12.6 Práctica
Los problemas de práctica del Capítulo 12 le piden ajustar modelos multinivel, comparar estimados agrupados y no agrupados, y generar predicciones a posteriori para grupos nuevos.
Problemas fáciles
12E1. ¿Qué es el agrupamiento parcial? ¿En qué se diferencia del agrupamiento completo y del sin agrupamiento?
12E2. ¿Qué es el encogimiento? ¿Cuándo ocurre más?
12E3. ¿Cuál es la diferencia entre efectos aleatorios cruzados y anidados?
12E4. ¿Por qué las predicciones para grupos nuevos tienen incertidumbre más amplia que para grupos existentes?
Problemas medios
12M1. Ajuste un modelo multinivel a datos simulados. Compare los estimados sin agrupamiento, con agrupamiento parcial y con agrupamiento completo.
# 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. Ajuste un modelo multinivel con efectos aleatorios cruzados. Interprete los componentes de varianza.
# 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")Problemas difíciles
12H1. Simule datos multinivel con pendientes variables. Ajuste un modelo con interceptos aleatorios y pendientes aleatorias. Compare con un modelo de solo interceptos aleatorios.
# 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. Genere predicciones a posteriori para un grupo nuevo y compare la incertidumbre con las predicciones para un grupo existente.
12H3. Ajuste un modelo multinivel anidado con tres niveles. ¿Cómo se particiona la varianza entre niveles?