########################################################
# Risk-buffering and resource access shape valuation of out-group strangers
# Anne C. Pisor & Michael Gurven
# 2016
########################################################

#N.B. All results run on R 3.2.3 (2015).

##### Load needed library and function
library(MCMCglmm)

#Variance Inflation Factor checks courtesy of Austin F. Frank (2011): https://github.com/aufrank/R-hacks/blob/master/MCMCglmm-utils.R
vif.MCMCglmm <- function (fit, intercept.columns = c(1)) {
    nF <- fit$Fixed$nfl
    v <- cov(as.matrix(fit$X[,1:nF]))
    nam <- colnames(fit$Sol[,1:nF])

    v <- v[-intercept.columns, -intercept.columns, drop = FALSE]
    nam <- nam[-intercept.columns]
    
    d <- diag(v)^0.5
    v <- diag(solve(v/(d %o% d)))
    names(v) <- nam
    v
}

#N.B. Summary variables were pre-processed, including amount given to in-group and out-group strangers (averaged across three recipients from each group); Extraversion, Agreeableness, and Risk Aversion (each measure, which drew on 4 questions, summed and centered such that their minima are 0); food insecurity (four questions summed); income, market items, places visited, and media exposure (z-scored); subjective SES (logged); Shortfall.Summary summary measure (the first principal component from a PCA generated from Dependency, Prod.Income.Drop, and Food.Insecurity; the reader can re-create this measure if she or he desires); Dependency and Food.Insecurity (adjusted for extreme positive outliers, those abouve the 97.5%ile, in order to estimate the aforementioned first principal component); age (we have binned ages into 10 year age categories, e.g. ages greater than 24 and less than 25 become 30, to protect participant identity).

dat1<-read.csv("[INSERT PATH HERE]/Pisor & Gurven 2016 Data.csv",header=TRUE)

##### Adjust for extreme outliers
dat1$Times.Church.Mo[dat1$Times.Church.Mo>4]<-5 #Attended at rate above 97.5%ile (rounding to the nearest integer)
dat1$Times.Church.Mo[is.na(dat1$Times.Church.Mo)]<-0 #NA = did not attend church in the last month
dat1$Market.Items.zscore[dat1$Market.Items.zscore>quantile(dat1$Market.Items.zscore,0.975,na.rm=TRUE)]<-quantile(dat1$Market.Items.zscore,0.975,na.rm=TRUE)
dat1$Years.Education[dat1$Years.Education>16]<-16 #This is the nearest integer to 97.5% (which is 15.5).
dat1$Risk.Aversion[dat1$Risk.Aversion>quantile(dat1$Risk.Aversion,0.975,na.rm=TRUE)]<-quantile(dat1$Risk.Aversion,0.975,na.rm=TRUE)

##### Center age
dat1$Age<-dat1$Age-20

#Make factors
as.factor(dat1$Prod.Income.Drop)->dat1$Prod.Income.Drop;as.factor(dat1$Can.Borrow)->dat1$Can.Borrow;as.factor(dat1$Can.Stay)->dat1$Can.Stay;as.factor(dat1$Population)->dat1$Population;as.factor(dat1$Ill.This.Mo)->dat1$Ill.This.Mo;as.factor(dat1$Sex.Male)->dat1$Sex.Male;as.factor(dat1$Married)->dat1$Married;factor(dat1$Population,exclude=NULL)->dat1$Population;as.factor(dat1$Coop.Labor)->dat1$Coop.Labor;as.factor(dat1$Married)->dat1$Married;as.factor(dat1$Sex.Male)->dat1$Sex.Male;as.factor(dat1$Nonanonymous.Play)->dat1$Nonanonymous.Play;as.factor(dat1$No.Neg.Stereos)->dat1$No.Neg.Stereos

prior1<-list(R=list(V=1, nu=0.002), G=list(G1=list(V=1, nu=0.002)))

############### Out-group mean #####################
##### No stereotypes
dat_og<-subset(dat1,select=c(OG.Avg,Ill.This.Mo,Prod.Income.Drop,Shortfall.Summary,Coop.Labor,Media.zscore,Visited.zscore,log.Subj.SES,Market.Items.zscore,Income.zscore,Married,Can.Borrow,Can.Stay,Risk.Aversion,Sex.Male,Age,Years.Education,Times.Church.Mo,Dependency,Agreeable,Population,Nonanonymous.Play,Extraverted,Places.Lived,Version))
na.omit(dat_og)->dat_og #n=150

