diff --git a/NEWS.md b/NEWS.md index 22570e96..bd6f3efe 100644 --- a/NEWS.md +++ b/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). diff --git a/R/bootci.R b/R/bootci.R index 1af5731e..bd6ef9af 100644 --- a/R/bootci.R +++ b/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) diff --git a/tests/testthat/_snaps/bootci.md b/tests/testthat/_snaps/bootci.md index 77e607e1..8632d77e 100644 --- a/tests/testthat/_snaps/bootci.md +++ b/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. ---