Skip to content

Instantly share code, notes, and snippets.

@acbass49

acbass49/26_political_compass.r

Last active January 16, 2026 07:27
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save acbass49/8b69a5abf126afaa89eb1e4418b659e9 to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save acbass49/8b69a5abf126afaa89eb1e4418b659e9 to your computer and use it in GitHub Desktop.
Download ZIP
26 CES Political Compass Over Time
Raw
26_political_compass.r
library(tidyverse)
library(haven)
library(sjlabelled)
library(car)
library(psych) # For factor analysis
library(lavaan)
library(ggrepel)
library(clipr)
library(binom)
# 2008
load('./data/CES/data/2008.RData')
# Check what objects were loaded
ls()
data <- x
# Step 1: identify features
econ <- c(
'CC309',
'CC311',
'CC312',
'CC316e',
'CC316h',
'CC316i',
'CC417',
'CC422'
)
social <- c(
'CC310', # Abortion
'CC316f', # Gay marriage
'CC419_3', # read passage from constitution
'CC419_6', #photo id when vote
'CC313' # affirmative action
)
features <- c(
econ,
social
)
data <- data |>
# Step 2: recode features to all be in same direction
mutate(
id = paste0('2008X', V100),
CC309 = car::recode(sjlabelled::as_numeric(CC309), "2=1; 1=-1;3=-1;else=NA"),
CC311 = car::recode(sjlabelled::as_numeric(CC311), "1=2;2=1;3=-1;4=-2;else=NA"),
CC316e = car::recode(sjlabelled::as_numeric(CC316e), "1=-1;2=1;3=0;else=NA"),
CC316h = car::recode(sjlabelled::as_numeric(CC316h), "1=1;2=-1;3=0;else=NA"),
CC316i = car::recode(sjlabelled::as_numeric(CC316i), "1=-1;2=1;3=0;else=NA"),
CC417 = car::recode(sjlabelled::as_numeric(CC417), "1=-2;2=-1;3=1;4=2;else=NA"),
CC422 = car::recode(sjlabelled::as_numeric(CC422), "1=-1;2=1;3=0;else=NA"),
CC310 = car::recode(sjlabelled::as_numeric(CC310), "1=2;2=1;3=-1;4=-2;else=NA"),
CC316f = car::recode(sjlabelled::as_numeric(CC316f), "1=1;2=-1;3=0;else=NA"),
CC419_3 = car::recode(sjlabelled::as_numeric(CC419_3), "1=1;2=-1;3=0;else=NA"),
CC419_6 = car::recode(sjlabelled::as_numeric(CC419_6), "1=1;2=-1;3=0;else=NA"),
CC313 = car::recode(sjlabelled::as_numeric(CC313), "1=-2;2=-1;3=1;4=2;else=NA")
) |>
# Step 3: impute data at mean and standardize
mutate(across(all_of(features), as.numeric)) |>
mutate(across(all_of(features),\(x) tidyr::replace_na(x, mean(x, na.rm = TRUE)))) |>
mutate(across(all_of(features), \(x) (x / max(x, na.rm = TRUE))))
data$social <- data |>
select(all_of(social)) |>
rowMeans(na.rm = TRUE)
data$social <- (data$social - mean(data$social, na.rm = TRUE)) / sd(data$social, na.rm = TRUE)
data$econ <- data |>
select(all_of(econ)) |>
rowMeans(na.rm = TRUE)
data$econ <- (data$econ - mean(data$econ, na.rm = TRUE)) / sd(data$econ, na.rm = TRUE)
data$V219 <- sjlabelled::as_labelled(data$V219)
data$V211 <- sjlabelled::as_labelled(data$V211)
data$V215 <- sjlabelled::as_labelled(data$V215)
data$religion_rc <- dplyr::case_when(
data$V219 == 1 & data$V211 == 2 ~ "Black Protestant",
data$V219 == 1 & data$V215 == 1 ~ "Evangelical",
data$V219 == 1 & data$V215 != 1 ~ "Mainline",
data$V219 == 2 ~ "Catholic",
data$V219 == 3 ~ "Mormon",
data$V219 == 4 ~ "Orthodox",
data$V219 == 5 ~ "Jewish",
data$V219 == 6 ~ "Muslim",
data$V219 == 7 ~ "Buddhist",
data$V219 == 8 ~ "Hindu",
data$V219 == 9 ~ "Atheist",
data$V219 == 10 ~ "Agnostic",
data$V219 == 11 ~ "Nothing in particular",
TRUE ~ NA_character_
)
data$cluster <- dplyr::case_when(
data$V218 == "Several times a day" & data$V216 == "Very important" & data$V217 %in% c("Once a week", "More than once a week") ~ "Devout Traditionalist",
data$V217 %in% c("Once a week", "More than once a week", "Once or twice a month") ~ "Adaptive Believer",
TRUE ~ "Cultural Mormon"
)
plot <- data |>
ggplot() +
geom_jitter(aes(x = econ, y = social),alpha = 0.05, width = 0.3, height = 0.3) +
geom_point(data = data |>
group_by(religion_rc) |>
summarise(
mean_econ = weighted.mean(econ, na.rm = TRUE, w = V201),
mean_soc = weighted.mean(social, na.rm = TRUE, w = V201),
n = n()
) |>
drop_na(), aes(x = mean_econ, y = mean_soc, size = n, color = religion_rc), alpha = 0.7) +
geom_text_repel(
data = data |>
group_by(religion_rc) |>
summarise(
mean_econ = weighted.mean(econ, na.rm = TRUE, w = V201),
mean_soc = weighted.mean(social, na.rm = TRUE, w = V201),
n = n()
) |>
drop_na(), aes(x = mean_econ, y = mean_soc, label = religion_rc, color = religion_rc), size = 2.5, max.overlaps = Inf, fontface = "bold") +
xlim(-3,3) +
ylim(-3,3) +
theme(
axis.ticks = element_blank(),
axis.title = element_text(size = 14),
axis.text.y = element_text(size = 10),
axis.text.x = element_text(size = 10, 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.title = element_blank(),
legend.background = element_blank(),
legend.box.background = element_blank(),
legend.key = element_blank(),
legend.text = element_text(size = 5),
panel.grid = element_blank(),
legend.position = "none",
panel.grid.major.y = element_line(color = "lightgrey", linetype = 'solid'),
panel.grid.major.x = element_line(color = "lightgrey", linetype = 'solid'),
plot.caption = element_text(size = 8,family = "Cairo")
)+
guides(size = "none") +
labs(
title = "2008 Political Compass by Religion",
subtitle = "Comprehensive Variable Set (n = 13 Policy Questions)",
x = "Economic (Left - Right)",
y = "Social (Libertarian - Authoritarian)",
caption = "@mormon_metrics\nData: 2008 Cooperative Election Study (n=32,800)"
)
ggsave("./images/26_political_compass_2008.png", plot, width = 1500, height = 1500, units = "px", dpi = 300)
data |>
filter(religion_rc == "Mormon") |>
count(cluster)
plot <- data |>
filter(religion_rc == "Mormon") |>
ggplot() +
geom_jitter(aes(x = econ, y = social),alpha = 0.05, width = 0.3, height = 0.3) +
geom_point(data = data |>
filter(religion_rc == "Mormon") |>
group_by(cluster) |>
summarise(
mean_econ = weighted.mean(econ, na.rm = TRUE, w = V201),
mean_soc = weighted.mean(social, na.rm = TRUE, w = V201),
n = n()
) |>
drop_na(), aes(x = mean_econ, y = mean_soc, size = n, color = cluster), alpha = 0.7) +
geom_text_repel(
data = data |>
filter(religion_rc == "Mormon") |>
group_by(cluster) |>
summarise(
mean_econ = weighted.mean(econ, na.rm = TRUE, w = V201),
mean_soc = weighted.mean(social, na.rm = TRUE, w = V201),
n = n()
) |>
drop_na(), aes(x = mean_econ, y = mean_soc, label = cluster, color = cluster), size = 2.5, max.overlaps = Inf, fontface = "bold") +
xlim(-3,3) +
ylim(-3,3) +
scale_size_area(max_size = 8) +
theme(
axis.ticks = element_blank(),
axis.title = element_text(size = 14),
axis.text.y = element_text(size = 10),
axis.text.x = element_text(size = 10, 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.title = element_blank(),
legend.background = element_blank(),
legend.box.background = element_blank(),
legend.key = element_blank(),
legend.text = element_text(size = 5),
panel.grid = element_blank(),
legend.position = "none",
panel.grid.major.y = element_line(color = "lightgrey", linetype = 'solid'),
panel.grid.major.x = element_line(color = "lightgrey", linetype = 'solid'),
plot.caption = element_text(size = 8,family = "Cairo")
)+
guides(size = "none") +
labs(
title = "2008 Political Compass by LDS Cluster",
subtitle = "Comprehensive Variable Set (n = 13 Policy Questions)",
x = "Economic (Left - Right)",
y = "Social (Libertarian - Authoritarian)",
caption = "@mormon_metrics\nData: 2008 Cooperative Election Study (n=629 LDS)"
)
ggsave("./images/26_political_compass_2008_mormon.png", plot, width = 1500, height = 1500, units = "px", dpi = 300)
# 2012
data <- load('./data/CES/data/2012.RData')
data <- x
social <- c(
'CC320',
'CC322_1',
'CC322_2',
'CC322_3',
'CC322_4',
'CC322_5',
'CC322_6',
'CC326',
'CC327',
'CC332E',
'CC332J',
'CC414_2',
'CC414_3',
'CC414_4',
'CC422a',
'CC422b'
)
econ <- c(
'CC325',
'CC328',
'CC332A',
'CC332B',
'CC332C',
'CC332D',
'CC332F',
'CC332G',
'CC332H',
'CC332I',
'CC414_2',
'CC414_3'
)
features <- c(
econ,
social
)
data <- data |>
# Step 2: recode features to all be in same direction
mutate(
#social
CC320 = car::recode(sjlabelled::as_numeric(CC320), "1=1; 2=-1;3=0;else=NA"),
CC322_1 = car::recode(sjlabelled::as_numeric(CC322_1), "1=1;2=-1;else=NA"),
CC322_2 = car::recode(sjlabelled::as_numeric(CC322_2), "1=1;2=-1;else=NA"),
CC322_3 = car::recode(sjlabelled::as_numeric(CC322_3), "1=1;2=-1;else=NA"),
CC322_4 = car::recode(sjlabelled::as_numeric(CC322_4), "1=1;2=-1;else=NA"),
CC322_5 = car::recode(sjlabelled::as_numeric(CC322_5), "1=1;2=-1;else=NA"),
CC322_6 = car::recode(sjlabelled::as_numeric(CC322_6), "1=1;2=-1;else=NA"),
CC326 = car::recode(sjlabelled::as_numeric(CC326), "1=2;2=1;3=-1;4=-2;else=NA"),
CC327 = car::recode(sjlabelled::as_numeric(CC327), "1=-2;2=-1;3=1;4=2;else=NA"),
CC332E = car::recode(sjlabelled::as_numeric(CC332E), "1=1;2=-1;else=NA"),
CC332J = car::recode(sjlabelled::as_numeric(CC332J), "1=-1;2=1;else=NA"),
CC414_2 = car::recode(sjlabelled::as_numeric(CC414_2), "1=1;2=-1;else=NA"),
CC414_3 = car::recode(sjlabelled::as_numeric(CC414_3), "1=1;2=-1;else=NA"),
CC414_4 = car::recode(sjlabelled::as_numeric(CC414_4), "1=-1;2=1;else=NA"),
CC422a = car::recode(sjlabelled::as_numeric(CC422a), "1=-2;2=-1;3=0;4=1;5=2;else=NA"),
CC422b = car::recode(sjlabelled::as_numeric(CC422b), "1=-2;2=-1;3=0;4=1;5=2;else=NA"),
#econ
CC325 = car::recode(sjlabelled::as_numeric(CC325), "1=-2;2=-1;3=0;4=1;5=2;else=NA"),
CC328 = car::recode(sjlabelled::as_numeric(CC328), "1=-1;2=1;3=-1;else=NA"),
CC332A = car::recode(sjlabelled::as_numeric(CC332A), "1=1;2=-1;else=NA"),
CC332B = car::recode(sjlabelled::as_numeric(CC332B), "1=1;2=-1;else=NA"),
CC332C = car::recode(sjlabelled::as_numeric(CC332C), "1=-1;2=1;else=NA"),
CC332D = car::recode(sjlabelled::as_numeric(CC332D), "1=1;2=-1;else=NA"),
CC332F = car::recode(sjlabelled::as_numeric(CC332F), "1=1;2=-1;else=NA"),
CC332G = car::recode(sjlabelled::as_numeric(CC332G), "1=1;2=-1;else=NA"),
CC332H = car::recode(sjlabelled::as_numeric(CC332H), "1=1;2=-1;else=NA"),
CC332I = car::recode(sjlabelled::as_numeric(CC332I), "1=-1;2=1;else=NA"),
CC414_2 = car::recode(sjlabelled::as_numeric(CC414_2), "1=1;2=-1;3=0;else=NA"),
CC414_2 = car::recode(sjlabelled::as_numeric(CC414_2), "1=1;2=-1;3=0;else=NA"),
CC414_3 = car::recode(sjlabelled::as_numeric(CC414_3), "1=-2;2=-1;3=1;4=2;else=NA")
) |>
# Step 3: impute data at mean and standardize
mutate(across(all_of(features), as.numeric)) |>
mutate(across(all_of(features),\(x) tidyr::replace_na(x, mean(x, na.rm = TRUE)))) |>
mutate(across(all_of(features), \(x) (x / max(x, na.rm = TRUE))))
data$social <- data |>
select(all_of(social)) |>
rowMeans(na.rm = TRUE)
data$social <- (data$social - mean(data$social, na.rm = TRUE)) / sd(data$social, na.rm = TRUE)
data$econ <- data |>
select(all_of(econ)) |>
rowMeans(na.rm = TRUE)
data$econ <- (data$econ - mean(data$econ, na.rm = TRUE)) / sd(data$econ, na.rm = TRUE)
data$race <- sjlabelled::as_labelled(data$race)
data$pew_bornagain <- sjlabelled::as_labelled(data$pew_bornagain)
data$religpew <- sjlabelled::as_labelled(data$religpew)
data$religion_rc <- dplyr::case_when(
data$religpew == 1 & data$race == 2 ~ "Black Protestant",
data$religpew == 1 & data$pew_bornagain == 1 ~ "Evangelical",
data$religpew == 1 & data$pew_bornagain != 1 ~ "Mainline",
data$religpew == 2 ~ "Catholic",
data$religpew == 3 ~ "Mormon",
data$religpew == 4 ~ "Orthodox",
data$religpew == 5 ~ "Jewish",
data$religpew == 6 ~ "Muslim",
data$religpew == 7 ~ "Buddhist",
data$religpew == 8 ~ "Hindu",
data$religpew == 9 ~ "Atheist",
data$religpew == 10 ~ "Agnostic",
data$religpew == 11 ~ "Nothing in particular",
TRUE ~ NA_character_
)
data$cluster <- dplyr::case_when(
data$pew_prayer == "Several times a day" & data$pew_religimp == "Very important" & data$pew_churatd %in% c("Once a week", "More than once a week") ~ "Devout Traditionalist",
data$pew_churatd %in% c("Once a week", "More than once a week", "Once or twice a month") ~ "Adaptive Believer",
TRUE ~ "Cultural Mormon"
)
plot <- data |>
ggplot() +
geom_jitter(aes(x = econ, y = social),alpha = 0.05, width = 0.3, height = 0.3) +
geom_point(data = data |>
group_by(religion_rc) |>
summarise(
mean_econ = weighted.mean(econ, na.rm = TRUE, w = V103),
mean_soc = weighted.mean(social, na.rm = TRUE, w = V103),
n = n()
) |>
drop_na(), aes(x = mean_econ, y = mean_soc, size = n, color = religion_rc), alpha = 0.7) +
geom_text_repel(
data = data |>
group_by(religion_rc) |>
summarise(
mean_econ = weighted.mean(econ, na.rm = TRUE, w = V103),
mean_soc = weighted.mean(social, na.rm = TRUE, w = V103),
n = n()
) |>
drop_na(), aes(x = mean_econ, y = mean_soc, label = religion_rc, color = religion_rc), size = 2.5, max.overlaps = Inf, fontface = "bold") +
xlim(-3,3) +
ylim(-3,3) +
theme(
axis.ticks = element_blank(),
axis.title = element_text(size = 14),
axis.text.y = element_text(size = 10),
axis.text.x = element_text(size = 10, 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.title = element_blank(),
legend.background = element_blank(),
legend.box.background = element_blank(),
legend.key = element_blank(),
legend.text = element_text(size = 5),
panel.grid = element_blank(),
legend.position = "none",
panel.grid.major.y = element_line(color = "lightgrey", linetype = 'solid'),
panel.grid.major.x = element_line(color = "lightgrey", linetype = 'solid'),
plot.caption = element_text(size = 8,family = "Cairo")
)+
guides(size = "none") +
labs(
title = "2012 Political Compass by Religion",
subtitle = "Comprehensive Variable Set (n = 28 Policy Questions)",
x = "Economic (Left - Right)",
y = "Social (Libertarian - Authoritarian)",
caption = "@mormon_metrics\nData: 2012 Cooperative Election Study (n=54,535)"
)
ggsave("./images/26_political_compass_2012.png", plot, width = 1500, height = 1500, units = "px", dpi = 300)
data |>
filter(religion_rc == "Mormon") |>
nrow()
plot <- data |>
filter(religion_rc == "Mormon") |>
ggplot() +
geom_jitter(aes(x = econ, y = social),alpha = 0.05, width = 0.3, height = 0.3) +
geom_point(data = data |>
filter(religion_rc == "Mormon") |>
group_by(cluster) |>
summarise(
mean_econ = weighted.mean(econ, na.rm = TRUE, w = V103),
mean_soc = weighted.mean(social, na.rm = TRUE, w = V103),
n = n()
) |>
drop_na(), aes(x = mean_econ, y = mean_soc, size = n, color = cluster), alpha = 0.7) +
geom_text_repel(
data = data |>
filter(religion_rc == "Mormon") |>
group_by(cluster) |>
summarise(
mean_econ = weighted.mean(econ, na.rm = TRUE, w = V103),
mean_soc = weighted.mean(social, na.rm = TRUE, w = V103),
n = n()
) |>
drop_na(), aes(x = mean_econ, y = mean_soc, label = cluster, color = cluster), size = 2.5, max.overlaps = Inf, fontface = "bold") +
xlim(-3,3) +
ylim(-3,3) +
scale_size_area(max_size = 8) +
theme(
axis.ticks = element_blank(),
axis.title = element_text(size = 14),
axis.text.y = element_text(size = 10),
axis.text.x = element_text(size = 10, 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.title = element_blank(),
legend.background = element_blank(),
legend.box.background = element_blank(),
legend.key = element_blank(),
legend.text = element_text(size = 5),
panel.grid = element_blank(),
legend.position = "none",
panel.grid.major.y = element_line(color = "lightgrey", linetype = 'solid'),
panel.grid.major.x = element_line(color = "lightgrey", linetype = 'solid'),
plot.caption = element_text(size = 8,family = "Cairo")
)+
guides(size = "none") +
labs(
title = "2012 Political Compass by LDS Cluster",
subtitle = "Comprehensive Variable Set (n = 28 Policy Questions)",
x = "Economic (Left - Right)",
y = "Social (Libertarian - Authoritarian)",
caption = "@mormon_metrics\nData: 2012 Cooperative Election Study (n=906 LDS)"
)
ggsave("./images/26_political_compass_2012_mormon.png", plot, width = 1500, height = 1500, units = "px", dpi = 300)
# 2016
# Load data
# Ensure the file path matches where you saved the 2016 data
data <- load('./data/CES/data/2016.RData')
data <- x
# --- 1. Define Variable Lists ---
# SOCIAL VARIABLES
# (Abortion, Guns, Immigration, Policing, Foreign Policy)
social <- c(
# Abortion
'CC16_332a', # Choice (Left)
'CC16_332b', # Rape/Incest Exceptions (Right)
'CC16_332c', # 20-Week Ban (Right)
'CC16_332d', # Insurance Opt-Out (Right)
'CC16_332e', # Federal Funding Ban (Right)
'CC16_332f', # Total Ban (Right)
# LGBT
'CC16_335', # Gay Marriage (Left)
# Guns
'CC16_330a', # Background Checks (Left)
'CC16_330b', # Publish Owners (Left)
'CC16_330d', # Ban Assault Rifles (Left)
'CC16_330e', # Concealed Carry (Right)
# Immigration
'CC16_331_1', # Amnesty (Left)
'CC16_331_2', # Border Patrol (Right)
'CC16_331_3', # Dreamers (Left)
'CC16_331_7', # Deportation (Right)
'CC16_331_8', # Muslim Ban (Right)
# Crime & Policing
'CC16_334a', # Eliminate Mandatory Mins (Left)
'CC16_334b', # Body Cameras (Left)
'CC16_334c', # Increase Police (Right)
'CC16_334d', # Increase Sentencing (Right)
'CC16_426_4', # State Spending: Law Enforcement (Right)
# Foreign Policy / Troops
'CC16_351C', # USA Freedom Act/Surveillance (Left/Libertarian)
'CC16_351G', # Iran Sanctions (Right)
'CC16_414_1', # Troops: Oil (Right)
'CC16_414_2', # Troops: Terrorist Camp (Right)
'CC16_414_3', # Troops: Genocide (Left)
'CC16_414_4', # Troops: Democracy (Right - Neocon)
'CC16_414_5', # Troops: Protect Allies (Right)
'CC16_414_6' # Troops: UN / Int'l Law (Left)
)
# ECONOMIC VARIABLES
# (Taxes, Spending, Environment, Regulation)
econ <- c(
'CC16_351I', # Repeal ACA (Right)
'CC16_351K', # Min Wage $12 (Left)
'CC16_351B', # TPP Trade Deal (Right/Globalist)
'CC16_351D', # Trade Adjustment Assistance (Left)
'CC16_351F', # Transport Funding (Left)
'CC16_351H', # Medicare Reform (Right)
# Environment
'CC16_333a', # EPA CO2 Regulation (Left)
'CC16_333b', # Fuel Efficiency Standards (Left)
'CC16_333c', # Renewable Mandate (Left)
'CC16_333d', # Clean Air Act vs Jobs (Left)
# State Spending
'CC16_426_1', # Welfare (Left)
'CC16_426_2', # Healthcare (Left)
'CC16_426_3', # Education (Left)
'CC16_426_5' # Transportation (Left)
)
features <- c(econ, social)
# --- 2. Recode Data ---
# Logic: Right/Conservative = 1, Left/Liberal = -1
data <- data |>
mutate(
# --- SOCIAL RECODING ---
# Abortion (1=Support, 2=Oppose)
CC16_332a = car::recode(sjlabelled::as_numeric(CC16_332a), "1=-1; 2=1; else=NA"), # Choice -> Left
CC16_332b = car::recode(sjlabelled::as_numeric(CC16_332b), "1=1; 2=-1; else=NA"), # Restrictions -> Right
CC16_332c = car::recode(sjlabelled::as_numeric(CC16_332c), "1=1; 2=-1; else=NA"), # 20wk Ban -> Right
CC16_332d = car::recode(sjlabelled::as_numeric(CC16_332d), "1=1; 2=-1; else=NA"), # Ins Opt-out -> Right
CC16_332e = car::recode(sjlabelled::as_numeric(CC16_332e), "1=1; 2=-1; else=NA"), # Funding Ban -> Right
CC16_332f = car::recode(sjlabelled::as_numeric(CC16_332f), "1=1; 2=-1; else=NA"), # Total Ban -> Right
# Gay Marriage (1=Support, 2=Oppose)
CC16_335 = car::recode(sjlabelled::as_numeric(CC16_335), "1=-1; 2=1; else=NA"),
# Guns (1=Support, 2=Oppose)
CC16_330a = car::recode(sjlabelled::as_numeric(CC16_330a), "1=-1; 2=1; else=NA"), # Background Checks -> Left
CC16_330b = car::recode(sjlabelled::as_numeric(CC16_330b), "1=-1; 2=1; else=NA"), # Publish Owners -> Left
CC16_330d = car::recode(sjlabelled::as_numeric(CC16_330d), "1=-1; 2=1; else=NA"), # Ban Assault -> Left
CC16_330e = car::recode(sjlabelled::as_numeric(CC16_330e), "1=1; 2=-1; else=NA"), # Concealed Carry -> Right
# Immigration (1=Support, 2=Oppose)
CC16_331_1 = car::recode(sjlabelled::as_numeric(CC16_331_1), "1=-1; 2=1; else=NA"), # Amnesty -> Left
CC16_331_2 = car::recode(sjlabelled::as_numeric(CC16_331_2), "1=1; 2=-1; else=NA"), # Border Patrol -> Right
CC16_331_3 = car::recode(sjlabelled::as_numeric(CC16_331_3), "1=-1; 2=1; else=NA"), # Dreamers -> Left
CC16_331_7 = car::recode(sjlabelled::as_numeric(CC16_331_7), "1=1; 2=-1; else=NA"), # Deportation -> Right
CC16_331_8 = car::recode(sjlabelled::as_numeric(CC16_331_8), "1=1; 2=-1; else=NA"), # Muslim Ban -> Right
# Crime (1=Support, 2=Oppose)
CC16_334a = car::recode(sjlabelled::as_numeric(CC16_334a), "1=-1; 2=1; else=NA"), # End Mand Min -> Left
CC16_334b = car::recode(sjlabelled::as_numeric(CC16_334b), "1=-1; 2=1; else=NA"), # Body Cams -> Left
CC16_334c = car::recode(sjlabelled::as_numeric(CC16_334c), "1=1; 2=-1; else=NA"), # More Police -> Right
CC16_334d = car::recode(sjlabelled::as_numeric(CC16_334d), "1=1; 2=-1; else=NA"), # Sentencing -> Right
# Foreign Policy (1=Support, 2=Oppose)
CC16_351G = car::recode(sjlabelled::as_numeric(CC16_351G), "1=1; 2=-1; else=NA"), # Iran Sanctions -> Right
# Troops (1=Yes, 2=No)
CC16_414_1 = car::recode(sjlabelled::as_numeric(CC16_414_1), "1=1; 2=-1; else=NA"), # Oil -> Right
CC16_414_2 = car::recode(sjlabelled::as_numeric(CC16_414_2), "1=1; 2=-1; else=NA"), # Terrorists -> Right
CC16_414_3 = car::recode(sjlabelled::as_numeric(CC16_414_3), "1=-1; 2=1; else=NA"), # Genocide -> Left
CC16_414_4 = car::recode(sjlabelled::as_numeric(CC16_414_4), "1=1; 2=-1; else=NA"), # Democracy -> Right
CC16_414_5 = car::recode(sjlabelled::as_numeric(CC16_414_5), "1=1; 2=-1; else=NA"), # Allies -> Right
CC16_414_6 = car::recode(sjlabelled::as_numeric(CC16_414_6), "1=-1; 2=1; else=NA"), # UN -> Left
# --- ECONOMIC RECODING ---
# ACA & Medicare (1=Support, 2=Oppose)
CC16_351I = car::recode(sjlabelled::as_numeric(CC16_351I), "1=1; 2=-1; else=NA"), # Repeal ACA -> Right
CC16_351H = car::recode(sjlabelled::as_numeric(CC16_351H), "1=1; 2=-1; else=NA"), # Medicare Reform -> Right
# Min Wage & Spending (1=Support, 2=Oppose)
CC16_351K = car::recode(sjlabelled::as_numeric(CC16_351K), "1=-1; 2=1; else=NA"), # Min Wage -> Left
CC16_351F = car::recode(sjlabelled::as_numeric(CC16_351F), "1=-1; 2=1; else=NA"), # Transp Funds -> Left
CC16_351D = car::recode(sjlabelled::as_numeric(CC16_351D), "1=-1; 2=1; else=NA"), # Trade Aid -> Left
# Trade (1=Support, 2=Oppose)
CC16_351B = car::recode(sjlabelled::as_numeric(CC16_351B), "1=1; 2=-1; else=NA"), # TPP -> Right (Fiscal Conservative)
# Environment (1=Support, 2=Oppose)
CC16_333a = car::recode(sjlabelled::as_numeric(CC16_333a), "1=-1; 2=1; else=NA"), # EPA CO2 -> Left
CC16_333b = car::recode(sjlabelled::as_numeric(CC16_333b), "1=-1; 2=1; else=NA"), # Fuel Eff -> Left
CC16_333c = car::recode(sjlabelled::as_numeric(CC16_333c), "1=-1; 2=1; else=NA"), # Renewables -> Left
# Clean Air Act (1=Enforce/Left, 2=Jobs/Right)
CC16_333d = car::recode(sjlabelled::as_numeric(CC16_333d), "1=-1; 2=1; else=NA"),
# State Spending (1=Increase, 2=Same, 3=Decrease)
# Increase = -1 (Left) | Decrease = 1 (Right)
CC16_426_1 = car::recode(sjlabelled::as_numeric(CC16_426_1), "1=-2; 2=-1; 3=0; 4=1; 5=2; else=NA"), # Welfare -> Left
CC16_426_2 = car::recode(sjlabelled::as_numeric(CC16_426_2), "1=-2; 2=-1; 3=0; 4=1; 5=2; else=NA"), # Health -> Left
CC16_426_3 = car::recode(sjlabelled::as_numeric(CC16_426_3), "1=-2; 2=-1; 3=0; 4=1; 5=2; else=NA"), # Education -> Left
CC16_426_5 = car::recode(sjlabelled::as_numeric(CC16_426_5), "1=-2; 2=-1; 3=0; 4=1; 5=2; else=NA"), # Transport -> Left
# Police Spending works opposite (Increase = Right)
CC16_426_4 = car::recode(sjlabelled::as_numeric(CC16_426_4), "1=2; 2=1; 3=0; 4=-1; 5=-2; else=NA") # Police -> Right
) |>
# --- 3. Impute & Standardize ---
mutate(across(all_of(features), as.numeric)) |>
mutate(across(all_of(features), \(x) tidyr::replace_na(x, mean(x, na.rm = TRUE)))) |>
mutate(across(all_of(features), \(x) (x / max(abs(x), na.rm = TRUE))))
# --- 4. Calculate Scores ---
# Calculate Means
data$social <- data |>
select(all_of(social)) |>
rowMeans(na.rm = TRUE)
data$econ <- data |>
select(all_of(econ)) |>
rowMeans(na.rm = TRUE)
# Normalize Z-Scores
data$social <- (data$social - mean(data$social, na.rm = TRUE)) / sd(data$social, na.rm = TRUE)
data$econ <- (data$econ - mean(data$econ, na.rm = TRUE)) / sd(data$econ, na.rm = TRUE)
# --- 5. Demographics & Labels ---
data$race <- sjlabelled::as_labelled(data$race)
data$pew_bornagain <- sjlabelled::as_labelled(data$pew_bornagain)
data$religpew <- sjlabelled::as_labelled(data$religpew)
data <- data |>
mutate(religion_rc = dplyr::case_when(
religpew == 1 & race == 2 ~ "Black Protestant",
religpew == 1 & pew_bornagain == 1 ~ "Evangelical",
religpew == 1 & pew_bornagain != 1 ~ "Mainline",
religpew == 2 ~ "Catholic",
religpew == 3 ~ "Mormon",
religpew == 4 ~ "Orthodox",
religpew == 5 ~ "Jewish",
religpew == 6 ~ "Muslim",
religpew == 7 ~ "Buddhist",
religpew == 8 ~ "Hindu",
religpew == 9 ~ "Atheist",
religpew == 10 ~ "Agnostic",
religpew == 11 ~ "Nothing in particular",
TRUE ~ NA_character_
))
data$cluster <- dplyr::case_when(
data$pew_prayer == "Several times a day" & data$pew_religimp == "Very important" & data$pew_churatd %in% c("Once a week", "More than once a week") ~ "Devout Traditionalist",
data$pew_churatd %in% c("Once a week", "More than once a week", "Once or twice a month") ~ "Adaptive Believer",
TRUE ~ "Cultural Mormon"
)
# --- 6. Plotting ---
plot <- data |>
ggplot() +
geom_jitter(aes(x = econ, y = social), alpha = 0.05, width = 0.3, height = 0.3) +
# Weighted Means (Using 'commonweight' for 2016)
geom_point(data = data |>
group_by(religion_rc) |>
summarise(
mean_econ = weighted.mean(econ, na.rm = TRUE, w = commonweight),
mean_soc = weighted.mean(social, na.rm = TRUE, w = commonweight),
n = n()
) |>
drop_na(), aes(x = mean_econ, y = mean_soc, size = n, color = religion_rc), alpha = 0.7) +
geom_text_repel(
data = data |>
group_by(religion_rc) |>
summarise(
mean_econ = weighted.mean(econ, na.rm = TRUE, w = commonweight),
mean_soc = weighted.mean(social, na.rm = TRUE, w = commonweight),
n = n()
) |>
drop_na(), aes(x = mean_econ, y = mean_soc, label = religion_rc, color = religion_rc),
size = 2.5, max.overlaps = Inf, fontface = "bold") +
xlim(-3, 3) +
ylim(-3, 3) +
theme(
axis.ticks = element_blank(),
axis.title = element_text(size = 14),
axis.text.y = element_text(size = 10),
axis.text.x = element_text(size = 10, margin = margin(t = -5)),
plot.background = element_rect(fill = "grey95"),
panel.background = element_blank(),
text = element_text(face = "bold", family = "Cairo"),
plot.title = element_text(size = 15, face = "bold"),
plot.title.position = "plot",
plot.subtitle.position = "plot",
plot.subtitle = element_text(size = 11),
legend.position = "none",
panel.grid = element_blank(),
panel.grid.major.y = element_line(color = "lightgrey", linetype = 'solid'),
panel.grid.major.x = element_line(color = "lightgrey", linetype = 'solid'),
plot.caption = element_text(size = 8, family = "Cairo")
) +
labs(
title = "2016 Political Compass by Religion",
subtitle = "Comprehensive Variable Set (n = 43 Policy Questions)",
x = "Economic (Left - Right)",
y = "Social (Libertarian - Authoritarian)",
caption = "@mormon_metrics\nData: 2016 Cooperative Election Study"
)
ggsave("./images/26_political_compass_2016.png", plot, width = 1500, height = 1500, units = "px", dpi = 300)
data |>
filter(religion_rc == "Mormon") |>
nrow()
plot <- data |>
filter(religion_rc == "Mormon") |>
ggplot() +
geom_jitter(aes(x = econ, y = social),alpha = 0.05, width = 0.3, height = 0.3) +
geom_point(data = data |>
filter(religion_rc == "Mormon") |>
group_by(cluster) |>
summarise(
mean_econ = weighted.mean(econ, na.rm = TRUE, w = commonweight),
mean_soc = weighted.mean(social, na.rm = TRUE, w = commonweight),
n = n()
) |>
drop_na(), aes(x = mean_econ, y = mean_soc, size = n, color = cluster), alpha = 0.7) +
geom_text_repel(
data = data |>
filter(religion_rc == "Mormon") |>
group_by(cluster) |>
summarise(
mean_econ = weighted.mean(econ, na.rm = TRUE, w = commonweight),
mean_soc = weighted.mean(social, na.rm = TRUE, w = commonweight),
n = n()
) |>
drop_na(), aes(x = mean_econ, y = mean_soc, label = cluster, color = cluster), size = 2.5, max.overlaps = Inf, fontface = "bold") +
xlim(-3,3) +
ylim(-3,3) +
scale_size_area(max_size = 8) +
theme(
axis.ticks = element_blank(),
axis.title = element_text(size = 14),
axis.text.y = element_text(size = 10),
axis.text.x = element_text(size = 10, 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.title = element_blank(),
legend.background = element_blank(),
legend.box.background = element_blank(),
legend.key = element_blank(),
legend.text = element_text(size = 5),
panel.grid = element_blank(),
legend.position = "none",
panel.grid.major.y = element_line(color = "lightgrey", linetype = 'solid'),
panel.grid.major.x = element_line(color = "lightgrey", linetype = 'solid'),
plot.caption = element_text(size = 8,family = "Cairo")
)+
guides(size = "none") +
labs(
title = "2016 Political Compass by LDS Cluster",
subtitle = "Comprehensive Variable Set (n = 43 Policy Questions)",
x = "Economic (Left - Right)",
y = "Social (Libertarian - Authoritarian)",
caption = "@mormon_metrics\nData: 2016 Cooperative Election Study (n=870 LDS)"
)
ggsave("./images/26_political_compass_2016_mormon.png", plot, width = 1500, height = 1500, units = "px", dpi = 300)
# 2020
data <- haven::read_dta('./data/CES/data/2020.dta')
# --- 1. Define Variable Lists ---
# SOCIAL VARIABLES
# (Abortion, Guns, Immigration, Policing, Courts, Civil Rights, Racial Resentment)
social <- c(
# Abortion
'CC20_332a', # Choice (Left)
'CC20_332b', # Exceptions Only (Right)
'CC20_332c', # 20-Week Ban (Right)
'CC20_332d', # Ins Opt-Out (Right)
'CC20_332e', # Fed Funding Ban (Right)
'CC20_332f', # Total Ban (Right)
# Guns
'CC20_330a', # Privacy for Owners (Right)
'CC20_330b', # Ban Assault Rifles (Left)
'CC20_330c', # Concealed Carry (Right)
# Immigration
'CC20_331a', # Amnesty (Left)
'CC20_331b', # Border Patrol (Right)
'CC20_331c', # Sanctuary Cities/Withhold Funds (Right)
'CC20_331d', # Reduce Legal Immigration (Right)
'CC20_331e', # Border Wall Spending (Right)
'CC20_350e', # Dreamers/DACA (Left)
'CC20_442c', # Emergency Declaration for Wall (Right)
'CC20_442d', # Remain in Mexico Policy (Right)
# Policing & Criminal Justice (2020 Specific)
'CC20_334a', # End Mandatory Minimums (Left)
'CC20_334b', # Body Cameras (Left)
'CC20_334c', # Increase Police Funding (Right)
'CC20_334d', # Decrease Police Funding/Defund (Left)
'CC20_334e', # Ban Chokeholds (Left)
'CC20_334f', # Police Misconduct Registry (Left)
'CC20_334g', # End Military Gear Program (Left)
'CC20_334h', # End Qualified Immunity/Sue Police (Left)
'CC20_443_4', # State Spending: Law Enforcement (Right)
# Civil Rights & Social Issues
'CC20_350a', # Equality Act (LGBTQ) (Left)
'CC20_355d', # Trans Military Ban (Right)
'CC20_440c', # Sexism: Women seek power over men (Right)
'CC20_440d', # Sexism: Women easily offended (Right)
# Courts
'CC20_350c', # Confirm Kavanaugh (Right)
'CC20_356', # Confirm Amy Coney Barrett (Right)
# Racial Resentment / Attitudes
'CC20_440a', # White Privilege Exists (Left)
'CC20_440b', # Racial Problems are Rare (Right)
'CC20_441a', # Irish/Italians worked up, Blacks should too (Right)
'CC20_441b', # Legacy of Slavery hinders Blacks (Left)
'CC20_441e' # Whites don't understand Black problems (Left)
)
# ECONOMIC VARIABLES
# (Healthcare, Taxes, Spending, Environment, Trade, COVID Stimulus)
econ <- c(
# Healthcare
'CC20_327a', # Medicare for All (Left)
'CC20_327b', # Negotiate Drug Prices (Left)
'CC20_327c', # Medicare Age 50 (Left)
'CC20_327d', # Repeal ACA (Right)
'CC20_327e', # Restore Individual Mandate (Left)
# Wages & Labor
'CC20_350b', # Min Wage $15 (Left)
'CC20_350d', # Equal Pay Act (Left)
'CC20_355e', # SNAP Work Requirements (Right)
# Environment
'CC20_333a', # EPA CO2 Regulation (Left)
'CC20_333b', # Renewable Mandate (Left)
'CC20_333c', # Clean Air Act vs Jobs (Left)
'CC20_333d', # Fuel Efficiency (Left)
'CC20_355a', # Withdraw Paris Agreement (Right)
'CC20_355c', # Repeal Clean Power Plan (Right)
# Trade (Nationalist/Protectionist = Right in this era)
'CC20_338a', # China Tariffs (Right)
'CC20_338b', # Steel Tariffs (Right)
'CC20_355b', # Withdraw TPP (Right)
# COVID Stimulus & Spending
'CC20_351a', # CARES Act $2T (Left/Spending)
'CC20_351b', # HEROES Act $3T (Left/Spending)
'CC20_443_1', # State Spending: Welfare (Left)
'CC20_443_2', # State Spending: Healthcare (Left)
'CC20_443_3', # State Spending: Education (Left)
'CC20_443_5' # State Spending: Infrastructure (Left)
)
features <- c(econ, social)
# --- 2. Recode Data ---
# Logic: Right/Conservative = 1, Left/Liberal = -1
data <- data |>
mutate(
# --- SOCIAL RECODING ---
# Abortion (1=Support, 2=Oppose)
CC20_332a = car::recode(sjlabelled::as_numeric(CC20_332a), "1=-1; 2=1; else=NA"), # Choice -> Left
CC20_332b = car::recode(sjlabelled::as_numeric(CC20_332b), "1=1; 2=-1; else=NA"), # Exceptions -> Right
CC20_332c = car::recode(sjlabelled::as_numeric(CC20_332c), "1=1; 2=-1; else=NA"), # 20wk Ban -> Right
CC20_332d = car::recode(sjlabelled::as_numeric(CC20_332d), "1=1; 2=-1; else=NA"), # Opt Out -> Right
CC20_332e = car::recode(sjlabelled::as_numeric(CC20_332e), "1=1; 2=-1; else=NA"), # Funding Ban -> Right
CC20_332f = car::recode(sjlabelled::as_numeric(CC20_332f), "1=1; 2=-1; else=NA"), # Total Ban -> Right
# Guns (1=Support, 2=Oppose)
CC20_330a = car::recode(sjlabelled::as_numeric(CC20_330a), "1=1; 2=-1; else=NA"), # Privacy -> Right
CC20_330b = car::recode(sjlabelled::as_numeric(CC20_330b), "1=-1; 2=1; else=NA"), # Assault Ban -> Left
CC20_330c = car::recode(sjlabelled::as_numeric(CC20_330c), "1=1; 2=-1; else=NA"), # Concealed -> Right
# Immigration (1=Support, 2=Oppose)
CC20_331a = car::recode(sjlabelled::as_numeric(CC20_331a), "1=-1; 2=1; else=NA"), # Amnesty -> Left
CC20_331b = car::recode(sjlabelled::as_numeric(CC20_331b), "1=1; 2=-1; else=NA"), # Border Patrol -> Right
CC20_331c = car::recode(sjlabelled::as_numeric(CC20_331c), "1=1; 2=-1; else=NA"), # Sanctuary/Funds -> Right
CC20_331d = car::recode(sjlabelled::as_numeric(CC20_331d), "1=1; 2=-1; else=NA"), # Reduce Legal -> Right
CC20_331e = car::recode(sjlabelled::as_numeric(CC20_331e), "1=1; 2=-1; else=NA"), # Border Wall -> Right
CC20_350e = car::recode(sjlabelled::as_numeric(CC20_350e), "1=-1; 2=1; else=NA"), # Dreamers -> Left
CC20_442c = car::recode(sjlabelled::as_numeric(CC20_442c), "1=1; 2=-1; else=NA"), # Emerg Wall -> Right
CC20_442d = car::recode(sjlabelled::as_numeric(CC20_442d), "1=1; 2=-1; else=NA"), # Remain Mexico -> Right
# Policing (1=Support, 2=Oppose)
CC20_334a = car::recode(sjlabelled::as_numeric(CC20_334a), "1=-1; 2=1; else=NA"), # Mand Min -> Left
CC20_334b = car::recode(sjlabelled::as_numeric(CC20_334b), "1=-1; 2=1; else=NA"), # Body Cams -> Left
CC20_334c = car::recode(sjlabelled::as_numeric(CC20_334c), "1=1; 2=-1; else=NA"), # Increase Police -> Right
CC20_334d = car::recode(sjlabelled::as_numeric(CC20_334d), "1=-1; 2=1; else=NA"), # Defund -> Left
CC20_334e = car::recode(sjlabelled::as_numeric(CC20_334e), "1=-1; 2=1; else=NA"), # Chokeholds -> Left
CC20_334f = car::recode(sjlabelled::as_numeric(CC20_334f), "1=-1; 2=1; else=NA"), # Registry -> Left
CC20_334g = car::recode(sjlabelled::as_numeric(CC20_334g), "1=-1; 2=1; else=NA"), # End Mil Gear -> Left
CC20_334h = car::recode(sjlabelled::as_numeric(CC20_334h), "1=-1; 2=1; else=NA"), # Sue Police -> Left
# State Police Spending (1=Greatly Increase ... 5=Greatly Decrease)
# Increase = Right
CC20_443_4 = car::recode(sjlabelled::as_numeric(CC20_443_4), "1=2; 2=1; 3=0; 4=-1; 5=-2; else=NA"),
# Civil Rights & Courts
CC20_350a = car::recode(sjlabelled::as_numeric(CC20_350a), "1=-1; 2=1; else=NA"), # Equality Act -> Left
CC20_350c = car::recode(sjlabelled::as_numeric(CC20_350c), "1=1; 2=-1; else=NA"), # Kavanaugh -> Right
CC20_356 = car::recode(sjlabelled::as_numeric(CC20_356), "1=1; 2=-1; else=NA"), # Barrett -> Right
CC20_355d = car::recode(sjlabelled::as_numeric(CC20_355d), "1=1; 2=-1; else=NA"), # Trans Ban -> Right
# Racial Resentment / Sexism (1=Strongly Agree ... 5=Strongly Disagree)
CC20_440a = car::recode(sjlabelled::as_numeric(CC20_440a), "1=-2; 2=-1; 3=0; 4=1; 5=2; else=NA"), # White Adv -> Left
CC20_440b = car::recode(sjlabelled::as_numeric(CC20_440b), "1=2; 2=1; 3=0; 4=-1; 5=-2; else=NA"), # Rare Probs -> Right
CC20_440c = car::recode(sjlabelled::as_numeric(CC20_440c), "1=2; 2=1; 3=0; 4=-1; 5=-2; else=NA"), # Women Power -> Right
CC20_440d = car::recode(sjlabelled::as_numeric(CC20_440d), "1=2; 2=1; 3=0; 4=-1; 5=-2; else=NA"), # Women Offend -> Right
CC20_441a = car::recode(sjlabelled::as_numeric(CC20_441a), "1=2; 2=1; 3=0; 4=-1; 5=-2; else=NA"), # Irish/Work Up -> Right
CC20_441b = car::recode(sjlabelled::as_numeric(CC20_441b), "1=-2; 2=-1; 3=0; 4=1; 5=2; else=NA"), # Slavery -> Left
CC20_441e = car::recode(sjlabelled::as_numeric(CC20_441e), "1=-2; 2=-1; 3=0; 4=1; 5=2; else=NA"), # Whites dont understand -> Left
# --- ECONOMIC RECODING ---
# Healthcare (1=Support, 2=Oppose)
CC20_327a = car::recode(sjlabelled::as_numeric(CC20_327a), "1=-1; 2=1; else=NA"), # M4A -> Left
CC20_327b = car::recode(sjlabelled::as_numeric(CC20_327b), "1=-1; 2=1; else=NA"), # Drug Prices -> Left
CC20_327c = car::recode(sjlabelled::as_numeric(CC20_327c), "1=-1; 2=1; else=NA"), # Medicare 50 -> Left
CC20_327d = car::recode(sjlabelled::as_numeric(CC20_327d), "1=1; 2=-1; else=NA"), # Repeal ACA -> Right
CC20_327e = car::recode(sjlabelled::as_numeric(CC20_327e), "1=-1; 2=1; else=NA"), # Mandate -> Left
# Wages (1=Support, 2=Oppose)
CC20_350b = car::recode(sjlabelled::as_numeric(CC20_350b), "1=-1; 2=1; else=NA"), # Min Wage -> Left
CC20_350d = car::recode(sjlabelled::as_numeric(CC20_350d), "1=-1; 2=1; else=NA"), # Equal Pay -> Left
CC20_355e = car::recode(sjlabelled::as_numeric(CC20_355e), "1=1; 2=-1; else=NA"), # SNAP Work -> Right
# Environment (1=Support, 2=Oppose)
CC20_333a = car::recode(sjlabelled::as_numeric(CC20_333a), "1=-1; 2=1; else=NA"), # EPA CO2 -> Left
CC20_333b = car::recode(sjlabelled::as_numeric(CC20_333b), "1=-1; 2=1; else=NA"), # Renewable -> Left
CC20_333c = car::recode(sjlabelled::as_numeric(CC20_333c), "1=-1; 2=1; else=NA"), # Clean Air -> Left
CC20_333d = car::recode(sjlabelled::as_numeric(CC20_333d), "1=-1; 2=1; else=NA"), # Fuel Eff -> Left
CC20_355a = car::recode(sjlabelled::as_numeric(CC20_355a), "1=1; 2=-1; else=NA"), # Paris -> Right
CC20_355c = car::recode(sjlabelled::as_numeric(CC20_355c), "1=1; 2=-1; else=NA"), # Repeal Clean Power -> Right
# Trade (1=Support, 2=Oppose)
CC20_338a = car::recode(sjlabelled::as_numeric(CC20_338a), "1=1; 2=-1; else=NA"), # China Tariffs -> Right
CC20_338b = car::recode(sjlabelled::as_numeric(CC20_338b), "1=1; 2=-1; else=NA"), # Steel Tariffs -> Right
CC20_355b = car::recode(sjlabelled::as_numeric(CC20_355b), "1=1; 2=-1; else=NA"), # Withdraw TPP -> Right
# COVID Stimulus (1=Support, 2=Oppose)
CC20_351a = car::recode(sjlabelled::as_numeric(CC20_351a), "1=-1; 2=1; else=NA"), # CARES -> Left
CC20_351b = car::recode(sjlabelled::as_numeric(CC20_351b), "1=-1; 2=1; else=NA"), # HEROES -> Left
# State Spending (1=Greatly Increase ... 5=Greatly Decrease)
# Increase = Left (-), Decrease = Right (+)
CC20_443_1 = car::recode(sjlabelled::as_numeric(CC20_443_1), "1=-2; 2=-1; 3=0; 4=1; 5=2; else=NA"), # Welfare -> Left
CC20_443_2 = car::recode(sjlabelled::as_numeric(CC20_443_2), "1=-2; 2=-1; 3=0; 4=1; 5=2; else=NA"), # Health -> Left
CC20_443_3 = car::recode(sjlabelled::as_numeric(CC20_443_3), "1=-2; 2=-1; 3=0; 4=1; 5=2; else=NA"), # Ed -> Left
CC20_443_5 = car::recode(sjlabelled::as_numeric(CC20_443_5), "1=-2; 2=-1; 3=0; 4=1; 5=2; else=NA") # Infra -> Left
) |>
# --- 3. Impute & Standardize ---
mutate(across(all_of(features), as.numeric)) |>
mutate(across(all_of(features), \(x) tidyr::replace_na(x, mean(x, na.rm = TRUE)))) |>
mutate(across(all_of(features), \(x) (x / max(abs(x), na.rm = TRUE))))
# --- 4. Calculate Scores ---
# Calculate Means
data$social <- data |>
select(all_of(social)) |>
rowMeans(na.rm = TRUE)
data$econ <- data |>
select(all_of(econ)) |>
rowMeans(na.rm = TRUE)
# Normalize Z-Scores
data$social <- (data$social - mean(data$social, na.rm = TRUE)) / sd(data$social, na.rm = TRUE)
data$econ <- (data$econ - mean(data$econ, na.rm = TRUE)) / sd(data$econ, na.rm = TRUE)
# --- 5. Demographics & Labels ---
data$race <- sjlabelled::as_labelled(data$race)
data$pew_bornagain <- sjlabelled::as_labelled(data$pew_bornagain)
data$religpew <- sjlabelled::as_labelled(data$religpew)
data <- data |>
mutate(religion_rc = dplyr::case_when(
religpew == 1 & race == 2 ~ "Black Protestant",
religpew == 1 & pew_bornagain == 1 ~ "Evangelical",
religpew == 1 & pew_bornagain != 1 ~ "Mainline",
religpew == 2 ~ "Catholic",
religpew == 3 ~ "Mormon",
religpew == 4 ~ "Orthodox",
religpew == 5 ~ "Jewish",
religpew == 6 ~ "Muslim",
religpew == 7 ~ "Buddhist",
religpew == 8 ~ "Hindu",
religpew == 9 ~ "Atheist",
religpew == 10 ~ "Agnostic",
religpew == 11 ~ "Nothing in particular",
TRUE ~ NA_character_
))
# --- 6. Plotting ---
plot <- data |>
ggplot() +
geom_jitter(aes(x = econ, y = social), alpha = 0.05, width = 0.3, height = 0.3) +
# Weighted Means (Using 'commonweight' for 2020)
geom_point(data = data |>
group_by(religion_rc) |>
summarise(
mean_econ = weighted.mean(econ, na.rm = TRUE, w = commonweight),
mean_soc = weighted.mean(social, na.rm = TRUE, w = commonweight),
n = n()
) |>
drop_na(), aes(x = mean_econ, y = mean_soc, size = n, color = religion_rc), alpha = 0.7) +
geom_text_repel(
data = data |>
group_by(religion_rc) |>
summarise(
mean_econ = weighted.mean(econ, na.rm = TRUE, w = commonweight),
mean_soc = weighted.mean(social, na.rm = TRUE, w = commonweight),
n = n()
) |>
drop_na(), aes(x = mean_econ, y = mean_soc, label = religion_rc, color = religion_rc),
size = 2.5, max.overlaps = Inf, fontface = "bold") +
xlim(-3, 3) +
ylim(-3, 3) +
theme(
axis.ticks = element_blank(),
axis.title = element_text(size = 14),
axis.text.y = element_text(size = 10),
axis.text.x = element_text(size = 10, margin = margin(t = -5)),
plot.background = element_rect(fill = "grey95"),
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),
legend.position = "none",
panel.grid = element_blank(),
panel.grid.major.y = element_line(color = "lightgrey", linetype = 'solid'),
panel.grid.major.x = element_line(color = "lightgrey", linetype = 'solid'),
plot.caption = element_text(size = 8, family = "Cairo")
) +
labs(
title = "2020 Political Compass by Religion",
subtitle = "Comprehensive Variable Set (n=60 Policy Questions)",
x = "Economic (Left - Right)",
y = "Social (Libertarian - Authoritarian)",
caption = "@mormon_metrics\nData: 2020 Cooperative Election Study"
)
ggsave("./images/26_political_compass_2020.png", plot, width = 1500, height = 1500, units = "px", dpi = 300)
data |>
filter(religion_rc == "Mormon") |>
nrow()
data$cluster <- dplyr::case_when(
data$pew_prayer == 1 & data$pew_religimp == 1 & data$pew_churatd %in% 1:2 ~ "Devout Traditionalist",
data$pew_churatd %in% 1:3 ~ "Adaptive Believer",
TRUE ~ "Cultural Mormon"
)
plot <- data |>
filter(religion_rc == "Mormon") |>
ggplot() +
geom_jitter(aes(x = econ, y = social),alpha = 0.05, width = 0.3, height = 0.3) +
geom_point(data = data |>
filter(religion_rc == "Mormon") |>
group_by(cluster) |>
summarise(
mean_econ = weighted.mean(econ, na.rm = TRUE, w = commonweight),
mean_soc = weighted.mean(social, na.rm = TRUE, w = commonweight),
n = n()
) |>
drop_na(), aes(x = mean_econ, y = mean_soc, size = n, color = cluster), alpha = 0.7) +
geom_text_repel(
data = data |>
filter(religion_rc == "Mormon") |>
group_by(cluster) |>
summarise(
mean_econ = weighted.mean(econ, na.rm = TRUE, w = commonweight),
mean_soc = weighted.mean(social, na.rm = TRUE, w = commonweight),
n = n()
) |>
drop_na(), aes(x = mean_econ, y = mean_soc, label = cluster, color = cluster), size = 2.5, max.overlaps = Inf, fontface = "bold") +
xlim(-3,3) +
ylim(-3,3) +
scale_size_area(max_size = 8) +
theme(
axis.ticks = element_blank(),
axis.title = element_text(size = 14),
axis.text.y = element_text(size = 10),
axis.text.x = element_text(size = 10, 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.title = element_blank(),
legend.background = element_blank(),
legend.box.background = element_blank(),
legend.key = element_blank(),
legend.text = element_text(size = 5),
panel.grid = element_blank(),
legend.position = "none",
panel.grid.major.y = element_line(color = "lightgrey", linetype = 'solid'),
panel.grid.major.x = element_line(color = "lightgrey", linetype = 'solid'),
plot.caption = element_text(size = 8,family = "Cairo")
)+
guides(size = "none") +
labs(
title = "2020 Political Compass by LDS Cluster",
subtitle = "Comprehensive Variable Set (n=60 Policy Questions)",
x = "Economic (Left - Right)",
y = "Social (Libertarian - Authoritarian)",
caption = "@mormon_metrics\nData: 2020 Cooperative Election Study (n=763 LDS)"
)
ggsave("./images/26_political_compass_2020_mormon.png", plot, width = 1500, height = 1500, units = "px", dpi = 300)
# 2024
data <- haven::read_dta('./data/CES/data/2024.dta', encoding = 'UTF-8')
# Step 1: identify features
social <- c(
'CC24_308a_1',
'CC24_308a_2',
'CC24_308a_3',
'CC24_308a_4',
'CC24_308a_6',
'CC24_308b_1',
'CC24_308b_2',
'CC24_308b_3',
'CC24_308b_5',
'CC24_321a',
'CC24_321b',
'CC24_321c',
'CC24_321d',
'CC24_321e',
'CC24_323a',
'CC24_323b',
'CC24_323c',
'CC24_323d',
'CC24_324a',
'CC24_324b',
'CC24_324c',
'CC24_324d',
'CC24_340a',
'CC24_340b',
'CC24_340c',
'CC24_340d',
'CC24_340e',
'CC24_340f',
'CC24_420_1',
'CC24_420_2',
'CC24_420_3',
'CC24_420_4',
'CC24_420_5',
'CC24_420_6',
'CC24_420_7',
'CC24_444a',
'CC24_444b',
'CC24_444c',
'CC24_444d',
'CC24_444e',
'CC24_445a',
'CC24_445b',
'CC24_440a',
'CC24_440b',
'CC24_440c',
'CC24_440d',
'CC24_441a',
'CC24_441b',
'CC24_441e'
)
econ <- c(
'CC24_326a',
'CC24_326b',
'CC24_326c',
'CC24_326d',
'CC24_326e',
'CC24_326f',
'CC24_328a',
'CC24_328b',
'CC24_328c',
'CC24_328d',
'CC24_328e',
'CC24_443_1',
'CC24_443_2',
'CC24_443_3',
'CC24_443_4',
'CC24_443_5',
'CC24_444f'
)
features <- c(
econ,
social
)
data <- data |>
# Step 2: recode features to all be in same direction
mutate(
id = paste0('2024X', caseid),
CC24_308a_1 = car::recode(sjlabelled::as_numeric(CC24_308a_1), "1=-1; 2=1;else=NA"),
CC24_308a_2 = car::recode(sjlabelled::as_numeric(CC24_308a_2), "1=-1; 2=1;else=NA"),
CC24_308a_3 = car::recode(sjlabelled::as_numeric(CC24_308a_3), "1=1; 2=-1;else=NA"),
CC24_308a_4 = car::recode(sjlabelled::as_numeric(CC24_308a_4), "1=1; 2=-1;else=NA"),
CC24_308a_6 = car::recode(sjlabelled::as_numeric(CC24_308a_6), "1=1; 2=-1;else=NA"),
CC24_308b_1 = car::recode(sjlabelled::as_numeric(CC24_308b_1), "1=-1; 2=1;else=NA"),
CC24_308b_2 = car::recode(sjlabelled::as_numeric(CC24_308b_2), "1=-1; 2=1;else=NA"),
CC24_308b_3 = car::recode(sjlabelled::as_numeric(CC24_308b_3), "1=1; 2=-1;else=NA"),
CC24_308b_5 = car::recode(sjlabelled::as_numeric(CC24_308b_5), "1=1; 2=-1;else=NA"),
CC24_321a = car::recode(sjlabelled::as_numeric(CC24_321a), "1=-1;2=1;else=NA"),
CC24_321b = car::recode(sjlabelled::as_numeric(CC24_321b), "1=-1;2=1;else=NA"),
CC24_321c = car::recode(sjlabelled::as_numeric(CC24_321c), "1=-1;2=1;else=NA"),
CC24_321d = car::recode(sjlabelled::as_numeric(CC24_321d), "1=-1;2=1;else=NA"),
CC24_321e = car::recode(sjlabelled::as_numeric(CC24_321e), "1=1;2=-1;else=NA"),
CC24_323a = car::recode(sjlabelled::as_numeric(CC24_323a), "1=-1;2=1;3=0;else=NA"),
CC24_323b = car::recode(sjlabelled::as_numeric(CC24_323b), "1=1;2=-1;3=0;else=NA"),
CC24_323c = car::recode(sjlabelled::as_numeric(CC24_323c), "1=1;2=-1;3=0;else=NA"),
CC24_323d = car::recode(sjlabelled::as_numeric(CC24_323d), "1=-1;2=1;3=0;else=NA"),
CC24_324a = car::recode(sjlabelled::as_numeric(CC24_324a), "1=-1;2=1;3=0;else=NA"),
CC24_324b = car::recode(sjlabelled::as_numeric(CC24_324b), "1=1;2=-1;3=0;else=NA"),
CC24_324c = car::recode(sjlabelled::as_numeric(CC24_324c), "1=1;2=-1;3=0;else=NA"),
CC24_324d = car::recode(sjlabelled::as_numeric(CC24_324d), "1=-1;2=1;3=0;else=NA"),
CC24_340a = car::recode(sjlabelled::as_numeric(CC24_340a), "1=-1;2=1;else=NA"),
CC24_340b = car::recode(sjlabelled::as_numeric(CC24_340b), "1=-1;2=1;3=0;else=NA"),
CC24_340c = car::recode(sjlabelled::as_numeric(CC24_340c), "1=-1;2=1;3=0;else=NA"),
CC24_340d = car::recode(sjlabelled::as_numeric(CC24_340d), "1=1;2=-1;3=0;else=NA"),
CC24_340e = car::recode(sjlabelled::as_numeric(CC24_340e), "1=1;2=-1;3=0;else=NA"),
CC24_340f = car::recode(sjlabelled::as_numeric(CC24_340f), "1=1;2=-1;3=0;else=NA"),
CC24_420_1 = car::recode(sjlabelled::as_numeric(CC24_420_1), "1=1;2=-1;3=0;else=NA"),
CC24_420_2 = car::recode(sjlabelled::as_numeric(CC24_420_2), "1=1;2=-1;3=0;else=NA"),
CC24_420_3 = car::recode(sjlabelled::as_numeric(CC24_420_3), "1=1;2=-1;3=0;else=NA"),
CC24_420_4 = car::recode(sjlabelled::as_numeric(CC24_420_4), "1=1;2=-1;3=0;else=NA"),
CC24_420_5 = car::recode(sjlabelled::as_numeric(CC24_420_5), "1=-1;2=1;3=0;else=NA"),
CC24_420_6 = car::recode(sjlabelled::as_numeric(CC24_420_6), "1=-1;2=1;3=0;else=NA"),
CC24_420_7 = car::recode(sjlabelled::as_numeric(CC24_420_7), "1=-1;2=1;3=0;else=NA"),
CC24_440a = car::recode(sjlabelled::as_numeric(CC24_440a), "1=-2;2=-1;3=0;4=1;5=2;else=NA"),
CC24_440b = car::recode(sjlabelled::as_numeric(CC24_440b), "1=2;2=1;3=0;4=-1;5=-2;else=NA"),
CC24_440c = car::recode(sjlabelled::as_numeric(CC24_440c), "1=2;2=1;3=0;4=-1;5=-2;else=NA"),
CC24_440d = car::recode(sjlabelled::as_numeric(CC24_440d), "1=2;2=1;3=0;4=-1;5=-2;else=NA"),
CC24_445a = car::recode(sjlabelled::as_numeric(CC24_444d), "1=1;2=-1;else=NA"),
CC24_445b = car::recode(sjlabelled::as_numeric(CC24_445b), "1=1;2=-1;else=NA"),
CC24_444a = car::recode(sjlabelled::as_numeric(CC24_444a), "1=1;2=-1;3=0;else=NA"),
CC24_444b = car::recode(sjlabelled::as_numeric(CC24_444b), "1=1;2=-1;3=0;else=NA"),
CC24_444c = car::recode(sjlabelled::as_numeric(CC24_444c), "1=1;2=-1;3=0;else=NA"),
CC24_444d = car::recode(sjlabelled::as_numeric(CC24_444d), "1=1;2=-1;3=0;else=NA"),
CC24_444e = car::recode(sjlabelled::as_numeric(CC24_444e), "1=1;2=-1;3=0;else=NA"),
CC24_441a = car::recode(sjlabelled::as_numeric(CC24_441a), "1=2;2=1;3=0;4=-1;5=-2;else=NA"),
CC24_441b = car::recode(sjlabelled::as_numeric(CC24_441b), "1=-2;2=-1;3=0;4=1;5=2;else=NA"),
CC24_441e = car::recode(sjlabelled::as_numeric(CC24_441e), "1=-2;2=-1;3=0;4=1;5=2;else=NA"),
CC24_326a = car::recode(sjlabelled::as_numeric(CC24_326a), "1=-1;2=1;else=NA"),
CC24_326b = car::recode(sjlabelled::as_numeric(CC24_326b), "1=-1;2=1;else=NA"),
CC24_326c = car::recode(sjlabelled::as_numeric(CC24_326c), "1=-1;2=1;else=NA"),
CC24_326d = car::recode(sjlabelled::as_numeric(CC24_326d), "1=1;2=-1;else=NA"),
CC24_326e = car::recode(sjlabelled::as_numeric(CC24_326e), "1=-1;2=1;else=NA"),
CC24_326f = car::recode(sjlabelled::as_numeric(CC24_326f), "1=1;2=-1;else=NA"),
CC24_328a = car::recode(sjlabelled::as_numeric(CC24_328a), "1=1;2=-1;else=NA"),
CC24_328b = car::recode(sjlabelled::as_numeric(CC24_328b), "1=-1;2=1;else=NA"),
CC24_328c = car::recode(sjlabelled::as_numeric(CC24_328c), "1=1;2=-1;else=NA"),
CC24_328d = car::recode(sjlabelled::as_numeric(CC24_328d), "1=1;2=-1;else=NA"),
CC24_328e = car::recode(sjlabelled::as_numeric(CC24_328e), "1=-1;2=1;else=NA"),
CC24_443_1 = car::recode(sjlabelled::as_numeric(CC24_443_1), "1=-2;2=-1;3=0;4=1;5=2;else=NA"),
CC24_443_2 = car::recode(sjlabelled::as_numeric(CC24_443_2), "1=-2;2=-1;3=0;4=1;5=2;else=NA"),
CC24_443_3 = car::recode(sjlabelled::as_numeric(CC24_443_3), "1=-2;2=-1;3=0;4=1;5=2;else=NA"),
CC24_443_4 = car::recode(sjlabelled::as_numeric(CC24_443_4), "1=-2;2=-1;3=0;4=1;5=2;else=NA"),
CC24_443_5 = car::recode(sjlabelled::as_numeric(CC24_443_5), "1=-2;2=-1;3=0;4=1;5=2;else=NA"),
CC24_444f = car::recode(sjlabelled::as_numeric(CC24_444f), "1=-1;2=1;else=NA")
) |>
# Step 3: impute data at mean and standardize
mutate(across(all_of(features), as.numeric)) |>
mutate(across(all_of(features),\(x) tidyr::replace_na(x, mean(x, na.rm = TRUE))))
# # |>
# mutate(across(all_of(features), \(x) (x - mean(x, na.rm = TRUE)) / sd(x, na.rm = TRUE)))
# create a social and economic variable
data$social <- data |>
select(all_of(social)) |>
rowMeans(na.rm = TRUE)
data$social <- (data$social - mean(data$social, na.rm = TRUE)) / sd(data$social, na.rm = TRUE)
data$econ <- data |>
select(all_of(econ)) |>
rowMeans(na.rm = TRUE)
data$econ <- (data$econ - mean(data$econ, na.rm = TRUE)) / sd(data$econ, na.rm = TRUE)
data$religion_rc <- dplyr::case_when(
data$religpew == 1 & data$race == 2 ~ "Black Protestant",
data$religpew == 1 & data$pew_bornagain == 1 ~ "Evangelical",
data$religpew == 1 & data$pew_bornagain != 1 ~ "Mainline",
data$religpew == 2 ~ "Catholic",
data$religpew == 3 ~ "Mormon",
data$religpew == 4 ~ "Orthodox",
data$religpew == 5 ~ "Jewish",
data$religpew == 6 ~ "Muslim",
data$religpew == 7 ~ "Buddhist",
data$religpew == 8 ~ "Hindu",
data$religpew == 9 ~ "Atheist",
data$religpew == 10 ~ "Agnostic",
data$religpew == 11 ~ "Nothing in particular",
TRUE ~ NA_character_
)
plot <- data |>
ggplot() +
geom_jitter(aes(x = econ, y = social),alpha = 0.05, width = 0.3, height = 0.3) +
geom_point(data = data |>
group_by(religion_rc) |>
summarise(
mean_econ = weighted.mean(econ, na.rm = TRUE, w = commonweight),
mean_soc = weighted.mean(social, na.rm = TRUE, w = commonweight),
n = n()
) |>
drop_na(), aes(x = mean_econ, y = mean_soc, size = n, color = religion_rc), alpha = 0.7) +
geom_text_repel(
data = data |>
group_by(religion_rc) |>
summarise(
mean_econ = weighted.mean(econ, na.rm = TRUE, w = commonweight),
mean_soc = weighted.mean(social, na.rm = TRUE, w = commonweight),
n = n()
) |>
drop_na(), aes(x = mean_econ, y = mean_soc, label = religion_rc, color = religion_rc), size = 2.5, max.overlaps = Inf, fontface = "bold") +
xlim(-3,3) +
ylim(-3,3) +
theme(
axis.ticks = element_blank(),
axis.title = element_text(size = 14),
axis.text.y = element_text(size = 10),
axis.text.x = element_text(size = 10, 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.title = element_blank(),
legend.background = element_blank(),
legend.box.background = element_blank(),
legend.key = element_blank(),
legend.text = element_text(size = 5),
panel.grid = element_blank(),
legend.position = "none",
panel.grid.major.y = element_line(color = "lightgrey", linetype = 'solid'),
panel.grid.major.x = element_line(color = "lightgrey", linetype = 'solid'),
plot.caption = element_text(size = 8,family = "Cairo")
)+
guides(size = "none") +
labs(
title = "2024 Political Compass by Religion",
subtitle = "Comprehensive Variable Set (n = 66 Policy Questions)",
x = "Economic (Left - Right)",
y = "Social (Libertarian - Authoritarian)",
caption = "@mormon_metrics\nData: 2024 Cooperative Election Study"
)
ggsave("./images/26_political_compass_2024.png", plot, width = 1500, height = 1500, units = "px", dpi = 300)
data |>
filter(religion_rc == "Mormon") |>
nrow()
data$cluster <- dplyr::case_when(
data$pew_prayer == 1 & data$pew_religimp == 1 & data$pew_churatd %in% 1:2 ~ "Devout Traditionalist",
data$pew_churatd %in% 1:3 ~ "Adaptive Believer",
TRUE ~ "Cultural Mormon"
)
plot <- data |>
filter(religion_rc == "Mormon") |>
ggplot() +
geom_jitter(aes(x = econ, y = social),alpha = 0.05, width = 0.3, height = 0.3) +
geom_point(data = data |>
filter(religion_rc == "Mormon") |>
group_by(cluster) |>
summarise(
mean_econ = weighted.mean(econ, na.rm = TRUE, w = commonweight),
mean_soc = weighted.mean(social, na.rm = TRUE, w = commonweight),
n = n()
) |>
drop_na(), aes(x = mean_econ, y = mean_soc, size = n, color = cluster), alpha = 0.7) +
geom_text_repel(
data = data |>
filter(religion_rc == "Mormon") |>
group_by(cluster) |>
summarise(
mean_econ = weighted.mean(econ, na.rm = TRUE, w = commonweight),
mean_soc = weighted.mean(social, na.rm = TRUE, w = commonweight),
n = n()
) |>
drop_na(), aes(x = mean_econ, y = mean_soc, label = cluster, color = cluster), size = 2.5, max.overlaps = Inf, fontface = "bold") +
xlim(-3,3) +
ylim(-3,3) +
scale_size_area(max_size = 8) +
theme(
axis.ticks = element_blank(),
axis.title = element_text(size = 14),
axis.text.y = element_text(size = 10),
axis.text.x = element_text(size = 10, 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.title = element_blank(),
legend.background = element_blank(),
legend.box.background = element_blank(),
legend.key = element_blank(),
legend.text = element_text(size = 5),
panel.grid = element_blank(),
legend.position = "none",
panel.grid.major.y = element_line(color = "lightgrey", linetype = 'solid'),
panel.grid.major.x = element_line(color = "lightgrey", linetype = 'solid'),
plot.caption = element_text(size = 8,family = "Cairo")
)+
guides(size = "none") +
labs(
title = "2024 Political Compass by LDS Cluster",
subtitle = "Comprehensive Variable Set (n = 66 Policy Questions)",
x = "Economic (Left - Right)",
y = "Social (Libertarian - Authoritarian)",
caption = "@mormon_metrics\nData: 2024 Cooperative Election Study (n=623 LDS)"
)
ggsave("./images/26_political_compass_2024_mormon.png", plot, width = 1500, height = 1500, units = "px", dpi = 300)
data |>
mutate(type = dplyr::case_when(
econ < 0 & social < 0 ~ "Progressives",
econ >= 0 & social < 0 ~ "Libertarians",
econ < 0 & social >= 0 ~ "Populists",
econ >= 0 & social >= 0 ~ "Conservatives"
)) |>
count(type, wt = commonweight) |>
drop_na() |>
mutate(
prop = n / sum(n),
total_n = sum(n)
) |>
select(-c(total_n, n)) |>
pivot_wider(names_from = type, values_from = prop)
clipr::write_clip(
data |>
mutate(type = dplyr::case_when(
econ < 0 & social < 0 ~ "Progressives",
econ >= 0 & social < 0 ~ "Libertarians",
econ < 0 & social >= 0 ~ "Populists",
econ >= 0 & social >= 0 ~ "Conservatives"
)) |>
group_by(religion_rc) |>
count(type, wt = commonweight) |>
drop_na() |>
mutate(
prop = n / sum(n),
total_n = sum(n),
) |>
select(-c(total_n, n)) |>
pivot_wider(names_from = type, values_from = prop)
)
data |>
count(religpew)
data <- data |>
mutate(
# 1. Define the Broad Quadrant (Your existing logic)
quadrant = dplyr::case_when(
econ < 0 & social < 0 ~ "Progressive",
econ >= 0 & social < 0 ~ "Libertarian (Secular)",
econ < 0 & social >= 0 ~ "Populist (Left-Econ)",
econ >= 0 & social >= 0 ~ "Conservative",
TRUE ~ NA_character_
),
# 2. Sub-Divide the "Conservative" Quadrant
subtype = dplyr::case_when(
quadrant != "Conservative" ~ quadrant,
# GROUP A: The "Trump" Populist
# Disagrees that elections are fair (CC24_421_1) OR Supports Wall (CC24_323_3)
# Note: Check if your grid variables export as _1, _2 or a, b. Usually it is _1.
(CC24_421_1 >= 4 & CC24_323c == 1) ~ "Populist (Trump)",
# GROUP B: The "Romney" Establishment
# Supports Arms to Ukraine (CC24_308a = 4) AND Thinks Elections Fair (CC24_421_1 <= 2)
(CC24_308a_4 == 1 & CC24_421_1 <= 2) ~ "Establishment",
# GROUP C: The "Lee" Libertarian
# Opposes Infrastructure Spending (CC24_341_4) AND Opposes Medicaid Expansion (CC24_328_5)
(CC24_341d == 2 & CC24_328e == -1) ~ "Relig Libertarian",
TRUE ~ "Standard"
)
)
data |>
filter(quadrant == "Conservative") |>
count(subtype, wt = commonweight) |>
drop_na() |>
mutate(
prop = n / sum(n)
) |>
select(-n) |>
pivot_wider(names_from = subtype, values_from = prop)
clipr::write_clip(
data |>
filter(quadrant == "Conservative") |>
group_by(religion_rc) |>
count(subtype, wt = commonweight) |>
drop_na() |>
mutate(
prop = n / sum(n)
) |>
select(-n) |>
pivot_wider(names_from = subtype, values_from = prop) |>
filter(religion_rc %in% c("Mormon", "Evangelical", "Catholic", "Mainline", "Orthodox"))
)
data |>
filter(quadrant == "Conservative") |>
group_by(religion_rc) |>
count(subtype) |>
filter(religion_rc == "Mormon")
data |>
group_by(religion_rc) |>
count(quadrant) |>
filter(religion_rc == "Mormon")
# demographic breaks
# overall Quadrant breaks
# average age
data |>
filter(religion_rc == "Mormon") |>
group_by(quadrant) |>
summarise(
mean_age = weighted.mean(as.numeric(2024 - birthyr), w = commonweight, na.rm = TRUE),
n = n()
)
# gender breakdown
data |>
filter(religion_rc == "Mormon") |>
group_by(quadrant,gender4) |>
summarise(
n = n()
) |>
filter(gender4 %in% c(1,2)) |>
group_by(quadrant) |>
mutate(
prop = n / sum(n)
)
# education breakdown
data |>
mutate(ba = dplyr::case_when(
educ %in% c(1,2,3,4) ~ "No BA",
educ %in% c(5,6) ~ "BA+",
TRUE ~ NA_character_
)) |>
filter(religion_rc == "Mormon") |>
group_by(quadrant, ba) |>
summarise(
n = n()
) |>
group_by(quadrant) |>
mutate(
prop = n / sum(n)
)
# race breakdown
data |>
mutate(white = ifelse(race == 1, "White", "Non-White")) |>
filter(religion_rc == "Mormon") |>
group_by(quadrant, white) |>
summarise(
n = n()
) |>
group_by(quadrant) |>
mutate(
prop = n / sum(n)
)
# region breakdown
data |>
mutate(jello_belt = ifelse(inputstate %in% c(49,16), "Utah/Idaho", "Non-Jello Belt")) |>
filter(religion_rc == "Mormon") |>
group_by(quadrant, jello_belt) |>
summarise(
n = n()
) |>
group_by(quadrant) |>
mutate(
prop = n / sum(n)
)
# Subtype
# average age
data |>
filter(religion_rc == "Mormon") |>
group_by(subtype) |>
summarise(
mean_age = weighted.mean(as.numeric(2024 - birthyr), w = commonweight, na.rm = TRUE),
n = n()
)
# gender breakdown
data |>
filter(religion_rc == "Mormon") |>
group_by(subtype,gender4) |>
summarise(
n = n()
) |>
filter(gender4 %in% c(1,2)) |>
group_by(subtype) |>
mutate(
prop = n / sum(n)
)
# education breakdown
data |>
mutate(ba = dplyr::case_when(
educ %in% c(1,2,3,4) ~ "No BA",
educ %in% c(5,6) ~ "BA+",
TRUE ~ NA_character_
)) |>
filter(religion_rc == "Mormon") |>
group_by(subtype, ba) |>
summarise(
n = n()
) |>
group_by(subtype) |>
mutate(
prop = n / sum(n)
)
# race breakdown
data |>
mutate(white = ifelse(race == 1, "White", "Non-White")) |>
filter(religion_rc == "Mormon") |>
group_by(subtype, white) |>
summarise(
n = n()
) |>
group_by(subtype) |>
mutate(
prop = n / sum(n)
)
# region breakdown
data |>
mutate(jello_belt = ifelse(inputstate %in% c(49,16), "Utah/Idaho", "Non-Jello Belt")) |>
filter(religion_rc == "Mormon") |>
group_by(subtype, jello_belt) |>
summarise(
n = n()
) |>
group_by(subtype) |>
mutate(
prop = n / sum(n)
)
# Load the dataset
data <- readRDS("./data/CES/cumulative_2006-2024.rds")
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_
)
)
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$devout <- dplyr::case_when(
data$prayer_rc == "Several Times a Day" &
data$relig_imp == "Very Important" &
data$relig_church_rc == "Weekly or More" ~ 1,
TRUE ~ 0
)
data$cluster <- dplyr::case_when(
data$prayer_rc == "Several Times a Day" & data$relig_imp == "Very Important" & data$relig_church_rc %in% c("Weekly or More") ~ "Devout Traditionalist",
data$relig_church_rc %in% c("Weekly or More", "Monthly") ~ "Adaptive Believer",
TRUE ~ "Cultural Mormon"
)
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"))
plot <- data |>
filter(religion == 3) |>
group_by(year_4) |>
count(cluster, 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
) |>
ggplot(aes(x = year_4, y = prop, group = cluster)) +
geom_line(aes(color = cluster)) +
geom_point(
size = 3,
stroke = 1.5,
aes(color = cluster)
) +
geom_errorbar(aes(ymin = lower, ymax = upper, color = cluster), width = 0.2) +
geom_text(aes(label = scales::percent(prop, accuracy = 1)), vjust = -1, size = 4, family = "Cairo", fontface = "bold", color = "black") +
labs(
title = "LDS Cluster Sizes Shift Over Time",
subtitle = "Devout Trad. = praying several times a day, religion very important, and attending church weekly+\nAdaptive = attending church at least monthly (+ not devout traditionalist)\nCultural = everyone else",
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)) +
theme(
axis.ticks = element_blank(),
axis.title = element_text(size = 14),
axis.text.y = element_text(size = 10),
axis.text.x = element_text(size = 10, 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 = 8),
plot.title.position = "plot",
plot.subtitle.position = "plot",
legend.title = element_blank(),
legend.background = element_blank(),
legend.box.background = 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/26_political_compass_cluster.png", plot, width = 1500, height = 1500, units = "px", dpi = 300)
# gist: https://gist.github.com/acbass49/8b69a5abf126afaa89eb1e4418b659e9
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment