Uncomment tests

cf. easystats/easystats#361
easystats · Sep 14, 2023 · 42d2322 · 42d2322
1 parent 2193a4f
commit 42d2322
Show file tree

Hide file tree

Showing 11 changed files with 115 additions and 108 deletions.
diff --git a/R/bayesfactor_restricted.R b/R/bayesfactor_restricted.R
@@ -5,9 +5,11 @@
 #' \cr \cr
 #' The `bf_*` function is an alias of the main function.
 #' \cr \cr
-#' \strong{For more info, in particular on specifying correct priors for factors with more than 2 levels, see [the Bayes factors vignette](https://easystats.github.io/bayestestR/articles/bayes_factors.html).}
+#' \strong{For more info, in particular on specifying correct priors for factors with more than 2 levels,
+#' see [the Bayes factors vignette](https://easystats.github.io/bayestestR/articles/bayes_factors.html).}
 #'
-#' @param posterior A `stanreg` / `brmsfit` object, `emmGrid` or a data frame - representing a posterior distribution(s) from (see Details).
+#' @param posterior A `stanreg` / `brmsfit` object, `emmGrid` or a data frame - representing
+#' a posterior distribution(s) from (see Details).
 #' @param hypothesis A character vector specifying the restrictions as logical conditions (see examples below).
 #' @param prior An object representing a prior distribution (see Details).
 #' @inheritParams hdi
@@ -107,9 +109,12 @@
 #' }
 #'
 #' @references
