R/smc.r
Run a sequential Monte Carlo algorithm
biips_smc_samples(object, ...) # S3 method for biips biips_smc_samples(object, variable_names, n_part, type = "fs", rs_thres = 0.5, rs_type = "stratified", ...)
object |
|
---|---|
... | additional arguments to pass to internal functions |
variable_names | character vector. The names of the unobserved
variables to monitor, e.g.: |
n_part | integer. Number of particles. |
type | string containing the characters |
rs_thres | real. Threshold for the adaptive SMC resampling. (default = 0.5)
|
rs_type | string. Name of the algorithm used for the SMC
resampling. Possible values are |
A smcarray.fsb.list
object, with one named member for
each monitored variable in the variable_names
argument and a member
named log_marg_like
with an estimate of the log marginal likelihood.
A smcarray.fsb.list
object is a named list of
smcarray.fsb
objects for different variables. Each
smcarray.fsb
object is a named list of smcarray
object, with one member for each type of monitoring (f
, s
and/or b
) in the type
argument. Assuming dim
is the
dimension of the monitored variable, a smcarray
object is a
list with the members:
array of dimension c(dim, n_part)
with the
values of the particles.
array of dimension c(dim, n_part)
with
the weights of the particles.
array of dimension dim
with Effective Sample Sizes (ESS)
of the particles set.
array of dimension dim
with
logicals indicating discreteness of each component.
array of dimension dim
with sampling iterations of
each component.
lists of the contitioning variables (observations). Its value is:
for filtering: a list of dimension dim
. each member is a
character vector with the respective conditioning variables of the
node array component.
for smoothing/backward_smoothing: a character vector, the same for all the components of the node array.
string with the name of the variable (without subset indices).
vector with the lower bounds of the variable.
vector with the upper bounds of the variable.
string with the type of monitor ('filtering'
,
'smoothing'
or 'backward_smoothing'
).
biips_model
, biips_diagnosis
,
biips_summary
, biips_density
,
biips_table
modelfile <- system.file('extdata', 'hmm.bug', package = 'rbiips') stopifnot(nchar(modelfile) > 0) cat(readLines(modelfile), sep = '\n')#> var c_true[tmax], x_true[tmax], c[tmax], x[tmax], y[tmax] #> #> data #> { #> x_true[1] ~ dnorm(0, 1/5) #> y[1] ~ dnorm(x_true[1], exp(logtau_true)) #> for (t in 2:tmax) #> { #> c_true[t] ~ dcat(p) #> x_true[t] ~ dnorm(0.5*x_true[t-1]+25*x_true[t-1]/(1+x_true[t-1]^2)+8*cos(1.2*(t-1)), ifelse(c_true[t]==1, 1/10, 1/100)) #> y[t] ~ dnorm(x_true[t]/4, exp(logtau_true)) #> } #> } #> #> model #> { #> logtau ~ dunif(-3, 3) #> x[1] ~ dnorm(0, 1/5) #> y[1] ~ dnorm(x[1], exp(logtau)) #> for (t in 2:tmax) #> { #> c[t] ~ dcat(p) #> x[t] ~ dnorm(0.5*x[t-1]+25*x[t-1]/(1+x[t-1]^2)+8*cos(1.2*(t-1)), ifelse(c[t]==1, 1/10, 1/100)) #> y[t] ~ dnorm(x[t]/4, exp(logtau)) #> } #> }data <- list(tmax = 10, p = c(.5, .5), logtau_true = log(1), logtau = log(1)) model <- biips_model(modelfile, data, sample_data = TRUE)#> * Parsing model in: /home/adrien/Dropbox/workspace/rbiips/inst/extdata/hmm.bug #> * Compiling data graph #> Declaring variables #> Resolving undeclared variables #> Allocating nodes #> Graph size: 169 #> Sampling data #> Reading data back into data table #> * Compiling model graph #> Declaring variables #> Resolving undeclared variables #> Allocating nodes #> Graph size: 180n_part <- 100 out_smc <- biips_smc_samples(model, c('x', 'c[2:10]'), n_part, type = 'fs', rs_thres = 0.5, rs_type = 'stratified')#> * Assigning node samplers #> * Running SMC forward sampler with 100 particles #> |--------------------------------------------------| 100% #> |**************************************************| 10 iterations in 0.01 sbiips_diagnosis(out_smc)#> * Diagnosis of variable: c[2:10] #> Filtering: GOOD #> Smoothing: POOR #> The minimum effective sample size is too low: 17.9102 #> Estimates may be poor for some variables. #> You should increase the number of particles #> .* Diagnosis of variable: x[1:10] #> Filtering: GOOD #> Smoothing: POOR #> The minimum effective sample size is too low: 17.9102 #> Estimates may be poor for some variables. #> You should increase the number of particles #> .summ_smc_x <- biips_summary(out_smc$x, order = 2, probs = c(.025, .975)) dens_smc_x <- biips_density(out_smc$x, bw = 'nrd0', adjust = 1, n = 100) summ_smc_c <- biips_summary(out_smc[['c[2:10]']]) table_smc_c <- biips_table(out_smc[['c[2:10]']]) par(mfrow = c(2, 2)) plot(model$data()$x_true, type = 'l', col = 'green', xlab = 't', ylab = 'x[t]') lines(summ_smc_x$f$mean, col = 'blue') lines(summ_smc_x$s$mean, col = 'red') matlines(matrix(unlist(summ_smc_x$f$quant), data$tmax), lty = 2, col = 'blue') matlines(matrix(unlist(summ_smc_x$s$quant), data$tmax), lty = 2, col = 'red') legend('topright', leg = c('true', 'SMC filtering estimate', 'SMC smoothing estimate'), lty = 1, col = c('green', 'blue', 'red'), bty = 'n') barplot(.5*(model$data()$c_true==1), col = 'green', border = NA, space = 0, offset=2, ylim=c(0,3), xlab='t', ylab='c[t]==1', axes = FALSE) axis(1, at=1:data$tmax-.5, labels=1:data$tmax) axis(2, line = 1, at=c(0,3), labels=NA) text(data$tmax/2, 2.75, 'true') barplot(.5*c(NA, summ_smc_c$f$mode==1), col = 'blue', border = NA, space = 0, offset=1, axes = FALSE, add = TRUE) text(data$tmax/2, 1.75, 'SMC filtering mode') barplot(.5*c(NA, summ_smc_c$s$mode==1), col = 'red', border = NA, space = 0, axes = FALSE, add = TRUE) text(data$tmax/2, .75, 'SMC smoothing mode') t <- 5 plot(dens_smc_x[[t]], col = c('blue','red'), ylab = 'posterior density') points(model$data()$x_true[t], 0, pch = 17, col = 'green') plot(table_smc_c[[t-1]], col = c('blue','red'), ylab = 'posterior probability mass')points(model$data()$c_true[t], 0, pch = 17, col = 'green')