acbass49/35_who_is_moving.r

## 35_who_is_moving.r
# Who is Moving? Demographic Realignment Among Ex-Mormons (2007–2024)
# Analyzing Pew RLS 2007, 2014, and 2024 waves to figure out which ex-Mormons
# are driving the Republican shift.

library(tidyverse)
library(haven)
library(ggtext)
library(showtext)

# ── Fonts & Styling ──────────────────────────────────────────────────────────

font_add("Cairo_bold", "~/Library/Fonts/Cairo-Bold.ttf")
font_add("Cairo",      "~/Library/Fonts/Cairo-Regular.ttf")
showtext_auto(enable = TRUE)
showtext_opts(dpi = 300)

mm_theme <- theme(
  axis.ticks              = element_blank(),
  axis.title              = element_text(size = 12, family = "Cairo_bold"),
  axis.text.y             = element_text(size = 10),
  axis.text.x             = element_text(size = 10, margin = margin(t = 6)),
  plot.background         = element_rect(fill = "grey95", color = "black", linewidth = 0.5),
  panel.background        = element_blank(),
  text                    = element_text(family = "Cairo", size = 10),
  plot.title              = element_text(size = 15.5, hjust = 0.5, family = "Cairo_bold"),
  plot.subtitle           = element_textbox_simple(size = 10, halign = 0.5, family = "Cairo",
                                                   margin = margin(b = 8)),
  plot.title.position     = "plot",
  plot.subtitle.position  = "plot",
  legend.background       = element_blank(),
  legend.box.background   = element_blank(),
  legend.position         = "top",
  legend.title            = element_blank(),
  legend.text             = element_text(size = 10),
  panel.grid              = element_blank(),
  panel.grid.major.y      = element_line(color = "lightgrey", linetype = "solid"),
  plot.caption            = element_text(size = 9, family = "Cairo"),
  plot.margin             = margin(12, 24, 12, 20)
)

# ── Load & Harmonize Data ─────────────────────────────────────────────────────

# 2024 Wave
d24 <- read_sav("./data/rls/rls2024.sav")
ex24 <- d24 |>
  filter(as.character(FRMREL) == "20000", as.numeric(RELTRAD) != 20000) |>
  mutate(
    year       = 2024,
    wt         = as.numeric(WEIGHT),
    # Republican + Leaners
    rep_lean   = (as.numeric(PARTY) == 1) | (as.numeric(PARTY) == 3 & as.numeric(PARTYLN) == 1),
    gender_rc  = if_else(as.numeric(GENDER) == 1, "Male", "Female"),
    college_rc = if_else(as.numeric(EDUCREC) %in% 3:4, "College Grad", "No College Grad"),
    married_rc = if_else(as.numeric(MARITAL) == 1, "Married", "Not Married"),
    income_rc  = case_when(
      as.numeric(INC_SDT1) %in% 5:8 ~ "High Income ($75k+)",
      as.numeric(INC_SDT1) %in% 1:4 ~ "Low/Mid Income (<$75k)",
      TRUE ~ NA_character_
    ),
    cohort_rc  = if_else(as.numeric(BIRTHDECADE) %in% 5:7, "Born 1980 or Later", "Born Before 1980"),
    relimp_rc  = if_else(as.numeric(RELIMP) %in% 1:2, "Religion is Important", "Religion is Not Important"),
    race_rc    = case_when(
      as.numeric(HISP) == 1 ~ "Hispanic",
      as.numeric(HISP) == 2 & as.numeric(RACECMB) == 1 ~ "White non-Hispanic",
      TRUE ~ "Other"
    ),
    ideo_rc    = case_when(
      as.numeric(IDEO) %in% 1:2 ~ "Conservative",
      as.numeric(IDEO) == 3 ~ "Moderate",
      as.numeric(IDEO) %in% 4:5 ~ "Liberal",
      TRUE ~ NA_character_
    ),
    dest       = case_when(
      as.numeric(RELTRAD) == 1100 ~ "Now Evangelical",
      as.numeric(RELTRAD) == 100000 ~ "Now Unaffiliated (None)",
      TRUE ~ "Joined other religion/church"
    )
  ) |>
  select(year, wt, rep_lean, gender_rc, college_rc, married_rc, income_rc, cohort_rc, relimp_rc, race_rc, ideo_rc, dest)

