library(MuMIn) library(arm) library(foreign) library(MASS) library(ordinal) ################################################################ import PROPOSER data ################################################################ data<-read.csv("proposer_workbook_analysis.csv", header=T) names(data) ################################################################ 1. Do people make lower DG than UG offers, as predicted ################################################################ t.test(data$UG.offer, data$DG.offer, paired=T) wilcox.test(data$UG.offer, data$DG.offer, paired=T) mean(data$UG.offer) mean(data$DG.offer) sd(data$UG.offer)/sqrt(1541) sd (data$DG.offer)/sqrt(1541) #Yes length(data$UG.offer) ################################################################ Remove NA entries in file ################################################################ data2<-subset(data, paranoia!="") data2$paranoia length(data2$paranoia) Gen<-ifelse(data2$Gender=="Male",1,0);Gen order_f<-ifelse(data2$order=="UG first",1,0);order_f wave_f<-ifelse(data2$Wave=="1",0,1); wave_f diff<-data2$UG.offer-data2$DG.offer;diff UGord<-ifelse(data2$UG.offer==0,1, ifelse(data2$UG.offer==0.05,2, ifelse(data2$UG.offer==0.1,3, ifelse(data2$UG.offer==0.15,4, ifelse(data2$UG.offer==0.2,5, ifelse(data2$UG.offer==0.25,6,7)))))) UG<-factor(UGord, ordered=T) DGord<-ifelse(data2$DG.offer==0,1, ifelse(data2$DG.offer==0.05,2, ifelse(data2$DG.offer==0.1,3, ifelse(data2$DG.offer==0.15,4, ifelse(data2$DG.offer==0.2,5, ifelse(data2$DG.offer==0.25,6,7)))))) DG<-factor(DGord, ordered=T); DG #standardizing input variables according to Gelman 2008 #continuous variables are divided by 2 sd and binary input variables are centered by dividing by the mean sdAge<-sd(data2$Age) sdPara<-sd(data2$paranoia) zAge<-data2$Age/(sdAge+sdAge) zPara<-data2$paranoia/(sdPara+sdPara) cGen<-Gen-(mean(Gen));cGen cOrd<-order_f-(mean(order_f)) cWave<-wave_f-(mean(wave_f)) cInc<-data2$Incorrect-(mean(data2$Incorrect)) ################################################################ 2. Do paranoid people show greater difference in UG than DG offers? ################################################################ global.model<-lm(diff~cGen+zAge+zPara+cOrd+cInc+cWave, na.action=na.fail) model.set<-dredge(global.model, REML=FALSE) top.models<-get.models(model.set, subset=delta<2) a<-model.avg(top.models, adjusted=FALSE, revised.var=TRUE) summary(a) confint(a, full=T) #Positive effects indicate increased UG relative to DG offers. In this model, positive effect of (i) being male; (ii) game order (if played UG first). Negative effect of (i) Age, (ii) Task comprehension. No detectable effects of paranoia or wave (i.e. longer-scale order effects). ################################################################ 3. Any effect of paranoia on UG offer?################################################################ global.model<-clm(UG~zAge+ zPara+ cGen+ cOrd+ cInc+ cWave, na.action=na.fail, data=data2) model.set<-dredge(global.model, REML=FALSE) top.models<-get.models(model.set, subset=delta<2) a<-model.avg(top.models, adjusted=FALSE, revised.var=TRUE) summary(a) confint(a, full=T) convergence(global.model) #A negative effect of paranoia on UG offer - i.e. paranoid ppl are making lower UG offers. Positive effect of age on UG offer. No effect of task comprehension. No effect of gender. No effect of wave. ################################################################ 3. Any effect of paranoia on DG offer?################################################################ global.model<-clm(DG~zAge+ zPara+ cGen+ cOrd+ cInc+ cWave, na.action=na.fail, data=data2) model.set<-dredge(global.model, REML=FALSE) top.models<-get.models(model.set, subset=delta<2) a<-model.avg(top.models, adjusted=FALSE, revised.var=TRUE) summary(a) confint(a, full=T) convergence(global.model) # Males make lower DG offers. Negative effect of paranoia on DG offer. Positive effect of age - i.e. Older people make higher DG offers. People who fail comprehension check make higher DG offers. People who play DG first make higher offers. No effect of wave (i.e. the longer-scale order effects) NB. I can detect a positive effect of paranoia on task incomprehension - i.e. paranoid ppl are more likely to get at least one comprehension question wrong. Despite this - the paranoid ppl are still making *lower* DG offers. m1<-glm(Incorrect~paranoia, family = "binomial", data=data2) ################################################################ 3a. Check that results hold when failed comprehenders are excluded ################################################################ comp<-subset(data2, Incorrect=="0") compDG<-ifelse(comp$DG.offer==0,1, ifelse(comp$DG.offer==0.05,2, ifelse(comp $DG.offer==0.1,3, ifelse(comp $DG.offer==0.15,4, ifelse(comp $DG.offer==0.2,5, ifelse(comp $DG.offer==0.25,6,7)))))) cDG<-factor(compDG, ordered=T); cDG compGen<-ifelse(comp$Gender=="Male",1,0);compGen comporder_f<-ifelse(comp$order=="UG first",1,0);comporder_f compwave_f<-ifelse(comp$Wave=="1",0,1); compwave_f compsdAge<-sd(comp$Age) compsdPara<-sd(comp$paranoia) compzAge<-comp$Age/(compsdAge+compsdAge) compzPara<-comp$paranoia/(compsdPara+compsdPara) compcGen<-compGen-(mean(compGen));compcGen compcOrd<-comporder_f-(mean(comporder_f)) compcWave<-compwave_f-(mean(compwave_f)) global.model<-clm(cDG~compzAge+ compzPara+ compcGen+ compcOrd+ compcWave, na.action=na.fail) model.set<-dredge(global.model, REML=FALSE) top.models<-get.models(model.set, subset=delta<2) a<-model.avg(top.models, adjusted=FALSE, revised.var=TRUE) summary(a) confint(a, full=T) convergence(global.model) #All patterns are the same as when all participants are included for analysis. ################################################################ import RESPONDER data ################################################################ rec<-read.csv("Receiver_workbook_analysis.csv", header=T) names(rec) ################################################################ remove NAs ################################################################ rec1<-subset(rec, Paranoia!="") Gen<-ifelse(rec1$Gender=="Male",1,0);Gen cGen<-Gen-(mean(Gen)) Wv<-ifelse(rec1$Wave=="2",1,0);Wv cOrd<-rec1$order_f-(mean(rec1$order_f));cOrd cInc<-rec1$Incorrect-(mean(rec1$Incorrect));cInc cWave<-Wv-(mean(Wv)) cPun<-(rec1$Pun-(mean(rec1$Pun))) MAO<-ifelse(rec1$MAO_UG==0,1, ifelse(rec1 $MAO_UG==0.05,2, ifelse(rec1 $MAO_UG==0.1,3, ifelse(rec1 $MAO_UG==0.15,4, ifelse(rec1 $MAO_UG==0.2,5, ifelse(rec1 $MAO_UG==0.25,6,7 )))))) MAOfac<-factor(MAO, ordered=T); MAOfac rej<-rec1$reject_UG;rej pun<-rec1$Pun; pun #standardize continuous input variables sdPar<-sd(rec1 $Paranoia) sdA<-sd(rec1$Age) zPar<-rec1$Paranoia/(sdPar+sdPar) zAge<-rec1$Age/(sdA+sdA) ################################################################ 1. What predicts tendency to reject at all in the UG? or to punish at all in the DG?################################################################ global.model<-glm(rej~ zAge+ cGen+ cOrd+ cInc+ cWave+ zPar, family="binomial", data=rec1, na.action=na.fail) model.set<-dredge(global.model, REML=FALSE) top.models<-get.models(model.set, subset=delta<2) a<-model.avg(top.models, adjusted=FALSE, revised.var=TRUE) summary(a) confint(a, full=T) #Men more likely to reject than women.Negative effect of task comprehension (ppl who don't understand less likely to reject); positive effect of order (if play DG first, reject more in the UG); older people less likely to reject. No detectable effects of Wave or Paranoia on tendency to reject any UG offer. global.model<-glm(pun~ zAge+ cGen+ cOrd+ cInc+ cWave+ zPar, family="binomial", data=rec1, na.action=na.fail) model.set<-dredge(global.model, REML=FALSE) top.models<-get.models(model.set, subset=delta<2) a<-model.avg(top.models, adjusted=FALSE, revised.var=TRUE) summary(a) confint(a, full=T) #Males more likely to punish than females. Positive effect of paranoia on tendency to punish. More likely to punish if play UG first. More likely to punish if get at least one comp question incorrect. No effect of wave. ################################################################ 2. What predicts MAO in the UG?################################################################ global.model<-clm(MAOfac~zAge+ cGen+ cOrd+ cInc+ cWave+ zPar, na.action=na.fail) model.set<-dredge(global.model, REML=FALSE) top.models<-get.models(model.set, subset=delta<2) a<-model.avg(top.models, adjusted=FALSE, revised.var=TRUE) summary(a) confint(a, full=T) convergence(global.model) #Men demand higher UG offers than women. Task incomprehension leads to lower MAO. Higher MAO if play UG first. Slight positive effect of paranoia on MAO. No effects of age / wave. ################################################################ 2a. Check MAO results when failed comprehenders are excluded ################################################################ comprec1<-subset(rec1, Incorrect=="0"); comprec1$Incorrect compGen<-ifelse(comprec1$Gender=="Male",1,0);compGen compcGen<-compGen-(mean(compGen)) compWv<-ifelse(comprec1$Wave=="2",1,0);compWv compcOrd<-comprec1$order_f-(mean(comprec1$order_f));compcOrd compcWave<-compWv-(mean(compWv)) compMAO<-ifelse(comprec1$MAO_UG==0,1, ifelse(comprec1 $MAO_UG==0.05,2, ifelse(comprec1 $MAO_UG==0.1,3, ifelse(comprec1 $MAO_UG==0.15,4, ifelse(comprec1 $MAO_UG==0.2,5, ifelse(comprec1 $MAO_UG==0.25,6,7 )))))) compMAOfac<-factor(compMAO, ordered=T); compMAOfac #standardize continuous input variables compsdPar<-sd(comprec1 $Paranoia) compsdA<-sd(comprec1$Age) compzPar<-comprec1$Paranoia/(compsdPar+compsdPar) compzAge<-comprec1$Age/(compsdA+compsdA) global.model<-clm(compMAOfac~compzAge+ compcGen+ compcOrd+ compcWave+ compzPar, na.action=na.fail) model.set<-dredge(global.model, REML=FALSE) top.models<-get.models(model.set, subset=delta<2) a<-model.avg(top.models, adjusted=FALSE, revised.var=TRUE) summary(a) confint(a, full=T) convergence(global.model) ################################################################ 3. What predicts WTP in the DG?################################################################ rec2<-subset(rec1, WTP_DG!="") Gen_b<-ifelse(rec2$Gender=="Male",0,1) cGen_b<-Gen_b-(mean(Gen_b)) wave_b<-ifelse(rec2$Wave=="2",1,0) cOrd_b<-rec2$order_f-(mean(rec2$order_f));cOrd_b cInc_b<-rec2$Incorrect-(mean(rec2$Incorrect));cInc_b cWave_b<-wave_b-(mean(wave_b)) WTP<-ifelse(rec2 $WTP_DG==0,7, ifelse(rec2 $WTP_DG ==0.05,6, ifelse(rec2 $WTP_DG ==0.1,5, ifelse(rec2 $WTP_DG ==0.15,4, ifelse(rec2 $WTP_DG ==0.2,3, ifelse(rec2 $WTP_DG ==0.25,2,1 )))))) WTPfac<-factor(WTP, ordered=T); WTPfac sdP<-sd(rec2$Paranoia) sdA<-sd(rec2$Age) zP<-rec2$Paranoia/(sdP+sdP) zA<-rec2$Age/(sdA+sdA) global.model<-clm(WTPfac~zA+ zP+ cGen_b+ cOrd_b+ cInc_b+ cWave_b, na.action=na.fail) model.set<-dredge(global.model, REML=FALSE) top.models<-get.models(model.set, subset=delta<2) a<-model.avg(top.models, adjusted=FALSE, revised.var=TRUE) summary(a) confint(a, full=T) convergence(global.model) #Women more likely to punish than men. Failed comprehension predicts increased WTP. Older people more WTP. Paranoid people more WTP.no order effect or wave effects. ################################################################ 3a. Check that WTP results hold when failed comp are excluded ################################################################ comprec2<-subset(rec2, Incorrect=="0") compGen_b<-ifelse(comprec2$Gender=="Male",0,1) compcGen_b<-compGen_b-(mean(compGen_b)) compwave_b<-ifelse(comprec2$Wave=="2",1,0) compcOrd_b<-comprec2$order_f-(mean(comprec2$order_f));compcOrd_b compcWave_b<-compwave_b-(mean(compwave_b)) compWTP<-ifelse(comprec2 $WTP_DG==0,7, ifelse(comprec2 $WTP_DG ==0.05,6, ifelse(comprec2 $WTP_DG ==0.1,5, ifelse(comprec2 $WTP_DG ==0.15,4, ifelse(comprec2 $WTP_DG ==0.2,3, ifelse(comprec2 $WTP_DG ==0.25,2,1 )))))) compWTPfac<-factor(compWTP, ordered=T); compWTPfac compsdP<-sd(comprec2$Paranoia) compsdA<-sd(comprec2$Age) compzP<-comprec2$Paranoia/(compsdP+compsdP) compzA<-comprec2$Age/(compsdA+compsdA) global.model<-clm(compWTPfac~ compzA+ compzP+ compcGen_b+ compcOrd_b+ compcWave_b, na.action=na.fail) model.set<-dredge(global.model, REML=FALSE) top.models<-get.models(model.set, subset=delta<2) a<-model.avg(top.models, adjusted=FALSE, revised.var=TRUE) summary(a) confint(a, full=T) convergence(global.model) ################################################################ 4. Is WTP< MAO? ################################################################ rec<-read.csv("Receiver_workbook_analysis.csv", header=T) names(rec) wpa<-subset(rec, WTP_DG!="") wpb<-subset(wpa, WTP_UG!="") MAO<-wpb$WTP_UG/0.50; MAO PUN<-wpb$WTP_DG/0.55;PUN wilcox.test(MAO, PUN, paired=T) mean(MAO) mean(PUN) #WTP is > MAO - people are more punitive in the DG than in the UG. This holds even when we look at the proportion of the stake that is punished (i.e. accounting for the fact that stake in the UG was $0.50 and in the DG was $0.55). ################################################################ Plots ################################################################ #barplot UG and DG offers par(font=1,font.lab=6,font.axis=6,font.main=6,font.sub=6,mai=c(0.5,0.6,0.3,0.1),mgp=c(1.5,0.5,0), mar=c(4.1, 4.1, 4.1, 8.1),xpd=TRUE) fp<-c(0.21, 0.13) receiver<-matrix(fp,nrow=2) iqfp1<-c(0.002, 0.003) ; iqfp11<-matrix(iqfp1, nrow=2) iqfp2<-c(0.002, 0.003) ; iqfp22<-matrix(iqfp2, nrow=2) pr.names<-c("Ultimatum Game", "Dictator Game") fprplot<-barplot(height=receiver, names.arg=pr.names, beside=T, ylab="Amount offered to partner ($)", ylim=c(0,0.3)) arrows(fprplot, receiver-iqfp11 , fprplot, receiver +iqfp22, length = 0.05,angle = 90,code = 3 ) #Main figure for paper para<-c(1,2,3,4,5) dg.offer<-c(0.133, 0.135, 0.116, 0.106, 0.068) sem.dg.offer<-c(0.01,0.00,0.01,0.01,0) ug.offer<-c(0.218, 0.214, 0.211, 0.182, 0.184) sem.ug.offer<-c(0.00, 0, 0.01, 0.01, 0.01) par(mfrow=c(1,2),font=1,font.lab=6,font.axis=6,font.main=6,font.sub=6,mai=c(1,0.1,0.1,0.1),mgp=c(1.5,0.5,0), mar=c(3, 3, 4.1, 5),xpd=TRUE) p<-plot(x=para, y=dg.offer, xlab="Paranoia" , ylab="Amount offered to partner ($)", ylim=c(0,0.35)) arrows(para,dg.offer-sem.dg.offer , para, dg.offer+ sem.dg.offer, length = 0.05,angle = 90,code = 3 ) points(x=para, y=ug.offer, col="red") arrows(para, ug.offer-sem.ug.offer,para, ug.offer + sem.ug.offer, length=0.05, angle=90, code=3, col="red") legend(x=1,y=0.41, legend=c("DG Offer","UG offer"), fill=c("black","red")) mtext("(a)", adj=1) dg.punish<-c(0.167, 0.157, 0.182, 0.317, 0.275) dg.pun.sem<-c(0.01, 0.01, 0.02, 0.03, 0.04) ug.wtp<-c(0.098, 0.100, 0.101, 0.108, 0.114) ug.wtp.sem<-c(0,0, 0.01, 0.01, 0.01) q<-plot(x=para, y=dg.punish, xlab="Paranoia" , ylab="Amount offered that player punished or rejected ($)", ylim=c(0,0.35)) arrows(para, dg.punish-dg.pun.sem , para, dg.punish + dg.pun.sem, length = 0.05,angle = 90,code = 3 ) points(x=para, y= ug.wtp, col="red") arrows(para, ug.wtp-ug.wtp.sem,para, ug.wtp + ug.wtp.sem, length=0.05, angle=90, code=3, col="red") mtext("(b)", adj=1) #plot MAO and WTP as function of paranoia para_more<-ifelse(data2$paranoia<=35,1, ifelse(data2$paranoia <=60,2, ifelse(data2$paranoia <=85,3, ifelse(data2$paranoia <=110,4, ifelse(data2$paranoia <=160,5, ))))) para_more