Running ‘testthat.R’ [125s/207s]
Running the tests in ‘tests/testthat.R’ failed.
Complete output:
  > library(testthat)
  > 
  > test_check("mcmcsae")
  Loading required package: mcmcsae
  Saving _problems/test_bart-21.R
  [ FAIL 1 | WARN 0 | SKIP 0 | PASS 915 ]
  
  ══ Failed tests ════════════════════════════════════════════════════════════════
  ── Error ('test_bart.R:17:3'): BART component 'brt' works ──────────────────────
  Error in `(function (formula, X = NULL, n.trees = 75L, name = "", debug = FALSE, keepTrees = FALSE, e, in.block, ...)  {     type <- "brt"     if (name == "")          stop("missing model component name")     if (!requireNamespace("dbarts", quietly = TRUE))          stop("package dbarts required for a model including Bayesian Additive Regression Trees")     if (e[["modeled.Q"]] && e[["Q0.type"]] == "symm")          stop("BART component not compatible with non-diagonal residual variance matrix")     if (is.null(X)) {         X <- model_matrix(formula, e[["data"]], contrasts.arg = "contr.none", sparse = FALSE)     }     else {         if (is.null(dimnames(X)[[2L]]))              colnames(X) <- seq_len(ncol(X))     }     X <- economizeMatrix(X, sparse = FALSE, strip.names = FALSE, check = TRUE)     q <- ncol(X)     in.block <- FALSE     control <- dbarts::dbartsControl(n.chains = 1L, updateState = FALSE, n.trees = n.trees)     name_sampler <- paste0(name, "_sampler_")     lp <- function(p) copy_vector(p[[name]])     lp_update <- function(x, plus = TRUE, p) v_update(x, plus, p[[name]])     draws_linpred <- function(obj, units = NULL, chains = NULL, draws = NULL, matrix = FALSE) {         if (is.null(obj[[name]]))              stop("no fitted values for 'brt' component; please re-run MCMCsim with 'store.all=TRUE'")         if (matrix)              out <- as.matrix.dc(get_from(obj[[name]], vars = units, chains = chains, draws = draws))         else {             out <- list()             for (ch in seq_along(chains)) out[[ch]] <- get_from(obj[[name]], vars = units, chains = chains[ch], draws = draws)[[1L]]         }         out     }     create_BART_sampler <- function() {         if (e[["Q0.type"]] == "diag") {             dbarts::dbarts(formula = X, data = e$y_eff(), weights = e$Q0@x, sigma = if (e[["sigma.fixed"]])                  1             else NA_real_, control = control, ...)         }         else {             dbarts::dbarts(formula = X, data = e$y_eff(), sigma = if (e[["sigma.fixed"]])                  1             else NA_real_, control = control, ...)         }     }     start <- function(p) {         if (is.null(p[[name_sampler]])) {             p[[name_sampler]] <- create_BART_sampler()         }         p[[name]] <- p[[name_sampler]]$run(0L, 1L, FALSE)$train[, 1L]         p     }     if (e$family[["family"]] == "multinomial") {         edat <- new.env(parent = environment(formula))         environment(formula) <- edat     }     if (keepTrees) {         name_trees <- paste0(name, "_", "trees_")         store.default <- name_trees     }     else {         store.default <- NULL     }     make_predict <- function(newdata = NULL, Xnew = NULL, verbose = TRUE) {         if (is.null(newdata) && is.null(Xnew)) {             linpred <- function(p) copy_vector(p[[name]])             linpred_update <- function(x, plus = TRUE, p) v_update(x, plus, p[[name]])         }         else {             if (is.null(newdata)) {                 if (missing(Xnew))                    stop("one of 'newdata' and 'Xnew' should be supplied")             }             else {                 if (!keepTrees)                    stop("out-of-sample prediction requires setting keepTrees=TRUE in brt() model specification")                 nnew <- nrow(newdata)                 if (e$family[["family"]] == "multinomial") {                   Xnew <- NULL                   for (k in seq_len(e[["Km1"]])) {                     edat$cat_ <- factor(rep.int(e$cats[k], nnew), levels = e$cats[-length(e$cats)])                     Xnew <- rbind(Xnew, model_matrix(formula, data = newdata, contrasts.arg = "contr.none", sparse = FALSE))                   }                   edat$cat_ <- NULL                 }                 else {                   Xnew <- model_matrix(formula, newdata, contrasts.arg = "contr.none", sparse = FALSE)                 }             }             if (is.null(dimnames(Xnew)[[2L]])) {                 if (ncol(Xnew) != q)                    stop("wrong number ", ncol(Xnew), " predictor column(s) for model term '", name, "' versus ", q, " originally")             }             else {                 Xnew <- Xnew[, dimnames(X)[[2L]], drop = FALSE]             }             Xnew <- economizeMatrix(Xnew, sparse = FALSE, strip.names = TRUE, check = TRUE)             rm(newdata, verbose)             nnew <- nrow(Xnew)             tree_predict <- function(p) {                 getPredictionsForTreeRecursive <- function(tree, indices) {                   if (tree$var[1L] == -1L) {                     predictions[indices] <<- predictions[indices] + tree$value[1L]                     return(1L)                   }                   goesLeft <- Xnew[indices, tree$var[1L]] <= tree$value[1L]                   headOfLeftBranch <- tree[-1L, ]                   n_nodes.left <- getPredictionsForTreeRecursive(headOfLeftBranch, indices[goesLeft])                   headOfRightBranch <- tree[seq.int(2L + n_nodes.left, dim(tree)[1L]), ]                   n_nodes.right <- getPredictionsForTreeRecursive(headOfRightBranch, indices[!goesLeft])                   return(1L + n_nodes.left + n_nodes.right)                 }                 trees <- p[[name_trees]]                 predictions <- numeric(nnew)                 for (t in seq_len(n.trees)) getPredictionsForTreeRecursive(trees[trees$tree == t, ], seq_len(nnew))                 predictions             }             linpred <- function(p) tree_predict(p)             linpred_update <- function(x, plus = TRUE, p) v_update(x, plus, tree_predict(p))         }         environment()     }     rprior <- function(p) {         if (is.null(p[[name_sampler]])) {             p[[name_sampler]] <- create_BART_sampler()         }         p[[name_sampler]]$sampleTreesFromPrior()         p[[name_sampler]]$sampleNodeParametersFromPrior()         p[[name]] <- p[[name_sampler]]$predict(X)         if (keepTrees) {             p[[name_trees]] <- p[[name_sampler]]$getTrees()[, -2L]         }         p     }     if (!e[["prior.only"]]) {         draw <- if (debug)              function(p) {                 browser()             }         else function(p) {         }         if (!e[["single.block"]]) {             if (e[["e.is.res"]])                  draw <- add(draw, bquote(p$e_ <- p[["e_"]] + p[[.(name)]]))             else draw <- add(draw, bquote(p$e_ <- p[["e_"]] - p[[.(name)]]))             draw <- add(draw, bquote(p[[.(name_sampler)]]$setResponse(p[["e_"]])))         }         if (e[["modeled.Q"]])              draw <- add(draw, bquote(p[[.(name_sampler)]]$setWeights(p[["Q_"]])))         draw <- add(add(draw, bquote(p[[.(name_sampler)]]$setSigma(.(if (e$sigma.fixed)              1         else quote(p[["sigma_"]]))))), bquote(p[[.(name)]] <- p[[.(name_sampler)]]$run(0L, 1L)$train[, 1L]))         if (keepTrees) {             draw <- add(draw, bquote(p[[.(name_trees)]] <- p[[.(name_sampler)]]$getTrees()[, -2L]))             if (e[["single.block"]]) {                 min.y <- min(e$y_eff())                 range.y <- max(e$y_eff()) - min.y             }             else {                 draw <- add(draw, quote(min.y <- min(p[["e_"]])))                 draw <- add(draw, quote(range.y <- max(p[["e_"]]) - min.y))             }             draw <- add(draw, bquote(p[[.(name_trees)]]$value[p[[.(name_trees)]]$var == -1L] <- min.y/n.trees + range.y * (p[[.(name_trees)]]$value[p[[.(name_trees)]]$var == -1L] + 0.5/n.trees)))         }         if (e[["single.block"]]) {             if (e[["e.is.res"]])                  draw <- add(draw, bquote(p$e_ <- e$y_eff() - p[[.(name)]]))             else draw <- add(draw, bquote(p$e_ <- p[[.(name)]]))         }         else {             if (e[["e.is.res"]])                  draw <- add(draw, bquote(p$e_ <- p[["e_"]] - p[[.(name)]]))             else draw <- add(draw, bquote(p$e_ <- p[["e_"]] + p[[.(name)]]))         }         draw <- add(draw, quote(p))     }     environment() })(~0 + x, n.trees = n.tr, debug = FALSE, keepTrees = TRUE, name = "bart", e = <environment>, in.block = FALSE)`: package dbarts required for a model including Bayesian Additive Regression Trees
  Backtrace:
      ▆
   1. ├─mcmcsae::create_sampler(...) at test_bart.R:17:3
   2. │ └─base::do.call(...)
   3. └─mcmcsae (local) `<fn>`(...)
  
  [ FAIL 1 | WARN 0 | SKIP 0 | PASS 915 ]
  Error:
  ! Test failures.
  Execution halted