diff --git a/DESCRIPTION b/DESCRIPTION index 4f72b5786..99a51aec8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: bayestestR Title: Understand and Describe Bayesian Models and Posterior Distributions -Version: 0.14.0.7 +Version: 0.14.0.8 Authors@R: c(person(given = "Dominique", family = "Makowski", diff --git a/NAMESPACE b/NAMESPACE index 76db6d047..0151ef477 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -534,6 +534,7 @@ S3method(rope,stanreg) S3method(rope_range,data.frame) S3method(rope_range,default) S3method(rope_range,mlm) +S3method(rope_range,parameters_model) S3method(sensitivity_to_prior,default) S3method(sensitivity_to_prior,stanreg) S3method(sexit_thresholds,BFBayesFactor) diff --git a/R/print.equivalence_test.R b/R/print.equivalence_test.R index 044d4554b..1b9d03cac 100644 --- a/R/print.equivalence_test.R +++ b/R/print.equivalence_test.R @@ -58,45 +58,3 @@ print.equivalence_test <- function(x, digits = 2, ...) { cat("\n") } } - - -.retrieve_model <- function(x) { - # retrieve model - obj_name <- attr(x, "object_name", exact = TRUE) - model <- NULL - - if (!is.null(obj_name)) { - # first try, parent frame - model <- tryCatch(get(obj_name, envir = parent.frame()), error = function(e) NULL) - - if (is.null(model)) { - # second try, global env - model <- tryCatch(get(obj_name, envir = globalenv()), error = function(e) NULL) - } - - if (is.null(model)) { - # last try - model <- .dynGet(obj_name, ifnotfound = NULL) - } - } - model -} - - -.dynGet <- function(x, - ifnotfound = stop(gettextf("%s not found", sQuote(x)), domain = NA, call. = FALSE), - minframe = 1L, - inherits = FALSE) { - x <- insight::safe_deparse(x) - n <- sys.nframe() - myObj <- structure(list(.b = as.raw(7)), foo = 47L) - while (n > minframe) { - n <- n - 1L - env <- sys.frame(n) - r <- get0(x, envir = env, inherits = inherits, ifnotfound = myObj) - if (!identical(r, myObj)) { - return(r) - } - } - ifnotfound -} diff --git a/R/rope_range.R b/R/rope_range.R index 6b21cdffe..b685b43b2 100644 --- a/R/rope_range.R +++ b/R/rope_range.R @@ -91,6 +91,13 @@ rope_range.default <- function(x, verbose = TRUE, ...) { } +#' @export +rope_range.parameters_model <- function(x, verbose = TRUE, ...) { + model <- .retrieve_model(x) + rope_range.default(x = model, verbose = verbose, ...) +} + + #' @export rope_range.data.frame <- function(x, verbose = TRUE, ...) { # to avoid errors with "get_response()" in the default method diff --git a/R/utils.R b/R/utils.R index 876e7debd..e8aa83116 100644 --- a/R/utils.R +++ b/R/utils.R @@ -15,6 +15,47 @@ x[unlist(lapply(x, is.numeric))] } +#' @keywords internal +.retrieve_model <- function(x) { + # retrieve model + obj_name <- attr(x, "object_name", exact = TRUE) + model <- NULL + + if (!is.null(obj_name)) { + # first try, parent frame + model <- .safe(get(obj_name, envir = parent.frame())) + + if (is.null(model)) { + # second try, global env + model <- .safe(get(obj_name, envir = globalenv())) + } + + if (is.null(model)) { + # last try + model <- .dynGet(obj_name, ifnotfound = NULL) + } + } + model +} + +#' @keywords internal +.dynGet <- function(x, + ifnotfound = stop(gettextf("%s not found", sQuote(x)), domain = NA, call. = FALSE), + minframe = 1L, + inherits = FALSE) { + x <- insight::safe_deparse(x) + n <- sys.nframe() + myObj <- structure(list(.b = as.raw(7)), foo = 47L) + while (n > minframe) { + n <- n - 1L + env <- sys.frame(n) + r <- get0(x, envir = env, inherits = inherits, ifnotfound = myObj) + if (!identical(r, myObj)) { + return(r) + } + } + ifnotfound +} #' @keywords internal .get_direction <- function(direction) {