OSCR

Self-allocation bias in performance-based cooperative decisions is driven by self-interest rather than distorted performance encoding.

A correction to this paper has been published: the notice, 42627763, from Europe PMC.

Code ↔ Paper

3 matches between paragraphs of the paper and lines of its authors' code, computed by the harvester (lexical-v1). Click a colored paragraph or line to see its counterpart.

The 3 matches
  1. [1] § Behavioral results › The self-allocation bias and its link to less reliance on performance. ↔ GA_analysis_plot_code.R, lines 1242 to 1283 · score 0.77 · OforO, OforS, SforO, SforS, allocation target, additive · Report a mismatch
  2. [2] § Methods › Experimental procedures › Experimental design in additional Experiment 3. ↔ GA_analysis_plot_code.R, lines 1242 to 1283 · score 0.73 · OforO, OforS, SforO, SforS, irrelevant · Report a mismatch
  3. [3] § Methods › Behavioral data analysis ↔ GA_analysis_plot_code.R, lines 92 to 136 · score 0.52 · inflated beta, emmeans, post hoc, LOO, brms, multilevel models · Report a mismatch

Paper

Loaded from Europe PMC by your browser; OSCR does not store it: doi.org · Europe PMC

The paper is loaded when this pane is shown.

The authors' code

R · 1,769 lines · 65 KB · no license · 3 matches

  1. ###### GA behavioral analysis
  3. ## ------------------------ Initialization -------------------------------------
  4. ## setting
  5. rm(list= ls())
  6. library(tidyverse)
  7. library(ggplot2)
  8. library(brms)
  9. library(emmeans)
  10. library(sjPlot)
  11. library(svglite)
  12. library(ggpubr)
  13. library(cowplot)
  14. library(bayestestR)
  15. library(papaja)
  17. setwd(".../Behavioral_data")
  20. ## color
  21. light = c("#b2df8a","#decbe4")
  22. dark = c("#4bb14b","#967cb9")
  23. color_four = c("#4bb14b","#b2df8a","#decbe4","#967cb9")
  24. contribution_color = c("#fbb4ae","#ccebc5","#b3cde3")
  27. ## -------------------Experiment 1 and 2 ---------------------------------------------
  28. ## ------------------ load and prepare data ------------------------------------
  29. ## load data Experiment 1
  30. Exp1_data <- read.csv(".../Exp1_data.csv", header = TRUE)
  32. # factorize variables
  33. Exp1_data$task <-factor(Exp1_data$task,c('Simple','Additive','Disjunctive'))
  34. Exp1_data$winorloss<-factor(Exp1_data$winorloss,levels = c('Rewards','Losses'))
  35. Exp1_data$condition <-factor(Exp1_data$condition,levels = c('Self-relevant','Self-irrelevant'))
  37. # add svo score
  38. SVOdataExp1 <-read.csv(".../Exp1_SVOscore.csv", header = TRUE)
  39. Exp1_data <- Exp1_data %>%
  40. left_join(SVOdataExp1, by = "subject") %>%
  41. mutate(experiment = 'Experiment1')
  42. # if control analysis:
  43. # filter(!subject %in% c(32, 46, 55, 56, 57))
  46. ## load data Experiment 2
  47. Exp2_data <- read.csv(".../Exp2_data.csv", header = TRUE)
  49. Exp2_data$task<-factor(Exp2_data$task,levels = c('Simple','Additive','Disjunctive'))
  50. Exp2_data$winorloss<-factor(Exp2_data$winorloss, levels = c('Rewards','Losses'))
  51. Exp2_data$condition<-factor(Exp2_data$condition, levels = c('Self-relevant','Self-irrelevant'))
  53. # add svo score
  54. SVOdataExp2 <-read.csv(".../Exp2_SVOscore.csv", header = TRUE)
  55. Exp2_data <- Exp2_data %>%
  56. left_join(SVOdataExp2, by = "subject") %>%
  57. mutate(experiment = 'Experiment2')
  58. # if control analysis:
  59. # filter(!subject %in% c(118,119,125,132,134,139,141,143))
  62. ## combine data
  63. # combine in trial level
  64. combinedData <- rbind(Exp1_data,Exp2_data)
  65. combinedData <- combinedData %>%
  66. filter(winorloss == "Rewards") %>%
  67. mutate(contribution = case_when((performance1 >= threshold & performance2 < threshold)~"Player1 only",
  68. (performance2 >= threshold & performance1 < threshold)~"Player2 only",
  69. TRUE ~"Both")) %>%
  70. dplyr::select(subject,trial,task,condition,contribution,allocation_ratio,performance_ratio,shapley_ratio,SVOscore,experiment)
  72. combinedData[,5]<-factor(combinedData[,5],levels = c('Player1 only','Both','Player2 only'))
  74. combinedData$SVOscore_z <- scale(combinedData$SVOscore)
  78. ## -------------- model 1: task * condition ------------------------------------
  79. ## model fitting
  80. # task * condition
  81. fit_zoib_tc <- brm(
  82. bf(
  83. allocation_ratio ~ task * condition + (1 | subject)
  84. ),
  85. data = combinedData,
  86. family = zero_one_inflated_beta(),
  87. chains = 8, cores = 8, iter = 3000, warmup = 1000
  88. )
  89. summary(fit_zoib_tc)
  90. saveRDS(fit_zoib_tc, file = "multilevel_model/output/fit_zoib_tc.rds")
  92. # task + condition
  93. fit_zoib_tc_noInt <- brm(
  94. bf(
  95. allocation_ratio ~ task + condition + (1 | subject)
  96. ),
  97. data = combinedData,
  98. family = zero_one_inflated_beta(),
  99. chains = 8, cores = 8, iter = 3000, warmup = 1000
  100. )
  101. summary(fit_zoib_tc_noInt)
  102. saveRDS(fit_zoib_tc_noInt, file = "multilevel_model/output/fit_zoib_tc_noInt.rds")
  105. ## save model output
  106. fit_zoib_tc <- readRDS("multilevel_model/output/fit_zoib_tc.rds")
  107. summary(fit_zoib_tc)
  108. coef_table <- as.data.frame(summary(fit_zoib_tc)$fixed)
  109. coef_table <- round(coef_table, 2)
  110. write.csv(coef_table, "multilevel_model/output/tables/TabS1-1_fit_zoib_tc.csv", row.names = TRUE)
  112. ## compare model
  113. fit_zoib_tc <- readRDS("multilevel_model/output/fit_zoib_tc.rds")
  114. fit_zoib_tc_noInt <- readRDS("multilevel_model/output/fit_zoib_tc_noInt.rds")
  115. loo_compare(loo(fit_zoib_tc), loo(fit_zoib_tc_noInt)) #diff 2*SE
  117. # post hoc
  118. emm <- emmeans(fit_zoib_tc, ~ task * condition, type = "response")
  119. plot(emm)
  120. pairs(emm, by = "condition")
  121. pairs(emm, by = "task")
  122. contrast(emm, "pairwise")
  123. emm_2 <-emm %>% summary() %>% as.data.frame() %>%
  124. mutate(across(where(is.numeric), ~ round(.x, 2)))
  125. write.csv(emm_2, "multilevel_model/output/tables/TabS1-3_emms.csv", row.names = TRUE)
  127. # plot
  128. tc <- conditional_effects(fit_zoib_tc, effects = "task:condition")
  129. p <- plot(tc, plot = FALSE)[[1]]
  130. p +
  131. scale_color_manual(values = dark) +
  132. scale_fill_manual(values = dark) +
  133. theme_classic() +
  134. theme(text = element_text(size = 15)) +
  135. xlab("Task type") +
  136. ylab("Allocation Ratio")
  140. ## ------------- model 2: task * condition * SVO score ------------------------------------------
  141. # task * condition * SVOscore
  142. fit_zoib_tc_SVO <- brm(
  143. bf(
  144. allocation_ratio ~ task * condition * SVOscore_z + (1 | subject)
  145. ),
  146. data = combinedData,
  147. family = zero_one_inflated_beta(),
  148. chains = 8, cores = 8, iter = 3000, warmup = 1000
  149. )
  150. summary(fit_zoib_tc_SVO)
  151. saveRDS(fit_zoib_tc_SVO, file = "multilevel_model/output/fit_zoib_tc_SVO.rds")
  153. # compare model
  154. loo_compare(loo(fit_zoib_tc), loo(fit_zoib_tc_noInt), loo(fit_zoib_tc_SVO))
  156. # post hoc
  157. fit_zoib_tc_SVO <- readRDS("multilevel_model/output/fit_zoib_tc_SVO.rds")
  158. summary(fit_zoib_tc_SVO)
  159. coef_table <- as.data.frame(summary(fit_zoib_tc_SVO)$fixed)
  160. coef_table <- round(coef_table, 2)
  161. write.csv(coef_table, "multilevel_model/output/tables/TabS2-1_fit_zoib_tc_SVO.csv", row.names = TRUE)
  163. post_summary <- describe_posterior(fit_zoib_tc_SVO)
  164. tab_df(post_summary,
  165. title = "Posterior Estimates",
  166. file = "multilevel_model/output/fit_zoib_tc_SVO.html")
  168. slopes_SVO <- emtrends(fit_zoib_tc_SVO, ~ condition | task, var = "SVOscore_z")
  169. pairs(slopes_SVO)
  170. emm_2 <- slopes_SVO %>% summary() %>% as.data.frame() %>%
  171. mutate(across(where(is.numeric), ~ round(.x, 2)))
  172. write.csv(emm_2, "multilevel_model/output/tables/TabS2-3_emms.csv", row.names = TRUE)
  174. st <- conditional_effects(fit_zoib_tc_SVO,
  175. effects = "SVOscore_z:condition",
  176. conditions = list(task = c("Simple", "Additive", "Disjunctive")))
  177. p <- plot(st, plot = FALSE)[[1]]
  178. p + scale_color_manual(values = dark) +
  179. scale_fill_manual(values = dark) +
  180. theme_classic()+
  181. theme(text = element_text(size = 15))+
  182. xlab("SVOscore (z-score)")+
  183. ylab("Allocation Ratio") +
  184. facet_wrap(~task, labeller = labeller(task = c("Simple", "Additive", "Disjunctive"))) # custom facet names
  188. ## ----- model 3: performance ratio * task + performance ratio * condition -----
  189. ## model fitting
  190. # three way interaction
  191. fit_zoib_3way <- brm(
  192. bf(
  193. allocation_ratio ~ performance_ratio * task * condition + (1 | subject)
  194. ),
  195. data = combinedData,
  196. family = zero_one_inflated_beta(),
  197. chains = 8, cores = 8, iter = 3000, warmup = 1000
  198. )
  199. summary(fit_zoib_3way)
  200. saveRDS(fit_zoib_3way, file = "multilevel_model/output/fit_zoib_3way.rds")
  202. # two way interaction
  203. fit_zoib_2way <- brm(
  204. bf(
  205. allocation_ratio ~ performance_ratio * task + performance_ratio * condition + (1 | subject)
  206. ),
  207. data = combinedData,
  208. family = zero_one_inflated_beta(),
  209. chains = 8, cores = 8, iter = 3000, warmup = 1000
  210. )
  211. summary(fit_zoib_2way)
  212. saveRDS(fit_zoib_2way, file = "multilevel_model/output/fit_zoib_2way.rds")
  214. # no interaction
  215. fit_zoib_noInt <- brm(
  216. bf(
  217. allocation_ratio ~ performance_ratio + task + condition + (1 | subject)
  218. ),
  219. data = combinedData,
  220. family = zero_one_inflated_beta(),
  221. chains = 8, cores = 8, iter = 3000, warmup = 1000
  222. )
  223. summary(fit_zoib_noInt)
  224. saveRDS(fit_zoib_noInt, file = "multilevel_model/output/fit_zoib_noInt.rds")
  227. ## Compare model
  228. fit_zoib_3way <- readRDS("multilevel_model/output/fit_zoib_3way.rds")
  229. fit_zoib_2way <- readRDS("multilevel_model/output/fit_zoib_2way.rds")
  230. fit_zoib_noInt <- readRDS("multilevel_model/output/fit_zoib_noInt.rds")
  232. three_way_model <- loo(fit_zoib_3way)
  233. two_way_model <- loo(fit_zoib_2way)
  234. no_int_model <- loo(fit_zoib_noInt)
  235. loo_compare(three_way_model, two_way_model, no_int_model) #diff 2*SE
  238. ## post hoc
  239. # get the best model
  240. fit_zoib <- readRDS("multilevel_model/output/fit_zoib_2way.rds")
  241. summary(fit_zoib)
  242. coef_table <- as.data.frame(summary(fit_zoib)$fixed)
  243. coef_table <- round(coef_table, 2)
  244. write.csv(coef_table, "multilevel_model/output/tables/TabS3-1_fit_zoib.csv", row.names = TRUE)
  246. post_summary <- describe_posterior(fit_zoib)
  247. tab_df(post_summary,
  248. title = "Posterior Estimates",
  249. file = "multilevel_model/output/fit_zoib_2way.html")
  252. slopes_task <- emtrends(fit_zoib, ~ task, var = "performance_ratio")
  253. pairs(slopes_task)
  255. slopes_cond <- emtrends(fit_zoib, ~ condition, var = "performance_ratio")
  256. pairs(slopes_cond)
  257. emm_2 <- slopes_cond %>% summary() %>% as.data.frame() %>%
  258. mutate(across(where(is.numeric), ~ round(.x, 2)))
  259. write.csv(emm_2, "multilevel_model/output/tables/TabS3-2_emms.csv", row.names = TRUE)
  261. plot(fit_zoib, variable = c("b_performance_ratio"))
  262. plot(fit_zoib, variable = c("b_taskDisjunctive"))
  263. plot(fit_zoib, variable = c("b_conditionSelfMirrelevant"))
  265. pt <- conditional_effects(fit_zoib, effects = "performance_ratio:task")
  266. p1 <- plot(pt, plot = FALSE)[[1]]
  267. p1 + scale_color_manual(values = c( "grey85", "grey50","black")) +
  268. scale_fill_manual(values = c( "grey85", "grey50","black")) +
  269. theme_classic()+
  270. theme(text = element_text(size = 15))+
  271. xlab("Performance Ratio")+
  272. ylab("Allocation Ratio")
  274. pc <- conditional_effects(fit_zoib, effects = "performance_ratio:condition")
  275. p_2c <- plot(pc, plot = FALSE)[[1]]+
  276. scale_color_manual(values = dark) +
  277. scale_fill_manual(values = dark) +
  278. theme_bw() +
  279. theme(text = element_text(size=20),
  280. panel.grid.major = element_blank(),
  281. panel.grid.minor = element_blank(),
  282. plot.title = element_text(hjust = 0.5),
  283. axis.text.x = element_text(size = 15),
  284. axis.text.y = element_text(size = 15),
  285. panel.spacing.x = unit(0.8, "lines"),
  286. legend.text=element_text(size=15))+
  287. xlab("Relative Performance")+
  288. ylab("Relative Allocation")
  289. p_2c
  292. ## ------------------- plot Figure 2A,2B,2C ------------------------------------------
  293. # get data
  294. # combine two datasets and exclude loss trials
  295. combinedData_sub <- combinedData %>%
  296. filter(!is.na(allocation_ratio)) %>%
  297. dplyr::select(experiment,task,subject,condition,allocation_ratio,SVOscore_z) %>%
  298. group_by(experiment,task,subject,condition) %>%
  299. dplyr::summarize(mean_allocation_ratio = mean(allocation_ratio),
  300. SVOscore_z = first(SVOscore_z)) %>%
  301. select(experiment, task,condition, subject, mean_allocation_ratio, SVOscore_z)
  302. combinedData_sub$subject <- as.factor(combinedData_sub$subject)
  304. # plot Figure 2B
  305. p_2a <- ggplot(combinedData_sub, aes(x = condition, y = mean_allocation_ratio, fill = condition)) +
  306. geom_bar(stat = "summary", fun = "mean", colour = "black", position = "dodge") +
  307. geom_line(aes(group = subject),color = 'darkgray') +
  308. geom_point(aes(group = subject), shape = 21, color = 'darkgray') +
  309. stat_summary(fun.data = mean_cl_normal, na.rm =TRUE,
  310. geom = "errorbar", width = .2)+
  311. geom_hline(yintercept = 0.5,linetype="dashed", color = "black") +
  312. facet_grid(~task) +
  313. scale_fill_manual(values = dark) +
  314. theme_bw()+
  315. theme(text = element_text(size=20),
  316. panel.grid.major = element_blank(),
  317. panel.grid.minor = element_blank(),
  318. axis.text.x = element_blank(),
  319. axis.ticks.x = element_blank(),
  320. axis.text.y = element_text(size = 15),
  321. plot.title = element_text(hjust = 0.5),
  322. legend.text=element_text(size=15)) +
  323. ylab("Relative allocation") +
  324. xlab(" ") +
  325. labs(fill = "Self-relevance")
  326. p_2a
  329. # plot Figure 2B
  330. p_2b<-combinedData_sub %>%
  331. ggplot(aes(x=SVOscore_z, y=mean_allocation_ratio, color=condition)) +
  332. geom_point(shape = 20,size=5,alpha = 0.5) +
  333. theme_bw() +
  334. theme(text = element_text(size=20),
  335. panel.grid.major = element_blank(),
  336. panel.grid.minor = element_blank(),
  337. plot.title = element_text(hjust = 0.5),
  338. axis.text.x = element_text(size = 15),
  339. axis.text.y = element_text(size = 15),
  340. panel.spacing.x = unit(0.8, "lines"),
  341. legend.text=element_text(size=15))+
  342. #legend.position="none")+
  343. geom_smooth(method=lm, se = FALSE)+
  344. #stat_cor()+
  345. facet_grid(~task,scales = "free")+
  346. #scale_shape_manual(values=c(3, 16))+
  347. #geom_vline(xintercept = 22.45,linetype="dashed", color = "black") +
  348. scale_color_manual(values=dark)+
  349. xlab("SVO score (z-scored)")+
  350. ylab("Relative allocation")+
  351. labs(color = "Self-relevance")
  352. p_2b
  356. ## -------------- model 4: contribution diff -----------------------------------
  357. # calculate the differnece between self-relevant and self-irrelevant based on trial
  358. combinedData_contribution <- combinedData %>%
  359. pivot_wider(id_cols = c(experiment,subject,SVOscore_z,SVOscore,trial,task,contribution,performance_ratio),
  360. names_from = condition,
  361. values_from = allocation_ratio) %>%
  362. mutate(difference = `Self-relevant` - `Self-irrelevant`)
  365. ## model fitting
  366. fit_gaussian_c_diff <- brm(
  367. bf(
  368. difference ~ contribution + (1 | subject)
  369. ),
  370. data = combinedData_contribution,
  371. family = gaussian(),
  372. chains = 8, cores = 8, iter = 3000, warmup = 1000
  373. )
  374. summary(fit_gaussian_c_diff)
  375. saveRDS(fit_gaussian_c_diff, file = "output/fit_gaussian_c_diff.rds")
  378. ## post hoc
  379. fit_gaussian_c_diff <- readRDS("multilevel_model/output/fit_gaussian_c_diff.rds")
  380. summary(fit_gaussian_c_diff)
  381. coef_table <- as.data.frame(summary(fit_gaussian_c_diff)$fixed)
  382. coef_table <- round(coef_table, 2)
  383. write.csv(coef_table, "multilevel_model/output/tables/TabS4-2_fit_zoib.csv", row.names = TRUE)
  385. post_summary <- describe_posterior(fit_gaussian_c_diff)
  386. tab_df(post_summary,
  387. title = "Posterior Estimates",
  388. file = "multilevel_model/output/fit_gaussian_c_diff.html")
  390. emm <- emmeans(fit_gaussian_c_diff, ~ contribution, type = "response")
  391. contrast(emm, "pairwise")
  392. emm_2 <- emm %>% summary() %>% as.data.frame() %>%
  393. mutate(across(where(is.numeric), ~ round(.x, 2)))
  394. write.csv(emm_2, "multilevel_model/output/tables/TabS4-3_emms.csv", row.names = TRUE)
  397. gaussian_c_diff <- conditional_effects(fit_gaussian_c_diff, effects = "contribution")
  398. p <- plot(gaussian_c_diff, plot = FALSE)[[1]]+
  399. aes(color = contribution, fill = contribution)
  400. p +
  401. scale_color_manual(values = contribution_color) +
  402. scale_fill_manual(values = contribution_color) +
  403. theme_classic() +
  404. theme(text = element_text(size = 15)) +
  405. xlab("Contribution") +
  406. ylab("Self-allocation Bias")
  411. ## ------------- model 5: including SVO score ---------------------------------
  412. # contribution*SVOscore_z
  413. fit_gaussian_c_diff_SVO <- brm(
  414. bf(
  415. difference ~ contribution * SVOscore_z + (1 | subject)
  416. ),
  417. data = combinedData_contribution,
  418. family = gaussian(),
  419. chains = 8, cores = 8, iter = 3000, warmup = 1000
  420. )
  421. summary(fit_gaussian_c_diff_SVO)
  422. saveRDS(fit_gaussian_c_diff_SVO, file = "output/fit_gaussian_c_diff_SVO.rds")
  425. ## compare model
  426. # get model
  427. fit_gaussian_c_diff <- readRDS("output/fit_gaussian_c_diff.rds")
  428. fit_gaussian_c_diff_SVO <- readRDS("output/fit_gaussian_c_diff_SVO.rds")
  429. # check distribution
  430. # pp_check(fit_gaussian_c_diff_SVO, type = "dens_overlay")
  431. loo_compare(loo(fit_gaussian_c_diff), loo(fit_gaussian_c_diff_SVO))
  433. ## post hoc
  434. fit_gaussian_c_diff_SVO <- readRDS("multilevel_model/output/fit_gaussian_c_diff_SVO.rds")
  435. post_summary <- describe_posterior(fit_gaussian_c_diff_SVO)
  436. tab_df(post_summary,
  437. title = "Posterior Estimates",
  438. file = "multilevel_model/output/fit_gaussian_c_diff_SVO.html")
  440. slopes_SVO <- emtrends(fit_gaussian_c_diff_SVO, ~ contribution, var = "SVOscore_z")
  441. pairs(slopes_SVO)
  442. emm_2 <- slopes_SVO %>% summary() %>% as.data.frame() %>%
  443. mutate(across(where(is.numeric), ~ round(.x, 2)))
  444. write.csv(emm_2, "multilevel_model/output/tables/TabS4-5_emms.csv", row.names = TRUE)
  446. c_diff_svo <- conditional_effects(fit_gaussian_c_diff_SVO,
  447. effects = "SVOscore_z:contribution")
  448. p <- plot(c_diff_svo, plot = FALSE)[[1]]
  449. p + scale_color_manual(values = contribution_color) +
  450. scale_fill_manual(values = contribution_color) +
  451. theme_classic()+
  452. theme(text = element_text(size = 15))+
  453. xlab("SVOscore (z-score)")+
  454. ylab("Allocation Ratio")
  457. ## post hoc
  458. emm <- emmeans(fit_gaussian_c_diff_SVO, ~ contribution, type = "response")
  459. contrast(emm, "pairwise")
  460. gaussian_c_diff <- conditional_effects(fit_gaussian_c_diff_SVO, effects = "contribution")
  461. p <- plot(gaussian_c_diff, plot = FALSE)[[1]] +
  462. aes(color = contribution, fill = contribution)
  463. p +
  464. scale_color_manual(values = contribution_color) +
  465. scale_fill_manual(values = contribution_color) +
  466. theme_classic() +
  467. theme(text = element_text(size = 15)) +
  468. xlab("Contribution") +
  469. ylab("Self-allocation Bias")
  474. ## ---------------------- plot Figure 3B 3C ------------------------------------
  475. combinedData_contribution_sub <- combinedData_contribution %>%
  476. filter(!is.na(difference)) %>%
  477. dplyr::select(experiment,task,subject,contribution,difference,SVOscore_z) %>%
  478. group_by(experiment,subject,contribution) %>%
  479. dplyr::summarize(mean_diff = mean(difference),
  480. SVOscore_z = first(SVOscore_z)) %>%
  481. select(experiment,contribution, subject, mean_diff, SVOscore_z)
  482. combinedData_contribution_sub$subject <- as.factor(combinedData_contribution_sub$subject)
  484. # plot 3B
  485. p_3b<-ggplot(combinedData_contribution_sub, aes(x = contribution, y = mean_diff, fill = contribution)) +
  486. geom_bar(stat = "summary", fun = "mean", colour = "black")+
  487. geom_point(aes(group = subject), shape = 21, color = 'darkgray') +
  488. stat_summary(fun.data = mean_cl_normal, na.rm =TRUE,
  489. geom = "errorbar", width = .2)+
  490. scale_fill_manual(values = contribution_color) +
  491. theme_bw()+
  492. theme(text = element_text(size=20),
  493. panel.grid.major = element_blank(),
  494. panel.grid.minor = element_blank(),
  495. axis.ticks.x = element_blank(),
  496. axis.text.y = element_text(size = 15)) +
  497. ylab("Self allocation bias") +
  498. xlab(" ")
  499. p_3b
  503. # plot 3c
  504. p_3c <- combinedData_contribution_sub %>%
  505. ggplot(aes(x=SVOscore_z, y=mean_diff, color=contribution)) +
  506. geom_point(shape = 20,size=5,alpha = 0.8) +
  507. theme_bw() +
  508. theme(text = element_text(size=20),
  509. panel.grid.major = element_blank(),
  510. panel.grid.minor = element_blank(),
  511. plot.title = element_text(hjust = 0.5),
  512. axis.text.x = element_text(size = 15),
  513. axis.text.y = element_text(size = 15),
  514. panel.spacing.x = unit(0.8, "lines"),
  515. )+
  516. #legend.position = "none"
  517. geom_smooth(method=lm, se = FALSE)+
  518. scale_color_manual("Contribution",values=contribution_color)+
  519. # stat_cor(p.accuracy = 0.001,size = 6)+
  520. xlab("SVO score (z-scored)")+ylab("Self allocation bias")
  521. p_3c
  526. ## -------------- Experiment 1 and 2 separately -------------------------------
  527. ## -------------- model S1: task * condition ------------------------------------
  528. ## prepare data
  529. exp1Data <- combinedData %>%
  530. filter(experiment == "Experiment1")
  531. exp2Data <- combinedData %>%
  532. filter(experiment == "Experiment2")
  535. ## model fitting
  536. # exp1
  537. fit_zoib_tc_exp1 <- brm(
  538. bf(
  539. allocation_ratio ~ task * condition + (1 | subject)
  540. ),
  541. data = exp1Data,
  542. family = zero_one_inflated_beta(),
  543. chains = 8, cores = 8, iter = 3000, warmup = 1000
  544. )
  545. summary(fit_zoib_tc_exp1)
  546. saveRDS(fit_zoib_tc_exp1, file = "output/exp1_fit_zoib_tc.rds")
  548. # exp2
  549. fit_zoib_tc_exp2 <- brm(
  550. bf(
  551. allocation_ratio ~ task * condition + (1 | subject)
  552. ),
  553. data = exp2Data,
  554. family = zero_one_inflated_beta(),
  555. chains = 8, cores = 8, iter = 3000, warmup = 1000
  556. )
  557. summary(fit_zoib_tc_exp2)
  558. saveRDS(fit_zoib_tc_exp2, file = "output/exp2_fit_zoib_tc.rds")
  561. ## post hoc
  562. # get the interaction model
  563. fit_zoib_tc_exp1 <- readRDS("multilevel_model/output/exp1_fit_zoib_tc.rds")
  564. summary(fit_zoib_tc_exp1)
  565. coef_table <- as.data.frame(summary(fit_zoib_tc_exp1)$fixed)
  566. coef_table <- round(coef_table, 2)
  567. write.csv(coef_table, "multilevel_model/output/tables/TabS1-4_fit_zoib_tc.csv", row.names = TRUE)
  569. fit_zoib_tc_exp2 <- readRDS("multilevel_model/output/exp2_fit_zoib_tc.rds")
  570. summary(fit_zoib_tc_exp2)
  571. coef_table <- as.data.frame(summary(fit_zoib_tc_exp2)$fixed)
  572. coef_table <- round(coef_table, 2)
  573. write.csv(coef_table, "multilevel_model/output/tables/TabS1-7_fit_zoib_tc.csv", row.names = TRUE)
  576. # exp1
  577. emm <- emmeans(fit_zoib_tc_exp1, ~ task * condition, type = "response")
  578. plot(emm)
  579. pairs(emm, by = "condition")
  580. pairs(emm, by = "task")
  581. contrast(emm, "pairwise")
  582. emm_2 <-emm %>% summary() %>% as.data.frame() %>%
  583. mutate(across(where(is.numeric), ~ round(.x, 2)))
  584. write.csv(emm_2, "multilevel_model/output/tables/TabS1-6_emms.csv", row.names = TRUE)
  586. tc_exp1 <- conditional_effects(fit_zoib_tc_exp1, effects = "task:condition")
  587. p <- plot(tc_exp1, plot = FALSE)[[1]]
  588. p +
  589. scale_color_manual(values = dark) +
  590. scale_fill_manual(values = dark) +
  591. theme_classic() +
  592. theme(text = element_text(size = 15)) +
  593. xlab("Task type") +
  594. ylab("Allocation Ratio") +
  595. ggtitle("Experiment 1")
  596. # exp2
  597. emm <- emmeans(fit_zoib_tc_exp2, ~ task * condition, type = "response")
  598. plot(emm)
  599. pairs(emm, by = "condition")
  600. pairs(emm, by = "task")
  601. contrast(emm, "pairwise")
  602. emm_2 <-emm %>% summary() %>% as.data.frame() %>%
  603. mutate(across(where(is.numeric), ~ round(.x, 2)))
  604. write.csv(emm_2, "multilevel_model/output/tables/TabS1-9_emms.csv", row.names = TRUE)
  606. tc_exp2 <- conditional_effects(fit_zoib_tc_exp2, effects = "task:condition")
  607. p <- plot(tc_exp2, plot = FALSE)[[1]]
  608. p +
  609. scale_color_manual(values = dark) +
  610. scale_fill_manual(values = dark) +
  611. theme_classic() +
  612. theme(text = element_text(size = 15)) +
  613. xlab("Task type") +
  614. ylab("Allocation Ratio") +
  615. ggtitle("Experiment 2")
  618. # ------------- model S2: including SVO score ------------------------------------------
  619. # task * condition * SVOscore
  620. fit_zoib_tc_SVO_exp1 <- brm(
  621. bf(
  622. allocation_ratio ~ task * condition * SVOscore_z + (1 | subject)
  623. ),
  624. data = exp1Data,
  625. family = zero_one_inflated_beta(),
  626. chains = 8, cores = 8, iter = 3000, warmup = 1000
  627. )
  628. summary(fit_zoib_tc_SVO_exp1)
  629. saveRDS(fit_zoib_tc_SVO_exp1, file = "output/exp1_fit_zoib_tc_SVO.rds")
  631. # exp2
  632. fit_zoib_tc_SVO_exp2 <- brm(
  633. bf(
  634. allocation_ratio ~ task * condition * SVOscore_z + (1 | subject)
  635. ),
  636. data = exp2Data,
  637. family = zero_one_inflated_beta(),
  638. chains = 8, cores = 8, iter = 3000, warmup = 1000
  639. )
  640. summary(fit_zoib_tc_SVO_exp2)
  641. saveRDS(fit_zoib_tc_SVO_exp2, file = "output/exp2_fit_zoib_tc_SVO.rds")
  644. # post hoc
  645. fit_zoib_tc_SVO_exp1 <- readRDS("multilevel_model/output/exp1_fit_zoib_tc_SVO.rds")
  646. summary(fit_zoib_tc_SVO_exp1)
  647. coef_table <- as.data.frame(summary(fit_zoib_tc_SVO_exp1)$fixed)
  648. coef_table <- round(coef_table, 2)
  649. write.csv(coef_table, "multilevel_model/output/tables/TabS2-4_fit_zoib_tc_SVO.csv", row.names = TRUE)
  651. fit_zoib_tc_SVO_exp2 <- readRDS("multilevel_model/output/exp2_fit_zoib_tc_SVO.rds")
  652. summary(fit_zoib_tc_SVO_exp2)
  653. coef_table <- as.data.frame(summary(fit_zoib_tc_SVO_exp2)$fixed)
  654. coef_table <- round(coef_table, 2)
  655. write.csv(coef_table, "multilevel_model/output/tables/TabS2-7_fit_zoib_tc_SVO.csv", row.names = TRUE)
  657. # exp1
  658. slopes_SVO <- emtrends(fit_zoib_tc_SVO_exp1, ~ condition | task, var = "SVOscore_z")
  659. pairs(slopes_SVO)
  660. emm_2 <-slopes_SVO %>% summary() %>% as.data.frame() %>%
  661. mutate(across(where(is.numeric), ~ round(.x, 2)))
  662. write.csv(emm_2, "multilevel_model/output/tables/TabS2-6_emms.csv", row.names = TRUE)
  664. st <- conditional_effects(fit_zoib_tc_SVO_exp1,
  665. effects = "SVOscore_z:condition",
  666. conditions = list(task = c("Simple", "Additive", "Disjunctive")))
  667. p <- plot(st, plot = FALSE)[[1]]
  668. p + scale_color_manual(values = dark) +
  669. scale_fill_manual(values = dark) +
  670. theme_classic()+
  671. theme(text = element_text(size = 15))+
  672. xlab("SVOscore (z-score)")+
  673. ylab("Allocation Ratio") +
  674. ggtitle("Experiment 1") +
  675. facet_wrap(~task, labeller = labeller(task = c("Simple", "Additive", "Disjunctive"))) # custom facet names
  677. # exp2
  678. slopes_SVO <- emtrends(fit_zoib_tc_SVO_exp2, ~ condition | task, var = "SVOscore_z")
  679. pairs(slopes_SVO)
  680. emm_2 <-slopes_SVO %>% summary() %>% as.data.frame() %>%
  681. mutate(across(where(is.numeric), ~ round(.x, 2)))
  682. write.csv(emm_2, "multilevel_model/output/tables/TabS2-9_emms.csv", row.names = TRUE)
  684. st <- conditional_effects(fit_zoib_tc_SVO_exp2,
  685. effects = "SVOscore_z:condition",
  686. conditions = list(task = c("Simple", "Additive", "Disjunctive")))
  687. p <- plot(st, plot = FALSE)[[1]]
  688. p + scale_color_manual(values = dark) +
  689. scale_fill_manual(values = dark) +
  690. theme_classic()+
  691. theme(text = element_text(size = 15))+
  692. xlab("SVOscore (z-score)")+
  693. ylab("Allocation Ratio") +
  694. ggtitle("Experiment 2") +
  695. facet_wrap(~task, labeller = labeller(task = c("Simple", "Additive", "Disjunctive"))) # custom facet names
  700. ## ----- model S3: performance ratio * task + performance ratio * condition -----
  701. ## model fitting
  702. # exp1
  703. fit_zoib_2way_exp1 <- brm(
  704. bf(
  705. allocation_ratio ~ performance_ratio * task + performance_ratio * condition + (1 | subject)
  706. ),
  707. data = exp1Data,
  708. family = zero_one_inflated_beta(),
  709. chains = 8, cores = 8, iter = 3000, warmup = 1000
  710. )
  711. summary(fit_zoib_2way_exp1)
  712. saveRDS(fit_zoib_2way_exp1, file = "output/exp1_fit_zoib_2way.rds")
  714. # exp2
  715. fit_zoib_2way_exp2 <- brm(
  716. bf(
  717. allocation_ratio ~ performance_ratio * task + performance_ratio * condition + (1 | subject)
  718. ),
  719. data = exp2Data,
  720. family = zero_one_inflated_beta(),
  721. chains = 8, cores = 8, iter = 3000, warmup = 1000
  722. )
  723. summary(fit_zoib_2way_exp2)
  724. saveRDS(fit_zoib_2way_exp2, file = "output/exp2_fit_zoib_2way.rds")
  728. # post hoc
  729. fit_zoib_2way_exp1 <- readRDS("multilevel_model/output/exp1_fit_zoib_2way.rds")
  730. summary(fit_zoib_2way_exp1)
  731. coef_table <- as.data.frame(summary(fit_zoib_2way_exp1)$fixed)
  732. coef_table <- round(coef_table, 2)
  733. write.csv(coef_table, "multilevel_model/output/tables/TabS3-4_fit_zoib.csv", row.names = TRUE)
  735. fit_zoib_2way_exp2 <- readRDS("multilevel_model/output/exp2_fit_zoib_2way.rds")
  736. summary(fit_zoib_2way_exp2)
  737. coef_table <- as.data.frame(summary(fit_zoib_2way_exp2)$fixed)
  738. coef_table <- round(coef_table, 2)
  739. write.csv(coef_table, "multilevel_model/output/tables/TabS3-7_fit_zoib.csv", row.names = TRUE)
  742. #exp1
  743. slopes_task <- emtrends(fit_zoib_2way_exp1, ~ task, var = "performance_ratio")
  744. pairs(slopes_task)
  746. slopes_cond <- emtrends(fit_zoib_2way_exp1, ~ condition, var = "performance_ratio")
  747. pairs(slopes_cond)
  748. emm_2 <- slopes_cond %>% summary() %>% as.data.frame() %>%
  749. mutate(across(where(is.numeric), ~ round(.x, 2)))
  750. write.csv(emm_2, "multilevel_model/output/tables/TabS3-5_emms.csv", row.names = TRUE)
  752. plot(fit_zoib_2way_exp1, variable = c("b_performance_ratio"))
  753. plot(fit_zoib_2way_exp1, variable = c("b_taskDisjunctive"))
  754. plot(fit_zoib_2way_exp1, variable = c("b_conditionSelfMirrelevant"))
  757. pc <- conditional_effects(fit_zoib_2way_exp1, effects = "performance_ratio:condition")
  758. p_s2c <- plot(pc, plot = FALSE)[[1]] +
  759. scale_color_manual(values = dark) +
  760. scale_fill_manual(values = dark) +
  761. theme_bw() +
  762. theme(text = element_text(size=20),
  763. panel.grid.major = element_blank(),
  764. panel.grid.minor = element_blank(),
  765. plot.title = element_text(hjust = 0.5),
  766. axis.text.x = element_text(size = 15),
  767. axis.text.y = element_text(size = 15),
  768. panel.spacing.x = unit(0.8, "lines"),
  769. legend.text=element_text(size=15))+
  770. xlab("Performance Ratio")+
  771. ylab("Allocation Ratio")+
  772. ggtitle("Experiment 1")
  773. p_s2c
  775. pt <- conditional_effects(fit_zoib_2way_exp1, effects = "performance_ratio:task")
  776. p_s2d <- plot(pt, plot = FALSE)[[1]] +
  777. scale_color_manual(values = c( "grey85", "grey50","black")) +
  778. scale_fill_manual(values = c( "grey85", "grey50","black")) +
  779. theme_bw() +
  780. theme(text = element_text(size=20),
  781. panel.grid.major = element_blank(),
  782. panel.grid.minor = element_blank(),
  783. plot.title = element_text(hjust = 0.5),
  784. axis.text.x = element_text(size = 15),
  785. axis.text.y = element_text(size = 15),
  786. panel.spacing.x = unit(0.8, "lines"),
  787. legend.text=element_text(size=15))+
  788. xlab("Performance Ratio")+
  789. ylab("Allocation Ratio")+
  790. ggtitle("Experiment 1")
  791. p_s2d
  793. #exp2
  794. slopes_task <- emtrends(fit_zoib_2way_exp2, ~ task, var = "performance_ratio")
  795. pairs(slopes_task)
  797. slopes_cond <- emtrends(fit_zoib_2way_exp2, ~ condition, var = "performance_ratio")
  798. pairs(slopes_cond)
  799. emm_2 <- slopes_cond %>% summary() %>% as.data.frame() %>%
  800. mutate(across(where(is.numeric), ~ round(.x, 2)))
  801. write.csv(emm_2, "multilevel_model/output/tables/TabS3-8_emms.csv", row.names = TRUE)
  803. plot(fit_zoib_2way_exp2, variable = c("b_performance_ratio"))
  804. plot(fit_zoib_2way_exp2, variable = c("b_taskDisjunctive"))
  805. plot(fit_zoib_2way_exp2, variable = c("b_conditionSelfMirrelevant"))
  808. pc <- conditional_effects(fit_zoib_2way_exp2, effects = "performance_ratio:condition")
  809. p_s2g <- plot(pc, plot = FALSE)[[1]] +
  810. scale_color_manual(values = dark) +
  811. scale_fill_manual(values = dark) +
  812. theme_bw() +
  813. theme(text = element_text(size=20),
  814. panel.grid.major = element_blank(),
  815. panel.grid.minor = element_blank(),
  816. plot.title = element_text(hjust = 0.5),
  817. axis.text.x = element_text(size = 15),
  818. axis.text.y = element_text(size = 15),
  819. panel.spacing.x = unit(0.8, "lines"),
  820. legend.text=element_text(size=15))+
  821. xlab("Performance Ratio")+
  822. ylab("Allocation Ratio")+
  823. ggtitle("Experiment 2")
  824. p_s2g
  827. pt <- conditional_effects(fit_zoib_2way_exp2, effects = "performance_ratio:task")
  828. p_s2h <- plot(pt, plot = FALSE)[[1]] +
  829. scale_color_manual(values = c( "grey85", "grey50","black")) +
  830. scale_fill_manual(values = c( "grey85", "grey50","black")) +
  831. theme_bw() +
  832. theme(text = element_text(size=20),
  833. panel.grid.major = element_blank(),
  834. panel.grid.minor = element_blank(),
  835. plot.title = element_text(hjust = 0.5),
  836. axis.text.x = element_text(size = 15),
  837. axis.text.y = element_text(size = 15),
  838. panel.spacing.x = unit(0.8, "lines"),
  839. legend.text=element_text(size=15))+
  840. xlab("Performance Ratio")+
  841. ylab("Allocation Ratio")+
  842. ggtitle("Experiment 2")
  843. p_s2h
  847. ## --------------------------- plot Figure S2: Experiment 1 --------------------
  848. # plot Figure S2A
  849. Exp1_sub <- combinedData_sub %>%
  850. filter(experiment == "Experiment1")
  852. p_S2a <- ggplot(Exp1_sub, aes(x = condition, y = mean_allocation_ratio, fill = condition)) +
  853. geom_bar(stat = "summary", fun = "mean", colour = "black", position = "dodge") +
  854. geom_line(aes(group = subject),color = 'darkgray') +
  855. geom_point(aes(group = subject), shape = 21, color = 'darkgray') +
  856. stat_summary(fun.data = mean_cl_normal, na.rm =TRUE,
  857. geom = "errorbar", width = .2)+
  858. geom_hline(yintercept = 0.5,linetype="dashed", color = "black") +
  859. facet_grid(~task) +
  860. scale_fill_manual(values = dark) +
  861. theme_bw()+
  862. theme(text = element_text(size=20),
  863. panel.grid.major = element_blank(),
  864. panel.grid.minor = element_blank(),
  865. axis.text.x = element_blank(),
  866. axis.ticks.x = element_blank(),
  867. axis.text.y = element_text(size = 15),
  868. plot.title = element_text(hjust = 0.5),
  869. legend.text=element_text(size=15)) +
  870. ylab("Relative allocation") +
  871. xlab(" ") +
  872. labs(fill = "Self-relevance", title = "Experiment 1")
  873. p_S2a
  875. # plot Figure S2B
  876. p_s2b<-Exp1_sub %>%
  877. ggplot(aes(x=SVOscore_z, y=mean_allocation_ratio, color=condition)) +
  878. geom_point(shape = 20,size=5,alpha = 0.5) +
  879. theme_bw() +
  880. theme(text = element_text(size=20),
  881. panel.grid.major = element_blank(),
  882. panel.grid.minor = element_blank(),
  883. plot.title = element_text(hjust = 0.5),
  884. axis.text.x = element_text(size = 15),
  885. axis.text.y = element_text(size = 15),
  886. panel.spacing.x = unit(0.8, "lines"),
  887. legend.text=element_text(size=15))+
  888. #legend.position="none")+
  889. geom_smooth(method=lm, se = FALSE)+
  890. #stat_cor()+
  891. facet_grid(~task,scales = "free")+
  892. #scale_shape_manual(values=c(3, 16))+
  893. #geom_vline(xintercept = 22.45,linetype="dashed", color = "black") +
  894. scale_color_manual(values=dark)+
  895. xlab("SVO score (z-scored)")+
  896. ylab("Relative allocation")+
  897. labs(color = "Self-relevance")
  898. p_s2b
  901. ## Experiment 2
  902. Exp2_sub <- combinedData_sub %>%
  903. filter(experiment == "Experiment2")
  905. # figure S2e
  906. p_S2e <- ggplot(Exp2_sub, aes(x = condition, y = mean_allocation_ratio, fill = condition)) +
  907. geom_bar(stat = "summary", fun = "mean", colour = "black", position = "dodge") +
  908. geom_line(aes(group = subject),color = 'darkgray') +
  909. geom_point(aes(group = subject), shape = 21, color = 'darkgray') +
  910. stat_summary(fun.data = mean_cl_normal, na.rm =TRUE,
  911. geom = "errorbar", width = .2)+
  912. geom_hline(yintercept = 0.5,linetype="dashed", color = "black") +
  913. facet_grid(~task) +
  914. scale_fill_manual(values = dark) +
  915. theme_bw()+
  916. theme(text = element_text(size=20),
  917. panel.grid.major = element_blank(),
  918. panel.grid.minor = element_blank(),
  919. axis.text.x = element_blank(),
  920. axis.ticks.x = element_blank(),
  921. axis.text.y = element_text(size = 15),
  922. plot.title = element_text(hjust = 0.5),
  923. legend.text=element_text(size=15)) +
  924. ylab("Relative allocation") +
  925. xlab(" ") +
  926. labs(fill = "Self-relevance", title = "Experiment 2")
  927. p_S2e
  930. # plot Figure S2f
  931. p_s2f<-Exp2_sub %>%
  932. ggplot(aes(x=SVOscore_z, y=mean_allocation_ratio, color=condition)) +
  933. geom_point(shape = 20,size=5,alpha = 0.5) +
  934. theme_bw() +
  935. theme(text = element_text(size=20),
  936. panel.grid.major = element_blank(),
  937. panel.grid.minor = element_blank(),
  938. plot.title = element_text(hjust = 0.5),
  939. axis.text.x = element_text(size = 15),
  940. axis.text.y = element_text(size = 15),
  941. panel.spacing.x = unit(0.8, "lines"),
  942. legend.text=element_text(size=15))+
  943. #legend.position="none")+
  944. geom_smooth(method=lm, se = FALSE)+
  945. #stat_cor()+
  946. facet_grid(~task,scales = "free")+
  947. #scale_shape_manual(values=c(3, 16))+
  948. #geom_vline(xintercept = 22.45,linetype="dashed", color = "black") +
  949. scale_color_manual(values=dark)+
  950. xlab("SVO score (z-scored)")+
  951. ylab("Relative allocation")+
  952. labs(color = "Self-relevance")
  953. p_s2f
  956. ## -------------- model S4: contribution on diff -------------------------------
  957. ## prepare data
  958. # calculate the differnece between self-relevant and self-irrelevant based on trial
  959. combinedData_contribution <- combinedData %>%
  960. pivot_wider(id_cols = c(experiment,subject,SVOscore_z,SVOscore,trial,task,contribution,performance_ratio),
  961. names_from = condition,
  962. values_from = allocation_ratio) %>%
  963. mutate(difference = `Self-relevant` - `Self-irrelevant`)
  964. exp1Data_contribution <- combinedData_contribution %>%
  965. filter(experiment == "Experiment1")
  966. exp2Data_contribution <- combinedData_contribution %>%
  967. filter(experiment == "Experiment2")
  969. ## model fitting
  970. #exp1
  971. fit_gaussian_c_diff_exp1 <- brm(
  972. bf(
  973. difference ~ contribution + (1 | subject)
  974. ),
  975. data = exp1Data_contribution,
  976. family = gaussian(),
  977. chains = 8, cores = 8, iter = 3000, warmup = 1000
  978. )
  979. summary(fit_gaussian_c_diff_exp1)
  980. saveRDS(fit_gaussian_c_diff_exp1, file = "output/exp1_fit_gaussian_c_diff.rds")
  982. #exp2
  983. fit_gaussian_c_diff_exp2 <- brm(
  984. bf(
  985. difference ~ contribution + (1 | subject)
  986. ),
  987. data = exp2Data_contribution,
  988. family = gaussian(),
  989. chains = 8, cores = 8, iter = 3000, warmup = 1000
  990. )
  991. summary(fit_gaussian_c_diff_exp2)
  992. saveRDS(fit_gaussian_c_diff_exp2, file = "output/exp2_fit_gaussian_c_diff.rds")
  995. ## post hoc
  996. fit_gaussian_c_diff_exp1 <- readRDS("multilevel_model/output/exp1_fit_gaussian_c_diff.rds")
  997. summary(fit_gaussian_c_diff_exp1)
  998. coef_table <- as.data.frame(summary(fit_gaussian_c_diff_exp1)$fixed)
  999. coef_table <- round(coef_table, 2)
  1000. write.csv(coef_table, "multilevel_model/output/tables/TabS4-7_fit_zoib.csv", row.names = TRUE)
  1002. fit_gaussian_c_diff_exp2 <- readRDS("multilevel_model/output/exp2_fit_gaussian_c_diff.rds")
  1003. summary(fit_gaussian_c_diff_exp2)
  1004. coef_table <- as.data.frame(summary(fit_gaussian_c_diff_exp2)$fixed)
  1005. coef_table <- round(coef_table, 2)
  1006. write.csv(coef_table, "multilevel_model/output/tables/TabS4-12_fit_zoib.csv", row.names = TRUE)
  1008. # exp1
  1009. emm <- emmeans(fit_gaussian_c_diff_exp1, ~ contribution, type = "response")
  1010. contrast(emm, "pairwise")
  1011. emm_2 <- emm %>% summary() %>% as.data.frame() %>%
  1012. mutate(across(where(is.numeric), ~ round(.x, 2)))
  1013. write.csv(emm_2, "multilevel_model/output/tables/TabS4-8_emms.csv", row.names = TRUE)
  1015. gaussian_c_diff <- conditional_effects(fit_gaussian_c_diff_exp1, effects = "contribution")
  1016. p <- plot(gaussian_c_diff, plot = FALSE)[[1]]+
  1017. aes(color = contribution, fill = contribution)
  1018. p +
  1019. scale_color_manual(values = contribution_color) +
  1020. scale_fill_manual(values = contribution_color) +
  1021. theme_classic() +
  1022. theme(text = element_text(size = 15)) +
  1023. xlab("Contribution") +
  1024. ylab("Self-allocation Bias") +
  1025. ggtitle("Experiment 1")
  1027. #exp2
  1028. emm <- emmeans(fit_gaussian_c_diff_exp2, ~ contribution, type = "response")
  1029. contrast(emm, "pairwise")
  1030. emm_2 <- emm %>% summary() %>% as.data.frame() %>%
  1031. mutate(across(where(is.numeric), ~ round(.x, 2)))
  1032. write.csv(emm_2, "multilevel_model/output/tables/TabS4-13_emms.csv", row.names = TRUE)
  1035. gaussian_c_diff <- conditional_effects(fit_gaussian_c_diff_exp2, effects = "contribution")
  1036. p <- plot(gaussian_c_diff, plot = FALSE)[[1]]+
  1037. aes(color = contribution, fill = contribution)
  1038. p +
  1039. scale_color_manual(values = contribution_color) +
  1040. scale_fill_manual(values = contribution_color) +
  1041. theme_classic() +
  1042. theme(text = element_text(size = 15)) +
  1043. xlab("Contribution") +
  1044. ylab("Self-allocation Bias") +
  1045. ggtitle("Experiment 2")
  1050. ## ------------- model S5: including SVO score ------------------------------------------
  1051. # exp1
  1052. fit_gaussian_c_diff_SVO_exp1 <- brm(
  1053. bf(
  1054. difference ~ contribution * SVOscore_z + (1 | subject)
  1055. ),
  1056. data = exp1Data_contribution,
  1057. family = gaussian(),
  1058. chains = 8, cores = 8, iter = 3000, warmup = 1000
  1059. )
  1060. summary(fit_gaussian_c_diff_SVO_exp1)
  1061. saveRDS(fit_gaussian_c_diff_SVO_exp1, file = "output/exp1_fit_gaussian_c_diff_SVO.rds")
  1062. #exp2
  1063. fit_gaussian_c_diff_SVO_exp2 <- brm(
  1064. bf(
  1065. difference ~ contribution * SVOscore_z + (1 | subject)
  1066. ),
  1067. data = exp2Data_contribution,
  1068. family = gaussian(),
  1069. chains = 8, cores = 8, iter = 3000, warmup = 1000
  1070. )
  1071. summary(fit_gaussian_c_diff_SVO_exp2)
  1072. saveRDS(fit_gaussian_c_diff_SVO_exp2, file = "output/exp2_fit_gaussian_c_diff_SVO.rds")
  1075. ## post hoc
  1076. #exp1
  1077. fit_gaussian_c_diff_SVO_exp1 <- readRDS("multilevel_model/output/exp1_fit_gaussian_c_diff_SVO.rds")
  1078. slopes_SVO <- emtrends(fit_gaussian_c_diff_SVO_exp1, ~ contribution, var = "SVOscore_z")
  1079. pairs(slopes_SVO)
  1080. emm_2 <- slopes_SVO %>% summary() %>% as.data.frame() %>%
  1081. mutate(across(where(is.numeric), ~ round(.x, 2)))
  1082. write.csv(emm_2, "multilevel_model/output/tables/TabS4-10_emms.csv", row.names = TRUE)
  1085. c_diff_svo <- conditional_effects(fit_gaussian_c_diff_SVO_exp1,
  1086. effects = "SVOscore_z:contribution")
  1087. p <- plot(c_diff_svo, plot = FALSE)[[1]]
  1088. p + scale_color_manual(values = contribution_color) +
  1089. scale_fill_manual(values = contribution_color) +
  1090. theme_classic()+
  1091. theme(text = element_text(size = 15))+
  1092. xlab("SVOscore (z-score)")+
  1093. ylab("Allocation Ratio") +
  1094. ggtitle("Experiment 1")
  1096. #exp2
  1097. fit_gaussian_c_diff_SVO_exp2 <- readRDS("multilevel_model/output/exp2_fit_gaussian_c_diff_SVO.rds")
  1098. slopes_SVO <- emtrends(fit_gaussian_c_diff_SVO_exp2, ~ contribution, var = "SVOscore_z")
  1099. pairs(slopes_SVO)
  1100. emm_2 <- slopes_SVO %>% summary() %>% as.data.frame() %>%
  1101. mutate(across(where(is.numeric), ~ round(.x, 2)))
  1102. write.csv(emm_2, "multilevel_model/output/tables/TabS4-15_emms.csv", row.names = TRUE)
  1105. slopes_SVO <- emtrends(fit_gaussian_c_diff_SVO_exp2, ~ contribution, var = "SVOscore_z")
  1106. pairs(slopes_SVO)
  1108. c_diff_svo <- conditional_effects(fit_gaussian_c_diff_SVO_exp2,
  1109. effects = "SVOscore_z:contribution")
  1110. p <- plot(c_diff_svo, plot = FALSE)[[1]]
  1111. p + scale_color_manual(values = contribution_color) +
  1112. scale_fill_manual(values = contribution_color) +
  1113. theme_classic()+
  1114. theme(text = element_text(size = 15))+
  1115. xlab("SVOscore (z-score)")+
  1116. ylab("Allocation Ratio") +
  1117. ggtitle("Experiment 2")
  1121. ## ---------------------- plot Figure S3 ------------------------------------
  1122. exp1Data_contribution_sub <- combinedData_contribution_sub %>%
  1123. filter(experiment == "Experiment1")
  1124. exp2Data_contribution_sub <- combinedData_contribution_sub %>%
  1125. filter(experiment == "Experiment2")
  1127. ## experiment 1
  1128. # plot S3a
  1129. p_s3a<-ggplot(exp1Data_contribution_sub, aes(x = contribution, y = mean_diff, fill = contribution)) +
  1130. geom_bar(stat = "summary", fun = "mean", colour = "black")+
  1131. geom_point(aes(group = subject), shape = 21, color = 'darkgray') +
  1132. stat_summary(fun.data = mean_cl_normal, na.rm =TRUE,
  1133. geom = "errorbar", width = .2)+
  1134. scale_fill_manual(values = contribution_color) +
  1135. theme_bw()+
  1136. theme(text = element_text(size=20),
  1137. panel.grid.major = element_blank(),
  1138. panel.grid.minor = element_blank(),
  1139. axis.ticks.x = element_blank(),
  1140. axis.text.y = element_text(size = 15),
  1141. legend.position = "none") +
  1142. ylab("Self allocation bias") +
  1143. xlab(" ")
  1144. p_s3a
  1147. # plot s3b
  1148. p_s3b <- exp1Data_contribution_sub %>%
  1149. ggplot(aes(x=SVOscore_z, y=mean_diff, color=contribution)) +
  1150. geom_point(shape = 20,size=5,alpha = 0.8) +
  1151. theme_bw() +
  1152. theme(text = element_text(size=20),
  1153. panel.grid.major = element_blank(),
  1154. panel.grid.minor = element_blank(),
  1155. plot.title = element_text(hjust = 0.5),
  1156. axis.text.x = element_text(size = 15),
  1157. axis.text.y = element_text(size = 15),
  1158. panel.spacing.x = unit(0.8, "lines"),
  1159. legend.position = "none")+
  1160. geom_smooth(method=lm, se = FALSE)+
  1161. scale_color_manual("Contribution",values=contribution_color)+
  1162. # stat_cor(p.accuracy = 0.001,size = 6)+
  1163. xlab("SVO score (z-scored)")+ylab("Self allocation bias")
  1164. p_s3b
  1167. ## experiment 2
  1168. # plot S3c
  1169. p_s3c<-ggplot(exp2Data_contribution_sub, aes(x = contribution, y = mean_diff, fill = contribution)) +
  1170. geom_bar(stat = "summary", fun = "mean", colour = "black")+
  1171. geom_point(aes(group = subject), shape = 21, color = 'darkgray') +
  1172. stat_summary(fun.data = mean_cl_normal, na.rm =TRUE,
  1173. geom = "errorbar", width = .2)+
  1174. scale_fill_manual(values = contribution_color) +
  1175. theme_bw()+
  1176. theme(text = element_text(size=20),
  1177. panel.grid.major = element_blank(),
  1178. panel.grid.minor = element_blank(),
  1179. axis.ticks.x = element_blank(),
  1180. axis.text.y = element_text(size = 15),
  1181. legend.position = "none") +
  1182. ylab("Self allocation bias") +
  1183. xlab(" ")
  1184. p_s3c
  1187. # plot s3d
  1188. p_s3d <- exp2Data_contribution_sub %>%
  1189. ggplot(aes(x=SVOscore_z, y=mean_diff, color=contribution)) +
  1190. geom_point(shape = 20,size=5,alpha = 0.8) +
  1191. theme_bw() +
  1192. theme(text = element_text(size=20),
  1193. panel.grid.major = element_blank(),
  1194. panel.grid.minor = element_blank(),
  1195. plot.title = element_text(hjust = 0.5),
  1196. axis.text.x = element_text(size = 15),
  1197. axis.text.y = element_text(size = 15),
  1198. panel.spacing.x = unit(0.8, "lines"),
  1199. legend.position = "none" )+
  1200. geom_smooth(method=lm, se = FALSE)+
  1201. scale_color_manual("Contribution",values=contribution_color)+
  1202. # stat_cor(p.accuracy = 0.001,size = 6)+
  1203. xlab("SVO score (z-scored)")+ylab("Self allocation bias")
  1204. p_s3d
  1207. ## -------------- Plot: contribution * contribution -----------------------
  1208. combinedData_conditionContribution_cub <- combinedData %>%
  1209. filter(!is.na(allocation_ratio)) %>%
  1210. dplyr::select(experiment,contribution,subject,condition,allocation_ratio,SVOscore_z) %>%
  1211. group_by(experiment,contribution,subject,condition) %>%
  1212. dplyr::summarize(mean_allocation_ratio = mean(allocation_ratio),
  1213. SVOscore_z = first(SVOscore_z)) %>%
  1214. select(experiment, contribution,condition, subject, mean_allocation_ratio, SVOscore_z)
  1215. combinedData_conditionContribution_cub$subject <- as.factor(combinedData_conditionContribution_cub$subject)
  1217. p_s3 <- ggplot(combinedData_conditionContribution_cub, aes(x = condition, y = mean_allocation_ratio, fill = condition)) +
  1218. geom_bar(stat = "summary", fun = "mean", colour = "black", position = "dodge") +
  1219. geom_line(aes(group = subject),color = 'darkgray') +
  1220. geom_point(aes(group = subject), shape = 21, color = 'darkgray') +
  1221. stat_summary(fun.data = mean_cl_normal, na.rm =TRUE,
  1222. geom = "errorbar", width = .2)+
  1223. geom_hline(yintercept = 0.5,linetype="dashed", color = "black") +
  1224. facet_grid(~contribution) +
  1225. scale_fill_manual(values = dark) +
  1226. theme_bw()+
  1227. theme(text = element_text(size=20),
  1228. panel.grid.major = element_blank(),
  1229. panel.grid.minor = element_blank(),
  1230. axis.text.x = element_blank(),
  1231. axis.ticks.x = element_blank(),
  1232. axis.text.y = element_text(size = 15),
  1233. plot.title = element_text(hjust = 0.5),
  1234. legend.text=element_text(size=15)) +
  1235. ylab("Relative allocation") +
  1236. xlab(" ") +
  1237. labs(fill = "Self-relevance")
  1238. p_s3
  1242. ## ------------------- Experiment 3 --------------------------------------------
  1243. ## ------------------- prepare data --------------------------------------------
  1244. Exp3_data <- read.csv(".../Exp3_data.csv", header = TRUE)
  1246. # add svo score
  1247. SVOdataExp3 <-read.csv(".../Exp3_SVOscore.csv", header = TRUE)
  1248. Exp3_data <- Exp3_data %>%
  1249. left_join(SVOdataExp3, by = "subject") %>%
  1250. mutate(experiment = 'Experiment3')
  1252. Exp3_data <- Exp3_data %>%
  1253. filter( winorloss=="Rewards") %>%
  1254. mutate( contribution = case_when((performance1 >= threshold & performance2 < threshold)~"Player1 only",
  1255. (performance2 >= threshold & performance1 < threshold)~"Player2 only",
  1256. TRUE ~"Both"),
  1257. p_source = case_when((condition == "SforS" | condition == "SforO") ~"Self-relevant",
  1258. (condition == "OforS" | condition == "OforO") ~"Self-irrelevant"),
  1259. a_target = case_when((condition == "SforS" | condition == "OforS") ~"Self-relevant",
  1260. (condition == "SforO" | condition == "OforO") ~"Self-irrelevant")) %>%
  1261. dplyr::select(subject,trial,task,condition,contribution,p_source, a_target, allocation_ratio,performance_ratio,SVOscore,experiment)
  1263. # factorize variables
  1264. Exp3_data$task <-factor(Exp3_data$task,c('Simple','Additive','Disjunctive'))
  1265. Exp3_data$condition <- factor(Exp3_data$condition, c("SforS","OforS","SforO","OforO"))
  1266. Exp3_data$p_source <- factor(Exp3_data$p_source,levels = c('Self-relevant','Self-irrelevant'))
  1267. Exp3_data$a_target <- factor(Exp3_data$a_target,levels = c('Self-relevant','Self-irrelevant'))
  1268. Exp3_data$contribution<-factor(Exp3_data$contribution,levels = c('Player1 only','Both','Player2 only'))
  1269. Exp3_data$SVOscore_z <- scale(Exp3_data$SVOscore)
  1272. ## ----------- model 1 task * performance source * allocation target -----------
  1273. # task * performance source * allocation target
  1274. fit_zoib_tpa <- brm(
  1275. bf(
  1276. allocation_ratio ~ task * p_source * a_target + (1 | subject)
  1277. ),
  1278. data = Exp3_data,
  1279. family = zero_one_inflated_beta(),
  1280. chains = 8, cores = 8, iter = 3000, warmup = 1000
  1281. )
  1282. summary(fit_zoib_tpa)
  1283. saveRDS(fit_zoib_tpa, file = "output/exp3_fit_zoib_tpa.rds")
  1285. # task + performance source + allocation target
  1286. fit_zoib_tpa_noInt <- brm(
  1287. bf(
  1288. allocation_ratio ~ task + p_source + a_target + (1 | subject)
  1289. ),
  1290. data = Exp3_data,
  1291. family = zero_one_inflated_beta(),
  1292. chains = 8, cores = 8, iter = 3000, warmup = 1000
  1293. )
  1294. summary(fit_zoib_tpa_noInt)
  1295. saveRDS(fit_zoib_tpa_noInt, file = "output/exp3_fit_zoib_tpa_noInt.rds")
  1297. # allocation target
  1298. fit_zoib_a <- brm(
  1299. bf(
  1300. allocation_ratio ~ a_target + (1 | subject)
  1301. ),
  1302. data = Exp3_data,
  1303. family = zero_one_inflated_beta(),
  1304. chains = 8, cores = 8, iter = 3000, warmup = 1000
  1305. )
  1306. summary(fit_zoib_a)
  1307. saveRDS(fit_zoib_a, file = "output/exp3_fit_zoib_a.rds")
  1310. ## compare model
  1311. fit_zoib_tpa <- readRDS("multilevel_model/output/exp3_fit_zoib_tpa.rds")
  1312. coef_table <- as.data.frame(summary(fit_zoib_tpa)$fixed)
  1313. coef_table <- round(coef_table, 2)
  1314. write.csv(coef_table, "multilevel_model/output/tables/TabS7-1_fit_zoib_tc.csv", row.names = TRUE)
  1316. fit_zoib_tpa_noInt <- readRDS("output/exp3_fit_zoib_tpa_noInt.rds")
  1317. fit_zoib_a <- readRDS("output/exp3_fit_zoib_a.rds")
  1319. tpa_model <- loo(fit_zoib_tpa)
  1320. tpa_noInt_model <- loo(fit_zoib_tpa_noInt)
  1321. a_model <- loo(fit_zoib_a)
  1323. loo_compare(tpa_model,tpa_noInt_model,a_model) #diff 2*SE
  1327. ## post hoc
  1328. # get the full model
  1329. fit_zoib_tpa <- readRDS("multilevel_model/output/exp3_fit_zoib_tpa.rds")
  1330. post_summary <- describe_posterior(fit_zoib_tpa)
  1331. tab_df(post_summary,
  1332. title = "Posterior Estimates",
  1333. file = "multilevel_model/output/exp3_fit_zoib_tpa.html")
  1334. # get the best model
  1335. fit_zoib_a <- readRDS("multilevel_model/output/exp3_fit_zoib_a.rds")
  1336. post_summary <- describe_posterior(fit_zoib_a)
  1337. tab_df(post_summary,
  1338. title = "Posterior Estimates",
  1339. file = "multilevel_model/output/exp3_fit_zoib_a.html")
  1340. summary(fit_zoib_a)
  1342. # post hoc
  1343. emm <- emmeans(fit_zoib_a, ~ a_target, type = "response")
  1344. plot(emm)
  1345. contrast(emm, "pairwise")
  1347. # plot
  1348. a <- conditional_effects(fit_zoib_a, effects = "a_target")
  1349. p <- plot(a, plot = FALSE)[[1]]+
  1350. aes(color = a_target)
  1351. p +
  1352. scale_color_manual(values = dark) +
  1353. scale_fill_manual(values = dark) +
  1354. theme_classic() +
  1355. theme(text = element_text(size = 15)) +
  1356. xlab("Allocation Target") +
  1357. ylab("Allocation Ratio")
  1359. ## post hoc
  1360. # get the full model
  1361. fit_zoib_tpa <- readRDS("multilevel_model/output/exp3_fit_zoib_tpa.rds")
  1362. summary(fit_zoib_tpa)
  1364. # post hoc
  1365. emm <- emmeans(fit_zoib_tpa, ~ p_source|a_target, type = "response")
  1366. plot(emm)
  1367. contrast(emm, "pairwise")
  1368. emm <- emmeans(fit_zoib_tpa, ~ a_target|p_source, type = "response")
  1369. plot(emm)
  1370. contrast(emm, "pairwise")
  1372. # plot
  1373. a <- conditional_effects(fit_zoib_tpa, effects = "p_source:a_target",
  1374. conditions = list(task = c("Simple", "Additive", "Disjunctive")))
  1375. p <- plot(a, plot = FALSE)[[1]]+
  1376. aes(color = a_target)
  1377. p +
  1378. scale_color_manual(values = dark) +
  1379. scale_fill_manual(values = dark) +
  1380. theme_classic() +
  1381. theme(text = element_text(size = 15)) +
  1382. xlab("Performance source") +
  1383. ylab("Allocation Ratio") +
  1384. facet_wrap(~task, labeller = labeller(task = c("Simple", "Additive", "Disjunctive"))) # custom facet names
  1389. ## ------------- model 2: task * p_source * a_target * SVO score ------------------------------------------
  1390. # task * condition * SVOscore
  1391. fit_zoib_tpa_SVO <- brm(
  1392. bf(
  1393. allocation_ratio ~ task * p_source * a_target * SVOscore_z + (1 | subject)
  1394. ),
  1395. data = Exp3_data,
  1396. family = zero_one_inflated_beta(),
  1397. chains = 8, cores = 8, iter = 3000, warmup = 1000
  1398. )
  1399. summary(fit_zoib_tpa_SVO)
  1400. saveRDS(fit_zoib_tpa_SVO, file = "output/exp3_fit_zoib_tpa_SVO.rds")
  1402. # a * SVOscore
  1403. fit_zoib_a_SVO <- brm(
  1404. bf(
  1405. allocation_ratio ~ a_target * SVOscore_z + (1 | subject)
  1406. ),
  1407. data = Exp3_data,
  1408. family = zero_one_inflated_beta(),
  1409. chains = 8, cores = 8, iter = 3000, warmup = 1000
  1410. )
  1412. summary(fit_zoib_a_SVO)
  1413. saveRDS(fit_zoib_a_SVO, file = "output/exp3_fit_zoib_a_SVO.rds")
  1415. # compare model
  1416. fit_zoib_tpa_SVO <- readRDS("multilevel_model/output/exp3_fit_zoib_tpa_SVO.rds")
  1417. fit_zoib_a_SVO <- readRDS("multilevel_model/output/exp3_fit_zoib_a_SVO.rds")
  1418. loo_compare( loo(fit_zoib_tpa_SVO), loo(fit_zoib_a_SVO))
  1420. coef_table <- as.data.frame(summary(fit_zoib_a_SVO)$fixed)
  1421. coef_table <- round(coef_table, 2)
  1422. write.csv(coef_table, "multilevel_model/output/tables/TabS7-4_fit_zoib.csv", row.names = TRUE)
  1425. # post hoc
  1426. post_summary <- describe_posterior(fit_zoib_a_SVO)
  1427. tab_df(post_summary,
  1428. title = "Posterior Estimates",
  1429. file = "multilevel_model/output/exp3_fit_zoib_a_SVO.html")
  1431. slopes_SVO <- emtrends(fit_zoib_a_SVO, ~ a_target, var = "SVOscore_z")
  1432. pairs(slopes_SVO)
  1434. a_svo <- conditional_effects(fit_zoib_a_SVO,
  1435. effects = "SVOscore_z:a_target")
  1436. p <- plot(a_svo, plot = FALSE)[[1]]
  1437. p + scale_color_manual(values = dark) +
  1438. scale_fill_manual(values = dark) +
  1439. theme_classic()+
  1440. theme(text = element_text(size = 15))+
  1441. xlab("SVOscore (z-score)")+
  1442. ylab("Allocation Ratio")
  1446. ## -------------------- model 3: performance ratio * a target -----------------
  1447. ## model fitting
  1448. fit_zoib_pa <- brm(
  1449. bf(
  1450. allocation_ratio ~ performance_ratio * a_target + (1 | subject)
  1451. ),
  1452. data = Exp3_data,
  1453. family = zero_one_inflated_beta(),
  1454. chains = 8, cores = 8, iter = 3000, warmup = 1000
  1455. )
  1456. summary(fit_zoib_pa)
  1457. saveRDS(fit_zoib_pa, file = "output/exp3_fit_zoib_pa.rds")
  1459. ## post hoc
  1460. fit_zoib_pa <- readRDS("multilevel_model/output/exp3_fit_zoib_pa.rds")
  1461. coef_table <- as.data.frame(summary(fit_zoib_pa)$fixed)
  1462. coef_table <- round(coef_table, 2)
  1463. write.csv(coef_table, "multilevel_model/output/tables/TabS7-5_fit_zoib.csv", row.names = TRUE)
  1465. post_summary <- describe_posterior(fit_zoib_pa)
  1466. tab_df(post_summary,
  1467. title = "Posterior Estimates",
  1468. file = "multilevel_model/output/exp3_fit_zoib_pa.html")
  1470. slopes_a <- emtrends(fit_zoib_pa, ~ a_target, var = "performance_ratio")
  1471. pairs(slopes_a)
  1474. pa <- conditional_effects(fit_zoib_pa, effects = "performance_ratio:a_target")
  1475. p_exp3_2c <- plot(pa, plot = FALSE)[[1]] +
  1476. scale_color_manual(values = dark) +
  1477. scale_fill_manual(values = dark) +
  1478. theme_bw() +
  1479. theme(text = element_text(size=20),
  1480. panel.grid.major = element_blank(),
  1481. panel.grid.minor = element_blank(),
  1482. plot.title = element_text(hjust = 0.5),
  1483. axis.text.x = element_text(size = 15),
  1484. axis.text.y = element_text(size = 15),
  1485. panel.spacing.x = unit(0.8, "lines"),
  1486. legend.text=element_text(size=15))+
  1487. xlab("Relative Performance")+
  1488. ylab("Relative Allocation") +
  1489. labs(color = "Allocation target", fill = "Allocation target")
  1490. p_exp3_2c
  1496. ## ---------------------- plot Figure exp3 2 A-C -------------------------------
  1497. # data
  1498. Exp3_data_sub <- Exp3_data %>%
  1499. filter(!is.na(allocation_ratio)) %>%
  1500. dplyr::select(experiment,task,subject,condition,allocation_ratio,SVOscore_z) %>%
  1501. group_by(experiment,task,subject,condition) %>%
  1502. dplyr::summarize(mean_allocation_ratio = mean(allocation_ratio),
  1503. SVOscore_z = first(SVOscore_z)) %>%
  1504. select(experiment, task,condition, subject, mean_allocation_ratio, SVOscore_z)
  1505. Exp3_data_sub$subject <- as.factor(Exp3_data_sub$subject)
  1509. p_exp3_2a <- ggplot(Exp3_data_sub, aes(x = condition, y = mean_allocation_ratio, fill = condition)) +
  1510. geom_bar(stat = "summary", fun = "mean", colour = "black", position = "dodge") +
  1511. # geom_line(aes(group = subject),color = 'gray') +
  1512. geom_point(aes(group = subject), shape = 21, color = 'darkgray',size = 3) +
  1513. stat_summary(fun.data = mean_cl_normal, na.rm =TRUE,
  1514. geom = "errorbar", width = .2)+
  1515. geom_hline(yintercept = 0.5,linetype="dashed", color = "black") +
  1516. facet_grid(~task) +
  1517. scale_fill_manual(values = color_four) +
  1518. theme_bw()+
  1519. theme(text = element_text(size=20),
  1520. panel.grid.major = element_blank(),
  1521. panel.grid.minor = element_blank(),
  1522. axis.text.x = element_blank(),
  1523. axis.ticks.x = element_blank(),
  1524. axis.text.y = element_text(size = 15),
  1525. plot.title = element_text(hjust = 0.5),
  1526. legend.text=element_text(size=15)) +
  1527. ylab("Relative allocation") +
  1528. xlab(" ") +
  1529. labs(fill = "Self-relevance")
  1530. p_exp3_2a
  1532. p_exp3_2b<-Exp3_data_sub %>%
  1533. ggplot(aes(x=SVOscore_z, y=mean_allocation_ratio, color=condition)) +
  1534. geom_point(shape = 20,size=5,alpha = 0.5) +
  1535. theme_bw() +
  1536. theme(text = element_text(size=20),
  1537. panel.grid.major = element_blank(),
  1538. panel.grid.minor = element_blank(),
  1539. plot.title = element_text(hjust = 0.5),
  1540. axis.text.x = element_text(size = 15),
  1541. axis.text.y = element_text(size = 15),
  1542. panel.spacing.x = unit(0.8, "lines"),
  1543. legend.text=element_text(size=15))+
  1544. #legend.position="none")+
  1545. geom_smooth(method=lm, se = FALSE)+
  1546. #stat_cor()+
  1547. facet_grid(~task,scales = "free")+
  1548. #scale_shape_manual(values=c(3, 16))+
  1549. scale_color_manual(values=color_four)+
  1550. xlab("SVO score (z-scored)")+
  1551. ylab("Relative allocation")+
  1552. labs(color = "Allocation target")
  1553. p_exp3_2b
  1556. # plot Figure exp3 2b
  1557. Exp3_data_sub <- Exp3_data %>%
  1558. filter(!is.na(allocation_ratio)) %>%
  1559. dplyr::select(experiment,task,subject,a_target,allocation_ratio,SVOscore_z) %>%
  1560. group_by(experiment,task,subject,a_target) %>%
  1561. dplyr::summarize(mean_allocation_ratio = mean(allocation_ratio),
  1562. SVOscore_z = first(SVOscore_z)) %>%
  1563. select(experiment, task,a_target, subject, mean_allocation_ratio, SVOscore_z)
  1564. Exp3_data_sub$subject <- as.factor(Exp3_data_sub$subject)
  1566. p_exp3_2b<-Exp3_data_sub %>%
  1567. ggplot(aes(x=SVOscore_z, y=mean_allocation_ratio, color=a_target)) +
  1568. geom_point(shape = 20,size=5,alpha = 0.5) +
  1569. theme_bw() +
  1570. theme(text = element_text(size=20),
  1571. panel.grid.major = element_blank(),
  1572. panel.grid.minor = element_blank(),
  1573. plot.title = element_text(hjust = 0.5),
  1574. axis.text.x = element_text(size = 15),
  1575. axis.text.y = element_text(size = 15),
  1576. panel.spacing.x = unit(0.8, "lines"),
  1577. legend.text=element_text(size=15))+
  1578. #legend.position="none")+
  1579. geom_smooth(method=lm, se = FALSE)+
  1580. #stat_cor()+
  1581. facet_grid(~task,scales = "free")+
  1582. #scale_shape_manual(values=c(3, 16))+
  1583. scale_color_manual(values=dark)+
  1584. xlab("SVO score (z-scored)")+
  1585. ylab("Relative allocation")+
  1586. labs(color = "Allocation target")
  1587. p_exp3_2b
  1590. ## -------------- model 4: contribution on diff -------------------------------
  1591. ## prepare data
  1592. # calculate the differnece between self-relevant and self-irrelevant based on trial
  1593. Exp3_Data_contribution <- Exp3_data %>%
  1594. pivot_wider(id_cols = c(subject,SVOscore_z,SVOscore,trial,task,contribution,performance_ratio, p_source),
  1595. names_from = a_target,
  1596. values_from = allocation_ratio) %>%
  1597. mutate(difference = `Self-relevant` - `Self-irrelevant`)
  1599. ## model fitting
  1600. fit_gaussian_a_diff <- brm(
  1601. bf(
  1602. difference ~ contribution + (1 | subject)
  1603. ),
  1604. data = Exp3_Data_contribution,
  1605. family = gaussian(),
  1606. chains = 8, cores = 8, iter = 3000, warmup = 1000
  1607. )
  1608. summary(fit_gaussian_a_diff)
  1609. saveRDS(fit_gaussian_a_diff, file = "output/exp3_fit_gaussian_a_diff.rds")
  1612. ## post hoc
  1613. fit_gaussian_a_diff <- readRDS("multilevel_model/output/exp3_fit_gaussian_a_diff.rds")
  1614. post_summary <- describe_posterior(fit_gaussian_a_diff)
  1615. tab_df(post_summary,
  1616. title = "Posterior Estimates",
  1617. file = "multilevel_model/output/exp3_fit_gaussian_a_diff.html")
  1619. emm <- emmeans(fit_gaussian_a_diff, ~ contribution, type = "response")
  1620. contrast(emm, "pairwise")
  1621. gaussian_a_diff <- conditional_effects(fit_gaussian_a_diff, effects = "contribution")
  1622. p <- plot(gaussian_a_diff, plot = FALSE)[[1]]+
  1623. aes(color = contribution, fill = contribution)
  1624. p +
  1625. scale_color_manual(values = contribution_color) +
  1626. scale_fill_manual(values = contribution_color) +
  1627. theme_classic() +
  1628. theme(text = element_text(size = 15)) +
  1629. xlab("Contribution") +
  1630. ylab("Self-allocation Bias")
  1633. ## ------------- model 5: including SVO score ------------------------------------------
  1634. fit_gaussian_a_diff_SVO <- brm(
  1635. bf(
  1636. difference ~ contribution * SVOscore_z + (1 | subject)
  1637. ),
  1638. data = Exp3_Data_contribution,
  1639. family = gaussian(),
  1640. chains = 8, cores = 8, iter = 3000, warmup = 1000
  1641. )
  1642. summary(fit_gaussian_a_diff_SVO)
  1643. saveRDS(fit_gaussian_a_diff_SVO, file = "output/exp3_fit_gaussian_a_diff_SVO.rds")
  1646. ## post hoc
  1647. fit_gaussian_a_diff_SVO <- readRDS("multilevel_model/output/exp3_fit_gaussian_a_diff_SVO.rds")
  1648. post_summary <- describe_posterior(fit_gaussian_a_diff_SVO)
  1649. tab_df(post_summary,
  1650. title = "Posterior Estimates",
  1651. file = "multilevel_model/output/exp3_fit_gaussian_a_diff_SVO.html")
  1653. slopes_SVO <- emtrends(fit_gaussian_a_diff_SVO, ~ contribution, var = "SVOscore_z")
  1654. pairs(slopes_SVO)
  1656. c_diff_svo <- conditional_effects(fit_gaussian_a_diff_SVO,
  1657. effects = "SVOscore_z:contribution")
  1658. p <- plot(c_diff_svo, plot = FALSE)[[1]]
  1659. p + scale_color_manual(values = contribution_color) +
  1660. scale_fill_manual(values = contribution_color) +
  1661. theme_classic()+
  1662. theme(text = element_text(size = 15))+
  1663. xlab("SVOscore (z-score)")+
  1664. ylab("Allocation Ratio")
  1668. ## contribution data prep
  1669. Exp3_Data_contribution_sub <- Exp3_Data_contribution %>%
  1670. filter(!is.na(difference)) %>%
  1671. dplyr::select(task,subject,contribution,difference,SVOscore_z) %>%
  1672. group_by(subject,contribution) %>%
  1673. dplyr::summarize(mean_diff = mean(difference),
  1674. SVOscore_z = first(SVOscore_z)) %>%
  1675. select(contribution, subject, mean_diff, SVOscore_z)
  1676. Exp3_Data_contribution_sub$subject <- as.factor(Exp3_Data_contribution_sub$subject)
  1680. # ---------------------------plot Figure exp3 2 DE------------------------------
  1681. p_exp3_2d<-ggplot(Exp3_Data_contribution_sub, aes(x = contribution, y = mean_diff, fill = contribution)) +
  1682. geom_bar(stat = "summary", fun = "mean", colour = "black")+
  1683. geom_point(aes(group = subject), shape = 21, color = 'darkgray') +
  1684. stat_summary(fun.data = mean_cl_normal, na.rm =TRUE,
  1685. geom = "errorbar", width = .2)+
  1686. scale_fill_manual(values = contribution_color) +
  1687. theme_bw()+
  1688. theme(text = element_text(size=20),
  1689. panel.grid.major = element_blank(),
  1690. panel.grid.minor = element_blank(),
  1691. axis.ticks.x = element_blank(),
  1692. axis.text.y = element_text(size = 15),
  1693. legend.position = "none") +
  1694. ylab("Self allocation bias") +
  1695. xlab(" ")
  1696. p_exp3_2d
  1698. # plot 2e
  1699. p_exp3_2e <- Exp3_Data_contribution_sub %>%
  1700. ggplot(aes(x=SVOscore_z, y=mean_diff, color=contribution)) +
  1701. geom_point(shape = 20,size=5,alpha = 0.8) +
  1702. theme_bw() +
  1703. theme(text = element_text(size=20),
  1704. panel.grid.major = element_blank(),
  1705. panel.grid.minor = element_blank(),
  1706. plot.title = element_text(hjust = 0.5),
  1707. axis.text.x = element_text(size = 15),
  1708. axis.text.y = element_text(size = 15),
  1709. panel.spacing.x = unit(0.8, "lines"),
  1710. legend.position = "none")+
  1711. geom_smooth(method=lm, se = FALSE)+
  1712. scale_color_manual("Contribution",values=contribution_color)+
  1713. # stat_cor(p.accuracy = 0.001,size = 6)+
  1714. xlab("SVO score (z-scored)")+ylab("Self allocation bias")
  1715. p_exp3_2e
  1722. ## ---------------------- ROI plots ------------------------------------------
  1724. # dmPFC
  1725. ROI_data <- read.csv(".../ROI_pmod_Main_effect_of_factor_2_12_28_52.csv", header = TRUE)
  1726. # OFC r
  1727. ROI_data <- read.csv(".../ROI_pmod_Main_effect_of_factor_2_40_48_-12.csv", header = TRUE)
  1728. # OFC l
  1729. ROI_data <- read.csv(".../ROI_pmod_Main_effect_of_factor_2_-42_50_-6.csv", header = TRUE)
  1730. # TPJ r
  1731. ROI_data <- read.csv(".../ROI_pmod_Main_effect_of_factor_2_44_-64_42.csv", header = TRUE)
  1732. # TPJ l
  1733. ROI_data <- read.csv(".../ROI_pmod_Main_effect_of_factor_2_-56_-64_30.csv", header = TRUE)
  1734. # temporal r
  1735. ROI_data <- read.csv(".../ROI_pmod_Main_effect_of_factor_2_64_-38_-4.csv", header = TRUE)
  1737. ROI_data <- ROI_data %>%
  1738. mutate(
  1739. Condition = case_when(Contribution < 4~"Self-relevant", Contribution >= 4~"Self-irrelevant"),
  1740. Contribution = case_when(Contribution == 1|Contribution == 4~"Both", Contribution == 2|Contribution == 5~"Player1 only",Contribution == 3|Contribution == 6~"Player2 only"),
  1741. Subject = Subject + 100) %>%
  1742. arrange(Contribution,Condition,Subject)
  1744. ROI_data$Subject<-factor(ROI_data$Subject)
  1745. ROI_data$Condition<-factor(ROI_data$Condition, levels = c('Self-relevant','Self-irrelevant'))
  1746. ROI_data$Contribution<-factor(ROI_data$Contribution, levels = c('Player1 only','Both','Player2 only'))
  1748. ROI_data_contribution <- ROI_data %>%
  1749. group_by(Contribution, Subject) %>%
  1750. dplyr::summarize(ROI_beta_mean = mean(ROI_beta)) %>%
  1751. ungroup()
  1753. # plot
  1754. p_roi<-ggplot(ROI_data_contribution, aes(x = Contribution, y = ROI_beta_mean, fill = Contribution)) +
  1755. geom_bar(stat = "summary", fun = "mean", colour = "black")+
  1756. geom_point(aes(group = Subject), shape = 21, color = 'darkgray', size = 4) +
  1757. stat_summary(fun.data = mean_cl_normal, na.rm =TRUE,
  1758. geom = "errorbar", width = .2)+
  1759. scale_fill_manual(values = contribution_color) +
  1760. theme_bw()+
  1761. theme(text = element_text(size=25),
  1762. panel.grid.major = element_blank(),
  1763. panel.grid.minor = element_blank(),
  1764. axis.ticks.x = element_blank(),
  1765. axis.text.y = element_text(size = 25),
  1766. legend.position = "none") +
  1767. ylab("Beta estimates") +
  1768. xlab(" ")
  1769. p_roi

