11.5 Practice

The practice problems for Chapter 11 ask you to fit ordered logit, zero-inflated Poisson, and beta-binomial models. They reinforce the idea that the choice of likelihood is a modeling decision, not a default.

Practice

Easy problems

11E1. What is a cumulative link model? How does it differ from a standard logistic regression?

11E2. What is the difference between a ZIP model and a hurdle model?

11E3. What is overdispersion? Name two models that handle it.

11E4. Why does the beta-binomial have more variance than the binomial?

Medium problems

11M1. Fit an ordered logistic regression. Interpret the coefficients and cutpoints.

# 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")

Click Run to execute this code in your browser with WebR

11M2. Simulate zero-inflated data. Fit a hurdle model and compare with a standard Poisson.

# 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")

Click Run to execute this code in your browser with WebR

Hard problems

11H1. Simulate overdispersed binomial data. Compare a binomial model with a beta-binomial approach (using the dispersion parameter). Show that the binomial underestimates uncertainty.

# 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")

Click Run to execute this code in your browser with WebR

11H2. Fit an ordered logit model with an interaction. How does the interaction affect the predicted category probabilities?

11H3. Compare a ZIP and hurdle model on the same zero-inflated dataset using posterior predictive checks. Which model reproduces the zero count better?

Summary

Example: Multilevel tadpoles