Merge pull request #1264 from tidymodels/cli-last-edits

NEWS.md

@@ -18,6 +18,8 @@
 
 * Added warnings when `step_scale()`, `step_normalise()`, `step_center()` or `step_range()` result in `NaN` columns. (@mastoffel, #1221)
 
+* All warnings and errors have been updated to use the cli package for increased clarity and consistency. (#1237)
+
 # recipes 1.0.8
 
 ## Improvements

R/BoxCox.R

@@ -115,10 +115,9 @@ prep.step_BoxCox <- function(x, training, info = NULL, ...) {
   )
   if (any(is.na(values))) {
     var_names <- names(values[is.na(values)])
-    vars <- glue::glue_collapse(glue::backtick(var_names), sep = ", ")
-    rlang::warn(paste(
-      "No Box-Cox transformation could be estimated for:", glue("{vars}")
-    ))
+    cli::cli_warn(
+      "No Box-Cox transformation could be estimated for: {.var {var_names}}."
+    )
   }
   values <- values[!is.na(values)]
   step_BoxCox_new(
@@ -158,10 +157,10 @@ print.step_BoxCox <-
 ## computes the new data
 bc_trans <- function(x, lambda, eps = .001) {
   if (any(x <= 0)) {
-    rlang::warn(paste0(
-      "Applying Box-Cox transformation to non-positive data in column `",
-      names(lambda), "`"
-    ))
+    cli::cli_warn(
+      "Applying Box-Cox transformation to non-positive data in column \\
+      {names(lambda)}"
+    )
   }
 
   if (is.na(lambda)) {
@@ -202,10 +201,10 @@ estimate_bc <- function(dat,
                         num_unique = 5) {
   eps <- .001
   if (length(unique(dat)) < num_unique) {
-    rlang::warn("Fewer than `num_unique` values in selected variable.")
+    cli::cli_warn("Fewer than {.arg num_unique} values in selected variable.")
     return(NA)
   } else if (any(dat <= 0)) {
-    rlang::warn("Non-positive values in selected variable.")
+    cli::cli_warn("Non-positive values in selected variable.")
     return(NA)
   }
 

R/classdist_shrunken.R

@@ -285,12 +285,10 @@ prep.step_classdist_shrunken <- function(x, training, info = NULL, ...) {
   check_type(training[, y_names], types = c("factor"))
 
   threshold <- x$threshold
-  stopifnot(all(threshold >= 0) & all(threshold <= 1) &
-              length(threshold) == 1 & all(!is.na(threshold)))
+  check_number_decimal(threshold, min = 0, max = 1)
 
   sd_offset <- x$sd_offset
-  stopifnot(all(sd_offset >= 0) & all(sd_offset <= 1) &
-              length(sd_offset) == 1 & all(!is.na(sd_offset)))
+  check_number_decimal(sd_offset, min = 0, max = 1)
 
   wts <- get_case_weights(info, training)
   were_weights_used <- are_weights_used(wts)

R/corr.R

@@ -187,28 +187,25 @@ corr_filter <-
     if (any(!complete.cases(x))) {
       all_na <- apply(x, 2, function(x) all(is.na(x)))
       if (sum(all_na) >= nrow(x) - 1) {
-        rlang::warn("Too many correlations are `NA`; skipping correlation filter.")
+        cli::cli_warn(
+          "Too many correlations are `NA`; skipping correlation filter."
+        )
         return(numeric(0))
       } else {
         na_cols <- which(all_na)
         if (length(na_cols) > 0) {
           x[na_cols, ] <- 0
           x[, na_cols] <- 0
-          rlang::warn(
-            paste0(
-              "The correlation matrix has missing values. ",
-              length(na_cols),
-              " columns were excluded from the filter."
-            )
+          cli::cli_warn(
+            "The correlation matrix has missing values. \\
+            {length(na_cols)} column{?s} {?was/were} excluded from the filter."
           )
         }
       }
       if (any(is.na(x))) {
-        rlang::warn(
-          paste0(
-            "The correlation matrix has sporadic missing values. ",
-            "Some columns were excluded from the filter."
-          )
+        cli::cli_warn(
+          "The correlation matrix has sporadic missing values. \\
+          Some columns were excluded from the filter."
         )
         x[is.na(x)] <- 0
       }

R/cut.R

@@ -133,7 +133,19 @@ prep.step_cut <- function(x, training, info = NULL, ...) {
 }
 
 create_full_breaks <- function(var, breaks) {
-  stopifnot(is.numeric(var), is.numeric(breaks))
+  if (!is.numeric(var)) {
+    cli::cli_abort(
+      "{.arg var} must be a numeric vector, not {.obj_type_friendly {var}}."
+    )
+  }
+
+  if (!is.numeric(breaks)) {
+    cli::cli_abort(
+      "{.arg breaks} must be a numeric vector, \\
+      not {.obj_type_friendly {breaks}}."
+    )
+  }
+
   if (min(var) < min(breaks)) {
     breaks <- c(min(var), breaks)
   }
@@ -151,7 +163,7 @@ full_breaks_check <- function(breaks, call = rlang::caller_env()) {
     )
   }
   if (length(breaks) == 2) {
-    rlang::warn("In step_cut: this will create a factor with one value only.")
+    cli::cli_warn("This will create a factor with one value only.")
   }
 }
 
@@ -192,7 +204,12 @@ cut_var <- function(var, breaks, include_outside_range) {
 # the levels when bake.recipe itself is called. Moreover,
 # it is cleaner to show it in this way.
 adjust_levels_min_max <- function(x) {
-  stopifnot(is.factor(x))
+  if (!is.factor(x)) {
+    cli::cli_abort(
+      "{.arg x} must be a factor, not {.obj_type_friendly {x}}.",
+      .internal = TRUE
+    )
+  }
   levs <- levels(x)
   if (length(levs) == 1) {
     return(factor(rep("[min,max]", length(x))))

R/discretize.R

@@ -114,14 +114,9 @@ discretize.numeric <-
       num_breaks <- length(breaks)
       breaks <- unique(breaks)
       if (num_breaks > length(breaks)) {
-        rlang::warn(
-          paste0(
-            "Not enough data for ",
-            cuts,
-            " breaks. Only ",
-            length(breaks),
-            " breaks were used."
-          )
+        cli::cli_warn(
+          "Not enough data for {cuts} breaks. \\
+          Only {length(breaks)} breaks were used."
         )
       }
       if (infs) {
@@ -133,13 +128,10 @@ discretize.numeric <-
       if (is.null(labels)) {
         prefix <- prefix[1]
         if (make.names(prefix) != prefix && !is.null(prefix)) {
-          rlang::warn(paste0(
-            "The prefix '",
-            prefix,
-            "' is not a valid R name. It has been changed to '",
-            make.names(prefix),
-            "'."
-          ))
+          cli::cli_warn(
+            "The prefix {.val {prefix}} is not a valid R name. \\
+            It has been changed to {.val {make.names(prefix)}}."
+          )
           prefix <- make.names(prefix)
         }
         labels <- names0(length(breaks) - 1, "")
@@ -157,11 +149,9 @@ discretize.numeric <-
       )
     } else {
       out <- list(bins = 0)
-      rlang::warn(
-        paste0(
-          "Data not binned; too few unique values per bin. ",
-          "Adjust 'min_unique' as needed"
-        )
+      cli::cli_warn(
+        "Data not binned; too few unique values per bin. \\
+        Adjust {.arg min_unique} as needed."
       )
     }
     class(out) <- "discretize"
@@ -360,11 +350,9 @@ prep.step_discretize <- function(x, training, info = NULL, ...) {
   check_type(training[, col_names], types = c("double", "integer"))
 
   if (length(col_names) > 1 & any(names(x$options) %in% c("prefix", "labels"))) {
-    rlang::warn(
-      paste0(
-        "Note that the options `prefix` and `labels` ",
-        "will be applied to all variables"
-      )
+    cli::cli_warn(
+      "Note that the options {.arg prefix} and {.arg labels} will be applied \\
+      to all variables."
     )
   }
 

R/dummy.R

@@ -223,13 +223,10 @@ warn_new_levels <- function(dat, lvl, details = NULL) {
   ind <- which(!(dat %in% lvl))
   if (length(ind) > 0) {
     lvl2 <- unique(dat[ind])
-    rlang::warn(
-      paste0(
-        "There are new levels in a factor: ",
-        paste0(lvl2, collapse = ", "),
-        details
-      )
-    )
+    cli::cli_warn(c(
+      "!" = "There are new levels in a factor: {.var {lvl2}}.",
+      details
+    ))
   }
   invisible(NULL)
 }

R/extract_parameter.R

@@ -31,7 +31,9 @@ eval_call_info <- function(x) {
     }
     res <- try(rlang::eval_tidy(rlang::call2(x$fun, .ns = x$pkg, !!!opts)), silent = TRUE)
     if (inherits(res, "try-error")) {
-      stop(paste0("Error when calling ", x$fun, "(): ", as.character(res)))
+      cli::cli_abort(
+        "Error when calling {.fn {x$fun}}: {as.character(res)}"
+      )
     }
   } else {
     res <- NA

R/impute_bag.R

@@ -301,7 +301,7 @@ bake.step_impute_bag <- function(object, new_data, ...) {
     pred_data <- old_data[missing_rows, preds, drop = FALSE]
     ## do a better job of checking this:
     if (all(is.na(pred_data))) {
-      rlang::warn("All predictors are missing; cannot impute")
+      cli::cli_warn("All predictors are missing; cannot impute.")
     } else {
       pred_vals <- predict(object$models[[col_name]], pred_data)
       # For an ipred bug reported on 2021-09-14:

R/impute_knn.R

@@ -276,7 +276,7 @@ bake.step_impute_knn <- function(object, new_data, ...) {
     imp_data <- old_data[missing_rows, preds, drop = FALSE]
     ## do a better job of checking this:
     if (all(is.na(imp_data))) {
-      rlang::warn("All predictors are missing; cannot impute")
+      cli::cli_warn("All predictors are missing; cannot impute.")
     } else {
       imp_var_complete <- !is.na(object$ref_data[[col_name]])
       nn_ind <- nn_index(

R/impute_linear.R

@@ -216,10 +216,10 @@ bake.step_impute_linear <- function(object, new_data, ...) {
     pred_data <- old_data[missing_rows, preds, drop = FALSE]
     ## do a better job of checking this:
     if (any(is.na(pred_data))) {
-      rlang::warn("
-        There were missing values in the predictor(s) used to impute;
-        imputation did not occur.
-      ")
+      cli::cli_warn(
+        "There were missing values in the predictor(s) used to impute; \\
+        imputation did not occur."
+      )
     } else {
       pred_vals <- predict(object$models[[col_name]], pred_data)
       pred_vals <- cast(pred_vals, new_data[[col_name]])

R/impute_mean.R

@@ -141,12 +141,14 @@ trim <- function(x, trim) {
   # Adapted from mean.default
   x <- sort(x, na.last = TRUE)
   na_ind <- is.na(x)
-  if (!is.numeric(trim) || length(trim) != 1L)
-    stop("'trim' must be numeric of length one")
+  if (!is.numeric(trim) || length(trim) != 1L) {
+    cli::cli_abort("{.arg trim} must be numeric of length one.")
+  }
   n <- length(x[!na_ind])
   if (trim > 0 && n) {
-    if (is.complex(x))
-      stop("trimmed means are not defined for complex data")
+    if (is.complex(x)) {
+      cli::cli_abort("Trimmed means are not defined for complex data.")
+    }
     if (trim >= 0.5)
       return(stats::median(x[!na_ind], na.rm = FALSE))
     lo <- floor(n * trim) + 1

R/impute_mode.R

@@ -165,12 +165,11 @@ bake.step_impute_mode <- function(object, new_data, ...) {
       next
     }
     if (is.null(object$ptype)) {
-      rlang::warn(
-        paste0(
-          "'ptype' was added to `step_impute_mode()` after this recipe was created.\n",
-          "Regenerate your recipe to avoid this warning."
-        )
-      )
+      cli::cli_warn(c(
+        "!" = "{.arg ptype} was added to {.fn step_impute_mode} after this \\
+              recipe was created.",
+        "i" = "Regenerate your recipe to avoid this warning."
+      ))
     } else {
       new_data[[col_name]] <- vctrs::vec_cast(
         new_data[[col_name]],

R/interact.R

@@ -206,13 +206,11 @@ prep.step_interact <- function(x, training, info = NULL, ...) {
       unique(unlist(lapply(make_new_formula(int_terms), all.vars)))
     var_check <- info[info$variable %in% vars, ]
     if (any(var_check$type == "nominal")) {
-      rlang::warn(
-        paste0(
-          "Categorical variables used in `step_interact` should probably be ",
-          "avoided;  This can lead to differences in dummy variable values that ",
-          "are produced by `step_dummy`. Please convert all involved variables ",
-          "to dummy variables first."
-        )
+      cli::cli_warn(
+        "Categorical variables used in {.fn step_interact} should probably be \\
+        avoided; This can lead to differences in dummy variable values that \\
+        are produced by {.help [?step_dummy](recipes::step_dummy)}. Please \\
+        convert all involved variables to dummy variables first."
       )
     }
 
@@ -325,13 +323,11 @@ get_term_names <- function(form, vnames) {
     silent = TRUE
   )
   if (inherits(nms, "try-error")) {
-    rlang::warn(
-      paste0(
-        "Interaction specification failed for: ",
-        deparse(form),
-        ". No interactions will be created."
-      )
-    )
+    cli::cli_warn(c(
+      "!" = "Interaction specification failed for:",
+      "*" = deparse(form),
+      "i" = "No interactions will be created"
+    ))
     return(rlang::na_chr)
   }
   nms <- nms[nms != "(Intercept)"]

R/intercept.R

@@ -55,7 +55,7 @@ step_intercept <- function(recipe, ..., role = "predictor",
                            value = 1L,
                            skip = FALSE, id = rand_id("intercept")) {
   if (length(list(...)) > 0) {
-    rlang::warn("Selectors are not used for this step.")
+    cli::cli_warn("Selectors are not used for this step.")
   }
 
   check_number_decimal(value)

R/log.R

@@ -133,7 +133,7 @@ bake.step_log <- function(object, new_data, ...) {
   }
 
   if (object$signed && object$offset != 0) {
-    rlang::warn("When signed is TRUE, offset will be ignored")
+    cli::cli_warn("When {.arg signed} is TRUE, {.arg offset} will be ignored.")
   }
 
   for (col_name in col_names) {

R/normalize.R

@@ -111,15 +111,15 @@ step_normalize_new <-
 sd_check <- function(x) {
   zero_sd <- which(x < .Machine$double.eps)
   if (length(zero_sd) > 0) {
-    glue_cols <- glue::glue_collapse(
-      glue("`{names(zero_sd)}`"), sep = ", ", last = " and "
-    )
-    rlang::warn(
-      glue(
-        "Column(s) have zero variance so scaling cannot be used: {glue_cols}. ",
-        "Consider using `step_zv()` to remove those columns before normalizing"
-      )
-    )
+    offenders <- names(zero_sd)
+
+    cli::cli_warn(c(
+      "!" = "{cli::qty(offenders)} The following column{?s} {?has/have} zero \\
+            variance so scaling cannot be used: {offenders}.",
+      "i" = "Consider using {.help [?step_zv](recipes::step_zv)} to remove \\
+            those columns before normalizing."
+    ))
+
     x[zero_sd] <- 1
   }