12.6 Practice
The practice problems for Chapter 12 ask you to fit multilevel models, compare pooled and unpooled estimates, and generate posterior predictions for new groups.
Easy problems
12E1. What is partial pooling? How does it differ from complete pooling and no pooling?
12E2. What is shrinkage? When does it happen more?
12E3. What is the difference between crossed and nested random effects?
12E4. Why do new-group predictions have wider uncertainty than existing-group predictions?
Medium problems
12M1. Fit a multilevel model to simulated data. Compare no-pooling, partial-pooling, and complete-pooling estimates.
# 12M1: Compare pooling strategies
set.seed(42)
n_groups <- 15
group_sizes <- sample(c(5, 10, 20, 40), n_groups, replace = TRUE)
true_means <- rnorm(n_groups, 5, 1.5)
data_list <- lapply(1:n_groups, function(j) {
rnorm(group_sizes[j], true_means[j], 2)
})
no_pool <- sapply(data_list, mean)
complete_pool <- mean(unlist(data_list))
# Partial pooling via lmer
library(lme4)
d <- do.call(rbind, lapply(1:n_groups, function(j) {
data.frame(group = factor(j), y = data_list[[j]])
}))
m <- lmer(y ~ (1 | group), data = d)
partial_pool <- fixef(m)[1] + ranef(m)$group[, 1]
cat("Pooling comparison:\n")
cat(" Group n True No-pool Partial Complete\n")
for (j in 1:min(8, n_groups)) {
cat(sprintf(" %5d %2d %5.2f %7.2f %7.2f %7.2f\n",
j, group_sizes[j], true_means[j],
no_pool[j], partial_pool[j], complete_pool))
}
mse_n <- mean((no_pool - true_means)^2)
mse_p <- mean((partial_pool - true_means)^2)
mse_c <- mean((rep(complete_pool, n_groups) - true_means)^2)
cat("\n MSE: No-pool=%.3f Partial=%.3f Complete=%.3f\n", mse_n, mse_p, mse_c)12M2. Fit a multilevel model with crossed random effects. Interpret the variance components.
# 12M2: Crossed random effects
set.seed(42)
n_a <- 8 # actors
n_b <- 6 # blocks
n <- 100
actor <- sample(1:n_a, n, replace = TRUE)
block <- sample(1:n_b, n, replace = TRUE)
x <- runif(n, 0, 5)
a_actor <- rnorm(n_a, 0, 1.2)
a_block <- rnorm(n_b, 0, 0.6)
y <- 2 + a_actor[actor] + a_block[block] + 0.5 * x + rnorm(n, 0, 1)
d <- data.frame(actor = factor(actor), block = factor(block), x = x, y = y)
library(lme4)
m <- lmer(y ~ x + (1 | actor) + (1 | block), data = d)
cat("Crossed multilevel model:\n")
cat(" Fixed: intercept =", round(fixef(m)[1], 3),
" x =", round(fixef(m)[2], 3), "\n")
cat(" Random SD: actor =", round(attr(VarCorr(m)$actor, "stddev"), 3),
" block =", round(attr(VarCorr(m)$block, "stddev"), 3), "\n")
cat(" Residual SD:", round(attr(VarCorr(m), "sc"), 3), "\n")Hard problems
12H1. Simulate multilevel data with varying slopes. Fit a model with random intercepts and random slopes. Compare to a model with only random intercepts.
# 12H1: Varying slopes multilevel model
set.seed(42)
n_groups <- 10
group_sizes <- rep(30, n_groups)
# Varying intercepts and slopes
a_bar <- 1
sigma_a <- 1.5
sigma_b <- 0.5
a_group <- rnorm(n_groups, 0, sigma_a)
b_group <- rnorm(n_groups, 0, sigma_b)
d <- do.call(rbind, lapply(1:n_groups, function(j) {
x <- runif(group_sizes[j], 0, 10)
y <- a_bar + a_group[j] + (0.3 + b_group[j]) * x + rnorm(group_sizes[j], 0, 1)
data.frame(group = factor(j), x = x, y = y)
}))
library(lme4)
# Random intercepts only
m_int <- lmer(y ~ x + (1 | group), data = d)
# Random intercepts and slopes
m_both <- lmer(y ~ x + (1 + x | group), data = d)
cat("Random intercepts only:\n")
cat(" x:", round(fixef(m_int)[2], 3), " AIC:", round(AIC(m_int), 1), "\n")
cat("\nRandom intercepts + slopes:\n")
cat(" x:", round(fixef(m_both)[2], 3), " AIC:", round(AIC(m_both), 1), "\n")
cat(" SD intercept:", round(attr(VarCorr(m_both)$group, "stddev")[1], 3), "\n")
cat(" SD slope: ", round(attr(VarCorr(m_both)$group, "stddev")[2], 3), "\n")
cat(" Correlation: ", round(attr(VarCorr(m_both)$group, "correlation")[1, 2], 3), "\n")
cat("\n AIC comparison: varying slopes",
ifelse(AIC(m_both) < AIC(m_int), "preferred", "not needed"), "\n")12H2. Generate posterior predictions for a new group and compare the uncertainty to predictions for an existing group.
12H3. Fit a nested multilevel model with three levels. How does the variance partition across levels?