Closes #47 - Switch to admiraldev::assert_unit() (#52)

* Get rid of assert_unit * Enable/Disable unit conversion * Apply suggestions from code review Co-authored-by: Edoardo Mancini <[email protected]> --------- Co-authored-by: Edoardo Mancini <[email protected]>
pharmaverse · Nov 11, 2024 · 8c97874 · 8c97874
1 parent 1502544
commit 8c97874
Show file tree

Hide file tree

Showing 9 changed files with 58 additions and 168 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -3,7 +3,6 @@
 export(derive_param_waisthgt)
 export(derive_param_waisthip)
 importFrom(admiral,derive_param_computed)
-importFrom(admiraldev,"%notin%")
 importFrom(admiraldev,assert_character_scalar)
 importFrom(admiraldev,assert_character_vector)
 importFrom(admiraldev,assert_data_frame)
@@ -12,6 +11,7 @@ importFrom(admiraldev,assert_filter_cond)
 importFrom(admiraldev,assert_logical_scalar)
 importFrom(admiraldev,assert_numeric_vector)
 importFrom(admiraldev,assert_param_does_not_exist)
+importFrom(admiraldev,assert_unit)
 importFrom(admiraldev,assert_vars)
 importFrom(admiraldev,assert_varval_list)
 importFrom(admiraldev,expect_dfs_equal)
@@ -71,7 +71,6 @@ importFrom(lubridate,ymd)
 importFrom(lubridate,ymd_hms)
 importFrom(magrittr,"%>%")
 importFrom(purrr,discard_at)
-importFrom(rlang,"%||%")
 importFrom(rlang,":=")
 importFrom(rlang,.data)
 importFrom(rlang,abort)

diff --git a/R/admiralmetabolic-package.R b/R/admiralmetabolic-package.R
@@ -1,9 +1,9 @@
 #' @keywords internal
 #' @family internal
-#' @importFrom admiraldev %notin% assert_numeric_vector assert_character_scalar
-#'             assert_logical_scalar assert_data_frame assert_vars assert_varval_list
-#'             assert_filter_cond assert_param_does_not_exist assert_expr expect_dfs_equal
-#'             assert_character_vector
+#' @importFrom admiraldev assert_numeric_vector assert_character_scalar assert_logical_scalar
+#'             assert_data_frame assert_vars assert_varval_list assert_filter_cond
+#'             assert_param_does_not_exist assert_expr expect_dfs_equal assert_character_vector
+#'             assert_unit
 #' @importFrom admiral derive_param_computed
 #' @importFrom cli cli_abort cli_alert_info
 #' @importFrom dplyr arrange bind_rows case_when desc ends_with filter full_join group_by
@@ -12,7 +12,7 @@
 #'             summarise_at summarise coalesce bind_cols na_if tibble tribble
 #' @importFrom magrittr %>%
 #' @importFrom purrr discard_at
-#' @importFrom rlang := %||% abort arg_match as_function as_string call2 caller_env
+#' @importFrom rlang := abort arg_match as_function as_string call2 caller_env
 #'             call_name current_env .data enexpr enexprs enquo eval_bare eval_tidy expr
 #'             exprs expr_interp expr_label f_lhs f_rhs inform
 #'             is_bare_formula is_call is_character is_formula is_integerish

diff --git a/R/assertions.R b/R/assertions.R
diff --git a/R/derive_advs_params.R b/R/derive_advs_params.R
@@ -161,7 +161,8 @@ derive_param_waisthip <- function(dataset,
     denominator_code = hipcir_code,
     by_vars = by_vars,
     set_values_to = set_values_to,
-    get_unit_expr = !!get_unit_expr
+    get_unit_expr = !!get_unit_expr,
+    unit_conversion = TRUE
   )
 }
 
@@ -373,7 +374,8 @@ derive_param_waisthgt <- function(dataset,
     constant_numerator = FALSE,
     constant_denominator = !is.null(constant_by_vars),
     constant_by_vars = constant_by_vars,
-    get_unit_expr = !!get_unit_expr
+    get_unit_expr = !!get_unit_expr,
+    unit_conversion = TRUE
   )
 }
 
