Projecting the Future of American Religion

projecting_religion.R

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")