Support {distributional} package

DESCRIPTION

@@ -82,6 +82,7 @@ Suggests:
     bridgesampling,
     brms,
     curl,
+    distributional,
     effectsize,
     emmeans,
     gamm4,

R/p_direction.R

@@ -76,7 +76,7 @@
 #' @section Methods of computation:
 #'
 #' The *pd* is defined as:
 #' \deqn{p_d = max({Pr(\hat{\theta} < \theta_{null}), Pr(\hat{\theta} > \theta_{null})})}{pd = max(mean(x < null), mean(x > null))}
 #'
 #' The most simple and direct way to compute the *pd* is to compute the
 #' proportion of positive (or larger than `null`) posterior samples, the
@@ -98,7 +98,7 @@
 #'
 #' @seealso [pd_to_p()] to convert between Probability of Direction (pd) and p-value.
 #'
 #' @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}.
 #'
 #' @references
 #' - Makowski, D., Ben-Shachar, M. S., Chen, S. A., & Lüdecke, D. (2019).
@@ -108,7 +108,7 @@
 #'   (2021). A cautionary note on estimating effect size. Advances in Methods
 #'   and Practices in Psychological Science, 4(1). \doi{10.1177/2515245921992035}
 #'
 #' @examplesIf requireNamespace("rstanarm", quietly = TRUE) && requireNamespace("emmeans", quietly = TRUE) && requireNamespace("brms", quietly = TRUE) && requireNamespace("BayesFactor", quietly = TRUE)
 #' library(bayestestR)
 #'
 #' # Simulate a posterior distribution of mean 1 and SD 1
@@ -286,6 +286,46 @@
 #' @export
 p_direction.rvar <- p_direction.draws
 
+#' @export
+p_direction.distribution <- function(x,
+                                     null = 0,
+                                     as_p = FALSE,
+                                     remove_na = TRUE,
+                                     ...) {
+  obj_name <- insight::safe_deparse_symbol(substitute(x))
+  x <- .clean_distributional(x)
+  pd <- numeric(length = length(x))
+
+  for (i in seq_along(pd)) {
+    low <- distributional::cdf(x[[i]], q = null)
+    if (.is_discrete_dist(x[[i]])) {
+      high <- 1 - (low + stats::density(x[[i]], at = null))
+    } else {
+      high <- 1 - low
+    }
+    pd[i] <- max(low, high)
+  }
+
+  out <- data.frame(
+    Parameter = names(x),
+    pd = pd,
+    row.names = NULL,
+    stringsAsFactors = FALSE
+  )
+
+  # rename column
+  if (as_p) {
+    out$pd <- pd_to_p(out$pd)
+    colnames(out)[2] <- "p"
+  }
+
+  attr(out, "object_name") <- obj_name
+  attr(out, "as_p") <- as_p
+  class(out) <- unique(c("p_direction", "see_p_direction", class(out)))
+
+  out
+}
+
 
 #' @rdname p_direction
 #' @export
@@ -482,7 +522,7 @@
 #' @export
 p_direction.stanreg <- function(x,
                                 effects = c("fixed", "random", "all"),
                                 component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"),
                                 parameters = NULL,
                                 method = "direct",
                                 null = 0,

R/utils.R

@@ -271,3 +271,19 @@
 
   insight::format_error("The `rvar_col` argument must be a single, valid column name.")
 }
+
+#' @keywords internal
+.clean_distributional <- function (d) {
+  nm <- format(d)
+  attributes(d) <- NULL
+  names(d) <- nm
+  d
+}
+
+#' @keywords internal
+.is_discrete_dist <- function (d) {
+  inherits(d, c("dist_bernoulli", "dist_binomial", "dist_categorical",
+                "dist_geometric", "dist_logarithmic", "dist_multinomial",
+                "dist_negative_binomial", "dist_poisson",
+                "dist_poisson_inverse_gaussian"))
+}