rm(list = ls()) library(metafor) library(ape) library(Matrix) metarep<-read.csv('ReproductionMarch.csv',na.strings="NA") ## str(metarep) #checking outliers #metarep<-metarep [-c( 71), ] ##keep outliers #metarep<-metarep [-c(25, 57, 71), ] # Importing modified tree, transfrom to .tre file and Contstructing tree matrix library(ape) treeRep<-read.tree(file="phylipReproOrgOct.phy") write.tree(treeRep, file="MyNewickRep.tre") treeRepmod<-read.tree(file="MyNewickRep.tre") treeRepmod plot(treeRepmod, cex=1) is.binary.tree(treeRepmod) #importing modified tree from mesquite RepTree<-read.tree(file="MyNewickRepOct.tre.phy") write.tree(RepTree, file="RepTreeM.tre") RepTreeM<-read.tree(file="RepTreeM.tre") RepTreeM plot(RepTreeM) is.binary.tree(RepTreeM) ###CREATING CORRELATION MATRIX### # getting a phylogenetic correlation matrix ready CorMatrix<-vcv(compute.brlen(RepTreeM),corr=T) CorMatrix # the same CorMatrix1<-vcv(corBrownian(1,compute.brlen(RepTreeM)),corr=T) CorMatrix1 # expanding the matrix to match the dataframe # animal = Spp CorExt<-as.matrix(CorMatrix[match(metarep$Animal,rownames(CorMatrix)),match(metarep$Animal, colnames(CorMatrix))]) CorExt # create square matrix matching N of ES, filled with zeros V <- matrix(0,nrow = dim(metarep)[1],ncol = dim(metarep)[1]) rownames(V) <- metarep$ES_ID colnames(V) <- metarep$ES_ID # find start and end coordinates for the subsets shared_coord <- which(metarep$Share_Control%in%metarep$Share_Control[duplicated(metarep$Share_Control)]==TRUE) shared_coord # matrix of combinations of coordinates for each experiment with shared control combinations <- do.call("rbind", tapply(shared_coord, metarep[shared_coord,"Share_Control"], function(x) t(combn(x,2)))) combinations # calculate covariance values between Hd values at the positions in shared_list and place them on the matrix for (i in 1:dim(combinations)[1]){ p1 <- combinations[i,1] p2 <- combinations[i,2] p1_p2_cov <- 1/metarep[p1,"n2Control"] + (metarep[p1,"hedges_g"]*metarep[p2,"hedges_g"]) / (2*(metarep[p1,"n1Infect"]+metarep[p1,"n2Control"])) V[p1,p2] <- p1_p2_cov V[p2,p1] <- p1_p2_cov } # add the diagonal - use df$Vg as matrix diagonal diag(V) <- metarep$Vg V[35:52,35:52] #********************************************************************* #TESTING RANDOM MODELS, PHYLOGENY VS. NON-PYHOGENY MODEL, estimations #********************************************************************** # MODEL 1 - phylogenetic model phyl<-rma.mv(yi=hedges_g,V=V,random = list (~ 1|IDstudy, ~1|Animal, ~1|focalID, ~1|ES_ID), R=list(Animal=CorExt), data=metarep, method="REML") summary(phyl) # MODEL 2 - non-phylogenetic model nonphyl<-rma.mv(yi=hedges_g,V=V,random = list (~ 1|IDstudy, ~1|focalID, ~1|ES_ID), data=metarep, method="REML") summary(nonphyl) # ML MODEL 1 - phylogenetic model phylML<-rma.mv(yi=hedges_g,V=V,random = list (~ 1|IDstudy, ~1|Animal, ~1|focalID, ~1|ES_ID), R=list(Animal=CorExt), data=metarep, method="ML") summary(phylML) # ML MODEL 2 - non-phylogenetic model nonphylML<-rma.mv(yi=hedges_g,V=V,random = list (~ 1|IDstudy, ~1|focalID, ~1|ES_ID), data=metarep, method="ML") summary(nonphylML) #plot funnel funnel(phyl) funnel(nonphyl) # MODEL 1, PHYLOGENY - for this we get H2 which equals to lambda s2m <- sum(1/metarep$Vg) * (phyl$k-1) / (sum(1/metarep$Vg)^2 - sum((1/metarep$Vg)^2)) # This gives "Measurement variance" - formula 11 in Nakagawa et al. 2012 s2m # typical sampling error # total variance s2t<-sum(phyl$sigma2)+s2m s2t I2t<-sum(phyl$sigma2)/s2t I2t*100 # 71.27437% - total heterogeneity I2s<-phyl$sigma2[1]/s2t I2s*100 # 51.5699% variance due to unique study ID I2a<-phyl$sigma2[2]/s2t I2a*100 # 1.625937e-07% due to phylogeny I2g<-phyl$sigma2[3]/s2t I2g*100 # 1.407842e-08% variance due to common focal individual (group same) I2e<-phyl$sigma2[4]/s2t I2e*100 # 19.70447% residual against sampling error (i.e. effect-size or observation-specific variance) H2 <-phyl$sigma2[2]/sum(phyl$sigma2) H2 # Pagel's lambda to describe phylogenetic signal (2.281237e-09) - close to zero. # MODEL 2 - Non-phylo # total variance s2t<-sum(nonphyl$sigma2)+s2m I2t<-sum(nonphyl$sigma2)/s2t I2t*100 # 71.27437 % - total heterogeneity I2s<-nonphyl$sigma2[1]/s2t I2s*100 # 51.5699 % variance due to study I2g<-nonphyl$sigma2[2]/s2t I2g*100 # 3.162523e-08 variance due to common focal individual (group same) I2e<-nonphyl$sigma2[3]/s2t I2e*100 # 19.70447 % residuals against sampling error (or effect-size-specific or observation-specific variance) par(mfrow=c(1,1)) #FORESTPLOTS #phylplot forest(phyl, slab=paste(metarep$author, metarep$year, sep=",")) text(4,-7, "Hedges g [+/- 95% CI]", pos=2) #forestplot nonphyl par(mar=c(4,0,4,0)) forest0<-forest(nonphyl, slab=paste(metarep$Author, metarep$year),ilab=cbind(metarep$n1Infect, metarep$n2Control), ilab.xpos=c(16, 14), cex=0.8, ylim=c(-1, 90), order=order(metarep$Author), xlab="Hedges' g [+/- 95% CI]", mlab="") ### set font expansion factor (as in forest() above) and use bold italic ### font and save original settings in object 'op' op <- par(cex=0.8, font=4) ### switch to bold font par(font=2) text(c(-19,14,16), 85, c("Authors & Year", "Nt", "Nc")) text(24, 85, "Hedges' g", pos=2) text(22, 84, "[+/- 95% CI]", pos=1, cex=0.9) ### set par back to the original settings par(op) ##_________________________ #TRIM AND FILL ##__________________________ trimRep<-trimfill(phyl) #--------------------------------------------------------------------- #Model 1 (Table S3) - "life-history stage" -- age and sex combined. #--------------------------------------------------------------------- par(mfrow=c(1,1)) Repagesex<-rma.mv(yi=hedges_g,V=V,mods= ~factor(agesex) -1, random = list (~ 1|IDstudy, ~1|focalID, ~1|ES_ID), data=metarep, method="REML") summary(Repagesex) predictRepmain<-predict(Repagesex, newmods=rbind(c(1,0,0), c(0,1,0), c(0,0,1)), intercept=FALSE, digit=3) predictRepmain Repagesex1<-rma.mv(yi=hedges_g,V=V,mods= ~factor(agesex), random = list (~ 1|IDstudy, ~1|focalID, ~1|ES_ID), data=metarep, method="REML") summary(Repagesex1) #get all contrasts predictRep<-predict(Repagesex1, newmods=rbind(c(1,0), c(0,1), c(-1,1)), intercept=FALSE, digit=4) predictRep predictRepC<-predict(Repagesex1, newmods=rbind(c(-1,1)), intercept=FALSE, digit=4) predictRepC #Forest plot of Survagesex, also showing contrast between female and male op <- par(cex=0.8, font=2) #trying contrasts - tweaking forest (x=c(Repagesex$b, Repagesex1$b[2], Repagesex1$b[3], predictRepC$pred),sei=c(Repagesex$se, Repagesex1$se[2], Repagesex1$se[3], predictRepC$se), ci.lb=c(Repagesex$ci.lb, Repagesex1$ci.lb[2], Repagesex1$ci.lb[3], predictRepC$ci.lb), ci.ub=c(Repagesex$ci.ub, Repagesex1$ci.ub[2], Repagesex1$ci.ub[3], predictRepC$ci.ub), xlab="Hedges' g [+/- 95% CI]", slab=c("Male","Female","Juvenile", "Contrast (fem-male)", "Contrast (juv-male)", "Contrast (juv-fem)"),xlim=c(-5, 5), alim=c(-3.5,3.5),psize=2,cex=0.9, ylim=c(0,9)) text(c(-4.3), 6.7, c("Life-history stage"), cex=1.1) text(4, 6.4, "Hedges' g [+/- 95% CI]", pos=3, cex=1.1) ### set par back to the original settings par(op) # get PHYLOGENETIC model too Repagesexp<-rma.mv(yi=hedges_g,V=V,mods= ~factor(agesex) -1, random = list (~ 1|IDstudy, ~1|Animal, ~1|focalID, ~1|ES_ID), R=list(Animal=CorExt), data=metarep, method="REML") summary(Repagesexp) predictRepmainp<-predict(Repagesexp, newmods=rbind(c(1,0,0), c(0,1,0), c(0,0,1)), intercept=FALSE, digit=3) predictRepmainp Repagesex1p<-rma.mv(yi=hedges_g,V=V,mods= ~factor(agesex), random = list (~ 1|IDstudy, ~1|Animal, ~1|focalID, ~1|ES_ID), R=list(Animal=CorExt), data=metarep, method="REML") summary(Repagesex1p) #get all contrasts predictRepp<-predict(Repagesex1p, newmods=rbind(c(1,0), c(0,1), c(-1,1)), intercept=FALSE, digit=4) predictRepp predictRepCp<-predict(Repagesex1p, newmods=rbind(c(-1,1)), intercept=FALSE, digit=4) predictRepCp #.............................. # Model 2 - Treatment agent details (Table S4) -- Replicating Bacteria or virus vs. Other elicitor (e.g. LPS, implant, heat #-killed, PHA), implant #.............................. RepIA<-rma.mv(yi=hedges_g,V=V,mods= ~factor(infectionAgent)-1, random = list (~ 1|IDstudy, ~1|focalID, ~1|ES_ID),data=metarep, method="REML") summary(RepIA) predictRepIA<-predict(RepIA, newmods=rbind(c(1,0), c(0,1)), digit=4) predictRepIA RepIA1<-rma.mv(yi=hedges_g,V=V,mods= ~factor(infectionAgent), random = list (~ 1|IDstudy, ~1|focalID, ~1|ES_ID), data=metarep, method="REML") summary(RepIA1) predictRepIA1<-predict(RepIA1, newmods=rbind(c(0,1)), intercept=FALSE) predictRepIA1 #forest plot op <- par(cex=0.8, font=2) ## alternative forest plot forest(x=c(RepIA$b,RepIA1$b[2]),sei=c(RepIA$se,RepIA1$se[2]), ci.lb=c(RepIA$ci.lb,RepIA1$ci.lb[2]), ci.ub=c(RepIA$ci.ub,RepIA1$ci.ub[2]), xlab="Hedges' g [+/- 95% CI]", slab=c("Non-replic. agent","Replic. agent","Contrast (Replic. - Non-replic.)"),xlim=c(-4, 4), ylim=c(0.5, 5.6), alim=c(-3.5,3.5),psize=2,cex=1.0) text(c(-3.4), 3.4, c("Treatment agent"), cex=1.1) text(3.2, 3.3, "Hedges' g [+/- 95% CI]", pos=3, cex=1.1) ### set par back to the original settings par(op) #PHYLOGENETIC model too RepIAp<-rma.mv(yi=hedges_g,V=V,mods= ~factor(infectionAgent)-1, random = list (~ 1|IDstudy, ~1|Animal, ~1|focalID, ~1|ES_ID), R=list(Animal=CorExt),data=metarep, method="REML") summary(RepIAp) predictRepIAp<-predict(RepIAp, newmods=rbind(c(1,0), c(0,1)), digit=4) predictRepIAp RepIA1p<-rma.mv(yi=hedges_g,V=V,mods= ~factor(infectionAgent), random = list (~ 1|IDstudy, ~1|Animal, ~1|focalID, ~1|ES_ID), R=list(Animal=CorExt), data=metarep, method="REML") summary(RepIA1p) #.............................. # Model 3 (Table S5) - Vertebrate and invertebrate #.............................. RepInvertvert<-rma.mv(yi=hedges_g,V=V,mods= ~factor(invertvert)-1, random = list(~ 1 | IDstudy, ~1|focalID, ~1|ES_ID ), data=metarep, method="REML") summary(RepInvertvert) predictInvertrep<-predict(RepInvertvert, newmods=rbind(c(1,0), c(0,1)), intercept=FALSE) predictInvertrep RepInvertvert1<-rma.mv(yi=hedges_g,V=V,mods= ~factor(invertvert), random = list (~ 1 | IDstudy, ~1|focalID, ~1|ES_ID ), data=metarep, method="REML") summary(RepInvertvert1) predictInvertrep1<-predict(RepInvertvert1, newmods=rbind(c(0,1)), intercept=FALSE) predictInvertrep1 #forest plot op <- par(cex=0.8, font=2) ## alternative forest plot forest(x=c(RepInvertvert$b,RepInvertvert1$b[2]),sei=c(RepInvertvert$se,RepInvertvert1$se[2]), ci.lb=c(RepInvertvert$ci.lb,RepInvertvert1$ci.lb[2]), ci.ub=c(RepInvertvert$ci.ub,RepInvertvert1$ci.ub[2]), xlab="Hedges' g", slab=c("Invertebrates","Vertebrates","Contrast (Vert-Invert)"),xlim=c(-4, 4), ylim=c(0.5, 5.6), alim=c(-3.5,3.5),psize=2,cex=1.0) text(c(-3.1), 3.4, c("Animal kingdom group"), cex=1.1) text(3.2, 3.3, "Hedges' g [+/- 95% CI]", pos=3, cex=1.1) ### set par back to the original settings par(op) #.................................................................... ##MODEL 4 - FULL MODEL WITH ALL MODERATORS (MAIN EFFECT MODEL) (Table S6a) - because of insufficient data we did not test the interaction here (not data in each cell) #..................................................................... #Non-phylogenetic model RepFull<-rma.mv(yi=hedges_g,V=V, mods= ~ factor(agesex)+factor(infectionAgent), random = list(~ 1 | IDstudy, ~1|focalID, ~1|ES_ID ), data=metarep, method="REML") summary(RepFull) funnelMeta<-funnel(RepFull) #Phylogenetic model (Table S6b) RepPhylFull<-rma.mv(yi=hedges_g,V=V, mods= ~ factor(agesex)+factor(infectionAgent), random = list (~ 1|IDstudy, ~1|Animal,~1|focalID, ~1|ES_ID), R=list(Animal=CorExt), data=metarep, method="REML") summary(RepPhylFull) funnelMeta<-funnel(RepPhylFull) # ML for AIC.......................................... #Non-phylogenetic model RepFullML<-rma.mv(yi=hedges_g,V=V, mods= ~ factor(agesex)+factor(infectionAgent), random = list(~ 1 | IDstudy, ~1|focalID, ~1|ES_ID ), data=metarep, method="ML") summary(RepFullML) #Phylogenetic model (Table S8b) RepPhylFullML<-rma.mv(yi=hedges_g,V=V, mods= ~ factor(agesex) +factor(infectionAgent), random = list (~ 1|IDstudy, ~1|Animal,~1|focalID, ~1|ES_ID), R=list(Animal=CorExt), data=metarep, method="ML") summary(RepPhylFullML) #............................................................ #FOREST PLOT NON-PHYL FULL MODEL NO INTERACTIONS #Non-phylogenetic model RepFullC<-rma.mv(yi=hedges_g,V=V, mods= ~ factor(agesex)+factor(infectionAgent)-1, random = list(~ 1 | IDstudy, ~1|focalID, ~1|ES_ID ), data=metarep, method="REML") summary(RepFullC) predContr<-predict(RepFullC, newmods=rbind(c(0, -1, 1, 0))) predContr op <- par(cex=0.8, font=2) #plot WITHOUT THE INTERCEPT forest(x=c(RepFull$b[2], RepFull$b[3], predContr$pred, RepFull$b[4]),sei=c(RepFull$se[2], RepFull$se[3], predContr$se, RepFull$se[4]), ci.lb=c(RepFull$ci.lb[2], RepFull$ci.lb[3], predContr$ci.lb,RepFull$ci.lb[4]), ci.ub=c(RepFull$ci.ub[2],RepFull$ci.ub[3], predContr$ci.ub, RepFull$ci.ub[4]),xlab="Hedges' g", slab=c("male-fem","juv-fem","juv-male", "" ),font=1, xlim=c(-7, 7), ylim=c(-0.2, 7), alim=c(-3.5,3.5),psize=1.5,cex=1.0) addpoly(nonphyl, row=0, cex=1.0, mlab="Meta-analytic mean", font=4) text(c(-6.0), 4.7, c("Life-history stage"), cex=1.0) text(c(-6.0), 1.0, c("Treatment agent"), cex=1.0) text(c(-4.2), 1.0, c("(repl-nonrepl)"), font=1, cex=1.0) text(c(-6.2), 5.3, c("Moderator"), cex=1.1) text(5.5, 5.1, "Hedges' g [+/- 95% CI]", pos=3, cex=1.2) abline(h=0.4, lwd=1, col="black", lty=3) title(outer=FALSE, main="REPRODUCTION FULL DATA", line=-7.2) ### set par back to the original settings par(op) library(bbmle) AICtab(RepPhylFullML, RepFullML, RepFullinvertML) #Because the model is better without invertvert, we proceed to work with main effects that do not include that #Calculate I2 for SurvFullmain and SurvFullPhylmain (Table S7) #------------------------------------ # SurvFullPhyl - get H2 which equals to lambda s2m <- sum(1/metarep$Vg) * (RepPhylFull$k-1) / (sum(1/metarep$Vg)^2 - sum((1/metarep$Vg)^2)) s2m # typical sampling error # total variance s2t<-sum(RepPhylFull$sigma2)+s2m s2t I2t<-sum(RepPhylFull$sigma2)/s2t I2t*100 # total heterogeneity I2s<-RepPhylFull$sigma2[1]/s2t I2s*100 # variance due to unique study I2a<-RepPhylFull$sigma2[2]/s2t I2a*100 # due to phylogeny I2f<-RepPhylFull$sigma2[3]/s2t I2f*100 # variance due to common focal individual I2e<-RepPhylFull$sigma2[4]/s2t I2e*100 # residuals against sampling error H2 <-RepPhylFull$sigma2[2]/sum(RepPhylFull$sigma2) H2 # lamdba - close to zero # SurvFullmain non-phylo # total variance # total variance s2t<-sum(RepFull$sigma2)+s2m I2t<-sum(RepFull$sigma2)/s2t I2t*100 # total heterogeneity I2s<-RepFull$sigma2[1]/s2t I2s*100 # variance due to study I2f<-RepFull$sigma2[2]/s2t I2f*100 # 0 variance due to focal individual I2e<-RepFull$sigma2[3]/s2t I2e*100 # residuals against sampling error (or effect-size-specific//observation-specific variance) # Calculate R2 #-------------------------------- #Non-phylogenetic model full<-rma.mv(yi=hedges_g,V=V, mods= ~ factor(agesex)+factor(infectionAgent), random = list(~ 1 | IDstudy, ~1|focalID, ~1|ES_ID ), data=metarep, method="REML") summary(full) null<-rma.mv(yi=hedges_g,V=V, random = list(~ 1 | IDstudy, ~1|focalID, ~1|ES_ID ), data=metarep, method="REML") summary(null) R2m<-(sum(null$sigma2)-sum(full$sigma2))/sum(null$sigma2) 100*R2m # % accounted for (marginal) - by fixed effects R2c<-(sum(null$sigma2)-full$sigma2[3])/sum(null$sigma2) 100*R2c # % accounted for (conditional) - by fixed and random effects sum(null$sigma2) sum(full$sigma2) table(metarep$matingStatus, metarep$infectionAgent) table(metarep$matingStatus2, metarep$agesex) #.................................................................... ##MODEL 5 - FULL MODEL WITH ALL MODERATORS incl. INVERTVERT (MAIN EFFECT MODEL) (Table S8) #..................................................................... #Non-phylogenetic model RepFullinvert<-rma.mv(yi=hedges_g,V=V, mods= ~ factor(agesex)+factor(infectionAgent)+factor(invertvert), random = list(~ 1 | IDstudy, ~1|focalID, ~1|ES_ID ), data=metarep, method="REML") summary(RepFullinvert) RepFullinvertML<-rma.mv(yi=hedges_g,V=V, mods= ~ factor(agesex)+factor(infectionAgent)+factor(invertvert), random = list(~ 1 | IDstudy, ~1|focalID, ~1|ES_ID ), data=metarep, method="REML") summary(RepFullinvertML) #*************************************************************************************** #........................................................................................ ##CHECKING FUNNEL ASSUMETRY AND EGGER'S REGRESSION WITH MCMCglmm - META-ANALYTIC MODEL #........................................................................................ #*************************************************************************************** prior<-list(R=list(V=1,nu=0),G=list(G1=list(V=1, nu=1, alpha.mu=0, alpha.V=1000), G2=list(V=1, nu=1, alpha.mu=0, alpha.V=1000), G3=list(V=1,fix=1))) # put a very small #number for R (nu=1*10^-7) because the initial parameter-expanded V=1, nu=0 didn't run - asked for a stronger prior) prior1<-list(R=list(V=1,nu=0.002),G=list(G1=list(V=1, nu=1, alpha.mu=0, alpha.V=1000),G2=list(V=1, nu=1, alpha.mu=0, alpha.V=1000), G3=list(V=1,fix=1))) # parameter expanded prior #(close to non-informative, also parameter-expanded prior; USE THIS, PRODUCES BEST GRAPHS) prior2<-list(R=list(V=1,nu=0.002),G=list(G1=list(V=1, nu=0.002),G2=list(V=1, nu=1, alpha.mu=0, alpha.V=1000), G3=list(V=1,fix=1))) #inverse-Gamma prior. slightly informative #playing around with some other priors... prior3<-list(R=list(V=1,nu=0.002),G=list(G1=list(V=1, nu=1, alpha.mu=0.002, alpha.V=1000),G2=list(V=1, nu=1, alpha.mu=0, alpha.V=1000), G3=list(V=1,fix=1))) prior4<- list(R=list(V=1,nu=0.0000001),G=list(G1=list(V=1, nu=0),G2=list(V=1, nu=1, alpha.mu=0, alpha.V=1000), G3=list(V=1,fix=1))) prior5<- list(R=list(V=1,nu=0.0000001),G=list(G1=list(V=1, nu=0.02),G2=list(V=1, nu=1, alpha.mu=0, alpha.V=1000), G3=list(V=1,fix=1))) #********************************************* #EGGERS prediction meta-analytic model #********************************************* library(MCMCglmm) AinvG <- solve(V) AnivG <- as(AinvG,"dgCMatrix") metaMC<-MCMCglmm(hedges_g ~ 1, random = ~IDstudy+focalID+ES_ID, data=metarep, verbose=T,nitt=13000*50,thin=50, burnin=3000*50, prior=prior1, pr=T, ginverse=list(ES_ID = AnivG)) summary(metaMC) plot(metaMC$Sol[,1]) # fixed effeinversects - just intercept (first row is the intercept). plot(metaMC$VCV) # random effects (i.e. the posterior distribution for the variance component [unit is the residual effect]) autocorr(metaMC$VCV) #EGGERS Prediction<-predict(metaMC, marginal=~ES_ID) ##predicted values for subset effect size ID to explore bias between effect sizes Precision<-sqrt(1/metarep$Vg) MR<-metarep$hedges_g-Prediction zMR<-MR*Precision # Egger's regression Egger<-lm(zMR~Precision) summary(Egger) ##the intercept is not signficant - no evidence of funnel asymetry, which supports the general trend of the graph #do trim and fill on residuals res.model<-rma(yi=MR, vi=Vg, data=metarep) trimMOrph<-trimfill(res.model) summary(trimMOrph) L0.TF<-trimfill(res.model, estimator="L0") summary(L0.TF) R0.TF<-trimfill(res.model, estimator="R0") summary(R0.TF) par(mfrow=c(1,2)) funnel(L0.TF) funnel(R0.TF) #PHYLOGENETIC MODEL FOR Eggers and TRIM AND FILL names(metarep)[7]<-"animal" # change name of "Animal" column to "animal" to be compatible with MCMCglmm #expand prior to include Animal prior1<-list(R=list(V=1,nu=0.002),G=list(G1=list(V=1, nu=1, alpha.mu=0, alpha.V=1000),G2=list(V=1, nu=1, alpha.mu=0, alpha.V=1000),G3=list(V=1, nu=1, alpha.mu=0, alpha.V=1000), G4=list(V=1,fix=1))) # parameter expanded prior #(close to non-informative, also parameter-expanded prior; USE THIS, PRODUCES BEST GRAPHS AND GOOD OUTCOME) metaMCp<-MCMCglmm(hedges_g ~ 1, random = ~IDstudy+animal+ focalID+ES_ID, data=metarep, pedigree = RepTreeM, verbose=T,nitt=13000*50,thin=50, burnin=3000*50, prior=prior1, pr=T, ginverse=list(ES_ID = AnivG)) summary(metaMCp) #Eggers phylo model Predictionp<-predict(metaMCp, marginal=~ES_ID) ##predicted values for subset effect size ID to explore bias between effect sizes Precisionp<-sqrt(1/metarep$Vg) MRp<-metarep$hedges_g-Predictionp zMRp<-MRp*Precisionp # Egger's regression Eggerp<-lm(zMRp~Precisionp) summary(Eggerp) ##the intercept is not signficant - no evidence of funnel asymetry, which supports the general trend of the graph #do trim and fill on residuals non-phylo model res.modelp<-rma(yi=MRp, vi=Vg, data=metarep) trimMOrphp<-trimfill(res.modelp) summary(trimMOrphp) L0.TFp<-trimfill(res.modelp, estimator="L0") summary(L0.TFp) R0.TFp<-trimfill(res.modelp, estimator="R0") summary(R0.TFp) par(mfrow=c(2,2)) funnel(L0.TF, main="Non-phylogenetic, estimate L0", xlab="Hedges g (residuals)", ylab="SE", pch=16, cex=0.8) funnel(R0.TF, main="Non-phylogenetic, estimate R0", xlab="Hedges g (residuals)", ylab="SE", pch=16, cex=0.8) funnel(L0.TFp, main="Phylogenetic, estimate L0", xlab="Hedges g (residuals)", ylab="SE", pch=16, cex=0.8) funnel(R0.TFp, main="Phylogenetic, estimate R0", xlab="Hedges g (residuals)", ylab="SE", pch=16, cex=0.5) #Gelman-Rubin stats metaMC1<-MCMCglmm(hedges_g ~ 1, random= ~ IDstudy+focalID+ES_ID, data=metarep, verbose=T,nitt=13000*50,thin=50, burnin=3000*50, prior=prior1, pr=T, ginverse=list(ES_ID = AnivG)) summary(metaMC1) metaMC2<-MCMCglmm(hedges_g ~ 1, random= ~ IDstudy+focalID+ES_ID, data=metarep, verbose=T,nitt=13000*50,thin=50, burnin=3000*50, prior=prior1, pr=T, ginverse=list(ES_ID = AnivG)) summary(metaMC2) ### Gelman-Rubin diagnostic gelman.diag(list(metaMC$Sol[,1],metaMC1$Sol[,1],metaMC2$Sol[,1])) gelman.diag(list(metaMC$VCV[,c(1,2,4)],metaMC1$VCV[,c(1,2,4)],metaMC2$VCV[,c(1,2,4)])) gelman.diag(list(metaMC$Deviance,metaMC1$Deviance,metaMC2$Deviance)) # All of these are 1 EXACTLY (OR CLOSE TO), indicating very good convergence between runs ################################################# # GETTING ready for MCMCglmm - metaregression ################################################# metarep2<-with(metarep,data.frame(hedges_g,Vg,Share_Control,agesex, invertvert, infectionAgent,matingStatus,matingStatus1, matingStatus2, IDstudy,focalID, Animal, ES_ID,n1Infect,n2Control)) summary(metarep2) Sub<-which(complete.cases(metarep2)==T) metarep2<-metarep2[Sub,] str(metarep2) # preparing for V2 # create square matrix matching N of ES, filled with zeros V2 <- matrix(0,nrow = dim(metarep2)[1],ncol = dim(metarep2)[1]) rownames(V2) <- metarep2$ES_ID colnames(V2) <- metarep2$ES_ID # find start and end coordinates for the subsets shared_coord <- which(metarep2$Share_Control%in%metarep2$Share_Control[duplicated(metarep2$Share_Control)]==TRUE) shared_coord # matrix of combinations of coordinates for each experiment with shared control combinations <- do.call("rbind", tapply(shared_coord, metarep2[shared_coord,"Share_Control"], function(x) t(combn(x,2)))) combinations for (i in 1:dim(combinations)[1]){ p1 <- combinations[i,1] p2 <- combinations[i,2] p1_p2_cov <- 1/metarep2[p1,"n2Control"] + (metarep2[p1,"Vg"]*metarep2[p2,"Vg"]) / (2*(metarep2[p1,"n1Infect"]+metarep2[p1,"n2Control"])) V2[p1,p2] <- p1_p2_cov V2[p2,p1] <- p1_p2_cov } diag(V2) <- metarep2$Vg V2[35:52,35:52] #preparations finished # getting V ready for MCMCglmm - meta-regression AinvG1 <- solve(V2) AnivG1 <- as(AinvG1,"dgCMatrix") library(MCMCglmm) metaMCfull<-MCMCglmm(hedges_g ~ factor(agesex)+factor(infectionAgent), random= ~ IDstudy+focalID+ES_ID, data=metarep2, verbose=T,nitt=13000*50,thin=50, burnin=3000*50, prior=prior1, pr=T, ginverse=list(ES_ID = AnivG1)) summary(metaMCfull) #Eggers prediction Prediction1<-predict(metaMCfull, marginal=~ES_ID) ##predicted values for subset effect size ID to explore bias between effect sizes Precision1<-sqrt(1/metarep2$Vg) MR1<-metarep2$hedges_g-Prediction1 zMR1<-MR1*Precision1 # Egger's regression Egger1<-lm(zMR1~Precision1) summary(Egger1) ##the intercept is not signficant - no evidence of funnel asymetry, which support the general trend of the graph #RE-RUNNING FOR GELMAN-RUBIN STATISTICS metaMCfull1<-MCMCglmm(hedges_g ~ agesex + infectionAgent, random= ~ IDstudy+focalID+ES_ID, data=metarep2, verbose=T,nitt=13000*50,thin=50, burnin=3000*50, prior=prior1, pr=T, ginverse=list(ES_ID = AnivG1)) summary(metaMCfull1) metaMCfull2<-MCMCglmm(hedges_g ~ agesex + infectionAgent, random= ~ IDstudy+focalID+ES_ID, data=metarep2, verbose=T,nitt=13000*50,thin=50, burnin=3000*50, prior=prior1, pr=T, ginverse=list(ES_ID = AnivG1)) summary(metaMCfull2) ### Gelman-Rubin diagnostic gelman.diag(list(metaMCfull$Sol[,1],metaMCfull1$Sol[,1],metaMCfull2$Sol[,1])) gelman.diag(list(metaMCfull$VCV[,c(1,2,4)],metaMCfull1$VCV[,c(1,2,4)],metaMCfull2$VCV[,c(1,2,4)])) gelman.diag(list(metaMCfull$Deviance,metaMCfull1$Deviance,metaMCfull2$Deviance)) # All of these are 1 EXACTLY (OR LOSE TO), indicating very good convergence between runs #************************ #R^2 from MCMCglmm #************************ mFixed <- mean(metaMCfull$Sol[,2]) * metaMCfull$X[, 2] + mean(metaMCfull$Sol[, 3]) * metaMCfull$X[, 3] + mean(metaMCfull$Sol[ ,4]) * metaMCfull$X[, 4] #Calculation of the variance of the fitted values mVarF<- var(mFixed) mVarF #MCMCglmm -marginal mVarF/(mVarF+sum(apply(metaMCfull$VCV,2,mean)[-3])) # MCMCglmm - conditional (mVarF+sum(apply(metaMCfull$VCV,2,mean)[-3:-4]))/(mVarF+sum(apply(metaMCfull$VCV,2,mean)[-3])) #SAME ANALYSIS BUT INCLUDING INVERTVERT metaMCfulli<-MCMCglmm(hedges_g ~ agesex + infectionAgent+invertvert, random= ~ IDstudy+focalID+ES_ID, data=metarep2, verbose=T,nitt=13000*50,thin=50, burnin=3000*50, prior=prior1, pr=T, ginverse=list(ES_ID = AnivG1)) summary(metaMCfulli) mFixedi <- mean(metaMCfulli$Sol[,2]) * metaMCfulli$X[, 2] + mean(metaMCfulli$Sol[, 3]) * metaMCfulli$X[, 3] + mean(metaMCfulli$Sol[ ,4]) * metaMCfulli$X[, 4] +mean(metaMCfulli$Sol[ ,5]) * metaMCfulli$X[, 5] #Calculation of the variance of the fitted values mVarFi<- var(mFixedi) mVarFi #MCMCglmm -marginal mVarFi/(mVarFi+sum(apply(metaMCfulli$VCV,2,mean)[-3])) # MCMCglmm - conditional (mVarFi+sum(apply(metaMCfulli$VCV,2,mean)[-3:-4]))/(mVarFi+sum(apply(metaMCfulli$VCV,2,mean)[-3])) #PLOTS # plot funnel plot with precision on y-axis META-REGRESSION FULL MAIN MODEL par(mfrow=c(1,1)) par(mfrow=c(2,2)) funnel(nonphyl, main="Meta-analytic model Metafor original", xlab="Hedges' g", ylab="SE", pch=16, cex=0.8) plot(metarep$hedges_g, Precision, xlab="Hedges' g", ylab="Precision (1/SE)", xlim=c(-7, 7), pch=16, cex=0.8) abline(v=mean(metaMC$Sol[,1]),lwd=1, lty=1) # mcmc mean abline(v= -0.1315, col="red", lwd=1, lty=3) # metafor mean abline(v=0, col="black", lwd=1, lty=2) # metafor no effect title(main="Meta-analytic model Metafor Precision") #plot of residuals from MCMC plot(MR, Precision, xlab="Hedges' g (residuals)", ylab="Precision (1/SE)", xlim=c(-7, 7), pch=16, cex=0.8) abline(v=0,lwd=1, lty=2) #no effect title(main="Meta-analytic model Reproduction (MCMC)") #plot of residuals Meta-regression plot(MR1,Precision1, xlab="Hedges' g (residuals)", ylab="Precision (1/SE)" , xlim=c(-7, 7), pch=16, cex=0.8) abline(v=0,lwd=1, lty=2) #no effect title(main="Meta-regression model MCMC") #***************************************************************** #FOREST PLOT UNIVARIATE TESTS COMBINED #***************************************************************** op <- par(cex=0.8, font=2) #trying contrasts - tweaking forest (x=c(RepIA1$b[2], RepIA$b[2], RepIA$b[1],predictRepC$pred,Repagesex1$b[3], Repagesex1$b[2], Repagesex$b[3], Repagesex$b[2],Repagesex$b[1]),sei=c(RepIA1$se[2], RepIA$se[2], RepIA$se[1],predictRepC$se,Repagesex1$se[3], Repagesex1$se[2], Repagesex$se[3], Repagesex$se[2],Repagesex$se[1]), ci.lb=c(RepIA1$ci.lb[2], RepIA$ci.lb[2], RepIA$ci.lb[1],predictRepC$ci.lb,Repagesex1$ci.lb[3], Repagesex1$ci.lb[2], Repagesex$ci.lb[3],Repagesex$ci.lb[2],Repagesex$ci.lb[1]), ci.ub=c(RepIA1$ci.ub[2], RepIA$ci.ub[2], RepIA$ci.ub[1],predictRepC$ci.ub,Repagesex1$ci.ub[3], Repagesex1$ci.ub[2], Repagesex$ci.ub[3],Repagesex$ci.ub[2],Repagesex$ci.ub[1]), xlab="Hedges g",slab=c("Contrast (Replic. - Non-replic.)","Replic. agent", "Non-replic. agent","Contrast (juv-fem)", "Contrast (juv-male)" ,"Contrast (fem-male)" , "Juvenile", "Female", "Male"),alim=c(-3.5,3.5),psize=2,cex=0.9, ylim=c(-1.5,13), rows=c(-1:1, 4:9)) ### switch to bold font par(font=4) text(c(-3.0), 11.5, c("MODERATOR"), cex=1.2,font=2) text(2.8, 11.2, "Hedges' g [+/- 95% CI]", pos=3, cex=1.2, font=2) text(-2.9, 9.8, "Life-history stage", pos=3, cex=1.1) text(-3.0, 1.8, "Treatment agent", pos=3, cex=1.1) text(-3.2, 12.9, "(b)", pos=2, cex=1.5, font=2) ### set par back to the original settings par(op)