From b2385677154f8c14c0249043d1b51fb5aa8428a5 Mon Sep 17 00:00:00 2001 From: "Mattan S. Ben-Shachar" Date: Thu, 5 Sep 2024 09:58:58 +0300 Subject: [PATCH] map, point_est, eti, docs --- DESCRIPTION | 2 +- NEWS.md | 7 ++++--- R/eti.R | 21 +++++++++++++++++++-- R/map_estimate.R | 16 +++++++++++++++- R/p_direction.R | 11 +++++++++++ R/point_estimate.R | 18 +++++++++++++++++- man/eti.Rd | 6 ++++++ man/map_estimate.Rd | 5 ++++- man/p_direction.Rd | 12 ++++++++++-- man/point_estimate.Rd | 13 +++++++++++++ 10 files changed, 100 insertions(+), 11 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index b5f2b0b5b..732d752a9 100644 --- a/DESCRIPTION +++ b/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", diff --git a/NEWS.md b/NEWS.md index 3eebdf519..db28c58f5 100644 --- a/NEWS.md +++ b/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. diff --git a/R/eti.R b/R/eti.R index 9e2b64935..aa599c568 100644 --- a/R/eti.R +++ b/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 } diff --git a/R/map_estimate.R b/R/map_estimate.R index 68bfafae0..546c069d5 100644 --- a/R/map_estimate.R +++ b/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) } diff --git a/R/p_direction.R b/R/p_direction.R index 8076f65d3..e9a8da467 100644 --- a/R/p_direction.R +++ b/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", diff --git a/R/point_estimate.R b/R/point_estimate.R index 15b305766..fe56e1022 100644 --- a/R/point_estimate.R +++ b/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) { diff --git a/man/eti.Rd b/man/eti.Rd index 18c7c348d..213bd4edb 100644 --- a/man/eti.Rd +++ b/man/eti.Rd @@ -3,6 +3,7 @@ \name{eti} \alias{eti} \alias{eti.numeric} +\alias{eti.data.frame} \alias{eti.stanreg} \alias{eti.brmsfit} \alias{eti.get_predicted} @@ -12,6 +13,8 @@ eti(x, ...) \method{eti}{numeric}(x, ci = 0.95, verbose = TRUE, ...) +\method{eti}{data.frame}(x, ci = 0.95, verbose = TRUE, rvar_col = NULL, ...) + \method{eti}{stanreg}( x, ci = 0.95, @@ -49,6 +52,9 @@ resemble the arguments of the \code{.numeric} or \code{.data.frame}methods.} \item{verbose}{Toggle off warnings.} +\item{rvar_col}{Possibly a single character - the name of an \code{rvar} column in +the data frame, to be processed. See example in \code{\link[=p_direction]{p_direction()}}.} + \item{effects}{Should results for fixed effects, random effects or both be returned? Only applies to mixed models. May be abbreviated.} diff --git a/man/map_estimate.Rd b/man/map_estimate.Rd index 3ffa10290..0f10d9c99 100644 --- a/man/map_estimate.Rd +++ b/man/map_estimate.Rd @@ -34,7 +34,7 @@ map_estimate(x, ...) ... ) -\method{map_estimate}{data.frame}(x, precision = 2^10, method = "kernel", ...) +\method{map_estimate}{data.frame}(x, precision = 2^10, method = "kernel", rvar_col = NULL, ...) \method{map_estimate}{get_predicted}( x, @@ -72,6 +72,9 @@ filtered by default, so only parameters that typically appear in the \code{summary()} are returned. Use \code{parameters} to select specific parameters for the output.} +\item{rvar_col}{Possibly a single character - the name of an \code{rvar} column in +the data frame, to be processed. See example in \code{\link[=p_direction]{p_direction()}}.} + \item{use_iterations}{Logical, if \code{TRUE} and \code{x} is a \code{get_predicted} object, (returned by \code{\link[insight:get_predicted]{insight::get_predicted()}}), the function is applied to the iterations instead of the predictions. This only applies to models that return diff --git a/man/p_direction.Rd b/man/p_direction.Rd index f9a2530e7..6915e237b 100644 --- a/man/p_direction.Rd +++ b/man/p_direction.Rd @@ -127,8 +127,8 @@ frequentist p-value using \code{\link[=pd_to_p]{pd_to_p()}}.} \item{remove_na}{Should missing values be removed before computation? Note that \code{Inf} (infinity) are \emph{not} removed.} -\item{rvar_col}{Name of an \code{rvar}-type column. If \code{NULL}, each column in the -data frame is assumed to represent draws from a posterior distribution.} +\item{rvar_col}{Possibly a single character - the name of an \code{rvar} column in +the data frame, to be processed. See example in \code{\link[=p_direction]{p_direction()}}.} \item{effects}{Should results for fixed effects, random effects or both be returned? Only applies to mixed models. May be abbreviated.} @@ -263,6 +263,7 @@ p_direction(posterior, method = "kernel") df <- data.frame(replicate(4, rnorm(100))) p_direction(df) p_direction(df, method = "kernel") + \donttest{ # rstanarm models # ----------------------------------------------- @@ -290,6 +291,13 @@ p_direction(bf) p_direction(bf, method = "kernel") } \dontshow{\}) # examplesIf} +\dontshow{if (requireNamespace("posterior", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +# 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") +\dontshow{\}) # examplesIf} } \references{ \itemize{ diff --git a/man/point_estimate.Rd b/man/point_estimate.Rd index 210100fb8..dbbd6fd0d 100644 --- a/man/point_estimate.Rd +++ b/man/point_estimate.Rd @@ -3,6 +3,7 @@ \name{point_estimate} \alias{point_estimate} \alias{point_estimate.numeric} +\alias{point_estimate.data.frame} \alias{point_estimate.stanreg} \alias{point_estimate.brmsfit} \alias{point_estimate.BFBayesFactor} @@ -13,6 +14,15 @@ point_estimate(x, ...) \method{point_estimate}{numeric}(x, centrality = "all", dispersion = FALSE, threshold = 0.1, ...) +\method{point_estimate}{data.frame}( + x, + centrality = "all", + dispersion = FALSE, + threshold = 0.1, + rvar_col = NULL, + ... +) + \method{point_estimate}{stanreg}( x, centrality = "all", @@ -67,6 +77,9 @@ Dispersion is not available for \code{"MAP"} or \code{"mode"} centrality indices the fraction (0 to 0.5) of observations to be trimmed from each end of the vector before the mean is computed.} +\item{rvar_col}{Possibly a single character - the name of an \code{rvar} column in +the data frame, to be processed. See example in \code{\link[=p_direction]{p_direction()}}.} + \item{effects}{Should results for fixed effects, random effects or both be returned? Only applies to mixed models. May be abbreviated.}