Skip to content

Instantly share code, notes, and snippets.

@acbass49
Created September 23, 2025 15:28
Show Gist options
  • Select an option

  • Save acbass49/92d3765be27673904c6d41c500c7a7c4 to your computer and use it in GitHub Desktop.

Select an option

Save acbass49/92d3765be27673904c6d41c500c7a7c4 to your computer and use it in GitHub Desktop.
18 Utah Mormons
library(tidyverse)
library(binom)
library(haven)
library(car)
library(ggtext)
library(sjlabelled)
# Load the dataset
data <- readRDS("./data/CES/cumulative_2006-2024.rds")
data$relig_church_rc <- car::recode(as.numeric(data$relig_church),"1:2 = 'Weekly or More'; 3 = 'Monthly'; 4:5 = 'A few times a year/Seldom'; 6 = 'Never'")
data$relig_church_rc <- factor(data$relig_church_rc,
levels = c("Weekly or More", "Monthly", "A few times a year/Seldom", "Never"))
data$relig_church_rc2 <- car::recode(as.numeric(data$relig_church),"1:2 = 'Weekly or More'; 3:4 = 'Monthly/A few times a year'; 5:6 = 'Seldom/Never'")
data$relig_church_rc2 <- factor(data$relig_church_rc2,
levels = c("Weekly or More", "Monthly/A few times a year", "Seldom/Never"))
data$year_4 <- car::recode(as.numeric(data$year), "2008:2012 = '2008-12'; 2013:2016 = '2013-16'; 2017:2020 = '2017-20'; 2021:2024 = '2021-24'")
data$year_4 <- factor(data$year_4,
levels = c("2008-12", "2013-16", "2017-20", "2021-24"))
data$year_2 <- car::recode(as.numeric(data$year), "2007:2008 = '2007-08'; 2009:2010 = '2009-10'; 2011:2012 = '2011-12'; 2013:2014 = '2013-14'; 2015:2016 = '2015-16'; 2017:2018 = '2017-18'; 2019:2020 = '2019-20'; 2021:2022 = '2021-22'; 2023:2024 = '2023-24'")
data$year_2 <- factor(data$year_2,
levels = c("2007-08", "2009-10", "2011-12", "2013-14", "2015-16", "2017-18", "2019-20", "2021-22", "2023-24"))
# prayer was not in the cumulative file, so I need to merge it in
# I went through each year and added the prayer variable manually.
data <- data |>
mutate(id = paste0(year, "X", case_id)) |>
left_join(read.csv("./data/CES/prayer.csv"), by = "id") |>
mutate(year = year.x)
data <- data |>
mutate(
prayer_rc = case_when(
prayer == 1 ~ "Several Times a Day",
prayer %in% 2:7 ~ "Less Than Several Times a Day",
TRUE ~ NA_character_
),
prayer_rc2 = case_when(
prayer %in% 1:2 ~ "Daily or More",
prayer %in% 3:7 ~ "Less Than Several Times a Day",
TRUE ~ NA_character_
)
)
# abortion was not in the cumulative file, so I need to merge it in
# I went through each year and added the abortion variable manually.
data <- data |>
left_join(read.csv("./data/CES/abortion.csv"), by = "id") |>
mutate(year = year.x)
mormon_data <- data |> filter(data$religion == 3)
mormon_data$devout <- dplyr::case_when(
mormon_data$prayer_rc == "Several Times a Day" &
mormon_data$relig_imp == "Very Important" &
mormon_data$relig_church_rc == "Weekly or More" ~ 1,
TRUE ~ 0
)
mormon_data$Utah <- ifelse(mormon_data$state == "Utah", "Utah Resident", "Non-Utah Resident")
mormon_data$jello_belt <- ifelse(mormon_data$state %in% c("Utah", "Idaho", "Arizona"), 1, 0)
mormon_data |>
group_by(Utah) |>
count(devout, wt = weight) |>
drop_na() |>
mutate(
prop = n / sum(n),
total_n = sum(n),
lower = binom.confint(x = n, n = total_n, method = "asymptotic")$lower,
upper = binom.confint(x = n, n = total_n, method = "asymptotic")$upper
) |>
filter(devout == 1)
plot <- mormon_data |>
group_by(Utah,year_4) |>
count(devout, wt = weight) |>
drop_na() |>
mutate(
prop = n / sum(n),
total_n = sum(n),
lower = binom.confint(x = n, n = total_n, method = "asymptotic")$lower,
upper = binom.confint(x = n, n = total_n, method = "asymptotic")$upper
) |>
filter(devout == 1) |>
ggplot(aes(x = year_4, y = prop, color = Utah, group = Utah)) +
geom_line() +
geom_point() +
geom_errorbar(aes(ymin = lower, ymax = upper), width = 0.2) +
geom_text(aes(label = scales::percent(prop, accuracy = 1)), vjust = -1, size = 3, family = "Cairo", fontface = "bold", color = "black") +
labs(
title = "'Devout' More Common Among Utah Mormons",
subtitle = "Devout defined as praying several times a day,\nreligion very important,\nand attending church weekly or more",
x = "Year Group",
y = "Proportion",
caption = "@mormon_metrics\nData: Cooperative Election Study (CES) 2008-24. N=9,189 LDS"
) +
theme_minimal() +
scale_y_continuous(labels = scales::percent_format(accuracy = 1), limits = c(0,0.8) , breaks = seq(0, 0.8, by = 0.1)) +
scale_color_manual(values = c("Utah Resident" = "#D35400", "Non-Utah Resident" = "goldenrod")) +
theme(
axis.ticks = element_blank(),
axis.title = element_text(size = 14),
axis.text.y = element_text(size = 10),
axis.text.x = element_text(size = 8, margin = margin(t = -5)),
plot.background = element_rect(fill = "grey95"), # Change entire plot background color here
panel.background = element_blank(),
text = element_text(face = "bold", family = "Cairo"),
plot.title = element_text(size = 15, face = "bold"),
plot.subtitle = element_text(size = 11),
plot.title.position = "plot",
plot.subtitle.position = "plot",
legend.background = element_blank(),
legend.box.background = element_blank(),
legend.title = element_blank(),
legend.key = element_blank(),
panel.grid = element_blank(),
legend.position = "top",
panel.grid.major.y = element_line(color = "lightgrey", linetype = 'solid'),
plot.caption = element_text(size = 8,family = "Cairo")
)
ggsave("./images/18_utah_mormons_1.png", plot, width = 1500, height = 1500, units = "px", dpi = 300)
mormon_data |>
group_by(jello_belt) |>
count(devout, wt = weight) |>
drop_na() |>
mutate(
prop = n / sum(n),
total_n = sum(n),
lower = binom.confint(x = n, n = total_n, method = "asymptotic")$lower,
upper = binom.confint(x = n, n = total_n, method = "asymptotic")$upper
) |>
filter(devout == 1)
mormon_data |>
group_by(jello_belt,year_4) |>
count(devout, wt = weight) |>
drop_na() |>
mutate(
prop = n / sum(n),
total_n = sum(n),
lower = binom.confint(x = n, n = total_n, method = "asymptotic")$lower,
upper = binom.confint(x = n, n = total_n, method = "asymptotic")$upper
) |>
filter(devout == 1)
mormon_data |>
group_by(state) |>
count(devout, wt = weight) |>
drop_na() |>
mutate(
prop = n / sum(n),
total_n = sum(n),
lower = binom.confint(x = n, n = total_n, method = "asymptotic")$lower,
upper = binom.confint(x = n, n = total_n, method = "asymptotic")$upper
) |>
filter(devout == 1) |>
arrange(desc(prop))
state_to_region <- c(
"Connecticut" = "Northeast", "Maine" = "Northeast", "Massachusetts" = "Northeast", "New Hampshire" = "Northeast", "Rhode Island" = "Northeast", "Vermont" = "Northeast",
"New Jersey" = "Northeast", "New York" = "Northeast", "Pennsylvania" = "Northeast",
"Illinois" = "Midwest", "Indiana" = "Midwest", "Michigan" = "Midwest", "Ohio" = "Midwest", "Wisconsin" = "Midwest",
"Iowa" = "Midwest", "Kansas" = "Midwest", "Minnesota" = "Midwest", "Missouri" = "Midwest", "Nebraska" = "Midwest", "North Dakota" = "Midwest", "South Dakota" = "Midwest",
"Delaware" = "South", "Florida" = "South", "Georgia" = "South", "Maryland" = "South", "North Carolina" = "South", "South Carolina" = "South", "Virginia" = "South", "District of Columbia" = "South", "West Virginia" = "South",
"Alabama" = "South", "Kentucky" = "South", "Mississippi" = "South", "Tennessee" = "South",
"Arkansas" = "South", "Louisiana" = "South", "Oklahoma" = "South", "Texas" = "South",
"Arizona" = "West", "Colorado" = "West", "Idaho" = "West", "Montana" = "West", "Nevada" = "West", "New Mexico" = "West", "Utah" = "West", "Wyoming" = "West",
"Alaska" = "West", "California" = "West", "Hawaii" = "West", "Oregon" = "West", "Washington" = "West"
)
mormon_data$region <- state_to_region[mormon_data$state]
mormon_data |>
group_by(region) |>
count(devout, wt = weight) |>
drop_na() |>
mutate(
prop = n / sum(n),
total_n = sum(n),
lower = binom.confint(x = n, n = total_n, method = "asymptotic")$lower,
upper = binom.confint(x = n, n = total_n, method = "asymptotic")$upper
) |>
filter(devout == 1) |>
arrange(desc(prop))
plot <- mormon_data |>
group_by(Utah, year_4) |>
count(relig_church_rc2, wt = weight) |>
drop_na() |>
mutate(
prop = n / sum(n),
total_n = sum(n),
lower = binom.confint(x = n, n = total_n, method = "asymptotic")$lower,
upper = binom.confint(x = n, n = total_n, method = "asymptotic")$upper
) |>
filter(relig_church_rc2 == "Seldom/Never") |>
ggplot(aes(x = year_4, y = prop, color = Utah, group = Utah)) +
geom_line() +
geom_point() +
geom_errorbar(aes(ymin = lower, ymax = upper), width = 0.2) +
geom_text(aes(label = scales::percent(prop, accuracy = 1)), vjust = -1, size = 3, family = "Cairo", fontface = "bold", color = "black") +
labs(
title = "Cultural Mormons More Common Outside Utah",
subtitle = "Cultural Mormons defined as identifying as LDS/Mormon \nbut seldom/never attending church",
x = "Year Group",
y = "Proportion",
caption = "@mormon_metrics\nData: Cooperative Election Study (CES) 2008-24. N=9,189 LDS"
) +
theme_minimal() +
scale_y_continuous(labels = scales::percent_format(accuracy = 1), limits = c(0,0.8) , breaks = seq(0, 0.8, by = 0.1)) +
scale_color_manual(values = c("Utah Resident" = "#D35400", "Non-Utah Resident" = "goldenrod")) +
theme(
axis.ticks = element_blank(),
axis.title = element_text(size = 14),
axis.text.y = element_text(size = 10),
axis.text.x = element_text(size = 8, margin = margin(t = -5)),
plot.background = element_rect(fill = "grey95"), # Change entire plot background color here
panel.background = element_blank(),
text = element_text(face = "bold", family = "Cairo"),
plot.title = element_text(size = 15, face = "bold"),
plot.subtitle = element_text(size = 11),
plot.title.position = "plot",
plot.subtitle.position = "plot",
legend.background = element_blank(),
legend.box.background = element_blank(),
legend.title = element_blank(),
legend.key = element_blank(),
panel.grid = element_blank(),
legend.position = "top",
panel.grid.major.y = element_line(color = "lightgrey", linetype = 'solid'),
plot.caption = element_text(size = 8,family = "Cairo")
)
ggsave("./images/18_utah_mormons_2.png", plot, width = 1500, height = 1500, units = "px", dpi = 300)
mormon_data |>
group_by(Utah, year_4) |>
count(relig_church_rc2, wt = weight) |>
drop_na() |>
mutate(
prop = n / sum(n),
total_n = sum(n),
lower = binom.confint(x = n, n = total_n, method = "asymptotic")$lower,
upper = binom.confint(x = n, n = total_n, method = "asymptotic")$upper
) |>
filter(relig_church_rc2 == "Seldom/Never") |>
arrange(Utah, year_4)
mormon_data |>
group_by(jello_belt) |>
count(relig_church_rc2, wt = weight) |>
drop_na() |>
mutate(
prop = n / sum(n),
total_n = sum(n),
lower = binom.confint(x = n, n = total_n, method = "asymptotic")$lower,
upper = binom.confint(x = n, n = total_n, method = "asymptotic")$upper
) |>
filter(relig_church_rc2 == "Seldom/Never") |>
arrange(jello_belt)
mormon_data |>
group_by(jello_belt, year_4) |>
count(relig_church_rc2, wt = weight) |>
drop_na() |>
mutate(
prop = n / sum(n),
total_n = sum(n),
lower = binom.confint(x = n, n = total_n, method = "asymptotic")$lower,
upper = binom.confint(x = n, n = total_n, method = "asymptotic")$upper
) |>
filter(relig_church_rc2 == "Seldom/Never") |>
arrange(jello_belt, year_4)
mormon_data |>
group_by(region) |>
count(relig_church_rc2, wt = weight) |>
drop_na() |>
mutate(
prop = n / sum(n),
total_n = sum(n),
lower = binom.confint(x = n, n = total_n, method = "asymptotic")$lower,
upper = binom.confint(x = n, n = total_n, method = "asymptotic")$upper
) |>
filter(relig_church_rc2 == "Seldom/Never")
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment