Exercise 3.11: Regular Bike Ridership

A university wants to estimate the proportion of students who are regular bike riders, denoted by \(\pi\), so that it can install an appropriate number of bike racks. The university staff believe that \(\pi\) has a prior mean of \(1/4\) and a prior mode of \(5/22\).

Part 1: Prior Beta Model

Suppose the prior model is:

\[ \pi \sim \operatorname{Beta}(\alpha,\beta). \]

The mean and mode of a Beta distribution are:

\[ E(\pi)=\frac{\alpha}{\alpha+\beta} \]

and

\[ \operatorname{Mode}(\pi) = \frac{\alpha-1}{\alpha+\beta-2}. \]

The prior mean is \(1/4\):

\[ \frac{\alpha}{\alpha+\beta}=\frac14. \]

This implies:

\[ \beta=3\alpha. \]

The prior mode is \(5/22\):

\[ \frac{\alpha-1}{\alpha+\beta-2}=\frac{5}{22}. \]

Substituting \(\beta=3\alpha\):

\[ \frac{\alpha-1}{4\alpha-2}=\frac{5}{22}. \]

Solving this equation gives:

\[ \alpha=6,\qquad\beta=18. \]

Therefore, the prior model is:

\[ \boxed{\pi\sim\operatorname{Beta}(6,18)}. \]

# Prior parameters
alpha_prior <- 6
beta_prior <- 18

# Prior mean and mode
prior_mean <- alpha_prior /
  (alpha_prior + beta_prior)

prior_mode <- (alpha_prior - 1) /
  (alpha_prior + beta_prior - 2)

prior_mean
## [1] 0.25
prior_mode
## [1] 0.2272727
# Values of pi used to plot the prior distribution
pi_values <- seq(0, 1, length.out = 1000)

# Prior density
prior_density <- dbeta(
  pi_values,
  shape1 = alpha_prior,
  shape2 = beta_prior
)

# Plot the prior model
plot(
  pi_values,
  prior_density,
  type = "l",
  lwd = 3,
  col = "steelblue",
  main = "Prior Model for Regular Bike Ridership",
  xlab = expression(pi),
  ylab = "Density"
)

abline(
  v = prior_mean,
  col = "red",
  lty = 2,
  lwd = 2
)

legend(
  "topright",
  legend = c(
    "Prior: Beta(6, 18)",
    "Prior mean = 0.25"
  ),
  col = c("steelblue", "red"),
  lty = c(1, 2),
  lwd = 2
)

The prior model has a mean of \(0.25\) and a mode of approximately \(0.2273\). Thus, before observing the survey data, the staff expected approximately 25% of students to be regular bike riders.

Part 2: Posterior Model

Among the 50 surveyed students, 15 are regular bike riders. Therefore:

\[ n=50,\qquad y=15,\qquad n-y=35. \]

Under the Beta-Binomial model, the posterior parameters are:

\[ \alpha_{\text{posterior}} = \alpha_{\text{prior}}+y = 6+15 = 21 \]

and

\[ \beta_{\text{posterior}} = \beta_{\text{prior}}+(n-y) = 18+35 = 53. \]

Therefore, the posterior model is:

\[ \boxed{\pi\mid Y=15\sim\operatorname{Beta}(21,53)}. \]

# Survey information
students_surveyed <- 50
bike_riders <- 15
non_bike_riders <- students_surveyed - bike_riders

# Posterior parameters
alpha_posterior <- alpha_prior + bike_riders
beta_posterior <- beta_prior + non_bike_riders

alpha_posterior
## [1] 21
beta_posterior
## [1] 53

Part 3: Posterior Summary Statistics

# Posterior mean
posterior_mean <- alpha_posterior /
  (alpha_posterior + beta_posterior)

# Posterior mode
posterior_mode <- (alpha_posterior - 1) /
  (alpha_posterior + beta_posterior - 2)

# Posterior standard deviation
posterior_sd <- sqrt(
  (alpha_posterior * beta_posterior) /
    (
      (alpha_posterior + beta_posterior)^2 *
      (alpha_posterior + beta_posterior + 1)
    )
)

posterior_mean
## [1] 0.2837838
posterior_mode
## [1] 0.2777778
posterior_sd
## [1] 0.05205773

The posterior mean is:

\[ E(\pi\mid Y=15) = \frac{21}{74} \approx0.2838. \]

