changed failed model predictions to n = 1

Author: topepo

R/predict_class.R

@@ -17,7 +17,7 @@ predict_class.model_fit <- function(object, new_data, ...) {
     stop("No class prediction module defined for this model.", call. = FALSE)
 
   if (inherits(object$fit, "try-error")) {
-    return(failed_class(n = nrow(new_data), lvl = object$lvl))
+    return(failed_class(lvl = object$lvl))
   }
 
   new_data <- prepare_data(object, new_data)
@@ -58,7 +58,7 @@ predict_class <- function(object, ...)
 
 # Some `predict()` helpers for failed models:
 
-failed_class <- function(n, lvl) {
+failed_class <- function(n = 1, lvl) {
   res <- rep(NA_character_, n)
   res <- factor(res, levels = lvl)
   res

R/predict_classprob.R

@@ -14,7 +14,7 @@ predict_classprob.model_fit <- function(object, new_data, ...) {
     stop("No class probability module defined for this model.", call. = FALSE)
 
   if (inherits(object$fit, "try-error")) {
-    return(failed_classprob(n = nrow(new_data), lvl = object$lvl))
+    return(failed_classprob(lvl = object$lvl))
   }
 
   new_data <- prepare_data(object, new_data)
@@ -55,7 +55,7 @@ predict_classprob <- function(object, ...)
 
 # Some `predict()` helpers for failed models:
 
-failed_classprob <- function(n, lvl) {
+failed_classprob <- function(n = 1, lvl) {
   res <- matrix(NA_real_, nrow = n, ncol = length(lvl))
   colnames(res) <- lvl
   as_tibble(res)

R/predict_interval.R

@@ -15,7 +15,7 @@ predict_confint.model_fit <- function(object, new_data, level = 0.95, std_error
          "engine.", call. = FALSE)
 
   if (inherits(object$fit, "try-error")) {
-    return(failed_int(n = nrow(new_data), lvl = object$lvl))
+    return(failed_int(lvl = object$lvl))
   }
 
   new_data <- prepare_data(object, new_data)
@@ -52,7 +52,7 @@ predict_confint <- function(object, ...)
 
 # Some `predict()` helpers for failed models:
 
-failed_int <- function(n, lvl = NULL, nms = ".pred") {
+failed_int <- function(n = 1, lvl = NULL, nms = ".pred") {
   # TODO figure out multivariate models
   if (is.null(lvl)) {
     res <- matrix(NA_real_, nrow = n, ncol = length(nms) * 2)
@@ -81,7 +81,7 @@ predict_predint.model_fit <- function(object, new_data, level = 0.95, std_error
          "engine.", call. = FALSE)
 
   if (inherits(object$fit, "try-error")) {
-    return(failed_int(n = nrow(new_data), lvl = object$lvl))
+    return(failed_int(lvl = object$lvl))
   }
 
   new_data <- prepare_data(object, new_data)

R/predict_numeric.R

@@ -16,7 +16,7 @@ predict_numeric.model_fit <- function(object, new_data, ...) {
 
   if (inherits(object$fit, "try-error")) {
     # TODO handle multivariate cases
-    return(failed_numeric(n = nrow(new_data)))
+    return(failed_numeric())
   }
 
   new_data <- prepare_data(object, new_data)
@@ -56,7 +56,7 @@ predict_numeric <- function(object, ...)
 
 # Some `predict()` helpers for failed models:
 
-failed_numeric <- function(n, nms = ".pred") {
+failed_numeric <- function(n = 1, nms = ".pred") {
   res <- matrix(NA_real_, ncol = length(nms), nrow = n)
   if (length(nms) > 1) {
     colnames(res) <- nms

tests/testthat/test_failed_models.R

@@ -35,9 +35,9 @@ test_that('numeric model', {
     fit(Sepal.Length ~ ., data = iris_bad, control = ctrl)
 
   num_res <- predict(lm_mod, iris_bad[1:11, -1])
-  expect_equal(num_res, tibble(.pred = rep(NA_real_, 11)))
+  expect_equal(num_res, tibble(.pred = rep(NA_real_, 1)))
 
-  exp_int_res <- tibble(.pred_lower = rep(NA_real_, 11), .pred_upper = rep(NA_real_, 11))
+  exp_int_res <- tibble(.pred_lower = rep(NA_real_, 1), .pred_upper = rep(NA_real_, 1))
   ci_res <- predict(lm_mod, iris_bad[1:11, -1], type = "conf_int")
   expect_equal(ci_res, exp_int_res)
 
@@ -55,22 +55,22 @@ test_that('classification model', {
     fit(Class ~ log(funded_amnt) + int_rate + big_num, data = lending_club, control = ctrl)
 
   cls_res <- predict(log_reg, lending_club %>%  dplyr::slice(1:7) %>% dplyr::select(-Class))
-  exp_cls_res <- tibble(.pred_class = factor(rep(NA_character_, 7), levels = lvl))
+  exp_cls_res <- tibble(.pred_class = factor(rep(NA_character_, 1), levels = lvl))
   expect_equal(cls_res, exp_cls_res)
 
   prb_res <-
     predict(log_reg, lending_club %>%  dplyr::slice(1:7) %>% dplyr::select(-Class), type = "prob")
-  exp_prb_res <- tibble(.pred_bad = rep(NA_real_, 7), .pred_good = rep(NA_real_, 7))
+  exp_prb_res <- tibble(.pred_bad = rep(NA_real_, 1), .pred_good = rep(NA_real_, 1))
   expect_equal(prb_res, exp_prb_res)
 
   ci_res <-
     predict(log_reg, lending_club %>%  dplyr::slice(1:7) %>% dplyr::select(-Class), type = "conf_int")
   exp_ci_res <-
     tibble(
-      .pred_lower_bad = rep(NA_real_, 7),
-      .pred_upper_bad = rep(NA_real_, 7),
-      .pred_lower_good = rep(NA_real_, 7),
-      .pred_upper_good = rep(NA_real_, 7)
+      .pred_lower_bad  = rep(NA_real_, 1),
+      .pred_upper_bad  = rep(NA_real_, 1),
+      .pred_lower_good = rep(NA_real_, 1),
+      .pred_upper_good = rep(NA_real_, 1)
       )
   expect_equal(ci_res, exp_ci_res)
 })