Skip to content

Instantly share code, notes, and snippets.

@ryanburge

ryanburge/ba_caths.R

Created July 17, 2019 13:25
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/71d7ba807078a36fc95020784ee642ad to your computer and use it in GitHub Desktop.
Save ryanburge/71d7ba807078a36fc95020784ee642ad to your computer and use it in GitHub Desktop.
Download ZIP
Born Again Catholics
Raw
ba_caths.R
graph <- cces %>%
filter(religion == 2) %>%
mutate(ba = car::recode(pew_bornagain, "1=1; 2=0; else =NA")) %>%
group_by(year) %>%
mean_ci(ba, wt = weight)
graph %>%
ggplot(., aes(x = factor(year), y = mean, fill = mean)) +
geom_col(color = "black") +
scale_y_continuous(labels = percent) +
geom_errorbar(aes(ymin=lower, ymax=upper), width=.2, position=position_dodge(.9)) +
theme_gg("Abel") +
scale_fill_gradient(low = "#FFFDE4", high = "#005AA7") +
geom_text(aes(y = .05, label = paste0(mean*100, '%')), position = position_stack(vjust = 0.5), size = 6, family = "font") +
theme(plot.title = element_text(size = 16)) +
labs(x = "", y = "", title = "Share of Catholics Who Say They Are Born-Again", caption = "@ryanburge\nData: CCES 2008-2018") +
ggsave("E://ba_cath.png", type = "cairo-png")
graph <- cces %>%
filter(religion == 2) %>%
filter(pid3 <= 3) %>%
mutate(ba = car::recode(pew_bornagain, "1=1; 2=0; else =NA")) %>%
group_by(year, ba) %>%
ct(pid3, wt = weight, show_na = FALSE) %>%
ungroup(ba) %>%
mutate(ba = frcode(ba == 1 ~ "Born-Again",
ba == 0 ~ "Not Born-Again")) %>%
mutate(pid3 = frcode(pid3 == 1 ~ "Democrat",
pid3 == 3 ~ "Independent",
pid3 == 2 ~ "Republican")) %>%
filter(ba != "NA")
graph %>%
ggplot(., aes(x =1, y = pct, fill = fct_rev(pid3))) +
geom_col(color = "black") +
coord_flip() +
scale_fill_manual(values = c("firebrick3", "azure3","dodgerblue3")) +
theme_gg("Abel") +
theme(legend.position = "bottom") +
facet_grid(year ~ ba, switch = "both") +
guides(fill = guide_legend(reverse=TRUE)) +
theme(axis.title.y=element_blank(), axis.text.y=element_blank(), axis.ticks.y=element_blank())+
scale_y_continuous(labels = percent) +
theme(plot.title = element_text(size = 32)) +
theme(strip.text.y = element_text(angle = 180, size = 18)) +
theme(strip.text.x = element_text(size = 24)) +
theme(strip.placement = "right") +
theme(legend.text = element_text(size = 24)) +
theme(panel.grid.minor.y=element_blank(), panel.grid.major.y=element_blank()) +
geom_text(aes(label = paste0(pct*100, '%')), position = position_stack(vjust = 0.5), size = 5, family = "font") +
labs(x = "", y = "", title = "Party ID of Catholics by Born-Again Status", caption = "@ryanburge\nData: CCES 2018") +
ggsave("E://pid3_ba_cath.png", type = "cairo-png", width = 12, height =6)
graph <- cces %>%
filter(year == 2018) %>%
filter(catholic ==1) %>%
mutate(ba = car::recode(pew_bornagain, "1=1; 2=0; else =NA")) %>%
mutate(race = frcode(race == 1 ~ "White",
race == 2 ~ "Black",
race == 3 ~ "Hispanic",
race == 4 ~ "Asian",
TRUE ~ "All\nOthers")) %>%
group_by(race) %>%
mean_ci(ba, wt = weight)
graph %>%
ggplot(., aes(x = race, y = mean, fill = mean)) +
geom_col(color = "black") +
geom_errorbar(aes(ymin=lower, ymax=upper), width=.2, position=position_dodge(.9)) +
theme_gg("Abel") +
scale_fill_gradient(low = "#FFFDE4", high = "#005AA7") +
geom_text(aes(y = .05, label = paste0(mean*100, '%')), position = position_stack(vjust = 0.5), size = 6, family = "font") +
scale_y_continuous(labels = percent) +
labs(x = "", y = "", title = "Percent of Born-Again Catholics by Race", caption = "@ryanburge\nData: CCES 2018") +
ggsave("E://ba_cath_race.png", type = "cairo-png")
graph <- cces %>%
filter(year == 2018) %>%
filter(catholic ==1) %>%
mutate(ba = car::recode(pew_bornagain, "1=1; 2=0; else =NA")) %>%
mutate(educ = frcode(educ == 1 ~ "No HS",
educ == 2 ~ "HS\nGrad",
educ == 3 ~ "Some\nCollege",
educ == 4 ~ "2 Yr.\nDegree",
educ == 5 ~ "4 Yr.\nDegree",
educ == 6 ~ "Grad\nSchool")) %>%
group_by(educ) %>%
mean_ci(ba, wt = weight)
graph %>%
ggplot(., aes(x = educ, y = mean, fill = mean)) +
geom_col(color = "black") +
geom_errorbar(aes(ymin=lower, ymax=upper), width=.2, position=position_dodge(.9)) +
theme_gg("Abel") +
scale_fill_gradient(low = "#FFFDE4", high = "#005AA7") +
geom_text(aes(y = .05, label = paste0(mean*100, '%')), position = position_stack(vjust = 0.5), size = 6, family = "font") +
scale_y_continuous(labels = percent) +
labs(x = "", y = "", title = "Percent of Born-Again Catholics by Education", caption = "@ryanburge\nData: CCES 2018") +
ggsave("E://ba_cath_educ.png", type = "cairo-png")
graph <- cces18 %>%
filter(catholic ==1) %>%
mutate(age = 2018 - birthyr) %>%
mutate(age2 = frcode(age >= 18 & age <= 29 ~ "18 to 29",
age >= 30 & age <= 39 ~ "30 to 39",
age >= 40 & age <= 49 ~ "40 to 49",
age >= 50 & age <= 59 ~ "50 to 59",
age >= 60 & age <= 69 ~ "60 to 69",
age >= 70 ~ "70 and Over")) %>%
mutate(ba = car::recode(pew_bornagain, "1=1; 2=0; else =NA")) %>%
mutate(ba = frcode(ba == 1 ~ "Born-Again",
ba == 0 ~ "Not Born-Again")) %>%
group_by(age2) %>%
ct(ba, wt = commonweight, show_na = FALSE)
graph %>%
ggplot(., aes(fill = fct_rev(ba), values = pct*100)) +
geom_waffle(color = "white", size=1.125, n_rows = 5, make_proportional = TRUE) +
scale_x_discrete(expand=c(0,0)) +
scale_y_discrete(expand=c(0,0)) +
ggthemes::scale_fill_tableau(name=NULL) +
coord_equal() +
theme_gg("Abel") +
theme(legend.position = "bottom") +
facet_wrap(~ age2) +
guides(fill = guide_legend(reverse=TRUE)) +
labs(x = "", y = "", title = "Catholic Born-Again Status by Age Group", subtitle = "", caption = "@ryanburge\nData: CCES 2018") +
ggsave("E://bacath_waffles.png", type = "cairo-png")
graph <- cces16 %>%
filter(catholic ==1) %>%
mutate(ba = car::recode(pew_bornagain, "1=1; 2=0; else =NA")) %>%
mutate(ba = frcode(ba == 1 ~ "Born-Again",
ba == 0 ~ "Not Born-Again")) %>%
filter(CC16_410a <= 4) %>%
mutate(vote16 = frcode(CC16_410a == 1 ~ "Trump",
CC16_410a == 2 ~ "Clinton",
CC16_410a == 3 ~ "Johnson",
CC16_410a == 4 ~ "Stein")) %>%
group_by(ba) %>%
ct(vote16, wt = commonweight_vv_post) %>%
filter(ba != "NA")
graph %>%
ggplot(., aes(x = vote16, y = pct, fill = vote16)) +
geom_col(color = "black") +
facet_wrap(~ ba) +
theme_gg("Abel") +
scale_fill_manual(values = c("firebrick3", "dodgerblue3", "goldenrod", "forestgreen")) +
scale_y_continuous(labels = percent) +
theme(strip.text = element_text(size = 18)) +
geom_text(aes(y = pct + .015, label = paste0(pct*100, '%')), position = position_dodge(width = .9), size = 4, family = "font") +
labs(x = "", y = "", title = "Vote Choice Among Catholics by Born-Again Status", caption = "@ryanburge\nData: CCES 2016") +
ggsave("E://ba_cath_vote.png", type = "cairo-png")
regg <- cces18 %>%
filter(catholic == 1) %>%
mutate(male = car::recode(gender, "1=1; else=0")) %>%
mutate(male = as.factor(male)) %>%
mutate(pid2 = car::recode(pid7, "1:3 = 'Democrat'; 5:7 = 'Republican'; else = NA")) %>%
mutate(att = recode(pew_churatd, "1=6; 2=5; 3=4; 4=3; 5=2; 6=1; else = NA")) %>%
mutate(ba = car::recode(pew_bornagain, "1=1; 2=0; else = NA")) %>%
mutate(white = car::recode(race, "1=1; else =0")) %>%
mutate(white = as.factor(white)) %>%
mutate(age = 2018 - birthyr)
gg <- glm(ba ~ att*pid2 + educ + white + male + age, data = regg, family = "binomial")
gg2 <- interact_plot(gg, pred= att, modx = pid2, int.width = .76, interval = TRUE, modx.labels = c("Democrat", "Republican"))
gg2 +
scale_x_continuous(limits = c(1,6.1), breaks = c(1,2,3,4,5,6), labels = c("Never", "Seldom", "Yearly", "Monthly", "Weekly", "Weekly+")) +
scale_color_manual(values = c("dodgerblue3", "firebrick3")) +
scale_fill_manual(values = c("dodgerblue3", "firebrick3")) +
theme_gg("Abel") +
scale_y_continuous(labels = percent) +
theme(legend.position = "bottom") +
labs(y = "Predicted Born-Again Percent", x = "Church Attendance", title = "Predicting Born-Again Status by Attendance and Party ID", subtitle = "Among Catholics", caption = "@ryanburge\nData: CCES 2018") +
ggsave("E://ba_cath_interact.png", type = "cairo-png")
att <- cces18 %>%
filter(catholic == 1) %>%
mutate(att = recode(pew_churatd, "1=6; 2=5; 3=4; 4=3; 5=2; 6=1; else = NA")) %>%
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(ba = car::recode(pew_bornagain, "1=1; 2=0; else =NA")) %>%
mutate(ba = frcode(ba == 0 ~ "Not Born-Again",
ba == 1 ~ "Born-Again")) %>%
filter(att != "REMOVE") %>%
filter(ba != "NA") %>%
group_by(ba) %>%
ct(att, wt = commonweight)
att %>%
ggplot(., aes(x = att, y = pct, fill = fct_rev(ba))) +
geom_col(color = "black", position = "dodge") +
theme_gg("Abel") +
theme(legend.position = "bottom") +
scale_fill_manual(values = c("#F28D2B", "#375677")) +
scale_y_continuous(labels = percent) +
theme(strip.text = element_text(size = 18)) +
geom_text(aes(y = pct + .01, label = paste0(pct*100, '%')), position = position_dodge(width = .9), size = 4, family = "font") +
labs(x = "", y = "", title = "Catholic Church Attendance by Born-Again Status", caption = "@ryanburge\nData: CCES 2018") +
ggsave("E://ba_cath_attend.png", type = "cairo-png")
cces18 %>%
filter(catholic == 1) %>%
mutate(CC18_412 = as.numeric(CC18_412)) %>%
mutate(house = car::recode(CC18_412, "1 = 'Democrat'; 2 = 'Republican'; 3:90 = 'All Others'; else = NA")) %>%
mutate(ba = car::recode(pew_bornagain, "1=1; 2=0; else =NA")) %>%
mutate(ba = frcode(ba == 0 ~ "Not Born-Again",
ba == 1 ~ "Born-Again")) %>%
group_by(ba) %>%
ct(house, show_na = FALSE, wt = commonpostweight)
cces16 %>%
filter(catholic == 1) %>%
mutate(CC16_412 = as.numeric(CC16_412)) %>%
mutate(house = car::recode(CC16_412, "1 = 'Democrat'; 2 = 'Republican'; 3:90 = 'All Others'; else = NA")) %>%
mutate(ba = car::recode(pew_bornagain, "1=1; 2=0; else =NA")) %>%
mutate(ba = frcode(ba == 0 ~ "Not Born-Again",
ba == 1 ~ "Born-Again")) %>%
group_by(ba) %>%
ct(house, show_na = FALSE, wt = commonweight_vv_post)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment