Jörn Alexander Quent's notebook

where I share semi-interesting stuff from my work

Understanding mixed linear models

Preface

Note: This is an old post from my early PhD time that I slightly edited but share again because it would be interesting to one or two people.

This work documents my attempt to understand the model structure of mixed linear models or multilevel models. I adapted a formula that I found on Wikipedia and work myself through the different models and test whether I am able to retrieve the different parameters with lmerTest. Bodo Winter’s tutorial on the lme was very useful for this. The main motivation for doing all this is to use basically model 5 in my analysis of my first experiment. This work is also part of the process of pre-registering the study with a complete analysis script, which I will upload soon.

The design of the fictive experiment that 100 subjects see 20 objects and provide a continuous measure of memory for each objects. The expectancy of the objects (X) servers as a predictor for the memory performance (Y).

I start with very easy models and add more effects in order to finally arrive at my target model (model 5).

Libraries & functions

library(lmerTest)
library(ggplot2)

pValue <-function(x, sign = '='){
  if (inherits(x, "lm")){
    s <- summary.lm(x)
    x <- pf(s$fstatistic[1L], s$fstatistic[2L], s$fstatistic[3L], lower.tail = FALSE)
    if(x > 1){
      stop("There is no p-value greater than 1")
    } else if(x < 0.001){
      x.converted <- '< .001'
    } else{
      x.converted <- paste(sign,substr(as.character(round(x, 3)), 2,5))
    } 
  } else {
    if(x > 1){
      stop("There is no p-value greater than 1")
    } else if(x < 0.001){
      x.converted <- '< .001'
    } else{
      x.converted <- paste(sign,substr(as.character(round(x, 3)), 2,5))
    } 
  }
  return(x.converted)
}

rValue <-function(x){
  if (inherits(x, "lm")){
    r.squared <- summary(x)$r.squared
    x.converted <- paste('=',substr(as.character(round(r.squared, 3)), 2,5)) 
  } else {
    if (x < 0){
      x.converted <- paste('= -',substr(as.character(abs(round(x, 3))), 2,5), sep = '') 
    } else {
      x.converted <- paste('=',substr(as.character(abs(round(x, 3))), 2,5)) 
    }
  }
  return(x.converted) 
}

Model 1: Simple regression model with 1 level

Assume that expectancy and memory performance was aggregated across subjects.In this model, objects’ memorability is predicted by their average expectancy values. The corresponding formula looks like this: Yi = β0 + β1Xi + ei

  • Yi refers to memorability of object i.
  • Xi refers to average expectancy of object i.
  • β0 refers to the intercept.
  • β1 refers to the linear slope.
  • ei refers to the random errors of prediction.
# Generating data set
# General values and variables
numObj <- 20
e      <- rnorm(numObj, mean = 0, sd = 0.1)
x      <- scale(runif(numObj, min = -100, max = 100))
y      <- c()

# Coefficients
beta0  <- 8
beta1  <- 0.3

for(i in 1:numObj){
  y[i] <- beta0 + beta1*x[i] + e[i]
}

dataFrame1 <- data.frame(y = y, x = x, objNum = factor(1:20)) 

model1 <- lm(y ~  x, data = dataFrame1)
summary(model1)
## 
## Call:
## lm(formula = y ~ x, data = dataFrame1)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.20890 -0.04468  0.01759  0.05531  0.13807 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  7.98510    0.01975  404.24  < 2e-16 ***
## x            0.29759    0.02027   14.68 1.84e-11 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.08834 on 18 degrees of freedom
## Multiple R-squared:  0.923,  Adjusted R-squared:  0.9187 
## F-statistic: 215.6 on 1 and 18 DF,  p-value: 1.84e-11

Unsurprisingly, lm returns estimates that are very close the the true values $\hat{\beta_{0}} =$ 7.9850955 (vs 8) and $\hat{\beta_{1}} =$ 0.297594 (vs 0.3).

Model 2: A random intercept for each subject

Now, I don’t aggregated anymore and there is one value for each subject and each object and I allow for different intercepts for each subject, which basically means that I assume that my subjects’ general memory performance varies.

Level 1: Yi**j = β0j + β1Xi**j + ei**j Level 2: β0j = γ00 + γ01Wj + u0j

  • Yi**j refers to memory score for object i and subject j.
  • β0j refers to the intercept of the dependent variable in subject j (level 2) in other words the individual difference in general performance across subjects.
  • β1 refers to the linear slope.
  • Xi**j refers to the level 1 predictor.
  • ei**j refers to the random errors of prediction for the level 1 equation.
  • γ00 refers to the overall intercept. This is the grand mean of the scores on the dependent variable across all the subjects when all the predictors are equal to 0.
  • γ01 refers to the overall regression coefficient, or the slope, between the dependent variable and the level 2 predictor.
  • Wj refers to the level 2 predictor.
  • u0j refers to the random error component for the deviation of the intercept of a subject from the overall intercept.
# Generating data set
# General values and variables
numObj <- 20
numSub <- 100
e      <- rnorm(numObj * numSub, mean = 0, sd = 0.1)
x      <- scale(runif(numObj * numSub, min = -100, max = 100))
y      <- c()
index  <- 1

# Coefficients
gamma00 <- 18
gamma01 <- 0.5
beta1   <- -100
w       <- runif(numSub, min = -3, max = 3)
u0      <- rnorm(numSub, mean = 0, sd = 0.1)
meanBeta0 <- mean(gamma00 + gamma01*w + u0) # I should be able to retrieve that parameter. 

for(j in 1:numSub){
  for(i in 1:numObj){
    y[index] <- gamma00 + gamma01*w[j]+ u0[j] + beta1*x[index] + e[index]
    index <- index + 1
  } 
}

dataFrame2 <- data.frame(y = y, x = x, subNo = factor(rep(1:numSub, each = numObj)), objNum = factor(rep(1:numObj, numSub))) 

model2 <- lmer(y ~  x + 
                 (1 | subNo), data = dataFrame2)
summary(model2)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: y ~ x + (1 | subNo)
##    Data: dataFrame2
## 
## REML criterion at convergence: -2857.9
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.3190 -0.6732 -0.0093  0.6534  3.5334 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  subNo    (Intercept) 0.685895 0.8282  
##  Residual             0.009703 0.0985  
## Number of obs: 2000, groups:  subNo, 100
## 
## Fixed effects:
##               Estimate Std. Error         df t value Pr(>|t|)    
## (Intercept)  1.806e+01  8.285e-02  9.900e+01     218   <2e-16 ***
## x           -1.000e+02  2.253e-03  1.899e+03  -44394   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##   (Intr)
## x 0.000
anova(model2)
## Type III Analysis of Variance Table with Satterthwaite's method
##     Sum Sq  Mean Sq NumDF  DenDF    F value    Pr(>F)    
## x 19123395 19123395     1 1899.1 1970854622 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Extract intercept for each subject by coef(model2). 

As you can see above (fixed effects), $\hat{\beta_{0.}} =$ 18.0612368 is approximating the true (18.0601846). The same is true for $\hat{\beta_{1}} =$ -100.0019619 (vs -100). The estimated level 1 intercept for subject 1 was also close to the true value (18.8278538 vs 18.8320122).

Model 3: Random intercept and slope for each subject

In the next model, I am additionally allowing the slope randomly different for each subject. This means that the strength of the relationship between the level 1 predictor X and the memory scores Y varies across subjects.

Level 1: Yi**j = β0j + β1jXi**j + ei**j

