Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Episcopal Church Decline - RiP July 2021
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")
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment