ct_selection_untitled-33177AF1.R

library(googlesheets4)


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)

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


pcu %>% 
  ggplot(., aes(x = year, y = members)) +
  geom_line() +
  geom_point(stroke = .5, shape = 21, fill = "white") +
  theme_rb() +
  add_text(x = 1984, y = 3200000, word = "3.1M", sz = 6) +
  add_text(x = 2022, y = 1000000, word = "1.1M", sz = 6) +
  scale_y_continuous(labels = label_number(suffix = " M", scale = 1e-6), limits = c(0, 3250000)) +
  labs(x = "Year", y = "", title = "Reported Memebership of the Presbyterian Church (USA)", caption = "@ryanburge\nData: Denominational Records (1984-2022)")
save("pcusa_membership2022.png")

pcu %>% 
  ggplot(., aes(x = year, y = yoy*-1)) +
  geom_line() +
  geom_point(stroke = .5, shape = 21, fill = "white") +
  theme_rb()  +
  scale_y_continuous(labels = percent, limits = c(0, .065)) +
  labs(x = "Year", y = "", title = "Year Over Year % Decline in Membership of the Presbyterian Church (USA)", caption = "@ryanburge\nData: Denominational Records (1984-2022)")
save("yoy_decline_pcusa.png")

pcu <- pcu %>% 
  mutate(proj=(lag(members)*.96)) 

pcu %>% 
  ggplot(., aes(x = year, y = proj)) +
  geom_point(stroke = .5, shape = 21) + 
  xlim(1985,2050) +
  stat_smooth(method="lm", fullrange=TRUE, linetype = "twodash", alpha = .2, color = "firebrick1") +
  scale_y_continuous(labels = label_number(suffix = " M", scale = 1e-6), limits = c(0, 3250000)) +
  theme_rb() +
  labs(x = "Year", y = "", title = "Projection Membership of the Presbyterian Church (USA) through 2050", caption = "@ryanburge\nData: Denominational Records (1984-2022)")
save("projection_pcusa.png")

library(rio)
library(readxl)
library(janitor)
library(urbnmapr)

rel10 <- import("D://relcensus.DTA")

pc10 <- rel10 %>% 
  select(fips, pcrate10 = pcrate, pcadh10 = pcadh) %>% 
  mutate(pcrate10 = pcrate10/1000) %>% 
  as_tibble()

cen20 <- read_excel("E://data/rel_cen20.xlsx", sheet = 3) %>% 
  clean_names() 

pc20 <- cen20 %>% 
  filter(group_name == "Presbyterian Church (U.S.A.)") %>% 
  select(fips, pcrate20 = adherents_as_percent_of_total_population, pcadh20 = adherents) %>% 
  mutate(fips = as.numeric(fips))

both <- left_join(pc10, pc20) %>% 
  mutate(adh = (pcadh10 - pcadh20)/pcadh10) %>% 
  mutate(adh = adh*-1)

both <- both %>% 
  mutate(bins = frcode(adh <= -.5 ~ 'More Than 50%', 
                       adh <= -.25 & adh >= -.4999 ~ "25%-50%", 
                       adh <= -.10 & adh >= -.2499 ~ "10%-25%", 
                       adh <=    0 & adh >= -.0999 ~ "0-10%", 
                       adh > 0 ~ "Any Increase",
                       TRUE ~ "No Data")) %>% filter(bins != 'NA')


territories_counties <- get_urbn_map(map = "territories_counties")

territories_counties <-  territories_counties %>% 
  mutate(fips =  as.numeric(county_fips))

joined <- left_join(territories_counties, both) %>% filter(bins != "NA")



joined %>% 
  ggplot(aes(long, lat, group = group, fill = bins)) +
  geom_polygon(color = "white", linewidth = 0.05) +
  coord_map(projection = "albers", lat0 = 39, lat1 = 45) +
  labs(title  = "      Decline in Number of PCUSA Members, 2020 vs 2010", caption = "@ryanburge\nData: Religion Census, 2010 + 2020", fill = "") +
  theme(legend.title = element_text(), legend.key.width = unit(.5, "in")) +
  urbnthemes::theme_urbn_map() +
  scale_fill_manual(values = c(  "#d62828", "#f77f00", "#fcbf49", "#eae2b7", "#003049", "azure3")) +
  theme(plot.title = element_text(size=20, family= "font", face= "bold")) +
  theme(plot.caption = element_text(size = 14, family="font")) +
  theme(legend.text = element_text(size = 14, family = "font"))
save("pcusa_decline.png")