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,559
## 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/15/2022", "9/15/2022", "9/15/2022", "9/15/2022"…
## $ startdate           <chr> "1/19/2021", "1/19/2021", "1/20/2021", "1/20/2021"…
## $ enddate             <chr> "1/21/2021", "1/21/2021", "1/22/2021", "1/21/2021"…
## $ pollster            <chr> "Rasmussen Reports/Pulse Opinion Research", "Morni…
## $ grade               <chr> "B", "B", "B", "B", "B+", "B-", "B", "B", "B+", "B…
## $ samplesize          <dbl> 1500, 15000, 15000, 1993, 1516, 1115, 15000, 1500,…
## $ population          <chr> "lv", "a", "a", "rv", "a", "a", "a", "lv", "rv", "…
## $ weight              <dbl> 0.3382, 0.2594, 0.2333, 0.0930, 1.2454, 1.1014, 0.…
## $ influence           <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…
## $ approve             <dbl> 48.0, 50.0, 51.0, 56.0, 45.0, 55.5, 52.0, 48.0, 63…
## $ disapprove          <dbl> 45.0, 28.0, 28.0, 31.0, 28.0, 31.6, 29.0, 47.0, 37…
## $ adjusted_approve    <dbl> 49.1, 49.4, 50.4, 55.4, 46.0, 54.6, 51.4, 49.1, 59…
## $ adjusted_disapprove <dbl> 40.3, 30.9, 30.9, 33.9, 29.0, 32.5, 31.9, 42.3, 38…
## $ multiversions       <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA…
## $ tracking            <lgl> TRUE, TRUE, TRUE, NA, NA, NA, TRUE, TRUE, NA, NA, …
## $ url                 <chr> "https://www.rasmussenreports.com/public_content/p…
## $ poll_id             <dbl> 74247, 74272, 74273, 74246, 74327, 74248, 74274, 7…
## $ question_id         <dbl> 139395, 139491, 139492, 139394, 139570, 139404, 13…
## $ createddate         <chr> "1/22/2021", "1/28/2021", "1/28/2021", "1/22/2021"…
## $ timestamp           <chr> "09:45:31 15 Sep 2022", "09:45:31 15 Sep 2022", "0…

Create a plot

What I would like you to do is to calculate the average net approval rate (approve- disapprove) for each week since he got into office. I want you plot the net approval for each week in 2022, along with its 95% confidence interval. There are various dates given for each poll, please use enddate, i.e., the date the poll ended.

approval_polllist %>% 
  #convert end-date into "date" format:
  mutate(date_poll = mdy(enddate)) %>% 
  #extract year from date
  mutate(Year_poll = year(date_poll)) %>%
  #get week number from date 
  mutate(week_no = isoweek(date_poll)) %>%
  #filter out data for year 2022 and eliminate week 52
  filter(Year_poll== 2022, week_no != 52) %>%
  #week-wise average approval rate line plot for different sub-groups 
  group_by(subgroup,week_no) %>% 
  #get mean approval rate (difference of approve & disapprove), standard deviation of approval rate and total number   of votes in each group
  summarize(approval_rate = mean(approve - disapprove), approval_sd = sd(approve-disapprove), n = n()) %>% 
  ungroup(subgroup,week_no) %>% 
  #confidence interval
  mutate(low = approval_rate - 1.96*approval_sd/sqrt(n)) %>%
  mutate(high = approval_rate + 1.96*approval_sd/sqrt(n)) %>%
  #Plot the graph of week number vs approval rate 
  ggplot(aes(x=week_no,y=approval_rate, color = subgroup))+
  geom_line()+
    facet_wrap(~subgroup, nrow = 3, strip.position = "right")+
    xlim(0,35)+
    geom_ribbon(aes(ymin=low,ymax=high), alpha = 0.3, fill= "orange", size = 0.8)+
    theme_bw()+
    theme(legend.position = "none")+
    labs(title = "Biden's Net Approval Ratings in 2022",
         subtitle = "Weekly Data, Approve - Disapprove, %",
         x = "Week in 2022", 
         y = NULL,
         caption = "Source: https://projects.fivethirtyeight.com/biden-approval-data/")