Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

In the last post I showed how to use Laplace approximation to quickly (but dirtily) approximate the posterior distribution of a Bayesian model coded in R. This is just a short follow up where I show how to use importance sampling as an easy method to shape up the Laplace approximation in order to approximate the true posterior much better. But first, what is importance sampling?

## Importance Sampling

Importance sampling is a method that can be used to estimate the integral of a function even though we only have access to the density of that function at any given point. Using a further resampling step, this method can be used to produce samples that are (approximately) distributed according to the density of the given function. In Bayesian statistics this is what we often want to do with a function that describes the density of the posterior distribution. In the case when there is more than one free parameter the posterior will be multidimensional and there is nothing stopping importance sampling from working in many dimensions. Below I will only visualize the one dimensional case, however.

The first step in the importance sampling scheme is to define a proposal distribution that we believe covers most of our target distribution, the distribution that we actually want to estimate. Ideally we would want to choose a proposal distribution that is the same as the target distribution, but if actually could do this we would already be able to sample from the target distribution and importance sampling would be unnecessary. Instead we can make an educated guess. A sloppy guess is to use a uniform proposal distribution that we believe covers most of the density of the target distribution. For example, assuming the target distribution has most of its density in $[-4,4]$ we could setup the importance sampling as:

Here, the target distribution is actually a $\text{Normal}(\mu=1,\sigma=1)$ distribution, but most often we do not know its shape.

The next step is to sample from the proposal distribution. For each sample we calculate the likelihood of getting that sample from the target distribution relative to the likelihood of sampling it from the proposal distribution. After we’ve finished sampling we normalize these relative likelihoods so that they sum to one, thus now forming a discrete probability distribution. That is, for each sample $x_i$ we calculate:

$$p_i = \frac{\text{Target}(x_i) / \text{Proposal}(x_i)}{\sum\nolimits_{x} \text{Target}(x) / \text{Proposal}(x)}$$

where $p_i$ is the final probability of $x_i$ and $\text{Proposal}(\cdot)$ and $\text{Target}(\cdot)$ are the two respective density functions. The resulting discrete probability distribution over all $x_i$ is now an estimate of the target distribution. The procedure is visualized below where the “height” of the samples indicate their respective probability:

We can now use the resulting discrete probability distribution to calculate, for example, the amount of probability above zero by summing all $p_i$ from samples $x_i$ above zero. However, I believe it is easier to work with samples that I can treat as being sampled from the target distribution. With such samples, instead of summing the $p_i$ for samples above zero, I could simply count the number of samples above zero, compare this with the total number of samples and in this way calculate the amount of probability above zero. So as a last step, to get samples that I can treat as being sampled from the target distribution, I (re)sample with replacement from the discrete probability distribution defined by the $x_i\text{s}$ and the corresponding $p_i\text{s}$.

Now, there are two issues that need consideration. First, it might actually be a better idea to resample without replacement. If we are unlucky in the initial sampling phase and draw a sample that is extremely unlikely according to the proposal distribution, but very likely according to the target distribution, this sample will get a huge probability. If we are sampling with replacement the value of that sample might end up dominating the distribution of the resulting resamples. Sampling without replacement is more robust, but on the downside we have to produce far more samples in the first sampling phase than we draw resamples in the resampling phase.

A second issue is that we need to find a good proposal distribution. If the proposal distribution is to wide, most samples will fall outside the high density area of the target distribution. Ideally we would want to choose a proposal distribution that looked similar to the target. If only there was a quick and dirty method that we could use to approximate the distribution of the target density*cough* *cough* Laplace approximation *cough*

## Importance Sampling ❤ Laplace Approximation

Importance Sampling and Laplace Approximation is such a good match! Laplace approximation quickly produces an approximation to the posterior, but it is often a bit off… Importance sampling converges to the true posterior, but this could take (literary) eons if the proposal distribution is very different from the target distribution… Ergo, we use the Laplace approximated posterior as the proposal distribution in importance sampling! With one important modification, however. Below is an importance sampling setup with the Laplace approximation to the posterior distribution as the proposal distribution:

As the target distribution is right skewed the symmetric Laplace approximation is doing a bad job. But using the Laplace approximation as the proposal distribution would currently not really work either. The Laplace approximation is a normal distribution and as such it has very light tails. In an importance sampling scheme we would want the proposal distribution to cover the target distribution but the light tails of the normal distribution make proposal distribution have very low density in areas where the target distribution has a relatively high density (look at the density at 4-5 in the plot above).

The solution is to use a heavy-tailed distribution for the proposal and here a convenient choice is the t-distribution where the degrees-of-freedom parameter decides the fatness of the tails (lower df = fatter tails, when df → $\infty$ the t-distribution approaches the normal distribution). Below, the proposal has been changed to a t-distribution with df = 2 but with the same mean and scale as above.

Being confident that we now have an adequate proposal distribution we can continue with the importance sampling:

Note that in the above animation we sample with replacement but, as argued earlier, it might actually be a good idea to sample without replacement.

So to compare, the true 95% credible interval of the target distribution is $[0.82,4.32]$ but the Laplace approximation gave $[0.20,3.51]$. A final Importance sampling step using 25000 samples and 5000 resamples without replacement yielded $[0.82,4.36]$, which is much closer to the true 95% CI!

## Doin’ it in R

Using the function below it is possible to do Laplace approximation of a Bayesian model followed by an optional importance sampling step. The function is designed along the same lines as the one in Easy Laplace Approximation of Bayesian Models in R and requires you to have the coda package and the mvtnorm package installed. The function takes the following arguments:

• model, a function that takes a vector of parameters as its first argument and returns the log of the unnormalized posterior density.
• inits, a vector of reasonable starting values for the parameters given in the same order as in the model.
• no_samples, number of samples to draw in the first sampling step.
• no_resamples, number of resamples in the importance sampling step. If this is set to zero (the default) the importance sampling is skipped and no_samples samples from the Laplace approximation are returned instead.
• with replacement, a TRUE/FALSE value that decides whether to resample with or without replacement. If sampling without replacement (the default) no_samples should be much larger (maybe ten times) than no_resamples.
• df, the degrees-of-freedoms of the t-distribution used if doing the importance sampling step.
• ..., all other arguments are passed to the model function.

The function returns the samples (or resamples) as an mcmc object which means that we can use the handy functions from the coda package to inspect the result. Here is now the function importance_laplace_approx (including the helper function log_sum_exp) :

<div class="highlight" style="background: #f8f8f8"><pre style="line-height: 125%">library(coda)
library(mvtnorm)

<span style="color: #408080; font-style: italic"># A more numerically stable way of calculating log( sum( exp( x ))) Source:</span>
<span style="color: #408080; font-style: italic"># http://r.789695.n4.nabble.com/logsumexp-function-in-R-td3310119.html</span>
log_sum_exp <span style="color: #666666"><-</span> <span style="color: #008000; font-weight: bold">function</span>(x) {
xmax <span style="color: #666666"><-</span> which.max(x)
log1p(sum(exp(x[<span style="color: #666666">-</span>xmax] <span style="color: #666666">-</span> x[xmax]))) <span style="color: #666666">+</span> x[xmax]
}

