ct_selection_untitled-32C8D2AF.R

gg1 <- gss %>% 
  filter(race == 1) %>% 
  filter(year <= 2018) %>% 
  mutate(rel = frcode(reltrad == 1 ~ "Evangelical", 
         reltrad == 4 ~ "Catholics")) %>% 
  mutate(cons = case_when(polviews == 5 | polviews == 6 | polviews == 7 ~ 1,
                          polviews <= 4 ~ 0)) %>% 
  group_by(rel, year) %>% 
  mean_ci(cons, wt = wtssall, ci = .84) 

gg2 <- gss %>% 
  filter(race == 1) %>% 
  filter(year > 2018) %>% 
  mutate(rel = frcode(reltrad == 1 ~ "Evangelical", 
                      reltrad == 4 ~ "Catholics")) %>% 
  mutate(cons = case_when(polviews == 5 | polviews == 6 | polviews == 7 ~ 1,
                          polviews <= 4 ~ 0)) %>% 
  group_by(rel, year) %>% 
  mean_ci(cons, wt = wtssnrps, ci = .84) 

one <- bind_rows(gg1, gg2) %>% mutate(type = "All Attendance Levels")


gg1 <- gss %>% 
  filter(race == 1) %>% 
  filter(attend >= 6) %>% 
  filter(year <= 2018) %>% 
  mutate(rel = frcode(reltrad == 1 ~ "Evangelical", 
                      reltrad == 4 ~ "Catholics")) %>% 
  mutate(cons = case_when(polviews == 5 | polviews == 6 | polviews == 7 ~ 1,
                          polviews <= 4 ~ 0)) %>% 
  group_by(rel, year) %>% 
  mean_ci(cons, wt = wtssall, ci = .84) 

gg2 <- gss %>% 
  filter(race == 1) %>% 
  filter(attend >= 6) %>% 
  filter(year > 2018) %>% 
  mutate(rel = frcode(reltrad == 1 ~ "Evangelical", 
                      reltrad == 4 ~ "Catholics")) %>% 
  mutate(cons = case_when(polviews == 5 | polviews == 6 | polviews == 7 ~ 1,
                          polviews <= 4 ~ 0)) %>% 
  group_by(rel, year) %>% 
  mean_ci(cons, wt = wtssnrps, ci = .84) 

two <- bind_rows(gg1, gg2) %>% mutate(type = "Weekly Attendance")

aa <- bind_rows(one, two)



labels_left <- aa %>% 
  filter(rel != "NA") %>% 
  group_by(rel, type) %>% 
  filter(!is.na(mean)) %>% 
  filter(year == min(year))

labels_right <- aa %>% 
  filter(rel != "NA") %>% 
  group_by(rel, type) %>% 
  filter(!is.na(mean)) %>% 
  filter(year == max(year))

aa %>% 
  filter(rel != "NA") %>% 
  ggplot(., aes(x = year, y = mean, color = rel, fill = rel, group = rel)) +
  geom_ribbon(aes(ymin = lower, ymax = upper), alpha = 0.15, color = NA) +
  geom_line() + 
  geom_text(data = labels_left, aes(label = paste0(round(mean * 100), "%")),
            hjust = 1.2, size = 5, family = "bold", show.legend = FALSE) +
  geom_text(data = labels_right, aes(label = paste0(round(mean * 100), "%")),
            hjust = -0.2, size = 5, family = "bold", show.legend = FALSE) +
  theme_rb(legend = TRUE) +
  facet_wrap(~ type) +
  scale_color_calc() +
  scale_fill_calc() +
  y_pct() + 
  scale_x_continuous(expand = expansion(mult = 0.15)) +
  theme(legend.text = element_text(size = 20)) +
  labs(x = "Year", y = "", title = "Share of White Evangelicals and Catholics Who Identify as Politically Conservative", 
       caption = "@ryanburge | Data: General Social Survey, 1972-2024")
save("gss_white_ev_cath_cons.png")




