diff --git a/R/grids.R b/R/grids.R
index e2e89d56..9f9a28ea 100644
--- a/R/grids.R
+++ b/R/grids.R
@@ -130,8 +130,8 @@ make_regular_grid <- function(...,
# check levels
p <- length(levels)
if (p > 1 && p != length(param_quos)) {
- rlang::abort(
- paste0("`levels` should have length 1 or ", length(param_quos)),
+ cli::cli_abort(
+ "{.arg levels} should have length 1 or {length(param_quos)}, not {p}.",
call = call
)
}
@@ -142,8 +142,9 @@ make_regular_grid <- function(...,
if (all(rlang::has_name(levels, names(params)))) {
levels <- levels[names(params)]
} else if (any(rlang::has_name(levels, names(params)))) {
- rlang::abort(
- "Elements of `levels` should either be all named or unnamed, not mixed.",
+ cli::cli_abort(
+ "Elements of {.arg levels} should either be all named or unnamed,
+ not mixed.",
call = call
)
}
@@ -156,7 +157,7 @@ make_regular_grid <- function(...,
parameters <- dplyr::filter(parameters, !!filter_quo)
}
- new_param_grid(parameters)
+ new_param_grid(parameters, call = call)
}
# ------------------------------------------------------------------------------
@@ -245,14 +246,16 @@ make_random_grid <- function(...,
parameters <- dplyr::filter(parameters, !!filter_quo)
}
- new_param_grid(parameters)
+ new_param_grid(parameters, call = call)
}
# ------------------------------------------------------------------------------
-new_param_grid <- function(x = new_data_frame()) {
+new_param_grid <- function(x = new_data_frame(), call = caller_env()) {
if (!is.data.frame(x)) {
- rlang::abort("`x` must be a data frame to construct a new grid from.")
+ cli::cli_abort(
+ "{.arg x} must be a data frame to construct a new grid from."
+ )
}
x <- vctrs::vec_unique(x)
diff --git a/R/misc.R b/R/misc.R
index 5aa118bc..86c54923 100644
--- a/R/misc.R
+++ b/R/misc.R
@@ -70,20 +70,21 @@ check_range <- function(x, type, trans, ..., call = caller_env()) {
whole <-
purrr::map_lgl(x0[known], ~ abs(.x - round(.x)) < .Machine$double.eps^0.5)
if (!all(whole)) {
- msg <- paste(x0[known][!whole], collapse = ", ")
- msg <- paste0(
- "An integer is required for the range and these do not appear to be ",
- "whole numbers: ", msg
+ offenders <- x0[known][!whole]
+ cli::cli_abort(
+ "An integer is required for the range and these do not appear to be
+ whole numbers: {offenders}.",
+ call = call
)
- rlang::abort(msg, call = call)
}
x0[known] <- as.integer(x0[known])
} else {
- msg <- paste0(
- "Since `type = '", type, "'`, please use that data type for the range."
+ cli::cli_abort(
+ "Since {.code type = \"{type}\"}, please use that data type for the
+ range.",
+ call = call
)
- rlang::abort(msg, call = call)
}
}
invisible(x0)
@@ -97,13 +98,13 @@ check_values_quant <- function(x, ..., call = caller_env()) {
}
if (!is.numeric(x)) {
- rlang::abort("`values` must be numeric.", call = call)
+ cli::cli_abort("{.arg values} must be numeric.", call = call)
}
if (anyNA(x)) {
- rlang::abort("`values` can't be `NA`.", call = call)
+ cli::cli_abort("{.arg values} can't be {.code NA}.", call = call)
}
if (length(x) == 0) {
- rlang::abort("`values` can't be empty.", call = call)
+ cli::cli_abort("{.arg values} can't be empty.", call = call)
}
invisible(x)
diff --git a/R/parameters.R b/R/parameters.R
index befc8ac4..725f9417 100644
--- a/R/parameters.R
+++ b/R/parameters.R
@@ -12,11 +12,8 @@ parameters <- function(x, ...) {
#' @export
#' @rdname parameters
parameters.default <- function(x, ...) {
- rlang::abort(
- glue(
- "`parameters` objects cannot be created from objects ",
- "of class `{class(x)[1]}`."
- )
+ cli::cli_abort(
+ "{.cls parameters} objects cannot be created from {.obj_type_friendly {x}}."
)
}
@@ -34,7 +31,7 @@ parameters.param <- function(x, ...) {
parameters.list <- function(x, ...) {
elem_param <- purrr::map_lgl(x, inherits, "param")
if (any(!elem_param)) {
- rlang::abort("The objects should all be `param` objects.")
+ cli::cli_abort("The objects should all be {.cls param} objects.")
}
elem_name <- purrr::map_chr(x, ~ names(.x$label))
elem_id <- names(x)
@@ -61,12 +58,14 @@ unique_check <- function(x, ..., call = caller_env()) {
if (any(is_dup)) {
dup_list <- x2[is_dup]
cl <- match.call()
- msg <- paste0(
- "Element `", deparse(cl$x), "` should have unique values. Duplicates exist ",
- "for item(s): ",
- paste0("'", dup_list, "'", collapse = ", ")
+
+ cli::cli_abort(
+ c(
+ x = "Element {.field {deparse(cl$x)}} should have unique values.",
+ i = "Duplicates exist for {cli::qty(dup_list)} item{?s}: {dup_list}"
+ ),
+ call = call
)
- rlang::abort(msg, call = call)
}
invisible(TRUE)
}
@@ -78,16 +77,18 @@ param_or_na <- function(x) {
check_list_of_param <- function(x, ..., call = caller_env()) {
check_dots_empty()
if (!is.list(x)) {
- abort("`object` must be a list of `param` objects.", call = call)
+ cli::cli_abort(
+ "{.arg object} must be a list of {.cls param} objects.",
+ call = call
+ )
}
is_good_boi <- map_lgl(x, param_or_na)
if (any(!is_good_boi)) {
- rlang::abort(
- paste0(
- "`object` elements in the following positions must be `NA` or a ",
- "`param` object:",
- paste0(which(!is_good_boi), collapse = ", ")
- ),
+ offenders <- which(!is_good_boi)
+
+ cli::cli_abort(
+ "{.arg object} elements in the following positions must be {.code NA} or a
+ {.cls param} object: {offenders}.",
call = call
)
}
@@ -99,7 +100,7 @@ check_list_of_param <- function(x, ..., call = caller_env()) {
#' length.
#' @param object A list of `param` objects or NA values.
#' @inheritParams rlang::args_dots_empty
-#' @param call The call passed on to [rlang::abort()].
+#' @param call The call passed on to [cli::cli_abort()].
#'
#' @return A tibble that encapsulates the input vectors into a tibble with an
#' additional class of "parameters".
@@ -129,7 +130,7 @@ parameters_constr <- function(name,
)
n_elements_unique <- unique(n_elements)
if (length(n_elements_unique) > 1) {
- abort(
+ cli::cli_abort(
"All inputs must contain contain the same number of elements.",
call = call
)
@@ -261,21 +262,21 @@ print.parameters <- function(x, ...) {
update.parameters <- function(object, ...) {
args <- rlang::list2(...)
if (length(args) == 0) {
- rlang::abort("Please supply at least one parameter object.")
+ cli::cli_abort("Please supply at least one parameter object.")
}
nms <- names(args)
if (length(nms) == 0 || any(nms == "")) {
- rlang::abort("All arguments should be named.")
+ cli::cli_abort("All arguments should be named.")
}
in_set <- nms %in% object$id
if (!all(in_set)) {
- msg <- paste0("'", nms[!in_set], "'", collapse = ", ")
- msg <- paste(
- "At least one parameter does not match any id's in the set:",
- msg
+ offenders <- nms[!in_set]
+
+ cli::cli_abort(
+ "At least one parameter does not match any id's in the set:
+ {offenders}."
)
- rlang::abort(msg)
}
not_param <- !purrr::map_lgl(args, inherits, "param")
not_null <- !purrr::map_lgl(args, ~ all(is.na(.x)))
diff --git a/R/space_filling.R b/R/space_filling.R
index 79c46e0a..85f2105e 100644
--- a/R/space_filling.R
+++ b/R/space_filling.R
@@ -235,7 +235,7 @@ make_sfd <- function(...,
)
}
- new_param_grid(grid)
+ new_param_grid(grid, call = call)
}
base_recycle <- function(x, size) {
diff --git a/man/parameters_constr.Rd b/man/parameters_constr.Rd
index d397cd98..ddab9065 100644
--- a/man/parameters_constr.Rd
+++ b/man/parameters_constr.Rd
@@ -23,7 +23,7 @@ length.}
\item{...}{These dots are for future extensions and must be empty.}
-\item{call}{The call passed on to \code{\link[rlang:abort]{rlang::abort()}}.}
+\item{call}{The call passed on to \code{\link[cli:cli_abort]{cli::cli_abort()}}.}
}
\value{
A tibble that encapsulates the input vectors into a tibble with an
diff --git a/tests/testthat/_snaps/constructors.md b/tests/testthat/_snaps/constructors.md
index 0537486f..9fbdae33 100644
--- a/tests/testthat/_snaps/constructors.md
+++ b/tests/testthat/_snaps/constructors.md
@@ -170,7 +170,7 @@
mixture(c(1L, 3L))
Condition
Error in `mixture()`:
- ! Since `type = 'double'`, please use that data type for the range.
+ ! Since `type = "double"`, please use that data type for the range.
---
@@ -178,7 +178,7 @@
mixture(c(1L, unknown()))
Condition
Error in `mixture()`:
- ! Since `type = 'double'`, please use that data type for the range.
+ ! Since `type = "double"`, please use that data type for the range.
---
@@ -186,7 +186,7 @@
mixture(c(unknown(), 1L))
Condition
Error in `mixture()`:
- ! Since `type = 'double'`, please use that data type for the range.
+ ! Since `type = "double"`, please use that data type for the range.
---
@@ -194,7 +194,7 @@
mixture(letters[1:2])
Condition
Error in `mixture()`:
- ! Since `type = 'double'`, please use that data type for the range.
+ ! Since `type = "double"`, please use that data type for the range.
---
@@ -202,7 +202,7 @@
mtry(c(0.1, 0.5))
Condition
Error in `mtry()`:
- ! An integer is required for the range and these do not appear to be whole numbers: 0.1, 0.5
+ ! An integer is required for the range and these do not appear to be whole numbers: 0.1 and 0.5.
---
@@ -210,7 +210,7 @@
mtry(c(0.1, unknown()))
Condition
Error in `mtry()`:
- ! An integer is required for the range and these do not appear to be whole numbers: 0.1
+ ! An integer is required for the range and these do not appear to be whole numbers: 0.1.
---
@@ -218,7 +218,7 @@
mtry(c(unknown(), 0.5))
Condition
Error in `mtry()`:
- ! An integer is required for the range and these do not appear to be whole numbers: 0.5
+ ! An integer is required for the range and these do not appear to be whole numbers: 0.5.
# `values` must be compatible with `range` and `inclusive`
diff --git a/tests/testthat/_snaps/grids.md b/tests/testthat/_snaps/grids.md
index fc9d5ab3..5ee72bf9 100644
--- a/tests/testthat/_snaps/grids.md
+++ b/tests/testthat/_snaps/grids.md
@@ -4,7 +4,7 @@
grid_regular(mixture(), trees(), levels = 1:4)
Condition
Error in `grid_regular()`:
- ! `levels` should have length 1 or 2
+ ! `levels` should have length 1 or 2, not 4.
---
@@ -14,7 +14,15 @@
Warning:
`size` is not an argument to `grid_regular()`. Did you mean `levels`?
Error in `parameters()`:
- ! The objects should all be `param` objects.
+ ! The objects should all be objects.
+
+---
+
+ Code
+ grid_regular(mixture(), trees(), levels = c(2, trees = 4))
+ Condition
+ Error in `grid_regular()`:
+ ! Elements of `levels` should either be all named or unnamed, not mixed.
# wrong argument name
diff --git a/tests/testthat/_snaps/parameters.md b/tests/testthat/_snaps/parameters.md
index d1979eb9..5e84bdf6 100644
--- a/tests/testthat/_snaps/parameters.md
+++ b/tests/testthat/_snaps/parameters.md
@@ -13,7 +13,8 @@
parameters_constr(ab, c("a", "a"), ab, ab, ab)
Condition
Error:
- ! Element `id` should have unique values. Duplicates exist for item(s): 'a'
+ x Element id should have unique values.
+ i Duplicates exist for item: a
---
@@ -22,7 +23,7 @@
parameters_constr(ab, ab, ab, ab, ab, "not a params list")
Condition
Error:
- ! `object` must be a list of `param` objects.
+ ! `object` must be a list of objects.
---
@@ -48,7 +49,16 @@
parameters(list(a = mtry(), a = penalty()))
Condition
Error in `parameters()`:
- ! Element `id` should have unique values. Duplicates exist for item(s): 'a'
+ x Element id should have unique values.
+ i Duplicates exist for item: a
+
+---
+
+ Code
+ parameters(list(a = mtry, a = penalty()))
+ Condition
+ Error in `parameters()`:
+ ! The objects should all be objects.
# updating
@@ -66,6 +76,14 @@
Error in `update()`:
! At least one parameter is not a dials parameter object or NA: penalty.
+---
+
+ Code
+ update(p_1, not_penalty = 1:2)
+ Condition
+ Error in `update()`:
+ ! At least one parameter does not match any id's in the set: not_penalty.
+
---
Code
@@ -74,6 +92,14 @@
Error in `update()`:
! All arguments should be named.
+---
+
+ Code
+ update(p_1)
+ Condition
+ Error in `update()`:
+ ! Please supply at least one parameter object.
+
# printing
Code
@@ -142,5 +168,5 @@
parameters(tibble::as_tibble(mtcars))
Condition
Error in `parameters()`:
- ! `parameters` objects cannot be created from objects of class `tbl_df`.
+ ! objects cannot be created from a tibble.
diff --git a/tests/testthat/test-grids.R b/tests/testthat/test-grids.R
index 31b232bd..63a332d1 100644
--- a/tests/testthat/test-grids.R
+++ b/tests/testthat/test-grids.R
@@ -44,6 +44,11 @@ test_that("regular grid", {
grid_regular(list(mixture(), trees()), levels = 3),
grid_regular(mixture(), trees(), levels = 3)
)
+
+ expect_snapshot(
+ error = TRUE,
+ grid_regular(mixture(), trees(), levels = c(2, trees = 4))
+ )
})
test_that("random grid", {
diff --git a/tests/testthat/test-parameters.R b/tests/testthat/test-parameters.R
index b93aa5a2..aa4b6953 100644
--- a/tests/testthat/test-parameters.R
+++ b/tests/testthat/test-parameters.R
@@ -46,6 +46,7 @@ test_that("create from lists of param objects", {
expect_equal(p_3$id, c("a", "some name"))
expect_snapshot(error = TRUE, parameters(list(a = mtry(), a = penalty())))
+ expect_snapshot(error = TRUE, parameters(list(a = mtry, a = penalty())))
})
test_that("updating", {
@@ -61,8 +62,10 @@ test_that("updating", {
expect_snapshot(error = TRUE, update(p_1, new_pen))
expect_snapshot(error = TRUE, update(p_1, penalty = 1:2))
+ expect_snapshot(error = TRUE, update(p_1, not_penalty = 1:2))
expect_snapshot(error = TRUE, update(p_1, penalty(), mtry = mtry(3:4)))
expect_error(update(p_1, penalty = NA), NA)
+ expect_snapshot(error = TRUE, update(p_1))
})
test_that("printing", {