Episcopal Church Decline - RiP July 2021

episcopal_decline_rip_2021.R

library(googlesheets4) 
library(lubridate)

clean <- read_sheet("https://docs.google.com/spreadsheets/d/1hy0Wa-BKt6XTAuqj6uxQyyCwJ6mN6_Xtv2NBz9_R8RA/edit?usp=sharing")

att <- clean %>% 
  filter(type == "att") %>% 
  mutate(change = (value - lag(value))/lag(value)) 

att <- att %>% 
  mutate(pct = change * 100) %>% 
  mutate(pct = round(pct, 1)) %>% 
  mutate(pct = paste0(pct, "%")) %>% 
  mutate(lab = value/1000) %>% 
  mutate(lab = round(lab, 0)) %>% 
  mutate(lab = paste0(lab, "K"))

att %>% 
  ggplot(., aes(x = factor(year), y = value, fill = value)) +
  geom_col(color = "black") +
  theme_rb() +
  scale_fill_gradient(high = "#7303c0", low = "#fdeff9") +
  geom_text(aes(y = value + 20000, label = lab), position = position_dodge(width = .9), size = 4, family = "font") +
  geom_text(aes(y = 30000, label = ifelse(pct != "NA%", pct, '')), position = position_dodge(width = .9), size = 4, family = "font") +
  scale_y_continuous(labels = label_number(suffix = "K", scale = 1e-3)) +
  labs(x = "Year", y = "", title = "Sunday Church Attendance for the Episcopalians", caption = "@ryanburge\nData: https://www.generalconvention.org/parochialreportresults") +
  ggsave("E://epis_attend.png", type = "cairo-png")

off <- clean %>% 
  filter(type == "offering") %>% 
  mutate(lab = value/1000000000) %>% 
  mutate(lab = round(lab, 2)) %>% 
  mutate(lab = paste0(lab, "B"))

off %>% 
  ggplot(., aes(x = factor(year), y = value, fill = value)) +
  geom_col(color = "black") +
  scale_y_continuous(labels = label_number(suffix = "B", scale = 1e-9)) +
  geom_text(aes(y = value + 60000000, label = lab), position = position_dodge(width = .9), size = 6, family = "font") +
  theme_rb() +
  scale_fill_gradient(low = "#B06AB3", high = "#4568DC") +
  labs(x = "", y = "", title = "Plate and Pledge Annual Totals for TEC", caption = "@ryanburge\nData: https://www.generalconvention.org/parochialreportresults") +
  ggsave("E://tec_offering.png", type = 'cairo-png')

att <- clean %>% 
  filter(type == "att") %>% 
  select(year, att = value)

off <- clean %>% 
  filter(type == "offering") %>% 
  select(year, off = value)

graph <- left_join(att, off) %>% 
  na.omit() %>% 
  mutate(give = off/att) %>% 
  mutate(give = round(give, 0)) %>% 
  mutate(lab = paste0("$", give))
  
graph %>% 
  ggplot(., aes(x = factor(year), y = give, fill = give)) +
  geom_col(color = "black") +
  geom_text(aes(y = give + 100, label = lab), position = position_dodge(width = .9), size = 6, family = "font") +
  theme_rb() +
  scale_y_continuous(labels=scales::dollar_format()) +
  scale_fill_gradient(low = "#493240", high = "#FF0099") +
  labs(x = "", y = "", title = "Annual Offering per Weekly Attender", caption = "@ryanburge\nData: https://www.generalconvention.org/parochialreportresults") +
  ggsave("E://tec_offering_by_att.png", type = 'cairo-png')
  

clean %>% 
  filter(type == "baptisms" | type == "marriages") %>% 
  ggplot(., aes(x = year, y = value, group = type, color = type, linetype = type)) +
  xlim(1980, 2030) +
  stat_smooth(method="lm", fullrange=TRUE, se = FALSE, alpha = .2) +
  theme_rb() +
  scale_color_gdocs() +
  add_text(x = 2012, y =  35000, word = "Baptisms", sz = 5) +
  add_text(x = 2012, y =  18000, word = "Weddings", sz = 5) +
  geom_vline(xintercept = 2019, linetype = "twodash") +
  add_text(x = 2024, y = 53000, word = "Projection\nBegins", sz = 5) +
  labs(x = "", y = "", title = "Baptisms and Weddings in the Episcopal Church", caption = "@ryanburge\nData: https://livingchurch.org/covenant/2021/01/11/the-episcopal-church-in-2050/") +
  ggsave("E://bapt_marr_tec.png", type = "cairo-png")