<span style="color: #408080; font-style: italic"># Laplace approximation with optional importance sampling step Note that in</span>
<span style="color: #408080; font-style: italic"># order to avoid numerical instability all densities are on the log-scale.</span>
importance_laplace_approx <span style="color: #666666"><-</span> <span style="color: #008000; font-weight: bold">function</span>(model, inits, no_samples, no_resamples <span style="color: #666666">=</span> <span style="color: #666666">0</span>,
with_replacement <span style="color: #666666">=</span> <span style="color: #008000; font-weight: bold">F</span>, df <span style="color: #666666">=</span> <span style="color: #666666">2</span>, <span style="color: #008000; font-weight: bold">...</span>) {
fit <span style="color: #666666"><-</span> optim(inits, model, control <span style="color: #666666">=</span> list(fnscale <span style="color: #666666">=</span> <span style="color: #666666">-1</span>), hessian <span style="color: #666666">=</span> <span style="color: #008000; font-weight: bold">TRUE</span>,
<span style="color: #008000; font-weight: bold">...</span>)
param_mean <span style="color: #666666"><-</span> fit<span style="color: #666666">$</span>par param_cov_mat <span style="color: #666666"><-</span> solve(<span style="color: #666666">-</span>fit<span style="color: #666666">$</span>hessian)
<span style="color: #008000; font-weight: bold">if</span> (no_resamples <span style="color: #666666"><=</span> <span style="color: #666666">0</span>) {
<span style="color: #408080; font-style: italic"># Just sample from the Laplace distribution</span>
samples <span style="color: #666666"><-</span> rmvnorm(no_samples, param_mean, param_cov_mat)
<span style="color: #008000; font-weight: bold">return</span>(mcmc(samples))

} <span style="color: #008000; font-weight: bold">else</span> {
<span style="color: #408080; font-style: italic"># Importance sample</span>
samples <span style="color: #666666"><-</span> rmvt(no_samples, delta <span style="color: #666666">=</span> param_mean, sigma <span style="color: #666666">=</span> param_cov_mat,
df <span style="color: #666666">=</span> df)
colnames(samples) <span style="color: #666666"><-</span> names(inits)
prop_dens <span style="color: #666666"><-</span> dmvt(samples, param_mean, param_cov_mat, df <span style="color: #666666">=</span> df)
target_dens <span style="color: #666666"><-</span> apply(samples, <span style="color: #666666">1</span>, model, <span style="color: #008000; font-weight: bold">...</span>)
target_dens[<span style="color: #666666">!</span>is.finite(target_dens)] <span style="color: #666666"><-</span> <span style="color: #666666">-</span><span style="color: #008000; font-weight: bold">Inf</span>
weighted_dens <span style="color: #666666"><-</span> target_dens <span style="color: #666666">-</span> prop_dens
sample_prob <span style="color: #666666"><-</span> exp(weighted_dens <span style="color: #666666">-</span> log_sum_exp(weighted_dens))
resample_i <span style="color: #666666"><-</span> sample(nrow(samples), size <span style="color: #666666">=</span> no_resamples, replace <span style="color: #666666">=</span> with_replacement,
prob <span style="color: #666666">=</span> sample_prob)
resamples <span style="color: #666666"><-</span> samples[resample_i, , drop <span style="color: #666666">=</span> <span style="color: #008000; font-weight: bold">FALSE</span>]
colnames(resamples) <span style="color: #666666"><-</span> names(inits)
<span style="color: #008000; font-weight: bold">return</span>(mcmc(resamples))
}
}
</pre></div>

Let’s try it out on the model from Three Ways to Run Bayesian Models in R, that is:

$$y_i \sim \text{Normal}(\mu,\sigma)$$

$$\mu \sim \text{Normal}(0,100)$$

$$\sigma \sim \text{LogNormal}(0,4)$$

where $y$ is 20 datapoints generated like the following:

<div class="highlight" style="background: #f8f8f8"><pre style="line-height: 125%">set.seed(<span style="color: #666666">1337</span>)
y <span style="color: #666666"><-</span> rnorm(n <span style="color: #666666">=</span> <span style="color: #666666">20</span>, mean <span style="color: #666666">=</span> <span style="color: #666666">10</span>, sd <span style="color: #666666">=</span> <span style="color: #666666">5</span>)
c(mean <span style="color: #666666">=</span> mean(y), sd <span style="color: #666666">=</span> sd(y))
</pre></div>