-#' - Morey, R. D., & Wagenmakers, E. J. (2014). Simple relation between Bayesian order-restricted and point-null hypothesis tests. Statistics & Probability Letters, 92, 121-124.
-#' - Morey, R. D., & Rouder, J. N. (2011). Bayes factor approaches for testing interval null hypotheses. Psychological methods, 16(4), 406.
-#' - Morey, R. D. (Jan, 2015). Multiple Comparisons with BayesFactor, Part 2 – order restrictions. Retrieved from https://richarddmorey.org/category/order-restrictions/.
+#' - Morey, R. D., & Wagenmakers, E. J. (2014). Simple relation between Bayesian order-restricted and
+#' point-null hypothesis tests. Statistics & Probability Letters, 92, 121-124.
+#' - Morey, R. D., & Rouder, J. N. (2011). Bayes factor approaches for testing interval null hypotheses.
+#' Psychological methods, 16(4), 406.
+#' - Morey, R. D. (Jan, 2015). Multiple Comparisons with BayesFactor, Part 2 – order restrictions.
+#' Retrieved from https://richarddmorey.org/category/order-restrictions/.
 #'
 #' @export
 bayesfactor_restricted <- function(posterior, hypothesis, prior = NULL, verbose = TRUE, ...) {

diff --git a/man/bayesfactor_restricted.Rd b/man/bayesfactor_restricted.Rd
diff --git a/tests/testthat/test-BFBayesFactor.R b/tests/testthat/test-BFBayesFactor.R
@@ -31,38 +31,38 @@ test_that("p_direction: BF t.test meta-analytic", {
   expect_equal(as.numeric(p_direction(x)), 0.99975, tolerance = 1)
 })
 
-# # ---------------------------
-# # "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)
-# })
-#
-# # ---------------------------
-# # "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)
-# })
-#
-#
-# # ---------------------------
-# # "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)
-# })
-#
-#
-# 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)
-# })
+# ---------------------------
+# "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)
+})
+
+# 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)
+})
+
+
+# ---------------------------
+# "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)
+})
+
+
+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)
+})
 
 
 test_that("rope_range", {

diff --git a/tests/testthat/test-bayesfactor_models.R b/tests/testthat/test-bayesfactor_models.R
@@ -195,7 +195,7 @@ test_that("bayesfactor_inclusion | LMM", {
   expect_equal(bfinc_all$p_posterior, c(1, 1, 0.12, 0.01, 0), tolerance = 0.1)
   expect_equal(bfinc_all$log_BF, c(NaN, 57.651, -2.352, -4.064, -4.788), tolerance = 0.1)
 
-  # + match_models
+  # plus match_models
   bfinc_matched <- bayesfactor_inclusion(BFM4, match_models = TRUE)
   expect_equal(bfinc_matched$p_prior, c(1, 0.2, 0.6, 0.2, 0.2), tolerance = 0.1)
   expect_equal(bfinc_matched$p_posterior, c(1, 0.875, 0.125, 0.009, 0.002), tolerance = 0.1)

diff --git a/tests/testthat/test-bayesfactor_parameters.R b/tests/testthat/test-bayesfactor_parameters.R
@@ -91,26 +91,27 @@ test_that("bayesfactor_parameters RSTANARM", {
 
 
 # bayesfactor_parameters BRMS ---------------------------------------------
-#
-#   test_that("bayesfactor_parameters BRMS", {
-#     skip_if_offline()
-#     skip_if_not_or_load_if_installed("rstanarm")
-#     skip_if_not_or_load_if_installed("BayesFactor")
-#     skip_if_not_or_load_if_installed("httr")
-#     skip_if_not_or_load_if_installed("brms")
-#
-#     brms_mixed_6 <- insight::download_model("brms_mixed_6")
-#
-#     set.seed(222)
-#     brms_mixed_6_p <- unupdate(brms_mixed_6)
-#     bfsd1 <- bayesfactor_parameters(brms_mixed_6, brms_mixed_6_p, effects = "fixed")
-#
-#     set.seed(222)
-#     bfsd2 <- bayesfactor_parameters(brms_mixed_6, effects = "fixed")
-#
-#     expect_equal(log(bfsd1$BF), log(bfsd2$BF), tolerance = .11)
-#
-#
-#     brms_mixed_1 <- insight::download_model("brms_mixed_1")
-#     expect_error(bayesfactor_parameters(brms_mixed_1))
-#   })
+
+test_that("bayesfactor_parameters BRMS", {
+  skip_if_offline()
+  skip_if_not_or_load_if_installed("rstanarm")
+  skip_if_not_or_load_if_installed("BayesFactor")
+  skip_if_not_or_load_if_installed("httr")
+  skip_if_not_or_load_if_installed("brms")
+  skip_if_not_or_load_if_installed("cmdstanr")
+
+  brms_mixed_6 <- insight::download_model("brms_mixed_6")
+
+  set.seed(222)
+  brms_mixed_6_p <- unupdate(brms_mixed_6)
+  bfsd1 <- bayesfactor_parameters(brms_mixed_6, brms_mixed_6_p, effects = "fixed")
+
+  set.seed(222)
+  bfsd2 <- bayesfactor_parameters(brms_mixed_6, effects = "fixed")
+
+  expect_equal(log(bfsd1$BF), log(bfsd2$BF), tolerance = .11)
+
+
+  brms_mixed_1 <- insight::download_model("brms_mixed_1")
+  expect_error(bayesfactor_parameters(brms_mixed_1))
+})
diff --git a/tests/testthat/test-brms.R b/tests/testthat/test-brms.R
@@ -10,14 +10,14 @@ test_that("brms", {
   expect_s3_class(hdi(model), "data.frame")
   expect_s3_class(ci(model), "data.frame")
   expect_s3_class(rope(model, verbose = FALSE), "data.frame")
-  # expect_true("equivalence_test" %in% class(equivalence_test(model)))
+  expect_true("equivalence_test" %in% class(equivalence_test(model)))
   expect_s3_class(map_estimate(model), "data.frame")
   expect_s3_class(p_map(model), "data.frame")
   expect_s3_class(p_direction(model), "data.frame")
 
   expect_identical(colnames(hdi(model)), c("Parameter", "CI", "CI_low", "CI_high", "Effects", "Component"))
   expect_identical(colnames(hdi(model, effects = "all")), c("Parameter", "CI", "CI_low", "CI_high", "Effects", "Component"))
-  # expect_equal(nrow(equivalence_test(model)), 2)
+  expect_equal(nrow(equivalence_test(model)), 2L)
 
   out <- describe_posterior(model, effects = "all", component = "all", centrality = "mean")
   suppressWarnings({

diff --git a/tests/testthat/test-check_prior.R b/tests/testthat/test-check_prior.R
@@ -80,15 +80,14 @@ test_that("check_prior - brms (linux)", {
     chains = 2, silent = TRUE, refresh = 0
   )
 
-  # TODO: check hard-coded values")
-  # expect_warning(expect_equal(
-  #   check_prior(model2)$Prior_Quality,
-  #   c(
-  #     "uninformative", "informative", "informative", "uninformative",
-  #     "uninformative", "not determinable", "not determinable", "not determinable"
-  #   )
-  # ))
-
+  # TODO: check hard-coded values
+  expect_warning(expect_equal(
+    check_prior(model2)$Prior_Quality,
+    c(
+      "uninformative", "informative", "informative", "uninformative",
+      "uninformative", "not determinable", "not determinable", "not determinable"
+    )
+  ))
 
   expect_warning(expect_identical(
     check_prior(model2, method = "lakeland")$Prior_Quality,

diff --git a/tests/testthat/test-ci.R b/tests/testthat/test-ci.R
@@ -15,8 +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))))))
-  # expect_equal(length(capture.output(print(ci(distribution_normal(1000), ci = c(.80, .90))))))
+  expect_equal(length(capture.output(print(ci(distribution_normal(1000), ci = c(.80, .90))))))
 
   expect_equal(ci(c(2, 3, NA))$CI_low, 2.02, tolerance = 1e-2)
   expect_warning(ci(c(2, 3)))

diff --git a/tests/testthat/test-different_models.R b/tests/testthat/test-different_models.R
@@ -38,8 +38,8 @@ test_that("insight::get_predicted", {
   rez <- describe_posterior(x)
   expect_equal(c(nrow(rez), ncol(rez)), c(32, 5))
 
-  # rez <- estimate_density(x)
-  # expect_equal(c(nrow(rez), ncol(rez)), c(2048, 3))
+  rez <- estimate_density(x)
+  expect_equal(c(nrow(rez), ncol(rez)), c(2048, 3))
 })
 
 test_that("bayesQR", {

diff --git a/tests/testthat/test-rope_range.R b/tests/testthat/test-rope_range.R
@@ -29,27 +29,26 @@ test_that("rope_range logistic", {
 
 
 
-# if ( skip_if_not_or_load_if_installed("brms")) {
-#   test_that("rope_range", {
-#     model <- brm(mpg ~ wt + gear, data = mtcars, iter = 300)
-#
-#     expect_equal(
-#       rope_range(model),
-#       c(-0.6026948, 0.6026948),
-#       tolerance = 0.01
-#     )
-#   })
-#
-#   test_that("rope_range (multivariate)", {
-#     model <- brm(mvbind(mpg, disp) ~ wt + gear, data = mtcars, iter = 300)
-#
-#     expect_equal(
-#       rope_range(model),
-#       list(
-#         mpg = c(-0.602694, 0.602694),
-#         disp = c(-12.393869, 12.393869)
-#       ),
-#       tolerance = 0.01
-#     )
-#   })
-# }
+test_that("rope_range", {
+  skip_if_not_or_load_if_installed("brms")
+  model <- brm(mpg ~ wt + gear, data = mtcars, iter = 300)
+
+  expect_equal(
+    rope_range(model),
+    c(-0.6026948, 0.6026948),
+    tolerance = 0.01
+  )
+})
+
+test_that("rope_range (multivariate)", {
+  model <- brm(mvbind(mpg, disp) ~ wt + gear, data = mtcars, iter = 300)
+
+  expect_equal(
+    rope_range(model),
+    list(
+      mpg = c(-0.602694, 0.602694),
+      disp = c(-12.393869, 12.393869)
+    ),
+    tolerance = 0.01
+  )
+})
diff --git a/tests/testthat/test-rstanarm.R b/tests/testthat/test-rstanarm.R
@@ -38,13 +38,12 @@ test_that("rstanarm", {
   expect_s3_class(hdi(model), "data.frame")
   expect_s3_class(ci(model), "data.frame")
   expect_s3_class(rope(model, verbose = FALSE), "data.frame")
-  # expect_true("equivalence_test" %in% class(equivalence_test(model)))
+  expect_true("equivalence_test" %in% class(equivalence_test(model)))
   expect_s3_class(map_estimate(model), "data.frame")
   expect_s3_class(p_map(model), "data.frame")
   expect_s3_class(p_direction(model), "data.frame")
 
-  # expect_error(equivalence_test(model, range = c(.1, .3, .5)))
-  # print(equivalence_test(model, ci = c(.1, .3, .5)))
+  expect_error(equivalence_test(model, range = c(0.1, 0.3, 0.5)))
 })
 
 test_that("rstanarm", {