Analyzing the 2016 CCES

CCES.R

## R Code for Analysing the 2016 Cooperative Congressional Election Study
## Written by G. Elliott Morris
## @gelliottmorris | [email protected] | TheCrosstab.com
## please do not replicate the analysis without permission.
##
## Additional info:
## DOWNLOAD DATA AT https://dataverse.harvard.edu/dataset.xhtml?persistentId=doi:10.7910/DVN/GDF6Z0
## Github Gist lives at: https://gist.github.com/elliottmorris/79141ff0f0c3824798ce3b84f18b817b

### libraries & functions ####
library(tidyverse)
library(ggrepel)
library(foreign)
library(reshape2)
library(choroplethrMaps)
library(choroplethr)
library(knitr)
library(scales)
source('~/Desktop/theme_elliott.R')


# load data ####
#cces_raw <- read.dta('CCES2016_Common_FirstRelease.dta')
cces <- cces_raw
cces_pre <-cces_raw %>% filter(tookpost =="No")
cces_post <-cces_raw %>% filter(tookpost =="Yes")

elec_results <- read.csv('results2016.csv')


# analyze!! 
# impact on method taking study and vote choice ####
cces$CC16_364b <- as.character(cces$CC16_364b)
cces$comptype <- as.character(cces$comptype)

cces$comptype_code <- as.numeric(factor(cces$comptype , levels=unique(cces$comptype)))
codes <- data.frame(cces$comptype, cces$comptype_code)
unique(codes)

cces$pres_code <- as.numeric(factor(cces$CC16_364b , levels=unique(cces$CC16_364b)))

prescodes <- data.frame(cces$CC16_364b, cces$pres_code)
unique(prescodes)
cces_slim<-cces %>% filter(pres_code %in% c(1,2))

summary(lm(pres_code ~ comptype_code,cces_slim))



# race ####

cces <- cces_raw
cces$CC16_364b <- as.character(cces$CC16_364b)
cces$race <- as.character(cces$race)

cces$race_code <- ifelse(cces$race == "White",0,1)
codes <- data.frame(cces$race, cces$race_code)
unique(codes)

cces$pres_code <- as.numeric(factor(cces$CC16_364b , levels=unique(cces$CC16_364b)))

prescodes <- data.frame(cces$CC16_364b, cces$pres_code)
unique(prescodes)
cces_slim<-cces %>% filter(pres_code %in% c(1,2))

summary(lm(pres_code ~ race_code,cces_slim))


# pre and post diff in PID 7 ####
#DEM FOR THIS CODE 

# PID3 by state (unweighted for now)####
cces_state_pid3 <- cces

unique(cces_state_pid3$pid7)
# among states 
ID_states <- data.frame("PID" = NA,
                        "Percent" = NA,
                        "State" = NA,
                        "Order" = NA,
                        "State_Name" = NA)

for (i in unique(cces_state_pid3$inputstate)){
  temp <- cces_state_pid3 %>% filter(inputstate == i)
  n <- nrow(temp)
  temp2 <- temp
  temp2$pid_state <- 
    ifelse(temp2$pid7 == "Strong Democrat",1,
           ifelse(temp2$pid7 == "Not very strong Democrat",1,
                  ifelse(temp2$pid7 == "Lean Democrat",1,
                         ifelse(temp2$pid7 == "Independent",2,
                                ifelse(temp2$pid7 == "Lean Republican",3,
                                       ifelse(temp2$pid7 == "Not very strong Republican",3,
                                              ifelse(temp2$pid7 == "Strong Republican",3,NA)))))))
  
  dem <- nrow(temp2 %>% filter(pid_state == 1 ))/nrow(temp2)
  ind <- nrow(temp2 %>% filter(pid_state == 2 ))/nrow(temp2)
  rep <- nrow(temp2 %>% filter(pid_state == 3 ))/nrow(temp2)
  temp3 <- data.frame("PID" = c("Democrat","Independent","Republican"),
                      "Percent" = c(dem,ind,rep),
                      "State" = c(paste0(i," (n=",n,")"),
                                  paste0(i," (n=",n,")"),
                                  paste0(i," (n=",n,")")),
                      "Order" = c(1,2,3),
                      "State_Name" = c(i,i,i))
  
  ID_states <- rbind(ID_states,temp3)
}

ID_states <- ID_states[complete.cases(ID_states),]
ID_states$Swing <- 0
ID_states[ID_states$State_Name %in% c("Florida","Wisconsin","North Carolina","Michigan","Pennsylvania","Nevada"),]$Swing <- 1

# graph
gg <- ggplot(ID_states , #%>% filter(Swing == 1),
             aes(x=reorder(PID,Order),y=Percent)) + 
  geom_bar(stat = "identity",position="dodge",aes(fill=PID),col="gray90",width = .6) +
  geom_label_repel(aes(label=paste(round(Percent,3)*100,"%"),fill=PID))+
  theme_elliott() +
  theme(legend.position = "top")+
  labs(title = "Party Identification in Every US State",
       subtitle = "As measured by the Cooperative Congressional Election study. \n3-Point Scale with Grouped Lean Democrats/Republicans",
       x = "Party Identification",
       y = "Percent of Americans")+
  coord_cartesian(ylim=c(0,.8)) +
  facet_wrap(~State,ncol =5)


