Instantly share code, notes, and snippets.

@ryanburge ryanburge/dfp_vote_pid.R
Last active Jan 27, 2019

Embed
What would you like to do?
Data for Progress 2018 First Cut Analysis
library(socsci)
library(car)
dfp <- read_csv("D://dfp/data.csv")
## PID Change Graph ####
dd18 <- dfp %>%
filter(race ==1) %>%
filter(religpew ==1) %>%
filter(pew_bornagain ==1) %>%
filter(pid7 <= 7) %>%
mutate(att = recode(pew_churatd, "1=6; 2=5; 3=4; 4=3; 5=2; 6=1; else = NA")) %>%
group_by(att) %>%
mean_ci(pid7, wt = weight_DFP, ci = .84) %>%
mutate(att = frcode(att == 1 ~ "Never",
att == 2 ~ "Seldom",
att == 3 ~ "Yearly",
att == 4 ~ "Monthly",
att == 5 ~ "Weekly",
att == 6 ~ "Weekly+",
att == 7 ~ "Don`t Know",
TRUE ~ "REMOVE")) %>%
mutate(year = 2018)
dd16 <- cces16 %>%
filter(race ==1) %>%
filter(religpew ==1) %>%
filter(pew_bornagain ==1) %>%
filter(pid7 <= 7) %>%
mutate(att = recode(pew_churatd, "1=6; 2=5; 3=4; 4=3; 5=2; 6=1; else = NA")) %>%
group_by(att) %>%
mean_ci(pid7, wt = commonweight_vv, ci = .84) %>%
mutate(att = frcode(att == 1 ~ "Never",
att == 2 ~ "Seldom",
att == 3 ~ "Yearly",
att == 4 ~ "Monthly",
att == 5 ~ "Weekly",
att == 6 ~ "Weekly+",
att == 7 ~ "Don`t Know",
TRUE ~ "REMOVE")) %>%
mutate(year = 2016)
dd14 <- cces14 %>%
filter(race ==1) %>%
filter(religpew ==1) %>%
filter(pew_bornagain ==1) %>%
filter(pid7 <= 7) %>%
mutate(att = recode(pew_churatd, "1=6; 2=5; 3=4; 4=3; 5=2; 6=1; else = NA")) %>%
group_by(att) %>%
mean_ci(pid7, wt = weight, ci = .84) %>%
mutate(att = frcode(att == 1 ~ "Never",
att == 2 ~ "Seldom",
att == 3 ~ "Yearly",
att == 4 ~ "Monthly",
att == 5 ~ "Weekly",
att == 6 ~ "Weekly+",
att == 7 ~ "Don`t Know",
TRUE ~ "REMOVE")) %>%
mutate(year = 2014)
dd12 <- cces12 %>%
filter(race ==1) %>%
filter(religpew ==1) %>%
filter(pew_bornagain ==1) %>%
filter(pid7 <= 7) %>%
mutate(att = recode(pew_churatd, "1=6; 2=5; 3=4; 4=3; 5=2; 6=1; else = NA")) %>%
group_by(att) %>%
mean_ci(pid7, wt = weight_vv, ci = .84) %>%
mutate(att = frcode(att == 1 ~ "Never",
att == 2 ~ "Seldom",
att == 3 ~ "Yearly",
att == 4 ~ "Monthly",
att == 5 ~ "Weekly",
att == 6 ~ "Weekly+",
att == 7 ~ "Don`t Know",
TRUE ~ "REMOVE")) %>%
mutate(year = 2012)
graph <- bind_df("dd") %>%
filter(att != "REMOVE") %>%
mutate(year = as.factor(year))
graph %>%
ggplot(., aes(x= att, y = mean, group = year, color = year)) +
geom_point() +
geom_line(size = 1) +
theme_gg("Abel") +
geom_ribbon(aes(ymin=lower, ymax=upper, color = year, fill = year), alpha = .05, show.legend = FALSE) +
scale_color_manual(values=c("darkorchid", "azure4", "forestgreen", "firebrick1")) +
scale_fill_manual(values=c("darkorchid", "azure4", "forestgreen", "firebrick1")) +
scale_y_continuous(limits = c(3,7), breaks = c(1,2,3,4,5,6,7), labels = c("Strong Democrat", "Not Strong Democrat", "Lean Democrat", "Independent", "Lean Republican", "Moderate Republican", "Strong Republican")) +
labs(x ="Church Attendance", y = "Mean Party Identification", subtitle = "Among White Born-Again Protestants", title = "The Change in Party ID At Each Attendance Level", caption = "Data: CCES (2012-2016) and Data for Progress (2018)") +
theme(legend.position = c(0.8, 0.3)) +
theme(legend.title=element_blank()) +
ggsave("D://dfp/pid_ribbons.png")
## Vote Graph ####
graph1 <- dfp %>%
filter(race ==1) %>%
filter(religpew ==1) %>%
filter(pew_bornagain ==1) %>%
filter(pid7 <= 7) %>%
mutate(att = recode(pew_churatd, "1=6; 2=5; 3=4; 4=3; 5=2; 6=1; else = NA")) %>%
mutate(rep_vote = recode(housevote18_full, "3=1; 1:2=0; else = NA")) %>%
group_by(att) %>%
mean_ci(rep_vote, ci = .84, wt = weight_DFP) %>%
ungroup(att) %>% mutate(att = frcode(att == 1 ~ "Never",
att == 2 ~ "Seldom",
att == 3 ~ "Yearly",
att == 4 ~ "Monthly",
att == 5 ~ "Weekly",
att == 6 ~ "Weekly+",
att == 7 ~ "Don`t Know",
TRUE ~ "REMOVE")) %>%
mutate(year = " 2018 ")
graph2 <- cces16 %>%
filter(race ==1) %>%
filter(religpew ==1) %>%
filter(pew_bornagain ==1) %>%
filter(pid7 <= 7) %>%
mutate(att = recode(pew_churatd, "1=6; 2=5; 3=4; 4=3; 5=2; 6=1; else = NA")) %>%
mutate(vote16 = recode(CC16_410a, "1=1; 2=0; else = NA")) %>%
group_by(att) %>%
mean_ci(vote16, ci = .84, wt = commonweight_vv_post) %>%
mutate(att = frcode(att == 1 ~ "Never",
att == 2 ~ "Seldom",
att == 3 ~ "Yearly",
att == 4 ~ "Monthly",
att == 5 ~ "Weekly",
att == 6 ~ "Weekly+",
att == 7 ~ "Don`t Know",
TRUE ~ "REMOVE")) %>%
mutate(year = " 2016 ")
graph3 <- cces12 %>%
filter(race ==1) %>%
filter(religpew ==1) %>%
filter(pew_bornagain ==1) %>%
filter(pid7 <= 7) %>%
mutate(att = recode(pew_churatd, "1=6; 2=5; 3=4; 4=3; 5=2; 6=1; else = NA")) %>%
mutate(vote12 = recode(CC410a, "2=1; 1=0; else = NA")) %>%
group_by(att) %>%
mean_ci(vote12, wt= weight_vv, ci = .84 ) %>%
mutate(att = frcode(att == 1 ~ "Never",
att == 2 ~ "Seldom",
att == 3 ~ "Yearly",
att == 4 ~ "Monthly",
att == 5 ~ "Weekly",
att == 6 ~ "Weekly+",
att == 7 ~ "Don`t Know",
TRUE ~ "REMOVE")) %>%
mutate(year = " 2012 ")
graph <- bind_rows(graph1, graph2, graph3)
graph %>%
filter(att != "REMOVE") %>%
mutate(mean = round(mean, 3)) %>%
ggplot(., aes(x=att, y = mean, fill = factor(year))) +
geom_col(color = "black", position = "dodge") +
theme_gg("Abel") +
scale_y_continuous(labels = percent) +
geom_errorbar(aes(ymin=lower, ymax=upper), width=.2, position=position_dodge(.9)) +
scale_fill_manual(values = c("#d5e0f3", "#656371", "#ff7369")) +
geom_text(aes(y = .08 , label = paste0(mean*100, '%')), position = position_dodge(width = .9), size = 4, family = "font") +
labs(x = "", y = "Share of Two Party Vote for Republicans", title = "White Evangelicals Vote Choice", subtitle = "Share for 2018 is based on House vote - 84% CIs", caption = "Data: CCES (2012-2016) and Data for Progress (2018)") +
theme(legend.position = "bottom") +
ggsave("D://dfp/vote.png", width = 10)
## PID Shift Graph ####
graph <- dfp %>%
# filter(race ==1) %>%
filter(religpew ==1) %>%
filter(pew_bornagain ==1) %>%
mutate(age = recode(age5, "1:3 = ' Under 50 '; 3:5= ' Over 50 '")) %>%
group_by(age) %>%
ct(suprpty, wt = weight_DFP) %>%
mutate(suprpty = frcode(suprpty == 1 ~ "Always Dem.",
suprpty == 2 ~ "Was GOP, Now Dem.",
suprpty == 3 ~ "Was Dem., Now GOP",
suprpty == 4 ~ "Always GOP",
suprpty == 5 ~ "Not Sure"))
graph %>%
ggplot(., aes(x=suprpty, y = pct, fill = fct_rev(age))) +
geom_col(color = "black", position = "dodge") +
theme_gg("Abel") +
scale_y_continuous(labels = percent) +
# geom_errorbar(aes(ymin=lower, ymax=upper), width=.2, position=position_dodge(.9)) +
scale_fill_manual(values = c("#d5e0f3", "#656371", "#ff7369")) +
geom_text(aes(y = .06 , label = paste0(pct*100, '%')), position = position_dodge(width = .9), size = 4, family = "font") +
labs(x = "", y = "Share of Two Party Vote for Republicans", title = "Which of the following best describes you?", subtitle = "Among Born-Again Protestants", caption = "Data: Data for Progress (2018)") +
theme(legend.position = "bottom") +
ggsave("D://dfp/pid_change_age.png", width = 10)
### Heatmap Crosstab ####
heat <- dfp %>%
filter(race ==1) %>%
filter(religpew ==1) %>%
filter(pew_bornagain ==1) %>%
mutate(att = frcode(pew_churatd == 6 ~ "Never",
pew_churatd == 5 ~ "Seldom",
pew_churatd == 4 ~ "Yearly",
pew_churatd == 3 ~ "Monthly",
pew_churatd == 2 ~ "Weekly",
pew_churatd == 1 ~ "Weekly+")) %>%
filter(app_dtrmp <= 4) %>%
mutate(tr = frcode(app_dtrmp == 4 ~ "Strongly Disapprove",
app_dtrmp == 3 ~ "Somewhat Disapprove",
app_dtrmp == 2 ~ "Somewhat Approve",
app_dtrmp == 1 ~ "Strongly Approve")) %>%
select(att, tr) %>%
group_by(att) %>%
ct(tr) %>%
ungroup(att) %>%
add_row(att = "Monthly", tr = "Somewhat Disapprove", n = 0, pct = 0)
heat %>%
filter(att != "NA") %>%
ggplot(., aes(x= att, y = tr)) +
geom_tile(aes(fill = pct), color = "black") +
scale_fill_gradient(low = "azure3", high = "#E94057") +
theme_gg("Abel") +
geom_text(aes(x= att, y = tr, label = paste0(pct*100, '%')), size = 4, family = "font") +
labs(x= "", y = "", title = "Job Approval for President Trump", subtitle = "Among White Born-Again Protestants", caption = "Data: Data for Progress (2018)") +
ggsave("D://dfp/heatmap.png", width = 6)
## Favorability Graph ####
favor_fun <- function(df, var, var1){
var <- enquo(var)
df1 <- df %>%
filter(race ==1) %>%
filter(religpew ==1) %>%
filter(pew_bornagain ==1) %>%
filter(!! var <= 4) %>%
mutate(ques = recode(!! var, "1=4; 2=3; 3=2; 4=1")) %>%
mean_ci(ques, wt = weight_DFP, ci = .84) %>%
mutate(group = var1) %>%
mutate(sample = "White BA Prot.")
df2 <- df %>%
filter(race !=1) %>%
filter(religpew ==1) %>%
filter(pew_bornagain ==1) %>%
filter(!! var <= 4) %>%
mutate(ques = recode(!! var, "1=4; 2=3; 3=2; 4=1")) %>%
mean_ci(ques, wt = weight_DFP, ci = .84) %>%
mutate(group = var1) %>%
mutate(sample = "Non-White BA Prot.")
df3 <- df %>%
filter(race ==1) %>%
filter(pew_bornagain ==2) %>%
filter(!! var <= 4) %>%
mutate(ques = recode(!! var, "1=4; 2=3; 3=2; 4=1")) %>%
mean_ci(ques, wt = weight_DFP, ci = .84) %>%
mutate(group = var1) %>%
mutate(sample = "White Non-BA")
bind_rows(df1, df2, df3)
}
eee1 <- dfp %>% favor_fun(favor_labor, "Labor Unions")
eee2 <- dfp %>% favor_fun(favor_dem, "Democratic Party")
eee3 <- dfp %>% favor_fun(favor_rep, "Republican Party")
eee4 <- dfp %>% favor_fun(favor_aca, "Obamacare/ACA")
eee5 <- dfp %>% favor_fun(favor_dtrump, "Trump")
eee6 <- dfp %>% favor_fun(favor_mcconnell, "McConnell")
eee7 <- dfp %>% favor_fun(favor_demcong, "Dem. in Congress")
eee8 <- dfp %>% favor_fun(favor_repcong, "Rep. in Congress")
eee9 <- dfp %>% favor_fun(favor_metoo, "MeToo")
eee10 <- dfp %>% favor_fun(favor_blm, "Black Lives Matter")
graph <- bind_df("eee")
graph %>%
ggplot(., aes(y=mean, x= fct_reorder(group, mean), color = sample)) +
geom_point(position=position_dodge(width=0.5), size =4) +
geom_errorbar(aes(ymin = lower, ymax=upper), position=position_dodge(0.5), size = 1) +
coord_flip() +
theme_gg("Abel") +
labs(title = "Favorability of Various Groups", x = "", y = "Level of Favorability", caption = "Data: Data for Progress (2018)") +
scale_y_continuous(limits = c(0.85,4.05), breaks = c(1,2,3,4), labels = c("Very Unfavorable", "Somewhat Unfavorable", "Somewhat Favorable", "Very Favorable")) +
scale_color_npg() +
theme(legend.position = "bottom") +
theme(legend.title=element_blank()) +
theme(text=element_text(size=28, family="font")) +
ggsave("D://dfp/group_like.png", height = 6, width =16)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment