Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Projecting the Future of American Religion
g <- graph %>%
filter(reltrad != "NA") %>%
ggplot(., aes(x = year, y = pct, color = factor(reltrad), group = factor(reltrad))) +
xlim(1980,2030) +
stat_smooth(method="lm", fullrange=TRUE, linetype = "twodash", alpha = .2) +
geom_point(size=3, color="white") +
geom_point(size=2, shape=1) +
geom_point(size=1, shape=19) +
scale_color_tableau() +
theme_gg("Abel") +
y_pct() +
add_text(x = 2016.75, y = .25, word = "Catholic", sz = 4)+
add_text(x = 2025, y = .22, word = "Evangelical", sz = 4)+
add_text(x = 2008, y = .19, word = "No Religion", sz = 4)+
add_text(x = 2024.5, y = .08, word = "Mainline", sz = 4)+
add_text(x = 2011, y = .085, word = "Black Protestant", sz = 4)+
add_text(x = 2000, y = .05, word = "Other Faith", sz = 4)+
add_text(x = 2007, y = .028, word = "Jewish", sz = 4)+
geom_vline(xintercept = 2019, linetype = "dashed") +
add_text(x = 2022, y = .30, word = "Projection\nBegins", sz = 4) +
labs(x = "", y = "", title = "What Does the Future of American Religion Look Like?", caption = "@ryanburge\nData: 1972-2018") +
ggsave("E://reltrad_project.png", type = "cairo-png")
over <- gss %>%
filter(year == 1982 | year == 1987) %>%
group_by(year) %>%
ct(reltrad, wt = oversamp)
## This is the weight for the rest of the sample ####
wtss <- gss %>%
group_by(year) %>%
ct(reltrad, wt = wtssall)
## Removing the two years that used the overweight ####
wtss <- wtss %>%
filter(year != 1982) %>%
filter(year != 1987)
## Bind them both together ####
graph <- bind_rows(over, wtss)
g <- graph %>%
ggplot(., aes(x = year, y = pct, color = reltrad, group = reltrad)) +
xlim(1980,2030) +
stat_smooth(method="lm", fullrange=TRUE)
right <- ggplot_build(g)$data[[1]] %>%
as_tibble() %>%
filter(x == 2030) %>%
select(group, y) %>%
mutate(reltrad = frcode(group == 1 ~ "Evangelical",
group == 2 ~ "Mainline",
group == 3 ~ "Black Prot.",
group == 4 ~ "Catholic",
group == 5 ~ "Jewish",
group == 6 ~ "Other Faith",
group == 7 ~ "No Religion")) %>%
mutate(newpct = round(y, 3)) %>%
mutate(newpct = paste0(newpct*100, "%")) %>%
select(reltrad, newpct, pct = y) %>%
filter(reltrad != "NA")
left <- graph %>%
ungroup(year) %>%
filter(year == 2018) %>%
select(reltrad, pct) %>%
mutate(reltrad = frcode(reltrad == 1 ~ "Evangelical",
reltrad == 2 ~ "Mainline",
reltrad == 3 ~ "Black Prot.",
reltrad == 4 ~ "Catholic",
reltrad == 5 ~ "Jewish",
reltrad == 6 ~ "Other Faith",
reltrad == 7 ~ "No Religion")) %>%
mutate(newpct = paste0(pct*100, "%")) %>%
select(reltrad, newpct, pct) %>%
filter(reltrad != "NA")
left_label <- paste(left$reltrad, left$newpct, sep = ": ")
right_label <- paste(right$reltrad, right$newpct, sep = ": ")
sl <- bind_cols(left, right)
ggplot(sl) +
geom_segment(aes(x=1, xend =2, y = pct, yend = pct1, col= reltrad), size = .75, show.legend = FALSE, linetype = "twodash") +
scale_y_continuous(labels = percent, limits = c(.22, .29)) +
geom_vline(xintercept=1, linetype="dashed", size=.1) +
geom_vline(xintercept=2, linetype="dashed", size=.1) +
xlim(.25, 2.75) +
scale_color_tableau() +
add_text(x = .68, y = .235, word = "No Religion: 23.1%", sz = 4.5) +
add_text(x = .68, y = .23, word = " Catholic: 23%", sz = 4.5) +
add_text(x = .68, y = .225, word = "Evangelical: 22.5%", sz = 4.5) +
# geom_text(label=left_label, y=sl$pct, x=rep(1, NROW(sl)), hjust=1.05, size=4.5, family = "font") +
geom_text(label=right_label, y=sl$pct1, x=rep(2, NROW(sl)), hjust=-0.05, size=4.5, family = "font") +
geom_text(label="2018", x=1, y=.285, hjust=1.1, size=5, family = "font") +
geom_text(label="Proj.\n2030", x=2, y=.285, hjust=-.1, size=5, family = "font") +
theme_gg("Abel") +
theme(panel.background = element_blank(),
panel.grid = element_blank(),
axis.ticks = element_blank(),
axis.text.x = element_blank(),
panel.border = element_blank()) +
labs(x = "", y = "", title = "Projecting the Three Largest Traditions", caption = "@ryanburge\nData: GSS 1972-2018") +
ggsave("E://slope_predict.png")
ggplot(sl) +
geom_segment(aes(x=1, xend =2, y = pct, yend = pct1, col= reltrad), size = .75, show.legend = FALSE, linetype = "twodash") +
scale_y_continuous(labels = percent, limits = c(.0, .13)) +
geom_vline(xintercept=1, linetype="dashed", size=.1) +
geom_vline(xintercept=2, linetype="dashed", size=.1) +
xlim(.25, 2.75) +
scale_color_tableau() +
add_text(x = .72, y = .11, word = "Mainline: 10.8%", sz = 4.5) +
add_text(x = .68, y = .066, word = "Black Prot.: 6.4%", sz = 4.5) +
add_text(x = .68, y = .061, word = "Other Faith: 6.2%", sz = 4.5) +
add_text(x = .68, y = .016, word = "Jewish: 1.6%", sz = 4.5) +
add_text(x = 2.26, y = .044, word = "Mainline: 4.4%", sz = 4.5) +
add_text(x = 2.3, y = .063, word = "Black Prot.: 6.4%", sz = 4.5) +
add_text(x = 2.3, y = .068, word = "Other Faith: 6.6%", sz = 4.5) +
add_text(x = 2.23, y = .015, word = "Jewish: 1.5%", sz = 4.5) +
geom_text(label="2018", x=1, y=.125, hjust=1.1, size=5, family = "font") +
geom_text(label="Proj.\n2030", x=2, y=.125, hjust=-.1, size=5, family = "font") +
theme_gg("Abel") +
theme(panel.background = element_blank(),
panel.grid = element_blank(),
axis.ticks = element_blank(),
axis.text.x = element_blank(),
panel.border = element_blank()) +
labs(x = "", y = "", title = "Projecting the Four Smaller Traditions", caption = "@ryanburge\nData: GSS 1972-2018") +
ggsave("E://slope_predict2.png")
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.