Level 2: β0j = γ00 + γ01Wj + u0j β1j = γ10 + u1j

  • Yi**j refers to memory score for object i and subject j.
  • β0j refers to the intercept of the dependent variable in subject j (level 2) in other words the individual difference in general performance across subjects.
  • β1j refers to the linear slope that varies across subjects in other words the relationship X and Y is different across subjects.
  • Xi**j refers to the level 1 predictor.
  • ei**j refers to the random errors of prediction for the level 1 equation.
  • γ00 refers to the overall intercept. This is the grand mean of the scores on the dependent variable across all the subjects when all the predictors are equal to 0.
  • γ01 refers to the overall regression coefficient, or the slope, between the dependent variable and the level 2 predictor.
  • Wj refers to the level 2 predictor.
  • u0j refers to the random error component for the deviation of the intercept of a subject from the overall intercept.
  • γ10 overall slope of the level 2.
  • u1j refers to the random error component for the deviation of the slope of a subject from the overall intercept.
# Generating data set
# General values and variables
numObj <- 20
numSub <- 100
e      <- rnorm(numObj * numSub, mean = 0, sd = 0.1)
x      <- scale(runif(numObj * numSub, min = -100, max = 100))
y      <- c()
index  <- 1

# Coefficients
gamma00 <- 18
gamma01 <- 0.5
gamma10 <- -100
w       <- runif(numSub, min = -3, max = 3)
u0      <- rnorm(numSub, mean = 0, sd = 0.1)
u1      <- rnorm(numSub, mean = 0, sd = 0.1)
meanBeta0 <- mean(gamma00 + gamma01*w + u0) # I should be able to retrieve that parameter. 

for(j in 1:numSub){
  for(i in 1:numObj){
    y[index] <- gamma00 + gamma01*w[j]+ u0[j] + (gamma10 + u1[j])*x[index] + e[index]
    index <- index + 1
  } 
}

dataFrame3 <- data.frame(y = y, x = x, subNo = factor(rep(1:numSub, each = numObj)), objNum = factor(rep(1:numObj, numSub))) 

model3 <- lmer(y ~  x + 
                 (1 + x | subNo), data = dataFrame3)
summary(model3)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: y ~ x + (1 + x | subNo)
##    Data: dataFrame3
## 
## REML criterion at convergence: -2552
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.9327 -0.6122  0.0083  0.6447  3.2559 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev. Corr
##  subNo    (Intercept) 0.868034 0.93168      
##           x           0.008187 0.09048  0.11
##  Residual             0.009730 0.09864      
## Number of obs: 2000, groups:  subNo, 100
## 
## Fixed effects:
##               Estimate Std. Error         df  t value Pr(>|t|)    
## (Intercept)  17.879803   0.093196  98.998382    191.9   <2e-16 ***
## x           -99.980041   0.009342  99.528150 -10702.0   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##   (Intr)
## x 0.106
anova(model3)
## Type III Analysis of Variance Table with Satterthwaite's method
##    Sum Sq Mean Sq NumDF  DenDF   F value    Pr(>F)    
## x 1114376 1114376     1 99.528 114532908 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Again, $\hat{\beta_{0.}} =$ 18.0612368 and $\hat{\beta_{1.}} =$ -100.0019619 were correctly estimated (i.e. 18 vs -100) for level 1. Level 2 estimates for subject 1 were also correctly estimated: $\hat{\beta_{01}}$ = 18.3278073 vs β11 = 18.3177611 and $\hat{\beta_{11}}$ = -99.9649699 vs β11 = -99.9383084.

Model 4: Random intercepts for each object and each subject

As explained, above each subject rates each of twenty objects. In addition to the varying performance among the participants, one can assume that there are objects, which can be remembered more easily than others. Therefore, I add a random intercept for each object representing at varying baseline memorability.

Level 1: Yi**j = β0i**j + β1Xi**j + ei**j

