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 analysis
# 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/pilot3_data.csv")
# Read exclusion list
exclusions <- read_csv("~/Downloads/Pilot 3 List of Exclusions (260628) - Sheet1.csv")
cat("Raw N =", nrow(raw), "\n")
## Raw N = 218
cat("Exclusions N =", nrow(exclusions), "\n")
## Exclusions N = 28
## Note: there are a lot of exclusions. People wrote in free response that they did not understand the game, many players made no moves, and some left the game early. All were excluded.
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 = 171
cat("Condition split:\n")
## Condition split:
print(table(df$cond))
##
## easy hard
## 83 88
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),
# ── Surprised & Disappointed (new single items) ───────────
# (used as exploratory alternatives to moral outrage)
# ── Empathy composite (replaces old sympathy scale) ────────
empathy = rowMeans(pick(empathy_1, empathy_2, empathy_3,
empathy_4, empathy_5), na.rm = TRUE),
# ── Schadenfreude composite ────────────────────────────────
schadenfreude = rowMeans(pick(schadenfreude_1, schadenfreude_2,
schadenfreude_3, schadenfreude_4), na.rm = TRUE),
# ── GP-5 composite ────────────────────────────────────────
gp = rowMeans(pick(GP_1, GP_2, GP_3, GP_4, GP_5), na.rm = TRUE),
# ── Subjective behavioral intent composite ─────────────────
intent_aggression = rowMeans(pick(intent_steal, intent_stun), na.rm = TRUE),
# ── Future behavioral intent composite ─────────────────────
future_aggression = rowMeans(pick(future_steal, future_stun), na.rm = TRUE),
# ── Future mode preference (easy = 1 hard = 2 no pref = 3)
# Coded separately per condition via Qualtrics branching
# Combine into single variable
future_mode = case_when(
!is.na(future_easy) ~ future_easy,
!is.na(future_hard) ~ future_hard,
TRUE ~ NA_real_
),
future_mode_label = case_when(
future_mode == 1 ~ "Same mode",
future_mode == 2 ~ "Other mode",
future_mode == 3 ~ "No preference",
TRUE ~ NA_character_
),
# ── People or bot manipulation check ──────────────────────
# 1 = Definitely real people, 2 = Probably real, 3 = Unsure
# 4 = Probably computer, 5 = Definitely computer
people_or_bot_label = case_when(
people_or_bot == 1 ~ "Definitely real",
people_or_bot == 2 ~ "Probably real",
people_or_bot == 3 ~ "Unsure",
people_or_bot == 4 ~ "Probably computer",
people_or_bot == 5 ~ "Definitely computer",
TRUE ~ NA_character_
),
believed_real = people_or_bot <= 2, # TRUE if thought real people
# ── 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 == 1 ~ "Never",
game_frequency == 2 ~ "< Once/month",
game_frequency == 3 ~ "Few times/month",
game_frequency == 4 ~ "Few times/week",
game_frequency == 5 ~ "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"))
)
# Distribution of total aggression
summary(df$total_aggression)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 4.000 8.000 9.591 13.000 28.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.023
cat("Max value:", max(df$total_aggression, na.rm = TRUE), "\n")
## Max value: 28
cat("Mean:", round(mean(df$total_aggression, na.rm = TRUE), 2), "\n")
## Mean: 9.59
cat("Variance:", round(var(df$total_aggression, na.rm = TRUE), 2), "\n")
## Variance: 42.56
cat("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: 4.44 (>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()
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 |
|---|---|---|---|---|---|---|
| 171 | 46 | 12.6 | 19–78 | 50.3% | 46.8% | 2.3% |
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()
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. | 133 | 78% |
| Black/Afr. Am. | 13 | 8% |
| E. Asian/Am. | 10 | 6% |
| NA | 8 | 5% |
| Latino/Hisp. | 5 | 3% |
| Biracial/Multi. | 1 | 1% |
| Other | 1 | 1% |
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)
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.52 | 1.72 | 3.67 | 1.76 |
alphas <- list(
"Moral Outrage" = df[, c("outrage_1", "outrage_2", "outrage_3")],
"Empathy" = df[, c("empathy_1", "empathy_2", "empathy_3", "empathy_4", "empathy_5")],
"Schadenfreude" = df[, c("schadenfreude_1", "schadenfreude_2", "schadenfreude_3", "schadenfreude_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")],
"GP-5" = df[, c("GP_1", "GP_2", "GP_3", "GP_4", "GP_5")]
)
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.914 | 3 |
| Empathy | 0.693 | 5 |
| Schadenfreude | 0.913 | 4 |
| CWV | 0.807 | 10 |
| SDT: Autonomy | 0.736 | 3 |
| SDT: Competence | 0.861 | 3 |
| SDT: Relatedness | 0.870 | 3 |
| Opponent Perception | 0.826 | 4 |
| GP-5 | 0.785 | 5 |
desc_vars <- c("moral_outrage", "surprised", "disappointed",
"empathy", "schadenfreude", "cwv", "gp",
"sdt_autonomy", "sdt_competence", "sdt_relatedness",
"perceived_strength", "opponent_perception",
"Player_score", "total_stuns", "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 | 3.15 | 1.91 | 3.97 | 2.02 |
| surprised | 2.61 | 1.86 | 3.39 | 2.04 |
| disappointed | 3.05 | 1.99 | 4.12 | 2.13 |
| empathy | 1.72 | 1.02 | 1.92 | 0.94 |
| schadenfreude | 2.31 | 1.59 | 1.25 | 0.57 |
| cwv | 2.46 | 0.87 | 2.48 | 0.86 |
| gp | 4.05 | 0.83 | 4.03 | 0.74 |
| sdt_autonomy | 3.91 | 1.53 | 3.29 | 1.56 |
| sdt_competence | 3.78 | 1.65 | 2.30 | 1.46 |
| sdt_relatedness | 2.29 | 1.56 | 1.82 | 1.00 |
| perceived_strength | 3.90 | 1.77 | 1.98 | 1.24 |
| opponent_perception | 3.90 | 1.56 | 4.73 | 1.37 |
| Player_score | 2.99 | 2.72 | 0.22 | 0.49 |
| total_stuns | 6.57 | 5.73 | 6.67 | 5.28 |
| difficulty | 4.71 | 1.77 | 6.56 | 0.76 |
df %>%
ggplot(aes(x = cwv)) +
geom_histogram(bins = 20, fill = "#5B8DB8", color = "white") +
geom_vline(xintercept = mean(df$cwv, na.rm = TRUE),
linetype = "dashed", color = "#E07B54", linewidth = 0.8) +
annotate("text",
x = mean(df$cwv, na.rm = TRUE) + 0.15,
y = Inf, vjust = 1.5,
label = paste0("M = ", round(mean(df$cwv, na.rm = TRUE), 2)),
color = "#E07B54", size = 3.5) +
labs(title = "Distribution of CWV",
x = "CWV (1–7)", y = "Count") +
theme_minimal()
df %>%
group_by(cond) %>%
summarise(M = round(mean(cwv, na.rm = TRUE), 2),
SD = round(sd(cwv, na.rm = TRUE), 2),
Min = round(min(cwv, na.rm = TRUE), 2),
Max = round(max(cwv, na.rm = TRUE), 2)) %>%
kable(col.names = c("Condition", "M", "SD", "Min", "Max"),
caption = "CWV by condition") %>%
kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)
| Condition | M | SD | Min | Max |
|---|---|---|---|---|
| easy | 2.46 | 0.87 | 1.2 | 4.9 |
| hard | 2.48 | 0.86 | 1.0 | 5.1 |
# Check CWV is balanced across conditions
t.test(cwv ~ cond, data = df)
##
## Welch Two Sample t-test
##
## data: cwv by cond
## t = -0.14515, df = 168.14, p-value = 0.8848
## alternative hypothesis: true difference in means between group easy and group hard is not equal to 0
## 95 percent confidence interval:
## -0.2798654 0.2415302
## sample estimates:
## mean in group easy mean in group hard
## 2.462651 2.481818
No difference in CWV by condition
t_diff <- t.test(difficulty ~ cond, data = df)
print(t_diff)
##
## Welch Two Sample t-test
##
## data: difficulty by cond
## t = -8.7741, df = 109.57, p-value = 2.549e-14
## alternative hypothesis: true difference in means between group easy and group hard is not equal to 0
## 95 percent confidence interval:
## -2.262934 -1.429016
## sample estimates:
## mean in group easy mean in group hard
## 4.710843 6.556818
df %>%
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()
Again, people in the hard condition saw it as significantly more difficult.
t_str <- t.test(perceived_strength ~ cond, data = df)
print(t_str)
##
## Welch Two Sample t-test
##
## data: perceived_strength by cond
## t = 8.1818, df = 146.34, p-value = 1.241e-13
## alternative hypothesis: true difference in means between group easy and group hard is not equal to 0
## 95 percent confidence interval:
## 1.456729 2.384591
## sample estimates:
## mean in group easy mean in group hard
## 3.903614 1.982955
Peple felt they were less strong in the hard condition, as expected.
t_score <- t.test(Player_score ~ cond, data = df)
print(t_score)
##
## Welch Two Sample t-test
##
## data: Player_score by cond
## t = 9.1434, df = 87.019, p-value = 2.279e-14
## alternative hypothesis: true difference in means between group easy and group hard is not equal to 0
## 95 percent confidence interval:
## 2.169456 3.374630
## sample estimates:
## mean in group easy mean in group hard
## 2.9879518 0.2159091
Players scored significantly higher in easy mode
m1a <- lm(moral_outrage ~ cond, data = df)
summary(m1a)
##
## Call:
## lm(formula = moral_outrage ~ cond, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.9697 -1.9697 -0.1526 1.6970 3.8474
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.1526 0.2158 14.608 < 2e-16 ***
## condhard 0.8171 0.3008 2.716 0.00729 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.966 on 169 degrees of freedom
## Multiple R-squared: 0.04182, Adjusted R-squared: 0.03615
## F-statistic: 7.377 on 1 and 169 DF, p-value: 0.007294
People in the hard condition felt more moral outrage.
m1b_emp <- lm(empathy ~ cond, data = df)
summary(m1b_emp)
##
## Call:
## lm(formula = empathy ~ cond, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.9205 -0.7181 -0.3205 0.4819 5.0819
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.7181 0.1078 15.938 <2e-16 ***
## condhard 0.2024 0.1503 1.347 0.18
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.9821 on 169 degrees of freedom
## Multiple R-squared: 0.01062, Adjusted R-squared: 0.004764
## F-statistic: 1.814 on 1 and 169 DF, p-value: 0.1799
People in easy condition did not feel more empathy emotions for the other players.
m1b_sch <- lm(schadenfreude ~ cond, data = df)
summary(m1b_sch)
##
## Call:
## lm(formula = schadenfreude ~ cond, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.3072 -0.5572 -0.2528 0.1928 4.6928
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.3072 0.1299 17.760 < 2e-16 ***
## condhard -1.0544 0.1811 -5.822 2.85e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.184 on 169 degrees of freedom
## Multiple R-squared: 0.1671, Adjusted R-squared: 0.1622
## F-statistic: 33.9 on 1 and 169 DF, p-value: 2.852e-08
People in the hard condition felt significantly less schadenfreude. Being overpowered generates schadenfreude — you enjoy the opponents’ struggle. Interesting!
df[, c("cond", "moral_outrage", "empathy", "schadenfreude", "surprised", "disappointed")] %>%
pivot_longer(c(moral_outrage, empathy, schadenfreude, surprised, disappointed),
names_to = "Emotion", values_to = "Score") %>%
mutate(Emotion = recode(Emotion,
"moral_outrage" = "Moral Outrage",
"empathy" = "Empathy",
"schadenfreude" = "Schadenfreude",
"surprised" = "Surprised",
"disappointed" = "Disappointed")) %>%
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()
Hard mode players felt more moral outrage, disappointment, and surprise, while easy mode players felt more schadenfreude — suggesting that being underpowered generates feelings of injustice and violated expectations, while being overpowered generates pleasure at opponents’ disadvantage. Empathy was low and relatively stable across both conditions, indicating it is unlikely to function as a meaningful mediator in this paradigm.
m1c <- lm(total_stuns ~ moral_outrage + empathy + schadenfreude + cond, data = df)
summary(m1c)
##
## Call:
## lm(formula = total_stuns ~ moral_outrage + empathy + schadenfreude +
## cond, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -7.0333 -3.9164 -0.9265 2.5702 18.1099
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.90823 1.29251 4.571 9.44e-06 ***
## moral_outrage -0.05001 0.23857 -0.210 0.8342
## empathy -0.40144 0.49074 -0.818 0.4145
## schadenfreude 0.65247 0.37576 1.736 0.0843 .
## condhard 0.91425 0.94223 0.970 0.3333
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 5.494 on 166 degrees of freedom
## Multiple R-squared: 0.02174, Adjusted R-squared: -0.00183
## F-statistic: 0.9224 on 4 and 166 DF, p-value: 0.4524
None of the emotional measures predicted actual stun behavior.
m1c_intent <- lm(intent_aggression ~ moral_outrage + empathy + schadenfreude + cond, data = df)
summary(m1c_intent)
##
## Call:
## lm(formula = intent_aggression ~ moral_outrage + empathy + schadenfreude +
## cond, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.1068 -1.0935 -0.0498 0.9299 3.4502
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.10087 0.34565 8.971 6.03e-16 ***
## moral_outrage 0.04780 0.06380 0.749 0.454836
## empathy 0.02440 0.13124 0.186 0.852746
## schadenfreude 0.37672 0.10049 3.749 0.000245 ***
## condhard -0.06511 0.25198 -0.258 0.796418
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.469 on 166 degrees of freedom
## Multiple R-squared: 0.1064, Adjusted R-squared: 0.08486
## F-statistic: 4.941 on 4 and 166 DF, p-value: 0.0008664
Schadenfreude was the only significant predictor of intent to aggress (stun and steal) (b = 0.38, p < .001), suggesting that the desire to harm opponents is driven not by outrage at perceived injustice but by the pleasure taken in their disadvantage?
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.2417 -1.8913 -0.1473 1.6860 3.8510
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.152505 0.216923 14.533 < 2e-16 ***
## condhard 0.815938 0.302385 2.698 0.00768 **
## cwv_c -0.009185 0.216182 -0.042 0.96616
## condhard:cwv_c 0.125113 0.303187 0.413 0.68039
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.976 on 167 degrees of freedom
## Multiple R-squared: 0.04354, Adjusted R-squared: 0.02636
## F-statistic: 2.534 on 3 and 167 DF, p-value: 0.0587
interact_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 prediction that high CWV people would feel less outrage when losing (“just the usual jungle”) is not supported across two pilots now. The Pilot 2 interaction was in the predicted direction but non-significant (p = .158), and here it’s essentially flat (p = .680). That’s a fairly consistent null across two independent samples.
m1e_emp <- lm(empathy ~ cond * cwv_c, data = df)
summary(m1e_emp)
##
## Call:
## lm(formula = empathy ~ cond * cwv_c, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.1404 -0.7205 -0.3724 0.4927 4.9823
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.71871 0.10821 15.883 <2e-16 ***
## condhard 0.20096 0.15085 1.332 0.185
## cwv_c 0.05573 0.10784 0.517 0.606
## condhard:cwv_c 0.01654 0.15125 0.109 0.913
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.9858 on 167 degrees of freedom
## Multiple R-squared: 0.01493, Adjusted R-squared: -0.002762
## F-statistic: 0.8439 on 3 and 167 DF, p-value: 0.4716
interact_plot(m1e_emp,
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", y.label = "Empathy",
main.title = "CWV × Condition on Empathy",
legend.main = "CWV") + theme_minimal()
Empathy is simply not sensitive to either the power manipulation or competitive worldview, and should probably be dropped as a mediator in our model. It is essentially a flat construct in this paradigm regardless of who is winning or losing or how competitive their worldview is.
m1e_sch <- lm(schadenfreude ~ cond * cwv_c, data = df)
summary(m1e_sch)
##
## Call:
## lm(formula = schadenfreude ~ cond * cwv_c, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.9026 -0.4151 -0.2483 0.1178 5.0808
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.3103 0.1291 17.900 < 2e-16 ***
## condhard -1.0576 0.1799 -5.878 2.2e-08 ***
## cwv_c 0.2644 0.1286 2.055 0.0414 *
## condhard:cwv_c -0.2505 0.1804 -1.389 0.1668
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.176 on 167 degrees of freedom
## Multiple R-squared: 0.1877, Adjusted R-squared: 0.1731
## F-statistic: 12.86 on 3 and 167 DF, p-value: 1.333e-07
interact_plot(m1e_sch,
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", y.label = "Schadenfreude",
main.title = "CWV × Condition on Schadenfreude",
legend.main = "CWV") + theme_minimal()
High CWV people feel more schadenfreude overall and show a trending interaction suggesting they particularly enjoy opponents’ disadvantage when overpowered, though the interaction would require a larger sample to confirm.
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
## -11.0229 -4.8462 -0.7968 3.9419 19.1880
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 8.80648 0.71350 12.343 <2e-16 ***
## condhard 1.51263 0.99461 1.521 0.130
## cwv_c -0.06535 0.71107 -0.092 0.927
## condhard:cwv_c 1.03019 0.99724 1.033 0.303
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 6.5 on 167 degrees of freedom
## Multiple R-squared: 0.02485, Adjusted R-squared: 0.007331
## F-statistic: 1.419 on 3 and 167 DF, p-value: 0.2392
interact_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()
A consistent null across all three terms — condition, CWV, and their interaction all fail to predict total aggression, with a non-significant overall model (R² = .025, p = .239). This replicates Pilot 2 and definitively confirms that actual behavioral aggression is not the right outcome variable for this paradigm — the mechanical confounds are too strong and the variance too noisy for emotional or personality predictors to emerge.
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
## -7.266 -4.340 -1.097 2.649 19.425
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 6.5649 0.6065 10.823 <2e-16 ***
## condhard 0.1001 0.8455 0.118 0.906
## cwv_c -0.1189 0.6045 -0.197 0.844
## condhard:cwv_c 0.6216 0.8478 0.733 0.464
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 5.526 on 167 degrees of freedom
## Multiple R-squared: 0.004585, Adjusted R-squared: -0.0133
## F-statistic: 0.2564 on 3 and 167 DF, p-value: 0.8567
interact_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()
The interaction pattern is theoretically interesting and directionally correct, but the outcome variable is simply too noisy and mechanically constrained to detect it statistically.
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.2759 -1.8516 -0.1279 1.5697 3.8320
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.1705 0.2154 14.720 < 2e-16 ***
## condhard 0.8080 0.3002 2.691 0.00784 **
## agree_c 0.3396 0.2183 1.555 0.12173
## condhard:agree_c -0.5166 0.3014 -1.714 0.08836 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.96 on 167 degrees of freedom
## Multiple R-squared: 0.05954, Adjusted R-squared: 0.04264
## F-statistic: 3.524 on 3 and 167 DF, p-value: 0.01632
m1h_emp <- lm(empathy ~ cond * agree_c, data = df)
summary(m1h_emp)
##
## Call:
## lm(formula = empathy ~ cond * agree_c, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.0418 -0.7201 -0.3398 0.4871 5.1364
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.72044 0.10850 15.857 <2e-16 ***
## condhard 0.20203 0.15123 1.336 0.183
## agree_c 0.04500 0.10998 0.409 0.683
## condhard:agree_c -0.08565 0.15179 -0.564 0.573
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.987 on 167 degrees of freedom
## Multiple R-squared: 0.0125, Adjusted R-squared: -0.005238
## F-statistic: 0.7047 on 3 and 167 DF, p-value: 0.5505
m1h_sch <- lm(schadenfreude ~ cond * agree_c, data = df)
summary(m1h_sch)
##
## Call:
## lm(formula = schadenfreude ~ cond * agree_c, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.5952 -0.5031 -0.2531 0.1248 4.7958
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.3011 0.1306 17.624 < 2e-16 ***
## condhard -1.0487 0.1820 -5.763 3.9e-08 ***
## agree_c -0.1168 0.1324 -0.883 0.379
## condhard:agree_c 0.1272 0.1827 0.696 0.487
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.188 on 167 degrees of freedom
## Multiple R-squared: 0.171, Adjusted R-squared: 0.1561
## F-statistic: 11.48 on 3 and 167 DF, p-value: 6.98e-07
m1i <- lm(total_stuns ~ cond * agree_c, data = df)
summary(m1i)
##
## Call:
## lm(formula = total_stuns ~ cond * agree_c, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -6.923 -4.470 -1.041 2.617 19.530
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 6.55534 0.60812 10.780 <2e-16 ***
## condhard 0.12915 0.84762 0.152 0.879
## agree_c -0.20730 0.61644 -0.336 0.737
## condhard:agree_c -0.07498 0.85080 -0.088 0.930
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 5.532 on 167 degrees of freedom
## Multiple R-squared: 0.002151, Adjusted R-squared: -0.01577
## F-statistic: 0.12 on 3 and 167 DF, p-value: 0.9482
med_out <- mediate(
model.m = lm(moral_outrage ~ cond + cwv_c, data = df),
model.y = lm(intent_aggression ~ 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.026016 -0.070354 0.124206 0.604
## ADE -0.447419 -0.905159 0.034875 0.072 .
## Total Effect -0.421402 -0.890471 0.034255 0.084 .
## Prop. Mediated -0.061737 -0.760687 0.443215 0.632
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Sample Size Used: 171
##
##
## Simulations: 500
med_emp <- mediate(
model.m = lm(empathy ~ cond + cwv_c, data = df),
model.y = lm(intent_aggression ~ empathy + cond + cwv_c, data = df),
treat = "cond",
mediator = "empathy",
boot = TRUE,
sims = 500
)
summary(med_emp)
##
## Causal Mediation Analysis
##
## Nonparametric Bootstrap Confidence Intervals with the Percentile Method
##
## Estimate 95% CI Lower 95% CI Upper p-value
## ACME 0.0329512 -0.0217561 0.1238659 0.360
## ADE -0.4543534 -0.9078551 0.0065701 0.052 .
## Total Effect -0.4214022 -0.8563469 0.0646529 0.060 .
## Prop. Mediated -0.0781942 -0.8986292 0.1896700 0.404
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Sample Size Used: 171
##
##
## Simulations: 500
med_sch <- mediate(
model.m = lm(schadenfreude ~ cond + cwv_c, data = df),
model.y = lm(intent_aggression ~ schadenfreude + cond + cwv_c, data = df),
treat = "cond",
mediator = "schadenfreude",
boot = TRUE,
sims = 500
)
summary(med_sch)
##
## Causal Mediation Analysis
##
## Nonparametric Bootstrap Confidence Intervals with the Percentile Method
##
## Estimate 95% CI Lower 95% CI Upper p-value
## ACME -0.387514 -0.621370 -0.171305 <2e-16 ***
## ADE -0.033888 -0.561072 0.445429 0.952
## Total Effect -0.421402 -0.876902 0.028414 0.068 .
## Prop. Mediated 0.919583 -2.538537 6.367283 0.068 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Sample Size Used: 171
##
##
## Simulations: 500
Interesting! Easy mode generates schadenfreude, and schadenfreude drives aggressive intent, with schadenfreude accounting for nearly all of the condition effect on aggression — providing the first clean mediation evidence in this paradigm and pointing to the overpowered condition, not the underpowered one, as the primary context for motivated aggression.
## 6.11 Within Easy Mode: Magnanimity vs. Painmaxxing
# Filter to easy mode only
easy_df <- df %>% filter(cond == "easy")
# Does CWV predict schadenfreude in easy mode?
m_easy_sch <- lm(schadenfreude ~ cwv_c, data = easy_df)
summary(m_easy_sch)
##
## Call:
## lm(formula = schadenfreude ~ cwv_c, data = easy_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.9026 -1.1651 -0.5421 0.9047 5.0808
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.3103 0.1736 13.308 <2e-16 ***
## cwv_c 0.2644 0.1730 1.528 0.13
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.581 on 81 degrees of freedom
## Multiple R-squared: 0.02802, Adjusted R-squared: 0.01602
## F-statistic: 2.335 on 1 and 81 DF, p-value: 0.1304
# Does CWV predict empathy in easy mode?
m_easy_emp <- lm(empathy ~ cwv_c, data = easy_df)
summary(m_easy_emp)
##
## Call:
## lm(formula = empathy ~ cwv_c, data = easy_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.8371 -0.6946 -0.4363 0.3601 4.9823
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.71871 0.11257 15.268 <2e-16 ***
## cwv_c 0.05573 0.11219 0.497 0.621
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.025 on 81 degrees of freedom
## Multiple R-squared: 0.003038, Adjusted R-squared: -0.009271
## F-statistic: 0.2468 on 1 and 81 DF, p-value: 0.6207
# Does CWV predict intent to aggress in easy mode?
m_easy_intent <- lm(intent_aggression ~ cwv_c, data = easy_df)
summary(m_easy_intent)
##
## Call:
## lm(formula = intent_aggression ~ cwv_c, data = easy_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.8388 -1.1834 -0.1915 1.4428 3.1029
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.1647 0.1821 22.875 <2e-16 ***
## cwv_c 0.1809 0.1814 0.997 0.322
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.659 on 81 degrees of freedom
## Multiple R-squared: 0.01213, Adjusted R-squared: -7.079e-05
## F-statistic: 0.9942 on 1 and 81 DF, p-value: 0.3217
# Visualize: CWV vs schadenfreude in easy mode
ggplot(easy_df, aes(x = cwv, y = schadenfreude)) +
geom_point(alpha = 0.4, color = "#5B8DB8") +
geom_smooth(method = "lm", se = TRUE, color = "#E07B54") +
labs(title = "CWV → Schadenfreude in Easy Mode",
subtitle = "Higher CWV = more enjoyment of opponents' disadvantage (painmaxxing)",
x = "Competitive Worldview", y = "Schadenfreude (1–7)") +
theme_minimal()
# Visualize: CWV vs intent to aggress in easy mode
ggplot(easy_df, aes(x = cwv, y = intent_aggression)) +
geom_point(alpha = 0.4, color = "#5B8DB8") +
geom_smooth(method = "lm", se = TRUE, color = "#E07B54") +
labs(title = "CWV → Intent to Aggress in Easy Mode",
subtitle = "Higher CWV = more aggressive intent when overpowered",
x = "Competitive Worldview", y = "Intent to Aggress (1–7)") +
theme_minimal()
# Summary table: low vs high CWV in easy mode
easy_df %>%
mutate(cwv_group = if_else(cwv > median(cwv, na.rm = TRUE), "High CWV", "Low CWV")) %>%
group_by(cwv_group) %>%
summarise(
Schadenfreude_M = round(mean(schadenfreude, na.rm = TRUE), 2),
Empathy_M = round(mean(empathy, na.rm = TRUE), 2),
Intent_Aggress_M = round(mean(intent_aggression, na.rm = TRUE), 2),
N = n()
) %>%
kable(col.names = c("CWV Group", "Schadenfreude M", "Empathy M",
"Intent Aggress M", "N"),
caption = "Low vs High CWV in Easy Mode: Magnanimity vs Painmaxxing") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)
| CWV Group | Schadenfreude M | Empathy M | Intent Aggress M | N |
|---|---|---|---|---|
| High CWV | 2.31 | 1.78 | 4.29 | 40 |
| Low CWV | 2.31 | 1.66 | 4.05 | 43 |
There just isn’t anything significant here…
This model examines how objective performance (score) and subjective opponent perceptions predict the three SDT needs — autonomy, competence, and relatedness.
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
## -2.5968 -1.1081 -0.2057 0.7613 4.8543
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.36522 0.36472 6.485 9.63e-10 ***
## Player_score 0.33572 0.05639 5.953 1.51e-08 ***
## opponent_perception 0.10626 0.07420 1.432 0.1540
## condhard -0.64457 0.27479 -2.346 0.0202 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.412 on 167 degrees of freedom
## Multiple R-squared: 0.3386, Adjusted R-squared: 0.3268
## F-statistic: 28.5 on 3 and 167 DF, p-value: 6.19e-15
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
## -2.9778 -1.3505 0.2011 1.2304 3.7900
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.33279 0.39812 8.371 2.2e-14 ***
## Player_score 0.08567 0.06156 1.392 0.166
## opponent_perception 0.08168 0.08099 1.009 0.315
## condhard -0.44955 0.29995 -1.499 0.136
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.542 on 167 degrees of freedom
## Multiple R-squared: 0.05626, Adjusted R-squared: 0.03931
## F-statistic: 3.319 on 3 and 167 DF, p-value: 0.0213
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()
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()
cor_vars <- df[, c("moral_outrage", "surprised", "disappointed",
"empathy", "schadenfreude", "cwv", "gp",
"tipi_agreeableness", "tipi_openness",
"sdt_autonomy", "sdt_competence", "sdt_relatedness",
"Player_score", "total_stuns", "intent_aggression",
"opponent_perception", "perceived_strength", "difficulty")]
names(cor_vars) <- c("Moral Outrage", "Surprised", "Disappointed",
"Empathy", "Schadenfreude", "CWV", "GP",
"Agreeableness", "Openness",
"Autonomy", "Competence", "Relatedness",
"Score", "Stuns", "Intent Aggress",
"Opp. Perception", "Perc. Strength", "Difficulty")
cor(cor_vars, use = "pairwise.complete.obs") %>%
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 | Surprised | Disappointed | Empathy | Schadenfreude | CWV | GP | Agreeableness | Openness | Autonomy | Competence | Relatedness | Score | Stuns | Intent Aggress | Opp. Perception | Perc. Strength | Difficulty | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Moral Outrage | 1.00 | 0.58 | 0.78 | 0.40 | -0.16 | 0.03 | 0.03 | 0.04 | -0.16 | 0.03 | -0.05 | 0.00 | -0.10 | -0.05 | 0.01 | 0.78 | -0.24 | 0.20 |
| Surprised | 0.58 | 1.00 | 0.62 | 0.33 | -0.10 | 0.02 | -0.01 | 0.03 | -0.10 | 0.00 | -0.04 | 0.03 | -0.19 | -0.13 | 0.02 | 0.54 | -0.21 | 0.28 |
| Disappointed | 0.78 | 0.62 | 1.00 | 0.39 | -0.24 | 0.06 | 0.01 | 0.07 | -0.11 | -0.01 | -0.10 | -0.04 | -0.20 | -0.15 | -0.06 | 0.74 | -0.22 | 0.25 |
| Empathy | 0.40 | 0.33 | 0.39 | 1.00 | 0.18 | 0.07 | -0.05 | 0.01 | -0.07 | 0.19 | 0.15 | 0.20 | 0.00 | -0.04 | 0.10 | 0.41 | -0.02 | 0.08 |
| Schadenfreude | -0.16 | -0.10 | -0.24 | 0.18 | 1.00 | 0.10 | -0.07 | -0.06 | 0.09 | 0.39 | 0.54 | 0.29 | 0.42 | 0.11 | 0.32 | -0.17 | 0.51 | -0.49 |
| CWV | 0.03 | 0.02 | 0.06 | 0.07 | 0.10 | 1.00 | -0.53 | -0.45 | -0.13 | 0.07 | 0.08 | -0.01 | 0.04 | 0.04 | 0.09 | 0.02 | 0.00 | -0.04 |
| GP | 0.03 | -0.01 | 0.01 | -0.05 | -0.07 | -0.53 | 1.00 | 0.27 | 0.07 | -0.06 | -0.01 | 0.04 | -0.11 | -0.09 | -0.05 | 0.12 | -0.05 | 0.16 |
| Agreeableness | 0.04 | 0.03 | 0.07 | 0.01 | -0.06 | -0.45 | 0.27 | 1.00 | 0.09 | 0.07 | 0.05 | 0.00 | -0.13 | -0.04 | -0.02 | 0.14 | -0.02 | 0.17 |
| Openness | -0.16 | -0.10 | -0.11 | -0.07 | 0.09 | -0.13 | 0.07 | 0.09 | 1.00 | 0.08 | 0.10 | 0.04 | 0.06 | 0.06 | 0.20 | -0.14 | 0.19 | -0.17 |
| Autonomy | 0.03 | 0.00 | -0.01 | 0.19 | 0.39 | 0.07 | -0.06 | 0.07 | 0.08 | 1.00 | 0.50 | 0.33 | 0.20 | -0.20 | -0.15 | 0.02 | 0.30 | -0.28 |
| Competence | -0.05 | -0.04 | -0.10 | 0.15 | 0.54 | 0.08 | -0.01 | 0.05 | 0.10 | 0.50 | 1.00 | 0.44 | 0.56 | 0.04 | 0.23 | -0.02 | 0.62 | -0.55 |
| Relatedness | 0.00 | 0.03 | -0.04 | 0.20 | 0.29 | -0.01 | 0.04 | 0.00 | 0.04 | 0.33 | 0.44 | 1.00 | 0.13 | -0.11 | 0.03 | -0.02 | 0.19 | -0.15 |
| Score | -0.10 | -0.19 | -0.20 | 0.00 | 0.42 | 0.04 | -0.11 | -0.13 | 0.06 | 0.20 | 0.56 | 0.13 | 1.00 | 0.23 | 0.31 | -0.13 | 0.67 | -0.76 |
| Stuns | -0.05 | -0.13 | -0.15 | -0.04 | 0.11 | 0.04 | -0.09 | -0.04 | 0.06 | -0.20 | 0.04 | -0.11 | 0.23 | 1.00 | 0.41 | -0.02 | 0.01 | -0.05 |
| Intent Aggress | 0.01 | 0.02 | -0.06 | 0.10 | 0.32 | 0.09 | -0.05 | -0.02 | 0.20 | -0.15 | 0.23 | 0.03 | 0.31 | 0.41 | 1.00 | 0.06 | 0.16 | -0.25 |
| Opp. Perception | 0.78 | 0.54 | 0.74 | 0.41 | -0.17 | 0.02 | 0.12 | 0.14 | -0.14 | 0.02 | -0.02 | -0.02 | -0.13 | -0.02 | 0.06 | 1.00 | -0.31 | 0.27 |
| Perc. Strength | -0.24 | -0.21 | -0.22 | -0.02 | 0.51 | 0.00 | -0.05 | -0.02 | 0.19 | 0.30 | 0.62 | 0.19 | 0.67 | 0.01 | 0.16 | -0.31 | 1.00 | -0.73 |
| Difficulty | 0.20 | 0.28 | 0.25 | 0.08 | -0.49 | -0.04 | 0.16 | 0.17 | -0.17 | -0.28 | -0.55 | -0.15 | -0.76 | -0.05 | -0.25 | 0.27 | -0.73 | 1.00 |
vars <- c("moral_outrage", "surprised", "disappointed",
"empathy", "schadenfreude", "cwv", "gp",
"tipi_agreeableness", "tipi_openness",
"sdt_autonomy", "sdt_competence", "sdt_relatedness",
"Player_score", "total_stuns", "intent_aggression",
"Player_raids_hut", "Player_produces_fruit",
"opponent_perception", "perceived_strength", "difficulty")
nice_names <- c("Moral Outrage", "Surprised", "Disappointed",
"Empathy", "Schadenfreude", "CWV", "GP",
"Agreeableness", "Openness",
"Autonomy", "Competence", "Relatedness",
"Score", "Stuns", "Intent Aggress",
"Raids", "Fruit", "Opp. Perception",
"Perc. Strength", "Difficulty")
cor_vars_easy <- df[df$cond == "easy", vars]
names(cor_vars_easy) <- nice_names
cor(cor_vars_easy, use = "pairwise.complete.obs") %>%
round(2) %>%
kable(caption = "Pairwise correlations — Easy mode only") %>%
kable_styling(bootstrap_options = c("striped", "condensed"),
font_size = 11, full_width = TRUE) %>%
scroll_box(width = "100%")
| Moral Outrage | Surprised | Disappointed | Empathy | Schadenfreude | CWV | GP | Agreeableness | Openness | Autonomy | Competence | Relatedness | Score | Stuns | Intent Aggress | Raids | Fruit | Opp. Perception | Perc. Strength | Difficulty | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Moral Outrage | 1.00 | 0.49 | 0.75 | 0.34 | -0.04 | 0.00 | 0.07 | 0.18 | -0.33 | 0.00 | 0.10 | -0.01 | 0.01 | -0.05 | -0.01 | -0.01 | 0.15 | 0.82 | -0.13 | 0.14 |
| Surprised | 0.49 | 1.00 | 0.63 | 0.34 | -0.04 | -0.09 | 0.17 | 0.29 | -0.17 | 0.00 | 0.02 | 0.02 | -0.19 | -0.20 | 0.07 | -0.17 | 0.06 | 0.53 | -0.15 | 0.33 |
| Disappointed | 0.75 | 0.63 | 1.00 | 0.26 | -0.15 | 0.10 | 0.03 | 0.21 | -0.27 | -0.03 | 0.10 | -0.02 | -0.08 | -0.16 | -0.11 | -0.10 | 0.11 | 0.75 | -0.13 | 0.22 |
| Empathy | 0.34 | 0.34 | 0.26 | 1.00 | 0.33 | 0.06 | -0.11 | 0.04 | -0.15 | 0.32 | 0.24 | 0.31 | 0.09 | -0.02 | 0.07 | -0.03 | 0.16 | 0.35 | 0.14 | -0.02 |
| Schadenfreude | -0.04 | -0.04 | -0.15 | 0.33 | 1.00 | 0.17 | -0.14 | -0.07 | 0.12 | 0.47 | 0.48 | 0.21 | 0.24 | 0.17 | 0.39 | 0.12 | 0.00 | -0.04 | 0.41 | -0.35 |
| CWV | 0.00 | -0.09 | 0.10 | 0.06 | 0.17 | 1.00 | -0.57 | -0.45 | 0.02 | 0.23 | 0.10 | 0.02 | 0.07 | -0.02 | 0.11 | 0.03 | -0.05 | 0.01 | 0.10 | -0.13 |
| GP | 0.07 | 0.17 | 0.03 | -0.11 | -0.14 | -0.57 | 1.00 | 0.34 | -0.09 | -0.13 | -0.20 | -0.08 | -0.23 | -0.03 | -0.17 | -0.15 | -0.07 | 0.11 | -0.25 | 0.36 |
| Agreeableness | 0.18 | 0.29 | 0.21 | 0.04 | -0.07 | -0.45 | 0.34 | 1.00 | 0.01 | 0.08 | 0.10 | -0.03 | -0.20 | -0.04 | -0.03 | -0.10 | -0.14 | 0.22 | -0.04 | 0.27 |
| Openness | -0.33 | -0.17 | -0.27 | -0.15 | 0.12 | 0.02 | -0.09 | 0.01 | 1.00 | 0.23 | 0.15 | 0.00 | 0.08 | 0.05 | 0.28 | -0.03 | -0.06 | -0.31 | 0.26 | -0.24 |
| Autonomy | 0.00 | 0.00 | -0.03 | 0.32 | 0.47 | 0.23 | -0.13 | 0.08 | 0.23 | 1.00 | 0.39 | 0.30 | 0.13 | -0.09 | 0.02 | -0.06 | 0.02 | 0.08 | 0.33 | -0.30 |
| Competence | 0.10 | 0.02 | 0.10 | 0.24 | 0.48 | 0.10 | -0.20 | 0.10 | 0.15 | 0.39 | 1.00 | 0.38 | 0.52 | 0.12 | 0.39 | 0.22 | 0.18 | 0.11 | 0.64 | -0.53 |
| Relatedness | -0.01 | 0.02 | -0.02 | 0.31 | 0.21 | 0.02 | -0.08 | -0.03 | 0.00 | 0.30 | 0.38 | 1.00 | 0.01 | -0.07 | 0.04 | -0.02 | 0.06 | -0.01 | 0.10 | 0.02 |
| Score | 0.01 | -0.19 | -0.08 | 0.09 | 0.24 | 0.07 | -0.23 | -0.20 | 0.08 | 0.13 | 0.52 | 0.01 | 1.00 | 0.36 | 0.36 | 0.50 | 0.57 | 0.02 | 0.66 | -0.70 |
| Stuns | -0.05 | -0.20 | -0.16 | -0.02 | 0.17 | -0.02 | -0.03 | -0.04 | 0.05 | -0.09 | 0.12 | -0.07 | 0.36 | 1.00 | 0.41 | 0.35 | 0.01 | -0.01 | 0.13 | -0.10 |
| Intent Aggress | -0.01 | 0.07 | -0.11 | 0.07 | 0.39 | 0.11 | -0.17 | -0.03 | 0.28 | 0.02 | 0.39 | 0.04 | 0.36 | 0.41 | 1.00 | 0.27 | 0.02 | 0.03 | 0.28 | -0.35 |
| Raids | -0.01 | -0.17 | -0.10 | -0.03 | 0.12 | 0.03 | -0.15 | -0.10 | -0.03 | -0.06 | 0.22 | -0.02 | 0.50 | 0.35 | 0.27 | 1.00 | 0.00 | -0.10 | 0.27 | -0.29 |
| Fruit | 0.15 | 0.06 | 0.11 | 0.16 | 0.00 | -0.05 | -0.07 | -0.14 | -0.06 | 0.02 | 0.18 | 0.06 | 0.57 | 0.01 | 0.02 | 0.00 | 1.00 | 0.14 | 0.19 | -0.24 |
| Opp. Perception | 0.82 | 0.53 | 0.75 | 0.35 | -0.04 | 0.01 | 0.11 | 0.22 | -0.31 | 0.08 | 0.11 | -0.01 | 0.02 | -0.01 | 0.03 | -0.10 | 0.14 | 1.00 | -0.16 | 0.17 |
| Perc. Strength | -0.13 | -0.15 | -0.13 | 0.14 | 0.41 | 0.10 | -0.25 | -0.04 | 0.26 | 0.33 | 0.64 | 0.10 | 0.66 | 0.13 | 0.28 | 0.27 | 0.19 | -0.16 | 1.00 | -0.70 |
| Difficulty | 0.14 | 0.33 | 0.22 | -0.02 | -0.35 | -0.13 | 0.36 | 0.27 | -0.24 | -0.30 | -0.53 | 0.02 | -0.70 | -0.10 | -0.35 | -0.29 | -0.24 | 0.17 | -0.70 | 1.00 |
cor_vars_hard <- df[df$cond == "hard", vars]
names(cor_vars_hard) <- nice_names
cor(cor_vars_hard, use = "pairwise.complete.obs") %>%
round(2) %>%
kable(caption = "Pairwise correlations — Hard mode only") %>%
kable_styling(bootstrap_options = c("striped", "condensed"),
font_size = 11, full_width = TRUE) %>%
scroll_box(width = "100%")
| Moral Outrage | Surprised | Disappointed | Empathy | Schadenfreude | CWV | GP | Agreeableness | Openness | Autonomy | Competence | Relatedness | Score | Stuns | Intent Aggress | Raids | Fruit | Opp. Perception | Perc. Strength | Difficulty | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Moral Outrage | 1.00 | 0.62 | 0.78 | 0.45 | -0.23 | 0.06 | -0.01 | -0.09 | -0.02 | 0.13 | -0.02 | 0.11 | 0.11 | -0.06 | 0.10 | -0.04 | 0.00 | 0.74 | -0.20 | 0.05 |
| Surprised | 0.62 | 1.00 | 0.58 | 0.30 | 0.01 | 0.12 | -0.17 | -0.20 | -0.04 | 0.08 | 0.07 | 0.15 | 0.20 | -0.07 | 0.03 | -0.17 | 0.18 | 0.50 | -0.09 | 0.01 |
| Disappointed | 0.78 | 0.58 | 1.00 | 0.48 | -0.22 | 0.02 | 0.00 | -0.07 | 0.02 | 0.10 | -0.07 | 0.06 | -0.06 | -0.15 | 0.05 | -0.06 | 0.02 | 0.69 | -0.06 | 0.01 |
| Empathy | 0.45 | 0.30 | 0.48 | 1.00 | 0.08 | 0.08 | 0.02 | -0.04 | 0.00 | 0.11 | 0.19 | 0.10 | 0.05 | -0.07 | 0.16 | -0.03 | 0.05 | 0.46 | -0.10 | 0.17 |
| Schadenfreude | -0.23 | 0.01 | -0.22 | 0.08 | 1.00 | 0.02 | 0.08 | 0.02 | 0.03 | 0.15 | 0.48 | 0.38 | 0.28 | 0.02 | 0.06 | -0.19 | 0.11 | -0.18 | 0.29 | -0.27 |
| CWV | 0.06 | 0.12 | 0.02 | 0.08 | 0.02 | 1.00 | -0.50 | -0.45 | -0.25 | -0.06 | 0.08 | -0.05 | 0.01 | 0.09 | 0.07 | 0.16 | -0.02 | 0.03 | -0.11 | 0.09 |
| GP | -0.01 | -0.17 | 0.00 | 0.02 | 0.08 | -0.50 | 1.00 | 0.21 | 0.22 | 0.00 | 0.19 | 0.24 | 0.14 | -0.16 | 0.09 | -0.04 | 0.07 | 0.15 | 0.20 | -0.13 |
| Agreeableness | -0.09 | -0.20 | -0.07 | -0.04 | 0.02 | -0.45 | 0.21 | 1.00 | 0.16 | 0.08 | 0.07 | 0.07 | 0.08 | -0.05 | 0.00 | -0.02 | 0.00 | 0.03 | 0.09 | 0.00 |
| Openness | -0.02 | -0.04 | 0.02 | 0.00 | 0.03 | -0.25 | 0.22 | 0.16 | 1.00 | -0.05 | 0.04 | 0.07 | 0.00 | 0.07 | 0.12 | -0.10 | -0.07 | 0.03 | 0.15 | -0.13 |
| Autonomy | 0.13 | 0.08 | 0.10 | 0.11 | 0.15 | -0.06 | 0.00 | 0.08 | -0.05 | 1.00 | 0.54 | 0.34 | 0.18 | -0.31 | -0.40 | -0.19 | 0.36 | 0.08 | 0.13 | -0.07 |
| Competence | -0.02 | 0.07 | -0.07 | 0.19 | 0.48 | 0.08 | 0.19 | 0.07 | 0.04 | 0.54 | 1.00 | 0.47 | 0.36 | -0.04 | -0.06 | -0.11 | 0.09 | 0.12 | 0.32 | -0.17 |
| Relatedness | 0.11 | 0.15 | 0.06 | 0.10 | 0.38 | -0.05 | 0.24 | 0.07 | 0.07 | 0.34 | 0.47 | 1.00 | 0.18 | -0.17 | -0.06 | -0.12 | 0.13 | 0.09 | 0.14 | -0.31 |
| Score | 0.11 | 0.20 | -0.06 | 0.05 | 0.28 | 0.01 | 0.14 | 0.08 | 0.00 | 0.18 | 0.36 | 0.18 | 1.00 | 0.25 | 0.17 | 0.04 | -0.08 | 0.15 | -0.07 | -0.14 |
| Stuns | -0.06 | -0.07 | -0.15 | -0.07 | 0.02 | 0.09 | -0.16 | -0.05 | 0.07 | -0.31 | -0.04 | -0.17 | 0.25 | 1.00 | 0.42 | 0.11 | -0.17 | -0.05 | -0.14 | 0.00 |
| Intent Aggress | 0.10 | 0.03 | 0.05 | 0.16 | 0.06 | 0.07 | 0.09 | 0.00 | 0.12 | -0.40 | -0.06 | -0.06 | 0.17 | 0.42 | 1.00 | 0.28 | -0.31 | 0.21 | -0.17 | 0.13 |
| Raids | -0.04 | -0.17 | -0.06 | -0.03 | -0.19 | 0.16 | -0.04 | -0.02 | -0.10 | -0.19 | -0.11 | -0.12 | 0.04 | 0.11 | 0.28 | 1.00 | -0.35 | 0.09 | -0.18 | 0.04 |
| Fruit | 0.00 | 0.18 | 0.02 | 0.05 | 0.11 | -0.02 | 0.07 | 0.00 | -0.07 | 0.36 | 0.09 | 0.13 | -0.08 | -0.17 | -0.31 | -0.35 | 1.00 | 0.02 | 0.08 | 0.12 |
| Opp. Perception | 0.74 | 0.50 | 0.69 | 0.46 | -0.18 | 0.03 | 0.15 | 0.03 | 0.03 | 0.08 | 0.12 | 0.09 | 0.15 | -0.05 | 0.21 | 0.09 | 0.02 | 1.00 | -0.26 | 0.14 |
| Perc. Strength | -0.20 | -0.09 | -0.06 | -0.10 | 0.29 | -0.11 | 0.20 | 0.09 | 0.15 | 0.13 | 0.32 | 0.14 | -0.07 | -0.14 | -0.17 | -0.18 | 0.08 | -0.26 | 1.00 | -0.38 |
| Difficulty | 0.05 | 0.01 | 0.01 | 0.17 | -0.27 | 0.09 | -0.13 | 0.00 | -0.13 | -0.07 | -0.17 | -0.31 | -0.14 | 0.00 | 0.13 | 0.04 | 0.12 | 0.14 | -0.38 | 1.00 |
## 9. Behavioral Outcomes by Condition
# Summarise all three behavioral outcomes by condition
behavioral_summary <- df %>%
group_by(cond) %>%
summarise(
Stuns_M = round(mean(total_stuns, na.rm = TRUE), 2),
Stuns_SD = round(sd(total_stuns, na.rm = TRUE), 2),
Raids_M = round(mean(Player_raids_hut, na.rm = TRUE), 2),
Raids_SD = round(sd(Player_raids_hut, na.rm = TRUE), 2),
Fruit_M = round(mean(Player_produces_fruit, na.rm = TRUE), 2),
Fruit_SD = round(sd(Player_produces_fruit, na.rm = TRUE), 2)
)
kable(behavioral_summary,
col.names = c("Condition",
"Stuns M", "Stuns SD",
"Raids M", "Raids SD",
"Fruit M", "Fruit SD"),
caption = "Behavioral outcomes by condition") %>%
kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)
| Condition | Stuns M | Stuns SD | Raids M | Raids SD | Fruit M | Fruit SD |
|---|---|---|---|---|---|---|
| easy | 6.57 | 5.73 | 2.24 | 2.03 | 3.52 | 1.68 |
| hard | 6.67 | 5.28 | 3.66 | 2.88 | 4.11 | 2.46 |
# t-tests for each outcome
cat("--- Stuns ---\n"); print(t.test(total_stuns ~ cond, data = df))
## --- Stuns ---
##
## Welch Two Sample t-test
##
## data: total_stuns by cond
## t = -0.12339, df = 165.71, p-value = 0.9019
## alternative hypothesis: true difference in means between group easy and group hard is not equal to 0
## 95 percent confidence interval:
## -1.771323 1.562944
## sample estimates:
## mean in group easy mean in group hard
## 6.566265 6.670455
cat("--- Raids ---\n"); print(t.test(Player_raids_hut ~ cond, data = df))
## --- Raids ---
##
## Welch Two Sample t-test
##
## data: Player_raids_hut by cond
## t = -3.7361, df = 156.48, p-value = 0.0002615
## alternative hypothesis: true difference in means between group easy and group hard is not equal to 0
## 95 percent confidence interval:
## -2.1678818 -0.6683723
## sample estimates:
## mean in group easy mean in group hard
## 2.240964 3.659091
cat("--- Fruit ---\n"); print(t.test(Player_produces_fruit ~ cond, data = df))
## --- Fruit ---
##
## Welch Two Sample t-test
##
## data: Player_produces_fruit by cond
## t = -1.8583, df = 154.14, p-value = 0.06504
## alternative hypothesis: true difference in means between group easy and group hard is not equal to 0
## 95 percent confidence interval:
## -1.2286935 0.0375653
## sample estimates:
## mean in group easy mean in group hard
## 3.518072 4.113636
# Figure: all three outcomes side by side
df %>%
rename(Stuns = total_stuns,
Raids = Player_raids_hut,
Fruit = Player_produces_fruit) %>%
pivot_longer(c(Stuns, Raids, Fruit),
names_to = "Behavior", values_to = "Count") %>%
group_by(cond, Behavior) %>%
summarise(M = mean(Count, na.rm = TRUE),
SE = sd(Count, na.rm = TRUE) / sqrt(n()),
.groups = "drop") %>%
mutate(Behavior = factor(Behavior, levels = c("Stuns", "Raids", "Fruit"))) %>%
ggplot(aes(x = Behavior, 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") +
labs(title = "Behavioral Outcomes by Condition",
subtitle = "Error bars = ±1 SE",
x = NULL, y = "Mean Count") +
theme_minimal() +
theme(legend.position = "top")
For each player, compute how many distinct behaviors they engaged in (>0) and a Shannon entropy score as a continuous diversity measure.
df <- df %>%
mutate(
# Binary indicators of whether each behavior occurred at all
did_stun = as.integer(total_stuns > 0),
did_raid = as.integer(Player_raids_hut > 0),
did_fruit = as.integer(Player_produces_fruit > 0),
# Count of distinct behaviors engaged in (0-3)
behavior_variety = did_stun + did_raid + did_fruit,
# Shannon entropy: higher = more evenly spread across behaviors
# (avoids 0 log 0 issues by adding small constant)
total_actions = total_stuns + Player_raids_hut + Player_produces_fruit + 0.001,
p_stun = (total_stuns + 0.001) / total_actions,
p_raid = (Player_raids_hut + 0.001) / total_actions,
p_fruit = (Player_produces_fruit + 0.001) / total_actions,
shannon_entropy = -(p_stun * log(p_stun) +
p_raid * log(p_raid) +
p_fruit * log(p_fruit))
)
# Summary table
df %>%
group_by(cond) %>%
summarise(
Variety_M = round(mean(behavior_variety, na.rm = TRUE), 2),
Variety_SD = round(sd(behavior_variety, na.rm = TRUE), 2),
Entropy_M = round(mean(shannon_entropy, na.rm = TRUE), 3),
Entropy_SD = round(sd(shannon_entropy, na.rm = TRUE), 3),
Pct_did_all_3 = paste0(round(mean(behavior_variety == 3,
na.rm = TRUE) * 100, 1), "%"),
Pct_did_1_or_fewer = paste0(round(mean(behavior_variety <= 1,
na.rm = TRUE) * 100, 1), "%")
) %>%
kable(col.names = c("Condition", "Variety M", "Variety SD",
"Entropy M", "Entropy SD",
"% Did All 3", "% Did ≤1"),
caption = "Behavioral diversity by condition") %>%
kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)
| Condition | Variety M | Variety SD | Entropy M | Entropy SD | % Did All 3 | % Did ≤1 |
|---|---|---|---|---|---|---|
| easy | 2.66 | 0.50 | 0.812 | 0.217 | 67.5% | 1.2% |
| hard | 2.73 | 0.52 | 0.834 | 0.244 | 76.1% | 3.4% |
# t-tests
cat("--- Behavior variety ---\n")
## --- Behavior variety ---
print(t.test(behavior_variety ~ cond, data = df))
##
## Welch Two Sample t-test
##
## data: behavior_variety by cond
## t = -0.82852, df = 168.91, p-value = 0.4085
## alternative hypothesis: true difference in means between group easy and group hard is not equal to 0
## 95 percent confidence interval:
## -0.21859702 0.08935277
## sample estimates:
## mean in group easy mean in group hard
## 2.662651 2.727273
cat("--- Shannon entropy ---\n")
## --- Shannon entropy ---
print(t.test(shannon_entropy ~ cond, data = df))
##
## Welch Two Sample t-test
##
## data: shannon_entropy by cond
## t = -0.60229, df = 168.36, p-value = 0.5478
## alternative hypothesis: true difference in means between group easy and group hard is not equal to 0
## 95 percent confidence interval:
## -0.09087876 0.04838993
## sample estimates:
## mean in group easy mean in group hard
## 0.8122871 0.8335315
# Figure 1: Distribution of variety scores
df %>%
count(cond, behavior_variety) %>%
group_by(cond) %>%
mutate(pct = n / sum(n)) %>%
ggplot(aes(x = factor(behavior_variety), y = pct, fill = cond)) +
geom_col(position = position_dodge(0.6), width = 0.5) +
geom_text(aes(label = paste0(round(pct * 100), "%")),
position = position_dodge(0.6), vjust = -0.4, size = 3.5) +
scale_fill_manual(values = c("easy" = "#5B8DB8", "hard" = "#E07B54"),
name = "Condition") +
scale_y_continuous(labels = percent_format(), limits = c(0, .6)) +
labs(title = "Number of Distinct Behaviors by Condition",
subtitle = "0 = did none, 3 = engaged in all three behaviors",
x = "Number of Distinct Behaviors", y = "Proportion of Players") +
theme_minimal() +
theme(legend.position = "top")
# Figure 2: Shannon entropy distribution
ggplot(df, aes(x = shannon_entropy, fill = cond)) +
geom_density(alpha = 0.6) +
scale_fill_manual(values = c("easy" = "#5B8DB8", "hard" = "#E07B54"),
name = "Condition") +
labs(title = "Behavioral Diversity (Shannon Entropy) by Condition",
subtitle = "Higher entropy = more evenly distributed across behaviors",
x = "Shannon Entropy", y = "Density") +
theme_minimal() +
theme(legend.position = "top")
# Figure 3: Stacked proportion chart showing behavioral mix
df %>%
group_by(cond) %>%
summarise(
Stuns = mean(total_stuns, na.rm = TRUE),
Raids = mean(Player_raids_hut, na.rm = TRUE),
Fruit = mean(Player_produces_fruit, na.rm = TRUE)
) %>%
pivot_longer(-cond, names_to = "Behavior", values_to = "Mean") %>%
group_by(cond) %>%
mutate(
Total = sum(Mean),
Pct = Mean / Total,
Behavior = factor(Behavior, levels = c("Fruit", "Raids", "Stuns"))
) %>%
ggplot(aes(x = cond, y = Pct, fill = Behavior)) +
geom_col(width = 0.5) +
geom_text(aes(label = paste0(round(Pct * 100), "%")),
position = position_stack(vjust = 0.5), size = 3.5, color = "white") +
scale_fill_manual(values = c("Stuns" = "#E07B54",
"Raids" = "#5B8DB8",
"Fruit" = "#6BAE75")) +
scale_y_continuous(labels = percent_format()) +
labs(title = "Behavioral Mix by Condition",
subtitle = "Proportion of total actions spent on each behavior",
x = "Condition", y = "Proportion of Actions") +
theme_minimal() +
theme(legend.position = "top")
Nothing really here about behavioral diversity across conditions.
# Main effects of condition
m_surp <- lm(surprised ~ cond, data = df)
summary(m_surp)
##
## Call:
## lm(formula = surprised ~ cond, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.3864 -1.6145 -0.3864 1.6136 4.3855
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.6145 0.2147 12.178 <2e-16 ***
## condhard 0.7719 0.2993 2.579 0.0108 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.956 on 169 degrees of freedom
## Multiple R-squared: 0.03787, Adjusted R-squared: 0.03218
## F-statistic: 6.653 on 1 and 169 DF, p-value: 0.01075
m_disap <- lm(disappointed ~ cond, data = df)
summary(m_disap)
##
## Call:
## lm(formula = disappointed ~ cond, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.1250 -2.0482 -0.0482 1.8750 3.9518
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.0482 0.2265 13.460 < 2e-16 ***
## condhard 1.0768 0.3157 3.411 0.00081 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.063 on 169 degrees of freedom
## Multiple R-squared: 0.06441, Adjusted R-squared: 0.05887
## F-statistic: 11.63 on 1 and 169 DF, p-value: 0.00081
# CWV moderation
m_surp_cwv <- lm(surprised ~ cond * cwv_c, data = df)
summary(m_surp_cwv)
##
## Call:
## lm(formula = surprised ~ cond * cwv_c, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.9518 -1.7131 -0.2233 1.7626 4.4120
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.6126 0.2148 12.165 <2e-16 ***
## condhard 0.7712 0.2994 2.576 0.0109 *
## cwv_c -0.1655 0.2140 -0.773 0.4405
## condhard:cwv_c 0.4065 0.3002 1.354 0.1775
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.956 on 167 degrees of freedom
## Multiple R-squared: 0.04875, Adjusted R-squared: 0.03166
## F-statistic: 2.853 on 3 and 167 DF, p-value: 0.03893
m_disap_cwv <- lm(disappointed ~ cond * cwv_c, data = df)
summary(m_disap_cwv)
##
## Call:
## lm(formula = disappointed ~ cond * cwv_c, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.1992 -1.9578 -0.0564 1.8655 4.0751
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.0504 0.2273 13.418 < 2e-16 ***
## condhard 1.0741 0.3169 3.389 0.000874 ***
## cwv_c 0.1885 0.2266 0.832 0.406592
## condhard:cwv_c -0.1401 0.3177 -0.441 0.659897
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.071 on 167 degrees of freedom
## Multiple R-squared: 0.06853, Adjusted R-squared: 0.0518
## F-statistic: 4.096 on 3 and 167 DF, p-value: 0.007765
Hard mode reliably generates both surprise and disappointment, with disappointment showing the largest condition effect in the study, suggesting that violated expectations rather than moral outrage may be the primary affective response to being underpowered in competition.
m_surp_agg <- lm(intent_aggression ~ surprised + disappointed + cond, data = df)
summary(m_surp_agg)
##
## Call:
## lm(formula = intent_aggression ~ surprised + disappointed + cond,
## data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.8305 -1.1167 -0.0024 1.2041 3.2387
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.15715 0.25053 16.594 <2e-16 ***
## surprised 0.08007 0.07519 1.065 0.2884
## disappointed -0.06687 0.07128 -0.938 0.3495
## condhard -0.40813 0.24221 -1.685 0.0939 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.529 on 167 degrees of freedom
## Multiple R-squared: 0.02607, Adjusted R-squared: 0.008573
## F-statistic: 1.49 on 3 and 167 DF, p-value: 0.2191
Nope
df[, c("cond", "surprised", "disappointed")] %>%
pivot_longer(c(surprised, disappointed),
names_to = "Emotion", values_to = "Score") %>%
mutate(Emotion = recode(Emotion,
"surprised" = "Surprised",
"disappointed" = "Disappointed")) %>%
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 = "Surprise and Disappointment by Condition",
x = NULL, y = "Mean (1–7)") +
theme_minimal()
intent_vars <- c("intent_steal","intent_protect","intent_stun",
"intent_others_score","intent_produce")
df[, c("cond", intent_vars)] %>%
pivot_longer(-cond, names_to = "Intent", values_to = "Score") %>%
mutate(Intent = recode(Intent,
"intent_steal" = "Steal",
"intent_protect" = "Protect",
"intent_stun" = "Stun",
"intent_others_score" = "Let score",
"intent_produce" = "Produce")) %>%
group_by(cond, Intent) %>%
summarise(M = mean(Score, na.rm = TRUE),
SE = sd(Score, na.rm = TRUE) / sqrt(n()), .groups = "drop") %>%
ggplot(aes(x = Intent, 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 = "Subjective Behavioral Intent by Condition",
x = NULL, y = "Mean (1–7)") +
theme_minimal()
m_intent_cwv <- lm(intent_aggression ~ cond * cwv_c, data = df)
summary(m_intent_cwv)
##
## Call:
## lm(formula = intent_aggression ~ cond * cwv_c, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.8388 -1.1605 -0.1235 1.0952 3.2983
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.16473 0.16775 24.826 <2e-16 ***
## condhard -0.42145 0.23385 -1.802 0.0733 .
## cwv_c 0.18091 0.16718 1.082 0.2807
## condhard:cwv_c -0.08486 0.23447 -0.362 0.7179
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.528 on 167 degrees of freedom
## Multiple R-squared: 0.02745, Adjusted R-squared: 0.009977
## F-statistic: 1.571 on 3 and 167 DF, p-value: 0.1983
interact_plot(m_intent_cwv,
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", y.label = "Intent to Aggress",
main.title = "CWV × Condition on Intent to Aggress",
legend.main = "CWV") + theme_minimal()
# Correlate intent with actual behavior within condition
df %>%
group_by(cond) %>%
summarise(
r_steal = round(cor(intent_steal, Player_raids_hut, use = "complete.obs"), 2),
r_stun = round(cor(intent_stun, total_stuns, use = "complete.obs"), 2),
r_produce = round(cor(intent_produce, Player_produces_fruit, use = "complete.obs"), 2)
) %>%
kable(col.names = c("Condition",
"r(Intent Steal, Raids)",
"r(Intent Stun, Stuns)",
"r(Intent Produce, Fruit)"),
caption = "Correlations between intent and actual behavior by condition") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)
| Condition | r(Intent Steal, Raids) | r(Intent Stun, Stuns) | r(Intent Produce, Fruit) |
|---|---|---|---|
| easy | 0.33 | 0.54 | 0.37 |
| hard | 0.43 | 0.64 | 0.46 |
m_play <- lm(play_again ~ cond, data = df)
summary(m_play)
##
## Call:
## lm(formula = play_again ~ cond, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.5422 -1.2955 -0.2955 1.4578 4.7045
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.5422 0.1975 17.939 < 2e-16 ***
## condhard -1.2467 0.2753 -4.529 1.11e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.799 on 169 degrees of freedom
## Multiple R-squared: 0.1082, Adjusted R-squared: 0.103
## F-statistic: 20.51 on 1 and 169 DF, p-value: 1.114e-05
df %>%
group_by(cond) %>%
summarise(M = round(mean(play_again, na.rm = TRUE), 2),
SD = round(sd(play_again, na.rm = TRUE), 2)) %>%
kable(col.names = c("Condition", "M", "SD"),
caption = "Play again by condition") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)
| Condition | M | SD |
|---|---|---|
| easy | 3.54 | 1.91 |
| hard | 2.30 | 1.69 |
m_sdt_play <- lm(play_again ~ sdt_autonomy + sdt_competence + sdt_relatedness + cond,
data = df)
summary(m_sdt_play)
##
## Call:
## lm(formula = play_again ~ sdt_autonomy + sdt_competence + sdt_relatedness +
## cond, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.7051 -0.8734 -0.2187 0.8375 5.5053
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.72015 0.38303 1.880 0.0618 .
## sdt_autonomy 0.16579 0.08592 1.930 0.0554 .
## sdt_competence 0.42453 0.08896 4.772 3.97e-06 ***
## sdt_relatedness 0.24817 0.09887 2.510 0.0130 *
## condhard -0.39552 0.25697 -1.539 0.1257
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.513 on 166 degrees of freedom
## Multiple R-squared: 0.3802, Adjusted R-squared: 0.3653
## F-statistic: 25.46 on 4 and 166 DF, p-value: < 2.2e-16
df %>%
filter(!is.na(future_mode_label)) %>%
count(cond, future_mode_label) %>%
group_by(cond) %>%
mutate(pct = paste0(round(n / sum(n) * 100, 1), "%")) %>%
kable(col.names = c("Condition", "Mode Preference", "N", "%"),
caption = "Future mode preference by condition") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)
| Condition | Mode Preference | N | % |
|---|---|---|---|
| easy | No preference | 10 | 12% |
| easy | Other mode | 14 | 16.9% |
| easy | Same mode | 59 | 71.1% |
| hard | No preference | 18 | 20.5% |
| hard | Other mode | 5 | 5.7% |
| hard | Same mode | 65 | 73.9% |
m_future_agg <- lm(future_aggression ~ cond, data = df)
summary(m_future_agg)
##
## Call:
## lm(formula = future_aggression ~ cond, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.1648 -1.1648 -0.1648 1.4458 2.8352
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.5542 0.1868 24.383 <2e-16 ***
## condhard -0.3894 0.2604 -1.496 0.137
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.702 on 169 degrees of freedom
## Multiple R-squared: 0.01306, Adjusted R-squared: 0.007225
## F-statistic: 2.237 on 1 and 169 DF, p-value: 0.1366
# Compare current intent vs future intent
df %>%
group_by(cond) %>%
summarise(
Intent_Now_M = round(mean(intent_aggression, na.rm = TRUE), 2),
Intent_Future_M = round(mean(future_aggression, na.rm = TRUE), 2)
) %>%
kable(col.names = c("Condition", "Intent Now M", "Intent Future M"),
caption = "Current vs future aggression intent by condition") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)
| Condition | Intent Now M | Intent Future M |
|---|---|---|
| easy | 4.16 | 4.55 |
| hard | 3.74 | 4.16 |
df <- df %>%
mutate(people_or_bot_label = case_when(
people_or_bot == 1 ~ "Real people",
people_or_bot == 2 ~ "Computer/bots",
people_or_bot == 3 ~ "Unsure",
TRUE ~ NA_character_
),
believed_real = people_or_bot == 1)
df %>%
filter(!is.na(people_or_bot_label)) %>%
count(people_or_bot_label) %>%
mutate(pct = paste0(round(n / sum(n) * 100, 1), "%"),
people_or_bot_label = factor(people_or_bot_label,
levels = c("Real people", "Unsure", "Computer/bots"))) %>%
arrange(people_or_bot_label) %>%
kable(col.names = c("Response", "N", "%"),
caption = "Did participants think they were playing real people?") %>%
kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)
| Response | N | % |
|---|---|---|
| Real people | 2 | 2.3% |
| Unsure | 10 | 11.5% |
| Computer/bots | 75 | 86.2% |
I forgot to add this at first! But got it for half our sample!!
df %>%
filter(!is.na(people_or_bot_label)) %>%
count(cond, people_or_bot_label) %>%
group_by(cond) %>%
mutate(pct = paste0(round(n / sum(n) * 100, 1), "%")) %>%
kable(col.names = c("Condition", "Response", "N", "%"),
caption = "Belief about opponents by condition") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)
| Condition | Response | N | % |
|---|---|---|---|
| easy | Computer/bots | 37 | 88.1% |
| easy | Real people | 1 | 2.4% |
| easy | Unsure | 4 | 9.5% |
| hard | Computer/bots | 38 | 84.4% |
| hard | Real people | 1 | 2.2% |
| hard | Unsure | 6 | 13.3% |
# Does believing they played real people predict outrage and empathy?
m_belief_out <- lm(moral_outrage ~ believed_real + cond, data = df)
summary(m_belief_out)
##
## Call:
## lm(formula = moral_outrage ~ believed_real + cond, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.8703 -2.0816 -0.1229 1.5437 3.5437
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.4563 0.3156 10.952 <2e-16 ***
## believed_realTRUE 0.1701 1.4542 0.117 0.907
## condhard 0.4140 0.4361 0.949 0.345
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.033 on 84 degrees of freedom
## (84 observations deleted due to missingness)
## Multiple R-squared: 0.01076, Adjusted R-squared: -0.01279
## F-statistic: 0.4568 on 2 and 84 DF, p-value: 0.6348
m_belief_emp <- lm(empathy ~ believed_real + cond, data = df)
summary(m_belief_emp)
##
## Call:
## lm(formula = empathy ~ believed_real + cond, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.6114 -0.6816 -0.2816 0.5184 3.5412
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.8588 0.1598 11.632 < 2e-16 ***
## believed_realTRUE 2.3298 0.7364 3.164 0.00217 **
## condhard -0.1773 0.2209 -0.803 0.42448
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.029 on 84 degrees of freedom
## (84 observations deleted due to missingness)
## Multiple R-squared: 0.1128, Adjusted R-squared: 0.09169
## F-statistic: 5.341 on 2 and 84 DF, p-value: 0.006557
# Does agreeableness predict believing they played real people?
m_agree_belief <- lm(as.numeric(believed_real) ~ tipi_agreeableness, data = df)
summary(m_agree_belief)
##
## Call:
## lm(formula = as.numeric(believed_real) ~ tipi_agreeableness,
## data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.02728 -0.02367 -0.02246 -0.02186 0.97874
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.029694 0.083940 0.354 0.724
## tipi_agreeableness -0.001205 0.014803 -0.081 0.935
##
## Residual standard error: 0.1516 on 85 degrees of freedom
## (84 observations deleted due to missingness)
## Multiple R-squared: 7.799e-05, Adjusted R-squared: -0.01169
## F-statistic: 0.00663 on 1 and 85 DF, p-value: 0.9353
Not super meaningful because so few people thought they were playing people.
df %>%
filter(!is.na(confidence)) %>%
group_by(cond) %>%
summarise(M = round(mean(confidence, na.rm = TRUE), 2),
SD = round(sd(confidence, na.rm = TRUE), 2)) %>%
kable(col.names = c("Condition", "Confidence M", "Confidence SD"),
caption = "Confidence in people vs bot judgment by condition") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)
| Condition | Confidence M | Confidence SD |
|---|---|---|
| easy | 5.07 | 1.87 |
| hard | 5.60 | 1.39 |
ggplot(df, aes(x = gp)) +
geom_histogram(bins = 20, fill = "#6BAE75", color = "white") +
geom_vline(xintercept = mean(df$gp, na.rm = TRUE),
linetype = "dashed", color = "#E07B54", linewidth = 0.8) +
annotate("text",
x = mean(df$gp, na.rm = TRUE) + 0.15, y = Inf, vjust = 1.5,
label = paste0("M = ", round(mean(df$gp, na.rm = TRUE), 2)),
color = "#E07B54", size = 3.5) +
labs(title = "Distribution of GP-5", x = "Guilt Proneness (1–7)", y = "Count") +
theme_minimal()
# Correlation with CWV
cat("r(GP, CWV) =", round(cor(df$gp, df$cwv, use = "complete.obs"), 3), "\n")
## r(GP, CWV) = -0.532
df <- df %>%
mutate(gp_c = scale(gp, center = TRUE, scale = TRUE)[,1])
m_gp_out <- lm(moral_outrage ~ cond * gp_c, data = df)
summary(m_gp_out)
##
## Call:
## lm(formula = moral_outrage ~ cond * gp_c, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.9935 -1.9126 0.0266 1.6916 3.9898
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.1508 0.2169 14.530 < 2e-16 ***
## condhard 0.8187 0.3023 2.708 0.00747 **
## gp_c 0.1317 0.2065 0.638 0.52466
## condhard:gp_c -0.1447 0.3039 -0.476 0.63464
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.975 on 167 degrees of freedom
## Multiple R-squared: 0.04417, Adjusted R-squared: 0.027
## F-statistic: 2.572 on 3 and 167 DF, p-value: 0.05587
interact_plot(m_gp_out,
pred = cond, modx = gp_c,
modx.values = c(-1, 0, 1),
modx.labels = c("Low GP (-1 SD)", "Mean GP", "High GP (+1 SD)"),
x.label = "Condition", y.label = "Moral Outrage",
main.title = "GP × Condition on Moral Outrage",
legend.main = "Guilt Proneness") + theme_minimal()
m_gp_emp <- lm(empathy ~ cond * gp_c, data = df)
summary(m_gp_emp)
##
## Call:
## lm(formula = empathy ~ cond * gp_c, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.9770 -0.7245 -0.3134 0.5316 4.8230
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.7196 0.1081 15.912 <2e-16 ***
## condhard 0.2012 0.1506 1.336 0.184
## gp_c -0.1097 0.1029 -1.066 0.288
## condhard:gp_c 0.1341 0.1515 0.885 0.377
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.9845 on 167 degrees of freedom
## Multiple R-squared: 0.01758, Adjusted R-squared: -6.364e-05
## F-statistic: 0.9964 on 3 and 167 DF, p-value: 0.396
interact_plot(m_gp_emp,
pred = cond, modx = gp_c,
modx.values = c(-1, 0, 1),
modx.labels = c("Low GP (-1 SD)", "Mean GP", "High GP (+1 SD)"),
x.label = "Condition", y.label = "Empathy",
main.title = "GP × Condition on Empathy",
legend.main = "Guilt Proneness") + theme_minimal()
m_gp_sch <- lm(schadenfreude ~ cond * gp_c, data = df)
summary(m_gp_sch)
##
## Call:
## lm(formula = schadenfreude ~ cond * gp_c, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.8225 -0.5421 -0.2512 0.0593 4.9591
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.3102 0.1294 17.849 < 2e-16 ***
## condhard -1.0567 0.1804 -5.857 2.44e-08 ***
## gp_c -0.2183 0.1233 -1.771 0.0784 .
## condhard:gp_c 0.2687 0.1814 1.481 0.1404
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.179 on 167 degrees of freedom
## Multiple R-squared: 0.1831, Adjusted R-squared: 0.1684
## F-statistic: 12.48 on 3 and 167 DF, p-value: 2.103e-07
interact_plot(m_gp_sch,
pred = cond, modx = gp_c,
modx.values = c(-1, 0, 1),
modx.labels = c("Low GP (-1 SD)", "Mean GP", "High GP (+1 SD)"),
x.label = "Condition", y.label = "Schadenfreude",
main.title = "GP × Condition on Schadenfreude",
legend.main = "Guilt Proneness") + theme_minimal()
m_gp_agg <- lm(intent_aggression ~ cond * gp_c, data = df)
summary(m_gp_agg)
##
## Call:
## lm(formula = intent_aggression ~ cond * gp_c, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.9163 -0.9930 -0.0403 1.0908 3.2954
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.1663 0.1668 24.984 <2e-16 ***
## condhard -0.4202 0.2325 -1.808 0.0724 .
## gp_c -0.2700 0.1588 -1.700 0.0910 .
## condhard:gp_c 0.4079 0.2337 1.745 0.0828 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.519 on 167 degrees of freedom
## Multiple R-squared: 0.03899, Adjusted R-squared: 0.02173
## F-statistic: 2.259 on 3 and 167 DF, p-value: 0.08348
interact_plot(m_gp_agg,
pred = cond, modx = gp_c,
modx.values = c(-1, 0, 1),
modx.labels = c("Low GP (-1 SD)", "Mean GP", "High GP (+1 SD)"),
x.label = "Condition", y.label = "Intent to Aggress",
main.title = "GP × Condition on Intent to Aggress",
legend.main = "Guilt Proneness") + theme_minimal()
People who don’t feel much guilt are more willing to attack opponents when they’re winning — they have no internal brake stopping them from being aggressive when they have the upper hand. People who do feel guilt hold back even when they could dominate. Guilt proneness doesn’t change how people behave when losing, it seems to change how ruthless they’re willing to be when winning. Interesting!
# Compare key interactions for CWV vs GP
results_comparison <- tibble(
Model = c("Condition → Moral Outrage",
"Condition → Empathy",
"Condition → Schadenfreude",
"Condition → Intent Aggress"),
CWV_b = c(coef(m1d)["condhard:cwv_c"],
coef(m1e_emp)["condhard:cwv_c"],
coef(m1e_sch)["condhard:cwv_c"],
coef(m_intent_cwv)["condhard:cwv_c"]),
CWV_p = c(summary(m1d)$coefficients["condhard:cwv_c", 4],
summary(m1e_emp)$coefficients["condhard:cwv_c", 4],
summary(m1e_sch)$coefficients["condhard:cwv_c", 4],
summary(m_intent_cwv)$coefficients["condhard:cwv_c", 4]),
GP_b = c(coef(m_gp_out)["condhard:gp_c"],
coef(m_gp_emp)["condhard:gp_c"],
coef(m_gp_sch)["condhard:gp_c"],
coef(m_gp_agg)["condhard:gp_c"]),
GP_p = c(summary(m_gp_out)$coefficients["condhard:gp_c", 4],
summary(m_gp_emp)$coefficients["condhard:gp_c", 4],
summary(m_gp_sch)$coefficients["condhard:gp_c", 4],
summary(m_gp_agg)$coefficients["condhard:gp_c", 4])
) %>%
mutate(across(c(CWV_b, GP_b), ~round(.x, 3)),
across(c(CWV_p, GP_p), ~round(.x, 3)))
kable(results_comparison,
col.names = c("Model", "CWV β", "CWV p", "GP β", "GP p"),
caption = "CWV vs GP-5 interaction coefficients across key models") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)
| Model | CWV β | CWV p | GP β | GP p |
|---|---|---|---|---|
| Condition → Moral Outrage | 0.125 | 0.680 | -0.145 | 0.635 |
| Condition → Empathy | 0.017 | 0.913 | 0.134 | 0.377 |
| Condition → Schadenfreude | -0.251 | 0.167 | 0.269 | 0.140 |
| Condition → Intent Aggress | -0.085 | 0.718 | 0.408 | 0.083 |
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