Closes #473 assert_length: add length argument to assert_numeric_vect…

…or() (#474) * #473 assert_length: add length argument to assert_numeric_vector() * #473 assert_length: improve coverage * #473 assert_length: fix R CMD check
pharmaverse · Dec 3, 2024 · 104f497 · 104f497
1 parent f40491a
commit 104f497
Show file tree

Hide file tree

Showing 5 changed files with 203 additions and 135 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -9,6 +9,9 @@ used in the glue expression specified for the `message_text` argument. (#469)
 possible to specify more than one unit or not specify it at all. In the latter
 case only the uniqueness of the unit is checked. (#468)
 
+- The `assert_numeric_vector()` function gained an optional `length` argument to
+check whether the vector has a specific length. (#473)
+
 ## Breaking Changes
 
 - The following functions are entering the next phase of the deprecation process: (#459)

diff --git a/R/assertions.R b/R/assertions.R
@@ -687,6 +687,10 @@ assert_integer_scalar <- function(arg,
 #' Checks if an argument is a numeric vector
 #'
 #' @param arg A function argument to be checked
+#' @param length Expected length
+#'
+#'   If the argument is not specified or set to `NULL`, any length is accepted.
+#'
 #' @param optional Is the checked argument optional? If set to `FALSE` and `arg`
 #' is `NULL` then an error is thrown
 #' @inheritParams assert_logical_scalar
@@ -708,12 +712,20 @@ assert_integer_scalar <- function(arg,
 #' example_fun(1:10)
 #'
 #' try(example_fun(letters))
+#'
+#' example_fun <- function(num) {
+#'   assert_numeric_vector(num, length = 2)
+#' }
+#'
+#' try(example_fun(1:10))
 assert_numeric_vector <- function(arg,
+                                  length = NULL,
                                   optional = FALSE,
                                   arg_name = rlang::caller_arg(arg),
                                   message = NULL,
                                   class = "assert_numeric_vector",
                                   call = parent.frame()) {
+  assert_integer_scalar(length, subset = "positive", optional = TRUE)
   assert_logical_scalar(optional)
 
   if (optional && is.null(arg)) {
@@ -730,6 +742,20 @@ assert_numeric_vector <- function(arg,
     )
   }
 
+  if (!is.null(length)) {
+    if (length(arg) != length) {
+      cli_abort(
+        message = message %||%
+          paste(
+            "Argument {.arg {arg_name}} must be a vector of length {.val {length}},",
+            "but has length {.val {length(arg)}}."
+          ),
+        class = c(class, "assert-admiraldev"),
+        call = call
+      )
+    }
+  }
+
   invisible(arg)
 }
 

diff --git a/man/assert_numeric_vector.Rd b/man/assert_numeric_vector.Rd
diff --git a/tests/testthat/_snaps/assertions.md b/tests/testthat/_snaps/assertions.md
@@ -212,7 +212,7 @@
       Error in `example_fun()`:
       ! Argument `arg` must be an integer scalar.
 
-# assert_numeric_vector Test 37: error if `arg` is not a numeric vector
+# assert_numeric_vector Test 38: error if `arg` is not a numeric vector
 
     Code
       example_fun(TRUE)
@@ -236,23 +236,31 @@
       Error in `example_fun()`:
       ! Argument `arg` must be a numeric vector, but it is a string.
 
-# assert_s3_class Test 38: error if `arg` is not an object of a specific class S3
+# assert_numeric_vector Test 39: error if length is not as expected
+
+    Code
+      assert_numeric_vector(numbers, length = 2)
+    Condition
+      Error:
+      ! Argument `numbers` must be a vector of length 2, but has length 3.
+
+# assert_s3_class Test 40: error if `arg` is not an object of a specific class S3
 
     Code
       example_fun("test")
     Condition
       Error in `example_fun()`:
       ! Argument `arg` must be class <factor>, but is a string.
 
-# assert_s3_class Test 40: error if `arg` is NULL and optional is FALSE
+# assert_s3_class Test 42: error if `arg` is NULL and optional is FALSE
 
     Code
       example_fun(NULL)
     Condition
       Error in `example_fun()`:
       ! Argument `arg` must be class <factor>, but is NULL.
 
-# assert_list_of Test 42: error if `arg` is not a list of specific class S3 objects
+# assert_list_of Test 44: error if `arg` is not a list of specific class S3 objects
 
     Code
       example_fun(list("test"))
@@ -261,15 +269,15 @@
       ! Each element of the list in argument `arg` must be class/type <factor>.
       i But, element 1 is a string
 
-# assert_list_of Test 44: error if `arg` is NULL and optional is FALSE
+# assert_list_of Test 46: error if `arg` is NULL and optional is FALSE
 
     Code
       example_fun(NULL)
     Condition
       Error in `example_fun()`:
       ! Argument `arg` must be class <list>, but is NULL.
 
-# assert_list_of Test 46: error if `arg` is not a named list (no elements named)
+# assert_list_of Test 48: error if `arg` is not a named list (no elements named)
 
     Code
       mylist <- list(1, 2, 3)
@@ -279,7 +287,7 @@
       ! All elements of `mylist` argument must be named.
       i The indices of the unnamed elements are 1, 2, and 3
 
-# assert_list_of Test 47: error if `arg` is not a named list (some elements named)
+# assert_list_of Test 49: error if `arg` is not a named list (some elements named)
 
     Code
       mylist <- list(1, 2, 3, d = 4)
@@ -289,7 +297,7 @@
       ! All elements of `mylist` argument must be named.
       i The indices of the unnamed elements are 1, 2, and 3
 
-# assert_named Test 50: error if no elements are named
+# assert_named Test 52: error if no elements are named
 
     Code
       arg <- c(1, 2)
@@ -299,15 +307,15 @@
       ! All elements of `arg` argument must be named.
       i The indices of the unnamed elements are 1 and 2
 
-# assert_function Test 51: error if `arg` is not a function
+# assert_function Test 53: error if `arg` is not a function
 
     Code
       example_fun(5)
     Condition
       Error in `example_fun()`:
       ! Argument `arg` must be a function, but is a number.
 
-# assert_function Test 54: error if  `params`  is missing with no default
+# assert_function Test 56: error if  `params`  is missing with no default
 
     Code
       example_fun(sum)
@@ -323,23 +331,23 @@
       Error in `example_fun()`:
       ! "x" and "y" are not arguments of the function specified for `arg`.
 
-# assert_unit Test 59: error if multiple units in the input dataset
+# assert_unit Test 61: error if multiple units in the input dataset
 
     Code
       assert_unit(advs, param = "WEIGHT", get_unit_expr = VSSTRESU)
     Condition
       Error:
       ! Multiple units "kg" and "lb" found for "WEIGHT". Please review and update the units.
 
-# assert_unit Test 60: error if unexpected unit in the input dataset
+# assert_unit Test 62: error if unexpected unit in the input dataset
 
     Code
       assert_unit(advs, param = "WEIGHT", required_unit = "lb", get_unit_expr = VSSTRESU)
     Condition
       Error:
       ! It is expected that "WEIGHT" has unit of "lb". In the input dataset the unit is "kg".
 
-# assert_unit Test 61: error if get_unit_expr invalid
+# assert_unit Test 63: error if get_unit_expr invalid
 
     Code
       assert_unit(advs, param = "WEIGHT", required_unit = "kg", get_unit_expr = VSTRESU)
@@ -349,15 +357,15 @@
       See error message below:
       i In argument: `_unit = VSTRESU`. Caused by error: ! object 'VSTRESU' not found
 
-# assert_param_does_not_exist Test 62: error if parameter exists in the input dataset
+# assert_param_does_not_exist Test 64: error if parameter exists in the input dataset
 
     Code
       assert_param_does_not_exist(advs, param = "WEIGHT")
     Condition
       Error:
       ! The parameter code "WEIGHT" already exists in dataset `advs`.
 
-# assert_varval_list Test 64: error if `arg` is not a list of var-value expressions
+# assert_varval_list Test 66: error if `arg` is not a list of expressions
 
     Code
       example_fun(c("USUBJID", "PARAMCD", "VISIT"))
@@ -366,7 +374,7 @@
       ! Argument `arg` must be a named list of expressions where each element is a symbol, character scalar, numeric scalar, an expression, or NA, but is a character vector.
       i To create a list of expressions use `exprs()`.
 
-# assert_varval_list Test 65: error if `arg` is not a list of var-value expressions
+# assert_varval_list Test 67: error if not all elements are variables
 
     Code
       example_fun(exprs(USUBJID, PARAMCD, NULL))
@@ -375,15 +383,15 @@
       ! Argument `arg` must be a list of expressions where each element is a symbol, character scalar, numeric scalar, an expression, or NA, but is a list.
       i To create a list of expressions use `exprs()`.
 
-# assert_varval_list Test 66: error if `required_elements` are missing from `arg`
+# assert_varval_list Test 68: error if `required_elements` are missing from `arg`
 
     Code
       example_fun(exprs(DTHSEQ = AESEQ))
     Condition
       Error in `example_fun()`:
       ! The following required elements are missing from argument `arg`: "DTHDOM".
 
-# assert_varval_list Test 68: error if `accept_expr` is TRUE and value is invalid
+# assert_varval_list Test 70: error if `accept_expr` is TRUE and value is invalid
 
     Code
       example_fun(exprs(DTHSEQ = TRUE))
@@ -392,7 +400,7 @@
       ! The elements of the list in argument `arg` must be a symbol, character scalar, numeric scalar, an expression, or NA.
       i "DTHSEQ" = `TRUE` is of type <logical>
 
-# assert_varval_list Test 69: error if `accept_expr` is FALSE and value is invalid
+# assert_varval_list Test 71: error if `accept_expr` is FALSE and value is invalid
 
     Code
       example_fun(exprs(DTHSEQ = exprs()))
@@ -401,7 +409,7 @@
       ! The elements of the list in argument `arg` must be a symbol, character scalar, numeric scalar, or NA.
       i "DTHSEQ" = `exprs()` is of type <language>
 
-# assert_list_element Test 78: error if the elements do not fulfill the condition
+# assert_list_element Test 80: error if the elements do not fulfill the condition
 
     Code
       assert_list_element(list(list(var = expr(DTHDT), val = 1), list(var = expr(
@@ -425,7 +433,7 @@
       ! List element "val" must one of 0 and 1 in argument `input`.
       i But, `input[[2]]$val = -1`, and `input[[3]]$val = -2`
 
-# assert_one_to_one Test 79: error if there is a one to many mapping
+# assert_one_to_one Test 81: error if there is a one to many mapping
 
     Code
       assert_one_to_one(dm, exprs(DOMAIN), exprs(USUBJID))
@@ -434,31 +442,31 @@
       ! For some values of "DOMAIN" there is more than one value of "USUBJID"
       i Call `admiral::get_one_to_many_dataset()` to get all one-to-many values.
 
-# assert_date_var Test 82: error if variable is not a date or datetime variable
+# assert_date_var Test 84: error if variable is not a date or datetime variable
 
     Code
       example_fun(dataset = my_data, var = USUBJID)
     Condition
       Error in `example_fun()`:
       ! Column "USUBJID" in dataset `dataset` must be a date or datetime, but is a character vector.
 
-# assert_date_vector Test 86: error if `arg` is NULL and optional is FALSE
+# assert_date_vector Test 88: error if `arg` is NULL and optional is FALSE
 
     Code
       example_fun(NULL)
     Condition
       Error in `example_fun()`:
       ! Argument `arg` must be a date or datetime, but is NULL.
 
-# assert_atomic_vector Test 87: error if input is not atomic vector
+# assert_atomic_vector Test 89: error if input is not atomic vector
 
     Code
       assert_atomic_vector(x)
     Condition
       Error:
       ! Argument `x` must be an atomic vector, but is a list.
 
-# assert_same_type Test 89: error if different type
+# assert_same_type Test 91: error if different type
 
     Code
       assert_same_type(true_value, false_value, missing_value)