Closes #31 wrapper functions for waist/hip and waist/height ratio (#33)

* (#31): wrapper functions for waist/hip and waist/height ratio * (#31): Apply styler::style_file() to R-files * (#31): Fix lintr warnings + Roxygenize * (#31): Move derive_param_ratio to {admiral} * #31 Get derive_param_ratio back as not exported * #31 Fix style and update WORDLIST * (#31): Units conversion on the fly * (#31): Removed hyphens from PARAM and added a couple of unit tests * #31 Get rid of {units} package * (#31): Update keywords * Update R/derive_advs_params.R Co-authored-by: Edoardo Mancini <[email protected]> * Apply suggestions from code review Co-authored-by: Edoardo Mancini <[email protected]> * Addressed review comments * Remove my_first_fcn * Updated WORDLIST * Update as per review comments * Apply suggestions from code review Co-authored-by: Anders Askeland <[email protected]> * Update as per review comments * Fix broken code after applying suggestion from code review * Update as per review comments * Update WORDLIST * Refined code/documentation and added more tests * Added conversion factors in documentation * Apply suggestions from code review Co-authored-by: Edoardo Mancini <[email protected]> * Roxygenize after applying suggestions from code review * Fix lintr issues after applying suggestions from code review * Unit tests for get_conv_factor * One more test to reach 100% test coverage --------- Co-authored-by: Edoardo Mancini <[email protected]> Co-authored-by: Anders Askeland <[email protected]>
pharmaverse · Nov 1, 2024 · 6f18ffe · 6f18ffe
1 parent f29b18d
commit 6f18ffe
Show file tree

Hide file tree

Showing 21 changed files with 1,914 additions and 86 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -24,11 +24,13 @@ Depends:
 Imports:
     admiral (>= 1.1.1),
     admiraldev (>= 1.0.0),
+    cli (>= 3.6.2),
     dplyr (>= 0.8.4),
     stringr (>= 1.4.0),
     lifecycle (>= 0.1.0),
     lubridate (>= 1.7.4),
     magrittr (>= 1.5),
+    purrr (>= 0.3.3),
     rlang (>= 0.4.4),
     tidyselect (>= 1.0.0)
 Suggests:

diff --git a/NAMESPACE b/NAMESPACE
@@ -1,6 +1,22 @@
 # Generated by roxygen2: do not edit by hand
 
-export(hello_admiral)
+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)
+importFrom(admiraldev,assert_expr)
+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_vars)
+importFrom(admiraldev,assert_varval_list)
+importFrom(admiraldev,expect_dfs_equal)
+importFrom(cli,cli_abort)
+importFrom(cli,cli_alert_info)
 importFrom(dplyr,arrange)
 importFrom(dplyr,bind_cols)
 importFrom(dplyr,bind_rows)
@@ -30,6 +46,7 @@ importFrom(dplyr,summarise)
 importFrom(dplyr,summarise_at)
 importFrom(dplyr,tibble)
 importFrom(dplyr,transmute)
+importFrom(dplyr,tribble)
 importFrom(dplyr,ungroup)
 importFrom(dplyr,union)
 importFrom(dplyr,vars)
@@ -53,6 +70,8 @@ importFrom(lubridate,years)
 importFrom(lubridate,ymd)
 importFrom(lubridate,ymd_hms)
 importFrom(magrittr,"%>%")
+importFrom(purrr,discard_at)
+importFrom(rlang,"%||%")
 importFrom(rlang,":=")
 importFrom(rlang,.data)
 importFrom(rlang,abort)
@@ -64,12 +83,14 @@ importFrom(rlang,call_name)
 importFrom(rlang,caller_env)
 importFrom(rlang,current_env)
 importFrom(rlang,enexpr)
+importFrom(rlang,enexprs)
 importFrom(rlang,enquo)
 importFrom(rlang,eval_bare)
 importFrom(rlang,eval_tidy)
 importFrom(rlang,expr)
 importFrom(rlang,expr_interp)
 importFrom(rlang,expr_label)
