Merge branch 'main' into test_on_bayestestR

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: parameters
 Title: Processing of Model Parameters
-Version: 0.22.2.10
+Version: 0.22.2.11
 Authors@R:
     c(person(given = "Daniel",
              family = "Lüdecke",

R/p_significance.R

@@ -157,19 +157,34 @@ p_significance.lm <- function(x, threshold = "default", ci = 0.95, verbose = TRU
   }
 
   # add ps
-  out$ps <- as.numeric(bayestestR::p_significance(
+  result_ps <- bayestestR::p_significance(
     posterior,
     threshold = threshold,
     verbose = verbose
-  ))
+  )
+  out$ps <- as.numeric(result_ps)
+
+  # for list-thresholds, we have the list as attribute and need to save it as
+  # data.frame
+  if (is.list(threshold)) {
+    # save for later
+    threshold_data <- stats::setNames(
+      as.data.frame(do.call(rbind, attributes(result_ps)$threshold)),
+      c("ROPE_low", "ROPE_high")
+    )
+    out <- cbind(out, threshold_data)
+    keep <- c("Parameter", "CI", "CI_low", "CI_high", "ROPE_low", "ROPE_high", "ps", "Effects", "Component")
+  } else {
+    keep <- c("Parameter", "CI", "CI_low", "CI_high", "ps", "Effects", "Component")
+  }
 
   # for plot, we need to have it numeric
-  if (!is.numeric(threshold)) {
+  if (!is.numeric(threshold) && !is.list(threshold)) {
     threshold <- 0.1
   }
 
-  # reorder
-  out <- out[intersect(c("Parameter", "CI", "CI_low", "CI_high", "ps", "Effects", "Component"), colnames(out))]
+  # Reorder columns of 'out' to keep only the relevant ones
+  out <- out[intersect(keep, colnames(out))]
 
   attr(out, "data") <- posterior
   attr(out, "threshold") <- threshold
@@ -236,18 +251,23 @@ p_significance.lm <- function(x, threshold = "default", ci = 0.95, verbose = TRU
 #' @export
 print.p_significance_lm <- function(x, digits = 2, ...) {
   threshold <- attributes(x)$threshold
-  # make sure it's numeric
-  if (!is.numeric(threshold)) {
-    threshold <- 0.1
-  }
-  # make sure we have both bounds for the range
-  if (length(threshold) == 1) {
-    threshold <- c(threshold * -1, threshold)
+  # Check if threshold is a list, which indicates multiple thresholds
+  if (is.list(threshold)) {
+    caption <- "Practical Significance"
+  } else {
+    # make sure it's numeric
+    if (!is.numeric(threshold)) {
+      threshold <- 0.1
+    }
+    # make sure we have both bounds for the range
+    if (length(threshold) == 1) {
+      threshold <- c(threshold * -1, threshold)
+    }
+    caption <- sprintf(
+      "Practical Significance (threshold: %s)",
+      toString(insight::format_value(threshold, digits = 2))
+    )
   }
-  caption <- sprintf(
-    "Practical Significance (threshold: %s)",
-    toString(insight::format_value(threshold, digits = 2))
-  )
   x$ps <- insight::format_pd(x$ps, name = NULL)
   x <- insight::format_table(x, digits = digits)
   cat(insight::export_table(x, title = caption, ...))

tests/testthat/test-p_significance.R

@@ -22,6 +22,11 @@ test_that("p_significance", {
   set.seed(123)
   x <- p_significance(m, threshold = 0.5)
   expect_equal(x$ps, c(1, 0.4393, 0.9969, 0.6803, 0), tolerance = 1e-4)
+
+  set.seed(123)
+  # Test p_significance with custom thresholds for specific parameters
+  x <- p_significance(m, threshold = list(cyl = 0.5, wt = 0.7))
+  expect_equal(x$ps, c(1, 0.6002, 0.995, 0.6805, 0), tolerance = 1e-4)
 })
 
 test_that("p_significance, glmmTMB", {