Class Zero-Sum Beliefs
November 2025A: 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 |
|---|---|---|
| woman | 105 | 53.57 |
| man | 90 | 45.92 |
| other | 1 | 0.51 |
Race
| race | N | Perc |
|---|---|---|
| White | 143 | 72.96 |
| Black or African American | 23 | 11.73 |
| Hispanic, Latino, or Spanish origin | 14 | 7.14 |
| multiracial | 10 | 5.10 |
| Asian | 3 | 1.53 |
| Middle Eastern or North African | 1 | 0.51 |
| Other (please specify) | 1 | 0.51 |
| NA | 1 | 0.51 |
Age
Mean age: 38.74.
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 |
|---|---|---|
| noHS | 1 | 0.51 |
| GED | 114 | 58.16 |
| 2yearColl | 70 | 35.71 |
| 4yearColl | 9 | 4.59 |
| PHD | 1 | 0.51 |
| NA | 1 | 0.51 |
SES
| ses | N | Perc |
|---|---|---|
| Lower Class | 28 | 14.29 |
| Lower Middle Class | 77 | 39.29 |
| Middle Class | 78 | 39.80 |
| Upper Middle Class | 10 | 5.10 |
| Upper Class | 2 | 1.02 |
| NA | 1 | 0.51 |
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 | 68 | 34.69 |
| Democrat | 66 | 33.67 |
| Republican | 62 | 31.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.94
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"))
Neutral Class Zero-Sum Beliefs
- If one class becomes richer, this comes at the expense of other classes
- If one class makes more money, then other classes make less money
- If one class does better economically, this does NOT come at the expense of other classes [R]
alpha = 0.94
df_cbzs_elg %>%
ggplot(aes(x = zs_neut)) +
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_neut,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.75
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"))
Perceived working-class disadvantage
- Working-class people are struggling to make ends meet.
- Most working-class people live paycheck to paycheck.
- Working class people are facing serious financial hardship.
alpha = 0.9
df_cbzs_elg %>%
ggplot(aes(x = dis)) +
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$dis,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"))
System justification
- In general, I find society to be fair.
- In general, the American political system operates as it should.
- American society needs to be radically restructured. [R]
- The United States is the best country in the world to live in.
- Most policies serve the greater good.
- Everyone has a fair shot at wealth and happiness.
- Our society is getting worse every year. [R]
- Society is set up so that people usually get what they deserve.
alpha = 0.91
df_cbzs_elg %>%
ggplot(aes(x = sj)) +
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$sj,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"))
General zero-sum mindset
- The success of one person is usually the failure of another person.
- Life is such that when one person gains, someone else has to lose.
- When someone does much for others, they lose.
- In most situations, different people’s interests are incompatible.
- When one person is winning, it does not mean that someone else is losing. [R]
- Life is like a tennis game - A person wins only when another person loses.
- One person’s success is not another person’s failure. [R]
alpha = 0.89
df_cbzs_elg %>%
ggplot(aes(x = zsm)) +
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$zsm,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.89
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"))
Linked fate
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.
- What happens to working-class White people in this country will have something to do with what happens to working-class people of my racial group.
- Working-class White people and working-class people from my racial group share a common destiny
- What happens to working-class Black people in this country will have something to do with what happens to working-class people of my racial group.
- Working-class Black people and working-class people from my racial group share a common destiny
- What happens to working-class Asian people in this country will have something to do with what happens to working-class people of my racial group.
- Working-class Asian people and working-class people from my racial group share a common destiny
- What happens to working-class Hispanic people in this country will have something to do with what happens to working-class people of my racial group.
- Working-class Hispanic people and working-class people from my racial group share a common destiny
alpha (of all items) = 0.9
df_cbzs_elg %>%
ggplot(aes(x = lf)) +
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,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
Same procedure as the one in the linked fate measure.
- 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"))
Working-class identification
To what extent do you identify as part of the working class? (1 = Not at all to 7 = Completely)
df_cbzs_elg %>%
ggplot(aes(x = class_id)) +
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$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"))
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"))
Analysis
Correlations
Linear models
Solidarity as DV
Model 1:
m1 <- lm(soli ~ zs_class,data = df_cbzs_elg)
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 | 4.69 | [4.34, 5.04] | 26.67 | 194 | < .001 | NA |
| Zs class | 0.25 | [0.18, 0.32] | 7.29 | 194 | < .001 | 0.215 |
Model 2:
m1 <- lm(soli ~ zs_class + ideo_con,data = df_cbzs_elg)
eta_table <- eta_squared(m1)
etas_for_table <- c(NA,eta_table$Eta2_partial)
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.40 | [4.86, 5.94] | 19.74 | 184 | < .001 | NA |
| Zs class | 0.18 | [0.11, 0.26] | 4.67 | 184 | < .001 | 0.218 |
| Ideo con | -0.10 | [-0.16, -0.03] | -3.02 | 184 | .003 | 0.047 |
Model 3:
m1 <- lm(soli ~ zs_class + ideo_con + SDO + sj,data = df_cbzs_elg)
eta_table <- eta_squared(m1)
etas_for_table <- c(NA,eta_table$Eta2_partial)
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.52 | [5.86, 7.18] | 19.55 | 182 | < .001 | NA |
| Zs class | 0.10 | [0.02, 0.18] | 2.44 | 182 | .016 | 0.250 |
| Ideo con | -0.01 | [-0.08, 0.06] | -0.31 | 182 | .760 | 0.056 |
| SDO | -0.22 | [-0.32, -0.12] | -4.35 | 182 | < .001 | 0.137 |
| Sj | -0.14 | [-0.26, -0.03] | -2.45 | 182 | .015 | 0.032 |
Model 4:
m1 <- lm(soli ~ zs_class + ideo_con + SDO + sj + reldep + dis + zsm,data = df_cbzs_elg)
eta_table <- eta_squared(m1)
etas_for_table <- c(NA,eta_table$Eta2_partial)
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.98 | [2.88, 5.09] | 7.12 | 179 | < .001 | NA |
| Zs class | 0.11 | [0.03, 0.19] | 2.83 | 179 | .005 | 0.296 |
| Ideo con | -0.01 | [-0.07, 0.05] | -0.32 | 179 | .753 | 0.069 |
| SDO | -0.16 | [-0.25, -0.06] | -3.32 | 179 | .001 | 0.167 |
| Sj | -0.03 | [-0.14, 0.08] | -0.53 | 179 | .597 | 0.040 |
| Reldep | -0.04 | [-0.12, 0.04] | -1.04 | 179 | .298 | 0.005 |
| Dis | 0.40 | [0.27, 0.52] | 6.31 | 179 | < .001 | 0.186 |
| Zsm | -0.10 | [-0.18, -0.01] | -2.23 | 179 | .027 | 0.027 |
Model 5:
m1 <- lm(soli ~ zs_class + ideo_con + SDO + sj + reldep + dis + zsm + income_num + edu_num + man + white + age,data = df_cbzs_elg)
eta_table <- eta_squared(m1)
etas_for_table <- c(NA,eta_table$Eta2_partial)
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.63 | [2.36, 4.89] | 5.66 | 170 | < .001 | NA |
| Zs class | 0.13 | [0.05, 0.21] | 3.15 | 170 | .002 | 0.302 |
| Ideo con | -0.01 | [-0.07, 0.05] | -0.38 | 170 | .707 | 0.074 |
| SDO | -0.14 | [-0.23, -0.04] | -2.80 | 170 | .006 | 0.170 |
| Sj | -0.02 | [-0.14, 0.09] | -0.43 | 170 | .669 | 0.046 |
| Reldep | -0.06 | [-0.15, 0.03] | -1.21 | 170 | .229 | 0.004 |
| Dis | 0.40 | [0.27, 0.53] | 6.21 | 170 | < .001 | 0.195 |
| Zsm | -0.09 | [-0.18, 0.00] | -2.05 | 170 | .042 | 0.028 |
| Income num | -0.01 | [-0.06, 0.03] | -0.63 | 170 | .531 | 0.001 |
| Edu num | 0.06 | [-0.10, 0.21] | 0.70 | 170 | .483 | 0.007 |
| Man | -0.16 | [-0.37, 0.04] | -1.54 | 170 | .125 | 0.017 |
| White | -0.07 | [-0.31, 0.16] | -0.61 | 170 | .546 | 0.001 |
| Age | 0.01 | [0.00, 0.02] | 1.96 | 170 | .052 | 0.022 |
Cross-Race Solidarity as DV
Model 1:
m1 <- lm(crs ~ zs_class,data = df_cbzs_elg)
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.50 | [2.90, 4.10] | 11.49 | 194 | < .001 | NA |
| Zs class | 0.27 | [0.15, 0.39] | 4.53 | 194 | < .001 | 0.096 |
Model 2:
m1 <- lm(crs ~ zs_class + ideo_con,data = df_cbzs_elg)
eta_table <- eta_squared(m1)
etas_for_table <- c(NA,eta_table$Eta2_partial)
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.61 | [2.65, 4.56] | 7.46 | 184 | < .001 | NA |
| Zs class | 0.27 | [0.13, 0.41] | 3.88 | 184 | < .001 | 0.108 |
| Ideo con | -0.02 | [-0.14, 0.09] | -0.38 | 184 | .701 | 0.001 |
Model 3:
m1 <- lm(crs ~ zs_class + ideo_con + SDO + sj,data = df_cbzs_elg)
eta_table <- eta_squared(m1)
etas_for_table <- c(NA,eta_table$Eta2_partial)
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 | 4.14 | [2.90, 5.38] | 6.59 | 182 | < .001 | NA |
| Zs class | 0.23 | [0.08, 0.38] | 3.06 | 182 | .003 | 0.113 |
| Ideo con | 0.03 | [-0.09, 0.16] | 0.52 | 182 | .601 | 0.001 |
| SDO | -0.28 | [-0.47, -0.09] | -2.92 | 182 | .004 | 0.045 |
| Sj | 0.05 | [-0.16, 0.27] | 0.49 | 182 | .622 | 0.001 |
Model 4:
m1 <- lm(crs ~ zs_class + ideo_con + SDO + sj + reldep + dis + zsm,data = df_cbzs_elg)
eta_table <- eta_squared(m1)
etas_for_table <- c(NA,eta_table$Eta2_partial)
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.70 | [1.40, 6.00] | 3.18 | 179 | .002 | NA |
| Zs class | 0.25 | [0.08, 0.41] | 3.00 | 179 | .003 | 0.116 |
| Ideo con | 0.03 | [-0.09, 0.16] | 0.51 | 179 | .612 | 0.001 |
| SDO | -0.25 | [-0.44, -0.06] | -2.58 | 179 | .011 | 0.046 |
| Sj | 0.07 | [-0.16, 0.30] | 0.61 | 179 | .542 | 0.001 |
| Reldep | -0.15 | [-0.32, 0.01] | -1.82 | 179 | .070 | 0.018 |
| Dis | 0.17 | [-0.09, 0.43] | 1.26 | 179 | .210 | 0.009 |
| Zsm | -0.06 | [-0.24, 0.12] | -0.67 | 179 | .503 | 0.003 |
Model 5:
m1 <- lm(crs ~ zs_class + ideo_con + SDO + sj + reldep + dis + zsm + income_num + edu_num + man + white + age,data = df_cbzs_elg)
eta_table <- eta_squared(m1)
etas_for_table <- c(NA,eta_table$Eta2_partial)
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.56 | [-0.07, 5.19] | 1.93 | 170 | .056 | NA |
| Zs class | 0.25 | [0.08, 0.41] | 2.91 | 170 | .004 | 0.135 |
| Ideo con | 0.05 | [-0.08, 0.18] | 0.78 | 170 | .439 | 0.001 |
| SDO | -0.27 | [-0.47, -0.07] | -2.64 | 170 | .009 | 0.042 |
| Sj | 0.08 | [-0.16, 0.31] | 0.62 | 170 | .536 | 0.002 |
| Reldep | -0.05 | [-0.24, 0.14] | -0.52 | 170 | .602 | 0.012 |
| Dis | 0.19 | [-0.07, 0.46] | 1.45 | 170 | .150 | 0.013 |
| Zsm | -0.01 | [-0.20, 0.17] | -0.14 | 170 | .886 | 0.001 |
| Income num | 0.09 | [0.00, 0.18] | 1.98 | 170 | .050 | 0.024 |
| Edu num | 0.06 | [-0.26, 0.38] | 0.36 | 170 | .716 | 0.001 |
| Man | 0.05 | [-0.37, 0.48] | 0.25 | 170 | .805 | 0.001 |
| White | -0.03 | [-0.53, 0.46] | -0.13 | 170 | .896 | 0.000 |
| Age | 0.00 | [-0.02, 0.01] | -0.25 | 170 | .804 | 0.000 |
Linked Fate as DV
Model 1:
m1 <- lm(lf ~ zs_class,data = df_cbzs_elg)
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.60 | [3.06, 4.14] | 13.14 | 194 | < .001 | NA |
| Zs class | 0.22 | [0.11, 0.32] | 4.03 | 194 | < .001 | 0.077 |
Model 2:
m1 <- lm(lf ~ zs_class + ideo_con,data = df_cbzs_elg)
eta_table <- eta_squared(m1)
etas_for_table <- c(NA,eta_table$Eta2_partial)
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.99 | [3.11, 4.87] | 8.94 | 184 | < .001 | NA |
| Zs class | 0.17 | [0.05, 0.30] | 2.71 | 184 | .007 | 0.070 |
| Ideo con | -0.05 | [-0.16, 0.05] | -1.00 | 184 | .320 | 0.005 |
Model 3:
m1 <- lm(lf ~ zs_class + ideo_con + SDO + sj,data = df_cbzs_elg)
eta_table <- eta_squared(m1)
etas_for_table <- c(NA,eta_table$Eta2_partial)
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 | 4.81 | [3.67, 5.94] | 8.35 | 182 | < .001 | NA |
| Zs class | 0.11 | [-0.02, 0.25] | 1.62 | 182 | .108 | 0.074 |
| Ideo con | 0.02 | [-0.10, 0.14] | 0.34 | 182 | .732 | 0.006 |
| SDO | -0.27 | [-0.45, -0.10] | -3.11 | 182 | .002 | 0.059 |
| Sj | -0.03 | [-0.23, 0.17] | -0.26 | 182 | .795 | 0.000 |
Model 4:
m1 <- lm(lf ~ zs_class + ideo_con + SDO + sj + reldep + dis + zsm,data = df_cbzs_elg)
eta_table <- eta_squared(m1)
etas_for_table <- c(NA,eta_table$Eta2_partial)
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.17 | [1.07, 5.27] | 2.98 | 179 | .003 | NA |
| Zs class | 0.12 | [-0.03, 0.27] | 1.62 | 179 | .107 | 0.077 |
| Ideo con | 0.02 | [-0.10, 0.14] | 0.34 | 179 | .733 | 0.006 |
| SDO | -0.23 | [-0.40, -0.05] | -2.55 | 179 | .012 | 0.061 |
| Sj | 0.05 | [-0.17, 0.26] | 0.43 | 179 | .671 | 0.000 |
| Reldep | -0.07 | [-0.22, 0.08] | -0.92 | 179 | .359 | 0.004 |
| Dis | 0.29 | [0.05, 0.52] | 2.37 | 179 | .019 | 0.031 |
| Zsm | -0.07 | [-0.23, 0.09] | -0.80 | 179 | .422 | 0.004 |
Model 5:
m1 <- lm(lf ~ zs_class + ideo_con + SDO + sj + reldep + dis + zsm + income_num + edu_num + man + white + age,data = df_cbzs_elg)
eta_table <- eta_squared(m1)
etas_for_table <- c(NA,eta_table$Eta2_partial)
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.83 | [0.40, 5.26] | 2.30 | 170 | .023 | NA |
| Zs class | 0.12 | [-0.03, 0.28] | 1.60 | 170 | .111 | 0.081 |
| Ideo con | 0.03 | [-0.09, 0.15] | 0.54 | 170 | .587 | 0.005 |
| SDO | -0.25 | [-0.44, -0.07] | -2.69 | 170 | .008 | 0.059 |
| Sj | 0.02 | [-0.20, 0.24] | 0.20 | 170 | .844 | 0.000 |
| Reldep | -0.04 | [-0.21, 0.13] | -0.44 | 170 | .658 | 0.003 |
| Dis | 0.28 | [0.04, 0.52] | 2.27 | 170 | .024 | 0.035 |
| Zsm | -0.07 | [-0.24, 0.10] | -0.85 | 170 | .395 | 0.002 |
| Income num | 0.02 | [-0.06, 0.11] | 0.56 | 170 | .575 | 0.001 |
| Edu num | -0.04 | [-0.34, 0.25] | -0.28 | 170 | .777 | 0.001 |
| Man | 0.37 | [-0.02, 0.77] | 1.87 | 170 | .064 | 0.020 |
| White | -0.08 | [-0.54, 0.38] | -0.35 | 170 | .729 | 0.000 |
| Age | 0.01 | [-0.01, 0.02] | 0.80 | 170 | .428 | 0.004 |
Support for Policy as DV
Model 1:
m1 <- lm(support ~ zs_class,data = df_cbzs_elg)
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.28 | [2.57, 4.00] | 9.03 | 194 | < .001 | NA |
| Zs class | 0.46 | [0.32, 0.60] | 6.42 | 194 | < .001 | 0.175 |
Model 2:
m1 <- lm(support ~ zs_class + ideo_con,data = df_cbzs_elg)
eta_table <- eta_squared(m1)
etas_for_table <- c(NA,eta_table$Eta2_partial)
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.13 | [4.01, 6.25] | 9.06 | 184 | < .001 | NA |
| Zs class | 0.28 | [0.12, 0.44] | 3.43 | 184 | < .001 | 0.184 |
| Ideo con | -0.29 | [-0.42, -0.15] | -4.22 | 184 | < .001 | 0.088 |
Model 3:
m1 <- lm(support ~ zs_class + ideo_con + SDO + sj,data = df_cbzs_elg)
eta_table <- eta_squared(m1)
etas_for_table <- c(NA,eta_table$Eta2_partial)
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.45 | [5.02, 7.89] | 8.85 | 182 | < .001 | NA |
| Zs class | 0.18 | [0.01, 0.35] | 2.04 | 182 | .043 | 0.194 |
| Ideo con | -0.18 | [-0.32, -0.03] | -2.38 | 182 | .018 | 0.094 |
| SDO | -0.33 | [-0.55, -0.11] | -2.94 | 182 | .004 | 0.060 |
| Sj | -0.12 | [-0.38, 0.13] | -0.96 | 182 | .338 | 0.005 |
Model 4:
m1 <- lm(support ~ zs_class + ideo_con + SDO + sj + reldep + dis + zsm,data = df_cbzs_elg)
eta_table <- eta_squared(m1)
etas_for_table <- c(NA,eta_table$Eta2_partial)
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.80 | [4.12, 9.48] | 5.01 | 179 | < .001 | NA |
| Zs class | 0.23 | [0.04, 0.42] | 2.44 | 179 | .016 | 0.198 |
| Ideo con | -0.17 | [-0.32, -0.03] | -2.34 | 179 | .021 | 0.096 |
| SDO | -0.31 | [-0.53, -0.08] | -2.70 | 179 | .008 | 0.061 |
| Sj | -0.13 | [-0.40, 0.14] | -0.95 | 179 | .345 | 0.005 |
| Reldep | -0.12 | [-0.31, 0.07] | -1.25 | 179 | .212 | 0.010 |
| Dis | 0.04 | [-0.26, 0.35] | 0.29 | 179 | .771 | 0.001 |
| Zsm | -0.15 | [-0.35, 0.05] | -1.45 | 179 | .149 | 0.012 |
Model 5:
m1 <- lm(support ~ zs_class + ideo_con + SDO + sj + reldep + dis + zsm + income_num + edu_num + man + white + age,data = df_cbzs_elg)
eta_table <- eta_squared(m1)
etas_for_table <- c(NA,eta_table$Eta2_partial)
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.78 | [3.79, 9.78] | 4.47 | 170 | < .001 | NA |
| Zs class | 0.22 | [0.03, 0.41] | 2.28 | 170 | .024 | 0.218 |
| Ideo con | -0.19 | [-0.34, -0.04] | -2.57 | 170 | .011 | 0.109 |
| SDO | -0.21 | [-0.44, 0.02] | -1.80 | 170 | .074 | 0.055 |
| Sj | -0.13 | [-0.40, 0.15] | -0.91 | 170 | .364 | 0.009 |
| Reldep | -0.19 | [-0.40, 0.03] | -1.72 | 170 | .088 | 0.007 |
| Dis | 0.10 | [-0.20, 0.40] | 0.64 | 170 | .521 | 0.001 |
| Zsm | -0.17 | [-0.38, 0.04] | -1.62 | 170 | .107 | 0.013 |
| Income num | -0.13 | [-0.24, -0.02] | -2.44 | 170 | .016 | 0.024 |
| Edu num | 0.48 | [0.11, 0.85] | 2.59 | 170 | .011 | 0.042 |
| Man | -0.40 | [-0.89, 0.09] | -1.62 | 170 | .107 | 0.012 |
| White | -0.03 | [-0.59, 0.53] | -0.10 | 170 | .922 | 0.001 |
| Age | -0.02 | [-0.03, 0.00] | -1.58 | 170 | .117 | 0.014 |
Mediation models
Model 1A
Predictor: CBZS
Mediator: Solidarity
Outcome: Support for Policy
Controls: Conservatism
Bootstraps: 10,000
# Vector of control variable names
controls <- c(
"ideo_con")
# Formula for mediator model: soli ~ zs_class + controls
form.m <- reformulate(c("zs_class", controls), response = "soli")
# Formula for outcome model: support ~ zs_class + soli + controls
form.y <- reformulate(c("zs_class", "soli", controls), response = "support")
# Fit linear models
m.fit <- lm(form.m, data = df_cbzs_elg) # a-path
y.fit <- lm(form.y, data = df_cbzs_elg) # b and c'-paths
# Fit outcome model WITHOUT mediator to get c-path (total effect)
y.fit.total <- lm(
reformulate(c("zs_class", controls), response = "support"),
data = df_cbzs_elg
)
# Mediation analysis with bootstrapping (10,000 sims)
med.fit <- mediation::mediate(
model.m = m.fit,
model.y = y.fit,
treat = "zs_class",
mediator = "soli",
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.0726813 | 0.0108585 | 0.1436155 | 0.0212 |
| ADE (direct) | 0.2086604 | 0.0030862 | 0.4187896 | 0.0468 |
| Total Effect | 0.2813417 | 0.0809088 | 0.4813416 | 0.0076 |
| Prop. Mediated | 0.2583382 | 0.0305308 | 0.8908305 | 0.0288 |
# 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)["soli"]
b_p <- summary(y.fit)$coefficients["soli", "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 = "soli", fontface = "bold") +
annotate("text", x = 2.5, y = 1, label = "support", 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()
Model 1B
Predictor: CBZS
Mediator: Solidarity
Outcome: Support for Policy
Controls: SDO
Bootstraps: 10,000
# Vector of control variable names
controls <- c(
"SDO")
# Formula for mediator model: soli ~ zs_class + controls
form.m <- reformulate(c("zs_class", controls), response = "soli")
# Formula for outcome model: support ~ zs_class + soli + controls
form.y <- reformulate(c("zs_class", "soli", controls), response = "support")
# Fit linear models
m.fit <- lm(form.m, data = df_cbzs_elg) # a-path
y.fit <- lm(form.y, data = df_cbzs_elg) # b and c'-paths
# Fit outcome model WITHOUT mediator to get c-path (total effect)
y.fit.total <- lm(
reformulate(c("zs_class", controls), response = "support"),
data = df_cbzs_elg
)
# Mediation analysis with bootstrapping (10,000 sims)
med.fit <- mediation::mediate(
model.m = m.fit,
model.y = y.fit,
treat = "zs_class",
mediator = "soli",
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.0353876 | -0.0196418 | 0.0872986 | 0.1872 |
| ADE (direct) | 0.2667420 | 0.0796494 | 0.4544776 | 0.0056 |
| Total Effect | 0.3021296 | 0.1230382 | 0.4781307 | 0.0014 |
| Prop. Mediated | 0.1171272 | -0.0676976 | 0.4162186 | 0.1886 |
# 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)["soli"]
b_p <- summary(y.fit)$coefficients["soli", "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 = "soli", fontface = "bold") +
annotate("text", x = 2.5, y = 1, label = "support", 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()
Model 1C
Predictor: CBZS
Mediator: Solidarity
Outcome: Support for Policy
Controls: Conservatism, SDO, system justification
Bootstraps: 10,000
# Vector of control variable names
controls <- c(
"ideo_con", "SDO", "sj"
)
# Formula for mediator model: soli ~ zs_class + controls
form.m <- reformulate(c("zs_class", controls), response = "soli")
# Formula for outcome model: support ~ zs_class + soli + controls
form.y <- reformulate(c("zs_class", "soli", controls), response = "support")
# Fit linear models
m.fit <- lm(form.m, data = df_cbzs_elg) # a-path
y.fit <- lm(form.y, data = df_cbzs_elg) # b and c'-paths
# Fit outcome model WITHOUT mediator to get c-path (total effect)
y.fit.total <- lm(
reformulate(c("zs_class", controls), response = "support"),
data = df_cbzs_elg
)
# Mediation analysis with bootstrapping (10,000 sims)
med.fit <- mediation::mediate(
model.m = m.fit,
model.y = y.fit,
treat = "zs_class",
mediator = "soli",
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.0216253 | -0.0161287 | 0.0724495 | 0.2846 |
| ADE (direct) | 0.1582800 | -0.0615918 | 0.3819159 | 0.1626 |
| Total Effect | 0.1799054 | -0.0440047 | 0.4016643 | 0.1182 |
| Prop. Mediated | 0.1202039 | -0.4942648 | 0.9622427 | 0.3560 |
# 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)["soli"]
b_p <- summary(y.fit)$coefficients["soli", "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 = "soli", fontface = "bold") +
annotate("text", x = 2.5, y = 1, label = "support", 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()
Model 1D
Predictor: CBZS
Mediator: Solidarity
Outcome: Support for Policy
Controls: Conservatism, SDO, system justification, relative deprivation, working-class disadvantage, zero-sum mindset
Bootstraps: 10,000
# Vector of control variable names
controls <- c(
"ideo_con", "SDO", "sj", "reldep", "dis", "zsm"
)
# Formula for mediator model: soli ~ zs_class + controls
form.m <- reformulate(c("zs_class", controls), response = "soli")
# Formula for outcome model: support ~ zs_class + soli + controls
form.y <- reformulate(c("zs_class", "soli", controls), response = "support")
# Fit linear models
m.fit <- lm(form.m, data = df_cbzs_elg) # a-path
y.fit <- lm(form.y, data = df_cbzs_elg) # b and c'-paths
# Fit outcome model WITHOUT mediator to get c-path (total effect)
y.fit.total <- lm(
reformulate(c("zs_class", controls), response = "support"),
data = df_cbzs_elg
)
# Mediation analysis with bootstrapping (10,000 sims)
med.fit <- mediation::mediate(
model.m = m.fit,
model.y = y.fit,
treat = "zs_class",
mediator = "soli",
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.0209670 | -0.0222817 | 0.0790911 | 0.3688 |
| ADE (direct) | 0.2138463 | -0.0108219 | 0.4263109 | 0.0608 |
| Total Effect | 0.2348133 | 0.0128506 | 0.4440432 | 0.0384 |
| Prop. Mediated | 0.0892923 | -0.1872729 | 0.6338080 | 0.3900 |
# 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)["soli"]
b_p <- summary(y.fit)$coefficients["soli", "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 = "soli", fontface = "bold") +
annotate("text", x = 2.5, y = 1, label = "support", 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()
Model 1E
Predictor: CBZS
Mediator: Solidarity
Outcome: Support for Policy
Controls: Conservatism, SDO, system justification, relative deprivation, working-class disadvantage, zero-sum mindset, income, education, gender (man = 1, non-man = 0), race (white = 1, non-white = 0), age
Bootstraps: 10,000
# Vector of control variable names
controls <- c(
"ideo_con", "SDO", "sj", "reldep", "dis", "zsm",
"income_num", "edu_num", "man", "white", "age"
)
# Formula for mediator model: soli ~ zs_class + controls
form.m <- reformulate(c("zs_class", controls), response = "soli")
# Formula for outcome model: support ~ zs_class + soli + controls
form.y <- reformulate(c("zs_class", "soli", controls), response = "support")
# Fit linear models
m.fit <- lm(form.m, data = df_cbzs_elg) # a-path
y.fit <- lm(form.y, data = df_cbzs_elg) # b and c'-paths
# Fit outcome model WITHOUT mediator to get c-path (total effect)
y.fit.total <- lm(
reformulate(c("zs_class", controls), response = "support"),
data = df_cbzs_elg
)
# Mediation analysis with bootstrapping (10,000 sims)
med.fit <- mediation::mediate(
model.m = m.fit,
model.y = y.fit,
treat = "zs_class",
mediator = "soli",
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.0177112 | -0.0309715 | 0.0753774 | 0.4772 |
| ADE (direct) | 0.2011849 | -0.0276812 | 0.4097829 | 0.0824 |
| Total Effect | 0.2188961 | -0.0125543 | 0.4273016 | 0.0630 |
| Prop. Mediated | 0.0809116 | -0.3774146 | 0.6321172 | 0.4966 |
# 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)["soli"]
b_p <- summary(y.fit)$coefficients["soli", "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 = "soli", fontface = "bold") +
annotate("text", x = 2.5, y = 1, label = "support", 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()
Model 2A
Predictor: CBZS
Mediator: Cross-Race Solidarity
Outcome: Support for Policy
Controls: Conservatism
Bootstraps: 10,000
# Vector of control variable names
controls <- c(
"ideo_con")
# Formula for mediator model: soli ~ zs_class + controls
form.m <- reformulate(c("zs_class", controls), response = "soli")
# Formula for outcome model: support ~ zs_class + soli + controls
form.y <- reformulate(c("zs_class", "soli", controls), response = "support")
# Fit linear models
m.fit <- lm(form.m, data = df_cbzs_elg) # a-path
y.fit <- lm(form.y, data = df_cbzs_elg) # b and c'-paths
# Fit outcome model WITHOUT mediator to get c-path (total effect)
y.fit.total <- lm(
reformulate(c("zs_class", controls), response = "support"),
data = df_cbzs_elg
)
# Mediation analysis with bootstrapping (10,000 sims)
med.fit <- mediation::mediate(
model.m = m.fit,
model.y = y.fit,
treat = "zs_class",
mediator = "soli",
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.0726813 | 0.0104248 | 0.1460110 | 0.0202 |
| ADE (direct) | 0.2086604 | -0.0018993 | 0.4154307 | 0.0532 |
| Total Effect | 0.2813417 | 0.0743770 | 0.4791417 | 0.0102 |
| Prop. Mediated | 0.2583382 | 0.0271581 | 0.9388408 | 0.0304 |
# 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)["soli"]
b_p <- summary(y.fit)$coefficients["soli", "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 = "soli", fontface = "bold") +
annotate("text", x = 2.5, y = 1, label = "support", 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()
Model 2B
Predictor: CBZS
Mediator: Cross-Race Solidarity
Outcome: Support for Policy
Controls: SDO
Bootstraps: 10,000
# Vector of control variable names
controls <- c(
"SDO")
# Formula for mediator model: soli ~ zs_class + controls
form.m <- reformulate(c("zs_class", controls), response = "soli")
# Formula for outcome model: support ~ zs_class + soli + controls
form.y <- reformulate(c("zs_class", "soli", controls), response = "support")
# Fit linear models
m.fit <- lm(form.m, data = df_cbzs_elg) # a-path
y.fit <- lm(form.y, data = df_cbzs_elg) # b and c'-paths
# Fit outcome model WITHOUT mediator to get c-path (total effect)
y.fit.total <- lm(
reformulate(c("zs_class", controls), response = "support"),
data = df_cbzs_elg
)
# Mediation analysis with bootstrapping (10,000 sims)
med.fit <- mediation::mediate(
model.m = m.fit,
model.y = y.fit,
treat = "zs_class",
mediator = "soli",
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.0353876 | -0.0188325 | 0.0873507 | 0.1796 |
| ADE (direct) | 0.2667420 | 0.0793483 | 0.4597119 | 0.0058 |
| Total Effect | 0.3021296 | 0.1194425 | 0.4833623 | 0.0008 |
| Prop. Mediated | 0.1171272 | -0.0624308 | 0.4155746 | 0.1804 |
# 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)["soli"]
b_p <- summary(y.fit)$coefficients["soli", "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 = "soli", fontface = "bold") +
annotate("text", x = 2.5, y = 1, label = "support", 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()
Model 2C
Predictor: CBZS
Mediator: Cross-Race Solidarity
Outcome: Support for Policy
Controls: Conservatism, SDO, system justification
Bootstraps: 10,000
# Vector of control variable names
controls <- c(
"ideo_con", "SDO", "sj"
)
# Formula for mediator model: soli ~ zs_class + controls
form.m <- reformulate(c("zs_class", controls), response = "soli")
# Formula for outcome model: support ~ zs_class + soli + controls
form.y <- reformulate(c("zs_class", "soli", controls), response = "support")
# Fit linear models
m.fit <- lm(form.m, data = df_cbzs_elg) # a-path
y.fit <- lm(form.y, data = df_cbzs_elg) # b and c'-paths
# Fit outcome model WITHOUT mediator to get c-path (total effect)
y.fit.total <- lm(
reformulate(c("zs_class", controls), response = "support"),
data = df_cbzs_elg
)
# Mediation analysis with bootstrapping (10,000 sims)
med.fit <- mediation::mediate(
model.m = m.fit,
model.y = y.fit,
treat = "zs_class",
mediator = "soli",
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.0216253 | -0.0159087 | 0.0719836 | 0.2796 |
| ADE (direct) | 0.1582800 | -0.0645964 | 0.3816512 | 0.1656 |
| Total Effect | 0.1799054 | -0.0452960 | 0.4017645 | 0.1194 |
| Prop. Mediated | 0.1202039 | -0.4936613 | 1.0291717 | 0.3558 |
# 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)["soli"]
b_p <- summary(y.fit)$coefficients["soli", "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 = "soli", fontface = "bold") +
annotate("text", x = 2.5, y = 1, label = "support", 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()
Model 2D
Predictor: CBZS
Mediator: Cross-Race Solidarity
Outcome: Support for Policy
Controls: Conservatism, SDO, system justification, relative deprivation, working-class disadvantage, zero-sum mindset
Bootstraps: 10,000
# Vector of control variable names
controls <- c(
"ideo_con", "SDO", "sj", "reldep", "dis", "zsm"
)
# Formula for mediator model: soli ~ zs_class + controls
form.m <- reformulate(c("zs_class", controls), response = "soli")
# Formula for outcome model: support ~ zs_class + soli + controls
form.y <- reformulate(c("zs_class", "soli", controls), response = "support")
# Fit linear models
m.fit <- lm(form.m, data = df_cbzs_elg) # a-path
y.fit <- lm(form.y, data = df_cbzs_elg) # b and c'-paths
# Fit outcome model WITHOUT mediator to get c-path (total effect)
y.fit.total <- lm(
reformulate(c("zs_class", controls), response = "support"),
data = df_cbzs_elg
)
# Mediation analysis with bootstrapping (10,000 sims)
med.fit <- mediation::mediate(
model.m = m.fit,
model.y = y.fit,
treat = "zs_class",
mediator = "soli",
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.0209670 | -0.0242797 | 0.0795810 | 0.3792 |
| ADE (direct) | 0.2138463 | -0.0115958 | 0.4269528 | 0.0614 |
| Total Effect | 0.2348133 | 0.0127239 | 0.4454565 | 0.0378 |
| Prop. Mediated | 0.0892923 | -0.2103843 | 0.6182457 | 0.4010 |
# 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)["soli"]
b_p <- summary(y.fit)$coefficients["soli", "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 = "soli", fontface = "bold") +
annotate("text", x = 2.5, y = 1, label = "support", 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()
Model 2E
Predictor: CBZS
Mediator: Cross-Race Solidarity
Outcome: Support for Policy
Controls: Conservatism, SDO, system justification, relative deprivation, working-class disadvantage, zero-sum mindset, income, education, gender (man = 1, non-man = 0), race (white = 1, non-white = 0), age
Bootstraps: 10,000
# Vector of control variable names
controls <- c(
"ideo_con", "SDO", "sj", "reldep", "dis", "zsm",
"income_num", "edu_num", "man", "white", "age"
)
# Formula for mediator model: crs ~ zs_class + controls
form.m <- reformulate(c("zs_class", controls), response = "crs")
# Formula for outcome model: support ~ zs_class + crs + controls
form.y <- reformulate(c("zs_class", "crs", controls), response = "support")
# Fit linear models
m.fit <- lm(form.m, data = df_cbzs_elg) # a-path
y.fit <- lm(form.y, data = df_cbzs_elg) # b and c'-paths
# Fit outcome model WITHOUT mediator to get c-path (total effect)
y.fit.total <- lm(
reformulate(c("zs_class", controls), response = "support"),
data = df_cbzs_elg
)
# Mediation analysis with bootstrapping (10,000 sims)
med.fit <- mediation::mediate(
model.m = m.fit,
model.y = y.fit,
treat = "zs_class",
mediator = "crs",
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.0162192 | -0.0342646 | 0.0742321 | 0.5110 |
| ADE (direct) | 0.2026770 | -0.0225859 | 0.4086205 | 0.0768 |
| Total Effect | 0.2188961 | -0.0082003 | 0.4260139 | 0.0574 |
| Prop. Mediated | 0.0740954 | -0.3572606 | 0.6306943 | 0.5312 |
# 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)["crs"]
b_p <- summary(y.fit)$coefficients["crs", "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 = "crs", fontface = "bold") +
annotate("text", x = 2.5, y = 1, label = "support", 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()
Model 3A
Predictor: CBZS
Mediator: Linked Fate
Outcome: Cross-Race Solidarity
Controls: Conservatism
Bootstraps: 10,000
# Vector of control variable names
controls <- c(
"ideo_con")
# Formula for mediator model: lf ~ zs_class + controls
form.m <- reformulate(c("zs_class", controls), response = "lf")
# Formula for outcome model: crs ~ zs_class + lf + controls
form.y <- reformulate(c("zs_class", "lf", controls), response = "crs")
# Fit linear models
m.fit <- lm(form.m, data = df_cbzs_elg) # a-path
y.fit <- lm(form.y, data = df_cbzs_elg) # b and c'-paths
# Fit outcome model WITHOUT mediator to get c-path (total effect)
y.fit.total <- lm(
reformulate(c("zs_class", controls), response = "crs"),
data = df_cbzs_elg
)
# Mediation analysis with bootstrapping (10,000 sims)
med.fit <- mediation::mediate(
model.m = m.fit,
model.y = y.fit,
treat = "zs_class",
mediator = "lf",
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.0897521 | 0.0189477 | 0.1745771 | 0.0112 |
| ADE (direct) | 0.1816014 | 0.0432607 | 0.3301010 | 0.0100 |
| Total Effect | 0.2713534 | 0.1235633 | 0.4227010 | 0.0000 |
| Prop. Mediated | 0.3307571 | 0.0855015 | 0.7226333 | 0.0112 |
# 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"]
b_p <- summary(y.fit)$coefficients["lf", "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", 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()
Model 3B
Predictor: CBZS
Mediator: Linked Fate
Outcome: Cross-Race Solidarity
Controls: SDO
Bootstraps: 10,000
# Vector of control variable names
controls <- c(
"SDO")
# Formula for mediator model: lf ~ zs_class + controls
form.m <- reformulate(c("zs_class", controls), response = "lf")
# Formula for outcome model: crs ~ zs_class + lf + controls
form.y <- reformulate(c("zs_class", "lf", controls), response = "crs")
# Fit linear models
m.fit <- lm(form.m, data = df_cbzs_elg) # a-path
y.fit <- lm(form.y, data = df_cbzs_elg) # b and c'-paths
# Fit outcome model WITHOUT mediator to get c-path (total effect)
y.fit.total <- lm(
reformulate(c("zs_class", controls), response = "crs"),
data = df_cbzs_elg
)
# Mediation analysis with bootstrapping (10,000 sims)
med.fit <- mediation::mediate(
model.m = m.fit,
model.y = y.fit,
treat = "zs_class",
mediator = "lf",
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.0595886 | 0.0030526 | 0.1307774 | 0.0362 |
| ADE (direct) | 0.1267896 | -0.0193911 | 0.2810391 | 0.0864 |
| Total Effect | 0.1863782 | 0.0381156 | 0.3409963 | 0.0152 |
| Prop. Mediated | 0.3197188 | 0.0088143 | 1.1917347 | 0.0462 |
# 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"]
b_p <- summary(y.fit)$coefficients["lf", "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", 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()
Model 3C
Predictor: CBZS
Mediator: Linked Fate
Outcome: Cross-Race Solidarity
Controls: Conservatism, SDO, system justification
Bootstraps: 10,000
# Vector of control variable names
controls <- c(
"ideo_con", "SDO", "sj"
)
# Formula for mediator model: lf ~ zs_class + controls
form.m <- reformulate(c("zs_class", controls), response = "lf")
# Formula for outcome model: crs ~ zs_class + lf + controls
form.y <- reformulate(c("zs_class", "lf", controls), response = "crs")
# Fit linear models
m.fit <- lm(form.m, data = df_cbzs_elg) # a-path
y.fit <- lm(form.y, data = df_cbzs_elg) # b and c'-paths
# Fit outcome model WITHOUT mediator to get c-path (total effect)
y.fit.total <- lm(
reformulate(c("zs_class", controls), response = "crs"),
data = df_cbzs_elg
)
# Mediation analysis with bootstrapping (10,000 sims)
med.fit <- mediation::mediate(
model.m = m.fit,
model.y = y.fit,
treat = "zs_class",
mediator = "lf",
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.0548871 | -0.0191236 | 0.1425001 | 0.1550 |
| ADE (direct) | 0.1769520 | 0.0055226 | 0.3632302 | 0.0418 |
| Total Effect | 0.2318391 | 0.0523594 | 0.4162138 | 0.0140 |
| Prop. Mediated | 0.2367464 | -0.1422922 | 0.8506499 | 0.1590 |
# 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"]
b_p <- summary(y.fit)$coefficients["lf", "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", 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()
Model 3D
Predictor: CBZS
Mediator: Linked Fate
Outcome: Cross-Race Solidarity
Controls: Conservatism, SDO, system justification, relative deprivation, working-class disadvantage, zero-sum mindset
Bootstraps: 10,000
# Vector of control variable names
controls <- c(
"ideo_con", "SDO", "sj", "reldep", "dis", "zsm"
)
# Formula for mediator model: lf ~ zs_class + controls
form.m <- reformulate(c("zs_class", controls), response = "lf")
# Formula for outcome model: crs ~ zs_class + lf + controls
form.y <- reformulate(c("zs_class", "lf", controls), response = "crs")
# Fit linear models
m.fit <- lm(form.m, data = df_cbzs_elg) # a-path
y.fit <- lm(form.y, data = df_cbzs_elg) # b and c'-paths
# Fit outcome model WITHOUT mediator to get c-path (total effect)
y.fit.total <- lm(
reformulate(c("zs_class", controls), response = "crs"),
data = df_cbzs_elg
)
# Mediation analysis with bootstrapping (10,000 sims)
med.fit <- mediation::mediate(
model.m = m.fit,
model.y = y.fit,
treat = "zs_class",
mediator = "lf",
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.0580348 | -0.0213257 | 0.1412028 | 0.1636 |
| ADE (direct) | 0.1892392 | 0.0138841 | 0.3675793 | 0.0334 |
| Total Effect | 0.2472740 | 0.0574986 | 0.4227851 | 0.0088 |
| Prop. Mediated | 0.2346982 | -0.1394092 | 0.8121266 | 0.1636 |
# 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"]
b_p <- summary(y.fit)$coefficients["lf", "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", 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()
Model 3E
Predictor: CBZS
Mediator: Linked Fate
Outcome: Cross-Race Solidarity
Controls: Conservatism, SDO, system justification, relative deprivation, working-class disadvantage, zero-sum mindset, income, education, gender (man = 1, non-man = 0), race (white = 1, non-white = 0), age
Bootstraps: 10,000
# Vector of control variable names
controls <- c(
"ideo_con", "SDO", "sj", "reldep", "dis", "zsm",
"income_num", "edu_num", "man", "white", "age"
)
# Formula for mediator model: lf ~ zs_class + controls
form.m <- reformulate(c("zs_class", controls), response = "lf")
# Formula for outcome model: crs ~ zs_class + lf + controls
form.y <- reformulate(c("zs_class", "lf", controls), response = "crs")
# Fit linear models
m.fit <- lm(form.m, data = df_cbzs_elg) # a-path
y.fit <- lm(form.y, data = df_cbzs_elg) # b and c'-paths
# Fit outcome model WITHOUT mediator to get c-path (total effect)
y.fit.total <- lm(
reformulate(c("zs_class", controls), response = "crs"),
data = df_cbzs_elg
)
# Mediation analysis with bootstrapping (10,000 sims)
med.fit <- mediation::mediate(
model.m = m.fit,
model.y = y.fit,
treat = "zs_class",
mediator = "lf",
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.0589264 | -0.0192051 | 0.1472944 | 0.1440 |
| ADE (direct) | 0.1865580 | 0.0052437 | 0.3798516 | 0.0416 |
| Total Effect | 0.2454844 | 0.0600788 | 0.4284891 | 0.0104 |
| Prop. Mediated | 0.2400413 | -0.1158607 | 0.8772220 | 0.1484 |
# 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"]
b_p <- summary(y.fit)$coefficients["lf", "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", 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()
Model 4A
Predictor: CBZS
Mediator: Linked Fate
Outcome: Solidarity
Controls: Conservatism
Bootstraps: 10,000
# Vector of control variable names
controls <- c(
"ideo_con")
# Formula for mediator model: soli ~ zs_class + controls
form.m <- reformulate(c("zs_class", controls), response = "lf")
# Formula for outcome model: soli ~ zs_class + lf + controls
form.y <- reformulate(c("zs_class", "lf", controls), response = "soli")
# Fit linear models
m.fit <- lm(form.m, data = df_cbzs_elg) # a-path
y.fit <- lm(form.y, data = df_cbzs_elg) # b and c'-paths
# Fit outcome model WITHOUT mediator to get c-path (total effect)
y.fit.total <- lm(
reformulate(c("zs_class", controls), response = "soli"),
data = df_cbzs_elg
)
# Mediation analysis with bootstrapping (10,000 sims)
med.fit <- mediation::mediate(
model.m = m.fit,
model.y = y.fit,
treat = "zs_class",
mediator = "lf",
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.0329561 | 0.0072724 | 0.0636532 | 0.0116 |
| ADE (direct) | 0.1517187 | 0.0705303 | 0.2358144 | 0.0000 |
| Total Effect | 0.1846748 | 0.1020958 | 0.2719039 | 0.0000 |
| Prop. Mediated | 0.1784548 | 0.0423166 | 0.3862718 | 0.0116 |
# 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"]
b_p <- summary(y.fit)$coefficients["lf", "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", 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()
Model 4B
Predictor: CBZS
Mediator: Linked Fate
Outcome: Solidarity
Controls: SDO
Bootstraps: 10,000
# Vector of control variable names
controls <- c(
"SDO")
# Formula for mediator model: soli ~ zs_class + controls
form.m <- reformulate(c("zs_class", controls), response = "lf")
# Formula for outcome model: soli ~ zs_class + lf + controls
form.y <- reformulate(c("zs_class", "lf", controls), response = "soli")
# Fit linear models
m.fit <- lm(form.m, data = df_cbzs_elg) # a-path
y.fit <- lm(form.y, data = df_cbzs_elg) # b and c'-paths
# Fit outcome model WITHOUT mediator to get c-path (total effect)
y.fit.total <- lm(
reformulate(c("zs_class", controls), response = "soli"),
data = df_cbzs_elg
)
# Mediation analysis with bootstrapping (10,000 sims)
med.fit <- mediation::mediate(
model.m = m.fit,
model.y = y.fit,
treat = "zs_class",
mediator = "lf",
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.0187779 | 0.0010029 | 0.0420307 | 0.0352 |
| ADE (direct) | 0.1364434 | 0.0688665 | 0.2049183 | 0.0000 |
| Total Effect | 0.1552213 | 0.0846543 | 0.2256648 | 0.0000 |
| Prop. Mediated | 0.1209749 | 0.0075827 | 0.2945605 | 0.0352 |
# 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"]
b_p <- summary(y.fit)$coefficients["lf", "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", 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()
Model 4C
Predictor: CBZS
Mediator: Linked Fate
Outcome: Solidarity
Controls: Conservatism, SDO, system justification
Bootstraps: 10,000
# Vector of control variable names
controls <- c(
"ideo_con", "SDO", "sj"
)
# Formula for mediator model: lf ~ zs_class + controls
form.m <- reformulate(c("zs_class", controls), response = "lf")
# Formula for outcome model: soli ~ zs_class + lf + controls
form.y <- reformulate(c("zs_class", "lf", controls), response = "soli")
# Fit linear models
m.fit <- lm(form.m, data = df_cbzs_elg) # a-path
y.fit <- lm(form.y, data = df_cbzs_elg) # b and c'-paths
# Fit outcome model WITHOUT mediator to get c-path (total effect)
y.fit.total <- lm(
reformulate(c("zs_class", controls), response = "soli"),
data = df_cbzs_elg
)
# Mediation analysis with bootstrapping (10,000 sims)
med.fit <- mediation::mediate(
model.m = m.fit,
model.y = y.fit,
treat = "zs_class",
mediator = "lf",
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.0158413 | -0.0051690 | 0.0443542 | 0.1530 |
| ADE (direct) | 0.0822847 | -0.0150579 | 0.1718057 | 0.0902 |
| Total Effect | 0.0981261 | -0.0026087 | 0.1919555 | 0.0554 |
| Prop. Mediated | 0.1614384 | -0.2152615 | 0.8370421 | 0.1968 |
# 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"]
b_p <- summary(y.fit)$coefficients["lf", "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", 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()
Model 4D
Predictor: CBZS
Mediator: Linked Fate
Outcome: Solidarity
Controls: Conservatism, SDO, system justification, relative deprivation, working-class disadvantage, zero-sum mindset
Bootstraps: 10,000
# Vector of control variable names
controls <- c(
"ideo_con", "SDO", "sj", "reldep", "dis", "zsm"
)
# Formula for mediator model: lf ~ zs_class + controls
form.m <- reformulate(c("zs_class", controls), response = "lf")
# Formula for outcome model: soli ~ zs_class + lf + controls
form.y <- reformulate(c("zs_class", "lf", controls), response = "soli")
# Fit linear models
m.fit <- lm(form.m, data = df_cbzs_elg) # a-path
y.fit <- lm(form.y, data = df_cbzs_elg) # b and c'-paths
# Fit outcome model WITHOUT mediator to get c-path (total effect)
y.fit.total <- lm(
reformulate(c("zs_class", controls), response = "soli"),
data = df_cbzs_elg
)
# Mediation analysis with bootstrapping (10,000 sims)
med.fit <- mediation::mediate(
model.m = m.fit,
model.y = y.fit,
treat = "zs_class",
mediator = "lf",
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.0114349 | -0.0043801 | 0.0321415 | 0.1816 |
| ADE (direct) | 0.1005148 | 0.0172248 | 0.1789989 | 0.0202 |
| Total Effect | 0.1119498 | 0.0265540 | 0.1908453 | 0.0122 |
| Prop. Mediated | 0.1021435 | -0.0605052 | 0.4102218 | 0.1890 |
# 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"]
b_p <- summary(y.fit)$coefficients["lf", "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", 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()
Model 4E
Predictor: CBZS
Mediator: Linked Fate
Outcome: Solidarity
Controls: Conservatism, SDO, system justification, relative deprivation, working-class disadvantage, zero-sum mindset, income, education, gender (man = 1, non-man = 0), race (white = 1, non-white = 0), age
Bootstraps: 10,000
# Vector of control variable names
controls <- c(
"ideo_con", "SDO", "sj", "reldep", "dis", "zsm",
"income_num", "edu_num", "man", "white", "age"
)
# Formula for mediator model: lf ~ zs_class + controls
form.m <- reformulate(c("zs_class", controls), response = "lf")
# Formula for outcome model: soli ~ zs_class + lf + controls
form.y <- reformulate(c("zs_class", "lf", controls), response = "soli")
# Fit linear models
m.fit <- lm(form.m, data = df_cbzs_elg) # a-path
y.fit <- lm(form.y, data = df_cbzs_elg) # b and c'-paths
# Fit outcome model WITHOUT mediator to get c-path (total effect)
y.fit.total <- lm(
reformulate(c("zs_class", controls), response = "soli"),
data = df_cbzs_elg
)
# Mediation analysis with bootstrapping (10,000 sims)
med.fit <- mediation::mediate(
model.m = m.fit,
model.y = y.fit,
treat = "zs_class",
mediator = "lf",
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.0129121 | -0.0040477 | 0.0352640 | 0.1554 |
| ADE (direct) | 0.1148024 | 0.0261904 | 0.2001849 | 0.0118 |
| Total Effect | 0.1277146 | 0.0369791 | 0.2129865 | 0.0068 |
| Prop. Mediated | 0.1011014 | -0.0435277 | 0.3768225 | 0.1610 |
# 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"]
b_p <- summary(y.fit)$coefficients["lf", "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", 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()
Structural Equation Models
Model 1
library(lavaan)## This is lavaan 0.6-17
## lavaan is FREE software! Please report any bugs.##
## Attaching package: 'lavaan'## The following object is masked from 'package:psych':
##
## cor2covmodel_chain <- '
# Regressions (paths)
lf ~ a * zs_class
crs ~ b * lf
support ~ c * crs + cprime * zs_class # include direct path zs_class → support
# Indirect effects
ind_zs_lf_crs := a * b # zs_class → lf → crs
ind_zs_lf_crs_sup := a * b * c # zs_class → lf → crs → support (full chain)
# Total indirect effect to support (here only the chain)
ind_total := a * b * c
# Total effect of zs_class on support
total := cprime + ind_total
'
fit_chain <- sem(
model_chain,
data = df_cbzs_elg,
se = "bootstrap", # bootstrap standard errors
bootstrap = 10000 # number of bootstrap draws
)
# extract parameter estimates & bootstrap CIs
pe <- parameterEstimates(fit_chain, boot.ci.type = "perc")
# filter for the effects we defined via :=
effects <- pe %>%
filter(label %in% c(
"ind_zs_lf_crs",
"ind_zs_lf_crs_sup",
"ind_total",
"cprime",
"total"
)) %>%
transmute(
Effect = c(
"Indirect (zs_class → lf → crs)",
"Indirect (zs_class → lf → crs → support)",
"Total Indirect",
"Direct (zs_class → support)",
"Total Effect"
),
Estimate = est,
CI.lower = ci.lower,
CI.upper = ci.upper,
p.value = pvalue
)
kbl(effects) %>%
kable_styling(bootstrap_options = "hover",
full_width = F,
position = "left")| Effect | Estimate | CI.lower | CI.upper | p.value |
|---|---|---|---|---|
| Indirect (zs_class → lf → crs) | 0.4236069 | 0.2468464 | 0.5920033 | 0.0000016 |
| Indirect (zs_class → lf → crs → support) | 0.1212501 | 0.0518951 | 0.2093906 | 0.0028236 |
| Total Indirect | 0.0163764 | -0.0051492 | 0.0522232 | 0.2655260 |
| Direct (zs_class → support) | 0.0163764 | -0.0051492 | 0.0522232 | 0.2655260 |
| Total Effect | 0.4399833 | 0.2700743 | 0.6041373 | 0.0000003 |
library(semPlot)
semPaths(
fit_chain,
whatLabels = "std", # standardized estimates
layout = "circle", # or "tree"
edge.label.cex = 1.0,
sizeMan = 7
)
Model 2
library(lavaan)
model_chain <- '
# Regressions (paths)
lf ~ a * zs_class
soli ~ b * lf
support ~ c * soli + cprime * zs_class # include direct path zs_class → support
# Indirect effects
ind_zs_lf_soli := a * b # zs_class → lf → soli
ind_zs_lf_soli_sup := a * b * c # zs_class → lf → soli → support (full chain)
# Total indirect effect to support (here only the chain)
ind_total := a * b * c
# Total effect of zs_class on support
total := cprime + ind_total
'
fit_chain <- sem(
model_chain,
data = df_cbzs_elg,
se = "bootstrap", # bootstrap standard errors
bootstrap = 10000 # number of bootstrap draws
)
# extract parameter estimates & bootstrap CIs
pe <- parameterEstimates(fit_chain, boot.ci.type = "perc")
# filter for the effects we defined via :=
effects <- pe %>%
filter(label %in% c(
"ind_zs_lf_soli",
"ind_zs_lf_soli_sup",
"ind_total",
"cprime",
"total"
)) %>%
transmute(
Effect = c(
"Indirect (zs_class → lf → soli)",
"Indirect (zs_class → lf → soli → support)",
"Total Indirect",
"Direct (zs_class → support)",
"Total Effect"
),
Estimate = est,
CI.lower = ci.lower,
CI.upper = ci.upper,
p.value = pvalue
)
kbl(effects) %>%
kable_styling(bootstrap_options = "hover",
full_width = F,
position = "left")| Effect | Estimate | CI.lower | CI.upper | p.value |
|---|---|---|---|---|
| Indirect (zs_class → lf → soli) | 0.3448896 | 0.1618893 | 0.5279227 | 0.0002336 |
| Indirect (zs_class → lf → soli → support) | 0.0603068 | 0.0243982 | 0.1069284 | 0.0044796 |
| Total Indirect | 0.0275052 | 0.0066044 | 0.0591535 | 0.0447373 |
| Direct (zs_class → support) | 0.0275052 | 0.0066044 | 0.0591535 | 0.0447373 |
| Total Effect | 0.3723947 | 0.1980591 | 0.5471268 | 0.0000327 |
library(semPlot)
semPaths(
fit_chain,
whatLabels = "std", # standardized estimates
layout = "circle", # or "tree"
edge.label.cex = 1.0,
sizeMan = 7
)
Parallel Mediations
Model 1
Predictor: CBZS
Mediators: (1) Solidarity; (2) Linked fate
Outcome: Support for policy
Bootstraps: 10,000
| label | est | se | ci.lower | ci.upper | pvalue |
|---|---|---|---|---|---|
| a1 | 0.2531870 | 0.0368301 | 0.1822710 | 0.3276074 | 0.0000000 |
| a2 | 0.2176254 | 0.0571818 | 0.1066202 | 0.3314790 | 0.0001413 |
| b1 | 0.4456690 | 0.1648692 | 0.1145023 | 0.7621934 | 0.0068682 |
| b2 | 0.0211547 | 0.1076957 | -0.1857956 | 0.2416600 | 0.8442731 |
| c_prime | 0.3429236 | 0.0952700 | 0.1571987 | 0.5318580 | 0.0003188 |
| ind1 | 0.1128376 | 0.0415920 | 0.0305228 | 0.1953472 | 0.0066684 |
| ind2 | 0.0046038 | 0.0243326 | -0.0432234 | 0.0555870 | 0.8499332 |
| ind_total | 0.1174414 | 0.0420297 | 0.0362327 | 0.2020691 | 0.0052021 |
| total | 0.4603650 | 0.0817163 | 0.2953558 | 0.6153107 | 0.0000000 |
Model 2
Predictor: SDO
Mediators: (1) Solidarity; (2) Linked fate
Outcome: Support for policy
Bootstraps: 10,000
| label | est | se | ci.lower | ci.upper | pvalue |
|---|---|---|---|---|---|
| a1 | -0.3702653 | 0.0513388 | -0.4710089 | -0.2691111 | 0.0000000 |
| a2 | -0.3345283 | 0.0759475 | -0.4837594 | -0.1875865 | 0.0000106 |
| b1 | 0.3826801 | 0.1658324 | 0.0567526 | 0.7119175 | 0.0210197 |
| b2 | -0.0006574 | 0.1087325 | -0.2088248 | 0.2191441 | 0.9951756 |
| c_prime | -0.4860767 | 0.1299417 | -0.7375552 | -0.2310087 | 0.0001835 |
| ind1 | -0.1416932 | 0.0636768 | -0.2755325 | -0.0206888 | 0.0260683 |
| ind2 | 0.0002199 | 0.0372849 | -0.0749327 | 0.0768492 | 0.9952935 |
| ind_total | -0.1414732 | 0.0639187 | -0.2757907 | -0.0206766 | 0.0268749 |
| total | -0.6275500 | 0.1041748 | -0.8271062 | -0.4191315 | 0.0000000 |
Social dominance orientation
alpha = 0.89