model shape rate mean mode var sd
1 prior 1 1 1.0 0 1.00 1.0
2 posterior 1 2 0.5 0 0.25 0.5
The notes for this lecture are derived from Chapter 7 of the Bayes Rules! book
\(Y \sim \text{Pois}(\lambda)\)
\(\lambda \sim\text{Gamma}(1,1)\)
\(Y = 0\)
Conditioned on data \(y\), let parameter \(\lambda\) have posterior pdf \(f(\lambda | y) \propto f(\lambda) L(\lambda |y)\). A Metropolis-Hastings Markov chain for \(f(\lambda|y)\), \(\left\lbrace \lambda^{(1)}, \lambda^{(2)}, ..., \lambda^{(N)}\right\rbrace\), evolves as follows. Let \(\lambda^{(i)} = \lambda\) be the location of the chain at iteration \(i \in \{1,2,...,N-1\}\) and identify the next location \(\lambda^{(i+1)}\) through a two-step process:
Step 1: Propose a new location.
Conditioned on the current location \(\lambda\), draw a location \(\lambda'\) from a proposal model with pdf \(q(\lambda'|\lambda)\).
Step 2: Decide whether or not to go there.
Calculate the acceptance probability, ie. the probability of accepting the proposal:
\[\alpha = \min\left\lbrace 1, \; \frac{f(\lambda')L(\lambda'|y)}{f(\lambda)L(\lambda|y)} \frac{q(\lambda|\lambda')}{q(\lambda'|\lambda)} \right\rbrace\]
Flip a weighted coin. If it’s Heads, with probability \(\alpha\), go to the proposed location. If it’s Tails, with probability \(1 - \alpha\), stay:
\[\lambda^{(i+1)} = \begin{cases} \lambda' & \text{ with probability } \alpha \\ \lambda & \text{ with probability } 1- \alpha \\ \end{cases}\]
Though not certain, the probability \(\alpha\) of accepting and subsequently moving to the proposed location is relatively high
To make the final determination, we flip a weighted coin which accepts the proposal with probability \(\alpha\) (0.878) and rejects the proposal with probability \(1 - \alpha\) (0.122).
one_mh_iteration <- function(sigma, current){
# STEP 1: Propose the next chain location
proposal <- rnorm(1, mean = current, sd = sigma)
# STEP 2: Decide whether or not to go there
if(proposal < 0) {alpha <- 0}
else {
proposal_plaus <- dgamma(proposal, 1, 1) * dpois(0, proposal)
current_plaus <- dgamma(current, 1, 1) * dpois(0, current)
alpha <- min(1, proposal_plaus / current_plaus)
}
next_stop <- sample(c(proposal, current),
size = 1, prob = c(alpha, 1-alpha))
# Return the results
return(data.frame(proposal, alpha, next_stop))
}
mh_tour <- function(N, sigma){
# 1. Start the chain at location 1
current <- 1
# 2. Initialize the simulation
lambda <- rep(0, N)
# 3. Simulate N Markov chain stops
for(i in 1:N){
# Simulate one iteration
sim <- one_mh_iteration(sigma = sigma, current = current)
# Record next location
lambda[i] <- sim$next_stop
# Reset the current location
current <- sim$next_stop
}
# 4. Return the chain locations
return(data.frame(iteration = c(1:N), lambda))
}
proposal alpha next_stop
1 1.065026 0.878049 1.065026
proposal alpha next_stop
1 1.686174 0.2535109 1