# 2014 Wave
d14 <- read_sav("./data/rls/rls2014.sav")
ex14 <- d14 |>
  filter(as.numeric(CHRELTRAD) == 20000, as.numeric(RELTRAD) != 20000) |>
  mutate(
    year       = 2014,
    wt         = as.numeric(WEIGHT),
    # Republican + Leaners
    rep_lean   = (as.numeric(party) == 1) | (as.numeric(party) == 3 & as.numeric(partyln) == 1),
    gender_rc  = if_else(as.numeric(SEX) == 1, "Male", "Female"),
    college_rc = if_else(as.numeric(educ) %in% 6:8, "College Grad", "No College Grad"),
    married_rc = if_else(as.numeric(marital) == 1, "Married", "Not Married"),
    income_rc  = case_when(
      as.numeric(income) %in% 7:9 ~ "High Income ($75k+)",
      as.numeric(income) %in% 1:6 ~ "Low/Mid Income (<$75k)",
      TRUE ~ NA_character_
    ),
    cohort_rc  = if_else(as.numeric(agerec) %in% 1:3, "Born 1980 or Later", "Born Before 1980"),
    relimp_rc  = if_else(as.numeric(qf2) %in% 1:2, "Religion is Important", "Religion is Not Important"),
    race_rc    = case_when(
      as.numeric(racethn) == 1 ~ "White non-Hispanic",
      as.numeric(racethn) == 3 ~ "Hispanic",
      TRUE ~ "Other"
    ),
    ideo_rc    = case_when(
      as.numeric(ideo) %in% 1:2 ~ "Conservative",
      as.numeric(ideo) == 3 ~ "Moderate",
      as.numeric(ideo) %in% 4:5 ~ "Liberal",
      TRUE ~ NA_character_
    ),
    dest       = case_when(
      as.numeric(RELTRAD) == 1100 ~ "Now Evangelical",
      as.numeric(RELTRAD) == 100000 ~ "Now Unaffiliated (None)",
      TRUE ~ "Joined other religion/church"
    )
  ) |>
  select(year, wt, rep_lean, gender_rc, college_rc, married_rc, income_rc, cohort_rc, relimp_rc, race_rc, ideo_rc, dest)

# 2007 Wave
d07 <- read_sav("./data/rls/rls2007.sav")
ex07 <- d07 |>
  filter(as.numeric(q50) == 3, as.numeric(reltrad) != 20000) |>
  mutate(
    year       = 2007,
    wt         = as.numeric(weight),
    # Republican + Leaners
    rep_lean   = (as.numeric(party) == 1) | (as.numeric(party) == 3 & as.numeric(partyln) == 1),
    gender_rc  = if_else(as.numeric(sex) == 1, "Male", "Female"),
    college_rc = if_else(as.numeric(educ) %in% 6:7, "College Grad", "No College Grad"),
    married_rc = if_else(as.numeric(marital) == 1, "Married", "Not Married"),
    income_rc  = case_when(
      as.numeric(income) %in% 7:9 ~ "High Income ($75k+)",
      as.numeric(income) %in% 1:6 ~ "Low/Mid Income (<$75k)",
      TRUE ~ NA_character_
    ),
    cohort_rc  = if_else(as.numeric(age) <= 27, "Born 1980 or Later", "Born Before 1980"),
    relimp_rc  = if_else(as.numeric(q21) %in% 1:2, "Religion is Important", "Religion is Not Important"),
    race_rc    = case_when(
      as.numeric(hisp) == 1 ~ "Hispanic",
      as.numeric(hisp) == 2 & as.numeric(race) == 1 ~ "White non-Hispanic",
      TRUE ~ "Other"
    ),
    ideo_rc    = case_when(
      as.numeric(ideo) %in% 1:2 ~ "Conservative",
      as.numeric(ideo) == 3 ~ "Moderate",
      as.numeric(ideo) %in% 4:5 ~ "Liberal",
      TRUE ~ NA_character_
    ),
    dest       = case_when(
      as.numeric(reltrad) == 1100 ~ "Now Evangelical",
      as.numeric(reltrad) == 100000 ~ "Now Unaffiliated (None)",
      TRUE ~ "Joined other religion/church"
    )
  ) |>
  select(year, wt, rep_lean, gender_rc, college_rc, married_rc, income_rc, cohort_rc, relimp_rc, race_rc, ideo_rc, dest)

# Combine all waves and drop cases missing political party
ex_all <- bind_rows(ex07, ex14, ex24) |>
  filter(!is.na(rep_lean))

# ── Function to Compute Proportions & CIs ─────────────────────────────────────

compute_trends <- function(df, group_var) {
  df |>
    group_by(year, !!sym(group_var)) |>
    summarise(
      n       = n(),
      rep_pct = sum(rep_lean * wt, na.rm = TRUE) / sum(wt, na.rm = TRUE),
      se      = sqrt(rep_pct * (1 - rep_pct) / n),
      .groups = "drop"
    ) |>
    mutate(
      ci_low  = pmax(0, rep_pct - 1.96 * se),
      ci_high = pmin(1, rep_pct + 1.96 * se)
    )
}

# ── Chart 1: Education Realignment ────────────────────────────────────────────

edu_trend <- compute_trends(ex_all, "college_rc") |>
  mutate(college_rc = factor(college_rc, levels = c("No College Grad", "College Grad")))

edu_endlabs <- edu_trend |>
  filter(year == 2024) |>
  mutate(label = paste0(college_rc, "  ", scales::percent(rep_pct, accuracy = 1)))

p_edu <- ggplot(edu_trend, aes(x = year, y = rep_pct, color = college_rc, group = college_rc)) +
  geom_ribbon(aes(ymin = ci_low, ymax = ci_high, fill = college_rc), alpha = 0.15, color = NA) +
  geom_line(linewidth = 1.4) +
  geom_point(size = 3.6) +
  geom_text(data = edu_endlabs, aes(label = label), hjust = 0, nudge_x = 1.0,
            family = "Cairo_bold", size = 3.4, show.legend = FALSE) +
  scale_color_manual(values = c("College Grad" = "#0B4F8B", "No College Grad" = "#B8392E")) +
  scale_fill_manual(values = c("College Grad" = "#0B4F8B", "No College Grad" = "#B8392E"), guide = "none") +
  scale_x_continuous(breaks = c(2007, 2014, 2024), limits = c(2006.5, 2035)) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1), limits = c(0, 0.70)) +
  labs(
    title    = "The Education Realignment Among Ex-Mormons",
    subtitle = "% Republican (with leaners) among ex-Mormons, split by educational attainment. Shaded = 95% CI.",
    x = NULL, y = NULL,
    caption  = "@mormon_metrics  |  Source: Pew RLS 2007 / 2014 / 2024 (weighted)"
  ) +
  mm_theme +
  theme(panel.grid.major.y = element_line(color = "lightgrey"),
        panel.grid.major.x = element_blank())

