Issue 896: newdata="median" with binary predictor

vincentarelbundock · Sep 10, 2023 · 1bb5ab9 · 1bb5ab9
1 parent 1db04dd
commit 1bb5ab9
Show file tree

Hide file tree

Showing 5 changed files with 19 additions and 2 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: marginaleffects
 Title: Predictions, Comparisons, Slopes, Marginal Means, and Hypothesis Tests
-Version: 0.14.0.9009
+Version: 0.14.0.9012
 Authors@R: 
     c(person(given = "Vincent",
              family = "Arel-Bundock",

diff --git a/NEWS.md b/NEWS.md
@@ -17,6 +17,10 @@ Misc:
 * Better documentation and error messages for `newdata=NULL`
 * Some performance improvements for `predictions()` and `marginalmeans()` (#880, #882, @etiennebacher).
 
+Bug fix:
+
+* `newdata="median"` returned mean of binary variables. Thanks to @jkhanson1970 for report #896.
+
 ## 0.14.0
 
 Breaking changes:

diff --git a/R/datagrid.R b/R/datagrid.R
@@ -192,6 +192,8 @@ datagrid_engine <- function(
                 out[[n]] <- FUN_logical(dat_automatic[[n]])
             } else if (get_variable_class(dat, n, "character")) {
                 out[[n]] <- FUN_character(dat_automatic[[n]])
+            } else if (get_variable_class(dat, n, "binary")) {
+                out[[n]] <- FUN_integer(dat_automatic[[n]])
             } else if (get_variable_class(dat, n, "numeric")) {
                 if (is.integer(dat_automatic[[n]])) {
                     out[[n]] <- FUN_integer(dat_automatic[[n]])

diff --git a/R/sanitize_newdata.R b/R/sanitize_newdata.R
@@ -40,7 +40,7 @@ build_newdata <- function(model, newdata, by, modeldata) {
         newdata <- do.call("datagrid", args)
 
     } else if (identical(newdata, "median")) {
-        args[["FUN_numeric"]] <- function(x) stats::median(x, na.rm = TRUE)
+        args[["FUN_numeric"]] <- args[["FUN_integer"]] <- args[["FUN_logical"]] <- function(x) stats::median(x, na.rm = TRUE)
         newdata <- do.call("datagrid", args)
 
     } else if (identical(newdata, "tukey")) {

diff --git a/inst/tinytest/test-pkg-MASS.R b/inst/tinytest/test-pkg-MASS.R
@@ -247,5 +247,16 @@ mm <- marginal_means(mod, variables = "am", type = "probs")
 expect_equivalent(nrow(mm), 6)
 
 
+# Issue #896: polr returns mean of binary instead of median
+mtcars$gear <- as.factor(mtcars$gear)
+mod <- polr(
+    gear ~ mpg + cyl + vs,
+    data = mtcars,
+    method = "probit",
+    Hess = TRUE)
+p <- predictions(mod, newdata = "median", type = "probs")
+expect_true(all(p$vs == 0))
+
+
 
 rm(list = ls())