historical presidential approval ratings

historical_approval.R

rm(list = ls()) #reset the environment
library(tidyverse)
library(lubridate)
library(mgcv)

exponent_weight <- function(i) {
  exp(-0.04*i)
}

TODAY_DAY <- difftime(Sys.Date(),as.Date("2017-01-21"))

days_since_inaug <- as.numeric(TODAY_DAY)

approvedata <- read.csv("pres_approval_data.csv",stringsAsFactors = FALSE)
approvedata <- approvedata %>% 
  mutate(Date = as.Date(End.Date,format = "%m/%d/%Y"),
         "Inaug" = as.Date(Inaug.Date, format = "%m/%d/%Y")) %>%
  select(President,
         Date, 
         Approve=Approving,
         Disapprove=Disapproving,
         "Undecided" = unsure.no.data,
         Inaug
         )

trump_approve <- read_csv("https://projects.fivethirtyeight.com/polls-page/president_approval_polls.csv")

trump_approve <- cbind("President" = "Trump", trump_approve)

trump_approve <- trump_approve %>% 
  filter(pollster %in% c("Gallup")) %>%
  mutate("Date" = mdy(end_date),
         "Inaug" = mdy("1/20/2017")) %>% 
  select(President,
         Date, 
         "Approve" = yes,
         "Disapprove" = no,
         Inaug)

trump_approve$Undecided <- 0
trump_approve <- trump_approve[trump_approve$Date > as.Date("2017-01-20"),]

# add a row for loess
trump_approve <- rbind(data.frame("President" = "Trump",
                              "Date" = as.Date("2017-01-21"), 
                              "Approve" = 45, 
                              "Disapprove" = 45, 
                              "Inaug" = as.Date("2017-01-20"), 
                              "Undecided" = 0),
                       trump_approve)


historical <- rbind(approvedata,trump_approve)

historical <- historical %>%
  mutate(Date = as.Date(Date),
         TDate = as.numeric(Date - Inaug),
         Net=Approve-Disapprove)
         


# restyle as approval ratings
approval_ratings <- 
  historical %>%
  filter(President %in% c('Trump','Obama','Bush 2')) %>%
  select(president=President,date=Date,
         approve=Approve,
         disapprove=Disapprove,
         net_approve=Net,
         inauguration_day=Inaug,
         days_since_inauguration=TDate,
  ) 

days_today_trump <- max(approval_ratings[approval_ratings$president=='Trump',]$days_since_inauguration)

# trim to max for Trump's presidency so far
approval_ratings <- approval_ratings %>%
  filter(days_since_inauguration <= days_today_trump
           
  )

# rolling avg
approval_ratings$average_net_approve <- NA

approval_ratings <- lapply(unique(approval_ratings$president),
       function(i){
          temp <- approval_ratings %>% filter(president == i)
          
          for (j in 1:nrow(temp)){
            UseDate <- temp[j,]$date
            temp2 <- temp[temp$date> UseDate - 14 & temp$date <=UseDate,]
            temp2$Weightday <- NA
            temp2$weight <- NA
            
            temp2$Weightday <- as.numeric(difftime(as.Date(temp2$date),as.Date(UseDate),units = "days"))
            temp2$weight = exponent_weight(temp2$Weightday)
            
            temp[j,]$average_net_approve <- weighted.mean(temp2$net_approve,temp2$weight)
          }
          
           return(temp)
        }) %>%
  do.call('bind_rows',.)


# plot
ggplot(approval_ratings,aes(x=days_since_inauguration,y=average_net_approve,col=president)) +
  geom_line() +
  theme_minimal()


write_csv(approval_ratings,'approval_ratings_out.csv')

# net approve
approval_ratings %>%
  filter(president=='Bush 2') %>%
  select(days_since_inauguration , net_approve) %>%
  gam(formula= net_approve ~ s(days_since_inauguration, fx=F,bs = "ts",k=30),
      data=.) %>%
  predict(.,tibble(days_since_inauguration = days_today_trump))


ggplot(approval_ratings,aes(x=days_since_inauguration,y=net_approve,col=president)) +
  #geom_line() +
  geom_smooth(method = 'gam',formula = y ~ s(x, fx=F,bs = "ts",k=30)) +
  theme_minimal() +
  theme(legend.position = 'top',legend.justification = 'left',
        panel.grid.minor = element_blank()) +
  labs(subtitle='Showing up to 1,104 days since inauguration') +
  coord_cartesian(xlim=c(0,days_today_trump))

ggsave('historical_approval.svg',width=8,height=8/1.7)


# both approve and dispprove
approval_ratings %>%
  filter(president=='Trump') %>%
  select(days_since_inauguration , approve,disapprove) %>%
  gam(formula= approve ~ s(days_since_inauguration, fx=F,bs = "ts",k=30),
      data=.) %>%
  predict(.,tibble(days_since_inauguration = days_today_trump))

approval_ratings %>%
  filter(president=='Trump') %>%
  select(days_since_inauguration , approve,disapprove) %>%
  gam(formula= disapprove ~ s(days_since_inauguration, fx=F,bs = "ts",k=30),
      data=.) %>%
  predict(.,tibble(days_since_inauguration = days_today_trump))

  
approval_ratings %>%
  filter(president=='Trump') %>%
  select(days_since_inauguration , approve,disapprove) %>%
  gather('variable','pct',c('approve','disapprove')) %>%
  ggplot(.,
       aes(x=days_since_inauguration,y=pct,col=variable)) +
  #geom_line() +
  #geom_hline(yintercept = 50) +
  geom_smooth(method = 'gam',formula = y ~ s(x, fx=F,bs = "ts",k=30)) +
  theme_minimal() +
  theme(legend.position = 'top',legend.justification = 'left',
        panel.grid.minor = element_blank()) +
  labs(subtitle='Showing up to 1,104 days since inauguration') +
  coord_cartesian(ylim=c(0,80),xlim=c(0,days_today_trump))

ggsave('trump_approval_disapprova.svg',width=8,height=8/1.7)

pres_approval_data.csv