make sure all steps work with zero and one rows data in bake()

Author: EmilHvitfeldt

NEWS.md

@@ -1,5 +1,7 @@
 # themis (development version)
 
+* All `step_*()` functions now correctly handle 0 and 1 row inputs in `bake()` (#160).
+
 * `adasyn()`, `bsmote()`, `nearmiss()`, `smote()`, and `tomek()` now correctly attribute errors from non-numeric columns to the user-facing function (#181).
 
 * `smotenc()` now only suppresses the specific benign warning from `gower::gower_topn()` about variables with zero range, rather than all warnings (#182).

R/adasyn.R

@@ -206,6 +206,10 @@ bake.step_adasyn <- function(object, new_data, ...) {
     return(new_data)
   }
 
+  if (nrow(new_data) <= 1) {
+    return(new_data)
+  }
+
   new_data <- as.data.frame(new_data)
 
   predictor_data <- new_data[, col_names]

R/bsmote.R

@@ -242,6 +242,10 @@ bake.step_bsmote <- function(object, new_data, ...) {
     return(new_data)
   }
 
+  if (nrow(new_data) <= 1) {
+    return(new_data)
+  }
+
   new_data <- as.data.frame(new_data)
 
   predictor_data <- new_data[, col_names]

R/downsample.R

@@ -228,6 +228,9 @@ prep.step_downsample <- function(x, training, info = NULL, ...) {
 
 subsamp <- function(x, wts, num) {
   n <- nrow(x)
+  if (n == 0) {
+    return(x)
+  }
   if (nrow(x) == num) {
     out <- x
   } else {
@@ -247,6 +250,10 @@ bake.step_downsample <- function(object, new_data, ...) {
     return(new_data)
   }
 
+  if (nrow(new_data) <= 1) {
+    return(new_data)
+  }
+
   if (isTRUE(object$case_weights)) {
     wts_col <- purrr::map_lgl(new_data, hardhat::is_case_weights)
     wts <- new_data[[names(which(wts_col))]]

R/nearmiss.R

@@ -212,6 +212,10 @@ bake.step_nearmiss <- function(object, new_data, ...) {
     return(new_data)
   }
 
+  if (nrow(new_data) <= 1) {
+    return(new_data)
+  }
+
   ignore_vars <- setdiff(names(new_data), col_names)
 
   # nearmiss with seed for reproducibility

R/rose.R

@@ -230,6 +230,10 @@ bake.step_rose <- function(object, new_data, ...) {
     return(new_data)
   }
 
+  if (nrow(new_data) <= 1) {
+    return(new_data)
+  }
+
   if (any(is.na(new_data[[object$column]]))) {
     missing <- new_data[is.na(new_data[[object$column]]), ]
   } else {

R/smote.R

@@ -212,6 +212,10 @@ bake.step_smote <- function(object, new_data, ...) {
     return(new_data)
   }
 
+  if (nrow(new_data) <= 1) {
+    return(new_data)
+  }
+
   new_data <- as.data.frame(new_data)
 
   predictor_data <- new_data[, col_names]

R/smotenc.R

@@ -195,6 +195,10 @@ bake.step_smotenc <- function(object, new_data, ...) {
     return(new_data)
   }
 
+  if (nrow(new_data) <= 1) {
+    return(new_data)
+  }
+
   new_data <- as.data.frame(new_data)
 
   predictor_data <- new_data[, col_names]

R/tomek.R

@@ -177,6 +177,10 @@ bake.step_tomek <- function(object, new_data, ...) {
     return(new_data)
   }
 
+  if (nrow(new_data) <= 1) {
+    return(new_data)
+  }
+
   predictor_data <- new_data[, col_names]
 
   # tomek with seed for reproducibility

R/upsample.R

@@ -225,6 +225,9 @@ prep.step_upsample <- function(x, training, info = NULL, ...) {
 
 supsamp <- function(x, wts, num) {
   n <- nrow(x)
+  if (n == 0) {
+    return(x)
+  }
   if (nrow(x) == num) {
     out <- x
   } else {
@@ -244,6 +247,10 @@ bake.step_upsample <- function(object, new_data, ...) {
     return(new_data)
   }
 
+  if (nrow(new_data) <= 1) {
+    return(new_data)
+  }
+
   if (isTRUE(object$case_weights)) {
     wts_col <- purrr::map_lgl(new_data, hardhat::is_case_weights)
     wts <- new_data[[names(which(wts_col))]]