switch to cli functions

DESCRIPTION

@@ -20,6 +20,7 @@ Depends:
     R (>= 3.6),
     recipes (>= 1.1.0.9000)
 Imports:
+    cli,
     glue,
     dplyr (>= 1.1.0),
     generics (>= 0.1.0),

R/collapse_stringdist.R

@@ -79,7 +79,7 @@ step_collapse_stringdist <-
            skip = FALSE,
            id = rand_id("collapse_stringdist")) {
     if (is.null(distance)) {
-      rlang::abort("`distance` argument must be set.")
+      cli::cli_abort("The {.arg distance} argument must be set.")
     }
 
     add_step(

R/discretize_cart.R

@@ -104,7 +104,9 @@ step_discretize_cart <-
     recipes_pkg_check(required_pkgs.step_discretize_cart())
 
     if (is.null(outcome)) {
-      rlang::abort("`outcome` should select at least one column.")
+      cli::cli_abort(
+        "The {.arg outcome} argument should select at least one column."
+      )
     }
 
     add_step(
@@ -167,24 +169,20 @@ cart_binning <- function(predictor, term, outcome, cost_complexity, tree_depth,
 
   if (inherits(cart_mdl, "try-error")) {
     err <- conditionMessage(attr(cart_mdl, "condition"))
-    msg <-
-      glue(
-        "`step_discretize_cart()` failed to create a tree with error for ",
-        "predictor '{term}', which will not be binned. The error: {err}"
-      )
-    rlang::warn(msg)
+    cli::cli_warn(
+      "step_discretize_cart() failed to create a tree for predictor {.var {term}}, 
+      which will not be binned. The error: {err}"
+    )
     return(numeric(0))
   }
 
   if (any(names(cart_mdl) == "splits")) {
     cart_split <- sort(unique(cart_mdl$splits[, "index"]))
   } else {
-    msg <-
-      glue(
-        "`step_discretize_cart()` failed to find any meaningful splits for ",
-        "predictor '{term}', which will not be binned."
-      )
-    rlang::warn(msg)
+    cli::cli_warn(
+      "{.fn step_discretize_cart} failed to find any meaningful splits for 
+      predictor {.val {term}}, which will not be binned."
+    )
     cart_split <- numeric(0)
   }
   cart_split

R/discretize_xgb.R

@@ -117,7 +117,7 @@ step_discretize_xgb <-
            skip = FALSE,
            id = rand_id("discretize_xgb")) {
     if (is.null(outcome)) {
-      rlang::abort("`outcome` should select at least one column.")
+      cli::cli_abort("{.arg outcome} should select at least one column.")
     }
 
     recipes_pkg_check(required_pkgs.step_discretize_xgb())
@@ -300,10 +300,10 @@ xgb_binning <- function(df, outcome, predictor, sample_val, learn_rate,
         nthread = 1
       )
     } else {
-      rlang::abort(
-        paste0(
-          "Outcome variable only has less than 2 levels. ",
-          "Doesn't conform to regresion or classification task."
+      cli::cli_abort(
+        c(
+          "Outcome variable only has less than 2 levels.",
+          "i" = "Doesn't conform to regresion or classification task."
         ),
         call = call
       )
@@ -330,12 +330,10 @@ xgb_binning <- function(df, outcome, predictor, sample_val, learn_rate,
 
   if (inherits(xgb_mdl, "try-error")) {
     err <- conditionMessage(attr(xgb_mdl, "condition"))
-    msg <-
-      glue(
-        "`step_discretize_xgb()` failed to create a tree with error for ",
-        "predictor '{predictor}', which was not binned. The error: {err}"
-      )
-    rlang::warn(msg)
+    cli::cli_warn(
+      "Failed to create {.fn step_discretize_xgb} tree for predictor 
+      {.val {predictor}}, which was not binned. The error: {err}"
+    )
     return(numeric(0))
   }
 
@@ -356,20 +354,21 @@ xgb_binning <- function(df, outcome, predictor, sample_val, learn_rate,
   if (inherits(xgb_tree, "try-error")) {
     err <- conditionMessage(attr(xgb_tree, "condition"))
     if (grepl("Non-tree model detected", err)) {
-      msg <- glue(
-        "`step_discretize_xgb()` failed for predictor '{predictor}'. ",
-        "This could be because the data have no trend or because ",
-        "the learning rate is too low (current value: {learn_rate}). ",
-        "The predictor was not binned."
+      cli::cli_warn(
+        c(
+          "{.fn step_discretize_xgb} failed for predictor {.val {predictor}}.",
+          "i" = "This could be because the data have no trend or because
+           the learning rate is too low (current value: {learn_rate}).",
+          "i" = "The predictor was not binned."
+        )
       )
     } else {
-      msg <- glue(
-        "`step_discretize_xgb()` failed to create a tree with error for ",
-        "predictor '{predictor}', which was not binned. The error: {err}"
+      cli::cli_warn(
+        "step_discretize_xgb() failed to create a tree with error for predictor 
+        {.val {predictor}}, which was not binned. The error: {err}"
       )
     }
 
-    rlang::warn(msg)
     return(numeric(0))
   }
 
@@ -409,10 +408,10 @@ prep.step_discretize_xgb <- function(x, training, info = NULL, ...) {
     test_size <- sum(complete.cases(training)) * x$sample_val
 
     if (floor(test_size) < 2) {
-      rlang::abort(
-        glue(
+      cli::cli_abort(
+        c(
           "Too few observations in the early stopping validation set.",
-          "Consider increasing the `sample_val` parameter."
+          "i" = "Consider increasing the {.arg sample_val} parameter."
         )
       )
     }
@@ -424,11 +423,11 @@ prep.step_discretize_xgb <- function(x, training, info = NULL, ...) {
     too_few <- num_unique < 20
     if (any(too_few)) {
       predictors <- paste0("'", col_names[too_few], "'", collapse = ", ")
-      rlang::warn(
-        glue(
-          "More than 20 unique training set values are required. ",
-          "Predictors {predictors} were not processed; ",
-          "their original values will be used."
+      cli::cli_warn(
+        c(
+          "More than 20 unique training set values are required.",
+          "i" = "Predictors {predictors} were not processed; 
+                their original values will be used."
         )
       )
       col_names <- col_names[!too_few]

R/embed.R

@@ -159,7 +159,7 @@ step_embed <-
     is_tf_available()
 
     if (is.null(outcome)) {
-      rlang::abort("Please list a variable in `outcome`")
+      cli::cli_abort("Please list a variable in {.arg outcome}.")
     }
     add_step(
       recipe,
@@ -261,10 +261,10 @@ prep.step_embed <- function(x, training, info = NULL, ...) {
 
 is_tf_2 <- function() {
   if (!is_tf_available()) {
-    rlang::abort(
+    cli::cli_abort(
       c(
         "tensorflow could now be found.",
-        "Please run `tensorflow::install_tensorflow()` to install."
+        "i" = "Please run {.code tensorflow::install_tensorflow()} to install."
       )
     )
   }
@@ -491,13 +491,13 @@ embed_control <- function(loss = "mse",
                           verbose = 0,
                           callbacks = NULL) {
   if (batch_size < 1) {
-    rlang::abort("`batch_size` should be a positive integer")
+    cli::cli_abort("{.arg batch_size} should be a positive integer.")
   }
   if (epochs < 1) {
-    rlang::abort("`epochs` should be a positive integer")
+    cli::cli_abort("{.arg epochs} should be a positive integer.")
   }
   if (validation_split < 0 || validation_split > 1) {
-    rlang::abort("`validation_split` should be on [0, 1)")
+    cli::cli_abort("{.arg validation_split} should be on [0, 1).")
   }
   list(
     loss = loss, metrics = metrics, optimizer = optimizer, epochs = epochs,
@@ -518,19 +518,17 @@ tf_options_check <- function(opt) {
   )
 
   if (length(setdiff(exp_names, names(opt))) > 0) {
-    rlang::abort(
-      paste0(
-        "The following options are missing from the `options`: ",
-        paste0(setdiff(exp_names, names(opt)), collapse = ",")
-      )
+    cli::cli_abort(
+      "The options {.code {setdiff(exp_names, names(opt))}} are missing from 
+      {.arg options}."
     )
   }
   opt
 }
 
 class2ind <- function(x) {
   if (!is.factor(x)) {
-    rlang::abort("'x' should be a factor")
+    cli::cli_abort("{.arg x} should be a factor.")
   }
   y <- model.matrix(~ x - 1)
   colnames(y) <- gsub("^x", "", colnames(y))

R/lencode_bayes.R

@@ -117,7 +117,7 @@ step_lencode_bayes <-
            skip = FALSE,
            id = rand_id("lencode_bayes")) {
     if (is.null(outcome)) {
-      rlang::abort("Please list a variable in `outcome`")
+      cli::cli_abort("Please list a variable in {.code outcome}.")
     }
     add_step(
       recipe,

R/lencode_glm.R

@@ -89,7 +89,7 @@ step_lencode_glm <-
            skip = FALSE,
            id = rand_id("lencode_glm")) {
     if (is.null(outcome)) {
-      rlang::abort("Please list a variable in `outcome`")
+      cli::cli_abort("Please list a variable in {.arg outcome}.")
     }
     add_step(
       recipe,

R/lencode_mixed.R

@@ -103,7 +103,7 @@ step_lencode_mixed <-
            skip = FALSE,
            id = rand_id("lencode_mixed")) {
     if (is.null(outcome)) {
-      rlang::abort("Please list a variable in `outcome`")
+      cli::cli_abort("Please list a variable in {.arg outcome}.")
     }
     add_step(
       recipe,
@@ -153,10 +153,9 @@ prep.step_lencode_mixed <- function(x, training, info = NULL, ...) {
     y_name <- recipes_eval_select(x$outcome, training, info)
     if (is.factor(training[[y_name]])) {
       if (length(levels(training[[y_name]])) > 2) {
-        rlang::abort(glue(
-          "Mixed effects methods here are only implemented for ",
-          "two-class problems."
-        ))
+        cli::cli_abort(
+          "Mixed effects methods here are only implemented for two-class problems."
+        )
       }
     }
     res <-

R/umap.R

@@ -142,7 +142,7 @@ step_umap <-
       seed <- as.integer(seed)
     }
     if (length(seed) != 2) {
-      rlang::abort("Two integers are required for `seed`.")
+      cli::cli_abort("Two integers are required for {.arg seed}.")
     }
 
     add_step(

R/woe.R

@@ -156,7 +156,7 @@ step_woe <- function(recipe,
                      skip = FALSE,
                      id = rand_id("woe")) {
   if (missing(outcome)) {
-    rlang::abort('argument "outcome" is missing, with no default')
+    cli::cli_abort("The {.arg outcome} argument is missing, with no default.")
   }
 
   add_step(
@@ -233,12 +233,13 @@ woe_table <- function(predictor,
   }
 
   if (length(outcome_original_labels) != 2) {
-    rlang::abort(sprintf(
-      "'outcome' must have exactly 2 categories (has %s)",
-      length(outcome_original_labels)
-    ), call = call)
+    cli::cli_abort(
+      "{.arg outcome} must have exactly 2 categories 
+      (has {length(outcome_original_labels)}).", 
+      call = call
+    )
   }
-
+  
   if (is.factor(predictor)) {
     predictor <- as.character(predictor)
   }
@@ -356,26 +357,26 @@ dictionary <- function(.data, outcome, ..., Laplace = 1e-6) {
 #' @export
 add_woe <- function(.data, outcome, ..., dictionary = NULL, prefix = "woe") {
   if (missing(.data)) {
-    rlang::abort('argument ".data" is missing, with no default')
+    cli::cli_abort("The {.arg .data} argument is missing, with no default.")
   }
   if (missing(outcome)) {
-    rlang::abort('argument "outcome" is missing, with no default')
+    cli::cli_abort("Argument {.arg outcome} is missing, with no default.")
   }
   if (!is.character(outcome)) {
-    rlang::abort("'outcome' should be a single character value.")
+    cli::cli_abort("{.arg outcome} should be a single character value.")
   }
 
   if (is.null(dictionary)) {
     dictionary <- dictionary(.data, outcome, ...)
   } else {
     if (is.null(dictionary$variable)) {
-      rlang::abort('column "variable" is missing in dictionary.')
+      cli::cli_abort('Column {.field variable} is missing in dictionary.')
     }
     if (is.null(dictionary$predictor)) {
-      rlang::abort('column "predictor" is missing in dictionary.')
+      cli::cli_abort('The column {.code predictor} is missing in the dictionary.')
     }
     if (is.null(dictionary$woe)) {
-      rlang::abort('column "woe" is missing in dictionary.')
+      cli::cli_abort('Column {.field woe} is missing in dictionary.')
     }
   }
 
@@ -447,12 +448,10 @@ prep.step_woe <- function(x, training, info = NULL, ...) {
 
     if (any(n_count$low_n > 0)) {
       flagged <- n_count$variable[n_count$low_n > 0]
-      flagged <- paste0("'", unique(flagged), "'", collapse = ", ")
-      msg <- glue(
-        "Some columns used by `step_woe()` have categories with ",
-        "less than 10 values: {flagged}"
+      cli::cli_warn(
+        "Some columns used by {.fn step_woe} have categories with fewer than 10 
+        values: {.val {unique(flagged)}}"
       )
-      rlang::warn(msg)
     }
   } else {
     x$dictionary <- tibble::tibble()