tests/smoke.R

In BDIB: Bayesian Dynamic Information Borrowing for Longitudinal Data with Informative Dropout

# Keep CRAN checks brief while exercising the complete fitting workflow.
# These short chains check execution only; they are not for inference.
library(BDIB)

check_result <- function(ans) {
  stopifnot(inherits(ans, "mlbslb_result"))
  stopifnot(all(vapply(ans$posterior_samples, function(x) length(x) > 0L, logical(1))))
  stopifnot(all(unlist(ans$probabilities) >= 0), all(unlist(ans$probabilities) <= 1))
  stopifnot(all(unlist(ans$decisions) %in% c(0L, 1L)))
}

settings <- list(n.chains = 1, n.iter = 200, n.burnin = 100,
                 n.thin = 1, parallel = FALSE)
t_vec <- c(4, 8, 12)

set.seed(1000)
historical <- generate_spm(12, t_vec, "gaussian", -4, 0.05, -1, 1,
                           theta = -3.2, sigma_e = 1)$dat
control <- generate_spm(8, t_vec, "gaussian", -4, 0.05, -1, 1,
                        theta = -3.2, sigma_e = 1)$dat
treatment <- generate_spm(12, t_vec, "gaussian", -5.3, 0.05, -1.5, 1,
                          theta = -3.7, sigma_e = 1)$dat
continuous <- MLB_SLB_anlaysis(
  historical, control, treatment, family = "gaussian", delta = 0.5,
  n_hist = 12, fixed_weight = 0.5, mcmc_settings = settings,
  decision_MLB = function(t, c) mean(t < c) > 0.95,
  direction_MLB = "lower",
  decision_SLB = function(t, c) mean(t < c) > 0.95,
  direction_SLB = "lower"
)
check_result(continuous)

set.seed(1000)
historical <- generate_spm(30, t_vec, "bernoulli", -4, 0.05, -1, 1,
                           theta = 0.4, beta0 = -2)$dat
control <- generate_spm(20, t_vec, "bernoulli", -4, 0.05, -1, 1,
                        theta = 0.4, beta0 = -2)$dat
treatment <- generate_spm(30, t_vec, "bernoulli", -5.3, 0.05, -1.5, 1,
                          theta = 0.5, beta0 = -1.5)$dat
binary <- MLB_SLB_anlaysis(
  historical, control, treatment, family = "bernoulli", delta = 0.1,
  n_hist = 30, fixed_weight = 0.5, mcmc_settings = settings,
  decision_MLB = function(t, c) mean(t > c) > 0.95,
  direction_MLB = "higher",
  decision_SLB = function(t, c) mean(t > c) > 0.95,
  direction_SLB = "higher"
)
check_result(binary)