r-从概率网格中采样（贝叶斯后验近似）

Question

I am doing a Bayesian analysis, and I am trying to estimate two parameters. To approximate the posterior distribution, I have constructed a fine grid and computed the posterior probability for each element in the grid. I normalized it so that the grid sums to 1.

Now I am interested in sampling from the distribution. This is what I have so far:

sampleGrid <- function(post.grid, mu.grid, sig2.grid) {
  value <- sample(post.grid, 1, prob=post.grid)
  index <- which(post.grid == value) 
  col <- as.integer(index/nrow(post.grid))+1
  row <- index-(col-1)*nrow(post.grid)
  return(c(mu.grid[row], sig2.grid[col]))
}

However, I run into problems with runtime when I want to sample a lot because I use a for loop:

for(i in 1:nrow(sample.grid)) {
  sample.grid[i, ] <- sampleFromGrid(post.grid, mu.grid, sig2.grid)
}

I was wondering if there was a way to vectorize this. My attempt was:

vectorizedSampleFromGrid <- function(post.grid, mu.grid, sig2.grid, n){
    values <- sample(post.grid, n, replace=T, prob=post.grid)
    index <- which(post.grid %in% values)
    if(length(values)!=length(index)) {
        temp.df <- count(values)
        index <- which(post.grid %in% temp.df[,1])
        temp.df <- cbind(temp.df, index)
        temp.df <- temp.df[temp.df[, 2] > 1, ]
        for(i in 1:nrow(temp.df)) {
            index <- c(index, rep(temp.df[i, 3], temp.df[i,2]-1))
        }
    }
    col <- as.integer(index/nrow(post.grid))+1
    row <- index-(col-1)*nrow(post.grid)
    return(cbind(mu.grid[row], sig2.grid[col]))
}

I know that some elements will be sampled more than once. What I am trying to do is append those indexes multiple times to the original index list based on how many times they were sampled. However when I do this the result is not correct.

If anyone can offer any advice, I would greatly appreciate it.

Answer 1

Here is what I would do. Create a vectorized function to evaluate the posterior (or at least something that is proportional to it):

f = function(mu, sigma, log=TRUE) {
  logf = dnorm(mu, 0, sigma, log=TRUE) + dgamma(sigma, 1, 1, log=TRUE)
  if (log) return(logf)
  return(exp(f))
}

Now evaluate this function on a grid.

library(dplyr)
grid = mutate(expand.grid(mu=seq(-3,3,1), sigma=seq(1,7,1)),
              logp = f(mu,sigma),
              logp = logp-max(logp), # for numerical stability
              p    = exp(logp),
              p    = p/sum(p))       # Normalize

Now obtain samples from this grid:

samples = sample_n(grid, size=100, replace=TRUE, weight=grid$p)