Skip to content

Commit

Permalink
Argument threshold can be a list (#1015)
Browse files Browse the repository at this point in the history
* Argument `threshold` can be a list

* comments
  • Loading branch information
strengejacke authored Sep 17, 2024
1 parent 1853d5d commit 29bc324
Show file tree
Hide file tree
Showing 6 changed files with 55 additions and 24 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
@@ -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",
Expand Down
52 changes: 36 additions & 16 deletions R/p_significance.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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, ...))
Expand Down
7 changes: 4 additions & 3 deletions man/model_parameters.BFBayesFactor.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

7 changes: 4 additions & 3 deletions man/model_parameters.stanreg.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

6 changes: 5 additions & 1 deletion man/p_significance.lm.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

5 changes: 5 additions & 0 deletions tests/testthat/test-p_significance.R
Original file line number Diff line number Diff line change
Expand Up @@ -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", {
Expand Down

0 comments on commit 29bc324

Please sign in to comment.