@@ -465,6 +467,12 @@ derive_param_waisthgt <- function(dataset,
 #'
 #'   *Permitted Values:* A variable of the input dataset or a function call
 #'
+#' @param unit_conversion Enable/Disable unit conversion
+#'
+#'   Unit conversion is disabled by default. Ignored if `get_unit_expr` is `NULL`.
+#'
+#'   *Permitted Values:* logical scalar
+#'
 #' @inheritParams admiral::derive_param_computed
 #'
 #' @details
@@ -486,7 +494,8 @@ derive_param_ratio <- function(dataset,
                                constant_denominator = FALSE,
                                filter = NULL,
                                constant_by_vars = NULL,
-                               get_unit_expr = NULL) {
+                               get_unit_expr = NULL,
+                               unit_conversion = FALSE) {
   assert_vars(by_vars)
   assert_data_frame(dataset, required_vars = exprs(!!!by_vars, PARAMCD, AVAL))
   assert_character_scalar(numerator_code)
@@ -498,6 +507,7 @@ derive_param_ratio <- function(dataset,
   filter <- assert_filter_cond(enexpr(filter), optional = TRUE)
   assert_vars(constant_by_vars, optional = TRUE)
   get_unit_expr <- assert_expr(enexpr(get_unit_expr), optional = TRUE)
+  assert_logical_scalar(unit_conversion)
 
   if (constant_numerator && constant_denominator) {
     cli_abort(
@@ -514,7 +524,7 @@ derive_param_ratio <- function(dataset,
 
   ### If `get_unit_expr` provided then check units and enable units conversion ----
 
-  if (!missing(get_unit_expr) && !is.null(get_unit_expr)) {
+  if (unit_conversion && !missing(get_unit_expr) && !is.null(get_unit_expr)) {
     # If the input parameters are measured in different units
     # but are convertible from one to another (and this kind of conversion supported)
     # then modify the formula in order to perform units conversion on the fly
@@ -531,19 +541,18 @@ derive_param_ratio <- function(dataset,
         param_units[[numerator_code]]
       )
 
-      if (!is.na(conv_factor)) {
-        ratio_formula <- expr(
-          !!sym(paste0("AVAL.", numerator_code)) / (
-            !!sym(paste0("AVAL.", denominator_code)) * !!conv_factor
-          )
+      # Adjust formula
+      ratio_formula <- expr(
+        !!sym(paste0("AVAL.", numerator_code)) / (
+          !!sym(paste0("AVAL.", denominator_code)) * !!conv_factor
         )
+      )
 
-        cli_alert_info(
-          "ALERT: Unit conversion performed for {.val {denominator_code}}. Values converted from
-          {.val {param_units[[denominator_code]]}} to {.val {param_units[[numerator_code]]}}.",
-          wrap = TRUE
-        )
-      }
+      cli_alert_info(
+        "ALERT: Unit conversion performed for {.val {denominator_code}}. Values converted from
+        {.val {param_units[[denominator_code]]}} to {.val {param_units[[numerator_code]]}}.",
+        wrap = TRUE
+      )
     }
   }
 
@@ -591,26 +600,33 @@ NULL
 #> NULL
 
 #' @description `get_conv_factor()` extracts a conversion factor for a pair of units.
-#' Returns `NA` if units are not supported/convertible.
+#' Fails with error if units are not supported/convertible.
 #'
 #' @rdname unit-conversion
 #' @keywords internal
 get_conv_factor <- function(from_unit, to_unit) {
   # Get all conversion factors supported
   conv_factors_all <- get_conv_factors_all()
 
-  # Return conversion factor if units are supported and convertible
+  # Look up for a conversion factor if units are supported and convertible
+  conv_factor <- NULL
+
   for (unit_category in names(conv_factors_all)) {
     if (all(c(from_unit, to_unit) %in% names(conv_factors_all[[unit_category]]))) {
-      return(
-        conv_factors_all[[unit_category]][[from_unit]] /
-          conv_factors_all[[unit_category]][[to_unit]]
-      )
+      conv_factor <- conv_factors_all[[unit_category]][[from_unit]] /
+        conv_factors_all[[unit_category]][[to_unit]]
     }
   }
 
-  # If units are not supported/convertible
-  return(NA_real_)
+  # Fail if conversion for the provided units is not supported
+  if (is.null(conv_factor)) {
+    cli_abort(
+      "Conversion for a pair of units {.val {c(from_unit, to_unit)}} is not supported."
+    )
+  }
+
+  # Return conversion factor
+  conv_factor
 }
 
 #' @description `get_conv_factors_all()` returns all conversion factors supported.

diff --git a/man/assert_unit.Rd b/man/assert_unit.Rd
diff --git a/man/derive_param_ratio.Rd b/man/derive_param_ratio.Rd
diff --git a/man/unit-conversion.Rd b/man/unit-conversion.Rd
diff --git a/tests/testthat/test-derive_param_ratio.R b/tests/testthat/test-derive_param_ratio.R
@@ -175,7 +175,8 @@ test_that(
         PARAMCD = "WAISTHIP",
         PARAM = "Waist to Hip Ratio"
       ),
-      get_unit_expr = admiral::extract_unit(PARAM)
+      get_unit_expr = admiral::extract_unit(PARAM),
+      unit_conversion = TRUE
     ) %>%
       filter(PARAMCD == "WAISTHIP")
 

diff --git a/tests/testthat/test-get_conv_factor.R b/tests/testthat/test-get_conv_factor.R
@@ -13,8 +13,7 @@ test_that("get_conv_factor Test 2: Indirect conversion factor for length (via cm
 })
 
 test_that("get_conv_factor Test 3: Inconvertible units", {
-  expect_equal(
-    get_conv_factor("cm", "kg"),
-    NA_real_
+  expect_error(
+    get_conv_factor("cm", "kg")
   )
 })