diff --git a/R/checks.R b/R/checks.R index ff34516..e0b389a 100644 --- a/R/checks.R +++ b/R/checks.R @@ -1,11 +1,11 @@ -check_numeric <- function(x, input = "`x`", call) { +check_numeric <- function(x, input = "`x`", call = rlang::caller_env()) { if (!is.vector(x) || !is.numeric(x)) { cli::cli_abort("{.arg {input}} should be {an} numeric vector.") } invisible(NULL) } -check_categorical <- function(x, call) { +check_categorical <- function(x, call = rlang::caller_env()) { if (!is.character(x) & !is.factor(x)) { cli::cli_abort( "{.arg x} should be a character or factor vector, @@ -21,7 +21,7 @@ out_of_unit_range <- function(x) { any(x < 0 | x > 1) } -check_unit_range <- function(x, call) { +check_unit_range <- function(x, call = rlang::caller_env()) { msg <- c( "Desirability values should be numeric and complete in the range [0, 1]." @@ -42,7 +42,7 @@ check_unit_range <- function(x, call) { invisible(NULL) } -check_value_order <- function(low, high, target = NULL, call) { +check_value_order <- function(low, high, target = NULL, call = rlang::caller_env()) { check_number_decimal(low, call = call) check_number_decimal(high, call = call) check_number_decimal(target, allow_null = TRUE, call = call) @@ -64,7 +64,7 @@ check_value_order <- function(low, high, target = NULL, call) { invisible(NULL) } -check_vector_args <- function(values, d, call) { +check_vector_args <- function(values, d, call = rlang::caller_env()) { if (!is.vector(values) || !is.numeric(values)) { cli::cli_abort("{.arg values} should be a numeric vector.", call = call) } @@ -93,12 +93,12 @@ check_args <- function(arg, x, use_data, fn, type = "low", call = rlang::caller_ arg } -check_scale <- function(x, arg, call) { +check_scale <- function(x, arg, call = rlang::caller_env()) { check_number_decimal(x, min = 0, arg = arg, call = call) invisible(NULL) } -is_d_input <- function(x, call) { +is_d_input <- function(x, call = rlang::caller_env()) { tmp <- purrr::map(x, check_numeric, input = "desirability", call = call) outside <- purrr::map_lgl(x, out_of_unit_range) if (any(outside)) { diff --git a/R/computations.R b/R/computations.R index 733cce3..1f2370b 100644 --- a/R/computations.R +++ b/R/computations.R @@ -1,4 +1,4 @@ -.comp_max <- function(x, low, high, scale, missing, call) { +.comp_max <- function(x, low, high, scale, missing, call = rlang::caller_env()) { check_unit_range(missing, call = call) check_numeric(x, call = call) check_value_order(low, high, call = call) @@ -11,7 +11,7 @@ out } -.comp_min <- function(x, low, high, scale, missing, call) { +.comp_min <- function(x, low, high, scale, missing, call = rlang::caller_env()) { check_unit_range(missing, call = call) check_numeric(x, call = call) check_value_order(low, high, call = call) diff --git a/R/in-line.R b/R/in-line.R index e4105a0..f8aadaf 100644 --- a/R/in-line.R +++ b/R/in-line.R @@ -191,9 +191,9 @@ d_max <- function(x, low, high, scale = 1, missing = NA_real_, use_data = FALSE) { low <- check_args(low, x, use_data, fn = "d_max") high <- check_args(high, x, use_data, fn = "d_max", type = "high") - check_scale(scale, arg = "scale", call = rlang::current_call()) + check_scale(scale, arg = "scale") - .comp_max(x, low, high, scale, missing, call = rlang::current_call()) + .comp_max(x, low, high, scale, missing) } #' @rdname inline_desirability @@ -201,9 +201,9 @@ d_max <- function(x, low, high, scale = 1, missing = NA_real_, use_data = FALSE) d_min <- function(x, low, high, scale = 1, missing = NA_real_, use_data = FALSE) { low <- check_args(low, x, use_data, fn = "d_min") high <- check_args(high, x, use_data, fn = "d_min", type = "high") - check_scale(scale, arg = "scale", call = rlang::current_call()) + check_scale(scale, arg = "scale") - .comp_min(x, low, high, scale, missing, call = rlang::current_call()) + .comp_min(x, low, high, scale, missing) } @@ -214,11 +214,10 @@ d_target <- function(x, low, target, high, scale_low = 1, scale_high = 1, low <- check_args(low, x, use_data, fn = "d_target") high <- check_args(high, x, use_data, fn = "d_target", type = "high") target <- check_args(target, x, use_data, fn = "d_target", type = "target") - check_scale(scale_low, arg = "scale_low", call = rlang::current_call()) - check_scale(scale_high, arg = "scale_high", call = rlang::current_call()) + check_scale(scale_low, arg = "scale_low") + check_scale(scale_high, arg = "scale_high") - .comp_target(x, low, target, high, scale_low, scale_high, missing, - call = rlang::current_call()) + .comp_target(x, low, target, high, scale_low, scale_high, missing) } @@ -227,18 +226,18 @@ d_target <- function(x, low, target, high, scale_low = 1, scale_high = 1, d_box <- function(x, low, high, missing = NA_real_, use_data = FALSE) { low <- check_args(low, x, use_data, fn = "d_box") high <- check_args(high, x, use_data, fn = "d_box", type = "high") - .comp_box(x, low, high, missing, call = rlang::current_call()) + .comp_box(x, low, high, missing) } #' @rdname inline_desirability #' @export d_custom <- function(x, x_vals, desirability, missing = NA_real_) { - .comp_custom(x, x_vals, desirability, missing, call = rlang::current_call()) + .comp_custom(x, x_vals, desirability, missing) } #' @rdname inline_desirability #' @export d_category <- function(x, categories, missing = NA_real_) { - .comp_category(x, categories, missing, call = rlang::current_call()) + .comp_category(x, categories, missing) }