Level 2: β0i**j = γ00 + γ01W1i + u01i + γ02W2j + u02j

  • Yi**j refers to memory score for object i and subject j.
  • β0i**j refers to the intercept of the dependent variable that is different for each subject and object.
  • β1 refers to the linear slope.
  • Xi**j refers to the level 1 predictor.
  • ei**j refers to the random errors of prediction for the level 1 equation.
  • γ00 refers to the overall intercept. This is the grand mean of the scores on the dependent variable across all the subjects when all the predictors are equal to 0.
  • γ01 refers to the overall regression coefficient, or the slope, between the dependent variable and the level 2 predictor.
  • W1i refers to the level 2 predictor for objects.
  • u01i refers to the random error component for the deviation of the intercept of a object from the overall intercept.
  • γ02 refers to the overall regression coefficient, or the slope, between the dependent variable and the level 2 predictor.
  • W2j refers to the level 2 predictor for subjects.
  • u02j refers to the random error component for the deviation of the intercept of a subject from the overall intercept.
# Generating data set
# General values and variables
numObj <- 20
numSub <- 100
e      <- rnorm(numObj * numSub, mean = 0, sd = 0.1)
x      <- scale(runif(numObj * numSub, min = -100, max = 100))
y      <- c()
index  <- 1

# Coefficients
gamma00 <- 18
gamma01 <- 0.5
gamma02 <- -10
beta1    <- -100
w1       <- runif(numObj, min = 0, max = 3)
w2       <- runif(numSub, min = -3, max = 3)
u01       <- rnorm(numObj, mean = 0, sd = 0.1)
u02       <- rnorm(numSub, mean = 0, sd = 0.1)

for(j in 1:numSub){
  for(i in 1:numObj){
    y[index] <-gamma00 + gamma01*w1[i] + u01[i] + gamma02*w2[j] + u02[j] + beta1*x[index] + e[index]
    index <- index + 1
  } 
}

dataFrame4 <- data.frame(y = y, x = x, subNo = factor(rep(1:numSub, each = numObj)), objNum = factor(rep(1:numObj, numSub))) 

model4 <- lmer(y ~  x + 
                 (1 | subNo) + 
                 (1 | objNum), data = dataFrame4)
summary(model4)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: y ~ x + (1 | subNo) + (1 | objNum)
##    Data: dataFrame4
## 
## REML criterion at convergence: -2138.5
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.7531 -0.6271  0.0010  0.6649  3.5013 
## 
## Random effects:
##  Groups   Name        Variance  Std.Dev.
##  subNo    (Intercept) 3.164e+02 17.78779
##  objNum   (Intercept) 1.008e-01  0.31753
##  Residual             9.602e-03  0.09799
## Number of obs: 2000, groups:  subNo, 100; objNum, 20
## 
## Fixed effects:
##               Estimate Std. Error         df   t value Pr(>|t|)    
## (Intercept)  1.945e+01  1.780e+00  9.932e+01     10.93   <2e-16 ***
## x           -1.000e+02  2.271e-03  1.880e+03 -44038.89   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##   (Intr)
## x 0.000
anova(model4)
## Type III Analysis of Variance Table with Satterthwaite's method
##     Sum Sq  Mean Sq NumDF DenDF    F value    Pr(>F)    
## x 18621423 18621423     1  1880 1939423508 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Firstly, on level 1 estimates were close to the true values: $\hat{\beta_{0..}} =$ 19.450424 (vs 19.4497162) as well as $\hat{\beta_{1}} =$ -100.0054394 (vs -100). Now looking at the level 2 estimates: the intercept for the object 1 across all subjects is $\hat{\beta_{01.}}$ = 19.0068543 (vs 18.9956614), while the intercept for subject 1 across all objects is $\hat{\beta_{0.1}}$ = 41.9438705 (vs 41.9422321).

Model 5: Random intercepts for each object, each subject, quadratic term and random slopes for subjects

Model 5.1

I am finally arriving at the model, which I want to use to model my data in the upcoming analysis. This models contains random intercepts for each object and each subject. A second quadratic term is added to test for non-linearities. Both the slope of the linear term and the slope of the quadratic term are random for each subject. At this point it is crucial to note that the predictor X is random for each subject and object just as if the subjects had to rate the expectancy of each object after their memory was tested. This will be the case of my experiment, but I also collected normative data, where X varies only across objects representing aggregate values (see model 5.2).

