Class Zero-Sum Beliefs
January 2026: Analysis
Demographics
Gender
df_cbzs_elg %>%
mutate(gender = ifelse(is.na(gender) | gender == "","other",gender)) %>%
group_by(gender) %>%
summarise(N = n()) %>%
ungroup() %>%
mutate(Perc = round(100*(N/sum(N)),2)) %>%
ungroup() %>%
arrange(desc(Perc)) %>%
kbl() %>%
kable_styling(bootstrap_options = "hover",
full_width = F,
position = "left")| gender | N | Perc |
|---|---|---|
| man | 141 | 49.47 |
| woman | 140 | 49.12 |
| other | 4 | 1.40 |
Race
| race | N | Perc |
|---|---|---|
| White | 193 | 67.72 |
| Black or African American | 34 | 11.93 |
| multiracial | 24 | 8.42 |
| Asian | 21 | 7.37 |
| Hispanic, Latino, or Spanish origin | 8 | 2.81 |
| Middle Eastern or North African | 2 | 0.70 |
| NA | 2 | 0.70 |
| Other (please specify) | 1 | 0.35 |
Age
Mean age: 41.49.
Income
median_income_num <- df_cbzs_elg %>%
mutate(income_num = as.numeric(income)) %>%
summarise(median = median(income_num, na.rm = TRUE)) %>%
pull(median)
df_cbzs_elg %>%
ggplot(aes(x = income)) +
geom_bar() +
geom_vline(xintercept = median_income_num,
color = "lightblue", linetype = "dashed") +
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
axis.ticks = element_blank(),
axis.line = element_line(color = "grey66"),
axis.text.y = element_text(color = "black"),
axis.text.x = element_text(color = "black", face = "bold"),
axis.title.x = element_blank(),
axis.title.y = element_blank()) +
coord_flip()
Education
| edu | N | Perc |
|---|---|---|
| GED | 66 | 23.16 |
| 2yearColl | 23 | 8.07 |
| 4yearColl | 127 | 44.56 |
| MA | 51 | 17.89 |
| PHD | 15 | 5.26 |
| NA | 3 | 1.05 |
SES
| ses | N | Perc |
|---|---|---|
| Lower Class | 38 | 13.33 |
| Lower Middle Class | 75 | 26.32 |
| Middle Class | 124 | 43.51 |
| Upper Middle Class | 46 | 16.14 |
| Upper Class | 2 | 0.70 |
Politics
Political ideology
Participants were asked about the extent to which they subscribe to the following ideologies on a scale of 1-7 (select NA if unfamiliar): Conservatism, Liberalism, Democratic Socialism, Libertarianism, Progressivism.
means <- df_cbzs_elg %>%
dplyr::select(PID,ideo_con:ideo_prog) %>%
pivot_longer(-PID,
names_to = "ideo",
values_to = "score") %>%
filter(!is.na(score)) %>%
group_by(ideo) %>%
summarise(score = mean(score)) %>%
ungroup()
df_cbzs_elg %>%
dplyr::select(PID,ideo_con:ideo_prog) %>%
pivot_longer(-PID,
names_to = "ideo",
values_to = "score") %>%
filter(!is.na(score)) %>%
ggplot() +
geom_density(aes(x = score), fill = "lightblue",color = NA) +
scale_x_continuous(limits = c(1,7),
breaks = seq(1,7,1)) +
geom_vline(data = means,mapping = aes(xintercept = score),
color = "black",
linetype = "dashed",
size = 1.1) +
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
axis.ticks = element_blank(),
axis.line = element_line(color = "grey66"),
axis.text.y = element_text(color = "black"),
axis.text.x = element_text(color = "black",
face = "bold")) +
facet_wrap(~ideo,nrow = 2)
Party affiliation
| party_id | N | Perc |
|---|---|---|
| Independent | 97 | 34.04 |
| Democrat | 95 | 33.33 |
| Republican | 93 | 32.63 |
Measures
Class-based Zero-Sum Beliefs
- If the upper class becomes richer, this comes at the expense of the working class
- If the upper class makes more money, then the working class makes less money
- If the upper class does better economically, this does NOT come at the expense of the working class [R]
alpha = 0.93
df_cbzs_elg %>%
ggplot(aes(x = zs_class)) +
geom_density(fill = "lightblue",
color = NA) +
scale_x_continuous(breaks = seq(1,7,1),
limits = c(1,7)) +
ylab("density") +
geom_vline(xintercept = mean(df_cbzs_elg$zs_class,na.rm = T),
color = "black",
linetype = "dashed",
size = 1.1) +
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
axis.ticks = element_blank(),
axis.line = element_line(color = "grey66"),
axis.text.y = element_text(color = "black"),
axis.text.x = element_text(color = "black",
face = "bold"),
axis.title.x = element_text(color = "black",
face = "bold"))
Race-based Zero-Sum Beliefs
participants racial ingroup and outgroup was determined by the demographic questionnaire they completed upon starting the study. If “white” was selected, their ingroup shows as “white people” and their outgroup shows as “racial minorities.” If not, their ingroup shows as “racial minorities” and their outgroup shows as “white people.” The idea was to always have the ingroup as the losing side of the zsb.
- If [OUTGROUP] become richer, this comes at the expense of [INGROUP]
- If [OUTGROUP] make more money, then [INGROUP] make less money
- If [OUTGROUP] do better economically, this does NOT come at the expense of [INGROUP] [R]
alpha = 0.95
df_cbzs_elg %>%
ggplot(aes(x = zs_race)) +
geom_density(fill = "lightblue",
color = NA) +
scale_x_continuous(breaks = seq(1,7,1),
limits = c(1,7)) +
ylab("density") +
geom_vline(xintercept = mean(df_cbzs_elg$zs_race,na.rm = T),
color = "black",
linetype = "dashed",
size = 1.1) +
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
axis.ticks = element_blank(),
axis.line = element_line(color = "grey66"),
axis.text.y = element_text(color = "black"),
axis.text.x = element_text(color = "black",
face = "bold"),
axis.title.x = element_text(color = "black",
face = "bold"))
Broken down by white/non-white
means <- df_cbzs_elg %>%
group_by(ingroup) %>%
summarise(score = mean(zs_race,na.rm = T)) %>%
ungroup()
df_cbzs_elg %>%
ggplot(aes(x = zs_race)) +
geom_density(fill = "lightblue",
color = NA) +
scale_x_continuous(breaks = seq(1,7,1),
limits = c(1,7)) +
ylab("density") +
geom_vline(data = means,mapping = aes(xintercept = score),
color = "black",
linetype = "dashed",
size = 1.1) +
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
axis.ticks = element_blank(),
axis.line = element_line(color = "grey66"),
axis.text.y = element_text(color = "black"),
axis.text.x = element_text(color = "black",
face = "bold"),
axis.title.x = element_text(color = "black",
face = "bold")) +
facet_wrap(~ingroup,nrow = 2)
Linked Fate
White Working Class
- Issues that affect me also affect white working-class Americans
- What happens to white working-class Americans in this country will have something to do with what happens to me
- White working-class Americans and me share a common destiny
- Progress for white working-class Americans also means progress for me
alpha = 0.9
df_cbzs_elg %>%
ggplot(aes(x = lf_wwc)) +
geom_density(fill = "lightblue",
color = NA) +
scale_x_continuous(breaks = seq(1,7,1),
limits = c(1,7)) +
ylab("density") +
geom_vline(xintercept = mean(df_cbzs_elg$lf_wwc,na.rm = T),
color = "black",
linetype = "dashed",
size = 1.1) +
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
axis.ticks = element_blank(),
axis.line = element_line(color = "grey66"),
axis.text.y = element_text(color = "black"),
axis.text.x = element_text(color = "black",
face = "bold"),
axis.title.x = element_text(color = "black",
face = "bold"))
Non-White Working Class
- Issues that affect me also affect non-white working-class Americans
- What happens to non-white working-class Americans in this country will have something to do with what happens to me
- Non-white working-class Americans and me share a common destiny
- Progress for non-white working-class Americans also means progress for me
alpha = 0.88
df_cbzs_elg %>%
ggplot(aes(x = lf_nwwc)) +
geom_density(fill = "lightblue",
color = NA) +
scale_x_continuous(breaks = seq(1,7,1),
limits = c(1,7)) +
ylab("density") +
geom_vline(xintercept = mean(df_cbzs_elg$lf_nwwc,na.rm = T),
color = "black",
linetype = "dashed",
size = 1.1) +
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
axis.ticks = element_blank(),
axis.line = element_line(color = "grey66"),
axis.text.y = element_text(color = "black"),
axis.text.x = element_text(color = "black",
face = "bold"),
axis.title.x = element_text(color = "black",
face = "bold"))
White Upper Class
- Issues that affect me also affect white upper-class Americans
- What happens to white upper-class Americans in this country will have something to do with what happens to me
- White upper-class Americans and me share a common destiny
- Progress for white upper-class Americans also means progress for me
alpha = 0.91
df_cbzs_elg %>%
ggplot(aes(x = lf_wuc)) +
geom_density(fill = "lightblue",
color = NA) +
scale_x_continuous(breaks = seq(1,7,1),
limits = c(1,7)) +
ylab("density") +
geom_vline(xintercept = mean(df_cbzs_elg$lf_wuc,na.rm = T),
color = "black",
linetype = "dashed",
size = 1.1) +
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
axis.ticks = element_blank(),
axis.line = element_line(color = "grey66"),
axis.text.y = element_text(color = "black"),
axis.text.x = element_text(color = "black",
face = "bold"),
axis.title.x = element_text(color = "black",
face = "bold"))
Non-White Upper Class
- Issues that affect me also affect non-white upper-class Americans
- What happens to non-white upper-class Americans in this country will have something to do with what happens to me
- Non-white upper-class Americans and me share a common destiny
- Progress for non-white upper-class Americans also means progress for me
alpha = 0.91
df_cbzs_elg %>%
ggplot(aes(x = lf_nwuc)) +
geom_density(fill = "lightblue",
color = NA) +
scale_x_continuous(breaks = seq(1,7,1),
limits = c(1,7)) +
ylab("density") +
geom_vline(xintercept = mean(df_cbzs_elg$lf_nwuc,na.rm = T),
color = "black",
linetype = "dashed",
size = 1.1) +
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
axis.ticks = element_blank(),
axis.line = element_line(color = "grey66"),
axis.text.y = element_text(color = "black"),
axis.text.x = element_text(color = "black",
face = "bold"),
axis.title.x = element_text(color = "black",
face = "bold"))
Class Solidarity
- I feel a sense of solidarity with the working class
- I support policy that helps the working class
- I stand united with the working class
- Policies negatively affecting the working class should be changed
- More people should know about how the working class are negatively affected by economic issues
- It’s important to challenge the power structures that disadvantage the working class
alpha = 0.92
df_cbzs_elg %>%
ggplot(aes(x = soli)) +
geom_density(fill = "lightblue",
color = NA) +
scale_x_continuous(breaks = seq(1,7,1),
limits = c(1,7)) +
ylab("density") +
geom_vline(xintercept = mean(df_cbzs_elg$soli,na.rm = T),
color = "black",
linetype = "dashed",
size = 1.1) +
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
axis.ticks = element_blank(),
axis.line = element_line(color = "grey66"),
axis.text.y = element_text(color = "black"),
axis.text.x = element_text(color = "black",
face = "bold"),
axis.title.x = element_text(color = "black",
face = "bold"))
Cross-Race Class Solidarity
Mean score of the out-group items in the following scale (we exclude each participant’s own self-reported in-group). If they are not affiliated with any of the following racial groups, we take the mean score of all items. If they are affiliated with more than one group, we take only the items of the groups they are not affiliated with.
- I feel a sense of solidarity with working-class White people
- I feel a sense of solidarity with working-class Black people
- I feel a sense of solidarity with working-class Asian people
- I feel a sense of solidarity with working-class Hispanic people
alpha (of all items) = 0.88
df_cbzs_elg %>%
ggplot(aes(x = crs)) +
geom_density(fill = "lightblue",
color = NA) +
scale_x_continuous(breaks = seq(1,7,1),
limits = c(1,7)) +
ylab("density") +
geom_vline(xintercept = mean(df_cbzs_elg$crs,na.rm = T),
color = "black",
linetype = "dashed",
size = 1.1) +
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
axis.ticks = element_blank(),
axis.line = element_line(color = "grey66"),
axis.text.y = element_text(color = "black"),
axis.text.x = element_text(color = "black",
face = "bold"),
axis.title.x = element_text(color = "black",
face = "bold"))
Support for redistributive policy
Participants saw one of the following policies and indicated their support for it (1 = Strongly Oppose to 7 = Strongly Support)
Minimum wage increase
Congress has not increased the federal minimum wage, currently set at $7.25, since 2009. Some Congresspeople are proposing a policy that would gradually raise the federal minimum wage to $20 an hour by 2028. After 2028, the minimum wage would be adjusted each year to keep pace with growth in the median wage, a measure of wages for typical workers.
Student debt relief
Some Congresspeople are proposing a policy that would help to address the student loan debt crisis by forgiving up to $50,000 in loans per borrower. Approximately 42 million Americans, or about 1 in 6 American adults, owe a cumulative $1.6 trillion in student loans. Student loans are now the second-largest slice of household debt after mortgages, bigger than credit card debt.
Housing
Some Congresspeople are proposing a housing affordability policy that would help ensure that every American has a place to live. The policy would allow for smaller, lower cost homes like duplexes, townhouses, and garden apartments to be built and developed, allowing new nonprofit homes and reducing overall housing prices.
Climate change
Some Congresspeople are proposing a Green New Deal bill which would phase out the use of fossil fuels, with the government providing clean energy jobs for people who can’t find employment in the private sector. All jobs would pay at least $20 an hour, and include healthcare benefits and collective bargaining rights.
df_cbzs_elg %>%
ggplot(aes(x = support)) +
geom_histogram(fill = "lightblue",
binwidth = 1,
color = NA) +
scale_x_continuous(breaks = seq(1,7,1),
limits = c(0,8)) +
ylab("count") +
geom_vline(xintercept = mean(df_cbzs_elg$support,na.rm = T),
color = "black",
linetype = "dashed",
size = 1.1) +
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
axis.ticks = element_blank(),
axis.line = element_line(color = "grey66"),
axis.text.y = element_text(color = "black"),
axis.text.x = element_text(color = "black",
face = "bold"),
axis.title.x = element_text(color = "black",
face = "bold"))
Relative Deprivation
- When I think about what I have compared to others, I feel deprived
- I feel privileged compared to other people like me [R]
- I feel resentful when I see how prosperous other people seem to be
- When I compare what I have with others, I realize that I am quite well off [R]
alpha = 0.72
df_cbzs_elg %>%
ggplot(aes(x = reldep)) +
geom_density(fill = "lightblue",
color = NA) +
scale_x_continuous(breaks = seq(1,7,1),
limits = c(1,7)) +
ylab("density") +
geom_vline(xintercept = mean(df_cbzs_elg$reldep,na.rm = T),
color = "black",
linetype = "dashed",
size = 1.1) +
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
axis.ticks = element_blank(),
axis.line = element_line(color = "grey66"),
axis.text.y = element_text(color = "black"),
axis.text.x = element_text(color = "black",
face = "bold"),
axis.title.x = element_text(color = "black",
face = "bold"))
Inclusion of Other-in-Self
Participants saw one of two sets of five images with differing degrees of overlapping circles (1 = no overlap to 5 = full overlap). Those who selected “White” in the demographic section saw “YOU” and “Non-White People” on the circles. Those who did not select “White” in the demographic section saw “YOU” and “White People” on the circles.
Please select the image that best represents how close you feel to [white/non-white] people in America.
df_cbzs_elg %>%
ggplot(aes(x = IOS)) +
geom_histogram(fill = "lightblue",
color = NA,
binwidth = 1) +
scale_x_continuous(breaks = seq(1,5,1),
limits = c(0,6)) +
ylab("count") +
geom_vline(xintercept = mean(df_cbzs_elg$IOS,na.rm = T),
color = "black",
linetype = "dashed",
size = 1.1) +
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
axis.ticks = element_blank(),
axis.line = element_line(color = "grey66"),
axis.text.y = element_text(color = "black"),
axis.text.x = element_text(color = "black",
face = "bold"),
axis.title.x = element_text(color = "black",
face = "bold"))
Broken down by white/non-white
means <- df_cbzs_elg %>%
group_by(ingroup) %>%
summarise(score = mean(IOS,na.rm = T)) %>%
ungroup()
df_cbzs_elg %>%
ggplot(aes(x = IOS)) +
geom_histogram(fill = "lightblue",
color = NA,
binwidth = 1) +
scale_x_continuous(breaks = seq(1,5,1),
limits = c(0,6)) +
ylab("count") +
geom_vline(data = means,mapping = aes(xintercept = score),
color = "black",
linetype = "dashed",
size = 1.1) +
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
axis.ticks = element_blank(),
axis.line = element_line(color = "grey66"),
axis.text.y = element_text(color = "black"),
axis.text.x = element_text(color = "black",
face = "bold"),
axis.title.x = element_text(color = "black",
face = "bold")) +
facet_wrap(~ingroup,nrow = 2)
Working-class identification
To what extent do you identify as working-class? (0 = Not at All Working-Class; 50 = Moderately Working-Class; 100 = Very Strongly Working-Class)
df_cbzs_elg %>%
ggplot(aes(x = class_id)) +
geom_histogram(fill = "lightblue",
binwidth = 5,
color = NA) +
scale_x_continuous(breaks = seq(0,100,10),
limits = c(-10,110)) +
ylab("count") +
geom_vline(xintercept = mean(df_cbzs_elg$class_id,na.rm = T),
color = "black",
linetype = "dashed",
size = 1.1) +
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
axis.ticks = element_blank(),
axis.line = element_line(color = "grey66"),
axis.text.y = element_text(color = "black"),
axis.text.x = element_text(color = "black",
face = "bold"),
axis.title.x = element_text(color = "black",
face = "bold"))
Correlations
We’re gonna break this by racial ingroup (white people AND everybody else)
Correlations: White people
Correlations: Non-White people
Analysis
Mediations
Mediation Model 1
Predictor: Class ZSB
Mediator: Linked fate with non-white working class
Outcome: Solidarity
Sample: White people
Bootstraps: 10,000
form.m <- reformulate("zs_class", response = "lf_nwwc")
form.y <- reformulate(c("zs_class", "lf_nwwc"), response = "soli")
# Fit linear models
m.fit <- lm(form.m, data = df_cbzs_elg %>% filter(ingroup == "white people")) # a-path
y.fit <- lm(form.y, data = df_cbzs_elg %>% filter(ingroup == "white people")) # b and c'-paths
# Fit outcome model WITHOUT mediator to get c-path (total effect)
y.fit.total <- lm(
reformulate("zs_class", response = "soli"),
data = df_cbzs_elg %>% filter(ingroup == "white people")
)
# Mediation analysis with bootstrapping (10,000 sims)
med.fit <- mediation::mediate(
model.m = m.fit,
model.y = y.fit,
treat = "zs_class",
mediator = "lf_nwwc",
boot = TRUE,
sims = 10000
)
med_tbl <- tibble(
Effect = c("ACME (indirect)", "ADE (direct)",
"Total Effect", "Prop. Mediated"),
Estimate = c(med.fit$d0, med.fit$z0,
med.fit$tau.coef, med.fit$n0),
CI.lower = c(med.fit$d0.ci[1], med.fit$z0.ci[1],
med.fit$tau.ci[1], med.fit$n0.ci[1]),
CI.upper = c(med.fit$d0.ci[2], med.fit$z0.ci[2],
med.fit$tau.ci[2], med.fit$n0.ci[2]),
p.value = c(med.fit$d0.p, med.fit$z0.p,
med.fit$tau.p, med.fit$n0.p)
)
kbl(med_tbl) %>%
kable_styling(bootstrap_options = "hover",
full_width = F,
position = "left")| Effect | Estimate | CI.lower | CI.upper | p.value |
|---|---|---|---|---|
| ACME (indirect) | 0.0185807 | 0.0031620 | 0.0384006 | 0.014 |
| ADE (direct) | 0.2127029 | 0.1579924 | 0.2663151 | 0.000 |
| Total Effect | 0.2312836 | 0.1760945 | 0.2852663 | 0.000 |
| Prop. Mediated | 0.0803374 | 0.0139766 | 0.1652915 | 0.014 |
# Helper to generate significance stars
p_stars <- function(p) {
if (p < .001) return("***")
if (p < .01) return("**")
if (p < .05) return("*")
return("")
}
# Extract coefficients & p-values
a_coef <- coef(m.fit)["zs_class"]
a_p <- summary(m.fit)$coefficients["zs_class", "Pr(>|t|)"]
b_coef <- coef(y.fit)["lf_nwwc"]
b_p <- summary(y.fit)$coefficients["lf_nwwc", "Pr(>|t|)"]
cprime <- coef(y.fit)["zs_class"]
cprime_p <- summary(y.fit)$coefficients["zs_class", "Pr(>|t|)"]
c_total <- coef(y.fit.total)["zs_class"]
c_total_p <- summary(y.fit.total)$coefficients["zs_class", "Pr(>|t|)"]
# Paste coefficient + stars
a_label <- paste0("a = ", round(a_coef, 3), p_stars(a_p))
b_label <- paste0("b = ", round(b_coef, 3), p_stars(b_p))
cprime_label <- paste0("c' = ", round(cprime, 3), p_stars(cprime_p))
c_label <- paste0("c = ", round(c_total, 3), p_stars(c_total_p))
# Plot
ggplot() +
xlim(0, 3) + ylim(0, 2) +
# Nodes
annotate("text", x = 0.5, y = 1, label = "zs_class", fontface = "bold") +
annotate("text", x = 1.5, y = 1, label = "lf_nwwc", fontface = "bold") +
annotate("text", x = 2.5, y = 1, label = "soli", fontface = "bold") +
# a-path (X → M)
annotate("segment",
x = 0.7, xend = 1.3, y = 1, yend = 1,
arrow = arrow(length = unit(0.20, "cm"))) +
annotate("text", x = 1.0, y = 1.15, label = a_label) +
# b-path (M → Y)
annotate("segment",
x = 1.7, xend = 2.3, y = 1, yend = 1,
arrow = arrow(length = unit(0.20, "cm"))) +
annotate("text", x = 2.0, y = 1.15, label = b_label) +
# c'-path (direct effect)
annotate("segment",
x = 0.5, xend = 2.5, y = 0.9, yend = 0.9,
arrow = arrow(length = unit(0.20, "cm"))) +
annotate("text", x = 1.5, y = 0.75, label = cprime_label) +
# c-path (total effect, dashed)
annotate("segment",
x = 0.5, xend = 2.5, y = 1.1, yend = 1.1,
linetype = "dashed",
arrow = arrow(length = unit(0.20, "cm"))) +
annotate("text", x = 1.5, y = 1.25, label = c_label) +
theme_void()
Mediation Model 2
Predictor: Class ZSB
Mediator: Linked fate with non-white working class
Outcome: Cross-Race Solidarity
Sample: White people
Bootstraps: 10,000
form.m <- reformulate("zs_class", response = "lf_nwwc")
form.y <- reformulate(c("zs_class", "lf_nwwc"), response = "crs")
# Fit linear models
m.fit <- lm(form.m, data = df_cbzs_elg %>% filter(ingroup == "white people") %>% filter(!is.na(crs))) # a-path
y.fit <- lm(form.y, data = df_cbzs_elg %>% filter(ingroup == "white people") %>% filter(!is.na(crs))) # b and c'-paths
# Fit outcome model WITHOUT mediator to get c-path (total effect)
y.fit.total <- lm(
reformulate("zs_class", response = "crs"),
data = df_cbzs_elg %>% filter(ingroup == "white people") %>% filter(!is.na(crs))
)
# Mediation analysis with bootstrapping (10,000 sims)
med.fit <- mediation::mediate(
model.m = m.fit,
model.y = y.fit,
treat = "zs_class",
mediator = "lf_nwwc",
boot = TRUE,
sims = 10000
)
med_tbl <- tibble(
Effect = c("ACME (indirect)", "ADE (direct)",
"Total Effect", "Prop. Mediated"),
Estimate = c(med.fit$d0, med.fit$z0,
med.fit$tau.coef, med.fit$n0),
CI.lower = c(med.fit$d0.ci[1], med.fit$z0.ci[1],
med.fit$tau.ci[1], med.fit$n0.ci[1]),
CI.upper = c(med.fit$d0.ci[2], med.fit$z0.ci[2],
med.fit$tau.ci[2], med.fit$n0.ci[2]),
p.value = c(med.fit$d0.p, med.fit$z0.p,
med.fit$tau.p, med.fit$n0.p)
)
kbl(med_tbl) %>%
kable_styling(bootstrap_options = "hover",
full_width = F,
position = "left")| Effect | Estimate | CI.lower | CI.upper | p.value |
|---|---|---|---|---|
| ACME (indirect) | 0.0660911 | 0.0162713 | 0.1202010 | 0.0100 |
| ADE (direct) | 0.0725522 | -0.0422591 | 0.1900148 | 0.2104 |
| Total Effect | 0.1386433 | 0.0093975 | 0.2657862 | 0.0364 |
| Prop. Mediated | 0.4766987 | 0.0531694 | 1.8913361 | 0.0428 |
# Helper to generate significance stars
p_stars <- function(p) {
if (p < .001) return("***")
if (p < .01) return("**")
if (p < .05) return("*")
return("")
}
# Extract coefficients & p-values
a_coef <- coef(m.fit)["zs_class"]
a_p <- summary(m.fit)$coefficients["zs_class", "Pr(>|t|)"]
b_coef <- coef(y.fit)["lf_nwwc"]
b_p <- summary(y.fit)$coefficients["lf_nwwc", "Pr(>|t|)"]
cprime <- coef(y.fit)["zs_class"]
cprime_p <- summary(y.fit)$coefficients["zs_class", "Pr(>|t|)"]
c_total <- coef(y.fit.total)["zs_class"]
c_total_p <- summary(y.fit.total)$coefficients["zs_class", "Pr(>|t|)"]
# Paste coefficient + stars
a_label <- paste0("a = ", round(a_coef, 3), p_stars(a_p))
b_label <- paste0("b = ", round(b_coef, 3), p_stars(b_p))
cprime_label <- paste0("c' = ", round(cprime, 3), p_stars(cprime_p))
c_label <- paste0("c = ", round(c_total, 3), p_stars(c_total_p))
# Plot
ggplot() +
xlim(0, 3) + ylim(0, 2) +
# Nodes
annotate("text", x = 0.5, y = 1, label = "zs_class", fontface = "bold") +
annotate("text", x = 1.5, y = 1, label = "lf_nwwc", fontface = "bold") +
annotate("text", x = 2.5, y = 1, label = "crs", fontface = "bold") +
# a-path (X → M)
annotate("segment",
x = 0.7, xend = 1.3, y = 1, yend = 1,
arrow = arrow(length = unit(0.20, "cm"))) +
annotate("text", x = 1.0, y = 1.15, label = a_label) +
# b-path (M → Y)
annotate("segment",
x = 1.7, xend = 2.3, y = 1, yend = 1,
arrow = arrow(length = unit(0.20, "cm"))) +
annotate("text", x = 2.0, y = 1.15, label = b_label) +
# c'-path (direct effect)
annotate("segment",
x = 0.5, xend = 2.5, y = 0.9, yend = 0.9,
arrow = arrow(length = unit(0.20, "cm"))) +
annotate("text", x = 1.5, y = 0.75, label = cprime_label) +
# c-path (total effect, dashed)
annotate("segment",
x = 0.5, xend = 2.5, y = 1.1, yend = 1.1,
linetype = "dashed",
arrow = arrow(length = unit(0.20, "cm"))) +
annotate("text", x = 1.5, y = 1.25, label = c_label) +
theme_void()
Serial Mediation 1
Predictor: Class ZSB
Mediator 1: Linked fate with non-white working class
Mediator 2: Solidarity
Outcome: Support for policy
Sample: White people
Bootstraps: 10,000
df_w <- df_cbzs_elg %>%
filter(ingroup == "white people")
model_serial <- '
# structural paths (the chain)
lf_nwwc ~ a*zs_class
soli ~ b*lf_nwwc + c1*zs_class
support~ d*soli + e*lf_nwwc + c2*zs_class
# defined (derived) effects
ind_zs_to_soli := a*b
ind_zs_to_support_1 := a*b*d # zs -> lf -> soli -> support
ind_zs_to_support_2 := a*e # zs -> lf -> support
ind_zs_to_support := ind_zs_to_support_1 + ind_zs_to_support_2
total_zs_to_soli := c1 + ind_zs_to_soli
total_zs_to_support := c2 + ind_zs_to_support
'
fit_serial <- lavaan::sem(
model_serial,
data = df_w,
se = "bootstrap",
bootstrap = 10000
)
pe <- parameterEstimates(fit_serial, ci = TRUE, level = 0.95) %>%
as_tibble()
# Effects table (for the defined ones)
effects_tbl <- pe %>%
filter(op == ":=") %>%
transmute(
Effect = lhs,
Estimate = est,
CI.lower = ci.lower,
CI.upper = ci.upper,
p.value = pvalue
)
kbl(effects_tbl, digits = 3) %>%
kable_styling(bootstrap_options = "hover",
full_width = FALSE,
position = "left")| Effect | Estimate | CI.lower | CI.upper | p.value |
|---|---|---|---|---|
| ind_zs_to_soli | 0.019 | 0.003 | 0.038 | 0.038 |
| ind_zs_to_support_1 | 0.011 | 0.001 | 0.027 | 0.109 |
| ind_zs_to_support_2 | -0.007 | -0.045 | 0.025 | 0.693 |
| ind_zs_to_support | 0.004 | -0.029 | 0.036 | 0.786 |
| total_zs_to_soli | 0.231 | 0.177 | 0.285 | 0.000 |
| total_zs_to_support | 0.269 | 0.105 | 0.425 | 0.001 |
library(ggplot2)
library(grid)
library(dplyr)
p_stars <- function(p) {
if (is.na(p)) return("")
if (p < .001) return("***")
if (p < .01) return("**")
if (p < .05) return("*")
return("")
}
# assumes `pe` exists from lavaan::parameterEstimates(fit_serial, ci=TRUE)
get_path <- function(lhs, rhs) {
row <- pe %>% filter(op == "~", lhs == !!lhs, rhs == !!rhs)
list(est = row$est[1], p = row$pvalue[1])
}
# paths
a <- get_path("lf_nwwc", "zs_class")
b <- get_path("soli", "lf_nwwc")
d <- get_path("support", "soli")
c1 <- get_path("soli", "zs_class") # zs -> soli (diagonal)
e <- get_path("support", "lf_nwwc") # lf -> support (diagonal)
c2 <- get_path("support", "zs_class") # zs -> support (bottom horizontal)
# labels
a_lab <- paste0("a = ", round(a$est, 3), p_stars(a$p))
b_lab <- paste0("b = ", round(b$est, 3), p_stars(b$p))
d_lab <- paste0("d = ", round(d$est, 3), p_stars(d$p))
c1_lab <- paste0("c'1 = ", round(c1$est, 3), p_stars(c1$p))
e_lab <- paste0("e = ", round(e$est, 3), p_stars(e$p))
c2_lab <- paste0("c'2 = ", round(c2$est, 3), p_stars(c2$p))
# node positions (moved zs left, support right)
pos <- tibble::tibble(
node = c("zs_class","lf_nwwc","soli","support"),
x = c(0.7, 1.0, 4.2, 4.6),
y = c(0.6, 2.2, 2.2, 0.6)
)
# box size
w <- 2.1
h <- 0.65
# helpers
node_xy <- function(name) {
row <- pos[pos$node == name, ]
list(x = row$x[1], y = row$y[1])
}
edge_right <- function(x) x + w/2
edge_left <- function(x) x - w/2
edge_top <- function(y) y + h/2
edge_bot <- function(y) y - h/2
# draw a boxed node
draw_node <- function(name, label) {
p <- node_xy(name)
list(
annotate("rect",
xmin = p$x - w/2, xmax = p$x + w/2,
ymin = p$y - h/2, ymax = p$y + h/2,
fill = "white", color = "black", linewidth = 0.5),
annotate("text", x = p$x, y = p$y, label = label,
fontface = "bold", size = 3.8)
)
}
# label text (no bubble, like the reference)
lbl <- function(x, y, txt) annotate("text", x = x, y = y, label = txt, size = 3.5)
# convenience
Pzs <- node_xy("zs_class")
Plf <- node_xy("lf_nwwc")
Pso <- node_xy("soli")
Psu <- node_xy("support")
ggplot() +
xlim(-0.8, 6.1) + ylim(0.0, 2.8) + # widened x-lims for new layout
# nodes
draw_node("zs_class", "zs_class") +
draw_node("lf_nwwc", "lf_nwwc") +
draw_node("soli", "soli") +
draw_node("support", "support") +
# zs -> lf (vertical-ish)
annotate("segment",
x = Pzs$x, xend = Plf$x,
y = edge_top(Pzs$y), yend = edge_bot(Plf$y),
arrow = arrow(length = unit(0.18, "cm")), linewidth = 0.6) +
lbl(Pzs$x - 0.40, (Pzs$y + Plf$y)/2, a_lab) +
# lf -> soli (top horizontal)
annotate("segment",
x = edge_right(Plf$x), xend = edge_left(Pso$x),
y = Plf$y, yend = Pso$y,
arrow = arrow(length = unit(0.18, "cm")), linewidth = 0.6) +
lbl((Plf$x + Pso$x)/2, Plf$y + 0.22, b_lab) +
# soli -> support (vertical-ish down)
annotate("segment",
x = Pso$x, xend = Psu$x,
y = edge_bot(Pso$y), yend = edge_top(Psu$y),
arrow = arrow(length = unit(0.18, "cm")), linewidth = 0.6) +
lbl(Pso$x + 0.40, (Pso$y + Psu$y)/2, d_lab) +
# zs -> soli (diagonal up-right)
annotate("segment",
x = edge_right(Pzs$x), xend = edge_left(Pso$x),
y = edge_top(Pzs$y), yend = edge_bot(Pso$y),
arrow = arrow(length = unit(0.18, "cm")), linewidth = 0.55) +
lbl((Pzs$x + Pso$x)/2, (Pzs$y + Pso$y)/2 + 0.12, c1_lab) +
# lf -> support (diagonal down-right)
annotate("segment",
x = edge_right(Plf$x), xend = edge_left(Psu$x),
y = edge_bot(Plf$y), yend = edge_top(Psu$y),
arrow = arrow(length = unit(0.18, "cm")), linewidth = 0.55) +
lbl((Plf$x + Psu$x)/2, (Plf$y + Psu$y)/2 - 0.12, e_lab) +
# zs -> support (bottom horizontal)
annotate("segment",
x = edge_right(Pzs$x), xend = edge_left(Psu$x),
y = Pzs$y, yend = Psu$y,
arrow = arrow(length = unit(0.18, "cm")), linewidth = 0.55) +
lbl((Pzs$x + Psu$x)/2, Pzs$y - 0.22, c2_lab) +
theme_void()
Serial Mediation 2
Predictor: Class ZSB
Mediator 1: Linked fate with non-white working class
Mediator 2: Cross-Race Solidarity
Outcome: Support for policy
Sample: White people
Bootstraps: 10,000
df_w <- df_cbzs_elg %>%
filter(ingroup == "white people")
model_serial <- '
# structural paths (the chain)
lf_nwwc ~ a*zs_class
crs ~ b*lf_nwwc + c1*zs_class
support~ d*crs + e*lf_nwwc + c2*zs_class
# defined (derived) effects
ind_zs_to_crs := a*b
ind_zs_to_support_1 := a*b*d # zs -> lf -> crs -> support
ind_zs_to_support_2 := a*e # zs -> lf -> support
ind_zs_to_support := ind_zs_to_support_1 + ind_zs_to_support_2
total_zs_to_crs := c1 + ind_zs_to_crs
total_zs_to_support := c2 + ind_zs_to_support
'
fit_serial <- lavaan::sem(
model_serial,
data = df_w,
se = "bootstrap",
bootstrap = 10000
)
pe <- parameterEstimates(fit_serial, ci = TRUE, level = 0.95) %>%
as_tibble()
# Effects table (for the defined ones)
effects_tbl <- pe %>%
filter(op == ":=") %>%
transmute(
Effect = lhs,
Estimate = est,
CI.lower = ci.lower,
CI.upper = ci.upper,
p.value = pvalue
)
kbl(effects_tbl, digits = 3) %>%
kable_styling(bootstrap_options = "hover",
full_width = FALSE,
position = "left")| Effect | Estimate | CI.lower | CI.upper | p.value |
|---|---|---|---|---|
| ind_zs_to_crs | 0.066 | 0.016 | 0.120 | 0.012 |
| ind_zs_to_support_1 | 0.014 | 0.000 | 0.036 | 0.131 |
| ind_zs_to_support_2 | -0.010 | -0.048 | 0.020 | 0.557 |
| ind_zs_to_support | 0.004 | -0.029 | 0.036 | 0.790 |
| total_zs_to_crs | 0.139 | 0.013 | 0.266 | 0.033 |
| total_zs_to_support | 0.379 | 0.227 | 0.526 | 0.000 |
library(ggplot2)
library(grid)
library(dplyr)
p_stars <- function(p) {
if (is.na(p)) return("")
if (p < .001) return("***")
if (p < .01) return("**")
if (p < .05) return("*")
return("")
}
# assumes `pe` exists from lavaan::parameterEstimates(fit_serial, ci=TRUE)
get_path <- function(lhs, rhs) {
row <- pe %>% filter(op == "~", lhs == !!lhs, rhs == !!rhs)
list(est = row$est[1], p = row$pvalue[1])
}
# paths
a <- get_path("lf_nwwc", "zs_class")
b <- get_path("crs", "lf_nwwc")
d <- get_path("support", "crs")
c1 <- get_path("crs", "zs_class") # zs -> crs (diagonal)
e <- get_path("support", "lf_nwwc") # lf -> support (diagonal)
c2 <- get_path("support", "zs_class") # zs -> support (bottom horizontal)
# labels
a_lab <- paste0("a = ", round(a$est, 3), p_stars(a$p))
b_lab <- paste0("b = ", round(b$est, 3), p_stars(b$p))
d_lab <- paste0("d = ", round(d$est, 3), p_stars(d$p))
c1_lab <- paste0("c'1 = ", round(c1$est, 3), p_stars(c1$p))
e_lab <- paste0("e = ", round(e$est, 3), p_stars(e$p))
c2_lab <- paste0("c'2 = ", round(c2$est, 3), p_stars(c2$p))
# node positions (moved zs left, support right)
pos <- tibble::tibble(
node = c("zs_class","lf_nwwc","crs","support"),
x = c(0.7, 1.0, 4.2, 4.6),
y = c(0.6, 2.2, 2.2, 0.6)
)
# box size
w <- 2.1
h <- 0.65
# helpers
node_xy <- function(name) {
row <- pos[pos$node == name, ]
list(x = row$x[1], y = row$y[1])
}
edge_right <- function(x) x + w/2
edge_left <- function(x) x - w/2
edge_top <- function(y) y + h/2
edge_bot <- function(y) y - h/2
# draw a boxed node
draw_node <- function(name, label) {
p <- node_xy(name)
list(
annotate("rect",
xmin = p$x - w/2, xmax = p$x + w/2,
ymin = p$y - h/2, ymax = p$y + h/2,
fill = "white", color = "black", linewidth = 0.5),
annotate("text", x = p$x, y = p$y, label = label,
fontface = "bold", size = 3.8)
)
}
# label text (no bubble, like the reference)
lbl <- function(x, y, txt) annotate("text", x = x, y = y, label = txt, size = 3.5)
# convenience
Pzs <- node_xy("zs_class")
Plf <- node_xy("lf_nwwc")
Pso <- node_xy("crs")
Psu <- node_xy("support")
ggplot() +
xlim(-0.8, 6.1) + ylim(0.0, 2.8) + # widened x-lims for new layout
# nodes
draw_node("zs_class", "zs_class") +
draw_node("lf_nwwc", "lf_nwwc") +
draw_node("crs", "crs") +
draw_node("support", "support") +
# zs -> lf (vertical-ish)
annotate("segment",
x = Pzs$x, xend = Plf$x,
y = edge_top(Pzs$y), yend = edge_bot(Plf$y),
arrow = arrow(length = unit(0.18, "cm")), linewidth = 0.6) +
lbl(Pzs$x - 0.40, (Pzs$y + Plf$y)/2, a_lab) +
# lf -> crs (top horizontal)
annotate("segment",
x = edge_right(Plf$x), xend = edge_left(Pso$x),
y = Plf$y, yend = Pso$y,
arrow = arrow(length = unit(0.18, "cm")), linewidth = 0.6) +
lbl((Plf$x + Pso$x)/2, Plf$y + 0.22, b_lab) +
# crs -> support (vertical-ish down)
annotate("segment",
x = Pso$x, xend = Psu$x,
y = edge_bot(Pso$y), yend = edge_top(Psu$y),
arrow = arrow(length = unit(0.18, "cm")), linewidth = 0.6) +
lbl(Pso$x + 0.40, (Pso$y + Psu$y)/2, d_lab) +
# zs -> crs (diagonal up-right)
annotate("segment",
x = edge_right(Pzs$x), xend = edge_left(Pso$x),
y = edge_top(Pzs$y), yend = edge_bot(Pso$y),
arrow = arrow(length = unit(0.18, "cm")), linewidth = 0.55) +
lbl((Pzs$x + Pso$x)/2, (Pzs$y + Pso$y)/2 + 0.12, c1_lab) +
# lf -> support (diagonal down-right)
annotate("segment",
x = edge_right(Plf$x), xend = edge_left(Psu$x),
y = edge_bot(Plf$y), yend = edge_top(Psu$y),
arrow = arrow(length = unit(0.18, "cm")), linewidth = 0.55) +
lbl((Plf$x + Psu$x)/2, (Plf$y + Psu$y)/2 - 0.12, e_lab) +
# zs -> support (bottom horizontal)
annotate("segment",
x = edge_right(Pzs$x), xend = edge_left(Psu$x),
y = Pzs$y, yend = Psu$y,
arrow = arrow(length = unit(0.18, "cm")), linewidth = 0.55) +
lbl((Pzs$x + Psu$x)/2, Pzs$y - 0.22, c2_lab) +
theme_void()
Mediation Model 3
Predictor: Class ZSB
Mediator: Linked fate with white working class
Outcome: Solidarity
Sample: Non-White people
Bootstraps: 10,000
form.m <- reformulate("zs_class", response = "lf_wwc")
form.y <- reformulate(c("zs_class", "lf_wwc"), response = "soli")
# Fit linear models
m.fit <- lm(form.m, data = df_cbzs_elg %>% filter(ingroup == "racial minorities")) # a-path
y.fit <- lm(form.y, data = df_cbzs_elg %>% filter(ingroup == "racial minorities")) # b and c'-paths
# Fit outcome model WITHOUT mediator to get c-path (total effect)
y.fit.total <- lm(
reformulate("zs_class", response = "soli"),
data = df_cbzs_elg %>% filter(ingroup == "racial minorities")
)
# Mediation analysis with bootstrapping (10,000 sims)
med.fit <- mediation::mediate(
model.m = m.fit,
model.y = y.fit,
treat = "zs_class",
mediator = "lf_wwc",
boot = TRUE,
sims = 10000
)
med_tbl <- tibble(
Effect = c("ACME (indirect)", "ADE (direct)",
"Total Effect", "Prop. Mediated"),
Estimate = c(med.fit$d0, med.fit$z0,
med.fit$tau.coef, med.fit$n0),
CI.lower = c(med.fit$d0.ci[1], med.fit$z0.ci[1],
med.fit$tau.ci[1], med.fit$n0.ci[1]),
CI.upper = c(med.fit$d0.ci[2], med.fit$z0.ci[2],
med.fit$tau.ci[2], med.fit$n0.ci[2]),
p.value = c(med.fit$d0.p, med.fit$z0.p,
med.fit$tau.p, med.fit$n0.p)
)
kbl(med_tbl) %>%
kable_styling(bootstrap_options = "hover",
full_width = F,
position = "left")| Effect | Estimate | CI.lower | CI.upper | p.value |
|---|---|---|---|---|
| ACME (indirect) | 0.0286635 | -0.0313287 | 0.1293606 | 0.3924 |
| ADE (direct) | 0.3030031 | 0.1399688 | 0.4362709 | 0.0004 |
| Total Effect | 0.3316666 | 0.1443236 | 0.5108788 | 0.0004 |
| Prop. Mediated | 0.0864228 | -0.1314974 | 0.2992412 | 0.3928 |
# Helper to generate significance stars
p_stars <- function(p) {
if (p < .001) return("***")
if (p < .01) return("**")
if (p < .05) return("*")
return("")
}
# Extract coefficients & p-values
a_coef <- coef(m.fit)["zs_class"]
a_p <- summary(m.fit)$coefficients["zs_class", "Pr(>|t|)"]
b_coef <- coef(y.fit)["lf_wwc"]
b_p <- summary(y.fit)$coefficients["lf_wwc", "Pr(>|t|)"]
cprime <- coef(y.fit)["zs_class"]
cprime_p <- summary(y.fit)$coefficients["zs_class", "Pr(>|t|)"]
c_total <- coef(y.fit.total)["zs_class"]
c_total_p <- summary(y.fit.total)$coefficients["zs_class", "Pr(>|t|)"]
# Paste coefficient + stars
a_label <- paste0("a = ", round(a_coef, 3), p_stars(a_p))
b_label <- paste0("b = ", round(b_coef, 3), p_stars(b_p))
cprime_label <- paste0("c' = ", round(cprime, 3), p_stars(cprime_p))
c_label <- paste0("c = ", round(c_total, 3), p_stars(c_total_p))
# Plot
ggplot() +
xlim(0, 3) + ylim(0, 2) +
# Nodes
annotate("text", x = 0.5, y = 1, label = "zs_class", fontface = "bold") +
annotate("text", x = 1.5, y = 1, label = "lf_wwc", fontface = "bold") +
annotate("text", x = 2.5, y = 1, label = "soli", fontface = "bold") +
# a-path (X → M)
annotate("segment",
x = 0.7, xend = 1.3, y = 1, yend = 1,
arrow = arrow(length = unit(0.20, "cm"))) +
annotate("text", x = 1.0, y = 1.15, label = a_label) +
# b-path (M → Y)
annotate("segment",
x = 1.7, xend = 2.3, y = 1, yend = 1,
arrow = arrow(length = unit(0.20, "cm"))) +
annotate("text", x = 2.0, y = 1.15, label = b_label) +
# c'-path (direct effect)
annotate("segment",
x = 0.5, xend = 2.5, y = 0.9, yend = 0.9,
arrow = arrow(length = unit(0.20, "cm"))) +
annotate("text", x = 1.5, y = 0.75, label = cprime_label) +
# c-path (total effect, dashed)
annotate("segment",
x = 0.5, xend = 2.5, y = 1.1, yend = 1.1,
linetype = "dashed",
arrow = arrow(length = unit(0.20, "cm"))) +
annotate("text", x = 1.5, y = 1.25, label = c_label) +
theme_void()
Mediation Model 4
Predictor: Class ZSB
Mediator: Linked fate with white working class
Outcome: Cross-race solidarity
Sample: Non-White people
Bootstraps: 10,000
form.m <- reformulate("zs_class", response = "lf_wwc")
form.y <- reformulate(c("zs_class", "lf_wwc"), response = "crs")
# Fit linear models
m.fit <- lm(form.m, data = df_cbzs_elg %>% filter(ingroup == "racial minorities")) # a-path
y.fit <- lm(form.y, data = df_cbzs_elg %>% filter(ingroup == "racial minorities")) # b and c'-paths
# Fit outcome model WITHOUT mediator to get c-path (total effect)
y.fit.total <- lm(
reformulate("zs_class", response = "crs"),
data = df_cbzs_elg %>% filter(ingroup == "racial minorities")
)
# Mediation analysis with bootstrapping (10,000 sims)
med.fit <- mediation::mediate(
model.m = m.fit,
model.y = y.fit,
treat = "zs_class",
mediator = "lf_wwc",
boot = TRUE,
sims = 10000
)
med_tbl <- tibble(
Effect = c("ACME (indirect)", "ADE (direct)",
"Total Effect", "Prop. Mediated"),
Estimate = c(med.fit$d0, med.fit$z0,
med.fit$tau.coef, med.fit$n0),
CI.lower = c(med.fit$d0.ci[1], med.fit$z0.ci[1],
med.fit$tau.ci[1], med.fit$n0.ci[1]),
CI.upper = c(med.fit$d0.ci[2], med.fit$z0.ci[2],
med.fit$tau.ci[2], med.fit$n0.ci[2]),
p.value = c(med.fit$d0.p, med.fit$z0.p,
med.fit$tau.p, med.fit$n0.p)
)
kbl(med_tbl) %>%
kable_styling(bootstrap_options = "hover",
full_width = F,
position = "left")| Effect | Estimate | CI.lower | CI.upper | p.value |
|---|---|---|---|---|
| ACME (indirect) | 0.0588758 | -0.0639580 | 0.2045237 | 0.3748 |
| ADE (direct) | 0.0840953 | -0.0976616 | 0.2536950 | 0.3564 |
| Total Effect | 0.1429711 | -0.0914130 | 0.3707475 | 0.2376 |
| Prop. Mediated | 0.4118020 | -2.2376268 | 2.9905944 | 0.3324 |
# Helper to generate significance stars
p_stars <- function(p) {
if (p < .001) return("***")
if (p < .01) return("**")
if (p < .05) return("*")
return("")
}
# Extract coefficients & p-values
a_coef <- coef(m.fit)["zs_class"]
a_p <- summary(m.fit)$coefficients["zs_class", "Pr(>|t|)"]
b_coef <- coef(y.fit)["lf_wwc"]
b_p <- summary(y.fit)$coefficients["lf_wwc", "Pr(>|t|)"]
cprime <- coef(y.fit)["zs_class"]
cprime_p <- summary(y.fit)$coefficients["zs_class", "Pr(>|t|)"]
c_total <- coef(y.fit.total)["zs_class"]
c_total_p <- summary(y.fit.total)$coefficients["zs_class", "Pr(>|t|)"]
# Paste coefficient + stars
a_label <- paste0("a = ", round(a_coef, 3), p_stars(a_p))
b_label <- paste0("b = ", round(b_coef, 3), p_stars(b_p))
cprime_label <- paste0("c' = ", round(cprime, 3), p_stars(cprime_p))
c_label <- paste0("c = ", round(c_total, 3), p_stars(c_total_p))
# Plot
ggplot() +
xlim(0, 3) + ylim(0, 2) +
# Nodes
annotate("text", x = 0.5, y = 1, label = "zs_class", fontface = "bold") +
annotate("text", x = 1.5, y = 1, label = "lf_wwc", fontface = "bold") +
annotate("text", x = 2.5, y = 1, label = "crs", fontface = "bold") +
# a-path (X → M)
annotate("segment",
x = 0.7, xend = 1.3, y = 1, yend = 1,
arrow = arrow(length = unit(0.20, "cm"))) +
annotate("text", x = 1.0, y = 1.15, label = a_label) +
# b-path (M → Y)
annotate("segment",
x = 1.7, xend = 2.3, y = 1, yend = 1,
arrow = arrow(length = unit(0.20, "cm"))) +
annotate("text", x = 2.0, y = 1.15, label = b_label) +
# c'-path (direct effect)
annotate("segment",
x = 0.5, xend = 2.5, y = 0.9, yend = 0.9,
arrow = arrow(length = unit(0.20, "cm"))) +
annotate("text", x = 1.5, y = 0.75, label = cprime_label) +
# c-path (total effect, dashed)
annotate("segment",
x = 0.5, xend = 2.5, y = 1.1, yend = 1.1,
linetype = "dashed",
arrow = arrow(length = unit(0.20, "cm"))) +
annotate("text", x = 1.5, y = 1.25, label = c_label) +
theme_void()
Interactions
LM 1
Predictor: Class ZSB
Moderator: Race ZSB
Outcome: Solidarity
Sample: White people
m1 <- lm(soli ~ zs_class*zs_race,data = df_cbzs_elg %>% filter(ingroup == "white people"))
eta_table <- eta_squared(m1)
etas_for_table <- c(NA,eta_table$Eta2)
apa_lm <- apa_print(m1)
table_for_print <- apa_lm$table %>%
mutate(eta2 = round(etas_for_table,3))
kbl(table_for_print) %>%
kable_styling(bootstrap_options = "hover",
full_width = F,
position = "left")| term | estimate | conf.int | statistic | df | p.value | eta2 |
|---|---|---|---|---|---|---|
| Intercept | 5.35 | [4.80, 5.89] | 19.28 | 212 | < .001 | NA |
| Zs class | 0.20 | [0.10, 0.31] | 3.77 | 212 | < .001 | 0.251 |
| Zs race | -0.23 | [-0.48, 0.02] | -1.85 | 212 | .065 | 0.077 |
| Zs class \(\times\) Zs race | 0.02 | [-0.03, 0.07] | 0.73 | 212 | .469 | 0.002 |
interact_plot(m1,
pred = "zs_class",
modx = "zs_race",
interval = T)
LM 2
Predictor: Class ZSB
Moderator: Race ZSB
Outcome: Cross-race Solidarity
Sample: White people
m1 <- lm(crs ~ zs_class*zs_race,data = df_cbzs_elg %>% filter(ingroup == "white people"))
eta_table <- eta_squared(m1)
etas_for_table <- c(NA,eta_table$Eta2)
apa_lm <- apa_print(m1)
table_for_print <- apa_lm$table %>%
mutate(eta2 = round(etas_for_table,3))
kbl(table_for_print) %>%
kable_styling(bootstrap_options = "hover",
full_width = F,
position = "left")| term | estimate | conf.int | statistic | df | p.value | eta2 |
|---|---|---|---|---|---|---|
| Intercept | 3.88 | [2.79, 4.97] | 7.00 | 209 | < .001 | NA |
| Zs class | 0.41 | [0.20, 0.62] | 3.80 | 209 | < .001 | 0.030 |
| Zs race | 0.22 | [-0.28, 0.71] | 0.86 | 209 | .392 | 0.163 |
| Zs class \(\times\) Zs race | -0.13 | [-0.23, -0.04] | -2.72 | 209 | .007 | 0.034 |
interact_plot(m1,
pred = "zs_class",
modx = "zs_race",
interval = T)
LM 3
Predictor: Class ZSB
Moderator: Race ZSB
Outcome: Linked Fate with Non-White Working-Class
Sample: White people
m1 <- lm(lf_nwwc ~ zs_class*zs_race,data = df_cbzs_elg %>% filter(ingroup == "white people"))
eta_table <- eta_squared(m1)
etas_for_table <- c(NA,eta_table$Eta2)
apa_lm <- apa_print(m1)
table_for_print <- apa_lm$table %>%
mutate(eta2 = round(etas_for_table,3))
kbl(table_for_print) %>%
kable_styling(bootstrap_options = "hover",
full_width = F,
position = "left")| term | estimate | conf.int | statistic | df | p.value | eta2 |
|---|---|---|---|---|---|---|
| Intercept | 5.20 | [4.33, 6.06] | 11.85 | 212 | < .001 | NA |
| Zs class | 0.13 | [-0.03, 0.30] | 1.57 | 212 | .119 | 0.036 |
| Zs race | -0.31 | [-0.70, 0.09] | -1.54 | 212 | .126 | 0.127 |
| Zs class \(\times\) Zs race | 0.00 | [-0.08, 0.08] | 0.01 | 212 | .991 | 0.000 |
interact_plot(m1,
pred = "zs_class",
modx = "zs_race",
interval = T)
LM 4
Predictor: Class ZSB
Moderator: Race ZSB
Outcome: Linked Fate with White Upper-Class
Sample: White people
m1 <- lm(lf_wuc ~ zs_class*zs_race,data = df_cbzs_elg %>% filter(ingroup == "white people"))
eta_table <- eta_squared(m1)
etas_for_table <- c(NA,eta_table$Eta2)
apa_lm <- apa_print(m1)
table_for_print <- apa_lm$table %>%
mutate(eta2 = round(etas_for_table,3))
kbl(table_for_print) %>%
kable_styling(bootstrap_options = "hover",
full_width = F,
position = "left")| term | estimate | conf.int | statistic | df | p.value | eta2 |
|---|---|---|---|---|---|---|
| Intercept | 6.18 | [5.10, 7.26] | 11.27 | 212 | < .001 | NA |
| Zs class | -0.55 | [-0.76, -0.34] | -5.14 | 212 | < .001 | 0.183 |
| Zs race | -0.33 | [-0.82, 0.16] | -1.33 | 212 | .185 | 0.012 |
| Zs class \(\times\) Zs race | 0.09 | [-0.01, 0.19] | 1.85 | 212 | .066 | 0.016 |
interact_plot(m1,
pred = "zs_class",
modx = "zs_race",
interval = T)
LM 5
Predictor: Class ZSB
Moderator: Race ZSB
Outcome: Linked Fate with White Working-Class
Sample: Non-White people
m1 <- lm(lf_wwc ~ zs_class*zs_race,data = df_cbzs_elg %>% filter(ingroup == "racial minorities"))
eta_table <- eta_squared(m1)
etas_for_table <- c(NA,eta_table$Eta2)
apa_lm <- apa_print(m1)
table_for_print <- apa_lm$table %>%
mutate(eta2 = round(etas_for_table,3))
kbl(table_for_print) %>%
kable_styling(bootstrap_options = "hover",
full_width = F,
position = "left")| term | estimate | conf.int | statistic | df | p.value | eta2 |
|---|---|---|---|---|---|---|
| Intercept | 1.85 | [0.07, 3.63] | 2.07 | 65 | .042 | NA |
| Zs class | 0.68 | [0.24, 1.13] | 3.08 | 65 | .003 | 0.020 |
| Zs race | 0.66 | [0.12, 1.19] | 2.47 | 65 | .016 | 0.002 |
| Zs class \(\times\) Zs race | -0.16 | [-0.27, -0.05] | -2.86 | 65 | .006 | 0.112 |
interact_plot(m1,
pred = "zs_class",
modx = "zs_race",
interval = T)
LM 6
Predictor: Class ZSB
Moderator: Race ZSB
Outcome: Linked Fate with Non-White Upper-Class
Sample: Non-White people
m1 <- lm(lf_nwuc ~ zs_class*zs_race,data = df_cbzs_elg %>% filter(ingroup == "racial minorities"))
eta_table <- eta_squared(m1)
etas_for_table <- c(NA,eta_table$Eta2)
apa_lm <- apa_print(m1)
table_for_print <- apa_lm$table %>%
mutate(eta2 = round(etas_for_table,3))
kbl(table_for_print) %>%
kable_styling(bootstrap_options = "hover",
full_width = F,
position = "left")| term | estimate | conf.int | statistic | df | p.value | eta2 |
|---|---|---|---|---|---|---|
| Intercept | 2.43 | [0.77, 4.09] | 2.92 | 65 | .005 | NA |
| Zs class | 0.55 | [0.14, 0.96] | 2.66 | 65 | .010 | 0.015 |
| Zs race | 0.56 | [0.06, 1.05] | 2.25 | 65 | .028 | 0.000 |
| Zs class \(\times\) Zs race | -0.13 | [-0.23, -0.03] | -2.53 | 65 | .014 | 0.089 |
interact_plot(m1,
pred = "zs_class",
modx = "zs_race",
interval = T)