11.5 Práctica
Los problemas de práctica del Capítulo 11 le piden ajustar modelos de logit ordenado, Poisson con inflación de ceros y beta-binomial. Refuerzan la idea de que la elección de la verosimilitud es una decisión de modelado, no un valor por defecto.
Problemas fáciles
11E1. ¿Qué es un modelo de enlace acumulativo? ¿En qué se diferencia de una regresión logística estándar?
11E2. ¿Cuál es la diferencia entre un modelo ZIP y un modelo de barrera?
11E3. ¿Qué es la sobredispersión? Nombre dos modelos que la manejan.
11E4. ¿Por qué la beta-binomial tiene más varianza que la binomial?
Problemas medios
11M1. Ajuste una regresión logística ordenada. Interprete los coeficientes y los puntos de corte.
# 11M1: Ordered logistic regression
set.seed(42)
n <- 300
x1 <- runif(n, 0, 10)
x2 <- runif(n, 0, 10)
# Latent variable with two predictors
phi <- -1 + 0.3 _ x1 - 0.2 _ x2 + rnorm(n, sd = 1)
cutpoints <- c(-2, -0.5, 0.5, 2)
y <- as.numeric(cut(phi, breaks = c(-Inf, cutpoints, Inf), labels = 1:5))
library(MASS)
m <- polr(factor(y) ~ x1 + x2, method = "logistic")
cat("Ordered logistic regression:\n")
cat(" x1:", round(coef(m)[1], 3), "\n")
cat(" x2:", round(coef(m)[2], 3), "\n")
cat(" Cutpoints:", round(m$zeta, 3), "\n")
cat("\nInterpretation:\n")
cat(" x1 shifts toward higher categories (positive coef)\n")
cat(" x2 shifts toward lower categories (negative coef)\n")11M2. Simule datos con inflación de ceros. Ajuste un modelo de barrera y compare con una Poisson estándar.
# 11M2: Zero-inflated data, hurdle vs Poisson
set.seed(42)
n <- 200
x <- runif(n, 0, 10)
# ZIP data: 40% structural zeros
is_zero <- rbinom(n, 1, 0.4)
lambda <- exp(0.3 + 0.15 * x)
y <- ifelse(is_zero, 0, rpois(n, lambda))
# Standard Poisson (wrong)
m_pois <- glm(y ~ x, family = poisson)
# Hurdle model
m_hurdle <- glm(I(y > 0) ~ x, family = binomial)
m_count <- glm(y[y > 0] ~ x[y > 0], family = poisson)
cat("Standard Poisson:\n")
cat(" Intercept:", round(coef(m_pois)[1], 3), " Slope:", round(coef(m_pois)[2], 3), "\n")
cat("\nHurdle model:\n")
cat(" Zero process: intercept =", round(coef(m_hurdle)[1], 3),
" slope =", round(coef(m_hurdle)[2], 3), "\n")
cat(" Count process: intercept =", round(coef(m_count)[1], 3),
" slope =", round(coef(m_count)[2], 3), "\n")
cat("\nZeros in data:", sum(y == 0), "/", n, "\n")Problemas difíciles
11H1. Simule datos binomiales sobredispersados. Compare un modelo binomial con un enfoque beta-binomial (usando el parámetro de dispersión). Muestre que la binomial subestima la incertidumbre.
# 11H1: Overdispersed binomial — binomial vs beta-binomial
set.seed(42)
n <- 50
n_trials <- 30
# Varying probabilities (overdispersion)
p_true <- rbeta(n, 3, 4) # mean ~0.43, varies
y <- rbinom(n, n_trials, p_true)
# Binomial model
m_binom <- glm(cbind(y, n_trials - y) ~ 1, family = binomial)
p_hat <- plogis(coef(m_binom)[1])
# Binomial standard error
se_binom <- summary(m_binom)$coefficients[1, 2]
cat("Binomial model:\n")
cat(" p_hat:", round(p_hat, 3), "\n")
cat(" SE (logit scale):", round(se_binom, 3), "\n")
# Observed variance vs binomial variance
obs_var <- var(y / n_trials)
binom_var <- p_hat * (1 - p_hat) / n_trials
cat("\nVariance comparison:\n")
cat(" Observed var of proportions:", round(obs_var, 5), "\n")
cat(" Binomial expected var: ", round(binom_var, 5), "\n")
cat(" Ratio (overdispersion):", round(obs_var / binom_var, 2), "\n")
cat("\nThe binomial underestimates variance by a factor of",
round(obs_var / binom_var, 1), "\n")
cat("A beta-binomial would absorb this extra variation.\n")11H2. Ajuste un modelo logit ordenado con una interacción. ¿Cómo afecta la interacción a las probabilidades predichas por categoría?
11H3. Compare un modelo ZIP y uno de barrera en el mismo conjunto de datos con inflación de ceros usando comprobaciones predictivas a posteriori. ¿Qué modelo reproduce mejor el conteo de ceros?