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

Key Takeaways — Pilot 3

1. Schadenfreude mediates aggression intent. Easy mode generates schadenfreude, and schadenfreude drives aggressive intent. This is the cleanest mediation finding across both pilots and suggests the overpowered condition — not the underpowered one — is the primary context for motivated aggression.

2. Disappointment is the strongest condition effect in the study. Hard mode players were significantly more disappointed and surprised by opponents’ behaviors than easy mode players, with disappointment showing a larger effect than moral outrage. This suggests violated expectations, not perceived injustice, may be the primary affective response to being underpowered in competition.

3. SDT needs drive wanting to play again. Competence (b = 0.42, p < .001) and relatedness (b = 0.25, p = .013) significantly predicted wanting to play again, with the overall model explaining 38% of variance. Hard mode players wanted to play again significantly less (M = 2.30 vs. 3.54). However, we don’t see that the other perception -> relatedness effect replicates from last time.

4. Guilt proneness is a more promising moderator than CWV for behavioral outcomes. Low GP people reported greater intent to aggress when overpowered (trending interaction, p = .083), while CWV showed no moderation of aggression intent. GP and CWV correlate at r = -.53 — GP may function as a moral brake on exploitative behavior while CWV captures ideological acceptance of competition.

5. Empathy should probably be dropped. Empathy was flat across all conditions and moderators and does not function as a meaningful mediator in this paradigm.


1. 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/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. 

1.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 = 171
cat("Condition split:\n")
## Condition split:
print(table(df$cond))
## 
## easy hard 
##   83   88

1.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),

    # ── 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"))
  )

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   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()


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)
Sample demographics
N Age M Age SD Age Range % Female % Male % Non-binary
171 46 12.6 19–78 50.3% 46.8% 2.3%

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 breakdown
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%

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)
Gaming experience descriptives (1–7 scales)
Genre Exp. M Genre Exp. SD Skill M Skill SD
3.52 1.72 3.67 1.76

3. Scale Reliability

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)
Internal consistency of composites
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

4. Descriptives by Condition

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)
Descriptive statistics by condition
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

4.1 Distribution of CWV

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)
CWV by condition
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


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.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.

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 = 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.

5.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 = 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


6. 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 
## -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.

6.2 Does Condition Predict Empathy?

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.

6.2b Does Condition Predict Schadenfreude?

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!

6.3 Visualize Emotion by Condition

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.

6.4 Do Emotions Predict Aggression (Stuns)?

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.

6.4b Do Emotions Predict Subjective Intent to Aggress?

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?

6.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.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.

6.6 CWV as Moderator of Condition → Empathy

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.

6.6b CWV as Moderator of Condition → Schadenfreude

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.

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 
## -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.

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.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

6.9 Mediation: Condition → Moral Outrage → Intent to Aggress

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.02601630  -0.08697254   0.13141524   0.536  
## ADE            -0.44741851  -0.92589444   0.00016418   0.052 .
## Total Effect   -0.42140221  -0.87856338   0.00353702   0.056 .
## Prop. Mediated -0.06173746  -0.58023889   0.39669299   0.576  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Sample Size Used: 171 
## 
## 
## Simulations: 500

6.10 Mediation: Condition → Empathy → Intent to Aggress

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.032951    -0.025004     0.122389   0.308  
## ADE            -0.454353    -0.886050    -0.022503   0.032 *
## Total Effect   -0.421402    -0.869972     0.015966   0.060 .
## Prop. Mediated -0.078194    -0.592830     0.179330   0.352  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Sample Size Used: 171 
## 
## 
## Simulations: 500

6.10b Mediation: Condition → Schadenfreude → Intent to Aggress

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.614341    -0.160039  <2e-16 ***
## ADE            -0.033888    -0.539362     0.455144   0.992    
## Total Effect   -0.421402    -0.877846     0.105450   0.128    
## Prop. Mediated  0.919583    -5.175074     6.400664   0.128    
## ---
## 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, are people being magnanimous?

## 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)
Low vs High CWV in Easy Mode: Magnanimity vs Painmaxxing
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…


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 
## -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

