From 0c7143490c7e2b8660d9194202b906a457e23c36 Mon Sep 17 00:00:00 2001
From: Daniel <mail@danielluedecke.de>
Date: Tue, 23 Jul 2024 11:17:59 +0200
Subject: [PATCH] Issues with blavaan (#656)

* Issues with blavaan
Fixes #627

* add test

* lintr
---
 R/bayesfactor_models.R        | 36 +++++++++++++++++------------------
 R/utils.R                     |  8 ++++----
 tests/testthat/test-blavaan.R | 11 ++---------
 3 files changed, 23 insertions(+), 32 deletions(-)

diff --git a/R/bayesfactor_models.R b/R/bayesfactor_models.R
index 1f6ad7079..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
@@ -483,6 +477,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
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,
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)))