Skip to content

Instantly share code, notes, and snippets.

@elliottmorris
Last active August 5, 2021 16:47
Show Gist options
  • Save elliottmorris/79141ff0f0c3824798ce3b84f18b817b to your computer and use it in GitHub Desktop.
Save elliottmorris/79141ff0f0c3824798ce3b84f18b817b to your computer and use it in GitHub Desktop.
Analyzing the 2016 CCES
## R Code for Analysing the 2016 Cooperative Congressional Election Study
## Written by G. Elliott Morris
## @gelliottmorris | elliott@thecrosstab.com | 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()
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment