Shukry Zablah

2021-12-03

A grid approximation of the posterior probability of the globe tossing model, in R.

library(tibble)
library(ggplot2)
library(stringr)

Globe tossing model:

$$W \sim \textrm{Binomial}(N, p)$$ $$p \sim \textrm{Uniform}(0, 1)$$

We can compute the posterior probability of observing the sequence WWW.

n <- 25
df <- tibble(grid = seq(from = 0, to = 1, length.out = n),
             prior = rep(1, n),
             likelihood = dbinom(3, size=3, prob=grid),
             posterior_unstandardized = likelihood * prior,
             posterior = posterior_unstandardized / sum(posterior_unstandardized))

ggplot(df, aes(x = grid, y = posterior)) +
  geom_point() +
  geom_line() +
  labs(x = "probability of water", y = "posterior probability")

We can generalize a utility function.

plot_posterior_approximation <- function(sequence, grid_length = 25) {
  num_water <- stringr::str_count(sequence, "W")
  df <- tibble(grid = seq(from = 0, to = 1, length.out = grid_length),
             prior = rep(1, grid_length),
             likelihood = dbinom(num_water,
                                 size=stringr::str_length(sequence),
                                 prob=grid),
             posterior_unstandardized = likelihood * prior,
             posterior = posterior_unstandardized / sum(posterior_unstandardized))
  ggplot(df, aes(x = grid, y = posterior)) +
    geom_point() +
    geom_line() +
    labs(x = "probability of water",
         y = "posterior probability",
         title = "Posterior (grid approximation)")
}

And use it to analyze other sequences.

plot_posterior_approximation("WWW")

plot_posterior_approximation("WWWL")

plot_posterior_approximation("LWWLWWW")

It would be interesting to generate Bayesian update GIFs of the grid approximation of the posterior.