The posterior mode is:

\[ \operatorname{Mode}(\pi\mid Y=15) = \frac{20}{72} \approx0.2778. \]

The posterior standard deviation is approximately:

\[ SD(\pi\mid Y=15)\approx0.0521. \]

Therefore:

  • Posterior mean: approximately 0.2838
  • Posterior mode: approximately 0.2778
  • Posterior standard deviation: approximately 0.0521

Part 4: Prior, Data, and Posterior Comparison

The observed proportion of regular bike riders is:

\[ \frac{15}{50}=0.30. \]

# Calculate posterior density
posterior_density <- dbeta(
  pi_values,
  shape1 = alpha_posterior,
  shape2 = beta_posterior
)

# Plot the prior and posterior models
plot(
  pi_values,
  prior_density,
  type = "l",
  lwd = 3,
  col = "steelblue",
  ylim = c(0, max(prior_density, posterior_density)),
  main = "Prior and Posterior Models for Bike Ridership",
  xlab = expression(pi),
  ylab = "Density"
)

lines(
  pi_values,
  posterior_density,
  lwd = 3,
  col = "orange"
)

abline(
  v = bike_riders / students_surveyed,
  col = "darkgreen",
  lty = 2,
  lwd = 2
)

legend(
  "topright",
  legend = c(
    "Prior: Beta(6, 18)",
    "Posterior: Beta(21, 53)",
    "Observed proportion = 0.30"
  ),
  col = c("steelblue", "orange", "darkgreen"),
  lty = c(1, 1, 2),
  lwd = 2
)

The posterior mean of approximately \(0.2838\) lies between the prior mean of \(0.25\) and the observed survey proportion of \(0.30\).

The posterior mean is closer to the observed proportion:

\[ |0.2838-0.30|=0.0162, \]

than to the prior mean:

\[ |0.2838-0.25|=0.0338. \]

Therefore, the posterior model more closely reflects the survey data. The survey contains 50 observations, while the \(\operatorname{Beta}(6,18)\) prior has a prior weight of 24. The larger amount of survey information gives the observed data a stronger influence on the posterior model.

Exercise 3.18: More Beta-Binomial

Part 1: Patrick’s Analysis

Patrick uses the following prior model for \(\pi\), the probability that a resident attended a protest in June 2020:

\[ \pi\sim\operatorname{Beta}(3,3). \]

The prior mean is:

\[ E(\pi)=\frac{3}{3+3}=0.50. \]

Patrick surveyed 40 residents, of whom 30 attended a protest:

\[ n=40,\qquad y=30. \]

The observed proportion is:

\[ \frac{30}{40}=0.75. \]

The posterior model is:

\[ \pi\mid Y=30 \sim \operatorname{Beta}(3+30,\;3+40-30) = \operatorname{Beta}(33,13). \]

# Patrick's prior and survey information
patrick_alpha <- 3
patrick_beta <- 3
patrick_y <- 30
patrick_n <- 40

# Summarize Patrick's Beta-Binomial model
patrick_summary <- summarize_beta_binomial(
  alpha = patrick_alpha,
  beta = patrick_beta,
  y = patrick_y,
  n = patrick_n
)

patrick_summary
##       model alpha beta      mean      mode         var        sd
## 1     prior     3    3 0.5000000 0.5000000 0.035714286 0.1889822
## 2 posterior    33   13 0.7173913 0.7272727 0.004313639 0.0656783
# Plot Patrick's prior, likelihood, and posterior models
plot_beta_binomial(
  alpha = patrick_alpha,
  beta = patrick_beta,
  y = patrick_y,
  n = patrick_n
)

Patrick’s posterior model is:

\[ \boxed{\pi\mid Y=30\sim\operatorname{Beta}(33,13)}. \]

The posterior mean is:

\[ \frac{33}{33+13} = \frac{33}{46} \approx0.7174. \]

The posterior mode is:

\[ \frac{33-1}{33+13-2} = \frac{32}{44} \approx0.7273. \]

The posterior standard deviation is approximately \(0.0657\). Patrick’s posterior analysis therefore estimates that approximately 71.74% of residents in his town attended a protest.

Part 2: Harold’s Analysis

Harold uses the same prior model:

\[ \pi\sim\operatorname{Beta}(3,3). \]

