Created
November 8, 2019 19:38
Star
You must be signed in to star a gist
God Gap
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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