version 0.9.9

DESCRIPTION

@@ -1,19 +1,19 @@
 Package: bsts
-Version: 0.9.8
-Date: 2022-05-27
+Version: 0.9.9
+Date: 2022-11-03
 Title: Bayesian Structural Time Series
 Author: Steven L. Scott <[email protected]>
 Maintainer: Steven L. Scott <[email protected]>
 Description: Time series regression using dynamic linear models fit using
  MCMC. See Scott and Varian (2014) <DOI:10.1504/IJMMNO.2014.059942>, among many
  other sources.
-Depends: BoomSpikeSlab (>= 1.2.5), zoo (>= 1.8), xts, Boom (>= 0.9.10),
+Depends: BoomSpikeSlab (>= 1.2.5), zoo (>= 1.8), xts, Boom (>= 0.9.11),
  R(>= 3.4.0)
 Suggests: testthat
-LinkingTo: Boom (>= 0.9.10)
+LinkingTo: Boom (>= 0.9.11)
 License: LGPL-2.1 | MIT + file LICENSE
 Encoding: UTF-8
 NeedsCompilation: yes
-Packaged: 2022-05-29 22:58:07 UTC; steve
+Packaged: 2022-11-06 20:47:53 UTC; steve
 Repository: CRAN
-Date/Publication: 2022-05-30 07:00:12 UTC
+Date/Publication: 2022-11-07 08:50:11 UTC

MD5

@@ -1,4 +1,4 @@
-77060bb31e06c8bce2996840a62ec823 *DESCRIPTION
+3e7a94e74d8420bd9659550450c174f2 *DESCRIPTION
 ccd3022578bbd36b69595f56cd8d83e5 *LICENSE
 1570eae7bf1ed9a241feeacb9404345b *NAMESPACE
 ceb07fe9db975f5c42496dfaa33a5d14 *R/add.ar.R
@@ -14,7 +14,7 @@ d4f5df46c6a15e0d4e47ede074775446 *R/add.semilocal.linear.trend.R
 f965dd362d2321286bea83acd0b40c2d *R/add.static.intercept.R
 c69a20b8a59408f1c7e47c51c180b36b *R/add.student.local.linear.trend.R
 585ef9759883b1349a00d140b91faacd *R/add.trig.R
-a98db043d454fecd68c910546bdecf64 *R/bsts.R
+5e596c7028f1b1db6ed476e3fd89bd02 *R/bsts.R
 642f82708acd5ce362948999df6aaf2d *R/compare.bsts.models.R
 994c84adfa23228d724050d98c6a560e *R/date.functions.R
 7512979ef565815e645dfc2dbab35bd8 *R/diagnostics.R
@@ -153,7 +153,7 @@ d99ce4ef93988dc2e1b7279ab92be31e *src/aggregate_time_series.cc
 776cfc2e6f5b39a8354601ceaf73905b *src/create_state_model.cpp
 f8f89c660dc8cf6920e8694d25b99671 *src/create_state_model.h
 4a0ab82799effea8a0f2998cfb9302f7 *src/dirm.cc
-f698985e6d5832df83a7ec75e44fcbce *src/dynamic_intercept_model_manager.cc
+c230f6664bd466e38e8e427d73b81cd2 *src/dynamic_intercept_model_manager.cc
 f4b47e0c03ea817b60f652813b16fb06 *src/dynamic_intercept_model_manager.h
 e6f88ebc8a3c65c29fd14268e57fe4d9 *src/get_date_ranges.cc
 cf13c9e432dda0d3468449ec04dc4804 *src/mbsts.cc
@@ -191,5 +191,6 @@ abadc45049de045297dc88b776546d08 *tests/testthat/test-poisson.R
 e91ff5f823c6acbff0b7b7d6810a82a8 *tests/testthat/test-prediction.R
 74913baa6a0f8135591ba1c6d7b7e46e *tests/testthat/test-regressionholiday.R
 ebe710afd159f82025b7c8b9d6e6d237 *tests/testthat/test-seasonal.R
+e0c7763b06a704f13b10d4248db8f344 *tests/testthat/test-sigma-upper-limit.R
 6c0c26d250eb86a7f004138b65297c90 *tests/testthat/test-student.R
 9f6f10bf2045923b08f20734cef76b22 *tests/testthat/test-trig.R

R/bsts.R

