Here is a possible solution for the Metropolis-Hastings sampler.
# This is a function that takes four parameters:
# - target: the target distribution, a function that takes one
# argument (a number) and returns the (logged) value of a
# distribution
# - initTheta: the initial value of theta, a number
# - proposalSd: the standard deviation of (Gaussian) proposal
# distribution
# - nIterations: the number of iterations
# The function returns a vector of samples of theta from the target
# distribution
my_mcmcMh <- function(target, initTheta, proposalSd, nIterations) {
# evaluate the function "target" at "initTheta", and assign to
# a variable called targetThetaCurrent.
targetThetaCurrent <- target(initTheta)
# initialise variables to store the current value of theta, the
# vector of samples, and the number of accepted runs
thetaCurrent <- initTheta
samples <- thetaCurrent
accepted <- 0
# run MCMC for nIteration interations
for (iIteration in seq_len(nIterations)) {
# draw a new theta from the (Gaussian) proposal distribution
# and assign to a variable called thetaProposed.
# See "?rnorm for more information
# Note that this step is vectorized for any arbitratry theta
# which will be useful when we will sample from a multivariate
# target distribution
thetaProposed <- rnorm(
n = length(thetaCurrent),
mean = thetaCurrent,
sd = proposalSd
)
# Note that 'rnorm' returns an unnamed vector, but the functions of
# 'fitmodel' need a named parameter vector. We therefore set
# the names of thetaProposed to be the same as the names of
# thetaCurrent
names(thetaProposed) <- names(thetaCurrent)
# evaluate the function target at the proposed theta and
# assign to a variable called targetThetaProposed
targetThetaProposed <- target(thetaProposed)
# compute Metropolis-Hastings ratio (acceptance probability). Since
# the multivariate Gaussian is symmetric, we don't need to consider
# the proposal distribution here
logAcceptance <- targetThetaProposed - targetThetaCurrent
# draw random number number between 0 and 1 using "runif" and assign to
# a variable called r.
r <- runif(1)
# test acceptance by comparing the random number to the
# Metropolis-Hastings ratio (acceptance probability) (using
# "exp" because we calculated the logarithm of the
# Metropolis-Hastings ratio before)
if (r < exp(logAcceptance)) {
# if accepted:
# change the current value of theta to the proposed theta
thetaCurrent <- thetaProposed
# updated the current value of the target
targetThetaCurrent <- targetThetaProposed
# update number of accepted proposals
accepted <- accepted + 1
}
# add the current theta to the vector of samples
# Note that we use `rbind` in order to deal with multivariate
# target. So if `theta` is a vector then `samples` is a matrix.
samples <- rbind(samples, thetaCurrent, deparse.level = 0)
# print current state of chain and acceptance rate
# use paste() to deal with the case where `theta` is a vector
message(
"iteration: ", iIteration, ", chain:", paste(thetaCurrent, collapse = " "),
", acceptance rate:", accepted / iIteration
)
}
# return the trace of the chain (i.e., the vector of samples)
return(samples)
}
You can copy and paste the function into your R session, and proceed from there.
Return to the MCMC session.
This web site and the material contained in it were originally created in support of an annual short course on Model Fitting and Inference for Infectious Disease Dynamics at the London School of Hygiene & Tropical Medicine. All material is under a MIT license. Please report any issues or suggestions for improvement on the corresponding GitHub issue tracker. We are always keen to hear about any uses of the material here, so please do get in touch using the Discussion board if you have any questions or ideas, or if you find the material here useful or use it in your own teaching.