Rejuvenation

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: bayestestR
 Title: Understand and Describe Bayesian Models and Posterior Distributions
-Version: 0.13.1.3
+Version: 0.13.1.4
 Authors@R:
     c(person(given = "Dominique",
              family = "Makowski",

NAMESPACE

@@ -314,6 +314,7 @@ S3method(p_map,data.frame)
 S3method(p_map,draws)
 S3method(p_map,emmGrid)
 S3method(p_map,emm_list)
+S3method(p_map,get_predicted)
 S3method(p_map,mcmc)
 S3method(p_map,mcmc.list)
 S3method(p_map,numeric)
@@ -357,6 +358,7 @@ S3method(p_significance,default)
 S3method(p_significance,draws)
 S3method(p_significance,emmGrid)
 S3method(p_significance,emm_list)
+S3method(p_significance,get_predicted)
 S3method(p_significance,mcmc)
 S3method(p_significance,mcmc.list)
 S3method(p_significance,numeric)
@@ -469,6 +471,7 @@ S3method(rope,default)
 S3method(rope,draws)
 S3method(rope,emmGrid)
 S3method(rope,emm_list)
+S3method(rope,get_predicted)
 S3method(rope,mcmc)
 S3method(rope,mcmc.list)
 S3method(rope,numeric)

NEWS.md

@@ -2,11 +2,15 @@
 
 ## Breaking Changes
 
-* `pd_to_p()` now returns 1 and a warning for pds smaller than 0.5.
+* `pd_to_p()` now returns 1 and a warning for values smaller than 0.5.
+
 * `map_estimate()`, `p_direction()`, `p_map()`, and `p_significance()` now 
   return a data-frame when the input is a numeric vector. (making the output 
   consistently a data frame for all inputs.)
 
+* Argument `posteriors` was renamed into `posterior`. Before, there were a mix
+  of both spellings, now it is consistently `posterior`.
+
 ## Changes
 
 * Retrieving models from the environment was improved.
@@ -19,6 +23,8 @@
 * Fixed issue in `estimate_density()` for double vectors that also had other
   class attributes.
 
+* Fixed several minor issues and tests.
+
 # bayestestR 0.13.1
 
 ## Changes

R/area_under_curve.R

@@ -31,7 +31,7 @@
 #' @seealso DescTools
 #' @export
 area_under_curve <- function(x, y, method = c("trapezoid", "step", "spline"), ...) {
-  # Stolen from DescTools: https://github.com/cran/DescTools/blob/master/R/StatsAndCIs.r
+  # From DescTools [GPL-3]: https://github.com/cran/DescTools/blob/master/R/StatsAndCIs.r
 
   if (length(x) != length(y)) {
     insight::format_error("Length of x must be equal to length of y.")
@@ -42,9 +42,9 @@
   y <- y[idx]
 
   switch(match.arg(arg = method, choices = c("trapezoid", "step", "spline")),
     "trapezoid" = sum((rowMeans(cbind(y[-length(y)], y[-1]))) * (x[-1] - x[-length(x)])),
     "step" = sum(y[-length(y)] * (x[-1] - x[-length(x)])),
     "spline" = stats::integrate(stats::splinefun(x, y, method = "natural"), lower = min(x), upper = max(x))$value
   )
 }
 

R/bayesfactor.R

@@ -21,35 +21,30 @@
 #'
 #' @note There is also a [`plot()`-method](https://easystats.github.io/see/articles/bayestestR.html) implemented in the \href{https://easystats.github.io/see/}{\pkg{see}-package}.
 #'
-#' @examples
+#' @examplesIf require("rstanarm") && require("logspline")
 #' library(bayestestR)
 #'
-#' if (require("logspline")) {
-#'   prior <- distribution_normal(1000, mean = 0, sd = 1)
-#'   posterior <- distribution_normal(1000, mean = .5, sd = .3)
+#' prior <- distribution_normal(1000, mean = 0, sd = 1)
+#' posterior <- distribution_normal(1000, mean = .5, sd = .3)
+#'
+#' bayesfactor(posterior, prior = prior, verbose = FALSE)
 #'
-#'   bayesfactor(posterior, prior = prior, verbose = FALSE)
-#' }
 #' \donttest{
 #' # rstanarm models
 #' # ---------------
-#' if (require("rstanarm")) {
-#'   model <- stan_lmer(extra ~ group + (1 | ID), data = sleep)
-#'   bayesfactor(model, verbose = FALSE)
-#' }
-#' }
+#' model <- suppressWarnings(rstanarm::stan_lmer(extra ~ group + (1 | ID), data = sleep))
+#' bayesfactor(model, verbose = FALSE)
 #'
-#' if (require("logspline")) {
-#'   # Frequentist models
-#'   # ---------------
-#'   m0 <- lm(extra ~ 1, data = sleep)
-#'   m1 <- lm(extra ~ group, data = sleep)
-#'   m2 <- lm(extra ~ group + ID, data = sleep)
+#' # Frequentist models
+#' # ---------------
+#' m0 <- lm(extra ~ 1, data = sleep)
+#' m1 <- lm(extra ~ group, data = sleep)
+#' m2 <- lm(extra ~ group + ID, data = sleep)
 #'
-#'   comparison <- bayesfactor(m0, m1, m2)
-#'   comparison
+#' comparison <- bayesfactor(m0, m1, m2)
+#' comparison
 #'
-#'   bayesfactor(comparison)
+#' bayesfactor(comparison)
 #' }
 #' @export
 bayesfactor <- function(...,
@@ -75,13 +70,7 @@ bayesfactor <- function(...,
     } else {
       bayesfactor_models(...)
     }
-  } else if (!is.null(hypothesis)) {
-    bayesfactor_restricted(...,
-      prior = prior,
-      verbose = verbose,
-      effects = effects
-    )
-  } else {
+  } else if (is.null(hypothesis)) {
     bayesfactor_parameters(
       ...,
       prior = prior,
@@ -90,5 +79,11 @@ bayesfactor <- function(...,
       effects = effects,
       verbose = verbose
     )
+  } else {
+    bayesfactor_restricted(...,
+      prior = prior,
+      verbose = verbose,
+      effects = effects
+    )
   }
 }

R/bayesfactor_inclusion.R

@@ -37,7 +37,7 @@
 #'
 #' @seealso [weighted_posteriors()] for Bayesian parameter averaging.
 #'
-#' @examples
+#' @examplesIf require("BayesFactor")
 #' library(bayestestR)
 #'
 #' # Using bayesfactor_models:
@@ -55,10 +55,7 @@
 #' \donttest{
 #' # BayesFactor
 #' # -------------------------------
-#' library(BayesFactor)
-#'
-#' BF <- generalTestBF(len ~ supp * dose, ToothGrowth, progress = FALSE)
-#'
+#' BF <- BayesFactor::generalTestBF(len ~ supp * dose, ToothGrowth, progress = FALSE)
 #' bayesfactor_inclusion(BF)
 #'
 #' # compare only matched models:
@@ -110,7 +107,7 @@
     df.interaction <- data.frame(effnames, stringsAsFactors = FALSE)
 
     for (eff in effnames) {
       df.interaction[, eff] <- sapply(effnames, .includes_interaction, effnames = eff)
     }
     rownames(df.interaction) <- effnames
     df.interaction <- as.matrix(df.interaction[, -1])

R/bayesfactor_models.R

@@ -55,7 +55,7 @@
 #'   random effects) and their `log(BF)`s  (Use `as.numeric()` to extract the
 #'   non-log Bayes factors; see examples), that prints nicely.
 #'
-#' @examples
+#' @examplesIf require("lme4") && require("BayesFactor") && require("rstanarm") && require("brms")
 #' # With lm objects:
 #' # ----------------
 #' lm1 <- lm(mpg ~ 1, data = mtcars)
@@ -66,81 +66,72 @@
 #' # bayesfactor_models(lm2, lm3, lm4, denominator = lm1) # same result
 #' # bayesfactor_models(lm1, lm2, lm3, lm4, denominator = lm1) # same result
 #'
-#'
 #' update(BFM, reference = "bottom")
 #' as.matrix(BFM)
 #' as.numeric(BFM)
 #'
-#'
 #' lm2b <- lm(sqrt(mpg) ~ hp, data = mtcars)
 #' # Set check_response = TRUE for transformed responses
 #' bayesfactor_models(lm2b, denominator = lm2, check_response = TRUE)
 #'
 #' \donttest{
 #' # With lmerMod objects:
 #' # ---------------------
-#' if (require("lme4")) {
-#'   lmer1 <- lmer(Sepal.Length ~ Petal.Length + (1 | Species), data = iris)
-#'   lmer2 <- lmer(Sepal.Length ~ Petal.Length + (Petal.Length | Species), data = iris)
-#'   lmer3 <- lmer(Sepal.Length ~ Petal.Length + (Petal.Length | Species) + (1 | Petal.Width),
-#'     data = iris
-#'   )
-#'   bayesfactor_models(lmer1, lmer2, lmer3,
-#'     denominator = 1,
-#'     estimator = "REML"
-#'   )
-#' }
+#' lmer1 <- lme4::lmer(Sepal.Length ~ Petal.Length + (1 | Species), data = iris)
+#' lmer2 <- lme4::lmer(Sepal.Length ~ Petal.Length + (Petal.Length | Species), data = iris)
+#' lmer3 <- lme4::lmer(
+#'   Sepal.Length ~ Petal.Length + (Petal.Length | Species) + (1 | Petal.Width),
+#'   data = iris
+#' )
+#' bayesfactor_models(lmer1, lmer2, lmer3,
+#'   denominator = 1,
+#'   estimator = "REML"
+#' )
 #'
 #' # rstanarm models
 #' # ---------------------
 #' # (note that a unique diagnostic_file MUST be specified in order to work)
-#' if (require("rstanarm")) {
-#'   stan_m0 <- stan_glm(Sepal.Length ~ 1,
-#'     data = iris,
-#'     family = gaussian(),
-#'     diagnostic_file = file.path(tempdir(), "df0.csv")
-#'   )
-#'   stan_m1 <- stan_glm(Sepal.Length ~ Species,
-#'     data = iris,
-#'     family = gaussian(),
-#'     diagnostic_file = file.path(tempdir(), "df1.csv")
-#'   )
-#'   stan_m2 <- stan_glm(Sepal.Length ~ Species + Petal.Length,
-#'     data = iris,
-#'     family = gaussian(),
-#'     diagnostic_file = file.path(tempdir(), "df2.csv")
-#'   )
-#'   bayesfactor_models(stan_m1, stan_m2, denominator = stan_m0, verbose = FALSE)
-#' }
+#' stan_m0 <- suppressWarnings(rstanarm::stan_glm(Sepal.Length ~ 1,
+#'   data = iris,
+#'   family = gaussian(),
+#'   diagnostic_file = file.path(tempdir(), "df0.csv")
+#' ))
+#' stan_m1 <- suppressWarnings(rstanarm::stan_glm(Sepal.Length ~ Species,
+#'   data = iris,
+#'   family = gaussian(),
+#'   diagnostic_file = file.path(tempdir(), "df1.csv")
+#' ))
+#' stan_m2 <- suppressWarnings(rstanarm::stan_glm(Sepal.Length ~ Species + Petal.Length,
+#'   data = iris,
+#'   family = gaussian(),
+#'   diagnostic_file = file.path(tempdir(), "df2.csv")
+#' ))
+#' bayesfactor_models(stan_m1, stan_m2, denominator = stan_m0, verbose = FALSE)
 #'
 #'
 #' # brms models
 #' # --------------------
 #' # (note the save_pars MUST be set to save_pars(all = TRUE) in order to work)
-#' if (require("brms")) {
-#'   brm1 <- brm(Sepal.Length ~ 1, data = iris, save_pars = save_pars(all = TRUE))
-#'   brm2 <- brm(Sepal.Length ~ Species, data = iris, save_pars = save_pars(all = TRUE))
-#'   brm3 <- brm(
-#'     Sepal.Length ~ Species + Petal.Length,
-#'     data = iris,
-#'     save_pars = save_pars(all = TRUE)
-#'   )
+#' brm1 <- brms::brm(Sepal.Length ~ 1, data = iris, save_pars = save_pars(all = TRUE))
+#' brm2 <- brms::brm(Sepal.Length ~ Species, data = iris, save_pars = save_pars(all = TRUE))
+#' brm3 <- brms::brm(
+#'   Sepal.Length ~ Species + Petal.Length,
+#'   data = iris,
+#'   save_pars = save_pars(all = TRUE)
+#' )
 #'
-#'   bayesfactor_models(brm1, brm2, brm3, denominator = 1, verbose = FALSE)
-#' }
+#' bayesfactor_models(brm1, brm2, brm3, denominator = 1, verbose = FALSE)
 #'
 #'
 #' # BayesFactor
 #' # ---------------------------
-#' if (require("BayesFactor")) {
-#'   data(puzzles)
-#'   BF <- anovaBF(RT ~ shape * color + ID,
-#'     data = puzzles,
-#'     whichRandom = "ID", progress = FALSE
-#'   )
-#'   BF
-#'   bayesfactor_models(BF) # basically the same
-#' }
+#' data(puzzles)
+#' BF <- BayesFactor::anovaBF(RT ~ shape * color + ID,
+#'   data = puzzles,
+#'   whichRandom = "ID", progress = FALSE
+#' )
+#' BF
+#' bayesfactor_models(BF) # basically the same
 #' }
 #'
 #' @references
@@ -169,6 +160,7 @@
 #' @export
 bf_models <- bayesfactor_models
 
+
 #' @export
 #' @rdname bayesfactor_models
 bayesfactor_models.default <- function(..., denominator = 1, verbose = TRUE) {
@@ -185,7 +177,7 @@
   cl$...$estimator <- cl$...$check_response <- NULL
 
 
   names(mods) <- sapply(cl$`...`, insight::safe_deparse)
   names(denominator) <- insight::safe_deparse(cl$denominator)
 
   mods <- .cleanup_BF_models(mods, denominator, cl)
@@ -196,9 +188,9 @@
   # supported models
   supported_models <- vapply(mods, insight::is_model_supported, TRUE)
   if (all(supported_models)) {
     temp_forms <- sapply(mods, .find_full_formula)
 
     has_terms <- sapply(temp_forms, nchar) > 0
 
     mforms[has_terms] <- temp_forms[has_terms]
     supported_models[!has_terms] <- FALSE
@@ -217,7 +209,7 @@
 
     # Get BIC
     if (were_checked && estimator == "REML" &&
       any(vapply(mods, insight::is_mixed_model, TRUE)) &&
       !isTRUE(attr(objects, "same_fixef")) &&
       verbose) {
       insight::format_warning(paste(
@@ -230,7 +222,7 @@
     insight::format_alert("Unable to validate that all models were fit with the same data.")
   }
 
   mBIC <- tryCatch(sapply(mods, function(m) {
     LL <- insight::get_loglikelihood(
       m,
       estimator = estimator, check_response = check_response
@@ -238,7 +230,7 @@
     stats::BIC(LL)
   }), error = function(...) NULL)
 
   if (is.null(mBIC)) mBIC <- sapply(mods, stats::BIC)
 
   # Get BF
   mBFs <- bic_to_bf(mBIC, denominator = mBIC[denominator], log = TRUE)
@@ -289,6 +281,7 @@
   )
 }
 
+
 #' @keywords internal
 .bayesfactor_models_stan_REG <- function(mods, denominator, verbose = TRUE) {
   insight::check_if_installed("bridgesampling")
@@ -356,6 +349,7 @@
   .bayesfactor_models_stan(mods, denominator = denominator, verbose = verbose)
 }
 
+
 #' @export
 bayesfactor_models.brmsfit <- function(..., denominator = 1, verbose = TRUE) {
   insight::check_if_installed("brms")
@@ -374,6 +368,7 @@
   .bayesfactor_models_stan(mods, denominator = denominator, verbose = verbose)
 }
 
+
 #' @export
 bayesfactor_models.blavaan <- function(..., denominator = 1, verbose = TRUE) {
   insight::check_if_installed("blavaan")
@@ -392,6 +387,7 @@
   .bayesfactor_models_stan(mods, denominator = denominator, verbose = verbose)
 }
 
+
 #' @export
 bayesfactor_models.BFBayesFactor <- function(..., verbose = TRUE) {
   models <- c(...)

R/bci.R

@@ -257,14 +257,19 @@ bci.BFBayesFactor <- function(x, ci = 0.95, verbose = TRUE, ...) {
 }
 
 
+#' @rdname bci
 #' @export
-bci.get_predicted <- function(x, ...) {
-  if ("iterations" %in% names(attributes(x))) {
-    out <- bci(as.data.frame(t(attributes(x)$iterations)), ...)
+bci.get_predicted <- function(x, ci = 0.95, use_iterations = FALSE, verbose = TRUE, ...) {
+  if (isTRUE(use_iterations)) {
+    if ("iterations" %in% names(attributes(x))) {
+      out <- bci(as.data.frame(t(attributes(x)$iterations)), ci = ci, verbose = verbose, ...)
+    } else {
+      insight::format_error("No iterations present in the output.")
+    }
+    attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
   } else {
-    insight::format_error("No iterations present in the output.")
+    out <- bci(as.numeric(x), ci = ci, verbose = verbose, ...)
   }
-  attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
   out
 }