ggsave("./images/35_exlds_education_1.png", p_edu, width = 1500, height = 1500, units = "px", dpi = 300)

# ── Chart 2: The Educational Chasm Among Ex-Mormon Women ──────────────────────

ex_female <- ex_all |> filter(gender_rc == "Female")
fem_edu_trend <- compute_trends(ex_female, "college_rc") |>
  mutate(college_rc = factor(college_rc, levels = c("No College Grad", "College Grad")))

fem_edu_endlabs <- fem_edu_trend |>
  filter(year == 2024) |>
  mutate(label = paste0(college_rc, "  ", scales::percent(rep_pct, accuracy = 1)))

p_fem_edu <- ggplot(fem_edu_trend, aes(x = year, y = rep_pct, color = college_rc, group = college_rc)) +
  geom_ribbon(aes(ymin = ci_low, ymax = ci_high, fill = college_rc), alpha = 0.15, color = NA) +
  geom_line(linewidth = 1.4) +
  geom_point(size = 3.6) +
  geom_text(data = fem_edu_endlabs, aes(label = label), hjust = 0, nudge_x = 1.0,
            family = "Cairo_bold", size = 3.4, show.legend = FALSE) +
  scale_color_manual(values = c("College Grad" = "#4F87B8", "No College Grad" = "#B8392E")) +
  scale_fill_manual(values = c("College Grad" = "#4F87B8", "No College Grad" = "#B8392E"), guide = "none") +
  scale_x_continuous(breaks = c(2007, 2014, 2024), limits = c(2006.5, 2035)) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1), limits = c(0, 0.70)) +
  labs(
    title    = "The Educational Chasm Among Ex-Mormon Women",
    subtitle = "% Republican (with leaners) among female ex-Mormons, showing massive college-divergence. Shaded = 95% CI.",
    x = NULL, y = NULL,
    caption  = "@mormon_metrics  |  Source: Pew RLS 2007 / 2014 / 2024 (weighted)"
  ) +
  mm_theme +
  theme(panel.grid.major.y = element_line(color = "lightgrey"),
        panel.grid.major.x = element_blank())

ggsave("./images/35_exlds_female_education_2.png", p_fem_edu, width = 1500, height = 1500, units = "px", dpi = 300)

# ── Chart 3: Gender Realignment & Convergence ────────────────────────────────

gender_trend <- compute_trends(ex_all, "gender_rc") |>
  mutate(gender_rc = factor(gender_rc, levels = c("Male", "Female")))

gender_endlabs <- gender_trend |>
  filter(year == 2024) |>
  mutate(label = paste0(gender_rc, "  ", scales::percent(rep_pct, accuracy = 1)))

# Adjust overlapping label slightly to ensure perfect visual spacing
gender_endlabs$y_lab <- gender_endlabs$rep_pct
gender_endlabs$y_lab[gender_endlabs$gender_rc == "Female"] <- gender_endlabs$y_lab[gender_endlabs$gender_rc == "Female"] - 0.015
gender_endlabs$y_lab[gender_endlabs$gender_rc == "Male"]   <- gender_endlabs$y_lab[gender_endlabs$gender_rc == "Male"]   + 0.015

p_gender <- ggplot(gender_trend, aes(x = year, y = rep_pct, color = gender_rc, group = gender_rc)) +
  geom_ribbon(aes(ymin = ci_low, ymax = ci_high, fill = gender_rc), alpha = 0.15, color = NA) +
  geom_line(linewidth = 1.4) +
  geom_point(size = 3.6) +
  geom_text(data = gender_endlabs, aes(label = label, y = y_lab), hjust = 0, nudge_x = 1.0,
            family = "Cairo_bold", size = 3.4, show.legend = FALSE) +
  scale_color_manual(values = c("Male" = "#1F4E79", "Female" = "#D95F52")) +
  scale_fill_manual(values = c("Male" = "#1F4E79", "Female" = "#D95F52"), guide = "none") +
  scale_x_continuous(breaks = c(2007, 2014, 2024), limits = c(2006.5, 2035)) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1), limits = c(0, 0.70)) +
  labs(
    title    = "The Ex-Mormon Gender Gap Has Vanished",
    subtitle = "% Republican (with leaners) among ex-Mormons by gender. In 2024, men and women are identical. Shaded = 95% CI.",
    x = NULL, y = NULL,
    caption  = "@mormon_metrics  |  Source: Pew RLS 2007 / 2014 / 2024 (weighted)"
  ) +
  mm_theme +
  theme(panel.grid.major.y = element_line(color = "lightgrey"),
        panel.grid.major.x = element_blank())