gg1 <- gss %>% 
  filter(race == 1) %>% 
  filter(year <= 2018) %>% 
  mutate(rel = frcode(reltrad == 1 ~ "Evangelical", 
                      reltrad == 4 ~ "Catholics")) %>% 
  mutate(weekly = as.integer(attend >= 6)) %>% 
  group_by(rel, year) %>% 
  mean_ci(weekly, wt = wtssall, ci = .84) 

gg2 <- gss %>% 
  filter(race == 1) %>% 
  filter(year > 2018) %>% 
  mutate(rel = frcode(reltrad == 1 ~ "Evangelical", 
                      reltrad == 4 ~ "Catholics")) %>% 
  mutate(weekly = as.integer(attend >= 6)) %>% 
  group_by(rel, year) %>% 
  mean_ci(weekly, wt = wtssnrps, ci = .84) 

att <- bind_rows(gg1, gg2)

labels_left <- att %>% 
  filter(rel != "NA") %>% 
  group_by(rel) %>% 
  filter(!is.na(mean)) %>% 
  filter(year == min(year))

labels_right <- att %>% 
  filter(rel != "NA") %>% 
  group_by(rel) %>% 
  filter(!is.na(mean)) %>% 
  filter(year == max(year))

att %>% 
  filter(rel != "NA") %>% 
  ggplot(., aes(x = year, y = mean, color = rel, fill = rel, group = rel)) +
  geom_ribbon(aes(ymin = lower, ymax = upper), alpha = 0.15, color = NA) +
  geom_line() + 
  geom_text(data = labels_left, aes(label = paste0(round(mean * 100), "%")),
            hjust = 1.2, size = 6.5, show.legend = FALSE, family = "bold") +
  geom_text(data = labels_right, aes(label = paste0(round(mean * 100), "%")),
            hjust = -0.2, size = 6.5, show.legend = FALSE, family = "bold") +
  theme_rb(legend = TRUE) +
  scale_color_calc() +
  scale_fill_calc() +
  y_pct() + 
  scale_x_continuous(expand = expansion(mult = 0.15)) +
  theme(legend.text = element_text(size = 20)) +
  labs(x = "Year", y = "", title = "Share of White Evangelicals and Catholics Who Attend Weekly or More", 
       caption = "@ryanburge | Data: General Social Survey, 1972-2024")
save("gss_white_ev_cath_attend.png")



make_gss <- function(attend_filter = NULL, cons_filter = FALSE) {
  
  base <- gss %>% 
    filter(race == 1) %>% 
    mutate(rel = frcode(reltrad == 1 ~ "Evangelical", 
                        reltrad == 4 ~ "Catholics")) %>% 
    mutate(abort = case_when(abany == 1 ~ 1,
                             abany == 2 ~ 0)) %>%
    mutate(cons = as.integer(polviews >= 5))
  
  if (!is.null(attend_filter)) base <- base %>% filter(attend >= attend_filter)
  if (cons_filter) base <- base %>% filter(cons == 1)
  
  gg1 <- base %>% filter(year <= 2018) %>% group_by(rel, year) %>% mean_ci(abort, wt = wtssall, ci = .84)
  gg2 <- base %>% filter(year > 2018) %>% group_by(rel, year) %>% mean_ci(abort, wt = wtssnrps, ci = .84)
  bind_rows(gg1, gg2)
}

one   <- make_gss() %>% mutate(type = "Full Sample")
two   <- make_gss(attend_filter = 6) %>% mutate(type = "Weekly Attenders")
three <- make_gss(attend_filter = 6, cons_filter = TRUE) %>% mutate(type = "Weekly Attenders + Conservative")

aa <- bind_rows(one, two, three) %>% 
  mutate(type = frcode(type == "Full Sample" ~ "Full Sample",
                       type == "Weekly Attenders" ~ "Weekly Attenders",
                       type == "Weekly Attenders + Conservative" ~ "Weekly Attenders + Conservative"))

labels_left <- aa %>% 
  filter(!is.na(rel), rel != "NA") %>% 
  filter(!is.na(mean)) %>% 
  group_by(rel, type) %>% 
  slice_min(year, n = 1)

