A few missing cli error conversions (#1213)

topepo · simonpcouch · web-flow · commit 33f621c884a8 · 2024-10-21T14:56:27.000-04:00
* remaning rlng errors to cli errors

* remove redundant tests

* updated snapshots

* Update R/misc.R

Co-authored-by: Simon P. Couch &lt;simonpatrickcouch@gmail.com&gt;

* Apply suggestions from code review

Co-authored-by: Simon P. Couch &lt;simonpatrickcouch@gmail.com&gt;

* update snapshots

---------

Co-authored-by: Simon P. Couch &lt;simonpatrickcouch@gmail.com&gt;
diff --git a/R/descriptors.R b/R/descriptors.R
@@ -245,9 +245,9 @@ get_descr_spark <- function(formula, data) {
   .obs   <- function() obs
   .lvls  <- function() y_vals
   .facts <- function() factor_pred
-  .x       <- function() abort("Descriptor .x() not defined for Spark.")
-  .y       <- function() abort("Descriptor .y() not defined for Spark.")
-  .dat     <- function() abort("Descriptor .dat() not defined for Spark.")
+  .x       <- function() cli::cli_abort("Descriptor {.fn .x} not defined for Spark.")
+  .y       <- function() cli::cli_abort("Descriptor {.fn .y} not defined for Spark.")
+  .dat     <- function() cli::cli_abort("Descriptor {.fn .dat} not defined for Spark.")
 
   # still need .x(), .y(), .dat() ?
 
@@ -409,13 +409,13 @@ scoped_descrs <- function(descrs, frame = caller_env()) {
 # with their actual implementations
 descr_env <- rlang::new_environment(
   data = list(
-    .cols  = function() abort("Descriptor context not set"),
-    .preds = function() abort("Descriptor context not set"),
-    .obs   = function() abort("Descriptor context not set"),
-    .lvls  = function() abort("Descriptor context not set"),
-    .facts = function() abort("Descriptor context not set"),
-    .x     = function() abort("Descriptor context not set"),
-    .y     = function() abort("Descriptor context not set"),
-    .dat   = function() abort("Descriptor context not set")
+    .cols  = function() cli::cli_abort("Descriptor context not set"),
+    .preds = function() cli::cli_abort("Descriptor context not set"),
+    .obs   = function() cli::cli_abort("Descriptor context not set"),
+    .lvls  = function() cli::cli_abort("Descriptor context not set"),
+    .facts = function() cli::cli_abort("Descriptor context not set"),
+    .x     = function() cli::cli_abort("Descriptor context not set"),
+    .y     = function() cli::cli_abort("Descriptor context not set"),
+    .dat   = function() cli::cli_abort("Descriptor context not set")
   )
 )
diff --git a/R/misc.R b/R/misc.R
@@ -369,22 +369,20 @@ check_outcome <- function(y, spec) {
   if (spec$mode == "regression") {
     outcome_is_numeric <- if (is.atomic(y)) {is.numeric(y)} else {all(map_lgl(y, is.numeric))}
     if (!outcome_is_numeric) {
-      cls <- class(y)[[1]]
-      abort(paste0(
-        "For a regression model, the outcome should be `numeric`, ",
-        "not a `", cls, "`."
-      ))
+      cli::cli_abort(
+        "For a regression model, the outcome should be {.cls numeric}, not
+        {.obj_type_friendly {y}}."
+      )
     }
   }
 
   if (spec$mode == "classification") {
     outcome_is_factor <- if (is.atomic(y)) {is.factor(y)} else {all(map_lgl(y, is.factor))}
     if (!outcome_is_factor) {
-      cls <- class(y)[[1]]
-      abort(paste0(
-        "For a classification model, the outcome should be a `factor`, ",
-        "not a `", cls, "`."
-      ))
+      cli::cli_abort(
+        "For a classification model, the outcome should be a {.cls factor}, not
+        {.obj_type_friendly {y}}."
+      )
     }
 
     if (inherits(spec, "logistic_reg") && is.atomic(y) && length(levels(y)) > 2) {
@@ -402,11 +400,10 @@ check_outcome <- function(y, spec) {
   if (spec$mode == "censored regression") {
     outcome_is_surv <- inherits(y, "Surv")
     if (!outcome_is_surv) {
-      cls <- class(y)[[1]]
-      abort(paste0(
-        "For a censored regression model, the outcome should be a `Surv` object, ",
-        "not a `", cls, "`."
-      ))
+      cli::cli_abort(
+        "For a censored regression model, the outcome should be a {.cls Surv} object, not
+        {.obj_type_friendly {y}}."
+      )
     }
   }
 
diff --git a/tests/testthat/_snaps/boost_tree_xgboost.md b/tests/testthat/_snaps/boost_tree_xgboost.md
@@ -6,15 +6,6 @@
       Error:
       ! object 'novar' not found
 
-# xgboost execution, regression
-
-    Code
-      res <- parsnip::fit_xy(car_basic, x = mtcars[, num_pred], y = factor(mtcars$vs),
-      control = ctrl)
-    Condition
-      Error in `check_outcome()`:
-      ! For a regression model, the outcome should be `numeric`, not a `factor`.
-
 # submodel prediction
 
     Code
diff --git a/tests/testthat/_snaps/linear_reg.md b/tests/testthat/_snaps/linear_reg.md
@@ -46,7 +46,7 @@
       res <- fit_xy(hpc_basic, x = hpc[, num_pred], y = hpc$class, control = ctrl)
     Condition
       Error in `check_outcome()`:
-      ! For a regression model, the outcome should be `numeric`, not a `factor`.
+      ! For a regression model, the outcome should be <numeric>, not a <factor> object.
 
 ---
 
@@ -55,47 +55,47 @@
       control = ctrl)
     Condition
       Error in `check_outcome()`:
-      ! For a regression model, the outcome should be `numeric`, not a `character`.
+      ! For a regression model, the outcome should be <numeric>, not a character vector.
 
 ---
 
     Code
       res <- fit(hpc_basic, hpc_bad_form, data = hpc, control = ctrl)
     Condition
       Error in `check_outcome()`:
-      ! For a regression model, the outcome should be `numeric`, not a `factor`.
+      ! For a regression model, the outcome should be <numeric>, not a <factor> object.
 
 ---
 
     Code
       lm_form_catch <- fit(hpc_basic, hpc_bad_form, data = hpc, control = caught_ctrl)
     Condition
       Error in `check_outcome()`:
-      ! For a regression model, the outcome should be `numeric`, not a `factor`.
+      ! For a regression model, the outcome should be <numeric>, not a <factor> object.
 
 # glm execution
 
     Code
       res <- fit_xy(hpc_glm, x = hpc[, num_pred], y = hpc$class, control = ctrl)
     Condition
       Error in `check_outcome()`:
-      ! For a regression model, the outcome should be `numeric`, not a `factor`.
+      ! For a regression model, the outcome should be <numeric>, not a <factor> object.
 
 ---
 
     Code
       res <- fit(hpc_glm, hpc_bad_form, data = hpc, control = ctrl)
     Condition
       Error in `check_outcome()`:
-      ! For a regression model, the outcome should be `numeric`, not a `factor`.
+      ! For a regression model, the outcome should be <numeric>, not a <factor> object.
 
 ---
 
     Code
       lm_form_catch <- fit(hpc_glm, hpc_bad_form, data = hpc, control = caught_ctrl)
     Condition
       Error in `check_outcome()`:
-      ! For a regression model, the outcome should be `numeric`, not a `factor`.
+      ! For a regression model, the outcome should be <numeric>, not a <factor> object.
 
 # newdata error trapping
 
diff --git a/tests/testthat/_snaps/logistic_reg.md b/tests/testthat/_snaps/logistic_reg.md
@@ -51,7 +51,7 @@
       res <- fit(lc_basic, funded_amnt ~ term, data = lending_club, control = ctrl)
     Condition
       Error in `check_outcome()`:
-      ! For a classification model, the outcome should be a `factor`, not a `integer`.
+      ! For a classification model, the outcome should be a <factor>, not an integer vector.
 
 ---
 
@@ -60,7 +60,7 @@
       control = caught_ctrl)
     Condition
       Error in `check_outcome()`:
-      ! For a classification model, the outcome should be a `factor`, not a `integer`.
+      ! For a classification model, the outcome should be a <factor>, not an integer vector.
 
 ---
 
@@ -69,15 +69,15 @@
         num_pred], y = lending_club$total_bal_il)
     Condition
       Error in `check_outcome()`:
-      ! For a classification model, the outcome should be a `factor`, not a `integer`.
+      ! For a classification model, the outcome should be a <factor>, not an integer vector.
 
 # liblinear execution
 
     Code
       res <- fit(ll_basic, funded_amnt ~ term, data = lending_club, control = ctrl)
     Condition
       Error in `check_outcome()`:
-      ! For a classification model, the outcome should be a `factor`, not a `integer`.
+      ! For a classification model, the outcome should be a <factor>, not an integer vector.
 
 ---
 
@@ -86,7 +86,7 @@
       control = caught_ctrl)
     Condition
       Error in `check_outcome()`:
-      ! For a classification model, the outcome should be a `factor`, not a `integer`.
+      ! For a classification model, the outcome should be a <factor>, not an integer vector.
 
 ---
 
@@ -95,7 +95,7 @@
         num_pred], y = lending_club$total_bal_il)
     Condition
       Error in `check_outcome()`:
