Merge branch 'main' into strengejacke/issue594

Author: strengejacke

R/estimate_slopes.R

@@ -109,7 +109,7 @@
 #' @examplesIf all(insight::check_if_installed(c("marginaleffects", "emmeans"), quietly = TRUE)) && getRversion() >= "4.5.0"
 #' \dontrun{
 #' # marginal effects with different `estimate` options
-#' data(penguins)
+#' data(penguins, package = "datasets")
 #' penguins$long_bill <- factor(datawizard::categorize(penguins$bill_len), labels = c("short", "long"))
 #' m <- glm(long_bill ~ sex + species + island * bill_dep, data = penguins, family = "binomial")
 #'

R/p_adjust.R

@@ -8,9 +8,17 @@
 
   # extract information
   datagrid <- attributes(params)$datagrid
-  focal <- .safe(insight::trim_ws(gsub("=.*", "\\1", attributes(params)$contrast)))
+
+  # when contrasting slopes, we need "by" as focal term
+  if (inherits(params, "estimate_slopes")) {
+    focal <- .safe(insight::trim_ws(gsub("=.*", "\\1", attributes(params)$by)))
+  } else {
+    focal <- .safe(insight::trim_ws(gsub("=.*", "\\1", attributes(params)$contrast)))
+  }
+
   # extract degrees of freedom
   dof <- .safe(params$df[1])
+
   if (is.null(dof)) {
     dof <- insight::get_df(model, type = "wald", verbose = FALSE)
   }

man/estimate_slopes.Rd

