introduce is_try_error function

R/bridgesampling.R

@@ -88,7 +88,7 @@ bridge_sampler.brmsfit <- function(samples, recompile = FALSE, ...) {
   # otherwise bridge_sampler may fail in a new R session or on another machine
   samples <- update_misc_env(samples, recompile = recompile)
   out <- try(bridge_sampler(samples$fit, ...))
-  if (is(out, "try-error")) {
+  if (is_try_error(out)) {
     stop2(
       "Bridgesampling failed. Perhaps you did not set ",
       "'save_pars = save_pars(all = TRUE)' when fitting your model? ",

R/brmsfit-helpers.R

@@ -988,7 +988,7 @@ read_brmsfit <- function(file) {
     )
   }
   x <- suppressWarnings(try(readRDS(file), silent = TRUE))
-  if (!is(x, "try-error")) {
+  if (!is_try_error(x)) {
     if (!is.brmsfit(x)) {
       stop2("Object loaded via 'file' is not of class 'brmsfit'.")
     }

R/brmsformula.R

@@ -1180,7 +1180,7 @@ decomp_opts <- function() {
 validate_par_formula <- function(formula, par = NULL, rsv_pars = NULL) {
   stopifnot(length(par) <= 1L)
   try_formula <- try(as_formula(formula), silent = TRUE)
-  if (is(try_formula, "try-error")) {
+  if (is_try_error(try_formula)) {
     if (length(formula) != 1L) {
       stop2("Expecting a single value when fixing parameter '", par, "'.")
     }
@@ -1235,7 +1235,7 @@ validate_resp_formula <- function(x, empty_ok = TRUE) {
   }
   out <- gsub("\\|+[^~]*~", "~", formula2str(out))
   out <- try(formula(out), silent = TRUE)
-  if (is(out, "try-error")) {
+  if (is_try_error(out)) {
     str_x <- formula2str(x, space = "trim")
     stop2("Incorrect use of '|' on the left-hand side of ", str_x)
   }
@@ -1287,7 +1287,7 @@ validate_formula.brmsformula <- function(
     # thresholds and category names are data dependent
     try_terms <- try(stats::terms(out$formula), silent = TRUE)
     intercept <- attr(try_terms, "intercept", TRUE)
-    if (!is(try_terms, "try-error") && isTRUE(intercept == 0)) {
+    if (!is_try_error(try_terms) && isTRUE(intercept == 0)) {
       stop2("Cannot remove the intercept in an ordinal model.")
     }
     if (!is.null(data)) {
@@ -1698,7 +1698,7 @@ expand_dot_formula <- function(formula, data = NULL) {
       stats::terms(formula, data = data),
       silent = TRUE
     )
-    if (!is(try_terms, "try-error")) {
+    if (!is_try_error(try_terms)) {
       formula <- formula(try_terms)
     }
     attributes(formula) <- att

R/brmsterms.R

@@ -805,7 +805,7 @@ combine_formulas <- function(formula1, formula2, lhs = "", update = FALSE) {
 has_terms <- function(formula) {
   stopifnot(is.formula(formula))
   terms <- try(terms(rhs(formula)), silent = TRUE)
-  is(terms, "try-error") ||
+  is_try_error(terms) ||
     length(attr(terms, "term.labels")) ||
     length(attr(terms, "offset"))
 }
@@ -1012,7 +1012,7 @@ has_intercept <- function(formula) {
   } else {
     formula <- as.formula(formula)
     try_terms <- try(terms(formula), silent = TRUE)
-    if (is(try_terms, "try-error")) {
+    if (is_try_error(try_terms)) {
       out <- FALSE
     } else {
       out <- as.logical(attr(try_terms, "intercept"))
@@ -1038,12 +1038,12 @@ has_rsv_intercept <- function(formula, has_intercept = NULL) {
     return(.has_rsv_intercept(formula, has_intercept))
   }
   formula <- try(as.formula(formula), silent = TRUE)
-  if (is(formula, "try-error")) {
+  if (is_try_error(formula)) {
     return(FALSE)
   }
   if (is.null(has_intercept)) {
     try_terms <- try(terms(formula), silent = TRUE)
-    if (is(try_terms, "try-error")) {
+    if (is_try_error(try_terms)) {
       return(FALSE)
     }
     has_intercept <- has_intercept(try_terms)

R/data-helpers.R

@@ -20,7 +20,7 @@ validate_data <- function(data, bterms, data2 = list(), knots = NULL,
     knots <- get_knots(data)
   }
   data <- try(as.data.frame(data), silent = TRUE)
-  if (is(data, "try-error")) {
+  if (is_try_error(data)) {
     stop2("Argument 'data' must be coercible to a data.frame.")
   }
   if (!isTRUE(nrow(data) > 0L)) {
@@ -396,7 +396,7 @@ validate_newdata <- function(
   incl_autocor = TRUE, group_vars = NULL, req_vars = NULL, ...
 ) {
   newdata <- try(as.data.frame(newdata), silent = TRUE)
-  if (is(newdata, "try-error")) {
+  if (is_try_error(newdata)) {
     stop2("Argument 'newdata' must be coercible to a data.frame.")
   }
   object <- restructure(object)

R/formula-gp.R

@@ -312,7 +312,7 @@ choose_L <- function(x, c) {
 # return an informative error message if it fails
 try_nug <- function(expr, nug) {
   out <- try(expr, silent = TRUE)
-  if (is(out, "try-error")) {
+  if (is_try_error(out)) {
     stop2("The Gaussian process covariance matrix is not positive ",
           "definite.\nThis occurs for numerical reasons. Setting ",
           "'nug' above ", nug, " may help.")

R/loo_moment_match.R

@@ -84,7 +84,7 @@ loo_moment_match.brmsfit <- function(x, loo, k_threshold = 0.7, newdata = NULL,
     newdata = newdata,
     resp = resp, ...
   ))
-  if (is(out, "try-error")) {
+  if (is_try_error(out)) {
     stop2(
       "Moment matching failed. Perhaps you did not set ",
       "'save_pars = save_pars(all = TRUE)' when fitting your model? ",

R/misc.R

@@ -767,7 +767,7 @@ eval_silent <- function(expr, type = "output", try = FALSE,
       try_out <- try(utils::capture.output(
         out <- eval(expr, envir), type = type, ...
       ))
-      if (is(try_out, "try-error")) {
+      if (is_try_error(try_out)) {
         # try again without suppressing error messages
         out <- eval(expr, envir)
       }
@@ -871,7 +871,7 @@ get_matches_expr <- function(pattern, expr, ...) {
   out <- NULL
   for (i in seq_along(expr)) {
     sexpr <- try(expr[[i]], silent = TRUE)
-    if (!is(sexpr, "try-error")) {
+    if (!is_try_error(sexpr)) {
       sexpr_char <- deparse0(sexpr)
       out <- c(out, get_matches(pattern, sexpr_char, ...))
     }
@@ -1025,6 +1025,11 @@ warn_deprecated <- function(new, old = as.character(sys.call(sys.parent()))[1])
   invisible(NULL)
 }
 
+# check if x is a try-error resulting from try()
+is_try_error <- function(x) {
+  inherits(x, "try-error")
+}
+
 # check if verbose mode is activated
 is_verbose <- function() {
   as_one_logical(getOption("brms.verbose", FALSE))

R/posterior_epred.R

@@ -717,12 +717,13 @@ posterior_epred_trunc <- function(prep) {
   stopifnot(is_trunc(prep))
   lb <- data2draws(prep$data[["lb"]], dim_mu(prep))
   ub <- data2draws(prep$data[["ub"]], dim_mu(prep))
-  posterior_epred_trunc_fun <- paste0("posterior_epred_trunc_", prep$family$family)
+  posterior_epred_trunc_fun <-
+    paste0("posterior_epred_trunc_", prep$family$family)
   posterior_epred_trunc_fun <- try(
     get(posterior_epred_trunc_fun, asNamespace("brms")),
     silent = TRUE
   )
-  if (is(posterior_epred_trunc_fun, "try-error")) {
+  if (is_try_error(posterior_epred_trunc_fun)) {
     stop2("posterior_epred values on the respone scale not yet implemented ",
           "for truncated '", prep$family$family, "' models.")
   }

R/predictor.R

@@ -70,7 +70,7 @@ predictor.bprepnl <- function(prep, i = NULL, fprep = NULL, ...) {
     # assumes fully vectorized version of 'nlform'
     eta <- try(eval(prep$nlform, args), silent = TRUE)
   }
-  if (is(eta, "try-error")) {
+  if (is_try_error(eta)) {
     if (grepl("could not find function", eta)) {
       eta <- rename(eta, "Error in eval(expr, envir, enclos) : ", "")
       vectorize <- str_if(prep$loop, ", vectorize = TRUE")
@@ -97,7 +97,7 @@ predictor_fe <- function(prep, i) {
     return(0)
   }
   eta <- try(.predictor_fe(X = p(fe[["X"]], i), b = fe[["b"]]))
-  if (is(eta, "try-error")) {
+  if (is_try_error(eta)) {
     stop2(
       "Something went wrong (see the error message above). ",
       "Perhaps you transformed numeric variables ",
@@ -125,7 +125,7 @@ predictor_re <- function(prep, i) {
   group <- names(re[["r"]])
   for (g in group) {
     eta_g <- try(.predictor_re(Z = p(re[["Z"]][[g]], i), r = re[["r"]][[g]]))
-    if (is(eta_g, "try-error")) {
+    if (is_try_error(eta_g)) {
       stop2(
         "Something went wrong (see the error message above). ",
         "Perhaps you transformed numeric variables ",

R/priors.R

@@ -359,7 +359,7 @@ set_prior <- function(prior, class = "b", coef = "", group = "",
                       lb = NA, ub = NA, check = TRUE) {
   input <- nlist(prior, class, coef, group, resp, dpar, nlpar, lb, ub, check)
   input <- try(as.data.frame(input), silent = TRUE)
-  if (is(input, "try-error")) {
+  if (is_try_error(input)) {
     stop2("Processing arguments of 'set_prior' has failed:\n", input)
   }
   out <- vector("list", nrow(input))
@@ -1848,7 +1848,7 @@ duplicated.brmsprior <- function(x, incomparables = FALSE, ...) {
 eval_dirichlet <- function(prior, len = NULL, env = NULL) {
   dirichlet <- function(...) {
     out <- try(as.numeric(c(...)))
-    if (is(out, "try-error")) {
+    if (is_try_error(out)) {
       stop2("Something went wrong. Did you forget to store ",
             "auxiliary data in the 'data2' argument?")
     }

R/rename_pars.R

@@ -628,7 +628,7 @@ compute_xi.brmsfit <- function(x, ...) {
     return(x)
   }
   draws <- try(extract_draws(x))
-  if (is(draws, "try-error")) {
+  if (is_try_error(draws)) {
     warning2("Trying to compute 'xi' was unsuccessful. ",
              "Some S3 methods may not work as expected.")
     return(x)

tests/testthat/tests.make_stancode.R

@@ -2447,7 +2447,7 @@ test_that("threaded Stan code is correct", {
   # only run if cmdstan >= 2.29 can be found on the system
   # otherwise the canonicalized code will cause test failures
   cmdstan_version <- try(cmdstanr::cmdstan_version(), silent = TRUE)
-  found_cmdstan <- !is(cmdstan_version, "try-error")
+  found_cmdstan <- !is_try_error(cmdstan_version)
   skip_if_not(found_cmdstan && cmdstan_version >= "2.29.0")
   options(brms.backend = "cmdstanr")
 
@@ -2523,7 +2523,7 @@ test_that("Un-normalized Stan code is correct", {
   # only run if cmdstan >= 2.29 can be found on the system
   # otherwise the canonicalized code will cause test failures
   cmdstan_version <- try(cmdstanr::cmdstan_version(), silent = TRUE)
-  found_cmdstan <- !is(cmdstan_version, "try-error")
+  found_cmdstan <- !is_try_error(cmdstan_version)
   skip_if_not(found_cmdstan && cmdstan_version >= "2.29.0")
   options(brms.backend = "cmdstanr")
 
@@ -2600,7 +2600,7 @@ test_that("Canonicalizing Stan code is correct", {
   # only run if cmdstan >= 2.29 can be found on the system
   # otherwise the canonicalized code will cause test failures
   cmdstan_version <- try(cmdstanr::cmdstan_version(), silent = TRUE)
-  found_cmdstan <- !is(cmdstan_version, "try-error")
+  found_cmdstan <- !is_try_error(cmdstan_version)
   skip_if_not(found_cmdstan && cmdstan_version >= "2.29.0")
   options(brms.backend = "cmdstanr")