R Gibbs Sampler for Bayesian Regression

Question

I am trying to code a Gibbs sampler for a Bayesian regression model in R, and I am having trouble running my code. It seems there is something going on with the beta in the sigma.update function. When I run the code I get an error that says " Error in x %*% beta : non-conformable arguments" Here is what my code looks like:

x0 <- rep(1, 1000)
x1 <- rnorm(1000, 5, 7)
x <- cbind(x0, x1)
true_error <- rnorm(1000, 0, 2)
true_beta <- c(1.1, -8.2)
y <- x %*% true_beta + true_error

beta0 <- c(1, 1)
sigma0 <- 1  
a <- b <- 1
burnin <- 0
thin <- 1
n <- 100

gibbs <- function(n.sims, beta.start, a, b,
                  y, x, burnin, thin) {
   beta.draws <- matrix(NA, nrow=n.sims, ncol=1)
   sigma.draws<- c()
   beta.cur <- beta.start
   sigma.update <- function(a,b, beta, y, x) {
        1 / rgamma(1, a + ((length(x)) / 2),
                   b + (1 / 2) %*% (t(y - x %*% beta) %*% (y - x %*% beta)))
     }
   beta.update <- function(x, y, sigma) {
        rnorm(1, (solve(t(x) %*% x) %*% t(x) %*% y),
              sigma^2 * (solve(t(x) %*%x)))
     }
   for (i in 1:n.sims) {
     sigma.cur <- sigma.update(a, b, beta.cur, y, x)
     beta.cur <- beta.update(x, y, sigma.cur)
     if (i > burnin & (i - burnin) %% thin == 0) {
       sigma.draws[(i - burnin) / thin ] <- sigma.cur
       beta.draws[(i - burnin) / thin,] <- beta.cur
       }
     }
   return (list(sigma.draws, beta.draws) )
   }

gibbs(n, beta0, a, b, y, x, burnin, thin)

Answer 1

The function beta.update is not correct, it returns NaN . You are defining a matrix in the argument sd that is passed to rnorm , a vector is expected in this argument. I think what you are trying to do could be done in this way:

beta.update <- function(x, y, sigma) {
  rn <- rnorm(n=2, mean=0, sd=sigma)
  xtxinv <- solve(crossprod(x))
  as.vector(xtxinv %*% crossprod(x, y)) + xtxinv %*% rn
}

Notice that you are computing some elements that are fixed at all iterations. For example, you could define t(x) %*% x once and pass this element as argument to other functions. In this way you avoid doing these operations at every iteration, saving some computations and probably some time.

Edit

Based on your code, this is what I do:

x0 <- rep(1, 1000)
x1 <- rnorm(1000, 5, 7)
x <- cbind(x0, x1)
true_error <- rnorm(1000, 0, 2)
true_beta <- c(1.1, -8.2)
y <- x %*% true_beta + true_error

beta0 <- c(1, 1)
sigma0 <- 1  
a <- b <- 1
burnin <- 0
thin <- 1
n <- 100

gibbs <- function(n.sims, beta.start, a, b, y, x, burnin, thin) 
{
  beta.draws <- matrix(NA, nrow=n.sims, ncol=2)
  sigma.draws<- c()
  beta.cur <- beta.start
  sigma.update <- function(a,b, beta, y, x) {
    1 / rgamma(1, a + ((length(x)) / 2),
    b + (1 / 2) %*% (t(y - x %*% beta) %*% (y - x %*% beta)))
  }
  beta.update <- function(x, y, sigma) {
    rn <- rnorm(n=2, mean=0, sd=sigma)
    xtxinv <- solve(crossprod(x))
    as.vector(xtxinv %*% crossprod(x, y)) + xtxinv %*% rn
  }
  for (i in 1:n.sims) {
    sigma.cur <- sigma.update(a, b, beta.cur, y, x)
     beta.cur <- beta.update(x, y, sigma.cur)
     if (i > burnin & (i - burnin) %% thin == 0) {
       sigma.draws[(i - burnin) / thin ] <- sigma.cur
       beta.draws[(i - burnin) / thin,] <- beta.cur
     }
  }
  return (list(sigma.draws, beta.draws) )
}

And this is what I get:

set.seed(123)
res <- gibbs(n, beta0, a, b, y, x, burnin, thin)
head(res[[1]])
# [1] 3015.256257   13.632748    1.950697    1.861225    1.928381    1.884090
tail(res[[1]])
# [1] 1.887497 1.915900 1.984031 2.010798 1.888575 1.994850
head(res[[2]])
#          [,1]      [,2]
# [1,] 7.135294 -8.697288
# [2,] 1.040720 -8.193057
# [3,] 1.047058 -8.193531
# [4,] 1.043769 -8.193183
# [5,] 1.043766 -8.193279
# [6,] 1.045247 -8.193356
tail(res[[2]])
#            [,1]      [,2]
# [95,]  1.048501 -8.193550
# [96,]  1.037859 -8.192848
# [97,]  1.045809 -8.193377
# [98,]  1.045611 -8.193374
# [99,]  1.038800 -8.192880
# [100,] 1.047063 -8.193479