labels_right <- aa %>% 
  filter(!is.na(rel), rel != "NA") %>% 
  filter(!is.na(mean)) %>% 
  group_by(rel, type) %>% 
  slice_max(year, n = 1)

library(zoo)

aa_interp <- aa %>% 
  filter(rel != "NA") %>% 
  group_by(rel, type) %>% 
  complete(year = full_seq(year, 1)) %>% 
  mutate(across(c(mean, lower, upper), ~ na.approx(., na.rm = FALSE))) %>% 
  filter(!is.na(mean))

aa_interp %>% 
  ggplot(., aes(x = year, y = mean, color = rel, fill = rel, group = rel)) +
  geom_ribbon(aes(ymin = lower, ymax = upper), alpha = 0.15, color = NA) +
  geom_line() +
  geom_text(data = labels_left, aes(label = paste0(round(mean * 100), "%")),
            hjust = 1.2, size = 5, show.legend = FALSE, family = "bold") +
  geom_text(data = labels_right, aes(label = paste0(round(mean * 100), "%")),
            hjust = -0.2, size = 5, show.legend = FALSE, family = "bold") +
  theme_rb(legend = TRUE) +
  facet_wrap(~ type, ncol = 1) +
  scale_color_calc() +
  scale_fill_calc() +
  y_pct() +
  scale_x_continuous(expand = expansion(mult = 0.15)) +
  theme(legend.text = element_text(size = 20)) +
  labs(x = "Year", y = "", 
       title = "Support for Abortion Access Among White Christians",
       caption = "@ryanburge | Data: General Social Survey, 1972-2024")
save("gss_white_ev_cath_abany.png", ht = 10, wd = 6)


make_gss <- function(attend_filter = NULL, cons_filter = FALSE) {
  
  base <- gss %>% 
    filter(race == 1) %>% 
    mutate(rel = frcode(reltrad == 1 ~ "Evangelical", 
                        reltrad == 4 ~ "Catholics")) %>% 
    mutate(same_sex = coalesce(marsame, marsame1)) %>% 
    mutate(marry = case_when(same_sex %in% c(1, 2) ~ 1,
                             same_sex %in% c(3, 4, 5) ~ 0)) %>% 
    mutate(cons = as.integer(polviews >= 5))
  
  if (!is.null(attend_filter)) base <- base %>% filter(attend >= attend_filter)
  if (cons_filter) base <- base %>% filter(cons == 1)
  
  gg1 <- base %>% filter(year <= 2018) %>% group_by(rel, year) %>% mean_ci(marry, wt = wtssall, ci = .84)
  gg2 <- base %>% filter(year > 2018) %>% group_by(rel, year) %>% mean_ci(marry, wt = wtssnrps, ci = .84)
  bind_rows(gg1, gg2)
}

one   <- make_gss() %>% mutate(type = "Full Sample")
two   <- make_gss(attend_filter = 6) %>% mutate(type = "Weekly Attenders")
three <- make_gss(attend_filter = 6, cons_filter = TRUE) %>% mutate(type = "Weekly Attenders + Conservative")

aa <- bind_rows(one, two, three) %>% 
  mutate(type = frcode(type == "Full Sample" ~ "Full Sample",
                       type == "Weekly Attenders" ~ "Weekly Attenders",
                       type == "Weekly Attenders + Conservative" ~ "Weekly Attenders + Conservative"))

aa_interp <- aa %>% 
  filter(rel != "NA") %>% 
  group_by(rel, type) %>% 
  complete(year = full_seq(year, 1)) %>% 
  mutate(across(c(mean, lower, upper), ~ na.approx(., na.rm = FALSE))) %>% 
  filter(!is.na(mean))

labels_left <- aa_interp %>% 
  group_by(rel, type) %>% 
  slice_min(year, n = 1)

labels_right <- aa_interp %>% 
  group_by(rel, type) %>% 
  slice_max(year, n = 1)

