ct_selection_untitled-6C6D0368.R

library(googlesheets4)

abc <- range_speedread("https://docs.google.com/spreadsheets/d/1hGhLAEV7nS--HtZwbk3zzmC-gDudN6o3Ol4nF8OxcWI/edit?usp=sharing", sheet = 2)

abc$members <- str_replace_all(abc$members, ",", "")
abc$members <- as.numeric(abc$members)

ucc <- range_speedread("https://docs.google.com/spreadsheets/d/1hGhLAEV7nS--HtZwbk3zzmC-gDudN6o3Ol4nF8OxcWI/edit?usp=sharing", sheet = 3)

ucc$members <- str_replace_all(ucc$members, ",", "")
ucc$members <- as.numeric(ucc$members)

pcu <- range_speedread("https://docs.google.com/spreadsheets/d/1hGhLAEV7nS--HtZwbk3zzmC-gDudN6o3Ol4nF8OxcWI/edit?usp=sharing", sheet = 4)

pcu$members <- str_replace_all(pcu$members, ",", "")
pcu$members <- as.numeric(pcu$members)

umc <- range_speedread("https://docs.google.com/spreadsheets/d/1hGhLAEV7nS--HtZwbk3zzmC-gDudN6o3Ol4nF8OxcWI/edit?usp=sharing", sheet = 5)

umc$members <- str_replace_all(umc$members, ",", "")
umc$members <- as.numeric(umc$members)


tec <- range_speedread("https://docs.google.com/spreadsheets/d/1hGhLAEV7nS--HtZwbk3zzmC-gDudN6o3Ol4nF8OxcWI/edit?usp=sharing", sheet = 6)

tec$members <- str_replace_all(tec$members, ",", "")
tec$members <- as.numeric(tec$members)

elca <- range_speedread("https://docs.google.com/spreadsheets/d/1hGhLAEV7nS--HtZwbk3zzmC-gDudN6o3Ol4nF8OxcWI/edit?usp=sharing", sheet = 7)

elca$members <- str_replace_all(elca$members, ",", "")
elca$members <- as.numeric(elca$members)


aog <- range_speedread("https://docs.google.com/spreadsheets/d/1hGhLAEV7nS--HtZwbk3zzmC-gDudN6o3Ol4nF8OxcWI/edit?usp=sharing", sheet = 8)

aog$members <- str_replace_all(aog$members, ",", "")
aog$members <- as.numeric(aog$members)


sbc <- range_speedread("https://docs.google.com/spreadsheets/d/1hGhLAEV7nS--HtZwbk3zzmC-gDudN6o3Ol4nF8OxcWI/edit?usp=sharing", sheet = 9)

sbc$members <- str_replace_all(sbc$members, ",", "")
sbc$members <- as.numeric(sbc$members)


pca <- range_speedread("https://docs.google.com/spreadsheets/d/1hGhLAEV7nS--HtZwbk3zzmC-gDudN6o3Ol4nF8OxcWI/edit?usp=sharing", sheet = 10)

pca$members <- str_replace_all(pca$members, ",", "")
pca$members <- as.numeric(pca$members)

graph <- bind_rows(abc, ucc, pcu, umc, tec, elca, aog, sbc, pca)


left <- graph %>% filter(year == 1987) %>% select(mem87 = members, denom)
right <- graph %>% filter(year == 2020) %>% select(mem20 = members, denom)

both <- left_join(left, right)

lab <- both %>% 
  mutate(decrease = (mem87 - mem20)/mem87 * 100) %>% 
  mutate(decrease = round(decrease, 0)) %>% 
  mutate(decrease = decrease*-1) %>% 
  mutate(decrease = paste0(decrease, "%")) %>% 
  select(denom, decrease)

lab$pos <- c(1200000, 950000, 1500000, 6750000, 1750000, 3500000, 3000000, 14000000, 350000)

graph %>%  
  filter(year >= 1987) %>% 
  ggplot(., aes(x = year, y = members, color = denom)) +
  geom_point(stroke = 1, shape = 21, alpha = .25) + 
  geom_smooth(se = FALSE) +
  scale_color_gdocs() +
  facet_wrap(~ denom, scales = "free_y") +
  scale_y_continuous(labels = unit_format(unit = "M", scale = 1e-6)) +
  labs(x = "Year", y = "Total Membership", title = "The Decline in Membership of Nine Protestant Traditions", caption = "@ryanburge\nData: Denominational Records") +
  theme_rb() +
  theme(strip.text.x = element_text(size = 18)) +
  geom_text(x = 1994, aes(label = decrease, y = pos), data = lab, color = "black", family = "font", size = 6)