grid.arrange(gg,my_g,heights=c(9, .2))

dev.copy(png,"graphics/PID3_State.png",width=15,height=24,unit="in",res=300)
dev.off()

ID_states$Percent <- round(ID_states$Percent,3) * 100

PID_spread <- ID_states %>% 
  select(PID,Percent,State_Name) %>%
  spread(PID,Percent)


kable(PID_spread,align="l")

# calculate turnout (CC16_401) ####
unique(cces$CC16_401)
cces$turnout_code <- as.numeric(factor(cces$CC16_401 , levels=unique(cces$CC16_401)))
codes <- data.frame(cces$CC16_401, cces$turnout_code)
unique(codes)

# turnout among all respondents
nrow(cces %>% filter(turnout_code == 1))/nrow(cces %>% filter(!is.na(turnout_code)))

#turnout among complete responses 
nrow(cces %>% filter(turnout_code == 1))/nrow(cces)


# guns (CC16_330) ####

df <- data.frame(table(cces %>% filter(inputstate == "Texas") %>% select(CC16_330a))) #Background checks for all sales, including at gun shows and over the Internet
df$prop <- df$Freq / sum(df$Freq)
df

df <- data.frame(table(cces %>% filter(inputstate == "Texas") %>% select(CC16_330b))) #Prohibit state and local governments from publishing the names and addresses of all gun owners
df$prop <- df$Freq / sum(df$Freq)
df

df <- data.frame(table(cces %>% filter(inputstate == "Texas") %>% select(CC16_330d)))  #Ban assault rifles
df$prop <- df$Freq / sum(df$Freq)
df

df <- data.frame(table(cces %>% filter(inputstate == "Texas") %>% select(CC16_330e))) #Make it easier for people to obtain concealed-carry permit
df$prop <- df$Freq / sum(df$Freq)
df


# healthcare (CC16_351I,weighted) ####
aca_repeal <- data.frame("State" = NA, "Support" = NA, "Against" = NA,n=NA)

for (i in unique(as.character(cces$inputstate))){
  df <- cces %>% filter(inputstate == i) #Make it easier for people to obtain concealed-carry permit
  
  df$obamacare <- ifelse(df$CC16_351I == "Against",0,1)
  
  ACA_wighted <- weighted.mean(df$obamacare, df$commonweight,na.rm=TRUE)
  aca_repeal <- rbind(aca_repeal,data.frame("State" = i,
                      "Support" = ACA_wighted ,
                      "Against" = 1-ACA_wighted,
                      n=nrow(df)))
}
aca_repeal <- aca_repeal[complete.cases(aca_repeal),]

aca_repeal[aca_repeal$State =="District of Columbia",]$State <- "DC"
aca_repeal$StateN <- paste0(aca_repeal$State," (N=",aca_repeal$n,")")
aca_repeal.m <- melt(aca_repeal,id.vars=c("State","StateN","n"))

gg <- ggplot(aca_repeal.m ,# %>% filter(State %in% c("Florida","North Carolina","Pennsylvania")),
             aes(x=variable,y=value)) + 
  geom_bar(stat = "identity",position="dodge",aes(fill=variable),col="gray90",width = .6) +
  geom_label(aes(label=paste(round(value,3)*100,"%"),col=variable),nudge_y = .1)+
  theme_elliott() +
  scale_fill_manual("",values=c("#EC7063","#3498DB"),labels=c("Support Repeal","Against Repeal"))+
  scale_color_manual("",values=c("#EC7063","#3498DB"),labels=c("Support Repeal","Against Repeal"))+
  theme(legend.position = "top")+
  labs(title = "Support for Obamacare Repeal by State",
       subtitle = "As measured by the 2016 Cooperative Congressional Election Study",
       x = "Position on Obamacare",
       y = "Percent of State")+
  scale_y_continuous(labels=scales::percent)+
  coord_cartesian(ylim=c(0,1)) +
  facet_wrap(~StateN,ncol=5)


grid.arrange(gg,my_g,heights=c(9, .2))

dev.copy(png,"graphics/ObamacareState.png",width=10,height=18,unit="in",res=350)
dev.off()
 
### map 

aca_repeal <- aca_repeal %>% mutate(value = Support - Against)
aca_repeal$region <- tolower(aca_repeal$State)

us <- map_data("state")

arr <- USArrests %>% 
  add_rownames("region") %>% 
  mutate(region=tolower(region))

DT_Map <- data.frame("region" = aca_repeal$region,"value" = aca_repeal$value)

