Add proper control-info for marginalize = "individual"

R/estimate_contrasts.R

@@ -149,7 +149,7 @@ estimate_contrasts <- function(model,
 
   # Table formatting
   attr(out, "table_title") <- c(ifelse(
-    marginalize == "individual",
+    marginalize == "specific",
     "Model-based Contrasts Analysis",
     "Marginal Contrasts Analysis"
   ), "blue")

R/estimate_means.R

@@ -186,7 +186,7 @@ estimate_means <- function(model,
   # validate input
   marginalize <- insight::validate_argument(
     marginalize,
-    c("average", "population", "individual")
+    c("average", "population", "specific")
   )
 
   if (backend == "emmeans") {
@@ -204,12 +204,13 @@ estimate_means <- function(model,
 
   # Table formatting
   attr(means, "table_title") <- c(ifelse(
-    marginalize == "individual",
+    marginalize == "specific",
     "Model-based Predictions",
     "Estimated Marginal Means"
   ), "blue")
   attr(means, "table_footer") <- .table_footer(
     means,
+    type = ifelse(marginalize == "specific", "predictions", "means"),
     by = info$by,
     model = model,
     info = info

R/get_marginalmeans.R

@@ -41,7 +41,7 @@ get_marginalmeans <- function(model,
   # validate input
   marginalize <- insight::validate_argument(
     marginalize,
-    c("average", "population", "individual")
+    c("average", "population", "specific")
   )
 
   # Guess arguments
@@ -60,7 +60,7 @@ get_marginalmeans <- function(model,
   } else {
     # setup arguments to create the data grid
     dg_factors <- switch(marginalize,
-      individual = "reference",
+      specific = "reference",
       "all"
     )
     dg_args <- list(

R/table_footer.R

@@ -7,7 +7,7 @@
                           model = NULL,
                           info = NULL) {
   # extract necessary information from attributes
   predict <- info$predict
   comparison <- info$comparison
   datagrid <- info$datagrid
   p_adjust <- info$p_adjust
@@ -32,19 +32,26 @@
 
 
   # predictors controlled (non-focal terms) ----------------------------------
-
   if (!is.null(adjusted_for) && length(adjusted_for) >= 1 && !all(is.na(adjusted_for))) {
     # if we have values of adjusted terms, add these here
     if (all(adjusted_for %in% colnames(x))) {
+      ref_cat_data <- x
+    } else if (all(adjusted_for %in% colnames(datagrid))) {
+      ref_cat_data <- datagrid
+    } else {
+      ref_cat_data <- NULL
+    }
+    if (!is.null(ref_cat_data)) {
       # get values at which non-focal terms are hold constant
-      adjusted_values <- sapply(adjusted_for, function(i) {
-        x[[i]][1]
-      })
-      # at values to names of non-focal terms (table_footer)
-      if (is.numeric(adjusted_values)) {
-        adjusted_for <- sprintf("%s (%.2g)", adjusted_for, adjusted_values)
-      } else {
-        adjusted_for <- sprintf("%s (%s)", adjusted_for, adjusted_values)
+      adjusted_values <- lapply(adjusted_for, function(i) ref_cat_data[[i]][1])
+      # at values to names of non-focal terms (table_footer). we have to iterate
+      # over the list, because we may have different types of data
+      for (av in seq_along(adjusted_values)) {
+        if (is.numeric(adjusted_values[[av]])) {
+          adjusted_for[av] <- sprintf("%s (%.2g)", adjusted_for[av], adjusted_values[[av]])
+        } else if (identical(type, "predictions")) {
+          adjusted_for[av] <- sprintf("%s (%s)", adjusted_for[av], adjusted_values[[av]])
+        }
       }
     }
     average_string <- switch(type,
@@ -74,7 +81,7 @@
       "Predictions"
     )
     # exceptions
     predict <- switch(predict,
       none = "link",
       prediction = ,
       expectations = ,

tests/testthat/_snaps/estimate_contrasts.md

@@ -188,7 +188,7 @@
 
       Variable predicted: neg_c_7
       Predictors contrasted: e42dep, c172code
-      Predictors averaged: c12hour, barthtot, c161sex
+      Predictors averaged: c12hour (42), barthtot (65), c161sex
       p-values are uncorrected.
       Parameters:
       b6 = e42dep [slightly dependent], c172code [intermediate level of education]
@@ -393,7 +393,7 @@
 
       Variable predicted: neg_c_7
       Predictors contrasted: barthtot
-      Predictors averaged: e16sex, barthtot
+      Predictors averaged: e16sex, barthtot (65)
       p-values are uncorrected.
 
 ---
@@ -424,7 +424,7 @@
 
       Variable predicted: neg_c_7
       Predictors contrasted: barthtot
-      Predictors averaged: barthtot
+      Predictors averaged: barthtot (65)
       p-values are uncorrected.
 
 # estimate_contrasts - simple contrasts and with - in levels works
@@ -443,7 +443,7 @@
 
       Variable predicted: Sepal.Length
       Predictors contrasted: Species
-      Predictors averaged: Sepal.Width
+      Predictors averaged: Sepal.Width (3.1)
       p-values are uncorrected.
 
 ---
@@ -603,7 +603,7 @@
 
       Variable predicted: count
       Predictors contrasted: mined, spp
-      Predictors averaged: cover, site
+      Predictors averaged: cover (8.7e-11), site
       p-values are uncorrected.
       Contrasts are on the response-scale.
 
@@ -627,7 +627,7 @@
 
       Variable predicted: count
       Predictors contrasted: mined
-      Predictors averaged: cover, site
+      Predictors averaged: cover (8.7e-11), site
       p-values are uncorrected.
       Contrasts are on the response-scale.
 

tests/testthat/_snaps/windows/print.md

@@ -134,7 +134,7 @@
 
       Variable predicted: neg_c_7
       Predictors modulated: c12hour, c172code, c161sex
-      Predictors averaged: barthtot
+      Predictors averaged: barthtot (65)
 
 ---
 
@@ -550,7 +550,7 @@
 
       Variable predicted: neg_c_7
       Predictors modulated: c160age=[fivenum], c161sex
-      Predictors controlled: barthtot (65), e16sex (1)
+      Predictors controlled: barthtot (65), e16sex (male)
 
 ---
 
@@ -574,5 +574,5 @@
 
       Variable predicted: neg_c_7
       Predictors modulated: c160age=[fivenum], c161sex
-      Predictors averaged: barthtot, e16sex
+      Predictors averaged: barthtot (65), e16sex
 

tests/testthat/test-estimate_expectation.R

@@ -74,12 +74,12 @@ test_that("estimate_expectation - error", {
 })
 
 
-test_that("estimate_relation and marginalize individual", {
+test_that("estimate_relation and marginalize specific", {
   skip_if_not_installed("ggeffects")
   data(efc, package = "ggeffects")
   efc <- datawizard::to_factor(efc, c("c161sex", "c172code", "e16sex", "e42dep"))
   fit <- lm(neg_c_7 ~ c12hour + barthtot + c161sex + e42dep + c172code, data = efc)
-  out1 <- estimate_means(fit, "e42dep", marginalize = "individual", backend = "marginaleffects")
+  out1 <- estimate_means(fit, "e42dep", marginalize = "specific", backend = "marginaleffects")
   out2 <- estimate_relation(fit, by = "e42dep")
   expect_equal(out1$Mean, out2$Predicted, tolerance = 1e-4)
 })

tests/testthat/test-table_footer.R

@@ -0,0 +1,19 @@
+skip_if_not_installed("marginaleffects")
+skip_if_not_installed("emmeans")
+
+test_that("table_footer", {
+  skip_if_not_installed("ggeffects")
+  data(efc, package = "ggeffects")
+  efc <- datawizard::to_factor(efc, c("c161sex", "c172code", "e16sex", "e42dep"))
+  m <- lm(neg_c_7 ~ c12hour + barthtot + c161sex + e42dep + c172code, data = efc)
+  out <- utils::capture.output(estimate_means(m, "c172code", marginalize = "specific", verbose = FALSE))
+  expect_identical(
+    out[11],
+    "Predictors controlled: c12hour (42), barthtot (65), c161sex (Male), e42dep (independent)"
+  )
+  out <- utils::capture.output(estimate_means(m, "c172code", marginalize = "average", verbose = FALSE))
+  expect_identical(
+    out[11],
+    "Predictors averaged: c12hour (42), barthtot (65), c161sex, e42dep"
+  )
+})