@@ -703,7 +703,7 @@ test_that("estimate_contrasts - p.adjust", {
   skip_if(getRversion() < "4.5.0")
   skip_if_not_installed("emmeans")
 
-  data(penguins)
+  data(penguins, package = "datasets")
   m_spec <- lm(body_mass ~ species, data = penguins)
   out1 <- estimate_contrasts(m_spec, p_adjust = "tukey")
   out2 <- estimate_contrasts(m_spec, p_adjust = "tukey", backend = "emmeans")
@@ -1709,7 +1709,7 @@ test_that("estimate_contrast, informative error when `by` and `contrast` are the
 
 test_that("estimate_contrast, works with aov (when no statistic is extracted)", {
   skip_if(getRversion() < "4.5.0")
-  data(penguins)
+  data(penguins, package = "datasets")
   fit <- aov(formula = body_mass ~ species, data = penguins)
 
   out1 <- marginaleffects::avg_predictions(fit, by = "species", hypothesis = ~pairwise)
@@ -1736,7 +1736,7 @@ test_that("estimate_contrast, works with aov (when no statistic is extracted)",
 test_that("estimate_contrast, slopes with different estimate options", {
   skip_if(getRversion() < "4.5.0")
   skip_if_not_installed("datawizard")
-  data(penguins)
+  data(penguins, package = "datasets")
   penguins$long_bill <- factor(
     datawizard::categorize(penguins$bill_len),
     labels = c("short", "long")
@@ -1766,3 +1766,26 @@ test_that("estimate_contrast, comparison-options as strings", {
   out <- estimate_contrasts(mod2, contrast = "cyl_helmert", comparison = "poly")
   expect_equal(out$Difference, c(-8.17673, 0.92996), tolerance = 1e-4)
 })
+
+
+test_that("estimate_contrast, p-adjust tukey works for contrasting slopes", {
+  skip_if(getRversion() < "4.5.0")
+  skip_if_not_installed("emmeans")
+
+  data(penguins, package = "datasets")
+  m <- lm(flipper_len ~ body_mass * species, data = penguins)
+
+  out1 <- as.data.frame(pairs(emmeans::emtrends(m, ~species, var = "body_mass")))
+  out2 <- estimate_contrasts(
+    m,
+    contrast = "body_mass",
+    by = "species",
+    p_adjust = "tukey"
+  )
+
+  # Note: p-values from emmeans::emtrends() + pairs() and estimate_contrasts()
+  # can differ slightly due to different underlying calculation/adjustment
+  # methods, especially with Tukey p-adjustment. A tolerance of 1e-2 is used
+  # here to avoid fragile tests while still ensuring close agreement.
+  expect_equal(out1$p.value, out2$p, tolerance = 1e-2)
+})

tests/testthat/test-estimate_contrasts.R

@@ -7,7 +7,7 @@ skip_if_not_installed("datawizard")
 
 
 test_that("estimate_contrast, marginal effects inequalities", {
-  data(penguins)
+  data(penguins, package = "datasets")
   penguins$long_bill <- factor(
     datawizard::categorize(penguins$bill_len),
     labels = c("short", "long")
@@ -88,14 +88,22 @@ test_that("estimate_contrast, marginal effects inequalities", {
     tolerance = 1e-4,
     ignore_attr = TRUE
   )
-  expect_named(out, c("Parameter", "Mean_Difference", "SE", "CI_low", "CI_high", "z", "p"))
+  expect_named(
+    out,
+    c("Parameter", "Mean_Difference", "SE", "CI_low", "CI_high", "z", "p")
+  )
   expect_identical(
     out$Parameter,
     c("Biscoe - Dream", "Biscoe - Torgersen", "Dream - Torgersen")
   )
 
   # pairwise inequality comparisons with `by`
-  out <- estimate_contrasts(m, "species", by = "island", comparison = "inequality_pairwise")
+  out <- estimate_contrasts(
+    m,
+    "species",
+    by = "island",
+    comparison = "inequality_pairwise"
+  )
   expect_equal(
     out$Mean_Difference,
     c(0.127399, 0.000135, -0.127264),
@@ -110,7 +118,11 @@ test_that("estimate_contrast, marginal effects inequalities", {
   )
 
   # check formula interface for grouping
-  m <- glm(long_bill ~ species * sex * island + bill_dep, data = penguins, family = "binomial")
+  m <- glm(
+    long_bill ~ species * sex * island + bill_dep,
+    data = penguins,
+    family = "binomial"
+  )
   out <- suppressWarnings(estimate_contrasts(
     m,
     "species",
@@ -153,7 +165,11 @@ test_that("estimate_contrast, marginal effects inequalities", {
   expect_identical(dim(out), c(60L, 9L))
 
   # contrasting slopes
-  m <- glm(long_bill ~ sex + species + island * bill_dep, data = penguins, family = "binomial")
+  m <- glm(
+    long_bill ~ sex + species + island * bill_dep,
+    data = penguins,
+    family = "binomial"
+  )
   out <- estimate_contrasts(
     m,
     "bill_dep",
@@ -183,15 +199,25 @@ test_that("estimate_contrast, marginal effects inequalities", {
 
 
 test_that("estimate_contrast, inequality ratios", {
-  data(penguins)
+  data(penguins, package = "datasets")
   m <- lm(bill_len ~ species * bill_dep + island, data = penguins)
 
   # pairwise ratios for slopes
   out <- estimate_contrasts(m, "bill_dep", by = "species", comparison = ratio ~ pairwise)
-  expect_equal(out$Ratio, c(2.262453, 2.378612, 1.051342), tolerance = 1e-4, ignore_attr = TRUE)
+  expect_equal(
+    out$Ratio,
+    c(2.262453, 2.378612, 1.051342),
+    tolerance = 1e-4,
+    ignore_attr = TRUE
+  )
 
   # inequality ratios for slopes
-  out <- estimate_contrasts(m, "bill_dep", by = "species", comparison = ratio ~ inequality)
+  out <- estimate_contrasts(
+    m,
+    "bill_dep",
+    by = "species",
+    comparison = ratio ~ inequality
+  )
   expect_equal(out$Mean_Ratio, 1.897469, tolerance = 1e-4, ignore_attr = TRUE)
   expect_identical(out$Parameter, "species")
 
@@ -217,8 +243,18 @@ test_that("estimate_contrast, inequality ratios", {
   expect_identical(as.character(out$sex), c("female", "male"))
 
   # pairwise inequality ratios
-  out <- estimate_contrasts(m, "island", by = "sex", comparison = ratio ~ inequality + pairwise)
-  expect_equal(out$Mean_Ratio_Difference, 0.01355006, tolerance = 1e-4, ignore_attr = TRUE)
+  out <- estimate_contrasts(
+    m,
+    "island",
+    by = "sex",
+    comparison = ratio ~ inequality + pairwise
+  )
+  expect_equal(
+    out$Mean_Ratio_Difference,
+    0.01355006,
+    tolerance = 1e-4,
+    ignore_attr = TRUE
+  )
 })
 
 
@@ -232,16 +268,25 @@ test_that("estimate_contrast, slopes, inequality pairwise", {
   m <- lm(QoL ~ time * education * grp, data = qol_cancer)
 
   # test integer handling
-  expect_silent(
-    estimate_contrasts(m, "time", by = "education", integer_as_continuous = TRUE)
-  )
-  expect_silent(
-    estimate_contrasts(m, "time", by = "education", integer_as_continuous = 2)
-  )
+  expect_silent(estimate_contrasts(
+    m,
+    "time",
+    by = "education",
+    integer_as_continuous = TRUE
+  ))
+  expect_silent(estimate_contrasts(
+    m,
+    "time",
+    by = "education",
+    integer_as_continuous = 2
+  ))
   # we also show no warning when user explicitly sets integer_as_continuous
-  expect_silent(
-    estimate_contrasts(m, "time", by = "education", integer_as_continuous = 10)
-  )
+  expect_silent(estimate_contrasts(
+    m,
+    "time",
+    by = "education",
+    integer_as_continuous = 10
+  ))
   expect_message(
     estimate_contrasts(m, "time", by = "education"),
     regex = "Numeric variable appears to be ordinal"
@@ -268,15 +313,15 @@ test_that("estimate_contrast, slopes, inequality pairwise", {
     estimate = "average"
   )
   out2 <- marginaleffects::hypotheses(
-    marginaleffects::avg_slopes(m, variables = "time", by = "education", hypothesis = ~pairwise),
-    hypothesis = ~I(mean(abs(x)))
-  )
-  expect_equal(
-    out1$Mean_Difference,
-    out2$estimate,
-    tolerance = 1e-4,
-    ignore_attr = TRUE
+    marginaleffects::avg_slopes(
+      m,
+      variables = "time",
+      by = "education",
+      hypothesis = ~pairwise
+    ),
+    hypothesis = ~ I(mean(abs(x)))
   )
+  expect_equal(out1$Mean_Difference, out2$estimate, tolerance = 1e-4, ignore_attr = TRUE)
 
   # inequality with slopes and grouping
   out <- estimate_contrasts(
@@ -286,29 +331,39 @@ test_that("estimate_contrast, slopes, inequality pairwise", {
     comparison = ~inequality,
     integer_as_continuous = TRUE
   )
-  expect_equal(out$Mean_Difference, c(4.742403, 2.883987), tolerance = 1e-4, ignore_attr = TRUE)
+  expect_equal(
+    out$Mean_Difference,
+    c(4.742403, 2.883987),
+    tolerance = 1e-4,
+    ignore_attr = TRUE
+  )
   expect_identical(out$Parameter, c("education: Group 1", "education: Group 2"))
 
   # inequality with slopes and grouping, using formula interface
   out <- estimate_contrasts(
     m,
     "time",
     by = c("education", "grp"),
-    comparison = ~inequality | grp,
+    comparison = ~ inequality | grp,
     integer_as_continuous = TRUE
   )
-  expect_equal(out$Mean_Difference, c(4.742403, 2.883987), tolerance = 1e-4, ignore_attr = TRUE)
+  expect_equal(
+    out$Mean_Difference,
+    c(4.742403, 2.883987),
+    tolerance = 1e-4,
+    ignore_attr = TRUE
+  )
   expect_identical(out$Parameter, c("education: Group 1", "education: Group 2"))
 
   # pairwise inequality with slopes and grouping
   out <- estimate_contrasts(
     m,
     "time",
     by = c("education", "grp"),
-    comparison = inequality ~ pairwise| grp,
+    comparison = inequality ~ pairwise | grp,
     integer_as_continuous = TRUE
   )
-  expect_equal(out$Mean_Difference,  1.858416, tolerance = 1e-4, ignore_attr = TRUE)
+  expect_equal(out$Mean_Difference, 1.858416, tolerance = 1e-4, ignore_attr = TRUE)
   expect_identical(out$Parameter, "Group 1 - Group 2")
 
   # validate against marginaleffects
@@ -321,15 +376,15 @@ test_that("estimate_contrast, slopes, inequality pairwise", {
     integer_as_continuous = TRUE
   )
   out2 <- marginaleffects::hypotheses(
-    marginaleffects::avg_slopes(m, variables = "time", by = c("education", "grp"), hypothesis = ~pairwise | grp),
-    hypothesis = ~I(mean(abs(x))) | grp
-  )
-  expect_equal(
-    out1$Mean_Difference,
-    out2$estimate,
-    tolerance = 1e-4,
-    ignore_attr = TRUE
+    marginaleffects::avg_slopes(
+      m,
+      variables = "time",
+      by = c("education", "grp"),
+      hypothesis = ~ pairwise | grp
+    ),
+    hypothesis = ~ I(mean(abs(x))) | grp
   )
+  expect_equal(out1$Mean_Difference, out2$estimate, tolerance = 1e-4, ignore_attr = TRUE)
 
   # pairwise inequality with slopes and grouping, using string
   out <- estimate_contrasts(
@@ -359,7 +414,12 @@ test_that("estimate_contrast, slopes, inequality pairwise", {
     comparison = ratio ~ inequality,
     integer_as_continuous = TRUE
   )
-  expect_equal(out$Mean_Ratio, c(0.0198939, 1.9717087), tolerance = 1e-4, ignore_attr = TRUE)
+  expect_equal(
+    out$Mean_Ratio,
+    c(0.0198939, 1.9717087),
+    tolerance = 1e-4,
+    ignore_attr = TRUE
+  )
   expect_identical(out$Parameter, c("education: Group 1", "education: Group 2"))
 
   out <- estimate_contrasts(
@@ -375,12 +435,12 @@ test_that("estimate_contrast, slopes, inequality pairwise", {
     m,
     "time",
     by = c("education", "grp"),
-    comparison = ~pairwise | grp,
+    comparison = ~ pairwise | grp,
     integer_as_continuous = TRUE
   )
   expect_identical(dim(out), c(6L, 9L))
   expect_named(
     out,
-    c("Parameter", "grp", "Difference", "SE", "CI_low", "CI_high",  "t", "df", "p")
+    c("Parameter", "grp", "Difference", "SE", "CI_low", "CI_high", "t", "df", "p")
   )
 })

tests/testthat/test-estimate_contrasts_inequality.R

@@ -310,7 +310,7 @@ test_that("estimate_slopes, works with glmmTMB and splines", {
 test_that("estimate_slopes, estimate-argument works", {
   skip_if(getRversion() < "4.5.0")
   skip_if_not_installed("datawizard")
-  data(penguins)
+  data(penguins, package = "datasets")
   penguins$long_bill <- factor(
     datawizard::categorize(penguins$bill_len),
     labels = c("short", "long")

tests/testthat/test-estimate_slopes.R

@@ -24,7 +24,10 @@ test_that("estimate_relation prints ordinal models correctly", {
 
   # keep row column
   out <- suppressWarnings(estimate_relation(m, data = iris[1:3, ], verbose = FALSE))
-  expect_named(out, c("Row", "Response", "Sepal.Width", "Predicted", "CI_low", "CI_high", "Residuals")) # nolint
+  expect_named(
+    out,
+    c("Row", "Response", "Sepal.Width", "Predicted", "CI_low", "CI_high", "Residuals")
+  )
   expect_identical(dim(out), c(9L, 7L))
 })
 
@@ -34,7 +37,7 @@ test_that("estimate_means, print bracl", {
   # required for the penguins dataset, which was added in R 4.5.0
   skip_if(getRversion() < "4.5.0")
 
-  data(penguins)
+  data(penguins, package = "datasets")
 
   m <- brglm2::bracl(species ~ island + sex, data = penguins)
   out <- estimate_means(m, by = "island")