Closes #468 multiple units: extend required_unit argument in assert_u…

…nit() (#471) * #468 multiple_units: extend required_unit argument * #468 multiple_units: update tests and NEWS * #468 multiple_units: update man * #468 multiple_units: style files * #468 multiple_units: fix R-CMD check * #468 multiple_units: style files * #468 multiple_units: fix case of all units NA * #468 multiple_units: fix case of all units NA * #468 multiple_units: update NEWS * #468 multiple_units: trigger workflows
pharmaverse · Nov 5, 2024 · 12380c4 · 12380c4
1 parent 0669aae
commit 12380c4
Show file tree

Hide file tree

Showing 6 changed files with 251 additions and 97 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -35,7 +35,7 @@ BugReports: https://github.com/pharmaverse/admiraldev/issues
 Depends: 
     R (>= 4.0)
 Imports:
-    cli,
+    cli (>= 3.0.0),
     dplyr (>= 1.0.5),
     glue (>= 1.6.0),
     lifecycle (>= 0.1.0),

diff --git a/NEWS.md b/NEWS.md
@@ -2,6 +2,10 @@
 
 ## Updates of Existing Functions
 
+- The `required_unit` argument of `assert_unit()` has been enhanced. It is now
+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)
+
 ## 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
@@ -1099,9 +1099,18 @@ assert_function <- function(arg,
 #' Checks if a parameter (`PARAMCD`) in a dataset is provided in the expected
 #' unit.
 #'
-#' @param dataset A `data.frame`
+#' @param dataset Dataset to be checked
+#'
+#'   The variable `PARAMCD` and those used in `get_unit_expr` are expected.
+#'
 #' @param param Parameter code of the parameter to check
-#' @param required_unit Expected unit
+#' @param required_unit Expected unit(s)
+#'
+#'  If the argument is set to `NULL`, it is checked only whether the unit is
+#'  unique within the parameter.
+#'
+#'  *Permitted Values*: A character vector or `NULL`
+#'
 #' @param get_unit_expr Expression used to provide the unit of `param`
 #'
 #' @inheritParams assert_logical_scalar
@@ -1111,9 +1120,12 @@ assert_function <- function(arg,
 #' @family assertion
 #'
 #' @return
-#' The function throws an error if the unit variable differs from the
-#' unit for any observation of the parameter in the input dataset. Otherwise, the
-#' dataset is returned invisibly.
+#' The function throws an error
+#' - if there is more than one non-missing unit in the dataset or
+#' - if the unit variable differs from the expected unit for any observation of
+#'  the parameter in the input dataset.
+#'
+#' Otherwise, the dataset is returned invisibly.
 #'
 #' @export
 #'
@@ -1127,26 +1139,63 @@ assert_function <- function(arg,
 #' )
 #'
 #' assert_unit(advs, param = "WEIGHT", required_unit = "kg", get_unit_expr = VSSTRESU)
+#'
+#' try(
+#'   assert_unit(
+#'     advs,
+#'     param = "WEIGHT",
+#'     required_unit = c("g", "mg"),
+#'     get_unit_expr = VSSTRESU
+#'   )
+#' )
+#'
+#' # Checking uniqueness of unit only
+#' advs <- tribble(
+#'   ~USUBJID, ~VSTESTCD, ~VSTRESN, ~VSSTRESU, ~PARAMCD, ~AVAL,
+#'   "P01",    "WEIGHT",      80.1, "kg",      "WEIGHT",  80.1,
+#'   "P02",    "WEIGHT",     85700, "g",       "WEIGHT", 85700
+#' )
+#'
+#' try(
+#'   assert_unit(advs, param = "WEIGHT", get_unit_expr = VSSTRESU)
+#' )
 assert_unit <- function(dataset,
                         param,
-                        required_unit,
+                        required_unit = NULL,
                         get_unit_expr,
                         arg_name = rlang::caller_arg(required_unit),
                         message = NULL,
                         class = "assert_unit",
                         call = parent.frame()) {
   assert_data_frame(dataset, required_vars = exprs(PARAMCD))
   assert_character_scalar(param)
-  assert_character_scalar(required_unit)
+  assert_character_vector(required_unit, optional = TRUE)
   get_unit_expr <- enexpr(get_unit_expr)
 
-  units <- dataset %>%
-    mutate(`_unit` = !!get_unit_expr) %>%
+  tryCatch(
+    data_unit <- mutate(dataset, `_unit` = !!get_unit_expr),
+    error = function(cnd) {
+      cli_abort(
+        message =
+          c(
+            paste(
+              "Extracting units using expression {.code {get_unit_expr}} specified",
+              "for {.arg get_unit_expr} failed!"
+            ),
+            "See error message below:",
+            conditionMessage(cnd)
+          ),
+        call = parent.frame(n = 4),
+        class = c(class, "assert-admiraldev", class(cnd))
+      )
+    }
+  )
+  units <- data_unit %>%
     filter(PARAMCD == param & !is.na(`_unit`)) %>%
     pull(`_unit`) %>%
     unique()
 
-  if (length(units) != 1L) {
+  if (length(units) > 1L) {
     message <-
       message %||%
       "Multiple units {.val {units}} found for {.val {param}}. Please review and update the units."
@@ -1157,7 +1206,12 @@ assert_unit <- function(dataset,
       class = c(class, "assert-admiraldev")
     )
   }
-  if (tolower(units) != tolower(required_unit)) {
+
+  if (!is.null(required_unit) && length(units) > 0 &&
+    tolower(units) %notin% tolower(required_unit)) {
+    # change cli `.val` to end with OR instead of AND
+    divid <- cli_div(theme = list(.val = list("vec-last" = ", or ", "vec_sep2" = " or ")))
+
     message <-
       message %||%
       "It is expected that {.val {param}} has unit of {.val {required_unit}}.

diff --git a/man/assert_unit.Rd b/man/assert_unit.Rd
diff --git a/tests/testthat/_snaps/assertions.md b/tests/testthat/_snaps/assertions.md
@@ -323,31 +323,41 @@
       Error in `example_fun()`:
       ! "x" and "y" are not arguments of the function specified for `arg`.
 
-# assert_unit Test 57: error if there are multiple units in the input dataset
+# assert_unit Test 59: error if multiple units in the input dataset
 
     Code
-      assert_unit(advs, param = "WEIGHT", required_unit = "kg", get_unit_expr = VSSTRESU)
+      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 58: error if unexpected unit in the input dataset
+# assert_unit Test 60: 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_param_does_not_exist Test 59: error if parameter exists in the input dataset
+# assert_unit Test 61: error if get_unit_expr invalid
+
+    Code
+      assert_unit(advs, param = "WEIGHT", required_unit = "kg", get_unit_expr = VSTRESU)
+    Condition
+      Error in `assert_unit()`:
+      ! Extracting units using expression `VSTRESU` specified for `get_unit_expr` failed!
+      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
 
     Code
       assert_param_does_not_exist(advs, param = "WEIGHT")
     Condition
       Error:
       ! The parameter code "WEIGHT" already exists in dataset `advs`.
 
-# assert_varval_list Test 61: error if `arg` is not a list of var-value expressions
+# assert_varval_list Test 64: error if `arg` is not a list of var-value expressions
 
     Code
       example_fun(c("USUBJID", "PARAMCD", "VISIT"))
@@ -356,7 +366,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 62: error if `arg` is not a list of var-value expressions
+# assert_varval_list Test 65: error if `arg` is not a list of var-value expressions
 
     Code
       example_fun(exprs(USUBJID, PARAMCD, NULL))
@@ -365,15 +375,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 63: error if `required_elements` are missing from `arg`
+# assert_varval_list Test 66: 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 65: error if `accept_expr` is TRUE and value is invalid
+# assert_varval_list Test 68: error if `accept_expr` is TRUE and value is invalid
 
     Code
       example_fun(exprs(DTHSEQ = TRUE))
@@ -382,7 +392,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 66: error if `accept_expr` is FALSE and value is invalid
+# assert_varval_list Test 69: error if `accept_expr` is FALSE and value is invalid
 
     Code
       example_fun(exprs(DTHSEQ = exprs()))
@@ -391,7 +401,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 75: error if the elements do not fulfill the condition
+# assert_list_element Test 78: error if the elements do not fulfill the condition
 
     Code
       assert_list_element(list(list(var = expr(DTHDT), val = 1), list(var = expr(
@@ -403,7 +413,7 @@
       ! List element "val" must be `>=0` in argument `input`:
       i  But, `input[[2]]$val = -1`, and `input[[3]]$val = -2`
 
-# assert_one_to_one Test 76: error if there is a one to many mapping
+# assert_one_to_one Test 79: error if there is a one to many mapping
 
     Code
       assert_one_to_one(dm, exprs(DOMAIN), exprs(USUBJID))
@@ -412,31 +422,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 79: error if variable is not a date or datetime variable
+# assert_date_var Test 82: 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 83: error if `arg` is NULL and optional is FALSE
+# assert_date_vector Test 86: 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 84: error if input is not atomic vector
+# assert_atomic_vector Test 87: 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 86: error if different type
+# assert_same_type Test 89: error if different type
 
     Code
       assert_same_type(true_value, false_value, missing_value)