Skip to content

Instantly share code, notes, and snippets.

@ryanburge

ryanburge/heat_maps_ed_att.R

Last active June 21, 2019 12:32
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save ryanburge/31a5005406ef82198b368cf529a3851f to your computer and use it in GitHub Desktop.
Save ryanburge/31a5005406ef82198b368cf529a3851f to your computer and use it in GitHub Desktop.
Download ZIP
Education and Church Attendance Heat Maps
Raw
heat_maps_ed_att.R
### White Evan Heat Map ####
graph <- cces18 %>%
filter(evangelical == 1) %>%
filter(race == 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+")) %>%
mutate(educ = frcode(educ == 1 ~ "No HS",
educ == 2 ~ "HS Grad",
educ == 3 ~ "Some College",
educ == 4 ~ "2 Yr. Degree",
educ == 5 ~ "4 Yr. Degree",
educ == 6 ~ "Grad School")) %>%
mutate(rep = car::recode(pid7, "5:7 = 1; 1:4=0; else = NA")) %>%
group_by(att, educ) %>%
mean_ci(rep)
graph %>%
filter(att != "NA") %>%
ggplot(., aes(x= att, y = educ)) +
geom_tile(aes(fill = mean), color = "black") +
scale_fill_gradient2(low = "dodgerblue3", mid = "azure3", high = "firebrick3", midpoint = .55) +
theme_gg("Abel") +
geom_text(aes(x= att, y = educ, label = paste0(mean*100, '%')), size = 4, family = "font") +
labs(x= "Church Attendance", y = "Highest Level of Education", title = "Percent Identifying as Republican", subtitle = "Among White Evangelicals", caption = "@ryanburge\nData: CCES 2018") +
ggsave("E://wht_evan_heat.png", width = 6)
## Nonwhite Prot and Catholic ####
graph <- cces18 %>%
filter(religpew == 1 | religpew == 2) %>%
filter(race != 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+")) %>%
mutate(educ = frcode(educ == 1 ~ "No HS",
educ == 2 ~ "HS Grad",
educ == 3 ~ "Some College",
educ == 4 ~ "2 Yr. Degree",
educ == 5 ~ "4 Yr. Degree",
educ == 6 ~ "Grad School")) %>%
mutate(rep = car::recode(pid7, "5:7 = 1; 1:4=0; else = NA")) %>%
group_by(att, educ) %>%
mean_ci(rep)
graph %>%
filter(att != "NA") %>%
ggplot(., aes(x= att, y = educ)) +
geom_tile(aes(fill = mean), color = "black") +
scale_fill_gradient2(low = "dodgerblue3", mid = "azure3", high = "firebrick3", midpoint = .35) +
theme_gg("Abel") +
geom_text(aes(x= att, y = educ, label = paste0(mean*100, '%')), size = 4, family = "font") +
labs(x= "Church Attendance", y = "Highest Level of Education", title = "Percent Identifying as Republican", subtitle = "Among Non-White Protestants and Catholics", caption = "@ryanburge\nData: CCES 2018") +
ggsave("E://nonwht_protcath_heat.png", width = 6)
### White Catholics ####
graph <- cces18 %>%
filter(catholic == 1) %>%
filter(race == 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+")) %>%
mutate(educ = frcode(educ == 1 ~ "No HS",
educ == 2 ~ "HS Grad",
educ == 3 ~ "Some College",
educ == 4 ~ "2 Yr. Degree",
educ == 5 ~ "4 Yr. Degree",
educ == 6 ~ "Grad School")) %>%
mutate(rep = car::recode(pid7, "5:7 = 1; 1:4=0; else = NA")) %>%
group_by(att, educ) %>%
mean_ci(rep)
graph %>%
filter(att != "NA") %>%
ggplot(., aes(x= att, y = educ)) +
geom_tile(aes(fill = mean), color = "black") +
scale_fill_gradient2(low = "dodgerblue3", mid = "azure3", high = "firebrick3", midpoint = .5) +
theme_gg("Abel") +
geom_text(aes(x= att, y = educ, label = paste0(mean*100, '%')), size = 4, family = "font") +
labs(x= "Church Attendance", y = "Highest Level of Education", title = "Percent Identifying as Republican", subtitle = "Among White Catholics", caption = "@ryanburge\nData: CCES 2018") +
ggsave("E://wht_cath_heat.png", width = 6)
graph <- cces18 %>%
filter(catholic == 1) %>%
filter(race != 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+")) %>%
mutate(educ = frcode(educ == 1 ~ "No HS",
educ == 2 ~ "HS Grad",
educ == 3 ~ "Some College",
educ == 4 ~ "2 Yr. Degree",
educ == 5 ~ "4 Yr. Degree",
educ == 6 ~ "Grad School")) %>%
mutate(rep = car::recode(pid7, "5:7 = 1; 1:4=0; else = NA")) %>%
group_by(att, educ) %>%
mean_ci(rep)
graph %>%
filter(att != "NA") %>%
ggplot(., aes(x= att, y = educ)) +
geom_tile(aes(fill = mean), color = "black") +
scale_fill_gradient(low = "azure3", high = "firebrick3") +
theme_gg("Abel") +
geom_text(aes(x= att, y = educ, label = paste0(mean*100, '%')), size = 4, family = "font") +
labs(x= "Church Attendance", y = "Highest Level of Education", title = "Percent Identifying as Republican", subtitle = "Among Non-White Catholics", caption = "@ryanburge\nData: CCES 2018") +
ggsave("E://nonwht_cath_heat.png", width = 6)
### Interactions ####
reg <- cces18 %>%
filter(evangelical == 1) %>%
filter(race == 1) %>%
mutate(att = recode(pew_churatd, "1=6; 2=5; 3=4; 4=3; 5=2; 6=1; else = NA")) %>%
mutate(week = car::recode(att, "5:6 = 'Weekly'; 1:4= 'Not Weekly'; else = NA")) %>%
mutate(att2 = car::recode(att, "1:2= 'Low Attendance'; 3:4 = 'Middle Attendance'; 5:6 = 'High Attendance'; else = NA")) %>%
mutate(college = car::recode(educ, "1:4 = 'No College'; 5:6 = 'College Degree'")) %>%
mutate(male = car::recode(gender, "1=1; else=0")) %>%
mutate(male = as.factor(male)) %>%
mutate(age = 2018 - birthyr) %>%
mutate(rep = car::recode(pid7, "5:7 = 1; 1:4=0; else = NA"))
gg <- glm(rep ~ educ*att2 + male + age, data = reg, family = "binomial")
gg2 <- interact_plot(gg, pred= educ, modx = att2, int.width = .76, interval = TRUE)
gg2 +
labs(x = "Education", y = "Predicting Republican Percent", title = "Interaction of Education and Church Attendance on Republican ID", caption = "Data: CCES 2018", subtitle = "Among White Evangelicals") +
theme_gg("Abel") +
scale_x_continuous(limits = c(1,6.1), breaks = c(1,2,3,4,5,6), labels = c("No HS", "HS Grad", "Some College", "2 Yr.\nDegree", "4 Yr.\nDegree", "Post-Grad")) +
scale_y_continuous(labels = percent) +
scale_fill_d3() +
scale_colour_d3() +
annotate("text", x=4, y = .76, label = "High Attendance", size = 5, family = "font") +
annotate("text", x=4, y = .525, label = "Low Attendance", size = 5, family = "font") +
annotate("text", x=4, y = .62, label = "Middle Attendance", size = 5, family = "font") +
ggsave("E://ed_att_interact_evan.png", width = 8)
reg <- cces18 %>%
filter(catholic == 1) %>%
filter(race == 1) %>%
mutate(att = recode(pew_churatd, "1=6; 2=5; 3=4; 4=3; 5=2; 6=1; else = NA")) %>%
mutate(att2 = car::recode(att, "1:2= 'Low Attendance'; 3:4 = 'Middle Attendance'; 5:6 = 'High Attendance'; else = NA")) %>%
mutate(att2 = car::recode(att, "5:6 = 'High Attendance'; 3:4 = 'Middle Attendance'; 1:2= 'Low Attendance'; else = NA")) %>%
mutate(college = car::recode(educ, "1:4 = 'No College'; 5:6 = 'College Degree'")) %>%
mutate(male = car::recode(gender, "1=1; else=0")) %>%
mutate(male = as.factor(male)) %>%
mutate(age = 2018 - birthyr) %>%
mutate(rep = car::recode(pid7, "5:7 = 1; 1:4=0; else = NA"))
gg <- glm(rep ~ educ*att2 + male + age, data = reg, family = "binomial")
gg2 <- interact_plot(gg, pred= educ, modx = att2, int.width = .76, interval = TRUE)
gg2 +
labs(x = "Education", y = "Predicting Republican Percent", title = "Interaction of Education and Church Attendance on Republican ID", caption = "Data: CCES 2018", subtitle = "Among White Catholics") +
theme_gg("Abel") +
scale_x_continuous(limits = c(1,6.1), breaks = c(1,2,3,4,5,6), labels = c("No HS", "HS Grad", "Some College", "2 Yr.\nDegree", "4 Yr.\nDegree", "Post-Grad")) +
scale_y_continuous(labels = percent) +
scale_fill_d3() +
scale_colour_d3() +
annotate("text", x=4, y = .535, label = "High Attendance", size = 5, family = "font") +
annotate("text", x=4, y = .395, label = "Low Attendance", size = 5, family = "font") +
annotate("text", x=4, y = .465, label = "Middle Attendance", size = 5, family = "font") +
ggsave("E://ed_att_interact_cath.png", width = 8)
graph <- cces18 %>%
filter(evangelical == 1) %>%
filter(race == 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+")) %>%
mutate(educ = frcode(educ == 1 ~ "No HS",
educ == 2 ~ "HS Grad",
educ == 3 ~ "Some College",
educ == 4 ~ "2 Yr. Degree",
educ == 5 ~ "4 Yr. Degree",
educ == 6 ~ "Grad School")) %>%
mutate(app_trump = car::recode(CC18_308a, "1:2 = 1; 3:4=0; else = NA")) %>%
group_by(att, educ) %>%
mean_ci(app_trump)
cces18 %>%
filter(pid7 == 5 | pid7 == 6 | pid7 == 7) %>%
mutate(app_trump = car::recode(CC18_308a, "1:2 = 1; 3:4=0; else = NA")) %>%
filter(app_trump != "NA") %>%
ct(app_trump)
graph %>%
filter(att != "NA") %>%
ggplot(., aes(x= att, y = educ)) +
geom_tile(aes(fill = mean), color = "black") +
scale_fill_gradient2(low = "dodgerblue3", mid = "azure3", high = "firebrick3", midpoint = .55) +
theme_gg("Abel") +
geom_text(aes(x= att, y = educ, label = paste0(mean*100, '%')), size = 4, family = "font") +
labs(x= "Church Attendance", y = "Highest Level of Education", title = "Percent Approving of Trump", subtitle = "Among White Evangelicals", caption = "@ryanburge\nData: CCES 2018") +
ggsave("E://wht_evan_heat18_app.png", width = 6)
## Trump Approval ####
graph <- cces18 %>%
filter(evangelical == 1) %>%
filter(race == 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+")) %>%
mutate(educ = frcode(educ == 1 ~ "No HS",
educ == 2 ~ "HS Grad",
educ == 3 ~ "Some College",
educ == 4 ~ "2 Yr. Degree",
educ == 5 ~ "4 Yr. Degree",
educ == 6 ~ "Grad School")) %>%
mutate(app_trump = car::recode(CC18_308a, "1:2 = 1; 3:4=0; else = NA")) %>%
group_by(educ) %>%
mean_ci(app_trump)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment