map, point_est, eti, docs

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",

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/eti.R

@@ -66,9 +66,26 @@ eti.numeric <- function(x, ci = 0.95, verbose = TRUE, ...) {
 
 
 #' @export
-eti.data.frame <- function(x, ci = 0.95, verbose = TRUE, ...) {
+#' @rdname eti
+#' @inheritParams p_direction
+eti.data.frame <- function(x, ci = 0.95, verbose = TRUE, rvar_col = NULL, ...) {
+  obj_name <- insight::safe_deparse_symbol(substitute(x))
+
+  if (length(x_rvar <- .possibly_extract_rvar_col(x, rvar_col)) > 0L) {
+    cl <- match.call()
+    cl[[1]] <- eti
+    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))
+  }
+
+
   dat <- .compute_interval_dataframe(x = x, ci = ci, verbose = verbose, fun = "eti")
-  attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x))
+  attr(dat, "object_name") <- obj_name
   dat
 }
 

R/map_estimate.R

@@ -148,8 +148,22 @@ map_estimate.brmsfit <- function(x, precision = 2^10, method = "kernel", effects
 
 
 #' @rdname map_estimate
+#' @inheritParams p_direction
 #' @export
-map_estimate.data.frame <- function(x, precision = 2^10, method = "kernel", ...) {
+map_estimate.data.frame <- function(x, precision = 2^10, method = "kernel", rvar_col = NULL, ...) {
+  if (length(x_rvar <- .possibly_extract_rvar_col(x, rvar_col)) > 0L) {
+    cl <- match.call()
+    cl[[1]] <- map_estimate
+    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))
+  }
+
   .map_estimate_models(x, precision = precision, method = method)
 }
 

R/p_direction.R

@@ -122,6 +122,7 @@
 #' df <- data.frame(replicate(4, rnorm(100)))
 #' p_direction(df)
 #' p_direction(df, method = "kernel")
+#'
 #' \donttest{
 #' # rstanarm models
 #' # -----------------------------------------------
@@ -148,6 +149,14 @@
 #' p_direction(bf)
 #' p_direction(bf, method = "kernel")
 #' }
+#'
+#' @examplesIf requireNamespace("posterior", quietly = TRUE)
+#' # Using "rvar_col"
+#' x <- data.frame(mu = c(0, 0.5, 1), sigma = c(1, 0.5, 0.25))
+#' x$my_rvar <- posterior::rvar_rng(rnorm, 3, mean = x$mu, sd = x$sigma)
+#' x
+#' p_direction(x, rvar_col = "my_rvar")
+#'
 #' @export
 p_direction <- function(x, ...) {
   UseMethod("p_direction")
@@ -187,6 +196,8 @@ p_direction.numeric <- function(x,
 
 
 #' @rdname p_direction
+#' @param rvar_col Possibly a single character - the name of an `rvar` column in
+#'   the data frame, to be processed. See example in [p_direction()].
 #' @export
 p_direction.data.frame <- function(x,
                                    method = "direct",

R/point_estimate.R

@@ -130,7 +130,23 @@ point_estimate.numeric <- function(x, centrality = "all", dispersion = FALSE, th
 
 
 #' @export
-point_estimate.data.frame <- function(x, centrality = "all", dispersion = FALSE, threshold = 0.1, ...) {
+#' @rdname point_estimate
+#' @inheritParams p_direction
+point_estimate.data.frame <- function(x, centrality = "all", dispersion = FALSE, threshold = 0.1, rvar_col = NULL, ...) {
+  if (length(x_rvar <- .possibly_extract_rvar_col(x, rvar_col)) > 0L) {
+    cl <- match.call()
+    cl[[1]] <- point_estimate
+    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))
+  }
+
+
   x <- .select_nums(x)
 
   if (ncol(x) == 1) {