From d666a3af3d71be5c14ba27611585a7e47825c5b1 Mon Sep 17 00:00:00 2001 From: Daniel Date: Tue, 3 Sep 2024 09:10:43 +0200 Subject: [PATCH] Allow `p_significance()` to accept non symetric `threshold` range (#671) Fixes #663 --- DESCRIPTION | 2 +- NEWS.md | 2 + R/p_significance.R | 63 ++++++++++++++++++---------- man/p_significance.Rd | 17 +++++++- tests/testthat/test-p_significance.R | 11 +++++ 5 files changed, 71 insertions(+), 24 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 72b8dc9ae..b2a148ab0 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.3 +Version: 0.14.0.4 Authors@R: c(person(given = "Dominique", family = "Makowski", diff --git a/NEWS.md b/NEWS.md index 982e56dc8..d6e5dc464 100644 --- a/NEWS.md +++ b/NEWS.md @@ -18,6 +18,8 @@ - Besides the existing `as.numeric()` method, `p_direction()` now also has an `as.vector()` method. +* `p_significance()` now accepts non-symmetric ranges for the `threshold` argument. + * `p_to_pd()` now also works with data frames returned by `p_direction()`. If a data frame contains a `pd`, `p_direction` or `PD` column name, this is assumed to be the pd-values, which are then converted to p-values. diff --git a/R/p_significance.R b/R/p_significance.R index 15d54b682..715684c17 100644 --- a/R/p_significance.R +++ b/R/p_significance.R @@ -1,8 +1,19 @@ #' Practical Significance (ps) #' -#' Compute the probability of **Practical Significance** (***ps***), which can be conceptualized as a unidirectional equivalence test. It returns the probability that effect is above a given threshold corresponding to a negligible effect in the median's direction. Mathematically, it is defined as the proportion of the posterior distribution of the median sign above the threshold. +#' Compute the probability of **Practical Significance** (***ps***), which can +#' be conceptualized as a unidirectional equivalence test. It returns the +#' probability that effect is above a given threshold corresponding to a +#' negligible effect in the median's direction. Mathematically, it is defined as +#' the proportion of the posterior distribution of the median sign above the +#' threshold. #' -#' @param threshold The threshold value that separates significant from negligible effect. If `"default"`, the range is set to `0.1` if input is a vector, and based on [`rope_range()`][rope_range] if a Bayesian model is provided. +#' @param threshold The threshold value that separates significant from +#' negligible effect, which can have following possible values: +#' - `"default"`, in which case the range is set to `0.1` if input is a vector, +#' and based on [`rope_range()`] if a Bayesian model is provided. +#' - a single numeric value (e.g., 0.1), which is used as range around zero +#' (i.e. the threshold range is set to -0.1 and 0.1) +#' - a numeric vector of length two (e.g., `c(-0.2, 0.1)`). #' @inheritParams rope #' @inheritParams hdi #' @@ -67,7 +78,11 @@ p_significance.numeric <- function(x, threshold = "default", ...) { #' @rdname p_significance #' @export -p_significance.get_predicted <- function(x, threshold = "default", use_iterations = FALSE, verbose = TRUE, ...) { +p_significance.get_predicted <- function(x, + threshold = "default", + use_iterations = FALSE, + verbose = TRUE, + ...) { if (isTRUE(use_iterations)) { if ("iterations" %in% names(attributes(x))) { out <- p_significance( @@ -275,12 +290,21 @@ p_significance.brmsfit <- function(x, } .p_significance <- function(x, threshold, ...) { - psig <- max( - c( - length(x[x > abs(threshold)]) / length(x), # ps positive - length(x[x < -abs(threshold)]) / length(x) # ps negative + if (length(threshold) == 1) { + psig <- max( + c( + length(x[x > abs(threshold)]) / length(x), # ps positive + length(x[x < -abs(threshold)]) / length(x) # ps negative + ) ) - ) + } else { + psig <- max( + c( + length(x[x > threshold[2]]) / length(x), # ps positive + length(x[x < threshold[1]]) / length(x) # ps negative + ) + ) + } psig } @@ -291,9 +315,9 @@ p_significance.brmsfit <- function(x, #' @export as.numeric.p_significance <- function(x, ...) { if (inherits(x, "data.frame")) { - return(as.numeric(as.vector(x$ps))) + as.numeric(as.vector(x$ps)) } else { - return(as.vector(x)) + as.vector(x) } } @@ -308,15 +332,6 @@ as.double.p_significance <- as.numeric.p_significance #' @keywords internal .select_threshold_ps <- function(model = NULL, threshold = "default", verbose = TRUE) { - # If a range is passed - if (length(threshold) > 1) { - if (length(unique(abs(threshold))) == 1) { - # If symmetric range - threshold <- abs(threshold[2]) - } else { - insight::format_error("`threshold` should be 'default' or a numeric value (e.g., 0.1).") - } - } # If default if (all(threshold == "default")) { if (is.null(model)) { @@ -324,8 +339,14 @@ as.double.p_significance <- as.numeric.p_significance } else { threshold <- rope_range(model, verbose = verbose)[2] } - } else if (!all(is.numeric(threshold))) { - insight::format_error("`threshold` should be 'default' or a numeric value (e.g., 0.1).") + } else if (all(is.numeric(threshold)) && length(threshold) == 2) { + } else if (!all(is.numeric(threshold)) || length(threshold) > 2) { + insight::format_error( + "`threshold` should be one of the following values:", + "- \"default\", in which case the threshold is based on `rope_range()`", + "- a single numeric value (e.g., 0.1), which is used as range around zero (i.e. the threshold range is set to -0.1 and 0.1)", + "- a numeric vector of length two (e.g., `c(-0.2, 0.1)`)" + ) } threshold } diff --git a/man/p_significance.Rd b/man/p_significance.Rd index f275550ae..ebf10cfc3 100644 --- a/man/p_significance.Rd +++ b/man/p_significance.Rd @@ -47,7 +47,15 @@ p_significance(x, ...) \item{...}{Currently not used.} -\item{threshold}{The threshold value that separates significant from negligible effect. If \code{"default"}, the range is set to \code{0.1} if input is a vector, and based on \code{\link[=rope_range]{rope_range()}} if a Bayesian model is provided.} +\item{threshold}{The threshold value that separates significant from +negligible effect, which can have following possible values: +\itemize{ +\item \code{"default"}, in which case the range is set to \code{0.1} if input is a vector, +and based on \code{\link[=rope_range]{rope_range()}} if a Bayesian model is provided. +\item a single numeric value (e.g., 0.1), which is used as range around zero +(i.e. the threshold range is set to -0.1 and 0.1) +\item a numeric vector of length two (e.g., \code{c(-0.2, 0.1)}). +}} \item{use_iterations}{Logical, if \code{TRUE} and \code{x} is a \code{get_predicted} object, (returned by \code{\link[insight:get_predicted]{insight::get_predicted()}}), the function is applied to the @@ -73,7 +81,12 @@ for the output.} Values between 0 and 1 corresponding to the probability of practical significance (ps). } \description{ -Compute the probability of \strong{Practical Significance} (\emph{\strong{ps}}), which can be conceptualized as a unidirectional equivalence test. It returns the probability that effect is above a given threshold corresponding to a negligible effect in the median's direction. Mathematically, it is defined as the proportion of the posterior distribution of the median sign above the threshold. +Compute the probability of \strong{Practical Significance} (\emph{\strong{ps}}), which can +be conceptualized as a unidirectional equivalence test. It returns the +probability that effect is above a given threshold corresponding to a +negligible effect in the median's direction. Mathematically, it is defined as +the proportion of the posterior distribution of the median sign above the +threshold. } \details{ \code{p_significance()} returns the proportion of a probability diff --git a/tests/testthat/test-p_significance.R b/tests/testthat/test-p_significance.R index b13754014..6f542f3c0 100644 --- a/tests/testthat/test-p_significance.R +++ b/tests/testthat/test-p_significance.R @@ -18,9 +18,20 @@ test_that("p_significance", { ) ) + # non-symmetric intervals + ps <- p_significance(x, threshold = c(0.05, 0.2)) + expect_equal(as.numeric(ps), 0.7881, tolerance = 0.1) + # should be identical, both ranges have same distance to the mean 1 + ps <- p_significance(x, threshold = c(1.8, 1.95)) + expect_equal(as.numeric(ps), 0.7881, tolerance = 0.1) + + set.seed(333) x <- data.frame(replicate(4, rnorm(100))) pd <- p_significance(x) expect_identical(dim(pd), c(4L, 2L)) + + # error: + expect_error(p_significance(x, threshold = 1:3)) }) test_that("stanreg", {