aa_interp %>% 
  ggplot(., aes(x = year, y = mean, color = rel, fill = rel, group = rel)) +
  geom_ribbon(aes(ymin = lower, ymax = upper), alpha = 0.15, color = NA) +
  geom_line() +
  geom_text(data = labels_left, aes(label = paste0(round(mean * 100), "%")),
            hjust = 1.2, size = 5, show.legend = FALSE, family = "bold") +
  geom_text(data = labels_right, aes(label = paste0(round(mean * 100), "%")),
            hjust = -0.2, size = 5, show.legend = FALSE, family = "bold") +
  theme_rb(legend = TRUE) +
  facet_wrap(~ type, ncol = 1) +
  scale_color_calc() +
  scale_fill_calc() +
  y_pct() +
  scale_x_continuous(expand = expansion(mult = 0.15)) +
  theme(legend.text = element_text(size = 20)) +
  labs(x = "Year", y = "", 
       title = "Support for Same-Sex Marriage Among White Christians",
       caption = "@ryanburge | Data: General Social Survey")
save("gss_white_ev_cath_marsame.png", ht = 10, wd = 6)


make_gss <- function(attend_filter = NULL, cons_filter = FALSE) {
  
  base <- gss %>% 
    filter(race == 1) %>% 
    mutate(rel = frcode(reltrad == 1 ~ "Evangelical", 
                        reltrad == 4 ~ "Catholics")) %>% 
    mutate(premar = case_when(premarsx == 1 ~ 1,
                              premarsx %in% c(2, 3, 4) ~ 0)) %>%
    mutate(cons = as.integer(polviews >= 5))
  
  if (!is.null(attend_filter)) base <- base %>% filter(attend >= attend_filter)
  if (cons_filter) base <- base %>% filter(cons == 1)
  
  gg1 <- base %>% filter(year <= 2018) %>% group_by(rel, year) %>% mean_ci(premar, wt = wtssall, ci = .84)
  gg2 <- base %>% filter(year > 2018) %>% group_by(rel, year) %>% mean_ci(premar, wt = wtssnrps, ci = .84)
  bind_rows(gg1, gg2)
}

one   <- make_gss() %>% mutate(type = "Full Sample")
two   <- make_gss(attend_filter = 6) %>% mutate(type = "Weekly Attenders")
three <- make_gss(attend_filter = 6, cons_filter = TRUE) %>% mutate(type = "Weekly Attenders + Conservative")

aa <- bind_rows(one, two, three) %>% 
  mutate(type = frcode(type == "Full Sample" ~ "Full Sample",
                       type == "Weekly Attenders" ~ "Weekly Attenders",
                       type == "Weekly Attenders + Conservative" ~ "Weekly Attenders + Conservative"))

aa_interp <- aa %>% 
  filter(rel != "NA") %>% 
  group_by(rel, type) %>% 
  complete(year = full_seq(year, 1)) %>% 
  mutate(across(c(mean, lower, upper), ~ na.approx(., na.rm = FALSE))) %>% 
  filter(!is.na(mean))

labels_left <- aa_interp %>% group_by(rel, type) %>% slice_min(year, n = 1)
labels_right <- aa_interp %>% group_by(rel, type) %>% slice_max(year, n = 1)


aa_interp %>% 
  ggplot(., aes(x = year, y = mean, color = rel, fill = rel, group = rel)) +
  geom_ribbon(aes(ymin = lower, ymax = upper), alpha = 0.15, color = NA) +
  geom_line() +
  geom_text(data = labels_left, aes(label = paste0(round(mean * 100), "%")),
            hjust = 1.2, size = 5, show.legend = FALSE, family = "bold") +
  geom_text(data = labels_right, aes(label = paste0(round(mean * 100), "%")),
            hjust = -0.2, size = 5, show.legend = FALSE, family = "bold") +
  theme_rb(legend = TRUE) +
  facet_wrap(~ type, ncol = 1) +
  scale_color_calc() +
  scale_fill_calc() +
  y_pct() +
  scale_x_continuous(expand = expansion(mult = 0.15)) +
  theme(legend.text = element_text(size = 20)) +
  theme(plot.title = element_text(size = 14)) +
  labs(x = "Year", y = "", 
       title = "Share of White Christians Who Say Premarital Sex is Always Wrong",
       caption = "@ryanburge | Data: General Social Survey, 1972-2024")
