Cli last phase

NEWS.md

@@ -16,6 +16,8 @@ calculated with `roc_auc_survival()`.
 
 * `demographic_parity()`, `equalized_odds()`, and `equal_opportunity()` are new metrics for measuring model fairness. Each is implemented with the `new_groupwise_metric()` constructor, a general interface for defining group-aware metrics that allows for quickly and flexibly defining fairness metrics with the problem context in mind.
 
+* All warnings and errors have been updated to use the cli package for increased clarity and consistency. (#456, #457, #458)
+
 # yardstick 1.2.0
 
 ## New Metrics

R/aaa-metrics.R

@@ -547,18 +547,17 @@ validate_not_empty <- function(x, call = caller_env()) {
   }
 }
 
-validate_inputs_are_functions <- function(fns) {
+validate_inputs_are_functions <- function(fns, call = caller_env()) {
   # Check that the user supplied all functions
   is_fun_vec <- vapply(fns, is_function, logical(1))
   all_fns <- all(is_fun_vec)
 
   if (!all_fns) {
     not_fn <- which(!is_fun_vec)
-    not_fn <- paste(not_fn, collapse = ", ")
-    stop(
-      "All inputs to `metric_set()` must be functions. ",
-      "These inputs are not: (", not_fn, ").",
-      call. = FALSE
+    cli::cli_abort(
+      "All inputs to {.fn metric_set} must be functions. \\
+      These inputs are not: {not_fn}.",
+      call = call
     )
   }
 }

R/class-precision.R

@@ -178,14 +178,20 @@ precision_multiclass <- function(data, estimator) {
 }
 
 warn_precision_undefined_binary <- function(event, count) {
-  message <- paste0(
-    "While computing binary `precision()`, no predicted events were detected ",
-    "(i.e. `true_positive + false_positive = 0`). ",
-    "\n",
-    "Precision is undefined in this case, and `NA` will be returned.",
-    "\n",
-    "Note that ", count, " true event(s) actually occured for the problematic ",
-    "event level, '", event, "'."
+  message <- c(
+    "While computing binary {.fn precision}, no predicted events were \\
+    detected (i.e. `true_positive + false_positive = 0`).",
+    "Precision is undefined in this case, and `NA` will be returned."
+  )
+
+  message <- c(
+    message,
+    paste(
+      "Note that",
+      count,
+      "true event(s) actually occured for the problematic event level,",
+      event
+    )
   )
 
   warn_precision_undefined(
@@ -197,15 +203,14 @@ warn_precision_undefined_binary <- function(event, count) {
 }
 
 warn_precision_undefined_multiclass <- function(events, counts) {
-  message <- paste0(
-    "While computing multiclass `precision()`, some levels had no predicted events ",
-    "(i.e. `true_positive + false_positive = 0`). ",
-    "\n",
-    "Precision is undefined in this case, and those levels will be removed from the averaged result.",
-    "\n",
-    "Note that the following number of true events actually occured for each problematic event level:",
-    "\n",
-    paste0("'", events, "': ", counts, collapse = "\n")
+  message <- c(
+    "While computing multiclass {.fn precision}, some levels had no predicted \\
+    events (i.e. `true_positive + false_positive = 0`).",
+    "Precision is undefined in this case, and those levels will be removed \\
+    from the averaged result.",
+    "Note that the following number of true events actually occured for each \\
+    problematic event level:",
+    paste0("'", events, "': ", counts, collapse = ", ")
   )
 
   warn_precision_undefined(
@@ -217,7 +222,7 @@ warn_precision_undefined_multiclass <- function(events, counts) {
 }
 
 warn_precision_undefined <- function(message, events, counts, ..., class = character()) {
-  warn(
+  cli::cli_warn(
     message = message,
     class = c(class, "yardstick_warning_precision_undefined"),
     events = events,

R/class-recall.R

@@ -179,14 +179,20 @@ recall_multiclass <- function(data, estimator) {
 
 
 warn_recall_undefined_binary <- function(event, count) {
-  message <- paste0(
-    "While computing binary `recall()`, no true events were detected ",
-    "(i.e. `true_positive + false_negative = 0`). ",
-    "\n",
-    "Recall is undefined in this case, and `NA` will be returned.",
-    "\n",
-    "Note that ", count, " predicted event(s) actually occured for the problematic ",
-    "event level, '", event, "'."
+  message <- c(
+    "While computing binary {.fn recall}, no true events were detected \\
+    (i.e. `true_positive + false_negative = 0`).",
+    "Recall is undefined in this case, and `NA` will be returned."
+  )
+
+  message <- c(
+    message,
+    paste(
+      "Note that",
+      count,
+      "predicted event(s) actually occured for the problematic event level",
+      event
+    )
   )
 
   warn_recall_undefined(
@@ -198,15 +204,14 @@ warn_recall_undefined_binary <- function(event, count) {
 }
 
 warn_recall_undefined_multiclass <- function(events, counts) {
-  message <- paste0(
-    "While computing multiclass `recall()`, some levels had no true events ",
-    "(i.e. `true_positive + false_negative = 0`). ",
-    "\n",
-    "Recall is undefined in this case, and those levels will be removed from the averaged result.",
-    "\n",
-    "Note that the following number of predicted events actually occured for each problematic event level:",
-    "\n",
-    paste0("'", events, "': ", counts, collapse = "\n")
+  message <- c(
+    "While computing multiclass {.fn recall}, some levels had no true events \\
+    (i.e. `true_positive + false_negative = 0`).",
+    "Recall is undefined in this case, and those levels will be removed from \\
+    the averaged result.",
+    "Note that the following number of predicted events actually occured for \\
+    each problematic event level:",
+    paste0("'", events, "': ", counts, collapse = ", ")
   )
 
   warn_recall_undefined(
@@ -218,7 +223,7 @@ warn_recall_undefined_multiclass <- function(events, counts) {
 }
 
 warn_recall_undefined <- function(message, events, counts, ..., class = character()) {
-  warn(
+  cli::cli_warn(
     message = message,
     class = c(class, "yardstick_warning_recall_undefined"),
     events = events,

R/class-sens.R

@@ -277,14 +277,20 @@ sens_multiclass <- function(data, estimator) {
 
 
 warn_sens_undefined_binary <- function(event, count) {
-  message <- paste0(
-    "While computing binary `sens()`, no true events were detected ",
-    "(i.e. `true_positive + false_negative = 0`). ",
-    "\n",
-    "Sensitivity is undefined in this case, and `NA` will be returned.",
-    "\n",
-    "Note that ", count, " predicted event(s) actually occured for the problematic ",
-    "event level, '", event, "'."
+  message <- c(
+    "While computing binary {.fn sens}, no true events were detected \\
+    (i.e. `true_positive + false_negative = 0`).",
+    "Sensitivity is undefined in this case, and `NA` will be returned."
+  )
+
+  message <- c(
+    message,
+    paste(
+      "Note that",
+      count,
+      "predicted event(s) actually occured for the problematic event level,",
+      event
+    )
   )
 
   warn_sens_undefined(
@@ -296,15 +302,14 @@ warn_sens_undefined_binary <- function(event, count) {
 }
 
 warn_sens_undefined_multiclass <- function(events, counts) {
-  message <- paste0(
-    "While computing multiclass `sens()`, some levels had no true events ",
-    "(i.e. `true_positive + false_negative = 0`). ",
-    "\n",
-    "Sensitivity is undefined in this case, and those levels will be removed from the averaged result.",
-    "\n",
-    "Note that the following number of predicted events actually occured for each problematic event level:",
-    "\n",
-    paste0("'", events, "': ", counts, collapse = "\n")
+  message <- c(
+    "While computing multiclass {.fn sens}, some levels had no true events \\
+    (i.e. `true_positive + false_negative = 0`).",
+    "Sensitivity is undefined in this case, and those levels will be removed \\
+    from the averaged result.",
+    "Note that the following number of predicted events actually occured for \\
+    each problematic event level:",
+    paste0("'", events, "': ", counts, collapse = ", ")
   )
 
   warn_sens_undefined(
@@ -316,7 +321,7 @@ warn_sens_undefined_multiclass <- function(events, counts) {
 }
 
 warn_sens_undefined <- function(message, events, counts, ..., class = character()) {
-  warn(
+  cli::cli_warn(
     message = message,
     class = c(class, "yardstick_warning_sens_undefined"),
     events = events,

R/class-spec.R

@@ -247,14 +247,20 @@ spec_multiclass <- function(data, estimator) {
 
 
 warn_spec_undefined_binary <- function(event, count) {
-  message <- paste0(
-    "While computing binary `spec()`, no true negatives were detected ",
-    "(i.e. `true_negative + false_positive = 0`). ",
-    "\n",
-    "Specificity is undefined in this case, and `NA` will be returned.",
-    "\n",
-    "Note that ", count, " predicted negatives(s) actually occured for the problematic ",
-    "event level, '", event, "'."
+  message <- c(
+    "While computing binary {.fn spec}, no true negatives were detected \\
+    (i.e. `true_negative + false_positive = 0`).",
+    "Specificity is undefined in this case, and `NA` will be returned."
+  )
+
+  message <- c(
+    message,
+    paste(
+      "Note that",
+      count,
+      "predicted negatives(s) actually occured for the problematic event level,",
+      event
+    )
   )
 
   warn_spec_undefined(
@@ -266,15 +272,14 @@ warn_spec_undefined_binary <- function(event, count) {
 }
 
 warn_spec_undefined_multiclass <- function(events, counts) {
-  message <- paste0(
-    "While computing multiclass `spec()`, some levels had no true negatives ",
-    "(i.e. `true_negative + false_positive = 0`). ",
-    "\n",
-    "Specificity is undefined in this case, and those levels will be removed from the averaged result.",
-    "\n",
-    "Note that the following number of predicted negatives actually occured for each problematic event level:",
-    "\n",
-    paste0("'", events, "': ", counts, collapse = "\n")
+  message <- c(
+    "While computing multiclass {.fn spec}, some levels had no true negatives \\
+    (i.e. `true_negative + false_positive = 0`).",
+    "Specificity is undefined in this case, and those levels will be removed \\
+    from the averaged result.",
+    "Note that the following number of predicted negatives actually occured \\
+    for each problematic event level:",
+    paste0("'", events, "': ", counts, collapse = ", ")
   )
 
   warn_spec_undefined(
@@ -286,7 +291,7 @@ warn_spec_undefined_multiclass <- function(events, counts) {
 }
 
 warn_spec_undefined <- function(message, events, counts, ..., class = character()) {
-  warn(
+  cli::cli_warn(
     message = message,
     class = c(class, "yardstick_warning_spec_undefined"),
     events = events,

R/conf_mat.R

@@ -292,13 +292,24 @@ tidy.conf_mat <- function(x, ...) {
   )
 }
 
-flatten <- function(xtab) {
-  p <- ncol(xtab)
-  if (nrow(xtab) != p) {
-    stop("table must have equal dimensions")
+flatten <- function(xtab, call = caller_env()) {
+  n_col <- ncol(xtab)
+  n_row <- nrow(xtab)
+  if (n_row != n_col) {
+    cli::cli_abort(
+      "{.arg x} must have equal dimensions. \\
+      {.arg x} has {n_col} columns and {n_row} rows.",
+      call = call
+    )
   }
   flat <- as.vector(xtab)
-  names(flat) <- paste("cell", rep(1:p, p), rep(1:p, each = p), sep = "_")
+  names(flat) <- paste(
+    "cell",
+    rep(seq_len(n_col), n_col),
+    rep(seq_len(n_col), each = n_col),
+    sep = "_"
+  )
+
   flat
 }
 

R/misc.R

@@ -28,12 +28,21 @@ neg_val <- function(xtab, event_level) {
 
 # ------------------------------------------------------------------------------
 
-check_table <- function(x) {
-  if (!identical(nrow(x), ncol(x))) {
-    stop("the table must have nrow = ncol", call. = FALSE)
+check_table <- function(x, call = caller_env()) {
+  n_col <- ncol(x)
+  n_row <- nrow(x)
+  if (n_row != n_col) {
+    cli::cli_abort(
+      "{.arg x} must have equal dimensions. \\
+      {.arg x} has {n_col} columns and {n_row} rows.",
+      call = call
+    )
   }
   if (!isTRUE(all.equal(rownames(x), colnames(x)))) {
-    stop("the table must the same groups in the same order", call. = FALSE)
+    cli::cli_abort(
+      "The table must the same groups in the same order.",
+      call = call
+    )
   }
   invisible(NULL)
 }
@@ -326,7 +335,7 @@ make_correlation_undefined_constant_message <- function(what) {
 }
 
 warn_correlation_undefined <- function(message, ..., class = character()) {
-  warn(
+  cli::cli_warn(
     message = message,
     class = c(class, "yardstick_warning_correlation_undefined"),
     ...

R/prob-binary-thresholds.R

@@ -17,7 +17,7 @@ binary_threshold_curve <- function(truth,
 
   if (!is.factor(truth)) {
     cli::cli_abort(
-      "{.arg truth} must be a factor, not {.obj_friendly_type {truth}}.",
+      "{.arg truth} must be a factor, not {.obj_type_friendly {truth}}.",
       .internal = TRUE
     )
   }
@@ -29,7 +29,7 @@ binary_threshold_curve <- function(truth,
   }
   if (!is.numeric(estimate)) {
     cli::cli_abort(
-      "{.arg estimate} must be numeric, not {.obj_friendly_type {estimate}}.",
+      "{.arg estimate} must be numeric, not {.obj_type_friendly {estimate}}.",
       .internal = TRUE
     )
   }
@@ -84,7 +84,9 @@ binary_threshold_curve <- function(truth,
   case_weights_non_events <- (1 - truth) * case_weights
 
   if (sum(case_weights_events) == 0L) {
-    warn("There are `0` event cases in `truth`, results will be meaningless.")
+    cli::cli_warn(
+      "There are 0 event cases in {.arg truth}, results will be meaningless."
+    )
   }
 
   tp <- cumsum(case_weights_events)