Contrasting slopes: differences between backends (#393)

* Contrasting slopes: differences between backends
Fixes #333

* fix

* comment

* fix

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: modelbased
 Title: Estimation of Model-Based Predictions, Contrasts and Means
-Version: 0.9.0.16
+Version: 0.9.0.17
 Authors@R:
     c(person(given = "Dominique",
              family = "Makowski",

NEWS.md

@@ -46,6 +46,8 @@
 
 * Fixed issues with plotting ordinal or multinomial models.
 
+* Fixed issues with contrasting slopes when `backend` was `"emmeans"`.
+
 # modelbased 0.9.0
 
 ## Breaking Changes

R/get_emcontrasts.R

@@ -9,12 +9,10 @@
 #' model <- lm(Sepal.Width ~ Species * Petal.Width, data = iris)
 #' # By default: selects first factor
 #' get_emcontrasts(model)
-#' # Can also run contrasts between points of numeric
-#' get_emcontrasts(model, contrast = "Petal.Width", length = 3)
 #' # Or both
 #' get_emcontrasts(model, contrast = c("Species", "Petal.Width"), length = 2)
 #' # Or with custom specifications
-#' estimate_contrasts(model, contrast = c("Species", "Petal.Width=c(1, 2)"))
+#' get_emcontrasts(model, contrast = c("Species", "Petal.Width=c(1, 2)"))
 #' # Or modulate it
 #' get_emcontrasts(model, by = "Petal.Width", length = 4)
 #' }
@@ -36,30 +34,58 @@ get_emcontrasts <- function(model,
     predict <- transform
   }
 
+  # check whether contrasts should be made for numerics or categorical
+  model_data <- insight::get_data(model, source = "mf", verbose = FALSE)
+  on_the_fly_factors <- attributes(model_data)$factors
+
   # Guess arguments
   my_args <- .guess_emcontrasts_arguments(model, contrast, by, verbose, ...)
 
   # find default response-type
   predict <- .get_emmeans_type_argument(model, predict, type = "contrasts", ...)
 
-  # Run emmeans
-  estimated <- emmeans::emmeans(
-    model,
-    specs = my_args$emmeans_specs,
-    at = my_args$emmeans_at,
-    type = predict,
-    ...
-  )
+  # extract first focal term
+  first_focal <- my_args$contrast[1]
+
+  # if first focal term is numeric, we contrast slopes
+  if (is.numeric(model_data[[first_focal]]) &&
+    !first_focal %in% on_the_fly_factors &&
+    # if these are identical, only slopes are contrasted - we need emmeans then
+    !identical(my_args$by, my_args$contrast)) {
+    # sanity check - contrast for slopes only makes sense when we have a "by" argument
+    if (is.null(my_args$by)) {
+      insight::format_error("Please specify the `by` argument to calculate contrasts of slopes.") # nolint
+    }
+    # Run emmeans
+    estimated <- emmeans::emtrends(
+      model,
+      specs = my_args$by,
+      var = my_args$contrast,
+      type = predict,
+      ...
+    )
+    emm_by <- NULL
+  } else {
+    # Run emmeans
+    estimated <- emmeans::emmeans(
+      model,
+      specs = my_args$emmeans_specs,
+      at = my_args$emmeans_at,
+      type = predict,
+      ...
+    )
+    # Find by variables
+    emm_by <- my_args$emmeans_specs[!my_args$emmeans_specs %in% my_args$contrast]
+    if (length(emm_by) == 0) {
+      emm_by <- NULL
+    }
+  }
 
   # If means are on the response scale (e.g., probabilities), need to regrid
   if (predict == "response") {
     estimated <- emmeans::regrid(estimated)
   }
 
-  # Find by variables
-  emm_by <- my_args$emmeans_specs[!my_args$emmeans_specs %in% my_args$contrast]
-  if (length(emm_by) == 0) emm_by <- NULL
-
   out <- emmeans::contrast(estimated, by = emm_by, method = comparison, ...)
 
   attr(out, "contrast") <- my_args$contrast

tests/testthat/test-estimate_contrasts.R

@@ -739,3 +739,18 @@ test_that("estimate_contrast, full averaging", {
   out <- estimate_contrasts(m, "c161sex", by = "c172code", estimate = "average")
   expect_equal(out$Difference, c(1.09591, 0.68736, 0.92224), tolerance = 1e-4)
 })
+
+
+test_that("estimate_contrast, slopes with emmeans", {
+  data(iris)
+  model <- lm(Petal.Width ~ Petal.Length * Species, data = iris)
+  out <- estimate_contrasts(
+    model,
+    contrast = "Petal.Length",
+    by = "Species",
+    backend = "emmeans"
+  )
+  expect_identical(dim(out), c(3L, 9L))
+  expect_equal(out$Difference, c(-0.12981, 0.04095, 0.17076), tolerance = 1e-4)
+  expect_identical(as.character(out$Level1), c("setosa", "setosa", "versicolor"))
+})