Merge pull request #1412 from tidymodels/estimate-sparsity-dummy-bug

R/dummy.R

@@ -397,3 +397,23 @@ tidy.step_dummy <- function(x, ...) {
   res$id <- x$id
   res
 }
+
+#' @export
+.recipes_estimate_sparsity.step_dummy <- function(x, data, ...) {
+  get_levels <- function(x) {
+    if (is.factor(x)) {
+      return(length(levels(x)))
+    } else {
+      return(vctrs::vec_unique_count(x))
+    }
+  }
+
+  n_levels <- lapply(data, get_levels)
+
+  lapply(n_levels, function(n_lvl) {
+    c(
+      n_cols = ifelse(x$one_hot, n_lvl, n_lvl - 1),
+      sparsity = 1 - 1 / n_lvl
+    )
+  })
+}

R/sparsevctrs.R

@@ -111,15 +111,3 @@ is_sparse_matrix <- function(x) {
 
   zeroes / (n_rows * n_cols)
 }
-
-#' @export
-.recipes_estimate_sparsity.step_dummy <- function(x, data, ...) {
-  n_levels <- lapply(data, function(x) length(levels(x)))
-
-  lapply(n_levels, function(n_lvl) {
-    c(
-      n_cols = ifelse(x$one_hot, n_lvl, n_lvl - 1),
-      sparsity = 1 - 1 / n_lvl
-    )
-  })
-}

tests/testthat/test-dummy.R

@@ -382,6 +382,30 @@ test_that("sparse = 'yes' errors on unsupported contrasts", {
   )
 })
 
+test_that(".recipes_toggle_sparse_args works", {
+  rec <- recipe(~., iris) %>%
+    step_dummy(all_nominal_predictors())
+
+  exp <- rec %>% prep() %>% bake(NULL) %>% sparsevctrs::sparsity()
+
+ expect_equal(
+    .recipes_estimate_sparsity(rec),
+    exp
+  )
+
+  iris$Species <- as.character(iris$Species)
+
+  rec <- recipe(~., iris) %>%
+    step_dummy(all_nominal_predictors())
+
+  exp <- rec %>% prep() %>% bake(NULL) %>% sparsevctrs::sparsity()
+
+ expect_equal(
+    .recipes_estimate_sparsity(rec),
+    exp
+  )
+})
+
 # Infrastructure ---------------------------------------------------------------
 
 test_that("bake method errors when needed non-standard role columns are missing", {