7.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 
## -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

7.3 Predictors of SDT Relatedness

m2c <- lm(sdt_relatedness ~ Player_score + opponent_perception + cond,
           data = df)
summary(m2c)
## 
## Call:
## lm(formula = sdt_relatedness ~ Player_score + opponent_perception + 
##     cond, data = df)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1.4711 -0.8413 -0.4272  0.4850  4.6823 
## 
## Coefficients:
##                     Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          2.12509    0.33775   6.292 2.65e-09 ***
## Player_score         0.01960    0.05222   0.375   0.7078    
## opponent_perception  0.02702    0.06871   0.393   0.6946    
## condhard            -0.43889    0.25447  -1.725   0.0864 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.308 on 167 degrees of freedom
## Multiple R-squared:  0.03382,    Adjusted R-squared:  0.01646 
## F-statistic: 1.948 on 3 and 167 DF,  p-value: 0.1237

In Pilot 2, opponent perception was a significant negative predictor of relatedness (b = -0.26, p = .007) and condition was significant (p = .030). Here both are null, with opponent perception essentially zero (b = 0.027, p = .695) and condition only trending (p = .086).

7.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 
## -1.5253 -0.8952 -0.3969  0.3972  4.6566 
## 
## Coefficients:
##                            Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                 2.24386    0.31687   7.081 3.85e-11 ***
## opponent_perception         0.01965    0.07031   0.279    0.780    
## open_c                     -0.28112    0.33700  -0.834    0.405    
## condhard                   -0.52005    0.20946  -2.483    0.014 *  
## opponent_perception:open_c  0.07026    0.06875   1.022    0.308    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.307 on 166 degrees of freedom
## Multiple R-squared:  0.04031,    Adjusted R-squared:  0.01718 
## F-statistic: 1.743 on 4 and 166 DF,  p-value: 0.1429
interact_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", "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%")
Pairwise correlations among key variables
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

8.1 Correlations Within Easy Mode

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%")
Pairwise correlations — Easy mode only
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

8.2 Correlations Within Hard Mode

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%")
Pairwise correlations — Hard mode only
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

## 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)
Behavioral outcomes by condition
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")

9.1 Behavioral Diversity by Condition

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)
Behavioral diversity by condition
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.


10. Exploratory: Surprised & Disappointed as Alternatives to Moral Outrage

10.1 Do Condition and CWV Predict Surprise and Disappointment?

# 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.

10.2 Do Surprised/Disappointed Predict Intent to Aggress?

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

10.3 Visualize Surprise and Disappointment by Condition

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()


11. Exploratory: Subjective Behavioral Intent as Aggression Measure

11.1 Intent by Condition

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()

11.2 CWV Moderation of Condition → Intent to Aggress

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()

11.3 Intent vs. Actual Behavior Comparison

# 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)
Correlations between intent and actual behavior by condition
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

12. SDT Consequences: Replay Intent

12.1 Play Again by Condition

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)
Play again by condition
Condition M SD
easy 3.54 1.91
hard 2.30 1.69

12.2 Does SDT Predict Wanting to Play Again?

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

12.3 Future Mode Preference

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)
Future mode preference by condition
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%

12.4 Future Aggression Intent by Condition

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)
Current vs future aggression intent by condition
Condition Intent Now M Intent Future M
easy 4.16 4.55
hard 3.74 4.16

13. People or Bot

13.1 Overall Breakdown

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)
Did participants think they were playing real people?
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!!

13.2 By Condition

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)
Belief about opponents by condition
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%

13.3 Does Belief Moderate Emotional Responses?

# 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.


14. Exploratory: Guilt Proneness (GP) as Alternative to CWV

14.1 GP Distribution and Reliability

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

14.2 GP as Moderator of Condition → Moral Outrage

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()

14.3 GP as Moderator of Condition → Empathy

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()

14.4 GP as Moderator of Condition → Schadenfreude

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()

14.5 GP as Moderator of Condition → Intent to Aggress

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!

14.6 GP vs CWV: Side-by-Side Comparison

# 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)
CWV vs GP-5 interaction coefficients across key models
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

15. 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