<div class="highlight" style="background: #f8f8f8"><pre style="line-height: 125%"><span style="color: #408080; font-style: italic">##   mean     sd </span>
<span style="color: #408080; font-style: italic">## 12.721  5.762</span>
</pre></div>

Here is the corresponding model function calculating the unnormalized log posterior of the model above given a parameter vector p and a vector of datapoints y.

<div class="highlight" style="background: #f8f8f8"><pre style="line-height: 125%">model <span style="color: #666666"><-</span> <span style="color: #008000; font-weight: bold">function</span>(p, y) {
log_lik <span style="color: #666666"><-</span> sum(dnorm(y, p[<span style="color: #BA2121">"mu"</span>], p[<span style="color: #BA2121">"sigma"</span>], log <span style="color: #666666">=</span> <span style="color: #008000; font-weight: bold">T</span>))  <span style="color: #408080; font-style: italic"># the log likelihood</span>
log_post <span style="color: #666666"><-</span> log_lik <span style="color: #666666">+</span> dnorm(p[<span style="color: #BA2121">"mu"</span>], <span style="color: #666666">0</span>, <span style="color: #666666">100</span>, log <span style="color: #666666">=</span> <span style="color: #008000; font-weight: bold">T</span>) <span style="color: #666666">+</span> dlnorm(p[<span style="color: #BA2121">"sigma"</span>],
<span style="color: #666666">0</span>, <span style="color: #666666">4</span>, log <span style="color: #666666">=</span> <span style="color: #008000; font-weight: bold">T</span>)
log_post
}
</pre></div>

First let’s run a Laplace approximation without the resampling step by letting no_resamples = 0 (the default):

<div class="highlight" style="background: #f8f8f8"><pre style="line-height: 125%">samples <span style="color: #666666"><-</span> importance_laplace_approx(model, c(mu <span style="color: #666666">=</span> <span style="color: #666666">0</span>, sigma <span style="color: #666666">=</span> <span style="color: #666666">1</span>), y <span style="color: #666666">=</span> y, no_samples <span style="color: #666666">=</span> <span style="color: #666666">5000</span>)
densityplot(samples)
</pre></div>

<div class="highlight" style="background: #f8f8f8"><pre style="line-height: 125%">summary(samples)
</pre></div>

<div class="highlight" style="background: #f8f8f8"><pre style="line-height: 125%"><span style="color: #408080; font-style: italic">## </span>
<span style="color: #408080; font-style: italic">## Iterations = 1:5000</span>
<span style="color: #408080; font-style: italic">## Thinning interval = 1 </span>
<span style="color: #408080; font-style: italic">## Number of chains = 1 </span>
<span style="color: #408080; font-style: italic">## Sample size per chain = 5000 </span>
<span style="color: #408080; font-style: italic">## </span>
<span style="color: #408080; font-style: italic">## 1. Empirical mean and standard deviation for each variable,</span>
<span style="color: #408080; font-style: italic">##    plus standard error of the mean:</span>
<span style="color: #408080; font-style: italic">## </span>
<span style="color: #408080; font-style: italic">##        Mean    SD Naive SE Time-series SE</span>
<span style="color: #408080; font-style: italic">## mu    12.72 1.224   0.0173         0.0173</span>
<span style="color: #408080; font-style: italic">## sigma  5.45 0.839   0.0119         0.0119</span>
<span style="color: #408080; font-style: italic">## </span>
<span style="color: #408080; font-style: italic">## 2. Quantiles for each variable:</span>
<span style="color: #408080; font-style: italic">## </span>
<span style="color: #408080; font-style: italic">##        2.5%   25%   50%   75% 97.5%</span>
<span style="color: #408080; font-style: italic">## mu    10.33 11.88 12.72 13.57  15.1</span>
<span style="color: #408080; font-style: italic">## sigma  3.81  4.88  5.45  6.02   7.1</span>
</pre></div>

