Biden’s Approval Margins

# Import approval polls data directly off fivethirtyeight website
approval_polllist <- read_csv('https://projects.fivethirtyeight.com/biden-approval-data/approval_polllist.csv') 

glimpse(approval_polllist)

## Rows: 4,572
## Columns: 22
## $ president           <chr> "Joe Biden", "Joe Biden", "Joe Biden", "Joe Biden"…
## $ subgroup            <chr> "All polls", "All polls", "All polls", "All polls"…
## $ modeldate           <chr> "9/19/2022", "9/19/2022", "9/19/2022", "9/19/2022"…
## $ startdate           <chr> "1/19/2021", "1/19/2021", "1/20/2021", "1/20/2021"…
## $ enddate             <chr> "1/21/2021", "1/21/2021", "1/21/2021", "1/21/2021"…
## $ pollster            <chr> "Morning Consult", "Rasmussen Reports/Pulse Opinio…
## $ grade               <chr> "B", "B", "B-", "B", "B", "B+", "B+", "B", "B-", "…
## $ samplesize          <dbl> 15000, 1500, 1115, 1993, 15000, 1516, 941, 15000, …
## $ population          <chr> "a", "lv", "a", "rv", "a", "a", "rv", "a", "rv", "…
## $ weight              <dbl> 0.2594, 0.3382, 1.1014, 0.0930, 0.2333, 1.2454, 1.…
## $ influence           <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…
## $ approve             <dbl> 50.0, 48.0, 55.5, 56.0, 51.0, 45.0, 63.0, 52.0, 58…
## $ disapprove          <dbl> 28.0, 45.0, 31.6, 31.0, 28.0, 28.0, 37.0, 29.0, 32…
## $ adjusted_approve    <dbl> 49.4, 49.1, 54.6, 55.4, 50.4, 46.0, 59.4, 51.4, 57…
## $ adjusted_disapprove <dbl> 30.9, 40.3, 32.4, 33.9, 30.9, 29.0, 38.4, 31.9, 32…
## $ multiversions       <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA…
## $ tracking            <lgl> TRUE, TRUE, NA, NA, TRUE, NA, NA, TRUE, NA, TRUE, …
## $ url                 <chr> "https://morningconsult.com/form/global-leader-app…
## $ poll_id             <dbl> 74272, 74247, 74248, 74246, 74273, 74327, 74256, 7…
## $ question_id         <dbl> 139491, 139395, 139404, 139394, 139492, 139570, 13…
## $ createddate         <chr> "1/28/2021", "1/22/2021", "1/22/2021", "1/22/2021"…
## $ timestamp           <chr> "09:58:31 19 Sep 2022", "09:58:31 19 Sep 2022", "0…

# Use `lubridate` to fix dates, as they are given as characters.

Average net approval rate (approve - disapprove) for each week since Biden got into office, along with its 95% confidence interval

approval_polllist_cleaned <- approval_polllist %>%
#create net approval rate (approve - disapprove)
  mutate(approval_rate = approve - disapprove) %>% 
#translate date to weeks
  mutate(date = as.Date(enddate, tryFormats = c("%m/%d/%Y")), 
         weeks = week(date)) %>%
  filter(year(date) == 2022) %>% 
#group
  group_by(weeks, subgroup) %>%
#create confidence intervals 
  summarise(mean_approval = mean(approval_rate, na.rm=TRUE),
            std_dev_approval = sd(approval_rate, na.rm=TRUE),
            sample_size = n(),
            t_critical = qt(0.95, sample_size-1),
            approval_high = mean_approval + t_critical * std_dev_approval / sqrt(sample_size),
            approval_low = mean_approval - t_critical * std_dev_approval / sqrt(sample_size)
            )

#create the graph
approval_polllist_cleaned %>%
  ggplot(aes(x = weeks, y = mean_approval, color = factor(subgroup))) +
    geom_line() +
    facet_wrap(vars(subgroup), ncol=1, strip.position = "right") +
    theme(legend.position="none",
          axis.title.y = element_blank()) +
    labs(
    title = "Biden's Net Approval Ratings in 2022",
    subtitle = "Weekly Data, Approve - Disapprove, %",
    x = "Week in 2022",
    caption = "Source: https://projects.fivethirtyeight.com/biden-approval-rating/") +
    geom_ribbon(aes(ymin=approval_low,ymax=approval_high),alpha=0.2,fill="orange")