GA_analysis_plot_code.R, no license · at the source

Overview

Authors: Sihui Zhang1,2, Xue Yong1, Yina Ma1,3, Christoph W. Korn2,4
ORCID iDs: Sihui Zhang, Yina Ma
  1. State Key Laboratory of Cognitive Neuroscience and Learning & IDG/McGovern Institute for Brain Research, Faculty of Psychology, Beijing Normal University, Beijing, China
  2. Section Social Neuroscience, Department of General Psychiatry, University of Heidelberg, Heidelberg, Germany
  3. Chinese Institute for Brain Research, Beijing, China
  4. Institute for Systems Neuroscience, University Medical Center Hamburg-Eppendorf, Hamburg, Germany
Institutions: Heidelberg University (Germany); Beijing Normal University (China); State Key Laboratory of Cognitive Neuroscience and Learning (China); Chinese Institute for Brain Research (China); University Medical Center Hamburg-Eppendorf (Germany)
Journal: PLoS biology, volume 24, issue 3, article e3003694
Dates: received 13 June 2025; accepted 23 February 2026; published online 26 March 2026
Type: Research article · Language: English
License: CC BY
Identifiers: DOI 10.1371/journal.pbio.3003694 · PMID 41886463 · PMCID PMC13020808 · OpenAlex W7140359916
Open access: gold, a free copy (OpenAlex)
Status: code verified (how the code is found and verified)
Categories: structural MRI / diffusion (modality), human (organism), cognitive (subfield)
Methods: Statistics, Machine learning, fMRI & imaging
MeSH: Cooperative Behavior*, Decision Making*, Adult, Female, Humans, Magnetic Resonance Imaging, Male, Prefrontal Cortex, Reward, Young Adult (* major topic)
Journal subjects: Biology and Life Sciences, Psychology, Behavior, Social Sciences, Neuroscience, Cognitive Science, Cognitive Psychology, Decision Making, Cognition, Brain Mapping, Functional Magnetic Resonance Imaging, Medicine and Health Sciences, Diagnostic Medicine, Diagnostic Radiology, Magnetic Resonance Imaging, Research and Analysis Methods, Imaging Techniques, Radiology and Imaging, Neuroimaging, Human Performance, Anatomy, Brain, Prefrontal Cortex, Physical Sciences, Mathematics, Applied Mathematics, Game Theory, Statistics, Statistical Data
Topic: Neural and Behavioral Psychology Studies (Cognitive Neuroscience, Neuroscience), according to OpenAlex
Funding: National Natural Science Foundation of China (32430041, 32125019); STI 2030–Major Projects (2022ZD0211000); Fundamental Research Funds for the Central Universities (2233300002); Deutsche Forschungsgemeinschaft (392443797); China Scholarship Council
Citations: cited by 1 paper (Europe PMC); 102 references in the paper
Notices: A correction to this paper has been published (42627763, from Europe PMC)

