Test that all steps support 0 and 1 rows as input to bake()

NEWS.md

@@ -8,6 +8,8 @@
 
 * The `strings_as_factors` argument of `prep.recipe()` has been soft-deprecated in favor of `recipe(strings_as_factors)`. If both are provided, the value in `recipe()` takes precedence. This allows control of recipe behavior within a workflow, which wasn't previously possible. (@smingerson, #331, #287)
 
+* Fixed bugs in `step_bs()`, `step_depth()`, `step_harmonic()`, `step_invlogit()`, `step_isomap()`, `step_logit()`, `check_range()`, `step_poly_bernstein()`, `step_spline_b()`, `step_spline_convex()`, `step_monotone()`, `step_natural()`, `step_nonnegative()` would error in `bake()` with zero-row data. (#1219)
+
 * Fixed bug where `step_lincomb()` would remove both variables if they were identical. (#1357)
 
 * `step_impute_bag()` and `step_impute_knn()` now gives more informative warnings when `impute_with` data contains all NAs. (#1385)

R/bs.R

@@ -155,6 +155,9 @@ bs_statistics <- function(x, args) {
 }
 
 bs_predict <- function(object, x) {
+  if (length(x) == 0) {
+    return(object)
+  }
   xu <- unique(x)
   ru <- predict(object, xu)
   res <- ru[match(x, xu), , drop = FALSE]

R/depth.R

@@ -189,8 +189,8 @@ prep.step_depth <- function(x, training, info = NULL, ...) {
 }
 
 get_depth <- function(tr_dat, new_dat, metric, opts) {
-  if (ncol(new_dat) == 0L) {
-    # ddalpha can't handle 0 col inputs
+  if (ncol(new_dat) == 0L || nrow(new_dat) == 0L) {
+    # ddalpha can't handle 0 col inputs or 0 row inputs
     return(rep(NA_real_, nrow(new_dat)))
   }
 

R/harmonic.R

@@ -301,11 +301,16 @@ sin_cos <- function(
   cycle_size,
   call = caller_env()
 ) {
+  nc <- length(frequency)
+
+  if (length(x) == 0) {
+    return(matrix(NA_real_, nrow = 0, ncol = nc * 2L))
+  }
+
   if (all(is.na(x))) {
     cli::cli_abort("Variable must have at least one non-NA value.", call = call)
   }
 
-  nc <- length(frequency)
   nr <- length(x)
 
   # adjust phase

R/invlogit.R

@@ -100,6 +100,10 @@ bake.step_invlogit <- function(object, new_data, ...) {
   col_names <- names(object$columns)
   check_new_data(col_names, object, new_data)
 
+  if (nrow(new_data) == 0) {
+    return(new_data)
+  }
+
   for (col_name in col_names) {
     new_data[[col_name]] <- binomial()$linkinv(new_data[[col_name]])
   }

R/isomap.R

@@ -221,11 +221,17 @@
   check_new_data(col_names, object, new_data)
 
   if (object$num_terms > 0 && length(col_names) > 0L) {
-    suppressMessages({
-      comps <- object$res@apply(
-        dimred_data(new_data[, col_names, drop = FALSE])
-      )@data
-    })
+    if (nrow(new_data) == 0) {
+      comps <- matrix(nrow = 0, ncol = object$num_terms)
+      colnames(comps) <- seq_len(object$num_terms)
+    } else {
+      suppressMessages({
+        comps <- object$res@apply(
+          dimred_data(new_data[, col_names, drop = FALSE])
+        )@data
+      })
+    }
+
     comps <- comps[, seq_len(object$num_terms), drop = FALSE]
     comps <- as_tibble(comps)
     comps <- check_name(comps, new_data, object)

R/logit.R

@@ -110,6 +110,10 @@ bake.step_logit <- function(object, new_data, ...) {
   col_names <- names(object$columns)
   check_new_data(col_names, object, new_data)
 
+  if (nrow(new_data) == 0) {
+    return(new_data)
+  }
+
   for (col_name in col_names) {
     new_data[[col_name]] <- binomial()$linkfun(
       pre_logit(new_data[[col_name]], object$offset)

R/range_check.R

@@ -190,6 +190,10 @@ bake.check_range <- function(object, new_data, ...) {
   col_names <- names(object$lower)
   check_new_data(col_names, object, new_data)
 
+  if (nrow(new_data) == 0) {
+    return(new_data)
+  }
+
   for (col_name in col_names) {
     range_check_func(
       new_data[[col_name]],

R/spline_helpers.R

@@ -63,13 +63,23 @@
   object$.ns <- NULL
   object$.fn <- NULL
   object$nm <- NULL
+
+  if (NROW(new_data) == 0) {
+    new_data <- object$Boundary.knots[[1]]
+  }
+
   .cl <- rlang::call2(
     .ns = .ns,
     .fn = .fn,
     !!!object,
     x = rlang::expr(new_data)
   )
   res <- rlang::eval_tidy(.cl)
+
+  if (NROW(new_data) == 0) {
+    res <- res[0, , drop = FALSE]
+  }
+
   attributes(res) <- list(dim = dim(res), dimnames = dimnames(res))
   if (length(new_data) == 1) {
     res <- matrix(res, nrow = 1, dimnames = dimnames(res))

tests/testthat/_snaps/depth.md

@@ -1,3 +1,23 @@
+# bad args
+
+    Code
+      recipe(Species ~ ., data = iris) %>% step_depth(all_numeric_predictors(),
+      class = "Species", metric = "circular") %>% prep()
+    Condition
+      Error in `step_depth()`:
+      Caused by error in `prep()`:
+      ! `metric` must be one of "potential", "halfspace", "Mahalanobis", "simplicialVolume", "spatial", or "zonoid", not "circular".
+
+---
+
+    Code
+      recipe(Species ~ ., data = iris) %>% step_depth(all_numeric_predictors(),
+      class = "Species", prefix = 0L) %>% prep()
+    Condition
+      Error in `step_depth()`:
+      Caused by error in `prep()`:
+      ! `prefix` must be a single string, not the number 0.
+
 # bake method errors when needed non-standard role columns are missing
 
     Code
@@ -85,23 +105,3 @@
       -- Operations 
       * Data depth by Species for: Sepal.Length Sepal.Width, ... | Trained
 
-# bad args
-
-    Code
-      recipe(Species ~ ., data = iris) %>% step_depth(all_numeric_predictors(),
-      class = "Species", metric = "circular") %>% prep()
-    Condition
-      Error in `step_depth()`:
-      Caused by error in `prep()`:
-      ! `metric` must be one of "potential", "halfspace", "Mahalanobis", "simplicialVolume", "spatial", or "zonoid", not "circular".
-
----
-
-    Code
-      recipe(Species ~ ., data = iris) %>% step_depth(all_numeric_predictors(),
-      class = "Species", prefix = 0L) %>% prep()
-    Condition
-      Error in `step_depth()`:
-      Caused by error in `prep()`:
-      ! `prefix` must be a single string, not the number 0.
-

tests/testthat/test-BoxCox.R

@@ -156,7 +156,7 @@ test_that("warnings", {
   )
 
   expect_snapshot(
-    recipe(~mpg + disp, data = mtcars) %>%
+    recipe(~ mpg + disp, data = mtcars) %>%
       step_BoxCox(mpg, disp) %>%
       prep() %>%
       bake(new_data = tibble(mpg = -1, disp = -1))
@@ -223,3 +223,19 @@ test_that("printing", {
   expect_snapshot(print(rec))
   expect_snapshot(prep(rec))
 })
+
+test_that("0 and 1 rows data work in bake method", {
+  data <- mtcars
+  rec <- recipe(~., data) %>%
+    step_BoxCox(mpg, disp) %>%
+    prep()
+
+  expect_identical(
+    nrow(bake(rec, slice(data, 1))),
+    1L
+  )
+  expect_identical(
+    nrow(bake(rec, slice(data, 0))),
+    0L
+  )
+})

tests/testthat/test-YeoJohnson.R

@@ -237,3 +237,19 @@ test_that("bad args", {
     error = TRUE
   )
 })
+
+test_that("0 and 1 rows data work in bake method", {
+  data <- mtcars
+  rec <- recipe(~., data) %>%
+    step_YeoJohnson(all_predictors()) %>%
+    prep()
+
+  expect_identical(
+    nrow(bake(rec, slice(data, 1))),
+    1L
+  )
+  expect_identical(
+    nrow(bake(rec, slice(data, 0))),
+    0L
+  )
+})

tests/testthat/test-arrange.R

@@ -10,24 +10,24 @@ iris_rec <- recipe(~., data = iris)
 test_that("basic usage", {
   rec <-
     iris_rec %>%
-      step_arrange(desc(Sepal.Length), 1 / Petal.Length)
+    step_arrange(desc(Sepal.Length), 1 / Petal.Length)
 
   prepped <- prep(rec, training = iris %>% slice(1:75))
 
   dplyr_train <-
     iris %>%
-      as_tibble() %>%
-      slice(1:75) %>%
-      dplyr::arrange(desc(Sepal.Length), 1 / Petal.Length)
+    as_tibble() %>%
+    slice(1:75) %>%
+    dplyr::arrange(desc(Sepal.Length), 1 / Petal.Length)
 
   rec_train <- bake(prepped, new_data = NULL)
   expect_equal(dplyr_train, rec_train)
 
   dplyr_test <-
     iris %>%
-      as_tibble() %>%
-      slice(76:150) %>%
-      dplyr::arrange(desc(Sepal.Length), 1 / Petal.Length)
+    as_tibble() %>%
+    slice(76:150) %>%
+    dplyr::arrange(desc(Sepal.Length), 1 / Petal.Length)
   rec_test <- bake(prepped, iris %>% slice(76:150))
   expect_equal(dplyr_test, rec_test)
 })
@@ -37,15 +37,15 @@ test_that("quasiquotation", {
   sort_vars <- syms(sort_vars)
   rec_1 <-
     iris_rec %>%
-      step_arrange(!!!sort_vars)
+    step_arrange(!!!sort_vars)
 
   prepped_1 <- prep(rec_1, training = iris %>% slice(1:75))
 
   dplyr_train <-
     iris %>%
-      as_tibble() %>%
-      slice(1:75) %>%
-      arrange(Sepal.Length, Petal.Length)
+    as_tibble() %>%
+    slice(1:75) %>%
+    arrange(Sepal.Length, Petal.Length)
 
   rec_1_train <- bake(prepped_1, new_data = NULL)
   expect_equal(dplyr_train, rec_1_train)
@@ -54,9 +54,9 @@ test_that("quasiquotation", {
 test_that("no input", {
   no_inputs <-
     iris_rec %>%
-      step_arrange() %>%
-      prep(training = iris) %>%
-      bake(new_data = NULL, composition = "data.frame")
+    step_arrange() %>%
+    prep(training = iris) %>%
+    bake(new_data = NULL, composition = "data.frame")
   expect_equal(no_inputs, iris)
 })
 
@@ -126,3 +126,19 @@ test_that("printing", {
   expect_snapshot(print(rec))
   expect_snapshot(prep(rec))
 })
+
+test_that("0 and 1 rows data work in bake method", {
+  data <- iris
+  rec <- recipe(~., data = data) %>%
+    step_arrange(Sepal.Length) %>%
+    prep()
+
+  expect_identical(
+    nrow(bake(rec, slice(data, 1))),
+    1L
+  )
+  expect_identical(
+    nrow(bake(rec, slice(data, 0))),
+    0L
+  )
+})

tests/testthat/test-bin2factor.R

@@ -123,3 +123,19 @@ test_that("printing", {
   expect_snapshot(print(rec2))
   expect_snapshot(prep(rec2))
 })
+
+test_that("0 and 1 rows data work in bake method", {
+  data <- mtcars
+  rec <- recipe(~., data) %>%
+    step_bin2factor(am, vs) %>%
+    prep()
+
+  expect_identical(
+    nrow(bake(rec, slice(data, 1))),
+    1L
+  )
+  expect_identical(
+    nrow(bake(rec, slice(data, 0))),
+    0L
+  )
+})

tests/testthat/test-bs.R

@@ -89,7 +89,7 @@ test_that("options(knots) works correctly (#1297)", {
     bake(new_data = NULL)
 
   mm_res <- model.matrix(
-    ~splines::bs(
+    ~ splines::bs(
       x,
       knots = seq(-1, 1, 0.125),
       Boundary.knots = c(-2.5, 2.5)
@@ -120,7 +120,7 @@ test_that("check_name() is used", {
 test_that("tunable", {
   rec <-
     recipe(~., data = iris) %>%
-      step_bs(all_predictors())
+    step_bs(all_predictors())
   rec_param <- tunable.step_bs(rec$steps[[1]])
   expect_equal(rec_param$name, c("deg_free", "degree"))
   expect_true(all(rec_param$source == "recipe"))
@@ -257,3 +257,19 @@ test_that("tunable is setup to work with extract_parameter_set_dials", {
   expect_s3_class(params, "parameters")
   expect_identical(nrow(params), 2L)
 })
+
+test_that("0 and 1 rows data work in bake method", {
+  data <- mtcars
+  rec <- recipe(~., data) %>%
+    step_bs(mpg, disp) %>%
+    prep()
+
+  expect_identical(
+    nrow(bake(rec, slice(data, 1))),
+    1L
+  )
+  expect_identical(
+    nrow(bake(rec, slice(data, 0))),
+    0L
+  )
+})