Visualising Laplace's rule of succession

rule-of-succession.png

rule-of-succession.R

library(tidyverse)

# CF en.wikipedia.org/wiki/Rule_of_succession

# True probabilities
true_probs <- c(0.1, 0.3, 0.7, 0.9)
# How many runs for each probability and prior?
n_repetitions <- 10
# How many observations to update estimated probability?
n_observations <- 500

# Generate (beta) priors of different strengths
# Laplace's rule is equivalent to a prior of Beta(1, 1)
priors <- tibble(alpha = c(1, 10, 25, 50, 100),
                 beta  = c(1, 10, 25, 50, 100))

simulate <- function(p, n, alpha, beta, ...) {
  tibble(n     = n,
         p     = p,
         alpha = alpha,
         beta  = beta,
         i     = 1:n,
         obs   = rbernoulli(n, p),
         count = cumsum(obs),
         succ  = (count + alpha) / (i + (alpha + beta)),
         !!!list(...))
}

p <-
  priors %>%
  crossing(p = true_probs,
           run  = 1:n_repetitions) %>%
  mutate(n = n_observations) %>%
  pmap_dfr(simulate) %>%
  ggplot(aes(x = i, y = succ)) +
  geom_path(aes(group = run), alpha = 0.5) +
  geom_hline(aes(yintercept = p), linetype = "dotted") +
  scale_x_log10() +
  facet_grid(reorder(p, -p) ~ alpha) +
  theme_bw() +
  labs(title    = "Laplace's rule of succession",
       subtitle = "With various strength priors",
       x = "Number of observations",
       y = "Estimated probability")

ggsave("rule-of-succession.png", p, width = 8, height = 6)