Abstract

Human cooperation often involves performing joint tasks, where success relies on how collective rewards are allocated among cooperating parties based on their individual performance and contribution to task outcomes. However, it remains unclear whether and how individual performance and contribution give rise to self-related biases in such allocation decisions. Here, we developed a novel performance-based social allocation task that manipulated how individual performance contributed to joint outcomes. Across two experiments, participants exhibited a robust self-allocation bias: they allocated more rewards to themselves and disproportionately disregarded their own performance, particularly when their performance did not causally contribute to the joint outcome. This self-allocation bias was amplified in individuals with stronger individualistic social preferences, as measured by social value orientation. At the neural level, self-relevant (versus self-irrelevant) allocation decisions were associated with increased activity in the medial prefrontal cortex extending into the anterior cingulate cortex, insula, and temporoparietal junction (TPJ). Moreover, the dorsomedial prefrontal cortex, lateral orbitofrontal cortex, and TPJ tracked trial-by-trial variations in relative performance as a function of contribution structure, independent of self-relevance. Together, these findings suggest that self-allocation bias in performance-based decisions is unlikely to arise from distorted neural encodings of performance. Instead, self-interest may shape how contribution-structured performance information is used in social-allocation choices, providing a more precise account of how self-serving behavior emerges in cooperative contexts.