Level 1: Yi**j = β0i**j + β1jXi**j + β2jXi**j2 + ei**j Level 2: β0i**j = γ00 + γ01W1i + u01i + γ02W2j + u02j β1j = γ10 + u1j β2j = γ20 + u2j

  • Yi**j refers to memory score for object i and subject j.
  • β0i**j refers to the intercept of the dependent variable that is different for each subject and object.
  • β1j refers to the linear slope for the relationship in subject j (level 2) between the level 1 predictor and the dependent variable.
  • Xi**j refers to the linear level 1 predictor that varies for across objects and subjects.
  • β2j refers to the quadratic slope for the relationship in subject j (level 2) between the level 1 predictor and the dependent variable.
  • Xi**j2 refers to the quadratic level 1 predictor that varies for across objects and subjects.
  • ei**j refers to the random errors of prediction for the level 1 equation.
  • γ00 refers to the overall intercept. This is the grand mean of the scores on the dependent variable across all the subjects when all the predictors are equal to 0.
  • γ01 refers to the overall regression coefficient, or the slope, between the dependent variable and the level 2 predictor.
  • W1i refers to the level 2 predictor for objects.
  • u01i refers to the random error component for the deviation of the intercept of a object from the overall intercept.
  • γ02 refers to the overall regression coefficient, or the slope, between the dependent variable and the level 2 predictor.
  • W2j refers to the level 2 predictor for subjects.
  • u02j refers to the random error component for the deviation of the intercept of a subject from the overall intercept.
  • γ10 overall linear slope of the level 2.
  • u1j refers to the random error component for the deviation from the linear slope of a subject from the overall intercept.
  • γ20 overall quadratic slope of the level 2.
  • u2j refers to the random error component for the deviation from the quadratic slope of a subject from the overall intercept.
# Generating data set
# General values
numObj <- 20
numSub <- 100
index  <- 1
y      <- c()
x      <- scale(runif(numObj * numSub, min = -100, max = 100)) # randomly varies across object and subjects as post ratings, but the problem here could be that this assumes that the ratings for the objects across subjects are completely uncorrelated
x2     <- x*x
e      <- rnorm(numObj * numSub, mean = 0, sd = 0.1) 

# Coefficients
gamma00 <- 0.5
gamma01 <- 2
gamma02 <- 8
gamma10 <- 0
gamma20 <- 10

# Varying stuff
w1 <- runif(numObj, min = -4, max = 4)
w2 <- runif(numSub, min =  0, max = 4)
u01 <- rnorm(numObj, mean = 0, sd = 0.1)
u02 <- rnorm(numSub, mean = 0, sd = 0.1)
u1 <- rnorm(numSub, mean = 0, sd = 0.1)
u2 <- rnorm(numSub, mean = 0, sd = 0.1)

for(j in 1:numSub){
  for(i in 1:numObj){
    # Long format
    y[index] <- gamma00 + gamma01 * w1[i]  + u01[i] + gamma02 * w2[j] + u02[j] + (gamma10 + u1[j]) * x[index] + (gamma20 + u2[j]) * x2[index] + e[index]
    index <- index + 1
  }
}

dataFrame5 <- data.frame(y = y, subNo = factor(rep(1:numSub, each = numObj)), objNum = factor(rep(1:numObj, numSub)), x = x, x2 = x2)

model5 <- lmer(y ~  x + 
                    x2 + 
                    (1 | subNo) + 
                    (1 | objNum) + 
                    (x2|subNo) +
                    (x|subNo), data = dataFrame5)

