R/test_bf.R

In performance: Assessment of Regression Models Performance

#' @rdname test_performance
#' @export
test_bf <- function(...) {
  UseMethod("test_bf")
}


#' @rdname test_performance
#' @export
test_bf.default <- function(..., reference = 1, text_length = NULL) {
  # Attribute class to list and get names from the global environment
  my_objects <- insight::ellipsis_info(..., only_models = TRUE)
  names(my_objects) <- match.call(expand.dots = FALSE)[["..."]]

  # validation checks (will throw error if non-valid objects)
  .test_performance_checks(objects = my_objects, multiple = FALSE)

  if (length(my_objects) == 1 && isTRUE(insight::is_model(my_objects))) {
    insight::format_error(
      "`test_bf()` is designed to compare multiple models together. For a single model, you might want to run `bayestestR::bf_parameters()` instead." # nolint
    )
  }

  # If a suitable class is found, run the more specific method on it
  if (inherits(my_objects, c("ListNestedRegressions", "ListNonNestedRegressions", "ListLavaan"))) {
    test_bf(my_objects, reference = reference, text_length = text_length)
  } else {
    insight::format_error("The models cannot be compared for some reason :/")
  }
}



#' @export
test_bf.ListModels <- function(objects, reference = 1, text_length = NULL, ...) {
  if (.test_bf_areAllBayesian(objects) == "mixed") {
    insight::format_error("You cannot mix Bayesian and non-Bayesian models in `test_bf()`.")
  }

  # Adapt reference but keep original input
  if (reference == "sequential") {
    ref <- 1
  } else {
    ref <- reference
  }

  rez <- bayestestR::bayesfactor_models(objects, denominator = ref)

  # check for log-BF
  if (!is.null(rez$log_BF)) {
    rez$BF <- exp(rez$log_BF)
  }

  row.names(rez) <- NULL

  # Adjust BFs for sequential testing
  if (reference == "sequential") {
    # TODO: Double check that formula and whether it works for increasing and
    # decreasing order.

    # For increasing
    rez$BF <- exp(c(NA, diff(log(rez$BF))))

    # For decreasing
    # ref <- nrow(rez)
    # rez$BF <- exp(c(-diff(log(rez$BF)), NA))
  } else {
    rez$BF[ref] <- NA
  }

  # add log-BF
  rez$log_BF <- log(rez$BF)

  # Replace denominator
  attr(rez, "denominator") <- ref
  attr(rez, "text_length") <- text_length
  class(rez) <- c("bayesfactor_models", "see_bayesfactor_models", class(rez))
  rez
}



# Helpers -----------------------------------------------------------------

.test_bf_areAllBayesian <- function(objects) {
  bayesian_models <- sapply(objects, function(i) isTRUE(insight::model_info(i)$is_bayesian))

  if (all(bayesian_models)) {
    "yes"
  } else if (any(bayesian_models)) {
    "mixed"
  } else {
    "no"
  }
}