Skip to content

Commit

Permalink
Merge pull request #529 from Dpananos/cli_misc
Browse files Browse the repository at this point in the history
Adds cli_abort to R/misc.R
  • Loading branch information
hfrick authored Sep 12, 2024
2 parents e489196 + ffd7b39 commit 8ccee92
Show file tree
Hide file tree
Showing 5 changed files with 58 additions and 50 deletions.
2 changes: 1 addition & 1 deletion NEWS.md
Original file line number Diff line number Diff line change
Expand Up @@ -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).

Expand Down
61 changes: 29 additions & 32 deletions R/misc.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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))
}
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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."
)
}

Expand Down Expand Up @@ -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)
Expand All @@ -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(
Expand All @@ -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
Expand All @@ -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
}
Expand Down Expand Up @@ -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
)
)
}
Expand All @@ -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}")
}
8 changes: 8 additions & 0 deletions tests/testthat/_snaps/make-splits.md
Original file line number Diff line number Diff line change
@@ -0,0 +1,8 @@
# improper argument

Code
make_splits("potato")
Condition
Error in `make_splits()`:
! No method for objects of class: character

33 changes: 17 additions & 16 deletions tests/testthat/_snaps/misc.md
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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()

Expand All @@ -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.

---

Expand All @@ -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.

---

Expand All @@ -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

4 changes: 3 additions & 1 deletion tests/testthat/test-make-splits.R
Original file line number Diff line number Diff line change
Expand Up @@ -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")
})
})

0 comments on commit 8ccee92

Please sign in to comment.