ggsave("./images/35_exlds_gender_3.png", p_gender, width = 1500, height = 1500, units = "px", dpi = 300)

# ── Chart 4: Married vs Unmarried ex-Mormons ──────────────────────────────────

married_trend <- compute_trends(ex_all, "married_rc") |>
  mutate(married_rc = factor(married_rc, levels = c("Married", "Not Married")))

married_endlabs <- married_trend |>
  filter(year == 2024) |>
  mutate(label = paste0(married_rc, "  ", scales::percent(rep_pct, accuracy = 1)))

p_married <- ggplot(married_trend, aes(x = year, y = rep_pct, color = married_rc, group = married_rc)) +
  geom_ribbon(aes(ymin = ci_low, ymax = ci_high, fill = married_rc), alpha = 0.15, color = NA) +
  geom_line(linewidth = 1.4) +
  geom_point(size = 3.6) +
  geom_text(data = married_endlabs, aes(label = label), hjust = 0, nudge_x = 1.0,
            family = "Cairo_bold", size = 3.4, show.legend = FALSE) +
  scale_color_manual(values = c("Married" = "#2C7A3D", "Not Married" = "#9B2C5E")) +
  scale_fill_manual(values = c("Married" = "#2C7A3D", "Not Married" = "#9B2C5E"), guide = "none") +
  scale_x_continuous(breaks = c(2007, 2014, 2024), limits = c(2006.5, 2035)) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1), limits = c(0, 0.70)) +
  labs(
    title    = "Marriage Realignment Among Ex-Mormons",
    subtitle = "% Republican (with leaners) among ex-Mormons, split by marital status. Shaded = 95% CI.",
    x = NULL, y = NULL,
    caption  = "@mormon_metrics  |  Source: Pew RLS 2007 / 2014 / 2024 (weighted)"
  ) +
  mm_theme +
  theme(panel.grid.major.y = element_line(color = "lightgrey"),
        panel.grid.major.x = element_blank())

ggsave("./images/35_exlds_married_4.png", p_married, width = 1500, height = 1500, units = "px", dpi = 300)

# ── Chart 5: Religious Destination ────────────────────────────────────────────

ex_all_dest <- ex_all

dest_trend <- ex_all_dest |>
  group_by(year, dest) |>
  summarise(
    n       = n(),
    rep_pct = sum(rep_lean * wt, na.rm = TRUE) / sum(wt, na.rm = TRUE),
    se      = sqrt(rep_pct * (1 - rep_pct) / n),
    .groups = "drop"
  ) |>
  mutate(
    ci_low  = pmax(0, rep_pct - 1.96 * se),
    ci_high = pmin(1, rep_pct + 1.96 * se),
    dest    = factor(dest, levels = c("Now Evangelical", "Joined other religion/church", "Now Unaffiliated (None)"))
  )

dest_endlabs <- dest_trend |>
  filter(year == 2024) |>
  mutate(label = paste0(dest, "  ", scales::percent(rep_pct, accuracy = 1)))

  p_dest <- ggplot(dest_trend, aes(x = year, y = rep_pct, color = dest, group = dest)) +
  geom_ribbon(aes(ymin = ci_low, ymax = ci_high, fill = dest), alpha = 0.15, color = NA) +
  geom_line(linewidth = 1.4) +
  geom_point(size = 3.6) +
  geom_text(data = dest_endlabs, aes(label = label), hjust = 0, nudge_x = 1.0,
            family = "Cairo_bold", size = 3.4, show.legend = FALSE) +
  scale_color_manual(values = c("Now Evangelical" = "#B8392E", "Joined other religion/church" = "#D9A441", "Now Unaffiliated (None)" = "#0B4F8B")) +
  scale_fill_manual(values = c("Now Evangelical" = "#B8392E", "Joined other religion/church" = "#D9A441", "Now Unaffiliated (None)" = "#0B4F8B"), guide = "none") +
  scale_x_continuous(breaks = c(2007, 2014, 2024), limits = c(2006.5, 2043)) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1), limits = c(0, 0.90)) +
  guides(color = guide_legend(nrow = 2, byrow = TRUE)) +
  labs(
    title    = "Ex-Mormon GOP Share by Religious Landing Pad",
    subtitle = "% Republican (with leaners) among ex-Mormons, split by current religious destination. Shaded = 95% CI.",
    x = NULL, y = NULL,
    caption  = "@mormon_metrics  |  Source: Pew RLS 2007 / 2014 / 2024 (weighted)"
  ) +
  mm_theme +
  theme(panel.grid.major.y = element_line(color = "lightgrey"),
        panel.grid.major.x = element_blank(),
        plot.margin        = margin(12, 35, 12, 20))

ggsave("./images/35_exlds_destination_5.png", p_dest, width = 1500, height = 1500, units = "px", dpi = 300)

# ── Chart 6: Income Realignment ───────────────────────────────────────────────

ex_all_income <- ex_all |> filter(!is.na(income_rc))
income_trend <- compute_trends(ex_all_income, "income_rc") |>
  mutate(income_rc = factor(income_rc, levels = c("High Income ($75k+)", "Low/Mid Income (<$75k)")))

income_endlabs <- income_trend |>
  filter(year == 2024) |>
  mutate(label = paste0(income_rc, "  ", scales::percent(rep_pct, accuracy = 1)))

