From 6f18ffe15702e169d271730ce5081a8fcd7be32f Mon Sep 17 00:00:00 2001 From: Andrii Yurovskyi Date: Fri, 1 Nov 2024 14:11:21 +0100 Subject: [PATCH] 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 <53403957+manciniedoardo@users.noreply.github.com> * Apply suggestions from code review Co-authored-by: Edoardo Mancini <53403957+manciniedoardo@users.noreply.github.com> * Addressed review comments * Remove my_first_fcn * Updated WORDLIST * Update as per review comments * Apply suggestions from code review Co-authored-by: Anders Askeland * 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 <53403957+manciniedoardo@users.noreply.github.com> * 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 <53403957+manciniedoardo@users.noreply.github.com> Co-authored-by: Anders Askeland --- DESCRIPTION | 2 + NAMESPACE | 24 +- R/admiralmetabolic-package.R | 17 +- R/assertions.R | 63 ++ R/derive_advs_params.R | 633 ++++++++++++++++++++ R/my_first_fcn.R | 28 - _pkgdown.yml | 7 +- inst/WORDLIST | 4 + man/admiralmetabolic-package.Rd | 3 + man/assert_unit.Rd | 69 +++ man/derive_param_ratio.Rd | 137 +++++ man/derive_param_waisthgt.Rd | 224 +++++++ man/derive_param_waisthip.Rd | 183 ++++++ man/hello_admiral.Rd | 28 - man/roxygen/meta.R | 2 +- man/unit-conversion.Rd | 21 + tests/testthat/test-derive_param_ratio.R | 246 ++++++++ tests/testthat/test-derive_param_waisthgt.R | 156 +++++ tests/testthat/test-derive_param_waisthip.R | 113 ++++ tests/testthat/test-get_conv_factor.R | 20 + tests/testthat/test-my_first_fcn.R | 20 - 21 files changed, 1914 insertions(+), 86 deletions(-) create mode 100644 R/assertions.R create mode 100644 R/derive_advs_params.R delete mode 100644 R/my_first_fcn.R create mode 100644 man/assert_unit.Rd create mode 100644 man/derive_param_ratio.Rd create mode 100644 man/derive_param_waisthgt.Rd create mode 100644 man/derive_param_waisthip.Rd delete mode 100644 man/hello_admiral.Rd create mode 100644 man/unit-conversion.Rd create mode 100644 tests/testthat/test-derive_param_ratio.R create mode 100644 tests/testthat/test-derive_param_waisthgt.R create mode 100644 tests/testthat/test-derive_param_waisthip.R create mode 100644 tests/testthat/test-get_conv_factor.R delete mode 100644 tests/testthat/test-my_first_fcn.R diff --git a/DESCRIPTION b/DESCRIPTION index 67fa74f..c440ab9 100644 --- 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 index 7c6e527..ced3370 100644 --- 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 index 233141f..5b35a9e 100644 --- a/R/admiralmetabolic-package.R +++ b/R/admiralmetabolic-package.R @@ -1,13 +1,20 @@ #' @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 @@ -15,7 +22,7 @@ #' 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 new file mode 100644 index 0000000..024c635 --- /dev/null +++ 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) +} diff --git a/R/derive_advs_params.R b/R/derive_advs_params.R new file mode 100644 index 0000000..2651c28 --- /dev/null +++ b/R/derive_advs_params.R @@ -0,0 +1,633 @@ +#' Adds a Parameter for Waist to Hip Ratio +#' +#' @description Adds a parameter for Waist to Hip Ratio using Waist Circumference and +#' Hip Circumference for each by group (e.g., subject and visit) where the source parameters +#' are available. +#' +#' **Note:** This is a wrapper function for the more generic [`admiral::derive_param_computed()`]. +#' +#' @param dataset Input dataset +#' +#' The variables specified by the `by_vars` argument are expected to be in the dataset. +#' `PARAMCD`, and `AVAL` are expected as well. +#' +#' The variable specified by `by_vars` and `PARAMCD` must be a unique key of the input dataset +#' after restricting it by the filter condition (`filter` argument) and to the parameters +#' specified by `wstcir_code` and `hipcir_code`. +#' +#' @param wstcir_code Waist Circumference parameter code +#' +#' The observations where `PARAMCD` equals the specified value are considered +#' as the Waist Circumference. +#' +#' *Permitted Values:* character value +#' +#' @param hipcir_code Hip Circumference parameter code +#' +#' The observations where `PARAMCD` equals the specified value are considered +#' as the Hip Circumference +#' +#' *Permitted Values:* character value +#' +#' @inheritParams derive_param_ratio +#' +#' @details +#' The analysis value of the new parameter is derived as +#' \deqn{WAISTHIP = \frac{WSTCIR}{HIPCIR}}{WAISTHIP = WSTCIR / HIPCIR} +#' +#' @return The input dataset with the new parameter added. Note, a variable will only +#' be populated in the new parameter rows if it is specified in `by_vars`. +#' +#' @family der_prm_advs +#' @keywords der_prm_advs +#' +#' @export +#' +#' @seealso [admiral::derive_param_computed()] +#' +#' @examples +#' library(tibble) +#' library(rlang) +#' +#' advs <- tribble( +#' ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, +#' "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 110, "cm", "SCREENING", +#' "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 108, "cm", "WEEK 2", +#' "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 107, "cm", "WEEK 3", +#' "01-101-1001", "HIPCIR", "Hip Circumference (cm)", 125, "cm", "SCREENING", +#' "01-101-1001", "HIPCIR", "Hip Circumference (cm)", 124, "cm", "WEEK 2", +#' "01-101-1001", "HIPCIR", "Hip Circumference (cm)", 123, "cm", "WEEK 3", +#' "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 120, "cm", "SCREENING", +#' "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 118, "cm", "WEEK 2", +#' "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 117, "cm", "WEEK 3", +#' "01-101-1002", "HIPCIR", "Hip Circumference (cm)", 135, "cm", "SCREENING", +#' "01-101-1002", "HIPCIR", "Hip Circumference (cm)", 133, "cm", "WEEK 2", +#' "01-101-1002", "HIPCIR", "Hip Circumference (cm)", 132, "cm", "WEEK 3" +#' ) +#' +#' derive_param_waisthip( +#' advs, +#' by_vars = exprs(USUBJID, VISIT), +#' wstcir_code = "WSTCIR", +#' hipcir_code = "HIPCIR", +#' set_values_to = exprs( +#' PARAMCD = "WAISTHIP", +#' PARAM = "Waist to Hip Ratio" +#' ), +#' get_unit_expr = admiral::extract_unit(PARAM) +#' ) +#' +#' # Only adding Waist to Hip Ratio at certain visits +#' +#' derive_param_waisthip( +#' advs, +#' by_vars = exprs(USUBJID, VISIT), +#' wstcir_code = "WSTCIR", +#' hipcir_code = "HIPCIR", +#' set_values_to = exprs( +#' PARAMCD = "WAISTHIP", +#' PARAM = "Waist to Hip Ratio" +#' ), +#' get_unit_expr = admiral::extract_unit(PARAM), +#' filter = VISIT %in% c("SCREENING", "WEEK 3") +#' ) +#' +#' # Automatic conversion is performed when deriving the ratio +#' # if parameters are provided in different units +#' +#' advs <- tribble( +#' ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, +#' "01-101-1001", "HIPCIR", "Hip Circumference (cm)", 125, "cm", "SCREENING", +#' "01-101-1001", "HIPCIR", "Hip Circumference (cm)", 124, "cm", "WEEK 2", +#' "01-101-1001", "HIPCIR", "Hip Circumference (cm)", 123, "cm", "WEEK 3", +#' "01-101-1001", "WSTCIR", "Waist Circumference (in)", 43.31, "in", "SCREENING", +#' "01-101-1001", "WSTCIR", "Waist Circumference (in)", 42.52, "in", "WEEK 2", +#' "01-101-1001", "WSTCIR", "Waist Circumference (in)", 42.13, "in", "WEEK 3", +#' "01-101-1002", "HIPCIR", "Hip Circumference (cm)", 135, "cm", "SCREENING", +#' "01-101-1002", "HIPCIR", "Hip Circumference (cm)", 133, "cm", "WEEK 2", +#' "01-101-1002", "HIPCIR", "Hip Circumference (cm)", 132, "cm", "WEEK 3", +#' "01-101-1002", "WSTCIR", "Waist Circumference (in)", 47.24, "in", "SCREENING", +#' "01-101-1002", "WSTCIR", "Waist Circumference (in)", 46.46, "in", "WEEK 2", +#' "01-101-1002", "WSTCIR", "Waist Circumference (in)", 46.06, "in", "WEEK 3" +#' ) +#' +#' derive_param_waisthip( +#' advs, +#' by_vars = exprs(USUBJID, VISIT), +#' wstcir_code = "WSTCIR", +#' hipcir_code = "HIPCIR", +#' set_values_to = exprs( +#' PARAMCD = "WAISTHIP", +#' PARAM = "Waist to Hip Ratio" +#' ), +#' get_unit_expr = admiral::extract_unit(PARAM) +#' ) +derive_param_waisthip <- function(dataset, + by_vars, + wstcir_code = "WSTCIR", + hipcir_code = "HIPCIR", + set_values_to = exprs(PARAMCD = "WAISTHIP"), + filter = NULL, + get_unit_expr) { + assert_vars(by_vars) + assert_data_frame(dataset, required_vars = exprs(!!!by_vars, PARAMCD, AVAL)) + assert_character_scalar(wstcir_code) + assert_character_scalar(hipcir_code) + assert_varval_list(set_values_to, required_elements = "PARAMCD") + assert_param_does_not_exist(dataset, set_values_to$PARAMCD) + filter <- assert_filter_cond(enexpr(filter), optional = TRUE) + get_unit_expr <- assert_expr(enexpr(get_unit_expr)) + + units_supported <- names(get_conv_factors_all()[["length"]]) + + assert_unit( + dataset, + param = wstcir_code, + required_unit = units_supported, + get_unit_expr = !!get_unit_expr + ) + + assert_unit( + dataset, + param = hipcir_code, + required_unit = units_supported, + get_unit_expr = !!get_unit_expr + ) + + derive_param_ratio( + dataset, + filter = !!filter, + numerator_code = wstcir_code, + denominator_code = hipcir_code, + by_vars = by_vars, + set_values_to = set_values_to, + get_unit_expr = !!get_unit_expr + ) +} + +#' Adds a Parameter for Waist to Height Ratio +#' +#' @description Adds a parameter for Waist to Height Ratio using Waist Circumference and Height +#' for each by group (e.g., subject and visit) where the source parameters are available. +#' +#' **Note:** This is a wrapper function for the more generic [`admiral::derive_param_computed()`]. +#' +#' @param dataset Input dataset +#' +#' The variables specified by the `by_vars` argument are expected to be in the dataset. +#' `PARAMCD`, and `AVAL` are expected as well. +#' +#' The variable specified by `by_vars` and `PARAMCD` must be a unique key of the input dataset +#' after restricting it by the filter condition (`filter` argument) and to the parameters +#' specified by `wstcir_code` and `height_code`. +#' +#' @param wstcir_code Waist Circumference parameter code +#' +#' The observations where `PARAMCD` equals the specified value are considered +#' as the Waist Circumference. +#' +#' *Permitted Values:* character value +#' +#' @param height_code Height parameter code +#' +#' The observations where `PARAMCD` equals the specified value are considered as the Height. +#' +#' *Permitted Values:* character value +#' +#' @param constant_by_vars By variables for when Height is constant +#' +#' When Height is constant, the Height parameters (measured only once) are merged +#' to the other parameters using the specified variables. +#' +#' If Height is constant (e.g. only measured once at screening or baseline) then use +#' `constant_by_vars` to select the subject-level variable to merge on (e.g. `USUBJID`). +#' This will produce Waist to Height Ratio at all visits where Waist Circumference is measured. +#' Otherwise it will only be calculated at visits with both Height and Waist Circumference +#' collected. +#' +#' *Permitted Values*: list of variables created by `exprs()`, e.g. `exprs(USUBJID, VISIT)` +#' +#' @inheritParams derive_param_ratio +#' +#' @details +#' The analysis value of the new parameter is derived as +#' \deqn{WAISTHGT = \frac{WSTCIR}{HEIGHT}}{WAISTHGT = WSTCIR / HEIGHT} +#' +#' @return The input dataset with the new parameter added. Note, a variable will only +#' be populated in the new parameter rows if it is specified in `by_vars`. +#' +#' @family der_prm_advs +#' @keywords der_prm_advs +#' +#' @export +#' +#' @seealso [admiral::derive_param_computed()] +#' +#' @examples +#' library(tibble) +#' library(rlang) +#' +#' # Example 1: Derive Waist to Height Ratio where Height is measured only once +#' +#' advs <- tribble( +#' ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, +#' "01-101-1001", "HEIGHT", "Height (cm)", 147, "cm", "SCREENING", +#' "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 110, "cm", "SCREENING", +#' "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 108, "cm", "WEEK 2", +#' "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 107, "cm", "WEEK 3", +#' "01-101-1002", "HEIGHT", "Height (cm)", 163, "cm", "SCREENING", +#' "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 120, "cm", "SCREENING", +#' "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 118, "cm", "WEEK 2", +#' "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 117, "cm", "WEEK 3", +#' ) +#' +#' derive_param_waisthgt( +#' advs, +#' by_vars = exprs(USUBJID, VISIT), +#' wstcir_code = "WSTCIR", +#' height_code = "HEIGHT", +#' set_values_to = exprs( +#' PARAMCD = "WAISTHGT", +#' PARAM = "Waist to Height Ratio" +#' ), +#' constant_by_vars = exprs(USUBJID), +#' get_unit_expr = admiral::extract_unit(PARAM) +#' ) +#' +#' # Example 2: Same as above but only adding Waist to Height Ratio +#' # at certain visits +#' +#' derive_param_waisthgt( +#' advs, +#' by_vars = exprs(USUBJID, VISIT), +#' wstcir_code = "WSTCIR", +#' height_code = "HEIGHT", +#' set_values_to = exprs( +#' PARAMCD = "WAISTHGT", +#' PARAM = "Waist to Height Ratio" +#' ), +#' constant_by_vars = exprs(USUBJID), +#' get_unit_expr = admiral::extract_unit(PARAM), +#' filter = VISIT %in% c("SCREENING", "WEEK 3") +#' ) +#' +#' # Example 3: Pediatric study where Height and Waist Circumference +#' # are measured multiple times +#' +#' advs <- tribble( +#' ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, +#' "01-101-1001", "HEIGHT", "Height (cm)", 147, "cm", "SCREENING", +#' "01-101-1001", "HEIGHT", "Height (cm)", 148, "cm", "WEEK 2", +#' "01-101-1001", "HEIGHT", "Height (cm)", 149, "cm", "WEEK 3", +#' "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 100, "cm", "SCREENING", +#' "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 99, "cm", "WEEK 2", +#' "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 98, "cm", "WEEK 3", +#' "01-101-1002", "HEIGHT", "Height (cm)", 163, "cm", "SCREENING", +#' "01-101-1002", "HEIGHT", "Height (cm)", 164, "cm", "WEEK 2", +#' "01-101-1002", "HEIGHT", "Height (cm)", 165, "cm", "WEEK 3", +#' "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 110, "cm", "SCREENING", +#' "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 109, "cm", "WEEK 2", +#' "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 108, "cm", "WEEK 3" +#' ) +#' +#' derive_param_waisthgt( +#' advs, +#' by_vars = exprs(USUBJID, VISIT), +#' wstcir_code = "WSTCIR", +#' height_code = "HEIGHT", +#' set_values_to = exprs( +#' PARAMCD = "WAISTHGT", +#' PARAM = "Waist to Height Ratio" +#' ), +#' get_unit_expr = admiral::extract_unit(PARAM) +#' ) +#' +#' # Example 4: Automatic conversion is performed when deriving the ratio +#' # if parameters are provided in different units (e.g. centimeters and inches) +#' +#' advs <- tribble( +#' ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, +#' "01-101-1001", "HEIGHT", "Height (cm)", 147, "cm", "SCREENING", +#' "01-101-1001", "WSTCIR", "Waist Circumference (in)", 39.37, "in", "SCREENING", +#' "01-101-1001", "WSTCIR", "Waist Circumference (in)", 38.98, "in", "WEEK 2", +#' "01-101-1001", "WSTCIR", "Waist Circumference (in)", 38.58, "in", "WEEK 3", +#' "01-101-1002", "HEIGHT", "Height (cm)", 163, "cm", "SCREENING", +#' "01-101-1002", "WSTCIR", "Waist Circumference (in)", 43.31, "in", "SCREENING", +#' "01-101-1002", "WSTCIR", "Waist Circumference (in)", 42.91, "in", "WEEK 2", +#' "01-101-1002", "WSTCIR", "Waist Circumference (in)", 42.52, "in", "WEEK 3" +#' ) +#' +#' derive_param_waisthgt( +#' advs, +#' by_vars = exprs(USUBJID, VISIT), +#' wstcir_code = "WSTCIR", +#' height_code = "HEIGHT", +#' set_values_to = exprs( +#' PARAMCD = "WAISTHGT", +#' PARAM = "Waist to Height Ratio" +#' ), +#' constant_by_vars = exprs(USUBJID), +#' get_unit_expr = admiral::extract_unit(PARAM) +#' ) +derive_param_waisthgt <- function(dataset, + by_vars, + wstcir_code = "WSTCIR", + height_code = "HEIGHT", + set_values_to = exprs(PARAMCD = "WAISTHGT"), + filter = NULL, + constant_by_vars = NULL, + get_unit_expr) { + assert_vars(by_vars) + assert_data_frame(dataset, required_vars = exprs(!!!by_vars, PARAMCD, AVAL)) + assert_character_scalar(wstcir_code) + assert_character_scalar(height_code) + assert_varval_list(set_values_to, required_elements = "PARAMCD") + assert_param_does_not_exist(dataset, set_values_to$PARAMCD) + filter <- assert_filter_cond(enexpr(filter), optional = TRUE) + assert_vars(constant_by_vars, optional = TRUE) + get_unit_expr <- assert_expr(enexpr(get_unit_expr)) + + units_supported <- names(get_conv_factors_all()[["length"]]) + + assert_unit( + dataset, + param = wstcir_code, + required_unit = units_supported, + get_unit_expr = !!get_unit_expr + ) + + assert_unit( + dataset, + param = height_code, + required_unit = units_supported, + get_unit_expr = !!get_unit_expr + ) + + derive_param_ratio( + dataset, + filter = !!filter, + numerator_code = wstcir_code, + denominator_code = height_code, + by_vars = by_vars, + set_values_to = set_values_to, + constant_numerator = FALSE, + constant_denominator = !is.null(constant_by_vars), + constant_by_vars = constant_by_vars, + get_unit_expr = !!get_unit_expr + ) +} + +#' Adds a Ratio Parameter Computed from the Analysis Value of Other Parameters +#' +#' @description Adds a record for a generic Ratio parameter using two existing parameter +#' (numerator and denominator) each by group (e.g., subject and visit) where the source parameters +#' are available. +#' +#' **Note:** This is a wrapper function for the more generic [`admiral::derive_param_computed()`]. +#' +#' @param dataset Input dataset +#' +#' The variables specified by the `by_vars` argument are expected to be in the dataset. +#' `PARAMCD`, and `AVAL` are expected as well. +#' +#' The variable specified by `by_vars` and `PARAMCD` must be a unique key of the input dataset +#' after restricting it by the filter condition (`filter` argument) and to the parameters +#' specified by `numerator_code` and `denominator_code`. +#' +#' @param numerator_code Numerator parameter code +#' +#' The observations where `PARAMCD` equals the specified value are considered as the numerator. +#' +#' *Permitted Values:* character value +#' +#' @param denominator_code Denominator parameter code +#' +#' The observations where `PARAMCD` equals the specified value are considered as the denominator. +#' +#' *Permitted Values:* character value +#' +#' @param set_values_to Variables to be set +#' +#' The specified variables are set to the specified values for the new +#' observations. For example `exprs(PARAMCD = "RATIO")` defines the parameter code +#' for the new parameter. +#' +#' *Permitted Values:* List of variable-value pairs +#' +#' @param constant_numerator Is numerator parameter constant? +#' +#' It is expected that the parameter code (PARAMCD) specified in `numerator_code` +#' which is required to derive the new parameter is measured only once. For example, +#' if Height to Weight Ratio should be derived and height is measured only once while +#' Weight is measured at each visit. Height could be specified in the `numerator_code` +#' argument and `constant_numerator` is to be set to `TRUE`. +#' +#' *Permitted Values:* logical scalar +#' +#' @param constant_denominator Is denominator parameter constant? +#' +#' It is expected that the parameter code (PARAMCD) specified in `numerator_code` +#' which is required to derive the new parameter is measured only once. For example, +#' if Waist to Height Ratio should be derived and height is measured only once +#' while Waist Circumference is measured at each visit. Height could be specified in +#' the `denominator_code` argument and `constant_denominator` is to be set to `TRUE`. +#' +#' *Permitted Values:* logical scalar +#' +#' @param constant_by_vars By variables for when numerator and/or denominator is constant +#' +#' When numerator and/or denominator is constant, the parameters (measured only once) are merged +#' to the other parameters using the specified variables. +#' +#' If numerator and/or denominator is constant (e.g. only measured once at screening or baseline) +#' then use `constant_by_vars` to select the subject-level variable to merge on (e.g. `USUBJID`). +#' This will produce a generic Ratio parameter at all visits where numerator and/or denominator +#' is measured. Otherwise it will only be calculated at visits with both numerator and denominator +#' parameters collected. +#' +#' *Permitted Values*: list of variables created by `exprs()`, e.g. `exprs(USUBJID, VISIT)` +#' +#' @param get_unit_expr An expression providing the unit of the parameter +#' +#' The result is used to check the units of the input parameters. If the units are not consistent +#' within each parameter, an error will be thrown. +#' +#' Additionally, if the input parameters are measured in different units but are mutually +#' convertible (e.g., centimeters for one parameter and inches for another), an automatic +#' conversion will be performed in order to uniform the values before calculating the ratio. +#' +#' **Note:** Conversion factors come from unit definitions as per CDISC standards. +#' ```{r, echo = FALSE, comment = "", results = "asis"} +#' get_conv_factors_all()[["length"]] %>% +#' discard_at("cm") %>% +#' str_glue_data("
*{names(.)}* is defined as {.} cm") +#' ``` +#' +#' *Permitted Values:* A variable of the input dataset or a function call +#' +#' @inheritParams admiral::derive_param_computed +#' +#' @details +#' The analysis value of the new parameter is derived as +#' \deqn{RATIO = \frac{NUMERATOR}{DENOMINATOR}} +#' +#' +#' @return The input dataset with the new parameter added. Note, a variable will only +#' be populated in the new parameter rows if it is specified in `by_vars`. +#' +#' @family internal +#' @keywords internal +derive_param_ratio <- function(dataset, + by_vars, + numerator_code, + denominator_code, + set_values_to, + constant_numerator = FALSE, + constant_denominator = FALSE, + filter = NULL, + constant_by_vars = NULL, + get_unit_expr = NULL) { + assert_vars(by_vars) + assert_data_frame(dataset, required_vars = exprs(!!!by_vars, PARAMCD, AVAL)) + assert_character_scalar(numerator_code) + assert_character_scalar(denominator_code) + assert_varval_list(set_values_to, required_elements = "PARAMCD") + assert_param_does_not_exist(dataset, set_values_to$PARAMCD) + assert_logical_scalar(constant_numerator) + assert_logical_scalar(constant_denominator) + 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) + + if (constant_numerator && constant_denominator) { + cli_abort( + "Only one of two input parameters are expected to be constant, or none of them." + ) + } + + ### Default formula with no units conversion applied ---- + + ratio_formula <- expr( + !!sym(paste0("AVAL.", numerator_code)) / + !!sym(paste0("AVAL.", denominator_code)) + ) + + ### If `get_unit_expr` provided then check units and enable units conversion ---- + + if (!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 + + param_units <- dataset %>% + mutate(tmp_unit = !!get_unit_expr) %>% + distinct(PARAMCD, .data$tmp_unit) %>% + pull(name = PARAMCD) + + if (param_units[[denominator_code]] != param_units[[numerator_code]]) { + # Find conversion factor for denominator + conv_factor <- get_conv_factor( + param_units[[denominator_code]], + param_units[[numerator_code]] + ) + + if (!is.na(conv_factor)) { + 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 + ) + } + } + } + + ### Identify constant parameters ---- + + parameters <- c(numerator_code, denominator_code) + constant_parameters <- NULL + + if (constant_numerator) { + constant_parameters <- c(constant_parameters, numerator_code) + + parameters <- parameters %>% + setdiff(numerator_code) + } + + if (constant_denominator) { + constant_parameters <- c(constant_parameters, denominator_code) + + parameters <- parameters %>% + setdiff(denominator_code) %>% + (\(x) if (length(x) == 0) NULL else x)() + } + + ### Call the core {admiral} function to derive Ratio parameter ---- + + derive_param_computed( + dataset, + filter = !!filter, + parameters = parameters, + by_vars = by_vars, + set_values_to = exprs( + AVAL = !!ratio_formula, + !!!set_values_to + ), + constant_parameters = constant_parameters, + constant_by_vars = constant_by_vars + ) +} + +#' Unit conversion +#' +#' @name unit-conversion +#' @keywords internal +NULL +#> NULL + +#' @description `get_conv_factor()` extracts a conversion factor for a pair of units. +#' Returns `NA` 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 + 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]] + ) + } + } + + # If units are not supported/convertible + return(NA_real_) +} + +#' @description `get_conv_factors_all()` returns all conversion factors supported. +#' +#' **Note:** Conversion factors come from unit definitions as per CDISC standards. +#' +#' @rdname unit-conversion +#' @keywords internal +get_conv_factors_all <- function() { + list( + # Conversion factors for length relative to centimeters + length = list( + "cm" = 1, + "m" = 100, + "mm" = 0.1, + "in" = 2.54, + "ft" = 30.48 + ) + ) +} diff --git a/R/my_first_fcn.R b/R/my_first_fcn.R deleted file mode 100644 index d0b5269..0000000 --- a/R/my_first_fcn.R +++ /dev/null @@ -1,28 +0,0 @@ -#' Derive Extension Example -#' -#' Says hello admiral -#' -#' @param hw TRUE or FALSE -#' -#' @details In the roxygen documentation you will find tags for family and keywords. -#' This is to create organized sections for the Reference tab on the pkgdown website. -#' You can modify the `_pkgdown.yml` as necessary to create appropriate sections as necessary. -#' Under `./man/roxygen/meta.R`, you will find where to store these family/keywords. -#' -#' @return Happy Message -#' -#' @family der_adxx -#' -#' @keywords der_adxx -#' -#' @export -#' -#' @examples -#' hello_admiral(hw = FALSE) -hello_admiral <- function(hw = TRUE) { - if (hw) { - message("Welcome to the admiral family!") - } else { - message("Welcome to the admiral family!") - } -} diff --git a/_pkgdown.yml b/_pkgdown.yml index b409e9b..d93adec 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -2,6 +2,7 @@ url: https://pharmaverse.github.io/admiralmetabolic template: bootstrap: 5 + math-rendering: mathjax params: bootswatch: flatly repo: @@ -25,10 +26,10 @@ reference: - has_keyword("der_adxx") - title: Derivations for Adding Parameters -- subtitle: ADXX-specific - desc: Parameter Derivation Functions helpful for building the ADXX dataset +- subtitle: ADVS-specific + desc: Parameter Derivation Functions helpful for building the ADVS dataset - contents: - - has_keyword("der_prm_adxx") + - has_keyword("der_prm_advs") - title: Advanced Functions - subtitle: Pre-Defined Source Objects diff --git a/inst/WORDLIST b/inst/WORDLIST index d583e2b..26e8d42 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -36,3 +36,7 @@ renv repo roxygen advs +PARAMCD +prm +admiraldev +github diff --git a/man/admiralmetabolic-package.Rd b/man/admiralmetabolic-package.Rd index 8fc799c..804d819 100644 --- a/man/admiralmetabolic-package.Rd +++ b/man/admiralmetabolic-package.Rd @@ -17,6 +17,9 @@ Useful links: \item \url{https://github.com/pharmaverse/admiraltemplate} } + +Other internal: +\code{\link{derive_param_ratio}()} } \author{ \strong{Maintainer}: Edoardo Mancini \email{edoardo.mancini@roche.com} diff --git a/man/assert_unit.Rd b/man/assert_unit.Rd new file mode 100644 index 0000000..a8d7981 --- /dev/null +++ b/man/assert_unit.Rd @@ -0,0 +1,69 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/assertions.R +\name{assert_unit} +\alias{assert_unit} +\title{Asserts That a Parameter is Provided in One of the Expected Units} +\usage{ +assert_unit( + dataset, + param, + required_unit, + get_unit_expr, + arg_name = rlang::caller_arg(required_unit), + message = NULL, + class = "assert_unit", + call = parent.frame() +) +} +\arguments{ +\item{dataset}{A \code{data.frame}} + +\item{param}{Parameter code of the parameter to check} + +\item{required_unit}{Expected unit} + +\item{get_unit_expr}{Expression used to provide the unit of \code{param}} + +\item{arg_name}{string indicating the label/symbol of the object being checked.} + +\item{message}{string passed to \code{cli::cli_abort(message)}. +When \code{NULL}, default messaging is used (see examples for default messages). +\code{"{arg_name}"} can be used in messaging.} + +\item{class}{Subclass of the condition.} + +\item{call}{The execution environment of a currently running +function, e.g. \code{call = caller_env()}. The corresponding function +call is retrieved and mentioned in error messages as the source +of the error. + +You only need to supply \code{call} when throwing a condition from a +helper function which wouldn't be relevant to mention in the +message. + +Can also be \code{NULL} or a \link[rlang:topic-defuse]{defused function call} to +respectively not display any call or hard-code a code to display. + +For more information about error calls, see \ifelse{html}{\link[rlang:topic-error-call]{Including function calls in error messages}}{\link[rlang:topic-error-call]{Including function calls in error messages}}.} +} +\value{ +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. +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} + +This function is to be \emph{deprecated}. Please use \code{admiraldev::assert_unit()} instead +once https://github.com/pharmaverse/admiraldev/issues/468 is closed. +} +\examples{ +# See examples of `admiraldev::assert_unit` + +} +\seealso{ +\link[admiraldev:assert_unit]{admiraldev::assert_unit} +} +\concept{internal deprecated} +\keyword{deprecated} +\keyword{internal} diff --git a/man/derive_param_ratio.Rd b/man/derive_param_ratio.Rd new file mode 100644 index 0000000..2461f86 --- /dev/null +++ b/man/derive_param_ratio.Rd @@ -0,0 +1,137 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/derive_advs_params.R +\name{derive_param_ratio} +\alias{derive_param_ratio} +\title{Adds a Ratio Parameter Computed from the Analysis Value of Other Parameters} +\usage{ +derive_param_ratio( + dataset, + by_vars, + numerator_code, + denominator_code, + set_values_to, + constant_numerator = FALSE, + constant_denominator = FALSE, + filter = NULL, + constant_by_vars = NULL, + get_unit_expr = NULL +) +} +\arguments{ +\item{dataset}{Input dataset + +The variables specified by the \code{by_vars} argument are expected to be in the dataset. +\code{PARAMCD}, and \code{AVAL} are expected as well. + +The variable specified by \code{by_vars} and \code{PARAMCD} must be a unique key of the input dataset +after restricting it by the filter condition (\code{filter} argument) and to the parameters +specified by \code{numerator_code} and \code{denominator_code}.} + +\item{by_vars}{Grouping variables + +For each group defined by \code{by_vars} an observation is added to the output +dataset. Only variables specified in \code{by_vars} will be populated +in the newly created records. + +\emph{Permitted Values}: list of variables created by \code{exprs()} +e.g. \code{exprs(USUBJID, VISIT)}} + +\item{numerator_code}{Numerator parameter code + +The observations where \code{PARAMCD} equals the specified value are considered as the numerator. + +\emph{Permitted Values:} character value} + +\item{denominator_code}{Denominator parameter code + +The observations where \code{PARAMCD} equals the specified value are considered as the denominator. + +\emph{Permitted Values:} character value} + +\item{set_values_to}{Variables to be set + +The specified variables are set to the specified values for the new +observations. For example \code{exprs(PARAMCD = "RATIO")} defines the parameter code +for the new parameter. + +\emph{Permitted Values:} List of variable-value pairs} + +\item{constant_numerator}{Is numerator parameter constant? + +It is expected that the parameter code (PARAMCD) specified in \code{numerator_code} +which is required to derive the new parameter is measured only once. For example, +if Height to Weight Ratio should be derived and height is measured only once while +Weight is measured at each visit. Height could be specified in the \code{numerator_code} +argument and \code{constant_numerator} is to be set to \code{TRUE}. + +\emph{Permitted Values:} logical scalar} + +\item{constant_denominator}{Is denominator parameter constant? + +It is expected that the parameter code (PARAMCD) specified in \code{numerator_code} +which is required to derive the new parameter is measured only once. For example, +if Waist to Height Ratio should be derived and height is measured only once +while Waist Circumference is measured at each visit. Height could be specified in +the \code{denominator_code} argument and \code{constant_denominator} is to be set to \code{TRUE}. + +\emph{Permitted Values:} logical scalar} + +\item{filter}{Filter condition + +The specified condition is applied to the input dataset before deriving the +new parameter, i.e., only observations fulfilling the condition are taken +into account. + +\emph{Permitted Values:} a condition} + +\item{constant_by_vars}{By variables for when numerator and/or denominator is constant + +When numerator and/or denominator is constant, the parameters (measured only once) are merged +to the other parameters using the specified variables. + +If numerator and/or denominator is constant (e.g. only measured once at screening or baseline) +then use \code{constant_by_vars} to select the subject-level variable to merge on (e.g. \code{USUBJID}). +This will produce a generic Ratio parameter at all visits where numerator and/or denominator +is measured. Otherwise it will only be calculated at visits with both numerator and denominator +parameters collected. + +\emph{Permitted Values}: list of variables created by \code{exprs()}, e.g. \code{exprs(USUBJID, VISIT)}} + +\item{get_unit_expr}{An expression providing the unit of the parameter + +The result is used to check the units of the input parameters. If the units are not consistent +within each parameter, an error will be thrown. + +Additionally, if the input parameters are measured in different units but are mutually +convertible (e.g., centimeters for one parameter and inches for another), an automatic +conversion will be performed in order to uniform the values before calculating the ratio. + +\strong{Note:} Conversion factors come from unit definitions as per CDISC standards. +\if{html}{\out{
}}\emph{m} is defined as 100 cm +\if{html}{\out{
}}\emph{mm} is defined as 0.1 cm +\if{html}{\out{
}}\emph{in} is defined as 2.54 cm +\if{html}{\out{
}}\emph{ft} is defined as 30.48 cm + +\emph{Permitted Values:} A variable of the input dataset or a function call} +} +\value{ +The input dataset with the new parameter added. Note, a variable will only +be populated in the new parameter rows if it is specified in \code{by_vars}. +} +\description{ +Adds a record for a generic Ratio parameter using two existing parameter +(numerator and denominator) each by group (e.g., subject and visit) where the source parameters +are available. + +\strong{Note:} This is a wrapper function for the more generic \code{\link[admiral:derive_param_computed]{admiral::derive_param_computed()}}. +} +\details{ +The analysis value of the new parameter is derived as +\deqn{RATIO = \frac{NUMERATOR}{DENOMINATOR}} +} +\seealso{ +Other internal: +\code{\link{admiralmetabolic-package}} +} +\concept{internal} +\keyword{internal} diff --git a/man/derive_param_waisthgt.Rd b/man/derive_param_waisthgt.Rd new file mode 100644 index 0000000..3523d36 --- /dev/null +++ b/man/derive_param_waisthgt.Rd @@ -0,0 +1,224 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/derive_advs_params.R +\name{derive_param_waisthgt} +\alias{derive_param_waisthgt} +\title{Adds a Parameter for Waist to Height Ratio} +\usage{ +derive_param_waisthgt( + dataset, + by_vars, + wstcir_code = "WSTCIR", + height_code = "HEIGHT", + set_values_to = exprs(PARAMCD = "WAISTHGT"), + filter = NULL, + constant_by_vars = NULL, + get_unit_expr +) +} +\arguments{ +\item{dataset}{Input dataset + +The variables specified by the \code{by_vars} argument are expected to be in the dataset. +\code{PARAMCD}, and \code{AVAL} are expected as well. + +The variable specified by \code{by_vars} and \code{PARAMCD} must be a unique key of the input dataset +after restricting it by the filter condition (\code{filter} argument) and to the parameters +specified by \code{wstcir_code} and \code{height_code}.} + +\item{by_vars}{Grouping variables + +For each group defined by \code{by_vars} an observation is added to the output +dataset. Only variables specified in \code{by_vars} will be populated +in the newly created records. + +\emph{Permitted Values}: list of variables created by \code{exprs()} +e.g. \code{exprs(USUBJID, VISIT)}} + +\item{wstcir_code}{Waist Circumference parameter code + +The observations where \code{PARAMCD} equals the specified value are considered +as the Waist Circumference. + +\emph{Permitted Values:} character value} + +\item{height_code}{Height parameter code + +The observations where \code{PARAMCD} equals the specified value are considered as the Height. + +\emph{Permitted Values:} character value} + +\item{set_values_to}{Variables to be set + +The specified variables are set to the specified values for the new +observations. For example \code{exprs(PARAMCD = "RATIO")} defines the parameter code +for the new parameter. + +\emph{Permitted Values:} List of variable-value pairs} + +\item{filter}{Filter condition + +The specified condition is applied to the input dataset before deriving the +new parameter, i.e., only observations fulfilling the condition are taken +into account. + +\emph{Permitted Values:} a condition} + +\item{constant_by_vars}{By variables for when Height is constant + +When Height is constant, the Height parameters (measured only once) are merged +to the other parameters using the specified variables. + +If Height is constant (e.g. only measured once at screening or baseline) then use +\code{constant_by_vars} to select the subject-level variable to merge on (e.g. \code{USUBJID}). +This will produce Waist to Height Ratio at all visits where Waist Circumference is measured. +Otherwise it will only be calculated at visits with both Height and Waist Circumference +collected. + +\emph{Permitted Values}: list of variables created by \code{exprs()}, e.g. \code{exprs(USUBJID, VISIT)}} + +\item{get_unit_expr}{An expression providing the unit of the parameter + +The result is used to check the units of the input parameters. If the units are not consistent +within each parameter, an error will be thrown. + +Additionally, if the input parameters are measured in different units but are mutually +convertible (e.g., centimeters for one parameter and inches for another), an automatic +conversion will be performed in order to uniform the values before calculating the ratio. + +\strong{Note:} Conversion factors come from unit definitions as per CDISC standards. +\if{html}{\out{
}}\emph{m} is defined as 100 cm +\if{html}{\out{
}}\emph{mm} is defined as 0.1 cm +\if{html}{\out{
}}\emph{in} is defined as 2.54 cm +\if{html}{\out{
}}\emph{ft} is defined as 30.48 cm + +\emph{Permitted Values:} A variable of the input dataset or a function call} +} +\value{ +The input dataset with the new parameter added. Note, a variable will only +be populated in the new parameter rows if it is specified in \code{by_vars}. +} +\description{ +Adds a parameter for Waist to Height Ratio using Waist Circumference and Height +for each by group (e.g., subject and visit) where the source parameters are available. + +\strong{Note:} This is a wrapper function for the more generic \code{\link[admiral:derive_param_computed]{admiral::derive_param_computed()}}. +} +\details{ +The analysis value of the new parameter is derived as +\deqn{WAISTHGT = \frac{WSTCIR}{HEIGHT}}{WAISTHGT = WSTCIR / HEIGHT} +} +\examples{ +library(tibble) +library(rlang) + +# Example 1: Derive Waist to Height Ratio where Height is measured only once + +advs <- tribble( + ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, + "01-101-1001", "HEIGHT", "Height (cm)", 147, "cm", "SCREENING", + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 110, "cm", "SCREENING", + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 108, "cm", "WEEK 2", + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 107, "cm", "WEEK 3", + "01-101-1002", "HEIGHT", "Height (cm)", 163, "cm", "SCREENING", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 120, "cm", "SCREENING", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 118, "cm", "WEEK 2", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 117, "cm", "WEEK 3", +) + +derive_param_waisthgt( + advs, + by_vars = exprs(USUBJID, VISIT), + wstcir_code = "WSTCIR", + height_code = "HEIGHT", + set_values_to = exprs( + PARAMCD = "WAISTHGT", + PARAM = "Waist to Height Ratio" + ), + constant_by_vars = exprs(USUBJID), + get_unit_expr = admiral::extract_unit(PARAM) +) + +# Example 2: Same as above but only adding Waist to Height Ratio +# at certain visits + +derive_param_waisthgt( + advs, + by_vars = exprs(USUBJID, VISIT), + wstcir_code = "WSTCIR", + height_code = "HEIGHT", + set_values_to = exprs( + PARAMCD = "WAISTHGT", + PARAM = "Waist to Height Ratio" + ), + constant_by_vars = exprs(USUBJID), + get_unit_expr = admiral::extract_unit(PARAM), + filter = VISIT \%in\% c("SCREENING", "WEEK 3") +) + +# Example 3: Pediatric study where Height and Waist Circumference +# are measured multiple times + +advs <- tribble( + ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, + "01-101-1001", "HEIGHT", "Height (cm)", 147, "cm", "SCREENING", + "01-101-1001", "HEIGHT", "Height (cm)", 148, "cm", "WEEK 2", + "01-101-1001", "HEIGHT", "Height (cm)", 149, "cm", "WEEK 3", + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 100, "cm", "SCREENING", + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 99, "cm", "WEEK 2", + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 98, "cm", "WEEK 3", + "01-101-1002", "HEIGHT", "Height (cm)", 163, "cm", "SCREENING", + "01-101-1002", "HEIGHT", "Height (cm)", 164, "cm", "WEEK 2", + "01-101-1002", "HEIGHT", "Height (cm)", 165, "cm", "WEEK 3", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 110, "cm", "SCREENING", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 109, "cm", "WEEK 2", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 108, "cm", "WEEK 3" +) + +derive_param_waisthgt( + advs, + by_vars = exprs(USUBJID, VISIT), + wstcir_code = "WSTCIR", + height_code = "HEIGHT", + set_values_to = exprs( + PARAMCD = "WAISTHGT", + PARAM = "Waist to Height Ratio" + ), + get_unit_expr = admiral::extract_unit(PARAM) +) + +# Example 4: Automatic conversion is performed when deriving the ratio +# if parameters are provided in different units (e.g. centimeters and inches) + +advs <- tribble( + ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, + "01-101-1001", "HEIGHT", "Height (cm)", 147, "cm", "SCREENING", + "01-101-1001", "WSTCIR", "Waist Circumference (in)", 39.37, "in", "SCREENING", + "01-101-1001", "WSTCIR", "Waist Circumference (in)", 38.98, "in", "WEEK 2", + "01-101-1001", "WSTCIR", "Waist Circumference (in)", 38.58, "in", "WEEK 3", + "01-101-1002", "HEIGHT", "Height (cm)", 163, "cm", "SCREENING", + "01-101-1002", "WSTCIR", "Waist Circumference (in)", 43.31, "in", "SCREENING", + "01-101-1002", "WSTCIR", "Waist Circumference (in)", 42.91, "in", "WEEK 2", + "01-101-1002", "WSTCIR", "Waist Circumference (in)", 42.52, "in", "WEEK 3" +) + +derive_param_waisthgt( + advs, + by_vars = exprs(USUBJID, VISIT), + wstcir_code = "WSTCIR", + height_code = "HEIGHT", + set_values_to = exprs( + PARAMCD = "WAISTHGT", + PARAM = "Waist to Height Ratio" + ), + constant_by_vars = exprs(USUBJID), + get_unit_expr = admiral::extract_unit(PARAM) +) +} +\seealso{ +\code{\link[admiral:derive_param_computed]{admiral::derive_param_computed()}} + +ADVS Functions for adding Parameters: +\code{\link{derive_param_waisthip}()} +} +\concept{der_prm_advs} +\keyword{der_prm_advs} diff --git a/man/derive_param_waisthip.Rd b/man/derive_param_waisthip.Rd new file mode 100644 index 0000000..fd9bf7f --- /dev/null +++ b/man/derive_param_waisthip.Rd @@ -0,0 +1,183 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/derive_advs_params.R +\name{derive_param_waisthip} +\alias{derive_param_waisthip} +\title{Adds a Parameter for Waist to Hip Ratio} +\usage{ +derive_param_waisthip( + dataset, + by_vars, + wstcir_code = "WSTCIR", + hipcir_code = "HIPCIR", + set_values_to = exprs(PARAMCD = "WAISTHIP"), + filter = NULL, + get_unit_expr +) +} +\arguments{ +\item{dataset}{Input dataset + +The variables specified by the \code{by_vars} argument are expected to be in the dataset. +\code{PARAMCD}, and \code{AVAL} are expected as well. + +The variable specified by \code{by_vars} and \code{PARAMCD} must be a unique key of the input dataset +after restricting it by the filter condition (\code{filter} argument) and to the parameters +specified by \code{wstcir_code} and \code{hipcir_code}.} + +\item{by_vars}{Grouping variables + +For each group defined by \code{by_vars} an observation is added to the output +dataset. Only variables specified in \code{by_vars} will be populated +in the newly created records. + +\emph{Permitted Values}: list of variables created by \code{exprs()} +e.g. \code{exprs(USUBJID, VISIT)}} + +\item{wstcir_code}{Waist Circumference parameter code + +The observations where \code{PARAMCD} equals the specified value are considered +as the Waist Circumference. + +\emph{Permitted Values:} character value} + +\item{hipcir_code}{Hip Circumference parameter code + +The observations where \code{PARAMCD} equals the specified value are considered +as the Hip Circumference + +\emph{Permitted Values:} character value} + +\item{set_values_to}{Variables to be set + +The specified variables are set to the specified values for the new +observations. For example \code{exprs(PARAMCD = "RATIO")} defines the parameter code +for the new parameter. + +\emph{Permitted Values:} List of variable-value pairs} + +\item{filter}{Filter condition + +The specified condition is applied to the input dataset before deriving the +new parameter, i.e., only observations fulfilling the condition are taken +into account. + +\emph{Permitted Values:} a condition} + +\item{get_unit_expr}{An expression providing the unit of the parameter + +The result is used to check the units of the input parameters. If the units are not consistent +within each parameter, an error will be thrown. + +Additionally, if the input parameters are measured in different units but are mutually +convertible (e.g., centimeters for one parameter and inches for another), an automatic +conversion will be performed in order to uniform the values before calculating the ratio. + +\strong{Note:} Conversion factors come from unit definitions as per CDISC standards. +\if{html}{\out{
}}\emph{m} is defined as 100 cm +\if{html}{\out{
}}\emph{mm} is defined as 0.1 cm +\if{html}{\out{
}}\emph{in} is defined as 2.54 cm +\if{html}{\out{
}}\emph{ft} is defined as 30.48 cm + +\emph{Permitted Values:} A variable of the input dataset or a function call} +} +\value{ +The input dataset with the new parameter added. Note, a variable will only +be populated in the new parameter rows if it is specified in \code{by_vars}. +} +\description{ +Adds a parameter for Waist to Hip Ratio using Waist Circumference and +Hip Circumference for each by group (e.g., subject and visit) where the source parameters +are available. + +\strong{Note:} This is a wrapper function for the more generic \code{\link[admiral:derive_param_computed]{admiral::derive_param_computed()}}. +} +\details{ +The analysis value of the new parameter is derived as +\deqn{WAISTHIP = \frac{WSTCIR}{HIPCIR}}{WAISTHIP = WSTCIR / HIPCIR} +} +\examples{ +library(tibble) +library(rlang) + +advs <- tribble( + ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 110, "cm", "SCREENING", + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 108, "cm", "WEEK 2", + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 107, "cm", "WEEK 3", + "01-101-1001", "HIPCIR", "Hip Circumference (cm)", 125, "cm", "SCREENING", + "01-101-1001", "HIPCIR", "Hip Circumference (cm)", 124, "cm", "WEEK 2", + "01-101-1001", "HIPCIR", "Hip Circumference (cm)", 123, "cm", "WEEK 3", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 120, "cm", "SCREENING", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 118, "cm", "WEEK 2", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 117, "cm", "WEEK 3", + "01-101-1002", "HIPCIR", "Hip Circumference (cm)", 135, "cm", "SCREENING", + "01-101-1002", "HIPCIR", "Hip Circumference (cm)", 133, "cm", "WEEK 2", + "01-101-1002", "HIPCIR", "Hip Circumference (cm)", 132, "cm", "WEEK 3" +) + +derive_param_waisthip( + advs, + by_vars = exprs(USUBJID, VISIT), + wstcir_code = "WSTCIR", + hipcir_code = "HIPCIR", + set_values_to = exprs( + PARAMCD = "WAISTHIP", + PARAM = "Waist to Hip Ratio" + ), + get_unit_expr = admiral::extract_unit(PARAM) +) + +# Only adding Waist to Hip Ratio at certain visits + +derive_param_waisthip( + advs, + by_vars = exprs(USUBJID, VISIT), + wstcir_code = "WSTCIR", + hipcir_code = "HIPCIR", + set_values_to = exprs( + PARAMCD = "WAISTHIP", + PARAM = "Waist to Hip Ratio" + ), + get_unit_expr = admiral::extract_unit(PARAM), + filter = VISIT \%in\% c("SCREENING", "WEEK 3") +) + +# Automatic conversion is performed when deriving the ratio +# if parameters are provided in different units + +advs <- tribble( + ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, + "01-101-1001", "HIPCIR", "Hip Circumference (cm)", 125, "cm", "SCREENING", + "01-101-1001", "HIPCIR", "Hip Circumference (cm)", 124, "cm", "WEEK 2", + "01-101-1001", "HIPCIR", "Hip Circumference (cm)", 123, "cm", "WEEK 3", + "01-101-1001", "WSTCIR", "Waist Circumference (in)", 43.31, "in", "SCREENING", + "01-101-1001", "WSTCIR", "Waist Circumference (in)", 42.52, "in", "WEEK 2", + "01-101-1001", "WSTCIR", "Waist Circumference (in)", 42.13, "in", "WEEK 3", + "01-101-1002", "HIPCIR", "Hip Circumference (cm)", 135, "cm", "SCREENING", + "01-101-1002", "HIPCIR", "Hip Circumference (cm)", 133, "cm", "WEEK 2", + "01-101-1002", "HIPCIR", "Hip Circumference (cm)", 132, "cm", "WEEK 3", + "01-101-1002", "WSTCIR", "Waist Circumference (in)", 47.24, "in", "SCREENING", + "01-101-1002", "WSTCIR", "Waist Circumference (in)", 46.46, "in", "WEEK 2", + "01-101-1002", "WSTCIR", "Waist Circumference (in)", 46.06, "in", "WEEK 3" +) + +derive_param_waisthip( + advs, + by_vars = exprs(USUBJID, VISIT), + wstcir_code = "WSTCIR", + hipcir_code = "HIPCIR", + set_values_to = exprs( + PARAMCD = "WAISTHIP", + PARAM = "Waist to Hip Ratio" + ), + get_unit_expr = admiral::extract_unit(PARAM) +) +} +\seealso{ +\code{\link[admiral:derive_param_computed]{admiral::derive_param_computed()}} + +ADVS Functions for adding Parameters: +\code{\link{derive_param_waisthgt}()} +} +\concept{der_prm_advs} +\keyword{der_prm_advs} diff --git a/man/hello_admiral.Rd b/man/hello_admiral.Rd deleted file mode 100644 index 31d1c3c..0000000 --- a/man/hello_admiral.Rd +++ /dev/null @@ -1,28 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/my_first_fcn.R -\name{hello_admiral} -\alias{hello_admiral} -\title{Derive Extension Example} -\usage{ -hello_admiral(hw = TRUE) -} -\arguments{ -\item{hw}{TRUE or FALSE} -} -\value{ -Happy Message -} -\description{ -Says hello admiral -} -\details{ -In the roxygen documentation you will find tags for family and keywords. -This is to create organized sections for the Reference tab on the pkgdown website. -You can modify the \verb{_pkgdown.yml} as necessary to create appropriate sections as necessary. -Under \code{./man/roxygen/meta.R}, you will find where to store these family/keywords. -} -\examples{ -hello_admiral(hw = FALSE) -} -\concept{der_adxx} -\keyword{der_adxx} diff --git a/man/roxygen/meta.R b/man/roxygen/meta.R index 44feadd..4843f06 100644 --- a/man/roxygen/meta.R +++ b/man/roxygen/meta.R @@ -1,7 +1,7 @@ list( rd_family_title = list( der_adxx = "ADXX Functions that returns variable appended to dataset: ", - der_prm_adxx = "ADXX Functions for adding Parameters: ", + der_prm_advs = "ADVS Functions for adding Parameters: ", com_adxx = "ADXX Functions that returns a vector: ", utils_ds_chk = "Utilities for Dataset Checking: ", utils_fil = "Utilities for Filtering Observations: ", diff --git a/man/unit-conversion.Rd b/man/unit-conversion.Rd new file mode 100644 index 0000000..8210026 --- /dev/null +++ b/man/unit-conversion.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/derive_advs_params.R +\name{unit-conversion} +\alias{unit-conversion} +\alias{get_conv_factor} +\alias{get_conv_factors_all} +\title{Unit conversion} +\usage{ +get_conv_factor(from_unit, to_unit) + +get_conv_factors_all() +} +\description{ +\code{get_conv_factor()} extracts a conversion factor for a pair of units. +Returns \code{NA} if units are not supported/convertible. + +\code{get_conv_factors_all()} returns all conversion factors supported. + +\strong{Note:} Conversion factors come from unit definitions as per CDISC standards. +} +\keyword{internal} diff --git a/tests/testthat/test-derive_param_ratio.R b/tests/testthat/test-derive_param_ratio.R new file mode 100644 index 0000000..9acb368 --- /dev/null +++ b/tests/testthat/test-derive_param_ratio.R @@ -0,0 +1,246 @@ +test_that( + "derive_param_ratio Test 1: Cross-check with derive_param_computed()", + { + input <- tribble( + ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, + "01-101-1001", "HIPCIR", "Hip Circumference (cm)", 125, "cm", "SCREENING", + "01-101-1001", "HIPCIR", "Hip Circumference (cm)", 124, "cm", "WEEK 2", + "01-101-1001", "HIPCIR", "Hip Circumference (cm)", 123, "cm", "WEEK 3", + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 110, "cm", "SCREENING", + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 108, "cm", "WEEK 2", + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 107, "cm", "WEEK 3", + "01-101-1002", "HIPCIR", "Hip Circumference (cm)", 135, "cm", "SCREENING", + "01-101-1002", "HIPCIR", "Hip Circumference (cm)", 133, "cm", "WEEK 2", + "01-101-1002", "HIPCIR", "Hip Circumference (cm)", 132, "cm", "WEEK 3", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 120, "cm", "SCREENING", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 118, "cm", "WEEK 2", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 117, "cm", "WEEK 3" + ) + + wrapper_output <- derive_param_ratio( + input, + by_vars = exprs(USUBJID, VISIT), + numerator_code = "WSTCIR", + denominator_code = "HIPCIR", + set_values_to = exprs( + PARAMCD = "WAISTHIP", + PARAM = "Waist to Hip Ratio" + ) + ) + + expected_output <- derive_param_computed( + input, + parameters = c("WSTCIR", "HIPCIR"), + by_vars = exprs(USUBJID, VISIT), + set_values_to = exprs( + AVAL = AVAL.WSTCIR / AVAL.HIPCIR, + PARAMCD = "WAISTHIP", + PARAM = "Waist to Hip Ratio" + ) + ) + + expect_dfs_equal( + wrapper_output, + expected_output, + keys = c("USUBJID", "PARAMCD", "VISIT") + ) + } +) + +test_that( + "derive_param_computed Test 2: Cross-check with derive_param_computed(), + new observations with constant denominator", + { + input <- tribble( + ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, + "01-101-1001", "HEIGHT", "Height (cm)", 147, "cm", "SCREENING", + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 110, "cm", "SCREENING", + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 108, "cm", "WEEK 2", + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 107, "cm", "WEEK 3", + "01-101-1002", "HEIGHT", "Height (cm)", 163, "cm", "SCREENING", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 120, "cm", "SCREENING", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 118, "cm", "WEEK 2", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 117, "cm", "WEEK 3", + ) + + wrapper_output <- derive_param_ratio( + input, + by_vars = exprs(USUBJID, VISIT), + numerator_code = "WSTCIR", + denominator_code = "HEIGHT", + set_values_to = exprs( + PARAMCD = "WAISTHGT", + PARAM = "Waist to Height Ratio" + ), + constant_denominator = TRUE, + constant_by_vars = exprs(USUBJID) + ) + + expected_output <- derive_param_computed( + input, + parameters = "WSTCIR", + by_vars = exprs(USUBJID, VISIT), + set_values_to = exprs( + AVAL = AVAL.WSTCIR / AVAL.HEIGHT, + PARAMCD = "WAISTHGT", + PARAM = "Waist to Height Ratio" + ), + constant_parameters = "HEIGHT", + constant_by_vars = exprs(USUBJID) + ) + + expect_dfs_equal( + wrapper_output, + expected_output, + keys = c("USUBJID", "PARAMCD", "VISIT") + ) + } +) + +test_that( + "derive_param_computed Test 3: Cross-check with derive_param_computed(), + new observations with constant numerator", + { + input <- tribble( + ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, + "01-101-1001", "HEIGHT", "Height (cm)", 147, "cm", "SCREENING", + "01-101-1001", "WEIGHT", "Weight (kg)", 95, "kg", "SCREENING", + "01-101-1001", "WEIGHT", "Weight (kg)", 94.5, "kg", "WEEK 2", + "01-101-1001", "WEIGHT", "Weight (kg)", 94, "kg", "WEEK 3", + "01-101-1002", "HEIGHT", "Height (cm)", 163, "cm", "SCREENING", + "01-101-1002", "WEIGHT", "Weight (kg)", 105, "kg", "SCREENING", + "01-101-1002", "WEIGHT", "Weight (kg)", 104.5, "kg", "WEEK 2", + "01-101-1002", "WEIGHT", "Weight (kg)", 104, "kg", "WEEK 3" + ) + + wrapper_output <- derive_param_ratio( + input, + by_vars = exprs(USUBJID, VISIT), + numerator_code = "HEIGHT", + denominator_code = "WEIGHT", + set_values_to = exprs( + PARAMCD = "HGTWGT", + PARAM = "Height to Weight Ratio" + ), + constant_numerator = TRUE, + constant_by_vars = exprs(USUBJID) + ) + + expected_output <- derive_param_computed( + input, + parameters = "WEIGHT", + by_vars = exprs(USUBJID, VISIT), + set_values_to = exprs( + AVAL = AVAL.HEIGHT / AVAL.WEIGHT, + PARAMCD = "HGTWGT", + PARAM = "Height to Weight Ratio" + ), + constant_parameters = "HEIGHT", + constant_by_vars = exprs(USUBJID) + ) + + expect_dfs_equal( + wrapper_output, + expected_output, + keys = c("USUBJID", "PARAMCD", "VISIT") + ) + } +) + +test_that( + "derive_param_ratio Test 4: Cross-check with and without units conversion", + { + input_diff_units <- tribble( + ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, + "01-101-1001", "HIPCIR", "Hip Circumference (in)", round(125 / 2.54, 2), "in", "SCREENING", + "01-101-1001", "HIPCIR", "Hip Circumference (in)", round(124 / 2.54, 2), "in", "WEEK 2", + "01-101-1001", "HIPCIR", "Hip Circumference (in)", round(123 / 2.54, 2), "in", "WEEK 3", + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 110, "cm", "SCREENING", + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 108, "cm", "WEEK 2", + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 107, "cm", "WEEK 3", + "01-101-1002", "HIPCIR", "Hip Circumference (in)", round(135 / 2.54, 2), "in", "SCREENING", + "01-101-1002", "HIPCIR", "Hip Circumference (in)", round(133 / 2.54, 2), "in", "WEEK 2", + "01-101-1002", "HIPCIR", "Hip Circumference (in)", round(132 / 2.54, 2), "in", "WEEK 3", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 120, "cm", "SCREENING", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 118, "cm", "WEEK 2", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 117, "cm", "WEEK 3" + ) + + output_units_unified <- derive_param_ratio( + input_diff_units, + by_vars = exprs(USUBJID, VISIT), + numerator_code = "WSTCIR", + denominator_code = "HIPCIR", + set_values_to = exprs( + PARAMCD = "WAISTHIP", + PARAM = "Waist to Hip Ratio" + ), + get_unit_expr = admiral::extract_unit(PARAM) + ) %>% + filter(PARAMCD == "WAISTHIP") + + input_same_units <- tribble( + ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, + "01-101-1001", "HIPCIR", "Hip Circumference (cm)", 125, "cm", "SCREENING", + "01-101-1001", "HIPCIR", "Hip Circumference (cm)", 124, "cm", "WEEK 2", + "01-101-1001", "HIPCIR", "Hip Circumference (cm)", 123, "cm", "WEEK 3", + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 110, "cm", "SCREENING", + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 108, "cm", "WEEK 2", + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 107, "cm", "WEEK 3", + "01-101-1002", "HIPCIR", "Hip Circumference (cm)", 135, "cm", "SCREENING", + "01-101-1002", "HIPCIR", "Hip Circumference (cm)", 133, "cm", "WEEK 2", + "01-101-1002", "HIPCIR", "Hip Circumference (cm)", 132, "cm", "WEEK 3", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 120, "cm", "SCREENING", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 118, "cm", "WEEK 2", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 117, "cm", "WEEK 3" + ) + + expected_output <- derive_param_ratio( + input_same_units, + by_vars = exprs(USUBJID, VISIT), + numerator_code = "WSTCIR", + denominator_code = "HIPCIR", + set_values_to = exprs( + PARAMCD = "WAISTHIP", + PARAM = "Waist to Hip Ratio" + ) + ) %>% + filter(PARAMCD == "WAISTHIP") + + expect_dfs_equal( + output_units_unified, + expected_output, + keys = c("USUBJID", "PARAMCD", "VISIT"), + tolerance = 0.0001 + ) + } +) + +test_that( + "derive_param_ratio Test 5: Both input parameters are constant", + { + input <- tribble( + ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, + "01-101-1001", "HEIGHT", "Height (cm)", 147, "cm", "SCREENING", + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 110, "cm", "SCREENING", + "01-101-1002", "HEIGHT", "Height (cm)", 163, "cm", "SCREENING", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 120, "cm", "SCREENING" + ) + + expect_error( + derive_param_ratio( + input, + by_vars = exprs(USUBJID, VISIT), + numerator_code = "WSTCIR", + denominator_code = "HEIGHT", + set_values_to = exprs( + PARAMCD = "WAISTHGT", + PARAM = "Waist to Height Ratio" + ), + constant_numerator = TRUE, + constant_denominator = TRUE, + constant_by_vars = exprs(USUBJID) + ) + ) + } +) diff --git a/tests/testthat/test-derive_param_waisthgt.R b/tests/testthat/test-derive_param_waisthgt.R new file mode 100644 index 0000000..6a20be6 --- /dev/null +++ b/tests/testthat/test-derive_param_waisthgt.R @@ -0,0 +1,156 @@ +test_that( + "derive_param_waisthgt Test 1: Cross-check with admiral::derive_param_computed(), + new observations with constant Height", + { + input <- tribble( + ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, + "01-101-1001", "HEIGHT", "Height (cm)", 147, "cm", "SCREENING", + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 110, "cm", "SCREENING", + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 108, "cm", "WEEK 2", + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 107, "cm", "WEEK 3", + "01-101-1002", "HEIGHT", "Height (cm)", 163, "cm", "SCREENING", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 120, "cm", "SCREENING", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 118, "cm", "WEEK 2", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 117, "cm", "WEEK 3", + ) + + wrapper_output <- derive_param_waisthgt( + input, + by_vars = exprs(USUBJID, VISIT), + set_values_to = exprs( + PARAMCD = "WAISTHGT", + PARAM = "Waist to Height Ratio" + ), + constant_by_vars = exprs(USUBJID), + get_unit_expr = admiral::extract_unit(PARAM) + ) + + expected_output <- derive_param_computed( + input, + parameters = "WSTCIR", + by_vars = exprs(USUBJID, VISIT), + set_values_to = exprs( + AVAL = AVAL.WSTCIR / AVAL.HEIGHT, + PARAMCD = "WAISTHGT", + PARAM = "Waist to Height Ratio" + ), + constant_parameters = "HEIGHT", + constant_by_vars = exprs(USUBJID) + ) + + expect_dfs_equal( + wrapper_output, + expected_output, + keys = c("USUBJID", "PARAMCD", "VISIT") + ) + } +) + +test_that( + "derive_param_waisthgt Test 2: Cross-check with admiral::derive_param_computed(), + pediatric study where Height is measured multiple times", + { + input <- tribble( + ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, + "01-101-1001", "HEIGHT", "Height (cm)", 147, "cm", "SCREENING", + "01-101-1001", "HEIGHT", "Height (cm)", 148, "cm", "WEEK 2", + "01-101-1001", "HEIGHT", "Height (cm)", 149, "cm", "WEEK 3", + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 100, "cm", "SCREENING", + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 99, "cm", "WEEK 2", + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 98, "cm", "WEEK 3", + "01-101-1002", "HEIGHT", "Height (cm)", 163, "cm", "SCREENING", + "01-101-1002", "HEIGHT", "Height (cm)", 164, "cm", "WEEK 2", + "01-101-1002", "HEIGHT", "Height (cm)", 165, "cm", "WEEK 3", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 110, "cm", "SCREENING", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 109, "cm", "WEEK 2", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 108, "cm", "WEEK 3" + ) + + wrapper_output <- derive_param_waisthgt( + input, + by_vars = exprs(USUBJID, VISIT), + set_values_to = exprs( + PARAMCD = "WAISTHGT", + PARAM = "Waist to Height Ratio" + ), + get_unit_expr = admiral::extract_unit(PARAM) + ) + + expected_output <- derive_param_computed( + input, + parameters = c("WSTCIR", "HEIGHT"), + by_vars = exprs(USUBJID, VISIT), + set_values_to = exprs( + AVAL = AVAL.WSTCIR / AVAL.HEIGHT, + PARAMCD = "WAISTHGT", + PARAM = "Waist to Height Ratio" + ) + ) + + expect_dfs_equal( + wrapper_output, + expected_output, + keys = c("USUBJID", "PARAMCD", "VISIT") + ) + } +) + +test_that( + "derive_param_waisthgt Test 3: Cross-check with and without units conversion", + { + input_diff_units <- tribble( + ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, + "01-101-1001", "HEIGHT", "Height (cm)", 147, "cm", "SCREENING", + "01-101-1001", "WSTCIR", "Waist Circumference (in)", 39.37, "in", "SCREENING", + "01-101-1001", "WSTCIR", "Waist Circumference (in)", 38.98, "in", "WEEK 2", + "01-101-1001", "WSTCIR", "Waist Circumference (in)", 38.58, "in", "WEEK 3", + "01-101-1002", "HEIGHT", "Height (cm)", 163, "cm", "SCREENING", + "01-101-1002", "WSTCIR", "Waist Circumference (in)", 43.31, "in", "SCREENING", + "01-101-1002", "WSTCIR", "Waist Circumference (in)", 42.91, "in", "WEEK 2", + "01-101-1002", "WSTCIR", "Waist Circumference (in)", 42.52, "in", "WEEK 3" + ) + + output_units_unified <- derive_param_waisthgt( + input_diff_units, + by_vars = exprs(USUBJID, VISIT), + set_values_to = exprs( + PARAMCD = "WAISTHGT", + PARAM = "Waist to Height Ratio" + ), + constant_by_vars = exprs(USUBJID), + get_unit_expr = admiral::extract_unit(PARAM) + ) %>% + filter(PARAMCD == "WAISTHGT") + + input_same_units <- tribble( + ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, + "01-101-1001", "HEIGHT", "Height (cm)", 147, "cm", "SCREENING", + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 100, "cm", "SCREENING", + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 99, "cm", "WEEK 2", + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 98, "cm", "WEEK 3", + "01-101-1002", "HEIGHT", "Height (cm)", 163, "cm", "SCREENING", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 110, "cm", "SCREENING", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 109, "cm", "WEEK 2", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 108, "cm", "WEEK 3" + ) + + expected_output <- derive_param_waisthgt( + input_same_units, + by_vars = exprs(USUBJID, VISIT), + set_values_to = exprs( + PARAMCD = "WAISTHGT", + PARAM = "Waist to Height Ratio" + ), + constant_by_vars = exprs(USUBJID), + get_unit_expr = admiral::extract_unit(PARAM) + ) %>% + filter(PARAMCD == "WAISTHGT") + + expect_dfs_equal( + output_units_unified, + expected_output, + keys = c("USUBJID", "PARAMCD", "VISIT"), + tolerance = 0.0001 + ) + } +) diff --git a/tests/testthat/test-derive_param_waisthip.R b/tests/testthat/test-derive_param_waisthip.R new file mode 100644 index 0000000..a4783ad --- /dev/null +++ b/tests/testthat/test-derive_param_waisthip.R @@ -0,0 +1,113 @@ +test_that( + "derive_param_waisthip Test 1: Cross-check with admiral::derive_param_computed()", + { + input <- tribble( + ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, + "01-101-1001", "HIPCIR", "Hip Circumference (cm)", 125, "cm", "SCREENING", + "01-101-1001", "HIPCIR", "Hip Circumference (cm)", 124, "cm", "WEEK 2", + "01-101-1001", "HIPCIR", "Hip Circumference (cm)", 123, "cm", "WEEK 3", + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 110, "cm", "SCREENING", + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 108, "cm", "WEEK 2", + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 107, "cm", "WEEK 3", + "01-101-1002", "HIPCIR", "Hip Circumference (cm)", 135, "cm", "SCREENING", + "01-101-1002", "HIPCIR", "Hip Circumference (cm)", 133, "cm", "WEEK 2", + "01-101-1002", "HIPCIR", "Hip Circumference (cm)", 132, "cm", "WEEK 3", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 120, "cm", "SCREENING", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 118, "cm", "WEEK 2", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 117, "cm", "WEEK 3" + ) + + wrapper_output <- derive_param_waisthip( + input, + by_vars = exprs(USUBJID, VISIT), + set_values_to = exprs( + PARAMCD = "WAISTHIP", + PARAM = "Waist to Hip Ratio" + ), + get_unit_expr = admiral::extract_unit(PARAM) + ) + + expected_output <- derive_param_computed( + input, + parameters = c("WSTCIR", "HIPCIR"), + by_vars = exprs(USUBJID, VISIT), + set_values_to = exprs( + AVAL = AVAL.WSTCIR / AVAL.HIPCIR, + PARAMCD = "WAISTHIP", + PARAM = "Waist to Hip Ratio" + ) + ) + + expect_dfs_equal( + wrapper_output, + expected_output, + keys = c("USUBJID", "PARAMCD", "VISIT") + ) + } +) + +test_that( + "derive_param_waisthip Test 2: Cross-check with and without units conversion", + { + input_diff_units <- tribble( + ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, + "01-101-1001", "HIPCIR", "Hip Circumference (cm)", 125, "cm", "SCREENING", + "01-101-1001", "HIPCIR", "Hip Circumference (cm)", 124, "cm", "WEEK 2", + "01-101-1001", "HIPCIR", "Hip Circumference (cm)", 123, "cm", "WEEK 3", + "01-101-1001", "WSTCIR", "Waist Circumference (in)", 43.31, "in", "SCREENING", + "01-101-1001", "WSTCIR", "Waist Circumference (in)", 42.52, "in", "WEEK 2", + "01-101-1001", "WSTCIR", "Waist Circumference (in)", 42.13, "in", "WEEK 3", + "01-101-1002", "HIPCIR", "Hip Circumference (cm)", 135, "cm", "SCREENING", + "01-101-1002", "HIPCIR", "Hip Circumference (cm)", 133, "cm", "WEEK 2", + "01-101-1002", "HIPCIR", "Hip Circumference (cm)", 132, "cm", "WEEK 3", + "01-101-1002", "WSTCIR", "Waist Circumference (in)", 47.24, "in", "SCREENING", + "01-101-1002", "WSTCIR", "Waist Circumference (in)", 46.46, "in", "WEEK 2", + "01-101-1002", "WSTCIR", "Waist Circumference (in)", 46.06, "in", "WEEK 3" + ) + + output_units_unified <- derive_param_waisthip( + input_diff_units, + by_vars = exprs(USUBJID, VISIT), + set_values_to = exprs( + PARAMCD = "WAISTHIP", + PARAM = "Waist to Hip Ratio" + ), + get_unit_expr = admiral::extract_unit(PARAM) + ) %>% + filter(PARAMCD == "WAISTHIP") + + input_same_units <- tribble( + ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, + "01-101-1001", "HIPCIR", "Hip Circumference (cm)", 125, "cm", "SCREENING", + "01-101-1001", "HIPCIR", "Hip Circumference (cm)", 124, "cm", "WEEK 2", + "01-101-1001", "HIPCIR", "Hip Circumference (cm)", 123, "cm", "WEEK 3", + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 110, "cm", "SCREENING", + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 108, "cm", "WEEK 2", + "01-101-1001", "WSTCIR", "Waist Circumference (cm)", 107, "cm", "WEEK 3", + "01-101-1002", "HIPCIR", "Hip Circumference (cm)", 135, "cm", "SCREENING", + "01-101-1002", "HIPCIR", "Hip Circumference (cm)", 133, "cm", "WEEK 2", + "01-101-1002", "HIPCIR", "Hip Circumference (cm)", 132, "cm", "WEEK 3", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 120, "cm", "SCREENING", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 118, "cm", "WEEK 2", + "01-101-1002", "WSTCIR", "Waist Circumference (cm)", 117, "cm", "WEEK 3" + ) + + expected_output <- derive_param_waisthip( + input_same_units, + by_vars = exprs(USUBJID, VISIT), + set_values_to = exprs( + PARAMCD = "WAISTHIP", + PARAM = "Waist to Hip Ratio" + ), + get_unit_expr = admiral::extract_unit(PARAM) + ) %>% + filter(PARAMCD == "WAISTHIP") + + expect_dfs_equal( + output_units_unified, + expected_output, + keys = c("USUBJID", "PARAMCD", "VISIT"), + tolerance = 0.0001 + ) + } +) diff --git a/tests/testthat/test-get_conv_factor.R b/tests/testthat/test-get_conv_factor.R new file mode 100644 index 0000000..cc5474d --- /dev/null +++ b/tests/testthat/test-get_conv_factor.R @@ -0,0 +1,20 @@ +test_that("get_conv_factor Test 1: Direct conversion factor for length (to cm)", { + expect_equal( + get_conv_factor("in", "cm"), + 2.54 + ) +}) + +test_that("get_conv_factor Test 2: Indirect conversion factor for length (via cm)", { + expect_equal( + get_conv_factor("ft", "in"), + 12 + ) +}) + +test_that("get_conv_factor Test 3: Inconvertible units", { + expect_equal( + get_conv_factor("cm", "kg"), + NA_real_ + ) +}) diff --git a/tests/testthat/test-my_first_fcn.R b/tests/testthat/test-my_first_fcn.R deleted file mode 100644 index 72e4aac..0000000 --- a/tests/testthat/test-my_first_fcn.R +++ /dev/null @@ -1,20 +0,0 @@ -test_that("hello admiral greets without hw", { - expect_message( - hello_admiral(), - "^Welcome to the admiral family!\\n" - ) -}) - -test_that("hello admiral greets with hw", { - expect_message( - hello_admiral(hw = TRUE), - "^Welcome to the admiral family!\\n" - ) -}) - -test_that("hello admiral greets with hw", { - expect_message( - hello_admiral(hw = FALSE), - "^Welcome to the admiral family!\\n" - ) -})