Merge branch 'main' into strengejacke/issue911

easystats · Oct 24, 2023 · 07892c2 · 07892c2
2 parents 7713e3c + a04deb7
commit 07892c2
Show file tree

Hide file tree

Showing 8 changed files with 76 additions and 28 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Type: Package
 Package: parameters
 Title: Processing of Model Parameters
-Version: 0.21.2.8
+Version: 0.21.2.10
 Authors@R:
     c(person(given = "Daniel",
              family = "Lüdecke",

diff --git a/NAMESPACE b/NAMESPACE
@@ -9,6 +9,8 @@ S3method(bootstrap_model,default)
 S3method(bootstrap_model,glmmTMB)
 S3method(bootstrap_model,merMod)
 S3method(bootstrap_model,nestedLogit)
+S3method(bootstrap_parameters,bootstrap_model)
+S3method(bootstrap_parameters,default)
 S3method(ci,BBmm)
 S3method(ci,BBreg)
 S3method(ci,DirichletRegModel)

diff --git a/NEWS.md b/NEWS.md
@@ -11,6 +11,9 @@
 * `n_factors()` no longer supports `package = "EGAnet"`, as package *EGAnet* was
   removed from CRAN.
 
+* `bootstrap_parameters()` now works for bootstrapped samples returned by
+  `bootstrap_model()`.
+
 ## Bug fixes
 
 * Fixed issue in `print_html()` for objects from package _ggeffects_.

diff --git a/R/bootstrap_parameters.R b/R/bootstrap_parameters.R
@@ -44,16 +44,33 @@
 #' print(model_parameters(est))
 #' }
 #' @export
-bootstrap_parameters <- function(model,
-                                 iterations = 1000,
-                                 centrality = "median",
-                                 ci = 0.95,
-                                 ci_method = "quantile",
-                                 test = "p-value",
-                                 ...) {
+bootstrap_parameters <- function(model, ...) {
+  UseMethod("bootstrap_parameters")
+}
+
+#' @rdname bootstrap_parameters
+#' @export
+bootstrap_parameters.default <- function(model,
+                                         iterations = 1000,
+                                         centrality = "median",
+                                         ci = 0.95,
+                                         ci_method = "quantile",
+                                         test = "p-value",
+                                         ...) {
   data <- bootstrap_model(model, iterations = iterations, ...)
+  bootstrap_parameters(data, centrality = centrality, ci = ci, ci_method = ci_method, test = test, ...)
+}
+
+
+#' @export
+bootstrap_parameters.bootstrap_model <- function(model,
+                                                 centrality = "median",
+                                                 ci = 0.95,
+                                                 ci_method = "quantile",
+                                                 test = "p-value",
+                                                 ...) {
   out <- .summary_bootstrap(
-    data = data,
+    data = model,
     test = test,
     centrality = centrality,
     ci = ci,
@@ -62,13 +79,11 @@ bootstrap_parameters <- function(model,
   )
 
   class(out) <- c("bootstrap_parameters", "parameters_model", class(out))
-  attr(out, "boot_samples") <- data
+  attr(out, "boot_samples") <- model
   out
 }
 
 
-
-
 #' @keywords internal
 .summary_bootstrap <- function(data, test, centrality, ci, ci_method, ...) {
   # Is the p-value requested?

diff --git a/man/bootstrap_parameters.Rd b/man/bootstrap_parameters.Rd
diff --git a/man/n_factors.Rd b/man/n_factors.Rd
diff --git a/tests/testthat/_snaps/bootstrap_parameters.md b/tests/testthat/_snaps/bootstrap_parameters.md
@@ -0,0 +1,14 @@
+# bootstrap_parameters.bootstrap_model
+
+    Code
+      print(out)
+    Output
+      # Fixed Effects
+      
+      Parameter    | Coefficient |       95% CI |      p
+      --------------------------------------------------
+      (Intercept)  |        2.25 | [1.79, 2.69] | < .001
+      Sepal.Width  |        0.60 | [0.47, 0.72] | < .001
+      Petal.Length |        0.47 | [0.44, 0.50] | < .001
+      lin_comb     |        0.13 | [0.00, 0.24] | 0.036 
+
diff --git a/tests/testthat/test-bootstrap_parameters.R b/tests/testthat/test-bootstrap_parameters.R
@@ -0,0 +1,12 @@
+skip_on_cran()
+skip_if_not_installed("boot")
+
+test_that("bootstrap_parameters.bootstrap_model", {
+  data(iris)
+  m_draws <- lm(Sepal.Length ~ Sepal.Width + Petal.Length, data = iris)
+  set.seed(123)
+  draws <- bootstrap_model(m_draws)
+  draws$lin_comb <- draws$Sepal.Width - draws$Petal.Length
+  out <- bootstrap_parameters(draws)
+  expect_snapshot(print(out))
+})