tests/testthat/test_shrinkTVP.R

In shrinkTVP: Efficient Bayesian Inference for Time-Varying Parameter Models with Shrinkage

context("test shrinkTVP")

test_bed <- function(args, dummies = FALSE, transf = FALSE) {

  set.seed(123)
  full_dat <- data.frame(y = runif(16), x1 = rnorm(16), x2 = runif(16), x3 = factor(rep(c(1, 2), 8)))
  test <- full_dat[11:16, ]
  args$data <- full_dat[1:10, ]

  args$formula <- y ~ x1 + x2 - 1

  if (dummies == TRUE) {
    args$formula <- update.formula(args$formula, "~ . + x3")
  }

  if (transf == TRUE) {
    args$formula <- update.formula(args$formula, "~ . + I(x1^1) + I(log(x2))")
  }

  res <- do.call(shrinkTVP, args)

  expect_s3_class(res, "shrinkTVP")

  # Test methods
  expect_invisible(plot(res, nplot = 7))
  expect_visible(summary(res))
  expect_invisible(plot(res$beta[[1]]))
  expect_visible(res)

  # Test prediction related functions/methods
  expect_type(LPDS(res, test[1,]), "double")
  expect_type(eval_pred_dens(-5:5, res, test[1,]), "double")
  expect_length(eval_pred_dens(-5:5, res, test[1,]), length(-5:5))

  expect_s3_class(forecast_shrinkTVP(res, test), "shrinkTVP_forc")
  expect_s3_class(predict(res), "shrinkTVP_pred")
  expect_s3_class(fitted(res), "shrinkTVP_fitted")
  expect_s3_class(residuals(res), "shrinkTVP_resid")
}

mod_type = c("triple", "double", "ridge")
transformations <- c(TRUE, FALSE)
dummies <- c(TRUE, FALSE)
#p <- c(0, 1, 2)
scenarios <- expand.grid(mod_type, transformations, dummies)#, p)
names(scenarios) <- c("mod_type", "transf", "dummies")#, "p")

params <- c(
  "learn_a_xi",
  "learn_a_tau",
  "learn_c_xi",
  "learn_c_tau",
  "a_eq_c_xi",
  "a_eq_c_tau",
  "learn_kappa2_B",
  "learn_lambda2_B",
  "sv",
  "a_xi_adaptive",
  "c_xi_adaptive",
  "a_tau_adaptive",
  "c_tau_adaptive"
)

for(i in length(scenarios)) {

  for (j in params) {

    args <- formals(shrinkTVP)
    args <- args[sapply(args, function(x) x != "")]

    if (grepl("adaptive", j)) {
      args$MH_tuning$temp <- FALSE
      names(args$MH_tuning) <- j
    } else {
      args[[j]] <- !args[[j]]
    }

    #args$p <- scenarios$p[i]
    args$mod_type <- as.character(scenarios$mod_type[i])
    args$display_progress <- FALSE
    args$niter <- 10
    args$nburn <- 0

    test_that(paste0("scenario: ", i,  ", mod_type: ", scenarios$mod_type[i],
                     ", transformations: ", scenarios$transf[i],
                     ", dummies: ", scenarios$dummies[i],
                     #", p: ", scenarios$p[i],
                     ", toggled: ", j), {
                       test_bed(args, scenarios$dummies[i], scenarios$transf[i])
                     })

  }
}