13.2 Ejemplo: Decisiones de admisión y género

Los datos de admisión de UC Berkeley ilustran cómo las pendientes variables pueden revelar o eliminar asociaciones aparentes — un caso clásico de la paradoja de Simpson.

13.2.1 La paradoja de Simpson

En los datos agregados, las mujeres parecen menos propensas a ser admitidas. Dentro de los departamentos, el patrón a menudo se invierte o desaparece. Un modelo de pendientes variables por departamento revela cómo la asociación género-admisión varía:

$\text{logit}(p_{ij}) = \alpha_{\text{dept}[j]} + \beta_{\text{dept}[j]} \cdot \text{male}_i$

# Simulate Simpson's paradox: admission data
set.seed(42)
n_depts <- 6

# Departments vary in selectivity and gender bias

# Some departments favor males, some favor females, some are neutral

dept_intercept <- rnorm(n_depts, 0, 1.5)
dept_slope <- rnorm(n_depts, 0, 0.5) # gender effect varies by dept

# More women apply to selective (low intercept) departments

# This creates the paradox: aggregate shows women disadvantaged

n_per <- 100
d <- do.call(rbind, lapply(1:n_depts, function(j) {
male <- sample(c(0, 1), n_per, replace = TRUE, prob = c(0.7, 0.3)) # more women apply
logit_p <- dept_intercept[j] + dept_slope[j] * male
p <- 1 / (1 + exp(-logit_p))
admit <- rbinom(n_per, 1, p)
data.frame(dept = factor(j), male = male, admit = admit)
}))

# Aggregate model (ignores department)

m_agg <- glm(admit ~ male, family = binomial, data = d)
cat("Aggregate model (Simpson's paradox):\n")
cat(" male coefficient:", round(coef(m_agg)[2], 3), "\n")

# Varying slopes by department

library(lme4)
m_vary <- glmer(admit ~ male + (1 + male | dept), family = binomial, data = d)

cat("\nVarying slopes model:\n")
cat(" Fixed male effect:", round(fixef(m_vary)[2], 3), "\n")
cat(" Dept intercept SD:", round(attr(VarCorr(m_vary)$dept, "stddev")[1], 3), "\n")
cat("  Dept slope SD:    ", round(attr(VarCorr(m_vary)$dept, "stddev")[2], 3), "\n")
cat(" Correlation: ", round(attr(VarCorr(m_vary)$dept, "correlation")[1, 2], 3), "\n")

# Department-specific effects

cat("\n Department-specific male effects:\n")
dept_slopes <- fixef(m_vary)[2] + ranef(m_vary)$dept[, 2]
for (j in 1:n_depts) {
cat(sprintf(" Dept %d: %.3f\n", j, dept_slopes[j]))
}

cat("\n The aggregate effect may differ from department effects!\n")

Click Run to execute this code in your browser with WebR

13.2.2 Interpretación de las pendientes variables

# Visualize department-specific effects
set.seed(42)
n_depts <- 6
dept_intercept <- rnorm(n_depts, 0, 1.5)
dept_slope <- rnorm(n_depts, 0, 0.5)
n_per <- 100

d <- do.call(rbind, lapply(1:n_depts, function(j) {
male <- sample(c(0, 1), n_per, replace = TRUE, prob = c(0.7, 0.3))
logit_p <- dept_intercept[j] + dept_slope[j] * male
p <- 1 / (1 + exp(-logit_p))
admit <- rbinom(n_per, 1, p)
data.frame(dept = factor(j), male = male, admit = admit)
}))

library(lme4)
m <- glmer(admit ~ male + (1 + male | dept), family = binomial, data = d)

# Extract department effects

dept_int <- fixef(m)[1] + ranef(m)$dept[, 1]
dept_slp <- fixef(m)[2] + ranef(m)$dept[, 2]

# Plot: department-specific admission probabilities

plot(0, 0, type = "n", xlim = c(-0.5, 1.5), ylim = c(0, 1),
xlab = "Male (0 = female, 1 = male)", ylab = "P(admit)",
main = "Department-specific admission curves")

for (j in 1:n_depts) {
x_seq <- c(0, 1)
logit_p <- dept_int[j] + dept_slp[j] * x_seq
p <- 1 / (1 + exp(-logit_p))
lines(x_seq, p, col = j, lwd = 2)
}
legend("topright", legend = paste("Dept", 1:n_depts), col = 1:n_depts, lwd = 2,
cex = 0.8)

cat("Each department has its own admission curve.\n")
cat("Some favor males, some favor females, some are neutral.\n")
cat("The aggregate effect hides this variation.\n")

Click Run to execute this code in your browser with WebR

Rethinking

La paradoja de Simpson es un problema de agrupamiento. La paradoja de Simpson no es realmente una paradoja — es una consecuencia de ignorar la estructura de agrupamiento. Cuando los grupos difieren tanto en el resultado como en el predictor, la relación agregada puede invertir la relación dentro de los grupos. El modelo de pendientes variables resuelve esto estimando efectos específicos por departamento. Pero también nos dice algo más profundo: la variación entre departamentos es en sí misma informativa. Si el efecto de género varía mucho entre departamentos, el efecto "promedio" de género no es muy significativo. Necesitamos entender por qué los departamentos difieren, no solo cuál es el promedio.

Resumen de la Sección 13.2

Paradoja de Simpson: el efecto agregado puede invertir los efectos dentro de los grupos.
Las pendientes variables por departamento revelan cómo varía la asociación género-admisión.
La covarianza entre interceptos y pendientes captura cómo se relacionan selectividad y sesgo.
La variación entre departamentos es tan importante como el efecto promedio.
Las pendientes variables resuelven la paradoja al no agrupar cuando no deben.

Pendientes variables por construcción

Ejemplo: Chimpancés cruzados con pendientes variables