diff --git a/R/bridgesampling.R b/R/bridgesampling.R index d2a07c834..5180dd015 100644 --- a/R/bridgesampling.R +++ b/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? ", diff --git a/R/brmsfit-helpers.R b/R/brmsfit-helpers.R index 0aea322b4..248a98d29 100644 --- a/R/brmsfit-helpers.R +++ b/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'.") } diff --git a/R/brmsformula.R b/R/brmsformula.R index a49da519f..4a421346b 100644 --- a/R/brmsformula.R +++ b/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 diff --git a/R/brmsterms.R b/R/brmsterms.R index c6aa390a9..c3e00574f 100644 --- a/R/brmsterms.R +++ b/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) diff --git a/R/data-helpers.R b/R/data-helpers.R index ded6b62c5..a97182596 100644 --- a/R/data-helpers.R +++ b/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) diff --git a/R/formula-gp.R b/R/formula-gp.R index 681296c2e..474e16753 100644 --- a/R/formula-gp.R +++ b/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.") diff --git a/R/loo_moment_match.R b/R/loo_moment_match.R index 591c43c06..fcf252384 100644 --- a/R/loo_moment_match.R +++ b/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? ", diff --git a/R/misc.R b/R/misc.R index 72506e48b..7a472decf 100644 --- a/R/misc.R +++ b/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)) diff --git a/R/posterior_epred.R b/R/posterior_epred.R index d875cfa62..d627c9649 100644 --- a/R/posterior_epred.R +++ b/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.") } diff --git a/R/predictor.R b/R/predictor.R index 276abee4b..4cc410693 100644 --- a/R/predictor.R +++ b/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 ", diff --git a/R/priors.R b/R/priors.R index a8ca3f8d3..80a126455 100644 --- a/R/priors.R +++ b/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?") } diff --git a/R/rename_pars.R b/R/rename_pars.R index e4ba88662..344137c91 100644 --- a/R/rename_pars.R +++ b/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) diff --git a/tests/testthat/tests.make_stancode.R b/tests/testthat/tests.make_stancode.R index a0acbdd6e..518c253dd 100644 --- a/tests/testthat/tests.make_stancode.R +++ b/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")