Reproduced under the paper's license (CC BY), from the paper cited above.

Repository

Its files are read in the Code ↔ Paper reader above, with 3 matches between paragraphs and lines of code.

OSF afdqs

License: none: the authors keep all their rights
State: the link answers, verified on 30 September 2026
Evidence: files inventoried
Languages: R (1)
Size: 3 files, 1 script
Software Heritage: not checked
Found in: the supplementary material
Not found: README, license file, CITATION.cff, environment file, tests, continuous integration, documentation
Tools: brms (1 file), cowplot (1 file), easystats (1 file), emmeans (1 file), ggplot2 (1 file), ggpubr (1 file), tidyverse (1 file)
Availability: 1 check, the latest on 30 September 2026: the link answers (HTTP 200)
  • 30 September 2026: the link answers (HTTP 200)
1 file
At the source: doi.org/10.17605/OSF.IO/AFDQS

The paper's code and data availability statement is in the Data section.

Tracing map

Proposed by the machine: these links were found in the paper and verified at the source, without human review. The map will receive a Zenodo DOI once one of the paper's authors has validated it with their ORCID.

What the map holds:

  • 1 repository of the authors' code, each at its verified commit, with its license and how the link was found in the paper;
  • 1 script, each with its path and the digest of its content;
  • 3 matches between paragraphs of the paper and lines of the code (method lexical-v1);
  • neither the text of the paper nor the code itself.

