use defaults for call in helper functions

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)) {

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)

R/in-line.R

@@ -191,19 +191,19 @@
 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
 #' @export
 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)
 }