diff --git a/.github/pull_request_template.md b/.github/pull_request_template.md index 1aa352d865..8ea8183799 100644 --- a/.github/pull_request_template.md +++ b/.github/pull_request_template.md @@ -1,13 +1,12 @@ - -Thank you for your Pull Request! We have developed this task checklist from the [Development Process Guide](https://pharmaverse.github.io/admiraldev/main/articles/development_process.html) to help with the final steps of the process. Completing the below tasks helps to ensure our reviewers can maximize their time on your code as well as making sure the admiral codebase remains robust and consistent. +Thank you for your Pull Request! We have developed this task checklist from the [Development Process Guide](https://pharmaverse.github.io/admiraldev/devel/articles/development_process.html) to help with the final steps of the process. Completing the below tasks helps to ensure our reviewers can maximize their time on your code as well as making sure the admiral codebase remains robust and consistent. Please check off each taskbox as an acknowledgment that you completed the task or check off that it is not relevant to your Pull Request. This checklist is part of the Github Action workflows and the Pull Request will not be merged into the `devel` branch until you have checked off each task. - [ ] Place Closes # into the beginning of your Pull Request Title (Use Edit button in top-right if you need to update) - [ ] Code is formatted according to the [tidyverse style guide](https://style.tidyverse.org/). Run `styler::style_file()` to style R and Rmd files -- [ ] Updated relevant unit tests or have written new unit tests - See [Unit Test Guide](https://pharmaverse.github.io/admiraldev/main/articles/unit_test_guidance.html#writing-unit-tests-in-admiral-) -- [ ] If you removed/replaced any function and/or function parameters, did you fully follow the [deprecation guidance](https://pharmaverse.github.io/admiraldev/main/articles/programming_strategy.html#deprecation-1)? -- [ ] Update to all relevant roxygen headers and examples +- [ ] Updated relevant unit tests or have written new unit tests, which should consider realistic data scenarios and edge cases, e.g. empty datasets, errors, boundary cases etc. - See [Unit Test Guide](https://pharmaverse.github.io/admiraldev/devel/articles/unit_test_guidance.html#tests-should-be-robust-to-cover-realistic-data-scenarios) +- [ ] If you removed/replaced any function and/or function parameters, did you fully follow the [deprecation guidance](https://pharmaverse.github.io/admiraldev/devel/articles/programming_strategy.html#deprecation)? +- [ ] Update to all relevant roxygen headers and examples, including keywords and families. Refer to the [categorization of functions](https://pharmaverse.github.io/admiraldev/devel/articles/programming_strategy.html#categorization-of-functions) to tag appropriate keyword/family. - [ ] Run `devtools::document()` so all `.Rd` files in the `man` folder and the `NAMESPACE` file in the project root are updated appropriately - [ ] Address any updates needed for vignettes and/or templates - [ ] Update `NEWS.md` if the changes pertain to a user-facing function (i.e. it has an `@export` tag) or documentation aimed at users (rather than developers) diff --git a/.github/workflows/common.yml b/.github/workflows/common.yml index fc74324e1a..ee241d67ef 100644 --- a/.github/workflows/common.yml +++ b/.github/workflows/common.yml @@ -29,10 +29,6 @@ on: release: types: [published] -env: - # R version to use for the workflows - R_VERSION: "3.6" - # Docs on concurrency: # https://docs.github.com/en/actions/using-jobs/using-concurrency concurrency: @@ -45,25 +41,25 @@ jobs: uses: pharmaverse/admiralci/.github/workflows/style.yml@main if: github.event_name == 'pull_request' with: - r-version: $R_VERSION + r-version: "4.0" spellcheck: name: Spelling uses: pharmaverse/admiralci/.github/workflows/spellcheck.yml@main if: github.event_name == 'pull_request' with: - r-version: $R_VERSION + r-version: "4.0" readme: name: Render README uses: pharmaverse/admiralci/.github/workflows/readme-render.yml@main if: github.event_name == 'push' with: - r-version: $R_VERSION + r-version: "4.0" validation: name: Validation uses: pharmaverse/admiralci/.github/workflows/r-pkg-validation.yml@main if: github.event_name == 'release' with: - r-version: $R_VERSION + r-version: "4.0" check: name: Check uses: pharmaverse/admiralci/.github/workflows/r-cmd-check.yml@main @@ -75,7 +71,7 @@ jobs: # Change this after the next release to remove the ref condition if: github.event_name == 'push' && github.ref == 'refs/heads/main' with: - r-version: $R_VERSION + r-version: "4.0" # Whether to skip multiversion docs # Note that if you have multiple versions of docs, # your URL links are likely to break due to path changes @@ -85,7 +81,7 @@ jobs: uses: pharmaverse/admiralci/.github/workflows/lintr.yml@main if: github.event_name == 'pull_request' with: - r-version: $R_VERSION + r-version: "4.0" links: name: Links uses: pharmaverse/admiralci/.github/workflows/links.yml@main @@ -97,7 +93,7 @@ jobs: if: > github.event_name == 'push' || github.event_name == 'pull_request' with: - r-version: $R_VERSION + r-version: "4.0" # Whether to skip code coverage badge creation # Setting to 'false' will require you to create # an orphan branch called 'badges' in your repository @@ -107,4 +103,4 @@ jobs: uses: pharmaverse/admiralci/.github/workflows/man-pages.yml@main if: github.event_name == 'pull_request' with: - r-version: $R_VERSION + r-version: "4.0" diff --git a/.github/workflows/cran-status.yml b/.github/workflows/cran-status.yml new file mode 100644 index 0000000000..382e25d8cb --- /dev/null +++ b/.github/workflows/cran-status.yml @@ -0,0 +1,24 @@ +--- +# Source: https://github.com/pharmaverse/admiralci +name: CRAN Status Monitor + +on: + # 'workflow_dispatch' gives you the ability + # to run this workflow on demand, anytime + workflow_dispatch: + # 'schedule' events are triggered on a schedule + schedule: + - cron: '1 0 * * 1,3,5' + +jobs: + cran-status: + name: Check & Report + uses: pharmaverse/admiralci/.github/workflows/cran-status.yml@main + with: + # Whom should the issue be assigned to if errors are encountered + # in the CRAN status checks? + issue-assignees: "bundfussr,esimms999-gsk,thomas-neitmann,bms63,rossfarrugia" + # Create an issue if one or more of the following + # statuses are reported on the check report. + status-types: "WARNING,ERROR,NOTE" + diff --git a/.github/workflows/templates.yml b/.github/workflows/templates.yml index dcfc6d3999..08d4adf39a 100644 --- a/.github/workflows/templates.yml +++ b/.github/workflows/templates.yml @@ -6,14 +6,10 @@ on: pull_request_review: types: [submitted] -env: - # R version to use for the workflows - R_VERSION: "3.6" - jobs: templates: name: Check Templates uses: pharmaverse/admiralci/.github/workflows/check-templates.yml@main if: github.event.review.state == 'approved' with: - r-version: $R_VERSION + r-version: "4.0" diff --git a/DESCRIPTION b/DESCRIPTION index a2870e59d4..2f139e7ecb 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: admiral Type: Package Title: ADaM in R Asset Library -Version: 0.8.4 +Version: 0.9.0 Authors@R: c( person("Thomas", "Neitmann", email = "thomas.neitmann@roche.com", role = c("aut", "cre")), person("Stefan", "Bundfuss", role = "aut"), @@ -25,9 +25,17 @@ Authors@R: c( person("Pooja", "Kumari", role = "aut"), person("Claudia", "Carlucci", role = "aut"), person("Daniil", "Stefonishin", role = "aut"), + person("Sadchla", "Mascary", role = "aut"), + person("Zelos", "Zhu", role = "aut"), + person("Jeffrey", "Dickinson", role = "aut"), + person("Ania", "Golab", role = "aut"), person("Michael", "Thorpe", role = "ctb"), + person("Declan", "Hodges", role = "ctb"), + person("Jaxon", "Abercrombie", role = "ctb"), + person("Nick", "Ramirez", role = "ctb"), person("Pavan", "Kumar", role = "ctb"), person("Hamza", "Rahal", role = "ctb"), + person("Yohann", "Omnes", role = "ctb"), person("Alice", "Ehmann", role = "ctb"), person("Tom", "Ratford", role = "ctb"), person("Vignesh", "Thanikachalam", role = "ctb"), @@ -39,6 +47,7 @@ Authors@R: c( person("Syed", "Mubasheer", role = "ctb"), person("Wenyi", "Liu", role = "ctb"), person("Dinakar", "Kulkarni", role = "ctb"), + person("Franciszek", "Walkowiak", role = "ctb"), person("Tamara", "Senior", role = "ctb"), person("Jordanna", "Morrish", role = "ctb"), person("Anthony", "Howard", role = "ctb"), @@ -61,11 +70,10 @@ URL: https://pharmaverse.github.io/admiral/, https://github.com/pharmaverse/admi Encoding: UTF-8 LazyData: true Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.0 +RoxygenNote: 7.2.1 Depends: R (>= 3.5) Imports: - admiraldev, - assertthat (>= 0.2.1), + admiraldev (>= 0.2.0), dplyr (>= 0.8.4), hms (>= 0.5.3), lifecycle (>= 0.1.0), @@ -75,9 +83,9 @@ Imports: rlang (>= 0.4.4), stringr (>= 1.4.0), tidyr (>= 1.0.2), - tidyselect (>= 1.0.0) + tidyselect (>= 1.1.0) Suggests: - admiral.test, + admiral.test (>= 0.4.0), covr, devtools, DT, diff --git a/NAMESPACE b/NAMESPACE index 63969d026c..d53484a14a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,11 +4,14 @@ S3method(convert_blanks_to_na,character) S3method(convert_blanks_to_na,data.frame) S3method(convert_blanks_to_na,default) S3method(convert_blanks_to_na,list) -S3method(format,sdg_select) -S3method(format,smq_select) +S3method(convert_na_to_blanks,character) +S3method(convert_na_to_blanks,data.frame) +S3method(convert_na_to_blanks,default) +S3method(convert_na_to_blanks,list) +S3method(format,basket_select) S3method(print,adam_templates) -S3method(print,derivation_slice) -S3method(print,tte_source) +S3method(print,source) +export("%>%") export(ae_event) export(ae_gr1_event) export(ae_gr2_event) @@ -21,9 +24,11 @@ export(ae_sev_event) export(ae_wd_event) export(assert_terms) export(assert_valid_queries) +export(basket_select) export(call_derivation) export(call_user_fun) export(censor_source) +export(chr2vars) export(compute_bmi) export(compute_bsa) export(compute_dtf) @@ -39,7 +44,9 @@ export(convert_blanks_to_na) export(convert_date_to_dtm) export(convert_dtc_to_dt) export(convert_dtc_to_dtm) +export(convert_na_to_blanks) export(count_vals) +export(create_period_dataset) export(create_query_data) export(create_single_dose_dataset) export(date_source) @@ -48,12 +55,14 @@ export(default_qtc_paramcd) export(derivation_slice) export(derive_derived_param) export(derive_extreme_records) +export(derive_locf_records) export(derive_param_bmi) export(derive_param_bsa) export(derive_param_computed) export(derive_param_doseint) export(derive_param_exist_flag) export(derive_param_exposure) +export(derive_param_extreme_event) export(derive_param_first_event) export(derive_param_framingham) export(derive_param_map) @@ -88,11 +97,14 @@ export(derive_var_last_dose_grp) export(derive_var_merged_cat) export(derive_var_merged_character) export(derive_var_merged_exist_flag) +export(derive_var_merged_summary) export(derive_var_obs_number) export(derive_var_ontrtfl) export(derive_var_pchg) +export(derive_var_relative_flag) export(derive_var_shift) export(derive_var_trtdurd) +export(derive_var_trtemfl) export(derive_var_worst_flag) export(derive_vars_aage) export(derive_vars_atc) @@ -103,11 +115,13 @@ export(derive_vars_dtm_to_dt) export(derive_vars_dtm_to_tm) export(derive_vars_duration) export(derive_vars_dy) +export(derive_vars_joined) export(derive_vars_last_dose) export(derive_vars_merged) export(derive_vars_merged_dt) export(derive_vars_merged_dtm) export(derive_vars_merged_lookup) +export(derive_vars_period) export(derive_vars_query) export(derive_vars_suppqual) export(derive_vars_transposed) @@ -121,10 +135,10 @@ export(extract_unit) export(filter_confirmation) export(filter_date_sources) export(filter_extreme) -export(filter_if) export(filter_relative) export(format_eoxxstt_default) export(format_reason_default) +export(get_admiral_option) export(get_duplicates_dataset) export(get_many_to_one_dataset) export(get_not_mapped) @@ -139,21 +153,21 @@ export(max_cond) export(min_cond) export(negate_vars) export(params) +export(print_named_list) export(query) export(restrict_derivation) export(sdg_select) +export(set_admiral_options) export(signal_duplicate_records) export(slice_derivation) export(smq_select) export(use_ad_template) +export(validate_basket_select) export(validate_query) -export(validate_sdg_select) -export(validate_smq_select) export(vars) -export(vars2chr) export(yn_to_numeric) import(admiraldev) -importFrom(assertthat,assert_that) +importFrom(dplyr,across) importFrom(dplyr,arrange) importFrom(dplyr,bind_cols) importFrom(dplyr,bind_rows) @@ -162,6 +176,7 @@ importFrom(dplyr,coalesce) importFrom(dplyr,desc) importFrom(dplyr,distinct) importFrom(dplyr,ends_with) +importFrom(dplyr,everything) importFrom(dplyr,filter) importFrom(dplyr,full_join) importFrom(dplyr,group_by) @@ -241,6 +256,7 @@ 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) @@ -282,19 +298,23 @@ importFrom(stringr,str_match) importFrom(stringr,str_remove) importFrom(stringr,str_remove_all) importFrom(stringr,str_replace) +importFrom(stringr,str_replace_all) importFrom(stringr,str_sub) importFrom(stringr,str_subset) importFrom(stringr,str_to_lower) importFrom(stringr,str_to_title) importFrom(stringr,str_to_upper) importFrom(stringr,str_trim) +importFrom(tidyr,crossing) importFrom(tidyr,drop_na) +importFrom(tidyr,fill) importFrom(tidyr,nest) importFrom(tidyr,pivot_longer) importFrom(tidyr,pivot_wider) importFrom(tidyr,unnest) importFrom(tidyselect,all_of) importFrom(tidyselect,contains) +importFrom(tidyselect,matches) importFrom(tidyselect,vars_select) importFrom(utils,capture.output) importFrom(utils,str) diff --git a/NEWS.md b/NEWS.md index db13039063..8a34cb6f8a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,100 @@ +# admiral 0.9.0 + +## New Features + +- The new function `derive_vars_joined()` adds variables from an additional +dataset. The selection of the observations can depend on variables from both +datasets. This can be used for adding `AVISIT`, `AWLO`, `AWHI` based on time +windows and `ADY` or deriving the lowest value (nadir) before the current +observation (#1448). + +- New function `derive_var_trtemfl()` for deriving treatment emergent flags (#989) + +- The new function `chr2vars()` turns a character vector into a list of quosures +(#1448). + +- New function `derive_var_relative_flag()` for flagging observations before or +after a condition is fulfilled (#1453) + +- New functions `get_admiral_option()` and `set_admiral_options()` to allow more +flexibility on common function inputs; e.g. like `subject_keys` to avoid several +find and replace instances of `vars(STUDYID, USUBJID)`. (#1338) + +- The new function `create_period_dataset()` for creating a reference dataset +for subperiods, periods, or phases from the ADSL dataset was added. The +reference dataset can be used to create subperiod, period, and phase variables +in OCCDS and BDS datasets. (#1477) + +- The new function `derive_vars_period()` adds subperiod, period, or phase +variables to ADSL. The values for the new variables are provided by a period +reference dataset. (#1477) + +- New function `derive_var_merged_summary()` adds a variable of summarized +values to the input dataset (#1564) + +- A `print()` method was added for all S3 objects defined by admiral, e.g., +`date_source()`, `dthcaus_source()`, ... (#858) + +- New metadata data set called `atoxgr_criteria_ctcv5` which holds criteria for lab grading +based on [Common Terminology Criteria for Adverse Events (CTCAE) v5.0](https://ctep.cancer.gov/protocoldevelopment/electronic_applications/ctc.htm) + +- Removed the `{assertthat}` dependency in `{admiral}` (#1392) + +- Removed R Version 3.6 check in CI/CD workflows in favor of the three most recent versions: 4.0, 4.1 and 4.2. (#1556) + +- The new function `derive_locf_records()` adds LOCF records as new observations. +This can be used when the input dataset does not contain observations for missed +visits/time points or when `AVAL` is `NA` for particular visits/time points (#1316). + +- New function `convert_na_to_blanks()` to convert character `NA` to blanks (#1624) + + +## Updates of Existing Functions + +- Function `derive_param_first_event()` has been replaced by a more generalized `derive_param_extreme_event()` function with new argument `mode` allowing for the selection of either the `"first"` or `"last"` event record according to the conditions provided. Also the `date_var` argument has been replaced with the `order` argument instead. In addition, three new arguments `new_var`, `true_value`, and `false_value` have been added to allow the user to choose what variable is used to indicate whether an event happened, and the values it is given (#1317) (#1242). + +- Argument `ignore_time_for_ref_end_date` was added to `derive_var_ontrtfl()`, +which controls if time is considered for the condition if `start_date` is after +`ref_end_date` + `ref_end_window` days (#989). + +- `derive_var_atoxgr_dir()` default value of `atoxgr_criteria_ctcv4` removed for +parameter `meta_criteria`. Can now also choose `atoxgr_criteria_ctcv5` for parameter +`meta_criteria`, to implement NCI-CTCAEv5 grading criteria . + +- _Environment_ objects were consolidated into a single `admiral_environment` object under `R/admiral__environment.R`. (#1572) + +- The default value of the `keep_source_vars` argument in +`create_single_dose_dataset()` was updated such that it takes the values of the +other arguments into account and the `start_datetime` and `end_datetime` +arguments are optional now (#1598). + +- Function `create_query_data()` has been updated such that the dictionary +version is stored in the output dataset (#1337). + +## Breaking Changes + +- Function `derive_param_first_event()` has been deprecated. Please use `derive_param_extreme_event()` with the `order` argument instead of the `date_var` argument (#1317). + +- Functions `smq_select()` and `sdg_select()` have been deprecated and replaced with `basket_select()`. In the `create_query_data()` function, `meddra_version` and `whodd_version` argument has been replaced by `version` and `get_smq_fun` and `get_sdg_fun` argument by `get_terms_fun`. (#1597) + +## Documentation + +- New vignette "Generic Functions" (#734) +- New vignette "Visit and Period Variables" (#1478) + +## Various + +- Function `derive_param_tte()` had a bug that set `ADT` to `NA` when `start_date` +was missing, which has now been fixed (#1540) + +- Function `derive_vars_merged()` had an improperly formatted error message +which has been corrected (#1473) + +- Templates now save datasets as `.rds` instead of `.rda` (#1501) + +- Function `create_single_dose_dataset()` no longer fails if the input dataset +contains observations with dose frequency `"ONCE"` (#1375). + # admiral 0.8.4 - Fixed a bug where a recent update to `{lifecylce}` caused several `admiral` tests to break (#1500) diff --git a/R/admiral-package.R b/R/admiral-package.R index b2635e2913..7d4f27ecb7 100644 --- a/R/admiral-package.R +++ b/R/admiral-package.R @@ -1,29 +1,28 @@ #' @keywords internal #' @family internal #' @import admiraldev -#' @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 -#' semi_join starts_with transmute ungroup vars n_distinct union distinct +#' @importFrom dplyr across arrange bind_rows case_when desc ends_with everything filter full_join +#' group_by if_else mutate mutate_at mutate_if n pull rename rename_at row_number select +#' slice semi_join starts_with transmute ungroup vars n_distinct union distinct #' summarise_at summarise coalesce bind_cols na_if tibble #' @importFrom magrittr %>% #' @importFrom rlang := abort arg_match as_function as_label 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 is_bare_formula is_call -#' is_character is_formula is_integerish is_logical is_quosure is_quosures -#' is_symbol new_formula parse_expr parse_exprs quo quo_get_expr quo_is_call -#' quo_is_missing quo_is_null quo_is_symbol quos quo_squash quo_text set_names -#' sym syms type_of warn quo_set_env quo_get_env +#' expr expr_interp expr_label exprs f_lhs f_rhs inform is_bare_formula +#' is_call is_character is_formula is_integerish is_logical is_quosure +#' is_quosures is_symbol new_formula parse_expr parse_exprs quo quo_get_expr +#' quo_is_call quo_is_missing quo_is_null quo_is_symbol quos quo_squash +#' quo_text set_names sym syms type_of warn quo_set_env quo_get_env #' @importFrom utils capture.output str #' @importFrom purrr map map2 map_chr map_lgl reduce walk keep map_if transpose #' flatten every modify_at modify_if reduce compose #' @importFrom stringr str_c str_detect str_extract str_glue str_match -#' str_remove str_remove_all str_replace str_sub str_subset str_trim -#' str_to_lower str_to_title str_to_upper str_length str_locate -#' @importFrom assertthat assert_that +#' str_remove str_remove_all str_replace str_replace_all str_sub str_subset +#' str_trim str_to_lower str_to_title str_to_upper str_length str_locate #' @importFrom lubridate as_datetime ceiling_date date days duration floor_date is.Date is.instant #' rollback time_length %--% ymd ymd_hms weeks years hours minutes -#' @importFrom tidyr drop_na nest pivot_longer pivot_wider unnest -#' @importFrom tidyselect all_of contains vars_select +#' @importFrom tidyr crossing drop_na fill nest pivot_longer pivot_wider unnest +#' @importFrom tidyselect all_of contains matches vars_select #' @importFrom hms as_hms #' @importFrom lifecycle deprecate_warn deprecated deprecate_stop "_PACKAGE" diff --git a/R/admiral_environment.R b/R/admiral_environment.R new file mode 100644 index 0000000000..4b4efe5f1d --- /dev/null +++ b/R/admiral_environment.R @@ -0,0 +1,37 @@ +#' Environment Objects +#' +#' @details +#' Once in a while, we may encounter "locked binding for 'xxx'." errors +#' during the development process while building out functions. This may arise because +#' we want to create dynamic data/objects based on user-inputs that need modification +#' at points in time after the package has been loaded. To manage such data or objects, +#' R has a data structure known as an 'environment'. These environment objects are created +#' at build time, but can be populated with values after the package has been loaded and +#' update those values over the course of an R session. For more details how environments work, +#' see relevant sections on environments in R Packages and Advanced R textbooks for more details. +#' @noRd + +admiral_environment <- new.env(parent = emptyenv()) + +# See respective ...R page for usage + +# admiral_options.R ---- +## set_admiral_options +admiral_environment$admiral_options <- list( + # future_input = vars(...), nolint + subject_keys = vars(STUDYID, USUBJID) +) + +# To enhance features and add inputs as necessary + +# 1. Add additional options such as future_input as shown in comment above +# 2. Update @params with future_input in set_admiral_options roxygen documentation +# 3. Add future_input into set_admiral_options() formals and body + +# derive_merged.R ---- +## derive_vars_merged_lookup +admiral_environment$nmap <- NULL + +# duplicates.R ---- +## signal_duplicate_records +admiral_environment$duplicates <- NULL diff --git a/R/admiral_options.R b/R/admiral_options.R new file mode 100644 index 0000000000..80176af443 --- /dev/null +++ b/R/admiral_options.R @@ -0,0 +1,141 @@ +#' Get the Value of an Admiral Option +#' +#' Get the Value of an Admiral Option Which Can Be Modified for Advanced Users. +#' +#' @param option A character scalar of commonly used admiral function inputs. +#' +#' As of now, support only available for `r enumerate(names(admiral_environment$admiral_options), quote_fun = dquote, conjunction = "or")`. +#' See `set_admiral_options()` for a description of the options. +#' +#' @details +#' This function allows flexibility for function inputs that may need to be repeated +#' multiple times in a script, such as `subject_keys`. +#' +#' @author Zelos Zhu +#' +#' @return +#' The value of the specified option. +#' +#' @keywords admiral_options +#' @family admiral_options +#' +#' @export +#' +#' @seealso [vars()], [set_admiral_options()], [derive_param_exist_flag()], +#' [derive_param_first_event()], [derive_param_tte()], [derive_var_disposition_status()], +#' [derive_var_dthcaus()], [derive_var_extreme_dtm()], [derive_vars_disposition_reason()], +#' [derive_vars_period()], [create_period_dataset()] +#' +#' +#' @examples +#' library(admiral.test) +#' library(dplyr, warn.conflicts = FALSE) +#' data("admiral_vs") +#' data("admiral_dm") +#' +#' # Merging all dm variables to vs +#' derive_vars_merged( +#' admiral_vs, +#' dataset_add = select(admiral_dm, -DOMAIN), +#' by_vars = get_admiral_option("subject_keys") +#' ) %>% +#' select(STUDYID, USUBJID, VSTESTCD, VISIT, VSTPT, VSSTRESN, AGE, AGEU) +get_admiral_option <- function(option) { + # Check for valid option - catch function abuse + assert_character_scalar(option) + + # Find which admiral_options is being called upon + possible_inputs <- names(admiral_environment$admiral_options) + + if (option %in% possible_inputs) { + return(admiral_environment$admiral_options[[option]]) + } + + # Return message otherwise, catch typos + err_msg <- paste( + "Invalid function argument, select one of:", + enumerate(possible_inputs, quote_fun = dquote, conjunction = "or") + ) + abort(err_msg) +} + +#' Set the Value of Admiral Options +#' +#' Set the Values of Admiral Options That Can Be Modified for Advanced Users. +#' +#' @param subject_keys Variables to uniquely identify a subject, defaults to +#' `vars(STUDYID, USUBJID)`. This option is used as default value for the +#' `subject_keys` argument in all admiral functions. +#' +#' @details +#' Modify an admiral option, e.g `subject_keys`, such that it automatically affects downstream +#' function inputs where `get_admiral_option()` is called such as `derive_param_exist_flag()`. +#' +#' @author Zelos Zhu +#' +#' @return +#' No return value, called for side effects. +#' +#' @keywords admiral_options +#' @family admiral_options +#' +#' @export +#' +#' @seealso [vars()], [get_admiral_option()], [derive_param_exist_flag()], +#' [derive_param_first_event()], [derive_param_tte()], [derive_var_disposition_status()], +#' [derive_var_dthcaus()], [derive_var_extreme_dtm()], [derive_vars_disposition_reason()], +#' [derive_vars_period()], [create_period_dataset()] +#' +#' @examples +#' library(lubridate) +#' library(dplyr, warn.conflicts = FALSE) +#' library(tibble) +#' set_admiral_options(subject_keys = vars(STUDYID, USUBJID2)) +#' +#' # Derive a new parameter for measurable disease at baseline +#' adsl <- tribble( +#' ~USUBJID2, +#' "1", +#' "2", +#' "3" +#' ) %>% +#' mutate(STUDYID = "XX1234") +#' +#' tu <- tribble( +#' ~USUBJID2, ~VISIT, ~TUSTRESC, +#' "1", "SCREENING", "TARGET", +#' "1", "WEEK 1", "TARGET", +#' "1", "WEEK 5", "TARGET", +#' "1", "WEEK 9", "NON-TARGET", +#' "2", "SCREENING", "NON-TARGET", +#' "2", "SCREENING", "NON-TARGET" +#' ) %>% +#' mutate( +#' STUDYID = "XX1234", +#' TUTESTCD = "TUMIDENT" +#' ) +#' +#' derive_param_exist_flag( +#' dataset_adsl = adsl, +#' dataset_add = tu, +#' filter_add = TUTESTCD == "TUMIDENT" & VISIT == "SCREENING", +#' condition = TUSTRESC == "TARGET", +#' false_value = "N", +#' missing_value = "N", +#' set_values_to = vars( +#' PARAMCD = "MDIS", +#' PARAM = "Measurable Disease at Baseline" +#' ) +#' ) +set_admiral_options <- function(subject_keys) { + if (!missing(subject_keys)) { + assert_vars(subject_keys) + admiral_environment$admiral_options$subject_keys <- subject_keys + } + + # Add future input to function formals above + # if (!missing(future_input)) { + # assert_vars(future_input) nolint + # admiral_environment$admiral_options$future_input <- future_input nolint + # } +} diff --git a/R/assertions.R b/R/assertions.R deleted file mode 100644 index ee16d6462b..0000000000 --- a/R/assertions.R +++ /dev/null @@ -1,9 +0,0 @@ -filter_if <- function(dataset, filter) { - assert_data_frame(dataset, check_is_grouped = FALSE) - assert_filter_cond(filter, optional = TRUE) - if (quo_is_null(filter)) { - dataset - } else { - filter(dataset, !!filter) - } -} diff --git a/R/call_derivation.R b/R/call_derivation.R index 8beb920d8b..2448ced6a1 100644 --- a/R/call_derivation.R +++ b/R/call_derivation.R @@ -176,5 +176,5 @@ params <- function(...) { ) abort(err_msg) } - structure(args, class = c("params", "list")) + structure(args, class = c("params", "source", "list")) } diff --git a/R/compute_duration.R b/R/compute_duration.R index 9b60838349..b0eae35ec1 100644 --- a/R/compute_duration.R +++ b/R/compute_duration.R @@ -80,24 +80,26 @@ #' @export #' #' @examples +#' library(lubridate) +#' #' # Derive duration in days (integer), i.e., relative day #' compute_duration( -#' start_date = lubridate::ymd_hms("2020-12-06T15:00:00"), -#' end_date = lubridate::ymd_hms("2020-12-24T08:15:00") +#' start_date = ymd_hms("2020-12-06T15:00:00"), +#' end_date = ymd_hms("2020-12-24T08:15:00") #' ) #' #' # Derive duration in days (float) #' compute_duration( -#' start_date = lubridate::ymd_hms("2020-12-06T15:00:00"), -#' end_date = lubridate::ymd_hms("2020-12-24T08:15:00"), +#' start_date = ymd_hms("2020-12-06T15:00:00"), +#' end_date = ymd_hms("2020-12-24T08:15:00"), #' floor_in = FALSE, #' add_one = FALSE #' ) #' #' # Derive age in years #' compute_duration( -#' start_date = lubridate::ymd("1984-09-06"), -#' end_date = lubridate::ymd("2020-02-24"), +#' start_date = ymd("1984-09-06"), +#' end_date = ymd("2020-02-24"), #' trunc_out = TRUE, #' out_unit = "years", #' add_one = FALSE @@ -105,8 +107,8 @@ #' #' # Derive duration in hours #' compute_duration( -#' start_date = lubridate::ymd_hms("2020-12-06T9:00:00"), -#' end_date = lubridate::ymd_hms("2020-12-06T13:30:00"), +#' start_date = ymd_hms("2020-12-06T9:00:00"), +#' end_date = ymd_hms("2020-12-06T13:30:00"), #' out_unit = "hours", #' floor_in = FALSE, #' add_one = FALSE, @@ -119,8 +121,10 @@ compute_duration <- function(start_date, add_one = TRUE, trunc_out = FALSE) { # Checks - assert_that(is_date(start_date), is_date(end_date)) - assert_that(is_timeunit(in_unit), is_timeunit(out_unit) | out_unit == "weeks") + assert_date_vector(start_date) + assert_date_vector(end_date) + assert_character_scalar(in_unit, values = valid_time_units()) + assert_character_scalar(out_unit, values = c(valid_time_units(), "weeks")) assert_logical_scalar(floor_in) assert_logical_scalar(add_one) assert_logical_scalar(trunc_out) diff --git a/R/compute_qual_imputation.R b/R/compute_qual_imputation.R index a37faf6d67..2e8a916a00 100644 --- a/R/compute_qual_imputation.R +++ b/R/compute_qual_imputation.R @@ -72,9 +72,9 @@ compute_qual_imputation <- function(character_value, imputation_type = 1, factor numeric_value <- case_when( str_detect(character_value, ">") & !str_detect(character_value, "=") ~ - numeric_value + factor, + numeric_value + factor, str_detect(character_value, "<") & !str_detect(character_value, "=") ~ - numeric_value - factor, + numeric_value - factor, TRUE ~ numeric_value ) } @@ -83,9 +83,9 @@ compute_qual_imputation <- function(character_value, imputation_type = 1, factor numeric_value <- case_when( str_detect(character_value, ">") & !str_detect(character_value, "=") ~ - numeric_value + compute_qual_imputation_dec(character_value), + numeric_value + compute_qual_imputation_dec(character_value), str_detect(character_value, "<") & !str_detect(character_value, "=") ~ - numeric_value - compute_qual_imputation_dec(character_value), + numeric_value - compute_qual_imputation_dec(character_value), TRUE ~ numeric_value ) } diff --git a/R/create_query_data.R b/R/create_query_data.R index 631ad27102..1f4131259c 100644 --- a/R/create_query_data.R +++ b/R/create_query_data.R @@ -9,92 +9,57 @@ #' #' A list of `query()` objects is expected. #' -#' @param meddra_version MedDRA version +#' @param meddra_version *Deprecated*, please use `version` #' -#' The MedDRA version used for coding the terms in the AE dataset should be -#' specified. If any of the queries is a SMQ or a customized query including a -#' SMQ, the parameter needs to be specified. +#' @param whodd_version *Deprecated*, please use `version` #' -#' *Permitted Values*: A character string (the expected format is -#' company-specific) -#' -#' @param whodd_version WHO Drug Dictionary version +#' @param version Dictionary version #' -#' The version of the WHO Drug Dictionary used for coding the terms in the CM -#' dataset should be specified. If any of the queries is a SDG, the parameter -#' needs to be specified. +#' The dictionary version used for coding the terms should be specified. +#' If any of the queries is a basket (SMQ, SDG, ....) or a customized query +#' including a basket, the parameter needs to be specified. #' #' *Permitted Values*: A character string (the expected format is #' company-specific) #' -#' @param get_smq_fun Function which returns the terms of an SMQ -#' -#' For each query specified for the `queries` parameter which refers to an SMQ -#' (i.e., those where the `definition` field is set to a `smq_select()` object -#' or a list which contains at least one `smq_select()` object) the specified -#' function is called to retrieve the terms defining the query. This function -#' is not provided by admiral as it is company specific, i.e., it has to be -#' implemented at company level. -#' -#' The function must return a dataset with all the terms defining the SMQ. The -#' output dataset must contain the following variables. +#' @param get_smq_fun *Deprecated*, please use `get_terms_fun` #' -#' - `TERM_LEVEL`: the variable to be used for defining a term of the SMQ, e.g., -#' `AEDECOD` -#' - `TERM_NAME`: the name of the term if the variable `TERM_LEVEL` is -#' referring to is character -#' - `TERM_ID` the numeric id of the term if the variable `TERM_LEVEL` is -#' referring to is numeric -#' - `QUERY_NAME`: the name of the SMQ. The values must be the same for all -#' observations. +#' @param get_sdg_fun *Deprecated*, please use `get_terms_fun` #' -#' The function must provide the following parameters +#' @param get_terms_fun Function which returns the terms #' -#' - `smq_select`: A `smq_select()` object. -#' - `version`: The MedDRA version. The value specified for the -#' `meddra_version` in the `create_query_data()` call is passed to this -#' parameter. -#' - `keep_id`: If set to `TRUE`, the output dataset must contain the -#' `QUERY_ID` variable. The variable must be set to the numeric id of the SMQ. -#' - `temp_env`: A temporary environment is passed to this parameter. It can -#' be used to store data which is used for all SMQs in the -#' `create_query_data()` call. For example if the SMQs need to be read from a -#' database all SMQs can be read and stored in the environment when the first -#' SMQ is handled. For the other SMQs the terms can be retrieved from the -#' environment instead of accessing the database again. -#' -#' @param get_sdg_fun Function which returns the terms of an SDG -#' -#' For each query specified for the `queries` parameter which refers to an SDG -#' the specified function is called to retrieve the terms defining the query. +#' For each query specified for the `queries` parameter referring to a basket +#' (i.e., those where the `definition` field is set to a `basket_select()` +#' object or a list which contains at least one `basket_select()` object) the +#' specified function is called to retrieve the terms defining the query. #' This function is not provided by admiral as it is company specific, i.e., #' it has to be implemented at company level. #' -#' The function must return a dataset with all the terms defining the SDG. The -#' output dataset must contain the following variables. +#' The function must return a dataset with all the terms defining the basket. +#' The output dataset must contain the following variables. #' -#' - `TERM_LEVEL`: the variable to be used for defining a term of the SDG, e.g., -#' `CMDECOD` +#' - `TERM_LEVEL`: the variable to be used for defining a term of the basket, +#' e.g., `AEDECOD` #' - `TERM_NAME`: the name of the term if the variable `TERM_LEVEL` is #' referring to is character #' - `TERM_ID` the numeric id of the term if the variable `TERM_LEVEL` is #' referring to is numeric -#' - `QUERY_NAME`: the name of the SDG. The values must be the same for all -#' observations. +#' - `QUERY_NAME`: the name of the basket. The values must be the same for +#' all observations. #' #' The function must provide the following parameters #' -#' - `sdg_select`: A `sdg_select()` object. -#' - `version`: The WHO drug dictionary version. The value specified for the -#' `whodd_version` in the `create_query_data()` call is passed to this +#' - `basket_select`: A `basket_select()` object. +#' - `version`: The dictionary version. The value specified for the +#' `version` in the `create_query_data()` call is passed to this #' parameter. #' - `keep_id`: If set to `TRUE`, the output dataset must contain the -#' `QUERY_ID` variable. The variable must be set to the numeric id of the SDG. +#' `QUERY_ID` variable. The variable must be set to the numeric id of the basket. #' - `temp_env`: A temporary environment is passed to this parameter. It can -#' be used to store data which is used for all SDGs in the -#' `create_query_data()` call. For example if the SDGs need to be read from a -#' database all SDGs can be read and stored in the environment when the first -#' SDG is handled. For the other SDGs the terms can be retrieved from the +#' be used to store data which is used for all baskets in the +#' `create_query_data()` call. For example if SMQs need to be read from a +#' database all SMQs can be read and stored in the environment when the first +#' SMQ is handled. For the other SMQs the terms can be retrieved from the #' environment instead of accessing the database again. #' #' @details @@ -104,14 +69,12 @@ #' to the `definition` field of the query: if the definition field of the #' `query()` object is #' -#' * an `smq_select()` object, the terms are read from the SMQ -#' database by calling the function specified for the `get_smq_fun` parameter. -#' * an `sdg_select()` object, the terms are read from the SDG -#' database by calling the function specified for the `get_sdg_fun` parameter. +#' * a `basket_select()` object, the terms are read from the basket +#' database by calling the function specified for the `get_terms_fun` parameter. #' * a data frame, the terms stored in the data frame are used. -#' * a list of data frames and `smq_select()` objects, all terms from -#' the data frames and all terms read from the SMQ database referenced by the -#' `smq_select()` objects are collated. +#' * a list of data frames and `basket_select()` objects, all terms from +#' the data frames and all terms read from the basket database referenced by the +#' `basket_select()` objects are collated. #' #' The following variables (as described in [Queries Dataset #' Documentation](../articles/queries_dataset.html)) are created: @@ -123,34 +86,35 @@ #' element is not specified for a query, the variable is set to `NA`. If the #' `id` element is not specified for any query, the variable is not created. #' * `QUERY_SCOPE`: scope of the query as specified by the `scope` element of -#' the `smq_select()` object. For queries not defined by a `smq_select()` +#' the `basket_select()` object. For queries not defined by a `basket_select()` #' object, the variable is set to `NA`. If none of the queries is defined by a -#' `smq_select()` object, the variable is not created. +#' `basket_select()` object, the variable is not created. #' * `QUERY_SCOPE_NUM`: numeric scope of the query. It is set to `1` if the -#' scope is broad. Otherwise it is set to '2'. If the `add_scope_num` element +#' scope is broad. Otherwise it is set to `2`. If the `add_scope_num` element #' equals `FALSE`, the variable is set to `NA`. If the `add_scope_num` element -#' equals `FALSE` for all SMQs or none of the queries is an SMQ , the variable +#' equals `FALSE` for all baskets or none of the queries is an basket , the variable #' is not created. #' * `TERM_LEVEL`: Name of the variable used to identify the terms. #' * `TERM_NAME`: Value of the term variable if it is a character variable. #' * `TERM_ID`: Value of the term variable if it is a numeric variable. +#' * `VERSION`: Set to the value of the `version` argument. If it is not +#' specified, the variable is not created. #' -#' @author Stefan Bundfuss +#' @author Stefan Bundfuss, Tamara Senior #' #' @return A dataset to be used as input dataset to the `dataset_queries` #' argument in `derive_vars_query()` #' -#' @family der_occds -#' @keywords der_occds +#' @family create_aux +#' @keywords create_aux #' -#' @seealso [derive_vars_query()], [query()], [smq_select()], [sdg_select()], [Queries Dataset +#' @seealso [derive_vars_query()], [query()], [basket_select()], [Queries Dataset #' Documentation](../articles/queries_dataset.html) #' #' @export #' #' @examples #' library(tibble) -#' library(magrittr, warn.conflicts = FALSE) #' library(dplyr, warn.conflicts = FALSE) #' library(admiral.test) #' library(admiral) @@ -175,47 +139,51 @@ #' pregsmq <- query( #' prefix = "SMQ02", #' id = auto, -#' definition = smq_select( +#' definition = basket_select( #' name = "Pregnancy and neonatal topics (SMQ)", -#' scope = "NARROW" +#' scope = "NARROW", +#' type = "smq" #' ) #' ) #' #' bilismq <- query( #' prefix = "SMQ04", -#' definition = smq_select( +#' definition = basket_select( #' id = 20000121L, -#' scope = "BROAD" +#' scope = "BROAD", +#' type = "smq" #' ) #' ) #' -#' # The get_smq_terms function from admiral.test is used for this example. +#' # The get_terms function from admiral.test is used for this example. #' # In a real application a company-specific function must be used. #' create_query_data( #' queries = list(pregsmq, bilismq), -#' get_smq_fun = admiral.test:::get_smq_terms, -#' meddra_version = "20.1" +#' get_terms_fun = admiral.test:::get_terms, +#' version = "20.1" #' ) #' #' # create a query dataset for SDGs #' sdg <- query( #' prefix = "SDG01", #' id = auto, -#' definition = sdg_select( -#' name = "5-aminosalicylates for ulcerative colitis" +#' definition = basket_select( +#' name = "5-aminosalicylates for ulcerative colitis", +#' scope = NA_character_, +#' type = "sdg" #' ) #' ) #' -#' # The get_sdg_terms function from admiral.test is used for this example. +#' # The get_terms function from admiral.test is used for this example. #' # In a real application a company-specific function must be used. #' create_query_data( #' queries = list(sdg), -#' get_sdg_fun = admiral.test:::get_sdg_terms, -#' whodd_version = "2019-09" +#' get_terms_fun = admiral.test:::get_terms, +#' version = "2019-09" #' ) #' #' # creating a query dataset for a customized query including SMQs -#' # The get_smq_terms function from admiral.test is used for this example. +#' # The get_terms function from admiral.test is used for this example. #' # In a real application a company-specific function must be used. #' create_query_data( #' queries = list( @@ -223,31 +191,53 @@ #' prefix = "CQ03", #' name = "Special issues of interest", #' definition = list( -#' smq_select( +#' basket_select( #' name = "Pregnancy and neonatal topics (SMQ)", -#' scope = "NARROW" +#' scope = "NARROW", +#' type = "smq" #' ), #' cqterms #' ) #' ) #' ), -#' get_smq_fun = admiral.test:::get_smq_terms, -#' meddra_version = "20.1" +#' get_terms_fun = admiral.test:::get_terms, +#' version = "20.1" #' ) create_query_data <- function(queries, - meddra_version = NULL, - whodd_version = NULL, - get_smq_fun = NULL, - get_sdg_fun = NULL) { + meddra_version = deprecated(), + whodd_version = deprecated(), + version = NULL, + get_smq_fun = deprecated(), + get_sdg_fun = deprecated(), + get_terms_fun = NULL) { + if (!missing(meddra_version)) { + deprecate_stop( + "0.9.0", + "create_query_data(meddra_version = )", "create_query_data(version = )" + ) + } + if (!missing(whodd_version)) { + deprecate_stop( + "0.9.0", + "create_query_data(whodd_version = )", "create_query_data(version = )" + ) + } + if (!missing(get_smq_fun)) { + deprecate_stop( + "0.9.0", + "create_query_data(get_smq_fun = )", "create_query_data(get_terms_fun = )" + ) + } + if (!missing(get_sdg_fun)) { + deprecate_stop( + "0.9.0", + "create_query_data(get_sdg_fun = )", "create_query_data(get_terms_fun = )" + ) + } # check parameters - assert_character_scalar(meddra_version, optional = TRUE) - assert_character_scalar(whodd_version, optional = TRUE) - assert_function(get_smq_fun, - params = c("smq_select", "version", "keep_id", "temp_env"), - optional = TRUE - ) - assert_function(get_sdg_fun, - params = c("sdg_select", "version", "keep_id", "temp_env"), + assert_character_scalar(version, optional = TRUE) + assert_function(get_terms_fun, + params = c("basket_select", "version", "keep_id", "temp_env"), optional = TRUE ) @@ -258,18 +248,17 @@ create_query_data <- function(queries, query_data <- vector("list", length(queries)) for (i in seq_along(queries)) { # get term names and term variable - if (inherits(queries[[i]]$definition, "smq_select")) { - # query is a SMQ + if (inherits(queries[[i]]$definition, "basket_select")) { + # query is a basket query_data[[i]] <- get_terms_from_db( - version = meddra_version, - fun = get_smq_fun, + version = version, + fun = get_terms_fun, queries = queries, definition = queries[[i]]$definition, expect_query_name = TRUE, expect_query_id = !is.null(queries[[i]]$id), i = i, - temp_env = temp_env, - type = "SMQ" + temp_env = temp_env ) query_data[[i]] <- mutate(query_data[[i]], QUERY_SCOPE = queries[[i]]$definition$scope @@ -280,24 +269,11 @@ create_query_data <- function(queries, QUERY_SCOPE_NUM = if_else(QUERY_SCOPE == "BROAD", 1, 2) ) } - } else if (inherits(queries[[i]]$definition, "sdg_select")) { - # query is a SDG - query_data[[i]] <- get_terms_from_db( - version = whodd_version, - fun = get_sdg_fun, - queries = queries, - definition = queries[[i]]$definition, - expect_query_name = TRUE, - expect_query_id = !is.null(queries[[i]]$id), - i = i, - temp_env = temp_env, - type = "SDG" - ) } else if (is.data.frame(queries[[i]]$definition)) { # query is a customized query query_data[[i]] <- queries[[i]]$definition } else if (is.list(queries[[i]]$definition)) { - # query is defined by customized queries and SMQs + # query is defined by customized queries and baskets definition <- queries[[i]]$definition terms <- vector("list", length(definition)) for (j in seq_along(definition)) { @@ -305,13 +281,12 @@ create_query_data <- function(queries, terms[[j]] <- definition[[j]] } else { terms[[j]] <- get_terms_from_db( - version = meddra_version, - fun = get_smq_fun, + version = version, + fun = get_terms_fun, queries = queries, definition = definition[[j]], i = i, - temp_env = temp_env, - type = "SMQ" + temp_env = temp_env ) } } @@ -319,12 +294,14 @@ create_query_data <- function(queries, } # add mandatory variables - query_data[[i]] <- mutate(query_data[[i]], + query_data[[i]] <- mutate( + query_data[[i]], VAR_PREFIX = queries[[i]]$prefix ) if (!is_auto(queries[[i]]$name)) { - query_data[[i]] <- mutate(query_data[[i]], + query_data[[i]] <- mutate( + query_data[[i]], QUERY_NAME = queries[[i]]$name ) } @@ -336,7 +313,15 @@ create_query_data <- function(queries, ) } } - bind_rows(query_data) + queries <- bind_rows(query_data) + + if (!is.null(version)) { + queries <- mutate( + queries, + VERSION = version + ) + } + queries } #' Get Terms from the Queries Database @@ -378,10 +363,6 @@ create_query_data <- function(queries, #' #' The value is passed to the access function. #' -#' @param type Type of query -#' -#' *Permitted Values*: `"smq"`, `"sdg"` -#' #' @family der_occds #' @keywords der_occds #' @@ -395,35 +376,35 @@ get_terms_from_db <- function(version, expect_query_name = FALSE, expect_query_id = FALSE, i, - temp_env, - type) { + temp_env) { assert_db_requirements( version = version, version_arg_name = arg_name(substitute(version)), fun = fun, fun_arg_name = arg_name(substitute(fun)), queries = queries, - i = i, - type = type + i = i ) - select <- rlang::parse_expr(paste0(str_to_lower(type), "_select = definition")) fun_call <- quo(fun( - !!select, + basket_select = definition, version = version, keep_id = expect_query_id, temp_env = temp_env )) - terms <- call_user_fun(fun_call) + terms <- call_user_fun( + fun( + basket_select = definition, + version = version, + keep_id = expect_query_id, + temp_env = temp_env + ) + ) assert_terms( terms, expect_query_name = expect_query_name, expect_query_id = expect_query_id, source_text = paste0( - "object returned by calling get_", - str_to_lower(type), - "_fun(", - str_to_lower(type), - "_select = ", + "object returned by calling get_terms_fun(basket_select = ", format(definition), ", version = ", dquote(version), @@ -435,9 +416,9 @@ get_terms_from_db <- function(version, terms } -#' Check required parameters for SMQ/SDG +#' Check required parameters for a basket #' -#' If SMQs or SDGs are requested, the version and a function to access the +#' If a basket (SMQ, SDG, ....) are requested, the version and a function to access the #' database must be provided. The function checks these requirements. #' #' @param version Version provided by user @@ -452,25 +433,20 @@ get_terms_from_db <- function(version, #' #' @param i Index of query being checked #' -#' @param type Type of query -#' -#' Should be `"SMQ`" or `"SDG"`. -#' #' @keywords source_specifications #' @family source_specifications #' #' @return An error is issued if `version` or `fun` is null. #' #' @author Stefan Bundfuss -assert_db_requirements <- function(version, version_arg_name, fun, fun_arg_name, queries, i, type) { +assert_db_requirements <- function(version, version_arg_name, fun, fun_arg_name, queries, i) { if (is.null(fun)) { msg <- paste0( fun_arg_name, - " is not specified. This is expected for ", - type, + " is not specified. This is expected for basket", "s.\n", - "A ", type, " is requested by query ", + "A basket is requested by query ", i, ":\n", paste(capture.output(str(queries[[i]])), @@ -483,12 +459,9 @@ assert_db_requirements <- function(version, version_arg_name, fun, fun_arg_name, msg <- paste0( version_arg_name, - " is not specified. This is expected for ", - type, + " is not specified. This is expected for basket", "s.\n", - "A ", - type, - " is requested by query ", + "A basket is requested by query ", i, ":\n", paste(capture.output(str(queries[[i]])), @@ -514,7 +487,7 @@ assert_db_requirements <- function(version, version_arg_name, fun, fun_arg_name, #' #' *Permitted Values*: A character scalar or the `auto` keyword. The `auto` #' keyword is permitted only for queries which are defined by an -#' `smq_select()` or `sdg_select()` object. +#' `basket_select()` object. #' #' @param id The value is used to populate `QUERY_ID` in the output dataset of #' `create_query_data()`. If the `auto` keyword is specified, the variable is @@ -522,12 +495,12 @@ assert_db_requirements <- function(version, version_arg_name, fun, fun_arg_name, #' #' *Permitted Values*: A integer scalar or the `auto` keyword. The `auto` #' keyword is permitted only for queries which are defined by an -#' `smq_select()` or `sdg_select()` object. +#' `basket_select()` object. #' #' @param add_scope_num Determines if `QUERY_SCOPE_NUM` in the output dataset #' of `create_query_data()` is populated #' -#' If the parameter is set to `TRUE`, the definition must be an `smq_select()` +#' If the parameter is set to `TRUE`, the definition must be an `basket_select()` #' object. #' #' *Default*: `FALSE` @@ -536,12 +509,9 @@ assert_db_requirements <- function(version, version_arg_name, fun, fun_arg_name, #' #' @param definition Definition of terms belonging to the query #' -#' There are four different ways to define the terms: +#' There are three different ways to define the terms: #' -#' * An `smq_select()` object is specified to select a query from the SMQ -#' database. -#' -#' * An `sdg_select()` object is specified to select a query from the SDG +#' * An `basket_select()` object is specified to select a query from the SMQ #' database. #' #' * A data frame with columns `TERM_LEVEL` and `TERM_NAME` or `TERM_ID` can @@ -557,16 +527,16 @@ assert_db_requirements <- function(version, version_arg_name, fun, fun_arg_name, #' or only numeric variables are used, `TERM_ID` or `TERM_NAME` respectively #' can be omitted. #' -#' * A list of data frames and `smq_select()` objects can be specified to +#' * A list of data frames and `basket_select()` objects can be specified to #' define a customized query based on custom terms and SMQs. The data frames #' must have the same structure as described for the previous item. #' -#' *Permitted Values*: an `smq_select()` object, an `sdg_select()` object, a -#' data frame, or a list of data frames and `smq_select()` objects. +#' *Permitted Values*: an `basket_select()` object, a +#' data frame, or a list of data frames and `basket_select()` objects. #' #' @author Stefan Bundfuss #' -#' @seealso [create_query_data()], [smq_select()], [sdg_select()], [Queries Dataset +#' @seealso [create_query_data()], [basket_select()], [Queries Dataset #' Documentation](../articles/queries_dataset.html) #' #' @family source_specifications @@ -580,15 +550,16 @@ assert_db_requirements <- function(version, version_arg_name, fun, fun_arg_name, #' #' # create a query for an SMQ #' library(tibble) -#' library(magrittr, warn.conflicts = FALSE) #' library(dplyr, warn.conflicts = FALSE) #' +#' # create a query for a SMQ #' query( #' prefix = "SMQ02", #' id = auto, -#' definition = smq_select( +#' definition = basket_select( #' name = "Pregnancy and neonatal topics (SMQ)", -#' scope = "NARROW" +#' scope = "NARROW", +#' type = "smq" #' ) #' ) #' @@ -596,8 +567,10 @@ assert_db_requirements <- function(version, version_arg_name, fun, fun_arg_name, #' query( #' prefix = "SDG01", #' id = auto, -#' definition = sdg_select( -#' name = "5-aminosalicylates for ulcerative colitis" +#' definition = basket_select( +#' name = "5-aminosalicylates for ulcerative colitis", +#' scope = NA_character_, +#' type = "sdg" #' ) #' ) #' @@ -621,13 +594,15 @@ assert_db_requirements <- function(version, version_arg_name, fun, fun_arg_name, #' name = "Special issues of interest", #' definition = list( #' cqterms, -#' smq_select( +#' basket_select( #' name = "Pregnancy and neonatal topics (SMQ)", -#' scope = "NARROW" +#' scope = "NARROW", +#' type = "smq" #' ), -#' smq_select( +#' basket_select( #' id = 8050L, -#' scope = "BROAD" +#' scope = "BROAD", +#' type = "smq" #' ) #' ) #' ) @@ -652,7 +627,7 @@ query <- function(prefix, if (!is_auto(out$id)) { out$id <- eval_tidy(out$id) } - class(out) <- c("query", "list") + class(out) <- c("query", "source", "list") validate_query(out) } @@ -660,7 +635,7 @@ query <- function(prefix, #' #' @param obj An object to be validated. #' -#' @author Stefan Bundfuss +#' @author Stefan Bundfuss Tamara Senior #' #' @keywords source_specifications #' @family source_specifications @@ -688,7 +663,7 @@ validate_query <- function(obj) { scope <- values$scope assert_character_scalar(scope, - values = c("BROAD", "NARROW"), + values = c("BROAD", "NARROW", NA_character_), optional = TRUE ) @@ -696,19 +671,14 @@ validate_query <- function(obj) { assert_logical_scalar(add_scope_num, optional = TRUE ) - if (add_scope_num && !inherits(values$definition, "smq_select")) { - abort("`add_scope_num == TRUE` must be used for SMQs only.") - } - if (inherits(values$definition, "smq_select")) { - validate_smq_select(values$definition) - } else if (inherits(values$definition, "sdg_select")) { - validate_sdg_select(values$definition) + if (inherits(values$definition, "basket_select")) { + validate_basket_select(values$definition) } else if (is.data.frame(values$definition) || is.list(values$definition)) { if (is_auto(values$name)) { abort( paste0( - "The auto keyword can be used for SMQs and SDGs only.\n", + "The auto keyword can be used for baskets only.\n", "It was provided for the name element." ) ) @@ -716,7 +686,7 @@ validate_query <- function(obj) { if (is_auto(values$id)) { abort( paste0( - "The auto keyword can be used for SMQs and SDGs only.\n", + "The auto keyword can be used for baskets only.\n", "It was provided for the id element." ) ) @@ -729,19 +699,20 @@ validate_query <- function(obj) { } else { is_valid <- map_lgl(values$definition, is.data.frame) | - map_lgl(values$definition, inherits, "smq_select") + map_lgl(values$definition, inherits, "basket_select") if (!all(is_valid)) { - info_msg <- paste(sprintf( - "\u2716 Element %s is %s", - which(!is_valid), - map_chr(values$definition[!is_valid], what_is_it) - ), - collapse = "\n" + info_msg <- paste( + sprintf( + "\u2716 Element %s is %s", + which(!is_valid), + map_chr(values$definition[!is_valid], what_is_it) + ), + collapse = "\n" ) err_msg <- sprintf( paste( "Each element of the list in the definition field must be a data frame", - "or an object of class `smq_select` but the following are not:\n%s" + "or an object of class `basket_select` but the following are not:\n%s" ), info_msg ) @@ -760,8 +731,8 @@ validate_query <- function(obj) { } else { abort( paste0( - "`definition` expects a `smq_select` or `sdg_select` object, a data frame,", - " or a list of data frames and `smq_select` objects.\n", + "`definition` expects a `basket_select` object, a data frame,", + " or a list of data frames and `basket_select` objects\n", "An object of the following class was provided: ", class(values$definition) ) @@ -862,7 +833,7 @@ assert_terms <- function(terms, ) } } - if (!"TERM_NAME" %in% vars & !"TERM_ID" %in% vars) { + if (!"TERM_NAME" %in% vars && !"TERM_ID" %in% vars) { abort( paste0( "Variable `TERM_NAME` or `TERM_ID` is required.\n", @@ -876,7 +847,7 @@ assert_terms <- function(terms, } } -#' Create an `smq_select` object +#' Create a `basket_select` object #' #' @param name Name of the query used to select the definition of the query from #' the company database. @@ -887,13 +858,17 @@ assert_terms <- function(terms, #' @param scope Scope of the query used to select the definition of the query #' from the company database. #' -#' *Permitted Values*: `"BROAD"`, `"NARROW"` +#' *Permitted Values*: `"BROAD"`, `"NARROW"`, `NA_character_` +#' +#' @param type The type argument expects a character scalar. It is passed to the +#' company specific get_terms() function such that the function can determine +#' which sort of basket is requested #' #' @details Exactly one of `name` or `id` must be specified. #' -#' @return An object of class `smq_select`. +#' @return An object of class `basket_select`. #' -#' @author Stefan Bundfuss +#' @author Tamara Senior #' #' @seealso [create_query_data()], [query()] #' @@ -901,34 +876,36 @@ assert_terms <- function(terms, #' @keywords source_specifications #' #' @export -smq_select <- function(name = NULL, - id = NULL, - scope = NULL) { +basket_select <- function(name = NULL, + id = NULL, + scope = NULL, + type) { out <- list( name = name, id = id, - scope = scope + scope = scope, + type = type ) - class(out) <- c("smq_select", "list") - validate_smq_select(out) + class(out) <- c("basket_select", "source", "list") + validate_basket_select(out) } -#' Validate an object is indeed a `smq_select` object +#' Validate an object is indeed a `basket_select` object #' #' @param obj An object to be validated. #' -#' @seealso [smq_select()] +#' @seealso [basket_select()] #' #' @keywords source_specifications #' @family source_specifications #' -#' @author Stefan Bundfuss +#' @author Tamara Senior #' #' @export #' #' @return The original object. -validate_smq_select <- function(obj) { - assert_s3_class(obj, "smq_select") +validate_basket_select <- function(obj) { + assert_s3_class(obj, "basket_select") values <- unclass(obj) name <- values$name assert_character_scalar(name, @@ -940,7 +917,7 @@ validate_smq_select <- function(obj) { ) scope <- values$scope assert_character_scalar(scope, - values = c("BROAD", "NARROW") + values = c("BROAD", "NARROW", NA_character_) ) if (is.null(values$id) && is.null(values$name)) { @@ -952,20 +929,20 @@ validate_smq_select <- function(obj) { obj } -#' Returns a Character Representation of a `smq_select()` Object +#' Returns a Character Representation of a `basket_select()` Object #' -#' The function returns a character representation of a `smq_select()` object. +#' The function returns a character representation of a `basket_select()` object. #' It can be used for error messages for example. #' -#' @param x A `smq_select()` object +#' @param x A `basket_select()` object #' #' @param ... Not used #' -#' @return A character representation of the `smq_select()` object +#' @return A character representation of the `basket_select()` object #' -#' @author Stefan Bundfuss +#' @author Tamara Senior #' -#' @seealso [smq_select()] +#' @seealso [basket_select()] #' #' @keywords source_specifications #' @family source_specifications @@ -974,30 +951,41 @@ validate_smq_select <- function(obj) { #' #' @examples #' -#' format(smq_select(id = 42, scope = "NARROW")) -format.smq_select <- function(x, ...) { +#' format(basket_select(id = 42, scope = "NARROW", type = "smq")) +format.basket_select <- function(x, ...) { paste0( - "smq_select(name = ", + "basket_select(name = ", dquote(x$name), ", id = ", format(x$id), ", scope = ", dquote(x$scope), + ", type = ", + dquote(x$type), ")" ) } -#' Create an `sdg_select` object +#' Create an `smq_select` object #' -#' @param name Name of the query used to select the definition of the query -#' from the company database. +#' `r lifecycle::badge("deprecated")` +#' +#' This function is *deprecated*, please use `basket_select()` instead. +#' +#' @param name Name of the query used to select the definition of the query from +#' the company database. #' #' @param id Identifier of the query used to select the definition of the query #' from the company database. #' -#' @details Exactly one `name` or `id` must be specified. +#' @param scope Scope of the query used to select the definition of the query +#' from the company database. #' -#' @return An object of class `sdg_select`. +#' *Permitted Values*: `"BROAD"`, `"NARROW"` +#' +#' @details Exactly one of `name` or `id` must be specified. +#' +#' @return An object of class `smq_select`. #' #' @author Stefan Bundfuss #' @@ -1007,83 +995,37 @@ format.smq_select <- function(x, ...) { #' @keywords source_specifications #' #' @export -sdg_select <- function(name = NULL, - id = NULL) { - out <- list( - name = name, - id = id - ) - class(out) <- c("sdg_select", "list") - validate_sdg_select(out) +smq_select <- function(name = NULL, + id = NULL, + scope = NULL) { + deprecate_stop("0.9.0", "smq_select()", "basket_select()") } -#' Validate an object is indeed a `sdg_select` object -#' -#' @param obj An object to be validated. -#' -#' @author Stefan Bundfuss -#' -#' @seealso [sdg_select()] +#' Create an `sdg_select` object #' -#' @keywords source_specifications -#' @family source_specifications +#' `r lifecycle::badge("deprecated")` #' -#' @export +#' This function is *deprecated*, please use `basket_select()` instead. #' -#' @return The original object. -validate_sdg_select <- function(obj) { - assert_s3_class(obj, "sdg_select") - values <- unclass(obj) - name <- values$name - assert_character_scalar(name, - optional = TRUE - ) - id <- values$id - assert_integer_scalar(id, - optional = TRUE - ) - if (is.null(values$id) && is.null(values$name)) { - abort("Either id or name has to be non null.") - } - if (!is.null(values$id) && !is.null(values$name)) { - abort("Either id or name has to be null.") - } - obj -} - -#' Returns a Character Representation of a `sdg_select()` Object -#' -#' The function returns a character representation of a `sdg_select()` object. -#' It can be used for error messages for example. +#' @param name Name of the query used to select the definition of the query +#' from the company database. #' -#' @param x A `sdg_select()` object +#' @param id Identifier of the query used to select the definition of the query +#' from the company database. #' -#' @param ... Not used +#' @details Exactly one `name` or `id` must be specified. #' -#' @return A character representation of the `sdg_select()` object +#' @return An object of class `sdg_select`. #' #' @author Stefan Bundfuss #' -#' @seealso [sdg_select()] +#' @seealso [create_query_data()], [query()] #' -#' @keywords source_specifications #' @family source_specifications +#' @keywords source_specifications #' #' @export -#' -#' @examples -#' -#' format( -#' sdg_select( -#' name = "5-aminosalicylates for ulcerative colitis" -#' ) -#' ) -format.sdg_select <- function(x, ...) { - paste0( - "sdg_select(name = ", - dquote(x$name), - ", id = ", - format(x$id), - ")" - ) +sdg_select <- function(name = NULL, + id = NULL) { + deprecate_stop("0.9.0", "sdg_select()", "basket_select()") } diff --git a/R/create_single_dose_dataset.R b/R/create_single_dose_dataset.R index f42bb60c35..45232224d6 100644 --- a/R/create_single_dose_dataset.R +++ b/R/create_single_dose_dataset.R @@ -132,13 +132,13 @@ dose_freq_lookup <- tibble::tribble( mutate( DOSE_COUNT = case_when( str_detect(CDISC_VALUE, "PER [WMY]") ~ - as.numeric(str_remove_all(CDISC_VALUE, "[\\D]")), + as.numeric(str_remove_all(CDISC_VALUE, "[\\D]")), str_detect(CDISC_VALUE, "PER [D]") ~ - 24 / as.numeric(str_remove_all(CDISC_VALUE, "[\\D]")), + 24 / as.numeric(str_remove_all(CDISC_VALUE, "[\\D]")), str_detect(CDISC_VALUE, "^Q\\d{1,2}(H|MIN)") ~ - 1 / as.numeric(str_remove_all(CDISC_VALUE, "[\\D]")), + 1 / as.numeric(str_remove_all(CDISC_VALUE, "[\\D]")), str_detect(CDISC_VALUE, "^(Q|EVERY)\\s?\\d{1,2}") ~ - 1 / as.numeric(str_remove_all(CDISC_VALUE, "[\\D]")), + 1 / as.numeric(str_remove_all(CDISC_VALUE, "[\\D]")), str_detect(CDISC_VALUE, "^EVERY (A|E|W)[:alpha:]+") ~ 1, str_detect(CDISC_VALUE, "^Q(AM|PM|M|N|D|HS)|^PA$") ~ 1, str_detect(CDISC_VALUE, "^QH$") ~ 1, @@ -149,7 +149,7 @@ dose_freq_lookup <- tibble::tribble( ), DOSE_WINDOW = case_when( str_detect(CDISC_VALUE, "EVERY \\d{1,2}|PER [WMY]") ~ - str_remove_all(sub(".* (\\w+)$", "\\1", CDISC_VALUE), "S"), + str_remove_all(sub(".* (\\w+)$", "\\1", CDISC_VALUE), "S"), str_detect(CDISC_VALUE, "^Q\\d{1,2}D$") ~ "DAY", str_detect(CDISC_VALUE, "^Q\\d{1,2}M$") ~ "MONTH", str_detect(CDISC_VALUE, "^Q\\d{0,2}H$|PER D") ~ "HOUR", @@ -190,8 +190,6 @@ dose_freq_lookup <- tibble::tribble( #' #' The aggregate dosing frequency used for multiple doses in a row. #' -#' Default: `EXDOSFRQ` -#' #' Permitted Values: defined by lookup table. #' #' @param start_date The start date @@ -201,8 +199,6 @@ dose_freq_lookup <- tibble::tribble( #' Refer to `derive_vars_dt()` to impute and derive a date from a date #' character vector to a date object. #' -#' Default: `ASTDT` -#' #' @param start_datetime The start date-time #' #' A date-time object is expected. This object cannot contain `NA` values. @@ -210,7 +206,8 @@ dose_freq_lookup <- tibble::tribble( #' Refer to `derive_vars_dtm()` to impute and derive a date-time from a date #' character vector to a date object. #' -#' Default: `ASTDTM` +#' If the input dataset contains frequencies which refer to `DOSE_WINDOW` +#' equals `"HOUR"` or `"MINUTE"`, the parameter must be specified. #' #' @param end_date The end date #' @@ -219,8 +216,6 @@ dose_freq_lookup <- tibble::tribble( #' Refer to `derive_vars_dt()` to impute and derive a date from a date #' character vector to a date object. #' -#' Default: `AENDT` -#' #' @param end_datetime The end date-time #' #' A date-time object is expected. This object cannot contain `NA` values. @@ -228,7 +223,8 @@ dose_freq_lookup <- tibble::tribble( #' Refer to `derive_vars_dtm()` to impute and derive a date-time from a date #' character vector to a date object. #' -#' Default: `AENDTM` +#' If the input dataset contains frequencies which refer to `DOSE_WINDOW` +#' equals `"HOUR"` or `"MINUTE"`, the parameter must be specified. #' #' @param lookup_table The dose frequency value lookup table #' @@ -238,8 +234,6 @@ dose_freq_lookup <- tibble::tribble( #' `CONVERSION_FACTOR`. The default table `dose_freq_lookup` is described in #' detail [here][dose_freq_lookup]. #' -#' Default: `dose_freq_lookup` -#' #' Permitted Values for `DOSE_WINDOW`: `"MINUTE"`, `"HOUR"`, `"DAY"`, #' `"WEEK"`, `"MONTH"`, `"YEAR"` #' @@ -247,11 +241,11 @@ dose_freq_lookup <- tibble::tribble( #' #' The column of `lookup_table`. #' -#' Default: `CDISC_VALUE` (column of `dose_freq_lookup`) -#' #' @param keep_source_vars List of variables to be retained from source dataset #' -#' Default: vars(USUBJID, EXDOSFRQ, ASTDT, ASTDTM, AENDT, AENDTM) +#' This parameter can be specified if additional information is required in +#' the output dataset. For example `EXTRT` for studies with more than one +#' drug. #' #' @details Each aggregate dose row is split into multiple rows which each #' represent a single dose.The number of completed dose periods between @@ -261,10 +255,13 @@ dose_freq_lookup <- tibble::tribble( #' `CONVERSION_FACTOR` is used to convert into days the time object #' to be added to `start_date`. #' +#' Observations with dose frequency `"ONCE"` are copied to the output dataset +#' unchanged. +#' #' @author Michael Thorpe, Andrew Smith #' -#' @family der_occds -#' @keywords der_occds +#' @family create_aux +#' @keywords create_aux #' #' @return The input dataset with a single dose per row. #' @@ -275,8 +272,9 @@ dose_freq_lookup <- tibble::tribble( #' #' library(lubridate) #' library(stringr) +#' library(tibble) #' -#' data <- tibble::tribble( +#' data <- tribble( #' ~USUBJID, ~EXDOSFRQ, ~ASTDT, ~ASTDTM, ~AENDT, ~AENDTM, #' "P01", "Q2D", ymd("2021-01-01"), ymd_hms("2021-01-01 10:30:00"), #' ymd("2021-01-07"), ymd_hms("2021-01-07 11:30:00"), @@ -291,13 +289,13 @@ dose_freq_lookup <- tibble::tribble( #' #' # Example with custom lookup #' -#' custom_lookup <- tibble::tribble( -#' ~Value, ~DOSE_COUNT, ~DOSE_WINDOW, ~CONVERSION_FACTOR, -#' "Q30MIN", (1 / 30), "MINUTE", 1, -#' "Q90MIN", (1 / 90), "MINUTE", 1 +#' custom_lookup <- tribble( +#' ~Value, ~DOSE_COUNT, ~DOSE_WINDOW, ~CONVERSION_FACTOR, +#' "Q30MIN", (1 / 30), "MINUTE", 1, +#' "Q90MIN", (1 / 90), "MINUTE", 1 #' ) #' -#' data <- tibble::tribble( +#' data <- tribble( #' ~USUBJID, ~EXDOSFRQ, ~ASTDT, ~ASTDTM, ~AENDT, ~AENDTM, #' "P01", "Q30MIN", ymd("2021-01-01"), ymd_hms("2021-01-01T06:00:00"), #' ymd("2021-01-01"), ymd_hms("2021-01-01T07:00:00"), @@ -307,37 +305,42 @@ dose_freq_lookup <- tibble::tribble( #' #' create_single_dose_dataset(data, #' lookup_table = custom_lookup, -#' lookup_column = Value +#' lookup_column = Value, +#' start_datetime = ASTDTM, +#' end_datetime = AENDTM #' ) create_single_dose_dataset <- function(dataset, dose_freq = EXDOSFRQ, start_date = ASTDT, - start_datetime = ASTDTM, + start_datetime = NULL, end_date = AENDT, - end_datetime = AENDTM, + end_datetime = NULL, lookup_table = dose_freq_lookup, lookup_column = CDISC_VALUE, - keep_source_vars = vars( - USUBJID, EXDOSFRQ, ASTDT, ASTDTM, - AENDT, AENDTM + keep_source_vars = quo_c( + vars(USUBJID), dose_freq, start_date, start_datetime, + end_date, end_datetime )) { - col_names <- colnames(dataset) dose_freq <- assert_symbol(enquo(dose_freq)) lookup_column <- assert_symbol(enquo(lookup_column)) start_date <- assert_symbol(enquo(start_date)) - start_datetime <- assert_symbol(enquo(start_datetime)) + start_datetime <- assert_symbol(enquo(start_datetime), optional = TRUE) end_date <- assert_symbol(enquo(end_date)) - end_datetime <- assert_symbol(enquo(end_datetime)) + end_datetime <- assert_symbol(enquo(end_datetime), optional = TRUE) assert_data_frame(dataset, required_vars = quo_c(dose_freq, start_date, end_date)) - assert_data_frame(lookup_table, required_vars = vars(DOSE_WINDOW, DOSE_COUNT, CONVERSION_FACTOR)) + assert_data_frame( + lookup_table, + required_vars = vars(!!lookup_column, DOSE_WINDOW, DOSE_COUNT, CONVERSION_FACTOR) + ) assert_data_frame(dataset, required_vars = keep_source_vars) + col_names <- colnames(dataset) # Checking that the dates specified follow the ADaM naming convention of ending in DT start_datec <- as_string(as_name(start_date)) start_date_chk <- stringr::str_locate_all(start_datec, "DT") start_date_chk_pos <- as.vector(start_date_chk[[1]]) - if (stringr::str_length(start_datec) != start_date_chk_pos[-1]) { + if (str_length(start_datec) != start_date_chk_pos[-1]) { err_msg <- paste0( "The argument start_date is expected to have a name like xxxDT.\n", "Please check as it does not follow the expected naming convention" @@ -349,7 +352,7 @@ create_single_dose_dataset <- function(dataset, end_date_chk <- stringr::str_locate_all(end_datec, "DT") end_date_chk_pos <- as.vector(end_date_chk[[1]]) - if (stringr::str_length(end_datec) != end_date_chk_pos[-1]) { + if (str_length(end_datec) != end_date_chk_pos[-1]) { err_msg <- paste0( "The argument end_date is expected to have a name like xxxDT.\n", "Please check as it does not follow the expected naming convention" @@ -362,10 +365,21 @@ create_single_dose_dataset <- function(dataset, lookup <- lookup_table %>% rename(!!dose_freq := !!lookup_column) + # Observations with frequency ONCE are copied unchanged to the output dataset + data_once <- filter(dataset, !!dose_freq == "ONCE") + + data_not_once <- filter(dataset, !!dose_freq != "ONCE") + # Check that NAs do not appear in start_date or start_datetime or end_date or end_datetime columns - na_check <- dataset %>% - filter(is.na(!!start_date) | is.na(!!end_date) | - is.na(!!start_datetime) | is.na(!!end_datetime)) %>% + condition <- paste0("is.na(", as_name(start_date), ") | is.na(", as_name(end_date), ")") + if (!quo_is_null(start_datetime)) { + condition <- paste(condition, "| is.na(", as_name(start_datetime), ")") + } + if (!quo_is_null(end_datetime)) { + condition <- paste(condition, "| is.na(", as_name(end_datetime), ")") + } + na_check <- data_not_once %>% + filter(!!parse_expr(condition)) %>% select(!!start_date, !!end_date, !!start_datetime, !!end_datetime) if (nrow(na_check) > 0) { @@ -383,7 +397,7 @@ create_single_dose_dataset <- function(dataset, # Check values of lookup vs. data and return error if values are not covered - value_check <- dataset %>% + value_check <- data_not_once %>% select(!!dose_freq) %>% anti_join(lookup, by = as.character(quo_get_expr(dose_freq))) %>% unique() @@ -404,21 +418,38 @@ create_single_dose_dataset <- function(dataset, # Use compute_duration to determine the number of completed dose periods - dataset_part_1 <- dataset %>% - filter(!!dose_freq == "ONCE") - - dataset_part_2 <- dataset %>% - filter(!!dose_freq != "ONCE") - - dataset_part_2 <- dataset_part_2 %>% - left_join(lookup, by = as.character(quo_get_expr(dose_freq))) %>% - mutate(dose_periods = case_when( + if (quo_is_null(start_datetime)) { + min_hour_cases <- exprs(FALSE ~ 0) + } else { + min_hour_cases <- exprs( DOSE_WINDOW == "MINUTE" ~ compute_duration(!!start_datetime, !!end_datetime, in_unit = "minutes", out_unit = "minutes" ), DOSE_WINDOW == "HOUR" ~ compute_duration(!!start_datetime, !!end_datetime, in_unit = "hours", out_unit = "hours" - ), + ) + ) + } + data_not_once <- left_join( + data_not_once, + lookup, + by = as.character(quo_get_expr(dose_freq)) + ) + + if (any(data_not_once$DOSE_WINDOW %in% c("MINUTE", "HOUR")) & + (quo_is_null(start_datetime) | quo_is_null(end_datetime))) { + abort( + paste( + "There are dose frequencies more frequent than once a day.", + "Thus `start_datetime` and `end_datetime` must be specified.", + sep = "\n" + ) + ) + } + + data_not_once <- data_not_once %>% + mutate(dose_periods = case_when( + !!!min_hour_cases, DOSE_WINDOW == "DAY" ~ compute_duration(!!start_date, !!end_date, out_unit = "days"), DOSE_WINDOW == "WEEK" ~ compute_duration(!!start_date, !!end_date, out_unit = "weeks"), DOSE_WINDOW == "MONTH" ~ compute_duration(!!start_date, !!end_date, out_unit = "months"), @@ -429,55 +460,65 @@ create_single_dose_dataset <- function(dataset, # Generate a row for each completed dose - dataset_part_2 <- dataset_part_2[rep(row.names(dataset_part_2), dataset_part_2$dose_count), ] + data_not_once <- data_not_once[rep(row.names(data_not_once), data_not_once$dose_count), ] # Determine amount of days to adjust start_date or start_datetime and end_date or end_datetime - dataset_part_2 <- dataset_part_2 %>% + data_not_once <- data_not_once %>% group_by(grpseq, !!dose_freq, !!start_date, !!end_date) %>% mutate(time_increment = (row_number() - 1) / (DOSE_COUNT)) %>% ungroup() %>% mutate( time_differential = case_when( - DOSE_WINDOW == "MINUTE" ~ minutes(floor(.data$time_increment)), - DOSE_WINDOW == "HOUR" ~ hours(floor(.data$time_increment)), + DOSE_WINDOW == "MINUTE" ~ minutes(floor(time_increment)), + DOSE_WINDOW == "HOUR" ~ hours(floor(time_increment)), DOSE_WINDOW %in% c("DAY", "WEEK", "MONTH", "YEAR") ~ - days(floor(.data$time_increment / CONVERSION_FACTOR)) + days(floor(time_increment / CONVERSION_FACTOR)) ), time_differential_dt = case_when( - DOSE_WINDOW == "MINUTE" ~ days(floor(.data$time_increment / 1440)), - DOSE_WINDOW == "HOUR" ~ days(floor(.data$time_increment / 24)), + DOSE_WINDOW == "MINUTE" ~ days(floor(time_increment / 1440)), + DOSE_WINDOW == "HOUR" ~ days(floor(time_increment / 24)), DOSE_WINDOW %in% c("DAY", "WEEK", "MONTH", "YEAR") ~ - days(floor(.data$time_increment / CONVERSION_FACTOR)) + days(floor(time_increment / CONVERSION_FACTOR)) ) ) # Adjust start_date and end_date, drop calculation columns, make sure nothing # later than end_date shows up in output - dataset_part_2 <- dataset_part_2 %>% + data_not_once <- data_not_once %>% mutate( !!dose_freq := "ONCE", - !!start_date := !!start_date + .data$time_differential_dt, - !!start_datetime := !!start_datetime + .data$time_differential, + !!start_date := !!start_date + time_differential_dt ) + if (!quo_is_null(start_datetime)) { + data_not_once <- + mutate( + data_not_once, + !!start_datetime := !!start_datetime + time_differential + ) + } - dataset_part_2 <- dataset_part_2 %>% + data_not_once <- data_not_once %>% filter(!(!!start_date > !!end_date)) %>% mutate( - !!end_date := !!start_date, - !!end_datetime := case_when( - DOSE_WINDOW %in% c("MINUTE", "HOUR") ~ !!start_datetime, - DOSE_WINDOW %in% c("DAY", "WEEK", "MONTH", "YEAR") ~ - ymd_hms(paste0(!!start_date, " ", format(!!end_datetime, format = "%H:%M:%S"))) + !!end_date := !!start_date + ) + if (!quo_is_null(end_datetime)) { + data_not_once <- + mutate( + data_not_once, + !!end_datetime := case_when( + DOSE_WINDOW %in% c("MINUTE", "HOUR") ~ !!start_datetime, + DOSE_WINDOW %in% c("DAY", "WEEK", "MONTH", "YEAR") ~ + ymd_hms(paste0(!!start_date, " ", format(!!end_datetime, format = "%H:%M:%S"))) + ) ) - ) %>% - select(!!!vars(all_of(col_names))) + } + data_not_once <- select(data_not_once, !!!vars(all_of(col_names))) # Stitch back together - dataset <- bind_rows(dataset_part_1, dataset_part_2) - dataset <- dataset %>% select(!!!keep_source_vars) - - return(dataset) + bind_rows(data_once, data_not_once) %>% + select(!!!keep_source_vars) } diff --git a/R/data.R b/R/data.R index 7f17a1d257..51968113f4 100644 --- a/R/data.R +++ b/R/data.R @@ -37,7 +37,8 @@ #' #' @details #' This metadata has its origin in the ADLB Grading Spec Excel file which ships with `{admiral}` -#' and can be accessed using `system.file("adlb_grading/adlb_grading_spec.xlsx", package = "admiral")`. +#' and can be accessed using `system.file("adlb_grading/adlb_grading_spec.xlsx", package = "admiral")` +#' in sheet = "NCICTCAEv4". #' The dataset contained in there has the following columns: #' - `SOC`: variable to hold the SOC of the lab test criteria. #' - `TERM`: variable to hold the term describing the criteria applied to a particular lab test, @@ -59,11 +60,49 @@ #' #' Note: Variables `SOC`, `TERM`, `Grade 1`, `Grade 2`,`Grade 3`,`Grade 4`,`Grade 5`, `Definition` #' are from the source document on NCI-CTC website defining the grading criteria. +#' [**Common Terminology Criteria for Adverse Events (CTCAE)v4.0**](https://ctep.cancer.gov/protocoldevelopment/electronic_applications/ctc.htm#ctc_40) #' From these variables only 'TERM' is used in the {admiral} code, the rest are for information and #' tracability only. #' #' @author Gordon Miller #' -#' @keywords datasets -#' @family datasets +#' @keywords metadata +#' @family metadata "atoxgr_criteria_ctcv4" + +#' Metadata Holding Grading Criteria for NCI-CTCAEv5 +#' +#' @details +#' This metadata has its origin in the ADLB Grading Spec Excel file which ships with `{admiral}` +#' and can be accessed using `system.file("adlb_grading/adlb_grading_spec.xlsx", package = "admiral")` +#' in sheet = "NCICTCAEv5". +#' The dataset contained in there has the following columns: +#' - `SOC`: variable to hold the SOC of the lab test criteria. +#' - `TERM`: variable to hold the term describing the criteria applied to a particular lab test, +#' eg. 'Anemia' or 'INR Increased'. Note: the variable is case insensitive. +#' - `Grade 1`: Criteria defining lab value as Grade 1. +#' - `Grade 2`: Criteria defining lab value as Grade 2. +#' - `Grade 3`: Criteria defining lab value as Grade 3. +#' - `Grade 4`: Criteria defining lab value as Grade 4. +#' - `Grade 5`: Criteria defining lab value as Grade 5. +#' - `Definition`: Holds the definition of the lab test abnormality. +#' - `GRADE_CRITERIA_CODE`: variable to hold code that creates grade based on defined criteria. +#' - `SI_UNIT_CHECK`: variable to hold unit of particular lab test. Used to check against input data +#' if criteria is based on absolute values. +#' - `VAR_CHECK`: List of variables required to implement lab grade criteria. Use to check against +#' input data. +#' - `DIRECTION`: variable to hold the direction of the abnormality of a particular lab test +#' value. 'L' is for LOW values, 'H' is for HIGH values. Note: the variable is case insensitive. +#' - `COMMENT`: Holds any information regarding rationale behind implementation of grading criteria. +#' +#' Note: Variables `SOC`, `TERM`, `Grade 1`, `Grade 2`,`Grade 3`,`Grade 4`,`Grade 5`, `Definition` +#' are from the source document on NCI-CTC website defining the grading criteria. +#' [**Common Terminology Criteria for Adverse Events (CTCAE)v5.0**](https://ctep.cancer.gov/protocoldevelopment/electronic_applications/ctc.htm#ctc_50) +#' From these variables only 'TERM' is used in the {admiral} code, the rest are for information and +#' traceability only. +#' +#' @author Gordon Miller +#' +#' @keywords metadata +#' @family metadata +"atoxgr_criteria_ctcv5" diff --git a/R/derive_adeg_params.R b/R/derive_adeg_params.R index e770b8fa8a..e71022eebe 100644 --- a/R/derive_adeg_params.R +++ b/R/derive_adeg_params.R @@ -61,7 +61,9 @@ #' @export #' #' @examples -#' adeg <- tibble::tribble( +#' library(tibble) +#' +#' adeg <- tribble( #' ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, #' "01-701-1015", "HR", "Heart Rate (beats/min)", 70.14, "beats/min", "BASELINE", #' "01-701-1015", "QT", "QT Duration (msec)", 370, "msec", "WEEK 2", @@ -276,7 +278,9 @@ compute_qtc <- function(qt, rr, method) { #' @export #' #' @examples -#' adeg <- tibble::tribble( +#' library(tibble) +#' +#' adeg <- tribble( #' ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, #' "01-701-1015", "HR", "Heart Rate", 70.14, "beats/min", "BASELINE", #' "01-701-1015", "QT", "QT Duration", 370, "msec", "WEEK 2", diff --git a/R/derive_advs_params.R b/R/derive_advs_params.R index bd3684bbdc..c799a48594 100644 --- a/R/derive_advs_params.R +++ b/R/derive_advs_params.R @@ -58,9 +58,10 @@ #' @export #' #' @examples +#' library(tibble) #' library(dplyr, warn.conflicts = FALSE) #' -#' advs <- tibble::tribble( +#' advs <- tribble( #' ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~VISIT, #' "01-701-1015", "PULSE", "Pulse (beats/min)", 59, "BASELINE", #' "01-701-1015", "PULSE", "Pulse (beats/min)", 61, "WEEK 2", @@ -267,7 +268,9 @@ compute_map <- function(diabp, sysbp, hr = NULL) { #' @export #' #' @examples -#' advs <- tibble::tribble( +#' library(tibble) +#' +#' advs <- tribble( #' ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~VISIT, #' "01-701-1015", "HEIGHT", "Height (cm)", 170, "BASELINE", #' "01-701-1015", "WEIGHT", "Weight (kg)", 75, "BASELINE", @@ -500,7 +503,9 @@ compute_bsa <- function(height = height, #' @export #' #' @examples -#' advs <- tibble::tribble( +#' library(tibble) +#' +#' advs <- tribble( #' ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVISIT, #' "01-701-1015", "HEIGHT", "Height (cm)", 147, "SCREENING", #' "01-701-1015", "WEIGHT", "Weight (kg)", 54.0, "SCREENING", diff --git a/R/derive_date_vars.R b/R/derive_date_vars.R index 55ba42ffc7..d367b37da6 100644 --- a/R/derive_date_vars.R +++ b/R/derive_date_vars.R @@ -535,7 +535,7 @@ restrict_imputed_dtc_dtm <- function(dtc, # for each minimum date within the range ensure that the imputed date is not # before it for (min_date in min_dates) { - assert_that(is_date(min_date)) + assert_date_vector(min_date) min_date_iso <- strftime(min_date, format = "%Y-%m-%dT%H:%M:%S", tz = "UTC") imputed_dtc <- if_else( min_dtc <= min_date_iso & min_date_iso <= max_dtc, @@ -549,7 +549,7 @@ restrict_imputed_dtc_dtm <- function(dtc, # for each maximum date within the range ensure that the imputed date is not # after it for (max_date in max_dates) { - assert_that(is_date(max_date)) + assert_date_vector(max_date) max_date <- convert_date_to_dtm( max_date, time_imputation = "last" @@ -901,7 +901,7 @@ restrict_imputed_dtc_dt <- function(dtc, # for each minimum date within the range ensure that the imputed date is not # before it for (min_date in min_dates) { - assert_that(is_date(min_date)) + assert_date_vector(min_date) min_date_iso <- strftime(min_date, format = "%Y-%m-%d", tz = "UTC") imputed_dtc <- if_else( min_dtc <= min_date_iso & min_date_iso <= max_dtc, @@ -915,7 +915,7 @@ restrict_imputed_dtc_dt <- function(dtc, # for each maximum date within the range ensure that the imputed date is not # after it for (max_date in max_dates) { - assert_that(is_date(max_date)) + assert_date_vector(max_date) max_date_iso <- strftime(max_date, format = "%Y-%m-%d", tz = "UTC") imputed_dtc <- if_else( min_dtc <= max_date_iso & max_date_iso <= max_dtc, @@ -957,7 +957,7 @@ convert_dtc_to_dt <- function(dtc, min_dates = NULL, max_dates = NULL, preserve = FALSE) { - assert_that(is.character(dtc)) + assert_character_vector(dtc) warn_if_invalid_dtc(dtc, is_valid_dtc(dtc)) imputed_dtc <- impute_dtc_dt( @@ -1055,7 +1055,7 @@ convert_date_to_dtm <- function(dt, if (lubridate::is.POSIXct(dt)) { return(dt) } else { - if (is_date(dt)) { + if (is.instant(dt)) { dt <- format(dt, "%Y-%m-%d") } @@ -1102,7 +1102,7 @@ convert_date_to_dtm <- function(dt, #' compute_dtf(dtc = "2019", dt = as.Date("2019-07-18")) compute_dtf <- function(dtc, dt) { assert_character_vector(dtc) - assert_that(is_date(dt)) + assert_date_vector(dt) is_na <- is.na(dt) n_chr <- nchar(dtc) @@ -1159,7 +1159,7 @@ compute_dtf <- function(dtc, dt) { compute_tmf <- function(dtc, dtm, ignore_seconds_flag = FALSE) { - assert_that(is_date(dtm)) + assert_date_vector(dtm) assert_character_vector(dtc) assert_logical_scalar(ignore_seconds_flag) @@ -1337,7 +1337,6 @@ derive_vars_dt <- function(dataset, min_dates = NULL, max_dates = NULL, preserve = FALSE) { - # check and quote arguments assert_character_scalar(new_vars_prefix) assert_vars(max_dates, optional = TRUE) @@ -1524,7 +1523,6 @@ derive_vars_dtm <- function(dataset, max_dates = NULL, preserve = FALSE, ignore_seconds_flag = FALSE) { - # check and quote arguments assert_character_scalar(new_vars_prefix) assert_vars(max_dates, optional = TRUE) diff --git a/R/derive_extreme_records.R b/R/derive_extreme_records.R index 138a865395..f82e9a96e9 100644 --- a/R/derive_extreme_records.R +++ b/R/derive_extreme_records.R @@ -48,7 +48,9 @@ #' @export #' #' @examples -#' adlb <- tibble::tribble( +#' library(tibble) +#' +#' adlb <- tribble( #' ~USUBJID, ~AVISITN, ~AVAL, ~LBSEQ, #' "1", 1, 113, 1, #' "1", 2, 113, 2, diff --git a/R/derive_joined.R b/R/derive_joined.R new file mode 100644 index 0000000000..27f720e3fe --- /dev/null +++ b/R/derive_joined.R @@ -0,0 +1,349 @@ +#' Add Variables from an Additional Dataset Based on Conditions from Both Datasets +#' +#' The function adds variables from an additional dataset to the input dataset. +#' The selection of the observations from the additional dataset can depend on +#' variables from both datasets. For example, add the lowest value (nadir) +#' before the current observation. +#' +#' @param dataset Input dataset +#' +#' The variables specified by `by_vars` are expected. +#' +#' @param dataset_add Additional dataset +#' +#' The variables specified by the `by_vars`, the `new_vars`, the `join_vars`, +#' and the `order` argument are expected. +#' +#' @param by_vars Grouping variables +#' +#' The two datasets are joined by the specified variables. Variables from the +#' additional dataset can be renamed by naming the element, i.e., `by_vars = +#' vars( = )`. +#' +#' *Permitted Values*: list of variables created by `vars()` +#' +#' @param order Sort order +#' +#' If the argument is set to a non-null value, for each observation of the +#' input dataset the first or last observation from the joined dataset is +#' selected with respect to the specified order. The specified variables are +#' expected in the additional dataset (`dataset_add`). If a variable is +#' available in both `dataset` and `dataset_add`, the one from `dataset_add` +#' is used for the sorting. +#' +#' *Permitted Values*: list of variables or `desc()` function calls +#' created by `vars()`, e.g., `vars(ADT, desc(AVAL))` or `NULL` +#' +#' @param new_vars Variables to add +#' +#' The specified variables from the additional dataset are added to the output +#' dataset. Variables can be renamed by naming the element, i.e., `new_vars = +#' vars( = )`. +#' +#' For example `new_vars = vars(var1, var2)` adds variables `var1` and `var2` +#' from `dataset_add` to the input dataset. +#' +#' And `new_vars = vars(var1, new_var2 = old_var2)` takes `var1` and +#' `old_var2` from `dataset_add` and adds them to the input dataset renaming +#' `old_var2` to `new_var2`. +#' +#' If the argument is not specified or set to `NULL`, all variables from the +#' additional dataset (`dataset_add`) are added. +#' +#' *Permitted Values*: list of variables created by `vars()` +#' +#' @param join_vars Variables to use from additional dataset +#' +#' Any extra variables required from the additional dataset for `filter_join` +#' should be specified for this argument. Variables specified for `new_vars` +#' do not need to be repeated for `join_vars`. If a specified variable exists +#' in both the input dataset and the additional dataset, the suffix ".join" is +#' added to the variable from the additional dataset. +#' +#' The variables are not included in the output dataset. +#' +#' *Permitted Values*: list of variables created by `vars()` +#' +#' @param filter_add Filter for additional dataset (`dataset_add`) +#' +#' Only observations from `dataset_add` fulfilling the specified condition are +#' joined to the input dataset. If the argument is not specified, all +#' observations are joined. +#' +#' *Permitted Values*: a condition +#' +#' @param filter_join Filter for the joined dataset +#' +#' The specified condition is applied to the joined dataset. Therefore +#' variables from both datasets `dataset` and `dataset_add` can be used. +#' +#' *Permitted Values*: a condition +#' +#' @param mode Selection mode +#' +#' Determines if the first or last observation is selected. If the `order` +#' argument is specified, `mode` must be non-null. +#' +#' If the `order` argument is not specified, the `mode` argument is ignored. +#' +#' *Permitted Values*: `"first"`, `"last"`, `NULL` +#' +#' @param check_type Check uniqueness? +#' +#' If `"warning"` or `"error"` is specified, the specified message is issued +#' if the observations of the (restricted) joined dataset are not unique +#' with respect to the by variables and the order. +#' +#' This argument is ignored if `order` is not specified. In this case an error +#' is issued independent of `check_type` if the restricted joined dataset +#' contains more than one observation for any of the observations of the input +#' dataset. +#' +#' *Permitted Values*: `"none"`, `"warning"`, `"error"` +#' +#' @author Stefan Bundfuss +#' +#' @details +#' +#' 1. The records from the additional dataset (`dataset_add`) are restricted +#' to those matching the `filter_add` condition. +#' +#' 1. The input dataset and the (restricted) additional dataset are left +#' joined by the grouping variables (`by_vars`). If no grouping variables are +#' specified, a full join is performed. +#' +#' 1. The joined dataset is restricted by the `filter_join` condition. +#' +#' 1. If `order` is specified, for each observation of the input dataset the +#' first or last observation (depending on `mode`) is selected. +#' +#' 1. The variables specified for `new_vars` are renamed (if requested) and +#' merged to the input dataset. I.e., the output dataset contains all +#' observations from the input dataset. For observations without a matching +#' observation in the joined dataset the new variables are set to `NA`. +#' Observations in the additional dataset which have no matching observation +#' in the input dataset are ignored. +#' +#' @return The output dataset contains all observations and variables of the +#' input dataset and additionally the variables specified for `new_vars` from +#' the additional dataset (`dataset_add`). +#' +#' @keywords der_gen +#' @family der_gen +#' +#' @export +#' +#' @examples +#' library(tibble) +#' library(lubridate) +#' library(dplyr, warn.conflicts = FALSE) +#' library(tidyr) +#' +#' # Add AVISIT (based on time windows), AWLO, and AWHI +#' adbds <- tribble( +#' ~USUBJID, ~ADY, +#' "1", -33, +#' "1", -2, +#' "1", 3, +#' "1", 24, +#' "2", NA, +#' ) +#' +#' windows <- tribble( +#' ~AVISIT, ~AWLO, ~AWHI, +#' "BASELINE", -30, 1, +#' "WEEK 1", 2, 7, +#' "WEEK 2", 8, 15, +#' "WEEK 3", 16, 22, +#' "WEEK 4", 23, 30 +#' ) +#' +#' derive_vars_joined( +#' adbds, +#' dataset_add = windows, +#' filter_join = AWLO <= ADY & ADY <= AWHI +#' ) +#' +#' # derive the nadir after baseline and before the current observation +#' adbds <- tribble( +#' ~USUBJID, ~ADY, ~AVAL, +#' "1", -7, 10, +#' "1", 1, 12, +#' "1", 8, 11, +#' "1", 15, 9, +#' "1", 20, 14, +#' "1", 24, 12, +#' "2", 13, 8 +#' ) +#' +#' derive_vars_joined( +#' adbds, +#' dataset_add = adbds, +#' by_vars = vars(USUBJID), +#' order = vars(AVAL), +#' new_vars = vars(NADIR = AVAL), +#' join_vars = vars(ADY), +#' filter_add = ADY > 0, +#' filter_join = ADY.join < ADY, +#' mode = "first", +#' check_type = "none" +#' ) +#' +#' # add highest hemoglobin value within two weeks before AE, +#' # take earliest if more than one +#' adae <- tribble( +#' ~USUBJID, ~ASTDY, +#' "1", 3, +#' "1", 22, +#' "2", 2 +#' ) +#' +#' adlb <- tribble( +#' ~USUBJID, ~PARAMCD, ~ADY, ~AVAL, +#' "1", "HGB", 1, 8.5, +#' "1", "HGB", 3, 7.9, +#' "1", "HGB", 5, 8.9, +#' "1", "HGB", 8, 8.0, +#' "1", "HGB", 9, 8.0, +#' "1", "HGB", 16, 7.4, +#' "1", "HGB", 24, 8.1, +#' "1", "ALB", 1, 42, +#' ) +#' +#' derive_vars_joined( +#' adae, +#' dataset_add = adlb, +#' by_vars = vars(USUBJID), +#' order = vars(AVAL, desc(ADY)), +#' new_vars = vars(HGB_MAX = AVAL, HGB_DY = ADY), +#' filter_add = PARAMCD == "HGB", +#' filter_join = ASTDY - 14 <= ADY & ADY <= ASTDY, +#' mode = "last" +#' ) +#' +#' # Add APERIOD, APERIODC based on ADSL +#' adsl <- tribble( +#' ~USUBJID, ~AP01SDT, ~AP01EDT, ~AP02SDT, ~AP02EDT, +#' "1", "2021-01-04", "2021-02-06", "2021-02-07", "2021-03-07", +#' "2", "2021-02-02", "2021-03-02", "2021-03-03", "2021-04-01" +#' ) %>% +#' mutate(across(ends_with("DT"), ymd)) %>% +#' mutate(STUDYID = "xyz") +#' +#' period_ref <- create_period_dataset( +#' adsl, +#' new_vars = vars(APERSDT = APxxSDT, APEREDT = APxxEDT) +#' ) +#' +#' period_ref +#' +#' adae <- tribble( +#' ~USUBJID, ~ASTDT, +#' "1", "2021-01-01", +#' "1", "2021-01-05", +#' "1", "2021-02-05", +#' "1", "2021-03-05", +#' "1", "2021-04-05", +#' "2", "2021-02-15", +#' ) %>% +#' mutate( +#' ASTDT = ymd(ASTDT), +#' STUDYID = "xyz" +#' ) +#' +#' derive_vars_joined( +#' adae, +#' dataset_add = period_ref, +#' by_vars = vars(STUDYID, USUBJID), +#' join_vars = vars(APERSDT, APEREDT), +#' filter_join = APERSDT <= ASTDT & ASTDT <= APEREDT +#' ) +derive_vars_joined <- function(dataset, + dataset_add, + by_vars = NULL, + order = NULL, + new_vars = NULL, + join_vars = NULL, + filter_add = NULL, + filter_join = NULL, + mode = NULL, + check_type = "warning") { + assert_vars(by_vars, optional = TRUE) + by_vars_left <- replace_values_by_names(by_vars) + assert_order_vars(order, optional = TRUE) + assert_vars(new_vars, optional = TRUE) + assert_vars(join_vars, optional = TRUE) + assert_data_frame(dataset, required_vars = by_vars_left) + assert_data_frame( + dataset_add, + required_vars = quo_c(by_vars, join_vars, extract_vars(order), new_vars) + ) + filter_add <- assert_filter_cond(enquo(filter_add), optional = TRUE) + filter_join <- assert_filter_cond(enquo(filter_join), optional = TRUE) + + if (is.null(new_vars)) { + new_vars <- chr2vars(colnames(dataset_add)) + } + + # number observations of the input dataset to get a unique key + # (by_vars and tmp_obs_nr) + tmp_obs_nr <- get_new_tmp_var(dataset, prefix = "tmp_obs_nr") + data <- dataset %>% + derive_var_obs_number( + new_var = !!tmp_obs_nr, + by_vars = by_vars_left, + check_type = "none" + ) + + # prepare right side of the join, + # by_vars are renamed here, new_vars will be renamed at the end + data_right <- filter_if(dataset_add, filter_add) %>% + select(!!!by_vars, !!!join_vars, !!!unname(new_vars)) + + # join dataset (if no by variable, a full join is performed) + data_joined <- left_join( + data, + data_right, + by = vars2chr(by_vars_left), + suffix = c("", ".join") + ) + + # select observations for the new variables + data_return <- filter_if(data_joined, filter_join) + + common_vars <- + chr2vars(setdiff(intersect(colnames(data), colnames(data_right)), vars2chr(by_vars))) + if (!is.null(order)) { + data_return <- filter_extreme( + data_return, + by_vars = quo_c(by_vars_left, quo(!!tmp_obs_nr)), + order = add_suffix_to_vars(order, vars = common_vars, suffix = ".join"), + mode = mode, + check_type = check_type + ) + } + + # merge new variables to the input dataset and rename them + data %>% + derive_vars_merged( + dataset_add = select( + data_return, + !!!by_vars_left, + !!tmp_obs_nr, + !!!add_suffix_to_vars(new_vars, vars = common_vars, suffix = ".join") + ), + by_vars = vars(!!!by_vars_left, !!tmp_obs_nr), + duplicate_msg = paste( + paste( + "After applying `filter_join` the joined dataset contains more", + "than one observation per observation of the input dataset." + ), + paste( + "Please adjust `filter_add` and/or `filter_join` or specify `order`", + "and `mode` to select one of the observations." + ), + sep = "\n" + ) + ) %>% + remove_tmp_vars() +} diff --git a/R/derive_locf_records.R b/R/derive_locf_records.R new file mode 100644 index 0000000000..51970dcb50 --- /dev/null +++ b/R/derive_locf_records.R @@ -0,0 +1,186 @@ +#' Derive LOCF (Last Observation Carried Forward) Records +#' +#' Adds LOCF records as new observations for each 'by group' when the dataset +#' does not contain observations for missed visits/time points. +#' +#' @param dataset Input dataset +#' +#' The columns specified by the `by_vars` and the `order` +#' parameter are expected. +#' +#' @param dataset_expected_obs Expected observations dataset +#' +#' Data frame with all the combinations of `PARAMCD`, `PARAM`, `AVISIT`, +#' `AVISITN`, ... which are expected in the dataset is expected. +#' +#' @param by_vars Grouping variables +#' +#' For each group defined by `by_vars` those observations from `dataset_expected_obs` +#' are added to the output dataset which do not have a corresponding observation +#' in the input dataset or for which `AVAL` is NA for the corresponding observation +#' in the input dataset. Only variables specified in `by_vars` will be populated +#' in the newly created records. +#' +#' @param order List of variables for sorting a dataset +#' +#' The dataset is sorted by `order` before carrying the last +#' observation forward (eg. `AVAL`) within each `by_vars`. +#' +#' @author G Gayatri +#' +#' @details For each group (with respect to the variables specified for the +#' by_vars parameter) those observations from dataset_expected_obs are added to +#' the output dataset +#' - which do not have a corresponding observation in the input dataset or +#' - for which `AVAL` is NA for the corresponding observation in the input dataset. +#' +#' For the new observations, `AVAL` is set to the non-missing `AVAL` of the +#' previous observation in the input dataset (when sorted by `order`) and +#' `DTYPE` is set to "LOCF". +#' +#' @return The input dataset with the new "LOCF" observations added for each +#' `by_vars`. Note, a variable will only be populated in the new parameter rows +#' if it is specified in `by_vars`. +#' +#' @keywords der_prm_bds_findings +#' @family der_prm_bds_findings +#' +#' @export +#' +#' @examples +#' +#' library(dplyr) +#' library(tibble) +#' +#' advs <- tribble( +#' ~STUDYID, ~USUBJID, ~PARAMCD, ~AVAL, ~AVISITN, ~AVISIT, +#' "CDISC01", "01-701-1015", "PULSE", 61, 0, "BASELINE", +#' "CDISC01", "01-701-1015", "PULSE", 60, 2, "WEEK 6", +#' "CDISC01", "01-701-1015", "DIABP", 51, 0, "BASELINE", +#' "CDISC01", "01-701-1015", "DIABP", 50, 2, "WEEK 2", +#' "CDISC01", "01-701-1015", "DIABP", 51, 4, "WEEK 4", +#' "CDISC01", "01-701-1015", "DIABP", 50, 6, "WEEK 6", +#' "CDISC01", "01-701-1015", "SYSBP", 121, 0, "BASELINE", +#' "CDISC01", "01-701-1015", "SYSBP", 121, 2, "WEEK 2", +#' "CDISC01", "01-701-1015", "SYSBP", 121, 4, "WEEK 4", +#' "CDISC01", "01-701-1015", "SYSBP", 121, 6, "WEEK 6", +#' "CDISC01", "01-701-1028", "PULSE", 65, 0, "BASELINE", +#' "CDISC01", "01-701-1028", "DIABP", 79, 0, "BASELINE", +#' "CDISC01", "01-701-1028", "DIABP", 80, 2, "WEEK 2", +#' "CDISC01", "01-701-1028", "DIABP", NA, 4, "WEEK 4", +#' "CDISC01", "01-701-1028", "DIABP", NA, 6, "WEEK 6", +#' "CDISC01", "01-701-1028", "SYSBP", 130, 0, "BASELINE", +#' "CDISC01", "01-701-1028", "SYSBP", 132, 2, "WEEK 2" +#' ) +#' +#' +#' # A dataset with all the combinations of PARAMCD, PARAM, AVISIT, AVISITN, ... which are expected. +#' advs_expected_obsv <- tibble::tribble( +#' ~PARAMCD, ~AVISITN, ~AVISIT, +#' "PULSE", 0, "BASELINE", +#' "PULSE", 6, "WEEK 6", +#' "DIABP", 0, "BASELINE", +#' "DIABP", 2, "WEEK 2", +#' "DIABP", 4, "WEEK 4", +#' "DIABP", 6, "WEEK 6", +#' "SYSBP", 0, "BASELINE", +#' "SYSBP", 2, "WEEK 2", +#' "SYSBP", 4, "WEEK 4", +#' "SYSBP", 6, "WEEK 6" +#' ) +#' +#' derive_locf_records( +#' data = advs, +#' dataset_expected_obs = advs_expected_obsv, +#' by_vars = vars(STUDYID, USUBJID, PARAMCD), +#' order = vars(AVISITN, AVISIT) +#' ) +#' +derive_locf_records <- function(dataset, + dataset_expected_obs, + by_vars, + order) { + #### Input Checking #### + + # Check if input parameters is a valid list of variables + assert_vars(by_vars, optional = TRUE) + assert_order_vars(order) + + # Check by_vars and order variables in input datasets + assert_data_frame(dataset_expected_obs) + assert_data_frame( + dataset, + required_vars = quo_c(by_vars, extract_vars(order), chr2vars(colnames(dataset_expected_obs))) + ) + + #### Prepping 'dataset_expected_obs' #### + + + # Get the IDs from input dataset for which the expected observations are to be added + + ids <- dataset %>% + select(!!!setdiff(by_vars, chr2vars(colnames(dataset_expected_obs)))) %>% + distinct() + + exp_obsv <- ids %>% + crossing(dataset_expected_obs) + + + + ##### Add LOCF records #### + + # Split input dataset into the missing and non-missing AVAL records + aval_missing <- dataset %>% + filter(is.na(AVAL)) + + aval_not_missing <- dataset %>% + drop_na(AVAL) + + + # Get the variable names from the expected observation dataset + exp_obs_vars <- exp_obsv %>% + colnames() + + + # Get unique combination of visits/timepoints per parameter per subject + # from the original input dataset (with non-missing AVAL) + advs_unique_original <- aval_not_missing %>% + select(all_of(exp_obs_vars)) %>% + distinct() + + + tmp_dtype <- get_new_tmp_var(exp_obsv, prefix = "tmp_dtype") + + # Get all the expected observations that are to be added to the input + # dataset (with non-missing AVAL) + advs_exp_obsv3 <- exp_obsv %>% + mutate(!!tmp_dtype := "LOCF") %>% + anti_join(advs_unique_original, by = c(exp_obs_vars)) + + # Merge the expected observations with the input dataset (with non-missing AVAL) + # Arrange the dataset by 'order' and group it by 'by_vars' + # Use fill() to fill the AVAL from the previous observation for the newly added records + + + aval_not_missing_locf <- aval_not_missing %>% + full_join(advs_exp_obsv3, by = c(exp_obs_vars)) + + if ("DTYPE" %in% colnames(aval_not_missing)) { + aval_not_missing_locf <- aval_not_missing_locf %>% + mutate(DTYPE = if_else(!!tmp_dtype == "LOCF", "LOCF", DTYPE, missing = DTYPE)) %>% + select(-!!tmp_dtype) + } else { + aval_not_missing_locf <- rename(aval_not_missing_locf, DTYPE = !!tmp_dtype) + } + + aval_not_missing_locf <- aval_not_missing_locf %>% + arrange(!!!by_vars, !!!order) %>% + group_by(!!!by_vars) %>% + fill("AVAL") %>% + ungroup() + + + + # Output dataset - merge the AVAL missing with non-missing+newly added LOCF records + bind_rows(aval_not_missing_locf, aval_missing) +} diff --git a/R/derive_merged.R b/R/derive_merged.R index 655485f595..ec2352252f 100644 --- a/R/derive_merged.R +++ b/R/derive_merged.R @@ -1,4 +1,3 @@ -.temp <- new.env(parent = emptyenv()) #' Add New Variable(s) to the Input Dataset Based on Variables from Another #' Dataset #' @@ -9,16 +8,16 @@ #' #' @param dataset Input dataset #' -#' The variables specified by the `by_vars` parameter are expected. +#' The variables specified by the `by_vars` argument are expected. #' #' @param dataset_add Additional dataset #' #' The variables specified by the `by_vars`, the `new_vars`, and the `order` -#' parameter are expected. +#' argument are expected. #' #' @param order Sort order #' -#' If the parameter is set to a non-null value, for each by group the first or +#' If the argument is set to a non-null value, for each by group the first or #' last observation from the additional dataset is selected with respect to the #' specified order. #' @@ -40,7 +39,7 @@ #' `old_var2` from `dataset_add` and adds them to the input dataset renaming #' `old_var2` to `new_var2`. #' -#' If the parameter is not specified or set to `NULL`, all variables from the +#' If the argument is not specified or set to `NULL`, all variables from the #' additional dataset (`dataset_add`) are added. #' #' *Default*: `NULL` @@ -50,9 +49,9 @@ #' @param mode Selection mode #' #' Determines if the first or last observation is selected. If the `order` -#' parameter is specified, `mode` must be non-null. +#' argument is specified, `mode` must be non-null. #' -#' If the `order` parameter is not specified, the `mode` parameter is ignored. +#' If the `order` argument is not specified, the `mode` argument is ignored. #' #' *Default*: `NULL` #' @@ -69,7 +68,7 @@ #' @param filter_add Filter for additional dataset (`dataset_add`) #' #' Only observations fulfilling the specified condition are taken into account -#' for merging. If the parameter is not specified, all observations are +#' for merging. If the argument is not specified, all observations are #' considered. #' #' *Default*: `NULL` @@ -78,7 +77,7 @@ #' #' @param match_flag Match flag #' -#' If the parameter is specified (e.g., `match_flag = FLAG`), the specified +#' If the argument is specified (e.g., `match_flag = FLAG`), the specified #' variable (e.g., `FLAG`) is added to the input dataset. This variable will #' be `TRUE` for all selected records from `dataset_add` which are merged into #' the input dataset, and `NA` otherwise. @@ -287,9 +286,9 @@ derive_vars_merged <- function(dataset, "Please add it to `by_vars` or remove or rename it in one of the datasets." ), paste0( - "The variables", + "The variables ", enumerate(common_vars), - "are contained in both datasets.\n", + " are contained in both datasets.\n", "Please add them to `by_vars` or remove or rename them in one of the datasets." ) )) @@ -312,11 +311,11 @@ derive_vars_merged <- function(dataset, #' @param dataset_add Additional dataset #' #' The variables specified by the `by_vars`, the `dtc`, and the `order` -#' parameter are expected. +#' argument are expected. #' #' @param order Sort order #' -#' If the parameter is set to a non-null value, for each by group the first or +#' If the argument is set to a non-null value, for each by group the first or #' last observation from the additional dataset is selected with respect to #' the specified order. The imputed date variable can be specified as well #' (see examples below). @@ -431,11 +430,11 @@ derive_vars_merged_dt <- function(dataset, #' @param dataset_add Additional dataset #' #' The variables specified by the `by_vars`, the `dtc`, and the `order` -#' parameter are expected. +#' argument are expected. #' #' @param order Sort order #' -#' If the parameter is set to a non-null value, for each by group the first or +#' If the argument is set to a non-null value, for each by group the first or #' last observation from the additional dataset is selected with respect to #' the specified order. The imputed datetime variable can be specified as well #' (see examples below). @@ -544,7 +543,7 @@ derive_vars_merged_dtm <- function(dataset, #' @param dataset_add Additional dataset #' #' The variables specified by the `by_vars`, the `source_var`, and the `order` -#' parameter are expected. +#' argument are expected. #' #' @param new_var New variable #' @@ -555,7 +554,7 @@ derive_vars_merged_dtm <- function(dataset, #' #' @param cat_fun Categorization function #' -#' A function must be specified for this parameter which expects the values of +#' A function must be specified for this argument which expects the values of #' the source variable as input and returns the categorized values. #' #' @param missing_value Values used for missing information @@ -668,7 +667,7 @@ derive_var_merged_cat <- function(dataset, #' #' @param dataset_add Additional dataset #' -#' The variables specified by the `by_vars` parameter are expected. +#' The variables specified by the `by_vars` argument are expected. #' #' @param by_vars Grouping variables #' @@ -708,7 +707,7 @@ derive_var_merged_cat <- function(dataset, #' @param filter_add Filter for additional data #' #' Only observations fulfilling the specified condition are taken into account -#' for flagging. If the parameter is not specified, all observations are +#' for flagging. If the argument is not specified, all observations are #' considered. #' #' *Permitted Values*: a condition @@ -804,12 +803,12 @@ derive_var_merged_exist_flag <- function(dataset, #' @param dataset_add Additional dataset #' #' The variables specified by the `by_vars`, the `source_var`, and the `order` -#' parameter are expected. +#' argument are expected. #' #' @param new_var New variable #' #' The specified variable is added to the additional dataset and set to the -#' transformed value with respect to the `case` parameter. +#' transformed value with respect to the `case` argument. #' #' @param source_var Source variable #' @@ -927,7 +926,7 @@ derive_var_merged_character <- function(dataset, #' #' @param dataset_add Lookup table #' -#' The variables specified by the `by_vars` parameter are expected. +#' The variables specified by the `by_vars` argument are expected. #' #' @param print_not_mapped Print a list of unique `by_vars` values that do not #' have corresponding records from the lookup table? @@ -954,9 +953,10 @@ derive_var_merged_character <- function(dataset, #' #' @examples #' library(admiral.test) +#' library(tibble) #' library(dplyr, warn.conflicts = FALSE) #' data("admiral_vs") -#' param_lookup <- tibble::tribble( +#' param_lookup <- tribble( #' ~VSTESTCD, ~VSTEST, ~PARAMCD, ~PARAM, #' "SYSBP", "Systolic Blood Pressure", "SYSBP", "Systolic Blood Pressure (mmHg)", #' "WEIGHT", "Weight", "WEIGHT", "Weight (kg)", @@ -1005,7 +1005,7 @@ derive_vars_merged_lookup <- function(dataset, distinct(!!!by_vars) if (nrow(temp_not_mapped) > 0) { - .temp$nmap <- structure( + admiral_environment$nmap <- structure( temp_not_mapped, class = union("nmap", class(temp_not_mapped)), by_vars = vars2chr(by_vars) @@ -1035,5 +1035,174 @@ derive_vars_merged_lookup <- function(dataset, #' @keywords utils_help #' @family utils_help get_not_mapped <- function() { - .temp$nmap + admiral_environment$nmap +} + +#' Merge a Summary Variable +#' +#' Merge a summary variable from a dataset to the input dataset. +#' +#' @param dataset Input dataset +#' +#' The variables specified by the `by_vars` argument are expected. +#' +#' @param dataset_add Additional dataset +#' +#' The variables specified by the `by_vars` and the `analysis_var` arguments +#' are expected. +#' +#' @param new_var Variable to add +#' +#' The specified variable is added to the input dataset (`dataset`) and set to +#' the summarized values. +#' +#' @param by_vars Grouping variables +#' +#' The values of `analysis_var` are summarized by the specified variables. The +#' summarized values are merged to the input dataset (`dataset`) by the +#' specified by variables. +#' +#' *Permitted Values*: list of variables created by `vars()` +#' +#' @param filter_add Filter for additional dataset (`dataset_add`) +#' +#' Only observations fulfilling the specified condition are taken into account +#' for summarizing. If the argument is not specified, all observations are +#' considered. +#' +#' *Permitted Values*: a condition +#' +#' @param analysis_var Analysis variable +#' +#' The values of the specified variable are summarized by the function +#' specified for `summary_fun`. +#' +#' @param summary_fun Summary function +#' +#' The specified function that takes as input `analysis_var` and performs the +#' calculation. This can include built-in functions as well as user defined +#' functions, for example `mean` or `function(x) mean(x, na.rm = TRUE)`. +#' +#' @author Stefan Bundfuss +#' +#' @details +#' +#' 1. The records from the additional dataset (`dataset_add`) are restricted +#' to those matching the `filter_add` condition. +#' +#' 1. The values of the analysis variable (`analysis_var`) are summarized by +#' the summary function (`summary_fun`) for each by group (`by_vars`) in the +#' additional dataset (`dataset_add`). +#' +#' 1. The summarized values are merged to the input dataset as a new variable +#' (`new_var`). For observations without a matching observation in the +#' additional dataset the new variable is set to `NA`. Observations in the +#' additional dataset which have no matching observation in the input dataset +#' are ignored. +#' +#' @return The output dataset contains all observations and variables of the +#' input dataset and additionally the variable specified for `new_var`. +#' +#' @family der_gen +#' @keywords der_gen +#' +#' @seealso [derive_summary_records()], [get_summary_records()] +#' +#' @export +#' +#' @examples +#' library(tibble) +#' +#' # Add a variable for the mean of AVAL within each visit +#' adbds <- tribble( +#' ~USUBJID, ~AVISIT, ~ASEQ, ~AVAL, +#' "1", "WEEK 1", 1, 10, +#' "1", "WEEK 1", 2, NA, +#' "1", "WEEK 2", 3, NA, +#' "1", "WEEK 3", 4, 42, +#' "1", "WEEK 4", 5, 12, +#' "1", "WEEK 4", 6, 12, +#' "1", "WEEK 4", 7, 15, +#' "2", "WEEK 1", 1, 21, +#' "2", "WEEK 4", 2, 22 +#' ) +#' +#' derive_var_merged_summary( +#' adbds, +#' dataset_add = adbds, +#' by_vars = vars(USUBJID, AVISIT), +#' new_var = MEANVIS, +#' analysis_var = AVAL, +#' summary_fun = function(x) mean(x, na.rm = TRUE) +#' ) +#' +#' # Add a variable listing the lesion ids at baseline +#' adsl <- tribble( +#' ~USUBJID, +#' "1", +#' "2", +#' "3" +#' ) +#' +#' adtr <- tribble( +#' ~USUBJID, ~AVISIT, ~LESIONID, +#' "1", "BASELINE", "INV-T1", +#' "1", "BASELINE", "INV-T2", +#' "1", "BASELINE", "INV-T3", +#' "1", "BASELINE", "INV-T4", +#' "1", "WEEK 1", "INV-T1", +#' "1", "WEEK 1", "INV-T2", +#' "1", "WEEK 1", "INV-T4", +#' "2", "BASELINE", "INV-T1", +#' "2", "BASELINE", "INV-T2", +#' "2", "BASELINE", "INV-T3", +#' "2", "WEEK 1", "INV-T1", +#' "2", "WEEK 1", "INV-N1" +#' ) +#' +#' derive_var_merged_summary( +#' adsl, +#' dataset_add = adtr, +#' by_vars = vars(USUBJID), +#' filter_add = AVISIT == "BASELINE", +#' new_var = LESIONSBL, +#' analysis_var = LESIONID, +#' summary_fun = function(x) paste(x, collapse = ", ") +#' ) +#' +derive_var_merged_summary <- function(dataset, + dataset_add, + by_vars, + new_var, + filter_add = NULL, + analysis_var, + summary_fun) { + assert_vars(by_vars) + new_var <- assert_symbol(enquo(new_var)) + analysis_var <- assert_symbol(enquo(analysis_var)) + filter_add <- + assert_filter_cond(enquo(filter_add), optional = TRUE) + assert_s3_class(summary_fun, "function") + assert_data_frame( + dataset, + required_vars = by_vars + ) + assert_data_frame( + dataset_add, + required_vars = quo_c(by_vars, analysis_var) + ) + + # Summarise the analysis value and merge to the original dataset + derive_vars_merged( + dataset, + dataset_add = get_summary_records( + dataset_add, + by_vars = by_vars, + filter = !!filter_add, + analysis_var = !!analysis_var, + summary_fun = summary_fun + ), + by_vars = by_vars, + new_vars = vars(!!new_var := !!analysis_var) + ) } diff --git a/R/derive_param_computed.R b/R/derive_param_computed.R index 37c6ccfc87..4d0f18cec0 100644 --- a/R/derive_param_computed.R +++ b/R/derive_param_computed.R @@ -95,8 +95,10 @@ #' @export #' #' @examples +#' library(tibble) +#' #' # Example 1: Derive MAP -#' advs <- tibble::tribble( +#' advs <- tribble( #' ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, #' "01-701-1015", "DIABP", "Diastolic Blood Pressure (mmHg)", 51, "mmHg", "BASELINE", #' "01-701-1015", "DIABP", "Diastolic Blood Pressure (mmHg)", 50, "mmHg", "WEEK 2", @@ -121,7 +123,7 @@ #' ) #' #' # Example 2: Derive BMI where height is measured only once -#' advs <- tibble::tribble( +#' advs <- tribble( #' ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, #' "01-701-1015", "HEIGHT", "Height (cm)", 147, "cm", "SCREENING", #' "01-701-1015", "WEIGHT", "Weight (kg)", 54.0, "kg", "SCREENING", diff --git a/R/derive_param_doseint.R b/R/derive_param_doseint.R index b087f24959..51fb38baa0 100644 --- a/R/derive_param_doseint.R +++ b/R/derive_param_doseint.R @@ -75,10 +75,10 @@ #' @export #' #' @examples -#' library(dplyr, warn.conflicts = FALSE) +#' library(tibble) #' library(lubridate, warn.conflicts = FALSE) #' -#' adex <- tibble::tribble( +#' adex <- tribble( #' ~USUBJID, ~PARAMCD, ~VISIT, ~ANL01FL, ~ASTDT, ~AENDT, ~AVAL, #' "P001", "TNDOSE", "V1", "Y", ymd("2020-01-01"), ymd("2020-01-30"), 59, #' "P001", "TSNDOSE", "V1", "Y", ymd("2020-01-01"), ymd("2020-02-01"), 96, diff --git a/R/derive_param_exist_flag.R b/R/derive_param_exist_flag.R index 6f52ebe531..155e3e11c6 100644 --- a/R/derive_param_exist_flag.R +++ b/R/derive_param_exist_flag.R @@ -131,11 +131,12 @@ #' @export #' #' @examples -#' library(dplyr) +#' library(tibble) +#' library(dplyr, warn.conflicts = FALSE) #' library(lubridate) #' #' # Derive a new parameter for measurable disease at baseline -#' adsl <- tibble::tribble( +#' adsl <- tribble( #' ~USUBJID, #' "1", #' "2", @@ -143,7 +144,7 @@ #' ) %>% #' mutate(STUDYID = "XX1234") #' -#' tu <- tibble::tribble( +#' tu <- tribble( #' ~USUBJID, ~VISIT, ~TUSTRESC, #' "1", "SCREENING", "TARGET", #' "1", "WEEK 1", "TARGET", @@ -178,7 +179,7 @@ derive_param_exist_flag <- function(dataset = NULL, missing_value = NA_character_, filter_add = NULL, aval_fun = yn_to_numeric, - subject_keys = vars(STUDYID, USUBJID), + subject_keys = get_admiral_option("subject_keys"), set_values_to) { # Check input parameters condition <- assert_filter_cond(enquo(condition)) diff --git a/R/derive_param_exposure.R b/R/derive_param_exposure.R index 2a9402b766..1391bca739 100644 --- a/R/derive_param_exposure.R +++ b/R/derive_param_exposure.R @@ -76,10 +76,11 @@ #' @export #' #' @examples +#' library(tibble) #' library(dplyr, warn.conflicts = FALSE) #' library(lubridate, warn.conflicts = FALSE) #' library(stringr, warn.conflicts = FALSE) -#' adex <- tibble::tribble( +#' adex <- tribble( #' ~USUBJID, ~PARAMCD, ~AVAL, ~AVALC, ~VISIT, ~ASTDT, ~AENDT, #' "1015", "DOSE", 80, NA_character_, "BASELINE", ymd("2014-01-02"), ymd("2014-01-16"), #' "1015", "DOSE", 85, NA_character_, "WEEK 2", ymd("2014-01-17"), ymd("2014-06-18"), diff --git a/R/derive_param_extreme_event.R b/R/derive_param_extreme_event.R new file mode 100644 index 0000000000..be38ef62cf --- /dev/null +++ b/R/derive_param_extreme_event.R @@ -0,0 +1,373 @@ +#' Add a First Event Parameter +#' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' This function is *deprecated*, please use `derive_param_extreme_event()` instead with the `order` argument instead of the `date_var` argument. +#' +#' @param dataset Input dataset +#' +#' The `PARAMCD` variable is expected. +#' +#' @param dataset_adsl ADSL input dataset +#' +#' The variables specified for `subject_keys` are expected. For each +#' observation of the specified dataset a new observation is added to the +#' input dataset. +#' +#' @param dataset_source Source dataset +#' +#' All observations in the specified dataset fulfilling the condition +#' specified by `filter_source` are considered as event. +#' +#' The variables specified by the `subject_keys` and +#' `date_var` parameter are expected. +#' +#' @param filter_source Source filter +#' +#' All observations in `dataset_source` fulfilling the specified condition are +#' considered as event. +#' +#' For subjects with at least one event `AVALC` is set to `"Y"`, `AVAL` to +#' `1`, and `ADT` to the first date where the condition is fulfilled. +#' +#' For all other subjects `AVALC` is set to `"N"`, `AVAL` to `0`, and `ADT` to +#' `NA`. +#' +#' @param date_var Date variable +#' +#' Date variable in the source dataset (`dataset_source`). The variable is +#' used to sort the source dataset. `ADT` is set to the specified variable for +#' events. +#' +#' @param set_values_to Variables to set +#' +#' A named list returned by `vars()` defining the variables to be set for the +#' new parameter, e.g. `vars(PARAMCD = "PD", PARAM = "Disease Progression")` +#' is expected. The values must be symbols, character strings, numeric values, +#' or `NA`. +#' +#' @param subject_keys Variables to uniquely identify a subject +#' +#' A list of symbols created using `vars()` is expected. +#' +#' @param check_type Check uniqueness? +#' +#' If `"warning"` or `"error"` is specified, a message is issued if the +#' observations of the input dataset restricted to the source parameter +#' (`source_param`) are not unique with respect to the subject keys +#' (`subject_key` parameter) and `ADT`. +#' +#' *Permitted Values*: `"none"`, `"warning"`, `"error"` +#' +#' @details +#' 1. The input dataset is restricted to observations fulfilling +#' `filter_source`. +#' 1. For each subject (with respect to the variables specified for the +#' `subject_keys` parameter) the first observation (with respect to +#' `date_var`) where the event condition (`filter_source` parameter) is +#' fulfilled is selected. +#' 1. For each observation in `dataset_adsl` a new observation is created. For +#' subjects with event `AVALC` is set to `"Y"`, `AVAL` to `1`, and `ADT` to +#' the first date where the event condition is fulfilled. For all other +#' subjects `AVALC` is set to `"N"`, `AVAL` to `0`, and `ADT` to `NA`. +#' For subjects with event all variables from `dataset_source` are kept. For +#' subjects without event all variables which are in both `dataset_adsl` and +#' `dataset_source` are kept. +#' 1. The variables specified by the `set_values_to` parameter are added to +#' the new observations. +#' 1. The new observations are added to input dataset. +#' +#' @author Stefan Bundfuss +#' +#' @return The input dataset with a new parameter indicating if and when an +#' event occurred +#' +#' @family deprecated +#' @keywords deprecated +#' +#' @export +#' +derive_param_first_event <- function(dataset, + dataset_adsl, + dataset_source, + filter_source, + date_var, + subject_keys = vars(STUDYID, USUBJID), + set_values_to, + check_type = "warning") { + ### DEPRECATION + deprecate_warn("0.9.0", + "derive_param_first_event()", + details = "Please use `derive_param_extreme_event()` instead with the `order` argument instead of the `date_var` argument" + ) + + filter_source <- enquo(filter_source) + date_var <- enquo(date_var) + tmp_var <- get_new_tmp_var(dataset = dataset) + tmp_var <- enquo(tmp_var) + + derive_param_extreme_event( + dataset = dataset, + dataset_adsl = dataset_adsl, + dataset_source = dataset_source, + filter_source = !!filter_source, + order = vars(!!date_var), + new_var = !!tmp_var, + subject_keys = subject_keys, + set_values_to = set_values_to, + check_type = check_type, + mode = "first" + ) %>% + mutate( + AVALC = coalesce(!!tmp_var, AVALC), + AVAL = if_else(!!tmp_var == "Y", true = 1, false = 0) + ) %>% + remove_tmp_vars() +} + +#' Add an Extreme Event Parameter +#' +#' Add a new parameter for the first or last event occurring in a dataset. The +#' variable given in `new_var` indicates if an event occurred or not. For example, +#' the function can derive a parameter for the first disease progression. +#' +#' @param dataset Input dataset +#' +#' The `PARAMCD` variable is expected. +#' +#' @param dataset_adsl ADSL input dataset +#' +#' The variables specified for `subject_keys` are expected. For each +#' observation of the specified dataset a new observation is added to the +#' input dataset. +#' +#' @param dataset_source Source dataset +#' +#' All observations in the specified dataset fulfilling the condition +#' specified by `filter_source` are considered as an event. +#' +#' The variables specified by the `subject_keys` and +#' `order` parameter (if applicable) are expected. +#' +#' @param filter_source Source filter +#' +#' All observations in `dataset_source` fulfilling the specified condition are +#' considered as an event. +#' +#' For subjects with at least one event `new_var` is set to `true_value`. +#' +#' For all other subjects `new_var` is set to `false_value`. +#' +#' @param order Order variable +#' +#' List of symbols for sorting the source dataset (`dataset_source`). +#' +#' *Permitted Values*: list of variables or `desc()` function calls +#' created by `vars()`, e.g., `vars(ADT, desc(AVAL))`. +#' +#' @param new_var New variable +#' +#' The name of the variable which will indicate whether an event happened or not. +#' +#' @param true_value True value +#' +#' For all subjects with at least one observation in the source dataset +#' (`dataset_source`) fulfilling the event condition (`filter_source`), +#' `new_var` is set to the specified value `true_value`. +#' +#' @param false_value False value +#' +#' For all other subjects in `dataset_adsl` without an event, `new_var` is set to +#' the specified value `false_value`. +#' +#' @param mode Selection mode (first or last) +#' +#' If `"first"` is specified, the first observation of each subject is selected. +#' If `"last"` is specified, the last observation of each subject is selected. +#' +#' *Permitted Values*: `"first"`, `"last"` +#' +#' @param set_values_to Variables to set +#' +#' A named list returned by `vars()` defining the variables to be set for the +#' new parameter, e.g. `vars(PARAMCD = "PD", PARAM = "Disease Progression")` +#' is expected. The values must be symbols, character strings, numeric values, +#' or `NA`. Note, if you require a date or datetime variable to be populated, +#' this needs to be defined here. +#' +#' @param subject_keys Variables to uniquely identify a subject +#' +#' A list of symbols created using `vars()` is expected. +#' +#' @param check_type Check uniqueness? +#' +#' If `"warning"` or `"error"` is specified, a message is issued if the +#' observations of the input dataset restricted to the source parameter +#' (`source_param`) are not unique with respect to the subject keys +#' (`subject_key` parameter) and order variables (`order` parameter). +#' +#' *Permitted Values*: `"none"`, `"warning"`, `"error"` +#' +#' @details +#' 1. The source dataset (`dataset_source`) is restricted to observations fulfilling +#' `filter_source`. +#' 1. For each subject (with respect to the variables specified for the +#' `subject_keys` parameter) either the first or last observation from the restricted +#' source dataset is selected. This is depending on `mode`, (with respect to `order`, +#' if applicable) where the event condition (`filter_source` parameter) is fulfilled. +#' 1. For each observation in `dataset_adsl` a new observation is created. For +#' subjects with event `new_var` is set to `true_var`. For all other +#' subjects `new_var` is set to `false_var`. +#' For subjects with event all variables from `dataset_source` are kept. For +#' subjects without event all variables which are in both `dataset_adsl` and +#' `dataset_source` are kept. +#' 1. The variables specified by the `set_values_to` parameter are added to +#' the new observations. +#' 1. The new observations are added to input dataset. +#' +#' @author Stefan Bundfuss Sophie Shapcott +#' +#' @return The input dataset with a new parameter indicating if and when an +#' event occurred +#' +#' @family der_prm_bds_findings +#' @keywords der_prm_bds_findings +#' +#' @export +#' +#' @examples +#' library(tibble) +#' library(dplyr, warn.conflicts = FALSE) +#' library(lubridate) +#' +#' # Derive a new parameter for the first disease progression (PD) +#' adsl <- tribble( +#' ~USUBJID, ~DTHDT, +#' "1", ymd("2022-05-13"), +#' "2", ymd(""), +#' "3", ymd("") +#' ) %>% +#' mutate(STUDYID = "XX1234") +#' +#' adrs <- tribble( +#' ~USUBJID, ~ADTC, ~AVALC, +#' "1", "2020-01-02", "PR", +#' "1", "2020-02-01", "CR", +#' "1", "2020-03-01", "CR", +#' "1", "2020-04-01", "SD", +#' "2", "2021-06-15", "SD", +#' "2", "2021-07-16", "PD", +#' "2", "2021-09-14", "PD" +#' ) %>% +#' mutate( +#' STUDYID = "XX1234", +#' ADT = ymd(ADTC), +#' PARAMCD = "OVR", +#' PARAM = "Overall Response", +#' ANL01FL = "Y" +#' ) %>% +#' select(-ADTC) +#' +#' derive_param_extreme_event( +#' adrs, +#' dataset_adsl = adsl, +#' dataset_source = adrs, +#' filter_source = PARAMCD == "OVR" & AVALC == "PD", +#' order = vars(ADT), +#' new_var = AVALC, +#' true_value = "Y", +#' false_value = "N", +#' mode = "first", +#' set_values_to = vars( +#' PARAMCD = "PD", +#' PARAM = "Disease Progression", +#' ANL01FL = "Y", +#' ADT = ADT +#' ) +#' ) +#' +#' # derive parameter indicating death +#' derive_param_extreme_event( +#' dataset_adsl = adsl, +#' dataset_source = adsl, +#' filter_source = !is.na(DTHDT), +#' new_var = AVALC, +#' true_value = "Y", +#' false_value = "N", +#' mode = "first", +#' set_values_to = vars( +#' PARAMCD = "DEATH", +#' PARAM = "Death", +#' ANL01FL = "Y", +#' ADT = DTHDT +#' ) +#' ) +derive_param_extreme_event <- function(dataset = NULL, + dataset_adsl, + dataset_source, + filter_source, + order = NULL, + new_var = AVALC, + true_value = "Y", + false_value = "N", + mode = "first", + subject_keys = vars(STUDYID, USUBJID), + set_values_to, + check_type = "warning") { + # Check input parameters + filter_source <- assert_filter_cond(enquo(filter_source)) + assert_vars(subject_keys) + assert_vars(order, optional = TRUE) + assert_data_frame(dataset_source, + required_vars = vars(!!!subject_keys, !!!extract_vars(order)) + ) + new_var <- assert_symbol(enquo(new_var)) + assert_same_type(true_value, false_value) + assert_data_frame(dataset, optional = TRUE) + assert_data_frame(dataset_adsl, required_vars = subject_keys) + check_type <- + assert_character_scalar( + check_type, + values = c("none", "warning", "error"), + case_sensitive = FALSE + ) + mode <- assert_character_scalar( + mode, + values = c("first", "last"), + case_sensitive = FALSE + ) + assert_varval_list(set_values_to, required_elements = "PARAMCD") + if (!is.null(set_values_to$PARAMCD) & !is.null(dataset)) { + assert_param_does_not_exist(dataset, quo_get_expr(set_values_to$PARAMCD)) + } + + # Create new observations + source_vars <- colnames(dataset_source) + adsl_vars <- colnames(dataset_adsl) + + events <- dataset_source %>% + filter_if(filter_source) %>% + filter_extreme( + by_vars = subject_keys, + order = order, + mode = mode, + check_type = check_type + ) %>% + mutate(!!new_var := true_value) + + noevents <- anti_join( + select(dataset_adsl, intersect(source_vars, adsl_vars)), + select(events, !!!subject_keys), + by = sapply(subject_keys, as_name) + ) %>% + mutate(!!new_var := false_value) + + new_obs <- bind_rows(events, noevents) %>% + mutate( + !!!set_values_to + ) + + # Create output dataset + bind_rows(dataset, new_obs) +} diff --git a/R/derive_param_first_event.R b/R/derive_param_first_event.R deleted file mode 100644 index 3633bcd043..0000000000 --- a/R/derive_param_first_event.R +++ /dev/null @@ -1,201 +0,0 @@ -#' Add a First Event Parameter -#' -#' Add a new parameter for the first event occurring in a dataset. `AVALC` and -#' `AVAL` indicate if an event occurred and `ADT` is set to the date of the -#' first event. For example, the function can derive a parameter for the first -#' disease progression. -#' -#' @param dataset Input dataset -#' -#' The `PARAMCD` variable is expected. -#' -#' @param dataset_adsl ADSL input dataset -#' -#' The variables specified for `subject_keys` are expected. For each -#' observation of the specified dataset a new observation is added to the -#' input dataset. -#' -#' @param dataset_source Source dataset -#' -#' All observations in the specified dataset fulfilling the condition -#' specified by `filter_source` are considered as event. -#' -#' The variables specified by the `subject_keys` and -#' `date_var` parameter are expected. -#' -#' @param filter_source Source filter -#' -#' All observations in `dataset_source` fulfilling the specified condition are -#' considered as event. -#' -#' For subjects with at least one event `AVALC` is set to `"Y"`, `AVAL` to -#' `1`, and `ADT` to the first date where the condition is fulfilled. -#' -#' For all other subjects `AVALC` is set to `"N"`, `AVAL` to `0`, and `ADT` to -#' `NA`. -#' -#' @param date_var Date variable -#' -#' Date variable in the source dataset (`dataset_source`). The variable is -#' used to sort the source dataset. `ADT` is set to the specified variable for -#' events. -#' -#' @param set_values_to Variables to set -#' -#' A named list returned by `vars()` defining the variables to be set for the -#' new parameter, e.g. `vars(PARAMCD = "PD", PARAM = "Disease Progression")` -#' is expected. The values must be symbols, character strings, numeric values, -#' or `NA`. -#' -#' @param subject_keys Variables to uniquely identify a subject -#' -#' A list of symbols created using `vars()` is expected. -#' -#' @param check_type Check uniqueness? -#' -#' If `"warning"` or `"error"` is specified, a message is issued if the -#' observations of the input dataset restricted to the source parameter -#' (`source_param`) are not unique with respect to the subject keys -#' (`subject_key` parameter) and `ADT`. -#' -#' *Default*: `"warning"` -#' -#' *Permitted Values*: `"none"`, `"warning"`, `"error"` -#' -#' @details -#' 1. The input dataset is restricted to observations fulfilling -#' `filter_source`. -#' 1. For each subject (with respect to the variables specified for the -#' `subject_keys` parameter) the first observation (with respect to -#' `date_var`) where the event condition (`filter_source` parameter) is -#' fulfilled is selected. -#' 1. For each observation in `dataset_adsl` a new observation is created. For -#' subjects with event `AVALC` is set to `"Y"`, `AVAL` to `1`, and `ADT` to -#' the first date where the event condition is fulfilled. For all other -#' subjects `AVALC` is set to `"N"`, `AVAL` to `0`, and `ADT` to `NA`. -#' For subjects with event all variables from `dataset_source` are kept. For -#' subjects without event all variables which are in both `dataset_adsl` and -#' `dataset_source` are kept. -#' 1. The variables specified by the `set_values_to` parameter are added to -#' the new observations. -#' 1. The new observations are added to input dataset. -#' -#' @author Stefan Bundfuss -#' -#' @return The input dataset with a new parameter indicating if and when an -#' event occurred -#' -#' @family der_prm_bds_findings -#' @keywords der_prm_bds_findings -#' -#' @export -#' -#' @examples -#' library(dplyr) -#' library(lubridate) -#' -#' # Derive a new parameter for the first disease progression (PD) -#' adsl <- tibble::tribble( -#' ~USUBJID, ~DTHDT, -#' "1", ymd("2022-05-13"), -#' "2", ymd(""), -#' "3", ymd("") -#' ) %>% -#' mutate(STUDYID = "XX1234") -#' -#' adrs <- tibble::tribble( -#' ~USUBJID, ~ADTC, ~AVALC, -#' "1", "2020-01-02", "PR", -#' "1", "2020-02-01", "CR", -#' "1", "2020-03-01", "CR", -#' "1", "2020-04-01", "SD", -#' "2", "2021-06-15", "SD", -#' "2", "2021-07-16", "PD", -#' "2", "2021-09-14", "PD" -#' ) %>% -#' mutate( -#' STUDYID = "XX1234", -#' ADT = ymd(ADTC), -#' PARAMCD = "OVR", -#' PARAM = "Overall Response", -#' ANL01FL = "Y" -#' ) %>% -#' select(-ADTC) -#' -#' derive_param_first_event( -#' adrs, -#' dataset_adsl = adsl, -#' dataset_source = adrs, -#' filter_source = PARAMCD == "OVR" & AVALC == "PD", -#' date_var = ADT, -#' set_values_to = vars( -#' PARAMCD = "PD", -#' PARAM = "Disease Progression", -#' ANL01FL = "Y" -#' ) -#' ) -#' -#' # derive parameter indicating death -#' derive_param_first_event( -#' dataset = adrs, -#' dataset_adsl = adsl, -#' dataset_source = adsl, -#' filter_source = !is.na(DTHDT), -#' date_var = DTHDT, -#' set_values_to = vars( -#' PARAMCD = "DEATH", -#' PARAM = "Death", -#' ANL01FL = "Y" -#' ) -#' ) -derive_param_first_event <- function(dataset, - dataset_adsl, - dataset_source, - filter_source, - date_var, - subject_keys = vars(STUDYID, USUBJID), - set_values_to, - check_type = "warning") { - # Check input parameters - filter_source <- assert_filter_cond(enquo(filter_source)) - date_var <- assert_symbol(enquo(date_var)) - assert_vars(subject_keys) - assert_data_frame(dataset, required_vars = vars(PARAMCD)) - assert_data_frame(dataset_source, required_vars = vars(!!!subject_keys, !!date_var)) - assert_data_frame(dataset_adsl, required_vars = subject_keys) - check_type <- - assert_character_scalar( - check_type, - values = c("none", "warning", "error"), - case_sensitive = FALSE - ) - assert_varval_list(set_values_to, required_elements = "PARAMCD") - assert_param_does_not_exist(dataset, quo_get_expr(set_values_to$PARAMCD)) - - # Create new observations - source_vars <- colnames(dataset_source) - adsl_vars <- colnames(dataset_adsl) - - events <- dataset_source %>% - filter_if(filter_source) %>% - filter_extreme( - by_vars = subject_keys, - order = vars(!!date_var), - mode = "first", - check_type = check_type - ) - noevents <- anti_join( - select(dataset_adsl, intersect(source_vars, adsl_vars)), - select(events, !!!subject_keys) - ) - new_obs <- bind_rows(events, noevents) %>% - mutate( - ADT = !!date_var, - AVALC = if_else(!is.na(ADT), "Y", "N"), - AVAL = if_else(!is.na(ADT), 1, 0), - !!!set_values_to - ) - - # Create output dataset - bind_rows(dataset, new_obs) -} diff --git a/R/derive_param_framingham.R b/R/derive_param_framingham.R index 326f5faa4d..e00cc0aca4 100644 --- a/R/derive_param_framingham.R +++ b/R/derive_param_framingham.R @@ -140,9 +140,9 @@ #' @seealso [compute_framingham()] #' #' @examples -#' library(dplyr, warn.conflicts = FALSE) +#' library(tibble) #' -#' adcvrisk <- tibble::tribble( +#' adcvrisk <- tribble( #' ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, #' ~VISIT, ~AGE, ~SEX, ~SMOKEFL, ~DIABETFL, ~TRTHYPFL, #' "01-701-1015", "SYSBP", "Systolic Blood Pressure (mmHg)", 121, diff --git a/R/derive_param_tte.R b/R/derive_param_tte.R index 3701aa3e73..8dac11019a 100644 --- a/R/derive_param_tte.R +++ b/R/derive_param_tte.R @@ -239,7 +239,7 @@ derive_param_tte <- function(dataset = NULL, censor_conditions, create_datetime = FALSE, set_values_to, - subject_keys = vars(STUDYID, USUBJID)) { + subject_keys = get_admiral_option("subject_keys")) { # checking and quoting # assert_data_frame(dataset, optional = TRUE) assert_vars(by_vars, optional = TRUE) @@ -376,7 +376,7 @@ derive_param_tte <- function(dataset = NULL, ) new_param <- new_param %>% - mutate(!!date_var := pmax(!!date_var, !!start_var)) %>% + mutate(!!date_var := pmax(!!date_var, !!start_var, na.rm = TRUE)) %>% remove_tmp_vars() if (!is.null(by_vars)) { @@ -498,7 +498,7 @@ derive_param_tte <- function(dataset = NULL, #' source_datasets = list(adsl = adsl, ae = ae), #' by_vars = vars(AEDECOD), #' create_datetime = FALSE, -#' subject_keys = vars(STUDYID, USUBJID), +#' subject_keys = get_admiral_option("subject_keys"), #' mode = "first" #' ) filter_date_sources <- function(sources, @@ -598,17 +598,18 @@ filter_date_sources <- function(sources, #' @family source_specifications #' #' @examples +#' library(tibble) #' library(dplyr, warn.conflicts = FALSE) #' library(lubridate) #' -#' adsl <- tibble::tribble( +#' adsl <- tribble( #' ~USUBJID, ~TRTSDT, ~EOSDT, #' "01", ymd("2020-12-06"), ymd("2021-03-06"), #' "02", ymd("2021-01-16"), ymd("2021-02-03") #' ) %>% #' mutate(STUDYID = "AB42") #' -#' ae <- tibble::tribble( +#' ae <- tribble( #' ~USUBJID, ~AESTDTC, ~AESEQ, ~AEDECOD, #' "01", "2021-01-03T10:56", 1, "Flu", #' "01", "2021-03-04", 2, "Cough", @@ -753,6 +754,7 @@ tte_source <- function(dataset_name, #' #' @examples #' # Death event +#' #' event_source( #' dataset_name = "adsl", #' filter = DTHFL == "Y", @@ -798,6 +800,7 @@ event_source <- function(dataset_name, #' #' @examples #' # Last study date known alive censor +#' #' censor_source( #' dataset_name = "adsl", #' date = LSTALVDT, @@ -823,38 +826,6 @@ censor_source <- function(dataset_name, out } -#' Print `tte_source` Objects -#' -#' @param x A `tte_source` object -#' @param ... Not used -#' -#' @return No return value, called for side effects -#' -#' @author Thomas Neitmann -#' -#' @keywords internal -#' @family internal -#' -#' @export -#' -#' @seealso [tte_source()], [censor_source()], [event_source()] -#' -#' @examples -#' print(death_event) -print.tte_source <- function(x, ...) { - cat <- function(...) base::cat(..., sep = "") - cat(" object\n") - cat("dataset_name: \"", x$dataset_name, "\"\n") - cat("filter: ", quo_text(x$filter), "\n") - cat("date: ", quo_text(x$date), "\n") - cat("censor: ", x$censor, "\n") - cat("set_values_to:\n") - for (name in names(x$set_values_to)) { - cat(" ", name, ": ", quo_text(x$set_values_to[[name]]), "\n") - } -} - - #' List all `tte_source` Objects Available in a Package #' #' @param package The name of the package in which to search for `tte_source` objects diff --git a/R/derive_param_wbc_abs.R b/R/derive_param_wbc_abs.R index fb623816ec..7270a5ee29 100644 --- a/R/derive_param_wbc_abs.R +++ b/R/derive_param_wbc_abs.R @@ -77,8 +77,9 @@ #' @export #' #' @examples -#' library(dplyr, warn.conflicts = FALSE) -#' test_lb <- tibble::tribble( +#' library(tibble) +#' +#' test_lb <- tribble( #' ~USUBJID, ~PARAMCD, ~AVAL, ~PARAM, ~VISIT, #' "P01", "WBC", 33, "Leukocyte Count (10^9/L)", "CYCLE 1 DAY 1", #' "P01", "WBC", 38, "Leukocyte Count (10^9/L)", "CYCLE 2 DAY 1", diff --git a/R/derive_summary_records.R b/R/derive_summary_records.R index c67e296c48..eea743d50f 100644 --- a/R/derive_summary_records.R +++ b/R/derive_summary_records.R @@ -59,8 +59,10 @@ #' @export #' #' @examples -#' library(dplyr, warn.conflicts = FALSE) -#' adeg <- tibble::tribble( +#' library(tibble) +#' library(dplyr, warn.conflicts = TRUE) +#' +#' adeg <- tribble( #' ~USUBJID, ~EGSEQ, ~PARAM, ~AVISIT, ~EGDTC, ~AVAL, ~TRTA, #' "XYZ-1001", 1, "QTcF Int. (msec)", "Baseline", "2016-02-24T07:50", 385, "", #' "XYZ-1001", 2, "QTcF Int. (msec)", "Baseline", "2016-02-24T07:52", 399, "", @@ -91,7 +93,7 @@ #' set_values_to = vars(DTYPE = "AVERAGE") #' ) #' -#' advs <- tibble::tribble( +#' advs <- tribble( #' ~USUBJID, ~VSSEQ, ~PARAM, ~AVAL, ~VSSTRESU, ~VISIT, ~VSDTC, #' "XYZ-001-001", 1164, "Weight", 99, "kg", "Screening", "2018-03-19", #' "XYZ-001-001", 1165, "Weight", 101, "kg", "Run-In", "2018-03-26", @@ -118,7 +120,7 @@ #' ) #' #' # Sample ADEG dataset with triplicate record for only AVISIT = 'Baseline' -#' adeg <- tibble::tribble( +#' adeg <- tribble( #' ~USUBJID, ~EGSEQ, ~PARAM, ~AVISIT, ~EGDTC, ~AVAL, ~TRTA, #' "XYZ-1001", 1, "QTcF Int. (msec)", "Baseline", "2016-02-24T07:50", 385, "", #' "XYZ-1001", 2, "QTcF Int. (msec)", "Baseline", "2016-02-24T07:52", 399, "", @@ -141,7 +143,7 @@ #' derive_summary_records( #' adeg, #' by_vars = vars(USUBJID, PARAM, AVISIT), -#' filter = dplyr::n() > 2, +#' filter = n() > 2, #' analysis_var = AVAL, #' summary_fun = function(x) mean(x, na.rm = TRUE), #' set_values_to = vars(DTYPE = "AVERAGE") diff --git a/R/derive_var_analysis_ratio.R b/R/derive_var_analysis_ratio.R index 42213632e1..0a42f62be3 100644 --- a/R/derive_var_analysis_ratio.R +++ b/R/derive_var_analysis_ratio.R @@ -38,9 +38,9 @@ #' @export #' #' @examples -#' library(dplyr, warn.conflicts = FALSE) +#' library(tibble) #' -#' data <- tibble::tribble( +#' data <- tribble( #' ~USUBJID, ~PARAMCD, ~SEQ, ~AVAL, ~BASE, ~ANRLO, ~ANRHI, #' "P01", "ALT", 1, 27, 27, 6, 34, #' "P01", "ALT", 2, 41, 27, 6, 34, diff --git a/R/derive_var_anrind.R b/R/derive_var_anrind.R index d678642319..7972548a51 100644 --- a/R/derive_var_anrind.R +++ b/R/derive_var_anrind.R @@ -25,11 +25,12 @@ #' @export #' #' @examples +#' library(tibble) #' library(dplyr, warn.conflicts = FALSE) #' library(admiral.test) #' data(admiral_vs) #' -#' ref_ranges <- tibble::tribble( +#' ref_ranges <- tribble( #' ~PARAMCD, ~ANRLO, ~ANRHI, ~A1LO, ~A1HI, #' "DIABP", 60, 80, 40, 90, #' "PULSE", 60, 100, 40, 110 diff --git a/R/derive_var_atoxgr.R b/R/derive_var_atoxgr.R index 5cfef9c12b..6c354805fa 100644 --- a/R/derive_var_atoxgr.R +++ b/R/derive_var_atoxgr.R @@ -15,11 +15,14 @@ #' #' @param meta_criteria Metadata data set holding the criteria (normally a case statement) #' -#' Default: `atoxgr_criteria_ctcv4` +#' Permitted Values: atoxgr_criteria_ctcv4, atoxgr_criteria_ctcv5 #' #' {admiral} metadata data set `atoxgr_criteria_ctcv4` implements #' [Common Terminology Criteria for Adverse Events (CTCAE) #' v4.0](https://ctep.cancer.gov/protocoldevelopment/electronic_applications/ctc.htm) +#' {admiral} metadata data set `atoxgr_criteria_ctcv5` implements +#' [Common Terminology Criteria for Adverse Events (CTCAE) +#' v5.0](https://ctep.cancer.gov/protocoldevelopment/electronic_applications/ctc.htm) #' #' The metadata should have the following variables: #' @@ -67,9 +70,9 @@ #' @export #' #' @examples -#' library(dplyr, warn.conflicts = FALSE) +#' library(tibble) #' -#' data <- tibble::tribble( +#' data <- tribble( #' ~ATOXDSCL, ~AVAL, ~ANRLO, ~ANRHI, ~PARAM, #' "Hypoglycemia", 119, 4, 7, "Glucose (mmol/L)", #' "Hypoglycemia", 120, 4, 7, "Glucose (mmol/L)", @@ -87,7 +90,7 @@ #' get_unit_expr = extract_unit(PARAM) #' ) #' -#' data <- tibble::tribble( +#' data <- tribble( #' ~ATOXDSCH, ~AVAL, ~ANRLO, ~ANRHI, ~PARAM, #' "Hyperglycemia", 119, 4, 7, "Glucose (mmol/L)", #' "Hyperglycemia", 120, 4, 7, "Glucose (mmol/L)", @@ -107,7 +110,7 @@ derive_var_atoxgr_dir <- function(dataset, new_var, tox_description_var, - meta_criteria = atoxgr_criteria_ctcv4, + meta_criteria, criteria_direction, get_unit_expr) { new_var <- assert_symbol(enquo(new_var)) @@ -165,7 +168,6 @@ derive_var_atoxgr_dir <- function(dataset, # for each TERM apply criteria and create grade derivation for (i in seq_along(list_of_terms$TERM)) { - # filter metadata on a term meta_this_term <- atoxgr_dir %>% filter(TERM_UPPER == list_of_terms$TERM_UPPER[i]) @@ -245,9 +247,9 @@ derive_var_atoxgr_dir <- function(dataset, #' @export #' #' @examples -#' library(dplyr, warn.conflicts = FALSE) +#' library(tibble) #' -#' adlb <- tibble::tribble( +#' adlb <- tribble( #' ~ATOXDSCL, ~ATOXDSCH, ~ATOXGRL, ~ATOXGRH, #' "Hypoglycemia", "Hyperglycemia", NA_character_, "0", #' "Hypoglycemia", "Hyperglycemia", "0", "1", diff --git a/R/derive_var_base.R b/R/derive_var_base.R index 89b4789ed8..ec18c7e949 100644 --- a/R/derive_var_base.R +++ b/R/derive_var_base.R @@ -20,8 +20,8 @@ #' dataset plus the `new_var` variable #' #' @details -#' For each `by_vars` group the baseline record is identified by filtering using the -#' condition specified by `filter` which defaults to `ABLFL == "Y"`. Subsequently, +#' For each `by_vars` group, the baseline record is identified by the +#' condition specified in `filter` which defaults to `ABLFL == "Y"`. Subsequently, #' every value of the `new_var` variable for the `by_vars` group is set to the #' value of the `source_var` variable of the baseline record. In case there are #' multiple baseline records within `by_vars` an error is issued. @@ -35,20 +35,22 @@ #' @keywords der_bds_findings #' #' @examples -#' dataset <- tibble::tribble( -#' ~STUDYID, ~USUBJID, ~PARAMCD, ~AVAL, ~AVALC, ~AVISIT, ~ABLFL, -#' "TEST01", "PAT01", "PARAM01", 10.12, NA, "Baseline", "Y", -#' "TEST01", "PAT01", "PARAM01", 9.700, NA, "Day 7", "N", -#' "TEST01", "PAT01", "PARAM01", 15.01, NA, "Day 14", "N", -#' "TEST01", "PAT01", "PARAM02", 8.350, NA, "Baseline", "Y", -#' "TEST01", "PAT01", "PARAM02", NA, NA, "Day 7", "N", -#' "TEST01", "PAT01", "PARAM02", 8.350, NA, "Day 14", "N", -#' "TEST01", "PAT01", "PARAM03", NA, "LOW", "Baseline", "Y", -#' "TEST01", "PAT01", "PARAM03", NA, "LOW", "Day 7", "N", -#' "TEST01", "PAT01", "PARAM03", NA, "MEDIUM", "Day 14", "N", -#' "TEST01", "PAT01", "PARAM04", NA, "HIGH", "Baseline", "Y", -#' "TEST01", "PAT01", "PARAM04", NA, "HIGH", "Day 7", "N", -#' "TEST01", "PAT01", "PARAM04", NA, "MEDIUM", "Day 14", "N" +#' library(tibble) +#' +#' dataset <- tribble( +#' ~STUDYID, ~USUBJID, ~PARAMCD, ~AVAL, ~AVALC, ~AVISIT, ~ABLFL, ~ANRIND, +#' "TEST01", "PAT01", "PARAM01", 10.12, NA, "Baseline", "Y", "NORMAL", +#' "TEST01", "PAT01", "PARAM01", 9.700, NA, "Day 7", "N", "LOW", +#' "TEST01", "PAT01", "PARAM01", 15.01, NA, "Day 14", "N", "HIGH", +#' "TEST01", "PAT01", "PARAM02", 8.350, NA, "Baseline", "Y", "LOW", +#' "TEST01", "PAT01", "PARAM02", NA, NA, "Day 7", "N", NA, +#' "TEST01", "PAT01", "PARAM02", 8.350, NA, "Day 14", "N", "LOW", +#' "TEST01", "PAT01", "PARAM03", NA, "LOW", "Baseline", "Y", NA, +#' "TEST01", "PAT01", "PARAM03", NA, "LOW", "Day 7", "N", NA, +#' "TEST01", "PAT01", "PARAM03", NA, "MEDIUM", "Day 14", "N", NA, +#' "TEST01", "PAT01", "PARAM04", NA, "HIGH", "Baseline", "Y", NA, +#' "TEST01", "PAT01", "PARAM04", NA, "HIGH", "Day 7", "N", NA, +#' "TEST01", "PAT01", "PARAM04", NA, "MEDIUM", "Day 14", "N", NA #' ) #' #' ## Derive `BASE` variable from `AVAL` @@ -68,14 +70,12 @@ #' ) #' #' ## Derive `BNRIND` variable from `ANRIND` -#' if (FALSE) { -#' derive_var_base( -#' dataset, -#' by_vars = vars(USUBJID, PARAMCD), -#' source_var = ANRIND, -#' new_var = BNRIND -#' ) -#' } +#' derive_var_base( +#' dataset, +#' by_vars = vars(USUBJID, PARAMCD), +#' source_var = ANRIND, +#' new_var = BNRIND +#' ) derive_var_base <- function(dataset, by_vars, source_var = AVAL, diff --git a/R/derive_var_basetype.R b/R/derive_var_basetype.R index 9c18ad7bb4..821d4e97a0 100644 --- a/R/derive_var_basetype.R +++ b/R/derive_var_basetype.R @@ -1,4 +1,4 @@ -#' Derive BASETYPE Variable +#' Derive Basetype Variable #' #' Baseline Type `BASETYPE` is needed when there is more than one definition of #' baseline for a given Analysis Parameter `PARAM` in the same dataset. For a @@ -39,7 +39,11 @@ #' @export #' #' @examples -#' bds <- tibble::tribble( +#' library(tibble) +#' library(dplyr, warn.conflicts = FALSE) +#' library(rlang) +#' +#' bds <- tribble( #' ~USUBJID, ~EPOCH, ~PARAMCD, ~ASEQ, ~AVAL, #' "P01", "RUN-IN", "PARAM01", 1, 10.0, #' "P01", "RUN-IN", "PARAM01", 2, 9.8, @@ -56,7 +60,7 @@ #' #' bds_with_basetype <- derive_var_basetype( #' dataset = bds, -#' basetypes = rlang::exprs( +#' basetypes = exprs( #' "RUN-IN" = EPOCH %in% c("RUN-IN", "STABILIZATION", "DOUBLE-BLIND", "OPEN-LABEL"), #' "DOUBLE-BLIND" = EPOCH %in% c("DOUBLE-BLIND", "OPEN-LABEL"), #' "OPEN-LABEL" = EPOCH == "OPEN-LABEL" @@ -68,11 +72,11 @@ #' # bds_with_basetype #' print(bds_with_basetype, n = Inf) #' -#' dplyr::count(bds_with_basetype, BASETYPE, name = "Number of Records") +#' count(bds_with_basetype, BASETYPE, name = "Number of Records") #' #' # An example where all parameter records need to be included for 2 different #' # baseline type derivations (such as LAST and WORST) -#' bds <- tibble::tribble( +#' bds <- tribble( #' ~USUBJID, ~EPOCH, ~PARAMCD, ~ASEQ, ~AVAL, #' "P01", "RUN-IN", "PARAM01", 1, 10.0, #' "P01", "RUN-IN", "PARAM01", 2, 9.8, @@ -82,7 +86,7 @@ #' #' bds_with_basetype <- derive_var_basetype( #' dataset = bds, -#' basetypes = rlang::exprs( +#' basetypes = exprs( #' "LAST" = TRUE, #' "WORST" = TRUE #' ) @@ -90,7 +94,7 @@ #' #' print(bds_with_basetype, n = Inf) #' -#' dplyr::count(bds_with_basetype, BASETYPE, name = "Number of Records") +#' count(bds_with_basetype, BASETYPE, name = "Number of Records") derive_var_basetype <- function(dataset, basetypes) { assert_data_frame(dataset) assert_named_exprs(basetypes) diff --git a/R/derive_var_chg.R b/R/derive_var_chg.R index 123244fe71..a22b433988 100644 --- a/R/derive_var_chg.R +++ b/R/derive_var_chg.R @@ -19,7 +19,9 @@ #' @export #' #' @examples -#' advs <- tibble::tribble( +#' library(tibble) +#' +#' advs <- tribble( #' ~USUBJID, ~PARAMCD, ~AVAL, ~ABLFL, ~BASE, #' "P01", "WEIGHT", 80, "Y", 80, #' "P01", "WEIGHT", 80.8, "", 80, diff --git a/R/derive_var_disposition_status.R b/R/derive_var_disposition_status.R index f86f7b822a..4b457294ae 100644 --- a/R/derive_var_disposition_status.R +++ b/R/derive_var_disposition_status.R @@ -145,7 +145,7 @@ format_eoxxstt_default <- function(status) { #' x == "COMPLETED" ~ "COMPLETED", #' x == "ADVERSE EVENT" ~ "DISCONTINUED DUE TO AE", #' !(x %in% c("ADVERSE EVENT", "COMPLETED", "SCREEN FAILURE")) & !is.na(x) ~ -#' "DISCONTINUED NOT DUE TO AE", +#' "DISCONTINUED NOT DUE TO AE", #' TRUE ~ "ONGOING" #' ) #' } @@ -165,7 +165,7 @@ derive_var_disposition_status <- function(dataset, status_var, format_new_var = format_eoxxstt_default, filter_ds, - subject_keys = vars(STUDYID, USUBJID)) { + subject_keys = get_admiral_option("subject_keys")) { new_var <- assert_symbol(enquo(new_var)) status_var <- assert_symbol(enquo(status_var)) filter_ds <- assert_filter_cond(enquo(filter_ds)) diff --git a/R/derive_var_dthcaus.R b/R/derive_var_dthcaus.R index fa603c61fc..152e4839ed 100644 --- a/R/derive_var_dthcaus.R +++ b/R/derive_var_dthcaus.R @@ -29,13 +29,15 @@ #' @author #' Shimeng Huang, Samia Kabi, Thomas Neitmann, Tamara Senior #' -#' @return `derive_var_dthcaus()` returns the input dataset with `DTHCAUS` variable added. +#' @return The input dataset with `DTHCAUS` variable added. #' #' @export #' +#' @seealso [dthcaus_source()] +#' #' @examples #' library(tibble) -#' library(dplyr) +#' library(dplyr, warn.conflicts = FALSE) #' library(lubridate) #' #' adsl <- tribble( @@ -134,7 +136,7 @@ derive_var_dthcaus <- function(dataset, ..., source_datasets, - subject_keys = vars(STUDYID, USUBJID)) { + subject_keys = get_admiral_option("subject_keys")) { assert_vars(subject_keys) assert_data_frame(dataset, required_vars = subject_keys) assert_list_of(source_datasets, "data.frame") @@ -198,6 +200,7 @@ derive_var_dthcaus <- function(dataset, } if (!is.null(sources[[ii]]$traceability)) { warn_if_vars_exist(source_dataset, names(sources[[ii]]$traceability)) + assert_data_frame(source_dataset, required_vars = get_source_vars(sources[[ii]]$traceability)) add_data[[ii]] <- add_data[[ii]] %>% transmute( !!!subject_keys, @@ -259,14 +262,35 @@ derive_var_dthcaus <- function(dataset, #' in the returned dataset. #' These can be either strings or symbols referring to existing variables. #' -#' @describeIn derive_var_dthcaus Create objects of class "dthcaus_source" -#' #' @keywords source_specifications #' @family source_specifications #' +#' @author Shimeng Huang +#' #' @export #' -#' @return `dthcaus_source()` returns an object of class "dthcaus_source". +#' @seealso [derive_var_dthcaus()] +#' +#' @return An object of class "dthcaus_source". +#' +#' @examples +#' # Deaths sourced from AE +#' src_ae <- dthcaus_source( +#' dataset_name = "ae", +#' filter = AEOUT == "FATAL", +#' date = AEDTHDT, +#' mode = "first", +#' dthcaus = AEDECOD +#' ) +#' +#' # Deaths sourced from DS +#' src_ds <- dthcaus_source( +#' dataset_name = "ds", +#' filter = DSDECOD == "DEATH", +#' date = DSSTDT, +#' mode = "first", +#' dthcaus = DSTERM +#' ) dthcaus_source <- function(dataset_name, filter, date, @@ -283,6 +307,6 @@ dthcaus_source <- function(dataset_name, dthcaus = assert_symbol(enquo(dthcaus)) %or% assert_character_scalar(dthcaus), traceability = assert_varval_list(traceability_vars, optional = TRUE) ) - class(out) <- c("dthcaus_source", "list") + class(out) <- c("dthcaus_source", "source", "list") out } diff --git a/R/derive_var_extreme_date.R b/R/derive_var_extreme_date.R index a50234e5a8..378a0f04ca 100644 --- a/R/derive_var_extreme_date.R +++ b/R/derive_var_extreme_date.R @@ -173,7 +173,7 @@ derive_var_extreme_dtm <- function(dataset, ..., source_datasets, mode, - subject_keys = vars(STUDYID, USUBJID)) { + subject_keys = get_admiral_option("subject_keys")) { assert_vars(subject_keys) assert_data_frame(dataset, required_vars = subject_keys) new_var <- assert_symbol(enquo(new_var)) @@ -222,6 +222,15 @@ derive_var_extreme_dtm <- function(dataset, var = !!date, dataset_name = source_dataset_name ) + + if (!is.null(sources[[i]]$traceability_vars)) { + warn_if_vars_exist(source_dataset, names(sources[[i]]$traceability_vars)) + assert_data_frame( + source_dataset, + required_vars = get_source_vars(sources[[i]]$traceability_vars) + ) + } + add_data[[i]] <- source_dataset %>% filter_if(sources[[i]]$filter) %>% filter(!is.na(!!date)) %>% @@ -409,7 +418,7 @@ derive_var_extreme_dt <- function(dataset, ..., source_datasets, mode, - subject_keys = vars(STUDYID, USUBJID)) { + subject_keys = get_admiral_option("subject_keys")) { new_var <- assert_symbol(enquo(new_var)) sources <- list(...) @@ -463,6 +472,31 @@ derive_var_extreme_dt <- function(dataset, #' @export #' #' @return An object of class `date_source`. +#' +#' @examples +#' +#' # treatment end date from ADSL +#' trt_end_date <- date_source( +#' dataset_name = "adsl", +#' date = TRTEDT +#' ) +#' +#' # lab date from LB where assessment was taken, i.e. not "NOT DONE" +#' lb_date <- date_source( +#' dataset_name = "lb", +#' filter = LBSTAT != "NOT DONE" | is.na(LBSTAT), +#' date = LBDT +#' ) +#' +#' # death date from ADSL including traceability variables +#' death_date <- date_source( +#' dataset_name = "adsl", +#' date = DTHDT, +#' traceability_vars = vars( +#' LALVDOM = "ADSL", +#' LALVVAR = "DTHDT" +#' ) +#' ) date_source <- function(dataset_name, filter = NULL, date, @@ -506,6 +540,6 @@ date_source <- function(dataset_name, date = assert_symbol(enquo(date)), traceability_vars = assert_varval_list(traceability_vars, optional = TRUE) ) - class(out) <- c("date_source", "list") + class(out) <- c("date_source", "source", "list") out } diff --git a/R/derive_var_extreme_flag.R b/R/derive_var_extreme_flag.R index 875c7e269c..c3a088c417 100644 --- a/R/derive_var_extreme_flag.R +++ b/R/derive_var_extreme_flag.R @@ -63,6 +63,7 @@ #' @export #' #' @examples +#' library(tibble) #' library(dplyr, warn.conflicts = FALSE) #' library(admiral.test) #' data("admiral_vs") @@ -84,7 +85,7 @@ #' #' # Baseline (ABLFL) examples: #' -#' input <- tibble::tribble( +#' input <- tribble( #' ~STUDYID, ~USUBJID, ~PARAMCD, ~AVISIT, ~ADT, ~AVAL, ~DTYPE, #' "TEST01", "PAT01", "PARAM01", "BASELINE", as.Date("2021-04-27"), 15.0, NA, #' "TEST01", "PAT01", "PARAM01", "BASELINE", as.Date("2021-04-25"), 14.0, NA, @@ -281,8 +282,10 @@ derive_var_extreme_flag <- function(dataset, #' @export #' #' @examples +#' library(tibble) +#' library(dplyr, warn.conflicts = FALSE) #' -#' input <- tibble::tribble( +#' input <- tribble( #' ~STUDYID, ~USUBJID, ~PARAMCD, ~AVISIT, ~ADT, ~AVAL, #' "TEST01", "PAT01", "PARAM01", "BASELINE", as.Date("2021-04-27"), 15.0, #' "TEST01", "PAT01", "PARAM01", "BASELINE", as.Date("2021-04-25"), 14.0, diff --git a/R/derive_var_ontrtfl.R b/R/derive_var_ontrtfl.R index 64c9afc23d..1de13c05cf 100644 --- a/R/derive_var_ontrtfl.R +++ b/R/derive_var_ontrtfl.R @@ -48,6 +48,14 @@ #' measured in days (e.g. 7 if 7 days should be added to the upper bound) #' Optional; default is 0. #' +#' @param ignore_time_for_ref_end_date +#' +#' If the argument is set to `TRUE`, the time part is ignored for checking if +#' the event occurred more than `ref_end_window` days after reference end +#' date. +#' +#' *Permitted Values:* `TRUE`, `FALSE` +#' #' @param filter_pre_timepoint An expression to filter observations as not #' on-treatment when `date` = `ref_start_date`. For example, if observations #' where `VSTPT = PRE` should not be considered on-treatment when `date = @@ -94,8 +102,8 @@ #' #' @examples #' library(tibble) -#' library(dplyr) -#' library(lubridate, warn.conflict = FALSE) +#' library(dplyr, warn.conflicts = FALSE) +#' library(lubridate, warn.conflicts = FALSE) #' #' advs <- tribble( #' ~USUBJID, ~ADT, ~TRTSDT, ~TRTEDT, @@ -177,6 +185,7 @@ derive_var_ontrtfl <- function(dataset, ref_start_date, ref_end_date = NULL, ref_end_window = 0, + ignore_time_for_ref_end_date = TRUE, filter_pre_timepoint = NULL, span_period = NULL) { new_var <- assert_symbol(enquo(new_var)) @@ -191,6 +200,7 @@ derive_var_ontrtfl <- function(dataset, warn_if_vars_exist(dataset, quo_text(new_var)) ref_end_window <- assert_integer_scalar(ref_end_window, "non-negative") + assert_logical_scalar(ignore_time_for_ref_end_date) filter_pre_timepoint <- assert_filter_cond(enquo(filter_pre_timepoint), optional = TRUE) assert_character_scalar(span_period, values = c("Y", "y"), optional = TRUE) @@ -226,11 +236,15 @@ derive_var_ontrtfl <- function(dataset, ) } else { # Scenario 2: Treatment end date is passed, window added above + if (ignore_time_for_ref_end_date) { + end_cond <- expr(date(!!start_date) <= date(!!ref_end_date) + days(!!ref_end_window)) + } else { + end_cond <- expr(!!start_date <= !!ref_end_date + days(!!ref_end_window)) + } dataset <- mutate( dataset, !!new_var := if_else( - !is.na(!!ref_start_date) & !is.na(!!start_date) & !!ref_start_date < !!start_date & - !is.na(!!ref_end_date) & !!start_date <= (!!ref_end_date + days(!!ref_end_window)), + !!ref_start_date < !!start_date & !!end_cond, "Y", !!new_var, missing = !!new_var @@ -238,7 +252,7 @@ derive_var_ontrtfl <- function(dataset, ) } - # scenario 3: end_date is parsed + # scenario 3: end_date is passed if (!quo_is_null(end_date)) { dataset <- mutate( dataset, @@ -251,12 +265,12 @@ derive_var_ontrtfl <- function(dataset, ) } - # scenario 4: end_date and span_period are parsed + # scenario 4: end_date and span_period are passed if (!is.null(span_period)) { dataset <- mutate( dataset, !!new_var := if_else( - !!start_date <= (!!ref_end_date + days(!!ref_end_window)) & + !!end_cond & (is.na(!!end_date) | !!end_date >= !!ref_start_date), "Y", !!new_var, diff --git a/R/derive_var_pchg.R b/R/derive_var_pchg.R index 00eb5240ce..44d1a6fc0b 100644 --- a/R/derive_var_pchg.R +++ b/R/derive_var_pchg.R @@ -20,7 +20,9 @@ #' @seealso [derive_var_chg()] #' #' @examples -#' advs <- tibble::tribble( +#' library(tibble) +#' +#' advs <- tribble( #' ~USUBJID, ~PARAMCD, ~AVAL, ~ABLFL, ~BASE, #' "P01", "WEIGHT", 80, "Y", 80, #' "P01", "WEIGHT", 80.8, "", 80, diff --git a/R/derive_var_relative_flag.R b/R/derive_var_relative_flag.R new file mode 100644 index 0000000000..85d57b946f --- /dev/null +++ b/R/derive_var_relative_flag.R @@ -0,0 +1,204 @@ +#' Flag Observations Before or After a Condition is Fulfilled +#' +#' Flag all observations before or after the observation where a specified +#' condition is fulfilled for each by group. For example, the function could be +#' called to flag for each subject all observations before the first disease +#' progression or to flag all AEs after a specific AE. +#' +#' @param dataset Input dataset +#' +#' The variables specified by the `order` and the `by_vars` argument are +#' expected. +#' +#' @param by_vars Grouping variables +#' +#' *Permitted Values:* list of variables created by `vars()` +#' +#' @param order Sort order +#' +#' Within each by group the observations are ordered by the specified order. +#' +#' *Permitted Values:* list of variables or `desc()` function calls +#' created by `vars()`, e.g., `vars(ADT, desc(AVAL))` +#' +#' @param new_var New variable +#' +#' The variable is added to the input dataset and set to `"Y"` for all +#' observations before or after the condition is fulfilled. For all other +#' observations it is set to `NA`. +#' +#' @param condition Condition for Reference Observation +#' +#' The specified condition determines the reference observation. In the output +#' dataset all observations before or after (`selection` argument) +#' the reference observation are flagged. +#' +#' @param mode Selection mode (first or last) +#' +#' If `"first"` is specified, for each by group the observations before or +#' after (`selection` argument) the observation where the condition +#' (`condition` argument) is fulfilled the *first* time is flagged in the +#' output dataset. If `"last"` is specified, for each by group the +#' observations before or after (`selection` argument) the observation where +#' the condition (`condition` argument) is fulfilled the *last* time is +#' flagged in the output dataset. +#' +#' *Permitted Values:* `"first"`, `"last"` +#' +#' @param selection Flag observations before or after the reference observation? +#' +#' *Permitted Values:* `"before"`, `"after"` +#' +#' @param inclusive Flag the reference observation? +#' +#' *Permitted Values:* `TRUE`, `FALSE` +#' +#' @param flag_no_ref_groups Should by groups without reference observation be flagged? +#' +#' *Permitted Values:* `TRUE`, `FALSE` +#' +#' @param check_type Check uniqueness? +#' +#' If `"warning"` or `"error"` is specified, the specified message is issued +#' if the observations of the input dataset are not unique with respect to the +#' by variables and the order. +#' +#' *Permitted Values:* `"none"`, `"warning"`, `"error"` +#' +#' @author Stefan Bundfuss +#' +#' @details For each by group (`by_vars` argument) the observations before or +#' after (`selection` argument) the observations where the condition +#' (`condition` argument) is fulfilled the first or last time (`order` +#' argument and `mode` argument) is flagged in the output dataset. +#' +#' @return The input dataset with the new variable (`new_var`) added +#' +#' @keywords der_gen +#' @family der_gen +#' +#' @export +#' +#' @examples +#' library(tibble) +#' library(dplyr, warn.conflicts = FALSE) +#' +#' # Flag all AEs after the first COVID AE +#' adae <- tribble( +#' ~USUBJID, ~ASTDY, ~ACOVFL, ~AESEQ, +#' "1", 2, NA, 1, +#' "1", 5, "Y", 2, +#' "1", 5, NA, 3, +#' "1", 17, NA, 4, +#' "1", 27, "Y", 5, +#' "1", 32, NA, 6, +#' "2", 8, NA, 1, +#' "2", 11, NA, 2, +#' ) +#' +#' derive_var_relative_flag( +#' adae, +#' by_vars = vars(USUBJID), +#' order = vars(ASTDY, AESEQ), +#' new_var = PSTCOVFL, +#' condition = ACOVFL == "Y", +#' mode = "first", +#' selection = "after", +#' inclusive = FALSE, +#' flag_no_ref_groups = FALSE +#' ) +#' +#' response <- tribble( +#' ~USUBJID, ~AVISITN, ~AVALC, +#' "1", 0, "PR", +#' "1", 1, "CR", +#' "1", 2, "CR", +#' "1", 3, "SD", +#' "1", 4, "NE", +#' "2", 0, "SD", +#' "2", 1, "PD", +#' "2", 2, "PD", +#' "3", 0, "SD", +#' "4", 0, "SD", +#' "4", 1, "PR", +#' "4", 2, "PD", +#' "4", 3, "SD", +#' "4", 4, "PR" +#' ) +#' +#' # Flag observations up to first PD for each patient +#' response %>% +#' derive_var_relative_flag( +#' by_vars = vars(USUBJID), +#' order = vars(AVISITN), +#' new_var = ANL02FL, +#' condition = AVALC == "PD", +#' mode = "first", +#' selection = "before", +#' inclusive = TRUE +#' ) +#' +#' # Flag observations up to first PD excluding baseline (AVISITN = 0) for each patient +#' response %>% +#' restrict_derivation( +#' derivation = derive_var_relative_flag, +#' args = params( +#' by_vars = vars(USUBJID), +#' order = vars(AVISITN), +#' new_var = ANL02FL, +#' condition = AVALC == "PD", +#' mode = "first", +#' selection = "before", +#' inclusive = TRUE +#' ), +#' filter = AVISITN > 0 +#' ) %>% +#' arrange(USUBJID, AVISITN) +derive_var_relative_flag <- function(dataset, + by_vars, + order, + new_var, + condition, + mode, + selection, + inclusive, + flag_no_ref_groups = TRUE, + check_type = "warning") { + new_var <- assert_symbol(enquo(new_var)) + condition <- assert_filter_cond(enquo(condition)) + assert_logical_scalar(flag_no_ref_groups) + + # add obs number for merging + tmp_obs_nr <- get_new_tmp_var(dataset, prefix = "tmp_obs_nr") + data <- derive_var_obs_number( + dataset, + by_vars = by_vars, + order = order, + new_var = !!tmp_obs_nr, + check_type = check_type + ) + + # select observations before/after the condition + # set check_type to "none" as uniqueness was already checked by derive_var_obs_number() + flag_obs <- filter_relative( + data, + by_vars = by_vars, + order = order, + condition = !!condition, + mode = mode, + selection = selection, + inclusive = inclusive, + keep_no_ref_groups = flag_no_ref_groups, + check_type = "none" + ) + + # flag observations based on the selected observations + derive_var_merged_exist_flag( + data, + dataset_add = flag_obs, + by_vars = quo_c(by_vars, quo(!!tmp_obs_nr)), + new_var = !!new_var, + condition = TRUE + ) %>% + remove_tmp_vars() +} diff --git a/R/derive_var_shift.R b/R/derive_var_shift.R index 7fc4a1148e..ebe59b56eb 100644 --- a/R/derive_var_shift.R +++ b/R/derive_var_shift.R @@ -36,9 +36,9 @@ #' @export #' #' @examples -#' library(dplyr, warn.conflicts = FALSE) +#' library(tibble) #' -#' data <- tibble::tribble( +#' data <- tribble( #' ~USUBJID, ~PARAMCD, ~AVAL, ~ABLFL, ~BNRIND, ~ANRIND, #' "P01", "ALB", 33, "Y", "LOW", "LOW", #' "P01", "ALB", 38, NA, "LOW", "NORMAL", diff --git a/R/derive_var_trtdurd.R b/R/derive_var_trtdurd.R index b1a7b0f295..f964e92613 100644 --- a/R/derive_var_trtdurd.R +++ b/R/derive_var_trtdurd.R @@ -41,9 +41,12 @@ #' @seealso [derive_vars_duration()] #' #' @examples -#' data <- tibble::tribble( +#' library(tibble) +#' library(lubridate) +#' +#' data <- tribble( #' ~TRTSDT, ~TRTEDT, -#' lubridate::ymd("2020-01-01"), lubridate::ymd("2020-02-24") +#' ymd("2020-01-01"), ymd("2020-02-24") #' ) #' #' derive_var_trtdurd(data) diff --git a/R/derive_var_trtemfl.R b/R/derive_var_trtemfl.R new file mode 100644 index 0000000000..17c88d087e --- /dev/null +++ b/R/derive_var_trtemfl.R @@ -0,0 +1,242 @@ +#' Derive Treatment-emergent Flag +#' +#' Derive treatment emergent analysis flag (e.g., `TRTEMFL`). +#' +#' @param dataset Input dataset +#' +#' The variables specified by `start_date`, `end_date`, `trt_start_date`, +#' `trt_end_date`, `initial_intensity`, and `intensity` are expected. +#' +#' @param new_var New variable +#' +#' @param start_date Event start date +#' +#' *Permitted Values:* A symbol referring to a date or datetime variable of +#' the input dataset +#' +#' @param end_date Event end date +#' +#' *Permitted Values:* A symbol referring to a date or datetime variable of +#' the input dataset +#' +#' @param trt_start_date Treatment start date +#' +#' *Permitted Values:* A symbol referring to a date or datetime variable of +#' the input dataset +#' +#' @param trt_end_date Treatment end date +#' +#' *Permitted Values:* A symbol referring to a date or datetime variable of +#' the input dataset or `NULL` +#' +#' @param end_window +#' +#' If the argument is specified, events starting more than the specified +#' number of days after end of treatment, are not flagged. +#' +#' *Permitted Values:* A non-negative integer or `NULL` +#' +#' @param ignore_time_for_trt_end +#' +#' If the argument is set to `TRUE`, the time part is ignored for checking if +#' the event occurred more than `end_window` days after end of treatment. +#' +#' *Permitted Values:* `TRUE`, `FALSE` +#' +#' @param initial_intensity Initial severity/intensity or toxicity +#' +#' This derivation assumes AE data collection method as single record per AE +#' with “initial” and “most extreme” severity/intensity recorded separately. +#' +#' If the argument is specified, events which start before treatment start and +#' end after treatment start (or are ongoing) and worsened (i.e., the +#' intensity is greater than the initial intensity), are flagged. +#' +#' The values of the specified variable must be comparable with the usual +#' comparison operators. I.e., if the intensity is greater than the initial +#' intensity `initial_intensity < intensity` must evaluate to `TRUE`. +#' +#' *Permitted Values:* A symbol referring to a variable of the input dataset +#' or `NULL` +#' +#' @param intensity Severity/intensity or toxicity +#' +#' If the argument is specified, events which start before treatment start and +#' end after treatment start (or are ongoing) and worsened (i.e., the +#' intensity is greater than the initial intensity), are flagged. +#' +#' The values of the specified variable must be comparable with the usual +#' comparison operators. I.e., if the intensity is greater than the initial +#' intensity `initial_intensity < intensity` must evaluate to `TRUE`. +#' +#' *Permitted Values:* A symbol referring to a variable of the input dataset +#' or `NULL` +#' +#' @author Stefan Bundfuss +#' +#' @details For the derivation of the new variable the following cases are +#' considered in this order. The first case which applies, defines the value +#' of the variable. +#' +#' - *not treated*: If `trt_start_date` is `NA`, it is set to `NA_character_`. +#' - *event before treatment*: If `end_date` is before `trt_start_date` (and +#' `end_date` is not `NA`), it is set to `NA_character_`. +#' - *no event date*: If `start_date` is `NA`, it is set to `"Y"` as in such +#' cases it is usually considered more conservative to assume the event was +#' treatment-emergent. +#' - *event started during treatment*: +#' - if `end_window` is not specified: +#' if `start_date` is on or after `trt_start_date`, it is set to `"Y"`, +#' - if `end_window` is specified: +#' if `start_date` is on or after `trt_start_date` and `start_date` is on +#' or before `trt_end_date` + `end_window` days, it is set to `"Y"`, +#' - *event started before treatment and (possibly) worsened on treatment*: +#' - if `initial_intensity` and `intensity` is specified: if +#' `initial_intensity < intensity` and `start_date` is before +#' `trt_start_date` and `end_date` is on or after `trt_start_date` or +#' `end_date` is `NA`, it is set to `"Y"`. +#' - Otherwise it is set to `NA_character_`. +#' +#' @return The input dataset with the variable specified by `new_var` added +#' +#' @keywords der_occds +#' @family der_occds +#' +#' @export +#' +#' @examples +#' +#' library(tibble) +#' library(dplyr, warn.conflicts = FALSE) +#' library(lubridate) +#' +#' adae <- expected <- tribble( +#' ~USUBJID, ~ASTDTM, ~AENDTM, ~AEITOXGR, ~AETOXGR, +#' # before treatment +#' "1", "2021-12-13T20:15", "2021-12-15T12:45", "1", "1", +#' "1", "2021-12-14T20:15", "2021-12-14T22:00", "1", "3", +#' # starting before treatment and ending during treatment +#' "1", "2021-12-30T20:00", "2022-01-14T11:00", "1", "3", +#' "1", "2021-12-31T20:15", "2022-01-01T01:23", "1", "1", +#' # starting during treatment +#' "1", "2022-01-01T12:00", "2022-01-02T23:25", "3", "4", +#' # after treatment +#' "1", "2022-05-10T11:00", "2022-05-10T13:05", "2", "2", +#' "1", "2022-05-11T11:00", "2022-05-11T13:05", "2", "2", +#' # missing dates +#' "1", "", "", "3", "4", +#' "1", "2021-12-30T09:00", "", "3", "4", +#' "1", "2021-12-30T11:00", "", "3", "3", +#' "1", "", "2022-01-04T09:00", "3", "4", +#' "1", "", "2021-12-24T19:00", "3", "4", +#' "1", "", "2022-06-04T09:00", "3", "4", +#' # without treatment +#' "2", "", "2021-12-03T12:00", "1", "2", +#' "2", "2021-12-01T12:00", "2021-12-03T12:00", "1", "2", +#' "2", "2021-12-06T18:00", "", "1", "2" +#' ) %>% +#' mutate( +#' ASTDTM = ymd_hm(ASTDTM), +#' AENDTM = ymd_hm(AENDTM), +#' TRTSDTM = if_else(USUBJID == "1", ymd_hm("2022-01-01T01:01"), ymd_hms("")), +#' TRTEDTM = if_else(USUBJID == "1", ymd_hm("2022-04-30T23:59"), ymd_hms("")) +#' ) +#' +#' # derive TRTEMFL without considering treatment end and worsening +#' derive_var_trtemfl(adae) %>% select(ASTDTM, AENDTM, TRTSDTM, TRTEMFL) +#' +#' # derive TRTEM2FL taking treatment end and worsening into account +#' derive_var_trtemfl( +#' adae, +#' new_var = TRTEM2FL, +#' trt_end_date = TRTEDTM, +#' end_window = 10, +#' initial_intensity = AEITOXGR, +#' intensity = AETOXGR +#' ) %>% select(ASTDTM, AENDTM, AEITOXGR, AETOXGR, TRTEM2FL) +derive_var_trtemfl <- function(dataset, + new_var = TRTEMFL, + start_date = ASTDTM, + end_date = AENDTM, + trt_start_date = TRTSDTM, + trt_end_date = NULL, + end_window = NULL, + ignore_time_for_trt_end = TRUE, + initial_intensity = NULL, + intensity = NULL) { + new_var <- assert_symbol(enquo(new_var)) + start_date <- assert_symbol(enquo(start_date)) + end_date <- assert_symbol(enquo(end_date)) + trt_start_date <- assert_symbol(enquo(trt_start_date)) + trt_end_date <- assert_symbol(enquo(trt_end_date), optional = TRUE) + assert_integer_scalar(end_window, subset = "non-negative", optional = TRUE) + assert_logical_scalar(ignore_time_for_trt_end) + initial_intensity <- assert_symbol(enquo(initial_intensity), optional = TRUE) + intensity <- assert_symbol(enquo(intensity), optional = TRUE) + if (quo_is_null(initial_intensity) && !quo_is_null(intensity)) { + abort(paste( + "`intensity` argument was specified but not `initial_intensity`", + "Either both or none of them must be specified.", + sep = "\n" + )) + } + if (!quo_is_null(initial_intensity) && quo_is_null(intensity)) { + abort(paste( + "`initial_intensity` argument was specified but not `intensity`", + "Either both or none of them must be specified.", + sep = "\n" + )) + } + assert_data_frame( + dataset, + required_vars = quo_c( + start_date, + end_date, + trt_start_date, + trt_end_date, + initial_intensity, + intensity + ) + ) + assert_date_var(dataset, var = !!start_date) + assert_date_var(dataset, var = !!end_date) + assert_date_var(dataset, var = !!trt_start_date) + if (!quo_is_null(trt_end_date)) { + assert_date_var(dataset, var = !!trt_end_date) + } + + if (is.null(end_window)) { + end_cond <- expr(TRUE) + } else { + if (quo_is_null(trt_end_date)) { + abort(paste( + "`end_window` argument was specified but not `trt_end_date`", + "Either both or none of them must be specified.", + sep = "\n" + )) + } + if (ignore_time_for_trt_end) { + end_cond <- expr(is.na(!!trt_end_date) | + date(!!start_date) <= date(!!trt_end_date) + days(end_window)) + } else { + end_cond <- expr(is.na(!!trt_end_date) | !!start_date <= !!trt_end_date + days(end_window)) + } + } + + if (quo_is_null(intensity)) { + worsening_cond <- expr(FALSE) + } else { + worsening_cond <- + expr(!!start_date < !!trt_start_date & + (!!initial_intensity < !!intensity | is.na(!!initial_intensity) | is.na(!!intensity))) + } + + dataset %>% + mutate(!!new_var := case_when( + is.na(!!trt_start_date) ~ NA_character_, + !!end_date < !!trt_start_date ~ NA_character_, + is.na(!!start_date) ~ "Y", + !!start_date >= !!trt_start_date & !!end_cond ~ "Y", + !!worsening_cond ~ "Y" + )) +} diff --git a/R/derive_vars_aage.R b/R/derive_vars_aage.R index 069d637c96..377b84042e 100644 --- a/R/derive_vars_aage.R +++ b/R/derive_vars_aage.R @@ -51,9 +51,12 @@ #' @seealso [derive_vars_duration()] #' #' @examples -#' data <- tibble::tribble( +#' library(tibble) +#' library(lubridate) +#' +#' data <- tribble( #' ~BRTHDT, ~RANDDT, -#' lubridate::ymd("1984-09-06"), lubridate::ymd("2020-02-24") +#' ymd("1984-09-06"), ymd("2020-02-24") #' ) #' #' derive_vars_aage(data) @@ -81,6 +84,7 @@ derive_vars_aage <- function(dataset, ) } + #' Derive Age in Years #' #' @details This function is used to convert age variables into years. @@ -110,8 +114,6 @@ derive_vars_aage <- function(dataset, #' #' @examples #' -#' library(dplyr, warn.conflicts = FALSE) -#' #' data <- data.frame( #' AGE = c(27, 24, 3, 4, 1), #' AGEU = c("days", "months", "years", "weeks", "years") @@ -132,6 +134,16 @@ derive_var_age_years <- function(dataset, age_var, age_unit = NULL, new_var) { age_var <- age_variable unit_var <- paste0(quo_get_expr(age_var), "U") + age_unit <- assert_character_scalar( + age_unit, + values = c( + "years", "months", "weeks", "days", + "hours", "minutes", "seconds" + ), + case_sensitive = FALSE, + optional = TRUE + ) + new_var <- assert_symbol(enquo(new_var)) warn_if_vars_exist(dataset, quo_text(new_var)) @@ -143,22 +155,15 @@ derive_var_age_years <- function(dataset, age_var, age_unit = NULL, new_var) { ) abort(err_msg) } else { - assert_character_scalar( - tolower(age_unit), - values = c( - "years", "months", "weeks", "days", - "hours", "minutes", "seconds" - ) - ) ds <- dataset %>% mutate( - !!new_var := time_length(duration(!!age_var, units = tolower(age_unit)), + !!new_var := time_length(duration(!!age_var, units = age_unit), unit = "years" ) ) } } else { - unit <- tolower(unique(pull(dataset, !!sym(unit_var)))) + unit <- unique(tolower(pull(dataset, !!sym(unit_var)))) assert_character_vector( unit, values = c( @@ -177,7 +182,7 @@ derive_var_age_years <- function(dataset, age_var, age_unit = NULL, new_var) { unit_var ) warn(msg) - } else if (unit != tolower(age_unit)) { + } else if (unit != age_unit) { msg <- paste( "The variable unit", unit_var, "is associated with", quo_get_expr(age_var), "but the argument `age_unit` has been specified with a different value.", @@ -232,7 +237,7 @@ NULL #' #' @export derive_var_agegr_fda <- function(dataset, age_var, age_unit = NULL, new_var) { - deprecate_warn("0.8.0", "derive_var_agegr_ema()") + deprecate_warn("0.8.0", "derive_var_agegr_fda()", details = "Please create a user defined function instead.") age_var <- assert_symbol(enquo(age_var)) new_var <- assert_symbol(enquo(new_var)) @@ -264,7 +269,7 @@ derive_var_agegr_fda <- function(dataset, age_var, age_unit = NULL, new_var) { #' #' @export derive_var_agegr_ema <- function(dataset, age_var, age_unit = NULL, new_var) { - deprecate_warn("0.8.0", "derive_var_agegr_ema()") + deprecate_warn("0.8.0", "derive_var_agegr_ema()", details = "Please create a user defined function instead.") age_var <- assert_symbol(enquo(age_var)) new_var <- assert_symbol(enquo(new_var)) diff --git a/R/derive_vars_disposition_reason.R b/R/derive_vars_disposition_reason.R index fefe405922..0d3f661cfb 100644 --- a/R/derive_vars_disposition_reason.R +++ b/R/derive_vars_disposition_reason.R @@ -182,7 +182,7 @@ derive_vars_disposition_reason <- function(dataset, reason_var_spe = NULL, format_new_vars = format_reason_default, filter_ds, - subject_keys = vars(STUDYID, USUBJID)) { + subject_keys = get_admiral_option("subject_keys")) { new_var <- assert_symbol(enquo(new_var)) reason_var <- assert_symbol(enquo(reason_var)) new_var_spe <- assert_symbol(enquo(new_var_spe), optional = T) diff --git a/R/derive_vars_dtm_to_dt.R b/R/derive_vars_dtm_to_dt.R index 2cfe50d8eb..3ecd305080 100644 --- a/R/derive_vars_dtm_to_dt.R +++ b/R/derive_vars_dtm_to_dt.R @@ -20,10 +20,11 @@ #' @export #' #' @examples +#' library(tibble) #' library(dplyr, warn.conflicts = FALSE) #' library(lubridate) #' -#' adcm <- tibble::tribble( +#' adcm <- tribble( #' ~USUBJID, ~TRTSDTM, ~ASTDTM, ~AENDTM, #' "PAT01", "2012-02-25 23:00:00", "2012-02-28 19:00:00", "2012-02-25 23:00:00", #' "PAT01", NA, "2012-02-28 19:00:00", NA, diff --git a/R/derive_vars_dtm_to_tm.R b/R/derive_vars_dtm_to_tm.R index 7140867205..3b819599ae 100644 --- a/R/derive_vars_dtm_to_tm.R +++ b/R/derive_vars_dtm_to_tm.R @@ -26,10 +26,11 @@ #' @export #' #' @examples +#' library(tibble) #' library(dplyr, warn.conflicts = FALSE) #' library(lubridate) #' -#' adcm <- tibble::tribble( +#' adcm <- tribble( #' ~USUBJID, ~TRTSDTM, ~ASTDTM, ~AENDTM, #' "PAT01", "2012-02-25 23:41:10", "2012-02-28 19:03:00", "2013-02-25 23:32:16", #' "PAT01", "", "2012-02-28 19:00:00", "", diff --git a/R/derive_vars_dy.R b/R/derive_vars_dy.R index fad44ed02f..9eb64ef860 100644 --- a/R/derive_vars_dy.R +++ b/R/derive_vars_dy.R @@ -40,10 +40,11 @@ #' @export #' #' @examples +#' library(tibble) #' library(lubridate) -#' library(dplyr) +#' library(dplyr, warn.conflicts = FALSE) #' -#' datain <- tibble::tribble( +#' datain <- tribble( #' ~TRTSDTM, ~ASTDTM, ~AENDT, #' "2014-01-17T23:59:59", "2014-01-18T13:09:O9", "2014-01-20" #' ) %>% @@ -60,7 +61,7 @@ #' ) #' #' # specifying name of new variables -#' datain <- tibble::tribble( +#' datain <- tribble( #' ~TRTSDT, ~DTHDT, #' "2014-01-17", "2014-02-01" #' ) %>% @@ -114,7 +115,7 @@ derive_vars_dy <- function(dataset, mutate_at( .vars = source_vars, .funs = list(temp = ~ - compute_duration(start_date = eval(reference_date), end_date = .)) + compute_duration(start_date = eval(reference_date), end_date = .)) ) %>% rename_at( vars(ends_with("temp")), diff --git a/R/derive_vars_last_dose.R b/R/derive_vars_last_dose.R index 49b9d2b9d0..6b3caa9ade 100644 --- a/R/derive_vars_last_dose.R +++ b/R/derive_vars_last_dose.R @@ -125,7 +125,7 @@ #' new_vars = vars(EXDOSE, EXTRT, EXSEQ, EXENDTC, VISIT), #' dose_date = EXENDTM, #' analysis_date = ASTDTM, -#' traceability_vars = dplyr::vars(LDOSEDOM = "EX", LDOSESEQ = EXSEQ, LDOSEVAR = "EXENDTC") +#' traceability_vars = vars(LDOSEDOM = "EX", LDOSESEQ = EXSEQ, LDOSEVAR = "EXENDTC") #' ) %>% #' select(STUDYID, USUBJID, AESEQ, AESTDTC, EXDOSE, EXTRT, EXENDTC, LDOSEDOM, LDOSESEQ, LDOSEVAR) derive_vars_last_dose <- function(dataset, diff --git a/R/derive_vars_query.R b/R/derive_vars_query.R index a86dc8836a..49b0e0e948 100644 --- a/R/derive_vars_query.R +++ b/R/derive_vars_query.R @@ -48,8 +48,9 @@ #' @export #' #' @examples +#' library(tibble) #' data("queries") -#' adae <- tibble::tribble( +#' adae <- tribble( #' ~USUBJID, ~ASTDTM, ~AETERM, ~AESEQ, ~AEDECOD, ~AELLT, ~AELLTCD, #' "01", "2020-06-02 23:59:59", "ALANINE AMINOTRANSFERASE ABNORMAL", #' 3, "Alanine aminotransferase abnormal", NA_character_, NA_integer_, @@ -222,7 +223,6 @@ derive_vars_query <- function(dataset, dataset_queries) { #' data("queries") #' assert_valid_queries(queries, "queries") assert_valid_queries <- function(queries, queries_name) { - # check required columns assert_has_variables( queries, diff --git a/R/derive_vars_transposed.R b/R/derive_vars_transposed.R index 61f1154058..c7cb3207e5 100644 --- a/R/derive_vars_transposed.R +++ b/R/derive_vars_transposed.R @@ -36,15 +36,16 @@ #' @export #' #' @examples +#' library(tibble) #' library(dplyr, warn.conflicts = FALSE) #' -#' cm <- tibble::tribble( +#' cm <- tribble( #' ~USUBJID, ~CMGRPID, ~CMREFID, ~CMDECOD, #' "BP40257-1001", "14", "1192056", "PARACETAMOL", #' "BP40257-1001", "18", "2007001", "SOLUMEDROL", #' "BP40257-1002", "19", "2791596", "SPIRONOLACTONE" #' ) -#' facm <- tibble::tribble( +#' facm <- tribble( #' ~USUBJID, ~FAGRPID, ~FAREFID, ~FATESTCD, ~FASTRESC, #' "BP40257-1001", "1", "1192056", "CMATC1CD", "N", #' "BP40257-1001", "1", "1192056", "CMATC2CD", "N02", @@ -128,13 +129,15 @@ derive_vars_transposed <- function(dataset, #' @export #' #' @examples -#' cm <- tibble::tribble( +#' library(tibble) +#' +#' cm <- tribble( #' ~USUBJID, ~CMGRPID, ~CMREFID, ~CMDECOD, #' "BP40257-1001", "14", "1192056", "PARACETAMOL", #' "BP40257-1001", "18", "2007001", "SOLUMEDROL", #' "BP40257-1002", "19", "2791596", "SPIRONOLACTONE" #' ) -#' facm <- tibble::tribble( +#' facm <- tribble( #' ~USUBJID, ~FAGRPID, ~FAREFID, ~FATESTCD, ~FASTRESC, #' "BP40257-1001", "1", "1192056", "CMATC1CD", "N", #' "BP40257-1001", "1", "1192056", "CMATC2CD", "N02", diff --git a/R/duplicates.R b/R/duplicates.R index 983ac0a1ca..97b806b8ed 100644 --- a/R/duplicates.R +++ b/R/duplicates.R @@ -1,6 +1,4 @@ -.datasets <- new.env(parent = emptyenv()) - -#' Get Duplicate Records that Lead to a Prior Error +#' Get Duplicate Records that Led to a Prior Error #' #' @export #' @@ -33,7 +31,7 @@ #' #' get_duplicates_dataset() get_duplicates_dataset <- function() { - .datasets$duplicates + admiral_environment$duplicates } #' Extract Duplicate Records @@ -110,7 +108,7 @@ signal_duplicate_records <- function(dataset, duplicate_records <- extract_duplicate_records(dataset, by_vars) if (nrow(duplicate_records) >= 1L) { - .datasets$duplicates <- structure( + admiral_environment$duplicates <- structure( duplicate_records, class = union("duplicates", class(duplicate_records)), by_vars = vars2chr(by_vars) diff --git a/R/filter_confirmation.R b/R/filter_confirmation.R index acf9fc2f4f..627492470b 100644 --- a/R/filter_confirmation.R +++ b/R/filter_confirmation.R @@ -385,9 +385,9 @@ filter_confirmation <- function(dataset, #' @examples #' #' library(tibble) -#' library(dplyr) +#' library(dplyr, warn.conflicts = FALSE) #' library(admiral) -#' data <- tibble::tribble( +#' data <- tribble( #' ~USUBJID, ~AVISITN, ~AVALC, #' "1", 1, "PR", #' "1", 2, "CR", @@ -431,7 +431,7 @@ count_vals <- function(var, val) { #' @examples #' #' library(tibble) -#' library(dplyr) +#' library(dplyr, warn.conflicts = FALSE) #' library(admiral) #' data <- tribble( #' ~USUBJID, ~AVISITN, ~AVALC, @@ -481,7 +481,7 @@ min_cond <- function(var, cond) { #' @examples #' #' library(tibble) -#' library(dplyr) +#' library(dplyr, warn.conflicts = FALSE) #' library(admiral) #' data <- tribble( #' ~USUBJID, ~AVISITN, ~AVALC, diff --git a/R/filter_extreme.R b/R/filter_extreme.R index d54ad3c5c4..2832505dfb 100644 --- a/R/filter_extreme.R +++ b/R/filter_extreme.R @@ -54,7 +54,7 @@ #' @export #' #' @examples -#' library(dplyr, warn.conflict = FALSE) +#' library(dplyr, warn.conflicts = FALSE) #' library(admiral.test) #' data("admiral_ex") #' diff --git a/R/filter_relative.R b/R/filter_relative.R index f2ddbde512..d5291b9a18 100644 --- a/R/filter_relative.R +++ b/R/filter_relative.R @@ -49,8 +49,6 @@ #' #' @param keep_no_ref_groups Should by groups without reference observation be kept? #' -#' *Default:* `TRUE` -#' #' *Permitted Values:* `TRUE`, `FALSE` #' #' @param check_type Check uniqueness? @@ -59,13 +57,11 @@ #' if the observations of the input dataset are not unique with respect to the #' by variables and the order. #' -#' *Default:* `"none"` -#' #' *Permitted Values:* `"none"`, `"warning"`, `"error"` #' #' @details For each by group ( `by_vars` parameter) the observations before or #' after (`selection` parameter) the observations where the condition -#' (`condition` parameter) if fulfilled the first or last time (`order` +#' (`condition` parameter) is fulfilled the first or last time (`order` #' parameter and `mode` parameter) is included in the output dataset. #' #' @author Stefan Bundfuss @@ -81,9 +77,9 @@ #' @export #' #' @examples -#' library(dplyr, warn.conflict = FALSE) +#' library(tibble) #' -#' response <- tibble::tribble( +#' response <- tribble( #' ~USUBJID, ~AVISITN, ~AVALC, #' "1", 1, "PR", #' "1", 2, "CR", diff --git a/R/get_summary_records.R b/R/get_summary_records.R index 7453843cc8..ce06ebcfe3 100644 --- a/R/get_summary_records.R +++ b/R/get_summary_records.R @@ -59,8 +59,10 @@ #' @export #' #' @examples +#' library(tibble) #' library(dplyr, warn.conflicts = FALSE) -#' adeg <- tibble::tribble( +#' +#' adeg <- tribble( #' ~USUBJID, ~EGSEQ, ~PARAM, ~AVISIT, ~EGDTC, ~AVAL, ~TRTA, #' "XYZ-1001", 1, "QTcF Int. (msec)", "Baseline", "2016-02-24T07:50", 385, "", #' "XYZ-1001", 2, "QTcF Int. (msec)", "Baseline", "2016-02-24T07:52", 399, "", @@ -91,7 +93,7 @@ #' set_values_to = vars(DTYPE = "AVERAGE") #' ) #' -#' advs <- tibble::tribble( +#' advs <- tribble( #' ~USUBJID, ~VSSEQ, ~PARAM, ~AVAL, ~VSSTRESU, ~VISIT, ~VSDTC, #' "XYZ-001-001", 1164, "Weight", 99, "kg", "Screening", "2018-03-19", #' "XYZ-001-001", 1165, "Weight", 101, "kg", "Run-In", "2018-03-26", @@ -118,7 +120,7 @@ #' ) #' #' # Sample ADEG dataset with triplicate record for only AVISIT = 'Baseline' -#' adeg <- tibble::tribble( +#' adeg <- tribble( #' ~USUBJID, ~EGSEQ, ~PARAM, ~AVISIT, ~EGDTC, ~AVAL, ~TRTA, #' "XYZ-1001", 1, "QTcF Int. (msec)", "Baseline", "2016-02-24T07:50", 385, "", #' "XYZ-1001", 2, "QTcF Int. (msec)", "Baseline", "2016-02-24T07:52", 399, "", @@ -141,7 +143,7 @@ #' get_summary_records( #' adeg, #' by_vars = vars(USUBJID, PARAM, AVISIT), -#' filter = dplyr::n() > 2, +#' filter = n() > 2, #' analysis_var = AVAL, #' summary_fun = function(x) mean(x, na.rm = TRUE), #' set_values_to = vars(DTYPE = "AVERAGE") @@ -151,7 +153,7 @@ get_summary_records <- function(dataset, filter = NULL, analysis_var, summary_fun, - set_values_to) { + set_values_to = NULL) { assert_vars(by_vars) analysis_var <- assert_symbol(enquo(analysis_var)) filter <- assert_filter_cond(enquo(filter), optional = TRUE) diff --git a/R/globals.R b/R/globals.R index bff3460b88..e78d647f62 100644 --- a/R/globals.R +++ b/R/globals.R @@ -9,7 +9,10 @@ globalVariables(c( "AENDY", "ANRHI", "ANRLO", + "APERIOD", + "APHASEN", "ASEQ", + "ASPER", "ASTDT", "ASTDTM", "ASTDY", @@ -40,6 +43,7 @@ globalVariables(c( "TRTDURD", "TRTEDT", "TRTEDTM", + "TRTEMFL", "TRTSDT", "TRTSDTM", "QLABEL", @@ -66,6 +70,7 @@ globalVariables(c( "temp_source_nr", "temp_slicenr", "temp_date", + "time_differential_dt", "tmp_obs_nr_filter_relative", "tmp_obs_nr_match_filter_relative", "VAR_PREFIX", @@ -130,5 +135,6 @@ globalVariables(c( "VAR_CHECK", "TERM", "TERM_UPPER", - "atoxgr_criteria_ctcv4" + "atoxgr_criteria_ctcv4", + "DTYPE" )) diff --git a/R/period_dataset.R b/R/period_dataset.R new file mode 100644 index 0000000000..7a701feb6e --- /dev/null +++ b/R/period_dataset.R @@ -0,0 +1,449 @@ +#' Create a Reference Dataset for Subperiods, Periods, or Phases +#' +#' The function creates a reference dataset for subperiods, periods, or phases +#' from the `ADSL` dataset. The reference dataset can be used to derive +#' subperiod, period, or phase variables like `ASPER`, `ASPRSDT`, `ASPREDT`, +#' `APERIOD`, `APERSDT`, `APEREDT`, `TRTA`, `APHASEN`, `PHSDTM`, `PHEDTM`, ... +#' in OCCDS and BDS datasets. +#' +#' @param dataset ADSL dataset +#' +#' The variables specified by `new_vars` and `subject_keys` are expected. For +#' each element of `new_vars` at least one variable of the form of the right +#' hand side value must be available in the dataset. +#' +#' @param new_vars New variables +#' +#' A named list of variables like `vars(PHSDT = PHwSDT, PHEDT = PHwEDT, APHASE +#' = APHASEw)` is expected. The left hand side of the elements defines a +#' variable of the output dataset, the right hand side defines the source +#' variables from the ADSL dataset in CDISC notation. +#' +#' If the lower case letter "w" is used it refers to a phase variable, if the +#' lower case letters "xx" are used it refers to a period variable, and if +#' both "xx" and "w" are used it refers to a subperiod variable. +#' +#' Only one type must be used, e.g., all right hand side values must refer to +#' period variables. It is not allowed to mix for example period and subperiod +#' variables. If period *and* subperiod variables are required, separate +#' reference datasets must be created. +#' +#' @param subject_keys Variables to uniquely identify a subject +#' +#' A list of quosures where the expressions are symbols as returned by +#' `vars()` is expected. +#' +#' @author Stefan Bundfuss +#' +#' @details For each subject and each subperiod/period/phase where at least one +#' of the source variable is not `NA` an observation is added to the output +#' dataset. +#' +#' Depending on the type of the source variable (subperiod, period, or phase) +#' the variable `ASPER`, `APERIOD`, or `APHASEN` is added and set to the +#' number of the subperiod, period, or phase. +#' +#' The variables specified for `new_vars` (left hand side) are added to the +#' output dataset and set to the value of the source variable (right hand +#' side). +#' +#' @return A period reference dataset (see "Details" section) +#' +#' @seealso [derive_vars_period()] +#' +#' @keywords create_aux +#' @family create_aux +#' +#' @export +#' +#' @examples +#' library(tibble) +#' library(dplyr, warn.conflicts = FALSE) +#' library(lubridate) +#' +#' # Create reference dataset for periods +#' adsl <- tribble( +#' ~USUBJID, ~AP01SDT, ~AP01EDT, ~AP02SDT, ~AP02EDT, ~TRT01A, ~TRT02A, +#' "1", "2021-01-04", "2021-02-06", "2021-02-07", "2021-03-07", "A", "B", +#' "2", "2021-02-02", "2021-03-02", "2021-03-03", "2021-04-01", "B", "A", +#' ) %>% +#' mutate( +#' across(matches("AP\\d\\d[ES]DT"), ymd) +#' ) %>% +#' mutate( +#' STUDYID = "xyz" +#' ) +#' +#' create_period_dataset( +#' adsl, +#' new_vars = vars(APERSDT = APxxSDT, APEREDT = APxxEDT, TRTA = TRTxxA) +#' ) +#' +#' # Create reference dataset for phases +#' adsl <- tribble( +#' ~USUBJID, ~PH1SDT, ~PH1EDT, ~PH2SDT, ~PH2EDT, ~APHASE1, ~APHASE2, +#' "1", "2021-01-04", "2021-02-06", "2021-02-07", "2021-03-07", "TREATMENT", "FUP", +#' "2", "2021-02-02", "2021-03-02", NA, NA, "TREATMENT", NA +#' ) %>% +#' mutate( +#' across(matches("PH\\d[ES]DT"), ymd) +#' ) %>% +#' mutate( +#' STUDYID = "xyz" +#' ) +#' +#' create_period_dataset( +#' adsl, +#' new_vars = vars(PHSDT = PHwSDT, PHEDT = PHwEDT, APHASE = APHASEw) +#' ) +#' +#' # Create reference datasets for subperiods +#' adsl <- tribble( +#' ~USUBJID, ~P01S1SDT, ~P01S1EDT, ~P01S2SDT, ~P01S2EDT, ~P02S1SDT, ~P02S1EDT, +#' "1", "2021-01-04", "2021-01-19", "2021-01-20", "2021-02-06", "2021-02-07", "2021-03-07", +#' "2", "2021-02-02", "2021-03-02", NA, NA, "2021-03-03", "2021-04-01" +#' ) %>% +#' mutate( +#' across(matches("P\\d\\dS\\d[ES]DT"), ymd) +#' ) %>% +#' mutate( +#' STUDYID = "xyz" +#' ) +#' +#' create_period_dataset( +#' adsl, +#' new_vars = vars(ASPRSDT = PxxSwSDT, ASPREDT = PxxSwEDT) +#' ) +create_period_dataset <- function(dataset, + new_vars, + subject_keys = get_admiral_option("subject_keys")) { + assert_vars(new_vars, expect_names = TRUE) + assert_vars(subject_keys) + assert_data_frame(dataset, required_vars = subject_keys) + + new_vars_names <- names(new_vars) + new_vars_chr <- vars2chr(new_vars) + cols <- str_replace(new_vars_chr, "xx", "\\\\d\\\\d") %>% + str_replace("w", "\\\\d") + names_pattern <- str_replace(new_vars_chr, "xx", "\\\\d\\\\d") %>% + str_replace("w", "\\\\d") %>% + str_replace("(\\w+)\\\\d", "(\\1)\\\\d") %>% + str_replace_all("((\\\\d)+)", "(\\1)") + mode <- case_when( + str_detect(new_vars_chr, "\\w+xx\\w+w\\w*") ~ "subperiod", + str_detect(new_vars_chr, "\\w+xx\\w*") ~ "period", + str_detect(new_vars_chr, "\\w+w\\w*") ~ "phase", + TRUE ~ "none" + ) %>% unique() + if (any(mode == "none")) { + abort( + paste( + paste0( + "The right hand side values of `new_vars` have to be CDISC style ", + "subperiod, period, or phase variables." + ), + "I.e., they must contain the xx or w fragment, e.g., APxxSDT, PxxSwSDT, or PHwSDT.", + sep = "\n" + ) + ) + } + if (length(mode) > 1) { + abort( + paste0( + "More than one type of subperiod, period, or phase variables ", + "is specified for `new_vars`:\n", + if_else( + "subperiod" %in% mode, + paste0("subperiod: ", enumerate(new_vars_chr[mode == "subperiod"]), "\n"), + "" + ), + if_else( + "period" %in% mode, + paste0("period: ", enumerate(new_vars_chr[mode == "period"]), "\n"), + "" + ), + if_else( + "phase" %in% mode, + paste0("phase: ", enumerate(new_vars_chr[mode == "phase"]), "\n"), + "" + ) + ) + ) + } + prefix <- syms(str_match(cols, "(\\w+)\\\\")[, 2]) + num_var_chr <- c( + subperiod = "ASPER", + period = "APERIOD", + phase = "APHASEN" + ) + num_var <- syms(num_var_chr) + period_ref <- vector("list", length(new_vars)) + for (i in seq_along(new_vars)) { + if (!any(str_detect(colnames(dataset), names_pattern[[i]]))) { + abort(paste( + "No variables of the form", + new_vars_chr[[i]], + "were found in the input dataset." + )) + } + if (mode == "subperiod") { + period_ref[[i]] <- pivot_longer( + select(dataset, !!!subject_keys, matches(cols[[i]])), + matches(cols[[i]]), + names_to = c(".value", "APERIOD", num_var_chr[[mode]]), + names_pattern = names_pattern[[i]] + ) %>% + rename(!!sym(new_vars_names[[i]]) := !!prefix[[i]]) %>% + mutate( + APERIOD = as.integer(APERIOD), + !!num_var[[mode]] := as.integer(!!num_var[[mode]]) + ) %>% + filter(!is.na(!!sym(new_vars_names[[i]]))) + by_vars <- vars(APERIOD, !!sym(num_var[[mode]])) + } else { + period_ref[[i]] <- pivot_longer( + select(dataset, !!!subject_keys, matches(cols[[i]])), + matches(cols[[i]]), + names_to = c(".value", num_var_chr[[mode]]), + names_pattern = names_pattern[[i]] + ) %>% + rename(!!sym(new_vars_names[[i]]) := !!prefix[[i]]) %>% + mutate(!!num_var[[mode]] := as.integer(!!num_var[[mode]])) %>% + filter(!is.na(!!sym(new_vars_names[[i]]))) + by_vars <- vars(!!sym(num_var[[mode]])) + } + if (i == 1) { + period_ref_final <- period_ref[[1]] + } else { + period_ref_final <- derive_vars_merged( + period_ref_final, + dataset_add = period_ref[[i]], + by_vars = quo_c(subject_keys, by_vars) + ) + } + } + period_ref_final +} + +#' Add Subperiod, Period, or Phase Variables to ADSL +#' +#' The function adds subperiod, period, or phase variables like `P01S1SDT`, +#' `P01S2SDT`, `AP01SDTM`, `AP02SDTM`, `TRT01A`, `TRT02A`, `PH1SDT`, `PH2SDT`, +#' ... to the input dataset. The values of the variables are defined by a period +#' reference dataset which has one observations per patient and subperiod, +#' period, or phase. +#' +#' @param dataset ADSL dataset +#' +#' The variables specified by `subject_keys` are expected. +#' +#' @param dataset_ref Period reference dataset +#' +#' The variables specified by `new_vars` and `subject_keys` are expected. +#' +#' If subperiod variables are requested, `APERIOD` and `ASPER` are expected. +#' If period variables are requested. `APERIOD` is expected. If phase +#' variables are requested, `APHASEN` is expected. +#' +#' @param new_vars New variables +#' +#' A named list of variables like `vars(PHwSDT = PHSDT, PHwEDT = PHEDT, +#' APHASEw = APHASE)` is expected. The left hand side of the elements defines +#' a set of variables (in CDISC notation) to be added to the output dataset. +#' The right hand side defines the source variable from the period reference +#' dataset. +#' +#' If the lower case letter "w" is used it refers to a phase variable, if the +#' lower case letters "xx" are used it refers to a period variable, and if +#' both "xx" and "w" are used it refers to a subperiod variable. +#' +#' Only one type must be used, e.g., all left hand side values must refer to +#' period variables. It is not allowed to mix for example period and subperiod +#' variables. If period *and* subperiod variables are required, separate calls +#' must be used. +#' +#' @param subject_keys Variables to uniquely identify a subject +#' +#' A list of quosures where the expressions are symbols as returned by +#' `vars()` is expected. +#' +#' @author Stefan Bundfuss +#' +#' @details For each subperiod/period/phase in the period reference dataset and +#' each element in `new_vars` a variable (LHS value of `new_vars`) is added to +#' the output dataset and set to the value of the source variable (RHS value +#' of `new_vars`. +#' +#' @return The input dataset with subperiod/period/phase variables added (see +#' "Details" section) +#' +#' @seealso [create_period_dataset()] +#' +#' @keywords der_adsl +#' @family der_adsl +#' +#' @export +#' +#' @examples +#' library(tibble) +#' library(dplyr, warn.conflicts = FALSE) +#' library(lubridate) +#' +#' adsl <- tibble(STUDYID = "xyz", USUBJID = c("1", "2")) +#' +#' # Add period variables to ADSL +#' period_ref <- tribble( +#' ~USUBJID, ~APERIOD, ~APERSDT, ~APEREDT, +#' "1", 1, "2021-01-04", "2021-02-06", +#' "1", 2, "2021-02-07", "2021-03-07", +#' "2", 1, "2021-02-02", "2021-03-02", +#' "2", 2, "2021-03-03", "2021-04-01" +#' ) %>% +#' mutate( +#' STUDYID = "xyz", +#' APERIOD = as.integer(APERIOD), +#' across(matches("APER[ES]DT"), ymd) +#' ) +#' +#' derive_vars_period( +#' adsl, +#' dataset_ref = period_ref, +#' new_vars = vars(APxxSDT = APERSDT, APxxEDT = APEREDT) +#' ) %>% +#' select(STUDYID, USUBJID, AP01SDT, AP01EDT, AP02SDT, AP02EDT) +#' +#' # Add phase variables to ADSL +#' phase_ref <- tribble( +#' ~USUBJID, ~APHASEN, ~PHSDT, ~PHEDT, ~APHASE, +#' "1", 1, "2021-01-04", "2021-02-06", "TREATMENT", +#' "1", 2, "2021-02-07", "2021-03-07", "FUP", +#' "2", 1, "2021-02-02", "2021-03-02", "TREATMENT" +#' ) %>% +#' mutate( +#' STUDYID = "xyz", +#' APHASEN = as.integer(APHASEN), +#' across(matches("PH[ES]DT"), ymd) +#' ) +#' +#' derive_vars_period( +#' adsl, +#' dataset_ref = phase_ref, +#' new_vars = vars(PHwSDT = PHSDT, PHwEDT = PHEDT, APHASEw = APHASE) +#' ) %>% +#' select(STUDYID, USUBJID, PH1SDT, PH1EDT, PH2SDT, PH2EDT, APHASE1, APHASE2) +#' +#' # Add subperiod variables to ADSL +#' subperiod_ref <- tribble( +#' ~USUBJID, ~APERIOD, ~ASPER, ~ASPRSDT, ~ASPREDT, +#' "1", 1, 1, "2021-01-04", "2021-01-19", +#' "1", 1, 2, "2021-01-20", "2021-02-06", +#' "1", 2, 1, "2021-02-07", "2021-03-07", +#' "2", 1, 1, "2021-02-02", "2021-03-02", +#' "2", 2, 1, "2021-03-03", "2021-04-01" +#' ) %>% +#' mutate( +#' STUDYID = "xyz", +#' APERIOD = as.integer(APERIOD), +#' ASPER = as.integer(ASPER), +#' across(matches("ASPR[ES]DT"), ymd) +#' ) +#' +#' derive_vars_period( +#' adsl, +#' dataset_ref = subperiod_ref, +#' new_vars = vars(PxxSwSDT = ASPRSDT, PxxSwEDT = ASPREDT) +#' ) %>% +#' select(STUDYID, USUBJID, P01S1SDT, P01S1EDT, P01S2SDT, P01S2EDT, P02S1SDT, P02S1EDT) +derive_vars_period <- function(dataset, + dataset_ref, + new_vars, + subject_keys = get_admiral_option("subject_keys")) { + assert_vars(new_vars, expect_names = TRUE) + assert_vars(subject_keys) + assert_data_frame(dataset, required_vars = subject_keys) + assert_data_frame(dataset_ref, required_vars = subject_keys) + + new_vars_names <- names(new_vars) + new_vars_chr <- vars2chr(new_vars) + mode <- case_when( + str_detect(new_vars_names, "\\w+xx\\w+w\\w*") ~ "subperiod", + str_detect(new_vars_names, "\\w+xx\\w*") ~ "period", + str_detect(new_vars_names, "\\w+w\\w*") ~ "phase", + TRUE ~ "none" + ) %>% unique() + if (any(mode == "none")) { + abort( + paste( + paste0( + "The left hand side values of `new_vars` have to be CDISC style ", + "subperiod, period, or phase variables." + ), + "I.e., they must contain the xx or w fragment, e.g., APxxSDT, PxxSwSDT, or PHwSDT.", + sep = "\n" + ) + ) + } + if (length(mode) > 1) { + abort( + paste0( + "More than one type of subperiod, period, or phase variables ", + "is specified for `new_vars`:\n", + if_else( + "subperiod" %in% mode, + paste0("subperiod: ", enumerate(new_vars_names[mode == "subperiod"]), "\n"), + "" + ), + if_else( + "period" %in% mode, + paste0("period: ", enumerate(new_vars_names[mode == "period"]), "\n"), + "" + ), + if_else( + "phase" %in% mode, + paste0("phase: ", enumerate(new_vars_names[mode == "phase"]), "\n"), + "" + ) + ) + ) + } + if (mode == "subperiod") { + id_vars <- vars(APERIOD, ASPER) + } else if (mode == "period") { + id_vars <- vars(APERIOD) + } else { + id_vars <- vars(APHASEN) + } + assert_data_frame(dataset_ref, required_vars = quo_c(subject_keys, new_vars, id_vars)) + + ref_wide <- pivot_wider( + dataset_ref, + names_from = vars2chr(id_vars), + values_from = unname(new_vars_chr) + ) + + # pivot_wider creates columns like APERSDT_1, APERSDT_2, ... + # these need to be renamed to variables like AP01SDT, AP02SDT, ... + rename_arg <- colnames(select(ref_wide, !!!negate_vars(subject_keys))) + split_names <- str_match(rename_arg, "(\\w+?)_(\\d{1,2})_?(\\d)?") + source_vars <- names(new_vars_chr) + names(source_vars) <- new_vars_chr + index <- split_names[, 3] + if (mode == "phase") { + names_rename_arg <- str_replace(source_vars[split_names[, 2]], "w", index) + } else { + # add leading zero for "xx" fragment + index <- if_else(str_length(index) == 1, paste0("0", index), index) + names_rename_arg <- str_replace(source_vars[split_names[, 2]], "xx", index) + if (mode == "subperiod") { + index2 <- split_names[, 4] + names_rename_arg <- str_replace(names_rename_arg, "w", index2) + } + } + names(rename_arg) <- names_rename_arg + + derive_vars_merged( + dataset, + dataset_add = ref_wide, + by_vars = subject_keys + ) %>% rename(all_of(rename_arg)) +} diff --git a/R/reexports.R b/R/reexports.R index 4d10b51e8d..e634c9e30e 100644 --- a/R/reexports.R +++ b/R/reexports.R @@ -1,14 +1,14 @@ -#' @export -admiraldev::filter_if - -#' @export -admiraldev::negate_vars - -#' @export -admiraldev::vars2chr +# Sometimes functions from other libraries become critically important while using admiral +# and thus should be included as an export. This applies especially to functions which are +# frequently called within `admiral` function arguments. The goal of these exports is such that +# admiral comes ready "out of the box", similar to how one might think the pipe operator, `%>%`, +# comes from `dplyr` but is actually native to `magrittr`. #' @export dplyr::vars #' @export dplyr::desc + +#' @export +magrittr::`%>%` diff --git a/R/restrict_derivation.R b/R/restrict_derivation.R index 90a6729110..aa2765b9f9 100644 --- a/R/restrict_derivation.R +++ b/R/restrict_derivation.R @@ -23,8 +23,9 @@ #' #' @examples #' -#' library(magrittr) -#' adlb <- tibble::tribble( +#' library(tibble) +#' +#' adlb <- tribble( #' ~USUBJID, ~AVISITN, ~AVAL, ~ABLFL, #' "1", -1, 113, NA_character_, #' "1", 0, 113, "Y", diff --git a/R/slice_derivation.R b/R/slice_derivation.R index 33ec540f38..f1bbeb2fd3 100644 --- a/R/slice_derivation.R +++ b/R/slice_derivation.R @@ -46,9 +46,9 @@ #' @export #' #' @examples -#' +#' library(tibble) #' library(stringr) -#' advs <- tibble::tribble( +#' advs <- tribble( #' ~USUBJID, ~VSDTC, ~VSTPT, #' "1", "2020-04-16", NA_character_, #' "1", "2020-04-16", "BEFORE TREATMENT" @@ -161,29 +161,6 @@ derivation_slice <- function(filter, filter = assert_filter_cond(enquo(filter)), args = assert_s3_class(args, "params") ) - class(out) <- c("derivation_slice", "list") + class(out) <- c("derivation_slice", "source", "list") out } - -#' Print `derivation_slice` Objects -#' -#' @param x A `derivation_slice` object -#' @param ... Not used -#' -#' @return No return value, called for side effects -#' -#' @export -#' -#' @family high_order_function -#' @keywords high_order_function -#' -#' @seealso [derivation_slice()] -#' -#' @examples -#' print(death_event) -print.derivation_slice <- function(x, ...) { - cat(" object\n") - cat("filter:", quo_text(x$filter), "\n") - cat("args:\n") - print(x$args) -} diff --git a/R/user_helpers.R b/R/user_helpers.R index a448c429bc..caca67d2ae 100644 --- a/R/user_helpers.R +++ b/R/user_helpers.R @@ -109,8 +109,8 @@ list_all_templates <- function(package = "admiral") { #' #' @export #' -#' @keywords internal -#' @family internal +#' @keywords utils_print +#' @family utils_print #' #' @seealso [list_all_templates()] #' diff --git a/R/user_utils.R b/R/user_utils.R index 314323ac5b..193300ec61 100644 --- a/R/user_utils.R +++ b/R/user_utils.R @@ -46,9 +46,11 @@ extract_unit <- function(x) { #' @export #' #' @examples +#' library(tibble) +#' #' convert_blanks_to_na(c("a", "b", "", "d", "")) #' -#' df <- tibble::tibble( +#' df <- tibble( #' a = structure(c("a", "b", "", "c"), label = "A"), #' b = structure(c(1, NA, 21, 9), label = "B"), #' c = structure(c(TRUE, FALSE, TRUE, TRUE), label = "C"), @@ -85,6 +87,98 @@ convert_blanks_to_na.data.frame <- function(x) { # nolint x } + +#' Convert NAs Into Blank Strings +#' +#' Turn `NA`s to blank strings . +#' +#' @param x Any R object +#' +#' @details +#' The default methods simply returns its input unchanged. The `character` method +#' turns every instance of `NA_character_` or `NA` into `""` while preserving *all* attributes. +#' When given a data frame as input the function keeps all non-character columns +#' as is and applies the just described logic to `character` +#' all attributes such as labels are preserved. +#' +#' @return An object of the same class as the input +#' +#' @author Sadchla Mascary +#' +#' @family utils_fmt +#' @keywords utils_fmt +#' +#' @export +#' +#' @examples +#' library(tibble) +#' +#' convert_na_to_blanks(c("a", "b", NA, "d", NA)) +#' +#' df <- tibble( +#' a = structure(c("a", "b", NA, "c"), label = "A"), +#' b = structure(c(1, NA, 21, 9), label = "B"), +#' c = structure(c(TRUE, FALSE, TRUE, TRUE), label = "C"), +#' d = structure(c(NA, NA, "s", "q"), label = "D") +#' ) +#' print(df) +#' convert_na_to_blanks(df) +convert_na_to_blanks <- function(x) { + UseMethod("convert_na_to_blanks") +} + +#' @export +#' @rdname convert_na_to_blanks +convert_na_to_blanks.default <- function(x) { + x +} + +#' @export +#' @rdname convert_na_to_blanks +convert_na_to_blanks.character <- function(x) { + do.call(structure, c(list(if_else(is.na(x), "", x)), attributes(x))) +} + +#' @export +#' @rdname convert_na_to_blanks +convert_na_to_blanks.list <- function(x) { + lapply(x, convert_na_to_blanks) +} + +#' @export +#' @rdname convert_na_to_blanks +convert_na_to_blanks.data.frame <- function(x) { # nolint + x_out <- x %>% + mutate(across(everything(), convert_na_to_blanks)) + x_out +} + + +#' Turn a Character Vector into a List of Quosures +#' +#' Turn a character vector into a list of quosures +#' +#' @param chr A character vector +#' +#' @return A `list` of `quosures` as returned by [`vars()`] +#' +#' @author Stefan Bundfuss +#' +#' @export +#' +#' @keywords utils_quo +#' @family utils_quo +#' +#' @examples +#' chr2vars(c("USUBJID", "AVAL")) +chr2vars <- function(chr) { + assert_character_vector(chr) + rlang::set_names( + quos(!!!syms(chr)), + names(chr) + ) +} + #' Get One to Many Values that Led to a Prior Error #' #' @export @@ -107,6 +201,7 @@ convert_blanks_to_na.data.frame <- function(x) { # nolint #' @keywords utils_ds_chk #' #' @examples +#' library(admiraldev, warn.conflicts = FALSE) #' data(admiral_adsl) #' #' try( @@ -140,6 +235,7 @@ get_one_to_many_dataset <- function() { #' @keywords utils_ds_chk #' #' @examples +#' library(admiraldev, warn.conflicts = FALSE) #' data(admiral_adsl) #' #' try( @@ -177,3 +273,107 @@ yn_to_numeric <- function(arg) { TRUE ~ NA_real_ ) } + +#' Print `source` Objects +#' +#' @param x An `source` object +#' @param ... If `indent = ` is specified the output is indented +#' by the specified number of characters. +#' +#' @return No return value, called for side effects +#' +#' @author Stefan Bundfuss +#' +#' @keywords utils_print +#' @family utils_print +#' +#' @export +#' +#' @examples +#' print(death_event) +print.source <- function(x, ...) { + args <- list(...) + if ("indent" %in% names(args)) { + indent <- args[["indent"]] + } else { + indent <- 0 + } + cat(strrep(" ", indent), "<", attr(x, "class")[1], "> object\n", sep = "") + print_named_list(x, indent = indent) +} + + +#' Print Named List +#' +#' @param list A named list +#' @param indent Indent +#' +#' The output is indented by the specified number of characters. +#' +#' @return No return value, called for side effects +#' +#' @author Stefan Bundfuss +#' +#' @keywords utils_print +#' @family utils_print +#' +#' @export +#' +#' @examples +#' print_named_list(death_event) +print_named_list <- function(list, indent = 0) { + names <- names(list) + if (is.null(names)) { + names <- seq_len(length.out = length(list)) + } + for (name in names) { + if (inherits(list[[name]], "source")) { + cat(strrep(" ", indent), name, ":\n", sep = "") + print(list[[name]], indent = indent + 2) + } else if (is.data.frame(list[[name]])) { + cat(strrep(" ", indent), name, ":\n", sep = "") + print(list[[name]]) + } else if (is.list(list[[name]])) { + cat(strrep(" ", indent), name, ":\n", sep = "") + print_named_list(list[[name]], indent = indent + 2) + } else { + if (is.character(list[[name]])) { + chr_val <- dquote(list[[name]]) + } else if (is_quosure(list[[name]])) { + chr_val <- quo_text(list[[name]]) + } else { + chr_val <- list[[name]] + } + cat(strrep(" ", indent), name, ": ", chr_val, "\n", sep = "") + } + } +} + +#' Negate List of Variables +#' +#' The function adds a minus sign as prefix to each variable. +#' +#' This is useful if a list of variables should be removed from a dataset, +#' e.g., `select(!!!negate_vars(by_vars))` removes all by variables. +#' +#' @param vars List of variables created by `vars()` +#' +#' @return A list of `quosures` +#' +#' @author Stefan Bundfuss +#' +#' @export +#' +#' @keywords utils_quo +#' @family utils_quo +#' +#' @examples +#' negate_vars(vars(USUBJID, STUDYID)) +negate_vars <- function(vars = NULL) { + assert_vars(vars, optional = TRUE) + if (is.null(vars)) { + NULL + } else { + lapply(vars, function(var) expr(-!!quo_get_expr(var))) + } +} diff --git a/README.md b/README.md index a58c3af076..6027eee77f 100644 --- a/README.md +++ b/README.md @@ -43,10 +43,10 @@ Phases: | Release Schedule | Phase 1- Date and Packages | Phase 2- Date and Packages | Phase 3- Date and Packages | | ---------------- | -------------------------- | -------------------------- | -------------------------- | -| Q4-2022 | November 28th | December 5th | December 12th | +| Q1-2023 | February 27th | March 6th | March 13th | | | `{admiraldev}` | `{admiral}` | `{admiralonco}` | | | `{admiral.test}` | | | -| Q1-2023 | February 27th | March 6th | March 12th | +| Q2-2023 | May 29th | June 5th | June 12th | | | `{admiraldev}` | `{admiral}` | `{admiralonco}` | | | `{admiral.test}` | | | diff --git a/_pkgdown.yml b/_pkgdown.yml index a3226ae031..7dfc4d40e4 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -14,73 +14,100 @@ repo: user: https://github.com/ news: cran_dates: true + reference: - title: Derivations for Adding Variables - subtitle: All ADaMs -- contents: + contents: - has_keyword("der_gen") + - subtitle: ADSL-specific - desc: Derivation Functions helpful for building the ADSL dataset -- contents: + desc: Derivation functions helpful for building the ADSL dataset + contents: - has_keyword("der_adsl") + - subtitle: BDS-specific - desc: Derivation Functions helpful for building the BDS datasets (e.g. advs, adlb, adeg, adex) -- contents: - - has_keyword("der_bds_gen") + desc: Derivation functions helpful for building the BDS datasets (e.g. advs, adlb, adeg, adex) + contents: - has_keyword("der_bds_findings") + - subtitle: OCCDS-specific - desc: Derivation Functions helpful for building the OCCDS datasets (e.g. adae, adcm, admh) -- contents: + desc: Derivation functions helpful for building the OCCDS datasets (e.g. adae, adcm, admh) + contents: - has_keyword("der_occds") - title: Derivations for Adding Parameters/Records - subtitle: BDS-specific -- contents: + contents: - has_keyword("der_prm_bds_findings") + - subtitle: TTE-specific -- contents: + contents: - has_keyword("der_prm_tte") +- title: Metadata + desc: Auxiliary datasets providing definitions as input for derivations, e.g. grading criteria or dose frequencies + contents: + - has_keyword("metadata") + - title: Advanced Functions +- subtitle: Admiral Options + contents: + - has_keyword("admiral_options") + - subtitle: Higher Order -- contents: + contents: - has_keyword("high_order_function") -- subtitle: Metadata -- contents: - - has_keyword("metadata") + +- subtitle: Creating Auxiliary Datasets + contents: + - has_keyword("create_aux") + - subtitle: Other -- contents: + contents: - has_keyword("source_specifications") - title: Computation Functions for Vectors - subtitle: All ADaMs contents: - has_keyword('com_date_time') + - subtitle: BDS-specific contents: - has_keyword('com_bds_findings') - - title: Utility Functions - subtitle: Utilities for Formatting Observations -- contents: + contents: - has_keyword('utils_fmt') + - subtitle: Utilities for Dataset Checking -- contents: + contents: - has_keyword('utils_ds_chk') + - subtitle: Utilities used within Derivation Functions -- contents: + contents: - has_keyword('utils_help') + - subtitle: Utilities for Filtering Observations -- contents: + contents: - has_keyword('utils_fil') + - subtitle: Utilities used for Date Imputation -- contents: + contents: - has_keyword('utils_impute') + +- subtitle: Utilities for Quosures + contents: + - has_keyword('utils_quo') + - subtitle: Utilities used for Examples and Template Scripts -- contents: + contents: - has_keyword('utils_examples') +- subtitle: Utilities for Printing + contents: + - has_keyword('utils_print') - title: Example Datasets desc: You can run `use_ad_template()` to produce additional datasets @@ -88,8 +115,17 @@ reference: - has_keyword('datasets') - title: Deprecated -- desc: Look out for Warning and Error messages. These will guide you to deprecated functions replacements. -- contents: + desc: | + As `{admiral}` is still evolving, functions/parameters may need to be removed or replaced over time. In such cases, the function/parameter will enter the following 6-month deprecation cycle: + + * In the first release (0-3 months), there will be a warning issued if you use the function/parameter, but it will still be available to use. + * In the following release (3-6 months), an error will be produced if you use the function/parameter. + * Finally, from the 3rd release (6 months) onwards, the function/parameter will be removed from `{admiral}` and its documentation completely. + + *Note: Guidance on replacement functionality can be found in the warning/error message produced or in the function's documentation.* + + Below, you can find a list of functions in the process of being deprecated: + contents: - has_keyword("deprecated") navbar: @@ -132,6 +168,10 @@ navbar: - text: "Advanced User Guides" - text: Date and Time Imputation href: articles/imputation.html + - text: Visit and Period Variables + href: articles/visits_periods.html + - text: Generic Functions + href: articles/generic.html - text: Higher Order Functions href: articles/higher_order.html - text: Queries Dataset Documentation diff --git a/data/atoxgr_criteria_ctcv5.rda b/data/atoxgr_criteria_ctcv5.rda new file mode 100644 index 0000000000..6b1b7641be Binary files /dev/null and b/data/atoxgr_criteria_ctcv5.rda differ diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml index 46d393af78..a9a638f7dc 100644 --- a/docs/pkgdown.yml +++ b/docs/pkgdown.yml @@ -1,5 +1,5 @@ -pandoc: 2.11.4 -pkgdown: 2.0.3 +pandoc: 2.19.2 +pkgdown: 2.0.6 pkgdown_sha: ~ articles: admiral: admiral.html @@ -8,12 +8,17 @@ articles: bds_finding: bds_finding.html bds_tte: bds_tte.html contribution_model: contribution_model.html + faq: faq.html + generic: generic.html higher_order: higher_order.html imputation: imputation.html lab_grading: lab_grading.html occds: occds.html queries_dataset: queries_dataset.html -last_built: 2022-09-09T10:59Z + visits_periods: visits_periods.html + +last_built: 2022-11-25T12:53Z + urls: reference: https://pharmaverse.github.io/admiral/reference article: https://pharmaverse.github.io/admiral/articles diff --git a/inst/WORDLIST b/inst/WORDLIST index 2b0d6085f8..ca2c4dab7c 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -35,6 +35,7 @@ COVID CQ CRF CTCAE +CTCAEv Changelog Codebase Cyclomatic @@ -65,10 +66,12 @@ GxP Hoffmann IG LLC +LOCF MedDRA Metatools Modularity Mosteller +NCI NUM OCCDS PARAM @@ -140,6 +143,7 @@ censorings chk constructible cyclomatic +datasets datepart datetime datetimes @@ -196,6 +200,7 @@ reults roche roxygen submittable +subperiod summarization testthat th diff --git a/inst/adlb_grading/adlb_grading_spec.xlsx b/inst/adlb_grading/adlb_grading_spec.xlsx index fbcf65b908..4fc461b3a4 100755 Binary files a/inst/adlb_grading/adlb_grading_spec.xlsx and b/inst/adlb_grading/adlb_grading_spec.xlsx differ diff --git a/inst/adlb_grading/atoxgr_sources.R b/inst/adlb_grading/atoxgr_sources.R index 71dcb32f5b..99e7c45207 100644 --- a/inst/adlb_grading/atoxgr_sources.R +++ b/inst/adlb_grading/atoxgr_sources.R @@ -1,8 +1,16 @@ -atoxgr_criteria_ctcv4 <- system.file("adlb_grading/adlb_grading_spec.xlsx", package = "admiral") %>% - # Contrary to our usual convention the use of `::` here is explicit. This way we - # avoid having to list {readxl} in "Imports" and instead get away with just - # listing it in "Depends". +atoxgr_criteria <- system.file("adlb_grading/adlb_grading_spec.xlsx", package = "admiral") +# Contrary to our usual convention the use of `::` here is explicit. This way we +# avoid having to list {readxl} in "Imports" and instead get away with just +# listing it in "Depends". + +atoxgr_criteria_ctcv4 <- atoxgr_criteria %>% readxl::read_excel(sheet = "NCICTCAEv4") %>% dplyr::mutate(GRADE_CRITERIA_CODE = gsub("[\r\n]", " ", GRADE_CRITERIA_CODE)) save(atoxgr_criteria_ctcv4, file = "data/atoxgr_criteria_ctcv4.rda") + +atoxgr_criteria_ctcv5 <- atoxgr_criteria %>% + readxl::read_excel(sheet = "NCICTCAEv5") %>% + dplyr::mutate(GRADE_CRITERIA_CODE = gsub("[\r\n]", " ", GRADE_CRITERIA_CODE)) + +save(atoxgr_criteria_ctcv5, file = "data/atoxgr_criteria_ctcv5.rda") diff --git a/inst/templates/ad_adae.R b/inst/templates/ad_adae.R index d836cf9d35..9e16f207d6 100644 --- a/inst/templates/ad_adae.R +++ b/inst/templates/ad_adae.R @@ -103,10 +103,12 @@ adae <- adae %>% AREL = AEREL ) %>% ## Derive treatment emergent flag ---- - mutate( - TRTEMFL = ifelse(ASTDT >= TRTSDT & ASTDT <= TRTEDT + days(30), "Y", NA_character_) + derive_var_trtemfl( + trt_start_date = TRTSDT, + trt_end_date = TRTEDT, + end_window = 30 ) %>% - ## Derive occurrence flags: first occurence of most severe AE ---- + ## Derive occurrence flags: first occurrence of most severe AE ---- # create numeric value ASEVN for severity mutate( ASEVN = as.integer(factor(ASEV, levels = c("MILD", "MODERATE", "SEVERE", "DEATH THREATENING"))) @@ -133,4 +135,4 @@ adae <- adae %>% # Save output ---- dir <- tempdir() # Change to whichever directory you want to save the dataset in -save(adae, file = file.path(dir, "adae.rda"), compress = "bzip2") +saveRDS(adae, file = file.path(dir, "adae.rds"), compress = "bzip2") diff --git a/inst/templates/ad_adcm.R b/inst/templates/ad_adcm.R index fb7c648897..8a915417f0 100644 --- a/inst/templates/ad_adcm.R +++ b/inst/templates/ad_adcm.R @@ -108,6 +108,8 @@ adcm <- adcm %>% ## Derive APHASE and APHASEN Variable ---- # Other timing variable can be derived similarly. +# See also the "Visit and Period Variables" vignette +# (https://pharmaverse.github.io/admiral/articles/visits_periods.html) adcm <- adcm %>% mutate( APHASE = case_when( @@ -138,4 +140,4 @@ adcm <- adcm %>% # Save output ---- dir <- tempdir() # Change to whichever directory you want to save the dataset in -save(adcm, file = file.path(dir, "adcm.rda"), compress = "bzip2") +saveRDS(adcm, file = file.path(dir, "adcm.rds"), compress = "bzip2") diff --git a/inst/templates/ad_adeg.R b/inst/templates/ad_adeg.R index c2317dc369..e0c76fd2a1 100644 --- a/inst/templates/ad_adeg.R +++ b/inst/templates/ad_adeg.R @@ -171,6 +171,8 @@ adeg <- adeg %>% ) ## Get visit info ---- +# See also the "Visit and Period Variables" vignette +# (https://pharmaverse.github.io/admiral/articles/visits_periods.html#visits) adeg <- adeg %>% # Derive Timing mutate( @@ -287,11 +289,12 @@ adeg <- adeg %>% ) ## Get treatment information ---- +# See also the "Visit and Period Variables" vignette +# (https://pharmaverse.github.io/admiral/articles/visits_periods.html#treatment_bds) adeg <- adeg %>% # Assign TRTA, TRTP mutate(TRTP = TRT01P, TRTA = TRT01A) - ## Get ASEQ and AVALCAT1/CHGCAT1 and add PARAM/PARAMN ---- adeg <- adeg %>% # Calculate ASEQ @@ -327,4 +330,4 @@ adeg <- adeg %>% # Save output ---- dir <- tempdir() # Change to whichever directory you want to save the dataset in -save(adeg, file = file.path(dir, "adeg.rda"), compress = "bzip2") +saveRDS(adeg, file = file.path(dir, "adeg.rds"), compress = "bzip2") diff --git a/inst/templates/ad_adex.R b/inst/templates/ad_adex.R index 61760ed60d..348723c1f3 100644 --- a/inst/templates/ad_adex.R +++ b/inst/templates/ad_adex.R @@ -292,4 +292,4 @@ adex <- adex %>% # Save output ---- dir <- tempdir() # Change to whichever directory you want to save the dataset in -save(adex, file = file.path(dir, "adex.rda"), compress = "bzip2") +saveRDS(adex, file = file.path(dir, "adex.rds"), compress = "bzip2") diff --git a/inst/templates/ad_adlb.R b/inst/templates/ad_adlb.R index b26321d7ec..efa6225c6e 100644 --- a/inst/templates/ad_adlb.R +++ b/inst/templates/ad_adlb.R @@ -153,6 +153,8 @@ adlb <- adlb %>% ) ## Get Visit Info ---- +# See also the "Visit and Period Variables" vignette +# (https://pharmaverse.github.io/admiral/articles/visits_periods.html#visits) adlb <- adlb %>% # Derive Timing mutate( @@ -228,6 +230,7 @@ adlb <- adlb %>% # Assign ATOXDSCL and ATOXDSCH to hold lab grading terms # ATOXDSCL and ATOXDSCH hold terms defined by NCI-CTCAEv4. +# See (https://pharmaverse.github.io/admiral/articles/lab_grading.html#implement_ctcv4) grade_lookup <- tibble::tribble( ~PARAMCD, ~ATOXDSCL, ~ATOXDSCH, "ALB", "Hypoalbuminemia", NA_character_, @@ -250,6 +253,15 @@ grade_lookup <- tibble::tribble( "WBC", "White blood cell decreased", "Leukocytosis", ) +# Assign grade criteria +# metadata atoxgr_criteria_ctcv4 used to implement NCI-CTCAEv4 +# user could change to atoxgr_criteria_ctcv5 to implement NCI-CTCAEv5 +# Note: Hyperglycemia and Hypophosphatemia not defined in NCI-CTCAEv5 so +# user would need to amend look-up table grade_lookup +# See (https://pharmaverse.github.io/admiral/articles/lab_grading.html#implement_ctcv5) +grade_crit <- atoxgr_criteria_ctcv4 + + # Add ATOXDSCL and ATOXDSCH adlb <- adlb %>% derive_vars_merged( @@ -257,8 +269,9 @@ adlb <- adlb %>% by_vars = vars(PARAMCD) ) %>% # Derive toxicity grade for low values ATOXGRL - # default metadata atoxgr_criteria_ctcv4 used + derive_var_atoxgr_dir( + meta_criteria = grade_crit, new_var = ATOXGRL, tox_description_var = ATOXDSCL, criteria_direction = "L", @@ -267,6 +280,7 @@ adlb <- adlb %>% # Derive toxicity grade for low values ATOXGRH # default metadata atoxgr_criteria_ctcv4 used derive_var_atoxgr_dir( + meta_criteria = grade_crit, new_var = ATOXGRH, tox_description_var = ATOXDSCH, criteria_direction = "H", @@ -354,6 +368,8 @@ adlb <- adlb %>% ) ## Get treatment information ---- +# See also the "Visit and Period Variables" vignette +# (https://pharmaverse.github.io/admiral/articles/visits_periods.html#treatment_bds) adlb <- adlb %>% # Assign TRTA, TRTP mutate( @@ -427,4 +443,4 @@ adlb <- adlb %>% # Save output ---- dir <- tempdir() # Change to whichever directory you want to save the dataset in -save(adlb, file = file.path(dir, "adlb.rda"), compress = "bzip2") +saveRDS(adlb, file = file.path(dir, "adlb.rds"), compress = "bzip2") diff --git a/inst/templates/ad_admh.R b/inst/templates/ad_admh.R index 9c7fba9e44..69a361d5d0 100644 --- a/inst/templates/ad_admh.R +++ b/inst/templates/ad_admh.R @@ -8,7 +8,7 @@ library(admiral.test) # Contains example datasets from the CDISC pilot project library(dplyr) library(lubridate) -# ---- Load source datasets ---- +# Load source datasets ---- # Use e.g. haven::read_sas to read in .sas7bdat, or other suitable functions # as needed and assign to the variables below. @@ -23,7 +23,7 @@ mh <- admiral_mh mh <- convert_blanks_to_na(mh) -# ---- Look-up tables ---- +# Look-up tables ---- # Creating a look-up table for assigning MHTERMN (for derivation of company specific variable) # (this is set to align with the order of pre-printed terms on the CRF) @@ -32,7 +32,7 @@ mhtermn_lookup <- tibble::tribble( "ALZHEIMER'S DISEASE", 1 ) -# ---- Derivations ---- +# Derivations ---- # Get list of ADSL vars required for derivations adsl_vars <- vars(TRTSDT, TRTEDT, TRT01A, TRT01P, DTHDT, EOSDT) @@ -44,6 +44,7 @@ admh <- mh %>% new_vars = adsl_vars, by_vars = vars(STUDYID, USUBJID) ) %>% + ## Derive dates (ASTDT, AEDT, ...) ---- # Derive analysis start date and flag derive_vars_dt( dtc = MHSTDTC, @@ -72,7 +73,7 @@ admh <- mh %>% reference_date = TRTSDT, source_vars = vars(ADT) ) %>% - # Derive query variables + ## Derive query variables ---- derive_vars_query(queries_mh) %>% # Assign the AHIST (company specific variable derivation) mutate(AHIST = case_when( @@ -80,7 +81,7 @@ admh <- mh %>% MHENRF %in% c("DURING", "AFTER") ~ "Current", MHSTAT == "Not Done" ~ "Not Assessed" )) %>% - # Derive occurrence flags + ## Derive occurrence flags ---- derive_var_extreme_flag( by_vars = vars(USUBJID), order = vars(ASTDT, MHSEQ), @@ -118,14 +119,18 @@ admh <- mh %>% new_var = AOCPPFL, mode = "first" ) %>% - # Derive analysis flag (company specific variable derivation) + ## Derive analysis flag (company specific variable derivation) ---- mutate(ANL01FL = ifelse(MHOCCUR != "N", "Y", NA_character_)) %>% - # Assign TRTA, TRTP (company specific variables derivation) + ## Assign TRTA, TRTP (company specific variables derivation) ---- + # See also the "Visit and Period Variables" vignette + # (https://pharmaverse.github.io/admiral/articles/visits_periods.html#treatment_bds) mutate( TRTP = TRT01P, TRTA = TRT01A ) %>% - # Assign APHASE and APHASEN Variable (company specific variable derivation) + ## Assign APHASE and APHASEN Variable (company specific variable derivation) ---- + # See also the "Visit and Period Variables" vignette + # (https://pharmaverse.github.io/admiral/articles/visits_periods.html#periods_bds) mutate( APHASE = case_when( ADT < TRTSDT ~ "Screening", @@ -151,9 +156,7 @@ admh <- restrict_derivation( filter = (MHPRESP == "Y") ) - - -# Add all ADSL variables +## Add all ADSL variables ---- admh <- admh %>% derive_vars_merged( dataset_add = select(adsl, !!!negate_vars(adsl_vars)), @@ -165,7 +168,7 @@ admh <- admh %>% # This process will be based on your metadata, no example given for this reason # ... -# ---- Save output ---- +# Save output ---- dir <- tempdir() # Change to whichever directory you want to save the dataset in -save(admh, file = file.path(dir, "admh.rda"), compress = "bzip2") +saveRDS(admh, file = file.path(dir, "admh.rds"), compress = "bzip2") diff --git a/inst/templates/ad_adpp.R b/inst/templates/ad_adpp.R index 775908489f..1a1948b40c 100644 --- a/inst/templates/ad_adpp.R +++ b/inst/templates/ad_adpp.R @@ -115,6 +115,8 @@ adpp <- adpp %>% select(-DOMAIN, -PPSEQ) ## Get visit info ---- +# See also the "Visit and Period Variables" vignette +# (https://pharmaverse.github.io/admiral/articles/visits_periods.html#visit_bds) adpp <- adpp %>% # Derive Timing mutate( @@ -128,6 +130,8 @@ adpp <- adpp %>% AVISITN = VISITNUM ) %>% ## Assign TRTA, TRTP ---- + # See also the "Visit and Period Variables" vignette + # (https://pharmaverse.github.io/admiral/articles/visits_periods.html#treatment_bds) mutate( TRTP = TRT01P, TRTA = TRT01A @@ -148,4 +152,4 @@ adpp <- adpp %>% # Save output ---- dir <- tempdir() # Change to whichever directory you want to save the dataset in -save(adpp, file = file.path(dir, "adpp.rda"), compress = "bzip2") +saveRDS(adpp, file = file.path(dir, "adpp.rds"), compress = "bzip2") diff --git a/inst/templates/ad_adsl.R b/inst/templates/ad_adsl.R index 85f636a542..b93cd9fd15 100644 --- a/inst/templates/ad_adsl.R +++ b/inst/templates/ad_adsl.R @@ -52,6 +52,15 @@ format_racegr1 <- function(x) { ) } +format_agegr1 <- function(x) { + case_when( + x < 18 ~ "<18", + between(x, 18, 64) ~ "18-64", + x > 64 ~ ">64", + TRUE ~ "Missing" + ) +} + format_region1 <- function(x) { case_when( x %in% c("CAN", "USA") ~ "NA", @@ -93,6 +102,8 @@ ex_ext <- ex %>% adsl <- dm %>% ## derive treatment variables (TRT01P, TRT01A) ---- + # See also the "Visit and Period Variables" vignette + # (https://pharmaverse.github.io/admiral/articles/visits_periods.html#treatment_adsl) mutate(TRT01P = ARM, TRT01A = ACTARM) %>% ## derive treatment start date (TRTSDTM) ---- derive_vars_merged( @@ -234,12 +245,6 @@ adsl <- adsl %>% source_datasets = list(ae = ae_ext, lb = lb_ext, adsl = adsl), mode = "last" ) %>% - ## Age group ---- - derive_var_agegr_fda( - age_var = AGE, - new_var = AGEGR1 - ) %>% - ## Safety population ---- derive_var_merged_exist_flag( dataset_add = ex, by_vars = vars(STUDYID, USUBJID), @@ -249,6 +254,7 @@ adsl <- adsl %>% ## Groupings and others variables ---- mutate( RACEGR1 = format_racegr1(RACE), + AGEGR1 = format_agegr1(AGE), REGION1 = format_region1(COUNTRY), LDDTHGR1 = format_lddthgr1(LDDTHELD), DTH30FL = if_else(LDDTHGR1 == "<= 30", "Y", NA_character_), @@ -261,4 +267,4 @@ adsl <- adsl %>% # Save output ---- dir <- tempdir() # Change to whichever directory you want to save the dataset in -save(adsl, file = file.path(dir, "adsl.rda"), compress = "bzip2") +saveRDS(adsl, file = file.path(dir, "adsl.rds"), compress = "bzip2") diff --git a/inst/templates/ad_advs.R b/inst/templates/ad_advs.R index eb94c5fcb1..4bc7306bba 100644 --- a/inst/templates/ad_advs.R +++ b/inst/templates/ad_advs.R @@ -133,6 +133,8 @@ advs <- advs %>% ## Get visit info ---- +# See also the "Visit and Period Variables" vignette +# (https://pharmaverse.github.io/admiral/articles/visits_periods.html#visits) advs <- advs %>% # Derive Timing mutate( @@ -240,6 +242,8 @@ advs <- advs %>% ) ## Get treatment information ---- +# See also the "Visit and Period Variables" vignette +# (https://pharmaverse.github.io/admiral/articles/visits_periods.html#treatment_bds) advs <- advs %>% # Assign TRTA, TRTP # Create End of Treatment Record @@ -296,4 +300,4 @@ advs <- advs %>% # Save output ---- dir <- tempdir() # Change to whichever directory you want to save the dataset in -save(advs, file = file.path(dir, "advs.rda"), compress = "bzip2") +saveRDS(advs, file = file.path(dir, "advs.rds"), compress = "bzip2") diff --git a/man/admiral-package.Rd b/man/admiral-package.Rd index c25b59f7f9..8d05c40d36 100644 --- a/man/admiral-package.Rd +++ b/man/admiral-package.Rd @@ -17,10 +17,6 @@ Useful links: \item \url{https://github.com/pharmaverse/admiral} } - -Other internal: -\code{\link{print.adam_templates}()}, -\code{\link{print.tte_source}()} } \author{ \strong{Maintainer}: Thomas Neitmann \email{thomas.neitmann@roche.com} @@ -48,13 +44,21 @@ Authors: \item Pooja Kumari \item Claudia Carlucci \item Daniil Stefonishin + \item Sadchla Mascary + \item Zelos Zhu + \item Jeffrey Dickinson + \item Ania Golab } Other contributors: \itemize{ \item Michael Thorpe [contributor] + \item Declan Hodges [contributor] + \item Jaxon Abercrombie [contributor] + \item Nick Ramirez [contributor] \item Pavan Kumar [contributor] \item Hamza Rahal [contributor] + \item Yohann Omnes [contributor] \item Alice Ehmann [contributor] \item Tom Ratford [contributor] \item Vignesh Thanikachalam [contributor] @@ -66,6 +70,7 @@ Other contributors: \item Syed Mubasheer [contributor] \item Wenyi Liu [contributor] \item Dinakar Kulkarni [contributor] + \item Franciszek Walkowiak [contributor] \item Tamara Senior [contributor] \item Jordanna Morrish [contributor] \item Anthony Howard [contributor] diff --git a/man/admiral_adsl.Rd b/man/admiral_adsl.Rd index c106548f43..4780d7f5ec 100644 --- a/man/admiral_adsl.Rd +++ b/man/admiral_adsl.Rd @@ -18,7 +18,6 @@ An example subject level analysis dataset } \seealso{ Other datasets: -\code{\link{atoxgr_criteria_ctcv4}}, \code{\link{ex_single}}, \code{\link{queries_mh}}, \code{\link{queries}} diff --git a/man/assert_db_requirements.Rd b/man/assert_db_requirements.Rd index 88127d2a3a..ddc58c6df1 100644 --- a/man/assert_db_requirements.Rd +++ b/man/assert_db_requirements.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/create_query_data.R \name{assert_db_requirements} \alias{assert_db_requirements} -\title{Check required parameters for SMQ/SDG} +\title{Check required parameters for a basket} \usage{ assert_db_requirements( version, @@ -10,8 +10,7 @@ assert_db_requirements( fun, fun_arg_name, queries, - i, - type + i ) } \arguments{ @@ -26,40 +25,35 @@ assert_db_requirements( \item{queries}{Queries provide by user} \item{i}{Index of query being checked} - -\item{type}{Type of query - -Should be \verb{"SMQ}" or \code{"SDG"}.} } \value{ An error is issued if \code{version} or \code{fun} is null. } \description{ -If SMQs or SDGs are requested, the version and a function to access the +If a basket (SMQ, SDG, ....) are requested, the version and a function to access the database must be provided. The function checks these requirements. } \seealso{ Source Specifications: \code{\link{assert_terms}()}, \code{\link{assert_valid_queries}()}, +\code{\link{basket_select}()}, \code{\link{censor_source}()}, \code{\link{date_source}()}, \code{\link{death_event}}, -\code{\link{derive_var_dthcaus}()}, +\code{\link{dthcaus_source}()}, \code{\link{event_source}()}, \code{\link{extend_source_datasets}()}, \code{\link{filter_date_sources}()}, -\code{\link{format.sdg_select}()}, -\code{\link{format.smq_select}()}, +\code{\link{format.basket_select}()}, \code{\link{list_tte_source_objects}()}, \code{\link{params}()}, \code{\link{query}()}, \code{\link{sdg_select}()}, \code{\link{smq_select}()}, \code{\link{tte_source}()}, -\code{\link{validate_query}()}, -\code{\link{validate_sdg_select}()}, -\code{\link{validate_smq_select}()} +\code{\link{validate_basket_select}()}, +\code{\link{validate_query}()} } \author{ Stefan Bundfuss diff --git a/man/assert_terms.Rd b/man/assert_terms.Rd index eebe3d3895..313dc6f6be 100644 --- a/man/assert_terms.Rd +++ b/man/assert_terms.Rd @@ -51,24 +51,23 @@ try( Source Specifications: \code{\link{assert_db_requirements}()}, \code{\link{assert_valid_queries}()}, +\code{\link{basket_select}()}, \code{\link{censor_source}()}, \code{\link{date_source}()}, \code{\link{death_event}}, -\code{\link{derive_var_dthcaus}()}, +\code{\link{dthcaus_source}()}, \code{\link{event_source}()}, \code{\link{extend_source_datasets}()}, \code{\link{filter_date_sources}()}, -\code{\link{format.sdg_select}()}, -\code{\link{format.smq_select}()}, +\code{\link{format.basket_select}()}, \code{\link{list_tte_source_objects}()}, \code{\link{params}()}, \code{\link{query}()}, \code{\link{sdg_select}()}, \code{\link{smq_select}()}, \code{\link{tte_source}()}, -\code{\link{validate_query}()}, -\code{\link{validate_sdg_select}()}, -\code{\link{validate_smq_select}()} +\code{\link{validate_basket_select}()}, +\code{\link{validate_query}()} } \author{ Stefan Bundfuss diff --git a/man/assert_valid_queries.Rd b/man/assert_valid_queries.Rd index 6eea29965d..e4c909f327 100644 --- a/man/assert_valid_queries.Rd +++ b/man/assert_valid_queries.Rd @@ -40,24 +40,23 @@ assert_valid_queries(queries, "queries") Source Specifications: \code{\link{assert_db_requirements}()}, \code{\link{assert_terms}()}, +\code{\link{basket_select}()}, \code{\link{censor_source}()}, \code{\link{date_source}()}, \code{\link{death_event}}, -\code{\link{derive_var_dthcaus}()}, +\code{\link{dthcaus_source}()}, \code{\link{event_source}()}, \code{\link{extend_source_datasets}()}, \code{\link{filter_date_sources}()}, -\code{\link{format.sdg_select}()}, -\code{\link{format.smq_select}()}, +\code{\link{format.basket_select}()}, \code{\link{list_tte_source_objects}()}, \code{\link{params}()}, \code{\link{query}()}, \code{\link{sdg_select}()}, \code{\link{smq_select}()}, \code{\link{tte_source}()}, -\code{\link{validate_query}()}, -\code{\link{validate_sdg_select}()}, -\code{\link{validate_smq_select}()} +\code{\link{validate_basket_select}()}, +\code{\link{validate_query}()} } \author{ Shimeng Huang, Ondrej Slama diff --git a/man/atoxgr_criteria_ctcv4.Rd b/man/atoxgr_criteria_ctcv4.Rd index adec72a788..edc1286c1a 100644 --- a/man/atoxgr_criteria_ctcv4.Rd +++ b/man/atoxgr_criteria_ctcv4.Rd @@ -15,7 +15,8 @@ Metadata Holding Grading Criteria for NCI-CTCAEv4 } \details{ This metadata has its origin in the ADLB Grading Spec Excel file which ships with \code{{admiral}} -and can be accessed using \code{system.file("adlb_grading/adlb_grading_spec.xlsx", package = "admiral")}. +and can be accessed using \code{system.file("adlb_grading/adlb_grading_spec.xlsx", package = "admiral")} +in sheet = "NCICTCAEv4". The dataset contained in there has the following columns: \itemize{ \item \code{SOC}: variable to hold the SOC of the lab test criteria. @@ -39,18 +40,17 @@ value. 'L' is for LOW values, 'H' is for HIGH values. Note: the variable is case Note: Variables \code{SOC}, \code{TERM}, \verb{Grade 1}, \verb{Grade 2},\verb{Grade 3},\verb{Grade 4},\verb{Grade 5}, \code{Definition} are from the source document on NCI-CTC website defining the grading criteria. +\href{https://ctep.cancer.gov/protocoldevelopment/electronic_applications/ctc.htm#ctc_40}{\strong{Common Terminology Criteria for Adverse Events (CTCAE)v4.0}} From these variables only 'TERM' is used in the {admiral} code, the rest are for information and tracability only. } \seealso{ -Other datasets: -\code{\link{admiral_adsl}}, -\code{\link{ex_single}}, -\code{\link{queries_mh}}, -\code{\link{queries}} +Other metadata: +\code{\link{atoxgr_criteria_ctcv5}}, +\code{\link{dose_freq_lookup}} } \author{ Gordon Miller } -\concept{datasets} -\keyword{datasets} +\concept{metadata} +\keyword{metadata} diff --git a/man/atoxgr_criteria_ctcv5.Rd b/man/atoxgr_criteria_ctcv5.Rd new file mode 100644 index 0000000000..f0b1ed9f00 --- /dev/null +++ b/man/atoxgr_criteria_ctcv5.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data.R +\docType{data} +\name{atoxgr_criteria_ctcv5} +\alias{atoxgr_criteria_ctcv5} +\title{Metadata Holding Grading Criteria for NCI-CTCAEv5} +\format{ +An object of class \code{tbl_df} (inherits from \code{tbl}, \code{data.frame}) with 37 rows and 13 columns. +} +\usage{ +atoxgr_criteria_ctcv5 +} +\description{ +Metadata Holding Grading Criteria for NCI-CTCAEv5 +} +\details{ +This metadata has its origin in the ADLB Grading Spec Excel file which ships with \code{{admiral}} +and can be accessed using \code{system.file("adlb_grading/adlb_grading_spec.xlsx", package = "admiral")} +in sheet = "NCICTCAEv5". +The dataset contained in there has the following columns: +\itemize{ +\item \code{SOC}: variable to hold the SOC of the lab test criteria. +\item \code{TERM}: variable to hold the term describing the criteria applied to a particular lab test, +eg. 'Anemia' or 'INR Increased'. Note: the variable is case insensitive. +\item \verb{Grade 1}: Criteria defining lab value as Grade 1. +\item \verb{Grade 2}: Criteria defining lab value as Grade 2. +\item \verb{Grade 3}: Criteria defining lab value as Grade 3. +\item \verb{Grade 4}: Criteria defining lab value as Grade 4. +\item \verb{Grade 5}: Criteria defining lab value as Grade 5. +\item \code{Definition}: Holds the definition of the lab test abnormality. +\item \code{GRADE_CRITERIA_CODE}: variable to hold code that creates grade based on defined criteria. +\item \code{SI_UNIT_CHECK}: variable to hold unit of particular lab test. Used to check against input data +if criteria is based on absolute values. +\item \code{VAR_CHECK}: List of variables required to implement lab grade criteria. Use to check against +input data. +\item \code{DIRECTION}: variable to hold the direction of the abnormality of a particular lab test +value. 'L' is for LOW values, 'H' is for HIGH values. Note: the variable is case insensitive. +\item \code{COMMENT}: Holds any information regarding rationale behind implementation of grading criteria. +} + +Note: Variables \code{SOC}, \code{TERM}, \verb{Grade 1}, \verb{Grade 2},\verb{Grade 3},\verb{Grade 4},\verb{Grade 5}, \code{Definition} +are from the source document on NCI-CTC website defining the grading criteria. +\href{https://ctep.cancer.gov/protocoldevelopment/electronic_applications/ctc.htm#ctc_50}{\strong{Common Terminology Criteria for Adverse Events (CTCAE)v5.0}} +From these variables only 'TERM' is used in the {admiral} code, the rest are for information and +traceability only. +} +\seealso{ +Other metadata: +\code{\link{atoxgr_criteria_ctcv4}}, +\code{\link{dose_freq_lookup}} +} +\author{ +Gordon Miller +} +\concept{metadata} +\keyword{metadata} diff --git a/man/basket_select.Rd b/man/basket_select.Rd new file mode 100644 index 0000000000..1a8fb33af6 --- /dev/null +++ b/man/basket_select.Rd @@ -0,0 +1,62 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/create_query_data.R +\name{basket_select} +\alias{basket_select} +\title{Create a \code{basket_select} object} +\usage{ +basket_select(name = NULL, id = NULL, scope = NULL, type) +} +\arguments{ +\item{name}{Name of the query used to select the definition of the query from +the company database.} + +\item{id}{Identifier of the query used to select the definition of the query +from the company database.} + +\item{scope}{Scope of the query used to select the definition of the query +from the company database. + +\emph{Permitted Values}: \code{"BROAD"}, \code{"NARROW"}, \code{NA_character_}} + +\item{type}{The type argument expects a character scalar. It is passed to the +company specific get_terms() function such that the function can determine +which sort of basket is requested} +} +\value{ +An object of class \code{basket_select}. +} +\description{ +Create a \code{basket_select} object +} +\details{ +Exactly one of \code{name} or \code{id} must be specified. +} +\seealso{ +\code{\link[=create_query_data]{create_query_data()}}, \code{\link[=query]{query()}} + +Source Specifications: +\code{\link{assert_db_requirements}()}, +\code{\link{assert_terms}()}, +\code{\link{assert_valid_queries}()}, +\code{\link{censor_source}()}, +\code{\link{date_source}()}, +\code{\link{death_event}}, +\code{\link{dthcaus_source}()}, +\code{\link{event_source}()}, +\code{\link{extend_source_datasets}()}, +\code{\link{filter_date_sources}()}, +\code{\link{format.basket_select}()}, +\code{\link{list_tte_source_objects}()}, +\code{\link{params}()}, +\code{\link{query}()}, +\code{\link{sdg_select}()}, +\code{\link{smq_select}()}, +\code{\link{tte_source}()}, +\code{\link{validate_basket_select}()}, +\code{\link{validate_query}()} +} +\author{ +Tamara Senior +} +\concept{source_specifications} +\keyword{source_specifications} diff --git a/man/call_derivation.Rd b/man/call_derivation.Rd index b7ba0b9965..e05c082880 100644 --- a/man/call_derivation.Rd +++ b/man/call_derivation.Rd @@ -75,7 +75,6 @@ adae \%>\% Higher Order Functions: \code{\link{derivation_slice}()}, -\code{\link{print.derivation_slice}()}, \code{\link{restrict_derivation}()}, \code{\link{slice_derivation}()} } diff --git a/man/censor_source.Rd b/man/censor_source.Rd index f59cd2083b..ca8f8fe0ca 100644 --- a/man/censor_source.Rd +++ b/man/censor_source.Rd @@ -45,6 +45,7 @@ An object of class \code{censor_source}, inheriting from class \code{tte_source} } \examples{ # Last study date known alive censor + censor_source( dataset_name = "adsl", date = LSTALVDT, @@ -62,23 +63,22 @@ Source Specifications: \code{\link{assert_db_requirements}()}, \code{\link{assert_terms}()}, \code{\link{assert_valid_queries}()}, +\code{\link{basket_select}()}, \code{\link{date_source}()}, \code{\link{death_event}}, -\code{\link{derive_var_dthcaus}()}, +\code{\link{dthcaus_source}()}, \code{\link{event_source}()}, \code{\link{extend_source_datasets}()}, \code{\link{filter_date_sources}()}, -\code{\link{format.sdg_select}()}, -\code{\link{format.smq_select}()}, +\code{\link{format.basket_select}()}, \code{\link{list_tte_source_objects}()}, \code{\link{params}()}, \code{\link{query}()}, \code{\link{sdg_select}()}, \code{\link{smq_select}()}, \code{\link{tte_source}()}, -\code{\link{validate_query}()}, -\code{\link{validate_sdg_select}()}, -\code{\link{validate_smq_select}()} +\code{\link{validate_basket_select}()}, +\code{\link{validate_query}()} } \author{ Stefan Bundfuss diff --git a/man/chr2vars.Rd b/man/chr2vars.Rd new file mode 100644 index 0000000000..8ab77d6868 --- /dev/null +++ b/man/chr2vars.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/user_utils.R +\name{chr2vars} +\alias{chr2vars} +\title{Turn a Character Vector into a List of Quosures} +\usage{ +chr2vars(chr) +} +\arguments{ +\item{chr}{A character vector} +} +\value{ +A \code{list} of \code{quosures} as returned by \code{\link[=vars]{vars()}} +} +\description{ +Turn a character vector into a list of quosures +} +\examples{ +chr2vars(c("USUBJID", "AVAL")) +} +\seealso{ +Other utils_quo: +\code{\link{negate_vars}()} +} +\author{ +Stefan Bundfuss +} +\concept{utils_quo} +\keyword{utils_quo} diff --git a/man/compute_duration.Rd b/man/compute_duration.Rd index 0212e3ccbe..814975252e 100644 --- a/man/compute_duration.Rd +++ b/man/compute_duration.Rd @@ -90,24 +90,26 @@ start to end date in the specified unit. If the end date is before the start date, the duration is negative. } \examples{ +library(lubridate) + # Derive duration in days (integer), i.e., relative day compute_duration( - start_date = lubridate::ymd_hms("2020-12-06T15:00:00"), - end_date = lubridate::ymd_hms("2020-12-24T08:15:00") + start_date = ymd_hms("2020-12-06T15:00:00"), + end_date = ymd_hms("2020-12-24T08:15:00") ) # Derive duration in days (float) compute_duration( - start_date = lubridate::ymd_hms("2020-12-06T15:00:00"), - end_date = lubridate::ymd_hms("2020-12-24T08:15:00"), + start_date = ymd_hms("2020-12-06T15:00:00"), + end_date = ymd_hms("2020-12-24T08:15:00"), floor_in = FALSE, add_one = FALSE ) # Derive age in years compute_duration( - start_date = lubridate::ymd("1984-09-06"), - end_date = lubridate::ymd("2020-02-24"), + start_date = ymd("1984-09-06"), + end_date = ymd("2020-02-24"), trunc_out = TRUE, out_unit = "years", add_one = FALSE @@ -115,8 +117,8 @@ compute_duration( # Derive duration in hours compute_duration( - start_date = lubridate::ymd_hms("2020-12-06T9:00:00"), - end_date = lubridate::ymd_hms("2020-12-06T13:30:00"), + start_date = ymd_hms("2020-12-06T9:00:00"), + end_date = ymd_hms("2020-12-06T13:30:00"), out_unit = "hours", floor_in = FALSE, add_one = FALSE, diff --git a/man/convert_blanks_to_na.Rd b/man/convert_blanks_to_na.Rd index 539538cd8f..f823fcf242 100644 --- a/man/convert_blanks_to_na.Rd +++ b/man/convert_blanks_to_na.Rd @@ -35,9 +35,11 @@ as is and applies the just described logic to \code{character} columns. Once aga all attributes such as labels are preserved. } \examples{ +library(tibble) + convert_blanks_to_na(c("a", "b", "", "d", "")) -df <- tibble::tibble( +df <- tibble( a = structure(c("a", "b", "", "c"), label = "A"), b = structure(c(1, NA, 21, 9), label = "B"), c = structure(c(TRUE, FALSE, TRUE, TRUE), label = "C"), @@ -48,6 +50,7 @@ convert_blanks_to_na(df) } \seealso{ Utilities for Formatting Observations: +\code{\link{convert_na_to_blanks}()}, \code{\link{format_eoxxstt_default}()}, \code{\link{format_reason_default}()}, \code{\link{yn_to_numeric}()} diff --git a/man/convert_na_to_blanks.Rd b/man/convert_na_to_blanks.Rd new file mode 100644 index 0000000000..627b9eb9f7 --- /dev/null +++ b/man/convert_na_to_blanks.Rd @@ -0,0 +1,62 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/user_utils.R +\name{convert_na_to_blanks} +\alias{convert_na_to_blanks} +\alias{convert_na_to_blanks.default} +\alias{convert_na_to_blanks.character} +\alias{convert_na_to_blanks.list} +\alias{convert_na_to_blanks.data.frame} +\title{Convert NAs Into Blank Strings} +\usage{ +convert_na_to_blanks(x) + +\method{convert_na_to_blanks}{default}(x) + +\method{convert_na_to_blanks}{character}(x) + +\method{convert_na_to_blanks}{list}(x) + +\method{convert_na_to_blanks}{data.frame}(x) +} +\arguments{ +\item{x}{Any R object} +} +\value{ +An object of the same class as the input +} +\description{ +Turn \code{NA}s to blank strings . +} +\details{ +The default methods simply returns its input unchanged. The \code{character} method +turns every instance of \code{NA_character_} or \code{NA} into \code{""} while preserving \emph{all} attributes. +When given a data frame as input the function keeps all non-character columns +as is and applies the just described logic to \code{character} +all attributes such as labels are preserved. +} +\examples{ +library(tibble) + +convert_na_to_blanks(c("a", "b", NA, "d", NA)) + +df <- tibble( + a = structure(c("a", "b", NA, "c"), label = "A"), + b = structure(c(1, NA, 21, 9), label = "B"), + c = structure(c(TRUE, FALSE, TRUE, TRUE), label = "C"), + d = structure(c(NA, NA, "s", "q"), label = "D") +) +print(df) +convert_na_to_blanks(df) +} +\seealso{ +Utilities for Formatting Observations: +\code{\link{convert_blanks_to_na}()}, +\code{\link{format_eoxxstt_default}()}, +\code{\link{format_reason_default}()}, +\code{\link{yn_to_numeric}()} +} +\author{ +Sadchla Mascary +} +\concept{utils_fmt} +\keyword{utils_fmt} diff --git a/man/count_vals.Rd b/man/count_vals.Rd index b83512a2f8..cae0224ac7 100644 --- a/man/count_vals.Rd +++ b/man/count_vals.Rd @@ -17,9 +17,9 @@ Count number of observations where a variable equals a value. \examples{ library(tibble) -library(dplyr) +library(dplyr, warn.conflicts = FALSE) library(admiral) -data <- tibble::tribble( +data <- tribble( ~USUBJID, ~AVISITN, ~AVALC, "1", 1, "PR", "1", 2, "CR", diff --git a/man/create_period_dataset.Rd b/man/create_period_dataset.Rd new file mode 100644 index 0000000000..0d6e4e133c --- /dev/null +++ b/man/create_period_dataset.Rd @@ -0,0 +1,133 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/period_dataset.R +\name{create_period_dataset} +\alias{create_period_dataset} +\title{Create a Reference Dataset for Subperiods, Periods, or Phases} +\usage{ +create_period_dataset( + dataset, + new_vars, + subject_keys = get_admiral_option("subject_keys") +) +} +\arguments{ +\item{dataset}{ADSL dataset + +The variables specified by \code{new_vars} and \code{subject_keys} are expected. For +each element of \code{new_vars} at least one variable of the form of the right +hand side value must be available in the dataset.} + +\item{new_vars}{New variables + +A named list of variables like \code{vars(PHSDT = PHwSDT, PHEDT = PHwEDT, APHASE = APHASEw)} is expected. The left hand side of the elements defines a +variable of the output dataset, the right hand side defines the source +variables from the ADSL dataset in CDISC notation. + +If the lower case letter "w" is used it refers to a phase variable, if the +lower case letters "xx" are used it refers to a period variable, and if +both "xx" and "w" are used it refers to a subperiod variable. + +Only one type must be used, e.g., all right hand side values must refer to +period variables. It is not allowed to mix for example period and subperiod +variables. If period \emph{and} subperiod variables are required, separate +reference datasets must be created.} + +\item{subject_keys}{Variables to uniquely identify a subject + +A list of quosures where the expressions are symbols as returned by +\code{vars()} is expected.} +} +\value{ +A period reference dataset (see "Details" section) +} +\description{ +The function creates a reference dataset for subperiods, periods, or phases +from the \code{ADSL} dataset. The reference dataset can be used to derive +subperiod, period, or phase variables like \code{ASPER}, \code{ASPRSDT}, \code{ASPREDT}, +\code{APERIOD}, \code{APERSDT}, \code{APEREDT}, \code{TRTA}, \code{APHASEN}, \code{PHSDTM}, \code{PHEDTM}, ... +in OCCDS and BDS datasets. +} +\details{ +For each subject and each subperiod/period/phase where at least one +of the source variable is not \code{NA} an observation is added to the output +dataset. + +Depending on the type of the source variable (subperiod, period, or phase) +the variable \code{ASPER}, \code{APERIOD}, or \code{APHASEN} is added and set to the +number of the subperiod, period, or phase. + +The variables specified for \code{new_vars} (left hand side) are added to the +output dataset and set to the value of the source variable (right hand +side). +} +\examples{ +library(tibble) +library(dplyr, warn.conflicts = FALSE) +library(lubridate) + +# Create reference dataset for periods +adsl <- tribble( + ~USUBJID, ~AP01SDT, ~AP01EDT, ~AP02SDT, ~AP02EDT, ~TRT01A, ~TRT02A, + "1", "2021-01-04", "2021-02-06", "2021-02-07", "2021-03-07", "A", "B", + "2", "2021-02-02", "2021-03-02", "2021-03-03", "2021-04-01", "B", "A", +) \%>\% + mutate( + across(matches("AP\\\\d\\\\d[ES]DT"), ymd) + ) \%>\% + mutate( + STUDYID = "xyz" + ) + +create_period_dataset( + adsl, + new_vars = vars(APERSDT = APxxSDT, APEREDT = APxxEDT, TRTA = TRTxxA) +) + +# Create reference dataset for phases +adsl <- tribble( + ~USUBJID, ~PH1SDT, ~PH1EDT, ~PH2SDT, ~PH2EDT, ~APHASE1, ~APHASE2, + "1", "2021-01-04", "2021-02-06", "2021-02-07", "2021-03-07", "TREATMENT", "FUP", + "2", "2021-02-02", "2021-03-02", NA, NA, "TREATMENT", NA +) \%>\% + mutate( + across(matches("PH\\\\d[ES]DT"), ymd) + ) \%>\% + mutate( + STUDYID = "xyz" + ) + +create_period_dataset( + adsl, + new_vars = vars(PHSDT = PHwSDT, PHEDT = PHwEDT, APHASE = APHASEw) +) + +# Create reference datasets for subperiods +adsl <- tribble( + ~USUBJID, ~P01S1SDT, ~P01S1EDT, ~P01S2SDT, ~P01S2EDT, ~P02S1SDT, ~P02S1EDT, + "1", "2021-01-04", "2021-01-19", "2021-01-20", "2021-02-06", "2021-02-07", "2021-03-07", + "2", "2021-02-02", "2021-03-02", NA, NA, "2021-03-03", "2021-04-01" +) \%>\% + mutate( + across(matches("P\\\\d\\\\dS\\\\d[ES]DT"), ymd) + ) \%>\% + mutate( + STUDYID = "xyz" + ) + +create_period_dataset( + adsl, + new_vars = vars(ASPRSDT = PxxSwSDT, ASPREDT = PxxSwEDT) +) +} +\seealso{ +\code{\link[=derive_vars_period]{derive_vars_period()}} + +Creating auxiliary datasets: +\code{\link{create_query_data}()}, +\code{\link{create_single_dose_dataset}()} +} +\author{ +Stefan Bundfuss +} +\concept{create_aux} +\keyword{create_aux} diff --git a/man/create_query_data.Rd b/man/create_query_data.Rd index a4fe663d03..65aaedc2f9 100644 --- a/man/create_query_data.Rd +++ b/man/create_query_data.Rd @@ -7,10 +7,12 @@ \usage{ create_query_data( queries, - meddra_version = NULL, - whodd_version = NULL, - get_smq_fun = NULL, - get_sdg_fun = NULL + meddra_version = deprecated(), + whodd_version = deprecated(), + version = NULL, + get_smq_fun = deprecated(), + get_sdg_fun = deprecated(), + get_terms_fun = NULL ) } \arguments{ @@ -18,95 +20,58 @@ create_query_data( A list of \code{query()} objects is expected.} -\item{meddra_version}{MedDRA version +\item{meddra_version}{\emph{Deprecated}, please use \code{version}} -The MedDRA version used for coding the terms in the AE dataset should be -specified. If any of the queries is a SMQ or a customized query including a -SMQ, the parameter needs to be specified. +\item{whodd_version}{\emph{Deprecated}, please use \code{version}} -\emph{Permitted Values}: A character string (the expected format is -company-specific)} - -\item{whodd_version}{WHO Drug Dictionary version +\item{version}{Dictionary version -The version of the WHO Drug Dictionary used for coding the terms in the CM -dataset should be specified. If any of the queries is a SDG, the parameter -needs to be specified. +The dictionary version used for coding the terms should be specified. +If any of the queries is a basket (SMQ, SDG, ....) or a customized query +including a basket, the parameter needs to be specified. \emph{Permitted Values}: A character string (the expected format is company-specific)} -\item{get_smq_fun}{Function which returns the terms of an SMQ - -For each query specified for the \code{queries} parameter which refers to an SMQ -(i.e., those where the \code{definition} field is set to a \code{smq_select()} object -or a list which contains at least one \code{smq_select()} object) the specified -function is called to retrieve the terms defining the query. This function -is not provided by admiral as it is company specific, i.e., it has to be -implemented at company level. - -The function must return a dataset with all the terms defining the SMQ. The -output dataset must contain the following variables. -\itemize{ -\item \code{TERM_LEVEL}: the variable to be used for defining a term of the SMQ, e.g., -\code{AEDECOD} -\item \code{TERM_NAME}: the name of the term if the variable \code{TERM_LEVEL} is -referring to is character -\item \code{TERM_ID} the numeric id of the term if the variable \code{TERM_LEVEL} is -referring to is numeric -\item \code{QUERY_NAME}: the name of the SMQ. The values must be the same for all -observations. -} +\item{get_smq_fun}{\emph{Deprecated}, please use \code{get_terms_fun}} -The function must provide the following parameters -\itemize{ -\item \code{smq_select}: A \code{smq_select()} object. -\item \code{version}: The MedDRA version. The value specified for the -\code{meddra_version} in the \code{create_query_data()} call is passed to this -parameter. -\item \code{keep_id}: If set to \code{TRUE}, the output dataset must contain the -\code{QUERY_ID} variable. The variable must be set to the numeric id of the SMQ. -\item \code{temp_env}: A temporary environment is passed to this parameter. It can -be used to store data which is used for all SMQs in the -\code{create_query_data()} call. For example if the SMQs need to be read from a -database all SMQs can be read and stored in the environment when the first -SMQ is handled. For the other SMQs the terms can be retrieved from the -environment instead of accessing the database again. -}} +\item{get_sdg_fun}{\emph{Deprecated}, please use \code{get_terms_fun}} -\item{get_sdg_fun}{Function which returns the terms of an SDG +\item{get_terms_fun}{Function which returns the terms -For each query specified for the \code{queries} parameter which refers to an SDG -the specified function is called to retrieve the terms defining the query. +For each query specified for the \code{queries} parameter referring to a basket +(i.e., those where the \code{definition} field is set to a \code{basket_select()} +object or a list which contains at least one \code{basket_select()} object) the +specified function is called to retrieve the terms defining the query. This function is not provided by admiral as it is company specific, i.e., it has to be implemented at company level. -The function must return a dataset with all the terms defining the SDG. The -output dataset must contain the following variables. +The function must return a dataset with all the terms defining the basket. +The output dataset must contain the following variables. \itemize{ -\item \code{TERM_LEVEL}: the variable to be used for defining a term of the SDG, e.g., -\code{CMDECOD} +\item \code{TERM_LEVEL}: the variable to be used for defining a term of the basket, +e.g., \code{AEDECOD} \item \code{TERM_NAME}: the name of the term if the variable \code{TERM_LEVEL} is referring to is character \item \code{TERM_ID} the numeric id of the term if the variable \code{TERM_LEVEL} is referring to is numeric -\item \code{QUERY_NAME}: the name of the SDG. The values must be the same for all -observations. +\item \code{QUERY_NAME}: the name of the basket. The values must be the same for +all observations. } The function must provide the following parameters \itemize{ -\item \code{sdg_select}: A \code{sdg_select()} object. -\item \code{version}: The WHO drug dictionary version. The value specified for the -\code{whodd_version} in the \code{create_query_data()} call is passed to this +\item \code{basket_select}: A \code{basket_select()} object. +\item \code{version}: The dictionary version. The value specified for the +\code{version} in the \code{create_query_data()} call is passed to this parameter. \item \code{keep_id}: If set to \code{TRUE}, the output dataset must contain the -\code{QUERY_ID} variable. The variable must be set to the numeric id of the SDG. +\code{QUERY_ID} variable. The variable must be set to the numeric id of the basket. \item \code{temp_env}: A temporary environment is passed to this parameter. It can -be used to store data which is used for all SDGs in the -\code{create_query_data()} call. For example if the SDGs need to be read from a -database all SDGs can be read and stored in the environment when the first -SDG is handled. For the other SDGs the terms can be retrieved from the +be used to store data which is used for all baskets in the +\code{create_query_data()} call. For example if SMQs need to be read from a +database all SMQs can be read and stored in the environment when the first +SMQ is handled. For the other SMQs the terms can be retrieved from the environment instead of accessing the database again. }} } @@ -124,14 +89,12 @@ to the query (\code{TERM_LEVEL}, \code{TERM_NAME}, \code{TERM_ID}) are determine to the \code{definition} field of the query: if the definition field of the \code{query()} object is \itemize{ -\item an \code{smq_select()} object, the terms are read from the SMQ -database by calling the function specified for the \code{get_smq_fun} parameter. -\item an \code{sdg_select()} object, the terms are read from the SDG -database by calling the function specified for the \code{get_sdg_fun} parameter. +\item a \code{basket_select()} object, the terms are read from the basket +database by calling the function specified for the \code{get_terms_fun} parameter. \item a data frame, the terms stored in the data frame are used. -\item a list of data frames and \code{smq_select()} objects, all terms from -the data frames and all terms read from the SMQ database referenced by the -\code{smq_select()} objects are collated. +\item a list of data frames and \code{basket_select()} objects, all terms from +the data frames and all terms read from the basket database referenced by the +\code{basket_select()} objects are collated. } The following variables (as described in \href{../articles/queries_dataset.html}{Queries Dataset Documentation}) are created: @@ -143,22 +106,23 @@ The following variables (as described in \href{../articles/queries_dataset.html} element is not specified for a query, the variable is set to \code{NA}. If the \code{id} element is not specified for any query, the variable is not created. \item \code{QUERY_SCOPE}: scope of the query as specified by the \code{scope} element of -the \code{smq_select()} object. For queries not defined by a \code{smq_select()} +the \code{basket_select()} object. For queries not defined by a \code{basket_select()} object, the variable is set to \code{NA}. If none of the queries is defined by a -\code{smq_select()} object, the variable is not created. +\code{basket_select()} object, the variable is not created. \item \code{QUERY_SCOPE_NUM}: numeric scope of the query. It is set to \code{1} if the -scope is broad. Otherwise it is set to '2'. If the \code{add_scope_num} element +scope is broad. Otherwise it is set to \code{2}. If the \code{add_scope_num} element equals \code{FALSE}, the variable is set to \code{NA}. If the \code{add_scope_num} element -equals \code{FALSE} for all SMQs or none of the queries is an SMQ , the variable +equals \code{FALSE} for all baskets or none of the queries is an basket , the variable is not created. \item \code{TERM_LEVEL}: Name of the variable used to identify the terms. \item \code{TERM_NAME}: Value of the term variable if it is a character variable. \item \code{TERM_ID}: Value of the term variable if it is a numeric variable. +\item \code{VERSION}: Set to the value of the \code{version} argument. If it is not +specified, the variable is not created. } } \examples{ library(tibble) -library(magrittr, warn.conflicts = FALSE) library(dplyr, warn.conflicts = FALSE) library(admiral.test) library(admiral) @@ -183,47 +147,51 @@ create_query_data(queries = list(cq)) pregsmq <- query( prefix = "SMQ02", id = auto, - definition = smq_select( + definition = basket_select( name = "Pregnancy and neonatal topics (SMQ)", - scope = "NARROW" + scope = "NARROW", + type = "smq" ) ) bilismq <- query( prefix = "SMQ04", - definition = smq_select( + definition = basket_select( id = 20000121L, - scope = "BROAD" + scope = "BROAD", + type = "smq" ) ) -# The get_smq_terms function from admiral.test is used for this example. +# The get_terms function from admiral.test is used for this example. # In a real application a company-specific function must be used. create_query_data( queries = list(pregsmq, bilismq), - get_smq_fun = admiral.test:::get_smq_terms, - meddra_version = "20.1" + get_terms_fun = admiral.test:::get_terms, + version = "20.1" ) # create a query dataset for SDGs sdg <- query( prefix = "SDG01", id = auto, - definition = sdg_select( - name = "5-aminosalicylates for ulcerative colitis" + definition = basket_select( + name = "5-aminosalicylates for ulcerative colitis", + scope = NA_character_, + type = "sdg" ) ) -# The get_sdg_terms function from admiral.test is used for this example. +# The get_terms function from admiral.test is used for this example. # In a real application a company-specific function must be used. create_query_data( queries = list(sdg), - get_sdg_fun = admiral.test:::get_sdg_terms, - whodd_version = "2019-09" + get_terms_fun = admiral.test:::get_terms, + version = "2019-09" ) # creating a query dataset for a customized query including SMQs -# The get_smq_terms function from admiral.test is used for this example. +# The get_terms function from admiral.test is used for this example. # In a real application a company-specific function must be used. create_query_data( queries = list( @@ -231,29 +199,28 @@ create_query_data( prefix = "CQ03", name = "Special issues of interest", definition = list( - smq_select( + basket_select( name = "Pregnancy and neonatal topics (SMQ)", - scope = "NARROW" + scope = "NARROW", + type = "smq" ), cqterms ) ) ), - get_smq_fun = admiral.test:::get_smq_terms, - meddra_version = "20.1" + get_terms_fun = admiral.test:::get_terms, + version = "20.1" ) } \seealso{ -\code{\link[=derive_vars_query]{derive_vars_query()}}, \code{\link[=query]{query()}}, \code{\link[=smq_select]{smq_select()}}, \code{\link[=sdg_select]{sdg_select()}}, \href{../articles/queries_dataset.html}{Queries Dataset Documentation} +\code{\link[=derive_vars_query]{derive_vars_query()}}, \code{\link[=query]{query()}}, \code{\link[=basket_select]{basket_select()}}, \href{../articles/queries_dataset.html}{Queries Dataset Documentation} -OCCDS Functions: -\code{\link{create_single_dose_dataset}()}, -\code{\link{derive_vars_atc}()}, -\code{\link{derive_vars_query}()}, -\code{\link{get_terms_from_db}()} +Creating auxiliary datasets: +\code{\link{create_period_dataset}()}, +\code{\link{create_single_dose_dataset}()} } \author{ -Stefan Bundfuss +Stefan Bundfuss, Tamara Senior } -\concept{der_occds} -\keyword{der_occds} +\concept{create_aux} +\keyword{create_aux} diff --git a/man/create_single_dose_dataset.Rd b/man/create_single_dose_dataset.Rd index 39abbd53e8..eb10713230 100644 --- a/man/create_single_dose_dataset.Rd +++ b/man/create_single_dose_dataset.Rd @@ -8,12 +8,13 @@ create_single_dose_dataset( dataset, dose_freq = EXDOSFRQ, start_date = ASTDT, - start_datetime = ASTDTM, + start_datetime = NULL, end_date = AENDT, - end_datetime = AENDTM, + end_datetime = NULL, lookup_table = dose_freq_lookup, lookup_column = CDISC_VALUE, - keep_source_vars = vars(USUBJID, EXDOSFRQ, ASTDT, ASTDTM, AENDT, AENDTM) + keep_source_vars = quo_c(vars(USUBJID), dose_freq, start_date, start_datetime, + end_date, end_datetime) ) } \arguments{ @@ -26,8 +27,6 @@ parameters are expected.} The aggregate dosing frequency used for multiple doses in a row. -Default: \code{EXDOSFRQ} - Permitted Values: defined by lookup table.} \item{start_date}{The start date @@ -35,9 +34,7 @@ Permitted Values: defined by lookup table.} A date object is expected. This object cannot contain \code{NA} values. Refer to \code{derive_vars_dt()} to impute and derive a date from a date -character vector to a date object. - -Default: \code{ASTDT}} +character vector to a date object.} \item{start_datetime}{The start date-time @@ -46,16 +43,15 @@ A date-time object is expected. This object cannot contain \code{NA} values. Refer to \code{derive_vars_dtm()} to impute and derive a date-time from a date character vector to a date object. -Default: \code{ASTDTM}} +If the input dataset contains frequencies which refer to \code{DOSE_WINDOW} +equals \code{"HOUR"} or \code{"MINUTE"}, the parameter must be specified.} \item{end_date}{The end date A date or date-time object is expected. This object cannot contain \code{NA} values. Refer to \code{derive_vars_dt()} to impute and derive a date from a date -character vector to a date object. - -Default: \code{AENDT}} +character vector to a date object.} \item{end_datetime}{The end date-time @@ -64,7 +60,8 @@ A date-time object is expected. This object cannot contain \code{NA} values. Refer to \code{derive_vars_dtm()} to impute and derive a date-time from a date character vector to a date object. -Default: \code{AENDTM}} +If the input dataset contains frequencies which refer to \code{DOSE_WINDOW} +equals \code{"HOUR"} or \code{"MINUTE"}, the parameter must be specified.} \item{lookup_table}{The dose frequency value lookup table @@ -74,20 +71,18 @@ default is used, it must have columns \code{DOSE_WINDOW}, \code{DOSE_COUNT}, and \code{CONVERSION_FACTOR}. The default table \code{dose_freq_lookup} is described in detail \link[=dose_freq_lookup]{here}. -Default: \code{dose_freq_lookup} - Permitted Values for \code{DOSE_WINDOW}: \code{"MINUTE"}, \code{"HOUR"}, \code{"DAY"}, \code{"WEEK"}, \code{"MONTH"}, \code{"YEAR"}} \item{lookup_column}{The dose frequency value column in the lookup table -The column of \code{lookup_table}. - -Default: \code{CDISC_VALUE} (column of \code{dose_freq_lookup})} +The column of \code{lookup_table}.} \item{keep_source_vars}{List of variables to be retained from source dataset -Default: vars(USUBJID, EXDOSFRQ, ASTDT, ASTDTM, AENDT, AENDTM)} +This parameter can be specified if additional information is required in +the output dataset. For example \code{EXTRT} for studies with more than one +drug.} } \value{ The input dataset with a single dose per row. @@ -105,14 +100,18 @@ calculated with \code{compute_duration} and multiplied by \code{DOSE_COUNT}. For \code{DOSE_WINDOW} values of \code{"WEEK"}, \code{"MONTH"}, and \code{"YEAR"}, \code{CONVERSION_FACTOR} is used to convert into days the time object to be added to \code{start_date}. + +Observations with dose frequency \code{"ONCE"} are copied to the output dataset +unchanged. } \examples{ # Example with default lookup library(lubridate) library(stringr) +library(tibble) -data <- tibble::tribble( +data <- tribble( ~USUBJID, ~EXDOSFRQ, ~ASTDT, ~ASTDTM, ~AENDT, ~AENDTM, "P01", "Q2D", ymd("2021-01-01"), ymd_hms("2021-01-01 10:30:00"), ymd("2021-01-07"), ymd_hms("2021-01-07 11:30:00"), @@ -127,13 +126,13 @@ create_single_dose_dataset(data) # Example with custom lookup -custom_lookup <- tibble::tribble( - ~Value, ~DOSE_COUNT, ~DOSE_WINDOW, ~CONVERSION_FACTOR, - "Q30MIN", (1 / 30), "MINUTE", 1, - "Q90MIN", (1 / 90), "MINUTE", 1 +custom_lookup <- tribble( + ~Value, ~DOSE_COUNT, ~DOSE_WINDOW, ~CONVERSION_FACTOR, + "Q30MIN", (1 / 30), "MINUTE", 1, + "Q90MIN", (1 / 90), "MINUTE", 1 ) -data <- tibble::tribble( +data <- tribble( ~USUBJID, ~EXDOSFRQ, ~ASTDT, ~ASTDTM, ~AENDT, ~AENDTM, "P01", "Q30MIN", ymd("2021-01-01"), ymd_hms("2021-01-01T06:00:00"), ymd("2021-01-01"), ymd_hms("2021-01-01T07:00:00"), @@ -143,18 +142,18 @@ data <- tibble::tribble( create_single_dose_dataset(data, lookup_table = custom_lookup, - lookup_column = Value + lookup_column = Value, + start_datetime = ASTDTM, + end_datetime = AENDTM ) } \seealso{ -OCCDS Functions: -\code{\link{create_query_data}()}, -\code{\link{derive_vars_atc}()}, -\code{\link{derive_vars_query}()}, -\code{\link{get_terms_from_db}()} +Creating auxiliary datasets: +\code{\link{create_period_dataset}()}, +\code{\link{create_query_data}()} } \author{ Michael Thorpe, Andrew Smith } -\concept{der_occds} -\keyword{der_occds} +\concept{create_aux} +\keyword{create_aux} diff --git a/man/date_source.Rd b/man/date_source.Rd index 5087e73318..e1e9454c10 100644 --- a/man/date_source.Rd +++ b/man/date_source.Rd @@ -43,6 +43,31 @@ An object of class \code{date_source}. Create a \code{date_source} object as input for \code{derive_var_extreme_dt()} and \code{derive_var_extreme_dtm()}. } +\examples{ + +# treatment end date from ADSL +trt_end_date <- date_source( + dataset_name = "adsl", + date = TRTEDT +) + +# lab date from LB where assessment was taken, i.e. not "NOT DONE" +lb_date <- date_source( + dataset_name = "lb", + filter = LBSTAT != "NOT DONE" | is.na(LBSTAT), + date = LBDT +) + +# death date from ADSL including traceability variables +death_date <- date_source( + dataset_name = "adsl", + date = DTHDT, + traceability_vars = vars( + LALVDOM = "ADSL", + LALVVAR = "DTHDT" + ) +) +} \seealso{ \code{\link[=derive_var_extreme_dtm]{derive_var_extreme_dtm()}}, \code{\link[=derive_var_extreme_dt]{derive_var_extreme_dt()}} @@ -50,23 +75,22 @@ Source Specifications: \code{\link{assert_db_requirements}()}, \code{\link{assert_terms}()}, \code{\link{assert_valid_queries}()}, +\code{\link{basket_select}()}, \code{\link{censor_source}()}, \code{\link{death_event}}, -\code{\link{derive_var_dthcaus}()}, +\code{\link{dthcaus_source}()}, \code{\link{event_source}()}, \code{\link{extend_source_datasets}()}, \code{\link{filter_date_sources}()}, -\code{\link{format.sdg_select}()}, -\code{\link{format.smq_select}()}, +\code{\link{format.basket_select}()}, \code{\link{list_tte_source_objects}()}, \code{\link{params}()}, \code{\link{query}()}, \code{\link{sdg_select}()}, \code{\link{smq_select}()}, \code{\link{tte_source}()}, -\code{\link{validate_query}()}, -\code{\link{validate_sdg_select}()}, -\code{\link{validate_smq_select}()} +\code{\link{validate_basket_select}()}, +\code{\link{validate_query}()} } \author{ Stefan Bundfuss diff --git a/man/default_qtc_paramcd.Rd b/man/default_qtc_paramcd.Rd index ed38b62288..d0902f7a7b 100644 --- a/man/default_qtc_paramcd.Rd +++ b/man/default_qtc_paramcd.Rd @@ -24,13 +24,14 @@ default_qtc_paramcd("Sagie") \seealso{ BDS-Findings Functions for adding Parameters/Records: \code{\link{derive_extreme_records}()}, +\code{\link{derive_locf_records}()}, \code{\link{derive_param_bmi}()}, \code{\link{derive_param_bsa}()}, \code{\link{derive_param_computed}()}, \code{\link{derive_param_doseint}()}, \code{\link{derive_param_exist_flag}()}, \code{\link{derive_param_exposure}()}, -\code{\link{derive_param_first_event}()}, +\code{\link{derive_param_extreme_event}()}, \code{\link{derive_param_framingham}()}, \code{\link{derive_param_map}()}, \code{\link{derive_param_qtc}()}, diff --git a/man/derivation_slice.Rd b/man/derivation_slice.Rd index d6080f1659..923b990a01 100644 --- a/man/derivation_slice.Rd +++ b/man/derivation_slice.Rd @@ -27,7 +27,6 @@ Create a \code{derivation_slice} object as input for \code{slice_derivation()}. Higher Order Functions: \code{\link{call_derivation}()}, -\code{\link{print.derivation_slice}()}, \code{\link{restrict_derivation}()}, \code{\link{slice_derivation}()} } diff --git a/man/derive_derived_param.Rd b/man/derive_derived_param.Rd index 4bd2d1eb84..06450f10be 100644 --- a/man/derive_derived_param.Rd +++ b/man/derive_derived_param.Rd @@ -93,6 +93,7 @@ This function is deprecated. Please use \code{derive_param-computed()} instead. } \seealso{ Other deprecated: +\code{\link{derive_param_first_event}()}, \code{\link{derive_var_aendy}()} } \author{ diff --git a/man/derive_extreme_records.Rd b/man/derive_extreme_records.Rd index c3b08fed5c..45331d8c6d 100644 --- a/man/derive_extreme_records.Rd +++ b/man/derive_extreme_records.Rd @@ -97,7 +97,9 @@ the selected observations. } } \examples{ -adlb <- tibble::tribble( +library(tibble) + +adlb <- tribble( ~USUBJID, ~AVISITN, ~AVAL, ~LBSEQ, "1", 1, 113, 1, "1", 2, 113, 2, @@ -153,13 +155,14 @@ derive_extreme_records( \seealso{ BDS-Findings Functions for adding Parameters/Records: \code{\link{default_qtc_paramcd}()}, +\code{\link{derive_locf_records}()}, \code{\link{derive_param_bmi}()}, \code{\link{derive_param_bsa}()}, \code{\link{derive_param_computed}()}, \code{\link{derive_param_doseint}()}, \code{\link{derive_param_exist_flag}()}, \code{\link{derive_param_exposure}()}, -\code{\link{derive_param_first_event}()}, +\code{\link{derive_param_extreme_event}()}, \code{\link{derive_param_framingham}()}, \code{\link{derive_param_map}()}, \code{\link{derive_param_qtc}()}, diff --git a/man/derive_locf_records.Rd b/man/derive_locf_records.Rd new file mode 100644 index 0000000000..9206c05ea2 --- /dev/null +++ b/man/derive_locf_records.Rd @@ -0,0 +1,127 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/derive_locf_records.R +\name{derive_locf_records} +\alias{derive_locf_records} +\title{Derive LOCF (Last Observation Carried Forward) Records} +\usage{ +derive_locf_records(dataset, dataset_expected_obs, by_vars, order) +} +\arguments{ +\item{dataset}{Input dataset + +The columns specified by the \code{by_vars} and the \code{order} +parameter are expected.} + +\item{dataset_expected_obs}{Expected observations dataset + +Data frame with all the combinations of \code{PARAMCD}, \code{PARAM}, \code{AVISIT}, +\code{AVISITN}, ... which are expected in the dataset is expected.} + +\item{by_vars}{Grouping variables + +For each group defined by \code{by_vars} those observations from \code{dataset_expected_obs} +are added to the output dataset which do not have a corresponding observation +in the input dataset or for which \code{AVAL} is NA for the corresponding observation +in the input dataset. Only variables specified in \code{by_vars} will be populated +in the newly created records.} + +\item{order}{List of variables for sorting a dataset + +The dataset is sorted by \code{order} before carrying the last +observation forward (eg. \code{AVAL}) within each \code{by_vars}.} +} +\value{ +The input dataset with the new "LOCF" observations added for each +\code{by_vars}. Note, a variable will only be populated in the new parameter rows +if it is specified in \code{by_vars}. +} +\description{ +Adds LOCF records as new observations for each 'by group' when the dataset +does not contain observations for missed visits/time points. +} +\details{ +For each group (with respect to the variables specified for the +by_vars parameter) those observations from dataset_expected_obs are added to +the output dataset +\itemize{ +\item which do not have a corresponding observation in the input dataset or +\item for which \code{AVAL} is NA for the corresponding observation in the input dataset. + +For the new observations, \code{AVAL} is set to the non-missing \code{AVAL} of the +previous observation in the input dataset (when sorted by \code{order}) and +\code{DTYPE} is set to "LOCF". +} +} +\examples{ + +library(dplyr) +library(tibble) + +advs <- tribble( + ~STUDYID, ~USUBJID, ~PARAMCD, ~AVAL, ~AVISITN, ~AVISIT, + "CDISC01", "01-701-1015", "PULSE", 61, 0, "BASELINE", + "CDISC01", "01-701-1015", "PULSE", 60, 2, "WEEK 6", + "CDISC01", "01-701-1015", "DIABP", 51, 0, "BASELINE", + "CDISC01", "01-701-1015", "DIABP", 50, 2, "WEEK 2", + "CDISC01", "01-701-1015", "DIABP", 51, 4, "WEEK 4", + "CDISC01", "01-701-1015", "DIABP", 50, 6, "WEEK 6", + "CDISC01", "01-701-1015", "SYSBP", 121, 0, "BASELINE", + "CDISC01", "01-701-1015", "SYSBP", 121, 2, "WEEK 2", + "CDISC01", "01-701-1015", "SYSBP", 121, 4, "WEEK 4", + "CDISC01", "01-701-1015", "SYSBP", 121, 6, "WEEK 6", + "CDISC01", "01-701-1028", "PULSE", 65, 0, "BASELINE", + "CDISC01", "01-701-1028", "DIABP", 79, 0, "BASELINE", + "CDISC01", "01-701-1028", "DIABP", 80, 2, "WEEK 2", + "CDISC01", "01-701-1028", "DIABP", NA, 4, "WEEK 4", + "CDISC01", "01-701-1028", "DIABP", NA, 6, "WEEK 6", + "CDISC01", "01-701-1028", "SYSBP", 130, 0, "BASELINE", + "CDISC01", "01-701-1028", "SYSBP", 132, 2, "WEEK 2" +) + + +# A dataset with all the combinations of PARAMCD, PARAM, AVISIT, AVISITN, ... which are expected. +advs_expected_obsv <- tibble::tribble( + ~PARAMCD, ~AVISITN, ~AVISIT, + "PULSE", 0, "BASELINE", + "PULSE", 6, "WEEK 6", + "DIABP", 0, "BASELINE", + "DIABP", 2, "WEEK 2", + "DIABP", 4, "WEEK 4", + "DIABP", 6, "WEEK 6", + "SYSBP", 0, "BASELINE", + "SYSBP", 2, "WEEK 2", + "SYSBP", 4, "WEEK 4", + "SYSBP", 6, "WEEK 6" +) + +derive_locf_records( + data = advs, + dataset_expected_obs = advs_expected_obsv, + by_vars = vars(STUDYID, USUBJID, PARAMCD), + order = vars(AVISITN, AVISIT) +) + +} +\seealso{ +BDS-Findings Functions for adding Parameters/Records: +\code{\link{default_qtc_paramcd}()}, +\code{\link{derive_extreme_records}()}, +\code{\link{derive_param_bmi}()}, +\code{\link{derive_param_bsa}()}, +\code{\link{derive_param_computed}()}, +\code{\link{derive_param_doseint}()}, +\code{\link{derive_param_exist_flag}()}, +\code{\link{derive_param_exposure}()}, +\code{\link{derive_param_extreme_event}()}, +\code{\link{derive_param_framingham}()}, +\code{\link{derive_param_map}()}, +\code{\link{derive_param_qtc}()}, +\code{\link{derive_param_rr}()}, +\code{\link{derive_param_wbc_abs}()}, +\code{\link{derive_summary_records}()} +} +\author{ +G Gayatri +} +\concept{der_prm_bds_findings} +\keyword{der_prm_bds_findings} diff --git a/man/derive_param_bmi.Rd b/man/derive_param_bmi.Rd index 467251ce76..24a9559109 100644 --- a/man/derive_param_bmi.Rd +++ b/man/derive_param_bmi.Rd @@ -81,7 +81,9 @@ The analysis value of the new parameter is derived as \deqn{BMI = \frac{WEIGHT}{HEIGHT^2}} } \examples{ -advs <- tibble::tribble( +library(tibble) + +advs <- tribble( ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVISIT, "01-701-1015", "HEIGHT", "Height (cm)", 147, "SCREENING", "01-701-1015", "WEIGHT", "Weight (kg)", 54.0, "SCREENING", @@ -109,12 +111,13 @@ derive_param_bmi( BDS-Findings Functions for adding Parameters/Records: \code{\link{default_qtc_paramcd}()}, \code{\link{derive_extreme_records}()}, +\code{\link{derive_locf_records}()}, \code{\link{derive_param_bsa}()}, \code{\link{derive_param_computed}()}, \code{\link{derive_param_doseint}()}, \code{\link{derive_param_exist_flag}()}, \code{\link{derive_param_exposure}()}, -\code{\link{derive_param_first_event}()}, +\code{\link{derive_param_extreme_event}()}, \code{\link{derive_param_framingham}()}, \code{\link{derive_param_map}()}, \code{\link{derive_param_qtc}()}, diff --git a/man/derive_param_bsa.Rd b/man/derive_param_bsa.Rd index ae4612dea1..e3112cf296 100644 --- a/man/derive_param_bsa.Rd +++ b/man/derive_param_bsa.Rd @@ -97,7 +97,9 @@ Adds a record for BSA (Body Surface Area) using the specified derivation method for each by group (e.g., subject and visit) where the source parameters are available. } \examples{ -advs <- tibble::tribble( +library(tibble) + +advs <- tribble( ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~VISIT, "01-701-1015", "HEIGHT", "Height (cm)", 170, "BASELINE", "01-701-1015", "WEIGHT", "Weight (kg)", 75, "BASELINE", @@ -135,12 +137,13 @@ derive_param_bsa( BDS-Findings Functions for adding Parameters/Records: \code{\link{default_qtc_paramcd}()}, \code{\link{derive_extreme_records}()}, +\code{\link{derive_locf_records}()}, \code{\link{derive_param_bmi}()}, \code{\link{derive_param_computed}()}, \code{\link{derive_param_doseint}()}, \code{\link{derive_param_exist_flag}()}, \code{\link{derive_param_exposure}()}, -\code{\link{derive_param_first_event}()}, +\code{\link{derive_param_extreme_event}()}, \code{\link{derive_param_framingham}()}, \code{\link{derive_param_map}()}, \code{\link{derive_param_qtc}()}, diff --git a/man/derive_param_computed.Rd b/man/derive_param_computed.Rd index 3c7cb7667d..62faecd3c6 100644 --- a/man/derive_param_computed.Rd +++ b/man/derive_param_computed.Rd @@ -106,8 +106,10 @@ the provided values. The values of the other variables of the input dataset are set to \code{NA}. } \examples{ +library(tibble) + # Example 1: Derive MAP -advs <- tibble::tribble( +advs <- tribble( ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, "01-701-1015", "DIABP", "Diastolic Blood Pressure (mmHg)", 51, "mmHg", "BASELINE", "01-701-1015", "DIABP", "Diastolic Blood Pressure (mmHg)", 50, "mmHg", "WEEK 2", @@ -132,7 +134,7 @@ derive_param_computed( ) # Example 2: Derive BMI where height is measured only once -advs <- tibble::tribble( +advs <- tribble( ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, "01-701-1015", "HEIGHT", "Height (cm)", 147, "cm", "SCREENING", "01-701-1015", "WEIGHT", "Weight (kg)", 54.0, "kg", "SCREENING", @@ -162,12 +164,13 @@ derive_param_computed( BDS-Findings Functions for adding Parameters/Records: \code{\link{default_qtc_paramcd}()}, \code{\link{derive_extreme_records}()}, +\code{\link{derive_locf_records}()}, \code{\link{derive_param_bmi}()}, \code{\link{derive_param_bsa}()}, \code{\link{derive_param_doseint}()}, \code{\link{derive_param_exist_flag}()}, \code{\link{derive_param_exposure}()}, -\code{\link{derive_param_first_event}()}, +\code{\link{derive_param_extreme_event}()}, \code{\link{derive_param_framingham}()}, \code{\link{derive_param_map}()}, \code{\link{derive_param_qtc}()}, diff --git a/man/derive_param_doseint.Rd b/man/derive_param_doseint.Rd index 9dc6b8b82c..9d3a535d3f 100644 --- a/man/derive_param_doseint.Rd +++ b/man/derive_param_doseint.Rd @@ -103,10 +103,10 @@ The analysis value of the new parameter is derived as Total Dose / Planned Dose * 100 } \examples{ -library(dplyr, warn.conflicts = FALSE) +library(tibble) library(lubridate, warn.conflicts = FALSE) -adex <- tibble::tribble( +adex <- tribble( ~USUBJID, ~PARAMCD, ~VISIT, ~ANL01FL, ~ASTDT, ~AENDT, ~AVAL, "P001", "TNDOSE", "V1", "Y", ymd("2020-01-01"), ymd("2020-01-30"), 59, "P001", "TSNDOSE", "V1", "Y", ymd("2020-01-01"), ymd("2020-02-01"), 96, @@ -139,12 +139,13 @@ derive_param_doseint( BDS-Findings Functions for adding Parameters/Records: \code{\link{default_qtc_paramcd}()}, \code{\link{derive_extreme_records}()}, +\code{\link{derive_locf_records}()}, \code{\link{derive_param_bmi}()}, \code{\link{derive_param_bsa}()}, \code{\link{derive_param_computed}()}, \code{\link{derive_param_exist_flag}()}, \code{\link{derive_param_exposure}()}, -\code{\link{derive_param_first_event}()}, +\code{\link{derive_param_extreme_event}()}, \code{\link{derive_param_framingham}()}, \code{\link{derive_param_map}()}, \code{\link{derive_param_qtc}()}, diff --git a/man/derive_param_exist_flag.Rd b/man/derive_param_exist_flag.Rd index 3da1ca7ebf..f6fd55f4d9 100644 --- a/man/derive_param_exist_flag.Rd +++ b/man/derive_param_exist_flag.Rd @@ -14,7 +14,7 @@ derive_param_exist_flag( missing_value = NA_character_, filter_add = NULL, aval_fun = yn_to_numeric, - subject_keys = vars(STUDYID, USUBJID), + subject_keys = get_admiral_option("subject_keys"), set_values_to ) } @@ -140,11 +140,12 @@ the new observations. } } \examples{ -library(dplyr) +library(tibble) +library(dplyr, warn.conflicts = FALSE) library(lubridate) # Derive a new parameter for measurable disease at baseline -adsl <- tibble::tribble( +adsl <- tribble( ~USUBJID, "1", "2", @@ -152,7 +153,7 @@ adsl <- tibble::tribble( ) \%>\% mutate(STUDYID = "XX1234") -tu <- tibble::tribble( +tu <- tribble( ~USUBJID, ~VISIT, ~TUSTRESC, "1", "SCREENING", "TARGET", "1", "WEEK 1", "TARGET", @@ -183,12 +184,13 @@ derive_param_exist_flag( BDS-Findings Functions for adding Parameters/Records: \code{\link{default_qtc_paramcd}()}, \code{\link{derive_extreme_records}()}, +\code{\link{derive_locf_records}()}, \code{\link{derive_param_bmi}()}, \code{\link{derive_param_bsa}()}, \code{\link{derive_param_computed}()}, \code{\link{derive_param_doseint}()}, \code{\link{derive_param_exposure}()}, -\code{\link{derive_param_first_event}()}, +\code{\link{derive_param_extreme_event}()}, \code{\link{derive_param_framingham}()}, \code{\link{derive_param_map}()}, \code{\link{derive_param_qtc}()}, diff --git a/man/derive_param_exposure.Rd b/man/derive_param_exposure.Rd index 42295c800b..4115a10020 100644 --- a/man/derive_param_exposure.Rd +++ b/man/derive_param_exposure.Rd @@ -93,10 +93,11 @@ an observation is added to the output dataset and the defined values are set to variables } \examples{ +library(tibble) library(dplyr, warn.conflicts = FALSE) library(lubridate, warn.conflicts = FALSE) library(stringr, warn.conflicts = FALSE) -adex <- tibble::tribble( +adex <- tribble( ~USUBJID, ~PARAMCD, ~AVAL, ~AVALC, ~VISIT, ~ASTDT, ~AENDT, "1015", "DOSE", 80, NA_character_, "BASELINE", ymd("2014-01-02"), ymd("2014-01-16"), "1015", "DOSE", 85, NA_character_, "WEEK 2", ymd("2014-01-17"), ymd("2014-06-18"), @@ -151,12 +152,13 @@ adex \%>\% BDS-Findings Functions for adding Parameters/Records: \code{\link{default_qtc_paramcd}()}, \code{\link{derive_extreme_records}()}, +\code{\link{derive_locf_records}()}, \code{\link{derive_param_bmi}()}, \code{\link{derive_param_bsa}()}, \code{\link{derive_param_computed}()}, \code{\link{derive_param_doseint}()}, \code{\link{derive_param_exist_flag}()}, -\code{\link{derive_param_first_event}()}, +\code{\link{derive_param_extreme_event}()}, \code{\link{derive_param_framingham}()}, \code{\link{derive_param_map}()}, \code{\link{derive_param_qtc}()}, diff --git a/man/derive_param_extreme_event.Rd b/man/derive_param_extreme_event.Rd new file mode 100644 index 0000000000..22804b5ff1 --- /dev/null +++ b/man/derive_param_extreme_event.Rd @@ -0,0 +1,218 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/derive_param_extreme_event.R +\name{derive_param_extreme_event} +\alias{derive_param_extreme_event} +\title{Add an Extreme Event Parameter} +\usage{ +derive_param_extreme_event( + dataset = NULL, + dataset_adsl, + dataset_source, + filter_source, + order = NULL, + new_var = AVALC, + true_value = "Y", + false_value = "N", + mode = "first", + subject_keys = vars(STUDYID, USUBJID), + set_values_to, + check_type = "warning" +) +} +\arguments{ +\item{dataset}{Input dataset + +The \code{PARAMCD} variable is expected.} + +\item{dataset_adsl}{ADSL input dataset + +The variables specified for \code{subject_keys} are expected. For each +observation of the specified dataset a new observation is added to the +input dataset.} + +\item{dataset_source}{Source dataset + +All observations in the specified dataset fulfilling the condition +specified by \code{filter_source} are considered as an event. + +The variables specified by the \code{subject_keys} and +\code{order} parameter (if applicable) are expected.} + +\item{filter_source}{Source filter + +All observations in \code{dataset_source} fulfilling the specified condition are +considered as an event. + +For subjects with at least one event \code{new_var} is set to \code{true_value}. + +For all other subjects \code{new_var} is set to \code{false_value}.} + +\item{order}{Order variable + +List of symbols for sorting the source dataset (\code{dataset_source}). + +\emph{Permitted Values}: list of variables or \verb{desc()} function calls +created by \code{vars()}, e.g., \code{vars(ADT, desc(AVAL))}.} + +\item{new_var}{New variable + +The name of the variable which will indicate whether an event happened or not.} + +\item{true_value}{True value + +For all subjects with at least one observation in the source dataset +(\code{dataset_source}) fulfilling the event condition (\code{filter_source}), +\code{new_var} is set to the specified value \code{true_value}.} + +\item{false_value}{False value + +For all other subjects in \code{dataset_adsl} without an event, \code{new_var} is set to +the specified value \code{false_value}.} + +\item{mode}{Selection mode (first or last) + +If \code{"first"} is specified, the first observation of each subject is selected. +If \code{"last"} is specified, the last observation of each subject is selected. + +\emph{Permitted Values}: \code{"first"}, \code{"last"}} + +\item{subject_keys}{Variables to uniquely identify a subject + +A list of symbols created using \code{vars()} is expected.} + +\item{set_values_to}{Variables to set + +A named list returned by \code{vars()} defining the variables to be set for the +new parameter, e.g. \code{vars(PARAMCD = "PD", PARAM = "Disease Progression")} +is expected. The values must be symbols, character strings, numeric values, +or \code{NA}. Note, if you require a date or datetime variable to be populated, +this needs to be defined here.} + +\item{check_type}{Check uniqueness? + +If \code{"warning"} or \code{"error"} is specified, a message is issued if the +observations of the input dataset restricted to the source parameter +(\code{source_param}) are not unique with respect to the subject keys +(\code{subject_key} parameter) and order variables (\code{order} parameter). + +\emph{Permitted Values}: \code{"none"}, \code{"warning"}, \code{"error"}} +} +\value{ +The input dataset with a new parameter indicating if and when an +event occurred +} +\description{ +Add a new parameter for the first or last event occurring in a dataset. The +variable given in \code{new_var} indicates if an event occurred or not. For example, +the function can derive a parameter for the first disease progression. +} +\details{ +\enumerate{ +\item The source dataset (\code{dataset_source}) is restricted to observations fulfilling +\code{filter_source}. +\item For each subject (with respect to the variables specified for the +\code{subject_keys} parameter) either the first or last observation from the restricted +source dataset is selected. This is depending on \code{mode}, (with respect to \code{order}, +if applicable) where the event condition (\code{filter_source} parameter) is fulfilled. +\item For each observation in \code{dataset_adsl} a new observation is created. For +subjects with event \code{new_var} is set to \code{true_var}. For all other +subjects \code{new_var} is set to \code{false_var}. +For subjects with event all variables from \code{dataset_source} are kept. For +subjects without event all variables which are in both \code{dataset_adsl} and +\code{dataset_source} are kept. +\item The variables specified by the \code{set_values_to} parameter are added to +the new observations. +\item The new observations are added to input dataset. +} +} +\examples{ +library(tibble) +library(dplyr, warn.conflicts = FALSE) +library(lubridate) + +# Derive a new parameter for the first disease progression (PD) +adsl <- tribble( + ~USUBJID, ~DTHDT, + "1", ymd("2022-05-13"), + "2", ymd(""), + "3", ymd("") +) \%>\% + mutate(STUDYID = "XX1234") + +adrs <- tribble( + ~USUBJID, ~ADTC, ~AVALC, + "1", "2020-01-02", "PR", + "1", "2020-02-01", "CR", + "1", "2020-03-01", "CR", + "1", "2020-04-01", "SD", + "2", "2021-06-15", "SD", + "2", "2021-07-16", "PD", + "2", "2021-09-14", "PD" +) \%>\% + mutate( + STUDYID = "XX1234", + ADT = ymd(ADTC), + PARAMCD = "OVR", + PARAM = "Overall Response", + ANL01FL = "Y" + ) \%>\% + select(-ADTC) + +derive_param_extreme_event( + adrs, + dataset_adsl = adsl, + dataset_source = adrs, + filter_source = PARAMCD == "OVR" & AVALC == "PD", + order = vars(ADT), + new_var = AVALC, + true_value = "Y", + false_value = "N", + mode = "first", + set_values_to = vars( + PARAMCD = "PD", + PARAM = "Disease Progression", + ANL01FL = "Y", + ADT = ADT + ) +) + +# derive parameter indicating death +derive_param_extreme_event( + dataset_adsl = adsl, + dataset_source = adsl, + filter_source = !is.na(DTHDT), + new_var = AVALC, + true_value = "Y", + false_value = "N", + mode = "first", + set_values_to = vars( + PARAMCD = "DEATH", + PARAM = "Death", + ANL01FL = "Y", + ADT = DTHDT + ) +) +} +\seealso{ +BDS-Findings Functions for adding Parameters/Records: +\code{\link{default_qtc_paramcd}()}, +\code{\link{derive_extreme_records}()}, +\code{\link{derive_locf_records}()}, +\code{\link{derive_param_bmi}()}, +\code{\link{derive_param_bsa}()}, +\code{\link{derive_param_computed}()}, +\code{\link{derive_param_doseint}()}, +\code{\link{derive_param_exist_flag}()}, +\code{\link{derive_param_exposure}()}, +\code{\link{derive_param_framingham}()}, +\code{\link{derive_param_map}()}, +\code{\link{derive_param_qtc}()}, +\code{\link{derive_param_rr}()}, +\code{\link{derive_param_wbc_abs}()}, +\code{\link{derive_summary_records}()} +} +\author{ +Stefan Bundfuss Sophie Shapcott +} +\concept{der_prm_bds_findings} +\keyword{der_prm_bds_findings} diff --git a/man/derive_param_first_event.Rd b/man/derive_param_first_event.Rd index 123cc87172..c1b9857f7d 100644 --- a/man/derive_param_first_event.Rd +++ b/man/derive_param_first_event.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/derive_param_first_event.R +% Please edit documentation in R/derive_param_extreme_event.R \name{derive_param_first_event} \alias{derive_param_first_event} \title{Add a First Event Parameter} @@ -69,8 +69,6 @@ observations of the input dataset restricted to the source parameter (\code{source_param}) are not unique with respect to the subject keys (\code{subject_key} parameter) and \code{ADT}. -\emph{Default}: \code{"warning"} - \emph{Permitted Values}: \code{"none"}, \code{"warning"}, \code{"error"}} } \value{ @@ -78,10 +76,9 @@ The input dataset with a new parameter indicating if and when an event occurred } \description{ -Add a new parameter for the first event occurring in a dataset. \code{AVALC} and -\code{AVAL} indicate if an event occurred and \code{ADT} is set to the date of the -first event. For example, the function can derive a parameter for the first -disease progression. +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} + +This function is \emph{deprecated}, please use \code{derive_param_extreme_event()} instead with the \code{order} argument instead of the \code{date_var} argument. } \details{ \enumerate{ @@ -103,84 +100,13 @@ the new observations. \item The new observations are added to input dataset. } } -\examples{ -library(dplyr) -library(lubridate) - -# Derive a new parameter for the first disease progression (PD) -adsl <- tibble::tribble( - ~USUBJID, ~DTHDT, - "1", ymd("2022-05-13"), - "2", ymd(""), - "3", ymd("") -) \%>\% - mutate(STUDYID = "XX1234") - -adrs <- tibble::tribble( - ~USUBJID, ~ADTC, ~AVALC, - "1", "2020-01-02", "PR", - "1", "2020-02-01", "CR", - "1", "2020-03-01", "CR", - "1", "2020-04-01", "SD", - "2", "2021-06-15", "SD", - "2", "2021-07-16", "PD", - "2", "2021-09-14", "PD" -) \%>\% - mutate( - STUDYID = "XX1234", - ADT = ymd(ADTC), - PARAMCD = "OVR", - PARAM = "Overall Response", - ANL01FL = "Y" - ) \%>\% - select(-ADTC) - -derive_param_first_event( - adrs, - dataset_adsl = adsl, - dataset_source = adrs, - filter_source = PARAMCD == "OVR" & AVALC == "PD", - date_var = ADT, - set_values_to = vars( - PARAMCD = "PD", - PARAM = "Disease Progression", - ANL01FL = "Y" - ) -) - -# derive parameter indicating death -derive_param_first_event( - dataset = adrs, - dataset_adsl = adsl, - dataset_source = adsl, - filter_source = !is.na(DTHDT), - date_var = DTHDT, - set_values_to = vars( - PARAMCD = "DEATH", - PARAM = "Death", - ANL01FL = "Y" - ) -) -} \seealso{ -BDS-Findings Functions for adding Parameters/Records: -\code{\link{default_qtc_paramcd}()}, -\code{\link{derive_extreme_records}()}, -\code{\link{derive_param_bmi}()}, -\code{\link{derive_param_bsa}()}, -\code{\link{derive_param_computed}()}, -\code{\link{derive_param_doseint}()}, -\code{\link{derive_param_exist_flag}()}, -\code{\link{derive_param_exposure}()}, -\code{\link{derive_param_framingham}()}, -\code{\link{derive_param_map}()}, -\code{\link{derive_param_qtc}()}, -\code{\link{derive_param_rr}()}, -\code{\link{derive_param_wbc_abs}()}, -\code{\link{derive_summary_records}()} +Other deprecated: +\code{\link{derive_derived_param}()}, +\code{\link{derive_var_aendy}()} } \author{ Stefan Bundfuss } -\concept{der_prm_bds_findings} -\keyword{der_prm_bds_findings} +\concept{deprecated} +\keyword{deprecated} diff --git a/man/derive_param_framingham.Rd b/man/derive_param_framingham.Rd index 43a75758c2..fcade0bc6e 100644 --- a/man/derive_param_framingham.Rd +++ b/man/derive_param_framingham.Rd @@ -177,9 +177,9 @@ Risk Period \tab 0.88936 \cr \deqn{Risk = 100 * (1 - RiskPeriodFactor^{RiskFactors})} } \examples{ -library(dplyr, warn.conflicts = FALSE) +library(tibble) -adcvrisk <- tibble::tribble( +adcvrisk <- tribble( ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, ~AGE, ~SEX, ~SMOKEFL, ~DIABETFL, ~TRTHYPFL, "01-701-1015", "SYSBP", "Systolic Blood Pressure (mmHg)", 121, @@ -235,13 +235,14 @@ derive_param_framingham( BDS-Findings Functions for adding Parameters/Records: \code{\link{default_qtc_paramcd}()}, \code{\link{derive_extreme_records}()}, +\code{\link{derive_locf_records}()}, \code{\link{derive_param_bmi}()}, \code{\link{derive_param_bsa}()}, \code{\link{derive_param_computed}()}, \code{\link{derive_param_doseint}()}, \code{\link{derive_param_exist_flag}()}, \code{\link{derive_param_exposure}()}, -\code{\link{derive_param_first_event}()}, +\code{\link{derive_param_extreme_event}()}, \code{\link{derive_param_map}()}, \code{\link{derive_param_qtc}()}, \code{\link{derive_param_rr}()}, diff --git a/man/derive_param_map.Rd b/man/derive_param_map.Rd index 12c98af266..f143cedf81 100644 --- a/man/derive_param_map.Rd +++ b/man/derive_param_map.Rd @@ -94,9 +94,10 @@ DIABP + 0.01 exp(4.14 - 40.74 / HR) (SYSBP - DIABP)} if it is based on diastolic, systolic blood pressure, and heart rate. } \examples{ +library(tibble) library(dplyr, warn.conflicts = FALSE) -advs <- tibble::tribble( +advs <- tribble( ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~VISIT, "01-701-1015", "PULSE", "Pulse (beats/min)", 59, "BASELINE", "01-701-1015", "PULSE", "Pulse (beats/min)", 61, "WEEK 2", @@ -140,13 +141,14 @@ derive_param_map( BDS-Findings Functions for adding Parameters/Records: \code{\link{default_qtc_paramcd}()}, \code{\link{derive_extreme_records}()}, +\code{\link{derive_locf_records}()}, \code{\link{derive_param_bmi}()}, \code{\link{derive_param_bsa}()}, \code{\link{derive_param_computed}()}, \code{\link{derive_param_doseint}()}, \code{\link{derive_param_exist_flag}()}, \code{\link{derive_param_exposure}()}, -\code{\link{derive_param_first_event}()}, +\code{\link{derive_param_extreme_event}()}, \code{\link{derive_param_framingham}()}, \code{\link{derive_param_qtc}()}, \code{\link{derive_param_rr}()}, diff --git a/man/derive_param_qtc.Rd b/man/derive_param_qtc.Rd index 3601047529..15153fccc4 100644 --- a/man/derive_param_qtc.Rd +++ b/man/derive_param_qtc.Rd @@ -82,7 +82,9 @@ formula for each by group (e.g., subject and visit) where the source parameters are available. } \examples{ -adeg <- tibble::tribble( +library(tibble) + +adeg <- tribble( ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, "01-701-1015", "HR", "Heart Rate (beats/min)", 70.14, "beats/min", "BASELINE", "01-701-1015", "QT", "QT Duration (msec)", 370, "msec", "WEEK 2", @@ -137,13 +139,14 @@ derive_param_qtc( BDS-Findings Functions for adding Parameters/Records: \code{\link{default_qtc_paramcd}()}, \code{\link{derive_extreme_records}()}, +\code{\link{derive_locf_records}()}, \code{\link{derive_param_bmi}()}, \code{\link{derive_param_bsa}()}, \code{\link{derive_param_computed}()}, \code{\link{derive_param_doseint}()}, \code{\link{derive_param_exist_flag}()}, \code{\link{derive_param_exposure}()}, -\code{\link{derive_param_first_event}()}, +\code{\link{derive_param_extreme_event}()}, \code{\link{derive_param_framingham}()}, \code{\link{derive_param_map}()}, \code{\link{derive_param_rr}()}, diff --git a/man/derive_param_rr.Rd b/man/derive_param_rr.Rd index 3861c41a30..43abe3beab 100644 --- a/man/derive_param_rr.Rd +++ b/man/derive_param_rr.Rd @@ -73,7 +73,9 @@ The analysis value of the new parameter is derived as \deqn{\frac{60000}{HR}}{60000 / HR} } \examples{ -adeg <- tibble::tribble( +library(tibble) + +adeg <- tribble( ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, "01-701-1015", "HR", "Heart Rate", 70.14, "beats/min", "BASELINE", "01-701-1015", "QT", "QT Duration", 370, "msec", "WEEK 2", @@ -101,13 +103,14 @@ derive_param_rr( BDS-Findings Functions for adding Parameters/Records: \code{\link{default_qtc_paramcd}()}, \code{\link{derive_extreme_records}()}, +\code{\link{derive_locf_records}()}, \code{\link{derive_param_bmi}()}, \code{\link{derive_param_bsa}()}, \code{\link{derive_param_computed}()}, \code{\link{derive_param_doseint}()}, \code{\link{derive_param_exist_flag}()}, \code{\link{derive_param_exposure}()}, -\code{\link{derive_param_first_event}()}, +\code{\link{derive_param_extreme_event}()}, \code{\link{derive_param_framingham}()}, \code{\link{derive_param_map}()}, \code{\link{derive_param_qtc}()}, diff --git a/man/derive_param_tte.Rd b/man/derive_param_tte.Rd index 3d1e65b756..e561b0c86e 100644 --- a/man/derive_param_tte.Rd +++ b/man/derive_param_tte.Rd @@ -14,7 +14,7 @@ derive_param_tte( censor_conditions, create_datetime = FALSE, set_values_to, - subject_keys = vars(STUDYID, USUBJID) + subject_keys = get_admiral_option("subject_keys") ) } \arguments{ diff --git a/man/derive_param_wbc_abs.Rd b/man/derive_param_wbc_abs.Rd index 9f0361c04b..f8e56d7427 100644 --- a/man/derive_param_wbc_abs.Rd +++ b/man/derive_param_wbc_abs.Rd @@ -84,8 +84,9 @@ white blood cell absolute value (identified by \code{wbc_code}) and the white bl (identified by \code{diff_code}) are both present. } \examples{ -library(dplyr, warn.conflicts = FALSE) -test_lb <- tibble::tribble( +library(tibble) + +test_lb <- tribble( ~USUBJID, ~PARAMCD, ~AVAL, ~PARAM, ~VISIT, "P01", "WBC", 33, "Leukocyte Count (10^9/L)", "CYCLE 1 DAY 1", "P01", "WBC", 38, "Leukocyte Count (10^9/L)", "CYCLE 2 DAY 1", @@ -116,13 +117,14 @@ derive_param_wbc_abs( BDS-Findings Functions for adding Parameters/Records: \code{\link{default_qtc_paramcd}()}, \code{\link{derive_extreme_records}()}, +\code{\link{derive_locf_records}()}, \code{\link{derive_param_bmi}()}, \code{\link{derive_param_bsa}()}, \code{\link{derive_param_computed}()}, \code{\link{derive_param_doseint}()}, \code{\link{derive_param_exist_flag}()}, \code{\link{derive_param_exposure}()}, -\code{\link{derive_param_first_event}()}, +\code{\link{derive_param_extreme_event}()}, \code{\link{derive_param_framingham}()}, \code{\link{derive_param_map}()}, \code{\link{derive_param_qtc}()}, diff --git a/man/derive_summary_records.Rd b/man/derive_summary_records.Rd index 060b1c5922..806022ca05 100644 --- a/man/derive_summary_records.Rd +++ b/man/derive_summary_records.Rd @@ -67,8 +67,10 @@ retain those common values in the newly derived records. Otherwise new value will be set to \code{NA}. } \examples{ -library(dplyr, warn.conflicts = FALSE) -adeg <- tibble::tribble( +library(tibble) +library(dplyr, warn.conflicts = TRUE) + +adeg <- tribble( ~USUBJID, ~EGSEQ, ~PARAM, ~AVISIT, ~EGDTC, ~AVAL, ~TRTA, "XYZ-1001", 1, "QTcF Int. (msec)", "Baseline", "2016-02-24T07:50", 385, "", "XYZ-1001", 2, "QTcF Int. (msec)", "Baseline", "2016-02-24T07:52", 399, "", @@ -99,7 +101,7 @@ derive_summary_records( set_values_to = vars(DTYPE = "AVERAGE") ) -advs <- tibble::tribble( +advs <- tribble( ~USUBJID, ~VSSEQ, ~PARAM, ~AVAL, ~VSSTRESU, ~VISIT, ~VSDTC, "XYZ-001-001", 1164, "Weight", 99, "kg", "Screening", "2018-03-19", "XYZ-001-001", 1165, "Weight", 101, "kg", "Run-In", "2018-03-26", @@ -126,7 +128,7 @@ derive_summary_records( ) # Sample ADEG dataset with triplicate record for only AVISIT = 'Baseline' -adeg <- tibble::tribble( +adeg <- tribble( ~USUBJID, ~EGSEQ, ~PARAM, ~AVISIT, ~EGDTC, ~AVAL, ~TRTA, "XYZ-1001", 1, "QTcF Int. (msec)", "Baseline", "2016-02-24T07:50", 385, "", "XYZ-1001", 2, "QTcF Int. (msec)", "Baseline", "2016-02-24T07:52", 399, "", @@ -149,7 +151,7 @@ adeg <- tibble::tribble( derive_summary_records( adeg, by_vars = vars(USUBJID, PARAM, AVISIT), - filter = dplyr::n() > 2, + filter = n() > 2, analysis_var = AVAL, summary_fun = function(x) mean(x, na.rm = TRUE), set_values_to = vars(DTYPE = "AVERAGE") @@ -161,13 +163,14 @@ derive_summary_records( BDS-Findings Functions for adding Parameters/Records: \code{\link{default_qtc_paramcd}()}, \code{\link{derive_extreme_records}()}, +\code{\link{derive_locf_records}()}, \code{\link{derive_param_bmi}()}, \code{\link{derive_param_bsa}()}, \code{\link{derive_param_computed}()}, \code{\link{derive_param_doseint}()}, \code{\link{derive_param_exist_flag}()}, \code{\link{derive_param_exposure}()}, -\code{\link{derive_param_first_event}()}, +\code{\link{derive_param_extreme_event}()}, \code{\link{derive_param_framingham}()}, \code{\link{derive_param_map}()}, \code{\link{derive_param_qtc}()}, diff --git a/man/derive_var_aendy.Rd b/man/derive_var_aendy.Rd index 02609ab2e5..8f837d56a4 100644 --- a/man/derive_var_aendy.Rd +++ b/man/derive_var_aendy.Rd @@ -46,7 +46,8 @@ start date is 1. } \seealso{ Other deprecated: -\code{\link{derive_derived_param}()} +\code{\link{derive_derived_param}()}, +\code{\link{derive_param_first_event}()} } \author{ Stefan Bundfuss diff --git a/man/derive_var_age_years.Rd b/man/derive_var_age_years.Rd index 0d745225b7..219a437efa 100644 --- a/man/derive_var_age_years.Rd +++ b/man/derive_var_age_years.Rd @@ -34,8 +34,6 @@ These can then be used to create age groups. } \examples{ -library(dplyr, warn.conflicts = FALSE) - data <- data.frame( AGE = c(27, 24, 3, 4, 1), AGEU = c("days", "months", "years", "weeks", "years") @@ -54,7 +52,8 @@ ADSL Functions that returns variable appended to dataset: \code{\link{derive_var_extreme_dtm}()}, \code{\link{derive_var_extreme_dt}()}, \code{\link{derive_vars_aage}()}, -\code{\link{derive_vars_disposition_reason}()} +\code{\link{derive_vars_disposition_reason}()}, +\code{\link{derive_vars_period}()} } \author{ Michael Thorpe diff --git a/man/derive_var_analysis_ratio.Rd b/man/derive_var_analysis_ratio.Rd index 2a0064fc86..6695e5a1f5 100644 --- a/man/derive_var_analysis_ratio.Rd +++ b/man/derive_var_analysis_ratio.Rd @@ -41,9 +41,9 @@ Reference CDISC ADaM Implementation Guide Version 1.1 Section 3.3.4 Analysis Parameter Variables for BDS Datasets } \examples{ -library(dplyr, warn.conflicts = FALSE) +library(tibble) -data <- tibble::tribble( +data <- tribble( ~USUBJID, ~PARAMCD, ~SEQ, ~AVAL, ~BASE, ~ANRLO, ~ANRHI, "P01", "ALT", 1, 27, 27, 6, 34, "P01", "ALT", 2, 41, 27, 6, 34, diff --git a/man/derive_var_anrind.Rd b/man/derive_var_anrind.Rd index 10b4a79d80..150c3ebfcd 100644 --- a/man/derive_var_anrind.Rd +++ b/man/derive_var_anrind.Rd @@ -31,11 +31,12 @@ is less than or equal \code{A1HI} } } \examples{ +library(tibble) library(dplyr, warn.conflicts = FALSE) library(admiral.test) data(admiral_vs) -ref_ranges <- tibble::tribble( +ref_ranges <- tribble( ~PARAMCD, ~ANRLO, ~ANRHI, ~A1LO, ~A1HI, "DIABP", 60, 80, 40, 90, "PULSE", 60, 100, 40, 110 diff --git a/man/derive_var_atoxgr.Rd b/man/derive_var_atoxgr.Rd index ab37a77d28..c68f06d961 100644 --- a/man/derive_var_atoxgr.Rd +++ b/man/derive_var_atoxgr.Rd @@ -45,9 +45,9 @@ Function applies the following rules: } } \examples{ -library(dplyr, warn.conflicts = FALSE) +library(tibble) -adlb <- tibble::tribble( +adlb <- tribble( ~ATOXDSCL, ~ATOXDSCH, ~ATOXGRL, ~ATOXGRH, "Hypoglycemia", "Hyperglycemia", NA_character_, "0", "Hypoglycemia", "Hyperglycemia", "0", "1", diff --git a/man/derive_var_atoxgr_dir.Rd b/man/derive_var_atoxgr_dir.Rd index 96d67ce127..1b6ae82ed2 100644 --- a/man/derive_var_atoxgr_dir.Rd +++ b/man/derive_var_atoxgr_dir.Rd @@ -8,7 +8,7 @@ derive_var_atoxgr_dir( dataset, new_var, tox_description_var, - meta_criteria = atoxgr_criteria_ctcv4, + meta_criteria, criteria_direction, get_unit_expr ) @@ -26,10 +26,12 @@ criteria. For example: "Anemia" or "INR Increased".} \item{meta_criteria}{Metadata data set holding the criteria (normally a case statement) -Default: \code{atoxgr_criteria_ctcv4} +Permitted Values: atoxgr_criteria_ctcv4, atoxgr_criteria_ctcv5 {admiral} metadata data set \code{atoxgr_criteria_ctcv4} implements \href{https://ctep.cancer.gov/protocoldevelopment/electronic_applications/ctc.htm}{Common Terminology Criteria for Adverse Events (CTCAE) v4.0} +{admiral} metadata data set \code{atoxgr_criteria_ctcv5} implements +\href{https://ctep.cancer.gov/protocoldevelopment/electronic_applications/ctc.htm}{Common Terminology Criteria for Adverse Events (CTCAE) v5.0} The metadata should have the following variables: \itemize{ @@ -75,9 +77,9 @@ severe grade } } \examples{ -library(dplyr, warn.conflicts = FALSE) +library(tibble) -data <- tibble::tribble( +data <- tribble( ~ATOXDSCL, ~AVAL, ~ANRLO, ~ANRHI, ~PARAM, "Hypoglycemia", 119, 4, 7, "Glucose (mmol/L)", "Hypoglycemia", 120, 4, 7, "Glucose (mmol/L)", @@ -95,7 +97,7 @@ derive_var_atoxgr_dir(data, get_unit_expr = extract_unit(PARAM) ) -data <- tibble::tribble( +data <- tribble( ~ATOXDSCH, ~AVAL, ~ANRLO, ~ANRHI, ~PARAM, "Hyperglycemia", 119, 4, 7, "Glucose (mmol/L)", "Hyperglycemia", 120, 4, 7, "Glucose (mmol/L)", diff --git a/man/derive_var_base.Rd b/man/derive_var_base.Rd index 82b51af3ae..a8848efb4f 100644 --- a/man/derive_var_base.Rd +++ b/man/derive_var_base.Rd @@ -34,27 +34,29 @@ dataset plus the \code{new_var} variable Derive baseline variables, e.g. \code{BASE} or \code{BNRIND}, in a BDS dataset } \details{ -For each \code{by_vars} group the baseline record is identified by filtering using the -condition specified by \code{filter} which defaults to \code{ABLFL == "Y"}. Subsequently, +For each \code{by_vars} group, the baseline record is identified by the +condition specified in \code{filter} which defaults to \code{ABLFL == "Y"}. Subsequently, every value of the \code{new_var} variable for the \code{by_vars} group is set to the value of the \code{source_var} variable of the baseline record. In case there are multiple baseline records within \code{by_vars} an error is issued. } \examples{ -dataset <- tibble::tribble( - ~STUDYID, ~USUBJID, ~PARAMCD, ~AVAL, ~AVALC, ~AVISIT, ~ABLFL, - "TEST01", "PAT01", "PARAM01", 10.12, NA, "Baseline", "Y", - "TEST01", "PAT01", "PARAM01", 9.700, NA, "Day 7", "N", - "TEST01", "PAT01", "PARAM01", 15.01, NA, "Day 14", "N", - "TEST01", "PAT01", "PARAM02", 8.350, NA, "Baseline", "Y", - "TEST01", "PAT01", "PARAM02", NA, NA, "Day 7", "N", - "TEST01", "PAT01", "PARAM02", 8.350, NA, "Day 14", "N", - "TEST01", "PAT01", "PARAM03", NA, "LOW", "Baseline", "Y", - "TEST01", "PAT01", "PARAM03", NA, "LOW", "Day 7", "N", - "TEST01", "PAT01", "PARAM03", NA, "MEDIUM", "Day 14", "N", - "TEST01", "PAT01", "PARAM04", NA, "HIGH", "Baseline", "Y", - "TEST01", "PAT01", "PARAM04", NA, "HIGH", "Day 7", "N", - "TEST01", "PAT01", "PARAM04", NA, "MEDIUM", "Day 14", "N" +library(tibble) + +dataset <- tribble( + ~STUDYID, ~USUBJID, ~PARAMCD, ~AVAL, ~AVALC, ~AVISIT, ~ABLFL, ~ANRIND, + "TEST01", "PAT01", "PARAM01", 10.12, NA, "Baseline", "Y", "NORMAL", + "TEST01", "PAT01", "PARAM01", 9.700, NA, "Day 7", "N", "LOW", + "TEST01", "PAT01", "PARAM01", 15.01, NA, "Day 14", "N", "HIGH", + "TEST01", "PAT01", "PARAM02", 8.350, NA, "Baseline", "Y", "LOW", + "TEST01", "PAT01", "PARAM02", NA, NA, "Day 7", "N", NA, + "TEST01", "PAT01", "PARAM02", 8.350, NA, "Day 14", "N", "LOW", + "TEST01", "PAT01", "PARAM03", NA, "LOW", "Baseline", "Y", NA, + "TEST01", "PAT01", "PARAM03", NA, "LOW", "Day 7", "N", NA, + "TEST01", "PAT01", "PARAM03", NA, "MEDIUM", "Day 14", "N", NA, + "TEST01", "PAT01", "PARAM04", NA, "HIGH", "Baseline", "Y", NA, + "TEST01", "PAT01", "PARAM04", NA, "HIGH", "Day 7", "N", NA, + "TEST01", "PAT01", "PARAM04", NA, "MEDIUM", "Day 14", "N", NA ) ## Derive `BASE` variable from `AVAL` @@ -74,14 +76,12 @@ derive_var_base( ) ## Derive `BNRIND` variable from `ANRIND` -if (FALSE) { - derive_var_base( - dataset, - by_vars = vars(USUBJID, PARAMCD), - source_var = ANRIND, - new_var = BNRIND - ) -} +derive_var_base( + dataset, + by_vars = vars(USUBJID, PARAMCD), + source_var = ANRIND, + new_var = BNRIND +) } \seealso{ BDS-Findings Functions that returns variable appended to dataset: diff --git a/man/derive_var_basetype.Rd b/man/derive_var_basetype.Rd index 9e6044e068..04de0c9aee 100644 --- a/man/derive_var_basetype.Rd +++ b/man/derive_var_basetype.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/derive_var_basetype.R \name{derive_var_basetype} \alias{derive_var_basetype} -\title{Derive BASETYPE Variable} +\title{Derive Basetype Variable} \usage{ derive_var_basetype(dataset, basetypes) } @@ -40,7 +40,11 @@ expression. Then, all subsets are stacked. Records which do not match any condition are kept and \code{BASETYPE} is set to \code{NA}. } \examples{ -bds <- tibble::tribble( +library(tibble) +library(dplyr, warn.conflicts = FALSE) +library(rlang) + +bds <- tribble( ~USUBJID, ~EPOCH, ~PARAMCD, ~ASEQ, ~AVAL, "P01", "RUN-IN", "PARAM01", 1, 10.0, "P01", "RUN-IN", "PARAM01", 2, 9.8, @@ -57,7 +61,7 @@ bds <- tibble::tribble( bds_with_basetype <- derive_var_basetype( dataset = bds, - basetypes = rlang::exprs( + basetypes = exprs( "RUN-IN" = EPOCH \%in\% c("RUN-IN", "STABILIZATION", "DOUBLE-BLIND", "OPEN-LABEL"), "DOUBLE-BLIND" = EPOCH \%in\% c("DOUBLE-BLIND", "OPEN-LABEL"), "OPEN-LABEL" = EPOCH == "OPEN-LABEL" @@ -69,11 +73,11 @@ bds_with_basetype <- derive_var_basetype( # bds_with_basetype print(bds_with_basetype, n = Inf) -dplyr::count(bds_with_basetype, BASETYPE, name = "Number of Records") +count(bds_with_basetype, BASETYPE, name = "Number of Records") # An example where all parameter records need to be included for 2 different # baseline type derivations (such as LAST and WORST) -bds <- tibble::tribble( +bds <- tribble( ~USUBJID, ~EPOCH, ~PARAMCD, ~ASEQ, ~AVAL, "P01", "RUN-IN", "PARAM01", 1, 10.0, "P01", "RUN-IN", "PARAM01", 2, 9.8, @@ -83,7 +87,7 @@ bds <- tibble::tribble( bds_with_basetype <- derive_var_basetype( dataset = bds, - basetypes = rlang::exprs( + basetypes = exprs( "LAST" = TRUE, "WORST" = TRUE ) @@ -91,7 +95,7 @@ bds_with_basetype <- derive_var_basetype( print(bds_with_basetype, n = Inf) -dplyr::count(bds_with_basetype, BASETYPE, name = "Number of Records") +count(bds_with_basetype, BASETYPE, name = "Number of Records") } \seealso{ BDS-Findings Functions that returns variable appended to dataset: diff --git a/man/derive_var_chg.Rd b/man/derive_var_chg.Rd index b3bd66b41e..9f2dc0f495 100644 --- a/man/derive_var_chg.Rd +++ b/man/derive_var_chg.Rd @@ -21,7 +21,9 @@ Change from baseline is calculated by subtracting the baseline value from the analysis value. } \examples{ -advs <- tibble::tribble( +library(tibble) + +advs <- tribble( ~USUBJID, ~PARAMCD, ~AVAL, ~ABLFL, ~BASE, "P01", "WEIGHT", 80, "Y", 80, "P01", "WEIGHT", 80.8, "", 80, diff --git a/man/derive_var_confirmation_flag.Rd b/man/derive_var_confirmation_flag.Rd index e8fdfc6927..89a88042df 100644 --- a/man/derive_var_confirmation_flag.Rd +++ b/man/derive_var_confirmation_flag.Rd @@ -324,8 +324,11 @@ General Derivation Functions for all ADaMs that returns variable appended to dat \code{\link{derive_var_merged_cat}()}, \code{\link{derive_var_merged_character}()}, \code{\link{derive_var_merged_exist_flag}()}, +\code{\link{derive_var_merged_summary}()}, \code{\link{derive_var_obs_number}()}, +\code{\link{derive_var_relative_flag}()}, \code{\link{derive_var_worst_flag}()}, +\code{\link{derive_vars_joined}()}, \code{\link{derive_vars_last_dose}()}, \code{\link{derive_vars_merged_lookup}()}, \code{\link{derive_vars_merged}()}, diff --git a/man/derive_var_disposition_status.Rd b/man/derive_var_disposition_status.Rd index f8db7bfdc6..1ac3000dcc 100644 --- a/man/derive_var_disposition_status.Rd +++ b/man/derive_var_disposition_status.Rd @@ -11,7 +11,7 @@ derive_var_disposition_status( status_var, format_new_var = format_eoxxstt_default, filter_ds, - subject_keys = vars(STUDYID, USUBJID) + subject_keys = get_admiral_option("subject_keys") ) } \arguments{ @@ -112,7 +112,7 @@ format_eoxxstt1 <- function(x) { x == "COMPLETED" ~ "COMPLETED", x == "ADVERSE EVENT" ~ "DISCONTINUED DUE TO AE", !(x \%in\% c("ADVERSE EVENT", "COMPLETED", "SCREEN FAILURE")) & !is.na(x) ~ - "DISCONTINUED NOT DUE TO AE", + "DISCONTINUED NOT DUE TO AE", TRUE ~ "ONGOING" ) } @@ -134,7 +134,8 @@ ADSL Functions that returns variable appended to dataset: \code{\link{derive_var_extreme_dtm}()}, \code{\link{derive_var_extreme_dt}()}, \code{\link{derive_vars_aage}()}, -\code{\link{derive_vars_disposition_reason}()} +\code{\link{derive_vars_disposition_reason}()}, +\code{\link{derive_vars_period}()} } \author{ Samia Kabi diff --git a/man/derive_var_dthcaus.Rd b/man/derive_var_dthcaus.Rd index 067700c434..eb20b72a63 100644 --- a/man/derive_var_dthcaus.Rd +++ b/man/derive_var_dthcaus.Rd @@ -2,24 +2,13 @@ % Please edit documentation in R/derive_var_dthcaus.R \name{derive_var_dthcaus} \alias{derive_var_dthcaus} -\alias{dthcaus_source} \title{Derive Death Cause} \usage{ derive_var_dthcaus( dataset, ..., source_datasets, - subject_keys = vars(STUDYID, USUBJID) -) - -dthcaus_source( - dataset_name, - filter, - date, - order = NULL, - mode = "first", - dthcaus, - traceability_vars = NULL + subject_keys = get_admiral_option("subject_keys") ) } \arguments{ @@ -36,45 +25,9 @@ death cause} A list of quosures where the expressions are symbols as returned by \code{vars()} is expected.} - -\item{dataset_name}{The name of the dataset, i.e. a string, used to search for -the death cause.} - -\item{filter}{An expression used for filtering \code{dataset}.} - -\item{date}{A date or datetime variable to be used for sorting \code{dataset}.} - -\item{order}{Sort order - -Additional variables to be used for sorting the \code{dataset} which is ordered by the -\code{date} and \code{order}. Can be used to avoid duplicate record warning. - -\emph{Default}: \code{NULL} - -\emph{Permitted Values}: list of variables or \verb{desc()} function calls -created by \code{vars()}, e.g., \code{vars(ADT, desc(AVAL))} or \code{NULL}} - -\item{mode}{One of \code{"first"} or \code{"last"}. -Either the \code{"first"} or \code{"last"} observation is preserved from the \code{dataset} -which is ordered by \code{date}.} - -\item{dthcaus}{A variable name or a string literal --- if a variable name, e.g., \code{AEDECOD}, -it is the variable in the source dataset to be used to assign values to -\code{DTHCAUS}; if a string literal, e.g. \code{"Adverse Event"}, it is the fixed value -to be assigned to \code{DTHCAUS}.} - -\item{traceability_vars}{A named list returned by \code{\link[=vars]{vars()}} listing the traceability variables, -e.g. \code{vars(DTHDOM = "DS", DTHSEQ = DSSEQ)}. -The left-hand side (names of the list elements) gives the names of the traceability variables -in the returned dataset. -The right-hand side (values of the list elements) gives the values of the traceability variables -in the returned dataset. -These can be either strings or symbols referring to existing variables.} } \value{ -\code{derive_var_dthcaus()} returns the input dataset with \code{DTHCAUS} variable added. - -\code{dthcaus_source()} returns an object of class "dthcaus_source". +The input dataset with \code{DTHCAUS} variable added. } \description{ Derive death cause (\code{DTHCAUS}) and add traceability variables if required. @@ -86,14 +39,9 @@ the one from the source with the earliest death date will be used. If dates are equivalent, the first source will be kept, so the user should provide the inputs in the preferred order. } -\section{Functions}{ -\itemize{ -\item \code{dthcaus_source}: Create objects of class "dthcaus_source" -}} - \examples{ library(tibble) -library(dplyr) +library(dplyr, warn.conflicts = FALSE) library(lubridate) adsl <- tribble( @@ -191,40 +139,19 @@ src_ds_post <- dthcaus_source( derive_var_dthcaus(adsl, src_ae, src_ds, src_ds_post, source_datasets = list(ae = ae, ds = ds)) } \seealso{ +\code{\link[=dthcaus_source]{dthcaus_source()}} + ADSL Functions that returns variable appended to dataset: \code{\link{derive_var_age_years}()}, \code{\link{derive_var_disposition_status}()}, \code{\link{derive_var_extreme_dtm}()}, \code{\link{derive_var_extreme_dt}()}, \code{\link{derive_vars_aage}()}, -\code{\link{derive_vars_disposition_reason}()} - -Source Specifications: -\code{\link{assert_db_requirements}()}, -\code{\link{assert_terms}()}, -\code{\link{assert_valid_queries}()}, -\code{\link{censor_source}()}, -\code{\link{date_source}()}, -\code{\link{death_event}}, -\code{\link{event_source}()}, -\code{\link{extend_source_datasets}()}, -\code{\link{filter_date_sources}()}, -\code{\link{format.sdg_select}()}, -\code{\link{format.smq_select}()}, -\code{\link{list_tte_source_objects}()}, -\code{\link{params}()}, -\code{\link{query}()}, -\code{\link{sdg_select}()}, -\code{\link{smq_select}()}, -\code{\link{tte_source}()}, -\code{\link{validate_query}()}, -\code{\link{validate_sdg_select}()}, -\code{\link{validate_smq_select}()} +\code{\link{derive_vars_disposition_reason}()}, +\code{\link{derive_vars_period}()} } \author{ Shimeng Huang, Samia Kabi, Thomas Neitmann, Tamara Senior } \concept{der_adsl} -\concept{source_specifications} \keyword{der_adsl} -\keyword{source_specifications} diff --git a/man/derive_var_extreme_dt.Rd b/man/derive_var_extreme_dt.Rd index b0f922fa38..6c47d3e9e8 100644 --- a/man/derive_var_extreme_dt.Rd +++ b/man/derive_var_extreme_dt.Rd @@ -10,7 +10,7 @@ derive_var_extreme_dt( ..., source_datasets, mode, - subject_keys = vars(STUDYID, USUBJID) + subject_keys = get_admiral_option("subject_keys") ) } \arguments{ @@ -182,7 +182,8 @@ ADSL Functions that returns variable appended to dataset: \code{\link{derive_var_dthcaus}()}, \code{\link{derive_var_extreme_dtm}()}, \code{\link{derive_vars_aage}()}, -\code{\link{derive_vars_disposition_reason}()} +\code{\link{derive_vars_disposition_reason}()}, +\code{\link{derive_vars_period}()} } \author{ Stefan Bundfuss, Thomas Neitmann diff --git a/man/derive_var_extreme_dtm.Rd b/man/derive_var_extreme_dtm.Rd index 26b5bf15bb..c958a5fa0d 100644 --- a/man/derive_var_extreme_dtm.Rd +++ b/man/derive_var_extreme_dtm.Rd @@ -10,7 +10,7 @@ derive_var_extreme_dtm( ..., source_datasets, mode, - subject_keys = vars(STUDYID, USUBJID) + subject_keys = get_admiral_option("subject_keys") ) } \arguments{ @@ -183,7 +183,8 @@ ADSL Functions that returns variable appended to dataset: \code{\link{derive_var_dthcaus}()}, \code{\link{derive_var_extreme_dt}()}, \code{\link{derive_vars_aage}()}, -\code{\link{derive_vars_disposition_reason}()} +\code{\link{derive_vars_disposition_reason}()}, +\code{\link{derive_vars_period}()} } \author{ Stefan Bundfuss, Thomas Neitmann diff --git a/man/derive_var_extreme_flag.Rd b/man/derive_var_extreme_flag.Rd index 18588353b3..cfccf276e1 100644 --- a/man/derive_var_extreme_flag.Rd +++ b/man/derive_var_extreme_flag.Rd @@ -72,6 +72,7 @@ all parameters in the dataset depending on the \code{order} and the \code{mode}, parameter the first or last record will be flagged across the whole dataset. } \examples{ +library(tibble) library(dplyr, warn.conflicts = FALSE) library(admiral.test) data("admiral_vs") @@ -93,7 +94,7 @@ admiral_vs \%>\% # Baseline (ABLFL) examples: -input <- tibble::tribble( +input <- tribble( ~STUDYID, ~USUBJID, ~PARAMCD, ~AVISIT, ~ADT, ~AVAL, ~DTYPE, "TEST01", "PAT01", "PARAM01", "BASELINE", as.Date("2021-04-27"), 15.0, NA, "TEST01", "PAT01", "PARAM01", "BASELINE", as.Date("2021-04-25"), 14.0, NA, @@ -213,8 +214,11 @@ General Derivation Functions for all ADaMs that returns variable appended to dat \code{\link{derive_var_merged_cat}()}, \code{\link{derive_var_merged_character}()}, \code{\link{derive_var_merged_exist_flag}()}, +\code{\link{derive_var_merged_summary}()}, \code{\link{derive_var_obs_number}()}, +\code{\link{derive_var_relative_flag}()}, \code{\link{derive_var_worst_flag}()}, +\code{\link{derive_vars_joined}()}, \code{\link{derive_vars_last_dose}()}, \code{\link{derive_vars_merged_lookup}()}, \code{\link{derive_vars_merged}()}, diff --git a/man/derive_var_last_dose_amt.Rd b/man/derive_var_last_dose_amt.Rd index f2504b0423..a04462ccd6 100644 --- a/man/derive_var_last_dose_amt.Rd +++ b/man/derive_var_last_dose_amt.Rd @@ -131,8 +131,11 @@ General Derivation Functions for all ADaMs that returns variable appended to dat \code{\link{derive_var_merged_cat}()}, \code{\link{derive_var_merged_character}()}, \code{\link{derive_var_merged_exist_flag}()}, +\code{\link{derive_var_merged_summary}()}, \code{\link{derive_var_obs_number}()}, +\code{\link{derive_var_relative_flag}()}, \code{\link{derive_var_worst_flag}()}, +\code{\link{derive_vars_joined}()}, \code{\link{derive_vars_last_dose}()}, \code{\link{derive_vars_merged_lookup}()}, \code{\link{derive_vars_merged}()}, diff --git a/man/derive_var_last_dose_date.Rd b/man/derive_var_last_dose_date.Rd index d5ed130666..9f225ac519 100644 --- a/man/derive_var_last_dose_date.Rd +++ b/man/derive_var_last_dose_date.Rd @@ -116,8 +116,11 @@ General Derivation Functions for all ADaMs that returns variable appended to dat \code{\link{derive_var_merged_cat}()}, \code{\link{derive_var_merged_character}()}, \code{\link{derive_var_merged_exist_flag}()}, +\code{\link{derive_var_merged_summary}()}, \code{\link{derive_var_obs_number}()}, +\code{\link{derive_var_relative_flag}()}, \code{\link{derive_var_worst_flag}()}, +\code{\link{derive_vars_joined}()}, \code{\link{derive_vars_last_dose}()}, \code{\link{derive_vars_merged_lookup}()}, \code{\link{derive_vars_merged}()}, diff --git a/man/derive_var_last_dose_grp.Rd b/man/derive_var_last_dose_grp.Rd index 18d3c45ddd..3bc2aecc9a 100644 --- a/man/derive_var_last_dose_grp.Rd +++ b/man/derive_var_last_dose_grp.Rd @@ -139,8 +139,11 @@ General Derivation Functions for all ADaMs that returns variable appended to dat \code{\link{derive_var_merged_cat}()}, \code{\link{derive_var_merged_character}()}, \code{\link{derive_var_merged_exist_flag}()}, +\code{\link{derive_var_merged_summary}()}, \code{\link{derive_var_obs_number}()}, +\code{\link{derive_var_relative_flag}()}, \code{\link{derive_var_worst_flag}()}, +\code{\link{derive_vars_joined}()}, \code{\link{derive_vars_last_dose}()}, \code{\link{derive_vars_merged_lookup}()}, \code{\link{derive_vars_merged}()}, diff --git a/man/derive_var_merged_cat.Rd b/man/derive_var_merged_cat.Rd index 13da2437ed..f60a0f3c29 100644 --- a/man/derive_var_merged_cat.Rd +++ b/man/derive_var_merged_cat.Rd @@ -20,12 +20,12 @@ derive_var_merged_cat( \arguments{ \item{dataset}{Input dataset -The variables specified by the \code{by_vars} parameter are expected.} +The variables specified by the \code{by_vars} argument are expected.} \item{dataset_add}{Additional dataset The variables specified by the \code{by_vars}, the \code{source_var}, and the \code{order} -parameter are expected.} +argument are expected.} \item{by_vars}{Grouping variables @@ -37,7 +37,7 @@ key of the selected observations. \item{order}{Sort order -If the parameter is set to a non-null value, for each by group the first or +If the argument is set to a non-null value, for each by group the first or last observation from the additional dataset is selected with respect to the specified order. @@ -55,13 +55,13 @@ categorized values, i.e., \verb{cat_fun()}.} \item{cat_fun}{Categorization function -A function must be specified for this parameter which expects the values of +A function must be specified for this argument which expects the values of the source variable as input and returns the categorized values.} \item{filter_add}{Filter for additional dataset (\code{dataset_add}) Only observations fulfilling the specified condition are taken into account -for merging. If the parameter is not specified, all observations are +for merging. If the argument is not specified, all observations are considered. \emph{Default}: \code{NULL} @@ -71,9 +71,9 @@ considered. \item{mode}{Selection mode Determines if the first or last observation is selected. If the \code{order} -parameter is specified, \code{mode} must be non-null. +argument is specified, \code{mode} must be non-null. -If the \code{order} parameter is not specified, the \code{mode} parameter is ignored. +If the \code{order} argument is not specified, the \code{mode} argument is ignored. \emph{Default}: \code{NULL} @@ -157,8 +157,11 @@ General Derivation Functions for all ADaMs that returns variable appended to dat \code{\link{derive_var_last_dose_grp}()}, \code{\link{derive_var_merged_character}()}, \code{\link{derive_var_merged_exist_flag}()}, +\code{\link{derive_var_merged_summary}()}, \code{\link{derive_var_obs_number}()}, +\code{\link{derive_var_relative_flag}()}, \code{\link{derive_var_worst_flag}()}, +\code{\link{derive_vars_joined}()}, \code{\link{derive_vars_last_dose}()}, \code{\link{derive_vars_merged_lookup}()}, \code{\link{derive_vars_merged}()}, diff --git a/man/derive_var_merged_character.Rd b/man/derive_var_merged_character.Rd index 7404f4e0b9..4d67c3ebfb 100644 --- a/man/derive_var_merged_character.Rd +++ b/man/derive_var_merged_character.Rd @@ -20,12 +20,12 @@ derive_var_merged_character( \arguments{ \item{dataset}{Input dataset -The variables specified by the \code{by_vars} parameter are expected.} +The variables specified by the \code{by_vars} argument are expected.} \item{dataset_add}{Additional dataset The variables specified by the \code{by_vars}, the \code{source_var}, and the \code{order} -parameter are expected.} +argument are expected.} \item{by_vars}{Grouping variables @@ -37,7 +37,7 @@ key of the selected observations. \item{order}{Sort order -If the parameter is set to a non-null value, for each by group the first or +If the argument is set to a non-null value, for each by group the first or last observation from the additional dataset is selected with respect to the specified order. @@ -49,7 +49,7 @@ created by \code{vars()}, e.g., \code{vars(ADT, desc(AVAL))} or \code{NULL}} \item{new_var}{New variable The specified variable is added to the additional dataset and set to the -transformed value with respect to the \code{case} parameter.} +transformed value with respect to the \code{case} argument.} \item{source_var}{Source variable} @@ -64,7 +64,7 @@ Changes the case of the values of the new variable. \item{filter_add}{Filter for additional dataset (\code{dataset_add}) Only observations fulfilling the specified condition are taken into account -for merging. If the parameter is not specified, all observations are +for merging. If the argument is not specified, all observations are considered. \emph{Default}: \code{NULL} @@ -74,9 +74,9 @@ considered. \item{mode}{Selection mode Determines if the first or last observation is selected. If the \code{order} -parameter is specified, \code{mode} must be non-null. +argument is specified, \code{mode} must be non-null. -If the \code{order} parameter is not specified, the \code{mode} parameter is ignored. +If the \code{order} argument is not specified, the \code{mode} argument is ignored. \emph{Default}: \code{NULL} @@ -137,8 +137,11 @@ General Derivation Functions for all ADaMs that returns variable appended to dat \code{\link{derive_var_last_dose_grp}()}, \code{\link{derive_var_merged_cat}()}, \code{\link{derive_var_merged_exist_flag}()}, +\code{\link{derive_var_merged_summary}()}, \code{\link{derive_var_obs_number}()}, +\code{\link{derive_var_relative_flag}()}, \code{\link{derive_var_worst_flag}()}, +\code{\link{derive_vars_joined}()}, \code{\link{derive_vars_last_dose}()}, \code{\link{derive_vars_merged_lookup}()}, \code{\link{derive_vars_merged}()}, diff --git a/man/derive_var_merged_exist_flag.Rd b/man/derive_var_merged_exist_flag.Rd index 0ace6e64d2..666b5314a0 100644 --- a/man/derive_var_merged_exist_flag.Rd +++ b/man/derive_var_merged_exist_flag.Rd @@ -19,11 +19,11 @@ derive_var_merged_exist_flag( \arguments{ \item{dataset}{Input dataset -The variables specified by the \code{by_vars} parameter are expected.} +The variables specified by the \code{by_vars} argument are expected.} \item{dataset_add}{Additional dataset -The variables specified by the \code{by_vars} parameter are expected.} +The variables specified by the \code{by_vars} argument are expected.} \item{by_vars}{Grouping variables @@ -63,7 +63,7 @@ observations in the additional dataset. \item{filter_add}{Filter for additional data Only observations fulfilling the specified condition are taken into account -for flagging. If the parameter is not specified, all observations are +for flagging. If the argument is not specified, all observations are considered. \emph{Permitted Values}: a condition} @@ -127,8 +127,11 @@ General Derivation Functions for all ADaMs that returns variable appended to dat \code{\link{derive_var_last_dose_grp}()}, \code{\link{derive_var_merged_cat}()}, \code{\link{derive_var_merged_character}()}, +\code{\link{derive_var_merged_summary}()}, \code{\link{derive_var_obs_number}()}, +\code{\link{derive_var_relative_flag}()}, \code{\link{derive_var_worst_flag}()}, +\code{\link{derive_vars_joined}()}, \code{\link{derive_vars_last_dose}()}, \code{\link{derive_vars_merged_lookup}()}, \code{\link{derive_vars_merged}()}, diff --git a/man/derive_var_merged_summary.Rd b/man/derive_var_merged_summary.Rd new file mode 100644 index 0000000000..48d00442f9 --- /dev/null +++ b/man/derive_var_merged_summary.Rd @@ -0,0 +1,167 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/derive_merged.R +\name{derive_var_merged_summary} +\alias{derive_var_merged_summary} +\title{Merge a Summary Variable} +\usage{ +derive_var_merged_summary( + dataset, + dataset_add, + by_vars, + new_var, + filter_add = NULL, + analysis_var, + summary_fun +) +} +\arguments{ +\item{dataset}{Input dataset + +The variables specified by the \code{by_vars} argument are expected.} + +\item{dataset_add}{Additional dataset + +The variables specified by the \code{by_vars} and the \code{analysis_var} arguments +are expected.} + +\item{by_vars}{Grouping variables + +The values of \code{analysis_var} are summarized by the specified variables. The +summarized values are merged to the input dataset (\code{dataset}) by the +specified by variables. + +\emph{Permitted Values}: list of variables created by \code{vars()}} + +\item{new_var}{Variable to add + +The specified variable is added to the input dataset (\code{dataset}) and set to +the summarized values.} + +\item{filter_add}{Filter for additional dataset (\code{dataset_add}) + +Only observations fulfilling the specified condition are taken into account +for summarizing. If the argument is not specified, all observations are +considered. + +\emph{Permitted Values}: a condition} + +\item{analysis_var}{Analysis variable + +The values of the specified variable are summarized by the function +specified for \code{summary_fun}.} + +\item{summary_fun}{Summary function + +The specified function that takes as input \code{analysis_var} and performs the +calculation. This can include built-in functions as well as user defined +functions, for example \code{mean} or \code{function(x) mean(x, na.rm = TRUE)}.} +} +\value{ +The output dataset contains all observations and variables of the +input dataset and additionally the variable specified for \code{new_var}. +} +\description{ +Merge a summary variable from a dataset to the input dataset. +} +\details{ +\enumerate{ +\item The records from the additional dataset (\code{dataset_add}) are restricted +to those matching the \code{filter_add} condition. +\item The values of the analysis variable (\code{analysis_var}) are summarized by +the summary function (\code{summary_fun}) for each by group (\code{by_vars}) in the +additional dataset (\code{dataset_add}). +\item The summarized values are merged to the input dataset as a new variable +(\code{new_var}). For observations without a matching observation in the +additional dataset the new variable is set to \code{NA}. Observations in the +additional dataset which have no matching observation in the input dataset +are ignored. +} +} +\examples{ +library(tibble) + +# Add a variable for the mean of AVAL within each visit +adbds <- tribble( + ~USUBJID, ~AVISIT, ~ASEQ, ~AVAL, + "1", "WEEK 1", 1, 10, + "1", "WEEK 1", 2, NA, + "1", "WEEK 2", 3, NA, + "1", "WEEK 3", 4, 42, + "1", "WEEK 4", 5, 12, + "1", "WEEK 4", 6, 12, + "1", "WEEK 4", 7, 15, + "2", "WEEK 1", 1, 21, + "2", "WEEK 4", 2, 22 +) + +derive_var_merged_summary( + adbds, + dataset_add = adbds, + by_vars = vars(USUBJID, AVISIT), + new_var = MEANVIS, + analysis_var = AVAL, + summary_fun = function(x) mean(x, na.rm = TRUE) +) + +# Add a variable listing the lesion ids at baseline +adsl <- tribble( + ~USUBJID, + "1", + "2", + "3" +) + +adtr <- tribble( + ~USUBJID, ~AVISIT, ~LESIONID, + "1", "BASELINE", "INV-T1", + "1", "BASELINE", "INV-T2", + "1", "BASELINE", "INV-T3", + "1", "BASELINE", "INV-T4", + "1", "WEEK 1", "INV-T1", + "1", "WEEK 1", "INV-T2", + "1", "WEEK 1", "INV-T4", + "2", "BASELINE", "INV-T1", + "2", "BASELINE", "INV-T2", + "2", "BASELINE", "INV-T3", + "2", "WEEK 1", "INV-T1", + "2", "WEEK 1", "INV-N1" +) + +derive_var_merged_summary( + adsl, + dataset_add = adtr, + by_vars = vars(USUBJID), + filter_add = AVISIT == "BASELINE", + new_var = LESIONSBL, + analysis_var = LESIONID, + summary_fun = function(x) paste(x, collapse = ", ") +) + +} +\seealso{ +\code{\link[=derive_summary_records]{derive_summary_records()}}, \code{\link[=get_summary_records]{get_summary_records()}} + +General Derivation Functions for all ADaMs that returns variable appended to dataset: +\code{\link{derive_var_confirmation_flag}()}, +\code{\link{derive_var_extreme_flag}()}, +\code{\link{derive_var_last_dose_amt}()}, +\code{\link{derive_var_last_dose_date}()}, +\code{\link{derive_var_last_dose_grp}()}, +\code{\link{derive_var_merged_cat}()}, +\code{\link{derive_var_merged_character}()}, +\code{\link{derive_var_merged_exist_flag}()}, +\code{\link{derive_var_obs_number}()}, +\code{\link{derive_var_relative_flag}()}, +\code{\link{derive_var_worst_flag}()}, +\code{\link{derive_vars_joined}()}, +\code{\link{derive_vars_last_dose}()}, +\code{\link{derive_vars_merged_lookup}()}, +\code{\link{derive_vars_merged}()}, +\code{\link{derive_vars_transposed}()}, +\code{\link{get_summary_records}()} +} +\author{ +Stefan Bundfuss +} +\concept{der_gen} +\keyword{der_gen} diff --git a/man/derive_var_obs_number.Rd b/man/derive_var_obs_number.Rd index d9ec2e4a76..0ad438b802 100644 --- a/man/derive_var_obs_number.Rd +++ b/man/derive_var_obs_number.Rd @@ -81,7 +81,10 @@ General Derivation Functions for all ADaMs that returns variable appended to dat \code{\link{derive_var_merged_cat}()}, \code{\link{derive_var_merged_character}()}, \code{\link{derive_var_merged_exist_flag}()}, +\code{\link{derive_var_merged_summary}()}, +\code{\link{derive_var_relative_flag}()}, \code{\link{derive_var_worst_flag}()}, +\code{\link{derive_vars_joined}()}, \code{\link{derive_vars_last_dose}()}, \code{\link{derive_vars_merged_lookup}()}, \code{\link{derive_vars_merged}()}, diff --git a/man/derive_var_ontrtfl.Rd b/man/derive_var_ontrtfl.Rd index 4b161383da..50716386f0 100644 --- a/man/derive_var_ontrtfl.Rd +++ b/man/derive_var_ontrtfl.Rd @@ -12,6 +12,7 @@ derive_var_ontrtfl( ref_start_date, ref_end_date = NULL, ref_end_window = 0, + ignore_time_for_ref_end_date = TRUE, filter_pre_timepoint = NULL, span_period = NULL ) @@ -61,6 +62,12 @@ considered on-treatment. Default is \code{NULL}.} measured in days (e.g. 7 if 7 days should be added to the upper bound) Optional; default is 0.} +\item{ignore_time_for_ref_end_date}{If the argument is set to \code{TRUE}, the time part is ignored for checking if +the event occurred more than \code{ref_end_window} days after reference end +date. + +\emph{Permitted Values:} \code{TRUE}, \code{FALSE}} + \item{filter_pre_timepoint}{An expression to filter observations as not on-treatment when \code{date} = \code{ref_start_date}. For example, if observations where \code{VSTPT = PRE} should not be considered on-treatment when \code{date = ref_start_date}, \code{filter_pre_timepoint} should be used to denote when the @@ -108,8 +115,8 @@ Any date imputations needed should be done prior to calling this function. } \examples{ library(tibble) -library(dplyr) -library(lubridate, warn.conflict = FALSE) +library(dplyr, warn.conflicts = FALSE) +library(lubridate, warn.conflicts = FALSE) advs <- tribble( ~USUBJID, ~ADT, ~TRTSDT, ~TRTEDT, diff --git a/man/derive_var_pchg.Rd b/man/derive_var_pchg.Rd index 94e017edaf..874f6a3c02 100644 --- a/man/derive_var_pchg.Rd +++ b/man/derive_var_pchg.Rd @@ -22,7 +22,9 @@ baseline by the absolute value of the baseline value and multiplying the result by \code{100}. } \examples{ -advs <- tibble::tribble( +library(tibble) + +advs <- tribble( ~USUBJID, ~PARAMCD, ~AVAL, ~ABLFL, ~BASE, "P01", "WEIGHT", 80, "Y", 80, "P01", "WEIGHT", 80.8, "", 80, diff --git a/man/derive_var_relative_flag.Rd b/man/derive_var_relative_flag.Rd new file mode 100644 index 0000000000..4ffff81160 --- /dev/null +++ b/man/derive_var_relative_flag.Rd @@ -0,0 +1,196 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/derive_var_relative_flag.R +\name{derive_var_relative_flag} +\alias{derive_var_relative_flag} +\title{Flag Observations Before or After a Condition is Fulfilled} +\usage{ +derive_var_relative_flag( + dataset, + by_vars, + order, + new_var, + condition, + mode, + selection, + inclusive, + flag_no_ref_groups = TRUE, + check_type = "warning" +) +} +\arguments{ +\item{dataset}{Input dataset + +The variables specified by the \code{order} and the \code{by_vars} argument are +expected.} + +\item{by_vars}{Grouping variables + +\emph{Permitted Values:} list of variables created by \code{vars()}} + +\item{order}{Sort order + +Within each by group the observations are ordered by the specified order. + +\emph{Permitted Values:} list of variables or \verb{desc()} function calls +created by \code{vars()}, e.g., \code{vars(ADT, desc(AVAL))}} + +\item{new_var}{New variable + +The variable is added to the input dataset and set to \code{"Y"} for all +observations before or after the condition is fulfilled. For all other +observations it is set to \code{NA}.} + +\item{condition}{Condition for Reference Observation + +The specified condition determines the reference observation. In the output +dataset all observations before or after (\code{selection} argument) +the reference observation are flagged.} + +\item{mode}{Selection mode (first or last) + +If \code{"first"} is specified, for each by group the observations before or +after (\code{selection} argument) the observation where the condition +(\code{condition} argument) is fulfilled the \emph{first} time is flagged in the +output dataset. If \code{"last"} is specified, for each by group the +observations before or after (\code{selection} argument) the observation where +the condition (\code{condition} argument) is fulfilled the \emph{last} time is +flagged in the output dataset. + +\emph{Permitted Values:} \code{"first"}, \code{"last"}} + +\item{selection}{Flag observations before or after the reference observation? + +\emph{Permitted Values:} \code{"before"}, \code{"after"}} + +\item{inclusive}{Flag the reference observation? + +\emph{Permitted Values:} \code{TRUE}, \code{FALSE}} + +\item{flag_no_ref_groups}{Should by groups without reference observation be flagged? + +\emph{Permitted Values:} \code{TRUE}, \code{FALSE}} + +\item{check_type}{Check uniqueness? + +If \code{"warning"} or \code{"error"} is specified, the specified message is issued +if the observations of the input dataset are not unique with respect to the +by variables and the order. + +\emph{Permitted Values:} \code{"none"}, \code{"warning"}, \code{"error"}} +} +\value{ +The input dataset with the new variable (\code{new_var}) added +} +\description{ +Flag all observations before or after the observation where a specified +condition is fulfilled for each by group. For example, the function could be +called to flag for each subject all observations before the first disease +progression or to flag all AEs after a specific AE. +} +\details{ +For each by group (\code{by_vars} argument) the observations before or +after (\code{selection} argument) the observations where the condition +(\code{condition} argument) is fulfilled the first or last time (\code{order} +argument and \code{mode} argument) is flagged in the output dataset. +} +\examples{ +library(tibble) +library(dplyr, warn.conflicts = FALSE) + +# Flag all AEs after the first COVID AE +adae <- tribble( + ~USUBJID, ~ASTDY, ~ACOVFL, ~AESEQ, + "1", 2, NA, 1, + "1", 5, "Y", 2, + "1", 5, NA, 3, + "1", 17, NA, 4, + "1", 27, "Y", 5, + "1", 32, NA, 6, + "2", 8, NA, 1, + "2", 11, NA, 2, +) + +derive_var_relative_flag( + adae, + by_vars = vars(USUBJID), + order = vars(ASTDY, AESEQ), + new_var = PSTCOVFL, + condition = ACOVFL == "Y", + mode = "first", + selection = "after", + inclusive = FALSE, + flag_no_ref_groups = FALSE +) + +response <- tribble( + ~USUBJID, ~AVISITN, ~AVALC, + "1", 0, "PR", + "1", 1, "CR", + "1", 2, "CR", + "1", 3, "SD", + "1", 4, "NE", + "2", 0, "SD", + "2", 1, "PD", + "2", 2, "PD", + "3", 0, "SD", + "4", 0, "SD", + "4", 1, "PR", + "4", 2, "PD", + "4", 3, "SD", + "4", 4, "PR" +) + +# Flag observations up to first PD for each patient +response \%>\% + derive_var_relative_flag( + by_vars = vars(USUBJID), + order = vars(AVISITN), + new_var = ANL02FL, + condition = AVALC == "PD", + mode = "first", + selection = "before", + inclusive = TRUE + ) + +# Flag observations up to first PD excluding baseline (AVISITN = 0) for each patient +response \%>\% + restrict_derivation( + derivation = derive_var_relative_flag, + args = params( + by_vars = vars(USUBJID), + order = vars(AVISITN), + new_var = ANL02FL, + condition = AVALC == "PD", + mode = "first", + selection = "before", + inclusive = TRUE + ), + filter = AVISITN > 0 + ) \%>\% + arrange(USUBJID, AVISITN) +} +\seealso{ +General Derivation Functions for all ADaMs that returns variable appended to dataset: +\code{\link{derive_var_confirmation_flag}()}, +\code{\link{derive_var_extreme_flag}()}, +\code{\link{derive_var_last_dose_amt}()}, +\code{\link{derive_var_last_dose_date}()}, +\code{\link{derive_var_last_dose_grp}()}, +\code{\link{derive_var_merged_cat}()}, +\code{\link{derive_var_merged_character}()}, +\code{\link{derive_var_merged_exist_flag}()}, +\code{\link{derive_var_merged_summary}()}, +\code{\link{derive_var_obs_number}()}, +\code{\link{derive_var_worst_flag}()}, +\code{\link{derive_vars_joined}()}, +\code{\link{derive_vars_last_dose}()}, +\code{\link{derive_vars_merged_lookup}()}, +\code{\link{derive_vars_merged}()}, +\code{\link{derive_vars_transposed}()}, +\code{\link{get_summary_records}()} +} +\author{ +Stefan Bundfuss +} +\concept{der_gen} +\keyword{der_gen} diff --git a/man/derive_var_shift.Rd b/man/derive_var_shift.Rd index ce4826a983..8ac09bd547 100644 --- a/man/derive_var_shift.Rd +++ b/man/derive_var_shift.Rd @@ -46,9 +46,9 @@ analysis value, shift from baseline grade to analysis grade, ... missing value is replaced by \code{na_val} (e.g. "NORMAL to NULL"). } \examples{ -library(dplyr, warn.conflicts = FALSE) +library(tibble) -data <- tibble::tribble( +data <- tribble( ~USUBJID, ~PARAMCD, ~AVAL, ~ABLFL, ~BNRIND, ~ANRIND, "P01", "ALB", 33, "Y", "LOW", "LOW", "P01", "ALB", 38, NA, "LOW", "NORMAL", diff --git a/man/derive_var_trtdurd.Rd b/man/derive_var_trtdurd.Rd index 12f9fb4afb..8ac35edf71 100644 --- a/man/derive_var_trtdurd.Rd +++ b/man/derive_var_trtdurd.Rd @@ -41,9 +41,12 @@ The total treatment duration is derived as the number of days from start to end date plus one. } \examples{ -data <- tibble::tribble( +library(tibble) +library(lubridate) + +data <- tribble( ~TRTSDT, ~TRTEDT, - lubridate::ymd("2020-01-01"), lubridate::ymd("2020-02-24") + ymd("2020-01-01"), ymd("2020-02-24") ) derive_var_trtdurd(data) diff --git a/man/derive_var_trtemfl.Rd b/man/derive_var_trtemfl.Rd new file mode 100644 index 0000000000..6d583d11b2 --- /dev/null +++ b/man/derive_var_trtemfl.Rd @@ -0,0 +1,183 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/derive_var_trtemfl.R +\name{derive_var_trtemfl} +\alias{derive_var_trtemfl} +\title{Derive Treatment-emergent Flag} +\usage{ +derive_var_trtemfl( + dataset, + new_var = TRTEMFL, + start_date = ASTDTM, + end_date = AENDTM, + trt_start_date = TRTSDTM, + trt_end_date = NULL, + end_window = NULL, + ignore_time_for_trt_end = TRUE, + initial_intensity = NULL, + intensity = NULL +) +} +\arguments{ +\item{dataset}{Input dataset + +The variables specified by \code{start_date}, \code{end_date}, \code{trt_start_date}, +\code{trt_end_date}, \code{initial_intensity}, and \code{intensity} are expected.} + +\item{new_var}{New variable} + +\item{start_date}{Event start date + +\emph{Permitted Values:} A symbol referring to a date or datetime variable of +the input dataset} + +\item{end_date}{Event end date + +\emph{Permitted Values:} A symbol referring to a date or datetime variable of +the input dataset} + +\item{trt_start_date}{Treatment start date + +\emph{Permitted Values:} A symbol referring to a date or datetime variable of +the input dataset} + +\item{trt_end_date}{Treatment end date + +\emph{Permitted Values:} A symbol referring to a date or datetime variable of +the input dataset or \code{NULL}} + +\item{end_window}{If the argument is specified, events starting more than the specified +number of days after end of treatment, are not flagged. + +\emph{Permitted Values:} A non-negative integer or \code{NULL}} + +\item{ignore_time_for_trt_end}{If the argument is set to \code{TRUE}, the time part is ignored for checking if +the event occurred more than \code{end_window} days after end of treatment. + +\emph{Permitted Values:} \code{TRUE}, \code{FALSE}} + +\item{initial_intensity}{Initial severity/intensity or toxicity + +This derivation assumes AE data collection method as single record per AE +with “initial” and “most extreme” severity/intensity recorded separately. + +If the argument is specified, events which start before treatment start and +end after treatment start (or are ongoing) and worsened (i.e., the +intensity is greater than the initial intensity), are flagged. + +The values of the specified variable must be comparable with the usual +comparison operators. I.e., if the intensity is greater than the initial +intensity \code{initial_intensity < intensity} must evaluate to \code{TRUE}. + +\emph{Permitted Values:} A symbol referring to a variable of the input dataset +or \code{NULL}} + +\item{intensity}{Severity/intensity or toxicity + +If the argument is specified, events which start before treatment start and +end after treatment start (or are ongoing) and worsened (i.e., the +intensity is greater than the initial intensity), are flagged. + +The values of the specified variable must be comparable with the usual +comparison operators. I.e., if the intensity is greater than the initial +intensity \code{initial_intensity < intensity} must evaluate to \code{TRUE}. + +\emph{Permitted Values:} A symbol referring to a variable of the input dataset +or \code{NULL}} +} +\value{ +The input dataset with the variable specified by \code{new_var} added +} +\description{ +Derive treatment emergent analysis flag (e.g., \code{TRTEMFL}). +} +\details{ +For the derivation of the new variable the following cases are +considered in this order. The first case which applies, defines the value +of the variable. +\itemize{ +\item \emph{not treated}: If \code{trt_start_date} is \code{NA}, it is set to \code{NA_character_}. +\item \emph{event before treatment}: If \code{end_date} is before \code{trt_start_date} (and +\code{end_date} is not \code{NA}), it is set to \code{NA_character_}. +\item \emph{no event date}: If \code{start_date} is \code{NA}, it is set to \code{"Y"} as in such +cases it is usually considered more conservative to assume the event was +treatment-emergent. +\item \emph{event started during treatment}: +\itemize{ +\item if \code{end_window} is not specified: +if \code{start_date} is on or after \code{trt_start_date}, it is set to \code{"Y"}, +\item if \code{end_window} is specified: +if \code{start_date} is on or after \code{trt_start_date} and \code{start_date} is on +or before \code{trt_end_date} + \code{end_window} days, it is set to \code{"Y"}, +} +\item \emph{event started before treatment and (possibly) worsened on treatment}: +\itemize{ +\item if \code{initial_intensity} and \code{intensity} is specified: if +\code{initial_intensity < intensity} and \code{start_date} is before +\code{trt_start_date} and \code{end_date} is on or after \code{trt_start_date} or +\code{end_date} is \code{NA}, it is set to \code{"Y"}. +} +\item Otherwise it is set to \code{NA_character_}. +} +} +\examples{ + +library(tibble) +library(dplyr, warn.conflicts = FALSE) +library(lubridate) + +adae <- expected <- tribble( + ~USUBJID, ~ASTDTM, ~AENDTM, ~AEITOXGR, ~AETOXGR, + # before treatment + "1", "2021-12-13T20:15", "2021-12-15T12:45", "1", "1", + "1", "2021-12-14T20:15", "2021-12-14T22:00", "1", "3", + # starting before treatment and ending during treatment + "1", "2021-12-30T20:00", "2022-01-14T11:00", "1", "3", + "1", "2021-12-31T20:15", "2022-01-01T01:23", "1", "1", + # starting during treatment + "1", "2022-01-01T12:00", "2022-01-02T23:25", "3", "4", + # after treatment + "1", "2022-05-10T11:00", "2022-05-10T13:05", "2", "2", + "1", "2022-05-11T11:00", "2022-05-11T13:05", "2", "2", + # missing dates + "1", "", "", "3", "4", + "1", "2021-12-30T09:00", "", "3", "4", + "1", "2021-12-30T11:00", "", "3", "3", + "1", "", "2022-01-04T09:00", "3", "4", + "1", "", "2021-12-24T19:00", "3", "4", + "1", "", "2022-06-04T09:00", "3", "4", + # without treatment + "2", "", "2021-12-03T12:00", "1", "2", + "2", "2021-12-01T12:00", "2021-12-03T12:00", "1", "2", + "2", "2021-12-06T18:00", "", "1", "2" +) \%>\% + mutate( + ASTDTM = ymd_hm(ASTDTM), + AENDTM = ymd_hm(AENDTM), + TRTSDTM = if_else(USUBJID == "1", ymd_hm("2022-01-01T01:01"), ymd_hms("")), + TRTEDTM = if_else(USUBJID == "1", ymd_hm("2022-04-30T23:59"), ymd_hms("")) + ) + +# derive TRTEMFL without considering treatment end and worsening +derive_var_trtemfl(adae) \%>\% select(ASTDTM, AENDTM, TRTSDTM, TRTEMFL) + +# derive TRTEM2FL taking treatment end and worsening into account +derive_var_trtemfl( + adae, + new_var = TRTEM2FL, + trt_end_date = TRTEDTM, + end_window = 10, + initial_intensity = AEITOXGR, + intensity = AETOXGR +) \%>\% select(ASTDTM, AENDTM, AEITOXGR, AETOXGR, TRTEM2FL) +} +\seealso{ +OCCDS Functions: +\code{\link{derive_vars_atc}()}, +\code{\link{derive_vars_query}()}, +\code{\link{get_terms_from_db}()} +} +\author{ +Stefan Bundfuss +} +\concept{der_occds} +\keyword{der_occds} diff --git a/man/derive_var_worst_flag.Rd b/man/derive_var_worst_flag.Rd index cb0aea7e7f..0a67c41982 100644 --- a/man/derive_var_worst_flag.Rd +++ b/man/derive_var_worst_flag.Rd @@ -78,8 +78,10 @@ arguments \code{worst_high} / \code{worst_low}, i.e. for some parameters the hig and for others the worst is the lowest value. } \examples{ +library(tibble) +library(dplyr, warn.conflicts = FALSE) -input <- tibble::tribble( +input <- tribble( ~STUDYID, ~USUBJID, ~PARAMCD, ~AVISIT, ~ADT, ~AVAL, "TEST01", "PAT01", "PARAM01", "BASELINE", as.Date("2021-04-27"), 15.0, "TEST01", "PAT01", "PARAM01", "BASELINE", as.Date("2021-04-25"), 14.0, @@ -149,7 +151,10 @@ General Derivation Functions for all ADaMs that returns variable appended to dat \code{\link{derive_var_merged_cat}()}, \code{\link{derive_var_merged_character}()}, \code{\link{derive_var_merged_exist_flag}()}, +\code{\link{derive_var_merged_summary}()}, \code{\link{derive_var_obs_number}()}, +\code{\link{derive_var_relative_flag}()}, +\code{\link{derive_vars_joined}()}, \code{\link{derive_vars_last_dose}()}, \code{\link{derive_vars_merged_lookup}()}, \code{\link{derive_vars_merged}()}, diff --git a/man/derive_vars_aage.Rd b/man/derive_vars_aage.Rd index e7e3413f51..8dc3c6869f 100644 --- a/man/derive_vars_aage.Rd +++ b/man/derive_vars_aage.Rd @@ -57,9 +57,12 @@ here, results are calculated based on the actual calendar length of months or ye rather than assuming equal days every month (30.4375 days) or every year (365.25 days). } \examples{ -data <- tibble::tribble( +library(tibble) +library(lubridate) + +data <- tribble( ~BRTHDT, ~RANDDT, - lubridate::ymd("1984-09-06"), lubridate::ymd("2020-02-24") + ymd("1984-09-06"), ymd("2020-02-24") ) derive_vars_aage(data) @@ -73,7 +76,8 @@ ADSL Functions that returns variable appended to dataset: \code{\link{derive_var_dthcaus}()}, \code{\link{derive_var_extreme_dtm}()}, \code{\link{derive_var_extreme_dt}()}, -\code{\link{derive_vars_disposition_reason}()} +\code{\link{derive_vars_disposition_reason}()}, +\code{\link{derive_vars_period}()} } \author{ Stefan Bundfuss diff --git a/man/derive_vars_atc.Rd b/man/derive_vars_atc.Rd index e0858a5f27..38b30f9f00 100644 --- a/man/derive_vars_atc.Rd +++ b/man/derive_vars_atc.Rd @@ -37,13 +37,15 @@ The input dataset with ATC variables added Add Anatomical Therapeutic Chemical class variables from \code{FACM} to \code{ADCM} } \examples{ -cm <- tibble::tribble( +library(tibble) + +cm <- tribble( ~USUBJID, ~CMGRPID, ~CMREFID, ~CMDECOD, "BP40257-1001", "14", "1192056", "PARACETAMOL", "BP40257-1001", "18", "2007001", "SOLUMEDROL", "BP40257-1002", "19", "2791596", "SPIRONOLACTONE" ) -facm <- tibble::tribble( +facm <- tribble( ~USUBJID, ~FAGRPID, ~FAREFID, ~FATESTCD, ~FASTRESC, "BP40257-1001", "1", "1192056", "CMATC1CD", "N", "BP40257-1001", "1", "1192056", "CMATC2CD", "N02", @@ -71,8 +73,7 @@ derive_vars_atc(cm, facm) } \seealso{ OCCDS Functions: -\code{\link{create_query_data}()}, -\code{\link{create_single_dose_dataset}()}, +\code{\link{derive_var_trtemfl}()}, \code{\link{derive_vars_query}()}, \code{\link{get_terms_from_db}()} } diff --git a/man/derive_vars_disposition_reason.Rd b/man/derive_vars_disposition_reason.Rd index 0c3fe7bc24..ff1bf239cb 100644 --- a/man/derive_vars_disposition_reason.Rd +++ b/man/derive_vars_disposition_reason.Rd @@ -13,7 +13,7 @@ derive_vars_disposition_reason( reason_var_spe = NULL, format_new_vars = format_reason_default, filter_ds, - subject_keys = vars(STUDYID, USUBJID) + subject_keys = get_admiral_option("subject_keys") ) } \arguments{ @@ -151,7 +151,8 @@ ADSL Functions that returns variable appended to dataset: \code{\link{derive_var_dthcaus}()}, \code{\link{derive_var_extreme_dtm}()}, \code{\link{derive_var_extreme_dt}()}, -\code{\link{derive_vars_aage}()} +\code{\link{derive_vars_aage}()}, +\code{\link{derive_vars_period}()} } \author{ Samia Kabi diff --git a/man/derive_vars_dtm_to_dt.Rd b/man/derive_vars_dtm_to_dt.Rd index d497fd545f..2be6aca903 100644 --- a/man/derive_vars_dtm_to_dt.Rd +++ b/man/derive_vars_dtm_to_dt.Rd @@ -20,10 +20,11 @@ variable(s) of all datetime variables (\code{--DTM}) specified in \code{source_v This function creates date(s) as output from datetime variable(s) } \examples{ +library(tibble) library(dplyr, warn.conflicts = FALSE) library(lubridate) -adcm <- tibble::tribble( +adcm <- tribble( ~USUBJID, ~TRTSDTM, ~ASTDTM, ~AENDTM, "PAT01", "2012-02-25 23:00:00", "2012-02-28 19:00:00", "2012-02-25 23:00:00", "PAT01", NA, "2012-02-28 19:00:00", NA, diff --git a/man/derive_vars_dtm_to_tm.Rd b/man/derive_vars_dtm_to_tm.Rd index 9e5be733c2..007f1c63b9 100644 --- a/man/derive_vars_dtm_to_tm.Rd +++ b/man/derive_vars_dtm_to_tm.Rd @@ -26,10 +26,11 @@ The names of the newly added variables are automatically set by replacing the using the {hms} package. } \examples{ +library(tibble) library(dplyr, warn.conflicts = FALSE) library(lubridate) -adcm <- tibble::tribble( +adcm <- tribble( ~USUBJID, ~TRTSDTM, ~ASTDTM, ~AENDTM, "PAT01", "2012-02-25 23:41:10", "2012-02-28 19:03:00", "2013-02-25 23:32:16", "PAT01", "", "2012-02-28 19:00:00", "", diff --git a/man/derive_vars_dy.Rd b/man/derive_vars_dy.Rd index 3681f8ee43..03c20224fe 100644 --- a/man/derive_vars_dy.Rd +++ b/man/derive_vars_dy.Rd @@ -42,10 +42,11 @@ from the source variable name by replacing DT (or DTM as appropriate) with DY. } \examples{ +library(tibble) library(lubridate) -library(dplyr) +library(dplyr, warn.conflicts = FALSE) -datain <- tibble::tribble( +datain <- tribble( ~TRTSDTM, ~ASTDTM, ~AENDT, "2014-01-17T23:59:59", "2014-01-18T13:09:O9", "2014-01-20" ) \%>\% @@ -62,7 +63,7 @@ derive_vars_dy( ) # specifying name of new variables -datain <- tibble::tribble( +datain <- tribble( ~TRTSDT, ~DTHDT, "2014-01-17", "2014-02-01" ) \%>\% diff --git a/man/derive_vars_joined.Rd b/man/derive_vars_joined.Rd new file mode 100644 index 0000000000..42654949d1 --- /dev/null +++ b/man/derive_vars_joined.Rd @@ -0,0 +1,294 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/derive_joined.R +\name{derive_vars_joined} +\alias{derive_vars_joined} +\title{Add Variables from an Additional Dataset Based on Conditions from Both Datasets} +\usage{ +derive_vars_joined( + dataset, + dataset_add, + by_vars = NULL, + order = NULL, + new_vars = NULL, + join_vars = NULL, + filter_add = NULL, + filter_join = NULL, + mode = NULL, + check_type = "warning" +) +} +\arguments{ +\item{dataset}{Input dataset + +The variables specified by \code{by_vars} are expected.} + +\item{dataset_add}{Additional dataset + +The variables specified by the \code{by_vars}, the \code{new_vars}, the \code{join_vars}, +and the \code{order} argument are expected.} + +\item{by_vars}{Grouping variables + +The two datasets are joined by the specified variables. Variables from the +additional dataset can be renamed by naming the element, i.e., \verb{by_vars = vars( = )}. + +\emph{Permitted Values}: list of variables created by \code{vars()}} + +\item{order}{Sort order + +If the argument is set to a non-null value, for each observation of the +input dataset the first or last observation from the joined dataset is +selected with respect to the specified order. The specified variables are +expected in the additional dataset (\code{dataset_add}). If a variable is +available in both \code{dataset} and \code{dataset_add}, the one from \code{dataset_add} +is used for the sorting. + +\emph{Permitted Values}: list of variables or \verb{desc()} function calls +created by \code{vars()}, e.g., \code{vars(ADT, desc(AVAL))} or \code{NULL}} + +\item{new_vars}{Variables to add + +The specified variables from the additional dataset are added to the output +dataset. Variables can be renamed by naming the element, i.e., \verb{new_vars = vars( = )}. + +For example \code{new_vars = vars(var1, var2)} adds variables \code{var1} and \code{var2} +from \code{dataset_add} to the input dataset. + +And \code{new_vars = vars(var1, new_var2 = old_var2)} takes \code{var1} and +\code{old_var2} from \code{dataset_add} and adds them to the input dataset renaming +\code{old_var2} to \code{new_var2}. + +If the argument is not specified or set to \code{NULL}, all variables from the +additional dataset (\code{dataset_add}) are added. + +\emph{Permitted Values}: list of variables created by \code{vars()}} + +\item{join_vars}{Variables to use from additional dataset + +Any extra variables required from the additional dataset for \code{filter_join} +should be specified for this argument. Variables specified for \code{new_vars} +do not need to be repeated for \code{join_vars}. If a specified variable exists +in both the input dataset and the additional dataset, the suffix ".join" is +added to the variable from the additional dataset. + +The variables are not included in the output dataset. + +\emph{Permitted Values}: list of variables created by \code{vars()}} + +\item{filter_add}{Filter for additional dataset (\code{dataset_add}) + +Only observations from \code{dataset_add} fulfilling the specified condition are +joined to the input dataset. If the argument is not specified, all +observations are joined. + +\emph{Permitted Values}: a condition} + +\item{filter_join}{Filter for the joined dataset + +The specified condition is applied to the joined dataset. Therefore +variables from both datasets \code{dataset} and \code{dataset_add} can be used. + +\emph{Permitted Values}: a condition} + +\item{mode}{Selection mode + +Determines if the first or last observation is selected. If the \code{order} +argument is specified, \code{mode} must be non-null. + +If the \code{order} argument is not specified, the \code{mode} argument is ignored. + +\emph{Permitted Values}: \code{"first"}, \code{"last"}, \code{NULL}} + +\item{check_type}{Check uniqueness? + +If \code{"warning"} or \code{"error"} is specified, the specified message is issued +if the observations of the (restricted) joined dataset are not unique +with respect to the by variables and the order. + +This argument is ignored if \code{order} is not specified. In this case an error +is issued independent of \code{check_type} if the restricted joined dataset +contains more than one observation for any of the observations of the input +dataset. + +\emph{Permitted Values}: \code{"none"}, \code{"warning"}, \code{"error"}} +} +\value{ +The output dataset contains all observations and variables of the +input dataset and additionally the variables specified for \code{new_vars} from +the additional dataset (\code{dataset_add}). +} +\description{ +The function adds variables from an additional dataset to the input dataset. +The selection of the observations from the additional dataset can depend on +variables from both datasets. For example, add the lowest value (nadir) +before the current observation. +} +\details{ +\enumerate{ +\item The records from the additional dataset (\code{dataset_add}) are restricted +to those matching the \code{filter_add} condition. +\item The input dataset and the (restricted) additional dataset are left +joined by the grouping variables (\code{by_vars}). If no grouping variables are +specified, a full join is performed. +\item The joined dataset is restricted by the \code{filter_join} condition. +\item If \code{order} is specified, for each observation of the input dataset the +first or last observation (depending on \code{mode}) is selected. +\item The variables specified for \code{new_vars} are renamed (if requested) and +merged to the input dataset. I.e., the output dataset contains all +observations from the input dataset. For observations without a matching +observation in the joined dataset the new variables are set to \code{NA}. +Observations in the additional dataset which have no matching observation +in the input dataset are ignored. +} +} +\examples{ +library(tibble) +library(lubridate) +library(dplyr, warn.conflicts = FALSE) +library(tidyr) + +# Add AVISIT (based on time windows), AWLO, and AWHI +adbds <- tribble( + ~USUBJID, ~ADY, + "1", -33, + "1", -2, + "1", 3, + "1", 24, + "2", NA, +) + +windows <- tribble( + ~AVISIT, ~AWLO, ~AWHI, + "BASELINE", -30, 1, + "WEEK 1", 2, 7, + "WEEK 2", 8, 15, + "WEEK 3", 16, 22, + "WEEK 4", 23, 30 +) + +derive_vars_joined( + adbds, + dataset_add = windows, + filter_join = AWLO <= ADY & ADY <= AWHI +) + +# derive the nadir after baseline and before the current observation +adbds <- tribble( + ~USUBJID, ~ADY, ~AVAL, + "1", -7, 10, + "1", 1, 12, + "1", 8, 11, + "1", 15, 9, + "1", 20, 14, + "1", 24, 12, + "2", 13, 8 +) + +derive_vars_joined( + adbds, + dataset_add = adbds, + by_vars = vars(USUBJID), + order = vars(AVAL), + new_vars = vars(NADIR = AVAL), + join_vars = vars(ADY), + filter_add = ADY > 0, + filter_join = ADY.join < ADY, + mode = "first", + check_type = "none" +) + +# add highest hemoglobin value within two weeks before AE, +# take earliest if more than one +adae <- tribble( + ~USUBJID, ~ASTDY, + "1", 3, + "1", 22, + "2", 2 +) + +adlb <- tribble( + ~USUBJID, ~PARAMCD, ~ADY, ~AVAL, + "1", "HGB", 1, 8.5, + "1", "HGB", 3, 7.9, + "1", "HGB", 5, 8.9, + "1", "HGB", 8, 8.0, + "1", "HGB", 9, 8.0, + "1", "HGB", 16, 7.4, + "1", "HGB", 24, 8.1, + "1", "ALB", 1, 42, +) + +derive_vars_joined( + adae, + dataset_add = adlb, + by_vars = vars(USUBJID), + order = vars(AVAL, desc(ADY)), + new_vars = vars(HGB_MAX = AVAL, HGB_DY = ADY), + filter_add = PARAMCD == "HGB", + filter_join = ASTDY - 14 <= ADY & ADY <= ASTDY, + mode = "last" +) + +# Add APERIOD, APERIODC based on ADSL +adsl <- tribble( + ~USUBJID, ~AP01SDT, ~AP01EDT, ~AP02SDT, ~AP02EDT, + "1", "2021-01-04", "2021-02-06", "2021-02-07", "2021-03-07", + "2", "2021-02-02", "2021-03-02", "2021-03-03", "2021-04-01" +) \%>\% + mutate(across(ends_with("DT"), ymd)) \%>\% + mutate(STUDYID = "xyz") + +period_ref <- create_period_dataset( + adsl, + new_vars = vars(APERSDT = APxxSDT, APEREDT = APxxEDT) +) + +period_ref + +adae <- tribble( + ~USUBJID, ~ASTDT, + "1", "2021-01-01", + "1", "2021-01-05", + "1", "2021-02-05", + "1", "2021-03-05", + "1", "2021-04-05", + "2", "2021-02-15", +) \%>\% + mutate( + ASTDT = ymd(ASTDT), + STUDYID = "xyz" + ) + +derive_vars_joined( + adae, + dataset_add = period_ref, + by_vars = vars(STUDYID, USUBJID), + join_vars = vars(APERSDT, APEREDT), + filter_join = APERSDT <= ASTDT & ASTDT <= APEREDT +) +} +\seealso{ +General Derivation Functions for all ADaMs that returns variable appended to dataset: +\code{\link{derive_var_confirmation_flag}()}, +\code{\link{derive_var_extreme_flag}()}, +\code{\link{derive_var_last_dose_amt}()}, +\code{\link{derive_var_last_dose_date}()}, +\code{\link{derive_var_last_dose_grp}()}, +\code{\link{derive_var_merged_cat}()}, +\code{\link{derive_var_merged_character}()}, +\code{\link{derive_var_merged_exist_flag}()}, +\code{\link{derive_var_merged_summary}()}, +\code{\link{derive_var_obs_number}()}, +\code{\link{derive_var_relative_flag}()}, +\code{\link{derive_var_worst_flag}()}, +\code{\link{derive_vars_last_dose}()}, +\code{\link{derive_vars_merged_lookup}()}, +\code{\link{derive_vars_merged}()}, +\code{\link{derive_vars_transposed}()}, +\code{\link{get_summary_records}()} +} +\author{ +Stefan Bundfuss +} +\concept{der_gen} +\keyword{der_gen} diff --git a/man/derive_vars_last_dose.Rd b/man/derive_vars_last_dose.Rd index b6c3740b0d..00afbcfc4c 100644 --- a/man/derive_vars_last_dose.Rd +++ b/man/derive_vars_last_dose.Rd @@ -138,7 +138,7 @@ adae \%>\% new_vars = vars(EXDOSE, EXTRT, EXSEQ, EXENDTC, VISIT), dose_date = EXENDTM, analysis_date = ASTDTM, - traceability_vars = dplyr::vars(LDOSEDOM = "EX", LDOSESEQ = EXSEQ, LDOSEVAR = "EXENDTC") + traceability_vars = vars(LDOSEDOM = "EX", LDOSESEQ = EXSEQ, LDOSEVAR = "EXENDTC") ) \%>\% select(STUDYID, USUBJID, AESEQ, AESTDTC, EXDOSE, EXTRT, EXENDTC, LDOSEDOM, LDOSESEQ, LDOSEVAR) } @@ -155,8 +155,11 @@ General Derivation Functions for all ADaMs that returns variable appended to dat \code{\link{derive_var_merged_cat}()}, \code{\link{derive_var_merged_character}()}, \code{\link{derive_var_merged_exist_flag}()}, +\code{\link{derive_var_merged_summary}()}, \code{\link{derive_var_obs_number}()}, +\code{\link{derive_var_relative_flag}()}, \code{\link{derive_var_worst_flag}()}, +\code{\link{derive_vars_joined}()}, \code{\link{derive_vars_merged_lookup}()}, \code{\link{derive_vars_merged}()}, \code{\link{derive_vars_transposed}()}, diff --git a/man/derive_vars_merged.Rd b/man/derive_vars_merged.Rd index e124ba63c2..be3f69813c 100644 --- a/man/derive_vars_merged.Rd +++ b/man/derive_vars_merged.Rd @@ -21,12 +21,12 @@ derive_vars_merged( \arguments{ \item{dataset}{Input dataset -The variables specified by the \code{by_vars} parameter are expected.} +The variables specified by the \code{by_vars} argument are expected.} \item{dataset_add}{Additional dataset The variables specified by the \code{by_vars}, the \code{new_vars}, and the \code{order} -parameter are expected.} +argument are expected.} \item{by_vars}{Grouping variables @@ -38,7 +38,7 @@ key of the selected observations. \item{order}{Sort order -If the parameter is set to a non-null value, for each by group the first or +If the argument is set to a non-null value, for each by group the first or last observation from the additional dataset is selected with respect to the specified order. @@ -59,7 +59,7 @@ And \code{new_vars = vars(var1, new_var2 = old_var2)} takes \code{var1} and \code{old_var2} from \code{dataset_add} and adds them to the input dataset renaming \code{old_var2} to \code{new_var2}. -If the parameter is not specified or set to \code{NULL}, all variables from the +If the argument is not specified or set to \code{NULL}, all variables from the additional dataset (\code{dataset_add}) are added. \emph{Default}: \code{NULL} @@ -69,9 +69,9 @@ additional dataset (\code{dataset_add}) are added. \item{mode}{Selection mode Determines if the first or last observation is selected. If the \code{order} -parameter is specified, \code{mode} must be non-null. +argument is specified, \code{mode} must be non-null. -If the \code{order} parameter is not specified, the \code{mode} parameter is ignored. +If the \code{order} argument is not specified, the \code{mode} argument is ignored. \emph{Default}: \code{NULL} @@ -80,7 +80,7 @@ If the \code{order} parameter is not specified, the \code{mode} parameter is ign \item{filter_add}{Filter for additional dataset (\code{dataset_add}) Only observations fulfilling the specified condition are taken into account -for merging. If the parameter is not specified, all observations are +for merging. If the argument is not specified, all observations are considered. \emph{Default}: \code{NULL} @@ -89,7 +89,7 @@ considered. \item{match_flag}{Match flag -If the parameter is specified (e.g., \code{match_flag = FLAG}), the specified +If the argument is specified (e.g., \code{match_flag = FLAG}), the specified variable (e.g., \code{FLAG}) is added to the input dataset. This variable will be \code{TRUE} for all selected records from \code{dataset_add} which are merged into the input dataset, and \code{NA} otherwise. @@ -244,8 +244,11 @@ General Derivation Functions for all ADaMs that returns variable appended to dat \code{\link{derive_var_merged_cat}()}, \code{\link{derive_var_merged_character}()}, \code{\link{derive_var_merged_exist_flag}()}, +\code{\link{derive_var_merged_summary}()}, \code{\link{derive_var_obs_number}()}, +\code{\link{derive_var_relative_flag}()}, \code{\link{derive_var_worst_flag}()}, +\code{\link{derive_vars_joined}()}, \code{\link{derive_vars_last_dose}()}, \code{\link{derive_vars_merged_lookup}()}, \code{\link{derive_vars_transposed}()}, diff --git a/man/derive_vars_merged_dt.Rd b/man/derive_vars_merged_dt.Rd index b487f97561..d88334587c 100644 --- a/man/derive_vars_merged_dt.Rd +++ b/man/derive_vars_merged_dt.Rd @@ -25,12 +25,12 @@ derive_vars_merged_dt( \arguments{ \item{dataset}{Input dataset -The variables specified by the \code{by_vars} parameter are expected.} +The variables specified by the \code{by_vars} argument are expected.} \item{dataset_add}{Additional dataset The variables specified by the \code{by_vars}, the \code{dtc}, and the \code{order} -parameter are expected.} +argument are expected.} \item{by_vars}{Grouping variables @@ -42,7 +42,7 @@ key of the selected observations. \item{order}{Sort order -If the parameter is set to a non-null value, for each by group the first or +If the argument is set to a non-null value, for each by group the first or last observation from the additional dataset is selected with respect to the specified order. The imputed date variable can be specified as well (see examples below). @@ -66,7 +66,7 @@ the specified prefix and for the date imputation flag "DTF". I.e., for \item{filter_add}{Filter for additional dataset (\code{dataset_add}) Only observations fulfilling the specified condition are taken into account -for merging. If the parameter is not specified, all observations are +for merging. If the argument is not specified, all observations are considered. \emph{Default}: \code{NULL} @@ -76,9 +76,9 @@ considered. \item{mode}{Selection mode Determines if the first or last observation is selected. If the \code{order} -parameter is specified, \code{mode} must be non-null. +argument is specified, \code{mode} must be non-null. -If the \code{order} parameter is not specified, the \code{mode} parameter is ignored. +If the \code{order} argument is not specified, the \code{mode} argument is ignored. \emph{Default}: \code{NULL} diff --git a/man/derive_vars_merged_dtm.Rd b/man/derive_vars_merged_dtm.Rd index fd72dd2e1d..e10cdd691d 100644 --- a/man/derive_vars_merged_dtm.Rd +++ b/man/derive_vars_merged_dtm.Rd @@ -26,12 +26,12 @@ derive_vars_merged_dtm( \arguments{ \item{dataset}{Input dataset -The variables specified by the \code{by_vars} parameter are expected.} +The variables specified by the \code{by_vars} argument are expected.} \item{dataset_add}{Additional dataset The variables specified by the \code{by_vars}, the \code{dtc}, and the \code{order} -parameter are expected.} +argument are expected.} \item{by_vars}{Grouping variables @@ -43,7 +43,7 @@ key of the selected observations. \item{order}{Sort order -If the parameter is set to a non-null value, for each by group the first or +If the argument is set to a non-null value, for each by group the first or last observation from the additional dataset is selected with respect to the specified order. The imputed datetime variable can be specified as well (see examples below). @@ -63,7 +63,7 @@ imputation flag "TMF". I.e., for \code{new_vars_prefix = "AST"} the variables \item{filter_add}{Filter for additional dataset (\code{dataset_add}) Only observations fulfilling the specified condition are taken into account -for merging. If the parameter is not specified, all observations are +for merging. If the argument is not specified, all observations are considered. \emph{Default}: \code{NULL} @@ -73,9 +73,9 @@ considered. \item{mode}{Selection mode Determines if the first or last observation is selected. If the \code{order} -parameter is specified, \code{mode} must be non-null. +argument is specified, \code{mode} must be non-null. -If the \code{order} parameter is not specified, the \code{mode} parameter is ignored. +If the \code{order} argument is not specified, the \code{mode} argument is ignored. \emph{Default}: \code{NULL} diff --git a/man/derive_vars_merged_lookup.Rd b/man/derive_vars_merged_lookup.Rd index d5084bb7a6..16d4940422 100644 --- a/man/derive_vars_merged_lookup.Rd +++ b/man/derive_vars_merged_lookup.Rd @@ -20,11 +20,11 @@ derive_vars_merged_lookup( \arguments{ \item{dataset}{Input dataset -The variables specified by the \code{by_vars} parameter are expected.} +The variables specified by the \code{by_vars} argument are expected.} \item{dataset_add}{Lookup table -The variables specified by the \code{by_vars} parameter are expected.} +The variables specified by the \code{by_vars} argument are expected.} \item{by_vars}{Grouping variables @@ -36,7 +36,7 @@ key of the selected observations. \item{order}{Sort order -If the parameter is set to a non-null value, for each by group the first or +If the argument is set to a non-null value, for each by group the first or last observation from the additional dataset is selected with respect to the specified order. @@ -57,7 +57,7 @@ And \code{new_vars = vars(var1, new_var2 = old_var2)} takes \code{var1} and \code{old_var2} from \code{dataset_add} and adds them to the input dataset renaming \code{old_var2} to \code{new_var2}. -If the parameter is not specified or set to \code{NULL}, all variables from the +If the argument is not specified or set to \code{NULL}, all variables from the additional dataset (\code{dataset_add}) are added. \emph{Default}: \code{NULL} @@ -67,9 +67,9 @@ additional dataset (\code{dataset_add}) are added. \item{mode}{Selection mode Determines if the first or last observation is selected. If the \code{order} -parameter is specified, \code{mode} must be non-null. +argument is specified, \code{mode} must be non-null. -If the \code{order} parameter is not specified, the \code{mode} parameter is ignored. +If the \code{order} argument is not specified, the \code{mode} argument is ignored. \emph{Default}: \code{NULL} @@ -78,7 +78,7 @@ If the \code{order} parameter is not specified, the \code{mode} parameter is ign \item{filter_add}{Filter for additional dataset (\code{dataset_add}) Only observations fulfilling the specified condition are taken into account -for merging. If the parameter is not specified, all observations are +for merging. If the argument is not specified, all observations are considered. \emph{Default}: \code{NULL} @@ -126,9 +126,10 @@ mapping from the lookup table. } \examples{ library(admiral.test) +library(tibble) library(dplyr, warn.conflicts = FALSE) data("admiral_vs") -param_lookup <- tibble::tribble( +param_lookup <- tribble( ~VSTESTCD, ~VSTEST, ~PARAMCD, ~PARAM, "SYSBP", "Systolic Blood Pressure", "SYSBP", "Systolic Blood Pressure (mmHg)", "WEIGHT", "Weight", "WEIGHT", "Weight (kg)", @@ -156,8 +157,11 @@ General Derivation Functions for all ADaMs that returns variable appended to dat \code{\link{derive_var_merged_cat}()}, \code{\link{derive_var_merged_character}()}, \code{\link{derive_var_merged_exist_flag}()}, +\code{\link{derive_var_merged_summary}()}, \code{\link{derive_var_obs_number}()}, +\code{\link{derive_var_relative_flag}()}, \code{\link{derive_var_worst_flag}()}, +\code{\link{derive_vars_joined}()}, \code{\link{derive_vars_last_dose}()}, \code{\link{derive_vars_merged}()}, \code{\link{derive_vars_transposed}()}, diff --git a/man/derive_vars_period.Rd b/man/derive_vars_period.Rd new file mode 100644 index 0000000000..b22c7e61db --- /dev/null +++ b/man/derive_vars_period.Rd @@ -0,0 +1,152 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/period_dataset.R +\name{derive_vars_period} +\alias{derive_vars_period} +\title{Add Subperiod, Period, or Phase Variables to ADSL} +\usage{ +derive_vars_period( + dataset, + dataset_ref, + new_vars, + subject_keys = get_admiral_option("subject_keys") +) +} +\arguments{ +\item{dataset}{ADSL dataset + +The variables specified by \code{subject_keys} are expected.} + +\item{dataset_ref}{Period reference dataset + +The variables specified by \code{new_vars} and \code{subject_keys} are expected. + +If subperiod variables are requested, \code{APERIOD} and \code{ASPER} are expected. +If period variables are requested. \code{APERIOD} is expected. If phase +variables are requested, \code{APHASEN} is expected.} + +\item{new_vars}{New variables + +A named list of variables like \code{vars(PHwSDT = PHSDT, PHwEDT = PHEDT, APHASEw = APHASE)} is expected. The left hand side of the elements defines +a set of variables (in CDISC notation) to be added to the output dataset. +The right hand side defines the source variable from the period reference +dataset. + +If the lower case letter "w" is used it refers to a phase variable, if the +lower case letters "xx" are used it refers to a period variable, and if +both "xx" and "w" are used it refers to a subperiod variable. + +Only one type must be used, e.g., all left hand side values must refer to +period variables. It is not allowed to mix for example period and subperiod +variables. If period \emph{and} subperiod variables are required, separate calls +must be used.} + +\item{subject_keys}{Variables to uniquely identify a subject + +A list of quosures where the expressions are symbols as returned by +\code{vars()} is expected.} +} +\value{ +The input dataset with subperiod/period/phase variables added (see +"Details" section) +} +\description{ +The function adds subperiod, period, or phase variables like \code{P01S1SDT}, +\code{P01S2SDT}, \code{AP01SDTM}, \code{AP02SDTM}, \code{TRT01A}, \code{TRT02A}, \code{PH1SDT}, \code{PH2SDT}, +... to the input dataset. The values of the variables are defined by a period +reference dataset which has one observations per patient and subperiod, +period, or phase. +} +\details{ +For each subperiod/period/phase in the period reference dataset and +each element in \code{new_vars} a variable (LHS value of \code{new_vars}) is added to +the output dataset and set to the value of the source variable (RHS value +of \code{new_vars}. +} +\examples{ +library(tibble) +library(dplyr, warn.conflicts = FALSE) +library(lubridate) + +adsl <- tibble(STUDYID = "xyz", USUBJID = c("1", "2")) + +# Add period variables to ADSL +period_ref <- tribble( + ~USUBJID, ~APERIOD, ~APERSDT, ~APEREDT, + "1", 1, "2021-01-04", "2021-02-06", + "1", 2, "2021-02-07", "2021-03-07", + "2", 1, "2021-02-02", "2021-03-02", + "2", 2, "2021-03-03", "2021-04-01" +) \%>\% + mutate( + STUDYID = "xyz", + APERIOD = as.integer(APERIOD), + across(matches("APER[ES]DT"), ymd) + ) + +derive_vars_period( + adsl, + dataset_ref = period_ref, + new_vars = vars(APxxSDT = APERSDT, APxxEDT = APEREDT) +) \%>\% + select(STUDYID, USUBJID, AP01SDT, AP01EDT, AP02SDT, AP02EDT) + +# Add phase variables to ADSL +phase_ref <- tribble( + ~USUBJID, ~APHASEN, ~PHSDT, ~PHEDT, ~APHASE, + "1", 1, "2021-01-04", "2021-02-06", "TREATMENT", + "1", 2, "2021-02-07", "2021-03-07", "FUP", + "2", 1, "2021-02-02", "2021-03-02", "TREATMENT" +) \%>\% + mutate( + STUDYID = "xyz", + APHASEN = as.integer(APHASEN), + across(matches("PH[ES]DT"), ymd) + ) + +derive_vars_period( + adsl, + dataset_ref = phase_ref, + new_vars = vars(PHwSDT = PHSDT, PHwEDT = PHEDT, APHASEw = APHASE) +) \%>\% + select(STUDYID, USUBJID, PH1SDT, PH1EDT, PH2SDT, PH2EDT, APHASE1, APHASE2) + +# Add subperiod variables to ADSL +subperiod_ref <- tribble( + ~USUBJID, ~APERIOD, ~ASPER, ~ASPRSDT, ~ASPREDT, + "1", 1, 1, "2021-01-04", "2021-01-19", + "1", 1, 2, "2021-01-20", "2021-02-06", + "1", 2, 1, "2021-02-07", "2021-03-07", + "2", 1, 1, "2021-02-02", "2021-03-02", + "2", 2, 1, "2021-03-03", "2021-04-01" +) \%>\% + mutate( + STUDYID = "xyz", + APERIOD = as.integer(APERIOD), + ASPER = as.integer(ASPER), + across(matches("ASPR[ES]DT"), ymd) + ) + +derive_vars_period( + adsl, + dataset_ref = subperiod_ref, + new_vars = vars(PxxSwSDT = ASPRSDT, PxxSwEDT = ASPREDT) +) \%>\% + select(STUDYID, USUBJID, P01S1SDT, P01S1EDT, P01S2SDT, P01S2EDT, P02S1SDT, P02S1EDT) +} +\seealso{ +\code{\link[=create_period_dataset]{create_period_dataset()}} + +ADSL Functions that returns variable appended to dataset: +\code{\link{derive_var_age_years}()}, +\code{\link{derive_var_disposition_status}()}, +\code{\link{derive_var_dthcaus}()}, +\code{\link{derive_var_extreme_dtm}()}, +\code{\link{derive_var_extreme_dt}()}, +\code{\link{derive_vars_aage}()}, +\code{\link{derive_vars_disposition_reason}()} +} +\author{ +Stefan Bundfuss +} +\concept{der_adsl} +\keyword{der_adsl} diff --git a/man/derive_vars_query.Rd b/man/derive_vars_query.Rd index 5e0b214083..5096b9c433 100644 --- a/man/derive_vars_query.Rd +++ b/man/derive_vars_query.Rd @@ -51,8 +51,9 @@ The "CD", "SC", and "SCN" variables are derived accordingly based on whenever not missing. } \examples{ +library(tibble) data("queries") -adae <- tibble::tribble( +adae <- tribble( ~USUBJID, ~ASTDTM, ~AETERM, ~AESEQ, ~AEDECOD, ~AELLT, ~AELLTCD, "01", "2020-06-02 23:59:59", "ALANINE AMINOTRANSFERASE ABNORMAL", 3, "Alanine aminotransferase abnormal", NA_character_, NA_integer_, @@ -69,8 +70,7 @@ derive_vars_query(adae, queries) \code{\link[=create_query_data]{create_query_data()}} \code{\link[=assert_valid_queries]{assert_valid_queries()}} OCCDS Functions: -\code{\link{create_query_data}()}, -\code{\link{create_single_dose_dataset}()}, +\code{\link{derive_var_trtemfl}()}, \code{\link{derive_vars_atc}()}, \code{\link{get_terms_from_db}()} } diff --git a/man/derive_vars_transposed.Rd b/man/derive_vars_transposed.Rd index a8eba59ada..38157a1ce6 100644 --- a/man/derive_vars_transposed.Rd +++ b/man/derive_vars_transposed.Rd @@ -45,15 +45,16 @@ dataset is transposed and subsequently merged onto \code{dataset} using \code{by keys. } \examples{ +library(tibble) library(dplyr, warn.conflicts = FALSE) -cm <- tibble::tribble( +cm <- tribble( ~USUBJID, ~CMGRPID, ~CMREFID, ~CMDECOD, "BP40257-1001", "14", "1192056", "PARACETAMOL", "BP40257-1001", "18", "2007001", "SOLUMEDROL", "BP40257-1002", "19", "2791596", "SPIRONOLACTONE" ) -facm <- tibble::tribble( +facm <- tribble( ~USUBJID, ~FAGRPID, ~FAREFID, ~FATESTCD, ~FASTRESC, "BP40257-1001", "1", "1192056", "CMATC1CD", "N", "BP40257-1001", "1", "1192056", "CMATC2CD", "N02", @@ -96,8 +97,11 @@ General Derivation Functions for all ADaMs that returns variable appended to dat \code{\link{derive_var_merged_cat}()}, \code{\link{derive_var_merged_character}()}, \code{\link{derive_var_merged_exist_flag}()}, +\code{\link{derive_var_merged_summary}()}, \code{\link{derive_var_obs_number}()}, +\code{\link{derive_var_relative_flag}()}, \code{\link{derive_var_worst_flag}()}, +\code{\link{derive_vars_joined}()}, \code{\link{derive_vars_last_dose}()}, \code{\link{derive_vars_merged_lookup}()}, \code{\link{derive_vars_merged}()}, diff --git a/man/dose_freq_lookup.Rd b/man/dose_freq_lookup.Rd index 531ac0a01f..3d6593c7ac 100644 --- a/man/dose_freq_lookup.Rd +++ b/man/dose_freq_lookup.Rd @@ -42,6 +42,10 @@ To see the entire table in the console, run \code{print(dose_freq_lookup)}. } \seealso{ \code{\link[=create_single_dose_dataset]{create_single_dose_dataset()}} + +Other metadata: +\code{\link{atoxgr_criteria_ctcv4}}, +\code{\link{atoxgr_criteria_ctcv5}} } \concept{metadata} \keyword{metadata} diff --git a/man/dthcaus_source.Rd b/man/dthcaus_source.Rd new file mode 100644 index 0000000000..f6a4095093 --- /dev/null +++ b/man/dthcaus_source.Rd @@ -0,0 +1,105 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/derive_var_dthcaus.R +\name{dthcaus_source} +\alias{dthcaus_source} +\title{Create a \code{dthcaus_source} Object} +\usage{ +dthcaus_source( + dataset_name, + filter, + date, + order = NULL, + mode = "first", + dthcaus, + traceability_vars = NULL +) +} +\arguments{ +\item{dataset_name}{The name of the dataset, i.e. a string, used to search for +the death cause.} + +\item{filter}{An expression used for filtering \code{dataset}.} + +\item{date}{A date or datetime variable to be used for sorting \code{dataset}.} + +\item{order}{Sort order + +Additional variables to be used for sorting the \code{dataset} which is ordered by the +\code{date} and \code{order}. Can be used to avoid duplicate record warning. + +\emph{Default}: \code{NULL} + +\emph{Permitted Values}: list of variables or \verb{desc()} function calls +created by \code{vars()}, e.g., \code{vars(ADT, desc(AVAL))} or \code{NULL}} + +\item{mode}{One of \code{"first"} or \code{"last"}. +Either the \code{"first"} or \code{"last"} observation is preserved from the \code{dataset} +which is ordered by \code{date}.} + +\item{dthcaus}{A variable name or a string literal --- if a variable name, e.g., \code{AEDECOD}, +it is the variable in the source dataset to be used to assign values to +\code{DTHCAUS}; if a string literal, e.g. \code{"Adverse Event"}, it is the fixed value +to be assigned to \code{DTHCAUS}.} + +\item{traceability_vars}{A named list returned by \code{\link[=vars]{vars()}} listing the traceability variables, +e.g. \code{vars(DTHDOM = "DS", DTHSEQ = DSSEQ)}. +The left-hand side (names of the list elements) gives the names of the traceability variables +in the returned dataset. +The right-hand side (values of the list elements) gives the values of the traceability variables +in the returned dataset. +These can be either strings or symbols referring to existing variables.} +} +\value{ +An object of class "dthcaus_source". +} +\description{ +Create a \code{dthcaus_source} Object +} +\examples{ +# Deaths sourced from AE +src_ae <- dthcaus_source( + dataset_name = "ae", + filter = AEOUT == "FATAL", + date = AEDTHDT, + mode = "first", + dthcaus = AEDECOD +) + +# Deaths sourced from DS +src_ds <- dthcaus_source( + dataset_name = "ds", + filter = DSDECOD == "DEATH", + date = DSSTDT, + mode = "first", + dthcaus = DSTERM +) +} +\seealso{ +\code{\link[=derive_var_dthcaus]{derive_var_dthcaus()}} + +Source Specifications: +\code{\link{assert_db_requirements}()}, +\code{\link{assert_terms}()}, +\code{\link{assert_valid_queries}()}, +\code{\link{basket_select}()}, +\code{\link{censor_source}()}, +\code{\link{date_source}()}, +\code{\link{death_event}}, +\code{\link{event_source}()}, +\code{\link{extend_source_datasets}()}, +\code{\link{filter_date_sources}()}, +\code{\link{format.basket_select}()}, +\code{\link{list_tte_source_objects}()}, +\code{\link{params}()}, +\code{\link{query}()}, +\code{\link{sdg_select}()}, +\code{\link{smq_select}()}, +\code{\link{tte_source}()}, +\code{\link{validate_basket_select}()}, +\code{\link{validate_query}()} +} +\author{ +Shimeng Huang +} +\concept{source_specifications} +\keyword{source_specifications} diff --git a/man/event_source.Rd b/man/event_source.Rd index 563b4e9a17..b17ade8e4d 100644 --- a/man/event_source.Rd +++ b/man/event_source.Rd @@ -34,6 +34,7 @@ An object of class \code{event_source}, inheriting from class \code{tte_source} } \examples{ # Death event + event_source( dataset_name = "adsl", filter = DTHFL == "Y", @@ -52,23 +53,22 @@ Source Specifications: \code{\link{assert_db_requirements}()}, \code{\link{assert_terms}()}, \code{\link{assert_valid_queries}()}, +\code{\link{basket_select}()}, \code{\link{censor_source}()}, \code{\link{date_source}()}, \code{\link{death_event}}, -\code{\link{derive_var_dthcaus}()}, +\code{\link{dthcaus_source}()}, \code{\link{extend_source_datasets}()}, \code{\link{filter_date_sources}()}, -\code{\link{format.sdg_select}()}, -\code{\link{format.smq_select}()}, +\code{\link{format.basket_select}()}, \code{\link{list_tte_source_objects}()}, \code{\link{params}()}, \code{\link{query}()}, \code{\link{sdg_select}()}, \code{\link{smq_select}()}, \code{\link{tte_source}()}, -\code{\link{validate_query}()}, -\code{\link{validate_sdg_select}()}, -\code{\link{validate_smq_select}()} +\code{\link{validate_basket_select}()}, +\code{\link{validate_query}()} } \author{ Stefan Bundfuss diff --git a/man/ex_single.Rd b/man/ex_single.Rd index b90d4aad02..3f438a2a50 100644 --- a/man/ex_single.Rd +++ b/man/ex_single.Rd @@ -19,7 +19,6 @@ A derived dataset with single dose per date. \seealso{ Other datasets: \code{\link{admiral_adsl}}, -\code{\link{atoxgr_criteria_ctcv4}}, \code{\link{queries_mh}}, \code{\link{queries}} } diff --git a/man/extend_source_datasets.Rd b/man/extend_source_datasets.Rd index 1a989d78d2..b3fe0d0a4d 100644 --- a/man/extend_source_datasets.Rd +++ b/man/extend_source_datasets.Rd @@ -31,17 +31,18 @@ by groups. } } \examples{ +library(tibble) library(dplyr, warn.conflicts = FALSE) library(lubridate) -adsl <- tibble::tribble( +adsl <- tribble( ~USUBJID, ~TRTSDT, ~EOSDT, "01", ymd("2020-12-06"), ymd("2021-03-06"), "02", ymd("2021-01-16"), ymd("2021-02-03") ) \%>\% mutate(STUDYID = "AB42") -ae <- tibble::tribble( +ae <- tribble( ~USUBJID, ~AESTDTC, ~AESEQ, ~AEDECOD, "01", "2021-01-03T10:56", 1, "Flu", "01", "2021-03-04", 2, "Cough", @@ -59,23 +60,22 @@ Source Specifications: \code{\link{assert_db_requirements}()}, \code{\link{assert_terms}()}, \code{\link{assert_valid_queries}()}, +\code{\link{basket_select}()}, \code{\link{censor_source}()}, \code{\link{date_source}()}, \code{\link{death_event}}, -\code{\link{derive_var_dthcaus}()}, +\code{\link{dthcaus_source}()}, \code{\link{event_source}()}, \code{\link{filter_date_sources}()}, -\code{\link{format.sdg_select}()}, -\code{\link{format.smq_select}()}, +\code{\link{format.basket_select}()}, \code{\link{list_tte_source_objects}()}, \code{\link{params}()}, \code{\link{query}()}, \code{\link{sdg_select}()}, \code{\link{smq_select}()}, \code{\link{tte_source}()}, -\code{\link{validate_query}()}, -\code{\link{validate_sdg_select}()}, -\code{\link{validate_smq_select}()} +\code{\link{validate_basket_select}()}, +\code{\link{validate_query}()} } \author{ Stefan Bundfuss diff --git a/man/figures/logo.png b/man/figures/logo.png index 6be4936ab4..3f023776ea 100644 Binary files a/man/figures/logo.png and b/man/figures/logo.png differ diff --git a/man/filter_date_sources.Rd b/man/filter_date_sources.Rd index 3ddec8feb7..aa6e5be35d 100644 --- a/man/filter_date_sources.Rd +++ b/man/filter_date_sources.Rd @@ -114,7 +114,7 @@ filter_date_sources( source_datasets = list(adsl = adsl, ae = ae), by_vars = vars(AEDECOD), create_datetime = FALSE, - subject_keys = vars(STUDYID, USUBJID), + subject_keys = get_admiral_option("subject_keys"), mode = "first" ) } @@ -123,23 +123,22 @@ Source Specifications: \code{\link{assert_db_requirements}()}, \code{\link{assert_terms}()}, \code{\link{assert_valid_queries}()}, +\code{\link{basket_select}()}, \code{\link{censor_source}()}, \code{\link{date_source}()}, \code{\link{death_event}}, -\code{\link{derive_var_dthcaus}()}, +\code{\link{dthcaus_source}()}, \code{\link{event_source}()}, \code{\link{extend_source_datasets}()}, -\code{\link{format.sdg_select}()}, -\code{\link{format.smq_select}()}, +\code{\link{format.basket_select}()}, \code{\link{list_tte_source_objects}()}, \code{\link{params}()}, \code{\link{query}()}, \code{\link{sdg_select}()}, \code{\link{smq_select}()}, \code{\link{tte_source}()}, -\code{\link{validate_query}()}, -\code{\link{validate_sdg_select}()}, -\code{\link{validate_smq_select}()} +\code{\link{validate_basket_select}()}, +\code{\link{validate_query}()} } \author{ Stefan Bundfuss diff --git a/man/filter_extreme.Rd b/man/filter_extreme.Rd index 1b801e6586..511bb72aab 100644 --- a/man/filter_extreme.Rd +++ b/man/filter_extreme.Rd @@ -56,7 +56,7 @@ order specified for the \code{order} parameter and the mode specified for the \code{mode} parameter) is included in the output dataset. } \examples{ -library(dplyr, warn.conflict = FALSE) +library(dplyr, warn.conflicts = FALSE) library(admiral.test) data("admiral_ex") diff --git a/man/filter_relative.Rd b/man/filter_relative.Rd index d3829d9220..22927efe13 100644 --- a/man/filter_relative.Rd +++ b/man/filter_relative.Rd @@ -61,8 +61,6 @@ included in the output dataset. \item{keep_no_ref_groups}{Should by groups without reference observation be kept? -\emph{Default:} \code{TRUE} - \emph{Permitted Values:} \code{TRUE}, \code{FALSE}} \item{check_type}{Check uniqueness? @@ -71,8 +69,6 @@ If \code{"warning"} or \code{"error"} is specified, the specified message is iss if the observations of the input dataset are not unique with respect to the by variables and the order. -\emph{Default:} \code{"none"} - \emph{Permitted Values:} \code{"none"}, \code{"warning"}, \code{"error"}} } \value{ @@ -89,13 +85,13 @@ progression. \details{ For each by group ( \code{by_vars} parameter) the observations before or after (\code{selection} parameter) the observations where the condition -(\code{condition} parameter) if fulfilled the first or last time (\code{order} +(\code{condition} parameter) is fulfilled the first or last time (\code{order} parameter and \code{mode} parameter) is included in the output dataset. } \examples{ -library(dplyr, warn.conflict = FALSE) +library(tibble) -response <- tibble::tribble( +response <- tribble( ~USUBJID, ~AVISITN, ~AVALC, "1", 1, "PR", "1", 2, "CR", diff --git a/man/format.smq_select.Rd b/man/format.basket_select.Rd similarity index 56% rename from man/format.smq_select.Rd rename to man/format.basket_select.Rd index 5d0332bd59..999b6cbf62 100644 --- a/man/format.smq_select.Rd +++ b/man/format.basket_select.Rd @@ -1,54 +1,53 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/create_query_data.R -\name{format.smq_select} -\alias{format.smq_select} -\title{Returns a Character Representation of a \code{smq_select()} Object} +\name{format.basket_select} +\alias{format.basket_select} +\title{Returns a Character Representation of a \code{basket_select()} Object} \usage{ -\method{format}{smq_select}(x, ...) +\method{format}{basket_select}(x, ...) } \arguments{ -\item{x}{A \code{smq_select()} object} +\item{x}{A \code{basket_select()} object} \item{...}{Not used} } \value{ -A character representation of the \code{smq_select()} object +A character representation of the \code{basket_select()} object } \description{ -The function returns a character representation of a \code{smq_select()} object. +The function returns a character representation of a \code{basket_select()} object. It can be used for error messages for example. } \examples{ -format(smq_select(id = 42, scope = "NARROW")) +format(basket_select(id = 42, scope = "NARROW", type = "smq")) } \seealso{ -\code{\link[=smq_select]{smq_select()}} +\code{\link[=basket_select]{basket_select()}} Source Specifications: \code{\link{assert_db_requirements}()}, \code{\link{assert_terms}()}, \code{\link{assert_valid_queries}()}, +\code{\link{basket_select}()}, \code{\link{censor_source}()}, \code{\link{date_source}()}, \code{\link{death_event}}, -\code{\link{derive_var_dthcaus}()}, +\code{\link{dthcaus_source}()}, \code{\link{event_source}()}, \code{\link{extend_source_datasets}()}, \code{\link{filter_date_sources}()}, -\code{\link{format.sdg_select}()}, \code{\link{list_tte_source_objects}()}, \code{\link{params}()}, \code{\link{query}()}, \code{\link{sdg_select}()}, \code{\link{smq_select}()}, \code{\link{tte_source}()}, -\code{\link{validate_query}()}, -\code{\link{validate_sdg_select}()}, -\code{\link{validate_smq_select}()} +\code{\link{validate_basket_select}()}, +\code{\link{validate_query}()} } \author{ -Stefan Bundfuss +Tamara Senior } \concept{source_specifications} \keyword{source_specifications} diff --git a/man/format.sdg_select.Rd b/man/format.sdg_select.Rd deleted file mode 100644 index f331666d1c..0000000000 --- a/man/format.sdg_select.Rd +++ /dev/null @@ -1,58 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/create_query_data.R -\name{format.sdg_select} -\alias{format.sdg_select} -\title{Returns a Character Representation of a \code{sdg_select()} Object} -\usage{ -\method{format}{sdg_select}(x, ...) -} -\arguments{ -\item{x}{A \code{sdg_select()} object} - -\item{...}{Not used} -} -\value{ -A character representation of the \code{sdg_select()} object -} -\description{ -The function returns a character representation of a \code{sdg_select()} object. -It can be used for error messages for example. -} -\examples{ - -format( - sdg_select( - name = "5-aminosalicylates for ulcerative colitis" - ) -) -} -\seealso{ -\code{\link[=sdg_select]{sdg_select()}} - -Source Specifications: -\code{\link{assert_db_requirements}()}, -\code{\link{assert_terms}()}, -\code{\link{assert_valid_queries}()}, -\code{\link{censor_source}()}, -\code{\link{date_source}()}, -\code{\link{death_event}}, -\code{\link{derive_var_dthcaus}()}, -\code{\link{event_source}()}, -\code{\link{extend_source_datasets}()}, -\code{\link{filter_date_sources}()}, -\code{\link{format.smq_select}()}, -\code{\link{list_tte_source_objects}()}, -\code{\link{params}()}, -\code{\link{query}()}, -\code{\link{sdg_select}()}, -\code{\link{smq_select}()}, -\code{\link{tte_source}()}, -\code{\link{validate_query}()}, -\code{\link{validate_sdg_select}()}, -\code{\link{validate_smq_select}()} -} -\author{ -Stefan Bundfuss -} -\concept{source_specifications} -\keyword{source_specifications} diff --git a/man/format_eoxxstt_default.Rd b/man/format_eoxxstt_default.Rd index 0bb499af2c..fc46d05a2f 100644 --- a/man/format_eoxxstt_default.Rd +++ b/man/format_eoxxstt_default.Rd @@ -45,6 +45,7 @@ admiral_dm \%>\% Utilities for Formatting Observations: \code{\link{convert_blanks_to_na}()}, +\code{\link{convert_na_to_blanks}()}, \code{\link{format_reason_default}()}, \code{\link{yn_to_numeric}()} } diff --git a/man/format_reason_default.Rd b/man/format_reason_default.Rd index 0c1bfdb800..e991a26364 100644 --- a/man/format_reason_default.Rd +++ b/man/format_reason_default.Rd @@ -47,6 +47,7 @@ admiral_dm \%>\% Utilities for Formatting Observations: \code{\link{convert_blanks_to_na}()}, +\code{\link{convert_na_to_blanks}()}, \code{\link{format_eoxxstt_default}()}, \code{\link{yn_to_numeric}()} } diff --git a/man/get_admiral_option.Rd b/man/get_admiral_option.Rd new file mode 100644 index 0000000000..a60087a394 --- /dev/null +++ b/man/get_admiral_option.Rd @@ -0,0 +1,52 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/admiral_options.R +\name{get_admiral_option} +\alias{get_admiral_option} +\title{Get the Value of an Admiral Option} +\usage{ +get_admiral_option(option) +} +\arguments{ +\item{option}{A character scalar of commonly used admiral function inputs. + +As of now, support only available for "subject_keys". +See \code{set_admiral_options()} for a description of the options.} +} +\value{ +The value of the specified option. +} +\description{ +Get the Value of an Admiral Option Which Can Be Modified for Advanced Users. +} +\details{ +This function allows flexibility for function inputs that may need to be repeated +multiple times in a script, such as \code{subject_keys}. +} +\examples{ +library(admiral.test) +library(dplyr, warn.conflicts = FALSE) +data("admiral_vs") +data("admiral_dm") + +# Merging all dm variables to vs +derive_vars_merged( + admiral_vs, + dataset_add = select(admiral_dm, -DOMAIN), + by_vars = get_admiral_option("subject_keys") +) \%>\% + select(STUDYID, USUBJID, VSTESTCD, VISIT, VSTPT, VSSTRESN, AGE, AGEU) +} +\seealso{ +\code{\link[=vars]{vars()}}, \code{\link[=set_admiral_options]{set_admiral_options()}}, \code{\link[=derive_param_exist_flag]{derive_param_exist_flag()}}, +\code{\link[=derive_param_first_event]{derive_param_first_event()}}, \code{\link[=derive_param_tte]{derive_param_tte()}}, \code{\link[=derive_var_disposition_status]{derive_var_disposition_status()}}, +\code{\link[=derive_var_dthcaus]{derive_var_dthcaus()}}, \code{\link[=derive_var_extreme_dtm]{derive_var_extreme_dtm()}}, \code{\link[=derive_vars_disposition_reason]{derive_vars_disposition_reason()}}, +\code{\link[=derive_vars_period]{derive_vars_period()}}, \code{\link[=create_period_dataset]{create_period_dataset()}} + +Other admiral_options: +\code{\link{set_admiral_options}()} +} +\author{ +Zelos Zhu +} +\concept{admiral_options} +\keyword{admiral_options} diff --git a/man/get_duplicates_dataset.Rd b/man/get_duplicates_dataset.Rd index b28e943d73..0dd29cba75 100644 --- a/man/get_duplicates_dataset.Rd +++ b/man/get_duplicates_dataset.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/duplicates.R \name{get_duplicates_dataset} \alias{get_duplicates_dataset} -\title{Get Duplicate Records that Lead to a Prior Error} +\title{Get Duplicate Records that Led to a Prior Error} \usage{ get_duplicates_dataset() } @@ -10,7 +10,7 @@ get_duplicates_dataset() A \code{data.frame} or \code{NULL} } \description{ -Get Duplicate Records that Lead to a Prior Error +Get Duplicate Records that Led to a Prior Error } \details{ Many {admiral} function check that the input dataset contains only one record diff --git a/man/get_many_to_one_dataset.Rd b/man/get_many_to_one_dataset.Rd index 6cdf057547..401d367283 100644 --- a/man/get_many_to_one_dataset.Rd +++ b/man/get_many_to_one_dataset.Rd @@ -23,6 +23,7 @@ second error has been thrown, the dataset of the first error can no longer be accessed (unless it has been saved in a variable). } \examples{ +library(admiraldev, warn.conflicts = FALSE) data(admiral_adsl) try( diff --git a/man/get_one_to_many_dataset.Rd b/man/get_one_to_many_dataset.Rd index 0ce60fb149..c9d406103b 100644 --- a/man/get_one_to_many_dataset.Rd +++ b/man/get_one_to_many_dataset.Rd @@ -23,6 +23,7 @@ second error has been thrown, the dataset of the first error can no longer be accessed (unless it has been saved in a variable). } \examples{ +library(admiraldev, warn.conflicts = FALSE) data(admiral_adsl) try( diff --git a/man/get_summary_records.Rd b/man/get_summary_records.Rd index 5d45e8bd14..3e625fef53 100644 --- a/man/get_summary_records.Rd +++ b/man/get_summary_records.Rd @@ -10,7 +10,7 @@ get_summary_records( filter = NULL, analysis_var, summary_fun, - set_values_to + set_values_to = NULL ) } \arguments{ @@ -67,8 +67,10 @@ to the original dataset observations. If you would like to this instead, see the \code{derive_summary_records()} function. } \examples{ +library(tibble) library(dplyr, warn.conflicts = FALSE) -adeg <- tibble::tribble( + +adeg <- tribble( ~USUBJID, ~EGSEQ, ~PARAM, ~AVISIT, ~EGDTC, ~AVAL, ~TRTA, "XYZ-1001", 1, "QTcF Int. (msec)", "Baseline", "2016-02-24T07:50", 385, "", "XYZ-1001", 2, "QTcF Int. (msec)", "Baseline", "2016-02-24T07:52", 399, "", @@ -99,7 +101,7 @@ get_summary_records( set_values_to = vars(DTYPE = "AVERAGE") ) -advs <- tibble::tribble( +advs <- tribble( ~USUBJID, ~VSSEQ, ~PARAM, ~AVAL, ~VSSTRESU, ~VISIT, ~VSDTC, "XYZ-001-001", 1164, "Weight", 99, "kg", "Screening", "2018-03-19", "XYZ-001-001", 1165, "Weight", 101, "kg", "Run-In", "2018-03-26", @@ -126,7 +128,7 @@ get_summary_records( ) # Sample ADEG dataset with triplicate record for only AVISIT = 'Baseline' -adeg <- tibble::tribble( +adeg <- tribble( ~USUBJID, ~EGSEQ, ~PARAM, ~AVISIT, ~EGDTC, ~AVAL, ~TRTA, "XYZ-1001", 1, "QTcF Int. (msec)", "Baseline", "2016-02-24T07:50", 385, "", "XYZ-1001", 2, "QTcF Int. (msec)", "Baseline", "2016-02-24T07:52", 399, "", @@ -149,7 +151,7 @@ adeg <- tibble::tribble( get_summary_records( adeg, by_vars = vars(USUBJID, PARAM, AVISIT), - filter = dplyr::n() > 2, + filter = n() > 2, analysis_var = AVAL, summary_fun = function(x) mean(x, na.rm = TRUE), set_values_to = vars(DTYPE = "AVERAGE") @@ -167,8 +169,11 @@ General Derivation Functions for all ADaMs that returns variable appended to dat \code{\link{derive_var_merged_cat}()}, \code{\link{derive_var_merged_character}()}, \code{\link{derive_var_merged_exist_flag}()}, +\code{\link{derive_var_merged_summary}()}, \code{\link{derive_var_obs_number}()}, +\code{\link{derive_var_relative_flag}()}, \code{\link{derive_var_worst_flag}()}, +\code{\link{derive_vars_joined}()}, \code{\link{derive_vars_last_dose}()}, \code{\link{derive_vars_merged_lookup}()}, \code{\link{derive_vars_merged}()}, diff --git a/man/get_terms_from_db.Rd b/man/get_terms_from_db.Rd index 46e9007f9c..4fb0635fc6 100644 --- a/man/get_terms_from_db.Rd +++ b/man/get_terms_from_db.Rd @@ -12,8 +12,7 @@ get_terms_from_db( expect_query_name = FALSE, expect_query_id = FALSE, i, - temp_env, - type + temp_env ) } \arguments{ @@ -48,10 +47,6 @@ The value is used for error messages.} \item{temp_env}{Temporary environment The value is passed to the access function.} - -\item{type}{Type of query - -\emph{Permitted Values}: \code{"smq"}, \code{"sdg"}} } \value{ Output dataset of the access function @@ -64,8 +59,7 @@ is in the expected format (see \code{assert_terms()}). } \seealso{ OCCDS Functions: -\code{\link{create_query_data}()}, -\code{\link{create_single_dose_dataset}()}, +\code{\link{derive_var_trtemfl}()}, \code{\link{derive_vars_atc}()}, \code{\link{derive_vars_query}()} } diff --git a/man/list_tte_source_objects.Rd b/man/list_tte_source_objects.Rd index 2f81fdb41e..c69995d6bd 100644 --- a/man/list_tte_source_objects.Rd +++ b/man/list_tte_source_objects.Rd @@ -24,23 +24,22 @@ Source Specifications: \code{\link{assert_db_requirements}()}, \code{\link{assert_terms}()}, \code{\link{assert_valid_queries}()}, +\code{\link{basket_select}()}, \code{\link{censor_source}()}, \code{\link{date_source}()}, \code{\link{death_event}}, -\code{\link{derive_var_dthcaus}()}, +\code{\link{dthcaus_source}()}, \code{\link{event_source}()}, \code{\link{extend_source_datasets}()}, \code{\link{filter_date_sources}()}, -\code{\link{format.sdg_select}()}, -\code{\link{format.smq_select}()}, +\code{\link{format.basket_select}()}, \code{\link{params}()}, \code{\link{query}()}, \code{\link{sdg_select}()}, \code{\link{smq_select}()}, \code{\link{tte_source}()}, -\code{\link{validate_query}()}, -\code{\link{validate_sdg_select}()}, -\code{\link{validate_smq_select}()} +\code{\link{validate_basket_select}()}, +\code{\link{validate_query}()} } \author{ Thomas Neitmann diff --git a/man/max_cond.Rd b/man/max_cond.Rd index 48c4a9fc38..e6573df791 100644 --- a/man/max_cond.Rd +++ b/man/max_cond.Rd @@ -18,7 +18,7 @@ entries/observations. \examples{ library(tibble) -library(dplyr) +library(dplyr, warn.conflicts = FALSE) library(admiral) data <- tribble( ~USUBJID, ~AVISITN, ~AVALC, diff --git a/man/min_cond.Rd b/man/min_cond.Rd index 1d7dad26d7..b7698bbcf6 100644 --- a/man/min_cond.Rd +++ b/man/min_cond.Rd @@ -18,7 +18,7 @@ entries/observations. \examples{ library(tibble) -library(dplyr) +library(dplyr, warn.conflicts = FALSE) library(admiral) data <- tribble( ~USUBJID, ~AVISITN, ~AVALC, diff --git a/man/negate_vars.Rd b/man/negate_vars.Rd new file mode 100644 index 0000000000..d040f31197 --- /dev/null +++ b/man/negate_vars.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/user_utils.R +\name{negate_vars} +\alias{negate_vars} +\title{Negate List of Variables} +\usage{ +negate_vars(vars = NULL) +} +\arguments{ +\item{vars}{List of variables created by \code{vars()}} +} +\value{ +A list of \code{quosures} +} +\description{ +The function adds a minus sign as prefix to each variable. +} +\details{ +This is useful if a list of variables should be removed from a dataset, +e.g., \code{select(!!!negate_vars(by_vars))} removes all by variables. +} +\examples{ +negate_vars(vars(USUBJID, STUDYID)) +} +\seealso{ +Other utils_quo: +\code{\link{chr2vars}()} +} +\author{ +Stefan Bundfuss +} +\concept{utils_quo} +\keyword{utils_quo} diff --git a/man/params.Rd b/man/params.Rd index 5ca0a94103..978c7fedfc 100644 --- a/man/params.Rd +++ b/man/params.Rd @@ -73,23 +73,22 @@ Source Specifications: \code{\link{assert_db_requirements}()}, \code{\link{assert_terms}()}, \code{\link{assert_valid_queries}()}, +\code{\link{basket_select}()}, \code{\link{censor_source}()}, \code{\link{date_source}()}, \code{\link{death_event}}, -\code{\link{derive_var_dthcaus}()}, +\code{\link{dthcaus_source}()}, \code{\link{event_source}()}, \code{\link{extend_source_datasets}()}, \code{\link{filter_date_sources}()}, -\code{\link{format.sdg_select}()}, -\code{\link{format.smq_select}()}, +\code{\link{format.basket_select}()}, \code{\link{list_tte_source_objects}()}, \code{\link{query}()}, \code{\link{sdg_select}()}, \code{\link{smq_select}()}, \code{\link{tte_source}()}, -\code{\link{validate_query}()}, -\code{\link{validate_sdg_select}()}, -\code{\link{validate_smq_select}()} +\code{\link{validate_basket_select}()}, +\code{\link{validate_query}()} } \author{ Thomas Neitmann, Tracey Wang diff --git a/man/print.adam_templates.Rd b/man/print.adam_templates.Rd index 69c350ab1b..99c1e432c5 100644 --- a/man/print.adam_templates.Rd +++ b/man/print.adam_templates.Rd @@ -24,12 +24,12 @@ print(templates) \seealso{ \code{\link[=list_all_templates]{list_all_templates()}} -Other internal: -\code{\link{admiral}}, -\code{\link{print.tte_source}()} +Utilities for printing: +\code{\link{print.source}()}, +\code{\link{print_named_list}()} } \author{ Thomas Neitmann } -\concept{internal} -\keyword{internal} +\concept{utils_print} +\keyword{utils_print} diff --git a/man/print.derivation_slice.Rd b/man/print.derivation_slice.Rd deleted file mode 100644 index be231a5295..0000000000 --- a/man/print.derivation_slice.Rd +++ /dev/null @@ -1,33 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/slice_derivation.R -\name{print.derivation_slice} -\alias{print.derivation_slice} -\title{Print \code{derivation_slice} Objects} -\usage{ -\method{print}{derivation_slice}(x, ...) -} -\arguments{ -\item{x}{A \code{derivation_slice} object} - -\item{...}{Not used} -} -\value{ -No return value, called for side effects -} -\description{ -Print \code{derivation_slice} Objects -} -\examples{ -print(death_event) -} -\seealso{ -\code{\link[=derivation_slice]{derivation_slice()}} - -Higher Order Functions: -\code{\link{call_derivation}()}, -\code{\link{derivation_slice}()}, -\code{\link{restrict_derivation}()}, -\code{\link{slice_derivation}()} -} -\concept{high_order_function} -\keyword{high_order_function} diff --git a/man/print.source.Rd b/man/print.source.Rd new file mode 100644 index 0000000000..a30daac1e0 --- /dev/null +++ b/man/print.source.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/user_utils.R +\name{print.source} +\alias{print.source} +\title{Print \code{source} Objects} +\usage{ +\method{print}{source}(x, ...) +} +\arguments{ +\item{x}{An \code{source} object} + +\item{...}{If \verb{indent = } is specified the output is indented +by the specified number of characters.} +} +\value{ +No return value, called for side effects +} +\description{ +Print \code{source} Objects +} +\examples{ +print(death_event) +} +\seealso{ +Utilities for printing: +\code{\link{print.adam_templates}()}, +\code{\link{print_named_list}()} +} +\author{ +Stefan Bundfuss +} +\concept{utils_print} +\keyword{utils_print} diff --git a/man/print.tte_source.Rd b/man/print.tte_source.Rd deleted file mode 100644 index 285618a80e..0000000000 --- a/man/print.tte_source.Rd +++ /dev/null @@ -1,34 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/derive_param_tte.R -\name{print.tte_source} -\alias{print.tte_source} -\title{Print \code{tte_source} Objects} -\usage{ -\method{print}{tte_source}(x, ...) -} -\arguments{ -\item{x}{A \code{tte_source} object} - -\item{...}{Not used} -} -\value{ -No return value, called for side effects -} -\description{ -Print \code{tte_source} Objects -} -\examples{ -print(death_event) -} -\seealso{ -\code{\link[=tte_source]{tte_source()}}, \code{\link[=censor_source]{censor_source()}}, \code{\link[=event_source]{event_source()}} - -Other internal: -\code{\link{admiral}}, -\code{\link{print.adam_templates}()} -} -\author{ -Thomas Neitmann -} -\concept{internal} -\keyword{internal} diff --git a/man/print_named_list.Rd b/man/print_named_list.Rd new file mode 100644 index 0000000000..abc3512247 --- /dev/null +++ b/man/print_named_list.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/user_utils.R +\name{print_named_list} +\alias{print_named_list} +\title{Print Named List} +\usage{ +print_named_list(list, indent = 0) +} +\arguments{ +\item{list}{A named list} + +\item{indent}{Indent + +The output is indented by the specified number of characters.} +} +\value{ +No return value, called for side effects +} +\description{ +Print Named List +} +\examples{ +print_named_list(death_event) +} +\seealso{ +Utilities for printing: +\code{\link{print.adam_templates}()}, +\code{\link{print.source}()} +} +\author{ +Stefan Bundfuss +} +\concept{utils_print} +\keyword{utils_print} diff --git a/man/queries.Rd b/man/queries.Rd index f7d637cbc3..27837b65c2 100644 --- a/man/queries.Rd +++ b/man/queries.Rd @@ -19,7 +19,6 @@ Queries Dataset \seealso{ Other datasets: \code{\link{admiral_adsl}}, -\code{\link{atoxgr_criteria_ctcv4}}, \code{\link{ex_single}}, \code{\link{queries_mh}} } diff --git a/man/queries_mh.Rd b/man/queries_mh.Rd index 68b6e3317a..12f4968c3e 100644 --- a/man/queries_mh.Rd +++ b/man/queries_mh.Rd @@ -19,7 +19,6 @@ Queries MH Dataset \seealso{ Other datasets: \code{\link{admiral_adsl}}, -\code{\link{atoxgr_criteria_ctcv4}}, \code{\link{ex_single}}, \code{\link{queries}} } diff --git a/man/query.Rd b/man/query.Rd index 47228b7dcd..514ffcc0dd 100644 --- a/man/query.Rd +++ b/man/query.Rd @@ -16,7 +16,7 @@ is set to the name of the query in the SMQ/SDG database. \emph{Permitted Values}: A character scalar or the \code{auto} keyword. The \code{auto} keyword is permitted only for queries which are defined by an -\code{smq_select()} or \code{sdg_select()} object.} +\code{basket_select()} object.} \item{id}{The value is used to populate \code{QUERY_ID} in the output dataset of \code{create_query_data()}. If the \code{auto} keyword is specified, the variable is @@ -24,12 +24,12 @@ set to the id of the query in the SMQ/SDG database. \emph{Permitted Values}: A integer scalar or the \code{auto} keyword. The \code{auto} keyword is permitted only for queries which are defined by an -\code{smq_select()} or \code{sdg_select()} object.} +\code{basket_select()} object.} \item{add_scope_num}{Determines if \code{QUERY_SCOPE_NUM} in the output dataset of \code{create_query_data()} is populated -If the parameter is set to \code{TRUE}, the definition must be an \code{smq_select()} +If the parameter is set to \code{TRUE}, the definition must be an \code{basket_select()} object. \emph{Default}: \code{FALSE} @@ -38,11 +38,9 @@ object. \item{definition}{Definition of terms belonging to the query -There are four different ways to define the terms: +There are three different ways to define the terms: \itemize{ -\item An \code{smq_select()} object is specified to select a query from the SMQ -database. -\item An \code{sdg_select()} object is specified to select a query from the SDG +\item An \code{basket_select()} object is specified to select a query from the SMQ database. \item A data frame with columns \code{TERM_LEVEL} and \code{TERM_NAME} or \code{TERM_ID} can be specified to define the terms of a customized query. The \code{TERM_LEVEL} @@ -56,13 +54,13 @@ to the value the variable. If it refers to a numeric variable, \code{TERM_ID} should be set to the value of the variable. If only character variables or only numeric variables are used, \code{TERM_ID} or \code{TERM_NAME} respectively can be omitted. -\item A list of data frames and \code{smq_select()} objects can be specified to +\item A list of data frames and \code{basket_select()} objects can be specified to define a customized query based on custom terms and SMQs. The data frames must have the same structure as described for the previous item. } -\emph{Permitted Values}: an \code{smq_select()} object, an \code{sdg_select()} object, a -data frame, or a list of data frames and \code{smq_select()} objects.} +\emph{Permitted Values}: an \code{basket_select()} object, a +data frame, or a list of data frames and \code{basket_select()} objects.} } \value{ An object of class \code{query}. @@ -76,15 +74,16 @@ as input to \code{create_query_data()}. # create a query for an SMQ library(tibble) -library(magrittr, warn.conflicts = FALSE) library(dplyr, warn.conflicts = FALSE) +# create a query for a SMQ query( prefix = "SMQ02", id = auto, - definition = smq_select( + definition = basket_select( name = "Pregnancy and neonatal topics (SMQ)", - scope = "NARROW" + scope = "NARROW", + type = "smq" ) ) @@ -92,8 +91,10 @@ query( query( prefix = "SDG01", id = auto, - definition = sdg_select( - name = "5-aminosalicylates for ulcerative colitis" + definition = basket_select( + name = "5-aminosalicylates for ulcerative colitis", + scope = NA_character_, + type = "sdg" ) ) @@ -117,41 +118,42 @@ query( name = "Special issues of interest", definition = list( cqterms, - smq_select( + basket_select( name = "Pregnancy and neonatal topics (SMQ)", - scope = "NARROW" + scope = "NARROW", + type = "smq" ), - smq_select( + basket_select( id = 8050L, - scope = "BROAD" + scope = "BROAD", + type = "smq" ) ) ) } \seealso{ -\code{\link[=create_query_data]{create_query_data()}}, \code{\link[=smq_select]{smq_select()}}, \code{\link[=sdg_select]{sdg_select()}}, \href{../articles/queries_dataset.html}{Queries Dataset Documentation} +\code{\link[=create_query_data]{create_query_data()}}, \code{\link[=basket_select]{basket_select()}}, \href{../articles/queries_dataset.html}{Queries Dataset Documentation} Source Specifications: \code{\link{assert_db_requirements}()}, \code{\link{assert_terms}()}, \code{\link{assert_valid_queries}()}, +\code{\link{basket_select}()}, \code{\link{censor_source}()}, \code{\link{date_source}()}, \code{\link{death_event}}, -\code{\link{derive_var_dthcaus}()}, +\code{\link{dthcaus_source}()}, \code{\link{event_source}()}, \code{\link{extend_source_datasets}()}, \code{\link{filter_date_sources}()}, -\code{\link{format.sdg_select}()}, -\code{\link{format.smq_select}()}, +\code{\link{format.basket_select}()}, \code{\link{list_tte_source_objects}()}, \code{\link{params}()}, \code{\link{sdg_select}()}, \code{\link{smq_select}()}, \code{\link{tte_source}()}, -\code{\link{validate_query}()}, -\code{\link{validate_sdg_select}()}, -\code{\link{validate_smq_select}()} +\code{\link{validate_basket_select}()}, +\code{\link{validate_query}()} } \author{ Stefan Bundfuss diff --git a/man/reexports.Rd b/man/reexports.Rd index 06a6ec6b26..eb33c97e0c 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -3,11 +3,9 @@ \docType{import} \name{reexports} \alias{reexports} -\alias{filter_if} -\alias{negate_vars} -\alias{vars2chr} \alias{vars} \alias{desc} +\alias{\%>\%} \title{Objects exported from other packages} \keyword{internal} \description{ @@ -15,8 +13,8 @@ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ - \item{admiraldev}{\code{\link[admiraldev]{filter_if}}, \code{\link[admiraldev]{negate_vars}}, \code{\link[admiraldev]{vars2chr}}} - \item{dplyr}{\code{\link[dplyr]{desc}}, \code{\link[dplyr]{vars}}} + + \item{magrittr}{\code{\link[magrittr:pipe]{\%>\%}}} }} diff --git a/man/restrict_derivation.Rd b/man/restrict_derivation.Rd index 7633b04aad..3a0cb426a4 100644 --- a/man/restrict_derivation.Rd +++ b/man/restrict_derivation.Rd @@ -22,8 +22,9 @@ Execute a derivation on a subset of the input dataset. } \examples{ -library(magrittr) -adlb <- tibble::tribble( +library(tibble) + +adlb <- tribble( ~USUBJID, ~AVISITN, ~AVAL, ~ABLFL, "1", -1, 113, NA_character_, "1", 0, 113, "Y", @@ -69,7 +70,6 @@ restrict_derivation( Higher Order Functions: \code{\link{call_derivation}()}, \code{\link{derivation_slice}()}, -\code{\link{print.derivation_slice}()}, \code{\link{slice_derivation}()} } \author{ diff --git a/man/roxygen/meta.R b/man/roxygen/meta.R index db3d081fc2..7167e5d4bb 100644 --- a/man/roxygen/meta.R +++ b/man/roxygen/meta.R @@ -17,7 +17,9 @@ list( utils_help = "Utilities used within Derivation functions: ", utils_examples = "Utilities used for examples and template scripts: ", utils_impute = "Utilities used for date imputation: ", + utils_print = "Utilities for printing: ", source_specifications = "Source Specifications: ", - high_order_function = "Higher Order Functions: " + high_order_function = "Higher Order Functions: ", + create_aux = "Creating auxiliary datasets: " ) ) diff --git a/man/sdg_select.Rd b/man/sdg_select.Rd index 28796de2b7..e2445c3733 100644 --- a/man/sdg_select.Rd +++ b/man/sdg_select.Rd @@ -17,9 +17,11 @@ from the company database.} An object of class \code{sdg_select}. } \description{ -Create an \code{sdg_select} object +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} } \details{ +This function is \emph{deprecated}, please use \code{basket_select()} instead. + Exactly one \code{name} or \code{id} must be specified. } \seealso{ @@ -29,23 +31,22 @@ Source Specifications: \code{\link{assert_db_requirements}()}, \code{\link{assert_terms}()}, \code{\link{assert_valid_queries}()}, +\code{\link{basket_select}()}, \code{\link{censor_source}()}, \code{\link{date_source}()}, \code{\link{death_event}}, -\code{\link{derive_var_dthcaus}()}, +\code{\link{dthcaus_source}()}, \code{\link{event_source}()}, \code{\link{extend_source_datasets}()}, \code{\link{filter_date_sources}()}, -\code{\link{format.sdg_select}()}, -\code{\link{format.smq_select}()}, +\code{\link{format.basket_select}()}, \code{\link{list_tte_source_objects}()}, \code{\link{params}()}, \code{\link{query}()}, \code{\link{smq_select}()}, \code{\link{tte_source}()}, -\code{\link{validate_query}()}, -\code{\link{validate_sdg_select}()}, -\code{\link{validate_smq_select}()} +\code{\link{validate_basket_select}()}, +\code{\link{validate_query}()} } \author{ Stefan Bundfuss diff --git a/man/set_admiral_options.Rd b/man/set_admiral_options.Rd new file mode 100644 index 0000000000..5529086696 --- /dev/null +++ b/man/set_admiral_options.Rd @@ -0,0 +1,79 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/admiral_options.R +\name{set_admiral_options} +\alias{set_admiral_options} +\title{Set the Value of Admiral Options} +\usage{ +set_admiral_options(subject_keys) +} +\arguments{ +\item{subject_keys}{Variables to uniquely identify a subject, defaults to +\code{vars(STUDYID, USUBJID)}. This option is used as default value for the +\code{subject_keys} argument in all admiral functions.} +} +\value{ +No return value, called for side effects. +} +\description{ +Set the Values of Admiral Options That Can Be Modified for Advanced Users. +} +\details{ +Modify an admiral option, e.g \code{subject_keys}, such that it automatically affects downstream +function inputs where \code{get_admiral_option()} is called such as \code{derive_param_exist_flag()}. +} +\examples{ +library(lubridate) +library(dplyr, warn.conflicts = FALSE) +library(tibble) +set_admiral_options(subject_keys = vars(STUDYID, USUBJID2)) + +# Derive a new parameter for measurable disease at baseline +adsl <- tribble( + ~USUBJID2, + "1", + "2", + "3" +) \%>\% + mutate(STUDYID = "XX1234") + +tu <- tribble( + ~USUBJID2, ~VISIT, ~TUSTRESC, + "1", "SCREENING", "TARGET", + "1", "WEEK 1", "TARGET", + "1", "WEEK 5", "TARGET", + "1", "WEEK 9", "NON-TARGET", + "2", "SCREENING", "NON-TARGET", + "2", "SCREENING", "NON-TARGET" +) \%>\% + mutate( + STUDYID = "XX1234", + TUTESTCD = "TUMIDENT" + ) + +derive_param_exist_flag( + dataset_adsl = adsl, + dataset_add = tu, + filter_add = TUTESTCD == "TUMIDENT" & VISIT == "SCREENING", + condition = TUSTRESC == "TARGET", + false_value = "N", + missing_value = "N", + set_values_to = vars( + PARAMCD = "MDIS", + PARAM = "Measurable Disease at Baseline" + ) +) +} +\seealso{ +\code{\link[=vars]{vars()}}, \code{\link[=get_admiral_option]{get_admiral_option()}}, \code{\link[=derive_param_exist_flag]{derive_param_exist_flag()}}, +\code{\link[=derive_param_first_event]{derive_param_first_event()}}, \code{\link[=derive_param_tte]{derive_param_tte()}}, \code{\link[=derive_var_disposition_status]{derive_var_disposition_status()}}, +\code{\link[=derive_var_dthcaus]{derive_var_dthcaus()}}, \code{\link[=derive_var_extreme_dtm]{derive_var_extreme_dtm()}}, \code{\link[=derive_vars_disposition_reason]{derive_vars_disposition_reason()}}, +\code{\link[=derive_vars_period]{derive_vars_period()}}, \code{\link[=create_period_dataset]{create_period_dataset()}} + +Other admiral_options: +\code{\link{get_admiral_option}()} +} +\author{ +Zelos Zhu +} +\concept{admiral_options} +\keyword{admiral_options} diff --git a/man/slice_derivation.Rd b/man/slice_derivation.Rd index e665a310cf..aeb06167db 100644 --- a/man/slice_derivation.Rd +++ b/man/slice_derivation.Rd @@ -45,9 +45,9 @@ output dataset but the derivation is not called for them. } } \examples{ - +library(tibble) library(stringr) -advs <- tibble::tribble( +advs <- tribble( ~USUBJID, ~VSDTC, ~VSTPT, "1", "2020-04-16", NA_character_, "1", "2020-04-16", "BEFORE TREATMENT" @@ -79,7 +79,6 @@ slice_derivation( Higher Order Functions: \code{\link{call_derivation}()}, \code{\link{derivation_slice}()}, -\code{\link{print.derivation_slice}()}, \code{\link{restrict_derivation}()} } \author{ diff --git a/man/smq_select.Rd b/man/smq_select.Rd index 716d17c0a6..53b9a6040f 100644 --- a/man/smq_select.Rd +++ b/man/smq_select.Rd @@ -22,9 +22,11 @@ from the company database. An object of class \code{smq_select}. } \description{ -Create an \code{smq_select} object +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} } \details{ +This function is \emph{deprecated}, please use \code{basket_select()} instead. + Exactly one of \code{name} or \code{id} must be specified. } \seealso{ @@ -34,23 +36,22 @@ Source Specifications: \code{\link{assert_db_requirements}()}, \code{\link{assert_terms}()}, \code{\link{assert_valid_queries}()}, +\code{\link{basket_select}()}, \code{\link{censor_source}()}, \code{\link{date_source}()}, \code{\link{death_event}}, -\code{\link{derive_var_dthcaus}()}, +\code{\link{dthcaus_source}()}, \code{\link{event_source}()}, \code{\link{extend_source_datasets}()}, \code{\link{filter_date_sources}()}, -\code{\link{format.sdg_select}()}, -\code{\link{format.smq_select}()}, +\code{\link{format.basket_select}()}, \code{\link{list_tte_source_objects}()}, \code{\link{params}()}, \code{\link{query}()}, \code{\link{sdg_select}()}, \code{\link{tte_source}()}, -\code{\link{validate_query}()}, -\code{\link{validate_sdg_select}()}, -\code{\link{validate_smq_select}()} +\code{\link{validate_basket_select}()}, +\code{\link{validate_query}()} } \author{ Stefan Bundfuss diff --git a/man/tte_source.Rd b/man/tte_source.Rd index 59f0f3c943..411ecf9141 100644 --- a/man/tte_source.Rd +++ b/man/tte_source.Rd @@ -43,23 +43,22 @@ Source Specifications: \code{\link{assert_db_requirements}()}, \code{\link{assert_terms}()}, \code{\link{assert_valid_queries}()}, +\code{\link{basket_select}()}, \code{\link{censor_source}()}, \code{\link{date_source}()}, \code{\link{death_event}}, -\code{\link{derive_var_dthcaus}()}, +\code{\link{dthcaus_source}()}, \code{\link{event_source}()}, \code{\link{extend_source_datasets}()}, \code{\link{filter_date_sources}()}, -\code{\link{format.sdg_select}()}, -\code{\link{format.smq_select}()}, +\code{\link{format.basket_select}()}, \code{\link{list_tte_source_objects}()}, \code{\link{params}()}, \code{\link{query}()}, \code{\link{sdg_select}()}, \code{\link{smq_select}()}, -\code{\link{validate_query}()}, -\code{\link{validate_sdg_select}()}, -\code{\link{validate_smq_select}()} +\code{\link{validate_basket_select}()}, +\code{\link{validate_query}()} } \author{ Stefan Bundfuss diff --git a/man/tte_source_objects.Rd b/man/tte_source_objects.Rd index 66e0e82106..ec6c16bd2d 100644 --- a/man/tte_source_objects.Rd +++ b/man/tte_source_objects.Rd @@ -64,23 +64,22 @@ Source Specifications: \code{\link{assert_db_requirements}()}, \code{\link{assert_terms}()}, \code{\link{assert_valid_queries}()}, +\code{\link{basket_select}()}, \code{\link{censor_source}()}, \code{\link{date_source}()}, -\code{\link{derive_var_dthcaus}()}, +\code{\link{dthcaus_source}()}, \code{\link{event_source}()}, \code{\link{extend_source_datasets}()}, \code{\link{filter_date_sources}()}, -\code{\link{format.sdg_select}()}, -\code{\link{format.smq_select}()}, +\code{\link{format.basket_select}()}, \code{\link{list_tte_source_objects}()}, \code{\link{params}()}, \code{\link{query}()}, \code{\link{sdg_select}()}, \code{\link{smq_select}()}, \code{\link{tte_source}()}, -\code{\link{validate_query}()}, -\code{\link{validate_sdg_select}()}, -\code{\link{validate_smq_select}()} +\code{\link{validate_basket_select}()}, +\code{\link{validate_query}()} } \concept{source_specifications} \keyword{source_specifications} diff --git a/man/validate_sdg_select.Rd b/man/validate_basket_select.Rd similarity index 64% rename from man/validate_sdg_select.Rd rename to man/validate_basket_select.Rd index b45e0bb83b..e30e30d264 100644 --- a/man/validate_sdg_select.Rd +++ b/man/validate_basket_select.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/create_query_data.R -\name{validate_sdg_select} -\alias{validate_sdg_select} -\title{Validate an object is indeed a \code{sdg_select} object} +\name{validate_basket_select} +\alias{validate_basket_select} +\title{Validate an object is indeed a \code{basket_select} object} \usage{ -validate_sdg_select(obj) +validate_basket_select(obj) } \arguments{ \item{obj}{An object to be validated.} @@ -13,35 +13,34 @@ validate_sdg_select(obj) The original object. } \description{ -Validate an object is indeed a \code{sdg_select} object +Validate an object is indeed a \code{basket_select} object } \seealso{ -\code{\link[=sdg_select]{sdg_select()}} +\code{\link[=basket_select]{basket_select()}} Source Specifications: \code{\link{assert_db_requirements}()}, \code{\link{assert_terms}()}, \code{\link{assert_valid_queries}()}, +\code{\link{basket_select}()}, \code{\link{censor_source}()}, \code{\link{date_source}()}, \code{\link{death_event}}, -\code{\link{derive_var_dthcaus}()}, +\code{\link{dthcaus_source}()}, \code{\link{event_source}()}, \code{\link{extend_source_datasets}()}, \code{\link{filter_date_sources}()}, -\code{\link{format.sdg_select}()}, -\code{\link{format.smq_select}()}, +\code{\link{format.basket_select}()}, \code{\link{list_tte_source_objects}()}, \code{\link{params}()}, \code{\link{query}()}, \code{\link{sdg_select}()}, \code{\link{smq_select}()}, \code{\link{tte_source}()}, -\code{\link{validate_query}()}, -\code{\link{validate_smq_select}()} +\code{\link{validate_query}()} } \author{ -Stefan Bundfuss +Tamara Senior } \concept{source_specifications} \keyword{source_specifications} diff --git a/man/validate_query.Rd b/man/validate_query.Rd index c62bc7b6d4..2a3f9b7c21 100644 --- a/man/validate_query.Rd +++ b/man/validate_query.Rd @@ -22,26 +22,25 @@ Source Specifications: \code{\link{assert_db_requirements}()}, \code{\link{assert_terms}()}, \code{\link{assert_valid_queries}()}, +\code{\link{basket_select}()}, \code{\link{censor_source}()}, \code{\link{date_source}()}, \code{\link{death_event}}, -\code{\link{derive_var_dthcaus}()}, +\code{\link{dthcaus_source}()}, \code{\link{event_source}()}, \code{\link{extend_source_datasets}()}, \code{\link{filter_date_sources}()}, -\code{\link{format.sdg_select}()}, -\code{\link{format.smq_select}()}, +\code{\link{format.basket_select}()}, \code{\link{list_tte_source_objects}()}, \code{\link{params}()}, \code{\link{query}()}, \code{\link{sdg_select}()}, \code{\link{smq_select}()}, \code{\link{tte_source}()}, -\code{\link{validate_sdg_select}()}, -\code{\link{validate_smq_select}()} +\code{\link{validate_basket_select}()} } \author{ -Stefan Bundfuss +Stefan Bundfuss Tamara Senior } \concept{source_specifications} \keyword{source_specifications} diff --git a/man/validate_smq_select.Rd b/man/validate_smq_select.Rd deleted file mode 100644 index cec3da0a0c..0000000000 --- a/man/validate_smq_select.Rd +++ /dev/null @@ -1,47 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/create_query_data.R -\name{validate_smq_select} -\alias{validate_smq_select} -\title{Validate an object is indeed a \code{smq_select} object} -\usage{ -validate_smq_select(obj) -} -\arguments{ -\item{obj}{An object to be validated.} -} -\value{ -The original object. -} -\description{ -Validate an object is indeed a \code{smq_select} object -} -\seealso{ -\code{\link[=smq_select]{smq_select()}} - -Source Specifications: -\code{\link{assert_db_requirements}()}, -\code{\link{assert_terms}()}, -\code{\link{assert_valid_queries}()}, -\code{\link{censor_source}()}, -\code{\link{date_source}()}, -\code{\link{death_event}}, -\code{\link{derive_var_dthcaus}()}, -\code{\link{event_source}()}, -\code{\link{extend_source_datasets}()}, -\code{\link{filter_date_sources}()}, -\code{\link{format.sdg_select}()}, -\code{\link{format.smq_select}()}, -\code{\link{list_tte_source_objects}()}, -\code{\link{params}()}, -\code{\link{query}()}, -\code{\link{sdg_select}()}, -\code{\link{smq_select}()}, -\code{\link{tte_source}()}, -\code{\link{validate_query}()}, -\code{\link{validate_sdg_select}()} -} -\author{ -Stefan Bundfuss -} -\concept{source_specifications} -\keyword{source_specifications} diff --git a/man/yn_to_numeric.Rd b/man/yn_to_numeric.Rd index e3f5b43ce8..8643c878b3 100644 --- a/man/yn_to_numeric.Rd +++ b/man/yn_to_numeric.Rd @@ -22,6 +22,7 @@ yn_to_numeric(c("Y", "N", NA_character_)) \seealso{ Utilities for Formatting Observations: \code{\link{convert_blanks_to_na}()}, +\code{\link{convert_na_to_blanks}()}, \code{\link{format_eoxxstt_default}()}, \code{\link{format_reason_default}()} } diff --git a/pkgdown/favicon/apple-touch-icon-120x120.png b/pkgdown/favicon/apple-touch-icon-120x120.png index 34d935056e..06193dd8a3 100644 Binary files a/pkgdown/favicon/apple-touch-icon-120x120.png and b/pkgdown/favicon/apple-touch-icon-120x120.png differ diff --git a/pkgdown/favicon/apple-touch-icon-152x152.png b/pkgdown/favicon/apple-touch-icon-152x152.png index 54ff9452eb..02acc58a22 100644 Binary files a/pkgdown/favicon/apple-touch-icon-152x152.png and b/pkgdown/favicon/apple-touch-icon-152x152.png differ diff --git a/pkgdown/favicon/apple-touch-icon-180x180.png b/pkgdown/favicon/apple-touch-icon-180x180.png index ceacad0d7f..8ea6a85cb2 100644 Binary files a/pkgdown/favicon/apple-touch-icon-180x180.png and b/pkgdown/favicon/apple-touch-icon-180x180.png differ diff --git a/pkgdown/favicon/apple-touch-icon-60x60.png b/pkgdown/favicon/apple-touch-icon-60x60.png index 7f3ce9c9fe..c666839ebe 100644 Binary files a/pkgdown/favicon/apple-touch-icon-60x60.png and b/pkgdown/favicon/apple-touch-icon-60x60.png differ diff --git a/pkgdown/favicon/apple-touch-icon-76x76.png b/pkgdown/favicon/apple-touch-icon-76x76.png index bd3b1fcb44..64c06276f7 100644 Binary files a/pkgdown/favicon/apple-touch-icon-76x76.png and b/pkgdown/favicon/apple-touch-icon-76x76.png differ diff --git a/pkgdown/favicon/apple-touch-icon.png b/pkgdown/favicon/apple-touch-icon.png index 67780bb2df..f0f00011b4 100644 Binary files a/pkgdown/favicon/apple-touch-icon.png and b/pkgdown/favicon/apple-touch-icon.png differ diff --git a/pkgdown/favicon/favicon-16x16.png b/pkgdown/favicon/favicon-16x16.png index c2f1003d11..2e0d30e5c1 100644 Binary files a/pkgdown/favicon/favicon-16x16.png and b/pkgdown/favicon/favicon-16x16.png differ diff --git a/pkgdown/favicon/favicon-32x32.png b/pkgdown/favicon/favicon-32x32.png index 91e4140581..37111f2220 100644 Binary files a/pkgdown/favicon/favicon-32x32.png and b/pkgdown/favicon/favicon-32x32.png differ diff --git a/pkgdown/favicon/favicon.ico b/pkgdown/favicon/favicon.ico index dc4c159fc1..e7fc65ada0 100644 Binary files a/pkgdown/favicon/favicon.ico and b/pkgdown/favicon/favicon.ico differ diff --git a/renv.lock b/renv.lock index 0b1c785214..b6e48a22a8 100644 --- a/renv.lock +++ b/renv.lock @@ -1,696 +1,1304 @@ { "R": { - "Version": "3.6.3", + "Version": "4.0.5", "Repositories": [ { "Name": "CRAN", - "URL": "https://cran.rstudio.com" + "URL": "https://cloud.r-project.org" + }, + { + "Name": "MRAN", + "URL": "https://cran.microsoft.com/snapshot/2021-03-31" } ] }, "Packages": { "BH": { "Package": "BH", - "Version": "1.72.0-3", + "Version": "1.75.0-0", "Source": "Repository", "Repository": "CRAN", - "Hash": "8f9ce74c6417d61f0782cbae5fd2b7b0" + "Hash": "e4c04affc2cac20c8fec18385cd14691", + "Requirements": [] }, "DT": { "Package": "DT", - "Version": "0.12", + "Version": "0.17", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "56b33b77f4cffd78ff96b8e5a69eabb0", + "Requirements": [ + "crosstalk", + "htmltools", + "htmlwidgets", + "jsonlite", + "magrittr", + "promises" + ] + }, + "KernSmooth": { + "Package": "KernSmooth", + "Version": "2.23-18", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "9e703ad8bf0e99f3691f05da32dfe68b", + "Requirements": [] + }, + "MASS": { + "Package": "MASS", + "Version": "7.3-53.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "4ef21dd0348b9abb7f8bd1d77e4cd0c3", + "Requirements": [] + }, + "Matrix": { + "Package": "Matrix", + "Version": "1.3-2", "Source": "Repository", "Repository": "CRAN", - "Hash": "0e120603cc57e4f1d741f739aa8147ba" + "Hash": "ff280503079ad8623d3c4b1519b24ea2", + "Requirements": [ + "lattice" + ] }, "R.cache": { "Package": "R.cache", - "Version": "0.15.0", + "Version": "0.16.0", "Source": "Repository", "Repository": "CRAN", - "Hash": "e92a8ea8388c47c82ed8aa435ed3be50" + "Hash": "fe539ca3f8efb7410c3ae2cf5fe6c0f8", + "Requirements": [ + "R.methodsS3", + "R.oo", + "R.utils", + "digest" + ] }, "R.methodsS3": { "Package": "R.methodsS3", "Version": "1.8.1", "Source": "Repository", "Repository": "CRAN", - "Hash": "4bf6453323755202d5909697b6f7c109" + "Hash": "4bf6453323755202d5909697b6f7c109", + "Requirements": [] }, "R.oo": { "Package": "R.oo", "Version": "1.24.0", "Source": "Repository", "Repository": "CRAN", - "Hash": "5709328352717e2f0a9c012be8a97554" + "Hash": "5709328352717e2f0a9c012be8a97554", + "Requirements": [ + "R.methodsS3" + ] }, "R.utils": { "Package": "R.utils", - "Version": "2.11.0", + "Version": "2.12.0", "Source": "Repository", "Repository": "CRAN", - "Hash": "a7ecb8e60815c7a18648e84cd121b23a" + "Hash": "d31333e10f14027e1cbbc6f266512806", + "Requirements": [ + "R.methodsS3", + "R.oo" + ] }, "R6": { "Package": "R6", - "Version": "2.4.1", + "Version": "2.5.0", "Source": "Repository", "Repository": "CRAN", - "Hash": "292b54f8f4b94669b08f94e5acce6be2" + "Hash": "b203113193e70978a696b2809525649d", + "Requirements": [] }, "Rcpp": { "Package": "Rcpp", - "Version": "1.0.3", + "Version": "1.0.6", "Source": "Repository", "Repository": "CRAN", - "Hash": "f3ca785924863b0e4c8cb23b6a5c75a1" - }, - "admiral.test": { - "Package": "admiral.test", - "Version": "0.2.0", - "Source": "GitHub", - "RemoteType": "github", - "RemoteHost": "api.github.com", - "RemoteUsername": "pharmaverse", - "RemoteRepo": "admiral.test", - "RemoteRef": "devel", - "RemoteSha": "b1f4a44a76410e5ef285f607e038f4c5b9f02dc9", - "Hash": "c6002d9280db2b0c00c49320fe00684b" - }, - "admiraldev": { - "Package": "admiraldev", - "Version": "0.1.0", - "Source": "Repository", - "Repository": "CRAN" + "Hash": "dbb5e436998a7eba5a9d682060533338", + "Requirements": [] }, "askpass": { "Package": "askpass", "Version": "1.1", "Source": "Repository", "Repository": "CRAN", - "Hash": "e8a22846fff485f0be3770c2da758713" + "Hash": "e8a22846fff485f0be3770c2da758713", + "Requirements": [ + "sys" + ] }, "assertthat": { "Package": "assertthat", "Version": "0.2.1", "Source": "Repository", "Repository": "CRAN", - "Hash": "50c838a310445e954bc13f26f26a6ecf" + "Hash": "50c838a310445e954bc13f26f26a6ecf", + "Requirements": [] }, "backports": { "Package": "backports", - "Version": "1.1.5", + "Version": "1.2.1", "Source": "Repository", "Repository": "CRAN", - "Hash": "e9f705633dc932bfd5b02b17a5053a06" + "Hash": "644043219fc24e190c2f620c1a380a69", + "Requirements": [] }, "base64enc": { "Package": "base64enc", "Version": "0.1-3", "Source": "Repository", "Repository": "CRAN", - "Hash": "543776ae6848fde2f48ff3816d0628bc" + "Hash": "543776ae6848fde2f48ff3816d0628bc", + "Requirements": [] + }, + "boot": { + "Package": "boot", + "Version": "1.3-27", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "d9778c960792721e8433daaf3db8f16a", + "Requirements": [] }, "brew": { "Package": "brew", "Version": "1.0-6", "Source": "Repository", "Repository": "CRAN", - "Hash": "92a5f887f9ae3035ac7afde22ba73ee9" + "Hash": "92a5f887f9ae3035ac7afde22ba73ee9", + "Requirements": [] }, "brio": { "Package": "brio", - "Version": "1.1.2", + "Version": "1.1.3", "Source": "Repository", "Repository": "CRAN", - "Hash": "2f01e16ff9571fe70381c7b9ae560dc4" + "Hash": "976cf154dfb043c012d87cddd8bca363", + "Requirements": [] }, "bslib": { "Package": "bslib", - "Version": "0.3.1", + "Version": "0.4.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "be5ee090716ce1671be6cd5d7c34d091", + "Requirements": [ + "cachem", + "htmltools", + "jquerylib", + "jsonlite", + "memoise", + "rlang", + "sass" + ] + }, + "cachem": { + "Package": "cachem", + "Version": "1.0.4", "Source": "Repository", "Repository": "CRAN", - "Hash": "56ae7e1987b340186a8a5a157c2ec358" + "Hash": "2703a46dcabfb902f10060b2bca9f708", + "Requirements": [ + "fastmap", + "rlang" + ] }, "callr": { "Package": "callr", - "Version": "3.7.0", + "Version": "3.7.2", "Source": "Repository", "Repository": "CRAN", - "Hash": "461aa75a11ce2400245190ef5d3995df" + "Hash": "358689cac9fe93b1bb3a19088d2dbed8", + "Requirements": [ + "R6", + "processx" + ] }, "cellranger": { "Package": "cellranger", "Version": "1.1.0", "Source": "Repository", "Repository": "CRAN", - "Hash": "f61dbaec772ccd2e17705c1e872e9e7c" + "Hash": "f61dbaec772ccd2e17705c1e872e9e7c", + "Requirements": [ + "rematch", + "tibble" + ] + }, + "class": { + "Package": "class", + "Version": "7.3-18", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "15ef288688a6919417ade6251deea2b3", + "Requirements": [ + "MASS" + ] }, "cli": { "Package": "cli", - "Version": "3.3.0", + "Version": "3.4.1", "Source": "Repository", "Repository": "CRAN", - "Hash": "23abf173c2b783dcc43379ab9bba00ee" + "Hash": "0d297d01734d2bcea40197bd4971a764", + "Requirements": [] }, "clipr": { "Package": "clipr", - "Version": "0.7.0", + "Version": "0.7.1", "Source": "Repository", "Repository": "CRAN", - "Hash": "08cf4045c149a0f0eaf405324c7495bd" + "Hash": "ebaa97ac99cc2daf04e77eecc7b781d7", + "Requirements": [] + }, + "cluster": { + "Package": "cluster", + "Version": "2.1.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "5ea8f54741ff907e2c0b5efabc9de729", + "Requirements": [] }, "codetools": { "Package": "codetools", - "Version": "0.2-16", + "Version": "0.2-18", "Source": "Repository", "Repository": "CRAN", - "Hash": "89cf4b8207269ccf82fbeb6473fd662b" + "Hash": "019388fc48e48b3da0d3a76ff94608a8", + "Requirements": [] }, "commonmark": { "Package": "commonmark", "Version": "1.7", "Source": "Repository", "Repository": "CRAN", - "Hash": "0f22be39ec1d141fd03683c06f3a6e67" + "Hash": "0f22be39ec1d141fd03683c06f3a6e67", + "Requirements": [] }, "covr": { "Package": "covr", - "Version": "3.5.0", + "Version": "3.5.1", "Source": "Repository", "Repository": "CRAN", - "Hash": "cbc6df1ef6ee576f844f973c1fc04ab4" + "Hash": "6d80a9fc3c0c8473153b54fa54719dfd", + "Requirements": [ + "crayon", + "digest", + "httr", + "jsonlite", + "rex", + "withr", + "yaml" + ] }, "cpp11": { "Package": "cpp11", - "Version": "0.4.2", + "Version": "0.4.3", "Source": "Repository", "Repository": "CRAN", - "Hash": "fa53ce256cd280f468c080a58ea5ba8c" + "Hash": "ed588261931ee3be2c700d22e94a29ab", + "Requirements": [] }, "crayon": { "Package": "crayon", - "Version": "1.3.4", + "Version": "1.4.1", "Source": "Repository", "Repository": "CRAN", - "Hash": "0d57bc8e27b7ba9e45dba825ebc0de6b" + "Hash": "e75525c55c70e5f4f78c9960a4b402e9", + "Requirements": [] }, "credentials": { "Package": "credentials", "Version": "1.3.0", "Source": "Repository", "Repository": "CRAN", - "Hash": "a96728288c75a814c900af9da84387be" + "Hash": "a96728288c75a814c900af9da84387be", + "Requirements": [ + "askpass", + "curl", + "jsonlite", + "openssl", + "sys" + ] }, "crosstalk": { "Package": "crosstalk", "Version": "1.1.1", "Source": "Repository", "Repository": "CRAN", - "Hash": "2b06f9e415a62b6762e4b8098d2aecbc" + "Hash": "2b06f9e415a62b6762e4b8098d2aecbc", + "Requirements": [ + "R6", + "htmltools", + "jsonlite", + "lazyeval" + ] }, "curl": { "Package": "curl", "Version": "4.3", "Source": "Repository", "Repository": "CRAN", - "Hash": "2b7d10581cc730804e9ed178c8374bd6" + "Hash": "2b7d10581cc730804e9ed178c8374bd6", + "Requirements": [] }, "cyclocomp": { "Package": "cyclocomp", "Version": "1.1.0", "Source": "Repository", "Repository": "CRAN", - "Hash": "53cbed70a2f7472d48fb6aef08442f25" + "Hash": "53cbed70a2f7472d48fb6aef08442f25", + "Requirements": [ + "callr", + "crayon", + "desc", + "remotes", + "withr" + ] }, "desc": { "Package": "desc", - "Version": "1.4.0", + "Version": "1.4.2", "Source": "Repository", "Repository": "CRAN", - "Hash": "28763d08fadd0b733e3cee9dab4e12fe" + "Hash": "6b9602c7ebbe87101a9c8edb6e8b6d21", + "Requirements": [ + "R6", + "cli", + "rprojroot" + ] }, "devtools": { "Package": "devtools", - "Version": "2.2.2", - "Source": "Repository", - "Repository": "CRAN", - "Hash": "e12b66f9f6dc41b765b047b4df4b4a38" + "Version": "2.3.2", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "415656f50722f5b6e6bcf80855ce11b9", + "Requirements": [ + "DT", + "callr", + "cli", + "covr", + "desc", + "ellipsis", + "httr", + "jsonlite", + "memoise", + "pkgbuild", + "pkgload", + "rcmdcheck", + "remotes", + "rlang", + "roxygen2", + "rstudioapi", + "rversions", + "sessioninfo", + "testthat", + "usethis", + "withr" + ] }, "diffdf": { "Package": "diffdf", "Version": "1.0.4", "Source": "Repository", "Repository": "CRAN", - "Hash": "9ddedef46959baad2080047a1b0117fe" + "Hash": "9ddedef46959baad2080047a1b0117fe", + "Requirements": [ + "tibble" + ] }, "diffobj": { "Package": "diffobj", "Version": "0.3.4", "Source": "Repository", "Repository": "CRAN", - "Hash": "feb5b7455eba422a2c110bb89852e6a3" + "Hash": "feb5b7455eba422a2c110bb89852e6a3", + "Requirements": [ + "crayon" + ] }, "digest": { "Package": "digest", - "Version": "0.6.25", + "Version": "0.6.27", "Source": "Repository", "Repository": "CRAN", - "Hash": "f697db7d92b7028c4b3436e9603fb636" + "Hash": "a0cbe758a531d054b537d16dff4d58a1", + "Requirements": [] }, "downlit": { "Package": "downlit", - "Version": "0.4.0", + "Version": "0.4.2", "Source": "Repository", "Repository": "CRAN", - "Hash": "ba63dc9ab5a31f3209892437e40c5f60" + "Hash": "79bf3f66590752ffbba20f8d2da94c7c", + "Requirements": [ + "brio", + "desc", + "digest", + "evaluate", + "fansi", + "memoise", + "rlang", + "vctrs", + "withr", + "yaml" + ] }, "dplyr": { "Package": "dplyr", - "Version": "0.8.5", - "Source": "Repository", - "Repository": "CRAN", - "Hash": "57a42ddf80f429764ff7987128c3fd0a" + "Version": "1.0.5", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "d0d76c11ec807eb3f000eba4e3eb0f68", + "Requirements": [ + "R6", + "ellipsis", + "generics", + "glue", + "lifecycle", + "magrittr", + "rlang", + "tibble", + "tidyselect", + "vctrs" + ] }, "ellipsis": { "Package": "ellipsis", "Version": "0.3.2", "Source": "Repository", "Repository": "CRAN", - "Hash": "bb0eec2fe32e88d9e2836c2f73ea2077" + "Hash": "bb0eec2fe32e88d9e2836c2f73ea2077", + "Requirements": [ + "rlang" + ] }, "evaluate": { "Package": "evaluate", - "Version": "0.15", + "Version": "0.17", "Source": "Repository", "Repository": "CRAN", - "Hash": "699a7a93d08c962d9f8950b2d7a227f1" + "Hash": "9171b012a55a1ef53f1442b1d798a3b4", + "Requirements": [] }, "fansi": { "Package": "fansi", - "Version": "0.4.1", + "Version": "0.4.2", "Source": "Repository", "Repository": "CRAN", - "Hash": "7fce217eaaf8016e72065e85c73027b5" + "Hash": "fea074fb67fe4c25d47ad09087da847d", + "Requirements": [] }, "fastmap": { "Package": "fastmap", "Version": "1.1.0", "Source": "Repository", "Repository": "CRAN", - "Hash": "77bd60a6157420d4ffa93b27cf6a58b8" + "Hash": "77bd60a6157420d4ffa93b27cf6a58b8", + "Requirements": [] + }, + "foreign": { + "Package": "foreign", + "Version": "0.8-81", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "74628ea7a3be5ee8a7b5bb0a8e84882e", + "Requirements": [] }, "fs": { "Package": "fs", "Version": "1.5.2", "Source": "Repository", "Repository": "CRAN", - "Hash": "7c89603d81793f0d5486d91ab1fc6f1d" + "Hash": "7c89603d81793f0d5486d91ab1fc6f1d", + "Requirements": [] + }, + "generics": { + "Package": "generics", + "Version": "0.1.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "4d243a9c10b00589889fe32314ffd902", + "Requirements": [] }, "gert": { "Package": "gert", - "Version": "1.4.3", + "Version": "1.9.1", "Source": "Repository", "Repository": "CRAN", - "Hash": "3a3f29a74f8bd85ed8d53ab039b18bcd" + "Hash": "9a091a6d2fb91e43afd4337e2dcef2e7", + "Requirements": [ + "askpass", + "credentials", + "openssl", + "rstudioapi", + "sys", + "zip" + ] }, "gh": { "Package": "gh", - "Version": "1.3.0", + "Version": "1.3.1", "Source": "Repository", "Repository": "CRAN", - "Hash": "38c2580abbda249bd6afeec00d14f531" + "Hash": "b6a12054ee13dce0f6696c019c10e539", + "Requirements": [ + "cli", + "gitcreds", + "httr", + "ini", + "jsonlite" + ] }, "git2r": { "Package": "git2r", - "Version": "0.26.1", + "Version": "0.28.0", "Source": "Repository", "Repository": "CRAN", - "Hash": "135db4dbc94ed18f629ff8843a8064b7" + "Hash": "f64fd34026f6025de71a4354800e6d79", + "Requirements": [] }, "gitcreds": { "Package": "gitcreds", "Version": "0.1.1", "Source": "Repository", "Repository": "CRAN", - "Hash": "f3aefccc1cc50de6338146b62f115de8" + "Hash": "f3aefccc1cc50de6338146b62f115de8", + "Requirements": [] }, "glue": { "Package": "glue", - "Version": "1.6.0", + "Version": "1.6.2", "Source": "Repository", "Repository": "CRAN", - "Hash": "b8bb7aaf248e45bac08ebed86f3a0aa4" + "Hash": "4f2596dfb05dac67b9dc558e5c6fba2e", + "Requirements": [] }, "highr": { "Package": "highr", "Version": "0.8", "Source": "Repository", "Repository": "CRAN", - "Hash": "4dc5bb88961e347a0f4d8aad597cbfac" + "Hash": "4dc5bb88961e347a0f4d8aad597cbfac", + "Requirements": [] }, "hms": { "Package": "hms", - "Version": "0.5.3", + "Version": "1.0.0", "Source": "Repository", "Repository": "CRAN", - "Hash": "726671f634529d470545f9fd1a9d1869" + "Hash": "bf552cdd96f5969873afdac7311c7d0d", + "Requirements": [ + "ellipsis", + "lifecycle", + "pkgconfig", + "rlang", + "vctrs" + ] }, "htmltools": { "Package": "htmltools", - "Version": "0.5.2", + "Version": "0.5.3", "Source": "Repository", "Repository": "CRAN", - "Hash": "526c484233f42522278ab06fb185cb26" + "Hash": "6496090a9e00f8354b811d1a2d47b566", + "Requirements": [ + "base64enc", + "digest", + "fastmap", + "rlang" + ] }, "htmlwidgets": { "Package": "htmlwidgets", - "Version": "1.5.1", + "Version": "1.5.3", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "6fdaa86d0700f8b3e92ee3c445a5a10d", + "Requirements": [ + "htmltools", + "jsonlite", + "yaml" + ] + }, + "httpuv": { + "Package": "httpuv", + "Version": "1.5.5", "Source": "Repository", "Repository": "CRAN", - "Hash": "41bace23583fbc25089edae324de2dc3" + "Hash": "b9d5d39be2150cf86538b8488334b8f8", + "Requirements": [ + "BH", + "R6", + "Rcpp", + "later", + "promises" + ] }, "httr": { "Package": "httr", "Version": "1.4.2", "Source": "Repository", "Repository": "CRAN", - "Hash": "a525aba14184fec243f9eaec62fbed43" + "Hash": "a525aba14184fec243f9eaec62fbed43", + "Requirements": [ + "R6", + "curl", + "jsonlite", + "mime", + "openssl" + ] }, "hunspell": { "Package": "hunspell", - "Version": "3.0", + "Version": "3.0.1", "Source": "Repository", "Repository": "CRAN", - "Hash": "71e7853d60b6b4ba891d62ede21752e9" + "Hash": "3987784c19192ad0f2261c456d936df1", + "Requirements": [ + "Rcpp", + "digest" + ] }, "ini": { "Package": "ini", "Version": "0.3.1", "Source": "Repository", "Repository": "CRAN", - "Hash": "6154ec2223172bce8162d4153cda21f7" + "Hash": "6154ec2223172bce8162d4153cda21f7", + "Requirements": [] }, "jquerylib": { "Package": "jquerylib", "Version": "0.1.4", "Source": "Repository", "Repository": "CRAN", - "Hash": "5aab57a3bd297eee1c1d862735972182" + "Hash": "5aab57a3bd297eee1c1d862735972182", + "Requirements": [ + "htmltools" + ] }, "jsonlite": { "Package": "jsonlite", - "Version": "1.6.1", + "Version": "1.7.2", "Source": "Repository", "Repository": "CRAN", - "Hash": "84b0ee361e2f78d6b7d670db9471c0c5" + "Hash": "98138e0994d41508c7a6b84a0600cfcb", + "Requirements": [] }, "knitr": { "Package": "knitr", - "Version": "1.39", + "Version": "1.40", "Source": "Repository", "Repository": "CRAN", - "Hash": "029ab7c4badd3cf8af69016b2ba27493" + "Hash": "caea8b0f899a0b1738444b9bc47067e7", + "Requirements": [ + "evaluate", + "highr", + "stringr", + "xfun", + "yaml" + ] }, "later": { "Package": "later", - "Version": "1.0.0", + "Version": "1.1.0.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "d0a62b247165aabf397fded504660d8a", + "Requirements": [ + "BH", + "Rcpp", + "rlang" + ] + }, + "lattice": { + "Package": "lattice", + "Version": "0.20-41", "Source": "Repository", "Repository": "CRAN", - "Hash": "6d927978fc658d24175ce37db635f9e5" + "Hash": "fbd9285028b0263d76d18c95ae51a53d", + "Requirements": [] }, "lazyeval": { "Package": "lazyeval", "Version": "0.2.2", "Source": "Repository", "Repository": "CRAN", - "Hash": "d908914ae53b04d4c0c0fd72ecc35370" + "Hash": "d908914ae53b04d4c0c0fd72ecc35370", + "Requirements": [] }, "lifecycle": { "Package": "lifecycle", - "Version": "1.0.1", + "Version": "1.0.3", "Source": "Repository", "Repository": "CRAN", - "Hash": "a6b6d352e3ed897373ab19d8395c98d0" + "Hash": "001cecbeac1cff9301bdc3775ee46a86", + "Requirements": [ + "cli", + "glue", + "rlang" + ] }, "lintr": { "Package": "lintr", "Version": "2.0.1", "Source": "Repository", "Repository": "CRAN", - "Hash": "023cecbdc0a32f86ad3cb1734c018d2e" + "Hash": "023cecbdc0a32f86ad3cb1734c018d2e", + "Requirements": [ + "codetools", + "crayon", + "cyclocomp", + "digest", + "httr", + "jsonlite", + "knitr", + "rex", + "rstudioapi", + "testthat", + "xml2", + "xmlparsedata" + ] }, "lubridate": { "Package": "lubridate", - "Version": "1.7.4", + "Version": "1.7.10", "Source": "Repository", "Repository": "CRAN", - "Hash": "796afeea047cda6bdb308d374a33eeb6" + "Hash": "1ebfdc8a3cfe8fe19184f5481972b092", + "Requirements": [ + "Rcpp", + "generics" + ] }, "magrittr": { "Package": "magrittr", "Version": "2.0.3", "Source": "Repository", "Repository": "CRAN", - "Hash": "7ce2733a9826b3aeb1775d56fd305472" + "Hash": "7ce2733a9826b3aeb1775d56fd305472", + "Requirements": [] + }, + "markdown": { + "Package": "markdown", + "Version": "1.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "61e4a10781dd00d7d81dd06ca9b94e95", + "Requirements": [ + "mime", + "xfun" + ] }, "memoise": { "Package": "memoise", - "Version": "1.1.0", + "Version": "2.0.0", "Source": "Repository", "Repository": "CRAN", - "Hash": "58baa74e4603fcfb9a94401c58c8f9b1" + "Hash": "a0bc51650201a56d00a4798523cc91b3", + "Requirements": [ + "cachem", + "rlang" + ] + }, + "mgcv": { + "Package": "mgcv", + "Version": "1.8-34", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "bd4a6c4b600f58651d60d381b0e9a397", + "Requirements": [ + "Matrix", + "nlme" + ] }, "mime": { "Package": "mime", - "Version": "0.9", + "Version": "0.10", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "26fa77e707223e1ce042b2b5d09993dc", + "Requirements": [] + }, + "miniUI": { + "Package": "miniUI", + "Version": "0.1.1.1", "Source": "Repository", "Repository": "CRAN", - "Hash": "e87a35ec73b157552814869f45a63aa3" + "Hash": "fec5f52652d60615fdb3957b3d74324a", + "Requirements": [ + "htmltools", + "shiny" + ] + }, + "mockery": { + "Package": "mockery", + "Version": "0.4.2", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "313fa6504824ba5aab9308412135fb5f", + "Requirements": [ + "testthat" + ] + }, + "nlme": { + "Package": "nlme", + "Version": "3.1-152", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "35de1ce639f20b5e10f7f46260730c65", + "Requirements": [ + "lattice" + ] + }, + "nnet": { + "Package": "nnet", + "Version": "7.3-15", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "b67ac021b3fb3a4b69d0d3c2bc049e9f", + "Requirements": [] }, "openssl": { "Package": "openssl", - "Version": "1.4.1", + "Version": "2.0.4", "Source": "Repository", "Repository": "CRAN", - "Hash": "49f7258fd86ebeaea1df24d9ded00478" + "Hash": "e86c5ffeb8474a9e03d75f5d2919683e", + "Requirements": [ + "askpass" + ] }, "pillar": { "Package": "pillar", - "Version": "1.4.3", + "Version": "1.5.1", "Source": "Repository", "Repository": "CRAN", - "Hash": "fa3ed60396b6998d0427c57dab90fba4" + "Hash": "24622aa4a0d3de3463c34513edca99b2", + "Requirements": [ + "cli", + "crayon", + "ellipsis", + "fansi", + "lifecycle", + "rlang", + "utf8", + "vctrs" + ] }, "pkgbuild": { "Package": "pkgbuild", - "Version": "1.0.6", + "Version": "1.2.0", "Source": "Repository", "Repository": "CRAN", - "Hash": "899835dfe286963471cbdb9591f8f94f" + "Hash": "725fcc30222d4d11ec68efb8ff11a9af", + "Requirements": [ + "R6", + "callr", + "cli", + "crayon", + "desc", + "prettyunits", + "rprojroot", + "withr" + ] }, "pkgconfig": { "Package": "pkgconfig", "Version": "2.0.3", "Source": "Repository", "Repository": "CRAN", - "Hash": "01f28d4278f15c76cddbea05899c5d6f" + "Hash": "01f28d4278f15c76cddbea05899c5d6f", + "Requirements": [] }, "pkgdown": { "Package": "pkgdown", - "Version": "2.0.3", - "Source": "Repository", - "Repository": "CRAN", - "Hash": "ec3139021900fa27faae7a821b732bf8" + "Version": "2.0.6", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "f958d0b2a5dabc5ffd414f062b1ffbe7", + "Requirements": [ + "bslib", + "callr", + "cli", + "desc", + "digest", + "downlit", + "fs", + "httr", + "jsonlite", + "magrittr", + "memoise", + "purrr", + "ragg", + "rlang", + "rmarkdown", + "tibble", + "whisker", + "withr", + "xml2", + "yaml" + ] }, "pkgload": { "Package": "pkgload", - "Version": "1.0.2", + "Version": "1.2.0", "Source": "Repository", "Repository": "CRAN", - "Hash": "5e655fb54cceead0f095f22d7be33da3" - }, - "plogr": { - "Package": "plogr", - "Version": "0.2.0", - "Source": "Repository", - "Repository": "CRAN", - "Hash": "09eb987710984fc2905c7129c7d85e65" + "Hash": "cb57de933545960a86f03513e4bd2911", + "Requirements": [ + "cli", + "crayon", + "desc", + "pkgbuild", + "rlang", + "rprojroot", + "rstudioapi", + "withr" + ] }, "praise": { "Package": "praise", "Version": "1.0.0", "Source": "Repository", "Repository": "CRAN", - "Hash": "a555924add98c99d2f411e37e7d25e9f" + "Hash": "a555924add98c99d2f411e37e7d25e9f", + "Requirements": [] }, "prettyunits": { "Package": "prettyunits", "Version": "1.1.1", "Source": "Repository", "Repository": "CRAN", - "Hash": "95ef9167b75dde9d2ccc3c7528393e7e" + "Hash": "95ef9167b75dde9d2ccc3c7528393e7e", + "Requirements": [] }, "processx": { "Package": "processx", - "Version": "3.5.2", + "Version": "3.8.0", "Source": "Repository", "Repository": "CRAN", - "Hash": "0cbca2bc4d16525d009c4dbba156b37c" + "Hash": "a33ee2d9bf07564efb888ad98410da84", + "Requirements": [ + "R6", + "ps" + ] }, "progress": { "Package": "progress", "Version": "1.2.2", "Source": "Repository", "Repository": "CRAN", - "Hash": "14dc9f7a3c91ebb14ec5bb9208a07061" + "Hash": "14dc9f7a3c91ebb14ec5bb9208a07061", + "Requirements": [ + "R6", + "crayon", + "hms", + "prettyunits" + ] }, "promises": { "Package": "promises", - "Version": "1.1.0", + "Version": "1.2.0.1", "Source": "Repository", "Repository": "CRAN", - "Hash": "efbbe62da4709f7040a380c702bc7103" + "Hash": "4ab2c43adb4d4699cf3690acd378d75d", + "Requirements": [ + "R6", + "Rcpp", + "later", + "magrittr", + "rlang" + ] }, "ps": { "Package": "ps", "Version": "1.6.0", "Source": "Repository", "Repository": "CRAN", - "Hash": "32620e2001c1dce1af49c49dccbb9420" + "Hash": "32620e2001c1dce1af49c49dccbb9420", + "Requirements": [] }, "purrr": { "Package": "purrr", - "Version": "0.3.3", + "Version": "0.3.4", "Source": "Repository", "Repository": "CRAN", - "Hash": "22aca7d1181718e927d403a8c2d69d62" + "Hash": "97def703420c8ab10d8f0e6c72101e02", + "Requirements": [ + "magrittr", + "rlang" + ] }, "ragg": { "Package": "ragg", - "Version": "1.2.2", + "Version": "1.2.4", "Source": "Repository", "Repository": "CRAN", - "Hash": "14932bb6f2739c771ca4ceaba6b4248e" + "Hash": "0db17bd5a1d4abfec76487b6f5dd957b", + "Requirements": [ + "systemfonts", + "textshaping" + ] }, "rappdirs": { "Package": "rappdirs", "Version": "0.3.3", "Source": "Repository", "Repository": "CRAN", - "Hash": "5e3c5dc0b071b21fa128676560dbe94d" + "Hash": "5e3c5dc0b071b21fa128676560dbe94d", + "Requirements": [] }, "rcmdcheck": { "Package": "rcmdcheck", "Version": "1.3.3", "Source": "Repository", "Repository": "CRAN", - "Hash": "ed95895886dab6d2a584da45503555da" + "Hash": "ed95895886dab6d2a584da45503555da", + "Requirements": [ + "R6", + "callr", + "cli", + "crayon", + "desc", + "digest", + "pkgbuild", + "prettyunits", + "rprojroot", + "sessioninfo", + "withr", + "xopen" + ] }, "readxl": { "Package": "readxl", - "Version": "1.4.0", + "Version": "1.3.1", "Source": "Repository", "Repository": "CRAN", - "Hash": "170c35f745563bb307e963bde0197e4f" + "Hash": "63537c483c2dbec8d9e3183b3735254a", + "Requirements": [ + "Rcpp", + "cellranger", + "progress", + "tibble" + ] }, "rematch": { "Package": "rematch", "Version": "1.0.1", "Source": "Repository", "Repository": "CRAN", - "Hash": "c66b930d20bb6d858cd18e1cebcfae5c" + "Hash": "c66b930d20bb6d858cd18e1cebcfae5c", + "Requirements": [] }, "rematch2": { "Package": "rematch2", - "Version": "2.1.0", + "Version": "2.1.2", "Source": "Repository", "Repository": "CRAN", - "Hash": "a8e6ebbd476d2b8f6557ed3fab3b6139" + "Hash": "76c9e04c712a05848ae7a23d2f170a40", + "Requirements": [ + "tibble" + ] }, "remotes": { "Package": "remotes", - "Version": "2.1.1", + "Version": "2.2.0", "Source": "Repository", "Repository": "CRAN", - "Hash": "57c3009534f805f0f6476ffee68483cc" + "Hash": "430a0908aee75b1fcba0e62857cab0ce", + "Requirements": [] }, "renv": { "Package": "renv", - "Version": "0.13.0", + "Version": "0.16.0", "Source": "Repository", "Repository": "CRAN", - "Hash": "9f10d9db5b50400c348920c5c603385e" + "Hash": "c9e8442ab69bc21c9697ecf856c1e6c7", + "Requirements": [] }, "rex": { "Package": "rex", - "Version": "1.1.2", + "Version": "1.2.0", "Source": "Repository", "Repository": "CRAN", - "Hash": "6d3dbb5d528c8f726861018472bc668c" + "Hash": "093584b944440c5cd07a696b3c8e0e4c", + "Requirements": [ + "lazyeval" + ] }, "rlang": { "Package": "rlang", - "Version": "1.0.2", + "Version": "1.0.6", "Source": "Repository", "Repository": "CRAN", - "Hash": "04884d9a75d778aca22c7154b8333ec9" + "Hash": "4ed1f8336c8d52c3e750adcdc57228a7", + "Requirements": [] }, "rmarkdown": { "Package": "rmarkdown", - "Version": "2.14", - "Source": "Repository", - "Repository": "CRAN", - "Hash": "31b60a882fabfabf6785b8599ffeb8ba" + "Version": "2.17", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "e97c8be593e010f93520e8215c0f9189", + "Requirements": [ + "bslib", + "evaluate", + "htmltools", + "jquerylib", + "jsonlite", + "knitr", + "stringr", + "tinytex", + "xfun", + "yaml" + ] }, "roxygen2": { "Package": "roxygen2", - "Version": "7.2.0", - "Source": "Repository", - "Repository": "CRAN", - "Hash": "b390c1d54fcd977cda48588e6172daba" + "Version": "7.2.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "da1f278262e563c835345872f2fef537", + "Requirements": [ + "R6", + "brew", + "cli", + "commonmark", + "cpp11", + "desc", + "digest", + "knitr", + "pkgload", + "purrr", + "rlang", + "stringi", + "stringr", + "withr", + "xml2" + ] + }, + "rpart": { + "Package": "rpart", + "Version": "4.1-15", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "9787c1fcb680e655d062e7611cadf78e", + "Requirements": [] }, "rprojroot": { "Package": "rprojroot", - "Version": "1.3-2", + "Version": "2.0.2", "Source": "Repository", "Repository": "CRAN", - "Hash": "f6a407ae5dd21f6f80a6708bbb6eb3ae" + "Hash": "249d8cd1e74a8f6a26194a91b47f21d1", + "Requirements": [] }, "rstudioapi": { "Package": "rstudioapi", - "Version": "0.11", + "Version": "0.13", "Source": "Repository", "Repository": "CRAN", - "Hash": "33a5b27a03da82ac4b1d43268f80088a" + "Hash": "06c85365a03fdaf699966cc1d3cf53ea", + "Requirements": [] }, "rversions": { "Package": "rversions", - "Version": "2.0.1", + "Version": "2.0.2", "Source": "Repository", "Repository": "CRAN", - "Hash": "2aa84e83767ba93ee6415b439fa981d2" + "Hash": "0ec41191f744d0f5afad8c6f35cc36e4", + "Requirements": [ + "curl", + "xml2" + ] }, "sass": { "Package": "sass", - "Version": "0.4.1", + "Version": "0.4.2", "Source": "Repository", "Repository": "CRAN", - "Hash": "f37c0028d720bab3c513fd65d28c7234" + "Hash": "1b191143d7d3444d504277843f3a95fe", + "Requirements": [ + "R6", + "fs", + "htmltools", + "rappdirs", + "rlang" + ] }, "sessioninfo": { "Package": "sessioninfo", "Version": "1.1.1", "Source": "Repository", "Repository": "CRAN", - "Hash": "308013098befe37484df72c39cf90d6e" + "Hash": "308013098befe37484df72c39cf90d6e", + "Requirements": [ + "cli", + "withr" + ] + }, + "shiny": { + "Package": "shiny", + "Version": "1.6.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "6e3b6ae7fe02b5859e4bb277f218b8ae", + "Requirements": [ + "R6", + "bslib", + "cachem", + "commonmark", + "crayon", + "digest", + "ellipsis", + "fastmap", + "glue", + "htmltools", + "httpuv", + "jsonlite", + "later", + "lifecycle", + "mime", + "promises", + "rlang", + "sourcetools", + "withr", + "xtable" + ] + }, + "sourcetools": { + "Package": "sourcetools", + "Version": "0.1.7", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "947e4e02a79effa5d512473e10f41797", + "Requirements": [] + }, + "spatial": { + "Package": "spatial", + "Version": "7.3-13", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "8d0918547149f72e78ae942ccd1fdbc7", + "Requirements": [] }, "spelling": { "Package": "spelling", - "Version": "2.1", + "Version": "2.2", "Source": "Repository", "Repository": "CRAN", - "Hash": "b3a5ecc3351f41eb30ef87f65cbff390" + "Hash": "b8c899a5c83f0d897286550481c91798", + "Requirements": [ + "commonmark", + "hunspell", + "knitr", + "xml2" + ] }, "staged.dependencies": { "Package": "staged.dependencies", @@ -698,172 +1306,345 @@ "Source": "GitHub", "RemoteType": "github", "RemoteHost": "api.github.com", - "RemoteUsername": "openpharma", "RemoteRepo": "staged.dependencies", - "RemoteRef": "v0.2.7", + "RemoteUsername": "openpharma", + "RemoteRef": "HEAD", "RemoteSha": "669f45a95d8772899551ad51fc3b38a3b5a1056a", - "Hash": "972f56f7ffa72007c91794e68bfb7d8a" + "Hash": "348648f944ce5dbcbdc2b120c9ba3a3c", + "Requirements": [ + "desc", + "devtools", + "digest", + "dplyr", + "fs", + "git2r", + "glue", + "httr", + "jsonlite", + "rcmdcheck", + "remotes", + "rlang", + "tidyr", + "withr", + "yaml" + ] }, "stringi": { "Package": "stringi", - "Version": "1.4.6", + "Version": "1.5.3", "Source": "Repository", "Repository": "CRAN", - "Hash": "e99d8d656980d2dd416a962ae55aec90" + "Hash": "a063ebea753c92910a4cca7b18bc1f05", + "Requirements": [] }, "stringr": { "Package": "stringr", "Version": "1.4.0", "Source": "Repository", "Repository": "CRAN", - "Hash": "0759e6b6c0957edb1311028a49a35e76" + "Hash": "0759e6b6c0957edb1311028a49a35e76", + "Requirements": [ + "glue", + "magrittr", + "stringi" + ] }, "styler": { "Package": "styler", - "Version": "1.5.1", + "Version": "1.8.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "c855e70eb69b3dd8883660b7110e0c44", + "Requirements": [ + "R.cache", + "cli", + "magrittr", + "purrr", + "rlang", + "rprojroot", + "vctrs", + "withr" + ] + }, + "survival": { + "Package": "survival", + "Version": "3.2-10", "Source": "Repository", "Repository": "CRAN", - "Hash": "eb62a56987abe8fa9d1de47eef53a790" + "Hash": "6b7453cd9bb32b12577c78d54eeea56a", + "Requirements": [ + "Matrix" + ] }, "sys": { "Package": "sys", - "Version": "3.3", + "Version": "3.4", "Source": "Repository", "Repository": "CRAN", - "Hash": "507f3116a38d37ad330a038b3be07b66" + "Hash": "b227d13e29222b4574486cfcbde077fa", + "Requirements": [] }, "systemfonts": { "Package": "systemfonts", "Version": "1.0.4", "Source": "Repository", "Repository": "CRAN", - "Hash": "90b28393209827327de889f49935140a" + "Hash": "90b28393209827327de889f49935140a", + "Requirements": [ + "cpp11" + ] }, "testthat": { "Package": "testthat", - "Version": "3.0.0", - "Source": "Repository", - "Repository": "CRAN", - "Hash": "13298cedd051cb7b8a8972d380b559a6" + "Version": "3.0.2", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "495e0434d9305716b6a87031570ce109", + "Requirements": [ + "R6", + "brio", + "callr", + "cli", + "crayon", + "desc", + "digest", + "ellipsis", + "evaluate", + "jsonlite", + "lifecycle", + "magrittr", + "pkgload", + "praise", + "processx", + "ps", + "rlang", + "waldo", + "withr" + ] }, "textshaping": { "Package": "textshaping", "Version": "0.3.6", "Source": "Repository", "Repository": "CRAN", - "Hash": "1ab6223d3670fac7143202cb6a2d43d5" + "Hash": "1ab6223d3670fac7143202cb6a2d43d5", + "Requirements": [ + "cpp11", + "systemfonts" + ] }, "tibble": { "Package": "tibble", - "Version": "3.0.0", + "Version": "3.1.0", "Source": "Repository", "Repository": "CRAN", - "Hash": "e742bc8d72071ef9aba29f71f132d773" + "Hash": "4d894a114dbd4ecafeda5074e7c538e6", + "Requirements": [ + "ellipsis", + "fansi", + "lifecycle", + "magrittr", + "pillar", + "pkgconfig", + "rlang", + "vctrs" + ] }, "tidyr": { "Package": "tidyr", - "Version": "1.0.2", - "Source": "Repository", - "Repository": "CRAN", - "Hash": "fb73a010ace00d6c584c2b53a21b969c" + "Version": "1.1.3", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "450d7dfaedde58e28586b854eeece4fa", + "Requirements": [ + "cpp11", + "dplyr", + "ellipsis", + "glue", + "lifecycle", + "magrittr", + "purrr", + "rlang", + "tibble", + "tidyselect", + "vctrs" + ] }, "tidyselect": { "Package": "tidyselect", - "Version": "1.0.0", + "Version": "1.1.0", "Source": "Repository", "Repository": "CRAN", - "Hash": "7d4b0f1ab542d8cb7a40c593a4de2f36" + "Hash": "6ea435c354e8448819627cf686f66e0a", + "Requirements": [ + "ellipsis", + "glue", + "purrr", + "rlang", + "vctrs" + ] }, "tinytex": { "Package": "tinytex", - "Version": "0.38", + "Version": "0.42", "Source": "Repository", "Repository": "CRAN", - "Hash": "759d047596ac173433985deddf313450" + "Hash": "7629c6c1540835d5248e6e7df265fa74", + "Requirements": [ + "xfun" + ] }, "usethis": { "Package": "usethis", - "Version": "2.1.5", - "Source": "Repository", - "Repository": "CRAN", - "Hash": "c499f488e6dd7718accffaee5bc5a79b" + "Version": "2.1.6", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "a67a22c201832b12c036cc059f1d137d", + "Requirements": [ + "cli", + "clipr", + "crayon", + "curl", + "desc", + "fs", + "gert", + "gh", + "glue", + "jsonlite", + "lifecycle", + "purrr", + "rappdirs", + "rlang", + "rprojroot", + "rstudioapi", + "whisker", + "withr", + "yaml" + ] }, "utf8": { "Package": "utf8", - "Version": "1.1.4", + "Version": "1.2.1", "Source": "Repository", "Repository": "CRAN", - "Hash": "4a5081acfb7b81a572e4384a7aaf2af1" + "Hash": "c3ad47dc6da0751f18ed53c4613e3ac7", + "Requirements": [] }, "vctrs": { "Package": "vctrs", - "Version": "0.3.8", + "Version": "0.5.0", "Source": "Repository", "Repository": "CRAN", - "Hash": "ecf749a1b39ea72bd9b51b76292261f1" + "Hash": "001fd6a5ebfff8316baf9fb2b5516dc9", + "Requirements": [ + "cli", + "glue", + "lifecycle", + "rlang" + ] + }, + "visNetwork": { + "Package": "visNetwork", + "Version": "2.0.9", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "12545f2acf49d1d346d075580122d89c", + "Requirements": [ + "htmltools", + "htmlwidgets", + "jsonlite", + "magrittr" + ] }, "waldo": { "Package": "waldo", "Version": "0.2.5", "Source": "Repository", "Repository": "CRAN", - "Hash": "20c45f1d511a3f730b7b469f4d11e104" + "Hash": "20c45f1d511a3f730b7b469f4d11e104", + "Requirements": [ + "cli", + "diffobj", + "fansi", + "glue", + "rematch2", + "rlang", + "tibble" + ] }, "whisker": { "Package": "whisker", "Version": "0.4", "Source": "Repository", "Repository": "CRAN", - "Hash": "ca970b96d894e90397ed20637a0c1bbe" + "Hash": "ca970b96d894e90397ed20637a0c1bbe", + "Requirements": [] }, "withr": { "Package": "withr", - "Version": "2.4.3", + "Version": "2.5.0", "Source": "Repository", "Repository": "CRAN", - "Hash": "a376b424c4817cda4920bbbeb3364e85" + "Hash": "c0e49a9760983e81e55cdd9be92e7182", + "Requirements": [] }, "xfun": { "Package": "xfun", - "Version": "0.30", + "Version": "0.34", "Source": "Repository", "Repository": "CRAN", - "Hash": "e83f48136b041845e50a6658feffb197" + "Hash": "9eba2411b0b1f879797141bd24df7407", + "Requirements": [] }, "xml2": { "Package": "xml2", "Version": "1.3.3", "Source": "Repository", "Repository": "CRAN", - "Hash": "40682ed6a969ea5abfd351eb67833adc" + "Hash": "40682ed6a969ea5abfd351eb67833adc", + "Requirements": [] }, "xmlparsedata": { "Package": "xmlparsedata", - "Version": "1.0.3", + "Version": "1.0.5", "Source": "Repository", "Repository": "CRAN", - "Hash": "90d3cba62daa9f1e5313afef106f719d" + "Hash": "45e4bf3c46476896e821fc0a408fb4fc", + "Requirements": [] }, "xopen": { "Package": "xopen", "Version": "1.0.0", "Source": "Repository", "Repository": "CRAN", - "Hash": "6c85f015dee9cc7710ddd20f86881f58" + "Hash": "6c85f015dee9cc7710ddd20f86881f58", + "Requirements": [ + "processx" + ] + }, + "xtable": { + "Package": "xtable", + "Version": "1.8-4", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "b8acdf8af494d9ec19ccb2481a9b11c2", + "Requirements": [] }, "yaml": { "Package": "yaml", "Version": "2.2.1", "Source": "Repository", "Repository": "CRAN", - "Hash": "2826c5d9efb0a88f657c7a679c7106db" + "Hash": "2826c5d9efb0a88f657c7a679c7106db", + "Requirements": [] }, "zip": { "Package": "zip", - "Version": "2.2.0", + "Version": "2.2.2", "Source": "Repository", "Repository": "CRAN", - "Hash": "c7eef2996ac270a18c2715c997a727c5" + "Hash": "c42bfcec3fa6a0cce17ce1f8bc684f88", + "Requirements": [] } } } diff --git a/renv/.gitignore b/renv/.gitignore index 2129631179..6ae4167d45 100644 --- a/renv/.gitignore +++ b/renv/.gitignore @@ -1,3 +1,5 @@ +cellar/ +sandbox/ library/ local/ lock/ diff --git a/renv/activate.R b/renv/activate.R index 2cba08a4cb..c9c3e1bbdb 100644 --- a/renv/activate.R +++ b/renv/activate.R @@ -2,18 +2,50 @@ local({ # the requested version of renv - version <- "0.13.0" + version <- "0.16.0" # the project directory project <- getwd() + # figure out whether the autoloader is enabled + enabled <- local({ + + # first, check config option + override <- getOption("renv.config.autoloader.enabled") + if (!is.null(override)) + return(override) + + # next, check environment variables + # TODO: prefer using the configuration one in the future + envvars <- c( + "RENV_CONFIG_AUTOLOADER_ENABLED", + "RENV_AUTOLOADER_ENABLED", + "RENV_ACTIVATE_PROJECT" + ) + + for (envvar in envvars) { + envval <- Sys.getenv(envvar, unset = NA) + if (!is.na(envval)) + return(tolower(envval) %in% c("true", "t", "1")) + } + + # enable by default + TRUE + + }) + + if (!enabled) + return(FALSE) + # avoid recursion - if (!is.na(Sys.getenv("RENV_R_INITIALIZING", unset = NA))) + if (identical(getOption("renv.autoloader.running"), TRUE)) { + warning("ignoring recursive attempt to run renv autoloader") return(invisible(TRUE)) + } # signal that we're loading renv during R startup - Sys.setenv("RENV_R_INITIALIZING" = "true") - on.exit(Sys.unsetenv("RENV_R_INITIALIZING"), add = TRUE) + options(renv.autoloader.running = TRUE) + on.exit(options(renv.autoloader.running = NULL), add = TRUE) # signal that we've consented to use renv options(renv.consent = TRUE) @@ -22,21 +54,15 @@ local({ # mask 'utils' packages, will come first on the search path library(utils, lib.loc = .Library) - # check to see if renv has already been loaded - if ("renv" %in% loadedNamespaces()) { - - # if renv has already been loaded, and it's the requested version of renv, - # nothing to do - spec <- .getNamespaceInfo(.getNamespace("renv"), "spec") - if (identical(spec[["version"]], version)) - return(invisible(TRUE)) - - # otherwise, unload and attempt to load the correct version of renv + # unload renv if it's already been loaded + if ("renv" %in% loadedNamespaces()) unloadNamespace("renv") - } - # load bootstrap tools + `%||%` <- function(x, y) { + if (is.environment(x) || length(x)) x else y + } + bootstrap <- function(version, library) { # attempt to download renv @@ -62,6 +88,11 @@ local({ if (!is.na(repos)) return(repos) + # check for lockfile repositories + repos <- tryCatch(renv_bootstrap_repos_lockfile(), error = identity) + if (!inherits(repos, "error") && length(repos)) + return(repos) + # if we're testing, re-use the test repositories if (renv_bootstrap_tests_running()) return(getOption("renv.tests.repos")) @@ -70,7 +101,10 @@ local({ repos <- getOption("repos") # ensure @CRAN@ entries are resolved - repos[repos == "@CRAN@"] <- "https://cloud.r-project.org" + repos[repos == "@CRAN@"] <- getOption( + "renv.repos.cran", + "https://cloud.r-project.org" + ) # add in renv.bootstrap.repos if set default <- c(FALLBACK = "https://cloud.r-project.org") @@ -83,6 +117,30 @@ local({ } + renv_bootstrap_repos_lockfile <- function() { + + lockpath <- Sys.getenv("RENV_PATHS_LOCKFILE", unset = "renv.lock") + if (!file.exists(lockpath)) + return(NULL) + + lockfile <- tryCatch(renv_json_read(lockpath), error = identity) + if (inherits(lockfile, "error")) { + warning(lockfile) + return(NULL) + } + + repos <- lockfile$R$Repositories + if (length(repos) == 0) + return(NULL) + + keys <- vapply(repos, `[[`, "Name", FUN.VALUE = character(1)) + vals <- vapply(repos, `[[`, "URL", FUN.VALUE = character(1)) + names(vals) <- keys + + return(vals) + + } + renv_bootstrap_download <- function(version) { # if the renv version number has 4 components, assume it must @@ -90,16 +148,20 @@ local({ nv <- numeric_version(version) components <- unclass(nv)[[1]] - methods <- if (length(components) == 4L) { - list( + # if this appears to be a development version of 'renv', we'll + # try to restore from github + dev <- length(components) == 4L + + # begin collecting different methods for finding renv + methods <- c( + renv_bootstrap_download_tarball, + if (dev) renv_bootstrap_download_github - ) - } else { - list( + else c( renv_bootstrap_download_cran_latest, renv_bootstrap_download_cran_archive ) - } + ) for (method in methods) { path <- tryCatch(method(version), error = identity) @@ -123,88 +185,123 @@ local({ if (fixup) mode <- "w+b" - utils::download.file( + args <- list( url = url, destfile = destfile, mode = mode, quiet = TRUE ) + if ("headers" %in% names(formals(utils::download.file))) + args$headers <- renv_bootstrap_download_custom_headers(url) + + do.call(utils::download.file, args) + } - renv_bootstrap_download_cran_latest <- function(version) { + renv_bootstrap_download_custom_headers <- function(url) { - repos <- renv_bootstrap_download_cran_latest_find(version) + headers <- getOption("renv.download.headers") + if (is.null(headers)) + return(character()) - message("* Downloading renv ", version, " ... ", appendLF = FALSE) + if (!is.function(headers)) + stopf("'renv.download.headers' is not a function") - downloader <- function(type) { + headers <- headers(url) + if (length(headers) == 0L) + return(character()) - tryCatch( - utils::download.packages( - pkgs = "renv", - destdir = tempdir(), - repos = repos, - type = type, - quiet = TRUE - ), - condition = identity - ) + if (is.list(headers)) + headers <- unlist(headers, recursive = FALSE, use.names = TRUE) - } + ok <- + is.character(headers) && + is.character(names(headers)) && + all(nzchar(names(headers))) - # first, try downloading a binary on Windows + macOS if appropriate - binary <- - !identical(.Platform$pkgType, "source") && - !identical(getOption("pkgType"), "source") && - Sys.info()[["sysname"]] %in% c("Darwin", "Windows") + if (!ok) + stop("invocation of 'renv.download.headers' did not return a named character vector") - if (binary) { - info <- downloader(type = "binary") - if (!inherits(info, "condition")) { - message("OK (downloaded binary)") - return(info[1, 2]) - } - } + headers + + } + + renv_bootstrap_download_cran_latest <- function(version) { + + spec <- renv_bootstrap_download_cran_latest_find(version) + type <- spec$type + repos <- spec$repos + + message("* Downloading renv ", version, " ... ", appendLF = FALSE) + + baseurl <- utils::contrib.url(repos = repos, type = type) + ext <- if (identical(type, "source")) + ".tar.gz" + else if (Sys.info()[["sysname"]] == "Windows") + ".zip" + else + ".tgz" + name <- sprintf("renv_%s%s", version, ext) + url <- paste(baseurl, name, sep = "/") + + destfile <- file.path(tempdir(), name) + status <- tryCatch( + renv_bootstrap_download_impl(url, destfile), + condition = identity + ) - # otherwise, try downloading a source tarball - info <- downloader(type = "source") - if (inherits(info, "condition")) { + if (inherits(status, "condition")) { message("FAILED") return(FALSE) } # report success and return - message("OK (downloaded source)") - info[1, 2] + message("OK (downloaded ", type, ")") + destfile } renv_bootstrap_download_cran_latest_find <- function(version) { - all <- renv_bootstrap_repos() + # check whether binaries are supported on this system + binary <- + getOption("renv.bootstrap.binary", default = TRUE) && + !identical(.Platform$pkgType, "source") && + !identical(getOption("pkgType"), "source") && + Sys.info()[["sysname"]] %in% c("Darwin", "Windows") - for (repos in all) { + types <- c(if (binary) "binary", "source") - db <- tryCatch( - as.data.frame( - x = utils::available.packages(repos = repos), - stringsAsFactors = FALSE - ), - error = identity - ) + # iterate over types + repositories + for (type in types) { + for (repos in renv_bootstrap_repos()) { - if (inherits(db, "error")) - next + # retrieve package database + db <- tryCatch( + as.data.frame( + utils::available.packages(type = type, repos = repos), + stringsAsFactors = FALSE + ), + error = identity + ) - entry <- db[db$Package %in% "renv" & db$Version %in% version, ] - if (nrow(entry) == 0) - next + if (inherits(db, "error")) + next - return(repos) + # check for compatible entry + entry <- db[db$Package %in% "renv" & db$Version %in% version, ] + if (nrow(entry) == 0) + next + + # found it; return spec to caller + spec <- list(entry = entry, type = type, repos = repos) + return(spec) + } } + # if we got here, we failed to find renv fmt <- "renv %s is not available from your declared package repositories" stop(sprintf(fmt, version)) @@ -238,6 +335,42 @@ local({ } + renv_bootstrap_download_tarball <- function(version) { + + # if the user has provided the path to a tarball via + # an environment variable, then use it + tarball <- Sys.getenv("RENV_BOOTSTRAP_TARBALL", unset = NA) + if (is.na(tarball)) + return() + + # allow directories + info <- file.info(tarball, extra_cols = FALSE) + if (identical(info$isdir, TRUE)) { + name <- sprintf("renv_%s.tar.gz", version) + tarball <- file.path(tarball, name) + } + + # bail if it doesn't exist + if (!file.exists(tarball)) { + + # let the user know we weren't able to honour their request + fmt <- "* RENV_BOOTSTRAP_TARBALL is set (%s) but does not exist." + msg <- sprintf(fmt, tarball) + warning(msg) + + # bail + return() + + } + + fmt <- "* Bootstrapping with tarball at path '%s'." + msg <- sprintf(fmt, tarball) + message(msg) + + tarball + + } + renv_bootstrap_download_github <- function(version) { enabled <- Sys.getenv("RENV_BOOTSTRAP_FROM_GITHUB", unset = "TRUE") @@ -291,7 +424,13 @@ local({ bin <- R.home("bin") exe <- if (Sys.info()[["sysname"]] == "Windows") "R.exe" else "R" r <- file.path(bin, exe) - args <- c("--vanilla", "CMD", "INSTALL", "-l", shQuote(library), shQuote(tarball)) + + args <- c( + "--vanilla", "CMD", "INSTALL", "--no-multiarch", + "-l", shQuote(path.expand(library)), + shQuote(path.expand(tarball)) + ) + output <- system2(r, args, stdout = TRUE, stderr = TRUE) message("Done!") @@ -484,18 +623,33 @@ local({ renv_bootstrap_library_root <- function(project) { + prefix <- renv_bootstrap_profile_prefix() + path <- Sys.getenv("RENV_PATHS_LIBRARY", unset = NA) if (!is.na(path)) - return(path) + return(paste(c(path, prefix), collapse = "/")) - path <- Sys.getenv("RENV_PATHS_LIBRARY_ROOT", unset = NA) - if (!is.na(path)) { + path <- renv_bootstrap_library_root_impl(project) + if (!is.null(path)) { name <- renv_bootstrap_library_root_name(project) - return(file.path(path, name)) + return(paste(c(path, prefix, name), collapse = "/")) } - prefix <- renv_bootstrap_profile_prefix() - paste(c(project, prefix, "renv/library"), collapse = "/") + renv_bootstrap_paths_renv("library", project = project) + + } + + renv_bootstrap_library_root_impl <- function(project) { + + root <- Sys.getenv("RENV_PATHS_LIBRARY_ROOT", unset = NA) + if (!is.na(root)) + return(root) + + type <- renv_bootstrap_project_type(project) + if (identical(type, "package")) { + userdir <- renv_bootstrap_user_dir() + return(file.path(userdir, "library")) + } } @@ -561,7 +715,7 @@ local({ return(profile) # check for a profile file (nothing to do if it doesn't exist) - path <- file.path(project, "renv/local/profile") + path <- renv_bootstrap_paths_renv("profile", profile = FALSE, project = project) if (!file.exists(path)) return(NULL) @@ -572,7 +726,7 @@ local({ # set RENV_PROFILE profile <- contents[[1L]] - if (nzchar(profile)) + if (!profile %in% c("", "default")) Sys.setenv(RENV_PROFILE = profile) profile @@ -582,7 +736,7 @@ local({ renv_bootstrap_profile_prefix <- function() { profile <- renv_bootstrap_profile_get() if (!is.null(profile)) - return(file.path("renv/profiles", profile)) + return(file.path("profiles", profile, "renv")) } renv_bootstrap_profile_get <- function() { @@ -606,6 +760,193 @@ local({ profile } + + renv_bootstrap_path_absolute <- function(path) { + + substr(path, 1L, 1L) %in% c("~", "/", "\\") || ( + substr(path, 1L, 1L) %in% c(letters, LETTERS) && + substr(path, 2L, 3L) %in% c(":/", ":\\") + ) + + } + + renv_bootstrap_paths_renv <- function(..., profile = TRUE, project = NULL) { + renv <- Sys.getenv("RENV_PATHS_RENV", unset = "renv") + root <- if (renv_bootstrap_path_absolute(renv)) NULL else project + prefix <- if (profile) renv_bootstrap_profile_prefix() + components <- c(root, renv, prefix, ...) + paste(components, collapse = "/") + } + + renv_bootstrap_project_type <- function(path) { + + descpath <- file.path(path, "DESCRIPTION") + if (!file.exists(descpath)) + return("unknown") + + desc <- tryCatch( + read.dcf(descpath, all = TRUE), + error = identity + ) + + if (inherits(desc, "error")) + return("unknown") + + type <- desc$Type + if (!is.null(type)) + return(tolower(type)) + + package <- desc$Package + if (!is.null(package)) + return("package") + + "unknown" + + } + + renv_bootstrap_user_dir <- function() { + dir <- renv_bootstrap_user_dir_impl() + path.expand(chartr("\\", "/", dir)) + } + + renv_bootstrap_user_dir_impl <- function() { + + # use local override if set + override <- getOption("renv.userdir.override") + if (!is.null(override)) + return(override) + + # use R_user_dir if available + tools <- asNamespace("tools") + if (is.function(tools$R_user_dir)) + return(tools$R_user_dir("renv", "cache")) + + # try using our own backfill for older versions of R + envvars <- c("R_USER_CACHE_DIR", "XDG_CACHE_HOME") + for (envvar in envvars) { + root <- Sys.getenv(envvar, unset = NA) + if (!is.na(root)) + return(file.path(root, "R/renv")) + } + + # use platform-specific default fallbacks + if (Sys.info()[["sysname"]] == "Windows") + file.path(Sys.getenv("LOCALAPPDATA"), "R/cache/R/renv") + else if (Sys.info()[["sysname"]] == "Darwin") + "~/Library/Caches/org.R-project.R/R/renv" + else + "~/.cache/R/renv" + + } + + + renv_json_read <- function(file = NULL, text = NULL) { + + # if jsonlite is loaded, use that instead + if ("jsonlite" %in% loadedNamespaces()) + renv_json_read_jsonlite(file, text) + else + renv_json_read_default(file, text) + + } + + renv_json_read_jsonlite <- function(file = NULL, text = NULL) { + text <- paste(text %||% read(file), collapse = "\n") + jsonlite::fromJSON(txt = text, simplifyVector = FALSE) + } + + renv_json_read_default <- function(file = NULL, text = NULL) { + + # find strings in the JSON + text <- paste(text %||% read(file), collapse = "\n") + pattern <- '["](?:(?:\\\\.)|(?:[^"\\\\]))*?["]' + locs <- gregexpr(pattern, text, perl = TRUE)[[1]] + + # if any are found, replace them with placeholders + replaced <- text + strings <- character() + replacements <- character() + + if (!identical(c(locs), -1L)) { + + # get the string values + starts <- locs + ends <- locs + attr(locs, "match.length") - 1L + strings <- substring(text, starts, ends) + + # only keep those requiring escaping + strings <- grep("[[\\]{}:]", strings, perl = TRUE, value = TRUE) + + # compute replacements + replacements <- sprintf('"\032%i\032"', seq_along(strings)) + + # replace the strings + mapply(function(string, replacement) { + replaced <<- sub(string, replacement, replaced, fixed = TRUE) + }, strings, replacements) + + } + + # transform the JSON into something the R parser understands + transformed <- replaced + transformed <- gsub("{}", "`names<-`(list(), character())", transformed, fixed = TRUE) + transformed <- gsub("[[{]", "list(", transformed, perl = TRUE) + transformed <- gsub("[]}]", ")", transformed, perl = TRUE) + transformed <- gsub(":", "=", transformed, fixed = TRUE) + text <- paste(transformed, collapse = "\n") + + # parse it + json <- parse(text = text, keep.source = FALSE, srcfile = NULL)[[1L]] + + # construct map between source strings, replaced strings + map <- as.character(parse(text = strings)) + names(map) <- as.character(parse(text = replacements)) + + # convert to list + map <- as.list(map) + + # remap strings in object + remapped <- renv_json_remap(json, map) + + # evaluate + eval(remapped, envir = baseenv()) + + } + + renv_json_remap <- function(json, map) { + + # fix names + if (!is.null(names(json))) { + lhs <- match(names(json), names(map), nomatch = 0L) + rhs <- match(names(map), names(json), nomatch = 0L) + names(json)[rhs] <- map[lhs] + } + + # fix values + if (is.character(json)) + return(map[[json]] %||% json) + + # handle true, false, null + if (is.name(json)) { + text <- as.character(json) + if (text == "true") + return(TRUE) + else if (text == "false") + return(FALSE) + else if (text == "null") + return(NULL) + } + + # recurse + if (is.recursive(json)) { + for (i in seq_along(json)) { + json[i] <- list(renv_json_remap(json[[i]], map)) + } + } + + json + + } # load the renv profile, if any renv_bootstrap_profile_load(project) @@ -650,4 +991,4 @@ local({ warning(paste(msg, collapse = "\n"), call. = FALSE) -}) +}) \ No newline at end of file diff --git a/tests/testthat/test-admiral_options.R b/tests/testthat/test-admiral_options.R new file mode 100644 index 0000000000..00f3564bf9 --- /dev/null +++ b/tests/testthat/test-admiral_options.R @@ -0,0 +1,30 @@ +# get_admiral_option ---- +## Test 1: get works ---- +test_that("get_admiral_option Test 1: get works", { + expect_equal(get_admiral_option("subject_keys"), vars(STUDYID, USUBJID)) +}) + +## Test 2: common typo gives error to select available options ---- +test_that("get_admiral_option Test 2: common typo gives error to select available options", { + expect_error(get_admiral_option("subject_key")) +}) + +## Test 3: non-character argument triggers assertion error ---- +test_that("get_admiral_option Test 3: non-character argument triggers assertion error", { + subject_keys <- 1 + expect_error(get_admiral_option(subject_keys), "`option` must be a character scalar but is `1`") +}) + +# set_admiral_options ---- +## Test 4: set works ---- +test_that("set_admiral_options Test 4: set works", { + set_admiral_options(subject_keys = vars(STUDYID, USUBJID2)) + expect_equal(get_admiral_option("subject_keys"), vars(STUDYID, USUBJID2)) +}) + +## Test 5: unexpected function input for set gives error ---- +test_that("set_admiral_options Test 5: unexpected function input for set gives error", { + expect_error(set_admiral_options(subject_keys = quo_c(STUDYID, USUBJID2))) + expect_error(set_admiral_options(subject_keys = STUDYID)) +}) +set_admiral_options(subject_keys = vars(STUDYID, USUBJID)) diff --git a/tests/testthat/test-call_derivation.R b/tests/testthat/test-call_derivation.R index ca05ec51ef..d3852fbf87 100644 --- a/tests/testthat/test-call_derivation.R +++ b/tests/testthat/test-call_derivation.R @@ -1,9 +1,7 @@ -library(admiral.test) -data(admiral_ae) -data(admiral_vs) - -test_that("call_derivation works", { - input <- admiral_vs[sample(seq_len(nrow(admiral_vs)), 1000), ] +## Test 1: Test that call_derivation generates expected summary ---- +# ---- call_derivation Test 1: Test that call_derivation generates expected summary ---- +test_that("call_derivation Test 1: Test that call_derivation generates expected summary", { + input <- admiral.test::admiral_vs[sample(seq_len(nrow(admiral.test::admiral_vs)), 1000), ] expected_output <- input %>% derive_summary_records( @@ -57,8 +55,10 @@ test_that("call_derivation works", { ) }) -test_that("call_derivation works", { - input <- admiral_ae[sample(seq_len(nrow(admiral_ae)), 1000), ] %>% +## Test 2: Test that call_derivation generates expected imputation ---- +# ---- call_derivation Test 2: Test that call_derivation generates expected imputation ---- +test_that("call_derivation Test 2: Test that call_derivation generates expected imputation", { + input <- admiral.test::admiral_ae[sample(seq_len(nrow(admiral.test::admiral_ae)), 1000), ] %>% left_join(admiral_adsl, by = "USUBJID") expected_output <- input %>% @@ -91,9 +91,10 @@ test_that("call_derivation works", { expect_dfs_equal(expected_output, actual_output, keys = c("USUBJID", "AESEQ")) }) - -test_that("call_derivation - Error is thrown if ... has no arguments", { - input <- admiral_ae[sample(seq_len(nrow(admiral_ae)), 1000), ] %>% +## Test 3: Test that Error is thrown if ... has no arguments ---- +# ---- call_derivation Test 3: Test that Error is thrown if ... has no arguments ---- +test_that("call_derivation Test 3: Test that Error is thrown if ... has no arguments", { + input <- admiral.test::admiral_ae[sample(seq_len(nrow(admiral.test::admiral_ae)), 1000), ] %>% left_join(admiral_adsl, by = "USUBJID") expect_error( @@ -108,8 +109,10 @@ test_that("call_derivation - Error is thrown if ... has no arguments", { ) }) -test_that("call_derivation - Error is thrown if ... arguments are not properly named", { - input <- admiral_ae[sample(seq_len(nrow(admiral_ae)), 1000), ] %>% +## Test 4: Error is thrown if ... arguments are not properly named ---- +# ---- call_derivation Test 4: Error is thrown if ... arguments are not properly named ---- +test_that("call_derivation Test 4: Error is thrown if ... arguments are not properly named", { + input <- admiral.test::admiral_ae[sample(seq_len(nrow(admiral.test::admiral_ae)), 1000), ] %>% left_join(admiral_adsl, by = "USUBJID") expect_error( @@ -126,8 +129,10 @@ test_that("call_derivation - Error is thrown if ... arguments are not properly n ) }) -test_that("call_derivation - Error is thrown params is empty", { - input <- admiral_ae[sample(seq_len(nrow(admiral_ae)), 1000), ] %>% +## Test 5: Error is thrown params is empty ---- +# ---- call_derivation Test 5: Error is thrown params is empty ---- +test_that("call_derivation Test 5: Error is thrown params is empty", { + input <- admiral.test::admiral_ae[sample(seq_len(nrow(admiral.test::admiral_ae)), 1000), ] %>% left_join(admiral_adsl, by = "USUBJID") expect_error( @@ -144,8 +149,10 @@ test_that("call_derivation - Error is thrown params is empty", { ) }) -test_that("call_derivation - Error is thrown if passed params are not proprely named", { - input <- admiral_ae[sample(seq_len(nrow(admiral_ae)), 1000), ] %>% +## Test 6: Error is thrown if passed params are not properly named ---- +# ---- call_derivation Test 6: Error is thrown if passed params are not properly named ---- +test_that("call_derivation Test 6: Error is thrown if passed params are not properly named", { + input <- admiral.test::admiral_ae[sample(seq_len(nrow(admiral.test::admiral_ae)), 1000), ] %>% left_join(admiral_adsl, by = "USUBJID") expect_error( @@ -163,8 +170,10 @@ test_that("call_derivation - Error is thrown if passed params are not proprely n ) }) -test_that("call_derivation - Error is thrown if `...` arguments are not properly named", { - input <- admiral_ae[sample(seq_len(nrow(admiral_ae)), 1000), ] %>% +## Test 7: Error is thrown if `...` arguments are not properly named ---- +# ---- call_derivation Test 7: Error is thrown if `...` arguments are not properly named ---- +test_that("call_derivation Test 7: Error is thrown if `...` arguments are not properly named", { + input <- admiral.test::admiral_ae[sample(seq_len(nrow(admiral.test::admiral_ae)), 1000), ] %>% left_join(admiral_adsl, by = "USUBJID") expect_error( @@ -180,3 +189,13 @@ test_that("call_derivation - Error is thrown if `...` arguments are not properly ) ) }) + +## Test 8: Error is thrown if duplicate parameters ---- +# ---- call_derivation Test 8: Error is thrown if duplicate parameters ---- +test_that("call_derivation Test 8: Error is thrown if duplicate parameters", { + expect_error( + params(dtc = VSDTC, dtc = VSDTC, new_vars_prefix = "A"), + "The following parameters have been specified more than once: `dtc`", + fixed = TRUE + ) +}) diff --git a/tests/testthat/test-create_query_data.R b/tests/testthat/test-create_query_data.R index 325fd018c7..c2112afa90 100644 --- a/tests/testthat/test-create_query_data.R +++ b/tests/testthat/test-create_query_data.R @@ -1,19 +1,19 @@ -get_smq <- function(smq_select, +get_smq <- function(basket_select, version, keep_id = FALSE, temp_env) { - if (smq_select$scope == "NARROW") { + if (basket_select$scope == "NARROW") { end <- 3 } else { end <- 5 } - if (is.null(smq_select$name)) { - smq_select$name <- paste("SMQ name of", smq_select$id) + if (is.null(basket_select$name)) { + basket_select$name <- paste("SMQ name of", basket_select$id) } - terms <- tibble(TERM_NAME = paste(smq_select$name, "Term", c(1:end), "(", version, ")")) - terms <- mutate(terms, TERM_LEVEL = "AEDECOD", QUERY_NAME = smq_select$name) + terms <- tibble(TERM_NAME = paste(basket_select$name, "Term", c(1:end), "(", version, ")")) + terms <- mutate(terms, TERM_LEVEL = "AEDECOD", QUERY_NAME = basket_select$name) if (keep_id) { mutate(terms, QUERY_ID = 42) } else { @@ -21,12 +21,12 @@ get_smq <- function(smq_select, } } -get_sdg <- function(sdg_select, +get_sdg <- function(basket_select, version, keep_id = FALSE, temp_env) { - terms <- tibble(TERM_NAME = paste(sdg_select$name, "Term", c(1:4))) - terms <- mutate(terms, TERM_LEVEL = "CMDECOD", QUERY_NAME = sdg_select$name) + terms <- tibble(TERM_NAME = paste(basket_select$name, "Term", c(1:4))) + terms <- mutate(terms, TERM_LEVEL = "CMDECOD", QUERY_NAME = basket_select$name) if (keep_id) { mutate(terms, QUERY_ID = 42) } else { @@ -40,9 +40,10 @@ cqterms <- tibble::tribble( "APPLICATION SITE PRURITUS", 10003053L ) %>% mutate(TERM_LEVEL = "AEDECOD") - +# create_query_data ---- # customized query defined by terms ---- -test_that("customized query defined by terms", { +## Test 1: customized query defined by terms ---- +test_that("create_query_data Test 1: customized query defined by terms", { cq <- query( prefix = "CQ01", name = "Application Site Issues", @@ -64,46 +65,54 @@ test_that("customized query defined by terms", { }) # customized query defined by SMQs ---- -test_that("customized query defined by SMQs", { +## Test 2: customized query defined by SMQs ---- +test_that("create_query_data Test 2: customized query defined by SMQs", { cq <- query( prefix = "CQ02", name = "Immune-Mediated Meningoencephalitis", definition = list( - smq_select( + basket_select( name = "Noninfectious meningitis", - scope = "NARROW" + scope = "NARROW", + type = "smq" ), - smq_select( + basket_select( name = "Noninfectious encephalitis", - scope = "BROAD" + scope = "BROAD", + type = "smq" ) ) ) actual_output <- create_query_data( queries = list(cq), - meddra_version = "20.0", - get_smq_fun = get_smq + version = "20.0", + get_terms_fun = get_smq ) expected_output <- bind_rows( - get_smq(smq_select( - name = "Noninfectious meningitis", - scope = "NARROW" - ), - version = "20.0" - ), - get_smq(smq_select( - name = "Noninfectious encephalitis", - scope = "BROAD" + get_smq( + basket_select( + name = "Noninfectious meningitis", + scope = "NARROW", + type = "smq" + ), + version = "20.0" ), - version = "20.0" + get_smq( + basket_select( + name = "Noninfectious encephalitis", + scope = "BROAD", + type = "smq" + ), + version = "20.0" ) ) %>% mutate( QUERY_NAME = "Immune-Mediated Meningoencephalitis", - VAR_PREFIX = "CQ02" + VAR_PREFIX = "CQ02", + VERSION = "20.0" ) expect_dfs_equal( @@ -113,48 +122,56 @@ test_that("customized query defined by SMQs", { ) }) -test_that("customized query defined by terms and SMQs", { +## Test 3: customized query defined by terms and SMQs ---- +test_that("create_query_data Test 3: customized query defined by terms and SMQs", { cq <- query( prefix = "CQ03", name = "Immune-Mediated Meningoencephalitis or Application Site Issues", definition = list( - smq_select( + basket_select( name = "Noninfectious meningitis", - scope = "NARROW" + scope = "NARROW", + type = "smq" ), cqterms, - smq_select( + basket_select( name = "Noninfectious encephalitis", - scope = "BROAD" + scope = "BROAD", + type = "smq" ) ) ) actual_output <- create_query_data( queries = list(cq), - meddra_version = "20.1", - get_smq_fun = get_smq + version = "20.1", + get_terms_fun = get_smq ) expected_output <- bind_rows( - get_smq(smq_select( - name = "Noninfectious meningitis", - scope = "NARROW" - ), - version = "20.1" + get_smq( + basket_select( + name = "Noninfectious meningitis", + scope = "NARROW", + type = "smq" + ), + version = "20.1" ), cqterms, - get_smq(smq_select( - name = "Noninfectious encephalitis", - scope = "BROAD" - ), - version = "20.1" + get_smq( + basket_select( + name = "Noninfectious encephalitis", + scope = "BROAD", + type = "smq" + ), + version = "20.1" ) ) %>% mutate( QUERY_NAME = "Immune-Mediated Meningoencephalitis or Application Site Issues", - VAR_PREFIX = "CQ03" + VAR_PREFIX = "CQ03", + VERSION = "20.1" ) expect_dfs_equal( @@ -165,38 +182,42 @@ test_that("customized query defined by terms and SMQs", { }) # SMQs ---- -test_that("SMQs", { +## Test 4: SMQs ---- +test_that("SMQs Test 4: SMQs", { pregsmq <- query( prefix = "SMQ02", id = 13, add_scope_num = TRUE, - definition = smq_select( + definition = basket_select( name = "Pregnancy and neonatal topics (SMQ)", - scope = "NARROW" + scope = "NARROW", + type = "smq" ) ) pneuaegt <- query( prefix = "SMQ04", - definition = smq_select( + definition = basket_select( id = 8050L, - scope = "BROAD" + scope = "BROAD", + type = "smq" ) ) actual_output <- create_query_data( queries = list(pregsmq, pneuaegt), - meddra_version = "20.0", - get_smq_fun = get_smq + version = "20.0", + get_terms_fun = get_smq ) expected_output <- bind_rows( get_smq( - smq_select( + basket_select( name = "Pregnancy and neonatal topics (SMQ)", - scope = "NARROW" + scope = "NARROW", + type = "smq" ), version = "20.0" ) %>% @@ -207,16 +228,21 @@ test_that("SMQs", { QUERY_SCOPE_NUM = 2, VAR_PREFIX = "SMQ02" ), - get_smq(smq_select( - id = 8050L, - scope = "BROAD" - ), - version = "20.0" + get_smq( + basket_select( + id = 8050L, + scope = "BROAD", + type = "smq" + ), + version = "20.0" ) %>% mutate( QUERY_SCOPE = "BROAD", VAR_PREFIX = "SMQ04" ) + ) %>% + mutate( + VERSION = "20.0" ) expect_dfs_equal( @@ -226,65 +252,60 @@ test_that("SMQs", { ) }) -# issues error if SMQs without get_smq_fun are requested ---- -test_that("issues error if SMQs without get_smq_fun are requested", { - pregsmq <- query( - prefix = "SMQ02", - definition = smq_select( - name = "Pregnancy and neonatal topics (SMQ)", - scope = "NARROW" - ) - ) - - expect_error( - create_query_data( - queries = list(pregsmq), - meddra_version = "20.0" - ), - regexp = "^get_smq_fun is not specified. This is expected for SMQs.*" - ) -}) - # issues error if SMQs without meddra_version are requested ---- -test_that("issues error if SMQs without meddra_version are requested", { +## Test 5: issues error if SMQs without meddra_version are requested ---- +test_that("SMQs Test 5: issues error if SMQs without meddra_version are requested", { pregsmq <- query( prefix = "SMQ02", - definition = smq_select( + definition = basket_select( name = "Pregnancy and neonatal topics (SMQ)", - scope = "NARROW" + scope = "NARROW", + type = "smq" ) ) expect_error( create_query_data( queries = list(pregsmq), - get_smq_fun = get_smq + get_terms_fun = get_smq ), - regexp = "^meddra_version is not specified. This is expected for SMQs.*" + regexp = "^version is not specified. This is expected for baskets.*" ) }) # SDGs ---- -test_that("SDGs", { +## Test 6: SDGs ---- +test_that("SDGs Test 6: SDGs", { sdg <- query( prefix = "SDG01", id = auto, - definition = sdg_select(name = "5-aminosalicylates for ulcerative colitis") + definition = basket_select( + name = "5-aminosalicylates for ulcerative colitis", + scope = NA_character_, + type = "sdg" + ) ) actual_output <- create_query_data( queries = list(sdg), - whodd_version = "2019_09", - get_sdg_fun = get_sdg + version = "2019_09", + get_terms_fun = get_sdg ) expected_output <- - get_sdg(sdg_select(name = "5-aminosalicylates for ulcerative colitis"), + get_sdg( + basket_select( + name = "5-aminosalicylates for ulcerative colitis", + scope = NA_character_, + type = "sdg" + ), version = "2019_09" ) %>% mutate( QUERY_ID = 42, - VAR_PREFIX = "SDG01" + VAR_PREFIX = "SDG01", + QUERY_SCOPE = NA_character_, + VERSION = "2019_09" ) expect_dfs_equal( @@ -293,64 +314,44 @@ test_that("SDGs", { keys = c("VAR_PREFIX", "TERM_NAME") ) }) -# issues error if SDGs without get_sdg_fun are requested ---- -test_that("issues error if SDGs without get_sdg_fun are requested", { - sdg <- query( - prefix = "SDG01", - definition = sdg_select(name = "5-aminosalicylates for ulcerative colitis") - ) - - expect_error( - create_query_data( - queries = list(sdg), - whodd_version = "2019_09" - ), - regexp = "^get_sdg_fun is not specified. This is expected for SDGs.*" - ) -}) # issues error if SDGs without meddra_version are requested ---- -test_that("issues error if SDGs without meddra_version are requested", { +## Test 7: issues error if SDGs without meddra_version are requested ---- +test_that("SDGs Test 7: issues error if SDGs without meddra_version are requested", { sdg <- query( prefix = "SDG01", - definition = sdg_select(name = "5-aminosalicylates for ulcerative colitis") + definition = basket_select( + name = "5-aminosalicylates for ulcerative colitis", + scope = NA_character_, + type = "sdg" + ) ) expect_error( create_query_data( queries = list(sdg), - get_sdg_fun = get_sdg + get_terms_fun = get_sdg ), - regexp = "^whodd_version is not specified. This is expected for SDGs.*" - ) -}) - -# query: error: add_scope_num = TRUE for non SMQs ---- -test_that("query: error: add_scope_num = TRUE for non SMQs", { - expect_error( - sdg <- query( - prefix = "SDG01", - add_scope_num = TRUE, - definition = sdg_select(name = "5-aminosalicylates for ulcerative colitis") - ), - regexp = "`add_scope_num == TRUE` must be used for SMQs only.", - fixed = TRUE + regexp = "^version is not specified. This is expected for baskets.*" ) }) +# query() ---- # query: error: name = auto for non SMQs/SDGs ---- -test_that("query: error: name = auto for non SMQs/SDGs", { +## Test 8: query: error: name = auto for non SMQs/SDGs ---- +test_that("SDGs Test 8: query: error: name = auto for non SMQs/SDGs", { expect_error( sdg <- query( prefix = "CQ01", definition = cqterms ), - regexp = "^The auto keyword can be used for SMQs and SDGs only.*" + regexp = "^The auto keyword can be used for baskets only.*" ) }) # query: error: name = id for non SMQs/SDGs ---- -test_that("query: error: name = id for non SMQs/SDGs", { +## Test 9: query: error: name = id for non SMQs/SDGs ---- +test_that("SDGs Test 9: query: error: name = id for non SMQs/SDGs", { expect_error( sdg <- query( name = "My CQ", @@ -358,28 +359,13 @@ test_that("query: error: name = id for non SMQs/SDGs", { prefix = "CQ01", definition = cqterms ), - regexp = "^The auto keyword can be used for SMQs and SDGs only.*" - ) -}) - -# query: error: definition is list with non dataframe or smq_select elements ---- -test_that("query: error: definition is list with non dataframe or smq_select elements", { - expect_error( - sdg <- query( - name = "My CQ", - prefix = "CQ01", - definition = list(sdg_select(name = "5-aminosalicylates for ulcerative colitis")) - ), - regexp = - paste0( - "^Each element of the list in the definition field must be a data frame or", - " an object of class `smq_select` but the following are not:.*" - ) + regexp = "^The auto keyword can be used for baskets only.*" ) }) # query: error: invalid definition ---- -test_that("query: error: invalid definition", { +## Test 10: query: error: invalid definition ---- +test_that("SDGs Test 10: query: error: invalid definition", { expect_error( sdg <- query( name = "My CQ", @@ -388,14 +374,16 @@ test_that("query: error: invalid definition", { ), regexp = paste0( - "^`definition` expects a `smq_select` or `sdg_select` object,", - " a data frame, or a list of data frames and `smq_select` objects.*" + "^`definition` expects a `basket_select` object,", + " a data frame, or a list of data frames and `basket_select` objects*" ) ) }) +# assert_terms ---- # assert_terms: error: TERM_LEVEL missing ---- -test_that("assert_terms: error: TERM_LEVEL missing", { +## Test 11: assert_terms: error: TERM_LEVEL missing ---- +test_that("assert_terms Test 11: assert_terms: error: TERM_LEVEL missing", { expect_error( assert_terms( terms = select(cqterms, -TERM_LEVEL), @@ -407,7 +395,8 @@ test_that("assert_terms: error: TERM_LEVEL missing", { }) # assert_terms: error: TERM_NAME and TERM_ID missing ---- -test_that("assert_terms: error: TERM_NAME and TERM_ID missing", { +## Test 12: assert_terms: error: TERM_NAME and TERM_ID missing ---- +test_that("assert_terms Test 12: assert_terms: error: TERM_NAME and TERM_ID missing", { expect_error( assert_terms( terms = select(cqterms, TERM_LEVEL), @@ -422,7 +411,8 @@ test_that("assert_terms: error: TERM_NAME and TERM_ID missing", { }) # assert_terms: error: no data frame ---- -test_that("assert_terms: error: no data frame", { +## Test 13: assert_terms: error: no data frame ---- +test_that("assert_terms Test 13: assert_terms: error: no data frame", { expect_error( assert_terms( terms = 42, @@ -434,7 +424,8 @@ test_that("assert_terms: error: no data frame", { }) # assert_terms: error: no observations ---- -test_that("assert_terms: error: no observations", { +## Test 14: assert_terms: error: no observations ---- +test_that("assert_terms Test 14: assert_terms: error: no observations", { expect_error( assert_terms( terms = filter(cqterms, TERM_ID == 42), @@ -446,7 +437,8 @@ test_that("assert_terms: error: no observations", { }) # assert_terms: error: QUERY_NAME is missing ---- -test_that("assert_terms: error: QUERY_NAME is missing", { +## Test 15: assert_terms: error: QUERY_NAME is missing ---- +test_that("assert_terms Test 15: assert_terms: error: QUERY_NAME is missing", { expect_error( assert_terms( terms = cqterms, @@ -459,7 +451,8 @@ test_that("assert_terms: error: QUERY_NAME is missing", { }) # assert_terms: error: QUERY_ID is missing ---- -test_that("assert_terms: error: QUERY_ID is missing", { +## Test 16: assert_terms: error: QUERY_ID is missing ---- +test_that("assert_terms Test 16: assert_terms: error: QUERY_ID is missing", { expect_error( assert_terms( terms = cqterms, @@ -471,64 +464,86 @@ test_that("assert_terms: error: QUERY_ID is missing", { ) }) -# smq_select: error: name and id specified ---- -test_that("smq_select: error: name and id specified", { +# basket_select ---- +# basket_select: error: name and id specified ---- +## Test 17: basket_select: error: name and id specified ---- +test_that("basket_select Test 17: basket_select: error: name and id specified", { expect_error( - smq_select( + basket_select( name = "My SMQ", id = 42, - scope = "NARROW" + scope = "NARROW", + type = "smq" ), regexp = "Either id or name has to be null.", fixed = TRUE ) }) -# smq_select: error: neither name nor id specified ---- -test_that("smq_select: error: neither name nor id specified", { +# basket_select: error: neither name nor id specified ---- +## Test 18: basket_select: error: neither name nor id specified ---- +test_that("basket_select Test 18: basket_select: error: neither name nor id specified", { expect_error( - smq_select(scope = "NARROW"), + basket_select(scope = "NARROW", type = "smq"), regexp = "Either id or name has to be non null.", fixed = TRUE ) }) -# sdg_select: error: name and id specified ---- -test_that("sdg_select: error: name and id specified", { +# basket_select: error: name and id specified ---- +## Test 19: basket_select: error: name and id specified ---- +test_that("basket_select Test 19: basket_select: error: name and id specified", { expect_error( - sdg_select( + basket_select( name = "My SDG", - id = 42 + id = 42, + scope = NA_character_, + type = "sdg" ), regexp = "Either id or name has to be null.", fixed = TRUE ) }) -# format.smq_select: formatting is correct ---- -test_that("format.smq_select: formatting is correct", { +# format.basket_select: formatting is correct ---- +## Test 20: format.basket_select: formatting is correct ---- +test_that("basket_select Test 20: format.basket_select: formatting is correct", { expect_equal( - format(smq_select( + format(basket_select( id = 42, - scope = "NARROW" + scope = "NARROW", + type = "smq" )), - "smq_select(name = NULL, id = 42, scope = \"NARROW\")" + "basket_select(name = NULL, id = 42, scope = \"NARROW\", type = \"smq\")" ) }) -# sdg_select: error: neither name nor id specified ---- -test_that("sdg_select: error: neither name nor id specified", { +# basket_select: error: neither name nor id specified ---- +## Test 21: basket_select: error: neither name nor id specified ---- +test_that("basket_select Test 21: basket_select: error: neither name nor id specified", { expect_error( - sdg_select(), + basket_select(type = "sdg", scope = NA_character_), regexp = "Either id or name has to be non null.", fixed = TRUE ) }) -# format.sdg_select: formatting is correct ---- -test_that("format.sdg_select: formatting is correct", { +# basket_select: error: type is not specified ---- +## Test 22: basket_select: error: type is not specified ---- +test_that("basket_select Test 22: basket_select: error: type is not specified", { + expect_error( + basket_select(id = 42, scope = "NARROW"), + regexp = "argument \"type\" is missing, with no default", + fixed = TRUE + ) +}) + +# format.basket_select ---- +# format.basket_select: formatting is correct ---- +## Test 23: format.basket_select: formatting is correct ---- +test_that("format.basket_select Test 23: format.basket_select: formatting is correct", { expect_equal( - format(sdg_select(name = "My SDG")), - "sdg_select(name = \"My SDG\", id = NULL)" + format(basket_select(name = "My SDG", type = "sdg", scope = NA_character_)), + "basket_select(name = \"My SDG\", id = NULL, scope = \"NA\", type = \"sdg\")" ) }) diff --git a/tests/testthat/test-create_single_dose_dataset.R b/tests/testthat/test-create_single_dose_dataset.R index 09f622b334..ec671b2492 100644 --- a/tests/testthat/test-create_single_dose_dataset.R +++ b/tests/testthat/test-create_single_dose_dataset.R @@ -1,135 +1,150 @@ -test_that("create_single_dose_dataset works as expected for Q#/EVERY # cases", { +# create_single_dose_dataset ---- +## Test 1: Works as expected for Q#/EVERY # cases ---- +test_that("cases Test 1: Works as expected for Q#/EVERY # cases", { input <- tibble::tribble( - ~USUBJID, ~EXDOSFRQ, ~ASTDT, ~ASTDTM, ~AENDT, ~AENDTM, - "P01", "Q2D", ymd("2021-01-01"), ymd_hms("2021-01-01 10:30:00"), - ymd("2021-01-07"), ymd_hms("2021-01-07 11:30:00"), - "P01", "Q3D", ymd("2021-01-08"), ymd_hms("2021-01-08 12:00:00"), - ymd("2021-01-14"), ymd_hms("2021-01-14 14:00:00"), - "P01", "EVERY 2 WEEKS", ymd("2021-01-15"), ymd_hms("2021-01-15 09:57:00"), - ymd("2021-01-29"), ymd_hms("2021-01-29 10:57:00") + ~USUBJID, ~EXDOSFRQ, ~ASTDT, ~AENDT, + "P01", "Q2D", ymd("2021-01-01"), ymd("2021-01-07"), + "P01", "Q3D", ymd("2021-01-08"), ymd("2021-01-14"), + "P01", "EVERY 2 WEEKS", ymd("2021-01-15"), ymd("2021-01-29"), + "P02", "ONCE", ymd("2021-02-02"), ymd("2021-02-02") ) expected_output <- tibble::tribble( - ~USUBJID, ~EXDOSFRQ, ~ASTDT, ~ASTDTM, ~AENDT, ~AENDTM, - "P01", "ONCE", lubridate::ymd("2021-01-01"), lubridate::ymd_hms("2021-01-01 10:30:00"), - lubridate::ymd("2021-01-01"), lubridate::ymd_hms("2021-01-01 11:30:00"), - "P01", "ONCE", lubridate::ymd("2021-01-03"), lubridate::ymd_hms("2021-01-03 10:30:00"), - lubridate::ymd("2021-01-03"), lubridate::ymd_hms("2021-01-03 11:30:00"), - "P01", "ONCE", lubridate::ymd("2021-01-05"), lubridate::ymd_hms("2021-01-05 10:30:00"), - lubridate::ymd("2021-01-05"), lubridate::ymd_hms("2021-01-05 11:30:00"), - "P01", "ONCE", lubridate::ymd("2021-01-07"), lubridate::ymd_hms("2021-01-07 10:30:00"), - lubridate::ymd("2021-01-07"), lubridate::ymd_hms("2021-01-07 11:30:00"), - "P01", "ONCE", lubridate::ymd("2021-01-08"), lubridate::ymd_hms("2021-01-08 12:00:00"), - lubridate::ymd("2021-01-08"), lubridate::ymd_hms("2021-01-08 14:00:00"), - "P01", "ONCE", lubridate::ymd("2021-01-11"), lubridate::ymd_hms("2021-01-11 12:00:00"), - lubridate::ymd("2021-01-11"), lubridate::ymd_hms("2021-01-11 14:00:00"), - "P01", "ONCE", lubridate::ymd("2021-01-14"), lubridate::ymd_hms("2021-01-14 12:00:00"), - lubridate::ymd("2021-01-14"), lubridate::ymd_hms("2021-01-14 14:00:00"), - "P01", "ONCE", lubridate::ymd("2021-01-15"), lubridate::ymd_hms("2021-01-15 09:57:00"), - lubridate::ymd("2021-01-15"), lubridate::ymd_hms("2021-01-15 10:57:00"), - "P01", "ONCE", lubridate::ymd("2021-01-29"), lubridate::ymd_hms("2021-01-29 09:57:00"), - lubridate::ymd("2021-01-29"), lubridate::ymd_hms("2021-01-29 10:57:00") - ) - - expect_equal(create_single_dose_dataset(input), expected_output) + ~USUBJID, ~EXDOSFRQ, ~ASTDT, ~AENDT, + "P01", "ONCE", ymd("2021-01-01"), ymd("2021-01-01"), + "P01", "ONCE", ymd("2021-01-03"), ymd("2021-01-03"), + "P01", "ONCE", ymd("2021-01-05"), ymd("2021-01-05"), + "P01", "ONCE", ymd("2021-01-07"), ymd("2021-01-07"), + "P01", "ONCE", ymd("2021-01-08"), ymd("2021-01-08"), + "P01", "ONCE", ymd("2021-01-11"), ymd("2021-01-11"), + "P01", "ONCE", ymd("2021-01-14"), ymd("2021-01-14"), + "P01", "ONCE", ymd("2021-01-15"), ymd("2021-01-15"), + "P01", "ONCE", ymd("2021-01-29"), ymd("2021-01-29"), + "P02", "ONCE", ymd("2021-02-02"), ymd("2021-02-02") + ) + + expect_dfs_equal( + create_single_dose_dataset(input), + expected_output, + keys = "ASTDT" + ) }) -test_that("create_single_dose_dataset works as expected for # TIMES PER cases", { + +## Test 2: Works as expected for # TIMES PER cases ---- +test_that("cases Test 2: Works as expected for # TIMES PER cases", { input <- tibble::tribble( - ~USUBJID, ~EXDOSFRQ, ~ASTDT, ~ASTDTM, ~AENDT, ~AENDTM, + ~USUBJID, ~DOSFREQ, ~EXSTDT, ~EXSTDTM, ~EXENDT, ~EXENDTM, "P01", "2 TIMES PER YEAR", - lubridate::ymd("2021-01-01"), lubridate::ymd_hms("2021-01-01 10:00:00"), - lubridate::ymd("2021-07-01"), lubridate::ymd_hms("2021-07-01 10:00:00"), + ymd("2021-01-01"), ymd_hms("2021-01-01 10:00:00"), + ymd("2021-07-01"), ymd_hms("2021-07-01 10:00:00"), "P02", "2 TIMES PER YEAR", - lubridate::ymd("2021-01-01"), lubridate::ymd_hms("2021-01-01 10:30:00"), - lubridate::ymd("2021-12-31"), lubridate::ymd_hms("2021-12-31 10:30:00"), + ymd("2021-01-01"), ymd_hms("2021-01-01 10:30:00"), + ymd("2021-12-31"), ymd_hms("2021-12-31 10:30:00"), "P03", "4 TIMES PER MONTH", - lubridate::ymd("2021-02-01"), lubridate::ymd_hms("2021-02-01 11:00:00"), - lubridate::ymd("2021-03-01"), lubridate::ymd_hms("2021-03-01 11:00:00"), + ymd("2021-02-01"), ymd_hms("2021-02-01 11:00:00"), + ymd("2021-03-01"), ymd_hms("2021-03-01 11:00:00"), "P04", "4 TIMES PER MONTH", - lubridate::ymd("2021-01-01"), lubridate::ymd_hms("2021-01-01 11:30:00"), - lubridate::ymd("2021-01-20"), lubridate::ymd_hms("2021-01-20 11:30:00"), + ymd("2021-01-01"), ymd_hms("2021-01-01 11:30:00"), + ymd("2021-01-20"), ymd_hms("2021-01-20 11:30:00"), "P05", "5 TIMES PER WEEK", - lubridate::ymd("2021-01-15"), lubridate::ymd_hms("2021-01-15 12:00:00"), - lubridate::ymd("2021-01-17"), lubridate::ymd_hms("2021-01-17 12:00:00"), + ymd("2021-01-15"), ymd_hms("2021-01-15 12:00:00"), + ymd("2021-01-17"), ymd_hms("2021-01-17 12:00:00"), "P06", "5 TIMES PER WEEK", - lubridate::ymd("2021-01-15"), lubridate::ymd_hms("2021-01-15 12:30:00"), - lubridate::ymd("2021-01-21"), lubridate::ymd_hms("2021-01-21 12:30:00"), + ymd("2021-01-15"), ymd_hms("2021-01-15 12:30:00"), + ymd("2021-01-21"), ymd_hms("2021-01-21 12:30:00"), ) expected_output <- tibble::tribble( - ~USUBJID, ~EXDOSFRQ, ~ASTDT, ~ASTDTM, ~AENDT, ~AENDTM, - "P01", "ONCE", lubridate::ymd("2021-01-01"), lubridate::ymd_hms("2021-01-01 10:00:00"), - lubridate::ymd("2021-01-01"), lubridate::ymd_hms("2021-01-01 10:00:00"), - "P02", "ONCE", lubridate::ymd("2021-01-01"), lubridate::ymd_hms("2021-01-01 10:30:00"), - lubridate::ymd("2021-01-01"), lubridate::ymd_hms("2021-01-01 10:30:00"), - "P02", "ONCE", lubridate::ymd("2021-07-02"), lubridate::ymd_hms("2021-07-02 10:30:00"), - lubridate::ymd("2021-07-02"), lubridate::ymd_hms("2021-07-02 10:30:00"), - "P03", "ONCE", lubridate::ymd("2021-02-01"), lubridate::ymd_hms("2021-02-01 11:00:00"), - lubridate::ymd("2021-02-01"), lubridate::ymd_hms("2021-02-01 11:00:00"), - "P03", "ONCE", lubridate::ymd("2021-02-08"), lubridate::ymd_hms("2021-02-08 11:00:00"), - lubridate::ymd("2021-02-08"), lubridate::ymd_hms("2021-02-08 11:00:00"), - "P03", "ONCE", lubridate::ymd("2021-02-16"), lubridate::ymd_hms("2021-02-16 11:00:00"), - lubridate::ymd("2021-02-16"), lubridate::ymd_hms("2021-02-16 11:00:00"), - "P03", "ONCE", lubridate::ymd("2021-02-23"), lubridate::ymd_hms("2021-02-23 11:00:00"), - lubridate::ymd("2021-02-23"), lubridate::ymd_hms("2021-02-23 11:00:00"), - "P04", "ONCE", lubridate::ymd("2021-01-01"), lubridate::ymd_hms("2021-01-01 11:30:00"), - lubridate::ymd("2021-01-01"), lubridate::ymd_hms("2021-01-01 11:30:00"), - "P04", "ONCE", lubridate::ymd("2021-01-08"), lubridate::ymd_hms("2021-01-08 11:30:00"), - lubridate::ymd("2021-01-08"), lubridate::ymd_hms("2021-01-08 11:30:00"), - "P04", "ONCE", lubridate::ymd("2021-01-16"), lubridate::ymd_hms("2021-01-16 11:30:00"), - lubridate::ymd("2021-01-16"), lubridate::ymd_hms("2021-01-16 11:30:00"), - "P05", "ONCE", lubridate::ymd("2021-01-15"), lubridate::ymd_hms("2021-01-15 12:00:00"), - lubridate::ymd("2021-01-15"), lubridate::ymd_hms("2021-01-15 12:00:00"), - "P05", "ONCE", lubridate::ymd("2021-01-16"), lubridate::ymd_hms("2021-01-16 12:00:00"), - lubridate::ymd("2021-01-16"), lubridate::ymd_hms("2021-01-16 12:00:00"), - "P05", "ONCE", lubridate::ymd("2021-01-17"), lubridate::ymd_hms("2021-01-17 12:00:00"), - lubridate::ymd("2021-01-17"), lubridate::ymd_hms("2021-01-17 12:00:00"), - "P06", "ONCE", lubridate::ymd("2021-01-15"), lubridate::ymd_hms("2021-01-15 12:30:00"), - lubridate::ymd("2021-01-15"), lubridate::ymd_hms("2021-01-15 12:30:00"), - "P06", "ONCE", lubridate::ymd("2021-01-16"), lubridate::ymd_hms("2021-01-16 12:30:00"), - lubridate::ymd("2021-01-16"), lubridate::ymd_hms("2021-01-16 12:30:00"), - "P06", "ONCE", lubridate::ymd("2021-01-17"), lubridate::ymd_hms("2021-01-17 12:30:00"), - lubridate::ymd("2021-01-17"), lubridate::ymd_hms("2021-01-17 12:30:00"), - "P06", "ONCE", lubridate::ymd("2021-01-19"), lubridate::ymd_hms("2021-01-19 12:30:00"), - lubridate::ymd("2021-01-19"), lubridate::ymd_hms("2021-01-19 12:30:00"), - "P06", "ONCE", lubridate::ymd("2021-01-20"), lubridate::ymd_hms("2021-01-20 12:30:00"), - lubridate::ymd("2021-01-20"), lubridate::ymd_hms("2021-01-20 12:30:00") - ) - - expect_equal(create_single_dose_dataset(input), expected_output) + ~USUBJID, ~DOSFREQ, ~EXSTDT, ~EXSTDTM, ~EXENDT, ~EXENDTM, + "P01", "ONCE", ymd("2021-01-01"), ymd_hms("2021-01-01 10:00:00"), + ymd("2021-01-01"), ymd_hms("2021-01-01 10:00:00"), + "P02", "ONCE", ymd("2021-01-01"), ymd_hms("2021-01-01 10:30:00"), + ymd("2021-01-01"), ymd_hms("2021-01-01 10:30:00"), + "P02", "ONCE", ymd("2021-07-02"), ymd_hms("2021-07-02 10:30:00"), + ymd("2021-07-02"), ymd_hms("2021-07-02 10:30:00"), + "P03", "ONCE", ymd("2021-02-01"), ymd_hms("2021-02-01 11:00:00"), + ymd("2021-02-01"), ymd_hms("2021-02-01 11:00:00"), + "P03", "ONCE", ymd("2021-02-08"), ymd_hms("2021-02-08 11:00:00"), + ymd("2021-02-08"), ymd_hms("2021-02-08 11:00:00"), + "P03", "ONCE", ymd("2021-02-16"), ymd_hms("2021-02-16 11:00:00"), + ymd("2021-02-16"), ymd_hms("2021-02-16 11:00:00"), + "P03", "ONCE", ymd("2021-02-23"), ymd_hms("2021-02-23 11:00:00"), + ymd("2021-02-23"), ymd_hms("2021-02-23 11:00:00"), + "P04", "ONCE", ymd("2021-01-01"), ymd_hms("2021-01-01 11:30:00"), + ymd("2021-01-01"), ymd_hms("2021-01-01 11:30:00"), + "P04", "ONCE", ymd("2021-01-08"), ymd_hms("2021-01-08 11:30:00"), + ymd("2021-01-08"), ymd_hms("2021-01-08 11:30:00"), + "P04", "ONCE", ymd("2021-01-16"), ymd_hms("2021-01-16 11:30:00"), + ymd("2021-01-16"), ymd_hms("2021-01-16 11:30:00"), + "P05", "ONCE", ymd("2021-01-15"), ymd_hms("2021-01-15 12:00:00"), + ymd("2021-01-15"), ymd_hms("2021-01-15 12:00:00"), + "P05", "ONCE", ymd("2021-01-16"), ymd_hms("2021-01-16 12:00:00"), + ymd("2021-01-16"), ymd_hms("2021-01-16 12:00:00"), + "P05", "ONCE", ymd("2021-01-17"), ymd_hms("2021-01-17 12:00:00"), + ymd("2021-01-17"), ymd_hms("2021-01-17 12:00:00"), + "P06", "ONCE", ymd("2021-01-15"), ymd_hms("2021-01-15 12:30:00"), + ymd("2021-01-15"), ymd_hms("2021-01-15 12:30:00"), + "P06", "ONCE", ymd("2021-01-16"), ymd_hms("2021-01-16 12:30:00"), + ymd("2021-01-16"), ymd_hms("2021-01-16 12:30:00"), + "P06", "ONCE", ymd("2021-01-17"), ymd_hms("2021-01-17 12:30:00"), + ymd("2021-01-17"), ymd_hms("2021-01-17 12:30:00"), + "P06", "ONCE", ymd("2021-01-19"), ymd_hms("2021-01-19 12:30:00"), + ymd("2021-01-19"), ymd_hms("2021-01-19 12:30:00"), + "P06", "ONCE", ymd("2021-01-20"), ymd_hms("2021-01-20 12:30:00"), + ymd("2021-01-20"), ymd_hms("2021-01-20 12:30:00") + ) + + expect_dfs_equal( + create_single_dose_dataset( + input, + dose_freq = DOSFREQ, + start_date = EXSTDT, + start_datetime = EXSTDTM, + end_date = EXENDT, + end_datetime = EXENDTM + ), + expected_output, + keys = c("USUBJID", "EXSTDT") + ) }) -test_that("create_single_dose_dataset works for different treatments", { +## Test 3: Works for different treatments ---- +test_that("cases Test 3: Works for different treatments", { input <- tibble::tribble( ~USUBJID, ~EXDOSFRQ, ~ASTDT, ~ASTDTM, ~AENDT, ~AENDTM, ~EXTRT, - "P01", "Q2D", lubridate::ymd("2021-01-01"), lubridate::ymd_hms("2021-01-01 09:00:00"), - lubridate::ymd("2021-01-03"), lubridate::ymd_hms("2021-01-03 09:00:00"), "XANOMELINE", - "P01", "QOD", lubridate::ymd("2021-01-01"), lubridate::ymd_hms("2021-01-01 09:15:00"), - lubridate::ymd("2021-01-05"), lubridate::ymd_hms("2021-01-05 09:15:00"), "PLACEBO" + "P01", "Q2D", ymd("2021-01-01"), ymd_hms("2021-01-01 09:00:00"), + ymd("2021-01-03"), ymd_hms("2021-01-03 09:00:00"), "XANOMELINE", + "P01", "QOD", ymd("2021-01-01"), ymd_hms("2021-01-01 09:15:00"), + ymd("2021-01-05"), ymd_hms("2021-01-05 09:15:00"), "PLACEBO" ) expected_output <- tibble::tribble( ~USUBJID, ~EXDOSFRQ, ~ASTDT, ~ASTDTM, ~AENDT, ~AENDTM, ~EXTRT, - "P01", "ONCE", lubridate::ymd("2021-01-01"), lubridate::ymd_hms("2021-01-01 09:00:00"), - lubridate::ymd("2021-01-01"), lubridate::ymd_hms("2021-01-01 09:00:00"), "XANOMELINE", - "P01", "ONCE", lubridate::ymd("2021-01-03"), lubridate::ymd_hms("2021-01-03 09:00:00"), - lubridate::ymd("2021-01-03"), lubridate::ymd_hms("2021-01-03 09:00:00"), "XANOMELINE", - "P01", "ONCE", lubridate::ymd("2021-01-01"), lubridate::ymd_hms("2021-01-01 09:15:00"), - lubridate::ymd("2021-01-01"), lubridate::ymd_hms("2021-01-01 09:15:00"), "PLACEBO", - "P01", "ONCE", lubridate::ymd("2021-01-03"), lubridate::ymd_hms("2021-01-03 09:15:00"), - lubridate::ymd("2021-01-03"), lubridate::ymd_hms("2021-01-03 09:15:00"), "PLACEBO", - "P01", "ONCE", lubridate::ymd("2021-01-05"), lubridate::ymd_hms("2021-01-05 09:15:00"), - lubridate::ymd("2021-01-05"), lubridate::ymd_hms("2021-01-05 09:15:00"), "PLACEBO" - ) - - expect_equal( - create_single_dose_dataset(input, + "P01", "ONCE", ymd("2021-01-01"), ymd_hms("2021-01-01 09:00:00"), + ymd("2021-01-01"), ymd_hms("2021-01-01 09:00:00"), "XANOMELINE", + "P01", "ONCE", ymd("2021-01-03"), ymd_hms("2021-01-03 09:00:00"), + ymd("2021-01-03"), ymd_hms("2021-01-03 09:00:00"), "XANOMELINE", + "P01", "ONCE", ymd("2021-01-01"), ymd_hms("2021-01-01 09:15:00"), + ymd("2021-01-01"), ymd_hms("2021-01-01 09:15:00"), "PLACEBO", + "P01", "ONCE", ymd("2021-01-03"), ymd_hms("2021-01-03 09:15:00"), + ymd("2021-01-03"), ymd_hms("2021-01-03 09:15:00"), "PLACEBO", + "P01", "ONCE", ymd("2021-01-05"), ymd_hms("2021-01-05 09:15:00"), + ymd("2021-01-05"), ymd_hms("2021-01-05 09:15:00"), "PLACEBO" + ) + + expect_dfs_equal( + create_single_dose_dataset( + input, + start_datetime = ASTDTM, + end_datetime = AENDTM, keep_source_vars = vars(USUBJID, EXDOSFRQ, ASTDT, ASTDTM, AENDT, AENDTM, EXTRT) ), - expected_output + expected_output, + keys = c("EXTRT", "ASTDT") ) }) -test_that("custom lookup works", { +## Test 4: Custom lookup works ---- +test_that("cases Test 4: Custom lookup works", { custom_lookup <- tibble::tribble( ~VALUE, ~DOSE_COUNT, ~DOSE_WINDOW, ~CONVERSION_FACTOR, "Q30MIN", (1 / 30), "MINUTE", 1, @@ -138,63 +153,137 @@ test_that("custom lookup works", { input <- tibble::tribble( ~USUBJID, ~EXDOSFRQ, ~ASTDT, ~ASTDTM, ~AENDT, ~AENDTM, - "P01", "Q30MIN", lubridate::ymd("2021-01-01"), lubridate::ymd_hms("2021-01-01T06:00:00"), - lubridate::ymd("2021-01-01"), lubridate::ymd_hms("2021-01-01T07:00:00"), - "P02", "Q90MIN", lubridate::ymd("2021-01-01"), lubridate::ymd_hms("2021-01-01T06:00:00"), - lubridate::ymd("2021-01-01"), lubridate::ymd_hms("2021-01-01T09:00:00") + "P01", "Q30MIN", ymd("2021-01-01"), ymd_hms("2021-01-01T06:00:00"), + ymd("2021-01-01"), ymd_hms("2021-01-01T07:00:00"), + "P02", "Q90MIN", ymd("2021-01-01"), ymd_hms("2021-01-01T06:00:00"), + ymd("2021-01-01"), ymd_hms("2021-01-01T09:00:00") ) expected_output <- tibble::tribble( ~USUBJID, ~EXDOSFRQ, ~ASTDT, ~ASTDTM, ~AENDT, ~AENDTM, - "P01", "ONCE", lubridate::ymd("2021-01-01"), lubridate::ymd_hms("2021-01-01T06:00:00"), - lubridate::ymd("2021-01-01"), lubridate::ymd_hms("2021-01-01T06:00:00"), - "P01", "ONCE", lubridate::ymd("2021-01-01"), lubridate::ymd_hms("2021-01-01T06:30:00"), - lubridate::ymd("2021-01-01"), lubridate::ymd_hms("2021-01-01T06:30:00"), - "P01", "ONCE", lubridate::ymd("2021-01-01"), lubridate::ymd_hms("2021-01-01T07:00:00"), - lubridate::ymd("2021-01-01"), lubridate::ymd_hms("2021-01-01T07:00:00"), - "P02", "ONCE", lubridate::ymd("2021-01-01"), lubridate::ymd_hms("2021-01-01T06:00:00"), - lubridate::ymd("2021-01-01"), lubridate::ymd_hms("2021-01-01T06:00:00"), - "P02", "ONCE", lubridate::ymd("2021-01-01"), lubridate::ymd_hms("2021-01-01T07:30:00"), - lubridate::ymd("2021-01-01"), lubridate::ymd_hms("2021-01-01T07:30:00"), - "P02", "ONCE", lubridate::ymd("2021-01-01"), lubridate::ymd_hms("2021-01-01T09:00:00"), - lubridate::ymd("2021-01-01"), lubridate::ymd_hms("2021-01-01T09:00:00") - ) - - expect_equal( - create_single_dose_dataset(input, + "P01", "ONCE", ymd("2021-01-01"), ymd_hms("2021-01-01T06:00:00"), + ymd("2021-01-01"), ymd_hms("2021-01-01T06:00:00"), + "P01", "ONCE", ymd("2021-01-01"), ymd_hms("2021-01-01T06:30:00"), + ymd("2021-01-01"), ymd_hms("2021-01-01T06:30:00"), + "P01", "ONCE", ymd("2021-01-01"), ymd_hms("2021-01-01T07:00:00"), + ymd("2021-01-01"), ymd_hms("2021-01-01T07:00:00"), + "P02", "ONCE", ymd("2021-01-01"), ymd_hms("2021-01-01T06:00:00"), + ymd("2021-01-01"), ymd_hms("2021-01-01T06:00:00"), + "P02", "ONCE", ymd("2021-01-01"), ymd_hms("2021-01-01T07:30:00"), + ymd("2021-01-01"), ymd_hms("2021-01-01T07:30:00"), + "P02", "ONCE", ymd("2021-01-01"), ymd_hms("2021-01-01T09:00:00"), + ymd("2021-01-01"), ymd_hms("2021-01-01T09:00:00") + ) + + expect_dfs_equal( + create_single_dose_dataset( + input, + start_datetime = ASTDTM, + end_datetime = AENDTM, lookup_table = custom_lookup, lookup_column = VALUE ), - expected_output + expected_output, + keys = c("USUBJID", "ASTDTM") ) }) -test_that("Warning is returned when values in EXDOSFRQ does not appear in lookup table", { +## Test 5: Warning is returned when values in EXDOSFRQ does not appear in lookup table ---- +test_that("cases Test 5: Warning is returned when values in EXDOSFRQ does not appear in lookup table", { # nolint input <- tibble::tribble( ~USUBJID, ~EXDOSFRQ, ~ASTDT, ~ASTDTM, ~AENDT, ~AENDTM, - "P01", "1", lubridate::ymd("2021-01-01"), lubridate::ymd_hms("2021-01-01T09:00:00"), - lubridate::ymd("2021-01-03"), lubridate::ymd_hms("2021-01-03T09:00:00"), - "P01", "1", lubridate::ymd("2021-01-08"), lubridate::ymd_hms("2021-01-08T09:00:00"), - lubridate::ymd("2021-01-12"), lubridate::ymd_hms("2021-01-12T09:00:00"), - "P01", "1", lubridate::ymd("2021-01-15"), lubridate::ymd_hms("2021-01-15T09:00:00"), - lubridate::ymd("2021-01-29"), lubridate::ymd_hms("2021-01-29T09:00:00") + "P01", "1", ymd("2021-01-01"), ymd_hms("2021-01-01T09:00:00"), + ymd("2021-01-03"), ymd_hms("2021-01-03T09:00:00"), + "P01", "1", ymd("2021-01-08"), ymd_hms("2021-01-08T09:00:00"), + ymd("2021-01-12"), ymd_hms("2021-01-12T09:00:00"), + "P01", "1", ymd("2021-01-15"), ymd_hms("2021-01-15T09:00:00"), + ymd("2021-01-29"), ymd_hms("2021-01-29T09:00:00") ) expect_error( create_single_dose_dataset(input) ) }) -test_that("Error is returned when a date variable contains NA values", { +## Test 6: Error is returned when a date variable contains NA values ---- +test_that("cases Test 6: Error is returned when a date variable contains NA values", { # nolint input <- tibble::tribble( ~USUBJID, ~EXDOSFRQ, ~ASTDT, ~ASTDTM, ~AENDT, ~AENDTM, - "P01", "Q2D", ymd("2021-01-01"), lubridate::ymd_hms("2021-01-01T09:00:00"), NA, NA, - "P01", "Q3D", ymd("2021-01-08"), lubridate::ymd_hms("2021-01-08T09:00:00"), - ymd("2021-01-15"), lubridate::ymd_hms("2021-01-15T09:00:00"), - "P01", "EVERY 2 WEEKS", ymd("2021-01-15"), lubridate::ymd_hms("2021-01-15T09:00:00"), - ymd("2021-01-29"), lubridate::ymd_hms("2021-01-29T09:00:00") + "P01", "Q2D", ymd("2021-01-01"), ymd_hms("2021-01-01T09:00:00"), NA, NA, + "P01", "Q3D", ymd("2021-01-08"), ymd_hms("2021-01-08T09:00:00"), + ymd("2021-01-15"), ymd_hms("2021-01-15T09:00:00"), + "P01", "EVERY 2 WEEKS", ymd("2021-01-15"), ymd_hms("2021-01-15T09:00:00"), + ymd("2021-01-29"), ymd_hms("2021-01-29T09:00:00") ) expect_error( create_single_dose_dataset(input), regexp = "cannot contain `NA`" ) }) + +## Test 7: Message for improper DT column names, ASTDT ---- +test_that("cases Test 7: Message for improper DT column names, ASTDT", { + input <- tibble::tribble( + ~USUBJID, ~EXDOSFRQ, ~ADTSTD, ~ASTDTM, ~AENDT, ~AENDTM, + "P01", "Q2D", ymd("2021-01-01"), ymd_hms("2021-01-01 10:30:00"), + ymd("2021-01-07"), ymd_hms("2021-01-07 11:30:00"), + "P01", "Q3D", ymd("2021-01-01"), ymd_hms("2021-01-08 12:00:00"), + ymd("2021-01-14"), ymd_hms("2021-01-14 14:00:00"), + "P01", "EVERY 2 WEEKS", ymd("2021-01-15"), ymd_hms("2021-01-15 09:57:00"), + ymd("2021-01-29"), ymd_hms("2021-01-29 10:57:00") + ) + expect_error( + create_single_dose_dataset(input, + start_date = ADTSTD, + keep_source_vars = vars( + USUBJID, EXDOSFRQ, + ADTSTD, ASTDTM, + AENDT, AENDTM + ) + ), + regexp = paste0( + "The argument start_date is expected to have a name like xxxDT.\n", + "Please check as it does not follow the expected naming convention" + ) + ) +}) + +## Test 8: Message for improper DT column names, AENDT ---- +test_that("cases Test 8: Message for improper DT column names, AENDT", { + input <- tibble::tribble( + ~USUBJID, ~EXDOSFRQ, ~ASTDT, ~ASTDTM, ~ADTEND, ~AENDTM, + "P01", "Q2D", ymd("2021-01-01"), ymd_hms("2021-01-01 10:30:00"), + ymd("2021-01-07"), ymd_hms("2021-01-07 11:30:00"), + "P01", "Q3D", ymd("2021-01-01"), ymd_hms("2021-01-08 12:00:00"), + ymd("2021-01-14"), ymd_hms("2021-01-14 14:00:00"), + "P01", "EVERY 2 WEEKS", ymd("2021-01-15"), ymd_hms("2021-01-15 09:57:00"), + ymd("2021-01-29"), ymd_hms("2021-01-29 10:57:00") + ) + expect_error( + create_single_dose_dataset(input, + end_date = ADTEND, + ), + regexp = paste0( + "The argument end_date is expected to have a name like xxxDT.\n", + "Please check as it does not follow the expected naming convention" + ) + ) +}) + +## Test 9: error if no datetime specified and freq more than QD ---- +test_that("cases Test 9: error if no datetime specified and freq more than QD", { + input <- tibble::tribble( + ~USUBJID, ~EXDOSFRQ, ~ASTDT, ~AENDT, + "P01", "Q12H", ymd("2021-01-01"), ymd("2021-01-01"), + "P02", "Q12H", ymd("2021-01-01"), ymd("2021-01-01") + ) + + expect_error( + create_single_dose_dataset(input), + regexp = paste( + "There are dose frequencies more frequent than once a day.", + "Thus `start_datetime` and `end_datetime` must be specified.", + sep = "\n" + ), + fixed = TRUE + ) +}) diff --git a/tests/testthat/test-deprecation.R b/tests/testthat/test-deprecation.R index 8323b9eb5a..170a74fabf 100644 --- a/tests/testthat/test-deprecation.R +++ b/tests/testthat/test-deprecation.R @@ -209,3 +209,109 @@ test_that("deprecation Test 15: A warning is issued if `derive_var_agegr_fda()` ) }) }) + +## Test 16: A warning is issued if `derive_param_first_event()` is called ---- +test_that("deprecation Test 16: A warning is issued if `derive_param_first_event()` + is called", { + rlang::with_options(lifecycle_verbosity = "warning", { + adsl <- tibble::tribble( + ~STUDYID, ~USUBJID, ~DTHDT, + "XX1234", "1", ymd("2022-05-13"), + "XX1234", "2", ymd(""), + "XX1234", "3", ymd(""), + ) + + adrs <- tibble::tribble( + ~USUBJID, ~ADTC, ~AVALC, ~PARAMCD, + "1", "2020-01-02", "PR", "OVR", + "1", "2020-02-01", "CR", "OVR", + "1", "2020-03-01", "CR", "OVR", + "1", "2020-04-01", "SD", "OVR", + "2", "2021-06-15", "SD", "OVR", + "2", "2021-07-16", "PD", "OVR", + "2", "2021-09-14", "PD", "OVR", + ) %>% + mutate( + STUDYID = "XX1234", + ADT = ymd(ADTC) + ) %>% + select(-ADTC) + + expect_warning( + derive_param_first_event( + adrs, + dataset_adsl = adsl, + dataset_source = adrs, + filter_source = PARAMCD == "OVR" & AVALC == "PD", + date_var = ADT, + set_values_to = vars( + PARAMCD = "PD", + ANL01FL = "Y" + ) + ), + class = "lifecycle_warning_deprecated" + ) + }) +}) + +## Test 17: An error is thrown if `smq_select()` is called ---- +test_that("deprecation Test 17: An error is thrown if `smq_select()` + is called", { + expect_error( + smq_select(), + class = "lifecycle_error_deprecated" + ) +}) + +## Test 18: An error is thrown if `sdg_select()` is called ---- +test_that("deprecation Test 18: An error is thrown if `sdg_select()` + is called", { + expect_error( + sdg_select(), + class = "lifecycle_error_deprecated" + ) +}) + +## Test 19: An error is thrown if `create_query_data()` and `meddra_version` argument is called ---- +test_that("deprecation Test 19: An error is thrown if `create_query_data()` + with `meddra_version` argument is called", { + expect_error( + create_query_data( + meddra_version = "20.1" + ), + class = "lifecycle_error_deprecated" + ) +}) + +## Test 20: An error is thrown if `create_query_data()` and `whodd_version` argument is called ---- +test_that("deprecation Test 20: An error is thrown if `create_query_data()` + with `whodd_version` argument is called", { + expect_error( + create_query_data( + whodd_version = "2019-09" + ), + class = "lifecycle_error_deprecated" + ) +}) + +## Test 21: An error is thrown if `create_query_data()` and `get_smq_fun` argument is called ---- +test_that("deprecation Test 21: An error is thrown if `create_query_data()` + with `get_smq_fun` argument is called", { + expect_error( + create_query_data( + get_smq_fun = admiral.test:::get_smq_terms + ), + class = "lifecycle_error_deprecated" + ) +}) + +## Test 22: An error is thrown if `create_query_data()` and `get_sdg_fun` argument is called ---- +test_that("deprecation Test 22: An error is thrown if `create_query_data()` + with `get_sdg_fun` argument is called", { + expect_error( + create_query_data( + get_sdg_fun = admiral.test:::get_sdg_terms + ), + class = "lifecycle_error_deprecated" + ) +}) diff --git a/tests/testthat/test-derive_date_vars.R b/tests/testthat/test-derive_date_vars.R index 9b46b6c282..ed0691bbfb 100644 --- a/tests/testthat/test-derive_date_vars.R +++ b/tests/testthat/test-derive_date_vars.R @@ -1,6 +1,3 @@ -library(lubridate) -library(dplyr) - input <- c( "2019-07-18T15:25:40.243", "2019-07-18T15:25:40", @@ -530,14 +527,15 @@ test_that("compute_tmf Test 24: compute TMF", { ## Test 25: throws ERROR when ignore_seconds_flag = T and seconds are present ---- test_that("compute_tmf Test 25: throws ERROR when ignore_seconds_flag = T and seconds are present", { # nolint - expect_error(compute_tmf( - dtc = c("2020-11-11T11:11:11", "2020-11-11T11:11"), - dtm = ymd_hms(c( - "2020-11-11T11:11:11", "2020-11-11T11:11:00" - )), - ignore_seconds_flag = TRUE - ), - regexp = "Seconds detected in data while ignore_seconds_flag is invoked" + expect_error( + compute_tmf( + dtc = c("2020-11-11T11:11:11", "2020-11-11T11:11"), + dtm = ymd_hms(c( + "2020-11-11T11:11:11", "2020-11-11T11:11:00" + )), + ignore_seconds_flag = TRUE + ), + regexp = "Seconds detected in data while ignore_seconds_flag is invoked" ) }) diff --git a/tests/testthat/test-derive_joined.R b/tests/testthat/test-derive_joined.R new file mode 100644 index 0000000000..1895fdcb72 --- /dev/null +++ b/tests/testthat/test-derive_joined.R @@ -0,0 +1,132 @@ +# derive_vars_joined ---- +## Test 1: no by_vars, no order, no new_vars ---- +test_that("derive_vars_joined Test 1: no by_vars, no order, no new_vars", { + expected <- tibble::tribble( + ~USUBJID, ~ADY, ~AVISIT, ~AWLO, ~AWHI, + "1", -2, "BASELINE", -30, 1, + "1", 3, "WEEK 1", 2, 7, + "1", 24, "WEEK 4", 23, 30, + "2", NA, NA, NA, NA + ) + + windows <- tibble::tribble( + ~AVISIT, ~AWLO, ~AWHI, + "BASELINE", -30, 1, + "WEEK 1", 2, 7, + "WEEK 2", 8, 15, + "WEEK 3", 16, 22, + "WEEK 4", 23, 30 + ) + + expect_dfs_equal( + base = expected, + comp = derive_vars_joined( + select(expected, USUBJID, ADY), + dataset_add = windows, + join_vars = vars(AWHI, AWLO), + filter_join = AWLO <= ADY & ADY <= AWHI + ), + keys = c("USUBJID", "ADY") + ) +}) + +## Test 2: new_vars with rename ---- +test_that("derive_vars_joined Test 2: new_vars with rename", { + expected <- tibble::tribble( + ~USUBJID, ~ADY, ~AVAL, ~NADIR, + "1", -7, 10, NA, + "1", 1, 12, NA, + "1", 8, 11, 12, + "1", 15, 9, 11, + "1", 20, 14, 9, + "1", 24, 12, 9, + "2", 13, 8, NA + ) + + adbds <- select(expected, -NADIR) + + expect_dfs_equal( + base = expected, + comp = derive_vars_joined( + adbds, + dataset_add = adbds, + by_vars = vars(USUBJID), + order = vars(AVAL), + new_vars = vars(NADIR = AVAL), + join_vars = vars(ADY), + filter_add = ADY > 0, + filter_join = ADY.join < ADY, + mode = "first", + check_type = "none" + ), + keys = c("USUBJID", "ADY") + ) +}) + +## Test 3: by_vars with rename ---- +test_that("derive_vars_joined Test 3: by_vars with rename", { + adae <- tibble::tribble( + ~AEGRPID, + "1", + "2" + ) %>% + mutate( + TRTSDTM = ymd_hms("2020-01-06T12:00:00") + ) + + faae <- tibble::tribble( + ~FAGRPID, ~FADT, ~FAORRES, + "1", "2020-01-01", "1", + "1", "2020-01-03", "2", + "1", "2020-01-05", "3", + "1", "2020-01-08", "4" + ) %>% + mutate(FADT = ymd(FADT)) + expect_dfs_equal( + base = mutate(adae, ATOXGR_pre = c("3", NA)), + comp = derive_vars_joined( + adae, + dataset_add = faae, + by_vars = vars(AEGRPID = FAGRPID), + order = vars(FADT), + new_vars = vars(ATOXGR_pre = FAORRES), + join_vars = vars(FADT), + filter_join = FADT < TRTSDTM, + mode = "last" + ), + keys = c("AEGRPID") + ) +}) + +## Test 4: no join_vars, no filter_join ---- +test_that("derive_vars_joined Test 4: no join_vars, no filter_join", { + adae <- tibble::tribble( + ~AEGRPID, + "1", + "2" + ) %>% + mutate( + TRTSDTM = ymd_hms("2020-01-06T12:00:00") + ) + + faae <- tibble::tribble( + ~FAGRPID, ~FADT, ~FAORRES, + "1", "2020-01-01", "1", + "1", "2020-01-03", "2", + "1", "2020-01-05", "3", + "1", "2020-01-08", "4" + ) %>% + mutate(FADT = ymd(FADT)) + expect_dfs_equal( + base = mutate(adae, ATOXGR_pre = c("1", NA)), + comp = derive_vars_joined( + adae, + dataset_add = faae, + by_vars = vars(AEGRPID = FAGRPID), + order = vars(FAORRES), + new_vars = vars(ATOXGR_pre = FAORRES), + mode = "first" + ), + keys = c("AEGRPID") + ) +}) diff --git a/tests/testthat/test-derive_locf_records.R b/tests/testthat/test-derive_locf_records.R new file mode 100644 index 0000000000..41a87a5f4c --- /dev/null +++ b/tests/testthat/test-derive_locf_records.R @@ -0,0 +1,260 @@ +## Test 1: visits are missing ---- +test_that("derive_locf_records Test 1: visits are missing", { + input <- tibble::tribble( + ~STUDYID, ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVISITN, ~AVISIT, + "TEST01", "01-701-1015", "DIABP", "Diastolic Blood Pressure (mmHg)", 51, 0, "BASELINE", + "TEST01", "01-701-1015", "DIABP", "Diastolic Blood Pressure (mmHg)", 50, 2, "WEEK 2", + "TEST01", "01-701-1015", "SYSBP", "Systolic Blood Pressure (mmHg)", 121, 0, "BASELINE", + "TEST01", "01-701-1015", "SYSBP", "Systolic Blood Pressure (mmHg)", 121, 2, "WEEK 2", + "TEST01", "01-701-1028", "DIABP", "Diastolic Blood Pressure (mmHg)", 79, 0, "BASELINE", + "TEST01", "01-701-1028", "SYSBP", "Systolic Blood Pressure (mmHg)", 130, 0, "BASELINE" + ) + + advs_expected_obsv <- tibble::tribble( + ~PARAMCD, ~PARAM, ~AVISITN, ~AVISIT, + "DIABP", "Diastolic Blood Pressure (mmHg)", 0, "BASELINE", + "DIABP", "Diastolic Blood Pressure (mmHg)", 2, "WEEK 2", + "SYSBP", "Systolic Blood Pressure (mmHg)", 0, "BASELINE", + "SYSBP", "Systolic Blood Pressure (mmHg)", 2, "WEEK 2", + ) + + + expected_output <- bind_rows( + input, + tibble::tribble( + ~STUDYID, ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVISITN, ~AVISIT, + "TEST01", "01-701-1028", "DIABP", "Diastolic Blood Pressure (mmHg)", 79, 2, "WEEK 2", + "TEST01", "01-701-1028", "SYSBP", "Systolic Blood Pressure (mmHg)", 130, 2, "WEEK 2" + ) %>% + mutate(DTYPE = "LOCF") + ) + + + actual_output <- derive_locf_records( + input, + dataset_expected_obs = advs_expected_obsv, + by_vars = vars(STUDYID, USUBJID, PARAM, PARAMCD), + order = vars(AVISITN, AVISIT) + ) + + + expect_dfs_equal( + base = expected_output, + compare = actual_output, + keys = c("STUDYID", "USUBJID", "PARAMCD", "PARAM", "AVISITN", "AVISIT", "DTYPE") + ) +}) + + +## Test 2: some visits have missing AVAL ---- +test_that("derive_locf_records Test 2: some visits have missing AVAL", { + input <- tibble::tribble( + ~STUDYID, ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVISITN, ~AVISIT, + "TEST01", "01-701-1015", "DIABP", "Diastolic Blood Pressure (mmHg)", 51, 0, "BASELINE", + "TEST01", "01-701-1015", "DIABP", "Diastolic Blood Pressure (mmHg)", 50, 2, "WEEK 2", + "TEST01", "01-701-1015", "SYSBP", "Systolic Blood Pressure (mmHg)", 121, 0, "BASELINE", + "TEST01", "01-701-1015", "SYSBP", "Systolic Blood Pressure (mmHg)", 121, 2, "WEEK 2", + "TEST01", "01-701-1028", "DIABP", "Diastolic Blood Pressure (mmHg)", 79, 0, "BASELINE", + "TEST01", "01-701-1028", "DIABP", "Diastolic Blood Pressure (mmHg)", NA, 2, "WEEK 2", + "TEST01", "01-701-1028", "SYSBP", "Systolic Blood Pressure (mmHg)", 130, 0, "BASELINE", + "TEST01", "01-701-1028", "SYSBP", "Systolic Blood Pressure (mmHg)", NA, 2, "WEEK 2" + ) + + advs_expected_obsv <- tibble::tribble( + ~PARAMCD, ~PARAM, ~AVISITN, ~AVISIT, + "DIABP", "Diastolic Blood Pressure (mmHg)", 0, "BASELINE", + "DIABP", "Diastolic Blood Pressure (mmHg)", 2, "WEEK 2", + "SYSBP", "Systolic Blood Pressure (mmHg)", 0, "BASELINE", + "SYSBP", "Systolic Blood Pressure (mmHg)", 2, "WEEK 2", + ) + + + expected_output <- bind_rows( + input, + tibble::tribble( + ~STUDYID, ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVISITN, ~AVISIT, + "TEST01", "01-701-1028", "DIABP", "Diastolic Blood Pressure (mmHg)", 79, 2, "WEEK 2", + "TEST01", "01-701-1028", "SYSBP", "Systolic Blood Pressure (mmHg)", 130, 2, "WEEK 2" + ) %>% + mutate(DTYPE = "LOCF") + ) + + + actual_output <- derive_locf_records( + input, + dataset_expected_obs = advs_expected_obsv, + by_vars = vars(STUDYID, USUBJID, PARAM, PARAMCD), + order = vars(AVISITN, AVISIT) + ) + + + expect_dfs_equal( + base = expected_output, + compare = actual_output, + keys = c("STUDYID", "USUBJID", "PARAMCD", "PARAM", "AVISITN", "AVISIT", "DTYPE") + ) +}) + + +## Test 3: visits are missing - and DTYPE already exits ---- +test_that("derive_locf_records Test 3: visits are missing - and DTYPE already exits", { + input <- tibble::tribble( + ~STUDYID, ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVISITN, ~AVISIT, ~DTYPE, + "TEST01", "1015", "DIABP", "Diastolic Blood Pressure", 51, 0, "BASELINE", NA, + "TEST01", "1015", "DIABP", "Diastolic Blood Pressure", 50, 2, "WEEK 2", NA, + "TEST01", "1015", "SYSBP", "Systolic Blood Pressure", 121, 0, "BASELINE", NA, + "TEST01", "1015", "SYSBP", "Systolic Blood Pressure", 121, 2, "WEEK 2", NA, + "TEST01", "1015", "LTDIABP", "Log(Diastolic Blood Pressure)", 1.71, 0, "BASELINE", "LOG", + "TEST01", "1015", "LTDIABP", "Log(Diastolic Blood Pressure)", 1.69, 2, "WEEK 2", "LOG", + "TEST01", "1015", "LTSYSBP", "Log(Systolic Blood Pressure)", 2.08, 0, "BASELINE", "LOG", + "TEST01", "1015", "LTSYSBP", "Log(Systolic Blood Pressure)", 2.08, 2, "WEEK 2", "LOG", + "TEST01", "1028", "DIABP", "Diastolic Blood Pressure", 79, 0, "BASELINE", NA, + "TEST01", "1028", "SYSBP", "Systolic Blood Pressure", 130, 0, "BASELINE", NA, + "TEST01", "1028", "LTDIABP", "Log(Diastolic Blood Pressure)", 1.89, 0, "BASELINE", "LOG", + "TEST01", "1028", "LTSYSBP", "Log(Systolic Blood Pressure)", 2.11, 0, "BASELINE", "LOG" + ) + + advs_expected_obsv <- tibble::tribble( + ~PARAMCD, ~PARAM, ~AVISITN, ~AVISIT, + "DIABP", "Diastolic Blood Pressure", 0, "BASELINE", + "DIABP", "Diastolic Blood Pressure", 2, "WEEK 2", + "LTDIABP", "Log(Diastolic Blood Pressure)", 0, "BASELINE", + "LTDIABP", "Log(Diastolic Blood Pressure)", 2, "WEEK 2", + "SYSBP", "Systolic Blood Pressure", 0, "BASELINE", + "SYSBP", "Systolic Blood Pressure", 2, "WEEK 2", + "LTSYSBP", "Log(Systolic Blood Pressure)", 0, "BASELINE", + "LTSYSBP", "Log(Systolic Blood Pressure)", 2, "WEEK 2" + ) + + + expected_output <- bind_rows( + input, + tibble::tribble( + ~STUDYID, ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVISITN, ~AVISIT, + "TEST01", "1028", "DIABP", "Diastolic Blood Pressure", 79, 2, "WEEK 2", + "TEST01", "1028", "LTDIABP", "Log(Diastolic Blood Pressure)", 1.89, 2, "WEEK 2", + "TEST01", "1028", "SYSBP", "Systolic Blood Pressure", 130, 2, "WEEK 2", + "TEST01", "1028", "LTSYSBP", "Log(Systolic Blood Pressure)", 2.11, 2, "WEEK 2" + ) %>% + mutate(DTYPE = "LOCF") + ) + + + actual_output <- derive_locf_records( + input, + dataset_expected_obs = advs_expected_obsv, + by_vars = vars(STUDYID, USUBJID, PARAM, PARAMCD), + order = vars(AVISITN, AVISIT) + ) + + + expect_dfs_equal( + base = expected_output, + compare = actual_output, + keys = c("STUDYID", "USUBJID", "PARAMCD", "PARAM", "AVISITN", "AVISIT", "DTYPE") + ) +}) + + +## Test 4: visit variables are parameter independent ---- +test_that("derive_locf_records Test 4: visit variables are parameter independent", { + input <- tibble::tribble( + ~STUDYID, ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVISITN, ~AVISIT, + "TEST01", "01-701-1015", "DIABP", "Diastolic Blood Pressure (mmHg)", 51, 0, "BASELINE", + "TEST01", "01-701-1015", "DIABP", "Diastolic Blood Pressure (mmHg)", 50, 2, "WEEK 2", + "TEST01", "01-701-1015", "SYSBP", "Systolic Blood Pressure (mmHg)", 121, 0, "BASELINE", + "TEST01", "01-701-1015", "SYSBP", "Systolic Blood Pressure (mmHg)", 121, 2, "WEEK 2", + "TEST01", "01-701-1028", "DIABP", "Diastolic Blood Pressure (mmHg)", 79, 0, "BASELINE", + "TEST01", "01-701-1028", "DIABP", "Diastolic Blood Pressure (mmHg)", NA, 2, "WEEK 2", + "TEST01", "01-701-1028", "SYSBP", "Systolic Blood Pressure (mmHg)", 130, 0, "BASELINE", + "TEST01", "01-701-1028", "SYSBP", "Systolic Blood Pressure (mmHg)", NA, 2, "WEEK 2" + ) + + advs_expected_obsv <- tibble::tribble( + ~AVISITN, ~AVISIT, + 0, "BASELINE", + 2, "WEEK 2" + ) + + + expected_output <- bind_rows( + input, + tibble::tribble( + ~STUDYID, ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVISITN, ~AVISIT, + "TEST01", "01-701-1028", "DIABP", "Diastolic Blood Pressure (mmHg)", 79, 2, "WEEK 2", + "TEST01", "01-701-1028", "SYSBP", "Systolic Blood Pressure (mmHg)", 130, 2, "WEEK 2" + ) %>% + mutate(DTYPE = "LOCF") + ) + + + actual_output <- derive_locf_records( + input, + dataset_expected_obs = advs_expected_obsv, + by_vars = vars(STUDYID, USUBJID, PARAM, PARAMCD), + order = vars(AVISITN, AVISIT) + ) + + + expect_dfs_equal( + base = expected_output, + compare = actual_output, + keys = c("STUDYID", "USUBJID", "PARAMCD", "PARAM", "AVISITN", "AVISIT", "DTYPE") + ) +}) + + +## Test 5: visit variables are parameter dependent ---- +test_that("derive_locf_records Test 5: visit variables are parameter dependent", { + input <- tibble::tribble( + ~STUDYID, ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVISITN, ~AVISIT, + "TEST01", "01-701-1015", "DIABP", "Diastolic Blood Pressure (mmHg)", 51, 0, "BASELINE", + "TEST01", "01-701-1015", "DIABP", "Diastolic Blood Pressure (mmHg)", 50, 2, "WEEK 2", + "TEST01", "01-701-1015", "DIABP", "Diastolic Blood Pressure (mmHg)", 52, 4, "WEEK 4", + "TEST01", "01-701-1015", "DIABP", "Diastolic Blood Pressure (mmHg)", 54, 6, "WEEK 6", + "TEST01", "01-701-1015", "SYSBP", "Systolic Blood Pressure (mmHg)", 121, 0, "BASELINE", + "TEST01", "01-701-1015", "SYSBP", "Systolic Blood Pressure (mmHg)", 121, 2, "WEEK 2", + "TEST01", "01-701-1028", "DIABP", "Diastolic Blood Pressure (mmHg)", 79, 0, "BASELINE", + "TEST01", "01-701-1028", "DIABP", "Diastolic Blood Pressure (mmHg)", 80, 2, "WEEK 2", + "TEST01", "01-701-1028", "DIABP", "Diastolic Blood Pressure (mmHg)", NA, 4, "WEEK 4", + "TEST01", "01-701-1028", "DIABP", "Diastolic Blood Pressure (mmHg)", NA, 6, "WEEK 6", + "TEST01", "01-701-1028", "SYSBP", "Systolic Blood Pressure (mmHg)", 130, 0, "BASELINE" + ) + + advs_expected_obsv <- tibble::tribble( + ~PARAMCD, ~PARAM, ~AVISITN, ~AVISIT, + "DIABP", "Diastolic Blood Pressure (mmHg)", 0, "BASELINE", + "DIABP", "Diastolic Blood Pressure (mmHg)", 2, "WEEK 2", + "DIABP", "Diastolic Blood Pressure (mmHg)", 4, "WEEK 4", + "DIABP", "Diastolic Blood Pressure (mmHg)", 6, "WEEK 6", + "SYSBP", "Systolic Blood Pressure (mmHg)", 0, "BASELINE", + "SYSBP", "Systolic Blood Pressure (mmHg)", 2, "WEEK 2" + ) + + + expected_output <- bind_rows( + input, + tibble::tribble( + ~STUDYID, ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVISITN, ~AVISIT, + "TEST01", "01-701-1028", "DIABP", "Diastolic Blood Pressure (mmHg)", 80, 4, "WEEK 4", + "TEST01", "01-701-1028", "DIABP", "Diastolic Blood Pressure (mmHg)", 80, 6, "WEEK 6", + "TEST01", "01-701-1028", "SYSBP", "Systolic Blood Pressure (mmHg)", 130, 2, "WEEK 2" + ) %>% + mutate(DTYPE = "LOCF") + ) + + + actual_output <- derive_locf_records( + input, + dataset_expected_obs = advs_expected_obsv, + by_vars = vars(STUDYID, USUBJID, PARAM, PARAMCD), + order = vars(AVISITN, AVISIT) + ) + + + expect_dfs_equal( + base = expected_output, + compare = actual_output, + keys = c("STUDYID", "USUBJID", "PARAMCD", "PARAM", "AVISITN", "AVISIT", "DTYPE") + ) +}) diff --git a/tests/testthat/test-derive_merged.R b/tests/testthat/test-derive_merged.R index 9d4fea987b..9c4e7833bc 100644 --- a/tests/testthat/test-derive_merged.R +++ b/tests/testthat/test-derive_merged.R @@ -34,7 +34,6 @@ vs <- tibble::tribble( "ST42-2", "HEIGHT", "Height", 58, 2 ) %>% mutate(STUDYID = "ST42") - # derive_vars_merged ---- ## Test 1: merge all variables ---- test_that("derive_vars_merged Test 1: merge all variables", { @@ -93,11 +92,12 @@ test_that("derive_vars_merged Test 3: merge last value and flag matched by group ## Test 4: error if variable in both datasets ---- test_that("derive_vars_merged Test 4: error if variable in both datasets", { - expect_error(derive_vars_merged(advs, - dataset_add = adsl, - by_vars = vars(USUBJID) - ), - regexp = "" + expect_error( + derive_vars_merged(advs, + dataset_add = adsl, + by_vars = vars(USUBJID) + ), + regexp = "" ) }) @@ -170,7 +170,7 @@ test_that("derive_vars_merged_dtm Test 6: merge first date", { # derive_var_merged_cat ---- ## Test 7: merge categorized variable ---- -test_that("derive_vars_merged_cat Test 7: merge categorized variable", { +test_that("derive_var_merged_cat Test 7: merge categorized variable", { get_region <- function(x) { if_else(x %in% c("AUT", "NOR"), "EUROPE", "AFRICA") } @@ -197,7 +197,7 @@ test_that("derive_vars_merged_cat Test 7: merge categorized variable", { }) ## Test 8: define value for non-matched by groups ---- -test_that("derive_vars_merged_cat Test 8: define value for non-matched by groups", { +test_that("derive_var_merged_cat Test 8: define value for non-matched by groups", { get_vscat <- function(x) { if_else(x == "BASELINE", "BASELINE", "POST-BASELINE") } @@ -228,7 +228,7 @@ test_that("derive_vars_merged_cat Test 8: define value for non-matched by groups # derive_var_merged_exist_flag ---- ## Test 9: merge existence flag ---- -test_that("derive_vars_merged_exist_flag Test 9: merge existence flag", { +test_that("derive_var_merged_exist_flag Test 9: merge existence flag", { actual <- derive_var_merged_exist_flag( adsl, dataset_add = advs, @@ -249,8 +249,8 @@ test_that("derive_vars_merged_exist_flag Test 9: merge existence flag", { }) # derive_var_merged_character ---- -## Test 10: merge character variable, no transformation ---- -test_that("derive_var_merged_character Test 10: merge character variable, no transformation", { +## Test 10: no transformation ---- +test_that("derive_var_merged_character Test 10: no transformation", { actual <- derive_var_merged_character( adsl, dataset_add = advs, @@ -272,8 +272,8 @@ test_that("derive_var_merged_character Test 10: merge character variable, no tra ) }) -## Test 11: merge character variable, upper case ---- -test_that("derive_var_merged_character Test 11: merge character variable, upper case", { +## Test 11: upper case ---- +test_that("derive_var_merged_character Test 11: upper case", { actual <- derive_var_merged_character( adsl, dataset_add = advs, @@ -297,8 +297,8 @@ test_that("derive_var_merged_character Test 11: merge character variable, upper ) }) -## Test 12: merge character variable, lower case ---- -test_that("derive_var_merged_character Test 12: merge character variable, lower case", { +## Test 12: lower case ---- +test_that("derive_var_merged_character Test 12: lower case", { actual <- derive_var_merged_character( adsl, dataset_add = advs, @@ -321,8 +321,8 @@ test_that("derive_var_merged_character Test 12: merge character variable, lower ) }) -## Test 13: merge character variable, title case ---- -test_that("derive_var_merged_character Test 13: merge character variable, title case", { +## Test 13: title case ---- +test_that("derive_var_merged_character Test 13: title case", { actual <- derive_var_merged_character( adsl, dataset_add = advs, @@ -345,9 +345,8 @@ test_that("derive_var_merged_character Test 13: merge character variable, title ) }) - - -## Test 14: merge lookup table +# derive_vars_merged_lookup ---- +## Test 14: merge lookup table ---- test_that("derive_vars_merged_lookup Test 14: merge lookup table", { param_lookup <- tibble::tribble( ~VSTESTCD, ~VSTEST, ~PARAMCD, ~DESCRIPTION, @@ -379,3 +378,141 @@ test_that("derive_vars_merged_lookup Test 14: merge lookup table", { keys = c("USUBJID", "VSSEQ", "VSTESTCD") ) }) + + + +## the lookup table +## Test 15: all by_vars have records in the lookup table ---- +test_that("derive_vars_merged_lookup Test 15: all by_vars have records in the lookup table", { + param_lookup <- tibble::tribble( + ~VSTESTCD, ~VSTEST, ~PARAMCD, ~DESCRIPTION, + "WEIGHT", "Weight", "WEIGHT", "Weight (kg)", + "HEIGHT", "Height", "HEIGHT", "Height (cm)", + "BMI", "Body Mass Index", "BMI", "Body Mass Index(kg/m^2)", + "DIABP", "Diastolic Blood Pressure", "DIABP", "Diastolic Blood Pressure (mmHg)" + ) + + attr(param_lookup$VSTESTCD, "label") <- "Vital Signs Test Short Name" + attr(param_lookup$VSTEST, "label") <- "Vital Signs Test Name" + + + actual <- derive_vars_merged_lookup( + vs, + dataset_add = param_lookup, + by_vars = vars(VSTESTCD, VSTEST), + new_var = vars(PARAMCD, PARAM = DESCRIPTION), + print_not_mapped = TRUE + ) + + expected <- + left_join(vs, param_lookup, by = c("VSTESTCD", "VSTEST")) %>% + rename(PARAM = DESCRIPTION) + + + expect_dfs_equal( + base = expected, + compare = actual, + keys = c("USUBJID", "VSSEQ", "VSTESTCD") + ) +}) + +# get_not_mapped ---- +## Test 16: not all by_vars have records in the lookup table ---- +test_that("get_not_mapped Test 16: not all by_vars have records in the lookup table", { + param_lookup <- tibble::tribble( + ~VSTESTCD, ~VSTEST, ~PARAMCD, ~DESCRIPTION, + "WEIGHT", "Weight", "WEIGHT", "Weight (kg)", + "HEIGHT", "Height", "HEIGHT", "Height (cm)", + "BMI", "Body Mass Index", "BMI", "Body Mass Index(kg/m^2)" + ) + + attr(param_lookup$VSTESTCD, "label") <- "Vital Signs Test Short Name" + attr(param_lookup$VSTEST, "label") <- "Vital Signs Test Name" + + + act_vs_param <- derive_vars_merged_lookup( + vs, + dataset_add = param_lookup, + by_vars = vars(VSTESTCD, VSTEST), + new_var = vars(PARAMCD, PARAM = DESCRIPTION), + print_not_mapped = TRUE + ) + + actual <- get_not_mapped() + + expected <- left_join(vs, param_lookup, by = c("VSTESTCD", "VSTEST")) %>% + rename(PARAM = DESCRIPTION) %>% + filter(is.na(PARAMCD)) %>% + select(VSTESTCD, VSTEST) %>% + distinct() + + expect_dfs_equal( + base = expected, + compare = actual, + keys = c("VSTESTCD", "VSTEST") + ) +}) + +# derive_var_merged_summary ---- +## Test 17: dataset == dataset_add, no filter ---- +test_that("derive_var_merged_summary Test 17: dataset == dataset_add, no filter", { + expected <- tibble::tribble( + ~AVISIT, ~ASEQ, ~AVAL, ~MEANVIS, + "WEEK 1", 1, 10, 10, + "WEEK 1", 2, NA, 10, + "WEEK 2", 3, NA, NA, + "WEEK 3", 4, 42, 42, + "WEEK 4", 5, 12, 13, + "WEEK 4", 6, 12, 13, + "WEEK 4", 7, 15, 13 + ) + + adbds <- select(expected, -MEANVIS) + + expect_dfs_equal( + base = expected, + compare = derive_var_merged_summary( + adbds, + dataset_add = adbds, + by_vars = vars(AVISIT), + new_var = MEANVIS, + analysis_var = AVAL, + summary_fun = function(x) mean(x, na.rm = TRUE) + ), + keys = c("AVISIT", "ASEQ") + ) +}) + +## Test 18: dataset != dataset_add, filter ---- +test_that("derive_var_merged_summary Test 18: dataset != dataset_add, filter", { + expected <- tibble::tribble( + ~USUBJID, ~MEANPBL, + "1", 13.5, + "2", NA, + "3", 42.0 + ) + + adbds <- tibble::tribble( + ~USUBJID, ~ADY, ~AVAL, + "1", -3, 10, + "1", 2, 12, + "1", 8, 15, + "3", 4, 42 + ) + + adsl <- select(expected, -MEANPBL) + + expect_dfs_equal( + base = expected, + compare = derive_var_merged_summary( + adsl, + dataset_add = adbds, + by_vars = vars(USUBJID), + new_var = MEANPBL, + filter_add = ADY > 0, + analysis_var = AVAL, + summary_fun = function(x) mean(x, na.rm = TRUE) + ), + keys = c("USUBJID") + ) +}) diff --git a/tests/testthat/test-derive_param_doseint.R b/tests/testthat/test-derive_param_doseint.R index 403e4df785..914aa9360a 100644 --- a/tests/testthat/test-derive_param_doseint.R +++ b/tests/testthat/test-derive_param_doseint.R @@ -35,11 +35,12 @@ test_that("new observations are derived correctly when zero_doses is NULL", { select(-AVAL.TSNDOSE, -AVAL.TNDOSE) expected_output <- bind_rows(input, new_obs) - expect_dfs_equal(derive_param_doseint(input, - by_vars = vars(USUBJID, VISIT) - ), - expected_output, - keys = c("USUBJID", "PARAMCD", "VISIT") + expect_dfs_equal( + derive_param_doseint(input, + by_vars = vars(USUBJID, VISIT) + ), + expected_output, + keys = c("USUBJID", "PARAMCD", "VISIT") ) }) @@ -84,11 +85,12 @@ test_that("new observations are derived correctly when zero_doses is Y", { select(-AVAL.TSNDOSE, -AVAL.TNDOSE) expected_output <- bind_rows(input, new_obs) - expect_dfs_equal(derive_param_doseint(input, - by_vars = vars(USUBJID, VISIT), - zero_doses = "100" - ), - expected_output, - keys = c("USUBJID", "PARAMCD", "VISIT") + expect_dfs_equal( + derive_param_doseint(input, + by_vars = vars(USUBJID, VISIT), + zero_doses = "100" + ), + expected_output, + keys = c("USUBJID", "PARAMCD", "VISIT") ) }) diff --git a/tests/testthat/test-derive_param_exist_flag.R b/tests/testthat/test-derive_param_exist_flag.R index 01da7207f3..a5a1500c86 100644 --- a/tests/testthat/test-derive_param_exist_flag.R +++ b/tests/testthat/test-derive_param_exist_flag.R @@ -84,3 +84,26 @@ test_that("derive_param_exist_flag Test 2: error is issued if aval_fun returns w fixed = TRUE ) }) + + +## derive_param_exist_flag Test 3: error is issued if paramter already exists in dataset ---- +test_that("derive_param_exist_flag Test 3: error is issued if paramter already exists in dataset", { + expect_error( + derive_param_exist_flag( + dataset = adrs, + dataset_adsl = adsl, + dataset_add = adrs, + filter_add = PARAMCD == "OVR", + condition = AVALC == "PD", + false_value = "N", + set_values_to = vars( + PARAMCD = "OVR", + ANL01FL = "Y" + ) + ), + regexp = paste( + "The parameter code 'OVR' does already exist in `dataset`." + ), + fixed = TRUE + ) +}) diff --git a/tests/testthat/test-derive_param_exposure.R b/tests/testthat/test-derive_param_exposure.R index 77c10053b0..9ddfaece28 100644 --- a/tests/testthat/test-derive_param_exposure.R +++ b/tests/testthat/test-derive_param_exposure.R @@ -1,19 +1,19 @@ input <- tibble::tribble( - ~USUBJID, ~VISIT, ~PARAMCD, ~AVAL, ~AVALC, ~EXSTDTC, ~EXENDTC, - "01-701-1015", "BASELINE", "DOSE", 80, NA, "2020-07-01", "2020-07-14", - "01-701-1015", "WEEK 2", "DOSE", 80, NA, "2020-07-15", "2020-09-23", - "01-701-1015", "WEEK 12", "DOSE", 65, NA, "2020-09-24", "2020-12-16", - "01-701-1015", "WEEK 24", "DOSE", 65, NA, "2020-12-17", "2021-06-02", - "01-701-1015", "BASELINE", "ADJ", NA, NA, "2020-07-01", "2020-07-14", - "01-701-1015", "WEEK 2", "ADJ", NA, "Y", "2020-07-15", "2020-09-23", - "01-701-1015", "WEEK 12", "ADJ", NA, "Y", "2020-09-24", "2020-12-16", - "01-701-1015", "WEEK 24", "ADJ", NA, NA, "2020-12-17", "2021-06-02", - "01-701-1281", "BASELINE", "DOSE", 80, NA, "2020-07-03", "2020-07-18", - "01-701-1281", "WEEK 2", "DOSE", 80, NA, "2020-07-19", "2020-10-01", - "01-701-1281", "WEEK 12", "DOSE", 82, NA, "2020-10-02", "2020-12-01", - "01-701-1281", "BASELINE", "ADJ", NA, NA, "2020-07-03", "2020-07-18", - "01-701-1281", "WEEK 2", "ADJ", NA, NA, "2020-07-19", "2020-10-01", - "01-701-1281", "WEEK 12", "ADJ", NA, NA, "2020-10-02", "2020-12-01" + ~USUBJID, ~VISIT, ~PARAMCD, ~AVAL, ~AVALC, ~EXSTDTC, ~EXENDTC, + "01-701-1015", "BASELINE", "DOSE", 80, NA, "2020-07-01", "2020-07-14", + "01-701-1015", "WEEK 2", "DOSE", 80, NA, "2020-07-15", "2020-09-23", + "01-701-1015", "WEEK 12", "DOSE", 65, NA, "2020-09-24", "2020-12-16", + "01-701-1015", "WEEK 24", "DOSE", 65, NA, "2020-12-17", "2021-06-02", + "01-701-1015", "BASELINE", "ADJ", NA, NA, "2020-07-01", "2020-07-14", + "01-701-1015", "WEEK 2", "ADJ", NA, "Y", "2020-07-15", "2020-09-23", + "01-701-1015", "WEEK 12", "ADJ", NA, "Y", "2020-09-24", "2020-12-16", + "01-701-1015", "WEEK 24", "ADJ", NA, NA, "2020-12-17", "2021-06-02", + "01-701-1281", "BASELINE", "DOSE", 80, NA, "2020-07-03", "2020-07-18", + "01-701-1281", "WEEK 2", "DOSE", 80, NA, "2020-07-19", "2020-10-01", + "01-701-1281", "WEEK 12", "DOSE", 82, NA, "2020-10-02", "2020-12-01", + "01-701-1281", "BASELINE", "ADJ", NA, NA, "2020-07-03", "2020-07-18", + "01-701-1281", "WEEK 2", "ADJ", NA, NA, "2020-07-19", "2020-10-01", + "01-701-1281", "WEEK 12", "ADJ", NA, NA, "2020-10-02", "2020-12-01" ) %>% mutate( ASTDTM = ymd_hms(paste(EXSTDTC, "T00:00:00")), @@ -22,7 +22,13 @@ input <- tibble::tribble( AENDT = date(AENDTM) ) -test_that("new observations are derived correctly for AVAL", { +input_no_dtm <- input %>% + select(-ASTDTM, -AENDTM) + +# ---- derive_param_exposure, test 1: New observations are derived correctly ---- +# ---- for AVAL ---- +test_that("derive_param_exposure Test 1: New observations are derived correctly + for AVAL", { new_obs1 <- input %>% filter(PARAMCD == "DOSE") %>% group_by(USUBJID) %>% @@ -85,7 +91,74 @@ test_that("new observations are derived correctly for AVAL", { ) }) -test_that("Errors", { +# ---- derive_param_exposure, test 2: New observations are derived correctly ---- +# ---- for AVAL, when the input dataset only contains AxxDT variables ---- +test_that("derive_param_exposure Test 2: New observations are derived correctly + for AVAL, when the input dataset only contains AxxDT variables", { + new_obs1 <- input_no_dtm %>% + filter(PARAMCD == "DOSE") %>% + group_by(USUBJID) %>% + summarise( + AVAL = sum(AVAL, na.rm = TRUE), + ASTDT = min(ASTDT, na.rm = TRUE), + AENDT = max(AENDT, na.rm = TRUE) + ) %>% + mutate(PARAMCD = "TDOSE", PARCAT1 = "OVERALL") + + new_obs2 <- input_no_dtm %>% + filter(PARAMCD == "DOSE") %>% + group_by(USUBJID) %>% + summarise( + AVAL = mean(AVAL, na.rm = TRUE), + ASTDT = min(ASTDT, na.rm = TRUE), + AENDT = max(AENDT, na.rm = TRUE) + ) %>% + mutate(PARAMCD = "AVDOSE", PARCAT1 = "OVERALL") + + new_obs3 <- input_no_dtm %>% + filter(PARAMCD == "ADJ") %>% + group_by(USUBJID) %>% + summarise( + AVALC = if_else(sum(!is.na(AVALC)) > 0, "Y", NA_character_), + ASTDT = min(ASTDT, na.rm = TRUE), + AENDT = max(AENDT, na.rm = TRUE) + ) %>% + mutate(PARAMCD = "TADJ", PARCAT1 = "OVERALL") + + expected_output <- bind_rows(input_no_dtm, new_obs1, new_obs2, new_obs3) + + actual_output <- input_no_dtm %>% + derive_param_exposure( + by_vars = vars(USUBJID), + input_code = "DOSE", + analysis_var = AVAL, + summary_fun = function(x) sum(x, na.rm = TRUE), + set_values_to = vars(PARAMCD = "TDOSE", PARCAT1 = "OVERALL") + ) %>% + derive_param_exposure( + by_vars = vars(USUBJID), + input_code = "DOSE", + analysis_var = AVAL, + summary_fun = function(x) mean(x, na.rm = TRUE), + set_values_to = vars(PARAMCD = "AVDOSE", PARCAT1 = "OVERALL") + ) %>% + derive_param_exposure( + by_vars = vars(USUBJID), + input_code = "ADJ", + analysis_var = AVALC, + summary_fun = function(x) if_else(sum(!is.na(x)) > 0, "Y", NA_character_), + set_values_to = vars(PARAMCD = "TADJ", PARCAT1 = "OVERALL") + ) + + expect_dfs_equal( + actual_output, + expected_output, + keys = c("USUBJID", "VISIT", "PARAMCD") + ) +}) + +# ---- derive_param_exposure, test 3: Errors ---- +test_that("derive_param_exposure, test 3: Errors", { # PARAMCD must be specified expect_error( input <- input %>% diff --git a/tests/testthat/test-derive_param_extreme_event.R b/tests/testthat/test-derive_param_extreme_event.R new file mode 100644 index 0000000000..f4cf8bb810 --- /dev/null +++ b/tests/testthat/test-derive_param_extreme_event.R @@ -0,0 +1,170 @@ +adsl <- tibble::tribble( + ~USUBJID, ~DTHDT, + "1", ymd("2022-05-13"), + "2", ymd(""), + "3", ymd("") +) %>% + mutate(STUDYID = "XX1234") + +adrs <- tibble::tribble( + ~USUBJID, ~ADTC, ~AVALC, ~PARAMCD, + "1", "2020-01-02", "PR", "OVR", + "1", "2020-02-01", "CR", "OVR", + "1", "2020-03-01", "CR", "OVR", + "1", "2020-04-01", "SD", "OVR", + "2", "2021-06-15", "SD", "OVR", + "2", "2021-07-16", "PD", "OVR", + "2", "2021-09-14", "PD", "OVR", + "1", "2020-01-02", "PR", "OVRF", + "1", "2020-02-01", "CR", "OVRF", + "1", "2020-03-01", "CR", "OVRF", + "1", "2020-04-01", "PD", "OVRF", + "2", "2021-06-15", "SD", "OVRF", + "2", "2021-07-16", "PD", "OVRF", + "2", "2021-09-14", "PD", "OVRF" +) %>% + mutate( + STUDYID = "XX1234", + ADT = ymd(ADTC) + ) %>% + select(-ADTC) + +# derive_param_extreme_event ---- +## Test 1: derive first PD date ---- +test_that("derive_param_extreme_event Test 1: derive first PD date", { + actual <- derive_param_extreme_event( + adrs, + dataset_adsl = adsl, + dataset_source = adrs, + filter_source = PARAMCD == "OVR" & AVALC == "PD", + order = vars(ADT), + set_values_to = vars( + PARAMCD = "PD", + ANL01FL = "Y", + ADT = ADT + ) + ) + + expected <- bind_rows( + adrs, + tibble::tribble( + ~USUBJID, ~ADT, ~AVALC, + "1", ymd(""), "N", + "2", ymd("2021-07-16"), "Y", + "3", ymd(""), "N" + ) %>% + mutate( + STUDYID = "XX1234", + PARAMCD = "PD", + ANL01FL = "Y" + ) + ) + + expect_dfs_equal( + base = expected, + comp = actual, + keys = c("USUBJID", "PARAMCD", "ADT") + ) +}) + +## Test 2: derive death date parameter ---- +test_that("derive_param_extreme_event Test 2: derive death date parameter", { + actual <- derive_param_extreme_event( + dataset_adsl = adsl, + dataset_source = adsl, + filter_source = !is.na(DTHDT), + new_var = AVAL, + true_value = 1, + false_value = 0, + mode = "first", + set_values_to = vars( + PARAMCD = "DEATH", + ANL01FL = "Y", + ADT = DTHDT + ) + ) + + expected <- tibble::tribble( + ~USUBJID, ~ADT, ~AVAL, ~DTHDT, + "1", ymd("2022-05-13"), 1, ymd("2022-05-13"), + "2", ymd(""), 0, ymd(""), + "3", ymd(""), 0, ymd("") + ) %>% + mutate( + STUDYID = "XX1234", + PARAMCD = "DEATH", + ANL01FL = "Y" + ) + + expect_dfs_equal( + base = expected, + comp = actual, + keys = c("USUBJID", "PARAMCD", "ADT") + ) +}) + +adrs <- tibble::tribble( + ~USUBJID, ~ADTC, ~AVALC, ~PARAMCD, + "1", "2020-01-02", "PR", "OVR", + "1", "2020-02-01", "CR", "OVR", + "1", "2020-03-01", "NE", "OVR", + "1", "2020-04-01", "SD", "OVR", + "2", "2021-06-15", "SD", "OVR", + "2", "2021-07-16", "SD", "OVR", + "2", "2021-09-14", "NE", "OVR", + "3", "2021-08-03", "NE", "OVR", + "1", "2020-01-02", "PR", "OVRF", + "1", "2020-02-01", "CR", "OVRF", + "1", "2020-03-01", "NE", "OVRF", + "1", "2020-04-01", "SD", "OVRF", + "2", "2021-06-15", "SD", "OVRF", + "2", "2021-07-16", "SD", "OVRF", + "2", "2021-09-14", "NE", "OVRF", + "3", "2021-08-03", "NE", "OVRF" +) %>% + mutate( + STUDYID = "XX1234", + ADT = ymd(ADTC) + ) %>% + select(-ADTC) + +## Test 3: derive latest evaluable tumor assessment date parameter ---- +test_that("derive_param_extreme_event Test 3: latest evaluable tumor assessment date parameter", { + actual <- derive_param_extreme_event( + dataset = adrs, + dataset_adsl = adsl, + dataset_source = adrs, + filter_source = PARAMCD == "OVR" & AVALC != "NE", + order = vars(ADT), + new_var = AVALC, + true_value = "Y", + false_value = "N", + mode = "last", + set_values_to = vars( + PARAMCD = "LSTEVLDT", + ANL01FL = "Y", + ADT = ADT + ) + ) + + expected <- bind_rows( + adrs, + tibble::tribble( + ~USUBJID, ~ADT, ~AVALC, + "1", ymd("2020-04-01"), "Y", + "2", ymd("2021-07-16"), "Y", + "3", ymd(""), "N" + ) %>% + mutate( + STUDYID = "XX1234", + PARAMCD = "LSTEVLDT", + ANL01FL = "Y" + ) + ) + + expect_dfs_equal( + base = expected, + comp = actual, + keys = c("USUBJID", "PARAMCD", "ADT") + ) +}) diff --git a/tests/testthat/test-derive_param_first_event.R b/tests/testthat/test-derive_param_first_event.R deleted file mode 100644 index eb978f3fa3..0000000000 --- a/tests/testthat/test-derive_param_first_event.R +++ /dev/null @@ -1,103 +0,0 @@ -adsl <- tibble::tribble( - ~USUBJID, ~DTHDT, - "1", ymd("2022-05-13"), - "2", ymd(""), - "3", ymd("") -) %>% - mutate(STUDYID = "XX1234") - -adrs <- tibble::tribble( - ~USUBJID, ~ADTC, ~AVALC, ~PARAMCD, - "1", "2020-01-02", "PR", "OVR", - "1", "2020-02-01", "CR", "OVR", - "1", "2020-03-01", "CR", "OVR", - "1", "2020-04-01", "SD", "OVR", - "2", "2021-06-15", "SD", "OVR", - "2", "2021-07-16", "PD", "OVR", - "2", "2021-09-14", "PD", "OVR", - "1", "2020-01-02", "PR", "OVRF", - "1", "2020-02-01", "CR", "OVRF", - "1", "2020-03-01", "CR", "OVRF", - "1", "2020-04-01", "PD", "OVRF", - "2", "2021-06-15", "SD", "OVRF", - "2", "2021-07-16", "PD", "OVRF", - "2", "2021-09-14", "PD", "OVRF" -) %>% - mutate( - STUDYID = "XX1234", - ADT = ymd(ADTC) - ) %>% - select(-ADTC) - -# derive_param_first_event ---- -## derive_param_first_event Test 1: derive first PD date ---- -test_that("derive_param_first_event Test 1: derive first PD date", { - actual <- derive_param_first_event( - adrs, - dataset_adsl = adsl, - dataset_source = adrs, - filter_source = PARAMCD == "OVR" & AVALC == "PD", - date_var = ADT, - set_values_to = vars( - PARAMCD = "PD", - ANL01FL = "Y" - ) - ) - - expected <- bind_rows( - adrs, - tibble::tribble( - ~USUBJID, ~ADT, ~AVALC, ~AVAL, - "1", ymd(""), "N", 0, - "2", ymd("2021-07-16"), "Y", 1, - "3", ymd(""), "N", 0 - ) %>% - mutate( - STUDYID = "XX1234", - PARAMCD = "PD", - ANL01FL = "Y" - ) - ) - - expect_dfs_equal( - base = expected, - comp = actual, - keys = c("USUBJID", "PARAMCD", "ADT") - ) -}) - -## derive_param_first_event Test 2: derive death date parameter ---- -test_that("derive_param_first_event Test 2: derive death date parameter", { - actual <- derive_param_first_event( - dataset = adrs, - dataset_adsl = adsl, - dataset_source = adsl, - filter_source = !is.na(DTHDT), - date_var = DTHDT, - set_values_to = vars( - PARAMCD = "DEATH", - ANL01FL = "Y" - ) - ) - - expected <- bind_rows( - adrs, - tibble::tribble( - ~USUBJID, ~ADT, ~AVALC, ~AVAL, ~DTHDT, - "1", ymd("2022-05-13"), "Y", 1, ymd("2022-05-13"), - "2", ymd(""), "N", 0, ymd(""), - "3", ymd(""), "N", 0, ymd("") - ) %>% - mutate( - STUDYID = "XX1234", - PARAMCD = "DEATH", - ANL01FL = "Y" - ) - ) - - expect_dfs_equal( - base = expected, - comp = actual, - keys = c("USUBJID", "PARAMCD", "ADT") - ) -}) diff --git a/tests/testthat/test-derive_param_tte.R b/tests/testthat/test-derive_param_tte.R index c5fd6d5268..cdc8fe4564 100644 --- a/tests/testthat/test-derive_param_tte.R +++ b/tests/testthat/test-derive_param_tte.R @@ -1,10 +1,7 @@ -library(tibble) -library(lubridate) - # derive_param_tte ---- ## Test 1: new observations with analysis date are derived correctly ---- test_that("derive_param_tte Test 1: new observations with analysis date are derived correctly", { - adsl <- tribble( + adsl <- tibble::tribble( ~USUBJID, ~DTHFL, ~DTHDT, ~LSTALVDT, ~TRTSDT, ~TRTSDTF, "03", "Y", ymd("2021-08-21"), ymd("2021-08-21"), ymd("2021-08-10"), NA, "04", "N", NA, ymd("2021-05-24"), ymd("2021-02-03"), NA @@ -33,10 +30,10 @@ test_that("derive_param_tte Test 1: new observations with analysis date are deri ) ) - expected_output <- tribble( + expected_output <- tibble::tribble( ~USUBJID, ~ADT, ~CNSR, ~EVENTDESC, ~SRCDOM, ~SRCVAR, - "03", ymd("2021-08-21"), 0L, "DEATH", "ADSL", "DTHDT", - "04", ymd("2021-05-24"), 1L, "LAST KNOWN ALIVE DATE", "ADSL", "LSTALVDT" + "03", ymd("2021-08-21"), 0L, "DEATH", "ADSL", "DTHDT", + "04", ymd("2021-05-24"), 1L, "LAST KNOWN ALIVE DATE", "ADSL", "LSTALVDT" ) %>% mutate( STUDYID = "AB42", @@ -78,13 +75,13 @@ test_that("derive_param_tte Test 2: new parameter with analysis datetime is deri adrs <- tibble::tribble( ~USUBJID, ~AVALC, ~ADTM, ~ASEQ, - "01", "SD", ymd_hms("2021-01-03 10:56:00"), 1, - "01", "PR", ymd_hms("2021-03-04 11:13:00"), 2, - "01", "PD", ymd_hms("2021-05-05 12:02:00"), 3, - "02", "PD", ymd_hms("2021-02-03 10:56:00"), 1, - "04", "SD", ymd_hms("2021-02-13 10:56:00"), 1, - "04", "PR", ymd_hms("2021-04-14 11:13:00"), 2, - "04", "CR", ymd_hms("2021-05-15 12:02:00"), 3 + "01", "SD", ymd_hms("2021-01-03 10:56:00"), 1, + "01", "PR", ymd_hms("2021-03-04 11:13:00"), 2, + "01", "PD", ymd_hms("2021-05-05 12:02:00"), 3, + "02", "PD", ymd_hms("2021-02-03 10:56:00"), 1, + "04", "SD", ymd_hms("2021-02-13 10:56:00"), 1, + "04", "PR", ymd_hms("2021-04-14 11:13:00"), 2, + "04", "CR", ymd_hms("2021-05-15 12:02:00"), 3 ) %>% mutate(STUDYID = "AB42", PARAMCD = "OVR") @@ -134,13 +131,13 @@ test_that("derive_param_tte Test 2: new parameter with analysis datetime is deri ) # nolint start - expected_output <- tribble( + expected_output <- tibble::tribble( ~USUBJID, ~ADTM, ~CNSR, ~EVENTDESC, ~SRCDOM, ~SRCVAR, ~SRCSEQ, - "01", ymd_hms("2021-05-05 12:02:00"), 0L, "PD", "ADRS", "ADTM", 3, - "02", ymd_hms("2021-02-03 10:56:00"), 0L, "PD", "ADRS", "ADTM", 1, - "03", as_datetime(ymd("2021-08-21")), 0L, "DEATH", "ADSL", "DTHDT", NA, - "04", ymd_hms("2021-05-15 12:02:00"), 1L, "LAST TUMOR ASSESSMENT", "ADRS", "ADTM", NA, - "05", ymd_hms("2021-04-05 11:22:33"), 1L, "TREATMENT START", "ADSL", "TRTSDTM", NA + "01", ymd_hms("2021-05-05 12:02:00"), 0L, "PD", "ADRS", "ADTM", 3, + "02", ymd_hms("2021-02-03 10:56:00"), 0L, "PD", "ADRS", "ADTM", 1, + "03", as_datetime(ymd("2021-08-21")), 0L, "DEATH", "ADSL", "DTHDT", NA, + "04", ymd_hms("2021-05-15 12:02:00"), 1L, "LAST TUMOR ASSESSMENT", "ADRS", "ADTM", NA, + "05", ymd_hms("2021-04-05 11:22:33"), 1L, "TREATMENT START", "ADSL", "TRTSDTM", NA ) %>% # nolint end mutate( @@ -184,9 +181,9 @@ test_that("derive_param_tte Test 3: error is issued if DTC variables specified f ae <- tibble::tribble( ~USUBJID, ~AESTDTC, ~AESEQ, - "01", "2021-01-03T10:56", 1, - "01", "2021-03-04", 2, - "01", "2021", 3 + "01", "2021-01-03T10:56", 1, + "01", "2021-03-04", 2, + "01", "2021", 3 ) %>% mutate(STUDYID = "AB42") @@ -239,9 +236,9 @@ test_that("derive_param_tte Test 4: by_vars parameter works correctly", { ae <- tibble::tribble( ~USUBJID, ~AESTDTC, ~AESEQ, ~AEDECOD, - "01", "2021-01-03", 1, "Flu", - "01", "2021-03-04", 2, "Cough", - "01", "2021-01-01", 3, "Flu" + "01", "2021-01-03", 1, "Flu", + "01", "2021-03-04", 2, "Cough", + "01", "2021-01-01", 3, "Flu" ) %>% mutate( STUDYID = "AB42", @@ -273,10 +270,10 @@ test_that("derive_param_tte Test 4: by_vars parameter works correctly", { # nolint start expected_output <- tibble::tribble( ~USUBJID, ~ADT, ~CNSR, ~EVENTDESC, ~SRCDOM, ~SRCVAR, ~SRCSEQ, ~PARCAT2, ~PARAMCD, - "01", ymd("2021-01-01"), 0L, "AE", "AE", "AESTDTC", 3, "Flu", "TTAE2", - "02", ymd("2021-02-03"), 1L, "END OF STUDY", "ADSL", "EOSDT", NA, "Flu", "TTAE2", - "01", ymd("2021-03-04"), 0L, "AE", "AE", "AESTDTC", 2, "Cough", "TTAE1", - "02", ymd("2021-02-03"), 1L, "END OF STUDY", "ADSL", "EOSDT", NA, "Cough", "TTAE1" + "01", ymd("2021-01-01"), 0L, "AE", "AE", "AESTDTC", 3, "Flu", "TTAE2", + "02", ymd("2021-02-03"), 1L, "END OF STUDY", "ADSL", "EOSDT", NA, "Flu", "TTAE2", + "01", ymd("2021-03-04"), 0L, "AE", "AE", "AESTDTC", 2, "Cough", "TTAE1", + "02", ymd("2021-02-03"), 1L, "END OF STUDY", "ADSL", "EOSDT", NA, "Cough", "TTAE1" ) %>% # nolint end mutate( @@ -308,18 +305,18 @@ test_that("derive_param_tte Test 4: by_vars parameter works correctly", { ## Test 5: an error is issued if some of the by variables are missing ---- test_that("derive_param_tte Test 5: an error is issued if some of the by variables are missing", { - adsl <- tribble( + adsl <- tibble::tribble( ~USUBJID, ~TRTSDT, ~EOSDT, "01", ymd("2020-12-06"), ymd("2021-03-06"), "02", ymd("2021-01-16"), ymd("2021-02-03") ) %>% mutate(STUDYID = "AB42") - ae <- tribble( + ae <- tibble::tribble( ~USUBJID, ~AESTDTC, ~AESEQ, ~AEDECOD, - "01", "2021-01-03", 1, "Flu", - "01", "2021-03-04", 2, "Cough", - "01", "2021-01-01", 3, "Flu" + "01", "2021-01-03", 1, "Flu", + "01", "2021-03-04", 2, "Cough", + "01", "2021-01-01", 3, "Flu" ) %>% mutate( STUDYID = "AB42", @@ -369,7 +366,7 @@ test_that("derive_param_tte Test 5: an error is issued if some of the by variabl ## Test 6: errors if all by vars are missing in all source datasets ---- test_that("derive_param_tte Test 6: errors if all by vars are missing in all source datasets", { - adsl <- tribble( + adsl <- tibble::tribble( ~USUBJID, ~TRTSDT, ~EOSDT, "01", ymd("2020-12-06"), ymd("2021-03-06"), "02", ymd("2021-01-16"), ymd("2021-02-03") @@ -378,9 +375,9 @@ test_that("derive_param_tte Test 6: errors if all by vars are missing in all sou ae <- tibble::tribble( ~USUBJID, ~AESTDTC, ~AESEQ, ~AEDECOD, - "01", "2021-01-03", 1, "Flu", - "01", "2021-03-04", 2, "Cough", - "01", "2021-01-01", 3, "Flu" + "01", "2021-01-03", 1, "Flu", + "01", "2021-03-04", 2, "Cough", + "01", "2021-01-01", 3, "Flu" ) %>% mutate( STUDYID = "AB42", @@ -431,18 +428,18 @@ test_that("derive_param_tte Test 6: errors if all by vars are missing in all sou ## Test 7: errors if PARAMCD and by_vars are not one to one ---- test_that("derive_param_tte Test 7: errors if PARAMCD and by_vars are not one to one", { - adsl <- tribble( + adsl <- tibble::tribble( ~USUBJID, ~TRTSDT, ~EOSDT, "01", ymd("2020-12-06"), ymd("2021-03-06"), "02", ymd("2021-01-16"), ymd("2021-02-03") ) %>% mutate(STUDYID = "AB42") - ae <- tribble( + ae <- tibble::tribble( ~USUBJID, ~AESTDTC, ~AESEQ, ~AEDECOD, - "01", "2021-01-03", 1, "Flu", - "01", "2021-03-04", 2, "Cough", - "01", "2021-01-01", 3, "Flu" + "01", "2021-01-03", 1, "Flu", + "01", "2021-03-04", 2, "Cough", + "01", "2021-01-01", 3, "Flu" ) %>% mutate( STUDYID = "AB42", @@ -494,18 +491,18 @@ test_that("derive_param_tte Test 7: errors if PARAMCD and by_vars are not one to ## Test 8: errors if set_values_to contains invalid expressions ---- test_that("derive_param_tte Test 8: errors if set_values_to contains invalid expressions", { - adsl <- tribble( + adsl <- tibble::tribble( ~USUBJID, ~TRTSDT, ~EOSDT, "01", ymd("2020-12-06"), ymd("2021-03-06"), "02", ymd("2021-01-16"), ymd("2021-02-03") ) %>% mutate(STUDYID = "AB42") - ae <- tribble( + ae <- tibble::tribble( ~USUBJID, ~AESTDTC, ~AESEQ, ~AEDECOD, - "01", "2021-01-03", 1, "Flu", - "01", "2021-03-04", 2, "Cough", - "01", "2021-01-01", 3, "Flu" + "01", "2021-01-03", 1, "Flu", + "01", "2021-03-04", 2, "Cough", + "01", "2021-01-01", 3, "Flu" ) %>% mutate( STUDYID = "AB42", @@ -565,18 +562,18 @@ test_that("derive_param_tte Test 8: errors if set_values_to contains invalid exp ## Test 9: error is issued if parameter code already exists ---- test_that("derive_param_tte Test 9: error is issued if parameter code already exists", { - adsl <- tribble( + adsl <- tibble::tribble( ~USUBJID, ~TRTSDT, ~EOSDT, "01", ymd("2020-12-06"), ymd("2021-03-06"), "02", ymd("2021-01-16"), ymd("2021-02-03") ) %>% mutate(STUDYID = "AB42") - ae <- tribble( + ae <- tibble::tribble( ~USUBJID, ~AESTDTC, ~AESEQ, ~AEDECOD, - "01", "2021-01-03", 1, "Flu", - "01", "2021-03-04", 2, "Cough", - "01", "2021-01-01", 3, "Flu" + "01", "2021-01-03", 1, "Flu", + "01", "2021-03-04", 2, "Cough", + "01", "2021-01-01", 3, "Flu" ) %>% mutate( STUDYID = "AB42", @@ -607,8 +604,8 @@ test_that("derive_param_tte Test 9: error is issued if parameter code already ex expected_output <- tibble::tribble( ~USUBJID, ~ADT, ~CNSR, ~EVENTDESC, ~SRCDOM, ~SRCVAR, ~SRCSEQ, - "01", ymd("2021-01-01"), 0L, "AE", "AE", "AESTDTC", 3, - "02", ymd("2021-02-03"), 1L, "END OF STUDY", "ADSL", "EOSDT", NA + "01", ymd("2021-01-01"), 0L, "AE", "AE", "AESTDTC", 3, + "02", ymd("2021-02-03"), 1L, "END OF STUDY", "ADSL", "EOSDT", NA ) %>% mutate( STUDYID = "AB42", @@ -634,30 +631,108 @@ test_that("derive_param_tte Test 9: error is issued if parameter code already ex ) }) -# print.tte_source ---- -## Test 10: tte_source` objects are printed as intended ---- -test_that("`print.tte_source Test 10: tte_source` objects are printed as intended", { +## Test 10: ensuring ADT is not NA because of missing start_date ---- +test_that("derive_param_tte Test 10: ensuring ADT is not NA because of missing start_date", { + adsl <- tibble::tribble( + ~USUBJID, ~TRTSDT, ~LSTALVDT, + "01", NA, ymd("2022-08-10"), + "02", NA, ymd("2022-09-12"), + "03", ymd("2020-10-13"), ymd("2022-07-21") + ) %>% + mutate(STUDYID = "AB42") + + ae <- tibble::tribble( + ~USUBJID, ~AESEQ, ~ASTDT, + "01", 1, ymd("2020-08-10"), + "02", 2, ymd("2020-08-15"), + "03", 3, ymd("2020-12-10"), + ) %>% + mutate(STUDYID = "AB42") + + eos <- censor_source( + "adsl", + date = LSTALVDT, + set_values_to = vars( + EVNTDESC = "Last Known Alive Date", + SRCDOM = "ADSL", + SRCVAR = "LSTALVDT" + ) + ) + ttae <- event_source( - dataset_name = "ae", - date = AESTDTC, + dataset_name = "adae", + date = ASTDT, set_values_to = vars( - EVENTDESC = "AE", - SRCDOM = "AE", - SRCVAR = "AESTDTC", + EVNTDESC = "Any Adverse Event", + SRCDOM = "ADAE", + SRCVAR = "AEDECOD", SRCSEQ = AESEQ ) ) - expected_print_output <- c( - " object", - "dataset_name: \"ae\"", - "filter: NULL", - "date: AESTDTC", - "censor: 0", - "set_values_to:", - " EVENTDESC: \"AE\"", - " SRCDOM: \"AE\"", - " SRCVAR: \"AESTDTC\"", - " SRCSEQ: AESEQ" + + actual_output <- derive_param_tte( + dataset_adsl = adsl, + source_datasets = list(adae = ae, adsl = adsl), + start_date = TRTSDT, + event_conditions = list(ttae), + censor_conditions = list(eos), + set_values_to = vars( + PARAMCD = "ANYAETTE", + PARAM = "Time to any first adverse event" + ) + ) + + expected_output <- tibble::tribble( + ~USUBJID, ~EVNTDESC, ~SRCDOM, ~SRCVAR, ~SRCSEQ, ~CNSR, ~ADT, ~STARTDT, + "01", "Any Adverse Event", "ADAE", "AEDECOD", 1, 0L, ymd("2020-08-10"), NA, + "02", "Any Adverse Event", "ADAE", "AEDECOD", 2, 0L, ymd("2020-08-15"), NA, + "03", "Any Adverse Event", "ADAE", "AEDECOD", 3, 0L, ymd("2020-12-10"), ymd("2020-10-13") # nolint + ) %>% + mutate( + STUDYID = "AB42", + PARAMCD = "ANYAETTE", + PARAM = "Time to any first adverse event" + ) + + expect_dfs_equal( + actual_output, + expected_output, + keys = c("USUBJID", "PARAMCD") + ) +}) + +## Test 11: error is issued if package does not exist ---- +test_that("list_tte_source_objects Test 10: error is issued if package does not exist", { + expect_error( + list_tte_source_objects(package = "tte"), + regexp = "No package called 'tte' is installed and hence no `tte_source` objects are available" ) - expect_identical(capture.output(print(ttae)), expected_print_output) +}) + +## Test 12: calling list_tte_source_objects results in expected output objects ---- +test_that("list_tte_source_objects Test 11: expected objects produced", { + expected_output <- tibble::tribble( + ~object, ~dataset_name, ~filter, ~date, ~censor, + "ae_ser_event", "adae", quote(TRTEMFL == "Y" & AESER == "Y"), "ASTDT", 0, + "ae_gr2_event", "adae", quote(TRTEMFL == "Y" & ATOXGR == "2"), "ASTDT", 0, + "ae_sev_event", "adae", quote(TRTEMFL == "Y" & AESEV == "SEVERE"), "ASTDT", 0, + "ae_gr4_event", "adae", quote(TRTEMFL == "Y" & ATOXGR == "4"), "ASTDT", 0, + "ae_gr3_event", "adae", quote(TRTEMFL == "Y" & ATOXGR == "3"), "ASTDT", 0, + "lastalive_censor", "adsl", NULL, "LSTALVDT", 1, + "ae_event", "adae", quote(TRTEMFL == "Y"), "ASTDT", 0, + "death_event", "adsl", quote(DTHFL == "Y"), "DTHDT", 0, + "ae_gr35_event", "adae", quote(TRTEMFL == "Y" & ATOXGR %in% c("3", "4", "5")), "ASTDT", 0, + "ae_wd_event", "adae", quote(TRTEMFL == "Y" & AEACN == "DRUG WITHDRAWN"), "ASTDT", 0, + "ae_gr1_event", "adae", quote(TRTEMFL == "Y" & ATOXGR == "1"), "ASTDT", 0, + "ae_gr5_event", "adae", quote(TRTEMFL == "Y" & ATOXGR == "5"), "ASTDT", 0, + ) %>% + mutate( + filter = as.character(filter), + censor = as.integer(censor) + ) + + observed_output <- list_tte_source_objects(package = "admiral") %>% + select(object, dataset_name, filter, date, censor) + + expect_dfs_equal(expected_output, observed_output, keys = c("object")) }) diff --git a/tests/testthat/test-derive_summary_records.R b/tests/testthat/test-derive_summary_records.R index e4535c69b1..425cbda8e8 100644 --- a/tests/testthat/test-derive_summary_records.R +++ b/tests/testthat/test-derive_summary_records.R @@ -1,6 +1,3 @@ -library(tibble) -library(dplyr) - test_that("creates a new record for each group and new data frame retains grouping", { # group --> 4 input <- tibble(x = rep(1:4, each = 4), y = rep(1:2, each = 8), z = runif(16)) @@ -12,7 +9,7 @@ test_that("creates a new record for each group and new data frame retains groupi ) expect_equal(nrow(actual_output), nrow(input) + 4) - expect_equal(group_vars(actual_output), group_vars(input)) + expect_equal(dplyr::group_vars(actual_output), dplyr::group_vars(input)) }) test_that("`fns` as inlined", { diff --git a/tests/testthat/test-derive_var_atoxgr.R b/tests/testthat/test-derive_var_atoxgr.R index f4f48d4f95..54400fcde4 100644 --- a/tests/testthat/test-derive_var_atoxgr.R +++ b/tests/testthat/test-derive_var_atoxgr.R @@ -1,7 +1,6 @@ -# derive_var_atoxgr ---- - -test_that("derive_var_atoxgr: Test 1 ATOXGR cannot be graded", { +# ---- derive_var_atoxgr, test 1: ATOXGR cannot be graded ---- +test_that("derive_var_atoxgr, test 1: ATOXGR cannot be graded", { exp_out_1 <- tibble::tribble( ~ATOXDSCL, ~ATOXDSCH, ~ATOXGRL, ~ATOXGRH, ~ATOXGR, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, @@ -27,7 +26,8 @@ test_that("derive_var_atoxgr: Test 1 ATOXGR cannot be graded", { ) }) -test_that("derive_var_atoxgr: Test 2 ATOXGR = 0 (normal)", { +# ---- derive_var_atoxgr, test 2: derive_var_atoxgr, ATOXGR = 0 (normal) ---- +test_that("derive_var_atoxgr, test 2: derive_var_atoxgr, ATOXGR = 0 (normal)", { exp_out_2 <- tibble::tribble( ~ATOXDSCL, ~ATOXDSCH, ~ATOXGRL, ~ATOXGRH, ~ATOXGR, "Hypoglycemia", "Hyperglycemia", "0", "0", "0", @@ -48,7 +48,8 @@ test_that("derive_var_atoxgr: Test 2 ATOXGR = 0 (normal)", { ) }) -test_that("derive_var_atoxgr: Test 3 ATOXGR > 0 (HYPER)", { +# ---- derive_var_atoxgr, test 3: ATOXGR > 0 (HYPER) ---- +test_that("derive_var_atoxgr, test 3: ATOXGR > 0 (HYPER)", { exp_out_3 <- tibble::tribble( ~ATOXDSCL, ~ATOXDSCH, ~ATOXGRL, ~ATOXGRH, ~ATOXGR, "Hypoglycemia", "Hyperglycemia", NA_character_, "1", "1", @@ -69,7 +70,8 @@ test_that("derive_var_atoxgr: Test 3 ATOXGR > 0 (HYPER)", { ) }) -test_that("derive_var_atoxgr: Test 4 ATOXGR < 0 (HYPO)", { +# ---- derive_var_atoxgr, test 4: ATOXGR < 0 (HYPO) ---- +test_that("derive_var_atoxgr, test 4: ATOXGR < 0 (HYPO)", { exp_out_4 <- tibble::tribble( ~ATOXDSCL, ~ATOXDSCH, ~ATOXGRL, ~ATOXGRH, ~ATOXGR, "Hypoglycemia", "Hyperglycemia", "3", NA_character_, "-3", @@ -90,166 +92,236 @@ test_that("derive_var_atoxgr: Test 4 ATOXGR < 0 (HYPO)", { ) }) +# derive_var_atoxgr_dir + +## Blood and lymphatic system disorders + +### Anemia +### NCICTCAEv4 and NCICTCAEv5 criteria is the same +### Grade 3: <80 g/L +### Grade 2: <100 - 80g/L +### Grade 1: % + select(-ATOXGRL) + +# ---- derive_var_atoxgr, test 5: CTCAEv4 Anemia ---- +test_that("derive_var_atoxgr, test 5: CTCAEv4 Anemia", { + actual_anemia_ctcv4 <- derive_var_atoxgr_dir( + input_anemia, + new_var = ATOXGRL, + meta_criteria = atoxgr_criteria_ctcv4, + tox_description_var = ATOXDSCL, + criteria_direction = "L", + get_unit_expr = AVALU + ) -## Blood and lymphatic system disorders ---- -## Grade 3: <80 g/L -## Grade 2: <100 - 80g/L -## Grade 1: % - select(-ATOXGRL) +}) - actual_output_ctcv4_1 <- derive_var_atoxgr_dir( - input_ctcv4_1, +# ---- derive_var_atoxgr, test 6: CTCAEv5 Anemia ---- +test_that("derive_var_atoxgr, test 6: CTCAEv5 Anemia", { + actual_anemia_ctcv5 <- derive_var_atoxgr_dir( + input_anemia, new_var = ATOXGRL, - meta_criteria = atoxgr_criteria_ctcv4, + meta_criteria = atoxgr_criteria_ctcv5, tox_description_var = ATOXDSCL, criteria_direction = "L", get_unit_expr = AVALU ) expect_dfs_equal( - base = exp_out_ctcv4_1, - compare = actual_output_ctcv4_1, + base = expected_anemia, + compare = actual_anemia_ctcv5, keys = c("ATOXDSCL", "AVAL", "ANRLO", "ANRHI", "AVALU") ) }) -### 2. Leukocytosis ---- + +### Leukocytosis +### NCICTCAEv4 and NCICTCAEv5 criteria is the same ### Grade 3: >100,000/mm3 -test_that("derive_var_atoxgr_dir: Test 2 NCICTCAEv4 Leukocytosis", { - exp_out_ctcv4_2 <- tibble::tribble( - ~ATOXDSCH, ~AVAL, ~ANRLO, ~ANRHI, ~AVALU, ~ATOXGRH, - "Not a term", 99, 0, NA, "10^9/L", NA, - NA, 99, 0, NA, "10^9/L", NA, - "Leukocytosis", 101, 0, 40, "10^9/L", "3", - "leukocytosis", 100, 0, 40, "10^9/L", "0", - "Leukocytosis", 99, 0, NA, "10^9/L", "0", - # wrong UNIT - GRADE should be missing - "Leukocytosis", 99, 0, 40, "10^9/M", NA, - # Unit missing cannot grade - "Leukocytosis", 99, 0, 40, NA, NA, - # AVAL missing cannot grade - "Leukocytosis", NA, 0, 40, "10^9/L", NA, +expected_leukocytosis <- tibble::tribble( + ~ATOXDSCH, ~AVAL, ~ANRLO, ~ANRHI, ~AVALU, ~ATOXGRH, + "Not a term", 99, 0, NA, "10^9/L", NA, + NA, 99, 0, NA, "10^9/L", NA, + "Leukocytosis", 101, 0, 40, "10^9/L", "3", + "leukocytosis", 100, 0, 40, "10^9/L", "0", + "Leukocytosis", 99, 0, NA, "10^9/L", "0", + # wrong UNIT - GRADE should be missing + "Leukocytosis", 99, 0, 40, "10^9/M", NA, + # Unit missing cannot grade + "Leukocytosis", 99, 0, 40, NA, NA, + # AVAL missing cannot grade + "Leukocytosis", NA, 0, 40, "10^9/L", NA, +) +input_leukocytosis <- expected_leukocytosis %>% + select(-ATOXGRH) + + +# ---- derive_var_atoxgr, test 7: CTCAEv4 Leukocytosis ---- +test_that("derive_var_atoxgr, test 7: CTCAEv4 Leukocytosis", { + actual_leukocytosis <- derive_var_atoxgr_dir( + input_leukocytosis, + new_var = ATOXGRH, + meta_criteria = atoxgr_criteria_ctcv4, + tox_description_var = ATOXDSCH, + criteria_direction = "H", + get_unit_expr = AVALU ) - input_ctcv4_2 <- exp_out_ctcv4_2 %>% - select(-ATOXGRH) - actual_output_ctcv4_2 <- derive_var_atoxgr_dir( - input_ctcv4_2, + expect_dfs_equal( + base = expected_leukocytosis, + compare = actual_leukocytosis, + keys = c("ATOXDSCH", "AVAL", "ANRLO", "ANRHI", "AVALU") + ) +}) + +# ---- derive_var_atoxgr, test 8: CTCAEv5 Leukocytosis ---- +test_that("derive_var_atoxgr, test 8: CTCAEv5 Leukocytosis", { + actual_leukocytosis <- derive_var_atoxgr_dir( + input_leukocytosis, new_var = ATOXGRH, - meta_criteria = atoxgr_criteria_ctcv4, + meta_criteria = atoxgr_criteria_ctcv5, tox_description_var = ATOXDSCH, criteria_direction = "H", get_unit_expr = AVALU ) expect_dfs_equal( - base = exp_out_ctcv4_2, - compare = actual_output_ctcv4_2, + base = expected_leukocytosis, + compare = actual_leukocytosis, keys = c("ATOXDSCH", "AVAL", "ANRLO", "ANRHI", "AVALU") ) }) -## Investigations ---- +## Investigations -### 3. Activated partial thromboplastin time prolonged ---- +### Activated partial thromboplastin time prolonged +### NCICTCAEv4 and NCICTCAEv5 criteria is the same ### Grade 3: >2.5 x ULN ### Grade 2: >1.5 - 2.5 x ULN ### Grade 1: >ULN - 1.5 x ULN -test_that("derive_var_atoxgr_dir: Test 3 CTCAEv4 Activated partial thromboplastin time prolonged", { - exp_out_ctcv4_3 <- tibble::tribble( - ~ATOXDSCH, ~AVAL, ~ANRHI, ~AVALU, ~ATOXGRH, - "Not a term", 80, 100, NA_character_, NA, - NA_character_, 60, 100, NA_character_, NA, - "Activated partial thromboplastin time prolonged", 251, 100, NA_character_, "3", - "Activated Partial thromboplastin time prolonged", 250, 100, NA_character_, "2", - "Activated partial Thromboplastin time prolonged", 151, 100, NA_character_, "2", - "Activated partial thromboplastin time prolonged", 150, 100, NA_character_, "1", - "Activated partial thromboplastin Time prolonged", 101, 100, NA_character_, "1", - "Activated partial thromboplastin time prolonged", 100, 100, NA_character_, "0", - # ANRHI missing - cannot grade - "Activated partial thromboplastin time prolonged", 100, NA, NA_character_, NA, - # AVAL missing cannot grade - "Activated partial thromboplastin time prolonged", NA, 100, NA_character_, NA, +expected_aptt <- tibble::tribble( + ~ATOXDSCH, ~AVAL, ~ANRHI, ~AVALU, ~ATOXGRH, + "Not a term", 80, 100, NA_character_, NA, + NA_character_, 60, 100, NA_character_, NA, + "Activated partial thromboplastin time prolonged", 251, 100, NA_character_, "3", + "Activated Partial thromboplastin time prolonged", 250, 100, NA_character_, "2", + "Activated partial Thromboplastin time prolonged", 151, 100, NA_character_, "2", + "Activated partial thromboplastin time prolonged", 150, 100, NA_character_, "1", + "Activated partial thromboplastin Time prolonged", 101, 100, NA_character_, "1", + "Activated partial thromboplastin time prolonged", 100, 100, NA_character_, "0", + # ANRHI missing - cannot grade + "Activated partial thromboplastin time prolonged", 100, NA, NA_character_, NA, + # AVAL missing cannot grade + "Activated partial thromboplastin time prolonged", NA, 100, NA_character_, NA, +) +input_aptt <- expected_aptt %>% + select(-ATOXGRH) + +# ---- derive_var_atoxgr, test 9: CTCAEv4 Activated partial thromboplastin time prolonged ---- +test_that("derive_var_atoxgr, test 9: CTCAEv4 Activated partial thromboplastin time prolonged", { + actual_aptt <- derive_var_atoxgr_dir( + input_aptt, + new_var = ATOXGRH, + meta_criteria = atoxgr_criteria_ctcv4, + tox_description_var = ATOXDSCH, + criteria_direction = "H", + get_unit_expr = AVALU ) - input_ctcv4_3 <- exp_out_ctcv4_3 %>% - select(-ATOXGRH) - actual_output_ctcv4_3 <- derive_var_atoxgr_dir( - input_ctcv4_3, + expect_dfs_equal( + base = expected_aptt, + compare = actual_aptt, + keys = c("ATOXDSCH", "AVAL", "ANRHI", "AVALU") + ) +}) + +# ---- derive_var_atoxgr, test 10: CTCAEv5 Activated partial thromboplastin time prolonged ---- +test_that("derive_var_atoxgr, test 10: CTCAEv5 Activated partial thromboplastin time prolonged", { + actual_aptt <- derive_var_atoxgr_dir( + input_aptt, new_var = ATOXGRH, - meta_criteria = atoxgr_criteria_ctcv4, + meta_criteria = atoxgr_criteria_ctcv5, tox_description_var = ATOXDSCH, criteria_direction = "H", get_unit_expr = AVALU ) expect_dfs_equal( - base = exp_out_ctcv4_3, - compare = actual_output_ctcv4_3, + base = expected_aptt, + compare = actual_aptt, keys = c("ATOXDSCH", "AVAL", "ANRHI", "AVALU") ) }) -### 4. Alanine aminotransferase increased ---- + +### Alanine aminotransferase increased +### NCICTCAEv5 same criteria as NCICTCAEv4 when BASELINE is normal ### Grade 4: >20.0 x ULN ### Grade 3: >5.0 - 20.0 x ULN ### Grade 2: >3.0 - 5.0 x ULN ### Grade 1: >ULN - 3.0 x ULN -test_that("derive_var_atoxgr_dir: Test 4 NCICTCAEv4 Alanine aminotransferase increased", { - exp_out_ctcv4_4 <- tibble::tribble( - ~ATOXDSCH, ~AVAL, ~ANRHI, ~AVALU, ~ATOXGRH, - "Not a term", 80, 40, NA_character_, NA, - NA_character_, 60, 40, NA_character_, NA, - "Alanine aminotransferase Increased", 801, 40, NA_character_, "4", - "Alanine aminotransferase Increased", 800, 40, NA_character_, "3", - "Alanine aminotransferase Increased", 201, 40, NA_character_, "3", - "Alanine aminotransferase Increased", 200, 40, NA_character_, "2", - "Alanine aminotransferase Increased", 121, 40, NA_character_, "2", - "Alanine aminotransferase Increased", 120, 40, NA_character_, "1", - "Alanine aminotransferase Increased", 41, 40, NA_character_, "1", - "Alanine aminotransferase Increased", 40, 40, NA_character_, "0", - # ANRHI missing - cannot grade - "Alanine aminotransferase Increased", 100, NA, NA_character_, NA, - # AVAL missing cannot grade - "Alanine aminotransferase Increased", NA, 40, NA_character_, NA, - ) - input_ctcv4_4 <- exp_out_ctcv4_4 %>% +expected_alt_ctcv4 <- tibble::tribble( + ~ATOXDSCH, ~AVAL, ~ANRHI, ~AVALU, ~ATOXGRH, + "Not a term", 80, 40, NA_character_, NA, + NA_character_, 60, 40, NA_character_, NA, + "Alanine aminotransferase Increased", 801, 40, NA_character_, "4", + "Alanine aminotransferase Increased", 800, 40, NA_character_, "3", + "Alanine aminotransferase Increased", 201, 40, NA_character_, "3", + "Alanine aminotransferase Increased", 200, 40, NA_character_, "2", + "Alanine aminotransferase Increased", 121, 40, NA_character_, "2", + "Alanine aminotransferase Increased", 120, 40, NA_character_, "1", + "Alanine aminotransferase Increased", 41, 40, NA_character_, "1", + "Alanine aminotransferase Increased", 40, 40, NA_character_, "0", + # ANRHI missing - cannot grade + "Alanine aminotransferase Increased", 100, NA, NA_character_, NA, + # AVAL missing cannot grade + "Alanine aminotransferase Increased", NA, 40, NA_character_, NA, +) + +# ---- derive_var_atoxgr, test 11: CTCAEv4 Alanine aminotransferase increased ---- +test_that("derive_var_atoxgr, test 11: CTCAEv4 Alanine aminotransferase increased", { + input_alt <- expected_alt_ctcv4 %>% select(-ATOXGRH) - actual_output_ctcv4_4 <- derive_var_atoxgr_dir( - input_ctcv4_4, + actual_alt <- derive_var_atoxgr_dir( + input_alt, new_var = ATOXGRH, meta_criteria = atoxgr_criteria_ctcv4, tox_description_var = ATOXDSCH, @@ -258,21 +330,145 @@ test_that("derive_var_atoxgr_dir: Test 4 NCICTCAEv4 Alanine aminotransferase inc ) expect_dfs_equal( - base = exp_out_ctcv4_4, - compare = actual_output_ctcv4_4, + base = expected_alt_ctcv4, + compare = actual_alt, keys = c("ATOXDSCH", "AVAL", "ANRHI", "AVALU") ) }) -### 5. Alkaline phosphatase increased ---- + +### NCICTCAEv5 same criteria as NCICTCAEv4 when BASELINE is normal +### Grade 4: >20.0 x ULN if BL was normal OR >20.0 x BL if BL was abnormal +### Grade 3: >5.0 - 20.0 x ULN if BL was normal OR >5.0 - 20.0 x BL if BL was abnormal +### Grade 2: >3.0 - 5.0 x ULN if BL was normal OR >3.0 - 5.0 x BL if BL was abnormal +### Grade 1: >ULN - 3.0 x ULN if BL was normal OR >1.5 - 3.0 x BL if BL was abnormal + +# ---- derive_var_atoxgr, test 12: CTCAEv5 Alanine aminotransferase increased ---- +test_that("derive_var_atoxgr, test 12: CTCAEv5 Alanine aminotransferase increased", { + # V5 and V4 criteria identical when BASELINE normal + expected_alt_ctcv5_norm <- expected_alt_ctcv4 %>% + # set BASE to be normal and create FLAG + mutate( + BASE = ANRHI, + FLAG = "NORMAL" + ) + + # create records with baseline abnormal and apply criteria + expected_alt_ctcv5_abn <- tibble::tribble( + ~ATOXDSCH, ~AVAL, ~BASE, ~AVALU, ~ATOXGRH, + "Not a term", 80, 40, NA_character_, NA, + NA_character_, 60, 40, NA_character_, NA, + "Alanine aminotransferase Increased", 801, 40, NA_character_, "4", + "Alanine aminotransferase Increased", 800, 40, NA_character_, "3", + "Alanine aminotransferase Increased", 201, 40, NA_character_, "3", + "Alanine aminotransferase Increased", 200, 40, NA_character_, "2", + "Alanine aminotransferase Increased", 121, 40, NA_character_, "2", + "Alanine aminotransferase Increased", 120, 40, NA_character_, "1", + "Alanine aminotransferase Increased", 60, 40, NA_character_, "1", + "Alanine aminotransferase Increased", 59, 40, NA_character_, "0", + # ANRHI missing - cannot grade + "Alanine aminotransferase Increased", 100, NA, NA_character_, NA, + # AVAL missing cannot grade + "Alanine aminotransferase Increased", NA, 40, NA_character_, NA, + ) %>% + # set BASE to be abnormal and create FLAG + mutate( + ANRHI = BASE - 1, + FLAG = "ABNORMAL" + ) + + # combine records with baseline normal and abnormal + expected_alt_ctcv5 <- expected_alt_ctcv5_norm %>% + bind_rows(expected_alt_ctcv5_abn) + + + input_alt <- expected_alt_ctcv5 %>% + select(-ATOXGRH) + + actual_alt <- derive_var_atoxgr_dir( + input_alt, + new_var = ATOXGRH, + meta_criteria = atoxgr_criteria_ctcv5, + tox_description_var = ATOXDSCH, + criteria_direction = "H", + get_unit_expr = AVALU + ) + + expect_dfs_equal( + base = expected_alt_ctcv5, + compare = actual_alt, + keys = c("ATOXDSCH", "AVAL", "ANRHI", "FLAG", "AVALU") + ) +}) + + +### Alkaline phosphatase increased +### NCICTCAEv5 same criteria as NCICTCAEv4 when BASELINE is normal ### Grade 4: >20.0 x ULN ### Grade 3: >5.0 - 20.0 x ULN ### Grade 2: >2.5 - 5.0 x ULN ### Grade 1: >ULN - 2.5 x ULN +expected_alkph_ctcv4 <- tibble::tribble( + ~ATOXDSCH, ~AVAL, ~ANRHI, ~AVALU, ~ATOXGRH, + "Not a term", 80, 40, NA_character_, NA, + NA_character_, 60, 40, NA_character_, NA, + "Alkaline phosphatase increased", 801, 40, NA_character_, "4", + "Alkaline phosphatase increased", 800, 40, NA_character_, "3", + "Alkaline phosphatase increased", 201, 40, NA_character_, "3", + "Alkaline phosphatase increased", 200, 40, NA_character_, "2", + "Alkaline phosphatase increased", 101, 40, NA_character_, "2", + "Alkaline phosphatase increased", 100, 40, NA_character_, "1", + "Alkaline phosphatase increased", 41, 40, NA_character_, "1", + "Alkaline phosphatase increased", 40, 40, NA_character_, "0", + # ANRHI missing - cannot grade + "Alkaline phosphatase increased", 100, NA, NA_character_, NA, + # AVAL missing cannot grade + "Alkaline phosphatase increased", NA, 40, NA_character_, NA, +) + + +# ---- derive_var_atoxgr, test 13: CTCAEv4 Alkaline phosphatase increased ---- +test_that("derive_var_atoxgr, test 13: CTCAEv4 Alkaline phosphatase increased", { + input_alkph <- expected_alkph_ctcv4 %>% + select(-ATOXGRH) + + actual_alkph <- derive_var_atoxgr_dir( + input_alkph, + new_var = ATOXGRH, + meta_criteria = atoxgr_criteria_ctcv4, + tox_description_var = ATOXDSCH, + criteria_direction = "H", + get_unit_expr = AVALU + ) + + expect_dfs_equal( + base = expected_alkph_ctcv4, + compare = actual_alkph, + keys = c("ATOXDSCH", "AVAL", "ANRHI", "AVALU") + ) +}) -test_that("derive_var_atoxgr_dir: Test 5 NCICTCAEv4 Alkaline phosphatase increased", { - exp_out_ctcv4_5 <- tibble::tribble( - ~ATOXDSCH, ~AVAL, ~ANRHI, ~AVALU, ~ATOXGRH, +### Alkaline phosphatase increased +### NCICTCAEv5 same criteria as NCICTCAEv4 when BASELINE is normal +### Grade 4: >20.0 x ULN if BL was normal OR >20.0 x BL if BL was abnormal +### Grade 3: >5.0 - 20.0 x ULN if BL was normal OR >5.0 - 20.0 x BL if BL was abnormal +### Grade 2: >2.5 - 5.0 x ULN if BL was normal OR >2.5 - 5.0 x BL if BL was abnormal +### Grade 1: >ULN - 2.5 x ULN if BL was normal OR >2.0 - 2.5 x BL if BL was abnormal + +# ---- derive_var_atoxgr, test 14: CTCAEv5 Alkaline phosphatase increased ---- +test_that("derive_var_atoxgr, test 14: CTCAEv5 Alkaline phosphatase increased", { + # V5 and V4 criteria identical when BASELINE normal + expected_alkph_ctcv5_norm <- expected_alkph_ctcv4 %>% + # set BASE to be normal and create FLAG + mutate( + BASE = ANRHI, + FLAG = "NORMAL" + ) + + # create records with baseline abnormal and apply criteria + + expected_alkph_ctcv5_abn <- tibble::tribble( + ~ATOXDSCH, ~AVAL, ~BASE, ~AVALU, ~ATOXGRH, "Not a term", 80, 40, NA_character_, NA, NA_character_, 60, 40, NA_character_, NA, "Alkaline phosphatase increased", 801, 40, NA_character_, "4", @@ -281,41 +477,108 @@ test_that("derive_var_atoxgr_dir: Test 5 NCICTCAEv4 Alkaline phosphatase increas "Alkaline phosphatase increased", 200, 40, NA_character_, "2", "Alkaline phosphatase increased", 101, 40, NA_character_, "2", "Alkaline phosphatase increased", 100, 40, NA_character_, "1", - "Alkaline phosphatase increased", 41, 40, NA_character_, "1", - "Alkaline phosphatase increased", 40, 40, NA_character_, "0", + "Alkaline phosphatase increased", 80, 40, NA_character_, "1", + "Alkaline phosphatase increased", 79, 40, NA_character_, "0", # ANRHI missing - cannot grade "Alkaline phosphatase increased", 100, NA, NA_character_, NA, # AVAL missing cannot grade "Alkaline phosphatase increased", NA, 40, NA_character_, NA, - ) - input_ctcv4_5 <- exp_out_ctcv4_5 %>% + ) %>% + # set BASE to be abnormal and create FLAG + mutate( + ANRHI = BASE - 1, + FLAG = "ABNORMAL" + ) + + # combine records with baseline normal and abnormal + expected_alkph_ctcv5 <- expected_alkph_ctcv5_norm %>% + bind_rows(expected_alkph_ctcv5_abn) + + input_alkph <- expected_alkph_ctcv5 %>% select(-ATOXGRH) - actual_output_ctcv4_5 <- derive_var_atoxgr_dir( - input_ctcv4_5, + actual_alkph <- derive_var_atoxgr_dir( + input_alkph, new_var = ATOXGRH, - meta_criteria = atoxgr_criteria_ctcv4, + meta_criteria = atoxgr_criteria_ctcv5, tox_description_var = ATOXDSCH, criteria_direction = "H", get_unit_expr = AVALU ) expect_dfs_equal( - base = exp_out_ctcv4_5, - compare = actual_output_ctcv4_5, - keys = c("ATOXDSCH", "AVAL", "ANRHI", "AVALU") + base = expected_alkph_ctcv5, + compare = actual_alkph, + keys = c("ATOXDSCH", "AVAL", "ANRHI", "FLAG", "AVALU") ) }) -### 6. Aspartate aminotransferase increased ---- + +### Aspartate aminotransferase increased +### NCICTCAEv5 same criteria as NCICTCAEv4 when BASELINE is normal ### Grade 4: >20.0 x ULN ### Grade 3: >5.0 - 20.0 x ULN ### Grade 2: >3.0 - 5.0 x ULN ### Grade 1: >ULN - 3.0 x ULN -test_that("derive_var_atoxgr_dir: Test 6 NCICTCAEv4 Aspartate aminotransferase increased", { - exp_out_ctcv4_6 <- tibble::tribble( - ~ATOXDSCH, ~AVAL, ~ANRHI, ~AVALU, ~ATOXGRH, +expected_ast_ctcv4 <- tibble::tribble( + ~ATOXDSCH, ~AVAL, ~ANRHI, ~AVALU, ~ATOXGRH, + "Not a term", 80, 40, NA_character_, NA, + NA_character_, 60, 40, NA_character_, NA, + "Aspartate aminotransferase Increased", 801, 40, NA_character_, "4", + "Aspartate aminotransferase Increased", 800, 40, NA_character_, "3", + "Aspartate aminotransferase Increased", 201, 40, NA_character_, "3", + "Aspartate aminotransferase Increased", 200, 40, NA_character_, "2", + "Aspartate aminotransferase Increased", 121, 40, NA_character_, "2", + "Aspartate aminotransferase Increased", 120, 40, NA_character_, "1", + "Aspartate aminotransferase Increased", 41, 40, NA_character_, "1", + "Aspartate aminotransferase Increased", 40, 40, NA_character_, "0", + # ANRHI missing - cannot grade + "Aspartate aminotransferase Increased", 100, NA, NA_character_, NA, + # AVAL missing cannot grade + "Aspartate aminotransferase Increased", NA, 40, NA_character_, NA, +) + +# ---- derive_var_atoxgr, test 15: CTCAEv4 Aspartate aminotransferase increased ---- +test_that("derive_var_atoxgr, test 15: CTCAEv4 Aspartate aminotransferase increased", { + input_ast <- expected_ast_ctcv4 %>% + select(-ATOXGRH) + + actual_ast <- derive_var_atoxgr_dir( + input_ast, + new_var = ATOXGRH, + meta_criteria = atoxgr_criteria_ctcv4, + tox_description_var = ATOXDSCH, + criteria_direction = "H", + get_unit_expr = AVALU + ) + + expect_dfs_equal( + base = expected_ast_ctcv4, + compare = actual_ast, + keys = c("ATOXDSCH", "AVAL", "ANRHI", "AVALU") + ) +}) + +### NCICTCAEv5 same criteria as NCICTCAEv4 when BASELINE is normal +### Grade 4: >20.0 x ULN if BL was normal OR >20.0 x BL if BL was abnormal +### Grade 3: >5.0 - 20.0 x ULN if BL was normal OR >5.0 - 20.0 x BL if BL was abnormal +### Grade 2: >3.0 - 5.0 x ULN if BL was normal OR >3.0 - 5.0 x BL if BL was abnormal +### Grade 1: >ULN - 3.0 x ULN if BL was normal OR >1.5 - 3.0 x BL if BL was abnormal + +# ---- derive_var_atoxgr, test 16: CTCAEv5 Aspartate aminotransferase increased ---- +test_that("derive_var_atoxgr, test 16: CTCAEv5 Aspartate aminotransferase increased", { + # V5 and V4 criteria identical when BASELINE normal + expected_ast_ctcv5_norm <- expected_ast_ctcv4 %>% + # set BASE to be normal and create FLAG + mutate( + BASE = ANRHI, + FLAG = "NORMAL" + ) + + # create records with baseline abnormal and apply criteria + expected_ast_ctcv5_abn <- tibble::tribble( + ~ATOXDSCH, ~AVAL, ~BASE, ~AVALU, ~ATOXGRH, "Not a term", 80, 40, NA_character_, NA, NA_character_, 60, 40, NA_character_, NA, "Aspartate aminotransferase Increased", 801, 40, NA_character_, "4", @@ -324,61 +587,79 @@ test_that("derive_var_atoxgr_dir: Test 6 NCICTCAEv4 Aspartate aminotransferase i "Aspartate aminotransferase Increased", 200, 40, NA_character_, "2", "Aspartate aminotransferase Increased", 121, 40, NA_character_, "2", "Aspartate aminotransferase Increased", 120, 40, NA_character_, "1", - "Aspartate aminotransferase Increased", 41, 40, NA_character_, "1", - "Aspartate aminotransferase Increased", 40, 40, NA_character_, "0", + "Aspartate aminotransferase Increased", 60, 40, NA_character_, "1", + "Aspartate aminotransferase Increased", 59, 40, NA_character_, "0", # ANRHI missing - cannot grade "Aspartate aminotransferase Increased", 100, NA, NA_character_, NA, # AVAL missing cannot grade "Aspartate aminotransferase Increased", NA, 40, NA_character_, NA, - ) - input_ctcv4_6 <- exp_out_ctcv4_6 %>% + ) %>% + # set BASE to be abnormal and create FLAG + mutate( + ANRHI = BASE - 1, + FLAG = "ABNORMAL" + ) + + # combine records with baseline normal and abnormal + expected_ast_ctcv5 <- expected_ast_ctcv5_norm %>% + bind_rows(expected_ast_ctcv5_abn) + + input_ast <- expected_ast_ctcv5 %>% select(-ATOXGRH) - actual_output_ctcv4_6 <- derive_var_atoxgr_dir( - input_ctcv4_6, + actual_ast <- derive_var_atoxgr_dir( + input_ast, new_var = ATOXGRH, - meta_criteria = atoxgr_criteria_ctcv4, + meta_criteria = atoxgr_criteria_ctcv5, tox_description_var = ATOXDSCH, criteria_direction = "H", get_unit_expr = AVALU ) expect_dfs_equal( - base = exp_out_ctcv4_6, - compare = actual_output_ctcv4_6, - keys = c("ATOXDSCH", "AVAL", "ANRHI", "AVALU") + base = expected_ast_ctcv5, + compare = actual_ast, + keys = c("ATOXDSCH", "AVAL", "ANRHI", "FLAG", "AVALU") ) }) -### 7. Blood bilirubin increased ---- + + + + + +### Blood bilirubin increased +### NCICTCAEv5 same criteria as NCICTCAEv4 when BASELINE is normal ### Grade 4: >10.0 x ULN ### Grade 3: >3.0 - 10.0 x ULN -### Grade 2: >3.0 - 1.5 x ULN +### Grade 2: >1.5 - 3.0 x ULN ### Grade 1: >ULN - 1.5 x ULN -test_that("derive_var_atoxgr_dir: Test 7 NCICTCAEv4 Blood bilirubin increased", { - exp_out_ctcv4_7 <- tibble::tribble( - ~ATOXDSCH, ~AVAL, ~ANRHI, ~AVALU, ~ATOXGRH, - "Not a term", 80, 40, NA_character_, NA, - NA_character_, 60, 40, NA_character_, NA, - "Blood bilirubin increased", 401, 40, NA_character_, "4", - "Blood bilirubin increased", 400, 40, NA_character_, "3", - "Blood bilirubin increased", 121, 40, NA_character_, "3", - "Blood bilirubin increased", 120, 40, NA_character_, "2", - "Blood bilirubin increased", 61, 40, NA_character_, "2", - "Blood bilirubin increased", 60, 40, NA_character_, "1", - "Blood bilirubin increased", 41, 40, NA_character_, "1", - "Blood bilirubin increased", 40, 40, NA_character_, "0", - # ANRHI missing - cannot grade - "Blood bilirubin increased", 100, NA, NA_character_, NA, - # AVAL missing cannot grade - "Blood bilirubin increased", NA, 40, NA_character_, NA, - ) - input_ctcv4_7 <- exp_out_ctcv4_7 %>% +expected_bili_ctcv4 <- tibble::tribble( + ~ATOXDSCH, ~AVAL, ~ANRHI, ~AVALU, ~ATOXGRH, + "Not a term", 80, 40, NA_character_, NA, + NA_character_, 60, 40, NA_character_, NA, + "Blood bilirubin increased", 401, 40, NA_character_, "4", + "Blood bilirubin increased", 400, 40, NA_character_, "3", + "Blood bilirubin increased", 121, 40, NA_character_, "3", + "Blood bilirubin increased", 120, 40, NA_character_, "2", + "Blood bilirubin increased", 61, 40, NA_character_, "2", + "Blood bilirubin increased", 60, 40, NA_character_, "1", + "Blood bilirubin increased", 41, 40, NA_character_, "1", + "Blood bilirubin increased", 40, 40, NA_character_, "0", + # ANRHI missing - cannot grade + "Blood bilirubin increased", 100, NA, NA_character_, NA, + # AVAL missing cannot grade + "Blood bilirubin increased", NA, 40, NA_character_, NA, +) + +# ---- derive_var_atoxgr, test 17: CTCAEv4 Blood bilirubin increased ---- +test_that("derive_var_atoxgr, test 17: CTCAEv4 Blood bilirubin increased", { + input_bili <- expected_bili_ctcv4 %>% select(-ATOXGRH) - actual_output_ctcv4_7 <- derive_var_atoxgr_dir( - input_ctcv4_7, + actual_bili <- derive_var_atoxgr_dir( + input_bili, new_var = ATOXGRH, meta_criteria = atoxgr_criteria_ctcv4, tox_description_var = ATOXDSCH, @@ -387,206 +668,318 @@ test_that("derive_var_atoxgr_dir: Test 7 NCICTCAEv4 Blood bilirubin increased", ) expect_dfs_equal( - base = exp_out_ctcv4_7, - compare = actual_output_ctcv4_7, + base = expected_bili_ctcv4, + compare = actual_bili, keys = c("ATOXDSCH", "AVAL", "ANRHI", "AVALU") ) }) -### 8. CD4 Lymphocytes decreased ---- +### Blood bilirubin increased +### NCICTCAEv5 same criteria as NCICTCAEv4 when BASELINE is normal +### Grade 4: >10.0 x ULN if BL was normal OR >10.0 x BL if BL was abnormal +### Grade 3: >3.0 - 10.0 x ULN if BL was normal OR >3.0 - 10.0 x BL +### Grade 2: >1.5 - 3.0 x ULN if BL was normal OR >1.5 - 3.0 x BL +### Grade 1: >ULN - 1.5 x ULN if BL was normal OR >1.0 - 1.5 x BL + +# ---- derive_var_atoxgr, test 18: CTCAEv5 Blood bilirubin increased ---- +test_that("derive_var_atoxgr, test 18: CTCAEv5 Blood bilirubin increased", { + # V5 and V4 criteria identical when BASELINE normal + expected_bili_ctcv5_norm <- expected_bili_ctcv4 %>% + # set BASE to be normal and create FLAG + mutate( + BASE = ANRHI, + FLAG = "NORMAL" + ) + + # create records with abnormal BASE then add records with normal BASE + expected_bili_ctcv5 <- expected_bili_ctcv4 %>% + # set BASE to ANRHI then make ANRHI < BASE + mutate( + BASE = ANRHI, + ANRHI = ANRHI - 1, + FLAG = "ABNORMAL" + ) %>% + bind_rows(expected_bili_ctcv5_norm) + + input_bili <- expected_bili_ctcv5 %>% + select(-ATOXGRH) + + actual_bili <- derive_var_atoxgr_dir( + input_bili, + new_var = ATOXGRH, + meta_criteria = atoxgr_criteria_ctcv5, + tox_description_var = ATOXDSCH, + criteria_direction = "H", + get_unit_expr = AVALU + ) + + expect_dfs_equal( + base = expected_bili_ctcv5, + compare = actual_bili, + keys = c("ATOXDSCH", "AVAL", "ANRHI", "FLAG", "AVALU") + ) +}) + + + +### CD4 Lymphocytes decreased +### NCICTCAEv5 same criteria as NCICTCAEv4 ### Grade 4: <0.05 x 10e9 /L ### Grade 3: <0.2 x 0.05 - 10e9 /L ### Grade 2: <0.5 - 0.2 x 10e9 /L ### Grade 1: % + select(-ATOXGRL) + +# ---- derive_var_atoxgr, test 19: CTCAEv4 CD4 Lymphocytes decreased ---- +test_that("derive_var_atoxgr, test 19: CTCAEv4 CD4 Lymphocytes decreased", { + actual_cd4 <- derive_var_atoxgr_dir( + input_cd4, + new_var = ATOXGRL, + meta_criteria = atoxgr_criteria_ctcv4, + tox_description_var = ATOXDSCL, + criteria_direction = "L", + get_unit_expr = AVALU ) - input_ctcv4_8 <- exp_out_ctcv4_8 %>% - select(-ATOXGRL) + expect_dfs_equal( + base = expected_cd4, + compare = actual_cd4, + keys = c("ATOXDSCL", "AVAL", "ANRLO", "AVALU") + ) +}) - actual_output_ctcv4_8 <- derive_var_atoxgr_dir( - input_ctcv4_8, +# ---- derive_var_atoxgr, test 20: CTCAEv5 CD4 Lymphocytes decreased ---- +test_that("derive_var_atoxgr, test 20: CTCAEv5 CD4 Lymphocytes decreased", { + actual_cd4 <- derive_var_atoxgr_dir( + input_cd4, new_var = ATOXGRL, - meta_criteria = atoxgr_criteria_ctcv4, + meta_criteria = atoxgr_criteria_ctcv5, tox_description_var = ATOXDSCL, criteria_direction = "L", get_unit_expr = AVALU ) expect_dfs_equal( - base = exp_out_ctcv4_8, - compare = actual_output_ctcv4_8, + base = expected_cd4, + compare = actual_cd4, keys = c("ATOXDSCL", "AVAL", "ANRLO", "AVALU") ) }) -### 9. Cholesterol high ---- +### Cholesterol high +### NCICTCAEv5 same criteria as NCICTCAEv4 ### Grade 4: >12.92 mmol/L ### Grade 3: >10.34 - 12.92 mmol/L ### Grade 2: >7.75 - 10.34 mmol/L ### Grade 1: >ULN - 7.75 mmol/L -test_that("derive_var_atoxgr_dir: Test 9 NCICTCAEv4 Cholesterol high", { - exp_out_ctcv4_9 <- tibble::tribble( - ~ATOXDSCH, ~AVAL, ~ANRLO, ~ANRHI, ~AVALU, ~ATOXGRH, - "Not a term", 8, 0, 5, "mmol/L", NA, - NA_character_, 10, 0, 5, "mmol/L", NA, - "Cholesterol high", 12.93, 0, 5, "mmol/L", "4", - "Cholesterol High", 12.92, 0, 5, "mmol/L", "3", - "Cholesterol high", 10.35, 0, 5, "Mmol/L", "3", - # wrong unit - grade missing - "Cholesterol high", 10.35, 0, 5, "umol/L", NA, - "Cholesterol high", 10.34, 0, 5, "mmol/L", "2", - "Cholesterol high", 7.76, 0, 5, "mmol/L", "2", - "Cholesterol high", 7.75, 0, 5, "mmol/L", "1", - "Cholesterol high", 5.1, 0, 5, "mmol/L", "1", - "Cholesterol high", 5, 0, 5, "mmol/L", "0", - # ANRHI missing - AVAL satisfies grade 2 - 4 - "Cholesterol high", 12.93, 0, NA, "mmol/L", "4", - "Cholesterol High", 12.92, 0, NA, "mmol/L", "3", - "Cholesterol high", 10.35, 0, NA, "Mmol/L", "3", - "Cholesterol high", 10.34, 0, NA, "mmol/L", "2", - "Cholesterol high", 7.76, 0, NA, "mmol/L", "2", - # ANRHI missing - AVAL does NOT satisfies grade 2 - 4 - "Cholesterol high", 7.75, 0, NA, "mmol/L", NA, - "Cholesterol high", 5.1, 0, NA, "mmol/L", NA, - "Cholesterol high", 5, 0, NA, "mmol/L", NA, - # Unit missing - cannot grade - "Cholesterol high", 5, 0, 5, NA, NA, - # AVAL missing cannot grade - "Cholesterol high", NA, 0, 5, "mmol/L", NA, +expected_choles <- tibble::tribble( + ~ATOXDSCH, ~AVAL, ~ANRLO, ~ANRHI, ~AVALU, ~ATOXGRH, + "Not a term", 8, 0, 5, "mmol/L", NA, + NA_character_, 10, 0, 5, "mmol/L", NA, + "Cholesterol high", 12.93, 0, 5, "mmol/L", "4", + "Cholesterol High", 12.92, 0, 5, "mmol/L", "3", + "Cholesterol high", 10.35, 0, 5, "Mmol/L", "3", + # wrong unit - grade missing + "Cholesterol high", 10.35, 0, 5, "umol/L", NA, + "Cholesterol high", 10.34, 0, 5, "mmol/L", "2", + "Cholesterol high", 7.76, 0, 5, "mmol/L", "2", + "Cholesterol high", 7.75, 0, 5, "mmol/L", "1", + "Cholesterol high", 5.1, 0, 5, "mmol/L", "1", + "Cholesterol high", 5, 0, 5, "mmol/L", "0", + # ANRHI missing - AVAL satisfies grade 2 - 4 + "Cholesterol high", 12.93, 0, NA, "mmol/L", "4", + "Cholesterol High", 12.92, 0, NA, "mmol/L", "3", + "Cholesterol high", 10.35, 0, NA, "Mmol/L", "3", + "Cholesterol high", 10.34, 0, NA, "mmol/L", "2", + "Cholesterol high", 7.76, 0, NA, "mmol/L", "2", + # ANRHI missing - AVAL does NOT satisfies grade 2 - 4 + "Cholesterol high", 7.75, 0, NA, "mmol/L", NA, + "Cholesterol high", 5.1, 0, NA, "mmol/L", NA, + "Cholesterol high", 5, 0, NA, "mmol/L", NA, + # Unit missing - cannot grade + "Cholesterol high", 5, 0, 5, NA, NA, + # AVAL missing cannot grade + "Cholesterol high", NA, 0, 5, "mmol/L", NA, +) +input_choles <- expected_choles %>% + select(-ATOXGRH) + +# ---- derive_var_atoxgr, test 21: CTCAEv4 Cholesterol high ---- +test_that("derive_var_atoxgr, test 21: CTCAEv4 Cholesterol high", { + actual_choles <- derive_var_atoxgr_dir( + input_choles, + new_var = ATOXGRH, + meta_criteria = atoxgr_criteria_ctcv4, + tox_description_var = ATOXDSCH, + criteria_direction = "H", + get_unit_expr = AVALU ) - input_ctcv4_9 <- exp_out_ctcv4_9 %>% - select(-ATOXGRH) - actual_output_ctcv4_9 <- derive_var_atoxgr_dir( - input_ctcv4_9, + expect_dfs_equal( + base = expected_choles, + compare = actual_choles, + keys = c("ATOXDSCH", "AVAL", "ANRLO", "ANRHI", "AVALU") + ) +}) + +# ---- derive_var_atoxgr, test 22: CTCAEv5 Cholesterol high ---- +test_that("derive_var_atoxgr, test 22: CTCAEv5 Cholesterol high", { + actual_choles <- derive_var_atoxgr_dir( + input_choles, new_var = ATOXGRH, - meta_criteria = atoxgr_criteria_ctcv4, + meta_criteria = atoxgr_criteria_ctcv5, tox_description_var = ATOXDSCH, criteria_direction = "H", get_unit_expr = AVALU ) expect_dfs_equal( - base = exp_out_ctcv4_9, - compare = actual_output_ctcv4_9, + base = expected_choles, + compare = actual_choles, keys = c("ATOXDSCH", "AVAL", "ANRLO", "ANRHI", "AVALU") ) }) -### 10. CPK increased ---- +### CPK increased +### NCICTCAEv5 same criteria as NCICTCAEv4 ### Grade 4: >10.0 x ULN ### Grade 3: >5.0 - 10.0 x ULN ### Grade 2: >2.5 - 5.0 x ULN ### Grade 1: >ULN - 2.5 x ULN -test_that("derive_var_atoxgr_dir: Test 10 NCICTCAEv4 CPK increased", { - exp_out_ctcv4_10 <- tibble::tribble( - ~ATOXDSCH, ~AVAL, ~ANRLO, ~ANRHI, ~AVALU, ~ATOXGRH, - "Not a term", 80, 0, 40, NA_character_, NA, - NA_character_, 60, 0, 40, NA_character_, NA, - "CPK increased", 401, 0, 40, NA_character_, "4", - "CPK increased", 400, 0, 40, NA_character_, "3", - "CPK increased", 201, 0, 40, NA_character_, "3", - "CPK increased", 200, 0, 40, NA_character_, "2", - "CPK increased", 101, 0, 40, NA_character_, "2", - "CPK increased", 100, 0, 40, NA_character_, "1", - "CPK increased", 41, 0, 40, NA_character_, "1", - "CPK increased", 40, 0, 40, NA_character_, "0", - # ANRHI missing - cannot grade - "CPK increased", 100, 0, NA, NA_character_, NA, - # AVAL missing cannot grade - "CPK increased", NA, 0, 40, NA_character_, NA, +expected_cpk <- tibble::tribble( + ~ATOXDSCH, ~AVAL, ~ANRLO, ~ANRHI, ~AVALU, ~ATOXGRH, + "Not a term", 80, 0, 40, NA_character_, NA, + NA_character_, 60, 0, 40, NA_character_, NA, + "CPK increased", 401, 0, 40, NA_character_, "4", + "CPK increased", 400, 0, 40, NA_character_, "3", + "CPK increased", 201, 0, 40, NA_character_, "3", + "CPK increased", 200, 0, 40, NA_character_, "2", + "CPK increased", 101, 0, 40, NA_character_, "2", + "CPK increased", 100, 0, 40, NA_character_, "1", + "CPK increased", 41, 0, 40, NA_character_, "1", + "CPK increased", 40, 0, 40, NA_character_, "0", + # ANRHI missing - cannot grade + "CPK increased", 100, 0, NA, NA_character_, NA, + # AVAL missing cannot grade + "CPK increased", NA, 0, 40, NA_character_, NA, +) +input_cpk <- expected_cpk %>% + select(-ATOXGRH) + +# ---- derive_var_atoxgr, test 23: CTCAEv4 CPK increased ---- +test_that("derive_var_atoxgr, test 23: CTCAEv4 CPK increased", { + actual_cpk <- derive_var_atoxgr_dir( + input_cpk, + new_var = ATOXGRH, + meta_criteria = atoxgr_criteria_ctcv4, + tox_description_var = ATOXDSCH, + criteria_direction = "H", + get_unit_expr = AVALU ) - input_ctcv4_10 <- exp_out_ctcv4_10 %>% - select(-ATOXGRH) - actual_output_ctcv4_10 <- derive_var_atoxgr_dir( - input_ctcv4_10, + expect_dfs_equal( + base = expected_cpk, + compare = actual_cpk, + keys = c("ATOXDSCH", "AVAL", "ANRLO", "ANRHI", "AVALU") + ) +}) + +# ---- derive_var_atoxgr, test 24: CTCAEv5 CPK increased ---- +test_that("derive_var_atoxgr, test 24: CTCAEv5 CPK increased", { + actual_cpk <- derive_var_atoxgr_dir( + input_cpk, new_var = ATOXGRH, - meta_criteria = atoxgr_criteria_ctcv4, + meta_criteria = atoxgr_criteria_ctcv5, tox_description_var = ATOXDSCH, criteria_direction = "H", get_unit_expr = AVALU ) expect_dfs_equal( - base = exp_out_ctcv4_10, - compare = actual_output_ctcv4_10, + base = expected_cpk, + compare = actual_cpk, keys = c("ATOXDSCH", "AVAL", "ANRLO", "ANRHI", "AVALU") ) }) -### 11. Creatinine increased ---- +### Creatinine increased (NCICTCv4) +### NCICTCAEv5 same criteria as NCICTCAEv4 except for Grade 1 ### Grade 4: >6.0 x ULN ### Grade 3: >3.0 baseline; >3.0 - 6.0 x ULN ### Grade 2: >1.5 - 3.0 x baseline; >1.5 - 3.0 x ULN ### Grade 1: >1 - 1.5 x baseline; >ULN - 1.5 x ULN -test_that("derive_var_atoxgr_dir: Test 10 NCICTCAEv4 Creatinine increased", { - exp_out_ctcv4_11 <- tibble::tribble( - ~ATOXDSCH, ~AVAL, ~BASE, ~ANRHI, ~AVALU, ~ATOXGRH, - "Not a term", 80, 80, 40, NA_character_, NA, - NA_character_, 60, 60, 40, NA_character_, NA, - # GRADE derived from AVAL against ANRHI - "Creatinine increased", 241, 241, 40, NA_character_, "4", - "Creatinine increased", 240, 230, 40, NA_character_, "3", - "Creatinine increased", 121, 120, 40, NA_character_, "3", - "Creatinine increased", 120, 119, 40, NA_character_, "2", - "Creatinine increased", 61, 60, 40, NA_character_, "2", - "Creatinine increased", 60, 60, 40, NA_character_, "1", - "Creatinine increased", 41, 41, 40, NA_character_, "1", - "Creatinine increased", 40, 40, 40, NA_character_, "0", - # GRADE derived from AVAL against BASE - "Creatinine increased", 42, 6, 40, NA_character_, "3", - "Creatinine increased", 42, 13.9, 40, NA_character_, "3", - "Creatinine increased", 42, 14, 40, NA_character_, "2", - "Creatinine increased", 42.1, 28, 40, NA_character_, "2", - "Creatinine increased", 42, 28, 42, NA_character_, "1", - "Creatinine increased", 42, 41, 42, NA_character_, "1", - "Creatinine increased", 42, 42, 42, NA_character_, "0", - # BASE missing - AVAL <= ANRLO cannot grade as NORMAL - "Creatinine increased", 42, NA, 42, NA_character_, NA, - # ANRHI missing - AVAL <= BASE cannot grade as NORMAL - "Creatinine increased", 42, 42, NA, NA_character_, NA, - # AVAL missing cannot grade - "Creatinine increased", NA, 0, 40, NA_character_, NA, - ) - input_ctcv4_11 <- exp_out_ctcv4_11 %>% +# create flag to remove obs not relevant for NCI-CTCAEv5 +expected_creatn <- tibble::tribble( + ~ATOXDSCH, ~AVAL, ~BASE, ~ANRHI, ~AVALU, ~ATOXGRH, ~V4, ~V5, + "Not a term", 80, 80, 40, NA_character_, NA, "Y", "Y", + NA_character_, 60, 60, 40, NA_character_, NA, "Y", "Y", + # GRADE derived from AVAL against ANRHI + "Creatinine increased", 241, 241, 40, NA_character_, "4", "Y", "Y", + "Creatinine increased", 240, 230, 40, NA_character_, "3", "Y", "Y", + "Creatinine increased", 121, 120, 40, NA_character_, "3", "Y", "Y", + "Creatinine increased", 120, 119, 40, NA_character_, "2", "Y", "Y", + "Creatinine increased", 61, 60, 40, NA_character_, "2", "Y", "Y", + "Creatinine increased", 60, 60, 40, NA_character_, "1", "Y", "Y", + "Creatinine increased", 41, 41, 40, NA_character_, "1", "Y", "Y", + "Creatinine increased", 40, 40, 40, NA_character_, "0", "Y", "Y", + # GRADE derived from AVAL against BASE + "Creatinine increased", 42, 6, 40, NA_character_, "3", "Y", "Y", + "Creatinine increased", 42, 13.9, 40, NA_character_, "3", "Y", "Y", + "Creatinine increased", 42, 14, 40, NA_character_, "2", "Y", "Y", + "Creatinine increased", 42.1, 28, 40, NA_character_, "2", "Y", "Y", + "Creatinine increased", 42, 28, 42, NA_character_, "1", "Y", "N", + "Creatinine increased", 42, 41, 42, NA_character_, "1", "Y", "N", + "Creatinine increased", 42, 42, 42, NA_character_, "0", "Y", "N", + # BASE missing - AVAL <= ANRLO cannot grade as NORMAL + "Creatinine increased", 42, NA, 42, NA_character_, NA, "Y", "N", + # ANRHI missing - AVAL <= BASE cannot grade as NORMAL + "Creatinine increased", 42, 42, NA, NA_character_, NA, "Y", "Y", + # AVAL missing cannot grade + "Creatinine increased", NA, 0, 40, NA_character_, NA, "Y", "Y", +) + +# ---- derive_var_atoxgr, test 25: CTCAEv4 Creatinine increased ---- +test_that("derive_var_atoxgr, test 25: CTCAEv4 Creatinine increased", { + input_creatn <- expected_creatn %>% select(-ATOXGRH) - actual_output_ctcv4_11 <- derive_var_atoxgr_dir( - input_ctcv4_11, + actual_creatn <- derive_var_atoxgr_dir( + input_creatn, new_var = ATOXGRH, meta_criteria = atoxgr_criteria_ctcv4, tox_description_var = ATOXDSCH, @@ -595,20 +988,52 @@ test_that("derive_var_atoxgr_dir: Test 10 NCICTCAEv4 Creatinine increased", { ) expect_dfs_equal( - base = exp_out_ctcv4_11, - compare = actual_output_ctcv4_11, + base = expected_creatn, + compare = actual_creatn, + keys = c("ATOXDSCH", "AVAL", "BASE", "ANRHI", "AVALU") + ) +}) + +### Creatinine increased (NCICTCv5) +### NCICTCAEv5 same criteria as NCICTCAEv4 except for Grade 1 +### Grade 4: >6.0 x ULN +### Grade 3: >3.0 baseline; >3.0 - 6.0 x ULN +### Grade 2: >1.5 - 3.0 x baseline; >1.5 - 3.0 x ULN +### Grade 1: >ULN - 1.5 x ULN + +# ---- derive_var_atoxgr, test 26: CTCAEv4 Creatinine increased ---- +test_that("derive_var_atoxgr, test 26: CTCAEv4 Creatinine increased", { + expected_creatn <- expected_creatn %>% + filter(V5 == "Y") + + input_creatn <- expected_creatn %>% + select(-ATOXGRH) + + actual_creatn <- derive_var_atoxgr_dir( + input_creatn, + new_var = ATOXGRH, + meta_criteria = atoxgr_criteria_ctcv5, + tox_description_var = ATOXDSCH, + criteria_direction = "H", + get_unit_expr = AVALU + ) + + expect_dfs_equal( + base = expected_creatn, + compare = actual_creatn, keys = c("ATOXDSCH", "AVAL", "BASE", "ANRHI", "AVALU") ) }) -### 12. Fibrinogen decreased decreased ---- +### Fibrinogen decreased (NCICTCv4) ### Grade 4: <0.25 x LLN or 75% decrease from baseline or absolute value <50 mg/dL ### Grade 3: <0.5 - 0.25 x LLN or 50 - <75% decrease from baseline ### Grade 2: <0.75 - 0.5 x LLN or 25 - <50% decrease from baseline ### Grade 1: <1.0 - 0.75 x LLN or <25% decrease from baseline -test_that("derive_var_atoxgr_dir: Test 12 NCICTCAEv4 Fibrinogen decreased", { - exp_out_ctcv4_12 <- tibble::tribble( +# ---- derive_var_atoxgr, test 27: CTCAEv4 Fibrinogen decreased ---- +test_that("derive_var_atoxgr, test 27: CTCAEv4 Fibrinogen decreased", { + expected_fib <- tibble::tribble( ~ATOXDSCL, ~AVAL, ~ANRLO, ~PCHG, ~AVALU, ~ATOXGRL, "Not a term", 9, 10, 40, "g/L", NA, NA_character_, 10, 10, 40, "g/L", NA, @@ -661,11 +1086,11 @@ test_that("derive_var_atoxgr_dir: Test 12 NCICTCAEv4 Fibrinogen decreased", { # missing unit cannot grade as it may satisfy grade 4 "Fibrinogen decreased", 1.5, 1.5, 0, NA, NA, ) - input_ctcv4_12 <- exp_out_ctcv4_12 %>% + input_fib <- expected_fib %>% select(-ATOXGRL) - actual_output_ctcv4_12 <- derive_var_atoxgr_dir( - input_ctcv4_12, + actual_fib <- derive_var_atoxgr_dir( + input_fib, new_var = ATOXGRL, meta_criteria = atoxgr_criteria_ctcv4, tox_description_var = ATOXDSCL, @@ -674,21 +1099,158 @@ test_that("derive_var_atoxgr_dir: Test 12 NCICTCAEv4 Fibrinogen decreased", { ) expect_dfs_equal( - base = exp_out_ctcv4_12, - compare = actual_output_ctcv4_12, + base = expected_fib, + compare = actual_fib, + keys = c("ATOXDSCL", "AVAL", "ANRLO", "PCHG", "AVALU") + ) +}) + +### Fibrinogen decreased (NCICTCv5) +### Grade 4: <0.25 x LLN OR if abnormal, 75% dec. from BL OR absolute value <50 mg/dL +### Grade 3: <0.5 - 0.25 x LLN OR if abnormal, 50 - <75% dec. from BL +### Grade 2: <0.75 - 0.5 x LLN OR if abnormal, 25 - <50% dec. from BL +### Grade 1: <1.0 - 0.75 x LLN OR if abnormal, <25% dec. from BL + +# ---- derive_var_atoxgr, test 28: CTCAEv5 Fibrinogen decreased ---- +test_that("derive_var_atoxgr, test 28: CTCAEv5 Fibrinogen decreased", { + expected_fib <- tibble::tribble( + ~ATOXDSCL, ~AVAL, ~ANRLO, ~PCHG, ~AVALU, ~ATOXGRL, + "Not a term", 9, 10, 40, "g/L", NA, + NA_character_, 10, 10, 40, "g/L", NA, + # Satisfies < 0.5 for grade 4 - other criteria missing + "Fibrinogen decreased", 0.49, NA, NA, "g/L", "4", + # Satisfies < 0.5 for grade 4 - satisfies grade 3 for other criteria + "Fibrinogen decreased", 0.49, 1, -51, "g/L", "4", + # Satisfies < 0.25*LLN for grade 4 - PCHG missing + "Fibrinogen decreased", 0.5, 2.1, NA, "g/L", "4", + # Satisfies < 0.25*LLN for grade 4 - PCHG satisfies grade 3 + "Fibrinogen decreased", 0.5, 2.1, -51, "g/L", "4", + # Satisfies <=75% decrease for grade 4 - LLN satisfies grade 3 + "Fibrinogen decreased", 0.5, 1.1, -75, "g/L", "4", + # Satisfies < 0.5*LLN for grade 3 - PCHG missing + "Fibrinogen decreased", 1, 2.1, NA, "g/L", "3", + # Satisfies < 0.5*LLN for grade 3 - PCHG satisfies grade 2 + "Fibrinogen decreased", 1, 2.1, -49, "g/L", "3", + # Satisfies <=50% decrease for grade 3 - LLN satisfies grade 2 + "Fibrinogen decreased", 1, 2, -50, "g/L", "3", + # Satisfies < 0.75*LLN for grade 2 - PCHG missing + "Fibrinogen decreased", 1.5, 2.1, NA, "g/L", "2", + # Satisfies < 0.75*LLN for grade 2 - PCHG satisfies grade 1 + "Fibrinogen decreased", 1.5, 2.1, -10, "g/L", "2", + # Satisfies <=25% for grade 2 - LLN satisfies grade 1 + "Fibrinogen decreased", 1.5, 1.6, -25, "g/L", "2", + # Satisfies < LLN for grade 1 - PCHG missing + "Fibrinogen decreased", 2, 2.1, NA, "g/L", "1", + # Satisfies < LLN for grade 1 - PCHG satisfies grade 0 + "Fibrinogen decreased", 2, 2.1, 10, "g/L", "1", + # Satisfies grade 0 - AVAL >= LLN AND no % descrease + "Fibrinogen decreased", 1.5, 1.5, 0, "g/L", "0", + # Satisfies % decrease for grade 1 - AVAL = LLN so not abnormal + "Fibrinogen decreased", 1.5, 1.5, -1, "g/L", "0", + # AVAL >= LLN - PCT missing but its normal so ignore PCT + "Fibrinogen decreased", 1.5, 1.5, NA, "g/L", "0", + # Satisfies <=75% decrease for grade 4 - LLN missing do not know its abnormal + "Fibrinogen decreased", 1, NA, -75, "g/L", NA, + # Satisfies <=50% decrease for grade 3 - LLN missing do not know its abnormal + "Fibrinogen decreased", 1, NA, -50, "g/L", NA, + # Satisfies <=25% decrease for grade 2 - LLN missing do not know its abnormal + "Fibrinogen decreased", 1.5, NA, -25, "g/L", NA, + # Satisfies % decrease for grade 1 - LLN missing do not know its abnormal + "Fibrinogen decreased", 1.5, NA, -1, "g/L", NA, + # PCT >= 0 BUT LLN missing cannot grade as NORMAL + "Fibrinogen decreased", 1.5, NA, 10, "g/L", NA, + # AVAL missing cannot grade + "Fibrinogen decreased", NA, 1.5, 10, "g/L", NA, + # wrong unit cannot grade as it may satisfy grade 4 + "Fibrinogen decreased", 1.5, 1.5, 0, "g/dL", NA, + # missing unit cannot grade as it may satisfy grade 4 + "Fibrinogen decreased", 1.5, 1.5, 0, NA, NA, + ) + input_fib <- expected_fib %>% + select(-ATOXGRL) + + actual_fib <- derive_var_atoxgr_dir( + input_fib, + new_var = ATOXGRL, + meta_criteria = atoxgr_criteria_ctcv5, + tox_description_var = ATOXDSCL, + criteria_direction = "L", + get_unit_expr = AVALU + ) + + expect_dfs_equal( + base = expected_fib, + compare = actual_fib, keys = c("ATOXDSCL", "AVAL", "ANRLO", "PCHG", "AVALU") ) }) -### 13. GGT increased ---- +### GGT increased (NCICTCv4) +### NCICTCAEv5 same criteria as NCICTCAEv4 when BASELINE is normal ### Grade 4: >20.0 x ULN ### Grade 3: >5.0 - 20.0 x ULN ### Grade 2: >2.5 - 5.0 x ULN ### Grade 1: >ULN - 2.5 x ULN -test_that("derive_var_atoxgr_dir: Test 13 NCICTCAEv4 GGT increased", { - exp_out_ctcv4_13 <- tibble::tribble( - ~ATOXDSCH, ~AVAL, ~ANRLO, ~ANRHI, ~AVALU, ~ATOXGRH, +expected_ggt_ctcv4 <- tibble::tribble( + ~ATOXDSCH, ~AVAL, ~ANRLO, ~ANRHI, ~AVALU, ~ATOXGRH, + "Not a term", 80, 0, 40, NA_character_, NA, + NA_character_, 60, 0, 40, NA_character_, NA, + "GGT increased", 801, 0, 40, NA_character_, "4", + "GGT increased", 800, 0, 40, NA_character_, "3", + "GGT increased", 201, 0, 40, NA_character_, "3", + "GGT increased", 200, 0, 40, NA_character_, "2", + "GGT increased", 101, 0, 40, NA_character_, "2", + "GGT increased", 100, 0, 40, NA_character_, "1", + "GGT increased", 41, 0, 40, NA_character_, "1", + "GGT increased", 40, 0, 40, NA_character_, "0", + # ANRHI missing - cannot grade + "GGT increased", 100, 0, NA, NA_character_, NA, + # AVAL missing cannot grade + "GGT increased", NA, 0, NA, NA_character_, NA, +) + +# ---- derive_var_atoxgr, test 29: CTCAEv4 GGT increased ---- +test_that("derive_var_atoxgr, test 29: CTCAEv4 GGT increased", { + input_ggt <- expected_ggt_ctcv4 %>% + select(-ATOXGRH) + + actual_ggt <- derive_var_atoxgr_dir( + input_ggt, + new_var = ATOXGRH, + meta_criteria = atoxgr_criteria_ctcv4, + tox_description_var = ATOXDSCH, + criteria_direction = "H", + get_unit_expr = AVALU + ) + + expect_dfs_equal( + base = expected_ggt_ctcv4, + compare = actual_ggt, + keys = c("ATOXDSCH", "AVAL", "ANRLO", "ANRHI", "AVALU") + ) +}) + +### GGT increased (NCICTCv5) +### NCICTCAEv5 same criteria as NCICTCAEv4 when BASELINE is normal +### Grade 4: >20.0 x ULN if BL was normal OR >20.0 x BL if BL was abnormal +### Grade 3: >5.0 - 20.0 x ULN if BL was normal OR >5.0 - 20.0 x BL if BL was abnormal +### Grade 2: >2.5 - 5.0 x ULN if BL was normal OR >2.5 - 5.0 x BL if BL was abnormal +### Grade 1: >ULN - 2.5 x ULN if BL was normal OR >2.0 - 2.5 x BL if BL was abnormal + +# ---- derive_var_atoxgr, test 30: CTCAEv5 GGT increased ---- +test_that("derive_var_atoxgr, test 30: CTCAEv5 GGT increased", { + # V5 and V4 criteria identical when BASELINE normal + expected_ggt_ctcv5_norm <- expected_ggt_ctcv4 %>% + # set BASE to be normal and create FLAG + mutate( + BASE = ANRHI, + FLAG = "NORMAL" + ) + + # create records with baseline abnormal and apply criteria + expected_ggt_ctcv5_abn <- tibble::tribble( + ~ATOXDSCH, ~AVAL, ~ANRLO, ~BASE, ~AVALU, ~ATOXGRH, "Not a term", 80, 0, 40, NA_character_, NA, NA_character_, 60, 0, 40, NA_character_, NA, "GGT increased", 801, 0, 40, NA_character_, "4", @@ -697,113 +1259,148 @@ test_that("derive_var_atoxgr_dir: Test 13 NCICTCAEv4 GGT increased", { "GGT increased", 200, 0, 40, NA_character_, "2", "GGT increased", 101, 0, 40, NA_character_, "2", "GGT increased", 100, 0, 40, NA_character_, "1", - "GGT increased", 41, 0, 40, NA_character_, "1", - "GGT increased", 40, 0, 40, NA_character_, "0", + "GGT increased", 81, 0, 40, NA_character_, "1", + "GGT increased", 80, 0, 40, NA_character_, "0", # ANRHI missing - cannot grade "GGT increased", 100, 0, NA, NA_character_, NA, # AVAL missing cannot grade "GGT increased", NA, 0, NA, NA_character_, NA, - ) - input_ctcv4_13 <- exp_out_ctcv4_13 %>% + ) %>% + # set BASE to be abnormal and create FLAG + mutate( + ANRHI = BASE - 1, + FLAG = "ABNORMAL" + ) + + # combine records with baseline normal and abnormal + expected_ggt_ctcv5 <- expected_ggt_ctcv5_norm %>% + bind_rows(expected_ggt_ctcv5_abn) + + input_ggt <- expected_ggt_ctcv5 %>% select(-ATOXGRH) - actual_output_ctcv4_13 <- derive_var_atoxgr_dir( - input_ctcv4_13, + actual_ggt <- derive_var_atoxgr_dir( + input_ggt, new_var = ATOXGRH, - meta_criteria = atoxgr_criteria_ctcv4, + meta_criteria = atoxgr_criteria_ctcv5, tox_description_var = ATOXDSCH, criteria_direction = "H", get_unit_expr = AVALU ) expect_dfs_equal( - base = exp_out_ctcv4_13, - compare = actual_output_ctcv4_13, - keys = c("ATOXDSCH", "AVAL", "ANRLO", "ANRHI", "AVALU") + base = expected_ggt_ctcv5, + compare = actual_ggt, + keys = c("ATOXDSCH", "AVAL", "ANRLO", "ANRHI", "FLAG", "AVALU") ) }) -### 14. Haptoglobin decreased ---- + +### Haptoglobin decreased (NCICTCv4) +# Same as NCICTCv5 ### Grade 1: % + select(-ATOXGRL) + +# ---- derive_var_atoxgr, test 31: CTCAEv4 Haptoglobin decreased ---- +test_that("derive_var_atoxgr, test 31: CTCAEv4 Haptoglobin decreased", { + actual_hapt <- derive_var_atoxgr_dir( + input_hapt, + new_var = ATOXGRL, + meta_criteria = atoxgr_criteria_ctcv4, + tox_description_var = ATOXDSCL, + criteria_direction = "L", + get_unit_expr = AVALU ) - input_ctcv4_14 <- exp_out_ctcv4_14 %>% - select(-ATOXGRL) - actual_output_ctcv4_14 <- derive_var_atoxgr_dir( - input_ctcv4_14, + expect_dfs_equal( + base = expected_hapt, + compare = actual_hapt, + keys = c("ATOXDSCL", "AVAL", "ANRLO", "ANRHI", "AVALU") + ) +}) + +# ---- derive_var_atoxgr, test 32: CTCAEv5 Haptoglobin decreased ---- +test_that("derive_var_atoxgr, test 32: CTCAEv5 Haptoglobin decreased", { + actual_hapt <- derive_var_atoxgr_dir( + input_hapt, new_var = ATOXGRL, - meta_criteria = atoxgr_criteria_ctcv4, + meta_criteria = atoxgr_criteria_ctcv5, tox_description_var = ATOXDSCL, criteria_direction = "L", get_unit_expr = AVALU ) expect_dfs_equal( - base = exp_out_ctcv4_14, - compare = actual_output_ctcv4_14, + base = expected_hapt, + compare = actual_hapt, keys = c("ATOXDSCL", "AVAL", "ANRLO", "ANRHI", "AVALU") ) }) -### 15. Hemoglobin increased ---- +### Hemoglobin increased +# NCICTCAEv5 same as NCICTCAEv4 when BASE is normal ### Grade 3: Increase in >4 gm/dL above ULN or above baseline if baseline is above ULN ### Grade 2: Increase in >2 - 4 gm/dL above ULN or above baseline if baseline is above ULN ### Grade 1: Increase in >0 - 2 gm/dL above ULN or above baseline if baseline is above ULN -test_that("derive_var_atoxgr_dir: Test 15 NCICTCAEv4 Hemoglobin increased", { - exp_out_ctcv4_15 <- tibble::tribble( - ~ATOXDSCH, ~AVAL, ~BASE, ~ANRHI, ~AVALU, ~ATOXGRH, ~TESTNUM, - "Not a term", 80, 120, 200, "g/L", NA, 1, - NA_character_, 60, 50, 100, "g/L", NA, 2, - # BASE greater than ANRHI - "Hemoglobin increased", 106, 65, 60, "g/L", "3", 3, - "Hemoglobin increased", 105, 65, 60, "g/L", "2", 4, - "Hemoglobin increased", 86, 65, 60, "g/L", "2", 5, - "Hemoglobin increased", 85, 65, 60, "g/L", "1", 6, - "Hemoglobin increased", 66, 65, 60, "g/L", "1", 7, - "Hemoglobin increased", 65, 65, 60, "g/L", "0", 8, - "Hemoglobin increased", NA, 65, 60, "g/L", NA, 9, - # BASE less than or equal to ANRHI - "Hemoglobin increased", 106, 60, 65, "g/L", "3", 10, - "Hemoglobin increased", 105, 60, 65, "g/L", "2", 11, - "Hemoglobin increased", 86, 60, 65, "g/L", "2", 12, - "Hemoglobin increased", 85, 60, 65, "g/L", "1", 13, - "Hemoglobin increased", 66, 60, 65, "g/L", "1", 14, - "Hemoglobin increased", 65, 60, 65, "g/L", "0", 15, - "Hemoglobin increased", NA, 60, 65, "g/L", NA, 16, - # BASE missing - "Hemoglobin increased", 106, NA, 65, "g/L", "3", 17, - "Hemoglobin increased", 105, NA, 65, "g/L", "2", 18, - "Hemoglobin increased", 86, NA, 65, "g/L", "2", 19, - "Hemoglobin increased", 85, NA, 65, "g/L", "1", 20, - "Hemoglobin increased", 66, NA, 65, "g/L", "1", 21, - "Hemoglobin increased", 65, NA, 65, "g/L", "0", 22, - "Hemoglobin increased", NA, NA, 65, "g/L", NA, 23, - # Unit missing cannot grade - "Hemoglobin increased", 200, 61, 65, NA, NA, 24, - # ANRHI missing - cannot grade - "Hemoglobin increased", 200, 60, NA, "g/L", NA, 25, - # AVAL missing cannot grade - "Hemoglobin increased", NA, 60, 65, "g/L", NA, 26, - ) - input_ctcv4_15 <- exp_out_ctcv4_15 %>% +expected_hgbi <- tibble::tribble( + ~ATOXDSCH, ~AVAL, ~BASE, ~ANRHI, ~AVALU, ~ATOXGRH, ~TESTNUM, ~V5, + "Not a term", 80, 120, 200, "g/L", NA, 1, "Y", + NA_character_, 60, 50, 100, "g/L", NA, 2, "Y", + # BASE greater than ANRHI + "Hemoglobin increased", 106, 65, 60, "g/L", "3", 3, "N", + "Hemoglobin increased", 105, 65, 60, "g/L", "2", 4, "N", + "Hemoglobin increased", 86, 65, 60, "g/L", "2", 5, "N", + "Hemoglobin increased", 85, 65, 60, "g/L", "1", 6, "N", + "Hemoglobin increased", 66, 65, 60, "g/L", "1", 7, "N", + "Hemoglobin increased", 65, 65, 60, "g/L", "0", 8, "N", + "Hemoglobin increased", NA, 65, 60, "g/L", NA, 9, "N", + # BASE less than or equal to ANRHI + "Hemoglobin increased", 106, 60, 65, "g/L", "3", 10, "Y", + "Hemoglobin increased", 105, 60, 65, "g/L", "2", 11, "Y", + "Hemoglobin increased", 86, 60, 65, "g/L", "2", 12, "Y", + "Hemoglobin increased", 85, 60, 65, "g/L", "1", 13, "Y", + "Hemoglobin increased", 66, 60, 65, "g/L", "1", 14, "Y", + "Hemoglobin increased", 65, 60, 65, "g/L", "0", 15, "Y", + "Hemoglobin increased", NA, 60, 65, "g/L", NA, 16, "Y", + # BASE missing + "Hemoglobin increased", 106, NA, 65, "g/L", "3", 17, "N", + "Hemoglobin increased", 105, NA, 65, "g/L", "2", 18, "N", + "Hemoglobin increased", 86, NA, 65, "g/L", "2", 19, "N", + "Hemoglobin increased", 85, NA, 65, "g/L", "1", 20, "N", + "Hemoglobin increased", 66, NA, 65, "g/L", "1", 21, "N", + "Hemoglobin increased", 65, NA, 65, "g/L", "0", 22, "N", + "Hemoglobin increased", NA, NA, 65, "g/L", NA, 23, "N", + # Unit missing cannot grade + "Hemoglobin increased", 200, 61, 65, NA, NA, 24, "Y", + # ANRHI missing - cannot grade + "Hemoglobin increased", 200, 60, NA, "g/L", NA, 25, "Y", + # AVAL missing cannot grade + "Hemoglobin increased", NA, 60, 65, "g/L", NA, 26, "Y", +) + +# ---- derive_var_atoxgr, test 33: CTCAEv4 Hemoglobin increased ---- +test_that("derive_var_atoxgr, test 33: CTCAEv4 Hemoglobin increased", { + input_hgbi <- expected_hgbi %>% select(-ATOXGRH) - actual_output_ctcv4_15 <- derive_var_atoxgr_dir( - input_ctcv4_15, + actual_hgbi <- derive_var_atoxgr_dir( + input_hgbi, new_var = ATOXGRH, meta_criteria = atoxgr_criteria_ctcv4, tox_description_var = ATOXDSCH, @@ -812,19 +1409,45 @@ test_that("derive_var_atoxgr_dir: Test 15 NCICTCAEv4 Hemoglobin increased", { ) expect_dfs_equal( - base = exp_out_ctcv4_15, - compare = actual_output_ctcv4_15, + base = expected_hgbi, + compare = actual_hgbi, keys = c("TESTNUM") ) }) -### 16. INR increased ---- -### Grade 3: >2.5 x ULN; >2.5 times above baseline if on anticoagulation -### Grade 2: >1.5 - 2.5 x ULN; >1.5 - 2.5 times above baseline if on anticoagulation +# ---- derive_var_atoxgr, test 34: CTCAEv5 Hemoglobin increased ---- +test_that("derive_var_atoxgr, test 34: CTCAEv5 Hemoglobin increased", { + expected_hgbi <- expected_hgbi %>% + filter(V5 == "Y") + + input_hgbi <- expected_hgbi %>% + select(-ATOXGRH) + + actual_hgbi <- derive_var_atoxgr_dir( + input_hgbi, + new_var = ATOXGRH, + meta_criteria = atoxgr_criteria_ctcv5, + tox_description_var = ATOXDSCH, + criteria_direction = "H", + get_unit_expr = AVALU + ) + + expect_dfs_equal( + base = expected_hgbi, + compare = actual_hgbi, + keys = c("TESTNUM") + ) +}) + +### INR increased (NCICTCV4) +### NCICTCV5 different for grade 1 +### Grade 3: >2.5 x ULN; >2.5 times above baseline if on anticoagulation +### Grade 2: >1.5 - 2.5 x ULN; >1.5 - 2.5 times above baseline if on anticoagulation ### Grade 1: >1 - 1.5 x ULN; >1 - 1.5 times above baseline if on anticoagulation -test_that("derive_var_atoxgr_dir: Test 16 NCICTCAEv4 INR increased", { - exp_out_ctcv4_16 <- tibble::tribble( +# ---- derive_var_atoxgr, test 35: CTCAEv4 INR increased ---- +test_that("derive_var_atoxgr, test 35: CTCAEv4 INR increased", { + expected_inri <- tibble::tribble( ~ATOXDSCH, ~AVAL, ~BASE, ~ANRHI, ~AVALU, ~ATOXGRH, ~TESTNUM, "Not a term", 80, 120, 200, NA_character_, NA, 1, NA_character_, 60, 50, 100, NA_character_, NA, 2, @@ -849,11 +1472,11 @@ test_that("derive_var_atoxgr_dir: Test 16 NCICTCAEv4 INR increased", { # AVAL missing cannot grade "INR Increased", NA, 100, 100, NA_character_, NA, 17, ) - input_ctcv4_16 <- exp_out_ctcv4_16 %>% + input_inri <- expected_inri %>% select(-ATOXGRH) - actual_output_ctcv4_16 <- derive_var_atoxgr_dir( - input_ctcv4_16, + actual_inri <- derive_var_atoxgr_dir( + input_inri, new_var = ATOXGRH, meta_criteria = atoxgr_criteria_ctcv4, tox_description_var = ATOXDSCH, @@ -862,131 +1485,227 @@ test_that("derive_var_atoxgr_dir: Test 16 NCICTCAEv4 INR increased", { ) expect_dfs_equal( - base = exp_out_ctcv4_16, - compare = actual_output_ctcv4_16, + base = expected_inri, + compare = actual_inri, + keys = c("TESTNUM") + ) +}) + +### INR increased (NCICTCV4) +### NCICTCV5 different for grade 1 +### Grade 3: >2.5 x ULN; >2.5 times above baseline if on anticoagulation +### Grade 2: >1.5 - 2.5 x ULN; >1.5 - 2.5 times above baseline if on anticoagulation +### Grade 1: >1.2 - 1.5 x ULN; >1 - 1.5 times above baseline if on anticoagulation + +# ---- derive_var_atoxgr, test 36: CTCAEv5 INR increased ---- +test_that("derive_var_atoxgr, test 36: CTCAEv5 INR increased", { + expected_inri <- tibble::tribble( + ~ATOXDSCH, ~AVAL, ~BASE, ~ANRHI, ~AVALU, ~ATOXGRH, ~TESTNUM, + "Not a term", 80, 120, 200, NA_character_, NA, 1, + NA_character_, 60, 50, 100, NA_character_, NA, 2, + # GRADE derived from AVAL against ANRHI + "INR IncreaSed", 251, 200, 100, NA_character_, "3", 3, + "INR Increased", 250, 199, 100, NA_character_, "2", 4, + "INR Increased", 151, 150, 100, NA_character_, "2", 5, + "INR Increased", 150, 150, 100, NA_character_, "1", 6, + "INR Increased", 121, 150, 100, NA_character_, "1", 7, + "INR Increased", 120, 120, 100, NA_character_, "0", 8, + # GRADE derived from AVAL against BASE + "INR IncreaSed", 251, 100, 200, NA_character_, "3", 9, + "INR Increased", 250, 100, 199, NA_character_, "2", 10, + "INR Increased", 151, 100, 150, NA_character_, "2", 11, + "INR Increased", 150, 100, 150, NA_character_, "1", 12, + "INR Increased", 101, 100, 150, NA_character_, "1", 13, + "INR Increased", 100, 100, 100, NA_character_, "0", 14, + # BASE missing - AVAL <= ANRLO cannot grade as NORMAL + "INR Increased", 100, NA, 100, NA_character_, NA, 15, + # ANRHI missing - AVAL <= BASE cannot grade as NORMAL + "INR Increased", 100, 100, NA, NA_character_, NA, 16, + # AVAL missing cannot grade + "INR Increased", NA, 100, 100, NA_character_, NA, 17, + ) + input_inri <- expected_inri %>% + select(-ATOXGRH) + + actual_inri <- derive_var_atoxgr_dir( + input_inri, + new_var = ATOXGRH, + meta_criteria = atoxgr_criteria_ctcv5, + tox_description_var = ATOXDSCH, + criteria_direction = "H", + get_unit_expr = AVALU + ) + + expect_dfs_equal( + base = expected_inri, + compare = actual_inri, keys = c("TESTNUM") ) }) -### 17. Lipase increased ---- +### Lipase increased +### NCICTCAEv4 and NCICTCAEv5 criteria is the same ### Grade 4: >5.0 x ULN ### Grade 3: >2.0 - 5.0 x ULN ### Grade 2: >1.5 - 2.0 x ULN ### Grade 1: >ULN - 1.5 x ULN -test_that("derive_var_atoxgr_dir: Test 17 NCICTCAEv4 Lipase increased", { - exp_out_ctcv4_17 <- tibble::tribble( - ~ATOXDSCH, ~AVAL, ~ANRLO, ~ANRHI, ~AVALU, ~ATOXGRH, - "Not a term", 80, 120, 200, NA_character_, NA, - NA_character_, 60, 50, 100, NA_character_, NA, - "Lipase IncreaSed", 501, 0, 100, NA_character_, "4", - "Lipase Increased", 500, 0, 100, NA_character_, "3", - "Lipase Increased", 201, 0, 100, NA_character_, "3", - "Lipase Increased", 200, 0, 100, NA_character_, "2", - "Lipase Increased", 151, 0, 100, NA_character_, "2", - "Lipase Increased", 150, 0, 100, NA_character_, "1", - "Lipase Increased", 101, 0, 100, NA_character_, "1", - "Lipase Increased", 100, 0, 100, NA_character_, "0", - # ANRHI missing cannot grade - "Lipase Increased", 200, 0, NA, NA_character_, NA, - # AVAL missing cannot grade - "Lipase Increased", NA, 0, 100, NA_character_, NA, +expected_lip <- tibble::tribble( + ~ATOXDSCH, ~AVAL, ~ANRLO, ~ANRHI, ~AVALU, ~ATOXGRH, + "Not a term", 80, 120, 200, NA_character_, NA, + NA_character_, 60, 50, 100, NA_character_, NA, + "Lipase IncreaSed", 501, 0, 100, NA_character_, "4", + "Lipase Increased", 500, 0, 100, NA_character_, "3", + "Lipase Increased", 201, 0, 100, NA_character_, "3", + "Lipase Increased", 200, 0, 100, NA_character_, "2", + "Lipase Increased", 151, 0, 100, NA_character_, "2", + "Lipase Increased", 150, 0, 100, NA_character_, "1", + "Lipase Increased", 101, 0, 100, NA_character_, "1", + "Lipase Increased", 100, 0, 100, NA_character_, "0", + # ANRHI missing cannot grade + "Lipase Increased", 200, 0, NA, NA_character_, NA, + # AVAL missing cannot grade + "Lipase Increased", NA, 0, 100, NA_character_, NA, +) +input_lip <- expected_lip %>% + select(-ATOXGRH) + +# ---- derive_var_atoxgr, test 37: CTCAEv4 Lipase increased ---- +test_that("derive_var_atoxgr, test 37: CTCAEv4 Lipase increased", { + actual_lip <- derive_var_atoxgr_dir( + input_lip, + new_var = ATOXGRH, + meta_criteria = atoxgr_criteria_ctcv4, + tox_description_var = ATOXDSCH, + criteria_direction = "H", + get_unit_expr = AVALU ) - input_ctcv4_17 <- exp_out_ctcv4_17 %>% - select(-ATOXGRH) - actual_output_ctcv4_17 <- derive_var_atoxgr_dir( - input_ctcv4_17, + expect_dfs_equal( + base = expected_lip, + compare = actual_lip, + keys = c("AVAL", "ANRLO", "ANRHI", "AVALU") + ) +}) + +# ---- derive_var_atoxgr, test 38: CTCAEv5 Lipase increased ---- +test_that("derive_var_atoxgr, test 38: CTCAEv5 Lipase increased", { + actual_lip <- derive_var_atoxgr_dir( + input_lip, new_var = ATOXGRH, - meta_criteria = atoxgr_criteria_ctcv4, + meta_criteria = atoxgr_criteria_ctcv5, tox_description_var = ATOXDSCH, criteria_direction = "H", get_unit_expr = AVALU ) expect_dfs_equal( - base = exp_out_ctcv4_17, - compare = actual_output_ctcv4_17, + base = expected_lip, + compare = actual_lip, keys = c("AVAL", "ANRLO", "ANRHI", "AVALU") ) }) -### 18. Lymphocyte count decreased ---- + +### Lymphocyte count decreased +### NCICTCAEv4 and NCICTCAEv5 criteria is the same ### Grade 4: <0.2 x 10e9 /L ### Grade 3: <0.5 - 0.2 x 10e9 /L ### Grade 2: <0.8 - 0.5 x 10e9 /L ### Grade 1: % + select(-ATOXGRL) + +# ---- derive_var_atoxgr, test 39: CTCAEv4 Lymphocyte count decreased ---- +test_that("derive_var_atoxgr, test 39: CTCAEv4 Lymphocyte count decreased", { + actual_lymd <- derive_var_atoxgr_dir( + input_lymd, + new_var = ATOXGRL, + meta_criteria = atoxgr_criteria_ctcv4, + tox_description_var = ATOXDSCL, + criteria_direction = "L", + get_unit_expr = AVALU ) - input_ctcv4_18 <- exp_out_ctcv4_18 %>% - select(-ATOXGRL) - actual_output_ctcv4_18 <- derive_var_atoxgr_dir( - input_ctcv4_18, + expect_dfs_equal( + base = expected_lymd, + compare = actual_lymd, + keys = c("TESTNUM") + ) +}) + +# ---- derive_var_atoxgr, test 40: CTCAEv5 Lymphocyte count decreased ---- +test_that("derive_var_atoxgr, test 40: CTCAEv5 Lymphocyte count decreased", { + actual_lymd <- derive_var_atoxgr_dir( + input_lymd, new_var = ATOXGRL, - meta_criteria = atoxgr_criteria_ctcv4, + meta_criteria = atoxgr_criteria_ctcv5, tox_description_var = ATOXDSCL, criteria_direction = "L", get_unit_expr = AVALU ) expect_dfs_equal( - base = exp_out_ctcv4_18, - compare = actual_output_ctcv4_18, + base = expected_lymd, + compare = actual_lymd, keys = c("TESTNUM") ) }) -### 19. Lymphocyte count increased ---- +### Lymphocyte count increased +### NCICTCAEv4 and NCICTCAEv5 criteria is the same ### Grade 3: >20,000/mm3 ### Grade 2: >4000/mm3 - 20,000/mm3 -test_that("derive_var_atoxgr_dir: Test 19 NCICTCAEv4 Lymphocyte count increased", { - exp_out_ctcv4_19 <- tibble::tribble( - ~ATOXDSCH, ~AVAL, ~ANRLO, ~ANRHI, ~AVALU, ~ATOXGRH, - "Not a term", 80, 120, 200, "10^9/L", NA, - NA_character_, 60, 50, 100, "10^9/L", NA, - "Lymphocyte count increased", 21, NA, NA, "10^9/L", "3", - "Lymphocyte count increased", 20, NA, NA, "10^9/L", "2", - "Lymphocyte count increased", 4.1, NA, NA, "10^9/L", "2", - "Lymphocyte count increased", 4, NA, NA, "10^9/L", "0", - # Unit missing cannot grade - "Lymphocyte count increased", 4, NA, NA, NA, NA, - # AVAL missing cannot grade - "Lymphocyte count increased", NA, NA, NA, "10^9/L", NA, - ) - input_ctcv4_19 <- exp_out_ctcv4_19 %>% - select(-ATOXGRH) - actual_output_ctcv4_19 <- derive_var_atoxgr_dir( - input_ctcv4_19, +expected_lymi <- tibble::tribble( + ~ATOXDSCH, ~AVAL, ~ANRLO, ~ANRHI, ~AVALU, ~ATOXGRH, + "Not a term", 80, 120, 200, "10^9/L", NA, + NA_character_, 60, 50, 100, "10^9/L", NA, + "Lymphocyte count increased", 21, NA, NA, "10^9/L", "3", + "Lymphocyte count increased", 20, NA, NA, "10^9/L", "2", + "Lymphocyte count increased", 4.1, NA, NA, "10^9/L", "2", + "Lymphocyte count increased", 4, NA, NA, "10^9/L", "0", + # Unit missing cannot grade + "Lymphocyte count increased", 4, NA, NA, NA, NA, + # AVAL missing cannot grade + "Lymphocyte count increased", NA, NA, NA, "10^9/L", NA, +) +input_lymi <- expected_lymi %>% + select(-ATOXGRH) + +# ---- derive_var_atoxgr, test 41: CTCAEv4 Lymphocyte count increased ---- +test_that("derive_var_atoxgr, test 41: CTCAEv4 Lymphocyte count increased", { + actual_lymi <- derive_var_atoxgr_dir( + input_lymi, new_var = ATOXGRH, meta_criteria = atoxgr_criteria_ctcv4, tox_description_var = ATOXDSCH, @@ -995,335 +1714,478 @@ test_that("derive_var_atoxgr_dir: Test 19 NCICTCAEv4 Lymphocyte count increased" ) expect_dfs_equal( - base = exp_out_ctcv4_19, - compare = actual_output_ctcv4_19, + base = expected_lymi, + compare = actual_lymi, + keys = c("AVAL", "ANRLO", "ANRHI", "AVALU") + ) +}) + +# ---- derive_var_atoxgr, test 42: CTCAEv5 Lymphocyte count increased ---- +test_that("derive_var_atoxgr, test 42: CTCAEv5 Lymphocyte count increased", { + actual_lymi <- derive_var_atoxgr_dir( + input_lymi, + new_var = ATOXGRH, + meta_criteria = atoxgr_criteria_ctcv5, + tox_description_var = ATOXDSCH, + criteria_direction = "H", + get_unit_expr = AVALU + ) + + expect_dfs_equal( + base = expected_lymi, + compare = actual_lymi, keys = c("AVAL", "ANRLO", "ANRHI", "AVALU") ) }) -### 20. Neutrophil count decreased ---- +### Neutrophil count decreased +### NCICTCAEv4 and NCICTCAEv5 criteria is the same ### Grade 4: <25.0 x 10e9 /L ### Grade 3: <1.0 - 0.5 x 10e9 /L ### Grade 2: <1.5 - 1.0 x 10e9 /L ### Grade 1: % + select(-ATOXGRL) + + +# ---- derive_var_atoxgr, test 43: CTCAEv4 Neutrophil count decreased ---- +test_that("derive_var_atoxgr, test 43: CTCAEv4 Neutrophil count decreased", { + actual_neut <- derive_var_atoxgr_dir( + input_neut, + new_var = ATOXGRL, + meta_criteria = atoxgr_criteria_ctcv4, + tox_description_var = ATOXDSCL, + criteria_direction = "L", + get_unit_expr = AVALU ) - input_ctcv4_20 <- exp_out_ctcv4_20 %>% - select(-ATOXGRL) - actual_output_ctcv4_20 <- derive_var_atoxgr_dir( - input_ctcv4_20, + expect_dfs_equal( + base = expected_neut, + compare = actual_neut, + keys = c("AVAL", "ANRLO", "ANRHI", "AVALU") + ) +}) + +# ---- derive_var_atoxgr, test 44: CTCAEv5 Neutrophil count decreased ---- +test_that("derive_var_atoxgr, test 44: CTCAEv5 Neutrophil count decreased", { + actual_neut <- derive_var_atoxgr_dir( + input_neut, new_var = ATOXGRL, - meta_criteria = atoxgr_criteria_ctcv4, + meta_criteria = atoxgr_criteria_ctcv5, tox_description_var = ATOXDSCL, criteria_direction = "L", get_unit_expr = AVALU ) expect_dfs_equal( - base = exp_out_ctcv4_20, - compare = actual_output_ctcv4_20, + base = expected_neut, + compare = actual_neut, keys = c("AVAL", "ANRLO", "ANRHI", "AVALU") ) }) -### 21. Platelet count decreased ---- +### Platelet count decreased +### NCICTCAEv4 and NCICTCAEv5 criteria is the same ### Grade 4: <25.0 x 10e9 /L ### Grade 3: <50.0 - 25.0 x 10e9 /L ### Grade 2: <75.0 - 50.0 x 10e9 /L ### Grade 1: % + select(-ATOXGRL) + +# ---- derive_var_atoxgr, test 45: CTCAEv4 Platelet count decreased ---- +test_that("derive_var_atoxgr, test 45: CTCAEv4 Platelet count decreased", { + actual_plate <- derive_var_atoxgr_dir( + input_plate, + new_var = ATOXGRL, + meta_criteria = atoxgr_criteria_ctcv4, + tox_description_var = ATOXDSCL, + criteria_direction = "L", + get_unit_expr = AVALU ) - input_ctcv4_21 <- exp_out_ctcv4_21 %>% - select(-ATOXGRL) - actual_output_ctcv4_21 <- derive_var_atoxgr_dir( - input_ctcv4_21, + expect_dfs_equal( + base = expected_plate, + compare = actual_plate, + keys = c("TESTNUM") + ) +}) + +# ---- derive_var_atoxgr, test 46: CTCAEv5 Platelet count decreased ---- +test_that("derive_var_atoxgr, test 46: CTCAEv5 Platelet count decreased", { + actual_plate <- derive_var_atoxgr_dir( + input_plate, new_var = ATOXGRL, - meta_criteria = atoxgr_criteria_ctcv4, + meta_criteria = atoxgr_criteria_ctcv5, tox_description_var = ATOXDSCL, criteria_direction = "L", get_unit_expr = AVALU ) expect_dfs_equal( - base = exp_out_ctcv4_21, - compare = actual_output_ctcv4_21, + base = expected_plate, + compare = actual_plate, keys = c("TESTNUM") ) }) -### 22. Serum amylase increased ---- +### Serum amylase increased +### NCICTCAEv4 and NCICTCAEv5 criteria essentially the same ### Grade 4: >5.0 x ULN ### Grade 3: >2.0 - 5.0 x ULN ### Grade 2: >1.5 - 2.0 x ULN ### Grade 1: >ULN - 1.5 x ULN -test_that("derive_var_atoxgr_dir: Test 22 NCICTCAEv4 Serum amylase increased", { - exp_out_ctcv4_22 <- tibble::tribble( - ~ATOXDSCH, ~AVAL, ~ANRLO, ~ANRHI, ~AVALU, ~ATOXGRH, - "Not a term", 80, 120, 200, NA_character_, NA, - NA_character_, 60, 50, 100, NA_character_, NA, - "Serum amylase increased", 501, 0, 100, NA_character_, "4", - "Serum amylase increased", 500, 0, 100, NA_character_, "3", - "Serum amylase increased", 201, 0, 100, NA_character_, "3", - "Serum amylase increased", 200, 0, 100, NA_character_, "2", - "Serum amylase increased", 151, 0, 100, NA_character_, "2", - "Serum amylase increased", 150, 0, 100, NA_character_, "1", - "Serum amylase increased", 101, 0, 100, NA_character_, "1", - "Serum amylase increased", 100, 0, 100, NA_character_, "0", - # ANRHI missing cannot grade - "Serum amylase increased", 200, 0, NA, NA_character_, NA, - # AVAL missing cannot grade - "Serum amylase increased", NA, 0, 100, NA_character_, NA, +expected_seri <- tibble::tribble( + ~ATOXDSCH, ~AVAL, ~ANRLO, ~ANRHI, ~AVALU, ~ATOXGRH, + "Not a term", 80, 120, 200, NA_character_, NA, + NA_character_, 60, 50, 100, NA_character_, NA, + "Serum amylase increased", 501, 0, 100, NA_character_, "4", + "Serum amylase increased", 500, 0, 100, NA_character_, "3", + "Serum amylase increased", 201, 0, 100, NA_character_, "3", + "Serum amylase increased", 200, 0, 100, NA_character_, "2", + "Serum amylase increased", 151, 0, 100, NA_character_, "2", + "Serum amylase increased", 150, 0, 100, NA_character_, "1", + "Serum amylase increased", 101, 0, 100, NA_character_, "1", + "Serum amylase increased", 100, 0, 100, NA_character_, "0", + # ANRHI missing cannot grade + "Serum amylase increased", 200, 0, NA, NA_character_, NA, + # AVAL missing cannot grade + "Serum amylase increased", NA, 0, 100, NA_character_, NA, +) +input_seri <- expected_seri %>% + select(-ATOXGRH) + +# ---- derive_var_atoxgr, test 47: CTCAEv4 Serum amylase increased ---- +test_that("derive_var_atoxgr, test 47: CTCAEv4 Serum amylase increased", { + actual_seri <- derive_var_atoxgr_dir( + input_seri, + new_var = ATOXGRH, + meta_criteria = atoxgr_criteria_ctcv4, + tox_description_var = ATOXDSCH, + criteria_direction = "H", + get_unit_expr = AVALU ) - input_ctcv4_22 <- exp_out_ctcv4_22 %>% - select(-ATOXGRH) - actual_output_ctcv4_22 <- derive_var_atoxgr_dir( - input_ctcv4_22, + expect_dfs_equal( + base = expected_seri, + compare = actual_seri, + keys = c("AVAL", "ANRLO", "ANRHI", "AVALU") + ) +}) + +# ---- derive_var_atoxgr, test 48: CTCAEv5 Serum amylase increased ---- +test_that("derive_var_atoxgr, test 48: CTCAEv5 Serum amylase increased", { + actual_seri <- derive_var_atoxgr_dir( + input_seri, new_var = ATOXGRH, - meta_criteria = atoxgr_criteria_ctcv4, + meta_criteria = atoxgr_criteria_ctcv5, tox_description_var = ATOXDSCH, criteria_direction = "H", get_unit_expr = AVALU ) expect_dfs_equal( - base = exp_out_ctcv4_22, - compare = actual_output_ctcv4_22, + base = expected_seri, + compare = actual_seri, keys = c("AVAL", "ANRLO", "ANRHI", "AVALU") ) }) -### 23. White blood cell decreased ---- +### White blood cell decreased +### NCICTCAEv4 and NCICTCAEv5 criteria is the same ### Grade 4: <1.0 x 10e9 /L ### Grade 3: <2.0 - 1.0 x 10e9 /L ### Grade 2: <3.0 - 2.0 x 10e9 /L ### Grade 1: % + select(-ATOXGRL) + +# ---- derive_var_atoxgr, test 49: CTCAEv4 White blood cell decreased ---- +test_that("derive_var_atoxgr, test 49: CTCAEv4 White blood cell decreased", { + actual_wbcd <- derive_var_atoxgr_dir( + input_wbcd, + new_var = ATOXGRL, + meta_criteria = atoxgr_criteria_ctcv4, + tox_description_var = ATOXDSCL, + criteria_direction = "L", + get_unit_expr = AVALU ) - input_ctcv4_23 <- exp_out_ctcv4_23 %>% - select(-ATOXGRL) - actual_output_ctcv4_23 <- derive_var_atoxgr_dir( - input_ctcv4_23, + expect_dfs_equal( + base = expected_wbcd, + compare = actual_wbcd, + keys = c("TESTNUM") + ) +}) + +# ---- derive_var_atoxgr, test 50: CTCAEv5 White blood cell decreased ---- +test_that("derive_var_atoxgr, test 50: CTCAEv5 White blood cell decreased", { + actual_wbcd <- derive_var_atoxgr_dir( + input_wbcd, new_var = ATOXGRL, - meta_criteria = atoxgr_criteria_ctcv4, + meta_criteria = atoxgr_criteria_ctcv5, tox_description_var = ATOXDSCL, criteria_direction = "L", get_unit_expr = AVALU ) expect_dfs_equal( - base = exp_out_ctcv4_23, - compare = actual_output_ctcv4_23, + base = expected_wbcd, + compare = actual_wbcd, keys = c("TESTNUM") ) }) -# Metabolism and nutrition disorders ---- -### 24. Hypercalcemia ---- +## Metabolism and nutrition disorders + +### Hypercalcemia +### NCICTCAEv4 and NCICTCAEv5 criteria is the same ### Grade 4: >3.4 mmol/L ### Grade 3: >3.1 - 3.4 mmol/L ### Grade 2: >2.9 - 3.1 mmol/L ### Grade 1: >ULN - 2.9 mmol/L -test_that("derive_var_atoxgr_dir: Test 24 NCICTCAEv4 Hypercalcemia", { - exp_out_ctcv4_24 <- tibble::tribble( - ~ATOXDSCH, ~AVAL, ~ANRLO, ~ANRHI, ~AVALU, ~ATOXGRH, ~TESTNUM, - "Not a term", 3.5, 0, 2.5, "mmol/L", NA, 1, - NA_character_, 3.5, 0, 2.5, "mmol/L", NA, 2, - # ANRHI not missing - "Hypercalcemia", 3.5, 0, 2.5, "mmol/L", "4", 3, - "Hypercalcemia", 3.4, 0, 2.5, "mmol/L", "3", 4, - "Hypercalcemia", 3.2, 0, 2.5, "mmol/L", "3", 5, - "Hypercalcemia", 3.1, 0, 2.5, "mmol/L", "2", 6, - "Hypercalcemia", 3, 0, 2.5, "mmol/L", "2", 7, - "Hypercalcemia", 2.9, 0, 2.5, "mmol/L", "1", 8, - "Hypercalcemia", 2.6, 0, 2.5, "mmol/L", "1", 9, - "Hypercalcemia", 2.5, 0, 2.5, "mmol/L", "0", 10, - # ANRHI missing - can grade 2-4 - "Hypercalcemia", 3.5, 0, NA, "mmol/L", "4", 11, - "Hypercalcemia", 3.4, 0, NA, "mmol/L", "3", 12, - "Hypercalcemia", 3.2, 0, NA, "mmol/L", "3", 13, - "Hypercalcemia", 3.1, 0, NA, "mmol/L", "2", 14, - "Hypercalcemia", 3, 0, NA, "mmol/L", "2", 15, - # ANRHI missing - can NOT grade 0 or 1 - "Hypercalcemia", 2.9, 0, NA, "mmol/L", NA, 16, - "Hypercalcemia", 2.6, 0, NA, "mmol/L", NA, 17, - "Hypercalcemia", 2.5, 0, NA, "mmol/L", NA, 18, - # Unit missing cannot grade - "Hypercalcemia", 2.5, 0, 2.5, NA, NA, 19, - # AVAL missing cannot grade - "Hypercalcemia", NA, 0, 2.5, "mmol/L", NA, 20, +expected_calci <- tibble::tribble( + ~ATOXDSCH, ~AVAL, ~ANRLO, ~ANRHI, ~AVALU, ~ATOXGRH, ~TESTNUM, + "Not a term", 3.5, 0, 2.5, "mmol/L", NA, 1, + NA_character_, 3.5, 0, 2.5, "mmol/L", NA, 2, + # ANRHI not missing + "Hypercalcemia", 3.5, 0, 2.5, "mmol/L", "4", 3, + "Hypercalcemia", 3.4, 0, 2.5, "mmol/L", "3", 4, + "Hypercalcemia", 3.2, 0, 2.5, "mmol/L", "3", 5, + "Hypercalcemia", 3.1, 0, 2.5, "mmol/L", "2", 6, + "Hypercalcemia", 3, 0, 2.5, "mmol/L", "2", 7, + "Hypercalcemia", 2.9, 0, 2.5, "mmol/L", "1", 8, + "Hypercalcemia", 2.6, 0, 2.5, "mmol/L", "1", 9, + "Hypercalcemia", 2.5, 0, 2.5, "mmol/L", "0", 10, + # ANRHI missing - can grade 2-4 + "Hypercalcemia", 3.5, 0, NA, "mmol/L", "4", 11, + "Hypercalcemia", 3.4, 0, NA, "mmol/L", "3", 12, + "Hypercalcemia", 3.2, 0, NA, "mmol/L", "3", 13, + "Hypercalcemia", 3.1, 0, NA, "mmol/L", "2", 14, + "Hypercalcemia", 3, 0, NA, "mmol/L", "2", 15, + # ANRHI missing - can NOT grade 0 or 1 + "Hypercalcemia", 2.9, 0, NA, "mmol/L", NA, 16, + "Hypercalcemia", 2.6, 0, NA, "mmol/L", NA, 17, + "Hypercalcemia", 2.5, 0, NA, "mmol/L", NA, 18, + # Unit missing cannot grade + "Hypercalcemia", 2.5, 0, 2.5, NA, NA, 19, + # AVAL missing cannot grade + "Hypercalcemia", NA, 0, 2.5, "mmol/L", NA, 20, +) +input_calci <- expected_calci %>% + select(-ATOXGRH) + +# ---- derive_var_atoxgr, test 51: CTCAEv4 Hypercalcemia ---- +test_that("derive_var_atoxgr, test 51: CTCAEv4 Hypercalcemia", { + actual_calci <- derive_var_atoxgr_dir( + input_calci, + new_var = ATOXGRH, + meta_criteria = atoxgr_criteria_ctcv4, + tox_description_var = ATOXDSCH, + criteria_direction = "H", + get_unit_expr = AVALU ) - input_ctcv4_24 <- exp_out_ctcv4_24 %>% - select(-ATOXGRH) - actual_output_ctcv4_24 <- derive_var_atoxgr_dir( - input_ctcv4_24, + expect_dfs_equal( + base = expected_calci, + compare = actual_calci, + keys = c("TESTNUM") + ) +}) + +# ---- derive_var_atoxgr, test 52: CTCAEv5 Hypercalcemia ---- +test_that("derive_var_atoxgr, test 52: CTCAEv5 Hypercalcemia", { + actual_calci <- derive_var_atoxgr_dir( + input_calci, new_var = ATOXGRH, - meta_criteria = atoxgr_criteria_ctcv4, + meta_criteria = atoxgr_criteria_ctcv5, tox_description_var = ATOXDSCH, criteria_direction = "H", get_unit_expr = AVALU ) expect_dfs_equal( - base = exp_out_ctcv4_24, - compare = actual_output_ctcv4_24, + base = expected_calci, + compare = actual_calci, keys = c("TESTNUM") ) }) -### 25. Hypercalcemia (Ionized) ---- +### Hypercalcemia (Ionized) +### NCICTCAEv4 and NCICTCAEv5 criteria is the same ### Grade 4: >1.8 mmol/L ### Grade 3: >1.6 - 1.8 mmol/L ### Grade 2: >1.5 - 1.6 mmol/L ### Grade 1: >ULN - 1.5 mmol/L -test_that("derive_var_atoxgr_dir: Test 25 NCICTCAEv4 Hypercalcemia (Ionized)", { - exp_out_ctcv4_25 <- tibble::tribble( - ~ATOXDSCH, ~AVAL, ~ANRLO, ~ANRHI, ~AVALU, ~ATOXGRH, ~TESTNUM, - "Not a term", 1.9, 0, 1.3, "mmol/L", NA, 1, - NA_character_, 1.9, 0, 1.3, "mmol/L", NA, 2, - # ANRHI not missing - "Hypercalcemia (Ionized)", 1.9, 0, 1.3, "mmol/L", "4", 3, - "Hypercalcemia (Ionized)", 1.8, 0, 1.3, "mmol/L", "3", 4, - "Hypercalcemia (Ionized)", 1.7, 0, 1.3, "mmol/L", "3", 5, - "Hypercalcemia (Ionized)", 1.6, 0, 1.3, "mmol/L", "2", 6, - "Hypercalcemia (Ionized)", 1.51, 0, 1.3, "mmol/L", "2", 7, - "Hypercalcemia (Ionized)", 1.5, 0, 1.3, "mmol/L", "1", 8, - "Hypercalcemia (Ionized)", 1.4, 0, 1.3, "mmol/L", "1", 9, - "Hypercalcemia (Ionized)", 1.3, 0, 1.3, "mmol/L", "0", 10, - # ANRHI missing - can grade 2-4 - "Hypercalcemia (Ionized)", 1.9, 0, NA, "mmol/L", "4", 11, - "Hypercalcemia (Ionized)", 1.8, 0, NA, "mmol/L", "3", 12, - "Hypercalcemia (Ionized)", 1.7, 0, NA, "mmol/L", "3", 13, - "Hypercalcemia (Ionized)", 1.6, 0, NA, "mmol/L", "2", 14, - "Hypercalcemia (Ionized)", 1.51, 0, NA, "mmol/L", "2", 15, - # ANRHI missing - can NOT grade 0 or 1 - "Hypercalcemia (Ionized)", 1.5, 0, NA, "mmol/L", NA, 16, - "Hypercalcemia (Ionized)", 1.4, 0, NA, "mmol/L", NA, 17, - "Hypercalcemia (Ionized)", 1.3, 0, NA, "mmol/L", NA, 18, - # Unit missing cannot grade 1, - "Hypercalcemia (Ionized)", 1.3, 0, 1.3, NA, NA, 19, - # AVAL missing cannot grade - "Hypercalcemia (Ionized)", NA, 0, 1.3, "mmol/L", NA, 20, +expected_calioni <- tibble::tribble( + ~ATOXDSCH, ~AVAL, ~ANRLO, ~ANRHI, ~AVALU, ~ATOXGRH, ~TESTNUM, + "Not a term", 1.9, 0, 1.3, "mmol/L", NA, 1, + NA_character_, 1.9, 0, 1.3, "mmol/L", NA, 2, + # ANRHI not missing + "Hypercalcemia (Ionized)", 1.9, 0, 1.3, "mmol/L", "4", 3, + "Hypercalcemia (Ionized)", 1.8, 0, 1.3, "mmol/L", "3", 4, + "Hypercalcemia (Ionized)", 1.7, 0, 1.3, "mmol/L", "3", 5, + "Hypercalcemia (Ionized)", 1.6, 0, 1.3, "mmol/L", "2", 6, + "Hypercalcemia (Ionized)", 1.51, 0, 1.3, "mmol/L", "2", 7, + "Hypercalcemia (Ionized)", 1.5, 0, 1.3, "mmol/L", "1", 8, + "Hypercalcemia (Ionized)", 1.4, 0, 1.3, "mmol/L", "1", 9, + "Hypercalcemia (Ionized)", 1.3, 0, 1.3, "mmol/L", "0", 10, + # ANRHI missing - can grade 2-4 + "Hypercalcemia (Ionized)", 1.9, 0, NA, "mmol/L", "4", 11, + "Hypercalcemia (Ionized)", 1.8, 0, NA, "mmol/L", "3", 12, + "Hypercalcemia (Ionized)", 1.7, 0, NA, "mmol/L", "3", 13, + "Hypercalcemia (Ionized)", 1.6, 0, NA, "mmol/L", "2", 14, + "Hypercalcemia (Ionized)", 1.51, 0, NA, "mmol/L", "2", 15, + # ANRHI missing - can NOT grade 0 or 1 + "Hypercalcemia (Ionized)", 1.5, 0, NA, "mmol/L", NA, 16, + "Hypercalcemia (Ionized)", 1.4, 0, NA, "mmol/L", NA, 17, + "Hypercalcemia (Ionized)", 1.3, 0, NA, "mmol/L", NA, 18, + # Unit missing cannot grade 1, + "Hypercalcemia (Ionized)", 1.3, 0, 1.3, NA, NA, 19, + # AVAL missing cannot grade + "Hypercalcemia (Ionized)", NA, 0, 1.3, "mmol/L", NA, 20, +) +input_calioni <- expected_calioni %>% + select(-ATOXGRH) + + +# ---- derive_var_atoxgr, test 53: CTCAEv4 Hypercalcemia (Ionized) ---- +test_that("derive_var_atoxgr, test 53: CTCAEv4 Hypercalcemia (Ionized)", { + actual_calioni <- derive_var_atoxgr_dir( + input_calioni, + new_var = ATOXGRH, + meta_criteria = atoxgr_criteria_ctcv4, + tox_description_var = ATOXDSCH, + criteria_direction = "H", + get_unit_expr = AVALU ) - input_ctcv4_25 <- exp_out_ctcv4_25 %>% - select(-ATOXGRH) - actual_output_ctcv4_25 <- derive_var_atoxgr_dir( - input_ctcv4_25, + expect_dfs_equal( + base = expected_calioni, + compare = actual_calioni, + keys = c("TESTNUM") + ) +}) + +# ---- derive_var_atoxgr, test 54: CTCAEv5 Hypercalcemia (Ionized) ---- +test_that("derive_var_atoxgr, test 54: CTCAEv5 Hypercalcemia (Ionized)", { + actual_calioni <- derive_var_atoxgr_dir( + input_calioni, new_var = ATOXGRH, - meta_criteria = atoxgr_criteria_ctcv4, + meta_criteria = atoxgr_criteria_ctcv5, tox_description_var = ATOXDSCH, criteria_direction = "H", get_unit_expr = AVALU ) expect_dfs_equal( - base = exp_out_ctcv4_25, - compare = actual_output_ctcv4_25, + base = expected_calioni, + compare = actual_calioni, keys = c("TESTNUM") ) }) -### 26. Hyperglycemia (Fasting) ---- +### Hyperglycemia (Fasting) (NCICTCAEv4) +### not included in NCICTCAEv5 ### Grade 4: >27.8 mmol/L ### Grade 3: >13.9 - 27.8 mmol/L ### Grade 2: >8.9 - 13.9 mmol/L ### Grade 1: >ULN - 8.9 mmol/L -test_that("derive_var_atoxgr_dir: Test 26 NCICTCAEv4 Hyperglycemia (Fasting)", { - exp_out_ctcv4_26 <- tibble::tribble( +# ---- derive_var_atoxgr, test 55: CTCAEv4 Hyperglycemia (Fasting) ---- +test_that("derive_var_atoxgr, test 55: CTCAEv4 Hyperglycemia (Fasting)", { + expected_glycfi <- tibble::tribble( ~ATOXDSCH, ~AVAL, ~ANRLO, ~ANRHI, ~AVALU, ~ATOXGRH, ~TESTNUM, "Not a term", 27.9, 0, 5.3, "mmol/L", NA, 1, NA_character_, 27.9, 0, 5.3, "mmol/L", NA, 2, @@ -1351,11 +2213,11 @@ test_that("derive_var_atoxgr_dir: Test 26 NCICTCAEv4 Hyperglycemia (Fasting)", { # AVAL missing cannot grade "Hyperglycemia (Fasting)", NA, 0, 5.3, "mmol/L", NA, 20, ) - input_ctcv4_26 <- exp_out_ctcv4_26 %>% + input_glycfi <- expected_glycfi %>% select(-ATOXGRH) - actual_output_ctcv4_26 <- derive_var_atoxgr_dir( - input_ctcv4_26, + actual_glycfi <- derive_var_atoxgr_dir( + input_glycfi, new_var = ATOXGRH, meta_criteria = atoxgr_criteria_ctcv4, tox_description_var = ATOXDSCH, @@ -1364,18 +2226,20 @@ test_that("derive_var_atoxgr_dir: Test 26 NCICTCAEv4 Hyperglycemia (Fasting)", { ) expect_dfs_equal( - base = exp_out_ctcv4_26, - compare = actual_output_ctcv4_26, + base = expected_glycfi, + compare = actual_glycfi, keys = c("TESTNUM") ) }) -### 27. Hyperglycemia ---- +### Hyperglycemia (NCICTCAEv4) +### not included in NCICTCAEv5 ### Grade 4: >27.8 mmol/L ### Grade 3: >13.9 - 27.8 mmol/L -test_that("derive_var_atoxgr_dir: Test 27 NCICTCAEv4 Hyperglycemia", { - exp_out_ctcv4_27 <- tibble::tribble( +# ---- derive_var_atoxgr, test 56: CTCAEv4 Hyperglycemia ---- +test_that("derive_var_atoxgr, test 56: CTCAEv4 Hyperglycemia", { + expected_glyci <- tibble::tribble( ~ATOXDSCH, ~AVAL, ~ANRLO, ~ANRHI, ~AVALU, ~ATOXGRH, ~TESTNUM, "Not a term", 27.9, 0, 5.3, "mmol/L", NA, 1, NA_character_, 27.9, 0, 5.3, "mmol/L", NA, 2, @@ -1389,11 +2253,11 @@ test_that("derive_var_atoxgr_dir: Test 27 NCICTCAEv4 Hyperglycemia", { # AVAL missing cannot grade "Hyperglycemia", NA, 0, 5.3, "mmol/L", NA, 9, ) - input_ctcv4_27 <- exp_out_ctcv4_27 %>% + input_glyci <- expected_glyci %>% select(-ATOXGRH) - actual_output_ctcv4_27 <- derive_var_atoxgr_dir( - input_ctcv4_27, + actual_glyci <- derive_var_atoxgr_dir( + input_glyci, new_var = ATOXGRH, meta_criteria = atoxgr_criteria_ctcv4, tox_description_var = ATOXDSCH, @@ -1402,243 +2266,352 @@ test_that("derive_var_atoxgr_dir: Test 27 NCICTCAEv4 Hyperglycemia", { ) expect_dfs_equal( - base = exp_out_ctcv4_27, - compare = actual_output_ctcv4_27, + base = expected_glyci, + compare = actual_glyci, keys = c("TESTNUM") ) }) -### 28. Hyperkalemia ---- +### Hyperkalemia +### NCICTCAEv4 and NCICTCAEv5 criteria is the same ### Grade 4: >7.0 mmol/L ### Grade 3: >6.0 - 7.0 mmol/L ### Grade 2: >5.5 - 6.0 mmol/L ### Grade 1: >ULN - 5.5 mmol/L -test_that("derive_var_atoxgr_dir: Test 28 NCICTCAEv4 Hyperkalemia", { - exp_out_ctcv4_28 <- tibble::tribble( - ~ATOXDSCH, ~AVAL, ~ANRLO, ~ANRHI, ~AVALU, ~ATOXGRH, ~TESTNUM, - "Not a term", 7.1, 0, 5.1, "mmol/L", NA, 1, - NA_character_, 7.1, 0, 5.1, "mmol/L", NA, 2, - # ANRHI not missing - "Hyperkalemia", 7.1, 0, 5.1, "mmol/L", "4", 3, - "Hyperkalemia", 7, 0, 5.1, "mmol/L", "3", 4, - "Hyperkalemia", 6.1, 0, 5.1, "mmol/L", "3", 5, - "Hyperkalemia", 6, 0, 5.1, "mmol/L", "2", 6, - "Hyperkalemia", 5.6, 0, 5.1, "mmol/L", "2", 7, - "Hyperkalemia", 5.5, 0, 5.1, "mmol/L", "1", 8, - "Hyperkalemia", 5.2, 0, 5.1, "mmol/L", "1", 9, - "Hyperkalemia", 5.1, 0, 5.1, "mmol/L", "0", 10, - # ANRHI missing - can grade 2-4 - "Hyperkalemia", 7.1, 0, NA, "mmol/L", "4", 11, - "Hyperkalemia", 7, 0, NA, "mmol/L", "3", 12, - "Hyperkalemia", 6.1, 0, NA, "mmol/L", "3", 13, - "Hyperkalemia", 6, 0, NA, "mmol/L", "2", 14, - "Hyperkalemia", 5.6, 0, NA, "mmol/L", "2", 15, - # ANRHI missing - can NOT grade 0 or 1 - "Hyperkalemia", 5.5, 0, NA, "mmol/L", NA, 16, - "Hyperkalemia", 5.2, 0, NA, "mmol/L", NA, 17, - "Hyperkalemia", 5.1, 0, NA, "mmol/L", NA, 18, - # Unit missing cannot grade - "Hyperkalemia", 5.1, 0, 5.1, NA, NA, 19, - # AVAL missing cannot grade - "Hyperkalemia", NA, 0, 5.1, "mmol/L", NA, 20, +expected_kalei <- tibble::tribble( + ~ATOXDSCH, ~AVAL, ~ANRLO, ~ANRHI, ~AVALU, ~ATOXGRH, ~TESTNUM, + "Not a term", 7.1, 0, 5.1, "mmol/L", NA, 1, + NA_character_, 7.1, 0, 5.1, "mmol/L", NA, 2, + # ANRHI not missing + "Hyperkalemia", 7.1, 0, 5.1, "mmol/L", "4", 3, + "Hyperkalemia", 7, 0, 5.1, "mmol/L", "3", 4, + "Hyperkalemia", 6.1, 0, 5.1, "mmol/L", "3", 5, + "Hyperkalemia", 6, 0, 5.1, "mmol/L", "2", 6, + "Hyperkalemia", 5.6, 0, 5.1, "mmol/L", "2", 7, + "Hyperkalemia", 5.5, 0, 5.1, "mmol/L", "1", 8, + "Hyperkalemia", 5.2, 0, 5.1, "mmol/L", "1", 9, + "Hyperkalemia", 5.1, 0, 5.1, "mmol/L", "0", 10, + # ANRHI missing - can grade 2-4 + "Hyperkalemia", 7.1, 0, NA, "mmol/L", "4", 11, + "Hyperkalemia", 7, 0, NA, "mmol/L", "3", 12, + "Hyperkalemia", 6.1, 0, NA, "mmol/L", "3", 13, + "Hyperkalemia", 6, 0, NA, "mmol/L", "2", 14, + "Hyperkalemia", 5.6, 0, NA, "mmol/L", "2", 15, + # ANRHI missing - can NOT grade 0 or 1 + "Hyperkalemia", 5.5, 0, NA, "mmol/L", NA, 16, + "Hyperkalemia", 5.2, 0, NA, "mmol/L", NA, 17, + "Hyperkalemia", 5.1, 0, NA, "mmol/L", NA, 18, + # Unit missing cannot grade + "Hyperkalemia", 5.1, 0, 5.1, NA, NA, 19, + # AVAL missing cannot grade + "Hyperkalemia", NA, 0, 5.1, "mmol/L", NA, 20, +) +input_kalei <- expected_kalei %>% + select(-ATOXGRH) + +# ---- derive_var_atoxgr, test 57: CTCAEv4 Hyperkalemia ---- +test_that("derive_var_atoxgr, test 57: CTCAEv4 Hyperkalemia", { + actual_kalei <- derive_var_atoxgr_dir( + input_kalei, + new_var = ATOXGRH, + meta_criteria = atoxgr_criteria_ctcv4, + tox_description_var = ATOXDSCH, + criteria_direction = "H", + get_unit_expr = AVALU ) - input_ctcv4_28 <- exp_out_ctcv4_28 %>% - select(-ATOXGRH) - actual_output_ctcv4_28 <- derive_var_atoxgr_dir( - input_ctcv4_28, + expect_dfs_equal( + base = expected_kalei, + compare = actual_kalei, + keys = c("TESTNUM") + ) +}) + +# ---- derive_var_atoxgr, test 58: CTCAEv5 Hyperkalemia ---- +test_that("derive_var_atoxgr, test 58: CTCAEv5 Hyperkalemia", { + actual_kalei <- derive_var_atoxgr_dir( + input_kalei, new_var = ATOXGRH, - meta_criteria = atoxgr_criteria_ctcv4, + meta_criteria = atoxgr_criteria_ctcv5, tox_description_var = ATOXDSCH, criteria_direction = "H", get_unit_expr = AVALU ) expect_dfs_equal( - base = exp_out_ctcv4_28, - compare = actual_output_ctcv4_28, + base = expected_kalei, + compare = actual_kalei, keys = c("TESTNUM") ) }) -### 29. Hypermagnesemia ---- +### Hypermagnesemia +### NCICTCAEv4 and NCICTCAEv5 criteria is the same ### Grade 4: >3.30 mmol/L ### Grade 3: >1.23 - 3.30 mmol/L ### Grade 1: >ULN - 1.23 mmol/L -test_that("derive_var_atoxgr_dir: Test 29 NCICTCAEv4 Hypermagnesemia", { - exp_out_ctcv4_29 <- tibble::tribble( - ~ATOXDSCH, ~AVAL, ~ANRLO, ~ANRHI, ~AVALU, ~ATOXGRH, ~TESTNUM, - "Not a term", 3.4, 0, 0.8, "mmol/L", NA, 1, - NA_character_, 3.4, 0, 0.8, "mmol/L", NA, 2, - # ANRHI not missing - "Hypermagnesemia", 3.4, 0, 0.8, "mmol/L", "4", 3, - "Hypermagnesemia", 3.3, 0, 0.8, "mmol/L", "3", 4, - "Hypermagnesemia", 1.24, 0, 0.8, "mmol/L", "3", 5, - "Hypermagnesemia", 1.23, 0, 0.8, "mmol/L", "1", 6, - "Hypermagnesemia", 0.81, 0, 0.8, "mmol/L", "1", 7, - "Hypermagnesemia", 0.8, 0, 0.8, "mmol/L", "0", 8, - # ANRHI missing - can grade 3-4 - "Hypermagnesemia", 3.4, 0, NA, "mmol/L", "4", 9, - "Hypermagnesemia", 3.3, 0, NA, "mmol/L", "3", 10, - "Hypermagnesemia", 1.24, 0, NA, "mmol/L", "3", 11, - # ANRHI missing - can NOT grade 0 or 1 - "Hypermagnesemia", 1.23, 0, NA, "mmol/L", NA, 12, - "Hypermagnesemia", 0.81, 0, NA, "mmol/L", NA, 13, - "Hypermagnesemia", 0.8, 0, NA, "mmol/L", NA, 14, - # Unit missing cannot grade - "Hypermagnesemia", 0.8, 0, 0.8, NA, NA, 15, - # AVAL missing cannot grade - "Hypermagnesemia", NA, 0, 0.8, "mmol/L", NA, 16, +expected_magni <- tibble::tribble( + ~ATOXDSCH, ~AVAL, ~ANRLO, ~ANRHI, ~AVALU, ~ATOXGRH, ~TESTNUM, + "Not a term", 3.4, 0, 0.8, "mmol/L", NA, 1, + NA_character_, 3.4, 0, 0.8, "mmol/L", NA, 2, + # ANRHI not missing + "Hypermagnesemia", 3.4, 0, 0.8, "mmol/L", "4", 3, + "Hypermagnesemia", 3.3, 0, 0.8, "mmol/L", "3", 4, + "Hypermagnesemia", 1.24, 0, 0.8, "mmol/L", "3", 5, + "Hypermagnesemia", 1.23, 0, 0.8, "mmol/L", "1", 6, + "Hypermagnesemia", 0.81, 0, 0.8, "mmol/L", "1", 7, + "Hypermagnesemia", 0.8, 0, 0.8, "mmol/L", "0", 8, + # ANRHI missing - can grade 3-4 + "Hypermagnesemia", 3.4, 0, NA, "mmol/L", "4", 9, + "Hypermagnesemia", 3.3, 0, NA, "mmol/L", "3", 10, + "Hypermagnesemia", 1.24, 0, NA, "mmol/L", "3", 11, + # ANRHI missing - can NOT grade 0 or 1 + "Hypermagnesemia", 1.23, 0, NA, "mmol/L", NA, 12, + "Hypermagnesemia", 0.81, 0, NA, "mmol/L", NA, 13, + "Hypermagnesemia", 0.8, 0, NA, "mmol/L", NA, 14, + # Unit missing cannot grade + "Hypermagnesemia", 0.8, 0, 0.8, NA, NA, 15, + # AVAL missing cannot grade + "Hypermagnesemia", NA, 0, 0.8, "mmol/L", NA, 16, +) +input_magni <- expected_magni %>% + select(-ATOXGRH) + + +# ---- derive_var_atoxgr, test 59: CTCAEv4 Hypermagnesemia ---- +test_that("derive_var_atoxgr, test 59: CTCAEv4 Hypermagnesemia", { + actual_magni <- derive_var_atoxgr_dir( + input_magni, + new_var = ATOXGRH, + meta_criteria = atoxgr_criteria_ctcv4, + tox_description_var = ATOXDSCH, + criteria_direction = "H", + get_unit_expr = AVALU ) - input_ctcv4_29 <- exp_out_ctcv4_29 %>% - select(-ATOXGRH) - actual_output_ctcv4_29 <- derive_var_atoxgr_dir( - input_ctcv4_29, + expect_dfs_equal( + base = expected_magni, + compare = actual_magni, + keys = c("TESTNUM") + ) +}) + +# ---- derive_var_atoxgr, test 60: CTCAEv5 Hypermagnesemia ---- +test_that("derive_var_atoxgr, test 60: CTCAEv5 Hypermagnesemia", { + actual_magni <- derive_var_atoxgr_dir( + input_magni, new_var = ATOXGRH, - meta_criteria = atoxgr_criteria_ctcv4, + meta_criteria = atoxgr_criteria_ctcv5, tox_description_var = ATOXDSCH, criteria_direction = "H", get_unit_expr = AVALU ) expect_dfs_equal( - base = exp_out_ctcv4_29, - compare = actual_output_ctcv4_29, + base = expected_magni, + compare = actual_magni, keys = c("TESTNUM") ) }) -### 30. Hypernatremia ---- +### Hypernatremia +### NCICTCAEv4 and NCICTCAEv5 criteria is the same ### Grade 4: >160 mmol/L ### Grade 3: >155 - 160 mmol/L ### Grade 2: >150 - 155 mmol/L ### Grade 1: >ULN - 150 mmol/L -test_that("derive_var_atoxgr_dir: Test 30 NCICTCAEv4 Hypernatremia", { - exp_out_ctcv4_30 <- tibble::tribble( - ~ATOXDSCH, ~AVAL, ~ANRLO, ~ANRHI, ~AVALU, ~ATOXGRH, ~TESTNUM, - "Not a term", 161, 0, 140, "mmol/L", NA, 1, - NA_character_, 161, 0, 140, "mmol/L", NA, 2, - # ANRHI not missing - "Hypernatremia", 161, 0, 140, "mmol/L", "4", 3, - "Hypernatremia", 160, 0, 140, "mmol/L", "3", 4, - "Hypernatremia", 156, 0, 140, "mmol/L", "3", 5, - "Hypernatremia", 155, 0, 140, "mmol/L", "2", 6, - "Hypernatremia", 151, 0, 140, "mmol/L", "2", 7, - "Hypernatremia", 150, 0, 140, "mmol/L", "1", 8, - "Hypernatremia", 141, 0, 140, "mmol/L", "1", 9, - "Hypernatremia", 140, 0, 140, "mmol/L", "0", 10, - # ANRHI missing - can grade 3-4 - "Hypernatremia", 161, 0, NA, "mmol/L", "4", 11, - "Hypernatremia", 160, 0, NA, "mmol/L", "3", 12, - "Hypernatremia", 156, 0, NA, "mmol/L", "3", 13, - "Hypernatremia", 155, 0, NA, "mmol/L", "2", 14, - "Hypernatremia", 151, 0, NA, "mmol/L", "2", 15, - # ANRHI missing - can NOT grade 0 or 1 - "Hypernatremia", 150, 0, NA, "mmol/L", NA, 16, - "Hypernatremia", 141, 0, NA, "mmol/L", NA, 17, - "Hypernatremia", 140, 0, NA, "mmol/L", NA, 18, - # Unit missing cannot grade - "Hypernatremia", 140, 0, 140, NA, NA, 19, - # AVAL missing cannot grade - "Hypernatremia", NA, 0, 140, "mmol/L", NA, 20, +expected_natri <- tibble::tribble( + ~ATOXDSCH, ~AVAL, ~ANRLO, ~ANRHI, ~AVALU, ~ATOXGRH, ~TESTNUM, + "Not a term", 161, 0, 140, "mmol/L", NA, 1, + NA_character_, 161, 0, 140, "mmol/L", NA, 2, + # ANRHI not missing + "Hypernatremia", 161, 0, 140, "mmol/L", "4", 3, + "Hypernatremia", 160, 0, 140, "mmol/L", "3", 4, + "Hypernatremia", 156, 0, 140, "mmol/L", "3", 5, + "Hypernatremia", 155, 0, 140, "mmol/L", "2", 6, + "Hypernatremia", 151, 0, 140, "mmol/L", "2", 7, + "Hypernatremia", 150, 0, 140, "mmol/L", "1", 8, + "Hypernatremia", 141, 0, 140, "mmol/L", "1", 9, + "Hypernatremia", 140, 0, 140, "mmol/L", "0", 10, + # ANRHI missing - can grade 3-4 + "Hypernatremia", 161, 0, NA, "mmol/L", "4", 11, + "Hypernatremia", 160, 0, NA, "mmol/L", "3", 12, + "Hypernatremia", 156, 0, NA, "mmol/L", "3", 13, + "Hypernatremia", 155, 0, NA, "mmol/L", "2", 14, + "Hypernatremia", 151, 0, NA, "mmol/L", "2", 15, + # ANRHI missing - can NOT grade 0 or 1 + "Hypernatremia", 150, 0, NA, "mmol/L", NA, 16, + "Hypernatremia", 141, 0, NA, "mmol/L", NA, 17, + "Hypernatremia", 140, 0, NA, "mmol/L", NA, 18, + # Unit missing cannot grade + "Hypernatremia", 140, 0, 140, NA, NA, 19, + # AVAL missing cannot grade + "Hypernatremia", NA, 0, 140, "mmol/L", NA, 20, +) +input_natri <- expected_natri %>% + select(-ATOXGRH) + +# ---- derive_var_atoxgr, test 61: CTCAEv4 Hypernatremia ---- +test_that("derive_var_atoxgr, test 61: CTCAEv4 Hypernatremia", { + actual_natri <- derive_var_atoxgr_dir( + input_natri, + new_var = ATOXGRH, + meta_criteria = atoxgr_criteria_ctcv4, + tox_description_var = ATOXDSCH, + criteria_direction = "H", + get_unit_expr = AVALU ) - input_ctcv4_30 <- exp_out_ctcv4_30 %>% - select(-ATOXGRH) - actual_output_ctcv4_30 <- derive_var_atoxgr_dir( - input_ctcv4_30, + expect_dfs_equal( + base = expected_natri, + compare = actual_natri, + keys = c("TESTNUM") + ) +}) + +# ---- derive_var_atoxgr, test 62: CTCAEv5 Hypernatremia ---- +test_that("derive_var_atoxgr, test 62: CTCAEv5 Hypernatremia", { + actual_natri <- derive_var_atoxgr_dir( + input_natri, new_var = ATOXGRH, - meta_criteria = atoxgr_criteria_ctcv4, + meta_criteria = atoxgr_criteria_ctcv5, tox_description_var = ATOXDSCH, criteria_direction = "H", get_unit_expr = AVALU ) expect_dfs_equal( - base = exp_out_ctcv4_30, - compare = actual_output_ctcv4_30, + base = expected_natri, + compare = actual_natri, keys = c("TESTNUM") ) }) -### 31. Hypertriglyceridemia ---- +### Hypertriglyceridemia +### NCICTCAEv4 and NCICTCAEv5 criteria is the same ### Grade 4: >11.4 mmol/L ### Grade 3: >5.7 mmol/L - 11.4 mmol/L ### Grade 2: >3.42 mmol/L - 5.7 mmol/L ### Grade 1: 1.71 mmol/L - 3.42 mmol/L -test_that("derive_var_atoxgr_dir: Test 31 NCICTCAEv4 Hypertriglyceridemia", { - exp_out_ctcv4_31 <- tibble::tribble( - ~ATOXDSCH, ~AVAL, ~ANRLO, ~ANRHI, ~AVALU, ~ATOXGRH, - "Not a term", 11.5, 0, 2.1, "mmol/L", NA, - NA_character_, 11.5, 0, 2.1, "mmol/L", NA, - "Hypertriglyceridemia", 11.5, 0, 2.1, "mmol/L", "4", - "Hypertriglyceridemia", 11.4, 0, 2.1, "mmol/L", "3", - "Hypertriglyceridemia", 5.8, 0, 2.1, "mmol/L", "3", - "Hypertriglyceridemia", 5.7, 0, 2.1, "mmol/L", "2", - "Hypertriglyceridemia", 3.43, 0, 2.1, "mmol/L", "2", - "Hypertriglyceridemia", 3.42, 0, 2.1, "mmol/L", "1", - "Hypertriglyceridemia", 1.72, 0, 2.1, "mmol/L", "1", - "Hypertriglyceridemia", 1.71, 0, 2.1, "mmol/L", "0", - # Unit missing cannot grade - "Hypertriglyceridemia", 1.71, 0, 2.1, NA, NA, - # AVAL missing cannot grade - "Hypertriglyceridemia", NA, 0, 2.1, "mmol/L", NA, +expected_trigi <- tibble::tribble( + ~ATOXDSCH, ~AVAL, ~ANRLO, ~ANRHI, ~AVALU, ~ATOXGRH, + "Not a term", 11.5, 0, 2.1, "mmol/L", NA, + NA_character_, 11.5, 0, 2.1, "mmol/L", NA, + "Hypertriglyceridemia", 11.5, 0, 2.1, "mmol/L", "4", + "Hypertriglyceridemia", 11.4, 0, 2.1, "mmol/L", "3", + "Hypertriglyceridemia", 5.8, 0, 2.1, "mmol/L", "3", + "Hypertriglyceridemia", 5.7, 0, 2.1, "mmol/L", "2", + "Hypertriglyceridemia", 3.43, 0, 2.1, "mmol/L", "2", + "Hypertriglyceridemia", 3.42, 0, 2.1, "mmol/L", "1", + "Hypertriglyceridemia", 1.72, 0, 2.1, "mmol/L", "1", + "Hypertriglyceridemia", 1.71, 0, 2.1, "mmol/L", "0", + # Unit missing cannot grade + "Hypertriglyceridemia", 1.71, 0, 2.1, NA, NA, + # AVAL missing cannot grade + "Hypertriglyceridemia", NA, 0, 2.1, "mmol/L", NA, +) +input_trigi <- expected_trigi %>% + select(-ATOXGRH) + +# ---- derive_var_atoxgr, test 63: CTCAEv4 Hypertriglyceridemia ---- +test_that("derive_var_atoxgr, test 63: CTCAEv4 Hypertriglyceridemia", { + actual_trigi <- derive_var_atoxgr_dir( + input_trigi, + new_var = ATOXGRH, + meta_criteria = atoxgr_criteria_ctcv4, + tox_description_var = ATOXDSCH, + criteria_direction = "H", + get_unit_expr = AVALU ) - input_ctcv4_31 <- exp_out_ctcv4_31 %>% - select(-ATOXGRH) - actual_output_ctcv4_31 <- derive_var_atoxgr_dir( - input_ctcv4_31, + expect_dfs_equal( + base = expected_trigi, + compare = actual_trigi, + keys = c("ATOXDSCH", "AVAL", "AVALU") + ) +}) + +# ---- derive_var_atoxgr, test 64: CTCAEv5 Hypertriglyceridemia ---- +test_that("derive_var_atoxgr, test 64: CTCAEv5 Hypertriglyceridemia", { + actual_trigi <- derive_var_atoxgr_dir( + input_trigi, new_var = ATOXGRH, - meta_criteria = atoxgr_criteria_ctcv4, + meta_criteria = atoxgr_criteria_ctcv5, tox_description_var = ATOXDSCH, criteria_direction = "H", get_unit_expr = AVALU ) expect_dfs_equal( - base = exp_out_ctcv4_31, - compare = actual_output_ctcv4_31, + base = expected_trigi, + compare = actual_trigi, keys = c("ATOXDSCH", "AVAL", "AVALU") ) }) -### 32. Hyperuricemia ---- +### Hyperuricemia (NCICTCAEv4) +### NCICTCAEv5 only has grade 3 ### Grade 4: >0.59 mmol/L; ### Grade 3: >ULN - 10 mg/dL (0.59 mmol/L) -test_that("derive_var_atoxgr_dir: Test 32 NCICTCAEv4 Hyperuricemia", { - exp_out_ctcv4_32 <- tibble::tribble( - ~ATOXDSCH, ~AVAL, ~ANRLO, ~ANRHI, ~AVALU, ~ATOXGRH, - "Not a term", 591, 0, 200, "umol/L", NA, - NA_character_, 591, 0, 200, "umol/L", NA, - # ANRHI not missing - "Hyperuricemia", 591, 0, 200, "umol/L", "4", - "Hyperuricemia", 590, 0, 200, "umol/L", "3", - "Hyperuricemia", 201, 0, 200, "umol/L", "3", - "Hyperuricemia", 200, 0, 200, "umol/L", "0", - # ANRHI missing - can grade 4 - "Hyperuricemia", 591, 0, NA, "umol/L", "4", - # ANRHI missing - can NOT grade 0 or 3 - "Hyperuricemia", 590, 0, NA, "umol/L", NA, - "Hyperuricemia", 201, 0, NA, "umol/L", NA, - "Hyperuricemia", 200, 0, NA, "umol/L", NA, - # Unit missing cannot grade - "Hyperuricemia", 200, 0, 200, NA, NA, - # AVAL missing cannot grade - "Hyperuricemia", NA, 0, 200, "umol/L", NA, - ) - input_ctcv4_32 <- exp_out_ctcv4_32 %>% +expected_albi <- tibble::tribble( + ~ATOXDSCH, ~AVAL, ~ANRLO, ~ANRHI, ~AVALU, ~ATOXGRH, + "Not a term", 591, 0, 200, "umol/L", NA, + NA_character_, 591, 0, 200, "umol/L", NA, + # ANRHI not missing + "Hyperuricemia", 591, 0, 200, "umol/L", "4", + "Hyperuricemia", 590, 0, 200, "umol/L", "3", + "Hyperuricemia", 201, 0, 200, "umol/L", "3", + "Hyperuricemia", 200, 0, 200, "umol/L", "0", + # ANRHI missing - can grade 4 + "Hyperuricemia", 591, 0, NA, "umol/L", "4", + # ANRHI missing - can NOT grade 0 or 3 + "Hyperuricemia", 590, 0, NA, "umol/L", NA, + "Hyperuricemia", 201, 0, NA, "umol/L", NA, + "Hyperuricemia", 200, 0, NA, "umol/L", NA, + # Unit missing cannot grade + "Hyperuricemia", 200, 0, 200, NA, NA, + # AVAL missing cannot grade + "Hyperuricemia", NA, 0, 200, "umol/L", NA, +) +input_albi <- expected_albi %>% + select(-ATOXGRH) + +### Hyperuricemia (NCICTCAEv5) +### NCICTCAEv5 only has grade 3 +### Grade 3: >ULN + +# ---- derive_var_atoxgr, test 65: CTCAEv5 Hyperuricemia ---- +test_that("derive_var_atoxgr, test 65: CTCAEv5 Hyperuricemia", { + expected_albi <- expected_albi %>% + filter(ATOXGRH != "4") + input_albi <- expected_albi %>% select(-ATOXGRH) + actual_albi <- derive_var_atoxgr_dir( + input_albi, + new_var = ATOXGRH, + meta_criteria = atoxgr_criteria_ctcv5, + tox_description_var = ATOXDSCH, + criteria_direction = "H", + get_unit_expr = AVALU + ) - actual_output_ctcv4_32 <- derive_var_atoxgr_dir( - input_ctcv4_32, + expect_dfs_equal( + base = expected_albi, + compare = actual_albi, + keys = c("ATOXDSCH", "AVAL", "ANRHI", "AVALU") + ) +}) + +# ---- derive_var_atoxgr, test 66: CTCAEv4 Hyperuricemia ---- +test_that("derive_var_atoxgr, test 66: CTCAEv4 Hyperuricemia", { + actual_albi <- derive_var_atoxgr_dir( + input_albi, new_var = ATOXGRH, meta_criteria = atoxgr_criteria_ctcv4, tox_description_var = ATOXDSCH, @@ -1647,48 +2620,50 @@ test_that("derive_var_atoxgr_dir: Test 32 NCICTCAEv4 Hyperuricemia", { ) expect_dfs_equal( - base = exp_out_ctcv4_32, - compare = actual_output_ctcv4_32, + base = expected_albi, + compare = actual_albi, keys = c("ATOXDSCH", "AVAL", "ANRHI", "AVALU") ) }) -### 33. Hypoalbuminemia ---- +### Hypoalbuminemia +### NCICTCAEv4 and NCICTCAEv5 criteria is the same ### Grade 3: <20 g/L ### Grade 2: <30 - 20 g/L ### Grade 1: % - select(-ATOXGRL) - - actual_output_ctcv4_33 <- derive_var_atoxgr_dir( - input_ctcv4_33, +expected_albd <- tibble::tribble( + ~ATOXDSCL, ~AVAL, ~ANRLO, ~ANRHI, ~AVALU, ~ATOXGRL, + "Not a term", 19, 40, 100, "G/L", NA, + NA_character_, 19, 40, 100, "G/L", NA, + # ANRLO not missing + "Hypoalbuminemia", 19, 40, 100, "G/L", "3", + "Hypoalbuminemia", 20, 40, 100, "G/L", "2", + "Hypoalbuminemia", 29, 40, 100, "G/L", "2", + "Hypoalbuminemia", 30, 40, 100, "G/L", "1", + "Hypoalbuminemia", 39, 40, 100, "G/L", "1", + "Hypoalbuminemia", 40, 40, 100, "G/L", "0", + "Hypoalbuminemia", 40, 40, NA, "G/L", "0", + # ANRLO missing - can grade 2-3 + "Hypoalbuminemia", 19, NA, 100, "G/L", "3", + "Hypoalbuminemia", 20, NA, 100, "G/L", "2", + "Hypoalbuminemia", 29, NA, 100, "G/L", "2", + # ANRLO missing - can NOT grade 0 or 1 + "Hypoalbuminemia", 30, NA, 100, "G/L", NA, + "Hypoalbuminemia", 39, NA, 100, "G/L", NA, + "Hypoalbuminemia", 40, NA, 100, "G/L", NA, + # Unit missing cannot grade + "Hypoalbuminemia", 40, 40, 100, NA, NA, + # AVAL missing cannot grade + "Hypoalbuminemia", NA, 40, 100, "G/L", NA, +) +input_albd <- expected_albd %>% + select(-ATOXGRL) + +# ---- derive_var_atoxgr, test 67: CTCAEv4 Hypoalbuminemia ---- +test_that("derive_var_atoxgr, test 67: CTCAEv4 Hypoalbuminemia", { + actual_albd <- derive_var_atoxgr_dir( + input_albd, new_var = ATOXGRL, meta_criteria = atoxgr_criteria_ctcv4, tox_description_var = ATOXDSCL, @@ -1697,52 +2672,72 @@ test_that("derive_var_atoxgr_dir: Test 33 NCICTCAEv4 Hypoalbuminemia", { ) expect_dfs_equal( - base = exp_out_ctcv4_33, - compare = actual_output_ctcv4_33, + base = expected_albd, + compare = actual_albd, keys = c("ATOXDSCL", "AVAL", "ANRLO", "ANRHI", "AVALU") ) }) +# ---- derive_var_atoxgr, test 68: CTCAEv5 Hypoalbuminemia ---- +test_that("derive_var_atoxgr, test 68: CTCAEv5 Hypoalbuminemia", { + actual_albd <- derive_var_atoxgr_dir( + input_albd, + new_var = ATOXGRL, + meta_criteria = atoxgr_criteria_ctcv5, + tox_description_var = ATOXDSCL, + criteria_direction = "L", + get_unit_expr = AVALU + ) + + expect_dfs_equal( + base = expected_albd, + compare = actual_albd, + keys = c("ATOXDSCL", "AVAL", "ANRLO", "ANRHI", "AVALU") + ) +}) -### 34. Hypocalcemia ---- +### Hypocalcemia +### NCICTCAEv4 and NCICTCAEv5 criteria is the same ### Grade 4: <1.5 mmol/L ### Grade 3: <1.75 - 1.5 mmol/L ### Grade 2: <2.0 - 1.75 mmol/L ### Grade 1: % - select(-ATOXGRL) - actual_output_ctcv4_34 <- derive_var_atoxgr_dir( - input_ctcv4_34, +expected_calcd <- tibble::tribble( + ~ATOXDSCL, ~AVAL, ~ANRLO, ~ANRHI, ~AVALU, ~ATOXGRL, + "Not a term", 1.4, 4, 100, "mmol/L", NA, + NA_character_, 1.4, 4, 100, "mmol/L", NA, + # ANRLO not missing + "Hypocalcemia", 1.4, 4, 100, "mmol/L", "4", + "Hypocalcemia", 1.5, 4, 100, "mmol/L", "3", + "Hypocalcemia", 1.74, 4, 100, "mmol/L", "3", + "Hypocalcemia", 1.75, 4, 100, "mmol/L", "2", + "Hypocalcemia", 1.9, 4, 100, "mmol/L", "2", + "Hypocalcemia", 2, 4, 100, "mmol/L", "1", + "Hypocalcemia", 3, 4, 100, "mmol/L", "1", + "Hypocalcemia", 4, 4, 100, "mmol/L", "0", + # ANRLO missing - can grade 2-4 + "Hypocalcemia", 1.4, 4, NA, "mmol/L", "4", + "Hypocalcemia", 1.5, 4, NA, "mmol/L", "3", + "Hypocalcemia", 1.74, 4, NA, "mmol/L", "3", + "Hypocalcemia", 1.75, 4, NA, "mmol/L", "2", + "Hypocalcemia", 1.9, 4, NA, "mmol/L", "2", + # ANRLO missing - can NOT grade 0 or 1 + "Hypocalcemia", 2, 4, NA, "mmol/L", "1", + "Hypocalcemia", 3, 4, NA, "mmol/L", "1", + "Hypocalcemia", 4, 4, NA, "mmol/L", "0", + # Unit missing cannot grade + "Hypocalcemia", 4, 4, 100, NA, NA, + # AVAL missing cannot grade + "Hypocalcemia", NA, 4, 100, "mmol/L", NA, +) +input_calcd <- expected_calcd %>% + select(-ATOXGRL) + +# ---- derive_var_atoxgr, test 69: CTCAEv4 Hypocalcemia ---- +test_that("derive_var_atoxgr, test 69: CTCAEv4 Hypocalcemia", { + actual_calcd <- derive_var_atoxgr_dir( + input_calcd, new_var = ATOXGRL, meta_criteria = atoxgr_criteria_ctcv4, tox_description_var = ATOXDSCL, @@ -1751,51 +2746,72 @@ test_that("derive_var_atoxgr_dir: Test 34 NCICTCAEv4 Hypocalcemia", { ) expect_dfs_equal( - base = exp_out_ctcv4_34, - compare = actual_output_ctcv4_34, + base = expected_calcd, + compare = actual_calcd, keys = c("ATOXDSCL", "AVAL", "ANRLO", "ANRHI", "AVALU") ) }) -### 35. Hypocalcemia (Ionized) ---- +# ---- derive_var_atoxgr, test 70: CTCAEv5 Hypocalcemia ---- +test_that("derive_var_atoxgr, test 70: CTCAEv5 Hypocalcemia", { + actual_calcd <- derive_var_atoxgr_dir( + input_calcd, + new_var = ATOXGRL, + meta_criteria = atoxgr_criteria_ctcv5, + tox_description_var = ATOXDSCL, + criteria_direction = "L", + get_unit_expr = AVALU + ) + + expect_dfs_equal( + base = expected_calcd, + compare = actual_calcd, + keys = c("ATOXDSCL", "AVAL", "ANRLO", "ANRHI", "AVALU") + ) +}) + +### Hypocalcemia (Ionized) +### NCICTCAEv4 and NCICTCAEv5 criteria is the same ### Grade 4: <0.8 mmol/L ### Grade 3: <0.9 - 0.8 mmol/L ### Grade 2: <1.0 - 0.9 mmol/L ### Grade 1: % - select(-ATOXGRL) - actual_output_ctcv4_35 <- derive_var_atoxgr_dir( - input_ctcv4_35, +expected_caliond <- tibble::tribble( + ~ATOXDSCL, ~AVAL, ~ANRLO, ~ANRHI, ~AVALU, ~ATOXGRL, + "Not a term", 0.79, 1.3, 100, "mmol/L", NA, + NA_character_, 0.79, 1.3, 100, "mmol/L", NA, + # ANRLO not missing + "Hypocalcemia (Ionized)", 0.79, 1.3, 100, "mmol/L", "4", + "Hypocalcemia (Ionized)", 0.8, 1.3, 100, "mmol/L", "3", + "Hypocalcemia (Ionized)", 0.89, 1.3, 100, "mmol/L", "3", + "Hypocalcemia (Ionized)", 0.9, 1.3, 100, "mmol/L", "2", + "Hypocalcemia (Ionized)", 0.99, 1.3, 100, "mmol/L", "2", + "Hypocalcemia (Ionized)", 1, 1.3, 100, "mmol/L", "1", + "Hypocalcemia (Ionized)", 1.29, 1.3, 100, "mmol/L", "1", + "Hypocalcemia (Ionized)", 1.3, 1.3, 100, "mmol/L", "0", + # ANRLO missing - can grade 2-4 + "Hypocalcemia (Ionized)", 0.79, NA, 100, "mmol/L", "4", + "Hypocalcemia (Ionized)", 0.8, NA, 100, "mmol/L", "3", + "Hypocalcemia (Ionized)", 0.89, NA, 100, "mmol/L", "3", + "Hypocalcemia (Ionized)", 0.9, NA, 100, "mmol/L", "2", + "Hypocalcemia (Ionized)", 0.99, NA, 100, "mmol/L", "2", + # ANRLO missing - can NOT grade 0 or 1 + "Hypocalcemia (Ionized)", 1, 1.3, NA, "mmol/L", "1", + "Hypocalcemia (Ionized)", 1.29, 1.3, NA, "mmol/L", "1", + "Hypocalcemia (Ionized)", 1.3, 1.3, NA, "mmol/L", "0", + # Unit missing cannot grade + "Hypocalcemia (Ionized)", 1.3, 1.3, 100, NA, NA, + # AVAL missing cannot grade + "Hypocalcemia (Ionized)", NA, 1.3, 100, "mmol/L", NA, +) +input_caliond <- expected_caliond %>% + select(-ATOXGRL) + +# ---- derive_var_atoxgr, test 71: CTCAEv4 Hypocalcemia (Ionized) ---- +test_that("derive_var_atoxgr, test 71: CTCAEv4 Hypocalcemia (Ionized)", { + actual_caliond <- derive_var_atoxgr_dir( + input_caliond, new_var = ATOXGRL, meta_criteria = atoxgr_criteria_ctcv4, tox_description_var = ATOXDSCL, @@ -1804,51 +2820,72 @@ test_that("derive_var_atoxgr_dir: Test 35 NCICTCAEv4 Hypocalcemia (Ionized)", { ) expect_dfs_equal( - base = exp_out_ctcv4_35, - compare = actual_output_ctcv4_35, + base = expected_caliond, + compare = actual_caliond, keys = c("ATOXDSCL", "AVAL", "ANRLO", "ANRHI", "AVALU") ) }) -### 36. Hypoglycemia ---- +# ---- derive_var_atoxgr, test 72: CTCAEv5 Hypocalcemia (Ionized) ---- +test_that("derive_var_atoxgr, test 72: CTCAEv5 Hypocalcemia (Ionized)", { + actual_caliond <- derive_var_atoxgr_dir( + input_caliond, + new_var = ATOXGRL, + meta_criteria = atoxgr_criteria_ctcv5, + tox_description_var = ATOXDSCL, + criteria_direction = "L", + get_unit_expr = AVALU + ) + + expect_dfs_equal( + base = expected_caliond, + compare = actual_caliond, + keys = c("ATOXDSCL", "AVAL", "ANRLO", "ANRHI", "AVALU") + ) +}) + +### Hypoglycemia +### NCICTCAEv4 and NCICTCAEv5 criteria is the same ### Grade 4: <1.7 mmol/L ### Grade 3: <2.2 - 1.7 mmol/L ### Grade 2: <3.0 - 2.2 mmol/L ### Grade 1: % - select(-ATOXGRL) - actual_output_ctcv4_36 <- derive_var_atoxgr_dir( - input_ctcv4_36, +expected_glycd <- tibble::tribble( + ~ATOXDSCL, ~AVAL, ~ANRLO, ~ANRHI, ~AVALU, ~ATOXGRL, + "Not a term", 1.69, 4, 100, "mmol/L", NA, + NA_character_, 1.69, 4, 100, "mmol/L", NA, + # ANRLO not missing + "Hypoglycemia", 1.69, 4, 100, "mmol/L", "4", + "Hypoglycemia", 1.7, 4, 100, "mmol/L", "3", + "Hypoglycemia", 2.19, 4, 100, "mmol/L", "3", + "Hypoglycemia", 2.2, 4, 100, "mmol/L", "2", + "Hypoglycemia", 2.9, 4, 100, "mmol/L", "2", + "Hypoglycemia", 3, 4, 100, "mmol/L", "1", + "Hypoglycemia", 3.9, 4, 100, "mmol/L", "1", + "Hypoglycemia", 4, 4, 100, "mmol/L", "0", + # ANRLO missing - can grade 2-4 + "Hypoglycemia", 1.69, NA, 100, "mmol/L", "4", + "Hypoglycemia", 1.7, NA, 100, "mmol/L", "3", + "Hypoglycemia", 2.19, NA, 100, "mmol/L", "3", + "Hypoglycemia", 2.2, NA, 100, "mmol/L", "2", + "Hypoglycemia", 2.9, NA, 100, "mmol/L", "2", + # ANRLO missing - can NOT grade 0 or 1 + "Hypoglycemia", 3, NA, 100, "mmol/L", NA, + "Hypoglycemia", 3.9, NA, 100, "mmol/L", NA, + "Hypoglycemia", 4, NA, 100, "mmol/L", NA, + # Unit missing cannot grade + "Hypoglycemia", 4, 4, 100, NA, NA, + # AVAL missing cannot grade + "Hypoglycemia", NA, 4, 100, "mmol/L", NA, +) +input_glycd <- expected_glycd %>% + select(-ATOXGRL) + +# ---- derive_var_atoxgr, test 73: CTCAEv4 Hypoglycemia ---- +test_that("derive_var_atoxgr, test 73: CTCAEv4 Hypoglycemia", { + actual_glycd <- derive_var_atoxgr_dir( + input_glycd, new_var = ATOXGRL, meta_criteria = atoxgr_criteria_ctcv4, tox_description_var = ATOXDSCL, @@ -1857,46 +2894,67 @@ test_that("derive_var_atoxgr_dir: Test 36 NCICTCAEv4 Hypoglycemia", { ) expect_dfs_equal( - base = exp_out_ctcv4_36, - compare = actual_output_ctcv4_36, + base = expected_glycd, + compare = actual_glycd, keys = c("ATOXDSCL", "AVAL", "ANRLO", "ANRHI", "AVALU") ) }) -### 37. Hypokalemia ---- +# ---- derive_var_atoxgr, test 74: CTCAEv5 Hypoglycemia ---- +test_that("derive_var_atoxgr, test 74: CTCAEv5 Hypoglycemia", { + actual_glycd <- derive_var_atoxgr_dir( + input_glycd, + new_var = ATOXGRL, + meta_criteria = atoxgr_criteria_ctcv5, + tox_description_var = ATOXDSCL, + criteria_direction = "L", + get_unit_expr = AVALU + ) + + expect_dfs_equal( + base = expected_glycd, + compare = actual_glycd, + keys = c("ATOXDSCL", "AVAL", "ANRLO", "ANRHI", "AVALU") + ) +}) + +### Hypokalemia +### NCICTCAEv4 and NCICTCAEv5 criteria is the same ### Grade 4: <2.5 mmol/L ### Grade 3: <3.0 - 2.5 mmol/L ### Grade 2: % - select(-ATOXGRL) - actual_output_ctcv4_37 <- derive_var_atoxgr_dir( - input_ctcv4_37, +expected_kaled <- tibble::tribble( + ~ATOXDSCL, ~AVAL, ~ANRLO, ~ANRHI, ~AVALU, ~ATOXGRL, + "Not a term", 2.49, 4, 100, "mmol/L", NA, + NA_character_, 2.49, 4, 100, "mmol/L", NA, + # ANRLO not missing + "Hypokalemia", 2.49, 4, 100, "mmol/L", "4", + "Hypokalemia", 2.5, 4, 100, "mmol/L", "3", + "Hypokalemia", 2.9, 4, 100, "mmol/L", "3", + "Hypokalemia", 3, 4, 100, "mmol/L", "2", + "Hypokalemia", 3.9, 4, 100, "mmol/L", "2", + "Hypokalemia", 4, 4, 100, "mmol/L", "0", + # ANRLO missing - can grade 3-4 + "Hypokalemia", 2.49, NA, 100, "mmol/L", "4", + "Hypokalemia", 2.5, NA, 100, "mmol/L", "3", + "Hypokalemia", 2.9, NA, 100, "mmol/L", "3", + # ANRLO missing - can NOT grade 0 or 2 + "Hypokalemia", 3, NA, 100, "mmol/L", NA, + "Hypokalemia", 3.9, NA, 100, "mmol/L", NA, + "Hypokalemia", 4, NA, NA, "mmol/L", NA, + # Unit missing cannot grade + "Hypokalemia", 4, 4, 100, NA, NA, + # AVAL missing cannot grade + "Hypokalemia", NA, 4, 100, "mmol/L", NA, +) +input_kaled <- expected_kaled %>% + select(-ATOXGRL) + +# ---- derive_var_atoxgr, test 75: CTCAEv4 Hypokalemia ---- +test_that("derive_var_atoxgr, test 75: CTCAEv4 Hypokalemia", { + actual_kaled <- derive_var_atoxgr_dir( + input_kaled, new_var = ATOXGRL, meta_criteria = atoxgr_criteria_ctcv4, tox_description_var = ATOXDSCL, @@ -1905,123 +2963,183 @@ test_that("derive_var_atoxgr_dir: Test 37 NCICTCAEv4 Hypokalemia", { ) expect_dfs_equal( - base = exp_out_ctcv4_37, - compare = actual_output_ctcv4_37, + base = expected_kaled, + compare = actual_kaled, keys = c("ATOXDSCL", "AVAL", "ANRLO", "ANRHI", "AVALU") ) }) -### 38. Hypomagnesemia ---- +# ---- derive_var_atoxgr, test 76: CTCAEv5 Hypokalemia ---- +test_that("derive_var_atoxgr, test 76: CTCAEv5 Hypokalemia", { + actual_kaled <- derive_var_atoxgr_dir( + input_kaled, + new_var = ATOXGRL, + meta_criteria = atoxgr_criteria_ctcv5, + tox_description_var = ATOXDSCL, + criteria_direction = "L", + get_unit_expr = AVALU + ) + + expect_dfs_equal( + base = expected_kaled, + compare = actual_kaled, + keys = c("ATOXDSCL", "AVAL", "ANRLO", "ANRHI", "AVALU") + ) +}) + +### Hypomagnesemia +### NCICTCAEv4 and NCICTCAEv5 criteria is the same ### Grade 4: <0.3 mmol/L ### Grade 3: <0.4 - 0.3 mmol/L ### Grade 2: <0.5 - 0.4 mmol/L ### Grade 1: % + select(-ATOXGRL) + +# ---- derive_var_atoxgr, test 77: CTCAEv4 Hypomagnesemia ---- +test_that("derive_var_atoxgr, test 77: CTCAEv4 Hypomagnesemia", { + actual_magnd <- derive_var_atoxgr_dir( + input_magnd, + new_var = ATOXGRL, + meta_criteria = atoxgr_criteria_ctcv4, + tox_description_var = ATOXDSCL, + criteria_direction = "L", + get_unit_expr = AVALU ) - input_ctcv4_38 <- exp_out_ctcv4_38 %>% - select(-ATOXGRL) - actual_output_ctcv4_38 <- derive_var_atoxgr_dir( - input_ctcv4_38, + expect_dfs_equal( + base = expected_magnd, + compare = actual_magnd, + keys = c("ATOXDSCL", "AVAL", "ANRLO", "ANRHI", "AVALU") + ) +}) + +# ---- derive_var_atoxgr, test 78: CTCAEv5 Hypomagnesemia ---- +test_that("derive_var_atoxgr, test 78: CTCAEv5 Hypomagnesemia", { + actual_magnd <- derive_var_atoxgr_dir( + input_magnd, new_var = ATOXGRL, - meta_criteria = atoxgr_criteria_ctcv4, + meta_criteria = atoxgr_criteria_ctcv5, tox_description_var = ATOXDSCL, criteria_direction = "L", get_unit_expr = AVALU ) expect_dfs_equal( - base = exp_out_ctcv4_38, - compare = actual_output_ctcv4_38, + base = expected_magnd, + compare = actual_magnd, keys = c("ATOXDSCL", "AVAL", "ANRLO", "ANRHI", "AVALU") ) }) -### 39. Hyponatremia ---- +### Hyponatremia (NCICTCAEv4) +### NCICTCAEv4 and NCICTCAEv5 essentially the same (slightly different text) ### Grade 4: <120 mmol/L ### Grade 3: <130 - 120 mmol/L ### Grade 1: % + select(-ATOXGRL) + +# ---- derive_var_atoxgr, test 79: CTCAEv4 Hyponatremia ---- +test_that("derive_var_atoxgr, test 79: CTCAEv4 Hyponatremia", { + actual_natrd <- derive_var_atoxgr_dir( + input_natrd, + new_var = ATOXGRL, + meta_criteria = atoxgr_criteria_ctcv4, + tox_description_var = ATOXDSCL, + criteria_direction = "L", + get_unit_expr = AVALU ) - input_ctcv4_39 <- exp_out_ctcv4_39 %>% - select(-ATOXGRL) - actual_output_ctcv4_39 <- derive_var_atoxgr_dir( - input_ctcv4_39, + expect_dfs_equal( + base = expected_natrd, + compare = actual_natrd, + keys = c("ATOXDSCL", "AVAL", "ANRLO", "ANRHI", "AVALU") + ) +}) + +# ---- derive_var_atoxgr, test 80: CTCAEv5 Hyponatremia ---- +test_that("derive_var_atoxgr, test 80: CTCAEv5 Hyponatremia", { + actual_natrd <- derive_var_atoxgr_dir( + input_natrd, new_var = ATOXGRL, - meta_criteria = atoxgr_criteria_ctcv4, + meta_criteria = atoxgr_criteria_ctcv5, tox_description_var = ATOXDSCL, criteria_direction = "L", get_unit_expr = AVALU ) expect_dfs_equal( - base = exp_out_ctcv4_39, - compare = actual_output_ctcv4_39, + base = expected_natrd, + compare = actual_natrd, keys = c("ATOXDSCL", "AVAL", "ANRLO", "ANRHI", "AVALU") ) }) -### 40. Hypophosphatemia ---- +### Hypophosphatemia +### Only in NCICTCAEv4 (not NCICTCAEv5) ### Grade 4: <0.3 mmol/L ### Grade 3: <0.6 - 0.3 mmol/L ### Grade 2: <0.8 - 0.6 mmol/L ### Grade 1: % + input_phosd <- expected_phosd %>% select(-ATOXGRL) - actual_output_ctcv4_40 <- derive_var_atoxgr_dir( - input_ctcv4_40, + actual_phosd <- derive_var_atoxgr_dir( + input_phosd, new_var = ATOXGRL, meta_criteria = atoxgr_criteria_ctcv4, tox_description_var = ATOXDSCL, @@ -2062,8 +3180,8 @@ test_that("derive_var_atoxgr_dir: Test 40 NCICTCAEv4 Hypophosphatemia", { ) expect_dfs_equal( - base = exp_out_ctcv4_40, - compare = actual_output_ctcv4_40, + base = expected_phosd, + compare = actual_phosd, keys = c("ATOXDSCL", "AVAL", "ANRLO", "ANRHI", "AVALU") ) }) diff --git a/tests/testthat/test-derive_var_confirmation_flag.R b/tests/testthat/test-derive_var_confirmation_flag.R index 618c503134..e72310e956 100644 --- a/tests/testthat/test-derive_var_confirmation_flag.R +++ b/tests/testthat/test-derive_var_confirmation_flag.R @@ -1,5 +1,4 @@ -library(tibble) -data <- tribble( +data <- tibble::tribble( ~USUBJID, ~AVISITN, ~AVALC, "1", 1, "PR", "1", 2, "CR", @@ -32,7 +31,7 @@ test_that("derive_var_confirmation_flag Test 1: filter without first_cond", { filter = AVALC == "PR" & AVALC.join %in% c("CR", "PR") ) - expected <- tribble( + expected <- tibble::tribble( ~USUBJID, ~AVISITN, ~AVALC, ~CONFFL, "1", 1, "PR", "Y", "1", 2, "CR", NA_character_, @@ -60,7 +59,7 @@ test_that("derive_var_confirmation_flag Test 1: filter without first_cond", { ## Test 2: filter with first_cond ---- ## Flagging any patient CR value that is followed by a CR test_that("derive_var_confirmation_flag Test 2: filter with first_cond", { - data <- tribble( + data <- tibble::tribble( ~USUBJID, ~AVISITN, ~AVALC, "1", 1, "PR", "1", 2, "CR", @@ -89,7 +88,7 @@ test_that("derive_var_confirmation_flag Test 2: filter with first_cond", { filter = TRUE ) - expected <- tribble( + expected <- tibble::tribble( ~USUBJID, ~AVISITN, ~AVALC, ~CONFFL, "1", 1, "PR", NA_character_, "1", 2, "CR", "Y", @@ -131,7 +130,7 @@ test_that("derive_var_confirmation_flag Test 3: filter with first_cond and summa false_value = "N" ) - expected <- tribble( + expected <- tibble::tribble( ~USUBJID, ~AVISITN, ~AVALC, ~CONFFL, "1", 1, "PR", "Y", "1", 2, "CR", "N", @@ -160,7 +159,7 @@ test_that("derive_var_confirmation_flag Test 3: filter with first_cond and summa ## Flagging observations with a duration longer than 30 and ## on or after 7 days of a COVID AE (ACOVFL == "Y") test_that("derive_var_confirmation_flag, Test 4: join_type = 'all'", { - adae <- tribble( + adae <- tibble::tribble( ~USUBJID, ~ADY, ~ACOVFL, ~ADURN, "1", 10, "N", 1, "1", 21, "N", 50, @@ -185,7 +184,7 @@ test_that("derive_var_confirmation_flag, Test 4: join_type = 'all'", { filter = ADURN > 30 & ACOVFL.join == "Y" & ADY >= ADY.join - 7 ) - expected <- tribble( + expected <- tibble::tribble( ~USUBJID, ~ADY, ~ACOVFL, ~ADURN, ~ALCOVFL, "1", 10, "N", 1, NA_character_, "1", 21, "N", 50, "Y", @@ -210,7 +209,7 @@ test_that("derive_var_confirmation_flag, Test 4: join_type = 'all'", { ## Test 5: join_type = "before" ---- ## Flagging observations with AVALC = Y and an observation with CRIT1FL = Y before test_that("derive_var_confirmation_flag, Test 5: join_type = 'before'", { - data <- tribble( + data <- tibble::tribble( ~USUBJID, ~ASEQ, ~AVALC, ~CRIT1FL, "1", 1, "Y", "Y", "1", 2, "N", "N", @@ -230,7 +229,7 @@ test_that("derive_var_confirmation_flag, Test 5: join_type = 'before'", { false_value = "N" ) - expected <- tribble( + expected <- tibble::tribble( ~USUBJID, ~ASEQ, ~AVALC, ~CRIT1FL, ~CONFFL, "1", 1, "Y", "Y", "N", "1", 2, "N", "N", "N", diff --git a/tests/testthat/test-derive_var_dthcaus.R b/tests/testthat/test-derive_var_dthcaus.R index df5f2ad2ba..72ef978dd9 100644 --- a/tests/testthat/test-derive_var_dthcaus.R +++ b/tests/testthat/test-derive_var_dthcaus.R @@ -1,7 +1,3 @@ -library(tibble) -library(dplyr) -library(lubridate) - # dthcaus_source ---- ## Test 1: error on invalid mode ---- test_that("dthcaus_source Test 1: error on invalid mode", { @@ -17,14 +13,14 @@ test_that("dthcaus_source Test 1: error on invalid mode", { # derive_var_dthcaus ---- ## Test 2: DTHCAUS is added from AE and DS ---- test_that("derive_var_dthcaus Test 2: DTHCAUS is added from AE and DS", { - adsl <- tribble( + adsl <- tibble::tribble( ~STUDYID, ~USUBJID, "TEST01", "PAT01", "TEST01", "PAT02", "TEST01", "PAT03" ) - ae <- tribble( + ae <- tibble::tribble( ~STUDYID, ~USUBJID, ~AESEQ, ~AEDECOD, ~AEOUT, ~AEDTHDTC, "TEST01", "PAT03", 12, "SUDDEN DEATH", "FATAL", "2021-04-04" ) %>% @@ -32,7 +28,7 @@ test_that("derive_var_dthcaus Test 2: DTHCAUS is added from AE and DS", { AEDTHDT = ymd(AEDTHDTC) ) - ds <- tribble( + ds <- tibble::tribble( ~STUDYID, ~USUBJID, ~DSSEQ, ~DSDECOD, ~DSTERM, ~DSSTDTC, "TEST01", "PAT01", 1, "INFORMED CONSENT OBTAINED", "INFORMED CONSENT OBTAINED", "2021-04-01", "TEST01", "PAT01", 2, "RANDOMIZATION", "RANDOMIZATION", "2021-04-11", @@ -65,7 +61,7 @@ test_that("derive_var_dthcaus Test 2: DTHCAUS is added from AE and DS", { dthcaus = DSTERM ) - expected_output <- tribble( + expected_output <- tibble::tribble( ~STUDYID, ~USUBJID, ~DTHCAUS, "TEST01", "PAT01", "DEATH DUE TO PROGRESSION OF DISEASE", "TEST01", "PAT02", NA, @@ -83,13 +79,13 @@ test_that("derive_var_dthcaus Test 2: DTHCAUS is added from AE and DS", { ## Test 3: `dthcaus` handles symbols and string literals correctly ---- test_that("derive_var_dthcaus Test 3: `dthcaus` handles symbols and string literals correctly", { - adsl <- tribble( + adsl <- tibble::tribble( ~STUDYID, ~USUBJID, "TEST01", "PAT01", "TEST01", "PAT02" ) - ae <- tribble( + ae <- tibble::tribble( ~STUDYID, ~USUBJID, ~AESEQ, ~AEDECOD, ~AEOUT, ~AEDTHDTC, "TEST01", "PAT01", 12, "SUDDEN DEATH", "FATAL", "2021-04-04" ) %>% @@ -97,7 +93,7 @@ test_that("derive_var_dthcaus Test 3: `dthcaus` handles symbols and string liter AEDTHDT = ymd(AEDTHDTC) ) - ds <- tribble( + ds <- tibble::tribble( ~STUDYID, ~USUBJID, ~DSSEQ, ~DSDECOD, ~DSTERM, ~DSSTDTC, "TEST01", "PAT01", 1, "INFORMED CONSENT OBTAINED", "INFORMED CONSENT OBTAINED", "2021-04-02", "TEST01", "PAT01", 2, "RANDOMIZATION", "RANDOMIZATION", "2021-04-11", @@ -127,7 +123,7 @@ test_that("derive_var_dthcaus Test 3: `dthcaus` handles symbols and string liter dthcaus = DSTERM ) - expected_output <- tribble( + expected_output <- tibble::tribble( ~STUDYID, ~USUBJID, ~DTHCAUS, "TEST01", "PAT01", "Adverse Event", "TEST01", "PAT02", "DEATH DUE TO PROGRESSION OF DISEASE" @@ -144,14 +140,14 @@ test_that("derive_var_dthcaus Test 3: `dthcaus` handles symbols and string liter ## Test 4: DTHCAUS and traceability vars are added from AE and DS ---- test_that("derive_var_dthcaus Test 4: DTHCAUS and traceability vars are added from AE and DS", { - adsl <- tribble( + adsl <- tibble::tribble( ~STUDYID, ~USUBJID, "TEST01", "PAT01", "TEST01", "PAT02", "TEST01", "PAT03" ) - ae <- tribble( + ae <- tibble::tribble( ~STUDYID, ~USUBJID, ~AESEQ, ~AEDECOD, ~AEOUT, ~AEDTHDTC, "TEST01", "PAT03", 12, "SUDDEN DEATH", "FATAL", "2021-04-04" ) %>% @@ -159,7 +155,7 @@ test_that("derive_var_dthcaus Test 4: DTHCAUS and traceability vars are added fr AEDTHDT = ymd(AEDTHDTC) ) - ds <- tribble( + ds <- tibble::tribble( ~STUDYID, ~USUBJID, ~DSSEQ, ~DSDECOD, ~DSTERM, ~DSSTDTC, "TEST01", "PAT01", 1, "INFORMED CONSENT OBTAINED", "INFORMED CONSENT OBTAINED", "2021-04-01", "TEST01", "PAT01", 2, "RANDOMIZATION", "RANDOMIZATION", "2021-04-11", @@ -194,7 +190,7 @@ test_that("derive_var_dthcaus Test 4: DTHCAUS and traceability vars are added fr traceability_vars = vars(DTHDOM = "DS", DTHSEQ = DSSEQ) ) - expected_output <- tribble( + expected_output <- tibble::tribble( ~STUDYID, ~USUBJID, ~DTHCAUS, ~DTHDOM, ~DTHSEQ, "TEST01", "PAT01", "DEATH DUE TO PROGRESSION OF DISEASE", "DS", 4, "TEST01", "PAT02", NA, NA, NA, @@ -212,14 +208,14 @@ test_that("derive_var_dthcaus Test 4: DTHCAUS and traceability vars are added fr ## Test 5: DTHCAUS/traceabiity are added from 2 input datasets ---- test_that("derive_var_dthcaus Test 5: DTHCAUS/traceabiity are added from 2 input datasets", { - adsl <- tribble( + adsl <- tibble::tribble( ~STUDYID, ~USUBJID, "TEST01", "PAT01", "TEST01", "PAT02", "TEST01", "PAT03" ) - ae <- tribble( + ae <- tibble::tribble( ~STUDYID, ~USUBJID, ~AESEQ, ~AEDECOD, ~AEOUT, ~AEDTHDTC, "TEST01", "PAT01", 14, "SUDDEN DEATH", "FATAL", "2021-04-04", "TEST01", "PAT03", 12, "SUDDEN DEATH", "FATAL", "2021-04-04" @@ -228,7 +224,7 @@ test_that("derive_var_dthcaus Test 5: DTHCAUS/traceabiity are added from 2 input AEDTHDT = ymd(AEDTHDTC) ) - ds <- tribble( + ds <- tibble::tribble( ~STUDYID, ~USUBJID, ~DSSEQ, ~DSDECOD, ~DSTERM, ~DSSTDTC, "TEST01", "PAT01", 1, "INFORMED CONSENT OBTAINED", "INFORMED CONSENT OBTAINED", "2021-04-01", "TEST01", "PAT01", 2, "RANDOMIZATION", "RANDOMIZATION", "2021-04-11", @@ -263,7 +259,7 @@ test_that("derive_var_dthcaus Test 5: DTHCAUS/traceabiity are added from 2 input traceability_vars = vars(DTHDOM = "DS", DTHSEQ = DSSEQ) ) - expected_output <- tribble( + expected_output <- tibble::tribble( ~STUDYID, ~USUBJID, ~DTHCAUS, ~DTHDOM, ~DTHSEQ, "TEST01", "PAT01", "DEATH DUE TO PROGRESSION OF DISEASE", "DS", 4, "TEST01", "PAT02", NA, NA, NA, @@ -283,14 +279,14 @@ test_that("derive_var_dthcaus Test 5: DTHCAUS/traceabiity are added from 2 input test_that("derive_var_dthcaus Test 6: DTHCAUS is added from AE and DS if filter is not specified", { # test based on covr report - the case for unspecified filter has not been tested - adsl <- tribble( + adsl <- tibble::tribble( ~STUDYID, ~USUBJID, "TEST01", "PAT01", "TEST01", "PAT02", "TEST01", "PAT03" ) - ae <- tribble( + ae <- tibble::tribble( ~STUDYID, ~USUBJID, ~AESEQ, ~AEDECOD, ~AEOUT, ~AEDTHDTC, "TEST01", "PAT03", 12, "SUDDEN DEATH", "FATAL", "2021-04-04" ) %>% @@ -298,7 +294,7 @@ test_that("derive_var_dthcaus Test 6: DTHCAUS is added from AE and DS if filter AEDTHDT = ymd(AEDTHDTC) ) - ds <- tribble( + ds <- tibble::tribble( ~STUDYID, ~USUBJID, ~DSSEQ, ~DSDECOD, ~DSTERM, ~DSSTDTC, "TEST01", "PAT01", 1, "INFORMED CONSENT OBTAINED", "INFORMED CONSENT OBTAINED", "2021-04-01", "TEST01", "PAT01", 2, "RANDOMIZATION", "RANDOMIZATION", "2021-04-11", @@ -331,7 +327,7 @@ test_that("derive_var_dthcaus Test 6: DTHCAUS is added from AE and DS if filter dthcaus = DSTERM ) - expected_output <- tribble( + expected_output <- tibble::tribble( ~STUDYID, ~USUBJID, ~DTHCAUS, "TEST01", "PAT01", "INFORMED CONSENT OBTAINED", "TEST01", "PAT02", "INFORMED CONSENT OBTAINED", diff --git a/tests/testthat/test-derive_var_extreme_date.R b/tests/testthat/test-derive_var_extreme_date.R index 6246eeaade..d67c6aae59 100644 --- a/tests/testthat/test-derive_var_extreme_date.R +++ b/tests/testthat/test-derive_var_extreme_date.R @@ -1,7 +1,4 @@ -library(tibble) -library(lubridate) -library(dplyr) -adsl <- tribble( +adsl <- tibble::tribble( ~STUDYID, ~USUBJID, ~TRTEDTM, ~DTHDTC, "STUDY01", "1", ymd_hms("2020-01-01T12:00:00"), NA_character_, "STUDY01", "2", NA, "2020-06", @@ -11,7 +8,7 @@ adsl <- tribble( DTHDT = c(ymd(""), ymd("2020-06-01"), ymd("")) ) -ae <- tribble( +ae <- tibble::tribble( ~STUDYID, ~USUBJID, ~AESTDTC, ~AEENDTC, ~AESEQ, "STUDY01", "1", "2019-11-01", "2019-11-23", 1, "STUDY01", "1", "2020-02-01", "2020-02-01", 2, diff --git a/tests/testthat/test-derive_var_last_dose_amt.R b/tests/testthat/test-derive_var_last_dose_amt.R index 20ca6c2fbf..5d1e237f18 100644 --- a/tests/testthat/test-derive_var_last_dose_amt.R +++ b/tests/testthat/test-derive_var_last_dose_amt.R @@ -1,8 +1,4 @@ -library(tibble) -library(dplyr) -library(lubridate) - -input_ae <- tribble( +input_ae <- tibble::tribble( ~STUDYID, ~USUBJID, ~AESEQ, ~AESTDTC, "my_study", "subject1", 1, "2020-01-02", "my_study", "subject1", 2, "2020-08-31", @@ -16,7 +12,7 @@ input_ae <- tribble( AESTDT = ymd(AESTDTC) ) -input_ex <- tribble( +input_ex <- tibble::tribble( ~STUDYID, ~USUBJID, ~EXSTDTC, ~EXENDTC, ~EXSEQ, ~EXDOSE, ~EXTRT, "my_study", "subject1", "2020-01-01", "2020-01-01", 1, 10, "treatment", "my_study", "subject1", "2020-08-29", "2020-08-29", 2, 10, "treatment", diff --git a/tests/testthat/test-derive_var_last_dose_date.R b/tests/testthat/test-derive_var_last_dose_date.R index 4522e87085..e4f40ae17b 100644 --- a/tests/testthat/test-derive_var_last_dose_date.R +++ b/tests/testthat/test-derive_var_last_dose_date.R @@ -1,7 +1,4 @@ -library(tibble) -library(dplyr) -library(lubridate) -input_ae <- tribble( +input_ae <- tibble::tribble( ~STUDYID, ~USUBJID, ~AESEQ, ~AESTDTC, "my_study", "subject1", 1, "2020-01-02", "my_study", "subject1", 2, "2020-08-31", @@ -14,7 +11,7 @@ input_ae <- tribble( AESTDT = ymd(AESTDTC) ) -input_ex <- tribble( +input_ex <- tibble::tribble( ~STUDYID, ~USUBJID, ~EXSTDTC, ~EXENDTC, ~EXSEQ, ~EXDOSE, ~EXTRT, "my_study", "subject1", "2020-01-01", "2020-01-01", 1, 10, "treatment", "my_study", "subject1", "2020-08-29", "2020-08-29", 2, 10, "treatment", @@ -62,7 +59,7 @@ test_that("derive_var_last_dose_date Test 1: works as expected output_datetime = ## Test 2: works as expected with output_datetime = TRUE ---- test_that("derive_var_last_dose_date Test 2: works as expected with output_datetime = TRUE", { - expected_output <- tribble( + expected_output <- tibble::tribble( ~STUDYID, ~USUBJID, ~AESEQ, ~AESTDTC, ~LDOSEDTM, "my_study", "subject1", 1, "2020-01-02", "2020-01-01 00:00:00", "my_study", "subject1", 2, "2020-08-31", "2020-08-29 00:00:00", @@ -95,7 +92,7 @@ test_that("derive_var_last_dose_date Test 2: works as expected with output_datet ## Test 3: returns traceability vars ---- test_that("derive_var_last_dose_date Test 3: returns traceability vars", { - expected_output <- tribble( + expected_output <- tibble::tribble( ~STUDYID, ~USUBJID, ~AESEQ, ~AESTDTC, ~LDOSEDTM, "my_study", "subject1", 1, "2020-01-02", "2020-01-01 00:00:00", "my_study", "subject1", 2, "2020-08-31", "2020-08-29 00:00:00", diff --git a/tests/testthat/test-derive_var_last_dose_grp.R b/tests/testthat/test-derive_var_last_dose_grp.R index 97377da242..b880165a36 100644 --- a/tests/testthat/test-derive_var_last_dose_grp.R +++ b/tests/testthat/test-derive_var_last_dose_grp.R @@ -1,7 +1,4 @@ -library(tibble) -library(dplyr) -library(lubridate) -input_ae <- tribble( +input_ae <- tibble::tribble( ~STUDYID, ~USUBJID, ~AESEQ, ~AESTDTC, "my_study", "subject1", 1, "2020-01-02", "my_study", "subject1", 2, "2020-08-31", @@ -14,7 +11,7 @@ input_ae <- tribble( AESTDT = ymd(AESTDTC) ) -input_ex <- tribble( +input_ex <- tibble::tribble( ~STUDYID, ~USUBJID, ~EXSTDTC, ~EXENDTC, ~EXSEQ, ~EXDOSE, ~EXTRT, "my_study", "subject1", "2020-01-01", "2020-01-01", 1, 1, "treatment", "my_study", "subject1", "2020-08-29", "2020-08-29", 2, 3, "treatment", @@ -29,7 +26,7 @@ input_ex <- tribble( # derive_var_last_dose_grp ## Test 1: works as expected ---- test_that("derive_var_last_dose_grp Test 1: works as expected", { - expected_output <- tribble( + expected_output <- tibble::tribble( ~STUDYID, ~USUBJID, ~AESEQ, ~AESTDTC, ~LDGRP, "my_study", "subject1", 1, "2020-01-02", "G1", "my_study", "subject1", 2, "2020-08-31", "G1", diff --git a/tests/testthat/test-derive_var_ontrtfl.R b/tests/testthat/test-derive_var_ontrtfl.R index df2a0fef81..324e8915bc 100644 --- a/tests/testthat/test-derive_var_ontrtfl.R +++ b/tests/testthat/test-derive_var_ontrtfl.R @@ -1,4 +1,5 @@ -test_that("`target` is set to NA when ` start_date` < `ref_start_date`", { +## Test 1: `start_date` < `ref_start_date` ---- +test_that("derive_var_ontrtfl Test 1: `start_date` < `ref_start_date`", { input <- tibble::tribble( ~STUDYID, ~USUBJID, ~ADT, ~TRTSDT, "TEST01", "PAT01", as.Date("2021-01-01"), as.Date("2021-01-02") @@ -22,7 +23,8 @@ test_that("`target` is set to NA when ` start_date` < `ref_start_date`", { ) }) -test_that("`target` is set to NA when `ref_start_date` is NA", { +## Test 2: `ref_start_date` is NA ---- +test_that("derive_var_ontrtfl Test 2: `ref_start_date` is NA", { input <- tibble::tribble( ~STUDYID, ~USUBJID, ~ADT, ~TRTSDT, "TEST01", "PAT01", as.Date("2021-01-01"), as.Date(NA) @@ -46,7 +48,8 @@ test_that("`target` is set to NA when `ref_start_date` is NA", { ) }) -test_that("`target` is set to `Y` when ` start_date` is NA", { +## Test 3: `start_date` is NA ---- +test_that("derive_var_ontrtfl Test 3: `start_date` is NA", { input <- tibble::tribble( ~STUDYID, ~USUBJID, ~ADT, ~TRTSDT, "TEST01", "PAT01", as.Date(NA), as.Date("2020-01-01"), @@ -72,8 +75,8 @@ test_that("`target` is set to `Y` when ` start_date` is NA", { ) }) -test_that("`target` is set to `Y` when ` start_date` >= `ref_start_date` and - `ref_end_date` and `filter_pre_timepoint` are not specified", { +## Test 4: start_date >= ref_start_date, no ref_end_date and filter_pre_timepoint ---- +test_that("derive_var_ontrtfl Test 4: start_date >= ref_start_date, no ref_end_date and filter_pre_timepoint", { # nolint input <- tibble::tribble( ~STUDYID, ~USUBJID, ~ADT, ~TRTSDT, "TEST01", "PAT01", as.Date("2020-01-01"), as.Date("2020-01-01"), @@ -99,8 +102,8 @@ test_that("`target` is set to `Y` when ` start_date` >= `ref_start_date` and ) }) -test_that("`target` is set to 'Y' when `filter_pre_timepoint` is not 'PRE' and - ` start_date` = `ref_start_date` and `ref_end_date` is not specified", { +## Test 5: `filter_pre_timepoint` is specified ---- +test_that("derive_var_ontrtfl Test 5: `filter_pre_timepoint` is specified", { input <- tibble::tribble( ~STUDYID, ~USUBJID, ~ADT, ~TRTSDT, ~TPT, "TEST01", "PAT01", as.Date("2020-01-01"), as.Date("2020-01-01"), "PRE", @@ -127,8 +130,8 @@ test_that("`target` is set to 'Y' when `filter_pre_timepoint` is not 'PRE' and ) }) -test_that("`target` is set to `Y` when ` start_date` >= `ref_start_date` and ` start_date` <= - `ref_end_date` and no `ref_end_window` is specified, otherwise NA", { +## Test 6: ref_start_date <= start_date <= ref_end_date, no ref_end_window ---- +test_that("derive_var_ontrtfl Test 6: ref_start_date <= start_date <= ref_end_date, no ref_end_window", { # nolint input <- tibble::tribble( ~STUDYID, ~USUBJID, ~ADT, ~TRTSDT, ~TRTEDT, "TEST01", "PAT01", as.Date("2019-12-13"), as.Date("2020-01-01"), as.Date("2020-02-01"), @@ -161,8 +164,8 @@ test_that("`target` is set to `Y` when ` start_date` >= `ref_start_date` and ` s ) }) -test_that("`target` is set to `Y` when ` start_date` >= `ref_start_date` and ` start_date` <= - `ref_end_date` + `ref_end_window`", { +## Test 7: ref_start_date <= start_date <= ref_end_date + ref_end_window ---- +test_that("derive_var_ontrtfl Test 7: ref_start_date <= start_date <= ref_end_date + ref_end_window", { # nolint input <- tibble::tribble( ~STUDYID, ~USUBJID, ~ADT, ~TRTSDT, ~TRTEDT, "TEST01", "PAT01", as.Date("2020-02-01"), as.Date("2020-01-01"), as.Date("2020-02-01"), @@ -192,10 +195,42 @@ test_that("`target` is set to `Y` when ` start_date` >= `ref_start_date` and ` s ) }) +## Test 8: considering time for ref_end_date ---- +test_that("derive_var_ontrtfl Test 8: considering time for ref_end_date", { + expected_output <- tibble::tribble( + ~STUDYID, ~USUBJID, ~ADTM, ~ONTRTFL, + "TEST01", "PAT01", "2020-02-01T12:00", "Y", + "TEST01", "PAT02", "2020-02-06T10:00", "Y", + "TEST01", "PAT03", "2020-02-06T14:00", NA, + "TEST01", "PAT03", "2020-02-10T13:00", NA + ) %>% + mutate( + ADTM = lubridate::ymd_hm(ADTM), + TRTSDTM = lubridate::ymd_hm("2020-01-01T12:00"), + TRTEDTM = lubridate::ymd_hm("2020-02-01T12:00") + ) + + input <- select(expected_output, -ONTRTFL) + + actual_output <- derive_var_ontrtfl( + input, + new_var = ONTRTFL, + start_date = ADTM, + ref_start_date = TRTSDTM, + ref_end_date = TRTEDTM, + ref_end_window = 5, + ignore_time_for_ref_end_date = FALSE + ) + expect_dfs_equal( + expected_output, + actual_output, + keys = c("STUDYID", "USUBJID", "ADTM") + ) +}) -test_that("`target` is set to NA when `end_date`<`ref_start_date` - regradless of start_date being NA", { +## Test 9: end_date < ref_start_date and start_date is NA ---- +test_that("derive_var_ontrtfl Test 9: end_date < ref_start_date and start_date is NA", { input <- tibble::tribble( ~USUBJID, ~ASTDT, ~TRTSDT, ~TRTEDT, ~AENDT, "PAT01", ymd("2019-04-30"), ymd("2020-01-01"), ymd("2020-03-01"), ymd("2019-03-15"), @@ -224,7 +259,8 @@ test_that("`target` is set to NA when `end_date`<`ref_start_date` ) }) -test_that("`target` is set to `Y` when `end_date`>`ref_start_date` when `start_date` is missing", { +## Test 10: end_date > ref_start_date and start_date is NA ---- +test_that("derive_var_ontrtfl Test 10: end_date > ref_start_date and start_date is NA", { input <- tibble::tribble( ~STUDYID, ~USUBJID, ~ASTDT, ~TRTSDT, ~TRTEDT, ~AENDT, "TEST01", "PAT01", NA, ymd("2020-01-01"), ymd("2020-03-01"), ymd("2021-03-15"), @@ -251,8 +287,8 @@ test_that("`target` is set to `Y` when `end_date`>`ref_start_date` when `start_ ) }) -test_that("`target` is set to NA when `end_date` is missing and - `start_date` is before `ref_start_date` a la Roche", { +## Test 11: end_date is NA and start_date < ref_start_date a la Roche ---- +test_that("derive_var_ontrtfl Test 11: end_date is NA and start_date < ref_start_date a la Roche", { input <- tibble::tribble( ~STUDYID, ~USUBJID, ~ASTDT, ~TRTSDT, ~TRTEDT, ~AENDT, "TEST01", "PAT01", ymd("2019-04-30"), ymd("2020-01-01"), ymd("2020-03-01"), NA, @@ -279,8 +315,8 @@ test_that("`target` is set to NA when `end_date` is missing and ) }) -test_that("`target` is set to Y when `end_date` is missing and - `start_date` is before `ref_start_date` a la GSK", { +## Test 12: end_date is NA and start_date < ref_start_date a la GSK ---- +test_that("derive_var_ontrtfl Test 12: end_date is NA and start_date < ref_start_date a la GSK", { input <- tibble::tribble( ~STUDYID, ~USUBJID, ~ASTDT, ~TRTSDT, ~TRTEDT, ~AENDT, "TEST01", "PAT01", ymd("2019-04-30"), ymd("2020-01-01"), ymd("2020-03-01"), NA, @@ -308,8 +344,8 @@ test_that("`target` is set to Y when `end_date` is missing and ) }) -test_that("`target` is set to Y when `end_date` is missing and - `start_date` is before `ref_start_date` a la GSK", { +## Test 13: end_date is NA and start_date < ref_start_date a la GSK ---- +test_that("derive_var_ontrtfl Test 13: end_date is NA and start_date < ref_start_date a la GSK", { input <- tibble::tribble( ~STUDYID, ~USUBJID, ~ASTDT, ~TRTSDT, ~TRTEDT, ~AENDT, "TEST01", "PAT01", ymd("2019-04-30"), ymd("2020-01-01"), ymd("2020-03-01"), NA, @@ -337,8 +373,8 @@ test_that("`target` is set to Y when `end_date` is missing and ) }) -test_that("`target` is set to Y when `start_date` is before `ref_start_date` and - `end_date` is before `ref_end_date` for Period 01", { +## Test 14: start_date < ref_start_date and end_date < ref_end_date for Period 01 ---- +test_that("derive_var_ontrtfl Test 14: start_date < ref_start_date and end_date < ref_end_date for Period 01", { # nolint input <- tibble::tribble( ~STUDYID, ~USUBJID, ~ASTDT, ~AP01SDT, ~AP01EDT, ~AENDT, "TEST01", "PAT01", ymd("2019-04-30"), ymd("2020-01-01"), ymd("2020-03-01"), ymd("2020-03-15") diff --git a/tests/testthat/test-derive_var_relative_flag.R b/tests/testthat/test-derive_var_relative_flag.R new file mode 100644 index 0000000000..b8a688d862 --- /dev/null +++ b/tests/testthat/test-derive_var_relative_flag.R @@ -0,0 +1,71 @@ + +## Test 1: flag observations up to first PD ---- +test_that("derive_var_relative_flag Test 1: flag observations up to first PD", { + expected <- tibble::tribble( + ~USUBJID, ~AVISITN, ~AVALC, ~ANL02FL, + "1", 0, "PR", "Y", + "1", 1, "CR", "Y", + "1", 2, "CR", "Y", + "1", 3, "SD", "Y", + "1", 4, "NE", "Y", + "2", 0, "SD", "Y", + "2", 1, "PD", "Y", + "2", 2, "PD", NA, + "3", 0, "SD", "Y", + "4", 0, "SD", "Y", + "4", 1, "PR", "Y", + "4", 2, "PD", "Y", + "4", 3, "SD", NA, + "4", 4, "PR", NA + ) + + response <- select(expected, -ANL02FL) + + expect_dfs_equal( + base = expected, + compare = derive_var_relative_flag( + response, + by_vars = vars(USUBJID), + order = vars(AVISITN), + new_var = ANL02FL, + condition = AVALC == "PD", + mode = "first", + selection = "before", + inclusive = TRUE + ), + keys = c("USUBJID", "AVISITN") + ) +}) + +## Test 2: Flag AEs after COVID AE ---- +test_that("derive_var_relative_flag Test 2: Flag AEs after COVID AE", { + expected <- tibble::tribble( + ~USUBJID, ~ASTDY, ~ACOVFL, ~AESEQ, ~PSTCOVFL, + "1", 2, NA, 1, NA, + "1", 5, "Y", 2, NA, + "1", 5, NA, 3, "Y", + "1", 17, NA, 4, "Y", + "1", 27, "Y", 5, "Y", + "1", 32, NA, 6, "Y", + "2", 8, NA, 1, NA, + "2", 11, NA, 2, NA + ) + + adae <- select(expected, -PSTCOVFL) + + expect_dfs_equal( + base = expected, + compare = derive_var_relative_flag( + adae, + by_vars = vars(USUBJID), + order = vars(ASTDY, AESEQ), + new_var = PSTCOVFL, + condition = ACOVFL == "Y", + mode = "first", + selection = "after", + inclusive = FALSE, + flag_no_ref_groups = FALSE + ), + keys = c("USUBJID", "AESEQ") + ) +}) diff --git a/tests/testthat/test-derive_var_trtemfl.R b/tests/testthat/test-derive_var_trtemfl.R new file mode 100644 index 0000000000..d16d4708ee --- /dev/null +++ b/tests/testthat/test-derive_var_trtemfl.R @@ -0,0 +1,125 @@ +expected <- tibble::tribble( + ~USUBJID, ~ASTDTM, ~AENDTM, ~AEITOXGR, ~AETOXGR, ~TRTEMFL, ~TRTEM2FL, ~TRTEM3FL, # nolint + # before treatment + "1", "2021-12-13T20:15", "2021-12-15T12:45", "1", "1", NA, NA, NA, + "1", "2021-12-14T20:15", "2021-12-14T22:00", "1", "3", NA, NA, NA, + # starting before treatment and ending during treatment + "1", "2021-12-30T20:00", "2022-01-14T11:00", "1", "3", NA, "Y", "Y", + "1", "2021-12-31T20:15", "2022-01-01T01:23", "1", "1", NA, NA, NA, + # starting during treatment + "1", "2022-01-01T12:00", "2022-01-02T23:25", "3", "4", "Y", "Y", "Y", + # after treatment + "1", "2022-05-10T11:00", "2022-05-10T13:05", "2", "2", "Y", "Y", "Y", + "1", "2022-05-10T12:00", "2022-05-10T13:05", "2", "2", "Y", "Y", NA, + "1", "2022-05-11T11:00", "2022-05-11T13:05", "2", "2", "Y", NA, NA, + # missing dates + "1", "", "", "3", "4", "Y", "Y", "Y", + "1", "2021-12-30T09:00", "", "3", "4", NA, "Y", "Y", + "1", "2021-12-30T11:00", "", "3", "3", NA, NA, NA, + "1", "", "2022-01-04T09:00", "3", "4", "Y", "Y", "Y", + "1", "", "2021-12-24T19:00", "3", "4", NA, NA, NA, + "1", "", "2022-06-04T09:00", "3", "4", "Y", "Y", "Y", + + # without treatment + "2", "", "2021-12-03T12:00", "1", "2", NA, NA, NA, + "2", "2021-12-01T12:00", "2021-12-03T12:00", "1", "2", NA, NA, NA, + "2", "2021-12-06T18:00", "", "1", "2", NA, NA, NA +) %>% + mutate( + ASTDTM = lubridate::ymd_hm(ASTDTM), + AENDTM = lubridate::ymd_hm(AENDTM), + TRTSDTM = if_else(USUBJID == "1", lubridate::ymd_hm("2022-01-01T01:01"), ymd_hms("")), + TRTEDTM = if_else(USUBJID == "1", lubridate::ymd_hm("2022-04-30T11:30"), ymd_hms("")) + ) + +adae <- select(expected, -starts_with("TRTEM")) + +## Test 1: end_window and worsening parameters not specfied ---- +test_that("derive_var_trtemfl Test 1: end_window and worsening parameters not specfied", { + expect_dfs_equal( + base = select(expected, -TRTEM2FL, -TRTEM3FL), + comp = derive_var_trtemfl(adae), + keys = c("USUBJID", "ASTDTM", "AENDTM") + ) +}) + +## Test 2: with end_window and worsening ---- +test_that("derive_var_trtemfl Test 2: with end_window and worsening", { + expect_dfs_equal( + base = select(expected, -TRTEMFL, -TRTEM3FL), + comp = derive_var_trtemfl( + adae, + new_var = TRTEM2FL, + trt_end_date = TRTEDTM, + end_window = 10, + initial_intensity = AEITOXGR, + intensity = AETOXGR + ), + keys = c("USUBJID", "ASTDTM", "AENDTM") + ) +}) + +## Test 3: considering trt end time ---- +test_that("derive_var_trtemfl Test 3: considering trt end time", { + expect_dfs_equal( + base = select(expected, -TRTEMFL, -TRTEM2FL), + comp = derive_var_trtemfl( + adae, + new_var = TRTEM3FL, + trt_end_date = TRTEDTM, + end_window = 10, + ignore_time_for_trt_end = FALSE, + initial_intensity = AEITOXGR, + intensity = AETOXGR + ), + keys = c("USUBJID", "ASTDTM", "AENDTM") + ) +}) + +## Test 4: error if `end_window` without `trt_end_date` ---- +test_that("derive_var_trtemfl Test 4: error if `end_window` without `trt_end_date`", { + expect_error( + derive_var_trtemfl( + adae, + end_window = 10 + ), + paste( + "`end_window` argument was specified but not `trt_end_date`", + "Either both or none of them must be specified.", + sep = "\n" + ), + fixed = TRUE + ) +}) + +## Test 5: error if `initial_intensity` without `intensity` ---- +test_that("derive_var_trtemfl Test 5: error if `initial_intensity` without `intensity`", { + expect_error( + derive_var_trtemfl( + adae, + initial_intensity = AEITOXGR + ), + paste( + "`initial_intensity` argument was specified but not `intensity`", + "Either both or none of them must be specified.", + sep = "\n" + ), + fixed = TRUE + ) +}) + +## Test 6: error if `intensity` without `initial_intensity` ---- +test_that("derive_var_trtemfl Test 6: error if `intensity` without `initial_intensity`", { + expect_error( + derive_var_trtemfl( + adae, + intensity = AETOXGR + ), + paste( + "`intensity` argument was specified but not `initial_intensity`", + "Either both or none of them must be specified.", + sep = "\n" + ), + fixed = TRUE + ) +}) diff --git a/tests/testthat/test-derive_vars_aage.R b/tests/testthat/test-derive_vars_aage.R index 5f6810b3ec..673c469bc9 100644 --- a/tests/testthat/test-derive_vars_aage.R +++ b/tests/testthat/test-derive_vars_aage.R @@ -1,4 +1,6 @@ -test_that("duration and unit variable are added", { +# derive_vars_aage ---- +## Test 1: duration and unit variable are added ---- +test_that("derive_vars_aage Test 1: duration and unit variable are added", { input <- tibble::tribble( ~BRTHDT, ~RANDDT, ymd("1999-09-09"), ymd("2020-02-20") @@ -8,8 +10,9 @@ test_that("duration and unit variable are added", { expect_dfs_equal(derive_vars_aage(input), expected_output, keys = c("BRTHDT", "RANDDT")) }) - -test_that("derive_var_age_years works as expected", { +# derive_var_age_years ---- +## Test 2: derive_var_age_years works as expected ---- +test_that("derive_var_age_years Test 2: derive_var_age_years works as expected", { input <- tibble::tibble( AGE = c(12, 24, 36, 48, 60), AGEU = c("months", "months", "months", "months", "months") @@ -23,7 +26,8 @@ test_that("derive_var_age_years works as expected", { expect_dfs_equal(derive_var_age_years(input, AGE, new_var = AAGE), expected_output, keys = "AGE") }) -test_that("derive_var_age_years works as expected", { +## Test 3: derive_var_age_years works as expected ---- +test_that("derive_var_age_years Test 3: derive_var_age_years works as expected", { input <- tibble::tibble(AGE = c(12, 24, 36, 48, 60)) expected_output <- mutate( @@ -37,162 +41,115 @@ test_that("derive_var_age_years works as expected", { ) }) -test_that("derive_var_agegr_fda works as expected", { - input <- tibble::tibble(AGE = c(10, 17, 18, 50, 64, 65, 80)) - - expected_output <- mutate( - input, - AGEGR_EXP = factor( - c("<18", "<18", "18-64", "18-64", "18-64", ">=65", ">=65"), - levels = c("<18", "18-64", ">=65"), - exclude = NULL - ) - ) - - expect_dfs_equal(derive_var_agegr_fda(input, AGE, age_unit = "years", AGEGR_EXP), expected_output, - keys = "AGE" +## Test 4: Error is thrown when age_unit is not proper unit ---- +test_that("derive_var_age_years Test 4: Error is thrown when age_unit is not proper unit", { + input <- data.frame(AGE = c(12, 24, 36, 48)) + expect_error( + derive_var_age_years(input, AGE, age_unit = "month", new_var = AAGE), + "`age_unit` must be one of 'years', 'months', 'weeks', 'days', 'hours', 'minutes' or 'seconds' but is 'month'" # nolint ) }) -test_that("derive_var_agegr_fda works with age_unit missing and multiple units in AGEU", { - input <- tibble::tibble( - AGE = c(10, 17, 18, 50, 64, 65, 80, 85), - AGEU = c( - "years", "years", "years", "years", "years", "years", "months", - "months" - ) - ) - - expected_output <- mutate( - input, - AGEGR_EXP = factor( - c("<18", "<18", "18-64", "18-64", "18-64", ">=65", "<18", "<18"), - levels = c("<18", "18-64", ">=65"), - exclude = NULL - ) - ) - - expect_dfs_equal(derive_var_agegr_fda(input, AGE, age_unit = NULL, AGEGR_EXP), expected_output, - keys = "AGE" +## Test 5: Error is issued if age_unit is missing ---- +test_that("derive_var_age_years Test 5: Error is issued if age_unit is missing", { + input <- data.frame(AGE = c(12, 24, 36, 48)) + expect_error( + derive_var_age_years(input, AGE, new_var = AAGE) ) }) -test_that("derive_var_agegr_ema works as expected", { - input <- tibble::tibble(AGE = c(10, 18, 19, 50, 64, 65, 80, 85)) - - expected_output <- mutate( - input, - AGEGR_EXP = factor( - c("2-11 (Children)", "18-64", "18-64", "18-64", "18-64", "65-84", "65-84", ">=85"), - levels = c( - "0-27 days (Newborns)", "28 days to 23 months (Infants and Toddlers)", - "2-11 (Children)", "12-17 (Adolescents)", "18-64", "65-84", ">=85" - ), - exclude = NULL - ) +## Test 6: Warning is issued if age_unit is not null, but the 'unit' variable +## corresponding to age_var stores more than one unique value. ---- +test_that("derive_var_age_years Test 6: Warning is issued if age_unit is not + null, but the 'unit' variable corresponding to age_var stores more + than one unique value.", { + input <- tibble::tribble( + ~AGE, ~AGEU, + #-------/--------- + 25, "years", + 312, "months", + 51, "years", + 402, "months", + 432, "months" ) - expect_dfs_equal(derive_var_agegr_ema(input, AGE, age_unit = "years", AGEGR_EXP), expected_output, - keys = "AGE" + expect_warning( + derive_var_age_years(input, AGE, age_unit = "months", new_var = AAGE) ) }) -test_that("derive_var_agegr_ema - works as expected", { - input <- tibble::tibble(AGE = c(1, 2, 11, 12, 17, 18)) - expected_output <- mutate( - input, - AGEGR_EXP = factor( - c( - "28 days to 23 months (Infants and Toddlers)", "2-11 (Children)", - "2-11 (Children)", "12-17 (Adolescents)", "12-17 (Adolescents)", - "18-64" - ), - levels = c( - "0-27 days (Newborns)", "28 days to 23 months (Infants and Toddlers)", - "2-11 (Children)", "12-17 (Adolescents)", "18-64", "65-84", ">=85" - ), - exclude = NULL - ) - ) - - expect_dfs_equal( - derive_var_agegr_ema(input, AGE, age_unit = "years", AGEGR_EXP), - expected_output, - keys = "AGE" +## Test 7: Error is issued if age_unit consists of more than one unique value. ---- +test_that("derive_var_age_years Test 7: Error is issued if age_unit consists of + more than one unique value.", { + input <- tibble::tribble( + ~AGE, ~AGEU, + #-------/--------- + 459, "months", + 312, "months", + 510, "months", + 402, "months", + 432, "months" ) -}) - -test_that("derive_var_agegr_ema works with age_unit missing and multiple units in AGEU (adults)", { - input <- tibble::tibble( - AGE = c(10, 18, 19, 50, 64, 65, 80, 85), - AGEU = c( - "years", "years", "years", "years", "years", "years", - "months", "years" - ) + expect_error( + derive_var_age_years(input, AGE, age_unit = c("months", "years"), new_var = AAGE) ) +}) - expected_output <- mutate( - input, - AGEGR_EXP = factor( - c("2-11 (Children)", "18-64", "18-64", "18-64", "18-64", "65-84", "2-11 (Children)", ">=85"), - levels = c( - "0-27 days (Newborns)", "28 days to 23 months (Infants and Toddlers)", - "2-11 (Children)", "12-17 (Adolescents)", "18-64", "65-84", ">=85" - ), - exclude = NULL - ) - ) +## Test 8: The 'unit' variable corresponding to age_var will be considered as +## storing one unique unit, if values differ only by case, i.e. +## 'months', 'Months', 'MONTHS' considered same unit, etc. ---- +test_that("derive_var_age_years Test 8: The 'unit' variable corresponding to + age_var will be considered as storing one unique unit, if values + differ only by case, i.e. 'months', 'Months', 'MONTHS' considered same + unit, etc.", { + # The tibbles "input" and "input2" differ only in the third row: "Months" + # versus "months". - expect_dfs_equal(derive_var_agegr_ema(input, AGE, new_var = AGEGR_EXP), expected_output, - keys = "AGE" + input <- tibble::tribble( + ~AGE, ~AGEU, + #-------/--------- + 459, "months", + 312, "months", + 510, "Months", + 402, "months", + 432, "months" ) -}) -test_that("derive_var_agegr_ema - works with age_unit missing and multiple units in AGEU (all)", { - input <- tibble::tibble( - AGE = c(1, 2, 11, 12, 17, 18, 36, 72, 3), - AGEU = c( - "years", "years", "years", "years", "years", "years", "months", - "months", "weeks" - ) + input2 <- tibble::tribble( + ~AGE, ~AGEU, + #-------/--------- + 459, "months", + 312, "months", + 510, "months", + 402, "months", + 432, "months" ) - expected_output <- mutate( - input, - AGEGR_EXP = factor( - c( - "28 days to 23 months (Infants and Toddlers)", "2-11 (Children)", - "2-11 (Children)", "12-17 (Adolescents)", "12-17 (Adolescents)", - "18-64", "2-11 (Children)", "2-11 (Children)", "0-27 days (Newborns)" - ), - levels = c( - "0-27 days (Newborns)", "28 days to 23 months (Infants and Toddlers)", - "2-11 (Children)", "12-17 (Adolescents)", "18-64", "65-84", ">=85" - ), - exclude = NULL - ) - ) - - expect_dfs_equal( - derive_var_agegr_ema(input, AGE, new_var = AGEGR_EXP), - expected_output, - keys = "AGE" + expect_equal( + derive_var_age_years(input, AGE, age_unit = "months", new_var = AAGE)$AAGE, + derive_var_age_years(input2, AGE, age_unit = "months", new_var = AAGE)$AAGE ) }) -test_that("derive_var_age_years - Error is thrown when age_unit is not proper unit ", { - input <- data.frame(AGE = c(12, 24, 36, 48)) - expect_error( - derive_var_age_years(input, AGE, age_unit = "month", new_var = AAGE), - "`age_unit` must be one of 'years', 'months', 'weeks', 'days', 'hours', 'minutes' or 'seconds' but is 'month'" # nolint +## Test 9: Warning is issued if age_unit is not null, but the 'unit' variable +## corresponding to age_var stores one unique unit that is not +## equivalent to age_unit. ---- +test_that("derive_var_age_years Test 9: Warning is issued if age_unit is not + null, but the 'unit' variable corresponding to age_var stores one + unique unit that is not equivalent to age_unit.", { + input <- tibble::tribble( + ~AGE, ~AGEU, + #-------/--------- + 459, "months", + 312, "months", + 510, "months", + 402, "months", + 432, "months" ) -}) -test_that("derive_var_age_years - Error is issued if age_unit is missing", { - input <- data.frame(AGE = c(12, 24, 36, 48)) - expect_error( - derive_var_age_years(input, AGE, new_var = AAGE) + expect_warning( + derive_var_age_years(input, AGE, age_unit = "years", new_var = AAGE) ) }) diff --git a/tests/testthat/test-derive_vars_duration.R b/tests/testthat/test-derive_vars_duration.R index 09cfd45a18..a4a3cf0c5e 100644 --- a/tests/testthat/test-derive_vars_duration.R +++ b/tests/testthat/test-derive_vars_duration.R @@ -1,8 +1,5 @@ -library(tibble) -library(lubridate) - test_that("derive_vars_duration Test 1: Duration and unit variable are added", { - input <- tribble( + input <- tibble::tribble( ~USUBJID, ~BRTHDT, ~RANDDT, "P01", ymd("1984-09-06"), ymd("2020-02-24"), "P02", ymd("1985-01-01"), NA, @@ -27,7 +24,7 @@ test_that("derive_vars_duration Test 1: Duration and unit variable are added", { }) test_that("derive_vars_duration Test 2: Duration and unit variable are added", { - input <- tribble( + input <- tibble::tribble( ~USUBJID, ~ASTDT, ~AENDT, "P01", ymd("2021-03-05"), ymd("2021-03-02"), "P02", ymd("2019-09-18"), ymd("2019-09-18"), @@ -52,7 +49,7 @@ test_that("derive_vars_duration Test 2: Duration and unit variable are added", { }) test_that("derive_vars_duration Test 3: Duration and unit variable are added", { - input <- tribble( + input <- tibble::tribble( ~USUBJID, ~ADTM, ~TRTSDTM, "P01", ymd_hms("2019-08-09T04:30:56"), ymd_hms("2019-08-09T05:00:00"), "P02", ymd_hms("2019-11-11T10:30:00"), ymd_hms("2019-11-11T11:30:00"), diff --git a/tests/testthat/test-derive_vars_last_dose.R b/tests/testthat/test-derive_vars_last_dose.R index 0aae4dc503..5f1635ca3e 100644 --- a/tests/testthat/test-derive_vars_last_dose.R +++ b/tests/testthat/test-derive_vars_last_dose.R @@ -1,7 +1,4 @@ -library(tibble) -library(dplyr) -library(lubridate) -input_ae <- tribble( +input_ae <- tibble::tribble( ~STUDYID, ~USUBJID, ~AESEQ, ~AESTDTC, "my_study", "subject1", 1, "2020-01-02", "my_study", "subject1", 2, "2020-08-31", @@ -15,7 +12,7 @@ input_ae <- tribble( AESTDT = ymd(AESTDTC) ) -input_ex <- tribble( +input_ex <- tibble::tribble( ~STUDYID, ~USUBJID, ~EXSTDTC, ~EXENDTC, ~EXSEQ, ~EXDOSE, ~EXTRT, "my_study", "subject1", "2020-01-01", "2020-01-01", 1, 10, "treatment", "my_study", "subject1", "2020-08-29", "2020-08-29", 2, 10, "treatment", @@ -58,7 +55,7 @@ test_that("derive_vars_last_dose Test 1: function works as expected", { test_that("derive_vars_last_dose Test 2: function checks validity of start and end dose inputs", { input_ex_wrong <- bind_rows( input_ex, - tribble( + tibble::tribble( ~STUDYID, ~USUBJID, ~EXSTDTC, ~EXENDTC, ~EXSEQ, ~EXDOSE, ~EXTRT, "my_study", "subject4", "2020-11-05", "2020-11-06", 1, 10, "treatment" ) %>% @@ -117,7 +114,7 @@ test_that("derive_vars_last_dose Test 3: function returns traceability vars", { test_that("derive_vars_last_dose Test 4: function errors when multiple doses are on same date", { input_ex_dup <- bind_rows( input_ex, - tribble( + tibble::tribble( ~STUDYID, ~USUBJID, ~EXSTDTC, ~EXENDTC, ~EXSEQ, ~EXDOSE, ~EXTRT, "my_study", "subject2", "2020-01-20", "2020-01-20", 3, 0, "placebo" ) %>% @@ -157,7 +154,7 @@ test_that("derive_vars_last_dose Test 4: function errors when multiple doses are test_that("derive_vars_last_dose Test 5: multiple doses on same date - dose_id supplied", { input_ex_dup <- bind_rows( input_ex, - tribble( + tibble::tribble( ~STUDYID, ~USUBJID, ~EXSTDTC, ~EXENDTC, ~EXSEQ, ~EXDOSE, ~EXTRT, "my_study", "subject2", "2020-01-20", "2020-01-20", 3, 0, "placebo" ) %>% mutate( @@ -193,7 +190,7 @@ test_that("derive_vars_last_dose Test 5: multiple doses on same date - dose_id s ## Test 6: error is issued if same variable is found in both input datasets ---- test_that("derive_vars_last_dose Test 6: error is issued if same variable is found in both input datasets", { # nolint - input_ae <- tribble( + input_ae <- tibble::tribble( ~STUDYID, ~USUBJID, ~AESEQ, ~EXSTDTC, "my_study", "subject1", 1, "2020-01-02", "my_study", "subject1", 2, "2020-08-31", @@ -207,7 +204,7 @@ test_that("derive_vars_last_dose Test 6: error is issued if same variable is fou EXSTDT = ymd(EXSTDTC) ) - input_ex <- tribble( + input_ex <- tibble::tribble( ~STUDYID, ~USUBJID, ~EXSTDTC, ~EXENDTC, ~EXSEQ, ~EXDOSE, ~EXTRT, "my_study", "subject1", "2020-01-01", "2020-01-01", 1, 10, "treatment", "my_study", "subject1", "2020-08-29", "2020-08-29", 2, 10, "treatment", @@ -241,14 +238,14 @@ test_that("derive_vars_last_dose Test 6: error is issued if same variable is fou ## Test 7: no error is raised when setting `dose_date` to a renamed variable ---- test_that("derive_vars_last_dose Test 7: no error is raised when setting `dose_date` to a renamed variable", { # nolint - adae <- tribble( + adae <- tibble::tribble( ~USUBJID, ~AESTDTC, ~AENDTC, ~ASTDT, ~AENDT, ~AEDECOD, "P01", "2022-01-10", "2022-01-12", ymd("2022-01-10"), ymd("2022-01-12"), "Nausea", "P02", "2022-01-31", "2022-01-31", ymd("2022-01-31"), ymd("2022-01-31"), "Vomitting", "P02", "2022-02-02", "2022-02-04", ymd("2022-02-02"), ymd("2022-02-04"), "Vomitting" ) - adex <- tribble( + adex <- tibble::tribble( ~USUBJID, ~EXTRT, ~EXDOSFRQ, ~EXSTDTC, ~EXENDTC, ~ASTDT, ~AENDT, ~ASTDTM, ~AENDTM, "P01", "Drug A", "QD", "2022-01-09", "2022-01-12", ymd("2022-01-09"), ymd("2022-01-12"), ymd_hms("2022-01-09 09:30:00"), ymd_hms("2022-01-12 09:30:00"), diff --git a/tests/testthat/test-filter_confirmation.R b/tests/testthat/test-filter_confirmation.R index 1f66e0b7fe..78396d0309 100644 --- a/tests/testthat/test-filter_confirmation.R +++ b/tests/testthat/test-filter_confirmation.R @@ -1,5 +1,4 @@ -library(tibble) -data <- tribble( +data <- tibble::tribble( ~USUBJID, ~AVISITN, ~AVALC, "1", 1, "PR", "1", 2, "CR", @@ -31,7 +30,7 @@ test_that("filter_confirmation Test 1: filter without first_cond", { AVISITN < AVISITN.join ) - expected <- tribble( + expected <- tibble::tribble( ~USUBJID, ~AVISITN, ~AVALC, "1", 1, "PR", "4", 1, "PR" @@ -58,7 +57,7 @@ test_that("filter_confirmation Test 2: filter with first_cond", { filter = TRUE ) - expected <- tribble( + expected <- tibble::tribble( ~USUBJID, ~AVISITN, ~AVALC, "1", 2, "CR" ) @@ -84,7 +83,7 @@ test_that("filter_confirmation Test 3: filter with first_cond and summary functi filter = count_vals(AVALC.join, "SD") <= 1 ) - expected <- tribble( + expected <- tibble::tribble( ~USUBJID, ~AVISITN, ~AVALC, "1", 1, "PR" ) @@ -98,7 +97,7 @@ test_that("filter_confirmation Test 3: filter with first_cond and summary functi ## Test 4: join_type = "all" ---- test_that("filter_confirmation Test 4: join_type = 'all'", { - adae <- tribble( + adae <- tibble::tribble( ~USUBJID, ~ADY, ~ACOVFL, ~ADURN, "1", 10, "N", 1, "1", 21, "N", 50, @@ -121,7 +120,7 @@ test_that("filter_confirmation Test 4: join_type = 'all'", { filter = ADURN > 30 & ACOVFL.join == "Y" & ADY >= ADY.join - 7 ) - expected <- tribble( + expected <- tibble::tribble( ~USUBJID, ~ADY, ~ACOVFL, ~ADURN, "1", 21, "N", 50, "1", 32, "N", 31, @@ -137,7 +136,7 @@ test_that("filter_confirmation Test 4: join_type = 'all'", { # min_cond ---- ## Test 1: test it ---- test_that("min_cond, Test 1: test it", { - data <- tribble( + data <- tibble::tribble( ~USUBJID, ~AVISITN, ~AVALC, "1", 1, "PR", "1", 2, "CR", @@ -153,7 +152,7 @@ test_that("min_cond, Test 1: test it", { first_cr_vis = min_cond(var = AVISITN, cond = AVALC == "CR") ) - expected <- tribble( + expected <- tibble::tribble( ~USUBJID, ~AVISITN, ~AVALC, ~first_cr_vis, "1", 1, "PR", 2, "1", 2, "CR", 2, @@ -175,7 +174,7 @@ test_that("min_cond, Test 1: test it", { # max_cond ---- ## Test 1: test it ---- test_that("max_cond, Test 1: test it", { - data <- tribble( + data <- tibble::tribble( ~USUBJID, ~AVISITN, ~AVALC, "1", 1, "PR", "1", 2, "CR", @@ -191,7 +190,7 @@ test_that("max_cond, Test 1: test it", { last_pr_vis = max_cond(var = AVISITN, cond = AVALC == "PR") ) - expected <- tribble( + expected <- tibble::tribble( ~USUBJID, ~AVISITN, ~AVALC, ~last_pr_vis, "1", 1, "PR", 1, "1", 2, "CR", 1, diff --git a/tests/testthat/test-period_dataset.R b/tests/testthat/test-period_dataset.R new file mode 100644 index 0000000000..0ce79c1394 --- /dev/null +++ b/tests/testthat/test-period_dataset.R @@ -0,0 +1,385 @@ +# create_period_dataset ---- +## Test 1: periods ---- +test_that("create_period_dataset Test 1: periods", { + adsl <- tibble::tribble( + ~USUBJID, ~AP01SDT, ~AP01EDT, ~AP02SDT, ~AP02EDT, + "1", "2021-01-04", "2021-02-06", "2021-02-07", "2021-03-07", + "2", "2021-02-02", "2021-03-02", "2021-03-03", "2021-04-01" + ) %>% + mutate( + dplyr::across(matches("AP\\d\\d[ES]DT"), ymd) + ) %>% + mutate( + STUDYID = "xyz" + ) + + expected <- tibble::tribble( + ~USUBJID, ~APERIOD, ~APERSDT, ~APEREDT, + "1", 1, "2021-01-04", "2021-02-06", + "1", 2, "2021-02-07", "2021-03-07", + "2", 1, "2021-02-02", "2021-03-02", + "2", 2, "2021-03-03", "2021-04-01" + ) %>% + mutate( + STUDYID = "xyz", + APERIOD = as.integer(APERIOD), + dplyr::across(matches("APER[ES]DT"), ymd) + ) + + expect_dfs_equal( + base = expected, + compare = create_period_dataset( + adsl, + new_vars = vars(APERSDT = APxxSDT, APEREDT = APxxEDT) + ), + keys = c("USUBJID", "APERIOD") + ) +}) + +## Test 2: phases ---- +test_that("create_period_dataset Test 2: phases", { + adsl <- tibble::tribble( + ~USUBJID, ~PH1SDT, ~PH1EDT, ~PH2SDT, ~PH2EDT, ~APHASE1, ~APHASE2, + "1", "2021-01-04", "2021-02-06", "2021-02-07", "2021-03-07", "TREATMENT", "FUP", + "2", "2021-02-02", "2021-03-02", NA, NA, "TREATMENT", NA + ) %>% + mutate( + dplyr::across(matches("PH\\d[ES]DT"), ymd) + ) %>% + mutate( + STUDYID = "xyz" + ) + + expected <- tibble::tribble( + ~USUBJID, ~APHASEN, ~PHSDT, ~PHEDT, ~APHASE, + "1", 1, "2021-01-04", "2021-02-06", "TREATMENT", + "1", 2, "2021-02-07", "2021-03-07", "FUP", + "2", 1, "2021-02-02", "2021-03-02", "TREATMENT" + ) %>% + mutate( + STUDYID = "xyz", + APHASEN = as.integer(APHASEN), + dplyr::across(matches("PH[ES]DT"), ymd) + ) + + expect_dfs_equal( + base = expected, + compare = create_period_dataset( + adsl, + new_vars = vars(PHSDT = PHwSDT, PHEDT = PHwEDT, APHASE = APHASEw) + ), + keys = c("USUBJID", "APHASEN") + ) +}) + +## Test 3: subperiods ---- +test_that("create_period_dataset Test 3: subperiods", { + adsl <- tibble::tribble( + ~USUBJID, ~P01S1SDT, ~P01S1EDT, ~P01S2SDT, ~P01S2EDT, ~P02S1SDT, ~P02S1EDT, + "1", "2021-01-04", "2021-01-19", "2021-01-20", "2021-02-06", "2021-02-07", "2021-03-07", + "2", "2021-02-02", "2021-03-02", NA, NA, "2021-03-03", "2021-04-01" + ) %>% + mutate( + dplyr::across(matches("PH\\d\\dS\\d[ES]DT"), ymd) + ) %>% + mutate( + STUDYID = "xyz" + ) + + expected <- tibble::tribble( + ~USUBJID, ~APERIOD, ~ASPER, ~ASPRSDT, ~ASPREDT, + "1", 1, 1, "2021-01-04", "2021-01-19", + "1", 1, 2, "2021-01-20", "2021-02-06", + "1", 2, 1, "2021-02-07", "2021-03-07", + "2", 1, 1, "2021-02-02", "2021-03-02", + "2", 2, 1, "2021-03-03", "2021-04-01" + ) %>% + mutate( + STUDYID = "xyz", + APERIOD = as.integer(APERIOD), + ASPER = as.integer(ASPER), + dplyr::across(matches("APER[ES]DT"), ymd) + ) + + expect_dfs_equal( + base = expected, + compare = create_period_dataset( + adsl, + new_vars = vars(ASPRSDT = PxxSwSDT, ASPREDT = PxxSwEDT) + ), + keys = c("USUBJID", "APERIOD", "ASPER") + ) +}) + +## Test 4: error if no period/phase variable on RHS ---- +test_that("create_period_dataset Test 4: error if no period/phase variable on RHS", { + adsl <- tibble::tribble( + ~USUBJID, ~AP01SDT, ~AP01EDT, ~AP02SDT, ~AP02EDT, + "1", "2021-01-04", "2021-02-06", "2021-02-07", "2021-03-07", + "2", "2021-02-02", "2021-03-02", "2021-03-03", "2021-04-01" + ) %>% + mutate( + dplyr::across(matches("AP\\d\\d[ES]DT"), ymd) + ) %>% + mutate( + STUDYID = "xyz" + ) + + expect_error( + create_period_dataset( + adsl, + new_vars = vars(USUBJ = USUBJID) + ), + regexp = paste( + paste0( + "The right hand side values of `new_vars` have to be CDISC style ", + "subperiod, period, or phase variables." + ), + "I.e., they must contain the xx or w fragment, e.g., APxxSDT, PxxSwSDT, or PHwSDT.", + sep = "\n" + ), + fixed = TRUE + ) +}) + +## Test 5: error if different type of RHSs ---- +test_that("create_period_dataset Test 5: error if different type of RHSs", { + adsl <- tibble::tribble( + ~USUBJID, ~AP01SDT, ~AP01EDT, ~AP02SDT, ~AP02EDT, + "1", "2021-01-04", "2021-02-06", "2021-02-07", "2021-03-07", + "2", "2021-02-02", "2021-03-02", "2021-03-03", "2021-04-01" + ) %>% + mutate( + dplyr::across(matches("AP\\d\\d[ES]DT"), ymd) + ) %>% + mutate( + STUDYID = "xyz" + ) + + expect_error( + create_period_dataset( + adsl, + new_vars = vars(APERSDT = APxxSDT, ASPRSDT = PxxSwSDT) + ), + regexp = paste( + "More than one type of subperiod, period, or phase variables is specified for `new_vars`:", + "subperiod: `PxxSwSDT`", + "period: `APxxSDT`", + sep = "\n" + ), + fixed = TRUE + ) +}) + +## Test 6: error if RHS variable not in input dataset ---- +test_that("create_period_dataset Test 6: error if RHS variable not in input dataset", { + adsl <- tibble::tribble( + ~USUBJID, ~AP01SDT, ~AP01EDT, ~AP02SDT, ~AP02EDT, + "1", "2021-01-04", "2021-02-06", "2021-02-07", "2021-03-07", + "2", "2021-02-02", "2021-03-02", "2021-03-03", "2021-04-01" + ) %>% + mutate( + dplyr::across(matches("AP\\d\\d[ES]DT"), ymd) + ) %>% + mutate( + STUDYID = "xyz" + ) + + expect_error( + create_period_dataset( + adsl, + new_vars = vars(PHSDT = PHwSDT) + ), + regexp = "No variables of the form PHwSDT were found in the input dataset.", + fixed = TRUE + ) +}) + +# derive_vars_period ---- +## Test 7: periods ---- +test_that("derive_vars_period Test 7: periods", { + expected <- tibble::tribble( + ~USUBJID, ~AP01SDT, ~AP01EDT, ~AP02SDT, ~AP02EDT, + "1", "2021-01-04", "2021-02-06", "2021-02-07", "2021-03-07", + "2", "2021-02-02", "2021-03-02", "2021-03-03", "2021-04-01" + ) %>% + mutate( + dplyr::across(matches("AP\\d\\d[ES]DT"), ymd) + ) %>% + mutate( + STUDYID = "xyz" + ) + + period_ref <- tibble::tribble( + ~USUBJID, ~APERIOD, ~APERSDT, ~APEREDT, + "1", 1, "2021-01-04", "2021-02-06", + "1", 2, "2021-02-07", "2021-03-07", + "2", 1, "2021-02-02", "2021-03-02", + "2", 2, "2021-03-03", "2021-04-01" + ) %>% + mutate( + STUDYID = "xyz", + APERIOD = as.integer(APERIOD), + dplyr::across(matches("APER[ES]DT"), ymd) + ) + + adsl <- tibble::tibble(STUDYID = "xyz", USUBJID = c("1", "2")) + + expect_dfs_equal( + base = expected, + compare = derive_vars_period( + adsl, + dataset_ref = period_ref, + new_vars = vars(APxxSDT = APERSDT, APxxEDT = APEREDT) + ), + keys = c("USUBJID") + ) +}) + +## Test 8: phases ---- +test_that("derive_vars_period Test 8: phases", { + expected <- tibble::tribble( + ~USUBJID, ~PH1SDT, ~PH1EDT, ~PH2SDT, ~PH2EDT, ~APHASE1, ~APHASE2, + "1", "2021-01-04", "2021-02-06", "2021-02-07", "2021-03-07", "TREATMENT", "FUP", + "2", "2021-02-02", "2021-03-02", NA, NA, "TREATMENT", NA + ) %>% + mutate( + dplyr::across(matches("PH\\d[ES]DT"), ymd) + ) %>% + mutate( + STUDYID = "xyz" + ) + + phase_ref <- tibble::tribble( + ~USUBJID, ~APHASEN, ~PHSDT, ~PHEDT, ~APHASE, + "1", 1, "2021-01-04", "2021-02-06", "TREATMENT", + "1", 2, "2021-02-07", "2021-03-07", "FUP", + "2", 1, "2021-02-02", "2021-03-02", "TREATMENT" + ) %>% + mutate( + STUDYID = "xyz", + APHASEN = as.integer(APHASEN), + dplyr::across(matches("PH[ES]DT"), ymd) + ) + + adsl <- tibble(STUDYID = "xyz", USUBJID = c("1", "2")) + + expect_dfs_equal( + base = expected, + compare = derive_vars_period( + adsl, + dataset_ref = phase_ref, + new_vars = vars(PHwSDT = PHSDT, PHwEDT = PHEDT, APHASEw = APHASE) + ), + keys = c("USUBJID") + ) +}) + +## Test 9: subperiods ---- +test_that("derive_vars_period Test 9: subperiods", { + expected <- tibble::tribble( + ~USUBJID, ~P01S1SDT, ~P01S1EDT, ~P01S2SDT, ~P01S2EDT, ~P02S1SDT, ~P02S1EDT, + "1", "2021-01-04", "2021-01-19", "2021-01-20", "2021-02-06", "2021-02-07", "2021-03-07", + "2", "2021-02-02", "2021-03-02", NA, NA, "2021-03-03", "2021-04-01" + ) %>% + mutate( + dplyr::across(matches("PH\\d\\dS\\d[ES]DT"), ymd) + ) %>% + mutate( + STUDYID = "xyz" + ) + + subperiod_ref <- tibble::tribble( + ~USUBJID, ~APERIOD, ~ASPER, ~ASPRSDT, ~ASPREDT, + "1", 1, 1, "2021-01-04", "2021-01-19", + "1", 1, 2, "2021-01-20", "2021-02-06", + "1", 2, 1, "2021-02-07", "2021-03-07", + "2", 1, 1, "2021-02-02", "2021-03-02", + "2", 2, 1, "2021-03-03", "2021-04-01" + ) %>% + mutate( + STUDYID = "xyz", + APERIOD = as.integer(APERIOD), + ASPER = as.integer(ASPER), + dplyr::across(matches("APER[ES]DT"), ymd) + ) + + adsl <- tibble(STUDYID = "xyz", USUBJID = c("1", "2")) + + expect_dfs_equal( + base = expected, + compare = derive_vars_period( + adsl, + dataset_ref = subperiod_ref, + new_vars = vars(PxxSwSDT = ASPRSDT, PxxSwEDT = ASPREDT) + ), + keys = c("USUBJID") + ) +}) +## Test 10: error if no period/phase variable on LHS ---- +test_that("derive_vars_period Test 10: error if no period/phase variable on LHS", { + period_ref <- tibble::tribble( + ~USUBJID, ~APERIOD, ~APERSDT, ~APEREDT, + "1", 1, "2021-01-04", "2021-02-06", + "1", 2, "2021-02-07", "2021-03-07", + "2", 1, "2021-02-02", "2021-03-02", + "2", 2, "2021-03-03", "2021-04-01" + ) %>% + mutate( + STUDYID = "xyz", + APERIOD = as.integer(APERIOD), + dplyr::across(matches("APER[ES]DT"), ymd) + ) + + adsl <- tibble(STUDYID = "xyz", USUBJID = c("1", "2")) + + expect_error( + derive_vars_period( + adsl, + dataset_ref = period_ref, + new_vars = vars(USUBJ = USUBJID) + ), + regexp = paste( + paste0( + "The left hand side values of `new_vars` have to be CDISC style ", + "subperiod, period, or phase variables." + ), + "I.e., they must contain the xx or w fragment, e.g., APxxSDT, PxxSwSDT, or PHwSDT.", + sep = "\n" + ), + fixed = TRUE + ) +}) + +## Test 11: error if different type of LHSs ---- +test_that("derive_vars_period Test 11: error if different type of LHSs", { + period_ref <- tibble::tribble( + ~USUBJID, ~APERIOD, ~APERSDT, ~APEREDT, + "1", 1, "2021-01-04", "2021-02-06", + "1", 2, "2021-02-07", "2021-03-07", + "2", 1, "2021-02-02", "2021-03-02", + "2", 2, "2021-03-03", "2021-04-01" + ) %>% + mutate( + STUDYID = "xyz", + APERIOD = as.integer(APERIOD), + dplyr::across(matches("APER[ES]DT"), ymd) + ) + + adsl <- tibble(STUDYID = "xyz", USUBJID = c("1", "2")) + + expect_error( + derive_vars_period( + adsl, + dataset_ref = period_ref, + new_vars = vars(APxxSDT = APERSDT, PxxSwSDT = ASPRSDT) + ), + regexp = paste( + "More than one type of subperiod, period, or phase variables is specified for `new_vars`:", + "subperiod: `PxxSwSDT`", + "period: `APxxSDT`", + sep = "\n" + ), + fixed = TRUE + ) +}) diff --git a/tests/testthat/test-slice_derivation.R b/tests/testthat/test-slice_derivation.R index 6d3784f06f..24eb446001 100644 --- a/tests/testthat/test-slice_derivation.R +++ b/tests/testthat/test-slice_derivation.R @@ -107,24 +107,3 @@ test_that("slice_derivation Test 3: empty slice", { keys = c("USUBJID", "VSSEQ") ) }) - -# print.derivation_slice ---- -## Test 1: `derivation_slice` objects are printed as intended ---- -test_that("print.derivation_slice Test1: `derivation_slice` objects are printed as intended", { - slice <- - derivation_slice( - filter = AVISITN > 0, - args = params(new_var = CHG) - ) - expected_print_output <- c( - " object", - "filter: AVISITN > 0 ", - "args:", - "$new_var", - "CHG", - "", - "attr(,\"class\")", - "[1] \"params\" \"list\" " - ) - expect_identical(capture.output(print(slice)), expected_print_output) -}) diff --git a/tests/testthat/test-user_utils.R b/tests/testthat/test-user_utils.R new file mode 100644 index 0000000000..93df84395b --- /dev/null +++ b/tests/testthat/test-user_utils.R @@ -0,0 +1,221 @@ +# convert_blanks_to_na ---- +## Test 1: blank strings are turned into `NA` ---- +test_that("convert_blanks_to_na Test 1: blank strings are turned into `NA`", { + expect_identical( + convert_blanks_to_na(c("a", "", "b")), + c("a", NA, "b") + ) +}) + +## Test 2: attributes are preserved when converting blanks to `NA` ---- +test_that("convert_blanks_to_na Test 2: attributes are preserved when converting blanks to `NA`", { + input <- structure(letters, names = rev(letters), label = "Letters") + input[c(1, 9, 23)] <- NA + output <- convert_blanks_to_na(input) + + expect_identical(attr(output, "label"), "Letters") + expect_identical(names(output), rev(letters)) +}) + +## Test 3: blank strings are turned into `NA` inside data frames ---- +test_that("convert_blanks_to_na Test 3: blank strings are turned into `NA` inside data frames", { + input <- tibble::tibble( + a = structure(c("a", "b", "", "c"), label = "A"), + b = structure(c(1, NA, 21, 9), label = "B"), + c = structure(c(TRUE, FALSE, TRUE, TRUE), label = "C"), + d = structure(c("", "", "s", "q"), label = "D") + ) + expected_output <- tibble::tibble( + a = structure(c("a", "b", NA, "c"), label = "A"), + b = structure(c(1, NA, 21, 9), label = "B"), + c = structure(c(TRUE, FALSE, TRUE, TRUE), label = "C"), + d = structure(c(NA, NA, "s", "q"), label = "D") + ) + + expect_identical(convert_blanks_to_na(input), expected_output) +}) + + +## Test 4: `convert_blanks_to_na.list` produces a lists ---- +test_that("convert_blanks_to_na.list Test 4: `convert_blanks_to_na.list` produces a lists", { + x <- c("", "", "") + expected_output <- lapply(x, convert_blanks_to_na) + actual_output <- convert_blanks_to_na.list(x) + + expect_equal(expected_output, actual_output) +}) + +# Test 5: convert_na_to_blanks Test 5---- +test_that("convert_na_to_blanks Test 5: `NA` strings are turned into blank ", { + expect_identical( + convert_na_to_blanks(c("a", NA, "b")), + c("a", "", "b") + ) +}) + +## Test 6: attributes are preserved when converting `NA` to blanks ---- +test_that("convert_na_to_blanks Test 6: attributes are preserved when converting `NA` to blanks", { + input <- structure(letters, names = rev(letters), label = "Letters") + input[c(1, 9, 23)] <- NA_character_ + output <- convert_na_to_blanks(input) + + expect_identical(attr(output, "label"), "Letters") + expect_identical(names(output), rev(letters)) +}) + +## Test 7: `NA` are turned into blank strings inside data frames ---- +test_that("convert_na_to_blanks Test 7: `NA` are turned into blank strings inside data frames", { + input <- tibble::tibble( + a = structure(c("a", "b", NA, "c"), label = "A"), + b = structure(c(1, NA, 21, 9), label = "B"), + c = structure(c(TRUE, FALSE, TRUE, TRUE), label = "C"), + d = structure(c(NA, NA, "s", "q"), label = "D") + ) + + expected_output <- tibble::tibble( + a = structure(c("a", "b", "", "c"), label = "A"), + b = structure(c(1, NA, 21, 9), label = "B"), + c = structure(c(TRUE, FALSE, TRUE, TRUE), label = "C"), + d = structure(c("", "", "s", "q"), label = "D") + ) + + expect_equivalent(convert_na_to_blanks.data.frame(input), expected_output) +}) + +# convert_na_to_blanks.list ---- +## Test 8: `convert_na_to_blanks.list` produces a lists ---- +test_that("convert_na_to_blanks.list Test 8: `convert_na_to_blanks.list` produces a lists", { + x <- c(NA_character_, NA_character_, NA_character_) + expected_output <- lapply(x, convert_na_to_blanks) + actual_output <- convert_na_to_blanks.list(x) + + expect_equal(expected_output, actual_output) +}) + +# negate_vars ---- +## Test 9: negate_vars returns list of negated variables ---- +test_that("negate_vars Test 9: negate_vars returns list of negated variables", { + expect_identical(negate_vars(vars(var1, var2)), rlang::exprs(-var1, -var2)) +}) + +## Test 10: negate_vars returns NULL if input is NULL ---- +test_that("negate_vars Test 6: negate_vars returns NULL if input is NULL", { + expect_identical(negate_vars(NULL), NULL) +}) + +# get_one_to_many_dataset ---- +## Test 11: returns a data frame after a previous error ---- +test_that("get_one_to_many_dataset Test 11: returns a data frame after a previous error", { + try(assert_one_to_one(admiral_adsl, vars(STUDYID), vars(SITEID)), silent = TRUE) + + expect_true(is.data.frame(get_one_to_many_dataset())) +}) + +# get_many_to_one_dataset ---- +## Test 12: returns a data frame after a previous error ---- +test_that("get_many_to_one_dataset Test 12: returns a data frame after a previous error", { + try(assert_one_to_one(admiral_adsl, vars(SITEID), vars(STUDYID)), silent = TRUE) + + expect_true(is.data.frame(get_many_to_one_dataset())) +}) + +# print.source ---- +## Test 13: `source` objects are printed as intended ---- +test_that("print.source Test 13: `source` objects are printed as intended", { + ttae <- event_source( + dataset_name = "ae", + date = AESTDTC, + set_values_to = vars( + EVENTDESC = "AE", + SRCDOM = "AE", + SRCVAR = "AESTDTC", + SRCSEQ = AESEQ + ) + ) + expected_print_output <- c( + " object", + "dataset_name: \"ae\"", + "filter: NULL", + "date: AESTDTC", + "censor: 0", + "set_values_to:", + " EVENTDESC: \"AE\"", + " SRCDOM: \"AE\"", + " SRCVAR: \"AESTDTC\"", + " SRCSEQ: AESEQ" + ) + expect_identical(capture.output(print(ttae)), expected_print_output) +}) + +## Test 14: `source` objects containing `source` objects ---- +test_that("print.source Test 14: `source` objects containing `source` objects", { + slice <- + derivation_slice( + filter = AVISITN > 0, + args = params(new_var = CHG) + ) + expected_print_output <- c( + " object", + "filter: AVISITN > 0", + "args:", + " object", + " new_var: CHG" + ) + expect_identical(capture.output(print(slice)), expected_print_output) +}) + +## Test 15: `source` objects containing `data.frame` ---- +test_that("print.source Test 15: `source` objects containing `data.frame`", { + cqterms <- tibble::tribble( + ~TERM_NAME, ~TERM_ID, + "APPLICATION SITE ERYTHEMA", 10003041L, + "APPLICATION SITE PRURITUS", 10003053L + ) %>% + mutate(TERM_LEVEL = "AEDECOD") + + cq <- query( + prefix = "CQ01", + name = "Application Site Issues", + definition = cqterms + ) + expected_print_output <- c( + " object", + "prefix: \"CQ01\"", + "name: \"Application Site Issues\"", + "add_scope_num: FALSE", + "definition:", + "# A tibble: 2 x 3", + " TERM_NAME TERM_ID TERM_LEVEL", + " ", + "1 APPLICATION SITE ERYTHEMA 10003041 AEDECOD ", + "2 APPLICATION SITE PRURITUS 10003053 AEDECOD " + ) + # replace × with x due to differences between R versions and remove formatting + expect_identical( + str_replace_all(capture.output(print(cq)), "×", "x") %>% + str_replace_all("\033\\[[\\d;]+m", ""), + expected_print_output + ) +}) + +## Test 16 print_named_list ---- +test_that("print_named_list Test 16: named list", { + expect_identical( + capture.output(print_named_list(list(a = 1, b = 2))), + c( + "a: 1", + "b: 2" + ) + ) +}) + +## Test 17: unnamed list ---- +test_that("print_named_list Test 17: unnamed list", { + expect_identical( + capture.output(print_named_list(list(1, 2))), + c( + "1: 1", + "2: 2" + ) + ) +}) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R deleted file mode 100644 index d639668b79..0000000000 --- a/tests/testthat/test-utils.R +++ /dev/null @@ -1,177 +0,0 @@ -test_that("atomic vectors of length 1", { - expect_identical(what_is_it(NULL), "`NULL`") - expect_identical(what_is_it(TRUE), "`TRUE`") - expect_identical(what_is_it(NA), "`NA`") - expect_identical(what_is_it("Text"), '`"Text"`') - expect_identical(what_is_it("3"), '`"3"`') - expect_identical(what_is_it(4L), "`4`") - expect_identical(what_is_it(2.42), "`2.42`") -}) - - -test_that("S3 objects", { - expect_identical(what_is_it(mtcars), "a data frame") - expect_identical(what_is_it(factor(letters)), "a factor") - expect_identical(what_is_it(lm(hp ~ mpg, data = mtcars)), "an object of class 'lm'") - expect_identical(what_is_it(quo(4 / 1)), "an object of class 'quosure'") -}) - - -test_that("S4 objects", { - expect_identical(what_is_it(lubridate::days(1)), "a S4 object of class 'Period'") -}) - -test_that("symbols", { - expect_identical(what_is_it(quote(USUBJID)), "a symbol") -}) - -test_that("input is returned as is if filter is NULL", { - input <- tibble::tribble( - ~USUBJID, ~VSTESTCD, ~VSSTRESN, - "P01", "WEIGHT", 80.9, - "P01", "HEIGHT", 189.2 - ) - - expect_dfs_equal( - input, - filter_if(input, quo(NULL)), - keys = c("USUBJID", "VSTESTCD") - ) -}) - -test_that("input is filtered if filter is not NULL", { - input <- tibble::tribble( - ~USUBJID, ~VSTESTCD, ~VSSTRESN, - "P01", "WEIGHT", 80.9, - "P01", "HEIGHT", 189.2 - ) - - expect_dfs_equal( - input[1L, ], - filter_if(input, quo(VSTESTCD == "WEIGHT")), - keys = c("USUBJID", "VSTESTCD") - ) -}) - -test_that("enumerate works", { - expect_equal(enumerate(letters[1]), "`a`") - expect_equal(enumerate(letters[1:3]), "`a`, `b` and `c`") -}) - -test_that("squote works", { - expect_equal(squote(letters[1]), "'a'") - expect_equal(squote(letters[1:3]), c("'a'", "'b'", "'c'")) -}) - -test_that("arg_name works", { - expect_equal(arg_name(sym("a")), "a") - expect_equal(arg_name(call("enquo", sym("a"))), "a") - expect_error(arg_name("a"), "Could not extract argument name from") -}) - -test_that("blank strings are turned into `NA`", { - expect_identical( - convert_blanks_to_na(c("a", "", "b")), - c("a", NA, "b") - ) -}) - -test_that("attributes are preserved when converting blanks to `NA`", { - input <- structure(letters, names = rev(letters), label = "Letters") - input[c(1, 9, 23)] <- NA - output <- convert_blanks_to_na(input) - - expect_identical(attr(output, "label"), "Letters") - expect_identical(names(output), rev(letters)) -}) - -test_that("blank strings are turned into `NA` inside data frames", { - input <- tibble::tibble( - a = structure(c("a", "b", "", "c"), label = "A"), - b = structure(c(1, NA, 21, 9), label = "B"), - c = structure(c(TRUE, FALSE, TRUE, TRUE), label = "C"), - d = structure(c("", "", "s", "q"), label = "D") - ) - expected_output <- tibble::tibble( - a = structure(c("a", "b", NA, "c"), label = "A"), - b = structure(c(1, NA, 21, 9), label = "B"), - c = structure(c(TRUE, FALSE, TRUE, TRUE), label = "C"), - d = structure(c(NA, NA, "s", "q"), label = "D") - ) - - expect_identical(convert_blanks_to_na(input), expected_output) -}) - -test_that("`convert_blanks_to_na.list` produces a lists", { - x <- c("", "", "") - expected_output <- lapply(x, convert_blanks_to_na) - actual_output <- convert_blanks_to_na.list(x) - - expect_equal(expected_output, actual_output) -}) - -test_that("negate_vars returns list of negated variables", { - expect_identical(negate_vars(vars(var1, var2)), rlang::exprs(-var1, -var2)) -}) - -test_that("negate_vars returns NULL if input is NULL", { - expect_identical(negate_vars(NULL), NULL) -}) - -test_that("`get_one_to_many_dataset()` returns a data frame after a previous error", { - try(assert_one_to_one(admiral_adsl, vars(STUDYID), vars(SITEID)), silent = TRUE) - - expect_true(is.data.frame(get_one_to_many_dataset())) -}) - -test_that("`get_many_to_one_dataset()` returns a data frame after a previous error", { - try(assert_one_to_one(admiral_adsl, vars(SITEID), vars(STUDYID)), silent = TRUE) - - expect_true(is.data.frame(get_many_to_one_dataset())) -}) - -test_that("`convert_dtm_to_dtc` is in correct format", { - expect_equal( - convert_dtm_to_dtc(as.POSIXct("2022-04-05 15:34:07 UTC")), - "2022-04-05T15:34:07" - ) -}) - - -test_that("`convert_dtm_to_dtc` Error is thrown if dtm is not in correct format", { - expect_error( - convert_dtm_to_dtc("2022-04-05T15:26:14"), - "lubridate::is.instant(dtm) is not TRUE", - fixed = TRUE - ) -}) - -test_that("get_constant_vars Test 1: without ignore_vars", { - data <- tibble::tribble( - ~USUBJID, ~AGE, ~AVISIT, - "1", 26, "BASELINE", - "1", 26, "WEEK 1", - "2", 42, "BASELINE", - "2", 42, "WEEK 1" - ) - - expect_equal( - get_constant_vars(data, by_vars = vars(USUBJID)), - vars(USUBJID, AGE) - ) -}) - -test_that("get_constant_vars Test 2: with ignore_vars", { - data <- tibble::tribble( - ~USUBJID, ~AGE, ~WGTBL, ~HGTBL, ~AVISIT, - "1", 26, 61, 172, "BASELINE", - "1", 26, 61, 172, "WEEK 1", - "2", 42, 72, 183, "BASELINE", - "2", 42, 72, 183, "WEEK 1" - ) - - expect_equal( - get_constant_vars(data, by_vars = vars(USUBJID), ignore_vars = vars(WGTBL, HGTBL)), - vars(USUBJID, AGE) - ) -}) diff --git a/vignettes/admiral.Rmd b/vignettes/admiral.Rmd index 09690679aa..66e5788fc3 100644 --- a/vignettes/admiral.Rmd +++ b/vignettes/admiral.Rmd @@ -29,7 +29,7 @@ for example the following script which creates a (very simple) ADSL dataset. First, we will load our packages and example datasets to help with our `ADSL` creation. The `{dplyr}` and `{lubridate}` packages are `{tidyverse}` packages and used heavily throughout this script. The `{admiral}` package also leverages the `{admiral.test}` package for example SDTM datasets which are from the CDISC Pilot Study. ```{r, message=FALSE, warning=FALSE} -library(dplyr) +library(dplyr, warn.conflicts = FALSE) library(lubridate) library(admiral) library(admiral.test) diff --git a/vignettes/adsl.Rmd b/vignettes/adsl.Rmd index 0facb06d21..13a86106d4 100644 --- a/vignettes/adsl.Rmd +++ b/vignettes/adsl.Rmd @@ -29,6 +29,7 @@ otherwise specified.* # Programming Flow * [Read in Data](#readdata) +* [Derive Period, Subperiod, and Phase Variables (e.g. `APxxSDT`, `APxxEDT`, ...)](#periodvars) * [Derive Treatment Variables (`TRT0xP`, `TRT0xA`)](#treatmentvar) * [Derive/Impute Numeric Treatment Date/Time and Duration (`TRTSDT`, `TRTEDT`, `TRTDURD`)](#trtdatetime) * [Derive Disposition Variables](#disposition) @@ -42,7 +43,7 @@ otherwise specified.* * [Duration Relative to Death](#death_other) * [Derive Last Known Date Alive (`LSTALVDT`)](#lstalvdt) * [Derive Groupings and Populations](#groupings) - * [Grouping (e.g. `AGEGR1`)](#groupings_ex) + * [Grouping (e.g. `AGEGR1` or `REGION1`)](#groupings_ex) * [Population Flags (e.g. `SAFFL`)](#popflag) * [Derive Other Variables](#other) * [Add Labels and Attributes](#attributes) @@ -59,7 +60,7 @@ For example purpose, the CDISC Pilot SDTM datasets---which are included in ```{r, message=FALSE, warning=FALSE} library(admiral) -library(dplyr) +library(dplyr, warn.conflicts = FALSE) library(admiral.test) library(lubridate) library(stringr) @@ -91,15 +92,28 @@ dataset_vignette( ) ``` +## Derive Period, Subperiod, and Phase Variables (e.g. `APxxSDT`, `APxxEDT`, ...) {#periodvars} + +See the ["Visit and Period Variables" +vignette](visits_periods.html#periods_adsl) for more information. + +If the variables are not derived based on a period reference dataset, they may +be derived at a later point of the flow. For example, phases like "Treatment +Phase" and "Follow up" could be derived based on treatment start and end date. + ## Derive Treatment Variables (`TRT0xP`, `TRT0xA`) {#treatmentvar} -The mapping of the treatment variables is left to the ADaM programmer. An example mapping may be: +The mapping of the treatment variables is left to the ADaM programmer. An +example mapping for a study without periods may be: ```{r eval=TRUE} adsl <- dm %>% mutate(TRT01P = ARM, TRT01A = ACTARM) ``` +For studies with periods see the ["Visit and Period Variables" +vignette](visits_periods.html#treatment_adsl). + ## Derive/Impute Numeric Treatment Date/Time and Duration (`TRTSDTM`, `TRTEDTM`, `TRTDURD`) {#trtdatetime} The function `derive_vars_merged()` can be used to derive the treatment start @@ -463,7 +477,7 @@ src_ae <- dthcaus_source( dataset_vignette( ae, display_vars = vars(USUBJID, AESTDTC, AEENDTC, AEDECOD, AEOUT), - filter = AEOUT == "FATAL" + filter = AEOUT == "FATAL" ) ``` @@ -699,7 +713,7 @@ adsl <- adsl %>% dataset_vignette( adsl, display_vars = vars(USUBJID, TRTEDT, DTHDTC, LSTALVDT, LALVDOM, LALVSEQ, LALVVAR), - filter = !is.na(TRTSDT) + filter = !is.na(TRTSDT) ) ``` @@ -710,31 +724,22 @@ dataset_vignette( Numeric and categorical variables (`AGE`, `RACE`, `COUNTRY`, etc.) may need to be grouped to perform the required analysis. -`{admiral}` does not **currently** have functionality to assist with all required groupings. Some functions exist for age grouping according to FDA or EMA conventions. For others, the user can create his/her own function to meet his/her study requirement. +`{admiral}` does not **currently** have functionality to assist with all required groupings. So, the user will often need to create his/her own function to meet his/her study requirement. -To derive `AGEGR1` as categorized `AGE` in `< 18 `, `18-65`, `>= 65` (FDA convention): +For example, if -```{r eval=TRUE} -adsl <- adsl %>% - derive_var_agegr_fda( - age_var = AGE, - new_var = AGEGR1 - ) -``` - -However for example if +- `AGEGR1` is required to categorize `AGE` into `<18`, `18-64` and `>64`, or +- `REGION1` is required to categorize `COUNTRY` in `North America`, `Rest of the World`, -- `AGEGR2` would categorize `AGE` in `< 65`, `>= 65`, -- `REGION1` would categorize `COUNTRY` in `North America`, `Rest of the World`, - -the user defined function(s) would be like: +the user defined functions would look like the following: ```{r eval=TRUE} -format_agegr2 <- function(var_input) { +format_agegr1 <- function(var_input) { case_when( - var_input < 65 ~ "< 65", - var_input >= 65 ~ ">= 65", - TRUE ~ NA_character_ + var_input < 18 ~ "<18", + between(var_input, 18, 64) ~ "18-64", + var_input > 64 ~ ">64", + TRUE ~ "Missing" ) } @@ -752,7 +757,7 @@ These functions are then used in a `mutate()` statement to derive the required g ```{r eval=TRUE} adsl <- adsl %>% mutate( - AGEGR2 = format_agegr2(AGE), + AGEGR1 = format_agegr1(AGE), REGION1 = format_region1(COUNTRY) ) ``` @@ -760,7 +765,7 @@ adsl <- adsl %>% ```{r, eval=TRUE, echo=FALSE} dataset_vignette( adsl, - display_vars = vars(USUBJID, AGE, SEX, COUNTRY, AGEGR1, AGEGR2, REGION1) + display_vars = vars(USUBJID, AGE, SEX, COUNTRY, AGEGR1, REGION1) ) ``` @@ -795,9 +800,12 @@ The users can add specific code to cover their need for the analysis. The following functions are helpful for many ADSL derivations: - `derive_vars_merged()` - Merge Variables from a Dataset to the Input Dataset - - `derive_var_merged_cat()` - Merge a Categorization Variable - `derive_var_merged_exist_flag()` - Merge an Existence Flag + - `derive_var_merged_cat()` - Merge a Categorization Variable - `derive_var_merged_character()` - Merge a Character Variable + - `derive_var_merged_summary()` - Merge a Summary Variable + +See also [Generic Functions](generic.html). ## Add Labels and Attributes {#attributes} @@ -818,7 +826,8 @@ file(xpt)](https://documentation.sas.com/doc/en/pgmsascdc/9.4_3.5/movefile/n1xbw NOTE: All these packages are in the experimental phase, but the vision is to have them associated with an End to End pipeline under the umbrella of the -[pharmaverse](https://github.com/pharmaverse). +[pharmaverse](https://github.com/pharmaverse). An example of applying metadata +and perform associated checks can be found at the [pharmaverse E2E example](https://examples.pharmaverse.org/data/adsl/). # Example Script diff --git a/vignettes/bds_exposure.Rmd b/vignettes/bds_exposure.Rmd index eccaa1ef3a..b3091f8a3d 100644 --- a/vignettes/bds_exposure.Rmd +++ b/vignettes/bds_exposure.Rmd @@ -44,6 +44,7 @@ otherwise specified.* * [Derive Categorization Variables (`AVALCATx`)](#cat) * [Assign `ASEQ`](#aseq) * [Add ADSL variables `ASEQ`](#adsl_vars) +* [Add Labels and Attributes](#attributes) ## Read in Data {#readdata} @@ -55,7 +56,7 @@ For example purpose, the CDISC Pilot SDTM and ADaM datasets---which are included ```{r message=FALSE} library(admiral) -library(dplyr) +library(dplyr, warn.conflicts = FALSE) library(admiral.test) library(lubridate) library(stringr) @@ -278,7 +279,9 @@ frequency to a corresponding set of records each representing one dose (i.e. single_dose <- adex %>% filter(USUBJID == "01-701-1015" & EXSTDY == 1) %>% create_single_dose_dataset(keep_source_vars = vars(USUBJID, EXDOSE, EXPLDOS, EXDOSFRQ, ASTDT, AENDT)) +``` +```{r, eval=TRUE, echo=FALSE} dataset_vignette( single_dose, display_vars = vars(USUBJID, EXDOSE, EXPLDOS, EXDOSFRQ, ASTDT, AENDT) @@ -587,6 +590,28 @@ adex <- adex %>% by_vars = vars(STUDYID, USUBJID) ) ``` +## Add Labels and Attributes {#attributes} + +Adding labels and attributes for SAS transport files is supported by the +following packages: + +- [metacore](https://atorus-research.github.io/metacore/): establish a common +foundation for the use of metadata within an R session. + +- [metatools](https://pharmaverse.github.io/metatools/): enable the use of +metacore objects. Metatools can be used to build datasets or enhance columns in +existing datasets as well as checking datasets against the metadata. + +- [xportr](https://atorus-research.github.io/xportr/): functionality to +associate all metadata information to a local R data frame, perform data set +level validation checks and convert into a [transport v5 +file(xpt)](https://documentation.sas.com/doc/en/pgmsascdc/9.4_3.5/movefile/n1xbwdre0giahfn11c99yjkpi2yb.htm). + +NOTE: All these packages are in the experimental phase, but the vision is to +have them associated with an End to End pipeline under the umbrella of the +[pharmaverse](https://github.com/pharmaverse). An example of applying metadata +and perform associated checks can be found at the [pharmaverse E2E example](https://examples.pharmaverse.org/data/adsl/). + # Example Scripts {#example} ADaM | Sample Code diff --git a/vignettes/bds_finding.Rmd b/vignettes/bds_finding.Rmd index f9e71d7825..8b62183854 100644 --- a/vignettes/bds_finding.Rmd +++ b/vignettes/bds_finding.Rmd @@ -47,6 +47,7 @@ otherwise specified.* * [Derive Categorization Variables (`AVALCATx`)](#cat) * [Add ADSL variables](#adsl_vars) * [Derive New Rows](#additional) +* [Add Labels and Attributes](#attributes) ## Read in Data {#readdata} @@ -58,7 +59,7 @@ For example purpose, the CDISC Pilot SDTM and ADaM datasets---which are included ```{r message=FALSE} library(admiral) -library(dplyr) +library(dplyr, warn.conflicts = FALSE) library(admiral.test) library(lubridate) library(stringr) @@ -426,12 +427,15 @@ advs <- advs %>% ATPTN = VSTPTNUM ) - count(advs, VISITNUM, VISIT, AVISITN, AVISIT) count(advs, VSTPTNUM, VSTPT, ATPTN, ATPT) ``` +For assigning visits based on time windows and deriving periods, subperiods, and +phase variables see the ["Visit and Period Variables" +vignette](visits_periods.html). + ## Timing Flag Variables (e.g. `ONTRTFL`) {#timingflag} In some analyses, it may be necessary to flag an observation as on-treatment. @@ -804,12 +808,11 @@ dataset_vignette( ## Assign Treatment (`TRTA`, `TRTP`) {#treatment} -`TRTA` and `TRTP` must correlate to treatment `TRTxxP` and/or `TRTxxA` in ADSL. The -derivation of `TRTA` and `TRTP` for a record are protocol and analysis specific. -`{admiral}` does not currently have functionality to assist with `TRTA` and `TRTP` -assignment. +`TRTA` and `TRTP` must match at least one value of the character treatment +variables in ADSL (e.g., `TRTxxA`/`TRTxxP`, `TRTSEQA`/`TRTSEQP`, +`TRxxAGy`/`TRxxPGy`). -However, an example of a simple implementation could be: +An example of a simple implementation for a study without periods could be: ```{r eval=TRUE} advs <- mutate(advs, TRTP = TRT01P, TRTA = TRT01A) @@ -817,6 +820,9 @@ advs <- mutate(advs, TRTP = TRT01P, TRTA = TRT01A) count(advs, TRTP, TRTA, TRT01P, TRT01A) ``` +For studies with periods see the ["Visit and Period Variables" +vignette](visits_periods.html#treatment_bds). + ## Assign `ASEQ` {#aseq} The `{admiral}` function `derive_var_obs_number()` can be used to derive `ASEQ`. An @@ -1024,6 +1030,28 @@ dataset_vignette( ) ``` +## Add Labels and Attributes {#attributes} + +Adding labels and attributes for SAS transport files is supported by the +following packages: + +- [metacore](https://atorus-research.github.io/metacore/): establish a common +foundation for the use of metadata within an R session. + +- [metatools](https://pharmaverse.github.io/metatools/): enable the use of +metacore objects. Metatools can be used to build datasets or enhance columns in +existing datasets as well as checking datasets against the metadata. + +- [xportr](https://atorus-research.github.io/xportr/): functionality to +associate all metadata information to a local R data frame, perform data set +level validation checks and convert into a [transport v5 +file(xpt)](https://documentation.sas.com/doc/en/pgmsascdc/9.4_3.5/movefile/n1xbwdre0giahfn11c99yjkpi2yb.htm). + +NOTE: All these packages are in the experimental phase, but the vision is to +have them associated with an End to End pipeline under the umbrella of the +[pharmaverse](https://github.com/pharmaverse). An example of applying metadata +and perform associated checks can be found at the [pharmaverse E2E example](https://examples.pharmaverse.org/data/adsl/). + # Example Scripts {#example} ADaM | Sample Code diff --git a/vignettes/bds_tte.Rmd b/vignettes/bds_tte.Rmd index e0ed7b9346..ee86be864b 100644 --- a/vignettes/bds_tte.Rmd +++ b/vignettes/bds_tte.Rmd @@ -35,7 +35,7 @@ The examples of this vignette require the following packages. ```{r, warning=FALSE, message=FALSE} library(admiral) -library(dplyr) +library(dplyr, warn.conflicts = FALSE) library(admiral.test) ``` @@ -50,6 +50,7 @@ library(lubridate) * [Derive Analysis Value (`AVAL`)](#aval) * [Derive Analysis Sequence Number (`ASEQ`)](#aseq) * [Add ADSL Variables](#adslvars) +* [Add Labels and Attributes](#attributes) ## Read in Data {#readdata} @@ -110,8 +111,7 @@ parameter) are potential events or censorings, - the value of the `CNSR` variable (`censor` parameter), and - which variable provides the date (`date` parameter). -The date can be provided as date (`--DT` variable), datetime (`--DTM` variable), -or character ISO-8601 date (`--DTC` variable). +The date can be provided as date (`--DT` variable) or datetime (`--DTM` variable). CDISC strongly recommends `CNSR = 0` for events and positive integers for censorings. `{admiral}` enforces this recommendation. Therefore the `censor` @@ -668,3 +668,25 @@ dataset_vignette( display_vars = vars(USUBJID, PARAMCD, CNSR, AVAL, ARMCD, AGE, SEX) ) ``` + +## Add Labels and Attributes {#attributes} + +Adding labels and attributes for SAS transport files is supported by the +following packages: + +- [metacore](https://atorus-research.github.io/metacore/): establish a common +foundation for the use of metadata within an R session. + +- [metatools](https://pharmaverse.github.io/metatools/): enable the use of +metacore objects. Metatools can be used to build datasets or enhance columns in +existing datasets as well as checking datasets against the metadata. + +- [xportr](https://atorus-research.github.io/xportr/): functionality to +associate all metadata information to a local R data frame, perform data set +level validation checks and convert into a [transport v5 +file(xpt)](https://documentation.sas.com/doc/en/pgmsascdc/9.4_3.5/movefile/n1xbwdre0giahfn11c99yjkpi2yb.htm). + +NOTE: All these packages are in the experimental phase, but the vision is to +have them associated with an End to End pipeline under the umbrella of the +[pharmaverse](https://github.com/pharmaverse). An example of applying metadata +and perform associated checks can be found at the [pharmaverse E2E example](https://examples.pharmaverse.org/data/adsl/). diff --git a/vignettes/faq.Rmd b/vignettes/faq.Rmd index 23be61ffb9..33e7c59016 100644 --- a/vignettes/faq.Rmd +++ b/vignettes/faq.Rmd @@ -49,8 +49,8 @@ knitr::opts_chunk$set( ##### Why do we use a **certain R version and package versions** for development? -* The choice of R Version is not set in stone. However, a common development environment is important to establish when working across multiple companies and multiple developers. We currently work in R Version 3.6.3, but that will change as we move forward with `{admiral}`. This need for a common development environment also carries over for our choice of package versions. -* GitHub allows us through the Actions/Workflows to test `{admiral}` under several versions of R as well as several versions of dependent R packages needed for `{admiral}`. Currently we test `{admiral}` against R Version 3.6.3 with a CRAN package snapshot from 2020-02-29, R Version 4.0 with a CRAN package snapshot from 2021-03-31 and the latest R version with the latest snapshots of packages. You can view this workflow and others on our [admiralci GitHub Repository](https://github.com/pharmaverse/admiralci). +* The choice of R Version is not set in stone. However, a common development environment is important to establish when working across multiple companies and multiple developers. We currently work in the earliest of the three latest R Versions. This need for a common development environment also carries over for our choice of package versions. +* GitHub allows us through the Actions/Workflows to test `{admiral}` under several versions of R as well as several versions of dependent R packages needed for `{admiral}`. Currently we test `{admiral}` against the three latest R Versions and the closest snapshots of packages to those R versions. You can view this workflow and others on our [admiralci GitHub Repository](https://github.com/pharmaverse/admiralci). * This common development allows us to easily re-create bugs and provide solutions to each other issues that developers will encounter. * Reviewers of Pull Requests when running code will know that their environment is identical to the initiator of the Pull Request. This ensures faster review times and higher quality Pull Request reviews. * We achieve this common development environment by using a **lockfile** created from the [`renv`](https://rstudio.github.io/renv/) package. New developers will encounter a suggested `renv::restore()` in the console to revert or move forward your R version and package versions. diff --git a/vignettes/generic.Rmd b/vignettes/generic.Rmd new file mode 100644 index 0000000000..5505b15070 --- /dev/null +++ b/vignettes/generic.Rmd @@ -0,0 +1,383 @@ +--- +title: "Generic Functions" +output: + rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Generic Functions} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r setup, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +library(admiraldev) +``` + +# Introduction + +This vignette explains some of the `{admiral}` generic functions, which we believe +are able to be re-used to sometimes save users having to create so many of their +own functions for study-specific analysis derivations. These re-usable functions give +the users great flexibility, but the challenge is knowing which to use when. So +this vignette is intended to help understand the differences between each, thus +improving the findability of the function needed for each task. + +The focus will be on the following different sets of generic functions: + +* [_merged_ functions](#merged) +* [_joined_ functions](#joined) +* [_extreme_ functions](#extreme) + +In each section below, we will show examples of different functions that belong +to each of these sets, but we don't list out each and every function offered. +Users should refer to the Reference page and search for example "merged" to see +the full list of functions offered for this respective set, with more examples +shown within each function page. + +## Required Packages + +The examples in this vignette require the following packages. + +For example purpose, the SDTM datasets from `{admiral.test}` are used. + +```{r, warning=FALSE, message=FALSE} +library(admiral) +library(admiral.test) +library(dplyr, warn.conflicts = FALSE) +library(stringr) +library(tibble) + +data("admiral_dm") +data("admiral_ds") +data("admiral_ex") +data("admiral_ae") +dm <- convert_blanks_to_na(admiral_dm) +ds <- convert_blanks_to_na(admiral_ds) +ex <- convert_blanks_to_na(admiral_ex) +ae <- convert_blanks_to_na(admiral_ae) +``` +```{r echo=FALSE} +# Filter test patients and make more realistic and interesting for the examples +dm <- filter(dm, USUBJID %in% c("01-701-1111", "01-701-1047", "01-701-1057")) +ds <- filter(ds, USUBJID %in% c("01-701-1111", "01-701-1047", "01-701-1057")) %>% + mutate(DSSTDTC = case_when( + USUBJID == "01-701-1111" & DSDECOD == "RANDOMIZED" ~ "2012-08-01", + TRUE ~ DSSTDTC + )) +ex <- filter(ex, USUBJID %in% c("01-701-1111", "01-701-1047", "01-701-1057")) +ae <- filter(ae, USUBJID %in% c("01-701-1111", "01-701-1047")) %>% + mutate(AESTDTC = case_when( + USUBJID == "01-701-1111" & AESTDY == "-61" ~ "2012-09-14", + TRUE ~ AESTDTC + )) %>% + mutate(AESTDY = case_when( + USUBJID == "01-701-1111" & AESTDY == "-61" ~ 8, + TRUE ~ AESTDY + )) +``` + +# Difference between _merged_ and _joined_ functions + +Firstly, we need to address the question all new users will have... why do we have +"merged" and "joined" functions and are they not the same thing?? + +Essentially in both sets of functions we are trying to take information from +an additional dataframe (passed into the `dataset_add` argument) and join it to +our original dataframe (passed into the `dataset` argument). The subtle difference +is that "merged" functions select the relevant information from the additional +dataframe and then adds it to the original dataframe; whilst "joined" functions +allow an extra filter condition after the join to further select the relevant +information. + +So in `derive_vars_joined()` for example, the filter conditions can depend on variables +from both dataframes; whilst in `derive_vars_merged()` only variables from the +additional dataframe can be used. Examples will be shown in the below sections to +further explain the difference. + +In principle though, we actually could achieve every "merged" function result using +the equivalent "joined" function. However, the "joined" functions require much more +resources (time and memory), hence why we include both options for users. + +# _merged_ functions {#merged} + +## Description + +As explained above, this simpler set of functions for joins selects relevant +information from the additional dataframe and joins it to the original dataframe. + +The additional dataframe can be filtered based on a user-defined condition passed +into the `filter_add` argument and/or (where relevant) by selecting the first or +last observation for each by group (`order` and `mode` arguments) and then joined with +the input dataframe by user-specified variables passed into `by_vars` argument. +Variables from the additional dataframe can be joined to the input dataframe as +they are or can be renamed (`new_vars` argument). + +The dataframe returned from the function call contains all observations and variables +from the original dataframe (with or without filtering applied) and additionally +the variable(s) specified for `new_var`/`new_vars` from the additional dataframe. +This is achieved via an underlying [dplyr::left_join](https://dplyr.tidyverse.org/reference/mutate-joins.html). +For observations without a match in the additional dataframe the new variable(s) +are set to `NA`. Observations in the additional dataframe which have no match in +the original dataframe are ignored. + +## Examples + +A simple call to derive `ADSL` randomization date (`ADSL.RANDDT`) from an +intermediate additional dataframe would use `derive_vars_merged()` as follows. + +```{r eval=TRUE} +# Use DM domain as basis to build ADSL +adsl_01 <- dm %>% + select(-DOMAIN) + +# Convert disposition character date to numeric date without imputation +ds_ext <- derive_vars_dt( + dataset = ds, + dtc = DSSTDTC, + new_vars_prefix = "DSST" +) + +# Join randomization date to ADSL +adsl_02 <- adsl_01 %>% + derive_vars_merged( + dataset_add = ds_ext, + filter_add = DSDECOD == "RANDOMIZED", + by_vars = vars(STUDYID, USUBJID), + new_vars = vars(RANDDT = DSSTDT) + ) +``` + +This call would return the input dataframe with the variable `RANDDT` added. + +Now, an example to add first treatment datetime (`ADSL.TRTSDT`), where we +need to make use of `derive_vars_merged()` with the `mode` and `order` arguments +to select the required observations from the additional dataframe. Note: the +`filter_add` argument here shows a possible method for checking only for valid doses. + +```{r eval=TRUE} +# Convert exposure start date to numeric date without imputation +ex_ext <- derive_vars_dt( + dataset = ex, + dtc = EXSTDTC, + new_vars_prefix = "EXST" +) + +# Determine first exposure datetime and add to ADSL +adsl_03 <- adsl_02 %>% + derive_vars_merged( + dataset_add = ex_ext, + filter_add = (EXDOSE > 0 | (EXDOSE == 0 & str_detect(EXTRT, "PLACEBO"))) & !is.na(EXSTDT), + new_vars = vars(TRTSDT = EXSTDT), + order = vars(EXSTDT, EXSEQ), + mode = "first", + by_vars = vars(STUDYID, USUBJID) + ) +``` + +This call would return the input dataframe with `TRTSDT` added. + +Beyond `derive_vars_merged()`, other "merged" functions offer specific common +analysis needs. For example, below shows an example of using `derive_var_merged_exist_flag()` +for adding safety population flag (`ADSL.SAFFL`). + +In this case we create a new flag variable (`new_var` argument) based on information we +take from the additional dataframe to tell us if a certain `condition` is met. +For all by groups (`by_vars` argument) where the check evaluates as `TRUE` at least +once the flag is set to `"Y"` (or whatever user passes in `true_value` argument). + +Note: we have extra arguments available here for patients that do not meet the `condition`. +In the below example, we set patients in `EX` with no valid dose to `"N"` (`false_value`) +and the same for patients with no observations at all in `EX` (`missing_value`). + +```{r eval=TRUE} +# Add safety population flag to ADSL +adsl_04 <- adsl_03 %>% + derive_var_merged_exist_flag( + dataset_add = ex, + by_vars = vars(STUDYID, USUBJID), + new_var = SAFFL, + condition = (EXDOSE > 0 | (EXDOSE == 0 & str_detect(EXTRT, "PLACEBO"))), + false_value = "N", + missing_value = "N" + ) +``` + +Here's how all these above derived variables then look in the dataset. + +```{r, eval=TRUE, echo=FALSE} +dataset_vignette( + dataset = adsl_04, + display_vars = vars(USUBJID, RANDDT, TRTSDT, SAFFL) +) +``` + +Some further examples of "merged" functions are `derive_vars_merged_lookup()` to +join a user-defined lookup table as commonly used in BDS ADaMs, +`derive_var_merged_cat()` to create a categorization variable from the +information joined from the additional dataframe, or +`derive_var_merged_summary()` to merge summarized values from the additional +dataframe. + +# _joined_ functions {#joined} + +## Description + +For any "joined" function remember from above that the main difference is that +given the additional option to filter after the join, it means that selection of +the observations to add from the additional dataframe can depend on variables from +both this and the original dataframe. + +So, as with the "merged" functions the additional dataframe can first be filtered +based on a user-defined condition passed into the `filter_add` argument. Then it +is joined with the input dataframe by user-specified variables passed into `by_vars` +argument. The joined dataframe can then be further restricted by the `filter_join` +condition, before optionally selecting the first or last observation for each by +group (`order` and `mode` arguments). Finally the joined variables from the additional +dataframe can be renamed (`new_vars` argument). + +To illustrate this, imagine that in the above randomization date example you only +wanted the date populated for patients randomized within 30 days of first treatment. +You would now need to check both the additional `DS` and the original `ADSL` dataframes, +so this would not be possible in one step using the "merged" functions. + +## Examples + +The above mentioned randomization date variable (let's call it `RAND30DT` here) +would use `derive_vars_joined()` as follows. + +```{r eval=TRUE} +# Join randomization date to ADSL only for safety population patients +adsl_05 <- adsl_04 %>% + derive_vars_joined( + dataset_add = ds_ext, + filter_add = DSDECOD == "RANDOMIZED", + by_vars = vars(STUDYID, USUBJID), + new_vars = vars(RAND30DT = DSSTDT), + filter_join = DSSTDT >= TRTSDT - 30 + ) +``` + +```{r, eval=TRUE, echo=FALSE} +dataset_vignette( + dataset = adsl_05, + display_vars = vars(USUBJID, RANDDT, TRTSDT, RAND30DT) +) +``` + +Now, let's consider another example of `derive_vars_joined()`. For this we'll need to +additionally use the `join_vars` argument, which is where the user needs to call out +any variables from the additional dataframe being used in `filter_join`. Note: If a +specified variable exists in both dataframes, then the suffix ".join" is added to the +variable from the additional dataframe. + +In this case we want to add a datacut flag to `AE`, only for events occurring up +to and including this day. So in this case `AE` is the original dataframe and the +datacut source is the additional dataframe that needs to be joined. + +```{r eval=TRUE} +# Create a unique datacut day for each patient +datacut <- tribble( + ~USUBJID, ~DCUTDY, ~DCUTFL, + "01-701-1047", 25, "Y", + "01-701-1111", 5, "Y" +) + +# Join datacut flag to AE only for events up to and including this date +ae_01 <- ae %>% + derive_vars_joined( + dataset_add = datacut, + by_vars = vars(USUBJID), + new_vars = vars(DCUTFL), + join_vars = vars(DCUTDY), + filter_join = AESTDY <= DCUTDY + ) +``` + +```{r, eval=TRUE, echo=FALSE} +ae_01 %>% + select(USUBJID, AEDECOD, AESTDY, DCUTFL) %>% + arrange(USUBJID, AESTDY) %>% + dataset_vignette(display_vars = vars(USUBJID, AEDECOD, AESTDY, DCUTFL)) +``` + +The `derive_vars_joined()` function could also be used to join the original dataframe +back with itself, which may be necessary if you're comparing across different observations. +For example, the below shows how a "nadir" calculation would be achieved which checks +for the worst value prior up to that observation. + +Here is how you would derive the highest severity AE the patient has occurred +post-baseline up to and excluding the current AE day. + +```{r eval=TRUE} +# Add a numeric version of severity for sorting with severe=1, moderate=2, mild=3 +ae_ext <- ae_01 %>% + mutate(TEMP_SEVN = as.integer(factor(AESEV, levels = c("SEVERE", "MODERATE", "MILD")))) + +# Derive nadir severity (AENADSEV) +ae_02 <- ae_ext %>% + derive_vars_joined( + dataset_add = ae_ext, + filter_add = AESTDY > 0, + by_vars = vars(USUBJID), + order = vars(TEMP_SEVN), + new_vars = vars(AENADSEV = AESEV), + join_vars = vars(AESTDY), + filter_join = AESTDY.join < AESTDY, + mode = "first", + check_type = "none" + ) +``` + +```{r, eval=TRUE, echo=FALSE} +ae_02 %>% + select(USUBJID, AEDECOD, AESTDY, AESEV, AENADSEV) %>% + arrange(USUBJID, AESTDY) %>% + dataset_vignette(display_vars = vars(USUBJID, AEDECOD, AESTDY, AESEV, AENADSEV)) +``` + +There exists a further function `derive_var_confirmation_flag()`, which follows +a similar principle to the "joined" set as explained here. This can be used for whenever +one set of observations "confirms" another set in a dataframe, i.e. the flag is only +set for your observation if both the observation and some other observation meet both +the user-specified criteria. + +# _extreme_ functions {#extreme} + +## Description + +The "extreme" functions are used for finding the first or last observation +(from `order` and `mode` arguments) within each by group (`by_vars` argument). + +These can then be output as a flag variable, a date, or as new records dependent +on which respective function is used between `derive_var_extreme_flag()`, +`derive_var_extreme_dt()` or `derive_extreme_records()` for example. + +## Example + +Building on the above case, let's use `derive_var_extreme_flag()` to now flag +the earliest observation with the highest severity per patient. + +```{r eval=TRUE} +# Highest severity flag (AEHSEVFL) +ae_03 <- ae_02 %>% + derive_var_extreme_flag( + new_var = AEHSEVFL, + by_vars = vars(USUBJID), + order = vars(TEMP_SEVN, AESTDY, AESEQ), + mode = "first" + ) +``` + +```{r, eval=TRUE, echo=FALSE} +ae_03 %>% + select(USUBJID, AESTDY, AESEQ, AESEV, AEHSEVFL) %>% + arrange(USUBJID, AESTDY, AESEQ) %>% + dataset_vignette(display_vars = vars(USUBJID, AESTDY, AESEQ, AESEV, AEHSEVFL)) +``` + +Common further examples of usage of this set of functions could be using +`derive_var_extreme_dt()` for last known alive date calculation or `derive_extreme_records()` +for creating derived minimum or maximum value records. diff --git a/vignettes/higher_order.Rmd b/vignettes/higher_order.Rmd index 740eb500d8..bf07477e94 100644 --- a/vignettes/higher_order.Rmd +++ b/vignettes/higher_order.Rmd @@ -44,7 +44,7 @@ in `{admiral}`---and the SDTM datasets from `{admiral.test}` are used. ```{r, warning=FALSE, message=FALSE} library(admiral) library(admiral.test) -library(dplyr) +library(dplyr, warn.conflicts = FALSE) data("admiral_adsl") data("admiral_ae") diff --git a/vignettes/imputation.Rmd b/vignettes/imputation.Rmd index 13a3fabbec..9977290c48 100644 --- a/vignettes/imputation.Rmd +++ b/vignettes/imputation.Rmd @@ -42,7 +42,7 @@ The examples of this vignette require the following packages. library(admiral) library(lubridate) library(tibble) -library(dplyr) +library(dplyr, warn.conflicts = FALSE) ``` # Imputation Rules diff --git a/vignettes/lab_grading.Rmd b/vignettes/lab_grading.Rmd index 9daf542dc5..f7cf29eace 100644 --- a/vignettes/lab_grading.Rmd +++ b/vignettes/lab_grading.Rmd @@ -26,9 +26,9 @@ Within the ADLB ADaM data set there is a concept of lab grading, where there is a set of criteria for particular lab tests that grade the severity or abnormality of a lab value. The grades are from 0 to 4, where grade 0 can be viewed generally as a “NORMAL” value. The higher the grade the more severe or more abnormal the lab value is. -There are several sets of lab grading criteria, for the initial implementation of lab -grading we will look at NCI-CTCAEv4. (In future releases `{admiral}` look to implement -further grading criteria, for example NCI-CTCAEv5) +There are several sets of lab grading criteria, currently `{admiral}` has implemented +NCI-CTCAEv4 and NCI-CTCAEv5 grading criteria. In future releases `{admiral}` may look +to implement further grading criteria. The NCI-CTCAE version 4 and 5 grading criteria can be found here: https://ctep.cancer.gov/protocoldevelopment/electronic_applications/ctc.htm . @@ -36,6 +36,8 @@ here: https://ctep.cancer.gov/protocoldevelopment/electronic_applications/ctc.ht The NCI-CTCAEv4 criteria can be found under the heading [**Common Terminology Criteria for Adverse Events (CTCAE)v4.0**](https://ctep.cancer.gov/protocoldevelopment/electronic_applications/ctc.htm#ctc_40) +The NCI-CTCAEv5 criteria can be found under the heading +[**Common Terminology Criteria for Adverse Events (CTCAE)v5.0**](https://ctep.cancer.gov/protocoldevelopment/electronic_applications/ctc.htm#ctc_50) # Grading metadata @@ -76,7 +78,7 @@ Variable | Scope | Type | Example Value ```{r message=FALSE} library(admiral) library(admiral.test) -library(dplyr) +library(dplyr, warn.conflicts = FALSE) library(stringr) library(tibble) @@ -104,6 +106,21 @@ atoxgr_criteria_ctcv4 %>% ) ```
+ +
+Likewise, the list of terms defined in the `{admiral}` metadata to implement NCI-CTCAEv5 is below: +(Terms identical to NCI-CTCAEv4, except `Hyperglycemia`, `Hyperglycemia (Fasting)` and `Hypophosphatemia`) +which are not present in NCI-CTCAEv5. +
+ +```{r, eval=TRUE, echo=FALSE} +atoxgr_criteria_ctcv5 %>% + filter(!is.na(TERM)) %>% + dataset_vignette( + display_vars = vars(TERM) + ) +``` +
Using CDISC data these lab tests can be mapped to the correct terms, firstly create `PARAMCD`, `PARAM`, `AVAL`, `ANRLO` and `ANRHI`, also some lab grading criteria require `BASE` and `PCHG`, so these would also need to be created before running `derive_var_atoxgr_dir()` @@ -223,19 +240,24 @@ adlb <- adlb %>% ``` It is now straightforward to create the grade, for low lab values the grade will -be held in `ATOXGRL` and for high lab values the grade will be held in `ATOXGRH` +be held in `ATOXGRL` and for high lab values the grade will be held in `ATOXGRH`. + +Note: for NCICTCAEv5 grading, you would update `meta_criteria` parameter to +`atoxgr_criteria_ctcv5`. ```{r, eval=TRUE} adlb <- adlb %>% derive_var_atoxgr_dir( new_var = ATOXGRL, tox_description_var = ATOXDSCL, + meta_criteria = atoxgr_criteria_ctcv4, criteria_direction = "L", get_unit_expr = extract_unit(PARAM) ) %>% derive_var_atoxgr_dir( new_var = ATOXGRH, tox_description_var = ATOXDSCH, + meta_criteria = atoxgr_criteria_ctcv4, criteria_direction = "H", get_unit_expr = extract_unit(PARAM) ) @@ -243,8 +265,8 @@ adlb <- adlb %>% Note: `{admiral}` does not grade 'Anemia' or 'Hemoglobin Increased' because the metadata is based on the SI unit of 'g/L', however the CDISC data has SI unit of 'mmol/L'. -Please see `SI_UNIT_CHECK` variable in `{admiral}` metadata `atoxgr_criteria_ctcv4`, the metadata -is in the data folder of `{admiral}`. +Please see `SI_UNIT_CHECK` variable in `{admiral}` metadata `atoxgr_criteria_ctcv4` or +`atoxgr_criteria_ctcv5`, the metadata is in the data folder of `{admiral}`.
```{r, eval=TRUE, echo=FALSE} @@ -276,7 +298,7 @@ adlb %>% ``` -# NCI-CTCAEV4 implementation +# NCI-CTCAEV4 implementation{#implement_ctcv4} ## Terms graded @@ -398,7 +420,7 @@ put in the `COMMENT` field.
```{r, eval=TRUE, echo=FALSE} atoxgr_criteria_ctcv4 %>% - filter(str_detect(TERM, "Hypouricemia")) %>% + filter(str_detect(TERM, "Hyperuricemia")) %>% dataset_vignette( display_vars = vars(TERM, Grade_1, Grade_3, COMMENT) ) @@ -419,9 +441,170 @@ atoxgr_criteria_ctcv4 %>% ```
+# NCI-CTCAEV5 implementation {#implement_ctcv5} + +## Terms graded + +Grading is implemented for those lab tests where a lab value is included in the grading definition, +`{admiral}` does NOT try to read any other data to determine the grade, and only the ADLB VAD is used. +The following CTCAE v5.0 SOC values were identified for grading, these are “Investigations", +“Metabolism and nutrition disorders” and “Blood and lymphatic system disorders”. + +From these SOC values the following terms criteria is implemented in `{admiral}` + +From SOC = “Investigations" there are 21 CTCAE v5.0 Terms: + + + Activated partial thromboplastin time prolonged + + Alanine aminotransferase increased + + Alkaline phosphatase increased + + Aspartate aminotransferase increased + + Blood bilirubin increased + + CD4 lymphocytes decreased + + Cholesterol high + + CPK increased + + Creatinine increased + + Fibrinogen decreased + + GGT increased + + Haptoglobin decreased + + Hemoglobin increased + + INR increased + + Lipase increased + + Lymphocyte count decreased + + Lymphocyte count increased + + Neutrophil count decreased + + Platelet count decreased + + Serum amylase increased + + White blood cell decreased + +Note: These are the same terms identified for NCI-CTCAEv4. + +From the SOC = “Metabolism and nutrition disorders” there are 12 CTCAE v4.0 Terms: + + + Hypercalcemia + + Hyperkalemia + + Hypermagnesemia + + Hypernatremia + + Hypertriglyceridemia + + Hyperuricemia + + Hypoalbuminemia + + Hypocalcemia + + Hypoglycemia + + Hypokalemia + + Hypomagnesemia + + Hyponatremia + +Note: These are the same terms identified for NCI-CTCAEv4, except "Hypophosphatemia" +and "Hyperglycemia" which are not in NCICTCAEv5 grading criteria. + +From the SOC = “Blood and lymphatic system disorders” there are 2 CTCAE v4.0 Terms: + + + Anemia + + Leukocytosis + +Note: These are the same terms identified for NCI-CTCAEv4. + +## Updates made to TERM + +For terms "Hypocalcemia" and "Hypercalcemia" the criteria is provided for Calcium and Ionized Calcium, +therefore `{admiral}` created a row for each in the metadata, this is noted in the COMMENT variable of +the metadata: +
+ +```{r, eval=TRUE, echo=FALSE} +atoxgr_criteria_ctcv5 %>% + filter(str_detect(TERM, "calcemia")) %>% + dataset_vignette( + display_vars = vars(TERM, COMMENT) + ) +``` +
+ +## Assumptions made when grading + +For term "INR Increased" there is the following criteria: + +
+```{r, eval=TRUE, echo=FALSE} + +atoxgr_criteria_ctcv5 %>% + filter(str_detect(TERM, "INR")) %>% + dataset_vignette( + display_vars = vars(TERM, Grade_1) + ) +``` +
+ +`{admiral}` assumed worst case and used both parts of the criteria for grading, so comparing +lab value against ULN and also BASE. The decision made was put in the `COMMENT` field. + +
+```{r, eval=TRUE, echo=FALSE} +atoxgr_criteria_ctcv5 %>% + filter(str_detect(TERM, "INR")) %>% + dataset_vignette( + display_vars = vars(TERM, COMMENT) + ) +``` +
+Similarly, for terms "Lipase Increased" and "Serum amylase increased" there is the following criteria: + +
+```{r, eval=TRUE, echo=FALSE} + +atoxgr_criteria_ctcv5 %>% + filter(str_detect(TERM, "INR") | str_detect(TERM, "amylase")) %>% + dataset_vignette( + display_vars = vars(TERM, Grade_2, Grade_3, Grade_4) + ) +``` +
+ +`{admiral}` assumed worst case and implemented highest grade possible. +The decision made was put in the `COMMENT` field. + +
+```{r, eval=TRUE, echo=FALSE} +atoxgr_criteria_ctcv5 %>% + filter(str_detect(TERM, "INR") | str_detect(TERM, "amylase")) %>% + dataset_vignette( + display_vars = vars(TERM, COMMENT) + ) +``` +
+ +For TERM "Hyperuricemia", the criteria for Grade 1 and Grade 3 is the same with respect +to the lab value, so worse case is assumed as grade 3. The decision made was +put in the `COMMENT` field. + +
+```{r, eval=TRUE, echo=FALSE} +atoxgr_criteria_ctcv5 %>% + filter(str_detect(TERM, "Hyperuricemia")) %>% + dataset_vignette( + display_vars = vars(TERM, Grade_1, Grade_3, COMMENT) + ) +``` +
+ +A similar approach was taken for TERM "Hypokalemia" and "Hyponatremia". For "Hypokalemia", +where Grade 1 and Grade 2 criteria is the same with respect to the lab value, then worse case +is assumed as grade 2. For "Hyponatremia", where Grade 2 and Grade 2 criteria is the same with +respect to the lab value, then worse case is assumed as grade 3. +The decision made was put in the `COMMENT` field. + +
+```{r, eval=TRUE, echo=FALSE} +atoxgr_criteria_ctcv5 %>% + filter(str_detect(TERM, "Hypokalemia") | str_detect(TERM, "Hyponatremia")) %>% + dataset_vignette( + display_vars = vars(TERM, Grade_1, Grade_2, Grade_3, COMMENT) + ) +``` +
+ # Conclusion -In future releases `{admiral}` will implement further grading criteria, with NCI-CTCAE v5 -being the priority. Providing tools for users to easily interact with the metadata to -update criteria, based on their companies needs will also be looked at. Ideally, users should -be able to create their own metadata for company specific grading schemes. +With NCI-CTCAEv4 and NCI-CTCAEv5 now implemented, {admiral} may look to implement other +industry standard grading criteria. Providing tools for users to easily interact with +the metadata to update criteria, based on their companies needs will also be looked at. +Ideally, users should be able to create their own metadata for company specific grading schemes. diff --git a/vignettes/occds.Rmd b/vignettes/occds.Rmd index be502f3b55..72fcb79da9 100644 --- a/vignettes/occds.Rmd +++ b/vignettes/occds.Rmd @@ -41,6 +41,7 @@ otherwise specified.* * [Derive Query Variables](#query) * [Add ADSL variables](#adsl_vars) * [Derive Analysis Sequence Number](#aseq) +* [Add Labels and Attributes](#attributes) ## Read in Data {#readdata} @@ -53,7 +54,7 @@ included in `{admiral.test}`--- are used. ```{r, message=FALSE, warning=FALSE} library(admiral) -library(dplyr) +library(dplyr, warn.conflicts = FALSE) library(admiral.test) library(lubridate) @@ -65,7 +66,6 @@ adsl <- admiral_adsl ``` ```{r echo = FALSE} ae <- filter(ae, USUBJID %in% c("01-701-1015", "01-701-1023", "01-703-1086", "01-703-1096", "01-707-1037", "01-716-1024")) - ``` At this step, it may be useful to join `ADSL` to your `AE` domain as well. Only the @@ -208,12 +208,11 @@ derive_vars_atc(cm, facm) ## Derive Planned and Actual Treatment {#trtpa} -`TRTA` and `TRTP` must correlate to treatment `TRTxxP` and/or `TRTxxA` in ADSL. -The derivation of `TRTA` and `TRTP` for a record are protocol and analysis -specific. `{admiral}`does not currently have functionality to assist with `TRTA` -and `TRTP` assignment. +`TRTA` and `TRTP` must match at least one value of the character treatment +variables in ADSL (e.g., `TRTxxA`/`TRTxxP`, `TRTSEQA`/`TRTSEQP`, +`TRxxAGy`/`TRxxPGy`). -However, an example of a simple implementation could be: +An example of a simple implementation for a study without periods could be: ```{r eval=TRUE} adae <- mutate(adae, TRTP = TRT01P, TRTA = TRT01A) @@ -221,7 +220,8 @@ adae <- mutate(adae, TRTP = TRT01P, TRTA = TRT01A) count(adae, TRTP, TRTA, TRT01P, TRT01A) ``` - +For studies with periods see the ["Visit and Period Variables" +vignette](visits_periods.html#treatment_bds). ## Derive Date/Date-time of Last Dose {#last_dose} @@ -278,13 +278,16 @@ adae <- adae %>% ## Derive Treatment Emergent Flag {#trtflag} -To derive the treatment emergent flag `TRTEMFL`, one can use a simple -`dplyr::mutate()` assignment. In the example below, we use 30 days in the flag derivation. +To derive the treatment emergent flag `TRTEMFL`, one can call +`derive_var_trtemfl()`. In the example below, we use 30 days in the flag +derivation. ```{r eval=TRUE} adae <- adae %>% - mutate( - TRTEMFL = ifelse(ASTDT >= TRTSDT & ASTDT <= TRTEDT + days(30), "Y", NA_character_) + derive_var_trtemfl( + trt_start_date = TRTSDT, + trt_end_date = TRTEDT, + end_window = 30 ) ``` @@ -301,7 +304,8 @@ dataset_vignette( To derive on-treatment flag (`ONTRTFL`) in an ADaM dataset with a single occurrence date, we use `derive_var_ontrtfl()`. -The expected result is the input dataset with an additional column named `ONTRTFL` with a value of `"Y"` or `NA`. +The expected result is the input dataset with an additional column named +`ONTRTFL` with a value of `"Y"` or `NA`. If you want to also check an end date, you could add the `end_date` argument. Note that in this scenario you could set `span_period = "Y"` if you want occurrences that started @@ -525,6 +529,28 @@ adcm_aseq <- adcm %>% dataset_vignette(adcm_aseq) ``` +## Add Labels and Attributes {#attributes} + +Adding labels and attributes for SAS transport files is supported by the +following packages: + +- [metacore](https://atorus-research.github.io/metacore/): establish a common +foundation for the use of metadata within an R session. + +- [metatools](https://pharmaverse.github.io/metatools/): enable the use of +metacore objects. Metatools can be used to build datasets or enhance columns in +existing datasets as well as checking datasets against the metadata. + +- [xportr](https://atorus-research.github.io/xportr/): functionality to +associate all metadata information to a local R data frame, perform data set +level validation checks and convert into a [transport v5 +file(xpt)](https://documentation.sas.com/doc/en/pgmsascdc/9.4_3.5/movefile/n1xbwdre0giahfn11c99yjkpi2yb.htm). + +NOTE: All these packages are in the experimental phase, but the vision is to +have them associated with an End to End pipeline under the umbrella of the +[pharmaverse](https://github.com/pharmaverse). An example of applying metadata +and perform associated checks can be found at the [pharmaverse E2E example](https://examples.pharmaverse.org/data/adsl/). + # Example Scripts ADaM | Sample Code diff --git a/vignettes/queries_dataset.Rmd b/vignettes/queries_dataset.Rmd index f1af94400a..f52a5668aa 100644 --- a/vignettes/queries_dataset.Rmd +++ b/vignettes/queries_dataset.Rmd @@ -46,17 +46,22 @@ This vignette describes the expected structure and content of the dataset passed Variable | Scope | Type | Example Value ------- | ----- | ------ | ----- -**VAR_PREFIX** | The prefix used to define the grouping variables | Character | "SMQ01" -**QUERY_NAME** | The value provided to the grouping variables name| Character | "Immune-Mediated Guillain-Barre Syndrome" -**TERM_LEVEL** | The variable used to define the grouping. Used in conjunction with TERM_NAME | Character | "AEDECOD" -**TERM_NAME** | A term used to define the grouping. Used in conjunction with TERM_LEVEL | Character | "GUILLAIN-BARRE SYNDROME" -**TERM_ID** | A code used to define the grouping. Used in conjunction with TERM_LEVEL | Integer | 10018767 -QUERY_ID | Id number of the query. This could be a SMQ identifier | Integer | 20000131 -QUERY_SCOPE | For SMQs, scope (Broad/Narrow) of the query | Character | BROAD, NARROW, NA -QUERY_SCOPE_NUM | For SMQs, scope (Broad/Narrow) of the query | Integer | 1, 2, NA +**VAR_PREFIX** | The prefix used to define the grouping variables | Character | `"SMQ01"` +**QUERY_NAME** | The value provided to the grouping variables name| Character | `"Immune-Mediated Guillain-Barre Syndrome"` +**TERM_LEVEL** | The variable used to define the grouping. Used in conjunction with TERM_NAME | Character | `"AEDECOD"` +**TERM_NAME** | A term used to define the grouping. Used in conjunction with TERM_LEVEL | Character | `"GUILLAIN-BARRE SYNDROME"` +**TERM_ID** | A code used to define the grouping. Used in conjunction with TERM_LEVEL | Integer | `10018767` +QUERY_ID | Id number of the query. This could be a SMQ identifier | Integer | `20000131` +QUERY_SCOPE | Scope (Broad/Narrow) of the query | Character | `BROAD`, `NARROW`, `NA` +QUERY_SCOPE_NUM | Scope (Broad/Narrow) of the query | Integer | `1`, `2`, `NA` +VERSION | The version of the dictionary | Character | `"20.1"` **Bold variables** are required in `dataset_queries`: an error is issued if any of these variables is missing. Other variables are optional. +The `VERSION` variable is not used by `derive_vars_query()` but can be used to +check if the dictionary version of the queries dataset and the analysis dataset +are in line. + ## Required Content Each row must be unique within the dataset. diff --git a/vignettes/visits_periods.Rmd b/vignettes/visits_periods.Rmd new file mode 100644 index 0000000000..574d312042 --- /dev/null +++ b/vignettes/visits_periods.Rmd @@ -0,0 +1,272 @@ +--- +title: "Visit and Period Variables" +output: + rmarkdown::html_vignette: +vignette: > + %\VignetteIndexEntry{Visit and Period Variables} + %\VignetteEngine{knitr::rmarkdown} +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +# Introduction + +The derivation of visit variables like `AVISIT`, `AVISITN`, `AWLO`, `AWHI`, ... +or period, subperiod, or phase variables like `APERIOD`, `TRT01A`, `TRT02A`, +`ASPER`, `PHSDTM`, `PHEDTM`, ... is highly study-specific. Therefore admiral +cannot provide functions which derive these variables. However, for common +scenarios like visit assignments based on time windows or deriving BDS period +variables from ADSL period variables, functions are provided which support those +derivations. + +## Required Packages + +The examples of this vignette require the following packages. + +```{r, warning=FALSE, message=FALSE} +library(admiral) +library(tibble) +library(dplyr, warn.conflicts = FALSE) +library(lubridate) +``` + +```{r, echo=FALSE, warning=FALSE, message=FALSE} +library(admiraldev) +``` + +# Visit variables (`AVISIT`, `AVISITN`, `AWLO`, `AWHI`, ...) {#visits} + +The most common ways of deriving `AVISIT` and `AVISITN` are: + +- The variables are set to the collected visits (`VISIT` and `VISITNUM`). +- The variables are set based on time windows. + +The former can be achieved simply by calling `mutate()`, like in the vignettes +and the template scripts. + +For the latter a (study-specific) reference dataset needs to be created which +provides for each visit the start and end day (`AWLO` and `AWHI`) and the values +of other visit related variables (`AVISIT`, `AVISITN`, `AWTARGET`, ...). +```{r} +windows <- tribble( + ~AVISIT, ~AWLO, ~AWHI, ~AVISITN, ~AWTARGET, + "BASELINE", -30, 1, 0, 1, + "WEEK 1", 2, 7, 1, 5, + "WEEK 2", 8, 15, 2, 11, + "WEEK 3", 16, 22, 3, 19, + "WEEK 4", 23, 30, 4, 26 +) +``` +Then the visits can be assigned based on the analysis day (`ADY`) by calling +`derive_vars_joined()`: +```{r} +adbds <- tribble( + ~USUBJID, ~ADY, + "1", -33, + "1", -2, + "1", 3, + "1", 24, + "2", NA, +) + +derive_vars_joined( + adbds, + dataset_add = windows, + filter_join = AWLO <= ADY & ADY <= AWHI +) +``` + +# Period, Subperiod, and Phase Variables + +If periods, subperiods, or phases are used, the corresponding variables have to +be consistent across all datasets. This can be achieved by defining the periods, +subperiods, or phases once and then use this definition for all datasets. The +definition can be stored in ADSL or in a separate dataset. In the following +examples, this separate dataset is called period reference dataset. + +## Period Reference Dataset + +The period reference dataset contains one observation per subject and period, +subperiod, or phase. For example: + +```{r echo=FALSE} +phase_ref <- tribble( + ~USUBJID, ~APHASEN, ~PHSDT, ~PHEDT, ~APHASE, + "1", 1, "2021-01-04", "2021-02-06", "TREATMENT", + "1", 2, "2021-02-07", "2021-03-07", "FUP", + "2", 1, "2021-02-02", "2021-03-02", "TREATMENT" +) %>% + mutate( + STUDYID = "xyz", + APHASEN = as.integer(APHASEN), + across(matches("PH[ES]DT"), ymd) + ) %>% + select(STUDYID, everything()) + +phase_ref +``` + +The admiral functions expect separate datasets for periods, subperiods, and +phases. For periods the numeric variable `APERIOD` is expected, for subperiods +the numeric variables `APERIOD` and `ASPER`, and for phases the numeric variable +`APHASEN`. + +## Creating ADSL Period, Subperiod, or Phase Variables {#periods_adsl} + +If a period reference dataset is available, the ADSL variables for periods, +subperiods, or phases can be created from this dataset by calling +`derive_vars_period()`. + +For example the period reference dataset from the previous section can be used +to add the phase variables (`PHwSDT`, `PHwEDT`, and `APHASEw`) to ADSL: +```{r} +adsl <- tibble(STUDYID = "xyz", USUBJID = c("1", "2")) + +adsl <- derive_vars_period( + adsl, + dataset_ref = phase_ref, + new_vars = vars(PHwSDT = PHSDT, PHwEDT = PHEDT, APHASEw = APHASE) +) %>% + select(STUDYID, USUBJID, PH1SDT, PH1EDT, PH2SDT, PH2EDT, APHASE1, APHASE2) + +adsl +``` + +## Creating BDS and OCCDS Period, Subperiod, or Phase Variables {#periods_bds} + +If a period reference dataset is available, BDS and OCCDS variables for periods, +subperiods, or phases can be created by calling `derive_vars_joined()`. + +For example the variables `APHASEN`, `PHSDT`, `PHEDT`, `APHASE` can be derived +from the period reference dataset defined above. + +```{r} +adae <- tribble( + ~USUBJID, ~ASTDT, + "1", "2021-01-01", + "1", "2021-01-05", + "1", "2021-02-05", + "1", "2021-03-05", + "1", "2021-04-05", + "2", "2021-02-15", +) %>% + mutate(ASTDT = ymd(ASTDT)) + +derive_vars_joined( + adae, + dataset_add = phase_ref, + by_vars = vars(USUBJID), + filter_join = PHSDT <= ASTDT & ASTDT <= PHEDT +) +``` + +If no period reference dataset is available but period variables are in ADSL, +the period reference dataset can be created from ADSL by calling +`create_period_dataset()`. + +For example, a period reference dataset for phases can be created from the ADSL +dataset created above: +```{r} +create_period_dataset( + adsl, + new_vars = vars(PHSDT = PHwSDT, PHEDT = PHwEDT, APHASE = APHASEw) +) +``` + +# Treatment Variables (`TRTxxP`, `TRTxxA`, `TRTP`, `TRTA`, ...) + +In studies with multiple periods the treatment can differ by period, e.g. for a +crossover trial. CDISC defines variables for planned and actual treatments in +ADSL (`TRTxxP`, `TRTxxA`, `TRxxPGy`, `TRxxAGy`, ...) and corresponding variables +in BDS and OCCDS datasets (`TRTP`, `TRTA`, `TRTPGy`, `TRTAGy`, ...). They can be +derived in the same way (and same step) as the period, subperiod, and phase +variables. + +## Creating ADSL Treatment Variables {#treatment_adsl} + +If the treatment information is included in the period reference dataset, the +treatment ADSL variables can be created by calling `derive_vars_period()`: + +```{r} +# Add period variables to ADSL +period_ref <- tribble( + ~USUBJID, ~APERIOD, ~APERSDT, ~APEREDT, ~TRTA, + "1", 1, "2021-01-04", "2021-02-06", "DRUG A", + "1", 2, "2021-02-07", "2021-03-07", "DRUG B", + "2", 1, "2021-02-02", "2021-03-02", "DRUG B", + "2", 2, "2021-03-03", "2021-04-01", "DRUG B" +) %>% + mutate( + STUDYID = "xyz", + APERIOD = as.integer(APERIOD), + across(ends_with("DT"), ymd) + ) + +adsl <- derive_vars_period( + adsl, + dataset_ref = period_ref, + new_vars = vars( + APxxSDT = APERSDT, + APxxEDT = APEREDT, + TRTxxA = TRTA + ) +) %>% + select( + STUDYID, USUBJID, + TRT01A, TRT02A, + AP01SDT, AP01EDT, AP02SDT, AP02EDT + ) + +adsl +``` + +## Creating BDS and OCCDS Treatment Variables {#treatment_bds} + +If a period reference dataset is available, BDS and OCCDS variables for +treatment can be created by calling `derive_vars_joined()`. + +For example the variables `APERIOD` and `TRTA` can be derived from the period +reference dataset defined above. + +```{r} +adae <- tribble( + ~USUBJID, ~ASTDT, + "1", "2021-01-05", + "1", "2021-02-05", + "1", "2021-03-05", + "1", "2021-04-05", + "2", "2021-02-15", + "2", "2021-03-10", +) %>% + mutate( + ASTDT = ymd(ASTDT), + STUDYID = "xyz" + ) + +derive_vars_joined( + adae, + dataset_add = period_ref, + by_vars = vars(STUDYID, USUBJID), + new_vars = vars(APERIOD, TRTA), + join_vars = vars(APERSDT, APEREDT), + filter_join = APERSDT <= ASTDT & ASTDT <= APEREDT +) +``` + +If no period reference dataset is available but period variables are in ADSL, +the period reference dataset can be created from ADSL by calling +`create_period_dataset()`. + +For example, a period reference dataset for periods and treatments can be +created from the ADSL dataset created above: +```{r} +create_period_dataset( + adsl, + new_vars = vars(APERSDT = APxxSDT, APEREDT = APxxEDT, TRTA = TRTxxA) +) +```