Plotting
Finally - you can plot the results marginalization to evaluate the effect of the random effect terms graphically.
One of the most common questions about multilevel models is how much influence grouping terms have on the outcome. One way to explore this is to simulate the predicted values of an observation across the distribution of random effects for a specific grouping variable and term. This can be described as “marginalizing” predictions over the distribution of random effects. This allows you to explore the influence of the grouping term and grouping levels on the outcome scale by simulating predictions for simulated values of each observation across the distribution of effect sizes.
The REmargins() function allows you to do this. Here, we take the example sleepstudy model and marginalize predictions for all of the random effect terms (Subject:Intercept, Subject:Days). By default, the function will marginalize over the quartiles of the expected rank (see expected rank vignette) of the effect distribution for each term.
fm1 <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy)
mfx <- REmargins(merMod = fm1, newdata = sleepstudy[1:10,])
head(mfx)
#> Reaction Days Subject case grouping_var term breaks
#> 1 249.56 0 309 1 Subject Intercept 1
#> 2 249.56 0 334 1 Subject Days 1
#> 3 249.56 0 350 1 Subject Intercept 2
#> 4 249.56 0 330 1 Subject Days 2
#> 5 249.56 0 308 1 Subject Intercept 3
#> 6 249.56 0 332 1 Subject Days 3
#> original_group_level fit_combined upr_combined lwr_combined fit_Subject
#> 1 308 211.6022 252.5443 177.4033 -40.220047
#> 2 308 244.4658 283.3303 207.5940 -7.471686
#> 3 308 237.1407 277.0037 201.7126 -15.712567
#> 4 308 276.0716 311.4830 239.3424 22.626852
#> 5 308 256.3923 292.7700 216.6426 3.815614
#> 6 308 262.6514 295.5489 224.5716 10.306149
#> upr_Subject lwr_Subject fit_fixed upr_fixed lwr_fixed
#> 1 -4.177672 -74.44036 249.3960 283.5701 215.7122
#> 2 29.913604 -45.58652 251.8809 286.7075 218.0804
#> 3 21.558164 -52.58777 250.4633 288.5282 216.1605
#> 4 59.942004 -14.46200 249.9996 285.5817 216.0925
#> 5 40.481303 -34.47880 252.2277 285.3248 217.0583
#> 6 48.049021 -28.16187 252.2168 286.4449 218.3318The new data frame output from REmargins contains a lot of information. The first few columns contain the original data passed to newdata. Each observation in newdata is identified by a case number, because the function repeats each observation by the number of random effect terms and number of breaks to simulate each term over. Then the grouping_var
Finally - you can plot the results marginalization to evaluate the effect of the random effect terms graphically.
Fitting (generalized) linear mixed models, (G)LMM, to very large data sets is becoming increasingly easy, but understanding and communicating the uncertainty inherent in those models is not. As the documentation for lme4::predict.merMod() notes:
There is no option for computing standard errors of predictions because it is difficult to define an efficient method that incorporates uncertainty in the variance parameters; we recommend
lme4::bootMer()for this task.
We agree that, short of a fully Bayesian analysis, bootstrapping is the gold-standard for deriving a prediction interval predictions from a (G)LMM, but the time required to obtain even a respectable number of replications from bootMer() quickly becomes prohibitive when the initial model fit is on the order of hours instead of seconds. The only other alternative we have identified for these situations is to use the arm::sim() function to simulate values. Unfortunately, this only takes variation of the fixed coefficients and residuals into account, and assumes the conditional modes of the random effects are fixed.
We developed the predictInterval() function to incorporate the variation in the conditional modes of the random effects (CMRE, a.k.a. BLUPs in the LMM case) into calculating prediction intervals. Ignoring the variance in the CMRE results in overly confident estimates of predicted values and in cases where the precision of the grouping term varies across levels of grouping terms, creates the illusion of difference where none may exist. The importance of accounting for this variance comes into play sharply when comparing the predictions of different models across observations.
We take the warning from lme4::predict.merMod() seriously, but view this method as a decent first approximation the full bootstrap analysis for (G)LMMs fit to very large data sets.
In order to generate a proper prediction interval, a prediction must account for three sources of uncertainty in mixed models:
A fourth, uncertainty about the data, is beyond the scope of any prediction method.
As we mentioned above, the arm:sim() function incorporates the first two sources of variation but not the third , while bootstrapping using lme4::bootMer() does incorporate all three sources of uncertainty because it re-estimates the model using random samples of the data.
When inference about the values of the CMREs is of interest, it would be nice to incorporate some degree of uncertainty in those estimates when comparing observations across groups. predictInterval() does this by drawing values of the CMREs from the conditional variance-covariance matrix of the random affects accessible from lme4::ranef(model, condVar=TRUE). Thus, predictInterval() incorporates all of the uncertainty from sources one and two, and part of the variance from source 3, but the variance parameters themselves are treated as fixed.
To do this, predictInterval() takes an estimated model of class merMod and, like predict(), a data.frame upon which to make those predictions and:
n draws from the multivariate normal distribution of the fixed and random coefficients (separately)newdata based on these draws, andarm::sim() function), and,Currently, the supported model types are linear mixed models and mixed logistic regression models.
The prediction data set can include levels that are not in the estimation model frame. The prediction intervals for such observations only incorporate uncertainty from fixed coefficient estimates and the residual level of variation.
What do the differences between predictInterval() and the other methods for constructing prediction intervals mean in practice? We would expect to see predictInterval() to produce prediction intervals that are wider than all methods except for the bootMer() method. We would also hope that the prediction point estimate from other methods falls within the prediction interval produced by predictInterval(). Ideally, the predicted point estimate produced by predictInterval() would fall close to that produced by bootMer().
This section compares the results of predictInterval() with those obtained using arm::sim() and lme4::bootMer() using the sleepstudy data from lme4. These data contain reaction time observations for 10 days on 18 subjects.
The data are sorted such that the first 10 observations are days one through ten for subject 1, the next 10 are days one through ten for subject 2 and so on. The example model that we are estimating below estimates random intercepts and a random slope for the number of days.
###Step 1: Estimating the model and using predictInterval()
First, we will load the required packages and data and estimate the model:
set.seed(271828)
data(sleepstudy)
fm1 <- lmer(Reaction ~ Days + (Days|Subject), data=sleepstudy)
display(fm1)
#> lmer(formula = Reaction ~ Days + (Days | Subject), data = sleepstudy)
#> coef.est coef.se
#> (Intercept) 251.41 6.82
#> Days 10.47 1.55
#>
#> Error terms:
#> Groups Name Std.Dev. Corr
#> Subject (Intercept) 24.74
#> Days 5.92 0.07
#> Residual 25.59
#> ---
#> number of obs: 180, groups: Subject, 18
#> AIC = 1755.6, DIC = 1760.3
#> deviance = 1751.9Then, calculate prediction intervals using predictInterval(). The predictInterval function has a number of user configurable options. In this example, we use the original data sleepstudy as the newdata. We pass the function the fm1 model we fit above. We also choose a 95% interval with level = 0.95, though we could choose a less conservative prediction interval. We make 1,000 simulations for each observation n.sims = 1000. We set the point estimate to be the median of the simulated values, instead of the mean. We ask for the linear predictor back, if we fit a logistic regression, we could have asked instead for our predictions on the probability scale instead. Finally, we indicate that we want the predictions to incorporate the residual variance from the model – an option only available for lmerMod objects.
PI.time <- system.time(
PI <- predictInterval(merMod = fm1, newdata = sleepstudy,
level = 0.95, n.sims = 1000,
stat = "median", type="linear.prediction",
include.resid.var = TRUE)
)Here is the first few rows of the object PI:
| fit | upr | lwr |
|---|---|---|
| 251.6679 | 311.3148 | 196.4089 |
| 271.4794 | 330.9183 | 214.2174 |
| 292.6803 | 350.9868 | 237.7709 |
| 311.6967 | 369.2907 | 254.2236 |
| 331.8317 | 389.7439 | 278.1873 |
| 350.7461 | 408.1392 | 294.8502 |
The three columns are the median (fit) and limits of the 95% prediction interval (upr and lwr) because we set level=0.95. The following figure displays the output graphically for the first 30 observations.
library(ggplot2);
ggplot(aes(x=1:30, y=fit, ymin=lwr, ymax=upr), data=PI[1:30,]) +
geom_point() +
geom_linerange() +
labs(x="Index", y="Prediction w/ 95% PI") + theme_bw()
The prediction intervals above do not correct for correlations between fixed and random effects. This tends to lead to predictive intervals that are too conservative, especially for existing groups when there is a lot of data on relatively few groups. In that case, a significant portion of the uncertainty in the prediction can be due to variance in the fixed intercept which is anti-correlated with variance in the random intercept effects. For instance, it does not actually matter if the fixed intercept is 5 and the random intercept effects are -2, 1, and 1, versus a fixed intercept of 6 and random intercept effects of -3, 0, and 0. (The latter situation will never be the MLE, but it can occur in this package’s simulations.)
To show this issue, we’ll use the sleep study model, predicting the reaction times of subjects after experiencing sleep deprivation:
fm1 <- lmer(Reaction ~ Days + (Days|Subject), data=sleepstudy)
display(fm1)
#> lmer(formula = Reaction ~ Days + (Days | Subject), data = sleepstudy)
#> coef.est coef.se
#> (Intercept) 251.41 6.82
#> Days 10.47 1.55
#>
#> Error terms:
#> Groups Name Std.Dev. Corr
#> Subject (Intercept) 24.74
#> Days 5.92 0.07
#> Residual 25.59
#> ---
#> number of obs: 180, groups: Subject, 18
#> AIC = 1755.6, DIC = 1760.3
#> deviance = 1751.9Let’s use the model to give an interval for the true average body fat of a large group of students like the first one in the study — a 196cm female baseball player:
sleepstudy[1,]
#> Reaction Days Subject
#> 1 249.56 0 308
predictInterval(fm1, sleepstudy[1,], include.resid.var=0) #predict the average body fat for a group of 196cm female baseball players
#> fit upr lwr
#> 1 253.997 270.7419 236.283There are two ways to get predictInterval to create less-conservative intervals to deal with this. The first is just to tell it to consider certain fixed effects as fully-known (that is, with an effectively 0 variance.) This is done using the ignore.fixed.effects argument.
predictInterval(fm1, sleepstudy[1,], include.resid.var=0, ignore.fixed.terms = 1)
#> fit upr lwr
#> 1 253.8527 268.5283 239.627
# predict the average reaction time for a subject at day 0, taking the global intercept
# (mean reaction time) as fully known
predictInterval(fm1, sleepstudy[1,], include.resid.var=0, ignore.fixed.terms = "(Intercept)")
#> fit upr lwr
#> 1 254.2344 269.3859 239.3111
#Same as above
predictInterval(fm1, sleepstudy[1,], include.resid.var=0, ignore.fixed.terms = 1:2)
#> fit upr lwr
#> 1 253.6733 269.8759 237.9836
# as above, taking the first two fixed effects (intercept and days effect) as fully knownThe second way is to use an ad-hoc variance adjustment, with the fix.intercept.variance argument. This takes the model’s intercept variance \(\hat\sigma^2_\mu\) and adjusts it to:
\[\hat\sigma\prime^2_\mu = \hat\sigma^2_\mu-\Sigma_{levels}\frac{1}{\Sigma_{groups(level)}1/(\hat\sigma^2_{level}+sigma^2_{group})}\]
In other words, it assumes the given intercept variance incorporates spurious variance for each level, where each of the spurious variance terms has a precision equal to the of the precisions due to the individual groups at that level.
predictInterval(fm1, sleepstudy[1,], include.resid.var=0,
fix.intercept.variance = TRUE)
#> fit upr lwr
#> 1 253.5861 268.8665 236.6637
# predict the average reaction time for a subject at day 0,, using an ad-hoc
# correction for the covariance of the intercept with the random intercept effects.A few notes about these two arguments:
fix.intercept.variance=T is redundant with ignore.fixed.effects=1, but not vice versa.arm::sim()How does the output above compare to what we could get from arm::sim()?
PI.arm.time <- system.time(
PI.arm.sims <- arm::sim(fm1, 1000)
)
PI.arm <- data.frame(
fit=apply(fitted(PI.arm.sims, fm1), 1, function(x) quantile(x, 0.500)),
upr=apply(fitted(PI.arm.sims, fm1), 1, function(x) quantile(x, 0.975)),
lwr=apply(fitted(PI.arm.sims, fm1), 1, function(x) quantile(x, 0.025))
)
comp.data <- rbind(data.frame(Predict.Method="predictInterval()", x=(1:nrow(PI))-0.1, PI),
data.frame(Predict.Method="arm::sim()", x=(1:nrow(PI.arm))+0.1, PI.arm))
ggplot(aes(x=x, y=fit, ymin=lwr, ymax=upr, color=Predict.Method), data=comp.data[c(1:30,181:210),]) +
geom_point() +
geom_linerange() +
labs(x="Index", y="Prediction w/ 95% PI") +
theme_bw() + theme(legend.position="bottom") +
scale_color_brewer(type = "qual", palette = 2)
The prediction intervals from arm:sim() are much smaller and the random slope for days vary more than they do for predictInterval. Both results are as expected, given the small number of subjects and observations per subject in these data. Because predictInterval() is incorporating uncertainty in the CMFEs (but not the variance parameters of the random coefficients themselves), the Days slopes are closer to the overall or pooled regression slope.
###Step 3: Comparison with lme4::bootMer()
As quoted above, the developers of lme4 suggest that users interested in uncertainty estimates around their predictions use lme4::bootmer() to calculate them. The documentation for lme4::bootMer() goes on to describe three implemented flavors of bootstrapped estimates:
We will compare the results from predictInterval() with each method, in turn.
lme4::bootMer() method 1##Functions for bootMer() and objects
####Return predicted values from bootstrap
mySumm <- function(.) {
predict(., newdata=sleepstudy, re.form=NULL)
}
####Collapse bootstrap into median, 95% PI
sumBoot <- function(merBoot) {
return(
data.frame(fit = apply(merBoot$t, 2, function(x) as.numeric(quantile(x, probs=.5, na.rm=TRUE))),
lwr = apply(merBoot$t, 2, function(x) as.numeric(quantile(x, probs=.025, na.rm=TRUE))),
upr = apply(merBoot$t, 2, function(x) as.numeric(quantile(x, probs=.975, na.rm=TRUE)))
)
)
}
##lme4::bootMer() method 1
PI.boot1.time <- system.time(
boot1 <- lme4::bootMer(fm1, mySumm, nsim=250, use.u=FALSE, type="parametric")
)
PI.boot1 <- sumBoot(boot1)
comp.data <- rbind(data.frame(Predict.Method="predictInterval()", x=(1:nrow(PI))-0.1, PI),
data.frame(Predict.Method="lme4::bootMer() - Method 1", x=(1:nrow(PI.boot1))+0.1, PI.boot1))
ggplot(aes(x=x, y=fit, ymin=lwr, ymax=upr, color=Predict.Method), data=comp.data[c(1:30,181:210),]) +
geom_point() +
geom_linerange() +
labs(x="Index", y="Prediction w/ 95% PI") +
theme_bw() + theme(legend.position="bottom") +
scale_color_brewer(type = "qual", palette = 2)
The intervals produced by predictInterval, represented in green, cover the point estimates produced by bootMer in every case for these 30 observations. Additionally, in almost every case, the predictInterval encompasses the entire interval presented by bootMer. Here, the estimates produced by bootMer are re-estimating the group terms, but by refitting the model, they are also taking into account the conditional variance of these terms, or theta, and provide tighter prediction intervals than the predictInterval method.
####Step 3b: lme4::bootMer() method 2
##lme4::bootMer() method 2
PI.boot2.time <- system.time(
boot2 <- lme4::bootMer(fm1, mySumm, nsim=250, use.u=TRUE, type="parametric")
)
PI.boot2 <- sumBoot(boot2)
comp.data <- rbind(data.frame(Predict.Method="predictInterval()", x=(1:nrow(PI))-0.1, PI),
data.frame(Predict.Method="lme4::bootMer() - Method 2", x=(1:nrow(PI.boot2))+0.1, PI.boot2))
ggplot(aes(x=x, y=fit, ymin=lwr, ymax=upr, color=Predict.Method), data=comp.data[c(1:30,181:210),]) +
geom_point() +
geom_linerange() +
labs(x="Index", y="Prediction w/ 95% PI") +
theme_bw() + theme(legend.position="bottom") +
scale_color_brewer(type = "qual", palette = 2)
Here, the results for predictInterval in green again encompass the results from bootMer, but are much wider. The bootMer estimates are ignoring the variance in the group effects, and as such, are only incorporating the residual variance and the variance in the fixed effects – similar to the arm::sim() function.
lme4::bootMer() method 3##lme4::bootMer() method 3
PI.boot3.time <- system.time(
boot3 <- lme4::bootMer(fm1, mySumm, nsim=250, use.u=TRUE, type="semiparametric")
)
PI.boot3 <- sumBoot(boot3)
comp.data <- rbind(data.frame(Predict.Method="predictInterval()", x=(1:nrow(PI))-0.1, PI),
data.frame(Predict.Method="lme4::bootMer() - Method 3", x=(1:nrow(PI.boot3))+0.1, PI.boot3))
ggplot(aes(x=x, y=fit, ymin=lwr, ymax=upr, color=Predict.Method), data=comp.data[c(1:30,181:210),]) +
geom_point() +
geom_linerange() +
labs(x="Index", y="Prediction w/ 95% PI") +
theme_bw() + theme(legend.position="bottom") +
scale_color_brewer(type = "qual", palette = 2)
These results are virtually identical to those above.
PI.time.stan <- system.time({
fm_stan <- stan_lmer(Reaction ~ Days + (Days|Subject), data = sleepstudy,
verbose = FALSE, open_progress = FALSE, refresh = -1,
show_messages=FALSE, chains = 1)
zed <- posterior_predict(fm_stan)
PI.stan <- cbind(apply(zed, 2, median), central_intervals(zed, prob=0.95))
})
#> Chain 1:
#> Chain 1: Gradient evaluation took 0 seconds
#> Chain 1: 1000 transitions using 10 leapfrog steps per transition would take 0 seconds.
#> Chain 1: Adjust your expectations accordingly!
#> Chain 1:
#> Chain 1:
#> Chain 1:
#> Chain 1: Elapsed Time: 6.919 seconds (Warm-up)
#> Chain 1: 3.744 seconds (Sampling)
#> Chain 1: 10.663 seconds (Total)
#> Chain 1:
print(fm_stan)
#> stan_lmer
#> family: gaussian [identity]
#> formula: Reaction ~ Days + (Days | Subject)
#> observations: 180
#> ------
#> Median MAD_SD
#> (Intercept) 251.9 6.3
#> Days 10.4 1.7
#>
#> Auxiliary parameter(s):
#> Median MAD_SD
#> sigma 25.9 1.5
#>
#> Error terms:
#> Groups Name Std.Dev. Corr
#> Subject (Intercept) 24
#> Days 7 0.07
#> Residual 26
#> Num. levels: Subject 18
#>
#> Sample avg. posterior predictive distribution of y:
#> Median MAD_SD
#> mean_PPD 298.5 2.8
#>
#> ------
#> * For help interpreting the printed output see ?print.stanreg
#> * For info on the priors used see ?prior_summary.stanreg
PI.stan <- as.data.frame(PI.stan)
names(PI.stan) <- c("fit", "lwr", "upr")
PI.stan <- PI.stan[, c("fit", "upr", "lwr")]
comp.data <- rbind(data.frame(Predict.Method="predictInterval()", x=(1:nrow(PI))-0.1, PI),
data.frame(Predict.Method="rstanArm", x=(1:nrow(PI.stan))+0.1, PI.stan))
ggplot(aes(x=x, y=fit, ymin=lwr, ymax=upr, color=Predict.Method), data=comp.data[c(1:30,181:210),]) +
geom_point() +
geom_linerange() +
labs(x="Index", y="Prediction w/ 95% PI") +
theme_bw() + theme(legend.position="bottom") +
scale_color_brewer(type = "qual", palette = 2)
Our initial motivation for writing this function was to develop a method for incorporating uncertainty in the CMFEs for mixed models estimated on very large samples. Even for models with only modest degrees of complexity, using lme4::bootMer() quickly becomes time prohibitive because it involves re-estimating the model for each simulation. We have seen how each alternative compares to predictInterval() substantively, but how do they compare in terms of computational time? The table below lists the output of system.time() for all five methods for calculating prediction intervals for merMod objects.
| user.self | sys.self | elapsed | |
|---|---|---|---|
| predictInterval() | 0.33 | 0.03 | 0.36 |
| arm::sim() | 0.64 | 0.00 | 0.64 |
| lme4::bootMer()-Method 1 | 5.46 | 0.00 | 5.47 |
| lme4::bootMer()-Method 2 | 5.50 | 0.00 | 5.50 |
| lme4::bootMer()-Method 3 | 5.54 | 0.00 | 5.53 |
| rstanarm:predict | 11.03 | 0.02 | 11.06 |
For this simple example, we see that arm::sim() is the fastest–nearly five times faster than predictInterval(). However, predictInterval() is nearly six times faster than any of the bootstrapping options via lme4::bootMer. This may not seem like a lot, but consider that the computational time for required for bootstrapping is roughly proportional to the number of bootstrapped simulations requested … predictInterval() is not because it is just a series of draws from various multivariate normal distributions, so the time ratios in the table below represents the lowest bound of the computation time ratio of bootstrapping to predictInterval().
TBC.
Multilevel models are valuable in a wide array of problem areas that involve non-experimental, or observational data. In many of these cases the data on individual observations may be incomplete. In these situations, the analyst may turn to one of many methods for filling in missing data depending on the specific problem at hand, disciplinary norms, and prior research.
One of the most common cases is to use multiple imputation. Multiple imputation involves fitting a model to the data and estimating the missing values for observations. For details on multiple imputation, and a discussion of some of the main implementations in R, look at the documentation and vignettes for the mice and Amelia packages.
The key difficulty multiple imputation creates for users of multilevel models is that the result of multiple imputation is K replicated datasets corresponding to different estimated values for the missing data in the original dataset.
For the purposes of this vignette, I will describe how to use one flavor of multiple imputation and the function in merTools to obtain estimates from a multilevel model in the presence of missing and multiply imputed data.
To demonstrate this workflow, we will use the hsb dataset in the merTools package which includes data on the math achievement of a wide sample of students nested within schools. The data has no missingness, so first we will simulate some missing data.
data(hsb)
# Create a function to randomly assign NA values
add_NA <- function(x, prob){
z <- rbinom(length(x), 1, prob = prob)
x[z==1] <- NA
return(x)
}
hsb$minority <- add_NA(hsb$minority, prob = 0.05)
table(is.na(hsb$minority))
#>
#> FALSE TRUE
#> 6836 349
hsb$female <- add_NA(hsb$female, prob = 0.05)
table(is.na(hsb$female))
#>
#> FALSE TRUE
#> 6830 355
hsb$ses <- add_NA(hsb$ses, prob = 0.05)
table(is.na(hsb$ses))
#>
#> FALSE TRUE
#> 6821 364
hsb$size <- add_NA(hsb$size, prob = 0.05)
table(is.na(hsb$size))
#>
#> FALSE TRUE
#> 6848 337# Load imputation library
library(Amelia)
# Declare the variables to include in the imputation data
varIndex <- names(hsb)
# Declare ID variables to be excluded from imputation
IDS <- c("schid", "meanses")
# Imputate
impute.out <- amelia(hsb[, varIndex], idvars = IDS,
noms = c("minority", "female"),
m = 5)
#> -- Imputation 1 --
#>
#> 1 2 3
#>
#> -- Imputation 2 --
#>
#> 1 2 3
#>
#> -- Imputation 3 --
#>
#> 1 2 3 4
#>
#> -- Imputation 4 --
#>
#> 1 2 3 4
#>
#> -- Imputation 5 --
#>
#> 1 2 3
summary(impute.out)
#>
#> Amelia output with 5 imputed datasets.
#> Return code: 1
#> Message: Normal EM convergence.
#>
#> Chain Lengths:
#> --------------
#> Imputation 1: 3
#> Imputation 2: 3
#> Imputation 3: 4
#> Imputation 4: 4
#> Imputation 5: 3
#>
#> Rows after Listwise Deletion: 5865
#> Rows after Imputation: 7185
#> Patterns of missingness in the data: 13
#>
#> Fraction Missing for original variables:
#> -----------------------------------------
#>
#> Fraction Missing
#> schid 0.00000000
#> minority 0.04857342
#> female 0.04940849
#> ses 0.05066110
#> mathach 0.00000000
#> size 0.04690327
#> schtype 0.00000000
#> meanses 0.00000000Fitting a model is very similar
fmla <- "mathach ~ minority + female + ses + meanses + (1 + ses|schid)"
mod <- lmer(fmla, data = hsb)
if(amelia_eval) {
modList <- lmerModList(fmla, data = impute.out$imputations)
} else {
# Use bootstrapped data instead
modList <- lmerModList(fmla, data = impute.out)
}
#> Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl =
#> control$checkConv, : Model failed to converge with max|grad| = 0.00243706
#> (tol = 0.002, component 1)The resulting object modList is a list of merMod objects the same length as the number of imputation datasets. This object is assigned the class of merModList and merTools provides some convenience functions for reporting the results of this object.
Using this, we can directly compare the model fit with missing data excluded to the aggregate from the imputed models:
fixef(mod) # model with dropped missing
#> (Intercept) minority female ses meanses
#> 14.042816 -2.701370 -1.182849 1.899924 2.992329
fixef(modList)
#> (Intercept) minority female ses meanses
#> 13.964580 -2.501642 -1.197021 1.930981 3.218819VarCorr(mod) # model with dropped missing
#> Groups Name Std.Dev. Corr
#> schid (Intercept) 1.53619
#> ses 0.64937 -0.566
#> Residual 6.00409
VarCorr(modList) # aggregate of imputed models
#> $stddev
#> $stddev$schid
#> (Intercept) ses
#> 1.5252886 0.6712887
#>
#>
#> $correlation
#> $correlation$schid
#> (Intercept) ses
#> (Intercept) 1.000000 -0.493787
#> ses -0.493787 1.000000If you want to inspect the individual models, or you do not like taking the mean across the imputation replications, you can take the merModList apart easily:
lapply(modList, fixef)
#> $imp1
#> (Intercept) minority female ses meanses
#> 13.963960 -2.506025 -1.187511 1.956362 3.176900
#>
#> $imp2
#> (Intercept) minority female ses meanses
#> 13.965839 -2.476253 -1.207036 1.941314 3.176969
#>
#> $imp3
#> (Intercept) minority female ses meanses
#> 13.968526 -2.573101 -1.172855 1.934888 3.206586
#>
#> $imp4
#> (Intercept) minority female ses meanses
#> 13.961077 -2.427355 -1.230145 1.927593 3.245608
#>
#> $imp5
#> (Intercept) minority female ses meanses
#> 13.963497 -2.525473 -1.187560 1.894750 3.288035And, you can always operate on any single element of the list:
print(modList)
#> $imp1
#> Linear mixed model fit by REML ['lmerMod']
#> Formula: mathach ~ minority + female + ses + meanses + (1 + ses | schid)
#> Data: d
#>
#> REML criterion at convergence: 46341.7
#>
#> Scaled residuals:
#> Min 1Q Median 3Q Max
#> -3.2121 -0.7269 0.0318 0.7616 2.9230
#>
#> Random effects:
#> Groups Name Variance Std.Dev. Corr
#> schid (Intercept) 2.3241 1.5245
#> ses 0.4518 0.6722 -0.45
#> Residual 35.7631 5.9802
#> Number of obs: 7185, groups: schid, 160
#>
#> Fixed effects:
#> Estimate Std. Error t value
#> (Intercept) 13.9640 0.1736 80.455
#> minority -2.5060 0.1983 -12.634
#> female -1.1875 0.1586 -7.489
#> ses 1.9564 0.1207 16.215
#> meanses 3.1769 0.3606 8.810
#>
#> Correlation of Fixed Effects:
#> (Intr) minrty female ses
#> minority -0.318
#> female -0.483 0.015
#> ses -0.200 0.140 0.043
#> meanses -0.091 0.121 0.023 -0.235
#>
#> $imp2
#> Linear mixed model fit by REML ['lmerMod']
#> Formula: mathach ~ minority + female + ses + meanses + (1 + ses | schid)
#> Data: d
#>
#> REML criterion at convergence: 46354.9
#>
#> Scaled residuals:
#> Min 1Q Median 3Q Max
#> -3.2035 -0.7211 0.0323 0.7596 2.9226
#>
#> Random effects:
#> Groups Name Variance Std.Dev. Corr
#> schid (Intercept) 2.3326 1.5273
#> ses 0.3909 0.6252 -0.52
#> Residual 35.8580 5.9882
#> Number of obs: 7185, groups: schid, 160
#>
#> Fixed effects:
#> Estimate Std. Error t value
#> (Intercept) 13.9658 0.1733 80.570
#> minority -2.4763 0.1993 -12.427
#> female -1.2070 0.1584 -7.620
#> ses 1.9413 0.1193 16.273
#> meanses 3.1770 0.3591 8.846
#>
#> Correlation of Fixed Effects:
#> (Intr) minrty female ses
#> minority -0.315
#> female -0.480 0.007
#> ses -0.211 0.140 0.038
#> meanses -0.096 0.124 0.023 -0.235
#> convergence code: 0
#> Model failed to converge with max|grad| = 0.00243706 (tol = 0.002, component 1)
#>
#>
#> $imp3
#> Linear mixed model fit by REML ['lmerMod']
#> Formula: mathach ~ minority + female + ses + meanses + (1 + ses | schid)
#> Data: d
#>
#> REML criterion at convergence: 46342.5
#>
#> Scaled residuals:
#> Min 1Q Median 3Q Max
#> -3.2214 -0.7222 0.0331 0.7602 2.9194
#>
#> Random effects:
#> Groups Name Variance Std.Dev. Corr
#> schid (Intercept) 2.3567 1.5352
#> ses 0.4808 0.6934 -0.46
#> Residual 35.7520 5.9793
#> Number of obs: 7185, groups: schid, 160
#>
#> Fixed effects:
#> Estimate Std. Error t value
#> (Intercept) 13.9685 0.1743 80.142
#> minority -2.5731 0.1987 -12.947
#> female -1.1729 0.1586 -7.393
#> ses 1.9349 0.1215 15.928
#> meanses 3.2066 0.3613 8.874
#>
#> Correlation of Fixed Effects:
#> (Intr) minrty female ses
#> minority -0.321
#> female -0.481 0.019
#> ses -0.208 0.138 0.042
#> meanses -0.093 0.123 0.025 -0.229
#>
#> $imp4
#> Linear mixed model fit by REML ['lmerMod']
#> Formula: mathach ~ minority + female + ses + meanses + (1 + ses | schid)
#> Data: d
#>
#> REML criterion at convergence: 46359.6
#>
#> Scaled residuals:
#> Min 1Q Median 3Q Max
#> -3.2097 -0.7245 0.0341 0.7595 2.9047
#>
#> Random effects:
#> Groups Name Variance Std.Dev. Corr
#> schid (Intercept) 2.3002 1.5166
#> ses 0.4605 0.6786 -0.51
#> Residual 35.8664 5.9889
#> Number of obs: 7185, groups: schid, 160
#>
#> Fixed effects:
#> Estimate Std. Error t value
#> (Intercept) 13.9611 0.1729 80.758
#> minority -2.4274 0.1981 -12.251
#> female -1.2301 0.1584 -7.765
#> ses 1.9276 0.1213 15.895
#> meanses 3.2456 0.3574 9.082
#>
#> Correlation of Fixed Effects:
#> (Intr) minrty female ses
#> minority -0.317
#> female -0.481 0.010
#> ses -0.219 0.140 0.037
#> meanses -0.095 0.121 0.022 -0.233
#>
#> $imp5
#> Linear mixed model fit by REML ['lmerMod']
#> Formula: mathach ~ minority + female + ses + meanses + (1 + ses | schid)
#> Data: d
#>
#> REML criterion at convergence: 46360.4
#>
#> Scaled residuals:
#> Min 1Q Median 3Q Max
#> -3.2003 -0.7248 0.0339 0.7606 2.9253
#>
#> Random effects:
#> Groups Name Variance Std.Dev. Corr
#> schid (Intercept) 2.3192 1.5229
#> ses 0.4721 0.6871 -0.54
#> Residual 35.8665 5.9889
#> Number of obs: 7185, groups: schid, 160
#>
#> Fixed effects:
#> Estimate Std. Error t value
#> (Intercept) 13.9635 0.1735 80.473
#> minority -2.5255 0.1980 -12.756
#> female -1.1876 0.1589 -7.472
#> ses 1.8948 0.1212 15.637
#> meanses 3.2880 0.3568 9.216
#>
#> Correlation of Fixed Effects:
#> (Intr) minrty female ses
#> minority -0.319
#> female -0.483 0.016
#> ses -0.233 0.138 0.043
#> meanses -0.097 0.118 0.023 -0.231summary(modList)
#> Warning in modelFixedEff(modList): Between imputation variance is very
#> small, are imputation sets too similar?
#> [1] "Linear mixed model fit by REML"
#> Model family:
#> lmer(formula = mathach ~ minority + female + ses + meanses +
#> (1 + ses | schid), data = d)
#>
#> Fixed Effects:
#> estimate std.error statistic df
#> (Intercept) 13.965 0.174 80.476 2.178458e+09
#> female -1.197 0.159 -7.525 4.567037e+05
#> meanses 3.219 0.361 8.910 1.078433e+05
#> minority -2.502 0.201 -12.425 2.002493e+04
#> ses 1.931 0.121 15.922 2.337436e+05
#>
#> Random Effects:
#>
#> Error Term Standard Deviations by Level:
#>
#> schid
#> (Intercept) ses
#> 1.525 0.671
#>
#>
#> Error Term Correlations:
#>
#> schid
#> (Intercept) ses
#> (Intercept) 1.000 -0.494
#> ses -0.494 1.000
#>
#>
#> Residual Error = 5.985
#>
#> ---Groups
#> number of obs: 7185, groups: schid, 160
#>
#> Model Fit Stats
#> AIC = 46369.8
#> Residual standard deviation = 5.985fastdisp(modList)
#> Warning in modelFixedEff(x): Between imputation variance is very small, are
#> imputation sets too similar?
#> lmer(formula = mathach ~ minority + female + ses + meanses +
#> (1 + ses | schid), data = d)
#> estimate std.error
#> (Intercept) 13.96 0.17
#> female -1.20 0.16
#> meanses 3.22 0.36
#> minority -2.50 0.20
#> ses 1.93 0.12
#>
#> Error terms:
#> Groups Name Std.Dev. Corr
#> schid (Intercept) 1.53
#> ses 0.67 -0.45
#> Residual 5.99
#> ---
#> number of obs: 7185, groups: schid, 160
#> AIC = 46369.8---The standard errors reported for the model list include a correction, Rubin’s correction (see documentation), which adjusts for the within and between imputation set variance as well.
modelRandEffStats(modList)
#> term group estimate std.error
#> 1 cor_(Intercept).ses.schid schid -0.4937870 0.040228230
#> 2 sd_(Intercept).schid schid 1.5252886 0.006762784
#> 3 sd_Observation.Residual Residual 5.9850808 0.004875255
#> 4 sd_ses.schid schid 0.6712887 0.026988611
modelFixedEff(modList)
#> Warning in modelFixedEff(modList): Between imputation variance is very
#> small, are imputation sets too similar?
#> term estimate std.error statistic df
#> 1 (Intercept) 13.964580 0.1735254 80.475705 2.178458e+09
#> 2 female -1.197021 0.1590628 -7.525465 4.567037e+05
#> 3 meanses 3.218819 0.3612399 8.910476 1.078433e+05
#> 4 minority -2.501642 0.2013395 -12.424990 2.002493e+04
#> 5 ses 1.930981 0.1212754 15.922281 2.337436e+05
VarCorr(modList)
#> $stddev
#> $stddev$schid
#> (Intercept) ses
#> 1.5252886 0.6712887
#>
#>
#> $correlation
#> $correlation$schid
#> (Intercept) ses
#> (Intercept) 1.000000 -0.493787
#> ses -0.493787 1.000000Let’s apply this to our model list.
lapply(modList, modelInfo)
#> $imp1
#> n.obs n.lvls AIC sigma
#> 1 7185 1 46359.69 5.980225
#>
#> $imp2
#> n.obs n.lvls AIC sigma
#> 1 7185 1 46372.89 5.988159
#>
#> $imp3
#> n.obs n.lvls AIC sigma
#> 1 7185 1 46360.52 5.979298
#>
#> $imp4
#> n.obs n.lvls AIC sigma
#> 1 7185 1 46377.55 5.988859
#>
#> $imp5
#> n.obs n.lvls AIC sigma
#> 1 7185 1 46378.4 5.988863summary(modList)
#> Warning in modelFixedEff(modList): Between imputation variance is very
#> small, are imputation sets too similar?
#> [1] "Linear mixed model fit by REML"
#> Model family:
#> lmer(formula = mathach ~ minority + female + ses + meanses +
#> (1 + ses | schid), data = d)
#>
#> Fixed Effects:
#> estimate std.error statistic df
#> (Intercept) 13.965 0.174 80.476 2.178458e+09
#> female -1.197 0.159 -7.525 4.567037e+05
#> meanses 3.219 0.361 8.910 1.078433e+05
#> minority -2.502 0.201 -12.425 2.002493e+04
#> ses 1.931 0.121 15.922 2.337436e+05
#>
#> Random Effects:
#>
#> Error Term Standard Deviations by Level:
#>
#> schid
#> (Intercept) ses
#> 1.525 0.671
#>
#>
#> Error Term Correlations:
#>
#> schid
#> (Intercept) ses
#> (Intercept) 1.000 -0.494
#> ses -0.494 1.000
#>
#>
#> Residual Error = 5.985
#>
#> ---Groups
#> number of obs: 7185, groups: schid, 160
#>
#> Model Fit Stats
#> AIC = 46369.8
#> Residual standard deviation = 5.985modelFixedEff(modList)
#> Warning in modelFixedEff(modList): Between imputation variance is very
#> small, are imputation sets too similar?
#> term estimate std.error statistic df
#> 1 (Intercept) 13.964580 0.1735254 80.475705 2.178458e+09
#> 2 female -1.197021 0.1590628 -7.525465 4.567037e+05
#> 3 meanses 3.218819 0.3612399 8.910476 1.078433e+05
#> 4 minority -2.501642 0.2013395 -12.424990 2.002493e+04
#> 5 ses 1.930981 0.1212754 15.922281 2.337436e+05ranef(modList)
#> $schid
#> (Intercept) ses
#> 1224 -1.399143e-01 0.0870214876
#> 1288 -2.029507e-02 0.0209930730
#> 1296 -1.387502e-01 -0.0089081897
#> 1308 9.060509e-02 -0.0457447758
#> 1317 6.838016e-02 -0.0366742092
#> 1358 -2.818154e-01 0.0923422578
#> 1374 -3.777665e-01 0.1339845395
#> 1433 2.725176e-01 -0.0060950439
#> 1436 2.525151e-01 -0.0222370416
#> 1461 -8.627395e-02 0.1483725160
#> 1462 3.233442e-01 -0.1333918276
#> 1477 4.567923e-02 -0.0432910687
#> 1499 -3.181307e-01 0.0955674324
#> 1637 -1.324880e-01 0.0331225424
#> 1906 4.681832e-02 -0.0137194805
#> 1909 -5.288305e-02 0.0323517862
#> 1942 1.966316e-01 -0.0404801434
#> 1946 -3.218928e-02 0.0721722386
#> 2030 -4.210847e-01 0.0250199864
#> 2208 -6.487192e-03 -0.0113346774
#> 2277 2.602357e-01 -0.2385197863
#> 2305 5.242570e-01 -0.2220979374
#> 2336 1.502060e-01 -0.0252668173
#> 2458 2.619321e-01 -0.0380037269
#> 2467 -2.416925e-01 0.0566945925
#> 2526 4.506364e-01 -0.1258336341
#> 2626 5.163045e-02 0.0327197223
#> 2629 3.403597e-01 -0.1159710875
#> 2639 6.473044e-02 -0.0779492331
#> 2651 -4.029183e-01 0.1139582321
#> 2655 6.596490e-01 -0.0621961389
#> 2658 -2.426720e-01 0.0449809087
#> 2755 1.460620e-01 -0.0819997261
#> 2768 -2.479582e-01 0.0848581743
#> 2771 4.371219e-02 0.0430727123
#> 2818 -4.491828e-03 0.0070114057
#> 2917 1.281104e-01 -0.0882143551
#> 2990 4.588319e-01 -0.0710915178
#> 2995 -2.574655e-01 -0.0069496065
#> 3013 -9.979640e-02 0.0495740012
#> 3020 8.354564e-02 -0.0436842394
#> 3039 2.283791e-01 -0.0096086898
#> 3088 -5.936495e-02 -0.0197989752
#> 3152 -3.574201e-02 0.0510562127
#> 3332 -2.514696e-01 0.0054341215
#> 3351 -3.753715e-01 -0.0329565944
#> 3377 1.119774e-01 -0.1241045407
#> 3427 8.509779e-01 -0.2159736932
#> 3498 1.405609e-02 -0.0601425130
#> 3499 -1.526413e-01 -0.0273713481
#> 3533 -1.978000e-01 -0.0130213455
#> 3610 3.139802e-01 -0.0015413182
#> 3657 -5.009415e-02 0.0910862871
#> 3688 8.387615e-03 -0.0300259707
#> 3705 -4.243127e-01 0.0006643509
#> 3716 7.620130e-02 0.0997516459
#> 3838 4.796080e-01 -0.1452775785
#> 3881 -2.859155e-01 0.0525682107
#> 3967 -5.528114e-02 0.0258997861
#> 3992 8.982978e-02 -0.0669851638
#> 3999 -7.807423e-02 0.0796825045
#> 4042 -1.629962e-01 -0.0013027027
#> 4173 -9.154334e-02 0.0481256404
#> 4223 2.919159e-01 -0.0600704384
#> 4253 -5.245953e-02 -0.1001175394
#> 4292 4.824264e-01 -0.1522695765
#> 4325 4.322369e-02 0.0219917820
#> 4350 -3.022826e-01 0.1152436365
#> 4383 -2.289804e-01 0.0816705223
#> 4410 -8.603032e-02 0.0456840195
#> 4420 1.928974e-01 0.0036406506
#> 4458 -4.177671e-02 -0.0242913321
#> 4511 2.382551e-01 -0.1070728572
#> 4523 -2.528129e-01 0.0607102350
#> 4530 5.363988e-02 -0.0206005365
#> 4642 1.198211e-01 0.0235413874
#> 4868 -2.452905e-01 -0.0323862227
#> 4931 -2.106879e-01 0.0296440221
#> 5192 -2.470670e-01 0.0316924716
#> 5404 -2.158925e-01 0.0305173800
#> 5619 -9.054503e-02 0.0949872291
#> 5640 8.676281e-02 0.0449915016
#> 5650 4.793208e-01 -0.1094774343
#> 5667 -2.832204e-01 0.0809240482
#> 5720 1.187385e-01 -0.0044879297
#> 5761 1.462343e-01 0.0108107176
#> 5762 -9.120342e-02 -0.0121329368
#> 5783 -6.455325e-02 0.0117745684
#> 5815 -1.909420e-01 0.0520751759
#> 5819 -3.427290e-01 0.0567897107
#> 5838 -4.330172e-02 0.0046177020
#> 5937 7.015990e-02 -0.0396161585
#> 6074 3.803140e-01 -0.0948826088
#> 6089 2.679939e-01 -0.0767274494
#> 6144 -2.800829e-01 0.0956555049
#> 6170 3.302820e-01 0.0011430677
#> 6291 2.019763e-01 -0.0138928506
#> 6366 1.969135e-01 -0.0448172553
#> 6397 1.875132e-01 -0.0495921582
#> 6415 -6.722504e-02 0.0665583112
#> 6443 -9.745699e-02 -0.0649203444
#> 6464 -4.715221e-02 -0.0137902909
#> 6469 2.976060e-01 -0.0506326255
#> 6484 9.621267e-02 -0.0539022742
#> 6578 3.299875e-01 -0.0731955878
#> 6600 -2.046091e-01 0.1556103932
#> 6808 -3.354575e-01 0.0366785359
#> 6816 2.075283e-01 -0.0841527359
#> 6897 2.875746e-02 0.0586708937
#> 6990 -3.389251e-01 -0.0032399959
#> 7011 5.528705e-02 0.0536884735
#> 7101 -1.317326e-01 -0.0055698337
#> 7172 -2.069157e-01 0.0215594869
#> 7232 -7.958129e-05 0.0700562217
#> 7276 -9.220686e-02 0.0705751886
#> 7332 4.078184e-02 0.0078698866
#> 7341 -2.906345e-01 0.0166689706
#> 7342 7.117216e-02 -0.0372525742
#> 7345 -2.484831e-01 0.1256428877
#> 7364 2.631941e-01 -0.0759474691
#> 7635 6.735063e-02 -0.0217257133
#> 7688 6.103311e-01 -0.1487600362
#> 7697 1.274315e-01 0.0188445088
#> 7734 5.924014e-02 0.0759096078
#> 7890 -3.085090e-01 0.0055988603
#> 7919 -1.316053e-01 0.1101965917
#> 8009 -2.093561e-01 -0.0450702852
#> 8150 1.005283e-01 -0.0757109662
#> 8165 1.738215e-01 -0.0279922313
#> 8175 1.141732e-01 -0.0476553823
#> 8188 -1.195179e-01 0.0719283103
#> 8193 5.708359e-01 -0.1110466009
#> 8202 -2.154225e-01 0.0568820672
#> 8357 1.779093e-01 -0.0170305658
#> 8367 -7.875384e-01 0.1151473352
#> 8477 7.698661e-02 0.0415470127
#> 8531 -2.223920e-01 0.0896911258
#> 8627 -4.182078e-01 0.0659411775
#> 8628 6.084020e-01 -0.1199329555
#> 8707 -9.115985e-02 0.0405670753
#> 8775 -2.215740e-01 0.0101264628
#> 8800 1.251331e-02 0.0069438812
#> 8854 -6.080997e-01 0.1551850607
#> 8857 2.188157e-01 -0.0623912476
#> 8874 1.881203e-01 0.0103110946
#> 8946 -1.465414e-01 0.0047247713
#> 8983 -1.357560e-01 -0.0179624690
#> 9021 -2.605620e-01 0.0254248923
#> 9104 -1.435123e-02 -0.0125625455
#> 9158 -2.798127e-01 0.1137418200
#> 9198 3.129854e-01 -0.0053483729
#> 9225 2.369962e-02 0.0687819911
#> 9292 2.473993e-01 -0.0701204152
#> 9340 -8.268410e-03 0.0286591632
#> 9347 -3.581963e-02 0.0499939562
#> 9359 -2.904600e-02 -0.0609316001
#> 9397 -4.930650e-01 0.1161492623
#> 9508 9.560210e-02 0.0150385488
#> 9550 -2.461625e-01 0.0770399294
#> 9586 -1.196654e-01 -0.0271003565Often it is desirable to include aggregate values in the level two or level three part of the model such as level 1 SES and level 2 mean SES for the group. In cases where there is missingness in either the level 1 SES values, or in the level 2 mean SES values, caution and careful thought need to be given to how to proceed with the imputation routine.
Working with generalized linear mixed models (GLMM) and linear mixed models (LMM) has become increasingly easy with the advances in the lme4 package recently. As we have found ourselves using these models more and more within our work, we, the authors, have developed a set of tools for simplifying and speeding up common tasks for interacting with merMod objects from lme4. This package provides those tools.
As the complexity of the model fit grows, it becomes harder and harder to interpret the substantive effect of parameters in the model.
Let’s start with a medium-sized example model using the InstEval data provided by the lme4 package. These data represent university lecture evaluations at ETH Zurich made by students. In this data, s is an individual student, d is an individual lecturer, studage is the semester the student is enrolled, lectage is how many semesters back the lecture with the rating took place, dept is the department of the lecture, and y is an integer 1:5 representing the ratings of the lecture from “poor” to “very good”:
library(lme4)
head(InstEval)
#> s d studage lectage service dept y
#> 1 1 1002 2 2 0 2 5
#> 2 1 1050 2 1 1 6 2
#> 3 1 1582 2 2 0 2 5
#> 4 1 2050 2 2 1 3 3
#> 5 2 115 2 1 0 5 2
#> 6 2 756 2 1 0 5 4
str(InstEval)
#> 'data.frame': 73421 obs. of 7 variables:
#> $ s : Factor w/ 2972 levels "1","2","3","4",..: 1 1 1 1 2 2 3 3 3 3 ...
#> $ d : Factor w/ 1128 levels "1","6","7","8",..: 525 560 832 1068 62 406 3 6 19 75 ...
#> $ studage: Ord.factor w/ 4 levels "2"<"4"<"6"<"8": 1 1 1 1 1 1 1 1 1 1 ...
#> $ lectage: Ord.factor w/ 6 levels "1"<"2"<"3"<"4"<..: 2 1 2 2 1 1 1 1 1 1 ...
#> $ service: Factor w/ 2 levels "0","1": 1 2 1 2 1 1 2 1 1 1 ...
#> $ dept : Factor w/ 14 levels "15","5","10",..: 14 5 14 12 2 2 13 3 3 3 ...
#> $ y : int 5 2 5 3 2 4 4 5 5 4 ...Starting with a simple model:
After fitting the model we can make use of the first function provided by merTools, fastdisp which modifies the function arm:::display to more quickly display a summary of the model without calculating the model sigma:
library(merTools)
fastdisp(m1)
#> lmer(formula = y ~ service + lectage + studage + (1 | d) + (1 |
#> s), data = InstEval)
#> coef.est coef.se
#> (Intercept) 3.22 0.02
#> service1 -0.07 0.01
#> lectage.L -0.19 0.02
#> lectage.Q 0.02 0.01
#> lectage.C -0.02 0.01
#> lectage^4 -0.02 0.01
#> lectage^5 -0.04 0.02
#> studage.L 0.10 0.02
#> studage.Q 0.01 0.02
#> studage.C 0.02 0.02
#>
#> Error terms:
#> Groups Name Std.Dev.
#> s (Intercept) 0.33
#> d (Intercept) 0.52
#> Residual 1.18
#> ---
#> number of obs: 73421, groups: s, 2972; d, 1128
#> AIC = 237655We see some interesting effects. First, our decision to include student and lecturer effects seems justified as there is substantial variance within these groups. Second, there do appear to be some effects by age and for lectures given as a service by an outside lecturer. Let’s look at these in more detail. One way to do this would be to plot the coefficients together in a line to see which deviate from 0 and in what direction. To get a confidence interval for our fixed effect coefficients we have a number of options that represent a tradeoff between coverage and computation time – see confint.merMod for details.
An alternative is to simulate values of the fixed effects from the posterior using the function arm::sim. Our next tool, FEsim, is a convenience wrapper to do this and provide an informative data frame of the results.
feEx <- FEsim(m1, 1000)
cbind(feEx[,1] , round(feEx[, 2:4], 3))
#> feEx[, 1] mean median sd
#> 1 (Intercept) 3.224 3.223 0.020
#> 2 service1 -0.071 -0.071 0.013
#> 3 lectage.L -0.187 -0.186 0.016
#> 4 lectage.Q 0.024 0.024 0.012
#> 5 lectage.C -0.024 -0.024 0.013
#> 6 lectage^4 -0.020 -0.021 0.014
#> 7 lectage^5 -0.039 -0.039 0.015
#> 8 studage.L 0.096 0.096 0.019
#> 9 studage.Q 0.006 0.006 0.016
#> 10 studage.C 0.017 0.017 0.016We can present these results graphically, using ggplot2:
library(ggplot2)
ggplot(feEx[feEx$term!= "(Intercept)", ]) +
aes(x = term, ymin = median - 1.96 * sd,
ymax = median + 1.96 * sd, y = median) +
geom_pointrange() +
geom_hline(yintercept = 0, size = I(1.1), color = I("red")) +
coord_flip() +
theme_bw() + labs(title = "Coefficient Plot of InstEval Model",
x = "Median Effect Estimate", y = "Evaluation Rating")
However, an easier option is:
plotFEsim(feEx) +
theme_bw() + labs(title = "Coefficient Plot of InstEval Model",
x = "Median Effect Estimate", y = "Evaluation Rating")
Next, we might be interested in exploring the random effects. Again, we create a dataframe of the values of the simulation of these effects for the individual levels.
reEx <- REsim(m1)
head(reEx)
#> groupFctr groupID term mean median sd
#> 1 s 1 (Intercept) 0.20126170 0.19775791 0.3009069
#> 2 s 2 (Intercept) -0.08231243 -0.05911867 0.3174702
#> 3 s 3 (Intercept) 0.28136487 0.27231003 0.3022773
#> 4 s 4 (Intercept) 0.22734481 0.21679242 0.2961077
#> 5 s 5 (Intercept) 0.06441259 0.06801963 0.3021177
#> 6 s 6 (Intercept) 0.11114881 0.11499146 0.2226471The result is a dataframe with estimates of the values of each of the random effects provided by the arm::sim() function. groupID represents the identfiable level for the variable for one random effect, term represents whether the simulated values are for an intercept or which slope, and groupFctr identifies which of the (1|x) terms the values represent. To make unique identifiers for each term, we need to use both the groupID and the groupFctr term in case these two variables use overlapping label names for their groups. In this case:
Most important is producing caterpillar or dotplots of these terms to explore their variation. This is easily accomplished with the dotplot function:
However, these graphics do not provide much control over the results. Instead, we can use the plotREsim function in merTools to gain more control over plotting of the random effect simulations.
The result is a ggplot2 object which can be modified however the user sees fit. Here, we’ve established that most student and professor effects are indistinguishable from zero, but there do exist extreme outliers with both high and low averages that need to be accounted for.
A logical next line of questioning is to see how much of the variation in a rating can be caused by changing the student rater and how much is due to the fixed effects we identified above. This is a very difficult problem to solve, but using simulation we can examine the model behavior under a range of scenarios to understand how the model is reflecting changes in the data. To do this, we use another set of functions available in merTools.
The simplest option is to pick an observation at random and then modify its values deliberately to see how the prediction changes in response. merTools makes this task very simple:
example1 <- draw(m1, type = 'random')
head(example1)
#> y service lectage studage d s
#> 71529 2 0 3 6 1306 2903The draw function takes a random observation from the data in the model and extracts it as a dataframe. We can now do a number of operations to this observation:
# predict it
predict(m1, newdata = example1)
#> 71529
#> 2.815463
# change values
example1$service <- "1"
predict(m1, newdata = example1)
#> 71529
#> 2.744619More interesting, let’s programatically modify this observation to see how the predicted value changes if we hold everything but one variable constant.
example2 <- wiggle(example1, varlist = "lectage",
valueslist = list(c("1", "2", "3", "4", "5", "6")))
example2
#> y service lectage studage d s
#> 71529 2 1 1 6 1306 2903
#> 715291 2 1 2 6 1306 2903
#> 715292 2 1 3 6 1306 2903
#> 715293 2 1 4 6 1306 2903
#> 715294 2 1 5 6 1306 2903
#> 715295 2 1 6 6 1306 2903The function wiggle allows us to create a new dataframe with copies of the variable that modify just one value. Chaining together wiggle calls, we can see how the variable behaves under a number of different scenarios simultaneously.
example2$yhat <- predict(m1, newdata = example2)
ggplot(example2, aes(x = lectage, y = yhat)) + geom_line(aes(group = 1)) +
theme_bw() + ylim(c(1, 5)) +
geom_hline(yintercept = mean(InstEval$y), linetype = 2) +
geom_hline(yintercept = mean(InstEval$y) + sd(InstEval$y), linetype = 3) +
geom_hline(yintercept = mean(InstEval$y) - sd(InstEval$y), linetype = 3)
The result allows us to graphically display the effect of each level of lectage on an observation that is otherwise identical. This is plotted here against a horizontal line representing the mean of the observed ratings, and two finer lines showing plus or minus one standard deviation of the mean.
This is nice, but selecting a random observation is not very satisfying as it may not be very meaningful. To address this, we can instead take the average observation:
example3 <- draw(m1, type = 'average')
example3
#> y service lectage studage d s
#> 1 3.205745 0 1 6 1510 2237Here, the average observation is identified based on either the modal observation for factors or on the mean for numeric variables. Then, the random effect terms are set to the level equivalent to the median effect – very close to 0.
example3 <- wiggle(example1, varlist = "service",
valueslist = list(c("0", "1")))
example3$yhat <- predict(m1, newdata = example3)
ggplot(example3, aes(x = service, y = yhat)) + geom_line(aes(group = 1)) +
theme_bw() + ylim(c(1, 5)) +
geom_hline(yintercept = mean(InstEval$y), linetype = 2) +
geom_hline(yintercept = mean(InstEval$y) + sd(InstEval$y), linetype = 3) +
geom_hline(yintercept = mean(InstEval$y) - sd(InstEval$y), linetype = 3)
Here we can see that for the average observation, whether the lecture is outside of the home department has a very slight negative effect on the overall rating. Might the individual professor or student have more of an impact on the overall rating? To answer this question we need to wiggle the same observation across a wide range of student or lecturer effects.
How do we identify this range? merTools provides the REquantile function which helps to identify which levels of the grouping terms correspond to which quantile of the magnitude of the random effects:
REquantile(m1, quantile = 0.25, groupFctr = "s")
#> [1] "446"
REquantile(m1, quantile = 0.25, groupFctr = "d")
#> [1] "18"Here we can see that group level 446 corresponds to the 25th percentile of the effect for the student groups, and level REquantile(m1, quantile = 0.25, groupFctr = "d") corresponds to the 25th percentile for the instructor group. Using this information we can reassign a specific observation to varying magnitudes of grouping term effects to see how much they might influence our final prediction.
example4 <- draw(m1, type = 'average')
example4 <- wiggle(example4, varlist = "s",
list(REquantile(m1, quantile = seq(0.1, 0.9, .1),
groupFctr = "s")))
example4$yhat <- predict(m1, newdata = example4)
ggplot(example4, aes(x = reorder(s, -yhat), y = yhat)) +
geom_line(aes(group = 1)) +
theme_bw() + ylim(c(1, 5)) +
geom_hline(yintercept = mean(InstEval$y), linetype = 2) +
geom_hline(yintercept = mean(InstEval$y) + sd(InstEval$y), linetype = 3) +
geom_hline(yintercept = mean(InstEval$y) - sd(InstEval$y), linetype = 3)
This figure is very interesting because it shows that moving across the range of student effects can have a larger impact on the score than the fixed effects we observed above. That is, getting a “generous” or a “stingy” rater can have a substantial impact on the final rating.
But, we can do even better. First, we can move beyond the average observation by taking advantage of the varList option to the function which allows us to specify a subset of the data to compute an average for.
subExample <- list(studage = "2", lectage = "4")
example5 <- draw(m1, type = 'average', varList = subExample)
example5
#> y service lectage studage d s
#> 1 3.087193 0 4 2 1510 2237Now we have the average observation with a student age of 2 and a lecture age of 4. We can then follow the same procedure as before to explore the effects on our subsamples. Before we do that, let’s fit a slightly more complex model that includes a random slope.
data(VerbAgg)
m2 <- glmer(r2 ~ Anger + Gender + btype + situ +
(1|id) + (1 + Gender|item), family = binomial,
data = VerbAgg)
#> Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl =
#> control$checkConv, : Model failed to converge with max|grad| = 0.0071146
#> (tol = 0.001, component 1)
example6 <- draw(m2, type = 'average', varList = list("id" = "149"))
example6$btype <- "scold"
example6$situ <- "self"
tempdf <- wiggle(example6, varlist = "Gender", list(c("M", "F")))
tempdf <- wiggle(tempdf, varlist = "item",
list(unique(VerbAgg$item)))
tempdf$yhat <- predict(m2, newdata = tempdf, type = "response",
allow.new.levels = TRUE)
ggplot(tempdf, aes(x = item, y = yhat, group = Gender)) +
geom_line(aes(color = Gender))+
theme_bw() + ylim(c(0, 1)) +
theme(axis.text.x = element_text(angle = 20, hjust=1),
legend.position = "bottom") + labs(x = "Item", y = "Probability")
Here we’ve shown that the effect of both the intercept and the gender slope on item simultaneously affect our predicted value. This results in the two lines for predicted values across the items not being parallel. While we can see this by looking at the results of the summary of the model object, using fastdisp
in the merTools package for larger models, it is not intuitive what that effect looks like across different scenarios. merTools has given us the machinery to investigate this.
The above examples make use of simulation to show the model behavior after changing some values in a dataset. However, until now, we’ve focused on using point estimates to represent these changes. The use of predicted point estimates without incorporating any uncertainty can lead to overconfidence in the precision of the model.
In the predictInterval function, discussed in more detail in another package vignette, we provide a way to incorporate three out of the four types of uncertainty inherent in a model. These are:
1-3 are incorporated in the results of predictInterval, while capturing 4 would require making use of the bootMer function – options discussed in greater detail elsewhere. The main advantage of predictInterval is that it is fast. By leveraging the power of the arm::sim() function, we are able to generate prediction intervals for individual observations from very large models very quickly. And, it works a lot like predict:
exampPreds <- predictInterval(m2, newdata = tempdf,
type = "probability", level = 0.8)
tempdf <- cbind(tempdf, exampPreds)
ggplot(tempdf, aes(x = item, y = fit, ymin = lwr, ymax = upr,
group = Gender)) +
geom_ribbon(aes(fill = Gender), alpha = I(0.2), color = I("black"))+
theme_bw() + ylim(c(0, 1)) +
theme(axis.text.x = element_text(angle = 20),
legend.position = "bottom")+ labs(x = "Item", y = "Probability")
Here we can see there is barely any gender difference in terms of area of potential prediction intervals. However, by default, this approach includes the residual variance of the model. If we instead focus just on the uncertainty of the random and fixed effects, we get:
exampPreds <- predictInterval(m2, newdata = tempdf,
type = "probability",
include.resid.var = FALSE, level = 0.8)
tempdf <- cbind(tempdf[, 1:8], exampPreds)
ggplot(tempdf, aes(x = item, y = fit, ymin = lwr, ymax = upr,
group = Gender)) +
geom_ribbon(aes(fill = Gender), alpha = I(0.2), color = I("black"))+
geom_line(aes(color = Gender)) +
theme_bw() + ylim(c(0, 1)) +
theme(axis.text.x = element_text(angle = 20),
legend.position = "bottom") + labs(x = "Item", y = "Probability")
Here, more difference emerges, but we see that the differences are not very precise.