Here the 95% CI for sigma is $[3.81,7.10]$ which is a bit off compared to the actual 95% posterior CI which is $[4.38,8.39]$. Now, let’s see if we can improve on that by running the extra importance sampling step by setting no_resamples = 5000 and increasing no_samples to 25000.

<div class="highlight" style="background: #f8f8f8"><pre style="line-height: 125%">samples <span style="color: #666666"><-</span> importance_laplace_approx(model, c(mu <span style="color: #666666">=</span> <span style="color: #666666">0</span>, sigma <span style="color: #666666">=</span> <span style="color: #666666">1</span>), y <span style="color: #666666">=</span> y, no_samples <span style="color: #666666">=</span> <span style="color: #666666">25000</span>,
no_resamples <span style="color: #666666">=</span> <span style="color: #666666">5000</span>)
</pre></div>

<div class="highlight" style="background: #f8f8f8"><pre style="line-height: 125%"><span style="color: #408080; font-style: italic">## There were 50 or more warnings (use warnings() to see the first 50)</span>
</pre></div>

Hmmm, why the warnings? Well, the importance sampling step does not honor the boundaries of the parameters in our model and regularly tries sigmas that are negative resulting in NaN. We could fix this by checking if the parameters are within the bounds in the model function and if not return -Inf or we could happily ignore these warnings as importance_laplace_approx sets all NaNs to -Inf. So, did the importance sampling improve upon the estimated posterior?

<div class="highlight" style="background: #f8f8f8"><pre style="line-height: 125%">densityplot(samples)
</pre></div>

<div class="highlight" style="background: #f8f8f8"><pre style="line-height: 125%">summary(samples)
</pre></div>

<div class="highlight" style="background: #f8f8f8"><pre style="line-height: 125%"><span style="color: #408080; font-style: italic">## </span>
<span style="color: #408080; font-style: italic">## Iterations = 1:5000</span>
<span style="color: #408080; font-style: italic">## Thinning interval = 1 </span>
<span style="color: #408080; font-style: italic">## Number of chains = 1 </span>
<span style="color: #408080; font-style: italic">## Sample size per chain = 5000 </span>
<span style="color: #408080; font-style: italic">## </span>
<span style="color: #408080; font-style: italic">## 1. Empirical mean and standard deviation for each variable,</span>
<span style="color: #408080; font-style: italic">##    plus standard error of the mean:</span>
<span style="color: #408080; font-style: italic">## </span>
<span style="color: #408080; font-style: italic">##        Mean   SD Naive SE Time-series SE</span>
<span style="color: #408080; font-style: italic">## mu    12.71 1.36   0.0192         0.0192</span>
<span style="color: #408080; font-style: italic">## sigma  5.95 1.03   0.0146         0.0152</span>
<span style="color: #408080; font-style: italic">## </span>
<span style="color: #408080; font-style: italic">## 2. Quantiles for each variable:</span>
<span style="color: #408080; font-style: italic">## </span>
<span style="color: #408080; font-style: italic">##        2.5%   25%   50%   75% 97.5%</span>
<span style="color: #408080; font-style: italic">## mu    10.04 11.87 12.71 13.57 15.40</span>
<span style="color: #408080; font-style: italic">## sigma  4.36  5.23  5.81  6.49  8.32</span>
</pre></div>

Now the posterior of sigma correctly appears right skewed and the 95% CI is $[4.36,8.33]$, much closer to the actual CI.

So, all in all, I believe importance_laplace_approx is a really neat function. You can start off by quickly estimating your model using regular Laplace approximation and then add the importance sampling step when you want to shape up the Laplace approximation.

Disclaimer: I have not tested the function extensively so use it with a pinch of caution. Please tell me if you find an error in it!

I would like to thank Tal Galili for syndicating me on Rbloggers and Yihui Xie for the animation package with which the animations in this post were made.