From 21a4d2714035b86c80ebe419a00b574d93e764b7 Mon Sep 17 00:00:00 2001 From: simonpcouch Date: Wed, 28 Aug 2024 11:15:48 -0500 Subject: [PATCH 01/11] transition remaining `rlang::abort()`s to `cli::cli_abort()` --- R/aaa_multi_predict.R | 18 +++---- R/adds.R | 2 +- R/arguments.R | 4 +- R/augment.R | 2 +- R/autoplot.R | 7 +-- R/case_weights.R | 7 ++- R/condense_control.R | 15 ++---- R/contr_one_hot.R | 4 +- R/control_parsnip.R | 14 ++++-- R/convert_data.R | 58 +++++++++++++---------- R/engines.R | 17 +++---- R/extract.R | 8 ++-- R/fit_helpers.R | 8 +++- R/glm_grouped.R | 6 ++- R/misc.R | 46 +++++++++--------- R/nullmodel.R | 2 +- R/partykit.R | 10 +++- R/repair_call.R | 4 +- R/required_pkgs.R | 2 +- R/standalone-survival.R | 9 ++-- R/survival-censoring-model.R | 4 +- R/survival-censoring-weights.R | 37 ++++++++++----- R/svm_linear.R | 10 ++-- R/translate.R | 9 ++-- R/varying.R | 8 ++-- inst/add-in/gadget.R | 9 ++-- man/rmd/aaa.Rmd | 6 ++- tests/testthat/_snaps/condense_control.md | 5 +- tests/testthat/_snaps/convert_data.md | 16 +++++++ tests/testthat/_snaps/extract.md | 20 ++++++++ tests/testthat/_snaps/misc.md | 8 ++++ tests/testthat/_snaps/partykit.md | 4 +- tests/testthat/_snaps/translate.md | 2 +- tests/testthat/_snaps/update.md | 10 ++-- tests/testthat/test-convert_data.R | 12 ++--- tests/testthat/test-extract.R | 4 +- tests/testthat/test-misc.R | 11 ++--- 37 files changed, 244 insertions(+), 174 deletions(-) create mode 100644 tests/testthat/_snaps/convert_data.md diff --git a/R/aaa_multi_predict.R b/R/aaa_multi_predict.R index 580bb0052..d00a82c1e 100644 --- a/R/aaa_multi_predict.R +++ b/R/aaa_multi_predict.R @@ -28,17 +28,19 @@ multi_predict <- function(object, ...) { #' @export #' @rdname multi_predict -multi_predict.default <- function(object, ...) - rlang::abort( - glue::glue( - "No `multi_predict` method exists for objects with classes ", - glue::glue_collapse(glue::glue("'{class(object)}'"), sep = ", ") - ) - ) +multi_predict.default <- function(object, ...) { + cli::cli_abort( + "No {.fun multi_predict} method exists for objects with classes + {.cls {class(object)}}." + ) +} #' @export predict.model_spec <- function(object, ...) { - rlang::abort("You must use `fit()` on your model specification before you can use `predict()`.") + cli::cli_abort( + "You must {.fun fit} your model specification + before you can use {.fun predict}." + ) } #' Tools for models that predict on sub-models diff --git a/R/adds.R b/R/adds.R index a210958fa..9ca677216 100644 --- a/R/adds.R +++ b/R/adds.R @@ -7,7 +7,7 @@ #' @export add_rowindex <- function(x) { if (!is.data.frame(x)) { - rlang::abort("`x` should be a data frame.") + cli::cli_abort("{.arg x} should be a data frame.") } x <- dplyr::mutate(x, .row = seq_len(nrow(x))) x diff --git a/R/arguments.R b/R/arguments.R index 42721aac4..d68758ba8 100644 --- a/R/arguments.R +++ b/R/arguments.R @@ -56,7 +56,7 @@ set_args <- function(object, ...) { set_args.model_spec <- function(object, ...) { the_dots <- enquos(...) if (length(the_dots) == 0) - rlang::abort("Please pass at least one named argument.") + cli::cli_abort("Please pass at least one named argument.") main_args <- names(object$args) new_args <- names(the_dots) for (i in new_args) { @@ -262,7 +262,7 @@ make_xy_call <- function(object, target, env) { none = rlang::expr(x), data.frame = rlang::expr(maybe_data_frame(x)), matrix = rlang::expr(maybe_matrix(x)), - rlang::abort(glue::glue("Invalid data type target: {target}.")) + cli::cli_abort("Invalid data type target: {target}.") ) if (uses_weights) { object$method$fit$args[[ unname(data_args["weights"]) ]] <- rlang::expr(weights) diff --git a/R/augment.R b/R/augment.R index 7ecea0d6f..8220414d0 100644 --- a/R/augment.R +++ b/R/augment.R @@ -86,7 +86,7 @@ augment.model_fit <- function(x, new_data, eval_time = NULL, ...) { "regression" = augment_regression(x, new_data), "classification" = augment_classification(x, new_data), "censored regression" = augment_censored(x, new_data, eval_time = eval_time), - rlang::abort(paste("Unknown mode:", x$spec$mode)) + cli::cli_abort("Unknown mode: {x$spec$mode}.") ) tibble::new_tibble(res) } diff --git a/R/autoplot.R b/R/autoplot.R index 34dabc5c6..823dd62f1 100644 --- a/R/autoplot.R +++ b/R/autoplot.R @@ -44,7 +44,9 @@ map_glmnet_coefs <- function(x) { # work. If an object is loaded from a new session, they will need to load the # package. if (is.null(coefs)) { - rlang::abort("Please load the glmnet package before running `autoplot()`.") + cli::cli_abort( + "Please load the glmnet package before running {.fun autoplot}." + ) } p <- x$dim[1] if (is.list(coefs)) { @@ -161,8 +163,7 @@ check_penalty_value <- function(x) { cl <- match.call() arg_val <- as.character(cl$x) if (!is.vector(x) || length(x) != 1 || !is.numeric(x) || x < 0) { - msg <- paste0("Argument '", arg_val, "' should be a single, non-negative value.") - rlang::abort(msg) + cli::cli_abort("{.arg {arg_val}} should be a single, non-negative value.") } invisible(x) } diff --git a/R/case_weights.R b/R/case_weights.R index 5709286bb..0d482920f 100644 --- a/R/case_weights.R +++ b/R/case_weights.R @@ -87,10 +87,9 @@ case_weights_allowed <- function(spec) { get_from_env(paste0(mod_type, "_fit")) %>% dplyr::filter(engine == mod_eng & mode == mod_mode) if (nrow(model_info) != 1) { - rlang::abort( - glue::glue( - "Error in getting model information for model {mod_type} with engine {mod_eng} and mode {mod_mode}." - ) + cli::cli_abort( + "Error in getting model information for model {mod_type} with + engine {mod_eng} and mode {mod_mode}." ) } # If weights are used, they are protected data arguments with the canonical diff --git a/R/condense_control.R b/R/condense_control.R index cdb077572..a5b49bd97 100644 --- a/R/condense_control.R +++ b/R/condense_control.R @@ -23,17 +23,12 @@ condense_control <- function(x, ref) { mismatch <- setdiff(names(ref), names(x)) if (length(mismatch)) { - rlang::abort( + cli::cli_abort( c( - glue::glue( - "Object of class `{class(x)[1]}` cannot be coerced to ", - "object of class `{class(ref)[1]}`." - ), - "The following arguments are missing:", - glue::glue_collapse( - glue::single_quote(mismatch), - sep = ", ", last = ", and " - ) + "Object of class {.cls class(x)[1]} cannot be coerced to + object of class {.cls class(ref)[1]}.", + "i" = "{cli::qty(mismatch)} The argument{?s} {.arg {mismatch}} + {?is/are} missing." ) ) } diff --git a/R/contr_one_hot.R b/R/contr_one_hot.R index f4bed3711..f8ebe1e1f 100644 --- a/R/contr_one_hot.R +++ b/R/contr_one_hot.R @@ -30,12 +30,12 @@ contr_one_hot <- function(n, contrasts = TRUE, sparse = FALSE) { n <- as.integer(n) if (length(n) != 1L) { - rlang::abort("`n` must have length 1 when an integer is provided.") + cli::cli_abort("{.arg n} must have length 1 when an integer is provided.") } names <- as.character(seq_len(n)) } else { - rlang::abort("`n` must be a character vector or an integer of size 1.") + cli::cli_abort("{.arg n} must be a character vector or an integer of size 1.") } out <- diag(n) diff --git a/R/control_parsnip.R b/R/control_parsnip.R index 5054b08d8..52f6cbd29 100644 --- a/R/control_parsnip.R +++ b/R/control_parsnip.R @@ -28,17 +28,21 @@ control_parsnip <- function(verbosity = 1L, catch = FALSE) { res } -check_control <- function(x) { +check_control <- function(x, call = rlang::caller_env()) { if (!is.list(x)) - rlang::abort("control should be a named list.") + cli::cli_abort("{.arg control} should be a named list.", call = call) if (!isTRUE(all.equal(sort(names(x)), c("catch", "verbosity")))) - rlang::abort("control should be a named list with elements 'verbosity' and 'catch'.") + cli::cli_abort( + "{.arg control} should be a named list with elements {.field verbosity} + and {.field catch}.", + call = call + ) # based on ?is.integer int_check <- function(x, tol = .Machine$double.eps^0.5) abs(x - round(x)) < tol if (!int_check(x$verbosity)) - rlang::abort("verbosity should be an integer.") + cli::cli_abort("{.arg verbosity} should be an integer.", call = call) if (!is.logical(x$catch)) - rlang::abort("catch should be a logical.") + cli::cli_abort("{.arg catch} should be a logical.", call = call) x } diff --git a/R/convert_data.R b/R/convert_data.R index 519aec9e3..3ba1ca59f 100644 --- a/R/convert_data.R +++ b/R/convert_data.R @@ -42,7 +42,9 @@ composition = "data.frame", remove_intercept = TRUE) { if (!(composition %in% c("data.frame", "matrix"))) { - rlang::abort("`composition` should be either 'data.frame' or 'matrix'.") + cli::cli_abort( + "{.arg composition} should be either {.val data.frame} or {.val matrix}." + ) } if (remove_intercept) { @@ -74,7 +76,7 @@ w <- as.vector(model.weights(mod_frame)) if (!is.null(w) && !is.numeric(w)) { - rlang::abort("`weights` must be a numeric vector") + cli::cli_abort("{.arg weights} must be a numeric vector.") } # TODO: Do we actually use the offset when fitting? @@ -151,7 +153,9 @@ na.action = na.pass, composition = "data.frame") { if (!(composition %in% c("data.frame", "matrix"))) { - rlang::abort("`composition` should be either 'data.frame' or 'matrix'.") + cli::cli_abort( + "{.arg composition} should be either {.val data.frame} or {.val matrix}." + ) } mod_terms <- object$terms @@ -218,7 +222,7 @@ y_name = "..y", remove_intercept = TRUE) { if (is.vector(x)) { - rlang::abort("`x` cannot be a vector.") + cli::cli_abort("{.arg x} cannot be a vector.") } if (remove_intercept) { @@ -251,10 +255,10 @@ if (!is.null(weights)) { if (!is.numeric(weights)) { - rlang::abort("`weights` must be a numeric vector") + cli::cli_abort("{.arg weights} must be a numeric vector.") } if (length(weights) != nrow(x)) { - rlang::abort(glue::glue("`weights` should have {nrow(x)} elements")) + cli::cli_abort("{.arg weights} should have {nrow(x)} elements") } form <- patch_formula_environment_with_case_weights( @@ -294,17 +298,17 @@ local_one_hot_contrasts <- function(frame = rlang::caller_env()) { rlang::local_options(contrasts = contrasts, .frame = frame) } -check_form_dots <- function(x) { +check_form_dots <- function(x, call = rlang::caller_env()) { good_args <- c("subset", "weights") good_names <- names(x) %in% good_args if (any(!good_names)) { - rlang::abort( - glue::glue( - "These argument(s) cannot be used to create the data: ", - glue::glue_collapse(glue::glue("`{names(x)[!good_names]}`"), sep = ", "), - ". Possible arguments are: ", - glue::glue_collapse(glue::glue("`{good_args}`"), sep = ", ") - ) + cli::cli_abort( + c( + "The argument{?s} {.arg {names(x)[!good_names]}} cannot be used to create + the data.", + "Possible arguments are {.arg {.or {good_args}}." + ), + call = call ) } invisible(NULL) @@ -339,18 +343,18 @@ will_make_matrix <- function(y) { all(can_convert) } -check_dup_names <- function(x, y) { +check_dup_names <- function(x, y, call = rlang::caller_env()) { if (is.vector(y)) return(invisible(NULL)) common_names <- intersect(colnames(x), colnames(y)) - if (length(common_names) > 0) - rlang::abort( - glue::glue( - "`x` and `y` have at least one name in common: ", - glue::glue_collapse(glue::glue("'{common_names}'"), sep = ", ") - ) + if (length(common_names) > 0) { + cli::cli_abort( + "{.arg x} and {.arg y} have the name{?s} {.val {common_names}} in common.", + call = call ) + } + invisible(NULL) } @@ -363,16 +367,18 @@ check_dup_names <- function(x, y) { #' @param x A data frame, matrix, or sparse matrix. #' @return A data frame, matrix, or sparse matrix. #' @export -maybe_matrix <- function(x) { +maybe_matrix <- function(x, call = rlang::caller_env()) { inher(x, c("data.frame", "matrix", "dgCMatrix"), cl = match.call()) if (is.data.frame(x)) { non_num_cols <- vapply(x, function(x) !is.numeric(x), logical(1)) if (any(non_num_cols)) { non_num_cols <- names(non_num_cols)[non_num_cols] - non_num_cols <- glue::glue_collapse(glue::single_quote(non_num_cols), sep = ", ") - msg <- glue::glue("Some columns are non-numeric. The data cannot be ", - "converted to numeric matrix: {non_num_cols}.") - rlang::abort(msg) + + cli::cli_abort( + "The column{?s} {.val {non_num_cols}} {?is/are} non-numeric, so the + data cannot be converted to a numeric matrix.", + call = call + ) } x <- as.matrix(x) } diff --git a/R/engines.R b/R/engines.R index 51a22dbff..f90c77ba3 100644 --- a/R/engines.R +++ b/R/engines.R @@ -20,17 +20,16 @@ is_installed <- function(pkg) { res } -check_installs <- function(x) { +check_installs <- function(x, call = rlang::caller_env()) { if (length(x$method$libs) > 0) { is_inst <- map_lgl(x$method$libs, is_installed) if (any(!is_inst)) { missing_pkg <- x$method$libs[!is_inst] missing_pkg <- paste0(missing_pkg, collapse = ", ") - rlang::abort( - glue::glue( - "This engine requires some package installs: ", - glue::glue_collapse(glue::glue("'{missing_pkg}'"), sep = ", ") - ) + + cli::cli_abort( + "Please install the {.pkg {missing_pkg}} package{?s} to use this engine.", + call = call ) } } @@ -165,13 +164,11 @@ set_engine.default <- function(object, engine, ...) { #' @export show_engines <- function(x) { if (!is.character(x) || length(x) > 1) { - rlang::abort("`show_engines()` takes a single character string as input.") + cli::cli_abort("{.arg x} must be a single character string.") } res <- try(get_from_env(x), silent = TRUE) if (inherits(res, "try-error") | is.null(res)) { - rlang::abort( - paste0("No results found for model function '", x, "'.") - ) + cli::cli_abort("No results found for model function {.val x}.") } res } diff --git a/R/extract.R b/R/extract.R index 08da71cd5..040682b6c 100644 --- a/R/extract.R +++ b/R/extract.R @@ -65,7 +65,7 @@ extract_spec_parsnip.model_fit <- function(x, ...) { if (any(names(x) == "spec")) { return(x$spec) } - rlang::abort("Internal error: The model fit does not have a model spec.") + cli::cli_abort("The model fit does not have a model spec.", .internal = TRUE) } @@ -75,7 +75,7 @@ extract_fit_engine.model_fit <- function(x, ...) { if (any(names(x) == "fit")) { return(x$fit) } - rlang::abort("Internal error: The model fit does not have an engine fit.") + cli::cli_abort("The model fit does not have an engine fit.", .internal = TRUE) } #' @export @@ -141,8 +141,8 @@ extract_fit_time.model_fit <- function(x, summarize = TRUE, ...) { elapsed <- x[["elapsed"]][["elapsed"]][["elapsed"]] if (is.na(elapsed) || is.null(elapsed)) { - rlang::abort( - "This model was fit before `extract_fit_time()` was added." + cli::cli_abort( + "This model was fit before {.fun extract_fit_time} was added." ) } diff --git a/R/fit_helpers.R b/R/fit_helpers.R index fe7f75527..2af4c1945 100644 --- a/R/fit_helpers.R +++ b/R/fit_helpers.R @@ -66,8 +66,12 @@ xy_xy <- function(object, ..., call = rlang::caller_env()) { - if (inherits(env$x, "tbl_spark") | inherits(env$y, "tbl_spark")) - rlang::abort("spark objects can only be used with the formula interface to `fit()`") + if (inherits(env$x, "tbl_spark") | inherits(env$y, "tbl_spark")) { + cli::cli_abort( + "spark objects can only be used with the formula interface to {.fun fit}", + call = call + ) + } check_outcome(env$y, object) diff --git a/R/glm_grouped.R b/R/glm_grouped.R index ec14dddc3..2b462f795 100644 --- a/R/glm_grouped.R +++ b/R/glm_grouped.R @@ -82,7 +82,7 @@ glm_grouped <- function(formula, data, weights, ...) { } if (is.null(weights) || !is.numeric(weights)) { - rlang::abort("'weights' should be an integer vector.") + cli::cli_abort("{.arg weights} should be an integer vector.") } if (!is.integer(weights)) { weights <- as.integer(weights) @@ -96,7 +96,9 @@ glm_grouped <- function(formula, data, weights, ...) { lvls <- levels(data[[response]]) if (length(lvls) != 2) { - rlang::abort(glue::glue("the response column '{response}' should be a two-level factor.")) + cli::cli_abort( + "The response column {.val response} should be a two-level factor." + ) } all_cols <- c(response, all_pred) diff --git a/R/misc.R b/R/misc.R index b564870fd..ee41f22c2 100644 --- a/R/misc.R +++ b/R/misc.R @@ -18,7 +18,9 @@ make_classes <- function(prefix) { check_empty_ellipse <- function(...) { terms <- quos(...) if (!is_empty(terms)) { - rlang::abort("Please pass other arguments to the model function via `set_engine()`.") + cli::cli_abort( + "Please pass other arguments to the model function via {.fun set_engine}." + ) } terms } @@ -298,9 +300,9 @@ check_args.default <- function(object, call = rlang::caller_env()) { # copied form recipes -names0 <- function(num, prefix = "x") { +names0 <- function(num, prefix = "x", call = rlang::caller_env()) { if (num < 1) { - rlang::abort("`num` should be > 0.") + cli::cli_abort("{.arg num} should be > 0.", call = call) } ind <- format(seq_len(num)) ind <- gsub(" ", "0", ind) @@ -317,13 +319,9 @@ update_dot_check <- function(...) { dots <- enquos(...) if (length(dots) > 0) { - rlang::abort( - glue::glue( - "Extra arguments will be ignored: ", - glue::glue_collapse(glue::glue("`{names(dots)}`"), sep = ", ") - ) - ) + cli::cli_abort("The extra argument{?s} {.arg {names(dots)}} will be ignored.") } + invisible(NULL) } @@ -425,16 +423,16 @@ check_final_param <- function(x) { return(invisible(x)) } if (!is.list(x) & !tibble::is_tibble(x)) { - rlang::abort("The parameter object should be a list or tibble") + cli::cli_abort("The parameter object should be a list or tibble.") } if (tibble::is_tibble(x) && nrow(x) > 1) { - rlang::abort("The parameter tibble should have a single row.") + cli::cli_abort("The parameter tibble should have a single row.") } if (tibble::is_tibble(x)) { x <- as.list(x) } if (length(names) == 0 || any(names(x) == "")) { - rlang::abort("All values in `parameters` should have a name.") + cli::cli_abort("All values in {.arg parameters} should have a name.") } invisible(x) @@ -455,11 +453,8 @@ update_main_parameters <- function(args, param) { has_extra_args <- !(names(param) %in% names(args)) extra_args <- names(param)[has_extra_args] if (any(has_extra_args)) { - rlang::abort( - paste( - "At least one argument is not a main argument:", - paste0("`", extra_args, "`", collapse = ", ") - ) + cli::cli_abort( + "Argument{?s} {.arg {extra_args}} {?is/are} not a main argument." ) } param <- param[!has_extra_args] @@ -517,16 +512,23 @@ stan_conf_int <- function(object, newdata) { # ------------------------------------------------------------------------------ -check_case_weights <- function(x, spec) { +check_case_weights <- function(x, spec, call = rlang::caller_env()) { if (is.null(x) | spec$engine == "spark") { return(invisible(NULL)) } if (!hardhat::is_case_weights(x)) { - rlang::abort("'case_weights' should be a single numeric vector of class 'hardhat_case_weights'.") + cli::cli_abort( + "{.arg case_weights} should be a single numeric vector of + class {.cls hardhat_case_weights}.", + call = call + ) } allowed <- case_weights_allowed(spec) if (!allowed) { - rlang::abort("Case weights are not enabled by the underlying model implementation.") + cli::cli_abort( + "Case weights are not enabled by the underlying model implementation.", + call = call + ) } invisible(NULL) } @@ -534,8 +536,8 @@ check_case_weights <- function(x, spec) { # ----------------------------------------------------------------------------- check_for_newdata <- function(..., call = rlang::caller_env()) { if (any(names(list(...)) == "newdata")) { - rlang::abort( - "Please use `new_data` instead of `newdata`.", + cli::cli_abort( + "Please use {.arg new_data} instead of {.arg newdata}.", call = call ) } diff --git a/R/nullmodel.R b/R/nullmodel.R index f75e95929..c5d40d6a4 100644 --- a/R/nullmodel.R +++ b/R/nullmodel.R @@ -112,7 +112,7 @@ predict.nullmodel <- function (object, new_data = NULL, type = NULL, ...) { } } else { if (type %in% c("prob", "class")) { - rlang::abort("Only numeric predicitons are applicable to regression models") + cli::cli_abort("Only numeric predicitons are applicable to regression models.") } if (length(object$value) == 1) { out <- rep(object$value, n) diff --git a/R/partykit.R b/R/partykit.R index 3ff8907a3..a1ca20da5 100644 --- a/R/partykit.R +++ b/R/partykit.R @@ -79,7 +79,10 @@ ctree_train <- if (!is.vector(weights) || !is.integer(weights) || length(weights) != nrow(data)) { - rlang::abort("'weights' should be an integer vector with size the same as the number of rows of 'data'.") + cli::cli_abort( + "{.arg weights} should be an integer vector with size the same + as the number of rows of {.arg data}." + ) } tree_call$weights <- rlang::expr(weights) } @@ -156,7 +159,10 @@ cforest_train <- if (!is.vector(weights) || !is.numeric(weights) || length(weights) != nrow(data)) { - rlang::abort("'weights' should be a numeric vector with size the same as the number of rows of 'data'.") + cli::cli_abort( + "{.arg weights} should be a numeric vector with size the same as + the number of rows of {.arg data}." + ) } forest_call$weights <- rlang::expr(weights) } diff --git a/R/repair_call.R b/R/repair_call.R index fcede6649..8b22b2164 100644 --- a/R/repair_call.R +++ b/R/repair_call.R @@ -30,10 +30,10 @@ repair_call <- function(x, data) { cl <- match.call() if (!any(names(x$fit) == "call")) { - rlang::abort("No `call` object to modify.") + cli::cli_abort("No `call` object to modify.") } if (rlang::is_missing(data)) { - rlang::abort("Please supply a data object to `data`.") + cli::cli_abort("Please supply a data object to {.arg data}.") } fit_call <- x$fit$call needs_eval <- purrr::map_lgl(fit_call, rlang::is_quosure) diff --git a/R/required_pkgs.R b/R/required_pkgs.R index a68420ed4..e025f7c01 100644 --- a/R/required_pkgs.R +++ b/R/required_pkgs.R @@ -24,7 +24,7 @@ #' @export required_pkgs.model_spec <- function(x, infra = TRUE, ...) { if (is.null(x$engine)) { - rlang::abort("Please set an engine.") + cli::cli_abort("Please set an engine.") } get_pkgs(x, infra) } diff --git a/R/standalone-survival.R b/R/standalone-survival.R index c655bbf5e..ab1033171 100644 --- a/R/standalone-survival.R +++ b/R/standalone-survival.R @@ -50,7 +50,7 @@ .is_surv <- function(surv, fail = TRUE, call = rlang::caller_env()) { is_surv <- inherits(surv, "Surv") if (!is_surv && fail) { - rlang::abort("The object does not have class `Surv`.", call = call) + cli::cli_abort("The object does not have class {.cls Surv}.", call = call) } is_surv } @@ -68,9 +68,10 @@ obj_type <- .extract_surv_type(surv) good_type <- all(obj_type %in% type) if (!good_type && fail) { - c_list <- paste0("'", type, "'") - msg <- cli::format_inline("For this usage, the allowed censoring type{?s} {?is/are}: {c_list}") - rlang::abort(msg, call = call) + rlang::abort( + "For this usage, the allowed censoring type{?s} {?is/are} {.or {type}}.", + call = call + ) } good_type } diff --git a/R/survival-censoring-model.R b/R/survival-censoring-model.R index 0509882a8..91fb78f0e 100644 --- a/R/survival-censoring-model.R +++ b/R/survival-censoring-model.R @@ -54,8 +54,8 @@ print.censoring_model <- function(x, ...) { #' @export predict.censoring_model <- function(object, ...) { - rlang::abort( - paste("Don't know how to predict with a censoring model of type:", object$label) + cli::cli_abort( + "Don't know how to predict with a censoring model of type {object$label}." ) invisible(NULL) } diff --git a/R/survival-censoring-weights.R b/R/survival-censoring-weights.R index 2b7b48df8..49d33e905 100644 --- a/R/survival-censoring-weights.R +++ b/R/survival-censoring-weights.R @@ -23,29 +23,40 @@ trunc_probs <- function(probs, trunc = 0.01) { .check_pred_col <- function(x, call = rlang::env_parent()) { if (!any(names(x) == ".pred")) { - rlang::abort("The input should have a list column called `.pred`.", call = call) + cli::cli_abort( + "The input should have a list column called {.val .pred}.", + call = call + ) } if (!is.list(x$.pred)) { - rlang::abort("The input should have a list column called `.pred`.", call = call) + cli::cli_abort( + "The input should have a list column called {.val .pred}.", + call = call + ) } req_cols <- c(".eval_time", ".pred_survival") if (!all(req_cols %in% names(x$.pred[[1]]))) { - msg <- paste0("The `.pred` tibbles should have columns: ", - paste0("'", req_cols, "'", collapse = ", ")) - rlang::abort(msg, call = call) + cli::cli_abort( + "The `.pred` tibbles should have columns {.val req_cols}.", + call = call + ) } invisible(NULL) } -.check_censor_model <- function(x) { +.check_censor_model <- function(x, call = rlang::caller_env()) { if (x$spec$mode != "censored regression") { cli::cli_abort( - "The model needs to be for mode 'censored regression', not for mode '{x$spec$mode}'." + "The model needs to be for mode 'censored regression', not for mode '{x$spec$mode}'.", + call = call ) } nms <- names(x) if (!any(nms == "censor_probs")) { - rlang::abort("Please refit the model with parsnip version 1.0.4 or greater.") + cli::cli_abort( + "Please refit the model with {.pkg parsnip} version 1.0.4 or greater.", + call = call + ) } invisible(NULL) } @@ -172,10 +183,10 @@ graf_weight_time_vec <- function(surv_obj, eval_time, eps = 10^-10) { #' @export #' @rdname censoring_weights .censoring_weights_graf.default <- function(object, ...) { - cls <- paste0("'", class(object), "'", collapse = ", ") - msg <- paste("There is no `.censoring_weights_graf()` method for objects with class(es):", - cls) - rlang::abort(msg) + cli::cli_abort( + "There is no `.censoring_weights_graf()` method for objects with class{?es} + {.cls {class(object)}}." + ) } #' @export @@ -233,7 +244,7 @@ add_graf_weights_vec <- function(object, .pred, surv_obj, trunc = 0.05, eps = 10 is_surv <- purrr::map_lgl(x[!is_lst_col], .is_surv, fail = FALSE) num_surv <- sum(is_surv) if (fail && num_surv != 1) { - rlang::abort("There should be a single column of class `Surv`", call = call) + cli::cli_abort("There should be a single column of class {.cls Surv}.", call = call) } names(is_surv)[is_surv] } diff --git a/R/svm_linear.R b/R/svm_linear.R index 29bac41a6..c45bb6fea 100644 --- a/R/svm_linear.R +++ b/R/svm_linear.R @@ -111,12 +111,12 @@ translate.svm_linear <- function(x, engine = x$engine, ...) { ) } else if (x$mode == "classification") { if (!is_null(liblinear_type)) - if(!liblinear_type %in% 1:5) - rlang::abort( - paste0("The LiblineaR engine argument of `type` = ", - liblinear_type, - " does not correspond to an SVM classification model.") + if (!liblinear_type %in% 1:5) { + cli::cli_abort( + "The LiblineaR engine argument of {.code type = {liblinear_type}} + does not correspond to an SVM classification model." ) + } } } diff --git a/R/translate.R b/R/translate.R index b2c59f599..7a43a3827 100644 --- a/R/translate.R +++ b/R/translate.R @@ -52,14 +52,15 @@ translate <- function(x, ...) #' @export translate.default translate.default <- function(x, engine = x$engine, ...) { check_empty_ellipse(...) - if (is.null(engine)) - rlang::abort("Please set an engine.") + if (is.null(engine)) { + cli::cli_abort("Please set an engine.") + } mod_name <- specific_model(x) x$engine <- engine if (x$mode == "unknown") { - rlang::abort("Model code depends on the mode; please specify one.") + cli::cli_abort("Model code depends on the mode; please specify one.") } check_spec_mode_engine_val(class(x)[1], x$engine, x$mode) @@ -196,7 +197,7 @@ add_methods <- function(x, engine) { #' @export .model_param_name_key <- function(object, as_tibble = TRUE) { if (!inherits(object, c("model_spec", "workflow"))) { - rlang::abort("'object' should be a model specification or workflow.") + cli::cli_abort("{.arg object} should be a model specification or workflow.") } if (inherits(object, "workflow")) { object <- hardhat::extract_spec_parsnip(object) diff --git a/R/varying.R b/R/varying.R index 53b7ca724..d322c114e 100644 --- a/R/varying.R +++ b/R/varying.R @@ -184,10 +184,10 @@ validate_only_allowed_step_args <- function(x, step_type) { return(invisible(x)) } - rlang::abort(glue::glue( - "The following argument for a recipe step of type ", - "'{step_type}' is not allowed to vary: '{nm}'." - )) + cli::cli_abort( + "The argument {nm} for a recipe step of type + {.val step_type} is not allowed to vary." + ) } purrr::iwalk(x, check_allowed_arg) diff --git a/inst/add-in/gadget.R b/inst/add-in/gadget.R index 43bb8a39f..7a20ffd56 100644 --- a/inst/add-in/gadget.R +++ b/inst/add-in/gadget.R @@ -6,12 +6,9 @@ parsnip_spec_add_in <- function() { is_inst <- rlang::is_installed(libs) if (any(!is_inst)) { missing_pkg <- libs[!is_inst] - missing_pkg <- paste0(missing_pkg, collapse = ", ") - rlang::abort( - glue::glue( - "The add-in requires some CRAN package installs: ", - glue::glue_collapse(glue::glue("'{missing_pkg}'"), sep = ", ") - ) + + cli::cli_abort( + "Please install package{s} {.pkg {missing_pkg}} to use the add-in." ) } diff --git a/man/rmd/aaa.Rmd b/man/rmd/aaa.Rmd index 3aa20ac19..c17bd649d 100644 --- a/man/rmd/aaa.Rmd +++ b/man/rmd/aaa.Rmd @@ -137,8 +137,10 @@ uses_extension <- function(mod, eng, mod_mode) { num_ext <- length(exts) if (num_ext > 1) { - rlang::abort(c("There are more than one extension packages for:", - mod, eng, mod_mode)) + cli::cli_abort( + "There is more than one extension package for model {.fun {mod}}, + engine {.val {eng}}, and mode {.val {mod_mode}}." + ) } if (num_ext > 0) { res <- paste0("The **", diff --git a/tests/testthat/_snaps/condense_control.md b/tests/testthat/_snaps/condense_control.md index 26043d374..19f908d21 100644 --- a/tests/testthat/_snaps/condense_control.md +++ b/tests/testthat/_snaps/condense_control.md @@ -4,7 +4,6 @@ condense_control(control_parsnip(), ctrl) Condition Error in `condense_control()`: - ! Object of class `control_parsnip` cannot be coerced to object of class `control_parsnip`. - * The following arguments are missing: - * 'allow_par', and 'anotherone' + ! Object of class cannot be coerced to object of class . + i The arguments `allow_par` and `anotherone` are missing. diff --git a/tests/testthat/_snaps/convert_data.md b/tests/testthat/_snaps/convert_data.md new file mode 100644 index 000000000..ed00a590f --- /dev/null +++ b/tests/testthat/_snaps/convert_data.md @@ -0,0 +1,16 @@ +# convert to matrix + + Code + parsnip::maybe_matrix(ames[, c("Year_Built", "Neighborhood")]) + Condition + Error: + ! The column "Neighborhood" is non-numeric, so the data cannot be converted to a numeric matrix. + +--- + + Code + parsnip::maybe_matrix(Chicago[, c("ridership", "date")]) + Condition + Error: + ! The column "date" is non-numeric, so the data cannot be converted to a numeric matrix. + diff --git a/tests/testthat/_snaps/extract.md b/tests/testthat/_snaps/extract.md index d4363fb70..182164a97 100644 --- a/tests/testthat/_snaps/extract.md +++ b/tests/testthat/_snaps/extract.md @@ -1,3 +1,23 @@ +# extract + + Code + extract_spec_parsnip(x_no_spec) + Condition + Error in `extract_spec_parsnip()`: + ! The model fit does not have a model spec. + i This is an internal error that was detected in the parsnip package. + Please report it at with a reprex () and the full backtrace. + +--- + + Code + extract_fit_engine(x_no_fit) + Condition + Error in `extract_fit_engine()`: + ! The model fit does not have an engine fit. + i This is an internal error that was detected in the parsnip package. + Please report it at with a reprex () and the full backtrace. + # extract parameter set from model with no loaded implementation Code diff --git a/tests/testthat/_snaps/misc.md b/tests/testthat/_snaps/misc.md index cb16c16e5..1a8e6733e 100644 --- a/tests/testthat/_snaps/misc.md +++ b/tests/testthat/_snaps/misc.md @@ -1,3 +1,11 @@ +# parsnip objects + + Code + multi_predict(lm_fit, mtcars) + Condition + Error in `multi_predict()`: + ! No `multi_predict()` method exists for objects with classes <_lm/model_fit>. + # combine_words helper works Code diff --git a/tests/testthat/_snaps/partykit.md b/tests/testthat/_snaps/partykit.md index 7c64a5ead..30810151b 100644 --- a/tests/testthat/_snaps/partykit.md +++ b/tests/testthat/_snaps/partykit.md @@ -1,8 +1,8 @@ # fit ctree models - 'weights' should be an integer vector with size the same as the number of rows of 'data'. + `weights` should be an integer vector with size the same as the number of rows of `data`. # fit cforest models - 'weights' should be a numeric vector with size the same as the number of rows of 'data'. + `weights` should be a numeric vector with size the same as the number of rows of `data`. diff --git a/tests/testthat/_snaps/translate.md b/tests/testthat/_snaps/translate.md index ff354245c..edb00ca38 100644 --- a/tests/testthat/_snaps/translate.md +++ b/tests/testthat/_snaps/translate.md @@ -2158,5 +2158,5 @@ --- - 'object' should be a model specification or workflow. + `object` should be a model specification or workflow. diff --git a/tests/testthat/_snaps/update.md b/tests/testthat/_snaps/update.md index ee13a6b86..394aa2a9f 100644 --- a/tests/testthat/_snaps/update.md +++ b/tests/testthat/_snaps/update.md @@ -197,7 +197,7 @@ expr1 %>% update(param_tibb) Condition Error in `update_main_parameters()`: - ! At least one argument is not a main argument: `nlambda` + ! Argument `nlambda` is not a main argument. --- @@ -205,7 +205,7 @@ expr1 %>% update(param_list) Condition Error in `update_main_parameters()`: - ! At least one argument is not a main argument: `nlambda` + ! Argument `nlambda` is not a main argument. --- @@ -213,7 +213,7 @@ expr1 %>% update(parameters = "wat") Condition Error in `check_final_param()`: - ! The parameter object should be a list or tibble + ! The parameter object should be a list or tibble. --- @@ -221,7 +221,7 @@ expr1 %>% update(parameters = tibble::tibble(wat = "wat")) Condition Error in `update_main_parameters()`: - ! At least one argument is not a main argument: `wat` + ! Argument `wat` is not a main argument. --- @@ -229,5 +229,5 @@ linear_reg() %>% update(boop = 0) Condition Error in `update_dot_check()`: - ! Extra arguments will be ignored: `boop` + ! The extra argument `boop` will be ignored. diff --git a/tests/testthat/test-convert_data.R b/tests/testthat/test-convert_data.R index e07b8c734..1b9c98255 100644 --- a/tests/testthat/test-convert_data.R +++ b/tests/testthat/test-convert_data.R @@ -622,14 +622,14 @@ test_that("convert to matrix", { ) data(ames, package = "modeldata") - expect_error( - parsnip::maybe_matrix(ames[, c("Year_Built", "Neighborhood")]), - "Some columns are non-numeric. The data cannot be converted to numeric matrix: 'Neighborhood'." + expect_snapshot( + error = TRUE, + parsnip::maybe_matrix(ames[, c("Year_Built", "Neighborhood")]) ) # Also for date columns data(Chicago, package = "modeldata") - expect_error( - parsnip::maybe_matrix(Chicago[, c("ridership", "date")]), - "Some columns are non-numeric. The data cannot be converted to numeric matrix: 'date'." + expect_snapshot( + error = TRUE, + parsnip::maybe_matrix(Chicago[, c("ridership", "date")]) ) }) diff --git a/tests/testthat/test-extract.R b/tests/testthat/test-extract.R index e48727ee9..b1826efef 100644 --- a/tests/testthat/test-extract.R +++ b/tests/testthat/test-extract.R @@ -8,8 +8,8 @@ test_that('extract', { expect_true(inherits(extract_spec_parsnip(x), "model_spec")) expect_true(inherits(extract_fit_engine(x), "lm")) - expect_error(extract_spec_parsnip(x_no_spec), "Internal error") - expect_error(extract_fit_engine(x_no_fit), "Internal error") + expect_snapshot(error = TRUE, extract_spec_parsnip(x_no_spec)) + expect_snapshot(error = TRUE, extract_fit_engine(x_no_fit)) }) # ------------------------------------------------------------------------------ diff --git a/tests/testthat/test-misc.R b/tests/testthat/test-misc.R index 643f60e05..fbfad14e8 100644 --- a/tests/testthat/test-misc.R +++ b/tests/testthat/test-misc.R @@ -9,10 +9,7 @@ test_that('parsnip objects', { lm_fit <- fit(lm_idea, mpg ~ ., data = mtcars) expect_false(has_multi_predict(lm_fit)) expect_false(has_multi_predict(extract_fit_engine(lm_fit))) - expect_error( - multi_predict(lm_fit, mtcars), - "No `multi_predict` method exists" - ) + expect_snapshot(error = TRUE, multi_predict(lm_fit, mtcars)) mars_fit <- mars(mode = "regression") %>% @@ -20,9 +17,9 @@ test_that('parsnip objects', { fit(mpg ~ ., data = mtcars) expect_true(has_multi_predict(mars_fit)) expect_false(has_multi_predict(extract_fit_engine(mars_fit))) - expect_error( - multi_predict(extract_fit_engine(mars_fit), mtcars), - "No `multi_predict` method exists" + expect_snapshot( + error = TRUE, + multi_predict(extract_fit_engine(mars_fit), mtcars) ) }) From 40894b8bb504f52674d09b076cb633aad32c9d68 Mon Sep 17 00:00:00 2001 From: simonpcouch Date: Wed, 28 Aug 2024 11:27:47 -0500 Subject: [PATCH 02/11] transition remaining `rlang::warn()`s to `cli::cli_warn()` --- R/aaa_multi_predict.R | 2 +- R/arguments.R | 27 +++++++++++++------ R/contr_one_hot.R | 4 +-- R/glm_grouped.R | 2 +- R/predict_hazard.R | 2 +- R/predict_interval.R | 4 +-- R/predict_linear_pred.R | 2 +- R/predict_quantile.R | 2 +- R/predict_raw.R | 2 +- R/predict_survival.R | 2 +- R/survival-censoring-weights.R | 3 +-- tests/testthat/_snaps/decision_tree.md | 18 +++++++++++++ tests/testthat/_snaps/misc.md | 8 ++++++ .../testthat/_snaps/nearest_neighbor_kknn.md | 18 +++++++++++++ tests/testthat/_snaps/rand_forest_ranger.md | 12 ++++++--- tests/testthat/test-decision_tree.R | 10 +++---- tests/testthat/test-nearest_neighbor_kknn.R | 10 +++---- 17 files changed, 91 insertions(+), 37 deletions(-) create mode 100644 tests/testthat/_snaps/nearest_neighbor_kknn.md diff --git a/R/aaa_multi_predict.R b/R/aaa_multi_predict.R index d00a82c1e..f79e8e9e7 100644 --- a/R/aaa_multi_predict.R +++ b/R/aaa_multi_predict.R @@ -19,7 +19,7 @@ #' @export multi_predict <- function(object, ...) { if (inherits(object$fit, "try-error")) { - rlang::warn("Model fit failed; cannot make predictions.") + cli::cli_warn("Model fit failed; cannot make predictions.") return(NULL) } check_for_newdata(...) diff --git a/R/arguments.R b/R/arguments.R index d68758ba8..e33bb072a 100644 --- a/R/arguments.R +++ b/R/arguments.R @@ -22,8 +22,10 @@ check_eng_args <- function(args, obj, core_args) { if (length(common_args) > 0) { args <- args[!(names(args) %in% common_args)] common_args <- paste0(common_args, collapse = ", ") - rlang::warn(glue::glue("The following arguments cannot be manually modified ", - "and were removed: {common_args}.")) + cli::cli_warn( + "The argument{?s} {.arg {common_args}} cannot be manually + modified and {?was/were} removed." + ) } args } @@ -316,9 +318,13 @@ min_cols <- function(num_cols, source) { p <- ncol(source) } if (num_cols > p) { - msg <- paste0(num_cols, " columns were requested but there were ", p, - " predictors in the data. ", p, " will be used.") - rlang::warn(msg) + cli::cli_warn( + c( + "!" = "{num_cols} column{?s} {?was/were} requested but there were + {p} predictors in the data.", + "i" = "{p} will be used." + ) + ) num_cols <- p } @@ -335,9 +341,14 @@ min_rows <- function(num_rows, source, offset = 0) { } if (num_rows > n - offset) { - msg <- paste0(num_rows, " samples were requested but there were ", n, - " rows in the data. ", n - offset, " will be used.") - rlang::warn(msg) + cli::cli_warn( + c( + "!" = "{num_rows} sample{?s} {?was/were} requested but there were + {n} rows in the data.", + "i" = "{n - offset} will be used." + ) + ) + num_rows <- n - offset } diff --git a/R/contr_one_hot.R b/R/contr_one_hot.R index f8ebe1e1f..7ea1115ae 100644 --- a/R/contr_one_hot.R +++ b/R/contr_one_hot.R @@ -16,11 +16,11 @@ #' @export contr_one_hot <- function(n, contrasts = TRUE, sparse = FALSE) { if (sparse) { - rlang::warn("`sparse = TRUE` not implemented for `contr_one_hot()`.") + cli::cli_warn("{.code sparse = TRUE} not implemented for {.fun contr_one_hot}.") } if (!contrasts) { - rlang::warn("`contrasts = FALSE` not implemented for `contr_one_hot()`.") + cli::cli_warn("{.code contrasts = FALSE} not implemented for {.fun contr_one_hot}.") } if (is.character(n)) { diff --git a/R/glm_grouped.R b/R/glm_grouped.R index 2b462f795..73e31bf9d 100644 --- a/R/glm_grouped.R +++ b/R/glm_grouped.R @@ -86,7 +86,7 @@ glm_grouped <- function(formula, data, weights, ...) { } if (!is.integer(weights)) { weights <- as.integer(weights) - rlang::warn(glue::glue("converting case weights from numeric to integer.")) + cli::cli_warn("Converting case weights from numeric to integer.") } terms <- terms(formula) diff --git a/R/predict_hazard.R b/R/predict_hazard.R index 433d9e253..a92fb454d 100644 --- a/R/predict_hazard.R +++ b/R/predict_hazard.R @@ -22,7 +22,7 @@ predict_hazard.model_fit <- function(object, check_spec_pred_type(object, "hazard") if (inherits(object$fit, "try-error")) { - rlang::warn("Model fit failed; cannot make predictions.") + cli::cli_warn("Model fit failed; cannot make predictions.") return(NULL) } diff --git a/R/predict_interval.R b/R/predict_interval.R index 4595c1551..136735a94 100644 --- a/R/predict_interval.R +++ b/R/predict_interval.R @@ -13,7 +13,7 @@ predict_confint.model_fit <- function(object, new_data, level = 0.95, std_error check_spec_pred_type(object, "conf_int") if (inherits(object$fit, "try-error")) { - rlang::warn("Model fit failed; cannot make predictions.") + cli::cli_warn("Model fit failed; cannot make predictions.") return(NULL) } @@ -68,7 +68,7 @@ predict_predint.model_fit <- function(object, new_data, level = 0.95, std_error check_spec_pred_type(object, "pred_int") if (inherits(object$fit, "try-error")) { - rlang::warn("Model fit failed; cannot make predictions.") + cli::cli_warn("Model fit failed; cannot make predictions.") return(NULL) } diff --git a/R/predict_linear_pred.R b/R/predict_linear_pred.R index 71b163d91..927164578 100644 --- a/R/predict_linear_pred.R +++ b/R/predict_linear_pred.R @@ -9,7 +9,7 @@ predict_linear_pred.model_fit <- function(object, new_data, ...) { check_spec_pred_type(object, "linear_pred") if (inherits(object$fit, "try-error")) { - rlang::warn("Model fit failed; cannot make predictions.") + cli::cli_warn("Model fit failed; cannot make predictions.") return(NULL) } diff --git a/R/predict_quantile.R b/R/predict_quantile.R index c2817e48b..b6b576316 100644 --- a/R/predict_quantile.R +++ b/R/predict_quantile.R @@ -16,7 +16,7 @@ predict_quantile.model_fit <- function(object, check_spec_pred_type(object, "quantile") if (inherits(object$fit, "try-error")) { - rlang::warn("Model fit failed; cannot make predictions.") + cli::cli_warn("Model fit failed; cannot make predictions.") return(NULL) } diff --git a/R/predict_raw.R b/R/predict_raw.R index cf391a063..02d24ffeb 100644 --- a/R/predict_raw.R +++ b/R/predict_raw.R @@ -16,7 +16,7 @@ predict_raw.model_fit <- function(object, new_data, opts = list(), ...) { check_spec_pred_type(object, "raw") if (inherits(object$fit, "try-error")) { - rlang::warn("Model fit failed; cannot make predictions.") + cli::cli_warn("Model fit failed; cannot make predictions.") return(NULL) } diff --git a/R/predict_survival.R b/R/predict_survival.R index 41447225a..9aa99e483 100644 --- a/R/predict_survival.R +++ b/R/predict_survival.R @@ -24,7 +24,7 @@ predict_survival.model_fit <- function(object, check_spec_pred_type(object, "survival") if (inherits(object$fit, "try-error")) { - rlang::warn("Model fit failed; cannot make predictions.") + cli::cli_warn("Model fit failed; cannot make predictions.") return(NULL) } diff --git a/R/survival-censoring-weights.R b/R/survival-censoring-weights.R index 49d33e905..60971c324 100644 --- a/R/survival-censoring-weights.R +++ b/R/survival-censoring-weights.R @@ -202,8 +202,7 @@ graf_weight_time_vec <- function(surv_obj, eval_time, eps = 10^-10) { .check_pred_col(predictions) if (!is.null(cens_predictors)) { - msg <- "The 'cens_predictors' argument to the survival weighting function is not currently used." - rlang::warn(msg) + cli::cli_warn("{.arg cens_predictors} is not currently used.") } predictions$.pred <- add_graf_weights_vec(object, diff --git a/tests/testthat/_snaps/decision_tree.md b/tests/testthat/_snaps/decision_tree.md index 0a6aa9dc2..8dfa9c7bb 100644 --- a/tests/testthat/_snaps/decision_tree.md +++ b/tests/testthat/_snaps/decision_tree.md @@ -38,3 +38,21 @@ unused argument (formula = y ~ x) +# argument checks for data dimensions + + Code + f_fit <- spec %>% fit(body_mass_g ~ ., data = penguins) + Condition + Warning: + ! 1000 samples were requested but there were 333 rows in the data. + i 333 will be used. + +--- + + Code + xy_fit <- spec %>% fit_xy(x = penguins[, -6], y = penguins$body_mass_g) + Condition + Warning: + ! 1000 samples were requested but there were 333 rows in the data. + i 333 will be used. + diff --git a/tests/testthat/_snaps/misc.md b/tests/testthat/_snaps/misc.md index 1a8e6733e..c82edc8f5 100644 --- a/tests/testthat/_snaps/misc.md +++ b/tests/testthat/_snaps/misc.md @@ -6,6 +6,14 @@ Error in `multi_predict()`: ! No `multi_predict()` method exists for objects with classes <_lm/model_fit>. +--- + + Code + multi_predict(extract_fit_engine(mars_fit), mtcars) + Condition + Error in `multi_predict()`: + ! No `multi_predict()` method exists for objects with classes . + # combine_words helper works Code diff --git a/tests/testthat/_snaps/nearest_neighbor_kknn.md b/tests/testthat/_snaps/nearest_neighbor_kknn.md new file mode 100644 index 000000000..774fd3582 --- /dev/null +++ b/tests/testthat/_snaps/nearest_neighbor_kknn.md @@ -0,0 +1,18 @@ +# argument checks for data dimensions + + Code + f_fit <- spec %>% fit(body_mass_g ~ ., data = penguins) + Condition + Warning: + ! 1000 samples were requested but there were 333 rows in the data. + i 328 will be used. + +--- + + Code + xy_fit <- spec %>% fit_xy(x = penguins[, -6], y = penguins$body_mass_g) + Condition + Warning: + ! 1000 samples were requested but there were 333 rows in the data. + i 328 will be used. + diff --git a/tests/testthat/_snaps/rand_forest_ranger.md b/tests/testthat/_snaps/rand_forest_ranger.md index cbc017269..b99e6ba25 100644 --- a/tests/testthat/_snaps/rand_forest_ranger.md +++ b/tests/testthat/_snaps/rand_forest_ranger.md @@ -26,9 +26,11 @@ f_fit <- spec %>% fit(body_mass_g ~ ., data = penguins) Condition Warning: - 1000 columns were requested but there were 6 predictors in the data. 6 will be used. + ! 1000 columns were requested but there were 6 predictors in the data. + i 6 will be used. Warning: - 1000 samples were requested but there were 333 rows in the data. 333 will be used. + ! 1000 samples were requested but there were 333 rows in the data. + i 333 will be used. --- @@ -36,7 +38,9 @@ xy_fit <- spec %>% fit_xy(x = penguins[, -6], y = penguins$body_mass_g) Condition Warning: - 1000 columns were requested but there were 6 predictors in the data. 6 will be used. + ! 1000 columns were requested but there were 6 predictors in the data. + i 6 will be used. Warning: - 1000 samples were requested but there were 333 rows in the data. 333 will be used. + ! 1000 samples were requested but there were 333 rows in the data. + i 333 will be used. diff --git a/tests/testthat/test-decision_tree.R b/tests/testthat/test-decision_tree.R index 85dd3ac1f..150d67457 100644 --- a/tests/testthat/test-decision_tree.R +++ b/tests/testthat/test-decision_tree.R @@ -48,13 +48,11 @@ test_that('argument checks for data dimensions', { set_engine("rpart") %>% set_mode("regression") - expect_warning( - f_fit <- spec %>% fit(body_mass_g ~ ., data = penguins), - "1000 samples were requested but there were 333 rows in the data. 333 will be used." + expect_snapshot( + f_fit <- spec %>% fit(body_mass_g ~ ., data = penguins) ) - expect_warning( - xy_fit <- spec %>% fit_xy(x = penguins[, -6], y = penguins$body_mass_g), - "1000 samples were requested but there were 333 rows in the data. 333 will be used." + expect_snapshot( + xy_fit <- spec %>% fit_xy(x = penguins[, -6], y = penguins$body_mass_g) ) expect_equal(extract_fit_engine(f_fit)$control$minsplit, nrow(penguins)) diff --git a/tests/testthat/test-nearest_neighbor_kknn.R b/tests/testthat/test-nearest_neighbor_kknn.R index 00fb5356e..b11212fd9 100644 --- a/tests/testthat/test-nearest_neighbor_kknn.R +++ b/tests/testthat/test-nearest_neighbor_kknn.R @@ -199,14 +199,12 @@ test_that('argument checks for data dimensions', { set_engine("kknn") %>% set_mode("regression") - expect_warning( - f_fit <- spec %>% fit(body_mass_g ~ ., data = penguins), - "1000 samples were requested but there were 333 rows in the data. 328 will be used." + expect_snapshot( + f_fit <- spec %>% fit(body_mass_g ~ ., data = penguins) ) - expect_warning( - xy_fit <- spec %>% fit_xy(x = penguins[, -6], y = penguins$body_mass_g), - "1000 samples were requested but there were 333 rows in the data. 328 will be used." + expect_snapshot( + xy_fit <- spec %>% fit_xy(x = penguins[, -6], y = penguins$body_mass_g) ) expect_equal(extract_fit_engine(f_fit)$best.parameters$k, nrow(penguins) - 5) From 48721b7a1897f1e84591071a7af1899f8019ddeb Mon Sep 17 00:00:00 2001 From: simonpcouch Date: Wed, 28 Aug 2024 11:28:17 -0500 Subject: [PATCH 03/11] add issue ref to NEWS entry --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index e56d8ed75..b1fba0e58 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,7 +2,7 @@ * Transitioned package errors and warnings to use cli (#1147 and #1148 by @shum461, #1153 by @RobLBaker and @wright13, #1154 by @JamesHWade, #1160, - #1161). + #1161, #1081). * `fit_xy()` currently raises an error for `gen_additive_mod()` model specifications as the default engine (`"mgcv"`) specifies smoothing terms in model formulas. However, some engines specify smooths via additional arguments, in which case the restriction on `fit_xy()` is excessive. parsnip will now only raise an error when fitting a `gen_additive_mod()` with `fit_xy()` when using the `"mgcv"` engine (#775). From 971be456c3baf53c0f07fbc97b143adb841f3b1f Mon Sep 17 00:00:00 2001 From: simonpcouch Date: Wed, 28 Aug 2024 11:39:25 -0500 Subject: [PATCH 04/11] remove new argument from exported function --- R/convert_data.R | 5 ++--- tests/testthat/_snaps/convert_data.md | 4 ++-- 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/R/convert_data.R b/R/convert_data.R index 3ba1ca59f..eecb6e0b8 100644 --- a/R/convert_data.R +++ b/R/convert_data.R @@ -367,7 +367,7 @@ check_dup_names <- function(x, y, call = rlang::caller_env()) { #' @param x A data frame, matrix, or sparse matrix. #' @return A data frame, matrix, or sparse matrix. #' @export -maybe_matrix <- function(x, call = rlang::caller_env()) { +maybe_matrix <- function(x) { inher(x, c("data.frame", "matrix", "dgCMatrix"), cl = match.call()) if (is.data.frame(x)) { non_num_cols <- vapply(x, function(x) !is.numeric(x), logical(1)) @@ -376,8 +376,7 @@ maybe_matrix <- function(x, call = rlang::caller_env()) { cli::cli_abort( "The column{?s} {.val {non_num_cols}} {?is/are} non-numeric, so the - data cannot be converted to a numeric matrix.", - call = call + data cannot be converted to a numeric matrix." ) } x <- as.matrix(x) diff --git a/tests/testthat/_snaps/convert_data.md b/tests/testthat/_snaps/convert_data.md index ed00a590f..eca0e514a 100644 --- a/tests/testthat/_snaps/convert_data.md +++ b/tests/testthat/_snaps/convert_data.md @@ -3,7 +3,7 @@ Code parsnip::maybe_matrix(ames[, c("Year_Built", "Neighborhood")]) Condition - Error: + Error in `parsnip::maybe_matrix()`: ! The column "Neighborhood" is non-numeric, so the data cannot be converted to a numeric matrix. --- @@ -11,6 +11,6 @@ Code parsnip::maybe_matrix(Chicago[, c("ridership", "date")]) Condition - Error: + Error in `parsnip::maybe_matrix()`: ! The column "date" is non-numeric, so the data cannot be converted to a numeric matrix. From d27308e5fb5b7a175c599e5eb8f73db0f32deaa0 Mon Sep 17 00:00:00 2001 From: topepo Date: Wed, 28 Aug 2024 13:18:23 -0400 Subject: [PATCH 05/11] move from rlang to cli error function --- R/standalone-survival.R | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/R/standalone-survival.R b/R/standalone-survival.R index ab1033171..311d948e1 100644 --- a/R/standalone-survival.R +++ b/R/standalone-survival.R @@ -9,6 +9,9 @@ # # ## Changelog +# 2024-08-28 +# * .check_cens_type() and .is_surv now use cli error formats. +# # 2024-01-10 # * .filter_eval_time() gives more informative warning. # @@ -68,7 +71,7 @@ obj_type <- .extract_surv_type(surv) good_type <- all(obj_type %in% type) if (!good_type && fail) { - rlang::abort( + cli::cli_abort( "For this usage, the allowed censoring type{?s} {?is/are} {.or {type}}.", call = call ) From 6baabebbfdf31cd655cfdcdc67411e865ffdb67d Mon Sep 17 00:00:00 2001 From: simonpcouch Date: Wed, 28 Aug 2024 13:32:54 -0500 Subject: [PATCH 06/11] format censoring types in error message --- R/standalone-survival.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/standalone-survival.R b/R/standalone-survival.R index 311d948e1..399e2e11c 100644 --- a/R/standalone-survival.R +++ b/R/standalone-survival.R @@ -72,7 +72,8 @@ good_type <- all(obj_type %in% type) if (!good_type && fail) { cli::cli_abort( - "For this usage, the allowed censoring type{?s} {?is/are} {.or {type}}.", + "For this usage, the allowed censoring + type{?s} {?is/are} {.or {.val {type}}}.", call = call ) } From 40bc5e30591fa8ba4a2e95215648746da181ed08 Mon Sep 17 00:00:00 2001 From: topepo Date: Wed, 28 Aug 2024 15:25:23 -0400 Subject: [PATCH 07/11] version bump for extratests --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 6dbb2399e..1022732ec 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: parsnip Title: A Common API to Modeling and Analysis Functions -Version: 1.2.1.9001 +Version: 1.2.1.9002 Authors@R: c( person("Max", "Kuhn", , "max@posit.co", role = c("aut", "cre")), person("Davis", "Vaughan", , "davis@posit.co", role = "aut"), From bf6aa1134d5c01e93bc4db101ea333c3d49e8889 Mon Sep 17 00:00:00 2001 From: "Simon P. Couch" Date: Wed, 28 Aug 2024 15:17:45 -0500 Subject: [PATCH 08/11] apply suggestions from code review Co-authored-by: Emil Hvitfeldt --- R/arguments.R | 6 +++--- R/autoplot.R | 2 +- R/convert_data.R | 2 +- R/fit_helpers.R | 2 +- R/repair_call.R | 2 +- R/survival-censoring-weights.R | 6 +++--- 6 files changed, 10 insertions(+), 10 deletions(-) diff --git a/R/arguments.R b/R/arguments.R index e33bb072a..233cbe4e8 100644 --- a/R/arguments.R +++ b/R/arguments.R @@ -320,9 +320,9 @@ min_cols <- function(num_cols, source) { if (num_cols > p) { cli::cli_warn( c( - "!" = "{num_cols} column{?s} {?was/were} requested but there were - {p} predictors in the data.", - "i" = "{p} will be used." + "!" = "{num_cols} column{?s} {?was/were} requested but there {cli::qty(p)} {?was/were} + {p} predictor{?s} in the data.", + "i" = "{p} predictor{?s} will be used." ) ) num_cols <- p diff --git a/R/autoplot.R b/R/autoplot.R index 823dd62f1..785f0a5e4 100644 --- a/R/autoplot.R +++ b/R/autoplot.R @@ -45,7 +45,7 @@ map_glmnet_coefs <- function(x) { # package. if (is.null(coefs)) { cli::cli_abort( - "Please load the glmnet package before running {.fun autoplot}." + "Please load the {.pkg glmnet} package before running {.fun autoplot}." ) } p <- x$dim[1] diff --git a/R/convert_data.R b/R/convert_data.R index eecb6e0b8..13d0c3f2c 100644 --- a/R/convert_data.R +++ b/R/convert_data.R @@ -258,7 +258,7 @@ cli::cli_abort("{.arg weights} must be a numeric vector.") } if (length(weights) != nrow(x)) { - cli::cli_abort("{.arg weights} should have {nrow(x)} elements") + cli::cli_abort("{.arg weights} should have {nrow(x)} elements.") } form <- patch_formula_environment_with_case_weights( diff --git a/R/fit_helpers.R b/R/fit_helpers.R index 2af4c1945..625162771 100644 --- a/R/fit_helpers.R +++ b/R/fit_helpers.R @@ -68,7 +68,7 @@ xy_xy <- function(object, if (inherits(env$x, "tbl_spark") | inherits(env$y, "tbl_spark")) { cli::cli_abort( - "spark objects can only be used with the formula interface to {.fun fit}", + "spark objects can only be used with the formula interface to {.fun fit}.", call = call ) } diff --git a/R/repair_call.R b/R/repair_call.R index 8b22b2164..318f66dd8 100644 --- a/R/repair_call.R +++ b/R/repair_call.R @@ -30,7 +30,7 @@ repair_call <- function(x, data) { cl <- match.call() if (!any(names(x$fit) == "call")) { - cli::cli_abort("No `call` object to modify.") + cli::cli_abort("No {.field call} object to modify.") } if (rlang::is_missing(data)) { cli::cli_abort("Please supply a data object to {.arg data}.") diff --git a/R/survival-censoring-weights.R b/R/survival-censoring-weights.R index 60971c324..08bea6ad6 100644 --- a/R/survival-censoring-weights.R +++ b/R/survival-censoring-weights.R @@ -37,7 +37,7 @@ trunc_probs <- function(probs, trunc = 0.01) { req_cols <- c(".eval_time", ".pred_survival") if (!all(req_cols %in% names(x$.pred[[1]]))) { cli::cli_abort( - "The `.pred` tibbles should have columns {.val req_cols}.", + "The {.field .pred} tibbles should have columns {.val req_cols}.", call = call ) } @@ -47,7 +47,7 @@ trunc_probs <- function(probs, trunc = 0.01) { .check_censor_model <- function(x, call = rlang::caller_env()) { if (x$spec$mode != "censored regression") { cli::cli_abort( - "The model needs to be for mode 'censored regression', not for mode '{x$spec$mode}'.", + "The model needs to be for mode {.val censored regression}, not for mode '{x$spec$mode}'.", call = call ) } @@ -184,7 +184,7 @@ graf_weight_time_vec <- function(surv_obj, eval_time, eps = 10^-10) { #' @rdname censoring_weights .censoring_weights_graf.default <- function(object, ...) { cli::cli_abort( - "There is no `.censoring_weights_graf()` method for objects with class{?es} + "There is no {.fun .censoring_weights_graf} method for objects with class{?es} {.cls {class(object)}}." ) } From cc98613351b8fb5a118cf8ab85ccb2bca85133a0 Mon Sep 17 00:00:00 2001 From: "Simon P. Couch" Date: Wed, 28 Aug 2024 15:18:58 -0500 Subject: [PATCH 09/11] apply suggestions from code review --- R/arguments.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/arguments.R b/R/arguments.R index 233cbe4e8..ad1033270 100644 --- a/R/arguments.R +++ b/R/arguments.R @@ -345,7 +345,7 @@ min_rows <- function(num_rows, source, offset = 0) { c( "!" = "{num_rows} sample{?s} {?was/were} requested but there were {n} rows in the data.", - "i" = "{n - offset} will be used." + "i" = "{n - offset} sample{?s} will be used." ) ) From 2134129a0361ff0766000a074245f6e0a96285f4 Mon Sep 17 00:00:00 2001 From: simonpcouch Date: Wed, 28 Aug 2024 15:32:45 -0500 Subject: [PATCH 10/11] apply more involved suggestions and update snaps --- R/augment.R | 7 ++++++- R/convert_data.R | 5 ++++- R/predict.R | 2 +- tests/testthat/_snaps/augment.md | 9 +++++++++ tests/testthat/_snaps/rand_forest_ranger.md | 4 ++-- tests/testthat/test-augment.R | 5 ++++- 6 files changed, 26 insertions(+), 6 deletions(-) create mode 100644 tests/testthat/_snaps/augment.md diff --git a/R/augment.R b/R/augment.R index 8220414d0..17af1dd78 100644 --- a/R/augment.R +++ b/R/augment.R @@ -86,7 +86,12 @@ augment.model_fit <- function(x, new_data, eval_time = NULL, ...) { "regression" = augment_regression(x, new_data), "classification" = augment_classification(x, new_data), "censored regression" = augment_censored(x, new_data, eval_time = eval_time), - cli::cli_abort("Unknown mode: {x$spec$mode}.") + cli::cli_abort( + c( + "Unknown mode {.val {x$spec$mode}}.", + "i" = "Model mode should be one of {.or {.val {all_modes}}}." + ) + ) ) tibble::new_tibble(res) } diff --git a/R/convert_data.R b/R/convert_data.R index 13d0c3f2c..a854502cd 100644 --- a/R/convert_data.R +++ b/R/convert_data.R @@ -350,7 +350,10 @@ check_dup_names <- function(x, y, call = rlang::caller_env()) { common_names <- intersect(colnames(x), colnames(y)) if (length(common_names) > 0) { cli::cli_abort( - "{.arg x} and {.arg y} have the name{?s} {.val {common_names}} in common.", + c( + "{.arg x} and {.arg y} have the name{?s} {.val {common_names}} in common.", + "i" = "Please ensure that {.arg x} and {.arg y} don't share any column names." + ), call = call ) } diff --git a/R/predict.R b/R/predict.R index e2a7545f2..7a307c201 100644 --- a/R/predict.R +++ b/R/predict.R @@ -207,7 +207,7 @@ check_pred_type <- function(object, type, ..., call = rlang::caller_env()) { } if (!(type %in% pred_types)) cli::cli_abort( - "{.arg type} should be one of:{.arg {pred_types}}", + "{.arg type} should be one of {.or {.arg {pred_types}}}.", call = call ) diff --git a/tests/testthat/_snaps/augment.md b/tests/testthat/_snaps/augment.md new file mode 100644 index 000000000..1e73b011e --- /dev/null +++ b/tests/testthat/_snaps/augment.md @@ -0,0 +1,9 @@ +# regression models + + Code + augment(reg_form, head(mtcars[, -1])) + Condition + Error in `augment()`: + ! Unknown mode "depeche". + i Model mode should be one of "classification", "regression", or "censored regression". + diff --git a/tests/testthat/_snaps/rand_forest_ranger.md b/tests/testthat/_snaps/rand_forest_ranger.md index b99e6ba25..66ad1d390 100644 --- a/tests/testthat/_snaps/rand_forest_ranger.md +++ b/tests/testthat/_snaps/rand_forest_ranger.md @@ -27,7 +27,7 @@ Condition Warning: ! 1000 columns were requested but there were 6 predictors in the data. - i 6 will be used. + i 6 predictors will be used. Warning: ! 1000 samples were requested but there were 333 rows in the data. i 333 will be used. @@ -39,7 +39,7 @@ Condition Warning: ! 1000 columns were requested but there were 6 predictors in the data. - i 6 will be used. + i 6 predictors will be used. Warning: ! 1000 samples were requested but there were 333 rows in the data. i 333 will be used. diff --git a/tests/testthat/test-augment.R b/tests/testthat/test-augment.R index 49b7fab09..9c4c93d58 100644 --- a/tests/testthat/test-augment.R +++ b/tests/testthat/test-augment.R @@ -38,7 +38,10 @@ test_that('regression models', { reg_form$spec$mode <- "depeche" - expect_error(augment(reg_form, head(mtcars[, -1])), "Unknown mode: depeche") + expect_snapshot( + error = TRUE, + augment(reg_form, head(mtcars[, -1])) + ) }) From 5bcf0bef3d71c4515ef8334a6f3d2c6c6100d5a0 Mon Sep 17 00:00:00 2001 From: simonpcouch Date: Wed, 28 Aug 2024 15:50:00 -0500 Subject: [PATCH 11/11] update more snaps --- tests/testthat/_snaps/decision_tree.md | 4 ++-- tests/testthat/_snaps/nearest_neighbor_kknn.md | 4 ++-- tests/testthat/_snaps/rand_forest_ranger.md | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/tests/testthat/_snaps/decision_tree.md b/tests/testthat/_snaps/decision_tree.md index 8dfa9c7bb..41bc8ae1a 100644 --- a/tests/testthat/_snaps/decision_tree.md +++ b/tests/testthat/_snaps/decision_tree.md @@ -45,7 +45,7 @@ Condition Warning: ! 1000 samples were requested but there were 333 rows in the data. - i 333 will be used. + i 333 samples will be used. --- @@ -54,5 +54,5 @@ Condition Warning: ! 1000 samples were requested but there were 333 rows in the data. - i 333 will be used. + i 333 samples will be used. diff --git a/tests/testthat/_snaps/nearest_neighbor_kknn.md b/tests/testthat/_snaps/nearest_neighbor_kknn.md index 774fd3582..0366b1dab 100644 --- a/tests/testthat/_snaps/nearest_neighbor_kknn.md +++ b/tests/testthat/_snaps/nearest_neighbor_kknn.md @@ -5,7 +5,7 @@ Condition Warning: ! 1000 samples were requested but there were 333 rows in the data. - i 328 will be used. + i 328 samples will be used. --- @@ -14,5 +14,5 @@ Condition Warning: ! 1000 samples were requested but there were 333 rows in the data. - i 328 will be used. + i 328 samples will be used. diff --git a/tests/testthat/_snaps/rand_forest_ranger.md b/tests/testthat/_snaps/rand_forest_ranger.md index 66ad1d390..128e4e275 100644 --- a/tests/testthat/_snaps/rand_forest_ranger.md +++ b/tests/testthat/_snaps/rand_forest_ranger.md @@ -30,7 +30,7 @@ i 6 predictors will be used. Warning: ! 1000 samples were requested but there were 333 rows in the data. - i 333 will be used. + i 333 samples will be used. --- @@ -42,5 +42,5 @@ i 6 predictors will be used. Warning: ! 1000 samples were requested but there were 333 rows in the data. - i 333 will be used. + i 333 samples will be used.