some predict call routing

Author: ‘topepo’

R/mlp.R

@@ -146,9 +146,10 @@ check_args.mlp <- function(object, call = rlang::caller_env()) {
 
 # keras wrapper for feed-forward nnet
 
-class2ind <- function (x, drop2nd = FALSE) {
-  if (!is.factor(x))
-    cli::cli_abort(c("x" = "{.arg x} should be a factor."))
+class2ind <- function (x, drop2nd = FALSE, call = rlang::caller_env()) {
+  if (!is.factor(x)) {
+    cli::cli_abort(c("x" = "{.arg x} should be a {cls factor} not {.obj_type_friendly {x}."))
+  }
   y <- model.matrix( ~ x - 1)
   colnames(y) <- gsub("^x", "", colnames(y))
   attributes(y)$assign <- NULL

R/predict_class.R

@@ -10,13 +10,15 @@
 #' @export
 predict_class.model_fit <- function(object, new_data, ...) {
   if (object$spec$mode != "classification") {
-    cli::cli_abort("{.fun predict.model_fit} is for predicting factor outcomes.")
+    cli::cli_abort("{.fun predict.model_fit} is for predicting factor outcomes.",
+                   call = rlang::call2("predict"))
   }
 
   check_spec_pred_type(object, "class")
 
   if (inherits(object$fit, "try-error")) {
-    cli::cli_warn("Model fit failed; cannot make predictions.")
+    cli::cli_warn("Model fit failed; cannot make predictions.",
+                  call = rlang::call2("predict"))
     return(NULL)
   }
 

R/predict_classprob.R

@@ -6,7 +6,8 @@
 #' @export
 predict_classprob.model_fit <- function(object, new_data, ...) {
   if (object$spec$mode != "classification") {
-    cli::cli_abort("{.fun predict.model_fit()} is for predicting factor outcomes.")
+    cli::cli_abort("{.fun predict.model_fit()} is for predicting factor outcomes.",
+                   call = rlang::call2("predict"))
   }
 
   check_spec_pred_type(object, "prob", call = caller_env())
@@ -36,7 +37,8 @@ predict_classprob.model_fit <- function(object, new_data, ...) {
 
   # check and sort names
   if (!is.data.frame(res) & !inherits(res, "tbl_spark")) {
-    cli::cli_abort("The was a problem with the probability predictions.")
+    cli::cli_abort("The was a problem with the probability predictions.",
+                   call = rlang::call2("predict"))
   }
 
   if (!is_tibble(res) & !inherits(res, "tbl_spark")) {

R/predict_numeric.R

@@ -11,7 +11,8 @@ predict_numeric.model_fit <- function(object, new_data, ...) {
         "{.fun predict_numeric} is for predicting numeric outcomes.",
         "i" = "Use {.fun predict_class} or {.fun predict_classprob} for
                classification models."
-      )
+      ),
+      call = rlang::call2("predict")
     )
   }
 

R/predict_quantile.R

@@ -37,7 +37,8 @@ predict_quantile.model_fit <- function(object,
   if (object$spec$mode == "quantile regression") {
     if (!is.null(quantile_levels)) {
       cli::cli_abort("When the mode is {.val quantile regression},
-                     {.arg quantile_levels} are specified by {.fn set_mode}.")
+                     {.arg quantile_levels} are specified by {.fn set_mode}.",
+                     call = rlang::call2("predict"))
     }
   } else {
     if (is.null(quantile_levels)) {

R/predict_time.R

@@ -11,7 +11,8 @@ predict_time.model_fit <- function(object, new_data, ...) {
         "{.fun predict_time} is for predicting time outcomes.",
         "i" = "Use {.fun predict_class} or {.fun predict_classprob} for
                classification models."
-      )
+      ),
+      call = rlang::call2("predict")
     )
   }
 

R/rand_forest_data.R

@@ -66,7 +66,8 @@ ranger_confint <- function(object, new_data, ...) {
     } else {
       cli::cli_abort(
         "Cannot compute confidence intervals for a ranger forest
-         of type {.val {object$fit$forest$treetype}}."
+         of type {.val {object$fit$forest$treetype}}.",
+        call = rlang::call2("predict")
       )
     }
   }

tests/testthat/_snaps/linear_reg_quantreg.md

@@ -4,6 +4,6 @@
       ten_quant_pred <- predict(ten_quant, new_data = sac_test, quantile_levels = (0:
       9) / 9)
     Condition
-      Error in `predict_quantile()`:
+      Error in `predict()`:
       ! When the mode is "quantile regression", `quantile_levels` are specified by `set_mode()`.