-      ! For a classification model, the outcome should be a `factor`, not a `integer`.
+      ! For a classification model, the outcome should be a <factor>, not an integer vector.
 
 # check_args() works
 
diff --git a/tests/testthat/_snaps/mars.md b/tests/testthat/_snaps/mars.md
@@ -31,14 +31,6 @@
       x Engine "wat?" is not supported for `mars()`
       i See `show_engines("mars")`.
 
-# mars execution
-
-    Code
-      res <- fit(hpc_basic, hpc_bad_form, data = hpc, control = ctrl)
-    Condition
-      Error in `check_outcome()`:
-      ! For a regression model, the outcome should be `numeric`, not a `factor`.
-
 # submodel prediction
 
     Code
diff --git a/tests/testthat/_snaps/misc.md b/tests/testthat/_snaps/misc.md
@@ -150,14 +150,6 @@
 
 # check_outcome works as expected
 
-    Code
-      check_outcome(factor(1:2), reg_spec)
-    Condition
-      Error in `check_outcome()`:
-      ! For a regression model, the outcome should be `numeric`, not a `factor`.
-
----
-
     Code
       check_outcome(NULL, reg_spec)
     Condition
@@ -192,14 +184,6 @@
       ! `linear_reg()` was unable to find an outcome.
       i Ensure that you have specified an outcome column and that it hasn't been removed in pre-processing.
 