summary(og_full<-MCMCglmm(OG.Avg~Income.zscore+Market.Items.zscore+log.Subj.SES+Shortfall.Summary+Ill.This.Mo+Can.Borrow+Can.Stay+Coop.Labor+Media.zscore+Visited.zscore+Places.Lived+Nonanonymous.Play+Risk.Aversion+Agreeable+Extraverted+Sex.Male+Age+Married+Years.Education+Times.Church.Mo+Version,random=~Population,data=dat_og,family="gaussian",nitt=300000,burnin=30000,verbose=FALSE,prior=prior1))
vif.MCMCglmm(og_full)

##### With lack of negative stereotypes
dat_ogs<-subset(dat1,select=c(OG.Avg,Ill.This.Mo,Prod.Income.Drop,Shortfall.Summary,Coop.Labor,Media.zscore,Visited.zscore,log.Subj.SES,Market.Items.zscore,Income.zscore,Married,Can.Stay,Risk.Aversion,Sex.Male,Age,Years.Education,Times.Church.Mo,Dependency,Agreeable,Population,Nonanonymous.Play,Extraverted,Places.Lived,Version,No.Neg.Stereos)) #Can.Borrow is collinear. n=42.
na.omit(dat_ogs)->dat_ogs

summary(og_st<-MCMCglmm(OG.Avg~No.Neg.Stereos+log.Subj.SES+Coop.Labor+Ill.This.Mo+Media.zscore+Places.Lived+Version,random=~Population,data=dat_ogs,family="gaussian",nitt=300000,burnin=30000,verbose=FALSE,prior=prior1)) #Can.Borrow collinear and thus excluded. 

### Compare to model on same subsample of n=42, but without stereotype.
summary(og_c<-MCMCglmm(OG.Avg~log.Subj.SES+Coop.Labor+Ill.This.Mo+Media.zscore+Places.Lived+Version,random=~Population,data=dat_ogs,family="gaussian",nitt=300000,burnin=30000,verbose=FALSE,prior=prior1)) #Can.Borrow collinear. 

##### Out-group model by population.
#N.B. Controlling for version requires 5 degrees of freedom but has few individuals per category when the data set is broken down by population. It is thus excluded from the below analyses.
dat_ogm<-dat_og[dat_og$Population=="Moseten",];dat_ogi<-dat_og[dat_og$Population=="Intercultural",];dat_ogt<-dat_og[dat_og$Population=="Tsimane",]

#Little varation in ability to borrow from past communities in two populations; this variable converted from three levels to two (binary) for these two populations.
dat_ogm$Can.Borrow[dat_ogm$Can.Borrow=="0"]<-"1";dat_ogi$Can.Borrow[dat_ogi$Can.Borrow=="0"]<-"1"

summary(og_m<-MCMCglmm(OG.Avg~Income.zscore+Market.Items.zscore+log.Subj.SES+Coop.Labor+Shortfall.Summary+Ill.This.Mo+Can.Borrow+Can.Stay+Media.zscore+Visited.zscore+Places.Lived+Nonanonymous.Play+Risk.Aversion+Agreeable+Extraverted+Sex.Male+Age+Years.Education+Times.Church.Mo,data=dat_ogm,family="gaussian",nitt=300000,burnin=30000,verbose=FALSE)) #Too little variability in Married for inclusion.

summary(og_t<-MCMCglmm(OG.Avg~Income.zscore+Market.Items.zscore+log.Subj.SES+Coop.Labor+Shortfall.Summary+Can.Borrow+Can.Stay+Media.zscore+Visited.zscore+Places.Lived+Nonanonymous.Play+Risk.Aversion+Agreeable+Extraverted+Sex.Male+Age+Years.Education+Times.Church.Mo,data=dat_ogt,family="gaussian",nitt=300000,burnin=30000,verbose=FALSE)) #Too little variability in Ill.This.Mo or Married for inclusion.

summary(og_i<-MCMCglmm(OG.Avg~Income.zscore+Market.Items.zscore+log.Subj.SES+Coop.Labor+Shortfall.Summary+Can.Borrow+Can.Stay+Media.zscore+Visited.zscore+Places.Lived+Nonanonymous.Play+Risk.Aversion+Agreeable+Extraverted+Sex.Male+Age+Married+Years.Education+Times.Church.Mo,data=dat_ogi,family="gaussian",nitt=300000,burnin=30000,verbose=FALSE)) #Too little variability in Ill.This.Mo for inclusion.

##### Out-group model by anonymity.
dat_oga<-dat_og[dat_og$Nonanonymous.Play==FALSE,];dat_ogn<-dat_og[dat_og$Nonanonymous.Play==TRUE,]

#Little varation in ability to borrow from past communities in anonymous subsample; this variable converted from three levels to two (binary) for this subsample.
dat_oga$Can.Borrow[dat_oga$Can.Borrow=="0"]<-"1"

summary(og_an<-MCMCglmm(OG.Avg~Income.zscore+Market.Items.zscore+log.Subj.SES+Coop.Labor+Shortfall.Summary+Ill.This.Mo+Can.Borrow+Can.Stay+Media.zscore+Visited.zscore+Places.Lived+Risk.Aversion+Agreeable+Extraverted+Sex.Male+Age+Years.Education+Times.Church.Mo,random=~Population,data=dat_oga,family="gaussian",nitt=300000,burnin=30000,verbose=FALSE)) #Too little variability in Married or Version for inclusion.

summary(og_n<-MCMCglmm(OG.Avg~Income.zscore+Market.Items.zscore+log.Subj.SES+Coop.Labor+Shortfall.Summary+Ill.This.Mo+Can.Borrow+Can.Stay+Media.zscore+Visited.zscore+Places.Lived+Risk.Aversion+Agreeable+Extraverted+Sex.Male+Age+Married+Years.Education+Times.Church.Mo+Version,random=~Population,data=dat_ogn,family="gaussian",nitt=300000,burnin=30000,verbose=FALSE))



############### Money kept for self #####################

##### No stereotypes
dat_s<-subset(dat1,select=c(Self.Kept,Ill.This.Mo,Prod.Income.Drop,Shortfall.Summary,Coop.Labor,Media.zscore,Visited.zscore,log.Subj.SES,Market.Items.zscore,Income.zscore,Married,Can.Borrow,Can.Stay,Risk.Aversion,Sex.Male,Age,Years.Education,Times.Church.Mo,Dependency,Agreeable,Population,Nonanonymous.Play,Extraverted,Places.Lived,Version,OG.Avg)) #Subset so as to contain the same individuals as dat_og. Results are robust either way.
na.omit(dat_s)->dat_s #n=150

summary(s<-MCMCglmm(Self.Kept~Income.zscore+Market.Items.zscore+log.Subj.SES+Shortfall.Summary+Ill.This.Mo+Can.Borrow+Can.Stay+Coop.Labor+Media.zscore+Visited.zscore+Places.Lived+Nonanonymous.Play+Risk.Aversion+Agreeable+Extraverted+Sex.Male+Age+Married+Years.Education+Times.Church.Mo+Version,random=~Population,data=dat_s,family="gaussian",nitt=300000,burnin=30000,verbose=FALSE,prior=prior1)) 

##### Out-group stereotypes
dat_ss<-subset(dat1,select=c(Self.Kept,OG.Avg,Ill.This.Mo,Prod.Income.Drop,Shortfall.Summary,Coop.Labor,Media.zscore,Visited.zscore,log.Subj.SES,Market.Items.zscore,Income.zscore,Married,Can.Borrow,Can.Stay,Risk.Aversion,Sex.Male,Age,Years.Education,Times.Church.Mo,Dependency,Agreeable,Population,Nonanonymous.Play,Extraverted,Places.Lived,Version,No.Neg.Stereos))
na.omit(dat_ss)->dat_ss

summary(s_st<-MCMCglmm(Self.Kept~No.Neg.Stereos+log.Subj.SES+Coop.Labor+Ill.This.Mo+Media.zscore+Places.Lived+Version,random=~Population,data=dat_ss,family="gaussian",nitt=300000,burnin=30000,verbose=FALSE,prior=prior1))

### Compare to model on same subsample of n=42, but without stereotype.
summary(s_c<-MCMCglmm(Self.Kept~log.Subj.SES+Coop.Labor+Ill.This.Mo+Media.zscore+Places.Lived+Version,random=~Population,data=dat_ss,family="gaussian",nitt=300000,burnin=30000,verbose=FALSE,prior=prior1))



############### In-group mean #####################

##### No stereotypes
dat_i<-subset(dat1,select=c(IG.Avg,OG.Avg,Ill.This.Mo,Prod.Income.Drop,Shortfall.Summary,Coop.Labor,Media.zscore,Visited.zscore,log.Subj.SES,Market.Items.zscore,Income.zscore,Married,Can.Borrow,Can.Stay,Risk.Aversion,Sex.Male,Age,Years.Education,Times.Church.Mo,Dependency,Agreeable,Population,Nonanonymous.Play,Extraverted,Places.Lived,Version))#Constrained to be same individuals featured in out-group model. Results are robust either way.
na.omit(dat_i)->dat_i

