| adaptMetropGibbs {spBayes} | R Documentation |
Markov chain Monte Carlo for continuous random vector using an adaptive Metropolis within Gibbs algorithm.
adaptMetropGibbs(ltd, starting, tuning=1, accept.rate=0.44,
batch = 1, batch.length=25, report=100,
verbose=TRUE, ...)
ltd |
an R function that evaluates the log target density of the
desired equilibrium distribution of the Markov chain. First argument is the
starting value vector of the Markov chain. Pass variables used in
the ltd via the ... argument of aMetropGibbs. |
starting |
a real vector of parameter starting values. |
tuning |
a scalar or vector of initial Metropolis tuning values. The vector must be of length(starting). If a scalar is passed then it is expanded to length(starting). |
accept.rate |
a scalar or vector of target Metropolis acceptance
rates. The vector must be of length(starting). If a scalar is passed then it is expanded to length(starting). |
batch |
the number of batches. |
batch.length |
the number of sampler iterations in each batch. |
report |
the number of batches between acceptance rate reports. |
verbose |
if TRUE, progress of the
sampler is printed to the screen. Otherwise, nothing is printed to
the screen. |
... |
currently no additional arguments. |
A list with the following tags:
p.samples |
a coda object of posterior samples for the parameters. |
acceptance |
the Metropolis acceptance rate at the end of each batch. |
ltd |
ltd |
accept.rate |
accept.rate |
batch |
batch |
batch.length |
batch.length |
This function is a rework of Rosenthal (2007) with some added niceties.
Andrew O. Finley finleya@msu.edu,
Sudipto Banerjee sudiptob@biostat.umn.edu
Roberts G.O. and Rosenthal J.S. (2006). Examples of Adaptive MCMC. http://probability.ca/jeff/ftpdir/adaptex.pdf Preprint.
Rosenthal J.S. (2007). AMCMC: An R interface for adaptive MCMC. Computational Statistics and Data Analysis. 51:5467-5470.
## Not run:
## Not run:
##########################
##Example of fitting a
##a non-linear model
##########################
set.seed(1)
##Simulate some data
par <- c(0.1,0.1,3,1)
tau.sq <- 0.01
fn <- function(par,x){
par[1]+par[2]^(1-(log(x/par[3])/par[4])^2)
}
n <- 200
x <- seq(1,10,0.1)
y <- rnorm(length(x), fn(par,x), sqrt(tau.sq))
##Define the log target density
ltd <- function(theta, x, y, fn, IG.a, IG.b){
theta[2:5] <- exp(theta[2:5])
tau.sq <- theta[5]
y.hat <- fn(theta[1:4],x)
##likelihood
logl <- -(n/2)*log(tau.sq)-(1/(2*tau.sq))*sum((y-y.hat)^2)
##priors IG on tau.sq and the rest flat
logl <- logl-(IG.a+1)*log(tau.sq)-IG.b/tau.sq
##Jacobian adjustments
logl <- logl+sum(log(theta[2:5]))
return(logl)
}
##Give some reasonable starting values,
##note the transformation
starting <- c(0.5, log(0.5), log(5), log(3), log(1))
m.1 <- adaptMetropGibbs(ltd, starting=starting,
batch=1200, batch.length=25,
x=x, y=y, fn=fn, IG.a=2, IG.b=0.01)
##Back transform
m.1$p.samples[,2:5] <- exp(m.1$p.samples[,2:5])
##Summary with 95
burn.in <- 10000
fn.pred <- function(par,x){
rnorm(length(x), fn(par[1:4],x), sqrt(par[5]))
}
post.curves <-
t(apply(m.1$p.samples[burn.in:nrow(m.1$p.samples),], 1, fn.pred, x))
post.curves.quants <- summary(mcmc(post.curves))$quantiles
plot(x, y, pch=19, xlab="x", ylab="f(x)")
lines(x, post.curves.quants[,1], lty="dashed", col="blue")
lines(x, post.curves.quants[,3])
lines(x, post.curves.quants[,5], lty="dashed", col="blue")
########################################
##Now some real data. There are way too
##few data for this model so we use a
##slightly informative normal prior on
##the parameters.
########################################
fn <- function(par,x){
par[1]-(par[2]^(1-(log(x/par[3])/par[4])^2))
}
x <- c(5,6,7,17,17,18,39,55,60)
y <- c(47.54,62.10,37.29,24.74,22.64,32.60,11.16,9.65,14.83)
n <- length(x)
##Define the log target density
ltd <- function(theta, x, y, fn, IG.a, IG.b){
theta[2:5] <- exp(theta[2:5])
tau.sq <- theta[5]
y.hat <- fn(theta[1:4],x)
##likelihood
logl <- -(n/2)*log(tau.sq)-(1/(2*tau.sq))*sum((y-y.hat)^2)
##priors IG on tau.sq and the rest normal
logl <- logl-(IG.a+1)*log(tau.sq)-IG.b/tau.sq+
sum(dnorm(theta[1:4], rep(0,4), 500, log = TRUE))
##Jacobian adjustments
logl <- logl+sum(log(theta[2:5]))
return(logl)
}
##Give some reasonable starting values,
##note the transformation
starting <- c(50, log(40), log(40), log(2), log(0.1))
m.1 <- adaptMetropGibbs(ltd, starting=starting,
batch=1500, batch.length=25,
x=x, y=y, fn=fn, IG.a=2, IG.b=10)
##Back transform
m.1$p.samples[,2:5] <- exp(m.1$p.samples[,2:5])
##Summary with 95
burn.in <- 20000
x.pred <- seq(0, 60, seq=0.1)
fn.pred <- function(par,x){
rnorm(length(x), fn(par[1:4],x), sqrt(par[5]))
}
post.curves <-
t(apply(m.1$p.samples[burn.in:nrow(m.1$p.samples),], 1, fn.pred, x.pred))
post.curves.quants <- summary(mcmc(post.curves))$quantiles
plot(x, y, pch=19, xlab="x", ylab="f(x)", xlim=c(0,60), ylim=c(0,100))
lines(x.pred, post.curves.quants[,1], lty="dashed", col="blue")
lines(x.pred, post.curves.quants[,3])
lines(x.pred, post.curves.quants[,5], lty="dashed", col="blue")
## End(Not run)
## End(Not run)