----
-
-    Code
-      check_outcome(1:2, class_spec)
-    Condition
-      Error in `check_outcome()`:
-      ! For a classification model, the outcome should be a `factor`, not a `integer`.
-
 ---
 
     Code
@@ -233,5 +217,5 @@
       check_outcome(1:2, cens_spec)
     Condition
       Error in `check_outcome()`:
-      ! For a censored regression model, the outcome should be a `Surv` object, not a `integer`.
+      ! For a censored regression model, the outcome should be a <Surv> object, not an integer vector.
 
diff --git a/tests/testthat/_snaps/nearest_neighbor_kknn.md b/tests/testthat/_snaps/nearest_neighbor_kknn.md
@@ -1,13 +1,5 @@
 # kknn execution
 
-    Code
-      fit_xy(hpc_basic, control = ctrl, x = hpc[, num_pred], y = hpc$input_fields)
-    Condition
-      Error in `check_outcome()`:
-      ! For a classification model, the outcome should be a `factor`, not a `numeric`.
-
----
-
     Code
       fit(hpc_basic, hpc_bad_form, data = hpc, control = ctrl)
     Condition
diff --git a/tests/testthat/_snaps/predict_formats.md b/tests/testthat/_snaps/predict_formats.md
@@ -14,7 +14,7 @@
         class = class == "VF"))
     Condition
       Error in `check_outcome()`:
