<- 6
Y <- 10
n
<- 3
alpha <- 3
beta
<- function(x) dbeta(x, alpha, beta)
prior <- function(x) dbeta(x, alpha + Y, n - Y + beta)
posterior
ggplot(data = data.frame(x = 0), mapping = aes(x = x)) +
stat_function(fun = prior, aes(colour = "Prior")) + xlim(0, 1) +
stat_function(fun = posterior, aes(colour = "Posterior")) +
xlab("p_h") +
ylab("Density") +
theme(
text = element_text(size = 20),
legend.title = element_blank(),
legend.position = c(0.2, 0.9),
legend.text = element_text(size = rel(1.3))
)
Coin Flip Model
As an example, consider a (possibly biased) coin flip experiment. The parameter of interest is the probability of heads
Then
$$
The posterior distribution is a Beta distribution,
Rejection Sampler
The rejection sampler is an algorithm which produces exact samples from the target distribution. Consider a problem where it is straightforward to evaluate the posterior density
- Propose
- Continuously sample
and check the condition in step 3. - If
, set as a sample from - Repeat 1-3 until enough samples are attained
The figure below shows the empirical posterior distribution found for the coin flip experiment overlaid with the analytic posterior distribution. This algorithm performs well for low-dimensional problems, but finding the upper bound
# Perform one rejection step
<- function(prop, propPdf, log_density) {
rejection_sample <- runif(1)
u <- prop(1)
y
if (log(u) < log_density(y) - propPdf(y)) {
yelse {
} rejection_sample(prop, propPdf, log_density)
}
}
<- function(alpha, beta, Y, n) {
log_density function(theta) {
dbeta(theta, alpha, beta, log = T) + dbinom(Y, n, theta, log = T)
}
}
<- 1000
samples <- log_density(alpha, beta, Y, n)
lden <-
rejection_samples replicate(samples, rejection_sample(runif, function(x)
dunif(x, log = T), lden))
ggplot(tibble(rejection_samples)) +
geom_histogram(aes(x = rejection_samples, y = ..density..), alpha = 0.4) +
stat_function(fun = posterior, aes(colour = "Analytic posterior")) +
theme(legend.position = "none") +
xlab("p_h")
`stat_bin()` using `bins = 30`. Pick better value with `binwidth`.