Competitive Jungle Game — Behavioral Variance Pilot
2026-07-02
library(qualtRics)
library(tidyverse)
library(psych)
library(knitr)
library(kableExtra)
library(ggcorrplot)
library(gridExtra)
library(scales)
library(mediation)
library(dplyr) # re-attach after mediation loads MASS1. Data Import & Cleaning
1.1 Load Data
raw <- read_survey(
"~/Google drive/My Drive/YEAR 3/PROJECTS/DANIEL/Competitive Jungle/CWV x Game/pilot5_data.csv"
)
cat("Raw N =", nrow(raw), "\n")## Raw N = 2221.2 Exclusions
# ── Manual exclusion IDs (add once open responses are reviewed) ───────────────
manual_exclusion_ids <- c(
"82D88B29D40F4C5A910237120499A0A7",
"1A7EA2A243BF467897CDCD8065FD980B"
)
## They said they could not play but didn't report a technical difficulty
df_flags <- raw %>%
mutate(
flag_bot = (Status != 0),
flag_recaptcha = (!is.na(Q_RecaptchaScore) & Q_RecaptchaScore < 0.5),
flag_attn = (!is.na(attn) & attn != 2), # correct = "Somewhat disagree"
flag_unfinished = (Finished != 1),
flag_manual = (participantId %in% manual_exclusion_ids),
# Tech issues — flagged but NOT auto-excluded; user reviews open responses
flag_tech_move = (!is.na(move_player) & move_player == 2),
flag_tech_other = (!is.na(other_player) & other_player == 2),
flag_any_tech = flag_tech_move | flag_tech_other
)
flag_summary <- df_flags %>%
summarise(
N_raw = n(),
N_bot = sum(flag_bot, na.rm = TRUE),
N_recaptcha = sum(flag_recaptcha, na.rm = TRUE),
N_attn_fail = sum(flag_attn, na.rm = TRUE),
N_unfinished = sum(flag_unfinished,na.rm = TRUE),
N_manual = sum(flag_manual, na.rm = TRUE),
N_tech_move = sum(flag_tech_move, na.rm = TRUE),
N_tech_other = sum(flag_tech_other,na.rm = TRUE)
)
kable(flag_summary,
caption = "Exclusion flag counts (tech flags are informational only)") %>%
kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)| N_raw | N_bot | N_recaptcha | N_attn_fail | N_unfinished | N_manual | N_tech_move | N_tech_other |
|---|---|---|---|---|---|---|---|
| 222 | 0 | 1 | 4 | 22 | 2 | 10 | 0 |
df <- df_flags %>%
filter(!flag_bot, !flag_recaptcha, !flag_attn,
!flag_unfinished, !flag_manual)
cat("N after exclusions =", nrow(df), "\n")## N after exclusions = 194cat("N flagged for technical issues (still in data) =",
sum(df$flag_any_tech, na.rm = TRUE), "\n")## N flagged for technical issues (still in data) = 101.3 Technical Issue Cases
df %>%
filter(flag_any_tech) %>%
dplyr::select(participantId, move_player, other_player,
open, feedback, Player_score, Player_shake_count) %>%
kable(caption = "Participants flagged for technical issues — review open responses") %>%
kable_styling(bootstrap_options = c("striped", "hover"), full_width = TRUE)| participantId | move_player | other_player | open | feedback | Player_score | Player_shake_count |
|---|---|---|---|---|---|---|
| DF56CA016588470CA7FFDB675D3021DD | 2 | 1 | I couldn’t move, I could only jump. It was a bummer | NA | 0 | 0 |
| 352F50BB940746CDBA37845760C42016 | 2 | 1 | My experience was good once I figured out how long it might take to shake a tree to get fruit. It seemed easier to keep an eye on what the other person was doing and go to their hut for fruit if the tree was taking a long time, but it was fun. | NA | 9 | 65 |
| 335641BBC0B246888FBAC9A94A8A7AA1 | 2 | 1 | It was pretty easy, annoying when they’d steal fruit from my hut but I usually got it back. | NA | 9 | 67 |
| B28F717D6E56496791CC7C51E8516DE4 | 2 | 1 | I could not move my character. The arrows on my keyboard did nothing. I am on a MacBook so not sure if that is the reason. | The only problem I had was that I could not move my character in the game. | 0 | 0 |
| 8F0DEA30918646299340E0018A729C96 | 2 | 1 | Once i figured out how to move and how to position myself relative to the tree, I found that I came from 3 or 4 fruits behind to be able to catch up and have one more fruit than my opponent AJ | Interesting and fun at the same time, nice break from some of the other surveys. | 9 | 37 |
| 5B82BC83BA134ABFADC2C08E3ABAF7C7 | 2 | 1 | I thought the game was quite fun and interesting. I thought it was also nice that my opponent was not so competitive or rude. | NA | 6 | 55 |
| 2944177FE2174A63B36D1DB9F41C78DE | 2 | 1 | I had a great experience playing the game. I would play it again. The only thing is that being able to only carry one fruit at a time makes it more difficult especially when you get behind. | I enjoyed the study; the game was entertaining. I did not have any issues, problems, or concerns. Thank you for allowing me to participate. | 6 | 54 |
| B0DE645961FE41D1AE4B437A371FE709 | 2 | 1 | I found it very frustrating as I was unable to move my player. I don’t think instructions on movement were provided. | NA | 0 | 0 |
| 4471729A8C2346E4A2706766FB660750 | 2 | 1 | I couldn’t move at all. I tried the arrow keys, the space bar, every other key, and it didn’t work. | NA | 0 | 0 |
| C12729A42845477FAE86A41DD3FF6393 | 2 | 1 | It was a little stressful figuring it out at first and getting stunned by the opponent, but I got pretty ok at it fast. It still seemed unfair that their hut was closer than mine but that’s ok! | NA | 12 | 54 |
1.3b Post-Review Exclusions
# After manually reviewing open responses, exclude:
# (1) Participants who said they could move but have zero score AND zero shakes
# — likely an unreported technical issue or that they just stood still the whole time
# (2) Participants who said they could not move and got zero on all behavioral
# outcomes — confirmed technical failure
pre_n <- nrow(df)
df <- df %>%
filter(
# Unreported tech issue
!(move_player == 1 & as.numeric(Player_score) == 0 &
as.numeric(Player_shake_count) == 0),
# Confirmed tech issue with zero behavioral data
!(move_player == 2 & as.numeric(Player_score) == 0 &
as.numeric(Player_shake_count) == 0 &
as.numeric(Player_stuns_Attacker) == 0 &
as.numeric(Player_steals_Attacker) == 0 &
as.numeric(Player_raids_hut) == 0)
)
cat("N removed:", pre_n - nrow(df), "\n")## N removed: 4cat("N after post-review exclusions =", nrow(df), "\n")## N after post-review exclusions = 1901.4 Scoring & Variable Creation
# ── SVO Slider Scoring ────────────────────────────────────────────────────────
# Items recoded in Qualtrics to positions 1-9 (A=1 ... I=9)
# Map each position to (you, other) payoff values, then compute angle
svo_payoffs <- list(
item1 = tibble(pos = 1:9,
you = c(85,85,85,85,85,85,85,85,85),
other = c(85,76,68,59,50,41,33,24,15)),
item2 = tibble(pos = 1:9,
you = c(85,87,89,91,93,94,96,98,100),
other = c(15,19,24,28,33,37,41,46,50)),
item3 = tibble(pos = 1:9,
you = c(50,54,59,63,68,72,76,81,85),
other = c(100,98,96,94,93,91,89,87,85)),
item4 = tibble(pos = 1:9,
you = c(50,54,59,63,68,72,76,81,85),
other = c(100,89,79,68,58,47,36,26,15)),
item5 = tibble(pos = 1:9,
you = c(100,94,88,81,75,69,63,56,50),
other = c(50,56,63,69,75,81,88,94,100)),
item6 = tibble(pos = 1:9,
you = c(100,98,96,94,93,91,89,87,85),
other = c(50,54,59,63,68,72,76,81,85))
)
get_payoff <- function(pos, item_num, type) {
pos <- as.integer(pos)
payoffs <- svo_payoffs[[paste0("item", item_num)]]
row <- payoffs[payoffs$pos == pos, ]
if (nrow(row) == 0) return(NA_real_)
row[[type]]
}
df <- df %>%
rowwise() %>%
mutate(
svo1_you = get_payoff(SVO_1, 1, "you"),
svo1_other = get_payoff(SVO_1, 1, "other"),
svo2_you = get_payoff(SVO_2, 2, "you"),
svo2_other = get_payoff(SVO_2, 2, "other"),
svo3_you = get_payoff(SVO_3, 3, "you"),
svo3_other = get_payoff(SVO_3, 3, "other"),
svo4_you = get_payoff(SVO_4, 4, "you"),
svo4_other = get_payoff(SVO_4, 4, "other"),
svo5_you = get_payoff(SVO_5, 5, "you"),
svo5_other = get_payoff(SVO_5, 5, "other"),
svo6_you = get_payoff(SVO_6, 6, "you"),
svo6_other = get_payoff(SVO_6, 6, "other"),
svo_mean_you = mean(c(svo1_you, svo2_you, svo3_you,
svo4_you, svo5_you, svo6_you), na.rm = TRUE),
svo_mean_other = mean(c(svo1_other, svo2_other, svo3_other,
svo4_other, svo5_other, svo6_other), na.rm = TRUE),
# SVO angle: >57.15 = Altruistic, 22.45-57.15 = Prosocial,
# -12.04-22.45 = Individualistic, < -12.04 = Competitive
svo_angle = atan((svo_mean_other - 50) / (svo_mean_you - 50)) * (180 / pi)
) %>%
ungroup() %>%
mutate(
svo_type = factor(case_when(
svo_angle > 57.15 ~ "Altruistic",
svo_angle > 22.45 ~ "Prosocial",
svo_angle > -12.04 ~ "Individualistic",
!is.na(svo_angle) ~ "Competitive",
TRUE ~ NA_character_
), levels = c("Competitive", "Individualistic", "Prosocial", "Altruistic")),
# ── Spite (recoded in Qualtrics to 1-7) ──────────────────────────────────
spite = rowMeans(cbind(as.numeric(spite_1), as.numeric(spite_2),
as.numeric(spite_3), as.numeric(spite_4)),
na.rm = TRUE),
# ── Guilt Proneness ───────────────────────────────────────────────────────
gp = rowMeans(cbind(as.numeric(GP_1), as.numeric(GP_2), as.numeric(GP_3),
as.numeric(GP_4), as.numeric(GP_5)), na.rm = TRUE),
# ── Honesty-Humility (reverse items 2,4,5,7,8,10) ────────────────────────
hh_2 = 8 - as.numeric(hh_2R),
hh_4 = 8 - as.numeric(hh_4R),
hh_5 = 8 - as.numeric(hh_5R),
hh_7 = 8 - as.numeric(hh_7R),
hh_8 = 8 - as.numeric(hh_8R),
hh_10 = 8 - as.numeric(hh_10R),
hh = rowMeans(cbind(as.numeric(hh_1), hh_2, as.numeric(hh_3), hh_4,
hh_5, as.numeric(hh_6), hh_7, hh_8,
as.numeric(hh_9), hh_10), na.rm = TRUE),
# ── CWV (reverse items 2,5,7,9,10) ───────────────────────────────────────
cwv_2 = 8 - as.numeric(CWV_2R),
cwv_5 = 8 - as.numeric(CWV_5R),
cwv_7 = 8 - as.numeric(CWV_7R),
cwv_9 = 8 - as.numeric(CWV_9R),
cwv_10 = 8 - as.numeric(CWV_10R),
cwv = rowMeans(cbind(as.numeric(CWV_1), cwv_2, as.numeric(CWV_3),
as.numeric(CWV_4), cwv_5, as.numeric(CWV_6),
cwv_7, as.numeric(CWV_8), cwv_9, cwv_10),
na.rm = TRUE),
# ── TIPI (reverse items 2,4,6,8,10) ──────────────────────────────────────
tipi_extra_6r = 8 - as.numeric(Extraversion_6R),
tipi_agree_2r = 8 - as.numeric(Agreeable_2R),
tipi_consc_8r = 8 - as.numeric(Conscientious_8R),
tipi_emosta_4r = 8 - as.numeric(EmoStability_4R),
tipi_open_10r = 8 - as.numeric(Open_10R),
tipi_extraversion = (as.numeric(Extraversion_1) + tipi_extra_6r) / 2,
tipi_agreeableness = (as.numeric(Agreeable_7) + tipi_agree_2r) / 2,
tipi_conscientiousness = (as.numeric(Conscientious_3) + tipi_consc_8r) / 2,
tipi_emo_stability = (as.numeric(EmoStability_9) + tipi_emosta_4r)/ 2,
tipi_openness = (as.numeric(Open_5) + tipi_open_10r) / 2,
# ── Single items ──────────────────────────────────────────────────────────
narcissism = as.numeric(narcissism),
sadism = as.numeric(sadism_6),
# ── Behavioral composites ─────────────────────────────────────────────────
noninstr_aggression = as.numeric(Player_stuns_Attacker),
instr_aggression = as.numeric(Player_steals_Attacker),
total_player_agg = noninstr_aggression + instr_aggression +
as.numeric(Player_raids_hut),
shake_count = as.numeric(Player_shake_count),
player_score = as.numeric(Player_score),
enemy_score = as.numeric(Enemy_score),
score_diff = player_score - enemy_score,
# ── Subjective intent ─────────────────────────────────────────────────────
intent_steal_n = as.numeric(intent_steal),
intent_stun_n = as.numeric(intent_stun),
intent_produce_n = as.numeric(intent_produce),
intent_protect_n = as.numeric(intent_protect),
intent_agg = rowMeans(cbind(intent_steal_n, intent_stun_n), na.rm = TRUE),
subj_intent_1 = as.numeric(subj_intent_1),
subj_intent_2 = as.numeric(subj_intent_2),
subj_intent_3 = as.numeric(subj_intent_3),
# ── Experience & emotions ─────────────────────────────────────────────────
positive_n = as.numeric(positive),
play_again_n = as.numeric(play_again),
challenged_n = as.numeric(challenged),
threatened_n = as.numeric(threatened),
bored_n = as.numeric(bored),
engaged_n = as.numeric(engaged),
angry_n = as.numeric(angry),
frustrated_n = as.numeric(frustrated),
sad_n = as.numeric(sad),
guilty_n = as.numeric(guilty),
happy_n = as.numeric(happy),
# ── Centered predictors for models ────────────────────────────────────────
gp_c = as.numeric(scale(gp)),
hh_c = as.numeric(scale(hh)),
cwv_c = as.numeric(scale(cwv)),
spite_c = as.numeric(scale(spite)),
svo_c = as.numeric(scale(svo_angle)),
narc_c = as.numeric(scale(narcissism)),
sadism_c = as.numeric(scale(sadism)),
agree_c = as.numeric(scale(tipi_agreeableness)),
# ── Demographics ──────────────────────────────────────────────────────────
gender_label = case_when(
gender == 1 ~ "Male", gender == 2 ~ "Female",
gender == 3 ~ "Non-binary", TRUE ~ "Other/NR"
),
game_freq_label = factor(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_
), levels = c("Never","< Once/month","Few times/month",
"Few times/week","Daily/almost daily"))
)2. Sample Overview
2.1 Demographics
demo_summary <- df %>%
summarise(
N = n(),
Age_M = round(mean(as.numeric(age), na.rm = TRUE), 1),
Age_SD = round(sd(as.numeric(age), na.rm = TRUE), 1),
Pct_Female = paste0(round(mean(gender == 2, na.rm = TRUE) * 100, 1), "%"),
Pct_Male = paste0(round(mean(gender == 1, na.rm = TRUE) * 100, 1), "%"),
N_Tech_Issue = sum(flag_any_tech, na.rm = TRUE)
)
kable(demo_summary, caption = "Sample summary") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)| N | Age_M | Age_SD | Pct_Female | Pct_Male | N_Tech_Issue |
|---|---|---|---|---|---|
| 190 | 41.7 | 11.8 | 56.8% | 42.1% | 6 |
df %>%
count(gender_label) %>%
mutate(pct = percent(n / sum(n), 1)) %>%
kable(col.names = c("Gender", "N", "%")) %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)| Gender | N | % |
|---|---|---|
| Female | 108 | 57% |
| Male | 80 | 42% |
| Non-binary | 1 | 1% |
| Other/NR | 1 | 1% |
2.2 Gaming Experience
p1 <- 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") +
labs(title = "Gaming Frequency", x = NULL, y = "N") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 30, hjust = 1))
p2 <- df %>%
count(skill_level) %>%
ggplot(aes(x = factor(skill_level), y = n)) +
geom_col(fill = "#6BAE75") +
scale_x_discrete(labels = c("Far\nbelow","Below","Slightly\nbelow",
"Average","Slightly\nabove","Above","Far\nabove")) +
labs(title = "Self-Rated Skill Level", x = NULL, y = "N") +
theme_minimal()
grid.arrange(p1, p2, ncol = 2)
df %>%
dplyr::select(game_frequency, skill_level, player_score, shake_count,
noninstr_aggression, instr_aggression, Player_raids_hut) %>%
mutate(across(everything(), as.numeric)) %>%
cor(use = "pairwise.complete.obs") %>%
round(2) %>%
kable(caption = "Gaming experience × behavioral outcomes correlations") %>%
kable_styling(bootstrap_options = c("striped","condensed"), full_width = FALSE)| game_frequency | skill_level | player_score | shake_count | noninstr_aggression | instr_aggression | Player_raids_hut | |
|---|---|---|---|---|---|---|---|
| game_frequency | 1.00 | 0.67 | 0.22 | 0.07 | 0.25 | 0.04 | -0.05 |
| skill_level | 0.67 | 1.00 | 0.39 | 0.13 | 0.21 | 0.12 | -0.09 |
| player_score | 0.22 | 0.39 | 1.00 | 0.45 | -0.06 | 0.32 | -0.07 |
| shake_count | 0.07 | 0.13 | 0.45 | 1.00 | -0.21 | -0.14 | -0.33 |
| noninstr_aggression | 0.25 | 0.21 | -0.06 | -0.21 | 1.00 | 0.13 | -0.18 |
| instr_aggression | 0.04 | 0.12 | 0.32 | -0.14 | 0.13 | 1.00 | -0.28 |
| Player_raids_hut | -0.05 | -0.09 | -0.07 | -0.33 | -0.18 | -0.28 | 1.00 |
3. Scale Reliability & Descriptives
3.1 Cronbach’s Alpha
alphas <- list(
"Guilt Proneness (GP-5)" = df %>% dplyr::select(GP_1, GP_2, GP_3, GP_4, GP_5),
"Competitive Worldview (CWV)" = df %>% dplyr::select(CWV_1, cwv_2, CWV_3, CWV_4,
cwv_5, CWV_6, cwv_7, CWV_8,
cwv_9, cwv_10),
"Honesty-Humility (HH-10)" = df %>% dplyr::select(hh_1, hh_2, hh_3, hh_4, hh_5,
hh_6, hh_7, hh_8, hh_9, hh_10),
"Spite (4-item)" = df %>% dplyr::select(spite_1, spite_2,
spite_3, spite_4)
)
alpha_table <- map_dfr(alphas, function(items) {
a <- psych::alpha(items %>% mutate(across(everything(), as.numeric)),
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 multi-item scales") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)| Scale | Cronbach’s α | N Items |
|---|---|---|
| Guilt Proneness (GP-5) | 0.816 | 5 |
| Competitive Worldview (CWV) | 0.842 | 10 |
| Honesty-Humility (HH-10) | 0.816 | 10 |
| Spite (4-item) | 0.852 | 4 |
3.2 Individual Difference Descriptives
df %>%
dplyr::select(gp, cwv, hh, spite, svo_angle, narcissism, sadism,
tipi_extraversion, tipi_agreeableness,
tipi_conscientiousness, tipi_emo_stability, tipi_openness) %>%
pivot_longer(everything(), names_to = "Variable", values_to = "Value") %>%
group_by(Variable) %>%
summarise(
M = round(mean(as.numeric(Value), na.rm = TRUE), 2),
SD = round(sd(as.numeric(Value), na.rm = TRUE), 2),
Min = round(min(as.numeric(Value), na.rm = TRUE), 2),
Max = round(max(as.numeric(Value), na.rm = TRUE), 2),
.groups = "drop"
) %>%
kable(caption = "Individual difference descriptives") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)| Variable | M | SD | Min | Max |
|---|---|---|---|---|
| cwv | 2.64 | 0.94 | 1.00 | 7.00 |
| gp | 3.98 | 0.80 | 1.00 | 5.00 |
| hh | 4.85 | 1.11 | 1.60 | 7.00 |
| narcissism | 1.77 | 1.12 | 1.00 | 7.00 |
| sadism | 1.40 | 0.83 | 1.00 | 7.00 |
| spite | 2.22 | 1.31 | 1.00 | 7.00 |
| svo_angle | 26.80 | 13.56 | -16.26 | 61.39 |
| tipi_agreeableness | 5.25 | 1.26 | 1.00 | 7.00 |
| tipi_conscientiousness | 5.38 | 1.43 | 1.00 | 7.00 |
| tipi_emo_stability | 4.46 | 1.66 | 1.00 | 7.00 |
| tipi_extraversion | 3.20 | 1.67 | 1.00 | 7.00 |
| tipi_openness | 5.03 | 1.26 | 1.50 | 7.00 |
3.3 SVO Distribution
df %>%
filter(!is.na(svo_type)) %>%
count(svo_type) %>%
mutate(pct = n / sum(n)) %>%
ggplot(aes(x = svo_type, y = pct, fill = svo_type)) +
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, 0.8)) +
scale_fill_manual(values = c("Competitive" = "#E07B54",
"Individualistic" = "#F0C274",
"Prosocial" = "#6BAE75",
"Altruistic" = "#5B8DB8")) +
labs(title = "SVO Type Distribution", x = NULL, y = "Proportion") +
theme_minimal()
ggplot(df, aes(x = svo_angle)) +
geom_histogram(bins = 25, fill = "#5B8DB8", color = "white") +
geom_vline(xintercept = c(-12.04, 22.45, 57.15),
linetype = "dashed", color = "#E07B54") +
annotate("text", x = c(-20, 5, 40, 65), y = Inf, vjust = 1.5, size = 3,
label = c("Competitive","Individual.","Prosocial","Altruistic")) +
labs(title = "SVO Angle Distribution",
x = "SVO Angle (degrees)", y = "Count") +
theme_minimal()
I have never worked with SVO but I guess this is normal?
4. Behavioral Outcomes
4.1 Distributions
df %>%
dplyr::select(player_score, noninstr_aggression, instr_aggression,
Player_raids_hut, shake_count, enemy_score,
Attacker_stuns_Player, Attacker_steals_Player,
Attacker_raids_hut, Attacker_shake_count) %>%
mutate(across(everything(), as.numeric)) %>%
pivot_longer(everything(), names_to = "Variable", values_to = "Value") %>%
mutate(Variable = recode(Variable,
"player_score" = "Player Score",
"noninstr_aggression" = "Non-Instr. Stuns",
"instr_aggression" = "Instr. Steals",
"Player_raids_hut" = "Player Raids",
"shake_count" = "Shake Count",
"enemy_score" = "Enemy Score",
"Attacker_stuns_Player" = "Attacker Stuns",
"Attacker_steals_Player" = "Attacker Steals",
"Attacker_raids_hut" = "Attacker Raids",
"Attacker_shake_count" = "Attacker Shakes"
)) %>%
ggplot(aes(x = as.numeric(Value))) +
geom_histogram(bins = 20, fill = "#5B8DB8", color = "white") +
facet_wrap(~Variable, scales = "free", ncol = 4) +
labs(title = "Behavioral Outcome Distributions", x = "Value", y = "Count") +
theme_minimal(base_size = 10)
4.2 Descriptive Statistics
df %>%
dplyr::select(player_score, noninstr_aggression, instr_aggression,
Player_raids_hut, shake_count, total_player_agg,
enemy_score, score_diff,
Attacker_stuns_Player, Attacker_steals_Player,
Attacker_raids_hut, Attacker_shake_count) %>%
mutate(across(everything(), as.numeric)) %>%
summarise(across(everything(),
list(M = ~round(mean(., na.rm = TRUE), 2),
SD = ~round(sd(., na.rm = TRUE), 2)),
.names = "{.col}_{.fn}")) %>%
pivot_longer(everything(),
names_to = c("Variable","stat"), names_sep = "_(?=[MS])") %>%
pivot_wider(names_from = stat, values_from = value) %>%
kable(col.names = c("Variable","M","SD"),
caption = "Behavioral outcome descriptives") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)| Variable | M | SD |
|---|---|---|
| player_score | 8.01 | 3.22 |
| noninstr_aggression | 8.23 | 5.40 |
| instr_aggression | 3.23 | 2.99 |
| Player_raids_hut | 1.93 | 2.11 |
| shake_count | 40.47 | 23.52 |
| total_player_agg | 13.39 | 6.24 |
| enemy_score | 4.34 | 2.93 |
| score_diff | 3.67 | 4.65 |
| Attacker_stuns_Player | 3.29 | 2.48 |
| Attacker_steals_Player | 2.90 | 2.12 |
| Attacker_raids_hut | 1.33 | 1.57 |
| Attacker_shake_count | 47.61 | 20.49 |
cat("Proportion of zeros:\n")## Proportion of zeros:df %>%
dplyr::select(noninstr_aggression, instr_aggression, Player_raids_hut) %>%
mutate(across(everything(), as.numeric)) %>%
summarise(across(everything(), ~round(mean(. == 0, na.rm = TRUE), 3))) %>%
print()## # A tibble: 1 × 3
## noninstr_aggression instr_aggression Player_raids_hut
## <dbl> <dbl> <dbl>
## 1 0.021 0.179 0.3634.3 Player vs. Attacker Behavior
compare_df <- tibble(
Actor = rep(c("Player","Attacker"), each = 3),
Behavior = rep(c("Stuns (non-instr.)","Steals (instr.)","Raids"), 2),
M = c(
mean(df$noninstr_aggression, na.rm = TRUE),
mean(df$instr_aggression, na.rm = TRUE),
mean(as.numeric(df$Player_raids_hut), na.rm = TRUE),
mean(as.numeric(df$Attacker_stuns_Player), na.rm = TRUE),
mean(as.numeric(df$Attacker_steals_Player), na.rm = TRUE),
mean(as.numeric(df$Attacker_raids_hut), na.rm = TRUE)
),
SE = c(
sd(df$noninstr_aggression, na.rm = TRUE) / sqrt(nrow(df)),
sd(df$instr_aggression, na.rm = TRUE) / sqrt(nrow(df)),
sd(as.numeric(df$Player_raids_hut), na.rm = TRUE) / sqrt(nrow(df)),
sd(as.numeric(df$Attacker_stuns_Player), na.rm = TRUE) / sqrt(nrow(df)),
sd(as.numeric(df$Attacker_steals_Player), na.rm = TRUE) / sqrt(nrow(df)),
sd(as.numeric(df$Attacker_raids_hut), na.rm = TRUE) / sqrt(nrow(df))
)
)
ggplot(compare_df, aes(x = Behavior, y = M, fill = Actor)) +
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("Player" = "#5B8DB8", "Attacker" = "#E07B54")) +
labs(title = "Player vs. Attacker Behavior",
subtitle = "Error bars = ±1 SE", x = NULL, y = "Mean Count") +
theme_minimal()
cat("\n--- Shake count: player vs. attacker (paired t-test) ---\n")##
## --- Shake count: player vs. attacker (paired t-test) ---t.test(as.numeric(df$Player_shake_count),
as.numeric(df$Attacker_shake_count), paired = TRUE)##
## Paired t-test
##
## data: as.numeric(df$Player_shake_count) and as.numeric(df$Attacker_shake_count)
## t = -2.8666, df = 189, p-value = 0.00462
## alternative hypothesis: true mean difference is not equal to 0
## 95 percent confidence interval:
## -12.047951 -2.225733
## sample estimates:
## mean difference
## -7.136842Participants are engaging in many more stuns (non instrumental aggression) than the NPC
5. Individual Differences × Behavioral Outcomes
5.1 Full Correlation Matrix
cor_df <- df %>%
dplyr::select(
# Objective behavioral outcomes
player_score, noninstr_aggression, instr_aggression,
Player_raids_hut, shake_count, score_diff,
# Behavioral intent
intent_steal_n, intent_stun_n, intent_protect_n, intent_produce_n,
subj_intent_1, subj_intent_2, subj_intent_3,
# Emotions & experience
positive_n, play_again_n, challenged_n, threatened_n, bored_n,
engaged_n, angry_n, frustrated_n, sad_n, guilty_n, happy_n,
# Individual differences
gp, cwv, hh, spite, svo_angle, narcissism, sadism,
tipi_agreeableness, tipi_conscientiousness,
tipi_extraversion, tipi_emo_stability, tipi_openness,
# Gaming experience
game_frequency, skill_level
) %>%
mutate(across(everything(), as.numeric))
names(cor_df) <- c(
# Objective
"Score","Non-Instr. Stuns","Instr. Steals","Raids","Shakes","Score Diff",
# Subjective intent
"Intent Steal","Intent Stun","Intent Protect","Intent Produce",
"Subj: Individualistic","Subj: Competitive","Subj: Prosocial",
# Emotions & experience
"Positive","Play Again","Challenged","Threatened","Bored",
"Engaged","Angry","Frustrated","Sad","Guilty","Happy",
# Individual differences
"GP","CWV","HH","Spite","SVO","Narcissism","Sadism",
"Agreeableness","Conscientiousness","Extraversion","Emo. Stability","Openness",
# Gaming
"Game Freq.","Skill Level"
)
cor_mat <- cor(cor_df, use = "pairwise.complete.obs")
cor_mat %>%
round(2) %>%
kable(caption = "Full correlation matrix") %>%
kable_styling(bootstrap_options = c("striped","condensed"),
font_size = 9, full_width = TRUE) %>%
scroll_box(width = "100%", height = "500px")| Score | Non-Instr. Stuns | Instr. Steals | Raids | Shakes | Score Diff | Intent Steal | Intent Stun | Intent Protect | Intent Produce | Subj: Individualistic | Subj: Competitive | Subj: Prosocial | Positive | Play Again | Challenged | Threatened | Bored | Engaged | Angry | Frustrated | Sad | Guilty | Happy | GP | CWV | HH | Spite | SVO | Narcissism | Sadism | Agreeableness | Conscientiousness | Extraversion | Emo. Stability | Openness | Game Freq. | Skill Level | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Score | 1.00 | -0.06 | 0.32 | -0.07 | 0.45 | 0.78 | 0.25 | 0.10 | -0.14 | 0.36 | -0.05 | 0.42 | -0.07 | 0.29 | 0.07 | -0.36 | -0.17 | 0.06 | 0.11 | -0.28 | -0.45 | -0.20 | 0.09 | 0.22 | -0.03 | -0.04 | -0.02 | 0.03 | 0.04 | 0.00 | 0.00 | -0.11 | 0.05 | -0.11 | 0.01 | 0.16 | 0.22 | 0.39 |
| Non-Instr. Stuns | -0.06 | 1.00 | 0.13 | -0.18 | -0.21 | 0.24 | 0.17 | 0.57 | -0.12 | -0.04 | -0.09 | 0.00 | -0.12 | -0.06 | -0.06 | -0.11 | 0.14 | 0.19 | -0.11 | -0.06 | -0.13 | 0.02 | 0.02 | 0.04 | 0.08 | -0.10 | 0.12 | -0.03 | -0.01 | -0.05 | -0.01 | -0.10 | 0.01 | -0.09 | 0.13 | 0.06 | 0.25 | 0.21 |
| Instr. Steals | 0.32 | 0.13 | 1.00 | -0.28 | -0.14 | 0.41 | 0.53 | 0.19 | -0.21 | -0.09 | -0.19 | 0.11 | -0.17 | 0.08 | 0.01 | -0.13 | 0.01 | 0.12 | -0.01 | -0.03 | -0.09 | -0.03 | -0.05 | 0.02 | -0.01 | 0.03 | -0.06 | 0.16 | -0.06 | 0.01 | 0.07 | -0.08 | 0.03 | 0.00 | 0.02 | 0.10 | 0.04 | 0.12 |
| Raids | -0.07 | -0.18 | -0.28 | 1.00 | -0.33 | 0.21 | 0.03 | -0.01 | 0.71 | -0.36 | -0.16 | 0.29 | -0.22 | 0.08 | 0.06 | -0.10 | -0.11 | -0.08 | 0.07 | -0.16 | -0.19 | -0.05 | 0.07 | 0.07 | -0.11 | 0.01 | -0.08 | -0.06 | -0.12 | -0.07 | -0.04 | -0.07 | -0.02 | -0.05 | -0.02 | -0.09 | -0.05 | -0.09 |
| Shakes | 0.45 | -0.21 | -0.14 | -0.33 | 1.00 | 0.02 | -0.20 | -0.21 | -0.39 | 0.56 | 0.17 | 0.05 | 0.15 | 0.11 | -0.04 | 0.05 | 0.03 | -0.02 | 0.16 | 0.10 | 0.02 | -0.03 | -0.01 | 0.14 | 0.05 | -0.04 | 0.07 | -0.06 | 0.08 | 0.05 | -0.01 | 0.08 | -0.04 | 0.06 | -0.07 | 0.08 | 0.07 | 0.13 |
| Score Diff | 0.78 | 0.24 | 0.41 | 0.21 | 0.02 | 1.00 | 0.44 | 0.36 | 0.14 | 0.05 | -0.17 | 0.51 | -0.24 | 0.27 | 0.02 | -0.45 | -0.14 | 0.16 | 0.00 | -0.35 | -0.53 | -0.17 | 0.08 | 0.18 | -0.07 | -0.06 | -0.04 | 0.07 | -0.04 | -0.01 | 0.07 | -0.18 | 0.07 | -0.16 | 0.06 | 0.12 | 0.29 | 0.42 |
| Intent Steal | 0.25 | 0.17 | 0.53 | 0.03 | -0.20 | 0.44 | 1.00 | 0.44 | 0.27 | -0.02 | -0.21 | 0.33 | -0.20 | 0.16 | 0.12 | -0.15 | -0.03 | 0.04 | -0.03 | -0.20 | -0.26 | -0.09 | -0.03 | 0.11 | -0.06 | 0.08 | -0.08 | 0.07 | 0.01 | 0.06 | 0.04 | -0.09 | -0.06 | -0.03 | 0.04 | 0.15 | 0.13 | 0.21 |
| Intent Stun | 0.10 | 0.57 | 0.19 | -0.01 | -0.21 | 0.36 | 0.44 | 1.00 | 0.24 | 0.01 | -0.15 | 0.26 | -0.24 | 0.11 | 0.09 | -0.08 | -0.02 | 0.02 | -0.01 | -0.15 | -0.22 | -0.17 | -0.07 | 0.14 | 0.03 | -0.08 | 0.10 | 0.04 | 0.05 | -0.02 | -0.01 | -0.09 | -0.01 | -0.02 | 0.17 | 0.16 | 0.25 | 0.27 |
| Intent Protect | -0.14 | -0.12 | -0.21 | 0.71 | -0.39 | 0.14 | 0.27 | 0.24 | 1.00 | -0.31 | -0.16 | 0.27 | -0.28 | 0.12 | 0.09 | -0.01 | -0.17 | -0.14 | 0.03 | -0.16 | -0.17 | -0.15 | -0.06 | 0.13 | -0.16 | 0.12 | -0.08 | 0.02 | -0.13 | -0.02 | 0.06 | -0.12 | 0.00 | -0.03 | 0.01 | -0.01 | 0.01 | -0.05 |
| Intent Produce | 0.36 | -0.04 | -0.09 | -0.36 | 0.56 | 0.05 | -0.02 | 0.01 | -0.31 | 1.00 | 0.31 | 0.08 | 0.16 | 0.09 | 0.11 | -0.02 | -0.10 | -0.04 | 0.08 | -0.06 | -0.07 | -0.12 | -0.06 | 0.05 | 0.11 | -0.11 | 0.15 | -0.06 | 0.11 | 0.00 | -0.15 | 0.09 | -0.01 | 0.07 | 0.00 | 0.21 | 0.18 | 0.22 |
| Subj: Individualistic | -0.05 | -0.09 | -0.19 | -0.16 | 0.17 | -0.17 | -0.21 | -0.15 | -0.16 | 0.31 | 1.00 | -0.03 | 0.20 | 0.05 | 0.06 | 0.09 | -0.07 | -0.10 | 0.02 | 0.00 | 0.04 | 0.02 | -0.13 | -0.02 | -0.08 | -0.04 | 0.06 | 0.04 | 0.04 | -0.01 | 0.04 | 0.06 | 0.11 | -0.01 | 0.10 | 0.02 | -0.14 | -0.09 |
| Subj: Competitive | 0.42 | 0.00 | 0.11 | 0.29 | 0.05 | 0.51 | 0.33 | 0.26 | 0.27 | 0.08 | -0.03 | 1.00 | -0.15 | 0.36 | 0.14 | -0.05 | -0.06 | -0.09 | 0.22 | -0.19 | -0.39 | -0.15 | 0.09 | 0.32 | 0.00 | -0.05 | -0.06 | -0.02 | -0.05 | -0.01 | 0.01 | -0.02 | 0.03 | -0.04 | 0.05 | 0.01 | 0.12 | 0.23 |
| Subj: Prosocial | -0.07 | -0.12 | -0.17 | -0.22 | 0.15 | -0.24 | -0.20 | -0.24 | -0.28 | 0.16 | 0.20 | -0.15 | 1.00 | -0.07 | 0.11 | 0.06 | -0.03 | -0.06 | -0.10 | 0.14 | 0.15 | 0.15 | 0.18 | -0.11 | 0.05 | 0.07 | -0.04 | 0.03 | 0.15 | 0.10 | 0.07 | 0.02 | -0.08 | -0.01 | -0.06 | -0.05 | 0.05 | 0.03 |
| Positive | 0.29 | -0.06 | 0.08 | 0.08 | 0.11 | 0.27 | 0.16 | 0.11 | 0.12 | 0.09 | 0.05 | 0.36 | -0.07 | 1.00 | 0.63 | 0.18 | -0.11 | -0.54 | 0.41 | -0.28 | -0.39 | -0.29 | 0.05 | 0.67 | 0.04 | -0.07 | -0.02 | 0.01 | 0.07 | -0.07 | -0.03 | 0.22 | 0.23 | 0.02 | 0.07 | 0.05 | 0.11 | 0.15 |
| Play Again | 0.07 | -0.06 | 0.01 | 0.06 | -0.04 | 0.02 | 0.12 | 0.09 | 0.09 | 0.11 | 0.06 | 0.14 | 0.11 | 0.63 | 1.00 | 0.27 | -0.07 | -0.59 | 0.39 | -0.17 | -0.26 | -0.22 | 0.00 | 0.59 | 0.05 | -0.05 | 0.01 | -0.02 | 0.04 | 0.04 | -0.09 | 0.23 | 0.11 | 0.05 | 0.06 | 0.02 | 0.05 | 0.05 |
| Challenged | -0.36 | -0.11 | -0.13 | -0.10 | 0.05 | -0.45 | -0.15 | -0.08 | -0.01 | -0.02 | 0.09 | -0.05 | 0.06 | 0.18 | 0.27 | 1.00 | 0.29 | -0.39 | 0.35 | 0.29 | 0.32 | 0.06 | -0.02 | 0.21 | 0.15 | 0.01 | 0.07 | -0.08 | -0.02 | 0.13 | -0.02 | 0.19 | -0.07 | 0.24 | 0.00 | -0.04 | -0.14 | -0.24 |
| Threatened | -0.17 | 0.14 | 0.01 | -0.11 | 0.03 | -0.14 | -0.03 | -0.02 | -0.17 | -0.10 | -0.07 | -0.06 | -0.03 | -0.11 | -0.07 | 0.29 | 1.00 | 0.07 | 0.02 | 0.46 | 0.38 | 0.29 | 0.22 | -0.12 | -0.04 | 0.08 | -0.09 | 0.03 | -0.12 | 0.16 | 0.14 | -0.12 | -0.22 | 0.08 | -0.23 | -0.19 | -0.06 | -0.17 |
| Bored | 0.06 | 0.19 | 0.12 | -0.08 | -0.02 | 0.16 | 0.04 | 0.02 | -0.14 | -0.04 | -0.10 | -0.09 | -0.06 | -0.54 | -0.59 | -0.39 | 0.07 | 1.00 | -0.40 | 0.13 | 0.09 | 0.35 | 0.01 | -0.33 | -0.15 | 0.12 | -0.15 | 0.16 | -0.09 | 0.08 | 0.23 | -0.34 | -0.23 | -0.21 | -0.09 | 0.04 | 0.03 | 0.04 |
| Engaged | 0.11 | -0.11 | -0.01 | 0.07 | 0.16 | 0.00 | -0.03 | -0.01 | 0.03 | 0.08 | 0.02 | 0.22 | -0.10 | 0.41 | 0.39 | 0.35 | 0.02 | -0.40 | 1.00 | 0.03 | -0.04 | -0.10 | 0.07 | 0.55 | 0.15 | -0.12 | 0.11 | -0.15 | 0.05 | -0.03 | -0.11 | 0.27 | 0.20 | 0.13 | 0.13 | -0.07 | 0.02 | 0.01 |
| Angry | -0.28 | -0.06 | -0.03 | -0.16 | 0.10 | -0.35 | -0.20 | -0.15 | -0.16 | -0.06 | 0.00 | -0.19 | 0.14 | -0.28 | -0.17 | 0.29 | 0.46 | 0.13 | 0.03 | 1.00 | 0.48 | 0.47 | 0.11 | -0.22 | -0.02 | 0.10 | -0.09 | 0.08 | -0.04 | 0.08 | 0.09 | -0.05 | -0.20 | 0.12 | -0.19 | -0.10 | -0.14 | -0.26 |
| Frustrated | -0.45 | -0.13 | -0.09 | -0.19 | 0.02 | -0.53 | -0.26 | -0.22 | -0.17 | -0.07 | 0.04 | -0.39 | 0.15 | -0.39 | -0.26 | 0.32 | 0.38 | 0.09 | -0.04 | 0.48 | 1.00 | 0.35 | -0.02 | -0.34 | 0.03 | 0.11 | -0.06 | 0.08 | -0.06 | 0.12 | 0.10 | 0.02 | -0.07 | 0.21 | -0.06 | -0.01 | -0.14 | -0.29 |
| Sad | -0.20 | 0.02 | -0.03 | -0.05 | -0.03 | -0.17 | -0.09 | -0.17 | -0.15 | -0.12 | 0.02 | -0.15 | 0.15 | -0.29 | -0.22 | 0.06 | 0.29 | 0.35 | -0.10 | 0.47 | 0.35 | 1.00 | 0.27 | -0.21 | -0.05 | 0.01 | -0.15 | 0.01 | 0.00 | 0.04 | 0.16 | -0.08 | -0.18 | -0.01 | -0.16 | -0.09 | -0.12 | -0.17 |
| Guilty | 0.09 | 0.02 | -0.05 | 0.07 | -0.01 | 0.08 | -0.03 | -0.07 | -0.06 | -0.06 | -0.13 | 0.09 | 0.18 | 0.05 | 0.00 | -0.02 | 0.22 | 0.01 | 0.07 | 0.11 | -0.02 | 0.27 | 1.00 | 0.09 | 0.14 | 0.03 | -0.07 | -0.11 | 0.14 | -0.07 | 0.00 | -0.02 | 0.00 | -0.15 | -0.15 | -0.16 | 0.01 | -0.04 |
| Happy | 0.22 | 0.04 | 0.02 | 0.07 | 0.14 | 0.18 | 0.11 | 0.14 | 0.13 | 0.05 | -0.02 | 0.32 | -0.11 | 0.67 | 0.59 | 0.21 | -0.12 | -0.33 | 0.55 | -0.22 | -0.34 | -0.21 | 0.09 | 1.00 | 0.09 | -0.08 | 0.04 | -0.02 | 0.09 | -0.02 | 0.05 | 0.27 | 0.19 | 0.02 | 0.16 | 0.05 | 0.08 | 0.17 |
| GP | -0.03 | 0.08 | -0.01 | -0.11 | 0.05 | -0.07 | -0.06 | 0.03 | -0.16 | 0.11 | -0.08 | 0.00 | 0.05 | 0.04 | 0.05 | 0.15 | -0.04 | -0.15 | 0.15 | -0.02 | 0.03 | -0.05 | 0.14 | 0.09 | 1.00 | -0.55 | 0.60 | -0.43 | 0.34 | -0.18 | -0.39 | 0.39 | 0.23 | 0.14 | 0.09 | 0.06 | -0.03 | -0.07 |
| CWV | -0.04 | -0.10 | 0.03 | 0.01 | -0.04 | -0.06 | 0.08 | -0.08 | 0.12 | -0.11 | -0.04 | -0.05 | 0.07 | -0.07 | -0.05 | 0.01 | 0.08 | 0.12 | -0.12 | 0.10 | 0.11 | 0.01 | 0.03 | -0.08 | -0.55 | 1.00 | -0.67 | 0.59 | -0.40 | 0.24 | 0.46 | -0.46 | -0.18 | -0.11 | -0.09 | -0.12 | 0.04 | 0.10 |
| HH | -0.02 | 0.12 | -0.06 | -0.08 | 0.07 | -0.04 | -0.08 | 0.10 | -0.08 | 0.15 | 0.06 | -0.06 | -0.04 | -0.02 | 0.01 | 0.07 | -0.09 | -0.15 | 0.11 | -0.09 | -0.06 | -0.15 | -0.07 | 0.04 | 0.60 | -0.67 | 1.00 | -0.53 | 0.32 | -0.23 | -0.43 | 0.31 | 0.24 | 0.06 | 0.19 | 0.01 | -0.07 | -0.12 |
| Spite | 0.03 | -0.03 | 0.16 | -0.06 | -0.06 | 0.07 | 0.07 | 0.04 | 0.02 | -0.06 | 0.04 | -0.02 | 0.03 | 0.01 | -0.02 | -0.08 | 0.03 | 0.16 | -0.15 | 0.08 | 0.08 | 0.01 | -0.11 | -0.02 | -0.43 | 0.59 | -0.53 | 1.00 | -0.25 | 0.17 | 0.43 | -0.24 | -0.12 | -0.01 | 0.03 | 0.07 | 0.14 | 0.08 |
| SVO | 0.04 | -0.01 | -0.06 | -0.12 | 0.08 | -0.04 | 0.01 | 0.05 | -0.13 | 0.11 | 0.04 | -0.05 | 0.15 | 0.07 | 0.04 | -0.02 | -0.12 | -0.09 | 0.05 | -0.04 | -0.06 | 0.00 | 0.14 | 0.09 | 0.34 | -0.40 | 0.32 | -0.25 | 1.00 | -0.15 | -0.29 | 0.21 | -0.03 | 0.10 | 0.06 | 0.10 | 0.14 | 0.09 |
| Narcissism | 0.00 | -0.05 | 0.01 | -0.07 | 0.05 | -0.01 | 0.06 | -0.02 | -0.02 | 0.00 | -0.01 | -0.01 | 0.10 | -0.07 | 0.04 | 0.13 | 0.16 | 0.08 | -0.03 | 0.08 | 0.12 | 0.04 | -0.07 | -0.02 | -0.18 | 0.24 | -0.23 | 0.17 | -0.15 | 1.00 | 0.30 | -0.29 | -0.22 | -0.04 | -0.17 | -0.04 | 0.06 | 0.04 |
| Sadism | 0.00 | -0.01 | 0.07 | -0.04 | -0.01 | 0.07 | 0.04 | -0.01 | 0.06 | -0.15 | 0.04 | 0.01 | 0.07 | -0.03 | -0.09 | -0.02 | 0.14 | 0.23 | -0.11 | 0.09 | 0.10 | 0.16 | 0.00 | 0.05 | -0.39 | 0.46 | -0.43 | 0.43 | -0.29 | 0.30 | 1.00 | -0.28 | -0.09 | -0.14 | 0.00 | -0.02 | 0.07 | 0.11 |
| Agreeableness | -0.11 | -0.10 | -0.08 | -0.07 | 0.08 | -0.18 | -0.09 | -0.09 | -0.12 | 0.09 | 0.06 | -0.02 | 0.02 | 0.22 | 0.23 | 0.19 | -0.12 | -0.34 | 0.27 | -0.05 | 0.02 | -0.08 | -0.02 | 0.27 | 0.39 | -0.46 | 0.31 | -0.24 | 0.21 | -0.29 | -0.28 | 1.00 | 0.34 | 0.29 | 0.24 | 0.16 | -0.04 | -0.01 |
| Conscientiousness | 0.05 | 0.01 | 0.03 | -0.02 | -0.04 | 0.07 | -0.06 | -0.01 | 0.00 | -0.01 | 0.11 | 0.03 | -0.08 | 0.23 | 0.11 | -0.07 | -0.22 | -0.23 | 0.20 | -0.20 | -0.07 | -0.18 | 0.00 | 0.19 | 0.23 | -0.18 | 0.24 | -0.12 | -0.03 | -0.22 | -0.09 | 0.34 | 1.00 | 0.17 | 0.47 | 0.12 | -0.09 | 0.12 |
| Extraversion | -0.11 | -0.09 | 0.00 | -0.05 | 0.06 | -0.16 | -0.03 | -0.02 | -0.03 | 0.07 | -0.01 | -0.04 | -0.01 | 0.02 | 0.05 | 0.24 | 0.08 | -0.21 | 0.13 | 0.12 | 0.21 | -0.01 | -0.15 | 0.02 | 0.14 | -0.11 | 0.06 | -0.01 | 0.10 | -0.04 | -0.14 | 0.29 | 0.17 | 1.00 | 0.33 | 0.42 | 0.06 | 0.07 |
| Emo. Stability | 0.01 | 0.13 | 0.02 | -0.02 | -0.07 | 0.06 | 0.04 | 0.17 | 0.01 | 0.00 | 0.10 | 0.05 | -0.06 | 0.07 | 0.06 | 0.00 | -0.23 | -0.09 | 0.13 | -0.19 | -0.06 | -0.16 | -0.15 | 0.16 | 0.09 | -0.09 | 0.19 | 0.03 | 0.06 | -0.17 | 0.00 | 0.24 | 0.47 | 0.33 | 1.00 | 0.23 | 0.05 | 0.26 |
| Openness | 0.16 | 0.06 | 0.10 | -0.09 | 0.08 | 0.12 | 0.15 | 0.16 | -0.01 | 0.21 | 0.02 | 0.01 | -0.05 | 0.05 | 0.02 | -0.04 | -0.19 | 0.04 | -0.07 | -0.10 | -0.01 | -0.09 | -0.16 | 0.05 | 0.06 | -0.12 | 0.01 | 0.07 | 0.10 | -0.04 | -0.02 | 0.16 | 0.12 | 0.42 | 0.23 | 1.00 | 0.30 | 0.27 |
| Game Freq. | 0.22 | 0.25 | 0.04 | -0.05 | 0.07 | 0.29 | 0.13 | 0.25 | 0.01 | 0.18 | -0.14 | 0.12 | 0.05 | 0.11 | 0.05 | -0.14 | -0.06 | 0.03 | 0.02 | -0.14 | -0.14 | -0.12 | 0.01 | 0.08 | -0.03 | 0.04 | -0.07 | 0.14 | 0.14 | 0.06 | 0.07 | -0.04 | -0.09 | 0.06 | 0.05 | 0.30 | 1.00 | 0.67 |
| Skill Level | 0.39 | 0.21 | 0.12 | -0.09 | 0.13 | 0.42 | 0.21 | 0.27 | -0.05 | 0.22 | -0.09 | 0.23 | 0.03 | 0.15 | 0.05 | -0.24 | -0.17 | 0.04 | 0.01 | -0.26 | -0.29 | -0.17 | -0.04 | 0.17 | -0.07 | 0.10 | -0.12 | 0.08 | 0.09 | 0.04 | 0.11 | -0.01 | 0.12 | 0.07 | 0.26 | 0.27 | 0.67 | 1.00 |
5.2 Individual Differences × Behavioral Outcomes (Heatmap)
id_names <- c("GP","CWV","HH","Spite","SVO","Narcissism","Sadism",
"Agreeableness","Conscientiousness","Extraversion",
"Emo. Stability","Openness","Game Freq.","Skill Level")
beh_names <- c("Score","Non-Instr. Stuns","Instr. Steals","Raids","Shakes",
"Score Diff","Intent Steal","Intent Stun","Intent Protect",
"Intent Produce","Subj: Individualistic","Subj: Competitive",
"Subj: Prosocial")
ggcorrplot(cor_mat[id_names, beh_names],
method = "square",
lab = TRUE,
lab_size = 2.5,
colors = c("#E07B54","white","#5B8DB8"),
title = "Individual Differences × Behavioral Outcomes",
ggtheme = theme_minimal())
5.3 Individual Difference Intercorrelations
ggcorrplot(cor_mat[id_names, id_names],
method = "square",
lab = TRUE,
lab_size = 2.8,
colors = c("#E07B54","white","#5B8DB8"),
title = "Individual Difference Intercorrelations",
ggtheme = theme_minimal())
6. Predicting Resource Generation (Shakes)
Hypothesis: SVO prosocials, high GP, high HH, and high agreeableness should shake more.
m_shake_svo <- lm(shake_count ~ svo_c, data = df)
m_shake_gp <- lm(shake_count ~ gp_c, data = df)
m_shake_hh <- lm(shake_count ~ hh_c, data = df)
m_shake_cwv <- lm(shake_count ~ cwv_c, data = df)
m_shake_spite <- lm(shake_count ~ spite_c, data = df)
m_shake_agree <- lm(shake_count ~ agree_c, data = df)
m_shake_full <- lm(shake_count ~ svo_c + gp_c + hh_c + cwv_c +
spite_c + agree_c + narc_c + sadism_c +
game_frequency + skill_level,
data = df)
map_dfr(
list(SVO=m_shake_svo, GP=m_shake_gp, HH=m_shake_hh, CWV=m_shake_cwv,
Spite=m_shake_spite, Agreeableness=m_shake_agree),
function(m) {
s <- summary(m)$coefficients
tibble(b = round(s[2,1], 3), se = round(s[2,2], 3),
t = round(s[2,3], 3), p = round(s[2,4], 3),
R2 = round(summary(m)$r.squared, 3))
}, .id = "Predictor"
) %>%
kable(col.names = c("Predictor","b","SE","t","p","R²"),
caption = "Bivariate predictors of Shake Count") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)| Predictor | b | SE | t | p | R² |
|---|---|---|---|---|---|
| SVO | 1.914 | 1.709 | 1.119 | 0.264 | 0.007 |
| GP | 1.244 | 1.713 | 0.727 | 0.468 | 0.003 |
| HH | 1.677 | 1.711 | 0.980 | 0.328 | 0.005 |
| CWV | -1.011 | 1.714 | -0.590 | 0.556 | 0.002 |
| Spite | -1.306 | 1.713 | -0.763 | 0.447 | 0.003 |
| Agreeableness | 1.845 | 1.710 | 1.079 | 0.282 | 0.006 |
cat("\n--- Full model ---\n")##
## --- Full model ---summary(m_shake_full)##
## Call:
## lm(formula = shake_count ~ svo_c + gp_c + hh_c + cwv_c + spite_c +
## agree_c + narc_c + sadism_c + game_frequency + skill_level,
## data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -43.644 -17.676 0.983 18.162 59.723
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 33.7011 5.1588 6.533 6.48e-10 ***
## svo_c 1.3881 1.9515 0.711 0.478
## gp_c -0.2057 2.3105 -0.089 0.929
## hh_c 2.1605 2.5794 0.838 0.403
## cwv_c 1.3300 2.7878 0.477 0.634
## spite_c -0.9320 2.2664 -0.411 0.681
## agree_c 2.0993 2.0291 1.035 0.302
## narc_c 2.0220 1.8638 1.085 0.279
## sadism_c 0.5258 2.0895 0.252 0.802
## game_frequency -0.6206 1.7464 -0.355 0.723
## skill_level 2.2006 1.4430 1.525 0.129
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 23.68 on 179 degrees of freedom
## Multiple R-squared: 0.03945, Adjusted R-squared: -0.01421
## F-statistic: 0.7351 on 10 and 179 DF, p-value: 0.6907Standard dilemma predictors (SVO, GP, HH, agreeableness) all point in the right direction for resource generation, but none reach significance, suggesting that shaking behavior in this paradigm is maybe driven more by in-game dynamics than stable dispositions.
7. Predicting Non-Instrumental Aggression (Stuns)
Hypothesis: high Spite, high CWV, low GP, low HH, competitive SVO should stun more.
m_stun_svo <- lm(noninstr_aggression ~ svo_c, data = df)
m_stun_gp <- lm(noninstr_aggression ~ gp_c, data = df)
m_stun_hh <- lm(noninstr_aggression ~ hh_c, data = df)
m_stun_cwv <- lm(noninstr_aggression ~ cwv_c, data = df)
m_stun_spite <- lm(noninstr_aggression ~ spite_c, data = df)
m_stun_narc <- lm(noninstr_aggression ~ narc_c, data = df)
m_stun_sad <- lm(noninstr_aggression ~ sadism_c, data = df)
m_stun_full <- lm(noninstr_aggression ~ svo_c + gp_c + hh_c + cwv_c +
spite_c + narc_c + sadism_c + agree_c +
game_frequency + skill_level,
data = df)
map_dfr(
list(SVO=m_stun_svo, GP=m_stun_gp, HH=m_stun_hh, CWV=m_stun_cwv,
Spite=m_stun_spite, Narcissism=m_stun_narc, Sadism=m_stun_sad),
function(m) {
s <- summary(m)$coefficients
tibble(b = round(s[2,1], 3), se = round(s[2,2], 3),
t = round(s[2,3], 3), p = round(s[2,4], 3),
R2 = round(summary(m)$r.squared, 3))
}, .id = "Predictor"
) %>%
kable(col.names = c("Predictor","b","SE","t","p","R²"),
caption = "Bivariate predictors of Non-Instrumental Aggression (stuns)") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)| Predictor | b | SE | t | p | R² |
|---|---|---|---|---|---|
| SVO | -0.062 | 0.394 | -0.157 | 0.875 | 0.000 |
| GP | 0.451 | 0.392 | 1.149 | 0.252 | 0.007 |
| HH | 0.629 | 0.391 | 1.608 | 0.109 | 0.014 |
| CWV | -0.516 | 0.392 | -1.316 | 0.190 | 0.009 |
| Spite | -0.156 | 0.393 | -0.396 | 0.692 | 0.001 |
| Narcissism | -0.289 | 0.393 | -0.736 | 0.462 | 0.003 |
| Sadism | -0.049 | 0.394 | -0.123 | 0.902 | 0.000 |
cat("\n--- Full model ---\n")##
## --- Full model ---summary(m_stun_full)##
## Call:
## lm(formula = noninstr_aggression ~ svo_c + gp_c + hh_c + cwv_c +
## spite_c + narc_c + sadism_c + agree_c + game_frequency +
## skill_level, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -9.172 -3.509 -0.644 2.040 21.163
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.9541 1.1245 3.516 0.000555 ***
## svo_c -0.6912 0.4254 -1.625 0.105961
## gp_c 0.4338 0.5037 0.861 0.390257
## hh_c 0.5639 0.5623 1.003 0.317301
## cwv_c -0.8781 0.6077 -1.445 0.150219
## spite_c 0.2127 0.4940 0.430 0.667386
## narc_c -0.4627 0.4063 -1.139 0.256318
## sadism_c 0.1610 0.4555 0.353 0.724138
## agree_c -1.1108 0.4423 -2.511 0.012910 *
## game_frequency 0.7839 0.3807 2.059 0.040921 *
## skill_level 0.3810 0.3146 1.211 0.227352
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 5.163 on 179 degrees of freedom
## Multiple R-squared: 0.1335, Adjusted R-squared: 0.08506
## F-statistic: 2.757 on 10 and 179 DF, p-value: 0.003472The traits expected to suppress aggression actually predict more non-instrumental stunning, suggesting players high in GP and HH may be stunning as moral punishment rather than gratuitous harm?
8. Predicting Instrumental Aggression (Steals)
Hypothesis: CWV, Spite, and competitive SVO should predict stealing.
m_steal_svo <- lm(instr_aggression ~ svo_c, data = df)
m_steal_gp <- lm(instr_aggression ~ gp_c, data = df)
m_steal_hh <- lm(instr_aggression ~ hh_c, data = df)
m_steal_cwv <- lm(instr_aggression ~ cwv_c, data = df)
m_steal_spite <- lm(instr_aggression ~ spite_c, data = df)
m_steal_narc <- lm(instr_aggression ~ narc_c, data = df)
m_steal_sad <- lm(instr_aggression ~ sadism_c, data = df)
m_steal_full <- lm(instr_aggression ~ svo_c + gp_c + hh_c + cwv_c +
spite_c + narc_c + sadism_c + agree_c +
game_frequency + skill_level,
data = df)
map_dfr(
list(SVO=m_steal_svo, GP=m_steal_gp, HH=m_steal_hh, CWV=m_steal_cwv,
Spite=m_steal_spite, Narcissism=m_steal_narc, Sadism=m_steal_sad),
function(m) {
s <- summary(m)$coefficients
tibble(b = round(s[2,1], 3), se = round(s[2,2], 3),
t = round(s[2,3], 3), p = round(s[2,4], 3),
R2 = round(summary(m)$r.squared, 3))
}, .id = "Predictor"
) %>%
kable(col.names = c("Predictor","b","SE","t","p","R²"),
caption = "Bivariate predictors of Instrumental Aggression (steals)") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)| Predictor | b | SE | t | p | R² |
|---|---|---|---|---|---|
| SVO | -0.181 | 0.218 | -0.831 | 0.407 | 0.004 |
| GP | -0.032 | 0.218 | -0.146 | 0.884 | 0.000 |
| HH | -0.172 | 0.218 | -0.791 | 0.430 | 0.003 |
| CWV | 0.081 | 0.218 | 0.372 | 0.710 | 0.001 |
| Spite | 0.482 | 0.215 | 2.241 | 0.026 | 0.026 |
| Narcissism | 0.042 | 0.218 | 0.195 | 0.846 | 0.000 |
| Sadism | 0.201 | 0.217 | 0.923 | 0.357 | 0.005 |
cat("\n--- Full model ---\n")##
## --- Full model ---summary(m_steal_full)##
## Call:
## lm(formula = instr_aggression ~ svo_c + gp_c + hh_c + cwv_c +
## spite_c + narc_c + sadism_c + agree_c + game_frequency +
## skill_level, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.6755 -2.0491 -0.6426 1.3958 15.1172
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.58821 0.64448 4.016 8.7e-05 ***
## svo_c -0.22146 0.24379 -0.908 0.3649
## gp_c 0.27412 0.28865 0.950 0.3436
## hh_c -0.11010 0.32223 -0.342 0.7330
## cwv_c -0.58384 0.34828 -1.676 0.0954 .
## spite_c 0.73575 0.28313 2.599 0.0101 *
## narc_c -0.06651 0.23284 -0.286 0.7755
## sadism_c 0.01747 0.26104 0.067 0.9467
## agree_c -0.38863 0.25349 -1.533 0.1270
## game_frequency -0.25510 0.21817 -1.169 0.2438
## skill_level 0.37758 0.18027 2.095 0.0376 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.959 on 179 degrees of freedom
## Multiple R-squared: 0.07158, Adjusted R-squared: 0.01972
## F-statistic: 1.38 on 10 and 179 DF, p-value: 0.1926Spite is the only significant predictor of instrumental aggression, and this makes sense. The overall sign pattern — dark traits positive, prosocial traits negative — seems right.
9. Predicting Raids
m_raid_svo <- lm(as.numeric(Player_raids_hut) ~ svo_c, data = df)
m_raid_gp <- lm(as.numeric(Player_raids_hut) ~ gp_c, data = df)
m_raid_hh <- lm(as.numeric(Player_raids_hut) ~ hh_c, data = df)
m_raid_cwv <- lm(as.numeric(Player_raids_hut) ~ cwv_c, data = df)
m_raid_spite <- lm(as.numeric(Player_raids_hut) ~ spite_c, data = df)
m_raid_full <- lm(as.numeric(Player_raids_hut) ~ svo_c + gp_c + hh_c +
cwv_c + spite_c + narc_c + sadism_c + agree_c +
game_frequency + skill_level,
data = df)
map_dfr(
list(SVO=m_raid_svo, GP=m_raid_gp, HH=m_raid_hh,
CWV=m_raid_cwv, Spite=m_raid_spite),
function(m) {
s <- summary(m)$coefficients
tibble(b = round(s[2,1], 3), se = round(s[2,2], 3),
t = round(s[2,3], 3), p = round(s[2,4], 3),
R2 = round(summary(m)$r.squared, 3))
}, .id = "Predictor"
) %>%
kable(col.names = c("Predictor","b","SE","t","p","R²"),
caption = "Bivariate predictors of Raids") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)| Predictor | b | SE | t | p | R² |
|---|---|---|---|---|---|
| SVO | -0.255 | 0.153 | -1.673 | 0.096 | 0.015 |
| GP | -0.232 | 0.153 | -1.516 | 0.131 | 0.012 |
| HH | -0.170 | 0.153 | -1.111 | 0.268 | 0.007 |
| CWV | 0.017 | 0.154 | 0.108 | 0.914 | 0.000 |
| Spite | -0.124 | 0.154 | -0.810 | 0.419 | 0.003 |
cat("\n--- Full model ---\n")##
## --- Full model ---summary(m_raid_full)##
## Call:
## lm(formula = as.numeric(Player_raids_hut) ~ svo_c + gp_c + hh_c +
## cwv_c + spite_c + narc_c + sadism_c + agree_c + game_frequency +
## skill_level, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.4368 -1.6496 -0.3861 1.1889 6.3907
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.19346 0.45610 4.809 3.2e-06 ***
## svo_c -0.26174 0.17253 -1.517 0.131
## gp_c -0.22851 0.20428 -1.119 0.265
## hh_c -0.30113 0.22805 -1.320 0.188
## cwv_c -0.20709 0.24648 -0.840 0.402
## spite_c -0.26573 0.20037 -1.326 0.186
## narc_c -0.20003 0.16478 -1.214 0.226
## sadism_c -0.14799 0.18474 -0.801 0.424
## agree_c -0.17379 0.17940 -0.969 0.334
## game_frequency 0.07679 0.15440 0.497 0.620
## skill_level -0.13177 0.12758 -1.033 0.303
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.094 on 179 degrees of freedom
## Multiple R-squared: 0.06677, Adjusted R-squared: 0.01463
## F-statistic: 1.281 on 10 and 179 DF, p-value: 0.2443Prosocial orientation and guilt proneness trend toward suppressing raids, which is the most premeditated form of aggression. While spite, which predicted opportunistic stealing, is irrelevant here, suggesting different psychological mechanisms underlie different aggressive acts in the game.
10. Summary: Do Standard Dilemma Predictors Generalize?
outcomes <- list(
Shakes = "shake_count", Stuns = "noninstr_aggression",
Steals = "instr_aggression", Raids = "Player_raids_hut",
Score = "player_score"
)
predictors <- list(
SVO = "svo_angle", GP = "gp", HH = "hh", CWV = "cwv",
Spite = "spite", Narcissism = "narcissism", Sadism = "sadism",
Agreeableness = "tipi_agreeableness"
)
map_dfr(names(predictors), function(pred_name) {
map_dfr(names(outcomes), function(out_name) {
ct <- cor.test(as.numeric(df[[predictors[[pred_name]]]]),
as.numeric(df[[outcomes[[out_name]]]]),
use = "complete.obs")
tibble(Predictor = pred_name, Outcome = out_name,
r_sig = paste0(round(ct$estimate, 2),
case_when(ct$p.value < .001 ~ "***",
ct$p.value < .01 ~ "**",
ct$p.value < .05 ~ "*",
ct$p.value < .10 ~ ".",
TRUE ~ "")))
})
}) %>%
pivot_wider(names_from = Outcome, values_from = r_sig) %>%
kable(caption = "Bivariate r (*** p<.001, ** p<.01, * p<.05, . p<.10)") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)| Predictor | Shakes | Stuns | Steals | Raids | Score |
|---|---|---|---|---|---|
| SVO | 0.08 | -0.01 | -0.06 | -0.12. | 0.04 |
| GP | 0.05 | 0.08 | -0.01 | -0.11 | -0.03 |
| HH | 0.07 | 0.12 | -0.06 | -0.08 | -0.02 |
| CWV | -0.04 | -0.1 | 0.03 | 0.01 | -0.04 |
| Spite | -0.06 | -0.03 | 0.16* | -0.06 | 0.03 |
| Narcissism | 0.05 | -0.05 | 0.01 | -0.07 | 0 |
| Sadism | -0.01 | -0.01 | 0.07 | -0.04 | 0 |
| Agreeableness | 0.08 | -0.1 | -0.08 | -0.07 | -0.11 |
The only significant finding is spite predicting instrumental stealing, but the broader pattern — prosocial traits consistently positive for shaking and negative for raiding, dark traits positive for stealing — is directionally coherent and suggests the paradigm is capturing potentially meaningful variance.
11. Subjective Intent × Actual Behavior
df %>%
summarise(
r_steal_intent_steals = round(cor(intent_steal_n, instr_aggression,
use = "complete.obs"), 2),
r_steal_intent_raids = round(cor(intent_steal_n, as.numeric(Player_raids_hut),
use = "complete.obs"), 2),
r_stun_intent_stuns = round(cor(intent_stun_n, noninstr_aggression,
use = "complete.obs"), 2),
r_produce_intent_shake = round(cor(intent_produce_n, shake_count,
use = "complete.obs"), 2)
) %>%
pivot_longer(everything(), names_to = "Correlation", values_to = "r") %>%
kable(caption = "Intent-behavior correspondence") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)| Correlation | r |
|---|---|
| r_steal_intent_steals | 0.53 |
| r_steal_intent_raids | 0.03 |
| r_stun_intent_stuns | 0.57 |
| r_produce_intent_shake | 0.56 |
12. People or Bot Belief
df %>%
mutate(pob_label = case_when(
people_or_bot == 1 ~ "Real person",
people_or_bot == 2 ~ "Computer",
people_or_bot == 3 ~ "Unsure",
TRUE ~ NA_character_
)) %>%
filter(!is.na(pob_label)) %>%
count(pob_label) %>%
mutate(pct = percent(n / sum(n), 1)) %>%
kable(col.names = c("Belief","N","%"),
caption = "Did participants think they were playing a real person?") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)| Belief | N | % |
|---|---|---|
| Computer | 93 | 49% |
| Real person | 74 | 39% |
| Unsure | 23 | 12% |
# Does belief relate to aggression?
df %>%
mutate(people_or_bot = as.numeric(people_or_bot)) %>%
summarise(
r_pob_stuns = round(cor(people_or_bot, noninstr_aggression, use = "complete.obs"), 2),
r_pob_steals = round(cor(people_or_bot, instr_aggression, use = "complete.obs"), 2),
r_pob_raids = round(cor(people_or_bot, as.numeric(Player_raids_hut), use = "complete.obs"), 2),
r_pob_guilty = round(cor(people_or_bot, guilty_n, use = "complete.obs"), 2)
) %>%
pivot_longer(everything(), names_to = "Correlation", values_to = "r") %>%
kable(caption = "People-or-bot belief × outcomes (higher = more bot-like)") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)| Correlation | r |
|---|---|
| r_pob_stuns | -0.02 |
| r_pob_steals | -0.01 |
| r_pob_raids | 0.13 |
| r_pob_guilty | -0.05 |
People behave the same way regardless of whether they think they’re playing a human or a computer, and they don’t feel more guilty about it either.
13. Game Experience & Emotions
13.1 Descriptives
df %>%
dplyr::select(positive_n, play_again_n, challenged_n, threatened_n,
bored_n, engaged_n, angry_n, frustrated_n,
sad_n, guilty_n, happy_n) %>%
pivot_longer(everything(), names_to = "Variable", values_to = "Value") %>%
mutate(Variable = str_remove(Variable, "_n") %>% str_to_title()) %>%
group_by(Variable) %>%
summarise(
M = round(mean(as.numeric(Value), na.rm = TRUE), 2),
SD = round(sd(as.numeric(Value), na.rm = TRUE), 2),
.groups = "drop"
) %>%
kable(col.names = c("Variable","M","SD"),
caption = "Game experience and emotion descriptives (1-7)") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)| Variable | M | SD |
|---|---|---|
| Angry | 1.99 | 1.46 |
| Bored | 2.22 | 1.56 |
| Challenged | 4.53 | 1.79 |
| Engaged | 5.97 | 1.20 |
| Frustrated | 2.86 | 1.87 |
| Guilty | 2.28 | 1.67 |
| Happy | 4.56 | 1.49 |
| Play_again | 4.71 | 1.74 |
| Positive | 5.47 | 1.30 |
| Sad | 1.56 | 0.93 |
| Threatened | 2.71 | 1.85 |
13.2 Emotion Profile
df %>%
dplyr::select(challenged_n, threatened_n, bored_n, engaged_n,
angry_n, frustrated_n, sad_n, guilty_n, happy_n) %>%
pivot_longer(everything(), names_to = "Emotion", values_to = "Score") %>%
mutate(Emotion = str_remove(Emotion, "_n") %>% str_to_title()) %>%
group_by(Emotion) %>%
summarise(M = mean(as.numeric(Score), na.rm = TRUE),
SE = sd(as.numeric(Score), na.rm = TRUE) / sqrt(n()),
.groups = "drop") %>%
mutate(Emotion = fct_reorder(Emotion, M)) %>%
ggplot(aes(x = Emotion, y = M, fill = M)) +
geom_col() +
geom_errorbar(aes(ymin = M - SE, ymax = M + SE), width = 0.2) +
scale_fill_gradient(low = "#5B8DB8", high = "#E07B54", guide = "none") +
scale_y_continuous(limits = c(0, 7)) +
coord_flip() +
labs(title = "Emotion Profile During Game",
subtitle = "Error bars = ±1 SE", x = NULL, y = "Mean (1-7)") +
theme_minimal()
13.3 Emotions & Overall Experience × Behavioral Outcomes
exp_beh_df <- df %>%
dplyr::select(positive_n, play_again_n, challenged_n, threatened_n,
bored_n, engaged_n, angry_n, frustrated_n,
sad_n, guilty_n, happy_n,
player_score, noninstr_aggression, instr_aggression,
Player_raids_hut, shake_count, score_diff) %>%
mutate(across(everything(), as.numeric))
exp_beh_mat <- cor(exp_beh_df, use = "pairwise.complete.obs")
exp_vars <- c("positive_n","play_again_n","challenged_n","threatened_n",
"bored_n","engaged_n","angry_n","frustrated_n",
"sad_n","guilty_n","happy_n")
beh_vars2 <- c("player_score","noninstr_aggression","instr_aggression",
"Player_raids_hut","shake_count","score_diff")
exp_beh_mat[exp_vars, beh_vars2] %>%
round(2) %>%
`rownames<-`(c("Positive","Play Again","Challenged","Threatened",
"Bored","Engaged","Angry","Frustrated","Sad","Guilty","Happy")) %>%
`colnames<-`(c("Score","Stuns","Steals","Raids","Shakes","Score Diff")) %>%
kable(caption = "Emotions & experience × behavioral outcomes (r)") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)| Score | Stuns | Steals | Raids | Shakes | Score Diff | |
|---|---|---|---|---|---|---|
| Positive | 0.29 | -0.06 | 0.08 | 0.08 | 0.11 | 0.27 |
| Play Again | 0.07 | -0.06 | 0.01 | 0.06 | -0.04 | 0.02 |
| Challenged | -0.36 | -0.11 | -0.13 | -0.10 | 0.05 | -0.45 |
| Threatened | -0.17 | 0.14 | 0.01 | -0.11 | 0.03 | -0.14 |
| Bored | 0.06 | 0.19 | 0.12 | -0.08 | -0.02 | 0.16 |
| Engaged | 0.11 | -0.11 | -0.01 | 0.07 | 0.16 | 0.00 |
| Angry | -0.28 | -0.06 | -0.03 | -0.16 | 0.10 | -0.35 |
| Frustrated | -0.45 | -0.13 | -0.09 | -0.19 | 0.02 | -0.53 |
| Sad | -0.20 | 0.02 | -0.03 | -0.05 | -0.03 | -0.17 |
| Guilty | 0.09 | 0.02 | -0.05 | 0.07 | -0.01 | 0.08 |
| Happy | 0.22 | 0.04 | 0.02 | 0.07 | 0.14 | 0.18 |
exp_beh_plot <- exp_beh_mat[exp_vars, beh_vars2]
rownames(exp_beh_plot) <- c("Positive","Play Again","Challenged","Threatened",
"Bored","Engaged","Angry","Frustrated",
"Sad","Guilty","Happy")
colnames(exp_beh_plot) <- c("Score","Stuns","Steals","Raids","Shakes","Score Diff")
ggcorrplot(exp_beh_plot,
method = "square",
lab = TRUE,
lab_size = 3,
colors = c("#E07B54","white","#5B8DB8"),
title = "Emotions & Experience × Behavioral Outcomes",
ggtheme = theme_minimal())
Just isolating emotions here with behaviors
13.4 Do Emotions Predict Aggression?
m_agg_emotions <- lm(noninstr_aggression ~ angry_n + frustrated_n +
guilty_n + threatened_n + engaged_n + happy_n,
data = df)
summary(m_agg_emotions)##
## Call:
## lm(formula = noninstr_aggression ~ angry_n + frustrated_n + guilty_n +
## threatened_n + engaged_n + happy_n, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -9.5621 -3.3282 -0.5372 2.1882 25.1813
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 11.41659 2.13524 5.347 2.65e-07 ***
## angry_n -0.25841 0.32082 -0.805 0.42161
## frustrated_n -0.49024 0.25047 -1.957 0.05184 .
## guilty_n -0.08907 0.23759 -0.375 0.70818
## threatened_n 0.76168 0.24275 3.138 0.00198 **
## engaged_n -0.77160 0.38896 -1.984 0.04878 *
## happy_n 0.32453 0.33364 0.973 0.33198
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 5.245 on 183 degrees of freedom
## Multiple R-squared: 0.08569, Adjusted R-squared: 0.05571
## F-statistic: 2.858 on 6 and 183 DF, p-value: 0.011m_steal_emotions <- lm(instr_aggression ~ angry_n + frustrated_n +
guilty_n + threatened_n + engaged_n,
data = df)
summary(m_steal_emotions)##
## Call:
## lm(formula = instr_aggression ~ angry_n + frustrated_n + guilty_n +
## threatened_n + engaged_n, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.6989 -2.2755 -0.5889 1.4545 15.4536
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.9275864 1.1977551 3.279 0.00125 **
## angry_n 0.0008129 0.1823297 0.004 0.99645
## frustrated_n -0.1933435 0.1375043 -1.406 0.16138
## guilty_n -0.1226846 0.1358098 -0.903 0.36752
## threatened_n 0.1170265 0.1390661 0.842 0.40115
## engaged_n -0.0305055 0.1830315 -0.167 0.86781
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 3.005 on 184 degrees of freedom
## Multiple R-squared: 0.01555, Adjusted R-squared: -0.01121
## F-statistic: 0.5811 on 5 and 184 DF, p-value: 0.7144Non-instrumental aggression is emotionally reactive — driven by feeling threatened and suppressed by engagement — while instrumental stealing is emotionally cold, suggesting the two forms of aggression have different underpinnings?
13.5 Do Emotions Predict Resource Generation?
m_shake_emotions <- lm(shake_count ~ engaged_n + challenged_n +
bored_n + positive_n + happy_n,
data = df)
summary(m_shake_emotions)##
## Call:
## lm(formula = shake_count ~ engaged_n + challenged_n + bored_n +
## positive_n + happy_n, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -45.732 -18.675 -0.632 16.991 62.626
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 9.3148 14.3046 0.651 0.516
## engaged_n 2.8335 1.8032 1.571 0.118
## challenged_n 0.2714 1.0660 0.255 0.799
## bored_n 1.4816 1.4093 1.051 0.295
## positive_n 1.2381 1.9943 0.621 0.535
## happy_n 0.6477 1.6912 0.383 0.702
##
## Residual standard error: 23.4 on 184 degrees of freedom
## Multiple R-squared: 0.03578, Adjusted R-squared: 0.009581
## F-statistic: 1.366 on 5 and 184 DF, p-value: 0.239213.6 Experience × Individual Differences
Do the same traits that predict behavior also shape how people felt?
exp_id_df <- df %>%
dplyr::select(positive_n, play_again_n, challenged_n, threatened_n,
bored_n, engaged_n, angry_n, frustrated_n,
sad_n, guilty_n, happy_n,
gp, cwv, hh, spite, svo_angle, narcissism, sadism,
tipi_agreeableness) %>%
mutate(across(everything(), as.numeric))
exp_id_mat <- cor(exp_id_df, use = "pairwise.complete.obs")
exp_id_mat[c("positive_n","play_again_n","challenged_n","threatened_n",
"bored_n","engaged_n","angry_n","frustrated_n",
"sad_n","guilty_n","happy_n"),
c("gp","cwv","hh","spite","svo_angle",
"narcissism","sadism","tipi_agreeableness")] %>%
round(2) %>%
`rownames<-`(c("Positive","Play Again","Challenged","Threatened",
"Bored","Engaged","Angry","Frustrated",
"Sad","Guilty","Happy")) %>%
`colnames<-`(c("GP","CWV","HH","Spite","SVO",
"Narcissism","Sadism","Agreeableness")) %>%
kable(caption = "Game experience × individual differences (r)") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)| GP | CWV | HH | Spite | SVO | Narcissism | Sadism | Agreeableness | |
|---|---|---|---|---|---|---|---|---|
| Positive | 0.04 | -0.07 | -0.02 | 0.01 | 0.07 | -0.07 | -0.03 | 0.22 |
| Play Again | 0.05 | -0.05 | 0.01 | -0.02 | 0.04 | 0.04 | -0.09 | 0.23 |
| Challenged | 0.15 | 0.01 | 0.07 | -0.08 | -0.02 | 0.13 | -0.02 | 0.19 |
| Threatened | -0.04 | 0.08 | -0.09 | 0.03 | -0.12 | 0.16 | 0.14 | -0.12 |
| Bored | -0.15 | 0.12 | -0.15 | 0.16 | -0.09 | 0.08 | 0.23 | -0.34 |
| Engaged | 0.15 | -0.12 | 0.11 | -0.15 | 0.05 | -0.03 | -0.11 | 0.27 |
| Angry | -0.02 | 0.10 | -0.09 | 0.08 | -0.04 | 0.08 | 0.09 | -0.05 |
| Frustrated | 0.03 | 0.11 | -0.06 | 0.08 | -0.06 | 0.12 | 0.10 | 0.02 |
| Sad | -0.05 | 0.01 | -0.15 | 0.01 | 0.00 | 0.04 | 0.16 | -0.08 |
| Guilty | 0.14 | 0.03 | -0.07 | -0.11 | 0.14 | -0.07 | 0.00 | -0.02 |
| Happy | 0.09 | -0.08 | 0.04 | -0.02 | 0.09 | -0.02 | 0.05 | 0.27 |
14. 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 Matrix_1.7-5
## [5] MASS_7.3-65 scales_1.4.0 gridExtra_2.3 ggcorrplot_0.1.4.1
## [9] kableExtra_1.4.0 knitr_1.51 psych_2.6.5 lubridate_1.9.5
## [13] forcats_1.0.1 stringr_1.6.0 dplyr_1.2.1 purrr_1.2.2
## [17] readr_2.2.0 tidyr_1.3.2 tibble_3.3.1 ggplot2_4.0.3
## [21] tidyverse_2.0.0 qualtRics_3.2.2
##
## loaded via a namespace (and not attached):
## [1] sjlabelled_1.2.0 tidyselect_1.2.1 viridisLite_0.4.3 farver_2.1.2
## [5] S7_0.2.2 fastmap_1.2.0 digest_0.6.39 rpart_4.1.27
## [9] timechange_0.4.0 lifecycle_1.0.5 cluster_2.1.8.2 magrittr_2.0.5
## [13] compiler_4.6.0 rlang_1.2.0 Hmisc_5.2-6 sass_0.4.10
## [17] tools_4.6.0 yaml_2.3.12 data.table_1.18.4 labeling_0.4.3
## [21] htmlwidgets_1.6.4 bit_4.6.0 mnormt_2.1.2 plyr_1.8.9
## [25] xml2_1.5.2 RColorBrewer_1.1-3 withr_3.0.2 foreign_0.8-91
## [29] nnet_7.3-20 grid_4.6.0 colorspace_2.1-2 insight_1.5.1
## [33] cli_3.6.6 crayon_1.5.3 rmarkdown_2.31 reformulas_0.4.4
## [37] generics_0.1.4 otel_0.2.0 rstudioapi_0.19.0 reshape2_1.4.5
## [41] tzdb_0.5.0 minqa_1.2.8 cachem_1.1.0 splines_4.6.0
## [45] parallel_4.6.0 base64enc_0.1-6 vctrs_0.7.3 boot_1.3-32
## [49] jsonlite_2.0.0 hms_1.1.4 bit64_4.8.2 Formula_1.2-5
## [53] htmlTable_2.5.0 systemfonts_1.3.2 jquerylib_0.1.4 glue_1.8.1
## [57] nloptr_2.2.1 stringi_1.8.7 gtable_0.3.6 lme4_2.0-1
## [61] pillar_1.11.1 htmltools_0.5.9 R6_2.6.1 Rdpack_2.6.6
## [65] textshaping_1.0.5 vroom_1.7.1 lpSolve_5.6.23 evaluate_1.0.5
## [69] lattice_0.22-9 rbibutils_2.4.1 backports_1.5.1 bslib_0.11.0
## [73] Rcpp_1.1.1-1.1 svglite_2.2.2 nlme_3.1-169 checkmate_2.3.4
## [77] xfun_0.58 zoo_1.8-15 pkgconfig_2.0.3