Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

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

Merged
merged 28 commits into from
Nov 1, 2024
Merged
Show file tree
Hide file tree
Changes from 10 commits
Commits
Show all changes
28 commits
Select commit Hold shift + click to select a range
52edc04
(#31): wrapper functions for waist/hip and waist/height ratio
yurovska Sep 28, 2024
91f76c3
(#31): Apply styler::style_file() to R-files
yurovska Sep 28, 2024
2ce6436
(#31): Fix lintr warnings + Roxygenize
yurovska Sep 28, 2024
be8ea17
(#31): Move derive_param_ratio to {admiral}
yurovska Oct 1, 2024
8753a73
#31 Get derive_param_ratio back as not exported
yurovska Oct 9, 2024
fddb8c3
#31 Fix style and update WORDLIST
yurovska Oct 10, 2024
1685761
(#31): Units conversion on the fly
yurovska Oct 10, 2024
ccdf002
(#31): Removed hyphens from PARAM and added a couple of unit tests
yurovska Oct 11, 2024
eaa6524
#31 Get rid of {units} package
yurovska Oct 15, 2024
0fd9e8f
(#31): Update keywords
yurovska Oct 20, 2024
37cfd49
Update R/derive_advs_params.R
yurovska Oct 23, 2024
84f39c4
Apply suggestions from code review
yurovska Oct 23, 2024
8024de2
Addressed review comments
yurovska Oct 23, 2024
03f57ed
Remove my_first_fcn
yurovska Oct 23, 2024
271e2a3
Updated WORDLIST
yurovska Oct 23, 2024
75c92c7
Update as per review comments
yurovska Oct 26, 2024
5274ef0
Apply suggestions from code review
yurovska Oct 26, 2024
af058ee
Update as per review comments
yurovska Oct 26, 2024
283de12
Fix broken code after applying suggestion from code review
yurovska Oct 26, 2024
65f7d89
Update as per review comments
yurovska Oct 28, 2024
1f05f0f
Update WORDLIST
yurovska Oct 29, 2024
d745aca
Refined code/documentation and added more tests
yurovska Oct 29, 2024
888d2fa
Added conversion factors in documentation
yurovska Oct 30, 2024
d92721d
Apply suggestions from code review
yurovska Oct 30, 2024
1009e76
Roxygenize after applying suggestions from code review
yurovska Oct 30, 2024
1d649f8
Fix lintr issues after applying suggestions from code review
yurovska Oct 30, 2024
058e6a5
Unit tests for get_conv_factor
yurovska Oct 30, 2024
5908433
One more test to reach 100% test coverage
yurovska Oct 30, 2024
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -24,6 +24,7 @@ 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),
Expand Down
18 changes: 18 additions & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
@@ -1,6 +1,21 @@
# Generated by roxygen2: do not edit by hand

export(derive_param_waisthgt)
export(derive_param_waisthip)
export(hello_admiral)
importFrom(admiral,derive_param_computed)
importFrom(admiraldev,assert_character_scalar)
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)
Expand Down Expand Up @@ -30,6 +45,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)
Expand Down Expand Up @@ -64,12 +80,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)
Expand Down
11 changes: 8 additions & 3 deletions R/admiralmetabolic-package.R
Original file line number Diff line number Diff line change
@@ -1,13 +1,18 @@
#' @keywords internal
#' @family internal
#' @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
#' @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
#' 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
Expand Down
317 changes: 317 additions & 0 deletions R/derive_advs_params.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,317 @@
#' Adds a Parameter for Waist to Hip Ratio
#'
#' @description Adds a record for Waist to Hip Ratio using Waist Circumference and Hip Circumference
yurovska marked this conversation as resolved.
Show resolved Hide resolved
#' each by group (e.g., subject and visit) where the source parameters are available.
yurovska marked this conversation as resolved.
Show resolved Hide resolved
#'
#' **Note:** This is a wrapper function for the more generic
#' \code{admiral::derive_param_computed()}.
#'
#' @param 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}.
#'
#' @param wstcir_code Waist Circumference parameter code
#'
#' The observations where \code{PARAMCD} equals the specified value are considered
#' as the Waist Circumference
yurovska marked this conversation as resolved.
Show resolved Hide resolved
#'
#' *Permitted Values:* character value
yurovska marked this conversation as resolved.
Show resolved Hide resolved
#'
#' @param hipcir_code Hip Circumference parameter code
#'
#' The observations where \code{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 \code{by_vars}.
#'
#' @family der_prm_advs
#' @keywords der_prm_advs
#'
#' @export
#'
#' @seealso \code{\link[admiral:derive_param_computed]{admiral::derive_param_computed()}}
yurovska marked this conversation as resolved.
Show resolved Hide resolved
#'
#' @examples
#'
yurovska marked this conversation as resolved.
Show resolved Hide resolved
#' 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"
#' )
#' )
#'
#' # 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)
#' )
manciniedoardo marked this conversation as resolved.
Show resolved Hide resolved
derive_param_waisthip <- function(dataset,
by_vars,
wstcir_code = "WSTCIR",
hipcir_code = "HIPCIR",
set_values_to = exprs(PARAMCD = "WAISTHIP"),
filter = NULL,
get_unit_expr = NULL) {
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), optional = TRUE)

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 record for Waist to Height Ratio using Waist Circumference and Height
yurovska marked this conversation as resolved.
Show resolved Hide resolved
#' each by group (e.g., subject and visit) where the source parameters are available.
yurovska marked this conversation as resolved.
Show resolved Hide resolved
#'
#' **Note:** This is a wrapper function for the more generic
#' \code{admiral::derive_param_computed()}.
#'
#' @param 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}.
#'
#' @param wstcir_code Waist Circumference parameter code
#'
#' The observations where \code{PARAMCD} equals the specified value are considered
#' as the Waist Circumference
yurovska marked this conversation as resolved.
Show resolved Hide resolved
#'
#' *Permitted Values:* character value
#'
#' @param height_code Height parameter code
#'
#' The observations where \code{PARAMCD} equals the specified value are considered
#' as the Height. It is expected that Height is measured in cm
yurovska marked this conversation as resolved.
Show resolved Hide resolved
#'
#' *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
#' \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.
#'
#' *Permitted Values*: list of variables created by \code{exprs()}
#' e.g. \code{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 \code{by_vars}.
#'
#' @family der_prm_advs
#' @keywords der_prm_advs
#'
#' @export
#'
#' @seealso \code{\link[admiral:derive_param_computed]{admiral::derive_param_computed()}}
yurovska marked this conversation as resolved.
Show resolved Hide resolved
#'
#' @examples
#'
yurovska marked this conversation as resolved.
Show resolved Hide resolved
#' 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)
#' )
#'
#' # Example 2: 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"
#' )
#' )
#'
#' # Example 3: 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 = AVALU
yurovska marked this conversation as resolved.
Show resolved Hide resolved
#' )
yurovska marked this conversation as resolved.
Show resolved Hide resolved
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 = NULL) {
yurovska marked this conversation as resolved.
Show resolved Hide resolved
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), optional = TRUE)

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
)
}
Loading
Loading