diff --git a/R/bayesfactor_restricted.R b/R/bayesfactor_restricted.R index 77ae4fc7e..f001d0a96 100644 --- 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 index bc8538fae..cdd10778a 100644 --- a/man/bayesfactor_restricted.Rd +++ b/man/bayesfactor_restricted.Rd @@ -59,7 +59,8 @@ bf_restricted(posterior, hypothesis, prior = NULL, verbose = TRUE, ...) \method{as.logical}{bayesfactor_restricted}(x, which = c("posterior", "prior"), ...) } \arguments{ -\item{posterior}{A \code{stanreg} / \code{brmsfit} object, \code{emmGrid} or a data frame - representing a posterior distribution(s) from (see Details).} +\item{posterior}{A \code{stanreg} / \code{brmsfit} object, \code{emmGrid} or a data frame - representing +a posterior distribution(s) from (see Details).} \item{hypothesis}{A character vector specifying the restrictions as logical conditions (see examples below).} @@ -93,7 +94,8 @@ with the fully unrestricted model. \emph{Note that this method should only be us \cr \cr The \verb{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 \href{https://easystats.github.io/bayestestR/articles/bayes_factors.html}{the Bayes factors vignette}.} +\strong{For more info, in particular on specifying correct priors for factors with more than 2 levels, +see \href{https://easystats.github.io/bayestestR/articles/bayes_factors.html}{the Bayes factors vignette}.} } \details{ This method is used to compute Bayes factors for order-restricted models vs un-restricted @@ -228,8 +230,11 @@ bayesfactor_restricted(em_condition, prior = fit_model, hypothesis = hyps) } \references{ \itemize{ -\item Morey, R. D., & Wagenmakers, E. J. (2014). Simple relation between Bayesian order-restricted and point-null hypothesis tests. Statistics & Probability Letters, 92, 121-124. -\item Morey, R. D., & Rouder, J. N. (2011). Bayes factor approaches for testing interval null hypotheses. Psychological methods, 16(4), 406. -\item Morey, R. D. (Jan, 2015). Multiple Comparisons with BayesFactor, Part 2 – order restrictions. Retrieved from https://richarddmorey.org/category/order-restrictions/. +\item Morey, R. D., & Wagenmakers, E. J. (2014). Simple relation between Bayesian order-restricted and +point-null hypothesis tests. Statistics & Probability Letters, 92, 121-124. +\item Morey, R. D., & Rouder, J. N. (2011). Bayes factor approaches for testing interval null hypotheses. +Psychological methods, 16(4), 406. +\item Morey, R. D. (Jan, 2015). Multiple Comparisons with BayesFactor, Part 2 – order restrictions. +Retrieved from https://richarddmorey.org/category/order-restrictions/. } } diff --git a/tests/testthat/test-BFBayesFactor.R b/tests/testthat/test-BFBayesFactor.R index 84af399b4..99b3759a9 100644 --- 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 index 27294b874..4e6256326 100644 --- 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 index 4cc9a57bd..715f1ff72 100644 --- 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 index b848bfee9..d900848d0 100644 --- 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 index 5087aab3e..c52c1da23 100644 --- 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 index c699cebc1..635e7c90f 100644 --- 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 index feec60e4d..aa9df05b2 100644 --- 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 index 72a859443..d97e4e99e 100644 --- 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 index 85dddf436..9faed14d2 100644 --- 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", {