# Adjust overlapping label slightly to ensure perfect visual spacing
income_endlabs$y_lab <- income_endlabs$rep_pct
income_endlabs$y_lab[income_endlabs$income_rc == "Low/Mid Income (<$75k)"] <- income_endlabs$y_lab[income_endlabs$income_rc == "Low/Mid Income (<$75k)"] - 0.015
income_endlabs$y_lab[income_endlabs$income_rc == "High Income ($75k+)"]  <- income_endlabs$y_lab[income_endlabs$income_rc == "High Income ($75k+)"]  + 0.015

p_income <- ggplot(income_trend, aes(x = year, y = rep_pct, color = income_rc, group = income_rc)) +
  geom_ribbon(aes(ymin = ci_low, ymax = ci_high, fill = income_rc), alpha = 0.15, color = NA) +
  geom_line(linewidth = 1.4) +
  geom_point(size = 3.6) +
  geom_text(data = income_endlabs, aes(label = label, y = y_lab), hjust = 0, nudge_x = 1.0,
            family = "Cairo_bold", size = 3.4, show.legend = FALSE) +
  scale_color_manual(values = c("High Income ($75k+)" = "#1F4E79", "Low/Mid Income (<$75k)" = "#D95F52")) +
  scale_fill_manual(values = c("High Income ($75k+)" = "#1F4E79", "Low/Mid Income (<$75k)" = "#D95F52"), guide = "none") +
  scale_x_continuous(breaks = c(2007, 2014, 2024), limits = c(2006.5, 2038)) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1), limits = c(0, 0.70)) +
  labs(
    title    = "The Income Realignment Among Ex-Mormons",
    subtitle = "% Republican (with leaners) among ex-Mormons, split by household income. Shaded = 95% CI.",
    x = NULL, y = NULL,
    caption  = "@mormon_metrics  |  Source: Pew RLS 2007 / 2014 / 2024 (weighted)"
  ) +
  mm_theme +
  theme(panel.grid.major.y = element_line(color = "lightgrey"),
        panel.grid.major.x = element_blank())

ggsave("./images/35_exlds_income_6.png", p_income, width = 1500, height = 1500, units = "px", dpi = 300)

# ── Chart 7: Generational Shift ───────────────────────────────────────────────

cohort_trend <- compute_trends(ex_all, "cohort_rc") |>
  mutate(cohort_rc = factor(cohort_rc, levels = c("Born 1980 or Later", "Born Before 1980")))

cohort_endlabs <- cohort_trend |>
  filter(year == 2024) |>
  mutate(label = paste0(cohort_rc, "  ", scales::percent(rep_pct, accuracy = 1)))

# Adjust overlapping label slightly to ensure perfect visual spacing
cohort_endlabs$y_lab <- cohort_endlabs$rep_pct
cohort_endlabs$y_lab[cohort_endlabs$cohort_rc == "Born 1980 or Later"] <- cohort_endlabs$y_lab[cohort_endlabs$cohort_rc == "Born 1980 or Later"] - 0.015
cohort_endlabs$y_lab[cohort_endlabs$cohort_rc == "Born Before 1980"]   <- cohort_endlabs$y_lab[cohort_endlabs$cohort_rc == "Born Before 1980"]   + 0.015

p_cohort <- ggplot(cohort_trend, aes(x = year, y = rep_pct, color = cohort_rc, group = cohort_rc)) +
  geom_ribbon(aes(ymin = ci_low, ymax = ci_high, fill = cohort_rc), alpha = 0.15, color = NA) +
  geom_line(linewidth = 1.4) +
  geom_point(size = 3.6) +
  geom_text(data = cohort_endlabs, aes(label = label, y = y_lab), hjust = 0, nudge_x = 1.0,
            family = "Cairo_bold", size = 3.4, show.legend = FALSE) +
  scale_color_manual(values = c("Born 1980 or Later" = "#9B2C5E", "Born Before 1980" = "#2C7A3D")) +
  scale_fill_manual(values = c("Born 1980 or Later" = "#9B2C5E", "Born Before 1980" = "#2C7A3D"), guide = "none") +
  scale_x_continuous(breaks = c(2007, 2014, 2024), limits = c(2006.5, 2038)) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1), limits = c(0, 0.70)) +
  labs(
    title    = "The Generational Realignment Among Ex-Mormons",
    subtitle = "% Republican (with leaners) among ex-Mormons, by birth cohort (Born 1980+ vs. Born before 1980). Shaded = 95% CI.",
    x = NULL, y = NULL,
    caption  = "@mormon_metrics  |  Source: Pew RLS 2007 / 2014 / 2024 (weighted)"
  ) +
  mm_theme +
  theme(panel.grid.major.y = element_line(color = "lightgrey"),
        panel.grid.major.x = element_blank())

ggsave("./images/35_exlds_cohort_7.png", p_cohort, width = 1500, height = 1500, units = "px", dpi = 300)

# ── Chart 8: Religiosity & Realignment ────────────────────────────────────────

relimp_trend <- compute_trends(ex_all, "relimp_rc") |>
  mutate(relimp_rc = factor(relimp_rc, levels = c("Religion is Important", "Religion is Not Important")))

