Merge pull request #160 from jdblischak/nse-input-error

Use NSE to include variable name in error message

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: simtrial
 Type: Package
 Title: Clinical Trial Simulation
-Version: 0.3.0.7
+Version: 0.3.0.8
 Authors@R: c(
     person("Keaven", "Anderson", email = "[email protected]", role = c("aut")),
     person("Yilong", "Zhang", email = "[email protected]", role =  c("aut")),

R/get_analysis_date.R

@@ -190,42 +190,14 @@ get_analysis_date <- function(
     min_n_overall = NA,
     min_n_per_stratum = NA,
     min_followup = NA) {
-  input_check_scalar(
-    planned_calendar_time,
-    label = "planned_calendar_time"
-  )
-  input_check_scalar(
-    target_event_overall,
-    label = "target_event_overall",
-    require_whole_number = TRUE
-  )
-  input_check_scalar(
-    max_extension_for_target_event,
-    label = "max_extension_for_target_event"
-  )
-  input_check_scalar(
-    min_time_after_previous_analysis,
-    label = "min_time_after_previous_analysis"
-  )
-  input_check_scalar(
-    min_n_overall,
-    label = "min_n_overall",
-    require_whole_number = TRUE
-  )
-  input_check_scalar(
-    min_followup,
-    label = "min_followup"
-  )
-  input_check_vector(
-    target_event_per_stratum,
-    label = "target_event_per_stratum",
-    require_whole_number = TRUE
-  )
-  input_check_vector(
-    min_n_per_stratum,
-    label = "min_n_per_stratum",
-    require_whole_number = TRUE
-  )
+  input_check_scalar(planned_calendar_time)
+  input_check_scalar(target_event_overall, require_whole_number = TRUE)
+  input_check_scalar(max_extension_for_target_event)
+  input_check_scalar(min_time_after_previous_analysis)
+  input_check_scalar(min_n_overall, require_whole_number = TRUE)
+  input_check_scalar(min_followup)
+  input_check_vector(target_event_per_stratum, require_whole_number = TRUE)
+  input_check_vector(min_n_per_stratum, require_whole_number = TRUE)
 
   # Check if `min_n_overall` is input by user
   cond1 <- !is.na(min_n_overall)

R/input_checking.R

@@ -19,14 +19,15 @@
 #' Check if the input `x` is a single non-negative number (or missing)
 #'
 #' @param x a scalar value
-#' @param label the label of `x`
 #' @param require_whole_number Must the numbers be whole numbers (default: FALSE)
 #'
 #' @return an error message or nothing
 #' @noRd
 #' @examples
-#' input_check_scalar(x = 100, label = "my_x")
-input_check_scalar <- function(x = NA, label = "x", require_whole_number = FALSE) {
+#' a <- 100
+#' input_check_scalar(a)
+input_check_scalar <- function(x = NA, require_whole_number = FALSE) {
+  label <- deparse(substitute(x))
   if (length(x) == 1 && is.na(x)) {
     return(invisible())
   }
@@ -48,15 +49,17 @@ input_check_scalar <- function(x = NA, label = "x", require_whole_number = FALSE
 #' Check if the input `x` is a vector of positive numbers (missing values allowed)
 #'
 #' @param x a vector
-#' @param label the label of `x`
 #' @param require_whole_number Must the numbers be whole numbers (default: FALSE)
 #'
 #' @return an error message or nothing
 #' @noRd
 #' @examples
-#' input_check_vector(x = 1:3, label = "my_x")
-#' input_check_vector(x = c(1, 2, NA), label = "my_x")
-input_check_vector <- function(x = NA, label = "x", require_whole_number = FALSE) {
+#' a <- 1:3
+#' input_check_vector(a)
+#' b <- c(1, 2, NA)
+#' input_check_vector(b)
+input_check_vector <- function(x = NA, require_whole_number = FALSE) {
+  label <- deparse(substitute(x))
   missing <- is.na(x)
   positive <- is.numeric(x) & x > 0
 

tests/testthat/test-unvalidated-input_checking.R

@@ -12,46 +12,46 @@ test_that("input_check_scalar() passes a single missing value", {
 })
 
 test_that("input_check_scalar() fails multiple values", {
+  two_na_var <- c(NA, NA)
   expect_error(
-    input_check_scalar(c(NA, NA)),
-    "x must be a single non-negative number \\(or NA\\)"
+    input_check_scalar(two_na_var),
+    "two_na_var must be a single non-negative number \\(or NA\\)"
   )
+  two_num_var <- c(1, 2)
   expect_error(
-    input_check_scalar(c(1, 2)),
-    "x must be a single non-negative number \\(or NA\\)"
+    input_check_scalar(two_num_var),
+    "two_num_var must be a single non-negative number \\(or NA\\)"
   )
+  na_num_var <- c(NA, 2)
   expect_error(
-    input_check_scalar(c(NA, 2)),
-    "x must be a single non-negative number \\(or NA\\)"
+    input_check_scalar(na_num_var),
+    "na_num_var must be a single non-negative number \\(or NA\\)"
   )
 })
 
 test_that("input_check_scalar() fails non-numeric input", {
+  logical_var <- TRUE
   expect_error(
-    input_check_scalar(TRUE),
-    "x must be a single non-negative number \\(or NA\\)"
+    input_check_scalar(logical_var),
+    "logical_var must be a single non-negative number \\(or NA\\)"
   )
+  string_var <- "string"
   expect_error(
-    input_check_scalar("string"),
-    "x must be a single non-negative number \\(or NA\\)"
+    input_check_scalar(string_var),
+    "string_var must be a single non-negative number \\(or NA\\)"
   )
 })
 
 test_that("input_check_scalar() fails negative numbers", {
+  neg_num_var <- -1
   expect_error(
-    input_check_scalar(-1),
-    "x must be a single non-negative number \\(or NA\\)"
+    input_check_scalar(neg_num_var),
+    "neg_num_var must be a single non-negative number \\(or NA\\)"
   )
+  neg_num_vec_var <- c(-1, -2)
   expect_error(
-    input_check_scalar(c(-1, -2)),
-    "x must be a single non-negative number \\(or NA\\)"
-  )
-})
-
-test_that("input_check_scalar() includes label in error message", {
-  expect_error(
-    input_check_scalar(-1, label = "custom"),
-    "custom must be a single non-negative number \\(or NA\\)"
+    input_check_scalar(neg_num_vec_var),
+    "neg_num_vec_var must be a single non-negative number \\(or NA\\)"
   )
 })
 
@@ -67,7 +67,7 @@ test_that("input_check_scalar() can check for whole numbers", {
   expect_silent(input_check_scalar(missing, require_whole_number = TRUE))
   expect_error(
     input_check_scalar(notwhole, require_whole_number = TRUE),
-    "x must be a single non-negative whole number \\(or NA\\)"
+    "notwhole must be a single non-negative whole number \\(or NA\\)"
   )
 })
 
@@ -92,34 +92,31 @@ test_that("input_check_vector() passes a vector of missing values", {
 })
 
 test_that("input_check_vector() fails with zero", {
+  with_zero_var <- 0:3
   expect_error(
-    input_check_vector(0:3),
-    "x must be a vector with only positive numbers and missing values"
+    input_check_vector(with_zero_var),
+    "with_zero_var must be a vector with only positive numbers and missing values"
   )
 })
 
 test_that("input_check_vector() fails with negative numbers", {
+  negative_var <- -3:3
   expect_error(
-    input_check_vector(-3:3),
-    "x must be a vector with only positive numbers and missing values"
+    input_check_vector(negative_var),
+    "negative_var must be a vector with only positive numbers and missing values"
   )
 })
 
 test_that("input_check_vector() fails with non-numeric vectors", {
+  logical_var <- TRUE
   expect_error(
-    input_check_vector(TRUE),
-    "x must be a vector with only positive numbers and missing values"
+    input_check_vector(logical_var),
+    "logical_var must be a vector with only positive numbers and missing values"
   )
+  string_var <- "string"
   expect_error(
-    input_check_vector("string"),
-    "x must be a vector with only positive numbers and missing values"
-  )
-})
-
-test_that("input_check_vector() includes label in error message", {
-  expect_error(
-    input_check_vector(-1, label = "custom"),
-    "custom must be a vector with only positive numbers and missing values"
+    input_check_vector(string_var),
+    "string_var must be a vector with only positive numbers and missing values"
   )
 })
 
@@ -132,7 +129,7 @@ test_that("input_check_vector() can check for whole numbers", {
   expect_silent(input_check_vector(whole, require_whole_number = TRUE))
   expect_error(
     input_check_vector(notwhole, require_whole_number = TRUE),
-    "x must be a vector with only positive whole numbers and missing values"
+    "notwhole must be a vector with only positive whole numbers and missing values"
   )
 })