From 04c951e8b1c56dccc6a15cbb4e205eb8357e2ca9 Mon Sep 17 00:00:00 2001
From: Daniel <mail@danielluedecke.de>
Date: Mon, 16 Sep 2024 14:13:07 +0200
Subject: [PATCH] add rope_range method for model_parameters() objects

---
 DESCRIPTION                |  2 +-
 NAMESPACE                  |  1 +
 R/print.equivalence_test.R | 42 --------------------------------------
 R/rope_range.R             |  7 +++++++
 R/utils.R                  | 41 +++++++++++++++++++++++++++++++++++++
 5 files changed, 50 insertions(+), 43 deletions(-)

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) {