Next fix

Author: strengejacke

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: parameters
 Title: Processing of Model Parameters
-Version: 0.28.0.9
+Version: 0.28.0.10
 Authors@R:
     c(person(given = "Daniel",
              family = "Lüdecke",

R/methods_marginaleffects.R

@@ -32,7 +32,21 @@ model_parameters.marginaleffects <- function(model,
       colnames(marginaleffects::components(model, "modeldata"))
     )
     # columns we want to keep
-    by_cols <- marginaleffects::components(model, "variable_names_by")
+    by_cols <- union(
+      marginaleffects::components(model, "variable_names_by"),
+      marginaleffects::components(model, "variable_names_by_hypothesis")
+    )
+
+    ## FIXME: hack to workaround https://github.com/vincentarelbundock/marginaleffects/issues/1573
+    duplicated_names <- grep(
+      paste0("(", paste0(by_cols, "\\.\\d+", collapse = "|"), ")"),
+      colnames(tidy_model),
+      value = TRUE
+    )
+    # if we have duplicated "by" columns, we want to remove those as well
+    if (length(duplicated_names) > 0) {
+      all_data_cols <- c(all_data_cols, duplicated_names)
+    }
 
     # remove redundant columns
     to_remove <- setdiff(all_data_cols, by_cols)
@@ -126,6 +140,23 @@ model_parameters.predictions <- function(model,
       ...
     ))
   } else {
+    # columns we want to keep
+    by_cols <- union(
+      marginaleffects::components(model, "variable_names_by"),
+      marginaleffects::components(model, "variable_names_by_hypothesis")
+    )
+
+    ## FIXME: hack to workaround https://github.com/vincentarelbundock/marginaleffects/issues/1573
+    duplicated_names <- grep(
+      paste0("(", paste0(by_cols, "\\.\\d+", collapse = "|"), ")"),
+      colnames(model),
+      value = TRUE
+    )
+    # if we have duplicated "by" columns, we want to remove those as well
+    if (length(duplicated_names) > 0) {
+      model[duplicated_names] <- NULL
+    }
+
     # handle non-Bayesian models
     out <- .rename_reserved_marginaleffects(model)
     out <- datawizard::data_rename(out, "estimate", "predicted")

tests/testthat/test-marginaleffects.R

@@ -181,6 +181,7 @@ test_that("predictions, bmrs with special response formula", {
   skip_if_offline()
   skip_if_not_installed("httr2")
   skip_if_not_installed("brms")
+  skip_if_not_installed("marginaleffects", minimum_version = "0.28.0.21")
 
   m <- insight::download_model("brms_ipw_1")
   skip_if(is.null(m))
@@ -190,6 +191,29 @@ test_that("predictions, bmrs with special response formula", {
   expect_identical(dim(out), c(1L, 10L))
 })
 
+
+test_that("modelbased, tidiers work", {
+  skip_if_not_installed("marginaleffects", minimum_version = "0.28.0.21")
+  skip_if_not_installed("modelbased")
+  skip_if(getRversion() < "4.5.0")
+
+  data(penguins)
+  m <- lm(bill_len ~ island * sex + bill_dep + species, data = penguins)
+
+  ## FIXME: Need to wait for https://github.com/vincentarelbundock/marginaleffects/issues/1573
+  out <- modelbased::estimate_contrasts(m, "island", by = "sex", comparison = ratio ~ pairwise)
+  expect_named(
+    out,
+    c("Level1", "Level2", "sex", "Ratio", "SE", "CI_low", "CI_high", "t", "df", "p")
+  )
+  expect_identical(dim(out), c(6L, 10L))
+
+  out <- modelbased::estimate_contrasts(m, "island", by = "sex", comparison = ratio ~ inequality)
+  expect_named(out, c("sex", "Mean_Ratio", "SE", "CI_low", "CI_high", "z", "p"))
+  expect_identical(dim(out), c(2L, 7L))
+})
+
+
 ## TODO: check this test locally
 
 # Following test may fail on CI, probably due to scoping issues?
@@ -210,6 +234,7 @@ test_that("predictions, using bayestestR #1063", {
   skip_if_offline()
   skip_if_not_installed("httr2")
   skip_if_not_installed("brms")
+  skip_if_not_installed("marginaleffects", minimum_version = "0.28.0.21")
 
   m <- insight::download_model("brms_mixed_3")
   skip_if(is.null(m))