Skip to content

Instantly share code, notes, and snippets.

@ryanburge
Created November 8, 2019 19:38
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save ryanburge/249ba6e04caa262edecd54cf29e2c277 to your computer and use it in GitHub Desktop.
God Gap
library(socsci)
library(fst)
library(car)
cces18 <- read.fst("C://cces18.fst")
## Graph 1 ####
week <- cces18 %>%
mutate(age = 2018 - birthyr) %>%
mutate(gens = frcode(age >= 20 & age <= 29 ~ "20-29",
age >= 30 & age <= 39 ~ "30-39",
age >= 40 & age <= 49 ~ "40-49",
age >= 50 & age <= 59 ~ "50-59",
age >= 60 & age <= 74 ~ "60-74",
age >= 75 ~ "75 and Over")) %>%
mutate(pid = frcode(pid3 == 1 ~ "Democrat",
pid3 == 3 ~ "Independent",
pid3 == 2 ~ "Republican")) %>%
mutate(att = car::recode(pew_churatd, "6=1; 5=2; 4=3; 3=4; 2=5; 1=6; else = NA")) %>%
mutate(weekly = car::recode(att, "5:6=1; 1:4=0; else = NA")) %>%
group_by(gens, pid) %>%
mean_ci(weekly, wt = commonweight) %>%
na.omit()
week %>%
filter(pid != "Independent") %>%
ggplot(., aes(x = pid, y = mean, fill = pid)) +
geom_col(color = "black", position = "dodge") +
facet_wrap(~ gens) +
theme_gg("Abel") +
geom_errorbar(aes(ymin=lower, ymax=upper), width=.2, position=position_dodge(.9)) +
geom_text(aes(y = .10, label = paste0(mean*100, '%')), position = position_stack(vjust = 0.5), size = 6, family = "font") +
scale_y_continuous(labels = percent) +
scale_fill_manual(values = c("dodgerblue3", "firebrick3")) +
labs(x = "Party ID", y = "", title = "Percent Attending Church Weekly", caption = "CCES 2018", subtitle = "") +
ggsave("new_pid2_week_attend.png", type = "cairo-png", width = 6)
## Graph 2 ####
pid <- cces18 %>%
mutate(age = 2018 - birthyr) %>%
mutate(gens = frcode(age >= 20 & age <= 29 ~ "20-29",
age >= 30 & age <= 39 ~ "30-39",
age >= 40 & age <= 49 ~ "40-49",
age >= 50 & age <= 59 ~ "50-59",
age >= 60 & age <= 74 ~ "60-74",
age >= 75 ~ "75 and Over")) %>%
mutate(pid = frcode(pid3 == 1 ~ "Democrat",
pid3 == 3 ~ "Independent",
pid3 == 2 ~ "Republican")) %>%
group_by(gens) %>%
ct(pid, wt = commonweight, show_na = FALSE) %>%
na.omit()
pid %>%
ggplot(., aes(x=1, y = pct, fill = fct_rev(pid))) +
geom_col(color = "black") +
coord_flip() +
facet_wrap(~ gens, ncol =1) +
theme_gg("Abel") +
theme(legend.position = "bottom") +
scale_fill_manual(values = c( "firebrick3", "azure4", "dodgerblue3")) +
scale_y_continuous(labels = percent) +
guides(fill = guide_legend(reverse=T, nrow =1)) +
theme(axis.title.y=element_blank(), axis.text.y=element_blank(), axis.ticks.y=element_blank()) +
geom_text(aes(label = paste0(pct*100, '%')), position = position_stack(vjust = 0.5), size = 4, family = "font", color = "white") +
theme(panel.grid.major.y = element_blank()) +
theme(panel.grid.minor.y = element_blank()) +
theme(plot.title = element_text(size = 16)) +
labs(x = "", y = "", title = "The Partisan Composition of Age Groups", caption = "@ryanburge\nData: CCES 2018") +
ggsave("pid3_gens.png", type = "cairo-png")
pid <- cces18 %>%
mutate(age = 2018 - birthyr) %>%
mutate(gens = frcode(age >= 20 & age <= 29 ~ "20-29",
age >= 30 & age <= 39 ~ "30-39",
age >= 40 & age <= 49 ~ "40-49",
age >= 50 & age <= 59 ~ "50-59",
age >= 60 & age <= 74 ~ "60-74",
age >= 75 ~ "75 and Over")) %>%
mutate(pid = frcode(pid3 == 1 ~ "Democrat",
pid3 == 3 ~ "Independent",
pid3 == 2 ~ "Republican")) %>%
group_by(gens) %>%
ct(pid, wt = commonweight, show_na = FALSE)
allweek <- cces18 %>%
mutate(age = 2018 - birthyr) %>%
mutate(gens = frcode(age >= 20 & age <= 29 ~ "20-29",
age >= 30 & age <= 39 ~ "30-39",
age >= 40 & age <= 49 ~ "40-49",
age >= 50 & age <= 59 ~ "50-59",
age >= 60 & age <= 74 ~ "60-74",
age >= 75 ~ "75 and Over")) %>%
mutate(att = car::recode(pew_churatd, "6=1; 5=2; 4=3; 3=4; 2=5; 1=6; else = NA")) %>%
mutate(weekly = car::recode(att, "5:6=1; 1:4=0; else = NA")) %>%
group_by(gens) %>%
mean_ci(weekly, wt = commonweight) %>%
na.omit()
census <- read_csv("C://census.csv") %>%
mutate(ages = factor(ages)) %>%
rename(gens = ages)
first <- left_join(pid, census)
allgop <- week %>%
filter(pid == "Republican") %>%
select(gens, pid, mean) %>%
left_join(first) %>%
mutate(new_n = mean * count) %>%
select(gens, pid, new_n)
second <- left_join(allweek, census) %>%
mutate(current_n = mean * count) %>%
select(gens, current_n)
final_gop <- left_join(allgop, second) %>%
mutate(diff = new_n - current_n)
alldem <- week %>%
filter(pid == "Democrat") %>%
select(gens, pid, mean) %>%
left_join(first) %>%
mutate(new_n = mean * count) %>%
select(gens, pid, new_n)
second <- left_join(allweek, census) %>%
mutate(current_n = mean * count) %>%
select(gens, current_n)
final_dem <- left_join(alldem, second) %>%
mutate(diff = new_n - current_n)
graph <- bind_rows(final_dem, final_gop)
second <- second %>%
mutate(pid = "Current") %>%
mutate(new_n = current_n) %>%
mutate(diff = new_n - current_n)
final <- bind_rows(graph, second) %>%
mutate(pid = as.factor(pid))
final$pid <- factor(final$pid, levels = c("Democrat", "Current", "Republican"))
final <- final %>%
mutate(label = new_n/1000000) %>%
mutate(label = round(label, 1)) %>%
mutate(label = paste0(label, 'M'))
final %>%
filter(gens == "20-29" | gens == "30-39" | gens == "40-49") %>%
ggplot(., aes(x = gens, y = new_n/1000, fill = pid)) +
geom_col(color = "black", position = "dodge") +
theme_gg("Abel") +
scale_fill_manual(values = c("dodgerblue3", "azure3", "firebrick3")) +
geom_text(aes(y = new_n/1000 + 500, label = label), position = position_dodge(width = .9), size = 4, family = "font") +
labs(x = "", y = "Weekly Attenders (in Thousands)", title = "How Big is the God Gap?", caption = "") +
ggsave("threebar_top.png", type = "cairo-png")
final %>%
filter(gens == "50-59" | gens == "60-74" | gens == "75 and Over") %>%
ggplot(., aes(x = gens, y = new_n/1000, fill = pid)) +
geom_col(color = "black", position = "dodge") +
theme_gg("Abel") +
theme(legend.position = "bottom") +
scale_fill_manual(values = c("dodgerblue3", "azure3", "firebrick3")) +
geom_text(aes(y = new_n/1000 + 500, label = label), position = position_dodge(width = .9), size = 4, family = "font") +
labs(x = "Age Group", y = "Weekly Attenders (in Thousands)", title = "", caption = "@ryanburge\nData: CCES 2018") +
ggsave("threebar_bottom.png", type = "cairo-png")
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment