EduMod80

From InterSciWiki
Jump to: navigation, search
  • Dep var: Moral gods
  • source("C:/My Documents/sccs/sccs/R/two_stage_ols.R")
  • pastoralExch=((sccs$v208==1)*1)*(sccs$v858==6)*1 #bridewealth*pastoralism
  • moneystate=(sccs$v237>=4)*1*(sccs$v155==5)*1

Edu-Mod 2009-10: The Individual Studies - Moral gods 3A forward Money v155, v17 as dependent variable

  • EduMod78 Evil eye is a dependent variable of money
  • EduMod79 Money is a dependent variable of milking, Moral gods
  • EduMod82 CaststratLGD is a dependent variable of milk, money2, Moral gods and ??other??
  • EduMod88 PastoralExch as a dependent variable of fratgrpstr, money, himilexp, etc.
  • Here: Are moral gods a dependent variable of money, milking?

Contents

AB| Code for map of v238<-4 Moral gods

load("world_countries_24.rda",.GlobalEnv)
 depvar<- ((1+(SCCS$v238==4)*1)^2)-2
zdv<-which(!is.na(depvar))
dep_var<-depvar[zdv]
dep_var<-dep_var+1
table(dep_var)
depvarname<-"Money v155"
load("world_countries_24.rda",.GlobalEnv)
sccs=SCCS
splgt<-SpatialPointsDataFrame(coordinates(sccs[zdv,c("longitud","latitude")]),data.frame(dep_var)) 
brks<-quantile(dep_var,c(0,.333,.666,1))
cols<-colorRampPalette(c("yellow", "brown"))(length(brks)-1)
plot(world_countries,col="white") #black")
plot(splgt,pch=21,add=TRUE,cex=dep_var^.25,col="red", bg=cols[findInterval(dep_var, brks, all.inside=TRUE)])
mtext(depvarname,line=-2, side=1,cex=.5) #7)
splgt<-SpatialPointsDataFrame(coordinates(sccs[zdv,c("longitud","latitude")]),data.frame(dep_var)) 
brks<-quantile(dep_var,c(0,.333,.666,1))
cols<-colorRampPalette(c("yellow", "brown"))(length(brks)-1)
#jpeg(file="473-475mapValue_of_Boys.jpg",width=8,height=5,units="in",pointsize=8,res=600)
plot(world_countries,col="white") #black")
plot(splgt,pch=21,add=TRUE,cex=dep_var^.25,col="red", bg=cols[findInterval(dep_var, brks, all.inside=TRUE)])
mtext(depvarname,line=-2, side=1,cex=.5) #7)
# dev.off()

AB| Code for map of v245<-4 Milk

load("world_countries_24.rda",.GlobalEnv)
 depvar<- ((1+(SCCS$v245==2)*1)^2)-2
 #depvar<- SCCS$v245
zdv<-which(!is.na(depvar))
dep_var<-depvar[zdv]
dep_var<-dep_var+1
table(dep_var)
depvarname<-"Money v155"
load("world_countries_24.rda",.GlobalEnv)
sccs=SCCS
splgt<-SpatialPointsDataFrame(coordinates(sccs[zdv,c("longitud","latitude")]),data.frame(dep_var)) 
brks<-quantile(dep_var,c(0,.333,.666,1))
cols<-colorRampPalette(c("yellow", "brown"))(length(brks)-1)
plot(world_countries,col="white") #black")
plot(splgt,pch=21,add=TRUE,cex=dep_var^.25,col="red", bg=cols[findInterval(dep_var, brks, all.inside=TRUE)])
mtext(depvarname,line=-2, side=1,cex=.5) #7)
splgt<-SpatialPointsDataFrame(coordinates(sccs[zdv,c("longitud","latitude")]),data.frame(dep_var)) 
brks<-quantile(dep_var,c(0,.333,.666,1))
cols<-colorRampPalette(c("yellow", "brown"))(length(brks)-1)
#jpeg(file="473-475mapValue_of_Boys.jpg",width=8,height=5,units="in",pointsize=8,res=600)
plot(world_countries,col="white") #black")
plot(splgt,pch=21,add=TRUE,cex=dep_var^.25,col="red", bg=cols[findInterval(dep_var, brks, all.inside=TRUE)])
mtext(depvarname,line=-2, side=1,cex=.5) #7)
# dev.off()

3A| Moral gods v238 EvilEye NOT DICHOTOMIZED MONEY v155 >1 >3 >4 drop PCsize

HOW TO CORRECT: IMPORTANT: RUN PROGRAM TO JUST ABOVE THE ERROR. THEN

coef(xR)              #where NA delete the variable
coef(xUR)             #where NA delete the variable
Error in `[.data.frame`(m9, , indpv) : undefined columns selected
Error in as.matrix(m9[, indpv]) :  indpv "money" listed twice
The hypothesis "moralgods" is not well formed: contains bad coefficient/variable names.
---
Error in constants(lhs, cnames_symb) : 
 The hypothesis "moralgods" is not well formed: contains bad coefficient/variable names. THIS WAS IN dropt!!


#Program 1 --> Program 2 below
#Program 1 Part A
#MI--make the imputed datasets
#--change the following path to the directory with your data and program--
setwd("C:/My Documents/MI")
rm(list=ls(all=TRUE))
options(echo=TRUE)
#--you need the following two packages--you must install them first--
library(foreign)
library(mice)
library(tripack)
library(zoo)
library(sp)
library(maptools)
library(spam)
#--for program 2 below
library(spdep)
library(car)
library(lmtest)
library(sandwich)

#--To find the citation for a package, use this function:---
citation("mice")

#-----------------------------
#--Read in data, rearrange----
#-----------------------------

#--Read in auxiliary variables---
load("vaux.Rdata",.GlobalEnv)
row.names(vaux)<-NULL
#--Read in the SCCS dataset---
load("SCCS.Rdata",.GlobalEnv)
#--look at first 6 rows of vaux--
head(vaux)
#--look at field names of vaux--
names(vaux)
#--check to see that rows are properly aligned in the two datasets--
#--sum should equal 186---
sum((SCCS$socname==vaux$socname)*1)
#--remove the society name field--
vaux<-vaux[,-28]
names(vaux)

#--Two nominal variables: brg and rlg----
#--brg: consolidated Burton  Regions-----
#0 = (rest of world) circumpolar, South and Meso-America, west North America
#1 = Subsaharan Africa
#2 = Middle Old World
#3 = Southeast Asia, Insular Pacific, Sahul
#4 = Eastern Americas
#--rlg: Religion---
#'0 (no world religion)'  
#'1 (Christianity)'  
#'2 (Islam)'  
#'3 (Hindu/Buddhist)'  

#--check to see number of missing values in vaux, 
#--whether variables are numeric,
#--and number of discrete values for each variable---
vvn<-names(vaux)
pp<-NULL
for (i in 1:length(vvn)){
nmiss<-length(which(is.na(vaux[,vvn[i]])))
numeric<-is.numeric(vaux[,vvn[i]])
numDiscrVals<-length(table(vaux[,vvn[i]]))
pp<-rbind(pp,cbind(data.frame(numeric),nmiss,numDiscrVals))
}
row.names(pp)<-vvn
pp

#MODIFY THESE STATEMENTS FOR A NEW PROJECT
#--extract variables to be used from SCCS, put in dataframe fx--
fx<-data.frame(
socname=SCCS$socname,socID=SCCS$"sccs#",
#PCAP PCsize PCsize2 caststrat eextwar
PCvioHomi=SCCS$v1665,   ### PCvioHomi PCvioAslt PCvioIntr PCvioTotl
PCvioAslt=SCCS$v1666,
PCvioIntr=SCCS$v666,
#PCvioTotl=SCCS$v666+SCCS$v1666+SCCS$v1665,
extwar=SCCS$v892,
classtrat=SCCS$v270,
caststrat=SCCS$v272,
anim=SCCS$v206,
anim_log=log(1+SCCS$v206),
milk=(SCCS$v245>1)*1,
milkedanim=SCCS$v206*SCCS$v206,
bridewealth=(SCCS$v208==1)*1,
money=SCCS$v17,
money2=(SCCS$v155>1)*1+(SCCS$v155>3)*1+(SCCS$v155>4)*1,
extwar2=SCCS$v892^2,
caststratLgd=log(1+SCCS$v272),    #^2,
anim=SCCS$v206,
anim2=log(1+SCCS$v206),         #^2,
#moralgods=SCCS$v238,
#moralgods2=(SCCS$v238)^2,
PCsize=SCCS$v237,
PCAP=SCCS$v921,
PCsize2=SCCS$v237^2, eextwar=SCCS$v1650,
valchild=(SCCS$v473+SCCS$v474+SCCS$v475+SCCS$v476),
fratgrpstr=SCCS$v570,
marrcaptives=SCCS$v870,
plunder=SCCS$v912, ##2009 depvars
pre_mar_sex=SCCS$v167, foodstress=SCCS$v678,
femctrldwellg=SCCS$v591,
wealthy=SCCS$v1721,
poor=SCCS$v1723,
war679=SCCS$v679,
###climate<-(SCCS$v857==1 | SCCS$v857==2 | SCCS$v857==6)*1+(SCCS$v857==3 | SCCS$v857==4)*2+(SCCS$v857==5)*3,
nonmatrel=SCCS$v52,
lrgfam=SCCS$v68,
exogamy=SCCS$v72,
famsize=SCCS$v80,
popdens=SCCS$v156,
malesexag=SCCS$v175,
ndrymonth=SCCS$v196,
gath=SCCS$v203,
hunt=SCCS$v204,
fish=SCCS$v205,
anim=SCCS$v206,
nuclearfam=(SCCS$v210<=3)*1,
ncmallow=SCCS$v227,
cultints=SCCS$v232,
tree=(SCCS$v233==4)*1,
roots=(SCCS$v233==5)*1,
cereals=(SCCS$v233==6)*1,
settype=SCCS$v234,
localjh=(SCCS$v236-1),
#superjh=SCCS$v237,
segadlboys=SCCS$v242,
plow=(SCCS$v243>1)*1,
pigs=(SCCS$v244==2)*1,
bovines=(SCCS$v244==7)*1,
agrlateboy=SCCS$v300,
fempower=SCCS$v663,
migr=(SCCS$v677==2)*1,
foodtrade=SCCS$v819,
dateobs=SCCS$v838,
rain=SCCS$v854,
temp=SCCS$v855,
ecorich=SCCS$v857,
pctFemPolyg=SCCS$v872,
femsubs=SCCS$v890,
himilexp=(SCCS$v899==1)*1,
AP1=SCCS$v921,
AP2=SCCS$v928,
pathstress=SCCS$v1260,
war=SCCS$v1648,
foodscarc=SCCS$v1685,
sexratio=1+(SCCS$v1689>85)+(SCCS$v1689>115),
wagelabor=SCCS$v1732,
CVrain=SCCS$v1914/SCCS$v1913
) 

#--look at first 6 rows of fx--
head(fx)

#--check to see number of missing values--
#--also check whether numeric--
vvn<-names(fx)
pp<-NULL
for (i in 1:length(vvn)){
nmiss<-length(which(is.na(fx[,vvn[i]])))
numeric<-is.numeric(fx[,vvn[i]])
pp<-rbind(pp,cbind(nmiss,data.frame(numeric)))
}
row.names(pp)<-vvn
pp

#--identify variables with missing values--
z<-which(pp[,1]>0)
zv1<-vvn[z]
zv1
#--identify variables with non-missing values--
z<-which(pp[,1]==0)
zv2<-vvn[z]
zv2
  



#Program 1 Part B
#-----------------------------
#----Multiple imputation------
#-----------------------------

#--number of imputed data sets to create--
#nimp<-10 #CHANGED TO TEST SPEEDUP  
nimp<-3  ################################################################## speedup test
#--one at a time, loop through those variables with missing values--
for (i in 1:length(zv1)){
#--attach the imputand to the auxiliary data--
zxx<-data.frame(cbind(vaux,fx[,zv1[i]]))
#--in the following line, the imputation is done--
aqq<-complete(mice(zxx,maxit=20,m=nimp),action="long")
###aqq<-complete(mice(zxx,maxit=100,m=nimp),action="long")
#--during first iteration of the loop, create dataframe impdat--
if (i==1){
impdat<-data.frame(aqq[,c(".id",".imp")])
}
#--the imputand is placed as a field in impdat and named--
impdat<-cbind(impdat,data.frame(aqq[,NCOL(zxx)]))
names(impdat)[NCOL(impdat)]<-zv1[i]
}

#--now the non-missing variables are attached to impdat--
gg<-NULL
for (i in 1:nimp){
gg<-rbind(gg,data.frame(fx[,zv2]))
}
impdat<-cbind(impdat,gg)

#--take a look at the top 6 and bottom 6 rows of impdat--
head(impdat)
tail(impdat)

#--impdat is saved as an R-format data file--
save(impdat,file="impdat.Rdata")


 
 

#Program 2 (12-18-2009)==
#MI--estimate model, combine results

rm(list=ls(all=TRUE))
#--Set path to your directory with data and program--
setwd("C:/My Documents/MI")
options(echo=TRUE)

#--need these packages for estimation and diagnostics--
library(foreign)
library(spdep)
library(car)
library(lmtest)
library(sandwich)

#-----------------------------
#--Read in data, rearrange----
#-----------------------------

#--Read in original SCCS data---
load("SCCS.Rdata",.GlobalEnv)
#--Read in two weight matrices--
ll<-as.matrix(read.dta("langwm.dta")[,-1])
dd<-as.matrix(read.dta("dist25wm.dta")[,c(-1,-2,-189)])
#--Read in the imputed dataset---
load("impdat.Rdata",.GlobalEnv)

#--create dep.varb. you wish to use from SCCS data--
#--Here we sum variables measuring how much a society values children--
#depvar<-apply(SCCS[,c("v473","v474","v475","v476")],1,sum) #can replace "sum" with "max"
#depvar<-SCCS$v1188    #v1188+SCCS$v1189
depvar<-SCCS$v238
#--find obs. for which dep. varb. is non-missing--
zdv<-which(!is.na(depvar))
depvar<-depvar[zdv]
#HERE GIVE THE "NAME" OF THE DEPENDENT VARIABLE THAT IS COMPUTED
depvarname<-"MoralGods"
#--can add additional SCCS variable, but only if it has no missing values---
dateobs<-SCCS$v838
dateobs<-dateobs[zdv]

#--look at histogram and frequencies for the dep. varb.--
hist(depvar)
table(depvar)

#--modify weight matrices---
#--set diagonal equal to zeros--
diag(ll)<-0
diag(dd)<-0
#--use only obs. where dep. varb. non-missing--
ll<-ll[zdv,zdv]
dd<-dd[zdv,zdv]
#--row standardize (rows sum to one)
ll<-ll/rowSums(ll)
dd<-dd/rowSums(dd)
#--check to see that rows sum to one
rowSums(ll)
rowSums(dd)
#--make weight matrix object for later autocorrelation test--
wmatll<-mat2listw(as.matrix(ll))
wmatdd<-mat2listw(as.matrix(dd))

#"moralgods","moralgods2",
indpv<-c("pre_mar_sex", "money", "foodstress", "femctrldwellg",
"wealthy","poor","PCvioHomi","PCvioAslt","PCvioIntr",#"PCvioTotl",
"milkedanim","pctFemPolyg",
"anim2","money2","bridewealth","caststratLgd",
#","classtrat "PCAP","PCsize","PCsize2","caststrat","eextwar", 
"femsubs","foodscarc",
"fratgrpstr","marrcaptives","plunder",###"climate",
"exogamy","ncmallow",#"superjh",
"fempower","sexratio",
"war","himilexp","wagelabor",
"famsize","settype","localjh",
"cultints","roots","cereals","gath","hunt","fish",
"anim","pigs","milk","plow","bovines","tree","foodtrade",
"ndrymonth","ecorich",
"popdens","pathstress","CVrain","rain","temp","AP1","AP2")


#-----------------------------------------------------
#---Estimate model on each imputed dataset------------
#-----------------------------------------------------

#--number of imputed datasets--
#nimp<-10
nimp<-3  ################################################################## speedup test

#--will append values to these empty objects--
vif<-NULL
ss<-NULL
beta<-NULL
dng<-NULL

#--loop through the imputed datasets--
for (i in 1:nimp){

#--select the ith imputed dataset--
m9<-impdat[which(impdat$.imp==i),]
#--retain only obs. for which dep. varb. is nonmissing--
m9<-m9[zdv,]

#--create spatially lagged dep. varbs.--
y<-as.matrix(depvar)
xx<-as.matrix(m9[,indpv])
#--for instruments we use the spatial lag of our indep. varbs.--
#--First, the spatially lagged varb. for distance--
xdy<-dd%*%xx
cyd<-dd%*%y
o<-lm(cyd~xdy)
#--the fitted value is our instrumental variable--
fydd<-fitted(o)
#--keep R2 from this regression--
dr2<-summary(o)$r.squared
#--Then, the spatially lagged varb. for language--
xly<-ll%*%xx   
cyl<-ll%*%y
o<-lm(cyl~xly)
#--the fitted value is our instrumental variable--
fyll<-fitted(o)
#--keep R2 from this regression--
lr2<-summary(o)$r.squared
m9<-cbind(m9,fydd,fyll)

#--OLS estimate of unrestricted model--
xUR<-lm(depvar~fyll+fydd+
PCvioHomi+PCvioAslt+PCvioIntr+
milkedanim+pctFemPolyg+
anim2+caststratLgd+money2+bridewealth+
##moralgods+moralgods2+  ##classtrat+
PCAP+PCsize+PCsize2+caststrat+eextwar+
pre_mar_sex+money+foodstress+femctrldwellg+
poor+wealthy+
fratgrpstr+marrcaptives+plunder+###climate+
cultints+roots+cereals+gath+plow+
hunt+fish+anim+pigs+milk+bovines+tree+foodtrade+foodscarc+
ecorich+popdens+pathstress+exogamy+ncmallow+famsize+
settype+localjh+
fempower+femsubs+ #superjh+
sexratio+war+himilexp+money+wagelabor
,data=m9)

##moralgods2+
##moralgods
#--OLS estimate of restricted model--
xR<-lm(depvar~fydd+fyll+
#PCvioHomi+#
#PCvioAslt+
PCvioIntr+
#foodscarc+##eextwar+
PCAP+
#PCsize+  Dropped 9-04-2010
PCsize2+
milk+  #AP1+AP2+
#anim+ anim2+
#milkedanim+
foodstress+
#fratgrpstr+ #poor+#wealthy+
#pctFemPolyg+# #plow+
eextwar+ 
#money    ##+money2  
bridewealth+ ## caststrat+money+
caststratLgd   ##classtrat+
#PCsize+
#superjh+
,data=m9)

#--corrected sigma2 and R2 for 2SLS--
qxx<-m9
qxx[,"fydd"]<-cyd
qxx[,"fyll"]<-cyl
b<-coef(xR)
incpt<-matrix(1,NROW(qxx),1)
x<-as.matrix(cbind(incpt,qxx[,names(b)[-1]]))
e<-y-x%*%as.matrix(b)
cs2<-as.numeric(t(e)%*%e/(NROW(x)-NCOL(x)))
cr2<-as.numeric(1-t(e)%*%e/sum((y-mean(y))^2))

#--collect coefficients and their variances--
ov<-summary(xR)
vif<-rbind(vif,vif(xR))
ss<-rbind(ss,diag(ov$cov*cs2))
#--collect robust coef. variances when there is heteroskedasticity--
#eb<-e^2
#x<-as.matrix(cbind(incpt,m9[,names(b)[-1]]))
#hcm<-inv(t(x)%*%x)%*%t(x)%*%diag(eb[1:length(eb)])%*%x%*%inv(t(x)%*%x)
#ss<-rbind(ss,diag(hcm))
beta<-rbind(beta,coef(xR))

#"moralgods","
#--collect some model diagnostics--
dropt<-c("cereals","gath","plow","hunt","anim",
"pigs","milk","bovines","foodscarc","ecorich",
"popdens","pathstress","ncmallow","famsize","localjh",
#"superjh",
"fempower","sexratio","money",
"wagelabor","war","himilexp","tree")


#--Ramsey RESET test--
p1<-qchisq(resettest(xR,type="fitted")$"p.value",1,lower.tail=FALSE)
#--Wald test (H0: dropped variables have coefficient equal zero)--
o<-linear.hypothesis(xUR,dropt,test="Chisq")$"Pr(>Chisq)"[2]
p2<-qchisq(o,1,lower.tail=FALSE) #find Chisq with 1 d.f. and same pvalue
#--Heteroskedasticity test (H0: homoskedastic residuals)--
p3<-ncv.test(xR)$ChiSquare
#--Shapiro-Wilke normality test (H0: residuals normal)
p4<-qchisq(shapiro.test(residuals(xR))$p.value,1,lower.tail=FALSE)
#--LaGrange Multiplier test for spatial autocorrelation: language--
o<-lm.LMtests(xR, wmatll, test=c("LMlag"))
p5<-as.numeric(o$LMlag$statistic)
#--LaGrange Multiplier test for spatial autocorrelation: distance--
o<-lm.LMtests(xR, wmatdd, test=c("LMlag"))
p6<-as.numeric(o$LMlag$statistic)
#--model R2--
p7<-cr2
dng<-rbind(dng,cbind(p1,p2,p3,p4,p5,p6,p7,dr2,lr2))

}


#--------------------------------------------
#--Rubin's formulas for combining estimates--
#--------------------------------------------

#--first find final regr. coefs. and p-values--
mnb<-apply(beta,2,mean)
####################vrb<-colSums((beta-t(matrix(mnb,length(mnb),10)))^2)/(nimp-1)
vrb<-colSums((beta-t(matrix(mnb,length(mnb),nimp)))^2)/(nimp-1)
mnv<-apply(ss,2,mean)
vrT<-mnv+vrb*(1-nimp^(-1))
fst<-mnb^2/vrT
r<-(1+nimp^(-1))*vrb/mnv
v<-(nimp-1)*(1+r^(-1))^2
pval<-pf(fst,1,v,lower.tail=FALSE)
bbb<-data.frame(round(cbind(mnb,fst,v,pval),8)) #,3 changed to .8 for significance test
bbb$VIF[2:NROW(bbb)]<-round(apply(vif,2,mean),3)
names(bbb)<-c("coef","Fstat","ddf","pvalue","VIF")

#--Then combine the diagnostics we collected--
dng<-data.frame(dng)
names(dng)<-c("RESET","Wald on restrs.","NCV","SWnormal","lagll","lagdd",
"R2:final model","R2:IV(distance)","R2:IV(language)")
r2<-apply(dng[,7:9],2,mean)
adng<-dng[,1:6]
mdm<-apply(adng,2,mean)
vrd<-colSums((adng-t(matrix(mdm,length(mdm),nimp)))^2)/(nimp-1)
aa<-4*mdm^2-2*vrd
aa[which(aa<0)]<-0
rd<-(1+nimp^(-1))*vrd/(2*mdm+aa^.5)
vd<-(nimp-1)*(1+rd^(-1))^2
Dm<-(mdm-(nimp-1)/(nimp+1)*rd)/(1+rd)
#-All chi-sq we collected have df=1-------
pvald<-pf(Dm,1,vd,lower.tail=FALSE)
ccc<-data.frame(round(cbind(Dm,vd,pvald),3))
names(ccc)<-c("Fstat","df","pvalue")

#--write results to csv file for perusal in spreadsheet--
write.csv("==OLS model for depvar==",file="OLSresults.csv",append=FALSE)
write.csv(bbb,file="OLSresults.csv",append=TRUE)
write.csv(r2,file="OLSresults.csv",append=TRUE)
write.csv(ccc,file="OLSresults.csv",append=TRUE)

aaa<-c(table(depvar), NROW(depvar),depvarname)
imp<-"number of imputations nimp="
impute=c(imp,nimp)

bbb
r2
ccc
bbb<-data.frame(round(cbind(mnb,fst,v,pval),3)) #.8 changed to back to .3 for significance test
bbb$VIF[2:NROW(bbb)]<-round(apply(vif,2,mean),3)
bbb
aaa
impute
load("world_countries_24.rda",.GlobalEnv)
zdv<-which(!is.na(depvar))
dep_var<-depvar[zdv]
dep_var<-dep_var+1
table(dep_var)
depvarname<-"Moral gods v238"
load("world_countries_24.rda",.GlobalEnv)
sccs=SCCS
splgt<-SpatialPointsDataFrame(coordinates(sccs[zdv,c("longitud","latitude")]),data.frame(dep_var)) 
brks<-quantile(dep_var,c(0,.333,.666,1))
cols<-colorRampPalette(c("yellow", "brown"))(length(brks)-1)
plot(world_countries,col="white") #black")
plot(splgt,pch=21,add=TRUE,cex=dep_var^.25,col="red", bg=cols[findInterval(dep_var, brks, all.inside=TRUE)])
mtext(depvarname,line=-2, side=1,cex=.5) #7)
splgt<-SpatialPointsDataFrame(coordinates(sccs[zdv,c("longitud","latitude")]),data.frame(dep_var)) 
brks<-quantile(dep_var,c(0,.333,.666,1))
cols<-colorRampPalette(c("yellow", "brown"))(length(brks)-1)
#jpeg(file="473-475mapValue_of_Boys.jpg",width=8,height=5,units="in",pointsize=8,res=600)
plot(world_countries,col="white") #black")
plot(splgt,pch=21,add=TRUE,cex=dep_var^.25,col="red", bg=cols[findInterval(dep_var, brks, all.inside=TRUE)])
mtext(depvarname,line=-2, side=1,cex=.5) #7)
# dev.off()

4B| Moral gods dep var on Milk, not money?

9-04-2010 drop PCsize

R2:final model R2:IV(distance) R2:IV(language) 
      0.5122616       0.9934543       0.9847571 
                Fstat           df pvalue
RESET           0.745       51.077  0.392
Wald on restrs. 0.840       24.219  0.369
NCV             5.349  5987963.746  0.021
SWnormal        3.189       16.896  0.092
lagll           1.481  9489526.720  0.224
lagdd           1.155 40993590.728  0.283
                mnb    fst           v  pval   VIF
(Intercept)   2.144  4.295      62.887 0.042    NA
fydd          0.929 31.983 3383749.713 0.00000002 2.556
fyll         -0.983  4.481     624.503 0.035 2.534
PCAP         -0.034  2.715  688084.821 0.099 1.124
PCsize2       0.020  3.004    1201.449 0.083 1.465
milk          0.498  5.371   17501.122 0.020 2.241
foodstress    0.281  8.048      30.714 0.008 1.145
eextwar      -0.029  7.003     729.541 0.008 1.142
bridewealth   0.387  6.061    1394.148 0.014 1.289
caststratLgd  0.646  3.971   12545.001 0.046 1.296
PCvioIntr    -0.342  3.712       9.605 0.084 1.206
dep_var "MoralGods" N=168
 2  3  4  5 
68 47 13 40 

Later 8-21- full solution

                    coef      Fstat          ddf     pvalue    VIF
(Intercept)   0.72508427  0.5082292   115.325138 0.47734644     NA
fydd          0.91737940 30.8198448  8813.767639 0.00000003  2.526
fyll         -0.70276350  2.1855171   319.563636 0.14029922  2.579
PCAP         -0.03800545  3.1835425   485.727974 0.07500740  1.148
PCsize        0.55404957  4.5046023   302.706435 0.03461546 23.844
PCsize2      -0.07669086  2.6256058   145.979307 0.10731055 23.404
milk          0.40384598  3.4039788 52902.394526 0.06504495  2.287
foodstress    0.20741460  2.8405758     5.067606 0.15194257  1.103
eextwar      -0.03118432  7.9068194   157.152396 0.00555296  1.124
bridewealth   0.19415083  1.5006396 53024.430162 0.22057841  1.307
caststratLgd  0.70443553  4.7019469 71431.156722 0.03013176  1.276
 R2:final model R2:IV(distance) R2:IV(language) 
      0.5039286       0.9934152       0.9841302 
                Fstat         df pvalue
RESET           0.262     39.642  0.612
Wald on restrs. 2.443    133.463  0.120
NCV             1.947   3240.414  0.163
SWnormal        7.933    474.756  0.005
lagll           1.222 251980.356  0.269
lagdd           0.793 524976.243  0.373
                mnb    fst         v  pval    VIF
(Intercept)   0.725  0.508   115.325 0.477     NA
fydd          0.917 30.820  8813.768 0.000  2.526
fyll         -0.703  2.186   319.564 0.140  2.579
PCAP         -0.038  3.184   485.728 0.075  1.148
PCsize        0.554  4.505   302.706 0.035 23.844
PCsize2      -0.077  2.626   145.979 0.107 23.404
milk          0.404  3.404 52902.395 0.065  2.287
foodstress    0.207  2.841     5.068 0.152  1.103
eextwar      -0.031  7.907   157.152 0.006  1.124
bridewealth   0.194  1.501 53024.430 0.221  1.307
caststratLgd  0.704  4.702 71431.157 0.030  1.276
          1           2           3           4                         
      "68"        "47"        "13"        "40"       "168" "MoralGods"

NEW 8-21-2010

                    coef     Fstat         ddf     pvalue   VIF
(Intercept)   1.14674343  1.488425 37025.59617 0.22246871    NA
fydd          0.97488591 36.006517  9188.75453 0.00000000 2.476
fyll         -0.87618682  3.630261  8296.88730 0.05677246 2.536
PCAP         -0.03115765  2.226991   990.10286 0.13593631 1.129
PCsize2       0.01867493  2.630566   490.07043 0.10546748 1.444
milk          0.48387998  5.057598   989.78679 0.02473743 2.194
foodstress    0.30765460 11.100709   191.96143 0.00103512 1.086
eextwar      -0.03419596  9.414057    55.32246 0.00333123 1.106
bridewealth   0.30343475  3.929405  2132.90513 0.04757688 1.220
caststratLGD  0.79202346  5.978612  2117.91361 0.01456135 1.271
 R2:final model R2:IV(distance) R2:IV(language) 
      0.5073227       0.9942653       0.9860534 
                Fstat        df pvalue
RESET           0.710  1658.936  0.400
Wald on restrs. 1.966    43.984  0.168
NCV             1.986    21.853  0.173
SWnormal        6.997   790.541  0.008
lagll           1.150 20198.642  0.284
lagdd           0.706 16245.675  0.401
                mnb    fst         v  pval   VIF
(Intercept)   1.147  1.488 37025.596 0.222    NA
fydd          0.975 36.007  9188.755 0.000 2.476
fyll         -0.876  3.630  8296.887 0.057 2.536
PCAP         -0.031  2.227   990.103 0.136 1.129
PCsize2       0.019  2.631   490.070 0.105 1.444
milk          0.484  5.058   989.787 0.025 2.194
foodstress    0.308 11.101   191.961 0.001 1.086
eextwar      -0.034  9.414    55.322 0.003 1.106
bridewealth   0.303  3.929  2132.905 0.048 1.220
caststratLGD  0.792  5.979  2117.914 0.015 1.271
          1           2           3           4                         
      "68"        "47"        "13"        "40"       "168" "MoralGods"

NEW 8-20-2010

                    coef     Fstat          ddf     pvalue   VIF
(Intercept)   1.15361605  1.486169   1149.57401 0.22306188    NA
fydd          0.92095750 30.668862 941103.05398 0.00000003 2.446
fyll         -0.65300123  2.079139   6437.23811 0.14937302 2.298
PCAP         -0.03805422  3.184647   3487.97650 0.07441994 1.116
PCsize2       0.01664471  1.990232    668.16677 0.15878198 1.428
milk          0.55125102  6.154235    585.38678 0.01338964 2.177
foodstress    0.20514543  3.622114     11.41537 0.08252780 1.086
eextwar      -0.03031953  6.831126     65.61154 0.01109839 1.120
caststratLGD  0.80335569  5.817327   1383.26801 0.01599856 1.274
 R2:final model R2:IV(distance) R2:IV(language) 
      0.4706303       0.9939618       0.9850883 
                Fstat        df pvalue
RESET           0.236   182.981  0.628
Wald on restrs. 1.602    24.460  0.217
NCV             3.115   121.839  0.080
SWnormal        7.527  1106.014  0.006
lagll           1.486 29167.282  0.223
lagdd           0.921 46574.050  0.337
                mnb    fst          v  pval   VIF
(Intercept)   1.154  1.486   1149.574 0.223    NA
fydd          0.921 30.669 941103.054 0.000 2.446
fyll         -0.653  2.079   6437.238 0.149 2.298
PCAP         -0.038  3.185   3487.976 0.074 1.116
PCsize2       0.017  1.990    668.167 0.159 1.428
milk          0.551  6.154    585.387 0.013 2.177
foodstress    0.205  3.622     11.415 0.083 1.086
eextwar      -0.030  6.831     65.612 0.011 1.120
caststratLGD  0.803  5.817   1383.268 0.016 1.274
          1           2           3           4                         
      "68"        "47"        "13"        "40"       "168" "MoralGods"

OLD

                    coef     Fstat         ddf     pvalue   VIF
(Intercept)   0.89620986  1.237299   16619.133 0.26600841    NA
fydd          0.82398026 23.281107   63545.006 0.00000140 2.407
fyll         -0.67156843  2.102504    4742.668 0.14712423 2.245
milk          0.71089379 10.445801  224164.569 0.00122946 2.053
caststratLGD  0.64701190  3.542931    1553.995 0.05998641 1.219
money         0.07013825  1.988768 1522197.233 0.15847000 1.167
 R2:final model R2:IV(distance) R2:IV(language) 
      0.4232057       0.9937974       0.9854007
                Fstat          df pvalue
RESET           0.118 3678916.693  0.732
Wald on restrs. 1.477      16.014  0.242
NCV             3.836    1601.303  0.050
SWnormal        8.879  200171.840  0.003
lagll           1.209   35782.498  0.272
lagdd           0.753   50167.334  0.385
                mnb    fst           v  pval   VIF
(Intercept)   0.896  1.237   16619.133 0.266    NA
fydd          0.824 23.281   63545.006 0.000 2.407
fyll         -0.672  2.103    4742.668 0.147 2.245
milk          0.711 10.446  224164.569 0.001 2.053
caststratLGD  0.647  3.543    1553.995 0.060 1.219
money         0.070  1.989 1522197.233 0.158 1.167           1           2           3           4                         
      "68"        "47"        "13"        "40"       "168" "MoralGods"

AA| Map for v272 Caste stratification

dep_var
  1   2   3   4
153  18   3   7 
depvar<-sccs$v272-2
dep_var
 0   1   2    
18   3   7 
load("world_countries_24.rda",.GlobalEnv)
zdv<-which(!is.na(depvar))
dep_var<-depvar[zdv]
dep_var<-dep_var+1
table(dep_var)
depvarname<-"Caste stratification v272"
load("world_countries_24.rda",.GlobalEnv)
sccs=SCCS
splgt<-SpatialPointsDataFrame(coordinates(sccs[zdv,c("longitud","latitude")]),data.frame(dep_var)) 
brks<-quantile(dep_var,c(0,.333,.666,1))
cols<-colorRampPalette(c("yellow", "brown"))(length(brks)-1)
plot(world_countries,col="white") #black")
plot(splgt,pch=21,add=TRUE,cex=dep_var^.25,col="red", bg=cols[findInterval(dep_var, brks, all.inside=TRUE)])
mtext(depvarname,line=-2, side=1,cex=.5) #7)
splgt<-SpatialPointsDataFrame(coordinates(sccs[zdv,c("longitud","latitude")]),data.frame(dep_var)) 
brks<-quantile(dep_var,c(0,.333,.666,1))
cols<-colorRampPalette(c("yellow", "brown"))(length(brks)-1)
#jpeg(file="473-475mapValue_of_Boys.jpg",width=8,height=5,units="in",pointsize=8,res=600)
plot(world_countries,col="white") #black")
plot(splgt,pch=21,add=TRUE,cex=dep_var^.25,col="red", bg=cols[findInterval(dep_var, brks, all.inside=TRUE)])
mtext(depvarname,line=-2, side=1,cex=.5) #7)
# dev.off()

6A| PROBIT WORKING! Moral gods v238 EvilEye NOT DICHOTOMIZED MONEY v155 >1 >3 >4

Used Error messages for Eff and Dow 2009



#Program 1 --> Program 2 below
#Program 1 Part A
#MI--make the imputed datasets
#--change the following path to the directory with your data and program--
setwd("C:/My Documents/MI")
rm(list=ls(all=TRUE))
options(echo=TRUE)
#--you need the following two packages--you must install them first--
library(foreign)
library(mice)
library(tripack)
library(zoo)
library(sp)
library(maptools)
library(spam)
#--for program 2 below
library(spdep)
library(car)
library(lmtest)
library(sandwich)

#--To find the citation for a package, use this function:---
citation("mice")

#-----------------------------
#--Read in data, rearrange----
#-----------------------------

#--Read in auxiliary variables---
load("vaux.Rdata",.GlobalEnv)
row.names(vaux)<-NULL
#--Read in the SCCS dataset---
load("SCCS.Rdata",.GlobalEnv)

#--look at first 6 rows of vaux--
head(vaux)
#--look at field names of vaux--
names(vaux)
#--check to see that rows are properly aligned in the two datasets--
#--sum should equal 186---
sum((SCCS$socname==vaux$socname)*1)
#--remove the society name field--
vaux<-vaux[,-28]
names(vaux)

#--Two nominal variables: brg and rlg----
#--brg: consolidated Burton  Regions-----
#0 = (rest of world) circumpolar, South and Meso-America, west North America
#1 = Subsaharan Africa
#2 = Middle Old World
#3 = Southeast Asia, Insular Pacific, Sahul
#4 = Eastern Americas
#--rlg: Religion---
#'0 (no world religion)'  
#'1 (Christianity)'  
#'2 (Islam)'  
#'3 (Hindu/Buddhist)'  

#--check to see number of missing values in vaux, 
#--whether variables are numeric,
#--and number of discrete values for each variable---
vvn<-names(vaux)
pp<-NULL
for (i in 1:length(vvn)){
nmiss<-length(which(is.na(vaux[,vvn[i]])))
numeric<-is.numeric(vaux[,vvn[i]])
numDiscrVals<-length(table(vaux[,vvn[i]]))
pp<-rbind(pp,cbind(data.frame(numeric),nmiss,numDiscrVals))
}
row.names(pp)<-vvn
pp

#MODIFY THESE STATEMENTS FOR A NEW PROJECT
#--extract variables to be used from SCCS, put in dataframe fx--
fx<-data.frame(
socname=SCCS$socname,socID=SCCS$"sccs#",
PCvioHomi=SCCS$v1665,   ### PCvioHomi PCvioAslt PCvioIntr PCvioTotl
PCvioAslt=SCCS$v1666,
PCvioIntr=SCCS$v666,
#PCvioTotl=SCCS$v666+SCCS$v1666+SCCS$v1665,
extwar=SCCS$v892,
classtrat=SCCS$v270,
caststrat=SCCS$v272,
anim=SCCS$v206,
anim2=log(1+SCCS$v206),         #^2,
anim_log=log(1+SCCS$v206),
milk=(SCCS$v245>1)*1,
milkedanim=SCCS$v206*SCCS$v206,
bridewealth=(SCCS$v208==1)*1,
money=SCCS$v17,
money2=(SCCS$v155>1)*1+(SCCS$v155>3)*1+(SCCS$v155>4)*1,
extwar2=SCCS$v892^2,
caststratLGd=log(1+SCCS$v272),    #^2,
#moralgods=SCCS$v238,
#moralgods2=(SCCS$v238)^2,
PCsize=SCCS$v237,
PCAP=SCCS$v921,
PCsize2=(SCCS$v237)^2, 
eextwar=SCCS$v1650,
valchild=(SCCS$v473+SCCS$v474+SCCS$v475+SCCS$v476),
fratgrpstr=SCCS$v570,
marrcaptives=SCCS$v870,
plunder=SCCS$v912, ##2009 depvars
pre_mar_sex=SCCS$v167, foodstress=SCCS$v678,
femctrldwellg=SCCS$v591,
wealthy=SCCS$v1721,
poor=SCCS$v1723,
war679=SCCS$v679,
###climate<-(SCCS$v857==1 | SCCS$v857==2 | SCCS$v857==6)*1+(SCCS$v857==3 | SCCS$v857==4)*2+(SCCS$v857==5)*3,
nonmatrel=SCCS$v52,
lrgfam=SCCS$v68,
exogamy=SCCS$v72,
famsize=SCCS$v80,
popdens=SCCS$v156,
malesexag=SCCS$v175,
ndrymonth=SCCS$v196,
gath=SCCS$v203,
hunt=SCCS$v204,
fish=SCCS$v205,
nuclearfam=(SCCS$v210<=3)*1,
ncmallow=SCCS$v227,
cultints=SCCS$v232,
tree=(SCCS$v233==4)*1,
roots=(SCCS$v233==5)*1,
cereals=(SCCS$v233==6)*1,
settype=SCCS$v234,
localjh=(SCCS$v236-1),
#superjh=SCCS$v237,
segadlboys=SCCS$v242,
plow=(SCCS$v243>1)*1,
pigs=(SCCS$v244==2)*1,
bovines=(SCCS$v244==7)*1,
agrlateboy=SCCS$v300,
fempower=SCCS$v663,
migr=(SCCS$v677==2)*1,
foodtrade=SCCS$v819,
dateobs=SCCS$v838,
rain=SCCS$v854,
temp=SCCS$v855,
ecorich=SCCS$v857,
pctFemPolyg=SCCS$v872,
femsubs=SCCS$v890,
himilexp=(SCCS$v899==1)*1,
AP1=SCCS$v921,
AP2=SCCS$v928,
pathstress=SCCS$v1260,
war=SCCS$v1648,
foodscarc=SCCS$v1685,
sexratio=1+(SCCS$v1689>85)+(SCCS$v1689>115),
wagelabor=SCCS$v1732,
CVrain=SCCS$v1914/SCCS$v1913
) 
source("C:/My Documents/MI/renormalize.R")
#SCCS = normalize_data(SCCS)
fx = normalize_data(fx)
#Verify fx works. The finish running the rest of the script.
After that SCCS is no longer used except in the eff_dow2 script where it is

loaded to define dep_var. If you need to normalize dep_var you can add the following line after dep_var is defined in the eff_dow 2 script:

#dep_var = normalize_probit(dep_var)
#Delete:
#new_sccs = SCCS
#save(new_sccs,file="new_sccs.Rdata")


#--look at first 6 rows of fx--
head(fx)

#--check to see number of missing values--
#--also check whether numeric--
vvn<-names(fx)
pp<-NULL
for (i in 1:length(vvn)){
nmiss<-length(which(is.na(fx[,vvn[i]])))
numeric<-is.numeric(fx[,vvn[i]])
pp<-rbind(pp,cbind(nmiss,data.frame(numeric)))
}
row.names(pp)<-vvn
pp

#--identify variables with missing values--
z<-which(pp[,1]>0)
zv1<-vvn[z]
zv1
#--identify variables with non-missing values--
z<-which(pp[,1]==0)
zv2<-vvn[z]
zv2
  



#Program 1 Part B
#-----------------------------
#----Multiple imputation------
#-----------------------------

#--number of imputed data sets to create--
#nimp<-10 #CHANGED TO TEST SPEEDUP  
nimp<-3  ################################################################## speedup test
#--one at a time, loop through those variables with missing values--
for (i in 1:length(zv1)){
#--attach the imputand to the auxiliary data--
zxx<-data.frame(cbind(vaux,fx[,zv1[i]]))
#--in the following line, the imputation is done--
aqq<-complete(mice(zxx,maxit=20,m=nimp),action="long")
###aqq<-complete(mice(zxx,maxit=100,m=nimp),action="long")
#--during first iteration of the loop, create dataframe impdat--
if (i==1){
impdat<-data.frame(aqq[,c(".id",".imp")])
}
#--the imputand is placed as a field in impdat and named--
impdat<-cbind(impdat,data.frame(aqq[,NCOL(zxx)]))
names(impdat)[NCOL(impdat)]<-zv1[i]
}

#--now the non-missing variables are attached to impdat--
gg<-NULL
for (i in 1:nimp){
gg<-rbind(gg,data.frame(fx[,zv2]))
}
impdat<-cbind(impdat,gg)

#--take a look at the top 6 and bottom 6 rows of impdat--
head(impdat)
tail(impdat)

#--impdat is saved as an R-format data file--
save(impdat,file="impdat.Rdata")


 
 

#Program 2 (12-18-2009)==
#MI--estimate model, combine results

rm(list=ls(all=TRUE))
#--Set path to your directory with data and program--
setwd("C:/My Documents/MI")
options(echo=TRUE)

#--need these packages for estimation and diagnostics--
library(foreign)
library(spdep)
library(car)
library(lmtest)
library(sandwich)

#-----------------------------
#--Read in data, rearrange----
#-----------------------------

#--Read in original SCCS data---
#load("SCCS.Rdata",.GlobalEnv)
load("new_sccs.Rdata",.GlobalEnv)
SCCS=new_sccs


#--Read in two weight matrices--
ll<-as.matrix(read.dta("langwm.dta")[,-1])
dd<-as.matrix(read.dta("dist25wm.dta")[,c(-1,-2,-189)])
#--Read in the imputed dataset---
load("impdat.Rdata",.GlobalEnv)

#--create dep.varb. you wish to use from SCCS data--
#--Here we sum variables measuring how much a society values children--
#depvar<-apply(SCCS[,c("v473","v474","v475","v476")],1,sum) #can replace "sum" with "max"
#depvar<-SCCS$v1188    #v1188+SCCS$v1189
depvar<-SCCS$v238
#--find obs. for which dep. varb. is non-missing--
zdv<-which(!is.na(depvar))
depvar<-depvar[zdv]
source("C:/My Documents/MI/normalize_probit.R")
depvar = normalize_probit(depvar)
#HERE GIVE THE "NAME" OF THE DEPENDENT VARIABLE THAT IS COMPUTED
depvarname<-"MoralGods"
#--can add additional SCCS variable, but only if it has no missing values---
dateobs<-SCCS$v838
dateobs<-dateobs[zdv]

#--look at histogram and frequencies for the dep. varb.--
hist(depvar)
table(depvar)

#--modify weight matrices---
#--set diagonal equal to zeros--
diag(ll)<-0
diag(dd)<-0
#--use only obs. where dep. varb. non-missing--
ll<-ll[zdv,zdv]
dd<-dd[zdv,zdv]
#--row standardize (rows sum to one)
ll<-ll/rowSums(ll)
dd<-dd/rowSums(dd)
#--check to see that rows sum to one
rowSums(ll)
rowSums(dd)
#--make weight matrix object for later autocorrelation test--
wmatll<-mat2listw(as.matrix(ll))
wmatdd<-mat2listw(as.matrix(dd))

#"moralgods","moralgods2",
indpv<-c("pre_mar_sex", "money", "foodstress", "femctrldwellg",
"wealthy","poor","PCvioHomi","PCvioAslt","PCvioIntr",#"PCvioTotl",
"milkedanim","pctFemPolyg",
"anim2","money2","bridewealth","caststratLGd",
#","classtrat "PCAP",
"PCsize",
"PCsize2",
#"caststrat","eextwar", 
"femsubs","foodscarc",
"fratgrpstr","marrcaptives","plunder",###"climate",
"exogamy","ncmallow",#"superjh",
"fempower","sexratio",
"war","himilexp","wagelabor",
"famsize","settype","localjh",
"cultints","roots","cereals","gath","hunt","fish",
"anim","pigs","milk","plow","bovines","tree","foodtrade",
"ndrymonth","ecorich",
"popdens","pathstress","CVrain","rain","temp","AP1","AP2")


#-----------------------------------------------------
#---Estimate model on each imputed dataset------------
#-----------------------------------------------------

#--number of imputed datasets--
#nimp<-10
nimp<-3  ################################################################## speedup test

#--will append values to these empty objects--
vif<-NULL
ss<-NULL
beta<-NULL
dng<-NULL

#--loop through the imputed datasets--
for (i in 1:nimp){

#--select the ith imputed dataset--
m9<-impdat[which(impdat$.imp==i),]
#--retain only obs. for which dep. varb. is nonmissing--
m9<-m9[zdv,]

#--create spatially lagged dep. varbs.--
y<-as.matrix(depvar)
xx<-as.matrix(m9[,indpv])
#--for instruments we use the spatial lag of our indep. varbs.--
#--First, the spatially lagged varb. for distance--
xdy<-dd%*%xx
cyd<-dd%*%y
o<-lm(cyd~xdy)
#--the fitted value is our instrumental variable--
fydd<-fitted(o)
#--keep R2 from this regression--
dr2<-summary(o)$r.squared
#--Then, the spatially lagged varb. for language--
xly<-ll%*%xx   
cyl<-ll%*%y
o<-lm(cyl~xly)
#--the fitted value is our instrumental variable--
fyll<-fitted(o)
#--keep R2 from this regression--
lr2<-summary(o)$r.squared
m9<-cbind(m9,fydd,fyll)

#--OLS estimate of unrestricted model--
xUR<-lm(depvar~fyll+fydd+
PCvioHomi+PCvioAslt+PCvioIntr+
milkedanim+pctFemPolyg+
#anim2+
caststratLGd+money2+bridewealth+
##moralgods+moralgods2+  ##classtrat+
PCAP+
PCsize+
PCsize2+
caststrat+eextwar+
pre_mar_sex+money+foodstress+femctrldwellg+
poor+wealthy+
fratgrpstr+marrcaptives+plunder+###climate+
cultints+roots+cereals+gath+plow+
hunt+fish+
#anim+
pigs+milk+bovines+tree+foodtrade+foodscarc+
ecorich+popdens+pathstress+exogamy+ncmallow+famsize+
settype+localjh+
fempower+femsubs+ #superjh+
sexratio+war+himilexp+money+wagelabor
,data=m9)


xR<-lm(depvar~fydd+fyll+
#PCvioHomi+PCvioAslt+
#milkedanim+ ##pctFemPolyg+
PCAP+
PCsize+
#PCsize2+    NA for some reason
milk+
foodstress+
eextwar+ 
bridewealth+
caststratLGd+
PCvioIntr
#anim2+
#money2+
##moralgods+moralgods2+  
#classtrat+##extwar+
#pre_mar_sex+money+
#femctrldwellg+
#poor+wealthy+
#fratgrpstr+
#marrcaptives+plunder+###climate+
#cultints+roots+cereals+gath+
#plow+
#hunt+fish+
#anim+
#pigs+milk+bovines+tree+foodtrade+foodscarc+
#ecorich+popdens+pathstress+exogamy+ncmallow+famsize+
#settype+localjh+
#fempower+femsubs+ #superjh+
#sexratio+war+
#himilexp #+money+wagelabor
,data=m9)


#--corrected sigma2 and R2 for 2SLS--
qxx<-m9
qxx[,"fydd"]<-cyd
qxx[,"fyll"]<-cyl
b<-coef(xR)
incpt<-matrix(1,NROW(qxx),1)
x<-as.matrix(cbind(incpt,qxx[,names(b)[-1]]))
e<-y-x%*%as.matrix(b)
cs2<-as.numeric(t(e)%*%e/(NROW(x)-NCOL(x)))
cr2<-as.numeric(1-t(e)%*%e/sum((y-mean(y))^2))

#--collect coefficients and their variances--
ov<-summary(xR)
vif<-rbind(vif,vif(xR))
ss<-rbind(ss,diag(ov$cov*cs2))
#--collect robust coef. variances when there is heteroskedasticity--
#eb<-e^2
#x<-as.matrix(cbind(incpt,m9[,names(b)[-1]]))
#hcm<-inv(t(x)%*%x)%*%t(x)%*%diag(eb[1:length(eb)])%*%x%*%inv(t(x)%*%x)
#ss<-rbind(ss,diag(hcm))
beta<-rbind(beta,coef(xR))

#"moralgods","
#"superjh",
#--collect some model diagnostics--
dropt<-c("cereals","gath","plow","hunt",#"anim",
"pigs","milk","bovines","foodscarc","ecorich",
"popdens","pathstress","ncmallow","famsize","localjh",
"fempower","sexratio","money",
"wagelabor","war","himilexp","tree")


#--Ramsey RESET test--
p1<-qchisq(resettest(xR,type="fitted")$"p.value",1,lower.tail=FALSE)
#--Wald test (H0: dropped variables have coefficient equal zero)--
o<-linear.hypothesis(xUR,dropt,test="Chisq")$"Pr(>Chisq)"[2]
p2<-qchisq(o,1,lower.tail=FALSE) #find Chisq with 1 d.f. and same pvalue
#--Heteroskedasticity test (H0: homoskedastic residuals)--
p3<-ncv.test(xR)$ChiSquare
#--Shapiro-Wilke normality test (H0: residuals normal)
p4<-qchisq(shapiro.test(residuals(xR))$p.value,1,lower.tail=FALSE)
#--LaGrange Multiplier test for spatial autocorrelation: language--
o<-lm.LMtests(xR, wmatll, test=c("LMlag"))
p5<-as.numeric(o$LMlag$statistic)
#--LaGrange Multiplier test for spatial autocorrelation: distance--
o<-lm.LMtests(xR, wmatdd, test=c("LMlag"))
p6<-as.numeric(o$LMlag$statistic)
#--model R2--
p7<-cr2
dng<-rbind(dng,cbind(p1,p2,p3,p4,p5,p6,p7,dr2,lr2))

}


#--------------------------------------------
#--Rubin's formulas for combining estimates--
#--------------------------------------------

#--first find final regr. coefs. and p-values--
mnb<-apply(beta,2,mean)
####################vrb<-colSums((beta-t(matrix(mnb,length(mnb),10)))^2)/(nimp-1)
vrb<-colSums((beta-t(matrix(mnb,length(mnb),nimp)))^2)/(nimp-1)
mnv<-apply(ss,2,mean)
vrT<-mnv+vrb*(1-nimp^(-1))
fst<-mnb^2/vrT
r<-(1+nimp^(-1))*vrb/mnv
v<-(nimp-1)*(1+r^(-1))^2
pval<-pf(fst,1,v,lower.tail=FALSE)
bbb<-data.frame(round(cbind(mnb,fst,v,pval),8)) #,3 changed to .8 for significance test
bbb$VIF[2:NROW(bbb)]<-round(apply(vif,2,mean),3)
names(bbb)<-c("coef","Fstat","ddf","pvalue","VIF")

#--Then combine the diagnostics we collected--
dng<-data.frame(dng)
names(dng)<-c("RESET","Wald on restrs.","NCV","SWnormal","lagll","lagdd",
"R2:final model","R2:IV(distance)","R2:IV(language)")
r2<-apply(dng[,7:9],2,mean)
adng<-dng[,1:6]
mdm<-apply(adng,2,mean)
vrd<-colSums((adng-t(matrix(mdm,length(mdm),nimp)))^2)/(nimp-1)
aa<-4*mdm^2-2*vrd
aa[which(aa<0)]<-0
rd<-(1+nimp^(-1))*vrd/(2*mdm+aa^.5)
vd<-(nimp-1)*(1+rd^(-1))^2
Dm<-(mdm-(nimp-1)/(nimp+1)*rd)/(1+rd)
#-All chi-sq we collected have df=1-------
pvald<-pf(Dm,1,vd,lower.tail=FALSE)
ccc<-data.frame(round(cbind(Dm,vd,pvald),3))
names(ccc)<-c("Fstat","df","pvalue")

#--write results to csv file for perusal in spreadsheet--
write.csv("==OLS model for depvar==",file="OLSresults.csv",append=FALSE)
write.csv(bbb,file="OLSresults.csv",append=TRUE)
write.csv(r2,file="OLSresults.csv",append=TRUE)
write.csv(ccc,file="OLSresults.csv",append=TRUE)

aaa<-c(table(depvar), NROW(depvar),depvarname)
imp<-"number of imputations nimp="
impute=c(imp,nimp)

bbb
r2
ccc
bbb<-data.frame(round(cbind(mnb,fst,v,pval),3)) #.8 changed to back to .3 for significance test
bbb$VIF[2:NROW(bbb)]<-round(apply(vif,2,mean),3)
bbb
aaa
impute
load("world_countries_24.rda",.GlobalEnv)
zdv<-which(!is.na(depvar))
dep_var<-depvar[zdv]
dep_var<-dep_var+1
table(dep_var)
depvarname<-"Moral gos v238"
load("world_countries_24.rda",.GlobalEnv)
sccs=SCCS
splgt<-SpatialPointsDataFrame(coordinates(sccs[zdv,c("longitud","latitude")]),data.frame(dep_var)) 
brks<-quantile(dep_var,c(0,.333,.666,1))
cols<-colorRampPalette(c("yellow", "brown"))(length(brks)-1)
plot(world_countries,col="white") #black")
plot(splgt,pch=21,add=TRUE,cex=dep_var^.25,col="red", bg=cols[findInterval(dep_var, brks, all.inside=TRUE)])
mtext(depvarname,line=-2, side=1,cex=.5) #7)
splgt<-SpatialPointsDataFrame(coordinates(sccs[zdv,c("longitud","latitude")]),data.frame(dep_var)) 
brks<-quantile(dep_var,c(0,.333,.666,1))
cols<-colorRampPalette(c("yellow", "brown"))(length(brks)-1)
#jpeg(file="473-475mapValue_of_Boys.jpg",width=8,height=5,units="in",pointsize=8,res=600)
plot(world_countries,col="white") #black")
plot(splgt,pch=21,add=TRUE,cex=dep_var^.25,col="red", bg=cols[findInterval(dep_var, brks, all.inside=TRUE)])
mtext(depvarname,line=-2, side=1,cex=.5) #7)
# dev.off()

B| Results that match and extend Brown and Eff 2010

EARLY PROBIT

                    coef     Fstat         ddf     pvalue   VIF
(Intercept)   1.33731158  2.949449   329.94838 0.08684514    NA
fydd          0.94170271 29.471148 64522.33575 0.00000006 2.591
fyll         -0.81914353  2.769871   297.68513 0.09710609 2.567
PCAP         -0.08484246  2.784208 30933.53405 0.09520784 1.156
PCsize2       0.17837998  7.076476  3121.51185 0.00785019 1.498
milk          0.24906800  2.658276   488.15209 0.10365734 2.255
foodstress    0.14906788  6.203431   131.39183 0.01399711 1.088
eextwar      -0.18747198  7.049675    10.03962 0.02402475 1.142
bridewealth   0.15540818  2.117861 26202.75667 0.14560177 1.236
caststratLGd  0.17293001  4.449971  2126.70834 0.03501842 1.345
 R2:final model R2:IV(distance) R2:IV(language) 
      0.4740704       0.9927359       0.9825687 
                Fstat         df pvalue
RESET           0.126     11.932  0.729
Wald on restrs. 1.286    552.037  0.257
NCV             0.034   1266.650  0.854
SWnormal        1.313    193.325  0.253
lagll           1.328 254731.243  0.249
lagdd           0.651  10435.852  0.420
                mnb    fst         v  pval   VIF
(Intercept)   1.337  2.949   329.948 0.087    NA
fydd          0.942 29.471 64522.336 0.000 2.591
fyll         -0.819  2.770   297.685 0.097 2.567
PCAP         -0.085  2.784 30933.534 0.095 1.156
PCsize2       0.178  7.076  3121.512 0.008 1.498
milk          0.249  2.658   488.152 0.104 2.255
foodstress    0.149  6.203   131.392 0.014 1.088
eextwar      -0.187  7.050    10.040 0.024 1.142
bridewealth   0.155  2.118 26202.757 0.146 1.236
caststratLGd  0.173  4.450  2126.708 0.035 1.345
               1 1.94528449032504 2.42556380146184 3.01290798369147 
            "68"             "47"             "13"             "40"      "168"      "MoralGods"

NO PROBIT

                  coef       Fstat          ddf     pvalue    VIF
(Intercept) -0.2038055  0.04861978 1.395108e+04 0.82548583     NA
fyll        -0.5497749  1.48746192 2.595532e+04 0.22262176  2.345
fydd         1.0094900 43.40723670 6.049636e+03 0.00000000  2.109
milkedanim   1.1864446 11.83637284 4.970119e+07 0.00058085 19.206
anim2       -1.1309092  6.42567444 8.180828e+04 0.01125007 20.023
PCAP        -0.1386346  3.45931184 4.373752e+04 0.06290319  1.141
PCsize2      0.2147070  5.29435638 7.582095e+02 0.02166511  1.477
eextwar     -0.1846330  4.24324822 1.644602e+03 0.03956375  1.110
foodstress   0.2347272  6.52836249 3.812567e+02 0.01100427  1.070
 R2:final model R2:IV(distance) R2:IV(language) 
      0.4831835       0.9938452       0.9858827 
                Fstat          df pvalue
RESET           2.220    4333.753  0.136
Wald on restrs. 2.969     432.544  0.086
NCV             0.412 1761388.798  0.521
SWnormal        7.129     317.121  0.008
lagll           0.924    5006.895  0.336
lagdd           0.652    3754.148  0.419
               mnb    fst            v  pval    VIF
(Intercept) -0.204  0.049    13951.075 0.825     NA
fyll        -0.550  1.487    25955.325 0.223  2.345
fydd         1.009 43.407     6049.636 0.000  2.109
milkedanim   1.186 11.836 49701187.170 0.001 19.206
anim2       -1.131  6.426    81808.285 0.011 20.023
PCAP        -0.139  3.459    43737.516 0.063  1.141
PCsize2      0.215  5.294      758.209 0.022  1.477
eextwar     -0.185  4.243     1644.602 0.040  1.110
foodstress   0.235  6.528      381.257 0.011  1.070
         1           2           3           4                         
      "68"        "47"        "13"        "40"       "168" "MoralGods"

ALMOST FINAL PROBIT

                   coef     Fstat          ddf     pvalue   VIF
(Intercept)  1.07618277  1.922186 4.492039e+03 0.16568472    NA
fyll        -0.47062814  1.026070 1.929135e+05 0.31108476 2.278
fydd         0.88101778 24.733080 1.952963e+03 0.00000072 2.547
milk         0.34393090  5.258866 1.097830e+04 0.02185405 2.132
PCAP        -0.09662422  3.558749 4.624715e+05 0.05923300 1.124
PCsize2      0.21188369  9.807551 5.273336e+06 0.00173798 1.474
eextwar     -0.18964426  9.048470 1.252189e+02 0.00317883 1.129
foodstress   0.13466647  4.796900 8.083973e+01 0.03139237 1.073
 R2:final model R2:IV(distance) R2:IV(language) 
      0.4423467       0.9928599       0.9826200 
                Fstat         df pvalue
RESET           0.287    405.316  0.593
Wald on restrs. 1.958     93.410  0.165
NCV             2.133   2290.866  0.144
SWnormal        1.201   1790.917  0.273
lagll           1.228 107680.937  0.268
lagdd           0.809  23076.261  0.368
               mnb    fst           v  pval   VIF
(Intercept)  1.076  1.922    4492.039 0.166    NA
fyll        -0.471  1.026  192913.475 0.311 2.278
fydd         0.881 24.733    1952.963 0.000 2.547
milk         0.344  5.259   10978.299 0.022 2.132
PCAP        -0.097  3.559  462471.547 0.059 1.124
PCsize2      0.212  9.808 5273335.565 0.002 1.474
eextwar     -0.190  9.048     125.219 0.003 1.129
foodstress   0.135  4.797      80.840 0.031 1.073 
                      "MoralGods" 
 1 1.94528449032504 2.42556380146184 3.01290798369147                  
"68"             "47"             "13"             "40"            "168"
                   coef       Fstat          ddf     pvalue    VIF
(Intercept) -0.06521588  0.00640785 9.850587e+02 0.93621452     NA
fyll        -0.46733193  0.95494370 1.865332e+03 0.32859082  2.395
fydd         0.91835610 31.33101551 2.991258e+07 0.00000002  2.236
PCvioIntr   -0.20820868  2.89784204 1.403562e+01 0.11073251  1.175
milkedanim   0.75938143  9.77147872 1.870075e+03 0.00179964 19.333
pctFemPolyg  0.11731447  3.19928497 8.966026e+00 0.10742558  1.169
anim2       -0.70792033  5.10124338 2.467559e+03 0.02399567 20.139
PCAP        -0.09496625  3.37065952 1.817741e+05 0.06636881  1.135
PCsize2      0.16251259  5.94303057 4.604671e+01 0.01869454  1.412
foodstress   0.16278534  6.24386703 2.062467e+02 0.01324295  1.094
 R2:final model R2:IV(distance) R2:IV(language) 
      0.4528545       0.9934533       0.9834687 
                Fstat       df pvalue
RESET           0.447   64.516  0.506
Wald on restrs. 2.653  776.322  0.104
NCV             0.077 4319.834  0.781
SWnormal        0.527   41.304  0.472
lagll           1.077 2508.501  0.299
lagdd           0.937  960.923  0.333
               mnb    fst            v  pval    VIF
(Intercept) -0.065  0.006      985.059 0.936     NA
fyll        -0.467  0.955     1865.332 0.329  2.395
fydd         0.918 31.331 29912582.152 0.000  2.236
PCvioIntr   -0.208  2.898       14.036 0.111  1.175
milkedanim   0.759  9.771     1870.075 0.002 19.333
pctFemPolyg  0.117  3.199        8.966 0.107  1.169
anim2       -0.708  5.101     2467.559 0.024 20.139
PCAP        -0.095  3.371   181774.089 0.066  1.135
PCsize2      0.163  5.943       46.047 0.019  1.412
foodstress   0.163  6.244      206.247 0.013  1.094
               1 1.94528449032504 2.42556380146184 3.01290798369147                  
            "68"             "47"             "13"             "40"            "168"  "MoralGods"

FINAL PROBIT

                    coef     Fstat          ddf     pvalue   VIF
 R2:final model R2:IV(distance) R2:IV(language) 
      0.4832798       0.9929023       0.9843283 
                 Fstat        df pvalue
RESET            0.116 36826.210  0.733
Wald on restrs.  1.900    45.440  0.175
NCV             -0.354     2.743  1.000
SWnormal         0.758   110.046  0.386
lagll            1.041   326.926  0.308
lagdd            0.695  3176.525  0.404
                mnb    fst            v  pval   VIF
(Intercept)   2.010  6.004      240.458 0.015    NA
fydd          0.930 27.782   307646.900 0.00000014 2.680
fyll         -0.972  3.885      249.420 0.050 2.565
PCAP         -0.104  4.160 28342539.703 0.041 1.156
PCsize        0.180  7.209     2228.578 0.007 1.494
milk          0.274  3.185     1093.394 0.075 2.295
foodstress    0.122  3.498       12.659 0.085 1.103
eextwar      -0.180  8.772      993.273 0.003 1.166
bridewealth   0.209  3.463      198.945 0.064 1.304
caststratLGd  0.156  3.570   296105.617 0.059 1.364
PCvioIntr    -0.164  2.329      245.435 0.128 1.171
dep_var   "168"      "MoralGods" 
               2 2.94528449032504 3.42556380146184 4.01290798369147 
              68               47               13               40

8A| Moral gods v238 EvilEye NOT DICHOTOMIZED MONEY v155 >1 >3 >4

#Program 1 --> Program 2 below
#Program 1 Part A
#MI--make the imputed datasets
#--change the following path to the directory with your data and program--
setwd("C:/My Documents/MI")
rm(list=ls(all=TRUE))
options(echo=TRUE)
#--you need the following two packages--you must install them first--
library(foreign)
library(mice)
library(tripack)
library(zoo)
library(sp)
library(maptools)
library(spam)
#--for program 2 below
library(spdep)
library(car)
library(lmtest)
library(sandwich)

#--To find the citation for a package, use this function:---
citation("mice")

#-----------------------------
#--Read in data, rearrange----
#-----------------------------

#--Read in auxiliary variables---
load("vaux.Rdata",.GlobalEnv)
row.names(vaux)<-NULL
#--Read in the SCCS dataset---
load("SCCS.Rdata",.GlobalEnv)
#--look at first 6 rows of vaux--
head(vaux)
#--look at field names of vaux--
names(vaux)
#--check to see that rows are properly aligned in the two datasets--
#--sum should equal 186---
sum((SCCS$socname==vaux$socname)*1)
#--remove the society name field--
vaux<-vaux[,-28]
names(vaux)

#--Two nominal variables: brg and rlg----
#--brg: consolidated Burton  Regions-----
#0 = (rest of world) circumpolar, South and Meso-America, west North America
#1 = Subsaharan Africa
#2 = Middle Old World
#3 = Southeast Asia, Insular Pacific, Sahul
#4 = Eastern Americas
#--rlg: Religion---
#'0 (no world religion)'  
#'1 (Christianity)'  
#'2 (Islam)'  
#'3 (Hindu/Buddhist)'  

#--check to see number of missing values in vaux, 
#--whether variables are numeric,
#--and number of discrete values for each variable---
vvn<-names(vaux)
pp<-NULL
for (i in 1:length(vvn)){
nmiss<-length(which(is.na(vaux[,vvn[i]])))
numeric<-is.numeric(vaux[,vvn[i]])
numDiscrVals<-length(table(vaux[,vvn[i]]))
pp<-rbind(pp,cbind(data.frame(numeric),nmiss,numDiscrVals))
}
row.names(pp)<-vvn
pp

#MODIFY THESE STATEMENTS FOR A NEW PROJECT
#--extract variables to be used from SCCS, put in dataframe fx--
fx<-data.frame(
socname=SCCS$socname,socID=SCCS$"sccs#",
islamic=(SCCS$v2002==3)*1+2*(SCCS$v2002==1)*1,
xian=(SCCS$v2002==4)*1+2*(SCCS$v2002==2)*1,
#PCAP PCsize PCsize2 caststrat eextwar
PCvioHomi=SCCS$v1665,   ### PCvioHomi PCvioAslt PCvioIntr PCvioTotl
PCvioAslt=SCCS$v1666,
PCvioIntr=SCCS$v666,
#PCvioTotl=SCCS$v666+SCCS$v1666+SCCS$v1665,
extwar=SCCS$v892,
classtrat=SCCS$v270,
caststrat=SCCS$v272,
anim=SCCS$v206,
anim_log=log(1+SCCS$v206),
milk=(SCCS$v245>1)*1,
milkedanim=SCCS$v206*SCCS$v206,
bridewealth=(SCCS$v208==1)*1,
money=SCCS$v17,
money2=(SCCS$v155>1)*1+(SCCS$v155>3)*1+(SCCS$v155>4)*1,
extwar2=SCCS$v892^2,
caststratLGD=log(1+SCCS$v272),    #^2,
anim=SCCS$v206,
anim2=log(1+SCCS$v206),         #^2,
#moralgods=SCCS$v238,
#moralgods2=(SCCS$v238)^2,
PCsize=SCCS$v237,
PCAP=SCCS$v921,
PCsize2=SCCS$v237^2, eextwar=SCCS$v1650,
valchild=(SCCS$v473+SCCS$v474+SCCS$v475+SCCS$v476),
fratgrpstr=SCCS$v570,
marrcaptives=SCCS$v870,
plunder=SCCS$v912, ##2009 depvars
pre_mar_sex=SCCS$v167, foodstress=SCCS$v678,
femctrldwellg=SCCS$v591,
wealthy=SCCS$v1721,
poor=SCCS$v1723,
war679=SCCS$v679,
###climate<-(SCCS$v857==1 | SCCS$v857==2 | SCCS$v857==6)*1+(SCCS$v857==3 | SCCS$v857==4)*2+(SCCS$v857==5)*3,
nonmatrel=SCCS$v52,
lrgfam=SCCS$v68,
exogamy=SCCS$v72,
famsize=SCCS$v80,
popdens=SCCS$v156,
malesexag=SCCS$v175,
ndrymonth=SCCS$v196,
gath=SCCS$v203,
hunt=SCCS$v204,
fish=SCCS$v205,
anim=SCCS$v206,
nuclearfam=(SCCS$v210<=3)*1,
ncmallow=SCCS$v227,
cultints=SCCS$v232,
tree=(SCCS$v233==4)*1,
roots=(SCCS$v233==5)*1,
cereals=(SCCS$v233==6)*1,
settype=SCCS$v234,
localjh=(SCCS$v236-1),
superjh=SCCS$v237,
segadlboys=SCCS$v242,
plow=(SCCS$v243>1)*1,
pigs=(SCCS$v244==2)*1,
bovines=(SCCS$v244==7)*1,
agrlateboy=SCCS$v300,
fempower=SCCS$v663,
migr=(SCCS$v677==2)*1,
foodtrade=SCCS$v819,
dateobs=SCCS$v838,
rain=SCCS$v854,
temp=SCCS$v855,
ecorich=SCCS$v857,
pctFemPolyg=SCCS$v872,
femsubs=SCCS$v890,
himilexp=(SCCS$v899==1)*1,
AP1=SCCS$v921,
AP2=SCCS$v928,
pathstress=SCCS$v1260,
war=SCCS$v1648,
foodscarc=SCCS$v1685,
sexratio=1+(SCCS$v1689>85)+(SCCS$v1689>115),
wagelabor=SCCS$v1732,
CVrain=SCCS$v1914/SCCS$v1913
) 

#--look at first 6 rows of fx--
head(fx)

#--check to see number of missing values--
#--also check whether numeric--
vvn<-names(fx)
pp<-NULL
for (i in 1:length(vvn)){
nmiss<-length(which(is.na(fx[,vvn[i]])))
numeric<-is.numeric(fx[,vvn[i]])
pp<-rbind(pp,cbind(nmiss,data.frame(numeric)))
}
row.names(pp)<-vvn
pp

#--identify variables with missing values--
z<-which(pp[,1]>0)
zv1<-vvn[z]
zv1
#--identify variables with non-missing values--
z<-which(pp[,1]==0)
zv2<-vvn[z]
zv2
  



#Program 1 Part B
#-----------------------------
#----Multiple imputation------
#-----------------------------

#--number of imputed data sets to create--
#nimp<-10 #CHANGED TO TEST SPEEDUP  
nimp<-3  ################################################################## speedup test
#--one at a time, loop through those variables with missing values--
for (i in 1:length(zv1)){
#--attach the imputand to the auxiliary data--
zxx<-data.frame(cbind(vaux,fx[,zv1[i]]))
#--in the following line, the imputation is done--
aqq<-complete(mice(zxx,maxit=20,m=nimp),action="long")
###aqq<-complete(mice(zxx,maxit=100,m=nimp),action="long")
#--during first iteration of the loop, create dataframe impdat--
if (i==1){
impdat<-data.frame(aqq[,c(".id",".imp")])
}
#--the imputand is placed as a field in impdat and named--
impdat<-cbind(impdat,data.frame(aqq[,NCOL(zxx)]))
names(impdat)[NCOL(impdat)]<-zv1[i]
}

#--now the non-missing variables are attached to impdat--
gg<-NULL
for (i in 1:nimp){
gg<-rbind(gg,data.frame(fx[,zv2]))
}
impdat<-cbind(impdat,gg)

#--take a look at the top 6 and bottom 6 rows of impdat--
head(impdat)
tail(impdat)

#--impdat is saved as an R-format data file--
save(impdat,file="impdat.Rdata")


 
 

#Program 2 (12-18-2009)==
#MI--estimate model, combine results

rm(list=ls(all=TRUE))
#--Set path to your directory with data and program--
setwd("C:/My Documents/MI")
options(echo=TRUE)

#--need these packages for estimation and diagnostics--
library(foreign)
library(spdep)
library(car)
library(lmtest)
library(sandwich)

#-----------------------------
#--Read in data, rearrange----
#-----------------------------

#--Read in original SCCS data---
load("SCCS.Rdata",.GlobalEnv)
#--Read in two weight matrices--
ll<-as.matrix(read.dta("langwm.dta")[,-1])
dd<-as.matrix(read.dta("dist25wm.dta")[,c(-1,-2,-189)])
#--Read in the imputed dataset---
load("impdat.Rdata",.GlobalEnv)

#--create dep.varb. you wish to use from SCCS data--
#--Here we sum variables measuring how much a society values children--
#depvar<-apply(SCCS[,c("v473","v474","v475","v476")],1,sum) #can replace "sum" with "max"
#depvar<-SCCS$v1188    #v1188+SCCS$v1189
depvar<-SCCS$v238
#--find obs. for which dep. varb. is non-missing--
zdv<-which(!is.na(depvar))
depvar<-depvar[zdv]
#HERE GIVE THE "NAME" OF THE DEPENDENT VARIABLE THAT IS COMPUTED
depvarname<-"MoralGods"
#--can add additional SCCS variable, but only if it has no missing values---
dateobs<-SCCS$v838
dateobs<-dateobs[zdv]

#--look at histogram and frequencies for the dep. varb.--
hist(depvar)
table(depvar)

#--modify weight matrices---
#--set diagonal equal to zeros--
diag(ll)<-0
diag(dd)<-0
#--use only obs. where dep. varb. non-missing--
ll<-ll[zdv,zdv]
dd<-dd[zdv,zdv]
#--row standardize (rows sum to one)
ll<-ll/rowSums(ll)
dd<-dd/rowSums(dd)
#--check to see that rows sum to one
rowSums(ll)
rowSums(dd)
#--make weight matrix object for later autocorrelation test--
wmatll<-mat2listw(as.matrix(ll))
wmatdd<-mat2listw(as.matrix(dd))

     #"moralgods","moralgods2",
indpv<-c(
"islamic",
"xian",
"pre_mar_sex", "money", "foodstress", "femctrldwellg",
"wealthy","poor","PCvioHomi","PCvioAslt","PCvioIntr",#"PCvioTotl",
"milkedanim","pctFemPolyg",
"anim2","money2","bridewealth","caststratLGD",
#","classtrat "PCAP","PCsize","PCsize2","caststrat","eextwar", 
"femsubs","foodscarc",
"fratgrpstr","marrcaptives","plunder",###"climate",
"exogamy","ncmallow","superjh",
"fempower","sexratio",
"war","himilexp","wagelabor",
"famsize","settype","localjh",
"cultints","roots","cereals","gath","hunt","fish",
"anim","pigs","milk","plow","bovines","tree","foodtrade",
"ndrymonth","ecorich",
"popdens","pathstress","CVrain","rain","temp","AP1","AP2")


#-----------------------------------------------------
#---Estimate model on each imputed dataset------------
#-----------------------------------------------------

#--number of imputed datasets--
#nimp<-10
nimp<-3  ################################################################## speedup test

#--will append values to these empty objects--
vif<-NULL
ss<-NULL
beta<-NULL
dng<-NULL

#--loop through the imputed datasets--
for (i in 1:nimp){

#--select the ith imputed dataset--
m9<-impdat[which(impdat$.imp==i),]
#--retain only obs. for which dep. varb. is nonmissing--
m9<-m9[zdv,]

#--create spatially lagged dep. varbs.--
y<-as.matrix(depvar)
xx<-as.matrix(m9[,indpv])
#--for instruments we use the spatial lag of our indep. varbs.--
#--First, the spatially lagged varb. for distance--
xdy<-dd%*%xx
cyd<-dd%*%y
o<-lm(cyd~xdy)
#--the fitted value is our instrumental variable--
fydd<-fitted(o)
#--keep R2 from this regression--
dr2<-summary(o)$r.squared
#--Then, the spatially lagged varb. for language--
xly<-ll%*%xx   
cyl<-ll%*%y
o<-lm(cyl~xly)
#--the fitted value is our instrumental variable--
fyll<-fitted(o)
#--keep R2 from this regression--
lr2<-summary(o)$r.squared
m9<-cbind(m9,fydd,fyll)

#--OLS estimate of unrestricted model--
xUR<-lm(depvar~fyll+fydd+
islamic+
xian+
PCvioHomi+PCvioAslt+PCvioIntr+
milkedanim+pctFemPolyg+
anim2+caststratLGD+money2+bridewealth+
##moralgods+moralgods2+  ##classtrat+
PCAP+PCsize+PCsize2+caststrat+eextwar+
pre_mar_sex+money+foodstress+femctrldwellg+
poor+wealthy+
fratgrpstr+marrcaptives+plunder+###climate+
cultints+roots+cereals+gath+plow+
hunt+fish+anim+pigs+milk+bovines+tree+foodtrade+foodscarc+
ecorich+popdens+pathstress+exogamy+ncmallow+famsize+
settype+localjh+
fempower+femsubs+ #superjh+
sexratio+war+himilexp+money+wagelabor
,data=m9)

     ##moralgods2+
     ##moralgods
#--OLS estimate of restricted model--
xR<-lm(depvar~fydd+fyll+
#superjh+
milk+  #AP1+AP2+
caststratLGD+   ##classtrat+
islamic+
xian+
money    ##+money2  #+#bridewealth ## caststrat+money+
#PCvioHomi+#
#PCvioAslt+
#PCvioIntr+
#foodscarc+##eextwar+
#PCAP+
#PCsize2+
#anim+##anim2+
#milkedanim+
#foodstress+
#fratgrpstr+
#PCsize+#poor+#wealthy+#pctFemPolyg+# #plow+
#extwar+ 
#PCsize+
 ,data=m9)

#--corrected sigma2 and R2 for 2SLS--
qxx<-m9
qxx[,"fydd"]<-cyd
qxx[,"fyll"]<-cyl
b<-coef(xR)
incpt<-matrix(1,NROW(qxx),1)
x<-as.matrix(cbind(incpt,qxx[,names(b)[-1]]))
e<-y-x%*%as.matrix(b)
cs2<-as.numeric(t(e)%*%e/(NROW(x)-NCOL(x)))
cr2<-as.numeric(1-t(e)%*%e/sum((y-mean(y))^2))

#--collect coefficients and their variances--
ov<-summary(xR)
vif<-rbind(vif,vif(xR))
ss<-rbind(ss,diag(ov$cov*cs2))
#--collect robust coef. variances when there is heteroskedasticity--
#eb<-e^2
#x<-as.matrix(cbind(incpt,m9[,names(b)[-1]]))
#hcm<-inv(t(x)%*%x)%*%t(x)%*%diag(eb[1:length(eb)])%*%x%*%inv(t(x)%*%x)
#ss<-rbind(ss,diag(hcm))
beta<-rbind(beta,coef(xR))

      #"moralgods","
#--collect some model diagnostics--
dropt<-c("cereals","gath","plow","hunt","anim",
"pigs","milk","bovines","foodscarc","ecorich",
"popdens","pathstress","ncmallow","famsize","localjh",
#"superjh",
"fempower","sexratio","money",
"wagelabor","war","himilexp","tree")


#--Ramsey RESET test--
p1<-qchisq(resettest(xR,type="fitted")$"p.value",1,lower.tail=FALSE)
#--Wald test (H0: dropped variables have coefficient equal zero)--
o<-linear.hypothesis(xUR,dropt,test="Chisq")$"Pr(>Chisq)"[2]
p2<-qchisq(o,1,lower.tail=FALSE) #find Chisq with 1 d.f. and same pvalue
#--Heteroskedasticity test (H0: homoskedastic residuals)--
p3<-ncv.test(xR)$ChiSquare
#--Shapiro-Wilke normality test (H0: residuals normal)
p4<-qchisq(shapiro.test(residuals(xR))$p.value,1,lower.tail=FALSE)
#--LaGrange Multiplier test for spatial autocorrelation: language--
o<-lm.LMtests(xR, wmatll, test=c("LMlag"))
p5<-as.numeric(o$LMlag$statistic)
#--LaGrange Multiplier test for spatial autocorrelation: distance--
o<-lm.LMtests(xR, wmatdd, test=c("LMlag"))
p6<-as.numeric(o$LMlag$statistic)
#--model R2--
p7<-cr2
dng<-rbind(dng,cbind(p1,p2,p3,p4,p5,p6,p7,dr2,lr2))

}


#--------------------------------------------
#--Rubin's formulas for combining estimates--
#--------------------------------------------

#--first find final regr. coefs. and p-values--
mnb<-apply(beta,2,mean)
####################vrb<-colSums((beta-t(matrix(mnb,length(mnb),10)))^2)/(nimp-1)
vrb<-colSums((beta-t(matrix(mnb,length(mnb),nimp)))^2)/(nimp-1)
mnv<-apply(ss,2,mean)
vrT<-mnv+vrb*(1-nimp^(-1))
fst<-mnb^2/vrT
r<-(1+nimp^(-1))*vrb/mnv
v<-(nimp-1)*(1+r^(-1))^2
pval<-pf(fst,1,v,lower.tail=FALSE)
bbb<-data.frame(round(cbind(mnb,fst,v,pval),8)) #,3 changed to .8 for significance test
bbb$VIF[2:NROW(bbb)]<-round(apply(vif,2,mean),3)
names(bbb)<-c("coef","Fstat","ddf","pvalue","VIF")

#--Then combine the diagnostics we collected--
dng<-data.frame(dng)
names(dng)<-c("RESET","Wald on restrs.","NCV","SWnormal","lagll","lagdd",
"R2:final model","R2:IV(distance)","R2:IV(language)")
r2<-apply(dng[,7:9],2,mean)
adng<-dng[,1:6]
mdm<-apply(adng,2,mean)
vrd<-colSums((adng-t(matrix(mdm,length(mdm),nimp)))^2)/(nimp-1)
aa<-4*mdm^2-2*vrd
aa[which(aa<0)]<-0
rd<-(1+nimp^(-1))*vrd/(2*mdm+aa^.5)
vd<-(nimp-1)*(1+rd^(-1))^2
Dm<-(mdm-(nimp-1)/(nimp+1)*rd)/(1+rd)
#-All chi-sq we collected have df=1-------
pvald<-pf(Dm,1,vd,lower.tail=FALSE)
ccc<-data.frame(round(cbind(Dm,vd,pvald),3))
names(ccc)<-c("Fstat","df","pvalue")

#--write results to csv file for perusal in spreadsheet--
write.csv("==OLS model for depvar==",file="OLSresults.csv",append=FALSE)
write.csv(bbb,file="OLSresults.csv",append=TRUE)
write.csv(r2,file="OLSresults.csv",append=TRUE)
write.csv(ccc,file="OLSresults.csv",append=TRUE)

aaa<-c(table(depvar), NROW(depvar),depvarname)
imp<-"number of imputations nimp="
impute=c(imp,nimp)

bbb
r2
ccc
bbb<-data.frame(round(cbind(mnb,fst,v,pval),3)) #.8 changed to back to .3 for significance test
bbb$VIF[2:NROW(bbb)]<-round(apply(vif,2,mean),3)
bbb
aaa
impute
load("world_countries_24.rda",.GlobalEnv)
zdv<-which(!is.na(depvar))
dep_var<-depvar[zdv]
dep_var<-dep_var+1
table(dep_var)
depvarname<-"Moral gos v238"
load("world_countries_24.rda",.GlobalEnv)
sccs=SCCS
splgt<-SpatialPointsDataFrame(coordinates(sccs[zdv,c("longitud","latitude")]),data.frame(dep_var)) 
brks<-quantile(dep_var,c(0,.333,.666,1))
cols<-colorRampPalette(c("yellow", "brown"))(length(brks)-1)
plot(world_countries,col="white") #black")
plot(splgt,pch=21,add=TRUE,cex=dep_var^.25,col="red", bg=cols[findInterval(dep_var, brks, all.inside=TRUE)])
mtext(depvarname,line=-2, side=1,cex=.5) #7)
splgt<-SpatialPointsDataFrame(coordinates(sccs[zdv,c("longitud","latitude")]),data.frame(dep_var)) 
brks<-quantile(dep_var,c(0,.333,.666,1))
cols<-colorRampPalette(c("yellow", "brown"))(length(brks)-1)
#jpeg(file="473-475mapValue_of_Boys.jpg",width=8,height=5,units="in",pointsize=8,res=600)
plot(world_countries,col="white") #black")
plot(splgt,pch=21,add=TRUE,cex=dep_var^.25,col="red", bg=cols[findInterval(dep_var, brks, all.inside=TRUE)])
mtext(depvarname,line=-2, side=1,cex=.5) #7)
# dev.off()

B Unusual results: Xianity not Islam

(superjh was coef(xUR)=NA!

                    coef      Fstat          ddf     pvalue   VIF
(Intercept)   0.69500097  0.7885506 6.161197e+03 0.37457341    NA
fydd          0.82163739 25.3688593 6.566495e+05 0.00000047 2.398
fyll         -0.52160817  1.3491852 1.047937e+04 0.24544707 2.308
milk          0.53885913  6.1591054 6.688429e+04 0.01307617 2.174
caststratLGD  0.47451085  2.0298571 4.328169e+06 0.15423518 1.276
islamic       0.17957288  0.2530650 3.589415e+08 0.61492516 1.101
xian          0.72068560 16.7561794 3.586110e+06 0.00004250 1.195
money         0.03348658  0.4758419 4.554192e+05 0.49031220 1.206
>  r2
 R2:final model R2:IV(distance) R2:IV(language) 
      0.4764750       0.9952422       0.9867894 
                Fstat           df pvalue
RESET           2.349     8902.009  0.125
Wald on restrs. 1.276       28.341  0.268
NCV             0.139 34105029.901  0.709
SWnormal        7.888   229412.071  0.005
lagll           1.017     7203.350  0.313
lagdd           0.569    10749.284  0.451

8A| ADDING PastoralExch Moral gods v238 EvilEye NOT DICHOTOMIZED MONEY v155 >1 >3 >4

pastoralExch=((SCCS$v208==1)*1)*(SCCS$v858==6)*1 #bridewealth*pastoralism 
MAC
#Program 1 --> Program 2 below
#Program 1 Part A
#MI--make the imputed datasets
#--change the following path to the directory with your data and program--
setwd("C:/My Documents/MI")
setwd("/Users/drwhite/Documents/MI") #these should work for for your subdirectory on the mac ignoring PC setwd("C:/My Documents/sccs")
rm(list=ls(all=TRUE))
options(echo=TRUE)
#--you need the following two packages--you must install them first--
library(foreign)
library(mice)
library(tripack)
library(zoo)
library(sp)
library(maptools)
library(spam)
#--for program 2 below
library(spdep)
library(car)
library(lmtest)
library(sandwich)

#--To find the citation for a package, use this function:---
citation("mice")

#-----------------------------
#--Read in data, rearrange----
#-----------------------------

#--Read in auxiliary variables---
load("vaux.Rdata",.GlobalEnv)
row.names(vaux)<-NULL
#--Read in the SCCS dataset---
load("SCCS.Rdata",.GlobalEnv)
#--look at first 6 rows of vaux--
head(vaux)
#--look at field names of vaux--
names(vaux)
#--check to see that rows are properly aligned in the two datasets--
#--sum should equal 186---
sum((SCCS$socname==vaux$socname)*1)
#--remove the society name field--
vaux<-vaux[,-28]
names(vaux)

#--Two nominal variables: brg and rlg----
#--brg: consolidated Burton  Regions-----
#0 = (rest of world) circumpolar, South and Meso-America, west North America
#1 = Subsaharan Africa
#2 = Middle Old World
#3 = Southeast Asia, Insular Pacific, Sahul
#4 = Eastern Americas
#--rlg: Religion---
#'0 (no world religion)'  
#'1 (Christianity)'  
#'2 (Islam)'  
#'3 (Hindu/Buddhist)'  

#--check to see number of missing values in vaux, 
#--whether variables are numeric,
#--and number of discrete values for each variable---
vvn<-names(vaux)
pp<-NULL
for (i in 1:length(vvn)){
nmiss<-length(which(is.na(vaux[,vvn[i]])))
numeric<-is.numeric(vaux[,vvn[i]])
numDiscrVals<-length(table(vaux[,vvn[i]]))
pp<-rbind(pp,cbind(data.frame(numeric),nmiss,numDiscrVals))
}
row.names(pp)<-vvn
pp

#MODIFY THESE STATEMENTS FOR A NEW PROJECT
#--extract variables to be used from SCCS, put in dataframe fx--
fx<-data.frame(
socname=SCCS$socname,socID=SCCS$"sccs#",
pastoralExch=((SCCS$v208==1)*1)*(SCCS$v858==6)*1,           #bridewealth*pastoralism
islamic=(SCCS$v2002==3)*1+2*(SCCS$v2002==1)*1,
xian=(SCCS$v2002==4)*1+2*(SCCS$v2002==2)*1,
#PCAP PCsize PCsize2 
#PCvioHomi=SCCS$v1665,   ### PCvioHomi PCvioAslt PCvioIntr PCvioTotl
#PCvioAslt=SCCS$v1666,
#PCvioIntr=SCCS$v666,
#PCvioTotl=SCCS$v666+SCCS$v1666+SCCS$v1665,
extwar=SCCS$v892,
classtrat=SCCS$v270,
caststrat=SCCS$v272,
caststratLGD=log(1+SCCS$v272),    #^2,
anim=SCCS$v206,
anim_log=log(1+SCCS$v206),
milk=(SCCS$v245>1)*1,
milkedanim=SCCS$v206*SCCS$v206,
bridewealth=(SCCS$v208==1)*1,
money=SCCS$v17,
money2=(SCCS$v155>1)*1+(SCCS$v155>3)*1+(SCCS$v155>4)*1,
extwar2=SCCS$v892^2,
anim=SCCS$v206,
anim2=log(1+SCCS$v206),         #^2,
#moralgods=SCCS$v238,
#moralgods2=(SCCS$v238)^2,
PCsize=SCCS$v237,
PCAP=SCCS$v921,
PCsize2=SCCS$v237^2, eextwar=SCCS$v1650,
valchild=(SCCS$v473+SCCS$v474+SCCS$v475+SCCS$v476),
fratgrpstr=SCCS$v570,
marrcaptives=SCCS$v870,
plunder=SCCS$v912, ##2009 depvars
pre_mar_sex=SCCS$v167, foodstress=SCCS$v678,
femctrldwellg=SCCS$v591,
wealthy=SCCS$v1721,
poor=SCCS$v1723,
war679=SCCS$v679,
###climate<-(SCCS$v857==1 | SCCS$v857==2 | SCCS$v857==6)*1+(SCCS$v857==3 | SCCS$v857==4)*2+(SCCS$v857==5)*3,
nonmatrel=SCCS$v52,
lrgfam=SCCS$v68,
exogamy=SCCS$v72,
famsize=SCCS$v80,
popdens=SCCS$v156,
malesexag=SCCS$v175,
ndrymonth=SCCS$v196,
gath=SCCS$v203,
hunt=SCCS$v204,
fish=SCCS$v205,
anim=SCCS$v206,
nuclearfam=(SCCS$v210<=3)*1,
ncmallow=SCCS$v227,
cultints=SCCS$v232,
tree=(SCCS$v233==4)*1,
roots=(SCCS$v233==5)*1,
cereals=(SCCS$v233==6)*1,
settype=SCCS$v234,
localjh=(SCCS$v236-1),
superjh=SCCS$v237,
segadlboys=SCCS$v242,
plow=(SCCS$v243>1)*1,
pigs=(SCCS$v244==2)*1,
bovines=(SCCS$v244==7)*1,
agrlateboy=SCCS$v300,
fempower=SCCS$v663,
migr=(SCCS$v677==2)*1,
foodtrade=SCCS$v819,
dateobs=SCCS$v838,
rain=SCCS$v854,
temp=SCCS$v855,
ecorich=SCCS$v857,
pctFemPolyg=SCCS$v872,
femsubs=SCCS$v890,
himilexp=(SCCS$v899==1)*1,
AP1=SCCS$v921,
AP2=SCCS$v928,
pathstress=SCCS$v1260,
war=SCCS$v1648,
foodscarc=SCCS$v1685,
sexratio=1+(SCCS$v1689>85)+(SCCS$v1689>115),
wagelabor=SCCS$v1732,
CVrain=SCCS$v1914/SCCS$v1913
) 

#--look at first 6 rows of fx--
head(fx)

#--check to see number of missing values--
#--also check whether numeric--
vvn<-names(fx)
pp<-NULL
for (i in 1:length(vvn)){
nmiss<-length(which(is.na(fx[,vvn[i]])))
numeric<-is.numeric(fx[,vvn[i]])
pp<-rbind(pp,cbind(nmiss,data.frame(numeric)))
}
row.names(pp)<-vvn
pp

#--identify variables with missing values--
z<-which(pp[,1]>0)
zv1<-vvn[z]
zv1
#--identify variables with non-missing values--
z<-which(pp[,1]==0)
zv2<-vvn[z]
zv2
  



#Program 1 Part B
#-----------------------------
#----Multiple imputation------
#-----------------------------

#--number of imputed data sets to create--
#nimp<-10 #CHANGED TO TEST SPEEDUP  
nimp<-3  ################################################################## speedup test
#--one at a time, loop through those variables with missing values--
for (i in 1:length(zv1)){
#--attach the imputand to the auxiliary data--
zxx<-data.frame(cbind(vaux,fx[,zv1[i]]))
#--in the following line, the imputation is done--
aqq<-complete(mice(zxx,maxit=20,m=nimp),action="long")
###aqq<-complete(mice(zxx,maxit=100,m=nimp),action="long")
#--during first iteration of the loop, create dataframe impdat--
if (i==1){
impdat<-data.frame(aqq[,c(".id",".imp")])
}
#--the imputand is placed as a field in impdat and named--
impdat<-cbind(impdat,data.frame(aqq[,NCOL(zxx)]))
names(impdat)[NCOL(impdat)]<-zv1[i]
}

#--now the non-missing variables are attached to impdat--
gg<-NULL
for (i in 1:nimp){
gg<-rbind(gg,data.frame(fx[,zv2]))
}
impdat<-cbind(impdat,gg)

#--take a look at the top 6 and bottom 6 rows of impdat--
head(impdat)
tail(impdat)

#--impdat is saved as an R-format data file--
save(impdat,file="impdat.Rdata")


 
 

#Program 2 (12-18-2009)==
#MI--estimate model, combine results

rm(list=ls(all=TRUE))
#--Set path to your directory with data and program--
setwd("C:/My Documents/MI")
options(echo=TRUE)

#--need these packages for estimation and diagnostics--
library(foreign)
library(spdep)
library(car)
library(lmtest)
library(sandwich)

#-----------------------------
#--Read in data, rearrange----
#-----------------------------

#--Read in original SCCS data---
load("SCCS.Rdata",.GlobalEnv)
#--Read in two weight matrices--
ll<-as.matrix(read.dta("langwm.dta")[,-1])
dd<-as.matrix(read.dta("dist25wm.dta")[,c(-1,-2,-189)])
#--Read in the imputed dataset---
load("impdat.Rdata",.GlobalEnv)

#--create dep.varb. you wish to use from SCCS data--
#--Here we sum variables measuring how much a society values children--
#depvar<-apply(SCCS[,c("v473","v474","v475","v476")],1,sum) #can replace "sum" with "max"
#depvar<-SCCS$v1188    #v1188+SCCS$v1189
depvar<-SCCS$v238
#--find obs. for which dep. varb. is non-missing--
zdv<-which(!is.na(depvar))
depvar<-depvar[zdv]
#HERE GIVE THE "NAME" OF THE DEPENDENT VARIABLE THAT IS COMPUTED
depvarname<-"MoralGods"
#--can add additional SCCS variable, but only if it has no missing values---
dateobs<-SCCS$v838
dateobs<-dateobs[zdv]

#--look at histogram and frequencies for the dep. varb.--
hist(depvar)
table(depvar)

#--modify weight matrices---
#--set diagonal equal to zeros--
diag(ll)<-0
diag(dd)<-0
#--use only obs. where dep. varb. non-missing--
ll<-ll[zdv,zdv]
dd<-dd[zdv,zdv]
#--row standardize (rows sum to one)
ll<-ll/rowSums(ll)
dd<-dd/rowSums(dd)
#--check to see that rows sum to one
rowSums(ll)
rowSums(dd)
#--make weight matrix object for later autocorrelation test--
wmatll<-mat2listw(as.matrix(ll))
wmatdd<-mat2listw(as.matrix(dd))

     #"moralgods","moralgods2",
indpv<-c("pastoralExch",
"islamic",
"xian",
"pre_mar_sex", "money", "foodstress", "femctrldwellg",
"wealthy","poor",
#"PCvioHomi","PCvioAslt","PCvioIntr",#"PCvioTotl",
"milkedanim","pctFemPolyg",
"anim2","money2","bridewealth","caststratLGD",
#"classtrat",
"PCAP","PCsize","PCsize2","caststrat","eextwar", 
"femsubs","foodscarc",
"fratgrpstr","marrcaptives","plunder",###"climate",
"exogamy","ncmallow","superjh",
"fempower","sexratio",
"war","himilexp","wagelabor",
"famsize","settype","localjh",
"cultints","roots","cereals","gath","hunt","fish",
"anim","pigs","milk","plow","bovines","tree","foodtrade",
"ndrymonth","ecorich",
"popdens","pathstress","CVrain","rain","temp","AP1","AP2")


#-----------------------------------------------------
#---Estimate model on each imputed dataset------------
#-----------------------------------------------------

#--number of imputed datasets--
#nimp<-10
nimp<-3  ################################################################## speedup test

#--will append values to these empty objects--
vif<-NULL
ss<-NULL
beta<-NULL
dng<-NULL

#--loop through the imputed datasets--
for (i in 1:nimp){

#--select the ith imputed dataset--
m9<-impdat[which(impdat$.imp==i),]
#--retain only obs. for which dep. varb. is nonmissing--
m9<-m9[zdv,]

#--create spatially lagged dep. varbs.--
y<-as.matrix(depvar)
xx<-as.matrix(m9[,indpv])
#--for instruments we use the spatial lag of our indep. varbs.--
#--First, the spatially lagged varb. for distance--
xdy<-dd%*%xx
cyd<-dd%*%y
o<-lm(cyd~xdy)
#--the fitted value is our instrumental variable--
fydd<-fitted(o)
#--keep R2 from this regression--
dr2<-summary(o)$r.squared
#--Then, the spatially lagged varb. for language--
xly<-ll%*%xx   
cyl<-ll%*%y
o<-lm(cyl~xly)
#--the fitted value is our instrumental variable--
fyll<-fitted(o)
#--keep R2 from this regression--
lr2<-summary(o)$r.squared
m9<-cbind(m9,fydd,fyll)

#--OLS estimate of unrestricted model--
xUR<-lm(depvar~fyll+fydd+
pastoralExch+
islamic+
xian+
#PCvioHomi+PCvioAslt+PCvioIntr+
milkedanim+pctFemPolyg+
anim2+caststratLGD+money2+bridewealth+
##moralgods+moralgods2+  ##classtrat+
PCAP+PCsize+PCsize2+caststrat+eextwar+
pre_mar_sex+money+foodstress+femctrldwellg+
#poor+wealthy+
fratgrpstr+marrcaptives+plunder+###climate+
cultints+roots+cereals+gath+plow+
hunt+fish+anim+pigs+milk+bovines+tree+foodtrade+foodscarc+
ecorich+popdens+pathstress+exogamy+ncmallow+famsize+
settype+localjh+
fempower+femsubs+ #superjh+
sexratio+war+himilexp+money+wagelabor
,data=m9)

     ##moralgods2+
     ##moralgods
#--OLS estimate of restricted model--
xR<-lm(depvar~fydd+fyll+
#superjh+
pastoralExch+
milk+  #AP1+AP2+
caststratLGD+   ##classtrat+
islamic+
xian+
money    ##+money2  #+#bridewealth ## caststrat+money+
#PCvioHomi+#
#PCvioAslt+
#PCvioIntr+
#foodscarc+##eextwar+
#PCAP+
#PCsize2+
#anim+##anim2+
#milkedanim+
#foodstress+
#fratgrpstr+
#PCsize+#poor+#wealthy+#pctFemPolyg+# #plow+
#extwar+ 
#PCsize+
 ,data=m9)

#--corrected sigma2 and R2 for 2SLS--
qxx<-m9
qxx[,"fydd"]<-cyd
qxx[,"fyll"]<-cyl
b<-coef(xR)
incpt<-matrix(1,NROW(qxx),1)
x<-as.matrix(cbind(incpt,qxx[,names(b)[-1]]))
e<-y-x%*%as.matrix(b)
cs2<-as.numeric(t(e)%*%e/(NROW(x)-NCOL(x)))
cr2<-as.numeric(1-t(e)%*%e/sum((y-mean(y))^2))

#--collect coefficients and their variances--
ov<-summary(xR)
vif<-rbind(vif,vif(xR))
ss<-rbind(ss,diag(ov$cov*cs2))
#--collect robust coef. variances when there is heteroskedasticity--
#eb<-e^2
#x<-as.matrix(cbind(incpt,m9[,names(b)[-1]]))
#hcm<-inv(t(x)%*%x)%*%t(x)%*%diag(eb[1:length(eb)])%*%x%*%inv(t(x)%*%x)
#ss<-rbind(ss,diag(hcm))
beta<-rbind(beta,coef(xR))

      #"moralgods","
#--collect some model diagnostics--
dropt<-c("cereals","gath","plow","hunt","anim",
"pigs","milk","bovines","foodscarc","ecorich",
"popdens","pathstress","ncmallow","famsize","localjh",
#"superjh",
"fempower","sexratio","money",
"wagelabor","war","himilexp","tree")


#--Ramsey RESET test--
p1<-qchisq(resettest(xR,type="fitted")$"p.value",1,lower.tail=FALSE)
#--Wald test (H0: dropped variables have coefficient equal zero)--
o<-linear.hypothesis(xUR,dropt,test="Chisq")$"Pr(>Chisq)"[2]
p2<-qchisq(o,1,lower.tail=FALSE) #find Chisq with 1 d.f. and same pvalue
#--Heteroskedasticity test (H0: homoskedastic residuals)--
p3<-ncv.test(xR)$ChiSquare
#--Shapiro-Wilke normality test (H0: residuals normal)
p4<-qchisq(shapiro.test(residuals(xR))$p.value,1,lower.tail=FALSE)
#--LaGrange Multiplier test for spatial autocorrelation: language--
o<-lm.LMtests(xR, wmatll, test=c("LMlag"))
p5<-as.numeric(o$LMlag$statistic)
#--LaGrange Multiplier test for spatial autocorrelation: distance--
o<-lm.LMtests(xR, wmatdd, test=c("LMlag"))
p6<-as.numeric(o$LMlag$statistic)
#--model R2--
p7<-cr2
dng<-rbind(dng,cbind(p1,p2,p3,p4,p5,p6,p7,dr2,lr2))

}


#--------------------------------------------
#--Rubin's formulas for combining estimates--
#--------------------------------------------

#--first find final regr. coefs. and p-values--
mnb<-apply(beta,2,mean)
####################vrb<-colSums((beta-t(matrix(mnb,length(mnb),10)))^2)/(nimp-1)
vrb<-colSums((beta-t(matrix(mnb,length(mnb),nimp)))^2)/(nimp-1)
mnv<-apply(ss,2,mean)
vrT<-mnv+vrb*(1-nimp^(-1))
fst<-mnb^2/vrT
r<-(1+nimp^(-1))*vrb/mnv
v<-(nimp-1)*(1+r^(-1))^2
pval<-pf(fst,1,v,lower.tail=FALSE)
bbb<-data.frame(round(cbind(mnb,fst,v,pval),8)) #,3 changed to .8 for significance test
bbb$VIF[2:NROW(bbb)]<-round(apply(vif,2,mean),3)
names(bbb)<-c("coef","Fstat","ddf","pvalue","VIF")

#--Then combine the diagnostics we collected--
dng<-data.frame(dng)
names(dng)<-c("RESET","Wald on restrs.","NCV","SWnormal","lagll","lagdd",
"R2:final model","R2:IV(distance)","R2:IV(language)")
r2<-apply(dng[,7:9],2,mean)
adng<-dng[,1:6]
mdm<-apply(adng,2,mean)
vrd<-colSums((adng-t(matrix(mdm,length(mdm),nimp)))^2)/(nimp-1)
aa<-4*mdm^2-2*vrd
aa[which(aa<0)]<-0
rd<-(1+nimp^(-1))*vrd/(2*mdm+aa^.5)
vd<-(nimp-1)*(1+rd^(-1))^2
Dm<-(mdm-(nimp-1)/(nimp+1)*rd)/(1+rd)
#-All chi-sq we collected have df=1-------
pvald<-pf(Dm,1,vd,lower.tail=FALSE)
ccc<-data.frame(round(cbind(Dm,vd,pvald),3))
names(ccc)<-c("Fstat","df","pvalue")

#--write results to csv file for perusal in spreadsheet--
write.csv("==OLS model for depvar==",file="OLSresults.csv",append=FALSE)
write.csv(bbb,file="OLSresults.csv",append=TRUE)
write.csv(r2,file="OLSresults.csv",append=TRUE)
write.csv(ccc,file="OLSresults.csv",append=TRUE)

aaa<-c(table(depvar), NROW(depvar),depvarname)
imp<-"number of imputations nimp="
impute=c(imp,nimp)

bbb
r2
ccc
bbb<-data.frame(round(cbind(mnb,fst,v,pval),3)) #.8 changed to back to .3 for significance test
bbb$VIF[2:NROW(bbb)]<-round(apply(vif,2,mean),3)
bbb
aaa
impute
load("world_countries_24.rda",.GlobalEnv)
zdv<-which(!is.na(depvar))
dep_var<-depvar[zdv]
dep_var<-dep_var+1
table(dep_var)
depvarname<-"Moral gos v238"
load("world_countries_24.rda",.GlobalEnv)
sccs=SCCS
splgt<-SpatialPointsDataFrame(coordinates(sccs[zdv,c("longitud","latitude")]),data.frame(dep_var)) 
brks<-quantile(dep_var,c(0,.333,.666,1))
cols<-colorRampPalette(c("yellow", "brown"))(length(brks)-1)
plot(world_countries,col="white") #black")
plot(splgt,pch=21,add=TRUE,cex=dep_var^.25,col="red", bg=cols[findInterval(dep_var, brks, all.inside=TRUE)])
mtext(depvarname,line=-2, side=1,cex=.5) #7)
splgt<-SpatialPointsDataFrame(coordinates(sccs[zdv,c("longitud","latitude")]),data.frame(dep_var)) 
brks<-quantile(dep_var,c(0,.333,.666,1))
cols<-colorRampPalette(c("yellow", "brown"))(length(brks)-1)
#jpeg(file="473-475mapValue_of_Boys.jpg",width=8,height=5,units="in",pointsize=8,res=600)
plot(world_countries,col="white") #black")
plot(splgt,pch=21,add=TRUE,cex=dep_var^.25,col="red", bg=cols[findInterval(dep_var, brks, all.inside=TRUE)])
mtext(depvarname,line=-2, side=1,cex=.5) #7)
# dev.off()

6A| pastoralExch BUT doesnt knock out milking! WORKING! Moral gods v238 EvilEye NOT DICHOTOMIZED MONEY v155 >1 >3 >4

Used Error messages for Eff and Dow 2009 + }

  • e.g., Error in linearHypothesis.lm(...) :
there are aliased coefficients in the model.
Remedy coef(xUR): showed NA for #roots, cereals, pigs, bovines, tree, SUSPICIOUS BECAUSE THE SAME FOR EduMod54!!

pastoralExch=((SCCS$v208==1)*1)*(SCCS$v858==6)*1

#Program 1 --> Program 2 below
#Program 1 Part A
#MI--make the imputed datasets
#--change the following path to the directory with your data and program--
setwd("C:/My Documents/MI")
rm(list=ls(all=TRUE))
options(echo=TRUE)
#--you need the following two packages--you must install them first--
library(foreign)
library(mice)
library(tripack)
library(zoo)
library(sp)
library(maptools)
library(spam)
#--for program 2 below
library(spdep)
library(car)
library(lmtest)
library(sandwich)

#--To find the citation for a package, use this function:---
citation("mice")

#-----------------------------
#--Read in data, rearrange----
#-----------------------------

#--Read in auxiliary variables---
load("vaux.Rdata",.GlobalEnv)
row.names(vaux)<-NULL
#--Read in the SCCS dataset---
load("SCCS.Rdata",.GlobalEnv)

#--look at first 6 rows of vaux--
head(vaux)
#--look at field names of vaux--
names(vaux)
#--check to see that rows are properly aligned in the two datasets--
#--sum should equal 186---
sum((SCCS$socname==vaux$socname)*1)
#--remove the society name field--
vaux<-vaux[,-28]
names(vaux)

#--Two nominal variables: brg and rlg----
#--brg: consolidated Burton  Regions-----
#0 = (rest of world) circumpolar, South and Meso-America, west North America
#1 = Subsaharan Africa
#2 = Middle Old World
#3 = Southeast Asia, Insular Pacific, Sahul
#4 = Eastern Americas
#--rlg: Religion---
#'0 (no world religion)'  
#'1 (Christianity)'  
#'2 (Islam)'  
#'3 (Hindu/Buddhist)'  

#--check to see number of missing values in vaux, 
#--whether variables are numeric,
#--and number of discrete values for each variable---
vvn<-names(vaux)
pp<-NULL
for (i in 1:length(vvn)){
nmiss<-length(which(is.na(vaux[,vvn[i]])))
numeric<-is.numeric(vaux[,vvn[i]])
numDiscrVals<-length(table(vaux[,vvn[i]]))
pp<-rbind(pp,cbind(data.frame(numeric),nmiss,numDiscrVals))
}
row.names(pp)<-vvn
pp

#MODIFY THESE STATEMENTS FOR A NEW PROJECT
#--extract variables to be used from SCCS, put in dataframe fx--
fx<-data.frame(
socname=SCCS$socname,socID=SCCS$"sccs#",
pastoralExch=((SCCS$v208==1)*1)*(SCCS$v858==6)*1,
PCvioHomi=SCCS$v1665,   ### PCvioHomi PCvioAslt PCvioIntr PCvioTotl
PCvioAslt=SCCS$v1666,
PCvioIntr=SCCS$v666,
#PCvioTotl=SCCS$v666+SCCS$v1666+SCCS$v1665,
extwar=SCCS$v892,
classtrat=SCCS$v270,
caststrat=SCCS$v272,
anim=SCCS$v206,
anim2=log(1+SCCS$v206),         #^2,
anim_log=log(1+SCCS$v206),
milk=(SCCS$v245>1)*1,
milkedanim=SCCS$v206*SCCS$v206,
bridewealth=(SCCS$v208==1)*1,
money=SCCS$v17,
money2=(SCCS$v155>1)*1+(SCCS$v155>3)*1+(SCCS$v155>4)*1,
extwar2=SCCS$v892^2,
caststratLGd=log(1+SCCS$v272),    #^2,
#moralgods=SCCS$v238,
#moralgods2=(SCCS$v238)^2,
PCsize=SCCS$v237,
PCAP=SCCS$v921,
PCsize2=(SCCS$v237)^2, 
eextwar=SCCS$v1650,
valchild=(SCCS$v473+SCCS$v474+SCCS$v475+SCCS$v476),
fratgrpstr=SCCS$v570,
marrcaptives=SCCS$v870,
plunder=SCCS$v912, ##2009 depvars
pre_mar_sex=SCCS$v167, foodstress=SCCS$v678,
femctrldwellg=SCCS$v591,
wealthy=SCCS$v1721,
poor=SCCS$v1723,
war679=SCCS$v679,
###climate<-(SCCS$v857==1 | SCCS$v857==2 | SCCS$v857==6)*1+(SCCS$v857==3 | SCCS$v857==4)*2+(SCCS$v857==5)*3,
nonmatrel=SCCS$v52,
lrgfam=SCCS$v68,
exogamy=SCCS$v72,
famsize=SCCS$v80,
popdens=SCCS$v156,
malesexag=SCCS$v175,
ndrymonth=SCCS$v196,
gath=SCCS$v203,
hunt=SCCS$v204,
fish=SCCS$v205,
nuclearfam=(SCCS$v210<=3)*1,
ncmallow=SCCS$v227,
cultints=SCCS$v232,
tree=(SCCS$v233==4)*1,
roots=(SCCS$v233==5)*1,
cereals=(SCCS$v233==6)*1,
settype=SCCS$v234,
localjh=(SCCS$v236-1),
#superjh=SCCS$v237,
segadlboys=SCCS$v242,
plow=(SCCS$v243>1)*1,
pigs=(SCCS$v244==2)*1,
bovines=(SCCS$v244==7)*1,
agrlateboy=SCCS$v300,
fempower=SCCS$v663,
migr=(SCCS$v677==2)*1,
foodtrade=SCCS$v819,
dateobs=SCCS$v838,
rain=SCCS$v854,
temp=SCCS$v855,
ecorich=SCCS$v857,
pctFemPolyg=SCCS$v872,
femsubs=SCCS$v890,
himilexp=(SCCS$v899==1)*1,
AP1=SCCS$v921,
AP2=SCCS$v928,
pathstress=SCCS$v1260,
war=SCCS$v1648,
foodscarc=SCCS$v1685,
sexratio=1+(SCCS$v1689>85)+(SCCS$v1689>115),
wagelabor=SCCS$v1732,
CVrain=SCCS$v1914/SCCS$v1913
) 
#source("C:/My Documents/MI/renormalize.R")
#SCCS = normalize_data(SCCS)
# fx = normalize_data(fx)
#Verify fx works. The finish running the rest of the script.
After that SCCS is no longer used except in the eff_dow2 script where it is

loaded to define dep_var. If you need to normalize dep_var you can add the following line after dep_var is defined in the eff_dow 2 script:

#dep_var = normalize_probit(dep_var)
#Delete:
#new_sccs = SCCS
#save(new_sccs,file="new_sccs.Rdata")
load("SCCS.Rdata",.GlobalEnv)


#--look at first 6 rows of fx--
head(fx)

#--check to see number of missing values--
#--also check whether numeric--
vvn<-names(fx)
pp<-NULL
for (i in 1:length(vvn)){
nmiss<-length(which(is.na(fx[,vvn[i]])))
numeric<-is.numeric(fx[,vvn[i]])
pp<-rbind(pp,cbind(nmiss,data.frame(numeric)))
}
row.names(pp)<-vvn
pp

#--identify variables with missing values--
z<-which(pp[,1]>0)
zv1<-vvn[z]
zv1
#--identify variables with non-missing values--
z<-which(pp[,1]==0)
zv2<-vvn[z]
zv2
  



#Program 1 Part B
#-----------------------------
#----Multiple imputation------
#-----------------------------

#--number of imputed data sets to create--
#nimp<-10 #CHANGED TO TEST SPEEDUP  
nimp<-3  ################################################################## speedup test
#--one at a time, loop through those variables with missing values--
for (i in 1:length(zv1)){
#--attach the imputand to the auxiliary data--
zxx<-data.frame(cbind(vaux,fx[,zv1[i]]))
#--in the following line, the imputation is done--
aqq<-complete(mice(zxx,maxit=20,m=nimp),action="long")
###aqq<-complete(mice(zxx,maxit=100,m=nimp),action="long")
#--during first iteration of the loop, create dataframe impdat--
if (i==1){
impdat<-data.frame(aqq[,c(".id",".imp")])
}
#--the imputand is placed as a field in impdat and named--
impdat<-cbind(impdat,data.frame(aqq[,NCOL(zxx)]))
names(impdat)[NCOL(impdat)]<-zv1[i]
}

#--now the non-missing variables are attached to impdat--
gg<-NULL
for (i in 1:nimp){
gg<-rbind(gg,data.frame(fx[,zv2]))
}
impdat<-cbind(impdat,gg)

#--take a look at the top 6 and bottom 6 rows of impdat--
head(impdat)
tail(impdat)

#--impdat is saved as an R-format data file--
save(impdat,file="impdat.Rdata")


 
 

#Program 2 (12-18-2009)==
#MI--estimate model, combine results

rm(list=ls(all=TRUE))
#--Set path to your directory with data and program--
setwd("C:/My Documents/MI")
options(echo=TRUE)

#--need these packages for estimation and diagnostics--
library(foreign)
library(spdep)
library(car)
library(lmtest)
library(sandwich)

#-----------------------------
#--Read in data, rearrange----
#-----------------------------

#--Read in original SCCS data---
#load("SCCS.Rdata",.GlobalEnv)
load("new_sccs.Rdata",.GlobalEnv)
SCCS=new_sccs
load("SCCS.Rdata",.GlobalEnv)


#--Read in two weight matrices--
ll<-as.matrix(read.dta("langwm.dta")[,-1])
dd<-as.matrix(read.dta("dist25wm.dta")[,c(-1,-2,-189)])
#--Read in the imputed dataset---
load("impdat.Rdata",.GlobalEnv)

#--create dep.varb. you wish to use from SCCS data--
#--Here we sum variables measuring how much a society values children--
#depvar<-apply(SCCS[,c("v473","v474","v475","v476")],1,sum) #can replace "sum" with "max"
#depvar<-SCCS$v1188    #v1188+SCCS$v1189
depvar<-SCCS$v238
#--find obs. for which dep. varb. is non-missing--
zdv<-which(!is.na(depvar))
depvar<-depvar[zdv]
#source("C:/My Documents/MI/normalize_probit.R")
#depvar = normalize_probit(depvar)
#HERE GIVE THE "NAME" OF THE DEPENDENT VARIABLE THAT IS COMPUTED
depvarname<-"MoralGods"
#--can add additional SCCS variable, but only if it has no missing values---
dateobs<-SCCS$v838
dateobs<-dateobs[zdv]

#--look at histogram and frequencies for the dep. varb.--
hist(depvar)
table(depvar)

#--modify weight matrices---
#--set diagonal equal to zeros--
diag(ll)<-0
diag(dd)<-0
#--use only obs. where dep. varb. non-missing--
ll<-ll[zdv,zdv]
dd<-dd[zdv,zdv]
#--row standardize (rows sum to one)
ll<-ll/rowSums(ll)
dd<-dd/rowSums(dd)
#--check to see that rows sum to one
rowSums(ll)
rowSums(dd)
#--make weight matrix object for later autocorrelation test--
wmatll<-mat2listw(as.matrix(ll))
wmatdd<-mat2listw(as.matrix(dd))

#"moralgods","moralgods2",
indpv<-c("pastoralExch",
"pre_mar_sex", "money", "foodstress", "femctrldwellg",
"wealthy","poor","PCvioHomi","PCvioAslt","PCvioIntr",#"PCvioTotl",
"milkedanim","pctFemPolyg",
"anim2","money2","bridewealth","caststratLGd",
#","classtrat "PCAP",
"PCsize",
"PCsize2",
#"caststrat","eextwar", 
"femsubs","foodscarc",
"fratgrpstr","marrcaptives","plunder",###"climate",
"exogamy","ncmallow",#"superjh",
"fempower","sexratio",
"war","himilexp","wagelabor",
"famsize","settype","localjh",
"cultints","roots","cereals","gath","hunt","fish",
"anim","pigs","milk","plow","bovines","tree","foodtrade",
"ndrymonth","ecorich",
"popdens","pathstress","CVrain","rain","temp","AP1","AP2")


#-----------------------------------------------------
#---Estimate model on each imputed dataset------------
#-----------------------------------------------------

#--number of imputed datasets--
#nimp<-10
nimp<-3  ################################################################## speedup test

#--will append values to these empty objects--
vif<-NULL
ss<-NULL
beta<-NULL
dng<-NULL

#--loop through the imputed datasets--
for (i in 1:nimp){

#--select the ith imputed dataset--
m9<-impdat[which(impdat$.imp==i),]
#--retain only obs. for which dep. varb. is nonmissing--
m9<-m9[zdv,]

#--create spatially lagged dep. varbs.--
y<-as.matrix(depvar)
xx<-as.matrix(m9[,indpv])
#--for instruments we use the spatial lag of our indep. varbs.--
#--First, the spatially lagged varb. for distance--
xdy<-dd%*%xx
cyd<-dd%*%y
o<-lm(cyd~xdy)
#--the fitted value is our instrumental variable--
fydd<-fitted(o)
#--keep R2 from this regression--
dr2<-summary(o)$r.squared
#--Then, the spatially lagged varb. for language--
xly<-ll%*%xx   
cyl<-ll%*%y
o<-lm(cyl~xly)
#--the fitted value is our instrumental variable--
fyll<-fitted(o)
#--keep R2 from this regression--
lr2<-summary(o)$r.squared
m9<-cbind(m9,fydd,fyll)

#--OLS estimate of unrestricted model--
xUR<-lm(depvar~fyll+fydd+
pastoralExch+
PCvioHomi+PCvioAslt+PCvioIntr+
milkedanim+pctFemPolyg+
#anim2+
caststratLGd+money2+bridewealth+
##moralgods+moralgods2+  ##classtrat+
PCAP+
PCsize+
PCsize2+
caststrat+eextwar+
pre_mar_sex+money+foodstress+femctrldwellg+
poor+wealthy+
fratgrpstr+marrcaptives+plunder+###climate+
cultints+roots+cereals+gath+plow+
hunt+fish+
#anim+
pigs+milk+bovines+tree+foodtrade+foodscarc+
ecorich+popdens+pathstress+exogamy+ncmallow+famsize+
settype+localjh+
fempower+femsubs+ #superjh+
sexratio+war+himilexp+money+wagelabor
,data=m9)


xR<-lm(depvar~fydd+fyll+
pastoralExch+
#PCvioHomi+PCvioAslt+
#milkedanim+ ##pctFemPolyg+
PCAP+
PCsize+
#PCsize2+    NA for some reason
milk+
foodstress+
eextwar+ 
bridewealth+
caststratLGd+
PCvioIntr
#anim2+
#money2+
##moralgods+moralgods2+  
#classtrat+##extwar+
#pre_mar_sex+money+
#femctrldwellg+
#poor+wealthy+
#fratgrpstr+
#marrcaptives+plunder+###climate+
#cultints+roots+cereals+gath+
#plow+
#hunt+fish+
#anim+
#pigs+milk+bovines+tree+foodtrade+foodscarc+
#ecorich+popdens+pathstress+exogamy+ncmallow+famsize+
#settype+localjh+
#fempower+femsubs+ #superjh+
#sexratio+war+
#himilexp #+money+wagelabor
,data=m9)


#--corrected sigma2 and R2 for 2SLS--
qxx<-m9
qxx[,"fydd"]<-cyd
qxx[,"fyll"]<-cyl
b<-coef(xR)
incpt<-matrix(1,NROW(qxx),1)
x<-as.matrix(cbind(incpt,qxx[,names(b)[-1]]))
e<-y-x%*%as.matrix(b)
cs2<-as.numeric(t(e)%*%e/(NROW(x)-NCOL(x)))
cr2<-as.numeric(1-t(e)%*%e/sum((y-mean(y))^2))

#--collect coefficients and their variances--
ov<-summary(xR)
vif<-rbind(vif,vif(xR))
ss<-rbind(ss,diag(ov$cov*cs2))
#--collect robust coef. variances when there is heteroskedasticity--
#eb<-e^2
#x<-as.matrix(cbind(incpt,m9[,names(b)[-1]]))
#hcm<-inv(t(x)%*%x)%*%t(x)%*%diag(eb[1:length(eb)])%*%x%*%inv(t(x)%*%x)
#ss<-rbind(ss,diag(hcm))
beta<-rbind(beta,coef(xR))

#"moralgods","
#"superjh",
#--collect some model diagnostics--
dropt<-c("cereals","gath","plow","hunt",#"anim",
"pigs","milk","bovines","foodscarc","ecorich",
"popdens","pathstress","ncmallow","famsize","localjh",
"fempower","sexratio","money",
"wagelabor","war","himilexp","tree")


#--Ramsey RESET test--
p1<-qchisq(resettest(xR,type="fitted")$"p.value",1,lower.tail=FALSE)
#--Wald test (H0: dropped variables have coefficient equal zero)--
o<-linear.hypothesis(xUR,dropt,test="Chisq")$"Pr(>Chisq)"[2]
p2<-qchisq(o,1,lower.tail=FALSE) #find Chisq with 1 d.f. and same pvalue
#--Heteroskedasticity test (H0: homoskedastic residuals)--
p3<-ncv.test(xR)$ChiSquare
#--Shapiro-Wilke normality test (H0: residuals normal)
p4<-qchisq(shapiro.test(residuals(xR))$p.value,1,lower.tail=FALSE)
#--LaGrange Multiplier test for spatial autocorrelation: language--
o<-lm.LMtests(xR, wmatll, test=c("LMlag"))
p5<-as.numeric(o$LMlag$statistic)
#--LaGrange Multiplier test for spatial autocorrelation: distance--
o<-lm.LMtests(xR, wmatdd, test=c("LMlag"))
p6<-as.numeric(o$LMlag$statistic)
#--model R2--
p7<-cr2
dng<-rbind(dng,cbind(p1,p2,p3,p4,p5,p6,p7,dr2,lr2))

}


#--------------------------------------------
#--Rubin's formulas for combining estimates--
#--------------------------------------------

#--first find final regr. coefs. and p-values--
mnb<-apply(beta,2,mean)
####################vrb<-colSums((beta-t(matrix(mnb,length(mnb),10)))^2)/(nimp-1)
vrb<-colSums((beta-t(matrix(mnb,length(mnb),nimp)))^2)/(nimp-1)
mnv<-apply(ss,2,mean)
vrT<-mnv+vrb*(1-nimp^(-1))
fst<-mnb^2/vrT
r<-(1+nimp^(-1))*vrb/mnv
v<-(nimp-1)*(1+r^(-1))^2
pval<-pf(fst,1,v,lower.tail=FALSE)
bbb<-data.frame(round(cbind(mnb,fst,v,pval),8)) #,3 changed to .8 for significance test
bbb$VIF[2:NROW(bbb)]<-round(apply(vif,2,mean),3)
names(bbb)<-c("coef","Fstat","ddf","pvalue","VIF")

#--Then combine the diagnostics we collected--
dng<-data.frame(dng)
names(dng)<-c("RESET","Wald on restrs.","NCV","SWnormal","lagll","lagdd",
"R2:final model","R2:IV(distance)","R2:IV(language)")
r2<-apply(dng[,7:9],2,mean)
adng<-dng[,1:6]
mdm<-apply(adng,2,mean)
vrd<-colSums((adng-t(matrix(mdm,length(mdm),nimp)))^2)/(nimp-1)
aa<-4*mdm^2-2*vrd
aa[which(aa<0)]<-0
rd<-(1+nimp^(-1))*vrd/(2*mdm+aa^.5)
vd<-(nimp-1)*(1+rd^(-1))^2
Dm<-(mdm-(nimp-1)/(nimp+1)*rd)/(1+rd)
#-All chi-sq we collected have df=1-------
pvald<-pf(Dm,1,vd,lower.tail=FALSE)
ccc<-data.frame(round(cbind(Dm,vd,pvald),3))
names(ccc)<-c("Fstat","df","pvalue")

#--write results to csv file for perusal in spreadsheet--
write.csv("==OLS model for depvar==",file="OLSresults.csv",append=FALSE)
write.csv(bbb,file="OLSresults.csv",append=TRUE)
write.csv(r2,file="OLSresults.csv",append=TRUE)
write.csv(ccc,file="OLSresults.csv",append=TRUE)

aaa<-c(table(depvar), NROW(depvar),depvarname)
imp<-"number of imputations nimp="
impute=c(imp,nimp)

bbb
r2
ccc
bbb<-data.frame(round(cbind(mnb,fst,v,pval),3)) #.8 changed to back to .3 for significance test
bbb$VIF[2:NROW(bbb)]<-round(apply(vif,2,mean),3)
bbb
aaa
impute
load("world_countries_24.rda",.GlobalEnv)
zdv<-which(!is.na(depvar))
dep_var<-depvar[zdv]
dep_var<-dep_var+1
table(dep_var)
depvarname<-"Moral gos v238"
load("world_countries_24.rda",.GlobalEnv)
sccs=SCCS
splgt<-SpatialPointsDataFrame(coordinates(sccs[zdv,c("longitud","latitude")]),data.frame(dep_var)) 
brks<-quantile(dep_var,c(0,.333,.666,1))
cols<-colorRampPalette(c("yellow", "brown"))(length(brks)-1)
plot(world_countries,col="white") #black")
plot(splgt,pch=21,add=TRUE,cex=dep_var^.25,col="red", bg=cols[findInterval(dep_var, brks, all.inside=TRUE)])
mtext(depvarname,line=-2, side=1,cex=.5) #7)
splgt<-SpatialPointsDataFrame(coordinates(sccs[zdv,c("longitud","latitude")]),data.frame(dep_var)) 
brks<-quantile(dep_var,c(0,.333,.666,1))
cols<-colorRampPalette(c("yellow", "brown"))(length(brks)-1)
#jpeg(file="473-475mapValue_of_Boys.jpg",width=8,height=5,units="in",pointsize=8,res=600)
plot(world_countries,col="white") #black")
plot(splgt,pch=21,add=TRUE,cex=dep_var^.25,col="red", bg=cols[findInterval(dep_var, brks, all.inside=TRUE)])
mtext(depvarname,line=-2, side=1,cex=.5) #7)
# dev.off()

BBB

                    coef     Fstat         ddf     pvalue   VIF
(Intercept)   1.89248661  3.613905   3603.4752 0.05737812    NA
fydd          0.90021643 29.043620 414121.5596 0.00000007 2.576
fyll         -0.91368363  3.886237 243774.2137 0.04868451 2.533
pastoralExch  0.40723873  1.608959   1774.2132 0.20480459 1.377
PCAP         -0.03579839  2.789466   6407.9520 0.09493466 1.181
PCsize        0.16096145  5.873339    476.4816 0.01574332 1.545
milk          0.46745040  4.474213 137606.3445 0.03441185 2.314
foodstress    0.20411571  4.644223    792.9312 0.03145866 1.135
eextwar      -0.03139114  8.096095    858.2568 0.00454169 1.167
bridewealth   0.27131665  2.769119   1074.0917 0.09639072 1.345
caststratLGd  0.61956346  3.365172   1722.5442 0.06676103 1.331
PCvioIntr    -0.21418460  1.821413    196.9496 0.17869444 1.151
>  r2
 R2:final model R2:IV(distance) R2:IV(language) 
      0.5027403       0.9934338       0.9849926 
>  ccc
                Fstat         df pvalue
RESET           0.460  27754.259  0.498
Wald on restrs. 0.453     34.158  0.506
NCV             2.966  52593.177  0.085
SWnormal        6.656    364.615  0.010
lagll           1.391   6298.024  0.238
lagdd           1.071 610670.388  0.301
>  bbb<-data.frame(round(cbind(mnb,fst,v,pval),3)) #.8 changed to back to .3 for significance test
>  bbb$VIF[2:NROW(bbb)]<-round(apply(vif,2,mean),3)
>  bbb
                mnb    fst          v  pval   VIF
(Intercept)   1.892  3.614   3603.475 0.057    NA
fydd          0.900 29.044 414121.560 0.000 2.576
fyll         -0.914  3.886 243774.214 0.049 2.533
pastoralExch  0.407  1.609   1774.213 0.205 1.377
PCAP         -0.036  2.789   6407.952 0.095 1.181
PCsize        0.161  5.873    476.482 0.016 1.545
milk          0.467  4.474 137606.344 0.034 2.314
foodstress    0.204  4.644    792.931 0.031 1.135
eextwar      -0.031  8.096    858.257 0.005 1.167
bridewealth   0.271  2.769   1074.092 0.096 1.345
caststratLGd  0.620  3.365   1722.544 0.067 1.331
PCvioIntr    -0.214  1.821    196.950 0.179 1.15
         1           2           3           4             
      "68"        "47"        "13"        "40"       "168" "MoralGods"

6A| needs new_sccs.Rdata pastoralExch BUT doesnt knock out milking! WORKING! Moral gods v238 EvilEye NOT DICHOTOMIZED MONEY v155 >1 >3 >4

Used Error messages for Eff and Dow 2009 + }

  • e.g., Error in linearHypothesis.lm(...) :
there are aliased coefficients in the model.
Remedy coef(xUR): showed NA for #roots, cereals, pigs, bovines, tree, SUSPICIOUS BECAUSE THE SAME FOR EduMod54!!

pastoralExch=((SCCS$v208==1)*1)*(SCCS$v858==6)*1

#Program 1 --> Program 2 below
#Program 1 Part A
#MI--make the imputed datasets
#--change the following path to the directory with your data and program--
setwd("C:/My Documents/MI")
rm(list=ls(all=TRUE))
options(echo=TRUE)
#--you need the following two packages--you must install them first--
library(foreign)
library(mice)
library(tripack)
library(zoo)
library(sp)
library(maptools)
library(spam)
#--for program 2 below
library(spdep)
library(car)
library(lmtest)
library(sandwich)

#--To find the citation for a package, use this function:---
citation("mice")

#-----------------------------
#--Read in data, rearrange----
#-----------------------------

#--Read in auxiliary variables---
load("vaux.Rdata",.GlobalEnv)
row.names(vaux)<-NULL
#--Read in the SCCS dataset---
load("SCCS.Rdata",.GlobalEnv)

#--look at first 6 rows of vaux--
head(vaux)
#--look at field names of vaux--
names(vaux)
#--check to see that rows are properly aligned in the two datasets--
#--sum should equal 186---
sum((SCCS$socname==vaux$socname)*1)
#--remove the society name field--
vaux<-vaux[,-28]
names(vaux)

#--Two nominal variables: brg and rlg----
#--brg: consolidated Burton  Regions-----
#0 = (rest of world) circumpolar, South and Meso-America, west North America
#1 = Subsaharan Africa
#2 = Middle Old World
#3 = Southeast Asia, Insular Pacific, Sahul
#4 = Eastern Americas
#--rlg: Religion---
#'0 (no world religion)'  
#'1 (Christianity)'  
#'2 (Islam)'  
#'3 (Hindu/Buddhist)'  

#--check to see number of missing values in vaux, 
#--whether variables are numeric,
#--and number of discrete values for each variable---
vvn<-names(vaux)
pp<-NULL
for (i in 1:length(vvn)){
nmiss<-length(which(is.na(vaux[,vvn[i]])))
numeric<-is.numeric(vaux[,vvn[i]])
numDiscrVals<-length(table(vaux[,vvn[i]]))
pp<-rbind(pp,cbind(data.frame(numeric),nmiss,numDiscrVals))
}
row.names(pp)<-vvn
pp

#MODIFY THESE STATEMENTS FOR A NEW PROJECT
#--extract variables to be used from SCCS, put in dataframe fx--
fx<-data.frame(
socname=SCCS$socname,socID=SCCS$"sccs#",
pastoralExch=((SCCS$v208==1)*1)*(SCCS$v858==6)*1,
PCvioHomi=SCCS$v1665,   ### PCvioHomi PCvioAslt PCvioIntr PCvioTotl
PCvioAslt=SCCS$v1666,
PCvioIntr=SCCS$v666,
#PCvioTotl=SCCS$v666+SCCS$v1666+SCCS$v1665,
extwar=SCCS$v892,
classtrat=SCCS$v270,
caststrat=SCCS$v272,
anim=SCCS$v206,
anim2=log(1+SCCS$v206),         #^2,
anim_log=log(1+SCCS$v206),
milk=(SCCS$v245>1)*1,
milkedanim=SCCS$v206*SCCS$v206,
bridewealth=(SCCS$v208==1)*1,
money=SCCS$v17,
money2=(SCCS$v155>1)*1+(SCCS$v155>3)*1+(SCCS$v155>4)*1,
extwar2=SCCS$v892^2,
caststratLGd=log(1+SCCS$v272),    #^2,
#moralgods=SCCS$v238,
#moralgods2=(SCCS$v238)^2,
PCsize=SCCS$v237,
PCAP=SCCS$v921,
PCsize2=(SCCS$v237)^2, 
eextwar=SCCS$v1650,
valchild=(SCCS$v473+SCCS$v474+SCCS$v475+SCCS$v476),
fratgrpstr=SCCS$v570,
marrcaptives=SCCS$v870,
plunder=SCCS$v912, ##2009 depvars
pre_mar_sex=SCCS$v167, foodstress=SCCS$v678,
femctrldwellg=SCCS$v591,
wealthy=SCCS$v1721,
poor=SCCS$v1723,
war679=SCCS$v679,
###climate<-(SCCS$v857==1 | SCCS$v857==2 | SCCS$v857==6)*1+(SCCS$v857==3 | SCCS$v857==4)*2+(SCCS$v857==5)*3,
nonmatrel=SCCS$v52,
lrgfam=SCCS$v68,
exogamy=SCCS$v72,
famsize=SCCS$v80,
popdens=SCCS$v156,
malesexag=SCCS$v175,
ndrymonth=SCCS$v196,
gath=SCCS$v203,
hunt=SCCS$v204,
fish=SCCS$v205,
nuclearfam=(SCCS$v210<=3)*1,
ncmallow=SCCS$v227,
cultints=SCCS$v232,
tree=(SCCS$v233==4)*1,
roots=(SCCS$v233==5)*1,
cereals=(SCCS$v233==6)*1,
settype=SCCS$v234,
localjh=(SCCS$v236-1),
#superjh=SCCS$v237,
segadlboys=SCCS$v242,
plow=(SCCS$v243>1)*1,
pigs=(SCCS$v244==2)*1,
bovines=(SCCS$v244==7)*1,
agrlateboy=SCCS$v300,
fempower=SCCS$v663,
migr=(SCCS$v677==2)*1,
foodtrade=SCCS$v819,
dateobs=SCCS$v838,
rain=SCCS$v854,
temp=SCCS$v855,
#ecorich=SCCS$v857,
ecorich=(sccs$v857==3|sccs$v857==4)*1+(sccs$v857==5)*2
pctFemPolyg=SCCS$v872,
femsubs=SCCS$v890,
himilexp=(SCCS$v899==1)*1,
AP1=SCCS$v921,
AP2=SCCS$v928,
pathstress=SCCS$v1260,
war=SCCS$v1648,
foodscarc=SCCS$v1685,
sexratio=1+(SCCS$v1689>85)+(SCCS$v1689>115),
wagelabor=SCCS$v1732,
CVrain=SCCS$v1914/SCCS$v1913
) 
#source("C:/My Documents/MI/renormalize.R")
#SCCS = normalize_data(SCCS)
# fx = normalize_data(fx)
#Verify fx works. The finish running the rest of the script.
After that SCCS is no longer used except in the eff_dow2 script where it is

loaded to define dep_var. If you need to normalize dep_var you can add the following line after dep_var is defined in the eff_dow 2 script:

#dep_var = normalize_probit(dep_var)
#Delete:
#new_sccs = SCCS
#save(new_sccs,file="new_sccs.Rdata")
load("SCCS.Rdata",.GlobalEnv)


#--look at first 6 rows of fx--
head(fx)

#--check to see number of missing values--
#--also check whether numeric--
vvn<-names(fx)
pp<-NULL
for (i in 1:length(vvn)){
nmiss<-length(which(is.na(fx[,vvn[i]])))
numeric<-is.numeric(fx[,vvn[i]])
pp<-rbind(pp,cbind(nmiss,data.frame(numeric)))
}
row.names(pp)<-vvn
pp

#--identify variables with missing values--
z<-which(pp[,1]>0)
zv1<-vvn[z]
zv1
#--identify variables with non-missing values--
z<-which(pp[,1]==0)
zv2<-vvn[z]
zv2
  



#Program 1 Part B
#-----------------------------
#----Multiple imputation------
#-----------------------------

#--number of imputed data sets to create--
#nimp<-10 #CHANGED TO TEST SPEEDUP  
nimp<-3  ################################################################## speedup test
#--one at a time, loop through those variables with missing values--
for (i in 1:length(zv1)){
#--attach the imputand to the auxiliary data--
zxx<-data.frame(cbind(vaux,fx[,zv1[i]]))
#--in the following line, the imputation is done--
aqq<-complete(mice(zxx,maxit=20,m=nimp),action="long")
###aqq<-complete(mice(zxx,maxit=100,m=nimp),action="long")
#--during first iteration of the loop, create dataframe impdat--
if (i==1){
impdat<-data.frame(aqq[,c(".id",".imp")])
}
#--the imputand is placed as a field in impdat and named--
impdat<-cbind(impdat,data.frame(aqq[,NCOL(zxx)]))
names(impdat)[NCOL(impdat)]<-zv1[i]
}

#--now the non-missing variables are attached to impdat--
gg<-NULL
for (i in 1:nimp){
gg<-rbind(gg,data.frame(fx[,zv2]))
}
impdat<-cbind(impdat,gg)

#--take a look at the top 6 and bottom 6 rows of impdat--
head(impdat)
tail(impdat)

#--impdat is saved as an R-format data file--
save(impdat,file="impdat.Rdata")


 
 

#Program 2 (12-18-2009)==
#MI--estimate model, combine results

rm(list=ls(all=TRUE))
#--Set path to your directory with data and program--
setwd("C:/My Documents/MI")
options(echo=TRUE)

#--need these packages for estimation and diagnostics--
library(foreign)
library(spdep)
library(car)
library(lmtest)
library(sandwich)

#-----------------------------
#--Read in data, rearrange----
#-----------------------------

#--Read in original SCCS data---
#load("SCCS.Rdata",.GlobalEnv)
load("new_sccs.Rdata",.GlobalEnv)
SCCS=new_sccs
load("SCCS.Rdata",.GlobalEnv)


#--Read in two weight matrices--
ll<-as.matrix(read.dta("langwm.dta")[,-1])
dd<-as.matrix(read.dta("dist25wm.dta")[,c(-1,-2,-189)])
#--Read in the imputed dataset---
load("impdat.Rdata",.GlobalEnv)

#--create dep.varb. you wish to use from SCCS data--
#--Here we sum variables measuring how much a society values children--
#depvar<-apply(SCCS[,c("v473","v474","v475","v476")],1,sum) #can replace "sum" with "max"
#depvar<-SCCS$v1188    #v1188+SCCS$v1189
depvar<-SCCS$v238
#--find obs. for which dep. varb. is non-missing--
zdv<-which(!is.na(depvar))
depvar<-depvar[zdv]
#source("C:/My Documents/MI/normalize_probit.R")
#depvar = normalize_probit(depvar)
#HERE GIVE THE "NAME" OF THE DEPENDENT VARIABLE THAT IS COMPUTED
depvarname<-"MoralGods"
#--can add additional SCCS variable, but only if it has no missing values---
dateobs<-SCCS$v838
dateobs<-dateobs[zdv]

#--look at histogram and frequencies for the dep. varb.--
hist(depvar)
table(depvar)

#--modify weight matrices---
#--set diagonal equal to zeros--
diag(ll)<-0
diag(dd)<-0
#--use only obs. where dep. varb. non-missing--
ll<-ll[zdv,zdv]
dd<-dd[zdv,zdv]
#--row standardize (rows sum to one)
ll<-ll/rowSums(ll)
dd<-dd/rowSums(dd)
#--check to see that rows sum to one
rowSums(ll)
rowSums(dd)
#--make weight matrix object for later autocorrelation test--
wmatll<-mat2listw(as.matrix(ll))
wmatdd<-mat2listw(as.matrix(dd))

#"moralgods","moralgods2",
indpv<-c("pastoralExch",
"pre_mar_sex", "money", "foodstress", "femctrldwellg",
"wealthy","poor","PCvioHomi","PCvioAslt","PCvioIntr",#"PCvioTotl",
"milkedanim","pctFemPolyg",
"anim2","money2","bridewealth","caststratLGd",
#","classtrat "PCAP",
"PCsize",
"PCsize2",
#"caststrat","eextwar", 
"femsubs","foodscarc",
"fratgrpstr","marrcaptives","plunder",###"climate",
"exogamy","ncmallow",#"superjh",
"fempower","sexratio",
"war","himilexp","wagelabor",
"famsize","settype","localjh",
"cultints","roots","cereals","gath","hunt","fish",
"anim","pigs","milk","plow","bovines","tree","foodtrade",
"ndrymonth","ecorich",
"popdens","pathstress","CVrain","rain","temp","AP1","AP2")


#-----------------------------------------------------
#---Estimate model on each imputed dataset------------
#-----------------------------------------------------

#--number of imputed datasets--
#nimp<-10
nimp<-3  ################################################################## speedup test

#--will append values to these empty objects--
vif<-NULL
ss<-NULL
beta<-NULL
dng<-NULL

#--loop through the imputed datasets--
for (i in 1:nimp){

#--select the ith imputed dataset--
m9<-impdat[which(impdat$.imp==i),]
#--retain only obs. for which dep. varb. is nonmissing--
m9<-m9[zdv,]

#--create spatially lagged dep. varbs.--
y<-as.matrix(depvar)
xx<-as.matrix(m9[,indpv])
#--for instruments we use the spatial lag of our indep. varbs.--
#--First, the spatially lagged varb. for distance--
xdy<-dd%*%xx
cyd<-dd%*%y
o<-lm(cyd~xdy)
#--the fitted value is our instrumental variable--
fydd<-fitted(o)
#--keep R2 from this regression--
dr2<-summary(o)$r.squared
#--Then, the spatially lagged varb. for language--
xly<-ll%*%xx   
cyl<-ll%*%y
o<-lm(cyl~xly)
#--the fitted value is our instrumental variable--
fyll<-fitted(o)
#--keep R2 from this regression--
lr2<-summary(o)$r.squared
m9<-cbind(m9,fydd,fyll)

#--OLS estimate of unrestricted model--
xUR<-lm(depvar~fyll+fydd+
pastoralExch+
PCvioHomi+PCvioAslt+PCvioIntr+
milkedanim+pctFemPolyg+
#anim2+
caststratLGd+money2+bridewealth+
##moralgods+moralgods2+  ##classtrat+
PCAP+
PCsize+
PCsize2+
caststrat+eextwar+
pre_mar_sex+money+foodstress+femctrldwellg+
poor+wealthy+
fratgrpstr+marrcaptives+plunder+###climate+
cultints+roots+cereals+gath+plow+
hunt+fish+
#anim+
pigs+milk+bovines+tree+foodtrade+foodscarc+
ecorich+popdens+pathstress+exogamy+ncmallow+famsize+
settype+localjh+
fempower+femsubs+ #superjh+
sexratio+war+himilexp+money+wagelabor
,data=m9)


xR<-lm(depvar~fydd+fyll+
pastoralExch+
#PCvioHomi+PCvioAslt+
#milkedanim+ ##pctFemPolyg+
PCAP+
PCsize+
#PCsize2+    NA for some reason
milk+
foodstress+
eextwar+ 
bridewealth+
caststratLGd+
PCvioIntr
#anim2+
#money2+
##moralgods+moralgods2+  
#classtrat+##extwar+
#pre_mar_sex+money+
#femctrldwellg+
#poor+wealthy+
#fratgrpstr+
#marrcaptives+plunder+###climate+
#cultints+roots+cereals+gath+
#plow+
#hunt+fish+
#anim+
#pigs+milk+bovines+tree+foodtrade+foodscarc+
#ecorich+popdens+pathstress+exogamy+ncmallow+famsize+
#settype+localjh+
#fempower+femsubs+ #superjh+
#sexratio+war+
#himilexp #+money+wagelabor
,data=m9)


#--corrected sigma2 and R2 for 2SLS--
qxx<-m9
qxx[,"fydd"]<-cyd
qxx[,"fyll"]<-cyl
b<-coef(xR)
incpt<-matrix(1,NROW(qxx),1)
x<-as.matrix(cbind(incpt,qxx[,names(b)[-1]]))
e<-y-x%*%as.matrix(b)
cs2<-as.numeric(t(e)%*%e/(NROW(x)-NCOL(x)))
cr2<-as.numeric(1-t(e)%*%e/sum((y-mean(y))^2))

#--collect coefficients and their variances--
ov<-summary(xR)
vif<-rbind(vif,vif(xR))
ss<-rbind(ss,diag(ov$cov*cs2))
#--collect robust coef. variances when there is heteroskedasticity--
#eb<-e^2
#x<-as.matrix(cbind(incpt,m9[,names(b)[-1]]))
#hcm<-inv(t(x)%*%x)%*%t(x)%*%diag(eb[1:length(eb)])%*%x%*%inv(t(x)%*%x)
#ss<-rbind(ss,diag(hcm))
beta<-rbind(beta,coef(xR))

#"moralgods","
#"superjh",
#--collect some model diagnostics--
dropt<-c("cereals","gath","plow","hunt",#"anim",
"pigs","milk","bovines","foodscarc","ecorich",
"popdens","pathstress","ncmallow","famsize","localjh",
"fempower","sexratio","money",
"wagelabor","war","himilexp","tree")


#--Ramsey RESET test--
p1<-qchisq(resettest(xR,type="fitted")$"p.value",1,lower.tail=FALSE)
#--Wald test (H0: dropped variables have coefficient equal zero)--
o<-linear.hypothesis(xUR,dropt,test="Chisq")$"Pr(>Chisq)"[2]
p2<-qchisq(o,1,lower.tail=FALSE) #find Chisq with 1 d.f. and same pvalue
#--Heteroskedasticity test (H0: homoskedastic residuals)--
p3<-ncv.test(xR)$ChiSquare
#--Shapiro-Wilke normality test (H0: residuals normal)
p4<-qchisq(shapiro.test(residuals(xR))$p.value,1,lower.tail=FALSE)
#--LaGrange Multiplier test for spatial autocorrelation: language--
o<-lm.LMtests(xR, wmatll, test=c("LMlag"))
p5<-as.numeric(o$LMlag$statistic)
#--LaGrange Multiplier test for spatial autocorrelation: distance--
o<-lm.LMtests(xR, wmatdd, test=c("LMlag"))
p6<-as.numeric(o$LMlag$statistic)
#--model R2--
p7<-cr2
dng<-rbind(dng,cbind(p1,p2,p3,p4,p5,p6,p7,dr2,lr2))

}


#--------------------------------------------
#--Rubin's formulas for combining estimates--
#--------------------------------------------

#--first find final regr. coefs. and p-values--
mnb<-apply(beta,2,mean)
####################vrb<-colSums((beta-t(matrix(mnb,length(mnb),10)))^2)/(nimp-1)
vrb<-colSums((beta-t(matrix(mnb,length(mnb),nimp)))^2)/(nimp-1)
mnv<-apply(ss,2,mean)
vrT<-mnv+vrb*(1-nimp^(-1))
fst<-mnb^2/vrT
r<-(1+nimp^(-1))*vrb/mnv
v<-(nimp-1)*(1+r^(-1))^2
pval<-pf(fst,1,v,lower.tail=FALSE)
bbb<-data.frame(round(cbind(mnb,fst,v,pval),8)) #,3 changed to .8 for significance test
bbb$VIF[2:NROW(bbb)]<-round(apply(vif,2,mean),3)
names(bbb)<-c("coef","Fstat","ddf","pvalue","VIF")

#--Then combine the diagnostics we collected--
dng<-data.frame(dng)
names(dng)<-c("RESET","Wald on restrs.","NCV","SWnormal","lagll","lagdd",
"R2:final model","R2:IV(distance)","R2:IV(language)")
r2<-apply(dng[,7:9],2,mean)
adng<-dng[,1:6]
mdm<-apply(adng,2,mean)
vrd<-colSums((adng-t(matrix(mdm,length(mdm),nimp)))^2)/(nimp-1)
aa<-4*mdm^2-2*vrd
aa[which(aa<0)]<-0
rd<-(1+nimp^(-1))*vrd/(2*mdm+aa^.5)
vd<-(nimp-1)*(1+rd^(-1))^2
Dm<-(mdm-(nimp-1)/(nimp+1)*rd)/(1+rd)
#-All chi-sq we collected have df=1-------
pvald<-pf(Dm,1,vd,lower.tail=FALSE)
ccc<-data.frame(round(cbind(Dm,vd,pvald),3))
names(ccc)<-c("Fstat","df","pvalue")

#--write results to csv file for perusal in spreadsheet--
write.csv("==OLS model for depvar==",file="OLSresults.csv",append=FALSE)
write.csv(bbb,file="OLSresults.csv",append=TRUE)
write.csv(r2,file="OLSresults.csv",append=TRUE)
write.csv(ccc,file="OLSresults.csv",append=TRUE)

aaa<-c(table(depvar), NROW(depvar),depvarname)
imp<-"number of imputations nimp="
impute=c(imp,nimp)

bbb
r2
ccc
bbb<-data.frame(round(cbind(mnb,fst,v,pval),3)) #.8 changed to back to .3 for significance test
bbb$VIF[2:NROW(bbb)]<-round(apply(vif,2,mean),3)
bbb
aaa
impute
load("world_countries_24.rda",.GlobalEnv)
zdv<-which(!is.na(depvar))
dep_var<-depvar[zdv]
dep_var<-dep_var+1
table(dep_var)
depvarname<-"Moral gos v238"
load("world_countries_24.rda",.GlobalEnv)
sccs=SCCS
splgt<-SpatialPointsDataFrame(coordinates(sccs[zdv,c("longitud","latitude")]),data.frame(dep_var)) 
brks<-quantile(dep_var,c(0,.333,.666,1))
cols<-colorRampPalette(c("yellow", "brown"))(length(brks)-1)
plot(world_countries,col="white") #black")
plot(splgt,pch=21,add=TRUE,cex=dep_var^.25,col="red", bg=cols[findInterval(dep_var, brks, all.inside=TRUE)])
mtext(depvarname,line=-2, side=1,cex=.5) #7)
splgt<-SpatialPointsDataFrame(coordinates(sccs[zdv,c("longitud","latitude")]),data.frame(dep_var)) 
brks<-quantile(dep_var,c(0,.333,.666,1))
cols<-colorRampPalette(c("yellow", "brown"))(length(brks)-1)
#jpeg(file="473-475mapValue_of_Boys.jpg",width=8,height=5,units="in",pointsize=8,res=600)
plot(world_countries,col="white") #black")
plot(splgt,pch=21,add=TRUE,cex=dep_var^.25,col="red", bg=cols[findInterval(dep_var, brks, all.inside=TRUE)])
mtext(depvarname,line=-2, side=1,cex=.5) #7)
# dev.off()

6A| needs NO new_sccs.Rdata pastoralExch BUT doesnt knock out milking! WORKING! Moral gods v238 EvilEye NOT DICHOTOMIZED MONEY v155 >1 >3 >4

Used Error messages for Eff and Dow 2009 + }

  • e.g., Error in linearHypothesis.lm(...) :
there are aliased coefficients in the model.
Remedy coef(xUR): showed NA for #roots, cereals, pigs, bovines, tree, SUSPICIOUS BECAUSE THE SAME FOR EduMod54!!

pastoralExch=((SCCS$v208==1)*1)*(SCCS$v858==6)*1

#Program 1 --> Program 2 below
#Program 1 Part A
#MI--make the imputed datasets
#--change the following path to the directory with your data and program--
setwd("C:/My Documents/MI")
rm(list=ls(all=TRUE))
options(echo=TRUE)
#--you need the following two packages--you must install them first--
library(foreign)
library(mice)
library(tripack)
library(zoo)
library(sp)
library(maptools)
library(spam)
#--for program 2 below
library(spdep)
library(car)
library(lmtest)
library(sandwich)

#--To find the citation for a package, use this function:---
citation("mice")

#-----------------------------
#--Read in data, rearrange----
#-----------------------------

#--Read in auxiliary variables---
load("vaux.Rdata",.GlobalEnv)
row.names(vaux)<-NULL
#--Read in the SCCS dataset---
load("SCCS.Rdata",.GlobalEnv)

#--look at first 6 rows of vaux--
head(vaux)
#--look at field names of vaux--
names(vaux)
#--check to see that rows are properly aligned in the two datasets--
#--sum should equal 186---
sum((SCCS$socname==vaux$socname)*1)
#--remove the society name field--
vaux<-vaux[,-28]
names(vaux)

#--Two nominal variables: brg and rlg----
#--brg: consolidated Burton  Regions-----
#0 = (rest of world) circumpolar, South and Meso-America, west North America
#1 = Subsaharan Africa
#2 = Middle Old World
#3 = Southeast Asia, Insular Pacific, Sahul
#4 = Eastern Americas
#--rlg: Religion---
#'0 (no world religion)'  
#'1 (Christianity)'  
#'2 (Islam)'  
#'3 (Hindu/Buddhist)'  

#--check to see number of missing values in vaux, 
#--whether variables are numeric,
#--and number of discrete values for each variable---
vvn<-names(vaux)
pp<-NULL
for (i in 1:length(vvn)){
nmiss<-length(which(is.na(vaux[,vvn[i]])))
numeric<-is.numeric(vaux[,vvn[i]])
numDiscrVals<-length(table(vaux[,vvn[i]]))
pp<-rbind(pp,cbind(data.frame(numeric),nmiss,numDiscrVals))
}
row.names(pp)<-vvn
pp

#MODIFY THESE STATEMENTS FOR A NEW PROJECT
#--extract variables to be used from SCCS, put in dataframe fx--
fx<-data.frame(
socname=SCCS$socname,socID=SCCS$"sccs#",
pastoralExch=((SCCS$v208==1)*1)*(SCCS$v858==6)*1,
PCvioHomi=SCCS$v1665,   ### PCvioHomi PCvioAslt PCvioIntr PCvioTotl
PCvioAslt=SCCS$v1666,
PCvioIntr=SCCS$v666,
#PCvioTotl=SCCS$v666+SCCS$v1666+SCCS$v1665,
extwar=SCCS$v892,
classtrat=SCCS$v270,
caststrat=SCCS$v272,
anim=SCCS$v206,
anim2=log(1+SCCS$v206),         #^2,
anim_log=log(1+SCCS$v206),
milk=(SCCS$v245>1)*1,
milkedanim=SCCS$v206*SCCS$v206,
bridewealth=(SCCS$v208==1)*1,
money=SCCS$v17,
money2=(SCCS$v155>1)*1+(SCCS$v155>3)*1+(SCCS$v155>4)*1,
extwar2=SCCS$v892^2,
caststratLGd=log(1+SCCS$v272),    #^2,
#moralgods=SCCS$v238,
#moralgods2=(SCCS$v238)^2,
PCsize=SCCS$v237,
PCAP=SCCS$v921,
PCsize2=(SCCS$v237)^2, 
eextwar=SCCS$v1650,
valchild=(SCCS$v473+SCCS$v474+SCCS$v475+SCCS$v476),
fratgrpstr=SCCS$v570,
marrcaptives=SCCS$v870,
plunder=SCCS$v912, ##2009 depvars
pre_mar_sex=SCCS$v167, foodstress=SCCS$v678,
femctrldwellg=SCCS$v591,
wealthy=SCCS$v1721,
poor=SCCS$v1723,
war679=SCCS$v679,
###climate<-(SCCS$v857==1 | SCCS$v857==2 | SCCS$v857==6)*1+(SCCS$v857==3 | SCCS$v857==4)*2+(SCCS$v857==5)*3,
nonmatrel=SCCS$v52,
lrgfam=SCCS$v68,
exogamy=SCCS$v72,
famsize=SCCS$v80,
popdens=SCCS$v156,
malesexag=SCCS$v175,
ndrymonth=SCCS$v196,
gath=SCCS$v203,
hunt=SCCS$v204,
fish=SCCS$v205,
nuclearfam=(SCCS$v210<=3)*1,
ncmallow=SCCS$v227,
cultints=SCCS$v232,
tree=(SCCS$v233==4)*1,
roots=(SCCS$v233==5)*1,
cereals=(SCCS$v233==6)*1,
settype=SCCS$v234,
localjh=(SCCS$v236-1),
#superjh=SCCS$v237,
segadlboys=SCCS$v242,
plow=(SCCS$v243>1)*1,
pigs=(SCCS$v244==2)*1,
bovines=(SCCS$v244==7)*1,
agrlateboy=SCCS$v300,
fempower=SCCS$v663,
migr=(SCCS$v677==2)*1,
foodtrade=SCCS$v819,
dateobs=SCCS$v838,
rain=SCCS$v854,
temp=SCCS$v855,
#ecorich=SCCS$v857,
ecorich=(SCCS$v857==3|SCCS$v857==4)*1+(SCCS$v857==5)*2,
pctFemPolyg=SCCS$v872,
femsubs=SCCS$v890,
himilexp=(SCCS$v899==1)*1,
AP1=SCCS$v921,
AP2=SCCS$v928,
pathstress=SCCS$v1260,
war=SCCS$v1648,
foodscarc=SCCS$v1685,
sexratio=1+(SCCS$v1689>85)+(SCCS$v1689>115),
wagelabor=SCCS$v1732,
CVrain=SCCS$v1914/SCCS$v1913
) 
#source("C:/My Documents/MI/renormalize.R")
#SCCS = normalize_data(SCCS)
# fx = normalize_data(fx)
#Verify fx works. The finish running the rest of the script.
After that SCCS is no longer used except in the eff_dow2 script where it is

loaded to define dep_var. If you need to normalize dep_var you can add the following line after dep_var is defined in the eff_dow 2 script:

#dep_var = normalize_probit(dep_var)
#Delete:
#new_sccs = SCCS
#save(new_sccs,file="new_sccs.Rdata")
load("SCCS.Rdata",.GlobalEnv)


#--look at first 6 rows of fx--
head(fx)

#--check to see number of missing values--
#--also check whether numeric--
vvn<-names(fx)
pp<-NULL
for (i in 1:length(vvn)){
nmiss<-length(which(is.na(fx[,vvn[i]])))
numeric<-is.numeric(fx[,vvn[i]])
pp<-rbind(pp,cbind(nmiss,data.frame(numeric)))
}
row.names(pp)<-vvn
pp

#--identify variables with missing values--
z<-which(pp[,1]>0)
zv1<-vvn[z]
zv1
#--identify variables with non-missing values--
z<-which(pp[,1]==0)
zv2<-vvn[z]
zv2
  



#Program 1 Part B
#-----------------------------
#----Multiple imputation------
#-----------------------------

#--number of imputed data sets to create--
#nimp<-10 #CHANGED TO TEST SPEEDUP  
nimp<-3  ################################################################## speedup test
#--one at a time, loop through those variables with missing values--
for (i in 1:length(zv1)){
#--attach the imputand to the auxiliary data--
zxx<-data.frame(cbind(vaux,fx[,zv1[i]]))
#--in the following line, the imputation is done--
aqq<-complete(mice(zxx,maxit=20,m=nimp),action="long")
###aqq<-complete(mice(zxx,maxit=100,m=nimp),action="long")
#--during first iteration of the loop, create dataframe impdat--
if (i==1){
impdat<-data.frame(aqq[,c(".id",".imp")])
}
#--the imputand is placed as a field in impdat and named--
impdat<-cbind(impdat,data.frame(aqq[,NCOL(zxx)]))
names(impdat)[NCOL(impdat)]<-zv1[i]
}

#--now the non-missing variables are attached to impdat--
gg<-NULL
for (i in 1:nimp){
gg<-rbind(gg,data.frame(fx[,zv2]))
}
impdat<-cbind(impdat,gg)

#--take a look at the top 6 and bottom 6 rows of impdat--
head(impdat)
tail(impdat)

#--impdat is saved as an R-format data file--
save(impdat,file="impdat.Rdata")


 
 

#Program 2 (12-18-2009)==
#MI--estimate model, combine results

rm(list=ls(all=TRUE))
#--Set path to your directory with data and program--
setwd("C:/My Documents/MI")
options(echo=TRUE)

#--need these packages for estimation and diagnostics--
library(foreign)
library(spdep)
library(car)
library(lmtest)
library(sandwich)

#-----------------------------
#--Read in data, rearrange----
#-----------------------------

#--Read in original SCCS data---
#load("SCCS.Rdata",.GlobalEnv)
#load("new_sccs.Rdata",.GlobalEnv)
#SCCS=new_sccs
load("SCCS.Rdata",.GlobalEnv)


#--Read in two weight matrices--
ll<-as.matrix(read.dta("langwm.dta")[,-1])
dd<-as.matrix(read.dta("dist25wm.dta")[,c(-1,-2,-189)])
#--Read in the imputed dataset---
load("impdat.Rdata",.GlobalEnv)

#--create dep.varb. you wish to use from SCCS data--
#--Here we sum variables measuring how much a society values children--
#depvar<-apply(SCCS[,c("v473","v474","v475","v476")],1,sum) #can replace "sum" with "max"
#depvar<-SCCS$v1188    #v1188+SCCS$v1189
depvar<-SCCS$v238
#--find obs. for which dep. varb. is non-missing--
zdv<-which(!is.na(depvar))
depvar<-depvar[zdv]
#source("C:/My Documents/MI/normalize_probit.R")
#depvar = normalize_probit(depvar)
#HERE GIVE THE "NAME" OF THE DEPENDENT VARIABLE THAT IS COMPUTED
depvarname<-"MoralGods"
#--can add additional SCCS variable, but only if it has no missing values---
dateobs<-SCCS$v838
dateobs<-dateobs[zdv]

#--look at histogram and frequencies for the dep. varb.--
hist(depvar)
table(depvar)

#--modify weight matrices---
#--set diagonal equal to zeros--
diag(ll)<-0
diag(dd)<-0
#--use only obs. where dep. varb. non-missing--
ll<-ll[zdv,zdv]
dd<-dd[zdv,zdv]
#--row standardize (rows sum to one)
ll<-ll/rowSums(ll)
dd<-dd/rowSums(dd)
#--check to see that rows sum to one
rowSums(ll)
rowSums(dd)
#--make weight matrix object for later autocorrelation test--
wmatll<-mat2listw(as.matrix(ll))
wmatdd<-mat2listw(as.matrix(dd))

#"moralgods","moralgods2",
indpv<-c("pastoralExch",
"pre_mar_sex", "money", "foodstress", "femctrldwellg",
"wealthy","poor","PCvioHomi","PCvioAslt","PCvioIntr",#"PCvioTotl",
"milkedanim","pctFemPolyg",
"anim2","money2","bridewealth","caststratLGd",
#","classtrat "PCAP",
"PCsize",
"PCsize2",
#"caststrat","eextwar", 
"femsubs","foodscarc",
"fratgrpstr","marrcaptives","plunder",###"climate",
"exogamy","ncmallow",#"superjh",
"fempower","sexratio",
"war","himilexp","wagelabor",
"famsize","settype","localjh",
"cultints","roots","cereals","gath","hunt","fish",
"anim","pigs","milk","plow","bovines","tree","foodtrade",
"ndrymonth","ecorich",
"popdens","pathstress","CVrain","rain","temp","AP1","AP2")


#-----------------------------------------------------
#---Estimate model on each imputed dataset------------
#-----------------------------------------------------

#--number of imputed datasets--
#nimp<-10
nimp<-3  ################################################################## speedup test

#--will append values to these empty objects--
vif<-NULL
ss<-NULL
beta<-NULL
dng<-NULL

#--loop through the imputed datasets--
for (i in 1:nimp){

#--select the ith imputed dataset--
m9<-impdat[which(impdat$.imp==i),]
#--retain only obs. for which dep. varb. is nonmissing--
m9<-m9[zdv,]

#--create spatially lagged dep. varbs.--
y<-as.matrix(depvar)
xx<-as.matrix(m9[,indpv])
#--for instruments we use the spatial lag of our indep. varbs.--
#--First, the spatially lagged varb. for distance--
xdy<-dd%*%xx
cyd<-dd%*%y
o<-lm(cyd~xdy)
#--the fitted value is our instrumental variable--
fydd<-fitted(o)
#--keep R2 from this regression--
dr2<-summary(o)$r.squared
#--Then, the spatially lagged varb. for language--
xly<-ll%*%xx   
cyl<-ll%*%y
o<-lm(cyl~xly)
#--the fitted value is our instrumental variable--
fyll<-fitted(o)
#--keep R2 from this regression--
lr2<-summary(o)$r.squared
m9<-cbind(m9,fydd,fyll)

#--OLS estimate of unrestricted model--
xUR<-lm(depvar~fyll+fydd+
pastoralExch+
PCvioHomi+PCvioAslt+PCvioIntr+
milkedanim+pctFemPolyg+
#anim2+
caststratLGd+money2+bridewealth+
##moralgods+moralgods2+  ##classtrat+
PCAP+
PCsize+
PCsize2+
caststrat+eextwar+
pre_mar_sex+money+foodstress+femctrldwellg+
poor+wealthy+
fratgrpstr+marrcaptives+plunder+###climate+
cultints+roots+cereals+gath+plow+
hunt+fish+
#anim+
pigs+milk+bovines+tree+foodtrade+foodscarc+
ecorich+popdens+pathstress+exogamy+ncmallow+famsize+
settype+localjh+
fempower+femsubs+ #superjh+
sexratio+war+himilexp+money+wagelabor
,data=m9)


xR<-lm(depvar~fydd+fyll+
pastoralExch+
#PCvioHomi+PCvioAslt+
#milkedanim+ ##pctFemPolyg+
PCAP+
PCsize+
#PCsize2+    NA for some reason
milk+
foodstress+
eextwar+ 
bridewealth+
caststratLGd+
PCvioIntr
#anim2+
#money2+
##moralgods+moralgods2+  
#classtrat+##extwar+
#pre_mar_sex+money+
#femctrldwellg+
#poor+wealthy+
#fratgrpstr+
#marrcaptives+plunder+###climate+
#cultints+roots+cereals+gath+
#plow+
#hunt+fish+
#anim+
#pigs+milk+bovines+tree+foodtrade+foodscarc+
#ecorich+popdens+pathstress+exogamy+ncmallow+famsize+
#settype+localjh+
#fempower+femsubs+ #superjh+
#sexratio+war+
#himilexp #+money+wagelabor
,data=m9)


#--corrected sigma2 and R2 for 2SLS--
qxx<-m9
qxx[,"fydd"]<-cyd
qxx[,"fyll"]<-cyl
b<-coef(xR)
incpt<-matrix(1,NROW(qxx),1)
x<-as.matrix(cbind(incpt,qxx[,names(b)[-1]]))
e<-y-x%*%as.matrix(b)
cs2<-as.numeric(t(e)%*%e/(NROW(x)-NCOL(x)))
cr2<-as.numeric(1-t(e)%*%e/sum((y-mean(y))^2))

#--collect coefficients and their variances--
ov<-summary(xR)
vif<-rbind(vif,vif(xR))
ss<-rbind(ss,diag(ov$cov*cs2))
#--collect robust coef. variances when there is heteroskedasticity--
#eb<-e^2
#x<-as.matrix(cbind(incpt,m9[,names(b)[-1]]))
#hcm<-inv(t(x)%*%x)%*%t(x)%*%diag(eb[1:length(eb)])%*%x%*%inv(t(x)%*%x)
#ss<-rbind(ss,diag(hcm))
beta<-rbind(beta,coef(xR))

#"moralgods","
#"superjh",
#--collect some model diagnostics--
dropt<-c("cereals","gath","plow","hunt",#"anim",
"pigs","milk","bovines","foodscarc","ecorich",
"popdens","pathstress","ncmallow","famsize","localjh",
"fempower","sexratio","money",
"wagelabor","war","himilexp","tree")


#--Ramsey RESET test--
p1<-qchisq(resettest(xR,type="fitted")$"p.value",1,lower.tail=FALSE)
#--Wald test (H0: dropped variables have coefficient equal zero)--
o<-linear.hypothesis(xUR,dropt,test="Chisq")$"Pr(>Chisq)"[2]
p2<-qchisq(o,1,lower.tail=FALSE) #find Chisq with 1 d.f. and same pvalue
#--Heteroskedasticity test (H0: homoskedastic residuals)--
p3<-ncv.test(xR)$ChiSquare
#--Shapiro-Wilke normality test (H0: residuals normal)
p4<-qchisq(shapiro.test(residuals(xR))$p.value,1,lower.tail=FALSE)
#--LaGrange Multiplier test for spatial autocorrelation: language--
o<-lm.LMtests(xR, wmatll, test=c("LMlag"))
p5<-as.numeric(o$LMlag$statistic)
#--LaGrange Multiplier test for spatial autocorrelation: distance--
o<-lm.LMtests(xR, wmatdd, test=c("LMlag"))
p6<-as.numeric(o$LMlag$statistic)
#--model R2--
p7<-cr2
dng<-rbind(dng,cbind(p1,p2,p3,p4,p5,p6,p7,dr2,lr2))

}


#--------------------------------------------
#--Rubin's formulas for combining estimates--
#--------------------------------------------

#--first find final regr. coefs. and p-values--
mnb<-apply(beta,2,mean)
####################vrb<-colSums((beta-t(matrix(mnb,length(mnb),10)))^2)/(nimp-1)
vrb<-colSums((beta-t(matrix(mnb,length(mnb),nimp)))^2)/(nimp-1)
mnv<-apply(ss,2,mean)
vrT<-mnv+vrb*(1-nimp^(-1))
fst<-mnb^2/vrT
r<-(1+nimp^(-1))*vrb/mnv
v<-(nimp-1)*(1+r^(-1))^2
pval<-pf(fst,1,v,lower.tail=FALSE)
bbb<-data.frame(round(cbind(mnb,fst,v,pval),8)) #,3 changed to .8 for significance test
bbb$VIF[2:NROW(bbb)]<-round(apply(vif,2,mean),3)
names(bbb)<-c("coef","Fstat","ddf","pvalue","VIF")

#--Then combine the diagnostics we collected--
dng<-data.frame(dng)
names(dng)<-c("RESET","Wald on restrs.","NCV","SWnormal","lagll","lagdd",
"R2:final model","R2:IV(distance)","R2:IV(language)")
r2<-apply(dng[,7:9],2,mean)
adng<-dng[,1:6]
mdm<-apply(adng,2,mean)
vrd<-colSums((adng-t(matrix(mdm,length(mdm),nimp)))^2)/(nimp-1)
aa<-4*mdm^2-2*vrd
aa[which(aa<0)]<-0
rd<-(1+nimp^(-1))*vrd/(2*mdm+aa^.5)
vd<-(nimp-1)*(1+rd^(-1))^2
Dm<-(mdm-(nimp-1)/(nimp+1)*rd)/(1+rd)
#-All chi-sq we collected have df=1-------
pvald<-pf(Dm,1,vd,lower.tail=FALSE)
ccc<-data.frame(round(cbind(Dm,vd,pvald),3))
names(ccc)<-c("Fstat","df","pvalue")

#--write results to csv file for perusal in spreadsheet--
write.csv("==OLS model for depvar==",file="OLSresults.csv",append=FALSE)
write.csv(bbb,file="OLSresults.csv",append=TRUE)
write.csv(r2,file="OLSresults.csv",append=TRUE)
write.csv(ccc,file="OLSresults.csv",append=TRUE)

aaa<-c(table(depvar), NROW(depvar),depvarname)
imp<-"number of imputations nimp="
impute=c(imp,nimp)

bbb
r2
ccc
bbb<-data.frame(round(cbind(mnb,fst,v,pval),3)) #.8 changed to back to .3 for significance test
bbb$VIF[2:NROW(bbb)]<-round(apply(vif,2,mean),3)
bbb
aaa
impute
load("world_countries_24.rda",.GlobalEnv)
zdv<-which(!is.na(depvar))
dep_var<-depvar[zdv]
dep_var<-dep_var+1
table(dep_var)
depvarname<-"Moral gos v238"
load("world_countries_24.rda",.GlobalEnv)
sccs=SCCS
splgt<-SpatialPointsDataFrame(coordinates(sccs[zdv,c("longitud","latitude")]),data.frame(dep_var)) 
brks<-quantile(dep_var,c(0,.333,.666,1))
cols<-colorRampPalette(c("yellow", "brown"))(length(brks)-1)
plot(world_countries,col="white") #black")
plot(splgt,pch=21,add=TRUE,cex=dep_var^.25,col="red", bg=cols[findInterval(dep_var, brks, all.inside=TRUE)])
mtext(depvarname,line=-2, side=1,cex=.5) #7)
splgt<-SpatialPointsDataFrame(coordinates(sccs[zdv,c("longitud","latitude")]),data.frame(dep_var)) 
brks<-quantile(dep_var,c(0,.333,.666,1))
cols<-colorRampPalette(c("yellow", "brown"))(length(brks)-1)
#jpeg(file="473-475mapValue_of_Boys.jpg",width=8,height=5,units="in",pointsize=8,res=600)
plot(world_countries,col="white") #black")
plot(splgt,pch=21,add=TRUE,cex=dep_var^.25,col="red", bg=cols[findInterval(dep_var, brks, all.inside=TRUE)])
mtext(depvarname,line=-2, side=1,cex=.5) #7)
# dev.off()

7AA Scott's code

SCCS_R_package_install#For_the_PC
setwd("/Users/drwhite/Documents/sccs")
#setwd("C:/My Documents/sccs")
setwd("/Users/drwhite/Documents/sccs") #Macbook
library(sccs)
data(sccs)                                 

depvar=sccs$v238
my_sccs<-data.frame(
dep_var=sccs$v238,
socname=sccs$socname,socID=sccs$"sccs#",
famsize=sccs$v68,    # similar to v80
exogamy=sccs$v72,
#famsizeB=sccs$v80,   # similar to v68
money=sccs$v155,
hunger=sccs$v678,
beyondlocal=sccs$v237,
popdens=sccs$v156,
premarsexatt=sccs$v165,
premarsexfrq=sccs$v166,
malesexag=sccs$v175,
ndrymonth=sccs$v196,
gath=sccs$v203,
hunt=sccs$v204,
fish=sccs$v205,
anim=sccs$v206,
bridewealth=(sccs$v208==1)*1,   #brideprice
nuclearfam=(sccs$v210<=3)*1,
ncmallow=sccs$v227,
cultints=sccs$v232,
tree=(sccs$v233==4)*1,
roots=(sccs$v233==5)*1,
cereals=(sccs$v233==6)*1,
settype=sccs$v234,
localjh=sccs$v236-1,
superjh=sccs$v237,
segadlboys=sccs$v242,
plow=(sccs$v243>1)*1,
pigs=(sccs$v244==2)*1,
bovines=(sccs$v244==7)*1,
milk=(sccs$v245>1)*1,
agrlateboy=sccs$v300,
valchild=(sccs$v473+sccs$v474+sccs$v475+sccs$v476),
fratgrpstr=sccs$v570,
Whyte577=sccs$v577,    #take care using Whyte variables - only coded 1/2 the sample
Whyte580=sccs$v580,
Whyte584=sccs$v583,
Whyte585=sccs$v584,
Whyte595=sccs$v594,
Whyte602=sccs$v602,
Whyte615=sccs$v615,
Whyte620=sccs$v620,
Whyte626=sccs$v626,
Whyte629=sccs$v629,
Whyte630=sccs$v630,
Whyte631=sccs$v631,
Whyte632=sccs$v632,
Whyte633=sccs$v633,
Whyte635=sccs$v635,
#                    #take care using Paige variables - coded less than 1/2 the sample
Paige657=sccs$v657,  # summed in v663#  Paige657 Paige658 Paige659 Paige660 Paige661 Paige662
femproduceND=sccs$v658, #Paige658=sccs$v658,  # summed in v663 
Paige659=sccs$v659,  # summed in v663
Paige660=sccs$v660,  # summed in v663
Paige661=sccs$v661,  # summed in v663
Paige662=sccs$v662,  # summed in v663
fempower=sccs$v663, # sum of v657-662
interperviol=sccs$v666,   ###synonyms: violence / interviol / freintovio
migr=(sccs$v677==2)*1,
#                    #take care using Sanday variables - only coded 1/2 the sample
Sanday664=sccs$v664,  # summed in v669
Sanday665=sccs$v665,  # summed in v669
Sanday666=sccs$v666,  # summed in v669
Sanday667=sccs$v667,  # summed in v669
Sanday668=sccs$v668,  # summed in v669
Sanday669=sccs$v669, # sum of v664-668 
 #WHYTE Data Quality Whyte718 Whyte719 Whyte720 Whyte721 Whyte722 Whyte723 Whyte724 Whyte725
Whyte718=sccs$v718,    #take care using Whyte variables - only coded 1/2 the sample
Whyte719=sccs$v719,
Whyte720=sccs$v720,
Whyte721=sccs$v721,
Whyte722=sccs$v722,
Whyte723=sccs$v723,
Whyte724=sccs$v724,
Whyte725=sccs$v725,
 #Rohner Data Quality Codes 
Rohner798=sccs$v798,
Rohner799=sccs$v799,
Rohner800=sccs$v800,
Rohner801=sccs$v801,
Rohner802=sccs$v802,
Rohner803=sccs$v803,
Rohner804=sccs$v804,
Rohner805=sccs$v805,
Rohner806=sccs$v806,
Rohner807=sccs$v807,
Rohner808=sccs$v808,
Rohner809=sccs$v809,
Rohner810=sccs$v810,
Rohner811=sccs$v811,
Rohner812=sccs$v812,
Rohner813=sccs$v813,
foodtrade=sccs$v819,
fem_agri=sccs$v821, 
dateobs=sccs$v838,
rain=sccs$v854,
temp=sccs$v855,
#ecorich=sccs$v857,
ecorich=(sccs$v857==3|sccs$v857==4)*1+(sccs$v857==5)*2,
pctFemPolyg=sccs$v872,
marrcaptives=sccs$v870,
femsubs=sccs$v890,
intwar=sccs$v891,    # similar to 1649
extwar=sccs$v892,    # similar to 1650
himilexp=(sccs$v899==1)*1,
plunder=sccs$v912,
AP1=sccs$v921,           ###agricultural potential 1
AP2=sccs$v928,           ###agricultural potential 2
pathstress=sccs$v1260,
war=sccs$v1648,     # overall -- sum of internal and external
intwarB=sccs$v1649,  # similar to v891
eextwar=sccs$v1650,  # similar to v892
foodscarc=sccs$v1685,
sexratio=1+(sccs$v1689>85)+(sccs$v1689>115),
wagelabor=sccs$v1732,
CVrain=sccs$v1914/sccs$v1913   #no comma
)  


indep_vars<-c("famsize","exogamy",    "money","popdens","malesexag","ndrymonth","gath","hunt","fish",
"anim","bridewealth","nuclearfam","ncmallow","cultints","tree","roots","cereals","settype","localjh",
"superjh","segadlboys","plow","pigs","bovines","milk","agrlateboy","valchild","fratgrpstr",
"Whyte577","Whyte580","Whyte584","Whyte585","Whyte595","Whyte602","Whyte615","Whyte620","Whyte626","Whyte629",
"Whyte630","Whyte631","Whyte632","Whyte633","Whyte635","Paige657","femproduceND","Paige659","Paige660",
"Paige661","Paige662","fempower","interperviol","migr","Sanday664","Sanday665","Sanday666","Sanday667",
"Sanday668","Sanday669","Whyte718","Whyte719","Whyte720","Whyte721","Whyte722","Whyte723","Whyte724",
"Whyte725","Rohner798","Rohner799","Rohner800","Rohner801","Rohner802","Rohner803","Rohner804","Rohner805",
"Rohner806","Rohner807","Rohner808","Rohner809","Rohner810","Rohner811","Rohner812","Rohner813","foodtrade","fem_agri",
"dateobs","rain","temp","ecorich","pctFemPolyg","femsubs","intwar","extwar","himilexp","AP1","AP2",
"pathstress","war","intwarB","eextwar","foodscarc","sexratio","wagelabor","CVrain", "hunger", "beyondlocal"
)


#restrictvars must drop one or more indepvars - in this case, dropping "premarsexatt"

restrict_vars=c("bridewealth", "milk", "ecorich","eextwar","hunger", "beyondlocal")

library(foreign)
#--Read in two weight matrices--
Wll<-as.matrix(read.dta("./examples/data/langwm.dta")[,-1])
Wdd<-as.matrix(read.dta("./examples/data/dist25wm.dta")[,c(-1,-2,-189)])

load("./examples/data/vaux.Rdata",.GlobalEnv)
my_aux = vaux
row.names(my_aux)<-NULL
#--remove the society name field--
my_aux<-my_aux[,-28]

name<-"god in human affair"
alias<-"QZgods"

model=list(name=name,
           alias=alias,
           data=my_sccs,
           aux_data=my_aux,
           prox_list=list(language=Wll,distance=Wdd),
           dep_var="dep_var",
           indep_vars=indep_vars,
           restrict_vars=restrict_vars)

save(model,file=paste(alias,".Rdata",sep=""))

#source("examples/src/run_model.R") #does for this model multiple imputation, two stage ols, saves to file to working directory.
source("examples/src/run_model_sept2010/run_model.R")
lat<-sccs$v833.1
lon<-sccs$v833.2
plot(lon,lat, cex=.1)
ztxt=as.character(depvar) #above "my_sccs( " -- a new line inserted: depvar= as defined in my_sccs( 
ztxt<-gsub("NaN",".",ztxt)
text(lon,lat,ztxt)
ols_stats$restrict_stats
ols_stats$r2
ols_stats$restrict_diagnostics

7AAA Scott's code

setwd("/Users/drwhite/Documents/sccs")
setwd("C:/My Documents/sccs")
setwd("/Users/drwhite/Documents/sccs") #Macbook

library(sccs)
data(sccs)                                 

depvar=sccs$v238
my_sccs<-data.frame(
dep_var=sccs$v238,
socname=sccs$socname,socID=sccs$"sccs#",
famsize=sccs$v68,    # similar to v80
exogamy=sccs$v72,
#famsizeB=sccs$v80,   # similar to v68
money=sccs$v155,
popdens=sccs$v156,
premarsexatt=sccs$v165,
premarsexfrq=sccs$v166,
malesexag=sccs$v175,
ndrymonth=sccs$v196,
gath=sccs$v203,
hunt=sccs$v204,
fish=sccs$v205,
anim=sccs$v206,
bridewealth=(sccs$v208==1)*1,
nuclearfam=(sccs$v210<=3)*1,
ncmallow=sccs$v227,
cultints=sccs$v232,
tree=(sccs$v233==4)*1,
roots=(sccs$v233==5)*1,
cereals=(sccs$v233==6)*1,
settype=sccs$v234,
localjh=sccs$v236-1,
superjh=sccs$v237,
segadlboys=sccs$v242,
plow=(sccs$v243>1)*1,
pigs=(sccs$v244==2)*1,
bovines=(sccs$v244==7)*1,
milk=(sccs$v245>1)*1,
caststratLGd=log(1+sccs$v272), 
agrlateboy=sccs$v300,
valchild=(sccs$v473+sccs$v474+sccs$v475+sccs$v476),
fratgrpstr=sccs$v570,
Whyte577=sccs$v577,    #take care using Whyte variables - only coded 1/2 the sample
Whyte580=sccs$v580,
Whyte584=sccs$v583,
Whyte585=sccs$v584,
Whyte595=sccs$v594,
Whyte602=sccs$v602,
Whyte615=sccs$v615,
Whyte620=sccs$v620,
Whyte626=sccs$v626,
Whyte629=sccs$v629,
Whyte630=sccs$v630,
Whyte631=sccs$v631,
Whyte632=sccs$v632,
Whyte633=sccs$v633,
Whyte635=sccs$v635,
#                    #take care using Paige variables - coded less than 1/2 the sample
Paige657=sccs$v657,  # summed in v663#  Paige657 Paige658 Paige659 Paige660 Paige661 Paige662
femproduceND=sccs$v658, #Paige658=sccs$v658,  # summed in v663 
Paige659=sccs$v659,  # summed in v663
Paige660=sccs$v660,  # summed in v663
Paige661=sccs$v661,  # summed in v663
Paige662=sccs$v662,  # summed in v663
fempower=sccs$v663, # sum of v657-662
PCvioIntr=sccs$v666, #interperviol=sccs$v666,   ###synonyms: violence / interviol / freintovio
migr=(sccs$v677==2)*1,
#                    #take care using Sanday variables - only coded 1/2 the sample
Sanday664=sccs$v664,  # summed in v669
Sanday665=sccs$v665,  # summed in v669
Sanday666=sccs$v666,  # summed in v669
Sanday667=sccs$v667,  # summed in v669
Sanday668=sccs$v668,  # summed in v669
Sanday669=sccs$v669, # sum of v664-668 
 #WHYTE Data Quality Whyte718 Whyte719 Whyte720 Whyte721 Whyte722 Whyte723 Whyte724 Whyte725
hunger=sccs$v678,
Whyte718=sccs$v718,    #take care using Whyte variables - only coded 1/2 the sample
Whyte719=sccs$v719,
Whyte720=sccs$v720,
Whyte721=sccs$v721,
Whyte722=sccs$v722,
Whyte723=sccs$v723,
Whyte724=sccs$v724,
Whyte725=sccs$v725,
 #Rohner Data Quality Codes 
Rohner798=sccs$v798,
Rohner799=sccs$v799,
Rohner800=sccs$v800,
Rohner801=sccs$v801,
Rohner802=sccs$v802,
Rohner803=sccs$v803,
Rohner804=sccs$v804,
Rohner805=sccs$v805,
Rohner806=sccs$v806,
Rohner807=sccs$v807,
Rohner808=sccs$v808,
Rohner809=sccs$v809,
Rohner810=sccs$v810,
Rohner811=sccs$v811,
Rohner812=sccs$v812,
Rohner813=sccs$v813,
foodtrade=sccs$v819,
fem_agri=sccs$v821, 
dateobs=sccs$v838,
rain=sccs$v854,
temp=sccs$v855,
#ecorich=sccs$v857,
ecorich=(sccs$v857==3|sccs$v857==4)*1+(sccs$v857==5)*2,
pctFemPolyg=sccs$v872,
marrcaptives=sccs$v870,
femsubs=sccs$v890,
intwar=sccs$v891,    # similar to 1649
extwar=sccs$v892,    # similar to 1650
himilexp=(sccs$v899==1)*1,
plunder=sccs$v912,
AP1=sccs$v921,           ###agricultural potential 1
AP2=sccs$v928,           ###agricultural potential 2
pathstress=sccs$v1260,
war=sccs$v1648,     # overall -- sum of internal and external
intwarB=sccs$v1649,  # similar to v891
eextwar=sccs$v1650,  # similar to v892
foodscarc=sccs$v1685,
sexratio=1+(sccs$v1689>85)+(sccs$v1689>115),
wagelabor=sccs$v1732,
CVrain=sccs$v1914/sccs$v1913   #no comma
)  


indep_vars<-c("bridewealth", "milk", "ecorich","eextwar","hunger", "superjh",
"famsize", "caststratLGd", #,"exogamy",    "money","popdens","malesexag","ndrymonth","gath","hunt","fish",
#"anim","nuclearfam","ncmallow","cultints","tree","roots","cereals","settype","localjh",
#"segadlboys","plow","pigs","bovines","agrlateboy","valchild","fratgrpstr",
#"Whyte577","Whyte580","Whyte584","Whyte585","Whyte595","Whyte602","Whyte615","Whyte620","Whyte626","Whyte629",
#"Whyte630","Whyte631","Whyte632","Whyte633","Whyte635","Paige657","femproduceND","Paige659","Paige660",
"Paige661","Paige662","fempower","PCvioIntr","migr","Sanday664","Sanday665","Sanday666","Sanday667",
#"Sanday668","Sanday669","Whyte718","Whyte719","Whyte720","Whyte721","Whyte722","Whyte723","Whyte724",
#"Whyte725","Rohner798","Rohner799","Rohner800","Rohner801","Rohner802","Rohner803","Rohner804","Rohner805",
#"Rohner806","Rohner807","Rohner808","Rohner809","Rohner810","Rohner811","Rohner812","Rohner813","foodtrade","fem_agri",
"dateobs","rain","temp","pctFemPolyg","femsubs","intwar","extwar","himilexp","AP1","AP2") #,
#"pathstress","war","intwarB","foodscarc","sexratio","wagelabor","CVrain"
#)


#restrictvars must drop one or more indepvars - in this case, dropping "premarsexatt"

restrict_vars=c("bridewealth", "milk", "ecorich","eextwar","hunger",
"AP1", "PCvioIntr", "caststratLGd", "superjh") #v237

library(foreign)
#--Read in two weight matrices--
Wll<-as.matrix(read.dta("./examples/data/langwm.dta")[,-1])
Wdd<-as.matrix(read.dta("./examples/data/dist25wm.dta")[,c(-1,-2,-189)])

load("./examples/data/vaux.Rdata",.GlobalEnv)
my_aux = vaux
row.names(my_aux)<-NULL
#--remove the society name field--
my_aux<-my_aux[,-28]

name<-"god in human affair"
alias<-"QZgods"

model=list(name=name,
           alias=alias,
           data=my_sccs,
           aux_data=my_aux,
           prox_list=list(language=Wll,distance=Wdd),
           dep_var="dep_var",
           indep_vars=indep_vars,
           restrict_vars=restrict_vars)

save(model,file=paste(alias,".Rdata",sep=""))

source("examples/src/run_model.R") #does for this model multiple imputation, two stage ols, saves to file to working directory.
lat<-sccs$v833.1
lon<-sccs$v833.2
plot(lon,lat, cex=.1)
ztxt=as.character(depvar) #above "my_sccs( " -- a new line inserted: depvar= as defined in my_sccs( 
ztxt<-gsub("NaN",".",ztxt)
text(lon,lat,ztxt)
ols_stats$restrict_stats
ols_stats$r2
ols_stats$restrict_diagnostics

7AAAA Scott's code

setwd("/Users/drwhite/Documents/sccs")
setwd("C:/My Documents/sccs")
setwd("/Users/drwhite/Documents/sccs") #Macbook

library(sccs)
data(sccs)                                 

depvar=sccs$v238
my_sccs<-data.frame(
dep_var=sccs$v238,
socname=sccs$socname,socID=sccs$"sccs#",
famsize=sccs$v68,    # similar to v80
exogamy=sccs$v72,
#famsizeB=sccs$v80,   # similar to v68
money=sccs$v155,
popdens=sccs$v156,
premarsexatt=sccs$v165,
premarsexfrq=sccs$v166,
malesexag=sccs$v175,
ndrymonth=sccs$v196,
gath=sccs$v203,
hunt=sccs$v204,
fish=sccs$v205,
anim=sccs$v206,
bridewealth=(sccs$v208==1)*1,
pastoralExch=((sccs$v208==1)*1)*(sccs$v858==6)*1,
nuclearfam=(sccs$v210<=3)*1,
ncmallow=sccs$v227,
cultints=sccs$v232,
tree=(sccs$v233==4)*1,
roots=(sccs$v233==5)*1,
cereals=(sccs$v233==6)*1,
settype=sccs$v234,
localjh=sccs$v236-1,
superjh=sccs$v237,
segadlboys=sccs$v242,
plow=(sccs$v243>1)*1,
pigs=(sccs$v244==2)*1,
bovines=(sccs$v244==7)*1,
milk=(sccs$v245>1)*1,
caststratLGd=log(1+sccs$v272), 
agrlateboy=sccs$v300,
valchild=(sccs$v473+sccs$v474+sccs$v475+sccs$v476),
fratgrpstr=sccs$v570,
Whyte577=sccs$v577,    #take care using Whyte variables - only coded 1/2 the sample
Whyte580=sccs$v580,
Whyte584=sccs$v583,
Whyte585=sccs$v584,
Whyte595=sccs$v594,
Whyte602=sccs$v602,
Whyte615=sccs$v615,
Whyte620=sccs$v620,
Whyte626=sccs$v626,
Whyte629=sccs$v629,
Whyte630=sccs$v630,
Whyte631=sccs$v631,
Whyte632=sccs$v632,
Whyte633=sccs$v633,
Whyte635=sccs$v635,
#                    #take care using Paige variables - coded less than 1/2 the sample
Paige657=sccs$v657,  # summed in v663#  Paige657 Paige658 Paige659 Paige660 Paige661 Paige662
femproduceND=sccs$v658, #Paige658=sccs$v658,  # summed in v663 
Paige659=sccs$v659,  # summed in v663
Paige660=sccs$v660,  # summed in v663
Paige661=sccs$v661,  # summed in v663
Paige662=sccs$v662,  # summed in v663
fempower=sccs$v663, # sum of v657-662
PCvioIntr=sccs$v666, #interperviol=sccs$v666,   ###synonyms: violence / interviol / freintovio
migr=(sccs$v677==2)*1,
#                    #take care using Sanday variables - only coded 1/2 the sample
Sanday664=sccs$v664,  # summed in v669
Sanday665=sccs$v665,  # summed in v669
Sanday666=sccs$v666,  # summed in v669
Sanday667=sccs$v667,  # summed in v669
Sanday668=sccs$v668,  # summed in v669
Sanday669=sccs$v669, # sum of v664-668 
 #WHYTE Data Quality Whyte718 Whyte719 Whyte720 Whyte721 Whyte722 Whyte723 Whyte724 Whyte725
foodstress=sccs$v678,
Whyte718=sccs$v718,    #take care using Whyte variables - only coded 1/2 the sample
Whyte719=sccs$v719,
Whyte720=sccs$v720,
Whyte721=sccs$v721,
Whyte722=sccs$v722,
Whyte723=sccs$v723,
Whyte724=sccs$v724,
Whyte725=sccs$v725,
 #Rohner Data Quality Codes 
Rohner798=sccs$v798,
Rohner799=sccs$v799,
Rohner800=sccs$v800,
Rohner801=sccs$v801,
Rohner802=sccs$v802,
Rohner803=sccs$v803,
Rohner804=sccs$v804,
Rohner805=sccs$v805,
Rohner806=sccs$v806,
Rohner807=sccs$v807,
Rohner808=sccs$v808,
Rohner809=sccs$v809,
Rohner810=sccs$v810,
Rohner811=sccs$v811,
Rohner812=sccs$v812,
Rohner813=sccs$v813,
foodtrade=sccs$v819,
fem_agri=sccs$v821, 
dateobs=sccs$v838,
rain=sccs$v854,
temp=sccs$v855,
#ecorich=sccs$v857,
ecorich=(sccs$v857==3|sccs$v857==4)*1+(sccs$v857==5)*2,
pctFemPolyg=sccs$v872,
marrcaptives=sccs$v870,
femsubs=sccs$v890,
intwar=sccs$v891,    # similar to 1649
extwar=sccs$v892,    # similar to 1650
himilexp=(sccs$v899==1)*1,
plunder=sccs$v912,
AP1=sccs$v921,           ###agricultural potential 1
AP2=sccs$v928,           ###agricultural potential 2
pathstress=sccs$v1260,
war=sccs$v1648,     # overall -- sum of internal and external
intwarB=sccs$v1649,  # similar to v891
eextwar=sccs$v1650,  # similar to v892
foodscarc=sccs$v1685,
sexratio=1+(sccs$v1689>85)+(sccs$v1689>115),
wagelabor=sccs$v1732,
CVrain=sccs$v1914/sccs$v1913   #no comma
)  


indep_vars<-c("pastoralExch", "bridewealth", "milk", "ecorich","eextwar","foodstress", "superjh","AP1",
"exogamy","caststratLGd",  "famsize",   "money","popdens","malesexag","ndrymonth","gath","hunt","fish",
"PCvioIntr")
#"anim","nuclearfam","ncmallow","cultints","tree","roots","cereals","settype","localjh",
#"segadlboys","plow","pigs","bovines","agrlateboy","valchild","fratgrpstr",
#"Whyte577","Whyte580","Whyte584","Whyte585","Whyte595","Whyte602","Whyte615","Whyte620","Whyte626","Whyte629",
#"Whyte630","Whyte631","Whyte632","Whyte633","Whyte635","Paige657","femproduceND","Paige659","Paige660",
#"Paige661","Paige662","fempower","migr","Sanday664","Sanday665","Sanday666","Sanday667",
#"Sanday668","Sanday669","Whyte718","Whyte719","Whyte720","Whyte721","Whyte722","Whyte723","Whyte724",
#"Whyte725","Rohner798","Rohner799","Rohner800","Rohner801","Rohner802","Rohner803","Rohner804","Rohner805",
#"Rohner806","Rohner807","Rohner808","Rohner809","Rohner810","Rohner811","Rohner812","Rohner813","foodtrade","fem_agri",
#"dateobs","rain","temp","pctFemPolyg","femsubs","intwar","extwar","himilexp","AP2") #,
#"pathstress","war","intwarB","foodscarc","sexratio","wagelabor","CVrain"
#)

#restrictvars must drop one or more indepvars - in this case, dropping "premarsexatt"

restrict_vars=c("superjh", "milk", "foodstress", "ecorich", "eextwar", "bridewealth", 
  "caststratLGd",  "pastoralExch") #, PCvioIntr") #"PCvioIntr")#) #v237  "AP1",

library(foreign)
#--Read in two weight matrices--
Wll<-as.matrix(read.dta("./examples/data/langwm.dta")[,-1])
Wdd<-as.matrix(read.dta("./examples/data/dist25wm.dta")[,c(-1,-2,-189)])

load("./examples/data/vaux.Rdata",.GlobalEnv)
my_aux = vaux
row.names(my_aux)<-NULL
#--remove the society name field--
my_aux<-my_aux[,-28]

name<-"god in human affair"
alias<-"QZgods"

model=list(name=name,
           alias=alias,
           data=my_sccs,
           aux_data=my_aux,
           prox_list=list(language=Wll,distance=Wdd),
           dep_var="dep_var",
           indep_vars=indep_vars,
           restrict_vars=restrict_vars)

save(model,file=paste(alias,".Rdata",sep=""))

source("examples/src/run_model.R") #does for this model multiple imputation, two stage ols, saves to file to working directory.
lat<-sccs$v833.1
lon<-sccs$v833.2
plot(lon,lat, cex=.1)
ztxt=as.character(depvar) #above "my_sccs( " -- a new line inserted: depvar= as defined in my_sccs( 
ztxt<-gsub("NaN",".",ztxt)
text(lon,lat,ztxt)
ols_stats$restrict_stats
ols_stats$r2
ols_stats$restrict_diagnostics

B Moral Gods & pastoralExch

               coef  Fstat        ddf pvalue   VIF
(Intercept)   1.016  1.387    696.900  0.239    NA
language     -0.787  2.895   2103.252  0.089 2.491
distance      0.935 31.999   9412.209  0.000 2.529
superjh       0.144  5.238  11373.337  0.022 1.453
milk          0.353  2.645  28418.851  0.104 2.286
foodstress    0.200  3.798     64.377  0.056 1.121
ecorich      -0.236  5.646 156853.139  0.018 1.171
eextwar      -0.033  8.944    622.748  0.003 1.114
bridewealth   0.276  2.970  24758.508  0.085 1.357
caststratLGd  0.479  2.109   1284.994  0.147 1.280
pastoralExch  0.376  1.394    990.358  0.238 1.357
>  ols_stats$r2
 R2:final model R2:IV_ language R2:IV_ distance 
      0.5132684       0.9729958       0.9806854 
>  ols_stats$restrict_diagnostics
               Fstat        df pvalue
RESET          0.966   550.122  0.326
Wald.on.restrs 0.449    19.116  0.511
NCV            2.249   431.318  0.134
SW.normal      6.222   822.444  0.013
lag..language  2.000 83352.173  0.157
lag..distance  1.313  4573.031  0.252

A No milk

restrict_vars=c("superjh", "foodstress", "ecorich", "eextwar", "bridewealth", 
  "caststratLGd",  "pastoralExch") #, PCvioIntr") #"PCvioIntr")#) #v237  "AP1",
library(foreign)
#--Read in two weight matrices--
Wll<-as.matrix(read.dta("./examples/data/langwm.dta")[,-1])
Wdd<-as.matrix(read.dta("./examples/data/dist25wm.dta")[,c(-1,-2,-189)])

load("./examples/data/vaux.Rdata",.GlobalEnv)
my_aux = vaux
row.names(my_aux)<-NULL
#--remove the society name field--
my_aux<-my_aux[,-28]

name<-"god in human affair"
alias<-"QZgods"

model=list(name=name,
           alias=alias,
           data=my_sccs,
           aux_data=my_aux,
           prox_list=list(language=Wll,distance=Wdd),
           dep_var="dep_var",
           indep_vars=indep_vars,
           restrict_vars=restrict_vars)

save(model,file=paste(alias,".Rdata",sep=""))

source("examples/src/run_model.R") #does for this model multiple imputation, two stage ols, saves to file to working directory.
lat<-sccs$v833.1
lon<-sccs$v833.2
plot(lon,lat, cex=.1)
ztxt=as.character(depvar) #above "my_sccs( " -- a new line inserted: depvar= as defined in my_sccs( 
ztxt<-gsub("NaN",".",ztxt)
text(lon,lat,ztxt)
ols_stats$restrict_stats
ols_stats$r2
ols_stats$restrict_diagnostics

B No milk

               coef  Fstat        ddf pvalue   VIF
(Intercept)   0.715  0.781  14314.218  0.377    NA
language     -0.710  2.353 161288.201  0.125 2.446
distance      1.056 47.720  13403.271  0.000 2.069
superjh       0.164  6.570   1440.183  0.010 1.391
foodstress    0.144  1.992     80.188  0.162 1.104
ecorich      -0.259  6.428  10159.942  0.011 1.173
eextwar      -0.034  7.708     51.700  0.008 1.098
bridewealth   0.284  3.015 186859.132  0.082 1.355
caststratLGd  0.568  2.922   5508.859  0.087 1.272
pastoralExch  0.500  2.495  53557.116  0.114 1.330
> ols_stats$r2
 R2:final model R2:IV_ language R2:IV_ distance 
      0.4870792       0.9727770       0.9800863 
> ols_stats$restrict_diagnostics
               Fstat          df pvalue
RESET          1.786    1078.037  0.182
Wald.on.restrs 0.781      79.188  0.379
NCV            3.974     501.680  0.047
SW.normal      5.384    8382.792  0.020
lag..language  1.731 1351628.561  0.188
lag..distance  1.201   25568.963  0.273

A No caststratLGd

restrict_vars=c("superjh", "milk", "foodstress", "ecorich", "eextwar", "bridewealth", 
  "pastoralExch") #, PCvioIntr") #"PCvioIntr")#) #v237  "AP1",
library(foreign)
#--Read in two weight matrices--
Wll<-as.matrix(read.dta("./examples/data/langwm.dta")[,-1])
Wdd<-as.matrix(read.dta("./examples/data/dist25wm.dta")[,c(-1,-2,-189)])

load("./examples/data/vaux.Rdata",.GlobalEnv)
my_aux = vaux
row.names(my_aux)<-NULL
#--remove the society name field--
my_aux<-my_aux[,-28]

name<-"god in human affair"
alias<-"QZgods"

model=list(name=name,
           alias=alias,
           data=my_sccs,
           aux_data=my_aux,
           prox_list=list(language=Wll,distance=Wdd),
           dep_var="dep_var",
           indep_vars=indep_vars,
           restrict_vars=restrict_vars)

save(model,file=paste(alias,".Rdata",sep=""))

source("examples/src/run_model.R") #does for this model multiple imputation, two stage ols, saves to file to working directory.
lat<-sccs$v833.1
lon<-sccs$v833.2
plot(lon,lat, cex=.1)
ztxt=as.character(depvar) #above "my_sccs( " -- a new line inserted: depvar= as defined in my_sccs( 
ztxt<-gsub("NaN",".",ztxt)
text(lon,lat,ztxt)
ols_stats$restrict_stats
ols_stats$r2
ols_stats$restrict_diagnostics

B No caststratLGd

               coef  Fstat       ddf pvalue   VIF
(Intercept)   1.346  2.567  3766.260  0.109    NA
language     -0.759  2.752  7532.980  0.097 2.433
distance      0.930 31.310 34574.108  0.000 2.527
superjh       0.170  7.477  5674.291  0.006 1.378
milk          0.405  3.529 61255.136  0.060 2.224
foodstress    0.173  3.110   143.910  0.080 1.115
ecorich      -0.254  6.427 10549.059  0.011 1.161
eextwar      -0.034  9.013   124.244  0.003 1.115
bridewealth   0.283  3.016  2563.556  0.083 1.356
pastoralExch  0.480  2.293  1675.031  0.130 1.337
>  ols_stats$r2
 R2:final model R2:IV_ language R2:IV_ distance 
      0.5022173       0.9723788       0.9784880 
>  ols_stats$restrict_diagnostics
               Fstat         df pvalue
RESET          1.317    147.020  0.253
Wald.on.restrs 0.182    360.716  0.670
NCV            3.561    856.005  0.060
SW.normal      4.728    168.335  0.031
lag..language  1.850 794716.411  0.174
lag..distance  1.432   8920.601  0.231

8A No milk No foodstress

will add in 9a  money3=(SCCS$v155=5)*1,  money5=(SCCS$v155=5)*1, 
restrict_vars=c("superjh", "ecorich", "eextwar", "bridewealth", 
  "caststratLGd",  "pastoralExch") #, PCvioIntr") #"PCvioIntr")#) #v237  "AP1",
library(foreign)
#--Read in two weight matrices--
Wll<-as.matrix(read.dta("./examples/data/langwm.dta")[,-1])
Wdd<-as.matrix(read.dta("./examples/data/dist25wm.dta")[,c(-1,-2,-189)])

load("./examples/data/vaux.Rdata",.GlobalEnv)
my_aux = vaux
row.names(my_aux)<-NULL
#--remove the society name field--
my_aux<-my_aux[,-28]

name<-"god in human affair"
alias<-"QZgods"

model=list(name=name,
           alias=alias,
           data=my_sccs,
           aux_data=my_aux,
           prox_list=list(language=Wll,distance=Wdd),
           dep_var="dep_var",
           indep_vars=indep_vars,
           restrict_vars=restrict_vars)

save(model,file=paste(alias,".Rdata",sep=""))

source("examples/src/run_model.R") #does for this model multiple imputation, two stage ols, saves to file to working directory.
lat<-sccs$v833.1
lon<-sccs$v833.2
plot(lon,lat, cex=.1)
ztxt=as.character(depvar) #above "my_sccs( " -- a new line inserted: depvar= as defined in my_sccs( 
ztxt<-gsub("NaN",".",ztxt)
text(lon,lat,ztxt)
ols_stats$restrict_stats
ols_stats$r2
ols_stats$restrict_diagnostics

24 8B No milk No foodstress

CODE WAS ACCIDENTALLY ERASED. SEE 28 7BBB Scott's code depvar Moral gods, indepvar pastoralExch
Foodstress was confounded with new Ecorich
Milk was confounded with pastoralExch 
Try a Bridewealth*Milk interaction variables for past_exch, perhaps more societies
               coef  Fstat        ddf pvalue   VIF
(Intercept)   1.160  2.265  84020.721  0.132    NA
language     -0.785  2.852  25694.706  0.091 2.436
distance      1.064 48.274 270475.086  0.000 2.078
superjh       0.159  6.260   1415.286  0.012 1.371
ecorich      -0.294  8.647  17356.003  0.003 1.119
eextwar      -0.033  8.262     88.313  0.005 1.078
bridewealth   0.296  3.260 215068.334  0.071 1.351
caststratLGd  0.561  2.866  14870.122  0.090 1.258
pastoralExch  0.562  3.160  12694.236  0.075 1.310
> ols_stats$r2
 R2:final model R2:IV_ language R2:IV_ distance 
      0.4800011       0.9724753       0.9791463 
> ols_stats$restrict_diagnostics
               Fstat          df pvalue
RESET          1.067     809.206  0.302
Wald.on.restrs 1.308     887.127  0.253
NCV            3.075     675.371  0.080
SW.normal      3.907     488.292  0.049
lag..language  1.764 3605805.959  0.184
lag..distance  1.359    5048.970  0.244

9A No milk No foodstress

will add in 9a  money3=(SCCS$v155=5)*1,  money5=(SCCS$v155=5)*1, 
restrict_vars=c("superjh", "ecorich", "eextwar", "bridewealth", 
  "caststratLGd",  "pastoralExch") #, PCvioIntr") #"PCvioIntr")#) #v237  "AP1",

9B results

7AAA Scott's code depvar Moral gods, indepvar pastoralExch

add pastoralExch=pastoralExch=((sccs$v208==1)*1)*(sccs$v858==6)*1
setwd("/Users/drwhite/Documents/sccs")
setwd("C:/My Documents/sccs")
setwd("/Users/drwhite/Documents/sccs") #Macbook

library(sccs)
data(sccs)                                 

depvar=sccs$v238
my_sccs<-data.frame(
dep_var=sccs$v238,
pastoralExch=((sccs$v208==1)*1)*(sccs$v858==6)*1,
socname=sccs$socname,socID=sccs$"sccs#",
famsize=sccs$v68,    # similar to v80
exogamy=sccs$v72,
#famsizeB=sccs$v80,   # similar to v68
money=sccs$v155,
popdens=sccs$v156,
premarsexatt=sccs$v165,
premarsexfrq=sccs$v166,
malesexag=sccs$v175,
ndrymonth=sccs$v196,
gath=sccs$v203,
hunt=sccs$v204,
fish=sccs$v205,
anim=sccs$v206,
bridewealth=(sccs$v208==1)*1,
nuclearfam=(sccs$v210<=3)*1,
ncmallow=sccs$v227,
cultints=sccs$v232,
tree=(sccs$v233==4)*1,
roots=(sccs$v233==5)*1,
cereals=(sccs$v233==6)*1,
settype=sccs$v234,
localjh=sccs$v236-1,
superjh=sccs$v237,
segadlboys=sccs$v242,
plow=(sccs$v243>1)*1,
pigs=(sccs$v244==2)*1,
bovines=(sccs$v244==7)*1,
milk=(sccs$v245>1)*1,
caststratLGd=log(1+sccs$v272), 
agrlateboy=sccs$v300,
valchild=(sccs$v473+sccs$v474+sccs$v475+sccs$v476),
fratgrpstr=sccs$v570,
Whyte577=sccs$v577,    #take care using Whyte variables - only coded 1/2 the sample
Whyte580=sccs$v580,
Whyte584=sccs$v583,
Whyte585=sccs$v584,
Whyte595=sccs$v594,
Whyte602=sccs$v602,
Whyte615=sccs$v615,
Whyte620=sccs$v620,
Whyte626=sccs$v626,
Whyte629=sccs$v629,
Whyte630=sccs$v630,
Whyte631=sccs$v631,
Whyte632=sccs$v632,
Whyte633=sccs$v633,
Whyte635=sccs$v635,
#                    #take care using Paige variables - coded less than 1/2 the sample
Paige657=sccs$v657,  # summed in v663#  Paige657 Paige658 Paige659 Paige660 Paige661 Paige662
femproduceND=sccs$v658, #Paige658=sccs$v658,  # summed in v663 
Paige659=sccs$v659,  # summed in v663
Paige660=sccs$v660,  # summed in v663
Paige661=sccs$v661,  # summed in v663
Paige662=sccs$v662,  # summed in v663
fempower=sccs$v663, # sum of v657-662
PCvioIntr=sccs$v666, #interperviol=sccs$v666,   ###synonyms: violence / interviol / freintovio
migr=(sccs$v677==2)*1,
#                    #take care using Sanday variables - only coded 1/2 the sample
Sanday664=sccs$v664,  # summed in v669
Sanday665=sccs$v665,  # summed in v669
Sanday666=sccs$v666,  # summed in v669
Sanday667=sccs$v667,  # summed in v669
Sanday668=sccs$v668,  # summed in v669
Sanday669=sccs$v669, # sum of v664-668 
 #WHYTE Data Quality Whyte718 Whyte719 Whyte720 Whyte721 Whyte722 Whyte723 Whyte724 Whyte725
hunger=sccs$v678,
Whyte718=sccs$v718,    #take care using Whyte variables - only coded 1/2 the sample
Whyte719=sccs$v719,
Whyte720=sccs$v720,
Whyte721=sccs$v721,
Whyte722=sccs$v722,
Whyte723=sccs$v723,
Whyte724=sccs$v724,
Whyte725=sccs$v725,
 #Rohner Data Quality Codes 
Rohner798=sccs$v798,
Rohner799=sccs$v799,
Rohner800=sccs$v800,
Rohner801=sccs$v801,
Rohner802=sccs$v802,
Rohner803=sccs$v803,
Rohner804=sccs$v804,
Rohner805=sccs$v805,
Rohner806=sccs$v806,
Rohner807=sccs$v807,
Rohner808=sccs$v808,
Rohner809=sccs$v809,
Rohner810=sccs$v810,
Rohner811=sccs$v811,
Rohner812=sccs$v812,
Rohner813=sccs$v813,
foodtrade=sccs$v819,
fem_agri=sccs$v821, 
dateobs=sccs$v838,
rain=sccs$v854,
temp=sccs$v855,
#ecorich=sccs$v857,
ecorich=(sccs$v857==3|sccs$v857==4)*1+(sccs$v857==5)*2,
pctFemPolyg=sccs$v872,
marrcaptives=sccs$v870,
femsubs=sccs$v890,
intwar=sccs$v891,    # similar to 1649
extwar=sccs$v892,    # similar to 1650
himilexp=(sccs$v899==1)*1,
plunder=sccs$v912,
AP1=sccs$v921,           ###agricultural potential 1
AP2=sccs$v928,           ###agricultural potential 2
pathstress=sccs$v1260,
war=sccs$v1648,     # overall -- sum of internal and external
intwarB=sccs$v1649,  # similar to v891
eextwar=sccs$v1650,  # similar to v892
foodscarc=sccs$v1685,
sexratio=1+(sccs$v1689>85)+(sccs$v1689>115),
wagelabor=sccs$v1732,
CVrain=sccs$v1914/sccs$v1913   #no comma
)  


indep_vars<-c("bridewealth", "milk", "ecorich","eextwar","hunger", "superjh",
"famsize", "caststratLGd", #,"exogamy",    "money","popdens","malesexag","ndrymonth","gath","hunt","fish",
#"anim","nuclearfam","ncmallow","cultints","tree","roots","cereals","settype","localjh",
#"segadlboys","plow","pigs","bovines","agrlateboy","valchild","fratgrpstr",
#"Whyte577","Whyte580","Whyte584","Whyte585","Whyte595","Whyte602","Whyte615","Whyte620","Whyte626","Whyte629",
#"Whyte630","Whyte631","Whyte632","Whyte633","Whyte635","Paige657","femproduceND","Paige659","Paige660",
"Paige661","Paige662","fempower","PCvioIntr","migr","Sanday664","Sanday665","Sanday666","Sanday667",
#"Sanday668","Sanday669","Whyte718","Whyte719","Whyte720","Whyte721","Whyte722","Whyte723","Whyte724",
#"Whyte725","Rohner798","Rohner799","Rohner800","Rohner801","Rohner802","Rohner803","Rohner804","Rohner805",
#"Rohner806","Rohner807","Rohner808","Rohner809","Rohner810","Rohner811","Rohner812","Rohner813","foodtrade","fem_agri",
"dateobs","rain","temp","pctFemPolyg","femsubs","intwar","extwar","himilexp","AP1","AP2") #,
#"pathstress","war","intwarB","foodscarc","sexratio","wagelabor","CVrain"
#)


#restrictvars must drop one or more indepvars - in this case, dropping "premarsexatt"

restrict_vars=c("superjh", "ecorich", "eextwar", "bridewealth", 
 "caststratLGd",  "pastoralExch") 
#restrict_vars=c("bridewealth", "milk", "ecorich","eextwar","hunger",
#"AP1", "PCvioIntr", "caststratLGd", "superjh") #v237

library(foreign)
#--Read in two weight matrices--
Wll<-as.matrix(read.dta("./examples/data/langwm.dta")[,-1])
Wdd<-as.matrix(read.dta("./examples/data/dist25wm.dta")[,c(-1,-2,-189)])

load("./examples/data/vaux.Rdata",.GlobalEnv)
my_aux = vaux
row.names(my_aux)<-NULL
#--remove the society name field--
my_aux<-my_aux[,-28]

name<-"god in human affair"
alias<-"QZgods"

model=list(name=name,
           alias=alias,
           data=my_sccs,
           aux_data=my_aux,
           prox_list=list(language=Wll,distance=Wdd),
           dep_var="dep_var",
           indep_vars=indep_vars,
           restrict_vars=restrict_vars)

save(model,file=paste(alias,".Rdata",sep=""))

source("examples/src/run_model.R") #does for this model multiple imputation, two stage ols, saves to file to working directory.
lat<-sccs$v833.1
lon<-sccs$v833.2
plot(lon,lat, cex=.1)
ztxt=as.character(depvar) #above "my_sccs( " -- a new line inserted: depvar= as defined in my_sccs( 
ztxt<-gsub("NaN",".",ztxt)
text(lon,lat,ztxt)
ols_stats$restrict_stats
ols_stats$r2
ols_stats$restrict_diagnostics

28 7BBB Scott's code depvar Moral gods, indepvar pastoralExch

 7AAA reconstituted for this result.
                coef   Fstat         ddf pvalue    VIF
(Intercept)   1.0018  1.6620   2909.3706 0.1974     NA
language     -0.6783  2.1251   8729.3393 0.1449 2.4224
distance      1.0188 44.8719  13787.6535 0.0000 2.0310
superjh       0.1581  6.4161  20840.4405 0.0113 1.3511
ecorich      -0.3133  9.7206   9376.6147 0.0018 1.1203
eextwar      -0.0321  7.8222     97.3484 0.0062 1.0857
bridewealth   0.2841  2.9705 850275.7190 0.0848 1.3591
caststratLGd  0.6068  3.3909  26392.8984 0.0656 1.2716
pastoralExch  0.5776  3.3139  28766.7898 0.0687 1.3167
>  ols_stats$r2
 R2:final model R2:IV_ language R2:IV_ distance 
      0.4766355       0.9745583       0.9834284 
>  ols_stats$restrict_diagnostics
               Fstat         df pvalue
RESET          0.711  22010.415  0.399
Wald.on.restrs 4.698    141.737  0.032
NCV            2.414   5244.173  0.120
SW.normal      4.574   5913.610  0.032
lag..language  1.759 202542.799  0.185
lag..distance  0.975 786770.898  0.323

8AAA Scott's code depvar Moral gods, indepvars pastoralExch money2, money3 money5

add pastoralExch=pastoralExch=((SCCS$v208==1)*1)*(SCCS$v858==6)*1
setwd("/Users/drwhite/Documents/sccs")
setwd("C:/My Documents/sccs")
setwd("/Users/drwhite/Documents/sccs") #Macbook

library(sccs)
data(sccs)                                 

depvar=sccs$v238
my_sccs<-data.frame(
dep_var=sccs$v238,
pastoralExch=((SCCS$v208==1)*1)*(SCCS$v858==6)*1,
socname=sccs$socname,socID=sccs$"sccs#",
famsize=sccs$v68,    # similar to v80
exogamy=sccs$v72,
#famsizeB=sccs$v80,   # similar to v68
money=sccs$v155,
money2=(SCCS$v155>1)*1,
money3=((SCCS$v155==3)*2)+((SCCS$v155==2)*1), 
money5=((SCCS$v155==5)*2)+((SCCS$v155==4)*1),
popdens=sccs$v156,
premarsexatt=sccs$v165,
premarsexfrq=sccs$v166,
malesexag=sccs$v175,
ndrymonth=sccs$v196,
gath=sccs$v203,
hunt=sccs$v204,
fish=sccs$v205,
anim=sccs$v206,
bridewealth=(sccs$v208==1)*1,
nuclearfam=(sccs$v210<=3)*1,
ncmallow=sccs$v227,
cultints=sccs$v232,
tree=(sccs$v233==4)*1,
roots=(sccs$v233==5)*1,
cereals=(sccs$v233==6)*1,
settype=sccs$v234,
localjh=sccs$v236-1,
superjh=sccs$v237,
segadlboys=sccs$v242,
plow=(sccs$v243>1)*1,
pigs=(sccs$v244==2)*1,
bovines=(sccs$v244==7)*1,
milk=(sccs$v245>1)*1,
caststratLGd=log(1+SCCS$v272), 
agrlateboy=sccs$v300,
valchild=(sccs$v473+sccs$v474+sccs$v475+sccs$v476),
fratgrpstr=sccs$v570,
Whyte577=sccs$v577,    #take care using Whyte variables - only coded 1/2 the sample
Whyte580=sccs$v580,
Whyte584=sccs$v583,
Whyte585=sccs$v584,
Whyte595=sccs$v594,
Whyte602=sccs$v602,
Whyte615=sccs$v615,
Whyte620=sccs$v620,
Whyte626=sccs$v626,
Whyte629=sccs$v629,
Whyte630=sccs$v630,
Whyte631=sccs$v631,
Whyte632=sccs$v632,
Whyte633=sccs$v633,
Whyte635=sccs$v635,
#                    #take care using Paige variables - coded less than 1/2 the sample
Paige657=sccs$v657,  # summed in v663#  Paige657 Paige658 Paige659 Paige660 Paige661 Paige662
femproduceND=sccs$v658, #Paige658=sccs$v658,  # summed in v663 
Paige659=sccs$v659,  # summed in v663
Paige660=sccs$v660,  # summed in v663
Paige661=sccs$v661,  # summed in v663
Paige662=sccs$v662,  # summed in v663
fempower=sccs$v663, # sum of v657-662
PCvioIntr=SCCS$v666, #interperviol=sccs$v666,   ###synonyms: violence / interviol / freintovio
migr=(sccs$v677==2)*1,
#                    #take care using Sanday variables - only coded 1/2 the sample
Sanday664=sccs$v664,  # summed in v669
Sanday665=sccs$v665,  # summed in v669
Sanday666=sccs$v666,  # summed in v669
Sanday667=sccs$v667,  # summed in v669
Sanday668=sccs$v668,  # summed in v669
Sanday669=sccs$v669, # sum of v664-668 
 #WHYTE Data Quality Whyte718 Whyte719 Whyte720 Whyte721 Whyte722 Whyte723 Whyte724 Whyte725
hunger=sccs$v678,
Whyte718=sccs$v718,    #take care using Whyte variables - only coded 1/2 the sample
Whyte719=sccs$v719,
Whyte720=sccs$v720,
Whyte721=sccs$v721,
Whyte722=sccs$v722,
Whyte723=sccs$v723,
Whyte724=sccs$v724,
Whyte725=sccs$v725,
 #Rohner Data Quality Codes 
Rohner798=sccs$v798,
Rohner799=sccs$v799,
Rohner800=sccs$v800,
Rohner801=sccs$v801,
Rohner802=sccs$v802,
Rohner803=sccs$v803,
Rohner804=sccs$v804,
Rohner805=sccs$v805,
Rohner806=sccs$v806,
Rohner807=sccs$v807,
Rohner808=sccs$v808,
Rohner809=sccs$v809,
Rohner810=sccs$v810,
Rohner811=sccs$v811,
Rohner812=sccs$v812,
Rohner813=sccs$v813,
foodtrade=sccs$v819,
fem_agri=sccs$v821, 
dateobs=sccs$v838,
rain=sccs$v854,
temp=sccs$v855,
#ecorich=sccs$v857,
ecorich=(sccs$v857==3|sccs$v857==4)*1+(sccs$v857==5)*2,
pctFemPolyg=sccs$v872,
marrcaptives=sccs$v870,
femsubs=sccs$v890,
intwar=sccs$v891,    # similar to 1649
extwar=sccs$v892,    # similar to 1650
himilexp=(sccs$v899==1)*1,
plunder=sccs$v912,
AP1=sccs$v921,           ###agricultural potential 1
AP2=sccs$v928,           ###agricultural potential 2
pathstress=sccs$v1260,
war=sccs$v1648,     # overall -- sum of internal and external
intwarB=sccs$v1649,  # similar to v891
eextwar=sccs$v1650,  # similar to v892
foodscarc=sccs$v1685,
sexratio=1+(sccs$v1689>85)+(sccs$v1689>115),
wagelabor=sccs$v1732,
CVrain=sccs$v1914/sccs$v1913   #no comma
)  


indep_vars<-c("bridewealth", "milk", "ecorich","eextwar","hunger", "superjh",
"famsize", "caststratLGd", #,"exogamy", 
"money", "money2", "money3", "money5",
"popdens","malesexag","ndrymonth","gath","hunt","fish",
#"anim","nuclearfam","ncmallow","cultints","tree","roots","cereals","settype","localjh",
#"segadlboys","plow","pigs","bovines","agrlateboy","valchild","fratgrpstr",
#"Whyte577","Whyte580","Whyte584","Whyte585","Whyte595","Whyte602","Whyte615","Whyte620","Whyte626","Whyte629",
#"Whyte630","Whyte631","Whyte632","Whyte633","Whyte635","Paige657","femproduceND","Paige659","Paige660",
"Paige661","Paige662","fempower","PCvioIntr","migr","Sanday664","Sanday665","Sanday666","Sanday667",
#"Sanday668","Sanday669","Whyte718","Whyte719","Whyte720","Whyte721","Whyte722","Whyte723","Whyte724",
#"Whyte725","Rohner798","Rohner799","Rohner800","Rohner801","Rohner802","Rohner803","Rohner804","Rohner805",
#"Rohner806","Rohner807","Rohner808","Rohner809","Rohner810","Rohner811","Rohner812","Rohner813","foodtrade","fem_agri",
"dateobs","rain","temp","pctFemPolyg","femsubs","intwar","extwar","himilexp","AP1","AP2") #,
#"pathstress","war","intwarB","foodscarc","sexratio","wagelabor","CVrain"
#)


#restrictvars must drop one or more indepvars - in this case, dropping "premarsexatt"

restrict_vars=c("milk",   #"money3", 
#"money", #"money5",
#NO "money2", "money3",
"superjh", "ecorich", "eextwar", "bridewealth", 
 "caststratLGd") #,  "pastoralExch") 
#restrict_vars=c("bridewealth", "ecorich","eextwar","hunger",
#"AP1", "PCvioIntr", "caststratLGd", "superjh") #v237

library(foreign)
#--Read in two weight matrices--
Wll<-as.matrix(read.dta("./examples/data/langwm.dta")[,-1])
Wdd<-as.matrix(read.dta("./examples/data/dist25wm.dta")[,c(-1,-2,-189)])

load("./examples/data/vaux.Rdata",.GlobalEnv)
my_aux = vaux
row.names(my_aux)<-NULL
#--remove the society name field--
my_aux<-my_aux[,-28]

name<-"god in human affair"
alias<-"QZgods"

model=list(name=name,
           alias=alias,
           data=my_sccs,
           aux_data=my_aux,
           prox_list=list(language=Wll,distance=Wdd),
           dep_var="dep_var",
           indep_vars=indep_vars,
           restrict_vars=restrict_vars)

save(model,file=paste(alias,".Rdata",sep=""))

source("examples/src/run_model.R") #does for this model multiple imputation, two stage ols, saves to file to working directory.
lat<-sccs$v833.1
lon<-sccs$v833.2
plot(lon,lat, cex=.1)
ztxt=as.character(depvar) #above "my_sccs( " -- a new line inserted: depvar= as defined in my_sccs( 
ztxt<-gsub("NaN",".",ztxt)
text(lon,lat,ztxt)
ols_stats$restrict_stats
ols_stats$r2
ols_stats$restrict_diagnostics

7AAA Scott's code depvar Moral gods, indepvar pastoralExch and EVIL EYE!!!

add pastoralExch=pastoralExch=((sccs$v208==1)*1)*(sccs$v858==6)*1
setwd("/Users/drwhite/Documents/sccs")
setwd("C:/My Documents/sccs")
setwd("/Users/drwhite/Documents/sccs") #Macbook

library(sccs)
data(sccs)                                 

depvar=sccs$v238
my_sccs<-data.frame(
dep_var=sccs$v238,
pastoralExch=((sccs$v208==1)*1)*(sccs$v858==6)*1,
evileye=sccs$v1188,
evileyeDich=sccs$v1189,
socname=sccs$socname,socID=sccs$"sccs#",
famsize=sccs$v68,    # similar to v80
exogamy=sccs$v72,
#famsizeB=sccs$v80,   # similar to v68
money=sccs$v155,
popdens=sccs$v156,
premarsexatt=sccs$v165,
premarsexfrq=sccs$v166,
malesexag=sccs$v175,
ndrymonth=sccs$v196,
gath=sccs$v203,
hunt=sccs$v204,
fish=sccs$v205,
anim=sccs$v206,
bridewealth=(sccs$v208==1)*1,
nuclearfam=(sccs$v210<=3)*1,
ncmallow=sccs$v227,
cultints=sccs$v232,
tree=(sccs$v233==4)*1,
roots=(sccs$v233==5)*1,
cereals=(sccs$v233==6)*1,
settype=sccs$v234,
localjh=sccs$v236-1,
superjh=sccs$v237,
segadlboys=sccs$v242,
plow=(sccs$v243>1)*1,
pigs=(sccs$v244==2)*1,
bovines=(sccs$v244==7)*1,
milk=(sccs$v245>1)*1,
caststratLGd=log(1+sccs$v272), 
agrlateboy=sccs$v300,
valchild=(sccs$v473+sccs$v474+sccs$v475+sccs$v476),
fratgrpstr=sccs$v570,
Whyte577=sccs$v577,    #take care using Whyte variables - only coded 1/2 the sample
Whyte580=sccs$v580,
Whyte584=sccs$v583,
Whyte585=sccs$v584,
Whyte595=sccs$v594,
Whyte602=sccs$v602,
Whyte615=sccs$v615,
Whyte620=sccs$v620,
Whyte626=sccs$v626,
Whyte629=sccs$v629,
Whyte630=sccs$v630,
Whyte631=sccs$v631,
Whyte632=sccs$v632,
Whyte633=sccs$v633,
Whyte635=sccs$v635,
#                    #take care using Paige variables - coded less than 1/2 the sample
Paige657=sccs$v657,  # summed in v663#  Paige657 Paige658 Paige659 Paige660 Paige661 Paige662
femproduceND=sccs$v658, #Paige658=sccs$v658,  # summed in v663 
Paige659=sccs$v659,  # summed in v663
Paige660=sccs$v660,  # summed in v663
Paige661=sccs$v661,  # summed in v663
Paige662=sccs$v662,  # summed in v663
fempower=sccs$v663, # sum of v657-662
PCvioIntr=sccs$v666, #interperviol=sccs$v666,   ###synonyms: violence / interviol / freintovio
migr=(sccs$v677==2)*1,
#                    #take care using Sanday variables - only coded 1/2 the sample
Sanday664=sccs$v664,  # summed in v669
Sanday665=sccs$v665,  # summed in v669
Sanday666=sccs$v666,  # summed in v669
Sanday667=sccs$v667,  # summed in v669
Sanday668=sccs$v668,  # summed in v669
Sanday669=sccs$v669, # sum of v664-668 
 #WHYTE Data Quality Whyte718 Whyte719 Whyte720 Whyte721 Whyte722 Whyte723 Whyte724 Whyte725
hunger=sccs$v678,
Whyte718=sccs$v718,    #take care using Whyte variables - only coded 1/2 the sample
Whyte719=sccs$v719,
Whyte720=sccs$v720,
Whyte721=sccs$v721,
Whyte722=sccs$v722,
Whyte723=sccs$v723,
Whyte724=sccs$v724,
Whyte725=sccs$v725,
 #Rohner Data Quality Codes 
Rohner798=sccs$v798,
Rohner799=sccs$v799,
Rohner800=sccs$v800,
Rohner801=sccs$v801,
Rohner802=sccs$v802,
Rohner803=sccs$v803,
Rohner804=sccs$v804,
Rohner805=sccs$v805,
Rohner806=sccs$v806,
Rohner807=sccs$v807,
Rohner808=sccs$v808,
Rohner809=sccs$v809,
Rohner810=sccs$v810,
Rohner811=sccs$v811,
Rohner812=sccs$v812,
Rohner813=sccs$v813,
foodtrade=sccs$v819,
fem_agri=sccs$v821, 
dateobs=sccs$v838,
rain=sccs$v854,
temp=sccs$v855,
#ecorich=sccs$v857,
ecorich=(sccs$v857==3|sccs$v857==4)*1+(sccs$v857==5)*2,
pctFemPolyg=sccs$v872,
marrcaptives=sccs$v870,
femsubs=sccs$v890,
intwar=sccs$v891,    # similar to 1649
extwar=sccs$v892,    # similar to 1650
himilexp=(sccs$v899==1)*1,
plunder=sccs$v912,
AP1=sccs$v921,           ###agricultural potential 1
AP2=sccs$v928,           ###agricultural potential 2
pathstress=sccs$v1260,
war=sccs$v1648,     # overall -- sum of internal and external
intwarB=sccs$v1649,  # similar to v891
eextwar=sccs$v1650,  # similar to v892
foodscarc=sccs$v1685,
sexratio=1+(sccs$v1689>85)+(sccs$v1689>115),
wagelabor=sccs$v1732,
CVrain=sccs$v1914/sccs$v1913   #no comma
)  


indep_vars<-c( "evileyeDich", "evileye", "pastoralExch", "bridewealth", "milk", "ecorich","eextwar","hunger", "superjh",
"famsize", "caststratLGd", #,"exogamy",    "money","popdens","malesexag","ndrymonth","gath","hunt","fish",
#"anim","nuclearfam","ncmallow","cultints","tree","roots","cereals","settype","localjh",
#"segadlboys","plow","pigs","bovines","agrlateboy","valchild","fratgrpstr",
#"Whyte577","Whyte580","Whyte584","Whyte585","Whyte595","Whyte602","Whyte615","Whyte620","Whyte626","Whyte629",
#"Whyte630","Whyte631","Whyte632","Whyte633","Whyte635","Paige657","femproduceND","Paige659","Paige660",
"Paige661","Paige662","fempower","PCvioIntr","migr","Sanday664","Sanday665","Sanday666","Sanday667",
#"Sanday668","Sanday669","Whyte718","Whyte719","Whyte720","Whyte721","Whyte722","Whyte723","Whyte724",
#"Whyte725","Rohner798","Rohner799","Rohner800","Rohner801","Rohner802","Rohner803","Rohner804","Rohner805",
#"Rohner806","Rohner807","Rohner808","Rohner809","Rohner810","Rohner811","Rohner812","Rohner813","foodtrade","fem_agri",
"dateobs","rain","temp","pctFemPolyg","femsubs","intwar","extwar","himilexp","AP1","AP2") #,
#"pathstress","war","intwarB","foodscarc","sexratio","wagelabor","CVrain")


#restrictvars must drop one or more indepvars - in this case, dropping "premarsexatt"

#p=.117 ("evileyeDich",  
restrict_vars=c("evileye",  "superjh", "ecorich", "eextwar", "bridewealth", 
 "caststratLGd",  "pastoralExch") 
#restrict_vars=c("bridewealth", "milk", "ecorich","eextwar","hunger",
#"AP1", "PCvioIntr", "caststratLGd", "superjh") #v237

library(foreign)
#--Read in two weight matrices--
Wll<-as.matrix(read.dta("./examples/data/langwm.dta")[,-1])
Wdd<-as.matrix(read.dta("./examples/data/dist25wm.dta")[,c(-1,-2,-189)])

load("./examples/data/vaux.Rdata",.GlobalEnv)
my_aux = vaux
row.names(my_aux)<-NULL
#--remove the society name field--
my_aux<-my_aux[,-28]

name<-"god in human affair"
alias<-"QZgods"

model=list(name=name,
           alias=alias,
           data=my_sccs,
           aux_data=my_aux,
           prox_list=list(language=Wll,distance=Wdd),
           dep_var="dep_var",
           indep_vars=indep_vars,
           restrict_vars=restrict_vars)

save(model,file=paste(alias,".Rdata",sep=""))

source("examples/src/run_model.R") #does for this model multiple imputation, two stage ols, saves to file to working directory.
lat<-sccs$v833.1
lon<-sccs$v833.2
plot(lon,lat, cex=.1)
ztxt=as.character(depvar) #above "my_sccs( " -- a new line inserted: depvar= as defined in my_sccs( 
ztxt<-gsub("NaN",".",ztxt)
text(lon,lat,ztxt)
ols_stats$restrict_stats
ols_stats$r2
ols_stats$restrict_diagnostics

31 7BBB Scott's code depvar Moral gods, indepvar pastoralExch and EVIL EYE!!!

                coef   Fstat         ddf pvalue    VIF
(Intercept)   1.1790  2.3986   14118.726 0.1215     NA
language     -0.7434  2.6513   37606.006 0.1035 2.4469
distance      0.8756 29.2369 1181277.509 0.0000 2.4197
evileye       0.0922  4.9036   61943.253 0.0268 1.9392 <--reciprocal !!!
superjh       0.1519  5.9860    4571.372 0.0145 1.3773
ecorich      -0.2828  8.1171    6573.488 0.0044 1.1365
eextwar      -0.0332  9.1387     149.692 0.0029 1.0852
bridewealth   0.2674  2.7151  165341.227 0.0994 1.3703
caststratLGd  0.4526  1.8392    3988.172 0.1751 1.3172
pastoralExch  0.3930  1.5490    8933.541 0.2133 1.3518
>  ols_stats$r2
 R2:final model R2:IV_ language R2:IV_ distance 
      0.5006812       0.9760988       0.9846392 
>  ols_stats$restrict_diagnostics
               Fstat         df pvalue
RESET          1.241    482.211  0.266
Wald.on.restrs 1.707     24.933  0.203
NCV            2.365   8412.078  0.124
SW.normal      3.052    631.160  0.081
lag..language  1.752 293852.485  0.186
lag..distance  1.071  49618.344  0.301
Evil Eye alone (78% of the R2)
               coef   Fstat       ddf pvalue    VIF
(Intercept)  0.0291  0.0015  288280.4 0.9692     NA
language    -0.1296  0.0849  358874.0 0.7708 1.9797
distance     0.8035 21.5410 1144249.7 0.0000 2.3550
evileye      0.1549 13.3237  816835.7 0.0003 1.7165
>  ols_stats$r2
 R2:final model R2:IV_ language R2:IV_ distance 
      0.3903217       0.9754923       0.9862557 
>  ols_stats$restrict_diagnostics
               Fstat          df pvalue
RESET          0.273   737837.05  0.601
Wald.on.restrs 7.086       10.48  0.023
NCV            2.376    25702.82  0.123
SW.normal      4.566 36433314.22  0.033
lag..language  1.510   163541.78  0.219
lag..distance  0.847   114097.43  0.357

moneystate 7AAA Scott's code depvar Moral gods, indepvar pastoralExch and EVIL EYE and Whyte626!!!

 moneystate=(sccs$v237>=4)*1+((sccs$v155==5)*2)+((sccs$v155==4)*1)
add pastoralExch=pastoralExch=((sccs$v208==1)*1)*(sccs$v858==6)*1
setwd("C:/My Documents/sccs") 
library(sccs)
data(sccs) 
newstate=((sccs$v237>=4)*1)*log(sccs$v838) #dateobs) 
newstate=(((sccs$v237>=4)*1)*log(sccs$v838)>=7.5)*1
newstate
moneystate=(sccs$v237>=4)*1+(sccs$v155==5)*1 
#moneystate==4)*1*(sccs$v155==5)*1 
moneystate
#table(((sccs$v237>=4)*1),((sccs$v155==5)*1),useNA="ifany") #DOES NOT COMPUTE
table(newstate,moneystate,useNA="ifany")
       moneystate
newstate   0   1 <NA>
    0    153   4    0
    1      0  27    0
    <NA>   0   0    2
Produced by codes above
       moneystate
newstate   0   1   2 <NA>
    0    145   9   3    0
    1      0  13  14    0
    <NA>   0   0   0    2
BELOW FROM Dec "Model 2" probably just changed name of MoneyState to get Final 3
log(sccs$v838) #dateobs) 
newstate=(((sccs$v237>=4)*1)*log(sccs$v838)>=7.5)*1
newstate
moneystate=(sccs$v237>=4)*1*(sccs$v155==5)*1 
moneystate 
#table(((sccs$v237>=4)*1),((sccs$v155==5)*1),useNA="ifany") #DOES NOT COMPUTE
table(newstate,moneystate,useNA="ifany")
         moneystate
newstate   0   1 <NA>
    0    154   3    0
    1     13  14    0
    <NA>   0   0    2link title
setwd("/Users/drwhite/Documents/sccs") #Macbook
setwd("/Users/drwhite/Documents/sccs")
setwd("C:/My Documents/sccs") 
library(sccs)
data(sccs)                                 

depvar=sccs$v238
my_sccs<-data.frame(
dep_var=sccs$v238,
#moneystate=((sccs$v237>=4)*1)*log(sccs$v838),  #WAS NEWSTATE
#moneystate=(((sccs$v237>=4)*1)*log(sccs$v838)>=7.5)*1, #WAS NEWSTATE
 moneystate=((sccs$v237>=4)*1)*(sccs$v155==5)*1,  #MONEYSTATE  
#moneystate=(sccs$v237>=4)*1*((sccs$v155==5)*2)+((sccs$v155==4)*1),
pastoralExch=((sccs$v208==1)*1)*(sccs$v858==6)*1,
evileye=sccs$v1188,
evileyeDich=sccs$v1189,
socname=sccs$socname,socID=sccs$"sccs#",
famsize=sccs$v68,    # similar to v80
exogamy=sccs$v72,
#famsizeB=sccs$v80,   # similar to v68
money=sccs$v155,
popdens=sccs$v156,
premarsexatt=sccs$v165,
premarsexfrq=sccs$v166,
malesexag=sccs$v175,
ndrymonth=sccs$v196,
gath=sccs$v203,
hunt=sccs$v204,
fish=sccs$v205,
anim=sccs$v206,
bridewealth=(sccs$v208==1)*1,
nuclearfam=(sccs$v210<=3)*1,
ncmallow=sccs$v227,
cultints=sccs$v232,
tree=(sccs$v233==4)*1,
roots=(sccs$v233==5)*1,
cereals=(sccs$v233==6)*1,
settype=sccs$v234,
localjh=sccs$v236-1,
superjh=sccs$v237,
segadlboys=sccs$v242,
plow=(sccs$v243>1)*1,
pigs=(sccs$v244==2)*1,
bovines=(sccs$v244==7)*1,
milk=(sccs$v245>1)*1,
caststratLGd=log(1+sccs$v272), 
agrlateboy=sccs$v300,
valchild=(sccs$v473+sccs$v474+sccs$v475+sccs$v476),
fratgrpstr=sccs$v570,
Whyte577=sccs$v577,    #take care using Whyte variables - only coded 1/2 the sample
Whyte580=sccs$v580,
Whyte584=sccs$v583,
Whyte585=sccs$v584,
Whyte595=sccs$v594,
Whyte602=sccs$v602,
Whyte615=sccs$v615,
Whyte620=sccs$v620,
Whyte626=sccs$v626,
Whyte629=sccs$v629,
Whyte630=sccs$v630,
Whyte631=sccs$v631,
Whyte632=sccs$v632,
Whyte633=sccs$v633,
Whyte635=sccs$v635,
#                    #take care using Paige variables - coded less than 1/2 the sample
Paige657=sccs$v657,  # summed in v663#  Paige657 Paige658 Paige659 Paige660 Paige661 Paige662
femproduceND=sccs$v658, #Paige658=sccs$v658,  # summed in v663 
Paige659=sccs$v659,  # summed in v663
Paige660=sccs$v660,  # summed in v663
Paige661=sccs$v661,  # summed in v663
Paige662=sccs$v662,  # summed in v663
fempower=sccs$v663, # sum of v657-662
PCvioIntr=sccs$v666, #interperviol=sccs$v666,   ###synonyms: violence / interviol / freintovio
migr=(sccs$v677==2)*1,
#                    #take care using Sanday variables - only coded 1/2 the sample
Sanday664=sccs$v664,  # summed in v669
Sanday665=sccs$v665,  # summed in v669
Sanday666=sccs$v666,  # summed in v669
Sanday667=sccs$v667,  # summed in v669
Sanday668=sccs$v668,  # summed in v669
Sanday669=sccs$v669, # sum of v664-668 
 #WHYTE Data Quality Whyte718 Whyte719 Whyte720 Whyte721 Whyte722 Whyte723 Whyte724 Whyte725
hunger=sccs$v678,
Whyte718=sccs$v718,    #take care using Whyte variables - only coded 1/2 the sample
Whyte719=sccs$v719,
Whyte720=sccs$v720,
Whyte721=sccs$v721,
Whyte722=sccs$v722,
Whyte723=sccs$v723,
Whyte724=sccs$v724,
Whyte725=sccs$v725,
 #Rohner Data Quality Codes 
Rohner798=sccs$v798,
Rohner799=sccs$v799,
Rohner800=sccs$v800,
Rohner801=sccs$v801,
Rohner802=sccs$v802,
Rohner803=sccs$v803,
Rohner804=sccs$v804,
Rohner805=sccs$v805,
Rohner806=sccs$v806,
Rohner807=sccs$v807,
Rohner808=sccs$v808,
Rohner809=sccs$v809,
Rohner810=sccs$v810,
Rohner811=sccs$v811,
Rohner812=sccs$v812,
Rohner813=sccs$v813,
foodtrade=sccs$v819,
fem_agri=sccs$v821, 
dateobs=sccs$v838,
rain=sccs$v854,
temp=sccs$v855,
#ecorich=sccs$v857,
ecorich=(sccs$v857==3|sccs$v857==4)*1+(sccs$v857==5)*2,
pctFemPolyg=sccs$v872,
marrcaptives=sccs$v870,
femsubs=sccs$v890,
intwar=sccs$v891,    # similar to 1649
extwar=sccs$v892,    # similar to 1650
himilexp=(sccs$v899==1)*1,
plunder=sccs$v912,
AP1=sccs$v921,           ###agricultural potential 1
AP2=sccs$v928,           ###agricultural potential 2
pathstress=sccs$v1260,
war=sccs$v1648,     # overall -- sum of internal and external
intwarB=sccs$v1649,  # similar to v891
eextwar=sccs$v1650,  # similar to v892
foodscarc=sccs$v1685,
sexratio=1+(sccs$v1689>85)+(sccs$v1689>115),
wagelabor=sccs$v1732,
CVrain=sccs$v1914/sccs$v1913   #no comma
)  


indep_vars<-c("moneystate","evileyeDich", "evileye", "pastoralExch", "bridewealth", "milk", "ecorich","eextwar","hunger", "superjh",
"famsize", "caststratLGd", #,"exogamy",    "money","popdens","malesexag","ndrymonth","gath","hunt","fish",
#"anim","nuclearfam","ncmallow","cultints","tree","roots","cereals","settype","localjh",
#"segadlboys","plow","pigs","bovines","agrlateboy","valchild","fratgrpstr",
#"Whyte577","Whyte580","Whyte584","Whyte585","Whyte595","Whyte602","Whyte615","Whyte620", 
"Whyte626",
#"Whyte629",
#"Whyte630","Whyte631","Whyte632","Whyte633","Whyte635","Paige657","femproduceND","Paige659","Paige660",
"Paige661","Paige662","fempower","PCvioIntr","migr","Sanday664","Sanday665","Sanday666","Sanday667",
#"Sanday668","Sanday669","Whyte718","Whyte719","Whyte720","Whyte721","Whyte722","Whyte723","Whyte724",
#"Whyte725","Rohner798","Rohner799","Rohner800","Rohner801","Rohner802","Rohner803","Rohner804","Rohner805",
#"Rohner806","Rohner807","Rohner808","Rohner809","Rohner810","Rohner811","Rohner812","Rohner813","foodtrade","fem_agri",
"dateobs","rain","temp","pctFemPolyg","femsubs","intwar","extwar","himilexp","AP1","AP2") #,
#"pathstress","war","intwarB","foodscarc","sexratio","wagelabor","CVrain")


#restrictvars must drop one or more indepvars - in this case, dropping "premarsexatt"

#p=.117 ("evileyeDich",  
restrict_vars=c("moneystate", #"superjh",  
"evileye",  "ecorich", "eextwar", #"bridewealth",  
#"Whyte626",
"caststratLGd",  "pastoralExch") 
#restrict_vars=c("bridewealth", "milk", "ecorich","eextwar","hunger",
#"AP1", "PCvioIntr", "caststratLGd", "superjh") #v237

library(foreign)
#--Read in two weight matrices--
Wll<-as.matrix(read.dta("./examples/data/langwm.dta")[,-1])
Wdd<-as.matrix(read.dta("./examples/data/dist25wm.dta")[,c(-1,-2,-189)])

load("./examples/data/vaux.Rdata",.GlobalEnv)
my_aux = vaux
row.names(my_aux)<-NULL
#--remove the society name field--
my_aux<-my_aux[,-28]

name<-"god in human affair"
alias<-"QZgods"

model=list(name=name,
           alias=alias,
           data=my_sccs,
           aux_data=my_aux,
           prox_list=list(language=Wll,distance=Wdd),
           dep_var="dep_var",
           indep_vars=indep_vars,
           restrict_vars=restrict_vars)

save(model,file=paste(alias,".Rdata",sep=""))

source("examples/src/run_model.R") #does for this model multiple imputation, two stage ols, saves to file to working directory.
ols_stats$restrict_stats
ols_stats$r2
ols_stats$restrict_diagnostics
aaa<-c(table(depvar), NROW(depvar),name)
#imp<-"number of imputations nimp="
#impute=c(imp,nimp)
aaa
lat<-sccs$v833.1
lon<-sccs$v833.2
plot(lon,lat, cex=.1)
ztxt=as.character(depvar) #above "my_sccs( " -- a new line inserted: depvar= as defined in my_sccs( 
ztxt<-gsub("NaN",".",ztxt)
text(lon,lat,ztxt)

Final model 2

bridewealth p=.08 taken out because it overlaps in meaning with PastoralExch
newstate dichotomized to remove the older tributary empires with highest levels of superjh 
Effectively, newstate(s) are monetized states (could excluded Aztec and Inca as well)
Newstate could be redefined as superjh==5 * money==4 i.e., MoneyStates
                coef   Fstat        ddf pvalue    VIF
(Intercept)   0.8218  1.1659 38625.0036 0.2803     NA
language     -0.4886  1.1980 84985.6946 0.2737 2.2237
distance      0.8506 26.1706 25885.3513 0.0000 2.4124
newstate      0.0446  2.7472 46456.7368 0.0974 1.2509
evileye       0.1040  5.7775   930.3656 0.0164 1.9233
ecorich      -0.2201  4.9736 44417.9828 0.0257 1.0745
eextwar      -0.0290  6.9685   743.2881 0.0085 1.0742
caststratLGd  0.5396  2.5709  4237.1802 0.1089 1.2701
pastoralExch  0.5488  3.0908  5760.9615 0.0788 1.2499
>  ols_stats$r2
 R2:final model R2:IV_ language R2:IV_ distance 
      0.4704268       0.9757884       0.9866815 
>  ols_stats$restrict_diagnostics
               Fstat         df pvalue
RESET          0.580   4530.351  0.446
Wald.on.restrs 4.129     77.831  0.046
NCV            2.459 272755.923  0.117
SW.normal      3.541    877.642  0.060
lag..language  2.123 140845.779  0.145
lag..distance  1.278   2708.469  0.258

Final model 3

Moral Gods CANNOT REPRODUCE - SEE BELOW
                coef   Fstat         ddf pvalue    VIF
(Intercept)   0.7925  1.1150   8940.4772 0.2910     NA
language     -0.4745  1.1441   6158.9424 0.2848 2.2120
distance      0.8663 27.5494  20175.6651 0.0000 2.4104
moneystate    0.0486  3.3703   1666.8047 0.0666 1.2193 moneystate=((sccs$v237>=4)*1)*(sccs$v155==5)*1
evileye       0.1006  5.6799 246115.4130 0.0172 1.9249
ecorich      -0.2150  4.8353 206724.7364 0.0279 1.0742
eextwar      -0.0325  8.8536    280.3989 0.0032 1.0674
caststratLGd  0.5459  2.6781  14734.6445 0.1018 1.2652
pastoralExch  0.5527  3.2227  45967.6929 0.0726 1.2464
>  ols_stats$r2
 R2:final model R2:IV_ language R2:IV_ distance 
      0.4786708       0.9772413       0.9858183 
>  ols_stats$restrict_diagnostics
               Fstat        df pvalue
RESET          1.217 10204.998  0.270
Wald.on.restrs 2.057    16.391  0.170
NCV            2.863  2011.170  0.091
SW.normal      3.147   870.801  0.076
lag..language  1.902  3483.142  0.168
lag..distance  1.293  6737.784  0.255
THIS IS WHAT I GET NOW
                coef   Fstat         ddf pvalue    VIF
(Intercept)   0.5026  0.4473   6230.4439 0.5036     NA
language     -0.3518  0.6147   2657.4889 0.4331 2.1891
distance      0.8592 26.2096  19066.1616 0.0000 2.4313
moneystate    0.0465  0.0353   5753.6138 0.8509 1.1576
evileye       0.1062  6.1380  25822.4784 0.0132 1.9265
ecorich      -0.2179  4.8293  73829.2659 0.0280 1.0756
eextwar      -0.0293  6.6633     89.9524 0.0115 1.0352
caststratLGd  0.6247  3.4657 167725.1194 0.0627 1.2808
pastoralExch  0.4840  2.3154    870.6106 0.1285 1.2564
> ols_stats$r2
 R2:final model R2:IV_ language R2:IV_ distance 
      0.4652749       0.9769784       0.9866153 
> ols_stats$restrict_diagnostics
               Fstat         df pvalue
RESET          0.558    605.416  0.455
Wald.on.restrs 3.168     14.382  0.096
NCV            1.463   1043.658  0.227
SW.normal      4.349  10674.292  0.037
lag..language  1.768   2129.947  0.184
lag..distance  1.000 883083.310  0.317

7BBB no Whyte626 effect!!!

                coef   Fstat         ddf pvalue    VIF
(Intercept)   1.6734  3.3182    120.8473 0.0710     NA
language     -0.8282  3.1067    799.1685 0.0784 2.5004
distance      0.8919 29.1811   4594.8458 0.0000 2.4701
evileye       0.0883  4.3892   8346.9871 0.0362 1.9679
superjh       0.1350  4.3381    920.9793 0.0375 1.4685
ecorich      -0.2672  7.2600 205421.2664 0.0071 1.1432
eextwar      -0.0310  7.8778    156.4228 0.0056 1.0918
bridewealth   0.2699  2.6968   1840.0279 0.1007 1.3704
Whyte626     -0.1761  1.0489     48.2845 0.3109 1.2151 <-- n.s. No belief in female inferiority
caststratLGd  0.4027  1.4561 422960.0260 0.2275 1.3274
pastoralExch  0.4214  1.7580   4932.3858 0.1849 1.3600
>  ols_stats$r2
 R2:final model R2:IV_ language R2:IV_ distance 
      0.5024085       0.9759511       0.9838705 
>  ols_stats$restrict_diagnostics
               Fstat        df pvalue
RESET          1.201   164.290  0.275
Wald.on.restrs 1.420   166.344  0.235
NCV            2.086 20234.753  0.149
SW.normal      3.478   791.064  0.063
lag..language  1.781 20891.999  0.182
lag..distance  1.056 48144.601  0.304

27 7AAA Scott's code depvar Moral gods, indepvar pastoralExch

EXPERIMENT substituted himilexp for eextwar, did not succeed
add pastoralExch=pastoralExch=((sccs$v208==1)*1)*(sccs$v858==6)*1
setwd("/Users/drwhite/Documents/sccs")
setwd("C:/My Documents/sccs")
#setwd("/Users/drwhite/Documents/sccs") #Macbook

library(sccs)
data(sccs)                                 

depvar=sccs$v238
my_sccs<-data.frame(
dep_var=sccs$v238,
pastoralExch=((sccs$v208==1)*1)*(sccs$v858==6)*1,
socname=sccs$socname,socID=sccs$"sccs#",
famsize=sccs$v68,    # similar to v80
exogamy=sccs$v72,
#famsizeB=sccs$v80,   # similar to v68
money=sccs$v155,
popdens=sccs$v156,
premarsexatt=sccs$v165,
premarsexfrq=sccs$v166,
malesexag=sccs$v175,
ndrymonth=sccs$v196,
gath=sccs$v203,
hunt=sccs$v204,
fish=sccs$v205,
anim=sccs$v206,
bridewealth=(sccs$v208==1)*1,
nuclearfam=(sccs$v210<=3)*1,
ncmallow=sccs$v227,
cultints=sccs$v232,
tree=(sccs$v233==4)*1,
roots=(sccs$v233==5)*1,
cereals=(sccs$v233==6)*1,
settype=sccs$v234,
localjh=sccs$v236-1,
superjh=sccs$v237,
segadlboys=sccs$v242,
plow=(sccs$v243>1)*1,
pigs=(sccs$v244==2)*1,
bovines=(sccs$v244==7)*1,
milk=(sccs$v245>1)*1,
caststratLGd=log(1+sccs$v272), 
agrlateboy=sccs$v300,
valchild=(sccs$v473+sccs$v474+sccs$v475+sccs$v476),
fratgrpstr=sccs$v570,
Whyte577=sccs$v577,    #take care using Whyte variables - only coded 1/2 the sample
Whyte580=sccs$v580,
Whyte584=sccs$v583,
Whyte585=sccs$v584,
Whyte595=sccs$v594,
Whyte602=sccs$v602,
Whyte615=sccs$v615,
Whyte620=sccs$v620,
Whyte626=sccs$v626,
Whyte629=sccs$v629,
Whyte630=sccs$v630,
Whyte631=sccs$v631,
Whyte632=sccs$v632,
Whyte633=sccs$v633,
Whyte635=sccs$v635,
#                    #take care using Paige variables - coded less than 1/2 the sample
Paige657=sccs$v657,  # summed in v663#  Paige657 Paige658 Paige659 Paige660 Paige661 Paige662
femproduceND=sccs$v658, #Paige658=sccs$v658,  # summed in v663 
Paige659=sccs$v659,  # summed in v663
Paige660=sccs$v660,  # summed in v663
Paige661=sccs$v661,  # summed in v663
Paige662=sccs$v662,  # summed in v663
fempower=sccs$v663, # sum of v657-662
PCvioIntr=sccs$v666, #interperviol=sccs$v666,   ###synonyms: violence / interviol / freintovio
migr=(sccs$v677==2)*1,
#                    #take care using Sanday variables - only coded 1/2 the sample
Sanday664=sccs$v664,  # summed in v669
Sanday665=sccs$v665,  # summed in v669
Sanday666=sccs$v666,  # summed in v669
Sanday667=sccs$v667,  # summed in v669
Sanday668=sccs$v668,  # summed in v669
Sanday669=sccs$v669, # sum of v664-668 
 #WHYTE Data Quality Whyte718 Whyte719 Whyte720 Whyte721 Whyte722 Whyte723 Whyte724 Whyte725
hunger=sccs$v678,
Whyte718=sccs$v718,    #take care using Whyte variables - only coded 1/2 the sample
Whyte719=sccs$v719,
Whyte720=sccs$v720,
Whyte721=sccs$v721,
Whyte722=sccs$v722,
Whyte723=sccs$v723,
Whyte724=sccs$v724,
Whyte725=sccs$v725,
 #Rohner Data Quality Codes 
Rohner798=sccs$v798,
Rohner799=sccs$v799,
Rohner800=sccs$v800,
Rohner801=sccs$v801,
Rohner802=sccs$v802,
Rohner803=sccs$v803,
Rohner804=sccs$v804,
Rohner805=sccs$v805,
Rohner806=sccs$v806,
Rohner807=sccs$v807,
Rohner808=sccs$v808,
Rohner809=sccs$v809,
Rohner810=sccs$v810,
Rohner811=sccs$v811,
Rohner812=sccs$v812,
Rohner813=sccs$v813,
foodtrade=sccs$v819,
fem_agri=sccs$v821, 
dateobs=sccs$v838,
rain=sccs$v854,
temp=sccs$v855,
#ecorich=sccs$v857,
ecorich=(sccs$v857==3|sccs$v857==4)*1+(sccs$v857==5)*2,
pctFemPolyg=sccs$v872,
marrcaptives=sccs$v870,
femsubs=sccs$v890,
intwar=sccs$v891,    # similar to 1649
extwar=sccs$v892,    # similar to 1650
himilexp=(sccs$v899==1)*1,
plunder=sccs$v912,
AP1=sccs$v921,           ###agricultural potential 1
AP2=sccs$v928,           ###agricultural potential 2
pathstress=sccs$v1260,
war=sccs$v1648,     # overall -- sum of internal and external
intwarB=sccs$v1649,  # similar to v891
eextwar=sccs$v1650,  # similar to v892
foodscarc=sccs$v1685,
sexratio=1+(sccs$v1689>85)+(sccs$v1689>115),
wagelabor=sccs$v1732,
CVrain=sccs$v1914/sccs$v1913   #no comma
)  


indep_vars<-c("bridewealth", "milk", "ecorich","eextwar","hunger", "superjh","himilexp",
"famsize", "caststratLGd", #,"exogamy",    "money","popdens","malesexag","ndrymonth","gath","hunt","fish",
#"anim","nuclearfam","ncmallow","cultints","tree","roots","cereals","settype","localjh",
#"segadlboys","plow","pigs","bovines","agrlateboy","valchild","fratgrpstr",
#"Whyte577","Whyte580","Whyte584","Whyte585","Whyte595","Whyte602","Whyte615","Whyte620","Whyte626","Whyte629",
#"Whyte630","Whyte631","Whyte632","Whyte633","Whyte635","Paige657","femproduceND","Paige659","Paige660",
"Paige661","Paige662","fempower","PCvioIntr","migr","Sanday664","Sanday665","Sanday666","Sanday667",
#"Sanday668","Sanday669","Whyte718","Whyte719","Whyte720","Whyte721","Whyte722","Whyte723","Whyte724",
#"Whyte725","Rohner798","Rohner799","Rohner800","Rohner801","Rohner802","Rohner803","Rohner804","Rohner805",
#"Rohner806","Rohner807","Rohner808","Rohner809","Rohner810","Rohner811","Rohner812","Rohner813","foodtrade","fem_agri",
"dateobs","rain","temp","pctFemPolyg","femsubs","intwar","extwar","himilexp","AP1","AP2") #,
#"pathstress","war","intwarB","foodscarc","sexratio","wagelabor","CVrain"
#)


#restrictvars must drop one or more indepvars - in this case, dropping "premarsexatt"

restrict_vars=c("superjh", "ecorich", "himilexp",  "bridewealth", 
#"eextwar", "bridewealth", 
 "caststratLGd",  "pastoralExch") 
#restrict_vars=c("bridewealth", "milk", "ecorich","eextwar","hunger",
#"AP1", "PCvioIntr", "caststratLGd", "superjh") #v237

library(foreign)
#--Read in two weight matrices--
Wll<-as.matrix(read.dta("./examples/data/langwm.dta")[,-1])
Wdd<-as.matrix(read.dta("./examples/data/dist25wm.dta")[,c(-1,-2,-189)])

load("./examples/data/vaux.Rdata",.GlobalEnv)
my_aux = vaux
row.names(my_aux)<-NULL
#--remove the society name field--
my_aux<-my_aux[,-28]

name<-"god in human affair"
alias<-"QZgods"

model=list(name=name,
           alias=alias,
           data=my_sccs,
           aux_data=my_aux,
           prox_list=list(language=Wll,distance=Wdd),
           dep_var="dep_var",
           indep_vars=indep_vars,
           restrict_vars=restrict_vars)

save(model,file=paste(alias,".Rdata",sep=""))

source("examples/src/run_model.R") #does for this model multiple imputation, two stage ols, saves to file to working directory.
lat<-sccs$v833.1
lon<-sccs$v833.2
plot(lon,lat, cex=.1)
ztxt=as.character(depvar) #above "my_sccs( " -- a new line inserted: depvar= as defined in my_sccs( 
ztxt<-gsub("NaN",".",ztxt)
text(lon,lat,ztxt)
ols_stats$restrict_stats
ols_stats$r2
ols_stats$restrict_diagnostics

B Newstate

                coef   Fstat         ddf pvalue    VIF
(Intercept)   0.8939  1.3935   3316.4319 0.2379     NA
language     -0.5477  1.4991   3724.9368 0.2209 2.2180
distance      0.8609 26.6334   6542.6659 0.0000 2.4259
newstate      0.3820  3.5859  37690.6741 0.0583 1.2032
evileye       0.1053  6.1265  11087.8670 0.0133 1.9226
ecorich      -0.2195  5.0027  66120.9182 0.0253 1.0710
eextwar      -0.0289  6.2444     68.1571 0.0149 1.0682
caststratLGd  0.5693  2.9149 147990.2226 0.0878 1.2571
pastoralExch  0.5518  3.1859  32631.1185 0.0743 1.2445
>  ols_stats$r2
 R2:final model R2:IV_ language R2:IV_ distance 
      0.4739916       0.9760910       0.9855489 
>  ols_stats$restrict_diagnostics
               Fstat         df pvalue
RESET          0.927   1386.436  0.336
Wald.on.restrs 3.425     18.572  0.080
NCV            1.647    894.392  0.200
SW.normal      3.215    509.211  0.074
lag..language  1.825  11294.956  0.177

moneystate 7AAA Scott's code depvar Moral gods, indepvar pastoralExch and EVIL EYE and Whyte626!!!

 moneystate=(SCCS$v237>=4)*1*((SCCS$v155==5)*2)+((SCCS$v155==4)*1)
 moneystate=(sccs$v237>=4)*1*((sccs$v155==5)*2)+((sccs$v155==4)*1)
moneystate=((sccs$v237>=4)*1)*((sccs$v155==5)*2)+((sccs$v155==4)*1)
add pastoralExch=pastoralExch=((sccs$v208==1)*1)*(sccs$v858==6)*1
setwd("C:/My Documents/sccs") 
library(sccs)
data(sccs) 
#newstate=((sccs$v237>=4)*1)*log(sccs$v838) #dateobs) BC coded as positive, e.g., -1750 (BC) => 1750
#newstate=(((sccs$v237>=4)*1)*log(sccs$v838)>=7.5)*1
HOW SIMILAR IS STATE TO NEWSTATE
new=(sccs$v838>=1600)*1
table(new)
 new[45]=0
table(new)
state=(sccs$v237>=4)*1
newstate=((sccs$v237>=4)*1)*(new)*1
table(newstate,state,useNA="ifany")
           state
newstate   0   1 <NA>
    0    153   4    0 row ok
    1      0  27    0 row ok
    <NA>   0   0    2
HOW SIMILAR IS MONEYSTATE TO NEWSTATE
               state                 money
moneystate=((sccs$v237>=4)*1)*((sccs$v155==5)*1)
#moneystate=(sccs$v155==5)*1
#moneystate=((sccs$v237>=4)*1)*((sccs$v155==5)*2)+((sccs$v155==4)*1)
moneystate
table(moneystate)
      0 c12          2  1 a   b         b     a  c 
#table( ((sccs$v237>=4)*1)*((log(sccs$v838)>=7.5)*1), ((sccs$v155==5)*1) ,useNA="ifany") #DOES NOT COMPUTE
table(newstate,moneystate,useNA="ifany")
       moneystate
newstate   0   1 <NA>
    0    153   4    0 row ok
    1      0  27    0 row ok
    <NA>   0   0    2
         167  25?   ==5 for v155 ok #table
         161  25?   ==5 correct


setwd("/Users/drwhite/Documents/sccs") #Macbook
setwd("/Users/drwhite/Documents/sccs")
setwd("C:/My Documents/sccs") 
library(sccs)
data(sccs)                                 

depvar=sccs$v238
#NEWSTATE
new=(sccs$v838>=1600)*1
table(new)
 new[45]=0 state=(sccs$v237>=4)*1
newstate=((sccs$v237>=4)*1)*(new)*1
table(new)
table(newstate)


my_sccs<-data.frame(
dep_var=sccs$v238,
#moneystate=((sccs$v237>=4)*1)*log(sccs$v838),  #WAS NEWSTATE
#moneystate=(((sccs$v237>=4)*1)*log(sccs$v838)>=7.5)*1, #WAS NEWSTATE
#moneystate=(sccs$v237>=4)*1+(sccs$v155==5)*1,  #MONEYSTATE  
moneystate=((sccs$v237>=4)*1)*((sccs$v155==5)*2)+((sccs$v155==4)*1),
state=(sccs$v237>=4)*1,
newstate=((sccs$v237>=4)*1)*(new)*1,
pastoralExch=((sccs$v208==1)*1)*(sccs$v858==6)*1,
evileye=sccs$v1188,
evileyeDich=sccs$v1189,
socname=sccs$socname,socID=sccs$"sccs#",
famsize=sccs$v68,    # similar to v80
exogamy=sccs$v72,
#famsizeB=sccs$v80,   # similar to v68
money=sccs$v155,
popdens=sccs$v156,
premarsexatt=sccs$v165,
premarsexfrq=sccs$v166,
malesexag=sccs$v175,
ndrymonth=sccs$v196,
gath=sccs$v203,
hunt=sccs$v204,
fish=sccs$v205,
anim=sccs$v206,
bridewealth=(sccs$v208==1)*1,
nuclearfam=(sccs$v210<=3)*1,
ncmallow=sccs$v227,
cultints=sccs$v232,
tree=(sccs$v233==4)*1,
roots=(sccs$v233==5)*1,
cereals=(sccs$v233==6)*1,
settype=sccs$v234,
localjh=sccs$v236-1,
superjh=sccs$v237,
segadlboys=sccs$v242,
plow=(sccs$v243>1)*1,
pigs=(sccs$v244==2)*1,
bovines=(sccs$v244==7)*1,
milk=(sccs$v245>1)*1,
caststratLGd=log(1+sccs$v272), 
agrlateboy=sccs$v300,
valchild=(sccs$v473+sccs$v474+sccs$v475+sccs$v476),
fratgrpstr=sccs$v570,
Whyte577=sccs$v577,    #take care using Whyte variables - only coded 1/2 the sample
Whyte580=sccs$v580,
Whyte584=sccs$v583,
Whyte585=sccs$v584,
Whyte595=sccs$v594,
Whyte602=sccs$v602,
Whyte615=sccs$v615,
Whyte620=sccs$v620,
Whyte626=sccs$v626,
Whyte629=sccs$v629,
Whyte630=sccs$v630,
Whyte631=sccs$v631,
Whyte632=sccs$v632,
Whyte633=sccs$v633,
Whyte635=sccs$v635,
#                    #take care using Paige variables - coded less than 1/2 the sample
Paige657=sccs$v657,  # summed in v663#  Paige657 Paige658 Paige659 Paige660 Paige661 Paige662
femproduceND=sccs$v658, #Paige658=sccs$v658,  # summed in v663 
Paige659=sccs$v659,  # summed in v663
Paige660=sccs$v660,  # summed in v663
Paige661=sccs$v661,  # summed in v663
Paige662=sccs$v662,  # summed in v663
fempower=sccs$v663, # sum of v657-662
PCvioIntr=sccs$v666, #interperviol=sccs$v666,   ###synonyms: violence / interviol / freintovio
migr=(sccs$v677==2)*1,
#                    #take care using Sanday variables - only coded 1/2 the sample
Sanday664=sccs$v664,  # summed in v669
Sanday665=sccs$v665,  # summed in v669
Sanday666=sccs$v666,  # summed in v669
Sanday667=sccs$v667,  # summed in v669
Sanday668=sccs$v668,  # summed in v669
Sanday669=sccs$v669, # sum of v664-668 
 #WHYTE Data Quality Whyte718 Whyte719 Whyte720 Whyte721 Whyte722 Whyte723 Whyte724 Whyte725
hunger=sccs$v678,
Whyte718=sccs$v718,    #take care using Whyte variables - only coded 1/2 the sample
Whyte719=sccs$v719,
Whyte720=sccs$v720,
Whyte721=sccs$v721,
Whyte722=sccs$v722,
Whyte723=sccs$v723,
Whyte724=sccs$v724,
Whyte725=sccs$v725,
 #Rohner Data Quality Codes 
Rohner798=sccs$v798,
Rohner799=sccs$v799,
Rohner800=sccs$v800,
Rohner801=sccs$v801,
Rohner802=sccs$v802,
Rohner803=sccs$v803,
Rohner804=sccs$v804,
Rohner805=sccs$v805,
Rohner806=sccs$v806,
Rohner807=sccs$v807,
Rohner808=sccs$v808,
Rohner809=sccs$v809,
Rohner810=sccs$v810,
Rohner811=sccs$v811,
Rohner812=sccs$v812,
Rohner813=sccs$v813,
foodtrade=sccs$v819,
fem_agri=sccs$v821, 
dateobs=sccs$v838,
rain=sccs$v854,
temp=sccs$v855,
#ecorich=sccs$v857,
ecorich=(sccs$v857==3|sccs$v857==4)*1+(sccs$v857==5)*2,
pctFemPolyg=sccs$v872,
marrcaptives=sccs$v870,
femsubs=sccs$v890,
intwar=sccs$v891,    # similar to 1649
extwar=sccs$v892,    # similar to 1650
himilexp=(sccs$v899==1)*1,
plunder=sccs$v912,
AP1=sccs$v921,           ###agricultural potential 1
AP2=sccs$v928,           ###agricultural potential 2
pathstress=sccs$v1260,
war=sccs$v1648,     # overall -- sum of internal and external
intwarB=sccs$v1649,  # similar to v891
eextwar=sccs$v1650,  # similar to v892
foodscarc=sccs$v1685,
sexratio=1+(sccs$v1689>85)+(sccs$v1689>115),
wagelabor=sccs$v1732,
CVrain=sccs$v1914/sccs$v1913   #no comma
)  


indep_vars<-c("newstate",
"moneystate","evileyeDich", "evileye", "pastoralExch", "bridewealth", "milk", "ecorich","eextwar","hunger", "superjh",
"famsize", "caststratLGd", #,"exogamy",    "money","popdens","malesexag","ndrymonth","gath","hunt","fish",
#"anim","nuclearfam","ncmallow","cultints","tree","roots","cereals","settype","localjh",
#"segadlboys","plow","pigs","bovines","agrlateboy","valchild","fratgrpstr",
#"Whyte577","Whyte580","Whyte584","Whyte585","Whyte595","Whyte602","Whyte615","Whyte620", 
"Whyte626",
#"Whyte629",
#"Whyte630","Whyte631","Whyte632","Whyte633","Whyte635","Paige657","femproduceND","Paige659","Paige660",
"Paige661","Paige662","fempower","PCvioIntr","migr","Sanday664","Sanday665","Sanday666","Sanday667",
#"Sanday668","Sanday669","Whyte718","Whyte719","Whyte720","Whyte721","Whyte722","Whyte723","Whyte724",
#"Whyte725","Rohner798","Rohner799","Rohner800","Rohner801","Rohner802","Rohner803","Rohner804","Rohner805",
#"Rohner806","Rohner807","Rohner808","Rohner809","Rohner810","Rohner811","Rohner812","Rohner813","foodtrade","fem_agri",
"dateobs","rain","temp","pctFemPolyg","femsubs","intwar","extwar","himilexp","AP1","AP2") #,
#"pathstress","war","intwarB","foodscarc","sexratio","wagelabor","CVrain")


#restrictvars must drop one or more indepvars - in this case, dropping "premarsexatt"

#p=.117 ("evileyeDich",  
restrict_vars=c( "newstate",
"moneystate", #"superjh",  
"evileye",  "ecorich", "eextwar", #"bridewealth",  
#"Whyte626",
"caststratLGd",  "pastoralExch") 
#restrict_vars=c("bridewealth", "milk", "ecorich","eextwar","hunger",
#"AP1", "PCvioIntr", "caststratLGd", "superjh") #v237

library(foreign)
#--Read in two weight matrices--
Wll<-as.matrix(read.dta("./examples/data/langwm.dta")[,-1])
Wdd<-as.matrix(read.dta("./examples/data/dist25wm.dta")[,c(-1,-2,-189)])

load("./examples/data/vaux.Rdata",.GlobalEnv)
my_aux = vaux
row.names(my_aux)<-NULL
#--remove the society name field--
my_aux<-my_aux[,-28]

name<-"god in human affair"
alias<-"QZgods"

model=list(name=name,
           alias=alias,
           data=my_sccs,
           aux_data=my_aux,
           prox_list=list(language=Wll,distance=Wdd),
           dep_var="dep_var",
           indep_vars=indep_vars,
           restrict_vars=restrict_vars)

save(model,file=paste(alias,".Rdata",sep=""))

source("examples/src/run_model.R") #does for this model multiple imputation, two stage ols, saves to file to working directory.
ols_stats$restrict_stats
ols_stats$r2
ols_stats$restrict_diagnostics
aaa<-c(table(depvar), NROW(depvar),name)
aaa


lat<-sccs$v833.1
lon<-sccs$v833.2
plot(lon,lat, cex=.1)
ztxt=as.character(depvar) #above "my_sccs( " -- a new line inserted: depvar= as defined in my_sccs( 
ztxt<-gsub("NaN",".",ztxt)
text(lon,lat,ztxt)

B Moneystate as state4-5 and newstate

B Moneystate as state4-5

                coef   Fstat         ddf pvalue    VIF
(Intercept)   0.8612  1.3172   4432.7599 0.2512     NA
language     -0.5059  1.2998   5819.0121 0.2543 2.2354
distance      0.8299 24.8534   5953.2614 0.0000 2.4664
newstate      0.5540  5.1692    617.9353 0.0233 1.6837
moneystate   -0.1753  1.7477   1442.0503 0.1864 1.6048
evileye       0.1111  6.9486 278503.8688 0.0084 1.9411
ecorich      -0.1972  4.0202  31937.6067 0.0450 1.0952
eextwar      -0.0310  7.6750     84.8433 0.0069 1.0493
caststratLGd  0.5961  3.2154   4250.5931 0.0730 1.2766
pastoralExch  0.4999  2.6135  20917.8245 0.1060 1.2675
>  ols_stats$r2
 R2:final model R2:IV_ language R2:IV_ distance 
      0.4875045       0.9769015       0.9869223 
>  ols_stats$restrict_diagnostics
               Fstat         df pvalue
RESET          0.929    147.457  0.337
Wald.on.restrs 2.584     12.433  0.133
NCV            1.184   2642.441  0.277
SW.normal      1.932    371.429  0.165
lag..language  1.952 345081.442  0.162
lag..distance  1.113  27522.902  0.292

moneystate 7AAA Scott's code depvar Moral gods, indepvar pastoralExch and EVIL EYE and Whyte626!!!

 moneystate=(SCCS$v237>=4)*1*((SCCS$v155==5)*2)+((SCCS$v155==4)*1)
 moneystate=(sccs$v237>=4)*1*((sccs$v155==5)*2)+((sccs$v155==4)*1)
moneystate=((sccs$v237>=4)*1)*((sccs$v155==5)*2)+((sccs$v155==4)*1)
add pastoralExch=pastoralExch=((sccs$v208==1)*1)*(sccs$v858==6)*1
setwd("C:/My Documents/sccs") 
library(sccs)
data(sccs) 
#newstate=((sccs$v237>=4)*1)*log(sccs$v838) #dateobs) BC coded as positive, e.g., -1750 (BC) => 1750
#newstate=(((sccs$v237>=4)*1)*log(sccs$v838)>=7.5)*1
HOW SIMILAR IS STATE TO NEWSTATE
new=(sccs$v838>=1600)*1
table(new)
 new[45]=0
table(new)
state=(sccs$v237>=4)*1
newstate=((sccs$v237>=4)*1)*(new)*1
table(newstate,state,useNA="ifany")
           state
newstate   0   1 <NA>
    0    153   4    0 row ok
    1      0  27    0 row ok
    <NA>   0   0    2
HOW SIMILAR IS MONEYSTATE TO NEWSTATE
               state                 money
moneystate=((sccs$v237>=4)*1)*((sccs$v155==5)*1)
#moneystate=(sccs$v155==5)*1
#moneystate=((sccs$v237>=4)*1)*((sccs$v155==5)*2)+((sccs$v155==4)*1)
moneystate
table(moneystate)
      0 c12          2  1 a   b         b     a  c 
#table( ((sccs$v237>=4)*1)*((log(sccs$v838)>=7.5)*1), ((sccs$v155==5)*1) ,useNA="ifany") #DOES NOT COMPUTE
table(newstate,moneystate,useNA="ifany")
       moneystate
newstate   0   1 <NA>
    0    153   4    0 row ok
    1      0  27    0 row ok
    <NA>   0   0    2
         167  25?   ==5 for v155 ok #table
         161  25?   ==5 correct


setwd("/Users/drwhite/Documents/sccs") #Macbook
setwd("/Users/drwhite/Documents/sccs")
setwd("C:/My Documents/sccs") 
library(sccs)
data(sccs)                                 

depvar=sccs$v238
#NEWSTATE
new=(sccs$v838>=1600)*1
table(new)
 new[45]=0 state=(sccs$v237>=4)*1
newstate=((sccs$v237>=4)*1)*(new)*1
table(new)
table(newstate)


my_sccs<-data.frame(
dep_var=sccs$v238,
#moneystate=((sccs$v237>=4)*1)*log(sccs$v838),  #WAS NEWSTATE
#moneystate=(((sccs$v237>=4)*1)*log(sccs$v838)>=7.5)*1, #WAS NEWSTATE
#moneystate=(sccs$v237>=4)*1+(sccs$v155==5)*1,  #MONEYSTATE  
## moneystate=((sccs$v237>=4)*1)*((sccs$v155==5)*2)+((sccs$v155==4)*1),
moneystate=((sccs$v237>=4)*1)*((sccs$v155==5)*1),
state=(sccs$v237>=4)*1,
newstate=((sccs$v237>=4)*1)*(new)*1,
pastoralExch=((sccs$v208==1)*1)*(sccs$v858==6)*1,
evileye=sccs$v1188,
evileyeDich=sccs$v1189,
socname=sccs$socname,socID=sccs$"sccs#",
famsize=sccs$v68,    # similar to v80
exogamy=sccs$v72,
#famsizeB=sccs$v80,   # similar to v68
money=sccs$v155,
popdens=sccs$v156,
premarsexatt=sccs$v165,
premarsexfrq=sccs$v166,
malesexag=sccs$v175,
ndrymonth=sccs$v196,
gath=sccs$v203,
hunt=sccs$v204,
fish=sccs$v205,
anim=sccs$v206,
bridewealth=(sccs$v208==1)*1,
nuclearfam=(sccs$v210<=3)*1,
ncmallow=sccs$v227,
cultints=sccs$v232,
tree=(sccs$v233==4)*1,
roots=(sccs$v233==5)*1,
cereals=(sccs$v233==6)*1,
settype=sccs$v234,
localjh=sccs$v236-1,
superjh=sccs$v237,
segadlboys=sccs$v242,
plow=(sccs$v243>1)*1,
pigs=(sccs$v244==2)*1,
bovines=(sccs$v244==7)*1,
milk=(sccs$v245>1)*1,
caststratLGd=log(1+sccs$v272), 
agrlateboy=sccs$v300,
valchild=(sccs$v473+sccs$v474+sccs$v475+sccs$v476),
fratgrpstr=sccs$v570,
Whyte577=sccs$v577,    #take care using Whyte variables - only coded 1/2 the sample
Whyte580=sccs$v580,
Whyte584=sccs$v583,
Whyte585=sccs$v584,
Whyte595=sccs$v594,
Whyte602=sccs$v602,
Whyte615=sccs$v615,
Whyte620=sccs$v620,
Whyte626=sccs$v626,
Whyte629=sccs$v629,
Whyte630=sccs$v630,
Whyte631=sccs$v631,
Whyte632=sccs$v632,
Whyte633=sccs$v633,
Whyte635=sccs$v635,
#                    #take care using Paige variables - coded less than 1/2 the sample
Paige657=sccs$v657,  # summed in v663#  Paige657 Paige658 Paige659 Paige660 Paige661 Paige662
femproduceND=sccs$v658, #Paige658=sccs$v658,  # summed in v663 
Paige659=sccs$v659,  # summed in v663
Paige660=sccs$v660,  # summed in v663
Paige661=sccs$v661,  # summed in v663
Paige662=sccs$v662,  # summed in v663
fempower=sccs$v663, # sum of v657-662
PCvioIntr=sccs$v666, #interperviol=sccs$v666,   ###synonyms: violence / interviol / freintovio
migr=(sccs$v677==2)*1,
#                    #take care using Sanday variables - only coded 1/2 the sample
Sanday664=sccs$v664,  # summed in v669
Sanday665=sccs$v665,  # summed in v669
Sanday666=sccs$v666,  # summed in v669
Sanday667=sccs$v667,  # summed in v669
Sanday668=sccs$v668,  # summed in v669
Sanday669=sccs$v669, # sum of v664-668 
 #WHYTE Data Quality Whyte718 Whyte719 Whyte720 Whyte721 Whyte722 Whyte723 Whyte724 Whyte725
hunger=sccs$v678,
Whyte718=sccs$v718,    #take care using Whyte variables - only coded 1/2 the sample
Whyte719=sccs$v719,
Whyte720=sccs$v720,
Whyte721=sccs$v721,
Whyte722=sccs$v722,
Whyte723=sccs$v723,
Whyte724=sccs$v724,
Whyte725=sccs$v725,
 #Rohner Data Quality Codes 
Rohner798=sccs$v798,
Rohner799=sccs$v799,
Rohner800=sccs$v800,
Rohner801=sccs$v801,
Rohner802=sccs$v802,
Rohner803=sccs$v803,
Rohner804=sccs$v804,
Rohner805=sccs$v805,
Rohner806=sccs$v806,
Rohner807=sccs$v807,
Rohner808=sccs$v808,
Rohner809=sccs$v809,
Rohner810=sccs$v810,
Rohner811=sccs$v811,
Rohner812=sccs$v812,
Rohner813=sccs$v813,
foodtrade=sccs$v819,
fem_agri=sccs$v821, 
dateobs=sccs$v838,
rain=sccs$v854,
temp=sccs$v855,
#ecorich=sccs$v857,
ecorich=(sccs$v857==3|sccs$v857==4)*1+(sccs$v857==5)*2,
pctFemPolyg=sccs$v872,
marrcaptives=sccs$v870,
femsubs=sccs$v890,
intwar=sccs$v891,    # similar to 1649
extwar=sccs$v892,    # similar to 1650
himilexp=(sccs$v899==1)*1,
plunder=sccs$v912,
AP1=sccs$v921,           ###agricultural potential 1
AP2=sccs$v928,           ###agricultural potential 2
pathstress=sccs$v1260,
war=sccs$v1648,     # overall -- sum of internal and external
intwarB=sccs$v1649,  # similar to v891
eextwar=sccs$v1650,  # similar to v892
foodscarc=sccs$v1685,
sexratio=1+(sccs$v1689>85)+(sccs$v1689>115),
wagelabor=sccs$v1732,
CVrain=sccs$v1914/sccs$v1913   #no comma
)  


indep_vars<-c("newstate",
"moneystate","evileyeDich", "evileye", "pastoralExch", "bridewealth", "milk", "ecorich","eextwar","hunger", "superjh",
"famsize", "caststratLGd", #,"exogamy",    "money","popdens","malesexag","ndrymonth","gath","hunt","fish",
#"anim","nuclearfam","ncmallow","cultints","tree","roots","cereals","settype","localjh",
#"segadlboys","plow","pigs","bovines","agrlateboy","valchild","fratgrpstr",
#"Whyte577","Whyte580","Whyte584","Whyte585","Whyte595","Whyte602","Whyte615","Whyte620", 
"Whyte626",
#"Whyte629",
#"Whyte630","Whyte631","Whyte632","Whyte633","Whyte635","Paige657","femproduceND","Paige659","Paige660",
"Paige661","Paige662","fempower","PCvioIntr","migr","Sanday664","Sanday665","Sanday666","Sanday667",
#"Sanday668","Sanday669","Whyte718","Whyte719","Whyte720","Whyte721","Whyte722","Whyte723","Whyte724",
#"Whyte725","Rohner798","Rohner799","Rohner800","Rohner801","Rohner802","Rohner803","Rohner804","Rohner805",
#"Rohner806","Rohner807","Rohner808","Rohner809","Rohner810","Rohner811","Rohner812","Rohner813","foodtrade","fem_agri",
"dateobs","rain","temp","pctFemPolyg","femsubs","intwar","extwar","himilexp","AP1","AP2") #,
#"pathstress","war","intwarB","foodscarc","sexratio","wagelabor","CVrain")


#restrictvars must drop one or more indepvars - in this case, dropping "premarsexatt"

#p=.117 ("evileyeDich",  
restrict_vars=c( "newstate",
"moneystate", #"superjh",  
"evileye",  "ecorich", "eextwar", #"bridewealth",  
#"Whyte626",
"caststratLGd",  "pastoralExch") 
#restrict_vars=c("bridewealth", "milk", "ecorich","eextwar","hunger",
#"AP1", "PCvioIntr", "caststratLGd", "superjh") #v237

library(foreign)
#--Read in two weight matrices--
Wll<-as.matrix(read.dta("./examples/data/langwm.dta")[,-1])
Wdd<-as.matrix(read.dta("./examples/data/dist25wm.dta")[,c(-1,-2,-189)])

load("./examples/data/vaux.Rdata",.GlobalEnv)
my_aux = vaux
row.names(my_aux)<-NULL
#--remove the society name field--
my_aux<-my_aux[,-28]

name<-"god in human affair"
alias<-"QZgods"

model=list(name=name,
           alias=alias,
           data=my_sccs,
           aux_data=my_aux,
           prox_list=list(language=Wll,distance=Wdd),
           dep_var="dep_var",
           indep_vars=indep_vars,
           restrict_vars=restrict_vars)

save(model,file=paste(alias,".Rdata",sep=""))

source("examples/src/run_model.R") #does for this model multiple imputation, two stage ols, saves to file to working directory.
ols_stats$restrict_stats
ols_stats$r2
ols_stats$restrict_diagnostics
aaa<-c(table(depvar), NROW(depvar),name)
aaa


lat<-sccs$v833.1
lon<-sccs$v833.2
plot(lon,lat, cex=.1)
ztxt=as.character(depvar) #above "my_sccs( " -- a new line inserted: depvar= as defined in my_sccs( 
ztxt<-gsub("NaN",".",ztxt)
text(lon,lat,ztxt)

B Money as state 5 only is worse

                coef   Fstat         ddf pvalue    VIF
(Intercept)   0.7810  1.0762  20789.6974 0.2996     NA
language     -0.4729  1.1389  70817.4018 0.2859 2.2313
distance      0.8259 25.2531 155195.4054 0.0000 2.4074
newstate      0.5536  4.6293 214722.3595 0.0314 1.9290
moneystate   -0.3653  1.4147  35952.5790 0.2343 1.8478
evileye       0.1096  6.6816  11395.0830 0.0098 1.9321
ecorich      -0.2199  5.0699 386924.6069 0.0243 1.0752
eextwar      -0.0305  6.5538     27.7244 0.0162 1.0505
caststratLGd  0.6171  3.3178   1258.1917 0.0688 1.2990
pastoralExch  0.4995  2.6088 240336.7376 0.1063 1.2644
> ols_stats$r2
 R2:final model R2:IV_ language R2:IV_ distance 
      0.4833514       0.9758946       0.9856163 
> ols_stats$restrict_diagnostics
               Fstat        df pvalue
RESET          0.604   101.855  0.439
Wald.on.restrs 2.316    71.562  0.132
NCV            0.770 65209.011  0.380
SW.normal      4.099  6465.947  0.043
lag..language  2.015 87207.668  0.156
lag..distance  0.796  8236.135  0.372

moneystate as state4-5 WITHOUT newstate 7AAA Scott's code depvar Moral gods, indepvar pastoralExch and EVIL EYE

 moneystate=(SCCS$v237>=4)*1*((SCCS$v155==5)*2)+((SCCS$v155==4)*1)
 moneystate=(sccs$v237>=4)*1*((sccs$v155==5)*2)+((sccs$v155==4)*1)
moneystate=((sccs$v237>=4)*1)*((sccs$v155==5)*2)+((sccs$v155==4)*1)
add pastoralExch=pastoralExch=((sccs$v208==1)*1)*(sccs$v858==6)*1
setwd("C:/My Documents/sccs") 
library(sccs)
data(sccs) 
#newstate=((sccs$v237>=4)*1)*log(sccs$v838) #dateobs) BC coded as positive, e.g., -1750 (BC) => 1750
#newstate=(((sccs$v237>=4)*1)*log(sccs$v838)>=7.5)*1
HOW SIMILAR IS STATE TO NEWSTATE
new=(sccs$v838>=1600)*1
table(new)
 new[45]=0
table(new)
state=(sccs$v237>=4)*1
newstate=((sccs$v237>=4)*1)*(new)*1
table(newstate,state,useNA="ifany")
           state
newstate   0   1 <NA>
    0    153   4    0 row ok
    1      0  27    0 row ok
    <NA>   0   0    2
HOW SIMILAR IS MONEYSTATE TO NEWSTATE
               state                 money
moneystate=((sccs$v237>=4)*1)*((sccs$v155==5)*1)
#moneystate=(sccs$v155==5)*1
#moneystate=((sccs$v237>=4)*1)*((sccs$v155==5)*2)+((sccs$v155==4)*1)
moneystate
table(moneystate)
      0 c12          2  1 a   b         b     a  c 
#table( ((sccs$v237>=4)*1)*((log(sccs$v838)>=7.5)*1), ((sccs$v155==5)*1) ,useNA="ifany") #DOES NOT COMPUTE
table(newstate,moneystate,useNA="ifany")
       moneystate
newstate   0   1 <NA>
    0    153   4    0 row ok
    1      0  27    0 row ok
    <NA>   0   0    2
         167  25?   ==5 for v155 ok #table
         161  25?   ==5 correct


setwd("/Users/drwhite/Documents/sccs") #Macbook
setwd("/Users/drwhite/Documents/sccs")
setwd("C:/My Documents/sccs") 
library(sccs)
data(sccs)                                 

depvar=sccs$v238
#NEWSTATE
new=(sccs$v838>=1600)*1
table(new)
 new[45]=0 state=(sccs$v237>=4)*1
newstate=((sccs$v237>=4)*1)*(new)*1
table(new)
table(newstate)


my_sccs<-data.frame(
dep_var=sccs$v238,
#moneystate=((sccs$v237>=4)*1)*log(sccs$v838),  #WAS NEWSTATE
#moneystate=(((sccs$v237>=4)*1)*log(sccs$v838)>=7.5)*1, #WAS NEWSTATE
#moneystate=(sccs$v237>=4)*1+(sccs$v155==5)*1,  #MONEYSTATE  
moneystate=((sccs$v237>=4)*1)*((sccs$v155==5)*2)+((sccs$v155==4)*1),
state=(sccs$v237>=4)*1,
newstate=((sccs$v237>=4)*1)*(new)*1,
pastoralExch=((sccs$v208==1)*1)*(sccs$v858==6)*1,
evileye=sccs$v1188,
evileyeDich=sccs$v1189,
socname=sccs$socname,socID=sccs$"sccs#",
famsize=sccs$v68,    # similar to v80
exogamy=sccs$v72,
#famsizeB=sccs$v80,   # similar to v68
money=sccs$v155,
popdens=sccs$v156,
premarsexatt=sccs$v165,
premarsexfrq=sccs$v166,
malesexag=sccs$v175,
ndrymonth=sccs$v196,
gath=sccs$v203,
hunt=sccs$v204,
fish=sccs$v205,
anim=sccs$v206,
bridewealth=(sccs$v208==1)*1,
nuclearfam=(sccs$v210<=3)*1,
ncmallow=sccs$v227,
cultints=sccs$v232,
tree=(sccs$v233==4)*1,
roots=(sccs$v233==5)*1,
cereals=(sccs$v233==6)*1,
settype=sccs$v234,
localjh=sccs$v236-1,
superjh=sccs$v237,
segadlboys=sccs$v242,
plow=(sccs$v243>1)*1,
pigs=(sccs$v244==2)*1,
bovines=(sccs$v244==7)*1,
milk=(sccs$v245>1)*1,
caststratLGd=log(1+sccs$v272), 
agrlateboy=sccs$v300,
valchild=(sccs$v473+sccs$v474+sccs$v475+sccs$v476),
fratgrpstr=sccs$v570,
Whyte577=sccs$v577,    #take care using Whyte variables - only coded 1/2 the sample
Whyte580=sccs$v580,
Whyte584=sccs$v583,
Whyte585=sccs$v584,
Whyte595=sccs$v594,
Whyte602=sccs$v602,
Whyte615=sccs$v615,
Whyte620=sccs$v620,
Whyte626=sccs$v626,
Whyte629=sccs$v629,
Whyte630=sccs$v630,
Whyte631=sccs$v631,
Whyte632=sccs$v632,
Whyte633=sccs$v633,
Whyte635=sccs$v635,
#                    #take care using Paige variables - coded less than 1/2 the sample
Paige657=sccs$v657,  # summed in v663#  Paige657 Paige658 Paige659 Paige660 Paige661 Paige662
femproduceND=sccs$v658, #Paige658=sccs$v658,  # summed in v663 
Paige659=sccs$v659,  # summed in v663
Paige660=sccs$v660,  # summed in v663
Paige661=sccs$v661,  # summed in v663
Paige662=sccs$v662,  # summed in v663
fempower=sccs$v663, # sum of v657-662
PCvioIntr=sccs$v666, #interperviol=sccs$v666,   ###synonyms: violence / interviol / freintovio
migr=(sccs$v677==2)*1,
#                    #take care using Sanday variables - only coded 1/2 the sample
Sanday664=sccs$v664,  # summed in v669
Sanday665=sccs$v665,  # summed in v669
Sanday666=sccs$v666,  # summed in v669
Sanday667=sccs$v667,  # summed in v669
Sanday668=sccs$v668,  # summed in v669
Sanday669=sccs$v669, # sum of v664-668 
 #WHYTE Data Quality Whyte718 Whyte719 Whyte720 Whyte721 Whyte722 Whyte723 Whyte724 Whyte725
hunger=sccs$v678,
Whyte718=sccs$v718,    #take care using Whyte variables - only coded 1/2 the sample
Whyte719=sccs$v719,
Whyte720=sccs$v720,
Whyte721=sccs$v721,
Whyte722=sccs$v722,
Whyte723=sccs$v723,
Whyte724=sccs$v724,
Whyte725=sccs$v725,
 #Rohner Data Quality Codes 
Rohner798=sccs$v798,
Rohner799=sccs$v799,
Rohner800=sccs$v800,
Rohner801=sccs$v801,
Rohner802=sccs$v802,
Rohner803=sccs$v803,
Rohner804=sccs$v804,
Rohner805=sccs$v805,
Rohner806=sccs$v806,
Rohner807=sccs$v807,
Rohner808=sccs$v808,
Rohner809=sccs$v809,
Rohner810=sccs$v810,
Rohner811=sccs$v811,
Rohner812=sccs$v812,
Rohner813=sccs$v813,
foodtrade=sccs$v819,
fem_agri=sccs$v821, 
dateobs=sccs$v838,
rain=sccs$v854,
temp=sccs$v855,
#ecorich=sccs$v857,
ecorich=(sccs$v857==3|sccs$v857==4)*1+(sccs$v857==5)*2,
pctFemPolyg=sccs$v872,
marrcaptives=sccs$v870,
femsubs=sccs$v890,
intwar=sccs$v891,    # similar to 1649
extwar=sccs$v892,    # similar to 1650
himilexp=(sccs$v899==1)*1,
plunder=sccs$v912,
AP1=sccs$v921,           ###agricultural potential 1
AP2=sccs$v928,           ###agricultural potential 2
pathstress=sccs$v1260,
war=sccs$v1648,     # overall -- sum of internal and external
intwarB=sccs$v1649,  # similar to v891
eextwar=sccs$v1650,  # similar to v892
foodscarc=sccs$v1685,
sexratio=1+(sccs$v1689>85)+(sccs$v1689>115),
wagelabor=sccs$v1732,
CVrain=sccs$v1914/sccs$v1913   #no comma
)  


indep_vars<-c("newstate",
"moneystate","evileyeDich", "evileye", "pastoralExch", "bridewealth", "milk", "ecorich","eextwar","hunger", "superjh",
"famsize", "caststratLGd", #,"exogamy",    "money","popdens","malesexag","ndrymonth","gath","hunt","fish",
#"anim","nuclearfam","ncmallow","cultints","tree","roots","cereals","settype","localjh",
#"segadlboys","plow","pigs","bovines","agrlateboy","valchild","fratgrpstr",
#"Whyte577","Whyte580","Whyte584","Whyte585","Whyte595","Whyte602","Whyte615","Whyte620", 
"Whyte626",
#"Whyte629",
#"Whyte630","Whyte631","Whyte632","Whyte633","Whyte635","Paige657","femproduceND","Paige659","Paige660",
"Paige661","Paige662","fempower","PCvioIntr","migr","Sanday664","Sanday665","Sanday666","Sanday667",
#"Sanday668","Sanday669","Whyte718","Whyte719","Whyte720","Whyte721","Whyte722","Whyte723","Whyte724",
#"Whyte725","Rohner798","Rohner799","Rohner800","Rohner801","Rohner802","Rohner803","Rohner804","Rohner805",
#"Rohner806","Rohner807","Rohner808","Rohner809","Rohner810","Rohner811","Rohner812","Rohner813","foodtrade","fem_agri",
"dateobs","rain","temp","pctFemPolyg","femsubs","intwar","extwar","himilexp","AP1","AP2") #,
#"pathstress","war","intwarB","foodscarc","sexratio","wagelabor","CVrain")


#restrictvars must drop one or more indepvars - in this case, dropping "premarsexatt"

#p=.117 ("evileyeDich",  
restrict_vars=c( #"newstate",
"moneystate", #"superjh",  
"evileye",  "ecorich", "eextwar", #"bridewealth",  
#"Whyte626",
"caststratLGd",  "pastoralExch") 
#restrict_vars=c("bridewealth", "milk", "ecorich","eextwar","hunger",
#"AP1", "PCvioIntr", "caststratLGd", "superjh") #v237

library(foreign)
#--Read in two weight matrices--
Wll<-as.matrix(read.dta("./examples/data/langwm.dta")[,-1])
Wdd<-as.matrix(read.dta("./examples/data/dist25wm.dta")[,c(-1,-2,-189)])

load("./examples/data/vaux.Rdata",.GlobalEnv)
my_aux = vaux
row.names(my_aux)<-NULL
#--remove the society name field--
my_aux<-my_aux[,-28]

name<-"god in human affair"
alias<-"QZgods"

model=list(name=name,
           alias=alias,
           data=my_sccs,
           aux_data=my_aux,
           prox_list=list(language=Wll,distance=Wdd),
           dep_var="dep_var",
           indep_vars=indep_vars,
           restrict_vars=restrict_vars)

save(model,file=paste(alias,".Rdata",sep=""))

source("examples/src/run_model.R") #does for this model multiple imputation, two stage ols, saves to file to working directory.
ols_stats$restrict_stats
ols_stats$r2
ols_stats$restrict_diagnostics
aaa<-c(table(depvar), NROW(depvar),name)
aaa


lat<-sccs$v833.1
lon<-sccs$v833.2
plot(lon,lat, cex=.1)
ztxt=as.character(depvar) #above "my_sccs( " -- a new line inserted: depvar= as defined in my_sccs( 
ztxt<-gsub("NaN",".",ztxt)
text(lon,lat,ztxt)

B Moneystate as state4-5 WITHOUT newstate

                coef   Fstat          ddf pvalue    VIF
(Intercept)   0.4706  0.3977   70616.4856 0.5283     NA
language     -0.3381  0.5846   55679.5199 0.4445 2.1661
distance      0.8610 26.7940 4249637.8195 0.0000 2.4100
moneystate    0.0232  0.0089   28622.2736 0.9250 1.1560
evileye       0.1053  6.0368   20646.0155 0.0140 1.9308
ecorich      -0.2128  4.6119   43524.4927 0.0318 1.0767
eextwar      -0.0297  6.6501      55.9261 0.0126 1.0296
caststratLGd  0.6305  3.4419   64530.8712 0.0636 1.2807
pastoralExch  0.4507  2.0827  482997.1330 0.1490 1.2584
> ols_stats$r2
 R2:final model R2:IV_ language R2:IV_ distance 
      0.4669871       0.9759273       0.9855844 
> ols_stats$restrict_diagnostics
               Fstat         df pvalue
RESET          0.460   5625.737  0.498
Wald.on.restrs 2.994     41.536  0.091
NCV            1.531    899.601  0.216
SW.normal      3.966   2063.112  0.047
lag..language  1.801 399991.401  0.180
lag..distance  0.841 345271.315  0.359


Warning messages:
1: 'linear.hypothesis' is deprecated.
Use 'linearHypothesis' instead.
See help("Deprecated") and help("car-deprecated").
2: 'ncv.test' is deprecated.
Use 'ncvTest' instead.
See help("Deprecated") and help("car-deprecated").
3: In lm.LMtests(stage2_ols_estimate_r, W_mat, test = c("LMlag")) :
  Spatial weights matrix not row standardized
4: In lm.LMtests(stage2_ols_estimate_r, W_mat, test = c("LMlag")) :
  Spatial weights matrix not row standardized
5: 'linear.hypothesis' is deprecated.
Use 'linearHypothesis' instead.
See help("Deprecated") and help("car-deprecated").
6: 'ncv.test' is deprecated.
Use 'ncvTest' instead.
See help("Deprecated") and help("car-deprecated").
7: In lm.LMtests(stage2_ols_estimate_r, W_mat, test = c("LMlag")) :
  Spatial weights matrix not row standardized
8: In lm.LMtests(stage2_ols_estimate_r, W_mat, test = c("LMlag")) :
  Spatial weights matrix not row standardized
9: 'linear.hypothesis' is deprecated.
Use 'linearHypothesis' instead.
See help("Deprecated") and help("car-deprecated").
10: 'ncv.test' is deprecated.
Use 'ncvTest' instead.
See help("Deprecated") and help("car-deprecated").
11: In lm.LMtests(stage2_ols_estimate_r, W_mat, test = c("LMlag")) :
  Spatial weights matrix not row standardized
12: In lm.LMtests(stage2_ols_estimate_r, W_mat, test = c("LMlag")) :
  Spatial weights matrix not row standardized
13: 'linear.hypothesis' is deprecated.
Use 'linearHypothesis' instead.
See help("Deprecated") and help("car-deprecated").
14: 'ncv.test' is deprecated.
Use 'ncvTest' instead.
See help("Deprecated") and help("car-deprecated").
15: In lm.LMtests(stage2_ols_estimate_r, W_mat, test = c("LMlag")) :
  Spatial weights matrix not row standardized
16: In lm.LMtests(stage2_ols_estimate_r, W_mat, test = c("LMlag")) :
  Spatial weights matrix not row standardized
17: In write.table(ols_stats$restrict_stats, file = summary_results_file,  ... :
  appending column names to file
18: In write.table(ols_stats$restrict_diagnostics, file = summary_results_file,  ... :
  appending column names to file

moneystate as state4-5 WITHOUT newstate and other variables 7AAA Scott's code depvar Moral gods, indepvar pastoralExch and EVIL EYE

 moneystate=(SCCS$v237>=4)*1*((SCCS$v155==5)*2)+((SCCS$v155==4)*1)
 moneystate=(sccs$v237>=4)*1*((sccs$v155==5)*2)+((sccs$v155==4)*1)
moneystate=((sccs$v237>=4)*1)*((sccs$v155==5)*2)+((sccs$v155==4)*1)
add pastoralExch=pastoralExch=((sccs$v208==1)*1)*(sccs$v858==6)*1
setwd("C:/My Documents/sccs") 
library(sccs)
data(sccs) 
#newstate=((sccs$v237>=4)*1)*log(sccs$v838) #dateobs) BC coded as positive, e.g., -1750 (BC) => 1750
#newstate=(((sccs$v237>=4)*1)*log(sccs$v838)>=7.5)*1
HOW SIMILAR IS STATE TO NEWSTATE
new=(sccs$v838>=1600)*1
table(new)
 new[45]=0
table(new)
state=(sccs$v237>=4)*1
newstate=((sccs$v237>=4)*1)*(new)*1
table(newstate,state,useNA="ifany")
           state
newstate   0   1 <NA>
    0    153   4    0 row ok
    1      0  27    0 row ok
    <NA>   0   0    2
HOW SIMILAR IS MONEYSTATE TO NEWSTATE
               state                 money
moneystate=((sccs$v237>=4)*1)*((sccs$v155==5)*1)
#moneystate=(sccs$v155==5)*1
#moneystate=((sccs$v237>=4)*1)*((sccs$v155==5)*2)+((sccs$v155==4)*1)
moneystate
table(moneystate)
      0 c12          2  1 a   b         b     a  c 
table( ((sccs$v237>=4)*1)*((log(sccs$v838)>=7.5)*1), ((sccs$v155==5)*1) ,useNA="ifany") #DOES COMPUTE
table(newstate,moneystate,useNA="ifany")
       moneystate
newstate 0   1
  0    146  11
  1     13  14
  <NA>   2   0



setwd("/Users/drwhite/Documents/sccs") #Macbook
setwd("/Users/drwhite/Documents/sccs")
setwd("C:/My Documents/sccs") 
library(sccs)
data(sccs)                                 

depvar=sccs$v238
#NEWSTATE
new=(sccs$v838>=1600)*1
table(new)
 new[45]=0 state=(sccs$v237>=4)*1
newstate=((sccs$v237>=4)*1)*(new)*1
table(new)
table(newstate)


my_sccs<-data.frame(
dep_var=sccs$v238,
#moneystate=((sccs$v237>=4)*1)*log(sccs$v838),  #WAS NEWSTATE
#moneystate=(((sccs$v237>=4)*1)*log(sccs$v838)>=7.5)*1, #WAS NEWSTATE
#moneystate=(sccs$v237>=4)*1+(sccs$v155==5)*1,  #MONEYSTATE  
moneystate=((sccs$v237>=4)*1)*((sccs$v155==5)*1),
state=(sccs$v237>=4)*1,
newstate=((sccs$v237>=4)*1)*(new)*1,
pastoralExch=((sccs$v208==1)*1)*(sccs$v858==6)*1,
evileye=sccs$v1188,
evileyeDich=sccs$v1189,
socname=sccs$socname,socID=sccs$"sccs#",
famsize=sccs$v68,    # similar to v80
exogamy=sccs$v72,
#famsizeB=sccs$v80,   # similar to v68
money=sccs$v155,
popdens=sccs$v156,
premarsexatt=sccs$v165,
premarsexfrq=sccs$v166,
malesexag=sccs$v175,
ndrymonth=sccs$v196,
gath=sccs$v203,
hunt=sccs$v204,
fish=sccs$v205,
anim=sccs$v206,
bridewealth=(sccs$v208==1)*1,
nuclearfam=(sccs$v210<=3)*1,
ncmallow=sccs$v227,
cultints=sccs$v232,
tree=(sccs$v233==4)*1,
roots=(sccs$v233==5)*1,
cereals=(sccs$v233==6)*1,
settype=sccs$v234,
localjh=sccs$v236-1,
superjh=sccs$v237,
segadlboys=sccs$v242,
plow=(sccs$v243>1)*1,
pigs=(sccs$v244==2)*1,
bovines=(sccs$v244==7)*1,
milk=(sccs$v245>1)*1,
caststratLGd=log(1+sccs$v272), 
agrlateboy=sccs$v300,
valchild=(sccs$v473+sccs$v474+sccs$v475+sccs$v476),
fratgrpstr=sccs$v570,
Whyte577=sccs$v577,    #take care using Whyte variables - only coded 1/2 the sample
Whyte580=sccs$v580,
Whyte584=sccs$v583,
Whyte585=sccs$v584,
Whyte595=sccs$v594,
Whyte602=sccs$v602,
Whyte615=sccs$v615,
Whyte620=sccs$v620,
Whyte626=sccs$v626,
Whyte629=sccs$v629,
Whyte630=sccs$v630,
Whyte631=sccs$v631,
Whyte632=sccs$v632,
Whyte633=sccs$v633,
Whyte635=sccs$v635,
#                    #take care using Paige variables - coded less than 1/2 the sample
Paige657=sccs$v657,  # summed in v663#  Paige657 Paige658 Paige659 Paige660 Paige661 Paige662
femproduceND=sccs$v658, #Paige658=sccs$v658,  # summed in v663 
Paige659=sccs$v659,  # summed in v663
Paige660=sccs$v660,  # summed in v663
Paige661=sccs$v661,  # summed in v663
Paige662=sccs$v662,  # summed in v663
fempower=sccs$v663, # sum of v657-662
PCvioIntr=sccs$v666, #interperviol=sccs$v666,   ###synonyms: violence / interviol / freintovio
migr=(sccs$v677==2)*1,
#                    #take care using Sanday variables - only coded 1/2 the sample
Sanday664=sccs$v664,  # summed in v669
Sanday665=sccs$v665,  # summed in v669
Sanday666=sccs$v666,  # summed in v669
Sanday667=sccs$v667,  # summed in v669
Sanday668=sccs$v668,  # summed in v669
Sanday669=sccs$v669, # sum of v664-668 
 #WHYTE Data Quality Whyte718 Whyte719 Whyte720 Whyte721 Whyte722 Whyte723 Whyte724 Whyte725
hunger=sccs$v678,
Whyte718=sccs$v718,    #take care using Whyte variables - only coded 1/2 the sample
Whyte719=sccs$v719,
Whyte720=sccs$v720,
Whyte721=sccs$v721,
Whyte722=sccs$v722,
Whyte723=sccs$v723,
Whyte724=sccs$v724,
Whyte725=sccs$v725,
 #Rohner Data Quality Codes 
Rohner798=sccs$v798,
Rohner799=sccs$v799,
Rohner800=sccs$v800,
Rohner801=sccs$v801,
Rohner802=sccs$v802,
Rohner803=sccs$v803,
Rohner804=sccs$v804,
Rohner805=sccs$v805,
Rohner806=sccs$v806,
Rohner807=sccs$v807,
Rohner808=sccs$v808,
Rohner809=sccs$v809,
Rohner810=sccs$v810,
Rohner811=sccs$v811,
Rohner812=sccs$v812,
Rohner813=sccs$v813,
foodtrade=sccs$v819,
fem_agri=sccs$v821, 
dateobs=sccs$v838,
rain=sccs$v854,
temp=sccs$v855,
#ecorich=sccs$v857,
ecorich=(sccs$v857==3|sccs$v857==4)*1+(sccs$v857==5)*2,
pctFemPolyg=sccs$v872,
marrcaptives=sccs$v870,
femsubs=sccs$v890,
intwar=sccs$v891,    # similar to 1649
extwar=sccs$v892,    # similar to 1650
himilexp=(sccs$v899==1)*1,
plunder=sccs$v912,
AP1=sccs$v921,           ###agricultural potential 1
AP2=sccs$v928,           ###agricultural potential 2
pathstress=sccs$v1260,
war=sccs$v1648,     # overall -- sum of internal and external
intwarB=sccs$v1649,  # similar to v891
eextwar=sccs$v1650,  # similar to v892
foodscarc=sccs$v1685,
sexratio=1+(sccs$v1689>85)+(sccs$v1689>115),
wagelabor=sccs$v1732,
CVrain=sccs$v1914/sccs$v1913   #no comma
)  


indep_vars<-c("newstate",
"moneystate","evileyeDich", "evileye", "pastoralExch", "bridewealth", "milk", "ecorich","eextwar","hunger", "superjh",
"famsize", "caststratLGd", #,"exogamy",    "money","popdens","malesexag","ndrymonth","gath","hunt","fish",
#"anim","nuclearfam","ncmallow","cultints","tree","roots","cereals","settype","localjh",
#"segadlboys","plow","pigs","bovines","agrlateboy","valchild","fratgrpstr",
#"Whyte577","Whyte580","Whyte584","Whyte585","Whyte595","Whyte602","Whyte615","Whyte620", 
"Whyte626",
#"Whyte629",
#"Whyte630","Whyte631","Whyte632","Whyte633","Whyte635","Paige657","femproduceND","Paige659","Paige660",
"Paige661","Paige662","fempower","PCvioIntr","migr","Sanday664","Sanday665","Sanday666","Sanday667",
#"Sanday668","Sanday669","Whyte718","Whyte719","Whyte720","Whyte721","Whyte722","Whyte723","Whyte724",
#"Whyte725","Rohner798","Rohner799","Rohner800","Rohner801","Rohner802","Rohner803","Rohner804","Rohner805",
#"Rohner806","Rohner807","Rohner808","Rohner809","Rohner810","Rohner811","Rohner812","Rohner813","foodtrade","fem_agri",
"dateobs","rain","temp","pctFemPolyg","femsubs","intwar","extwar","himilexp","AP1","AP2") #,
#"pathstress","war","intwarB","foodscarc","sexratio","wagelabor","CVrain")


#restrictvars must drop one or more indepvars - in this case, dropping "premarsexatt"

#p=.117 ("evileyeDich",  
restrict_vars=c(
#"newstate",
"moneystate", #"superjh",  
"evileye",   "eextwar")  

library(foreign)
#--Read in two weight matrices--
Wll<-as.matrix(read.dta("./examples/data/langwm.dta")[,-1])
Wdd<-as.matrix(read.dta("./examples/data/dist25wm.dta")[,c(-1,-2,-189)])

load("./examples/data/vaux.Rdata",.GlobalEnv)
my_aux = vaux
row.names(my_aux)<-NULL
#--remove the society name field--
my_aux<-my_aux[,-28]

name<-"god in human affair"
alias<-"QZgods"

model=list(name=name,
           alias=alias,
           data=my_sccs,
           aux_data=my_aux,
           prox_list=list(language=Wll,distance=Wdd),
           dep_var="dep_var",
           indep_vars=indep_vars,
           restrict_vars=restrict_vars)

save(model,file=paste(alias,".Rdata",sep=""))

source("examples/src/run_model.R") #does for this model multiple imputation, two stage ols, saves to file to working directory.
ols_stats$restrict_stats
ols_stats$r2
ols_stats$restrict_diagnostics
aaa<-c(table(depvar), NROW(depvar),name)
aaa
mn = min(depvar, na.rm = TRUE)
mx = max(depvar, na.rm = TRUE)
md = mx-mn
"divide each effect by md = diff between max (depvar) and Min (depvar) to get ratio for each IVar"
md
lat<-sccs$v833.1
lon<-sccs$v833.2
plot(lon,lat, cex=.1)
ztxt=as.character(depvar) #above "my_sccs( " -- a new line inserted: depvar= as defined in my_sccs( 
ztxt<-gsub("NaN",".",ztxt)
text(lon,lat,ztxt)

That did not work

               coef range  effect   Fstat          ddf pvalue    VIF
(Intercept)  0.1220    NA      NA  0.0262   33979.2316 0.8715     NA
language    -0.0809    NA      NA  0.0330  218539.9391 0.8558 2.0521
distance     0.8156    NA      NA 22.9521   30449.0615 0.0000 2.3433
moneystate   0.0239     1  0.0239  0.0095  414871.5398 0.9222 1.0737
evileye      0.1560     7  1.0923 14.0576 2254261.4935 0.0002 1.7075
eextwar     -0.0287    16 -0.4600  5.7191      38.3539 0.0218 1.0230
> ols_stats$r2
R2:final model R2:IV_language R2:IV_distance 
     0.4172098      0.9756906      0.9869507 
               Fstat          df pvalue
RESET          0.112   44410.989  0.738
Wald.on.restrs 5.506      39.125  0.024
NCV            3.042     621.927  0.082
SW.normal      2.619    3435.077  0.106
lag..language  1.490 7850748.384  0.222
lag..distance  0.781  141589.212  0.377