@@ -424,7 +424,13 @@ BstsOptions <- function(save.state.contributions = TRUE,
  ## deviation that are greater than 20% larger than the empirical
  ## SD.
  sdy <- sqrt(var(data.list$response, na.rm = TRUE))
- sigma.upper.limit <- sdy * 1.2
+ dots <- list(...)
+ if ("sigma.upper.limit" %in% names(dots)) {
+ sigma.upper.limit <- dots $sigma.upper.limit
+ } else {
+ sigma.upper.limit <- sdy * 1.2
+ }
+
  if (!has.regression) {
  prior <- SdPrior(sigma.guess = sdy,
  sample.size = .01,
@@ -434,6 +440,16 @@ BstsOptions <- function(save.state.contributions = TRUE,
  zero <- rep(0, ncol(data.list$predictors))
  if (bma.method == "SSVS") {
  ## If using SSVS then the default prior is Zellner's g-prior.
+
+ ### TODO(steve):
+ ## replace the raw function call with do.call. You need to name each
+ ## of the function parameters as they're named in SpikeSlabPrior, and
+ ## pass the list of arguments. When you do this pass
+ ## sigma.upper.limit as part of 'dots' and not as a separate argument.
+
+ # The call looks like prior <- do.call(SpikeSlabPrior, dots) you'll need
+ # to put dots$x = data.list$predictors, dots$y = data.list$response,
+ # dots$optional.coefficient.estimate = zero, etc.
  prior <- SpikeSlabPrior(data.list$predictors,
  data.list$response,
  optional.coefficient.estimate = zero,
@@ -475,13 +491,19 @@ BstsOptions <- function(save.state.contributions = TRUE,
  }
  } else if (family == "student") {
  sdy <- sqrt(var(data.list$response, na.rm = TRUE))
- sigma.upper.limit <- sdy * 1.2
+ dots = list(...)
+ if ("sigma.upper.limit" %in% names(dots)) {
+ sigma.upper.limit = dots$sigma.upper.limit
+ } else {
+ sigma.upper.limit <- sdy * 1.2
+ }
  if (!has.regression) {
  y <- data.list$response
  prior <- StudentSpikeSlabPrior(
  matrix(1.0, nrow = length(y), ncol = 1),
  y,
  prior.inclusion.probabilities = 0,
+ sigma.upper.limit = sigma.upper.limit,
  ...)
  } else {
  zero <- rep(0, ncol(data.list$predictors))
@@ -634,4 +656,21 @@ BstsOptions <- function(save.state.contributions = TRUE,
  if (!data.list$timestamp.info$timestamps.are.trivial && dynamic.regression) {
  stop("Dynamic regression models are only supported with trivial time stamps.")
  }
+
+ is.state.model <- sapply(state.specification, inherits, "StateModel")
+ if (!all(is.state.model)) {
+ error.message <- paste0(
+ "The state.specification should be a list of StateModel objects. ")
+ if (sum(!is.state.model) == 1) {
+ error.message <- paste0(
+ error.message,
+ "The list element in position: ", which(is.state.model),
+ " is not a StateModel object.")
+ } else {
+ error.message <- paste0(
+ "The list elements in positions: ", which(is.state.model),
+ " are not StateModel objects.")
+ }
+ stop(error.message)
+ }
 }

src/dynamic_intercept_model_manager.cc

@@ -134,10 +134,11 @@ namespace BOOM {
  io_manager.stream();
  if (refilter) {
  model_->kalman_filter();
- const Kalman::MarginalDistributionBase &marg(
+ const Kalman::MultivariateMarginalDistributionBase &marg(
  model_->get_filter().back());
+ Ptr<SparseKalmanMatrix> forecast_precision = marg.sparse_forecast_precision();
  final_state() = rmvn(marg.contemporaneous_state_mean(),
- marg.contemporaneous_state_variance());
+  marg.contemporaneous_state_variance(forecast_precision));
  }
  ans.row(i) = model_->simulate_forecast(
  rng(),

tests/testthat/test-sigma-upper-limit.R

@@ -0,0 +1,19 @@
+library(bsts)
+library(testthat)
+
+test_that("sigma.upper.limit can be specified at the main bsts call.", {
+ y <- rnorm(4)
+ x <- rnorm(4)
+ ss <- AddLocalLevel(list(), y)
+
+ warning("enable the test for 'sigma.upper.limit'")
+
+ ## for (i in 1:20) {
+ ## model <- bsts(y, ss, niter = 100, ping = -1, sigma.upper.limit = 10)
+ ## }
+ ## expect_true(inherits(model, "bsts"))
+
+ ## for(i in 1:20) {
+ ## model <- bsts(y ~ x, ss, niter = 10, ping = -1, sigma.upper.limit = 10)
+ ## }
+})