save("all_decline_new.png")






library(googlesheets4)


abc <- range_speedread("https://docs.google.com/spreadsheets/d/1hGhLAEV7nS--HtZwbk3zzmC-gDudN6o3Ol4nF8OxcWI/edit?usp=sharing", sheet = 2)

abc$members <- str_replace_all(abc$members, ",", "")
abc$members <- as.numeric(abc$members)

ucc <- range_speedread("https://docs.google.com/spreadsheets/d/1hGhLAEV7nS--HtZwbk3zzmC-gDudN6o3Ol4nF8OxcWI/edit?usp=sharing", sheet = 3)

ucc$members <- str_replace_all(ucc$members, ",", "")
ucc$members <- as.numeric(ucc$members)

pcu <- range_speedread("https://docs.google.com/spreadsheets/d/1hGhLAEV7nS--HtZwbk3zzmC-gDudN6o3Ol4nF8OxcWI/edit?usp=sharing", sheet = 4)

pcu$members <- str_replace_all(pcu$members, ",", "")
pcu$members <- as.numeric(pcu$members)

umc <- range_speedread("https://docs.google.com/spreadsheets/d/1hGhLAEV7nS--HtZwbk3zzmC-gDudN6o3Ol4nF8OxcWI/edit?usp=sharing", sheet = 5)

umc$members <- str_replace_all(umc$members, ",", "")
umc$members <- as.numeric(umc$members)


tec <- range_speedread("https://docs.google.com/spreadsheets/d/1hGhLAEV7nS--HtZwbk3zzmC-gDudN6o3Ol4nF8OxcWI/edit?usp=sharing", sheet = 6)

tec$members <- str_replace_all(tec$members, ",", "")
tec$members <- as.numeric(tec$members)

elca <- range_speedread("https://docs.google.com/spreadsheets/d/1hGhLAEV7nS--HtZwbk3zzmC-gDudN6o3Ol4nF8OxcWI/edit?usp=sharing", sheet = 7)

elca$members <- str_replace_all(elca$members, ",", "")
elca$members <- as.numeric(elca$members)


aog <- range_speedread("https://docs.google.com/spreadsheets/d/1hGhLAEV7nS--HtZwbk3zzmC-gDudN6o3Ol4nF8OxcWI/edit?usp=sharing", sheet = 8)

aog$members <- str_replace_all(aog$members, ",", "")
aog$members <- as.numeric(aog$members)


sbc <- range_speedread("https://docs.google.com/spreadsheets/d/1hGhLAEV7nS--HtZwbk3zzmC-gDudN6o3Ol4nF8OxcWI/edit?usp=sharing", sheet = 9)

sbc$members <- str_replace_all(sbc$members, ",", "")
sbc$members <- as.numeric(sbc$members)


pca <- range_speedread("https://docs.google.com/spreadsheets/d/1hGhLAEV7nS--HtZwbk3zzmC-gDudN6o3Ol4nF8OxcWI/edit?usp=sharing", sheet = 10)

pca$members <- str_replace_all(pca$members, ",", "")
pca$members <- as.numeric(pca$members)

graph <- bind_rows(abc, ucc, pcu, umc, tec, elca, aog, sbc)



graph <- graph %>% 
  mutate(numdrop=(members-lag(members))) %>% 
  mutate(yoy=(members-lag(members))/lag(members)) 

pop <- read_csv("D://cen_pop.csv")

pop <- pop %>% 
  mutate(yoy=(pop-lag(pop))/lag(pop)) %>% 
  mutate(denom = "Overall Population") %>% 
  rename(members = pop)

all <- bind_rows(graph, pop) %>% 
  mutate(denom = as.factor(denom))

all <- all %>%  mutate(denom=relevel(denom,ref="Overall Population"))




all %>% 
  filter(year >= 1990) %>% 
  ggplot(., aes(x = year, y = yoy, color = denom, group = denom)) +
  geom_smooth(se = FALSE) +
  facet_wrap(~ denom) +
  geom_hline(yintercept = 0, linetype = "twodash") + 
  scale_color_manual(values = c(met.brewer("Johnson", 9))) +
  theme_rb() +
  scale_y_continuous(labels = percent) +
  theme(strip.text = element_text(size = 20)) +
  labs(x = "Year", y  = "", title = "Year over Year % Change in Size of Membership", caption = "@ryanburge\nData: Denominational Records")
save("denom_yoy_shifts.png", ht = 8)

act <- graph %>% 
  filter(year == 2021) %>% 
  select(denom, value = members) %>% 
  mutate(name = "actual")