save("gss_white_ev_cath_premar.png", ht = 10, wd = 6)



library(broom)
library(ggplot2)

reg_data <- gss %>% 
  filter(race == 1) %>% 
  filter(year >= 2021) %>% 
  mutate(rel = frcode(reltrad == 1 ~ "Evangelical", 
                      reltrad == 4 ~ "Catholics")) %>% 
  mutate(same_sex = coalesce(marsame, marsame1)) %>% 
  mutate(marry  = case_when(same_sex %in% c(1, 2) ~ 1, same_sex %in% c(3, 4, 5) ~ 0),
         abort  = case_when(abany == 1 ~ 1, abany == 2 ~ 0),
         premar = case_when(premarsx == 1 ~ 0, premarsx %in% c(2, 3, 4) ~ 1)) %>% 
  mutate(female      = as.integer(sex == 2),
         weekly      = as.integer(attend >= 6),
         cons        = as.integer(polviews >= 5),
         age         = ifelse(age > 89, NA, age),
         evangelical = as.integer(reltrad == 1),
         catholic    = as.integer(reltrad == 4))

run_model <- function(dv) {
  formula <- as.formula(paste(dv, "~ evangelical + catholic + female + age + weekly + cons"))
  lm(formula, data = reg_data, weights = wtssnrps) %>% 
    tidy(conf.int = TRUE, conf.level = 0.84) %>% 
    filter(term != "(Intercept)") %>% 
    mutate(dv = dv)
}

results <- bind_rows(
  run_model("abort"),
  run_model("marry"),
  run_model("premar")
) %>% 
  mutate(term = frcode(term == "evangelical" ~ "Evangelical",
                       term == "catholic"    ~ "Catholic",
                       term == "female"      ~ "Female",
                       term == "age"         ~ "Age",
                       term == "weekly"      ~ "Weekly Attender",
                       term == "cons"        ~ "Conservative"),
         dv = frcode(dv == "abort"  ~ "Abortion Access",
                     dv == "marry"  ~ "Same-Sex Marriage",
                     dv == "premar" ~ "Premarital Sex Always Wrong"))

results %>% 
  ggplot(aes(x = estimate, y = term, color = dv, group = dv)) +
  geom_vline(xintercept = 0, linetype = "dashed", color = "gray50") +
  geom_errorbarh(aes(xmin = conf.low, xmax = conf.high), 
                 height = 0.2, position = position_dodge(width = 0.5)) +
  geom_point(position = position_dodge(width = 0.5), size = 2.5) +
  theme_rb(legend = TRUE) +
  theme(legend.text = element_text(size = 14)) +
  labs(x = "Coefficient (OLS)", y = "", 
       title = "Predictors of Social Attitudes Among White Americans",
       subtitle = "GSS 2021-2024 | Reference category: Non-Evangelical, Non-Catholic",
       caption = "@ryanburge | Data: General Social Survey, 2021-2024")
save("gss_white_reg_social.png", ht = 7, wd = 9)


results %>% 
  filter(term %in% c("Evangelical", "Catholic")) %>% 
  ggplot(aes(x = estimate, y = dv, color = term, group = term)) +
  geom_vline(xintercept = 0, linetype = "dashed", color = "gray50") +
  geom_errorbarh(aes(xmin = conf.low, xmax = conf.high), 
                 height = 0, position = position_dodge(width = 0.5)) +
  geom_point(position = position_dodge(width = 0.5), size = 5, stroke = 2, shape = 21, fill = 'white') +
  theme_rb(legend = TRUE) +
  scale_color_calc() +
  theme(legend.text = element_text(size = 14)) +
  labs(x = "Coefficient (OLS)", y = "", 
       title = "Religious Tradition as a Predictor of Social Attitudes",
       subtitle = "Controlling for gender, age, attendance, and ideology",
       caption = "@ryanburge | Data: General Social Survey, 2021-2024")
save("gss_white_reg_social.png")