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.