Running ‘testthat.R’ [4s/7s]
Running the tests in ‘tests/testthat.R’ failed.
Complete output:
  > library(testthat)
  > library(MCMCvis)
  > 
  > test_check("MCMCvis")
   ----------- FAILURE REPORT -------------- 
   --- failure: the condition has length > 1 ---
   --- srcref --- 
  : 
   --- package (from environment) --- 
  MCMCvis
   --- call from context --- 
  MCMCchains(object, params, excl, ISB, mcmc.list = FALSE)
   --- call from argument --- 
  if (coda::is.mcmc.list(object) != TRUE & typeof(object) != "double" & 
      class(object) != "rjags" & class(object) != "stanfit" & class(object) != 
      "brmsfit" & class(object) != "jagsUI") {
      stop("Invalid object type. Input must be stanfit object (rstan), stanreg object (rstanarm), brmsfit object (brms), mcmc.list object (coda), rjags object (R2jags), jagsUI object (jagsUI), or matrix with MCMC chains.")
  }
   --- R stacktrace ---
  where 1: MCMCchains(object, params, excl, ISB, mcmc.list = FALSE)
  where 2: MCMCsummary(matrix_data, Rhat = FALSE)
  where 3: NROW(MCMCsummary(matrix_data, Rhat = FALSE))
  where 4: eval_bare(expr, quo_get_env(quo))
  where 5: quasi_label(enquo(object), label, arg = "object")
  where 6 at testthat/test_master.R#35: expect_equal(NROW(MCMCsummary(matrix_data, Rhat = FALSE)), 3)
  where 7: eval(code, test_env)
  where 8: eval(code, test_env)
  where 9: withCallingHandlers({
      eval(code, test_env)
      if (!handled && !is.null(test)) {
          skip_empty()
      }
  }, expectation = handle_expectation, skip = handle_skip, warning = handle_warning, 
      message = handle_message, error = handle_error)
  where 10: doTryCatch(return(expr), name, parentenv, handler)
  where 11: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  where 12: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  where 13: doTryCatch(return(expr), name, parentenv, handler)
  where 14: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
      names[nh], parentenv, handlers[[nh]])
  where 15: tryCatchList(expr, classes, parentenv, handlers)
  where 16: tryCatch(withCallingHandlers({
      eval(code, test_env)
      if (!handled && !is.null(test)) {
          skip_empty()
      }
  }, expectation = handle_expectation, skip = handle_skip, warning = handle_warning, 
      message = handle_message, error = handle_error), error = handle_fatal, 
      skip = function(e) {
      })
  where 17: test_code(desc, code, env = parent.frame())
  where 18 at testthat/test_master.R#22: test_that("MCMCsummary returns output for all supported object types", 
      {
          expect_equal(NROW(MCMCsummary(jags_data)), 1)
          expect_equal(NROW(MCMCsummary(R2jags_data)), 2)
          expect_equal(NROW(MCMCsummary(jagsparallel_data)), 2)
          expect_equal(NROW(MCMCsummary(jagsUI_data)), 2)
          expect_equal(NROW(MCMCsummary(stan_data)), 2)
          expect_equal(NROW(MCMCsummary(matrix_data, Rhat = FALSE)), 
              3)
          expect_error(MCMCsummary(jagssamps_data))
      })
  where 19: eval(code, test_env)
  where 20: eval(code, test_env)
  where 21: withCallingHandlers({
      eval(code, test_env)
      if (!handled && !is.null(test)) {
          skip_empty()
      }
  }, expectation = handle_expectation, skip = handle_skip, warning = handle_warning, 
      message = handle_message, error = handle_error)
  where 22: doTryCatch(return(expr), name, parentenv, handler)
  where 23: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  where 24: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  where 25: doTryCatch(return(expr), name, parentenv, handler)
  where 26: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
      names[nh], parentenv, handlers[[nh]])
  where 27: tryCatchList(expr, classes, parentenv, handlers)
  where 28: tryCatch(withCallingHandlers({
      eval(code, test_env)
      if (!handled && !is.null(test)) {
          skip_empty()
      }
  }, expectation = handle_expectation, skip = handle_skip, warning = handle_warning, 
      message = handle_message, error = handle_error), error = handle_fatal, 
      skip = function(e) {
      })
  where 29: test_code(NULL, exprs, env)
  where 30: source_file(path, new.env(parent = env), chdir = TRUE, wrap = wrap)
  where 31: force(code)
  where 32: doWithOneRestart(return(expr), restart)
  where 33: withOneRestart(expr, restarts[[1L]])
  where 34: withRestarts(testthat_abort_reporter = function() NULL, force(code))
  where 35: with_reporter(reporter = reporter, start_end_reporter = start_end_reporter, 
      {
          reporter$start_file(basename(path))
          lister$start_file(basename(path))
          source_file(path, new.env(parent = env), chdir = TRUE, 
              wrap = wrap)
          reporter$.end_context()
          reporter$end_file()
      })
  where 36: FUN(X[[i]], ...)
  where 37: lapply(paths, test_file, env = env, reporter = current_reporter, 
      start_end_reporter = FALSE, load_helpers = FALSE, wrap = wrap)
  where 38: force(code)
  where 39: doWithOneRestart(return(expr), restart)
  where 40: withOneRestart(expr, restarts[[1L]])
  where 41: withRestarts(testthat_abort_reporter = function() NULL, force(code))
  where 42: with_reporter(reporter = current_reporter, results <- lapply(paths, 
      test_file, env = env, reporter = current_reporter, start_end_reporter = FALSE, 
      load_helpers = FALSE, wrap = wrap))
  where 43: test_files(paths, reporter = reporter, env = env, stop_on_failure = stop_on_failure, 
      stop_on_warning = stop_on_warning, wrap = wrap)
  where 44: test_dir(path = test_path, reporter = reporter, env = env, filter = filter, 
      ..., stop_on_failure = stop_on_failure, stop_on_warning = stop_on_warning, 
      wrap = wrap)
  where 45: test_package_dir(package = package, test_path = test_path, filter = filter, 
      reporter = reporter, ..., stop_on_failure = stop_on_failure, 
      stop_on_warning = stop_on_warning, wrap = wrap)
  where 46: test_check("MCMCvis")
  
   --- value of length: 2 type: logical ---
  [1] FALSE FALSE
   --- function from context --- 
  function (object, params = "all", excl = NULL, ISB = TRUE, mcmc.list = FALSE, 
      chain_num = NULL) 
  {
      sp_names <- NULL
      if (length(class(object)) > 1) {
          if (class(object)[1] == "rjags.parallel") {
              x <- object$BUGSoutput
              mclist <- vector("list", x$n.chains)
              mclis <- vector("list", x$n.chains)
              ord <- dimnames(x$sims.array)[[3]]
              for (i in 1:x$n.chains) {
                  tmp1 <- x$sims.array[, i, ord]
                  mclis[[i]] <- coda::mcmc(tmp1, thin = x$n.thin)
              }
              object <- coda::as.mcmc.list(mclis)
          }
          if (class(object)[1] == "stanreg") {
              object <- object$stanfit
              sp_names <- object@sim$fnames_oi
          }
      }
      if (coda::is.mcmc.list(object) != TRUE & typeof(object) != 
          "double" & class(object) != "rjags" & class(object) != 
          "stanfit" & class(object) != "brmsfit" & class(object) != 
          "jagsUI") {
          stop("Invalid object type. Input must be stanfit object (rstan), stanreg object (rstanarm), brmsfit object (brms), mcmc.list object (coda), rjags object (R2jags), jagsUI object (jagsUI), or matrix with MCMC chains.")
      }
      if (class(object) == "brmsfit") {
          object <- object$fit
          sp_names_p <- names(object@sim$samples[[1]])
          st_nm <- substr(sp_names_p, start = 1, stop = 2)
          sp_names <- rep(NA, length(sp_names_p))
          b_idx <- which(st_nm == "b_")
          r_idx <- which(st_nm == "r_")
          ot_idx <- which(st_nm != "b_" & st_nm != "r_")
          sp_names[b_idx] <- gsub("b_", "", sp_names_p[b_idx])
          sp_names[r_idx] <- gsub("r_", "", sp_names_p[r_idx])
          sp_names[ot_idx] <- sp_names_p[ot_idx]
      }
      if (class(object) == "stanfit") {
          temp_in <- rstan::As.mcmc.list(object)
          if (!is.null(sp_names)) {
              coda::varnames(temp_in) <- sp_names
          }
          if (ISB == TRUE) {
              names <- vapply(strsplit(colnames(temp_in[[1]]), 
                  split = "[", fixed = TRUE), `[`, 1, FUN.VALUE = character(1))
          }
          else {
              names <- colnames(temp_in[[1]])
          }
      }
      if (class(object) == "jagsUI") {
          object <- object$samples
      }
      if (coda::is.mcmc.list(object) == TRUE) {
          temp_in <- object
          if (is.null(colnames(temp_in[[1]]))) {
              warning("No parameter names provided. Assigning arbitrary names.")
              sub_cn <- paste0("Param_", 1:NCOL(temp_in[[1]]))
              colnames(temp_in[[1]]) <- sub_cn
          }
          if (ISB == TRUE) {
              names <- vapply(strsplit(colnames(temp_in[[1]]), 
                  split = "[", fixed = TRUE), `[`, 1, FUN.VALUE = character(1))
          }
          else {
              names <- colnames(temp_in[[1]])
          }
      }
      if (typeof(object) == "double") {
          temp_in <- object
          if (is.null(colnames(temp_in))) {
              warning("No parameter names (column names) provided. Assigning arbitrary names.")
              sub_cn <- paste0("Param_", 1:NCOL(temp_in))
              colnames(temp_in) <- sub_cn
          }
          if (ISB == TRUE) {
              names <- vapply(strsplit(colnames(temp_in), split = "[", 
                  fixed = TRUE), `[`, 1, FUN.VALUE = character(1))
          }
          else {
              names <- colnames(temp_in)
          }
      }
      if (class(object) == "rjags") {
          temp_in <- object$BUGSoutput$sims.matrix
          if (ISB == TRUE) {
              names <- vapply(strsplit(rownames(object$BUGSoutput$summary), 
                  split = "[", fixed = TRUE), `[`, 1, FUN.VALUE = character(1))
          }
          else {
              names <- rownames(object$BUGSoutput$summary)
          }
      }
      if (!is.null(excl)) {
          rm_ind <- c()
          for (i in 1:length(excl)) {
              if (ISB == TRUE) {
                  n_excl <- vapply(strsplit(excl, split = "[", 
                    fixed = TRUE), `[`, 1, FUN.VALUE = character(1))
                  ind_excl <- which(names %in% n_excl[i])
                  if (length(ind_excl) < 1) {
                    warning(paste0("\"", excl[i], "\"", " not found in MCMC output."))
                  }
                  rm_ind <- c(rm_ind, ind_excl)
              }
              else {
                  n_excl <- excl
                  ind_excl <- grep(n_excl[i], names, fixed = FALSE)
                  if (length(ind_excl) < 1) {
                    warning(paste0("\"", excl[i], "\"", " not found in MCMC output."))
                  }
                  rm_ind <- c(rm_ind, ind_excl)
              }
          }
          if (length(rm_ind) > 0) {
              dups <- which(duplicated(rm_ind))
              if (length(dups) > 0) {
                  rm_ind2 <- rm_ind[-dups]
              }
              else {
                  rm_ind2 <- rm_ind
              }
          }
          else {
              excl <- NULL
          }
      }
      if (length(params) == 1) {
          if (params == "all") {
              if (is.null(excl)) {
                  f_ind <- 1:length(names)
              }
              else {
                  f_ind <- (1:length(names))[-rm_ind2]
              }
          }
          else {
              if (ISB == TRUE) {
                  get_ind <- which(names %in% params)
              }
              else {
                  get_ind <- grep(paste(params), names, fixed = FALSE)
              }
              if (length(get_ind) < 1) {
                  stop(paste0("\"", params, "\"", " not found in MCMC output."))
              }
              if (!is.null(excl)) {
                  if (identical(get_ind, rm_ind2)) {
                    stop("No parameters selected.")
                  }
                  matched <- stats::na.omit(match(rm_ind2, get_ind))
                  if (length(matched) > 0) {
                    f_ind <- get_ind[-matched]
                  }
                  else {
                    f_ind <- get_ind
                  }
              }
              else {
                  f_ind <- get_ind
              }
          }
      }
      else {
          grouped <- c()
          for (i in 1:length(params)) {
              if (ISB == TRUE) {
                  get_ind <- which(names %in% params[i])
              }
              else {
                  get_ind <- grep(paste(params[i]), names, fixed = FALSE)
              }
              if (length(get_ind) < 1) {
                  warning(paste0("\"", params[i], "\"", " not found in MCMC output."))
                  (next)()
              }
              grouped <- c(grouped, get_ind)
          }
          if (!is.null(excl)) {
              if (identical(grouped, rm_ind2)) {
                  stop("No parameters selected.")
              }
              matched <- stats::na.omit(match(rm_ind2, grouped))
              if (length(matched) > 0) {
                  t_ind <- grouped[-matched]
              }
              else {
                  t_ind <- grouped
              }
              to.rm <- which(duplicated(t_ind))
              if (length(to.rm) > 0) {
                  f_ind <- t_ind[-to.rm]
              }
              else {
                  f_ind <- t_ind
              }
          }
          else {
              to.rm <- which(duplicated(grouped))
              if (length(to.rm) > 0) {
                  f_ind <- grouped[-to.rm]
              }
              else {
                  f_ind <- grouped
              }
          }
      }
      if (is.null(chain_num)) {
          if (coda::is.mcmc.list(object) == TRUE | typeof(object) == 
              "S4") {
              if (length(f_ind) > 1) {
                  dsort_mcmc <- do.call(coda::mcmc.list, temp_in[, 
                    f_ind])
                  OUT <- do.call("rbind", dsort_mcmc)
              }
              else {
                  dsort_mcmc <- do.call(coda::mcmc.list, temp_in[, 
                    f_ind, drop = FALSE])
                  OUT <- as.matrix(do.call(coda::mcmc.list, temp_in[, 
                    f_ind, drop = FALSE]), ncol = 1)
              }
          }
          if (typeof(object) == "double") {
              OUT <- temp_in[, f_ind, drop = FALSE]
              if (mcmc.list == TRUE) {
                  stop("Cannot produce mcmc.list output with matrix input")
              }
          }
          if (class(object) == "rjags") {
              OUT <- temp_in[, f_ind, drop = FALSE]
              if (mcmc.list == TRUE) {
                  x <- object$BUGSoutput
                  mclist <- vector("list", x$n.chains)
                  mclis <- vector("list", x$n.chains)
                  ord <- dimnames(x$sims.array)[[3]]
                  for (i in 1:x$n.chains) {
                    tmp1 <- x$sims.array[, i, ord]
                    mclis[[i]] <- coda::mcmc(tmp1, thin = x$n.thin)
                  }
                  temp2 <- coda::as.mcmc.list(mclis)
                  dsort_mcmc <- do.call(coda::mcmc.list, temp2[, 
                    f_ind, drop = FALSE])
              }
          }
      }
      if (!is.null(chain_num)) {
          if (coda::is.mcmc.list(object) == TRUE | typeof(object) == 
              "S4") {
              if (length(f_ind) > 1) {
                  dsort <- do.call(coda::mcmc.list, temp_in[, f_ind])
                  if (chain_num > length(dsort)) {
                    stop("Invalid value for chain_num specified.")
                  }
                  dsort_mcmc <- dsort[[chain_num]]
                  OUT <- as.matrix(dsort_mcmc)
              }
              else {
                  dsort <- do.call(coda::mcmc.list, temp_in[, f_ind, 
                    drop = FALSE])
                  if (chain_num > length(dsort)) {
                    stop("Invalid value for chain_num specified.")
                  }
                  dsort_mcmc <- dsort[[chain_num]]
                  OUT <- as.matrix(dsort_mcmc)
              }
          }
          if (typeof(object) == "double") {
              stop("Cannot extract posterior information for individual chains from matrix input.")
          }
          if (class(object) == "rjags") {
              x <- object$BUGSoutput
              mclist <- vector("list", x$n.chains)
              mclis <- vector("list", x$n.chains)
              ord <- dimnames(x$sims.array)[[3]]
              for (i in 1:x$n.chains) {
                  tmp1 <- x$sims.array[, i, ord]
                  mclis[[i]] <- coda::mcmc(tmp1, thin = x$n.thin)
              }
              temp2 <- coda::as.mcmc.list(mclis)
              dsort <- do.call(coda::mcmc.list, temp2[, f_ind, 
                  drop = FALSE])
              if (chain_num > length(dsort)) {
                  stop("Invalid value for chain_num specified.")
              }
              dsort_mcmc <- dsort[[chain_num]]
              OUT <- as.matrix(dsort_mcmc)
          }
      }
      if (mcmc.list == FALSE) {
          return(OUT)
      }
      if (mcmc.list == TRUE) {
          return(dsort_mcmc)
      }
  }
  <bytecode: 0x56526ef67000>
  <environment: namespace:MCMCvis>
   --- function search by body ---
  Function MCMCchains in namespace MCMCvis has this body.
   ----------- END OF FAILURE REPORT -------------- 
  Fatal error: the condition has length > 1