summary(model5)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: y ~ x + x2 + (1 | subNo) + (1 | objNum) + (x2 | subNo) + (x |  
##     subNo)
##    Data: dataFrame5
## 
## REML criterion at convergence: -1542.7
## 
## Scaled residuals: 
##      Min       1Q   Median       3Q      Max 
## -2.90993 -0.61316  0.02424  0.64441  2.92104 
## 
## Random effects:
##  Groups   Name        Variance  Std.Dev. Corr 
##  subNo    (Intercept)  0.296066 0.54412       
##           x            0.013235 0.11504  0.37 
##  subNo.1  (Intercept)  0.627256 0.79199       
##           x2           0.008627 0.09288  -0.46
##  subNo.2  (Intercept) 70.071082 8.37085       
##  objNum   (Intercept) 23.260830 4.82295       
##  Residual              0.009904 0.09952       
## Number of obs: 2000, groups:  subNo, 100; objNum, 20
## 
## Fixed effects:
##              Estimate Std. Error        df  t value Pr(>|t|)    
## (Intercept) 17.495733   1.368575 45.984110   12.784   <2e-16 ***
## x            0.002500   0.011769 98.789562    0.212    0.832    
## x2           9.970179   0.009687 98.504324 1029.206   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##    (Intr) x     
## x   0.014       
## x2 -0.026  0.001
## convergence code: 0
## unable to evaluate scaled gradient
## Model failed to converge: degenerate  Hessian with 1 negative eigenvalues
anova(model5)
## Type III Analysis of Variance Table with Satterthwaite's method
##    Sum Sq Mean Sq NumDF  DenDF    F value Pr(>F)    
## x       0       0     1 98.790 4.5100e-02 0.8322    
## x2  10492   10492     1 98.504 1.0593e+06 <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
corrResult <- cor.test(coef(model5)$subNo$`(Intercept)`, gamma00 + mean(gamma01*w1 + u01) + gamma02*w2 + u02)

The intercept of object 1 across all subjects is $\hat{\beta_{01.}} =$ 16.4906087 (vs 16.4837433), while subject’s 1 performance across all objects was $\hat{\beta_{0.1}} =$ 17.3720882 (vs 15.6800431). Compared to the other estimates, the last estimate is quite far off. However the estimates are still highly correlated with the true values, r = .185, p = .065. However on some simulations they are not, which I realised after running this script a couple of times. I have no idea why this is the case. On level 2, the linear slope for subject 1 was $\hat{\beta_{11}} =$ -0.0244874 (vs -0.0174013), while the quadratic slope was $\hat{\beta_{21}} =$ 9.9571944 (vs 9.970709).

Model 5.2

This model is basically the same than the previous except one different. X varies only across objects like as if it was aggregated values from a different population. This is case in the experiment, in which one could use the normative data instead of participants’ ratings to predict the memory score.

Level 1: Yi**j = β0i**j + β1jXi + β2jXi2 + ei**j Level 2: β0i**j = γ00 + γ01W1i + u01i + γ02W2j + u02j β1j = γ10 + u1j β2j = γ20 + u2j

  • Yi**j refers to memory score for object i and subject j.
  • β0i**j refers to the intercept of the dependent variable that is different for each subject and object.
  • β1j refers to the linear slope for the relationship in subject j (level 2) between the level 1 predictor and the dependent variable.
  • Xi refers to the linear level 1 predictor that varies for across objects but not across subjects.
  • β2j refers to the quadratic slope for the relationship in subject j (level 2) between the level 1 predictor and the dependent variable.
  • Xi2 refers to the quadratic level 1 predictor that varies for across objects but not across subjects.
  • ei**j refers to the random errors of prediction for the level 1 equation.
  • γ00 refers to the overall intercept. This is the grand mean of the scores on the dependent variable across all the subjects when all the predictors are equal to 0.
  • γ01 refers to the overall regression coefficient, or the slope, between the dependent variable and the level 2 predictor.
  • W1i refers to the level 2 predictor for objects.
  • u01i refers to the random error component for the deviation of the intercept of a object from the overall intercept.
  • γ02 refers to the overall regression coefficient, or the slope, between the dependent variable and the level 2 predictor.
  • W2j refers to the level 2 predictor for subjects.
  • u02j refers to the random error component for the deviation of the intercept of a subject from the overall intercept.
  • γ10 overall linear slope of the level 2.
  • u1j refers to the random error component for the deviation from the linear slope of a subject from the overall intercept.
  • γ20 overall quadratic slope of the level 2.
  • u2j refers to the random error component for the deviation from the quadratic slope of a subject from the overall intercept.
# Generating data set
# General values
numObj <- 20
numSub <- 100
index  <- 1
y      <- c()
x      <- scale(runif(numObj, min = -100, max = 100)) # randomly varies across object and subjects as post ratings, but the problem here could be that this assumes that the ratings for the objects across subjects are completely uncorrelated
x2     <- x*x
e      <- rnorm(numObj * numSub, mean = 0, sd = 0.1) 

# Coefficients
gamma00 <- 0.5
gamma01 <- 2
gamma02 <- 8
gamma10 <- 0
gamma20 <- 10

# Varying stuff
w1 <- runif(numObj, min = -4, max = 4)
w2 <- runif(numSub, min =  0, max = 4)
u01 <- rnorm(numObj, mean = 0, sd = 0.1)
u02 <- rnorm(numSub, mean = 0, sd = 0.1)
u1 <- rnorm(numSub, mean = 0, sd = 0.1)
u2 <- rnorm(numSub, mean = 0, sd = 0.1)

for(j in 1:numSub){
  for(i in 1:numObj){
    # Long format
    y[index] <- gamma00 + gamma01 * w1[i]  + u01[i] + gamma02 * w2[j] + u02[j] + (gamma10 + u1[j]) * x[i] + (gamma20 + u2[j]) * x2[i] + e[index]
    index <- index + 1
  }
}

dataFrame5 <- data.frame(y = y, subNo = factor(rep(1:numSub, each = numObj)), objNum = factor(rep(1:numObj, numSub)), x = x, x2 = x2)

model5 <- lmer(y ~  x + 
                    x2 + 
                    (1 | subNo) + 
                    (1 | objNum) + 
                    (x2|subNo) +
                    (x|subNo), data = dataFrame5)

summary(model5)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: y ~ x + x2 + (1 | subNo) + (1 | objNum) + (x2 | subNo) + (x |  
##     subNo)
##    Data: dataFrame5
## 
## REML criterion at convergence: -1497.3
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.2316 -0.6402  0.0021  0.6139  3.4157 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev. Corr 
##  subNo    (Intercept)  0.77346 0.8795        
##           x            0.01168 0.1081   -1.00
##  subNo.1  (Intercept) 62.59113 7.9115        
##           x2           0.01023 0.1011   0.30 
##  subNo.2  (Intercept) 18.34655 4.2833        
##  objNum   (Intercept) 23.05402 4.8015        
##  Residual              0.01039 0.1019        
## Number of obs: 2000, groups:  subNo, 100; objNum, 20
## 
## Fixed effects:
##             Estimate Std. Error      df t value Pr(>|t|)    
## (Intercept)  17.7209     1.9922 26.6294   8.895 1.86e-09 ***
## x            -0.1758     1.1925 17.0058  -0.147    0.885    
## x2           10.2781     1.4883 16.9798   6.906 2.56e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##    (Intr) x     
## x  -0.272       
## x2 -0.709  0.383
anova(model5)
## Type III Analysis of Variance Table with Satterthwaite's method
##     Sum Sq Mean Sq NumDF  DenDF F value   Pr(>F)    
## x  0.00023 0.00023     1 17.006  0.0217   0.8845    
## x2 0.49531 0.49531     1 16.980 47.6909 2.56e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
corrResult <- cor.test(coef(model5)$subNo$`(Intercept)`, gamma00 + mean(gamma01*w1 + u01) + gamma02*w2 + u02)

The intercept of object 1 across all subjects is $\hat{\beta_{01.}} =$ 16.6529841 (vs 16.6423956), while subject’s 1 performance across all objects was $\hat{\beta_{0.1}} =$ 17.139073 (vs 20.5890653). Compared to the other estimates, the last estimate is quite far off. However the estimates are still highly correlated with the true values, r = .094, p = .352. However on some simulations they are not, which I realised after running this script a couple of times. I have no idea why this is the case. On level 2, the linear slope for subject 1 was $\hat{\beta_{11}} =$ 0.0037117 (vs -0.1519748), while the quadratic slope was $\hat{\beta_{21}} =$ 9.9792044 (vs 10.2879503).

Inaccurate estimations of the random intercepts for each subject

There seems to be a problem in both simulation above that the estimate of $\hat{\beta_{0.j}}$ was quite inaccurate sometimes, but this could be due the fact that I used 16 subjects in previous analyses. To test this, I run number of simulation with the same parameters.

n <- 100
# Fixed values:
  numObj <- 20
  numSub <- 100
  gamma00 <- 0.5
  gamma01 <- 2
  gamma02 <- 8
  gamma10 <- 0
  gamma20 <- 10
  corrResults <- c()
  
# Loop for n simulations
for(run in 1:n){
  # Generating data set
  # General values
  index  <- 1
  y      <- c()
  x      <- scale(runif(numObj, min = -100, max = 100)) # randomly varies across object and subjects as post ratings, but the problem here could be that this assumes that the ratings for the objects across subjects are completely uncorrelated
  x2     <- x*x
  e      <- rnorm(numObj * numSub, mean = 0, sd = 0.1) 
  # Varying stuff
  w1 <- runif(numObj, min = -4, max = 4)
  w2 <- runif(numSub, min =  0, max = 4)
  u01 <- rnorm(numObj, mean = 0, sd = 0.1)
  u02 <- rnorm(numSub, mean = 0, sd = 0.1)
  u1 <- rnorm(numSub, mean = 0, sd = 0.1)
  u2 <- rnorm(numSub, mean = 0, sd = 0.1)
  
  for(j in 1:numSub){
    for(i in 1:numObj){
      # Long format
      y[index] <- gamma00 + gamma01 * w1[i]  + u01[i] + gamma02 * w2[j] + u02[j] + (gamma10 + u1[j]) * x[i] + (gamma20 + u2[j]) * x2[i] + e[index]
      index <- index + 1
    }
  }
  
  dataFrame5 <- data.frame(y = y, subNo = factor(rep(1:numSub, each = numObj)), objNum = factor(rep(1:numObj, numSub)), x = x, x2 = x2)
  
  try(model5 <- lmer(y ~  x + 
                      x2 + 
                      (1 | subNo) + 
                      (1 | objNum) + 
                      (x2|subNo) +
                      (x|subNo), data = dataFrame5))
  
  corrResults[run] <- cor.test(coef(model5)$subNo$`(Intercept)`, gamma00 + mean(gamma01*w1 + u01) + gamma02*w2 + u02)$estimate
}

Even when increasing the number of subjects to 100, there were models that couldn’t be estimated or had every low correlations coefficients. See the histogram below for the distribution.

ggplot(data.frame(corrResults), aes(corrResults)) + geom_histogram() + theme(panel.margin = unit(1, "cm"), text = element_text(size = 12), plot.margin = margin(10, 10, 10, 10)) + 
        labs(y = 'Frequency', x = 'Correlation coefficients') + 
        coord_cartesian(xlim = c(0, 1), expand = FALSE)

Conclusion

All models except the last two can be estimated with a decent accuracy. The problem for the last two models is that on rare occasions the model fails to converge or the correlation coefficients for $\hat{\beta_{0.j}}$ and their true value is very low. At the moment, I don’t really know what to do about it.


Share