estimate_density.slopes

easystats · Sep 4, 2024 · 05bd759 · 05bd759
1 parent 2b03ec9
commit 05bd759
Show file tree

Hide file tree

Showing 3 changed files with 46 additions and 0 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -196,6 +196,7 @@ S3method(estimate_density,bcplm)
 S3method(estimate_density,blavaan)
 S3method(estimate_density,blrm)
 S3method(estimate_density,brmsfit)
+S3method(estimate_density,comparisons)
 S3method(estimate_density,data.frame)
 S3method(estimate_density,default)
 S3method(estimate_density,double)
@@ -206,7 +207,9 @@ S3method(estimate_density,grouped_df)
 S3method(estimate_density,mcmc)
 S3method(estimate_density,mcmc.list)
 S3method(estimate_density,numeric)
+S3method(estimate_density,predictions)
 S3method(estimate_density,rvar)
+S3method(estimate_density,slopes)
 S3method(estimate_density,stanfit)
 S3method(estimate_density,stanreg)
 S3method(eti,BFBayesFactor)

diff --git a/R/estimate_density.R b/R/estimate_density.R
@@ -387,6 +387,37 @@ estimate_density.emmGrid <- function(x,
 #' @export
 estimate_density.emm_list <- estimate_density.emmGrid
 
+#' @export
+estimate_density.slopes <- function(x,
+                                    method = "kernel",
+                                    precision = 2^10,
+                                    extend = FALSE,
+                                    extend_scale = 0.1,
+                                    bw = "SJ",
+                                    ...) {
+  xdf <- .get_marginaleffects_draws(x)
+
+  out <- estimate_density(xdf,
+                          method = method, precision = precision,
+                          extend = extend, extend_scale = extend_scale,
+                          bw = bw, ...
+  )
+
+  # This doesn't use .append_datagrid because we get a non-grid output
+  grid <- insight::get_datagrid(x)
+  grid$Parameter <- unique(out$Parameter)
+  out <- datawizard::data_join(grid, out, by = "Parameter")
+  out$Parameter <- NULL
+  class(out) <- .set_density_class(out)
+  out
+}
+
+#' @export
+estimate_density.predictions <- estimate_density.slopes
+
+#' @export
+estimate_density.comparisons <- estimate_density.slopes
+
 
 #' @export
 estimate_density.stanreg <- function(x,

diff --git a/tests/testthat/test-marginaleffects.R b/tests/testthat/test-marginaleffects.R
@@ -22,6 +22,18 @@ test_that("emmGrid descrive_posterior", {
   expect_equal(results[setdiff(colnames(results), c("term", "contrast"))],
                results_draws[setdiff(colnames(results_draws), "Parameter")],
                ignore_attr = TRUE)
+
+  # estimate_density
+  mfx <- marginaleffects::comparisons(mod, variables = "cyl",
+                                      newdata = data.frame(hp = 100, am = 0))
+  samps <- insight::get_parameters(mod)[c("cyl6", "cyl8")]
+
+  res <- estimate_density(mfx)
+  resref <- estimate_density(samps)
+  expect_equal(res[intersect(colnames(res), colnames(resref))],
+               resref[intersect(colnames(res), colnames(resref))],
+               ignore_attr = TRUE)
+
 })
 
 test_that("emmGrid bayesfactors", {