Its JSON (tracing-map.json) is deposited on Zenodo with its DOI once the map is validated.

Data

No dataset and no data link were found in the paper.

Data Availability

All data and analysis codes related to this paper are available and archived in Open Science Framework at https://doi.org/10.17605/OSF.IO/AFDQS.

Reproduced under the paper's license (CC BY), from the paper cited above.

Versions

The history of this record: each version stored by the harvester or made by a correction of its authors or of the maintainers of its code, and what changed in its facts. The texts of the paper (its abstract, its availability statements) are not part of it; versions that changed only those are not listed.

Version 1, 30 September 2026: the first record

Recorded: type, language, journal, volume, issue, pages, dates, 4 authors, 10 MeSH terms, 5 funders, 91 references, 1 integrity notice.

Cite

This paper

Zhang, S., Yong, X., Ma, Y., & Korn, C. W. (2026). Self-allocation bias in performance-based cooperative decisions is driven by self-interest rather than distorted performance encoding. PLoS biology, 24(3), e3003694. https://doi.org/10.1371/journal.pbio.3003694

BibTeX

@article{zhang2026self,
author = {Zhang, Sihui and Yong, Xue and Ma, Yina and Korn, Christoph W.},
title = {{Self-allocation bias in performance-based cooperative decisions is driven by self-interest rather than distorted performance encoding}},
journal = {PLoS biology},
year = {2026},
month = mar,
volume = {24},
number = {3},
pages = {e3003694},
publisher = {PLOS},
issn = {1544-9173},
doi = {10.1371/journal.pbio.3003694},
url = {https://doi.org/10.1371/journal.pbio.3003694},
pmid = {41886463},
pmcid = {PMC13020808}
}

RIS

TY - JOUR
AU - Zhang, Sihui
AU - Yong, Xue
AU - Ma, Yina
AU - Korn, Christoph W.
TI - Self-allocation bias in performance-based cooperative decisions is driven by self-interest rather than distorted performance encoding
T2 - PLoS biology
J2 - PLoS Biol
PY - 2026
DA - 2026/03/26
VL - 24
IS - 3
SP - e3003694
SN - 1544-9173
PB - PLOS
DO - 10.1371/journal.pbio.3003694
UR - https://doi.org/10.1371/journal.pbio.3003694
LA - en
ER -

CSL-JSON

{
"id": "10.1371/journal.pbio.3003694",
"type": "article-journal",
"title": "Self-allocation bias in performance-based cooperative decisions is driven by self-interest rather than distorted performance encoding",
"container-title": "PLoS biology",
"author": [
{
"family": "Zhang",
"given": "Sihui"
},
{
"family": "Yong",
"given": "Xue"
},
{
"family": "Ma",
"given": "Yina"
},
{
"family": "Korn",
"given": "Christoph W."
}
],
"container-title-short": "PLoS Biol",
"volume": "24",
"issue": "3",
"page": "e3003694",
"DOI": "10.1371/journal.pbio.3003694",
"PMID": "41886463",
"PMCID": "PMC13020808",
"ISSN": "1544-9173",
"publisher": "PLOS",
"URL": "https://doi.org/10.1371/journal.pbio.3003694",
"language": "en",
"issued": {
"date-parts": [
[
2026,
3,
26
]
]
}
}

The tracing map gets a citation of its own once an author has validated it and it has a DOI.

Similar papers

The papers with a page that share the most with this one: the tools found in their code, their categories, datasets, cited references and authors, the rarest counting most.

[1] doi:10.1371/journal.pbio.3003079 [code]
Dorsomedial and ventromedial prefrontal cortex lesions differentially impact social influence and temporal discounting.
Journal: PLoS biology
In common: easystats, emmeans, ggpubr, 2 other tools, cognitive, 8 references
[2] doi:10.1038/s41586-025-08705-9 [code]
Basis functions for complex social decisions in dorsomedial frontal cortex.
Journal: Nature
In common: ggpubr, ggplot2, tidyverse, cognitive, 8 references
[3] doi:10.1038/s42003-022-04329-1 [code]
Behavioral and neuro-cognitive bases for emergence of norms and socially shared realities via dynamic interaction.
Journal: Communications biology
In common: brms, tidyverse, 8 references
[4] doi:10.1093/scan/nsad023 [code]
Mentalizing in an economic games context is associated with enhanced activation and connectivity in the left temporoparietal junction.
Journal: Social cognitive and affective neuroscience
In common: cognitive, 9 references
[5] doi:10.3758/s13415-026-01425-1 [code]
Mindful minds: How group identity shapes brain and behavior in social decision-making.
Journal: Cognitive, affective & behavioral neuroscience
In common: cognitive, 9 references
[6] doi:10.1093/scan/nsag030 [code]
Delaying rewards reduces egoism bias during prosocial acts.
Journal: Social cognitive and affective neuroscience
In common: easystats, emmeans, ggpubr, 2 other tools, cognitive, 4 references
[7] doi:10.7554/elife.87271 [code]
Acute stress reduces effortful prosocial behaviour.
Journal: eLife
In common: emmeans, cowplot, ggpubr, 2 other tools, cognitive, 4 references
[8] doi:10.7554/elife.92539 [code]
A neurocomputational account of the link between social perception and social action.
Journal: eLife
In common: cognitive, 8 references
[9] doi: [code]
Neural integration of affective prosodic and semantic cues in non-literal forms of speech understanding
Journal: Imaging neuroscience (Cambridge, Mass.)
In common: easystats, emmeans, cowplot, 3 other tools, cognitive, 3 references
[10] doi:10.1038/s41467-025-67853-8 [code]
Active disambiguation guides inferring controllability and cause in social interactions.
Journal: Nature communications
In common: brms, ggpubr, ggplot2, 1 other tool, 4 references

Contribute

The authors of this paper can claim it, correct its record and validate its tracing map, and the maintainers of its code (its owner, or a public member of its organization) correct what it says of their repository; anyone signed in can ask for its removal. Every request goes to OSCR's own machine, which answers it; your account page follows them.

Sign in with ORCID to claim this paper as one of its authors, correct its record or validate its tracing map: when the paper's metadata lists your ORCID iD, you are recognized at once. Maintainers of its code: sign in with GitHub, then claim the repository on your account page.

Add the badge to the code's README

OSCR: the badge of this paper

If you are an author or a maintainer of this paper's code, you can add this badge. It says what OSCR knows of the paper (its code, its validated tracing map) and links the code to this page. Paste one of these snippets under the README's title. Keep the two marks around it, so that the badge can be replaced in place and is never added twice. OSCR changes nothing in your repository.

Markdown
<!-- oscr-badge:start -->
[![OSCR](https://openscicode.org/badge/doi/10.1371/journal.pbio.3003694.svg)](https://openscicode.org/badge/doi/10.1371/journal.pbio.3003694)
<!-- oscr-badge:end -->
reStructuredText
.. oscr-badge:start

.. image:: https://openscicode.org/badge/doi/10.1371/journal.pbio.3003694.svg
   :target: https://openscicode.org/badge/doi/10.1371/journal.pbio.3003694
   :alt: OSCR

.. oscr-badge:end
HTML
<!-- oscr-badge:start -->
<a href="https://openscicode.org/badge/doi/10.1371/journal.pbio.3003694"><img src="https://openscicode.org/badge/doi/10.1371/journal.pbio.3003694.svg" alt="OSCR"></a>
<!-- oscr-badge:end -->

If you choose to, you can have the badge kept up to date for you, with oscr badge --write from the command line or with the GitHub Action in your repository's workflows. Every other form and option (a card, AsciiDoc, LaTeX, shields.io) is on the badge page.

Request its removal

To ask OSCR to remove this record, the copies of its authors' scripts or its tracing map, use the removal request page: signed in, you say who you are, what to remove and why, then review and confirm the request. Published rules decide every request (how).

Discussion, reproductions, activity

Discussion: code errors and mismatches between the code and the paper about this paper and its code, from readers and its authors, beside the paper and its tracing map.

Report a mismatch between the code and the paper · Report a code error (signed in)

Reproductions: reports from readers who ran the authors' code and did not get the paper's result, what they ran, with which environment, commit and data.

Report a reproduction failure (signed in)

Activity: what happens around this paper: new versions of its record, its map's validation, discussions and reproductions. It opens with sign-in.