Merge pull request #516 from Dpananos/cli_bootci

cli updates for `bootci.R`

NEWS.md

@@ -2,7 +2,7 @@
 
 * The new `inner_split()` function and its methods for various resamples is for usage in tune to create a inner resample of the analysis set to fit the preprocessor and model on one part and the post-processor on the other part (#483, #488, #489).
 
-* Started moving error messages to cli (#499, #502). With contributions from @PriKalra (#523, #526, #528, #530, #531, #532) and @JamesHWade (#518).
+* Started moving error messages to cli (#499, #502). With contributions from @PriKalra (#523, #526, #528, #530, #531, #532), @Dpananos (#516), and @JamesHWade (#518).
 
 * Fixed example for `nested_cv()` (@seb09, #520).
 

R/bootci.R

@@ -6,39 +6,37 @@
 
 check_rset <- function(x, app = TRUE) {
   if (!inherits(x, "bootstraps")) {
-    rlang::abort("`.data` should be an `rset` object generated from `bootstraps()`")
+    cli_abort("{.arg .data} should be an {.cls rset} object generated from {.fn bootstraps}.")
   }
 
   if (app) {
     if (x %>% dplyr::filter(id == "Apparent") %>% nrow() != 1) {
-      rlang::abort("Please set `apparent = TRUE` in `bootstraps()` function")
+      cli_abort("Please set {.code apparent = TRUE} in {.fn bootstraps} function.")
     }
   }
   invisible(NULL)
 }
 
 
-stat_fmt_err <- paste("`statistics` should select a list column of tidy results.")
+stat_fmt_err <- "{.arg statistics} should select a list column of tidy results."
 stat_nm_err <- paste(
-  "The tibble in `statistics` should have columns for",
-  "'estimate' and 'term`"
+  "The tibble in {.arg statistics} should have columns for",
+  "'estimate' and 'term'."
 )
 std_exp <- c("std.error", "robust.se")
 
 check_tidy_names <- function(x, std_col) {
   # check for proper columns
   if (sum(colnames(x) == "estimate") != 1) {
-    rlang::abort(stat_nm_err)
+    cli_abort(stat_nm_err)
   }
   if (sum(colnames(x) == "term") != 1) {
-    rlang::abort(stat_nm_err)
+    cli_abort(stat_nm_err)
   }
   if (std_col) {
     std_candidates <- colnames(x) %in% std_exp
     if (sum(std_candidates) != 1) {
-      rlang::abort(
-        "`statistics` should select a single column for the standard error."
-      )
+      cli_abort("{.arg statistics} should select a single column for the standard error.")
     }
   }
   invisible(TRUE)
@@ -59,7 +57,7 @@ check_tidy <- function(x, std_col = FALSE) {
   }
 
   if (inherits(x, "try-error")) {
-    rlang::abort(stat_fmt_err)
+    cli_abort(stat_fmt_err)
   }
 
   check_tidy_names(x, std_col)
@@ -117,7 +115,7 @@ new_stats <- function(x, lo, hi) {
 has_dots <- function(x) {
   nms <- names(formals(x))
   if (!any(nms == "...")) {
-    rlang::abort("`.fn` must have an argument `...`.")
+    cli_abort("{.arg .fn} must have an argument {.arg ...}.")
   }
   invisible(NULL)
 }
@@ -130,15 +128,8 @@ check_num_resamples <- function(x, B = 1000) {
     dplyr::filter(n < B)
 
   if (nrow(x) > 0) {
-    terms <- paste0("`", x$term, "`")
-    msg <-
-      paste0(
-        "Recommend at least ", B, " non-missing bootstrap resamples for ",
-        ifelse(length(terms) > 1, "terms: ", "term "),
-        paste0(terms, collapse = ", "),
-        "."
-      )
-    rlang::warn(msg)
+    terms <- x$term
+    cli_warn("Recommend at least {B} non-missing bootstrap resamples for {cli::qty(terms)} term{?s} {.code {terms}}.")
   }
   invisible(NULL)
 }
@@ -149,11 +140,11 @@ check_num_resamples <- function(x, B = 1000) {
 
 pctl_single <- function(stats, alpha = 0.05) {
   if (all(is.na(stats))) {
-    rlang::abort("All statistics have missing values..")
+    cli_abort("All statistics have missing values.")
   }
 
   if (!is.numeric(stats)) {
-    rlang::abort("`stats` must be a numeric vector.")
+    cli_abort("{.arg stats} must be a numeric vector.")
   }
 
   # stats is a numeric vector of values
@@ -258,7 +249,7 @@ int_pctl.bootstraps <- function(.data, statistics, alpha = 0.05, ...) {
   check_dots_empty()
   check_rset(.data, app = FALSE)
   if (length(alpha) != 1 || !is.numeric(alpha)) {
-    abort("`alpha` must be a single numeric value.")
+    cli_abort("{.arg alpha} must be a single numeric value.")
   }
 
   .data <- .data %>% dplyr::filter(id != "Apparent")
@@ -289,19 +280,20 @@ t_single <- function(stats, std_err, is_orig, alpha = 0.05) {
   # which_orig is the index of stats and std_err that has the original result
 
   if (all(is.na(stats))) {
-    rlang::abort("All statistics have missing values.")
+    cli_abort("All statistics have missing values.")
   }
 
   if (!is.logical(is_orig) || any(is.na(is_orig))) {
-    rlang::abort(
-      "`is_orig` should be a logical column the same length as `stats` with no missing values."
+    cli_abort(
+      "{.arg is_orig} should be a logical column the same length as {.arg stats} with no missing values."
     )
   }
   if (length(stats) != length(std_err) && length(stats) != length(is_orig)) {
-    rlang::abort("`stats`, `std_err`, and `is_orig` should have the same length.")
+    function_args <- c('stats', 'std_err', 'is_orig')
+    cli_abort("{.arg {function_args}} should have the same length.")
   }
   if (sum(is_orig) != 1) {
-    rlang::abort("The original statistic must be in a single row.")
+    cli_abort("The original statistic must be in a single row.")
   }
 
   theta_obs <- stats[is_orig]
@@ -339,12 +331,12 @@ int_t.bootstraps <- function(.data, statistics, alpha = 0.05, ...) {
   check_dots_empty()
   check_rset(.data)
   if (length(alpha) != 1 || !is.numeric(alpha)) {
-    abort("`alpha` must be a single numeric value.")
+    cli_abort("{.arg alpha} must be a single numeric value.")
   }
 
   column_name <- tidyselect::vars_select(names(.data), !!enquo(statistics))
   if (length(column_name) != 1) {
-    rlang::abort(stat_fmt_err)
+    cli_abort(stat_fmt_err)
   }
   stats <- .data %>% dplyr::select(!!column_name, id)
   stats <- check_tidy(stats, std_col = TRUE)
@@ -366,7 +358,7 @@ bca_calc <- function(stats, orig_data, alpha = 0.05, .fn, ...) {
 
   # TODO check per term
   if (all(is.na(stats$estimate))) {
-    rlang::abort("All statistics have missing values.")
+    cli_abort("All statistics have missing values.")
   }
 
   ### Estimating Z0 bias-correction
@@ -381,7 +373,7 @@ bca_calc <- function(stats, orig_data, alpha = 0.05, .fn, ...) {
   if (inherits(loo_test, "try-error")) {
     cat("Running `.fn` on the LOO resamples produced an error:\n")
     print(loo_test)
-    rlang::abort("`.fn` failed.")
+    cli_abort("{.arg .fn} failed.")
   }
 
   loo_res <- furrr::future_map(loo_rs$splits, .fn, ...) %>% list_rbind()
@@ -440,14 +432,14 @@ int_bca <- function(.data, ...) {
 int_bca.bootstraps <- function(.data, statistics, alpha = 0.05, .fn, ...) {
   check_rset(.data)
   if (length(alpha) != 1 || !is.numeric(alpha)) {
-    abort("`alpha` must be a single numeric value.")
+    cli_abort("{.arg alpha} must be a single numeric value.")
   }
 
   has_dots(.fn)
 
   column_name <- tidyselect::vars_select(names(.data), !!enquo(statistics))
   if (length(column_name) != 1) {
-    rlang::abort(stat_fmt_err)
+    cli_abort(stat_fmt_err)
   }
   stats <- .data %>% dplyr::select(!!column_name, id)
   stats <- check_tidy(stats)

tests/testthat/_snaps/bootci.md

@@ -6,7 +6,7 @@
       Warning:
       Recommend at least 1000 non-missing bootstrap resamples for term `mean`.
       Error in `pctl_single()`:
-      ! All statistics have missing values..
+      ! All statistics have missing values.
 
 ---