Running ‘testthat.R’ [21s/31s]
Running the tests in ‘tests/testthat.R’ failed.
Complete output:
  > rm(list=ls())
  > library(testthat)
  > library(lavaan)
  This is lavaan 0.6-5
  lavaan is BETA software! Please report any bugs.
  > library(bain)
  > test_check("bain")
   ----------- FAILURE REPORT -------------- 
   --- failure: the condition has length > 1 ---
   --- srcref --- 
  : 
   --- package (from environment) --- 
  bain
   --- call from context --- 
  bain.lm(within, "pre=post")
   --- call from argument --- 
  if (!class(x$coefficients) == "numeric") {
      stop("It appears that you are trying to run a multivariate linear model. This cannot be done using a lm() object as input for bain. Instead use a named numeric vector. See vignette('Introduction_to_bain') for further information")
  }
   --- R stacktrace ---
  where 1: bain.lm(within, "pre=post")
  where 2: bain(within, "pre=post")
  where 3: eval_bare(quo_get_expr(.quo), quo_get_env(.quo))
  where 4: withCallingHandlers({
      code
      NULL
  }, error = function(cnd) {
      cnd <- cnd_entrace(cnd)
      return_from(env, cnd)
  })
  where 5: .capture(act$val <- eval_bare(quo_get_expr(.quo), quo_get_env(.quo)), 
      ...)
  where 6: quasi_capture(enquo(object), label, capture_error, entrace = TRUE)
  where 7: expect_error(bain(within, "pre=post"))
  where 8: eval(code, test_env)
  where 9: eval(code, test_env)
  where 10: 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 11: doTryCatch(return(expr), name, parentenv, handler)
  where 12: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  where 13: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  where 14: doTryCatch(return(expr), name, parentenv, handler)
  where 15: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
      names[nh], parentenv, handlers[[nh]])
  where 16: tryCatchList(expr, classes, parentenv, handlers)
  where 17: 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 18: test_code(desc, code, env = parent.frame())
  where 19 at testthat/test-extra-bug.R#325: test_that("Multivariate lm() gives error", expect_error(bain(within, 
      "pre=post")))
  where 20: eval(code, test_env)
  where 21: eval(code, test_env)
  where 22: 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 23: doTryCatch(return(expr), name, parentenv, handler)
  where 24: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  where 25: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  where 26: doTryCatch(return(expr), name, parentenv, handler)
  where 27: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
      names[nh], parentenv, handlers[[nh]])
  where 28: tryCatchList(expr, classes, parentenv, handlers)
  where 29: 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 30: test_code(NULL, exprs, env)
  where 31: source_file(path, new.env(parent = env), chdir = TRUE, wrap = wrap)
  where 32: force(code)
  where 33: doWithOneRestart(return(expr), restart)
  where 34: withOneRestart(expr, restarts[[1L]])
  where 35: withRestarts(testthat_abort_reporter = function() NULL, force(code))
  where 36: 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 37: FUN(X[[i]], ...)
  where 38: lapply(paths, test_file, env = env, reporter = current_reporter, 
      start_end_reporter = FALSE, load_helpers = FALSE, wrap = wrap)
  where 39: force(code)
  where 40: doWithOneRestart(return(expr), restart)
  where 41: withOneRestart(expr, restarts[[1L]])
  where 42: withRestarts(testthat_abort_reporter = function() NULL, force(code))
  where 43: 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 44: test_files(paths, reporter = reporter, env = env, stop_on_failure = stop_on_failure, 
      stop_on_warning = stop_on_warning, wrap = wrap)
  where 45: 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 46: 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 47: test_check("bain")
  
   --- value of length: 2 type: logical ---
  [1] TRUE TRUE
   --- function from context --- 
  function (x, hypothesis, fraction = 1, ..., standardize = FALSE) 
  {
      cl <- match.call()
      Args <- as.list(cl[-1])
      if (!class(x$coefficients) == "numeric") {
          stop("It appears that you are trying to run a multivariate linear model. This cannot be done using a lm() object as input for bain. Instead use a named numeric vector. See vignette('Introduction_to_bain') for further information")
      }
      factor_variables <- sapply(x$model[-1], inherits, what = "factor")
      Warnings <- NULL
      which_model <- if (any(factor_variables)) {
          if (ncol(x$model) == 2) {
              "ANOVA"
          }
          else {
              if (sum(factor_variables) == 1 & !grepl(":", paste(names(x$coefficients), 
                  collapse = ""))) {
                  "ANCOVA"
              }
              else {
                  Warnings <- c(Warnings, "Calling bain on an object of type 'lm' with mixed predictors (factors and numeric predictors) may result in untrustworthy results. Please interpret with caution.")
                  "mixed predictors"
              }
          }
      }
      else {
          "continuous predictors"
      }
      switch(which_model, ANOVA = {
          if (names(x$coefficients)[1] == "(Intercept)") {
              Warnings <- c(Warnings, "Your ANOVA model included an intercept, which was dropped by bain. Please specify your hypothesis in terms of group means.")
          }
          n <- table(x$model[, 2])
          anovafm <- lm(x$model[, 1] ~ -1 + x$model[, 2])
          Args$x <- anovafm$coefficients
          names(Args$x) <- paste0(names(x$model)[2], levels(x$model[, 
              2]))
          Args$Sigma <- lapply((1/n * summary.lm(anovafm)$sigma^2), 
              matrix)
          Args$group_parameters <- 1
          Args$joint_parameters <- 0
          Args$n <- n
      }, ANCOVA = {
          if (names(x$coefficients)[1] == "(Intercept)") {
              Warnings <- c(Warnings, "Your ANCOVA model included an intercept, which was dropped by bain. Please specify your hypothesis in terms of group means.")
          }
          df <- x$model
          var_factor <- which(factor_variables) + 1
          var_numeric <- c(FALSE, sapply(x$model[-1], is.numeric))
          df[, var_numeric] <- scale(df[, var_numeric], scale = FALSE)
          ancovafm <- lm(as.formula(paste0(names(df)[1], "~ -1 + ", 
              names(x$model)[var_factor], " + ", paste(names(x$model)[var_numeric], 
                  collapse = " + "))), df)
          Args$x <- ancovafm$coefficients
          resvar <- summary(ancovafm)$sigma^2
          Args$Sigma <- by(cbind(1, df[, var_numeric]), df[[var_factor]], 
              function(x) {
                  resvar * solve(t(as.matrix(x)) %*% as.matrix(x))
              })
          Args$group_parameters <- 1
          Args$joint_parameters <- sum(var_numeric)
          Args$n <- table(df[[var_factor]])
      }, {
          dependent <- x$model[, 1]
          predictor <- model.matrix(as.formula(x$call[2]), x$model)
          hyp_params <- params_in_hyp(hypothesis)
          coef_in_hyp <- charmatch(rename_function(hyp_params), 
              rename_function(names(x$coefficients)))
          if (anyNA(coef_in_hyp)) {
              stop("Some of the parameters referred to in the 'hypothesis' do not correspond to parameter names of object 'x'.\n  The following parameter names in the 'hypothesis' did not match any parameters in 'x': ", 
                  paste(reverse_rename_function(hyp_params[is.na(coef_in_hyp)]), 
                    collapse = ", "), "\n  The parameters in object 'x' are named: ", 
                  paste(reverse_rename_function(names(x$coefficients)), 
                    collapse = ", "))
          }
          if (any(coef_in_hyp == 0)) {
              stop("Some of the parameters referred to in the 'hypothesis' matched multiple parameter names of object 'x'.\n  The following parameter names in the 'hypothesis' matched multiple parameters in 'x': ", 
                  paste(reverse_rename_function(hyp_params[coef_in_hyp == 
                    0]), collapse = ", "), "\n  The parameters in object 'x' are named: ", 
                  paste(reverse_rename_function(names(x$coefficients)), 
                    collapse = ", "))
          }
          if (!standardize) {
              estimate <- coef(x)[coef_in_hyp]
              Sigma <- vcov(x)[coef_in_hyp, coef_in_hyp]
          } else {
              ses <- seBeta(x$model[, -1], x$model[, 1], Nobs = nrow(x$model), 
                  alpha = 0.05, estimator = "Normal")
              select_parameters <- match(names(x$model)[-1], names(x$coefficients)[coef_in_hyp])
              estimate <- ses$CIs$estimate[select_parameters]
              names(estimate) <- names(x$model)[-1][select_parameters]
              Sigma <- ses$cov.mat[select_parameters, select_parameters]
          }
          Args$x <- estimate
          Args$Sigma <- Sigma
          Args$group_parameters <- 0
          Args$joint_parameters <- length(coef_in_hyp)
          Args$n <- nrow(x$model)
      })
      Bain_res <- do.call(bain, Args)
      Bain_res$call <- cl
      Bain_res$model <- x
      if (!is.null(Warnings)) {
          Bain_res$Warnings <- Warnings
      }
      class(Bain_res) <- c("bain_lm", class(Bain_res))
      attr(Bain_res, "which_model") <- which_model
      Bain_res
  }
  <bytecode: 0x560470dd7930>
  <environment: namespace:bain>
   --- function search by body ---
  Function bain.lm in namespace bain has this body.
   ----------- END OF FAILURE REPORT -------------- 
  Fatal error: the condition has length > 1