Competitive Jungle Game — Pilot 2 Analysis
2026-06-23
library(qualtRics)
library(tidyverse)
library(psych)
library(scales)
library(ggplot2)
library(knitr)
library(kableExtra)
library(lme4)
library(lmerTest)
library(interactions) # for interact_plot()
library(mediation) # for mediation analysis1. Data Import & Cleaning
1.1 Load Data
# Read raw Qualtrics export (skip the two label/importId rows)
raw <- read_survey("~/Google drive/My Drive/YEAR 3/PROJECTS/DANIEL/Competitive Jungle/CWV x Game/pilot2_data.csv")
# Read exclusion list
exclusions <- read_csv("~/Downloads/Pilot 2 List of Exclusions (260623) - Sheet1.csv")
cat("Raw N =", nrow(raw), "\n")## Raw N = 218cat("Exclusions N =", nrow(exclusions), "\n")## Exclusions N = 431.2 Apply Exclusions
df <- raw %>%
filter(!participantId %in% exclusions$ID) %>%
filter(Finished == 1) %>%
filter(Q_RecaptchaScore > 0.5)
cat("N after exclusions =", nrow(df), "\n")## N after exclusions = 155cat("Condition split:\n")## Condition split:print(table(df$cond))##
## easy hard
## 79 761.3 Reverse-Score & Compute Composites
df <- df %>%
mutate(
# ── Condition ──────────────────────────────────────────────
cond = factor(cond, levels = c("easy", "hard")),
cond_num = if_else(cond == "hard", 1, 0), # hard = 1, easy = 0
# ── TIPI reverse scores ────────────────────────────────────
Extraversion_6R_r = 8 - Extraversion_6R,
Agreeable_2R_r = 8 - Agreeable_2R,
Conscientious_8R_r = 8 - Conscientious_8R,
EmoStability_4R_r = 8 - EmoStability_4R,
Open_10R_r = 8 - Open_10R,
# ── TIPI composites (each = mean of 2 items) ───────────────
tipi_extraversion = (Extraversion_1 + Extraversion_6R_r) / 2,
tipi_agreeableness = (Agreeable_7 + Agreeable_2R_r) / 2,
tipi_conscientiousness= (Conscientious_3 + Conscientious_8R_r) / 2,
tipi_emo_stability = (EmoStability_9 + EmoStability_4R_r) / 2,
tipi_openness = (Open_5 + Open_10R_r) / 2,
# ── CWV reverse scores & composite ────────────────────────
CWV_2R_r = 8 - CWV_2R,
CWV_5R_r = 8 - CWV_5R,
CWV_7R_r = 8 - CWV_7R,
CWV_9R_r = 8 - CWV_9R,
CWV_10R_r = 8 - CWV_10R,
cwv = rowMeans(
pick(CWV_1, CWV_2R_r, CWV_3, CWV_4, CWV_5R_r,
CWV_6, CWV_7R_r, CWV_8, CWV_9R_r, CWV_10R_r),
na.rm = TRUE
),
# ── Moral outrage composite ────────────────────────────────
moral_outrage = rowMeans(pick(outrage_1, outrage_2, outrage_3), na.rm = TRUE),
# ── Sympathy composite ─────────────────────────────────────
sympathy = rowMeans(pick(sympathy_1, sympathy_2, sympathy_3, sympathy_4), na.rm = TRUE),
# ── SDT subscales ──────────────────────────────────────────
sdt_autonomy = rowMeans(pick(autonomy_1, autonomy_2, autonomy_3), na.rm = TRUE),
sdt_competence = rowMeans(pick(competence_1, competence_2, competence_3), na.rm = TRUE),
sdt_relatedness = rowMeans(pick(relate_1, relate_2, relate_3), na.rm = TRUE),
# ── Perceived strength (reverse strength_2R) ───────────────
strength_2R_r = 8 - strength_2R,
perceived_strength = rowMeans(pick(strength_1, strength_2R_r), na.rm = TRUE),
# ── Perceived opponent unfairness composite ─────────────────
opponent_perception = rowMeans(
pick(opponent_1, opponent_2, opponent_3, opponent_4), na.rm = TRUE
),
# ── Aggression composite (behavioral) ─────────────────────
# stuns = aggressive acts toward opponents; raids = stealing
total_stuns = rowSums(
pick(Player_stuns_Attacker, Player_stuns_Thief, Player_stuns_Freerider),
na.rm = TRUE
),
total_aggression = total_stuns + Player_raids_hut,
# ── Recode demographics ────────────────────────────────────
gender_label = case_when(
gender == 1 ~ "Male",
gender == 2 ~ "Female",
gender == 3 ~ "Non-binary",
TRUE ~ "Other/NR"
),
game_freq_label = case_when(
game_frequency == 9 ~ "Never",
game_frequency == 10 ~ "< Once/month",
game_frequency == 11 ~ "Few times/month",
game_frequency == 12 ~ "Few times/week",
game_frequency == 13 ~ "Daily/almost daily",
TRUE ~ NA_character_
),
game_freq_label = factor(game_freq_label,
levels = c("Never","< Once/month","Few times/month",
"Few times/week","Daily/almost daily"))
)1.4 What does the distribution of aggression look like
# Distribution of total aggression
summary(df$total_aggression)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 5.000 9.000 9.897 13.000 45.000# Histogram
ggplot(df, aes(x = total_aggression)) +
geom_histogram(bins = 30, fill = "#5B8DB8", color = "white") +
labs(title = "Distribution of Total Aggression",
x = "Total Aggression (stuns + raids)", y = "Count") +
theme_minimal()
# By condition
ggplot(df, aes(x = total_aggression, fill = cond)) +
geom_histogram(bins = 30, alpha = 0.7, position = "identity") +
scale_fill_manual(values = c("easy" = "#5B8DB8", "hard" = "#E07B54"),
name = "Condition") +
facet_wrap(~cond) +
labs(title = "Distribution of Total Aggression by Condition",
x = "Total Aggression", y = "Count") +
theme_minimal()
# Check zero inflation
cat("Proportion of zeros:", round(mean(df$total_aggression == 0, na.rm = TRUE), 3), "\n")## Proportion of zeros: 0.097cat("Max value:", max(df$total_aggression, na.rm = TRUE), "\n")## Max value: 45cat("Mean:", round(mean(df$total_aggression, na.rm = TRUE), 2), "\n")## Mean: 9.9cat("Variance:", round(var(df$total_aggression, na.rm = TRUE), 2), "\n")## Variance: 63.87cat("Variance/Mean ratio:", round(var(df$total_aggression, na.rm = TRUE) /
mean(df$total_aggression, na.rm = TRUE), 2),
"(>1 suggests overdispersion)\n")## Variance/Mean ratio: 6.45 (>1 suggests overdispersion)# Log transform check (adding 1 to handle zeros)
df <- df %>% mutate(log_aggression = log(total_aggression + 1))
ggplot(df, aes(x = log_aggression)) +
geom_histogram(bins = 30, fill = "#6BAE75", color = "white") +
labs(title = "Distribution of Log(Total Aggression + 1)",
x = "Log Aggression", y = "Count") +
theme_minimal()
2. Demographics & Gaming Experience
2.1 Sample Overview
demo_summary <- df %>%
summarise(
N = n(),
Age_M = round(mean(age, na.rm = TRUE), 1),
Age_SD = round(sd(age, na.rm = TRUE), 1),
Age_Range = paste0(min(age, na.rm = TRUE), "–", max(age, na.rm = TRUE)),
Pct_Female = paste0(round(mean(gender == 2, na.rm = TRUE) * 100, 1), "%"),
Pct_Male = paste0(round(mean(gender == 1, na.rm = TRUE) * 100, 1), "%"),
Pct_NonBin = paste0(round(mean(gender == 3, na.rm = TRUE) * 100, 1), "%")
)
kable(demo_summary,
col.names = c("N","Age M","Age SD","Age Range",
"% Female","% Male","% Non-binary"),
caption = "Sample demographics") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)| N | Age M | Age SD | Age Range | % Female | % Male | % Non-binary |
|---|---|---|---|---|---|---|
| 155 | 41.7 | 12 | 20–73 | 43.9% | 54.2% | 1.9% |
2.2 Gender Distribution
df %>%
count(gender_label) %>%
mutate(pct = n / sum(n)) %>%
ggplot(aes(x = reorder(gender_label, -n), y = pct, fill = gender_label)) +
geom_col(show.legend = FALSE) +
geom_text(aes(label = paste0(n, "\n(", percent(pct, 1), ")")),
vjust = -0.3, size = 3.5) +
scale_y_continuous(labels = percent_format(), limits = c(0, .7)) +
scale_fill_brewer(palette = "Set2") +
labs(title = "Gender Distribution", x = NULL, y = "Proportion") +
theme_minimal()
2.3 Race/Ethnicity
race_labels <- c(
"1" = "White/Eur. Am.", "2" = "Black/Afr. Am.",
"3" = "E. Asian/Am.", "4" = "S. Asian/Am.",
"5" = "Latino/Hisp.", "6" = "Native Am.",
"7" = "Middle Eastern", "8" = "Biracial/Multi.",
"9" = "Other"
)
df %>%
mutate(race_label = race_labels[as.character(race)]) %>%
count(race_label) %>%
arrange(desc(n)) %>%
mutate(pct = percent(n / sum(n), 1)) %>%
kable(col.names = c("Race/Ethnicity", "N", "%"),
caption = "Race/ethnicity breakdown") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)| Race/Ethnicity | N | % |
|---|---|---|
| White/Eur. Am. | 110 | 71% |
| E. Asian/Am. | 16 | 10% |
| Black/Afr. Am. | 12 | 8% |
| NA | 9 | 6% |
| Latino/Hisp. | 4 | 3% |
| S. Asian/Am. | 4 | 3% |
2.4 Education & SES
edu_labels <- c(
"1" = "Some HS", "2" = "HS", "3" = "Some College",
"4" = "College", "5" = "Some Grad", "6" = "MA",
"7" = "PhD", "8" = "MD", "9" = "MBA",
"10" = "JD", "11" = "Other"
)
p_edu <- df %>%
mutate(edu_label = edu_labels[as.character(edu)]) %>%
count(edu_label) %>%
mutate(edu_label = fct_reorder(edu_label, n)) %>%
ggplot(aes(x = edu_label, y = n)) +
geom_col(fill = "#5B8DB8") +
coord_flip() +
labs(title = "Education", x = NULL, y = "N") +
theme_minimal()
ses_labels <- c(
"1" = "Upper", "2" = "Upper Middle", "3" = "Middle",
"4" = "Lower Middle", "5" = "Working", "6" = "Lower"
)
p_ses <- df %>%
mutate(ses_label = ses_labels[as.character(ses)]) %>%
count(ses_label) %>%
mutate(ses_label = fct_reorder(ses_label, n)) %>%
ggplot(aes(x = ses_label, y = n)) +
geom_col(fill = "#E07B54") +
coord_flip() +
labs(title = "Socioeconomic Status", x = NULL, y = "N") +
theme_minimal()
gridExtra::grid.arrange(p_edu, p_ses, ncol = 2)
2.5 Gaming Experience
p_freq <- df %>%
filter(!is.na(game_freq_label)) %>%
count(game_freq_label) %>%
ggplot(aes(x = game_freq_label, y = n, fill = game_freq_label)) +
geom_col(show.legend = FALSE) +
geom_text(aes(label = n), vjust = -0.3, size = 3.5) +
scale_fill_brewer(palette = "Blues", direction = 1) +
labs(title = "Gaming Frequency", x = NULL, y = "N") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 30, hjust = 1))
p_skill <- df %>%
count(skill_level) %>%
ggplot(aes(x = factor(skill_level), y = n)) +
geom_col(fill = "#6BAE75") +
scale_x_discrete(labels = c("Far below\navg","Below\navg","Slightly\nbelow","Average",
"Slightly\nabove","Above\navg","Far above\navg")) +
labs(title = "Self-Rated Skill Level", x = NULL, y = "N") +
theme_minimal()
gridExtra::grid.arrange(p_freq, p_skill, ncol = 2)
df %>%
summarise(
Genre_Exp_M = round(mean(genre_frequency, na.rm = TRUE), 2),
Genre_Exp_SD = round(sd(genre_frequency, na.rm = TRUE), 2),
Skill_M = round(mean(skill_level, na.rm = TRUE), 2),
Skill_SD = round(sd(skill_level, na.rm = TRUE), 2)
) %>%
kable(col.names = c("Genre Exp. M","Genre Exp. SD","Skill M","Skill SD"),
caption = "Gaming experience descriptives (1–7 scales)") %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE)| Genre Exp. M | Genre Exp. SD | Skill M | Skill SD |
|---|---|---|---|
| 3.74 | 1.76 | 4.02 | 1.6 |
3. Scale Reliability
alphas <- list(
"Moral Outrage" = df[, c("outrage_1", "outrage_2", "outrage_3")],
"Sympathy" = df[, c("sympathy_1", "sympathy_2", "sympathy_3", "sympathy_4")],
"CWV" = df[, c("CWV_1", "CWV_2R_r", "CWV_3", "CWV_4", "CWV_5R_r",
"CWV_6", "CWV_7R_r", "CWV_8", "CWV_9R_r", "CWV_10R_r")],
"SDT: Autonomy" = df[, c("autonomy_1", "autonomy_2", "autonomy_3")],
"SDT: Competence" = df[, c("competence_1", "competence_2", "competence_3")],
"SDT: Relatedness" = df[, c("relate_1", "relate_2", "relate_3")],
"Opponent Perception" = df[, c("opponent_1", "opponent_2", "opponent_3", "opponent_4")]
)
alpha_table <- map_dfr(alphas, function(items) {
a <- psych::alpha(items, warnings = FALSE)
tibble(alpha = round(a$total$raw_alpha, 3), n_items = ncol(items))
}, .id = "Scale")
kable(alpha_table,
col.names = c("Scale", "Cronbach's α", "N Items"),
caption = "Internal consistency of composites") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)| Scale | Cronbach’s α | N Items |
|---|---|---|
| Moral Outrage | 0.927 | 3 |
| Sympathy | 0.924 | 4 |
| CWV | 0.802 | 10 |
| SDT: Autonomy | 0.751 | 3 |
| SDT: Competence | 0.880 | 3 |
| SDT: Relatedness | 0.898 | 3 |
| Opponent Perception | 0.765 | 4 |
4. Descriptives by Condition
desc_vars <- c("moral_outrage", "sympathy", "cwv",
"sdt_autonomy", "sdt_competence", "sdt_relatedness",
"perceived_strength", "opponent_perception",
"Player_score", "total_aggression", "difficulty")
desc_table <- df %>%
group_by(cond) %>%
summarise(across(all_of(desc_vars),
list(M = ~round(mean(.x, na.rm = TRUE), 2),
SD = ~round(sd(.x, na.rm = TRUE), 2)),
.names = "{.col}_{.fn}")) %>%
pivot_longer(-cond, names_to = c("Variable", "stat"), names_sep = "_(?=[MS])") %>%
pivot_wider(names_from = c(cond, stat), values_from = value)
desc_table <- desc_table[, c("Variable", "easy_M", "easy_SD", "hard_M", "hard_SD")]
kable(desc_table,
col.names = c("Variable", "Easy M", "Easy SD", "Hard M", "Hard SD"),
caption = "Descriptive statistics by condition") %>%
kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)| Variable | Easy M | Easy SD | Hard M | Hard SD |
|---|---|---|---|---|
| moral_outrage | 2.76 | 1.72 | 4.46 | 1.97 |
| sympathy | 1.54 | 0.91 | 1.42 | 0.97 |
| cwv | 2.81 | 0.89 | 2.55 | 0.86 |
| sdt_autonomy | 4.57 | 1.37 | 3.56 | 1.69 |
| sdt_competence | 4.53 | 1.45 | 2.70 | 1.62 |
| sdt_relatedness | 3.06 | 1.64 | 2.12 | 1.48 |
| perceived_strength | 4.73 | 1.39 | 2.30 | 1.49 |
| opponent_perception | 3.71 | 1.30 | 4.88 | 1.32 |
| Player_score | 3.43 | 2.64 | 0.24 | 0.46 |
| total_aggression | 10.10 | 8.27 | 9.68 | 7.74 |
| difficulty | 4.33 | 1.71 | 6.34 | 1.23 |
5. Manipulation Checks
5.1 Perceived Difficulty
t_diff <- t.test(difficulty ~ cond, data = df)
print(t_diff)##
## Welch Two Sample t-test
##
## data: difficulty by cond
## t = -8.4498, df = 141.79, p-value = 3.164e-14
## alternative hypothesis: true difference in means between group easy and group hard is not equal to 0
## 95 percent confidence interval:
## -2.483933 -1.542049
## sample estimates:
## mean in group easy mean in group hard
## 4.329114 6.342105df %>%
group_by(cond) %>%
summarise(M = mean(difficulty, na.rm = TRUE),
SE = sd(difficulty, na.rm = TRUE) / sqrt(n())) %>%
ggplot(aes(x = cond, y = M, fill = cond)) +
geom_col(width = 0.5, show.legend = FALSE) +
geom_errorbar(aes(ymin = M - SE, ymax = M + SE), width = 0.15) +
scale_fill_manual(values = c("easy" = "#5B8DB8", "hard" = "#E07B54")) +
scale_y_continuous(limits = c(0, 7)) +
labs(title = "Perceived Difficulty by Condition",
x = "Condition", y = "Mean Difficulty (1–7)") +
theme_minimal()
5.2 Perceived Strength
t_str <- t.test(perceived_strength ~ cond, data = df)
print(t_str)##
## Welch Two Sample t-test
##
## data: perceived_strength by cond
## t = 10.465, df = 151.25, p-value < 2.2e-16
## alternative hypothesis: true difference in means between group easy and group hard is not equal to 0
## 95 percent confidence interval:
## 1.967340 2.883093
## sample estimates:
## mean in group easy mean in group hard
## 4.727848 2.3026325.3 Player Score
t_score <- t.test(Player_score ~ cond, data = df)
print(t_score)##
## Welch Two Sample t-test
##
## data: Player_score by cond
## t = 10.571, df = 82.858, p-value < 2.2e-16
## alternative hypothesis: true difference in means between group easy and group hard is not equal to 0
## 95 percent confidence interval:
## 2.592653 3.794422
## sample estimates:
## mean in group easy mean in group hard
## 3.4303797 0.23684216. Model 1: Condition → Emotion → Aggression (Moderated by CWV & TIPI)
6.1 Does Condition Predict Moral Outrage?
m1a <- lm(moral_outrage ~ cond, data = df)
summary(m1a)##
## Call:
## lm(formula = moral_outrage ~ cond, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.4605 -1.7637 -0.1272 1.5395 3.9030
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.7637 0.2074 13.324 < 2e-16 ***
## condhard 1.6968 0.2962 5.728 5.22e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.844 on 153 degrees of freedom
## Multiple R-squared: 0.1766, Adjusted R-squared: 0.1712
## F-statistic: 32.81 on 1 and 153 DF, p-value: 5.222e-08People in the hard condition felt more moral outrage.
6.2 Does Condition Predict Sympathy?
m1b <- lm(sympathy ~ cond, data = df)
summary(m1b)##
## Call:
## lm(formula = sympathy ~ cond, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.5411 -0.5411 -0.4211 0.2089 4.5789
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.5411 0.1056 14.599 <2e-16 ***
## condhard -0.1201 0.1508 -0.797 0.427
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.9383 on 153 degrees of freedom
## Multiple R-squared: 0.00413, Adjusted R-squared: -0.002379
## F-statistic: 0.6345 on 1 and 153 DF, p-value: 0.427Condition does not predict sympathy.
6.3 Visualize Emotion by Condition
df[, c("cond", "moral_outrage", "sympathy")] %>%
pivot_longer(c(moral_outrage, sympathy), names_to = "Emotion", values_to = "Score") %>%
mutate(Emotion = recode(Emotion,
"moral_outrage" = "Moral Outrage",
"sympathy" = "Sympathy")) %>%
group_by(cond, Emotion) %>%
summarise(M = mean(Score, na.rm = TRUE),
SE = sd(Score, na.rm = TRUE) / sqrt(n()), .groups = "drop") %>%
ggplot(aes(x = Emotion, y = M, fill = cond)) +
geom_col(position = position_dodge(0.6), width = 0.5) +
geom_errorbar(aes(ymin = M - SE, ymax = M + SE),
position = position_dodge(0.6), width = 0.2) +
scale_fill_manual(values = c("easy" = "#5B8DB8", "hard" = "#E07B54"),
name = "Condition") +
scale_y_continuous(limits = c(0, 7)) +
labs(title = "Moral Outrage and Sympathy by Condition",
x = NULL, y = "Mean (1–7)") +
theme_minimal()
6.4 Do Emotions Predict Aggression?
m1c <- lm(total_aggression ~ moral_outrage + sympathy + cond, data = df)
summary(m1c)##
## Call:
## lm(formula = total_aggression ~ moral_outrage + sympathy + cond,
## data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -11.440 -5.210 -1.441 2.926 34.759
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 13.0105 1.7413 7.472 5.93e-12 ***
## moral_outrage -0.3998 0.3504 -1.141 0.2558
## sympathy -1.1708 0.6886 -1.700 0.0911 .
## condhard 0.1207 1.4109 0.086 0.9319
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 7.966 on 151 degrees of freedom
## Multiple R-squared: 0.02589, Adjusted R-squared: 0.006533
## F-statistic: 1.338 on 3 and 151 DF, p-value: 0.2644m1c_2 <- lm(total_stuns ~ moral_outrage + sympathy + cond, data = df)
summary(m1c_2)##
## Call:
## lm(formula = total_stuns ~ moral_outrage + sympathy + cond, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -9.013 -4.266 -1.265 2.534 33.034
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 9.9788 1.4131 7.062 5.61e-11 ***
## moral_outrage -0.3491 0.2844 -1.227 0.222
## sympathy -0.6169 0.5588 -1.104 0.271
## condhard -1.5845 1.1450 -1.384 0.168
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 6.464 on 151 degrees of freedom
## Multiple R-squared: 0.04202, Adjusted R-squared: 0.02299
## F-statistic: 2.208 on 3 and 151 DF, p-value: 0.089546.5 CWV as Moderator of Condition → Moral Outrage
df <- df %>% mutate(cwv_c = scale(cwv, center = TRUE, scale = TRUE)[,1])
m1d <- lm(moral_outrage ~ cond * cwv_c, data = df)
summary(m1d)##
## Call:
## lm(formula = moral_outrage ~ cond * cwv_c, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.4773 -1.6232 0.0864 1.5571 4.0574
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.7461 0.2093 13.119 < 2e-16 ***
## condhard 1.6695 0.2992 5.581 1.08e-07 ***
## cwv_c 0.1231 0.2073 0.594 0.553
## condhard:cwv_c -0.4257 0.3004 -1.417 0.158
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.842 on 151 degrees of freedom
## Multiple R-squared: 0.1889, Adjusted R-squared: 0.1728
## F-statistic: 11.72 on 3 and 151 DF, p-value: 6.008e-07interact_plot(m1d,
pred = cond,
modx = cwv_c,
modx.values = c(-1, 0, 1),
modx.labels = c("Low CWV (-1 SD)", "Mean CWV", "High CWV (+1 SD)"),
x.label = "Condition (0 = Easy, 1 = Hard)",
y.label = "Moral Outrage",
main.title = "CWV × Condition Interaction on Moral Outrage",
legend.main = "CWV") +
theme_minimal()
The interaction is in the predicted direction — the negative coefficient means high CWV people show less outrage in hard mode compared to low CWV people, consistent with your theoretical model (“just the usual jungle”). However it doesn’t reach significance at p = .158.
6.6 CWV as Moderator of Condition → Sympathy
m1e <- lm(sympathy ~ cond * cwv_c, data = df)
summary(m1e)##
## Call:
## lm(formula = sympathy ~ cond * cwv_c, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.9899 -0.5414 -0.4043 0.2051 4.3201
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.541686 0.104674 14.728 <2e-16 ***
## condhard -0.075617 0.149594 -0.505 0.6140
## cwv_c -0.003832 0.103667 -0.037 0.9706
## condhard:cwv_c 0.307318 0.150213 2.046 0.0425 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.921 on 151 degrees of freedom
## Multiple R-squared: 0.05302, Adjusted R-squared: 0.0342
## F-statistic: 2.818 on 3 and 151 DF, p-value: 0.04107interact_plot(m1e,
pred = cond,
modx = cwv_c,
modx.values = c(-1, 0, 1),
modx.labels = c("Low CWV (-1 SD)", "Mean CWV", "High CWV (+1 SD)"),
x.label = "Condition (0 = Easy, 1 = Hard)",
y.label = "Sympathy",
main.title = "CWV × Condition Interaction on Sympathy",
legend.main = "CWV") +
theme_minimal()
Weird!!! The positive coefficient means high CWV people actually feel more sympathy in hard mode than low CWV people do. This is the opposite of what your model predicted. High CWV people in hard mode may be experiencing something more like competitive respect or admiration for the opponents beating them, which loads onto sympathy items.
6.7 CWV as Moderator of Condition → Aggression
m1f <- lm(total_aggression ~ cond * cwv_c, data = df)
summary(m1f)##
## Call:
## lm(formula = total_aggression ~ cond * cwv_c, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -12.748 -5.453 -0.869 3.471 32.252
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 10.3774 0.9030 11.492 <2e-16 ***
## condhard -0.7179 1.2905 -0.556 0.5789
## cwv_c -1.9348 0.8943 -2.164 0.0321 *
## condhard:cwv_c 1.7683 1.2958 1.365 0.1744
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 7.945 on 151 degrees of freedom
## Multiple R-squared: 0.03093, Adjusted R-squared: 0.01167
## F-statistic: 1.606 on 3 and 151 DF, p-value: 0.1903interact_plot(m1f,
pred = cond,
modx = cwv_c,
modx.values = c(-1, 0, 1),
modx.labels = c("Low CWV (-1 SD)", "Mean CWV", "High CWV (+1 SD)"),
x.label = "Condition (0 = Easy, 1 = Hard)",
y.label = "Total Aggression",
main.title = "CWV × Condition Interaction on Aggression",
legend.main = "CWV") +
theme_minimal()
m1f_2 <- lm(total_stuns ~ cond * cwv_c, data = df)
summary(m1f_2)##
## Call:
## lm(formula = total_stuns ~ cond * cwv_c, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -10.523 -4.226 -1.196 3.123 30.477
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 8.3199 0.7258 11.463 <2e-16 ***
## condhard -2.3358 1.0373 -2.252 0.0258 *
## cwv_c -1.7980 0.7188 -2.501 0.0134 *
## condhard:cwv_c 1.9568 1.0416 1.879 0.0622 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 6.386 on 151 degrees of freedom
## Multiple R-squared: 0.06502, Adjusted R-squared: 0.04644
## F-statistic: 3.5 on 3 and 151 DF, p-value: 0.01706interact_plot(m1f_2,
pred = cond,
modx = cwv_c,
modx.values = c(-1, 0, 1),
modx.labels = c("Low CWV (-1 SD)", "Mean CWV", "High CWV (+1 SD)"),
x.label = "Condition (0 = Easy, 1 = Hard)",
y.label = "Total Aggression",
main.title = "CWV × Condition Interaction on Aggression",
legend.main = "CWV") +
theme_minimal()
Stuns: This is trending toward significance and is in the predicted
direction. In easy mode high CWV people stun less, but in hard mode that
gap narrows or reverses. With more power this could reach
significance?
6.8 TIPI Agreeableness as Moderator
df <- df %>%
mutate(agree_c = scale(tipi_agreeableness, center = TRUE, scale = TRUE)[,1])
m1g <- lm(moral_outrage ~ cond * agree_c, data = df)
summary(m1g)##
## Call:
## lm(formula = moral_outrage ~ cond * agree_c, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.5868 -1.6096 -0.0758 1.5409 3.9685
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.75556 0.20918 13.173 < 2e-16 ***
## condhard 1.69718 0.29883 5.679 6.73e-08 ***
## agree_c -0.09964 0.20510 -0.486 0.628
## condhard:agree_c 0.19116 0.30042 0.636 0.526
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.853 on 151 degrees of freedom
## Multiple R-squared: 0.1788, Adjusted R-squared: 0.1625
## F-statistic: 10.96 on 3 and 151 DF, p-value: 1.487e-06m1h <- lm(sympathy ~ cond * agree_c, data = df)
summary(m1h)##
## Call:
## lm(formula = sympathy ~ cond * agree_c, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.7406 -0.4830 -0.4214 0.2084 4.5817
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.53683 0.10652 14.428 <2e-16 ***
## condhard -0.11637 0.15217 -0.765 0.446
## agree_c -0.05271 0.10444 -0.505 0.615
## condhard:agree_c 0.05968 0.15298 0.390 0.697
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.9437 on 151 degrees of freedom
## Multiple R-squared: 0.005832, Adjusted R-squared: -0.01392
## F-statistic: 0.2953 on 3 and 151 DF, p-value: 0.8288m1i <- lm(total_aggression ~ cond * agree_c, data = df)
summary(m1i)##
## Call:
## lm(formula = total_aggression ~ cond * agree_c, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -10.264 -5.117 -1.078 3.156 34.916
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 10.10743 0.91008 11.106 <2e-16 ***
## condhard -0.45900 1.30010 -0.353 0.725
## agree_c 0.07535 0.89232 0.084 0.933
## condhard:agree_c 0.34521 1.30704 0.264 0.792
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.063 on 151 degrees of freedom
## Multiple R-squared: 0.002014, Adjusted R-squared: -0.01781
## F-statistic: 0.1016 on 3 and 151 DF, p-value: 0.9596.9 Mediation: Condition → Moral Outrage → Stuns
med_out <- mediate(
model.m = lm(moral_outrage ~ cond + cwv_c, data = df),
model.y = lm(total_stuns ~ moral_outrage + cond + cwv_c, data = df),
treat = "cond",
mediator = "moral_outrage",
boot = TRUE,
sims = 500
)summary(med_out)##
## Causal Mediation Analysis
##
## Nonparametric Bootstrap Confidence Intervals with the Percentile Method
##
## Estimate 95% CI Lower 95% CI Upper p-value
## ACME -0.57661 -1.57051 0.23667 0.204
## ADE -1.77818 -4.21952 0.51835 0.172
## Total Effect -2.35479 -4.39228 -0.19533 0.020 *
## Prop. Mediated 0.24487 -0.16914 2.23977 0.216
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Sample Size Used: 155
##
##
## Simulations: 500The mediation story isn’t working for stuns, and there’s a logical reason why — moral outrage goes up in hard mode (condition → outrage is positive and strong) but stuns go down in hard mode (due to mechanics). So outrage and stuns are moving in opposite directions across conditions, making outrage a poor mediator of that particular path.
6.10 Mediation: Condition → Sympathy → Stuns
med_sym <- mediate(
model.m = lm(sympathy ~ cond + cwv_c, data = df),
model.y = lm(total_stuns ~ sympathy + cond + cwv_c, data = df),
treat = "cond",
mediator = "sympathy",
boot = TRUE,
sims = 500
)summary(med_sym)##
## Causal Mediation Analysis
##
## Nonparametric Bootstrap Confidence Intervals with the Percentile Method
##
## Estimate 95% CI Lower 95% CI Upper p-value
## ACME 0.034088 -0.285096 0.279716 0.980
## ADE -2.388873 -4.676681 -0.377220 0.020 *
## Total Effect -2.354785 -4.676972 -0.305883 0.028 *
## Prop. Mediated -0.014476 -0.300637 0.163272 0.992
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Sample Size Used: 155
##
##
## Simulations: 500The stun outcome is conflating motivation and opportunity in a way that makes mediation through emotional states implausible.
7. Model 2: Score & Perceptions → SDT Facets
This model examines how objective performance (score) and subjective opponent perceptions predict the three SDT needs — autonomy, competence, and relatedness.
7.1 Predictors of SDT Competence
m2a <- lm(sdt_competence ~ Player_score + opponent_perception + cond,
data = df)
summary(m2a)##
## Call:
## lm(formula = sdt_competence ~ Player_score + opponent_perception +
## cond, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.7389 -1.3338 0.0259 1.0856 4.2033
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.36936 0.44109 9.906 < 2e-16 ***
## Player_score 0.15413 0.06400 2.408 0.017239 *
## opponent_perception -0.09881 0.09356 -1.056 0.292606
## condhard -1.22682 0.33752 -3.635 0.000381 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.516 on 151 degrees of freedom
## Multiple R-squared: 0.2962, Adjusted R-squared: 0.2822
## F-statistic: 21.18 on 3 and 151 DF, p-value: 1.662e-117.2 Predictors of SDT Autonomy
m2b <- lm(sdt_autonomy ~ Player_score + opponent_perception + cond,
data = df)
summary(m2b)##
## Call:
## lm(formula = sdt_autonomy ~ Player_score + opponent_perception +
## cond, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.7992 -1.1573 -0.0419 1.0478 3.4548
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.83697 0.44336 10.910 <2e-16 ***
## Player_score 0.08606 0.06433 1.338 0.183
## opponent_perception -0.15282 0.09404 -1.625 0.106
## condhard -0.55532 0.33925 -1.637 0.104
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.524 on 151 degrees of freedom
## Multiple R-squared: 0.1237, Adjusted R-squared: 0.1063
## F-statistic: 7.103 on 3 and 151 DF, p-value: 0.00016987.4 SDT Facets by Condition
df[, c("cond", "sdt_autonomy", "sdt_competence", "sdt_relatedness")] %>%
pivot_longer(-cond, names_to = "Facet", values_to = "Score") %>%
mutate(Facet = recode(Facet,
"sdt_autonomy" = "Autonomy",
"sdt_competence" = "Competence",
"sdt_relatedness" = "Relatedness")) %>%
group_by(cond, Facet) %>%
summarise(M = mean(Score, na.rm = TRUE),
SE = sd(Score, na.rm = TRUE) / sqrt(n()), .groups = "drop") %>%
ggplot(aes(x = Facet, y = M, fill = cond)) +
geom_col(position = position_dodge(0.6), width = 0.5) +
geom_errorbar(aes(ymin = M - SE, ymax = M + SE),
position = position_dodge(0.6), width = 0.2) +
scale_fill_manual(values = c("easy" = "#5B8DB8", "hard" = "#E07B54"),
name = "Condition") +
scale_y_continuous(limits = c(0, 7)) +
labs(title = "SDT Facets by Condition",
x = NULL, y = "Mean (1–7)") +
theme_minimal()
7.5 Score Predicts Competence & Autonomy (Scatter)
df[, c("Player_score", "sdt_competence", "sdt_autonomy", "cond")] %>%
pivot_longer(c(sdt_competence, sdt_autonomy),
names_to = "Facet", values_to = "Score") %>%
mutate(Facet = recode(Facet,
"sdt_competence" = "Competence",
"sdt_autonomy" = "Autonomy")) %>%
ggplot(aes(x = Player_score, y = Score, color = cond)) +
geom_point(alpha = 0.4) +
geom_smooth(method = "lm", se = TRUE) +
scale_color_manual(values = c("easy" = "#5B8DB8", "hard" = "#E07B54"),
name = "Condition") +
facet_wrap(~Facet) +
labs(title = "Player Score → SDT Facets",
x = "Player Score", y = "SDT Facet (1–7)") +
theme_minimal()
7.6 Openness as Moderator of Social Signal → Relatedness
df <- df %>%
mutate(open_c = scale(tipi_openness, center = TRUE, scale = TRUE)[,1])
m2d <- lm(sdt_relatedness ~ opponent_perception * open_c + cond,
data = df)
summary(m2d)##
## Call:
## lm(formula = sdt_relatedness ~ opponent_perception * open_c +
## cond, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.4943 -1.0866 -0.3874 0.9277 3.7973
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.01973 0.39252 10.241 < 2e-16 ***
## opponent_perception -0.25895 0.09506 -2.724 0.00722 **
## open_c 0.30614 0.39175 0.781 0.43576
## condhard -0.64014 0.27162 -2.357 0.01973 *
## opponent_perception:open_c -0.06990 0.08328 -0.839 0.40265
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.538 on 150 degrees of freedom
## Multiple R-squared: 0.1306, Adjusted R-squared: 0.1074
## F-statistic: 5.631 on 4 and 150 DF, p-value: 0.0002993interact_plot(m2d,
pred = opponent_perception,
modx = open_c,
modx.values = c(-1, 0, 1),
modx.labels = c("Low Openness (-1 SD)", "Mean Openness", "High Openness (+1 SD)"),
x.label = "Opponent Perception (unfairness)",
y.label = "Relatedness",
main.title = "Openness × Opponent Perception on Relatedness",
legend.main = "Openness") +
theme_minimal()
8. Correlations
cor_vars <- df[, c("moral_outrage", "sympathy", "cwv", "tipi_agreeableness",
"sdt_autonomy", "sdt_competence", "sdt_relatedness",
"Player_score", "total_stuns", "opponent_perception",
"perceived_strength", "difficulty")]
names(cor_vars) <- c("Moral Outrage", "Sympathy", "CWV", "Agreeableness",
"Autonomy", "Competence", "Relatedness",
"Score", "Stuns", "Opp. Perception",
"Perc. Strength", "Difficulty")
cor_matrix <- cor(cor_vars, use = "pairwise.complete.obs")
cor_matrix %>%
round(2) %>%
kable(caption = "Pairwise correlations among key variables") %>%
kable_styling(bootstrap_options = c("striped", "condensed"),
font_size = 11, full_width = TRUE) %>%
scroll_box(width = "100%")| Moral Outrage | Sympathy | CWV | Agreeableness | Autonomy | Competence | Relatedness | Score | Stuns | Opp. Perception | Perc. Strength | Difficulty | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Moral Outrage | 1.00 | -0.10 | -0.10 | 0.03 | -0.25 | -0.28 | -0.26 | -0.36 | -0.15 | 0.76 | -0.37 | 0.37 |
| Sympathy | -0.10 | 1.00 | 0.16 | -0.03 | 0.09 | 0.21 | 0.40 | 0.01 | -0.07 | -0.18 | 0.14 | 0.01 |
| CWV | -0.10 | 0.16 | 1.00 | -0.24 | 0.14 | 0.13 | 0.21 | 0.07 | -0.11 | -0.09 | 0.19 | -0.06 |
| Agreeableness | 0.03 | -0.03 | -0.24 | 1.00 | 0.02 | 0.12 | 0.00 | -0.26 | 0.02 | -0.14 | -0.03 | 0.14 |
| Autonomy | -0.25 | 0.09 | 0.14 | 0.02 | 1.00 | 0.64 | 0.44 | 0.28 | -0.16 | -0.24 | 0.47 | -0.39 |
| Competence | -0.28 | 0.21 | 0.13 | 0.12 | 0.64 | 1.00 | 0.55 | 0.46 | 0.05 | -0.27 | 0.67 | -0.53 |
| Relatedness | -0.26 | 0.40 | 0.21 | 0.00 | 0.44 | 0.55 | 1.00 | 0.15 | -0.10 | -0.31 | 0.39 | -0.30 |
| Score | -0.36 | 0.01 | 0.07 | -0.26 | 0.28 | 0.46 | 0.15 | 1.00 | 0.26 | -0.25 | 0.56 | -0.67 |
| Stuns | -0.15 | -0.07 | -0.11 | 0.02 | -0.16 | 0.05 | -0.10 | 0.26 | 1.00 | -0.08 | 0.13 | -0.23 |
| Opp. Perception | 0.76 | -0.18 | -0.09 | -0.14 | -0.24 | -0.27 | -0.31 | -0.25 | -0.08 | 1.00 | -0.45 | 0.35 |
| Perc. Strength | -0.37 | 0.14 | 0.19 | -0.03 | 0.47 | 0.67 | 0.39 | 0.56 | 0.13 | -0.45 | 1.00 | -0.67 |
| Difficulty | 0.37 | 0.01 | -0.06 | 0.14 | -0.39 | -0.53 | -0.30 | -0.67 | -0.23 | 0.35 | -0.67 | 1.00 |
9. Session Info
sessionInfo()## R version 4.6.0 (2026-04-24)
## Platform: aarch64-apple-darwin23
## Running under: macOS Ventura 13.3
##
## Matrix products: default
## BLAS: /Library/Frameworks/R.framework/Versions/4.6/Resources/lib/libRblas.0.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/4.6/Resources/lib/libRlapack.dylib; LAPACK version 3.12.1
##
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
##
## time zone: America/New_York
## tzcode source: internal
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] mediation_4.5.1 sandwich_3.1-1 mvtnorm_1.4-1 MASS_7.3-65
## [5] interactions_1.2.0 lmerTest_3.2-1 lme4_2.0-1 Matrix_1.7-5
## [9] kableExtra_1.4.0 knitr_1.51 scales_1.4.0 psych_2.6.5
## [13] lubridate_1.9.5 forcats_1.0.1 stringr_1.6.0 dplyr_1.2.1
## [17] purrr_1.2.2 readr_2.2.0 tidyr_1.3.2 tibble_3.3.1
## [21] ggplot2_4.0.3 tidyverse_2.0.0 qualtRics_3.2.2
##
## loaded via a namespace (and not attached):
## [1] Rdpack_2.6.6 mnormt_2.1.2 gridExtra_2.3
## [4] rlang_1.2.0 magrittr_2.0.5 furrr_0.4.0
## [7] otel_0.2.0 compiler_4.6.0 mgcv_1.9-4
## [10] systemfonts_1.3.2 vctrs_0.7.3 crayon_1.5.3
## [13] pkgconfig_2.0.3 fastmap_1.2.0 backports_1.5.1
## [16] labeling_0.4.3 pander_0.6.6 rmarkdown_2.31
## [19] tzdb_0.5.0 nloptr_2.2.1 bit_4.6.0
## [22] xfun_0.58 cachem_1.1.0 jsonlite_2.0.0
## [25] broom_1.0.13 parallel_4.6.0 cluster_2.1.8.2
## [28] R6_2.6.1 bslib_0.11.0 stringi_1.8.7
## [31] RColorBrewer_1.1-3 parallelly_1.47.0 boot_1.3-32
## [34] rpart_4.1.27 jquerylib_0.1.4 numDeriv_2016.8-1.1
## [37] Rcpp_1.1.1-1.1 zoo_1.8-15 base64enc_0.1-6
## [40] splines_4.6.0 nnet_7.3-20 timechange_0.4.0
## [43] tidyselect_1.2.1 rstudioapi_0.19.0 yaml_2.3.12
## [46] codetools_0.2-20 sjlabelled_1.2.0 listenv_0.10.1
## [49] lattice_0.22-9 withr_3.0.2 S7_0.2.2
## [52] evaluate_1.0.5 foreign_0.8-91 future_1.70.0
## [55] xml2_1.5.2 lpSolve_5.6.23 jtools_2.3.1
## [58] pillar_1.11.1 checkmate_2.3.4 reformulas_0.4.4
## [61] insight_1.5.1 generics_0.1.4 vroom_1.7.1
## [64] hms_1.1.4 minqa_1.2.8 globals_0.19.1
## [67] glue_1.8.1 Hmisc_5.2-6 tools_4.6.0
## [70] data.table_1.18.4 grid_4.6.0 rbibutils_2.4.1
## [73] colorspace_2.1-2 nlme_3.1-169 htmlTable_2.5.0
## [76] Formula_1.2-5 cli_3.6.6 textshaping_1.0.5
## [79] viridisLite_0.4.3 svglite_2.2.2 gtable_0.3.6
## [82] broom.mixed_0.2.9.7 sass_0.4.10 digest_0.6.39
## [85] htmlwidgets_1.6.4 farver_2.1.2 htmltools_0.5.9
## [88] lifecycle_1.0.5 bit64_4.8.2