├── figures ├── test ├── m2_output.png ├── PosteriorsO4.png ├── PosteriorsO3_ID.png ├── PosteriorsO3_Res.png ├── m2_output_brms.png └── figureWikiCorrDifferentLEvels.png ├── scripts ├── sommerO4D1.R ├── sommerO3D1.R └── sommerO2D1 ├── data └── MMM_wiki_data.RData ├── README.md └── example1 /figures/test: -------------------------------------------------------------------------------- 1 | dd 2 | -------------------------------------------------------------------------------- /scripts/sommerO4D1.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JonBrommer/Multivariate-Mixed-Models-in-R/HEAD/scripts/sommerO4D1.R -------------------------------------------------------------------------------- /figures/m2_output.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JonBrommer/Multivariate-Mixed-Models-in-R/HEAD/figures/m2_output.png -------------------------------------------------------------------------------- /data/MMM_wiki_data.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JonBrommer/Multivariate-Mixed-Models-in-R/HEAD/data/MMM_wiki_data.RData -------------------------------------------------------------------------------- /figures/PosteriorsO4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JonBrommer/Multivariate-Mixed-Models-in-R/HEAD/figures/PosteriorsO4.png -------------------------------------------------------------------------------- /figures/PosteriorsO3_ID.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JonBrommer/Multivariate-Mixed-Models-in-R/HEAD/figures/PosteriorsO3_ID.png -------------------------------------------------------------------------------- /figures/PosteriorsO3_Res.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JonBrommer/Multivariate-Mixed-Models-in-R/HEAD/figures/PosteriorsO3_Res.png -------------------------------------------------------------------------------- /figures/m2_output_brms.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JonBrommer/Multivariate-Mixed-Models-in-R/HEAD/figures/m2_output_brms.png -------------------------------------------------------------------------------- /figures/figureWikiCorrDifferentLEvels.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JonBrommer/Multivariate-Mixed-Models-in-R/HEAD/figures/figureWikiCorrDifferentLEvels.png -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Multivariate-Mixed-Models-in-R 2 | contains R scripts exemplifying use of multivariate mixed models in a variety of R packages. Check out the wiki for more information 3 | -------------------------------------------------------------------------------- /scripts/sommerO3D1.R: -------------------------------------------------------------------------------- 1 | rm(list=ls()) 2 | setwd("C:\\Users\\joegbr\\Dropbox\\MMM_methods_paper\\wiki\\datafile") #set your working directory 3 | require(sommer) 4 | load("MMM_wiki_data.RData") 5 | require(sommer) 6 | m.biv<-mmer2(cbind(z1,z2)~1,random=~us(trait):ID, rcov=~us(trait):units, data=df.z) 7 | summary(m.biv) 8 | #proportion explained by between-individual variance 9 | pin(m.biv,prop.ID~V1/(V1+V4)) 10 | pin(m.biv,prop.ID~V3/(V3+V6)) 11 | #correlation on the between-individual level 12 | pin(m.biv,r.ID~V2/sqrt(V1*V3)) 13 | #correlation on the residual level 14 | pin(m.biv,r.res~V5/sqrt(V4*V6)) 15 | #correlation on the phenotypic level 16 | pin(m.biv,r.pheno~(V2+V5)/sqrt((V1+V4)*(V3+V6))) 17 | #phenotypic variances 18 | pin(m.biv,V.pheno.z1~V1+V4)*var(df.z$z1) 19 | pin(m.biv,V.pheno.z2~V3+V6)*var(df.z$z2) 20 | -------------------------------------------------------------------------------- /example1: -------------------------------------------------------------------------------- 1 | require(mvtnorm) 2 | n=200 #number of subject 3 | V_s = c(2,3) #between-subject variances for trait 1 and 2 4 | V_e = c(6,6) #error variances for trait 1 and 2 5 | r_s = 0.6 #correlation between s-values for traits 1 and 2 6 | r_e = -0.1 #correlation between e-values for traits 1 and 2 7 | C_s = r_s*sqrt(V_s[1]*V_s[2]) # covariance computed using the correlation 8 | C_e = r_e*sqrt(V_e[1]*V_e[2]) # covariance computed using the correlation 9 | #combining the above into covariance matrices 10 | sigma_s=diag(V_s) 11 | sigma_s[1,2]=sigma_s[2,1]=C_s 12 | sigma_e=diag(V_e) 13 | sigma_e[1,2]=sigma_e[2,1]=C_e 14 | #generating values 15 | s=rmvnorm(n=n, sigma=sigma_s) # subject-specific values for n subject 16 | e=list(trial1=rmvnorm(n=n, sigma=sigma_e), trial2=rmvnorm(n=n, sigma=sigma_e)) 17 | # measured values with first column the ID of the subject, 2nd column the trial 18 | z=rbind(cbind(1:n,1,s+e$trial1),cbind(1:n,2,s+e$trial2)) 19 | #plotting 20 | layout(matrix(c(1,2),2,1)) 21 | plot(s,pch=19, main="a strong correlation on the level of the subjects") 22 | plot(z[,3:4],pch=19, main="is not obvious when the residuals are added") 23 | #the correlation for the z values is: 24 | cov2cor(sigma_s+sigma_e) 25 | -------------------------------------------------------------------------------- /scripts/sommerO2D1: -------------------------------------------------------------------------------- 1 | rm(list=ls()) 2 | setwd("C:\\Users\\joegbr\\Dropbox\\MMM_methods_paper\\wiki\\datafile") #set your working directory 3 | require(sommer) 4 | load("MMM_wiki_data.RData") 5 | setwd("C:\\Users\\joegbr\\Dropbox\\MMM_methods_paper\\wiki\\sommer") #set your working directory 6 | #construct the A matrix 7 | require(pedigreemm) 8 | ped <- pedigree(sire = gryphonped[,"FATHER"],dam = gryphonped[,"MOTHER"], label= gryphonped[,"ID"]) 9 | A<-as.matrix(getA(ped)) 10 | #set to factors 11 | gryphondata$ANIMAL<-as.factor(gryphondata$ANIMAL) 12 | gryphondata$MOTHER<-as.factor(gryphondata$MOTHER) 13 | gryphondata$BYEAR<-as.factor(gryphondata$BYEAR) 14 | gryphondata$SEX<-as.factor(gryphondata$SEX) 15 | #run model 16 | m1<-mmer2(BWT~1,random=~BYEAR, G=list(ANIMAL=A),data=gryphondata) 17 | summary(m1) 18 | m2<-mmer2(BWT~1,random=~g(ANIMAL)+BYEAR, G=list(ANIMAL=A),data=gryphondata) 19 | summary(m2) 20 | #================================================== 21 | #Variance-Covariance components: 22 | # VarComp VarCompSE Zratio 23 | #1.g(ANIMAL).BWT-BWT 2.838 0.5396 5.261 24 | #2.BYEAR.BWT-BWT 1.234 0.3673 3.360 25 | #3. units.BWT-BWT 2.962 0.4360 6.793 26 | #================================================== 27 | anova(m2,m1) 28 | #above tests without taking into account the boundary condition 29 | #the probability (p) to obtain the same chi-square value with boundary condition is 30 | (1-pchisq(2*(m2$LL-m1$LL),1)+1-pchisq(2*(m2$LL-m1$LL),0))/2 31 | #calculate phenotypic variance and its SE 32 | # the pin() function calculates functions of the inferred variance: e.g. 33 | pin(m2, Vp.BWT~(V1+V2+V3)) #phenotypic variance conditional on fixed effects in the model 34 | #calculate heritability 35 | pin(m2, h2.BWT~V1/(V1+V2+V3)) 36 | # ¤¤¤¤¤¤¤¤¤ multivariate mm ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ 37 | m.biv.gen<-mmer2(cbind(BWT,TARSUS)~1,random=~us(trait):g(ANIMAL)+us(trait):BYEAR, G=list(ANIMAL=A),rcov = ~ us(trait):units,data=gryphondata) 38 | summary(m.biv.gen) 39 | #using the pin: what are the numbers? (get var components from summary(m.biv.gen)) and number them 40 | #================================================== 41 | # Multivariate Linear Mixed Model fit by REML 42 | #****************** sommer 3.1 ****************** 43 | #================================================== 44 | # logLik AIC BIC Method Converge 45 | #Value -661.579 1327.158 1338.044 MNR TRUE 46 | #================================================== 47 | #Variance-Covariance components: 48 | # VarComp VarCompSE Zratio 49 | #1. g(ANIMAL).BWT-BWT 2.76955 0.5346 5.1808 50 | #2. g(ANIMAL).BWT-TARSUS 1.49218 0.7564 1.9729 51 | #3. g(ANIMAL).TARSUS-TARSUS 7.13805 1.8675 3.8223 52 | #4. BYEAR.BWT-BWT 1.24039 0.3684 3.3666 53 | #5. BYEAR.BWT-TARSUS 0.08291 0.3663 0.2264 54 | #6. BYEAR.TARSUS-TARSUS 1.98210 0.7159 2.7686 55 | #7. units.BWT-BWT 3.01411 0.4353 6.9248 56 | #8. units.BWT-TARSUS 2.88036 0.6547 4.3996 57 | #9. units.TARSUS-TARSUS 14.70274 1.7019 8.6388 58 | #================================================== 59 | #heritabilities 60 | pin(m.biv.gen,h2.BWT~V1/(V1+V4+V6)) 61 | pin(m.biv.gen,h2.TARS~V3/(V3+V6+V9)) 62 | # genetic correlation 63 | pin(m.biv.gen,r.A~V2/sqrt(V1*V3)) 64 | # corr on the level of birth year 65 | pin(m.biv.gen,r.BY~V5/sqrt(V4*V6)) 66 | # corr on the level of residuals 67 | pin(m.biv.gen,r.res~V8/sqrt(V7*V9)) 68 | # corr on the phenotypic level 69 | pin(m.biv.gen,r.pheno~(V2+V5+V8)/sqrt((V1+V4+V7)*(V3+V6+V9))) 70 | #¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ 71 | #phenotypic variances 72 | pin(m.biv.gen, V.pheno.BWT~V1+V4+V7) 73 | pin(m.biv.gen, V.pheno.TARSUS~V3+V6+V9) 74 | #phenotypic covariance 75 | pin(m.biv.gen, C.pheno.BWT.TARS~(V2+V5+V8)) 76 | --------------------------------------------------------------------------------