cli errors (#286)

* declare cli as a depencency

* update error in`survial_reg-survival.R`

* update error for `proportional_hazards-survival.R`

* update error for `proportional_hazards.R`

* update errors for `proportional_hazards-glmnet.R`

* no need for glue anymore

* Update NEWS

* glue is back for the parsnip utils

R/proportional_hazards-glmnet.R

@@ -18,7 +18,7 @@
 #' @param data The data.
 #' @inheritParams glmnet::glmnet
 #' @param ... additional parameters passed to glmnet::glmnet.
-#' @param call The call passed to [rlang::abort()].
+#' @param call The call used in errors and warnings.
 #'
 #' @return A fitted `glmnet` model.
 #' @export
@@ -87,10 +87,10 @@ check_strata_nterms <- function(formula, data, call = caller_env()) {
   mod_terms <- stats::terms(formula, specials = "strata", data = data)
   strata_terms <- attr(mod_terms, "specials")$strata
   if (length(strata_terms) > 1) {
-    rlang::abort(
+    cli::cli_abort(
       c(
-        "There can only be a single 'strata' term specified using the `strata()` function.",
-        i = "It can contain multiple strata columns, e.g., ` ~ x + strata(s1, s2)`."
+        "There can only be a single strata term specified using the {.fn strata} function.",
+        i = "It can contain multiple strata columns, e.g., {.code ~ x + strata(s1, s2)}."
       ),
       call = call
     )
@@ -146,7 +146,7 @@ drop_strata <- function(expr, in_plus = TRUE) {
 
 check_intercept_model <- function(expr, call = caller_env()) {
   if (expr == rlang::sym("1") | is_call(expr, "strata")) {
-    abort(
+    cli::cli_abort(
       "The Cox model does not contain an intercept, please add a predictor.",
       call = call
     )
@@ -156,11 +156,11 @@ check_intercept_model <- function(expr, call = caller_env()) {
 
 check_strata_remaining <- function(expr, call = rlang::caller_env()) {
   if (is_call(expr, "strata")) {
-    abort(
+    cli::cli_abort(
       c(
-        "Stratification must be nested under a chain of `+` calls.",
-        i = "# Good: ~ x1 + x2 + strata(s)",
-        i = "# Bad: ~ x1 + (x2 + strata(s))"
+        "Stratification must be nested under a chain of {.code +} calls.",
+        i = "# Good: {.code ~ x1 + x2 + strata(s)}",
+        i = "# Bad: {.code ~ x1 + (x2 + strata(s))}"
       ),
       call = call
     )
@@ -175,13 +175,10 @@ check_strata_remaining <- function(expr, call = rlang::caller_env()) {
 
 check_dots_coxnet <- function(x, call = caller_env()) {
   bad_args <- c("subset", "contrasts", "offset", "family")
-  bad_names <- names(x) %in% bad_args
-  if (any(bad_names)) {
-    rlang::abort(
-      glue::glue(
-        "These argument(s) cannot be used to create the model: ",
-        glue::glue_collapse(glue::glue("`{names(x)[bad_names]}`"), sep = ", ")
-      ),
+  bad_names <- names(x)[names(x) %in% bad_args]
+  if (length(bad_names) > 0) {
+    cli::cli_abort(
+      "{?This/These} argument{?s} cannot be used to create the model: {.arg {bad_names}}.",
       call = call
     )
   }
@@ -486,7 +483,7 @@ survival_time_coxnet <- function(object, new_data, penalty = NULL, multi = FALSE
   n_obs <- nrow(new_data)
   n_penalty <- length(penalty)
   if (n_penalty > 1 & !multi) {
-    rlang::abort("Cannot use multiple penalty values with `multi = FALSE`.")
+    cli::cli_abort("Cannot use multiple penalty values with {.code multi = FALSE}.")
   }
 
   new_x <- coxnet_prepare_x(new_data, object)
@@ -625,7 +622,7 @@ survival_prob_coxnet <- function(object,
 
   n_penalty <- length(penalty)
   if (n_penalty > 1 & !multi) {
-    rlang::abort("Cannot use multiple penalty values with `multi = FALSE`.")
+    cli::cli_abort("Cannot use multiple penalty values with {.code multi = FALSE}.")
   }
 
   output <- match.arg(output, c("surv", "haz"))

R/proportional_hazards-survival.R

@@ -29,10 +29,12 @@ cph_survival_pre <- function(new_data, object, ..., call = caller_env()) {
     strata <- grep(pattern = "^strata", x = strata, value = TRUE)
     strata <- sub(pattern = "strata\\(", replacement = "", x = strata)
     strata <- sub(pattern = "\\)", replacement = "", x = strata)
+    strata_available <- strata %in% names(new_data)
+    strata_missing <- strata[!strata_available]
 
-    if (!all(strata %in% names(new_data))) {
-      rlang::abort(
-        "Please provide the strata variable(s) in `new_data`.",
+    if (length(strata_missing) > 0) {
+      cli::cli_abort(
+        "{.arg new_data} is missing the following stratification variable{?s}: {.code {strata_missing}}.",
         call = call
       )
     }

R/proportional_hazards.R

@@ -37,7 +37,7 @@ fit_xy.proportional_hazards <- function(object,
   # special case for glmnet, which puts stratification on the response
   # via `glmnet::stratifySurv()`
   if (inherits(y, "stratifySurv")) {
-    rlang::abort("For stratification, please use the formula interface via `fit()`.")
+    cli::cli_abort("For stratification, please use the formula interface via {.fn fit}.")
   }
 
   # call parsnip::fit_xy.model_spec()

R/survival_reg-survival.R

@@ -30,9 +30,10 @@ survreg_quant <- function(results, object) {
 }
 
 # copied form recipes
-names0 <- function(num, prefix = "x") {
+names0 <- function(num, prefix = "x", ..., call = caller_env()) {
+  check_dots_empty()
   if (num < 1) {
-    rlang::abort("`num` should be > 0.")
+    cli::cli_abort("{.arg num} should be > 0.", call = call)
   }
   ind <- format(1:num)
   ind <- gsub(" ", "0", ind)

tests/testthat/_snaps/proportional_hazards-glmnet.md

@@ -60,8 +60,8 @@
       data = lung)
     Condition
       Error:
-      ! There can only be a single 'strata' term specified using the `strata()` function.
-      i It can contain multiple strata columns, e.g., ` ~ x + strata(s1, s2)`.
+      ! There can only be a single strata term specified using the `strata()` function.
+      i It can contain multiple strata columns, e.g., `~ x + strata(s1, s2)`.
 
 # formula modifications to remove strata
 
@@ -78,8 +78,8 @@
     Condition
       Error:
       ! Stratification must be nested under a chain of `+` calls.
-      i # Good: ~ x1 + x2 + strata(s)
-      i # Bad: ~ x1 + (x2 + strata(s))
+      i # Good: `~ x1 + x2 + strata(s)`
+      i # Bad: `~ x1 + (x2 + strata(s))`
 
 # protect certain glmnet engine args
 
@@ -88,7 +88,7 @@
         fit(Surv(time, status) ~ age + sex, data = lung)
     Condition
       Error:
-      ! These argument(s) cannot be used to create the model: `family`
+      ! This argument cannot be used to create the model: `family`.
 
 # predictions with strata and dot in formula
 

tests/testthat/_snaps/proportional_hazards-survival.md

@@ -4,5 +4,13 @@
       predict(f_fit, new_data = dplyr::select(lung, -inst))
     Condition
       Error in `predict_time()`:
-      ! Please provide the strata variable(s) in `new_data`.
+      ! `new_data` is missing the following stratification variable: `inst`.
+
+---
+
+    Code
+      predict(f_fit, new_data = dplyr::select(lung, -inst, -ph.ecog))
+    Condition
+      Error in `predict_time()`:
+      ! `new_data` is missing the following stratification variables: `inst` and `ph.ecog`.
 

tests/testthat/test-proportional_hazards-survival.R

@@ -68,13 +68,6 @@ test_that("time predictions with strata", {
   # single observation
   expect_error(f_pred_1 <- predict(f_fit, lung[1, ], type = "time"), NA)
   expect_equal(nrow(f_pred_1), 1)
-
-  # prediction without strata info should fail
-  new_data_0 <- data.frame(age = c(50, 60), sex = 1)
-  expect_error(
-    predict(f_fit, new_data = new_data_0, type = "time"),
-    "provide the strata"
-  )
 })
 
 test_that("time predictions with NA", {
@@ -150,6 +143,14 @@ test_that("prediction from stratified models require strata variables in new_dat
   expect_snapshot(error = TRUE, {
     predict(f_fit, new_data = dplyr::select(lung, -inst))
   })
+
+  f_fit <- proportional_hazards() %>%
+    set_engine("survival") %>%
+      fit(Surv(time, status) ~ age + sex + strata(inst) + strata(ph.ecog), data = lung)
+
+  expect_snapshot(error = TRUE, {
+    predict(f_fit, new_data = dplyr::select(lung, -inst, -ph.ecog))
+  })
 })
 
 # prediction: survival ----------------------------------------------------
@@ -264,8 +265,7 @@ test_that("survival predictions with strata", {
   # prediction without strata info should fail
   new_data_s <- new_data_3 %>% dplyr::select(-enum)
   expect_error(
-    predict(f_fit, new_data = new_data_s, type = "survival", eval_time = 20),
-    "provide the strata"
+    predict(f_fit, new_data = new_data_s, type = "survival", eval_time = 20)
   )
 })