Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Switch from rlang::abort() in parameters.R, grids.R and misc.R #351

Merged
merged 4 commits into from
Sep 23, 2024
Merged
Show file tree
Hide file tree
Changes from 2 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
13 changes: 8 additions & 5 deletions R/grids.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
)
}
Expand All @@ -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
)
}
Expand Down Expand Up @@ -252,7 +253,9 @@ make_random_grid <- function(...,

new_param_grid <- function(x = new_data_frame()) {
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."
)
Comment on lines +256 to +258
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Can you thread the call through and give this message a test?

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I can thread through the call. but this code as far as I can seen isn't possible to reach naturally. It is only applied to the output of functions like make_max_entropy_grid() and make_latin_hypercube_grid() which returns

}

x <- vctrs::vec_unique(x)
Expand Down
23 changes: 12 additions & 11 deletions R/misc.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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)
Expand Down
55 changes: 28 additions & 27 deletions R/parameters.R
Original file line number Diff line number Diff line change
Expand Up @@ -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}}."
EmilHvitfeldt marked this conversation as resolved.
Show resolved Hide resolved
)
}

Expand All @@ -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)
Expand All @@ -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)
}
Expand All @@ -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
)
}
Expand All @@ -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".
Expand Down Expand Up @@ -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
)
Expand Down Expand Up @@ -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)))
Expand Down
2 changes: 1 addition & 1 deletion man/parameters_constr.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

14 changes: 7 additions & 7 deletions tests/testthat/_snaps/constructors.md
Original file line number Diff line number Diff line change
Expand Up @@ -170,55 +170,55 @@
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.

---

Code
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.

---

Code
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.

---

Code
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.

---

Code
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.

---

Code
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.

---

Code
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`

Expand Down
4 changes: 2 additions & 2 deletions tests/testthat/_snaps/grids.md
Original file line number Diff line number Diff line change
Expand Up @@ -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.

---

Expand All @@ -14,7 +14,7 @@
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 <param> objects.

# wrong argument name

Expand Down
10 changes: 6 additions & 4 deletions tests/testthat/_snaps/parameters.md
Original file line number Diff line number Diff line change
Expand Up @@ -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

---

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

---

Expand All @@ -48,7 +49,8 @@
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

# updating

Expand Down Expand Up @@ -142,5 +144,5 @@
parameters(tibble::as_tibble(mtcars))
Condition
Error in `parameters()`:
! `parameters` objects cannot be created from objects of class `tbl_df`.
! <parameters> objects cannot be created from a tibble.

Loading