summary(simi1_ct<-MCMCglmm(IG.Avg~Income.zscore+Market.Items.zscore+log.Subj.SES+Shortfall.Summary+Ill.This.Mo+Can.Borrow+Can.Stay+Coop.Labor+Media.zscore+Visited.zscore+Places.Lived+Nonanonymous.Play+Risk.Aversion+Agreeable+Extraverted+Sex.Male+Age+Married+Years.Education+Times.Church.Mo+Version,random=~Population,data=dat_i,family="gaussian",nitt=300000,burnin=30000,verbose=FALSE,prior=prior1))

##### Out-group stereotypes
dat_is<-subset(dat1,select=c(IG.Avg,OG.Avg,Ill.This.Mo,Prod.Income.Drop,Shortfall.Summary,Coop.Labor,Media.zscore,Visited.zscore,log.Subj.SES,Market.Items.zscore,Income.zscore,Married,Can.Borrow,Can.Stay,Risk.Aversion,Sex.Male,Age,Years.Education,Times.Church.Mo,Dependency,Agreeable,Population,Nonanonymous.Play,Extraverted,Places.Lived,Version,No.Neg.Stereos))#Constrained to be same individuals featured in out-group model. n=39.
na.omit(dat_is)->dat_is

summary(i_st<-MCMCglmm(IG.Avg~No.Neg.Stereos+log.Subj.SES+Coop.Labor+Ill.This.Mo+Media.zscore+Places.Lived+Version,random=~Population,data=dat_is,family="gaussian",nitt=300000,burnin=30000,verbose=FALSE,prior=prior1)) #Too collinear for Can.Borrow.
vif.MCMCglmm(i_stc)

### Compare to model on same subsample of n=42, but without stereotype.
summary(i_c<-MCMCglmm(IG.Avg~log.Subj.SES+Coop.Labor+Ill.This.Mo+Media.zscore+Places.Lived+Version,random=~Population,data=dat_is,family="gaussian",nitt=300000,burnin=30000,verbose=FALSE,prior=prior1)) 

############### Descriptive stats #####################

dat_og<-subset(dat1,select=c(OG.Avg,IG.Avg,Self.Kept,Prod.Income.Drop,Ill.This.Mo,Shortfall.Summary,Food.Insecurity,Coop.Labor,Media.zscore,Visited.zscore,log.Subj.SES,Market.Items.zscore,Income.zscore,Married,Can.Borrow,Can.Stay,Risk.Aversion,Sex.Male,Age,Years.Education,Times.Church.Mo,Dependency,Agreeable,Population,Nonanonymous.Play,Extraverted,Places.Lived,Version,No.Neg.Stereos))
dat_og[!is.na(dat_og$OG.Avg),]->dat_og1

subset(dat_og1,select=c(OG.Avg,IG.Avg,Self.Kept,Income.zscore,Market.Items.zscore,log.Subj.SES,Shortfall.Summary,Food.Insecurity,Dependency,Media.zscore,Visited.zscore,Places.Lived,Risk.Aversion,Agreeable,Extraverted,Age,Years.Education,Times.Church.Mo))->matnum
subset(dat_og1,select=c(Coop.Labor,Prod.Income.Drop,Ill.This.Mo,Can.Borrow,Can.Stay,No.Neg.Stereos,Nonanonymous.Play,Sex.Male,Married,Population))->matint

numdes<-matrix(c(rep(NA,length(matnum)*7)),ncol=7,byrow=FALSE)
colnames(numdes)<-c("Variable","Mean","SD","Median","Min","Max","N")
for (i in 1:length(matnum)) {
colnames(matnum[i])->numdes[i,1]
mean(matnum[,i],na.rm=TRUE)->numdes[i,2]
sd(matnum[,i],na.rm=TRUE)->numdes[i,3]
median(matnum[,i],na.rm=TRUE)->numdes[i,4]
min(matnum[,i],na.rm=TRUE)->numdes[i,5]
max(matnum[,i],na.rm=TRUE)->numdes[i,6]
nrow(matnum[!is.na(matnum[,i]),])->numdes[i,7]
}

facdes<-matrix(c(rep(NA,length(matint)*7)),ncol=7,byrow=FALSE)
colnames(facdes)<-c("Variable","Mean","SD","Median","Min","Max","N")
for (i in 1:length(matint)) {
colnames(matint[i])->facdes[i,1]
if (class(matint[,i])=="integer") median(matint[,i],na.rm=TRUE)->facdes[i,4] else median(as.numeric(matint[,i]),na.rm=T)->facdes[i,4]
nrow(matint[!is.na(matint[,i]),])->facdes[i,7]
}