relimp_endlabs <- relimp_trend |>
  filter(year == 2024) |>
  mutate(label = paste0(relimp_rc, "  ", scales::percent(rep_pct, accuracy = 1)))

p_relimp <- ggplot(relimp_trend, aes(x = year, y = rep_pct, color = relimp_rc, group = relimp_rc)) +
  geom_ribbon(aes(ymin = ci_low, ymax = ci_high, fill = relimp_rc), alpha = 0.15, color = NA) +
  geom_line(linewidth = 1.4) +
  geom_point(size = 3.6) +
  geom_text(data = relimp_endlabs, aes(label = label), hjust = 0, nudge_x = 1.0,
            family = "Cairo_bold", size = 3.4, show.legend = FALSE) +
  scale_color_manual(values = c("Religion is Important" = "#0B4F8B", "Religion is Not Important" = "#D95F52")) +
  scale_fill_manual(values = c("Religion is Important" = "#0B4F8B", "Religion is Not Important" = "#D95F52"), guide = "none") +
  scale_x_continuous(breaks = c(2007, 2014, 2024), limits = c(2006.5, 2038)) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1), limits = c(0, 0.70)) +
  labs(
    title    = "Religiosity and Ex-Mormon GOP Lean",
    subtitle = "% Republican (with leaners) among ex-Mormons, by importance of religion in their life. Shaded = 95% CI.",
    x = NULL, y = NULL,
    caption  = "@mormon_metrics  |  Source: Pew RLS 2007 / 2014 / 2024 (weighted)"
  ) +
  mm_theme +
  theme(panel.grid.major.y = element_line(color = "lightgrey"),
        panel.grid.major.x = element_blank())

ggsave("./images/35_exlds_religiosity_8.png", p_relimp, width = 1500, height = 1500, units = "px", dpi = 300)

# ── Chart 9: Educational Composition over Time ────────────────────────────────

edu_comp_trend <- ex_all |>
  group_by(year, college_rc) |>
  summarise(
    w_n = sum(wt, na.rm = TRUE),
    .groups = "drop_last"
  ) |>
  mutate(pct = w_n / sum(w_n)) |>
  ungroup() |>
  mutate(college_rc = factor(college_rc, levels = c("No College Grad", "College Grad")))

edu_comp_endlabs <- edu_comp_trend |>
  filter(year == 2024) |>
  mutate(label = paste0(college_rc, "  ", scales::percent(pct, accuracy = 1)))

p_edu_comp <- ggplot(edu_comp_trend, aes(x = year, y = pct, color = college_rc, group = college_rc)) +
  geom_line(linewidth = 1.4) +
  geom_point(size = 3.6) +
  geom_text(data = edu_comp_endlabs, aes(label = label), hjust = 0, nudge_x = 1.0,
            family = "Cairo_bold", size = 3.4, show.legend = FALSE) +
  scale_color_manual(values = c("College Grad" = "#0B4F8B", "No College Grad" = "#B8392E")) +
  scale_x_continuous(breaks = c(2007, 2014, 2024), limits = c(2006.5, 2038)) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1), limits = c(0, 1.00)) +
  labs(
    title    = "The Educational Composition of Ex-Mormons",
    subtitle = "Share of the disaffiliated LDS population by educational attainment. Non-college remains the vast majority.",
    x = NULL, y = NULL,
    caption  = "@mormon_metrics  |  Source: Pew RLS 2007 / 2014 / 2024 (weighted)"
  ) +
  mm_theme +
  theme(panel.grid.major.y = element_line(color = "lightgrey"),
        panel.grid.major.x = element_blank())

ggsave("./images/35_exlds_edu_composition_9.png", p_edu_comp, width = 1500, height = 1500, units = "px", dpi = 300)


# ── Chart 10: US Education Comparison ─────────────────────────────────────────

# 2007 Wave
act07_edu <- d07 |> filter(as.numeric(reltrad) == 20000) |>
  summarise(
    pct = sum((as.numeric(educ) %in% 6:7) * as.numeric(weight), na.rm=TRUE) / sum(as.numeric(weight), na.rm=TRUE),
    n = n()
  ) |> mutate(group = "Mormons", year = 2007)

ex07_edu <- d07 |> filter(as.numeric(q50) == 3, as.numeric(reltrad) != 20000) |>
  summarise(
    pct = sum((as.numeric(educ) %in% 6:7) * as.numeric(weight), na.rm=TRUE) / sum(as.numeric(weight), na.rm=TRUE),
    n = n()
  ) |> mutate(group = "Ex-Mormons", year = 2007)

us07_edu <- d07 |>
  summarise(
    pct = sum((as.numeric(educ) %in% 6:7) * as.numeric(weight), na.rm=TRUE) / sum(as.numeric(weight), na.rm=TRUE),
    n = n()
  ) |> mutate(group = "General US Population", year = 2007)

# 2014 Wave
act14_edu <- d14 |> filter(as.numeric(RELTRAD) == 20000) |>
  summarise(
    pct = sum((as.numeric(educ) %in% 6:8) * as.numeric(WEIGHT), na.rm=TRUE) / sum(as.numeric(WEIGHT), na.rm=TRUE),
    n = n()
  ) |> mutate(group = "Mormons", year = 2014)

