From 5f03206d4671e0a402ed2e604362d6fecc403fda Mon Sep 17 00:00:00 2001 From: Daniel Date: Tue, 23 Jul 2024 10:04:55 +0200 Subject: [PATCH 1/3] Issues with blavaan Fixes #627 --- R/bayesfactor_models.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/bayesfactor_models.R b/R/bayesfactor_models.R index 1f6ad7079..24568cf96 100644 --- a/R/bayesfactor_models.R +++ b/R/bayesfactor_models.R @@ -483,6 +483,10 @@ as.matrix.bayesfactor_models <- function(x, ...) { bf_method = "method", unsupported_models = FALSE, model_names = NULL) { + # sanity check - are all BF NA? + if (!is.null(res$log_BF) && all(is.na(res$log_BF))) { + insight::format_error("Could not calculate Bayes Factor for these models. You may report this problem at {https://github.com/easystats/bayestestR/issues/}.") # nolint + } attr(res, "denominator") <- denominator attr(res, "BF_method") <- bf_method attr(res, "unsupported_models") <- unsupported_models From f72985db64531e75b3f333911ed720256a71b903 Mon Sep 17 00:00:00 2001 From: Daniel Date: Tue, 23 Jul 2024 10:06:49 +0200 Subject: [PATCH 2/3] add test --- tests/testthat/test-blavaan.R | 11 ++--------- 1 file changed, 2 insertions(+), 9 deletions(-) diff --git a/tests/testthat/test-blavaan.R b/tests/testthat/test-blavaan.R index 2bfc690bf..696c6033f 100644 --- a/tests/testthat/test-blavaan.R +++ b/tests/testthat/test-blavaan.R @@ -75,15 +75,8 @@ test_that("blavaan, all", { ## Bayes factors ---- - ## FIXME: test fails - # expect_warning(bayesfactor_models(bfit, bfit2)) - # x <- suppressWarnings(bayesfactor_models(bfit, bfit2)) - # expect_lt(x$log_BF[2], 0) - - ## FIXME: test fails - # expect_warning(weighted_posteriors(bfit, bfit2)) - # x <- suppressWarnings(weighted_posteriors(bfit, bfit2)) - # expect_identical(ncol(x), 10L) + # For these models, no BF available, see #627 + expect_error(bayesfactor_models(bfit, bfit2), regex = "Could not calculate Bayes") bfit_prior <- unupdate(bfit) capture.output(x <- expect_warning(bayesfactor_parameters(bfit, prior = bfit_prior))) From 137a69b4973f32d4b1b82d4f7a5ddfa3e9f7e0c3 Mon Sep 17 00:00:00 2001 From: Daniel Date: Tue, 23 Jul 2024 11:16:29 +0200 Subject: [PATCH 3/3] lintr --- R/bayesfactor_models.R | 32 +++++++++++++------------------- R/utils.R | 8 ++++---- 2 files changed, 17 insertions(+), 23 deletions(-) diff --git a/R/bayesfactor_models.R b/R/bayesfactor_models.R index 24568cf96..072070024 100644 --- a/R/bayesfactor_models.R +++ b/R/bayesfactor_models.R @@ -196,12 +196,12 @@ bayesfactor_models.default <- function(..., denominator = 1, verbose = TRUE) { supported_models[!has_terms] <- FALSE } - objects <- .safe(do.call(insight::ellipsis_info, c(mods, verbose = FALSE))) - if (!is.null(objects)) { - were_checked <- inherits(objects, "ListModels") + model_objects <- .safe(do.call(insight::ellipsis_info, c(mods, verbose = FALSE))) + if (!is.null(model_objects)) { + were_checked <- inherits(model_objects, "ListModels") # Validate response - if (were_checked && verbose && !isTRUE(attr(objects, "same_response"))) { + if (were_checked && verbose && !isTRUE(attr(model_objects, "same_response"))) { insight::format_warning( "When comparing models, please note that probably not all models were fit from same data." ) @@ -210,7 +210,7 @@ bayesfactor_models.default <- function(..., denominator = 1, verbose = TRUE) { # Get BIC if (were_checked && estimator == "REML" && any(vapply(mods, insight::is_mixed_model, TRUE)) && - !isTRUE(attr(objects, "same_fixef")) && + !isTRUE(attr(model_objects, "same_fixef")) && verbose) { insight::format_warning(paste( "Information criteria (like BIC) based on REML fits (i.e. `estimator=\"REML\"`)", @@ -373,10 +373,10 @@ bayesfactor_models.BFBayesFactor <- function(..., verbose = TRUE) { mBFs <- c(0, BayesFactor::extractBF(models, TRUE, TRUE)) mforms <- sapply(c(models@denominator, models@numerator), function(x) x@shortName) - if (!inherits(models@denominator, "BFlinearModel")) { - mforms <- .clean_non_linBF_mods(mforms) - } else { + if (inherits(models@denominator, "BFlinearModel")) { mforms[mforms == "Intercept only"] <- "1" + } else { + mforms <- .clean_non_linBF_mods(mforms) } res <- data.frame( @@ -446,20 +446,16 @@ as.matrix.bayesfactor_models <- function(x, ...) { .cleanup_BF_models <- function(mods, denominator, cl) { if (length(mods) == 1 && inherits(mods[[1]], "list")) { mods <- mods[[1]] - mod_names <- tryCatch( - { - sapply(cl$`...`[[1]][-1], insight::safe_deparse) - }, - error = function(e) { - NULL - } - ) + mod_names <- .safe(sapply(cl$`...`[[1]][-1], insight::safe_deparse)) + if (!is.null(mod_names) && length(mod_names) == length(mods)) { names(mods) <- mod_names } } - if (!is.numeric(denominator[[1]])) { + if (is.numeric(denominator[[1]])) { + denominator <- denominator[[1]] + } else { denominator_model <- which(names(mods) == names(denominator)) if (length(denominator_model) == 0) { @@ -468,8 +464,6 @@ as.matrix.bayesfactor_models <- function(x, ...) { } else { denominator <- denominator_model } - } else { - denominator <- denominator[[1]] } attr(mods, "denominator") <- denominator diff --git a/R/utils.R b/R/utils.R index de396a834..be2679b4c 100644 --- a/R/utils.R +++ b/R/utils.R @@ -27,12 +27,12 @@ } Value <- c( - "left" = -1, - "right" = 1, + left = -1, + right = 1, "two-sided" = 0, - "twosided" = 0, + twosided = 0, "one-sided" = 1, - "onesided" = 1, + onesided = 1, "<" = -1, ">" = 1, "=" = 0,