-      ! For a classification model, the outcome should be a `factor`, not a `logical`.
+      ! For a classification model, the outcome should be a <factor>, not a logical vector.
 
 ---
 
@@ -23,7 +23,7 @@
         class = ifelse(class == "VF", 1, 0)))
     Condition
       Error in `check_outcome()`:
-      ! For a classification model, the outcome should be a `factor`, not a `numeric`.
+      ! For a classification model, the outcome should be a <factor>, not a double vector.
 
 ---
 
@@ -32,5 +32,5 @@
         dplyr::mutate(class = as.character(class)))
     Condition
       Error in `check_outcome()`:
-      ! For a classification model, the outcome should be a `factor`, not a `character`.
+      ! For a classification model, the outcome should be a <factor>, not a character vector.
 
diff --git a/tests/testthat/_snaps/rand_forest_ranger.md b/tests/testthat/_snaps/rand_forest_ranger.md
@@ -4,15 +4,7 @@
       res <- fit(lc_ranger, funded_amnt ~ Class + term, data = lending_club, control = ctrl)
     Condition
       Error in `check_outcome()`:
-      ! For a classification model, the outcome should be a `factor`, not a `integer`.
-
----
-
-    Code
-      res <- fit(bad_ranger_cls, funded_amnt ~ term, data = lending_club, control = ctrl)
-    Condition
-      Error in `check_outcome()`:
-      ! For a classification model, the outcome should be a `factor`, not a `integer`.
+      ! For a classification model, the outcome should be a <factor>, not an integer vector.
 
 # ranger classification probabilities
 
diff --git a/tests/testthat/_snaps/sparsevctrs.md b/tests/testthat/_snaps/sparsevctrs.md
@@ -30,14 +30,6 @@
       Warning:
       `data` is a sparse tibble, but `linear_reg()` with engine "lm" doesn't accept that. Converting to non-sparse.
 
----
-
-    Code
-      fit(spec, avg_price_per_room ~ ., data = hotel_data)
-    Condition
-      Error in `fit()`:
-      ! `x` must have column names.
-
 # sparse tibble can be passed to `fit_xy() - unsupported
 
     Code
@@ -135,3 +127,11 @@
       Error in `maybe_sparse_matrix()`:
       ! no sparse vectors detected
 
+# fit() errors if sparse matrix has no colnames
+
+    Code
+      fit(spec, avg_price_per_room ~ ., data = hotel_data)
+    Condition
+      Error in `fit()`:
+      ! `x` must have column names.
+
diff --git a/tests/testthat/test-boost_tree_xgboost.R b/tests/testthat/test-boost_tree_xgboost.R
@@ -151,15 +151,6 @@ test_that('xgboost execution, regression', {
     )
   )
 
-  expect_snapshot(
-    error = TRUE,
-    res <- parsnip::fit_xy(
-      car_basic,
-      x = mtcars[, num_pred],
-      y = factor(mtcars$vs),
-      control = ctrl
-    )
-  )
 })
 
 
diff --git a/tests/testthat/test-mars.R b/tests/testthat/test-mars.R
@@ -56,16 +56,6 @@ test_that('mars execution', {
   expect_true(has_multi_predict(res))
   expect_equal(multi_predict_args(res), "num_terms")
 
-  expect_snapshot(
-    error = TRUE,
-    res <- fit(
-      hpc_basic,
-      hpc_bad_form,
-      data = hpc,
-      control = ctrl
-    )
-  )
-
   ## multivariate y
 
   expect_no_condition(
diff --git a/tests/testthat/test-misc.R b/tests/testthat/test-misc.R
diff --git a/tests/testthat/test-nearest_neighbor_kknn.R b/tests/testthat/test-nearest_neighbor_kknn.R
diff --git a/tests/testthat/test-rand_forest_ranger.R b/tests/testthat/test-rand_forest_ranger.R
diff --git a/tests/testthat/test-sparsevctrs.R b/tests/testthat/test-sparsevctrs.R
