Merge pull request #529 from Dpananos/cli_misc

Adds cli_abort to R/misc.R

Author: hfrick

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), @Dpananos (#516, #517), and @JamesHWade (#518).
+* Started moving error messages to cli (#499, #502). With contributions from @PriKalra (#523, #526, #528, #530, #531, #532), @Dpananos (#516, #517, #529), and @JamesHWade (#518).
 
 * Fixed example for `nested_cv()` (@seb09, #520).
 

R/misc.R

@@ -24,7 +24,8 @@ make_splits <- function(x, ...) {
 #' data frame of analysis or training data.
 #' @export
 make_splits.default <- function(x, ...) {
-  rlang::abort("There is no method available to make an rsplit from `x`.")
+  cls <- class(x)
+  cli_abort("No method for objects of class{?es}: {cls}")
 }
 
 #' @rdname make_splits
@@ -47,15 +48,15 @@ make_splits.list <- function(x, data, class = NULL, ...) {
 make_splits.data.frame <- function(x, assessment, ...) {
   rlang::check_dots_empty()
   if (nrow(x) == 0) {
-    rlang::abort("The analysis set must contain at least one row.")
+    cli_abort("The analysis set must contain at least one row.")
   }
 
   ind_analysis <- seq_len(nrow(x))
   if (nrow(assessment) == 0) {
     ind_assessment <- integer()
   } else {
     if (!identical(colnames(x), colnames(assessment))) {
-      rlang::abort("The analysis and assessment sets must have the same columns.")
+      cli_abort("The analysis and assessment sets must have the same columns.")
     }
     ind_assessment <- nrow(x) + seq_len(nrow(assessment))
   }
@@ -100,13 +101,13 @@ add_class <- function(x, cls) {
 strata_check <- function(strata, data) {
   if (!is.null(strata)) {
     if (!is.character(strata) | length(strata) != 1) {
-      rlang::abort("`strata` should be a single name or character value.")
+      cli_abort("{.arg strata} should be a single name or character value.")
     }
     if (inherits(data[, strata], "Surv")) {
-      rlang::abort("`strata` cannot be a `Surv` object. Use the time or event variable directly.")
+      cli_abort("{.arg strata} cannot be a {.cls Surv} object. Use the time or event variable directly.")
     }
     if (!(strata %in% names(data))) {
-      rlang::abort(strata, " is not in `data`.")
+      cli_abort("{strata} is not in {.arg data}.")
     }
   }
   invisible(NULL)
@@ -148,10 +149,8 @@ split_unnamed <- function(x, f) {
 #' @export
 #' @rdname get_fingerprint
 .get_fingerprint.default <- function(x, ...) {
-  cls <- paste0("'", class(x), "'", collapse = ", ")
-  rlang::abort(
-    paste("No `.get_fingerprint()` method for this class(es)", cls)
-  )
+  cls <- class(x)
+  cli_abort("No method for objects of class{?es}: {cls}")
 }
 
 #' @export
@@ -192,16 +191,16 @@ reverse_splits <- function(x, ...) {
 #' @rdname reverse_splits
 #' @export
 reverse_splits.default <- function(x, ...) {
-  rlang::abort(
-    "`x` must be either an `rsplit` or an `rset` object"
+  cli_abort(
+    "{.arg x} must be either an {.cls rsplit} or an {.cls rset} object."
   )
 }
 
 #' @rdname reverse_splits
 #' @export
 reverse_splits.permutations <- function(x, ...) {
-  rlang::abort(
-    "Permutations cannot have their splits reversed"
+  cli_abort(
+    "Permutations cannot have their splits reversed."
   )
 }
 
@@ -253,18 +252,18 @@ reverse_splits.rset <- function(x, ...) {
 #' @export
 reshuffle_rset <- function(rset) {
   if (!inherits(rset, "rset")) {
-    rlang::abort("`rset` must be an rset object")
+    cli_abort("{.arg rset} must be an {.cls rset} object.")
   }
 
   if (inherits(rset, "manual_rset")) {
-    rlang::abort("`manual_rset` objects cannot be reshuffled")
+    cli_abort("{.arg manual_rset} objects cannot be reshuffled.")
   }
 
   # non-random classes is defined below
   if (any(non_random_classes %in% class(rset))) {
     cls <- class(rset)[[1]]
-    rlang::warn(
-      glue::glue("`reshuffle_rset()` will return an identical rset when called on {cls} objects")
+    cli::cli_warn(
+      "{.fun reshuffle_rset} will return an identical {.cls rset} when called on {.cls {cls}} objects."
     )
     if ("validation_set" %in% class(rset)) {
       return(rset)
@@ -274,10 +273,10 @@ reshuffle_rset <- function(rset) {
   rset_type <- class(rset)[[1]]
   split_arguments <- .get_split_args(rset)
   if (identical(split_arguments$strata, TRUE)) {
-    rlang::abort(
-      "Cannot reshuffle this rset (`attr(rset, 'strata')` is `TRUE`, not a column identifier)",
-      i = "If the original object was created with an older version of rsample, try recreating it with the newest version of the package"
-    )
+    cli_abort(c(
+      "Cannot reshuffle this rset ({.code attr(rset, 'strata')} is {.val TRUE}, not a column identifier)",
+      i = "If the original object was created with an older version of rsample, try recreating it with the newest version of the package."
+    ))
   }
 
   do.call(
@@ -297,8 +296,8 @@ non_random_classes <- c(
 
 #' Get the split arguments from an rset
 #' @param x An `rset` or `initial_split` object.
-#' @param allow_strata_false A logical to specify which value to use if no 
-#' stratification was specified. The default is to use `strata = NULL`, the 
+#' @param allow_strata_false A logical to specify which value to use if no
+#' stratification was specified. The default is to use `strata = NULL`, the
 #' alternative is `strata = FALSE`.
 #' @return A list of arguments used to create the rset.
 #' @keywords internal
@@ -315,7 +314,7 @@ non_random_classes <- c(
   args <- names(formals(function_used_to_create))
   split_args <- all_attributes[args]
   split_args <- split_args[!is.na(names(split_args))]
-  
+
   if (identical(split_args$strata, FALSE) && !allow_strata_false) {
     split_args$strata <- NULL
   }
@@ -361,10 +360,10 @@ get_rsplit.rset <- function(x, index, ...) {
       glue::glue("A value of {index} was provided.")
       )
 
-    rlang::abort(
+    cli_abort(
       c(
-        glue::glue("`index` must be a length-1 integer between 1 and {n_rows}."),
-        x = msg
+        "{.arg index} must be a length-1 integer between 1 and {n_rows}.",
+       "*" = msg
       )
     )
   }
@@ -375,8 +374,6 @@ get_rsplit.rset <- function(x, index, ...) {
 #' @rdname get_rsplit
 #' @export
 get_rsplit.default <- function(x, index, ...) {
-  cls <- paste0("'", class(x), "'", collapse = ", ")
-  rlang::abort(
-    paste("No `get_rsplit()` method for this class(es)", cls)
-  )
+  cls <- class(x)
+  cli_abort("No method for objects of class{?es}: {cls}")
 }

tests/testthat/_snaps/make-splits.md

@@ -0,0 +1,8 @@
+# improper argument
+
+    Code
+      make_splits("potato")
+    Condition
+      Error in `make_splits()`:
+      ! No method for objects of class: character
+

tests/testthat/_snaps/misc.md

@@ -4,31 +4,31 @@
       reverse_splits(1)
     Condition
       Error in `reverse_splits()`:
-      ! `x` must be either an `rsplit` or an `rset` object
+      ! `x` must be either an <rsplit> or an <rset> object.
 
 ---
 
     Code
       reverse_splits(permutes)
     Condition
       Error in `reverse_splits()`:
-      ! Permutations cannot have their splits reversed
+      ! Permutations cannot have their splits reversed.
 
 ---
 
     Code
       reverse_splits(permutes$splits[[1]])
     Condition
       Error in `reverse_splits()`:
-      ! Permutations cannot have their splits reversed
+      ! Permutations cannot have their splits reversed.
 
 # reshuffle_rset is working
 
     Code
       reshuffle_rset(rset_subclasses[[non_random_classes[[i]]]])
     Condition
       Warning:
-      `reshuffle_rset()` will return an identical rset when called on sliding_index objects
+      `reshuffle_rset()` will return an identical <rset> when called on <sliding_index> objects.
     Output
       # Sliding index resampling 
       # A tibble: 49 x 2
@@ -52,7 +52,7 @@
       reshuffle_rset(rset_subclasses[[non_random_classes[[i]]]])
     Condition
       Warning:
-      `reshuffle_rset()` will return an identical rset when called on sliding_period objects
+      `reshuffle_rset()` will return an identical <rset> when called on <sliding_period> objects.
     Output
       # Sliding period resampling 
       # A tibble: 7 x 2
@@ -72,7 +72,7 @@
       reshuffle_rset(rset_subclasses[[non_random_classes[[i]]]])
     Condition
       Warning:
-      `reshuffle_rset()` will return an identical rset when called on sliding_window objects
+      `reshuffle_rset()` will return an identical <rset> when called on <sliding_window> objects.
     Output
       # Sliding window resampling 
       # A tibble: 49 x 2
@@ -96,7 +96,7 @@
       reshuffle_rset(rset_subclasses[[non_random_classes[[i]]]])
     Condition
       Warning:
-      `reshuffle_rset()` will return an identical rset when called on rolling_origin objects
+      `reshuffle_rset()` will return an identical <rset> when called on <rolling_origin> objects.
     Output
       # Rolling origin forecast resampling 
       # A tibble: 45 x 2
@@ -120,7 +120,7 @@
       reshuffle_rset(rset_subclasses[[non_random_classes[[i]]]])
     Condition
       Warning:
-      `reshuffle_rset()` will return an identical rset when called on validation_time_split objects
+      `reshuffle_rset()` will return an identical <rset> when called on <validation_time_split> objects.
     Output
       # Validation Set Split (0.75/0.25)  
       # A tibble: 1 x 2
@@ -134,7 +134,7 @@
       reshuffle_rset(rset_subclasses[[non_random_classes[[i]]]])
     Condition
       Warning:
-      `reshuffle_rset()` will return an identical rset when called on validation_set objects
+      `reshuffle_rset()` will return an identical <rset> when called on <validation_set> objects.
     Output
       # A tibble: 1 x 2
         splits          id        
@@ -143,15 +143,16 @@
 
 ---
 
-    Cannot reshuffle this rset (`attr(rset, 'strata')` is `TRUE`, not a column identifier)
+    Cannot reshuffle this rset (`attr(rset, 'strata')` is "TRUE", not a column identifier)
+    i If the original object was created with an older version of rsample, try recreating it with the newest version of the package.
 
 ---
 
-    `manual_rset` objects cannot be reshuffled
+    `manual_rset` objects cannot be reshuffled.
 
 ---
 
-    `rset` must be an rset object
+    `rset` must be an <rset> object.
 
 # get_rsplit()
 
@@ -160,7 +161,7 @@
     Condition
       Error in `get_rsplit()`:
       ! `index` must be a length-1 integer between 1 and 1.
-      x A value of 3 was provided.
+      * A value of 3 was provided.
 
 ---
 
@@ -169,7 +170,7 @@
     Condition
       Error in `get_rsplit()`:
       ! `index` must be a length-1 integer between 1 and 1.
-      x Index was of length 2.
+      * Index was of length 2.
 
 ---
 
@@ -178,13 +179,13 @@
     Condition
       Error in `get_rsplit()`:
       ! `index` must be a length-1 integer between 1 and 1.
-      x A value of 1.5 was provided.
+      * A value of 1.5 was provided.
 
 ---
 
     Code
       get_rsplit(warpbreaks, 1)
     Condition
       Error in `get_rsplit()`:
-      ! No `get_rsplit()` method for this class(es) 'data.frame'
+      ! No method for objects of class: data.frame
 

tests/testthat/test-make-splits.R

@@ -54,5 +54,7 @@ test_that("cannot create a split from dataframes with different columns", {
 })
 
 test_that("improper argument", {
-  expect_error(make_splits("potato"), "There is no method available to")
+  expect_snapshot(error = TRUE, {
+    make_splits("potato")
+  })
 })