# Same data as in Vihola, Helske, Franks (2020)
data(poisson_series)
s <- sd(log(pmax(0.1, poisson_series)))
model <- bsm_ng(poisson_series, sd_level = uniform(0.115, 0, 2 * s),
sd_slope = uniform(0.004, 0, 2 * s), P1 = diag(0.1, 2),
distribution = "poisson")
# \donttest{
out <- run_mcmc(model, iter = 1e5, particles = 10)
summary(out, variable = "theta", return_se = TRUE)
# should be about 0.093 and 0.016
summary(out, variable = "states", return_se = TRUE,
states = 1, times = c(1, 100))
# should be about -0.075, 2.618
# }
model <- bsm_ng(Seatbelts[, "VanKilled"], distribution = "poisson",
sd_level = halfnormal(0.01, 1),
sd_seasonal = halfnormal(0.01, 1),
beta = normal(0, 0, 10),
xreg = Seatbelts[, "law"],
# default values, just for illustration
period = 12L,
a1 = rep(0, 1 + 11), # level + period - 1 seasonal states
P1 = diag(1, 12),
C = matrix(0, 12, 1),
u = rep(1, nrow(Seatbelts)))
# \donttest{
set.seed(123)
mcmc_out <- run_mcmc(model, iter = 5000, particles = 10, mcmc_type = "da")
mcmc_out$acceptance_rate
theta <- expand_sample(mcmc_out, "theta")
plot(theta)
summary(theta)
library("ggplot2")
ggplot(as.data.frame(theta[,1:2]), aes(x = sd_level, y = sd_seasonal)) +
geom_point() + stat_density2d(aes(fill = ..level.., alpha = ..level..),
geom = "polygon") + scale_fill_continuous(low = "green", high = "blue") +
guides(alpha = "none")
# Traceplot using as.data.frame method for MCMC output
library("dplyr")
as.data.frame(mcmc_out) |>
filter(variable == "sd_level") |>
ggplot(aes(y = value, x = iter)) + geom_line()
# }
# Model with slope term and additional noise to linear predictor to capture
# excess variation
model2 <- bsm_ng(Seatbelts[, "VanKilled"], distribution = "poisson",
sd_level = halfnormal(0.01, 1),
sd_seasonal = halfnormal(0.01, 1),
beta = normal(0, 0, 10),
xreg = Seatbelts[, "law"],
sd_slope = halfnormal(0.01, 0.1),
sd_noise = halfnormal(0.01, 1))
# instead of extra noise term, model using negative binomial distribution:
model3 <- bsm_ng(Seatbelts[, "VanKilled"],
distribution = "negative binomial",
sd_level = halfnormal(0.01, 1),
sd_seasonal = halfnormal(0.01, 1),
beta = normal(0, 0, 10),
xreg = Seatbelts[, "law"],
sd_slope = halfnormal(0.01, 0.1),
phi = gamma_prior(1, 5, 5))
Run the code above in your browser using DataLab