12.2 Efectos variables y el balance subajuste/sobreajuste

Los efectos variables balancean el subajuste y el sobreajuste. El agrupamiento completo asume que todos los grupos son idénticos; el sin agrupamiento estima cada grupo independientemente. El agrupamiento parcial es el compromiso.

12.2.1 Tres estrategias de agrupamiento

Agrupamiento completo: Ignora las diferencias entre grupos. Un estimado para todos los grupos. Subajusta — pierde la variación real entre grupos.
Sin agrupamiento: Cada grupo se estima independientemente. Sobreajusta — estimados ruidosos para grupos pequeños.
Agrupamiento parcial: Los estimados de grupo se extraen de una distribución común. Balancea — encoge hacia la media, con más encogimiento para grupos pequeños.

El estimado de agrupamiento parcial para el grupo $j$ es:

$\hat{\gamma}_j = \frac{\sigma_\gamma^2}{\sigma_\gamma^2 + \sigma_y^2/n_j} \bar{y}_j + \frac{\sigma_y^2/n_j}{\sigma_\gamma^2 + \sigma_y^2/n_j} \bar{y}$

El peso sobre la media del grupo $\bar{y}_j$ aumenta con $n_j$ (más datos) y $\sigma_\gamma^2$ (más variación entre grupos).

# Demonstrate the three pooling strategies
set.seed(42)
n_groups <- 20
group_sizes <- sample(c(5, 10, 25, 50), n_groups, replace = TRUE)

# True group means drawn from a common distribution

true_mu <- 3 # population mean
sigma_between <- 1.5 # between-group SD
sigma_within <- 2 # within-group SD

group_means <- rnorm(n_groups, true_mu, sigma_between)

# Generate data

data_list <- lapply(1:n_groups, function(j) {
rnorm(group_sizes[j], group_means[j], sigma_within)
})

# Compute estimates

no_pool <- sapply(data_list, mean)
complete_pool <- mean(unlist(data_list))

# Partial pooling (manual formula)

sigma*y2 <- sigma_within^2
sigma_g2 <- sigma_between^2
partial_pool <- sapply(1:n_groups, function(j) {
w <- sigma_g2 / (sigma_g2 + sigma_y2 / group_sizes[j])
w * no*pool[j] + (1 - w) * complete_pool
})

cat("Pooling comparison (first 8 groups):\n")
cat(" Group n True No-pool Partial Complete\n")
for (j in 1:8) {
cat(sprintf(" %5d %2d %5.2f %7.2f %7.2f %7.2f\n",
j, group_sizes[j], group_means[j],
no_pool[j], partial_pool[j], complete_pool))
}

# Compute MSE for each strategy

mse_nopool <- mean((no_pool - group_means)^2)
mse_partial <- mean((partial_pool - group_means)^2)
mse_complete <- mean((rep(complete_pool, n_groups) - group_means)^2)

cat("\nMean squared error:\n")
cat(" No pooling: ", round(mse_nopool, 3), "\n")
cat(" Partial pooling:", round(mse_partial, 3), "\n")
cat(" Complete pooling:", round(mse_complete, 3), "\n")

cat("\nPartial pooling has the lowest MSE!\n")

Click Run to execute this code in your browser with WebR

12.2.2 Visualización del encogimiento

# Visualize shrinkage
set.seed(42)
n_groups <- 20
group_sizes <- sample(c(5, 10, 25, 50), n_groups, replace = TRUE)
true_mu <- 3
sigma_between <- 1.5
sigma_within <- 2
group_means <- rnorm(n_groups, true_mu, sigma_between)
data_list <- lapply(1:n_groups, function(j) rnorm(group_sizes[j], group_means[j], sigma_within))

no*pool <- sapply(data_list, mean)
complete_pool <- mean(unlist(data_list))
sigma_y2 <- sigma_within^2
sigma_g2 <- sigma_between^2
partial_pool <- sapply(1:n_groups, function(j) {
w <- sigma_g2 / (sigma_g2 + sigma_y2 / group_sizes[j])
w * no*pool[j] + (1 - w) * complete_pool
})

# Plot: shrinkage by group size

plot(group_sizes, no_pool, pch = 16, col = "steelblue",
ylim = range(c(no_pool, partial_pool, group_means)),
xlab = "Group size (n)", ylab = "Estimate",
main = "Shrinkage: no-pooling vs partial pooling")
points(group_sizes, partial_pool, pch = 17, col = "firebrick")
points(group_sizes, group_means, pch = 4, col = "darkgreen", lwd = 2)
abline(h = complete_pool, lty = 2, col = "gray50")
legend("topright", legend = c("No pooling", "Partial pooling", "True mean", "Complete pooling"),
col = c("steelblue", "firebrick", "darkgreen", "gray50"),
pch = c(16, 17, 4, NA), lty = c(NA, NA, NA, 2), lwd = c(NA, NA, 2, 1))

cat("Smaller groups (left) show more shrinkage toward the population mean.\n")
cat("Larger groups (right) are barely shrunk — their data dominates.\n")

Click Run to execute this code in your browser with WebR

Rethinking

El agrupamiento parcial predice mejor. La razón por la que el agrupamiento parcial funciona no es filosófica — es práctica. Al predecir para un grupo nuevo, la mejor conjetura no son los datos del grupo mismo (que pueden ser escasos) ni la media general (que ignora las diferencias entre grupos). Es un promedio ponderado de ambos, donde los pesos dependen de cuántos datos tenga el grupo y cuánto varíen los grupos. Por esto el agrupamiento parcial predice nuevos grupos mejor que cualquiera de los extremos. También por esto los modelos multinivel son el valor por defecto para datos agrupados — encuentran automáticamente el balance correcto.

Resumen de la Sección 12.2

El agrupamiento completo subajusta — ignora las diferencias entre grupos.
El sin agrupamiento sobreajusta — estimados ruidosos para grupos pequeños.
El agrupamiento parcial balancea — encoge hacia la media, más para grupos pequeños.
El peso de encogimiento: $\frac{\sigma_\gamma^2}{\sigma_\gamma^2 + \sigma_y^2/n_j}$ — basado en los datos.
El agrupamiento parcial predice nuevos grupos mejor que cualquiera de los extremos.

Ejemplo: Renacuajos multinivel

Más de un tipo de cluster