Convert errors to use cli (#91)

Co-authored-by: Emil Hvitfeldt <[email protected]>

Author: aluxh

DESCRIPTION

@@ -21,6 +21,7 @@ Depends:
     parsnip (>= 1.0.3),
     R (>= 4.1)
 Imports: 
+    cli,
     dials (>= 0.1.1.9001),
     dplyr,
     generics (>= 0.1.0),

NAMESPACE

@@ -28,7 +28,6 @@ importFrom(generics,tidy)
 importFrom(generics,tunable)
 importFrom(parsnip,multi_predict)
 importFrom(purrr,map_dfr)
-importFrom(rlang,abort)
 importFrom(rlang,call2)
 importFrom(rlang,enquos)
 importFrom(rlang,eval_tidy)

R/C5_rules.R

@@ -41,7 +41,7 @@ c5_fit <- function(x, y, trials = 1, minCases = 2, cost = NULL, ...) {
 
   if (!is.null(cost)) {
     if (length(levels(y) != 2)) {
-      rlang::abort("Cost-sensitive models only implemented for 2 classes.")
+      cli::cli_abort("Cost-sensitive models only implemented for 2 classes.")
     }
     costs <- matrix(c(0, 1, cost, 0), nrow = 2, byrow = TRUE)
     args$costs <- costs
@@ -54,7 +54,7 @@ c5_fit <- function(x, y, trials = 1, minCases = 2, cost = NULL, ...) {
 
 c5_pred_wrap <- function(trials = 1, object, new_data, type = "class", ...) {
   if (length(trials) > 1) {
-    rlang::abort("`c5_pred_wrap` takes a single value of `trials`")
+    cli::cli_abort("`c5_pred_wrap` takes a single value of {.arg trials}")
   }
   trials[trials < 1] <- 1L
   trials[trials > 100] <- 100L

R/cubist_rules.R

@@ -95,7 +95,7 @@ get_neighbors <- function(x) {
 
 cubist_pred_wrap <- function(neighbors = 0, object, new_data, ...) {
   if (length(neighbors) > 1) {
-    rlang::abort("`cubist_pred_wrap` takes a single neighbor.")
+    cli::cli_abort("{.fn cubist_pred_wrap} takes a single neighbor.")
   }
   object$spec$args$neighbors <- neighbors
   res <- predict(object, new_data)
@@ -203,7 +203,9 @@ tunable.cubist_rules <- function(x, ...) {
 multi_predict._cubist <-
   function(object, new_data, type = NULL, neighbors = NULL, ...) {
     if (any(names(enquos(...)) == "newdata")) {
-      rlang::abort("Did you mean to use `new_data` instead of `newdata`?")
+      cli::cli_abort(
+        "Did you mean to use {.arg new_data} instead of {.arg newdata}?"
+      )
     }
     if (is.null(neighbors)) {
       n <- 1

R/rule_fit.R

@@ -82,7 +82,7 @@ xrf_fit <-
 
 process_mtry <- function(colsample_bytree, counts, n_predictors, is_missing) {
   if (!is.logical(counts)) {
-    rlang::abort("'counts' should be a logical value.")
+    cli::cli_abort("{.arg counts} should be a logical value.")
   }
 
   ineq <- if (counts) {
@@ -102,35 +102,21 @@ process_mtry <- function(colsample_bytree, counts, n_predictors, is_missing) {
   }
 
   if ((colsample_bytree < 1 & counts) | (colsample_bytree > 1 & !counts)) {
-    rlang::abort(
-      paste0(
-        "The supplied argument `mtry = ",
-        colsample_bytree,
-        "` must be ",
-        ineq,
-        " than or equal to 1. \n\n`mtry` is currently being interpreted ",
-        "as a ",
-        interp,
-        " rather than a ",
-        opp,
-        ". Supply `counts = ",
-        !counts,
-        "` to `set_engine()` to supply this argument as a ",
-        opp,
-        " rather than ",
-        # TODO: add a section to the linked parsnip docs on mtry vs mtry_prop
-        "a ",
-        interp,
-        ". \n\nSee `?details_rule_fit_xrf` for more details."
-      ),
-      call = NULL
+    cli::cli_abort(
+      c(
+        "The supplied argument `{.arg mtry} = {colsample_bytree}` must be {ineq} than or equal to 1.",
+        "i" = "{.arg mtry} is currently being interpreted as a {interp} rather than a {opp}.",
+        "i" = "Supply `{.arg counts} = {!counts}` to `set_engine()` to supply this argument as a {opp} rather than a {interp}.",
+        "i" = "See {.help details_rule_fit_xrf} for more details.",
+        call = NULL
+      )
     )
   }
 
   if (rlang::is_call(colsample_bytree)) {
     if (rlang::call_name(colsample_bytree) == "tune") {
-      rlang::abort(
-        paste0(
+      cli::cli_abort(
+        c(
           "The supplied `mtry` parameter is a call to `tune`. Did you forget ",
           "to optimize hyperparameters with a tuning function like `tune::tune_grid`?"
         ),
@@ -220,7 +206,9 @@ xrf_pred <- function(object, new_data, lambda = object$fit$lambda, type, ...) {
 multi_predict._xrf <-
   function(object, new_data, type = NULL, penalty = NULL, ...) {
     if (any(names(enquos(...)) == "newdata")) {
-      rlang::abort("Did you mean to use `new_data` instead of `newdata`?")
+      cli::cli_abort(
+        "Did you mean to use {.arg new_data} instead of {.arg newdata}?"
+      )
     }
     if (is.null(penalty)) {
       penalty <- object$fit$lambda

R/rules-package.R

@@ -6,7 +6,6 @@
 #' @importFrom dplyr as_tibble
 #' @importFrom dplyr tibble
 #' @importFrom purrr map_dfr
-#' @importFrom rlang abort
 #' @importFrom rlang call2
 #' @importFrom rlang enquos
 #' @importFrom rlang eval_tidy

R/tidy_C5.0.R

@@ -200,7 +200,7 @@ get_rule_index <- function(index, tree, history = c(), levels) {
     res <- c(res, new_rules)
   } else {
     msg <- paste("Unknown split type", curr$type)
-    rlang::abort(msg)
+    cli::cli_abort("{msg}")
   }
 
   res
@@ -231,7 +231,7 @@ get_freqs <- function(rule, tree, lvls) {
       length(lvls),
       ")."
     )
-    rlang::abort(msg)
+    cli::cli_abort("{msg}")
   }
   tibble::tibble(value = lvls, count = freqs)
 }

R/tidy_cubist.R

@@ -144,7 +144,7 @@ get_reg_data <- function(txt, results = "expression") {
   if (length(vals) > 0) {
     n_elem <- length(vals)
     if (n_elem %% 2 != 0) {
-      rlang::abort("number of remaining terms not even", call. = FALSE)
+      cli::cli_abort("Number of remaining terms is not even.", call. = FALSE)
     }
     n_terms <- n_elem / 2
     split_terms <- split(vals, rep(1:n_terms, each = 2))
@@ -158,7 +158,7 @@ get_reg_data <- function(txt, results = "expression") {
 splits_to_coefs <- function(x, int) {
   num_check <- purrr::map_int(x, length)
   if (!all(num_check == 2)) {
-    rlang::abort("Problem with getting coefficients")
+    cli::cli_abort("Problem with getting coefficients")
   }
   coef_val <- purrr::map_dbl(x, \(.x) as.numeric(.x[2]))
   res <- tibble(term = purrr::map_chr(x, \(.x) .x[1]), estimate = coef_val)

R/tidy_xrf.R

@@ -5,10 +5,10 @@ tidy.xrf <- function(x, penalty = NULL, unit = c("rules", "columns"), ...) {
 
   msg <- "Please choose a single numeric value of 'penalty'."
   if (is.null(penalty)) {
-    rlang::abort(msg)
+    cli::cli_abort("{msg}")
   } else {
     if (!is.numeric(penalty) | length(penalty) != 1) {
-      rlang::abort(msg)
+      cli::cli_abort("{msg}")
     }
   }
 
@@ -51,7 +51,7 @@ xrf_coefs <- function(x, penalty = NULL) {
     penalty <- x$lambda
   }
   if (length(penalty) != 1) {
-    rlang::abort("`penalty` should be a single numeric measure.")
+    cli::cli_abort("{.arg penalty} should be a single numeric measure.")
   }
 
   lvls <- x$levels