new <- graph %>% 
  filter(year == 1990) %>% 
  mutate(project = members*1.33) %>% 
  select(-year) %>% 
  pivot_longer(!denom)

new1 <- graph %>% 
  filter(year == 1990) %>% 
  select(-year) %>% 
  mutate(name = "members1") %>% 
  rename(value = members)


gg <- bind_rows(new, act, new1) %>% arrange(denom)

gg <- gg %>% 
  mutate(year = case_when(name == "members" ~ 1990, 
                        name == "members1" ~ 1990,
                       name == "project" ~ 2021, 
                       name == "actual"  ~ 2021))


gg$grp <- c("a", "a", "b", "b", "a", "a", "b", "b","a", "a", "b", "b","a", "a", "b", "b","a", "a", "b", "b","a", "a", "b", "b","a", "a", "b", "b","a", "a", "b", "b","a", "a", "b", "b")

gg <- gg %>% 
   mutate(label = frcode(grp == "a" ~ "Projection", 
                         grp == "b" ~ "Actual"))

gg %>% 
  ggplot(., aes(x = year, y = value, group = label, color = label)) +
  geom_line() + 
  geom_point(stroke = 1, shape = 21, fill = "white") + 
  # geom_labelsmooth(aes(label = label, linetype = label),  method = "loess", formula = y ~ x, family = "font", linewidth = 1, text_smoothing = 30, size = 4, linewidth = 1, boxlinewidth = 0.3) +
  facet_wrap(~ denom, scale = "free_y") +
  scale_y_continuous(labels = scales::unit_format(unit = "M", scale = 1e-6)) +
  labs(x = "Year", y = "", title = "How Large Would Denominations Be If They Kept Pace With Population Growth?", 
       subtitle = "Projection Using 1990-2021 Census Population Data", 
       caption = "@ryanburge\nData: Denominational Records") +
  scale_color_calc() +
  theme_rb(legend = TRUE)
save("project_denoms.png")


gg %>% 
  mutate(lab = value/1000000) %>% 
  mutate(lab = round(lab, 1)) %>% 
  filter(name == "actual" | name == "project") %>% 
  ggplot(., aes(x = label, y = value, fill = label)) +
  geom_col(color = "black") +
  facet_wrap(~ denom) +
  scale_y_continuous(labels = scales::unit_format(unit = "M", scale = 1e-6), limits = c(0, 23000000)) +
  scale_fill_calc() +
  theme_rb() +
  theme(strip.text = element_text(size = 20)) +
  geom_text(aes(y = value + 1950000, label = lab), position = position_dodge(width = .9), size = 9, family = "font") +
  labs(x = "", y= "Number of Members (in Millions)", title = "Projected vs Actual Size of Denominations in 2021", 
       subtitle = "Projection Using 1990-2021 Census Population Data", 
       caption = "@ryanburge\nData: Denominational Records") 
save("project_actual_bars.png", ht = 9, wd = 6)

graph <- bind_rows(abc, ucc, pcu, umc, tec, elca, aog, sbc, pca)

  

one <- graph %>% 
  filter(year >= 1990) %>% 
  select(year, denom,  members) %>% 
  mutate(name = "Actual")


pop <- read_csv("D://cen_pop.csv") %>% filter(year >= 1990)


pop <- pop %>% 
  mutate(change = cumsum((pop - lag(pop, default = first(pop))) / lag(pop, default = first(pop)))) %>% 
  mutate(change = change + 1)


joined <- left_join(graph, pop) %>% filter(year >= 1990)

all <- range_speedread("https://docs.google.com/spreadsheets/d/1KA1yMoXe9px8v-w3qVDzA4-1bZHbMx7wSrM4ov5sK3c/edit?usp=sharing")


joined <- left_join(all, pop) %>% filter(year >= 1990)

two <- joined %>% 
  filter(year >= 1990) %>% 
  mutate(members = members*change) %>% 
  select(year, denom, members) %>% 
  mutate(name = "Projection")

final <- bind_rows(one, two) 

final %>% 
  ggplot(., aes(x = year, y = members, color = name, group = name)) +
  geom_line( ) +
  geom_point(stroke = .5, shape = 21, fill = 'white', size = .85)  +
  facet_wrap(~ denom, scale = "free_y") +
  scale_y_continuous(labels = scales::unit_format(unit = "M", scale = 1e-6)) +
  labs(x = "Year", y = "", title = "How Large Would Denominations Be If They Kept Pace With Population Growth?", 
       subtitle = "Projection Using 1990-2021 Census Population Data", 
       caption = "@ryanburge\nData: Denominational Records") +
  scale_color_calc() +
  theme_rb(legend = TRUE)
save("project_denoms.png")