Rejuvenation

NEWS.md

@@ -2,7 +2,7 @@
 
 ## Breaking Changes
 
-* `pd_to_p()` now returns 1 and a warning for pds smaller than 0.5.
+* `pd_to_p()` now returns 1 and a warning for values smaller than 0.5.
 * `map_estimate()`, `p_direction()`, `p_map()`, and `p_significance()` now 
   return a data-frame when the input is a numeric vector. (making the output 
   consistently a data frame for all inputs.)

R/describe_posterior.R

@@ -46,7 +46,7 @@
 #' - Makowski, D., Ben-Shachar, M. S., Chen, S. H. A., and Lüdecke, D. (2019).
 #'   *Indices of Effect Existence and Significance in the Bayesian Framework*.
 #'   Frontiers in Psychology 2019;10:2767. \doi{10.3389/fpsyg.2019.02767}
 #' - [Region of Practical Equivalence (ROPE)](https://easystats.github.io/bayestestR/articles/region_of_practical_equivalence.html)
 #' - [Bayes factors](https://easystats.github.io/bayestestR/articles/bayes_factors.html)
 #'
 #' @examples
@@ -165,7 +165,7 @@
 
   # Point-estimates
 
   if (!is.null(centrality)) {
     estimates <- .prepare_output(
       point_estimate(x_df, centrality = centrality, dispersion = dispersion, ...),
       cleaned_parameters,
@@ -184,7 +184,7 @@
 
   # Uncertainty
 
   if (!is.null(ci)) {
     ci_method <- match.arg(tolower(ci_method), c("hdi", "spi", "quantile", "ci", "eti", "si", "bci", "bcai"))
     # not sure why "si" requires the model object
     if (ci_method == "si") {
@@ -211,7 +211,7 @@
 
   # Effect Existence
 
   if (!is.null(test)) {
     test <- .check_test_values(test)
     if ("all" %in% test) {
       test <- c("pd", "p_map", "p_rope", "p_significance", "rope", "equivalence", "bf")
@@ -243,7 +243,7 @@
       if (!is.data.frame(test_pmap)) {
         test_pmap <- data.frame(
           Parameter = "Posterior",
-          p_map = test_pmap,
+          p_MAP = test_pmap,
           stringsAsFactors = FALSE
         )
       }
@@ -367,7 +367,7 @@
           cleaned_parameters,
           is_stanmvreg
         ),
         error = function(e) data.frame("Parameter" = NA)
       )
       if (!"Parameter" %in% names(test_bf)) {
         test_bf <- cbind(
@@ -376,14 +376,14 @@
         )
       }
     } else {
       test_bf <- data.frame("Parameter" = NA)
     }
   } else {
     test_pd <- data.frame(
       "Parameter" = NA,
       "Effects" = NA,
       "Component" = NA,
       "Response" = NA
     )
 
     test_rope <- data.frame(

R/p_direction.R

@@ -167,8 +167,7 @@ p_direction.default <- function(x, ...) {
 #' @export
 p_direction.numeric <- function(x, method = "direct", null = 0, ...) {
   obj_name <- insight::safe_deparse_symbol(substitute(x))
-  out <- p_direction(data.frame(x = x), method = method, null = null, ...)
-  out[[1]] <- NULL
+  out <- p_direction(data.frame(Posterior = x), method = method, null = null, ...)
   attr(out, "object_name") <- obj_name
   out
 }
@@ -187,8 +186,8 @@ p_direction.data.frame <- function(x, method = "direct", null = 0, ...) {
   }
 
   out <- data.frame(
-    "Parameter" = names(x),
-    "pd" = pd,
+    Parameter = names(x),
+    pd = pd,
     row.names = NULL,
     stringsAsFactors = FALSE
   )

R/p_map.R

@@ -82,9 +82,7 @@ p_pointnull <- p_map
 
 #' @export
 p_map.numeric <- function(x, null = 0, precision = 2^10, method = "kernel", ...) {
-  out <- p_map(data.frame(x = x), null = null, precision = precision, method = method, ...)
-  out[[1]] <- NULL
-  out
+  p_map(data.frame(Posterior = x), null = null, precision = precision, method = method, ...)
 }
 
 
@@ -100,8 +98,8 @@ p_map.data.frame <- function(x, null = 0, precision = 2^10, method = "kernel", .
   }
 
   out <- data.frame(
-    "Parameter" = names(x),
-    "p_MAP" = p_MAP,
+    Parameter = names(x),
+    p_MAP = p_MAP,
     row.names = NULL,
     stringsAsFactors = FALSE
   )

R/p_significance.R

@@ -60,8 +60,7 @@ p_significance.default <- function(x, ...) {
 #' @export
 p_significance.numeric <- function(x, threshold = "default", ...) {
   threshold <- .select_threshold_ps(threshold = threshold)
-  out <- p_significance(data.frame(x = x), threshold = threshold)
-  out[[1]] <- NULL
+  out <- p_significance(data.frame(Posterior = x), threshold = threshold)
   attr(out, "data") <- x
   out
 }
@@ -80,8 +79,8 @@ p_significance.data.frame <- function(x, threshold = "default", ...) {
   }
 
   out <- data.frame(
-    "Parameter" = names(x),
-    "ps" = as.numeric(ps),
+    Parameter = names(x),
+    ps = as.numeric(ps),
     row.names = NULL,
     stringsAsFactors = FALSE
   )
@@ -295,10 +294,10 @@ as.double.p_significance <- as.numeric.p_significance
   }
   # If default
   if (all(threshold == "default")) {
-    if (!is.null(model)) {
-      threshold <- rope_range(model, verbose = verbose)[2]
-    } else {
+    if (is.null(model)) {
       threshold <- 0.1
+    } 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).")

inst/WORDLIST

@@ -41,6 +41,7 @@ Haaf
 Hinne
 Hirose
 Imai
+IRR
 Iverson
 JASP
 JASP's

tests/testthat/test-BFBayesFactor.R

@@ -1,15 +1,15 @@
 test_that("p_direction", {
   skip_if_not_or_load_if_installed("BayesFactor")
   set.seed(333)
-  x <- correlationBF(y = iris$Sepal.Length, x = iris$Sepal.Width)
+  x <- BayesFactor::correlationBF(y = iris$Sepal.Length, x = iris$Sepal.Width)
   expect_equal(as.numeric(p_direction(x)), 0.9225, tolerance = 1)
 })
 
 test_that("p_direction: BF t.test one sample", {
   skip_if_not_or_load_if_installed("BayesFactor")
   data(sleep)
   diffScores <- sleep$extra[1:10] - sleep$extra[11:20]
-  x <- ttestBF(x = diffScores)
+  x <- BayesFactor::ttestBF(x = diffScores)
   expect_equal(as.numeric(p_direction(x)), 0.99675, tolerance = 1)
 })
 
@@ -19,67 +19,72 @@ test_that("p_direction: BF t.test two samples", {
   data(chickwts)
   chickwts <- chickwts[chickwts$feed %in% c("horsebean", "linseed"), ]
   chickwts$feed <- factor(chickwts$feed)
-  x <- ttestBF(formula = weight ~ feed, data = chickwts)
+  x <- BayesFactor::ttestBF(formula = weight ~ feed, data = chickwts)
   expect_equal(as.numeric(p_direction(x)), 1, tolerance = 1)
 })
 
 test_that("p_direction: BF t.test meta-analytic", {
   skip_if_not_or_load_if_installed("BayesFactor")
-  t <- c(-.15, 2.39, 2.42, 2.43)
+  t <- c(-0.15, 2.39, 2.42, 2.43)
   N <- c(100, 150, 97, 99)
-  x <- meta.ttestBF(t = t, n1 = N, rscale = 1)
+  x <- BayesFactor::meta.ttestBF(t = t, n1 = N, rscale = 1)
   expect_equal(as.numeric(p_direction(x)), 0.99975, tolerance = 1)
 })
 
+skip_if_not_or_load_if_installed("BayesFactor")
+
 # ---------------------------
 # "BF ANOVA"
 data(ToothGrowth)
 ToothGrowth$dose <- factor(ToothGrowth$dose)
 levels(ToothGrowth$dose) <- c("Low", "Medium", "High")
 x <- BayesFactor::anovaBF(len ~ supp * dose, data = ToothGrowth)
 test_that("p_direction", {
-  expect_equal(as.numeric(p_direction(x)), 91.9, tol = 0.1)
+  expect_equal(as.numeric(p_direction(x)), c(1, 0.95675, 0.95675, 1, 1), tolerance = 0.1)
 })
 
 # BF ANOVA Random ---------------------------
 
 data(puzzles)
 x <- BayesFactor::anovaBF(RT ~ shape * color + ID, data = puzzles, whichRandom = "ID")
 test_that("p_direction", {
-  expect_equal(as.numeric(p_direction(x)), 91.9, tol = 0.1)
+  expect_equal(as.numeric(p_direction(x)), c(
+    1, 0.98125, 0.98125, 0.995, 0.67725, 0.8285, 0.68425, 0.99975,
+    0.6725, 0.9995, 0.60275, 0.99525, 0.7615, 0.763, 1, 1, 1, 1
+  ), tolerance = 0.1)
 })
 
 
 # ---------------------------
 # "BF lm"
 x <- BayesFactor::lmBF(len ~ supp + dose, data = ToothGrowth)
 test_that("p_direction", {
-  expect_equal(as.numeric(p_direction(x)), 91.9, tol = 0.1)
+  expect_equal(as.numeric(p_direction(x)), c(1, 0.9995, 0.9995, 1, 0.903, 1, 1, 1, 1), tolerance = 0.1)
 })
 
 
 x2 <- BayesFactor::lmBF(len ~ supp + dose + supp:dose, data = ToothGrowth)
 x <- x / x2
 test_that("p_direction", {
-  expect_equal(as.numeric(p_direction(x)), 91.9, tol = 0.1)
+  expect_equal(as.numeric(p_direction(x)), c(1, 0.99925, 0.99925, 1, 0.89975, 1, 1, 1, 1), tolerance = 0.1)
 })
 
 
 test_that("rope_range", {
   skip_if_not_or_load_if_installed("BayesFactor")
-  x <- lmBF(len ~ supp + dose, data = ToothGrowth)
-  expect_equal(rope_range(x)[2], sd(ToothGrowth$len) / 10)
+  x <- BayesFactor::lmBF(len ~ supp + dose, data = ToothGrowth)
+  expect_equal(rope_range(x)[2], sd(ToothGrowth$len) / 10, tolerance = 1e-4)
 
-  x <- ttestBF(
+  x <- BayesFactor::ttestBF(
     ToothGrowth$len[ToothGrowth$supp == "OJ"],
     ToothGrowth$len[ToothGrowth$supp == "VC"]
   )
-  expect_equal(rope_range(x)[2], sd(ToothGrowth$len) / 10)
+  expect_equal(rope_range(x)[2], sd(ToothGrowth$len) / 10, tolerance = 1e-4)
 
-  x <- ttestBF(formula = len ~ supp, data = ToothGrowth)
-  expect_equal(rope_range(x)[2], sd(ToothGrowth$len) / 10)
+  x <- BayesFactor::ttestBF(formula = len ~ supp, data = ToothGrowth)
+  expect_equal(rope_range(x)[2], sd(ToothGrowth$len) / 10, tolerance = 1e-4)
 
   # else
-  x <- correlationBF(ToothGrowth$len, ToothGrowth$dose)
-  expect_equal(rope_range(x, verbose = FALSE), c(-0.05, 0.05))
+  x <- BayesFactor::correlationBF(ToothGrowth$len, as.numeric(ToothGrowth$dose))
+  expect_equal(rope_range(x, verbose = FALSE), c(-0.05, 0.05), tolerance = 1e-4)
 })

tests/testthat/test-ci.R

@@ -15,7 +15,7 @@ test_that("ci", {
   expect_equal(ci(distribution_normal(1000), ci = 0.90)$CI_low[1], -1.6361, tolerance = 0.02)
   expect_equal(nrow(ci(distribution_normal(1000), ci = c(0.80, 0.90, 0.95))), 3, tolerance = 0.01)
   expect_equal(ci(distribution_normal(1000), ci = 1)$CI_low[1], -3.29, tolerance = 0.02)
-  expect_equal(length(capture.output(print(ci(distribution_normal(1000), ci = c(.80, .90))))))
+  expect_length(capture.output(print(ci(distribution_normal(1000), ci = c(0.80, 0.90)))), 5)
 
   expect_equal(ci(c(2, 3, NA))$CI_low, 2.02, tolerance = 1e-2)
   expect_warning(ci(c(2, 3)))

tests/testthat/test-describe_posterior.R

@@ -157,11 +157,11 @@ test_that("describe_posterior", {
 
   # brms -------------------------------------------------
 
-  x <- brms::brm(mpg ~ wt + (1 | cyl) + (1 + wt | gear), data = mtcars, refresh = 0)
+  x <- suppressWarnings(brms::brm(mpg ~ wt + (1 | cyl) + (1 + wt | gear), data = mtcars, refresh = 0))
   rez <- describe_posterior(x, centrality = "all", dispersion = TRUE, ci = c(0.8, 0.9))
 
   expect_equal(dim(rez), c(4, 16))
-  expect_equal(colnames(rez), c(
+  expect_identical(colnames(rez), c(
     "Parameter", "Median", "MAD", "Mean", "SD", "MAP", "CI", "CI_low",
     "CI_high", "pd", "ROPE_CI", "ROPE_low", "ROPE_high", "ROPE_Percentage",
     "Rhat", "ESS"
@@ -178,13 +178,13 @@ test_that("describe_posterior", {
 
   expect_equal(dim(rez), c(2, 4))
 
-  model <- brms::brm(
+  model <- suppressWarnings(brms::brm(
     mpg ~ drat,
     data = mtcars,
     chains = 2,
     algorithm = "meanfield",
     refresh = 0
-  )
+  ))
 
   expect_equal(nrow(describe_posterior(model)), 2)
 

tests/testthat/test-format.R

@@ -18,22 +18,22 @@ test_that("p_significance", {
   )
   expect_equal(
     format(map_estimate(x)),
-    data.frame(x = "0.13", stringsAsFactors = FALSE),
+    data.frame(MAP_Estimate = "0.13", stringsAsFactors = FALSE),
     ignore_attr = TRUE
   )
   expect_equal(
     format(p_direction(x)),
-    data.frame(x = "51.00%", stringsAsFactors = FALSE),
+    data.frame(Parameter = "Posterior", pd = "51.00%", stringsAsFactors = FALSE),
     ignore_attr = TRUE
   )
   expect_equal(
     format(p_map(x)),
-    data.frame(x = "0.973", stringsAsFactors = FALSE),
+    data.frame(Parameter = "Posterior", p_MAP = "0.973", stringsAsFactors = FALSE),
     ignore_attr = TRUE
   )
   expect_equal(
     format(p_significance(x)),
-    data.frame(x = "0.46", stringsAsFactors = FALSE),
+    data.frame(Parameter = "Posterior", ps = "0.46", stringsAsFactors = FALSE),
     ignore_attr = TRUE
   )
   expect_equal(

tests/testthat/test-p_direction.R

@@ -6,14 +6,20 @@ test_that("p_direction", {
   expect_equal(as.numeric(p_direction(x, method = "kernel")), 0.842, tolerance = 0.1)
   expect_s3_class(pd, "p_direction")
   expect_s3_class(pd, "data.frame")
-  expect_equal(dim(pd), c(1L, 1L))
-  expect_output(print(pd), regexp = "Probability of Direction: 84.13%", fixed = TRUE)
+  expect_identical(dim(pd), c(1L, 2L))
+  expect_identical(
+    capture.output(print(pd)),
+    c(
+      "Probability of Direction", "", "Parameter |     pd", "------------------",
+      "Posterior | 84.13%"
+    )
+  )
 
   df <- data.frame(replicate(4, rnorm(100)))
   pd <- p_direction(df)
   expect_s3_class(pd, "p_direction")
   expect_s3_class(pd, "data.frame")
-  expect_equal(dim(pd), c(4, 2))
+  expect_identical(dim(pd), c(4L, 2L))
 })
 
 

tests/testthat/test-p_map.R

@@ -4,8 +4,14 @@ test_that("p_map", {
   expect_equal(as.numeric(pmap), 0.9285376, tolerance = 0.001)
   expect_s3_class(pmap, "p_map")
   expect_s3_class(pmap, "data.frame")
-  expect_equal(dim(pmap), c(1, 1))
-  expect_output(print(pmap), "MAP-based p-value: 0.929")
+  expect_identical(dim(pmap), c(1L, 2L))
+  expect_identical(
+    capture.output(print(pmap)),
+    c(
+      "MAP-based p-value", "", "Parameter | p (MAP)",
+      "-------------------", "Posterior |   0.929"
+    )
+  )
 
   expect_equal(as.numeric(p_map(distribution_normal(1000))), 1, tolerance = 0.1)
   expect_equal(as.numeric(p_map(distribution_normal(1000, 1, 1))), 0.62, tolerance = 0.1)

tests/testthat/test-p_significance.R

@@ -6,12 +6,21 @@ test_that("p_significance", {
   expect_equal(as.numeric(ps), 0.816, tolerance = 0.1)
   expect_s3_class(ps, "p_significance")
   expect_s3_class(ps, "data.frame")
-  expect_equal(dim(ps), c(1, 1))
-  expect_output(print(ps), "Practical Significance \\(threshold: 0.10\\): 0.82")
+  expect_identical(dim(ps), c(1L, 2L))
+  expect_identical(
+    capture.output(print(ps)),
+    c(
+      "Practical Significance (threshold: 0.10)",
+      "",
+      "Parameter |   ps",
+      "----------------",
+      "Posterior | 0.82"
+    )
+  )
 
   x <- data.frame(replicate(4, rnorm(100)))
   pd <- p_significance(x)
-  expect_equal(dim(pd), c(4, 2))
+  expect_identical(dim(pd), c(4L, 2L))
 })
 
 test_that("stanreg", {

tests/testthat/test-rope.R

@@ -4,25 +4,23 @@ test_that("rope", {
   skip_if_not_or_load_if_installed("brms")
 
   expect_equal(as.numeric(rope(distribution_normal(1000, 0, 1), verbose = FALSE)), 0.084, tolerance = 0.01)
-  expect_equal(equivalence_test(distribution_normal(1000, 0, 1))$ROPE_Equivalence, "Undecided")
-  expect_equal(length(capture.output(print(equivalence_test(distribution_normal(1000))))), 9)
-  expect_equal(length(capture.output(print(equivalence_test(distribution_normal(1000),
-    ci = c(0.8, 0.9)
-  )))), 14)
+  expect_identical(equivalence_test(distribution_normal(1000, 0, 1))$ROPE_Equivalence, "Undecided")
+  expect_length(capture.output(print(equivalence_test(distribution_normal(1000)))), 9)
+  expect_length(capture.output(print(equivalence_test(distribution_normal(1000), ci = c(0.8, 0.9)))), 14)
 
   expect_equal(as.numeric(rope(distribution_normal(1000, 2, 0.01), verbose = FALSE)), 0, tolerance = 0.01)
-  expect_equal(equivalence_test(distribution_normal(1000, 2, 0.01))$ROPE_Equivalence, "Rejected")
+  expect_identical(equivalence_test(distribution_normal(1000, 2, 0.01))$ROPE_Equivalence, "Rejected")
 
   expect_equal(as.numeric(rope(distribution_normal(1000, 0, 0.001), verbose = FALSE)), 1, tolerance = 0.01)
-  expect_equal(equivalence_test(distribution_normal(1000, 0, 0.001))$ROPE_Equivalence, "Accepted")
+  expect_identical(equivalence_test(distribution_normal(1000, 0, 0.001))$ROPE_Equivalence, "Accepted")
 
-  expect_equal(equivalence_test(distribution_normal(1000, 0, 0.001), ci = 1)$ROPE_Equivalence, "Accepted")
+  expect_identical(equivalence_test(distribution_normal(1000, 0, 0.001), ci = 1)$ROPE_Equivalence, "Accepted")
 
-  expect_equal(rope(rnorm(1000, mean = 0, sd = 3), ci = c(.1, .5, .9), verbose = FALSE)$CI, c(.1, .5, .9))
+  expect_equal(rope(rnorm(1000, mean = 0, sd = 3), ci = c(0.1, 0.5, 0.9), verbose = FALSE)$CI, c(0.1, 0.5, 0.9))
 
-  x <- equivalence_test(distribution_normal(1000, 1, 1), ci = c(.50, .99))
+  x <- equivalence_test(distribution_normal(1000, 1, 1), ci = c(0.50, 0.99))
   expect_equal(x$ROPE_Percentage[2], 0.0484, tolerance = 0.01)
-  expect_equal(x$ROPE_Equivalence[2], "Undecided")
+  expect_identical(x$ROPE_Equivalence[2], "Undecided")
 
   expect_error(rope(distribution_normal(1000, 0, 1), range = c(0.0, 0.1, 0.2)))
 
@@ -47,7 +45,7 @@ test_that("rope", {
   p <- insight::get_parameters(m, effects = "all")
   expect_equal(
     # fix range to -.1/.1, to compare to data frame method
-    rope(m, range = c(-.1, .1), effects = "all", verbose = FALSE)$ROPE_Percentage,
+    rope(m, range = c(-0.1, 0.1), effects = "all", verbose = FALSE)$ROPE_Percentage,
     rope(p, verbose = FALSE)$ROPE_Percentage,
     tolerance = 1e-3
   )
@@ -81,7 +79,7 @@ test_that("rope (brms)", {
   expect_equal(rope$ROPE_Percentage, c(0.00, 0.00, 0.50), tolerance = 0.1)
 })
 
-model <- brm(mvbind(mpg, disp) ~ wt + gear, data = mtcars, iter = 500)
+model <- brm(bf(mvbind(mpg, disp) ~ wt + gear) + set_rescor(TRUE), data = mtcars, iter = 500, refresh = 0)
 rope <- rope(model, verbose = FALSE)
 
 test_that("rope (brms, multivariate)", {