diff --git a/R/misc.R b/R/misc.R index 97119298..9be4c3ba 100644 --- a/R/misc.R +++ b/R/misc.R @@ -24,7 +24,7 @@ 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`.") + cli_abort("There is no method available to make an rsplit from {.arg x}.") } #' @rdname make_splits @@ -47,7 +47,7 @@ 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)) @@ -55,7 +55,7 @@ make_splits.data.frame <- function(x, assessment, ...) { 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 +100,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 {.arg 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) @@ -149,9 +149,7 @@ split_unnamed <- function(x, f) { #' @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) - ) + cli_abort("No {.fn .get_fingerprint} method for this {cli::qty(class(x))} class{?es} {cls}") } #' @export @@ -192,15 +190,15 @@ 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( + "`x` must be either an {.arg rsplit} or an {.arg rset} object" ) } #' @rdname reverse_splits #' @export reverse_splits.permutations <- function(x, ...) { - rlang::abort( + cli_abort( "Permutations cannot have their splits reversed" ) } @@ -253,11 +251,11 @@ 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 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 @@ -274,10 +272,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)", + cli_abort(c( + "Cannot reshuffle this rset ({.arg attr(rset, 'strata')} is {.arg 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 +295,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 +313,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 +359,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}.", + "x {msg}" ) ) } @@ -376,7 +374,5 @@ get_rsplit.rset <- function(x, index, ...) { #' @export get_rsplit.default <- function(x, index, ...) { cls <- paste0("'", class(x), "'", collapse = ", ") - rlang::abort( - paste("No `get_rsplit()` method for this class(es)", cls) - ) + cli_abort("No {.fn get_rsplit} method for this {cli::qty(cls)} class{?es} {cls}") }