diff --git a/R/plot.p_significance.R b/R/plot.p_significance.R index 9e45c4f80..f42ec6b29 100644 --- a/R/plot.p_significance.R +++ b/R/plot.p_significance.R @@ -68,7 +68,7 @@ data_plot.p_significance <- function(x, } } else { levels_order <- NULL - dataplot <- .compute_densities_pd(data[, 1], name = "Posterior") + dataplot <- .compute_densities_ps(data[, 1], name = "Posterior", threshold = attr(x, "threshold")) } dataplot <- do.call( @@ -132,12 +132,28 @@ data_plot.p_significance <- function(x, .compute_densities_ps <- function(x, name = "Y", threshold = 0) { out <- .as.data.frame_density(stats::density(x)) - fifty_cents <- sum(out$y[out$x > threshold]) > (sum(out$y) / 2) + # sanity check + if (is.null(threshold)) { + threshold <- 0 + } + + # make sure we have a vector of length 2 + if (length(threshold) == 1) { + threshold <- c(-1 * threshold, threshold) + } + + # find out the probability mass larger or lower than the ROPE (outside) + p_mass_ht_rope <- sum(out$y[out$x > threshold[2]]) > (sum(out$y) / 2) + p_mass_lt_rope <- sum(out$y[out$x < threshold[1]]) > (sum(out$y) / 2) + + # find out whether probability mass "above" ROPE is larger than the probability + # mass that is on the left (negative) side of the ROPE + fifty_cents <- p_mass_ht_rope > p_mass_lt_rope out$fill <- "Less Probable" - out$fill[abs(out$x) < threshold] <- "ROPE" - out$fill[(out$x > threshold)] <- ifelse(fifty_cents, "Significant", "Less Probable") - out$fill[out$x < (-1 * threshold)] <- ifelse(fifty_cents, "Less Probable", "Significant") + out$fill[out$x > threshold[1] & out$x < threshold[2]] <- "ROPE" + out$fill[out$x > threshold[2]] <- ifelse(fifty_cents, "Significant", "Less Probable") + out$fill[out$x < threshold[1]] <- ifelse(fifty_cents, "Less Probable", "Significant") out$height <- out$y out$y <- name diff --git a/tests/testthat/_snaps/plot.p_significance/plot-p-sig-simple-threshold.svg b/tests/testthat/_snaps/plot.p_significance/plot-p-sig-simple-threshold.svg new file mode 100644 index 000000000..dd97f5514 --- /dev/null +++ b/tests/testthat/_snaps/plot.p_significance/plot-p-sig-simple-threshold.svg @@ -0,0 +1,52 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-2 +0 +2 +4 +6 +Possible parameter values +Posterior +Practical Significance + + diff --git a/tests/testthat/_snaps/plot.p_significance/plot-p-sig-threshold-2.svg b/tests/testthat/_snaps/plot.p_significance/plot-p-sig-threshold-2.svg new file mode 100644 index 000000000..7c93bef30 --- /dev/null +++ b/tests/testthat/_snaps/plot.p_significance/plot-p-sig-threshold-2.svg @@ -0,0 +1,52 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-2 +0 +2 +4 +6 +Possible parameter values +Posterior +Practical Significance + + diff --git a/tests/testthat/test-plot.p_significance.R b/tests/testthat/test-plot.p_significance.R index e2bc1ec1b..bd3be9f5c 100644 --- a/tests/testthat/test-plot.p_significance.R +++ b/tests/testthat/test-plot.p_significance.R @@ -7,3 +7,21 @@ test_that("`plot.see_p_significance()` works", { expect_s3_class(plot(result), "gg") }) + +skip_if_not_installed("bayestestR", minimum_version = "0.14.1") + +test_that("`plot.see_p_significance works for two thresholds", { + skip_if_not_installed("vdiffr") + set.seed(123) + x <- rnorm(1000, 1, 1.2) + out <- bayestestR::p_significance(x) + vdiffr::expect_doppelganger( + title = "plot.p_sig_simple_threshold", + fig = plot(out) + ) + out <- bayestestR::p_significance(x, threshold = c(-0.2, 0.5)) + vdiffr::expect_doppelganger( + title = "plot.p_sig_threshold_2", + fig = plot(out) + ) +})