DT_Map$colors <- NA
for (i in 1:nrow(DT_Map)){
  n <- DT_Map$value[i]
  if (n <= 0){color <- "#EBF5FB"}
  if (n <= -.05){color <- "#AED6F1"}
  if (n <= -.1){color <- "#85C1E9"}
  if (n <= -.2){color <- "#5DADE2"}
  if (n <= -.3){color <- "#3498DB"}
  
  if (n >=  0){color <- "#FDEDEC"}
  if (n >=  .05){color <- "#F5B7B1"}
  if (n >=  .1){color <- "#F1948A"}
  if (n >=  .2){color <- "#EC7063"}
  if (n >=  .3){color <- "#E74C3C"}
  
  DT_Map$colors[i] <- color
}

#labels

cnames <- aggregate(cbind(long, lat) ~ region, data=us, 
                    FUN=function(x)mean(range(x)))
cnames <- cnames[order(cnames$region),]
cnames$region <- c("AL" ,"AZ", "AR" ,"CA" ,"CO" ,"CT", "DE","DC", "FL" ,"GA",  "ID" ,"IL" ,
                   "IN" ,"IA", "KS", "KY" ,"LA" ,"ME" ,"MD" ,"MA", "MI", "MN", "MS" ,
                   "MO", "MT", "NE", "NV" ,"NH" ,"NJ" ,"NM", "NY", "NC", "ND" ,"OH" ,
                   "OK", "OR" ,"PA", "RI" ,"SC", "SD" ,"TN", "TX" ,"UT", "VT", "VA" ,"WA", "WV", "WI" ,"WY")
cnames[cnames$region=='MI','long']<-cnames[cnames$region=='MI','long']+1.5
cnames[cnames$region=='MI','lat']<-cnames[cnames$region=='MI','lat']-1
cnames[cnames$region=='CA','lat']<-cnames[cnames$region=='CA','lat']-1
cnames[cnames$region=='ID','lat']<-cnames[cnames$region=='ID','lat']-1.5
cnames[cnames$region=='OK','long']<-cnames[cnames$region=='OK','long']+1.5
cnames[cnames$region=='FL','long']<-cnames[cnames$region=='FL','long']+2
cnames[cnames$region=='MN','long']<-cnames[cnames$region=='MN','long']-1
cnames[cnames$region=='KY','lat']<-cnames[cnames$region=='KY','lat']-.3
cnames[cnames$region=='KY','long']<-cnames[cnames$region=='KY','long']+.3
cnames[cnames$region=='LA','long']<-cnames[cnames$region=='LA','long']-1
cnames[cnames$region=='IL','long']<-cnames[cnames$region=='IL','long']+.5
cnames[cnames$region=='MA','lat']<-cnames[cnames$region=='MA','lat']+.3
cnames[cnames$region=='VA','long']<-cnames[cnames$region=='VA','long']+1
cnames[cnames$region=='WV','long']<-cnames[cnames$region=='WV','long']-.1
cnames[cnames$region=='TX','long']<-cnames[cnames$region=='TX','long']+1
cnames[cnames$region=='CT','lat']<-cnames[cnames$region=='CT','lat']+.2
cnames[cnames$region=='NC','lat']<-cnames[cnames$region=='NC','lat']+.6
cnames[cnames$region=='NH','lat']<-cnames[cnames$region=='NH','lat']-.5
cnames[cnames$region=='VT','lat']<-cnames[cnames$region=='VT','lat']+.5
cnames[cnames$region=='VT','long']<-cnames[cnames$region=='VT','long']-.2
cnames[cnames$region=='VA','lat']<-cnames[cnames$region=='VA','lat']-.5
cnames<-cnames[!(cnames$region %in% c('MD','DC','DE','NJ','RI')),]

#plot

gg <- ggplot()
gg <- gg + geom_map(data=us, map=us,
                    aes(x=long, y=lat, map_id=region),
                    fill="#ffffff", color="#ffffff", size=0.5)

gg <- gg + geom_map(data=DT_Map, map=us,
                    aes(map_id=region),fill=DT_Map$colors,
                    color="#ffffff", size=0.3)

gg <- gg + geom_text(data=cnames, aes(long, lat, label = region), size=4)

gg <- gg + labs(title = "Support for Obamacare Repeal by State",
                subtitle = "As measured by the 2016 Cooperative Congressional Election Study\n\nRed = Support Repeal, Blue = Against Repeal")

gg <- gg + theme(plot.title = element_text(face = "bold", size = 20))
gg <- gg + labs(x=NULL, y=NULL)
gg <- gg + coord_map("albers", lat0 = 39, lat1 = 45) 
gg <- gg + theme(panel.border = element_blank())
gg <- gg + theme(panel.background = element_blank())
gg <- gg + theme(axis.ticks = element_blank())
gg <- gg + theme(axis.text = element_blank())
gg <- gg + theme(legend.position = "right")
gg <- gg + theme(plot.title = element_text(hjust = .5,vjust=-4))
gg <- gg + theme(plot.subtitle = element_text(hjust = .5,vjust=-4))
gg <- gg + theme(plot.margin = margin(c(-2,-1,-2,-1), unit = "in"))


grid.arrange(gg,my_g,heights=c(9, .5))

dev.copy(png,"graphics/ObamacareStateMap.png",width=8,height=6,unit="in",res=350)
dev.off()