From f0bf59428302fe1a88ac13987e4791e4a3367595 Mon Sep 17 00:00:00 2001 From: "Mattan S. Ben-Shachar" Date: Tue, 3 Sep 2024 12:37:43 +0300 Subject: [PATCH 01/15] initial change --- DESCRIPTION | 4 ++-- NEWS.md | 3 +++ R/bayesfactor_parameters.R | 3 ++- R/bayesfactor_restricted.R | 3 ++- R/bci.R | 2 +- R/ci.R | 6 ++++-- R/describe_posterior.R | 4 +--- R/equivalence_test.R | 2 +- R/estimate_density.R | 6 ++++-- R/eti.R | 2 +- R/hdi.R | 1 + R/map_estimate.R | 5 +++-- R/p_direction.R | 2 +- R/p_map.R | 2 +- R/p_rope.R | 2 +- R/p_significance.R | 2 +- R/point_estimate.R | 2 +- R/rope.R | 2 +- R/si.R | 1 + R/spi.R | 1 + R/utils.R | 14 ++++++++++++++ 21 files changed, 47 insertions(+), 22 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index b2a148ab0..c71e4efd7 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.4 +Version: 0.14.0.5 Authors@R: c(person(given = "Dominique", family = "Makowski", @@ -66,7 +66,7 @@ Description: Provides utilities to describe posterior Depends: R (>= 3.6) Imports: - insight (>= 0.20.1), + insight (>= 0.20.4.1), datawizard (>= 0.10.0), graphics, methods, diff --git a/NEWS.md b/NEWS.md index d6e5dc464..a4c5628a0 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,9 @@ ## Changes +* Results from objects generated by `{emmeans}` (`emmGrid`/`emm_list`) now + return results with appended grid-data. + * Usability improvements for `p_direction()`: - Results from `p_direction()` can directly be used in `pd_to_p()`. diff --git a/R/bayesfactor_parameters.R b/R/bayesfactor_parameters.R index 6e1b2e832..551b2816a 100644 --- a/R/bayesfactor_parameters.R +++ b/R/bayesfactor_parameters.R @@ -378,7 +378,7 @@ bayesfactor_parameters.emmGrid <- function(posterior, ) # Get BFs - bayesfactor_parameters.data.frame( + out <- bayesfactor_parameters.data.frame( posterior = samps$posterior, prior = samps$prior, direction = direction, @@ -386,6 +386,7 @@ bayesfactor_parameters.emmGrid <- function(posterior, verbose = verbose, ... ) + .append_datagrid(out, posterior) } #' @export diff --git a/R/bayesfactor_restricted.R b/R/bayesfactor_restricted.R index 4e8cef5f2..695727b54 100644 --- a/R/bayesfactor_restricted.R +++ b/R/bayesfactor_restricted.R @@ -176,10 +176,11 @@ bayesfactor_restricted.emmGrid <- function(posterior, hypothesis, prior = NULL, verbose = verbose ) - bayesfactor_restricted.data.frame( + out <- bayesfactor_restricted.data.frame( posterior = samps$posterior, prior = samps$prior, hypothesis = hypothesis ) + .append_datagrid(out, posterior) } #' @export diff --git a/R/bci.R b/R/bci.R index 51f5c2b28..5f8f99c24 100644 --- a/R/bci.R +++ b/R/bci.R @@ -167,8 +167,8 @@ bci.sim <- function(x, ci = 0.95, parameters = NULL, verbose = TRUE, ...) { #' @export 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) attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x)) dat } diff --git a/R/ci.R b/R/ci.R index cdc5d9eb9..5d4641612 100644 --- a/R/ci.R +++ b/R/ci.R @@ -179,8 +179,10 @@ ci.emmGrid <- function(x, ci = NULL, ...) { } if (is.null(ci)) ci <- 0.95 - x <- insight::get_parameters(x) - ci(x, ci = ci, ...) + xdf <- insight::get_parameters(x) + out <- ci(xdf, ci = ci, ...) + out <- .append_datagrid(out, x) + out } diff --git a/R/describe_posterior.R b/R/describe_posterior.R index 3e8d82209..ce2efa5aa 100644 --- a/R/describe_posterior.R +++ b/R/describe_posterior.R @@ -794,7 +794,6 @@ describe_posterior.emmGrid <- function(posterior, posterior_samples <- insight::get_parameters(posterior) } - out <- .describe_posterior( posterior_samples, centrality = centrality, @@ -812,11 +811,10 @@ describe_posterior.emmGrid <- function(posterior, ) row.names(out) <- NULL # Reset row names - + out <- .append_datagrid(out, posterior) class(out) <- c("describe_posterior", "see_describe_posterior", class(out)) attr(out, "ci_method") <- ci_method attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(posterior)) - out } diff --git a/R/equivalence_test.R b/R/equivalence_test.R index 99c19e433..d99a9eb2c 100644 --- a/R/equivalence_test.R +++ b/R/equivalence_test.R @@ -182,8 +182,8 @@ equivalence_test.rvar <- equivalence_test.draws #' @export equivalence_test.emmGrid <- function(x, range = "default", ci = 0.95, verbose = TRUE, ...) { xdf <- insight::get_parameters(x) - out <- equivalence_test(xdf, range = range, ci = ci, verbose = verbose, ...) + out <- .append_datagrid(out, x) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } diff --git a/R/estimate_density.R b/R/estimate_density.R index 2074c4efc..a8ac37a53 100644 --- a/R/estimate_density.R +++ b/R/estimate_density.R @@ -367,13 +367,15 @@ estimate_density.emmGrid <- function(x, extend_scale = 0.1, bw = "SJ", ...) { - x <- insight::get_parameters(x) + xdf <- insight::get_parameters(x) - out <- estimate_density(x, + out <- estimate_density(xdf, method = method, precision = precision, extend = extend, extend_scale = extend_scale, bw = bw, ... ) + + out <- .append_datagrid(out, x) class(out) <- .set_density_class(out) out } diff --git a/R/eti.R b/R/eti.R index 73f22c6e8..91282c47b 100644 --- a/R/eti.R +++ b/R/eti.R @@ -174,8 +174,8 @@ eti.sim <- function(x, ci = 0.95, parameters = NULL, verbose = TRUE, ...) { #' @export eti.emmGrid <- function(x, ci = 0.95, verbose = TRUE, ...) { xdf <- insight::get_parameters(x) - dat <- eti(xdf, ci = ci, verbose = verbose, ...) + dat <- .append_datagrid(dat, x) attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x)) dat } diff --git a/R/hdi.R b/R/hdi.R index 01dc5bc0b..b8903d1c6 100644 --- a/R/hdi.R +++ b/R/hdi.R @@ -264,6 +264,7 @@ hdi.sim <- function(x, ci = 0.95, parameters = NULL, verbose = TRUE, ...) { hdi.emmGrid <- function(x, ci = 0.95, verbose = TRUE, ...) { xdf <- insight::get_parameters(x) out <- hdi(xdf, ci = ci, verbose = verbose, ...) + out <- .append_datagrid(out, x) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } diff --git a/R/map_estimate.R b/R/map_estimate.R index 2f80c463c..a2814f3ff 100644 --- a/R/map_estimate.R +++ b/R/map_estimate.R @@ -165,8 +165,9 @@ map_estimate.rvar <- map_estimate.draws #' @export map_estimate.emmGrid <- function(x, precision = 2^10, method = "kernel", ...) { - x <- insight::get_parameters(x) - .map_estimate_models(x, precision = precision, method = method) + xdf <- insight::get_parameters(x) + out <- .map_estimate_models(x, precision = precision, method = method) + .append_datagrid(out, x) } #' @export diff --git a/R/p_direction.R b/R/p_direction.R index ecfce52c1..1da0ddd93 100644 --- a/R/p_direction.R +++ b/R/p_direction.R @@ -389,8 +389,8 @@ p_direction.bamlss <- function(x, #' @export p_direction.emmGrid <- function(x, method = "direct", null = 0, as_p = FALSE, remove_na = TRUE, ...) { xdf <- insight::get_parameters(x) - out <- p_direction(xdf, method = method, null = null, as_p = as_p, remove_na = remove_na, ...) + out <- .append_datagrid(out, x) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } diff --git a/R/p_map.R b/R/p_map.R index 3e1cd3ef8..2e5592402 100644 --- a/R/p_map.R +++ b/R/p_map.R @@ -158,8 +158,8 @@ p_map.rvar <- p_map.draws #' @export p_map.emmGrid <- function(x, null = 0, precision = 2^10, method = "kernel", ...) { xdf <- insight::get_parameters(x) - out <- p_map(xdf, null = null, precision = precision, method = method, ...) + out <- .append_datagrid(out, x) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } diff --git a/R/p_rope.R b/R/p_rope.R index e88f656b6..3d4f590a6 100644 --- a/R/p_rope.R +++ b/R/p_rope.R @@ -53,8 +53,8 @@ p_rope.rvar <- p_rope.draws #' @export p_rope.emmGrid <- function(x, range = "default", verbose = TRUE, ...) { xdf <- insight::get_parameters(x) - out <- p_rope(xdf, range = range, verbose = verbose) + out <- .append_datagrid(out, x) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } diff --git a/R/p_significance.R b/R/p_significance.R index 715684c17..8e6b56ff7 100644 --- a/R/p_significance.R +++ b/R/p_significance.R @@ -213,8 +213,8 @@ p_significance.BGGM <- p_significance.bcplm #' @export p_significance.emmGrid <- function(x, threshold = "default", ...) { xdf <- insight::get_parameters(x) - out <- p_significance(xdf, threshold = threshold, ...) + out <- .append_datagrid(out, x) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } diff --git a/R/point_estimate.R b/R/point_estimate.R index d725749f3..788dfe086 100644 --- a/R/point_estimate.R +++ b/R/point_estimate.R @@ -220,8 +220,8 @@ point_estimate.MCMCglmm <- function(x, centrality = "all", dispersion = FALSE, . #' @export point_estimate.emmGrid <- function(x, centrality = "all", dispersion = FALSE, ...) { xdf <- insight::get_parameters(x) - out <- point_estimate(xdf, centrality = centrality, dispersion = dispersion, ...) + out <- .append_datagrid(out, x) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } diff --git a/R/rope.R b/R/rope.R index b16db40d5..066b01136 100644 --- a/R/rope.R +++ b/R/rope.R @@ -244,8 +244,8 @@ rope.rvar <- rope.draws #' @export rope.emmGrid <- function(x, range = "default", ci = 0.95, ci_method = "ETI", verbose = TRUE, ...) { xdf <- insight::get_parameters(x) - dat <- rope(xdf, range = range, ci = ci, ci_method = ci_method, verbose = verbose, ...) + out <- .append_datagrid(out, x) attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x)) dat } diff --git a/R/si.R b/R/si.R index 62ae04a2f..b489a957e 100644 --- a/R/si.R +++ b/R/si.R @@ -168,6 +168,7 @@ si.emmGrid <- function(posterior, prior = NULL, BF = BF, verbose = verbose, ... ) + out <- .append_datagrid(out, posterior) attr(out, "ci_method") <- "SI" attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(posterior)) out diff --git a/R/spi.R b/R/spi.R index 772ac6ba3..b50f20d34 100644 --- a/R/spi.R +++ b/R/spi.R @@ -130,6 +130,7 @@ spi.sim <- function(x, ci = 0.95, parameters = NULL, verbose = TRUE, ...) { spi.emmGrid <- function(x, ci = 0.95, verbose = TRUE, ...) { xdf <- insight::get_parameters(x) out <- spi(xdf, ci = ci, verbose = verbose, ...) + out <- .append_datagrid(out, x) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } diff --git a/R/utils.R b/R/utils.R index be2679b4c..a3f98ea64 100644 --- a/R/utils.R +++ b/R/utils.R @@ -154,3 +154,17 @@ attr(params, "clean_parameters") <- cp params } + +#' @keywords internal +.append_datagrid <- function(results, object) { + # results is assumed to be a data frame with "Parameter" column + # object is an emmeans that results is based on + + grid <- insight::get_datagrid(object) + grid_names <- colnames(grid) + + results[colnames(grid)] <- grid + results$Parameter <- NULL + results[, c(grid_names, setdiff(colnames(results), grid_names)), drop = FALSE] +} + From 55492c6fa8f7b693a810c7ebda7a04b782779076 Mon Sep 17 00:00:00 2001 From: "Mattan S. Ben-Shachar" Date: Tue, 3 Sep 2024 12:43:48 +0300 Subject: [PATCH 02/15] minor fixes --- R/map_estimate.R | 2 +- R/rope.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/map_estimate.R b/R/map_estimate.R index a2814f3ff..8b88b00dd 100644 --- a/R/map_estimate.R +++ b/R/map_estimate.R @@ -166,7 +166,7 @@ map_estimate.rvar <- map_estimate.draws #' @export map_estimate.emmGrid <- function(x, precision = 2^10, method = "kernel", ...) { xdf <- insight::get_parameters(x) - out <- .map_estimate_models(x, precision = precision, method = method) + out <- .map_estimate_models(xdf, precision = precision, method = method) .append_datagrid(out, x) } diff --git a/R/rope.R b/R/rope.R index 066b01136..92c052c02 100644 --- a/R/rope.R +++ b/R/rope.R @@ -245,7 +245,7 @@ rope.rvar <- rope.draws rope.emmGrid <- function(x, range = "default", ci = 0.95, ci_method = "ETI", verbose = TRUE, ...) { xdf <- insight::get_parameters(x) dat <- rope(xdf, range = range, ci = ci, ci_method = ci_method, verbose = verbose, ...) - out <- .append_datagrid(out, x) + dat <- .append_datagrid(dat, x) attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x)) dat } From 6c46a0ed23cf4c4db8f43901a9557fc9b1644986 Mon Sep 17 00:00:00 2001 From: "Mattan S. Ben-Shachar" Date: Tue, 3 Sep 2024 13:04:40 +0300 Subject: [PATCH 03/15] fix missing attributes --- R/utils.R | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/R/utils.R b/R/utils.R index a3f98ea64..6016fa5f7 100644 --- a/R/utils.R +++ b/R/utils.R @@ -160,11 +160,20 @@ # results is assumed to be a data frame with "Parameter" column # object is an emmeans that results is based on + all_attrs <- attributes(results) # save attributes for later + grid <- insight::get_datagrid(object) grid_names <- colnames(grid) results[colnames(grid)] <- grid results$Parameter <- NULL - results[, c(grid_names, setdiff(colnames(results), grid_names)), drop = FALSE] + results <- results[, c(grid_names, setdiff(colnames(results), grid_names)), drop = FALSE] + + # add back attributes + most_attrs <- all_attrs[setdiff(names(all_attrs), names(attributes(grid)))] + attributes(results)[names(most_attrs)] <- most_attrs + + attr(results, "grid_cols") <- grid_names + results } From 57be2205a1dcfa9b64e7f0a25dabc63d1f545bc9 Mon Sep 17 00:00:00 2001 From: "Mattan S. Ben-Shachar" Date: Tue, 3 Sep 2024 13:04:42 +0300 Subject: [PATCH 04/15] Update estimate_density.R --- R/estimate_density.R | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/R/estimate_density.R b/R/estimate_density.R index a8ac37a53..f33538c19 100644 --- a/R/estimate_density.R +++ b/R/estimate_density.R @@ -375,7 +375,11 @@ estimate_density.emmGrid <- function(x, bw = bw, ... ) - out <- .append_datagrid(out, x) + # 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 } From b28a7f3fcaafd64131598694823d6fc69a5103e1 Mon Sep 17 00:00:00 2001 From: "Mattan S. Ben-Shachar" Date: Tue, 3 Sep 2024 13:17:03 +0300 Subject: [PATCH 05/15] fix printing --- R/bayesfactor_restricted.R | 3 +-- R/format.R | 3 ++- R/print.equivalence_test.R | 3 ++- R/print.rope.R | 2 +- 4 files changed, 6 insertions(+), 5 deletions(-) diff --git a/R/bayesfactor_restricted.R b/R/bayesfactor_restricted.R index 695727b54..4e8cef5f2 100644 --- a/R/bayesfactor_restricted.R +++ b/R/bayesfactor_restricted.R @@ -176,11 +176,10 @@ bayesfactor_restricted.emmGrid <- function(posterior, hypothesis, prior = NULL, verbose = verbose ) - out <- bayesfactor_restricted.data.frame( + bayesfactor_restricted.data.frame( posterior = samps$posterior, prior = samps$prior, hypothesis = hypothesis ) - .append_datagrid(out, posterior) } #' @export diff --git a/R/format.R b/R/format.R index c5e21f5b9..750b48b2d 100644 --- a/R/format.R +++ b/R/format.R @@ -225,7 +225,8 @@ format.bayesfactor_restricted <- function(x, BFE$BF[sgn] <- paste0("-", BFE$BF[sgn]) } BFE$log_BF <- NULL - colnames(BFE) <- c("Hypothesis", "P(Prior)", "P(Posterior)", "BF") + colnames(BFE)[colnames(BFE)=="p_prior"] <- "P(Prior)" + colnames(BFE)[colnames(BFE)=="p_posterior"] <- "P(Posterior)" # footer if (is.null(format) || format == "text") { diff --git a/R/print.equivalence_test.R b/R/print.equivalence_test.R index e9413ddf6..496f09d47 100644 --- a/R/print.equivalence_test.R +++ b/R/print.equivalence_test.R @@ -34,7 +34,8 @@ print.equivalence_test <- function(x, digits = 2, ...) { x$HDI <- sprintf("[%*s %*s]", maxlen_low, x$HDI_low, maxlen_high, x$HDI_high) ci <- unique(x$CI) - keep.columns <- c("CI", "Parameter", "ROPE_Equivalence", "ROPE_Percentage", "HDI", "Effects", "Component") + keep.columns <- c(attr(x, "grid_cols"), "Parameter", "Effects", "Component", + "ROPE_Equivalence", "ROPE_Percentage", "CI", "HDI") x <- x[, intersect(keep.columns, colnames(x))] diff --git a/R/print.rope.R b/R/print.rope.R index 85d21cd57..43cc9a2c2 100644 --- a/R/print.rope.R +++ b/R/print.rope.R @@ -28,7 +28,7 @@ print.rope <- function(x, digits = 2, ...) { # These are the base columns we want to print cols <- c( - "Parameter", "ROPE_Percentage", "Effects", "Component", + attr(x, "grid_cols"), "Parameter", "ROPE_Percentage", "Effects", "Component", if (is_multivariate) c("ROPE_low", "ROPE_high") ) From c1bcfb9e233a52a728ca1150dffe7b35a667f473 Mon Sep 17 00:00:00 2001 From: "Mattan S. Ben-Shachar" Date: Tue, 3 Sep 2024 13:35:29 +0300 Subject: [PATCH 06/15] add tests --- tests/testthat/test-emmGrid.R | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/tests/testthat/test-emmGrid.R b/tests/testthat/test-emmGrid.R index b5fff9968..672b2ea58 100644 --- a/tests/testthat/test-emmGrid.R +++ b/tests/testthat/test-emmGrid.R @@ -25,6 +25,7 @@ set.seed(300) test_that("emmGrid hdi", { xhdi <- hdi(all_, ci = 0.95) + expect_identical(colnames(xhdi)[1:2], c("group", "contrast")) expect_equal(xhdi$CI_low, all_summ$lower.HPD, tolerance = 0.1) expect_equal(xhdi$CI_high, all_summ$upper.HPD, tolerance = 0.1) @@ -34,6 +35,7 @@ test_that("emmGrid hdi", { test_that("emmGrid point_estimate", { xpest <- point_estimate(all_, centrality = "all", dispersion = TRUE) + expect_identical(colnames(xpest)[1:2], c("group", "contrast")) expect_equal(xpest$Median, all_summ$emmean, tolerance = 0.1) xpest2 <- point_estimate(emc_, centrality = "all", dispersion = TRUE) @@ -46,55 +48,65 @@ test_that("emmGrid point_estimate", { test_that("emmGrid ci", { xci <- ci(all_, ci = 0.9) + expect_identical(colnames(xci)[1:2], c("group", "contrast")) expect_equal(length(xci$CI_low), 3) expect_equal(length(xci$CI_high), 3) }) test_that("emmGrid eti", { xeti <- eti(all_, ci = 0.9) + expect_identical(colnames(xeti)[1:2], c("group", "contrast")) expect_equal(length(xeti$CI_low), 3) expect_equal(length(xeti$CI_high), 3) }) test_that("emmGrid equivalence_test", { xeqtest <- equivalence_test(all_, ci = 0.9, range = c(-0.1, 0.1)) + expect_identical(colnames(xeqtest)[1:2], c("group", "contrast")) expect_equal(length(xeqtest$ROPE_Percentage), 3) expect_equal(length(xeqtest$ROPE_Equivalence), 3) }) test_that("emmGrid estimate_density", { xestden <- estimate_density(c_, method = "logspline", precision = 5) + expect_identical(colnames(xestden)[1], "contrast") expect_equal(length(xestden$x), 5) }) test_that("emmGrid map_estimate", { xmapest <- map_estimate(all_, method = "kernel") + expect_identical(colnames(xmapest)[1:2], c("group", "contrast")) expect_equal(length(xmapest$MAP_Estimate), 3) }) test_that("emmGrid p_direction", { xpd <- p_direction(all_, method = "direct") + expect_identical(colnames(xpd)[1:2], c("group", "contrast")) expect_equal(length(xpd$pd), 3) }) test_that("emmGrid p_map", { xpmap <- p_map(all_, precision = 2^9) + expect_identical(colnames(xpmap)[1:2], c("group", "contrast")) expect_equal(length(xpmap$p_MAP), 3) }) test_that("emmGrid p_rope", { xprope <- p_rope(all_, range = c(-0.1, 0.1)) + expect_identical(colnames(xprope)[1:2], c("group", "contrast")) expect_equal(length(xprope$p_ROPE), 3) }) test_that("emmGrid p_significance", { xsig <- p_significance(all_, threshold = c(-0.1, 0.1)) + expect_identical(colnames(xsig)[1:2], c("group", "contrast")) expect_equal(length(xsig$ps), 3) }) test_that("emmGrid rope", { xrope <- rope(all_, range = "default", ci = 0.9) + expect_identical(colnames(xrope)[1:2], c("group", "contrast")) expect_equal(length(xrope$ROPE_Percentage), 3) }) @@ -107,6 +119,8 @@ test_that("emmGrid describe_posterior", { describe_posterior(emc_)$median ) + expect_identical(colnames(describe_posterior(all_))[1:2], c("group", "contrast")) + skip_on_cran() expect_equal( describe_posterior(all_, bf_prior = model_p, test = "bf")$log_BF, @@ -129,6 +143,7 @@ test_that("emmGrid bayesfactor_parameters", { xbfp <- bayesfactor_parameters(all_, prior = model_p, verbose = FALSE) xbfp2 <- bayesfactor_parameters(emc_, prior = model_p, verbose = FALSE) xbfp3 <- bayesfactor_parameters(emc_, prior = emc_p, verbose = FALSE) + expect_identical(colnames(xbfp)[1:2], c("group", "contrast")) expect_equal(xbfp$log_BF, xbfp2$log_BF, tolerance = 0.1) expect_equal(xbfp$log_BF, xbfp3$log_BF, tolerance = 0.1) @@ -166,6 +181,7 @@ test_that("emmGrid si", { set.seed(4) xrsi <- si(all_, prior = model_p, verbose = FALSE) + expect_identical(colnames(xrsi)[1:2], c("group", "contrast")) expect_equal(length(xrsi$CI_low), 3) expect_equal(length(xrsi$CI_high), 3) From 7c4b2b9018463008ec2e75ffe327682ea9f1b1ec Mon Sep 17 00:00:00 2001 From: "Mattan S. Ben-Shachar" Date: Tue, 3 Sep 2024 13:37:36 +0300 Subject: [PATCH 07/15] Update DESCRIPTION --- DESCRIPTION | 1 + 1 file changed, 1 insertion(+) diff --git a/DESCRIPTION b/DESCRIPTION index c71e4efd7..48bff709c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -126,3 +126,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 \ No newline at end of file From 026189d2269c7ab1d5f6bd74361df786a9342a70 Mon Sep 17 00:00:00 2001 From: "Mattan S. Ben-Shachar" Date: Tue, 3 Sep 2024 13:50:39 +0300 Subject: [PATCH 08/15] styler and lintrs --- R/bci.R | 6 +++--- R/format.R | 4 ++-- R/print.equivalence_test.R | 6 ++++-- R/utils.R | 1 - 4 files changed, 9 insertions(+), 8 deletions(-) diff --git a/R/bci.R b/R/bci.R index 5f8f99c24..0b71025c0 100644 --- a/R/bci.R +++ b/R/bci.R @@ -300,8 +300,8 @@ bci.get_predicted <- function(x, ci = 0.95, use_iterations = FALSE, verbose = TR upper <- stats::quantile(x, upper.inv, names = FALSE, na.rm = TRUE) data.frame( - "CI" = ci, - "CI_low" = lower, - "CI_high" = upper + CI = ci, + CI_low = lower, + CI_high = upper ) } diff --git a/R/format.R b/R/format.R index 750b48b2d..15c205e48 100644 --- a/R/format.R +++ b/R/format.R @@ -225,8 +225,8 @@ format.bayesfactor_restricted <- function(x, BFE$BF[sgn] <- paste0("-", BFE$BF[sgn]) } BFE$log_BF <- NULL - colnames(BFE)[colnames(BFE)=="p_prior"] <- "P(Prior)" - colnames(BFE)[colnames(BFE)=="p_posterior"] <- "P(Posterior)" + colnames(BFE)[colnames(BFE) == "p_prior"] <- "P(Prior)" + colnames(BFE)[colnames(BFE) == "p_posterior"] <- "P(Posterior)" # footer if (is.null(format) || format == "text") { diff --git a/R/print.equivalence_test.R b/R/print.equivalence_test.R index 496f09d47..fd7f72cf5 100644 --- a/R/print.equivalence_test.R +++ b/R/print.equivalence_test.R @@ -34,8 +34,10 @@ print.equivalence_test <- function(x, digits = 2, ...) { x$HDI <- sprintf("[%*s %*s]", maxlen_low, x$HDI_low, maxlen_high, x$HDI_high) ci <- unique(x$CI) - keep.columns <- c(attr(x, "grid_cols"), "Parameter", "Effects", "Component", - "ROPE_Equivalence", "ROPE_Percentage", "CI", "HDI") + keep.columns <- c( + attr(x, "grid_cols"), "Parameter", "Effects", "Component", + "ROPE_Equivalence", "ROPE_Percentage", "CI", "HDI" + ) x <- x[, intersect(keep.columns, colnames(x))] diff --git a/R/utils.R b/R/utils.R index 6016fa5f7..3f8803f82 100644 --- a/R/utils.R +++ b/R/utils.R @@ -176,4 +176,3 @@ attr(results, "grid_cols") <- grid_names results } - From f4f137c4e4d814b8653659b768a1e54f2c4349bb Mon Sep 17 00:00:00 2001 From: "Mattan S. Ben-Shachar" Date: Tue, 3 Sep 2024 23:28:31 +0300 Subject: [PATCH 09/15] add marginaleffects support --- DESCRIPTION | 3 ++- NAMESPACE | 41 ++++++++++++++++++++++++++++++++++++ NEWS.md | 2 ++ R/bci.R | 16 ++++++++++++++ R/ci.R | 23 +++++++++++++++++++- R/equivalence_test.R | 16 ++++++++++++++ R/eti.R | 14 +++++++++++++ R/hdi.R | 15 +++++++++++++ R/map_estimate.R | 13 ++++++++++++ R/p_direction.R | 16 ++++++++++++++ R/p_map.R | 13 ++++++++++++ R/p_rope.R | 15 +++++++++++++ R/p_significance.R | 14 +++++++++++++ R/point_estimate.R | 14 +++++++++++++ R/print.equivalence_test.R | 2 +- R/rope.R | 15 +++++++++++++ R/spi.R | 24 +++++++++++++++++++++ R/utils.R | 43 +++++++++++++++++++++++++++++++++++++- man/bci.Rd | 3 +++ man/p_direction.Rd | 10 +++++++++ 20 files changed, 308 insertions(+), 4 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 48bff709c..8754ae0b3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -95,6 +95,7 @@ Suggests: lavaan, lme4, logspline (>= 2.1.21), + marginaleffects (>= 0.21.0), MASS, mclust, mediation, @@ -126,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 \ No newline at end of file +Remotes: easystats/insight diff --git a/NAMESPACE b/NAMESPACE index f52947612..3709169b8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -63,6 +63,7 @@ S3method(bci,bcplm) S3method(bci,blavaan) S3method(bci,blrm) S3method(bci,brmsfit) +S3method(bci,comparisons) S3method(bci,data.frame) S3method(bci,draws) S3method(bci,emmGrid) @@ -71,9 +72,11 @@ S3method(bci,get_predicted) S3method(bci,mcmc) S3method(bci,mcmc.list) S3method(bci,numeric) +S3method(bci,predictions) S3method(bci,rvar) S3method(bci,sim) S3method(bci,sim.merMod) +S3method(bci,slopes) S3method(bci,stanfit) S3method(bci,stanreg) S3method(check_prior,blavaan) @@ -87,6 +90,7 @@ S3method(ci,bcplm) S3method(ci,blavaan) S3method(ci,blrm) S3method(ci,brmsfit) +S3method(ci,comparisons) S3method(ci,data.frame) S3method(ci,draws) S3method(ci,emmGrid) @@ -95,9 +99,11 @@ S3method(ci,get_predicted) S3method(ci,mcmc) S3method(ci,mcmc.list) S3method(ci,numeric) +S3method(ci,predictions) S3method(ci,rvar) S3method(ci,sim) S3method(ci,sim.merMod) +S3method(ci,slopes) S3method(ci,stanfit) S3method(ci,stanreg) S3method(cwi,data.frame) @@ -157,6 +163,7 @@ S3method(equivalence_test,bcplm) S3method(equivalence_test,blavaan) S3method(equivalence_test,blrm) S3method(equivalence_test,brmsfit) +S3method(equivalence_test,comparisons) S3method(equivalence_test,data.frame) S3method(equivalence_test,default) S3method(equivalence_test,draws) @@ -165,9 +172,11 @@ S3method(equivalence_test,emm_list) S3method(equivalence_test,mcmc) S3method(equivalence_test,mcmc.list) S3method(equivalence_test,numeric) +S3method(equivalence_test,predictions) S3method(equivalence_test,rvar) S3method(equivalence_test,sim) S3method(equivalence_test,sim.merMod) +S3method(equivalence_test,slopes) S3method(equivalence_test,stanfit) S3method(equivalence_test,stanreg) S3method(estimate_density,BGGM) @@ -200,6 +209,7 @@ S3method(eti,bcplm) S3method(eti,blavaan) S3method(eti,blrm) S3method(eti,brmsfit) +S3method(eti,comparisons) S3method(eti,data.frame) S3method(eti,default) S3method(eti,draws) @@ -209,9 +219,11 @@ S3method(eti,get_predicted) S3method(eti,mcmc) S3method(eti,mcmc.list) S3method(eti,numeric) +S3method(eti,predictions) S3method(eti,rvar) S3method(eti,sim) S3method(eti,sim.merMod) +S3method(eti,slopes) S3method(eti,stanfit) S3method(eti,stanreg) S3method(format,bayesfactor_inclusion) @@ -239,6 +251,7 @@ S3method(hdi,bcplm) S3method(hdi,blavaan) S3method(hdi,blrm) S3method(hdi,brmsfit) +S3method(hdi,comparisons) S3method(hdi,data.frame) S3method(hdi,default) S3method(hdi,draws) @@ -248,9 +261,11 @@ S3method(hdi,get_predicted) S3method(hdi,mcmc) S3method(hdi,mcmc.list) S3method(hdi,numeric) +S3method(hdi,predictions) S3method(hdi,rvar) S3method(hdi,sim) S3method(hdi,sim.merMod) +S3method(hdi,slopes) S3method(hdi,stanfit) S3method(hdi,stanreg) S3method(map_estimate,BGGM) @@ -260,6 +275,7 @@ S3method(map_estimate,bcplm) S3method(map_estimate,blavaan) S3method(map_estimate,blrm) S3method(map_estimate,brmsfit) +S3method(map_estimate,comparisons) S3method(map_estimate,data.frame) S3method(map_estimate,draws) S3method(map_estimate,emmGrid) @@ -268,7 +284,9 @@ S3method(map_estimate,get_predicted) S3method(map_estimate,mcmc) S3method(map_estimate,mcmc.list) S3method(map_estimate,numeric) +S3method(map_estimate,predictions) S3method(map_estimate,rvar) +S3method(map_estimate,slopes) S3method(map_estimate,stanfit) S3method(map_estimate,stanreg) S3method(mcse,blavaan) @@ -287,6 +305,7 @@ S3method(p_direction,bcplm) S3method(p_direction,blavaan) S3method(p_direction,blrm) S3method(p_direction,brmsfit) +S3method(p_direction,comparisons) S3method(p_direction,data.frame) S3method(p_direction,default) S3method(p_direction,draws) @@ -297,9 +316,11 @@ S3method(p_direction,mcmc) S3method(p_direction,mcmc.list) S3method(p_direction,numeric) S3method(p_direction,parameters_model) +S3method(p_direction,predictions) S3method(p_direction,rvar) S3method(p_direction,sim) S3method(p_direction,sim.merMod) +S3method(p_direction,slopes) S3method(p_direction,stanfit) S3method(p_direction,stanreg) S3method(p_map,BFBayesFactor) @@ -311,6 +332,7 @@ S3method(p_map,bcplm) S3method(p_map,blavaan) S3method(p_map,blrm) S3method(p_map,brmsfit) +S3method(p_map,comparisons) S3method(p_map,data.frame) S3method(p_map,draws) S3method(p_map,emmGrid) @@ -319,9 +341,11 @@ S3method(p_map,get_predicted) S3method(p_map,mcmc) S3method(p_map,mcmc.list) S3method(p_map,numeric) +S3method(p_map,predictions) S3method(p_map,rvar) S3method(p_map,sim) S3method(p_map,sim.merMod) +S3method(p_map,slopes) S3method(p_map,stanfit) S3method(p_map,stanreg) S3method(p_rope,BFBayesFactor) @@ -332,6 +356,7 @@ S3method(p_rope,bcplm) S3method(p_rope,blavaan) S3method(p_rope,blrm) S3method(p_rope,brmsfit) +S3method(p_rope,comparisons) S3method(p_rope,data.frame) S3method(p_rope,default) S3method(p_rope,draws) @@ -340,9 +365,11 @@ S3method(p_rope,emm_list) S3method(p_rope,mcmc) S3method(p_rope,mcmc.list) S3method(p_rope,numeric) +S3method(p_rope,predictions) S3method(p_rope,rvar) S3method(p_rope,sim) S3method(p_rope,sim.merMod) +S3method(p_rope,slopes) S3method(p_rope,stanfit) S3method(p_rope,stanreg) S3method(p_significance,BFBayesFactor) @@ -354,6 +381,7 @@ S3method(p_significance,bcplm) S3method(p_significance,blavaan) S3method(p_significance,blrm) S3method(p_significance,brmsfit) +S3method(p_significance,comparisons) S3method(p_significance,data.frame) S3method(p_significance,default) S3method(p_significance,draws) @@ -364,7 +392,9 @@ S3method(p_significance,mcmc) S3method(p_significance,mcmc.list) S3method(p_significance,numeric) S3method(p_significance,parameters_simulate_model) +S3method(p_significance,predictions) S3method(p_significance,rvar) +S3method(p_significance,slopes) S3method(p_significance,stanfit) S3method(p_significance,stanreg) S3method(p_to_bf,default) @@ -396,6 +426,7 @@ S3method(point_estimate,bcplm) S3method(point_estimate,blavaan) S3method(point_estimate,blrm) S3method(point_estimate,brmsfit) +S3method(point_estimate,comparisons) S3method(point_estimate,data.frame) S3method(point_estimate,default) S3method(point_estimate,draws) @@ -406,9 +437,11 @@ S3method(point_estimate,matrix) S3method(point_estimate,mcmc) S3method(point_estimate,mcmc.list) S3method(point_estimate,numeric) +S3method(point_estimate,predictions) S3method(point_estimate,rvar) S3method(point_estimate,sim) S3method(point_estimate,sim.merMod) +S3method(point_estimate,slopes) S3method(point_estimate,stanfit) S3method(point_estimate,stanreg) S3method(print,bayesfactor_inclusion) @@ -469,6 +502,7 @@ S3method(rope,bcplm) S3method(rope,blavaan) S3method(rope,blrm) S3method(rope,brmsfit) +S3method(rope,comparisons) S3method(rope,data.frame) S3method(rope,default) S3method(rope,draws) @@ -478,9 +512,11 @@ S3method(rope,get_predicted) S3method(rope,mcmc) S3method(rope,mcmc.list) S3method(rope,numeric) +S3method(rope,predictions) S3method(rope,rvar) S3method(rope,sim) S3method(rope,sim.merMod) +S3method(rope,slopes) S3method(rope,stanfit) S3method(rope,stanreg) S3method(rope_range,data.frame) @@ -534,16 +570,21 @@ S3method(spi,bcplm) S3method(spi,blavaan) S3method(spi,blrm) S3method(spi,brmsfit) +S3method(spi,comparisons) S3method(spi,data.frame) S3method(spi,default) +S3method(spi,draws) S3method(spi,emmGrid) S3method(spi,emm_list) S3method(spi,get_predicted) S3method(spi,mcmc) S3method(spi,mcmc.list) S3method(spi,numeric) +S3method(spi,predictions) +S3method(spi,rvar) S3method(spi,sim) S3method(spi,sim.merMod) +S3method(spi,slopes) S3method(spi,stanfit) S3method(spi,stanreg) S3method(unupdate,blavaan) diff --git a/NEWS.md b/NEWS.md index a4c5628a0..3eebdf519 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,8 @@ ## Changes +* Added support for `{marginaleffects}` + * Results from objects generated by `{emmeans}` (`emmGrid`/`emm_list`) now return results with appended grid-data. diff --git a/R/bci.R b/R/bci.R index 0b71025c0..5a2d075a1 100644 --- a/R/bci.R +++ b/R/bci.R @@ -176,6 +176,22 @@ bci.emmGrid <- function(x, ci = 0.95, verbose = TRUE, ...) { #' @export bci.emm_list <- bci.emmGrid +#' @rdname bci +#' @export +bci.slopes <- function(x, ci = 0.95, verbose = TRUE, ...) { + xrvar <- .get_marginaleffects_rvar(x) + dat <- bci(xrvar, ci = ci, verbose = verbose, ...) + dat <- .append_datagrid(dat, x) + attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x)) + dat +} + +#' @export +bci.comparisons <- bci.slopes + +#' @export +bci.predictions <- bci.slopes + #' @rdname bci #' @export bci.stanreg <- function(x, diff --git a/R/ci.R b/R/ci.R index 5d4641612..51e7e2e58 100644 --- a/R/ci.R +++ b/R/ci.R @@ -172,7 +172,7 @@ ci.rvar <- ci.draws #' @export ci.emmGrid <- function(x, ci = NULL, ...) { - if (!.is_baysian_emmeans(x)) { + if (!.is_baysian_grid(x)) { insight::check_if_installed("parameters") if (is.null(ci)) ci <- 0.95 return(parameters::ci(model = x, ci = ci, ...)) @@ -189,6 +189,27 @@ ci.emmGrid <- function(x, ci = NULL, ...) { #' @export ci.emm_list <- ci.emmGrid +#' @export +ci.slopes <- function(x, ci = NULL, ...) { + if (!.is_baysian_grid(x)) { + insight::check_if_installed("parameters") + if (is.null(ci)) ci <- 0.95 + return(parameters::ci(model = x, ci = ci, ...)) + } + + if (is.null(ci)) ci <- 0.95 + xrvar <- .get_marginaleffects_rvar(x) + out <- ci(xrvar, ci = ci, ...) + out <- .append_datagrid(out, x) + out +} + +#' @export +ci.comparisons <- ci.slopes + +#' @export +ci.predictions <- ci.slopes + #' @rdname ci #' @export diff --git a/R/equivalence_test.R b/R/equivalence_test.R index d99a9eb2c..2dd7c2c76 100644 --- a/R/equivalence_test.R +++ b/R/equivalence_test.R @@ -192,6 +192,22 @@ equivalence_test.emmGrid <- function(x, range = "default", ci = 0.95, verbose = equivalence_test.emm_list <- equivalence_test.emmGrid +#' @export +equivalence_test.slopes <- function(x, range = "default", ci = 0.95, verbose = TRUE, ...) { + xrvar <- .get_marginaleffects_rvar(x) + out <- equivalence_test(xrvar, range = range, ci = ci, verbose = verbose, ...) + out <- .append_datagrid(out, x) + attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) + out +} + +#' @export +equivalence_test.comparisons <- equivalence_test.slopes + +#' @export +equivalence_test.predictions <- equivalence_test.slopes + + #' @export equivalence_test.BFBayesFactor <- function(x, range = "default", ci = 0.95, verbose = TRUE, ...) { out <- equivalence_test(insight::get_parameters(x), range = range, ci = ci, verbose = verbose, ...) diff --git a/R/eti.R b/R/eti.R index 91282c47b..766345530 100644 --- a/R/eti.R +++ b/R/eti.R @@ -183,6 +183,20 @@ eti.emmGrid <- function(x, ci = 0.95, verbose = TRUE, ...) { #' @export eti.emm_list <- eti.emmGrid +#' @export +eti.slopes <- function(x, ci = 0.95, verbose = TRUE, ...) { + xrvar <- .get_marginaleffects_rvar(x) + dat <- eti(xrvar, ci = ci, verbose = verbose, ...) + dat <- .append_datagrid(dat, x) + attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x)) + dat +} + +#' @export +eti.comparisons <- eti.slopes + +#' @export +eti.predictions <- eti.slopes #' @rdname eti #' @export diff --git a/R/hdi.R b/R/hdi.R index b8903d1c6..6423be454 100644 --- a/R/hdi.R +++ b/R/hdi.R @@ -272,6 +272,21 @@ hdi.emmGrid <- function(x, ci = 0.95, verbose = TRUE, ...) { #' @export hdi.emm_list <- hdi.emmGrid +#' @export +hdi.slopes <- function(x, ci = 0.95, verbose = TRUE, ...) { + xrvar <- .get_marginaleffects_rvar(x) + out <- hdi(xrvar, ci = ci, verbose = verbose, ...) + out <- .append_datagrid(out, x) + attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) + out +} + +#' @export +hdi.comparisons <- hdi.slopes + +#' @export +hdi.predictions <- hdi.slopes + #' @rdname hdi #' @export diff --git a/R/map_estimate.R b/R/map_estimate.R index 8b88b00dd..e7e518940 100644 --- a/R/map_estimate.R +++ b/R/map_estimate.R @@ -173,6 +173,19 @@ map_estimate.emmGrid <- function(x, precision = 2^10, method = "kernel", ...) { #' @export map_estimate.emm_list <- map_estimate.emmGrid +#' @export +map_estimate.slopes <- function(x, precision = 2^10, method = "kernel", ...) { + xrvar <- .get_marginaleffects_rvar(x) + out <- map_estimate(xrvar, precision = precision, method = method, ...) + .append_datagrid(out, x) +} + +#' @export +map_estimate.comparisons <- map_estimate.slopes + +#' @export +map_estimate.predictions <- map_estimate.slopes + #' @rdname map_estimate #' @export diff --git a/R/p_direction.R b/R/p_direction.R index 1da0ddd93..f64add787 100644 --- a/R/p_direction.R +++ b/R/p_direction.R @@ -399,6 +399,22 @@ p_direction.emmGrid <- function(x, method = "direct", null = 0, as_p = FALSE, re #' @export p_direction.emm_list <- p_direction.emmGrid +#' @rdname p_direction +#' @export +p_direction.slopes <- function(x, method = "direct", null = 0, as_p = FALSE, remove_na = TRUE, ...) { + xrvar <- .get_marginaleffects_rvar(x) + out <- p_direction(xrvar, method = method, null = null, as_p = as_p, remove_na = remove_na, ...) + out <- .append_datagrid(out, x) + attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) + out +} + +#' @export +p_direction.comparisons <- p_direction.slopes + +#' @export +p_direction.predictions <- p_direction.slopes + #' @keywords internal .p_direction_models <- function(x, diff --git a/R/p_map.R b/R/p_map.R index 2e5592402..27739ce9a 100644 --- a/R/p_map.R +++ b/R/p_map.R @@ -167,7 +167,20 @@ p_map.emmGrid <- function(x, null = 0, precision = 2^10, method = "kernel", ...) #' @export p_map.emm_list <- p_map.emmGrid +#' @export +p_map.slopes <- function(x, null = 0, precision = 2^10, method = "kernel", ...) { + xrvar <- .get_marginaleffects_rvar(x) + out <- p_map(xrvar, null = null, precision = precision, method = method, ...) + out <- .append_datagrid(out, x) + attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) + out +} + +#' @export +p_map.comparisons <- p_map.slopes +#' @export +p_map.predictions <- p_map.slopes #' @keywords internal diff --git a/R/p_rope.R b/R/p_rope.R index 3d4f590a6..bb07b09b9 100644 --- a/R/p_rope.R +++ b/R/p_rope.R @@ -62,6 +62,21 @@ p_rope.emmGrid <- function(x, range = "default", verbose = TRUE, ...) { #' @export p_rope.emm_list <- p_rope.emmGrid +#' @export +p_rope.slopes <- function(x, range = "default", verbose = TRUE, ...) { + xrvar <- .get_marginaleffects_rvar(x) + out <- p_rope(xrvar, range = range, verbose = verbose) + out <- .append_datagrid(out, x) + attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) + out +} + +#' @export +p_rope.comparisons <- p_rope.slopes + +#' @export +p_rope.predictions <- p_rope.slopes + #' @export p_rope.BFBayesFactor <- p_rope.numeric diff --git a/R/p_significance.R b/R/p_significance.R index 8e6b56ff7..eb86b0fe1 100644 --- a/R/p_significance.R +++ b/R/p_significance.R @@ -222,6 +222,20 @@ p_significance.emmGrid <- function(x, threshold = "default", ...) { #' @export p_significance.emm_list <- p_significance.emmGrid +#' @export +p_significance.slopes <- function(x, threshold = "default", ...) { + xrvar <- .get_marginaleffects_rvar(x) + out <- p_significance(xrvar, threshold = threshold, ...) + out <- .append_datagrid(out, x) + attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) + out +} + +#' @export +p_significance.comparisons <- p_significance.slopes + +#' @export +p_significance.predictions <- p_significance.slopes #' @rdname p_significance diff --git a/R/point_estimate.R b/R/point_estimate.R index 788dfe086..99d9ce8aa 100644 --- a/R/point_estimate.R +++ b/R/point_estimate.R @@ -229,6 +229,20 @@ point_estimate.emmGrid <- function(x, centrality = "all", dispersion = FALSE, .. #' @export point_estimate.emm_list <- point_estimate.emmGrid +#' @export +point_estimate.slopes <- function(x, centrality = "all", dispersion = FALSE, ...) { + xrvar <- .get_marginaleffects_rvar(x) + out <- point_estimate(xrvar, centrality = centrality, dispersion = dispersion, ...) + out <- .append_datagrid(out, x) + attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) + out +} + +#' @export +point_estimate.comparisons <- point_estimate.slopes + +#' @export +point_estimate.predictions <- point_estimate.slopes #' @rdname point_estimate #' @export diff --git a/R/print.equivalence_test.R b/R/print.equivalence_test.R index fd7f72cf5..978253fc7 100644 --- a/R/print.equivalence_test.R +++ b/R/print.equivalence_test.R @@ -6,7 +6,7 @@ print.equivalence_test <- function(x, digits = 2, ...) { # fix "sd" pattern model <- .retrieve_model(x) - if (!is.null(model)) { + if (!is.null(model) && !is.data.frame(model)) { cp <- insight::clean_parameters(model) if (!is.null(cp$Group) && any(startsWith(cp$Group, "SD/Cor"))) { cp <- cp[startsWith(cp$Group, "SD/Cor"), ] diff --git a/R/rope.R b/R/rope.R index 92c052c02..7b77923ca 100644 --- a/R/rope.R +++ b/R/rope.R @@ -253,6 +253,21 @@ rope.emmGrid <- function(x, range = "default", ci = 0.95, ci_method = "ETI", ver #' @export rope.emm_list <- rope.emmGrid +#' @export +rope.slopes <- function(x, range = "default", ci = 0.95, ci_method = "ETI", verbose = TRUE, ...) { + xrvar <- .get_marginaleffects_rvar(x) + dat <- rope(xrvar, range = range, ci = ci, ci_method = ci_method, verbose = verbose, ...) + dat <- .append_datagrid(dat, x) + attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x)) + dat +} + +#' @export +rope.comparisons <- rope.slopes + +#' @export +rope.predictions <- rope.slopes + #' @export rope.BFBayesFactor <- function(x, range = "default", ci = 0.95, ci_method = "ETI", verbose = TRUE, ...) { diff --git a/R/spi.R b/R/spi.R index b50f20d34..e677ffbfc 100644 --- a/R/spi.R +++ b/R/spi.R @@ -72,6 +72,16 @@ spi.data.frame <- function(x, ci = 0.95, verbose = TRUE, ...) { dat } +#' @export +spi.draws <- function(x, ci = 0.95, verbose = TRUE, ...) { + dat <- .compute_interval_dataframe(x = .posterior_draws_to_df(x), ci = ci, verbose = verbose, fun = "spi") + attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x)) + dat +} + +#' @export +spi.rvar <- spi.draws + #' @export spi.MCMCglmm <- function(x, ci = 0.95, verbose = TRUE, ...) { @@ -138,6 +148,20 @@ spi.emmGrid <- function(x, ci = 0.95, verbose = TRUE, ...) { #' @export spi.emm_list <- spi.emmGrid +#' @export +spi.slopes <- function(x, ci = 0.95, verbose = TRUE, ...) { + xrvar <- .get_marginaleffects_rvar(x) + out <- spi(xrvar, ci = ci, verbose = verbose, ...) + out <- .append_datagrid(out, x) + attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) + out +} + +#' @export +spi.comparisons <- spi.slopes + +#' @export +spi.predictions <- spi.slopes #' @rdname spi #' @export diff --git a/R/utils.R b/R/utils.R index 3f8803f82..0b6db955f 100644 --- a/R/utils.R +++ b/R/utils.R @@ -132,7 +132,12 @@ } #' @keywords internal -.is_baysian_emmeans <- function(x) { +.is_baysian_grid <- function(x) { + UseMethod(".is_baysian_grid") +} + +#' @keywords internal +.is_baysian_grid.emmGrid <- function(x) { if (inherits(x, "emm_list")) { x <- x[[1]] } @@ -140,6 +145,19 @@ !(all(dim(post.beta) == 1) && is.na(post.beta)) } +#' @keywords internal +.is_baysian_grid.emm_list <- .is_baysian_grid.emmGrid + +#' @keywords internal +.is_baysian_grid.slopes <- function(x) { + !is.null(attr(x, "posterior_draws")) +} + +#' @keywords internal +.is_baysian_grid.predictions <- .is_baysian_grid.slopes + +#' @keywords internal +.is_baysian_grid.comparisons <- .is_baysian_grid.slopes # safe add cleaned parameter names to a model object .add_clean_parameters_attribute <- function(params, model) { @@ -157,6 +175,11 @@ #' @keywords internal .append_datagrid <- function(results, object) { + UseMethod(".append_datagrid", object) +} + +#' @keywords internal +.append_datagrid.emmGrid <- function(results, object) { # results is assumed to be a data frame with "Parameter" column # object is an emmeans that results is based on @@ -176,3 +199,21 @@ attr(results, "grid_cols") <- grid_names results } + +#' @keywords internal +.append_datagrid.emm_list <- .append_datagrid.emmGrid + +#' @keywords internal +.append_datagrid.predictions <- .append_datagrid.emmGrid + +#' @keywords internal +.append_datagrid.slopes <- .append_datagrid.predictions + +#' @keywords internal +.append_datagrid.comparisons <- .append_datagrid.predictions + +#' @keywords internal +.get_marginaleffects_rvar <- function(object) { + # errors and checks are handled by marginaleffects + marginaleffects::posterior_draws(object, shape = "rvar")[["rvar"]] +} \ No newline at end of file diff --git a/man/bci.Rd b/man/bci.Rd index a2040bf0a..db4de886b 100644 --- a/man/bci.Rd +++ b/man/bci.Rd @@ -9,6 +9,7 @@ \alias{bci.sim.merMod} \alias{bci.sim} \alias{bci.emmGrid} +\alias{bci.slopes} \alias{bci.stanreg} \alias{bci.brmsfit} \alias{bci.BFBayesFactor} @@ -38,6 +39,8 @@ bcai(x, ...) \method{bci}{emmGrid}(x, ci = 0.95, verbose = TRUE, ...) +\method{bci}{slopes}(x, ci = 0.95, verbose = TRUE, ...) + \method{bci}{stanreg}( x, ci = 0.95, diff --git a/man/p_direction.Rd b/man/p_direction.Rd index 488371e1f..9255a532d 100644 --- a/man/p_direction.Rd +++ b/man/p_direction.Rd @@ -7,6 +7,7 @@ \alias{p_direction.data.frame} \alias{p_direction.MCMCglmm} \alias{p_direction.emmGrid} +\alias{p_direction.slopes} \alias{p_direction.stanreg} \alias{p_direction.brmsfit} \alias{p_direction.BFBayesFactor} @@ -54,6 +55,15 @@ pd(x, ...) ... ) +\method{p_direction}{slopes}( + x, + method = "direct", + null = 0, + as_p = FALSE, + remove_na = TRUE, + ... +) + \method{p_direction}{stanreg}( x, effects = c("fixed", "random", "all"), From 6a6589c008b2ff91d395d000d788771a7d619741 Mon Sep 17 00:00:00 2001 From: "Mattan S. Ben-Shachar" Date: Wed, 4 Sep 2024 14:28:59 +0300 Subject: [PATCH 10/15] simplify code --- R/utils.R | 19 +------------------ 1 file changed, 1 insertion(+), 18 deletions(-) diff --git a/R/utils.R b/R/utils.R index 0b6db955f..0b7de91f0 100644 --- a/R/utils.R +++ b/R/utils.R @@ -175,13 +175,8 @@ #' @keywords internal .append_datagrid <- function(results, object) { - UseMethod(".append_datagrid", object) -} - -#' @keywords internal -.append_datagrid.emmGrid <- function(results, object) { # results is assumed to be a data frame with "Parameter" column - # object is an emmeans that results is based on + # object is an emmeans / marginalefeects that results is based on all_attrs <- attributes(results) # save attributes for later @@ -200,18 +195,6 @@ results } -#' @keywords internal -.append_datagrid.emm_list <- .append_datagrid.emmGrid - -#' @keywords internal -.append_datagrid.predictions <- .append_datagrid.emmGrid - -#' @keywords internal -.append_datagrid.slopes <- .append_datagrid.predictions - -#' @keywords internal -.append_datagrid.comparisons <- .append_datagrid.predictions - #' @keywords internal .get_marginaleffects_rvar <- function(object) { # errors and checks are handled by marginaleffects From 2b03ec94d22cadcf00708cecb378408b3908396f Mon Sep 17 00:00:00 2001 From: "Mattan S. Ben-Shachar" Date: Wed, 4 Sep 2024 15:06:42 +0300 Subject: [PATCH 11/15] desc_post + bf stuff --- DESCRIPTION | 2 +- NAMESPACE | 12 ++++++ R/bayesfactor_parameters.R | 12 ++++++ R/bayesfactor_restricted.R | 9 ++++ R/bci.R | 2 +- R/ci.R | 2 +- R/describe_posterior.R | 53 ++++++++++++++++++++++- R/equivalence_test.R | 2 +- R/eti.R | 2 +- R/hdi.R | 2 +- R/map_estimate.R | 2 +- R/p_direction.R | 2 +- R/p_map.R | 2 +- R/p_rope.R | 2 +- R/p_significance.R | 2 +- R/point_estimate.R | 2 +- R/rope.R | 2 +- R/si.R | 9 ++++ R/spi.R | 2 +- R/utils.R | 11 +++-- R/utils_bayesfactor.R | 22 ++++++++++ man/bayesfactor_parameters.Rd | 3 ++ man/bayesfactor_restricted.Rd | 3 ++ man/si.Rd | 3 ++ tests/testthat/test-marginaleffects.R | 61 +++++++++++++++++++++++++++ 25 files changed, 208 insertions(+), 18 deletions(-) create mode 100644 tests/testthat/test-marginaleffects.R diff --git a/DESCRIPTION b/DESCRIPTION index 8754ae0b3..b5f2b0b5b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -66,7 +66,7 @@ Description: Provides utilities to describe posterior Depends: R (>= 3.6) Imports: - insight (>= 0.20.4.1), + insight (>= 0.20.4.2), datawizard (>= 0.10.0), graphics, methods, diff --git a/NAMESPACE b/NAMESPACE index 3709169b8..9896af5c0 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -37,22 +37,28 @@ S3method(bayesfactor_models,stanreg) S3method(bayesfactor_parameters,bayesfactor_models) S3method(bayesfactor_parameters,blavaan) S3method(bayesfactor_parameters,brmsfit) +S3method(bayesfactor_parameters,comparisons) S3method(bayesfactor_parameters,data.frame) S3method(bayesfactor_parameters,draws) S3method(bayesfactor_parameters,emmGrid) S3method(bayesfactor_parameters,emm_list) S3method(bayesfactor_parameters,numeric) +S3method(bayesfactor_parameters,predictions) S3method(bayesfactor_parameters,rvar) S3method(bayesfactor_parameters,sim) S3method(bayesfactor_parameters,sim.merMod) +S3method(bayesfactor_parameters,slopes) S3method(bayesfactor_parameters,stanreg) S3method(bayesfactor_restricted,blavaan) S3method(bayesfactor_restricted,brmsfit) +S3method(bayesfactor_restricted,comparisons) S3method(bayesfactor_restricted,data.frame) S3method(bayesfactor_restricted,draws) S3method(bayesfactor_restricted,emmGrid) S3method(bayesfactor_restricted,emm_list) +S3method(bayesfactor_restricted,predictions) S3method(bayesfactor_restricted,rvar) +S3method(bayesfactor_restricted,slopes) S3method(bayesfactor_restricted,stanreg) S3method(bci,BFBayesFactor) S3method(bci,BGGM) @@ -116,6 +122,7 @@ S3method(describe_posterior,bcplm) S3method(describe_posterior,blavaan) S3method(describe_posterior,blrm) S3method(describe_posterior,brmsfit) +S3method(describe_posterior,comparisons) S3method(describe_posterior,data.frame) S3method(describe_posterior,default) S3method(describe_posterior,double) @@ -127,9 +134,11 @@ S3method(describe_posterior,get_predicted) S3method(describe_posterior,mcmc) S3method(describe_posterior,mcmc.list) S3method(describe_posterior,numeric) +S3method(describe_posterior,predictions) S3method(describe_posterior,rvar) S3method(describe_posterior,sim) S3method(describe_posterior,sim.merMod) +S3method(describe_posterior,slopes) S3method(describe_posterior,stanfit) S3method(describe_posterior,stanmvreg) S3method(describe_posterior,stanreg) @@ -548,13 +557,16 @@ S3method(sexit_thresholds,wbm) S3method(sexit_thresholds,zeroinfl) S3method(si,blavaan) S3method(si,brmsfit) +S3method(si,comparisons) S3method(si,data.frame) S3method(si,draws) S3method(si,emmGrid) S3method(si,emm_list) S3method(si,get_predicted) S3method(si,numeric) +S3method(si,predictions) S3method(si,rvar) +S3method(si,slopes) S3method(si,stanfit) S3method(si,stanreg) S3method(simulate_prior,bcplm) diff --git a/R/bayesfactor_parameters.R b/R/bayesfactor_parameters.R index 551b2816a..f11f9c665 100644 --- a/R/bayesfactor_parameters.R +++ b/R/bayesfactor_parameters.R @@ -94,6 +94,9 @@ #' - `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()]. @@ -392,6 +395,15 @@ bayesfactor_parameters.emmGrid <- function(posterior, #' @export bayesfactor_parameters.emm_list <- bayesfactor_parameters.emmGrid +#' @export +bayesfactor_parameters.slopes <- bayesfactor_parameters.emmGrid + +#' @export +bayesfactor_parameters.predictions <- bayesfactor_parameters.emmGrid + +#' @export +bayesfactor_parameters.comparisons <- bayesfactor_parameters.emmGrid + #' @rdname bayesfactor_parameters #' @export diff --git a/R/bayesfactor_restricted.R b/R/bayesfactor_restricted.R index 4e8cef5f2..c5ddf4f46 100644 --- a/R/bayesfactor_restricted.R +++ b/R/bayesfactor_restricted.R @@ -185,6 +185,15 @@ bayesfactor_restricted.emmGrid <- function(posterior, hypothesis, prior = NULL, #' @export bayesfactor_restricted.emm_list <- bayesfactor_restricted.emmGrid +#' @export +bayesfactor_restricted.slopes <- bayesfactor_restricted.emmGrid + +#' @export +bayesfactor_restricted.predictions <- bayesfactor_restricted.emmGrid + +#' @export +bayesfactor_restricted.comparisons <- bayesfactor_restricted.emmGrid + #' @export bayesfactor_restricted.data.frame <- function(posterior, hypothesis, prior = NULL, ...) { p_hypothesis <- parse(text = hypothesis) diff --git a/R/bci.R b/R/bci.R index 5a2d075a1..190c229c6 100644 --- a/R/bci.R +++ b/R/bci.R @@ -179,7 +179,7 @@ bci.emm_list <- bci.emmGrid #' @rdname bci #' @export bci.slopes <- function(x, ci = 0.95, verbose = TRUE, ...) { - xrvar <- .get_marginaleffects_rvar(x) + xrvar <- .get_marginaleffects_draws(x) dat <- bci(xrvar, ci = ci, verbose = verbose, ...) dat <- .append_datagrid(dat, x) attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x)) diff --git a/R/ci.R b/R/ci.R index 51e7e2e58..be5e91f05 100644 --- a/R/ci.R +++ b/R/ci.R @@ -198,7 +198,7 @@ ci.slopes <- function(x, ci = NULL, ...) { } if (is.null(ci)) ci <- 0.95 - xrvar <- .get_marginaleffects_rvar(x) + xrvar <- .get_marginaleffects_draws(x) out <- ci(xrvar, ci = ci, ...) out <- .append_datagrid(out, x) out diff --git a/R/describe_posterior.R b/R/describe_posterior.R index ce2efa5aa..37b13bfd8 100644 --- a/R/describe_posterior.R +++ b/R/describe_posterior.R @@ -655,7 +655,7 @@ describe_posterior.draws <- function(posterior, rope_range = rope_range, rope_ci = rope_ci, keep_iterations = keep_iterations, - bf_prior = bf_prior, + bf_prior = if (!is.null(bf_prior)) .posterior_draws_to_df(bf_prior), BF = BF, verbose = verbose, ... @@ -822,7 +822,58 @@ describe_posterior.emmGrid <- function(posterior, #' @export describe_posterior.emm_list <- describe_posterior.emmGrid +#' @export +describe_posterior.slopes <- function(posterior, + centrality = "median", + dispersion = FALSE, + ci = 0.95, + ci_method = "eti", + test = c("p_direction", "rope"), + rope_range = "default", + rope_ci = 0.95, + keep_iterations = FALSE, + bf_prior = NULL, + BF = 1, + verbose = TRUE, + ...) { + if (any(c("all", "bf", "bayesfactor", "bayes_factor") %in% tolower(test)) || + "si" %in% tolower(ci_method)) { + samps <- .clean_priors_and_posteriors(posterior, bf_prior, verbose = verbose) + bf_prior <- samps$prior + posterior_samples <- samps$posterior + } else { + posterior_samples <- .get_marginaleffects_draws(posterior) + } + + out <- describe_posterior( + posterior_samples, + centrality = centrality, + dispersion = dispersion, + ci = ci, + ci_method = ci_method, + test = test, + rope_range = rope_range, + rope_ci = rope_ci, + keep_iterations = keep_iterations, + bf_prior = bf_prior, + BF = BF, + verbose = verbose, + ... + ) + + row.names(out) <- NULL # Reset row names + out <- .append_datagrid(out, posterior) + class(out) <- c("describe_posterior", "see_describe_posterior", class(out)) + attr(out, "ci_method") <- ci_method + attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(posterior)) + out +} +#' @export +describe_posterior.comparisons <- describe_posterior.slopes + +#' @export +describe_posterior.predictions <- describe_posterior.slopes # Stan ------------------------------ diff --git a/R/equivalence_test.R b/R/equivalence_test.R index 2dd7c2c76..163db680d 100644 --- a/R/equivalence_test.R +++ b/R/equivalence_test.R @@ -194,7 +194,7 @@ equivalence_test.emm_list <- equivalence_test.emmGrid #' @export equivalence_test.slopes <- function(x, range = "default", ci = 0.95, verbose = TRUE, ...) { - xrvar <- .get_marginaleffects_rvar(x) + xrvar <- .get_marginaleffects_draws(x) out <- equivalence_test(xrvar, range = range, ci = ci, verbose = verbose, ...) out <- .append_datagrid(out, x) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) diff --git a/R/eti.R b/R/eti.R index 766345530..9e2b64935 100644 --- a/R/eti.R +++ b/R/eti.R @@ -185,7 +185,7 @@ eti.emm_list <- eti.emmGrid #' @export eti.slopes <- function(x, ci = 0.95, verbose = TRUE, ...) { - xrvar <- .get_marginaleffects_rvar(x) + xrvar <- .get_marginaleffects_draws(x) dat <- eti(xrvar, ci = ci, verbose = verbose, ...) dat <- .append_datagrid(dat, x) attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x)) diff --git a/R/hdi.R b/R/hdi.R index 6423be454..bf1aa4244 100644 --- a/R/hdi.R +++ b/R/hdi.R @@ -274,7 +274,7 @@ hdi.emm_list <- hdi.emmGrid #' @export hdi.slopes <- function(x, ci = 0.95, verbose = TRUE, ...) { - xrvar <- .get_marginaleffects_rvar(x) + xrvar <- .get_marginaleffects_draws(x) out <- hdi(xrvar, ci = ci, verbose = verbose, ...) out <- .append_datagrid(out, x) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) diff --git a/R/map_estimate.R b/R/map_estimate.R index e7e518940..68bfafae0 100644 --- a/R/map_estimate.R +++ b/R/map_estimate.R @@ -175,7 +175,7 @@ map_estimate.emm_list <- map_estimate.emmGrid #' @export map_estimate.slopes <- function(x, precision = 2^10, method = "kernel", ...) { - xrvar <- .get_marginaleffects_rvar(x) + xrvar <- .get_marginaleffects_draws(x) out <- map_estimate(xrvar, precision = precision, method = method, ...) .append_datagrid(out, x) } diff --git a/R/p_direction.R b/R/p_direction.R index f64add787..4f3d5122a 100644 --- a/R/p_direction.R +++ b/R/p_direction.R @@ -402,7 +402,7 @@ p_direction.emm_list <- p_direction.emmGrid #' @rdname p_direction #' @export p_direction.slopes <- function(x, method = "direct", null = 0, as_p = FALSE, remove_na = TRUE, ...) { - xrvar <- .get_marginaleffects_rvar(x) + xrvar <- .get_marginaleffects_draws(x) out <- p_direction(xrvar, method = method, null = null, as_p = as_p, remove_na = remove_na, ...) out <- .append_datagrid(out, x) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) diff --git a/R/p_map.R b/R/p_map.R index 27739ce9a..60efe1580 100644 --- a/R/p_map.R +++ b/R/p_map.R @@ -169,7 +169,7 @@ p_map.emm_list <- p_map.emmGrid #' @export p_map.slopes <- function(x, null = 0, precision = 2^10, method = "kernel", ...) { - xrvar <- .get_marginaleffects_rvar(x) + xrvar <- .get_marginaleffects_draws(x) out <- p_map(xrvar, null = null, precision = precision, method = method, ...) out <- .append_datagrid(out, x) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) diff --git a/R/p_rope.R b/R/p_rope.R index bb07b09b9..9b2522228 100644 --- a/R/p_rope.R +++ b/R/p_rope.R @@ -64,7 +64,7 @@ p_rope.emm_list <- p_rope.emmGrid #' @export p_rope.slopes <- function(x, range = "default", verbose = TRUE, ...) { - xrvar <- .get_marginaleffects_rvar(x) + xrvar <- .get_marginaleffects_draws(x) out <- p_rope(xrvar, range = range, verbose = verbose) out <- .append_datagrid(out, x) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) diff --git a/R/p_significance.R b/R/p_significance.R index 904ff8a0d..68a179fa2 100644 --- a/R/p_significance.R +++ b/R/p_significance.R @@ -226,7 +226,7 @@ p_significance.emm_list <- p_significance.emmGrid #' @export p_significance.slopes <- function(x, threshold = "default", ...) { - xrvar <- .get_marginaleffects_rvar(x) + xrvar <- .get_marginaleffects_draws(x) out <- p_significance(xrvar, threshold = threshold, ...) out <- .append_datagrid(out, x) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) diff --git a/R/point_estimate.R b/R/point_estimate.R index 99d9ce8aa..15b305766 100644 --- a/R/point_estimate.R +++ b/R/point_estimate.R @@ -231,7 +231,7 @@ point_estimate.emm_list <- point_estimate.emmGrid #' @export point_estimate.slopes <- function(x, centrality = "all", dispersion = FALSE, ...) { - xrvar <- .get_marginaleffects_rvar(x) + xrvar <- .get_marginaleffects_draws(x) out <- point_estimate(xrvar, centrality = centrality, dispersion = dispersion, ...) out <- .append_datagrid(out, x) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) diff --git a/R/rope.R b/R/rope.R index 7b77923ca..c9ba83f41 100644 --- a/R/rope.R +++ b/R/rope.R @@ -255,7 +255,7 @@ rope.emm_list <- rope.emmGrid #' @export rope.slopes <- function(x, range = "default", ci = 0.95, ci_method = "ETI", verbose = TRUE, ...) { - xrvar <- .get_marginaleffects_rvar(x) + xrvar <- .get_marginaleffects_draws(x) dat <- rope(xrvar, range = range, ci = ci, ci_method = ci_method, verbose = verbose, ...) dat <- .append_datagrid(dat, x) attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x)) diff --git a/R/si.R b/R/si.R index b489a957e..497a60f74 100644 --- a/R/si.R +++ b/R/si.R @@ -177,6 +177,15 @@ si.emmGrid <- function(posterior, prior = NULL, #' @export si.emm_list <- si.emmGrid +#' @export +si.slopes <- si.emmGrid + +#' @export +si.comparisons <- si.emmGrid + +#' @export +si.predictions <- si.emmGrid + #' @export si.stanfit <- function(posterior, prior = NULL, BF = 1, verbose = TRUE, effects = c("fixed", "random", "all"), ...) { diff --git a/R/spi.R b/R/spi.R index e677ffbfc..1e38c9104 100644 --- a/R/spi.R +++ b/R/spi.R @@ -150,7 +150,7 @@ spi.emm_list <- spi.emmGrid #' @export spi.slopes <- function(x, ci = 0.95, verbose = TRUE, ...) { - xrvar <- .get_marginaleffects_rvar(x) + xrvar <- .get_marginaleffects_draws(x) out <- spi(xrvar, ci = ci, verbose = verbose, ...) out <- .append_datagrid(out, x) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) diff --git a/R/utils.R b/R/utils.R index 0b7de91f0..77e7100fb 100644 --- a/R/utils.R +++ b/R/utils.R @@ -196,7 +196,12 @@ } #' @keywords internal -.get_marginaleffects_rvar <- function(object) { +.get_marginaleffects_draws <- function(object) { # errors and checks are handled by marginaleffects - marginaleffects::posterior_draws(object, shape = "rvar")[["rvar"]] -} \ No newline at end of file + posterior_draws <- attr(object, "posterior_draws") + if (is.null(posterior_draws)) { + insight::format_warning("Could not find posterior draws. The object produced by the `marginaleffects` package was not based on a bayesian model.") + } + as.data.frame(t(posterior_draws)) +} + diff --git a/R/utils_bayesfactor.R b/R/utils_bayesfactor.R index a97ef30e9..1992c63f8 100644 --- a/R/utils_bayesfactor.R +++ b/R/utils_bayesfactor.R @@ -179,6 +179,28 @@ ) } +.clean_priors_and_posteriors.slopes <- function(posterior, prior, + verbose = TRUE, ...) { + if (is.null(prior)) { + prior <- posterior + if (verbose) { + insight::format_warning("Prior not specified! Please provide the original model to get meaningful results.") + } + } + + posterior <- .get_marginaleffects_draws(posterior) + prior <- .get_marginaleffects_draws(prior) + + list( + posterior = posterior, + prior = prior + ) +} + +.clean_priors_and_posteriors.predictions <- .clean_priors_and_posteriors.slopes + +.clean_priors_and_posteriors.comparisons <- .clean_priors_and_posteriors.slopes + # BMA --------------------------------------------------------------------- diff --git a/man/bayesfactor_parameters.Rd b/man/bayesfactor_parameters.Rd index f44a6652c..a29ee8d37 100644 --- a/man/bayesfactor_parameters.Rd +++ b/man/bayesfactor_parameters.Rd @@ -239,6 +239,9 @@ It is important to provide the correct \code{prior} for meaningful results. the priors \emph{only}. See \code{\link[=unupdate]{unupdate()}}. \item \strong{Note:} When \code{posterior} is a \code{brmsfit_multiple} model, \code{prior} \strong{must} be provided. } +\item When \code{posterior} is an output from a \code{{marginaleffects}} function, \code{prior} should also be an an output +from a \code{{marginaleffects}} function equivalent to \code{posterior} but created +with a model of priors samples \emph{only}. \item When \code{posterior} is an \code{emmGrid} / \code{emm_list} object: \itemize{ \item \code{prior} should also be an \code{emmGrid} / \code{emm_list} object equivalent to \code{posterior} but diff --git a/man/bayesfactor_restricted.Rd b/man/bayesfactor_restricted.Rd index cf73c6fc8..6ed081598 100644 --- a/man/bayesfactor_restricted.Rd +++ b/man/bayesfactor_restricted.Rd @@ -130,6 +130,9 @@ It is important to provide the correct \code{prior} for meaningful results. the priors \emph{only}. See \code{\link[=unupdate]{unupdate()}}. \item \strong{Note:} When \code{posterior} is a \code{brmsfit_multiple} model, \code{prior} \strong{must} be provided. } +\item When \code{posterior} is an output from a \code{{marginaleffects}} function, \code{prior} should also be an an output +from a \code{{marginaleffects}} function equivalent to \code{posterior} but created +with a model of priors samples \emph{only}. \item When \code{posterior} is an \code{emmGrid} / \code{emm_list} object: \itemize{ \item \code{prior} should also be an \code{emmGrid} / \code{emm_list} object equivalent to \code{posterior} but diff --git a/man/si.Rd b/man/si.Rd index c6f769240..45e87e7c3 100644 --- a/man/si.Rd +++ b/man/si.Rd @@ -161,6 +161,9 @@ It is important to provide the correct \code{prior} for meaningful results. the priors \emph{only}. See \code{\link[=unupdate]{unupdate()}}. \item \strong{Note:} When \code{posterior} is a \code{brmsfit_multiple} model, \code{prior} \strong{must} be provided. } +\item When \code{posterior} is an output from a \code{{marginaleffects}} function, \code{prior} should also be an an output +from a \code{{marginaleffects}} function equivalent to \code{posterior} but created +with a model of priors samples \emph{only}. \item When \code{posterior} is an \code{emmGrid} / \code{emm_list} object: \itemize{ \item \code{prior} should also be an \code{emmGrid} / \code{emm_list} object equivalent to \code{posterior} but diff --git a/tests/testthat/test-marginaleffects.R b/tests/testthat/test-marginaleffects.R new file mode 100644 index 000000000..7ba12eb1f --- /dev/null +++ b/tests/testthat/test-marginaleffects.R @@ -0,0 +1,61 @@ + +test_that("emmGrid descrive_posterior", { + skip_on_ci() + skip_on_cran() + + skip_if_not_installed("rstanarm") + skip_if_not_installed("marginaleffects") + + data("mtcars") + mtcars$cyl <- factor(mtcars$cyl) + mod <- rstanarm::stan_glm(mpg ~ cyl + hp * am, data = mtcars, refresh = 0) + + mfx <- marginaleffects::avg_slopes(mod, by = "am") + mfx_samps <- as.data.frame(t(attr(mfx, "posterior_draws"))) + + results <- describe_posterior(mfx, centrality = "MAP", ci_method = "hdi", + test = c("pd", "rope", "p_map", "equivalence_test")) + results_draws <- describe_posterior(mfx_samps, centrality = "MAP", ci_method = "hdi", + test = c("pd", "rope", "p_map", "equivalence_test")) + + expect_true(all(c("term", "contrast") %in% colnames(results))) + expect_equal(results[setdiff(colnames(results), c("term", "contrast"))], + results_draws[setdiff(colnames(results_draws), "Parameter")], + ignore_attr = TRUE) +}) + +test_that("emmGrid bayesfactors", { + skip_on_ci() + skip_on_cran() + + skip_if_not_installed("rstanarm") + skip_if_not_installed("marginaleffects") + + data("mtcars") + mtcars$cyl <- factor(mtcars$cyl) + mod <- rstanarm::stan_glm(mpg ~ cyl + hp * am, data = mtcars, refresh = 0) + modp <- unupdate(mod) + + mfx <- marginaleffects::avg_slopes(mod, by = "am") + mfxp <- marginaleffects::avg_slopes(modp, by = "am") + + mfx_samps <- as.data.frame(t(attr(mfx, "posterior_draws"))) + mfxp_samps <- as.data.frame(t(attr(mfxp, "posterior_draws"))) + + # SI + outsi <- si(mfx, prior = mfxp, verbose = FALSE) + outsiref <- si(mfx_samps, prior = mfxp_samps, verbose = FALSE) + + expect_true(all(c("term", "contrast") %in% colnames(outsi))) + expect_equal(outsi[setdiff(colnames(outsi), c("term", "contrast"))], + outsiref[setdiff(colnames(outsiref), "Parameter")], + ignore_attr = TRUE) + + # bayesfactor_parameters + bfp <- bayesfactor_parameters(mfx, prior = mfxp, verbose = FALSE) + bfpref <- bayesfactor_parameters(mfx_samps, prior = mfxp_samps, verbose = FALSE) + expect_equal(bfp[setdiff(colnames(bfp), c("term", "contrast"))], + bfpref[setdiff(colnames(bfpref), "Parameter")], + ignore_attr = TRUE) + +}) From 05bd7599afc3dbe3056df18d6e3039714eaeae86 Mon Sep 17 00:00:00 2001 From: "Mattan S. Ben-Shachar" Date: Wed, 4 Sep 2024 15:15:01 +0300 Subject: [PATCH 12/15] estimate_density.slopes --- NAMESPACE | 3 +++ R/estimate_density.R | 31 +++++++++++++++++++++++++++ tests/testthat/test-marginaleffects.R | 12 +++++++++++ 3 files changed, 46 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 9896af5c0..76db6d047 100644 --- 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 index f33538c19..80329b599 100644 --- 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 index 7ba12eb1f..faa4ff48a 100644 --- 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", { From eda3b1500c376c1637eba50eb237387b313f462d Mon Sep 17 00:00:00 2001 From: Daniel Date: Wed, 4 Sep 2024 15:34:10 +0200 Subject: [PATCH 13/15] some minor edits (lintrs) --- R/estimate_density.R | 18 +++++++++--------- R/format.R | 12 ++++++++---- tests/testthat/test-emmGrid.R | 26 +++++++++++++------------- 3 files changed, 30 insertions(+), 26 deletions(-) diff --git a/R/estimate_density.R b/R/estimate_density.R index 80329b599..a8307c37c 100644 --- a/R/estimate_density.R +++ b/R/estimate_density.R @@ -376,9 +376,9 @@ estimate_density.emmGrid <- function(x, ) # 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") + dgrid <- insight::get_datagrid(x) + dgrid$Parameter <- unique(out$Parameter) + out <- datawizard::data_join(dgrid, out, by = "Parameter") out$Parameter <- NULL class(out) <- .set_density_class(out) out @@ -398,15 +398,15 @@ estimate_density.slopes <- function(x, xdf <- .get_marginaleffects_draws(x) out <- estimate_density(xdf, - method = method, precision = precision, - extend = extend, extend_scale = extend_scale, - bw = bw, ... + 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") + dgrid <- insight::get_datagrid(x) + dgrid$Parameter <- unique(out$Parameter) + out <- datawizard::data_join(dgrid, out, by = "Parameter") out$Parameter <- NULL class(out) <- .set_density_class(out) out diff --git a/R/format.R b/R/format.R index 15c205e48..3d81e4734 100644 --- a/R/format.R +++ b/R/format.R @@ -103,7 +103,8 @@ format.bayesfactor_models <- function(x, BFE$log_BF <- as.numeric(x, log = log) BFE$BF <- insight::format_bf(abs(BFE$log_BF), name = NULL, exact = exact, ...) - if (any((sgn <- sign(BFE$log_BF) < 0)[!is.na(BFE$log_BF)])) { + sgn <- sign(BFE$log_BF) + if (any((sgn < 0)[!is.na(BFE$log_BF)])) { BFE$BF[sgn] <- paste0("-", BFE$BF[sgn]) } @@ -170,7 +171,8 @@ format.bayesfactor_inclusion <- function(x, BFE$log_BF <- as.numeric(x, log = log) BFE$BF <- insight::format_bf(abs(BFE$log_BF), name = NULL, exact = exact, ...) - if (any((sgn <- sign(BFE$log_BF) < 0)[!is.na(BFE$log_BF)])) { + sgn <- sign(BFE$log_BF) + if (any((sgn < 0)[!is.na(BFE$log_BF)])) { BFE$BF[sgn] <- paste0("-", BFE$BF[sgn]) } @@ -221,7 +223,8 @@ format.bayesfactor_restricted <- function(x, BFE$log_BF <- as.numeric(x, log = log) BFE$BF <- insight::format_bf(abs(BFE$log_BF), name = NULL, exact = exact, ...) - if (any((sgn <- sign(BFE$log_BF) < 0)[!is.na(BFE$log_BF)])) { + sgn <- sign(BFE$log_BF) + if (any((sgn < 0)[!is.na(BFE$log_BF)])) { BFE$BF[sgn] <- paste0("-", BFE$BF[sgn]) } BFE$log_BF <- NULL @@ -267,7 +270,8 @@ format.bayesfactor_parameters <- function(x, x$BF_override <- insight::format_bf(abs(x$log_BF), name = NULL, exact = exact, ...) - if (any((sgn <- sign(x$log_BF) < 0)[!is.na(x$log_BF)])) { + sgn <- sign(x$log_BF) + if (any((sgn < 0)[!is.na(x$log_BF)])) { x$BF_override[sgn] <- paste0("-", x$BF_override[sgn]) } x$log_BF <- NULL diff --git a/tests/testthat/test-emmGrid.R b/tests/testthat/test-emmGrid.R index 672b2ea58..ed05ad940 100644 --- a/tests/testthat/test-emmGrid.R +++ b/tests/testthat/test-emmGrid.R @@ -49,65 +49,65 @@ test_that("emmGrid point_estimate", { test_that("emmGrid ci", { xci <- ci(all_, ci = 0.9) expect_identical(colnames(xci)[1:2], c("group", "contrast")) - expect_equal(length(xci$CI_low), 3) - expect_equal(length(xci$CI_high), 3) + expect_length(xci$CI_low, 3) + expect_length(xci$CI_high, 3) }) test_that("emmGrid eti", { xeti <- eti(all_, ci = 0.9) expect_identical(colnames(xeti)[1:2], c("group", "contrast")) - expect_equal(length(xeti$CI_low), 3) - expect_equal(length(xeti$CI_high), 3) + expect_length(xeti$CI_low, 3) + expect_length(xeti$CI_high, 3) }) test_that("emmGrid equivalence_test", { xeqtest <- equivalence_test(all_, ci = 0.9, range = c(-0.1, 0.1)) expect_identical(colnames(xeqtest)[1:2], c("group", "contrast")) - expect_equal(length(xeqtest$ROPE_Percentage), 3) - expect_equal(length(xeqtest$ROPE_Equivalence), 3) + expect_length(xeqtest$ROPE_Percentage, 3) + expect_length(xeqtest$ROPE_Equivalence, 3) }) test_that("emmGrid estimate_density", { xestden <- estimate_density(c_, method = "logspline", precision = 5) expect_identical(colnames(xestden)[1], "contrast") - expect_equal(length(xestden$x), 5) + expect_length(xestden$x, 5) }) test_that("emmGrid map_estimate", { xmapest <- map_estimate(all_, method = "kernel") expect_identical(colnames(xmapest)[1:2], c("group", "contrast")) - expect_equal(length(xmapest$MAP_Estimate), 3) + expect_length(xmapest$MAP_Estimate, 3) }) test_that("emmGrid p_direction", { xpd <- p_direction(all_, method = "direct") expect_identical(colnames(xpd)[1:2], c("group", "contrast")) - expect_equal(length(xpd$pd), 3) + expect_length(xpd$pd, 3) }) test_that("emmGrid p_map", { xpmap <- p_map(all_, precision = 2^9) expect_identical(colnames(xpmap)[1:2], c("group", "contrast")) - expect_equal(length(xpmap$p_MAP), 3) + expect_length(xpmap$p_MAP, 3) }) test_that("emmGrid p_rope", { xprope <- p_rope(all_, range = c(-0.1, 0.1)) expect_identical(colnames(xprope)[1:2], c("group", "contrast")) - expect_equal(length(xprope$p_ROPE), 3) + expect_length(xprope$p_ROPE, 3) }) test_that("emmGrid p_significance", { xsig <- p_significance(all_, threshold = c(-0.1, 0.1)) expect_identical(colnames(xsig)[1:2], c("group", "contrast")) - expect_equal(length(xsig$ps), 3) + expect_length(xsig$ps, 3) }) test_that("emmGrid rope", { xrope <- rope(all_, range = "default", ci = 0.9) expect_identical(colnames(xrope)[1:2], c("group", "contrast")) - expect_equal(length(xrope$ROPE_Percentage), 3) + expect_length(xrope$ROPE_Percentage, 3) }) From a872a7113f538bf0a245cf3d493200a1ad3dcd62 Mon Sep 17 00:00:00 2001 From: "Mattan S. Ben-Shachar" Date: Wed, 4 Sep 2024 22:03:08 +0300 Subject: [PATCH 14/15] simplify code --- R/utils.R | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/R/utils.R b/R/utils.R index 77e7100fb..374a04fdc 100644 --- a/R/utils.R +++ b/R/utils.R @@ -198,10 +198,6 @@ #' @keywords internal .get_marginaleffects_draws <- function(object) { # errors and checks are handled by marginaleffects - posterior_draws <- attr(object, "posterior_draws") - if (is.null(posterior_draws)) { - insight::format_warning("Could not find posterior draws. The object produced by the `marginaleffects` package was not based on a bayesian model.") - } - as.data.frame(t(posterior_draws)) + insight::check_if_installed("marginaleffects") + data.frame(marginaleffects::posterior_draws(object, shape = "DxP")) } - From 50787734aff34602c0323e60cb0bfd9e31272111 Mon Sep 17 00:00:00 2001 From: "Mattan S. Ben-Shachar" Date: Wed, 4 Sep 2024 22:03:12 +0300 Subject: [PATCH 15/15] styler --- R/describe_posterior.R | 2 +- tests/testthat/test-marginaleffects.R | 41 ++++++++++++++++----------- 2 files changed, 25 insertions(+), 18 deletions(-) diff --git a/R/describe_posterior.R b/R/describe_posterior.R index 37b13bfd8..56b3c8432 100644 --- a/R/describe_posterior.R +++ b/R/describe_posterior.R @@ -837,7 +837,7 @@ describe_posterior.slopes <- function(posterior, verbose = TRUE, ...) { if (any(c("all", "bf", "bayesfactor", "bayes_factor") %in% tolower(test)) || - "si" %in% tolower(ci_method)) { + "si" %in% tolower(ci_method)) { samps <- .clean_priors_and_posteriors(posterior, bf_prior, verbose = verbose) bf_prior <- samps$prior posterior_samples <- samps$posterior diff --git a/tests/testthat/test-marginaleffects.R b/tests/testthat/test-marginaleffects.R index faa4ff48a..11be99559 100644 --- a/tests/testthat/test-marginaleffects.R +++ b/tests/testthat/test-marginaleffects.R @@ -1,4 +1,3 @@ - test_that("emmGrid descrive_posterior", { skip_on_ci() skip_on_cran() @@ -13,27 +12,34 @@ test_that("emmGrid descrive_posterior", { mfx <- marginaleffects::avg_slopes(mod, by = "am") mfx_samps <- as.data.frame(t(attr(mfx, "posterior_draws"))) - results <- describe_posterior(mfx, centrality = "MAP", ci_method = "hdi", - test = c("pd", "rope", "p_map", "equivalence_test")) - results_draws <- describe_posterior(mfx_samps, centrality = "MAP", ci_method = "hdi", - test = c("pd", "rope", "p_map", "equivalence_test")) + results <- describe_posterior(mfx, + centrality = "MAP", ci_method = "hdi", + test = c("pd", "rope", "p_map", "equivalence_test") + ) + results_draws <- describe_posterior(mfx_samps, + centrality = "MAP", ci_method = "hdi", + test = c("pd", "rope", "p_map", "equivalence_test") + ) expect_true(all(c("term", "contrast") %in% colnames(results))) expect_equal(results[setdiff(colnames(results), c("term", "contrast"))], - results_draws[setdiff(colnames(results_draws), "Parameter")], - ignore_attr = TRUE) + 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)) + 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) - + resref[intersect(colnames(res), colnames(resref))], + ignore_attr = TRUE + ) }) test_that("emmGrid bayesfactors", { @@ -60,14 +66,15 @@ test_that("emmGrid bayesfactors", { expect_true(all(c("term", "contrast") %in% colnames(outsi))) expect_equal(outsi[setdiff(colnames(outsi), c("term", "contrast"))], - outsiref[setdiff(colnames(outsiref), "Parameter")], - ignore_attr = TRUE) + outsiref[setdiff(colnames(outsiref), "Parameter")], + ignore_attr = TRUE + ) # bayesfactor_parameters bfp <- bayesfactor_parameters(mfx, prior = mfxp, verbose = FALSE) bfpref <- bayesfactor_parameters(mfx_samps, prior = mfxp_samps, verbose = FALSE) expect_equal(bfp[setdiff(colnames(bfp), c("term", "contrast"))], - bfpref[setdiff(colnames(bfpref), "Parameter")], - ignore_attr = TRUE) - + bfpref[setdiff(colnames(bfpref), "Parameter")], + ignore_attr = TRUE + ) })