library("robumeta") library("dplyr") library("psych") library (metafor) library (foreign) data.ges<-data #################################################################overall-rma #fishers`z eszcor<-escalc(measure="ZCOR", ri=correlation, ni=N, data=data.ges) eszcor #random effects model REmodel<-rma(yi, vi, data=eszcor, method="REML") REmodel #convert fisher`s z to r predict(REmodel, digits=3, transf=transf.ztor) #confidence interval for the amount of heterogeneity confint(REmodel, digits = 3) #which studies contribute to heterogeneity? b_res<-rma(yi, vi, data=eszcor, slab=Study) b_res baujat(b_res) #potentual outliers/ influencal cases inf <- influence(REmodel) print(inf) plot(inf) help(inf) ##########################################meta-analysis without the influencial cases (37,55)######## dataA=data.ges[-c(37),] dataB=data.ges[-c(55),] dataC=data.ges[-c(37,55)] #vary data-set (A,B,C) #fishers`z eszcor<-escalc(measure="ZCOR", ri=correlation, ni=N, data=dataC) eszcor #random effects model REmodel<-rma(yi, vi, data=eszcor, method="REML") REmodel #convert fisher`s z to r predict(REmodel, digits=3, transf=transf.ztor) #confidence interval for the amount of heterogeneity confint(REmodel, digits = 3) ####subgroup analysis######################################################################### ##########religiosity measure ##Beliefs data.ges_sample1=data.ges[data.ges$religiosityMeasure=="Beliefs",] #fishers`z eszcor<-escalc(measure="ZCOR", ri=correlation, ni=N, data=data.ges_sample1) eszcor #random effects model REmodel1<-rma(yi, vi, data=eszcor, method="REML") REmodel1 predict(REmodel1, transf=transf.ztor) ##Behavior data.ges_sample2=data.ges[data.ges$religiosityMeasure=="Behavior",] #fishers`z eszcor<-escalc(measure="ZCOR", ri=correlation, ni=N, data=data.ges_sample2) eszcor #random effects model REmodel2<-rma(yi, vi, data=eszcor, method="REML") REmodel2 predict(REmodel2, transf=transf.ztor) ##Mixed data.ges_sample3=data.ges[data.ges$religiosityMeasure=="mixed",] #fishers`z eszcor<-escalc(measure="ZCOR", ri=correlation, ni=N, data=data.ges_sample3) eszcor #random effects model REmodel3<-rma(yi, vi, data=eszcor, method="REML") REmodel3 predict(REmodel3, transf=transf.ztor) ##compare omnibus comparison<-data.frame(ES=c(coef(REmodel1),coef(REmodel2),coef(REmodel3)),SE=c(REmodel1$se,REmodel2$se,REmodel3$se),factor=c(1,2,3),tau2=round(c(REmodel1$tau2,REmodel2$tau2,REmodel3$tau2),3)) comparison rma(ES, sei=SE,mods=~factor,method="FE",data=comparison,digits=3) ##compare paarweise ##compare beliefs-behavior (1-2) comparison<-data.frame(ES=c(coef(REmodel1),coef(REmodel2)),SE=c(REmodel1$se,REmodel2$se),factor=c(1,2),tau2=round(c(REmodel1$tau2,REmodel2$tau2),3)) comparison rma(ES, sei=SE,mods=~factor,method="FE",data=comparison,digits=3) ##compare beliefs-mixed (1-3) comparison<-data.frame(ES=c(coef(REmodel1),coef(REmodel3)),SE=c(REmodel1$se,REmodel3$se),factor=c(1,2),tau2=round(c(REmodel1$tau2,REmodel3$tau2),3)) comparison rma(ES, sei=SE,mods=~factor,method="FE",data=comparison,digits=3) ##compare behavior-mixed (2-3) comparison<-data.frame(ES=c(coef(REmodel2),coef(REmodel3)),SE=c(REmodel2$se,REmodel3$se),factor=c(1,2),tau2=round(c(REmodel2$tau2,REmodel3$tau2),3)) comparison rma(ES, sei=SE,mods=~factor,method="FE",data=comparison,digits=3) ##########sample type ##Pre-College data.ges_sample4=data.ges[data.ges$sample=="Pre-College",] #fishers`z eszcor<-escalc(measure="ZCOR", ri=correlation, ni=N, data=data.ges_sample4) eszcor #random effects model REmodel4<-rma(yi, vi, data=eszcor, method="REML") REmodel4 predict(REmodel4, transf=transf.ztor) ##College data.ges_sample5=data.ges[data.ges$sample=="College",] #fishers`z eszcor<-escalc(measure="ZCOR", ri=correlation, ni=N, data=data.ges_sample5) eszcor #random effects model REmodel5<-rma(yi, vi, data=eszcor, method="REML") REmodel5 predict(REmodel5, transf=transf.ztor) ##Non-College data.ges_sample6=data.ges[data.ges$sample=="Non-College",] #fishers`z eszcor<-escalc(measure="ZCOR", ri=correlation, ni=N, data=data.ges_sample6) eszcor #random effects model REmodel6<-rma(yi, vi, data=eszcor, method="REML") REmodel6 predict(REmodel6, transf=transf.ztor) ##compare omnibus comparison<-data.frame(ES=c(coef(REmodel4),coef(REmodel5),coef(REmodel6)),SE=c(REmodel4$se,REmodel5$se,REmodel6$se),factor=c(1,2,3),tau2=round(c(REmodel4$tau2,REmodel5$tau2,REmodel6$tau2),3)) comparison rma(ES, sei=SE,mods=~factor,method="FE",data=comparison,digits=3) ##compare paarweise #pre-college vs. college (4-5) comparison<-data.frame(ES=c(coef(REmodel4),coef(REmodel5)),SE=c(REmodel4$se,REmodel5$se),factor=c(1,2),tau2=round(c(REmodel4$tau2,REmodel5$tau2),3)) comparison rma(ES, sei=SE,mods=~factor,method="FE",data=comparison,digits=3) #pre-college vs. non-college (4-6) comparison<-data.frame(ES=c(coef(REmodel4),coef(REmodel6)),SE=c(REmodel4$se,REmodel6$se),factor=c(1,2),tau2=round(c(REmodel4$tau2,REmodel6$tau2),3)) comparison rma(ES, sei=SE,mods=~factor,method="FE",data=comparison,digits=3) #college - non-college (5-6) comparison<-data.frame(ES=c(coef(REmodel5),coef(REmodel6)),SE=c(REmodel5$se,REmodel6$se),factor=c(1,2),tau2=round(c(REmodel5$tau2,REmodel6$tau2),3)) comparison rma(ES, sei=SE,mods=~factor,method="FE",data=comparison,digits=3) ##########status of publication ##published data.ges_sample7=data.ges[data.ges$publicationstatus=="published",] #fishers`z eszcor<-escalc(measure="ZCOR", ri=correlation, ni=N, data=data.ges_sample7) eszcor #random effects model REmodel7<-rma(yi, vi, data=eszcor, method="REML") REmodel7 predict(REmodel7, transf=transf.ztor) ##unpublished data.ges_sample8=data.ges[data.ges$publicationstatus=="unpublished",] #fishers`z eszcor<-escalc(measure="ZCOR", ri=correlation, ni=N, data=data.ges_sample8) eszcor #random effects model REmodel8<-rma(yi, vi, data=eszcor, method="REML") REmodel8 predict(REmodel8, transf=transf.ztor) ##compare (omnibus=paarweise) comparison<-data.frame(ES=c(coef(REmodel7),coef(REmodel8)),SE=c(REmodel7$se,REmodel8$se),factor=c(1,2),tau2=round(c(REmodel7$tau2,REmodel8$tau2),3)) comparison rma(ES, sei=SE,mods=~factor,method="FE",data=comparison,digits=3) ######## GPA #without GPA data.ges_sample9=data.ges[data.ges$intelligenceMeasure=="ohneGPA",] #fishers`z eszcor<-escalc(measure="ZCOR", ri=correlation, ni=N, data=data.ges_sample9) eszcor #random effects model REmodel9<-rma(yi, vi, data=eszcor, method="REML") REmodel9 predict(REmodel9, transf=transf.ztor) #only GPA data.ges_sample10=data.ges[data.ges$intelligenceMeasure=="GPA",] #fishers`z eszcor<-escalc(measure="ZCOR", ri=correlation, ni=N, data=data.ges_sample10) eszcor #random effects model REmodel10<-rma(yi, vi, data=eszcor, method="REML") REmodel10 predict(REmodel10, transf=transf.ztor) #mixed data.ges_sample11=data.ges[data.ges$intelligenceMeasure=="beides",] #fishers`z eszcor<-escalc(measure="ZCOR", ri=correlation, ni=N, data=data.ges_sample11) eszcor #random effects model REmodel11<-rma(yi, vi, data=eszcor, method="REML") REmodel11 predict(REmodel11, transf=transf.ztor) ##compare omnibus comparison<-data.frame(ES=c(coef(REmodel9),coef(REmodel10),coef(REmodel11)),SE=c(REmodel9$se,REmodel10$se,REmodel11$se),factor=c(1,2,3),tau2=round(c(REmodel9$tau2,REmodel10$tau2,REmodel11$tau2),3)) comparison rma(ES, sei=SE,mods=~factor,method="FE",data=comparison,digits=3) ##compare paarweise #ohne GPA vs. mit GPA (9-10) comparison<-data.frame(ES=c(coef(REmodel9),coef(REmodel10)),SE=c(REmodel9$se,REmodel10$se),factor=c(1,2),tau2=round(c(REmodel9$tau2,REmodel10$tau2),3)) comparison rma(ES, sei=SE,mods=~factor,method="FE",data=comparison,digits=3) #ohne GPA vs. mixed (9-11) comparison<-data.frame(ES=c(coef(REmodel9),coef(REmodel11)),SE=c(REmodel9$se,REmodel11$se),factor=c(1,2),tau2=round(c(REmodel9$tau2,REmodel11$tau2),3)) comparison rma(ES, sei=SE,mods=~factor,method="FE",data=comparison,digits=3) #mit GPA - mixed (10-11) comparison<-data.frame(ES=c(coef(REmodel10),coef(REmodel11)),SE=c(REmodel10$se,REmodel11$se),factor=c(1,2),tau2=round(c(REmodel10$tau2,REmodel11$tau2),3)) comparison rma(ES, sei=SE,mods=~factor,method="FE",data=comparison,digits=3) #####################psychometric/ IQ only data.ges90=data.ges[data.ges$intelligenceMeasure=="ohneGPA",] ##########religiositymeasure ##Beliefs data.ges_sample1=data.ges90[data.ges90$religiosityMeasure=="Beliefs",] #fishers`z eszcor<-escalc(measure="ZCOR", ri=correlation, ni=N, data=data.ges_sample1) eszcor #random effects model REmodel1<-rma(yi, vi, data=eszcor, method="REML") REmodel1 predict(REmodel1, transf=transf.ztor) ##Behavior data.ges_sample2=data.ges90[data.ges90$religiosityMeasure=="Behavior",] #fishers`z eszcor<-escalc(measure="ZCOR", ri=correlation, ni=N, data=data.ges_sample2) eszcor #random effects model REmodel2<-rma(yi, vi, data=eszcor, method="REML") REmodel2 predict(REmodel2, transf=transf.ztor) ##Mixed data.ges_sample3=data.ges90[data.ges90$religiosityMeasure=="mixed",] #fishers`z eszcor<-escalc(measure="ZCOR", ri=correlation, ni=N, data=data.ges_sample3) eszcor #random effects model REmodel3<-rma(yi, vi, data=eszcor, method="REML") REmodel3 predict(REmodel3, transf=transf.ztor) ##compare omnibus comparison<-data.frame(ES=c(coef(REmodel1),coef(REmodel2),coef(REmodel3)),SE=c(REmodel1$se,REmodel2$se,REmodel3$se),factor=c(1,2,3),tau2=round(c(REmodel1$tau2,REmodel2$tau2,REmodel3$tau2),3)) comparison rma(ES, sei=SE,mods=~factor,method="FE",data=comparison,digits=3) ##compare paarweise ##compare beliefs-behavior (1-2) comparison<-data.frame(ES=c(coef(REmodel1),coef(REmodel2)),SE=c(REmodel1$se,REmodel2$se),factor=c(1,2),tau2=round(c(REmodel1$tau2,REmodel2$tau2),3)) comparison rma(ES, sei=SE,mods=~factor,method="FE",data=comparison,digits=3) ##compare beliefs-mixed (1-3) comparison<-data.frame(ES=c(coef(REmodel1),coef(REmodel3)),SE=c(REmodel1$se,REmodel3$se),factor=c(1,2),tau2=round(c(REmodel1$tau2,REmodel3$tau2),3)) comparison rma(ES, sei=SE,mods=~factor,method="FE",data=comparison,digits=3) ##compare behavior-mixed (2-3) comparison<-data.frame(ES=c(coef(REmodel2),coef(REmodel3)),SE=c(REmodel2$se,REmodel3$se),factor=c(1,2),tau2=round(c(REmodel2$tau2,REmodel3$tau2),3)) comparison rma(ES, sei=SE,mods=~factor,method="FE",data=comparison,digits=3) ##########sample type ##Pre-College data.ges_sample4=data.ges90[data.ges90$sample=="Pre-College",] #fishers`z eszcor<-escalc(measure="ZCOR", ri=correlation, ni=N, data=data.ges_sample4) eszcor #random effects model REmodel4<-rma(yi, vi, data=eszcor, method="REML") REmodel4 predict(REmodel4, transf=transf.ztor) ##College data.ges_sample5=data.ges90[data.ges90$sample=="College",] #fishers`z eszcor<-escalc(measure="ZCOR", ri=correlation, ni=N, data=data.ges_sample5) eszcor #random effects model REmodel5<-rma(yi, vi, data=eszcor, method="REML") REmodel5 predict(REmodel5, transf=transf.ztor) ##Non-College data.ges_sample6=data.ges90[data.ges90$sample=="Non-College",] #fishers`z eszcor<-escalc(measure="ZCOR", ri=correlation, ni=N, data=data.ges_sample6) eszcor #random effects model REmodel6<-rma(yi, vi, data=eszcor, method="REML") REmodel6 predict(REmodel6, transf=transf.ztor) ##compare omnibus comparison<-data.frame(ES=c(coef(REmodel4),coef(REmodel5),coef(REmodel6)),SE=c(REmodel4$se,REmodel5$se,REmodel6$se),factor=c(1,2,3),tau2=round(c(REmodel4$tau2,REmodel5$tau2,REmodel6$tau2),3)) comparison rma(ES, sei=SE,mods=~factor,method="FE",data=comparison,digits=3) ##compare paarweise #pre-college vs. college (4-5) comparison<-data.frame(ES=c(coef(REmodel4),coef(REmodel5)),SE=c(REmodel4$se,REmodel5$se),factor=c(1,2),tau2=round(c(REmodel4$tau2,REmodel5$tau2),3)) comparison rma(ES, sei=SE,mods=~factor,method="FE",data=comparison,digits=3) #pre-college vs. non-college (4-6) comparison<-data.frame(ES=c(coef(REmodel4),coef(REmodel6)),SE=c(REmodel4$se,REmodel6$se),factor=c(1,2),tau2=round(c(REmodel4$tau2,REmodel6$tau2),3)) comparison rma(ES, sei=SE,mods=~factor,method="FE",data=comparison,digits=3) #college - non-college (5-6) comparison<-data.frame(ES=c(coef(REmodel5),coef(REmodel6)),SE=c(REmodel5$se,REmodel6$se),factor=c(1,2),tau2=round(c(REmodel5$tau2,REmodel6$tau2),3)) comparison rma(ES, sei=SE,mods=~factor,method="FE",data=comparison,digits=3) ##########status of publication ##published data.ges_sample7=data.ges90[data.ges90$publicationstatus=="published",] #fishers`z eszcor<-escalc(measure="ZCOR", ri=correlation, ni=N, data=data.ges_sample7) eszcor #random effects model REmodel7<-rma(yi, vi, data=eszcor, method="REML") REmodel7 predict(REmodel7, transf=transf.ztor) ##unpublished data.ges_sample8=data.ges90[data.ges90$publicationstatus=="unpublished",] #fishers`z eszcor<-escalc(measure="ZCOR", ri=correlation, ni=N, data=data.ges_sample8) eszcor #random effects model REmodel8<-rma(yi, vi, data=eszcor, method="REML") REmodel8 predict(REmodel8, transf=transf.ztor) ##compare (omnibus=paarweise) comparison<-data.frame(ES=c(coef(REmodel7),coef(REmodel8)),SE=c(REmodel7$se,REmodel8$se),factor=c(1,2),tau2=round(c(REmodel7$tau2,REmodel8$tau2),3)) comparison rma(ES, sei=SE,mods=~factor,method="FE",data=comparison,digits=3) ###############################within-study comparison beliefs-intelligence vs. behavior-intelligence ##beliefs-intelligence eszcor<-escalc(measure="ZCOR", ri=correlationBEL, ni=N, data=data.ges) eszcor #random effects model REmodelBEL<-rma(yi, vi, data=eszcor, method="REML") REmodelBEL #convert fisher`s z to r predict(REmodelBEL, digits=3, transf=transf.ztor) ##behaviors-intelligence eszcor<-escalc(measure="ZCOR", ri=correlationBEH, ni=N, data=data.ges) eszcor #random effects model REmodelBEH<-rma(yi, vi, data=eszcor, method="REML") REmodelBEH #convert fisher`s z to r predict(REmodelBEH, digits=3, transf=transf.ztor) ##compare (omnibus=paarweise) comparison<-data.frame(ES=c(coef(REmodelBEL),coef(REmodelBEH)),SE=c(REmodelBEL$se,REmodelBEH$se),factor=c(1,2),tau2=round(c(REmodelBEL$tau2,REmodelBEH$tau2),3)) comparison rma(ES, sei=SE,mods=~factor,method="FE",data=comparison,digits=3) ############################################################################decline effect data.ges_sample7=data.ges[data.ges$publicationstatus=="published",] summary(rma(ri=correlation,ni=N,mods=~yearofpublication,data=data.ges,measure="ZCOR")) reg.d<-rma(ri=correlation,ni=N,mods=~yearofpublication,data=data.ges_sample7,measure="ZCOR") reg.d x=data.ges_sample7$yearofpublication y=data.ges_sample7$correlation #(weighted) published only###############################FIG. 10################################### #################################################################################################### plot(x,y,type= "p", xlim=c(1920,2020),cex =sqrt(data.ges_sample7$N/100) , xlab="Year of Publication", ylab="Reported Effect Size Estimate") m=lm(y~x, weights = data.ges_sample7$N) abline(a=m$coefficients[1],b=m$coefficients[2]) summary(m) ###genuinely decreasing decline effect##### x=data.ges$yearofpublication y=data.ges$correlation plot(x,y, type= "p", xlim=c(1920,2020),cex =sqrt(data.ges_sample7$N/100), xlab="year of publication", ylab="reported effect size estimate") m=lm(y~x, weights = data.ges$N)#, #weights = data.ges$N) abline(a=m$coefficients[1],b=m$coefficients[2]) summary(m) wi<-1/sqrt(data.ges$variance_r) size<-0.5+10*(wi-min(wi))/(max(wi)-min(wi)) plot(data.ges$correlation~data.ges$yearofpublication,cex=size,xlab="Publication Year", ylab="Effect Size Estimate") abline(rma(ri=correlation,ni=N,mods=~yearofpublication,data=data.ges,measure="ZCOR")) ##########################################################################dissemination bias ####################FUNNEL-Plot Fig.8##################################################################### #################################################################################################### funnel(REmodel7) #Tests for bias #egger`s regression test` regtest(REmodel7) #rank correlation test ranktest(REmodel7) #trim and fill REmodel.tf <- trimfill(REmodel7) REmodel.tf funnel(REmodel.tf) #######################################################################################p-uniform library(puniform) datap<-subset(data.ges_sample7, data.ges_sample7$correlation<0) puniform(ri=datap$correlation, ni=datap$N, alpha=.05, side="left", method="P", plot = TRUE) ###puniform* puni_star(ri=datap$correlation, ni=datap$N, alpha=.05, side="left", method="P") help(puni_star) #######################################################################################p-curve #defining loss-function loss=function(t_obs,df_obs,d_est) { #Syntax t_obs: vector of t-values, df_obs of degrees of freedom, d_est: candidate d t_obs=abs(t_obs) #Take absolute value of t-value (p-curve assumes same sign and/or sign does not matter) p_obs=2*(1-pt(t_obs,df=df_obs)) #Compute p-values of each t in t_obs so as to keep only p<.05 results t.sig=subset(t_obs,p_obs<.05) #Significant t-values df.sig=subset(df_obs,p_obs<.05) #d.f. associated with significant t.values ncp_est=sqrt((df.sig+2)/4)*d_est #Compute noncentrality parameter for that sample size and candidate effect size tc=qt(.975,df.sig) #Compute critical t-value to get p=.05 power_est=1-pt(tc,df.sig,ncp_est) #Compute power for obtaining that t-value or bigger, given the noncentrality parameter p_larger=pt(t.sig,df=df.sig,ncp=ncp_est) #Probability of obtaining a t-value bigger than the one that is observed (this is a vector) ppr=(p_larger-(1-power_est))/power_est #Conditional probability of larger t-value given that it is p<.05, pp-values KSD=ks.test(ppr,punif)$statistic #Kolmogorov Smirnov test on that vector against the theoretical U[0,1] distribution return(KSD) } #find the best fitting effect size plotloss=function(t_obs,df_obs,dmin,dmax) #Syntax, same as above plus: dmin/dmax: smallest/biggest d considered, { loss.all=c() #Vector where results of fit for each candidate effect size are stored di=c() #Vector where the respective effect sizes are stored for (i in 0:((dmax-dmin)*100)) { #Do a loop considering every effect size between dmin and dmax in steps of .01 d=dmin+i/100 #What effect size are we considering? di=c(di,d) #Add it to the vector of effect sizes options(warn=-1) #turn off warning because R often generates warnings when using noncentral pt() and qt() that are inconsequential (they involve lack of precision at a degree where precision lacks practical relevance) loss.all=c(loss.all,loss(df_obs=df_obs,t_obs=t_obs,d_est=d)) #add loss for that effect size to the vector with all losses options(warn=0) #turn warnings back on } imin=match(min(loss.all),loss.all) #Find the attempted effect size that leads to smallest los overall dstart=dmin+imin/100 #Counting from dmin, what effect size is that? dhat=optimize(loss,c(dstart-.1, dstart+.1), df_obs=df_obs,t_obs=t_obs) #Now optimize in the neighborhood of that effect size #PLOT RESULTS plot(di,loss.all,xlab="Effect size\nCohen-d", ylab="Loss (D stat in KS test)",ylim=c(0,1), main="How well does each effect size fit? (lower is better)") points(dhat$minimum,dhat$objective,pch=19,col="red",cex=2) #Put a red dot in the estimated effect size #Add a label text(dhat$minimum,dhat$objective-.08,paste0("p-curve's estimate of effect size:\nd=",round(dhat$minimum,3)),col="red") return(dhat$minimum) } t_obs=c(-1.61, -.93, -1.27, -3.37, -3.30, -2.07, -1.94, 1.71, 1.44, -2.54, -.06, -3.33, -9.92, -1.44, -2.21, -2.63, -8.66, -5.53, -3.95, -1.92, -2.85, -3.48, -6.69, -4.03, -.46, .00, -.20, -4.90, -1.00, 1.71, -.97, -2.07, -4.74, .66, -2.65, -.56, -9.49, -.97, -2.79, -2.83, 2.50, -2.69, .32, 1.91, -.56, -.28, -2.23, -1.07, .00, -4.98, 1.26, .76, .65, -1.05, -15.52, -2.57, -3.15, -10.99, -2.04, -1.56, -5.17, -5.91, 2.32, -2.29, -2.52, -.59, -3.06, -14.44, -11.96, -.87, -17.29, -4.90, -7.52, -2.73, -1.05, -2.88, -2.81, -22.40, -1.97, -3.41, -3.55, -6.29, -3.31, -51.85, -5.28, -2.13, -17.63, -17.80, -4.98, -4.90, -19.14, .00, -1.72, -7.52, 3.14, -3.09, -4.74, 2.16, -2.98, -.99, -5.08, -1.86, -3.29, -5.51, -2.34) df_obs=c(177, 133, 325, 34, 73, 214, 33, 127, 120, 89, 42, 556, 1475, 108, 183, 264, 11652, 459, 65, 98, 352, 198, 158, 266, 232, 324, 98, 106, 58, 359, 259, 163, 1536, 479, 572, 38, 70, 94, 337, 239, 186, 193, 42, 2270, 198, 198, 288, 709, 94, 217, 92, 118, 170, 75, 949, 99, 178, 11961, 140, 121, 437, 1043, 234, 228, 276, 20, 3740, 14275, 7158, 18, 12992, 2377, 2153, 373, 304, 221, 265, 8982, 148, 89, 548, 503, 196, 37076, 1063, 424, 30760, 15841, 596, 473, 8881, 793, 817, 1013, 2320, 320, 315, 119, 299, 198, 983, 537, 629, 597, 473) plotloss(t_obs = t_obs, df_obs = df_obs, dmin=-1, dmax=1) ###############################################################################gender-regression reg.g<-rma(ri=correlation,ni=N,mods=~maleproportion,data=data.ges,measure="ZCOR") reg.g summary(reg.g) x=data.ges$maleproportion y=data.ges$correlation #############################################FIG 7###################################################### ######################################################################################################## library(metafor) wi<-1/sqrt(data.ges$variance_r) size<-0.5+10*(wi-min(wi))/(max(wi)-min(wi)) preds<-predict(reg.g) plot(data.ges$correlation~data.ges$maleproportion,cex=size,xlab="Proportion of Men in Sample", ylab="Reported Effect Size Estimate") abline(rma(ri=correlation,ni=N,mods=~maleproportion,data=data.ges,measure="ZCOR")) plot(x,y, xlab="Proportion of Men", ylab="Reported Effect Size Estimate", cex=sqrt(data.ges$N/100)) m=lm(y~x, weights = data.ges$N) abline(a=m$coefficients[1],b=m$coefficients[2]) summary(m) #gender reg only IQ data.ges_sample9=data.ges[data.ges$intelligenceMeasure=="ohneGPA",] reg.g<-rma(ri=correlation,ni=N,mods=~maleproportion,data=data.ges_sample9,measure="ZCOR") reg.g x=data.ges_sample9$maleproportion y=data.ges_sample9$correlation plot(x,y, xlab="Proportion of Males", ylab="Reported Effect Size Estimate", cex=sqrt(data.ges_sample9$N/100)) m=lm(y~x, weights = data.ges_sample9$N) abline(a=m$coefficients[1],b=m$coefficients[2]) summary(m) ###############gender-subgroup analysis #male data_male=data.ges[data.ges$maleproportion==1,] #fishers`z eszcor<-escalc(measure="ZCOR", ri=correlation, ni=N, data=data_male) eszcor #random effects model REmodelM<-rma(yi, vi, data=eszcor, method="REML") REmodelM predict(REmodelM, transf=transf.ztor) #female data_female=data.ges[data.ges$maleproportion==0,] #fishers`z eszcor<-escalc(measure="ZCOR", ri=correlation, ni=N, data=data_female) eszcor #random effects model REmodelF<-rma(yi, vi, data=eszcor, method="REML") REmodelF predict(REmodelF, transf=transf.ztor) ##compare (omnibus=paarweise) comparison<-data.frame(ES=c(coef(REmodelM),coef(REmodelF)),SE=c(REmodelM$se,REmodelF$se),factor=c(1,2),tau2=round(c(REmodelM$tau2,REmodelF$tau2),3)) comparison rma(ES, sei=SE,mods=~factor,method="FE",data=comparison,digits=3) ##########################################################################effect size on study quality ###newcastle-ottowa scale######################################################################## #################################################################################################### x=data.ges$SUM y=data.ges$correlation plot(x,y,xlab="quality of study", ylab="reported effect size estimate") m=lm(y~x) abline(a=m$coefficients[1],b=m$coefficients[2]) summary(m) summary(lm(data.ges$correlation~data.ges$SUM)) ###newcastle-ottowa scale##### weighted reg.g<-rma(ri=correlation,ni=N,mods=~SUM,data=data.ges,measure="ZCOR") reg.g x=data.ges$SUM y=data.ges$correlation plot(x,y, xlab="quality of study", ylab="reported effect size estimate", cex=sqrt(data.ges$N/100)) m=lm(y~x, weights = data.ges$N) abline(a=m$coefficients[1],b=m$coefficients[2]) summary(m) wi<-1/sqrt(data.ges$variance_r) size<-0.5+10*(wi-min(wi))/(max(wi)-min(wi)) preds<-predict(reg.g) plot(data.ges$correlation~data.ges$maleproportion,cex=size,xlab="Proportion of Men in Sample", ylab="Reported Effect Size Estimate") abline(rma(ri=correlation,ni=N,mods=~maleproportion,data=data.ges,measure="ZCOR")) ######################################################################## Ioannidis & Trikalinos #TES library(pwr) library(meta) #published & neg.sign data.new<-data.ges_sample7[data.ges_sample7$correlation<0,] data.new P.ind.all.e<-mapply(pwr.r.test,n=data.ges$N,r=-.141) P.ind.all.e PowP.ind.all.e<-sapply(P.ind.all.e[4,1:105], as.numeric) MeanPowerInd.all.e<-mean(PowP.ind.all.e) MeanPowerInd.all.e e.all.e<-MeanPowerInd.all.e*105 e.all.e ################### calculate correlation coefficients corrected for univariate direct range departure ##College data.ges_sample5=data.ges[data.ges$sample=="College",] r<-data.ges_sample5$correlation u<-1/.67 ##Thorndike: x<- (u*r)/sqrt(1+r^2*(u-1)) x #fishers`z eszcor<-escalc(measure="ZCOR", ri=x, ni=N, data=data.ges_sample5) eszcor #random effects model REmodelRC<-rma(yi, vi, data=eszcor, method="REML") REmodelRC predict(REmodelRC, transf=transf.ztor) #########subgroup analysis with correction for range restriction in college samples ##Pre-College data.ges_sample4=data.ges[data.ges$sample=="Pre-College",] #fishers`z eszcor<-escalc(measure="ZCOR", ri=correlation, ni=N, data=data.ges_sample4) eszcor #random effects model REmodel4<-rma(yi, vi, data=eszcor, method="REML") REmodel4 predict(REmodel4, transf=transf.ztor) ##Non-College data.ges_sample6=data.ges[data.ges$sample=="Non-College",] #fishers`z eszcor<-escalc(measure="ZCOR", ri=correlation, ni=N, data=data.ges_sample6) eszcor #random effects model REmodel6<-rma(yi, vi, data=eszcor, method="REML") REmodel6 predict(REmodel6, transf=transf.ztor) ##compare omnibus comparison<-data.frame(ES=c(coef(REmodel4),coef(REmodelRC),coef(REmodel6)),SE=c(REmodel4$se,REmodelRC$se,REmodel6$se),factor=c(1,2,3),tau2=round(c(REmodel4$tau2,REmodelRC$tau2,REmodel6$tau2),3)) comparison rma(ES, sei=SE,mods=~factor,method="FE",data=comparison,digits=3) ##compare paarweise #pre-college vs. collegeRC (4-5) comparison<-data.frame(ES=c(coef(REmodel4),coef(REmodelRC)),SE=c(REmodel4$se,REmodelRC$se),factor=c(1,2),tau2=round(c(REmodel4$tau2,REmodelRC$tau2),3)) comparison rma(ES, sei=SE,mods=~factor,method="FE",data=comparison,digits=3) #pre-college vs. non-college (4-6) #comparison<-data.frame(ES=c(coef(REmodel4),coef(REmodel6)),SE=c(REmodel4$se,REmodel6$se),factor=c(1,2),tau2=round(c(REmodel4$tau2,REmodel6$tau2),3)) #comparison #rma(ES, sei=SE,mods=~factor,method="FE",data=comparison,digits=3) #collegeRC - non-college (5-6) comparison<-data.frame(ES=c(coef(REmodelRC),coef(REmodel6)),SE=c(REmodelRC$se,REmodel6$se),factor=c(1,2),tau2=round(c(REmodelRC$tau2,REmodel6$tau2),3)) comparison rma(ES, sei=SE,mods=~factor,method="FE",data=comparison,digits=3) ############################################################################multiple moderator analysis #gender, year of publication, status of publication reg.mm<-rma(ri=correlation,ni=N,mods=cbind(maleproportion, yearofpublication, publicationstatus),data=data.ges,measure="ZCOR", weights = data.ges$N) reg.mm ########################################################################mediation analysis: education ##partial correlations #intelligence- religiosity correlation (zero order) data.edu data.edu2<-data.edu[data.edu$sample!="College",] data.edu2 dim(data.edu2) ####overall-rma - religiosity intelligence #fishers`z eszcor<-escalc(measure="ZCOR", ri=correlation, ni=N, data=data.edu2) eszcor #random effects model REmodel<-rma(yi, vi, data=eszcor, method="REML") REmodel #convert fisher`s z to r predict(REmodel, digits=3, transf=transf.ztor) ###partial-correlation intelligence religiosity (controlled for education) #fishers`z eszcor<-escalc(measure="ZCOR", ri=par.IR, ni=N, data=data.edu2) eszcor #random effects model REmodel<-rma(yi, vi, data=eszcor, method="REML") REmodel #convert fisher`s z to r predict(REmodel, digits=3, transf=transf.ztor) #education and religiosity eszcor<-escalc(measure="ZCOR", ri=ReligiosityEducation, ni=N, data=data.edu2) eszcor #random effects model REmodel<-rma(yi, vi, data=eszcor, method="REML") REmodel #convert fisher`s z to r predict(REmodel, digits=3, transf=transf.ztor) ###partial-correlation religiosity education (controlled for intelligence) eszcor<-escalc(measure="ZCOR", ri=part.ER, ni=N, data=data.edu2) eszcor #random effects model REmodel<-rma(yi, vi, data=eszcor, method="REML") REmodel #convert fisher`s z to r predict(REmodel, digits=3, transf=transf.ztor) #intelligence education eszcor<-escalc(measure="ZCOR", ri=IntelligenceEducation, ni=N, data=data.edu2) eszcor #random effects model REmodel<-rma(yi, vi, data=eszcor, method="REML") REmodel #convert fisher`s z to r predict(REmodel, digits=3, transf=transf.ztor) #########################################################################multiverse/ specification-curve library(readxl) library(metafor) library(ggplot2) library(plyr) library(ggpubr) library(grid) library(gridExtra) library(metaviz) #plots library(Matrix) library(psychmeta) library (metafor) library (foreign) library(gsl) library(dplyr) #Variance fisher`s z eszcor<-escalc(measure="ZCOR", ri=correlation, ni=N, data=data.ges) eszcor zcor<-eszcor$yi zcor_var<-eszcor$vi #Variance ucor esucor<-escalc(measure="UCOR", ri=correlation, ni=N, data=data.ges) esucor ucor<-esucor$yi ucor_var<-esucor$vi #new dataset x<-cbind(data.ges, zcor, zcor_var, ucor, ucor_var) x ####################gosh-plot # create function sca_gosh <- function(x, highlightID = 37 | 55, cols = c("#08519C", "#DEEBF7"), pointsize = 2, random_samples = NULL, text_size = 3, xlab = "Effect size", x_limit = NULL, x_breaks = NULL, trans_function = NULL) { subset_statistics <- function(subsets, data) { es <- data[subsets, 1] se <- data[subsets, 2] k <- length(es) xy <- rma.uni(yi = es, sei = se, method = "PM", # Fisher scoring algorithm got stuck a lot using REML; therefore PM used data = data) M <- xy$beta I2 <- xy$I2 data.frame(M = M, I2 = I2) } #all subset meta-analysis k <- nrow(x) #number of studies if(!is.null(random_samples)) { if(random_samples < 2^nrow(x) - 1) { mult_const <- 1 list_length <- 0 while(list_length < random_samples) { iter_k <- rep(1:k, times = random_samples*mult_const) l <- lapply(iter_k, function(x) {sort(sample(1:k, x, replace = F))}) l <- l[!duplicated(l)] list_length <- length(l) if(list_length < random_samples) { mult_const <- mult_const*2 } } subsets <- l[1:random_samples] } else { subsets <- unlist(sapply(1:k, FUN = function(x) combn(1:k, x, simplify = FALSE)), recursive = FALSE) # all combinations sum(choose(k, 1:k)) } } else { subsets <- unlist(sapply(1:k, FUN = function(x) combn(1:k, x, simplify = FALSE)), recursive = FALSE) #all combinations sum(choose(k, 1:k)) } subset_results <- lapply(subsets, FUN = function(y) { data.frame(subset_to_highlight = as.numeric(highlightID %in% y), subset_statistics(subsets = y, data = x))}) plotdata <- plyr::ldply(subset_results) y_limit <- c(-10, 110) if(is.null(x_limit)) { x_limit <- c(min(plotdata$M) - diff(range(plotdata$M))*0.1, max(plotdata$M) + diff(range(plotdata$M))*0.1) } scatter <- ggplot(plotdata, aes(x = M, y = I2)) + geom_point(aes(fill = as.factor(subset_to_highlight)), size = pointsize, stroke = pointsize*0.1, shape = 21, color = "black") + # alpha = 0.2 labs(x = xlab, y = expression(I^{2})) + scale_fill_manual(values=c("0" = cols[1], "1" = cols[2])) + coord_cartesian(xlim = x_limit, ylim = y_limit, expand = F) # define x scale (transformation, breaks, labels) ------------------------- if(!is.null(trans_function) && identical(trans_function, exp)) { if(is.null(x_breaks)) { x_breaks <- log(c(rev(1/(2*2^(0:ceiling(max(abs(x_limit)))))), 1, 2*2^(0:ceiling(max(abs(x_limit)))))) } scatter <- scatter + scale_x_continuous(name = xlab, breaks = x_breaks, labels = function(x) {round(trans_function(x), 3)}) } else { if(!is.null(trans_function) && identical(trans_function, tanh)) { if(is.null(x_breaks)) { scatter <- scatter + scale_x_continuous(name = xlab, labels = function(x) {round(trans_function(x), 3)}) } else { scatter <- scatter + scale_x_continuous(name = xlab, breaks = x_breaks, labels = function(x) {round(trans_function(x), 3)}) } } else { if(is.null(x_breaks)) { if(!is.null(trans_function)) { scatter <- scatter + scale_x_continuous(name = xlab, labels = function(x) {round(trans_function(x), 3)}) } else { scatter <- scatter + scale_x_continuous(name = xlab) } } else { if(!is.null(trans_function)) { scatter <- scatter + scale_x_continuous(name = xlab, breaks = x_breaks, labels = function(x) {round(trans_function(x), 3)}) } else { scatter <- scatter + scale_x_continuous(name = xlab, breaks = x_breaks) } } } } scatter <- scatter + theme_bw() + theme(legend.position = "none", text = element_text(size = 1/0.352777778*text_size), panel.border = element_rect(fill = NA, colour = "black"), panel.grid.major.y = element_line("grey"), panel.grid.minor.y = element_line("grey"), panel.grid.major.x = element_line("grey"), panel.grid.minor.x = element_line("grey"), plot.margin = margin(t = 0, r = 0, b = 5.5, l = 5.5, "pt")) density_M <- ggplot(plotdata, aes(x = M)) + geom_density(trim = F, aes(y = ..density.., fill = as.factor(subset_to_highlight)), alpha = 0.75) + labs(x = "", y = expression(I^{2})) + coord_cartesian(ylim = c(0, max(density(plotdata$M[plotdata$subset_to_highlight == 0])$y, density(plotdata$M[plotdata$subset_to_highlight == 1])$y)*1.1), xlim = x_limit, expand = F) + scale_y_continuous(breaks = 0, labels = 100) + scale_fill_manual(values=c("0" = cols[1], "1" = cols[2])) # define x scale (transformation, breaks, labels) ------------------------- if(!is.null(trans_function) && identical(trans_function, exp)) { if(is.null(x_breaks)) { x_breaks <- log(c(rev(1/(2*2^(0:ceiling(max(abs(x_limit)))))), 1, 2*2^(0:ceiling(max(abs(x_limit)))))) } density_M <- density_M + scale_x_continuous(name = xlab, breaks = x_breaks, labels = function(x) {round(trans_function(x), 3)}) } else { if(!is.null(trans_function) && identical(trans_function, tanh)) { if(is.null(x_breaks)) { density_M <- density_M + scale_x_continuous(name = xlab, labels = function(x) {round(trans_function(x), 3)}) } else { density_M <- density_M + scale_x_continuous(name = xlab, breaks = x_breaks, labels = function(x) {round(trans_function(x), 3)}) } } else { if(is.null(x_breaks)) { if(!is.null(trans_function)) { density_M <- density_M + scale_x_continuous(name = xlab, labels = function(x) {round(trans_function(x), 3)}) } else { density_M <- density_M + scale_x_continuous(name = xlab) } } else { if(!is.null(trans_function)) { density_M <- density_M + scale_x_continuous(name = xlab, breaks = x_breaks, labels = function(x) {round(trans_function(x), 3)}) } else { density_M <- density_M + scale_x_continuous(name = xlab, breaks = x_breaks) } } } } density_M <- density_M + theme_bw() + theme(legend.position = "none", panel.border = element_rect(fill = NA, colour = "white"), text = element_text(size = 1/0.352777778*text_size), axis.text.y = element_text(colour = "white"), axis.text.x = element_blank(), axis.ticks.x = element_blank(), axis.ticks.y = element_line(colour = "white"), axis.title = element_text(colour = "white"), panel.grid.major.y = element_blank(), panel.grid.minor.y = element_blank(), panel.grid.major.x = element_blank(), panel.grid.minor.x = element_blank(), plot.margin = margin(t = 0, r = 5.5, b = -14.5, l = 5.5, "pt")) density_I2 <- ggplot(plotdata, aes(x = I2)) + geom_density(trim = F, aes(y = ..density.., fill = as.factor(subset_to_highlight)), alpha = 0.75) + labs(x = "", y = xlab) + scale_y_continuous(breaks = max(density(plotdata$I2[plotdata$subset_to_highlight == 0])$y, density(plotdata$I2[plotdata$subset_to_highlight == 1])$y), labels = 0) + scale_fill_manual(values=c("0" = cols[1], "1" = cols[2])) + theme(legend.position = "none", panel.background = element_blank(), text = element_text(size = 1/0.352777778*text_size), axis.text.x = element_text(colour = "white"), axis.text.y = element_blank(), axis.ticks.x = element_line(colour = "white"), axis.ticks.y = element_blank(), panel.border = element_rect(fill = NA, colour = "white"), axis.title = element_text(colour = "white"), panel.grid.major.y = element_blank(), panel.grid.minor.y = element_blank(), panel.grid.major.x = element_blank(), panel.grid.minor.x = element_blank(), plot.margin = margin(t = 0, r = 0, b = 5.5, l = -14.5, "pt")) + coord_flip(xlim = y_limit, ylim = c(0, max(density(plotdata$I2[plotdata$subset_to_highlight == 0])$y, density(plotdata$I2[plotdata$subset_to_highlight == 1])$y)*1.1), expand = F) blank <- ggplot(plotdata, aes(x = M, y = I2)) + labs(x = "", y = "") + coord_cartesian(expand = F) + theme(legend.position = "none", text = element_text(size = 1/0.352777778*text_size), axis.text.x = element_blank(), axis.text.y = element_blank(), axis.ticks.x = element_blank(), axis.ticks.y = element_blank(), panel.border = element_rect(fill = NA, colour = "white"), panel.background = element_blank(), panel.grid.major.y = element_blank(), panel.grid.minor.y = element_blank(), panel.grid.major.x = element_blank(), panel.grid.minor.x = element_blank(), plot.margin = margin(t = 0, r = 0, b = -14.5, l = -14.5, "pt")) layout_matrix <- matrix(c(1, 1, 1, 1, 2, 4, 4, 4, 4, 3, 4, 4, 4, 4, 3, 4, 4, 4, 4, 3, 4, 4, 4, 4, 3), nrow = 5, byrow = T) p <- arrangeGrob(density_M, blank, density_I2, scatter, layout_matrix = layout_matrix) as_ggplot(p) } p_gosh_FS <- sca_gosh(x = cbind(x$zcor, sqrt(x$zcor_var)), random_samples = 100000, pointsize = 0.5, trans_function = tanh, x_breaks = atanh(c(-0.4, -0.2, 0, 0.2, 0.4)), cols = c("steelblue4", "firebrick"), xlab = "Summary Effect (r)", text_size = 2.5, x_limit = atanh(c(-0.4, 0.4))) #ggsave("p_gosh_r.png", p_gosh_FS, width = 7.5, height = 7.5, dpi = 1200, units = "cm") ##################################################FIG 3################################################### ########################################################################################################## p_gosh_FS ##################rainforest-plot study_table<-data.frame( study = x$Study, YearofPublication = x$yearofpublication) study_table p_rain_r <- viz_rainforest(x = cbind(x$zcor, sqrt(x$zcor_var)), trans_function = tanh, x_breaks = atanh(c(-1, -0.5, 0, 0.5)), names = x$StudyID, detail_level = 30, study_table = study_table, xlab = "Effect Size (r)", text_size = 1.5, x_limit = c(-1, 0.5)) + ggtitle("Intelligence-Religiosity") #####################################################FIG 2################################################ ########################################################################################################## p_rain_r x<-cbind(data.ges, zcor, zcor_var, ucor, ucor_var) x<-x[c(1:77,80:82,84:96,99:105),] ##x<-x[-c(78,81,84),] ############################################################################specification curve # Construct grouping factors (internal, which factors) religiosityMeasure <- c("Beliefs", "Behavior", "mixed") sample <- c("College", "Non-College", "Pre-College") publicationstatus <- c("published", "unpublished", "total_publicationstatus") # different methods (external, how factors) effect <- c("r", "zcor", "ucor") ma_method <- c("REML_inv", "unweighted", "RE_DL", "FE") # Construct all possible combinations of internal and external factors specifications <- expand.grid(religiosityMeasure = religiosityMeasure, sample = sample, publicationstatus = publicationstatus, effect = effect, ma_method = ma_method) specifications <- data.frame(specifications, mean = rep(NA, nrow(specifications)), lb = rep(NA, nrow(specifications)), ub = rep(NA, nrow(specifications)), p = rep(NA, nrow(specifications)), k = rep(NA, nrow(specifications))) specifications # Conduct specification analyses for(i in 1:nrow(specifications)) { dat <- x #### Determine specification subset by using "Which" factors ################################################### if(specifications$religiosityMeasure[i] == "Beliefs") { dat <- dat[dat$religiosityMeasure == "Beliefs", ] } else { if(specifications$religiosityMeasure[i] == "Behavior") { dat <- dat[dat$religiosityMeasure == "Behavior", ] } else{ if(specifications$religiosityMeasure[i] == "mixed") { dat <- dat[dat$religiosityMeasure == "mixed", ] } } } if(specifications$sample[i] == "College") { dat <- dat[dat$sample == "College", ] } else { if(specifications$sample[i] == "Non-College") { dat <- dat[dat$sample == "Non-College", ] } else { if(specifications$sample[i] == "Pre-College") { dat <- dat[dat$sample == "Pre-College", ] } } } if(specifications$publicationstatus[i] == "published") { dat <- dat[dat$publicationstatus == "published", ] } else { if(specifications$publicationstatus[i] == "unpublished") { dat <- dat[dat$publicationstatus == "unpublished", ] } } # only compute meta-analytic summary effects for specification subsets with at least two studies/samples. if(nrow(dat) < 2) next # Save which study/sample IDs were selected by the "Which" factors for a given specification. specifications$set[i] <- paste(rownames(dat), collapse = ",") #### Determine specification analyses by using "How" factors #################################################### if(specifications$effect[i] == "r") { #################### effect = r ################ if(specifications$ma_method[i] == "REML_inv") { mod <- rma(yi = dat$correlation, vi = dat$r_var, method = "REML", control = list(stepadj=0.5, maxiter = 2000)) } else { if(specifications$ma_method[i] == "unweighted") { mod <- rma(yi = dat$correlation, vi = dat$r_var, method = "FE", weights = 1/nrow(dat)) } else { if(specifications$ma_method[i] == "FE") { mod <- rma(yi = dat$correlation, vi = dat$r_var, method = "FE") } else { if(specifications$ma_method[i] == "RE_DL") { mod <- rma(yi = dat$correlation, vi = dat$r_var, method = "DL") } } } } specifications$mean[i] <- mod$b[[1]] specifications$lb[i] <- mod$ci.lb[[1]] specifications$ub[i] <- mod$ci.ub[[1]] specifications$p[i] <- mod$pval[[1]] specifications$k[i] <- nrow(dat) ################################################ } else { if(specifications$effect[i] == "zcor") { #################### effect = zcor ################ if(specifications$ma_method[i] == "REML_inv") { mod <- rma(yi = dat$zcor, vi = dat$zcor_var, method = "REML", control = list(stepadj=0.5, maxiter = 2000)) } else { if(specifications$ma_method[i] == "unweighted") { mod <- rma(yi = dat$zcor, vi = dat$zcor_var, method = "FE", weights = 1/nrow(dat)) } else { if(specifications$ma_method[i] == "FE") { mod <- rma(yi = dat$zcor, vi = dat$zcor_var, method = "FE") } else { if(specifications$ma_method[i] == "RE_DL") { mod <- rma(yi = dat$zcor, vi = dat$zcor_var, method = "DL") } } } } specifications$mean[i] <- tanh(mod$b[[1]]) # inverse of z specifications$lb[i] <- tanh(mod$ci.lb[[1]]) specifications$ub[i] <- tanh(mod$ci.ub[[1]]) specifications$p[i] <- mod$pval[[1]] specifications$k[i] <- nrow(dat) ################################################ } else { if(specifications$effect[i] == "ucor") { #################### effect = ucor ################ if(specifications$ma_method[i] == "REML_inv") { mod <- rma(yi = dat$ucor, vi = dat$ucor_var, method = "REML", control = list(stepadj=0.5, maxiter = 2000)) } else { if(specifications$ma_method[i] == "unweighted") { mod <- rma(yi = dat$ucor, vi = dat$ucor_var, method = "FE", weights = 1/nrow(dat)) } else { if(specifications$ma_method[i] == "FE") { mod <- rma(yi = dat$ucor, vi = dat$ucor_var, method = "FE") } else { if(specifications$ma_method[i] == "RE_DL") { mod <- rma(yi = dat$ucor, vi = dat$ucor_var, method = "DL") } } } } specifications$mean[i] <- mod$b[[1]] specifications$lb[i] <- mod$ci.lb[[1]] specifications$ub[i] <- mod$ci.ub[[1]] specifications$p[i] <- mod$pval[[1]] specifications$k[i] <- nrow(dat) ##################################### } } } } # Only keep specifications with at least 2 studies/samples specifications_full <- specifications[complete.cases(specifications),] # Only keep unique study/sample subsets resulting from "Which" factor combinations. specifications_full <- specifications_full[!duplicated(specifications_full[, c("mean", "set", "ma_method", "effect")]), ] # Indicator if all studies are included in the set specifications_full$full_set <- as.numeric(specifications_full$set == paste(1:nrow(dat), collapse =",", sep = "")) # Save specification data write.csv2(file = "specifications.csv", specifications_full) data(specifications.csv) specifications_full #specifications_full$set #options(max.print=5000) #specifications_full$ub #m<- specifications_full$p<=0.05 #m #specifications_new<- specifications_full[specifications_full$p<0.05,] #specifications_new ################################### # DESCRIPTIVE SPECIFICATION PLOTS # ################################### # load data specifications_full <- read.csv2('specifications.csv')[, -1] #specifications_full <- specifications # prepare plotting data for tile plot # grouping factors religiosityMeasure <- c("Beliefs", "Behavior", "mixed") sample <- c("College", "Non-College", "Pre-College") publicationstatus <- c("published", "unpublished", "total_publicationstatus") # different methods (external, how factors) effect <- c("r", "zcor", "ucor") ma_method <- c("REML_inv", "unweighted", "RE_DL", "FE") x_rank <- rank(specifications_full$mean, ties.method = "random") yvar <- rep(factor(rev(c(religiosityMeasure, sample, publicationstatus, effect, ma_method)), levels = rev(c(religiosityMeasure, sample, publicationstatus, effect, ma_method))), times = nrow(specifications_full)) xvar <- rep(x_rank, each = length(levels(yvar))) spec <- NULL # Determine which specifications are observed and which are not for(i in 1:nrow(specifications_full)) { id <- as.numeric(levels(yvar) %in% as.character(unlist(specifications_full[i, 1:5]))) spec <- c(spec, id) } plotdata <- data.frame(xvar, yvar, spec) ylabels <- rev(c("ReligiosityMeasure: Beliefs", "ReligiosityMeasure: Behavior", "ReligiosityMeasure: Mixed", "Sample: Pre-College", "Sample: College", "Sample: Non-College", "Publicationstatus: Published", "Publicationstatus: Unpublished", "Publicationstatus: Either", "Metric: r", "Metric: z", "Metric: ucor", "Model: REML_inv", "Model: Unweighted", "Model:RE_DL", "model: FE" )) plotdata$k <- rep(specifications_full$k, each = length(levels(yvar))) plotdata$fill <- as.factor(plotdata$k * plotdata$spec) cols <- RColorBrewer::brewer.pal(min(11, length(levels(plotdata$fill)) - 1), "Spectral") #help(brewer.pal) # Create specification tile plot ------------------------------------------ p_spec <- ggplot(data = plotdata, aes(x = xvar, y = as.factor(yvar), fill = fill)) + geom_raster() + geom_hline(yintercept = c(3, 7, 10, 13, 16, 18) + 0.5) + scale_x_continuous(position = "bottom") + scale_y_discrete(labels = ylabels) + scale_fill_manual(values = c("white", c(cols[floor(seq(from = 1, to = length(cols), length.out = length(levels(plotdata$fill)) - 1))]))) + labs(x = "Specification Number", y = "Which/How Factors") + coord_cartesian(expand = F, xlim = c(0.5, nrow(specifications_full) + 0.5)) + theme_bw() + theme(legend.position = "none", axis.text = element_text(colour = "black"), axis.ticks = element_line(colour = "black"), plot.margin = margin(t = 5.5, r = 5.5, b = 5.5, l = 5.5, unit = "pt")) # Create summary forest plot ------------------------------------------------------ specifications_full$xvar <- x_rank yrng <- range(c(0, specifications_full$lb, specifications_full$ub)) ylimit <- c(yrng[1] - diff(yrng)*0.1, yrng[2] + diff(yrng)*0.1) y_breaks_forest <- round(seq(from = round(ylimit[1], 1), to = round(ylimit[2], 1), by = 0.1), 2) y_labels_forest <- format(y_breaks_forest, nsmall = 2) y_breaks_forest <- c(ylimit[1], y_breaks_forest) y_labels_forest <- c(ylabels[which.max(nchar(ylabels))], y_labels_forest) p_forest <- ggplot(data = specifications_full, aes(x = xvar, y = mean)) + geom_errorbar(aes(ymin = lb, ymax = ub, col = as.factor(k)), width = 0, size = 0.25) + geom_line(col = "black", size = 0.25) + geom_hline(yintercept = 0, linetype = 2, size = 0.25) + scale_x_continuous(name = "") + scale_y_continuous(name = "Summary effect (r)", breaks = y_breaks_forest, labels = y_labels_forest) + scale_color_manual(values = c(cols[floor(seq(from = 1, to = length(cols), length.out = length(levels(as.factor(specifications_full$k)))))])) + coord_cartesian(ylim = ylimit, xlim = c(0.5, nrow(specifications_full) + 0.5), expand = FALSE) + ggtitle("Intelligence - Religiosity") + theme_bw() + theme(legend.position = "none", axis.text.x = element_blank(), axis.ticks.x = element_blank(), axis.text.y = element_text(colour = c("white", rep("black", times = length(y_labels_forest) - 1))), axis.ticks.y = element_line(colour = c("white", rep("black", times = length(y_breaks_forest) - 1))), panel.grid.major.x = element_blank(), panel.grid.minor.x = element_blank(), panel.grid.major.y = element_line(), panel.grid.minor.y = element_blank(), plot.margin = margin(t = 5.5, r = 5.5, b = -15, l = 5.5, unit = "pt")) # Create subset size indicator -------------------------------------------- yrng <- range(c(2, max(specifications_full$k))) ylimit <- c(2, max(specifications_full$k)) y_breaks_size <- round(seq(from = yrng[1], to = yrng[2], by = 61.33), 0) y_labels_size <- format(y_breaks_size, nsmall = 0) y_breaks_size <- c(ylimit[1], y_breaks_size) y_labels_size <- c(ylabels[which.max(nchar(ylabels))], y_labels_size) p_size <- ggplot(data = specifications_full, aes(x = xvar, y = k)) + geom_area(fill = "gray35", color = "black", size = 0.25) + scale_x_continuous(name = "") + scale_y_continuous(name = "# Samples", breaks = y_breaks_size, labels = y_labels_size) + coord_cartesian(ylim = ylimit, xlim = c(0.5, nrow(specifications_full) + 0.5), expand = FALSE) + theme_bw() + theme(legend.position = "none", axis.text.x = element_blank(), axis.ticks.x = element_blank(), axis.text.y = element_text(colour = c("white", rep("black", times = length(y_labels_size) - 1))), axis.ticks.y = element_line(colour = c("white", rep("black", times = length(y_breaks_size) - 1))), panel.grid.major.x = element_blank(), panel.grid.minor.x = element_blank(), panel.grid.major.y = element_line(), panel.grid.minor.y = element_blank(), plot.margin = margin(t = 5.5, r = 5.5, b = -15, l = 5.5, unit = "pt")) # Combine specfication tile plot, subset size indicator and forest plot p <- gridExtra::arrangeGrob(p_spec, p_size, p_forest, layout_matrix = matrix(c(3, 3, 3, 2, 1, 1, 1, 1, 1), ncol = 1)) head(specifications_full) specifications_full$mean specifications_full$lb specifications_full$ub view(specifications.csv) #############################################################FIG 4###################################### ######################################################################################################## p <- ggpubr::as_ggplot(p) p #ggsave("plot_specforest_FSIQ.png", p, width = 16*1.2, height = 12*1.2, dpi = 600, units = "cm") #################################################bootstrap inferencial x<-data.ges r_se<-sqrt(data.ges$r_var) #Varianz fisher`s z eszcor<-escalc(measure="ZCOR", ri=correlation, ni=N, data=data.ges) eszcor zcor<-eszcor$yi zcor_var<-eszcor$vi z_se<-sqrt(zcor_var) #Varianz ucor esucor<-escalc(measure="UCOR", ri=correlation, ni=N, data=data.ges) esucor ucor<-esucor$yi ucor_var<-esucor$vi ucor_se<-sqrt(ucor_var) #newdataset data.ges<-cbind(data.ges, r_se, zcor, zcor_var, z_se, ucor, ucor_var, ucor_se) data.ges # load unique specification study subsets found via the "Which" factors sets <- as.vector(unique(read.csv2(file = "specifications.csv")$set)) sets <- as.vector(unique(specifications_full$set)) sets <- lapply(strsplit(sets, ","), as.numeric) # Number of specifcations (number of unique study subsets times number of How Factor Combinations) no_spec <- length(sets) * 12 # Number of iterations iter <- 1000 # Matrix to save bootstrapped specification curves res <- matrix(numeric(iter * no_spec), ncol = iter) # Function that takes the ids of studies for each unique specification regarding the included studies (Which factors), # and computes the resulting summary effect for each of the 12 "How factors". spec_list <- function(ids, data) { temp <- data[ids, ] spec <- c(tanh(rma(yi = zcor, sei = z_se, method = "FE", data = temp)$b[[1]]), tanh(rma(yi = zcor, sei = z_se, method = "DL", data = temp)$b[[1]]), tanh(rma(yi = zcor, sei = z_se, method = "REML", control = list(stepadj = 0.5, maxiter = 2000), data = temp)$b[[1]]), tanh(rma(yi = zcor, sei = z_se, method = "FE", weights = 1/nrow(temp), data = temp)$b[[1]]), rma(yi = correlation, sei = r_se, method = "FE", data = temp)$b[[1]], rma(yi = correlation, sei = r_se, method = "DL", data = temp)$b[[1]], rma(yi = correlation, sei = r_se, method = "REML", control = list(stepadj = 0.5, maxiter = 2000), data = temp)$b[[1]], rma(yi = correlation, sei = r_se, method = "FE", weights = 1/nrow(temp), data = temp)$b[[1]], rma(yi = ucor, sei = ucor_se, method = "FE", data = temp)$b[[1]], rma(yi = ucor, sei = ucor_se, method = "DL", data = temp)$b[[1]], rma(yi = ucor, sei = ucor_se, method = "REML", control = list(stepadj = 0.5, maxiter = 2000), data = temp)$b[[1]], rma(yi = ucor, sei = ucor_se, method = "FE", weights = 1/nrow(temp), data = temp)$b[[1]]) spec } # Loop to draw specification curves under the null hypothesis iter times for(j in 1:iter) { # Draw randomly new effect sizes (Fisher's z) from a normal distribution with SE 1/sqrt(N - 3) # and expectation 0 for each study in the data set data.ges$zcor <- rnorm(nrow(data.ges), mean = 0, sd = 1/sqrt(data.ges$N-3)) # Inverse of Fisher's transformation to get correlation coefficient data.ges$correlation <- tanh(data.ges$zcor) # standard error of simulated z data.ges$z_se <- 1/sqrt(data.ges$N-3) # standard error of simulated r data.ges$r_se <- (1 - data.ges$correlation^2)/sqrt(data.ges$N-3) # Store the sorted summary effects for each specification (i.e. the null specification curves) res[, j] <- sort(unlist(lapply(sets, FUN = function(x) spec_list(x, data = data.ges)))) } # Compute the 2.5% and 97.5% quantile of all specification curves for each position as reference boot_lb <- apply(res, 1, function(x) {quantile(x, probs = 0.025)}) boot_ub <- apply(res, 1, function(x) {quantile(x, probs = 0.975)}) # Save bootstrap upper and lower limits together with the observed specification curve boot_data <- data.frame(xvar = 1:no_spec, obs = sort(specifications_full$mean), boot_lb, boot_ub) boot_data write.csv2(file = "bootspec.csv", boot_data) sort(specifications$mean) #boot_data <- data.frame(xvar = 1:no_spec, obs = sort(read.csv2(file = "specifications.csv")$mean), boot_lb, boot_ub) options(max.print=500000) #####################################Code to plot specification curves and the inferental test of the specification library(ggplot2) library(gridExtra) library(ggpubr) plotdata_total <- boot_data p_bootspec_ges <- ggplot(data = plotdata_total, aes(x = xvar, y = obs)) + geom_ribbon(aes(x = xvar, ymin = boot_lb, ymax = boot_ub), fill = "gray", color = "black", lty = "dotted", alpha = 0.7, size = 0.25) + geom_line(col = "firebrick", size = 0.5) + geom_hline(yintercept = 0, linetype = 2, size = 0.25) + scale_x_continuous(name = "Specification Number") + scale_y_continuous(name = "Summary Effect") + ggtitle("Intelligence - Religiosity") + coord_cartesian(xlim = c(0.5, nrow(plotdata_total) + 0.5), expand = FALSE) + theme_bw() + theme(legend.position = "none") ###########################################################FIG 5########################################## ######################################################################################################## p <- arrangeGrob(p_bootspec_ges) p <- as_ggplot(p) p #ggsave("bootspec_plot.png", p, width = 16, height = 22, dpi = 600, units = "cm") ############################ Code to plot the p value distribution of meta-analytic specifications # library(ggplot2) breaks <- seq(from = 0, to = 1, by = 0.05) specifications_full <- read.csv2('specifications.csv') height <- as.numeric(prop.table(table(cut(specifications_full$p, breaks)))) plotdata <- data.frame(height, breaks = breaks[-21] + 0.025) p_R <- ggplot(data = plotdata, aes(x = breaks, y = height)) + geom_bar(stat = "identity", width = 0.05, color="black", fill = "steelblue4") + geom_bar(aes(x = breaks, y = ifelse(breaks < 0.05, height, 0)), col = "black", fill = "firebrick", stat = "identity", width = 0.05) + coord_cartesian(xlim = c(-0.01, 1.01), ylim = c(0, 0.15), expand = F) + theme_bw() + labs(y = "Proportion", x = "Specification p-values") + ggtitle("Histogram of the p Value Distribution") + theme(strip.text.x = element_text(face="bold"), axis.title.x = element_text(color = "white"), strip.background = element_rect(colour=NA, fill=NA), panel.background = element_rect(colour = "black"), plot.margin = margin(t = 5.5, r = 9.5, b = 5.5, l = 5.5, "pt")) #################################################FIG 6################################################# ######################################################################################################## p <- gridExtra::arrangeGrob(p_R, layout_matrix = matrix(1:3, ncol = 3, byrow = T)) p <- ggpubr::as_ggplot(p) p ggsave("p_hist.png", p, width = 16, height = 8, dpi = 600, units = "cm") ##########formal test library(metaSEM) library(foreign) library(stringr) library(truncnorm) library(semPlot) ########################### ## only use data that report correlations with education but no college samples ############################ data.edu #note: "correlation" = Intelligence & religiosity #note: college- sample already omitted ################################################################################################### #intelligence -> education -> religiosity #################################################################################################### #1#Pollet, Schnell (2017) #intelligence-education a<-data.edu$IntelligenceEducation[1] #intelligence-religiosity b<-data.edu$correlation[1] #education-religiosity c<-data.edu$ReligiosityEducation[1] #define rows Intelligenz<-c(1,a,b) Education<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, Education, Religiosity) Pollet<-as.matrix(x) Pollet #2#Furnham, Grover (2020) a<-data.edu$IntelligenceEducation[2] b<-data.edu$correlation[2] c<-data.edu$ReligiosityEducation[2] #define rows Intelligenz<-c(1,a,b) Education<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, Education, Religiosity) Furnham<-as.matrix(x) Furnham #3#Leonard (2018) a<-data.edu$IntelligenceEducation[3] b<-data.edu$correlation[3] c<-data.edu$ReligiosityEducation[3] #define rows Intelligenz<-c(1,a,b) Education<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, Education, Religiosity) Leonard<-as.matrix(x) Leonard #4#(1) Drewelies, Deeg, Huisman, Gerstorf (2018) a<-data.edu$IntelligenceEducation[4] b<-data.edu$correlation[4] c<-data.edu$ReligiosityEducation[4] #define rows Intelligenz<-c(1,a,b) Education<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, Education, Religiosity) Drewelies<-as.matrix(x) Drewelies #5#(1)Pennycook, Cheyne, Seli, Koehler, Fugelsang (2012) a<-data.edu$IntelligenceEducation[5] b<-data.edu$correlation[5] c<-data.edu$ReligiosityEducation[5] #define rows Intelligenz<-c(1,a,b) Education<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, Education, Religiosity) Pennycook<-as.matrix(x) Pennycook #6#Saribay & Yilmaz (2017) a<-data.edu$IntelligenceEducation[6] b<-data.edu$correlation[6] c<-data.edu$ReligiosityEducation[6] #define rows Intelligenz<-c(1,a,b) Education<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, Education, Religiosity) Saribay<-as.matrix(x) Saribay #7#Pennycook, Cheyne, Barr, Koehler, Fugelsang (2014a) a<-data.edu$IntelligenceEducation[7] b<-data.edu$correlation[7] c<-data.edu$ReligiosityEducation[7] #define rows Intelligenz<-c(1,a,b) Education<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, Education, Religiosity) Pennycook2014a<-as.matrix(x) Pennycook2014a #8#Ross (2015) a<-data.edu$IntelligenceEducation[8] b<-data.edu$correlation[8] c<-data.edu$ReligiosityEducation[8] #define rows Intelligenz<-c(1,a,b) Education<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, Education, Religiosity) Ross<-as.matrix(x) Ross #9#Erlandsson, Nilsson, Tingkög, Västfjäll (2018) a<-data.edu$IntelligenceEducation[9] b<-data.edu$correlation[9] c<-data.edu$ReligiosityEducation[9] #define rows Intelligenz<-c(1,a,b) Education<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, Education, Religiosity) Erlandsson<-as.matrix(x) Erlandsson #10#Ståhl, van Prooijen (2018) a<-data.edu$IntelligenceEducation[10] b<-data.edu$correlation[10] c<-data.edu$ReligiosityEducation[10] #define rows Intelligenz<-c(1,a,b) Education<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, Education, Religiosity) Stahl<-as.matrix(x) Stahl #11#Betsch, Aßmann, Glöckner (2020) a<-data.edu$IntelligenceEducation[11] b<-data.edu$correlation[11] c<-data.edu$ReligiosityEducation[11] #define rows Intelligenz<-c(1,a,b) Education<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, Education, Religiosity) Betsch<-as.matrix(x) Betsch #12#(2)Pennycook, Cheyne, Seli, Koehler, Fugelsang (2012) a<-data.edu$IntelligenceEducation[12] b<-data.edu$correlation[12] c<-data.edu$ReligiosityEducation[12] #define rows Intelligenz<-c(1,a,b) Education<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, Education, Religiosity) Pennycook2012<-as.matrix(x) Pennycook2012 #13#Zuckerman, McPhetres (2016) a<-data.edu$IntelligenceEducation[13] b<-data.edu$correlation[13] c<-data.edu$ReligiosityEducation[13] #define rows Intelligenz<-c(1,a,b) Education<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, Education, Religiosity) Zuckerman<-as.matrix(x) Zuckerman #14#(2)Blanchard-Fields et al. (2001) a<-data.edu$IntelligenceEducation[14] b<-data.edu$correlation[14] c<-data.edu$ReligiosityEducation[14] #define rows Intelligenz<-c(1,a,b) Education<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, Education, Religiosity) Blanchard.Fields2<-as.matrix(x) Blanchard.Fields2 #15#(1)Kanazawa (2010) a<-data.edu$IntelligenceEducation[15] b<-data.edu$correlation[15] c<-data.edu$ReligiosityEducation[15] #define rows Intelligenz<-c(1,a,b) Education<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, Education, Religiosity) Kanazawa<-as.matrix(x) Kanazawa #16#(2) Drewelies, Deeg, Huisman, Gerstorf (2018) a<-data.edu$IntelligenceEducation[16] b<-data.edu$correlation[16] c<-data.edu$ReligiosityEducation[16] #define rows Intelligenz<-c(1,a,b) Education<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, Education, Religiosity) Drewelies2<-as.matrix(x) Drewelies2 #17#Ritchie, Gow, Deary (2014) a<-data.edu$IntelligenceEducation[17] b<-data.edu$correlation[17] c<-data.edu$ReligiosityEducation[17] #define rows Intelligenz<-c(1,a,b) Education<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, Education, Religiosity) Ritchie<-as.matrix(x) Ritchie #18#Lewis, Ritchie, Bates (2011) a<-data.edu$IntelligenceEducation[18] b<-data.edu$correlation[18] c<-data.edu$ReligiosityEducation[18] #define rows Intelligenz<-c(1,a,b) Education<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, Education, Religiosity) Lewis<-as.matrix(x) Lewis #19#(2)Kanazawa (2010) a<-data.edu$IntelligenceEducation[19] b<-data.edu$correlation[19] c<-data.edu$ReligiosityEducation[19] #define rows Intelligenz<-c(1,a,b) Education<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, Education, Religiosity) Kanazawa2<-as.matrix(x) Kanazawa2 #20#Ganzach & Gotlibovski (2013) a<-data.edu$IntelligenceEducation[20] b<-data.edu$correlation[20] c<-data.edu$ReligiosityEducation[20] #define rows Intelligenz<-c(1,a,b) Education<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, Education, Religiosity) Ganzach<-as.matrix(x) Ganzach ##################################################################################################### #stage 1 final<-list(Pollet, Furnham, Leonard, Drewelies, Pennycook, Saribay, Pennycook2014a, Ross, Erlandsson, Stahl, Betsch, Pennycook2012, Zuckerman, Blanchard.Fields2, Kanazawa, Drewelies2, Ritchie, Lewis, Kanazawa2, Ganzach) final is.pd(final) final1<-lapply(final, function(x) { dimnames(x)[[1]] <- c("Intelligenz","Education","Religiosity"); x}) ##med1<-tssem1(final, data.edu$N, method = "FEM") med1<-tssem1(final1, data.edu$N, method = "REM",RE.type="Diag") summary(med1) ##plot(med1) coef(med1,"fixed") #stage 2 ####A-matrix # Build matrix A <- matrix(c(0 , 0 , 0, "0.2*IntelligenceEducation", 0 , 0, "0.2*correlation", "0.2*ReligiosityEducation", 0), ncol = 3, nrow=3, byrow=TRUE) # Set column and row labels dimnames(A)[[1]] <- dimnames(A)[[2]] <- c("intelligence", "education", "religiosity") A A <- as.mxMatrix(A) ####S-matrix # Build matrix S <- Diag(c(1,"0.1*ErrVarEdu", "0.1*ErrVarRel")) # Set column and row labels dimnames(S)[[1]] <- dimnames(S)[[2]] <- c("intelligence", "education", "religiosity") S S <- as.mxMatrix(S) ##model fitting med2 <- tssem2(med1, Amatrix = A, Smatrix = S, intervals.type = "LB", diag.constraints = TRUE, mx.algebras=list(indirectEffect = mxAlgebra(IntelligenceEducation*ReligiosityEducation, name="indirectEffect"))) # Rerun med2 <- rerun(med2) labs<-summary(med2, digits=3) #options(digits=3) summary(med2)$coefficients summary(med2) ####plotting the model # Convert to semPlot sem.plot1 <- meta2semPlot(med2) # Create Labels (left to right, bottom to top) labels <- c("intelligence", "education", "religiosity") # Plot semPaths(sem.plot1, whatLabels = "est", edge.color = "black", layout="tree2", rotation=2, nodeLabels = labels, residuals=F,sizeMan=12, edge.label.cex = 1) est1<-sprintf("%.2f",round(labs$coefficients$Estimate,2)) est1 l1<-sprintf("%.2f",round(labs$coefficients$lbound,2)) l1 u1<-sprintf("%.2f",round(labs$coefficients$ubound,2)) u1 labs$coefficients$Estimate labs strings<-paste0(est1[1]," [",l1[1],", ",u1[1],"]") strings1<-paste0(est1[2]," [",l1[2],", ",u1[2],"]") strings2<-paste0(est1[3]," [",l1[3],", ",u1[3],"]") coef(med1,"fixed") #strings0<-paste0(est1[3]," [",l1[3],", ",u1[3],"]") semPaths(sem.plot1, whatLabels = "est", edge.color = "black", layout="tree2", rotation=2, nodeLabels = labels, residuals=F,sizeMan=12, edgeLabels=c(strings,strings2,strings1), nDigits=2, edge.label.cex = 1) text(-0.5,1.25,"Panel A: intelligence and religiosity as mediated by education") # groups="intelligence and religiosity as mediated by education") semPaths(sem.plot1, whatLabels = "est", edge.color = "black", layout="tree2", rotation=2, nodeLabels = labels, residuals=F,sizeMan=12, edgeLabels=c(strings,strings2,strings1), nDigits=2, edge.label.cex = 1) panelA ################################################################################################### #education -> intelligence -> religiosity #################################################################################################### #1#Pollet, Schnell (2017) a<-data.edu$IntelligenceEducation[1] b<-data.edu$correlation[1] c<-data.edu$ReligiosityEducation[1] #define rows Education<-c(1,a,c) Intelligence<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(Education, Intelligence, Religiosity) Pollet<-as.matrix(x) Pollet #2#Furnham, Grover (2020) a<-data.edu$IntelligenceEducation[2] b<-data.edu$correlation[2] c<-data.edu$ReligiosityEducation[2] #define rows Education<-c(1,a,c) Intelligence<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(Education, Intelligence, Religiosity) Furnham<-as.matrix(x) Furnham #3#Leonard (2018) a<-data.edu$IntelligenceEducation[3] b<-data.edu$correlation[3] c<-data.edu$ReligiosityEducation[3] #define rows Education<-c(1,a,c) Intelligence<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(Education, Intelligence, Religiosity) Leonard<-as.matrix(x) Leonard #4#(1) Drewelies, Deeg, Huisman, Gerstorf (2018) a<-data.edu$IntelligenceEducation[4] b<-data.edu$correlation[4] c<-data.edu$ReligiosityEducation[4] #define rows Education<-c(1,a,c) Intelligence<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(Education, Intelligence, Religiosity) Drewelies<-as.matrix(x) Drewelies #5#(1)Pennycook, Cheyne, Seli, Koehler, Fugelsang (2012) a<-data.edu$IntelligenceEducation[5] b<-data.edu$correlation[5] c<-data.edu$ReligiosityEducation[5] #define rows Education<-c(1,a,c) Intelligence<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(Education, Intelligence, Religiosity) Pennycook<-as.matrix(x) Pennycook #6#Saribay & Yilmaz (2017) a<-data.edu$IntelligenceEducation[6] b<-data.edu$correlation[6] c<-data.edu$ReligiosityEducation[6] #define rows Education<-c(1,a,c) Intelligence<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(Education, Intelligence, Religiosity) Saribay<-as.matrix(x) Saribay #7#Pennycook, Cheyne, Barr, Koehler, Fugelsang (2014a) a<-data.edu$IntelligenceEducation[7] b<-data.edu$correlation[7] c<-data.edu$ReligiosityEducation[7] #define rows Education<-c(1,a,c) Intelligence<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(Education, Intelligence, Religiosity) Pennycook2014a<-as.matrix(x) Pennycook2014a #8#Ross (2015) a<-data.edu$IntelligenceEducation[8] b<-data.edu$correlation[8] c<-data.edu$ReligiosityEducation[8] #define rows Education<-c(1,a,c) Intelligence<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(Education, Intelligence, Religiosity) Ross<-as.matrix(x) Ross #9#Erlandsson, Nilsson, Tingkög, Västfjäll (2018) a<-data.edu$IntelligenceEducation[9] b<-data.edu$correlation[9] c<-data.edu$ReligiosityEducation[9] #define rows Education<-c(1,a,c) Intelligence<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(Education, Intelligence, Religiosity) Erlandsson<-as.matrix(x) Erlandsson #10#Ståhl, van Prooijen (2018) a<-data.edu$IntelligenceEducation[10] b<-data.edu$correlation[10] c<-data.edu$ReligiosityEducation[10] #define rows Education<-c(1,a,c) Intelligence<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(Education, Intelligence, Religiosity) Stahl<-as.matrix(x) Stahl #11#Betsch, Aßmann, Glöckner (2020) a<-data.edu$IntelligenceEducation[11] b<-data.edu$correlation[11] c<-data.edu$ReligiosityEducation[11] #define rows Education<-c(1,a,c) Intelligence<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(Education, Intelligence, Religiosity) Betsch<-as.matrix(x) Betsch #12#(2)Pennycook, Cheyne, Seli, Koehler, Fugelsang (2012) a<-data.edu$IntelligenceEducation[12] b<-data.edu$correlation[12] c<-data.edu$ReligiosityEducation[12] #define rows Education<-c(1,a,c) Intelligence<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(Education, Intelligence, Religiosity) Pennycook2012<-as.matrix(x) Pennycook2012 #13#Zuckerman, McPhetres (2016) a<-data.edu$IntelligenceEducation[13] b<-data.edu$correlation[13] c<-data.edu$ReligiosityEducation[13] #define rows Education<-c(1,a,c) Intelligence<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(Education, Intelligence, Religiosity) Zuckerman<-as.matrix(x) Zuckerman #14#(2)Blanchard-Fields et al. (2001) a<-data.edu$IntelligenceEducation[14] b<-data.edu$correlation[14] c<-data.edu$ReligiosityEducation[14] #define rows Education<-c(1,a,c) Intelligence<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(Education, Intelligence, Religiosity) Blanchard.Fields2<-as.matrix(x) Blanchard.Fields2 #15#(1)Kanazawa (2010) a<-data.edu$IntelligenceEducation[15] b<-data.edu$correlation[15] c<-data.edu$ReligiosityEducation[15] #define rows Education<-c(1,a,c) Intelligence<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(Education, Intelligence, Religiosity) Kanazawa<-as.matrix(x) Kanazawa #16#(2) Drewelies, Deeg, Huisman, Gerstorf (2018) a<-data.edu$IntelligenceEducation[16] b<-data.edu$correlation[16] c<-data.edu$ReligiosityEducation[16] #define rows Education<-c(1,a,c) Intelligence<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(Education, Intelligence, Religiosity) Drewelies2<-as.matrix(x) Drewelies2 #17#Ritchie, Gow, Deary (2014) a<-data.edu$IntelligenceEducation[17] b<-data.edu$correlation[17] c<-data.edu$ReligiosityEducation[17] #define rows Education<-c(1,a,c) Intelligence<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(Education, Intelligence, Religiosity) Ritchie<-as.matrix(x) Ritchie #18#Lewis, Ritchie, Bates (2011) a<-data.edu$IntelligenceEducation[18] b<-data.edu$correlation[18] c<-data.edu$ReligiosityEducation[18] #define rows Education<-c(1,a,c) Intelligence<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(Education, Intelligence, Religiosity) Lewis<-as.matrix(x) Lewis #19#(2)Kanazawa (2010) a<-data.edu$IntelligenceEducation[19] b<-data.edu$correlation[19] c<-data.edu$ReligiosityEducation[19] #define rows Education<-c(1,a,c) Intelligence<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(Education, Intelligence, Religiosity) Kanazawa2<-as.matrix(x) Kanazawa2 #20#Ganzach & Gotlibovski (2013) a<-data.edu$IntelligenceEducation[20] b<-data.edu$correlation[20] c<-data.edu$ReligiosityEducation[20] #define rows Education<-c(1,a,c) Intelligence<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(Education, Intelligence, Religiosity) Ganzach<-as.matrix(x) Ganzach ##################################################################################################### #stage 1 final<-list(Pollet, Furnham, Leonard, Drewelies, Pennycook, Saribay, Pennycook2014a, Ross, Erlandsson, Stahl, Betsch, Pennycook2012, Zuckerman, Blanchard.Fields2, Kanazawa, Drewelies2, Ritchie, Lewis, Kanazawa2, Ganzach) final is.pd(final) final1<-lapply(final, function(x) { dimnames(x)[[1]] <- c("Education","Intelligence","Religiosity"); x}) ##med1<-tssem1(final, data.edu$N, method = "FEM") med1<-tssem1(final1, data.edu$N, method = "REM",RE.type="Diag") summary(med1) #stage 2 ##A-matrix # Build matrix A <- matrix(c( 0 , 0 , 0, "0.2*IntelligenceEducation", 0 , 0, "0.2*ReligiosityEducation", "0.2*correlation", 0), ncol = 3, nrow=3, byrow=TRUE) # Set column and row labels dimnames(A)[[1]] <- dimnames(A)[[2]] <- c( "education","intelligence", "religiosity") A A <- as.mxMatrix(A) ############S-matrix # Build matrix S <- Diag(c(1,"0.1*ErrVarInt", "0.1*ErrVarRel")) # Set column and row labels dimnames(S)[[1]] <- dimnames(S)[[2]] <- c("education", "intelligence", "religiosity") S S <- as.mxMatrix(S) ##model fitting med2 <- tssem2(med1, Amatrix = A, Smatrix = S, intervals.type = "LB", diag.constraints = TRUE, mx.algebras=list(indirectEffect = mxAlgebra(IntelligenceEducation*correlation, name="indirectEffect"))) #help(mxAlgebra) # Rerun med2 <- rerun(med2) summary(med2) labs<-summary(med2, digits=3) ####plotting the model # Convert to semPlot sem.plot2 <- meta2semPlot(med2) # Create Labels (left to right, bottom to top) labels <- c("education", "intelligence", "religiosity") # Plot semPaths(sem.plot2, whatLabels = "est", edge.color = "black", layout="tree2", rotation=2, nodeLabels = labels, residuals=F,sizeMan=12, edge.label.cex = 1) est2<-sprintf("%.2f",round(labs$coefficients$Estimate,2)) est2 l2<-sprintf("%.2f",round(labs$coefficients$lbound,2)) l2 u2<-sprintf("%.2f",round(labs$coefficients$ubound,2)) u2 labs$coefficients$Estimate labs strings.2<-paste0(est2[1]," [",l2[1],", ",u2[1],"]") strings1.2<-paste0(est2[3]," [",l2[3],", ",u2[3],"]") strings2.2<-paste0(est2[2]," [",l2[2],", ",u2[2],"]") coef(med1,"fixed") #strings0<-paste0(est1[3]," [",l1[3],", ",u1[3],"]") semPaths(sem.plot2, whatLabels = "est", edge.color = "black", layout="tree2", rotation=2, nodeLabels = labels, residuals=F,sizeMan=12, edgeLabels=c(strings.2,strings2.2,strings1.2), nDigits=2, edge.label.cex = 1) text(-0.5,1.25,"Panel B: Intelligence and religiosity as mediated by education") # groups="intelligence and religiosity as mediated by education") # Plot semPaths(sem.plot2, whatLabels = "est", edge.color = "black", layout="tree2", rotation=2, nodeLabels = labels) ##########formal test library(metaSEM) library(foreign) library(semPlot) #note: "correlation" = Intelligence & religiosity ################################################################################################### #intelligence -> analytic style -> religiosity #################################################################################################### ## only use data that report associations with cognitive style ################## #1#Ross (2015) #intelligence - analytic style a<-data.cs$ASI[1] #intelligence-religiosity b<-data.cs$correlation[1] #analytic style - religiosity c<-data.cs$ASREL[1] #define rows Intelligenz<-c(1,a,b) AnalyticStyle<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, AnalyticStyle, Religiosity) Ross<-as.matrix(x) Ross #2#Zuckerman, McPhetres (2016) a<-data.cs$ASI[2] b<-data.cs$correlation[2] c<-data.cs$ASREL[2] #define rows Intelligenz<-c(1,a,b) AnalyticStyle<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, AnalyticStyle, Religiosity) Zuckerman<-as.matrix(x) Zuckerman #3#(1) Strimaitis (2018) a<-data.cs$ASI[3] b<-data.cs$correlation[3] c<-data.cs$ASREL[3] #define rows Intelligenz<-c(1,a,b) AnalyticStyle<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, AnalyticStyle, Religiosity) Strimaitis1<-as.matrix(x) Strimaitis1 #4#(2) Strimaitis (2018) a<-data.cs$ASI[4] b<-data.cs$correlation[4] c<-data.cs$ASREL[4] #define rows Intelligenz<-c(1,a,b) AnalyticStyle<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, AnalyticStyle, Religiosity) Strimaitis2<-as.matrix(x) Strimaitis2 #5#Leonard (2018) a<-data.cs$ASI[5] b<-data.cs$correlation[5] c<-data.cs$ASREL[5] #define rows Intelligenz<-c(1,a,b) AnalyticStyle<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, AnalyticStyle, Religiosity) Leonard<-as.matrix(x) Leonard #6#Shenav, Rand, Greene (2011) a<-data.cs$ASI[6] b<-data.cs$correlation[6] c<-data.cs$ASREL[6] #define rows Intelligenz<-c(1,a,b) AnalyticStyle<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, AnalyticStyle, Religiosity) Shenav<-as.matrix(x) Shenav #7#(1)Pennycook, Cheyne, Seli, Koehler, Fugelsang (2012) a<-data.cs$ASI[7] b<-data.cs$correlation[7] c<-data.cs$ASREL[7] #define rows Intelligenz<-c(1,a,b) AnalyticStyle<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, AnalyticStyle, Religiosity) Pennycook2012.1<-as.matrix(x) Pennycook2012.1 #8#(2)Pennycook, Cheyne, Seli, Koehler, Fugelsang (2012) a<-data.cs$ASI[8] b<-data.cs$correlation[8] c<-data.cs$ASREL[8] #define rows Intelligenz<-c(1,a,b) AnalyticStyle<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, AnalyticStyle, Religiosity) Pennycook2012.2<-as.matrix(x) Pennycook2012.2 #9#Razmyar & Reeve (2013) a<-data.cs$ASI[9] b<-data.cs$correlation[9] c<-data.cs$ASREL[9] #define rows Intelligenz<-c(1,a,b) AnalyticStyle<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, AnalyticStyle, Religiosity) Razmyar<-as.matrix(x) Razmyar #10#Pennycook Cheyne, Koehler, Fugelsang (2013) a<-data.cs$ASI[10] b<-data.cs$correlation[10] c<-data.cs$ASREL[10] #define rows Intelligenz<-c(1,a,b) AnalyticStyle<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, AnalyticStyle, Religiosity) Pennycook2013<-as.matrix(x) Pennycook2013 #11#Pennycook, Cheyne, Barr, Koehler, Fugelsang (2014a) a<-data.cs$ASI[11] b<-data.cs$correlation[11] c<-data.cs$ASREL[11] #define rows Intelligenz<-c(1,a,b) AnalyticStyle<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, AnalyticStyle, Religiosity) Pennycook2014a<-as.matrix(x) Pennycook2014a #12#Pennycook, Cheyne, Barr, Koehler, Fugelsang (2014b) a<-data.cs$ASI[12] b<-data.cs$correlation[12] c<-data.cs$ASREL[12] #define rows Intelligenz<-c(1,a,b) AnalyticStyle<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, AnalyticStyle, Religiosity) Pennycook2014b<-as.matrix(x) Pennycook2014b #13#Pennycook, Ross, Koehler, Fugelsang (2016) a<-data.cs$ASI[13] b<-data.cs$correlation[13] c<-data.cs$ASREL[13] #define rows Intelligenz<-c(1,a,b) AnalyticStyle<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, AnalyticStyle, Religiosity) Pennycook2016<-as.matrix(x) Pennycook2016 #14#Saribay & Yilmaz (2017) a<-data.cs$ASI[14] b<-data.cs$correlation[14] c<-data.cs$ASREL[14] #define rows Intelligenz<-c(1,a,b) AnalyticStyle<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, AnalyticStyle, Religiosity) Saribay<-as.matrix(x) Saribay #15#Hartman et al. (2017) a<-data.cs$ASI[15] b<-data.cs$correlation[15] c<-data.cs$ASREL[15] #define rows Intelligenz<-c(1,a,b) AnalyticStyle<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, AnalyticStyle, Religiosity) Hartman<-as.matrix(x) Hartman #16#Erlandsson, Nilsson, Tingkög, Västfjäll (2018) a<-data.cs$ASI[16] b<-data.cs$correlation[16] c<-data.cs$ASREL[16] #define rows Intelligenz<-c(1,a,b) AnalyticStyle<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, AnalyticStyle, Religiosity) Erlandsson<-as.matrix(x) Erlandsson #17#Ståhl, van Prooijen (2018) a<-data.cs$ASI[17] b<-data.cs$correlation[17] c<-data.cs$ASREL[17] #define rows Intelligenz<-c(1,a,b) AnalyticStyle<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, AnalyticStyle, Religiosity) Stahl<-as.matrix(x) Stahl #18#Cavojová, Secara, Jurkovic, Srol (2019) a<-data.cs$ASI[18] b<-data.cs$correlation[18] c<-data.cs$ASREL[18] #define rows Intelligenz<-c(1,a,b) AnalyticStyle<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, AnalyticStyle, Religiosity) Cavojova<-as.matrix(x) Cavojova #19#Nilsson, Erlandsson, Västtjfäll (2019) a<-data.cs$ASI[19] b<-data.cs$correlation[19] c<-data.cs$ASREL[19] #define rows Intelligenz<-c(1,a,b) AnalyticStyle<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, AnalyticStyle, Religiosity) Nilsson<-as.matrix(x) Nilsson #20#(1) Patel, Baker, Scherer (2019) a<-data.cs$ASI[20] b<-data.cs$correlation[20] c<-data.cs$ASREL[20] #define rows Intelligenz<-c(1,a,b) AnalyticStyle<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, AnalyticStyle, Religiosity) Patel1<-as.matrix(x) Patel1 #21#(2) Patel, Baker, Scherer (2019) a<-data.cs$ASI[21] b<-data.cs$correlation[21] c<-data.cs$ASREL[21] #define rows Intelligenz<-c(1,a,b) AnalyticStyle<-c(a,1,c) Religiosity<-c(b,c,1) x<-data.frame(Intelligenz, AnalyticStyle, Religiosity) Patel2<-as.matrix(x) Patel2 ##################################################################################################### #stage 1 final<-list(Ross, Zuckerman, Strimaitis1, Strimaitis2, Leonard, Shenav, Pennycook2012.1, Pennycook2012.2, Razmyar, Pennycook2013, Pennycook2014a, Pennycook2014b, Pennycook2016, Saribay, Hartman, Erlandsson, Stahl, Cavojova, Nilsson, Patel1, Patel2) final is.pd(final) final1<-lapply(final, function(x) { dimnames(x)[[1]] <- c("Intelligenz","AnalyticStyle","Religiosity"); x}) ##med1<-tssem1(final, data.cs$N, method = "FEM") ##summary(med1) med1<-tssem1(final1, data.cs$N, method = "REM",RE.type="Diag") summary(med1) #stage 2 ##A-matrix # Build matrix A <- matrix(c(0 , 0 , 0, "0.2*IntelligenceAS", 0 , 0, "0.2*correlation", "0.2*ReligiosityAS", 0), ncol = 3, nrow=3, byrow=TRUE) # Set column and row labels dimnames(A)[[1]] <- dimnames(A)[[2]] <- c("intelligence", "analytic style", "religiosity") A A <- as.mxMatrix(A) ############S-matrix # Build matrix S <- Diag(c(1,"0.1*ErrVarAS", "0.1*ErrVarRel")) # Set column and row labels dimnames(S)[[1]] <- dimnames(S)[[2]] <- c("intelligence", "analytic style", "religiosity") S S <- as.mxMatrix(S) ##model fitting med2 <- tssem2(med1, Amatrix = A, Smatrix = S, intervals.type = "LB", diag.constraints = TRUE, mx.algebras=list(indirectEffect = mxAlgebra(IntelligenceAS*ReligiosityAS, name="indirectEffect"))) # Rerun med2 <- rerun(med2) summary(med2) labs<-summary(med2, digits=3) ####plotting the model # Convert to semPlot sem.plot2 <- meta2semPlot(med2) # Create Labels (left to right, bottom to top) labels <- c("intelligence", "cognitive style", "religiosity") # Plot semPaths(sem.plot2, whatLabels = "est", edge.color = "black", layout="tree2", rotation=2, nodeLabels = labels) est3<-sprintf("%.2f",round(labs$coefficients$Estimate,2)) est3 l3<-sprintf("%.2f",round(labs$coefficients$lbound,2)) l3 u3<-sprintf("%.2f",round(labs$coefficients$ubound,2)) u3 labs$coefficients$Estimate labs strings.3<-paste0(est3[1]," [",l3[1],", ",u3[1],"]") strings1.3<-paste0(est3[2]," [",l3[2],", ",u3[2],"]") strings2.3<-paste0(est3[3]," [",l3[3],", ",u3[3],"]") coef(med1,"fixed") #strings0<-paste0(est1[3]," [",l1[3],", ",u1[3],"]") semPaths(sem.plot2, whatLabels = "est", edge.color = "black", layout="tree2", rotation=2, nodeLabels = labels, residuals=F,sizeMan=12, edgeLabels=c(strings.3,strings2.3,strings1.3), nDigits=2, edge.label.cex = 1) text(-0.5,1.25,"Panel C: intelligence and religiosity as mediated by cognitive style") # groups="intelligence and religiosity as mediated by education") ################################################################################################### # analytic style -> intelligence -> religiosity #################################################################################################### #1#Ross (2015) #intelligence - analytic style a<-data.cs$ASI[1] #intelligence-religiosity b<-data.cs$correlation[1] #analytic style - religiosity c<-data.cs$ASREL[1] #define rows AnalyticStyle<-c(1,a,c) Intelligenz<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(AnalyticStyle, Intelligenz, Religiosity) Ross<-as.matrix(x) Ross #2#Zuckerman, McPhetres (2016) a<-data.cs$ASI[2] b<-data.cs$correlation[2] c<-data.cs$ASREL[2] #define rows AnalyticStyle<-c(1,a,c) Intelligenz<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(AnalyticStyle, Intelligenz, Religiosity) Zuckerman<-as.matrix(x) Zuckerman #3#(1) Strimaitis (2018) a<-data.cs$ASI[3] b<-data.cs$correlation[3] c<-data.cs$ASREL[3] #define rows AnalyticStyle<-c(1,a,c) Intelligenz<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(AnalyticStyle, Intelligenz, Religiosity) Strimaitis1<-as.matrix(x) Strimaitis1 #4#(2) Strimaitis (2018) a<-data.cs$ASI[4] b<-data.cs$correlation[4] c<-data.cs$ASREL[4] #define rows AnalyticStyle<-c(1,a,c) Intelligenz<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(AnalyticStyle, Intelligenz, Religiosity) Strimaitis2<-as.matrix(x) Strimaitis2 #5#Leonard (2018) a<-data.cs$ASI[5] b<-data.cs$correlation[5] c<-data.cs$ASREL[5] #define rows AnalyticStyle<-c(1,a,c) Intelligenz<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(AnalyticStyle, Intelligenz, Religiosity) Leonard<-as.matrix(x) Leonard #6#Shenav, Rand, Greene (2011) a<-data.cs$ASI[6] b<-data.cs$correlation[6] c<-data.cs$ASREL[6] #define rows AnalyticStyle<-c(1,a,c) Intelligenz<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(AnalyticStyle, Intelligenz, Religiosity) Shenav<-as.matrix(x) Shenav #7#(1)Pennycook, Cheyne, Seli, Koehler, Fugelsang (2012) a<-data.cs$ASI[7] b<-data.cs$correlation[7] c<-data.cs$ASREL[7] #define rows AnalyticStyle<-c(1,a,c) Intelligenz<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(AnalyticStyle, Intelligenz, Religiosity) Pennycook2012.1<-as.matrix(x) Pennycook2012.1 #8#(2)Pennycook, Cheyne, Seli, Koehler, Fugelsang (2012) a<-data.cs$ASI[8] b<-data.cs$correlation[8] c<-data.cs$ASREL[8] #define rows AnalyticStyle<-c(1,a,c) Intelligenz<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(AnalyticStyle, Intelligenz, Religiosity) Pennycook2012.2<-as.matrix(x) Pennycook2012.2 #9#Razmyar & Reeve (2013) a<-data.cs$ASI[9] b<-data.cs$correlation[9] c<-data.cs$ASREL[9] #2define rows AnalyticStyle<-c(1,a,c) Intelligenz<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(AnalyticStyle, Intelligenz, Religiosity) Razmyar<-as.matrix(x) Razmyar #10#Pennycook Cheyne, Koehler, Fugelsang (2013) a<-data.cs$ASI[10] b<-data.cs$correlation[10] c<-data.cs$ASREL[10] #define rows AnalyticStyle<-c(1,a,c) Intelligenz<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(AnalyticStyle, Intelligenz, Religiosity) Pennycook2013<-as.matrix(x) Pennycook2013 #11#Pennycook, Cheyne, Barr, Koehler, Fugelsang (2014a) a<-data.cs$ASI[11] b<-data.cs$correlation[11] c<-data.cs$ASREL[11] #define rows AnalyticStyle<-c(1,a,c) Intelligenz<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(AnalyticStyle, Intelligenz, Religiosity) Pennycook2014a<-as.matrix(x) Pennycook2014a #12#Pennycook, Cheyne, Barr, Koehler, Fugelsang (2014b) a<-data.cs$ASI[12] b<-data.cs$correlation[12] c<-data.cs$ASREL[12] #define rows AnalyticStyle<-c(1,a,c) Intelligenz<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(AnalyticStyle, Intelligenz, Religiosity) Pennycook2014b<-as.matrix(x) Pennycook2014b #13#Pennycook, Ross, Koehler, Fugelsang (2016) a<-data.cs$ASI[13] b<-data.cs$correlation[13] c<-data.cs$ASREL[13] #define rows AnalyticStyle<-c(1,a,c) Intelligenz<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(AnalyticStyle, Intelligenz, Religiosity) Pennycook2016<-as.matrix(x) Pennycook2016 #14#Saribay & Yilmaz (2017) a<-data.cs$ASI[14] b<-data.cs$correlation[14] c<-data.cs$ASREL[14] #define rows AnalyticStyle<-c(1,a,c) Intelligenz<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(AnalyticStyle, Intelligenz, Religiosity) Saribay<-as.matrix(x) Saribay #15#Hartman et al. (2017) a<-data.cs$ASI[15] b<-data.cs$correlation[15] c<-data.cs$ASREL[15] #define rows AnalyticStyle<-c(1,a,c) Intelligenz<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(AnalyticStyle, Intelligenz, Religiosity) Hartman<-as.matrix(x) Hartman #16#Erlandsson, Nilsson, Tingkög, Västfjäll (2018) a<-data.cs$ASI[16] b<-data.cs$correlation[16] c<-data.cs$ASREL[16] #define rows AnalyticStyle<-c(1,a,c) Intelligenz<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(AnalyticStyle, Intelligenz, Religiosity) Erlandsson<-as.matrix(x) Erlandsson #17#Ståhl, van Prooijen (2018) a<-data.cs$ASI[17] b<-data.cs$correlation[17] c<-data.cs$ASREL[17] #define rows AnalyticStyle<-c(1,a,c) Intelligenz<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(AnalyticStyle, Intelligenz, Religiosity) Stahl<-as.matrix(x) Stahl #18#Cavojová, Secara, Jurkovic, Srol (2019) a<-data.cs$ASI[18] b<-data.cs$correlation[18] c<-data.cs$ASREL[18] #define rows AnalyticStyle<-c(1,a,c) Intelligenz<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(AnalyticStyle, Intelligenz, Religiosity) Cavojova<-as.matrix(x) Cavojova #19#Nilsson, Erlandsson, Västtjfäll (2019) a<-data.cs$ASI[19] b<-data.cs$correlation[19] c<-data.cs$ASREL[19] #define rows AnalyticStyle<-c(1,a,c) Intelligenz<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(AnalyticStyle, Intelligenz, Religiosity) Nilsson<-as.matrix(x) Nilsson #20#(1) Patel, Baker, Scherer (2019) a<-data.cs$ASI[20] b<-data.cs$correlation[20] c<-data.cs$ASREL[20] #define rows AnalyticStyle<-c(1,a,c) Intelligenz<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(AnalyticStyle, Intelligenz, Religiosity) Patel1<-as.matrix(x) Patel1 #21#(2) Patel, Baker, Scherer (2019) a<-data.cs$ASI[21] b<-data.cs$correlation[21] c<-data.cs$ASREL[21] #define rows AnalyticStyle<-c(1,a,c) Intelligenz<-c(a,1,b) Religiosity<-c(c,b,1) x<-data.frame(AnalyticStyle, Intelligenz, Religiosity) Patel2<-as.matrix(x) Patel2 ##################################################################################################### #stage 1 final<-list(Ross, Zuckerman, Strimaitis1, Strimaitis2, Leonard, Shenav, Pennycook2012.1, Pennycook2012.2, Razmyar, Pennycook2013, Pennycook2014a, Pennycook2014b, Pennycook2016, Saribay, Hartman, Erlandsson, Stahl, Cavojova, Nilsson, Patel1, Patel2) final is.pd(final) final1<-lapply(final, function(x) { dimnames(x)[[1]] <- c("AnalyticStyle","Intelligenz","Religiosity"); x}) ##med1<-tssem1(final, data.cs$N, method = "FEM") ##summary(med1) med1<-tssem1(final1, data.cs$N, method = "REM",RE.type="Diag") summary(med1) #stage 2 ##A-matrix # Build matrix A <- matrix(c(0 , 0 , 0, "0.2*IntelligenceAS", 0 , 0, "0.2*ReligiosityAS", "0.2*correlation", 0), ncol = 3, nrow=3, byrow=TRUE) # Set column and row labels dimnames(A)[[1]] <- dimnames(A)[[2]] <- c("analytic style","intelligence", "religiosity") A A <- as.mxMatrix(A) ############S-matrix # Build matrix S <- Diag(c(1,"0.1*ErrVarInt", "0.1*ErrVarRel")) # Set column and row labels dimnames(S)[[1]] <- dimnames(S)[[2]] <- c("analytic style", "intelligence", "religiosity") S S <- as.mxMatrix(S) ##model fitting med2 <- tssem2(med1, Amatrix = A, Smatrix = S, intervals.type = "LB", diag.constraints = TRUE, mx.algebras=list(indirectEffect = mxAlgebra(IntelligenceAS*correlation, name="indirectEffect"))) # Rerun med2 <- rerun(med2) summary(med2) labs<-summary(med2, digits=3) ####plotting the model # Convert to semPlot sem.plot3 <- meta2semPlot(med2) # Create Labels (left to right, bottom to top) labels <- c("cognitive style", "intelligence", "religiosity") # Plot semPaths(sem.plot3, whatLabels = "est", edge.color = "black", layout="tree2", rotation=2, nodeLabels = labels) est4<-sprintf("%.2f",round(labs$coefficients$Estimate,2)) est4 l4<-sprintf("%.2f",round(labs$coefficients$lbound,2)) l4 u4<-sprintf("%.2f",round(labs$coefficients$ubound,2)) u4 labs$coefficients$Estimate labs strings.4<-paste0(est4[1]," [",l4[1],", ",u4[1],"]") strings1.4<-paste0(est4[3]," [",l4[3],", ",u4[3],"]") strings2.4<-paste0(est4[2]," [",l4[2],", ",u4[2],"]") coef(med1,"fixed") #strings0<-paste0(est1[3]," [",l1[3],", ",u1[3],"]") semPaths(sem.plot3, whatLabels = "est", edge.color = "black", layout="tree2", rotation=2, nodeLabels = labels, residuals=F,sizeMan=12, edgeLabels=c(strings.4,strings2.4,strings1.4), nDigits=2, edge.label.cex = 1) text(-0.5,1.25,"Panel D: cognitive style and religiosity as mediated by intelligence") # groups="intelligence and religiosity as mediated by education")