ex14_edu <- d14 |> filter(as.numeric(CHRELTRAD) == 20000, as.numeric(RELTRAD) != 20000) |>
  summarise(
    pct = sum((as.numeric(educ) %in% 6:8) * as.numeric(WEIGHT), na.rm=TRUE) / sum(as.numeric(WEIGHT), na.rm=TRUE),
    n = n()
  ) |> mutate(group = "Ex-Mormons", year = 2014)

us14_edu <- d14 |>
  summarise(
    pct = sum((as.numeric(educ) %in% 6:8) * as.numeric(WEIGHT), na.rm=TRUE) / sum(as.numeric(WEIGHT), na.rm=TRUE),
    n = n()
  ) |> mutate(group = "General US Population", year = 2014)

# 2024 Wave
act24_edu <- d24 |> filter(as.numeric(RELTRAD) == 20000) |>
  summarise(
    pct = sum((as.numeric(EDUCREC) %in% 3:4) * as.numeric(WEIGHT), na.rm=TRUE) / sum(as.numeric(WEIGHT), na.rm=TRUE),
    n = n()
  ) |> mutate(group = "Mormons", year = 2024)

ex24_edu <- d24 |> filter(as.character(FRMREL) == "20000", as.numeric(RELTRAD) != 20000) |>
  summarise(
    pct = sum((as.numeric(EDUCREC) %in% 3:4) * as.numeric(WEIGHT), na.rm=TRUE) / sum(as.numeric(WEIGHT), na.rm=TRUE),
    n = n()
  ) |> mutate(group = "Ex-Mormons", year = 2024)

us24_edu <- d24 |>
  summarise(
    pct = sum((as.numeric(EDUCREC) %in% 3:4) * as.numeric(WEIGHT), na.rm=TRUE) / sum(as.numeric(WEIGHT), na.rm=TRUE),
    n = n()
  ) |> mutate(group = "General US Population", year = 2024)

# Combine
edu_compare_trend <- bind_rows(
  act07_edu, ex07_edu, us07_edu,
  act14_edu, ex14_edu, us14_edu,
  act24_edu, ex24_edu, us24_edu
) |>
  mutate(
    se = sqrt(pct * (1 - pct) / n),
    ci_low = pmax(0, pct - 1.96 * se),
    ci_high = pmin(1, pct + 1.96 * se),
    group = factor(group, levels = c("Mormons", "General US Population", "Ex-Mormons"))
  )

edu_compare_endlabs <- edu_compare_trend |>
  filter(year == 2024) |>
  mutate(label = paste0(group, "  ", scales::percent(pct, accuracy = 0.1)))

p_edu_compare <- ggplot(edu_compare_trend, aes(x = year, y = pct, color = group, group = group)) +
  geom_ribbon(aes(ymin = ci_low, ymax = ci_high, fill = group), alpha = 0.12, color = NA) +
  geom_line(linewidth = 1.4) +
  geom_point(size = 3.6) +
  geom_text(data = edu_compare_endlabs, aes(label = label), hjust = 0, nudge_x = 1.0,
            family = "Cairo_bold", size = 3.4, show.legend = FALSE) +
  scale_color_manual(values = c("Mormons" = "#0B4F8B", "General US Population" = "#5A5A5A", "Ex-Mormons" = "#B8392E")) +
  scale_fill_manual(values = c("Mormons" = "#0B4F8B", "General US Population" = "#5A5A5A", "Ex-Mormons" = "#B8392E"), guide = "none") +
  scale_x_continuous(breaks = c(2007, 2014, 2024), limits = c(2006.5, 2038)) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1), limits = c(0.10, 0.45)) +
  labs(
    title    = "Educational Attainment Comparison",
    subtitle = "Percentage of College Graduates (Bachelor's or higher) over time. Shaded = 95% CI.",
    x = NULL, y = NULL,
    caption  = "@mormon_metrics  |  Source: Pew RLS 2007 / 2014 / 2024 (weighted)"
  ) +
  mm_theme +
  theme(panel.grid.major.y = element_line(color = "lightgrey"),
        panel.grid.major.x = element_blank())

ggsave("./images/35_exlds_us_edu_comparison_10.png", p_edu_compare, width = 1500, height = 1500, units = "px", dpi = 300)


# ── Chart 11: Partisan Sorting vs. Ideological Drift ──────────────────────────

# 1. Party Trend
party_trend_11 <- ex_all |>
  group_by(year) |>
  summarise(
    pct = sum(rep_lean * wt, na.rm = TRUE) / sum(wt, na.rm = TRUE),
    n = n(),
    .groups = "drop"
  ) |> mutate(metric = "Republican (with leaners)")

# 2. Ideology Trend
ideo_trend_11 <- ex_all |>
  filter(!is.na(ideo_rc)) |>
  group_by(year) |>
  summarise(
    pct = sum((ideo_rc == "Conservative") * wt, na.rm = TRUE) / sum(wt, na.rm = TRUE),
    n = n(),
    .groups = "drop"
  ) |> mutate(metric = "Conservative (ideology)")

# Combine
sorting_trend <- bind_rows(party_trend_11, ideo_trend_11) |>
  mutate(
    se = sqrt(pct * (1 - pct) / n),
    ci_low = pmax(0, pct - 1.96 * se),
    ci_high = pmin(1, pct + 1.96 * se),
    metric = factor(metric, levels = c("Republican (with leaners)", "Conservative (ideology)"))
  )

