Merge pull request #673 from easystats/rvar_col

Add support for `rvar` columns in `data.frame`s

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: bayestestR
 Title: Understand and Describe Bayesian Models and Posterior Distributions
-Version: 0.14.0.5
+Version: 0.14.0.6
 Authors@R:
     c(person(given = "Dominique",
              family = "Makowski",
@@ -67,7 +67,7 @@ Depends:
     R (>= 3.6)
 Imports:
     insight (>= 0.20.4.2),
-    datawizard (>= 0.10.0),
+    datawizard (>= 0.12.3.1),
     graphics,
     methods,
     stats,
@@ -127,4 +127,4 @@ Config/testthat/parallel: true
 Config/rcmdcheck/ignore-inconsequential-notes: true
 Config/Needs/website: easystats/easystatstemplate
 Config/Needs/check: stan-dev/cmdstanr
-Remotes: easystats/insight
+Remotes: easystats/insight, easystats/datawizard

NEWS.md

@@ -2,6 +2,10 @@
 
 ## Changes
 
+* Support for `posterior::rvar`-type column in data frames. 
+  For example, a data frame `df` with an `rvar` column `".pred"` can now be 
+  called directly via `p_direction(df, rvar_col = ".pred")`.
+
 * Added support for `{marginaleffects}`
 
 * Results from objects generated by `{emmeans}` (`emmGrid`/`emm_list`) now
@@ -17,9 +21,6 @@
   - `p_direction()` gets a `remove_na` argument, which defaults to `TRUE`, to
     remove `NA` values from the input before calculating the pd-values.
 
-  - The `data.frame` method for `p_direction()` gets an `rvar_col` argument, to
-    specify the column that contains the `rvar` objects.
-
   - Besides the existing `as.numeric()` method, `p_direction()` now also has an
     `as.vector()` method.
 

R/bayesfactor_parameters.R

@@ -85,26 +85,22 @@
 #' (Note that by default, `brms::brm()` uses flat priors for fixed-effects;
 #' See example below.)
 #' \cr\cr
-#' It is important to provide the correct `prior` for meaningful results.
+#' It is important to provide the correct `prior` for meaningful results,
+#' to match the `posterior`-type input:
 #'
-#'   - When `posterior` is a numerical vector, `prior` should also be a numerical vector.
-#'   - When `posterior` is a `data.frame`, `prior` should also be a `data.frame`, with matching column order.
-#'   - When `posterior` is a `stanreg`, `brmsfit` or other supported Bayesian model:
-#'       - `prior` can be set to `NULL`, in which case prior samples are drawn internally.
-#'       - `prior` can also be a model equivalent to `posterior` but with samples from
-#'         the priors *only*. See [unupdate()].
-#'       - **Note:** When `posterior` is a `brmsfit_multiple` model, `prior` **must** be provided.
-#'   - When `posterior` is an output from a `{marginaleffects}` function, `prior` should also be an an output
-#'   from a `{marginaleffects}` function equivalent to `posterior` but created
-#'   with a model of priors samples *only*.
-#'   - When `posterior` is an `emmGrid` / `emm_list` object:
-#'       - `prior` should also be an `emmGrid` / `emm_list` object equivalent to `posterior` but
-#'        created with a model of priors samples *only*. See [unupdate()].
-#'       - `prior` can also be the original (posterior) *model*. If so, the function will try to
-#'        update the `emmGrid` / `emm_list` to use the [unupdate()]d prior-model.
-#'        (*This cannot be done for `brmsfit` models.*)
-#'       - **Note**: When the `emmGrid` has undergone any transformations (`"log"`, `"response"`, etc.),
-#'         or `regrid`ing, then `prior` must be an `emmGrid` object, as stated above.
+#' - **A numeric vector** - `prior` should also be a _numeric vector_, representing the prior-estimate.
+#' - **A data frame** - `prior` should also be a _data frame_, representing the prior-estimates, in matching column order.
+#'   - If `rvar_col` is specified, `prior` should be _the name of an `rvar` column_ that represents the prior-estimates.
+#' - **Supported Bayesian model (`stanreg`, `brmsfit`, etc.)**
+#'   - `prior` should be _a model an equivalent model with MCMC samples from the priors **only**_. See [unupdate()].
+#'   - If `prior` is set to `NULL`, [unupdate()] is called internally (not supported for `brmsfit_multiple` model).
+#' - **Output from a `{marginaleffects}` function** - `prior` should also be _an equivalent output_ from a `{marginaleffects}` function based on a prior-model
+#'  (See [unupdate()]).
+#' - **Output from an `{emmeans}` function**
+#'   - `prior` should also be _an equivalent output_ from an `{emmeans}` function based on a prior-model (See [unupdate()]).
+#'   - `prior` can also be _the original (posterior) model_, in which case the function
+#'      will try to "unupdate" the estimates (not supported if the estimates have undergone
+#'      any transformations -- `"log"`, `"response"`, etc. -- or any `regrid`ing).
 #'
 #' @section Interpreting Bayes Factors:
 #' A Bayes factor greater than 1 can be interpreted as evidence against the
@@ -193,8 +189,8 @@ bayesfactor_parameters <- function(posterior,
                                    prior = NULL,
                                    direction = "two-sided",
                                    null = 0,
-                                   verbose = TRUE,
-                                   ...) {
+                                   ...,
+                                   verbose = TRUE) {
   UseMethod("bayesfactor_parameters")
 }
 
@@ -204,8 +200,8 @@ bayesfactor_pointnull <- function(posterior,
                                   prior = NULL,
                                   direction = "two-sided",
                                   null = 0,
-                                  verbose = TRUE,
-                                  ...) {
+                                  ...,
+                                  verbose = TRUE) {
   if (length(null) > 1L && verbose) {
     insight::format_alert("`null` is a range - computing a ROPE based Bayes factor.")
   }
@@ -226,8 +222,8 @@ bayesfactor_rope <- function(posterior,
                              prior = NULL,
                              direction = "two-sided",
                              null = rope_range(posterior, verbose = FALSE),
-                             verbose = TRUE,
-                             ...) {
+                             ...,
+                             verbose = TRUE) {
   if (length(null) < 2 && verbose) {
     insight::format_alert("'null' is a point - computing a Savage-Dickey (point null) Bayes factor.")
   }
@@ -260,8 +256,8 @@ bayesfactor_parameters.numeric <- function(posterior,
                                            prior = NULL,
                                            direction = "two-sided",
                                            null = 0,
-                                           verbose = TRUE,
-                                           ...) {
+                                           ...,
+                                           verbose = TRUE) {
   # nm <- insight::safe_deparse(substitute(posterior)
 
   if (is.null(prior)) {
@@ -293,11 +289,11 @@ bayesfactor_parameters.stanreg <- function(posterior,
                                            prior = NULL,
                                            direction = "two-sided",
                                            null = 0,
-                                           verbose = TRUE,
                                            effects = c("fixed", "random", "all"),
                                            component = c("conditional", "location", "smooth_terms", "sigma", "zi", "zero_inflated", "all"),
                                            parameters = NULL,
-                                           ...) {
+                                           ...,
+                                           verbose = TRUE) {
   cleaned_parameters <- insight::clean_parameters(posterior)
   effects <- match.arg(effects)
   component <- match.arg(component)
@@ -339,8 +335,8 @@ bayesfactor_parameters.blavaan <- function(posterior,
                                            prior = NULL,
                                            direction = "two-sided",
                                            null = 0,
-                                           verbose = TRUE,
-                                           ...) {
+                                           ...,
+                                           verbose = TRUE) {
   cleaned_parameters <- insight::clean_parameters(posterior)
 
   samps <- .clean_priors_and_posteriors(posterior, prior,
@@ -372,8 +368,8 @@ bayesfactor_parameters.emmGrid <- function(posterior,
                                            prior = NULL,
                                            direction = "two-sided",
                                            null = 0,
-                                           verbose = TRUE,
-                                           ...) {
+                                           ...,
+                                           verbose = TRUE) {
   samps <- .clean_priors_and_posteriors(
     posterior,
     prior,
@@ -406,13 +402,33 @@ bayesfactor_parameters.comparisons <- bayesfactor_parameters.emmGrid
 
 
 #' @rdname bayesfactor_parameters
+#' @inheritParams p_direction
 #' @export
 bayesfactor_parameters.data.frame <- function(posterior,
                                               prior = NULL,
                                               direction = "two-sided",
                                               null = 0,
-                                              verbose = TRUE,
-                                              ...) {
+                                              rvar_col = NULL,
+                                              ...,
+                                              verbose = TRUE) {
+  x_rvar <- .possibly_extract_rvar_col(posterior, rvar_col)
+  if (length(x_rvar) > 0L) {
+    cl <- match.call()
+    cl[[1]] <- bayestestR::bayesfactor_parameters
+    cl$posterior <- x_rvar
+    cl$rvar_col <- NULL
+    prior_rvar <- .possibly_extract_rvar_col(posterior, prior)
+    if (length(prior_rvar) > 0L) {
+      cl$prior <- prior_rvar
+    }
+    out <- eval.parent(cl)
+
+    obj_name <- insight::safe_deparse_symbol(substitute(posterior))
+    attr(out, "object_name") <- sprintf('%s[["%s"]]', obj_name, rvar_col)
+
+    return(.append_datagrid(out, posterior))
+  }
+
   # find direction
   direction <- .get_direction(direction)
 
@@ -469,11 +485,11 @@ bayesfactor_parameters.draws <- function(posterior,
                                          prior = NULL,
                                          direction = "two-sided",
                                          null = 0,
-                                         verbose = TRUE,
-                                         ...) {
+                                         ...,
+                                         verbose = TRUE) {
   bayesfactor_parameters(
     .posterior_draws_to_df(posterior),
-    prior = prior,
+    prior = if (!is.null(prior)) .posterior_draws_to_df(prior),
     direction = direction,
     null = null,
     verbose = verbose,

R/bayesfactor_restricted.R

@@ -117,7 +117,7 @@
 #' Retrieved from https://richarddmorey.org/category/order-restrictions/.
 #'
 #' @export
-bayesfactor_restricted <- function(posterior, hypothesis, prior = NULL, verbose = TRUE, ...) {
+bayesfactor_restricted <- function(posterior, ...) {
   UseMethod("bayesfactor_restricted")
 }
 
@@ -195,7 +195,23 @@ bayesfactor_restricted.predictions <- bayesfactor_restricted.emmGrid
 bayesfactor_restricted.comparisons <- bayesfactor_restricted.emmGrid
 
 #' @export
-bayesfactor_restricted.data.frame <- function(posterior, hypothesis, prior = NULL, ...) {
+#' @rdname bayesfactor_restricted
+#' @inheritParams p_direction
+bayesfactor_restricted.data.frame <- function(posterior, hypothesis, prior = NULL, rvar_col = NULL, ...) {
+  x_rvar <- .possibly_extract_rvar_col(posterior, rvar_col)
+  if (length(x_rvar) > 0L) {
+    cl <- match.call()
+    cl[[1]] <- bayestestR::bayesfactor_restricted
+    cl$posterior <- x_rvar
+    cl$rvar_col <- NULL
+    prior_rvar <- .possibly_extract_rvar_col(posterior, prior)
+    if (length(prior_rvar) > 0L) {
+      cl$prior <- prior_rvar
+    }
+    return(eval.parent(cl))
+  }
+
+
   p_hypothesis <- parse(text = hypothesis)
 
   if (is.null(prior)) {
@@ -251,7 +267,11 @@ bayesfactor_restricted.data.frame <- function(posterior, hypothesis, prior = NUL
 
 #' @export
 bayesfactor_restricted.draws <- function(posterior, hypothesis, prior = NULL, ...) {
-  bayesfactor_restricted(.posterior_draws_to_df(posterior), hypothesis = hypothesis, prior = prior, ...)
+  bayesfactor_restricted(.posterior_draws_to_df(posterior),
+    hypothesis = hypothesis,
+    prior = if (!is.null(prior)) .posterior_draws_to_df(prior),
+    ...
+  )
 }
 
 #' @export

R/bci.R

@@ -42,10 +42,26 @@ bci.numeric <- function(x, ci = 0.95, verbose = TRUE, ...) {
 
 
 #' @rdname bci
+#' @inheritParams p_direction
 #' @export
-bci.data.frame <- function(x, ci = 0.95, verbose = TRUE, ...) {
+bci.data.frame <- function(x, ci = 0.95, rvar_col = NULL, verbose = TRUE, ...) {
+  obj_name <- insight::safe_deparse_symbol(substitute(x))
+
+  x_rvar <- .possibly_extract_rvar_col(x, rvar_col)
+  if (length(x_rvar) > 0L) {
+    cl <- match.call()
+    cl[[1]] <- bayestestR::bci
+    cl$x <- x_rvar
+    cl$rvar_col <- NULL
+    out <- eval.parent(cl)
+
+    attr(out, "object_name") <- sprintf('%s[["%s"]]', obj_name, rvar_col)
+
+    return(.append_datagrid(out, x, long = length(ci) > 1L))
+  }
+
   dat <- .compute_interval_dataframe(x = x, ci = ci, verbose = verbose, fun = "bci")
-  attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x))
+  attr(dat, "object_name") <- obj_name
   dat
 }
 
@@ -168,7 +184,7 @@ bci.sim <- function(x, ci = 0.95, parameters = NULL, verbose = TRUE, ...) {
 bci.emmGrid <- function(x, ci = 0.95, verbose = TRUE, ...) {
   xdf <- insight::get_parameters(x)
   dat <- bci(xdf, ci = ci, verbose = verbose, ...)
-  dat <- .append_datagrid(dat, x)
+  dat <- .append_datagrid(dat, x, long = length(ci) > 1L)
   attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x))
   dat
 }
@@ -181,7 +197,7 @@ bci.emm_list <- bci.emmGrid
 bci.slopes <- function(x, ci = 0.95, verbose = TRUE, ...) {
   xrvar <- .get_marginaleffects_draws(x)
   dat <- bci(xrvar, ci = ci, verbose = verbose, ...)
-  dat <- .append_datagrid(dat, x)
+  dat <- .append_datagrid(dat, x, long = length(ci) > 1L)
   attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x))
   dat
 }

R/ci.R

@@ -157,8 +157,25 @@ ci.numeric <- function(x, ci = 0.95, method = "ETI", verbose = TRUE, BF = 1, ...
 
 
 #' @rdname ci
+#' @inheritParams p_direction
 #' @export
-ci.data.frame <- ci.numeric
+ci.data.frame <- function(x, ci = 0.95, method = "ETI", BF = 1, rvar_col = NULL, verbose = TRUE, ...) {
+  x_rvar <- .possibly_extract_rvar_col(x, rvar_col)
+  if (length(x_rvar) > 0L) {
+    cl <- match.call()
+    cl[[1]] <- bayestestR::ci
+    cl$x <- x_rvar
+    cl$rvar_col <- NULL
+    out <- eval.parent(cl)
+
+    obj_name <- insight::safe_deparse_symbol(substitute(x))
+    attr(out, "object_name") <- sprintf('%s[["%s"]]', obj_name, rvar_col)
+
+    return(.append_datagrid(out, x, long = length(ci) > 1L))
+  }
+
+  .ci_bayesian(x, ci = ci, method = method, verbose = verbose, BF = BF, ...)
+}
 
 
 #' @export
@@ -181,7 +198,7 @@ ci.emmGrid <- function(x, ci = NULL, ...) {
   if (is.null(ci)) ci <- 0.95
   xdf <- insight::get_parameters(x)
   out <- ci(xdf, ci = ci, ...)
-  out <- .append_datagrid(out, x)
+  out <- .append_datagrid(out, x, long = length(ci) > 1L)
   out
 }
 
@@ -200,7 +217,7 @@ ci.slopes <- function(x, ci = NULL, ...) {
   if (is.null(ci)) ci <- 0.95
   xrvar <- .get_marginaleffects_draws(x)
   out <- ci(xrvar, ci = ci, ...)
-  out <- .append_datagrid(out, x)
+  out <- .append_datagrid(out, x, long = length(ci) > 1L)
   out
 }