+importFrom(rlang,exprs)
 importFrom(rlang,f_lhs)
 importFrom(rlang,f_rhs)
 importFrom(rlang,inform)
@@ -105,6 +126,7 @@ importFrom(stringr,str_c)
 importFrom(stringr,str_detect)
 importFrom(stringr,str_extract)
 importFrom(stringr,str_glue)
+importFrom(stringr,str_glue_data)
 importFrom(stringr,str_remove)
 importFrom(stringr,str_remove_all)
 importFrom(stringr,str_replace)

diff --git a/R/admiralmetabolic-package.R b/R/admiralmetabolic-package.R
@@ -1,21 +1,28 @@
 #' @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 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
 #'             if_else mutate mutate_at mutate_if n pull rename rename_at row_number select slice
 #'             starts_with transmute ungroup vars n_distinct union distinct
-#'             summarise_at summarise coalesce bind_cols na_if tibble
+#'             summarise_at summarise coalesce bind_cols na_if tibble tribble
 #' @importFrom magrittr %>%
-#' @importFrom rlang := abort arg_match as_function as_string call2 caller_env
-#'             call_name current_env .data enexpr enquo eval_bare eval_tidy expr
-#'             expr_interp expr_label f_lhs f_rhs inform
+#' @importFrom purrr discard_at
+#' @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
 #'             is_logical is_quosure is_quosures is_symbol new_formula
 #'             parse_expr parse_exprs quo quo_get_expr quo_is_call
 #'             quo_is_missing quo_is_null quo_is_symbol quos quo_squash quo_text
 #'             set_names sym syms type_of warn quo_set_env quo_get_env
 #' @importFrom utils capture.output str
 #' @importFrom stringr str_c str_detect str_extract str_remove str_remove_all
-#'             str_replace str_trim str_to_lower str_to_title str_to_upper str_glue
+#'             str_replace str_trim str_to_lower str_to_title str_to_upper str_glue str_glue_data
 #' @importFrom lubridate as_datetime ceiling_date date days duration floor_date is.Date is.instant
 #'             time_length %--% ymd ymd_hms weeks years hours minutes
 #' @importFrom tidyselect all_of contains vars_select

diff --git a/R/assertions.R b/R/assertions.R
@@ -0,0 +1,63 @@
+#' Asserts That a Parameter is Provided in One of the Expected Units
+#'
+#' @description
+#' `r lifecycle::badge("deprecated")`
+#'
+#' This function is to be *deprecated*. Please use `admiraldev::assert_unit()` instead
+#' once https://github.com/pharmaverse/admiraldev/issues/468 is closed.
+#'
+#' @inherit admiraldev::assert_unit
+#'
+#' @seealso [admiraldev::assert_unit]
+#'
+#' @examples
+#' # See examples of `admiraldev::assert_unit`
+#'
+#' @family internal deprecated
+#' @keywords internal deprecated
+assert_unit <- function(dataset,
+                        param,
+                        required_unit,
+                        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_vector(required_unit)
+  get_unit_expr <- enexpr(get_unit_expr)
+
+  units <- dataset %>%
+    mutate(tmp_unit = !!get_unit_expr) %>%
+    filter(PARAMCD == param & !is.na(.data$tmp_unit)) %>%
+    pull(.data$tmp_unit) %>%
+    unique()
+
+  if (length(units) != 1L) {
+    message <-
+      message %||%
+      "Multiple units {.val {units}} found for {.val {param}}. Please review and update the units."
+
+    cli_abort(
+      message = message,
+      call = call,
+      class = c(class, "assert-admiraldev")
+    )
+  }
+
+  if (tolower(units) %notin% tolower(required_unit)) {
+    message <-
+      message %||%
+      "It is expected that {.val {param}} has unit of {.or {required_unit}}.
+       In the input dataset the unit is {.val {units}}."
+
+    cli_abort(
+      message = message,
+      call = call,
+      class = c(class, "assert-admiraldev")
+    )
+  }
+
+  invisible(dataset)
+}