sorting_endlabs <- sorting_trend |>
  filter(year == 2024) |>
  mutate(label = paste0(metric, "  ", scales::percent(pct, accuracy = 0.1)))

p_sorting <- ggplot(sorting_trend, aes(x = year, y = pct, color = metric, group = metric)) +
  geom_ribbon(aes(ymin = ci_low, ymax = ci_high, fill = metric), alpha = 0.12, color = NA) +
  geom_line(linewidth = 1.4) +
  geom_point(size = 3.6) +
  geom_text(data = sorting_endlabs, aes(label = label), hjust = 0, nudge_x = 1.0,
            family = "Cairo_bold", size = 3.4, show.legend = FALSE) +
  scale_color_manual(values = c("Republican (with leaners)" = "#B8392E", "Conservative (ideology)" = "#D9A441")) +
  scale_fill_manual(values = c("Republican (with leaners)" = "#B8392E", "Conservative (ideology)" = "#D9A441"), guide = "none") +
  scale_x_continuous(breaks = c(2007, 2014, 2024), limits = c(2006.5, 2038)) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1), limits = c(0.15, 0.55)) +
  labs(
    title    = "Partisan Sorting vs. Ideological Drift",
    subtitle = "Comparing political party identity with political views among ex-Mormons over time. Shaded = 95% CI.",
    x = NULL, y = NULL,
    caption  = "@mormon_metrics  |  Source: Pew RLS 2007 / 2014 / 2024 (weighted)"
  ) +
  mm_theme +
  theme(panel.grid.major.y = element_line(color = "lightgrey"),
        panel.grid.major.x = element_blank())

ggsave("./images/35_exlds_partisan_sorting_11.png", p_sorting, width = 1500, height = 1500, units = "px", dpi = 300)


# ── Chart 12: Religious Destination Composition ────────────────────────────────

dest_comp <- ex_all_dest |>
  group_by(year, dest) |>
  summarise(w_n = sum(wt, na.rm=TRUE), .groups="drop_last") |>
  mutate(pct = w_n / sum(w_n)) |>
  ungroup() |>
  mutate(
    dest = factor(dest, levels = c("Now Unaffiliated (None)", "Joined other religion/church", "Now Evangelical")),
    year_factor = factor(year, levels = c("2007", "2014", "2024"))
  )

p_bar <- ggplot(dest_comp, aes(x = dest, y = pct, fill = year_factor)) +
  geom_col(position = position_dodge(width = 0.8), width = 0.72) +
  geom_text(aes(label = scales::percent(pct, accuracy = 0.1), group = year_factor),
            position = position_dodge(width = 0.8), vjust = -0.5,
            family = "Cairo_bold", size = 3.2, color = "black") +
  scale_fill_manual(values = c("2007" = "#A8C3D8", "2014" = "#4F87B8", "2024" = "#0B4F8B")) +
  scale_x_discrete(labels = function(x) stringr::str_wrap(x, width = 15)) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1), limits = c(0, 0.70)) +
  labs(
    title    = "Where Do Ex-Mormons Land?",
    subtitle = "Weighted religious destination of adults raised LDS who left the faith, across the three RLS waves.",
    x = NULL, y = NULL,
    caption  = "@mormon_metrics  |  Source: Pew RLS 2007 / 2014 / 2024 (weighted)"
  ) +
  mm_theme +
  theme(panel.grid.major.y = element_line(color = "lightgrey"),
        panel.grid.major.x = element_blank())

ggsave("./images/35_exlds_dest_composition_12.png", p_bar, width = 1500, height = 1500, units = "px", dpi = 300)


# ── Statistical Modeling: Logistic Regression ───────────────────────────────

cat("\n=======================================================\n")
cat("          LOGISTIC REGRESSION MODEL OUTPUT             \n")
cat("=======================================================\n")

ex_all_model <- ex_all_dest |>
  mutate(
    college_rc  = factor(college_rc, levels = c("No College Grad", "College Grad")),
    gender_rc   = factor(gender_rc, levels = c("Female", "Male")),
    married_rc  = factor(married_rc, levels = c("Not Married", "Married")),
    dest        = factor(dest, levels = c("Now Unaffiliated (None)", "Now Evangelical", "Joined other religion/church")),
    income_rc   = factor(income_rc, levels = c("Low/Mid Income (<$75k)", "High Income ($75k+)")),
    cohort_rc   = factor(cohort_rc, levels = c("Born Before 1980", "Born 1980 or Later")),
    relimp_rc   = factor(relimp_rc, levels = c("Religion is Not Important", "Religion is Important")),
    race_rc     = factor(race_rc, levels = c("White non-Hispanic", "Hispanic", "Other")),
    year_factor = factor(year, levels = c("2007", "2014", "2024"))
  ) |>
  group_by(year) |>
  mutate(wt_norm = wt / mean(wt)) |>
  ungroup()

model <- glm(rep_lean ~ year_factor + college_rc + gender_rc + married_rc + dest + income_rc + cohort_rc + relimp_rc + race_rc,
             data = ex_all_model, weights = wt_norm, family = quasibinomial())

print(summary(model))

cat("Successfully ran analysis and generated all twelve figures.\n")
No results found