More edits to bootci. Updates snapshot of tests

R/bootci.R

@@ -6,12 +6,12 @@
 
 check_rset <- function(x, app = TRUE) {
   if (!inherits(x, "bootstraps")) {
-    cli::cli_abort("{.arg .data} should be an `rset` object generated from {.fn bootstraps}")
+    cli_abort("{.arg .data} should be an `rset` object generated from {.fn bootstraps}")
   }
 
   if (app) {
     if (x %>% dplyr::filter(id == "Apparent") %>% nrow() != 1) {
-      cli::cli_abort("Please set `apparent = TRUE` in {.fn bootstraps} function")
+      cli_abort("Please set `apparent = TRUE` in {.fn bootstraps} function")
     }
   }
   invisible(NULL)
@@ -28,15 +28,15 @@ std_exp <- c("std.error", "robust.se")
 check_tidy_names <- function(x, std_col) {
   # check for proper columns
   if (sum(colnames(x) == "estimate") != 1) {
-    cli::cli_abort(stat_nm_err)
+    cli_abort(stat_nm_err)
   }
   if (sum(colnames(x) == "term") != 1) {
-    cli::cli_abort(stat_nm_err)
+    cli_abort(stat_nm_err)
   }
   if (std_col) {
     std_candidates <- colnames(x) %in% std_exp
     if (sum(std_candidates) != 1) {
-      cli::cli_abort("{.arg 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)
@@ -57,7 +57,7 @@ check_tidy <- function(x, std_col = FALSE) {
   }
 
   if (inherits(x, "try-error")) {
-    cli::cli_abort(stat_fmt_err)
+    cli_abort(stat_fmt_err)
   }
 
   check_tidy_names(x, std_col)
@@ -115,7 +115,7 @@ new_stats <- function(x, lo, hi) {
 has_dots <- function(x) {
   nms <- names(formals(x))
   if (!any(nms == "...")) {
-    cli::cli_abort("{.arg .fn} must have an argument {.arg ...}.")
+    cli_abort("{.arg .fn} must have an argument {.arg ...}.")
   }
   invisible(NULL)
 }
@@ -128,9 +128,7 @@ check_num_resamples <- function(x, B = 1000) {
     dplyr::filter(n < B)
 
   if (nrow(x) > 0) {
-    terms <- paste0("`", x$term, "`")
-    cli::cli_warn(paste0("Recommend at least {B} non-missing bootstrap ",
-                         "resamples for {cli::qty(terms)} term{?s} {terms}."))
+    cli::cli_warn("Recommend at least {B} non-missing bootstrap resamples for {x$terms} term{?s}.")
   }
   invisible(NULL)
 }
@@ -141,11 +139,11 @@ check_num_resamples <- function(x, B = 1000) {
 
 pctl_single <- function(stats, alpha = 0.05) {
   if (all(is.na(stats))) {
-    cli::cli_abort("All statistics have missing values.")
+    cli_abort("All statistics have missing values.")
   }
 
   if (!is.numeric(stats)) {
-    cli::cli_abort("{.arg stats} must be a numeric vector.")
+    cli_abort("{.arg stats} must be a numeric vector.")
   }
 
   # stats is a numeric vector of values
@@ -250,7 +248,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)) {
-    cli::cli_abort("{.arg alpha} must be a single numeric value.")
+    cli_abort("{.arg alpha} must be a single numeric value.")
   }
 
   .data <- .data %>% dplyr::filter(id != "Apparent")
@@ -281,20 +279,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))) {
-    cli::cli_abort("All statistics have missing values.")
+    cli_abort("All statistics have missing values.")
   }
 
   if (!is.logical(is_orig) || any(is.na(is_orig))) {
-    cli::cli_abort(
+    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)) {
     function_args <- c('stats', 'std_err', 'is_orig')
-    cli::cli_abort("{.arg {function_args}} should have the same length.")
+    cli_abort("{.arg {function_args}} should have the same length.")
   }
   if (sum(is_orig) != 1) {
-    cli::cli_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]
@@ -332,12 +330,12 @@ int_t.bootstraps <- function(.data, statistics, alpha = 0.05, ...) {
   check_dots_empty()
   check_rset(.data)
   if (length(alpha) != 1 || !is.numeric(alpha)) {
-    cli::cli_abort("{.arg 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) {
-    cli::cli_abort(stat_fmt_err)
+    cli_abort(stat_fmt_err)
   }
   stats <- .data %>% dplyr::select(!!column_name, id)
   stats <- check_tidy(stats, std_col = TRUE)
@@ -359,7 +357,7 @@ bca_calc <- function(stats, orig_data, alpha = 0.05, .fn, ...) {
 
   # TODO check per term
   if (all(is.na(stats$estimate))) {
-    cli::cli_abort("All statistics have missing values.")
+    cli_abort("All statistics have missing values.")
   }
 
   ### Estimating Z0 bias-correction
@@ -374,7 +372,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)
-    cli::cli_abort("{.arg .fn} failed.")
+    cli_abort("{.arg .fn} failed.")
   }
 
   loo_res <- furrr::future_map(loo_rs$splits, .fn, ...) %>% list_rbind()
@@ -433,14 +431,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)) {
-    cli::cli_abort("{.arg 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) {
-    cli::cli_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

@@ -4,7 +4,7 @@
       int_pctl(bt_resamples, res)
     Condition
       Warning:
-      Recommend at least 1000 non-missing bootstrap resamples for term `mean`.
+      Recommend at least 1000 non-missing bootstrap resamples for `mean` term.
       Error in `pctl_single()`:
       ! All statistics have missing values.
 
@@ -14,7 +14,7 @@
       int_t(bt_resamples, res)
     Condition
       Warning:
-      Recommend at least 500 non-missing bootstrap resamples for term `mean`.
+      Recommend at least 500 non-missing bootstrap resamples for `mean` term.
       Error in `t_single()`:
       ! All statistics have missing values.
 
@@ -24,7 +24,7 @@
       int_bca(bt_resamples, res, .fn = bad_stats)
     Condition
       Warning:
-      Recommend at least 1000 non-missing bootstrap resamples for term `mean`.
+      Recommend at least 1000 non-missing bootstrap resamples for `mean` term.
       Error in `bca_calc()`:
       ! All statistics have missing values.