### Simulation of parameter estimation in GLMM # Copyright (C) 2022 anonymous authors # # This program is only for anonymous peer review and not to be distributed or used for any other purpose. #load libraries library(lme4) library(optimx) library(statmod) ###functions #generate dataset #n - number of participants #N - number of measurement categories in total generateData=function(n,N) { #generate dataset with independent variables testdata=data.frame(ids=as.factor(rep(1:n,each=N/n)), sex=factor(rep(c("m","f"),each=N/2)), #between subjects angle=rep(c(-72,0,72),N/3), #within subjects block=factor(rep(c("single","dual"),each=3,N/6)), #within subjects (repeat 3 times each for each factor of angle) condition=factor(rep(c("exp1","exp2"),each=N/4,2))) #between subjects (repeat 2 times for each factor of sex) #convert factors to numeric testdata$sexNumeric=sapply(testdata$sex,function(i) contr.sum(2)[i,]) testdata$blockNumeric=sapply(testdata$block,function(i) contr.sum(2)[i,]) testdata$conditionNumeric=sapply(testdata$condition,function(i) contr.sum(2)[i,]) #normalize all numeric variables (already centered) testdata$sexNumeric=testdata$sexNumeric/2 testdata$blockNumeric=testdata$blockNumeric/2 testdata$conditionNumeric=testdata$conditionNumeric/2 testdata$angle=testdata$angle/144 #random intercept for id (normally distributed for all distributions) testdata$randomIntercept=rep(rnorm(n),each=N/n) #generate vector of means for reaction time (arbitrary values for proof of concept) #initialize with -1 to start loop testdata$means=-1 ## in case values <0 are generated (extremely unlikely), this loop should be used to generate new values (generate new random intercepts inside loop) #do not allow data <0 because distributions are bounded to (0,inf)] #while(min(testdata$means)<=0){ #set values for fixed effects intercept=1000 factorSex=40 factorAngle=40 factorBlock=60 factorSexAngle=20 #generate true means as linear combinations testdata$means=intercept+ testdata$randomIntercept*50+ factorSex*testdata$sexNumeric+ factorAngle*testdata$angle+ factorBlock*testdata$blockNumeric+ factorSexAngle*testdata$sexNumeric*testdata$angle #} #different means for log odds for probabilities not too close to 1 intercept=3 factorSex=1 factorAngle=2 factorBlock=3 factorSexAngle=6 testdata$logOdds=intercept+ testdata$randomIntercept+ factorSex*testdata$sexNumeric+ factorAngle*testdata$angle+ factorBlock*testdata$blockNumeric+ factorSexAngle*testdata$sexNumeric*testdata$angle #convert to probability for binomial distribution testdata$prob=exp(testdata$logOdds)/(1+exp(testdata$logOdds)) #generate dependent variable (with random error) testdata$binomial=rbinom(N,1,prob=testdata$prob) testdata$inverseGaussian=rinvgauss(N, testdata$means, 10000) testdata$gamma=rgamma(N, testdata$means/100,1/100) #both distributions use variance of about 100000 (1000^3/10000 and 1000/100*100*100) return(testdata) } #get fixed effects of the binomial model for binomial distributed data getFixefGLMMbinomial=function(testdata){ glmmBinomial=glmer(binomial~sexNumeric*angle*blockNumeric*conditionNumeric+(1|ids), family=binomial(),data=testdata) return(fixef(glmmBinomial)) } #get fixed effects of the inverse gaussian model for inverse gaussian distributed data getFixefGLMMinverseGaussian=function(testdata){ glmmInvGauss=glmer(inverseGaussian~sexNumeric*angle*blockNumeric*conditionNumeric+(1|ids), family=inverse.gaussian(link=identity),data=testdata) return(fixef(glmmInvGauss)) } #get fixed effects of the gamma model for gamma distributed data getFixefGLMMgamma=function(testdata){ glmmGamma=glmer(gamma~sexNumeric*angle*blockNumeric*conditionNumeric+(1|ids), family=Gamma(link=identity),data=testdata) return(fixef(glmmGamma)) } ###script #set seed for reproducibility set.seed(12) #set variables numSims=100 #number of simulations n=250 #participants N=n*6*20 #6 times the number of measurements per condition (6 conditions) #create arrays for saving data (16 fixed effects) fixefBinoms=array(numeric(),dim=c(16,numSims)) fixefInvGauss=array(numeric(),dim=c(16,numSims)) fixefGamma=array(numeric(),dim=c(16,numSims)) #run simulations for(i in 1:numSims){ #generate dataset testdata=generateData(n,N) #get fixed effects and save to arrays fixefBinoms[,i]=getFixefGLMMbinomial(testdata) fixefInvGauss[,i]=getFixefGLMMinverseGaussian(testdata) fixefGamma[,i]=getFixefGLMMgamma(testdata) } #print mean estimates #order of effects is #(Intercept) sexNumeric angle #blockNumeric conditionNumeric sexNumeric:angle #sexNumeric:blockNumeric angle:blockNumeric sexNumeric:conditionNumeric #angle:conditionNumeric blockNumeric:conditionNumeric sexNumeric:angle:blockNumeric #sexNumeric:angle:conditionNumeric sexNumeric:blockNumeric:conditionNumeric angle:blockNumeric:conditionNumeric #sexNumeric:angle:blockNumeric:conditionNumeric rowMeans(fixefBinoms) # [1] 2.9991542958 1.0014865614 2.0037270380 3.0132881502 0.0328311075 6.0117053568 0.0005103637 0.0141551588 0.0118127217 #[10] 0.0028185636 -0.0011036812 0.0317811830 0.0150514574 -0.0206935241 -0.0374157113 0.0003926594 rowMeans(fixefInvGauss) # [1] 997.1108921 39.4953885 40.2607063 60.4402954 0.9044210 17.6801950 3.5760054 -3.6336310 -2.0864844 -1.0014691 0.2343476 #[12] -3.7960002 0.7378712 -7.4681096 8.8220969 13.6218517 rowMeans(fixefGamma) # [1] 999.379687783 41.022529737 39.933602868 59.765892468 0.630064345 19.052391947 0.233344171 0.503710066 -0.006143823 #[10] -0.784452093 -0.789480698 -2.133520816 -3.478296595 3.396727120 -2.556593296 1.486729309 #print sd of estimates library(matrixStats) rowSds(fixefBinoms) # [1] 0.0799613 0.1695318 0.1007769 0.1032844 0.1722383 0.2066440 0.2082300 0.2128910 0.3431093 0.2179655 0.1855355 0.4481443 0.4439759 0.3886309 0.4496478 #[16] 0.8186032 rowSds(fixefInvGauss) #[1] 3.922242 7.666585 4.470850 3.495186 7.884077 7.978722 7.956225 10.161775 13.698307 9.361408 6.947687 16.679177 18.758114 13.936927 18.608016 #[16] 38.536971 rowSds(fixefGamma) # [1] 3.707217 7.887490 4.072142 3.906186 7.037336 8.128849 6.208855 8.116008 15.099633 9.703957 7.168417 16.435334 19.209609 16.149764 19.419414 #[16] 32.368525