diff --git a/DESCRIPTION b/DESCRIPTION index f32873fbb..70cc906d6 100644 --- a/DESCRIPTION +++ b/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", diff --git a/R/p_significance.R b/R/p_significance.R index 603e7ed5a..dc3d02091 100644 --- a/R/p_significance.R +++ b/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, ...)) diff --git a/man/model_parameters.BFBayesFactor.Rd b/man/model_parameters.BFBayesFactor.Rd index 5bb4ecf8e..9b67ccb4f 100644 --- a/man/model_parameters.BFBayesFactor.Rd +++ b/man/model_parameters.BFBayesFactor.Rd @@ -49,9 +49,10 @@ For each "test", the corresponding \pkg{bayestestR} function is called (e.g. \code{\link[bayestestR:rope]{rope()}} or \code{\link[bayestestR:p_direction]{p_direction()}}) and its results included in the summary output.} -\item{rope_range}{ROPE's lower and higher bounds. Should be a list of two -values (e.g., \code{c(-0.1, 0.1)}) or \code{"default"}. If \code{"default"}, -the bounds are set to \code{x +- 0.1*SD(response)}.} +\item{rope_range}{ROPE's lower and higher bounds. Should be a vector of two +values (e.g., \code{c(-0.1, 0.1)}), \code{"default"} or a list of numeric vectors of +the same length as numbers of parameters. If \code{"default"}, the bounds are +set to \code{x +- 0.1*SD(response)}.} \item{rope_ci}{The Credible Interval (CI) probability, corresponding to the proportion of HDI, to use for the percentage in ROPE.} diff --git a/man/model_parameters.stanreg.Rd b/man/model_parameters.stanreg.Rd index ef2f3f623..57095a54b 100644 --- a/man/model_parameters.stanreg.Rd +++ b/man/model_parameters.stanreg.Rd @@ -131,9 +131,10 @@ For each "test", the corresponding \pkg{bayestestR} function is called (e.g. \code{\link[bayestestR:rope]{rope()}} or \code{\link[bayestestR:p_direction]{p_direction()}}) and its results included in the summary output.} -\item{rope_range}{ROPE's lower and higher bounds. Should be a list of two -values (e.g., \code{c(-0.1, 0.1)}) or \code{"default"}. If \code{"default"}, -the bounds are set to \code{x +- 0.1*SD(response)}.} +\item{rope_range}{ROPE's lower and higher bounds. Should be a vector of two +values (e.g., \code{c(-0.1, 0.1)}), \code{"default"} or a list of numeric vectors of +the same length as numbers of parameters. If \code{"default"}, the bounds are +set to \code{x +- 0.1*SD(response)}.} \item{rope_ci}{The Credible Interval (CI) probability, corresponding to the proportion of HDI, to use for the percentage in ROPE.} diff --git a/man/p_significance.lm.Rd b/man/p_significance.lm.Rd index 37a0adb36..a01e64c36 100644 --- a/man/p_significance.lm.Rd +++ b/man/p_significance.lm.Rd @@ -18,7 +18,11 @@ and based on \code{\link[bayestestR:rope_range]{rope_range()}} if a (Bayesian) m (i.e. the threshold range is set to -0.1 and 0.1, i.e. reflects a symmetric interval) \item a numeric vector of length two (e.g., \code{c(-0.2, 0.1)}), useful for -asymmetric intervals. +asymmetric intervals +\item a list of numeric vectors, where each vector corresponds to a parameter +\item a list of \emph{named} numeric vectors, where names correspond to parameter +names. In this case, all parameters that have no matching name in \code{threshold} +will be set to \code{"default"}. }} \item{ci}{Confidence Interval (CI) level. Default to \code{0.95} (\verb{95\%}).} diff --git a/tests/testthat/test-p_significance.R b/tests/testthat/test-p_significance.R index 9de21d3cc..16c71f4f2 100644 --- a/tests/testthat/test-p_significance.R +++ b/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", {