3.5 Practice
The practice problems for Chapter 3 ask you to sample from posteriors, compute credible intervals, and simulate posterior predictive distributions. They emphasize that the posterior is a distribution, not a point, and that summaries should preserve uncertainty.
Easy problems
3E1. How much posterior probability lies below ?
# 3E1: P(p < 0.2) from the globe tossing posterior
p_grid <- seq(0, 1, length.out = 1000)
prior <- rep(1, 1000)
likelihood <- dbinom(6, size = 9, prob = p_grid)
posterior <- (likelihood * prior) / sum(likelihood * prior)
set.seed(42)
samples <- sample(p_grid, size = 1e4, replace = TRUE, prob = posterior)
cat("P(p < 0.2) =", round(mean(samples < 0.2), 4), "\n")3E2. How much posterior probability lies above ?
3E3. How much posterior probability lies between and ?
3E4. What is the 20th percentile of the posterior samples?
# 3E4: 20th percentile of posterior
cat("20th percentile:", round(quantile(samples, 0.2), 4), "\n")3E5. What is the 80th percentile of the posterior samples?
Medium problems
3M1. Suppose the globe tossing data had been 8 waters in 15 tosses. Construct the posterior and compute the 90% HPD interval.
# 3M1: 8 waters in 15 tosses
p_grid <- seq(0, 1, length.out = 1000)
prior <- rep(1, 1000)
likelihood <- dbinom(8, size = 15, prob = p_grid)
posterior <- (likelihood * prior) / sum(likelihood * prior)
set.seed(42)
samples <- sample(p_grid, size = 1e4, replace = TRUE, prob = posterior)
# 90% percentile interval
pi90 <- quantile(samples, c(0.05, 0.95))
cat("90% percentile interval: [", round(pi90[1], 4), ",", round(pi90[2], 4), "]\n")
# 90% HPD interval
sorted <- sort(samples)
n <- length(sorted)
window <- floor(n * 0.9)
widths <- sorted[(window+1):n] - sorted[1:(n-window)]
hpd_idx <- which.min(widths)
hpd90 <- c(sorted[hpd_idx], sorted[hpd_idx + window])
cat("90% HPD interval: [", round(hpd90[1], 4), ",", round(hpd90[2], 4), "]\n")
# Plot
plot(p_grid, posterior, type = "l", lwd = 2, col = "steelblue",
xlab = "p", ylab = "Posterior density",
main = "3M1: 8 waters in 15 tosses")
abline(v = pi90, col = "firebrick", lty = 2, lwd = 2)
abline(v = hpd90, col = "darkgreen", lty = 3, lwd = 2)
legend("topright", legend = c("90% PI", "90% HPD"),
col = c("firebrick", "darkgreen"), lty = c(2, 3), lwd = 2)3M2. Draw 10,000 samples from the posterior for 8 waters in 15 tosses. Simulate posterior predictive samples for 15 tosses. What is the predicted probability of observing 8 waters?
3M3. Compare the posterior predictive distribution to the observed data. Is 8 waters a typical value?
Hard problems
3H1. Using the posterior from 3M1, compute the posterior probability that .
3H2. Simulate 10,000 posterior predictive datasets of 15 tosses each. Compute the proportion of simulations that produce 8 or more waters. Compare this to the observed data.
# 3H2: Posterior predictive check for 8/15
p_grid <- seq(0, 1, length.out = 1000)
prior <- rep(1, 1000)
likelihood <- dbinom(8, size = 15, prob = p_grid)
posterior <- (likelihood * prior) / sum(likelihood * prior)
set.seed(42)
samples <- sample(p_grid, size = 1e4, replace = TRUE, prob = posterior)
# Simulate posterior predictive
pred <- rbinom(1e4, size = 15, prob = samples)
cat("P(simulated >= 8):", round(mean(pred >= 8), 4), "\n")
cat("P(simulated <= 8):", round(mean(pred <= 8), 4), "\n")
cat("Observed: 8 waters in 15 tosses\n")
hist(pred, breaks = -0.5:15.5, col = "steelblue", border = "white",
xlab = "Number of waters", main = "3H2: Posterior predictive (8/15)")
abline(v = 8, col = "firebrick", lwd = 3)3H3. Suppose you observe 3 waters in 3 tosses. Construct the posterior and simulate posterior predictive samples. What is the predicted probability of observing 3 waters in 3 future tosses? How does this compare to the case with more data?