diff --git a/R/bart.R b/R/bart.R index 0251680b7..0070f702e 100644 --- a/R/bart.R +++ b/R/bart.R @@ -142,7 +142,9 @@ update.bart <- #' @param std_err Attach column for standard error of prediction or not. bartMachine_interval_calc <- function(new_data, obj, ci = TRUE, level = 0.95) { if (obj$spec$mode == "classification") { - rlang::abort("In bartMachine: Prediction intervals are not possible for classification") + cli::cli_abort( + "Prediction intervals are not possible for classification" + ) } get_std_err <- obj$spec$method$pred$pred_int$extras$std_error diff --git a/R/boost_tree.R b/R/boost_tree.R index 799afee1e..0d4a17e5c 100644 --- a/R/boost_tree.R +++ b/R/boost_tree.R @@ -134,11 +134,9 @@ translate.boost_tree <- function(x, engine = x$engine, ...) { if (engine == "spark") { if (x$mode == "unknown") { - rlang::abort( - glue::glue( - "For spark boosted trees models, the mode cannot be 'unknown' ", - "if the specification is to be translated." - ) + cli::cli_abort( + "For spark boosted tree models, the mode cannot be {.val unknown} + if the specification is to be translated." ) } else { arg_vals$type <- x$mode @@ -172,7 +170,7 @@ check_args.boost_tree <- function(object, call = rlang::caller_env()) { check_number_decimal(args$sample_size, min = 0, max = 1, allow_null = TRUE, call = call, arg = "sample_size") check_number_whole(args$tree_depth, min = 0, allow_null = TRUE, call = call, arg = "tree_depth") check_number_whole(args$min_n, min = 0, allow_null = TRUE, call = call, arg = "min_n") - + invisible(object) } @@ -229,15 +227,15 @@ xgb_train <- function( num_class <- length(levels(y)) if (!is.numeric(validation) || validation < 0 || validation >= 1) { - rlang::abort("`validation` should be on [0, 1).") + cli::cli_abort("{.arg validation} should be on [0, 1).") } if (!is.null(early_stop)) { if (early_stop <= 1) { - rlang::abort(paste0("`early_stop` should be on [2, ", nrounds, ").")) + cli::cli_abort("{.arg early_stop} should be on [2, {nrounds}).") } else if (early_stop >= nrounds) { early_stop <- nrounds - 1 - rlang::warn(paste0("`early_stop` was reduced to ", early_stop, ".")) + cli::cli_warn("{.arg early_stop} was reduced to {early_stop}.") } } @@ -252,7 +250,7 @@ xgb_train <- function( if (!is.numeric(subsample) || subsample < 0 || subsample > 1) { - rlang::abort("`subsample` should be on [0, 1].") + cli::cli_abort("{.arg subsample} should be on [0, 1].") } # initialize @@ -268,9 +266,13 @@ xgb_train <- function( } if (min_child_weight > n) { - msg <- paste0(min_child_weight, " samples were requested but there were ", - n, " rows in the data. ", n, " will be used.") - rlang::warn(msg) + cli::cli_warn( + c( + "!" = "{min_child_weight} samples were requested but there were {n} rows + in the data.", + "i" = "{n} will be used." + ) + ) min_child_weight <- min(min_child_weight, n) } @@ -369,14 +371,16 @@ recalc_param <- function(x, counts, denom) { x } -maybe_proportion <- function(x, nm) { +maybe_proportion <- function(x, nm, call = rlang::caller_env()) { if (x < 1) { - msg <- paste0( - "The option `counts = TRUE` was used but parameter `", nm, - "` was given as ", signif(x, 3), ". Please use a value >= 1 or use ", - "`counts = FALSE`." + cli::cli_abort( + c( + "The option `counts = TRUE` was used but {.arg {nm}} was given + as {signif(x, 3)}.", + "i" = "Please use a value >= 1 or use {.code counts = FALSE}." + ), + call = call ) - rlang::abort(msg) } } @@ -418,7 +422,9 @@ as_xgb_data <- function(x, y, validation = 0, weights = NULL, event_level = "fir y <- as.numeric(y) - 1 } } else { - if (event_level == "second") rlang::warn("`event_level` can only be set for binary variables.") + if (event_level == "second") { + cli::cli_warn("{.arg event_level} can only be set for binary outcomes.") + } y <- as.numeric(y) - 1 } } @@ -573,15 +579,19 @@ C5.0_train <- n <- nrow(x) if (n == 0) { - rlang::abort("There are zero rows in the predictor set.") + cli::cli_abort("There are zero rows in the predictor set.") } ctrl <- call2("C5.0Control", .ns = "C50") if (minCases > n) { - msg <- paste0(minCases, " samples were requested but there were ", - n, " rows in the data. ", n, " will be used.") - rlang::warn(msg) + + cli::cli_warn( + c( + "!" = "{minCases} samples were requested but there were {n} rows in the data.", + "i" = "{n} will be used." + ) + ) minCases <- n } ctrl$minCases <- minCases diff --git a/R/decision_tree.R b/R/decision_tree.R index 8266fe806..33c5570a7 100644 --- a/R/decision_tree.R +++ b/R/decision_tree.R @@ -97,11 +97,9 @@ translate.decision_tree <- function(x, engine = x$engine, ...) { if (x$engine == "spark") { if (x$mode == "unknown") { - rlang::abort( - glue::glue( - "For spark decision tree models, the mode cannot be 'unknown' ", - "if the specification is to be translated." - ) + cli::cli_abort( + "For spark decision tree models, the mode cannot be {.val unknown} + if the specification is to be translated." ) } } diff --git a/tests/testthat/_snaps/boost_tree_xgboost.md b/tests/testthat/_snaps/boost_tree_xgboost.md index 5c7876f92..32e9c4337 100644 --- a/tests/testthat/_snaps/boost_tree_xgboost.md +++ b/tests/testthat/_snaps/boost_tree_xgboost.md @@ -6,6 +6,14 @@ Error in `multi_predict()`: ! Please use `new_data` instead of `newdata`. +# xgboost data conversion + + Code + from_df <- parsnip:::as_xgb_data(mtcar_x, mtcars_y, event_level = "second") + Condition + Warning: + `event_level` can only be set for binary outcomes. + # interface to param arguments ! Please supply elements of the `params` list argument as main arguments to `set_engine()` rather than as part of `params`. diff --git a/tests/testthat/test-boost_tree_xgboost.R b/tests/testthat/test-boost_tree_xgboost.R index 26d20a6e2..6b291c178 100644 --- a/tests/testthat/test-boost_tree_xgboost.R +++ b/tests/testthat/test-boost_tree_xgboost.R @@ -416,8 +416,9 @@ test_that('xgboost data conversion', { expect_equal(xgboost::getinfo(from_df$data, name = "label")[1:5], rep(1, 5)) mtcars_y <- factor(mtcars$mpg < 15, levels = c(TRUE, FALSE, "na"), labels = c("low", "high", "missing")) - expect_warning(from_df <- parsnip:::as_xgb_data(mtcar_x, mtcars_y, event_level = "second"), - regexp = "`event_level` can only be set for binary variables.") + expect_snapshot( + from_df <- parsnip:::as_xgb_data(mtcar_x, mtcars_y, event_level = "second") + ) # case weights added expect_error(wted <- parsnip:::as_xgb_data(mtcar_x, mtcars$mpg, weights = wts), regexp = NA)