Harold surveyed 20 residents, of whom 15 attended a protest:

\[ n=20,\qquad y=15. \]

The observed proportion is:

\[ \frac{15}{20}=0.75. \]

The posterior model is:

\[ \pi\mid Y=15 \sim \operatorname{Beta}(3+15,\;3+20-15) = \operatorname{Beta}(18,8). \]

# Harold's prior and survey information
harold_alpha <- 3
harold_beta <- 3
harold_y <- 15
harold_n <- 20

# Summarize Harold's Beta-Binomial model
harold_summary <- summarize_beta_binomial(
  alpha = harold_alpha,
  beta = harold_beta,
  y = harold_y,
  n = harold_n
)

harold_summary
##       model alpha beta      mean      mode         var         sd
## 1     prior     3    3 0.5000000 0.5000000 0.035714286 0.18898224
## 2 posterior    18    8 0.6923077 0.7083333 0.007889546 0.08882312
# Plot Harold's prior, likelihood, and posterior models
plot_beta_binomial(
  alpha = harold_alpha,
  beta = harold_beta,
  y = harold_y,
  n = harold_n
)

Harold’s posterior model is:

\[ \boxed{\pi\mid Y=15\sim\operatorname{Beta}(18,8)}. \]

The posterior mean is:

\[ \frac{18}{18+8} = \frac{18}{26} \approx0.6923. \]

The posterior mode is:

\[ \frac{18-1}{18+8-2} = \frac{17}{24} \approx0.7083. \]

The posterior standard deviation is approximately \(0.0888\). Harold’s posterior analysis therefore estimates that approximately 69.23% of residents in his town attended a protest.

Part 3: Comparison of Patrick and Harold

Patrick and Harold observed the same sample proportion:

\[ \frac{30}{40} = \frac{15}{20} = 0.75. \]

They also began with the same \(\operatorname{Beta}(3,3)\) prior, which has a mean of \(0.50\). Therefore, both posterior models shift away from the prior mean and toward the observed proportion of \(0.75\).

# Values of pi for the comparison plot
protest_pi <- seq(0, 1, length.out = 1000)

# Patrick's posterior density
patrick_posterior <- dbeta(
  protest_pi,
  shape1 = 33,
  shape2 = 13
)

# Harold's posterior density
harold_posterior <- dbeta(
  protest_pi,
  shape1 = 18,
  shape2 = 8
)

# Plot Patrick's posterior
plot(
  protest_pi,
  patrick_posterior,
  type = "l",
  lwd = 3,
  col = "steelblue",
  ylim = c(
    0,
    max(patrick_posterior, harold_posterior)
  ),
  main = "Patrick and Harold's Posterior Models",
  xlab = expression(pi),
  ylab = "Density"
)

# Add Harold's posterior
lines(
  protest_pi,
  harold_posterior,
  lwd = 3,
  col = "orange"
)

# Add the observed proportion
abline(
  v = 0.75,
  col = "darkgreen",
  lty = 2,
  lwd = 2
)

legend(
  "topleft",
  legend = c(
    "Patrick: Beta(33, 13)",
    "Harold: Beta(18, 8)",
    "Observed proportion = 0.75"
  ),
  col = c("steelblue", "orange", "darkgreen"),
  lty = c(1, 1, 2),
  lwd = 2
)

The posterior results can be summarized as follows:

Analysis Survey result Posterior model Posterior mean Posterior mode Posterior SD
Patrick 30 of 40 Beta(33, 13) 0.7174 0.7273 0.0657
Harold 15 of 20 Beta(18, 8) 0.6923 0.7083 0.0888

Patrick’s posterior mean is closer to the observed proportion of \(0.75\) because his survey contains 40 observations. His larger sample provides more evidence and reduces the relative influence of the prior.

Patrick’s posterior distribution also has a smaller standard deviation, so it is narrower and represents greater certainty about \(\pi\).

Harold surveyed only 20 residents. Consequently, the shared prior has a stronger relative influence on his posterior model. Harold’s posterior mean remains closer to the prior mean of \(0.50\), and his posterior distribution is wider, representing greater uncertainty.

In conclusion, the posterior models are similar because Patrick and Harold used the same prior and observed the same sample proportion. They differ because Patrick had a larger sample, which produced a posterior model that is more concentrated and more strongly influenced by the survey data.