diff --git a/.Rprofile b/.Rprofile index 7b58783ae0..77ae067e30 100644 --- a/.Rprofile +++ b/.Rprofile @@ -1,4 +1,14 @@ -if (Sys.getenv("GITHUB_ACTIONS") == "") { +# Set renv profile base on R version. +if ((Sys.getenv("GITHUB_ACTIONS") == "") && (Sys.getenv("DOCKER_CONTAINER_CONTEXT") == "")) { + renv_profile <- paste(R.version$major, substr(R.version$minor, 1, 1), sep = ".") + if (file.exists("./renv/profile")) { + message("Using renv profile from `renv/profile` file.") + } else if (renv_profile %in% c("4.1", "4.2", "4.3")) { + message("Set renv profile to `", renv_profile, "`") + Sys.setenv("RENV_PROFILE" = renv_profile) + } else { + message("This repository do not contains the renv profile for your R version.") + } source("renv/activate.R") } else { options(repos = c(CRAN = "https://cran.rstudio.com")) diff --git a/.github/pull_request_template.md b/.github/pull_request_template.md index 62d689a480..70de46c879 100644 --- a/.github/pull_request_template.md +++ b/.github/pull_request_template.md @@ -14,5 +14,5 @@ Please check off each taskbox as an acknowledgment that you completed the task o - [ ] Address or fix all lintr warnings and errors - `lintr::lint_package()` - [ ] Run `R CMD check` locally and address all errors and warnings - `devtools::check()` - [ ] Link the issue in the Development Section on the right hand side. -- [ ] Address all merge conflicts and resolve appropriately +- [ ] Address all merge conflicts and resolve appropriately - [ ] Pat yourself on the back for a job well done! Much love to your accomplishment! diff --git a/.github/workflows/common.yml b/.github/workflows/common.yml index f5c55ca20f..9b932f84fe 100644 --- a/.github/workflows/common.yml +++ b/.github/workflows/common.yml @@ -43,25 +43,25 @@ jobs: uses: pharmaverse/admiralci/.github/workflows/style.yml@main if: github.event_name == 'pull_request' with: - r-version: "4.0" + r-version: "4.1" spellcheck: name: Spelling uses: pharmaverse/admiralci/.github/workflows/spellcheck.yml@main if: github.event_name == 'pull_request' with: - r-version: "4.0" + r-version: "4.1" readme: name: Render README uses: pharmaverse/admiralci/.github/workflows/readme-render.yml@main if: github.event_name == 'push' with: - r-version: "4.0" + r-version: "4.1" validation: name: Validation uses: pharmaverse/admiralci/.github/workflows/r-pkg-validation.yml@main if: github.event_name == 'release' with: - r-version: "4.0" + r-version: "4.1" check: name: Check uses: pharmaverse/admiralci/.github/workflows/r-cmd-check.yml@main @@ -71,7 +71,7 @@ jobs: uses: pharmaverse/admiralci/.github/workflows/pkgdown.yml@main if: github.event_name == 'push' || startsWith(github.ref, 'refs/tags/v') with: - r-version: "4.0" + r-version: "4.1" # 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 +85,7 @@ jobs: uses: pharmaverse/admiralci/.github/workflows/lintr.yml@main if: github.event_name == 'pull_request' with: - r-version: "4.0" + r-version: "4.1" links: name: Links uses: pharmaverse/admiralci/.github/workflows/links.yml@main @@ -96,7 +96,7 @@ jobs: if: > github.event_name != 'release' with: - r-version: "4.0" + r-version: "4.1" # Whether to skip code coverage badge creation # Setting to 'false' will require you to create # an orphan branch called 'badges' in your repository @@ -106,4 +106,4 @@ jobs: uses: pharmaverse/admiralci/.github/workflows/man-pages.yml@main if: github.event_name == 'pull_request' with: - r-version: "4.0" + r-version: "4.1" diff --git a/.github/workflows/templates.yml b/.github/workflows/templates.yml index 08d4adf39a..9abed5e849 100644 --- a/.github/workflows/templates.yml +++ b/.github/workflows/templates.yml @@ -12,4 +12,4 @@ jobs: uses: pharmaverse/admiralci/.github/workflows/check-templates.yml@main if: github.event.review.state == 'approved' with: - r-version: "4.0" + r-version: "4.1" diff --git a/.lintr b/.lintr index 5c286fe859..ce36cfd87d 100644 --- a/.lintr +++ b/.lintr @@ -1,2 +1,12 @@ -linters: with_defaults(line_length_linter(100), object_usage_linter=NULL, cyclocomp_linter(complexity_limit = 20)) -exclusions: list("R/data.R") +linters: linters_with_defaults( + line_length_linter(100), + object_usage_linter=NULL, + cyclocomp_linter(complexity_limit = 22), + undesirable_function_linter = undesirable_function_linter() + ) +exclusions: list( + "R/data.R" = Inf, + "inst" = list(undesirable_function_linter = Inf), + "vignettes" = list(undesirable_function_linter = Inf), + "R/admiral_options.R" = list(line_length_linter = 8) + ) diff --git a/DESCRIPTION b/DESCRIPTION index 45a7ac4bdb..3ca21f89e6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: admiral Type: Package Title: ADaM in R Asset Library -Version: 0.10.2 +Version: 0.11.0 Authors@R: c( person("Ben", "Straub", email = "ben.x.straub@gsk.com", role = c("aut", "cre")), person("Stefan", "Bundfuss", role = "aut"), @@ -32,6 +32,8 @@ Authors@R: c( person("Kangjie", "Zhang", role = "aut"), person("Daphne", "Grasselly", role = "aut"), person("Adam", "Forys", role = "aut"), + person("Edoardo", "Mancini", role = "aut"), + person("Stefan", "Thoma", role = "aut"), person("Michael", "Thorpe", role = "ctb"), person("Declan", "Hodges", role = "ctb"), person("Jaxon", "Abercrombie", role = "ctb"), @@ -69,14 +71,15 @@ Description: A toolbox for programming Clinical Data Interchange Standards Conso (CDISC Analysis Data Model Team, 2021, ). Language: en-US License: Apache License (>= 2) +BugReports: https://github.com/pharmaverse/admiral/issues URL: https://pharmaverse.github.io/admiral/, https://github.com/pharmaverse/admiral Encoding: UTF-8 LazyData: true Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.1 +RoxygenNote: 7.2.3 Depends: R (>= 3.5) Imports: - admiraldev (>= 0.3.0), + admiraldev (>= 0.4.0), dplyr (>= 0.8.4), hms (>= 0.5.3), lifecycle (>= 0.1.0), @@ -101,7 +104,6 @@ Suggests: rmarkdown, roxygen2, spelling, - styler, testthat (>= 3.0.0), tibble, usethis diff --git a/NAMESPACE b/NAMESPACE index ceda1a1a6e..cc45836698 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -10,6 +10,7 @@ S3method(convert_na_to_blanks,default) S3method(convert_na_to_blanks,list) S3method(format,basket_select) S3method(print,adam_templates) +S3method(print,duplicates) S3method(print,source) export("%>%") export(ae_event) @@ -29,10 +30,12 @@ export(call_derivation) export(call_user_fun) export(censor_source) export(chr2vars) +export(compute_age_years) export(compute_bmi) export(compute_bsa) export(compute_dtf) export(compute_duration) +export(compute_egfr) export(compute_framingham) export(compute_map) export(compute_qtc) @@ -55,7 +58,7 @@ export(date_source) export(death_event) export(default_qtc_paramcd) export(derivation_slice) -export(derive_derived_param) +export(derive_basetype_records) export(derive_expected_records) export(derive_extreme_event) export(derive_extreme_records) @@ -67,7 +70,7 @@ 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_extreme_record) export(derive_param_framingham) export(derive_param_map) export(derive_param_qtc) @@ -76,8 +79,6 @@ export(derive_param_tte) export(derive_param_wbc_abs) export(derive_summary_records) export(derive_var_age_years) -export(derive_var_agegr_ema) -export(derive_var_agegr_fda) export(derive_var_analysis_ratio) export(derive_var_anrind) export(derive_var_atoxgr) @@ -119,8 +120,6 @@ 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) @@ -134,10 +133,11 @@ export(exprs) export(extend_source_datasets) export(extract_duplicate_records) export(extract_unit) -export(filter_confirmation) export(filter_date_sources) +export(filter_exist) export(filter_extreme) export(filter_joined) +export(filter_not_exist) export(filter_relative) export(format_eoxxstt_default) export(format_reason_default) @@ -158,6 +158,7 @@ export(negate_vars) export(params) export(print_named_list) export(query) +export(records_source) export(restrict_derivation) export(set_admiral_options) export(signal_duplicate_records) @@ -165,7 +166,6 @@ export(slice_derivation) export(use_ad_template) export(validate_basket_select) export(validate_query) -export(vars) export(yn_to_numeric) import(admiraldev) importFrom(dplyr,across) @@ -179,8 +179,10 @@ importFrom(dplyr,distinct) importFrom(dplyr,ends_with) importFrom(dplyr,everything) importFrom(dplyr,filter) +importFrom(dplyr,first) importFrom(dplyr,full_join) importFrom(dplyr,group_by) +importFrom(dplyr,group_by_at) importFrom(dplyr,if_else) importFrom(dplyr,mutate) importFrom(dplyr,n) @@ -195,8 +197,10 @@ importFrom(dplyr,semi_join) importFrom(dplyr,slice) importFrom(dplyr,starts_with) importFrom(dplyr,summarise) +importFrom(dplyr,summarise_all) importFrom(dplyr,tibble) importFrom(dplyr,transmute) +importFrom(dplyr,tribble) importFrom(dplyr,ungroup) importFrom(dplyr,union) importFrom(hms,as_hms) @@ -212,6 +216,7 @@ importFrom(lubridate,duration) importFrom(lubridate,floor_date) importFrom(lubridate,hours) importFrom(lubridate,is.Date) +importFrom(lubridate,is.POSIXct) importFrom(lubridate,is.instant) importFrom(lubridate,minutes) importFrom(lubridate,rollback) @@ -232,6 +237,7 @@ importFrom(purrr,map_if) importFrom(purrr,map_lgl) importFrom(purrr,modify_at) importFrom(purrr,modify_if) +importFrom(purrr,pmap) importFrom(purrr,reduce) importFrom(purrr,transpose) importFrom(purrr,walk) @@ -239,6 +245,7 @@ importFrom(rlang,":=") importFrom(rlang,.data) importFrom(rlang,abort) importFrom(rlang,arg_match) +importFrom(rlang,as_data_mask) importFrom(rlang,as_function) importFrom(rlang,as_label) importFrom(rlang,as_name) @@ -257,8 +264,10 @@ importFrom(rlang,exprs) importFrom(rlang,f_lhs) importFrom(rlang,f_rhs) importFrom(rlang,inform) +importFrom(rlang,is_call) importFrom(rlang,is_expression) importFrom(rlang,is_missing) +importFrom(rlang,list2) importFrom(rlang,new_formula) importFrom(rlang,parse_expr) importFrom(rlang,parse_exprs) @@ -268,16 +277,20 @@ importFrom(rlang,syms) importFrom(rlang,type_of) importFrom(rlang,warn) importFrom(stringr,str_c) +importFrom(stringr,str_count) importFrom(stringr,str_detect) importFrom(stringr,str_extract) importFrom(stringr,str_glue) importFrom(stringr,str_length) importFrom(stringr,str_locate) +importFrom(stringr,str_locate_all) 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_split) +importFrom(stringr,str_starts) importFrom(stringr,str_sub) importFrom(stringr,str_subset) importFrom(stringr,str_to_lower) @@ -292,8 +305,10 @@ importFrom(tidyr,pivot_longer) importFrom(tidyr,pivot_wider) importFrom(tidyr,unnest) importFrom(tidyselect,all_of) +importFrom(tidyselect,any_of) importFrom(tidyselect,contains) importFrom(tidyselect,matches) importFrom(tidyselect,vars_select) importFrom(utils,capture.output) +importFrom(utils,file.edit) importFrom(utils,str) diff --git a/NEWS.md b/NEWS.md index d2bd245476..95d3e2c6d3 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,12 +1,168 @@ +# admiral 0.11.0 + +## New Features + +- In the function `derive_var_anrind()`, added argument `use_a1hia1lo` to turn the usage of `A1HI` and `A1LO` off and on, with the default being off. (#1795) + +- Added a "Report a bug" link to `{admiral}` website. (#1836) + +- New function `compute_age_years()` for converting a vector of age values to years. (#1794) + +- New functions `filter_exist()` and `filter_not_exist()` for selecting records from +a dataset dependent on the existence of the corresponding by groups in a filtered +source dataset. (#1699) + +- New function `derive_param_extreme_record()` that adds parameter based on the first or last record from multiple sources. (#1822) + +- New ADPPK template script available `ad_adppk.R` which creates Population PK Analysis Dataset based on forthcoming CDISC Implementation guide. (#1772) + +- New function `compute_egfr()` for calculating Estimated Glomerular Filtration Rate (eGFR) and Creatinine Clearance for Kidney Function. (#1826) + +## Updates of Existing Functions + +- `derive_extreme_records()` was enhanced such that it includes the +functionality of `derive_param_extreme_event()`. (#1725) + +- For the `set_values_to` argument expressions are accepted now. For example, +`set_values_to = exprs(PARAMCD = str_to_upper(QSTESTCD))`. This affects +`censor_source()`, `derive_expected_records()`, `derive_extreme_event()`, +`derive_extreme_records()`, `derive_param_bmi()`, `derive_param_bsa()`, +`derive_param_computed()`, `derive_param_doseint()`, `derive_param_exposure()`, +`derive_param_framingham()`, `derive_param_map()`, `derive_param_exist_flag()`, +`derive_param_extreme_event()`, `derive_param_qtc()`, `derive_param_rr()`, +`derive_param_wbc_abs()`, `derive_summary_records()`, `event_source()`, +`get_summary_records()`. (#1727) + +- For the `order` argument expressions are accepted now. (#1727) + +- `derive_vars_merged()` updates: (#1727) + - The `missing_values` argument to assign values to +the new variables for non-matching observations was added. + - The `new_vars` argument accepts expressions now. + +- `derive_vars_joined()` updates: (#1727) + - The `missing_values` argument to assign values to the new variables for + non-matching observations was added. + - The `new_vars` and the `join_vars` argument accept expressions now. + +- The `date` field of `date_source()` accepts expressions now. This affects +`derive_var_extreme_dt()` and `derive_var_extreme_dtm()`. (#1727) + +- The `date` and `dthcaus` field of `dthcaus_source()` accept expressions now. +This affects `derive_var_dthcaus()`. (#1727) + +- The `date` field of `event_source()` and `censor_source()` accepts expressions +now. This affects `derive_param_tte()`. (#1727) + +- The `derive_param_computed()` function was enhanced: (#1873) + - The new `dataset_add` argument allows to consider parameters from a + different dataset than the input dataset. + - The new `analysis_var` argument allows to specify the variable to be + populated, e.g., `AVALC`. + - For `parameters` and `constant_parameters` a list of expressions can be + specified now. This allows to create temporary parameter codes, e.g., if + SDTM data is used as input. + - The `analysis_value` argument was enhanced such that any variable of the + form `.` can be used, e.g., `QSORRES.CHSF13`. + +## Breaking Changes + +- `create_query_data()` and `derive_vars_query()` updated to rename variables in + query data set as follows: (#1907) + + - `VAR_PREFIX` to `PREFIX` + - `QUERY_NAME` to `GRPNAME` + - `QUERY_ID` to `GRPID` + - `QUERY_SCOPE` to `SCOPE` + - `QUERY_SCOPE_NUM` to `SCOPEN` + - `TERM_LEVEL` to `SRCVAR` + - `TERM_NAME` to `TERMNAME` + - `TERM_ID` to `TERMID` + + Users need to adjust their `get_terms()` function accordingly. + +- The `aval_fun` argument of `derive_param_exist_flag()` was deprecated in favor +of the `set_values_to` argument. (#1727) + +- `derive_var_merged_cat()` and `derive_var_merged_character()` have been +deprecated in favor of `derive_vars_merged()`. (#1727) + +- The following functions, which were deprecated in previous `{admiral}` versions, have been removed: (#1747) + + - `derive_vars_merged_dt()` + - `derive_vars_merged_dtm()` + - `derive_var_agegr_ema()` + - `derive_var_agegr_fda()` + - `derive_param_first_event()` + - `derive_derived_param()` + - `derive_var_confirmation_flag()` + - `filter_confirmation()` + +- The following functions have been deprecated from previous `{admiral}` versions using the next phase of the deprecation process: (#1747) + + - `derive_var_disposition_status()` + - `derive_vars_disposition_reason()` + - `format_eoxxstt_default()` + - `format_reason_default()` + - `derive_var_worst_flag()` + +- `derive_param_extreme_event()` was deprecated in favor of +`derive_extreme_records()`. (#1725) + +- The `filter` argument in `derive_extreme_records()` was deprecated in favor of +the `filter_add` argument. (#1725) + +- `derive_vars_last_dose()`, `derive_var_last_dose_amt()`, `derive_var_last_dose_date()`, `derive_var_last_dose_grp()`, +were deprecated in favor of `derive_vars_joined()`. (#1797) + +- `derive_var_basetype()` was deprecated in favor of `derive_basetype_records()`. (#1796) + +- In the function `derive_param_exist_flag()` the arguments `dataset_adsl` and +`subject_keys` have been renamed to `dataset_ref` and `by_vars` respectively. (#1793) + +## Documentation + +- Updated example dataset to trigger deterioration flags in the vignette "Creating Questionnaire ADaMs". (#1853, #1854) + +- Updated PK Programming vignette to include new Population PK Template `ad_adppk.R`. (#1772) + +- Updated "Lab Grading" Vignette to link to grading metadata available in `{admiral}` and clarify how abnormal baseline +values are assigned in NCI-CTCAEv5. (#1863) + +- Updated "Visit and Period Variables" Vignette to add more detail about Study Specific Code that is required. (#1831) + +- Increased documentation for those functions which are regarded as wrapper functions. (#1726) + +- Examples in function documentation no longer rely on `library(admiral.test)`. (#1752) + +- Conferences where `{admiral}` was presented were updated on the `README.md`. (#1890) + +## Various + +- `vars()` which was used in the admiral function calls that expected a list of +quosures has been removed. The admiral option `force_admiral_vars` was removed +as well. (#1694) + +- `derive_vars_dtm()` and `derive_vars_dt()` had a bug pertaining to imputations associated with supplying both `min_dates` and `max_dates` that has now been resolved. (#1843) + +- Examples for `derive_var_extreme_flag()` were reworked to reduce runtime that occasionally led to failing CI check. (#1780) + +- `create_period_dataset()` had a bug that led to an error when both DT and DTM columns existed. (#1845) + +- External functions are now consistently imported via namespace. `package::function()` calls have been removed from `admiral` functions. (#1842) + +- `restrict_derivation()` had a bug which led to failure if the `derivation` argument was not in the global environment. (#1765) + # admiral 0.10.2 -- Changing package maintainer from Thomas Neitmann to Ben Straub (#1848) +- Changing package maintainer from Thomas Neitmann to Ben Straub. (#1848) # admiral 0.10.1 - Fix checks on `derive_vars_dtm()` and `derive_vars_dt()` that were too restrictive. (#1810) + # admiral 0.10.0 ## New Features @@ -15,26 +171,26 @@ that were too restrictive. (#1810) that messages must be addressed and deprecated functions throw errors. (#1754) - New function `consolidate_metadata()` for consolidating multiple meta datasets -into a single one (#1479) +into a single one. (#1479) - New function `compute_scale()` for computing the average of a vector and transforming the result from a source to a target range. (#1692) - New ADPC template script available `ad_adpc.R` which creates PK Concentration Analysis Dataset (#849). This script includes formatting suitable for -Non-Compartmental Analysis (ADNCA) (#851) +Non-Compartmental Analysis (ADNCA). (#851) -- New function `derive_expected_records()` for adding expected records (#1729) +- New function `derive_expected_records()` for adding expected records. (#1729) - New function `derive_extreme_event()` for adding the worst or best observation -for each by group as new records (#1755) +for each by group as new records. (#1755) ## Updates of Existing Functions - Arguments `analysis_var`, `keep_vars` were added to `derive_locf_records()`, `analysis_var` allows to specify analysis variable, `keep_vars` keeps variables that need carrying the last observation forward other than `analysis_var` -(e.g., `PARAMN`, `VISITNUM`) (#1636). +(e.g., `PARAMN`, `VISITNUM`). (#1636) - The function `create_single_dose_dataset()` adds support for expanding relative nominal time (e.g. NFRLT) used in Pharmacokinetic @@ -43,13 +199,13 @@ that need carrying the last observation forward other than `analysis_var` `nominal_time` is specified such as NFRLT (Nominal Relative Time from First Dose) then the nominal time is incremented by the interval specified in `EXDOSFRQ` for example for "QD" records the - NFRLT is incremented by 24 hours, e.g. 0, 24, 48...(#1640). + NFRLT is incremented by 24 hours, e.g. 0, 24, 48... (#1640) - `create_single_dose_dataset()` is also updated for values of `EXDOSFRQ` with units in days but expected values less than 24 hours, such as "BID", "TID", and "QID". Previously these values of `EXDOSFRQ` may result in duplicate records where the day values are - incremented but the time values are not (#1643) + incremented but the time values are not. (#1643) - The function `derive_var_confirmation_flag()` and `filter_confirmation()` gained the `tmp_obs_nr_var` argument. It helps flagging or selecting consecutive @@ -58,9 +214,9 @@ observations or the first or last observation in a by group. (#1724) - The functions `derive_vars_merged()`, `derive_var_merged_cat()`, `derive_var_merged_character()`, `derive_var_merged_exist_flag()`, `derive_var_merged_summary()`, and `derive_vars_merged_lookup()` were updated to -allow renaming in the argument `by_vars` (#1680). +allow renaming in the argument `by_vars`. (#1680) -- The units "min" and "sec" are added as valid values of `out_unit` in `compute_duration()` and `derive_vars_duration()` (#1647). +- The units "min" and "sec" are added as valid values of `out_unit` in `compute_duration()` and `derive_vars_duration()`. (#1647) - The function `derive_vars_query()` now includes a consistency check for `QUERY_SCOPE` and `QUERY_SCOPE_NUM` values. (#652) @@ -85,13 +241,13 @@ USUBJID)` must be used now. - Function `derive_param_tte()` has been updated such that only observations are added for subjects who have both an event or censoring and an observation in -`dataset_adsl` (#1576). +`dataset_adsl`. (#1576) -- Function `derive_var_disposition_status()` has been deprecated, please use `derive_var_merged_cat()` instead (#1681). +- Function `derive_var_disposition_status()` has been deprecated, please use `derive_var_merged_cat()` instead. (#1681) -- Function `derive_var_worst_flag()` has been deprecated, in favor of `slice_derivation()`/`derive_var_extreme_flag()` (#1682) +- Function `derive_var_worst_flag()` has been deprecated, in favor of `slice_derivation()`/`derive_var_extreme_flag()`. (#1682) -- Function `derive_vars_disposition_reason()` has been deprecated, in favor of `derive_vars_merged()`(#1683) +- Function `derive_vars_disposition_reason()` has been deprecated, in favor of `derive_vars_merged()`. (#1683) - The following functions have been deprecated from previous `{admiral}` versions using the next phase of the deprecation process: (#1712) @@ -102,7 +258,7 @@ added for subjects who have both an event or censoring and an observation in - `derive_var_agegr_ema()` - `derive_var_agegr_fda()` -- The following functions, which were deprecated in previous `{admiral}` versions, have been removed (#1712): +- The following functions, which were deprecated in previous `{admiral}` versions, have been removed: (#1712) - `derive_var_ady()` - `derive_var_aendy()` @@ -112,7 +268,7 @@ added for subjects who have both an event or censoring and an observation in - `smq_select()` - `sdg_select()` -- The following parameters, which were deprecated in previous `{admiral}` versions, have been removed (#1712): +- The following parameters, which were deprecated in previous `{admiral}` versions, have been removed: (#1712) - `meddra_version`, `whodd_version`, `get_smq_fun` and `get_sdg_fun` from the `create_query_data()` function - `date_imputation`, `time_imputation` and `preserve` parameters from `date_source()` function @@ -120,18 +276,18 @@ added for subjects who have both an event or censoring and an observation in - `ADLB` metadata data set called `atoxgr_criteria_ctcv5` updated to remove unit check for `HYPERURICEMIA` as grade criteria based on `ANRHI` only. This metadata 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) (#1650) +based on [Common Terminology Criteria for Adverse Events (CTCAE) v5.0](https://ctep.cancer.gov/protocoldevelopment/electronic_applications/ctc.htm). (#1650) - Renamed `derive_var_confirmation_flag()` and `filter_confirmation()` to -`derive_var_joined_exist_flag()` and `filter_joined()` respectively (#1738). +`derive_var_joined_exist_flag()` and `filter_joined()` respectively. (#1738) ## Documentation -- New vignette "Creating a PK NCA ADaM (ADPC/ADNCA)" (#1639) +- New vignette "Creating a PK NCA ADaM (ADPC/ADNCA)". (#1639) -- New vignette "Hy's Law Implementation" (#1637) +- New vignette "Hy's Law Implementation". (#1637) -- New vignette "Creating Questionnaire ADaMs" (#1715) +- New vignette "Creating Questionnaire ADaMs". (#1715) - The expected value for the `derivation` argument of `restrict_derivation()`, `slice_derivation()`, and `call_derivation()` is described now. (#1698) @@ -139,15 +295,15 @@ based on [Common Terminology Criteria for Adverse Events (CTCAE) v5.0](https://c - Removed authors from function documentation, as we will now only be tracking an overall list of authors for admiral. (#1673) -- Added an imputation example for `create_single_source_dataset()` in function documentation (#1408)(#1760) +- Added an imputation example for `create_single_source_dataset()` in function documentation. (#1408, #1760) -- Updates to examples for `derive_var_age_years()` and `derive_vars_duration()` (#1620)(#1634) +- Updates to examples for `derive_var_age_years()` and `derive_vars_duration()`. (#1620, #1634) - Increased the level of documentation for `derive_var_age_years()` to describe the data type of the newly created `new_var` column. (#970) ## Various -- Functions `derive_vars_dtm()` and `derive_vars_dt()` had a bug pertaining to imputations associated with `NA` values that has now been fixed (#1646) +- Functions `derive_vars_dtm()` and `derive_vars_dt()` had a bug pertaining to imputations associated with `NA` values that has now been fixed. (#1646) # admiral 0.9.1 @@ -162,15 +318,14 @@ affects `derive_vars_dtm()` and `and compute_tmf()`. (#1641) 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). +observation. (#1448) -- New function `derive_var_trtemfl()` for deriving treatment emergent flags (#989) +- 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). +- 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) +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 @@ -186,70 +341,70 @@ 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) +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) +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 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). +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) +- 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). +- 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). +`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 . +`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). +arguments are optional now. (#1598) - Function `create_query_data()` has been updated such that the dictionary -version is stored in the output dataset (#1337). +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). +- 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) +- 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) +was missing, which has now been fixed. (#1540) - Function `derive_vars_merged()` had an improperly formatted error message -which has been corrected (#1473) +which has been corrected. (#1473) -- Templates now save datasets as `.rds` instead of `.rda` (#1501) +- 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). +contains observations with dose frequency `"ONCE"`. (#1375) # admiral 0.8.4 @@ -355,7 +510,6 @@ imputation functions themselves (#1299). I.e., if a derivation like last known a date is based on dates, DTC variables have to be converted to numeric date or datetime variables in a preprocessing step. For examples see the [ADSL vignette](https://pharmaverse.github.io/admiral/cran-release/articles/adsl.html). - The following arguments were deprecated: - `date_imputation`, `time_imputation`, and `preserve` in `date_source()` diff --git a/R/admiral-package.R b/R/admiral-package.R index 4e1c96ad8d..f6e02aae22 100644 --- a/R/admiral-package.R +++ b/R/admiral-package.R @@ -4,23 +4,25 @@ #' @importFrom dplyr across arrange bind_rows case_when desc ends_with #' everything filter full_join group_by if_else mutate n pull rename #' rename_with row_number select slice semi_join starts_with transmute ungroup -#' n_distinct union distinct summarise coalesce bind_cols na_if tibble +#' n_distinct union distinct summarise coalesce bind_cols na_if tibble tribble +#' summarise_all group_by_at first #' @importFrom magrittr %>% #' @importFrom rlang := abort arg_match as_function as_label as_name as_string #' call2 caller_env call_name current_env .data enexpr eval_bare eval_tidy -#' expr expr_interp expr_label exprs f_lhs f_rhs inform is_expression +#' expr expr_interp expr_label exprs f_lhs f_rhs inform is_call is_expression #' is_missing new_formula parse_expr parse_exprs set_names sym syms type_of -#' warn -#' @importFrom utils capture.output str +#' warn as_data_mask list2 +#' @importFrom utils capture.output str file.edit #' @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_replace_all str_sub str_subset -#' str_trim str_to_lower str_to_title str_to_upper str_length str_locate +#' flatten every modify_at modify_if reduce compose pmap +#' @importFrom stringr str_c str_count str_detect str_extract str_glue +#' str_length str_locate str_locate_all str_match str_remove str_remove_all +#' str_replace str_replace_all str_split str_starts str_sub str_subset +#' str_trim str_to_lower str_to_title str_to_upper #' @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 +#' rollback time_length %--% ymd ymd_hms weeks years hours minutes is.POSIXct #' @importFrom tidyr crossing drop_na fill nest pivot_longer pivot_wider unnest -#' @importFrom tidyselect all_of contains matches vars_select +#' @importFrom tidyselect all_of any_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 index f8c2e884aa..4bcd64a593 100644 --- a/R/admiral_environment.R +++ b/R/admiral_environment.R @@ -19,8 +19,7 @@ admiral_environment <- new.env(parent = emptyenv()) ## set_admiral_options admiral_environment$admiral_options <- list( # future_input = exprs(...), nolint - subject_keys = exprs(STUDYID, USUBJID), - force_admiral_vars = TRUE + subject_keys = exprs(STUDYID, USUBJID) ) # To enhance features and add inputs as necessary diff --git a/R/admiral_options.R b/R/admiral_options.R index 84ac917027..42485ef963 100644 --- a/R/admiral_options.R +++ b/R/admiral_options.R @@ -4,7 +4,8 @@ #' #' @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")`. +#' 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 @@ -24,20 +25,32 @@ #' [derive_var_dthcaus()], [derive_var_extreme_dtm()], [derive_vars_period()], #' [create_period_dataset()] #' -#' #' @examples -#' library(admiral.test) #' library(dplyr, warn.conflicts = FALSE) -#' data("admiral_vs") -#' data("admiral_dm") +#' dm <- tribble( +#' ~STUDYID, ~DOMAIN, ~USUBJID, ~AGE, ~AGEU, +#' "PILOT01", "DM", "01-1302", 61, "YEARS", +#' "PILOT01", "DM", "17-1344", 64, "YEARS" +#' ) +#' +#' vs <- tribble( +#' ~STUDYID, ~DOMAIN, ~USUBJID, ~VSTESTCD, ~VISIT, ~VSTPT, ~VSSTRESN, +#' "PILOT01", "VS", "01-1302", "DIABP", "BASELINE", "LYING", 76, +#' "PILOT01", "VS", "01-1302", "DIABP", "BASELINE", "STANDING", 87, +#' "PILOT01", "VS", "01-1302", "DIABP", "WEEK 2", "LYING", 71, +#' "PILOT01", "VS", "01-1302", "DIABP", "WEEK 2", "STANDING", 79, +#' "PILOT01", "VS", "17-1344", "DIABP", "BASELINE", "LYING", 88, +#' "PILOT01", "VS", "17-1344", "DIABP", "BASELINE", "STANDING", 86, +#' "PILOT01", "VS", "17-1344", "DIABP", "WEEK 2", "LYING", 84, +#' "PILOT01", "VS", "17-1344", "DIABP", "WEEK 2", "STANDING", 82 +#' ) #' #' # Merging all dm variables to vs #' derive_vars_merged( -#' admiral_vs, -#' dataset_add = select(admiral_dm, -DOMAIN), +#' vs, +#' dataset_add = select(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) @@ -65,11 +78,6 @@ get_admiral_option <- function(option) { #' `exprs(STUDYID, USUBJID)`. This option is used as default value for the #' `subject_keys` argument in all admiral functions. #' -#' @param force_admiral_vars If this option is set to `TRUE` (which is the -#' default), the admiral definition of `vars()` is forced. This is just a -#' temporary solution to allow running scripts which use `vars()` in the -#' admiral function calls. It will be removed in a future release. -#' #' @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()`. @@ -84,7 +92,8 @@ get_admiral_option <- function(option) { #' @export #' #' @seealso [get_admiral_option()], [derive_param_exist_flag()],[derive_param_tte()], -#' [derive_var_dthcaus()], [derive_var_extreme_dtm()], [derive_vars_period()], [create_period_dataset()] +#' [derive_var_dthcaus()], [derive_var_extreme_dtm()], [derive_vars_period()], +#' [create_period_dataset()] #' #' @examples #' library(lubridate) @@ -102,11 +111,11 @@ get_admiral_option <- function(option) { #' mutate(STUDYID = "XX1234") #' #' tu <- tribble( -#' ~USUBJID2, ~VISIT, ~TUSTRESC, -#' "1", "SCREENING", "TARGET", -#' "1", "WEEK 1", "TARGET", -#' "1", "WEEK 5", "TARGET", -#' "1", "WEEK 9", "NON-TARGET", +#' ~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" #' ) %>% @@ -116,7 +125,7 @@ get_admiral_option <- function(option) { #' ) #' #' derive_param_exist_flag( -#' dataset_adsl = adsl, +#' dataset_ref = adsl, #' dataset_add = tu, #' filter_add = TUTESTCD == "TUMIDENT" & VISIT == "SCREENING", #' condition = TUSTRESC == "TARGET", @@ -127,17 +136,12 @@ get_admiral_option <- function(option) { #' PARAM = "Measurable Disease at Baseline" #' ) #' ) -set_admiral_options <- function(subject_keys, force_admiral_vars) { +set_admiral_options <- function(subject_keys) { if (!missing(subject_keys)) { assert_vars(subject_keys) admiral_environment$admiral_options$subject_keys <- subject_keys } - if (!missing(force_admiral_vars)) { - assert_logical_scalar(force_admiral_vars) - admiral_environment$admiral_options$force_admiral_vars <- force_admiral_vars - } - # Add future input to function formals above # if (!missing(future_input)) { # assert_vars(future_input) nolint diff --git a/R/call_derivation.R b/R/call_derivation.R index da27b762ee..78e2e3283f 100644 --- a/R/call_derivation.R +++ b/R/call_derivation.R @@ -36,14 +36,41 @@ #' #' @examples #' library(dplyr, warn.conflicts = FALSE) -#' library(admiral.test) -#' data(admiral_ae) -#' data(admiral_adsl) +#' adsl <- tribble( +#' ~STUDYID, ~USUBJID, ~TRTSDT, ~TRTEDT, +#' "PILOT01", "01-1307", NA, NA, +#' "PILOT01", "05-1377", "2014-01-04", "2014-01-25", +#' "PILOT01", "06-1384", "2012-09-15", "2012-09-24", +#' "PILOT01", "15-1085", "2013-02-16", "2013-08-18", +#' "PILOT01", "16-1298", "2013-04-08", "2013-06-28" +#' ) %>% +#' mutate( +#' across(TRTSDT:TRTEDT, as.Date) +#' ) +#' +#' ae <- tribble( +#' ~STUDYID, ~DOMAIN, ~USUBJID, ~AESTDTC, ~AEENDTC, +#' "PILOT01", "AE", "06-1384", "2012-09-15", "2012-09-29", +#' "PILOT01", "AE", "06-1384", "2012-09-15", "2012-09-29", +#' "PILOT01", "AE", "06-1384", "2012-09-23", "2012-09-29", +#' "PILOT01", "AE", "06-1384", "2012-09-23", "2012-09-29", +#' "PILOT01", "AE", "06-1384", "2012-09-15", "2012-09-29", +#' "PILOT01", "AE", "06-1384", "2012-09-15", "2012-09-29", +#' "PILOT01", "AE", "06-1384", "2012-09-15", "2012-09-29", +#' "PILOT01", "AE", "06-1384", "2012-09-15", "2012-09-29", +#' "PILOT01", "AE", "06-1384", "2012-09-23", "2012-09-29", +#' "PILOT01", "AE", "06-1384", "2012-09-23", "2012-09-29", +#' "PILOT01", "AE", "16-1298", "2013-06-08", "2013-07-06", +#' "PILOT01", "AE", "16-1298", "2013-06-08", "2013-07-06", +#' "PILOT01", "AE", "16-1298", "2013-04-22", "2013-07-06", +#' "PILOT01", "AE", "16-1298", "2013-04-22", "2013-07-06", +#' "PILOT01", "AE", "16-1298", "2013-04-22", "2013-07-06", +#' "PILOT01", "AE", "16-1298", "2013-04-22", "2013-07-06" +#' ) #' -#' adae <- -#' select(admiral_ae[sample(1:nrow(admiral_ae), 1000), ], USUBJID, AESTDTC, AEENDTC) %>% +#' adae <- ae %>% #' derive_vars_merged( -#' dataset_add = admiral_adsl, +#' dataset_add = adsl, #' new_vars = exprs(TRTSDT, TRTEDT), #' by_vars = exprs(USUBJID) #' ) @@ -90,7 +117,7 @@ call_derivation <- function(dataset = NULL, derivation, variable_params, ...) { abort("All arguments inside `...` must be named") } - all_params <- base::union(unlist(map(variable_params, names)), names(fixed_params)) + all_params <- union(unlist(map(variable_params, names)), names(fixed_params)) assert_function_param(deparse(substitute(derivation)), all_params) for (i in seq_along(variable_params)) { @@ -121,14 +148,43 @@ call_derivation <- function(dataset = NULL, derivation, variable_params, ...) { #' #' @examples #' library(dplyr, warn.conflicts = FALSE) -#' library(admiral.test) -#' data(admiral_ae) -#' data(admiral_adsl) #' -#' adae <- admiral_ae[sample(1:nrow(admiral_ae), 1000), ] %>% +#' adsl <- tribble( +#' ~STUDYID, ~USUBJID, ~TRTSDT, ~TRTEDT, +#' "PILOT01", "01-1307", NA, NA, +#' "PILOT01", "05-1377", "2014-01-04", "2014-01-25", +#' "PILOT01", "06-1384", "2012-09-15", "2012-09-24", +#' "PILOT01", "15-1085", "2013-02-16", "2013-08-18", +#' "PILOT01", "16-1298", "2013-04-08", "2013-06-28" +#' ) %>% +#' mutate( +#' across(TRTSDT:TRTEDT, as.Date) +#' ) +#' +#' ae <- tribble( +#' ~STUDYID, ~DOMAIN, ~USUBJID, ~AESTDTC, ~AEENDTC, +#' "PILOT01", "AE", "06-1384", "2012-09-15", "2012-09-29", +#' "PILOT01", "AE", "06-1384", "2012-09-15", "2012-09-29", +#' "PILOT01", "AE", "06-1384", "2012-09-23", "2012-09-29", +#' "PILOT01", "AE", "06-1384", "2012-09-23", "2012-09-29", +#' "PILOT01", "AE", "06-1384", "2012-09-15", "2012-09-29", +#' "PILOT01", "AE", "06-1384", "2012-09-15", "2012-09-29", +#' "PILOT01", "AE", "06-1384", "2012-09-15", "2012-09-29", +#' "PILOT01", "AE", "06-1384", "2012-09-15", "2012-09-29", +#' "PILOT01", "AE", "06-1384", "2012-09-23", "2012-09-29", +#' "PILOT01", "AE", "06-1384", "2012-09-23", "2012-09-29", +#' "PILOT01", "AE", "16-1298", "2013-06-08", "2013-07-06", +#' "PILOT01", "AE", "16-1298", "2013-06-08", "2013-07-06", +#' "PILOT01", "AE", "16-1298", "2013-04-22", "2013-07-06", +#' "PILOT01", "AE", "16-1298", "2013-04-22", "2013-07-06", +#' "PILOT01", "AE", "16-1298", "2013-04-22", "2013-07-06", +#' "PILOT01", "AE", "16-1298", "2013-04-22", "2013-07-06" +#' ) +#' +#' adae <- ae %>% #' select(USUBJID, AESTDTC, AEENDTC) %>% #' derive_vars_merged( -#' dataset_add = admiral_adsl, +#' dataset_add = adsl, #' new_vars = exprs(TRTSDT, TRTEDT), #' by_vars = exprs(USUBJID) #' ) @@ -150,6 +206,7 @@ call_derivation <- function(dataset = NULL, derivation, variable_params, ...) { #' max_dates = exprs(TRTEDT) #' ) #' +#' #' ## While `derive_vars_dt()` can only add one variable at a time, using `call_derivation()` #' ## one can add multiple variables in one go. #' ## The function arguments which are different from a variable to another (e.g. `new_vars_prefix`, diff --git a/R/call_user_fun.R b/R/call_user_fun.R index 1b8e68f837..b8109a5a5c 100644 --- a/R/call_user_fun.R +++ b/R/call_user_fun.R @@ -28,7 +28,7 @@ call_user_fun <- function(call) { eval_tidy(call), error = function(cnd) { abort( - paste0("Calling ", rlang::as_label(enexpr(call)), " caused the following error:\n", cnd) + paste0("Calling ", as_label(enexpr(call)), " caused the following error:\n", cnd) ) } ) diff --git a/R/compute_age_years.R b/R/compute_age_years.R new file mode 100644 index 0000000000..10afc698bb --- /dev/null +++ b/R/compute_age_years.R @@ -0,0 +1,68 @@ +#' Compute Age in Years +#' +#' Converts a set of age values from the specified time unit to years. +#' +#' @param age The ages to convert. +#' +#' A numeric vector is expected. +#' +#' @param age_unit Age unit. +#' +#' Either a string containing the time unit of all ages in `age` or a character +#' vector containing the time units of each age in `age` is expected. Note that +#' permitted values are cases insensitive (e.g. `"YEARS"` is treated the same +#' as `"years"` and `"Years"`). +#' +#' Permitted Values: `"years"`, `"months"`, `"weeks"`, `"days"`, `"hours"`, `"minutes"`, +#' `"seconds"`. +#' +#' @details Returns a numeric vector of ages in years as doubles. Note, underlying +#' computations assume an equal number of days in each year (365.25). +#' +#' @return The ages contained in `age` converted to years. +#' +#' @keywords com_date_time +#' +#' @family com_date_time +#' +#' @export +#' +#' @examples +#' compute_age_years( +#' age = c(240, 360, 480), +#' age_unit = "MONTHS" +#' ) +#' +#' compute_age_years( +#' age = c(10, 520, 3650), +#' age_unit = c("YEARS", "WEEKS", "DAYS") +#' ) +#' +compute_age_years <- function(age, + age_unit) { + assert_numeric_vector(age) + assert_character_vector( + unique(tolower(age_unit)), + values = c( + NA, "years", "months", "weeks", "days", + "hours", "minutes", "seconds" + ) + ) + + if (!(length(age_unit) %in% c(1, length(age)))) { + abort(paste0( + "`age_unit` must be a single string or a vector of the same length as", + "`age`, but there are ", length(age), " values in `age` and ", + length(age_unit), " values in `age_unit`." + )) + } + + age_years <- time_length( + duration(age, + units = tolower(age_unit) + ), + unit = "years" + ) + + age_years +} diff --git a/R/compute_kidney.R b/R/compute_kidney.R new file mode 100644 index 0000000000..a5a976c470 --- /dev/null +++ b/R/compute_kidney.R @@ -0,0 +1,202 @@ +#' Compute Estimated Glomerular Filtration Rate (eGFR) for Kidney Function +#' +#' Compute Kidney Function Tests: +#' - Estimated Creatinine Clearance (CRCL) by Cockcroft-Gault equation +#' - Estimated Glomerular Filtration Rate (eGFR) by CKD-EPI or MDRD equations +#' +#' @param creat Creatinine +#' +#' A numeric vector is expected. +#' +#' @param creatu Creatinine Units +#' +#' A character vector is expected. +#' +#' Default: `"SI"` +#' +#' Expected Values: `"SI"`, `"CV"`, `"umol/L"`, `"mg/dL"` +#' +#' @param age Age (years) +#' +#' A numeric vector is expected. +#' +#' @param wt Weight (kg) +#' +#' A numeric vector is expected if `method = "CRCL"` +#' +#' @param sex Gender +#' +#' A character vector is expected. +#' +#' Expected Values: `"M"`, `"F"` +#' +#' @param race Race +#' +#' A character vector is expected if `method = "MDRD"` +#' +#' Expected Values: `"BLACK OR AFRICAN AMERICAN"` and others +#' +#' @param method Method +#' +#' A character vector is expected. +#' +#' Expected Values: `"CRCL"`, `"CKD-EPI"`, `"MDRD"` +#' +#' @details +#' +#' Calculates an estimate of Glomerular Filtration Rate (eGFR) +#' +#' \strong{CRCL Creatinine Clearance (Cockcroft-Gault)} +#' +#' For Creatinine in umol/L: +#' +#' \deqn{\frac{(140 - age) \times weight(kg) \times constant}{Serum\:Creatinine(\mu mol/L)}} +#' +#' \deqn{Constant = 1.04\:for\:females, 1.23\:for\:males} +#' +#' For Creatinine in mg/dL: +#' +#' \deqn{\frac{(140 - age) \times weight(kg) \times (0.85\:if\:female)}{72 \times +#' Serum\:Creatinine(mg/dL)}} +#' +#' units = mL/min +#' +#' \strong{CKD-EPI Chronic Kidney Disease Epidemiology Collaboration formula} +#' +#' \deqn{eGFR = 142 \times min(SCr/κ, 1)^{α} \times max(SCr/κ, 1)^{-1.200} +#' \times 0.9938^{Age} \times 1.012 [if\:female]} +#' +#' SCr = standardized serum creatinine in mg/dL +#' (Note SCr(mg/dL) = Creat(umol/L) / 88.42) +#' +#' κ = 0.7 (females) or 0.9 (males) +#' α = -0.241 (female) or -0.302 (male) +#' units = mL/min/1.73 m2 +#' +#' \strong{MDRD Modification of Diet in Renal Disease formula} +#' +#' \deqn{eGFR = 175 \times (SCr)^{-1.154} \times (age)^{-0.203} +#' \times 0.742 [if\:female] \times 1.212 [if\:Black]} +#' +#' SCr = standardized serum creatinine in mg/dL +#' (Note SCr(mg/dL) = Creat(umol/L) / 88.42) +#' +#' units = mL/min/1.73 m2 +#' +#' @return A numeric vector of egfr values +#' +#' @keywords com_bds_findings +#' @family com_bds_findings +#' +#' @export +#' +#' @examples +#' compute_egfr( +#' creat = 90, creatu = "umol/L", age = 53, wt = 85, sex = "M", method = "CRCL" +#' ) +#' +#' compute_egfr( +#' creat = 90, creatu = "umol/L", age = 53, sex = "M", race = "ASIAN", method = "MDRD" +#' ) +#' +#' compute_egfr( +#' creat = 70, creatu = "umol/L", age = 52, sex = "F", race = "BLACK OR AFRICAN AMERICAN", +#' method = "MDRD" +#' ) +#' +#' compute_egfr( +#' creat = 90, creatu = "umol/L", age = 53, sex = "M", method = "CKD-EPI" +#' ) +#' +#' +#' base <- tibble::tribble( +#' ~STUDYID, ~USUBJID, ~AGE, ~SEX, ~RACE, ~WTBL, ~CREATBL, ~CREATBLU, +#' "P01", "P01-1001", 55, "M", "WHITE", 90.7, 96.3, "umol/L", +#' "P01", "P01-1002", 52, "F", "BLACK OR AFRICAN AMERICAN", 68.5, 70, "umol/L", +#' "P01", "P01-1003", 67, "M", "BLACK OR AFRICAN AMERICAN", 85.0, 77, "umol/L", +#' "P01", "P01-1004", 76, "F", "ASIAN", 60.7, 65, "umol/L", +#' ) +#' +#' base %>% +#' dplyr::mutate( +#' CRCL_CG = compute_egfr( +#' creat = CREATBL, creatu = CREATBLU, age = AGE, wt = WTBL, sex = SEX, +#' method = "CRCL" +#' ), +#' EGFR_EPI = compute_egfr( +#' creat = CREATBL, creatu = CREATBLU, age = AGE, wt = WTBL, sex = SEX, +#' method = "CKD-EPI" +#' ), +#' EGFR_MDRD = compute_egfr( +#' creat = CREATBL, creatu = CREATBLU, age = AGE, wt = WTBL, sex = SEX, +#' race = RACE, method = "MDRD" +#' ), +#' ) +compute_egfr <- function(creat, creatu = "SI", age, wt, sex, race = NULL, method) { + assert_numeric_vector(creat) + assert_character_vector(creatu, values = c( + "SI", "CV", "mg/dL", "umol/L", NA_character_, + optional = TRUE + )) + assert_numeric_vector(age) + assert_character_vector(sex, values = c("M", "F")) + assert_character_vector(race, optional = TRUE) + assert_character_scalar( + method, + values = c( + "CRCL", "MDRD", "CKD-EPI" + ) + ) + + scr <- case_when( + tolower(creatu) %in% c("cv", "mg/dl") ~ creat, + TRUE ~ creat / 88.42 + ) + + if (method == "MDRD") { + assert_character_vector(race) + + egfr <- case_when( + race == "BLACK OR AFRICAN AMERICAN" & sex == "F" ~ 175 * (scr^-1.154) * + (age^-0.203) * 0.742 * 1.212, + race == "BLACK OR AFRICAN AMERICAN" ~ 175 * (scr^-1.154) * (age^-0.203) * 1.212, + sex == "F" ~ 175 * (scr^-1.154) * (age^-0.203) * 0.742, + sex == "M" ~ 175 * (scr^-1.154) * (age^-0.203) + ) + } else if (method == "CRCL") { + assert_numeric_vector(wt) + + egfr <- case_when( + tolower(creatu) %in% c("cv", "mg/dl") & sex == "F" ~ + ((140 - age) * wt * 0.85) / (creat * 72), + tolower(creatu) %in% c("cv", "mg/dl") & sex == "M" ~ + ((140 - age) * wt) / (creat * 72), + sex == "F" ~ ((140 - age) * wt * 1.04) / creat, + sex == "M" ~ ((140 - age) * wt * 1.23) / creat + ) + } else if (method == "CKD-EPI") { + kappa <- case_when( + sex == "F" ~ 0.7, + sex == "M" ~ 0.9, + TRUE ~ NA_real_ + ) + + alpha <- case_when( + sex == "F" ~ -0.241, + sex == "M" ~ -0.302, + TRUE ~ NA_real_ + ) + + gender_coefficent <- case_when( + sex == "F" ~ 1.012, + TRUE ~ 1 + ) + + egfr <- 142 * pmin(scr / kappa, 1)^(alpha) * + pmax(scr / kappa, 1)^(-1.200) * + 0.9938^age * + gender_coefficent + } + + return(egfr) +} diff --git a/R/compute_scale.R b/R/compute_scale.R index d8117f0e60..0e9b60716c 100644 --- a/R/compute_scale.R +++ b/R/compute_scale.R @@ -74,7 +74,7 @@ compute_scale <- function(source, flip_direction = FALSE, min_n = 1) { # Function argument checks - assert_numeric_vector(source) + assert_numeric_vector(source) # nolint: undesirable_function_linter assert_numeric_vector(source_range, optional = TRUE) if (!is.null(target_range) && is.null(source_range)) { abort(paste0( @@ -96,8 +96,8 @@ compute_scale <- function(source, # Computation - if (sum(!is.na(source)) >= min_n) { - target <- mean(source, na.rm = TRUE) + if (sum(!is.na(source)) >= min_n) { # nolint: undesirable_function_linter + target <- mean(source, na.rm = TRUE) # nolint: undesirable_function_linter if (!is.null(source_range) && !is.null(target_range)) { scale_constant <- min(target_range) - min(source_range) diff --git a/R/create_query_data.R b/R/create_query_data.R index 241589dfc4..29531eed09 100644 --- a/R/create_query_data.R +++ b/R/create_query_data.R @@ -29,13 +29,13 @@ #' 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 basket, +#' - `SRCVAR`: 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 +#' - `TERMNAME`: the name of the term if the variable `SRCVAR` is #' referring to is character -#' - `TERM_ID` the numeric id of the term if the variable `TERM_LEVEL` is +#' - `TERMID` the numeric id of the term if the variable `SRCVAR` is #' referring to is numeric -#' - `QUERY_NAME`: the name of the basket. The values must be the same for +#' - `GRPNAME`: the name of the basket. The values must be the same for #' all observations. #' #' The function must provide the following parameters @@ -45,7 +45,7 @@ #' `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 basket. +#' `GRPID` 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 baskets in the #' `create_query_data()` call. For example if SMQs need to be read from a @@ -56,7 +56,7 @@ #' @details #' #' For each `query()` object listed in the `queries` argument, the terms belonging -#' to the query (`TERM_LEVEL`, `TERM_NAME`, `TERM_ID`) are determined with respect +#' to the query (`SRCVAR`, `TERMNAME`, `TERMID`) are determined with respect #' to the `definition` field of the query: if the definition field of the #' `query()` object is #' @@ -70,24 +70,24 @@ #' The following variables (as described in [Queries Dataset #' Documentation](../articles/queries_dataset.html)) are created: #' -#' * `VAR_PREFIX`: Prefix of the variables to be created by +#' * `PREFIX`: Prefix of the variables to be created by #' `derive_vars_query()` as specified by the `prefix` element. -#' * `QUERY_NAME`: Name of the query as specified by the `name` element. -#' * `QUERY_ID`: Id of the query as specified by the `id` element. If the `id` +#' * `GRPNAME`: Name of the query as specified by the `name` element. +#' * `GRPID`: Id of the query as specified by the `id` element. If the `id` #' 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 +#' * `SCOPE`: scope of the query as specified by the `scope` element of #' 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 #' `basket_select()` object, the variable is not created. -#' * `QUERY_SCOPE_NUM`: numeric scope of the query. It is set to `1` if the +#' * `SCOPEN`: 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 #' equals `FALSE`, the variable is set to `NA`. If the `add_scope_num` element #' 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. +#' * `SRCVAR`: Name of the variable used to identify the terms. +#' * `TERMNAME`: Value of the term variable if it is a character variable. +#' * `TERMID`: 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. #' @@ -111,11 +111,11 @@ #' #' # creating a query dataset for a customized query #' cqterms <- tribble( -#' ~TERM_NAME, ~TERM_ID, +#' ~TERMNAME, ~TERMID, #' "APPLICATION SITE ERYTHEMA", 10003041L, #' "APPLICATION SITE PRURITUS", 10003053L #' ) %>% -#' mutate(TERM_LEVEL = "AEDECOD") +#' mutate(SRCVAR = "AEDECOD") #' #' cq <- query( #' prefix = "CQ01", @@ -217,18 +217,18 @@ create_query_data <- function(queries, fun = get_terms_fun, queries = queries, definition = queries[[i]]$definition, - expect_query_name = TRUE, - expect_query_id = !is.null(queries[[i]]$id), + expect_grpname = TRUE, + expect_grpid = !is.null(queries[[i]]$id), i = i, temp_env = temp_env ) query_data[[i]] <- mutate(query_data[[i]], - QUERY_SCOPE = queries[[i]]$definition$scope + SCOPE = queries[[i]]$definition$scope ) if (queries[[i]]$add_scope_num) { query_data[[i]] <- mutate(query_data[[i]], - QUERY_SCOPE_NUM = if_else(QUERY_SCOPE == "BROAD", 1, 2) + SCOPEN = if_else(SCOPE == "BROAD", 1, 2) ) } } else if (is.data.frame(queries[[i]]$definition)) { @@ -258,20 +258,20 @@ create_query_data <- function(queries, # add mandatory variables query_data[[i]] <- mutate( query_data[[i]], - VAR_PREFIX = queries[[i]]$prefix + PREFIX = queries[[i]]$prefix ) if (!is_auto(queries[[i]]$name)) { query_data[[i]] <- mutate( query_data[[i]], - QUERY_NAME = queries[[i]]$name + GRPNAME = queries[[i]]$name ) } # add optional variables if (!is.null(queries[[i]]$id) && !is_auto(queries[[i]]$id)) { query_data[[i]] <- mutate(query_data[[i]], - QUERY_ID = queries[[i]]$id + GRPID = queries[[i]]$id ) } } @@ -313,9 +313,9 @@ create_query_data <- function(queries, #' The definition is passed to the access function. It defines which terms are #' returned. #' -#' @param expect_query_name Is `QUERY_NAME` expected in the output dataset? +#' @param expect_grpname Is `GRPNAME` expected in the output dataset? #' -#' @param expect_query_id Is `QUERY_ID` expected in the output dataset? +#' @param expect_grpid Is `GRPID` expected in the output dataset? #' #' @param i Index of `definition` in `queries` #' @@ -334,8 +334,8 @@ get_terms_from_db <- function(version, fun, queries, definition, - expect_query_name = FALSE, - expect_query_id = FALSE, + expect_grpname = FALSE, + expect_grpid = FALSE, i, temp_env) { assert_db_requirements( @@ -350,21 +350,21 @@ get_terms_from_db <- function(version, fun( basket_select = definition, version = version, - keep_id = expect_query_id, + keep_id = expect_grpid, temp_env = temp_env ) ) assert_terms( terms, - expect_query_name = expect_query_name, - expect_query_id = expect_query_id, + expect_grpname = expect_grpname, + expect_grpid = expect_grpid, source_text = paste0( "object returned by calling get_terms_fun(basket_select = ", format(definition), ", version = ", dquote(version), ", keep_id = ", - expect_query_id, + expect_grpid, ")" ) ) @@ -432,10 +432,10 @@ assert_db_requirements <- function(version, version_arg_name, fun, fun_arg_name, #' Standardized Drug Grouping (SDG), or a customized query (CQ). It is used #' as input to `create_query_data()`. #' -#' @param prefix The value is used to populate `VAR_PREFIX` in the output +#' @param prefix The value is used to populate `PREFIX` in the output #' dataset of `create_query_data()`, e.g., `"SMQ03"` #' -#' @param name The value is used to populate `QUERY_NAME` in the output dataset +#' @param name The value is used to populate `GRPNAME` in the output dataset #' of `create_query_data()`. If the `auto` keyword is specified, the variable #' is set to the name of the query in the SMQ/SDG database. #' @@ -443,7 +443,7 @@ assert_db_requirements <- function(version, version_arg_name, fun, fun_arg_name, #' keyword is permitted only for queries which are defined by an #' `basket_select()` object. #' -#' @param id The value is used to populate `QUERY_ID` in the output dataset of +#' @param id The value is used to populate `GRPID` in the output dataset of #' `create_query_data()`. If the `auto` keyword is specified, the variable is #' set to the id of the query in the SMQ/SDG database. #' @@ -451,7 +451,7 @@ assert_db_requirements <- function(version, version_arg_name, fun, fun_arg_name, #' keyword is permitted only for queries which are defined by an #' `basket_select()` object. #' -#' @param add_scope_num Determines if `QUERY_SCOPE_NUM` in the output dataset +#' @param add_scope_num Determines if `SCOPEN` in the output dataset #' of `create_query_data()` is populated #' #' If the parameter is set to `TRUE`, the definition must be an `basket_select()` @@ -468,17 +468,17 @@ assert_db_requirements <- function(version, version_arg_name, fun, fun_arg_name, #' * 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 -#' be specified to define the terms of a customized query. The `TERM_LEVEL` +#' * A data frame with columns `SRCVAR` and `TERMNAME` or `TERMID` can +#' be specified to define the terms of a customized query. The `SRCVAR` #' should be set to the name of the variable which should be used to select -#' the terms, e.g., `"AEDECOD"` or `"AELLTCD"`. `TERM_LEVEL` does not need +#' the terms, e.g., `"AEDECOD"` or `"AELLTCD"`. `SRCVAR` does not need #' to be constant within a query. For example a query can be based on #' `AEDECOD` and `AELLT`. #' -#' If `TERM_LEVEL` refers to a character variable, `TERM_NAME` should be set -#' to the value the variable. If it refers to a numeric variable, `TERM_ID` +#' If `SRCVAR` refers to a character variable, `TERMNAME` should be set +#' to the value the variable. If it refers to a numeric variable, `TERMID` #' should be set to the value of the variable. If only character variables -#' or only numeric variables are used, `TERM_ID` or `TERM_NAME` respectively +#' or only numeric variables are used, `TERMID` or `TERMNAME` respectively #' can be omitted. #' #' * A list of data frames and `basket_select()` objects can be specified to @@ -529,11 +529,11 @@ assert_db_requirements <- function(version, version_arg_name, fun, fun_arg_name, #' #' # creating a query for a customized query #' cqterms <- tribble( -#' ~TERM_NAME, ~TERM_ID, +#' ~TERMNAME, ~TERMID, #' "APPLICATION SITE ERYTHEMA", 10003041L, #' "APPLICATION SITE PRURITUS", 10003053L #' ) %>% -#' mutate(TERM_LEVEL = "AEDECOD") +#' mutate(SRCVAR = "AEDECOD") #' #' query( #' prefix = "CQ01", @@ -701,9 +701,9 @@ validate_query <- function(obj) { #' #' @param terms Terms provided by user #' -#' @param expect_query_name Is the `QUERY_NAME` column expected? +#' @param expect_grpname Is the `GRPNAME` column expected? #' -#' @param expect_query_id Is the `QUERY_ID` column expected? +#' @param expect_grpid Is the `GRPID` column expected? #' #' @param source_text Text describing the source of the terms, e.g., `"the data #' frame provided for the `definition` element"`. @@ -712,10 +712,10 @@ validate_query <- function(obj) { #' #' - `terms` is not a data frame, #' - `terms` has zero observations, -#' - the `TERM_LEVEL` variable is not in `terms`, -#' - neither the `TERM_NAME` nor the `TERM_ID` variable is in `terms`, -#' - `expect_query_name == TRUE` and the `QUERY_NAME` variable is not in `terms`, -#' - `expect_query_id == TRUE` and the `QUERY_ID` variable is not in `terms`, +#' - the `SRCVAR` variable is not in `terms`, +#' - neither the `TERMNAME` nor the `TERMID` variable is in `terms`, +#' - `expect_grpname == TRUE` and the `GRPNAME` variable is not in `terms`, +#' - `expect_grpid == TRUE` and the `GRPID` variable is not in `terms`, #' #' @examples #' @@ -733,8 +733,8 @@ validate_query <- function(obj) { #' @family other_advanced #' assert_terms <- function(terms, - expect_query_name = FALSE, - expect_query_id = FALSE, + expect_grpname = FALSE, + expect_grpid = FALSE, source_text) { if (!is.data.frame(terms)) { abort(paste0( @@ -753,41 +753,41 @@ assert_terms <- function(terms, } vars <- names(terms) - if (!"TERM_LEVEL" %in% vars) { + if (!"SRCVAR" %in% vars) { abort( paste0( - "Required variable `TERM_LEVEL` is missing in ", + "Required variable `SRCVAR` is missing in ", source_text, "." ) ) } - if (expect_query_name) { - if (!"QUERY_NAME" %in% vars) { + if (expect_grpname) { + if (!"GRPNAME" %in% vars) { abort( paste0( - "Required variable `QUERY_NAME` is missing in ", + "Required variable `GRPNAME` is missing in ", source_text, "." ) ) } } - if (expect_query_id) { - if (!"QUERY_ID" %in% vars) { + if (expect_grpid) { + if (!"GRPID" %in% vars) { abort( paste0( - "Required variable `QUERY_ID` is missing in ", + "Required variable `GRPID` is missing in ", source_text, "." ) ) } } - if (!"TERM_NAME" %in% vars && !"TERM_ID" %in% vars) { + if (!"TERMNAME" %in% vars && !"TERMID" %in% vars) { abort( paste0( - "Variable `TERM_NAME` or `TERM_ID` is required.\n", + "Variable `TERMNAME` or `TERMID` is required.\n", "None of them is in ", source_text, ".\n", diff --git a/R/create_single_dose_dataset.R b/R/create_single_dose_dataset.R index 887555e7dc..1a0c782b24 100644 --- a/R/create_single_dose_dataset.R +++ b/R/create_single_dose_dataset.R @@ -40,7 +40,7 @@ #' #' @rdname dose_freq_lookup -dose_freq_lookup <- tibble::tribble( +dose_freq_lookup <- tribble( ~NCI_CODE, ~CDISC_VALUE, "C64526", "1 TIME PER WEEK", "C139179", "10 DAYS PER MONTH", @@ -472,7 +472,7 @@ create_single_dose_dataset <- function(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 <- str_locate_all(start_datec, "DT") start_date_chk_pos <- as.vector(start_date_chk[[1]]) if (str_length(start_datec) != start_date_chk_pos[-1]) { @@ -484,7 +484,7 @@ create_single_dose_dataset <- function(dataset, } end_datec <- as_string(as_name(end_date)) - end_date_chk <- stringr::str_locate_all(end_datec, "DT") + end_date_chk <- str_locate_all(end_datec, "DT") end_date_chk_pos <- as.vector(end_date_chk[[1]]) if (str_length(end_datec) != end_date_chk_pos[-1]) { @@ -583,8 +583,8 @@ create_single_dose_dataset <- function(dataset, by = as.character(dose_freq) ) - if (any(data_not_once$DOSE_WINDOW %in% c("MINUTE", "HOUR")) & - (is.null(start_datetime) | is.null(end_datetime))) { + if (any(data_not_once$DOSE_WINDOW %in% c("MINUTE", "HOUR")) && + (is.null(start_datetime) || is.null(end_datetime))) { abort( paste( "There are dose frequencies more frequent than once a day.", diff --git a/R/derive_adeg_params.R b/R/derive_adeg_params.R index 11e1a7a947..f7a238e88c 100644 --- a/R/derive_adeg_params.R +++ b/R/derive_adeg_params.R @@ -1,9 +1,11 @@ #' Adds a Parameter for Corrected QT (an ECG measurement) #' -#' Adds a record for corrected QT using either Bazett's, Fridericia's or Sagie's +#' @description Adds a record for corrected QT using either Bazett's, Fridericia's or Sagie's #' formula for each by group (e.g., subject and visit) where the source parameters #' are available. #' +#' **Note:** This is a wrapper function for the more generic `derive_param_computed()`. +#' #' @param dataset Input dataset #' #' The variables specified by the `by_vars` and the `unit_var` parameter, @@ -238,9 +240,11 @@ compute_qtc <- function(qt, rr, method) { #' Adds a Parameter for Derived RR (an ECG measurement) #' -#' Adds a record for derived RR based on heart rate for each by group (e.g., +#' @description Adds a record for derived RR based on heart rate for each by group (e.g., #' subject and visit) where the source parameters are available. #' +#' **Note:** This is a wrapper function for the more generic `derive_param_computed()`. +#' #' The analysis value of the new parameter is derived as #' \deqn{\frac{60000}{HR}}{60000 / HR} #' diff --git a/R/derive_advs_params.R b/R/derive_advs_params.R index d4673953ed..1c269ea56f 100644 --- a/R/derive_advs_params.R +++ b/R/derive_advs_params.R @@ -1,8 +1,10 @@ #' Adds a Parameter for Mean Arterial Pressure #' -#' Adds a record for mean arterial pressure (MAP) for each by group +#' @description Adds a record for mean arterial pressure (MAP) for each by group #' (e.g., subject and visit) where the source parameters are available. #' +#' **Note:** This is a wrapper function for the more generic `derive_param_computed()`. +#' #' @param dataset Input dataset #' #' The variables specified by the `by_vars` parameter, `PARAMCD`, and @@ -204,8 +206,11 @@ compute_map <- function(diabp, sysbp, hr = NULL) { #' Adds a Parameter for BSA (Body Surface Area) Using the Specified Method #' -#' 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. +#' @description 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. +#' +#' **Note:** This is a wrapper function for the more generic `derive_param_computed()`. #' #' @param dataset Input dataset #' @@ -453,9 +458,11 @@ compute_bsa <- function(height = height, #' Adds a Parameter for BMI #' -#' Adds a record for BMI/Body Mass Index using Weight and Height each by group +#' @description Adds a record for BMI/Body Mass Index using Weight and Height each by group #' (e.g., subject and visit) where the source parameters are available. #' +#' **Note:** This is a wrapper function for the more generic `derive_param_computed()`. +#' #' @param dataset Input dataset #' #' The variables specified by the `by_vars` parameter, `PARAMCD`, and diff --git a/R/derive_basetype_records.R b/R/derive_basetype_records.R new file mode 100644 index 0000000000..64fb271ac0 --- /dev/null +++ b/R/derive_basetype_records.R @@ -0,0 +1,112 @@ +#' 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 +#' given parameter, if Baseline Value `BASE` is populated, and there is more than +#' one definition of baseline, then `BASETYPE` must be non-null on all records of +#' any type for that parameter. Each value of `BASETYPE` refers to a definition of +#' baseline that characterizes the value of `BASE` on that row. Please see +#' section 4.2.1.6 of the ADaM Implementation Guide, version 1.3 for further +#' background. +#' +#' Adds the `BASETYPE` variable to a dataset and duplicates records based upon +#' the provided conditions. +#' +#' @param dataset Input dataset +#' +#' The columns specified in the expressions inside `basetypes` are required. +#' +#' @param basetypes A *named* list of expressions created using the +#' `rlang::exprs()` function +#' +#' The names corresponds to the values of the newly created `BASETYPE` variables +#' and the expressions are used to subset the input dataset. +#' +#' @details +#' For each element of `basetypes` the input dataset is subset based upon +#' the provided expression and the `BASETYPE` variable is set to the name of the +#' expression. Then, all subsets are stacked. Records which do not match any +#' condition are kept and `BASETYPE` is set to `NA`. +#' +#' @return The input dataset with variable `BASETYPE` added +#' +#' +#' @family der_bds_findings +#' +#' @keywords der_bds_findings +#' +#' @export +#' +#' @examples +#' 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, +#' "P01", "DOUBLE-BLIND", "PARAM01", 3, 9.2, +#' "P01", "DOUBLE-BLIND", "PARAM01", 4, 10.1, +#' "P01", "OPEN-LABEL", "PARAM01", 5, 10.4, +#' "P01", "OPEN-LABEL", "PARAM01", 6, 9.9, +#' "P02", "RUN-IN", "PARAM01", 1, 12.1, +#' "P02", "DOUBLE-BLIND", "PARAM01", 2, 10.2, +#' "P02", "DOUBLE-BLIND", "PARAM01", 3, 10.8, +#' "P02", "OPEN-LABEL", "PARAM01", 4, 11.4, +#' "P02", "OPEN-LABEL", "PARAM01", 5, 10.8 +#' ) +#' +#' bds_with_basetype <- derive_basetype_records( +#' dataset = bds, +#' 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" +#' ) +#' ) +#' +#' +#' # Below print statement will print all 23 records in the data frame +#' # bds_with_basetype +#' print(bds_with_basetype, n = Inf) +#' +#' 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 <- tribble( +#' ~USUBJID, ~EPOCH, ~PARAMCD, ~ASEQ, ~AVAL, +#' "P01", "RUN-IN", "PARAM01", 1, 10.0, +#' "P01", "RUN-IN", "PARAM01", 2, 9.8, +#' "P01", "DOUBLE-BLIND", "PARAM01", 3, 9.2, +#' "P01", "DOUBLE-BLIND", "PARAM01", 4, 10.1 +#' ) +#' +#' bds_with_basetype <- derive_basetype_records( +#' dataset = bds, +#' basetypes = exprs( +#' "LAST" = TRUE, +#' "WORST" = TRUE +#' ) +#' ) +#' +#' print(bds_with_basetype, n = Inf) +#' +#' count(bds_with_basetype, BASETYPE, name = "Number of Records") +derive_basetype_records <- function(dataset, basetypes) { + assert_data_frame(dataset) + assert_named_exprs(basetypes) + + records_with_basetype <- map2(names(basetypes), basetypes, function(label, condition) { + dataset %>% + filter(!!condition) %>% + mutate(BASETYPE = label) + }) %>% + bind_rows() + + complementary_condition <- Reduce(function(x, y) bquote(.(x) | .(y)), basetypes) + records_without_basetype <- filter(dataset, !(!!complementary_condition)) + + bind_rows(records_without_basetype, records_with_basetype) +} diff --git a/R/derive_date_vars.R b/R/derive_date_vars.R index 8c7c181cfb..c43e8dd38a 100644 --- a/R/derive_date_vars.R +++ b/R/derive_date_vars.R @@ -308,7 +308,7 @@ impute_dtc_dtm <- function(dtc, max_dates = max_dates ) - if (highest_imputation == "Y" & is.null(min_dates) & is.null(max_dates)) { + if (highest_imputation == "Y" && is.null(min_dates) && is.null(max_dates)) { warning("If `highest_impuation` = \"Y\" is specified, `min_dates` or `max_dates` should be specified respectively.") # nolint } @@ -366,7 +366,7 @@ dtm_level <- function(level) { #' @seealso [impute_dtc_dtm()], [impute_dtc_dt()] get_partialdatetime <- function(dtc) { two <- "(\\d{2}|-?)" - partialdate <- stringr::str_match(dtc, paste0( + partialdate <- str_match(dtc, paste0( "(\\d{4}|-?)-?", two, "-?", @@ -514,8 +514,8 @@ restrict_imputed_dtc_dtm <- function(dtc, imputed_dtc, min_dates, max_dates) { - if (!(is.null(min_dates) | length(min_dates) == 0) | - !(is.null(max_dates) | length(max_dates) == 0)) { + if (!(is.null(min_dates) || length(min_dates) == 0) || + !(is.null(max_dates) || length(max_dates) == 0)) { suppress_warning( { # nolint # determine range of possible dates @@ -538,7 +538,7 @@ restrict_imputed_dtc_dtm <- function(dtc, regexpr = "If `highest_impuation` = \"Y\" is specified, `min_dates` or `max_dates` should be specified respectively." # nolint ) } - if (!(is.null(min_dates) | length(min_dates) == 0)) { + if (!(is.null(min_dates) || length(min_dates) == 0)) { if (length(unique(c(length(imputed_dtc), unlist(lapply(min_dates, length))))) != 1) { abort("Length of `min_dates` do not match length of dates to be imputed.") } @@ -554,13 +554,8 @@ restrict_imputed_dtc_dtm <- function(dtc, missing = imputed_dtc ) } - imputed_dtc <- if_else( - stringr::str_starts(imputed_dtc, "(0000|9999)"), - NA_character_, - imputed_dtc - ) } - if (!(is.null(max_dates) | length(max_dates) == 0)) { + if (!(is.null(max_dates) || length(max_dates) == 0)) { if (length(unique(c(length(imputed_dtc), unlist(lapply(max_dates, length))))) != 1) { abort("Length of `max_dates` do not match length of dates to be imputed.") } @@ -580,11 +575,6 @@ restrict_imputed_dtc_dtm <- function(dtc, missing = imputed_dtc ) } - imputed_dtc <- if_else( - stringr::str_starts(imputed_dtc, "(0000|9999)"), - NA_character_, - imputed_dtc - ) } imputed_dtc } @@ -781,7 +771,7 @@ impute_dtc_dt <- function(dtc, # Parse character date ---- two <- "(\\d{2}|-?)" - partialdate <- stringr::str_match(dtc, paste0( + partialdate <- str_match(dtc, paste0( "(\\d{4}|-?)-?", two, "-?", @@ -850,7 +840,7 @@ impute_dtc_dt <- function(dtc, max_dates = max_dates ) - if (highest_imputation == "Y" & is.null(min_dates) & is.null(max_dates)) { + if (highest_imputation == "Y" && is.null(min_dates) && is.null(max_dates)) { warning("If `highest_impuation` = \"Y\" is specified, `min_dates` or `max_dates` should be specified respectively.") # nolint } @@ -908,8 +898,8 @@ restrict_imputed_dtc_dt <- function(dtc, imputed_dtc, min_dates, max_dates) { - if (!(is.null(min_dates) | length(min_dates) == 0) | - !(is.null(max_dates) | length(max_dates) == 0)) { + if (!(is.null(min_dates) || length(min_dates) == 0) || + !(is.null(max_dates) || length(max_dates) == 0)) { suppress_warning( { # nolint # determine range of possible dates @@ -930,7 +920,7 @@ restrict_imputed_dtc_dt <- function(dtc, regexpr = "If `highest_impuation` = \"Y\" is specified, `min_dates` or `max_dates` should be specified respectively." # nolint ) } - if (!(is.null(min_dates) | length(min_dates) == 0)) { + if (!(is.null(min_dates) || length(min_dates) == 0)) { if (length(unique(c(length(imputed_dtc), unlist(lapply(min_dates, length))))) != 1) { abort("Length of `min_dates` do not match length of dates to be imputed.") } @@ -946,13 +936,8 @@ restrict_imputed_dtc_dt <- function(dtc, missing = imputed_dtc ) } - imputed_dtc <- if_else( - stringr::str_starts(imputed_dtc, "(0000|9999)"), - NA_character_, - imputed_dtc - ) } - if (!(is.null(max_dates) | length(max_dates) == 0)) { + if (!(is.null(max_dates) || length(max_dates) == 0)) { if (length(unique(c(length(imputed_dtc), unlist(lapply(max_dates, length))))) != 1) { abort("Length of `max_dates` do not match length of dates to be imputed.") } @@ -968,11 +953,6 @@ restrict_imputed_dtc_dt <- function(dtc, missing = imputed_dtc ) } - imputed_dtc <- if_else( - stringr::str_starts(imputed_dtc, "(0000|9999)"), - NA_character_, - imputed_dtc - ) } imputed_dtc } @@ -1016,6 +996,11 @@ convert_dtc_to_dt <- function(dtc, max_dates = max_dates, preserve = preserve ) + imputed_dtc <- if_else( + str_starts(imputed_dtc, "(0000|9999)") | imputed_dtc %in% c("0000-01-01", "9999-12-31"), # nolint + NA_character_, + imputed_dtc + ) ymd(imputed_dtc) } @@ -1052,21 +1037,31 @@ convert_dtc_to_dtm <- function(dtc, assert_character_vector(dtc) warn_if_invalid_dtc(dtc, is_valid_dtc(dtc)) - dtc %>% - impute_dtc_dtm( - highest_imputation = highest_imputation, - date_imputation = date_imputation, - time_imputation = time_imputation, - min_dates = min_dates, - max_dates = max_dates, - preserve = preserve - ) %>% - ymd_hms() + imputed_dtc <- impute_dtc_dtm( + dtc = dtc, + highest_imputation = highest_imputation, + date_imputation = date_imputation, + time_imputation = time_imputation, + min_dates = min_dates, + max_dates = max_dates, + preserve = preserve + ) + + imputed_dtc <- if_else( + str_starts(imputed_dtc, "(0000|9999)") | imputed_dtc %in% c("0000-01-01", "9999-12-31"), # nolint + NA_character_, + imputed_dtc + ) + + ymd_hms(imputed_dtc) } #' Convert a Date into a Datetime Object #' -#' Convert a date (datetime, date, or date character) into a Date vector (usually `'--DTM'`). +#' @description Convert a date (datetime, date, or date character) into a Date +#' vector (usually `'--DTM'`). +#' +#' **Note:** This is a wrapper function for the function `convert_dtc_to_dtm()`. #' #' @param dt The date to convert. #' @@ -1098,7 +1093,7 @@ convert_date_to_dtm <- function(dt, min_dates = NULL, max_dates = NULL, preserve = FALSE) { - if (lubridate::is.POSIXct(dt)) { + if (is.POSIXct(dt)) { return(dt) } else { if (is.instant(dt)) { @@ -1371,7 +1366,7 @@ compute_tmf <- function(dtc, #' date_imputation = "mid", #' preserve = TRUE #' ) -derive_vars_dt <- function(dataset, +derive_vars_dt <- function(dataset, # nolint: cyclocomp_linter new_vars_prefix, dtc, highest_imputation = "n", @@ -1391,17 +1386,17 @@ derive_vars_dt <- function(dataset, values = c("auto", "date", "none"), case_sensitive = FALSE ) - if ((highest_imputation == "Y" & is.null(min_dates) & is.null(max_dates)) | - (highest_imputation == "Y" & length(min_dates) == 0 & length(max_dates) == 0)) { + if ((highest_imputation == "Y" && is.null(min_dates) && is.null(max_dates)) || + (highest_imputation == "Y" && length(min_dates) == 0 && length(max_dates) == 0)) { abort("If `highest_impuation` = \"Y\" is specified, `min_dates` or `max_dates` should be specified respectively.") # nolint } if (highest_imputation == "Y") { assert_character_scalar(date_imputation, values = c("first", "last")) } - if (highest_imputation == "Y" & is.null(min_dates) & date_imputation == "first") { + if (highest_imputation == "Y" && is.null(min_dates) && date_imputation == "first") { warning("If `highest_impuation` = \"Y\" and `date_imputation` = \"first\" is specified, `min_dates` should be specified.") # nolint } - if (highest_imputation == "Y" & is.null(max_dates) & date_imputation == "last") { + if (highest_imputation == "Y" && is.null(max_dates) && date_imputation == "last") { warning("If `highest_impuation` = \"Y\" and `date_imputation` = \"last\" is specified, `max_dates` should be specified.") # nolint } @@ -1416,8 +1411,8 @@ derive_vars_dt <- function(dataset, dtc = !!dtc, highest_imputation = highest_imputation, date_imputation = date_imputation, - min_dates = lapply(min_dates, eval_tidy, data = rlang::as_data_mask(.)), - max_dates = lapply(max_dates, eval_tidy, data = rlang::as_data_mask(.)), + min_dates = lapply(min_dates, eval_tidy, data = as_data_mask(.)), + max_dates = lapply(max_dates, eval_tidy, data = as_data_mask(.)), preserve = preserve ) ) @@ -1567,7 +1562,7 @@ derive_vars_dt <- function(dataset, #' date_imputation = "mid", #' preserve = TRUE #' ) -derive_vars_dtm <- function(dataset, +derive_vars_dtm <- function(dataset, # nolint: cyclocomp_linter new_vars_prefix, dtc, highest_imputation = "h", @@ -1589,17 +1584,17 @@ derive_vars_dtm <- function(dataset, values = c("auto", "both", "date", "time", "none"), case_sensitive = FALSE ) - if ((highest_imputation == "Y" & is.null(min_dates) & is.null(max_dates)) | - (highest_imputation == "Y" & length(min_dates) == 0 & length(max_dates) == 0)) { + if ((highest_imputation == "Y" && is.null(min_dates) && is.null(max_dates)) || + (highest_imputation == "Y" && length(min_dates) == 0 && length(max_dates) == 0)) { abort("If `highest_impuation` = \"Y\" is specified, `min_dates` or `max_dates` should be specified respectively.") # nolint } if (highest_imputation == "Y") { assert_character_scalar(date_imputation, values = c("first", "last")) } - if (highest_imputation == "Y" & is.null(min_dates) & date_imputation == "first") { + if (highest_imputation == "Y" && is.null(min_dates) && date_imputation == "first") { warning("If `highest_impuation` = \"Y\" and `date_imputation` = \"first\" is specified, `min_dates` should be specified.") # nolint } - if (highest_imputation == "Y" & is.null(max_dates) & date_imputation == "last") { + if (highest_imputation == "Y" && is.null(max_dates) && date_imputation == "last") { warning("If `highest_impuation` = \"Y\" and `date_imputation` = \"last\" is specified, `max_dates` should be specified.") # nolint } @@ -1607,7 +1602,7 @@ derive_vars_dtm <- function(dataset, # Issue a warning if --DTM already exists warn_if_vars_exist(dataset, dtm) - mask <- rlang::as_data_mask(dataset) + mask <- as_data_mask(dataset) dataset[[dtm]] <- convert_dtc_to_dtm( dtc = eval_tidy(dtc, mask), diff --git a/R/derive_expected_records.R b/R/derive_expected_records.R index 6bd6d26cb0..c9a753fedc 100644 --- a/R/derive_expected_records.R +++ b/R/derive_expected_records.R @@ -27,8 +27,8 @@ #' A list of variable name-value pairs is expected. #' + LHS refers to a variable. #' + RHS refers to the values to set to the variable. This can be a string, a -#' symbol, a numeric value or `NA`, e.g., `exprs(PARAMCD = "TDOSE", PARCAT1 = -#' "OVERALL")`. More general expression are not allowed. +#' symbol, a numeric value, `NA`, or expressions, e.g., `exprs(PARAMCD = +#' "TDOSE", PARCAT1 = "OVERALL")`. #' #' @details For each group (the variables specified in the `by_vars` parameter), #' those records from `dataset_expected_obs` that are missing in the input diff --git a/R/derive_extreme_event.R b/R/derive_extreme_event.R index e4a32f8d38..e81dadfd86 100644 --- a/R/derive_extreme_event.R +++ b/R/derive_extreme_event.R @@ -12,9 +12,8 @@ #' If a particular event from `events` has more than one observation, within #' the event and by group, the records are ordered by the specified order. #' -#' *Permitted Values:* list of variables or `desc()` function calls -#' created by `exprs()`, e.g., `exprs(ADT, desc(AVAL))` -#' +#' *Permitted Values:* list of expressions created by `exprs()`, e.g., +#' `exprs(ADT, desc(AVAL))` #' #' @param mode Selection mode (first or last) #' @@ -113,7 +112,7 @@ derive_extreme_event <- function(dataset, # Check input parameters assert_vars(by_vars, optional = TRUE) assert_list_of(events, "event") - assert_order_vars(order) + assert_expr_list(order) assert_data_frame( dataset, required_vars = by_vars @@ -134,7 +133,7 @@ derive_extreme_event <- function(dataset, event_order <- map(seq_len(length(events)), function(x) x) tmp_event_no <- get_new_tmp_var(dataset, prefix = "tmp_event_no") - selected_records_ls <- purrr::pmap( + selected_records_ls <- pmap( list(condition_ls, set_values_to_ls, event_order), function(x, y, z) { dataset %>% diff --git a/R/derive_extreme_records.R b/R/derive_extreme_records.R index 1c21e830ef..a637ee4674 100644 --- a/R/derive_extreme_records.R +++ b/R/derive_extreme_records.R @@ -1,10 +1,49 @@ #' Add the First or Last Observation for Each By Group as New Records #' -#' Add the first or last observation for each by group as new observations. It -#' can be used for example for adding the maximum or minimum value as a separate -#' visit. All variables of the selected observation are kept. This distinguish -#' `derive_extreme_records()` from `derive_summary_records()`, where only the by -#' variables are populated for the new records. +#' Add the first or last observation for each by group as new observations. The +#' new observations can be selected from the input dataset or an additional +#' dataset. This function can be used for adding the maximum or minimum value +#' as a separate visit. All variables of the selected observation are kept. This +#' distinguishes `derive_extreme_records()` from `derive_summary_records()`, +#' where only the by variables are populated for the new records. +#' +#' @param dataset Input dataset +#' +#' If `dataset_add` is not specified, the new records are selected from the +#' input dataset. In this case the variables specified by `by_vars` and +#' `order` are expected. +#' +#' @param dataset_ref Reference dataset +#' +#' The variables specified for `by_vars` are expected. For each +#' observation of the specified dataset a new observation is added to the +#' input dataset. +#' +#' @param dataset_add Additional dataset +#' +#' Observations from the specified dataset are added as new records to the +#' input dataset (`dataset`). +#' +#' All observations in the specified dataset fulfilling the condition +#' specified by `filter_source` are considered. If `mode` and `order` are +#' specified, the first or last observation within each by group, defined by +#' `by_vars`, is selected. +#' +#' If the argument is not specified, the input dataset (`dataset`) is used. +#' +#' The variables specified by the `by_vars` and `order` argument (if +#' applicable) are expected. +#' +#' @param by_vars Grouping variables +#' +#' If `dataset_ref` is specified, this argument must be specified. +#' +#' *Permitted Values*: list of variables created by `exprs()` +#' +#' @param filter_add Filter for additional dataset (`dataset_add`) +#' +#' Only observations in `dataset_add` fulfilling the specified condition are +#' considered. #' #' @param mode Selection mode (first or last) #' @@ -14,26 +53,61 @@ #' #' *Permitted Values:* `"first"`, `"last"` #' +#' @param check_type Check uniqueness? +#' +#' If `"warning"` or `"error"` is specified, the specified message is issued +#' if the observations of the (restricted) additional dataset are not unique +#' with respect to the by variables and the order. +#' +#' *Permitted Values*: `"none"`, `"warning"`, `"error"` +#' +#' @param exist_flag Existence flag +#' +#' The specified variable is added to the output dataset. +#' +#' For by groups with at least one observation in the additional dataset +#' (`dataset_add`) `exist_flag` is set to the value specified by the +#' `true_value` argument. +#' +#' For all other by groups `exist_flag` is set to the value specified by the +#' `false_value` argument. +#' +#' *Permitted Values:* Variable name +#' +#' @param true_value True value +#' +#' For new observations selected from the additional dataset (`dataset_add`), +#' `exist_flag` is set to the specified value. +#' +#' @param false_value False value +#' +#' For new observations not selected from the additional dataset +#' (`dataset_add`), `exist_flag` is set to the specified value. +#' +#' #' @param filter Filter for observations to consider #' +#' *Deprecated*, please use the above `filter_add` argument instead. +#' #' Only observations fulfilling the specified condition are taken into account -#' for selecting the first or last observation. If the parameter is not +#' for selecting the first or last observation. If the argument is not #' specified, all observations are considered. #' -#' *Default*: `NULL` -#' #' *Permitted Values*: a condition #' #' @inheritParams filter_extreme #' @inheritParams derive_summary_records #' #' @details -#' 1. The input dataset is restricted as specified by the `filter` parameter. +#' 1. The additional dataset (`dataset_add`) is restricted as specified by the +#' `filter_add` argument. #' 1. For each group (with respect to the variables specified for the -#' `by_vars` parameter) the first or last observation (with respect to the -#' order specified for the `order` parameter and the mode specified for the -#' `mode` parameter) is selected. -#' 1. The variables specified by the `set_values_to` parameter are added to +#' `by_vars` argument) the first or last observation (with respect to the +#' order specified for the `order` argument and the mode specified for the +#' `mode` argument) is selected. +#' 1. If `dataset_ref` is specified, observations which are in `dataset_ref` +#' but not in the selected records are added. +#' 1. The variables specified by the `set_values_to` argument are added to #' the selected observations. #' 1. The observations are added to input dataset. #' @@ -48,6 +122,8 @@ #' #' @examples #' library(tibble) +#' library(dplyr, warn.conflicts = FALSE) +#' library(lubridate) #' #' adlb <- tribble( #' ~USUBJID, ~AVISITN, ~AVAL, ~LBSEQ, @@ -67,7 +143,7 @@ #' by_vars = exprs(USUBJID), #' order = exprs(AVAL, AVISITN), #' mode = "first", -#' filter = !is.na(AVAL), +#' filter_add = !is.na(AVAL), #' set_values_to = exprs( #' AVISITN = 97, #' DTYPE = "MINIMUM" @@ -82,7 +158,7 @@ #' by_vars = exprs(USUBJID), #' order = exprs(desc(AVAL), AVISITN), #' mode = "first", -#' filter = !is.na(AVAL), +#' filter_add = !is.na(AVAL), #' set_values_to = exprs( #' AVISITN = 98, #' DTYPE = "MAXIMUM" @@ -101,42 +177,166 @@ #' DTYPE = "LOV" #' ) #' ) -derive_extreme_records <- function(dataset, +#' +#' # 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_extreme_records( +#' adrs, +#' dataset_ref = adsl, +#' dataset_add = adrs, +#' by_vars = exprs(STUDYID, USUBJID), +#' filter_add = PARAMCD == "OVR" & AVALC == "PD", +#' order = exprs(ADT), +#' exist_flag = AVALC, +#' true_value = "Y", +#' false_value = "N", +#' mode = "first", +#' set_values_to = exprs( +#' PARAMCD = "PD", +#' PARAM = "Disease Progression", +#' AVAL = yn_to_numeric(AVALC), +#' ANL01FL = "Y", +#' ADT = ADT +#' ) +#' ) +#' +#' # derive parameter indicating death +#' derive_extreme_records( +#' dataset_ref = adsl, +#' dataset_add = adsl, +#' by_vars = exprs(STUDYID, USUBJID), +#' filter_add = !is.na(DTHDT), +#' exist_flag = AVALC, +#' true_value = "Y", +#' false_value = "N", +#' mode = "first", +#' set_values_to = exprs( +#' PARAMCD = "DEATH", +#' PARAM = "Death", +#' ANL01FL = "Y", +#' ADT = DTHDT +#' ) +#' ) +derive_extreme_records <- function(dataset = NULL, + dataset_add = NULL, + dataset_ref = NULL, by_vars = NULL, - order, - mode, + order = NULL, + mode = NULL, + filter_add = NULL, check_type = "warning", - filter = NULL, - set_values_to) { - # Check input parameters - assert_vars(by_vars, optional = TRUE) - assert_order_vars(order) + exist_flag = NULL, + true_value = "Y", + false_value = "N", + set_values_to, + filter) { + if (!missing(filter)) { + deprecate_warn( + "0.11.0", + "derive_extreme_records(filter = )", + "derive_extreme_records(filter_add = )" + ) + filter_add <- enexpr(filter) + } + + # Check input arguments + assert_vars(by_vars, optional = is.null(dataset_ref)) + assert_expr_list(order, optional = TRUE) assert_data_frame( dataset, required_vars = expr_c( by_vars, extract_vars(order) - ) + ), + optional = TRUE + ) + mode <- assert_character_scalar( + mode, + values = c("first", "last"), + case_sensitive = FALSE, + optional = TRUE ) - mode <- assert_character_scalar(mode, values = c("first", "last"), case_sensitive = FALSE) check_type <- assert_character_scalar( check_type, values = c("none", "warning", "error"), case_sensitive = FALSE ) - filter <- assert_filter_cond(enexpr(filter), optional = TRUE) + exist_flag <- assert_symbol(enexpr(exist_flag), optional = TRUE) + filter_add <- assert_filter_cond(enexpr(filter_add), optional = TRUE) assert_varval_list(set_values_to) + if (is.null(dataset) && is.null(dataset_add)) { + abort(paste( + "Neither `dataset` nor `dataset_add` is specified.", + "At least one of them must be specified.", + sep = "\n" + )) + } # Create new observations - new_obs <- dataset %>% - filter_if(filter) %>% - filter_extreme( + if (is.null(dataset_add)) { + dataset_add <- dataset + } + new_add_obs <- filter_if(dataset_add, filter_add) + + if (!is.null(order)) { + new_add_obs <- filter_extreme( + new_add_obs, by_vars = by_vars, order = order, mode = mode, check_type = check_type - ) %>% - mutate(!!!set_values_to) + ) + } + + if (!is.null(dataset_ref)) { + add_vars <- colnames(dataset_add) + ref_vars <- colnames(dataset_ref) + + new_ref_obs <- anti_join( + select(dataset_ref, intersect(add_vars, ref_vars)), + select(new_add_obs, !!!by_vars), + by = map_chr(by_vars, as_name) + ) + + if (!is.null(exist_flag)) { + new_add_obs <- mutate(new_add_obs, !!exist_flag := true_value) + new_ref_obs <- mutate(new_ref_obs, !!exist_flag := false_value) + } + new_obs <- bind_rows(new_add_obs, new_ref_obs) + } else { + new_obs <- new_add_obs + } + + new_obs <- process_set_values_to( + new_obs, + set_values_to = set_values_to + ) # Create output dataset bind_rows(dataset, new_obs) diff --git a/R/derive_joined.R b/R/derive_joined.R index f4b7dad4e0..ef6c58aa4b 100644 --- a/R/derive_joined.R +++ b/R/derive_joined.R @@ -1,4 +1,5 @@ -#' Add Variables from an Additional Dataset Based on Conditions from Both Datasets +#' 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 @@ -31,8 +32,14 @@ #' 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 `exprs()`, e.g., `exprs(ADT, desc(AVAL))` or `NULL` +#' If an expression is named, e.g., `exprs(EXSTDT = +#' convert_dtc_to_dt(EXSTDTC), EXSEQ)`, a corresponding variable (`EXSTDT`) is +#' added to the additional dataset and can be used in the filter conditions +#' (`filter_add`, `filter_join`) and for `join_vars` and `new_vars`. The +#' variable is not included in the output dataset. +#' +#' *Permitted Values*: list of expressions created by `exprs()`, e.g., +#' `exprs(ADT, desc(AVAL))` or `NULL` #' #' @param new_vars Variables to add #' @@ -47,10 +54,15 @@ #' `old_var2` from `dataset_add` and adds them to the input dataset renaming #' `old_var2` to `new_var2`. #' +#' Values of the added variables can be modified by specifying an expression. +#' For example, `new_vars = LASTRSP = exprs(str_to_upper(AVALC))` adds the +#' variable `LASTRSP` to the dataset and sets it to the upper case value of +#' `AVALC`. +#' #' 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 `exprs()` +#' *Permitted Values*: list of variables or named expressions created by `exprs()` #' #' @param join_vars Variables to use from additional dataset #' @@ -60,9 +72,15 @@ #' in both the input dataset and the additional dataset, the suffix ".join" is #' added to the variable from the additional dataset. #' +#' If an expression is named, e.g., `exprs(EXTDT = +#' convert_dtc_to_dt(EXSTDTC))`, a corresponding variable is added to the +#' additional dataset and can be used in the filter conditions (`filter_add`, +#' `filter_join`) and for `new_vars`. The variable is not included in the +#' output dataset. +#' #' The variables are not included in the output dataset. #' -#' *Permitted Values*: list of variables created by `exprs()` +#' *Permitted Values*: list of variables or named expressions created by `exprs()` #' #' @param filter_add Filter for additional dataset (`dataset_add`) #' @@ -70,6 +88,9 @@ #' joined to the input dataset. If the argument is not specified, all #' observations are joined. #' +#' Variables created by `order` or `new_vars` arguments can be used in the +#' condition. +#' #' *Permitted Values*: a condition #' #' @param filter_join Filter for the joined dataset @@ -77,6 +98,9 @@ #' The specified condition is applied to the joined dataset. Therefore #' variables from both datasets `dataset` and `dataset_add` can be used. #' +#' Variables created by `order` or `new_vars` arguments can be used in the +#' condition. +#' #' *Permitted Values*: a condition #' #' @param mode Selection mode @@ -91,8 +115,8 @@ #' @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. +#' 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 @@ -104,24 +128,33 @@ #' #' @details #' -#' 1. The records from the additional dataset (`dataset_add`) are restricted -#' to those matching the `filter_add` condition. +#' 1. The variables specified by `order` are added to the additional dataset +#' (`dataset_add`). #' -#' 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 variables specified by `join_vars` are added to the additional dataset +#' (`dataset_add`). #' -#' 1. The joined dataset is restricted by the `filter_join` condition. +#' 1. The records from the additional dataset (`dataset_add`) are restricted to +#' those matching the `filter_add` 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 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 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. +#' 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 created (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 as specified by +#' `missing_values` (or to `NA` for variables not in `missing_values`). +#' Observations in the additional dataset which have no matching observation in +#' the input dataset are ignored. +#' +#' @inheritParams derive_vars_merged #' #' @return The output dataset contains all observations and variables of the #' input dataset and additionally the variables specified for `new_vars` from @@ -257,6 +290,37 @@ #' join_vars = exprs(APERSDT, APEREDT), #' filter_join = APERSDT <= ASTDT & ASTDT <= APEREDT #' ) +#' +#' # Add day since last dose (LDRELD) +#' adae <- tribble( +#' ~USUBJID, ~ASTDT, ~AESEQ, +#' "1", "2020-02-02", 1, +#' "1", "2020-02-04", 2 +#' ) %>% +#' mutate(ASTDT = ymd(ASTDT)) +#' +#' ex <- tribble( +#' ~USUBJID, ~EXSDTC, +#' "1", "2020-01-10", +#' "1", "2020-01", +#' "1", "2020-01-20", +#' "1", "2020-02-03" +#' ) +#' +#' ## Please note that EXSDT is created via the order argument and then used +#' ## for new_vars, filter_add, and filter_join +#' derive_vars_joined( +#' adae, +#' dataset_add = ex, +#' by_vars = exprs(USUBJID), +#' order = exprs(EXSDT = convert_dtc_to_dt(EXSDTC)), +#' new_vars = exprs(LDRELD = compute_duration( +#' start_date = EXSDT, end_date = ASTDT +#' )), +#' filter_add = !is.na(EXSDT), +#' filter_join = EXSDT <= ASTDT, +#' mode = "last" +#' ) derive_vars_joined <- function(dataset, dataset_add, by_vars = NULL, @@ -266,17 +330,23 @@ derive_vars_joined <- function(dataset, filter_add = NULL, filter_join = NULL, mode = NULL, + missing_values = 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_expr_list(order, optional = TRUE) + assert_expr_list(new_vars, optional = TRUE) + assert_expr_list(join_vars, optional = TRUE) assert_data_frame(dataset, required_vars = by_vars_left) assert_data_frame( dataset_add, - required_vars = expr_c(by_vars, join_vars, extract_vars(order), new_vars) + required_vars = expr_c( + by_vars, + extract_vars(order), + setdiff(extract_vars(join_vars), replace_values_by_names(order)) + ) ) + filter_add <- assert_filter_cond(enexpr(filter_add), optional = TRUE) filter_join <- assert_filter_cond(enexpr(filter_join), optional = TRUE) @@ -296,8 +366,15 @@ derive_vars_joined <- function(dataset, # 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)) + data_right <- dataset_add %>% + mutate(!!!order, !!!join_vars) %>% + filter_if(filter_add) %>% + select( + !!!by_vars, + !!!chr2vars(names(order)), + !!!replace_values_by_names(join_vars), + !!!intersect(unname(extract_vars(new_vars)), chr2vars(colnames(dataset_add))) + ) # join dataset (if no by variable, a full join is performed) data_joined <- left_join( @@ -316,7 +393,11 @@ derive_vars_joined <- function(dataset, data_return <- filter_extreme( data_return, by_vars = expr_c(by_vars_left, tmp_obs_nr), - order = add_suffix_to_vars(order, vars = common_vars, suffix = ".join"), + order = add_suffix_to_vars( + replace_values_by_names(order), + vars = common_vars, + suffix = ".join" + ), mode = mode, check_type = check_type ) @@ -325,13 +406,10 @@ derive_vars_joined <- function(dataset, # 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") - ), + dataset_add = data_return, by_vars = exprs(!!!by_vars_left, !!tmp_obs_nr), + new_vars = add_suffix_to_vars(new_vars, vars = common_vars, suffix = ".join"), + missing_values = missing_values, duplicate_msg = paste( paste( "After applying `filter_join` the joined dataset contains more", diff --git a/R/derive_locf_records.R b/R/derive_locf_records.R index 6f6b985544..e4a2e6ca2c 100644 --- a/R/derive_locf_records.R +++ b/R/derive_locf_records.R @@ -26,10 +26,10 @@ #' #' *Permitted Values*: a variable #' -#' @param order List of variables for sorting a dataset +#' @param order Sort order #' -#' The dataset is sorted by `order` before carrying the last -#' observation forward (eg. `AVAL`) within each `by_vars`. +#' The dataset is sorted by `order` before carrying the last observation +#' forward (e.g. `AVAL`) within each `by_vars`. #' #' @param keep_vars Variables that need carrying the last observation forward #' @@ -120,7 +120,7 @@ derive_locf_records <- function(dataset, # Check if input parameters is a valid list of variables assert_vars(by_vars, optional = TRUE) assert_vars(keep_vars, optional = TRUE) - assert_order_vars(order) + assert_expr_list(order) # Check by_vars and order variables in input datasets assert_data_frame(dataset_expected_obs) diff --git a/R/derive_merged.R b/R/derive_merged.R index 1d4b4cb705..0b46d62e29 100644 --- a/R/derive_merged.R +++ b/R/derive_merged.R @@ -15,16 +15,27 @@ #' The variables specified by the `by_vars`, the `new_vars`, and the `order` #' argument are expected. #' +#' @param by_vars Grouping variables +#' +#' The input dataset and the selected observations from the additional dataset +#' are merged by the specified by variables. The by variables must be a unique +#' key of the selected observations. Variables from the additional dataset can +#' be renamed by naming the element, i.e., `by_vars = +#' exprs( = )`, similar to +#' the dplyr joins. +#' +#' *Permitted Values*: list of variables created by `exprs()` +#' #' @param order Sort order #' #' 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. #' -#' *Default*: `NULL` +#' Variables defined by the `new_vars` argument can be used in the sort order. #' -#' *Permitted Values*: list of variables or `desc()` function calls -#' created by `exprs()`, e.g., `exprs(ADT, desc(AVAL))` or `NULL` +#' *Permitted Values*: list of expressions created by `exprs()`, e.g., +#' `exprs(ADT, desc(AVAL))` or `NULL` #' #' @param new_vars Variables to add #' @@ -39,12 +50,26 @@ #' `old_var2` from `dataset_add` and adds them to the input dataset renaming #' `old_var2` to `new_var2`. #' +#' Values of the added variables can be modified by specifying an expression. +#' For example, `new_vars = LASTRSP = exprs(str_to_upper(AVALC))` adds the +#' variable `LASTRSP` to the dataset and sets it to the upper case value of +#' `AVALC`. +#' #' If the argument is not specified or set to `NULL`, all variables from the #' additional dataset (`dataset_add`) are added. #' -#' *Default*: `NULL` +#' *Permitted Values*: list of variables or named expressions created by `exprs()` #' -#' *Permitted Values*: list of variables created by `exprs()` +#' @param filter_add Filter for additional dataset (`dataset_add`) +#' +#' Only observations fulfilling the specified condition are taken into account +#' for merging. If the argument is not specified, all observations are +#' considered. +#' +#' Variables defined by the `new_vars` argument can be used in the filter +#' condition. +#' +#' *Permitted Values*: a condition #' #' @param mode Selection mode #' @@ -53,31 +78,8 @@ #' #' If the `order` argument is not specified, the `mode` argument is ignored. #' -#' *Default*: `NULL` -#' #' *Permitted Values*: `"first"`, `"last"`, `NULL` #' -#' @param by_vars Grouping variables -#' -#' The input dataset and the selected observations from the additional dataset -#' are merged by the specified by variables. The by variables must be a unique -#' key of the selected observations. Variables from the additional dataset can -#' be renamed by naming the element, i.e., `by_vars = -#' exprs( = )`, similar to -#' the dplyr joins. -#' -#' *Permitted Values*: list of variables created by `exprs()` -#' -#' @param filter_add Filter for additional dataset (`dataset_add`) -#' -#' Only observations fulfilling the specified condition are taken into account -#' for merging. If the argument is not specified, all observations are -#' considered. -#' -#' *Default*: `NULL` -#' -#' *Permitted Values*: a condition -#' #' @param match_flag Match flag #' #' If the argument is specified (e.g., `match_flag = FLAG`), the specified @@ -85,18 +87,24 @@ #' be `TRUE` for all selected records from `dataset_add` which are merged into #' the input dataset, and `NA` otherwise. #' -#' *Default*: `NULL` -#' #' *Permitted Values*: Variable name #' +#' @param missing_values Values for non-matching observations +#' +#' For observations of the input dataset (`dataset`) which do not have a +#' matching observation in the additional dataset (`dataset_add`) the values +#' of the specified variables are set to the specified value. Only variables +#' specified for `new_vars` can be specified for `missing_values`. +#' +#' *Permitted Values*: named list of expressions, e.g., +#' `exprs(BASEC = "MISSING", BASE = -1)` +#' #' @param check_type Check uniqueness? #' #' If `"warning"` or `"error"` is specified, the specified message is issued #' if the observations of the (restricted) additional dataset are not unique #' with respect to the by variables and the order. #' -#' *Default*: `"warning"` -#' #' *Permitted Values*: `"none"`, `"warning"`, `"error"` #' #' @param duplicate_msg Message of unique check @@ -116,19 +124,22 @@ #' #' @details #' +#' 1. The new variables (`new_vars`) are added to the additional dataset +#' (`dataset_add`). +#' #' 1. The records from the additional dataset (`dataset_add`) are restricted #' to those matching the `filter_add` condition. #' #' 1. If `order` is specified, for each by group 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 using `left_join()`. I.e., the output dataset -#' contains all observations from the input dataset. For observations without -#' a matching observation in the additional dataset the new variables are set -#' to `NA`. Observations in the additional dataset which have no matching -#' observation in the input dataset are ignored. -#' +#' 1. The variables specified for `new_vars` are merged to the input dataset +#' using `left_join()`. I.e., the output dataset contains all observations +#' from the input dataset. For observations without a matching observation in +#' the additional dataset the new variables are set as specified by +#' `missing_values` (or to `NA` for variables not in `missing_values`). +#' Observations in the additional dataset which have no matching observation +#' in the input dataset are ignored. #' #' @family der_gen #' @keywords der_gen @@ -136,26 +147,55 @@ #' @export #' #' @examples -#' library(admiral.test) #' library(dplyr, warn.conflicts = FALSE) -#' data("admiral_vs") -#' data("admiral_dm") +#' vs <- tribble( +#' ~STUDYID, ~DOMAIN, ~USUBJID, ~VSTESTCD, ~VISIT, ~VSSTRESN, ~VSSTRESU, ~VSDTC, +#' "PILOT01", "VS", "01-1302", "HEIGHT", "SCREENING", 177.8, "cm", "2013-08-20", +#' "PILOT01", "VS", "01-1302", "WEIGHT", "SCREENING", 81.19, "kg", "2013-08-20", +#' "PILOT01", "VS", "01-1302", "WEIGHT", "BASELINE", 82.1, "kg", "2013-08-29", +#' "PILOT01", "VS", "01-1302", "WEIGHT", "WEEK 2", 81.19, "kg", "2013-09-15", +#' "PILOT01", "VS", "01-1302", "WEIGHT", "WEEK 4", 82.56, "kg", "2013-09-24", +#' "PILOT01", "VS", "01-1302", "WEIGHT", "WEEK 6", 80.74, "kg", "2013-10-08", +#' "PILOT01", "VS", "01-1302", "WEIGHT", "WEEK 8", 82.1, "kg", "2013-10-22", +#' "PILOT01", "VS", "01-1302", "WEIGHT", "WEEK 12", 82.1, "kg", "2013-11-05", +#' "PILOT01", "VS", "17-1344", "HEIGHT", "SCREENING", 163.5, "cm", "2014-01-01", +#' "PILOT01", "VS", "17-1344", "WEIGHT", "SCREENING", 58.06, "kg", "2014-01-01", +#' "PILOT01", "VS", "17-1344", "WEIGHT", "BASELINE", 58.06, "kg", "2014-01-11", +#' "PILOT01", "VS", "17-1344", "WEIGHT", "WEEK 2", 58.97, "kg", "2014-01-24", +#' "PILOT01", "VS", "17-1344", "WEIGHT", "WEEK 4", 57.97, "kg", "2014-02-07", +#' "PILOT01", "VS", "17-1344", "WEIGHT", "WEEK 6", 58.97, "kg", "2014-02-19", +#' "PILOT01", "VS", "17-1344", "WEIGHT", "WEEK 8", 57.79, "kg", "2014-03-14" +#' ) +#' +#' dm <- tribble( +#' ~STUDYID, ~DOMAIN, ~USUBJID, ~AGE, ~AGEU, +#' "PILOT01", "DM", "01-1302", 61, "YEARS", +#' "PILOT01", "DM", "17-1344", 64, "YEARS" +#' ) +#' #' #' # Merging all dm variables to vs #' derive_vars_merged( -#' admiral_vs, -#' dataset_add = select(admiral_dm, -DOMAIN), +#' vs, +#' dataset_add = select(dm, -DOMAIN), #' by_vars = exprs(STUDYID, USUBJID) #' ) %>% -#' select(STUDYID, USUBJID, VSTESTCD, VISIT, VSTPT, VSSTRESN, AGE, AGEU) +#' select(STUDYID, USUBJID, VSTESTCD, VISIT, VSSTRESN, AGE, AGEU) +#' #' #' # Merge last weight to adsl -#' data("admiral_adsl") +#' adsl <- tribble( +#' ~STUDYID, ~USUBJID, ~AGE, ~AGEU, +#' "PILOT01", "01-1302", 61, "YEARS", +#' "PILOT01", "17-1344", 64, "YEARS" +#' ) +#' +#' #' derive_vars_merged( -#' admiral_adsl, -#' dataset_add = admiral_vs, +#' adsl, +#' dataset_add = vs, #' by_vars = exprs(STUDYID, USUBJID), -#' order = exprs(VSDTC), +#' order = exprs(convert_dtc_to_dtm(VSDTC)), #' mode = "last", #' new_vars = exprs(LASTWGT = VSSTRESN, LASTWGTU = VSSTRESU), #' filter_add = VSTESTCD == "WEIGHT", @@ -163,43 +203,26 @@ #' ) %>% #' select(STUDYID, USUBJID, AGE, AGEU, LASTWGT, LASTWGTU, vsdatafl) #' -#' # Derive treatment start datetime (TRTSDTM) -#' data(admiral_ex) -#' -#' ## Impute exposure start date to first date/time -#' ex_ext <- derive_vars_dtm( -#' admiral_ex, -#' dtc = EXSTDTC, -#' new_vars_prefix = "EXST", -#' highest_imputation = "M", -#' ) -#' -#' ## Add first exposure datetime and imputation flags to adsl -#' derive_vars_merged( -#' select(admiral_dm, STUDYID, USUBJID), -#' dataset_add = ex_ext, -#' by_vars = exprs(STUDYID, USUBJID), -#' new_vars = exprs(TRTSDTM = EXSTDTM, TRTSDTF = EXSTDTF, TRTSTMF = EXSTTMF), -#' order = exprs(EXSTDTM), -#' mode = "first" -#' ) #' #' # Derive treatment start datetime (TRTSDTM) -#' data(admiral_ex) -#' +#' ex <- tribble( +#' ~STUDYID, ~DOMAIN, ~USUBJID, ~EXSTDY, ~EXENDY, ~EXSTDTC, ~EXENDTC, +#' "PILOT01", "EX", "01-1302", 1, 18, "2013-08-29", "2013-09-15", +#' "PILOT01", "EX", "01-1302", 19, 69, "2013-09-16", "2013-11-05", +#' "PILOT01", "EX", "17-1344", 1, 14, "2014-01-11", "2014-01-24", +#' "PILOT01", "EX", "17-1344", 15, 63, "2014-01-25", "2014-03-14" +#' ) #' ## Impute exposure start date to first date/time #' ex_ext <- derive_vars_dtm( -#' admiral_ex, +#' ex, #' dtc = EXSTDTC, #' new_vars_prefix = "EXST", #' highest_imputation = "M", #' ) -#' #' ## Add first exposure datetime and imputation flags to adsl #' derive_vars_merged( -#' select(admiral_dm, STUDYID, USUBJID), +#' select(dm, STUDYID, USUBJID), #' dataset_add = ex_ext, -#' filter_add = !is.na(EXSTDTM), #' by_vars = exprs(STUDYID, USUBJID), #' new_vars = exprs(TRTSDTM = EXSTDTM, TRTSDTF = EXSTDTF, TRTSTMF = EXSTTMF), #' order = exprs(EXSTDTM), @@ -209,15 +232,14 @@ #' # Derive treatment end datetime (TRTEDTM) #' ## Impute exposure end datetime to last time, no date imputation #' ex_ext <- derive_vars_dtm( -#' admiral_ex, +#' ex, #' dtc = EXENDTC, #' new_vars_prefix = "EXEN", #' time_imputation = "last", #' ) -#' #' ## Add last exposure datetime and imputation flag to adsl #' derive_vars_merged( -#' select(admiral_dm, STUDYID, USUBJID), +#' select(adsl, STUDYID, USUBJID), #' dataset_add = ex_ext, #' filter_add = !is.na(EXENDTM), #' by_vars = exprs(STUDYID, USUBJID), @@ -225,27 +247,81 @@ #' order = exprs(EXENDTM), #' mode = "last" #' ) +#' # Modify merged values and set value for non matching observations +#' adsl <- tribble( +#' ~USUBJID, ~SEX, ~COUNTRY, +#' "ST42-1", "F", "AUT", +#' "ST42-2", "M", "MWI", +#' "ST42-3", "M", "NOR", +#' "ST42-4", "F", "UGA" +#' ) +#' +#' advs <- tribble( +#' ~USUBJID, ~PARAMCD, ~AVISIT, ~AVISITN, ~AVAL, +#' "ST42-1", "WEIGHT", "BASELINE", 0, 66, +#' "ST42-1", "WEIGHT", "WEEK 2", 1, 68, +#' "ST42-2", "WEIGHT", "BASELINE", 0, 88, +#' "ST42-3", "WEIGHT", "WEEK 2", 1, 55, +#' "ST42-3", "WEIGHT", "WEEK 4", 2, 50 +#' ) +#' +#' derive_vars_merged( +#' adsl, +#' dataset_add = advs, +#' by_vars = exprs(USUBJID), +#' new_vars = exprs( +#' LSTVSCAT = if_else(AVISIT == "BASELINE", "BASELINE", "POST-BASELINE") +#' ), +#' order = exprs(AVISITN), +#' mode = "last", +#' missing_values = exprs(LSTVSCAT = "MISSING") +#' ) derive_vars_merged <- function(dataset, dataset_add, by_vars, order = NULL, new_vars = NULL, - mode = NULL, filter_add = NULL, + mode = NULL, match_flag = NULL, + missing_values = NULL, check_type = "warning", duplicate_msg = NULL) { filter_add <- assert_filter_cond(enexpr(filter_add), optional = TRUE) assert_vars(by_vars) by_vars_left <- replace_values_by_names(by_vars) by_vars_right <- chr2vars(paste(vars2chr(by_vars))) - assert_order_vars(order, optional = TRUE) - assert_vars(new_vars, optional = TRUE) + assert_expr_list(order, optional = TRUE) + assert_expr_list(new_vars, optional = TRUE) assert_data_frame(dataset, required_vars = by_vars_left) - assert_data_frame(dataset_add, required_vars = expr_c(by_vars_right, extract_vars(order), new_vars)) + assert_data_frame( + dataset_add, + required_vars = expr_c( + by_vars_right, + setdiff(extract_vars(order), replace_values_by_names(new_vars)), + extract_vars(new_vars) + ) + ) match_flag <- assert_symbol(enexpr(match_flag), optional = TRUE) + assert_expr_list(missing_values, named = TRUE, optional = TRUE) + if (!is.null(missing_values)) { + invalid_vars <- setdiff( + names(missing_values), + vars2chr(replace_values_by_names(new_vars)) + ) + if (length(invalid_vars) > 0) { + abort(paste( + "The variables", + enumerate(invalid_vars), + "were specified for `missing_values` but not for `new_vars`." + )) + } + } + + add_data <- dataset_add %>% + mutate(!!!new_vars) %>% + filter_if(filter_add) - add_data <- filter_if(dataset_add, filter_add) if (!is.null(order)) { add_data <- filter_extreme( add_data, @@ -268,12 +344,20 @@ derive_vars_merged <- function(dataset, ) } if (!is.null(new_vars)) { - add_data <- select(add_data, !!!by_vars_right, !!!new_vars) + add_data <- add_data %>% + select(!!!by_vars_right, !!!replace_values_by_names(new_vars)) + } + + if (!is.null(missing_values)) { + match_flag_var <- get_new_tmp_var(add_data, prefix = "tmp_match_flag") + } else { + match_flag_var <- match_flag } - if (!is.null(match_flag)) { + + if (!is.null(match_flag_var)) { add_data <- mutate( add_data, - !!match_flag := TRUE + !!match_flag_var := TRUE ) } # check if there are any variables in both datasets which are not by vars @@ -297,171 +381,28 @@ derive_vars_merged <- function(dataset, ) )) } - left_join(dataset, add_data, by = vars2chr(by_vars)) -} + dataset <- left_join(dataset, add_data, by = vars2chr(by_vars)) -#' Merge a (Imputed) Date Variable -#' -#' @description -#' `r lifecycle::badge("deprecated")` -#' -#' This function is *deprecated*, please use `derive_vars_dt()` and -#' `derive_vars_merged()` instead. -#' -#' Merge a imputed date variable and date imputation flag from a dataset to the -#' input dataset. The observations to merge can be selected by a condition -#' and/or selecting the first or last observation for each by group. -#' -#' @param dataset_add Additional dataset -#' -#' The variables specified by the `by_vars`, the `dtc`, and the `order` -#' argument are expected. -#' -#' @param order Sort order -#' -#' 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). -#' -#' Please note that `NA` is considered as the last value. I.e., if a order -#' variable is `NA` and `mode = "last"`, this observation is chosen while for -#' `mode = "first"` the observation is chosen only if there are no -#' observations where the variable is not 'NA'. -#' -#' *Default*: `NULL` -#' -#' *Permitted Values*: list of variables or `desc()` function calls -#' created by `exprs()`, e.g., `exprs(ADT, desc(AVAL)` or `NULL` -#' -#' @inheritParams derive_vars_merged -#' @inheritParams derive_vars_dt -#' -#' @return The output dataset contains all observations and variables of the -#' input dataset and additionally the variable `DT` and -#' optionally the variable `DTF` derived from the additional -#' dataset (`dataset_add`). -#' -#' @details -#' -#' 1. The additional dataset is restricted to the observations matching the -#' `filter_add` condition. -#' -#' 1. The date variable and if requested, the date imputation flag is added to -#' the additional dataset. -#' -#' 1. If `order` is specified, for each by group the first or last observation -#' (depending on `mode`) is selected. -#' -#' 1. The date and flag variables are merged to the input dataset. -#' -#' @keywords deprecated -#' @family deprecated -#' -#' @export -#' -derive_vars_merged_dt <- function(dataset, - dataset_add, - by_vars, - order = NULL, - new_vars_prefix, - filter_add = NULL, - mode = NULL, - dtc, - date_imputation = NULL, - flag_imputation = "auto", - min_dates = NULL, - max_dates = NULL, - preserve = FALSE, - check_type = "warning", - duplicate_msg = NULL) { - deprecate_stop( - "0.8.0", - "derive_vars_merged_dt()", - details = "Please use `derive_vars_dt()` and `derive_vars_merged()` instead." - ) + if (!is.null(missing_values)) { + update_missings <- map2( + syms(names(missing_values)), + missing_values, + ~ expr(if_else(is.na(!!match_flag_var), !!.y, !!.x)) + ) + names(update_missings) <- names(missing_values) + dataset <- dataset %>% + mutate(!!!update_missings) %>% + remove_tmp_vars() + } + dataset } -#' Merge a (Imputed) Datetime Variable +#' Merge a Categorization Variable #' #' @description #' `r lifecycle::badge("deprecated")` #' -#' This function is *deprecated*, please use `derive_vars_dtm()` and -#' `derive_vars_merged()` instead. -#' -#' Merge a imputed datetime variable, date imputation flag, and time imputation -#' flag from a dataset to the input dataset. The observations to merge can be -#' selected by a condition and/or selecting the first or last observation for -#' each by group. -#' -#' @param dataset_add Additional dataset -#' -#' The variables specified by the `by_vars`, the `dtc`, and the `order` -#' argument are expected. -#' -#' @param order Sort order -#' -#' 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). -#' -#' *Default*: `NULL` -#' -#' *Permitted Values*: list of variables or `desc()` function calls -#' created by `exprs()`, e.g., `exprs(ADT, desc(AVAL)` or `NULL` -#' -#' @inheritParams derive_vars_merged -#' @inheritParams derive_vars_dtm -#' -#' @return The output dataset contains all observations and variables of the -#' input dataset and additionally the variable `DT` and -#' optionally the variables `DTF` and `TMF` -#' derived from the additional dataset (`dataset_add`). -#' -#' @details -#' -#' 1. The additional dataset is restricted to the observations matching the -#' `filter_add` condition. -#' -#' 1. The datetime variable and if requested, the date imputation flag and -#' time imputation flag is added to the additional dataset. -#' -#' 1. If `order` is specified, for each by group the first or last observation -#' (depending on `mode`) is selected. -#' -#' 1. The date and flag variables are merged to the input dataset. -#' -#' @keywords deprecated -#' @family deprecated -#' -#' @export -#' -derive_vars_merged_dtm <- function(dataset, - dataset_add, - by_vars, - order = NULL, - new_vars_prefix, - filter_add = NULL, - mode = NULL, - dtc, - date_imputation = NULL, - time_imputation = "00:00:00", - flag_imputation = "auto", - min_dates = NULL, - max_dates = NULL, - preserve = FALSE, - check_type = "warning", - duplicate_msg = NULL) { - deprecate_stop( - "0.8.0", - "derive_vars_merged_dtm()", - details = "Please use `derive_vars_dtm()` and `derive_vars_merged()` instead." - ) -} - -#' Merge a Categorization Variable +#' This function is *deprecated*, please use `derive_vars_merged()` instead. #' #' Merge a categorization variable from a dataset to the input dataset. The #' observations to merge can be selected by a condition and/or selecting the @@ -510,17 +451,35 @@ derive_vars_merged_dtm <- function(dataset, #' 1. The categorization variable is merged to the input dataset. #' #' -#' @family der_gen -#' @keywords der_gen +#' @family deprecated +#' @keywords deprecated #' #' @export #' #' @examples -#' library(admiral.test) #' library(dplyr, warn.conflicts = FALSE) -#' data("admiral_dm") -#' data("admiral_vs") #' +#' vs <- tribble( +#' ~STUDYID, ~DOMAIN, ~USUBJID, ~VISIT, ~VSTESTCD, ~VSSTRESN, ~VSSEQ, ~VSDTC, +#' "PILOT01", "VS", "04-1127", "SCREENING", "HEIGHT", 165.1, 43, "2013-09-16", +#' "PILOT01", "VS", "04-1127", "SCREENING", "WEIGHT", 42.87, 142, "2013-09-16", +#' "PILOT01", "VS", "04-1127", "BASELINE", "WEIGHT", 41.05, 143, "2013-10-02", +#' "PILOT01", "VS", "04-1127", "WEEK 2", "WEIGHT", 42.64, 144, "2013-10-16", +#' "PILOT01", "VS", "04-1127", "WEEK 4", "WEIGHT", 41.73, 145, "2013-10-30", +#' "PILOT01", "VS", "04-1127", "WEEK 26", "WEIGHT", 43.09, 152, "2014-03-31", +#' "PILOT01", "VS", "06-1049", "SCREENING", "HEIGHT", 167.64, 28, "2013-04-30", +#' "PILOT01", "VS", "06-1049", "SCREENING", "WEIGHT", 57.61, 92, "2013-04-30", +#' "PILOT01", "VS", "06-1049", "BASELINE", "WEIGHT", 57.83, 93, "2013-05-14", +#' "PILOT01", "VS", "06-1049", "WEEK 2", "WEIGHT", 58.29, 94, "2013-05-28", +#' "PILOT01", "VS", "06-1049", "WEEK 4", "WEIGHT", 58.97, 95, "2013-06-11" +#' ) +#' +#' dm <- tribble( +#' ~STUDYID, ~DOMAIN, ~USUBJID, ~AGE, ~AGEU, +#' "PILOT01", "DM", "01-1057", 59, "YEARS", +#' "PILOT01", "DM", "04-1127", 84, "YEARS", +#' "PILOT01", "DM", "06-1049", 60, "YEARS" +#' ) #' wgt_cat <- function(wgt) { #' case_when( #' wgt < 50 ~ "low", @@ -530,8 +489,8 @@ derive_vars_merged_dtm <- function(dataset, #' } #' #' derive_var_merged_cat( -#' admiral_dm, -#' dataset_add = admiral_vs, +#' dm, +#' dataset_add = vs, #' by_vars = exprs(STUDYID, USUBJID), #' order = exprs(VSDTC, VSSEQ), #' filter_add = VSTESTCD == "WEIGHT" & substr(VISIT, 1, 9) == "SCREENING", @@ -542,10 +501,12 @@ derive_vars_merged_dtm <- function(dataset, #' ) %>% #' select(STUDYID, USUBJID, AGE, AGEU, WGTBLCAT) #' +#' +#' #' # defining a value for missing VS data #' derive_var_merged_cat( -#' admiral_dm, -#' dataset_add = admiral_vs, +#' dm, +#' dataset_add = vs, #' by_vars = exprs(STUDYID, USUBJID), #' order = exprs(VSDTC, VSSEQ), #' filter_add = VSTESTCD == "WEIGHT" & substr(VISIT, 1, 9) == "SCREENING", @@ -566,30 +527,31 @@ derive_var_merged_cat <- function(dataset, filter_add = NULL, mode = NULL, missing_value = NA_character_) { + deprecate_warn("0.11.0", "derive_var_merged_cat()", "derive_vars_merged()") new_var <- assert_symbol(enexpr(new_var)) source_var <- assert_symbol(enexpr(source_var)) filter_add <- assert_filter_cond(enexpr(filter_add), optional = TRUE) assert_data_frame(dataset_add, required_vars = expr_c(by_vars, source_var)) - add_data <- filter_if(dataset_add, filter_add) %>% - mutate(!!new_var := cat_fun(!!source_var)) derive_vars_merged( dataset, - dataset_add = add_data, + dataset_add = dataset_add, + filter_add = !!filter_add, by_vars = by_vars, order = order, - new_vars = exprs(!!new_var), - match_flag = temp_match_flag, - mode = mode - ) %>% - mutate(!!new_var := if_else(temp_match_flag, !!new_var, missing_value, missing_value)) %>% - select(-temp_match_flag) + new_vars = exprs(!!new_var := {{ cat_fun }}(!!source_var)), + mode = mode, + missing_values = exprs(!!new_var := !!missing_value) + ) } #' Merge an Existence Flag #' -#' Adds a flag variable to the input dataset which indicates if there exists at -#' least one observation in another dataset fulfilling a certain condition. +#' @description Adds a flag variable to the input dataset which indicates if +#' there exists at least one observation in another dataset fulfilling a certain +#' condition. +#' +#' **Note:** This is a wrapper function for the more generic `derive_vars_merged()`. #' #' @param dataset_add Additional dataset #' @@ -665,23 +627,51 @@ derive_var_merged_cat <- function(dataset, #' #' @examples #' -#' library(admiral.test) #' library(dplyr, warn.conflicts = FALSE) -#' data("admiral_dm") -#' data("admiral_ae") +#' +#' dm <- tribble( +#' ~STUDYID, ~DOMAIN, ~USUBJID, ~AGE, ~AGEU, +#' "PILOT01", "DM", "01-1028", 71, "YEARS", +#' "PILOT01", "DM", "04-1127", 84, "YEARS", +#' "PILOT01", "DM", "06-1049", 60, "YEARS" +#' ) +#' +#' ae <- tribble( +#' ~STUDYID, ~DOMAIN, ~USUBJID, ~AETERM, ~AEREL, +#' "PILOT01", "AE", "01-1028", "ERYTHEMA", "POSSIBLE", +#' "PILOT01", "AE", "01-1028", "PRURITUS", "PROBABLE", +#' "PILOT01", "AE", "06-1049", "SYNCOPE", "POSSIBLE", +#' "PILOT01", "AE", "06-1049", "SYNCOPE", "PROBABLE" +#' ) +#' +#' #' derive_var_merged_exist_flag( -#' admiral_dm, -#' dataset_add = admiral_ae, +#' dm, +#' dataset_add = ae, #' by_vars = exprs(STUDYID, USUBJID), #' new_var = AERELFL, #' condition = AEREL == "PROBABLE" #' ) %>% #' select(STUDYID, USUBJID, AGE, AGEU, AERELFL) #' -#' data("admiral_vs") +#' vs <- tribble( +#' ~STUDYID, ~DOMAIN, ~USUBJID, ~VISIT, ~VSTESTCD, ~VSSTRESN, ~VSBLFL, +#' "PILOT01", "VS", "01-1028", "SCREENING", "HEIGHT", 177.8, NA, +#' "PILOT01", "VS", "01-1028", "SCREENING", "WEIGHT", 98.88, NA, +#' "PILOT01", "VS", "01-1028", "BASELINE", "WEIGHT", 99.34, "Y", +#' "PILOT01", "VS", "01-1028", "WEEK 4", "WEIGHT", 98.88, NA, +#' "PILOT01", "VS", "04-1127", "SCREENING", "HEIGHT", 165.1, NA, +#' "PILOT01", "VS", "04-1127", "SCREENING", "WEIGHT", 42.87, NA, +#' "PILOT01", "VS", "04-1127", "BASELINE", "WEIGHT", 41.05, "Y", +#' "PILOT01", "VS", "04-1127", "WEEK 4", "WEIGHT", 41.73, NA, +#' "PILOT01", "VS", "06-1049", "SCREENING", "HEIGHT", 167.64, NA, +#' "PILOT01", "VS", "06-1049", "SCREENING", "WEIGHT", 57.61, NA, +#' "PILOT01", "VS", "06-1049", "BASELINE", "WEIGHT", 57.83, "Y", +#' "PILOT01", "VS", "06-1049", "WEEK 4", "WEIGHT", 58.97, NA +#' ) #' derive_var_merged_exist_flag( -#' admiral_dm, -#' dataset_add = admiral_vs, +#' dm, +#' dataset_add = vs, #' by_vars = exprs(STUDYID, USUBJID), #' filter_add = VSTESTCD == "WEIGHT" & VSBLFL == "Y", #' new_var = WTBLHIFL, @@ -721,6 +711,11 @@ derive_var_merged_exist_flag <- function(dataset, #' Merge a Character Variable #' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' This function is *deprecated*, please use `derive_vars_merged()` instead. +#' #' Merge a character variable from a dataset to the input dataset. The #' observations to merge can be selected by a condition and/or selecting the #' first or last observation for each by group. @@ -773,27 +768,10 @@ derive_var_merged_exist_flag <- function(dataset, #' 1. The character variable is merged to the input dataset. #' #' -#' @family der_gen -#' @keywords der_gen +#' @family deprecated +#' @keywords deprecated #' #' @export -#' -#' @examples -#' library(admiral.test) -#' library(dplyr, warn.conflicts = FALSE) -#' data("admiral_dm") -#' data("admiral_ds") -#' -#' derive_var_merged_character( -#' admiral_dm, -#' dataset_add = admiral_ds, -#' by_vars = exprs(STUDYID, USUBJID), -#' new_var = DISPSTAT, -#' filter_add = DSCAT == "DISPOSITION EVENT", -#' source_var = DSDECOD, -#' case = "title" -#' ) %>% -#' select(STUDYID, USUBJID, AGE, AGEU, DISPSTAT) derive_var_merged_character <- function(dataset, dataset_add, by_vars, @@ -804,6 +782,8 @@ derive_var_merged_character <- function(dataset, filter_add = NULL, mode = NULL, missing_value = NA_character_) { + deprecate_warn("0.11.0", "derive_var_merged_character()", "derive_vars_merged()") + new_var <- assert_symbol(enexpr(new_var)) source_var <- assert_symbol(enexpr(source_var)) case <- @@ -826,19 +806,16 @@ derive_var_merged_character <- function(dataset, } else if (case == "title") { trans <- expr(str_to_title(!!source_var)) } - add_data <- filter_if(dataset_add, filter_add) %>% - mutate(!!new_var := !!trans) derive_vars_merged( dataset, - dataset_add = add_data, + dataset_add = dataset_add, by_vars = by_vars, order = order, - new_vars = exprs(!!new_var), - match_flag = temp_match_flag, - mode = mode - ) %>% - mutate(!!new_var := if_else(temp_match_flag, !!new_var, missing_value, missing_value)) %>% - select(-temp_match_flag) + new_vars = exprs(!!new_var := !!trans), + filter_add = !!filter_add, + mode = mode, + missing_values = exprs(!!new_var := !!missing_value) + ) } @@ -875,25 +852,48 @@ derive_var_merged_character <- function(dataset, #' @export #' #' @examples -#' library(admiral.test) -#' library(tibble) #' library(dplyr, warn.conflicts = FALSE) -#' data("admiral_vs") +#' vs <- tribble( +#' ~STUDYID, ~DOMAIN, ~USUBJID, ~VISIT, ~VSTESTCD, ~VSTEST, +#' "PILOT01", "VS", "01-1028", "SCREENING", "HEIGHT", "Height", +#' "PILOT01", "VS", "01-1028", "SCREENING", "TEMP", "Temperature", +#' "PILOT01", "VS", "01-1028", "BASELINE", "TEMP", "Temperature", +#' "PILOT01", "VS", "01-1028", "WEEK 4", "TEMP", "Temperature", +#' "PILOT01", "VS", "01-1028", "SCREENING 1", "WEIGHT", "Weight", +#' "PILOT01", "VS", "01-1028", "BASELINE", "WEIGHT", "Weight", +#' "PILOT01", "VS", "01-1028", "WEEK 4", "WEIGHT", "Weight", +#' "PILOT01", "VS", "04-1325", "SCREENING", "HEIGHT", "Height", +#' "PILOT01", "VS", "04-1325", "SCREENING", "TEMP", "Temperature", +#' "PILOT01", "VS", "04-1325", "BASELINE", "TEMP", "Temperature", +#' "PILOT01", "VS", "04-1325", "WEEK 4", "TEMP", "Temperature", +#' "PILOT01", "VS", "04-1325", "SCREENING 1", "WEIGHT", "Weight", +#' "PILOT01", "VS", "04-1325", "BASELINE", "WEIGHT", "Weight", +#' "PILOT01", "VS", "04-1325", "WEEK 4", "WEIGHT", "Weight", +#' "PILOT01", "VS", "10-1027", "SCREENING", "HEIGHT", "Height", +#' "PILOT01", "VS", "10-1027", "SCREENING", "TEMP", "Temperature", +#' "PILOT01", "VS", "10-1027", "BASELINE", "TEMP", "Temperature", +#' "PILOT01", "VS", "10-1027", "WEEK 4", "TEMP", "Temperature", +#' "PILOT01", "VS", "10-1027", "SCREENING 1", "WEIGHT", "Weight", +#' "PILOT01", "VS", "10-1027", "BASELINE", "WEIGHT", "Weight", +#' "PILOT01", "VS", "10-1027", "WEEK 4", "WEIGHT", "Weight" +#' ) +#' #' param_lookup <- tribble( -#' ~VSTESTCD, ~VSTEST, ~PARAMCD, ~PARAM, -#' "SYSBP", "Systolic Blood Pressure", "SYSBP", "Systolic Blood Pressure (mmHg)", -#' "WEIGHT", "Weight", "WEIGHT", "Weight (kg)", -#' "HEIGHT", "Height", "HEIGHT", "Height (cm)", -#' "TEMP", "Temperature", "TEMP", "Temperature (C)", -#' "MAP", "Mean Arterial Pressure", "MAP", "Mean Arterial Pressure (mmHg)", -#' "BMI", "Body Mass Index", "BMI", "Body Mass Index(kg/m^2)", -#' "BSA", "Body Surface Area", "BSA", "Body Surface Area(m^2)" +#' ~VSTESTCD, ~VSTEST, ~PARAMCD, ~PARAM, +#' "SYSBP", "Systolic Blood Pressure", "SYSBP", "Syst Blood Pressure (mmHg)", +#' "WEIGHT", "Weight", "WEIGHT", "Weight (kg)", +#' "HEIGHT", "Height", "HEIGHT", "Height (cm)", +#' "TEMP", "Temperature", "TEMP", "Temperature (C)", +#' "MAP", "Mean Arterial Pressure", "MAP", "Mean Art Pressure (mmHg)", +#' "BMI", "Body Mass Index", "BMI", "Body Mass Index(kg/m^2)", +#' "BSA", "Body Surface Area", "BSA", "Body Surface Area(m^2)" #' ) +#' #' derive_vars_merged_lookup( -#' dataset = admiral_vs, +#' dataset = vs, #' dataset_add = param_lookup, #' by_vars = exprs(VSTESTCD), -#' new_vars = exprs(PARAMCD), +#' new_vars = exprs(PARAMCD, PARAM), #' print_not_mapped = TRUE #' ) derive_vars_merged_lookup <- function(dataset, @@ -964,7 +964,9 @@ get_not_mapped <- function() { #' Merge a Summary Variable #' -#' Merge a summary variable from a dataset to the input dataset. +#' @description Merge a summary variable from a dataset to the input dataset. +#' +#' **Note:** This is a wrapper function for the more generic `derive_vars_merged`. #' #' @param dataset Input dataset #' @@ -1038,16 +1040,16 @@ get_not_mapped <- function() { #' #' # 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 +#' ~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( @@ -1068,19 +1070,19 @@ get_not_mapped <- function() { #' ) #' #' 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" +#' ~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( diff --git a/R/derive_param_computed.R b/R/derive_param_computed.R index c72f793814..85cfc6ba18 100644 --- a/R/derive_param_computed.R +++ b/R/derive_param_computed.R @@ -9,13 +9,24 @@ #' #' @param dataset Input dataset #' -#' The variables specified by the `by_vars` parameter, `PARAMCD`, and `AVAL` -#' are expected. +#' The variables specified by the `by_vars` parameter are expected. #' #' The variable specified by `by_vars` and `PARAMCD` must be a unique key of #' the input dataset after restricting it by the filter condition (`filter` #' parameter) and to the parameters specified by `parameters`. #' +#' @param dataset_add Additional dataset +#' +#' The variables specified by the `by_vars` parameter are expected. +#' +#' The variable specified by `by_vars` and `PARAMCD` must be a unique key of +#' the additional dataset after restricting it to the parameters specified by +#' `parameters`. +#' +#' If the argument is specified, the observations of the additional dataset +#' are considered in addition to the observations from the input dataset +#' (`dataset` restricted by `filter`). +#' #' @param filter Filter condition #' #' The specified condition is applied to the input dataset before deriving the @@ -30,7 +41,28 @@ #' derive the new parameter are specified for this parameter or the #' `constant_parameters` parameter. #' -#' *Permitted Values:* A character vector of `PARAMCD` values +#' If observations should be considered which do not have a parameter code, +#' e.g., if an SDTM dataset is used, temporary parameter codes can be derived +#' by specifying a list of expressions. The name of the element defines the +#' temporary parameter code and the expression the condition for selecting the +#' records. For example `parameters = exprs(HGHT = VSTESTCD == "HEIGHT")` +#' selects the observations with `VSTESTCD == "HEIGHT"` from the input data +#' (`dataset` and `dataset_add`), sets `PARAMCD = "HGHT"` for these +#' observations, and adds them to the observations to consider. +#' +#' Unnamed elements in the list of expressions are considered as parameter +#' codes. For example, `parameters = exprs(WEIGHT, HGHT = VSTESTCD == +#' "HEIGHT")` uses the parameter code `"WEIGHT"` and creates a temporary +#' parameter code `"HGHT"`. +#' +#' *Permitted Values:* A character vector of `PARAMCD` values or a list of expressions +#' +#' @param analysis_var Analysis variable +#' +#' The specified variable is set to the value of `analysis_value` for the new +#' observations. +#' +#' *Permitted Values*: An unquoted symbol #' #' @param by_vars Grouping variables #' @@ -48,7 +80,21 @@ #' weight is measured at each visit. Height could be specified in the #' `constant_parameters` parameter. (Refer to Example 2) #' -#' *Permitted Values:* A character vector of `PARAMCD` values +#' If observations should be considered which do not have a parameter code, +#' e.g., if an SDTM dataset is used, temporary parameter codes can be derived +#' by specifying a list of expressions. The name of the element defines the +#' temporary parameter code and the expression the condition for selecting the +#' records. For example `constant_parameters = exprs(HGHT = VSTESTCD == +#' "HEIGHT")` selects the observations with `VSTESTCD == "HEIGHT"` from the +#' input data (`dataset` and `dataset_add`), sets `PARAMCD = "HGHT"` for these +#' observations, and adds them to the observations to consider. +#' +#' Unnamed elements in the list of expressions are considered as parameter +#' codes. For example, `constant_parameters = exprs(WEIGHT, HGHT = VSTESTCD == +#' "HEIGHT")` uses the parameter code `"WEIGHT"` and creates a temporary +#' parameter code `"HGHT"`. +#' +#' *Permitted Values:* A character vector of `PARAMCD` values or a list of expressions #' #' @param constant_by_vars By variables for constant parameters #' @@ -60,8 +106,11 @@ #' @param analysis_value Definition of the analysis value #' #' An expression defining the analysis value (`AVAL`) of the new parameter is -#' expected. The analysis values of the parameters specified by `parameters` -#' can be accessed using `AVAL.`, e.g., `AVAL.SYSBP`. +#' expected. The values of variables of the parameters specified by +#' `parameters` can be accessed using `.`, +#' e.g., `AVAL.SYSBP`. +#' +#' Variable names in the expression must not contain more than one dot. #' #' *Permitted Values:* An unquoted expression #' @@ -75,15 +124,15 @@ #' #' @details For each group (with respect to the variables specified for the #' `by_vars` parameter) an observation is added to the output dataset if the -#' filtered input dataset contains exactly one observation for each parameter -#' code specified for `parameters`. +#' filtered input dataset (`dataset`) or the additional dataset +#' (`dataset_add`) contains exactly one observation for each parameter code +#' specified for `parameters`. #' #' For the new observations `AVAL` is set to the value specified by #' `analysis_value` and the variables specified for `set_values_to` are set to #' the provided values. The values of the other variables of the input dataset #' are set to `NA`. #' -#' #' @return The input dataset with the new parameter added. Note, a variable will only #' be populated in the new parameter rows if it is specified in `by_vars`. #' @@ -98,15 +147,15 @@ #' #' # Example 1: Derive MAP #' 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", -#' "01-701-1015", "SYSBP", "Systolic Blood Pressure (mmHg)", 121, "mmHg", "BASELINE", -#' "01-701-1015", "SYSBP", "Systolic Blood Pressure (mmHg)", 121, "mmHg", "WEEK 2", -#' "01-701-1028", "DIABP", "Diastolic Blood Pressure (mmHg)", 79, "mmHg", "BASELINE", -#' "01-701-1028", "DIABP", "Diastolic Blood Pressure (mmHg)", 80, "mmHg", "WEEK 2", -#' "01-701-1028", "SYSBP", "Systolic Blood Pressure (mmHg)", 130, "mmHg", "BASELINE", -#' "01-701-1028", "SYSBP", "Systolic Blood Pressure (mmHg)", 132, "mmHg", "WEEK 2" +#' ~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", +#' "01-701-1015", "SYSBP", "Systolic Blood Pressure (mmHg)", 121, "mmHg", "BASELINE", +#' "01-701-1015", "SYSBP", "Systolic Blood Pressure (mmHg)", 121, "mmHg", "WEEK 2", +#' "01-701-1028", "DIABP", "Diastolic Blood Pressure (mmHg)", 79, "mmHg", "BASELINE", +#' "01-701-1028", "DIABP", "Diastolic Blood Pressure (mmHg)", 80, "mmHg", "WEEK 2", +#' "01-701-1028", "SYSBP", "Systolic Blood Pressure (mmHg)", 130, "mmHg", "BASELINE", +#' "01-701-1028", "SYSBP", "Systolic Blood Pressure (mmHg)", 132, "mmHg", "WEEK 2" #' ) #' #' derive_param_computed( @@ -123,15 +172,15 @@ #' #' # Example 2: Derive BMI where height is measured only once #' 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", -#' "01-701-1015", "WEIGHT", "Weight (kg)", 54.4, "kg", "BASELINE", -#' "01-701-1015", "WEIGHT", "Weight (kg)", 53.1, "kg", "WEEK 2", -#' "01-701-1028", "HEIGHT", "Height (cm)", 163, "cm", "SCREENING", -#' "01-701-1028", "WEIGHT", "Weight (kg)", 78.5, "kg", "SCREENING", -#' "01-701-1028", "WEIGHT", "Weight (kg)", 80.3, "kg", "BASELINE", -#' "01-701-1028", "WEIGHT", "Weight (kg)", 80.7, "kg", "WEEK 2" +#' ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, +#' "01-701-1015", "HEIGHT", "Height (cm)", 147.0, "cm", "SCREENING", +#' "01-701-1015", "WEIGHT", "Weight (kg)", 54.0, "kg", "SCREENING", +#' "01-701-1015", "WEIGHT", "Weight (kg)", 54.4, "kg", "BASELINE", +#' "01-701-1015", "WEIGHT", "Weight (kg)", 53.1, "kg", "WEEK 2", +#' "01-701-1028", "HEIGHT", "Height (cm)", 163.0, "cm", "SCREENING", +#' "01-701-1028", "WEIGHT", "Weight (kg)", 78.5, "kg", "SCREENING", +#' "01-701-1028", "WEIGHT", "Weight (kg)", 80.3, "kg", "BASELINE", +#' "01-701-1028", "WEIGHT", "Weight (kg)", 80.7, "kg", "WEEK 2" #' ) #' #' derive_param_computed( @@ -147,32 +196,236 @@ #' constant_parameters = c("HEIGHT"), #' constant_by_vars = exprs(USUBJID) #' ) -derive_param_computed <- function(dataset, +#' +#' # Example 3: Using data from an additional dataset and other variables than AVAL +#' qs <- tibble::tribble( +#' ~USUBJID, ~AVISIT, ~QSTESTCD, ~QSORRES, ~QSSTRESN, +#' "1", "WEEK 2", "CHSF112", NA, 1, +#' "1", "WEEK 2", "CHSF113", "Yes", NA, +#' "1", "WEEK 2", "CHSF114", NA, 1, +#' "1", "WEEK 4", "CHSF112", NA, 2, +#' "1", "WEEK 4", "CHSF113", "No", NA, +#' "1", "WEEK 4", "CHSF114", NA, 1 +#' ) +#' +#' adchsf <- tibble::tribble( +#' ~USUBJID, ~AVISIT, ~PARAMCD, ~QSORRES, ~QSSTRESN, ~AVAL, +#' "1", "WEEK 2", "CHSF12", NA, 1, 6, +#' "1", "WEEK 2", "CHSF14", NA, 1, 6, +#' "1", "WEEK 4", "CHSF12", NA, 2, 12, +#' "1", "WEEK 4", "CHSF14", NA, 1, 6 +#' ) +#' +#' derive_param_computed( +#' adchsf, +#' dataset_add = qs, +#' by_vars = exprs(USUBJID, AVISIT), +#' parameters = exprs(CHSF12, CHSF13 = QSTESTCD %in% c("CHSF113", "CHSF213"), CHSF14), +#' analysis_value = case_when( +#' QSORRES.CHSF13 == "Not applicable" ~ 0, +#' QSORRES.CHSF13 == "Yes" ~ 38, +#' QSORRES.CHSF13 == "No" ~ if_else( +#' QSSTRESN.CHSF12 > QSSTRESN.CHSF14, +#' 25, +#' 0 +#' ) +#' ), +#' set_values_to = exprs(PARAMCD = "CHSF13") +#' ) +derive_param_computed <- function(dataset = NULL, + dataset_add = NULL, by_vars, parameters, + analysis_var = AVAL, analysis_value, set_values_to, filter = NULL, constant_by_vars = NULL, constant_parameters = NULL) { assert_vars(by_vars) + analysis_var <- assert_symbol(enexpr(analysis_var)) assert_vars(constant_by_vars, optional = TRUE) - assert_data_frame(dataset, required_vars = exprs(!!!by_vars, PARAMCD, AVAL)) + assert_data_frame(dataset, required_vars = by_vars, optional = TRUE) + assert_data_frame(dataset_add, optional = TRUE) filter <- assert_filter_cond(enexpr(filter), optional = TRUE) - params_available <- unique(dataset$PARAMCD) - assert_character_vector(parameters, values = params_available) - assert_character_vector(constant_parameters, values = params_available, optional = TRUE) assert_varval_list(set_values_to) - if (!is.null(set_values_to$PARAMCD)) { + if (!is.null(set_values_to$PARAMCD) && !is.null(dataset)) { assert_param_does_not_exist(dataset, set_values_to$PARAMCD) } + analysis_value <- enexpr(analysis_value) + + parameters <- assert_parameters_argument(parameters) + constant_parameters <- assert_parameters_argument(constant_parameters, optional = TRUE) # select observations and variables required for new observations - data_filtered <- dataset %>% - filter_if(filter) + if (is.null(dataset)) { + data_source <- dataset_add + } else { + data_source <- dataset %>% + filter_if(filter) %>% + bind_rows(dataset_add) + } - data_parameters <- data_filtered %>% - filter(PARAMCD %in% parameters) + hori_return <- get_hori_data( + data_source, + by_vars = by_vars, + parameters = parameters, + analysis_value = !!analysis_value, + filter = !!filter + ) + hori_data <- hori_return[["hori_data"]] + if (is.null(hori_data)) { + return(dataset) + } + analysis_vars_chr <- hori_return[["analysis_vars_chr"]] + + if (!is.null(constant_parameters)) { + hori_const_data <- get_hori_data( + data_source, + by_vars = constant_by_vars, + parameters = constant_parameters, + analysis_value = !!analysis_value, + filter = !!filter + )[["hori_data"]] + + if (is.null(hori_const_data)) { + return(dataset) + } + + hori_data <- inner_join(hori_data, hori_const_data, by = vars2chr(constant_by_vars)) + } + + # add analysis value (AVAL) and parameter variables, e.g., PARAMCD + hori_data <- hori_data %>% + # keep only observations where all analysis values are available + filter(!!!parse_exprs(map_chr( + analysis_vars_chr, + ~ str_c("!is.na(", .x, ")") + ))) %>% + process_set_values_to(exprs(!!analysis_var := !!analysis_value)) %>% + process_set_values_to(set_values_to) %>% + select(-all_of(analysis_vars_chr[str_detect(analysis_vars_chr, "\\.")])) + + bind_rows(dataset, hori_data) +} + +#' Asserts `parameters` Argument and Converts to List of Expressions +#' +#' The function asserts that the argument is a character vector or a list of +#' expressions. If it is a character vector, it converts it to a list of +#' symbols. +#' +#' @param parameters The argument to check +#' +#' @param optional Is the checked argument optional? If set to `FALSE` and +#' `parameters` is `NULL` then an error is thrown. +#' +#' @return The `parameters` argument (converted to a list of symbol, if it is a +#' character vector) +#' +#' @keywords other_advanced +#' @family other_advanced +assert_parameters_argument <- function(parameters, optional = TRUE) { + assert_logical_scalar(optional) + if (optional && is.null(parameters)) { + return(invisible(parameters)) + } + + if (typeof(parameters) == "character") { + parameters <- map(parameters, sym) + } else { + if (!inherits(parameters, "list") || any(!map_lgl( + parameters, + ~ is_call(.x) || is_expression(.x) + ))) { + abort( + paste0( + "`", + arg_name(substitute(parameters)), + "` must be a character vector or a list of expressions but it is ", + what_is_it(parameters), + "." + ) + ) + } + } + parameters +} + +#' Creating Temporary Parameters and `.` Variables +#' +#' The function creates temporary parameters and variables of the form +#' `.`, e.g., `AVAL.WEIGHT`. +#' +#' @param dataset Input dataset +#' +#' @param by_vars By variables +#' +#' @param parameters List of parameter codes +#' +#' The input dataset is restricted to the specified parameter codes. If an +#' expression is specified, a new parameter code is added to the input +#' dataset. The name of the element defines the parameter code and the +#' expression the observations to select. +#' +#' *Permitted Values:* A character vector of `PARAMCD` values or a list of expressions +#' +#' @param analysis_value +#' +#' All variables of the form `.` like `AVAL.WEIGHT` are +#' added to the input dataset. They are set to the value of the variable for +#' the parameter. E.g., `AVAL.WEIGHT` is set to the value of `AVAL` where +#' `PARAMCD == "WEIGHT"`. +#' +#' *Permitted Values:* An unquoted expression +#' +#' @param filter Filter condition used for restricting the input dataset +#' +#' The specified filter condition is used in the warnings only. It is not +#' applied to the input dataset. +#' +#' *Permitted Values:* An unquoted expression +#' +#' @return A dataset with one observation per by group. It contains the +#' variables specified for `by_vars` and all variables of the form +#' `.` occurring in `analysis_value`. +#' +#' @keywords other_advanced +#' @family other_advanced +get_hori_data <- function(dataset, + by_vars, + parameters, + analysis_value, + filter) { + assert_vars(by_vars) + assert_data_frame(dataset, required_vars = by_vars) + parameters <- assert_parameters_argument(parameters) + analysis_value <- enexpr(analysis_value) + filter <- assert_filter_cond(enexpr(filter), optional = TRUE) + + # determine parameter values + if (is.null(names(parameters))) { + param_values <- map(parameters, as_label) + } else { + param_values <- map2( + parameters, + names(parameters), + ~ if_else(.y == "", as_label(.x), .y) + ) + } + + new_params <- parameters[names(parameters) != ""] + new_names <- names(new_params) + + new_data <- vector("list", length(new_params)) + for (i in seq_along(new_params)) { + new_data[[i]] <- filter(dataset, !!new_params[[i]]) %>% + mutate(PARAMCD = new_names[[i]]) + } + + data_parameters <- dataset %>% + bind_rows(new_data) %>% + filter(PARAMCD %in% param_values) if (nrow(data_parameters) == 0L) { warn( @@ -180,15 +433,15 @@ derive_param_computed <- function(dataset, "The input dataset does not contain any observations fullfiling the filter condition (", expr_label(filter), ") for the parameter codes (PARAMCD) ", - enumerate(parameters), + enumerate(param_values), "\nNo new observations were added." ) ) - return(dataset) + return(list(hori_data = NULL)) } - params_available <- unique(data_filtered$PARAMCD) - params_missing <- setdiff(c(parameters, constant_parameters), params_available) + params_available <- unique(data_parameters$PARAMCD) + params_missing <- setdiff(param_values, params_available) if (length(params_missing) > 0) { warn( paste0( @@ -199,12 +452,9 @@ derive_param_computed <- function(dataset, "\nNo new observations were added." ) ) - return(dataset) + return(list(hori_data = NULL)) } - data_parameters <- data_parameters %>% - select(!!!by_vars, PARAMCD, AVAL) - signal_duplicate_records( data_parameters, by_vars = exprs(!!!by_vars, PARAMCD), @@ -217,59 +467,46 @@ derive_param_computed <- function(dataset, ) ) - # horizontalize data, AVAL for PARAMCD = "PARAMx" -> AVAL.PARAMx - hori_data <- data_parameters %>% - pivot_wider(names_from = PARAMCD, values_from = AVAL, names_prefix = "AVAL.") - - if (!is.null(constant_parameters)) { - data_const_parameters <- data_filtered %>% - filter(PARAMCD %in% constant_parameters) %>% - select(!!!exprs(!!!constant_by_vars, PARAMCD, AVAL)) - - hori_const_data <- data_const_parameters %>% - pivot_wider(names_from = PARAMCD, values_from = AVAL, names_prefix = "AVAL.") - - hori_data <- inner_join(hori_data, hori_const_data, by = vars2chr(constant_by_vars)) + # horizontalize data, e.g., AVAL for PARAMCD = "PARAMx" -> AVAL.PARAMx + analysis_vars <- extract_vars(analysis_value) + analysis_vars_chr <- vars2chr(analysis_vars) + multi_dot_names <- str_count(analysis_vars_chr, "\\.") > 1 + if (any(multi_dot_names)) { + abort( + paste( + "The `analysis_value` argument contains variable names with more than on dot:", + enumerate(analysis_vars_chr[multi_dot_names]), + sep = "\n" + ) + ) } + vars_hori <- analysis_vars_chr[str_detect(analysis_vars_chr, "\\.")] %>% + str_split(pattern = "\\.") %>% + map_chr(`[[`, 1) %>% + unique() - # add analysis value (AVAL) and parameter variables, e.g., PARAMCD - hori_data <- hori_data %>% - # keep only observations where all analysis values are available - filter(!!!parse_exprs(map_chr( - c(parameters, constant_parameters), - ~ str_c("!is.na(AVAL.", .x, ")") - ))) %>% - mutate(AVAL = !!enexpr(analysis_value), !!!set_values_to) %>% - select(-starts_with("AVAL.")) - - bind_rows(dataset, hori_data) -} + hori_data <- data_parameters + for (i in seq_along(vars_hori)) { + pivoted_data <- pivot_wider( + select(data_parameters, !!!by_vars, PARAMCD, sym(vars_hori[[i]])), + names_from = PARAMCD, + values_from = sym(vars_hori[[i]]), + names_prefix = paste0(vars_hori[[i]], ".") + ) + if (i == 1) { + hori_data <- pivoted_data + } else { + hori_data <- left_join( + hori_data, + pivoted_data, + by = vars2chr(by_vars) + ) + } + } -#' Adds a Parameter Computed from the Analysis Value of Other Parameters -#' -#' @description -#' `r lifecycle::badge("deprecated")` -#' -#' This function is deprecated. Please use `derive_param_computed()` instead. -#' -#' @inheritParams derive_param_computed -#' -#' -#' @return The input dataset with the new parameter added. Note, a variable will only -#' be populated in the new parameter rows if it is specified in `by_vars`. -#' -#' @keywords deprecated -#' @family deprecated -#' -#' @export -#' -derive_derived_param <- function(dataset, - by_vars, - parameters, - analysis_value, - set_values_to, - filter = NULL, - constant_by_vars = NULL, - constant_parameters = NULL) { - deprecate_stop("0.8.0", "derive_derived_param()", "derive_param_computed()") + list( + hori_data = bind_rows(hori_data) %>% + select(!!!by_vars, any_of(analysis_vars_chr)), + analysis_vars_chr = analysis_vars_chr + ) } diff --git a/R/derive_param_doseint.R b/R/derive_param_doseint.R index 80d0965e9b..82ec6a5384 100644 --- a/R/derive_param_doseint.R +++ b/R/derive_param_doseint.R @@ -1,8 +1,10 @@ #' Adds a Parameter for Dose Intensity #' -#' Adds a record for the dose intensity for each by group +#' @description Adds a record for the dose intensity for each by group #' (e.g., subject and visit) where the source parameters are available. #' +#' **Note:** This is a wrapper function for the more generic `derive_param_computed()`. +#' #' The analysis value of the new parameter is derived as #' Total Dose / Planned Dose * 100 #' @@ -124,33 +126,30 @@ derive_param_doseint <- function(dataset, assert_param_does_not_exist(dataset, set_values_to$PARAMCD) # Create Dose intensity records - dataset <- derive_param_computed( - dataset, - filter = !!filter, - parameters = c(tadm_code, tpadm_code), - by_vars = by_vars, - analysis_value = (!!sym(paste0("AVAL.", tadm_code)) / - !!sym(paste0("AVAL.", tpadm_code)) * 100), - set_values_to = exprs( - !!!set_values_to, - temp_planned_dose = !!sym(paste0("AVAL.", tpadm_code)), - temp_admin_dose = !!sym(paste0("AVAL.", tadm_code)) - ) - ) + aval_tadm <- sym(paste0("AVAL.", tadm_code)) + aval_tpdm <- sym(paste0("AVAL.", tpadm_code)) - # # handle 0 doses planned if needed + # handle 0 doses planned if needed if (zero_doses == "100") { - dataset <- mutate(dataset, + update_aval <- exprs( AVAL = case_when( - temp_planned_dose == 0 & - temp_admin_dose > 0 ~ 100, - temp_planned_dose == 0 & - temp_admin_dose == 0 ~ 0, + !!aval_tpdm == 0 & + !!aval_tadm > 0 ~ 100, + !!aval_tpdm == 0 & + !!aval_tadm == 0 ~ 0, TRUE ~ AVAL ) ) + } else { + update_aval <- NULL } - - dataset %>% select(-starts_with("temp")) + derive_param_computed( + dataset, + filter = !!filter, + parameters = c(tadm_code, tpadm_code), + by_vars = by_vars, + analysis_value = (!!aval_tadm / !!aval_tpdm * 100), + set_values_to = expr_c(set_values_to, update_aval) + ) } diff --git a/R/derive_param_exist_flag.R b/R/derive_param_exist_flag.R index 37d9268b70..786c4ec7ef 100644 --- a/R/derive_param_exist_flag.R +++ b/R/derive_param_exist_flag.R @@ -7,19 +7,19 @@ #' #' @param dataset Input dataset #' -#' The variables specified for `subject_keys` and the `PARAMCD` variable are +#' The variables specified for `by_vars` and the `PARAMCD` variable are #' expected. #' -#' @param dataset_adsl ADSL input dataset +#' @param dataset_ref Reference dataset, e.g., ADSL #' -#' The variables specified for `subject_keys` are expected. For each subject -#' (as defined by `subject_keys`) from the specified dataset (`dataset_adsl`), +#' The variables specified in `by_vars` are expected. For each group +#' (as defined by `by_vars`) from the specified dataset (`dataset_ref`), #' the existence flag is calculated and added as a new observation to the -#' input datasets (`dataset`) +#' input datasets (`dataset`). #' #' @param dataset_add Additional dataset #' -#' The variables specified by the `subject_keys` parameter are expected. +#' The variables specified by the `by_vars` parameter are expected. #' #' This dataset is used to check if an event occurred or not. Any observation #' in the dataset fulfilling the event condition (`condition`) is considered @@ -29,18 +29,18 @@ #' #' The condition is evaluated at the additional dataset (`dataset_add`). #' -#' For all subjects where it evaluates as `TRUE` at least once `AVALC` is set +#' For all groups where it evaluates as `TRUE` at least once `AVALC` is set #' to the true value (`true_value`) for the new observations. #' -#' For all subjects where it evaluates as `FALSE` or `NA` for all observations +#' For all groups where it evaluates as `FALSE` or `NA` for all observations #' `AVALC` is set to the false value (`false_value`). #' -#' For all subjects not present in the additional dataset `AVALC` is set to +#' For all groups not present in the additional dataset `AVALC` is set to #' the missing value (`missing_value`). #' #' @param true_value True value #' -#' For all subjects with at least one observations in the additional dataset +#' For all groups with at least one observations in the additional dataset #' (`dataset_add`) fulfilling the event condition (`condition`), `AVALC` is #' set to the specified value (`true_value`). #' @@ -50,7 +50,7 @@ #' #' @param false_value False value #' -#' For all subjects with at least one observations in the additional dataset +#' For all groups with at least one observations in the additional dataset #' (`dataset_add`) but none of them is fulfilling the event condition #' (`condition`), `AVALC` is set to the specified value (`false_value`). #' @@ -60,7 +60,7 @@ #' #' @param missing_value Values used for missing information #' -#' For all subjects without an observation in the additional dataset +#' For all groups without an observation in the additional dataset #' (`dataset_add`), `AVALC` is set to the specified value (`missing_value`). #' #' *Default*: `NA_character_` @@ -78,40 +78,39 @@ #' @param aval_fun Function to map character analysis value (`AVALC`) to numeric #' analysis value (`AVAL`) #' -#' The (first) argument of the function must expect a character vector and the -#' function must return a numeric vector. -#' -#' *Default:* `yn_to_numeric` (see `yn_to_numeric()` for details) +#' *Deprecated*, please use `set_values_to` instead. #' #' @param set_values_to Variables to set #' #' A named list returned by `exprs()` defining the variables to be set for the #' new parameter, e.g. `exprs(PARAMCD = "MDIS", PARAM = "Measurable Disease at #' Baseline")` is expected. The values must be symbols, character strings, -#' numeric values, or `NA`. +#' numeric values, `NA`, or expressions. #' -#' @param subject_keys Variables to uniquely identify a subject +#' @param by_vars Variables to uniquely identify a group #' #' A list of symbols created using `exprs()` is expected. #' +#' @param dataset_adsl *Deprecated*, please use `dataset_ref` instead. +#' +#' @param subject_keys *Deprecated*, please use `by_vars` instead. +#' #' @details #' 1. The additional dataset (`dataset_add`) is restricted to the observations #' matching the `filter_add` condition. #' -#' 1. For each subject in `dataset_adsl` a new observation is created. +#' 1. For each group in `dataset_ref` a new observation is created. #' #' - The `AVALC` variable is added and set to the true value (`true_value`) -#' if for the subject at least one observation exists in the (restricted) +#' if for the group at least one observation exists in the (restricted) #' additional dataset where the condition evaluates to `TRUE`. #' -#' - It is set to the false value (`false_value`) if for the subject at least +#' - It is set to the false value (`false_value`) if for the group at least #' one observation exists and for all observations the condition evaluates #' to `FALSE` or `NA`. #' #' - Otherwise, it is set to the missing value (`missing_value`), i.e., for -#' those subject not in `dataset_add`. -#' -#' 1. The `AVAL` variable is added and set to `aval_fun(AVALC)`. +#' those groups not in `dataset_add`. #' #' 1. The variables specified by the `set_values_to` parameter are added to #' the new observations. @@ -120,8 +119,8 @@ #' #' #' @return The input dataset with a new parameter indicating if an event -#' occurred (`AVALC`, `AVAL`, and the variables specified by `subject_keys` -#' and `set_value_to` are populated for the new parameter) +#' occurred (`AVALC` and the variables specified by `by_vars` +#' and `set_value_to` are populated for the new parameter). #' #' @family der_prm_bds_findings #' @@ -158,70 +157,97 @@ #' ) #' #' derive_param_exist_flag( -#' dataset_adsl = adsl, +#' dataset_ref = adsl, #' dataset_add = tu, #' filter_add = TUTESTCD == "TUMIDENT" & VISIT == "SCREENING", #' condition = TUSTRESC == "TARGET", #' false_value = "N", #' missing_value = "N", #' set_values_to = exprs( +#' AVAL = yn_to_numeric(AVALC), #' PARAMCD = "MDIS", #' PARAM = "Measurable Disease at Baseline" #' ) #' ) derive_param_exist_flag <- function(dataset = NULL, - dataset_adsl, + dataset_ref, dataset_add, condition, true_value = "Y", false_value = NA_character_, missing_value = NA_character_, filter_add = NULL, - aval_fun = yn_to_numeric, - subject_keys = get_admiral_option("subject_keys"), - set_values_to) { + aval_fun, + by_vars = get_admiral_option("subject_keys"), + set_values_to, + dataset_adsl, + subject_keys) { + ### BEGIN DEPRECATION + if (!missing(dataset_adsl)) { + deprecate_warn( + "0.11.0", "derive_param_exist_flag(dataset_adsl = )", + "derive_param_exit_flag(dataset_ref = )" + ) + # assign deprecated argument to new variable + dataset_ref <- dataset_adsl + } + + if (!missing(subject_keys)) { + deprecate_warn( + "0.11.0", "derive_param_exist_flag(subject_keys = )", + "derive_param_exit_flag(by_vars = )" + ) + # assign deprecated argument to new variable + by_vars <- subject_keys + } + ### END DEPRECATION + # Check input parameters condition <- assert_filter_cond(enexpr(condition)) assert_character_scalar(true_value) assert_character_scalar(false_value) assert_character_scalar(missing_value) filter_add <- assert_filter_cond(enexpr(filter_add), optional = TRUE) - assert_function(aval_fun) - assert_vars(subject_keys) + assert_vars(by_vars) assert_data_frame( dataset, - required_vars = exprs(PARAMCD, !!!subject_keys), + required_vars = exprs(PARAMCD, !!!by_vars), optional = TRUE ) - assert_data_frame(dataset_adsl, required_vars = subject_keys) - assert_data_frame(dataset_add, required_vars = subject_keys) + assert_data_frame(dataset_ref, required_vars = by_vars) + assert_data_frame(dataset_add, required_vars = by_vars) assert_varval_list(set_values_to, required_elements = "PARAMCD") if (!is.null(dataset)) { assert_param_does_not_exist(dataset, set_values_to$PARAMCD) } + if (!missing(aval_fun)) { + assert_function(aval_fun) + deprecate_warn( + "0.11.0", + "derive_param_exist_flag(aval_fun = )", + "derive_param_exist_flag(set_values_to = )" + ) + set_values_to <- exprs(!!!set_values_to, AVAL = aval_fun(AVALC)) + } + # Create new observations new_obs <- derive_var_merged_exist_flag( - dataset_adsl, + dataset_ref, dataset_add = dataset_add, filter_add = !!filter_add, condition = !!condition, - by_vars = subject_keys, + by_vars = by_vars, new_var = AVALC, true_value = true_value, false_value = false_value, missing_value = missing_value ) - new_obs <- call_user_fun(mutate(new_obs, AVAL = aval_fun(AVALC))) - if (!is.numeric(new_obs$AVAL)) { - abort(paste( - "Calling `aval_fun(AVALC)` did not result in a numeric vector.\n", - "A", typeof(new_obs$AVAL), "vector was returned." - )) - } - - new_obs <- mutate(new_obs, !!!set_values_to) + new_obs <- process_set_values_to( + new_obs, + set_values_to = set_values_to + ) # Create output dataset bind_rows(dataset, new_obs) diff --git a/R/derive_param_exposure.R b/R/derive_param_exposure.R index d4d91d5e18..652e9d2992 100644 --- a/R/derive_param_exposure.R +++ b/R/derive_param_exposure.R @@ -44,9 +44,8 @@ #' Set a list of variables to some specified value for the new observation(s) #' + LHS refer to a variable. It is expected that at least `PARAMCD` is defined. #' + RHS refers to the values to set to the variable. This can be a string, a symbol, a numeric -#' value or NA. +#' value, `NA`, or an expression. #' (e.g. `exprs(PARAMCD = "TDOSE",PARCAT1 = "OVERALL")`). -#' More general expression are not allowed. #' #' *Permitted Values:* List of variable-value pairs #' @@ -54,8 +53,6 @@ #' an observation is added to the output dataset and the defined values are set to the defined #' variables #' -#' -#' #' @return The input dataset with a new record added for each group (with respect to the variables #' specified for the `by_vars` parameter). That is, a variable will only #' be populated in this new record if it is specified in `by_vars`. diff --git a/R/derive_param_extreme_event.R b/R/derive_param_extreme_event.R index d4c1d36edb..0c240264c0 100644 --- a/R/derive_param_extreme_event.R +++ b/R/derive_param_extreme_event.R @@ -1,112 +1,14 @@ -#' Add a First Event Parameter +#' Add an Extreme 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 `exprs()` defining the variables to be set for the -#' new parameter, e.g. `exprs(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 `exprs()` 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. -#' -#' -#' @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 = exprs(STUDYID, USUBJID), - set_values_to, - check_type = "warning") { - ### DEPRECATION - deprecate_stop("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" - ) -} - -#' Add an Extreme Event Parameter +#' This function is *deprecated*, please use `derive_extreme_records()` instead. #' #' 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. +#' 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 #' @@ -124,7 +26,7 @@ derive_param_first_event <- function(dataset, #' specified by `filter_source` are considered as an event. #' #' The variables specified by the `subject_keys` and -#' `order` parameter (if applicable) are expected. +#' `order` argument (if applicable) are expected. #' #' @param filter_source Source filter #' @@ -139,8 +41,8 @@ derive_param_first_event <- function(dataset, #' #' List of symbols for sorting the source dataset (`dataset_source`). #' -#' *Permitted Values*: list of variables or `desc()` function calls -#' created by `exprs()`, e.g., `exprs(ADT, desc(AVAL))`. +#' *Permitted Values*: list of expressions created by `exprs()`, e.g., +#' `exprs(ADT, desc(AVAL))`. #' #' @param new_var New variable #' @@ -169,8 +71,8 @@ derive_param_first_event <- function(dataset, #' A named list returned by `exprs()` defining the variables to be set for the #' new parameter, e.g. `exprs(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. +#' `NA`, or an expression. 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 #' @@ -179,9 +81,9 @@ derive_param_first_event <- function(dataset, #' @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). +#' observations of the source dataset (`dataset_source`) restricted by +#' `filter_source` are not unique with respect to the subject keys +#' (`subject_key` argument) and `order`. #' #' *Permitted Values*: `"none"`, `"warning"`, `"error"` #' @@ -189,16 +91,16 @@ derive_param_first_event <- function(dataset, #' 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 +#' `subject_keys` argument) 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. +#' if applicable) where the event condition (`filter_source` argument) is fulfilled. #' 1. For each observation in `dataset_adsl` a new observation is created. For #' subjects with event `new_var` is set to `true_value`. For all other #' subjects `new_var` is set to `false_value`. #' 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 +#' 1. The variables specified by the `set_values_to` argument are added to #' the new observations. #' 1. The new observations are added to input dataset. #' @@ -206,78 +108,10 @@ derive_param_first_event <- function(dataset, #' @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 +#' @family deprecated +#' @keywords deprecated #' #' @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 = exprs(ADT), -#' new_var = AVALC, -#' true_value = "Y", -#' false_value = "N", -#' mode = "first", -#' set_values_to = exprs( -#' 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 = exprs( -#' PARAMCD = "DEATH", -#' PARAM = "Death", -#' ANL01FL = "Y", -#' ADT = DTHDT -#' ) -#' ) derive_param_extreme_event <- function(dataset = NULL, dataset_adsl, dataset_source, @@ -290,10 +124,12 @@ derive_param_extreme_event <- function(dataset = NULL, subject_keys = get_admiral_option("subject_keys"), set_values_to, check_type = "warning") { - # Check input parameters + deprecate_warn("0.11.0", "derive_param_extreme_event()", "derive_extreme_records()") + + # Check input arguments filter_source <- assert_filter_cond(enexpr(filter_source)) assert_vars(subject_keys) - assert_vars(order, optional = TRUE) + assert_expr_list(order, optional = TRUE) assert_data_frame(dataset_source, required_vars = exprs(!!!subject_keys, !!!extract_vars(order)) ) @@ -313,39 +149,22 @@ derive_param_extreme_event <- function(dataset = NULL, case_sensitive = FALSE ) assert_varval_list(set_values_to, required_elements = "PARAMCD") - if (!is.null(set_values_to$PARAMCD) & !is.null(dataset)) { + if (!is.null(set_values_to$PARAMCD) && !is.null(dataset)) { assert_param_does_not_exist(dataset, 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 - ) - - noevents <- anti_join( - select(dataset_adsl, intersect(source_vars, adsl_vars)), - select(events, !!!subject_keys), - by = sapply(subject_keys, as_name) + derive_extreme_records( + dataset, + dataset_add = dataset_source, + dataset_ref = dataset_adsl, + by_vars = subject_keys, + order = order, + mode = mode, + filter_add = !!filter_source, + check_type = check_type, + exist_flag = !!new_var, + true_value = true_value, + false_value = false_value, + set_values_to = set_values_to ) - - if (!is.null(new_var)) { - events <- mutate(events, !!new_var := true_value) - noevents <- mutate(noevents, !!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_extreme_record.R b/R/derive_param_extreme_record.R new file mode 100644 index 0000000000..d14753b984 --- /dev/null +++ b/R/derive_param_extreme_record.R @@ -0,0 +1,221 @@ +#' Adds a Parameter Based on First or Last Record from Multiple Sources +#' +#' Generates parameter based on the first or last observation from multiple +#' source datasets, based on user-defined filter, order and by group criteria. +#' All variables of the selected observation are kept. +#' +#' @param dataset Input dataset +#' +#' @param sources Sources +#' +#' A list of `records_source()` objects is expected. +#' +#' @param source_datasets Source datasets +#' +#' A named list of datasets is expected. The `dataset_name` field of +#' `records_source()` refers to the dataset provided in the list. The variables +#' specified by the `order` and the `by_vars` arguments are expected after applying `new_vars`. +#' +#' @param by_vars By variables +#' +#' If the argument is specified, for each by group the observations are +#' selected separately. +#' +#' @param order Sort order +#' +#' If the argument is set to a non-null value, for each by group the first or +#' last observation from the source datasets is selected with respect to +#' the specified order. Variables created via `new_vars` e.g., imputed date variables, +#' can be specified as well (see examples below). +#' +#' Please note that `NA` is considered as the last value. I.e., if a order +#' variable is `NA` and `mode = "last"`, this observation is chosen while for +#' `mode = "first"` the observation is chosen only if there are no +#' observations where the variable is not `NA`. +#' +#' *Permitted Values:* list of expressions created by `exprs()`, e.g., +#' `exprs(ADT, desc(AVAL))` +#' +#' @param mode Selection mode (first or last) +#' +#' If `"first"` is specified, for each by group the first observation with +#' respect to `order` is included in the output dataset. If `"last"` is +#' specified, the last observation is included in the output dataset. +#' +#' Permitted Values: `"first"`, `"last"` +#' +#' @param set_values_to Variables to be set +#' +#' The specified variables are set to the specified values for the new +#' observations. +#' +#' A list of variable name-value pairs is expected. +#' + LHS refers to a variable. +#' + RHS refers to the values to set to the variable. This can be a string, a +#' symbol, a numeric value or `NA`, e.g., `exprs(PARAMCD = "PD", PARAM = +#' "First Progressive Disease")`. +#' +#' @details The following steps are performed to create the output dataset: +#' +#' \enumerate{ +#' \item For each source dataset the observations as specified by +#' the `filter` element are selected. +#' +#' \item Variables specified by `new_vars` are created for each source dataset. +#' +#' \item The first or last observation (with respect to the +#' `order` variable) for each by group (specified by `by_vars`) from multiple sources +#' is selected and added to the input dataset. } +#' +#' @return +#' The input dataset with the first or last observation of each by group +#' added as new observations. +#' +#' @family der_prm_bds_findings +#' @keywords der_prm_bds_findings +#' +#' @export +#' @examples +#' aevent_samp <- tibble::tribble( +#' ~USUBJID, ~PARAMCD, ~PARAM, ~RSSTDTC, +#' "1", "PD", "First Progressive Disease", "2022-04-01", +#' "2", "PD", "First Progressive Disease", "2021-04-01", +#' "3", "PD", "First Progressive Disease", "2023-04-01" +#' ) +#' +#' cm <- tibble::tribble( +#' ~STUDYID, ~USUBJID, ~CMDECOD, ~CMSTDTC, +#' "1001", "1", "ACT", "2021-12-25" +#' ) +#' +#' pr <- tibble::tribble( +#' ~STUDYID, ~USUBJID, ~PRDECOD, ~PRSTDTC, +#' "1001", "1", "ACS", "2021-12-27", +#' "1001", "2", "ACS", "2020-12-25", +#' "1001", "3", "ACS", "2022-12-25", +#' ) +#' derive_param_extreme_record( +#' dataset = aevent_samp, +#' sources = list( +#' records_source( +#' dataset_name = "cm", +#' filter = CMDECOD == "ACT", +#' new_vars = exprs( +#' ADT = convert_dtc_to_dt(CMSTDTC), +#' AVALC = CMDECOD +#' ) +#' ), +#' records_source( +#' dataset_name = "pr", +#' filter = PRDECOD == "ACS", +#' new_vars = exprs( +#' ADT = convert_dtc_to_dt(PRSTDTC), +#' AVALC = PRDECOD +#' ) +#' ) +#' ), +#' source_datasets = list(cm = cm, pr = pr), +#' by_vars = exprs(USUBJID), +#' order = exprs(ADT), +#' mode = "first", +#' set_values_to = exprs( +#' PARAMCD = "FIRSTACT", +#' PARAM = "First Anti-Cancer Therapy" +#' ) +#' ) +derive_param_extreme_record <- function(dataset = NULL, + sources, + source_datasets, + by_vars = NULL, + order, + mode, + set_values_to) { + # Check arguments assertions + assert_data_frame(dataset, optional = TRUE) + assert_list_of(sources, "records_source") + assert_list_of(source_datasets, "data.frame") + assert_vars(by_vars, optional = TRUE) + assert_character_scalar( + mode, + values = c("first", "last"), + case_sensitive = FALSE + ) + assert_varval_list(set_values_to, accept_expr = TRUE, optional = TRUE) + + source_names <- names(source_datasets) + + # Create Empty list to contain source datasets + data_list <- vector("list", length(sources)) + + # Evaluate the expressions contained in the sources + for (i in seq_along(sources)) { + source_dataset <- source_datasets[[sources[[i]]$dataset_name]] + new_vars_colnames <- replace_values_by_names(sources[[i]]$new_vars) + data_list[[i]] <- source_dataset %>% + filter_if(sources[[i]]$filter) %>% + mutate(!!!sources[[i]]$new_vars) %>% + select(!!!by_vars, !!!new_vars_colnames) + } + + # Bind the source datasets together and parse out the extreme value + param_data <- bind_rows(data_list) %>% + filter_extreme(., + by_vars = by_vars, + order = order, + mode = mode + ) %>% + process_set_values_to( + set_values_to + ) + + # Bind the parameter rows back to original dataset + bind_rows(dataset, param_data) +} + +#' Create a `records_source` Object +#' +#' The `records_source` object is used to find extreme records of interest. +#' +#' @param dataset_name The name of the source dataset +#' +#' The name refers to the dataset provided by the `source_datasets` argument +#' of `derive_param_extreme_record()`. +#' +#' @param filter An unquoted condition for selecting the observations from +#' `dataset`. +#' +#' @param new_vars Variables to add +#' +#' The specified variables from the source datasets are added to the output +#' dataset. Variables can be renamed by naming the element, i.e., `new_vars = +#' exprs( = )`. +#' +#' For example `new_vars = exprs(var1, var2)` adds variables `var1` and `var2` +#' from to the input dataset. +#' +#' And `new_vars = exprs(var1, new_var2 = old_var2)` takes `var1` and +#' `old_var2` from the source dataset and adds them to the input dataset renaming +#' `old_var2` to `new_var2`. Expressions can be used to create new variables +#' (see for example `new_vars` argument in `derive_vars_merged()`). +#' +#' *Permitted Values:* list of expressions created by `exprs()`, e.g., +#' `exprs(ADT, desc(AVAL))` +#' +#' @keywords source_specifications +#' @family source_specifications +#' +#' @seealso [derive_param_extreme_record()] +#' +#' @return An object of class `records_source` +#' @export +records_source <- function(dataset_name, + filter = NULL, + new_vars) { + out <- list( + dataset_name = assert_character_scalar(dataset_name), + filter = assert_filter_cond(enexpr(filter), optional = TRUE), + new_vars = assert_expr_list(new_vars) + ) + class(out) <- c("records_source", "source", "list") + out +} diff --git a/R/derive_param_framingham.R b/R/derive_param_framingham.R index 8cdeca9beb..e14d9610b0 100644 --- a/R/derive_param_framingham.R +++ b/R/derive_param_framingham.R @@ -71,8 +71,6 @@ #' indicates whether a subject is treated for high blood #' pressure #' -#' @inheritParams derive_derived_param -#' #' @inheritParams derive_param_qtc #' #' @details diff --git a/R/derive_param_tte.R b/R/derive_param_tte.R index 28651ca946..a1419999f6 100644 --- a/R/derive_param_tte.R +++ b/R/derive_param_tte.R @@ -127,6 +127,8 @@ #' @family der_prm_tte #' @keywords der_prm_tte #' +#' @seealso [event_source()], [censor_source()] +#' #' @export #' #' @examples @@ -358,8 +360,8 @@ derive_param_tte <- function(dataset = NULL, ) ) assert_logical_scalar(create_datetime) - assert_varval_list(set_values_to, accept_expr = TRUE, optional = TRUE) - if (!is.null(set_values_to$PARAMCD) & !is.null(dataset)) { + assert_varval_list(set_values_to, optional = TRUE) + if (!is.null(set_values_to$PARAMCD) && !is.null(dataset)) { assert_param_does_not_exist(dataset, set_values_to$PARAMCD) } if (!is.null(by_vars)) { @@ -406,7 +408,7 @@ derive_param_tte <- function(dataset = NULL, ) start_date_imputation_flag <- gsub("(DT|DTM)$", "DTF", as_name(start_date)) - if (start_date_imputation_flag %in% colnames(dataset_adsl) & + if (start_date_imputation_flag %in% colnames(dataset_adsl) && as_name(start_date) != start_date_imputation_flag) { adsl_vars <- exprs( !!!adsl_vars, @@ -415,7 +417,7 @@ derive_param_tte <- function(dataset = NULL, } start_time_imputation_flag <- gsub("DTM$", "TMF", as_name(start_date)) - if (start_time_imputation_flag %in% colnames(dataset_adsl) & + if (start_time_imputation_flag %in% colnames(dataset_adsl) && as_name(start_date) != start_time_imputation_flag) { adsl_vars <- exprs( !!!adsl_vars, @@ -436,29 +438,8 @@ derive_param_tte <- function(dataset = NULL, inner_join( adsl, by = vars2chr(subject_keys) - ) - tryCatch( - new_param <- mutate(new_param, !!!set_values_to), - error = function(cnd) { - abort( - paste0( - "Assigning new variables failed!\n", - "set_values_to = (\n", - paste( - " ", - names(set_values_to), - "=", - set_values_to, - collapse = "\n" - ), - "\n)\nError message:\n ", - cnd - ) - ) - } - ) - - new_param <- new_param %>% + ) %>% + process_set_values_to(set_values_to) %>% mutate(!!date_var := pmax(!!date_var, !!start_var, na.rm = TRUE)) %>% remove_tmp_vars() @@ -607,17 +588,26 @@ filter_date_sources <- function(sources, data <- vector("list", length(sources)) for (i in seq_along(sources)) { - date <- sources[[i]]$date + source_date <- sources[[i]]$date source_dataset <- source_datasets[[sources[[i]]$dataset_name]] + if (is.symbol(source_date)) { + source_date_var <- source_date + } else { + source_date_var <- get_new_tmp_var(dataset = source_dataset, prefix = "tmp_date") + source_dataset <- mutate( + source_dataset, + !!source_date_var := !!source_date + ) + } assert_date_var( dataset = source_dataset, - var = !!date, + var = !!source_date_var, dataset_name = sources[[i]]$dataset_name ) data[[i]] <- source_dataset %>% filter_if(sources[[i]]$filter) %>% filter_extreme( - order = exprs(!!date), + order = exprs(!!source_date_var), by_vars = expr_c(subject_keys, by_vars), mode = mode, check_type = "none" @@ -625,9 +615,9 @@ filter_date_sources <- function(sources, # add date variable and accompanying variables if (create_datetime) { - date_derv <- exprs(!!date_var := as_datetime(!!date)) + date_derv <- exprs(!!date_var := as_datetime(!!source_date_var)) } else { - date_derv <- exprs(!!date_var := date(!!date)) + date_derv <- exprs(!!date_var := date(!!source_date_var)) } data[[i]] <- transmute( @@ -752,7 +742,8 @@ extend_source_datasets <- function(source_datasets, full_join( mutate(by_groups, temp_dummy = 1), mutate(source_datasets[[i]], temp_dummy = 1), - by = "temp_dummy" + by = "temp_dummy", + relationship = "many-to-many" ) %>% select(-temp_dummy) } @@ -772,11 +763,12 @@ extend_source_datasets <- function(source_datasets, #' @param filter An unquoted condition for selecting the observations from #' `dataset` which are events or possible censoring time points. #' -#' @param date A variable providing the date of the event or censoring. A date, -#' or a datetime can be specified. An unquoted symbol is expected. +#' @param date A variable or expression providing the date of the event or +#' censoring. A date, or a datetime can be specified. An unquoted symbol or +#' expression is expected. #' -#' Refer to `derive_vars_dt()` to impute and derive a date from a date -#' character vector to a date object. +#' Refer to `derive_vars_dt()` or `convert_dtc_to_dt()` to impute and derive a +#' date from a date character vector to a date object. #' #' @param censor Censoring value #' @@ -786,7 +778,7 @@ extend_source_datasets <- function(source_datasets, #' @param set_values_to A named list returned by `exprs()` defining the variables #' to be set for the event or censoring, e.g. `exprs(EVENTDESC = "DEATH", #' SRCDOM = "ADSL", SRCVAR = "DTHDT")`. The values must be a symbol, a -#' character string, a numeric value, or `NA`. +#' character string, a numeric value, an expression, or `NA`. #' #' #' @keywords source_specifications @@ -803,10 +795,11 @@ tte_source <- function(dataset_name, out <- list( dataset_name = assert_character_scalar(dataset_name), filter = assert_filter_cond(enexpr(filter), optional = TRUE), - date = assert_symbol(enexpr(date)), + date = assert_expr(enexpr(date)), censor = assert_integer_scalar(censor), - set_values_to = assert_varval_list( + set_values_to = assert_expr_list( set_values_to, + named = TRUE, optional = TRUE ) ) @@ -816,9 +809,11 @@ tte_source <- function(dataset_name, #' Create an `event_source` Object #' -#' `event_source` objects are used to define events as input for the +#' @description `event_source` objects are used to define events as input for the #' `derive_param_tte()` function. #' +#' **Note:** This is a wrapper function for the more generic `tte_source()`. +#' #' @inheritParams tte_source #' #' @@ -851,7 +846,7 @@ event_source <- function(dataset_name, out <- tte_source( dataset_name = assert_character_scalar(dataset_name), filter = !!enexpr(filter), - date = !!assert_symbol(enexpr(date)), + date = !!assert_expr(enexpr(date)), censor = 0, set_values_to = set_values_to ) @@ -861,9 +856,11 @@ event_source <- function(dataset_name, #' Create a `censor_source` Object #' -#' `censor_source` objects are used to define censorings as input for the +#' @description `censor_source` objects are used to define censorings as input for the #' `derive_param_tte()` function. #' +#' **Note:** This is a wrapper function for the more generic `tte_source()`. +#' #' @inheritParams tte_source #' #' @@ -896,7 +893,7 @@ censor_source <- function(dataset_name, out <- tte_source( dataset_name = assert_character_scalar(dataset_name), filter = !!enexpr(filter), - date = !!assert_symbol(enexpr(date)), + date = !!assert_expr(enexpr(date)), censor = assert_integer_scalar(censor, subset = "positive"), set_values_to = set_values_to ) @@ -949,7 +946,7 @@ list_tte_source_objects <- function(package = "admiral") { set_values_to = paste( paste( names(obj$set_values_to), - purrr::map_chr(obj$set_values_to, as_label), + map_chr(obj$set_values_to, as_label), sep = ": " ), collapse = "
" diff --git a/R/derive_summary_records.R b/R/derive_summary_records.R index f6f69041c8..9418e0cafd 100644 --- a/R/derive_summary_records.R +++ b/R/derive_summary_records.R @@ -44,9 +44,8 @@ #' A list of variable name-value pairs is expected. #' + LHS refers to a variable. #' + RHS refers to the values to set to the variable. This can be a string, a -#' symbol, a numeric value or `NA`, e.g., `exprs(PARAMCD = "TDOSE", PARCAT1 = -#' "OVERALL")`. More general expression are not allowed. -#' +#' symbol, a numeric value, an expression, or `NA`, e.g., `exprs(PARAMCD = +#' "TDOSE", PARCAT1 = "OVERALL")`. #' #' @return A data frame with derived records appended to original dataset. #' @@ -161,9 +160,7 @@ derive_summary_records <- function(dataset, dataset, required_vars = expr_c(by_vars, analysis_var) ) - if (!is.null(set_values_to)) { - assert_varval_list(set_values_to, optional = TRUE) - } + assert_varval_list(set_values_to, optional = TRUE) # Summarise the analysis value and bind to the original dataset bind_rows( diff --git a/R/derive_var_analysis_ratio.R b/R/derive_var_analysis_ratio.R index bffb1f713e..98a35cce18 100644 --- a/R/derive_var_analysis_ratio.R +++ b/R/derive_var_analysis_ratio.R @@ -71,7 +71,7 @@ derive_var_analysis_ratio <- function(dataset, new_var <- assert_symbol(enexpr(new_var), optional = TRUE) if (is.null(new_var)) { - new_var <- sym(paste0("R2", rlang::as_name(denom_var))) + new_var <- sym(paste0("R2", as_name(denom_var))) } dataset <- dataset %>% mutate( diff --git a/R/derive_var_anrind.R b/R/derive_var_anrind.R index 7b8868e006..909e5b452c 100644 --- a/R/derive_var_anrind.R +++ b/R/derive_var_anrind.R @@ -1,9 +1,11 @@ #' Derive Reference Range Indicator #' #' @param dataset The input dataset +#' @param use_a1hia1lo A logical value indicating whether to use `A1H1` and `A1LO` in +#' the derivation of `ANRIND`. #' #' @details -#' `ANRIND` is set to +#' In the case that `A1H1` and `A1LO` are to be used, `ANRIND` is set to: #' - `"NORMAL"` if `AVAL` is greater or equal `ANRLO` and less than #' or equal `ANRHI`; or if `AVAL` is greater than or equal `ANRLO` and `ANRHI` #' is missing; or if `AVAL` is less than or equal `ANRHI` and `ANRLO` is @@ -15,8 +17,15 @@ #' - `"LOW LOW"` if `AVAL` is less than `A1LO` #' - `"HIGH HIGH"` if `AVAL` is greater than `A1HI` #' -#' @return The input dataset with additional column `ANRIND` +#' In the case that `A1H1` and `A1LO` are not to be used, `ANRIND` is set to: +#' - `"NORMAL"` if `AVAL` is greater or equal `ANRLO` and less than +#' or equal `ANRHI`; or if `AVAL` is greater than or equal `ANRLO` and `ANRHI` +#' is missing; or if `AVAL` is less than or equal `ANRHI` and `ANRLO` is +#' missing +#' - `"LOW"` if `AVAL` is less than `ANRLO` +#' - `"HIGH"` if `AVAL` is greater than `ANRHI` #' +#' @return The input dataset with additional column `ANRIND` #' #' @family der_bds_findings #' @keywords der_bds_findings @@ -26,32 +35,40 @@ #' @examples #' library(tibble) #' library(dplyr, warn.conflicts = FALSE) -#' library(admiral.test) -#' data(admiral_vs) #' -#' ref_ranges <- tribble( -#' ~PARAMCD, ~ANRLO, ~ANRHI, ~A1LO, ~A1HI, -#' "DIABP", 60, 80, 40, 90, -#' "PULSE", 60, 100, 40, 110 +#' vs <- tibble::tribble( +#' ~USUBJID, ~PARAMCD, ~AVAL, ~ANRLO, ~ANRHI, ~A1LO, ~A1HI, +#' "P01", "PUL", 70, 60, 100, 40, 110, +#' "P01", "PUL", 57, 60, 100, 40, 110, +#' "P01", "PUL", 60, 60, 100, 40, 110, +#' "P01", "DIABP", 102, 60, 80, 40, 90, +#' "P02", "PUL", 109, 60, 100, 40, 110, +#' "P02", "PUL", 100, 60, 100, 40, 110, +#' "P02", "DIABP", 80, 60, 80, 40, 90, +#' "P03", "PUL", 39, 60, 100, 40, 110, +#' "P03", "PUL", 40, 60, 100, 40, 110 #' ) #' -#' admiral_vs %>% -#' mutate( -#' PARAMCD = VSTESTCD, -#' AVAL = VSSTRESN -#' ) %>% -#' filter(PARAMCD %in% c("PULSE", "DIABP")) %>% -#' derive_vars_merged(ref_ranges, by_vars = exprs(PARAMCD)) %>% -#' derive_var_anrind() %>% -#' select(USUBJID, PARAMCD, AVAL, ANRLO:ANRIND) -derive_var_anrind <- function(dataset) { - assert_data_frame(dataset, required_vars = exprs(ANRLO, ANRHI, AVAL)) +#' vs %>% derive_var_anrind(use_a1hia1lo = TRUE) +#' vs %>% derive_var_anrind(use_a1hia1lo = FALSE) +#' +derive_var_anrind <- function(dataset, + use_a1hia1lo = FALSE) { + if (use_a1hia1lo) { + assert_data_frame(dataset, required_vars = exprs(ANRLO, ANRHI, A1HI, A1LO, AVAL)) - # Temporarily add these variables to the dataset if they are not included - has_a1lo <- "A1LO" %in% colnames(dataset) - has_a1hi <- "A1HI" %in% colnames(dataset) - if (!has_a1lo) dataset[["A1LO"]] <- NA_character_ - if (!has_a1hi) dataset[["A1HI"]] <- NA_character_ + low_cond <- "AVAL < ANRLO & (is.na(A1LO) | AVAL >= A1LO)" + high_cond <- "AVAL > ANRHI & (is.na(A1HI) | AVAL <= A1HI)" + lowlow_cond <- "AVAL < A1LO" + highhigh_cond <- "AVAL > A1HI" + } else { + assert_data_frame(dataset, required_vars = exprs(ANRLO, ANRHI, AVAL)) + + low_cond <- "AVAL < ANRLO" + high_cond <- "AVAL > ANRHI" + lowlow_cond <- "FALSE" + highhigh_cond <- "FALSE" + } result <- dataset %>% mutate( @@ -59,17 +76,13 @@ derive_var_anrind <- function(dataset) { AVAL >= ANRLO & is.na(ANRHI) ~ "NORMAL", AVAL <= ANRHI & is.na(ANRLO) ~ "NORMAL", AVAL >= ANRLO & AVAL <= ANRHI ~ "NORMAL", - AVAL < ANRLO & (is.na(A1LO) | AVAL >= A1LO) ~ "LOW", - AVAL > ANRHI & (is.na(A1HI) | AVAL <= A1HI) ~ "HIGH", - AVAL < A1LO ~ "LOW LOW", - AVAL > A1HI ~ "HIGH HIGH", + eval(parse(text = low_cond)) ~ "LOW", + eval(parse(text = high_cond)) ~ "HIGH", + eval(parse(text = lowlow_cond)) ~ "LOW LOW", + eval(parse(text = highhigh_cond)) ~ "HIGH HIGH", TRUE ~ NA_character_ ) ) - # Remove the variables if they have been added above - if (!has_a1lo) result[["A1LO"]] <- NULL - if (!has_a1hi) result[["A1HI"]] <- NULL - result } diff --git a/R/derive_var_base.R b/R/derive_var_base.R index 48ca1802ec..5f88f582bf 100644 --- a/R/derive_var_base.R +++ b/R/derive_var_base.R @@ -1,6 +1,8 @@ #' Derive Baseline Variables #' -#' Derive baseline variables, e.g. `BASE` or `BNRIND`, in a BDS dataset +#' @description Derive baseline variables, e.g. `BASE` or `BNRIND`, in a BDS dataset. +#' +#' **Note:** This is a wrapper function for the more generic `derive_vars_merged()`. #' #' @param dataset The input dataset #' diff --git a/R/derive_var_basetype.R b/R/derive_var_basetype.R index bdbc1191aa..d78e170ae0 100644 --- a/R/derive_var_basetype.R +++ b/R/derive_var_basetype.R @@ -1,5 +1,10 @@ #' Derive Basetype Variable #' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' This function is *deprecated*, please use `derive_basetype_records()` instead. +#' #' 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 #' given parameter, if Baseline Value `BASE` is populated, and there is more than @@ -31,82 +36,16 @@ #' @return The input dataset with variable `BASETYPE` added #' #' -#' @family der_bds_findings +#' @family deprecated #' -#' @keywords der_bds_findings +#' @keywords deprecated #' #' @export -#' -#' @examples -#' 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, -#' "P01", "DOUBLE-BLIND", "PARAM01", 3, 9.2, -#' "P01", "DOUBLE-BLIND", "PARAM01", 4, 10.1, -#' "P01", "OPEN-LABEL", "PARAM01", 5, 10.4, -#' "P01", "OPEN-LABEL", "PARAM01", 6, 9.9, -#' "P02", "RUN-IN", "PARAM01", 1, 12.1, -#' "P02", "DOUBLE-BLIND", "PARAM01", 2, 10.2, -#' "P02", "DOUBLE-BLIND", "PARAM01", 3, 10.8, -#' "P02", "OPEN-LABEL", "PARAM01", 4, 11.4, -#' "P02", "OPEN-LABEL", "PARAM01", 5, 10.8 -#' ) -#' -#' bds_with_basetype <- derive_var_basetype( -#' dataset = bds, -#' 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" -#' ) -#' ) -#' -#' -#' # Below print statement will print all 23 records in the data frame -#' # bds_with_basetype -#' print(bds_with_basetype, n = Inf) -#' -#' 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 <- tribble( -#' ~USUBJID, ~EPOCH, ~PARAMCD, ~ASEQ, ~AVAL, -#' "P01", "RUN-IN", "PARAM01", 1, 10.0, -#' "P01", "RUN-IN", "PARAM01", 2, 9.8, -#' "P01", "DOUBLE-BLIND", "PARAM01", 3, 9.2, -#' "P01", "DOUBLE-BLIND", "PARAM01", 4, 10.1 -#' ) -#' -#' bds_with_basetype <- derive_var_basetype( -#' dataset = bds, -#' basetypes = exprs( -#' "LAST" = TRUE, -#' "WORST" = TRUE -#' ) -#' ) -#' -#' print(bds_with_basetype, n = Inf) -#' -#' count(bds_with_basetype, BASETYPE, name = "Number of Records") derive_var_basetype <- function(dataset, basetypes) { - assert_data_frame(dataset) - assert_named_exprs(basetypes) - - records_with_basetype <- map2(names(basetypes), basetypes, function(label, condition) { - dataset %>% - filter(!!condition) %>% - mutate(BASETYPE = label) - }) %>% - bind_rows() - - complementary_condition <- Reduce(function(x, y) bquote(.(x) | .(y)), basetypes) - records_without_basetype <- filter(dataset, !(!!complementary_condition)) + deprecate_warn("0.11.0", "derive_var_basetype()", "derive_basetype_records()") - bind_rows(records_without_basetype, records_with_basetype) + derive_basetype_records( + dataset = dataset, + basetypes = basetypes + ) } diff --git a/R/derive_var_disposition_status.R b/R/derive_var_disposition_status.R index 4251db7240..19a7be04bd 100644 --- a/R/derive_var_disposition_status.R +++ b/R/derive_var_disposition_status.R @@ -25,7 +25,7 @@ #' @keywords deprecated format_eoxxstt_default <- function(status) { ### DEPRECATION - deprecate_warn("0.10.0", + deprecate_stop("0.10.0", "format_eoxxstt_default()", details = paste( "This function is deprecated", @@ -33,14 +33,6 @@ format_eoxxstt_default <- function(status) { `cat_fun` argument in `derive_var_merged_cat()` instead" ) ) - - case_when( - status %in% c("SCREEN FAILURE", "SCREENING NOT COMPLETED") ~ "NOT STARTED", - status == "COMPLETED" ~ "COMPLETED", - !status %in% c("COMPLETED", "SCREEN FAILURE", "SCREENING NOT COMPLETED") & - !is.na(status) ~ "DISCONTINUED", - TRUE ~ "ONGOING" - ) } #' Derive a Disposition Status at a Specific Timepoint @@ -122,29 +114,8 @@ derive_var_disposition_status <- function(dataset, filter_ds, subject_keys = get_admiral_option("subject_keys")) { ### DEPRECATION - deprecate_warn("0.10.0", + deprecate_stop("0.10.0", "derive_var_disposition_status()", details = "Please use `derive_var_merged_cat()` instead" ) - - new_var <- assert_symbol(enexpr(new_var)) - status_var <- assert_symbol(enexpr(status_var)) - filter_ds <- assert_filter_cond(enexpr(filter_ds)) - - assert_s3_class(format_new_var, "function") - assert_data_frame(dataset) - assert_data_frame(dataset_ds, expr_c(status_var)) - warn_if_vars_exist(dataset, as_name(new_var)) - assert_vars(subject_keys) - - # Add the status variable and derive the new dispo status in the input dataset - dataset %>% - derive_vars_merged( - dataset_add = dataset_ds, - filter_add = !!filter_ds, - new_vars = exprs(!!status_var), - by_vars = subject_keys - ) %>% - mutate(!!new_var := format_new_var(!!status_var)) %>% - select(-!!status_var) } diff --git a/R/derive_var_dthcaus.R b/R/derive_var_dthcaus.R index d1ed0e2968..3e730f39fd 100644 --- a/R/derive_var_dthcaus.R +++ b/R/derive_var_dthcaus.R @@ -35,7 +35,6 @@ #' @examples #' library(tibble) #' library(dplyr, warn.conflicts = FALSE) -#' library(lubridate) #' #' adsl <- tribble( #' ~STUDYID, ~USUBJID, @@ -46,26 +45,21 @@ #' ae <- tribble( #' ~STUDYID, ~USUBJID, ~AESEQ, ~AEDECOD, ~AEOUT, ~AEDTHDTC, #' "STUDY01", "PAT01", 12, "SUDDEN DEATH", "FATAL", "2021-04-04" -#' ) %>% -#' mutate( -#' AEDTHDT = ymd(AEDTHDTC) -#' ) +#' ) +#' #' ds <- tribble( #' ~STUDYID, ~USUBJID, ~DSSEQ, ~DSDECOD, ~DSTERM, ~DSSTDTC, #' "STUDY01", "PAT02", 1, "INFORMED CONSENT OBTAINED", "INFORMED CONSENT OBTAINED", "2021-04-03", #' "STUDY01", "PAT02", 2, "RANDOMIZATION", "RANDOMIZATION", "2021-04-11", #' "STUDY01", "PAT02", 3, "DEATH", "DEATH DUE TO PROGRESSION OF DISEASE", "2022-02-01", #' "STUDY01", "PAT03", 1, "DEATH", "POST STUDY REPORTING OF DEATH", "2022-03-03" -#' ) %>% -#' mutate( -#' DSSTDT = ymd(DSSTDTC) -#' ) +#' ) #' #' # Derive `DTHCAUS` only - for on-study deaths only #' src_ae <- dthcaus_source( #' dataset_name = "ae", #' filter = AEOUT == "FATAL", -#' date = AEDTHDT, +#' date = convert_dtc_to_dt(AEDTHDTC), #' mode = "first", #' dthcaus = AEDECOD #' ) @@ -73,7 +67,7 @@ #' src_ds <- dthcaus_source( #' dataset_name = "ds", #' filter = DSDECOD == "DEATH" & grepl("DEATH DUE TO", DSTERM), -#' date = DSSTDT, +#' date = convert_dtc_to_dt(DSSTDTC), #' mode = "first", #' dthcaus = DSTERM #' ) @@ -84,7 +78,7 @@ #' src_ae <- dthcaus_source( #' dataset_name = "ae", #' filter = AEOUT == "FATAL", -#' date = AEDTHDT, +#' date = convert_dtc_to_dt(AEDTHDTC), #' mode = "first", #' dthcaus = AEDECOD, #' traceability_vars = exprs(DTHDOM = "AE", DTHSEQ = AESEQ) @@ -93,7 +87,7 @@ #' src_ds <- dthcaus_source( #' dataset_name = "ds", #' filter = DSDECOD == "DEATH" & grepl("DEATH DUE TO", DSTERM), -#' date = DSSTDT, +#' date = convert_dtc_to_dt(DSSTDTC), #' mode = "first", #' dthcaus = DSTERM, #' traceability_vars = exprs(DTHDOM = "DS", DTHSEQ = DSSEQ) @@ -105,12 +99,17 @@ #' src_ae <- dthcaus_source( #' dataset_name = "ae", #' filter = AEOUT == "FATAL", -#' date = AEDTHDT, +#' date = convert_dtc_to_dt(AEDTHDTC), #' mode = "first", #' dthcaus = AEDECOD, #' traceability_vars = exprs(DTHDOM = "AE", DTHSEQ = AESEQ) #' ) #' +#' ds <- mutate( +#' ds, +#' DSSTDT = convert_dtc_to_dt(DSSTDTC) +#' ) +#' #' src_ds <- dthcaus_source( #' dataset_name = "ds", #' filter = DSDECOD == "DEATH" & grepl("DEATH DUE TO", DSTERM), @@ -129,7 +128,11 @@ #' traceability_vars = exprs(DTHDOM = "DS", DTHSEQ = DSSEQ) #' ) #' -#' derive_var_dthcaus(adsl, src_ae, src_ds, src_ds_post, source_datasets = list(ae = ae, ds = ds)) +#' derive_var_dthcaus( +#' adsl, +#' src_ae, src_ds, src_ds_post, +#' source_datasets = list(ae = ae, ds = ds) +#' ) derive_var_dthcaus <- function(dataset, ..., source_datasets, @@ -164,9 +167,19 @@ derive_var_dthcaus <- function(dataset, add_data[[ii]] <- source_dataset %>% filter_if(sources[[ii]]$filter) + date <- sources[[ii]]$date + if (is.symbol(date)) { + date_var <- date + } else { + date_var <- get_new_tmp_var(dataset = add_data[[ii]], prefix = "tmp_date") + add_data[[ii]] <- mutate( + add_data[[ii]], + !!date_var := !!date + ) + } assert_date_var( dataset = add_data[[ii]], - var = !!sources[[ii]]$date, + var = !!date_var, dataset_name = source_dataset_name ) @@ -175,13 +188,13 @@ derive_var_dthcaus <- function(dataset, tmp_date <- get_new_tmp_var(dataset) add_data[[ii]] <- add_data[[ii]] %>% filter_extreme( - order = exprs(!!sources[[ii]]$date, !!!sources[[ii]]$order), + order = exprs(!!date_var, !!!sources[[ii]]$order), by_vars = subject_keys, mode = sources[[ii]]$mode ) %>% mutate( !!tmp_source_nr := ii, - !!tmp_date := !!sources[[ii]]$date, + !!tmp_date := !!date_var, DTHCAUS = !!sources[[ii]]$dthcaus ) @@ -230,34 +243,37 @@ derive_var_dthcaus <- function(dataset, #' #' @param filter An expression used for filtering `dataset`. #' -#' @param date A date or datetime variable to be used for sorting `dataset`. +#' @param date A date or datetime variable or an expression to be used for +#' sorting `dataset`. #' #' @param order Sort order #' -#' Additional variables to be used for sorting the `dataset` which is ordered by the -#' `date` and `order`. Can be used to avoid duplicate record warning. -#' -#' *Default*: `NULL` +#' Additional variables/expressions to be used for sorting the `dataset`. The +#' dataset is ordered by `date` and `order`. Can be used to avoid duplicate +#' record warning. #' -#' *Permitted Values*: list of variables or `desc()` function calls -#' created by `exprs()`, e.g., `exprs(ADT, desc(AVAL))` or `NULL` +#' *Permitted Values*: list of expressions created by `exprs()`, e.g., +#' `exprs(ADT, desc(AVAL))` or `NULL` #' #' @param mode One of `"first"` or `"last"`. #' Either the `"first"` or `"last"` observation is preserved from the `dataset` #' which is ordered by `date`. #' -#' @param dthcaus A variable name or a string literal --- if a variable name, e.g., `AEDECOD`, -#' it is the variable in the source dataset to be used to assign values to -#' `DTHCAUS`; if a string literal, e.g. `"Adverse Event"`, it is the fixed value -#' to be assigned to `DTHCAUS`. +#' @param dthcaus A variable name, an expression, or a string literal #' -#' @param traceability_vars A named list returned by [`exprs()`] listing the traceability variables, -#' e.g. `exprs(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. +#' If a variable name is specified, e.g., `AEDECOD`, it is the variable in the +#' source dataset to be used to assign values to `DTHCAUS`; if an expression, +#' e.g., `str_to_upper(AEDECOD)`, it is evaluated in the source dataset and +#' the results is assigned to `DTHCAUS`; if a string literal, e.g. `"Adverse +#' Event"`, it is the fixed value to be assigned to `DTHCAUS`. +#' +#' @param traceability_vars A named list returned by [`exprs()`] listing the +#' traceability variables, e.g. `exprs(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, numbers, symbols, or +#' expressions referring to existing variables. #' #' @keywords source_specifications #' @family source_specifications @@ -283,7 +299,7 @@ derive_var_dthcaus <- function(dataset, #' src_ds <- dthcaus_source( #' dataset_name = "ds", #' filter = DSDECOD == "DEATH", -#' date = DSSTDT, +#' date = convert_dtc_to_dt(DSSTDTC), #' mode = "first", #' dthcaus = DSTERM #' ) @@ -297,11 +313,11 @@ dthcaus_source <- function(dataset_name, out <- list( dataset_name = assert_character_scalar(dataset_name), filter = assert_filter_cond(enexpr(filter), optional = TRUE), - date = assert_symbol(enexpr(date)), - order = assert_order_vars(order, optional = TRUE), + date = assert_expr(enexpr(date)), + order = assert_expr_list(order, optional = TRUE), mode = assert_character_scalar(mode, values = c("first", "last"), case_sensitive = FALSE), - dthcaus = assert_symbol(enexpr(dthcaus)) %or% assert_character_scalar(dthcaus), - traceability = assert_varval_list(traceability_vars, optional = TRUE) + dthcaus = assert_expr(enexpr(dthcaus)), + traceability = assert_expr_list(traceability_vars, named = TRUE, optional = TRUE) ) 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 990b0f6f16..176c0c2e2c 100644 --- a/R/derive_var_extreme_date.R +++ b/R/derive_var_extreme_date.R @@ -34,9 +34,9 @@ #' Then for each patient the first or last observation (with respect to `date` #' and `mode`) is selected. #' -#' 1. The new variable is set to the variable specified by the `date` element. -#' If this is a date variable (rather than datetime), then the time is imputed -#' as `"00:00:00"`. +#' 1. The new variable is set to the variable or expression specified by the +#' `date` element. If this is a date variable (rather than datetime), then the +#' time is imputed as `"00:00:00"`. #' #' 1. The variables specified by the `traceability_vars` element are added. #' @@ -60,23 +60,79 @@ #' #' @examples #' library(dplyr, warn.conflicts = FALSE) -#' library(admiral.test) -#' data("admiral_dm") -#' data("admiral_ae") -#' data("admiral_lb") -#' data("admiral_adsl") +#' library(lubridate) +#' dm <- tribble( +#' ~STUDYID, ~DOMAIN, ~USUBJID, ~AGE, ~AGEU, +#' "PILOT01", "DM", "01-1130", 84, "YEARS", +#' "PILOT01", "DM", "01-1133", 81, "YEARS", +#' "PILOT01", "DM", "01-1211", 76, "YEARS", +#' "PILOT01", "DM", "09-1081", 86, "YEARS", +#' "PILOT01", "DM", "09-1088", 69, "YEARS" +#' ) +#' ae <- tribble( +#' ~STUDYID, ~DOMAIN, ~USUBJID, ~AESEQ, ~AESTDTC, ~AEENDTC, +#' "PILOT01", "AE", "01-1130", 5, "2014-05-09", "2014-05-09", +#' "PILOT01", "AE", "01-1130", 6, "2014-05-22", NA, +#' "PILOT01", "AE", "01-1130", 4, "2014-05-09", "2014-05-09", +#' "PILOT01", "AE", "01-1130", 8, "2014-05-22", NA, +#' "PILOT01", "AE", "01-1130", 7, "2014-05-22", NA, +#' "PILOT01", "AE", "01-1130", 2, "2014-03-09", "2014-03-09", +#' "PILOT01", "AE", "01-1130", 1, "2014-03-09", "2014-03-16", +#' "PILOT01", "AE", "01-1130", 3, "2014-03-09", "2014-03-16", +#' "PILOT01", "AE", "01-1133", 1, "2012-12-27", NA, +#' "PILOT01", "AE", "01-1133", 3, "2012-12-27", NA, +#' "PILOT01", "AE", "01-1133", 2, "2012-12-27", NA, +#' "PILOT01", "AE", "01-1133", 4, "2012-12-27", NA, +#' "PILOT01", "AE", "01-1211", 5, "2012-11-29", NA, +#' "PILOT01", "AE", "01-1211", 1, "2012-11-16", NA, +#' "PILOT01", "AE", "01-1211", 7, "2013-01-11", NA, +#' "PILOT01", "AE", "01-1211", 8, "2013-01-11", NA, +#' "PILOT01", "AE", "01-1211", 4, "2012-11-22", NA, +#' "PILOT01", "AE", "01-1211", 2, "2012-11-21", "2012-11-21", +#' "PILOT01", "AE", "01-1211", 3, "2012-11-21", NA, +#' "PILOT01", "AE", "01-1211", 6, "2012-12-09", NA, +#' "PILOT01", "AE", "01-1211", 9, "2013-01-14", "2013-01-14", +#' "PILOT01", "AE", "09-1081", 2, "2014-05-01", NA, +#' "PILOT01", "AE", "09-1081", 1, "2014-04-07", NA, +#' "PILOT01", "AE", "09-1088", 1, "2014-05-08", NA, +#' "PILOT01", "AE", "09-1088", 2, "2014-08-02", NA +#' ) +#' lb <- tribble( +#' ~STUDYID, ~DOMAIN, ~USUBJID, ~LBSEQ, ~LBDTC, +#' "PILOT01", "LB", "01-1130", 219, "2014-06-07T13:20", +#' "PILOT01", "LB", "01-1130", 322, "2014-08-16T13:10", +#' "PILOT01", "LB", "01-1133", 268, "2013-04-18T15:30", +#' "PILOT01", "LB", "01-1133", 304, "2013-04-29T10:13", +#' "PILOT01", "LB", "01-1211", 8, "2012-10-30T14:26", +#' "PILOT01", "LB", "01-1211", 162, "2013-01-08T12:13", +#' "PILOT01", "LB", "09-1081", 47, "2014-02-01T10:55", +#' "PILOT01", "LB", "09-1081", 219, "2014-05-10T11:15", +#' "PILOT01", "LB", "09-1088", 283, "2014-09-27T12:13", +#' "PILOT01", "LB", "09-1088", 322, "2014-10-09T13:25" +#' ) +#' adsl <- tribble( +#' ~STUDYID, ~USUBJID, ~TRTEDTM, +#' "PILOT01", "01-1130", "2014-08-16 23:59:59", +#' "PILOT01", "01-1133", "2013-04-28 23:59:59", +#' "PILOT01", "01-1211", "2013-01-12 23:59:59", +#' "PILOT01", "09-1081", "2014-04-27 23:59:59", +#' "PILOT01", "09-1088", "2014-10-09 23:59:59" +#' ) %>% +#' mutate( +#' TRTEDTM = as_datetime(TRTEDTM) +#' ) #' #' # derive last known alive datetime (LSTALVDTM) #' ae_start <- date_source( #' dataset_name = "ae", -#' date = AESTDTM +#' date = convert_dtc_to_dtm(AESTDTC, highest_imputation = "M"), #' ) #' ae_end <- date_source( #' dataset_name = "ae", -#' date = AEENDTM +#' date = convert_dtc_to_dtm(AEENDTC, highest_imputation = "M"), #' ) #' -#' ae_ext <- admiral_ae %>% +#' ae_ext <- ae %>% #' derive_vars_dtm( #' dtc = AESTDTC, #' new_vars_prefix = "AEST", @@ -90,25 +146,28 @@ #' #' lb_date <- date_source( #' dataset_name = "lb", -#' date = LBDTM, -#' filter = !is.na(LBDTM) +#' date = convert_dtc_to_dtm(LBDTC), #' ) #' #' lb_ext <- derive_vars_dtm( -#' admiral_lb, +#' lb, #' dtc = LBDTC, #' new_vars_prefix = "LB" #' ) #' -#' adsl_date <- date_source(dataset_name = "adsl", date = TRTEDTM) +#' adsl_date <- date_source( +#' dataset_name = "adsl", +#' date = TRTEDTM +#' ) #' -#' admiral_dm %>% +#' dm %>% #' derive_var_extreme_dtm( #' new_var = LSTALVDTM, #' ae_start, ae_end, lb_date, adsl_date, #' source_datasets = list( -#' adsl = admiral_adsl, -#' ae = ae_ext, lb = lb_ext +#' adsl = adsl, +#' ae = ae_ext, +#' lb = lb_ext #' ), #' mode = "last" #' ) %>% @@ -117,7 +176,7 @@ #' # derive last alive datetime and traceability variables #' ae_start <- date_source( #' dataset_name = "ae", -#' date = AESTDTM, +#' date = convert_dtc_to_dtm(AESTDTC, highest_imputation = "M"), #' traceability_vars = exprs( #' LALVDOM = "AE", #' LALVSEQ = AESEQ, @@ -127,7 +186,7 @@ #' #' ae_end <- date_source( #' dataset_name = "ae", -#' date = AEENDTM, +#' date = convert_dtc_to_dtm(AEENDTC, highest_imputation = "M"), #' traceability_vars = exprs( #' LALVDOM = "AE", #' LALVSEQ = AESEQ, @@ -136,8 +195,7 @@ #' ) #' lb_date <- date_source( #' dataset_name = "lb", -#' date = LBDTM, -#' filter = !is.na(LBDTM), +#' date = convert_dtc_to_dtm(LBDTC), #' traceability_vars = exprs( #' LALVDOM = "LB", #' LALVSEQ = LBSEQ, @@ -155,12 +213,12 @@ #' ) #' ) #' -#' admiral_dm %>% +#' dm %>% #' derive_var_extreme_dtm( #' new_var = LSTALVDTM, #' ae_start, ae_end, lb_date, adsl_date, #' source_datasets = list( -#' adsl = admiral_adsl, +#' adsl = adsl, #' ae = ae_ext, #' lb = lb_ext #' ), @@ -177,7 +235,7 @@ derive_var_extreme_dtm <- function(dataset, assert_data_frame(dataset, required_vars = subject_keys) new_var <- assert_symbol(enexpr(new_var)) assert_list_of(source_datasets, "data.frame") - sources <- rlang::list2(...) + sources <- list2(...) assert_list_of(sources, "date_source") mode <- assert_character_scalar( mode, @@ -216,9 +274,18 @@ derive_var_extreme_dtm <- function(dataset, source_dataset <- source_datasets[[source_dataset_name]] date <- sources[[i]]$date + if (is.symbol(date)) { + date_var <- date + } else { + date_var <- get_new_tmp_var(dataset = source_dataset, prefix = "tmp_date") + source_dataset <- mutate( + source_dataset, + !!date_var := !!date + ) + } assert_date_var( dataset = source_dataset, - var = !!date, + var = !!date_var, dataset_name = source_dataset_name ) @@ -232,9 +299,9 @@ derive_var_extreme_dtm <- function(dataset, add_data[[i]] <- source_dataset %>% filter_if(sources[[i]]$filter) %>% - filter(!is.na(!!date)) %>% + filter(!is.na(!!date_var)) %>% filter_extreme( - order = exprs(!!date), + order = exprs(!!date_var), by_vars = subject_keys, mode = mode, check_type = "none" @@ -244,7 +311,7 @@ derive_var_extreme_dtm <- function(dataset, add_data[[i]], !!!subject_keys, !!!sources[[i]]$traceability_vars, - !!new_var := convert_date_to_dtm(!!date) + !!new_var := convert_date_to_dtm(!!date_var) ) } @@ -266,8 +333,10 @@ derive_var_extreme_dtm <- function(dataset, #' Derive First or Last Date from Multiple Sources #' -#' Add the first or last date from multiple sources to the dataset, e.g., -#' the last known alive date (`LSTALVDT`). +#' @description Add the first or last date from multiple sources to the +#' dataset, e.g., the last known alive date (`LSTALVDT`). +#' +#' **Note:** This is a wrapper function for the function `derive_var_extreme_dtm()`. #' #' @inheritParams derive_var_extreme_dtm #' @@ -278,7 +347,8 @@ derive_var_extreme_dtm <- function(dataset, #' Then for each patient the first or last observation (with respect to `date` #' and `mode`) is selected. #' -#' 1. The new variable is set to the variable specified by the `date` element. +#' 1. The new variable is set to the variable or expression specified by the +#' `date` element. #' #' 1. The variables specified by the `traceability_vars` element are added. #' @@ -303,23 +373,81 @@ derive_var_extreme_dtm <- function(dataset, #' #' @examples #' library(dplyr, warn.conflicts = FALSE) -#' library(admiral.test) -#' data("admiral_dm") -#' data("admiral_ae") -#' data("admiral_lb") -#' data("admiral_adsl") +#' ae <- tribble( +#' ~STUDYID, ~DOMAIN, ~USUBJID, ~AESEQ, ~AESTDTC, ~AEENDTC, +#' "PILOT01", "AE", "01-1130", 5, "2014-05-09", "2014-05-09", +#' "PILOT01", "AE", "01-1130", 6, "2014-05-22", NA, +#' "PILOT01", "AE", "01-1130", 4, "2014-05-09", "2014-05-09", +#' "PILOT01", "AE", "01-1130", 8, "2014-05-22", NA, +#' "PILOT01", "AE", "01-1130", 7, "2014-05-22", NA, +#' "PILOT01", "AE", "01-1130", 2, "2014-03-09", "2014-03-09", +#' "PILOT01", "AE", "01-1130", 1, "2014-03-09", "2014-03-16", +#' "PILOT01", "AE", "01-1130", 3, "2014-03-09", "2014-03-16", +#' "PILOT01", "AE", "01-1133", 1, "2012-12-27", NA, +#' "PILOT01", "AE", "01-1133", 3, "2012-12-27", NA, +#' "PILOT01", "AE", "01-1133", 2, "2012-12-27", NA, +#' "PILOT01", "AE", "01-1133", 4, "2012-12-27", NA, +#' "PILOT01", "AE", "01-1211", 5, "2012-11-29", NA, +#' "PILOT01", "AE", "01-1211", 1, "2012-11-16", NA, +#' "PILOT01", "AE", "01-1211", 7, "2013-01-11", NA, +#' "PILOT01", "AE", "01-1211", 8, "2013-01-11", NA, +#' "PILOT01", "AE", "01-1211", 4, "2012-11-22", NA, +#' "PILOT01", "AE", "01-1211", 2, "2012-11-21", "2012-11-21", +#' "PILOT01", "AE", "01-1211", 3, "2012-11-21", NA, +#' "PILOT01", "AE", "01-1211", 6, "2012-12-09", NA, +#' "PILOT01", "AE", "01-1211", 9, "2013-01-14", "2013-01-14", +#' "PILOT01", "AE", "09-1081", 2, "2014-05-01", NA, +#' "PILOT01", "AE", "09-1081", 1, "2014-04-07", NA, +#' "PILOT01", "AE", "09-1088", 1, "2014-05-08", NA, +#' "PILOT01", "AE", "09-1088", 2, "2014-08-02", NA +#' ) +#' +#' adsl <- tribble( +#' ~STUDYID, ~USUBJID, ~TRTEDTM, ~TRTEDT, +#' "PILOT01", "01-1130", "2014-08-16 23:59:59", "2014-08-16", +#' "PILOT01", "01-1133", "2013-04-28 23:59:59", "2013-04-28", +#' "PILOT01", "01-1211", "2013-01-12 23:59:59", "2013-01-12", +#' "PILOT01", "09-1081", "2014-04-27 23:59:59", "2014-04-27", +#' "PILOT01", "09-1088", "2014-10-09 23:59:59", "2014-10-09" +#' ) %>% +#' mutate( +#' across(TRTEDTM:TRTEDT, as.Date) +#' ) +#' +#' +#' lb <- tribble( +#' ~STUDYID, ~DOMAIN, ~USUBJID, ~LBSEQ, ~LBDTC, +#' "PILOT01", "LB", "01-1130", 219, "2014-06-07T13:20", +#' "PILOT01", "LB", "01-1130", 322, "2014-08-16T13:10", +#' "PILOT01", "LB", "01-1133", 268, "2013-04-18T15:30", +#' "PILOT01", "LB", "01-1133", 304, "2013-04-29T10:13", +#' "PILOT01", "LB", "01-1211", 8, "2012-10-30T14:26", +#' "PILOT01", "LB", "01-1211", 162, "2013-01-08T12:13", +#' "PILOT01", "LB", "09-1081", 47, "2014-02-01T10:55", +#' "PILOT01", "LB", "09-1081", 219, "2014-05-10T11:15", +#' "PILOT01", "LB", "09-1088", 283, "2014-09-27T12:13", +#' "PILOT01", "LB", "09-1088", 322, "2014-10-09T13:25" +#' ) +#' +#' dm <- tribble( +#' ~STUDYID, ~DOMAIN, ~USUBJID, ~AGE, ~AGEU, +#' "PILOT01", "DM", "01-1130", 84, "YEARS", +#' "PILOT01", "DM", "01-1133", 81, "YEARS", +#' "PILOT01", "DM", "01-1211", 76, "YEARS", +#' "PILOT01", "DM", "09-1081", 86, "YEARS", +#' "PILOT01", "DM", "09-1088", 69, "YEARS" +#' ) #' -#' # derive last known alive date (LSTALVDT) #' ae_start <- date_source( #' dataset_name = "ae", -#' date = AESTDT +#' date = convert_dtc_to_dt(AESTDTC, highest_imputation = "M") #' ) #' ae_end <- date_source( #' dataset_name = "ae", -#' date = AEENDT +#' date = convert_dtc_to_dt(AEENDTC, highest_imputation = "M") #' ) #' -#' ae_ext <- admiral_ae %>% +#' ae_ext <- ae %>% #' derive_vars_dt( #' dtc = AESTDTC, #' new_vars_prefix = "AEST", @@ -333,24 +461,23 @@ derive_var_extreme_dtm <- function(dataset, #' #' lb_date <- date_source( #' dataset_name = "lb", -#' date = LBDT, -#' filter = !is.na(LBDT), +#' date = convert_dtc_to_dt(LBDTC) #' ) #' #' lb_ext <- derive_vars_dt( -#' admiral_lb, +#' lb, #' dtc = LBDTC, #' new_vars_prefix = "LB" #' ) #' #' adsl_date <- date_source(dataset_name = "adsl", date = TRTEDT) #' -#' admiral_dm %>% +#' dm %>% #' derive_var_extreme_dt( #' new_var = LSTALVDT, #' ae_start, ae_end, lb_date, adsl_date, #' source_datasets = list( -#' adsl = admiral_adsl, +#' adsl = adsl, #' ae = ae_ext, #' lb = lb_ext #' ), @@ -361,7 +488,7 @@ derive_var_extreme_dtm <- function(dataset, #' # derive last alive date and traceability variables #' ae_start <- date_source( #' dataset_name = "ae", -#' date = AESTDT, +#' date = convert_dtc_to_dt(AESTDTC, highest_imputation = "M"), #' traceability_vars = exprs( #' LALVDOM = "AE", #' LALVSEQ = AESEQ, @@ -371,17 +498,17 @@ derive_var_extreme_dtm <- function(dataset, #' #' ae_end <- date_source( #' dataset_name = "ae", -#' date = AEENDT, +#' date = convert_dtc_to_dt(AEENDTC, highest_imputation = "M"), #' traceability_vars = exprs( #' LALVDOM = "AE", #' LALVSEQ = AESEQ, #' LALVVAR = "AEENDTC" #' ) #' ) +#' #' lb_date <- date_source( #' dataset_name = "lb", -#' date = LBDT, -#' filter = !is.na(LBDT), +#' date = convert_dtc_to_dt(LBDTC), #' traceability_vars = exprs( #' LALVDOM = "LB", #' LALVSEQ = LBSEQ, @@ -399,12 +526,12 @@ derive_var_extreme_dtm <- function(dataset, #' ) #' ) #' -#' admiral_dm %>% +#' dm %>% #' derive_var_extreme_dt( #' new_var = LSTALVDT, #' ae_start, ae_end, lb_date, adsl_date, #' source_datasets = list( -#' adsl = admiral_adsl, +#' adsl = adsl, #' ae = ae_ext, #' lb = lb_ext #' ), @@ -443,13 +570,13 @@ derive_var_extreme_dt <- function(dataset, #' #' @param filter An unquoted condition for filtering `dataset`. #' -#' @param date A variable providing a date. A date or a datetime can be -#' specified. An unquoted symbol is expected. +#' @param date A variable or an expression providing a date. A date or a +#' datetime can be specified. An unquoted symbol or expression is expected. #' #' @param traceability_vars A named list returned by `exprs()` defining the #' traceability variables, e.g. `exprs(LALVDOM = "AE", LALVSEQ = AESEQ, LALVVAR #' = "AESTDTC")`. The values must be a symbol, a character string, a numeric, -#' or `NA`. +#' an expression, or `NA`. #' #' #' @seealso [derive_var_extreme_dtm()], [derive_var_extreme_dt()] @@ -473,7 +600,7 @@ derive_var_extreme_dt <- function(dataset, #' lb_date <- date_source( #' dataset_name = "lb", #' filter = LBSTAT != "NOT DONE" | is.na(LBSTAT), -#' date = LBDT +#' date = convert_dtc_to_dt(LBDTC) #' ) #' #' # death date from ADSL including traceability variables @@ -492,8 +619,8 @@ date_source <- function(dataset_name, out <- list( dataset_name = assert_character_scalar(dataset_name), filter = assert_filter_cond(enexpr(filter), optional = TRUE), - date = assert_symbol(enexpr(date)), - traceability_vars = assert_varval_list(traceability_vars, optional = TRUE) + date = assert_expr(enexpr(date)), + traceability_vars = assert_expr_list(traceability_vars, named = TRUE, optional = TRUE) ) 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 f3a6f6f58e..109d118b9e 100644 --- a/R/derive_var_extreme_flag.R +++ b/R/derive_var_extreme_flag.R @@ -62,11 +62,20 @@ #' @examples #' library(tibble) #' library(dplyr, warn.conflicts = FALSE) -#' library(admiral.test) -#' data("admiral_vs") +#' example_vs <- tribble( +#' ~USUBJID, ~VSTESTCD, ~VISIT, ~VISITNUM, ~VSTPTNUM, ~VSSTRESN, +#' "1001", "DIABP", "SCREENING", 1, 10, 64, +#' "1001", "DIABP", "SCREENING", 1, 11, 66, +#' "1001", "DIABP", "BASELINE", 2, 100, 68, +#' "1001", "DIABP", "BASELINE", 2, 101, 68, +#' "1001", "DIABP", "WEEK 2", 3, 200, 72, +#' "1001", "DIABP", "WEEK 2", 3, 201, 71, +#' "1001", "DIABP", "WEEK 4", 4, 300, 70, +#' "1001", "DIABP", "WEEK 4", 4, 301, 70 +#' ) #' #' # Flag last value for each patient, test, and visit, baseline observations are ignored -#' admiral_vs %>% +#' example_vs %>% #' restrict_derivation( #' derivation = derive_var_extreme_flag, #' args = params( @@ -159,10 +168,19 @@ #' ) #' #' # OCCURDS Examples -#' data("admiral_ae") +#' example_ae <- tribble( +#' ~USUBJID, ~AEBODSYS, ~AEDECOD, ~AESEV, ~AESTDY, ~AESEQ, +#' "1015", "GENERAL DISORDERS", "ERYTHEMA", "MILD", 2, 1, +#' "1015", "GENERAL DISORDERS", "PRURITUS", "MILD", 2, 2, +#' "1015", "GI DISORDERS", "DIARRHOEA", "MILD", 8, 3, +#' "1023", "CARDIAC DISORDERS", "AV BLOCK", "MILD", 22, 4, +#' "1023", "SKIN DISORDERS", "ERYTHEMA", "MILD", 3, 1, +#' "1023", "SKIN DISORDERS", "ERYTHEMA", "SEVERE", 5, 2, +#' "1023", "SKIN DISORDERS", "ERYTHEMA", "MILD", 8, 3 +#' ) #' #' # Most severe AE first occurrence per patient -#' admiral_ae %>% +#' example_ae %>% #' mutate( #' TEMP_AESEVN = #' as.integer(factor(AESEV, levels = c("SEVERE", "MODERATE", "MILD"))) @@ -177,7 +195,7 @@ #' select(USUBJID, AEDECOD, AESEV, AESTDY, AESEQ, AOCCIFL) #' #' # Most severe AE first occurrence per patient per body system -#' admiral_ae %>% +#' example_ae %>% #' mutate( #' TEMP_AESEVN = #' as.integer(factor(AESEV, levels = c("SEVERE", "MODERATE", "MILD"))) @@ -198,7 +216,7 @@ derive_var_extreme_flag <- function(dataset, check_type = "warning") { new_var <- assert_symbol(enexpr(new_var)) assert_vars(by_vars) - assert_order_vars(order) + assert_expr_list(order) assert_data_frame(dataset, required_vars = exprs(!!!by_vars, !!!extract_vars(order))) mode <- assert_character_scalar(mode, values = c("first", "last"), case_sensitive = FALSE) check_type <- assert_character_scalar( @@ -287,79 +305,8 @@ derive_var_worst_flag <- function(dataset, worst_low, check_type = "warning") { ### DEPRECATION - deprecate_warn("0.10.0", + deprecate_stop("0.10.0", "derive_var_worst_flag()", - details = paste( - "Please use `slice_derivation()` / `derive_var_extreme_flag()`", - "to derive extreme flags by changing the `order` argument" - ) - ) - - # perform argument checks - new_var <- assert_symbol(enexpr(new_var)) - param_var <- assert_symbol(enexpr(param_var)) - analysis_var <- assert_symbol(enexpr(analysis_var)) - assert_vars(by_vars) - assert_order_vars(order) - assert_data_frame( - dataset, - required_vars = expr_c(by_vars, extract_vars(order), param_var, analysis_var) - ) - assert_character_vector(worst_high) - assert_character_vector(worst_low) - - # additional checks for worstflag - parameters overlap - if (length(intersect(worst_high, worst_low)) > 0) { - err_msg <- paste( - "The following parameter(-s) are both assigned to `worst_high` and `worst_low` flags:", - paste0(intersect(worst_high, worst_low), collapse = ", ") - ) - abort(err_msg) - } - - # additional checks for worstflag - parameters not available - param_var_str <- as_string(param_var) - if (length(worst_high) > 0 && - !all(worst_high %in% dataset[[param_var_str]])) { - err_msg <- paste0( - "The following parameter(-s) in `worst_high` are not available in column ", - param_var_str, - ": ", - paste0(worst_high[!worst_high %in% dataset[[param_var_str]]], collapse = ", ") - ) - abort(err_msg) - } - - # additional checks for worstflag - parameters not available - if (length(worst_low) > 0 && - !all(worst_low %in% dataset[[param_var_str]])) { - err_msg <- paste0( - "The following parameter(-s) in `worst_low` are not available in column ", - param_var_str, - ": ", - paste0(worst_low[!worst_low %in% dataset[[param_var_str]]], collapse = ", ") - ) - abort(err_msg) - } - - # derive worst-flag - bind_rows( - derive_var_extreme_flag( - dataset = dplyr::filter(dataset, !!param_var %in% worst_low), - by_vars = by_vars, - order = expr_c(analysis_var, order), - new_var = !!new_var, - mode = "first", - check_type = check_type - ), - derive_var_extreme_flag( - dataset = dplyr::filter(dataset, !!param_var %in% worst_high), - by_vars = by_vars, - order = expr_c(expr(desc(!!analysis_var)), order), - new_var = !!new_var, - mode = "first", - check_type = check_type - ), - dplyr::filter(dataset, !(!!param_var %in% c(worst_low, worst_high))) + details = "Please use `slice_derivation()` / `derive_var_extreme_flag()`" ) } diff --git a/R/derive_var_joined_exist_flag.R b/R/derive_var_joined_exist_flag.R index 95a9dae0d4..d96e97476f 100644 --- a/R/derive_var_joined_exist_flag.R +++ b/R/derive_var_joined_exist_flag.R @@ -388,6 +388,7 @@ derive_var_joined_exist_flag <- function(dataset, ) %>% remove_tmp_vars() } + #' Derive Confirmation Flag #' #' @description diff --git a/R/derive_var_last_dose_amt.R b/R/derive_var_last_dose_amt.R index 23f95205c6..7d6051d829 100644 --- a/R/derive_var_last_dose_amt.R +++ b/R/derive_var_last_dose_amt.R @@ -1,6 +1,13 @@ #' Derive Last Dose Amount #' -#' Add a variable for dose amount from the last dose to the input dataset. +#' @description Add a variable for dose amount from the last dose to the input dataset. +#' +#' **Note:** This is a wrapper function for the function `derive_vars_last_dose()`. +#' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' This function is *deprecated*, please use `derive_vars_joined()` instead. #' #' @inheritParams derive_vars_last_dose #' @param new_var The new variable added to `dataset`. @@ -17,63 +24,12 @@ #' @return Input dataset with additional column `new_var`. #' #' -#' @family der_gen -#' @keywords der_gen +#' @family deprecated +#' @keywords deprecated #' #' @export #' #' @seealso [derive_vars_last_dose()], [create_single_dose_dataset()] -#' -#' @examples -#' library(dplyr, warn.conflicts = FALSE) -#' library(admiral.test) -#' data(admiral_ae) -#' data(ex_single) -#' -#' ex_single <- derive_vars_dtm( -#' head(ex_single, 100), -#' dtc = EXENDTC, -#' new_vars_prefix = "EXEN", -#' flag_imputation = "none" -#' ) -#' -#' adae <- admiral_ae %>% -#' head(100) %>% -#' derive_vars_dtm( -#' dtc = AESTDTC, -#' new_vars_prefix = "AST", -#' highest_imputation = "M" -#' ) -#' -#' adae %>% -#' derive_var_last_dose_amt( -#' dataset_ex = ex_single, -#' filter_ex = (EXDOSE > 0 | (EXDOSE == 0 & grepl("PLACEBO", EXTRT))) & -#' !is.na(EXENDTM), -#' dose_date = EXENDTM, -#' analysis_date = ASTDTM, -#' new_var = LDOSE, -#' dose_var = EXDOSE -#' ) %>% -#' select(STUDYID, USUBJID, AESEQ, AESTDTC, LDOSE) -#' -#' # or with traceability variables -#' adae %>% -#' derive_var_last_dose_amt( -#' dataset_ex = ex_single, -#' filter_ex = (EXDOSE > 0 | (EXDOSE == 0 & grepl("PLACEBO", EXTRT))) & -#' !is.na(EXENDTM), -#' dose_date = EXENDTM, -#' analysis_date = ASTDTM, -#' new_var = LDOSE, -#' dose_var = EXDOSE, -#' traceability_vars = exprs( -#' LDOSEDOM = "EX", -#' LDOSESEQ = EXSEQ, -#' LDOSEVAR = "EXDOSE" -#' ) -#' ) %>% -#' select(STUDYID, USUBJID, AESEQ, AESTDTC, LDOSEDOM, LDOSESEQ, LDOSEVAR, LDOSE) derive_var_last_dose_amt <- function(dataset, dataset_ex, filter_ex = NULL, @@ -85,6 +41,7 @@ derive_var_last_dose_amt <- function(dataset, new_var, dose_var = EXDOSE, traceability_vars = NULL) { + deprecate_warn("0.11.0", "derive_var_last_dose_amt()", "derive_vars_joined()") filter_ex <- assert_filter_cond(enexpr(filter_ex), optional = TRUE) by_vars <- assert_vars(by_vars) dose_id <- assert_vars(dose_id) diff --git a/R/derive_var_last_dose_date.R b/R/derive_var_last_dose_date.R index a1d7d58f12..126e568262 100644 --- a/R/derive_var_last_dose_date.R +++ b/R/derive_var_last_dose_date.R @@ -1,6 +1,14 @@ #' Derive Last Dose Date-Time #' -#' Add a variable for the dose date or datetime of the last dose to the input dataset. +#' @description Add a variable for the dose date or datetime of the last dose to +#' the input dataset. +#' +#' **Note:** This is a wrapper function for the function `derive_vars_last_dose()`. +#' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' This function is *deprecated*, please use `derive_vars_joined()` instead. #' #' @inheritParams derive_vars_last_dose #' @param new_var The new date or datetime variable added to `dataset`. @@ -20,45 +28,12 @@ #' @return Input dataset with additional column `new_var`. #' #' -#' @family der_gen -#' @keywords der_gen +#' @family deprecated +#' @keywords deprecated #' #' @export #' #' @seealso [derive_vars_last_dose()], [create_single_dose_dataset()] -#' -#' @examples -#' library(dplyr, warn.conflicts = FALSE) -#' library(admiral.test) -#' data(admiral_ae) -#' data(ex_single) -#' -#' ex_single <- derive_vars_dtm( -#' head(ex_single, 100), -#' dtc = EXENDTC, -#' new_vars_prefix = "EXEN", -#' flag_imputation = "none" -#' ) -#' -#' adae <- admiral_ae %>% -#' head(100) %>% -#' derive_vars_dtm( -#' dtc = AESTDTC, -#' new_vars_prefix = "AST", -#' highest_imputation = "M" -#' ) -#' -#' adae %>% -#' derive_var_last_dose_date( -#' dataset_ex = ex_single, -#' filter_ex = (EXDOSE > 0 | (EXDOSE == 0 & grepl("PLACEBO", EXTRT))) & -#' !is.na(EXENDTM), -#' dose_date = EXENDTM, -#' analysis_date = ASTDTM, -#' new_var = LDOSEDTM, -#' traceability_vars = exprs(LDOSEDOM = "EX", LDOSESEQ = EXSEQ, LDOSEVAR = "EXDOSE") -#' ) %>% -#' select(STUDYID, USUBJID, AESEQ, AESTDTC, LDOSEDOM, LDOSESEQ, LDOSEVAR, LDOSEDTM) derive_var_last_dose_date <- function(dataset, dataset_ex, filter_ex = NULL, @@ -70,6 +45,7 @@ derive_var_last_dose_date <- function(dataset, new_var, output_datetime = TRUE, traceability_vars = NULL) { + deprecate_warn("0.11.0", "derive_var_last_dose_date()", "derive_vars_joined()") filter_ex <- assert_filter_cond(enexpr(filter_ex), optional = TRUE) by_vars <- assert_vars(by_vars) dose_id <- assert_vars(dose_id) diff --git a/R/derive_var_last_dose_grp.R b/R/derive_var_last_dose_grp.R index 13a77bac5d..b51d2370a4 100644 --- a/R/derive_var_last_dose_grp.R +++ b/R/derive_var_last_dose_grp.R @@ -1,6 +1,14 @@ #' Derive Last Dose with User-Defined Groupings #' -#' Add a variable for user-defined dose grouping of the last dose to the input dataset. +#' @description Add a variable for user-defined dose grouping of the last dose +#' to the input dataset. +#' +#' **Note:** This is a wrapper function for the function `derive_vars_last_dose()`. +#' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' This function is *deprecated*, please use `derive_vars_joined()` instead. #' #' @inheritParams derive_vars_last_dose #' @param new_var The output variable defined by the user. @@ -28,51 +36,12 @@ #' @return Input dataset with additional column `new_var`. #' #' -#' @family der_gen -#' @keywords der_gen +#' @family deprecated +#' @keywords deprecated #' #' @export #' #' @seealso [derive_vars_last_dose()], [cut()], [create_single_dose_dataset()] -#' -#' @examples -#' library(dplyr, warn.conflicts = FALSE) -#' library(admiral.test) -#' data(admiral_ae) -#' data(ex_single) -#' -#' ex_single <- derive_vars_dtm( -#' head(ex_single, 100), -#' dtc = EXSTDTC, -#' new_vars_prefix = "EXST", -#' flag_imputation = "none" -#' ) -#' -#' adae <- admiral_ae %>% -#' head(100) %>% -#' derive_vars_dtm( -#' dtc = AESTDTC, -#' new_vars_prefix = "AST", -#' highest_imputation = "M" -#' ) -#' -#' adae %>% -#' derive_var_last_dose_grp( -#' dataset_ex = ex_single, -#' filter_ex = (EXDOSE > 0 | (EXDOSE == 0 & grepl("PLACEBO", EXTRT))) & -#' !is.na(EXSTDTM), -#' by_vars = exprs(STUDYID, USUBJID), -#' dose_date = EXSTDTM, -#' new_var = LDGRP, -#' grp_brks = c(0, 20, 40, 60), -#' grp_lbls = c("Low", "Medium", "High"), -#' include_lowest = TRUE, -#' right = TRUE, -#' dose_var = EXDOSE, -#' analysis_date = ASTDTM, -#' traceability_vars = exprs(LDOSEDOM = "EX", LDOSESEQ = EXSEQ, LDOSEVAR = "EXENDTC") -#' ) %>% -#' select(USUBJID, LDGRP, LDOSEDOM, LDOSESEQ, LDOSEVAR) derive_var_last_dose_grp <- function(dataset, dataset_ex, filter_ex = NULL, @@ -88,6 +57,7 @@ derive_var_last_dose_grp <- function(dataset, right = TRUE, dose_var = EXDOSE, traceability_vars = NULL) { + deprecate_warn("0.11.0", "derive_var_last_dose_grp()", "derive_vars_joined()") filter_ex <- assert_filter_cond(enexpr(filter_ex), optional = TRUE) by_vars <- assert_vars(by_vars) dose_date <- assert_symbol(enexpr(dose_date)) diff --git a/R/derive_var_obs_number.R b/R/derive_var_obs_number.R index 19a2fdf36f..ffa425263f 100644 --- a/R/derive_var_obs_number.R +++ b/R/derive_var_obs_number.R @@ -50,11 +50,34 @@ #' #' @examples #' library(dplyr, warn.conflicts = FALSE) -#' library(admiral.test) -#' data("admiral_vs") -#' -#' admiral_vs %>% -#' select(USUBJID, VSTESTCD, VISITNUM, VSTPTNUM) %>% +#' vs <- tribble( +#' ~STUDYID, ~DOMAIN, ~USUBJID, ~VSTESTCD, ~VISITNUM, ~VSTPTNUM, +#' "PILOT01", "VS", "01-703-1182", "DIABP", 3, 815, +#' "PILOT01", "VS", "01-703-1182", "DIABP", 3, 816, +#' "PILOT01", "VS", "01-703-1182", "DIABP", 4, 815, +#' "PILOT01", "VS", "01-703-1182", "DIABP", 4, 816, +#' "PILOT01", "VS", "01-703-1182", "PULSE", 3, 815, +#' "PILOT01", "VS", "01-703-1182", "PULSE", 3, 816, +#' "PILOT01", "VS", "01-703-1182", "PULSE", 4, 815, +#' "PILOT01", "VS", "01-703-1182", "PULSE", 4, 816, +#' "PILOT01", "VS", "01-703-1182", "SYSBP", 3, 815, +#' "PILOT01", "VS", "01-703-1182", "SYSBP", 3, 816, +#' "PILOT01", "VS", "01-703-1182", "SYSBP", 4, 815, +#' "PILOT01", "VS", "01-703-1182", "SYSBP", 4, 816, +#' "PILOT01", "VS", "01-716-1229", "DIABP", 3, 815, +#' "PILOT01", "VS", "01-716-1229", "DIABP", 3, 816, +#' "PILOT01", "VS", "01-716-1229", "DIABP", 4, 815, +#' "PILOT01", "VS", "01-716-1229", "DIABP", 4, 816, +#' "PILOT01", "VS", "01-716-1229", "PULSE", 3, 815, +#' "PILOT01", "VS", "01-716-1229", "PULSE", 3, 816, +#' "PILOT01", "VS", "01-716-1229", "PULSE", 4, 815, +#' "PILOT01", "VS", "01-716-1229", "PULSE", 4, 816, +#' "PILOT01", "VS", "01-716-1229", "SYSBP", 3, 815, +#' "PILOT01", "VS", "01-716-1229", "SYSBP", 3, 816, +#' "PILOT01", "VS", "01-716-1229", "SYSBP", 4, 815, +#' "PILOT01", "VS", "01-716-1229", "SYSBP", 4, 816 +#' ) +#' vs %>% #' derive_var_obs_number( #' by_vars = exprs(USUBJID, VSTESTCD), #' order = exprs(VISITNUM, desc(VSTPTNUM)) @@ -67,7 +90,7 @@ derive_var_obs_number <- function(dataset, # checks and quoting new_var <- assert_symbol(enexpr(new_var)) assert_vars(by_vars, optional = TRUE) - assert_order_vars(order, optional = TRUE) + assert_expr_list(order, optional = TRUE) if (!is.null(by_vars)) { required_vars <- by_vars } else { @@ -87,7 +110,7 @@ derive_var_obs_number <- function(dataset, # derivation data <- dataset - if (!is.null(by_vars) | !is.null(order)) { + if (!is.null(by_vars) || !is.null(order)) { # group and sort input dataset if (!is.null(by_vars)) { data <- data %>% @@ -97,7 +120,7 @@ derive_var_obs_number <- function(dataset, if (check_type != "none") { signal_duplicate_records( data, - by_vars = required_vars, + by_vars = expr_c(by_vars, order), cnd_type = check_type ) } diff --git a/R/derive_var_relative_flag.R b/R/derive_var_relative_flag.R index 36a63af7bb..42883f1c45 100644 --- a/R/derive_var_relative_flag.R +++ b/R/derive_var_relative_flag.R @@ -18,8 +18,8 @@ #' #' Within each by group the observations are ordered by the specified order. #' -#' *Permitted Values:* list of variables or `desc()` function calls -#' created by `exprs()`, e.g., `exprs(ADT, desc(AVAL))` +#' *Permitted Values:* list of expressions created by `exprs()`, e.g., +#' `exprs(ADT, desc(AVAL))` #' #' @param new_var New variable #' diff --git a/R/derive_var_trtdurd.R b/R/derive_var_trtdurd.R index c206bfa1a7..d2e3e46042 100644 --- a/R/derive_var_trtdurd.R +++ b/R/derive_var_trtdurd.R @@ -1,6 +1,8 @@ #' Derive Total Treatment Duration (Days) #' -#' Derives total treatment duration (days) (`TRTDURD`) +#' @description Derives total treatment duration (days) (`TRTDURD`). +#' +#' **Note:** This is a wrapper function for the more generic `derive_vars_duration()`. #' #' @param dataset Input dataset #' diff --git a/R/derive_vars_aage.R b/R/derive_vars_aage.R index 58c0ed430f..c8c041562c 100644 --- a/R/derive_vars_aage.R +++ b/R/derive_vars_aage.R @@ -1,6 +1,8 @@ #' Derive Analysis Age #' -#' Derives analysis age (`AAGE`) and analysis age unit (`AAGEU`) +#' @description Derives analysis age (`AAGE`) and analysis age unit (`AAGEU`). +#' +#' **Note:** This is a wrapper function for the more generic `derive_vars_duration()`. #' #' @param dataset Input dataset #' @@ -116,8 +118,6 @@ derive_vars_aage <- function(dataset, #' equivalent years as a double. Note, underlying computations assume an equal number #' of days in each year (365.25). #' -#' @author Michael Thorpe -#' #' @return The input dataset (`dataset`) with `new_var` variable added in years. #' #' @family der_adsl @@ -183,11 +183,7 @@ derive_var_age_years <- function(dataset, age_var, age_unit = NULL, new_var) { abort(err_msg) } else { ds <- dataset %>% - mutate( - !!new_var := time_length(duration(!!age_var, units = age_unit), - unit = "years" - ) - ) + mutate(!!new_var := compute_age_years(!!age_var, age_unit)) } } else { unit <- unique(tolower(pull(dataset, !!sym(unit_var)))) @@ -220,69 +216,8 @@ derive_var_age_years <- function(dataset, age_var, age_unit = NULL, new_var) { } } - average_durations <- c( - seconds = 365.25 * 24 * 60 * 60, - minutes = 365.25 * 24 * 60, - hours = 365.25 * 24, - days = 365.25, - weeks = 365.25 / 7, - months = 12, - years = 1 - ) - ds <- dataset %>% - mutate(!!new_var := !!age_var / unname(average_durations[tolower(!!sym(unit_var))])) + mutate(!!new_var := compute_age_years(!!age_var, !!sym(unit_var))) } return(ds) } - - -#' Derive Age Groups -#' -#' @description -#' `r lifecycle::badge("deprecated")` -#' -#' This function is *deprecated*, please create a user defined function instead. -#' -#' @param dataset Input dataset -#' -#' @param age_var AGE variable -#' -#' @param age_unit AGE unit variable -#' -#' @param new_var New variable to create inside `dataset` -#' -#' @keywords deprecated -#' @family deprecated -#' -#' -#' @name derive_var_agegr_fda -NULL - -#' @rdname derive_var_agegr_fda -#' -#' @keywords deprecated -#' @family deprecated -#' -#' @export -derive_var_agegr_fda <- function(dataset, age_var, age_unit = NULL, new_var) { - deprecate_stop("0.8.0", "derive_var_agegr_fda()", - details = "Please create a user defined function instead." - ) -} - -#' @description -#' `r lifecycle::badge("deprecated")` -#' -#' This function is *deprecated*, please create a user defined function instead. -#' @rdname derive_var_agegr_fda -#' -#' @keywords deprecated -#' @family deprecated -#' -#' @export -derive_var_agegr_ema <- function(dataset, age_var, age_unit = NULL, new_var) { - deprecate_stop("0.8.0", "derive_var_agegr_ema()", - details = "Please create a user defined function instead." - ) -} diff --git a/R/derive_vars_disposition_reason.R b/R/derive_vars_disposition_reason.R index a611d69f3d..e99a8bdc82 100644 --- a/R/derive_vars_disposition_reason.R +++ b/R/derive_vars_disposition_reason.R @@ -28,7 +28,7 @@ #' @seealso [derive_vars_disposition_reason()] format_reason_default <- function(reason, reason_spe = NULL) { ### DEPRECATION - deprecate_warn("0.10.0", + deprecate_stop("0.10.0", "format_reason_default()", details = paste( "This function is a default for `derive_vars_disposition_reason() and is being deprecated`", @@ -36,12 +36,6 @@ format_reason_default <- function(reason, reason_spe = NULL) { "specify the `filter_add` argument to derive the respective variables." ) ) - - if (is.null(reason_spe)) { - if_else(reason != "COMPLETED" & !is.na(reason), reason, NA_character_) - } else { - if_else(reason == "OTHER", reason_spe, NA_character_) - } } #' Derive a Disposition Reason at a Specific Timepoint @@ -154,58 +148,11 @@ derive_vars_disposition_reason <- function(dataset, filter_ds, subject_keys = get_admiral_option("subject_keys")) { ### DEPRECATION - deprecate_warn("0.10.0", + deprecate_stop("0.10.0", "derive_vars_disposition_reason()", details = paste( "Please use `derive_vars_merged()`", "and specify the `filter_add` argument to derive the respective variables" ) ) - - new_var <- assert_symbol(enexpr(new_var)) - reason_var <- assert_symbol(enexpr(reason_var)) - new_var_spe <- assert_symbol(enexpr(new_var_spe), optional = T) - reason_var_spe <- assert_symbol(enexpr(reason_var_spe), optional = T) - assert_s3_class(format_new_vars, "function") - filter_ds <- assert_filter_cond(enexpr(filter_ds)) - assert_vars(subject_keys) - assert_data_frame(dataset, required_vars = subject_keys) - assert_data_frame( - dataset_ds, - required_vars = expr_c(subject_keys, reason_var, reason_var_spe) - ) - warn_if_vars_exist(dataset, as_name(new_var)) - - # Additional checks - if (!is.null(new_var_spe)) { - if (!is.null(reason_var_spe)) { - statusvar <- c(as_name(reason_var), as_name(reason_var_spe)) - } else { - err_msg <- paste( - "`new_var_spe` is specified as ", as_name(new_var_spe), - "but `reason_var_spe` is NULL.", - "Please specify `reason_var_spe` together with `new_var_spe`." - ) - abort(err_msg) - } - } else { - statusvar <- as_name(reason_var) - } - - dataset <- dataset %>% - derive_vars_merged( - dataset_add = dataset_ds, - filter_add = !!filter_ds, - new_vars = expr_c(reason_var, reason_var_spe), - by_vars = subject_keys - ) %>% - mutate(!!new_var := format_new_vars(!!reason_var)) - - if (!is.null(new_var_spe)) { - dataset <- mutate( - dataset, - !!new_var_spe := format_new_vars(!!reason_var, !!reason_var_spe) - ) - } - select(dataset, -statusvar) } diff --git a/R/derive_vars_dtm_to_dt.R b/R/derive_vars_dtm_to_dt.R index 86158f9ca6..7b1a74078d 100644 --- a/R/derive_vars_dtm_to_dt.R +++ b/R/derive_vars_dtm_to_dt.R @@ -60,6 +60,6 @@ derive_vars_dtm_to_dt <- function(dataset, source_vars) { rename_with(.cols = ends_with("new"), .fn = ~ str_replace(., "DTM_new", "DT")) } else { dataset %>% - mutate(!!sym(dt_vars) := lubridate::date(!!sym(dtm_vars2))) + mutate(!!sym(dt_vars) := date(!!sym(dtm_vars2))) } } diff --git a/R/derive_vars_dy.R b/R/derive_vars_dy.R index 1dfc9c4d51..aa085c32eb 100644 --- a/R/derive_vars_dy.R +++ b/R/derive_vars_dy.R @@ -104,7 +104,7 @@ derive_vars_dy <- function(dataset, dy_vars <- if_else( source_names == "", - stringr::str_replace_all(vars2chr(source_vars), "(DT|DTM)$", "DY"), + str_replace_all(vars2chr(source_vars), "(DT|DTM)$", "DY"), source_names ) warn_if_vars_exist(dataset, dy_vars) diff --git a/R/derive_vars_last_dose.R b/R/derive_vars_last_dose.R index 975d333b1d..77bc93fe9c 100644 --- a/R/derive_vars_last_dose.R +++ b/R/derive_vars_last_dose.R @@ -2,6 +2,11 @@ #' #' Add EX source variables from last dose to the input dataset. #' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' This function is *deprecated*, please use `derive_vars_joined()` instead. +#' #' @param dataset Input dataset. #' The variables specified by the `by_vars` and `analysis_date` parameters are expected. #' @@ -73,60 +78,13 @@ #' @return Input dataset with EX source variables from last dose added. #' #' -#' @family der_gen -#' @keywords der_gen +#' @family deprecated +#' @keywords deprecated #' #' @seealso [derive_var_last_dose_amt()], [derive_var_last_dose_date()], #' [derive_var_last_dose_grp()], [create_single_dose_dataset()] #' #' @export -#' -#' @examples -#' library(dplyr, warn.conflicts = FALSE) -#' library(admiral.test) -#' data(admiral_ae) -#' data(ex_single) -#' -#' # create datetime variables in input datasets -#' ex_single <- derive_vars_dtm( -#' head(ex_single, 100), -#' dtc = EXENDTC, -#' new_vars_prefix = "EXEN", -#' flag_imputation = "none" -#' ) -#' -#' adae <- admiral_ae %>% -#' head(100) %>% -#' derive_vars_dtm( -#' dtc = AESTDTC, -#' new_vars_prefix = "AST", -#' highest_imputation = "M" -#' ) -#' -#' # add last dose vars -#' adae %>% -#' derive_vars_last_dose( -#' dataset_ex = ex_single, -#' filter_ex = (EXDOSE > 0 | (EXDOSE == 0 & grepl("PLACEBO", EXTRT))) & -#' !is.na(EXENDTM), -#' new_vars = exprs(EXDOSE, EXTRT, EXSEQ, EXENDTC, VISIT), -#' dose_date = EXENDTM, -#' analysis_date = ASTDTM -#' ) %>% -#' select(STUDYID, USUBJID, AESEQ, AESTDTC, EXDOSE, EXTRT, EXENDTC, EXSEQ, VISIT) -#' -#' # or with traceability variables -#' adae %>% -#' derive_vars_last_dose( -#' dataset_ex = ex_single, -#' filter_ex = (EXDOSE > 0 | (EXDOSE == 0 & grepl("PLACEBO", EXTRT))) & -#' !is.na(EXENDTM), -#' new_vars = exprs(EXDOSE, EXTRT, EXSEQ, EXENDTC, VISIT), -#' dose_date = EXENDTM, -#' analysis_date = ASTDTM, -#' traceability_vars = exprs(LDOSEDOM = "EX", LDOSESEQ = EXSEQ, LDOSEVAR = "EXENDTC") -#' ) %>% -#' select(STUDYID, USUBJID, AESEQ, AESTDTC, EXDOSE, EXTRT, EXENDTC, LDOSEDOM, LDOSESEQ, LDOSEVAR) derive_vars_last_dose <- function(dataset, dataset_ex, filter_ex = NULL, @@ -137,131 +95,16 @@ derive_vars_last_dose <- function(dataset, single_dose_condition = EXDOSFRQ == "ONCE", new_vars = NULL, traceability_vars = NULL) { - filter_ex <- assert_filter_cond(enexpr(filter_ex), optional = TRUE) - by_vars <- assert_vars(by_vars) - dose_id <- assert_vars(dose_id) - dose_date <- assert_symbol(enexpr(dose_date)) - analysis_date <- assert_symbol(enexpr(analysis_date)) - single_dose_condition <- assert_filter_cond(enexpr(single_dose_condition)) - assert_varval_list(new_vars, optional = TRUE, accept_var = TRUE) - assert_varval_list(traceability_vars, optional = TRUE) - assert_data_frame(dataset, expr_c(by_vars, analysis_date)) - if (as_name(dose_date) %in% names(new_vars)) { - required_vars <- expr_c(by_vars, new_vars, get_source_vars(traceability_vars)) - dose_date_res <- new_vars[[as_name(dose_date)]] - } else { - required_vars <- expr_c(by_vars, dose_date, new_vars, get_source_vars(traceability_vars)) - dose_date_res <- dose_date - } - assert_data_frame(dataset_ex, required_vars) - assert_date_var( + deprecate_warn("0.11.0", "derive_vars_last_dose()", "derive_vars_joined()") + derive_vars_joined( dataset = dataset, - var = !!analysis_date - ) - assert_date_var( - dataset = dataset_ex, - var = !!dose_date_res - ) - - # vars converted to string - by_vars_str <- vars2chr(by_vars) - dose_id_str <- vars2chr(dose_id) - - # check if single_dose_condition is true for all EX records - single_dose_eval <- dataset_ex %>% - with(eval_tidy(single_dose_condition)) %>% - all() - - if (!single_dose_eval) { - stop("Specified `single_dose_condition` is not satisfied.") - } - - # check if doses are unique based on `dose_date` and `dose_id` - if (as_name(dose_date) %in% names(new_vars)) { - unique_by <- c(by_vars, new_vars[[as_name(dose_date)]], dose_id) - } else { - unique_by <- c(by_vars, dose_date, dose_id) - } - signal_duplicate_records( - dataset_ex, - unique_by, - "Multiple doses exist for the same `dose_date`. Update `dose_id` to identify unique doses." + dataset_add = dataset_ex, + by_vars = by_vars, + order = expr_c(enexpr(dose_date), dose_id), + new_vars = expr_c({{ new_vars }}, {{ traceability_vars }}), + join_vars = expr_c(enexpr(dose_date), dose_id), + filter_add = {{ filter_ex }}, + filter_join = {{ dose_date }} <= {{ analysis_date }}, + mode = "last", ) - - # filter EX based on user-specified condition - if (!is.null(filter_ex)) { - dataset_ex <- dataset_ex %>% - filter_if(filter_ex) - } - - # create traceability vars if requested - if (!is.null(traceability_vars)) { - trace_vars_str <- names(traceability_vars) - dataset_ex <- mutate(dataset_ex, !!!traceability_vars) - } else { - trace_vars_str <- character(0) - } - - # keep user-specified variables from EX, if no variables specified all EX variables are kept - if (!is.null(new_vars)) { - new_vars_name <- replace_values_by_names(new_vars) - dataset_ex <- dataset_ex %>% - mutate(!!!new_vars) %>% - select( - !!!by_vars, !!!syms(dose_id_str), !!dose_date, - !!!new_vars_name, !!!syms(trace_vars_str) - ) - } else { - new_vars_name <- syms(colnames(dataset_ex)) - } - - # check if any variable exist in both dataset and dataset_ex (except for by_vars) before join - dataset_var <- colnames(dataset)[!colnames(dataset) %in% by_vars_str] - dataset_ex_var <- colnames(dataset_ex)[!colnames(dataset_ex) %in% by_vars_str] - dup_var <- enumerate(intersect(dataset_var, dataset_ex_var)) - - if (length(intersect(dataset_var, dataset_ex_var)) != 0) { - stop("Variable(s) ", paste(dup_var, "found in both datasets, cannot perform join")) - } - - # create temporary observation number and temporary numeric date to identify last dose - dataset <- dataset %>% - derive_var_obs_number( - new_var = tmp_seq_var - ) %>% - mutate( - tmp_analysis_date = convert_date_to_dtm( - dt = !!analysis_date, - time_imputation = "last" - ) - ) - - # create tmp numeric date to enable date comparison for identifying last dose - dataset_ex <- dataset_ex %>% - mutate( - tmp_dose_date = convert_date_to_dtm( - dt = !!dose_date - ) - ) - - - # join datasets and keep unique last dose records (where dose_date is before or on analysis_date) - res <- dataset %>% - select(!!!by_vars, tmp_seq_var, tmp_analysis_date) %>% - inner_join(dataset_ex, by = by_vars_str) %>% - filter(!is.na(tmp_dose_date) & !is.na(tmp_analysis_date) & - tmp_dose_date <= tmp_analysis_date) %>% - filter_extreme( - by_vars = exprs(tmp_seq_var), - order = c(exprs(tmp_dose_date), dose_id), - mode = "last" - ) %>% - select(tmp_seq_var, !!!new_vars_name, !!!syms(trace_vars_str), -by_vars_str) - - # return observations from original dataset with last dose variables added - derive_vars_merged( - dataset, - dataset_add = res, - by_vars = exprs(tmp_seq_var) - ) %>% select(-starts_with("tmp_")) } diff --git a/R/derive_vars_query.R b/R/derive_vars_query.R index d1a0391ffc..4063a0db21 100644 --- a/R/derive_vars_query.R +++ b/R/derive_vars_query.R @@ -10,27 +10,27 @@ #' [Queries Dataset Documentation vignette](../articles/queries_dataset.html) #' for descriptions, or call `data("queries")` for an example of a query dataset. #' -#' For each unique element in `VAR_PREFIX`, the corresponding "NAM" -#' variable will be created. For each unique `VAR_PREFIX`, if `QUERY_ID` is +#' For each unique element in `PREFIX`, the corresponding "NAM" +#' variable will be created. For each unique `PREFIX`, if `GRPID` is #' not "" or NA, then the corresponding "CD" variable is created; similarly, -#' if `QUERY_SCOPE` is not "" or NA, then the corresponding "SC" variable will -#' be created; if `QUERY_SCOPE_NUM` is not "" or NA, then the corresponding +#' if `SCOPE` is not "" or NA, then the corresponding "SC" variable will +#' be created; if `SCOPEN` is not "" or NA, then the corresponding #' "SCN" variable will be created. #' #' For each record in `dataset`, the "NAM" variable takes the value of -#' `QUERY_NAME` if the value of `TERM_NAME` or `TERM_ID` in `dataset_queries` matches -#' the value of the respective TERM_LEVEL in `dataset`. -#' Note that `TERM_NAME` in `dataset_queries` dataset may be NA only when `TERM_ID` +#' `GRPNAME` if the value of `TERMNAME` or `TERMID` in `dataset_queries` matches +#' the value of the respective SRCVAR in `dataset`. +#' Note that `TERMNAME` in `dataset_queries` dataset may be NA only when `TERMID` #' is non-NA and vice versa. #' The "CD", "SC", and "SCN" variables are derived accordingly based on -#' `QUERY_ID`, `QUERY_SCOPE`, and `QUERY_SCOPE_NUM` respectively, +#' `GRPID`, `SCOPE`, and `SCOPEN` respectively, #' whenever not missing. #' #' @param dataset Input dataset. #' -#' @param dataset_queries A dataset containing required columns `VAR_PREFIX`, -#' `QUERY_NAME`, `TERM_LEVEL`, `TERM_NAME`, `TERM_ID`, and optional columns -#' `QUERY_ID`, `QUERY_SCOPE`, `QUERY_SCOPE_NUM`. +#' @param dataset_queries A dataset containing required columns `PREFIX`, +#' `GRPNAME`, `SRCVAR`, `TERMNAME`, `TERMID`, and optional columns +#' `GRPID`, `SCOPE`, `SCOPEN`. #' #' The content of the dataset will be verified by [assert_valid_queries()]. #' @@ -65,34 +65,34 @@ derive_vars_query <- function(dataset, dataset_queries) { assert_data_frame(dataset_queries) assert_valid_queries(dataset_queries, queries_name = deparse(substitute(dataset_queries))) assert_data_frame(dataset, - required_vars = exprs(!!!syms(unique(dataset_queries$TERM_LEVEL))), + required_vars = exprs(!!!syms(unique(dataset_queries$SRCVAR))), optional = FALSE ) dataset_queries <- convert_blanks_to_na(dataset_queries) # names of new columns - if ("QUERY_ID" %notin% names(dataset_queries)) { - dataset_queries$QUERY_ID <- NA_integer_ # nolint + if ("GRPID" %notin% names(dataset_queries)) { + dataset_queries$GRPID <- NA_integer_ # nolint } - if ("QUERY_SCOPE" %notin% names(dataset_queries)) { - dataset_queries$QUERY_SCOPE <- NA_integer_ # nolint + if ("SCOPE" %notin% names(dataset_queries)) { + dataset_queries$SCOPE <- NA_integer_ # nolint } - if ("QUERY_SCOPE_NUM" %notin% names(dataset_queries)) { - dataset_queries$QUERY_SCOPE_NUM <- NA_integer_ # nolint + if ("SCOPEN" %notin% names(dataset_queries)) { + dataset_queries$SCOPEN <- NA_integer_ # nolint } new_col_names <- dataset_queries %>% - group_by(VAR_PREFIX) %>% + group_by(PREFIX) %>% mutate( - NAM = paste0(VAR_PREFIX, "NAM"), - CD = ifelse(!all(is.na(QUERY_ID)), - paste0(VAR_PREFIX, "CD"), NA_character_ + NAM = paste0(PREFIX, "NAM"), + CD = ifelse(!all(is.na(GRPID)), + paste0(PREFIX, "CD"), NA_character_ ), - SC = ifelse(!all(is.na(QUERY_SCOPE)), - paste0(VAR_PREFIX, "SC"), NA_character_ + SC = ifelse(!all(is.na(SCOPE)), + paste0(PREFIX, "SC"), NA_character_ ), - SCN = ifelse(!all(is.na(QUERY_SCOPE_NUM)), - paste0(VAR_PREFIX, "SCN"), NA_character_ + SCN = ifelse(!all(is.na(SCOPEN)), + paste0(PREFIX, "SCN"), NA_character_ ) ) %>% ungroup() %>% @@ -101,8 +101,8 @@ derive_vars_query <- function(dataset, dataset_queries) { pivot_longer(c(NAM, CD, SC, SCN), names_to = "key", values_to = "value") %>% filter(!is.na(value)) %>% mutate( - order1 = stringr::str_extract(value, "^[a-zA-Z]{2,3}"), - order2 = stringr::str_extract(value, "\\d{2}"), + order1 = str_extract(value, "^[a-zA-Z]{2,3}"), + order2 = str_extract(value, "\\d{2}"), order3 = as.integer(factor(key, levels = c("NAM", "CD", "SC", "SCN"))) ) %>% arrange(desc(order1), order2, order3) %>% @@ -111,24 +111,24 @@ derive_vars_query <- function(dataset, dataset_queries) { # queries restructured queries_wide <- dataset_queries %>% mutate( - TERM_NAME = toupper(.data$TERM_NAME), - VAR_PREFIX_NAM = paste0(.data$VAR_PREFIX, "NAM") + TERMNAME = toupper(TERMNAME), + PREFIX_NAM = paste0(PREFIX, "NAM") ) %>% - pivot_wider(names_from = .data$VAR_PREFIX_NAM, values_from = .data$QUERY_NAME) %>% - mutate(VAR_PREFIX_CD = paste0(.data$VAR_PREFIX, "CD")) %>% - pivot_wider(names_from = .data$VAR_PREFIX_CD, values_from = .data$QUERY_ID) %>% - mutate(VAR_PREFIX_SC = paste0(.data$VAR_PREFIX, "SC")) %>% - pivot_wider(names_from = .data$VAR_PREFIX_SC, values_from = .data$QUERY_SCOPE) %>% - mutate(VAR_PREFIX_SCN = paste0(.data$VAR_PREFIX, "SCN")) %>% - pivot_wider(names_from = .data$VAR_PREFIX_SCN, values_from = .data$QUERY_SCOPE_NUM) %>% - select(-VAR_PREFIX) %>% - # determine join column based on type of TERM_LEVEL - # numeric -> TERM_ID, character -> TERM_NAME, otherwise -> error + pivot_wider(names_from = PREFIX_NAM, values_from = GRPNAME) %>% + mutate(PREFIX_CD = paste0(PREFIX, "CD")) %>% + pivot_wider(names_from = PREFIX_CD, values_from = GRPID) %>% + mutate(PREFIX_SC = paste0(PREFIX, "SC")) %>% + pivot_wider(names_from = PREFIX_SC, values_from = SCOPE) %>% + mutate(PREFIX_SCN = paste0(PREFIX, "SCN")) %>% + pivot_wider(names_from = PREFIX_SCN, values_from = SCOPEN) %>% + select(-PREFIX) %>% + # determine join column based on type of SRCVAR + # numeric -> TERMID, character -> TERMNAME, otherwise -> error mutate( - tmp_col_type = vapply(dataset[.data$TERM_LEVEL], typeof, character(1)), + tmp_col_type = vapply(dataset[SRCVAR], typeof, character(1)), TERM_NAME_ID = case_when( - .data$tmp_col_type == "character" ~ .data$TERM_NAME, - .data$tmp_col_type %in% c("double", "integer") ~ as.character(.data$TERM_ID), + tmp_col_type == "character" ~ TERMNAME, + tmp_col_type %in% c("double", "integer") ~ as.character(TERMID), TRUE ~ NA_character_ ) ) @@ -136,7 +136,7 @@ derive_vars_query <- function(dataset, dataset_queries) { # throw error if any type of column is not character or numeric if (any(is.na(queries_wide$TERM_NAME_ID))) { idx <- is.na(queries_wide$TERM_NAME_ID) - dat_incorrect_type <- dataset[queries_wide$TERM_LEVEL[idx]] + dat_incorrect_type <- dataset[queries_wide$SRCVAR[idx]] msg <- paste0( paste0( colnames(dat_incorrect_type), @@ -150,10 +150,10 @@ derive_vars_query <- function(dataset, dataset_queries) { } # prepare input dataset for joining - static_cols <- setdiff(names(dataset), unique(dataset_queries$TERM_LEVEL)) + static_cols <- setdiff(names(dataset), unique(dataset_queries$SRCVAR)) # if dataset does not have a unique key, create a temp one no_key <- dataset %>% - select(!!!syms(static_cols)) %>% + select(all_of(static_cols)) %>% distinct() if (nrow(no_key) != nrow(dataset)) { dataset$temp_key <- seq_len(nrow(dataset)) @@ -161,25 +161,25 @@ derive_vars_query <- function(dataset, dataset_queries) { } # Keep static variables - will add back on once non-static vars fixed - df_static <- dataset %>% select(static_cols) + df_static <- dataset %>% select(all_of(static_cols)) # Change non-static numeric vars to character df_fix_numeric <- dataset %>% - select(-static_cols) %>% + select(-all_of(static_cols)) %>% mutate(across(where(is.numeric), as.character)) joined <- cbind(df_static, df_fix_numeric) %>% - pivot_longer(-static_cols, names_to = "TERM_LEVEL", values_to = "TERM_NAME_ID") %>% - drop_na(.data$TERM_NAME_ID) %>% - mutate(TERM_NAME_ID = toupper(.data$TERM_NAME_ID)) + pivot_longer(-all_of(static_cols), names_to = "SRCVAR", values_to = "TERM_NAME_ID") %>% + drop_na(TERM_NAME_ID) %>% + mutate(TERM_NAME_ID = toupper(TERM_NAME_ID)) # join restructured queries to input dataset joined <- joined %>% - inner_join(queries_wide, by = c("TERM_LEVEL", "TERM_NAME_ID")) %>% + inner_join(queries_wide, by = c("SRCVAR", "TERM_NAME_ID")) %>% select(!!!syms(c(static_cols, new_col_names))) %>% - dplyr::group_by_at(static_cols) %>% - dplyr::summarise_all(~ dplyr::first(na.omit(.))) %>% + group_by_at(static_cols) %>% + summarise_all(~ first(na.omit(.))) %>% ungroup() # join queries to input dataset @@ -190,16 +190,16 @@ derive_vars_query <- function(dataset, dataset_queries) { #' Verify if a Dataset Has the Required Format as Queries Dataset. #' #' @details Check if the dataset has the following columns -#' - `VAR_PREFIX`, e.g., SMQ01, CQ12 -#' - `QUERY_NAME`, non NA, must be unique per each `VAR_PREFIX` -#' - `QUERY_ID`, could be NA, must be unique per each `VAR_PREFIX` -#' - `QUERY_SCOPE`, 'BROAD', 'NARROW', or NA -#' - `QUERY_SCOPE_NUM`, 1, 2, or NA -#' - `TERM_LEVEL`, e.g., `"AEDECOD"`, `"AELLT"`, `"AELLTCD"`, ... -#' - `TERM_NAME`, character, could be NA only at those observations -#' where `TERM_ID` is non-NA -#' - `TERM_ID`, integer, could be NA only at those observations -#' where `TERM_NAME` is non-NA +#' - `PREFIX`, e.g., SMQ01, CQ12 +#' - `GRPNAME`, non NA, must be unique per each `PREFIX` +#' - `GRPID`, could be NA, must be unique per each `PREFIX` +#' - `SCOPE`, 'BROAD', 'NARROW', or NA +#' - `SCOPEN`, 1, 2, or NA +#' - `SRCVAR`, e.g., `"AEDECOD"`, `"AELLT"`, `"AELLTCD"`, ... +#' - `TERMNAME`, character, could be NA only at those observations +#' where `TERMID` is non-NA +#' - `TERMID`, integer, could be NA only at those observations +#' where `TERMNAME` is non-NA #' #' @param queries A data.frame. #' @@ -220,73 +220,73 @@ assert_valid_queries <- function(queries, queries_name) { # check required columns assert_has_variables( queries, - c("VAR_PREFIX", "QUERY_NAME", "TERM_LEVEL", "TERM_NAME", "TERM_ID") + c("PREFIX", "GRPNAME", "SRCVAR", "TERMNAME", "TERMID") ) # check duplicate rows signal_duplicate_records(queries, by_vars = exprs(!!!syms(colnames(queries)))) # check illegal prefix category - is_good_prefix <- grepl("^[a-zA-Z]{2,3}", queries$VAR_PREFIX) + is_good_prefix <- grepl("^[a-zA-Z]{2,3}", queries$PREFIX) if (!all(is_good_prefix)) { abort( paste0( - "`VAR_PREFIX` in `", queries_name, + "`PREFIX` in `", queries_name, "` must start with 2-3 letters.. Problem with ", - enumerate(unique(queries$VAR_PREFIX[!is_good_prefix])), + enumerate(unique(queries$PREFIX[!is_good_prefix])), "." ) ) } # check illegal prefix number - query_num <- sub("[[:alpha:]]+", "", queries$VAR_PREFIX) + query_num <- sub("[[:alpha:]]+", "", queries$PREFIX) is_bad_num <- nchar(query_num) != 2 | is.na(as.numeric(query_num)) if (any(is_bad_num)) { abort( paste0( - "`VAR_PREFIX` in `", queries_name, + "`PREFIX` in `", queries_name, "` must end with 2-digit numbers. Issue with ", - enumerate(unique(queries$VAR_PREFIX[is_bad_num])), + enumerate(unique(queries$PREFIX[is_bad_num])), "." ) ) } # check illegal query name - if (any(queries$QUERY_NAME == "") | any(is.na(queries$QUERY_NAME))) { + if (any(queries$GRPNAME == "") || any(is.na(queries$GRPNAME))) { abort(paste0( - "`QUERY_NAME` in `", queries_name, + "`GRPNAME` in `", queries_name, "` cannot be empty string or NA." )) } # check query id is numeric - if ("QUERY_ID" %in% names(queries) && !is.numeric(queries$QUERY_ID)) { + if ("GRPID" %in% names(queries) && !is.numeric(queries$GRPID)) { abort(paste0( - "`QUERY_ID` in `", queries_name, + "`GRPID` in `", queries_name, "` should be numeric." )) } # check illegal query scope - if ("QUERY_SCOPE" %in% names(queries) && - any(unique(queries$QUERY_SCOPE) %notin% c("BROAD", "NARROW", "", NA_character_))) { + if ("SCOPE" %in% names(queries) && + any(unique(queries$SCOPE) %notin% c("BROAD", "NARROW", "", NA_character_))) { abort(paste0( - "`QUERY_SCOPE` in `", queries_name, + "`SCOPE` in `", queries_name, "` can only be 'BROAD', 'NARROW' or `NA`." )) } # check illegal query scope number - if ("QUERY_SCOPE_NUM" %in% names(queries)) { - is_bad_scope_num <- queries$QUERY_SCOPE_NUM %notin% c(1, 2, NA_integer_) + if ("SCOPEN" %in% names(queries)) { + is_bad_scope_num <- queries$SCOPEN %notin% c(1, 2, NA_integer_) if (any(is_bad_scope_num)) { abort( paste0( - "`QUERY_SCOPE_NUM` in `", queries_name, + "`SCOPEN` in `", queries_name, "` must be one of 1, 2, or NA. Issue with ", - enumerate(unique(queries$QUERY_SCOPE_NUM[is_bad_scope_num])), + enumerate(unique(queries$SCOPEN[is_bad_scope_num])), "." ) ) @@ -294,22 +294,22 @@ assert_valid_queries <- function(queries, queries_name) { } # check illegal term name - if (any(is.na(queries$TERM_NAME) & is.na(queries$TERM_ID)) | - any(queries$TERM_NAME == "" & is.na(queries$TERM_ID))) { + if (any(is.na(queries$TERMNAME) & is.na(queries$TERMID)) || + any(queries$TERMNAME == "" & is.na(queries$TERMID))) { abort(paste0( - "Either `TERM_NAME` or `TERM_ID` need to be specified", + "Either `TERMNAME` or `TERMID` need to be specified", " in `", queries_name, "`. ", "They both cannot be NA or empty." )) } - # each VAR_PREFIX must have unique QUERY_NAME, QUERY_ID if the columns exist + # each PREFIX must have unique GRPNAME, GRPID if the columns exist count_unique <- queries %>% - group_by(VAR_PREFIX) %>% - dplyr::summarise( - n_qnam = length(unique(QUERY_NAME)), - n_qid = ifelse("QUERY_ID" %in% names(queries), - length(unique(QUERY_ID)), 0 + group_by(PREFIX) %>% + summarise( + n_qnam = length(unique(GRPNAME)), + n_qid = ifelse("GRPID" %in% names(queries), + length(unique(GRPID)), 0 ) ) %>% ungroup() @@ -317,8 +317,8 @@ assert_valid_queries <- function(queries, queries_name) { if (any(count_unique$n_qnam > 1)) { idx <- which(count_unique$n_qnam > 1) abort(paste0( - "In `", queries_name, "`, `QUERY_NAME` of '", - paste(count_unique$VAR_PREFIX[idx], collapse = ", "), + "In `", queries_name, "`, `GRPNAME` of '", + paste(count_unique$PREFIX[idx], collapse = ", "), "' is not unique." )) } @@ -326,14 +326,14 @@ assert_valid_queries <- function(queries, queries_name) { if (any(count_unique$n_qid > 1)) { idx <- which(count_unique$n_qid > 1) abort(paste0( - "In `", queries_name, "`, `QUERY_ID` of '", - paste(count_unique$VAR_PREFIX[idx], collapse = ", "), + "In `", queries_name, "`, `GRPID` of '", + paste(count_unique$PREFIX[idx], collapse = ", "), "' is not unique." )) } - # check QUERY_SCOPE and QUERY_SCOPE_NUM are one to one if available - if ("QUERY_SCOPE" %in% names(queries) & "QUERY_SCOPE_NUM" %in% names(queries)) { - assert_one_to_one(queries, exprs(QUERY_SCOPE), exprs(QUERY_SCOPE_NUM)) + # check SCOPE and SCOPEN are one to one if available + if ("SCOPE" %in% names(queries) && "SCOPEN" %in% names(queries)) { + assert_one_to_one(queries, exprs(SCOPE), exprs(SCOPEN)) } } diff --git a/R/derive_vars_transposed.R b/R/derive_vars_transposed.R index c9e03219ea..1ae95521b7 100644 --- a/R/derive_vars_transposed.R +++ b/R/derive_vars_transposed.R @@ -98,7 +98,9 @@ derive_vars_transposed <- function(dataset, #' Derive ATC Class Variables #' -#' Add Anatomical Therapeutic Chemical class variables from `FACM` to `ADCM` +#' @description Add Anatomical Therapeutic Chemical class variables from `FACM` to `ADCM`. +#' +#' **Note:** This is a wrapper function for the more generic `derive_vars_transposed()`. #' #' @param dataset Input dataset #' diff --git a/R/duplicates.R b/R/duplicates.R index 6cce93e6a4..04a51a85cf 100644 --- a/R/duplicates.R +++ b/R/duplicates.R @@ -36,8 +36,8 @@ get_duplicates_dataset <- function() { #' Extract Duplicate Records #' #' @param dataset A data frame -#' @param by_vars A list of variables created using `exprs()` identifying groups of -#' records in which to look for duplicates +#' @param by_vars A list of expressions created using `exprs()` identifying +#' groups of records in which to look for duplicates #' #' @return A `data.frame` of duplicate records within `dataset` #' @@ -54,18 +54,24 @@ get_duplicates_dataset <- function() { #' #' extract_duplicate_records(adsl, exprs(USUBJID)) extract_duplicate_records <- function(dataset, by_vars) { - assert_vars(by_vars) - assert_data_frame(dataset, required_vars = by_vars, check_is_grouped = FALSE) + assert_expr_list(by_vars) + assert_data_frame(dataset, required_vars = extract_vars(by_vars), check_is_grouped = FALSE) data_by <- dataset %>% ungroup() %>% - select(!!!by_vars) + # evaluate expressions in by_vars + transmute(!!!by_vars) is_duplicate <- duplicated(data_by) | duplicated(data_by, fromLast = TRUE) dataset %>% ungroup() %>% - select(!!!by_vars, dplyr::everything()) %>% + # evaluate expressions in by_vars + mutate(!!!by_vars) %>% + # move by variables to the beginning + # if by_vars includes unnamed expressions, the unevaluated expression is + # used as variable name + select(!!!syms(map(replace_values_by_names(by_vars), as_label)), everything()) %>% filter(is_duplicate) %>% arrange(!!!by_vars) } @@ -73,8 +79,8 @@ extract_duplicate_records <- function(dataset, by_vars) { #' Signal Duplicate Records #' #' @param dataset A data frame -#' @param by_vars A list of variables created using `exprs()` identifying groups of -#' records in which to look for duplicates +#' @param by_vars A list of expressions created using `exprs()` identifying +#' groups of records in which to look for duplicates #' @param msg The condition message #' @param cnd_type Type of condition to signal when detecting duplicate records. #' One of `"message"`, `"warning"` or `"error"`. Default is `"error"`. @@ -94,10 +100,10 @@ extract_duplicate_records <- function(dataset, by_vars) { #' signal_duplicate_records(adsl, exprs(USUBJID), cnd_type = "message") signal_duplicate_records <- function(dataset, by_vars, - msg = paste("Dataset contains duplicate records with respect to", enumerate(vars2chr(by_vars))), # nolint + msg = paste("Dataset contains duplicate records with respect to", enumerate(replace_values_by_names(by_vars))), # nolint cnd_type = "error") { - assert_vars(by_vars) - assert_data_frame(dataset, required_vars = by_vars, check_is_grouped = FALSE) + assert_expr_list(by_vars) + assert_data_frame(dataset, required_vars = extract_vars(by_vars), check_is_grouped = FALSE) assert_character_scalar(msg) assert_character_scalar(cnd_type, values = c("message", "warning", "error")) @@ -108,16 +114,28 @@ signal_duplicate_records <- function(dataset, admiral_environment$duplicates <- structure( duplicate_records, class = union("duplicates", class(duplicate_records)), - by_vars = vars2chr(by_vars) + by_vars = replace_values_by_names(by_vars) ) full_msg <- paste0(msg, "\nRun `get_duplicates_dataset()` to access the duplicate records") cnd_funs[[cnd_type]](full_msg) } } +#' Print `duplicates` Objects +#' +#' @param x A `duplicates` object +#' @param ... Not used +#' +#' @return No return value, called for side effects +#' +#' +#' @keywords utils_print +#' @family utils_print +#' +#' @export print.duplicates <- function(x, ...) { cat( - "Dataset contains duplicate records with respect to ", + "Duplicate records with respect to ", enumerate(attr(x, "by_vars")), ".\n", sep = "" diff --git a/R/filter_exist.R b/R/filter_exist.R new file mode 100644 index 0000000000..b842b02a2a --- /dev/null +++ b/R/filter_exist.R @@ -0,0 +1,182 @@ +#' Returns records that fit into existing by groups in a filtered source dataset +#' +#' Returns all records in the input dataset that belong to by groups that are present +#' in a source dataset, after the source dataset is optionally filtered. For example, +#' this could be used to return ADSL records for subjects that experienced a certain +#' adverse event during the course of the study (as per records in ADAE). +#' +#' @param dataset Input dataset +#' +#' The variables specified in the `by_vars` parameter are expected in this dataset. +#' +#' @param dataset_add Source dataset +#' +#' The source dataset, which determines the by groups returned in the input dataset, +#' based on the groups that exist in this dataset after being subset by `filter_add`. +#' +#' The variables specified in the `by_vars` and `filter_add` parameters are expected +#' in this dataset. +#' +#' @param by_vars Grouping variables +#' +#' A list of variable names specified within `exprs()` is expected. +#' +#' @param filter_add Filter for the source dataset +#' +#' The filter condition which will be used to subset the source dataset. +#' Alternatively, if no filter condition is supplied, no subsetting of the source +#' dataset will be performed. +#' +#' Default: `NULL` (i.e. no filtering will be performed) +#' +#' @details Returns the records in `dataset` which match an existing by group in `dataset_add`, +#' after being filtered according to `filter_add`. If there are no by groups that exist +#' in both datasets, an empty dataset will be returned. +#' +#' @return The records in the input dataset which are contained within an existing by group in +#' the filtered source dataset. +#' +#' @keywords utils_fil +#' +#' @family utils_fil +#' +#' @export +#' +#' @examples +#' # Get demographic information about subjects who have suffered from moderate or +#' # severe fatigue +#' +#' library(tibble) +#' +#' adsl <- tribble( +#' ~USUBJID, ~AGE, ~SEX, +#' "01-701-1015", 63, "F", +#' "01-701-1034", 77, "F", +#' "01-701-1115", 84, "M", +#' "01-701-1146", 75, "F", +#' "01-701-1444", 63, "M" +#' ) +#' +#' adae <- tribble( +#' ~USUBJID, ~AEDECOD, ~AESEV, ~AESTDTC, +#' "01-701-1015", "DIARRHOEA", "MODERATE", "2014-01-09", +#' "01-701-1034", "FATIGUE", "SEVERE", "2014-11-02", +#' "01-701-1034", "APPLICATION SITE PRURITUS", "MODERATE", "2014-08-27", +#' "01-701-1115", "FATIGUE", "MILD", "2013-01-14", +#' "01-701-1146", "FATIGUE", "MODERATE", "2013-06-03" +#' ) +#' +#' filter_exist( +#' dataset = adsl, +#' dataset_add = adae, +#' by_vars = exprs(USUBJID), +#' filter_add = AEDECOD == "FATIGUE" & AESEV %in% c("MODERATE", "SEVERE") +#' ) +#' +filter_exist <- function(dataset, + dataset_add, + by_vars, + filter_add = NULL) { + assert_vars(by_vars) + assert_data_frame( + dataset, + required_vars = by_vars + ) + filter_add <- assert_filter_cond(enexpr(filter_add), optional = TRUE) + assert_data_frame( + dataset_add, + required_vars = by_vars + ) + + dataset %>% + semi_join( + dataset_add %>% + filter_if(filter_add), + by = vars2chr(by_vars) + ) +} + +#' Returns records that don't fit into existing by groups in a filtered source dataset +#' +#' Returns all records in the input dataset that belong to by groups that are not +#' present in a source dataset, after the source dataset is optionally filtered. For +#' example, this could be used to return ADSL records for subjects that didn't take certain +#' concomitant medications during the course of the study (as per records in ADCM). +#' +#' @inheritParams filter_exist +#' +#' @param dataset_add Source dataset +#' +#' The source dataset, which determines the by groups returned in the input dataset, +#' based on the groups that don't exist in this dataset after being subset by `filter_add`. +#' +#' The variables specified in the `by_vars` and `filter_add` parameters are expected +#' in this dataset. +#' +#' @details Returns the records in `dataset` which don't match any existing by groups in +#' `dataset_add`, after being filtered according to `filter_add`. If all by +#' groups that exist in `dataset` don't exist in `dataset_add`, an empty dataset will +#' be returned. +#' +#' @return The records in the input dataset which are not contained within any existing by +#' group in the filtered source dataset. +#' +#' @keywords utils_fil +#' +#' @family utils_fil +#' +#' @export +#' +#' @examples +#' # Get demographic information about subjects who didn't take vitamin supplements +#' # during the study +#' +#' library(tibble) +#' +#' adsl <- tribble( +#' ~USUBJID, ~AGE, ~SEX, +#' "01-701-1015", 63, "F", +#' "01-701-1023", 64, "M", +#' "01-701-1034", 77, "F", +#' "01-701-1118", 52, "M" +#' ) +#' +#' adcm <- tribble( +#' ~USUBJID, ~CMTRT, ~CMSTDTC, +#' "01-701-1015", "ASPIRIN", "2013-05-14", +#' "01-701-1023", "MYLANTA", "2014-01-04", +#' "01-701-1023", "CALCIUM", "2014-02-25", +#' "01-701-1034", "VITAMIN C", "2013-12-12", +#' "01-701-1034", "CALCIUM", "2013-03-27", +#' "01-701-1118", "MULTIVITAMIN", "2013-02-21" +#' ) +#' +#' filter_not_exist( +#' dataset = adsl, +#' dataset_add = adcm, +#' by_vars = exprs(USUBJID), +#' filter_add = str_detect(CMTRT, "VITAMIN") +#' ) +#' +filter_not_exist <- function(dataset, + dataset_add, + by_vars, + filter_add = NULL) { + assert_vars(by_vars) + assert_data_frame( + dataset, + required_vars = by_vars + ) + filter_add <- assert_filter_cond(enexpr(filter_add), optional = TRUE) + assert_data_frame( + dataset_add, + required_vars = by_vars + ) + + dataset %>% + anti_join( + dataset_add %>% + filter_if(filter_add), + by = vars2chr(by_vars) + ) +} diff --git a/R/filter_extreme.R b/R/filter_extreme.R index 358fb4a3af..63c919791d 100644 --- a/R/filter_extreme.R +++ b/R/filter_extreme.R @@ -17,8 +17,8 @@ #' #' Within each by group the observations are ordered by the specified order. #' -#' *Permitted Values:* list of variables or `desc()` function calls -#' created by `exprs()`, e.g., `exprs(ADT, desc(AVAL))` +#' *Permitted Values:* list of expressions created by `exprs()`, e.g., +#' `exprs(ADT, desc(AVAL))` #' #' @param mode Selection mode (first or last) #' @@ -54,11 +54,34 @@ #' #' @examples #' library(dplyr, warn.conflicts = FALSE) -#' library(admiral.test) -#' data("admiral_ex") +#' +#' ex <- tribble( +#' ~STUDYID, ~DOMAIN, ~USUBJID, ~EXSEQ, ~EXDOSE, ~EXTRT, +#' "PILOT01", "EX", "01-1442", 1, 54, "XANO", +#' "PILOT01", "EX", "01-1442", 2, 54, "XANO", +#' "PILOT01", "EX", "01-1442", 3, 54, "XANO", +#' "PILOT01", "EX", "01-1444", 1, 54, "XANO", +#' "PILOT01", "EX", "01-1444", 2, 81, "XANO", +#' "PILOT01", "EX", "05-1382", 1, 54, "XANO", +#' "PILOT01", "EX", "08-1213", 1, 54, "XANO", +#' "PILOT01", "EX", "10-1053", 1, 54, "XANO", +#' "PILOT01", "EX", "10-1053", 2, 54, "XANO", +#' "PILOT01", "EX", "10-1183", 1, 0, "PLACEBO", +#' "PILOT01", "EX", "10-1183", 2, 0, "PLACEBO", +#' "PILOT01", "EX", "10-1183", 3, 0, "PLACEBO", +#' "PILOT01", "EX", "11-1036", 1, 0, "PLACEBO", +#' "PILOT01", "EX", "11-1036", 2, 0, "PLACEBO", +#' "PILOT01", "EX", "11-1036", 3, 0, "PLACEBO", +#' "PILOT01", "EX", "14-1425", 1, 54, "XANO", +#' "PILOT01", "EX", "15-1319", 1, 54, "XANO", +#' "PILOT01", "EX", "15-1319", 2, 81, "XANO", +#' "PILOT01", "EX", "16-1151", 1, 54, "XANO", +#' "PILOT01", "EX", "16-1151", 2, 54, "XANO" +#' ) +#' #' #' # Select first dose for each patient -#' admiral_ex %>% +#' ex %>% #' filter_extreme( #' by_vars = exprs(USUBJID), #' order = exprs(EXSEQ), @@ -67,7 +90,7 @@ #' select(USUBJID, EXSEQ) #' #' # Select highest dose for each patient on the active drug -#' admiral_ex %>% +#' ex %>% #' filter(EXTRT != "PLACEBO") %>% #' filter_extreme( #' by_vars = exprs(USUBJID), diff --git a/R/filter_joined.R b/R/filter_joined.R index c76534f767..1d85e6cfdb 100644 --- a/R/filter_joined.R +++ b/R/filter_joined.R @@ -57,6 +57,9 @@ #' #' The observations are ordered by the specified order. #' +#' *Permitted Values:* list of expressions created by `exprs()`, e.g., +#' `exprs(ADT, desc(AVAL))` +#' #' @param tmp_obs_nr_var Temporary observation number #' #' The specified variable is added to the input dataset and set to the @@ -128,7 +131,7 @@ #' `join_type` and `order`. #' #' The dataset from the example in the previous step with `join_type = -#' "after"` and order = exprs(AVISITN)` is restricted to +#' "after"` and `order = exprs(AVISITN)` is restricted to #' #' ```{r eval=FALSE} #' A tibble: 4 x 6 @@ -334,7 +337,7 @@ filter_joined <- function(dataset, case_sensitive = FALSE ) first_cond <- assert_filter_cond(enexpr(first_cond), optional = TRUE) - assert_order_vars(order) + assert_expr_list(order) tmp_obs_nr_var <- assert_symbol(enexpr(tmp_obs_nr_var), optional = TRUE) filter <- assert_filter_cond(enexpr(filter)) check_type <- @@ -548,175 +551,3 @@ max_cond <- function(var, cond) { max(var[cond]) } } - -#' Filter Confirmed Observations -#' -#' @description -#' `r lifecycle::badge("deprecated")` -#' -#' This function is *deprecated*, please use `filter_joined()` instead. -#' -#' @param dataset Input dataset -#' -#' The variables specified for `by_vars`, `join_vars`, and `order` are -#' expected. -#' -#' @param by_vars By variables -#' -#' The specified variables are used as by variables for joining the input -#' dataset with itself. -#' -#' @param join_vars Variables to keep from joined dataset -#' -#' The variables needed from the other observations should be specified for -#' this parameter. The specified variables are added to the joined dataset -#' with suffix ".join". For example to select all observations with `AVALC == -#' "Y"` and `AVALC == "Y"` for at least one subsequent visit `join_vars = -#' exprs(AVALC, AVISITN)` and `filter = AVALC == "Y" & AVALC.join == "Y" & -#' AVISITN < AVISITN.join` could be specified. -#' -#' The `*.join` variables are not included in the output dataset. -#' -#' @param join_type Observations to keep after joining -#' -#' The argument determines which of the joined observations are kept with -#' respect to the original observation. For example, if `join_type = -#' "after"` is specified all observations after the original observations are -#' kept. -#' -#' *Permitted Values:* `"before"`, `"after"`, `"all"` -#' -#' @param first_cond Condition for selecting range of data -#' -#' If this argument is specified, the other observations are restricted up to -#' the first observation where the specified condition is fulfilled. If the -#' condition is not fulfilled for any of the subsequent observations, all -#' observations are removed. -#' -#' @param order Order -#' -#' The observations are ordered by the specified order. -#' -#' @param tmp_obs_nr_var Temporary observation number -#' -#' The specified variable is added to the input dataset and set to the -#' observation number with respect to `order`. For each by group (`by_vars`) -#' the observation number starts with `1`. The variable can be used in the -#' conditions (`filter`, `first_cond`). It is not included in the output -#' dataset. It can be used to select consecutive observations or the last -#' observation (see last example below). -#' -#' @param filter Condition for selecting observations -#' -#' The filter is applied to the joined dataset for selecting the confirmed -#' observations. The condition can include summary functions. The joined -#' dataset is grouped by the original observations. I.e., the summary function -#' are applied to all observations up to the confirmation observation. For -#' example in the oncology setting when using this function for confirmed best -#' overall response, `filter = AVALC == "CR" & all(AVALC.join %in% c("CR", -#' "NE")) & count_vals(var = AVALC.join, val = "NE") <= 1` selects -#' observations with response "CR" and for all observations up to the -#' confirmation observation the response is "CR" or "NE" and there is at most -#' one "NE". -#' -#' @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. -#' -#' *Default:* `"none"` -#' -#' *Permitted Values:* `"none"`, `"warning"`, `"error"` -#' -#' @details -#' -#' The following steps are performed to produce the output dataset. -#' -#' ## Step 1 -#' -#' The input dataset is joined with itself by the variables specified for -#' `by_vars`. From the right hand side of the join only the variables -#' specified for `join_vars` are kept. The suffix ".join" is added to these -#' variables. -#' -#' For example, for `by_vars = USUBJID`, `join_vars = exprs(AVISITN, AVALC)` and input dataset -#' -#' ```{r eval=FALSE} -#' # A tibble: 2 x 4 -#' USUBJID AVISITN AVALC AVAL -#' -#' 1 1 Y 1 -#' 1 2 N 0 -#' ``` -#' -#' the joined dataset is -#' -#' ```{r eval=FALSE} -#' A tibble: 4 x 6 -#' USUBJID AVISITN AVALC AVAL AVISITN.join AVALC.join -#' -#' 1 1 Y 1 1 Y -#' 1 1 Y 1 2 N -#' 1 2 N 0 1 Y -#' 1 2 N 0 2 N -#' ``` -#' -#' ## Step 2 -#' -#' The joined dataset is restricted to observations with respect to -#' `join_type` and `order`. -#' -#' The dataset from the example in the previous step with `join_type = -#' "after"` and order = exprs(AVISITN)` is restricted to -#' -#' ```{r eval=FALSE} -#' A tibble: 4 x 6 -#' USUBJID AVISITN AVALC AVAL AVISITN.join AVALC.join -#' -#' 1 1 Y 1 2 N -#' ``` -#' -#' ## Step 3 -#' -#' If `first_cond` is specified, for each observation of the input dataset the -#' joined dataset is restricted to observations up to the first observation -#' where `first_cond` is fulfilled (the observation fulfilling the condition -#' is included). If for an observation of the input dataset the condition is -#' not fulfilled, the observation is removed. -#' -#' ## Step 4 -#' -#' The joined dataset is grouped by the observations from the input dataset -#' and restricted to the observations fulfilling the condition specified by -#' `filter`. -#' -#' ## Step 5 -#' -#' The first observation of each group is selected and the `*.join` variables -#' are dropped. -#' -#' @returns A subset of the observations of the input dataset. All variables of -#' the input dataset are included in the output dataset. -#' -#' -#' @keywords deprecated -#' @family deprecated -#' -#' @export -#' -filter_confirmation <- function(dataset, - by_vars, - join_vars, - join_type, - first_cond = NULL, - order, - tmp_obs_nr_var = NULL, - filter, - check_type = "warning") { - deprecate_stop( - "0.10.0", - "filter_confirmation()", - details = "Please use `filter_joined()` instead." - ) -} diff --git a/R/filter_relative.R b/R/filter_relative.R index 933b303589..34c57d796b 100644 --- a/R/filter_relative.R +++ b/R/filter_relative.R @@ -18,8 +18,8 @@ #' #' Within each by group the observations are ordered by the specified order. #' -#' *Permitted Values:* list of variables or `desc()` function calls -#' created by `exprs()`, e.g., `exprs(ADT, desc(AVAL))` +#' *Permitted Values:* list of expressions created by `exprs()`, e.g., +#' `exprs(ADT, desc(AVAL))` #' #' @param condition Condition for Reference Observation #' @@ -147,7 +147,7 @@ filter_relative <- function(dataset, keep_no_ref_groups = TRUE, check_type = "warning") { assert_vars(by_vars) - assert_order_vars(order) + assert_expr_list(order) condition <- assert_filter_cond(enexpr(condition)) mode <- assert_character_scalar( diff --git a/R/get_summary_records.R b/R/get_summary_records.R index 04c1e00f99..52406841a8 100644 --- a/R/get_summary_records.R +++ b/R/get_summary_records.R @@ -42,10 +42,8 @@ #' Set a list of variables to some specified value for the new observation(s) #' + LHS refer to a variable. #' + RHS refers to the values to set to the variable. This can be a string, a symbol, a numeric -#' value or NA. +#' value, an expression or NA. #' (e.g. `exprs(PARAMCD = "TDOSE",PARCAT1 = "OVERALL")`). -#' More general expression are not allowed. -#' #' #' @return A data frame of derived records. #' @@ -162,15 +160,13 @@ get_summary_records <- function(dataset, required_vars = expr_c(by_vars, analysis_var), check_is_grouped = FALSE ) - if (!is.null(set_values_to)) { - assert_varval_list(set_values_to, optional = TRUE) - } + assert_varval_list(set_values_to, optional = TRUE) # Summarise the analysis value dataset %>% group_by(!!!by_vars) %>% filter_if(filter) %>% summarise(!!analysis_var := summary_fun(!!analysis_var)) %>% - mutate(!!!set_values_to) %>% - ungroup() + ungroup() %>% + process_set_values_to(set_values_to) } diff --git a/R/globals.R b/R/globals.R index c9511dcc6b..5488078113 100644 --- a/R/globals.R +++ b/R/globals.R @@ -19,6 +19,8 @@ globalVariables(c( "AVAL", "AVALC", "AVALU", + "A1HI", + "A1LO", "BASE", "BASEC", "BASETYPE", @@ -75,11 +77,15 @@ globalVariables(c( "time_differential_dt", "tmp_obs_nr_filter_relative", "tmp_obs_nr_match_filter_relative", - "VAR_PREFIX", - "QUERY_NAME", - "QUERY_ID", - "QUERY_SCOPE", - "QUERY_SCOPE_NUM", + "PREFIX", + "PREFIX_CD", + "PREFIX_NAM", + "PREFIX_SC", + "PREFIX_SCN", + "GRPNAME", + "GRPID", + "SCOPE", + "SCOPEN", ".", "NAM", "CD", @@ -137,6 +143,9 @@ globalVariables(c( "SI_UNIT_UPPER", "VAR_CHECK", "TERM", + "SRCVAR", + "TERMNAME", + "TERM_NAME_ID", "TERM_UPPER", "atoxgr_criteria_ctcv4", "DTYPE", diff --git a/R/period_dataset.R b/R/period_dataset.R index 53d4f38b79..f16998e8ab 100644 --- a/R/period_dataset.R +++ b/R/period_dataset.R @@ -187,8 +187,8 @@ create_period_dataset <- function(dataset, } if (mode == "subperiod") { period_ref[[i]] <- pivot_longer( - select(dataset, !!!subject_keys, matches(cols[[i]])), - matches(cols[[i]]), + select(dataset, !!!subject_keys, matches(paste0(cols[[i]], "\\b"))), + matches(paste0(cols[[i]], "\\b")), names_to = c(".value", "APERIOD", num_var_chr[[mode]]), names_pattern = names_pattern[[i]] ) %>% @@ -201,8 +201,8 @@ create_period_dataset <- function(dataset, by_vars <- exprs(APERIOD, !!sym(num_var[[mode]])) } else { period_ref[[i]] <- pivot_longer( - select(dataset, !!!subject_keys, matches(cols[[i]])), - matches(cols[[i]]), + select(dataset, !!!subject_keys, matches(paste0(cols[[i]], "\\b"))), + matches(paste0(cols[[i]], "\\b")), names_to = c(".value", num_var_chr[[mode]]), names_pattern = names_pattern[[i]] ) %>% diff --git a/R/reexports.R b/R/reexports.R index 2f0ef9e2b5..b97c187ada 100644 --- a/R/reexports.R +++ b/R/reexports.R @@ -15,59 +15,6 @@ #' @export NULL -#' Create List of Quosures -#' -#' @description -#' `r lifecycle::badge("deprecated")` -#' -#' This function is *deprecated*, please use `exprs()` instead. -#' -#' @param ... List of variables -#' -#' @return List of expressions -#' -#' @keywords deprecated -#' @family deprecated -#' -#' @export -vars <- function(...) { - deprecate_warn( - "0.10.0", - "vars()", - "exprs()", - details = paste( - "The admiral functions no longer expects lists of quosures created by `vars()`", - "but lists of expressions created by `exprs()`.", - "Please update your function calls ASAP." - ) - ) - exprs(...) -} - -# Force admiral definition of vars(). -# This and the definition of vars() above should be removed in the release after admiral 0.10.0 -setHook( - packageEvent("dplyr", "attach"), function(...) { - if (get_admiral_option("force_admiral_vars")) { - inform(paste0( - "admiral definition of `vars()` is forced.\n", - "If you want to use the dplyr definition of `vars()`, call ", - "`set_admiral_options(force_admiral_vars = FALSE)` ", - "before attaching dplyr." - )) - detach("package:admiral") - suppressWarnings(library("admiral", - pos = 2L, - warn.conflicts = FALSE, - quietly = TRUE, - character.only = TRUE, - verbose = FALSE - )) - } - }, - "append" -) - #' dplyr desc #' #' See \code{dplyr::\link[dplyr:desc]{desc}} for details. diff --git a/R/restrict_derivation.R b/R/restrict_derivation.R index 0f09bd0aeb..7a5605e7b4 100644 --- a/R/restrict_derivation.R +++ b/R/restrict_derivation.R @@ -81,7 +81,7 @@ restrict_derivation <- function(dataset, assert_function(derivation, params = c("dataset")) assert_s3_class(args, "params", optional = TRUE) if (!is.null(args)) { - assert_function_param(deparse(substitute(derivation)), names(args)) + assert_function(derivation, names(args)) } filter <- assert_filter_cond(enexpr(filter)) diff --git a/R/slice_derivation.R b/R/slice_derivation.R index 9a1d6f67c4..7a8c3f650c 100644 --- a/R/slice_derivation.R +++ b/R/slice_derivation.R @@ -92,7 +92,7 @@ slice_derivation <- function(dataset, if (!is.null(args)) { assert_function_param(deparse(substitute(derivation)), names(args)) } - slices <- rlang::list2(...) + slices <- list2(...) assert_list_of(slices, "derivation_slice") # the variable temp_slicenr is added to the dataset which indicates to which diff --git a/R/user_helpers.R b/R/user_helpers.R index 744c9fa6d8..91f228ea5e 100644 --- a/R/user_helpers.R +++ b/R/user_helpers.R @@ -1,6 +1,8 @@ #' Open an ADaM Template Script #' -#' @param adam_name An ADaM dataset name. You can use any of the available dataset name `r list_all_templates()`, and the dataset name is case-insensitive. The default dataset name is ADSL. +#' @param adam_name An ADaM dataset name. You can use any of the available dataset name +#' `r list_all_templates()`, and the dataset name is case-insensitive. The default dataset +#' name is ADSL. #' @param save_path Path to save the script. #' @param package The R package in which to look for templates. By default `"admiral"`. #' @param overwrite Whether to overwrite an existing file named `save_path`. @@ -8,7 +10,8 @@ #' #' @return No return values, called for side effects #' -#' @details Running without any arguments such as `use_ad_template()` auto-generates adsl.R in the current path. Use `list_all_templates()` to discover which templates are available. +#' @details Running without any arguments such as `use_ad_template()` auto-generates adsl.R in +#' the current path. Use `list_all_templates()` to discover which templates are available. #' #' #' @family utils_examples @@ -61,7 +64,7 @@ use_ad_template <- function(adam_name = "adsl", } if (open) { - utils::file.edit(save_path) + file.edit(save_path) } invisible(TRUE) @@ -85,7 +88,10 @@ list_all_templates <- function(package = "admiral") { assert_character_scalar(package) if (!requireNamespace(package, quietly = TRUE)) { - err_msg <- sprintf("No package called '%s' is installed and hence no templates are available", package) + err_msg <- sprintf( + "No package called '%s' is installed and hence no templates are available", + package + ) abort(err_msg) } diff --git a/R/user_utils.R b/R/user_utils.R index a33f5f7f52..7eea0632c8 100644 --- a/R/user_utils.R +++ b/R/user_utils.R @@ -49,11 +49,11 @@ extract_unit <- function(x) { #' #' convert_blanks_to_na(c("a", "b", "", "d", "")) #' -#' 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"), -#' d = structure(c("", "", "s", "q"), label = "D") +#' df <- tribble( +#' ~USUBJID, ~RFICDTC, +#' "1001", "2000-01-01", +#' "1002", "2001-01-01", +#' "1003", "" #' ) #' print(df) #' convert_blanks_to_na(df) @@ -113,11 +113,11 @@ convert_blanks_to_na.data.frame <- function(x) { # nolint #' #' 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") +#' df <- tribble( +#' ~USUBJID, ~RFICDTC, +#' "1001", "2000-01-01", +#' "1002", "2001-01-01", +#' "1003", NA #' ) #' print(df) #' convert_na_to_blanks(df) @@ -169,7 +169,7 @@ convert_na_to_blanks.data.frame <- function(x) { # nolint #' @examples #' chr2vars(c("USUBJID", "AVAL")) chr2vars <- function(chr) { - assert_character_vector(chr) + assert_character_vector(chr, optional = TRUE) set_names( exprs(!!!syms(chr)), names(chr) diff --git a/README.md b/README.md index ed2fd6e2bc..fe304975c8 100644 --- a/README.md +++ b/README.md @@ -41,13 +41,13 @@ Phases: * Phase 2 release is extension packages, e.g. `{admiralonco}`, `admiralophtha` |Release Schedule | Phase 1- Date and Packages | Phase 2- Date and Packages | -|---------------- | -------------------------- | -------------------------- | -| Q2-2023 | June 5th | June 12th | -| | `{admiraldev}` `{admiral.test}` | `{admiralonco}` | -| | `{admiral}` | `{admiralophtha}` | +|---------------- | -------------------------- | -------------------------- | | Q3-2023 | September 4th | September 11th | | | `{admiraldev}` `{admiral.test}` | `{admiralonco}` | | | `{admiral}` | `{admiralophtha}` | +| Q4-2023 | December 4th | December 11th | +| | `{admiraldev}` `{admiral.test}` | `{admiralonco}` | +| | `{admiral}` | `{admiralophtha}` | ## Main Goal @@ -86,7 +86,7 @@ There will be 3 foreseeable types of `{admiral}` packages: * Core package---one package containing all core functions required to create ADaMs, usable by any company (i.e. general derivations, utility functions and checks for ADSL, OCCDS and BDS) * TA (Therapeutic Area) package extensions---one package per TA with functions that are - specific to algorithms and requirements for that particular TA (e.g. [`{admiralonco}`](https://pharmaverse.github.io/admiralonco/index.html)) + specific to algorithms and requirements for that particular TA (e.g. [`{admiralonco}`](https://pharmaverse.github.io/admiralonco/)) * Company package extensions---specific needs and plug-ins for the company, such as access to metadata (e.g. `{admiralroche}` or `{admiralgsk}`) @@ -168,8 +168,13 @@ that all our developers and contributors must follow, so that all our code has a ## Conference Presentations -* [R/Pharma 2021 talk](https://www.youtube.com/watch?v=N7Bw8c3D5fU) (recording) -* [PHUSE US Connect 2022 pharmaverse workshop](https://github.com/pharmaverse/pharmaverse.workshop.phuseUS2022) (slides and materials---including `{admiral}` +* [Paving the way for clinical submissions in R](https://phuse.s3.eu-central-1.amazonaws.com/Archive/2023/SDE/EU/London/PRE_London09.pdf) (slides from PHUSE SDE in London) +* [An Overview of {admiral}](https://phuse.s3.eu-central-1.amazonaws.com/Archive/2023/SDE/US/Summit/PRE_Summit03.pdf) (slides from PHUSE SDE in Summit, NJ) +* [{admiralonco}](https://phuse.s3.eu-central-1.amazonaws.com/Archive/2023/Connect/US/Florida/REC_OS12.mp4) (recording for talk at PHUSE US Connect 2023, slides also available [here](https://phuse.s3.eu-central-1.amazonaws.com/Archive/2023/Connect/US/Florida/PRE_OS12.pdf)) +* [Programming ADNCA using R and {admiral}](https://phuse.s3.eu-central-1.amazonaws.com/Archive/2023/Connect/US/Florida/REC_OS09.mp4) (recording of presentation from PHUSE US Connect 2023) +* [Clinical Reporting in R](https://www.youtube.com/watch?v=9eod8MLF5ys&list=PLMtxz1fUYA5AWYQHB5mZAs-yamNJ5Tm_8&index=2) (recording of workshop at R in Pharma 2022) +* [Introducing {admiral}](https://www.youtube.com/watch?v=N7Bw8c3D5fU) (recording of talk for R in Pharma 2021) +* [Pharmaverse workshop](https://github.com/pharmaverse/pharmaverse.workshop.phuseUS2022) (slides and materials from PHUSE US Connect 2022---including `{admiral}` workshop slides from PHUSE EU Connect 2021) ## Contact diff --git a/_pkgdown.yml b/_pkgdown.yml index b0dc5a1a3e..4c879cd0d4 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -50,6 +50,11 @@ reference: contents: - has_keyword("metadata") +- title: Example Datasets + desc: You can run `use_ad_template()` to produce additional datasets + contents: + - has_keyword('datasets') + - title: Advanced Functions - subtitle: Admiral Options contents: @@ -113,11 +118,6 @@ reference: contents: - has_keyword('utils_print') -- title: Example Datasets - desc: You can run `use_ad_template()` to produce additional datasets - contents: - - has_keyword('datasets') - - title: Objects exported from other packages desc: | To maximize the user-friendliness of `{admiral}`, functions from other packages are provided @@ -145,10 +145,10 @@ navbar: components: getstarted: text: Get Started - href: articles/admiral.html + href: articles/ reference: text: Reference - href: reference/index.html + href: reference/ community: text: Community menu: @@ -162,7 +162,7 @@ navbar: text: User Guides menu: - text: Getting Started - - text: Creating a basic ADSL + - text: Creating a Basic ADSL href: articles/adsl.html - text: FAQ href: articles/faq.html @@ -178,7 +178,7 @@ navbar: href: articles/bds_tte.html - text: Creating Questionnaire ADaMs href: articles/questionnaires.html - - text: Creating a PK NCA ADaM (ADPC/ADNCA) + - text: Creating a PK NCA or Population PK ADaM href: articles/pk_adnca.html - text: "Advanced User Guides" - text: Date and Time Imputation diff --git a/data/example_qs.rda b/data/example_qs.rda index 5bd4991733..df81153271 100644 Binary files a/data/example_qs.rda and b/data/example_qs.rda differ diff --git a/data/queries.rda b/data/queries.rda index d05f776368..b6ddbe870e 100644 Binary files a/data/queries.rda and b/data/queries.rda differ diff --git a/data/queries_mh.rda b/data/queries_mh.rda index 94094e3ebf..7382fe1dc2 100644 Binary files a/data/queries_mh.rda and b/data/queries_mh.rda differ diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml index 9abc5c52eb..8492dafdf7 100644 --- a/docs/pkgdown.yml +++ b/docs/pkgdown.yml @@ -1,5 +1,5 @@ -pandoc: 2.14.0.3 -pkgdown: 2.0.6 +pandoc: 2.11.4 +pkgdown: 2.0.7 pkgdown_sha: ~ articles: admiral: admiral.html @@ -19,7 +19,8 @@ articles: queries_dataset: queries_dataset.html questionnaires: questionnaires.html visits_periods: visits_periods.html -last_built: 2023-03-02T20:56Z +last_built: 2023-05-31T14:16Z urls: reference: https://pharmaverse.github.io/admiral/cran-release/reference article: https://pharmaverse.github.io/admiral/cran-release/articles + diff --git a/inst/WORDLIST b/inst/WORDLIST index 6ab568f1ab..9dc1141688 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -5,11 +5,11 @@ ADEX ADJAE ADLB ADLBHY -adlbhy ADMH ADNCA ADPC ADPP +ADPPK ADSL ADVS ADaM @@ -22,11 +22,11 @@ AENDTM AEs AFRLT ANRLO +APRLT ARRLT ASEQ AST ASTDTM -aspartate ATC ATOXGR AVAL @@ -35,18 +35,20 @@ Alanine Analyte Aspartate BDS +BILI BLQ BMI BOR Basetype Bazett Bazett's -BILI Biologics CDISC +CKD COVID CPK CQ +CRCL CRF CTC CTCAE @@ -54,10 +56,12 @@ CTCAEV CTCAEv CVD Chol +Cockcroft +Creat Creatinine D'Agostino -DILI DIABP +DILI DT DTC DTF @@ -68,6 +72,7 @@ DuBois Durations EMA EOSSTT +EPI FACM FCVD Fibrinogen @@ -76,14 +81,20 @@ Framingham Fridericia Fridericia's Fujimoto +GDS GGT +GRPID +GRPNAME GSK +Gault Gehan GlaxoSmithKline +Glomerular GxP HDL Haptoglobin Hoffmann +Hy's Hypercalcemia Hyperkalemia Hypermagnesemia @@ -96,7 +107,6 @@ Hypokalemia Hypomagnesemia Hyponatremia Hypophosphatemia -Hy's IG INR LLC @@ -104,6 +114,7 @@ LLOQ LOCF Leukocytosis Lipase +MDRD MH MRRLT MedDRA @@ -115,6 +126,7 @@ NCA NCI NCICTCAEv NFRLT +NPRLT NRRLT NUM Neutrophil @@ -136,12 +148,16 @@ Quosures README SCE SCN +SCOPEN +SCr +SDE SDG SDGs SDTM SGPT SMQ SMQs +SRCVAR SYSBP Sagie Sagie's @@ -152,6 +168,8 @@ TADJ TADJAE TDOSE TDURD +TERMID +TERMNAME TID TLFs TMF @@ -169,9 +187,12 @@ adamig adeg adex adlb +adlbhy admiralci +admiralonco admiralxxx adpc +adppk adsl advs alanine @@ -180,6 +201,7 @@ analyte analytes analytics anticoagulation +aspartate atoxgr basetypes bds @@ -189,6 +211,7 @@ censorings chk codebase constructible +creatinine ctcv dL datacut @@ -202,7 +225,9 @@ dplyr ds dtc dthcaus +eGFR eg +egfr exprs fil findability @@ -210,11 +235,12 @@ findable fmt framingham funder -GDS +glomerular groupwise hms https lockfile +mL magrittr metacore metatools @@ -228,6 +254,7 @@ onwards parttime pharmaverse phosphatase +poppk pre prev prm @@ -251,9 +278,12 @@ timeframe timepart timepoint tte +umol ungrouped usethis www +xULN xportr xpt -xULN +α +κ diff --git a/inst/example_scripts/example_qs.R b/inst/example_scripts/example_qs.R index c9d6739813..f6c6e7ab3a 100644 --- a/inst/example_scripts/example_qs.R +++ b/inst/example_scripts/example_qs.R @@ -160,21 +160,6 @@ qs_gdssf <- tibble::tribble( "P0002", 28L, "GDS02-Feel Full of Energy", "GDS0213", "VISIT 2", 2, "2012-12-15", "YES", 0L, "P0002", 29L, "GDS02-Feel Hopeless", "GDS0214", "VISIT 2", 2, "2012-12-15", "NO", 0L, "P0002", 30L, "GDS02-Most People Better Off Than You", "GDS0215", "VISIT 2", 2, "2012-12-15", "NO", 0L, - "P0002", 31L, "GDS02-Satisfied With Life", "GDS0201", "VISIT 3", 3, "2013-01-12", "YES", 0L, - "P0002", 32L, "GDS02-Dropped Activities and Interests", "GDS0202", "VISIT 3", 3, "2013-01-12", "YES", 1L, - "P0002", 33L, "GDS02-Life Is Empty", "GDS0203", "VISIT 3", 3, "2013-01-12", "NO", 0L, - "P0002", 34L, "GDS02-Bored Often", "GDS0204", "VISIT 3", 3, "2013-01-12", "NO", 0L, - "P0002", 35L, "GDS02-Good Spirits Most of Time", "GDS0205", "VISIT 3", 3, "2013-01-12", "YES", 0L, - "P0002", 36L, "GDS02-Afraid of Something Bad Happening", "GDS0206", "VISIT 3", 3, "2013-01-12", "NO", 0L, - "P0002", 37L, "GDS02-Feel Happy Most of Time", "GDS0207", "VISIT 3", 3, "2013-01-12", "NO", 1L, - "P0002", 38L, "GDS02-Often Feel Helpless", "GDS0208", "VISIT 3", 3, "2013-01-12", "NO", 0L, - "P0002", 39L, "GDS02-Prefer to Stay Home", "GDS0209", "VISIT 3", 3, "2013-01-12", "NO", 0L, - "P0002", 40L, "GDS02-Memory Problems", "GDS0210", "VISIT 3", 3, "2013-01-12", "NO", 0L, - "P0002", 41L, "GDS02-Wonderful to Be Alive", "GDS0211", "VISIT 3", 3, "2013-01-12", "NO", 1L, - "P0002", 42L, "GDS02-Feel Worthless", "GDS0212", "VISIT 3", 3, "2013-01-12", "YES", 1L, - "P0002", 43L, "GDS02-Feel Full of Energy", "GDS0213", "VISIT 3", 3, "2013-01-12", "YES", 0L, - "P0002", 44L, "GDS02-Feel Hopeless", "GDS0214", "VISIT 3", 3, "2013-01-12", "NO", 0L, - "P0002", 45L, "GDS02-Most People Better Off Than You", "GDS0215", "VISIT 3", 3, "2013-01-12", "NO", 0L, "P0002", 46L, "GDS02-Satisfied With Life", "GDS0201", "VISIT 4", 4, "2013-02-13", "NO", 1L, "P0002", 47L, "GDS02-Dropped Activities and Interests", "GDS0202", "VISIT 4", 4, "2013-02-13", "YES", 1L, "P0002", 48L, "GDS02-Life Is Empty", "GDS0203", "VISIT 4", 4, "2013-02-13", "NO", 0L, diff --git a/inst/example_scripts/example_query_source.R b/inst/example_scripts/example_query_source.R index 10ca2c186d..96ffbae0b3 100644 --- a/inst/example_scripts/example_query_source.R +++ b/inst/example_scripts/example_query_source.R @@ -1,13 +1,13 @@ -# VAR_PREFIX, e.g., SMQ01, CQ12 -# QUERY_NAME, non NULL -# QUERY_ID, could be NULL -# QUERY_SCOPE, ‘BROAD’, ‘NARROW’, or NULL -# TERM_LEVEL, e.g., AEDECOD, AELLT, ... -# TERM_NAME, non NULL +# PREFIX, e.g., SMQ01, CQ12 +# GRPNAME, non NULL +# GRPID, could be NULL +# SCOPE, ‘BROAD’, ‘NARROW’, or NULL +# SRCVAR, e.g., AEDECOD, AELLT, ... +# TERMNAME, non NULL queries <- tibble::tribble( - ~VAR_PREFIX, ~QUERY_NAME, ~QUERY_ID, ~QUERY_SCOPE, - ~QUERY_SCOPE_NUM, ~TERM_LEVEL, ~TERM_NAME, ~TERM_ID, + ~PREFIX, ~GRPNAME, ~GRPID, ~SCOPE, + ~SCOPEN, ~SRCVAR, ~TERMNAME, ~TERMID, "CQ01", "Dermatologic events", NA_integer_, NA_character_, NA_integer_, "AELLT", "APPLICATION SITE ERYTHEMA", NA_integer_, "CQ01", "Dermatologic events", NA_integer_, NA_character_, @@ -23,7 +23,7 @@ queries <- tibble::tribble( "SMQ02", "Immune-Mediated Hypothyroidism", 20000160L, "BROAD", 1L, "AEDECOD", "BLOOD THYROID STIMULATING HORMONE ABNORMAL", NA_integer_, "SMQ02", "Immune-Mediated Hypothyroidism", 20000160L, "NARROW", - 1L, "AEDECOD", "BIOPSY THYROID GLAND INCREASED", NA_integer_, + 2L, "AEDECOD", "BIOPSY THYROID GLAND INCREASED", NA_integer_, "SMQ03", "Immune-Mediated Guillain-Barre Syndrome", 20000131L, "NARROW", 2L, "AEDECOD", "GUILLAIN-BARRE SYNDROME", NA_integer_, "SMQ03", "Immune-Mediated Guillain-Barre Syndrome", 20000131L, "NARROW", @@ -41,17 +41,17 @@ queries <- tibble::tribble( ) adae <- tibble::tribble( - ~USUBJID, ~ASTDTM, ~AETERM, ~AESEQ, ~AEDECOD, ~AELLT, + ~USUBJID, ~ASTDTM, ~AETERM, ~AESEQ, ~AEDECOD, ~AELLT, ~AELLTCD, "01", "2020-06-02 23:59:59", "ERYTHEMA", 3, - "Erythema", "Localized erythema", + "Erythema", "Localized erythema", NA_integer_, "02", "2020-06-05 23:59:59", "BASEDOW'S DISEASE", 5, - "Basedow's disease", NA_character_, + "Basedow's disease", NA_character_, NA_integer_, "02", "2020-06-05 23:59:59", "ALVEOLAR PROTEINOSIS", 1, - "Alveolar proteinosis", NA_character_, + "Alveolar proteinosis", NA_character_, NA_integer_, "03", "2020-06-07 23:59:59", "SOME TERM", 2, - "Some query", "Some term", + "Some query", "Some term", NA_integer_, "04", "2020-06-10 23:59:59", "APPLICATION SITE ERYTHEMA", 7, - "APPLICATION SITE ERYTHEMA", "Application site erythema", + "APPLICATION SITE ERYTHEMA", "Application site erythema", 1 ) # try below: @@ -60,7 +60,7 @@ derive_vars_query(adae, queries) # example to use for ADMH: queries_mh <- queries %>% - filter(TERM_LEVEL %in% c("AELLT", "AEDECOD")) %>% - mutate(TERM_LEVEL = ifelse(TERM_LEVEL == "AELLT", "MHLLT", "MHDECOD")) + filter(SRCVAR %in% c("AELLT", "AEDECOD")) %>% + mutate(SRCVAR = ifelse(SRCVAR == "AELLT", "MHLLT", "MHDECOD")) derive_vars_query(admh, queries_mh) diff --git a/inst/templates/ad_adae.R b/inst/templates/ad_adae.R index b4acdb5259..4e0929d08f 100644 --- a/inst/templates/ad_adae.R +++ b/inst/templates/ad_adae.R @@ -87,15 +87,15 @@ ex_ext <- derive_vars_dtm( adae <- adae %>% ## Derive last dose date/time ---- - derive_var_last_dose_date( - ex_ext, - filter_ex = (EXDOSE > 0 | (EXDOSE == 0 & grepl("PLACEBO", EXTRT))) & - !is.na(EXSTDTM), - dose_date = EXSTDTM, - analysis_date = ASTDT, - new_var = LDOSEDTM, - single_dose_condition = (EXSTDTC == EXENDTC), - output_datetime = TRUE + derive_vars_joined( + dataset_add = ex_ext, + by_vars = exprs(STUDYID, USUBJID), + new_vars = exprs(LDOSEDTM = EXSTDTM), + join_vars = exprs(EXSTDTM), + order = exprs(EXSTDTM), + filter_add = (EXDOSE > 0 | (EXDOSE == 0 & grepl("PLACEBO", EXTRT))) & !is.na(EXSTDTM), + filter_join = EXSTDTM <= ASTDTM, + mode = "last" ) %>% ## Derive severity / causality / ... ---- mutate( diff --git a/inst/templates/ad_adeg.R b/inst/templates/ad_adeg.R index cbe4b266cb..523491a82b 100644 --- a/inst/templates/ad_adeg.R +++ b/inst/templates/ad_adeg.R @@ -227,8 +227,8 @@ adeg <- adeg %>% ## Derive baseline flags ---- adeg <- adeg %>% # Calculate BASETYPE - derive_var_basetype( - basetypes = rlang::exprs( + derive_basetype_records( + basetypes = exprs( "LAST: AFTER LYING DOWN FOR 5 MINUTES" = ATPTN == 815, "LAST: AFTER STANDING FOR 1 MINUTE" = ATPTN == 816, "LAST: AFTER STANDING FOR 3 MINUTES" = ATPTN == 817, diff --git a/inst/templates/ad_adlb.R b/inst/templates/ad_adlb.R index 35e8f08630..22275b11a5 100644 --- a/inst/templates/ad_adlb.R +++ b/inst/templates/ad_adlb.R @@ -385,7 +385,7 @@ adlb <- adlb %>% order = exprs(AVAL, ADT, AVISITN), mode = "first", # "AVISITN < 9997" to evaluate only real visits - filter = (!is.na(AVAL) & ONTRTFL == "Y" & AVISITN < 9997), + filter_add = (!is.na(AVAL) & ONTRTFL == "Y" & AVISITN < 9997), set_values_to = exprs( AVISITN = 9997, AVISIT = "POST-BASELINE MINIMUM", @@ -398,7 +398,7 @@ adlb <- adlb %>% order = exprs(desc(AVAL), ADT, AVISITN), mode = "first", # "AVISITN < 9997" to evaluate only real visits - filter = (!is.na(AVAL) & ONTRTFL == "Y" & AVISITN < 9997), + filter_add = (!is.na(AVAL) & ONTRTFL == "Y" & AVISITN < 9997), set_values_to = exprs( AVISITN = 9998, AVISIT = "POST-BASELINE MAXIMUM", @@ -411,7 +411,7 @@ adlb <- adlb %>% order = exprs(ADT, AVISITN), mode = "last", # "AVISITN < 9997" to evaluate only real visits - filter = (ONTRTFL == "Y" & AVISITN < 9997), + filter_add = (ONTRTFL == "Y" & AVISITN < 9997), set_values_to = exprs( AVISITN = 9999, AVISIT = "POST-BASELINE LAST", diff --git a/inst/templates/ad_adlbhy.R b/inst/templates/ad_adlbhy.R index f96e4551b5..03664ab1c5 100644 --- a/inst/templates/ad_adlbhy.R +++ b/inst/templates/ad_adlbhy.R @@ -74,12 +74,12 @@ hylaw_records_fls <- hylaw_records %>% # Create new parameters based on records that present potential case hylaw_params <- derive_param_exist_flag( - dataset_adsl = hylaw_records_pts_visits, + dataset_ref = hylaw_records_pts_visits, dataset_add = hylaw_records_fls, condition = CRIT1FL == "Y" & BILI_CRITFL == "Y", false_value = "N", missing_value = "N", - subject_keys = exprs(STUDYID, USUBJID, TRT01A), # add AVISIT, ADT for by visit + by_vars = exprs(STUDYID, USUBJID, TRT01A), # add AVISIT, ADT for by visit set_values_to = exprs( PARAMCD = "HYSLAW", PARAM = "ALT/AST >= 3xULN and BILI >= 2xULN" diff --git a/inst/templates/ad_adpc.R b/inst/templates/ad_adpc.R index 3006d76364..dda1a1991a 100644 --- a/inst/templates/ad_adpc.R +++ b/inst/templates/ad_adpc.R @@ -70,7 +70,7 @@ format_avalcat1n <- function(param, aval) { # Get list of ADSL vars required for derivations adsl_vars <- exprs(TRTSDT, TRTSDTM, TRT01P, TRT01A) -adpc <- pc %>% +pc_dates <- pc %>% # Join ADSL with PC (need TRTSDT for ADY derivation) derive_vars_merged( dataset_add = adsl, @@ -98,7 +98,7 @@ adpc <- pc %>% # ---- Get dosing information ---- -ex <- ex %>% +ex_dates <- ex %>% derive_vars_merged( dataset_add = adsl, new_vars = adsl_vars, @@ -138,7 +138,7 @@ ex <- ex %>% # ---- Expand dosing records between start and end dates ---- # Updated function includes nominal_time parameter -ex_exp <- ex %>% +ex_exp <- ex_dates %>% create_single_dose_dataset( dose_freq = EXDOSFRQ, start_date = ASTDT, @@ -175,7 +175,7 @@ ex_exp <- ex %>% # ---- Find first dose per treatment per subject ---- # ---- Join with ADPC data and keep only subjects with dosing ---- -adpc <- adpc %>% +adpc_first_dose <- pc_dates %>% derive_vars_merged( dataset_add = ex_exp, filter_add = (EXDOSE > 0 & !is.na(ADTM)), @@ -195,10 +195,8 @@ adpc <- adpc %>% # ---- Find previous dose ---- -# Use derive_vars_joined for consistency with other variables -# This is equivalent to derive_vars_last_dose in this case -adpc <- adpc %>% +adpc_prev <- adpc_first_dose %>% derive_vars_joined( dataset_add = ex_exp, by_vars = exprs(USUBJID), @@ -216,7 +214,7 @@ adpc <- adpc %>% # ---- Find next dose ---- -adpc <- adpc %>% +adpc_next <- adpc_prev %>% derive_vars_joined( dataset_add = ex_exp, by_vars = exprs(USUBJID), @@ -234,7 +232,7 @@ adpc <- adpc %>% # ---- Find previous nominal time ---- -adpc <- adpc %>% +adpc_nom_prev <- adpc_next %>% derive_vars_joined( dataset_add = ex_exp, by_vars = exprs(USUBJID), @@ -249,7 +247,7 @@ adpc <- adpc %>% # ---- Find next nominal time ---- -adpc <- adpc %>% +adpc_nom_next <- adpc_nom_prev %>% derive_vars_joined( dataset_add = ex_exp, by_vars = exprs(USUBJID), @@ -265,7 +263,7 @@ adpc <- adpc %>% # ---- Combine ADPC and EX data ---- # Derive Relative Time Variables -adpc <- bind_rows(adpc, ex_exp) %>% +adpc_arrlt <- bind_rows(adpc_nom_next, ex_exp) %>% group_by(USUBJID, DRUG) %>% mutate( FANLDTM = min(FANLDTM, na.rm = TRUE), @@ -323,7 +321,7 @@ adpc <- bind_rows(adpc, ex_exp) %>% # Derive Nominal Relative Time from Reference Dose (NRRLT) -adpc <- adpc %>% +adpc_nrrlt <- adpc_arrlt %>% mutate( NRRLT = case_when( EVID == 1 ~ 0, @@ -342,7 +340,7 @@ adpc <- adpc %>% # Derive PARAMCD and relative time units # Derive AVAL, AVALU and AVALCAT1 -adpc <- adpc %>% +adpc_aval <- adpc_nrrlt %>% mutate( ATPTN = case_when( EVID == 1 ~ 0, @@ -369,7 +367,7 @@ adpc <- adpc %>% DOSEA = case_when( EVID == 1 ~ EXDOSE, is.na(EXDOSE_prev) ~ EXDOSE_next, - TRUE ~ EXDOSE_next + TRUE ~ EXDOSE_prev ), # Derive Planned Dose DOSEP = case_when( @@ -407,7 +405,7 @@ adpc <- adpc %>% # ---- Create DTYPE copy records ---- -dtype <- adpc %>% +dtype <- adpc_aval %>% filter(NFRLT > 0 & NXRLT == 0 & EVID == 0 & !is.na(AVISIT_next)) %>% select(-PCRFTDT, -PCRFTTM) %>% # Re-derive variables in for DTYPE copy records @@ -429,7 +427,7 @@ dtype <- adpc %>% # ---- Combine original records and DTYPE copy records ---- -adpc <- bind_rows(adpc, dtype) %>% +adpc_dtype <- bind_rows(adpc_aval, dtype) %>% arrange(STUDYID, USUBJID, BASETYPE, ADTM, NFRLT) %>% mutate( # Derive MRRLT, ANL01FL and ANL02FL @@ -440,7 +438,7 @@ adpc <- bind_rows(adpc, dtype) %>% # ---- Derive BASE and Calculate Change from Baseline ---- -adpc <- adpc %>% +adpc_base <- adpc_dtype %>% derive_var_base( by_vars = exprs(STUDYID, USUBJID, PARAMCD, BASETYPE), source_var = AVAL, @@ -448,11 +446,11 @@ adpc <- adpc %>% filter = ABLFL == "Y" ) -adpc <- derive_var_chg(adpc) +adpc_chg <- derive_var_chg(adpc_base) # ---- Add ASEQ ---- -adpc <- adpc %>% +adpc_aseq <- adpc_chg %>% # Calculate ASEQ derive_var_obs_number( new_var = ASEQ, @@ -472,7 +470,7 @@ adpc <- adpc %>% #---- Derive additional baselines from VS ---- -adpc <- adpc %>% +adpc_baselines <- adpc_aseq %>% derive_vars_merged( dataset_add = vs, filter_add = VSTESTCD == "HEIGHT", @@ -493,7 +491,7 @@ adpc <- adpc %>% # ---- Add all ADSL variables ---- # Add all ADSL variables -adpc <- adpc %>% +adpc <- adpc_baselines %>% derive_vars_merged( dataset_add = select(adsl, !!!negate_vars(adsl_vars)), by_vars = exprs(STUDYID, USUBJID) diff --git a/inst/templates/ad_adpp.R b/inst/templates/ad_adpp.R index c664834bcd..c215c5cdeb 100644 --- a/inst/templates/ad_adpp.R +++ b/inst/templates/ad_adpp.R @@ -71,7 +71,7 @@ format_avalcat1n <- function(param, aval) { case_when( param == "AUCALL" & aval < 19 ~ 1, param == "AUCALL" & aval >= 19 ~ 2, - T ~ NA_real_ + TRUE ~ NA_real_ ) } diff --git a/inst/templates/ad_adppk.R b/inst/templates/ad_adppk.R new file mode 100644 index 0000000000..ea4ceb122b --- /dev/null +++ b/inst/templates/ad_adppk.R @@ -0,0 +1,477 @@ +# Name: ADPPK +# +# Label: Population PK Analysis Data +# +# Description: Based on simulated data, create ADPPK analysis dataset +# +# Input: pc, ex, vs, lb, adsl +library(admiral) +library(dplyr) +library(lubridate) +library(stringr) + +library(admiral.test) # Contains example datasets from the CDISC pilot project or simulated + +# ---- 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. +# For illustration purposes read in admiral test data + +# Load PC, EX, VS, LB and ADSL +data("admiral_pc") +data("admiral_ex") +data("admiral_vs") +data("admiral_lb") + +data("admiral_adsl") + +adsl <- admiral_adsl + +# When SAS datasets are imported into R using haven::read_sas(), missing +# character values from SAS appear as "" characters in R, instead of appearing +# as NA values. Further details can be obtained via the following link: +# https://pharmaverse.github.io/admiral/cran-release/articles/admiral.html#handling-of-missing-values # nolint + +# Load EX + +ex <- convert_blanks_to_na(admiral_ex) + +# Load PC + +pc <- convert_blanks_to_na(admiral_pc) + +# Load VS for baseline height and weight + +vs <- convert_blanks_to_na(admiral_vs) + +# Load LB for baseline lab values + +lb <- convert_blanks_to_na(admiral_lb) + +# ---- Lookup tables ---- +param_lookup <- tibble::tribble( + ~PCTESTCD, ~PARAMCD, ~PARAM, ~PARAMN, + "XAN", "XAN", "Pharmacokinetic concentration of Xanomeline", 1, + "DOSE", "DOSE", "Xanomeline Patch Dose", 2, +) + +# ---- Derivations ---- + +# Get list of ADSL vars required for derivations +adsl_vars <- exprs(TRTSDT, TRTSDTM, TRT01P, TRT01A) + +pc_dates <- pc %>% + # Join ADSL with PC (need TRTSDT for ADY derivation) + derive_vars_merged( + dataset_add = adsl, + new_vars = adsl_vars, + by_vars = exprs(STUDYID, USUBJID) + ) %>% + # Derive analysis date/time + # Impute missing time to 00:00:00 + derive_vars_dtm( + new_vars_prefix = "A", + dtc = PCDTC, + time_imputation = "00:00:00" + ) %>% + # Derive dates and times from date/times + derive_vars_dtm_to_dt(exprs(ADTM)) %>% + derive_vars_dtm_to_tm(exprs(ADTM)) %>% + # Derive event ID and nominal relative time from first dose (NFRLT) + mutate( + EVID = 0, + DRUG = PCTEST, + NFRLT = if_else(PCTPTNUM < 0, 0, PCTPTNUM), .after = USUBJID + ) + +# ---- Get dosing information ---- + +ex_dates <- ex %>% + derive_vars_merged( + dataset_add = adsl, + new_vars = adsl_vars, + by_vars = exprs(STUDYID, USUBJID) + ) %>% + # Keep records with nonzero dose + filter(EXDOSE > 0) %>% + # Add time and set missing end date to start date + # Impute missing time to 00:00:00 + # Note all times are missing for dosing records in this example data + # Derive Analysis Start and End Dates + derive_vars_dtm( + new_vars_prefix = "AST", + dtc = EXSTDTC, + time_imputation = "00:00:00" + ) %>% + derive_vars_dtm( + new_vars_prefix = "AEN", + dtc = EXENDTC, + time_imputation = "00:00:00" + ) %>% + # Derive event ID and nominal relative time from first dose (NFRLT) + mutate( + EVID = 1, + NFRLT = 24 * (VISITDY - 1), .after = USUBJID + ) %>% + # Set missing end dates to start date + mutate(AENDTM = case_when( + is.na(AENDTM) ~ ASTDTM, + TRUE ~ AENDTM + )) %>% + # Derive dates from date/times + derive_vars_dtm_to_dt(exprs(ASTDTM)) %>% + derive_vars_dtm_to_dt(exprs(AENDTM)) + + +# ---- Expand dosing records between start and end dates ---- +# Updated function includes nominal_time parameter + +ex_exp <- ex_dates %>% + create_single_dose_dataset( + dose_freq = EXDOSFRQ, + start_date = ASTDT, + start_datetime = ASTDTM, + end_date = AENDT, + end_datetime = AENDTM, + nominal_time = NFRLT, + lookup_table = dose_freq_lookup, + lookup_column = CDISC_VALUE, + keep_source_vars = exprs( + STUDYID, USUBJID, EVID, EXDOSFRQ, EXDOSFRM, + NFRLT, EXDOSE, EXDOSU, EXTRT, ASTDT, ASTDTM, AENDT, AENDTM, + VISIT, VISITNUM, VISITDY, + TRT01A, TRT01P, DOMAIN, EXSEQ, !!!adsl_vars + ) + ) %>% + # Derive AVISIT based on nominal relative time + # Derive AVISITN to nominal time in whole days using integer division + # Define AVISIT based on nominal day + mutate( + AVISITN = NFRLT %/% 24 + 1, + AVISIT = paste("Day", AVISITN), + ADTM = ASTDTM, + DRUG = EXTRT + ) %>% + # Derive dates and times from datetimes + derive_vars_dtm_to_dt(exprs(ADTM)) %>% + derive_vars_dtm_to_tm(exprs(ADTM)) %>% + derive_vars_dtm_to_tm(exprs(ASTDTM)) %>% + derive_vars_dtm_to_tm(exprs(AENDTM)) + + +# ---- Find first dose per treatment per subject ---- +# ---- Join with ADPPK data and keep only subjects with dosing ---- + +adppk_first_dose <- pc_dates %>% + derive_vars_merged( + dataset_add = ex_exp, + filter_add = (!is.na(ADTM)), + new_vars = exprs(FANLDTM = ADTM, EXDOSE_first = EXDOSE), + order = exprs(ADTM, EXSEQ), + mode = "first", + by_vars = exprs(STUDYID, USUBJID, DRUG) + ) %>% + filter(!is.na(FANLDTM)) %>% + # Derive AVISIT based on nominal relative time + # Derive AVISITN to nominal time in whole days using integer division + # Define AVISIT based on nominal day + mutate( + AVISITN = NFRLT %/% 24 + 1, + AVISIT = paste("Day", AVISITN), + ) + + +# ---- Find previous dose ---- + +adppk_prev <- adppk_first_dose %>% + derive_vars_joined( + dataset_add = ex_exp, + by_vars = exprs(USUBJID), + order = exprs(ADTM), + new_vars = exprs( + ADTM_prev = ADTM, EXDOSE_prev = EXDOSE, AVISIT_prev = AVISIT, + AENDTM_prev = AENDTM + ), + join_vars = exprs(ADTM), + filter_add = NULL, + filter_join = ADTM > ADTM.join, + mode = "last", + check_type = "none" + ) + +# ---- Find previous nominal dose ---- + +adppk_nom_prev <- adppk_prev %>% + derive_vars_joined( + dataset_add = ex_exp, + by_vars = exprs(USUBJID), + order = exprs(NFRLT), + new_vars = exprs(NFRLT_prev = NFRLT), + join_vars = exprs(NFRLT), + filter_add = NULL, + filter_join = NFRLT > NFRLT.join, + mode = "last", + check_type = "none" + ) + +# ---- Combine ADPPK and EX data ---- +# Derive Relative Time Variables + +adppk_aprlt <- bind_rows(adppk_nom_prev, ex_exp) %>% + group_by(USUBJID, DRUG) %>% + mutate( + FANLDTM = min(FANLDTM, na.rm = TRUE), + min_NFRLT = min(NFRLT, na.rm = TRUE), + maxdate = max(ADT[EVID == 0], na.rm = TRUE), .after = USUBJID + ) %>% + arrange(USUBJID, ADTM) %>% + ungroup() %>% + filter(ADT <= maxdate) %>% + # Derive Actual Relative Time from First Dose (AFRLT) + derive_vars_duration( + new_var = AFRLT, + start_date = FANLDTM, + end_date = ADTM, + out_unit = "hours", + floor_in = FALSE, + add_one = FALSE + ) %>% + # Derive Actual Relative Time from Reference Dose (APRLT) + derive_vars_duration( + new_var = APRLT, + start_date = ADTM_prev, + end_date = ADTM, + out_unit = "hours", + floor_in = FALSE, + add_one = FALSE + ) %>% + # Derive APRLT + mutate( + APRLT = case_when( + EVID == 1 ~ 0, + is.na(APRLT) ~ AFRLT, + TRUE ~ APRLT + ), + NPRLT = case_when( + EVID == 1 ~ 0, + is.na(NFRLT_prev) ~ NFRLT - min_NFRLT, + TRUE ~ NFRLT - NFRLT_prev + ) + ) + +# ---- Derive Analysis Variables ---- +# Derive actual dose DOSEA and planned dose DOSEP, +# Derive AVAL and DV + +adppk_aval <- adppk_aprlt %>% + mutate( + # Derive Actual Dose + DOSEA = case_when( + EVID == 1 ~ EXDOSE, + is.na(EXDOSE_prev) ~ EXDOSE_first, + TRUE ~ EXDOSE_prev + ), + # Derive Planned Dose + DOSEP = case_when( + TRT01P == "Xanomeline High Dose" ~ 81, + TRT01P == "Xanomeline Low Dose" ~ 54, + TRT01P == "Placebo" ~ 0 + ), + # Derive PARAMCD + PARAMCD = case_when( + EVID == 1 ~ "DOSE", + TRUE ~ PCTESTCD + ), + ALLOQ = PCLLOQ, + # Derive CMT + CMT = case_when( + EVID == 1 ~ 1, + TRUE ~ 2 + ), + # Derive BLQFL/BLQFN + BLQFL = case_when( + PCSTRESC == "% + # Calculate ASEQ + derive_var_obs_number( + new_var = ASEQ, + by_vars = exprs(STUDYID, USUBJID), + order = exprs(AFRLT, EVID), + check_type = "error" + ) %>% + # Derive PARAM and PARAMN + derive_vars_merged(dataset_add = select(param_lookup, -PCTESTCD), by_vars = exprs(PARAMCD)) %>% + mutate( + PROJID = DRUG, + PROJIDN = 1 + ) %>% + # Remove temporary variables + select( + -DOMAIN, -starts_with("min"), -starts_with("max"), -starts_with("EX"), + -starts_with("PC"), -ends_with("first"), -ends_with("prev"), + -ends_with("DTM"), -ends_with("DT"), -ends_with("TM"), -starts_with("VISIT"), + -starts_with("AVISIT"), -starts_with("PARAM"), + -ends_with("TMF"), -starts_with("TRT"), -starts_with("ATPT"), -DRUG + ) + +#---- Derive Covariates ---- +# Include numeric values for STUDYIDN, USUBJIDN, SEXN, RACEN etc. + +covar <- adsl %>% + mutate( + STUDYIDN = as.numeric(word(USUBJID, 1, sep = fixed("-"))), + SITEIDN = as.numeric(word(USUBJID, 2, sep = fixed("-"))), + USUBJIDN = as.numeric(word(USUBJID, 3, sep = fixed("-"))), + SUBJIDN = as.numeric(SUBJID), + SEXN = case_when( + SEX == "M" ~ 1, + SEX == "F" ~ 2, + TRUE ~ 3 + ), + RACEN = case_when( + RACE == "AMERICAN INDIAN OR ALASKA NATIVE" ~ 1, + RACE == "ASIAN" ~ 2, + RACE == "BLACK OR AFRICAN AMERICAN" ~ 3, + RACE == "NATIVE HAWAIIAN OR OTHER PACIFIC ISLANDER" ~ 4, + RACE == "WHITE" ~ 5, + TRUE ~ 6 + ), + ETHNICN = case_when( + ETHNIC == "HISPANIC OR LATINO" ~ 1, + ETHNIC == "NOT HISPANIC OR LATINO" ~ 2, + TRUE ~ 3 + ), + ARMN = case_when( + ARM == "Placebo" ~ 0, + ARM == "Xanomeline Low Dose" ~ 1, + ARM == "Xanomeline High Dose" ~ 2, + TRUE ~ 3 + ), + ACTARMN = case_when( + ACTARM == "Placebo" ~ 0, + ACTARM == "Xanomeline Low Dose" ~ 1, + ACTARM == "Xanomeline High Dose" ~ 2, + TRUE ~ 3 + ), + COHORT = ARMN, + COHORTC = ARM, + ROUTE = unique(ex$EXROUTE), + ROUTEN = case_when( + ROUTE == "TRANSDERMAL" ~ 3, + TRUE ~ NA_real_ + ), + FORM = unique(ex$EXDOSFRM), + FORMN = case_when( + FORM == "PATCH" ~ 3, + TRUE ~ 4 + ), + COUNTRYN = case_when( + COUNTRY == "USA" ~ 1, + COUNTRY == "CAN" ~ 2, + COUNTRY == "GBR" ~ 3 + ), + REGION1N = COUNTRYN, + ) %>% + select( + STUDYID, STUDYIDN, SITEID, SITEIDN, USUBJID, USUBJIDN, + SUBJID, SUBJIDN, AGE, SEX, SEXN, COHORT, COHORTC, ROUTE, ROUTEN, + RACE, RACEN, ETHNIC, ETHNICN, FORM, FORMN, COUNTRY, COUNTRYN, + REGION1, REGION1N + ) + +#---- Derive additional baselines from VS and LB ---- + +labsbl <- lb %>% + filter(LBBLFL == "Y" & LBTESTCD %in% c("CREAT", "ALT", "AST", "BILI")) %>% + mutate(LBTESTCDB = paste0(LBTESTCD, "BL")) %>% + select(STUDYID, USUBJID, LBTESTCDB, LBSTRESN) + +covar_vslb <- covar %>% + derive_vars_merged( + dataset_add = vs, + filter_add = VSTESTCD == "HEIGHT", + by_vars = exprs(STUDYID, USUBJID), + new_vars = exprs(HTBL = VSSTRESN) + ) %>% + derive_vars_merged( + dataset_add = vs, + filter_add = VSTESTCD == "WEIGHT" & VSBLFL == "Y", + by_vars = exprs(STUDYID, USUBJID), + new_vars = exprs(WTBL = VSSTRESN) + ) %>% + derive_vars_transposed( + dataset_merge = labsbl, + by_vars = exprs(STUDYID, USUBJID), + key_var = LBTESTCDB, + value_var = LBSTRESN + ) %>% + mutate( + BMIBL = compute_bmi(height = HTBL, weight = WTBL), + BSABL = compute_bsa( + height = HTBL, + weight = HTBL, + method = "Mosteller" + ), + CRCLBL = compute_egfr( + creat = CREATBL, creatu = "SI", age = AGE, wt = WTBL, sex = SEX, + method = "CRCL" + ), + EGFRBL = compute_egfr( + creat = CREATBL, creatu = "SI", age = AGE, wt = WTBL, sex = SEX, + method = "CKD-EPI" + ) + ) %>% + rename(TBILBL = BILIBL) + +# Combine covariates with APPPK data + +adppk <- adppk_aseq %>% + derive_vars_merged( + dataset_add = covar_vslb, + by_vars = exprs(STUDYID, USUBJID) + ) %>% + arrange(STUDYIDN, USUBJIDN, AFRLT, EVID) %>% + mutate(RECSEQ = row_number()) + +# Final Steps, Select final variables and Add labels +# This process will be based on your metadata, no example given for this reason +# ... +# ---- Save output ---- + +dir <- tempdir() # Change to whichever directory you want to save the dataset in +saveRDS(adppk, file = file.path(dir, "adppk.rds"), compress = "bzip2") diff --git a/inst/templates/ad_adsl.R b/inst/templates/ad_adsl.R index 5975e6c99c..59a7d45fbe 100644 --- a/inst/templates/ad_adsl.R +++ b/inst/templates/ad_adsl.R @@ -156,14 +156,11 @@ adsl <- adsl %>% filter_add = DSCAT == "DISPOSITION EVENT" & DSDECOD != "SCREEN FAILURE" ) %>% # EOS status - derive_var_merged_cat( + derive_vars_merged( dataset_add = ds_ext, by_vars = exprs(STUDYID, USUBJID), filter_add = DSCAT == "DISPOSITION EVENT", - new_var = EOSSTT, - source_var = DSDECOD, - cat_fun = format_eosstt, - missing_value = NA_character_ + new_vars = exprs(EOSSTT = format_eosstt(DSDECOD)) ) %>% # Last retrieval date derive_vars_merged( @@ -201,50 +198,30 @@ adsl <- adsl %>% ) ## Last known alive date ---- +## DTC variables are converted to numeric dates imputing missing day and month +## to the first ae_start_date <- date_source( dataset_name = "ae", - date = AESTDT + date = convert_dtc_to_dt(AESTDTC, highest_imputation = "M") ) ae_end_date <- date_source( dataset_name = "ae", - date = AEENDT + date = convert_dtc_to_dt(AEENDTC, highest_imputation = "M") ) lb_date <- date_source( dataset_name = "lb", - date = LBDT, - filter = !is.na(LBDT) + date = convert_dtc_to_dt(LBDTC, highest_imputation = "M") ) trt_end_date <- date_source( dataset_name = "adsl", date = TRTEDT ) -# impute AE start and end date to first -ae_ext <- ae %>% - derive_vars_dt( - dtc = AESTDTC, - new_vars_prefix = "AEST", - highest_imputation = "M" - ) %>% - derive_vars_dt( - dtc = AEENDTC, - new_vars_prefix = "AEEN", - highest_imputation = "M" - ) - -# impute LB date to first -lb_ext <- derive_vars_dt( - lb, - dtc = LBDTC, - new_vars_prefix = "LB", - highest_imputation = "M" -) - adsl <- adsl %>% derive_var_extreme_dt( new_var = LSTALVDT, ae_start_date, ae_end_date, lb_date, trt_end_date, - source_datasets = list(ae = ae_ext, lb = lb_ext, adsl = adsl), + source_datasets = list(ae = ae, lb = lb, adsl = adsl), mode = "last" ) %>% derive_var_merged_exist_flag( diff --git a/inst/templates/ad_advs.R b/inst/templates/ad_advs.R index be49764f54..eb0977ce9d 100644 --- a/inst/templates/ad_advs.R +++ b/inst/templates/ad_advs.R @@ -181,8 +181,8 @@ advs <- advs %>% ## Derive baseline flags ---- advs <- advs %>% # Calculate BASETYPE - derive_var_basetype( - basetypes = rlang::exprs( + derive_basetype_records( + basetypes = exprs( "LAST: AFTER LYING DOWN FOR 5 MINUTES" = ATPTN == 815, "LAST: AFTER STANDING FOR 1 MINUTE" = ATPTN == 816, "LAST: AFTER STANDING FOR 3 MINUTES" = ATPTN == 817, @@ -247,24 +247,17 @@ advs <- advs %>% advs <- advs %>% # Assign TRTA, TRTP # Create End of Treatment Record - restrict_derivation( - derivation = derive_var_extreme_flag, - args = params( - by_vars = exprs(STUDYID, USUBJID, PARAMCD, ATPTN), - order = exprs(ADT), - new_var = EOTFL, - mode = "last" - ), - filter = (4 < VISITNUM & - VISITNUM <= 13 & ANL01FL == "Y" & is.na(DTYPE)) - ) %>% - filter(EOTFL == "Y") %>% - mutate( - AVISIT = "End of Treatment", - AVISITN = 99 + derive_extreme_records( + by_vars = exprs(STUDYID, USUBJID, PARAMCD, ATPTN), + order = exprs(ADT, AVISITN, AVAL), + mode = "last", + filter_add = (4 < AVISITN & AVISITN <= 13 & ANL01FL == "Y" & is.na(DTYPE)), + set_values_to = exprs( + AVISIT = "End of Treatment", + AVISITN = 99, + DTYPE = "LOV" + ) ) %>% - union_all(advs) %>% - select(-EOTFL) %>% mutate( TRTP = TRT01P, TRTA = TRT01A diff --git a/man/admiral-package.Rd b/man/admiral-package.Rd index 7361d4c191..ad3bdb6975 100644 --- a/man/admiral-package.Rd +++ b/man/admiral-package.Rd @@ -15,6 +15,7 @@ Useful links: \itemize{ \item \url{https://pharmaverse.github.io/admiral/} \item \url{https://github.com/pharmaverse/admiral} + \item Report bugs at \url{https://github.com/pharmaverse/admiral/issues} } } @@ -51,6 +52,8 @@ Authors: \item Kangjie Zhang \item Daphne Grasselly \item Adam Forys + \item Edoardo Mancini + \item Stefan Thoma } Other contributors: diff --git a/man/assert_db_requirements.Rd b/man/assert_db_requirements.Rd index 728d4bbd57..80bf8bd57f 100644 --- a/man/assert_db_requirements.Rd +++ b/man/assert_db_requirements.Rd @@ -35,11 +35,13 @@ database must be provided. The function checks these requirements. } \seealso{ Other Advanced Functions: +\code{\link{assert_parameters_argument}()}, \code{\link{assert_terms}()}, \code{\link{assert_valid_queries}()}, \code{\link{extend_source_datasets}()}, \code{\link{filter_date_sources}()}, \code{\link{format.basket_select}()}, +\code{\link{get_hori_data}()}, \code{\link{list_tte_source_objects}()}, \code{\link{params}()}, \code{\link{validate_basket_select}()}, diff --git a/man/assert_parameters_argument.Rd b/man/assert_parameters_argument.Rd new file mode 100644 index 0000000000..50974eb92d --- /dev/null +++ b/man/assert_parameters_argument.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/derive_param_computed.R +\name{assert_parameters_argument} +\alias{assert_parameters_argument} +\title{Asserts \code{parameters} Argument and Converts to List of Expressions} +\usage{ +assert_parameters_argument(parameters, optional = TRUE) +} +\arguments{ +\item{parameters}{The argument to check} + +\item{optional}{Is the checked argument optional? If set to \code{FALSE} and +\code{parameters} is \code{NULL} then an error is thrown.} +} +\value{ +The \code{parameters} argument (converted to a list of symbol, if it is a +character vector) +} +\description{ +The function asserts that the argument is a character vector or a list of +expressions. If it is a character vector, it converts it to a list of +symbols. +} +\seealso{ +Other Advanced Functions: +\code{\link{assert_db_requirements}()}, +\code{\link{assert_terms}()}, +\code{\link{assert_valid_queries}()}, +\code{\link{extend_source_datasets}()}, +\code{\link{filter_date_sources}()}, +\code{\link{format.basket_select}()}, +\code{\link{get_hori_data}()}, +\code{\link{list_tte_source_objects}()}, +\code{\link{params}()}, +\code{\link{validate_basket_select}()}, +\code{\link{validate_query}()} +} +\concept{other_advanced} +\keyword{other_advanced} diff --git a/man/assert_terms.Rd b/man/assert_terms.Rd index e10858575d..d88f8bab5e 100644 --- a/man/assert_terms.Rd +++ b/man/assert_terms.Rd @@ -4,19 +4,14 @@ \alias{assert_terms} \title{Asserts Requirements for Terms for Queries} \usage{ -assert_terms( - terms, - expect_query_name = FALSE, - expect_query_id = FALSE, - source_text -) +assert_terms(terms, expect_grpname = FALSE, expect_grpid = FALSE, source_text) } \arguments{ \item{terms}{Terms provided by user} -\item{expect_query_name}{Is the \code{QUERY_NAME} column expected?} +\item{expect_grpname}{Is the \code{GRPNAME} column expected?} -\item{expect_query_id}{Is the \code{QUERY_ID} column expected?} +\item{expect_grpid}{Is the \code{GRPID} column expected?} \item{source_text}{Text describing the source of the terms, e.g., \verb{"the data frame provided for the }definition\verb{ element"}.} } @@ -25,10 +20,10 @@ An error is issued if \itemize{ \item \code{terms} is not a data frame, \item \code{terms} has zero observations, -\item the \code{TERM_LEVEL} variable is not in \code{terms}, -\item neither the \code{TERM_NAME} nor the \code{TERM_ID} variable is in \code{terms}, -\item \code{expect_query_name == TRUE} and the \code{QUERY_NAME} variable is not in \code{terms}, -\item \code{expect_query_id == TRUE} and the \code{QUERY_ID} variable is not in \code{terms}, +\item the \code{SRCVAR} variable is not in \code{terms}, +\item neither the \code{TERMNAME} nor the \code{TERMID} variable is in \code{terms}, +\item \code{expect_grpname == TRUE} and the \code{GRPNAME} variable is not in \code{terms}, +\item \code{expect_grpid == TRUE} and the \code{GRPID} variable is not in \code{terms}, } } \description{ @@ -50,10 +45,12 @@ try( Other Advanced Functions: \code{\link{assert_db_requirements}()}, +\code{\link{assert_parameters_argument}()}, \code{\link{assert_valid_queries}()}, \code{\link{extend_source_datasets}()}, \code{\link{filter_date_sources}()}, \code{\link{format.basket_select}()}, +\code{\link{get_hori_data}()}, \code{\link{list_tte_source_objects}()}, \code{\link{params}()}, \code{\link{validate_basket_select}()}, diff --git a/man/assert_valid_queries.Rd b/man/assert_valid_queries.Rd index d242e42001..421d207018 100644 --- a/man/assert_valid_queries.Rd +++ b/man/assert_valid_queries.Rd @@ -20,16 +20,16 @@ Verify if a Dataset Has the Required Format as Queries Dataset. \details{ Check if the dataset has the following columns \itemize{ -\item \code{VAR_PREFIX}, e.g., SMQ01, CQ12 -\item \code{QUERY_NAME}, non NA, must be unique per each \code{VAR_PREFIX} -\item \code{QUERY_ID}, could be NA, must be unique per each \code{VAR_PREFIX} -\item \code{QUERY_SCOPE}, 'BROAD', 'NARROW', or NA -\item \code{QUERY_SCOPE_NUM}, 1, 2, or NA -\item \code{TERM_LEVEL}, e.g., \code{"AEDECOD"}, \code{"AELLT"}, \code{"AELLTCD"}, ... -\item \code{TERM_NAME}, character, could be NA only at those observations -where \code{TERM_ID} is non-NA -\item \code{TERM_ID}, integer, could be NA only at those observations -where \code{TERM_NAME} is non-NA +\item \code{PREFIX}, e.g., SMQ01, CQ12 +\item \code{GRPNAME}, non NA, must be unique per each \code{PREFIX} +\item \code{GRPID}, could be NA, must be unique per each \code{PREFIX} +\item \code{SCOPE}, 'BROAD', 'NARROW', or NA +\item \code{SCOPEN}, 1, 2, or NA +\item \code{SRCVAR}, e.g., \code{"AEDECOD"}, \code{"AELLT"}, \code{"AELLTCD"}, ... +\item \code{TERMNAME}, character, could be NA only at those observations +where \code{TERMID} is non-NA +\item \code{TERMID}, integer, could be NA only at those observations +where \code{TERMNAME} is non-NA } } \examples{ @@ -39,10 +39,12 @@ assert_valid_queries(queries, "queries") \seealso{ Other Advanced Functions: \code{\link{assert_db_requirements}()}, +\code{\link{assert_parameters_argument}()}, \code{\link{assert_terms}()}, \code{\link{extend_source_datasets}()}, \code{\link{filter_date_sources}()}, \code{\link{format.basket_select}()}, +\code{\link{get_hori_data}()}, \code{\link{list_tte_source_objects}()}, \code{\link{params}()}, \code{\link{validate_basket_select}()}, diff --git a/man/basket_select.Rd b/man/basket_select.Rd index b6f39abac6..2eb207dcd4 100644 --- a/man/basket_select.Rd +++ b/man/basket_select.Rd @@ -42,6 +42,7 @@ Source Objects: \code{\link{event_source}()}, \code{\link{event}()}, \code{\link{query}()}, +\code{\link{records_source}()}, \code{\link{tte_source}()} } \concept{source_specifications} diff --git a/man/call_derivation.Rd b/man/call_derivation.Rd index 328fa9f605..313cef60c5 100644 --- a/man/call_derivation.Rd +++ b/man/call_derivation.Rd @@ -38,14 +38,41 @@ iterations and others varying. } \examples{ library(dplyr, warn.conflicts = FALSE) -library(admiral.test) -data(admiral_ae) -data(admiral_adsl) +adsl <- tribble( + ~STUDYID, ~USUBJID, ~TRTSDT, ~TRTEDT, + "PILOT01", "01-1307", NA, NA, + "PILOT01", "05-1377", "2014-01-04", "2014-01-25", + "PILOT01", "06-1384", "2012-09-15", "2012-09-24", + "PILOT01", "15-1085", "2013-02-16", "2013-08-18", + "PILOT01", "16-1298", "2013-04-08", "2013-06-28" +) \%>\% + mutate( + across(TRTSDT:TRTEDT, as.Date) + ) + +ae <- tribble( + ~STUDYID, ~DOMAIN, ~USUBJID, ~AESTDTC, ~AEENDTC, + "PILOT01", "AE", "06-1384", "2012-09-15", "2012-09-29", + "PILOT01", "AE", "06-1384", "2012-09-15", "2012-09-29", + "PILOT01", "AE", "06-1384", "2012-09-23", "2012-09-29", + "PILOT01", "AE", "06-1384", "2012-09-23", "2012-09-29", + "PILOT01", "AE", "06-1384", "2012-09-15", "2012-09-29", + "PILOT01", "AE", "06-1384", "2012-09-15", "2012-09-29", + "PILOT01", "AE", "06-1384", "2012-09-15", "2012-09-29", + "PILOT01", "AE", "06-1384", "2012-09-15", "2012-09-29", + "PILOT01", "AE", "06-1384", "2012-09-23", "2012-09-29", + "PILOT01", "AE", "06-1384", "2012-09-23", "2012-09-29", + "PILOT01", "AE", "16-1298", "2013-06-08", "2013-07-06", + "PILOT01", "AE", "16-1298", "2013-06-08", "2013-07-06", + "PILOT01", "AE", "16-1298", "2013-04-22", "2013-07-06", + "PILOT01", "AE", "16-1298", "2013-04-22", "2013-07-06", + "PILOT01", "AE", "16-1298", "2013-04-22", "2013-07-06", + "PILOT01", "AE", "16-1298", "2013-04-22", "2013-07-06" +) -adae <- - select(admiral_ae[sample(1:nrow(admiral_ae), 1000), ], USUBJID, AESTDTC, AEENDTC) \%>\% +adae <- ae \%>\% derive_vars_merged( - dataset_add = admiral_adsl, + dataset_add = adsl, new_vars = exprs(TRTSDT, TRTEDT), by_vars = exprs(USUBJID) ) diff --git a/man/censor_source.Rd b/man/censor_source.Rd index f8b6480b0a..b2c3d5f31b 100644 --- a/man/censor_source.Rd +++ b/man/censor_source.Rd @@ -21,11 +21,12 @@ of \code{derive_param_tte()}.} \item{filter}{An unquoted condition for selecting the observations from \code{dataset} which are events or possible censoring time points.} -\item{date}{A variable providing the date of the event or censoring. A date, -or a datetime can be specified. An unquoted symbol is expected. +\item{date}{A variable or expression providing the date of the event or +censoring. A date, or a datetime can be specified. An unquoted symbol or +expression is expected. -Refer to \code{derive_vars_dt()} to impute and derive a date from a date -character vector to a date object.} +Refer to \code{derive_vars_dt()} or \code{convert_dtc_to_dt()} to impute and derive a +date from a date character vector to a date object.} \item{censor}{Censoring value @@ -34,7 +35,7 @@ censoring.} \item{set_values_to}{A named list returned by \code{exprs()} defining the variables to be set for the event or censoring, e.g. \code{exprs(EVENTDESC = "DEATH", SRCDOM = "ADSL", SRCVAR = "DTHDT")}. The values must be a symbol, a -character string, a numeric value, or \code{NA}.} +character string, a numeric value, an expression, or \code{NA}.} } \value{ An object of class \code{censor_source}, inheriting from class \code{tte_source} @@ -42,6 +43,8 @@ An object of class \code{censor_source}, inheriting from class \code{tte_source} \description{ \code{censor_source} objects are used to define censorings as input for the \code{derive_param_tte()} function. + +\strong{Note:} This is a wrapper function for the more generic \code{tte_source()}. } \examples{ # Last study date known alive censor @@ -67,6 +70,7 @@ Source Objects: \code{\link{event_source}()}, \code{\link{event}()}, \code{\link{query}()}, +\code{\link{records_source}()}, \code{\link{tte_source}()} } \concept{source_specifications} diff --git a/man/compute_age_years.Rd b/man/compute_age_years.Rd new file mode 100644 index 0000000000..b4f4cfff56 --- /dev/null +++ b/man/compute_age_years.Rd @@ -0,0 +1,58 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/compute_age_years.R +\name{compute_age_years} +\alias{compute_age_years} +\title{Compute Age in Years} +\usage{ +compute_age_years(age, age_unit) +} +\arguments{ +\item{age}{The ages to convert. + +A numeric vector is expected.} + +\item{age_unit}{Age unit. + +Either a string containing the time unit of all ages in \code{age} or a character +vector containing the time units of each age in \code{age} is expected. Note that +permitted values are cases insensitive (e.g. \code{"YEARS"} is treated the same +as \code{"years"} and \code{"Years"}). + +Permitted Values: \code{"years"}, \code{"months"}, \code{"weeks"}, \code{"days"}, \code{"hours"}, \code{"minutes"}, +\code{"seconds"}.} +} +\value{ +The ages contained in \code{age} converted to years. +} +\description{ +Converts a set of age values from the specified time unit to years. +} +\details{ +Returns a numeric vector of ages in years as doubles. Note, underlying +computations assume an equal number of days in each year (365.25). +} +\examples{ +compute_age_years( + age = c(240, 360, 480), + age_unit = "MONTHS" +) + +compute_age_years( + age = c(10, 520, 3650), + age_unit = c("YEARS", "WEEKS", "DAYS") +) + +} +\seealso{ +Date/Time Computation Functions that returns a vector: +\code{\link{compute_dtf}()}, +\code{\link{compute_duration}()}, +\code{\link{compute_tmf}()}, +\code{\link{convert_date_to_dtm}()}, +\code{\link{convert_dtc_to_dtm}()}, +\code{\link{convert_dtc_to_dt}()}, +\code{\link{impute_dtc_dtm}()}, +\code{\link{impute_dtc_dt}()} +} +\concept{com_date_time} +\keyword{com_date_time} diff --git a/man/compute_bmi.Rd b/man/compute_bmi.Rd index 0b1aeb86e5..aa6177f15b 100644 --- a/man/compute_bmi.Rd +++ b/man/compute_bmi.Rd @@ -34,6 +34,7 @@ compute_bmi(height = 170, weight = 75) \seealso{ BDS-Findings Functions that returns a vector: \code{\link{compute_bsa}()}, +\code{\link{compute_egfr}()}, \code{\link{compute_framingham}()}, \code{\link{compute_map}()}, \code{\link{compute_qtc}()}, diff --git a/man/compute_bsa.Rd b/man/compute_bsa.Rd index 75abdeb187..a8b3c9fe9e 100644 --- a/man/compute_bsa.Rd +++ b/man/compute_bsa.Rd @@ -64,6 +64,7 @@ compute_bsa( \seealso{ BDS-Findings Functions that returns a vector: \code{\link{compute_bmi}()}, +\code{\link{compute_egfr}()}, \code{\link{compute_framingham}()}, \code{\link{compute_map}()}, \code{\link{compute_qtc}()}, diff --git a/man/compute_dtf.Rd b/man/compute_dtf.Rd index 7c52f8e082..18f0c816b4 100644 --- a/man/compute_dtf.Rd +++ b/man/compute_dtf.Rd @@ -31,6 +31,7 @@ compute_dtf(dtc = "2019", dt = as.Date("2019-07-18")) } \seealso{ Date/Time Computation Functions that returns a vector: +\code{\link{compute_age_years}()}, \code{\link{compute_duration}()}, \code{\link{compute_tmf}()}, \code{\link{convert_date_to_dtm}()}, diff --git a/man/compute_duration.Rd b/man/compute_duration.Rd index 8d990f96f4..4439f55239 100644 --- a/man/compute_duration.Rd +++ b/man/compute_duration.Rd @@ -127,6 +127,7 @@ compute_duration( } \seealso{ Date/Time Computation Functions that returns a vector: +\code{\link{compute_age_years}()}, \code{\link{compute_dtf}()}, \code{\link{compute_tmf}()}, \code{\link{convert_date_to_dtm}()}, diff --git a/man/compute_egfr.Rd b/man/compute_egfr.Rd new file mode 100644 index 0000000000..bfe5702b5b --- /dev/null +++ b/man/compute_egfr.Rd @@ -0,0 +1,154 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/compute_kidney.R +\name{compute_egfr} +\alias{compute_egfr} +\title{Compute Estimated Glomerular Filtration Rate (eGFR) for Kidney Function} +\usage{ +compute_egfr(creat, creatu = "SI", age, wt, sex, race = NULL, method) +} +\arguments{ +\item{creat}{Creatinine + +A numeric vector is expected.} + +\item{creatu}{Creatinine Units + +A character vector is expected. + +Default: \code{"SI"} + +Expected Values: \code{"SI"}, \code{"CV"}, \code{"umol/L"}, \code{"mg/dL"}} + +\item{age}{Age (years) + +A numeric vector is expected.} + +\item{wt}{Weight (kg) + +A numeric vector is expected if \code{method = "CRCL"}} + +\item{sex}{Gender + +A character vector is expected. + +Expected Values: \code{"M"}, \code{"F"}} + +\item{race}{Race + +A character vector is expected if \code{method = "MDRD"} + +Expected Values: \code{"BLACK OR AFRICAN AMERICAN"} and others} + +\item{method}{Method + +A character vector is expected. + +Expected Values: \code{"CRCL"}, \code{"CKD-EPI"}, \code{"MDRD"}} +} +\value{ +A numeric vector of egfr values +} +\description{ +Compute Kidney Function Tests: +\itemize{ +\item Estimated Creatinine Clearance (CRCL) by Cockcroft-Gault equation +\item Estimated Glomerular Filtration Rate (eGFR) by CKD-EPI or MDRD equations +} +} +\details{ +Calculates an estimate of Glomerular Filtration Rate (eGFR) + +\strong{CRCL Creatinine Clearance (Cockcroft-Gault)} + +For Creatinine in umol/L: + +\deqn{\frac{(140 - age) \times weight(kg) \times constant}{Serum\:Creatinine(\mu mol/L)}} + +\deqn{Constant = 1.04\:for\:females, 1.23\:for\:males} + +For Creatinine in mg/dL: + +\deqn{\frac{(140 - age) \times weight(kg) \times (0.85\:if\:female)}{72 \times +Serum\:Creatinine(mg/dL)}} + +units = mL/min + +\strong{CKD-EPI Chronic Kidney Disease Epidemiology Collaboration formula} + +\deqn{eGFR = 142 \times min(SCr/κ, 1)^{α} \times max(SCr/κ, 1)^{-1.200} +\times 0.9938^{Age} \times 1.012 [if\:female]} + +SCr = standardized serum creatinine in mg/dL +(Note SCr(mg/dL) = Creat(umol/L) / 88.42) + +κ = 0.7 (females) or 0.9 (males) +α = -0.241 (female) or -0.302 (male) +units = mL/min/1.73 m2 + +\strong{MDRD Modification of Diet in Renal Disease formula} + +\deqn{eGFR = 175 \times (SCr)^{-1.154} \times (age)^{-0.203} +\times 0.742 [if\:female] \times 1.212 [if\:Black]} + +SCr = standardized serum creatinine in mg/dL +(Note SCr(mg/dL) = Creat(umol/L) / 88.42) + +units = mL/min/1.73 m2 +} +\examples{ +compute_egfr( + creat = 90, creatu = "umol/L", age = 53, wt = 85, sex = "M", method = "CRCL" +) + +compute_egfr( + creat = 90, creatu = "umol/L", age = 53, sex = "M", race = "ASIAN", method = "MDRD" +) + +compute_egfr( + creat = 70, creatu = "umol/L", age = 52, sex = "F", race = "BLACK OR AFRICAN AMERICAN", + method = "MDRD" +) + +compute_egfr( + creat = 90, creatu = "umol/L", age = 53, sex = "M", method = "CKD-EPI" +) + + +base <- tibble::tribble( + ~STUDYID, ~USUBJID, ~AGE, ~SEX, ~RACE, ~WTBL, ~CREATBL, ~CREATBLU, + "P01", "P01-1001", 55, "M", "WHITE", 90.7, 96.3, "umol/L", + "P01", "P01-1002", 52, "F", "BLACK OR AFRICAN AMERICAN", 68.5, 70, "umol/L", + "P01", "P01-1003", 67, "M", "BLACK OR AFRICAN AMERICAN", 85.0, 77, "umol/L", + "P01", "P01-1004", 76, "F", "ASIAN", 60.7, 65, "umol/L", +) + +base \%>\% + dplyr::mutate( + CRCL_CG = compute_egfr( + creat = CREATBL, creatu = CREATBLU, age = AGE, wt = WTBL, sex = SEX, + method = "CRCL" + ), + EGFR_EPI = compute_egfr( + creat = CREATBL, creatu = CREATBLU, age = AGE, wt = WTBL, sex = SEX, + method = "CKD-EPI" + ), + EGFR_MDRD = compute_egfr( + creat = CREATBL, creatu = CREATBLU, age = AGE, wt = WTBL, sex = SEX, + race = RACE, method = "MDRD" + ), + ) +} +\seealso{ +BDS-Findings Functions that returns a vector: +\code{\link{compute_bmi}()}, +\code{\link{compute_bsa}()}, +\code{\link{compute_framingham}()}, +\code{\link{compute_map}()}, +\code{\link{compute_qtc}()}, +\code{\link{compute_qual_imputation_dec}()}, +\code{\link{compute_qual_imputation}()}, +\code{\link{compute_rr}()}, +\code{\link{compute_scale}()} +} +\concept{com_bds_findings} +\keyword{com_bds_findings} diff --git a/man/compute_framingham.Rd b/man/compute_framingham.Rd index eece486d2e..cada5fc027 100644 --- a/man/compute_framingham.Rd +++ b/man/compute_framingham.Rd @@ -118,6 +118,7 @@ compute_framingham( BDS-Findings Functions that returns a vector: \code{\link{compute_bmi}()}, \code{\link{compute_bsa}()}, +\code{\link{compute_egfr}()}, \code{\link{compute_map}()}, \code{\link{compute_qtc}()}, \code{\link{compute_qual_imputation_dec}()}, diff --git a/man/compute_map.Rd b/man/compute_map.Rd index d5607ace1a..2677ee2ced 100644 --- a/man/compute_map.Rd +++ b/man/compute_map.Rd @@ -46,6 +46,7 @@ compute_map(diabp = 51, sysbp = 121, hr = 59) BDS-Findings Functions that returns a vector: \code{\link{compute_bmi}()}, \code{\link{compute_bsa}()}, +\code{\link{compute_egfr}()}, \code{\link{compute_framingham}()}, \code{\link{compute_qtc}()}, \code{\link{compute_qual_imputation_dec}()}, diff --git a/man/compute_qtc.Rd b/man/compute_qtc.Rd index b0b62d780b..746a107973 100644 --- a/man/compute_qtc.Rd +++ b/man/compute_qtc.Rd @@ -48,6 +48,7 @@ compute_qtc(qt = 350, rr = 56.54, method = "Sagie") BDS-Findings Functions that returns a vector: \code{\link{compute_bmi}()}, \code{\link{compute_bsa}()}, +\code{\link{compute_egfr}()}, \code{\link{compute_framingham}()}, \code{\link{compute_map}()}, \code{\link{compute_qual_imputation_dec}()}, diff --git a/man/compute_qual_imputation.Rd b/man/compute_qual_imputation.Rd index 86f46d00b7..2c8ce68a8c 100644 --- a/man/compute_qual_imputation.Rd +++ b/man/compute_qual_imputation.Rd @@ -33,6 +33,7 @@ compute_qual_imputation("<40") BDS-Findings Functions that returns a vector: \code{\link{compute_bmi}()}, \code{\link{compute_bsa}()}, +\code{\link{compute_egfr}()}, \code{\link{compute_framingham}()}, \code{\link{compute_map}()}, \code{\link{compute_qtc}()}, diff --git a/man/compute_qual_imputation_dec.Rd b/man/compute_qual_imputation_dec.Rd index 1e9bb32c60..7aff94c8dc 100644 --- a/man/compute_qual_imputation_dec.Rd +++ b/man/compute_qual_imputation_dec.Rd @@ -30,6 +30,7 @@ compute_qual_imputation_dec("<40.1") BDS-Findings Functions that returns a vector: \code{\link{compute_bmi}()}, \code{\link{compute_bsa}()}, +\code{\link{compute_egfr}()}, \code{\link{compute_framingham}()}, \code{\link{compute_map}()}, \code{\link{compute_qtc}()}, diff --git a/man/compute_rr.Rd b/man/compute_rr.Rd index b817ae51bd..518c4d10d6 100644 --- a/man/compute_rr.Rd +++ b/man/compute_rr.Rd @@ -29,6 +29,7 @@ compute_rr(hr = 70.14) BDS-Findings Functions that returns a vector: \code{\link{compute_bmi}()}, \code{\link{compute_bsa}()}, +\code{\link{compute_egfr}()}, \code{\link{compute_framingham}()}, \code{\link{compute_map}()}, \code{\link{compute_qtc}()}, diff --git a/man/compute_scale.Rd b/man/compute_scale.Rd index 5f2036c69d..3dd95387be 100644 --- a/man/compute_scale.Rd +++ b/man/compute_scale.Rd @@ -83,6 +83,7 @@ compute_scale( BDS-Findings Functions that returns a vector: \code{\link{compute_bmi}()}, \code{\link{compute_bsa}()}, +\code{\link{compute_egfr}()}, \code{\link{compute_framingham}()}, \code{\link{compute_map}()}, \code{\link{compute_qtc}()}, diff --git a/man/compute_tmf.Rd b/man/compute_tmf.Rd index a1b3d830c4..e65b90cfe3 100644 --- a/man/compute_tmf.Rd +++ b/man/compute_tmf.Rd @@ -41,6 +41,7 @@ compute_tmf(dtc = "2019-07-18", dtm = as.POSIXct("2019-07-18")) } \seealso{ Date/Time Computation Functions that returns a vector: +\code{\link{compute_age_years}()}, \code{\link{compute_dtf}()}, \code{\link{compute_duration}()}, \code{\link{convert_date_to_dtm}()}, diff --git a/man/convert_blanks_to_na.Rd b/man/convert_blanks_to_na.Rd index adb562efb6..8e66147503 100644 --- a/man/convert_blanks_to_na.Rd +++ b/man/convert_blanks_to_na.Rd @@ -39,11 +39,11 @@ library(tibble) convert_blanks_to_na(c("a", "b", "", "d", "")) -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"), - d = structure(c("", "", "s", "q"), label = "D") +df <- tribble( + ~USUBJID, ~RFICDTC, + "1001", "2000-01-01", + "1002", "2001-01-01", + "1003", "" ) print(df) convert_blanks_to_na(df) diff --git a/man/convert_date_to_dtm.Rd b/man/convert_date_to_dtm.Rd index 9c2964a9c7..d15849dade 100644 --- a/man/convert_date_to_dtm.Rd +++ b/man/convert_date_to_dtm.Rd @@ -126,7 +126,10 @@ Permitted Values: \code{TRUE}, \code{FALSE} A datetime object } \description{ -Convert a date (datetime, date, or date character) into a Date vector (usually \code{'--DTM'}). +Convert a date (datetime, date, or date character) into a Date +vector (usually \code{'--DTM'}). + +\strong{Note:} This is a wrapper function for the function \code{convert_dtc_to_dtm()}. } \details{ Usually this computation function can not be used with \verb{\%>\%}. @@ -140,6 +143,7 @@ convert_date_to_dtm("2019-07-18") } \seealso{ Date/Time Computation Functions that returns a vector: +\code{\link{compute_age_years}()}, \code{\link{compute_dtf}()}, \code{\link{compute_duration}()}, \code{\link{compute_tmf}()}, diff --git a/man/convert_dtc_to_dt.Rd b/man/convert_dtc_to_dt.Rd index d2cf1ea030..f6ff1e6666 100644 --- a/man/convert_dtc_to_dt.Rd +++ b/man/convert_dtc_to_dt.Rd @@ -111,6 +111,7 @@ convert_dtc_to_dt("2019-07") } \seealso{ Date/Time Computation Functions that returns a vector: +\code{\link{compute_age_years}()}, \code{\link{compute_dtf}()}, \code{\link{compute_duration}()}, \code{\link{compute_tmf}()}, diff --git a/man/convert_dtc_to_dtm.Rd b/man/convert_dtc_to_dtm.Rd index d880e49bad..3d612f2092 100644 --- a/man/convert_dtc_to_dtm.Rd +++ b/man/convert_dtc_to_dtm.Rd @@ -136,6 +136,7 @@ convert_dtc_to_dtm("2019-07-18") } \seealso{ Date/Time Computation Functions that returns a vector: +\code{\link{compute_age_years}()}, \code{\link{compute_dtf}()}, \code{\link{compute_duration}()}, \code{\link{compute_tmf}()}, diff --git a/man/convert_na_to_blanks.Rd b/man/convert_na_to_blanks.Rd index e36334ca77..7e58e4b7ce 100644 --- a/man/convert_na_to_blanks.Rd +++ b/man/convert_na_to_blanks.Rd @@ -39,11 +39,11 @@ 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") +df <- tribble( + ~USUBJID, ~RFICDTC, + "1001", "2000-01-01", + "1002", "2001-01-01", + "1003", NA ) print(df) convert_na_to_blanks(df) diff --git a/man/count_vals.Rd b/man/count_vals.Rd index 779124b8d9..4d0be694d7 100644 --- a/man/count_vals.Rd +++ b/man/count_vals.Rd @@ -43,8 +43,10 @@ group_by(data, USUBJID) \%>\% } \seealso{ Utilities for Filtering Observations: +\code{\link{filter_exist}()}, \code{\link{filter_extreme}()}, \code{\link{filter_joined}()}, +\code{\link{filter_not_exist}()}, \code{\link{filter_relative}()}, \code{\link{max_cond}()}, \code{\link{min_cond}()} diff --git a/man/create_query_data.Rd b/man/create_query_data.Rd index 9e6eefd079..1f7ca894a2 100644 --- a/man/create_query_data.Rd +++ b/man/create_query_data.Rd @@ -33,13 +33,13 @@ it has to be implemented at company level. 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 basket, +\item \code{SRCVAR}: 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 +\item \code{TERMNAME}: the name of the term if the variable \code{SRCVAR} is referring to is character -\item \code{TERM_ID} the numeric id of the term if the variable \code{TERM_LEVEL} is +\item \code{TERMID} the numeric id of the term if the variable \code{SRCVAR} is referring to is numeric -\item \code{QUERY_NAME}: the name of the basket. The values must be the same for +\item \code{GRPNAME}: the name of the basket. The values must be the same for all observations. } @@ -50,7 +50,7 @@ The function must provide the following parameters \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 basket. +\code{GRPID} 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 baskets in the \code{create_query_data()} call. For example if SMQs need to be read from a @@ -69,7 +69,7 @@ in the \code{derive_vars_query()} function as defined in the \href{../articles/q } \details{ For each \code{query()} object listed in the \code{queries} argument, the terms belonging -to the query (\code{TERM_LEVEL}, \code{TERM_NAME}, \code{TERM_ID}) are determined with respect +to the query (\code{SRCVAR}, \code{TERMNAME}, \code{TERMID}) are determined with respect to the \code{definition} field of the query: if the definition field of the \code{query()} object is \itemize{ @@ -83,24 +83,24 @@ the data frames and all terms read from the basket database referenced by the The following variables (as described in \href{../articles/queries_dataset.html}{Queries Dataset Documentation}) are created: \itemize{ -\item \code{VAR_PREFIX}: Prefix of the variables to be created by +\item \code{PREFIX}: Prefix of the variables to be created by \code{derive_vars_query()} as specified by the \code{prefix} element. -\item \code{QUERY_NAME}: Name of the query as specified by the \code{name} element. -\item \code{QUERY_ID}: Id of the query as specified by the \code{id} element. If the \code{id} +\item \code{GRPNAME}: Name of the query as specified by the \code{name} element. +\item \code{GRPID}: Id of the query as specified by the \code{id} element. If the \code{id} 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 +\item \code{SCOPE}: scope of the query as specified by the \code{scope} element of 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{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 +\item \code{SCOPEN}: numeric scope of the query. It is set to \code{1} if the 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 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{SRCVAR}: Name of the variable used to identify the terms. +\item \code{TERMNAME}: Value of the term variable if it is a character variable. +\item \code{TERMID}: 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. } @@ -113,11 +113,11 @@ library(admiral) # creating a query dataset for a customized query cqterms <- tribble( - ~TERM_NAME, ~TERM_ID, + ~TERMNAME, ~TERMID, "APPLICATION SITE ERYTHEMA", 10003041L, "APPLICATION SITE PRURITUS", 10003053L ) \%>\% - mutate(TERM_LEVEL = "AEDECOD") + mutate(SRCVAR = "AEDECOD") cq <- query( prefix = "CQ01", diff --git a/man/date_source.Rd b/man/date_source.Rd index 2d93109d8f..e9fd8e1a52 100644 --- a/man/date_source.Rd +++ b/man/date_source.Rd @@ -12,12 +12,12 @@ the date.} \item{filter}{An unquoted condition for filtering \code{dataset}.} -\item{date}{A variable providing a date. A date or a datetime can be -specified. An unquoted symbol is expected.} +\item{date}{A variable or an expression providing a date. A date or a +datetime can be specified. An unquoted symbol or expression is expected.} \item{traceability_vars}{A named list returned by \code{exprs()} defining the traceability variables, e.g. \code{exprs(LALVDOM = "AE", LALVSEQ = AESEQ, LALVVAR = "AESTDTC")}. The values must be a symbol, a character string, a numeric, -or \code{NA}.} +an expression, or \code{NA}.} } \value{ An object of class \code{date_source}. @@ -38,7 +38,7 @@ trt_end_date <- date_source( lb_date <- date_source( dataset_name = "lb", filter = LBSTAT != "NOT DONE" | is.na(LBSTAT), - date = LBDT + date = convert_dtc_to_dt(LBDTC) ) # death date from ADSL including traceability variables @@ -62,6 +62,7 @@ Source Objects: \code{\link{event_source}()}, \code{\link{event}()}, \code{\link{query}()}, +\code{\link{records_source}()}, \code{\link{tte_source}()} } \concept{source_specifications} diff --git a/man/default_qtc_paramcd.Rd b/man/default_qtc_paramcd.Rd index 47e71550ce..3ca73a9c6f 100644 --- a/man/default_qtc_paramcd.Rd +++ b/man/default_qtc_paramcd.Rd @@ -33,7 +33,7 @@ BDS-Findings Functions for adding Parameters/Records: \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_extreme_record}()}, \code{\link{derive_param_framingham}()}, \code{\link{derive_param_map}()}, \code{\link{derive_param_qtc}()}, diff --git a/man/derive_basetype_records.Rd b/man/derive_basetype_records.Rd new file mode 100644 index 0000000000..44b88473c3 --- /dev/null +++ b/man/derive_basetype_records.Rd @@ -0,0 +1,113 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/derive_basetype_records.R +\name{derive_basetype_records} +\alias{derive_basetype_records} +\title{Derive Basetype Variable} +\usage{ +derive_basetype_records(dataset, basetypes) +} +\arguments{ +\item{dataset}{Input dataset + +The columns specified in the expressions inside \code{basetypes} are required.} + +\item{basetypes}{A \emph{named} list of expressions created using the +\code{rlang::exprs()} function + +The names corresponds to the values of the newly created \code{BASETYPE} variables +and the expressions are used to subset the input dataset.} +} +\value{ +The input dataset with variable \code{BASETYPE} added +} +\description{ +Baseline Type \code{BASETYPE} is needed when there is more than one definition of +baseline for a given Analysis Parameter \code{PARAM} in the same dataset. For a +given parameter, if Baseline Value \code{BASE} is populated, and there is more than +one definition of baseline, then \code{BASETYPE} must be non-null on all records of +any type for that parameter. Each value of \code{BASETYPE} refers to a definition of +baseline that characterizes the value of \code{BASE} on that row. Please see +section 4.2.1.6 of the ADaM Implementation Guide, version 1.3 for further +background. +} +\details{ +Adds the \code{BASETYPE} variable to a dataset and duplicates records based upon +the provided conditions. + +For each element of \code{basetypes} the input dataset is subset based upon +the provided expression and the \code{BASETYPE} variable is set to the name of the +expression. Then, all subsets are stacked. Records which do not match any +condition are kept and \code{BASETYPE} is set to \code{NA}. +} +\examples{ +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, + "P01", "DOUBLE-BLIND", "PARAM01", 3, 9.2, + "P01", "DOUBLE-BLIND", "PARAM01", 4, 10.1, + "P01", "OPEN-LABEL", "PARAM01", 5, 10.4, + "P01", "OPEN-LABEL", "PARAM01", 6, 9.9, + "P02", "RUN-IN", "PARAM01", 1, 12.1, + "P02", "DOUBLE-BLIND", "PARAM01", 2, 10.2, + "P02", "DOUBLE-BLIND", "PARAM01", 3, 10.8, + "P02", "OPEN-LABEL", "PARAM01", 4, 11.4, + "P02", "OPEN-LABEL", "PARAM01", 5, 10.8 +) + +bds_with_basetype <- derive_basetype_records( + dataset = bds, + 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" + ) +) + + +# Below print statement will print all 23 records in the data frame +# bds_with_basetype +print(bds_with_basetype, n = Inf) + +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 <- tribble( + ~USUBJID, ~EPOCH, ~PARAMCD, ~ASEQ, ~AVAL, + "P01", "RUN-IN", "PARAM01", 1, 10.0, + "P01", "RUN-IN", "PARAM01", 2, 9.8, + "P01", "DOUBLE-BLIND", "PARAM01", 3, 9.2, + "P01", "DOUBLE-BLIND", "PARAM01", 4, 10.1 +) + +bds_with_basetype <- derive_basetype_records( + dataset = bds, + basetypes = exprs( + "LAST" = TRUE, + "WORST" = TRUE + ) +) + +print(bds_with_basetype, n = Inf) + +count(bds_with_basetype, BASETYPE, name = "Number of Records") +} +\seealso{ +BDS-Findings Functions that returns variable appended to dataset: +\code{\link{derive_var_analysis_ratio}()}, +\code{\link{derive_var_anrind}()}, +\code{\link{derive_var_atoxgr_dir}()}, +\code{\link{derive_var_atoxgr}()}, +\code{\link{derive_var_base}()}, +\code{\link{derive_var_chg}()}, +\code{\link{derive_var_ontrtfl}()}, +\code{\link{derive_var_pchg}()}, +\code{\link{derive_var_shift}()} +} +\concept{der_bds_findings} +\keyword{der_bds_findings} diff --git a/man/derive_derived_param.Rd b/man/derive_derived_param.Rd deleted file mode 100644 index cee9ced906..0000000000 --- a/man/derive_derived_param.Rd +++ /dev/null @@ -1,110 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/derive_param_computed.R -\name{derive_derived_param} -\alias{derive_derived_param} -\title{Adds a Parameter Computed from the Analysis Value of Other Parameters} -\usage{ -derive_derived_param( - dataset, - by_vars, - parameters, - analysis_value, - set_values_to, - filter = NULL, - constant_by_vars = NULL, - constant_parameters = NULL -) -} -\arguments{ -\item{dataset}{Input dataset - -The variables specified by the \code{by_vars} parameter, \code{PARAMCD}, and \code{AVAL} -are expected. - -The variable specified by \code{by_vars} and \code{PARAMCD} must be a unique key of -the input dataset after restricting it by the filter condition (\code{filter} -parameter) and to the parameters specified by \code{parameters}.} - -\item{by_vars}{Grouping variables - -For each group defined by \code{by_vars} an observation is added to the output -dataset. Only variables specified in \code{by_vars} will be populated -in the newly created records. - -\emph{Permitted Values:} list of variables} - -\item{parameters}{Required parameter codes - -It is expected that all parameter codes (\code{PARAMCD}) which are required to -derive the new parameter are specified for this parameter or the -\code{constant_parameters} parameter. - -\emph{Permitted Values:} A character vector of \code{PARAMCD} values} - -\item{analysis_value}{Definition of the analysis value - -An expression defining the analysis value (\code{AVAL}) of the new parameter is -expected. The analysis values of the parameters specified by \code{parameters} -can be accessed using \verb{AVAL.}, e.g., \code{AVAL.SYSBP}. - -\emph{Permitted Values:} An unquoted expression} - -\item{set_values_to}{Variables to be set - -The specified variables are set to the specified values for the new -observations. For example \code{exprs(PARAMCD = "MAP")} defines the parameter -code for the new parameter. - -\emph{Permitted Values:} List of variable-value pairs} - -\item{filter}{Filter condition - -The specified condition is applied to the input dataset before deriving the -new parameter, i.e., only observations fulfilling the condition are taken -into account. - -\emph{Permitted Values:} a condition} - -\item{constant_by_vars}{By variables for constant parameters - -The constant parameters (parameters that are measured only once) are merged -to the other parameters using the specified variables. (Refer to Example 2) - -\emph{Permitted Values:} list of variables} - -\item{constant_parameters}{Required constant parameter codes - -It is expected that all the parameter codes (\code{PARAMCD}) which are required -to derive the new parameter and are measured only once are specified here. -For example if BMI should be derived and height is measured only once while -weight is measured at each visit. Height could be specified in the -\code{constant_parameters} parameter. (Refer to Example 2) - -\emph{Permitted Values:} A character vector of \code{PARAMCD} values} -} -\value{ -The input dataset with the new parameter added. Note, a variable will only -be populated in the new parameter rows if it is specified in \code{by_vars}. -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} - -This function is deprecated. Please use \code{derive_param_computed()} instead. -} -\seealso{ -Other deprecated: -\code{\link{derive_param_first_event}()}, -\code{\link{derive_var_agegr_fda}()}, -\code{\link{derive_var_confirmation_flag}()}, -\code{\link{derive_var_disposition_status}()}, -\code{\link{derive_var_worst_flag}()}, -\code{\link{derive_vars_disposition_reason}()}, -\code{\link{derive_vars_merged_dtm}()}, -\code{\link{derive_vars_merged_dt}()}, -\code{\link{filter_confirmation}()}, -\code{\link{format_eoxxstt_default}()}, -\code{\link{format_reason_default}()}, -\code{\link{vars}()} -} -\concept{deprecated} -\keyword{deprecated} diff --git a/man/derive_expected_records.Rd b/man/derive_expected_records.Rd index a20d07e831..75022c4b80 100644 --- a/man/derive_expected_records.Rd +++ b/man/derive_expected_records.Rd @@ -37,7 +37,7 @@ A list of variable name-value pairs is expected. \itemize{ \item LHS refers to a variable. \item RHS refers to the values to set to the variable. This can be a string, a -symbol, a numeric value or \code{NA}, e.g., \code{exprs(PARAMCD = "TDOSE", PARCAT1 = "OVERALL")}. More general expression are not allowed. +symbol, a numeric value, \code{NA}, or expressions, e.g., \code{exprs(PARAMCD = "TDOSE", PARCAT1 = "OVERALL")}. }} } \value{ @@ -107,7 +107,7 @@ BDS-Findings Functions for adding Parameters/Records: \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_extreme_record}()}, \code{\link{derive_param_framingham}()}, \code{\link{derive_param_map}()}, \code{\link{derive_param_qtc}()}, diff --git a/man/derive_extreme_event.Rd b/man/derive_extreme_event.Rd index 946c4e2c8d..b2912f1783 100644 --- a/man/derive_extreme_event.Rd +++ b/man/derive_extreme_event.Rd @@ -37,8 +37,8 @@ meet the filter \code{condition}, take the first record sorted by \code{order}.} If a particular event from \code{events} has more than one observation, within the event and by group, the records are ordered by the specified order. -\emph{Permitted Values:} list of variables or \verb{desc()} function calls -created by \code{exprs()}, e.g., \code{exprs(ADT, desc(AVAL))}} +\emph{Permitted Values:} list of expressions created by \code{exprs()}, e.g., +\code{exprs(ADT, desc(AVAL))}} \item{mode}{Selection mode (first or last) @@ -67,7 +67,7 @@ A list of variable name-value pairs is expected. \itemize{ \item LHS refers to a variable. \item RHS refers to the values to set to the variable. This can be a string, a -symbol, a numeric value or \code{NA}, e.g., \code{exprs(PARAMCD = "TDOSE", PARCAT1 = "OVERALL")}. More general expression are not allowed. +symbol, a numeric value, an expression, or \code{NA}, e.g., \code{exprs(PARAMCD = "TDOSE", PARCAT1 = "OVERALL")}. }} } \value{ @@ -158,7 +158,7 @@ BDS-Findings Functions for adding Parameters/Records: \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_extreme_record}()}, \code{\link{derive_param_framingham}()}, \code{\link{derive_param_map}()}, \code{\link{derive_param_qtc}()}, diff --git a/man/derive_extreme_records.Rd b/man/derive_extreme_records.Rd index b75e4d9e10..a18c354a8f 100644 --- a/man/derive_extreme_records.Rd +++ b/man/derive_extreme_records.Rd @@ -5,33 +5,61 @@ \title{Add the First or Last Observation for Each By Group as New Records} \usage{ derive_extreme_records( - dataset, + dataset = NULL, + dataset_add = NULL, + dataset_ref = NULL, by_vars = NULL, - order, - mode, + order = NULL, + mode = NULL, + filter_add = NULL, check_type = "warning", - filter = NULL, - set_values_to + exist_flag = NULL, + true_value = "Y", + false_value = "N", + set_values_to, + filter ) } \arguments{ \item{dataset}{Input dataset -The variables specified by the \code{order} and the \code{by_vars} parameter are -expected.} +If \code{dataset_add} is not specified, the new records are selected from the +input dataset. In this case the variables specified by \code{by_vars} and +\code{order} are expected.} + +\item{dataset_add}{Additional dataset + +Observations from the specified dataset are added as new records to the +input dataset (\code{dataset}). + +All observations in the specified dataset fulfilling the condition +specified by \code{filter_source} are considered. If \code{mode} and \code{order} are +specified, the first or last observation within each by group, defined by +\code{by_vars}, is selected. + +If the argument is not specified, the input dataset (\code{dataset}) is used. + +The variables specified by the \code{by_vars} and \code{order} argument (if +applicable) are expected.} + +\item{dataset_ref}{Reference dataset + +The variables specified for \code{by_vars} are expected. For each +observation of the specified dataset a new observation is added to the +input dataset.} \item{by_vars}{Grouping variables -\emph{Default}: \code{NULL} +If \code{dataset_ref} is specified, this argument must be specified. -\emph{Permitted Values:} list of variables created by \code{exprs()}} +\emph{Permitted Values}: list of variables created by \code{exprs()}} \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{exprs()}, e.g., \code{exprs(ADT, desc(AVAL))}} +\emph{Permitted Values:} list of expressions created by \code{exprs()}, e.g., +\code{exprs(ADT, desc(AVAL))}} \item{mode}{Selection mode (first or last) @@ -41,25 +69,41 @@ each by group is added to the input dataset. \emph{Permitted Values:} \code{"first"}, \code{"last"}} +\item{filter_add}{Filter for additional dataset (\code{dataset_add}) + +Only observations in \code{dataset_add} fulfilling the specified condition are +considered.} + \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. +if the observations of the (restricted) additional dataset are not unique +with respect to the by variables and the order. -\emph{Default:} \code{"warning"} +\emph{Permitted Values}: \code{"none"}, \code{"warning"}, \code{"error"}} -\emph{Permitted Values:} \code{"none"}, \code{"warning"}, \code{"error"}} +\item{exist_flag}{Existence flag -\item{filter}{Filter for observations to consider +The specified variable is added to the output dataset. -Only observations fulfilling the specified condition are taken into account -for selecting the first or last observation. If the parameter is not -specified, all observations are considered. +For by groups with at least one observation in the additional dataset +(\code{dataset_add}) \code{exist_flag} is set to the value specified by the +\code{true_value} argument. -\emph{Default}: \code{NULL} +For all other by groups \code{exist_flag} is set to the value specified by the +\code{false_value} argument. -\emph{Permitted Values}: a condition} +\emph{Permitted Values:} Variable name} + +\item{true_value}{True value + +For new observations selected from the additional dataset (\code{dataset_add}), +\code{exist_flag} is set to the specified value.} + +\item{false_value}{False value + +For new observations not selected from the additional dataset +(\code{dataset_add}), \code{exist_flag} is set to the specified value.} \item{set_values_to}{Variables to be set @@ -70,34 +114,50 @@ A list of variable name-value pairs is expected. \itemize{ \item LHS refers to a variable. \item RHS refers to the values to set to the variable. This can be a string, a -symbol, a numeric value or \code{NA}, e.g., \code{exprs(PARAMCD = "TDOSE", PARCAT1 = "OVERALL")}. More general expression are not allowed. +symbol, a numeric value, an expression, or \code{NA}, e.g., \code{exprs(PARAMCD = "TDOSE", PARCAT1 = "OVERALL")}. }} + +\item{filter}{Filter for observations to consider + +\emph{Deprecated}, please use the above \code{filter_add} argument instead. + +Only observations fulfilling the specified condition are taken into account +for selecting the first or last observation. If the argument is not +specified, all observations are considered. + +\emph{Permitted Values}: a condition} } \value{ The input dataset with the first or last observation of each by group added as new observations. } \description{ -Add the first or last observation for each by group as new observations. It -can be used for example for adding the maximum or minimum value as a separate -visit. All variables of the selected observation are kept. This distinguish -\code{derive_extreme_records()} from \code{derive_summary_records()}, where only the by -variables are populated for the new records. +Add the first or last observation for each by group as new observations. The +new observations can be selected from the input dataset or an additional +dataset. This function can be used for adding the maximum or minimum value +as a separate visit. All variables of the selected observation are kept. This +distinguishes \code{derive_extreme_records()} from \code{derive_summary_records()}, +where only the by variables are populated for the new records. } \details{ \enumerate{ -\item The input dataset is restricted as specified by the \code{filter} parameter. +\item The additional dataset (\code{dataset_add}) is restricted as specified by the +\code{filter_add} argument. \item For each group (with respect to the variables specified for the -\code{by_vars} parameter) the first or last observation (with respect to the -order specified for the \code{order} parameter and the mode specified for the -\code{mode} parameter) is selected. -\item The variables specified by the \code{set_values_to} parameter are added to +\code{by_vars} argument) the first or last observation (with respect to the +order specified for the \code{order} argument and the mode specified for the +\code{mode} argument) is selected. +\item If \code{dataset_ref} is specified, observations which are in \code{dataset_ref} +but not in the selected records are added. +\item The variables specified by the \code{set_values_to} argument are added to the selected observations. \item The observations are added to input dataset. } } \examples{ library(tibble) +library(dplyr, warn.conflicts = FALSE) +library(lubridate) adlb <- tribble( ~USUBJID, ~AVISITN, ~AVAL, ~LBSEQ, @@ -117,7 +177,7 @@ derive_extreme_records( by_vars = exprs(USUBJID), order = exprs(AVAL, AVISITN), mode = "first", - filter = !is.na(AVAL), + filter_add = !is.na(AVAL), set_values_to = exprs( AVISITN = 97, DTYPE = "MINIMUM" @@ -132,7 +192,7 @@ derive_extreme_records( by_vars = exprs(USUBJID), order = exprs(desc(AVAL), AVISITN), mode = "first", - filter = !is.na(AVAL), + filter_add = !is.na(AVAL), set_values_to = exprs( AVISITN = 98, DTYPE = "MAXIMUM" @@ -151,6 +211,72 @@ derive_extreme_records( DTYPE = "LOV" ) ) + +# 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_extreme_records( + adrs, + dataset_ref = adsl, + dataset_add = adrs, + by_vars = exprs(STUDYID, USUBJID), + filter_add = PARAMCD == "OVR" & AVALC == "PD", + order = exprs(ADT), + exist_flag = AVALC, + true_value = "Y", + false_value = "N", + mode = "first", + set_values_to = exprs( + PARAMCD = "PD", + PARAM = "Disease Progression", + AVAL = yn_to_numeric(AVALC), + ANL01FL = "Y", + ADT = ADT + ) +) + +# derive parameter indicating death +derive_extreme_records( + dataset_ref = adsl, + dataset_add = adsl, + by_vars = exprs(STUDYID, USUBJID), + filter_add = !is.na(DTHDT), + exist_flag = AVALC, + true_value = "Y", + false_value = "N", + mode = "first", + set_values_to = exprs( + PARAMCD = "DEATH", + PARAM = "Death", + ANL01FL = "Y", + ADT = DTHDT + ) +) } \seealso{ BDS-Findings Functions for adding Parameters/Records: @@ -164,7 +290,7 @@ BDS-Findings Functions for adding Parameters/Records: \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_extreme_record}()}, \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 index f6aad644bf..3ef93a3e51 100644 --- a/man/derive_locf_records.Rd +++ b/man/derive_locf_records.Rd @@ -37,10 +37,10 @@ in the input dataset.} \emph{Permitted Values}: a variable} -\item{order}{List of variables for sorting a dataset +\item{order}{Sort order -The dataset is sorted by \code{order} before carrying the last -observation forward (eg. \code{AVAL}) within each \code{by_vars}.} +The dataset is sorted by \code{order} before carrying the last observation +forward (e.g. \code{AVAL}) within each \code{by_vars}.} \item{keep_vars}{Variables that need carrying the last observation forward @@ -133,7 +133,7 @@ BDS-Findings Functions for adding Parameters/Records: \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_extreme_record}()}, \code{\link{derive_param_framingham}()}, \code{\link{derive_param_map}()}, \code{\link{derive_param_qtc}()}, diff --git a/man/derive_param_bmi.Rd b/man/derive_param_bmi.Rd index 90346d4df9..fb8a3ee12e 100644 --- a/man/derive_param_bmi.Rd +++ b/man/derive_param_bmi.Rd @@ -75,6 +75,8 @@ be populated in the new parameter rows if it is specified in \code{by_vars}. \description{ Adds a record for BMI/Body Mass Index using Weight and Height each by group (e.g., subject and visit) where the source parameters are available. + +\strong{Note:} This is a wrapper function for the more generic \code{derive_param_computed()}. } \details{ The analysis value of the new parameter is derived as @@ -119,7 +121,7 @@ BDS-Findings Functions for adding Parameters/Records: \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_extreme_record}()}, \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 ad7bc6bed6..9fd45fd2c1 100644 --- a/man/derive_param_bsa.Rd +++ b/man/derive_param_bsa.Rd @@ -93,8 +93,11 @@ The input dataset with the new parameter added. Note, a variable will only be populated in the new parameter rows if it is specified in \code{by_vars}. } \description{ -Adds a record for BSA (Body Surface Area) using the specified derivation method -for each by group (e.g., subject and visit) where the source parameters are available. +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. + +\strong{Note:} This is a wrapper function for the more generic \code{derive_param_computed()}. } \examples{ library(tibble) @@ -145,7 +148,7 @@ BDS-Findings Functions for adding Parameters/Records: \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_extreme_record}()}, \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 9025555a0b..14f1aea584 100644 --- a/man/derive_param_computed.Rd +++ b/man/derive_param_computed.Rd @@ -5,9 +5,11 @@ \title{Adds a Parameter Computed from the Analysis Value of Other Parameters} \usage{ derive_param_computed( - dataset, + dataset = NULL, + dataset_add = NULL, by_vars, parameters, + analysis_var = AVAL, analysis_value, set_values_to, filter = NULL, @@ -18,13 +20,24 @@ derive_param_computed( \arguments{ \item{dataset}{Input dataset -The variables specified by the \code{by_vars} parameter, \code{PARAMCD}, and \code{AVAL} -are expected. +The variables specified by the \code{by_vars} parameter are expected. The variable specified by \code{by_vars} and \code{PARAMCD} must be a unique key of the input dataset after restricting it by the filter condition (\code{filter} parameter) and to the parameters specified by \code{parameters}.} +\item{dataset_add}{Additional dataset + +The variables specified by the \code{by_vars} parameter are expected. + +The variable specified by \code{by_vars} and \code{PARAMCD} must be a unique key of +the additional dataset after restricting it to the parameters specified by +\code{parameters}. + +If the argument is specified, the observations of the additional dataset +are considered in addition to the observations from the input dataset +(\code{dataset} restricted by \code{filter}).} + \item{by_vars}{Grouping variables For each group defined by \code{by_vars} an observation is added to the output @@ -39,13 +52,36 @@ It is expected that all parameter codes (\code{PARAMCD}) which are required to derive the new parameter are specified for this parameter or the \code{constant_parameters} parameter. -\emph{Permitted Values:} A character vector of \code{PARAMCD} values} +If observations should be considered which do not have a parameter code, +e.g., if an SDTM dataset is used, temporary parameter codes can be derived +by specifying a list of expressions. The name of the element defines the +temporary parameter code and the expression the condition for selecting the +records. For example \code{parameters = exprs(HGHT = VSTESTCD == "HEIGHT")} +selects the observations with \code{VSTESTCD == "HEIGHT"} from the input data +(\code{dataset} and \code{dataset_add}), sets \code{PARAMCD = "HGHT"} for these +observations, and adds them to the observations to consider. + +Unnamed elements in the list of expressions are considered as parameter +codes. For example, \code{parameters = exprs(WEIGHT, HGHT = VSTESTCD == "HEIGHT")} uses the parameter code \code{"WEIGHT"} and creates a temporary +parameter code \code{"HGHT"}. + +\emph{Permitted Values:} A character vector of \code{PARAMCD} values or a list of expressions} + +\item{analysis_var}{Analysis variable + +The specified variable is set to the value of \code{analysis_value} for the new +observations. + +\emph{Permitted Values}: An unquoted symbol} \item{analysis_value}{Definition of the analysis value An expression defining the analysis value (\code{AVAL}) of the new parameter is -expected. The analysis values of the parameters specified by \code{parameters} -can be accessed using \verb{AVAL.}, e.g., \code{AVAL.SYSBP}. +expected. The values of variables of the parameters specified by +\code{parameters} can be accessed using \verb{.}, +e.g., \code{AVAL.SYSBP}. + +Variable names in the expression must not contain more than one dot. \emph{Permitted Values:} An unquoted expression} @@ -80,7 +116,19 @@ For example if BMI should be derived and height is measured only once while weight is measured at each visit. Height could be specified in the \code{constant_parameters} parameter. (Refer to Example 2) -\emph{Permitted Values:} A character vector of \code{PARAMCD} values} +If observations should be considered which do not have a parameter code, +e.g., if an SDTM dataset is used, temporary parameter codes can be derived +by specifying a list of expressions. The name of the element defines the +temporary parameter code and the expression the condition for selecting the +records. For example \code{constant_parameters = exprs(HGHT = VSTESTCD == "HEIGHT")} selects the observations with \code{VSTESTCD == "HEIGHT"} from the +input data (\code{dataset} and \code{dataset_add}), sets \code{PARAMCD = "HGHT"} for these +observations, and adds them to the observations to consider. + +Unnamed elements in the list of expressions are considered as parameter +codes. For example, \code{constant_parameters = exprs(WEIGHT, HGHT = VSTESTCD == "HEIGHT")} uses the parameter code \code{"WEIGHT"} and creates a temporary +parameter code \code{"HGHT"}. + +\emph{Permitted Values:} A character vector of \code{PARAMCD} values or a list of expressions} } \value{ The input dataset with the new parameter added. Note, a variable will only @@ -97,8 +145,9 @@ blood pressure (DIABP) with the formula \details{ For each group (with respect to the variables specified for the \code{by_vars} parameter) an observation is added to the output dataset if the -filtered input dataset contains exactly one observation for each parameter -code specified for \code{parameters}. +filtered input dataset (\code{dataset}) or the additional dataset +(\code{dataset_add}) contains exactly one observation for each parameter code +specified for \code{parameters}. For the new observations \code{AVAL} is set to the value specified by \code{analysis_value} and the variables specified for \code{set_values_to} are set to @@ -110,15 +159,15 @@ library(tibble) # Example 1: Derive MAP 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", - "01-701-1015", "SYSBP", "Systolic Blood Pressure (mmHg)", 121, "mmHg", "BASELINE", - "01-701-1015", "SYSBP", "Systolic Blood Pressure (mmHg)", 121, "mmHg", "WEEK 2", - "01-701-1028", "DIABP", "Diastolic Blood Pressure (mmHg)", 79, "mmHg", "BASELINE", - "01-701-1028", "DIABP", "Diastolic Blood Pressure (mmHg)", 80, "mmHg", "WEEK 2", - "01-701-1028", "SYSBP", "Systolic Blood Pressure (mmHg)", 130, "mmHg", "BASELINE", - "01-701-1028", "SYSBP", "Systolic Blood Pressure (mmHg)", 132, "mmHg", "WEEK 2" + ~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", + "01-701-1015", "SYSBP", "Systolic Blood Pressure (mmHg)", 121, "mmHg", "BASELINE", + "01-701-1015", "SYSBP", "Systolic Blood Pressure (mmHg)", 121, "mmHg", "WEEK 2", + "01-701-1028", "DIABP", "Diastolic Blood Pressure (mmHg)", 79, "mmHg", "BASELINE", + "01-701-1028", "DIABP", "Diastolic Blood Pressure (mmHg)", 80, "mmHg", "WEEK 2", + "01-701-1028", "SYSBP", "Systolic Blood Pressure (mmHg)", 130, "mmHg", "BASELINE", + "01-701-1028", "SYSBP", "Systolic Blood Pressure (mmHg)", 132, "mmHg", "WEEK 2" ) derive_param_computed( @@ -135,15 +184,15 @@ derive_param_computed( # Example 2: Derive BMI where height is measured only once 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", - "01-701-1015", "WEIGHT", "Weight (kg)", 54.4, "kg", "BASELINE", - "01-701-1015", "WEIGHT", "Weight (kg)", 53.1, "kg", "WEEK 2", - "01-701-1028", "HEIGHT", "Height (cm)", 163, "cm", "SCREENING", - "01-701-1028", "WEIGHT", "Weight (kg)", 78.5, "kg", "SCREENING", - "01-701-1028", "WEIGHT", "Weight (kg)", 80.3, "kg", "BASELINE", - "01-701-1028", "WEIGHT", "Weight (kg)", 80.7, "kg", "WEEK 2" + ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, + "01-701-1015", "HEIGHT", "Height (cm)", 147.0, "cm", "SCREENING", + "01-701-1015", "WEIGHT", "Weight (kg)", 54.0, "kg", "SCREENING", + "01-701-1015", "WEIGHT", "Weight (kg)", 54.4, "kg", "BASELINE", + "01-701-1015", "WEIGHT", "Weight (kg)", 53.1, "kg", "WEEK 2", + "01-701-1028", "HEIGHT", "Height (cm)", 163.0, "cm", "SCREENING", + "01-701-1028", "WEIGHT", "Weight (kg)", 78.5, "kg", "SCREENING", + "01-701-1028", "WEIGHT", "Weight (kg)", 80.3, "kg", "BASELINE", + "01-701-1028", "WEIGHT", "Weight (kg)", 80.7, "kg", "WEEK 2" ) derive_param_computed( @@ -159,6 +208,42 @@ derive_param_computed( constant_parameters = c("HEIGHT"), constant_by_vars = exprs(USUBJID) ) + +# Example 3: Using data from an additional dataset and other variables than AVAL +qs <- tibble::tribble( + ~USUBJID, ~AVISIT, ~QSTESTCD, ~QSORRES, ~QSSTRESN, + "1", "WEEK 2", "CHSF112", NA, 1, + "1", "WEEK 2", "CHSF113", "Yes", NA, + "1", "WEEK 2", "CHSF114", NA, 1, + "1", "WEEK 4", "CHSF112", NA, 2, + "1", "WEEK 4", "CHSF113", "No", NA, + "1", "WEEK 4", "CHSF114", NA, 1 +) + +adchsf <- tibble::tribble( + ~USUBJID, ~AVISIT, ~PARAMCD, ~QSORRES, ~QSSTRESN, ~AVAL, + "1", "WEEK 2", "CHSF12", NA, 1, 6, + "1", "WEEK 2", "CHSF14", NA, 1, 6, + "1", "WEEK 4", "CHSF12", NA, 2, 12, + "1", "WEEK 4", "CHSF14", NA, 1, 6 +) + +derive_param_computed( + adchsf, + dataset_add = qs, + by_vars = exprs(USUBJID, AVISIT), + parameters = exprs(CHSF12, CHSF13 = QSTESTCD \%in\% c("CHSF113", "CHSF213"), CHSF14), + analysis_value = case_when( + QSORRES.CHSF13 == "Not applicable" ~ 0, + QSORRES.CHSF13 == "Yes" ~ 38, + QSORRES.CHSF13 == "No" ~ if_else( + QSSTRESN.CHSF12 > QSSTRESN.CHSF14, + 25, + 0 + ) + ), + set_values_to = exprs(PARAMCD = "CHSF13") +) } \seealso{ BDS-Findings Functions for adding Parameters/Records: @@ -172,7 +257,7 @@ BDS-Findings Functions for adding Parameters/Records: \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_extreme_record}()}, \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 0014ae832f..cf6bee3633 100644 --- a/man/derive_param_doseint.Rd +++ b/man/derive_param_doseint.Rd @@ -97,8 +97,9 @@ be populated in the new parameter rows if it is specified in \code{by_vars}. \description{ Adds a record for the dose intensity for each by group (e.g., subject and visit) where the source parameters are available. -} -\details{ + +\strong{Note:} This is a wrapper function for the more generic \code{derive_param_computed()}. + The analysis value of the new parameter is derived as Total Dose / Planned Dose * 100 } @@ -147,7 +148,7 @@ BDS-Findings Functions for adding Parameters/Records: \code{\link{derive_param_computed}()}, \code{\link{derive_param_exist_flag}()}, \code{\link{derive_param_exposure}()}, -\code{\link{derive_param_extreme_event}()}, +\code{\link{derive_param_extreme_record}()}, \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 8b2758d0cd..6866626294 100644 --- a/man/derive_param_exist_flag.Rd +++ b/man/derive_param_exist_flag.Rd @@ -6,34 +6,36 @@ \usage{ derive_param_exist_flag( dataset = NULL, - dataset_adsl, + dataset_ref, dataset_add, condition, true_value = "Y", false_value = NA_character_, missing_value = NA_character_, filter_add = NULL, - aval_fun = yn_to_numeric, - subject_keys = get_admiral_option("subject_keys"), - set_values_to + aval_fun, + by_vars = get_admiral_option("subject_keys"), + set_values_to, + dataset_adsl, + subject_keys ) } \arguments{ \item{dataset}{Input dataset -The variables specified for \code{subject_keys} and the \code{PARAMCD} variable are +The variables specified for \code{by_vars} and the \code{PARAMCD} variable are expected.} -\item{dataset_adsl}{ADSL input dataset +\item{dataset_ref}{Reference dataset, e.g., ADSL -The variables specified for \code{subject_keys} are expected. For each subject -(as defined by \code{subject_keys}) from the specified dataset (\code{dataset_adsl}), +The variables specified in \code{by_vars} are expected. For each group +(as defined by \code{by_vars}) from the specified dataset (\code{dataset_ref}), the existence flag is calculated and added as a new observation to the -input datasets (\code{dataset})} +input datasets (\code{dataset}).} \item{dataset_add}{Additional dataset -The variables specified by the \code{subject_keys} parameter are expected. +The variables specified by the \code{by_vars} parameter are expected. This dataset is used to check if an event occurred or not. Any observation in the dataset fulfilling the event condition (\code{condition}) is considered @@ -43,18 +45,18 @@ as an event.} The condition is evaluated at the additional dataset (\code{dataset_add}). -For all subjects where it evaluates as \code{TRUE} at least once \code{AVALC} is set +For all groups where it evaluates as \code{TRUE} at least once \code{AVALC} is set to the true value (\code{true_value}) for the new observations. -For all subjects where it evaluates as \code{FALSE} or \code{NA} for all observations +For all groups where it evaluates as \code{FALSE} or \code{NA} for all observations \code{AVALC} is set to the false value (\code{false_value}). -For all subjects not present in the additional dataset \code{AVALC} is set to +For all groups not present in the additional dataset \code{AVALC} is set to the missing value (\code{missing_value}).} \item{true_value}{True value -For all subjects with at least one observations in the additional dataset +For all groups with at least one observations in the additional dataset (\code{dataset_add}) fulfilling the event condition (\code{condition}), \code{AVALC} is set to the specified value (\code{true_value}). @@ -64,7 +66,7 @@ set to the specified value (\code{true_value}). \item{false_value}{False value -For all subjects with at least one observations in the additional dataset +For all groups with at least one observations in the additional dataset (\code{dataset_add}) but none of them is fulfilling the event condition (\code{condition}), \code{AVALC} is set to the specified value (\code{false_value}). @@ -74,7 +76,7 @@ For all subjects with at least one observations in the additional dataset \item{missing_value}{Values used for missing information -For all subjects without an observation in the additional dataset +For all groups without an observation in the additional dataset (\code{dataset_add}), \code{AVALC} is set to the specified value (\code{missing_value}). \emph{Default}: \code{NA_character_} @@ -92,12 +94,9 @@ considered. \item{aval_fun}{Function to map character analysis value (\code{AVALC}) to numeric analysis value (\code{AVAL}) -The (first) argument of the function must expect a character vector and the -function must return a numeric vector. - -\emph{Default:} \code{yn_to_numeric} (see \code{yn_to_numeric()} for details)} +\emph{Deprecated}, please use \code{set_values_to} instead.} -\item{subject_keys}{Variables to uniquely identify a subject +\item{by_vars}{Variables to uniquely identify a group A list of symbols created using \code{exprs()} is expected.} @@ -105,12 +104,16 @@ A list of symbols created using \code{exprs()} is expected.} A named list returned by \code{exprs()} defining the variables to be set for the new parameter, e.g. \code{exprs(PARAMCD = "MDIS", PARAM = "Measurable Disease at Baseline")} is expected. The values must be symbols, character strings, -numeric values, or \code{NA}.} +numeric values, \code{NA}, or expressions.} + +\item{dataset_adsl}{\emph{Deprecated}, please use \code{dataset_ref} instead.} + +\item{subject_keys}{\emph{Deprecated}, please use \code{by_vars} instead.} } \value{ The input dataset with a new parameter indicating if an event -occurred (\code{AVALC}, \code{AVAL}, and the variables specified by \code{subject_keys} -and \code{set_value_to} are populated for the new parameter) +occurred (\code{AVALC} and the variables specified by \code{by_vars} +and \code{set_value_to} are populated for the new parameter). } \description{ Add a new parameter indicating that a certain event exists in a dataset. @@ -122,18 +125,17 @@ baseline. \enumerate{ \item The additional dataset (\code{dataset_add}) is restricted to the observations matching the \code{filter_add} condition. -\item For each subject in \code{dataset_adsl} a new observation is created. +\item For each group in \code{dataset_ref} a new observation is created. \itemize{ \item The \code{AVALC} variable is added and set to the true value (\code{true_value}) -if for the subject at least one observation exists in the (restricted) +if for the group at least one observation exists in the (restricted) additional dataset where the condition evaluates to \code{TRUE}. -\item It is set to the false value (\code{false_value}) if for the subject at least +\item It is set to the false value (\code{false_value}) if for the group at least one observation exists and for all observations the condition evaluates to \code{FALSE} or \code{NA}. \item Otherwise, it is set to the missing value (\code{missing_value}), i.e., for -those subject not in \code{dataset_add}. +those groups not in \code{dataset_add}. } -\item The \code{AVAL} variable is added and set to \code{aval_fun(AVALC)}. \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. @@ -168,13 +170,14 @@ tu <- tribble( ) derive_param_exist_flag( - dataset_adsl = adsl, + dataset_ref = adsl, dataset_add = tu, filter_add = TUTESTCD == "TUMIDENT" & VISIT == "SCREENING", condition = TUSTRESC == "TARGET", false_value = "N", missing_value = "N", set_values_to = exprs( + AVAL = yn_to_numeric(AVALC), PARAMCD = "MDIS", PARAM = "Measurable Disease at Baseline" ) @@ -192,7 +195,7 @@ BDS-Findings Functions for adding Parameters/Records: \code{\link{derive_param_computed}()}, \code{\link{derive_param_doseint}()}, \code{\link{derive_param_exposure}()}, -\code{\link{derive_param_extreme_event}()}, +\code{\link{derive_param_extreme_record}()}, \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 84b57e1c33..5f0d4fd0be 100644 --- a/man/derive_param_exposure.Rd +++ b/man/derive_param_exposure.Rd @@ -58,9 +58,8 @@ Set a list of variables to some specified value for the new observation(s) \itemize{ \item LHS refer to a variable. It is expected that at least \code{PARAMCD} is defined. \item RHS refers to the values to set to the variable. This can be a string, a symbol, a numeric -value or NA. +value, \code{NA}, or an expression. (e.g. \code{exprs(PARAMCD = "TDOSE",PARCAT1 = "OVERALL")}). -More general expression are not allowed. } \emph{Permitted Values:} List of variable-value pairs} @@ -160,7 +159,7 @@ BDS-Findings Functions for adding Parameters/Records: \code{\link{derive_param_computed}()}, \code{\link{derive_param_doseint}()}, \code{\link{derive_param_exist_flag}()}, -\code{\link{derive_param_extreme_event}()}, +\code{\link{derive_param_extreme_record}()}, \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 index 223b5cbf0a..93e27a9b9b 100644 --- a/man/derive_param_extreme_event.Rd +++ b/man/derive_param_extreme_event.Rd @@ -36,7 +36,7 @@ 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.} +\code{order} argument (if applicable) are expected.} \item{filter_source}{Source filter @@ -51,8 +51,8 @@ For all other subjects \code{new_var} is set to \code{false_value}.} 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{exprs()}, e.g., \code{exprs(ADT, desc(AVAL))}.} +\emph{Permitted Values}: list of expressions created by \code{exprs()}, e.g., +\code{exprs(ADT, desc(AVAL))}.} \item{new_var}{New variable @@ -85,15 +85,15 @@ A list of symbols created using \code{exprs()} is expected.} A named list returned by \code{exprs()} defining the variables to be set for the new parameter, e.g. \code{exprs(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.} +\code{NA}, or an expression. 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). +observations of the source dataset (\code{dataset_source}) restricted by +\code{filter_source} are not unique with respect to the subject keys +(\code{subject_key} argument) and \code{order}. \emph{Permitted Values}: \code{"none"}, \code{"warning"}, \code{"error"}} } @@ -102,116 +102,49 @@ The input dataset with a new parameter indicating if and when an event occurred } \description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} + +This function is \emph{deprecated}, please use \code{derive_extreme_records()} instead. + 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. +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 +\code{subject_keys} argument) 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. +if applicable) where the event condition (\code{filter_source} argument) 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_value}. For all other subjects \code{new_var} is set to \code{false_value}. 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 +\item The variables specified by the \code{set_values_to} argument 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 = exprs(ADT), - new_var = AVALC, - true_value = "Y", - false_value = "N", - mode = "first", - set_values_to = exprs( - 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 = exprs( - PARAMCD = "DEATH", - PARAM = "Death", - ANL01FL = "Y", - ADT = DTHDT - ) -) -} \seealso{ -BDS-Findings Functions for adding Parameters/Records: -\code{\link{default_qtc_paramcd}()}, -\code{\link{derive_expected_records}()}, -\code{\link{derive_extreme_event}()}, -\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}()} +Other deprecated: +\code{\link{derive_var_basetype}()}, +\code{\link{derive_var_confirmation_flag}()}, +\code{\link{derive_var_disposition_status}()}, +\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_worst_flag}()}, +\code{\link{derive_vars_disposition_reason}()}, +\code{\link{derive_vars_last_dose}()}, +\code{\link{format_eoxxstt_default}()}, +\code{\link{format_reason_default}()} } -\concept{der_prm_bds_findings} -\keyword{der_prm_bds_findings} +\concept{deprecated} +\keyword{deprecated} diff --git a/man/derive_param_extreme_record.Rd b/man/derive_param_extreme_record.Rd new file mode 100644 index 0000000000..6660b91d3f --- /dev/null +++ b/man/derive_param_extreme_record.Rd @@ -0,0 +1,162 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/derive_param_extreme_record.R +\name{derive_param_extreme_record} +\alias{derive_param_extreme_record} +\title{Adds a Parameter Based on First or Last Record from Multiple Sources} +\usage{ +derive_param_extreme_record( + dataset = NULL, + sources, + source_datasets, + by_vars = NULL, + order, + mode, + set_values_to +) +} +\arguments{ +\item{dataset}{Input dataset} + +\item{sources}{Sources + +A list of \code{records_source()} objects is expected.} + +\item{source_datasets}{Source datasets + +A named list of datasets is expected. The \code{dataset_name} field of +\code{records_source()} refers to the dataset provided in the list. The variables +specified by the \code{order} and the \code{by_vars} arguments are expected after applying \code{new_vars}.} + +\item{by_vars}{By variables + +If the argument is specified, for each by group the observations are +selected separately.} + +\item{order}{Sort order + +If the argument is set to a non-null value, for each by group the first or +last observation from the source datasets is selected with respect to +the specified order. Variables created via \code{new_vars} e.g., imputed date variables, +can be specified as well (see examples below). + +Please note that \code{NA} is considered as the last value. I.e., if a order +variable is \code{NA} and \code{mode = "last"}, this observation is chosen while for +\code{mode = "first"} the observation is chosen only if there are no +observations where the variable is not \code{NA}. + +\emph{Permitted Values:} list of expressions created by \code{exprs()}, e.g., +\code{exprs(ADT, desc(AVAL))}} + +\item{mode}{Selection mode (first or last) + +If \code{"first"} is specified, for each by group the first observation with +respect to \code{order} is included in the output dataset. If \code{"last"} is +specified, the last observation is included in the output dataset. + +Permitted Values: \code{"first"}, \code{"last"}} + +\item{set_values_to}{Variables to be set + +The specified variables are set to the specified values for the new +observations. + +A list of variable name-value pairs is expected. +\itemize{ +\item LHS refers to a variable. +\item RHS refers to the values to set to the variable. This can be a string, a +symbol, a numeric value or \code{NA}, e.g., \code{exprs(PARAMCD = "PD", PARAM = "First Progressive Disease")}. +}} +} +\value{ +The input dataset with the first or last observation of each by group +added as new observations. +} +\description{ +Generates parameter based on the first or last observation from multiple +source datasets, based on user-defined filter, order and by group criteria. +All variables of the selected observation are kept. +} +\details{ +The following steps are performed to create the output dataset: + +\enumerate{ +\item For each source dataset the observations as specified by +the \code{filter} element are selected. + +\item Variables specified by \code{new_vars} are created for each source dataset. + +\item The first or last observation (with respect to the +\code{order} variable) for each by group (specified by \code{by_vars}) from multiple sources +is selected and added to the input dataset. } +} +\examples{ +aevent_samp <- tibble::tribble( + ~USUBJID, ~PARAMCD, ~PARAM, ~RSSTDTC, + "1", "PD", "First Progressive Disease", "2022-04-01", + "2", "PD", "First Progressive Disease", "2021-04-01", + "3", "PD", "First Progressive Disease", "2023-04-01" +) + +cm <- tibble::tribble( + ~STUDYID, ~USUBJID, ~CMDECOD, ~CMSTDTC, + "1001", "1", "ACT", "2021-12-25" +) + +pr <- tibble::tribble( + ~STUDYID, ~USUBJID, ~PRDECOD, ~PRSTDTC, + "1001", "1", "ACS", "2021-12-27", + "1001", "2", "ACS", "2020-12-25", + "1001", "3", "ACS", "2022-12-25", +) +derive_param_extreme_record( + dataset = aevent_samp, + sources = list( + records_source( + dataset_name = "cm", + filter = CMDECOD == "ACT", + new_vars = exprs( + ADT = convert_dtc_to_dt(CMSTDTC), + AVALC = CMDECOD + ) + ), + records_source( + dataset_name = "pr", + filter = PRDECOD == "ACS", + new_vars = exprs( + ADT = convert_dtc_to_dt(PRSTDTC), + AVALC = PRDECOD + ) + ) + ), + source_datasets = list(cm = cm, pr = pr), + by_vars = exprs(USUBJID), + order = exprs(ADT), + mode = "first", + set_values_to = exprs( + PARAMCD = "FIRSTACT", + PARAM = "First Anti-Cancer Therapy" + ) +) +} +\seealso{ +BDS-Findings Functions for adding Parameters/Records: +\code{\link{default_qtc_paramcd}()}, +\code{\link{derive_expected_records}()}, +\code{\link{derive_extreme_event}()}, +\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}()} +} +\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 deleted file mode 100644 index d62dff921e..0000000000 --- a/man/derive_param_first_event.Rd +++ /dev/null @@ -1,119 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% 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} -\usage{ -derive_param_first_event( - dataset, - dataset_adsl, - dataset_source, - filter_source, - date_var, - subject_keys = exprs(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 event. - -The variables specified by the \code{subject_keys} and -\code{date_var} parameter are expected.} - -\item{filter_source}{Source filter - -All observations in \code{dataset_source} fulfilling the specified condition are -considered as event. - -For subjects with at least one event \code{AVALC} is set to \code{"Y"}, \code{AVAL} to -\code{1}, and \code{ADT} to the first date where the condition is fulfilled. - -For all other subjects \code{AVALC} is set to \code{"N"}, \code{AVAL} to \code{0}, and \code{ADT} to -\code{NA}.} - -\item{date_var}{Date variable - -Date variable in the source dataset (\code{dataset_source}). The variable is -used to sort the source dataset. \code{ADT} is set to the specified variable for -events.} - -\item{subject_keys}{Variables to uniquely identify a subject - -A list of symbols created using \code{exprs()} is expected.} - -\item{set_values_to}{Variables to set - -A named list returned by \code{exprs()} defining the variables to be set for the -new parameter, e.g. \code{exprs(PARAMCD = "PD", PARAM = "Disease Progression")} -is expected. The values must be symbols, character strings, numeric values, -or \code{NA}.} - -\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 \code{ADT}. - -\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{ -\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{ -\item The input dataset is restricted to observations fulfilling -\code{filter_source}. -\item For each subject (with respect to the variables specified for the -\code{subject_keys} parameter) the first observation (with respect to -\code{date_var}) where the event condition (\code{filter_source} parameter) is -fulfilled is selected. -\item For each observation in \code{dataset_adsl} a new observation is created. For -subjects with event \code{AVALC} is set to \code{"Y"}, \code{AVAL} to \code{1}, and \code{ADT} to -the first date where the event condition is fulfilled. For all other -subjects \code{AVALC} is set to \code{"N"}, \code{AVAL} to \code{0}, and \code{ADT} to \code{NA}. -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. -} -} -\seealso{ -Other deprecated: -\code{\link{derive_derived_param}()}, -\code{\link{derive_var_agegr_fda}()}, -\code{\link{derive_var_confirmation_flag}()}, -\code{\link{derive_var_disposition_status}()}, -\code{\link{derive_var_worst_flag}()}, -\code{\link{derive_vars_disposition_reason}()}, -\code{\link{derive_vars_merged_dtm}()}, -\code{\link{derive_vars_merged_dt}()}, -\code{\link{filter_confirmation}()}, -\code{\link{format_eoxxstt_default}()}, -\code{\link{format_reason_default}()}, -\code{\link{vars}()} -} -\concept{deprecated} -\keyword{deprecated} diff --git a/man/derive_param_framingham.Rd b/man/derive_param_framingham.Rd index f304600933..38058e9fa0 100644 --- a/man/derive_param_framingham.Rd +++ b/man/derive_param_framingham.Rd @@ -34,11 +34,10 @@ and \code{hdl_code}.} \item{by_vars}{Grouping variables -For each group defined by \code{by_vars} an observation is added to the output -dataset. Only variables specified in \code{by_vars} will be populated +Only variables specified in \code{by_vars} will be populated in the newly created records. -\emph{Permitted Values:} list of variables} +Permitted Values: list of variables} \item{set_values_to}{Variables to be set @@ -245,7 +244,7 @@ BDS-Findings Functions for adding Parameters/Records: \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_extreme_record}()}, \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 99a47b047d..f019558f0e 100644 --- a/man/derive_param_map.Rd +++ b/man/derive_param_map.Rd @@ -84,6 +84,8 @@ be populated in the new parameter rows if it is specified in \code{by_vars}. \description{ Adds a record for mean arterial pressure (MAP) for each by group (e.g., subject and visit) where the source parameters are available. + +\strong{Note:} This is a wrapper function for the more generic \code{derive_param_computed()}. } \details{ The analysis value of the new parameter is derived as @@ -150,7 +152,7 @@ BDS-Findings Functions for adding Parameters/Records: \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_extreme_record}()}, \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 ee9f44e6eb..73d8d22986 100644 --- a/man/derive_param_qtc.Rd +++ b/man/derive_param_qtc.Rd @@ -80,6 +80,8 @@ be populated in the new parameter rows if it is specified in \code{by_vars}. Adds a record for corrected QT using either Bazett's, Fridericia's or Sagie's formula for each by group (e.g., subject and visit) where the source parameters are available. + +\strong{Note:} This is a wrapper function for the more generic \code{derive_param_computed()}. } \examples{ library(tibble) @@ -148,7 +150,7 @@ BDS-Findings Functions for adding Parameters/Records: \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_extreme_record}()}, \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 24053aae82..1bb8e0642a 100644 --- a/man/derive_param_rr.Rd +++ b/man/derive_param_rr.Rd @@ -67,8 +67,9 @@ be populated in the new parameter rows if it is specified in \code{by_vars}. \description{ Adds a record for derived RR based on heart rate for each by group (e.g., subject and visit) where the source parameters are available. -} -\details{ + +\strong{Note:} This is a wrapper function for the more generic \code{derive_param_computed()}. + The analysis value of the new parameter is derived as \deqn{\frac{60000}{HR}}{60000 / HR} } @@ -112,7 +113,7 @@ BDS-Findings Functions for adding Parameters/Records: \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_extreme_record}()}, \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 3d5ac7dd61..8edb228af9 100644 --- a/man/derive_param_tte.Rd +++ b/man/derive_param_tte.Rd @@ -331,5 +331,8 @@ derive_param_tte( ) \%>\% select(USUBJID, STARTDT, PARAMCD, PARAM, ADT, CNSR, SRCSEQ) } +\seealso{ +\code{\link[=event_source]{event_source()}}, \code{\link[=censor_source]{censor_source()}} +} \concept{der_prm_tte} \keyword{der_prm_tte} diff --git a/man/derive_param_wbc_abs.Rd b/man/derive_param_wbc_abs.Rd index 1786b740b8..e2278299b9 100644 --- a/man/derive_param_wbc_abs.Rd +++ b/man/derive_param_wbc_abs.Rd @@ -126,7 +126,7 @@ BDS-Findings Functions for adding Parameters/Records: \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_extreme_record}()}, \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 5d8cdfe6fb..05281d4767 100644 --- a/man/derive_summary_records.Rd +++ b/man/derive_summary_records.Rd @@ -49,7 +49,7 @@ A list of variable name-value pairs is expected. \itemize{ \item LHS refers to a variable. \item RHS refers to the values to set to the variable. This can be a string, a -symbol, a numeric value or \code{NA}, e.g., \code{exprs(PARAMCD = "TDOSE", PARCAT1 = "OVERALL")}. More general expression are not allowed. +symbol, a numeric value, an expression, or \code{NA}, e.g., \code{exprs(PARAMCD = "TDOSE", PARCAT1 = "OVERALL")}. }} } \value{ @@ -172,7 +172,7 @@ BDS-Findings Functions for adding Parameters/Records: \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_extreme_record}()}, \code{\link{derive_param_framingham}()}, \code{\link{derive_param_map}()}, \code{\link{derive_param_qtc}()}, diff --git a/man/derive_var_age_years.Rd b/man/derive_var_age_years.Rd index e35d0f4e41..cee141541c 100644 --- a/man/derive_var_age_years.Rd +++ b/man/derive_var_age_years.Rd @@ -78,8 +78,5 @@ ADSL Functions that returns variable appended to dataset: \code{\link{derive_vars_aage}()}, \code{\link{derive_vars_period}()} } -\author{ -Michael Thorpe -} \concept{der_adsl} \keyword{der_adsl} diff --git a/man/derive_var_agegr_fda.Rd b/man/derive_var_agegr_fda.Rd deleted file mode 100644 index 56100515a5..0000000000 --- a/man/derive_var_agegr_fda.Rd +++ /dev/null @@ -1,74 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/derive_vars_aage.R -\name{derive_var_agegr_fda} -\alias{derive_var_agegr_fda} -\alias{derive_var_agegr_ema} -\title{Derive Age Groups} -\usage{ -derive_var_agegr_fda(dataset, age_var, age_unit = NULL, new_var) - -derive_var_agegr_ema(dataset, age_var, age_unit = NULL, new_var) -} -\arguments{ -\item{dataset}{Input dataset} - -\item{age_var}{AGE variable} - -\item{age_unit}{AGE unit variable} - -\item{new_var}{New variable to create inside \code{dataset}} -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} - -This function is \emph{deprecated}, please create a user defined function instead. - -\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 create a user defined function instead. -} -\seealso{ -Other deprecated: -\code{\link{derive_derived_param}()}, -\code{\link{derive_param_first_event}()}, -\code{\link{derive_var_confirmation_flag}()}, -\code{\link{derive_var_disposition_status}()}, -\code{\link{derive_var_worst_flag}()}, -\code{\link{derive_vars_disposition_reason}()}, -\code{\link{derive_vars_merged_dtm}()}, -\code{\link{derive_vars_merged_dt}()}, -\code{\link{filter_confirmation}()}, -\code{\link{format_eoxxstt_default}()}, -\code{\link{format_reason_default}()}, -\code{\link{vars}()} - -Other deprecated: -\code{\link{derive_derived_param}()}, -\code{\link{derive_param_first_event}()}, -\code{\link{derive_var_confirmation_flag}()}, -\code{\link{derive_var_disposition_status}()}, -\code{\link{derive_var_worst_flag}()}, -\code{\link{derive_vars_disposition_reason}()}, -\code{\link{derive_vars_merged_dtm}()}, -\code{\link{derive_vars_merged_dt}()}, -\code{\link{filter_confirmation}()}, -\code{\link{format_eoxxstt_default}()}, -\code{\link{format_reason_default}()}, -\code{\link{vars}()} - -Other deprecated: -\code{\link{derive_derived_param}()}, -\code{\link{derive_param_first_event}()}, -\code{\link{derive_var_confirmation_flag}()}, -\code{\link{derive_var_disposition_status}()}, -\code{\link{derive_var_worst_flag}()}, -\code{\link{derive_vars_disposition_reason}()}, -\code{\link{derive_vars_merged_dtm}()}, -\code{\link{derive_vars_merged_dt}()}, -\code{\link{filter_confirmation}()}, -\code{\link{format_eoxxstt_default}()}, -\code{\link{format_reason_default}()}, -\code{\link{vars}()} -} -\concept{deprecated} -\keyword{deprecated} diff --git a/man/derive_var_analysis_ratio.Rd b/man/derive_var_analysis_ratio.Rd index f69b4b927e..6272963e46 100644 --- a/man/derive_var_analysis_ratio.Rd +++ b/man/derive_var_analysis_ratio.Rd @@ -67,10 +67,10 @@ data \%>\% } \seealso{ BDS-Findings Functions that returns variable appended to dataset: +\code{\link{derive_basetype_records}()}, \code{\link{derive_var_anrind}()}, \code{\link{derive_var_atoxgr_dir}()}, \code{\link{derive_var_atoxgr}()}, -\code{\link{derive_var_basetype}()}, \code{\link{derive_var_base}()}, \code{\link{derive_var_chg}()}, \code{\link{derive_var_ontrtfl}()}, diff --git a/man/derive_var_anrind.Rd b/man/derive_var_anrind.Rd index f6b69d38dc..6329f74bc4 100644 --- a/man/derive_var_anrind.Rd +++ b/man/derive_var_anrind.Rd @@ -4,10 +4,13 @@ \alias{derive_var_anrind} \title{Derive Reference Range Indicator} \usage{ -derive_var_anrind(dataset) +derive_var_anrind(dataset, use_a1hia1lo = FALSE) } \arguments{ \item{dataset}{The input dataset} + +\item{use_a1hia1lo}{A logical value indicating whether to use \code{A1H1} and \code{A1LO} in +the derivation of \code{ANRIND}.} } \value{ The input dataset with additional column \code{ANRIND} @@ -16,7 +19,7 @@ The input dataset with additional column \code{ANRIND} Derive Reference Range Indicator } \details{ -\code{ANRIND} is set to +In the case that \code{A1H1} and \code{A1LO} are to be used, \code{ANRIND} is set to: \itemize{ \item \code{"NORMAL"} if \code{AVAL} is greater or equal \code{ANRLO} and less than or equal \code{ANRHI}; or if \code{AVAL} is greater than or equal \code{ANRLO} and \code{ANRHI} @@ -29,35 +32,44 @@ is less than or equal \code{A1HI} \item \code{"LOW LOW"} if \code{AVAL} is less than \code{A1LO} \item \code{"HIGH HIGH"} if \code{AVAL} is greater than \code{A1HI} } + +In the case that \code{A1H1} and \code{A1LO} are not to be used, \code{ANRIND} is set to: +\itemize{ +\item \code{"NORMAL"} if \code{AVAL} is greater or equal \code{ANRLO} and less than +or equal \code{ANRHI}; or if \code{AVAL} is greater than or equal \code{ANRLO} and \code{ANRHI} +is missing; or if \code{AVAL} is less than or equal \code{ANRHI} and \code{ANRLO} is +missing +\item \code{"LOW"} if \code{AVAL} is less than \code{ANRLO} +\item \code{"HIGH"} if \code{AVAL} is greater than \code{ANRHI} +} } \examples{ library(tibble) library(dplyr, warn.conflicts = FALSE) -library(admiral.test) -data(admiral_vs) -ref_ranges <- tribble( - ~PARAMCD, ~ANRLO, ~ANRHI, ~A1LO, ~A1HI, - "DIABP", 60, 80, 40, 90, - "PULSE", 60, 100, 40, 110 +vs <- tibble::tribble( + ~USUBJID, ~PARAMCD, ~AVAL, ~ANRLO, ~ANRHI, ~A1LO, ~A1HI, + "P01", "PUL", 70, 60, 100, 40, 110, + "P01", "PUL", 57, 60, 100, 40, 110, + "P01", "PUL", 60, 60, 100, 40, 110, + "P01", "DIABP", 102, 60, 80, 40, 90, + "P02", "PUL", 109, 60, 100, 40, 110, + "P02", "PUL", 100, 60, 100, 40, 110, + "P02", "DIABP", 80, 60, 80, 40, 90, + "P03", "PUL", 39, 60, 100, 40, 110, + "P03", "PUL", 40, 60, 100, 40, 110 ) -admiral_vs \%>\% - mutate( - PARAMCD = VSTESTCD, - AVAL = VSSTRESN - ) \%>\% - filter(PARAMCD \%in\% c("PULSE", "DIABP")) \%>\% - derive_vars_merged(ref_ranges, by_vars = exprs(PARAMCD)) \%>\% - derive_var_anrind() \%>\% - select(USUBJID, PARAMCD, AVAL, ANRLO:ANRIND) +vs \%>\% derive_var_anrind(use_a1hia1lo = TRUE) +vs \%>\% derive_var_anrind(use_a1hia1lo = FALSE) + } \seealso{ BDS-Findings Functions that returns variable appended to dataset: +\code{\link{derive_basetype_records}()}, \code{\link{derive_var_analysis_ratio}()}, \code{\link{derive_var_atoxgr_dir}()}, \code{\link{derive_var_atoxgr}()}, -\code{\link{derive_var_basetype}()}, \code{\link{derive_var_base}()}, \code{\link{derive_var_chg}()}, \code{\link{derive_var_ontrtfl}()}, diff --git a/man/derive_var_atoxgr.Rd b/man/derive_var_atoxgr.Rd index 3a03402d13..9214320e7e 100644 --- a/man/derive_var_atoxgr.Rd +++ b/man/derive_var_atoxgr.Rd @@ -60,10 +60,10 @@ derive_var_atoxgr(adlb) } \seealso{ BDS-Findings Functions that returns variable appended to dataset: +\code{\link{derive_basetype_records}()}, \code{\link{derive_var_analysis_ratio}()}, \code{\link{derive_var_anrind}()}, \code{\link{derive_var_atoxgr_dir}()}, -\code{\link{derive_var_basetype}()}, \code{\link{derive_var_base}()}, \code{\link{derive_var_chg}()}, \code{\link{derive_var_ontrtfl}()}, diff --git a/man/derive_var_atoxgr_dir.Rd b/man/derive_var_atoxgr_dir.Rd index f57665e4bd..69daadaf2f 100644 --- a/man/derive_var_atoxgr_dir.Rd +++ b/man/derive_var_atoxgr_dir.Rd @@ -117,10 +117,10 @@ derive_var_atoxgr_dir(data, } \seealso{ BDS-Findings Functions that returns variable appended to dataset: +\code{\link{derive_basetype_records}()}, \code{\link{derive_var_analysis_ratio}()}, \code{\link{derive_var_anrind}()}, \code{\link{derive_var_atoxgr}()}, -\code{\link{derive_var_basetype}()}, \code{\link{derive_var_base}()}, \code{\link{derive_var_chg}()}, \code{\link{derive_var_ontrtfl}()}, diff --git a/man/derive_var_base.Rd b/man/derive_var_base.Rd index f53a46ba1d..807057db36 100644 --- a/man/derive_var_base.Rd +++ b/man/derive_var_base.Rd @@ -31,7 +31,9 @@ A new \code{data.frame} containing all records and variables of the input dataset plus the \code{new_var} variable } \description{ -Derive baseline variables, e.g. \code{BASE} or \code{BNRIND}, in a BDS dataset +Derive baseline variables, e.g. \code{BASE} or \code{BNRIND}, in a BDS dataset. + +\strong{Note:} This is a wrapper function for the more generic \code{derive_vars_merged()}. } \details{ For each \code{by_vars} group, the baseline record is identified by the @@ -85,11 +87,11 @@ derive_var_base( } \seealso{ BDS-Findings Functions that returns variable appended to dataset: +\code{\link{derive_basetype_records}()}, \code{\link{derive_var_analysis_ratio}()}, \code{\link{derive_var_anrind}()}, \code{\link{derive_var_atoxgr_dir}()}, \code{\link{derive_var_atoxgr}()}, -\code{\link{derive_var_basetype}()}, \code{\link{derive_var_chg}()}, \code{\link{derive_var_ontrtfl}()}, \code{\link{derive_var_pchg}()}, diff --git a/man/derive_var_basetype.Rd b/man/derive_var_basetype.Rd index f501c63e1a..ed996203bc 100644 --- a/man/derive_var_basetype.Rd +++ b/man/derive_var_basetype.Rd @@ -21,6 +21,10 @@ and the expressions are used to subset the input dataset.} The input dataset with variable \code{BASETYPE} added } \description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} + +This function is \emph{deprecated}, please use \code{derive_basetype_records()} instead. + Baseline Type \code{BASETYPE} is needed when there is more than one definition of baseline for a given Analysis Parameter \code{PARAM} in the same dataset. For a given parameter, if Baseline Value \code{BASE} is populated, and there is more than @@ -29,85 +33,31 @@ any type for that parameter. Each value of \code{BASETYPE} refers to a definitio baseline that characterizes the value of \code{BASE} on that row. Please see section 4.2.1.6 of the ADaM Implementation Guide, version 1.3 for further background. -} -\details{ + Adds the \code{BASETYPE} variable to a dataset and duplicates records based upon the provided conditions. - +} +\details{ For each element of \code{basetypes} the input dataset is subset based upon the provided expression and the \code{BASETYPE} variable is set to the name of the expression. Then, all subsets are stacked. Records which do not match any condition are kept and \code{BASETYPE} is set to \code{NA}. } -\examples{ -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, - "P01", "DOUBLE-BLIND", "PARAM01", 3, 9.2, - "P01", "DOUBLE-BLIND", "PARAM01", 4, 10.1, - "P01", "OPEN-LABEL", "PARAM01", 5, 10.4, - "P01", "OPEN-LABEL", "PARAM01", 6, 9.9, - "P02", "RUN-IN", "PARAM01", 1, 12.1, - "P02", "DOUBLE-BLIND", "PARAM01", 2, 10.2, - "P02", "DOUBLE-BLIND", "PARAM01", 3, 10.8, - "P02", "OPEN-LABEL", "PARAM01", 4, 11.4, - "P02", "OPEN-LABEL", "PARAM01", 5, 10.8 -) - -bds_with_basetype <- derive_var_basetype( - dataset = bds, - 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" - ) -) - - -# Below print statement will print all 23 records in the data frame -# bds_with_basetype -print(bds_with_basetype, n = Inf) - -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 <- tribble( - ~USUBJID, ~EPOCH, ~PARAMCD, ~ASEQ, ~AVAL, - "P01", "RUN-IN", "PARAM01", 1, 10.0, - "P01", "RUN-IN", "PARAM01", 2, 9.8, - "P01", "DOUBLE-BLIND", "PARAM01", 3, 9.2, - "P01", "DOUBLE-BLIND", "PARAM01", 4, 10.1 -) - -bds_with_basetype <- derive_var_basetype( - dataset = bds, - basetypes = exprs( - "LAST" = TRUE, - "WORST" = TRUE - ) -) - -print(bds_with_basetype, n = Inf) - -count(bds_with_basetype, BASETYPE, name = "Number of Records") -} \seealso{ -BDS-Findings Functions that returns variable appended to dataset: -\code{\link{derive_var_analysis_ratio}()}, -\code{\link{derive_var_anrind}()}, -\code{\link{derive_var_atoxgr_dir}()}, -\code{\link{derive_var_atoxgr}()}, -\code{\link{derive_var_base}()}, -\code{\link{derive_var_chg}()}, -\code{\link{derive_var_ontrtfl}()}, -\code{\link{derive_var_pchg}()}, -\code{\link{derive_var_shift}()} +Other deprecated: +\code{\link{derive_param_extreme_event}()}, +\code{\link{derive_var_confirmation_flag}()}, +\code{\link{derive_var_disposition_status}()}, +\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_worst_flag}()}, +\code{\link{derive_vars_disposition_reason}()}, +\code{\link{derive_vars_last_dose}()}, +\code{\link{format_eoxxstt_default}()}, +\code{\link{format_reason_default}()} } -\concept{der_bds_findings} -\keyword{der_bds_findings} +\concept{deprecated} +\keyword{deprecated} diff --git a/man/derive_var_chg.Rd b/man/derive_var_chg.Rd index 64827cd916..5a0b8de486 100644 --- a/man/derive_var_chg.Rd +++ b/man/derive_var_chg.Rd @@ -35,11 +35,11 @@ derive_var_chg(advs) } \seealso{ BDS-Findings Functions that returns variable appended to dataset: +\code{\link{derive_basetype_records}()}, \code{\link{derive_var_analysis_ratio}()}, \code{\link{derive_var_anrind}()}, \code{\link{derive_var_atoxgr_dir}()}, \code{\link{derive_var_atoxgr}()}, -\code{\link{derive_var_basetype}()}, \code{\link{derive_var_base}()}, \code{\link{derive_var_ontrtfl}()}, \code{\link{derive_var_pchg}()}, diff --git a/man/derive_var_confirmation_flag.Rd b/man/derive_var_confirmation_flag.Rd index 25a92537d3..f45011cee3 100644 --- a/man/derive_var_confirmation_flag.Rd +++ b/man/derive_var_confirmation_flag.Rd @@ -194,18 +194,19 @@ previous step. For the other observations it is set to \code{false_value}. } \seealso{ Other deprecated: -\code{\link{derive_derived_param}()}, -\code{\link{derive_param_first_event}()}, -\code{\link{derive_var_agegr_fda}()}, +\code{\link{derive_param_extreme_event}()}, +\code{\link{derive_var_basetype}()}, \code{\link{derive_var_disposition_status}()}, +\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_worst_flag}()}, \code{\link{derive_vars_disposition_reason}()}, -\code{\link{derive_vars_merged_dtm}()}, -\code{\link{derive_vars_merged_dt}()}, -\code{\link{filter_confirmation}()}, +\code{\link{derive_vars_last_dose}()}, \code{\link{format_eoxxstt_default}()}, -\code{\link{format_reason_default}()}, -\code{\link{vars}()} +\code{\link{format_reason_default}()} } \concept{deprecated} \keyword{deprecated} diff --git a/man/derive_var_disposition_status.Rd b/man/derive_var_disposition_status.Rd index 9ba0256e9c..45644dedec 100644 --- a/man/derive_var_disposition_status.Rd +++ b/man/derive_var_disposition_status.Rd @@ -83,18 +83,19 @@ Derive a disposition status from the the relevant records in the disposition dom } \seealso{ Other deprecated: -\code{\link{derive_derived_param}()}, -\code{\link{derive_param_first_event}()}, -\code{\link{derive_var_agegr_fda}()}, +\code{\link{derive_param_extreme_event}()}, +\code{\link{derive_var_basetype}()}, \code{\link{derive_var_confirmation_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_worst_flag}()}, \code{\link{derive_vars_disposition_reason}()}, -\code{\link{derive_vars_merged_dtm}()}, -\code{\link{derive_vars_merged_dt}()}, -\code{\link{filter_confirmation}()}, +\code{\link{derive_vars_last_dose}()}, \code{\link{format_eoxxstt_default}()}, -\code{\link{format_reason_default}()}, -\code{\link{vars}()} +\code{\link{format_reason_default}()} } \concept{deprecated} \keyword{deprecated} diff --git a/man/derive_var_dthcaus.Rd b/man/derive_var_dthcaus.Rd index 08dc2f8ab7..09ff551c68 100644 --- a/man/derive_var_dthcaus.Rd +++ b/man/derive_var_dthcaus.Rd @@ -42,7 +42,6 @@ the preferred order. \examples{ library(tibble) library(dplyr, warn.conflicts = FALSE) -library(lubridate) adsl <- tribble( ~STUDYID, ~USUBJID, @@ -53,26 +52,21 @@ adsl <- tribble( ae <- tribble( ~STUDYID, ~USUBJID, ~AESEQ, ~AEDECOD, ~AEOUT, ~AEDTHDTC, "STUDY01", "PAT01", 12, "SUDDEN DEATH", "FATAL", "2021-04-04" -) \%>\% - mutate( - AEDTHDT = ymd(AEDTHDTC) - ) +) + ds <- tribble( ~STUDYID, ~USUBJID, ~DSSEQ, ~DSDECOD, ~DSTERM, ~DSSTDTC, "STUDY01", "PAT02", 1, "INFORMED CONSENT OBTAINED", "INFORMED CONSENT OBTAINED", "2021-04-03", "STUDY01", "PAT02", 2, "RANDOMIZATION", "RANDOMIZATION", "2021-04-11", "STUDY01", "PAT02", 3, "DEATH", "DEATH DUE TO PROGRESSION OF DISEASE", "2022-02-01", "STUDY01", "PAT03", 1, "DEATH", "POST STUDY REPORTING OF DEATH", "2022-03-03" -) \%>\% - mutate( - DSSTDT = ymd(DSSTDTC) - ) +) # Derive `DTHCAUS` only - for on-study deaths only src_ae <- dthcaus_source( dataset_name = "ae", filter = AEOUT == "FATAL", - date = AEDTHDT, + date = convert_dtc_to_dt(AEDTHDTC), mode = "first", dthcaus = AEDECOD ) @@ -80,7 +74,7 @@ src_ae <- dthcaus_source( src_ds <- dthcaus_source( dataset_name = "ds", filter = DSDECOD == "DEATH" & grepl("DEATH DUE TO", DSTERM), - date = DSSTDT, + date = convert_dtc_to_dt(DSSTDTC), mode = "first", dthcaus = DSTERM ) @@ -91,7 +85,7 @@ derive_var_dthcaus(adsl, src_ae, src_ds, source_datasets = list(ae = ae, ds = ds src_ae <- dthcaus_source( dataset_name = "ae", filter = AEOUT == "FATAL", - date = AEDTHDT, + date = convert_dtc_to_dt(AEDTHDTC), mode = "first", dthcaus = AEDECOD, traceability_vars = exprs(DTHDOM = "AE", DTHSEQ = AESEQ) @@ -100,7 +94,7 @@ src_ae <- dthcaus_source( src_ds <- dthcaus_source( dataset_name = "ds", filter = DSDECOD == "DEATH" & grepl("DEATH DUE TO", DSTERM), - date = DSSTDT, + date = convert_dtc_to_dt(DSSTDTC), mode = "first", dthcaus = DSTERM, traceability_vars = exprs(DTHDOM = "DS", DTHSEQ = DSSEQ) @@ -112,12 +106,17 @@ derive_var_dthcaus(adsl, src_ae, src_ds, source_datasets = list(ae = ae, ds = ds src_ae <- dthcaus_source( dataset_name = "ae", filter = AEOUT == "FATAL", - date = AEDTHDT, + date = convert_dtc_to_dt(AEDTHDTC), mode = "first", dthcaus = AEDECOD, traceability_vars = exprs(DTHDOM = "AE", DTHSEQ = AESEQ) ) +ds <- mutate( + ds, + DSSTDT = convert_dtc_to_dt(DSSTDTC) +) + src_ds <- dthcaus_source( dataset_name = "ds", filter = DSDECOD == "DEATH" & grepl("DEATH DUE TO", DSTERM), @@ -136,7 +135,11 @@ src_ds_post <- dthcaus_source( traceability_vars = exprs(DTHDOM = "DS", DTHSEQ = DSSEQ) ) -derive_var_dthcaus(adsl, src_ae, src_ds, src_ds_post, source_datasets = list(ae = ae, ds = ds)) +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()}} diff --git a/man/derive_var_extreme_dt.Rd b/man/derive_var_extreme_dt.Rd index fa172cb499..c64c03bc92 100644 --- a/man/derive_var_extreme_dt.Rd +++ b/man/derive_var_extreme_dt.Rd @@ -42,8 +42,10 @@ A list of expressions where the expressions are symbols as returned by The input dataset with the new variable added. } \description{ -Add the first or last date from multiple sources to the dataset, e.g., -the last known alive date (\code{LSTALVDT}). +Add the first or last date from multiple sources to the +dataset, e.g., the last known alive date (\code{LSTALVDT}). + +\strong{Note:} This is a wrapper function for the function \code{derive_var_extreme_dtm()}. } \details{ The following steps are performed to create the output dataset: @@ -52,7 +54,8 @@ The following steps are performed to create the output dataset: element are selected and observations where \code{date} is \code{NA} are removed. Then for each patient the first or last observation (with respect to \code{date} and \code{mode}) is selected. -\item The new variable is set to the variable specified by the \code{date} element. +\item The new variable is set to the variable or expression specified by the +\code{date} element. \item The variables specified by the \code{traceability_vars} element are added. \item The selected observations of all source datasets are combined into a single dataset. @@ -64,23 +67,81 @@ variable is merged to the input dataset. } \examples{ library(dplyr, warn.conflicts = FALSE) -library(admiral.test) -data("admiral_dm") -data("admiral_ae") -data("admiral_lb") -data("admiral_adsl") +ae <- tribble( + ~STUDYID, ~DOMAIN, ~USUBJID, ~AESEQ, ~AESTDTC, ~AEENDTC, + "PILOT01", "AE", "01-1130", 5, "2014-05-09", "2014-05-09", + "PILOT01", "AE", "01-1130", 6, "2014-05-22", NA, + "PILOT01", "AE", "01-1130", 4, "2014-05-09", "2014-05-09", + "PILOT01", "AE", "01-1130", 8, "2014-05-22", NA, + "PILOT01", "AE", "01-1130", 7, "2014-05-22", NA, + "PILOT01", "AE", "01-1130", 2, "2014-03-09", "2014-03-09", + "PILOT01", "AE", "01-1130", 1, "2014-03-09", "2014-03-16", + "PILOT01", "AE", "01-1130", 3, "2014-03-09", "2014-03-16", + "PILOT01", "AE", "01-1133", 1, "2012-12-27", NA, + "PILOT01", "AE", "01-1133", 3, "2012-12-27", NA, + "PILOT01", "AE", "01-1133", 2, "2012-12-27", NA, + "PILOT01", "AE", "01-1133", 4, "2012-12-27", NA, + "PILOT01", "AE", "01-1211", 5, "2012-11-29", NA, + "PILOT01", "AE", "01-1211", 1, "2012-11-16", NA, + "PILOT01", "AE", "01-1211", 7, "2013-01-11", NA, + "PILOT01", "AE", "01-1211", 8, "2013-01-11", NA, + "PILOT01", "AE", "01-1211", 4, "2012-11-22", NA, + "PILOT01", "AE", "01-1211", 2, "2012-11-21", "2012-11-21", + "PILOT01", "AE", "01-1211", 3, "2012-11-21", NA, + "PILOT01", "AE", "01-1211", 6, "2012-12-09", NA, + "PILOT01", "AE", "01-1211", 9, "2013-01-14", "2013-01-14", + "PILOT01", "AE", "09-1081", 2, "2014-05-01", NA, + "PILOT01", "AE", "09-1081", 1, "2014-04-07", NA, + "PILOT01", "AE", "09-1088", 1, "2014-05-08", NA, + "PILOT01", "AE", "09-1088", 2, "2014-08-02", NA +) + +adsl <- tribble( + ~STUDYID, ~USUBJID, ~TRTEDTM, ~TRTEDT, + "PILOT01", "01-1130", "2014-08-16 23:59:59", "2014-08-16", + "PILOT01", "01-1133", "2013-04-28 23:59:59", "2013-04-28", + "PILOT01", "01-1211", "2013-01-12 23:59:59", "2013-01-12", + "PILOT01", "09-1081", "2014-04-27 23:59:59", "2014-04-27", + "PILOT01", "09-1088", "2014-10-09 23:59:59", "2014-10-09" +) \%>\% + mutate( + across(TRTEDTM:TRTEDT, as.Date) + ) + + +lb <- tribble( + ~STUDYID, ~DOMAIN, ~USUBJID, ~LBSEQ, ~LBDTC, + "PILOT01", "LB", "01-1130", 219, "2014-06-07T13:20", + "PILOT01", "LB", "01-1130", 322, "2014-08-16T13:10", + "PILOT01", "LB", "01-1133", 268, "2013-04-18T15:30", + "PILOT01", "LB", "01-1133", 304, "2013-04-29T10:13", + "PILOT01", "LB", "01-1211", 8, "2012-10-30T14:26", + "PILOT01", "LB", "01-1211", 162, "2013-01-08T12:13", + "PILOT01", "LB", "09-1081", 47, "2014-02-01T10:55", + "PILOT01", "LB", "09-1081", 219, "2014-05-10T11:15", + "PILOT01", "LB", "09-1088", 283, "2014-09-27T12:13", + "PILOT01", "LB", "09-1088", 322, "2014-10-09T13:25" +) + +dm <- tribble( + ~STUDYID, ~DOMAIN, ~USUBJID, ~AGE, ~AGEU, + "PILOT01", "DM", "01-1130", 84, "YEARS", + "PILOT01", "DM", "01-1133", 81, "YEARS", + "PILOT01", "DM", "01-1211", 76, "YEARS", + "PILOT01", "DM", "09-1081", 86, "YEARS", + "PILOT01", "DM", "09-1088", 69, "YEARS" +) -# derive last known alive date (LSTALVDT) ae_start <- date_source( dataset_name = "ae", - date = AESTDT + date = convert_dtc_to_dt(AESTDTC, highest_imputation = "M") ) ae_end <- date_source( dataset_name = "ae", - date = AEENDT + date = convert_dtc_to_dt(AEENDTC, highest_imputation = "M") ) -ae_ext <- admiral_ae \%>\% +ae_ext <- ae \%>\% derive_vars_dt( dtc = AESTDTC, new_vars_prefix = "AEST", @@ -94,24 +155,23 @@ ae_ext <- admiral_ae \%>\% lb_date <- date_source( dataset_name = "lb", - date = LBDT, - filter = !is.na(LBDT), + date = convert_dtc_to_dt(LBDTC) ) lb_ext <- derive_vars_dt( - admiral_lb, + lb, dtc = LBDTC, new_vars_prefix = "LB" ) adsl_date <- date_source(dataset_name = "adsl", date = TRTEDT) -admiral_dm \%>\% +dm \%>\% derive_var_extreme_dt( new_var = LSTALVDT, ae_start, ae_end, lb_date, adsl_date, source_datasets = list( - adsl = admiral_adsl, + adsl = adsl, ae = ae_ext, lb = lb_ext ), @@ -122,7 +182,7 @@ admiral_dm \%>\% # derive last alive date and traceability variables ae_start <- date_source( dataset_name = "ae", - date = AESTDT, + date = convert_dtc_to_dt(AESTDTC, highest_imputation = "M"), traceability_vars = exprs( LALVDOM = "AE", LALVSEQ = AESEQ, @@ -132,17 +192,17 @@ ae_start <- date_source( ae_end <- date_source( dataset_name = "ae", - date = AEENDT, + date = convert_dtc_to_dt(AEENDTC, highest_imputation = "M"), traceability_vars = exprs( LALVDOM = "AE", LALVSEQ = AESEQ, LALVVAR = "AEENDTC" ) ) + lb_date <- date_source( dataset_name = "lb", - date = LBDT, - filter = !is.na(LBDT), + date = convert_dtc_to_dt(LBDTC), traceability_vars = exprs( LALVDOM = "LB", LALVSEQ = LBSEQ, @@ -160,12 +220,12 @@ adsl_date <- date_source( ) ) -admiral_dm \%>\% +dm \%>\% derive_var_extreme_dt( new_var = LSTALVDT, ae_start, ae_end, lb_date, adsl_date, source_datasets = list( - adsl = admiral_adsl, + adsl = adsl, ae = ae_ext, lb = lb_ext ), diff --git a/man/derive_var_extreme_dtm.Rd b/man/derive_var_extreme_dtm.Rd index 05b8029f12..8f5f419eca 100644 --- a/man/derive_var_extreme_dtm.Rd +++ b/man/derive_var_extreme_dtm.Rd @@ -52,9 +52,9 @@ The following steps are performed to create the output dataset: element are selected and observations where \code{date} is \code{NA} are removed. Then for each patient the first or last observation (with respect to \code{date} and \code{mode}) is selected. -\item The new variable is set to the variable specified by the \code{date} element. -If this is a date variable (rather than datetime), then the time is imputed -as \code{"00:00:00"}. +\item The new variable is set to the variable or expression specified by the +\code{date} element. If this is a date variable (rather than datetime), then the +time is imputed as \code{"00:00:00"}. \item The variables specified by the \code{traceability_vars} element are added. \item The selected observations of all source datasets are combined into a single dataset. @@ -65,23 +65,79 @@ variable is merged to the input dataset. } \examples{ library(dplyr, warn.conflicts = FALSE) -library(admiral.test) -data("admiral_dm") -data("admiral_ae") -data("admiral_lb") -data("admiral_adsl") +library(lubridate) +dm <- tribble( + ~STUDYID, ~DOMAIN, ~USUBJID, ~AGE, ~AGEU, + "PILOT01", "DM", "01-1130", 84, "YEARS", + "PILOT01", "DM", "01-1133", 81, "YEARS", + "PILOT01", "DM", "01-1211", 76, "YEARS", + "PILOT01", "DM", "09-1081", 86, "YEARS", + "PILOT01", "DM", "09-1088", 69, "YEARS" +) +ae <- tribble( + ~STUDYID, ~DOMAIN, ~USUBJID, ~AESEQ, ~AESTDTC, ~AEENDTC, + "PILOT01", "AE", "01-1130", 5, "2014-05-09", "2014-05-09", + "PILOT01", "AE", "01-1130", 6, "2014-05-22", NA, + "PILOT01", "AE", "01-1130", 4, "2014-05-09", "2014-05-09", + "PILOT01", "AE", "01-1130", 8, "2014-05-22", NA, + "PILOT01", "AE", "01-1130", 7, "2014-05-22", NA, + "PILOT01", "AE", "01-1130", 2, "2014-03-09", "2014-03-09", + "PILOT01", "AE", "01-1130", 1, "2014-03-09", "2014-03-16", + "PILOT01", "AE", "01-1130", 3, "2014-03-09", "2014-03-16", + "PILOT01", "AE", "01-1133", 1, "2012-12-27", NA, + "PILOT01", "AE", "01-1133", 3, "2012-12-27", NA, + "PILOT01", "AE", "01-1133", 2, "2012-12-27", NA, + "PILOT01", "AE", "01-1133", 4, "2012-12-27", NA, + "PILOT01", "AE", "01-1211", 5, "2012-11-29", NA, + "PILOT01", "AE", "01-1211", 1, "2012-11-16", NA, + "PILOT01", "AE", "01-1211", 7, "2013-01-11", NA, + "PILOT01", "AE", "01-1211", 8, "2013-01-11", NA, + "PILOT01", "AE", "01-1211", 4, "2012-11-22", NA, + "PILOT01", "AE", "01-1211", 2, "2012-11-21", "2012-11-21", + "PILOT01", "AE", "01-1211", 3, "2012-11-21", NA, + "PILOT01", "AE", "01-1211", 6, "2012-12-09", NA, + "PILOT01", "AE", "01-1211", 9, "2013-01-14", "2013-01-14", + "PILOT01", "AE", "09-1081", 2, "2014-05-01", NA, + "PILOT01", "AE", "09-1081", 1, "2014-04-07", NA, + "PILOT01", "AE", "09-1088", 1, "2014-05-08", NA, + "PILOT01", "AE", "09-1088", 2, "2014-08-02", NA +) +lb <- tribble( + ~STUDYID, ~DOMAIN, ~USUBJID, ~LBSEQ, ~LBDTC, + "PILOT01", "LB", "01-1130", 219, "2014-06-07T13:20", + "PILOT01", "LB", "01-1130", 322, "2014-08-16T13:10", + "PILOT01", "LB", "01-1133", 268, "2013-04-18T15:30", + "PILOT01", "LB", "01-1133", 304, "2013-04-29T10:13", + "PILOT01", "LB", "01-1211", 8, "2012-10-30T14:26", + "PILOT01", "LB", "01-1211", 162, "2013-01-08T12:13", + "PILOT01", "LB", "09-1081", 47, "2014-02-01T10:55", + "PILOT01", "LB", "09-1081", 219, "2014-05-10T11:15", + "PILOT01", "LB", "09-1088", 283, "2014-09-27T12:13", + "PILOT01", "LB", "09-1088", 322, "2014-10-09T13:25" +) +adsl <- tribble( + ~STUDYID, ~USUBJID, ~TRTEDTM, + "PILOT01", "01-1130", "2014-08-16 23:59:59", + "PILOT01", "01-1133", "2013-04-28 23:59:59", + "PILOT01", "01-1211", "2013-01-12 23:59:59", + "PILOT01", "09-1081", "2014-04-27 23:59:59", + "PILOT01", "09-1088", "2014-10-09 23:59:59" +) \%>\% + mutate( + TRTEDTM = as_datetime(TRTEDTM) + ) # derive last known alive datetime (LSTALVDTM) ae_start <- date_source( dataset_name = "ae", - date = AESTDTM + date = convert_dtc_to_dtm(AESTDTC, highest_imputation = "M"), ) ae_end <- date_source( dataset_name = "ae", - date = AEENDTM + date = convert_dtc_to_dtm(AEENDTC, highest_imputation = "M"), ) -ae_ext <- admiral_ae \%>\% +ae_ext <- ae \%>\% derive_vars_dtm( dtc = AESTDTC, new_vars_prefix = "AEST", @@ -95,25 +151,28 @@ ae_ext <- admiral_ae \%>\% lb_date <- date_source( dataset_name = "lb", - date = LBDTM, - filter = !is.na(LBDTM) + date = convert_dtc_to_dtm(LBDTC), ) lb_ext <- derive_vars_dtm( - admiral_lb, + lb, dtc = LBDTC, new_vars_prefix = "LB" ) -adsl_date <- date_source(dataset_name = "adsl", date = TRTEDTM) +adsl_date <- date_source( + dataset_name = "adsl", + date = TRTEDTM +) -admiral_dm \%>\% +dm \%>\% derive_var_extreme_dtm( new_var = LSTALVDTM, ae_start, ae_end, lb_date, adsl_date, source_datasets = list( - adsl = admiral_adsl, - ae = ae_ext, lb = lb_ext + adsl = adsl, + ae = ae_ext, + lb = lb_ext ), mode = "last" ) \%>\% @@ -122,7 +181,7 @@ admiral_dm \%>\% # derive last alive datetime and traceability variables ae_start <- date_source( dataset_name = "ae", - date = AESTDTM, + date = convert_dtc_to_dtm(AESTDTC, highest_imputation = "M"), traceability_vars = exprs( LALVDOM = "AE", LALVSEQ = AESEQ, @@ -132,7 +191,7 @@ ae_start <- date_source( ae_end <- date_source( dataset_name = "ae", - date = AEENDTM, + date = convert_dtc_to_dtm(AEENDTC, highest_imputation = "M"), traceability_vars = exprs( LALVDOM = "AE", LALVSEQ = AESEQ, @@ -141,8 +200,7 @@ ae_end <- date_source( ) lb_date <- date_source( dataset_name = "lb", - date = LBDTM, - filter = !is.na(LBDTM), + date = convert_dtc_to_dtm(LBDTC), traceability_vars = exprs( LALVDOM = "LB", LALVSEQ = LBSEQ, @@ -160,12 +218,12 @@ adsl_date <- date_source( ) ) -admiral_dm \%>\% +dm \%>\% derive_var_extreme_dtm( new_var = LSTALVDTM, ae_start, ae_end, lb_date, adsl_date, source_datasets = list( - adsl = admiral_adsl, + adsl = adsl, ae = ae_ext, lb = lb_ext ), diff --git a/man/derive_var_extreme_flag.Rd b/man/derive_var_extreme_flag.Rd index eec33ebb20..b2a3b06399 100644 --- a/man/derive_var_extreme_flag.Rd +++ b/man/derive_var_extreme_flag.Rd @@ -71,11 +71,20 @@ 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") +example_vs <- tribble( + ~USUBJID, ~VSTESTCD, ~VISIT, ~VISITNUM, ~VSTPTNUM, ~VSSTRESN, + "1001", "DIABP", "SCREENING", 1, 10, 64, + "1001", "DIABP", "SCREENING", 1, 11, 66, + "1001", "DIABP", "BASELINE", 2, 100, 68, + "1001", "DIABP", "BASELINE", 2, 101, 68, + "1001", "DIABP", "WEEK 2", 3, 200, 72, + "1001", "DIABP", "WEEK 2", 3, 201, 71, + "1001", "DIABP", "WEEK 4", 4, 300, 70, + "1001", "DIABP", "WEEK 4", 4, 301, 70 +) # Flag last value for each patient, test, and visit, baseline observations are ignored -admiral_vs \%>\% +example_vs \%>\% restrict_derivation( derivation = derive_var_extreme_flag, args = params( @@ -168,10 +177,19 @@ restrict_derivation( ) # OCCURDS Examples -data("admiral_ae") +example_ae <- tribble( + ~USUBJID, ~AEBODSYS, ~AEDECOD, ~AESEV, ~AESTDY, ~AESEQ, + "1015", "GENERAL DISORDERS", "ERYTHEMA", "MILD", 2, 1, + "1015", "GENERAL DISORDERS", "PRURITUS", "MILD", 2, 2, + "1015", "GI DISORDERS", "DIARRHOEA", "MILD", 8, 3, + "1023", "CARDIAC DISORDERS", "AV BLOCK", "MILD", 22, 4, + "1023", "SKIN DISORDERS", "ERYTHEMA", "MILD", 3, 1, + "1023", "SKIN DISORDERS", "ERYTHEMA", "SEVERE", 5, 2, + "1023", "SKIN DISORDERS", "ERYTHEMA", "MILD", 8, 3 +) # Most severe AE first occurrence per patient -admiral_ae \%>\% +example_ae \%>\% mutate( TEMP_AESEVN = as.integer(factor(AESEV, levels = c("SEVERE", "MODERATE", "MILD"))) @@ -186,7 +204,7 @@ admiral_ae \%>\% select(USUBJID, AEDECOD, AESEV, AESTDY, AESEQ, AOCCIFL) # Most severe AE first occurrence per patient per body system -admiral_ae \%>\% +example_ae \%>\% mutate( TEMP_AESEVN = as.integer(factor(AESEV, levels = c("SEVERE", "MODERATE", "MILD"))) @@ -205,17 +223,11 @@ admiral_ae \%>\% General Derivation Functions for all ADaMs that returns variable appended to dataset: \code{\link{derive_var_joined_exist_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_vars_joined}()}, -\code{\link{derive_vars_last_dose}()}, \code{\link{derive_vars_merged_lookup}()}, \code{\link{derive_vars_merged}()}, \code{\link{derive_vars_transposed}()}, diff --git a/man/derive_var_joined_exist_flag.Rd b/man/derive_var_joined_exist_flag.Rd index 8b649ad446..21321c43dd 100644 --- a/man/derive_var_joined_exist_flag.Rd +++ b/man/derive_var_joined_exist_flag.Rd @@ -356,17 +356,11 @@ derive_var_joined_exist_flag( General Derivation Functions for all ADaMs that returns variable appended to dataset: \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_vars_joined}()}, -\code{\link{derive_vars_last_dose}()}, \code{\link{derive_vars_merged_lookup}()}, \code{\link{derive_vars_merged}()}, \code{\link{derive_vars_transposed}()}, diff --git a/man/derive_var_last_dose_amt.Rd b/man/derive_var_last_dose_amt.Rd index 074a530114..f8962f2d04 100644 --- a/man/derive_var_last_dose_amt.Rd +++ b/man/derive_var_last_dose_amt.Rd @@ -59,6 +59,12 @@ Input dataset with additional column \code{new_var}. } \description{ Add a variable for dose amount from the last dose to the input dataset. + +\strong{Note:} This is a wrapper function for the function \code{derive_vars_last_dose()}. + +\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_vars_joined()} instead. } \details{ The last dose amount is derived as the dose amount where the maximum \code{dose_date} is @@ -69,77 +75,23 @@ over a period defined by a start and end date) the function \code{create_single_dose_dataset()} can be used to generate single doses from aggregate dose information and satisfy \code{single_dose_condition}. } -\examples{ -library(dplyr, warn.conflicts = FALSE) -library(admiral.test) -data(admiral_ae) -data(ex_single) - -ex_single <- derive_vars_dtm( - head(ex_single, 100), - dtc = EXENDTC, - new_vars_prefix = "EXEN", - flag_imputation = "none" -) - -adae <- admiral_ae \%>\% - head(100) \%>\% - derive_vars_dtm( - dtc = AESTDTC, - new_vars_prefix = "AST", - highest_imputation = "M" - ) - -adae \%>\% - derive_var_last_dose_amt( - dataset_ex = ex_single, - filter_ex = (EXDOSE > 0 | (EXDOSE == 0 & grepl("PLACEBO", EXTRT))) & - !is.na(EXENDTM), - dose_date = EXENDTM, - analysis_date = ASTDTM, - new_var = LDOSE, - dose_var = EXDOSE - ) \%>\% - select(STUDYID, USUBJID, AESEQ, AESTDTC, LDOSE) - -# or with traceability variables -adae \%>\% - derive_var_last_dose_amt( - dataset_ex = ex_single, - filter_ex = (EXDOSE > 0 | (EXDOSE == 0 & grepl("PLACEBO", EXTRT))) & - !is.na(EXENDTM), - dose_date = EXENDTM, - analysis_date = ASTDTM, - new_var = LDOSE, - dose_var = EXDOSE, - traceability_vars = exprs( - LDOSEDOM = "EX", - LDOSESEQ = EXSEQ, - LDOSEVAR = "EXDOSE" - ) - ) \%>\% - select(STUDYID, USUBJID, AESEQ, AESTDTC, LDOSEDOM, LDOSESEQ, LDOSEVAR, LDOSE) -} \seealso{ \code{\link[=derive_vars_last_dose]{derive_vars_last_dose()}}, \code{\link[=create_single_dose_dataset]{create_single_dose_dataset()}} -General Derivation Functions for all ADaMs that returns variable appended to dataset: -\code{\link{derive_var_extreme_flag}()}, -\code{\link{derive_var_joined_exist_flag}()}, +Other deprecated: +\code{\link{derive_param_extreme_event}()}, +\code{\link{derive_var_basetype}()}, +\code{\link{derive_var_confirmation_flag}()}, +\code{\link{derive_var_disposition_status}()}, \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_vars_joined}()}, +\code{\link{derive_var_worst_flag}()}, +\code{\link{derive_vars_disposition_reason}()}, \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}()} +\code{\link{format_eoxxstt_default}()}, +\code{\link{format_reason_default}()} } -\concept{der_gen} -\keyword{der_gen} +\concept{deprecated} +\keyword{deprecated} diff --git a/man/derive_var_last_dose_date.Rd b/man/derive_var_last_dose_date.Rd index d9ce95ff46..1fdab362f1 100644 --- a/man/derive_var_last_dose_date.Rd +++ b/man/derive_var_last_dose_date.Rd @@ -58,7 +58,14 @@ These can be either strings or symbols referring to existing variables.} Input dataset with additional column \code{new_var}. } \description{ -Add a variable for the dose date or datetime of the last dose to the input dataset. +Add a variable for the dose date or datetime of the last dose to +the input dataset. + +\strong{Note:} This is a wrapper function for the function \code{derive_vars_last_dose()}. + +\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_vars_joined()} instead. } \details{ The last dose date is derived as the maximum dose date where the @@ -72,59 +79,23 @@ over a period defined by a start and end date) the function \code{create_single_dose_dataset()} can be used to generate single doses from aggregate dose information and satisfy \code{single_dose_condition}. } -\examples{ -library(dplyr, warn.conflicts = FALSE) -library(admiral.test) -data(admiral_ae) -data(ex_single) - -ex_single <- derive_vars_dtm( - head(ex_single, 100), - dtc = EXENDTC, - new_vars_prefix = "EXEN", - flag_imputation = "none" -) - -adae <- admiral_ae \%>\% - head(100) \%>\% - derive_vars_dtm( - dtc = AESTDTC, - new_vars_prefix = "AST", - highest_imputation = "M" - ) - -adae \%>\% - derive_var_last_dose_date( - dataset_ex = ex_single, - filter_ex = (EXDOSE > 0 | (EXDOSE == 0 & grepl("PLACEBO", EXTRT))) & - !is.na(EXENDTM), - dose_date = EXENDTM, - analysis_date = ASTDTM, - new_var = LDOSEDTM, - traceability_vars = exprs(LDOSEDOM = "EX", LDOSESEQ = EXSEQ, LDOSEVAR = "EXDOSE") - ) \%>\% - select(STUDYID, USUBJID, AESEQ, AESTDTC, LDOSEDOM, LDOSESEQ, LDOSEVAR, LDOSEDTM) -} \seealso{ \code{\link[=derive_vars_last_dose]{derive_vars_last_dose()}}, \code{\link[=create_single_dose_dataset]{create_single_dose_dataset()}} -General Derivation Functions for all ADaMs that returns variable appended to dataset: -\code{\link{derive_var_extreme_flag}()}, -\code{\link{derive_var_joined_exist_flag}()}, +Other deprecated: +\code{\link{derive_param_extreme_event}()}, +\code{\link{derive_var_basetype}()}, +\code{\link{derive_var_confirmation_flag}()}, +\code{\link{derive_var_disposition_status}()}, \code{\link{derive_var_last_dose_amt}()}, \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_vars_joined}()}, +\code{\link{derive_var_worst_flag}()}, +\code{\link{derive_vars_disposition_reason}()}, \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}()} +\code{\link{format_eoxxstt_default}()}, +\code{\link{format_reason_default}()} } -\concept{der_gen} -\keyword{der_gen} +\concept{deprecated} +\keyword{deprecated} diff --git a/man/derive_var_last_dose_grp.Rd b/man/derive_var_last_dose_grp.Rd index 0beaacaa07..496a0b582d 100644 --- a/man/derive_var_last_dose_grp.Rd +++ b/man/derive_var_last_dose_grp.Rd @@ -76,7 +76,14 @@ These can be either strings or symbols referring to existing variables.} Input dataset with additional column \code{new_var}. } \description{ -Add a variable for user-defined dose grouping of the last dose to the input dataset. +Add a variable for user-defined dose grouping of the last dose +to the input dataset. + +\strong{Note:} This is a wrapper function for the function \code{derive_vars_last_dose()}. + +\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_vars_joined()} instead. } \details{ Last dose is the dose with maximum \code{dose_date} that is lower to or equal to the @@ -89,65 +96,23 @@ over a period defined by a start and end date) the function \code{create_single_dose_dataset()} can be used to generate single doses from aggregate dose information and satisfy \code{single_dose_condition}. } -\examples{ -library(dplyr, warn.conflicts = FALSE) -library(admiral.test) -data(admiral_ae) -data(ex_single) - -ex_single <- derive_vars_dtm( - head(ex_single, 100), - dtc = EXSTDTC, - new_vars_prefix = "EXST", - flag_imputation = "none" -) - -adae <- admiral_ae \%>\% - head(100) \%>\% - derive_vars_dtm( - dtc = AESTDTC, - new_vars_prefix = "AST", - highest_imputation = "M" - ) - -adae \%>\% - derive_var_last_dose_grp( - dataset_ex = ex_single, - filter_ex = (EXDOSE > 0 | (EXDOSE == 0 & grepl("PLACEBO", EXTRT))) & - !is.na(EXSTDTM), - by_vars = exprs(STUDYID, USUBJID), - dose_date = EXSTDTM, - new_var = LDGRP, - grp_brks = c(0, 20, 40, 60), - grp_lbls = c("Low", "Medium", "High"), - include_lowest = TRUE, - right = TRUE, - dose_var = EXDOSE, - analysis_date = ASTDTM, - traceability_vars = exprs(LDOSEDOM = "EX", LDOSESEQ = EXSEQ, LDOSEVAR = "EXENDTC") - ) \%>\% - select(USUBJID, LDGRP, LDOSEDOM, LDOSESEQ, LDOSEVAR) -} \seealso{ \code{\link[=derive_vars_last_dose]{derive_vars_last_dose()}}, \code{\link[=cut]{cut()}}, \code{\link[=create_single_dose_dataset]{create_single_dose_dataset()}} -General Derivation Functions for all ADaMs that returns variable appended to dataset: -\code{\link{derive_var_extreme_flag}()}, -\code{\link{derive_var_joined_exist_flag}()}, +Other deprecated: +\code{\link{derive_param_extreme_event}()}, +\code{\link{derive_var_basetype}()}, +\code{\link{derive_var_confirmation_flag}()}, +\code{\link{derive_var_disposition_status}()}, \code{\link{derive_var_last_dose_amt}()}, \code{\link{derive_var_last_dose_date}()}, \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_var_worst_flag}()}, +\code{\link{derive_vars_disposition_reason}()}, \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}()} +\code{\link{format_eoxxstt_default}()}, +\code{\link{format_reason_default}()} } -\concept{der_gen} -\keyword{der_gen} +\concept{deprecated} +\keyword{deprecated} diff --git a/man/derive_var_merged_cat.Rd b/man/derive_var_merged_cat.Rd index 3d2316693f..1de2eb59a6 100644 --- a/man/derive_var_merged_cat.Rd +++ b/man/derive_var_merged_cat.Rd @@ -43,10 +43,10 @@ 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. -\emph{Default}: \code{NULL} +Variables defined by the \code{new_vars} argument can be used in the sort order. -\emph{Permitted Values}: list of variables or \verb{desc()} function calls -created by \code{exprs()}, e.g., \code{exprs(ADT, desc(AVAL))} or \code{NULL}} +\emph{Permitted Values}: list of expressions created by \code{exprs()}, e.g., +\code{exprs(ADT, desc(AVAL))} or \code{NULL}} \item{new_var}{New variable @@ -66,7 +66,8 @@ Only observations fulfilling the specified condition are taken into account for merging. If the argument is not specified, all observations are considered. -\emph{Default}: \code{NULL} +Variables defined by the \code{new_vars} argument can be used in the filter +condition. \emph{Permitted Values}: a condition} @@ -77,8 +78,6 @@ argument is specified, \code{mode} must be non-null. If the \code{order} argument is not specified, the \code{mode} argument is ignored. -\emph{Default}: \code{NULL} - \emph{Permitted Values}: \code{"first"}, \code{"last"}, \code{NULL}} \item{missing_value}{Values used for missing information @@ -94,6 +93,10 @@ input dataset and additionally the variable specified for \code{new_var} derived from the additional dataset (\code{dataset_add}). } \description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} + +This function is \emph{deprecated}, please use \code{derive_vars_merged()} instead. + Merge a categorization variable from a dataset to the input dataset. The observations to merge can be selected by a condition and/or selecting the first or last observation for each by group. @@ -109,11 +112,29 @@ first or last observation for each by group. } } \examples{ -library(admiral.test) library(dplyr, warn.conflicts = FALSE) -data("admiral_dm") -data("admiral_vs") +vs <- tribble( + ~STUDYID, ~DOMAIN, ~USUBJID, ~VISIT, ~VSTESTCD, ~VSSTRESN, ~VSSEQ, ~VSDTC, + "PILOT01", "VS", "04-1127", "SCREENING", "HEIGHT", 165.1, 43, "2013-09-16", + "PILOT01", "VS", "04-1127", "SCREENING", "WEIGHT", 42.87, 142, "2013-09-16", + "PILOT01", "VS", "04-1127", "BASELINE", "WEIGHT", 41.05, 143, "2013-10-02", + "PILOT01", "VS", "04-1127", "WEEK 2", "WEIGHT", 42.64, 144, "2013-10-16", + "PILOT01", "VS", "04-1127", "WEEK 4", "WEIGHT", 41.73, 145, "2013-10-30", + "PILOT01", "VS", "04-1127", "WEEK 26", "WEIGHT", 43.09, 152, "2014-03-31", + "PILOT01", "VS", "06-1049", "SCREENING", "HEIGHT", 167.64, 28, "2013-04-30", + "PILOT01", "VS", "06-1049", "SCREENING", "WEIGHT", 57.61, 92, "2013-04-30", + "PILOT01", "VS", "06-1049", "BASELINE", "WEIGHT", 57.83, 93, "2013-05-14", + "PILOT01", "VS", "06-1049", "WEEK 2", "WEIGHT", 58.29, 94, "2013-05-28", + "PILOT01", "VS", "06-1049", "WEEK 4", "WEIGHT", 58.97, 95, "2013-06-11" +) + +dm <- tribble( + ~STUDYID, ~DOMAIN, ~USUBJID, ~AGE, ~AGEU, + "PILOT01", "DM", "01-1057", 59, "YEARS", + "PILOT01", "DM", "04-1127", 84, "YEARS", + "PILOT01", "DM", "06-1049", 60, "YEARS" +) wgt_cat <- function(wgt) { case_when( wgt < 50 ~ "low", @@ -123,8 +144,8 @@ wgt_cat <- function(wgt) { } derive_var_merged_cat( - admiral_dm, - dataset_add = admiral_vs, + dm, + dataset_add = vs, by_vars = exprs(STUDYID, USUBJID), order = exprs(VSDTC, VSSEQ), filter_add = VSTESTCD == "WEIGHT" & substr(VISIT, 1, 9) == "SCREENING", @@ -135,10 +156,12 @@ derive_var_merged_cat( ) \%>\% select(STUDYID, USUBJID, AGE, AGEU, WGTBLCAT) + + # defining a value for missing VS data derive_var_merged_cat( - admiral_dm, - dataset_add = admiral_vs, + dm, + dataset_add = vs, by_vars = exprs(STUDYID, USUBJID), order = exprs(VSDTC, VSSEQ), filter_add = VSTESTCD == "WEIGHT" & substr(VISIT, 1, 9) == "SCREENING", @@ -151,23 +174,20 @@ derive_var_merged_cat( select(STUDYID, USUBJID, AGE, AGEU, WGTBLCAT) } \seealso{ -General Derivation Functions for all ADaMs that returns variable appended to dataset: -\code{\link{derive_var_extreme_flag}()}, -\code{\link{derive_var_joined_exist_flag}()}, +Other deprecated: +\code{\link{derive_param_extreme_event}()}, +\code{\link{derive_var_basetype}()}, +\code{\link{derive_var_confirmation_flag}()}, +\code{\link{derive_var_disposition_status}()}, \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_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_var_worst_flag}()}, +\code{\link{derive_vars_disposition_reason}()}, \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}()} +\code{\link{format_eoxxstt_default}()}, +\code{\link{format_reason_default}()} } -\concept{der_gen} -\keyword{der_gen} +\concept{deprecated} +\keyword{deprecated} diff --git a/man/derive_var_merged_character.Rd b/man/derive_var_merged_character.Rd index b346024280..f613ab037f 100644 --- a/man/derive_var_merged_character.Rd +++ b/man/derive_var_merged_character.Rd @@ -43,10 +43,10 @@ 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. -\emph{Default}: \code{NULL} +Variables defined by the \code{new_vars} argument can be used in the sort order. -\emph{Permitted Values}: list of variables or \verb{desc()} function calls -created by \code{exprs()}, e.g., \code{exprs(ADT, desc(AVAL))} or \code{NULL}} +\emph{Permitted Values}: list of expressions created by \code{exprs()}, e.g., +\code{exprs(ADT, desc(AVAL))} or \code{NULL}} \item{new_var}{New variable @@ -69,7 +69,8 @@ Only observations fulfilling the specified condition are taken into account for merging. If the argument is not specified, all observations are considered. -\emph{Default}: \code{NULL} +Variables defined by the \code{new_vars} argument can be used in the filter +condition. \emph{Permitted Values}: a condition} @@ -80,8 +81,6 @@ argument is specified, \code{mode} must be non-null. If the \code{order} argument is not specified, the \code{mode} argument is ignored. -\emph{Default}: \code{NULL} - \emph{Permitted Values}: \code{"first"}, \code{"last"}, \code{NULL}} \item{missing_value}{Values used for missing information @@ -99,6 +98,10 @@ input dataset and additionally the variable specified for \code{new_var} derived from the additional dataset (\code{dataset_add}). } \description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} + +This function is \emph{deprecated}, please use \code{derive_vars_merged()} instead. + Merge a character variable from a dataset to the input dataset. The observations to merge can be selected by a condition and/or selecting the first or last observation for each by group. @@ -113,41 +116,21 @@ first or last observation for each by group. \item The character variable is merged to the input dataset. } } -\examples{ -library(admiral.test) -library(dplyr, warn.conflicts = FALSE) -data("admiral_dm") -data("admiral_ds") - -derive_var_merged_character( - admiral_dm, - dataset_add = admiral_ds, - by_vars = exprs(STUDYID, USUBJID), - new_var = DISPSTAT, - filter_add = DSCAT == "DISPOSITION EVENT", - source_var = DSDECOD, - case = "title" -) \%>\% - select(STUDYID, USUBJID, AGE, AGEU, DISPSTAT) -} \seealso{ -General Derivation Functions for all ADaMs that returns variable appended to dataset: -\code{\link{derive_var_extreme_flag}()}, -\code{\link{derive_var_joined_exist_flag}()}, +Other deprecated: +\code{\link{derive_param_extreme_event}()}, +\code{\link{derive_var_basetype}()}, +\code{\link{derive_var_confirmation_flag}()}, +\code{\link{derive_var_disposition_status}()}, \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_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_var_worst_flag}()}, +\code{\link{derive_vars_disposition_reason}()}, \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}()} +\code{\link{format_eoxxstt_default}()}, +\code{\link{format_reason_default}()} } -\concept{der_gen} -\keyword{der_gen} +\concept{deprecated} +\keyword{deprecated} diff --git a/man/derive_var_merged_exist_flag.Rd b/man/derive_var_merged_exist_flag.Rd index 7f5f32ee85..b86c0ef87b 100644 --- a/man/derive_var_merged_exist_flag.Rd +++ b/man/derive_var_merged_exist_flag.Rd @@ -74,8 +74,11 @@ input dataset and additionally the variable specified for \code{new_var} derived from the additional dataset (\code{dataset_add}). } \description{ -Adds a flag variable to the input dataset which indicates if there exists at -least one observation in another dataset fulfilling a certain condition. +Adds a flag variable to the input dataset which indicates if +there exists at least one observation in another dataset fulfilling a certain +condition. + +\strong{Note:} This is a wrapper function for the more generic \code{derive_vars_merged()}. } \details{ \enumerate{ @@ -92,23 +95,51 @@ observation exists and for all observations the condition evaluates to } \examples{ -library(admiral.test) library(dplyr, warn.conflicts = FALSE) -data("admiral_dm") -data("admiral_ae") + +dm <- tribble( + ~STUDYID, ~DOMAIN, ~USUBJID, ~AGE, ~AGEU, + "PILOT01", "DM", "01-1028", 71, "YEARS", + "PILOT01", "DM", "04-1127", 84, "YEARS", + "PILOT01", "DM", "06-1049", 60, "YEARS" +) + +ae <- tribble( + ~STUDYID, ~DOMAIN, ~USUBJID, ~AETERM, ~AEREL, + "PILOT01", "AE", "01-1028", "ERYTHEMA", "POSSIBLE", + "PILOT01", "AE", "01-1028", "PRURITUS", "PROBABLE", + "PILOT01", "AE", "06-1049", "SYNCOPE", "POSSIBLE", + "PILOT01", "AE", "06-1049", "SYNCOPE", "PROBABLE" +) + + derive_var_merged_exist_flag( - admiral_dm, - dataset_add = admiral_ae, + dm, + dataset_add = ae, by_vars = exprs(STUDYID, USUBJID), new_var = AERELFL, condition = AEREL == "PROBABLE" ) \%>\% select(STUDYID, USUBJID, AGE, AGEU, AERELFL) -data("admiral_vs") +vs <- tribble( + ~STUDYID, ~DOMAIN, ~USUBJID, ~VISIT, ~VSTESTCD, ~VSSTRESN, ~VSBLFL, + "PILOT01", "VS", "01-1028", "SCREENING", "HEIGHT", 177.8, NA, + "PILOT01", "VS", "01-1028", "SCREENING", "WEIGHT", 98.88, NA, + "PILOT01", "VS", "01-1028", "BASELINE", "WEIGHT", 99.34, "Y", + "PILOT01", "VS", "01-1028", "WEEK 4", "WEIGHT", 98.88, NA, + "PILOT01", "VS", "04-1127", "SCREENING", "HEIGHT", 165.1, NA, + "PILOT01", "VS", "04-1127", "SCREENING", "WEIGHT", 42.87, NA, + "PILOT01", "VS", "04-1127", "BASELINE", "WEIGHT", 41.05, "Y", + "PILOT01", "VS", "04-1127", "WEEK 4", "WEIGHT", 41.73, NA, + "PILOT01", "VS", "06-1049", "SCREENING", "HEIGHT", 167.64, NA, + "PILOT01", "VS", "06-1049", "SCREENING", "WEIGHT", 57.61, NA, + "PILOT01", "VS", "06-1049", "BASELINE", "WEIGHT", 57.83, "Y", + "PILOT01", "VS", "06-1049", "WEEK 4", "WEIGHT", 58.97, NA +) derive_var_merged_exist_flag( - admiral_dm, - dataset_add = admiral_vs, + dm, + dataset_add = vs, by_vars = exprs(STUDYID, USUBJID), filter_add = VSTESTCD == "WEIGHT" & VSBLFL == "Y", new_var = WTBLHIFL, @@ -122,16 +153,10 @@ derive_var_merged_exist_flag( General Derivation Functions for all ADaMs that returns variable appended to dataset: \code{\link{derive_var_extreme_flag}()}, \code{\link{derive_var_joined_exist_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_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}()}, \code{\link{derive_vars_transposed}()}, diff --git a/man/derive_var_merged_summary.Rd b/man/derive_var_merged_summary.Rd index 2b0b4a430f..5a7ff2fd0f 100644 --- a/man/derive_var_merged_summary.Rd +++ b/man/derive_var_merged_summary.Rd @@ -62,6 +62,8 @@ input dataset and additionally the variable specified for \code{new_var}. } \description{ Merge a summary variable from a dataset to the input dataset. + +\strong{Note:} This is a wrapper function for the more generic \code{derive_vars_merged}. } \details{ \enumerate{ @@ -82,16 +84,16 @@ 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 + ~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( @@ -112,19 +114,19 @@ adsl <- tribble( ) 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" + ~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( @@ -144,16 +146,10 @@ derive_var_merged_summary( General Derivation Functions for all ADaMs that returns variable appended to dataset: \code{\link{derive_var_extreme_flag}()}, \code{\link{derive_var_joined_exist_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_vars_joined}()}, -\code{\link{derive_vars_last_dose}()}, \code{\link{derive_vars_merged_lookup}()}, \code{\link{derive_vars_merged}()}, \code{\link{derive_vars_transposed}()}, diff --git a/man/derive_var_obs_number.Rd b/man/derive_var_obs_number.Rd index 4ab4a5069e..f9fae3a7ee 100644 --- a/man/derive_var_obs_number.Rd +++ b/man/derive_var_obs_number.Rd @@ -60,11 +60,34 @@ order specified for the \code{order} parameter and the mode specified for the } \examples{ library(dplyr, warn.conflicts = FALSE) -library(admiral.test) -data("admiral_vs") - -admiral_vs \%>\% - select(USUBJID, VSTESTCD, VISITNUM, VSTPTNUM) \%>\% +vs <- tribble( + ~STUDYID, ~DOMAIN, ~USUBJID, ~VSTESTCD, ~VISITNUM, ~VSTPTNUM, + "PILOT01", "VS", "01-703-1182", "DIABP", 3, 815, + "PILOT01", "VS", "01-703-1182", "DIABP", 3, 816, + "PILOT01", "VS", "01-703-1182", "DIABP", 4, 815, + "PILOT01", "VS", "01-703-1182", "DIABP", 4, 816, + "PILOT01", "VS", "01-703-1182", "PULSE", 3, 815, + "PILOT01", "VS", "01-703-1182", "PULSE", 3, 816, + "PILOT01", "VS", "01-703-1182", "PULSE", 4, 815, + "PILOT01", "VS", "01-703-1182", "PULSE", 4, 816, + "PILOT01", "VS", "01-703-1182", "SYSBP", 3, 815, + "PILOT01", "VS", "01-703-1182", "SYSBP", 3, 816, + "PILOT01", "VS", "01-703-1182", "SYSBP", 4, 815, + "PILOT01", "VS", "01-703-1182", "SYSBP", 4, 816, + "PILOT01", "VS", "01-716-1229", "DIABP", 3, 815, + "PILOT01", "VS", "01-716-1229", "DIABP", 3, 816, + "PILOT01", "VS", "01-716-1229", "DIABP", 4, 815, + "PILOT01", "VS", "01-716-1229", "DIABP", 4, 816, + "PILOT01", "VS", "01-716-1229", "PULSE", 3, 815, + "PILOT01", "VS", "01-716-1229", "PULSE", 3, 816, + "PILOT01", "VS", "01-716-1229", "PULSE", 4, 815, + "PILOT01", "VS", "01-716-1229", "PULSE", 4, 816, + "PILOT01", "VS", "01-716-1229", "SYSBP", 3, 815, + "PILOT01", "VS", "01-716-1229", "SYSBP", 3, 816, + "PILOT01", "VS", "01-716-1229", "SYSBP", 4, 815, + "PILOT01", "VS", "01-716-1229", "SYSBP", 4, 816 +) +vs \%>\% derive_var_obs_number( by_vars = exprs(USUBJID, VSTESTCD), order = exprs(VISITNUM, desc(VSTPTNUM)) @@ -74,16 +97,10 @@ admiral_vs \%>\% General Derivation Functions for all ADaMs that returns variable appended to dataset: \code{\link{derive_var_extreme_flag}()}, \code{\link{derive_var_joined_exist_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_relative_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}()}, diff --git a/man/derive_var_ontrtfl.Rd b/man/derive_var_ontrtfl.Rd index 4c25ad5c05..55fa797e10 100644 --- a/man/derive_var_ontrtfl.Rd +++ b/man/derive_var_ontrtfl.Rd @@ -194,11 +194,11 @@ derive_var_ontrtfl( } \seealso{ BDS-Findings Functions that returns variable appended to dataset: +\code{\link{derive_basetype_records}()}, \code{\link{derive_var_analysis_ratio}()}, \code{\link{derive_var_anrind}()}, \code{\link{derive_var_atoxgr_dir}()}, \code{\link{derive_var_atoxgr}()}, -\code{\link{derive_var_basetype}()}, \code{\link{derive_var_base}()}, \code{\link{derive_var_chg}()}, \code{\link{derive_var_pchg}()}, diff --git a/man/derive_var_pchg.Rd b/man/derive_var_pchg.Rd index d41a61e94c..428950b05a 100644 --- a/man/derive_var_pchg.Rd +++ b/man/derive_var_pchg.Rd @@ -38,11 +38,11 @@ derive_var_pchg(advs) \code{\link[=derive_var_chg]{derive_var_chg()}} BDS-Findings Functions that returns variable appended to dataset: +\code{\link{derive_basetype_records}()}, \code{\link{derive_var_analysis_ratio}()}, \code{\link{derive_var_anrind}()}, \code{\link{derive_var_atoxgr_dir}()}, \code{\link{derive_var_atoxgr}()}, -\code{\link{derive_var_basetype}()}, \code{\link{derive_var_base}()}, \code{\link{derive_var_chg}()}, \code{\link{derive_var_ontrtfl}()}, diff --git a/man/derive_var_relative_flag.Rd b/man/derive_var_relative_flag.Rd index f423f34eab..9d07da3360 100644 --- a/man/derive_var_relative_flag.Rd +++ b/man/derive_var_relative_flag.Rd @@ -31,8 +31,8 @@ expected.} 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{exprs()}, e.g., \code{exprs(ADT, desc(AVAL))}} +\emph{Permitted Values:} list of expressions created by \code{exprs()}, e.g., +\code{exprs(ADT, desc(AVAL))}} \item{new_var}{New variable @@ -173,16 +173,10 @@ response \%>\% General Derivation Functions for all ADaMs that returns variable appended to dataset: \code{\link{derive_var_extreme_flag}()}, \code{\link{derive_var_joined_exist_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_vars_joined}()}, -\code{\link{derive_vars_last_dose}()}, \code{\link{derive_vars_merged_lookup}()}, \code{\link{derive_vars_merged}()}, \code{\link{derive_vars_transposed}()}, diff --git a/man/derive_var_shift.Rd b/man/derive_var_shift.Rd index a2891e4d82..76c6a38679 100644 --- a/man/derive_var_shift.Rd +++ b/man/derive_var_shift.Rd @@ -81,11 +81,11 @@ data \%>\% } \seealso{ BDS-Findings Functions that returns variable appended to dataset: +\code{\link{derive_basetype_records}()}, \code{\link{derive_var_analysis_ratio}()}, \code{\link{derive_var_anrind}()}, \code{\link{derive_var_atoxgr_dir}()}, \code{\link{derive_var_atoxgr}()}, -\code{\link{derive_var_basetype}()}, \code{\link{derive_var_base}()}, \code{\link{derive_var_chg}()}, \code{\link{derive_var_ontrtfl}()}, diff --git a/man/derive_var_trtdurd.Rd b/man/derive_var_trtdurd.Rd index a94f5f2f5a..81707b483b 100644 --- a/man/derive_var_trtdurd.Rd +++ b/man/derive_var_trtdurd.Rd @@ -34,7 +34,9 @@ Default: \code{TRTEDT}} The input dataset with \code{TRTDURD} added } \description{ -Derives total treatment duration (days) (\code{TRTDURD}) +Derives total treatment duration (days) (\code{TRTDURD}). + +\strong{Note:} This is a wrapper function for the more generic \code{derive_vars_duration()}. } \details{ The total treatment duration is derived as the number of days from diff --git a/man/derive_var_worst_flag.Rd b/man/derive_var_worst_flag.Rd index 9d1bd7a2f5..d08084640d 100644 --- a/man/derive_var_worst_flag.Rd +++ b/man/derive_var_worst_flag.Rd @@ -81,18 +81,19 @@ and for others the worst is the lowest value. \code{\link[=derive_var_extreme_flag]{derive_var_extreme_flag()}} Other deprecated: -\code{\link{derive_derived_param}()}, -\code{\link{derive_param_first_event}()}, -\code{\link{derive_var_agegr_fda}()}, +\code{\link{derive_param_extreme_event}()}, +\code{\link{derive_var_basetype}()}, \code{\link{derive_var_confirmation_flag}()}, \code{\link{derive_var_disposition_status}()}, +\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_vars_disposition_reason}()}, -\code{\link{derive_vars_merged_dtm}()}, -\code{\link{derive_vars_merged_dt}()}, -\code{\link{filter_confirmation}()}, +\code{\link{derive_vars_last_dose}()}, \code{\link{format_eoxxstt_default}()}, -\code{\link{format_reason_default}()}, -\code{\link{vars}()} +\code{\link{format_reason_default}()} } \concept{deprecated} \keyword{deprecated} diff --git a/man/derive_vars_aage.Rd b/man/derive_vars_aage.Rd index 06ebadc501..6c43f19929 100644 --- a/man/derive_vars_aage.Rd +++ b/man/derive_vars_aage.Rd @@ -47,7 +47,9 @@ Permitted Values: 'years', 'months', 'weeks', 'days', 'hours', 'minutes', 'secon The input dataset with \code{AAGE} and \code{AAGEU} added } \description{ -Derives analysis age (\code{AAGE}) and analysis age unit (\code{AAGEU}) +Derives analysis age (\code{AAGE}) and analysis age unit (\code{AAGEU}). + +\strong{Note:} This is a wrapper function for the more generic \code{derive_vars_duration()}. } \details{ The age is derived as the integer part of the duration from start to diff --git a/man/derive_vars_atc.Rd b/man/derive_vars_atc.Rd index 3d70214d9a..0f9e8f8bde 100644 --- a/man/derive_vars_atc.Rd +++ b/man/derive_vars_atc.Rd @@ -34,7 +34,9 @@ Default: \code{FASTRESC}} The input dataset with ATC variables added } \description{ -Add Anatomical Therapeutic Chemical class variables from \code{FACM} to \code{ADCM} +Add Anatomical Therapeutic Chemical class variables from \code{FACM} to \code{ADCM}. + +\strong{Note:} This is a wrapper function for the more generic \code{derive_vars_transposed()}. } \examples{ library(tibble) diff --git a/man/derive_vars_disposition_reason.Rd b/man/derive_vars_disposition_reason.Rd index 14a0f6dffc..ad80e2decb 100644 --- a/man/derive_vars_disposition_reason.Rd +++ b/man/derive_vars_disposition_reason.Rd @@ -115,18 +115,19 @@ The details associated with the reason for discontinuation are derived based on \code{\link[=format_reason_default]{format_reason_default()}} Other deprecated: -\code{\link{derive_derived_param}()}, -\code{\link{derive_param_first_event}()}, -\code{\link{derive_var_agegr_fda}()}, +\code{\link{derive_param_extreme_event}()}, +\code{\link{derive_var_basetype}()}, \code{\link{derive_var_confirmation_flag}()}, \code{\link{derive_var_disposition_status}()}, +\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_worst_flag}()}, -\code{\link{derive_vars_merged_dtm}()}, -\code{\link{derive_vars_merged_dt}()}, -\code{\link{filter_confirmation}()}, +\code{\link{derive_vars_last_dose}()}, \code{\link{format_eoxxstt_default}()}, -\code{\link{format_reason_default}()}, -\code{\link{vars}()} +\code{\link{format_reason_default}()} } \concept{deprecated} \keyword{deprecated} diff --git a/man/derive_vars_joined.Rd b/man/derive_vars_joined.Rd index 2b5c3bb196..0073930145 100644 --- a/man/derive_vars_joined.Rd +++ b/man/derive_vars_joined.Rd @@ -2,7 +2,8 @@ % 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} +\title{Add Variables from an Additional Dataset Based on Conditions from Both +Datasets} \usage{ derive_vars_joined( dataset, @@ -14,6 +15,7 @@ derive_vars_joined( filter_add = NULL, filter_join = NULL, mode = NULL, + missing_values = NULL, check_type = "warning" ) } @@ -43,8 +45,13 @@ 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{exprs()}, e.g., \code{exprs(ADT, desc(AVAL))} or \code{NULL}} +If an expression is named, e.g., \code{exprs(EXSTDT = convert_dtc_to_dt(EXSTDTC), EXSEQ)}, a corresponding variable (\code{EXSTDT}) is +added to the additional dataset and can be used in the filter conditions +(\code{filter_add}, \code{filter_join}) and for \code{join_vars} and \code{new_vars}. The +variable is not included in the output dataset. + +\emph{Permitted Values}: list of expressions created by \code{exprs()}, e.g., +\code{exprs(ADT, desc(AVAL))} or \code{NULL}} \item{new_vars}{Variables to add @@ -58,10 +65,15 @@ And \code{new_vars = exprs(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}. +Values of the added variables can be modified by specifying an expression. +For example, \code{new_vars = LASTRSP = exprs(str_to_upper(AVALC))} adds the +variable \code{LASTRSP} to the dataset and sets it to the upper case value of +\code{AVALC}. + 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{exprs()}} +\emph{Permitted Values}: list of variables or named expressions created by \code{exprs()}} \item{join_vars}{Variables to use from additional dataset @@ -71,9 +83,14 @@ 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. +If an expression is named, e.g., \code{exprs(EXTDT = convert_dtc_to_dt(EXSTDTC))}, a corresponding variable is added to the +additional dataset and can be used in the filter conditions (\code{filter_add}, +\code{filter_join}) and for \code{new_vars}. The variable is not included in the +output dataset. + The variables are not included in the output dataset. -\emph{Permitted Values}: list of variables created by \code{exprs()}} +\emph{Permitted Values}: list of variables or named expressions created by \code{exprs()}} \item{filter_add}{Filter for additional dataset (\code{dataset_add}) @@ -81,6 +98,9 @@ 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. +Variables created by \code{order} or \code{new_vars} arguments can be used in the +condition. + \emph{Permitted Values}: a condition} \item{filter_join}{Filter for the joined dataset @@ -88,6 +108,9 @@ observations are joined. The specified condition is applied to the joined dataset. Therefore variables from both datasets \code{dataset} and \code{dataset_add} can be used. +Variables created by \code{order} or \code{new_vars} arguments can be used in the +condition. + \emph{Permitted Values}: a condition} \item{mode}{Selection mode @@ -99,11 +122,21 @@ If the \code{order} argument is not specified, the \code{mode} argument is ignor \emph{Permitted Values}: \code{"first"}, \code{"last"}, \code{NULL}} +\item{missing_values}{Values for non-matching observations + +For observations of the input dataset (\code{dataset}) which do not have a +matching observation in the additional dataset (\code{dataset_add}) the values +of the specified variables are set to the specified value. Only variables +specified for \code{new_vars} can be specified for \code{missing_values}. + +\emph{Permitted Values}: named list of expressions, e.g., +\code{exprs(BASEC = "MISSING", BASE = -1)}} + \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. +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 @@ -125,20 +158,25 @@ 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 +\item The variables specified by \code{order} are added to the additional dataset +(\code{dataset_add}). +\item The variables specified by \code{join_vars} are added to the additional dataset +(\code{dataset_add}). +\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 +\item The variables specified for \code{new_vars} are created (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. +observation in the joined dataset the new variables are set as specified by +\code{missing_values} (or to \code{NA} for variables not in \code{missing_values}). +Observations in the additional dataset which have no matching observation in +the input dataset are ignored. } } \examples{ @@ -266,21 +304,46 @@ derive_vars_joined( join_vars = exprs(APERSDT, APEREDT), filter_join = APERSDT <= ASTDT & ASTDT <= APEREDT ) + +# Add day since last dose (LDRELD) +adae <- tribble( + ~USUBJID, ~ASTDT, ~AESEQ, + "1", "2020-02-02", 1, + "1", "2020-02-04", 2 +) \%>\% + mutate(ASTDT = ymd(ASTDT)) + +ex <- tribble( + ~USUBJID, ~EXSDTC, + "1", "2020-01-10", + "1", "2020-01", + "1", "2020-01-20", + "1", "2020-02-03" +) + +## Please note that EXSDT is created via the order argument and then used +## for new_vars, filter_add, and filter_join +derive_vars_joined( + adae, + dataset_add = ex, + by_vars = exprs(USUBJID), + order = exprs(EXSDT = convert_dtc_to_dt(EXSDTC)), + new_vars = exprs(LDRELD = compute_duration( + start_date = EXSDT, end_date = ASTDT + )), + filter_add = !is.na(EXSDT), + filter_join = EXSDT <= ASTDT, + mode = "last" +) } \seealso{ General Derivation Functions for all ADaMs that returns variable appended to dataset: \code{\link{derive_var_extreme_flag}()}, \code{\link{derive_var_joined_exist_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_vars_last_dose}()}, \code{\link{derive_vars_merged_lookup}()}, \code{\link{derive_vars_merged}()}, \code{\link{derive_vars_transposed}()}, diff --git a/man/derive_vars_last_dose.Rd b/man/derive_vars_last_dose.Rd index 25c0421d2a..a69acbbe4c 100644 --- a/man/derive_vars_last_dose.Rd +++ b/man/derive_vars_last_dose.Rd @@ -59,9 +59,13 @@ These can be either strings or symbols referring to existing variables.} Input dataset with EX source variables from last dose added. } \description{ -Add EX source variables from last dose to the input dataset. +\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_vars_joined()} instead. } \details{ +Add EX source variables from last dose to the input dataset. + When doing date comparison to identify last dose, date-time imputations are done as follows: \itemize{ \item \code{dose_date}: time is imputed to \code{00:00:00} if the variable is a date variable @@ -95,74 +99,24 @@ then join cannot be performed properly and an error is issued. To resolve the er \code{new_vars} to either keep variables unique to \code{dataset_ex}, or use this option to rename variables from \code{dataset_ex} (e.g. \code{new_vars = exprs(LSTEXVIS = VISIT)}). } -\examples{ -library(dplyr, warn.conflicts = FALSE) -library(admiral.test) -data(admiral_ae) -data(ex_single) - -# create datetime variables in input datasets -ex_single <- derive_vars_dtm( - head(ex_single, 100), - dtc = EXENDTC, - new_vars_prefix = "EXEN", - flag_imputation = "none" -) - -adae <- admiral_ae \%>\% - head(100) \%>\% - derive_vars_dtm( - dtc = AESTDTC, - new_vars_prefix = "AST", - highest_imputation = "M" - ) - -# add last dose vars -adae \%>\% - derive_vars_last_dose( - dataset_ex = ex_single, - filter_ex = (EXDOSE > 0 | (EXDOSE == 0 & grepl("PLACEBO", EXTRT))) & - !is.na(EXENDTM), - new_vars = exprs(EXDOSE, EXTRT, EXSEQ, EXENDTC, VISIT), - dose_date = EXENDTM, - analysis_date = ASTDTM - ) \%>\% - select(STUDYID, USUBJID, AESEQ, AESTDTC, EXDOSE, EXTRT, EXENDTC, EXSEQ, VISIT) - -# or with traceability variables -adae \%>\% - derive_vars_last_dose( - dataset_ex = ex_single, - filter_ex = (EXDOSE > 0 | (EXDOSE == 0 & grepl("PLACEBO", EXTRT))) & - !is.na(EXENDTM), - new_vars = exprs(EXDOSE, EXTRT, EXSEQ, EXENDTC, VISIT), - dose_date = EXENDTM, - analysis_date = ASTDTM, - traceability_vars = exprs(LDOSEDOM = "EX", LDOSESEQ = EXSEQ, LDOSEVAR = "EXENDTC") - ) \%>\% - select(STUDYID, USUBJID, AESEQ, AESTDTC, EXDOSE, EXTRT, EXENDTC, LDOSEDOM, LDOSESEQ, LDOSEVAR) -} \seealso{ \code{\link[=derive_var_last_dose_amt]{derive_var_last_dose_amt()}}, \code{\link[=derive_var_last_dose_date]{derive_var_last_dose_date()}}, \code{\link[=derive_var_last_dose_grp]{derive_var_last_dose_grp()}}, \code{\link[=create_single_dose_dataset]{create_single_dose_dataset()}} -General Derivation Functions for all ADaMs that returns variable appended to dataset: -\code{\link{derive_var_extreme_flag}()}, -\code{\link{derive_var_joined_exist_flag}()}, +Other deprecated: +\code{\link{derive_param_extreme_event}()}, +\code{\link{derive_var_basetype}()}, +\code{\link{derive_var_confirmation_flag}()}, +\code{\link{derive_var_disposition_status}()}, \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_vars_joined}()}, -\code{\link{derive_vars_merged_lookup}()}, -\code{\link{derive_vars_merged}()}, -\code{\link{derive_vars_transposed}()}, -\code{\link{get_summary_records}()} +\code{\link{derive_var_worst_flag}()}, +\code{\link{derive_vars_disposition_reason}()}, +\code{\link{format_eoxxstt_default}()}, +\code{\link{format_reason_default}()} } -\concept{der_gen} -\keyword{der_gen} +\concept{deprecated} +\keyword{deprecated} diff --git a/man/derive_vars_merged.Rd b/man/derive_vars_merged.Rd index 0f94355b99..78e415ce4d 100644 --- a/man/derive_vars_merged.Rd +++ b/man/derive_vars_merged.Rd @@ -11,9 +11,10 @@ derive_vars_merged( by_vars, order = NULL, new_vars = NULL, - mode = NULL, filter_add = NULL, + mode = NULL, match_flag = NULL, + missing_values = NULL, check_type = "warning", duplicate_msg = NULL ) @@ -44,10 +45,10 @@ 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. -\emph{Default}: \code{NULL} +Variables defined by the \code{new_vars} argument can be used in the sort order. -\emph{Permitted Values}: list of variables or \verb{desc()} function calls -created by \code{exprs()}, e.g., \code{exprs(ADT, desc(AVAL))} or \code{NULL}} +\emph{Permitted Values}: list of expressions created by \code{exprs()}, e.g., +\code{exprs(ADT, desc(AVAL))} or \code{NULL}} \item{new_vars}{Variables to add @@ -61,12 +62,26 @@ And \code{new_vars = exprs(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}. +Values of the added variables can be modified by specifying an expression. +For example, \code{new_vars = LASTRSP = exprs(str_to_upper(AVALC))} adds the +variable \code{LASTRSP} to the dataset and sets it to the upper case value of +\code{AVALC}. + 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} +\emph{Permitted Values}: list of variables or named expressions created by \code{exprs()}} -\emph{Permitted Values}: list of variables created by \code{exprs()}} +\item{filter_add}{Filter for additional dataset (\code{dataset_add}) + +Only observations fulfilling the specified condition are taken into account +for merging. If the argument is not specified, all observations are +considered. + +Variables defined by the \code{new_vars} argument can be used in the filter +condition. + +\emph{Permitted Values}: a condition} \item{mode}{Selection mode @@ -75,20 +90,8 @@ argument is specified, \code{mode} must be non-null. If the \code{order} argument is not specified, the \code{mode} argument is ignored. -\emph{Default}: \code{NULL} - \emph{Permitted Values}: \code{"first"}, \code{"last"}, \code{NULL}} -\item{filter_add}{Filter for additional dataset (\code{dataset_add}) - -Only observations fulfilling the specified condition are taken into account -for merging. If the argument is not specified, all observations are -considered. - -\emph{Default}: \code{NULL} - -\emph{Permitted Values}: a condition} - \item{match_flag}{Match flag If the argument is specified (e.g., \code{match_flag = FLAG}), the specified @@ -96,18 +99,24 @@ 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. -\emph{Default}: \code{NULL} - \emph{Permitted Values}: Variable name} +\item{missing_values}{Values for non-matching observations + +For observations of the input dataset (\code{dataset}) which do not have a +matching observation in the additional dataset (\code{dataset_add}) the values +of the specified variables are set to the specified value. Only variables +specified for \code{new_vars} can be specified for \code{missing_values}. + +\emph{Permitted Values}: named list of expressions, e.g., +\code{exprs(BASEC = "MISSING", BASE = -1)}} + \item{check_type}{Check uniqueness? If \code{"warning"} or \code{"error"} is specified, the specified message is issued if the observations of the (restricted) additional dataset are not unique with respect to the by variables and the order. -\emph{Default}: \code{"warning"} - \emph{Permitted Values}: \code{"none"}, \code{"warning"}, \code{"error"}} \item{duplicate_msg}{Message of unique check @@ -133,39 +142,71 @@ each by group (\code{order} and \code{mode} argument). } \details{ \enumerate{ +\item The new variables (\code{new_vars}) are added to the additional dataset +(\code{dataset_add}). \item The records from the additional dataset (\code{dataset_add}) are restricted to those matching the \code{filter_add} condition. \item If \code{order} is specified, for each by group 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 using \code{left_join()}. I.e., the output dataset -contains all observations from the input dataset. For observations without -a matching observation in the additional 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. +\item The variables specified for \code{new_vars} are merged to the input dataset +using \code{left_join()}. I.e., the output dataset contains all observations +from the input dataset. For observations without a matching observation in +the additional dataset the new variables are set as specified by +\code{missing_values} (or to \code{NA} for variables not in \code{missing_values}). +Observations in the additional dataset which have no matching observation +in the input dataset are ignored. } } \examples{ -library(admiral.test) library(dplyr, warn.conflicts = FALSE) -data("admiral_vs") -data("admiral_dm") +vs <- tribble( + ~STUDYID, ~DOMAIN, ~USUBJID, ~VSTESTCD, ~VISIT, ~VSSTRESN, ~VSSTRESU, ~VSDTC, + "PILOT01", "VS", "01-1302", "HEIGHT", "SCREENING", 177.8, "cm", "2013-08-20", + "PILOT01", "VS", "01-1302", "WEIGHT", "SCREENING", 81.19, "kg", "2013-08-20", + "PILOT01", "VS", "01-1302", "WEIGHT", "BASELINE", 82.1, "kg", "2013-08-29", + "PILOT01", "VS", "01-1302", "WEIGHT", "WEEK 2", 81.19, "kg", "2013-09-15", + "PILOT01", "VS", "01-1302", "WEIGHT", "WEEK 4", 82.56, "kg", "2013-09-24", + "PILOT01", "VS", "01-1302", "WEIGHT", "WEEK 6", 80.74, "kg", "2013-10-08", + "PILOT01", "VS", "01-1302", "WEIGHT", "WEEK 8", 82.1, "kg", "2013-10-22", + "PILOT01", "VS", "01-1302", "WEIGHT", "WEEK 12", 82.1, "kg", "2013-11-05", + "PILOT01", "VS", "17-1344", "HEIGHT", "SCREENING", 163.5, "cm", "2014-01-01", + "PILOT01", "VS", "17-1344", "WEIGHT", "SCREENING", 58.06, "kg", "2014-01-01", + "PILOT01", "VS", "17-1344", "WEIGHT", "BASELINE", 58.06, "kg", "2014-01-11", + "PILOT01", "VS", "17-1344", "WEIGHT", "WEEK 2", 58.97, "kg", "2014-01-24", + "PILOT01", "VS", "17-1344", "WEIGHT", "WEEK 4", 57.97, "kg", "2014-02-07", + "PILOT01", "VS", "17-1344", "WEIGHT", "WEEK 6", 58.97, "kg", "2014-02-19", + "PILOT01", "VS", "17-1344", "WEIGHT", "WEEK 8", 57.79, "kg", "2014-03-14" +) + +dm <- tribble( + ~STUDYID, ~DOMAIN, ~USUBJID, ~AGE, ~AGEU, + "PILOT01", "DM", "01-1302", 61, "YEARS", + "PILOT01", "DM", "17-1344", 64, "YEARS" +) + # Merging all dm variables to vs derive_vars_merged( - admiral_vs, - dataset_add = select(admiral_dm, -DOMAIN), + vs, + dataset_add = select(dm, -DOMAIN), by_vars = exprs(STUDYID, USUBJID) ) \%>\% - select(STUDYID, USUBJID, VSTESTCD, VISIT, VSTPT, VSSTRESN, AGE, AGEU) + select(STUDYID, USUBJID, VSTESTCD, VISIT, VSSTRESN, AGE, AGEU) + # Merge last weight to adsl -data("admiral_adsl") +adsl <- tribble( + ~STUDYID, ~USUBJID, ~AGE, ~AGEU, + "PILOT01", "01-1302", 61, "YEARS", + "PILOT01", "17-1344", 64, "YEARS" +) + + derive_vars_merged( - admiral_adsl, - dataset_add = admiral_vs, + adsl, + dataset_add = vs, by_vars = exprs(STUDYID, USUBJID), - order = exprs(VSDTC), + order = exprs(convert_dtc_to_dtm(VSDTC)), mode = "last", new_vars = exprs(LASTWGT = VSSTRESN, LASTWGTU = VSSTRESU), filter_add = VSTESTCD == "WEIGHT", @@ -173,43 +214,26 @@ derive_vars_merged( ) \%>\% select(STUDYID, USUBJID, AGE, AGEU, LASTWGT, LASTWGTU, vsdatafl) -# Derive treatment start datetime (TRTSDTM) -data(admiral_ex) - -## Impute exposure start date to first date/time -ex_ext <- derive_vars_dtm( - admiral_ex, - dtc = EXSTDTC, - new_vars_prefix = "EXST", - highest_imputation = "M", -) - -## Add first exposure datetime and imputation flags to adsl -derive_vars_merged( - select(admiral_dm, STUDYID, USUBJID), - dataset_add = ex_ext, - by_vars = exprs(STUDYID, USUBJID), - new_vars = exprs(TRTSDTM = EXSTDTM, TRTSDTF = EXSTDTF, TRTSTMF = EXSTTMF), - order = exprs(EXSTDTM), - mode = "first" -) # Derive treatment start datetime (TRTSDTM) -data(admiral_ex) - +ex <- tribble( + ~STUDYID, ~DOMAIN, ~USUBJID, ~EXSTDY, ~EXENDY, ~EXSTDTC, ~EXENDTC, + "PILOT01", "EX", "01-1302", 1, 18, "2013-08-29", "2013-09-15", + "PILOT01", "EX", "01-1302", 19, 69, "2013-09-16", "2013-11-05", + "PILOT01", "EX", "17-1344", 1, 14, "2014-01-11", "2014-01-24", + "PILOT01", "EX", "17-1344", 15, 63, "2014-01-25", "2014-03-14" +) ## Impute exposure start date to first date/time ex_ext <- derive_vars_dtm( - admiral_ex, + ex, dtc = EXSTDTC, new_vars_prefix = "EXST", highest_imputation = "M", ) - ## Add first exposure datetime and imputation flags to adsl derive_vars_merged( - select(admiral_dm, STUDYID, USUBJID), + select(dm, STUDYID, USUBJID), dataset_add = ex_ext, - filter_add = !is.na(EXSTDTM), by_vars = exprs(STUDYID, USUBJID), new_vars = exprs(TRTSDTM = EXSTDTM, TRTSDTF = EXSTDTF, TRTSTMF = EXSTTMF), order = exprs(EXSTDTM), @@ -219,15 +243,14 @@ derive_vars_merged( # Derive treatment end datetime (TRTEDTM) ## Impute exposure end datetime to last time, no date imputation ex_ext <- derive_vars_dtm( - admiral_ex, + ex, dtc = EXENDTC, new_vars_prefix = "EXEN", time_imputation = "last", ) - ## Add last exposure datetime and imputation flag to adsl derive_vars_merged( - select(admiral_dm, STUDYID, USUBJID), + select(adsl, STUDYID, USUBJID), dataset_add = ex_ext, filter_add = !is.na(EXENDTM), by_vars = exprs(STUDYID, USUBJID), @@ -235,22 +258,45 @@ derive_vars_merged( order = exprs(EXENDTM), mode = "last" ) +# Modify merged values and set value for non matching observations +adsl <- tribble( + ~USUBJID, ~SEX, ~COUNTRY, + "ST42-1", "F", "AUT", + "ST42-2", "M", "MWI", + "ST42-3", "M", "NOR", + "ST42-4", "F", "UGA" +) + +advs <- tribble( + ~USUBJID, ~PARAMCD, ~AVISIT, ~AVISITN, ~AVAL, + "ST42-1", "WEIGHT", "BASELINE", 0, 66, + "ST42-1", "WEIGHT", "WEEK 2", 1, 68, + "ST42-2", "WEIGHT", "BASELINE", 0, 88, + "ST42-3", "WEIGHT", "WEEK 2", 1, 55, + "ST42-3", "WEIGHT", "WEEK 4", 2, 50 +) + +derive_vars_merged( + adsl, + dataset_add = advs, + by_vars = exprs(USUBJID), + new_vars = exprs( + LSTVSCAT = if_else(AVISIT == "BASELINE", "BASELINE", "POST-BASELINE") + ), + order = exprs(AVISITN), + mode = "last", + missing_values = exprs(LSTVSCAT = "MISSING") +) } \seealso{ General Derivation Functions for all ADaMs that returns variable appended to dataset: \code{\link{derive_var_extreme_flag}()}, \code{\link{derive_var_joined_exist_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_vars_joined}()}, -\code{\link{derive_vars_last_dose}()}, \code{\link{derive_vars_merged_lookup}()}, \code{\link{derive_vars_transposed}()}, \code{\link{get_summary_records}()} diff --git a/man/derive_vars_merged_dt.Rd b/man/derive_vars_merged_dt.Rd deleted file mode 100644 index 561690992f..0000000000 --- a/man/derive_vars_merged_dt.Rd +++ /dev/null @@ -1,226 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/derive_merged.R -\name{derive_vars_merged_dt} -\alias{derive_vars_merged_dt} -\title{Merge a (Imputed) Date Variable} -\usage{ -derive_vars_merged_dt( - dataset, - dataset_add, - by_vars, - order = NULL, - new_vars_prefix, - filter_add = NULL, - mode = NULL, - dtc, - date_imputation = NULL, - flag_imputation = "auto", - min_dates = NULL, - max_dates = NULL, - preserve = FALSE, - check_type = "warning", - duplicate_msg = NULL -) -} -\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}, the \code{dtc}, and the \code{order} -argument are expected.} - -\item{by_vars}{Grouping variables - -The input dataset and the selected observations from the additional dataset -are merged by the specified by variables. The by variables must be a unique -key of the selected observations. Variables from the additional dataset can -be renamed by naming the element, i.e., \verb{by_vars = exprs( = )}, similar to -the dplyr joins. - -\emph{Permitted Values}: list of variables created by \code{exprs()}} - -\item{order}{Sort order - -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). - -Please note that \code{NA} is considered as the last value. I.e., if a order -variable is \code{NA} and \code{mode = "last"}, this observation is chosen while for -\code{mode = "first"} the observation is chosen only if there are no -observations where the variable is not 'NA'. - -\emph{Default}: \code{NULL} - -\emph{Permitted Values}: list of variables or \verb{desc()} function calls -created by \code{exprs()}, e.g., \verb{exprs(ADT, desc(AVAL)} or \code{NULL}} - -\item{new_vars_prefix}{Prefix used for the output variable(s). - -A character scalar is expected. For the date variable "DT" is appended to -the specified prefix and for the date imputation flag "DTF". I.e., for -\code{new_vars_prefix = "AST"} the variables \code{ASTDT} and \code{ASTDTF} are created.} - -\item{filter_add}{Filter for additional dataset (\code{dataset_add}) - -Only observations fulfilling the specified condition are taken into account -for merging. If the argument is not specified, all observations are -considered. - -\emph{Default}: \code{NULL} - -\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{Default}: \code{NULL} - -\emph{Permitted Values}: \code{"first"}, \code{"last"}, \code{NULL}} - -\item{dtc}{The \code{'--DTC'} date to impute - -A character date is expected in a format like \code{yyyy-mm-dd} or -\code{yyyy-mm-ddThh:mm:ss}. Trailing components can be omitted and \code{-} is a -valid "missing" value for any component.} - -\item{date_imputation}{The value to impute the day/month when a datepart is -missing. - -A character value is expected, either as a -\itemize{ -\item format with month and day specified as \code{"mm-dd"}: e.g. \code{"06-15"} for the -15th of June (The year can not be specified; for imputing the year -\code{"first"} or \code{"last"} together with \code{min_dates} or \code{max_dates} argument can -be used (see examples).), -\item or as a keyword: \code{"first"}, \code{"mid"}, \code{"last"} to impute to the first/mid/last -day/month. -} - -The argument is ignored if \code{highest_imputation} is less then \code{"D"}. - -\emph{Default}: \code{"first"}} - -\item{flag_imputation}{Whether the date imputation flag must also be derived. - -If \code{"auto"} is specified, the date imputation flag is derived if the -\code{date_imputation} argument is not null. - -\emph{Default}: \code{"auto"} - -\emph{Permitted Values}: \code{"auto"}, \code{"date"} or \code{"none"}} - -\item{min_dates}{Minimum dates - -A list of dates is expected. It is ensured that the imputed date is not -before any of the specified dates, e.g., that the imputed adverse event start -date is not before the first treatment date. Only dates which are in the -range of possible dates of the \code{dtc} value are considered. The possible dates -are defined by the missing parts of the \code{dtc} date (see example below). This -ensures that the non-missing parts of the \code{dtc} date are not changed. -A date or date-time object is expected. -For example - -\if{html}{\out{
}}\preformatted{impute_dtc_dtm( - "2020-11", - min_dates = list( - ymd_hms("2020-12-06T12:12:12"), - ymd_hms("2020-11-11T11:11:11") - ), - highest_imputation = "M" -) -}\if{html}{\out{
}} - -returns \code{"2020-11-11T11:11:11"} because the possible dates for \code{"2020-11"} -range from \code{"2020-11-01T00:00:00"} to \code{"2020-11-30T23:59:59"}. Therefore -\code{"2020-12-06T12:12:12"} is ignored. Returning \code{"2020-12-06T12:12:12"} would -have changed the month although it is not missing (in the \code{dtc} date).} - -\item{max_dates}{Maximum dates - -A list of dates is expected. It is ensured that the imputed date is not after -any of the specified dates, e.g., that the imputed date is not after the data -cut off date. Only dates which are in the range of possible dates are -considered. A date or date-time object is expected.} - -\item{preserve}{Preserve day if month is missing and day is present - -For example \code{"2019---07"} would return \verb{"2019-06-07} if \code{preserve = TRUE} -(and \code{date_imputation = "MID"}). - -Permitted Values: \code{TRUE}, \code{FALSE} - -Default: \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 (restricted) additional dataset are not unique -with respect to the by variables and the order. - -\emph{Default}: \code{"warning"} - -\emph{Permitted Values}: \code{"none"}, \code{"warning"}, \code{"error"}} - -\item{duplicate_msg}{Message of unique check - -If the uniqueness check fails, the specified message is displayed. - -\emph{Default}: - -\if{html}{\out{
}}\preformatted{paste("Dataset `dataset_add` contains duplicate records with respect to", - enumerate(vars2chr(by_vars))) -}\if{html}{\out{
}}} -} -\value{ -The output dataset contains all observations and variables of the -input dataset and additionally the variable \verb{DT} and -optionally the variable \verb{DTF} derived from the additional -dataset (\code{dataset_add}). -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} - -This function is \emph{deprecated}, please use \code{derive_vars_dt()} and -\code{derive_vars_merged()} instead. - -Merge a imputed date variable and date imputation flag from a dataset to the -input dataset. The observations to merge can be selected by a condition -and/or selecting the first or last observation for each by group. -} -\details{ -\enumerate{ -\item The additional dataset is restricted to the observations matching the -\code{filter_add} condition. -\item The date variable and if requested, the date imputation flag is added to -the additional dataset. -\item If \code{order} is specified, for each by group the first or last observation -(depending on \code{mode}) is selected. -\item The date and flag variables are merged to the input dataset. -} -} -\seealso{ -Other deprecated: -\code{\link{derive_derived_param}()}, -\code{\link{derive_param_first_event}()}, -\code{\link{derive_var_agegr_fda}()}, -\code{\link{derive_var_confirmation_flag}()}, -\code{\link{derive_var_disposition_status}()}, -\code{\link{derive_var_worst_flag}()}, -\code{\link{derive_vars_disposition_reason}()}, -\code{\link{derive_vars_merged_dtm}()}, -\code{\link{filter_confirmation}()}, -\code{\link{format_eoxxstt_default}()}, -\code{\link{format_reason_default}()}, -\code{\link{vars}()} -} -\concept{deprecated} -\keyword{deprecated} diff --git a/man/derive_vars_merged_dtm.Rd b/man/derive_vars_merged_dtm.Rd deleted file mode 100644 index 8d10c0333c..0000000000 --- a/man/derive_vars_merged_dtm.Rd +++ /dev/null @@ -1,247 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/derive_merged.R -\name{derive_vars_merged_dtm} -\alias{derive_vars_merged_dtm} -\title{Merge a (Imputed) Datetime Variable} -\usage{ -derive_vars_merged_dtm( - dataset, - dataset_add, - by_vars, - order = NULL, - new_vars_prefix, - filter_add = NULL, - mode = NULL, - dtc, - date_imputation = NULL, - time_imputation = "00:00:00", - flag_imputation = "auto", - min_dates = NULL, - max_dates = NULL, - preserve = FALSE, - check_type = "warning", - duplicate_msg = NULL -) -} -\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}, the \code{dtc}, and the \code{order} -argument are expected.} - -\item{by_vars}{Grouping variables - -The input dataset and the selected observations from the additional dataset -are merged by the specified by variables. The by variables must be a unique -key of the selected observations. Variables from the additional dataset can -be renamed by naming the element, i.e., \verb{by_vars = exprs( = )}, similar to -the dplyr joins. - -\emph{Permitted Values}: list of variables created by \code{exprs()}} - -\item{order}{Sort order - -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). - -\emph{Default}: \code{NULL} - -\emph{Permitted Values}: list of variables or \verb{desc()} function calls -created by \code{exprs()}, e.g., \verb{exprs(ADT, desc(AVAL)} or \code{NULL}} - -\item{new_vars_prefix}{Prefix used for the output variable(s). - -A character scalar is expected. For the date variable "DT" is appended to -the specified prefix, for the date imputation flag "DTF", and for the time -imputation flag "TMF". I.e., for \code{new_vars_prefix = "AST"} the variables -\code{ASTDT}, \code{ASTDTF}, and \code{ASTTMF} are created.} - -\item{filter_add}{Filter for additional dataset (\code{dataset_add}) - -Only observations fulfilling the specified condition are taken into account -for merging. If the argument is not specified, all observations are -considered. - -\emph{Default}: \code{NULL} - -\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{Default}: \code{NULL} - -\emph{Permitted Values}: \code{"first"}, \code{"last"}, \code{NULL}} - -\item{dtc}{The \code{'--DTC'} date to impute - -A character date is expected in a format like \code{yyyy-mm-dd} or -\code{yyyy-mm-ddThh:mm:ss}. Trailing components can be omitted and \code{-} is a -valid "missing" value for any component.} - -\item{date_imputation}{The value to impute the day/month when a datepart is -missing. - -A character value is expected, either as a -\itemize{ -\item format with month and day specified as \code{"mm-dd"}: e.g. \code{"06-15"} for the -15th of June (The year can not be specified; for imputing the year -\code{"first"} or \code{"last"} together with \code{min_dates} or \code{max_dates} argument can -be used (see examples).), -\item or as a keyword: \code{"first"}, \code{"mid"}, \code{"last"} to impute to the first/mid/last -day/month. -} - -The argument is ignored if \code{highest_imputation} is less then \code{"D"}. - -\emph{Default}: \code{"first"}.} - -\item{time_imputation}{The value to impute the time when a timepart is -missing. - -A character value is expected, either as a -\itemize{ -\item format with hour, min and sec specified as \code{"hh:mm:ss"}: e.g. \code{"00:00:00"} -for the start of the day, -\item or as a keyword: \code{"first"},\code{"last"} to impute to the start/end of a day. -} - -The argument is ignored if \code{highest_imputation = "n"}. - -\emph{Default}: \code{"first"}.} - -\item{flag_imputation}{Whether the date/time imputation flag(s) must also be derived. - -If \code{"auto"} is specified, the date imputation flag is derived if the -\code{date_imputation} argument is not null and the time imputation flag is -derived if the \code{time_imputation} argument is not null - -\emph{Default}: \code{"auto"} - -\emph{Permitted Values}: \code{"auto"}, \code{"date"}, \code{"time"}, \code{"both"}, or \code{"none"}} - -\item{min_dates}{Minimum dates - -A list of dates is expected. It is ensured that the imputed date is not -before any of the specified dates, e.g., that the imputed adverse event start -date is not before the first treatment date. Only dates which are in the -range of possible dates of the \code{dtc} value are considered. The possible dates -are defined by the missing parts of the \code{dtc} date (see example below). This -ensures that the non-missing parts of the \code{dtc} date are not changed. -A date or date-time object is expected. -For example - -\if{html}{\out{
}}\preformatted{impute_dtc_dtm( - "2020-11", - min_dates = list( - ymd_hms("2020-12-06T12:12:12"), - ymd_hms("2020-11-11T11:11:11") - ), - highest_imputation = "M" -) -}\if{html}{\out{
}} - -returns \code{"2020-11-11T11:11:11"} because the possible dates for \code{"2020-11"} -range from \code{"2020-11-01T00:00:00"} to \code{"2020-11-30T23:59:59"}. Therefore -\code{"2020-12-06T12:12:12"} is ignored. Returning \code{"2020-12-06T12:12:12"} would -have changed the month although it is not missing (in the \code{dtc} date). - -For date variables (not datetime) in the list the time is imputed to -\code{"00:00:00"}. Specifying date variables makes sense only if the date is -imputed. If only time is imputed, date variables do not affect the result.} - -\item{max_dates}{Maximum dates - -A list of dates is expected. It is ensured that the imputed date is not after -any of the specified dates, e.g., that the imputed date is not after the data -cut off date. Only dates which are in the range of possible dates are -considered. A date or date-time object is expected. - -For date variables (not datetime) in the list the time is imputed to -\code{"23:59:59"}. Specifying date variables makes sense only if the date is -imputed. If only time is imputed, date variables do not affect the result.} - -\item{preserve}{Preserve day if month is missing and day is present - -For example \code{"2019---07"} would return \verb{"2019-06-07} if \code{preserve = TRUE} -(and \code{date_imputation = "mid"}). - -Permitted Values: \code{TRUE}, \code{FALSE} - -\emph{Default}: \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 (restricted) additional dataset are not unique -with respect to the by variables and the order. - -\emph{Default}: \code{"warning"} - -\emph{Permitted Values}: \code{"none"}, \code{"warning"}, \code{"error"}} - -\item{duplicate_msg}{Message of unique check - -If the uniqueness check fails, the specified message is displayed. - -\emph{Default}: - -\if{html}{\out{
}}\preformatted{paste("Dataset `dataset_add` contains duplicate records with respect to", - enumerate(vars2chr(by_vars))) -}\if{html}{\out{
}}} -} -\value{ -The output dataset contains all observations and variables of the -input dataset and additionally the variable \verb{DT} and -optionally the variables \verb{DTF} and \verb{TMF} -derived from the additional dataset (\code{dataset_add}). -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} - -This function is \emph{deprecated}, please use \code{derive_vars_dtm()} and -\code{derive_vars_merged()} instead. - -Merge a imputed datetime variable, date imputation flag, and time imputation -flag from a dataset to the input dataset. The observations to merge can be -selected by a condition and/or selecting the first or last observation for -each by group. -} -\details{ -\enumerate{ -\item The additional dataset is restricted to the observations matching the -\code{filter_add} condition. -\item The datetime variable and if requested, the date imputation flag and -time imputation flag is added to the additional dataset. -\item If \code{order} is specified, for each by group the first or last observation -(depending on \code{mode}) is selected. -\item The date and flag variables are merged to the input dataset. -} -} -\seealso{ -Other deprecated: -\code{\link{derive_derived_param}()}, -\code{\link{derive_param_first_event}()}, -\code{\link{derive_var_agegr_fda}()}, -\code{\link{derive_var_confirmation_flag}()}, -\code{\link{derive_var_disposition_status}()}, -\code{\link{derive_var_worst_flag}()}, -\code{\link{derive_vars_disposition_reason}()}, -\code{\link{derive_vars_merged_dt}()}, -\code{\link{filter_confirmation}()}, -\code{\link{format_eoxxstt_default}()}, -\code{\link{format_reason_default}()}, -\code{\link{vars}()} -} -\concept{deprecated} -\keyword{deprecated} diff --git a/man/derive_vars_merged_lookup.Rd b/man/derive_vars_merged_lookup.Rd index 5c4c7e9477..80761151a2 100644 --- a/man/derive_vars_merged_lookup.Rd +++ b/man/derive_vars_merged_lookup.Rd @@ -42,10 +42,10 @@ 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. -\emph{Default}: \code{NULL} +Variables defined by the \code{new_vars} argument can be used in the sort order. -\emph{Permitted Values}: list of variables or \verb{desc()} function calls -created by \code{exprs()}, e.g., \code{exprs(ADT, desc(AVAL))} or \code{NULL}} +\emph{Permitted Values}: list of expressions created by \code{exprs()}, e.g., +\code{exprs(ADT, desc(AVAL))} or \code{NULL}} \item{new_vars}{Variables to add @@ -59,12 +59,15 @@ And \code{new_vars = exprs(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}. +Values of the added variables can be modified by specifying an expression. +For example, \code{new_vars = LASTRSP = exprs(str_to_upper(AVALC))} adds the +variable \code{LASTRSP} to the dataset and sets it to the upper case value of +\code{AVALC}. + 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} - -\emph{Permitted Values}: list of variables created by \code{exprs()}} +\emph{Permitted Values}: list of variables or named expressions created by \code{exprs()}} \item{mode}{Selection mode @@ -73,8 +76,6 @@ argument is specified, \code{mode} must be non-null. If the \code{order} argument is not specified, the \code{mode} argument is ignored. -\emph{Default}: \code{NULL} - \emph{Permitted Values}: \code{"first"}, \code{"last"}, \code{NULL}} \item{filter_add}{Filter for additional dataset (\code{dataset_add}) @@ -83,7 +84,8 @@ Only observations fulfilling the specified condition are taken into account for merging. If the argument is not specified, all observations are considered. -\emph{Default}: \code{NULL} +Variables defined by the \code{new_vars} argument can be used in the filter +condition. \emph{Permitted Values}: a condition} @@ -93,8 +95,6 @@ If \code{"warning"} or \code{"error"} is specified, the specified message is iss if the observations of the (restricted) additional dataset are not unique with respect to the by variables and the order. -\emph{Default}: \code{"warning"} - \emph{Permitted Values}: \code{"none"}, \code{"warning"}, \code{"error"}} \item{duplicate_msg}{Message of unique check @@ -127,25 +127,48 @@ list of records from the input dataset that do not have corresponding mapping from the lookup table. } \examples{ -library(admiral.test) -library(tibble) library(dplyr, warn.conflicts = FALSE) -data("admiral_vs") +vs <- tribble( + ~STUDYID, ~DOMAIN, ~USUBJID, ~VISIT, ~VSTESTCD, ~VSTEST, + "PILOT01", "VS", "01-1028", "SCREENING", "HEIGHT", "Height", + "PILOT01", "VS", "01-1028", "SCREENING", "TEMP", "Temperature", + "PILOT01", "VS", "01-1028", "BASELINE", "TEMP", "Temperature", + "PILOT01", "VS", "01-1028", "WEEK 4", "TEMP", "Temperature", + "PILOT01", "VS", "01-1028", "SCREENING 1", "WEIGHT", "Weight", + "PILOT01", "VS", "01-1028", "BASELINE", "WEIGHT", "Weight", + "PILOT01", "VS", "01-1028", "WEEK 4", "WEIGHT", "Weight", + "PILOT01", "VS", "04-1325", "SCREENING", "HEIGHT", "Height", + "PILOT01", "VS", "04-1325", "SCREENING", "TEMP", "Temperature", + "PILOT01", "VS", "04-1325", "BASELINE", "TEMP", "Temperature", + "PILOT01", "VS", "04-1325", "WEEK 4", "TEMP", "Temperature", + "PILOT01", "VS", "04-1325", "SCREENING 1", "WEIGHT", "Weight", + "PILOT01", "VS", "04-1325", "BASELINE", "WEIGHT", "Weight", + "PILOT01", "VS", "04-1325", "WEEK 4", "WEIGHT", "Weight", + "PILOT01", "VS", "10-1027", "SCREENING", "HEIGHT", "Height", + "PILOT01", "VS", "10-1027", "SCREENING", "TEMP", "Temperature", + "PILOT01", "VS", "10-1027", "BASELINE", "TEMP", "Temperature", + "PILOT01", "VS", "10-1027", "WEEK 4", "TEMP", "Temperature", + "PILOT01", "VS", "10-1027", "SCREENING 1", "WEIGHT", "Weight", + "PILOT01", "VS", "10-1027", "BASELINE", "WEIGHT", "Weight", + "PILOT01", "VS", "10-1027", "WEEK 4", "WEIGHT", "Weight" +) + param_lookup <- tribble( - ~VSTESTCD, ~VSTEST, ~PARAMCD, ~PARAM, - "SYSBP", "Systolic Blood Pressure", "SYSBP", "Systolic Blood Pressure (mmHg)", - "WEIGHT", "Weight", "WEIGHT", "Weight (kg)", - "HEIGHT", "Height", "HEIGHT", "Height (cm)", - "TEMP", "Temperature", "TEMP", "Temperature (C)", - "MAP", "Mean Arterial Pressure", "MAP", "Mean Arterial Pressure (mmHg)", - "BMI", "Body Mass Index", "BMI", "Body Mass Index(kg/m^2)", - "BSA", "Body Surface Area", "BSA", "Body Surface Area(m^2)" + ~VSTESTCD, ~VSTEST, ~PARAMCD, ~PARAM, + "SYSBP", "Systolic Blood Pressure", "SYSBP", "Syst Blood Pressure (mmHg)", + "WEIGHT", "Weight", "WEIGHT", "Weight (kg)", + "HEIGHT", "Height", "HEIGHT", "Height (cm)", + "TEMP", "Temperature", "TEMP", "Temperature (C)", + "MAP", "Mean Arterial Pressure", "MAP", "Mean Art Pressure (mmHg)", + "BMI", "Body Mass Index", "BMI", "Body Mass Index(kg/m^2)", + "BSA", "Body Surface Area", "BSA", "Body Surface Area(m^2)" ) + derive_vars_merged_lookup( - dataset = admiral_vs, + dataset = vs, dataset_add = param_lookup, by_vars = exprs(VSTESTCD), - new_vars = exprs(PARAMCD), + new_vars = exprs(PARAMCD, PARAM), print_not_mapped = TRUE ) } @@ -153,17 +176,11 @@ derive_vars_merged_lookup( General Derivation Functions for all ADaMs that returns variable appended to dataset: \code{\link{derive_var_extreme_flag}()}, \code{\link{derive_var_joined_exist_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_vars_joined}()}, -\code{\link{derive_vars_last_dose}()}, \code{\link{derive_vars_merged}()}, \code{\link{derive_vars_transposed}()}, \code{\link{get_summary_records}()} diff --git a/man/derive_vars_query.Rd b/man/derive_vars_query.Rd index d0bf13f4e5..16a91bd87c 100644 --- a/man/derive_vars_query.Rd +++ b/man/derive_vars_query.Rd @@ -9,9 +9,9 @@ derive_vars_query(dataset, dataset_queries) \arguments{ \item{dataset}{Input dataset.} -\item{dataset_queries}{A dataset containing required columns \code{VAR_PREFIX}, -\code{QUERY_NAME}, \code{TERM_LEVEL}, \code{TERM_NAME}, \code{TERM_ID}, and optional columns -\code{QUERY_ID}, \code{QUERY_SCOPE}, \code{QUERY_SCOPE_NUM}. +\item{dataset_queries}{A dataset containing required columns \code{PREFIX}, +\code{GRPNAME}, \code{SRCVAR}, \code{TERMNAME}, \code{TERMID}, and optional columns +\code{GRPID}, \code{SCOPE}, \code{SCOPEN}. The content of the dataset will be verified by \code{\link[=assert_valid_queries]{assert_valid_queries()}}. @@ -34,20 +34,20 @@ A query dataset is expected as an input to this function. See the \href{../articles/queries_dataset.html}{Queries Dataset Documentation vignette} for descriptions, or call \code{data("queries")} for an example of a query dataset. -For each unique element in \code{VAR_PREFIX}, the corresponding "NAM" -variable will be created. For each unique \code{VAR_PREFIX}, if \code{QUERY_ID} is +For each unique element in \code{PREFIX}, the corresponding "NAM" +variable will be created. For each unique \code{PREFIX}, if \code{GRPID} is not "" or NA, then the corresponding "CD" variable is created; similarly, -if \code{QUERY_SCOPE} is not "" or NA, then the corresponding "SC" variable will -be created; if \code{QUERY_SCOPE_NUM} is not "" or NA, then the corresponding +if \code{SCOPE} is not "" or NA, then the corresponding "SC" variable will +be created; if \code{SCOPEN} is not "" or NA, then the corresponding "SCN" variable will be created. For each record in \code{dataset}, the "NAM" variable takes the value of -\code{QUERY_NAME} if the value of \code{TERM_NAME} or \code{TERM_ID} in \code{dataset_queries} matches -the value of the respective TERM_LEVEL in \code{dataset}. -Note that \code{TERM_NAME} in \code{dataset_queries} dataset may be NA only when \code{TERM_ID} +\code{GRPNAME} if the value of \code{TERMNAME} or \code{TERMID} in \code{dataset_queries} matches +the value of the respective SRCVAR in \code{dataset}. +Note that \code{TERMNAME} in \code{dataset_queries} dataset may be NA only when \code{TERMID} is non-NA and vice versa. The "CD", "SC", and "SCN" variables are derived accordingly based on -\code{QUERY_ID}, \code{QUERY_SCOPE}, and \code{QUERY_SCOPE_NUM} respectively, +\code{GRPID}, \code{SCOPE}, and \code{SCOPEN} respectively, whenever not missing. } \examples{ diff --git a/man/derive_vars_transposed.Rd b/man/derive_vars_transposed.Rd index 25e6a0830a..effa25f80c 100644 --- a/man/derive_vars_transposed.Rd +++ b/man/derive_vars_transposed.Rd @@ -91,17 +91,11 @@ cm \%>\% General Derivation Functions for all ADaMs that returns variable appended to dataset: \code{\link{derive_var_extreme_flag}()}, \code{\link{derive_var_joined_exist_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_vars_joined}()}, -\code{\link{derive_vars_last_dose}()}, \code{\link{derive_vars_merged_lookup}()}, \code{\link{derive_vars_merged}()}, \code{\link{get_summary_records}()} diff --git a/man/dthcaus_source.Rd b/man/dthcaus_source.Rd index e9dd3583bf..55c9e4c83e 100644 --- a/man/dthcaus_source.Rd +++ b/man/dthcaus_source.Rd @@ -20,34 +20,36 @@ 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{date}{A date or datetime variable or an expression 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. +Additional variables/expressions to be used for sorting the \code{dataset}. The +dataset is ordered by \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{exprs()}, e.g., \code{exprs(ADT, desc(AVAL))} or \code{NULL}} +\emph{Permitted Values}: list of expressions created by \code{exprs()}, e.g., +\code{exprs(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{dthcaus}{A variable name, an expression, or a string literal + +If a variable name is specified, e.g., \code{AEDECOD}, it is the variable in the +source dataset to be used to assign values to \code{DTHCAUS}; if an expression, +e.g., \code{str_to_upper(AEDECOD)}, it is evaluated in the source dataset and +the results is assigned 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[=exprs]{exprs()}} listing the traceability variables, -e.g. \code{exprs(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.} +\item{traceability_vars}{A named list returned by \code{\link[=exprs]{exprs()}} listing the +traceability variables, e.g. \code{exprs(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, numbers, symbols, or +expressions referring to existing variables.} } \value{ An object of class "dthcaus_source". @@ -69,7 +71,7 @@ src_ae <- dthcaus_source( src_ds <- dthcaus_source( dataset_name = "ds", filter = DSDECOD == "DEATH", - date = DSSTDT, + date = convert_dtc_to_dt(DSSTDTC), mode = "first", dthcaus = DSTERM ) @@ -85,6 +87,7 @@ Source Objects: \code{\link{event_source}()}, \code{\link{event}()}, \code{\link{query}()}, +\code{\link{records_source}()}, \code{\link{tte_source}()} } \concept{source_specifications} diff --git a/man/event.Rd b/man/event.Rd index 24540bdf72..39573f0a2e 100644 --- a/man/event.Rd +++ b/man/event.Rd @@ -32,6 +32,7 @@ Source Objects: \code{\link{dthcaus_source}()}, \code{\link{event_source}()}, \code{\link{query}()}, +\code{\link{records_source}()}, \code{\link{tte_source}()} } \concept{source_specifications} diff --git a/man/event_source.Rd b/man/event_source.Rd index e87c261544..ba9d6cb3fb 100644 --- a/man/event_source.Rd +++ b/man/event_source.Rd @@ -15,15 +15,16 @@ of \code{derive_param_tte()}.} \item{filter}{An unquoted condition for selecting the observations from \code{dataset} which are events or possible censoring time points.} -\item{date}{A variable providing the date of the event or censoring. A date, -or a datetime can be specified. An unquoted symbol is expected. +\item{date}{A variable or expression providing the date of the event or +censoring. A date, or a datetime can be specified. An unquoted symbol or +expression is expected. -Refer to \code{derive_vars_dt()} to impute and derive a date from a date -character vector to a date object.} +Refer to \code{derive_vars_dt()} or \code{convert_dtc_to_dt()} to impute and derive a +date from a date character vector to a date object.} \item{set_values_to}{A named list returned by \code{exprs()} defining the variables to be set for the event or censoring, e.g. \code{exprs(EVENTDESC = "DEATH", SRCDOM = "ADSL", SRCVAR = "DTHDT")}. The values must be a symbol, a -character string, a numeric value, or \code{NA}.} +character string, a numeric value, an expression, or \code{NA}.} } \value{ An object of class \code{event_source}, inheriting from class \code{tte_source} @@ -31,6 +32,8 @@ An object of class \code{event_source}, inheriting from class \code{tte_source} \description{ \code{event_source} objects are used to define events as input for the \code{derive_param_tte()} function. + +\strong{Note:} This is a wrapper function for the more generic \code{tte_source()}. } \examples{ # Death event @@ -57,6 +60,7 @@ Source Objects: \code{\link{dthcaus_source}()}, \code{\link{event}()}, \code{\link{query}()}, +\code{\link{records_source}()}, \code{\link{tte_source}()} } \concept{source_specifications} diff --git a/man/example_qs.Rd b/man/example_qs.Rd index 90f85d9ebb..10902ebde4 100644 --- a/man/example_qs.Rd +++ b/man/example_qs.Rd @@ -5,7 +5,7 @@ \alias{example_qs} \title{Example \code{QS} Dataset} \format{ -An object of class \code{tbl_df} (inherits from \code{tbl}, \code{data.frame}) with 176 rows and 11 columns. +An object of class \code{tbl_df} (inherits from \code{tbl}, \code{data.frame}) with 161 rows and 11 columns. } \source{ Created by (\url{https://github.com/pharmaverse/admiral/blob/main/inst/example_scripts/example_qs.R}) diff --git a/man/extend_source_datasets.Rd b/man/extend_source_datasets.Rd index 1f7ad659bb..ac494f0144 100644 --- a/man/extend_source_datasets.Rd +++ b/man/extend_source_datasets.Rd @@ -58,10 +58,12 @@ extend_source_datasets( \seealso{ Other Advanced Functions: \code{\link{assert_db_requirements}()}, +\code{\link{assert_parameters_argument}()}, \code{\link{assert_terms}()}, \code{\link{assert_valid_queries}()}, \code{\link{filter_date_sources}()}, \code{\link{format.basket_select}()}, +\code{\link{get_hori_data}()}, \code{\link{list_tte_source_objects}()}, \code{\link{params}()}, \code{\link{validate_basket_select}()}, diff --git a/man/extract_duplicate_records.Rd b/man/extract_duplicate_records.Rd index df90ec9e7f..6c29348703 100644 --- a/man/extract_duplicate_records.Rd +++ b/man/extract_duplicate_records.Rd @@ -9,8 +9,8 @@ extract_duplicate_records(dataset, by_vars) \arguments{ \item{dataset}{A data frame} -\item{by_vars}{A list of variables created using \code{exprs()} identifying groups of -records in which to look for duplicates} +\item{by_vars}{A list of expressions created using \code{exprs()} identifying +groups of records in which to look for duplicates} } \value{ A \code{data.frame} of duplicate records within \code{dataset} diff --git a/man/filter_confirmation.Rd b/man/filter_confirmation.Rd deleted file mode 100644 index 34a1ea836f..0000000000 --- a/man/filter_confirmation.Rd +++ /dev/null @@ -1,179 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/filter_joined.R -\name{filter_confirmation} -\alias{filter_confirmation} -\title{Filter Confirmed Observations} -\usage{ -filter_confirmation( - dataset, - by_vars, - join_vars, - join_type, - first_cond = NULL, - order, - tmp_obs_nr_var = NULL, - filter, - check_type = "warning" -) -} -\arguments{ -\item{dataset}{Input dataset - -The variables specified for \code{by_vars}, \code{join_vars}, and \code{order} are -expected.} - -\item{by_vars}{By variables - -The specified variables are used as by variables for joining the input -dataset with itself.} - -\item{join_vars}{Variables to keep from joined dataset - -The variables needed from the other observations should be specified for -this parameter. The specified variables are added to the joined dataset -with suffix ".join". For example to select all observations with \code{AVALC == "Y"} and \code{AVALC == "Y"} for at least one subsequent visit \code{join_vars = exprs(AVALC, AVISITN)} and \code{filter = AVALC == "Y" & AVALC.join == "Y" & AVISITN < AVISITN.join} could be specified. - -The \verb{*.join} variables are not included in the output dataset.} - -\item{join_type}{Observations to keep after joining - -The argument determines which of the joined observations are kept with -respect to the original observation. For example, if \code{join_type = "after"} is specified all observations after the original observations are -kept. - -\emph{Permitted Values:} \code{"before"}, \code{"after"}, \code{"all"}} - -\item{first_cond}{Condition for selecting range of data - -If this argument is specified, the other observations are restricted up to -the first observation where the specified condition is fulfilled. If the -condition is not fulfilled for any of the subsequent observations, all -observations are removed.} - -\item{order}{Order - -The observations are ordered by the specified order.} - -\item{tmp_obs_nr_var}{Temporary observation number - -The specified variable is added to the input dataset and set to the -observation number with respect to \code{order}. For each by group (\code{by_vars}) -the observation number starts with \code{1}. The variable can be used in the -conditions (\code{filter}, \code{first_cond}). It is not included in the output -dataset. It can be used to select consecutive observations or the last -observation (see last example below).} - -\item{filter}{Condition for selecting observations - -The filter is applied to the joined dataset for selecting the confirmed -observations. The condition can include summary functions. The joined -dataset is grouped by the original observations. I.e., the summary function -are applied to all observations up to the confirmation observation. For -example in the oncology setting when using this function for confirmed best -overall response, \code{filter = AVALC == "CR" & all(AVALC.join \%in\% c("CR", "NE")) & count_vals(var = AVALC.join, val = "NE") <= 1} selects -observations with response "CR" and for all observations up to the -confirmation observation the response is "CR" or "NE" and there is at most -one "NE".} - -\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{Default:} \code{"none"} - -\emph{Permitted Values:} \code{"none"}, \code{"warning"}, \code{"error"}} -} -\value{ -A subset of the observations of the input dataset. All variables of -the input dataset are included in the output dataset. -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} - -This function is \emph{deprecated}, please use \code{filter_joined()} instead. -} -\details{ -The following steps are performed to produce the output dataset. -\subsection{Step 1}{ - -The input dataset is joined with itself by the variables specified for -\code{by_vars}. From the right hand side of the join only the variables -specified for \code{join_vars} are kept. The suffix ".join" is added to these -variables. - -For example, for \code{by_vars = USUBJID}, \code{join_vars = exprs(AVISITN, AVALC)} and input dataset - -\if{html}{\out{
}}\preformatted{# A tibble: 2 x 4 -USUBJID AVISITN AVALC AVAL - -1 1 Y 1 -1 2 N 0 -}\if{html}{\out{
}} - -the joined dataset is - -\if{html}{\out{
}}\preformatted{A tibble: 4 x 6 -USUBJID AVISITN AVALC AVAL AVISITN.join AVALC.join - -1 1 Y 1 1 Y -1 1 Y 1 2 N -1 2 N 0 1 Y -1 2 N 0 2 N -}\if{html}{\out{
}} -} - -\subsection{Step 2}{ - -The joined dataset is restricted to observations with respect to -\code{join_type} and \code{order}. - -The dataset from the example in the previous step with \code{join_type = "after"} and order = exprs(AVISITN)` is restricted to - -\if{html}{\out{
}}\preformatted{A tibble: 4 x 6 -USUBJID AVISITN AVALC AVAL AVISITN.join AVALC.join - -1 1 Y 1 2 N -}\if{html}{\out{
}} -} - -\subsection{Step 3}{ - -If \code{first_cond} is specified, for each observation of the input dataset the -joined dataset is restricted to observations up to the first observation -where \code{first_cond} is fulfilled (the observation fulfilling the condition -is included). If for an observation of the input dataset the condition is -not fulfilled, the observation is removed. -} - -\subsection{Step 4}{ - -The joined dataset is grouped by the observations from the input dataset -and restricted to the observations fulfilling the condition specified by -\code{filter}. -} - -\subsection{Step 5}{ - -The first observation of each group is selected and the \verb{*.join} variables -are dropped. -} -} -\seealso{ -Other deprecated: -\code{\link{derive_derived_param}()}, -\code{\link{derive_param_first_event}()}, -\code{\link{derive_var_agegr_fda}()}, -\code{\link{derive_var_confirmation_flag}()}, -\code{\link{derive_var_disposition_status}()}, -\code{\link{derive_var_worst_flag}()}, -\code{\link{derive_vars_disposition_reason}()}, -\code{\link{derive_vars_merged_dtm}()}, -\code{\link{derive_vars_merged_dt}()}, -\code{\link{format_eoxxstt_default}()}, -\code{\link{format_reason_default}()}, -\code{\link{vars}()} -} -\concept{deprecated} -\keyword{deprecated} diff --git a/man/filter_date_sources.Rd b/man/filter_date_sources.Rd index 3851c7eada..691520e296 100644 --- a/man/filter_date_sources.Rd +++ b/man/filter_date_sources.Rd @@ -121,10 +121,12 @@ filter_date_sources( \seealso{ Other Advanced Functions: \code{\link{assert_db_requirements}()}, +\code{\link{assert_parameters_argument}()}, \code{\link{assert_terms}()}, \code{\link{assert_valid_queries}()}, \code{\link{extend_source_datasets}()}, \code{\link{format.basket_select}()}, +\code{\link{get_hori_data}()}, \code{\link{list_tte_source_objects}()}, \code{\link{params}()}, \code{\link{validate_basket_select}()}, diff --git a/man/filter_exist.Rd b/man/filter_exist.Rd new file mode 100644 index 0000000000..20697b3916 --- /dev/null +++ b/man/filter_exist.Rd @@ -0,0 +1,92 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/filter_exist.R +\name{filter_exist} +\alias{filter_exist} +\title{Returns records that fit into existing by groups in a filtered source dataset} +\usage{ +filter_exist(dataset, dataset_add, by_vars, filter_add = NULL) +} +\arguments{ +\item{dataset}{Input dataset + +The variables specified in the \code{by_vars} parameter are expected in this dataset.} + +\item{dataset_add}{Source dataset + +The source dataset, which determines the by groups returned in the input dataset, +based on the groups that exist in this dataset after being subset by \code{filter_add}. + +The variables specified in the \code{by_vars} and \code{filter_add} parameters are expected +in this dataset.} + +\item{by_vars}{Grouping variables + +A list of variable names specified within \code{exprs()} is expected.} + +\item{filter_add}{Filter for the source dataset + +The filter condition which will be used to subset the source dataset. +Alternatively, if no filter condition is supplied, no subsetting of the source +dataset will be performed. + +Default: \code{NULL} (i.e. no filtering will be performed)} +} +\value{ +The records in the input dataset which are contained within an existing by group in +the filtered source dataset. +} +\description{ +Returns all records in the input dataset that belong to by groups that are present +in a source dataset, after the source dataset is optionally filtered. For example, +this could be used to return ADSL records for subjects that experienced a certain +adverse event during the course of the study (as per records in ADAE). +} +\details{ +Returns the records in \code{dataset} which match an existing by group in \code{dataset_add}, +after being filtered according to \code{filter_add}. If there are no by groups that exist +in both datasets, an empty dataset will be returned. +} +\examples{ +# Get demographic information about subjects who have suffered from moderate or +# severe fatigue + +library(tibble) + +adsl <- tribble( + ~USUBJID, ~AGE, ~SEX, + "01-701-1015", 63, "F", + "01-701-1034", 77, "F", + "01-701-1115", 84, "M", + "01-701-1146", 75, "F", + "01-701-1444", 63, "M" +) + +adae <- tribble( + ~USUBJID, ~AEDECOD, ~AESEV, ~AESTDTC, + "01-701-1015", "DIARRHOEA", "MODERATE", "2014-01-09", + "01-701-1034", "FATIGUE", "SEVERE", "2014-11-02", + "01-701-1034", "APPLICATION SITE PRURITUS", "MODERATE", "2014-08-27", + "01-701-1115", "FATIGUE", "MILD", "2013-01-14", + "01-701-1146", "FATIGUE", "MODERATE", "2013-06-03" +) + +filter_exist( + dataset = adsl, + dataset_add = adae, + by_vars = exprs(USUBJID), + filter_add = AEDECOD == "FATIGUE" & AESEV \%in\% c("MODERATE", "SEVERE") +) + +} +\seealso{ +Utilities for Filtering Observations: +\code{\link{count_vals}()}, +\code{\link{filter_extreme}()}, +\code{\link{filter_joined}()}, +\code{\link{filter_not_exist}()}, +\code{\link{filter_relative}()}, +\code{\link{max_cond}()}, +\code{\link{min_cond}()} +} +\concept{utils_fil} +\keyword{utils_fil} diff --git a/man/filter_extreme.Rd b/man/filter_extreme.Rd index 9d049f1508..6842ff97e6 100644 --- a/man/filter_extreme.Rd +++ b/man/filter_extreme.Rd @@ -22,8 +22,8 @@ expected.} 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{exprs()}, e.g., \code{exprs(ADT, desc(AVAL))}} +\emph{Permitted Values:} list of expressions created by \code{exprs()}, e.g., +\code{exprs(ADT, desc(AVAL))}} \item{mode}{Selection mode (first or last) @@ -57,11 +57,34 @@ order specified for the \code{order} parameter and the mode specified for the } \examples{ library(dplyr, warn.conflicts = FALSE) -library(admiral.test) -data("admiral_ex") + +ex <- tribble( + ~STUDYID, ~DOMAIN, ~USUBJID, ~EXSEQ, ~EXDOSE, ~EXTRT, + "PILOT01", "EX", "01-1442", 1, 54, "XANO", + "PILOT01", "EX", "01-1442", 2, 54, "XANO", + "PILOT01", "EX", "01-1442", 3, 54, "XANO", + "PILOT01", "EX", "01-1444", 1, 54, "XANO", + "PILOT01", "EX", "01-1444", 2, 81, "XANO", + "PILOT01", "EX", "05-1382", 1, 54, "XANO", + "PILOT01", "EX", "08-1213", 1, 54, "XANO", + "PILOT01", "EX", "10-1053", 1, 54, "XANO", + "PILOT01", "EX", "10-1053", 2, 54, "XANO", + "PILOT01", "EX", "10-1183", 1, 0, "PLACEBO", + "PILOT01", "EX", "10-1183", 2, 0, "PLACEBO", + "PILOT01", "EX", "10-1183", 3, 0, "PLACEBO", + "PILOT01", "EX", "11-1036", 1, 0, "PLACEBO", + "PILOT01", "EX", "11-1036", 2, 0, "PLACEBO", + "PILOT01", "EX", "11-1036", 3, 0, "PLACEBO", + "PILOT01", "EX", "14-1425", 1, 54, "XANO", + "PILOT01", "EX", "15-1319", 1, 54, "XANO", + "PILOT01", "EX", "15-1319", 2, 81, "XANO", + "PILOT01", "EX", "16-1151", 1, 54, "XANO", + "PILOT01", "EX", "16-1151", 2, 54, "XANO" +) + # Select first dose for each patient -admiral_ex \%>\% +ex \%>\% filter_extreme( by_vars = exprs(USUBJID), order = exprs(EXSEQ), @@ -70,7 +93,7 @@ admiral_ex \%>\% select(USUBJID, EXSEQ) # Select highest dose for each patient on the active drug -admiral_ex \%>\% +ex \%>\% filter(EXTRT != "PLACEBO") \%>\% filter_extreme( by_vars = exprs(USUBJID), @@ -83,7 +106,9 @@ admiral_ex \%>\% \seealso{ Utilities for Filtering Observations: \code{\link{count_vals}()}, +\code{\link{filter_exist}()}, \code{\link{filter_joined}()}, +\code{\link{filter_not_exist}()}, \code{\link{filter_relative}()}, \code{\link{max_cond}()}, \code{\link{min_cond}()} diff --git a/man/filter_joined.Rd b/man/filter_joined.Rd index 70f6bcf711..8361945017 100644 --- a/man/filter_joined.Rd +++ b/man/filter_joined.Rd @@ -52,7 +52,10 @@ observations are removed.} \item{order}{Order -The observations are ordered by the specified order.} +The observations are ordered by the specified order. + +\emph{Permitted Values:} list of expressions created by \code{exprs()}, e.g., +\code{exprs(ADT, desc(AVAL))}} \item{tmp_obs_nr_var}{Temporary observation number @@ -138,7 +141,7 @@ USUBJID AVISITN AVALC AVAL AVISITN.join AVALC.join The joined dataset is restricted to observations with respect to \code{join_type} and \code{order}. -The dataset from the example in the previous step with \code{join_type = "after"} and order = exprs(AVISITN)` is restricted to +The dataset from the example in the previous step with \code{join_type = "after"} and \code{order = exprs(AVISITN)} is restricted to \if{html}{\out{
}}\preformatted{A tibble: 4 x 6 USUBJID AVISITN AVALC AVAL AVISITN.join AVALC.join @@ -323,7 +326,9 @@ filter_joined( Utilities for Filtering Observations: \code{\link{count_vals}()}, +\code{\link{filter_exist}()}, \code{\link{filter_extreme}()}, +\code{\link{filter_not_exist}()}, \code{\link{filter_relative}()}, \code{\link{max_cond}()}, \code{\link{min_cond}()} diff --git a/man/filter_not_exist.Rd b/man/filter_not_exist.Rd new file mode 100644 index 0000000000..ae8c3d1f0c --- /dev/null +++ b/man/filter_not_exist.Rd @@ -0,0 +1,93 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/filter_exist.R +\name{filter_not_exist} +\alias{filter_not_exist} +\title{Returns records that don't fit into existing by groups in a filtered source dataset} +\usage{ +filter_not_exist(dataset, dataset_add, by_vars, filter_add = NULL) +} +\arguments{ +\item{dataset}{Input dataset + +The variables specified in the \code{by_vars} parameter are expected in this dataset.} + +\item{dataset_add}{Source dataset + +The source dataset, which determines the by groups returned in the input dataset, +based on the groups that don't exist in this dataset after being subset by \code{filter_add}. + +The variables specified in the \code{by_vars} and \code{filter_add} parameters are expected +in this dataset.} + +\item{by_vars}{Grouping variables + +A list of variable names specified within \code{exprs()} is expected.} + +\item{filter_add}{Filter for the source dataset + +The filter condition which will be used to subset the source dataset. +Alternatively, if no filter condition is supplied, no subsetting of the source +dataset will be performed. + +Default: \code{NULL} (i.e. no filtering will be performed)} +} +\value{ +The records in the input dataset which are not contained within any existing by +group in the filtered source dataset. +} +\description{ +Returns all records in the input dataset that belong to by groups that are not +present in a source dataset, after the source dataset is optionally filtered. For +example, this could be used to return ADSL records for subjects that didn't take certain +concomitant medications during the course of the study (as per records in ADCM). +} +\details{ +Returns the records in \code{dataset} which don't match any existing by groups in +\code{dataset_add}, after being filtered according to \code{filter_add}. If all by +groups that exist in \code{dataset} don't exist in \code{dataset_add}, an empty dataset will +be returned. +} +\examples{ +# Get demographic information about subjects who didn't take vitamin supplements +# during the study + +library(tibble) + +adsl <- tribble( + ~USUBJID, ~AGE, ~SEX, + "01-701-1015", 63, "F", + "01-701-1023", 64, "M", + "01-701-1034", 77, "F", + "01-701-1118", 52, "M" +) + +adcm <- tribble( + ~USUBJID, ~CMTRT, ~CMSTDTC, + "01-701-1015", "ASPIRIN", "2013-05-14", + "01-701-1023", "MYLANTA", "2014-01-04", + "01-701-1023", "CALCIUM", "2014-02-25", + "01-701-1034", "VITAMIN C", "2013-12-12", + "01-701-1034", "CALCIUM", "2013-03-27", + "01-701-1118", "MULTIVITAMIN", "2013-02-21" +) + +filter_not_exist( + dataset = adsl, + dataset_add = adcm, + by_vars = exprs(USUBJID), + filter_add = str_detect(CMTRT, "VITAMIN") +) + +} +\seealso{ +Utilities for Filtering Observations: +\code{\link{count_vals}()}, +\code{\link{filter_exist}()}, +\code{\link{filter_extreme}()}, +\code{\link{filter_joined}()}, +\code{\link{filter_relative}()}, +\code{\link{max_cond}()}, +\code{\link{min_cond}()} +} +\concept{utils_fil} +\keyword{utils_fil} diff --git a/man/filter_relative.Rd b/man/filter_relative.Rd index a614f01a4d..220ce39caf 100644 --- a/man/filter_relative.Rd +++ b/man/filter_relative.Rd @@ -30,8 +30,8 @@ expected.} 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{exprs()}, e.g., \code{exprs(ADT, desc(AVAL))}} +\emph{Permitted Values:} list of expressions created by \code{exprs()}, e.g., +\code{exprs(ADT, desc(AVAL))}} \item{condition}{Condition for Reference Observation @@ -154,8 +154,10 @@ response \%>\% \seealso{ Utilities for Filtering Observations: \code{\link{count_vals}()}, +\code{\link{filter_exist}()}, \code{\link{filter_extreme}()}, \code{\link{filter_joined}()}, +\code{\link{filter_not_exist}()}, \code{\link{max_cond}()}, \code{\link{min_cond}()} } diff --git a/man/format.basket_select.Rd b/man/format.basket_select.Rd index 7b07168b6c..03587542fe 100644 --- a/man/format.basket_select.Rd +++ b/man/format.basket_select.Rd @@ -27,10 +27,12 @@ format(basket_select(id = 42, scope = "NARROW", type = "smq")) Other Advanced Functions: \code{\link{assert_db_requirements}()}, +\code{\link{assert_parameters_argument}()}, \code{\link{assert_terms}()}, \code{\link{assert_valid_queries}()}, \code{\link{extend_source_datasets}()}, \code{\link{filter_date_sources}()}, +\code{\link{get_hori_data}()}, \code{\link{list_tte_source_objects}()}, \code{\link{params}()}, \code{\link{validate_basket_select}()}, diff --git a/man/format_eoxxstt_default.Rd b/man/format_eoxxstt_default.Rd index 409d806507..27cdbf84cc 100644 --- a/man/format_eoxxstt_default.Rd +++ b/man/format_eoxxstt_default.Rd @@ -32,18 +32,19 @@ Usually this function can not be used with \verb{\%>\%}. } \seealso{ Other deprecated: -\code{\link{derive_derived_param}()}, -\code{\link{derive_param_first_event}()}, -\code{\link{derive_var_agegr_fda}()}, +\code{\link{derive_param_extreme_event}()}, +\code{\link{derive_var_basetype}()}, \code{\link{derive_var_confirmation_flag}()}, \code{\link{derive_var_disposition_status}()}, +\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_worst_flag}()}, \code{\link{derive_vars_disposition_reason}()}, -\code{\link{derive_vars_merged_dtm}()}, -\code{\link{derive_vars_merged_dt}()}, -\code{\link{filter_confirmation}()}, -\code{\link{format_reason_default}()}, -\code{\link{vars}()} +\code{\link{derive_vars_last_dose}()}, +\code{\link{format_reason_default}()} } \concept{deprecated} \keyword{deprecated} diff --git a/man/format_reason_default.Rd b/man/format_reason_default.Rd index 0e2a256038..924db54cab 100644 --- a/man/format_reason_default.Rd +++ b/man/format_reason_default.Rd @@ -35,18 +35,19 @@ equal to \code{'OTHER'}. \code{\link[=derive_vars_disposition_reason]{derive_vars_disposition_reason()}} Other deprecated: -\code{\link{derive_derived_param}()}, -\code{\link{derive_param_first_event}()}, -\code{\link{derive_var_agegr_fda}()}, +\code{\link{derive_param_extreme_event}()}, +\code{\link{derive_var_basetype}()}, \code{\link{derive_var_confirmation_flag}()}, \code{\link{derive_var_disposition_status}()}, +\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_worst_flag}()}, \code{\link{derive_vars_disposition_reason}()}, -\code{\link{derive_vars_merged_dtm}()}, -\code{\link{derive_vars_merged_dt}()}, -\code{\link{filter_confirmation}()}, -\code{\link{format_eoxxstt_default}()}, -\code{\link{vars}()} +\code{\link{derive_vars_last_dose}()}, +\code{\link{format_eoxxstt_default}()} } \concept{deprecated} \keyword{deprecated} diff --git a/man/get_admiral_option.Rd b/man/get_admiral_option.Rd index fd4075a3d2..6f1d691188 100644 --- a/man/get_admiral_option.Rd +++ b/man/get_admiral_option.Rd @@ -9,7 +9,8 @@ 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" or "force_admiral_vars". +As of now, support only available for +"subject_keys". See \code{set_admiral_options()} for a description of the options.} } \value{ @@ -23,18 +24,31 @@ This function allows flexibility for function inputs that may need to be repeate 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") +dm <- tribble( + ~STUDYID, ~DOMAIN, ~USUBJID, ~AGE, ~AGEU, + "PILOT01", "DM", "01-1302", 61, "YEARS", + "PILOT01", "DM", "17-1344", 64, "YEARS" +) + +vs <- tribble( + ~STUDYID, ~DOMAIN, ~USUBJID, ~VSTESTCD, ~VISIT, ~VSTPT, ~VSSTRESN, + "PILOT01", "VS", "01-1302", "DIABP", "BASELINE", "LYING", 76, + "PILOT01", "VS", "01-1302", "DIABP", "BASELINE", "STANDING", 87, + "PILOT01", "VS", "01-1302", "DIABP", "WEEK 2", "LYING", 71, + "PILOT01", "VS", "01-1302", "DIABP", "WEEK 2", "STANDING", 79, + "PILOT01", "VS", "17-1344", "DIABP", "BASELINE", "LYING", 88, + "PILOT01", "VS", "17-1344", "DIABP", "BASELINE", "STANDING", 86, + "PILOT01", "VS", "17-1344", "DIABP", "WEEK 2", "LYING", 84, + "PILOT01", "VS", "17-1344", "DIABP", "WEEK 2", "STANDING", 82 +) # Merging all dm variables to vs derive_vars_merged( - admiral_vs, - dataset_add = select(admiral_dm, -DOMAIN), + vs, + dataset_add = select(dm, -DOMAIN), by_vars = get_admiral_option("subject_keys") -) \%>\% - select(STUDYID, USUBJID, VSTESTCD, VISIT, VSTPT, VSSTRESN, AGE, AGEU) +) } \seealso{ \code{\link[=set_admiral_options]{set_admiral_options()}}, \code{\link[=derive_param_exist_flag]{derive_param_exist_flag()}}, \code{\link[=derive_param_tte]{derive_param_tte()}} diff --git a/man/get_hori_data.Rd b/man/get_hori_data.Rd new file mode 100644 index 0000000000..cd78eb0eac --- /dev/null +++ b/man/get_hori_data.Rd @@ -0,0 +1,61 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/derive_param_computed.R +\name{get_hori_data} +\alias{get_hori_data} +\title{Creating Temporary Parameters and \verb{.} Variables} +\usage{ +get_hori_data(dataset, by_vars, parameters, analysis_value, filter) +} +\arguments{ +\item{dataset}{Input dataset} + +\item{by_vars}{By variables} + +\item{parameters}{List of parameter codes + +The input dataset is restricted to the specified parameter codes. If an +expression is specified, a new parameter code is added to the input +dataset. The name of the element defines the parameter code and the +expression the observations to select. + +\emph{Permitted Values:} A character vector of \code{PARAMCD} values or a list of expressions} + +\item{analysis_value}{All variables of the form \verb{.} like \code{AVAL.WEIGHT} are +added to the input dataset. They are set to the value of the variable for +the parameter. E.g., \code{AVAL.WEIGHT} is set to the value of \code{AVAL} where +\code{PARAMCD == "WEIGHT"}. + +\emph{Permitted Values:} An unquoted expression} + +\item{filter}{Filter condition used for restricting the input dataset + +The specified filter condition is used in the warnings only. It is not +applied to the input dataset. + +\emph{Permitted Values:} An unquoted expression} +} +\value{ +A dataset with one observation per by group. It contains the +variables specified for \code{by_vars} and all variables of the form +\verb{.} occurring in \code{analysis_value}. +} +\description{ +The function creates temporary parameters and variables of the form +\verb{.}, e.g., \code{AVAL.WEIGHT}. +} +\seealso{ +Other Advanced Functions: +\code{\link{assert_db_requirements}()}, +\code{\link{assert_parameters_argument}()}, +\code{\link{assert_terms}()}, +\code{\link{assert_valid_queries}()}, +\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{validate_basket_select}()}, +\code{\link{validate_query}()} +} +\concept{other_advanced} +\keyword{other_advanced} diff --git a/man/get_summary_records.Rd b/man/get_summary_records.Rd index 58c4adfa1d..ba0f3786d9 100644 --- a/man/get_summary_records.Rd +++ b/man/get_summary_records.Rd @@ -47,9 +47,8 @@ Set a list of variables to some specified value for the new observation(s) \itemize{ \item LHS refer to a variable. \item RHS refers to the values to set to the variable. This can be a string, a symbol, a numeric -value or NA. +value, an expression or NA. (e.g. \code{exprs(PARAMCD = "TDOSE",PARCAT1 = "OVERALL")}). -More general expression are not allowed. }} } \value{ @@ -163,17 +162,11 @@ get_summary_records( General Derivation Functions for all ADaMs that returns variable appended to dataset: \code{\link{derive_var_extreme_flag}()}, \code{\link{derive_var_joined_exist_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_vars_joined}()}, -\code{\link{derive_vars_last_dose}()}, \code{\link{derive_vars_merged_lookup}()}, \code{\link{derive_vars_merged}()}, \code{\link{derive_vars_transposed}()} diff --git a/man/get_terms_from_db.Rd b/man/get_terms_from_db.Rd index 29ea512837..6840450962 100644 --- a/man/get_terms_from_db.Rd +++ b/man/get_terms_from_db.Rd @@ -9,8 +9,8 @@ get_terms_from_db( fun, queries, definition, - expect_query_name = FALSE, - expect_query_id = FALSE, + expect_grpname = FALSE, + expect_grpid = FALSE, i, temp_env ) @@ -36,9 +36,9 @@ messages.} The definition is passed to the access function. It defines which terms are returned.} -\item{expect_query_name}{Is \code{QUERY_NAME} expected in the output dataset?} +\item{expect_grpname}{Is \code{GRPNAME} expected in the output dataset?} -\item{expect_query_id}{Is \code{QUERY_ID} expected in the output dataset?} +\item{expect_grpid}{Is \code{GRPID} expected in the output dataset?} \item{i}{Index of \code{definition} in \code{queries} diff --git a/man/impute_dtc_dt.Rd b/man/impute_dtc_dt.Rd index fa28ef7c11..06c4ab92a4 100644 --- a/man/impute_dtc_dt.Rd +++ b/man/impute_dtc_dt.Rd @@ -176,6 +176,7 @@ impute_dtc_dt( } \seealso{ Date/Time Computation Functions that returns a vector: +\code{\link{compute_age_years}()}, \code{\link{compute_dtf}()}, \code{\link{compute_duration}()}, \code{\link{compute_tmf}()}, diff --git a/man/impute_dtc_dtm.Rd b/man/impute_dtc_dtm.Rd index 388320b10a..8e0f8c0e8c 100644 --- a/man/impute_dtc_dtm.Rd +++ b/man/impute_dtc_dtm.Rd @@ -218,6 +218,7 @@ impute_dtc_dtm( } \seealso{ Date/Time Computation Functions that returns a vector: +\code{\link{compute_age_years}()}, \code{\link{compute_dtf}()}, \code{\link{compute_duration}()}, \code{\link{compute_tmf}()}, diff --git a/man/list_tte_source_objects.Rd b/man/list_tte_source_objects.Rd index c454c02e22..155a926972 100644 --- a/man/list_tte_source_objects.Rd +++ b/man/list_tte_source_objects.Rd @@ -22,11 +22,13 @@ list_tte_source_objects() \seealso{ Other Advanced Functions: \code{\link{assert_db_requirements}()}, +\code{\link{assert_parameters_argument}()}, \code{\link{assert_terms}()}, \code{\link{assert_valid_queries}()}, \code{\link{extend_source_datasets}()}, \code{\link{filter_date_sources}()}, \code{\link{format.basket_select}()}, +\code{\link{get_hori_data}()}, \code{\link{params}()}, \code{\link{validate_basket_select}()}, \code{\link{validate_query}()} diff --git a/man/max_cond.Rd b/man/max_cond.Rd index c737114395..9a651a06aa 100644 --- a/man/max_cond.Rd +++ b/man/max_cond.Rd @@ -44,8 +44,10 @@ group_by(data, USUBJID) \%>\% mutate( \seealso{ Utilities for Filtering Observations: \code{\link{count_vals}()}, +\code{\link{filter_exist}()}, \code{\link{filter_extreme}()}, \code{\link{filter_joined}()}, +\code{\link{filter_not_exist}()}, \code{\link{filter_relative}()}, \code{\link{min_cond}()} } diff --git a/man/min_cond.Rd b/man/min_cond.Rd index 4e1207c85f..e00c303929 100644 --- a/man/min_cond.Rd +++ b/man/min_cond.Rd @@ -44,8 +44,10 @@ group_by(data, USUBJID) \%>\% mutate( \seealso{ Utilities for Filtering Observations: \code{\link{count_vals}()}, +\code{\link{filter_exist}()}, \code{\link{filter_extreme}()}, \code{\link{filter_joined}()}, +\code{\link{filter_not_exist}()}, \code{\link{filter_relative}()}, \code{\link{max_cond}()} } diff --git a/man/params.Rd b/man/params.Rd index f0fcca1542..7dc400deea 100644 --- a/man/params.Rd +++ b/man/params.Rd @@ -17,14 +17,43 @@ Create a set of variable parameters/function arguments to be used in \code{\link } \examples{ library(dplyr, warn.conflicts = FALSE) -library(admiral.test) -data(admiral_ae) -data(admiral_adsl) -adae <- admiral_ae[sample(1:nrow(admiral_ae), 1000), ] \%>\% +adsl <- tribble( + ~STUDYID, ~USUBJID, ~TRTSDT, ~TRTEDT, + "PILOT01", "01-1307", NA, NA, + "PILOT01", "05-1377", "2014-01-04", "2014-01-25", + "PILOT01", "06-1384", "2012-09-15", "2012-09-24", + "PILOT01", "15-1085", "2013-02-16", "2013-08-18", + "PILOT01", "16-1298", "2013-04-08", "2013-06-28" +) \%>\% + mutate( + across(TRTSDT:TRTEDT, as.Date) + ) + +ae <- tribble( + ~STUDYID, ~DOMAIN, ~USUBJID, ~AESTDTC, ~AEENDTC, + "PILOT01", "AE", "06-1384", "2012-09-15", "2012-09-29", + "PILOT01", "AE", "06-1384", "2012-09-15", "2012-09-29", + "PILOT01", "AE", "06-1384", "2012-09-23", "2012-09-29", + "PILOT01", "AE", "06-1384", "2012-09-23", "2012-09-29", + "PILOT01", "AE", "06-1384", "2012-09-15", "2012-09-29", + "PILOT01", "AE", "06-1384", "2012-09-15", "2012-09-29", + "PILOT01", "AE", "06-1384", "2012-09-15", "2012-09-29", + "PILOT01", "AE", "06-1384", "2012-09-15", "2012-09-29", + "PILOT01", "AE", "06-1384", "2012-09-23", "2012-09-29", + "PILOT01", "AE", "06-1384", "2012-09-23", "2012-09-29", + "PILOT01", "AE", "16-1298", "2013-06-08", "2013-07-06", + "PILOT01", "AE", "16-1298", "2013-06-08", "2013-07-06", + "PILOT01", "AE", "16-1298", "2013-04-22", "2013-07-06", + "PILOT01", "AE", "16-1298", "2013-04-22", "2013-07-06", + "PILOT01", "AE", "16-1298", "2013-04-22", "2013-07-06", + "PILOT01", "AE", "16-1298", "2013-04-22", "2013-07-06" +) + +adae <- ae \%>\% select(USUBJID, AESTDTC, AEENDTC) \%>\% derive_vars_merged( - dataset_add = admiral_adsl, + dataset_add = adsl, new_vars = exprs(TRTSDT, TRTEDT), by_vars = exprs(USUBJID) ) @@ -46,6 +75,7 @@ adae \%>\% max_dates = exprs(TRTEDT) ) + ## While `derive_vars_dt()` can only add one variable at a time, using `call_derivation()` ## one can add multiple variables in one go. ## The function arguments which are different from a variable to another (e.g. `new_vars_prefix`, @@ -71,11 +101,13 @@ call_derivation( Other Advanced Functions: \code{\link{assert_db_requirements}()}, +\code{\link{assert_parameters_argument}()}, \code{\link{assert_terms}()}, \code{\link{assert_valid_queries}()}, \code{\link{extend_source_datasets}()}, \code{\link{filter_date_sources}()}, \code{\link{format.basket_select}()}, +\code{\link{get_hori_data}()}, \code{\link{list_tte_source_objects}()}, \code{\link{validate_basket_select}()}, \code{\link{validate_query}()} diff --git a/man/print.adam_templates.Rd b/man/print.adam_templates.Rd index 847879d6de..ab3a9ed634 100644 --- a/man/print.adam_templates.Rd +++ b/man/print.adam_templates.Rd @@ -25,6 +25,7 @@ print(templates) \code{\link[=list_all_templates]{list_all_templates()}} Utilities for printing: +\code{\link{print.duplicates}()}, \code{\link{print.source}()}, \code{\link{print_named_list}()} } diff --git a/man/print.duplicates.Rd b/man/print.duplicates.Rd new file mode 100644 index 0000000000..265921ebe8 --- /dev/null +++ b/man/print.duplicates.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/duplicates.R +\name{print.duplicates} +\alias{print.duplicates} +\title{Print \code{duplicates} Objects} +\usage{ +\method{print}{duplicates}(x, ...) +} +\arguments{ +\item{x}{A \code{duplicates} object} + +\item{...}{Not used} +} +\value{ +No return value, called for side effects +} +\description{ +Print \code{duplicates} Objects +} +\seealso{ +Utilities for printing: +\code{\link{print.adam_templates}()}, +\code{\link{print.source}()}, +\code{\link{print_named_list}()} +} +\concept{utils_print} +\keyword{utils_print} diff --git a/man/print.source.Rd b/man/print.source.Rd index 51dbe7bf9e..f98d455fa1 100644 --- a/man/print.source.Rd +++ b/man/print.source.Rd @@ -24,6 +24,7 @@ print(death_event) \seealso{ Utilities for printing: \code{\link{print.adam_templates}()}, +\code{\link{print.duplicates}()}, \code{\link{print_named_list}()} } \concept{utils_print} diff --git a/man/print_named_list.Rd b/man/print_named_list.Rd index b65bd274b1..7fb1cfb352 100644 --- a/man/print_named_list.Rd +++ b/man/print_named_list.Rd @@ -25,6 +25,7 @@ print_named_list(death_event) \seealso{ Utilities for printing: \code{\link{print.adam_templates}()}, +\code{\link{print.duplicates}()}, \code{\link{print.source}()} } \concept{utils_print} diff --git a/man/query.Rd b/man/query.Rd index 07a905ed6c..0478406e01 100644 --- a/man/query.Rd +++ b/man/query.Rd @@ -7,10 +7,10 @@ query(prefix, name = auto, id = NULL, add_scope_num = FALSE, definition = NULL) } \arguments{ -\item{prefix}{The value is used to populate \code{VAR_PREFIX} in the output +\item{prefix}{The value is used to populate \code{PREFIX} in the output dataset of \code{create_query_data()}, e.g., \code{"SMQ03"}} -\item{name}{The value is used to populate \code{QUERY_NAME} in the output dataset +\item{name}{The value is used to populate \code{GRPNAME} in the output dataset of \code{create_query_data()}. If the \code{auto} keyword is specified, the variable is set to the name of the query in the SMQ/SDG database. @@ -18,7 +18,7 @@ is set to the name of the query in the SMQ/SDG database. keyword is permitted only for queries which are defined by an \code{basket_select()} object.} -\item{id}{The value is used to populate \code{QUERY_ID} in the output dataset of +\item{id}{The value is used to populate \code{GRPID} in the output dataset of \code{create_query_data()}. If the \code{auto} keyword is specified, the variable is set to the id of the query in the SMQ/SDG database. @@ -26,7 +26,7 @@ set to the id of the query in the SMQ/SDG database. keyword is permitted only for queries which are defined by an \code{basket_select()} object.} -\item{add_scope_num}{Determines if \code{QUERY_SCOPE_NUM} in the output dataset +\item{add_scope_num}{Determines if \code{SCOPEN} 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{basket_select()} @@ -42,17 +42,17 @@ There are three different ways to define the terms: \itemize{ \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} +\item A data frame with columns \code{SRCVAR} and \code{TERMNAME} or \code{TERMID} can +be specified to define the terms of a customized query. The \code{SRCVAR} should be set to the name of the variable which should be used to select -the terms, e.g., \code{"AEDECOD"} or \code{"AELLTCD"}. \code{TERM_LEVEL} does not need +the terms, e.g., \code{"AEDECOD"} or \code{"AELLTCD"}. \code{SRCVAR} does not need to be constant within a query. For example a query can be based on \code{AEDECOD} and \code{AELLT}. -If \code{TERM_LEVEL} refers to a character variable, \code{TERM_NAME} should be set -to the value the variable. If it refers to a numeric variable, \code{TERM_ID} +If \code{SRCVAR} refers to a character variable, \code{TERMNAME} should be set +to the value the variable. If it refers to a numeric variable, \code{TERMID} 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 +or only numeric variables are used, \code{TERMID} or \code{TERMNAME} respectively can be omitted. \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 @@ -100,11 +100,11 @@ query( # creating a query for a customized query cqterms <- tribble( - ~TERM_NAME, ~TERM_ID, + ~TERMNAME, ~TERMID, "APPLICATION SITE ERYTHEMA", 10003041L, "APPLICATION SITE PRURITUS", 10003053L ) \%>\% - mutate(TERM_LEVEL = "AEDECOD") + mutate(SRCVAR = "AEDECOD") query( prefix = "CQ01", @@ -142,6 +142,7 @@ Source Objects: \code{\link{dthcaus_source}()}, \code{\link{event_source}()}, \code{\link{event}()}, +\code{\link{records_source}()}, \code{\link{tte_source}()} } \concept{source_specifications} diff --git a/man/records_source.Rd b/man/records_source.Rd new file mode 100644 index 0000000000..f0d011aa39 --- /dev/null +++ b/man/records_source.Rd @@ -0,0 +1,55 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/derive_param_extreme_record.R +\name{records_source} +\alias{records_source} +\title{Create a \code{records_source} Object} +\usage{ +records_source(dataset_name, filter = NULL, new_vars) +} +\arguments{ +\item{dataset_name}{The name of the source dataset + +The name refers to the dataset provided by the \code{source_datasets} argument +of \code{derive_param_extreme_record()}.} + +\item{filter}{An unquoted condition for selecting the observations from +\code{dataset}.} + +\item{new_vars}{Variables to add + +The specified variables from the source datasets are added to the output +dataset. Variables can be renamed by naming the element, i.e., \verb{new_vars = exprs( = )}. + +For example \code{new_vars = exprs(var1, var2)} adds variables \code{var1} and \code{var2} +from to the input dataset. + +And \code{new_vars = exprs(var1, new_var2 = old_var2)} takes \code{var1} and +\code{old_var2} from the source dataset and adds them to the input dataset renaming +\code{old_var2} to \code{new_var2}. Expressions can be used to create new variables +(see for example \code{new_vars} argument in \code{derive_vars_merged()}). + +\emph{Permitted Values:} list of expressions created by \code{exprs()}, e.g., +\code{exprs(ADT, desc(AVAL))}} +} +\value{ +An object of class \code{records_source} +} +\description{ +The \code{records_source} object is used to find extreme records of interest. +} +\seealso{ +\code{\link[=derive_param_extreme_record]{derive_param_extreme_record()}} + +Source Objects: +\code{\link{basket_select}()}, +\code{\link{censor_source}()}, +\code{\link{date_source}()}, +\code{\link{death_event}}, +\code{\link{dthcaus_source}()}, +\code{\link{event_source}()}, +\code{\link{event}()}, +\code{\link{query}()}, +\code{\link{tte_source}()} +} +\concept{source_specifications} +\keyword{source_specifications} diff --git a/man/set_admiral_options.Rd b/man/set_admiral_options.Rd index b99772244d..21e4d4e766 100644 --- a/man/set_admiral_options.Rd +++ b/man/set_admiral_options.Rd @@ -4,17 +4,12 @@ \alias{set_admiral_options} \title{Set the Value of Admiral Options} \usage{ -set_admiral_options(subject_keys, force_admiral_vars) +set_admiral_options(subject_keys) } \arguments{ \item{subject_keys}{Variables to uniquely identify a subject, defaults to \code{exprs(STUDYID, USUBJID)}. This option is used as default value for the \code{subject_keys} argument in all admiral functions.} - -\item{force_admiral_vars}{If this option is set to \code{TRUE} (which is the -default), the admiral definition of \code{vars()} is forced. This is just a -temporary solution to allow running scripts which use \code{vars()} in the -admiral function calls. It will be removed in a future release.} } \value{ No return value, called for side effects. @@ -42,11 +37,11 @@ adsl <- tribble( mutate(STUDYID = "XX1234") tu <- tribble( - ~USUBJID2, ~VISIT, ~TUSTRESC, - "1", "SCREENING", "TARGET", - "1", "WEEK 1", "TARGET", - "1", "WEEK 5", "TARGET", - "1", "WEEK 9", "NON-TARGET", + ~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" ) \%>\% @@ -56,7 +51,7 @@ tu <- tribble( ) derive_param_exist_flag( - dataset_adsl = adsl, + dataset_ref = adsl, dataset_add = tu, filter_add = TUTESTCD == "TUMIDENT" & VISIT == "SCREENING", condition = TUSTRESC == "TARGET", @@ -70,7 +65,8 @@ derive_param_exist_flag( } \seealso{ \code{\link[=get_admiral_option]{get_admiral_option()}}, \code{\link[=derive_param_exist_flag]{derive_param_exist_flag()}},\code{\link[=derive_param_tte]{derive_param_tte()}}, -\code{\link[=derive_var_dthcaus]{derive_var_dthcaus()}}, \code{\link[=derive_var_extreme_dtm]{derive_var_extreme_dtm()}}, \code{\link[=derive_vars_period]{derive_vars_period()}}, \code{\link[=create_period_dataset]{create_period_dataset()}} +\code{\link[=derive_var_dthcaus]{derive_var_dthcaus()}}, \code{\link[=derive_var_extreme_dtm]{derive_var_extreme_dtm()}}, \code{\link[=derive_vars_period]{derive_vars_period()}}, +\code{\link[=create_period_dataset]{create_period_dataset()}} Other admiral_options: \code{\link{get_admiral_option}()} diff --git a/man/signal_duplicate_records.Rd b/man/signal_duplicate_records.Rd index 36ad32c0dc..1076de7329 100644 --- a/man/signal_duplicate_records.Rd +++ b/man/signal_duplicate_records.Rd @@ -8,15 +8,15 @@ signal_duplicate_records( dataset, by_vars, msg = paste("Dataset contains duplicate records with respect to", - enumerate(vars2chr(by_vars))), + enumerate(replace_values_by_names(by_vars))), cnd_type = "error" ) } \arguments{ \item{dataset}{A data frame} -\item{by_vars}{A list of variables created using \code{exprs()} identifying groups of -records in which to look for duplicates} +\item{by_vars}{A list of expressions created using \code{exprs()} identifying +groups of records in which to look for duplicates} \item{msg}{The condition message} diff --git a/man/tte_source.Rd b/man/tte_source.Rd index 14252ef5dc..5051d0de38 100644 --- a/man/tte_source.Rd +++ b/man/tte_source.Rd @@ -15,11 +15,12 @@ of \code{derive_param_tte()}.} \item{filter}{An unquoted condition for selecting the observations from \code{dataset} which are events or possible censoring time points.} -\item{date}{A variable providing the date of the event or censoring. A date, -or a datetime can be specified. An unquoted symbol is expected. +\item{date}{A variable or expression providing the date of the event or +censoring. A date, or a datetime can be specified. An unquoted symbol or +expression is expected. -Refer to \code{derive_vars_dt()} to impute and derive a date from a date -character vector to a date object.} +Refer to \code{derive_vars_dt()} or \code{convert_dtc_to_dt()} to impute and derive a +date from a date character vector to a date object.} \item{censor}{Censoring value @@ -28,7 +29,7 @@ censoring.} \item{set_values_to}{A named list returned by \code{exprs()} defining the variables to be set for the event or censoring, e.g. \code{exprs(EVENTDESC = "DEATH", SRCDOM = "ADSL", SRCVAR = "DTHDT")}. The values must be a symbol, a -character string, a numeric value, or \code{NA}.} +character string, a numeric value, an expression, or \code{NA}.} } \value{ An object of class \code{tte_source} @@ -47,7 +48,8 @@ Source Objects: \code{\link{dthcaus_source}()}, \code{\link{event_source}()}, \code{\link{event}()}, -\code{\link{query}()} +\code{\link{query}()}, +\code{\link{records_source}()} } \concept{source_specifications} \keyword{source_specifications} diff --git a/man/tte_source_objects.Rd b/man/tte_source_objects.Rd index 417f4a3a50..9608eaab54 100644 --- a/man/tte_source_objects.Rd +++ b/man/tte_source_objects.Rd @@ -68,6 +68,7 @@ Source Objects: \code{\link{event_source}()}, \code{\link{event}()}, \code{\link{query}()}, +\code{\link{records_source}()}, \code{\link{tte_source}()} } \concept{source_specifications} diff --git a/man/use_ad_template.Rd b/man/use_ad_template.Rd index 1b780c128b..55847a584f 100644 --- a/man/use_ad_template.Rd +++ b/man/use_ad_template.Rd @@ -13,7 +13,9 @@ use_ad_template( ) } \arguments{ -\item{adam_name}{An ADaM dataset name. You can use any of the available dataset name ADAE, ADCM, ADEG, ADEX, ADLB, ADLBHY, ADMH, ADPC, ADPP, ADSL, ADVS, and the dataset name is case-insensitive. The default dataset name is ADSL.} +\item{adam_name}{An ADaM dataset name. You can use any of the available dataset name +ADAE, ADCM, ADEG, ADEX, ADLB, ADLBHY, ADMH, ADPC, ADPP, ADPPK, ADSL, ADVS, and the dataset name is case-insensitive. The default dataset +name is ADSL.} \item{save_path}{Path to save the script.} @@ -30,7 +32,8 @@ No return values, called for side effects Open an ADaM Template Script } \details{ -Running without any arguments such as \code{use_ad_template()} auto-generates adsl.R in the current path. Use \code{list_all_templates()} to discover which templates are available. +Running without any arguments such as \code{use_ad_template()} auto-generates adsl.R in +the current path. Use \code{list_all_templates()} to discover which templates are available. } \examples{ if (interactive()) { diff --git a/man/validate_basket_select.Rd b/man/validate_basket_select.Rd index 9bfcddca71..d0aa42bc20 100644 --- a/man/validate_basket_select.Rd +++ b/man/validate_basket_select.Rd @@ -20,11 +20,13 @@ Validate an object is indeed a \code{basket_select} object Other Advanced Functions: \code{\link{assert_db_requirements}()}, +\code{\link{assert_parameters_argument}()}, \code{\link{assert_terms}()}, \code{\link{assert_valid_queries}()}, \code{\link{extend_source_datasets}()}, \code{\link{filter_date_sources}()}, \code{\link{format.basket_select}()}, +\code{\link{get_hori_data}()}, \code{\link{list_tte_source_objects}()}, \code{\link{params}()}, \code{\link{validate_query}()} diff --git a/man/validate_query.Rd b/man/validate_query.Rd index dab7e33c9a..5c835669be 100644 --- a/man/validate_query.Rd +++ b/man/validate_query.Rd @@ -20,11 +20,13 @@ Validate an object is indeed a \code{query} object Other Advanced Functions: \code{\link{assert_db_requirements}()}, +\code{\link{assert_parameters_argument}()}, \code{\link{assert_terms}()}, \code{\link{assert_valid_queries}()}, \code{\link{extend_source_datasets}()}, \code{\link{filter_date_sources}()}, \code{\link{format.basket_select}()}, +\code{\link{get_hori_data}()}, \code{\link{list_tte_source_objects}()}, \code{\link{params}()}, \code{\link{validate_basket_select}()} diff --git a/man/vars.Rd b/man/vars.Rd deleted file mode 100644 index 144b2c5979..0000000000 --- a/man/vars.Rd +++ /dev/null @@ -1,36 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/reexports.R -\name{vars} -\alias{vars} -\title{Create List of Quosures} -\usage{ -vars(...) -} -\arguments{ -\item{...}{List of variables} -} -\value{ -List of expressions -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} - -This function is \emph{deprecated}, please use \code{exprs()} instead. -} -\seealso{ -Other deprecated: -\code{\link{derive_derived_param}()}, -\code{\link{derive_param_first_event}()}, -\code{\link{derive_var_agegr_fda}()}, -\code{\link{derive_var_confirmation_flag}()}, -\code{\link{derive_var_disposition_status}()}, -\code{\link{derive_var_worst_flag}()}, -\code{\link{derive_vars_disposition_reason}()}, -\code{\link{derive_vars_merged_dtm}()}, -\code{\link{derive_vars_merged_dt}()}, -\code{\link{filter_confirmation}()}, -\code{\link{format_eoxxstt_default}()}, -\code{\link{format_reason_default}()} -} -\concept{deprecated} -\keyword{deprecated} diff --git a/renv.lock b/renv.lock index 098b33b95f..6617448390 100644 --- a/renv.lock +++ b/renv.lock @@ -1,332 +1,349 @@ { "R": { - "Version": "4.0.5", + "Version": "4.1.3", "Repositories": [ { "Name": "CRAN", "URL": "https://cloud.r-project.org" }, { - "Name": "MRAN", - "URL": "https://cran.microsoft.com/snapshot/2021-03-31" + "Name": "RSPM", + "URL": "https://packagemanager.posit.co/cran/2022-03-10" } ] }, "Packages": { - "BH": { - "Package": "BH", - "Version": "1.75.0-0", - "Source": "Repository", - "Repository": "CRAN", - "Hash": "e4c04affc2cac20c8fec18385cd14691", - "Requirements": [] - }, "DT": { "Package": "DT", - "Version": "0.17", + "Version": "0.21", "Source": "Repository", - "Repository": "CRAN", - "Hash": "56b33b77f4cffd78ff96b8e5a69eabb0", + "Repository": "RSPM", "Requirements": [ "crosstalk", "htmltools", "htmlwidgets", + "jquerylib", "jsonlite", "magrittr", "promises" - ] + ], + "Hash": "45fa28dbf288cd606e13ca35d3d72437" }, "R.cache": { "Package": "R.cache", - "Version": "0.16.0", + "Version": "0.15.0", "Source": "Repository", - "Repository": "CRAN", - "Hash": "fe539ca3f8efb7410c3ae2cf5fe6c0f8", + "Repository": "RSPM", "Requirements": [ + "R", "R.methodsS3", "R.oo", "R.utils", - "digest" - ] + "digest", + "utils" + ], + "Hash": "e92a8ea8388c47c82ed8aa435ed3be50" }, "R.methodsS3": { "Package": "R.methodsS3", "Version": "1.8.1", "Source": "Repository", - "Repository": "CRAN", - "Hash": "4bf6453323755202d5909697b6f7c109", - "Requirements": [] + "Repository": "RSPM", + "Requirements": [ + "R", + "utils" + ], + "Hash": "4bf6453323755202d5909697b6f7c109" }, "R.oo": { "Package": "R.oo", "Version": "1.24.0", "Source": "Repository", - "Repository": "CRAN", - "Hash": "5709328352717e2f0a9c012be8a97554", + "Repository": "RSPM", "Requirements": [ - "R.methodsS3" - ] + "R", + "R.methodsS3", + "methods", + "utils" + ], + "Hash": "5709328352717e2f0a9c012be8a97554" }, "R.utils": { "Package": "R.utils", - "Version": "2.12.0", + "Version": "2.11.0", "Source": "Repository", - "Repository": "CRAN", - "Hash": "d31333e10f14027e1cbbc6f266512806", + "Repository": "RSPM", "Requirements": [ + "R", "R.methodsS3", - "R.oo" - ] + "R.oo", + "methods", + "tools", + "utils" + ], + "Hash": "a7ecb8e60815c7a18648e84cd121b23a" }, "R6": { "Package": "R6", - "Version": "2.5.0", + "Version": "2.5.1", "Source": "Repository", - "Repository": "CRAN", - "Hash": "b203113193e70978a696b2809525649d", - "Requirements": [] + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "470851b6d5d0ac559e9d01bb352b4021" }, "Rcpp": { "Package": "Rcpp", - "Version": "1.0.6", - "Source": "Repository", - "Repository": "CRAN", - "Hash": "dbb5e436998a7eba5a9d682060533338", - "Requirements": [] - }, - "admiral.test": { - "Package": "admiral.test", - "Version": "0.4.0", + "Version": "1.0.8", "Source": "Repository", - "Repository": "CRAN", - "Hash": "4643912b04dc40a0251f864206676a0f", - "Requirements": [] + "Repository": "RSPM", + "Requirements": [ + "methods", + "utils" + ], + "Hash": "22b546dd7e337f6c0c58a39983a496bc" }, "askpass": { "Package": "askpass", "Version": "1.1", "Source": "Repository", - "Repository": "CRAN", - "Hash": "e8a22846fff485f0be3770c2da758713", + "Repository": "RSPM", "Requirements": [ "sys" - ] + ], + "Hash": "e8a22846fff485f0be3770c2da758713" + }, + "backports": { + "Package": "backports", + "Version": "1.4.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "c39fbec8a30d23e721980b8afb31984c" }, "base64enc": { "Package": "base64enc", "Version": "0.1-3", "Source": "Repository", - "Repository": "CRAN", - "Hash": "543776ae6848fde2f48ff3816d0628bc", - "Requirements": [] + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "543776ae6848fde2f48ff3816d0628bc" }, "brew": { "Package": "brew", - "Version": "1.0-6", + "Version": "1.0-7", "Source": "Repository", - "Repository": "CRAN", - "Hash": "92a5f887f9ae3035ac7afde22ba73ee9", - "Requirements": [] + "Repository": "RSPM", + "Hash": "38875ea52350ff4b4c03849fc69736c8" }, "brio": { "Package": "brio", "Version": "1.1.3", "Source": "Repository", - "Repository": "CRAN", - "Hash": "976cf154dfb043c012d87cddd8bca363", - "Requirements": [] + "Repository": "RSPM", + "Hash": "976cf154dfb043c012d87cddd8bca363" }, "bslib": { "Package": "bslib", - "Version": "0.4.2", + "Version": "0.3.1", "Source": "Repository", - "Repository": "CRAN", - "Hash": "a7fbf03946ad741129dc81098722fca1", + "Repository": "RSPM", "Requirements": [ - "base64enc", - "cachem", + "R", + "grDevices", "htmltools", "jquerylib", "jsonlite", - "memoise", - "mime", "rlang", "sass" - ] + ], + "Hash": "56ae7e1987b340186a8a5a157c2ec358" }, "cachem": { "Package": "cachem", - "Version": "1.0.4", + "Version": "1.0.6", "Source": "Repository", - "Repository": "CRAN", - "Hash": "2703a46dcabfb902f10060b2bca9f708", + "Repository": "RSPM", "Requirements": [ "fastmap", "rlang" - ] + ], + "Hash": "648c5b3d71e6a37e3043617489a0a0e9" }, "callr": { "Package": "callr", "Version": "3.7.3", "Source": "Repository", "Repository": "CRAN", - "Hash": "9b2191ede20fa29828139b9900922e51", "Requirements": [ + "R", "R6", - "processx" - ] - }, - "cellranger": { - "Package": "cellranger", - "Version": "1.1.0", - "Source": "Repository", - "Repository": "CRAN", - "Hash": "f61dbaec772ccd2e17705c1e872e9e7c", - "Requirements": [ - "rematch", - "tibble" - ] + "processx", + "utils" + ], + "Hash": "9b2191ede20fa29828139b9900922e51" }, "cli": { "Package": "cli", "Version": "3.4.1", "Source": "Repository", "Repository": "CRAN", - "Hash": "0d297d01734d2bcea40197bd4971a764", - "Requirements": [] + "Requirements": [ + "R", + "utils" + ], + "Hash": "0d297d01734d2bcea40197bd4971a764" }, "clipr": { "Package": "clipr", "Version": "0.8.0", "Source": "Repository", - "Repository": "CRAN", - "Hash": "3f038e5ac7f41d4ac41ce658c85e3042", - "Requirements": [] + "Repository": "RSPM", + "Requirements": [ + "utils" + ], + "Hash": "3f038e5ac7f41d4ac41ce658c85e3042" }, "codetools": { "Package": "codetools", "Version": "0.2-18", "Source": "Repository", "Repository": "CRAN", - "Hash": "019388fc48e48b3da0d3a76ff94608a8", - "Requirements": [] + "Requirements": [ + "R" + ], + "Hash": "019388fc48e48b3da0d3a76ff94608a8" }, "commonmark": { "Package": "commonmark", - "Version": "1.8.1", + "Version": "1.8.0", "Source": "Repository", - "Repository": "CRAN", - "Hash": "b6e3e947d1d7ebf3d2bdcea1bde63fe7", - "Requirements": [] + "Repository": "RSPM", + "Hash": "2ba81b120c1655ab696c935ef33ea716" }, "covr": { "Package": "covr", - "Version": "3.6.1", + "Version": "3.5.1", "Source": "Repository", - "Repository": "CRAN", - "Hash": "a861cee34fbb4b107a73dd414ef56724", + "Repository": "RSPM", "Requirements": [ + "R", "crayon", "digest", "httr", "jsonlite", + "methods", "rex", + "stats", + "utils", "withr", "yaml" - ] + ], + "Hash": "6d80a9fc3c0c8473153b54fa54719dfd" }, "cpp11": { "Package": "cpp11", "Version": "0.4.3", "Source": "Repository", "Repository": "CRAN", - "Hash": "ed588261931ee3be2c700d22e94a29ab", - "Requirements": [] + "Hash": "ed588261931ee3be2c700d22e94a29ab" }, "crayon": { "Package": "crayon", - "Version": "1.5.2", + "Version": "1.5.0", "Source": "Repository", - "Repository": "CRAN", - "Hash": "e8a1e41acf02548751f45c718d55aa6a", - "Requirements": [] + "Repository": "RSPM", + "Requirements": [ + "grDevices", + "methods", + "utils" + ], + "Hash": "741c2e098e98afe3dc26a7b0e5489f4e" }, "credentials": { "Package": "credentials", "Version": "1.3.2", "Source": "Repository", - "Repository": "CRAN", - "Hash": "93762d0a34d78e6a025efdbfb5c6bb41", + "Repository": "RSPM", "Requirements": [ "askpass", "curl", "jsonlite", "openssl", "sys" - ] + ], + "Hash": "93762d0a34d78e6a025efdbfb5c6bb41" }, "crosstalk": { "Package": "crosstalk", - "Version": "1.1.1", + "Version": "1.2.0", "Source": "Repository", - "Repository": "CRAN", - "Hash": "2b06f9e415a62b6762e4b8098d2aecbc", + "Repository": "RSPM", "Requirements": [ "R6", "htmltools", "jsonlite", "lazyeval" - ] + ], + "Hash": "6aa54f69598c32177e920eb3402e8293" }, "curl": { "Package": "curl", - "Version": "5.0.0", + "Version": "4.3.2", "Source": "Repository", - "Repository": "CRAN", - "Hash": "e4f97056611e8e6b8b852d13b7400cf1", - "Requirements": [] + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "022c42d49c28e95d69ca60446dbabf88" }, "cyclocomp": { "Package": "cyclocomp", "Version": "1.1.0", "Source": "Repository", - "Repository": "CRAN", - "Hash": "53cbed70a2f7472d48fb6aef08442f25", + "Repository": "RSPM", "Requirements": [ "callr", "crayon", "desc", "remotes", "withr" - ] + ], + "Hash": "53cbed70a2f7472d48fb6aef08442f25" }, "desc": { "Package": "desc", "Version": "1.4.2", "Source": "Repository", "Repository": "CRAN", - "Hash": "6b9602c7ebbe87101a9c8edb6e8b6d21", "Requirements": [ + "R", "R6", "cli", - "rprojroot" - ] + "rprojroot", + "utils" + ], + "Hash": "6b9602c7ebbe87101a9c8edb6e8b6d21" }, "devtools": { "Package": "devtools", - "Version": "2.3.2", + "Version": "2.4.3", "Source": "Repository", - "Repository": "CRAN", - "Hash": "415656f50722f5b6e6bcf80855ce11b9", + "Repository": "RSPM", "Requirements": [ - "DT", + "R", "callr", "cli", - "covr", "desc", "ellipsis", + "fs", "httr", - "jsonlite", + "lifecycle", "memoise", "pkgbuild", "pkgload", @@ -337,46 +354,59 @@ "rstudioapi", "rversions", "sessioninfo", + "stats", "testthat", + "tools", "usethis", + "utils", "withr" - ] + ], + "Hash": "fc35e13bb582e5fe6f63f3d647a4cbe5" }, "diffdf": { "Package": "diffdf", "Version": "1.0.4", "Source": "Repository", - "Repository": "CRAN", - "Hash": "9ddedef46959baad2080047a1b0117fe", + "Repository": "RSPM", "Requirements": [ + "R", "tibble" - ] + ], + "Hash": "9ddedef46959baad2080047a1b0117fe" }, "diffobj": { "Package": "diffobj", "Version": "0.3.5", "Source": "Repository", - "Repository": "CRAN", - "Hash": "bcaa8b95f8d7d01a5dedfd959ce88ab8", + "Repository": "RSPM", "Requirements": [ - "crayon" - ] + "R", + "crayon", + "methods", + "stats", + "tools", + "utils" + ], + "Hash": "bcaa8b95f8d7d01a5dedfd959ce88ab8" }, "digest": { "Package": "digest", - "Version": "0.6.27", + "Version": "0.6.29", "Source": "Repository", - "Repository": "CRAN", - "Hash": "a0cbe758a531d054b537d16dff4d58a1", - "Requirements": [] + "Repository": "RSPM", + "Requirements": [ + "R", + "utils" + ], + "Hash": "cf6b206a045a684728c3267ef7596190" }, "downlit": { "Package": "downlit", - "Version": "0.4.2", + "Version": "0.4.0", "Source": "Repository", - "Repository": "CRAN", - "Hash": "79bf3f66590752ffbba20f8d2da94c7c", + "Repository": "RSPM", "Requirements": [ + "R", "brio", "desc", "digest", @@ -385,85 +415,113 @@ "memoise", "rlang", "vctrs", - "withr", "yaml" - ] + ], + "Hash": "ba63dc9ab5a31f3209892437e40c5f60" }, "dplyr": { "Package": "dplyr", - "Version": "1.0.5", + "Version": "1.1.1", "Source": "Repository", "Repository": "CRAN", - "Hash": "d0d76c11ec807eb3f000eba4e3eb0f68", "Requirements": [ + "R", "R6", - "ellipsis", + "cli", "generics", "glue", "lifecycle", "magrittr", + "methods", + "pillar", "rlang", "tibble", "tidyselect", + "utils", "vctrs" - ] + ], + "Hash": "eb5742d256a0d9306d85ea68756d8187" }, "ellipsis": { "Package": "ellipsis", "Version": "0.3.2", "Source": "Repository", - "Repository": "CRAN", - "Hash": "bb0eec2fe32e88d9e2836c2f73ea2077", + "Repository": "RSPM", "Requirements": [ + "R", "rlang" - ] + ], + "Hash": "bb0eec2fe32e88d9e2836c2f73ea2077" }, "evaluate": { "Package": "evaluate", - "Version": "0.20", + "Version": "0.15", "Source": "Repository", - "Repository": "CRAN", - "Hash": "4b68aa51edd89a0e044a66e75ae3cc6c", - "Requirements": [] + "Repository": "RSPM", + "Requirements": [ + "R", + "methods" + ], + "Hash": "699a7a93d08c962d9f8950b2d7a227f1" }, "fansi": { "Package": "fansi", - "Version": "1.0.4", + "Version": "1.0.2", "Source": "Repository", - "Repository": "CRAN", - "Hash": "1d9e7ad3c8312a192dea7d3db0274fde", - "Requirements": [] + "Repository": "RSPM", + "Requirements": [ + "R", + "grDevices", + "utils" + ], + "Hash": "f28149c2d7a1342a834b314e95e67260" }, "fastmap": { "Package": "fastmap", "Version": "1.1.0", "Source": "Repository", - "Repository": "CRAN", - "Hash": "77bd60a6157420d4ffa93b27cf6a58b8", - "Requirements": [] + "Repository": "RSPM", + "Hash": "77bd60a6157420d4ffa93b27cf6a58b8" + }, + "fontawesome": { + "Package": "fontawesome", + "Version": "0.2.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "htmltools", + "rlang" + ], + "Hash": "55624ed409e46c5f358b2c060be87f67" }, "fs": { "Package": "fs", "Version": "1.5.2", "Source": "Repository", - "Repository": "CRAN", - "Hash": "7c89603d81793f0d5486d91ab1fc6f1d", - "Requirements": [] + "Repository": "RSPM", + "Requirements": [ + "R", + "methods" + ], + "Hash": "7c89603d81793f0d5486d91ab1fc6f1d" }, "generics": { "Package": "generics", - "Version": "0.1.0", + "Version": "0.1.2", "Source": "Repository", - "Repository": "CRAN", - "Hash": "4d243a9c10b00589889fe32314ffd902", - "Requirements": [] + "Repository": "RSPM", + "Requirements": [ + "R", + "methods" + ], + "Hash": "177475892cf4a55865868527654a7741" }, "gert": { "Package": "gert", - "Version": "1.9.1", + "Version": "1.5.0", "Source": "Repository", - "Repository": "CRAN", - "Hash": "9a091a6d2fb91e43afd4337e2dcef2e7", + "Repository": "RSPM", "Requirements": [ "askpass", "credentials", @@ -471,284 +529,338 @@ "rstudioapi", "sys", "zip" - ] + ], + "Hash": "8fddce7cbd59467106266a6e93e253b4" }, "gh": { "Package": "gh", - "Version": "1.3.1", + "Version": "1.3.0", "Source": "Repository", - "Repository": "CRAN", - "Hash": "b6a12054ee13dce0f6696c019c10e539", + "Repository": "RSPM", "Requirements": [ "cli", "gitcreds", "httr", "ini", "jsonlite" - ] + ], + "Hash": "38c2580abbda249bd6afeec00d14f531" }, "git2r": { "Package": "git2r", - "Version": "0.28.0", + "Version": "0.29.0", "Source": "Repository", - "Repository": "CRAN", - "Hash": "f64fd34026f6025de71a4354800e6d79", - "Requirements": [] + "Repository": "RSPM", + "Requirements": [ + "R", + "graphics", + "utils" + ], + "Hash": "b114135c4749076bd5ef74a5827b6f62" }, "gitcreds": { "Package": "gitcreds", "Version": "0.1.1", "Source": "Repository", - "Repository": "CRAN", - "Hash": "f3aefccc1cc50de6338146b62f115de8", - "Requirements": [] + "Repository": "RSPM", + "Hash": "f3aefccc1cc50de6338146b62f115de8" }, "glue": { "Package": "glue", "Version": "1.6.2", "Source": "Repository", - "Repository": "CRAN", - "Hash": "4f2596dfb05dac67b9dc558e5c6fba2e", - "Requirements": [] + "Repository": "RSPM", + "Requirements": [ + "R", + "methods" + ], + "Hash": "4f2596dfb05dac67b9dc558e5c6fba2e" }, "highr": { "Package": "highr", - "Version": "0.8", + "Version": "0.9", "Source": "Repository", - "Repository": "CRAN", - "Hash": "4dc5bb88961e347a0f4d8aad597cbfac", - "Requirements": [] + "Repository": "RSPM", + "Requirements": [ + "R", + "xfun" + ], + "Hash": "8eb36c8125038e648e5d111c0d7b2ed4" }, "hms": { "Package": "hms", - "Version": "1.0.0", + "Version": "1.1.1", "Source": "Repository", - "Repository": "CRAN", - "Hash": "bf552cdd96f5969873afdac7311c7d0d", + "Repository": "RSPM", "Requirements": [ "ellipsis", "lifecycle", + "methods", "pkgconfig", "rlang", "vctrs" - ] + ], + "Hash": "5b8a2dd0fdbe2ab4f6081e6c7be6dfca" }, "htmltools": { "Package": "htmltools", - "Version": "0.5.4", + "Version": "0.5.2", "Source": "Repository", - "Repository": "CRAN", - "Hash": "9d27e99cc90bd701c0a7a63e5923f9b7", + "Repository": "RSPM", "Requirements": [ + "R", "base64enc", "digest", - "ellipsis", "fastmap", - "rlang" - ] + "grDevices", + "rlang", + "utils" + ], + "Hash": "526c484233f42522278ab06fb185cb26" }, "htmlwidgets": { "Package": "htmlwidgets", - "Version": "1.5.3", + "Version": "1.5.4", "Source": "Repository", - "Repository": "CRAN", - "Hash": "6fdaa86d0700f8b3e92ee3c445a5a10d", + "Repository": "RSPM", "Requirements": [ + "grDevices", "htmltools", "jsonlite", "yaml" - ] + ], + "Hash": "76147821cd3fcd8c4b04e1ef0498e7fb" + }, + "httpuv": { + "Package": "httpuv", + "Version": "1.6.5", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R6", + "Rcpp", + "later", + "promises", + "utils" + ], + "Hash": "97fe71f0a4a1c9890e6c2128afa04bc0" }, "httr": { "Package": "httr", "Version": "1.4.2", "Source": "Repository", - "Repository": "CRAN", - "Hash": "a525aba14184fec243f9eaec62fbed43", + "Repository": "RSPM", "Requirements": [ + "R", "R6", "curl", "jsonlite", "mime", "openssl" - ] + ], + "Hash": "a525aba14184fec243f9eaec62fbed43" }, "hunspell": { "Package": "hunspell", "Version": "3.0.1", "Source": "Repository", - "Repository": "CRAN", - "Hash": "3987784c19192ad0f2261c456d936df1", + "Repository": "RSPM", "Requirements": [ + "R", "Rcpp", "digest" - ] + ], + "Hash": "3987784c19192ad0f2261c456d936df1" }, "ini": { "Package": "ini", "Version": "0.3.1", "Source": "Repository", - "Repository": "CRAN", - "Hash": "6154ec2223172bce8162d4153cda21f7", - "Requirements": [] + "Repository": "RSPM", + "Hash": "6154ec2223172bce8162d4153cda21f7" }, "jquerylib": { "Package": "jquerylib", "Version": "0.1.4", "Source": "Repository", - "Repository": "CRAN", - "Hash": "5aab57a3bd297eee1c1d862735972182", + "Repository": "RSPM", "Requirements": [ "htmltools" - ] + ], + "Hash": "5aab57a3bd297eee1c1d862735972182" }, "jsonlite": { "Package": "jsonlite", - "Version": "1.7.2", + "Version": "1.8.0", "Source": "Repository", - "Repository": "CRAN", - "Hash": "98138e0994d41508c7a6b84a0600cfcb", - "Requirements": [] + "Repository": "RSPM", + "Requirements": [ + "methods" + ], + "Hash": "d07e729b27b372429d42d24d503613a0" }, "knitr": { "Package": "knitr", "Version": "1.40", "Source": "Repository", "Repository": "CRAN", - "Hash": "caea8b0f899a0b1738444b9bc47067e7", "Requirements": [ + "R", "evaluate", "highr", + "methods", "stringr", + "tools", "xfun", "yaml" - ] + ], + "Hash": "caea8b0f899a0b1738444b9bc47067e7" }, "later": { "Package": "later", - "Version": "1.1.0.1", + "Version": "1.3.0", "Source": "Repository", - "Repository": "CRAN", - "Hash": "d0a62b247165aabf397fded504660d8a", + "Repository": "RSPM", "Requirements": [ - "BH", "Rcpp", "rlang" - ] + ], + "Hash": "7e7b457d7766bc47f2a5f21cc2984f8e" }, "lazyeval": { "Package": "lazyeval", "Version": "0.2.2", "Source": "Repository", - "Repository": "CRAN", - "Hash": "d908914ae53b04d4c0c0fd72ecc35370", - "Requirements": [] + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "d908914ae53b04d4c0c0fd72ecc35370" }, "lifecycle": { "Package": "lifecycle", "Version": "1.0.3", "Source": "Repository", - "Repository": "CRAN", - "Hash": "001cecbeac1cff9301bdc3775ee46a86", + "Repository": "RSPM", "Requirements": [ + "R", "cli", "glue", "rlang" - ] + ], + "Hash": "001cecbeac1cff9301bdc3775ee46a86" }, "lintr": { "Package": "lintr", - "Version": "2.0.1", + "Version": "3.0.2", "Source": "Repository", "Repository": "CRAN", - "Hash": "023cecbdc0a32f86ad3cb1734c018d2e", "Requirements": [ + "R", + "backports", "codetools", "crayon", "cyclocomp", "digest", - "httr", + "glue", "jsonlite", "knitr", "rex", - "rstudioapi", - "testthat", + "stats", + "utils", "xml2", "xmlparsedata" - ] + ], + "Hash": "b21ebd652d940f099915221f3328ab7b" }, "lubridate": { "Package": "lubridate", - "Version": "1.7.10", + "Version": "1.8.0", "Source": "Repository", - "Repository": "CRAN", - "Hash": "1ebfdc8a3cfe8fe19184f5481972b092", + "Repository": "RSPM", "Requirements": [ - "Rcpp", - "generics" - ] + "R", + "cpp11", + "generics", + "methods" + ], + "Hash": "2ff5eedb6ee38fb1b81205c73be1be5a" }, "magrittr": { "Package": "magrittr", - "Version": "2.0.3", + "Version": "2.0.2", "Source": "Repository", - "Repository": "CRAN", - "Hash": "7ce2733a9826b3aeb1775d56fd305472", - "Requirements": [] + "Repository": "RSPM", + "Hash": "cdc87ecd81934679d1557633d8e1fe51" }, "memoise": { "Package": "memoise", "Version": "2.0.1", "Source": "Repository", - "Repository": "CRAN", - "Hash": "e2817ccf4a065c5d9d7f2cfbe7c1d78c", + "Repository": "RSPM", "Requirements": [ "cachem", "rlang" - ] + ], + "Hash": "e2817ccf4a065c5d9d7f2cfbe7c1d78c" }, "mime": { "Package": "mime", - "Version": "0.10", + "Version": "0.12", "Source": "Repository", - "Repository": "CRAN", - "Hash": "26fa77e707223e1ce042b2b5d09993dc", - "Requirements": [] + "Repository": "RSPM", + "Requirements": [ + "tools" + ], + "Hash": "18e9c28c1d3ca1560ce30658b22ce104" + }, + "miniUI": { + "Package": "miniUI", + "Version": "0.1.1.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "htmltools", + "shiny", + "utils" + ], + "Hash": "fec5f52652d60615fdb3957b3d74324a" }, "openssl": { "Package": "openssl", - "Version": "2.0.4", + "Version": "2.0.0", "Source": "Repository", - "Repository": "CRAN", - "Hash": "e86c5ffeb8474a9e03d75f5d2919683e", + "Repository": "RSPM", "Requirements": [ "askpass" - ] + ], + "Hash": "cf4329aac12c2c44089974559c18e446" }, "pillar": { "Package": "pillar", - "Version": "1.5.1", + "Version": "1.9.0", "Source": "Repository", "Repository": "CRAN", - "Hash": "24622aa4a0d3de3463c34513edca99b2", "Requirements": [ "cli", - "crayon", - "ellipsis", "fansi", + "glue", "lifecycle", "rlang", "utf8", + "utils", "vctrs" - ] + ], + "Hash": "15da5a8412f317beeee6175fbc76f4bb" }, "pkgbuild": { "Package": "pkgbuild", - "Version": "1.2.0", + "Version": "1.3.1", "Source": "Repository", - "Repository": "CRAN", - "Hash": "725fcc30222d4d11ec68efb8ff11a9af", + "Repository": "RSPM", "Requirements": [ + "R", "R6", "callr", "cli", @@ -757,23 +869,26 @@ "prettyunits", "rprojroot", "withr" - ] + ], + "Hash": "66d2adfed274daf81ccfe77d974c3b9b" }, "pkgconfig": { "Package": "pkgconfig", "Version": "2.0.3", "Source": "Repository", - "Repository": "CRAN", - "Hash": "01f28d4278f15c76cddbea05899c5d6f", - "Requirements": [] + "Repository": "RSPM", + "Requirements": [ + "utils" + ], + "Hash": "01f28d4278f15c76cddbea05899c5d6f" }, "pkgdown": { "Package": "pkgdown", - "Version": "2.0.6", + "Version": "2.0.7", "Source": "Repository", "Repository": "CRAN", - "Hash": "f958d0b2a5dabc5ffd414f062b1ffbe7", "Requirements": [ + "R", "bslib", "callr", "cli", @@ -794,322 +909,362 @@ "withr", "xml2", "yaml" - ] + ], + "Hash": "16fa15449c930bf3a7761d3c68f8abf9" }, "pkgload": { "Package": "pkgload", - "Version": "1.2.0", + "Version": "1.2.4", "Source": "Repository", - "Repository": "CRAN", - "Hash": "cb57de933545960a86f03513e4bd2911", + "Repository": "RSPM", "Requirements": [ "cli", "crayon", "desc", - "pkgbuild", + "methods", "rlang", "rprojroot", "rstudioapi", + "utils", "withr" - ] + ], + "Hash": "7533cd805940821bf23eaf3c8d4c1735" }, "praise": { "Package": "praise", "Version": "1.0.0", "Source": "Repository", - "Repository": "CRAN", - "Hash": "a555924add98c99d2f411e37e7d25e9f", - "Requirements": [] + "Repository": "RSPM", + "Hash": "a555924add98c99d2f411e37e7d25e9f" }, "prettyunits": { "Package": "prettyunits", "Version": "1.1.1", "Source": "Repository", - "Repository": "CRAN", - "Hash": "95ef9167b75dde9d2ccc3c7528393e7e", - "Requirements": [] + "Repository": "RSPM", + "Hash": "95ef9167b75dde9d2ccc3c7528393e7e" }, "processx": { "Package": "processx", - "Version": "3.8.0", - "Source": "Repository", - "Repository": "CRAN", - "Hash": "a33ee2d9bf07564efb888ad98410da84", - "Requirements": [ - "R6", - "ps" - ] - }, - "progress": { - "Package": "progress", - "Version": "1.2.2", + "Version": "3.6.1", "Source": "Repository", "Repository": "CRAN", - "Hash": "14dc9f7a3c91ebb14ec5bb9208a07061", "Requirements": [ + "R", "R6", - "crayon", - "hms", - "prettyunits" - ] + "ps", + "utils" + ], + "Hash": "a11891e28c1f1e5ddd773ba1b8c07cf6" }, "promises": { "Package": "promises", "Version": "1.2.0.1", "Source": "Repository", - "Repository": "CRAN", - "Hash": "4ab2c43adb4d4699cf3690acd378d75d", + "Repository": "RSPM", "Requirements": [ "R6", "Rcpp", "later", "magrittr", - "rlang" - ] + "rlang", + "stats" + ], + "Hash": "4ab2c43adb4d4699cf3690acd378d75d" }, "ps": { "Package": "ps", "Version": "1.6.0", "Source": "Repository", - "Repository": "CRAN", - "Hash": "32620e2001c1dce1af49c49dccbb9420", - "Requirements": [] + "Repository": "RSPM", + "Requirements": [ + "R", + "utils" + ], + "Hash": "32620e2001c1dce1af49c49dccbb9420" }, "purrr": { "Package": "purrr", "Version": "0.3.4", "Source": "Repository", - "Repository": "CRAN", - "Hash": "97def703420c8ab10d8f0e6c72101e02", + "Repository": "RSPM", "Requirements": [ + "R", "magrittr", "rlang" - ] + ], + "Hash": "97def703420c8ab10d8f0e6c72101e02" }, "ragg": { "Package": "ragg", - "Version": "1.2.4", + "Version": "1.2.2", "Source": "Repository", - "Repository": "CRAN", - "Hash": "0db17bd5a1d4abfec76487b6f5dd957b", + "Repository": "RSPM", "Requirements": [ "systemfonts", "textshaping" - ] + ], + "Hash": "14932bb6f2739c771ca4ceaba6b4248e" }, "rappdirs": { "Package": "rappdirs", "Version": "0.3.3", "Source": "Repository", - "Repository": "CRAN", - "Hash": "5e3c5dc0b071b21fa128676560dbe94d", - "Requirements": [] + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "5e3c5dc0b071b21fa128676560dbe94d" }, "rcmdcheck": { "Package": "rcmdcheck", - "Version": "1.3.3", + "Version": "1.4.0", "Source": "Repository", - "Repository": "CRAN", - "Hash": "ed95895886dab6d2a584da45503555da", + "Repository": "RSPM", "Requirements": [ "R6", "callr", "cli", - "crayon", + "curl", "desc", "digest", "pkgbuild", "prettyunits", "rprojroot", "sessioninfo", + "utils", "withr", "xopen" - ] - }, - "readxl": { - "Package": "readxl", - "Version": "1.3.1", - "Source": "Repository", - "Repository": "CRAN", - "Hash": "63537c483c2dbec8d9e3183b3735254a", - "Requirements": [ - "Rcpp", - "cellranger", - "progress", - "tibble" - ] - }, - "rematch": { - "Package": "rematch", - "Version": "1.0.1", - "Source": "Repository", - "Repository": "CRAN", - "Hash": "c66b930d20bb6d858cd18e1cebcfae5c", - "Requirements": [] + ], + "Hash": "8f25ebe2ec38b1f2aef3b0d2ef76f6c4" }, "rematch2": { "Package": "rematch2", "Version": "2.1.2", "Source": "Repository", - "Repository": "CRAN", - "Hash": "76c9e04c712a05848ae7a23d2f170a40", + "Repository": "RSPM", "Requirements": [ "tibble" - ] + ], + "Hash": "76c9e04c712a05848ae7a23d2f170a40" }, "remotes": { "Package": "remotes", - "Version": "2.2.0", + "Version": "2.4.2", "Source": "Repository", - "Repository": "CRAN", - "Hash": "430a0908aee75b1fcba0e62857cab0ce", - "Requirements": [] + "Repository": "RSPM", + "Requirements": [ + "R", + "methods", + "stats", + "tools", + "utils" + ], + "Hash": "227045be9aee47e6dda9bb38ac870d67" }, "renv": { "Package": "renv", - "Version": "0.16.0", + "Version": "0.17.0", "Source": "Repository", - "Repository": "CRAN", - "Hash": "c9e8442ab69bc21c9697ecf856c1e6c7", - "Requirements": [] + "Repository": "RSPM", + "Requirements": [ + "utils" + ], + "Hash": "ce3065fc1a0b64a859f55ac3998d6927" }, "rex": { "Package": "rex", - "Version": "1.2.0", + "Version": "1.2.1", "Source": "Repository", - "Repository": "CRAN", - "Hash": "093584b944440c5cd07a696b3c8e0e4c", + "Repository": "RSPM", "Requirements": [ "lazyeval" - ] + ], + "Hash": "ae34cd56890607370665bee5bd17812f" }, "rlang": { "Package": "rlang", - "Version": "1.0.6", + "Version": "1.1.0", "Source": "Repository", "Repository": "CRAN", - "Hash": "4ed1f8336c8d52c3e750adcdc57228a7", - "Requirements": [] + "Requirements": [ + "R", + "utils" + ], + "Hash": "dc079ccd156cde8647360f473c1fa718" }, "rmarkdown": { "Package": "rmarkdown", "Version": "2.17", "Source": "Repository", "Repository": "CRAN", - "Hash": "e97c8be593e010f93520e8215c0f9189", "Requirements": [ + "R", "bslib", "evaluate", "htmltools", "jquerylib", "jsonlite", "knitr", + "methods", "stringr", "tinytex", + "tools", + "utils", "xfun", "yaml" - ] + ], + "Hash": "e97c8be593e010f93520e8215c0f9189" }, "roxygen2": { "Package": "roxygen2", - "Version": "7.2.1", + "Version": "7.2.3", "Source": "Repository", "Repository": "CRAN", - "Hash": "da1f278262e563c835345872f2fef537", "Requirements": [ + "R", "R6", "brew", "cli", "commonmark", "cpp11", "desc", - "digest", "knitr", + "methods", "pkgload", "purrr", "rlang", "stringi", "stringr", + "utils", "withr", "xml2" - ] + ], + "Hash": "7b153c746193b143c14baa072bae4e27" }, "rprojroot": { "Package": "rprojroot", "Version": "2.0.2", "Source": "Repository", - "Repository": "CRAN", - "Hash": "249d8cd1e74a8f6a26194a91b47f21d1", - "Requirements": [] + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "249d8cd1e74a8f6a26194a91b47f21d1" }, "rstudioapi": { "Package": "rstudioapi", "Version": "0.13", "Source": "Repository", - "Repository": "CRAN", - "Hash": "06c85365a03fdaf699966cc1d3cf53ea", - "Requirements": [] + "Repository": "RSPM", + "Hash": "06c85365a03fdaf699966cc1d3cf53ea" }, "rversions": { "Package": "rversions", - "Version": "2.0.2", + "Version": "2.1.1", "Source": "Repository", - "Repository": "CRAN", - "Hash": "0ec41191f744d0f5afad8c6f35cc36e4", + "Repository": "RSPM", "Requirements": [ "curl", + "utils", "xml2" - ] + ], + "Hash": "f88fab00907b312f8b23ec13e2d437cb" }, "sass": { "Package": "sass", - "Version": "0.4.2", + "Version": "0.4.0", "Source": "Repository", - "Repository": "CRAN", - "Hash": "1b191143d7d3444d504277843f3a95fe", + "Repository": "RSPM", "Requirements": [ "R6", "fs", "htmltools", "rappdirs", "rlang" - ] + ], + "Hash": "50cf822feb64bb3977bda0b7091be623" }, "sessioninfo": { "Package": "sessioninfo", - "Version": "1.1.1", + "Version": "1.2.2", "Source": "Repository", - "Repository": "CRAN", - "Hash": "308013098befe37484df72c39cf90d6e", + "Repository": "RSPM", "Requirements": [ + "R", "cli", - "withr" - ] + "tools", + "utils" + ], + "Hash": "3f9796a8d0a0e8c6eb49a4b029359d1f" + }, + "shiny": { + "Package": "shiny", + "Version": "1.7.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R6", + "bslib", + "cachem", + "commonmark", + "crayon", + "ellipsis", + "fastmap", + "fontawesome", + "glue", + "grDevices", + "htmltools", + "httpuv", + "jsonlite", + "later", + "lifecycle", + "methods", + "mime", + "promises", + "rlang", + "sourcetools", + "tools", + "utils", + "withr", + "xtable" + ], + "Hash": "00344c227c7bd0ab5d78052c5d736c44" + }, + "sourcetools": { + "Package": "sourcetools", + "Version": "0.1.7", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "947e4e02a79effa5d512473e10f41797" }, "spelling": { "Package": "spelling", "Version": "2.2", "Source": "Repository", - "Repository": "CRAN", - "Hash": "b8c899a5c83f0d897286550481c91798", + "Repository": "RSPM", "Requirements": [ "commonmark", "hunspell", "knitr", "xml2" - ] + ], + "Hash": "b8c899a5c83f0d897286550481c91798" }, "staged.dependencies": { "Package": "staged.dependencies", - "Version": "0.2.7", + "Version": "0.2.8", "Source": "GitHub", "RemoteType": "github", "RemoteHost": "api.github.com", - "RemoteRepo": "staged.dependencies", "RemoteUsername": "openpharma", - "RemoteRef": "HEAD", - "RemoteSha": "669f45a95d8772899551ad51fc3b38a3b5a1056a", - "Hash": "348648f944ce5dbcbdc2b120c9ba3a3c", + "RemoteRepo": "staged.dependencies", + "RemoteRef": "main", + "RemoteSha": "ce7c112ba3d75cf48e4dd6310b3140ab0ec3b486", "Requirements": [ "desc", "devtools", @@ -1120,81 +1275,92 @@ "glue", "httr", "jsonlite", + "methods", "rcmdcheck", "remotes", "rlang", + "stats", "tidyr", + "utils", "withr", "yaml" - ] + ], + "Hash": "89f2e1d1009601f58f64b7092abcc0d7" }, "stringi": { "Package": "stringi", "Version": "1.7.6", "Source": "Repository", - "Repository": "CRAN", - "Hash": "bba431031d30789535745a9627ac9271", - "Requirements": [] + "Repository": "RSPM", + "Requirements": [ + "R", + "stats", + "tools", + "utils" + ], + "Hash": "bba431031d30789535745a9627ac9271" }, "stringr": { "Package": "stringr", "Version": "1.4.0", "Source": "Repository", - "Repository": "CRAN", - "Hash": "0759e6b6c0957edb1311028a49a35e76", + "Repository": "RSPM", "Requirements": [ + "R", "glue", "magrittr", "stringi" - ] + ], + "Hash": "0759e6b6c0957edb1311028a49a35e76" }, "styler": { "Package": "styler", - "Version": "1.8.0", + "Version": "1.9.1", "Source": "Repository", "Repository": "CRAN", - "Hash": "c855e70eb69b3dd8883660b7110e0c44", "Requirements": [ + "R", "R.cache", "cli", "magrittr", "purrr", "rlang", "rprojroot", + "tools", "vctrs", "withr" - ] + ], + "Hash": "ed8c90822b7da46beee603f263a85fe0" }, "sys": { "Package": "sys", "Version": "3.4", "Source": "Repository", - "Repository": "CRAN", - "Hash": "b227d13e29222b4574486cfcbde077fa", - "Requirements": [] + "Repository": "RSPM", + "Hash": "b227d13e29222b4574486cfcbde077fa" }, "systemfonts": { "Package": "systemfonts", "Version": "1.0.4", "Source": "Repository", - "Repository": "CRAN", - "Hash": "90b28393209827327de889f49935140a", + "Repository": "RSPM", "Requirements": [ + "R", "cpp11" - ] + ], + "Hash": "90b28393209827327de889f49935140a" }, "testthat": { "Package": "testthat", - "Version": "3.0.2", + "Version": "3.1.7", "Source": "Repository", "Repository": "CRAN", - "Hash": "495e0434d9305716b6a87031570ce109", "Requirements": [ + "R", "R6", "brio", "callr", "cli", - "crayon", "desc", "digest", "ellipsis", @@ -1202,50 +1368,56 @@ "jsonlite", "lifecycle", "magrittr", + "methods", "pkgload", "praise", "processx", "ps", "rlang", + "utils", "waldo", "withr" - ] + ], + "Hash": "7eb5fd202a61d2fb78af5869b6c08998" }, "textshaping": { "Package": "textshaping", "Version": "0.3.6", "Source": "Repository", - "Repository": "CRAN", - "Hash": "1ab6223d3670fac7143202cb6a2d43d5", + "Repository": "RSPM", "Requirements": [ + "R", "cpp11", "systemfonts" - ] + ], + "Hash": "1ab6223d3670fac7143202cb6a2d43d5" }, "tibble": { "Package": "tibble", - "Version": "3.1.0", + "Version": "3.2.0", "Source": "Repository", "Repository": "CRAN", - "Hash": "4d894a114dbd4ecafeda5074e7c538e6", "Requirements": [ - "ellipsis", + "R", "fansi", "lifecycle", "magrittr", + "methods", "pillar", "pkgconfig", "rlang", + "utils", "vctrs" - ] + ], + "Hash": "37695ff125982007d42a59ad10982ff2" }, "tidyr": { "Package": "tidyr", - "Version": "1.1.3", + "Version": "1.2.0", "Source": "Repository", - "Repository": "CRAN", - "Hash": "450d7dfaedde58e28586b854eeece4fa", + "Repository": "RSPM", "Requirements": [ + "R", "cpp11", "dplyr", "ellipsis", @@ -1256,40 +1428,44 @@ "rlang", "tibble", "tidyselect", + "utils", "vctrs" - ] + ], + "Hash": "d8b95b7fee945d7da6888cf7eb71a49c" }, "tidyselect": { "Package": "tidyselect", - "Version": "1.1.0", + "Version": "1.2.0", "Source": "Repository", "Repository": "CRAN", - "Hash": "6ea435c354e8448819627cf686f66e0a", "Requirements": [ - "ellipsis", + "R", + "cli", "glue", - "purrr", + "lifecycle", "rlang", - "vctrs" - ] + "vctrs", + "withr" + ], + "Hash": "79540e5fcd9e0435af547d885f184fd5" }, "tinytex": { "Package": "tinytex", - "Version": "0.42", + "Version": "0.37", "Source": "Repository", - "Repository": "CRAN", - "Hash": "7629c6c1540835d5248e6e7df265fa74", + "Repository": "RSPM", "Requirements": [ "xfun" - ] + ], + "Hash": "a80abeb527a977e4bef21873d29222dd" }, "usethis": { "Package": "usethis", - "Version": "2.1.6", + "Version": "2.1.5", "Source": "Repository", - "Repository": "CRAN", - "Hash": "a67a22c201832b12c036cc059f1d137d", + "Repository": "RSPM", "Requirements": [ + "R", "cli", "clipr", "crayon", @@ -1306,113 +1482,143 @@ "rlang", "rprojroot", "rstudioapi", + "stats", + "utils", "whisker", "withr", "yaml" - ] + ], + "Hash": "c499f488e6dd7718accffaee5bc5a79b" }, "utf8": { "Package": "utf8", "Version": "1.2.2", "Source": "Repository", - "Repository": "CRAN", - "Hash": "c9c462b759a5cc844ae25b5942654d13", - "Requirements": [] + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "c9c462b759a5cc844ae25b5942654d13" }, "vctrs": { "Package": "vctrs", - "Version": "0.5.2", + "Version": "0.6.0", "Source": "Repository", "Repository": "CRAN", - "Hash": "e4ffa94ceed5f124d429a5a5f0f5b378", "Requirements": [ + "R", "cli", "glue", "lifecycle", "rlang" - ] + ], + "Hash": "7e877404388794361277be95d8445de8" }, "waldo": { "Package": "waldo", - "Version": "0.2.5", + "Version": "0.4.0", "Source": "Repository", "Repository": "CRAN", - "Hash": "20c45f1d511a3f730b7b469f4d11e104", "Requirements": [ "cli", "diffobj", "fansi", "glue", + "methods", "rematch2", "rlang", "tibble" - ] + ], + "Hash": "035fba89d0c86e2113120f93301b98ad" }, "whisker": { "Package": "whisker", "Version": "0.4", "Source": "Repository", - "Repository": "CRAN", - "Hash": "ca970b96d894e90397ed20637a0c1bbe", - "Requirements": [] + "Repository": "RSPM", + "Hash": "ca970b96d894e90397ed20637a0c1bbe" }, "withr": { "Package": "withr", "Version": "2.5.0", "Source": "Repository", - "Repository": "CRAN", - "Hash": "c0e49a9760983e81e55cdd9be92e7182", - "Requirements": [] + "Repository": "RSPM", + "Requirements": [ + "R", + "grDevices", + "graphics", + "stats" + ], + "Hash": "c0e49a9760983e81e55cdd9be92e7182" }, "xfun": { "Package": "xfun", "Version": "0.34", "Source": "Repository", "Repository": "CRAN", - "Hash": "9eba2411b0b1f879797141bd24df7407", - "Requirements": [] + "Requirements": [ + "stats", + "tools" + ], + "Hash": "9eba2411b0b1f879797141bd24df7407" }, "xml2": { "Package": "xml2", "Version": "1.3.3", "Source": "Repository", - "Repository": "CRAN", - "Hash": "40682ed6a969ea5abfd351eb67833adc", - "Requirements": [] + "Repository": "RSPM", + "Requirements": [ + "R", + "methods" + ], + "Hash": "40682ed6a969ea5abfd351eb67833adc" }, "xmlparsedata": { "Package": "xmlparsedata", "Version": "1.0.5", "Source": "Repository", - "Repository": "CRAN", - "Hash": "45e4bf3c46476896e821fc0a408fb4fc", - "Requirements": [] + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "45e4bf3c46476896e821fc0a408fb4fc" }, "xopen": { "Package": "xopen", "Version": "1.0.0", "Source": "Repository", - "Repository": "CRAN", - "Hash": "6c85f015dee9cc7710ddd20f86881f58", + "Repository": "RSPM", "Requirements": [ + "R", "processx" - ] + ], + "Hash": "6c85f015dee9cc7710ddd20f86881f58" + }, + "xtable": { + "Package": "xtable", + "Version": "1.8-4", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "stats", + "utils" + ], + "Hash": "b8acdf8af494d9ec19ccb2481a9b11c2" }, "yaml": { "Package": "yaml", - "Version": "2.2.1", + "Version": "2.3.5", "Source": "Repository", - "Repository": "CRAN", - "Hash": "2826c5d9efb0a88f657c7a679c7106db", - "Requirements": [] + "Repository": "RSPM", + "Hash": "458bb38374d73bf83b1bb85e353da200" }, "zip": { "Package": "zip", - "Version": "2.2.2", + "Version": "2.2.0", "Source": "Repository", - "Repository": "CRAN", - "Hash": "c42bfcec3fa6a0cce17ce1f8bc684f88", - "Requirements": [] + "Repository": "RSPM", + "Hash": "c7eef2996ac270a18c2715c997a727c5" } } } diff --git a/renv/.gitignore b/renv/.gitignore index 6ae4167d45..2649d0a0cf 100644 --- a/renv/.gitignore +++ b/renv/.gitignore @@ -5,3 +5,4 @@ local/ lock/ python/ staging/ +profile diff --git a/renv/activate.R b/renv/activate.R index c9c3e1bbdb..360dd52869 100644 --- a/renv/activate.R +++ b/renv/activate.R @@ -2,7 +2,7 @@ local({ # the requested version of renv - version <- "0.16.0" + version <- "0.17.0" # the project directory project <- getwd() @@ -94,8 +94,11 @@ local({ return(repos) # if we're testing, re-use the test repositories - if (renv_bootstrap_tests_running()) - return(getOption("renv.tests.repos")) + if (renv_bootstrap_tests_running()) { + repos <- getOption("renv.tests.repos") + if (!is.null(repos)) + return(repos) + } # retrieve current repos repos <- getOption("repos") @@ -344,8 +347,7 @@ local({ return() # allow directories - info <- file.info(tarball, extra_cols = FALSE) - if (identical(info$isdir, TRUE)) { + if (dir.exists(tarball)) { name <- sprintf("renv_%s.tar.gz", version) tarball <- file.path(tarball, name) } @@ -659,8 +661,8 @@ local({ if (version == loadedversion) return(TRUE) - # assume four-component versions are from GitHub; three-component - # versions are from CRAN + # assume four-component versions are from GitHub; + # three-component versions are from CRAN components <- strsplit(loadedversion, "[.-]")[[1]] remote <- if (length(components) == 4L) paste("rstudio/renv", loadedversion, sep = "@") @@ -700,6 +702,12 @@ local({ # warn if the version of renv loaded does not match renv_bootstrap_validate_version(version) + # execute renv load hooks, if any + hooks <- getHook("renv::autoload") + for (hook in hooks) + if (is.function(hook)) + tryCatch(hook(), error = warning) + # load the project renv::load(project) @@ -842,11 +850,29 @@ local({ renv_json_read <- function(file = NULL, text = NULL) { + jlerr <- NULL + # if jsonlite is loaded, use that instead - if ("jsonlite" %in% loadedNamespaces()) - renv_json_read_jsonlite(file, text) + if ("jsonlite" %in% loadedNamespaces()) { + + json <- catch(renv_json_read_jsonlite(file, text)) + if (!inherits(json, "error")) + return(json) + + jlerr <- json + + } + + # otherwise, fall back to the default JSON reader + json <- catch(renv_json_read_default(file, text)) + if (!inherits(json, "error")) + return(json) + + # report an error + if (!is.null(jlerr)) + stop(jlerr) else - renv_json_read_default(file, text) + stop(json) } @@ -991,4 +1017,4 @@ local({ warning(paste(msg, collapse = "\n"), call. = FALSE) -}) \ No newline at end of file +}) diff --git a/renv/profiles/4.1/renv.lock b/renv/profiles/4.1/renv.lock new file mode 100644 index 0000000000..0f3ac2c8a4 --- /dev/null +++ b/renv/profiles/4.1/renv.lock @@ -0,0 +1,1624 @@ +{ + "R": { + "Version": "4.1.3", + "Repositories": [ + { + "Name": "CRAN", + "URL": "https://cloud.r-project.org" + }, + { + "Name": "RSPM", + "URL": "https://packagemanager.posit.co/cran/2022-03-10" + } + ] + }, + "Packages": { + "DT": { + "Package": "DT", + "Version": "0.21", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "crosstalk", + "htmltools", + "htmlwidgets", + "jquerylib", + "jsonlite", + "magrittr", + "promises" + ], + "Hash": "45fa28dbf288cd606e13ca35d3d72437" + }, + "R.cache": { + "Package": "R.cache", + "Version": "0.15.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R.methodsS3", + "R.oo", + "R.utils", + "digest", + "utils" + ], + "Hash": "e92a8ea8388c47c82ed8aa435ed3be50" + }, + "R.methodsS3": { + "Package": "R.methodsS3", + "Version": "1.8.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "utils" + ], + "Hash": "4bf6453323755202d5909697b6f7c109" + }, + "R.oo": { + "Package": "R.oo", + "Version": "1.24.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R.methodsS3", + "methods", + "utils" + ], + "Hash": "5709328352717e2f0a9c012be8a97554" + }, + "R.utils": { + "Package": "R.utils", + "Version": "2.11.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R.methodsS3", + "R.oo", + "methods", + "tools", + "utils" + ], + "Hash": "a7ecb8e60815c7a18648e84cd121b23a" + }, + "R6": { + "Package": "R6", + "Version": "2.5.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "470851b6d5d0ac559e9d01bb352b4021" + }, + "Rcpp": { + "Package": "Rcpp", + "Version": "1.0.8", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "methods", + "utils" + ], + "Hash": "22b546dd7e337f6c0c58a39983a496bc" + }, + "askpass": { + "Package": "askpass", + "Version": "1.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "sys" + ], + "Hash": "e8a22846fff485f0be3770c2da758713" + }, + "backports": { + "Package": "backports", + "Version": "1.4.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "c39fbec8a30d23e721980b8afb31984c" + }, + "base64enc": { + "Package": "base64enc", + "Version": "0.1-3", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "543776ae6848fde2f48ff3816d0628bc" + }, + "brew": { + "Package": "brew", + "Version": "1.0-7", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "38875ea52350ff4b4c03849fc69736c8" + }, + "brio": { + "Package": "brio", + "Version": "1.1.3", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "976cf154dfb043c012d87cddd8bca363" + }, + "bslib": { + "Package": "bslib", + "Version": "0.3.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "grDevices", + "htmltools", + "jquerylib", + "jsonlite", + "rlang", + "sass" + ], + "Hash": "56ae7e1987b340186a8a5a157c2ec358" + }, + "cachem": { + "Package": "cachem", + "Version": "1.0.6", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "fastmap", + "rlang" + ], + "Hash": "648c5b3d71e6a37e3043617489a0a0e9" + }, + "callr": { + "Package": "callr", + "Version": "3.7.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "processx", + "utils" + ], + "Hash": "9b2191ede20fa29828139b9900922e51" + }, + "cli": { + "Package": "cli", + "Version": "3.4.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "utils" + ], + "Hash": "0d297d01734d2bcea40197bd4971a764" + }, + "clipr": { + "Package": "clipr", + "Version": "0.8.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "utils" + ], + "Hash": "3f038e5ac7f41d4ac41ce658c85e3042" + }, + "codetools": { + "Package": "codetools", + "Version": "0.2-18", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "019388fc48e48b3da0d3a76ff94608a8" + }, + "commonmark": { + "Package": "commonmark", + "Version": "1.8.0", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "2ba81b120c1655ab696c935ef33ea716" + }, + "covr": { + "Package": "covr", + "Version": "3.5.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "crayon", + "digest", + "httr", + "jsonlite", + "methods", + "rex", + "stats", + "utils", + "withr", + "yaml" + ], + "Hash": "6d80a9fc3c0c8473153b54fa54719dfd" + }, + "cpp11": { + "Package": "cpp11", + "Version": "0.4.3", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "ed588261931ee3be2c700d22e94a29ab" + }, + "crayon": { + "Package": "crayon", + "Version": "1.5.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "grDevices", + "methods", + "utils" + ], + "Hash": "741c2e098e98afe3dc26a7b0e5489f4e" + }, + "credentials": { + "Package": "credentials", + "Version": "1.3.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "askpass", + "curl", + "jsonlite", + "openssl", + "sys" + ], + "Hash": "93762d0a34d78e6a025efdbfb5c6bb41" + }, + "crosstalk": { + "Package": "crosstalk", + "Version": "1.2.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R6", + "htmltools", + "jsonlite", + "lazyeval" + ], + "Hash": "6aa54f69598c32177e920eb3402e8293" + }, + "curl": { + "Package": "curl", + "Version": "4.3.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "022c42d49c28e95d69ca60446dbabf88" + }, + "cyclocomp": { + "Package": "cyclocomp", + "Version": "1.1.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "callr", + "crayon", + "desc", + "remotes", + "withr" + ], + "Hash": "53cbed70a2f7472d48fb6aef08442f25" + }, + "desc": { + "Package": "desc", + "Version": "1.4.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "cli", + "rprojroot", + "utils" + ], + "Hash": "6b9602c7ebbe87101a9c8edb6e8b6d21" + }, + "devtools": { + "Package": "devtools", + "Version": "2.4.3", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "callr", + "cli", + "desc", + "ellipsis", + "fs", + "httr", + "lifecycle", + "memoise", + "pkgbuild", + "pkgload", + "rcmdcheck", + "remotes", + "rlang", + "roxygen2", + "rstudioapi", + "rversions", + "sessioninfo", + "stats", + "testthat", + "tools", + "usethis", + "utils", + "withr" + ], + "Hash": "fc35e13bb582e5fe6f63f3d647a4cbe5" + }, + "diffdf": { + "Package": "diffdf", + "Version": "1.0.4", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "tibble" + ], + "Hash": "9ddedef46959baad2080047a1b0117fe" + }, + "diffobj": { + "Package": "diffobj", + "Version": "0.3.5", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "crayon", + "methods", + "stats", + "tools", + "utils" + ], + "Hash": "bcaa8b95f8d7d01a5dedfd959ce88ab8" + }, + "digest": { + "Package": "digest", + "Version": "0.6.29", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "utils" + ], + "Hash": "cf6b206a045a684728c3267ef7596190" + }, + "downlit": { + "Package": "downlit", + "Version": "0.4.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "brio", + "desc", + "digest", + "evaluate", + "fansi", + "memoise", + "rlang", + "vctrs", + "yaml" + ], + "Hash": "ba63dc9ab5a31f3209892437e40c5f60" + }, + "dplyr": { + "Package": "dplyr", + "Version": "1.1.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "cli", + "generics", + "glue", + "lifecycle", + "magrittr", + "methods", + "pillar", + "rlang", + "tibble", + "tidyselect", + "utils", + "vctrs" + ], + "Hash": "eb5742d256a0d9306d85ea68756d8187" + }, + "ellipsis": { + "Package": "ellipsis", + "Version": "0.3.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "rlang" + ], + "Hash": "bb0eec2fe32e88d9e2836c2f73ea2077" + }, + "evaluate": { + "Package": "evaluate", + "Version": "0.15", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "methods" + ], + "Hash": "699a7a93d08c962d9f8950b2d7a227f1" + }, + "fansi": { + "Package": "fansi", + "Version": "1.0.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "grDevices", + "utils" + ], + "Hash": "f28149c2d7a1342a834b314e95e67260" + }, + "fastmap": { + "Package": "fastmap", + "Version": "1.1.0", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "77bd60a6157420d4ffa93b27cf6a58b8" + }, + "fontawesome": { + "Package": "fontawesome", + "Version": "0.2.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "htmltools", + "rlang" + ], + "Hash": "55624ed409e46c5f358b2c060be87f67" + }, + "fs": { + "Package": "fs", + "Version": "1.5.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "methods" + ], + "Hash": "7c89603d81793f0d5486d91ab1fc6f1d" + }, + "generics": { + "Package": "generics", + "Version": "0.1.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "methods" + ], + "Hash": "177475892cf4a55865868527654a7741" + }, + "gert": { + "Package": "gert", + "Version": "1.5.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "askpass", + "credentials", + "openssl", + "rstudioapi", + "sys", + "zip" + ], + "Hash": "8fddce7cbd59467106266a6e93e253b4" + }, + "gh": { + "Package": "gh", + "Version": "1.3.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "cli", + "gitcreds", + "httr", + "ini", + "jsonlite" + ], + "Hash": "38c2580abbda249bd6afeec00d14f531" + }, + "git2r": { + "Package": "git2r", + "Version": "0.29.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "graphics", + "utils" + ], + "Hash": "b114135c4749076bd5ef74a5827b6f62" + }, + "gitcreds": { + "Package": "gitcreds", + "Version": "0.1.1", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "f3aefccc1cc50de6338146b62f115de8" + }, + "glue": { + "Package": "glue", + "Version": "1.6.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "methods" + ], + "Hash": "4f2596dfb05dac67b9dc558e5c6fba2e" + }, + "highr": { + "Package": "highr", + "Version": "0.9", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "xfun" + ], + "Hash": "8eb36c8125038e648e5d111c0d7b2ed4" + }, + "hms": { + "Package": "hms", + "Version": "1.1.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "ellipsis", + "lifecycle", + "methods", + "pkgconfig", + "rlang", + "vctrs" + ], + "Hash": "5b8a2dd0fdbe2ab4f6081e6c7be6dfca" + }, + "htmltools": { + "Package": "htmltools", + "Version": "0.5.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "base64enc", + "digest", + "fastmap", + "grDevices", + "rlang", + "utils" + ], + "Hash": "526c484233f42522278ab06fb185cb26" + }, + "htmlwidgets": { + "Package": "htmlwidgets", + "Version": "1.5.4", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "grDevices", + "htmltools", + "jsonlite", + "yaml" + ], + "Hash": "76147821cd3fcd8c4b04e1ef0498e7fb" + }, + "httpuv": { + "Package": "httpuv", + "Version": "1.6.5", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R6", + "Rcpp", + "later", + "promises", + "utils" + ], + "Hash": "97fe71f0a4a1c9890e6c2128afa04bc0" + }, + "httr": { + "Package": "httr", + "Version": "1.4.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R6", + "curl", + "jsonlite", + "mime", + "openssl" + ], + "Hash": "a525aba14184fec243f9eaec62fbed43" + }, + "hunspell": { + "Package": "hunspell", + "Version": "3.0.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "Rcpp", + "digest" + ], + "Hash": "3987784c19192ad0f2261c456d936df1" + }, + "ini": { + "Package": "ini", + "Version": "0.3.1", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "6154ec2223172bce8162d4153cda21f7" + }, + "jquerylib": { + "Package": "jquerylib", + "Version": "0.1.4", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "htmltools" + ], + "Hash": "5aab57a3bd297eee1c1d862735972182" + }, + "jsonlite": { + "Package": "jsonlite", + "Version": "1.8.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "methods" + ], + "Hash": "d07e729b27b372429d42d24d503613a0" + }, + "knitr": { + "Package": "knitr", + "Version": "1.40", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "evaluate", + "highr", + "methods", + "stringr", + "tools", + "xfun", + "yaml" + ], + "Hash": "caea8b0f899a0b1738444b9bc47067e7" + }, + "later": { + "Package": "later", + "Version": "1.3.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "Rcpp", + "rlang" + ], + "Hash": "7e7b457d7766bc47f2a5f21cc2984f8e" + }, + "lazyeval": { + "Package": "lazyeval", + "Version": "0.2.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "d908914ae53b04d4c0c0fd72ecc35370" + }, + "lifecycle": { + "Package": "lifecycle", + "Version": "1.0.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "glue", + "rlang" + ], + "Hash": "001cecbeac1cff9301bdc3775ee46a86" + }, + "lintr": { + "Package": "lintr", + "Version": "3.0.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "backports", + "codetools", + "crayon", + "cyclocomp", + "digest", + "glue", + "jsonlite", + "knitr", + "rex", + "stats", + "utils", + "xml2", + "xmlparsedata" + ], + "Hash": "b21ebd652d940f099915221f3328ab7b" + }, + "lubridate": { + "Package": "lubridate", + "Version": "1.8.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cpp11", + "generics", + "methods" + ], + "Hash": "2ff5eedb6ee38fb1b81205c73be1be5a" + }, + "magrittr": { + "Package": "magrittr", + "Version": "2.0.2", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "cdc87ecd81934679d1557633d8e1fe51" + }, + "memoise": { + "Package": "memoise", + "Version": "2.0.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "cachem", + "rlang" + ], + "Hash": "e2817ccf4a065c5d9d7f2cfbe7c1d78c" + }, + "mime": { + "Package": "mime", + "Version": "0.12", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "tools" + ], + "Hash": "18e9c28c1d3ca1560ce30658b22ce104" + }, + "miniUI": { + "Package": "miniUI", + "Version": "0.1.1.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "htmltools", + "shiny", + "utils" + ], + "Hash": "fec5f52652d60615fdb3957b3d74324a" + }, + "openssl": { + "Package": "openssl", + "Version": "2.0.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "askpass" + ], + "Hash": "cf4329aac12c2c44089974559c18e446" + }, + "pillar": { + "Package": "pillar", + "Version": "1.9.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "cli", + "fansi", + "glue", + "lifecycle", + "rlang", + "utf8", + "utils", + "vctrs" + ], + "Hash": "15da5a8412f317beeee6175fbc76f4bb" + }, + "pkgbuild": { + "Package": "pkgbuild", + "Version": "1.3.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R6", + "callr", + "cli", + "crayon", + "desc", + "prettyunits", + "rprojroot", + "withr" + ], + "Hash": "66d2adfed274daf81ccfe77d974c3b9b" + }, + "pkgconfig": { + "Package": "pkgconfig", + "Version": "2.0.3", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "utils" + ], + "Hash": "01f28d4278f15c76cddbea05899c5d6f" + }, + "pkgdown": { + "Package": "pkgdown", + "Version": "2.0.7", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "bslib", + "callr", + "cli", + "desc", + "digest", + "downlit", + "fs", + "httr", + "jsonlite", + "magrittr", + "memoise", + "purrr", + "ragg", + "rlang", + "rmarkdown", + "tibble", + "whisker", + "withr", + "xml2", + "yaml" + ], + "Hash": "16fa15449c930bf3a7761d3c68f8abf9" + }, + "pkgload": { + "Package": "pkgload", + "Version": "1.2.4", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "cli", + "crayon", + "desc", + "methods", + "rlang", + "rprojroot", + "rstudioapi", + "utils", + "withr" + ], + "Hash": "7533cd805940821bf23eaf3c8d4c1735" + }, + "praise": { + "Package": "praise", + "Version": "1.0.0", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "a555924add98c99d2f411e37e7d25e9f" + }, + "prettyunits": { + "Package": "prettyunits", + "Version": "1.1.1", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "95ef9167b75dde9d2ccc3c7528393e7e" + }, + "processx": { + "Package": "processx", + "Version": "3.6.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "ps", + "utils" + ], + "Hash": "a11891e28c1f1e5ddd773ba1b8c07cf6" + }, + "promises": { + "Package": "promises", + "Version": "1.2.0.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R6", + "Rcpp", + "later", + "magrittr", + "rlang", + "stats" + ], + "Hash": "4ab2c43adb4d4699cf3690acd378d75d" + }, + "ps": { + "Package": "ps", + "Version": "1.6.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "utils" + ], + "Hash": "32620e2001c1dce1af49c49dccbb9420" + }, + "purrr": { + "Package": "purrr", + "Version": "0.3.4", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "magrittr", + "rlang" + ], + "Hash": "97def703420c8ab10d8f0e6c72101e02" + }, + "ragg": { + "Package": "ragg", + "Version": "1.2.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "systemfonts", + "textshaping" + ], + "Hash": "14932bb6f2739c771ca4ceaba6b4248e" + }, + "rappdirs": { + "Package": "rappdirs", + "Version": "0.3.3", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "5e3c5dc0b071b21fa128676560dbe94d" + }, + "rcmdcheck": { + "Package": "rcmdcheck", + "Version": "1.4.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R6", + "callr", + "cli", + "curl", + "desc", + "digest", + "pkgbuild", + "prettyunits", + "rprojroot", + "sessioninfo", + "utils", + "withr", + "xopen" + ], + "Hash": "8f25ebe2ec38b1f2aef3b0d2ef76f6c4" + }, + "rematch2": { + "Package": "rematch2", + "Version": "2.1.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "tibble" + ], + "Hash": "76c9e04c712a05848ae7a23d2f170a40" + }, + "remotes": { + "Package": "remotes", + "Version": "2.4.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "methods", + "stats", + "tools", + "utils" + ], + "Hash": "227045be9aee47e6dda9bb38ac870d67" + }, + "renv": { + "Package": "renv", + "Version": "0.17.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "utils" + ], + "Hash": "ce3065fc1a0b64a859f55ac3998d6927" + }, + "rex": { + "Package": "rex", + "Version": "1.2.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "lazyeval" + ], + "Hash": "ae34cd56890607370665bee5bd17812f" + }, + "rlang": { + "Package": "rlang", + "Version": "1.1.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "utils" + ], + "Hash": "dc079ccd156cde8647360f473c1fa718" + }, + "rmarkdown": { + "Package": "rmarkdown", + "Version": "2.17", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "bslib", + "evaluate", + "htmltools", + "jquerylib", + "jsonlite", + "knitr", + "methods", + "stringr", + "tinytex", + "tools", + "utils", + "xfun", + "yaml" + ], + "Hash": "e97c8be593e010f93520e8215c0f9189" + }, + "roxygen2": { + "Package": "roxygen2", + "Version": "7.2.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "brew", + "cli", + "commonmark", + "cpp11", + "desc", + "knitr", + "methods", + "pkgload", + "purrr", + "rlang", + "stringi", + "stringr", + "utils", + "withr", + "xml2" + ], + "Hash": "7b153c746193b143c14baa072bae4e27" + }, + "rprojroot": { + "Package": "rprojroot", + "Version": "2.0.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "249d8cd1e74a8f6a26194a91b47f21d1" + }, + "rstudioapi": { + "Package": "rstudioapi", + "Version": "0.13", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "06c85365a03fdaf699966cc1d3cf53ea" + }, + "rversions": { + "Package": "rversions", + "Version": "2.1.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "curl", + "utils", + "xml2" + ], + "Hash": "f88fab00907b312f8b23ec13e2d437cb" + }, + "sass": { + "Package": "sass", + "Version": "0.4.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R6", + "fs", + "htmltools", + "rappdirs", + "rlang" + ], + "Hash": "50cf822feb64bb3977bda0b7091be623" + }, + "sessioninfo": { + "Package": "sessioninfo", + "Version": "1.2.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cli", + "tools", + "utils" + ], + "Hash": "3f9796a8d0a0e8c6eb49a4b029359d1f" + }, + "shiny": { + "Package": "shiny", + "Version": "1.7.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R6", + "bslib", + "cachem", + "commonmark", + "crayon", + "ellipsis", + "fastmap", + "fontawesome", + "glue", + "grDevices", + "htmltools", + "httpuv", + "jsonlite", + "later", + "lifecycle", + "methods", + "mime", + "promises", + "rlang", + "sourcetools", + "tools", + "utils", + "withr", + "xtable" + ], + "Hash": "00344c227c7bd0ab5d78052c5d736c44" + }, + "sourcetools": { + "Package": "sourcetools", + "Version": "0.1.7", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "947e4e02a79effa5d512473e10f41797" + }, + "spelling": { + "Package": "spelling", + "Version": "2.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "commonmark", + "hunspell", + "knitr", + "xml2" + ], + "Hash": "b8c899a5c83f0d897286550481c91798" + }, + "staged.dependencies": { + "Package": "staged.dependencies", + "Version": "0.2.8", + "Source": "GitHub", + "RemoteType": "github", + "RemoteHost": "api.github.com", + "RemoteUsername": "openpharma", + "RemoteRepo": "staged.dependencies", + "RemoteRef": "main", + "RemoteSha": "ce7c112ba3d75cf48e4dd6310b3140ab0ec3b486", + "Requirements": [ + "desc", + "devtools", + "digest", + "dplyr", + "fs", + "git2r", + "glue", + "httr", + "jsonlite", + "methods", + "rcmdcheck", + "remotes", + "rlang", + "stats", + "tidyr", + "utils", + "withr", + "yaml" + ], + "Hash": "89f2e1d1009601f58f64b7092abcc0d7" + }, + "stringi": { + "Package": "stringi", + "Version": "1.7.6", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "stats", + "tools", + "utils" + ], + "Hash": "bba431031d30789535745a9627ac9271" + }, + "stringr": { + "Package": "stringr", + "Version": "1.4.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "glue", + "magrittr", + "stringi" + ], + "Hash": "0759e6b6c0957edb1311028a49a35e76" + }, + "styler": { + "Package": "styler", + "Version": "1.9.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R.cache", + "cli", + "magrittr", + "purrr", + "rlang", + "rprojroot", + "tools", + "vctrs", + "withr" + ], + "Hash": "ed8c90822b7da46beee603f263a85fe0" + }, + "sys": { + "Package": "sys", + "Version": "3.4", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "b227d13e29222b4574486cfcbde077fa" + }, + "systemfonts": { + "Package": "systemfonts", + "Version": "1.0.4", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cpp11" + ], + "Hash": "90b28393209827327de889f49935140a" + }, + "testthat": { + "Package": "testthat", + "Version": "3.1.7", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "brio", + "callr", + "cli", + "desc", + "digest", + "ellipsis", + "evaluate", + "jsonlite", + "lifecycle", + "magrittr", + "methods", + "pkgload", + "praise", + "processx", + "ps", + "rlang", + "utils", + "waldo", + "withr" + ], + "Hash": "7eb5fd202a61d2fb78af5869b6c08998" + }, + "textshaping": { + "Package": "textshaping", + "Version": "0.3.6", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cpp11", + "systemfonts" + ], + "Hash": "1ab6223d3670fac7143202cb6a2d43d5" + }, + "tibble": { + "Package": "tibble", + "Version": "3.2.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "fansi", + "lifecycle", + "magrittr", + "methods", + "pillar", + "pkgconfig", + "rlang", + "utils", + "vctrs" + ], + "Hash": "37695ff125982007d42a59ad10982ff2" + }, + "tidyr": { + "Package": "tidyr", + "Version": "1.2.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cpp11", + "dplyr", + "ellipsis", + "glue", + "lifecycle", + "magrittr", + "purrr", + "rlang", + "tibble", + "tidyselect", + "utils", + "vctrs" + ], + "Hash": "d8b95b7fee945d7da6888cf7eb71a49c" + }, + "tidyselect": { + "Package": "tidyselect", + "Version": "1.2.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "glue", + "lifecycle", + "rlang", + "vctrs", + "withr" + ], + "Hash": "79540e5fcd9e0435af547d885f184fd5" + }, + "tinytex": { + "Package": "tinytex", + "Version": "0.37", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "xfun" + ], + "Hash": "a80abeb527a977e4bef21873d29222dd" + }, + "usethis": { + "Package": "usethis", + "Version": "2.1.5", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cli", + "clipr", + "crayon", + "curl", + "desc", + "fs", + "gert", + "gh", + "glue", + "jsonlite", + "lifecycle", + "purrr", + "rappdirs", + "rlang", + "rprojroot", + "rstudioapi", + "stats", + "utils", + "whisker", + "withr", + "yaml" + ], + "Hash": "c499f488e6dd7718accffaee5bc5a79b" + }, + "utf8": { + "Package": "utf8", + "Version": "1.2.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "c9c462b759a5cc844ae25b5942654d13" + }, + "vctrs": { + "Package": "vctrs", + "Version": "0.6.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "glue", + "lifecycle", + "rlang" + ], + "Hash": "7e877404388794361277be95d8445de8" + }, + "waldo": { + "Package": "waldo", + "Version": "0.4.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "cli", + "diffobj", + "fansi", + "glue", + "methods", + "rematch2", + "rlang", + "tibble" + ], + "Hash": "035fba89d0c86e2113120f93301b98ad" + }, + "whisker": { + "Package": "whisker", + "Version": "0.4", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "ca970b96d894e90397ed20637a0c1bbe" + }, + "withr": { + "Package": "withr", + "Version": "2.5.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "grDevices", + "graphics", + "stats" + ], + "Hash": "c0e49a9760983e81e55cdd9be92e7182" + }, + "xfun": { + "Package": "xfun", + "Version": "0.34", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "stats", + "tools" + ], + "Hash": "9eba2411b0b1f879797141bd24df7407" + }, + "xml2": { + "Package": "xml2", + "Version": "1.3.3", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "methods" + ], + "Hash": "40682ed6a969ea5abfd351eb67833adc" + }, + "xmlparsedata": { + "Package": "xmlparsedata", + "Version": "1.0.5", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "45e4bf3c46476896e821fc0a408fb4fc" + }, + "xopen": { + "Package": "xopen", + "Version": "1.0.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "processx" + ], + "Hash": "6c85f015dee9cc7710ddd20f86881f58" + }, + "xtable": { + "Package": "xtable", + "Version": "1.8-4", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "stats", + "utils" + ], + "Hash": "b8acdf8af494d9ec19ccb2481a9b11c2" + }, + "yaml": { + "Package": "yaml", + "Version": "2.3.5", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "458bb38374d73bf83b1bb85e353da200" + }, + "zip": { + "Package": "zip", + "Version": "2.2.0", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "c7eef2996ac270a18c2715c997a727c5" + } + } +} diff --git a/renv/profiles/4.1/renv/.gitignore b/renv/profiles/4.1/renv/.gitignore new file mode 100644 index 0000000000..0ec0cbba2d --- /dev/null +++ b/renv/profiles/4.1/renv/.gitignore @@ -0,0 +1,7 @@ +library/ +local/ +cellar/ +lock/ +python/ +sandbox/ +staging/ diff --git a/renv/profiles/4.1/renv/settings.dcf b/renv/profiles/4.1/renv/settings.dcf new file mode 100644 index 0000000000..fd205f802c --- /dev/null +++ b/renv/profiles/4.1/renv/settings.dcf @@ -0,0 +1,10 @@ +bioconductor.version: +external.libraries: +ignored.packages: admiral, admiraldev, admiral.test, admiralci +package.dependency.fields: Imports, Depends, LinkingTo +r.version: +snapshot.type: implicit +use.cache: TRUE +vcs.ignore.cellar: TRUE +vcs.ignore.library: TRUE +vcs.ignore.local: TRUE diff --git a/renv/profiles/4.2/renv.lock b/renv/profiles/4.2/renv.lock new file mode 100644 index 0000000000..0bb8fc5653 --- /dev/null +++ b/renv/profiles/4.2/renv.lock @@ -0,0 +1,1707 @@ +{ + "R": { + "Version": "4.2.3", + "Repositories": [ + { + "Name": "CRAN", + "URL": "https://cloud.r-project.org" + }, + { + "Name": "RSPM", + "URL": "https://packagemanager.posit.co/cran/2023-03-15" + } + ] + }, + "Packages": { + "DT": { + "Package": "DT", + "Version": "0.27", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "crosstalk", + "htmltools", + "htmlwidgets", + "jquerylib", + "jsonlite", + "magrittr", + "promises" + ], + "Hash": "3444e6ed78763f9f13aaa39f2481eb34" + }, + "R.cache": { + "Package": "R.cache", + "Version": "0.16.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R.methodsS3", + "R.oo", + "R.utils", + "digest", + "utils" + ], + "Hash": "fe539ca3f8efb7410c3ae2cf5fe6c0f8" + }, + "R.methodsS3": { + "Package": "R.methodsS3", + "Version": "1.8.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "utils" + ], + "Hash": "278c286fd6e9e75d0c2e8f731ea445c8" + }, + "R.oo": { + "Package": "R.oo", + "Version": "1.25.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R.methodsS3", + "methods", + "utils" + ], + "Hash": "a0900a114f4f0194cf4aa8cd4a700681" + }, + "R.utils": { + "Package": "R.utils", + "Version": "2.12.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R.methodsS3", + "R.oo", + "methods", + "tools", + "utils" + ], + "Hash": "325f01db13da12c04d8f6e7be36ff514" + }, + "R6": { + "Package": "R6", + "Version": "2.5.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "470851b6d5d0ac559e9d01bb352b4021" + }, + "Rcpp": { + "Package": "Rcpp", + "Version": "1.0.10", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "methods", + "utils" + ], + "Hash": "e749cae40fa9ef469b6050959517453c" + }, + "askpass": { + "Package": "askpass", + "Version": "1.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "sys" + ], + "Hash": "e8a22846fff485f0be3770c2da758713" + }, + "backports": { + "Package": "backports", + "Version": "1.4.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "c39fbec8a30d23e721980b8afb31984c" + }, + "base64enc": { + "Package": "base64enc", + "Version": "0.1-3", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "543776ae6848fde2f48ff3816d0628bc" + }, + "brew": { + "Package": "brew", + "Version": "1.0-8", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "d69a786e85775b126bddbee185ae6084" + }, + "brio": { + "Package": "brio", + "Version": "1.1.3", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "976cf154dfb043c012d87cddd8bca363" + }, + "bslib": { + "Package": "bslib", + "Version": "0.4.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "base64enc", + "cachem", + "grDevices", + "htmltools", + "jquerylib", + "jsonlite", + "memoise", + "mime", + "rlang", + "sass" + ], + "Hash": "a7fbf03946ad741129dc81098722fca1" + }, + "cachem": { + "Package": "cachem", + "Version": "1.0.7", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "fastmap", + "rlang" + ], + "Hash": "cda74447c42f529de601fe4d4050daef" + }, + "callr": { + "Package": "callr", + "Version": "3.7.3", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R6", + "processx", + "utils" + ], + "Hash": "9b2191ede20fa29828139b9900922e51" + }, + "cli": { + "Package": "cli", + "Version": "3.6.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "utils" + ], + "Hash": "3177a5a16c243adc199ba33117bd9657" + }, + "clipr": { + "Package": "clipr", + "Version": "0.8.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "utils" + ], + "Hash": "3f038e5ac7f41d4ac41ce658c85e3042" + }, + "codetools": { + "Package": "codetools", + "Version": "0.2-19", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "c089a619a7fae175d149d89164f8c7d8" + }, + "commonmark": { + "Package": "commonmark", + "Version": "1.8.1", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "b6e3e947d1d7ebf3d2bdcea1bde63fe7" + }, + "covr": { + "Package": "covr", + "Version": "3.6.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "crayon", + "digest", + "httr", + "jsonlite", + "methods", + "rex", + "stats", + "utils", + "withr", + "yaml" + ], + "Hash": "a861cee34fbb4b107a73dd414ef56724" + }, + "cpp11": { + "Package": "cpp11", + "Version": "0.4.3", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "ed588261931ee3be2c700d22e94a29ab" + }, + "crayon": { + "Package": "crayon", + "Version": "1.5.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "grDevices", + "methods", + "utils" + ], + "Hash": "e8a1e41acf02548751f45c718d55aa6a" + }, + "credentials": { + "Package": "credentials", + "Version": "1.3.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "askpass", + "curl", + "jsonlite", + "openssl", + "sys" + ], + "Hash": "93762d0a34d78e6a025efdbfb5c6bb41" + }, + "crosstalk": { + "Package": "crosstalk", + "Version": "1.2.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R6", + "htmltools", + "jsonlite", + "lazyeval" + ], + "Hash": "6aa54f69598c32177e920eb3402e8293" + }, + "curl": { + "Package": "curl", + "Version": "5.0.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "e4f97056611e8e6b8b852d13b7400cf1" + }, + "cyclocomp": { + "Package": "cyclocomp", + "Version": "1.1.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "callr", + "crayon", + "desc", + "remotes", + "withr" + ], + "Hash": "53cbed70a2f7472d48fb6aef08442f25" + }, + "desc": { + "Package": "desc", + "Version": "1.4.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R6", + "cli", + "rprojroot", + "utils" + ], + "Hash": "6b9602c7ebbe87101a9c8edb6e8b6d21" + }, + "devtools": { + "Package": "devtools", + "Version": "2.4.5", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cli", + "desc", + "ellipsis", + "fs", + "lifecycle", + "memoise", + "miniUI", + "pkgbuild", + "pkgdown", + "pkgload", + "profvis", + "rcmdcheck", + "remotes", + "rlang", + "roxygen2", + "rversions", + "sessioninfo", + "stats", + "testthat", + "tools", + "urlchecker", + "usethis", + "utils", + "withr" + ], + "Hash": "ea5bc8b4a6a01e4f12d98b58329930bb" + }, + "diffdf": { + "Package": "diffdf", + "Version": "1.0.4", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "tibble" + ], + "Hash": "9ddedef46959baad2080047a1b0117fe" + }, + "diffobj": { + "Package": "diffobj", + "Version": "0.3.5", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "crayon", + "methods", + "stats", + "tools", + "utils" + ], + "Hash": "bcaa8b95f8d7d01a5dedfd959ce88ab8" + }, + "digest": { + "Package": "digest", + "Version": "0.6.31", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "utils" + ], + "Hash": "8b708f296afd9ae69f450f9640be8990" + }, + "downlit": { + "Package": "downlit", + "Version": "0.4.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "brio", + "desc", + "digest", + "evaluate", + "fansi", + "memoise", + "rlang", + "vctrs", + "withr", + "yaml" + ], + "Hash": "79bf3f66590752ffbba20f8d2da94c7c" + }, + "dplyr": { + "Package": "dplyr", + "Version": "1.1.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "cli", + "generics", + "glue", + "lifecycle", + "magrittr", + "methods", + "pillar", + "rlang", + "tibble", + "tidyselect", + "utils", + "vctrs" + ], + "Hash": "eb5742d256a0d9306d85ea68756d8187" + }, + "ellipsis": { + "Package": "ellipsis", + "Version": "0.3.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "rlang" + ], + "Hash": "bb0eec2fe32e88d9e2836c2f73ea2077" + }, + "evaluate": { + "Package": "evaluate", + "Version": "0.20", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "methods" + ], + "Hash": "4b68aa51edd89a0e044a66e75ae3cc6c" + }, + "fansi": { + "Package": "fansi", + "Version": "1.0.4", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "grDevices", + "utils" + ], + "Hash": "1d9e7ad3c8312a192dea7d3db0274fde" + }, + "fastmap": { + "Package": "fastmap", + "Version": "1.1.1", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "f7736a18de97dea803bde0a2daaafb27" + }, + "fontawesome": { + "Package": "fontawesome", + "Version": "0.5.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "htmltools", + "rlang" + ], + "Hash": "e80750aec5717dedc019ad7ee40e4a7c" + }, + "fs": { + "Package": "fs", + "Version": "1.6.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "methods" + ], + "Hash": "f4dcd23b67e33d851d2079f703e8b985" + }, + "generics": { + "Package": "generics", + "Version": "0.1.3", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "methods" + ], + "Hash": "15e9634c0fcd294799e9b2e929ed1b86" + }, + "gert": { + "Package": "gert", + "Version": "1.9.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "askpass", + "credentials", + "openssl", + "rstudioapi", + "sys", + "zip" + ], + "Hash": "9122b3958e749badb5c939f498038b57" + }, + "gh": { + "Package": "gh", + "Version": "1.4.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cli", + "gitcreds", + "httr2", + "ini", + "jsonlite", + "rlang" + ], + "Hash": "03533b1c875028233598f848fda44c4c" + }, + "git2r": { + "Package": "git2r", + "Version": "0.31.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "graphics", + "utils" + ], + "Hash": "acb972e0be37f83b9c762d962d75a188" + }, + "gitcreds": { + "Package": "gitcreds", + "Version": "0.1.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "ab08ac61f3e1be454ae21911eb8bc2fe" + }, + "glue": { + "Package": "glue", + "Version": "1.6.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "methods" + ], + "Hash": "4f2596dfb05dac67b9dc558e5c6fba2e" + }, + "highr": { + "Package": "highr", + "Version": "0.10", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "xfun" + ], + "Hash": "06230136b2d2b9ba5805e1963fa6e890" + }, + "hms": { + "Package": "hms", + "Version": "1.1.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "ellipsis", + "lifecycle", + "methods", + "pkgconfig", + "rlang", + "vctrs" + ], + "Hash": "41100392191e1244b887878b533eea91" + }, + "htmltools": { + "Package": "htmltools", + "Version": "0.5.4", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "base64enc", + "digest", + "ellipsis", + "fastmap", + "grDevices", + "rlang", + "utils" + ], + "Hash": "9d27e99cc90bd701c0a7a63e5923f9b7" + }, + "htmlwidgets": { + "Package": "htmlwidgets", + "Version": "1.6.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "grDevices", + "htmltools", + "jsonlite", + "knitr", + "rmarkdown", + "yaml" + ], + "Hash": "b677ee5954471eaa974c0d099a343a1a" + }, + "httpuv": { + "Package": "httpuv", + "Version": "1.6.9", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R6", + "Rcpp", + "later", + "promises", + "utils" + ], + "Hash": "1046aa31a57eae8b357267a56a0b6d8b" + }, + "httr": { + "Package": "httr", + "Version": "1.4.5", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R6", + "curl", + "jsonlite", + "mime", + "openssl" + ], + "Hash": "f6844033201269bec3ca0097bc6c97b3" + }, + "httr2": { + "Package": "httr2", + "Version": "0.2.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R6", + "cli", + "curl", + "glue", + "magrittr", + "openssl", + "rappdirs", + "rlang", + "withr" + ], + "Hash": "5c09fe33064978ede54de42309c8b532" + }, + "hunspell": { + "Package": "hunspell", + "Version": "3.0.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "Rcpp", + "digest" + ], + "Hash": "656219b6f3f605499d7cdbe208656639" + }, + "ini": { + "Package": "ini", + "Version": "0.3.1", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "6154ec2223172bce8162d4153cda21f7" + }, + "jquerylib": { + "Package": "jquerylib", + "Version": "0.1.4", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "htmltools" + ], + "Hash": "5aab57a3bd297eee1c1d862735972182" + }, + "jsonlite": { + "Package": "jsonlite", + "Version": "1.8.4", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "methods" + ], + "Hash": "a4269a09a9b865579b2635c77e572374" + }, + "knitr": { + "Package": "knitr", + "Version": "1.42", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "evaluate", + "highr", + "methods", + "tools", + "xfun", + "yaml" + ], + "Hash": "8329a9bcc82943c8069104d4be3ee22d" + }, + "later": { + "Package": "later", + "Version": "1.3.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "Rcpp", + "rlang" + ], + "Hash": "7e7b457d7766bc47f2a5f21cc2984f8e" + }, + "lazyeval": { + "Package": "lazyeval", + "Version": "0.2.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "d908914ae53b04d4c0c0fd72ecc35370" + }, + "lifecycle": { + "Package": "lifecycle", + "Version": "1.0.3", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cli", + "glue", + "rlang" + ], + "Hash": "001cecbeac1cff9301bdc3775ee46a86" + }, + "lintr": { + "Package": "lintr", + "Version": "3.0.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "backports", + "codetools", + "crayon", + "cyclocomp", + "digest", + "glue", + "jsonlite", + "knitr", + "rex", + "stats", + "utils", + "xml2", + "xmlparsedata" + ], + "Hash": "b21ebd652d940f099915221f3328ab7b" + }, + "lubridate": { + "Package": "lubridate", + "Version": "1.9.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "generics", + "methods", + "timechange" + ], + "Hash": "e25f18436e3efd42c7c590a1c4c15390" + }, + "magrittr": { + "Package": "magrittr", + "Version": "2.0.3", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "7ce2733a9826b3aeb1775d56fd305472" + }, + "memoise": { + "Package": "memoise", + "Version": "2.0.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "cachem", + "rlang" + ], + "Hash": "e2817ccf4a065c5d9d7f2cfbe7c1d78c" + }, + "mime": { + "Package": "mime", + "Version": "0.12", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "tools" + ], + "Hash": "18e9c28c1d3ca1560ce30658b22ce104" + }, + "miniUI": { + "Package": "miniUI", + "Version": "0.1.1.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "htmltools", + "shiny", + "utils" + ], + "Hash": "fec5f52652d60615fdb3957b3d74324a" + }, + "openssl": { + "Package": "openssl", + "Version": "2.0.6", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "askpass" + ], + "Hash": "0f7cd2962e3044bb940cca4f4b5cecbe" + }, + "pillar": { + "Package": "pillar", + "Version": "1.9.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "cli", + "fansi", + "glue", + "lifecycle", + "rlang", + "utf8", + "utils", + "vctrs" + ], + "Hash": "15da5a8412f317beeee6175fbc76f4bb" + }, + "pkgbuild": { + "Package": "pkgbuild", + "Version": "1.4.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R6", + "callr", + "cli", + "crayon", + "desc", + "prettyunits", + "processx", + "rprojroot", + "withr" + ], + "Hash": "d6c3008d79653a0f267703288230105e" + }, + "pkgconfig": { + "Package": "pkgconfig", + "Version": "2.0.3", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "utils" + ], + "Hash": "01f28d4278f15c76cddbea05899c5d6f" + }, + "pkgdown": { + "Package": "pkgdown", + "Version": "2.0.7", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "bslib", + "callr", + "cli", + "desc", + "digest", + "downlit", + "fs", + "httr", + "jsonlite", + "magrittr", + "memoise", + "purrr", + "ragg", + "rlang", + "rmarkdown", + "tibble", + "whisker", + "withr", + "xml2", + "yaml" + ], + "Hash": "16fa15449c930bf3a7761d3c68f8abf9" + }, + "pkgload": { + "Package": "pkgload", + "Version": "1.3.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cli", + "crayon", + "desc", + "fs", + "glue", + "methods", + "rlang", + "rprojroot", + "utils", + "withr" + ], + "Hash": "6b0c222c5071efe0f3baf3dae9aa40e2" + }, + "praise": { + "Package": "praise", + "Version": "1.0.0", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "a555924add98c99d2f411e37e7d25e9f" + }, + "prettyunits": { + "Package": "prettyunits", + "Version": "1.1.1", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "95ef9167b75dde9d2ccc3c7528393e7e" + }, + "processx": { + "Package": "processx", + "Version": "3.8.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R6", + "ps", + "utils" + ], + "Hash": "a33ee2d9bf07564efb888ad98410da84" + }, + "profvis": { + "Package": "profvis", + "Version": "0.3.7", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "htmlwidgets", + "stringr" + ], + "Hash": "e9d21e79848e02e524bea6f5bd53e7e4" + }, + "promises": { + "Package": "promises", + "Version": "1.2.0.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R6", + "Rcpp", + "later", + "magrittr", + "rlang", + "stats" + ], + "Hash": "4ab2c43adb4d4699cf3690acd378d75d" + }, + "ps": { + "Package": "ps", + "Version": "1.7.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "utils" + ], + "Hash": "68dd03d98a5efd1eb3012436de45ba83" + }, + "purrr": { + "Package": "purrr", + "Version": "1.0.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cli", + "lifecycle", + "magrittr", + "rlang", + "vctrs" + ], + "Hash": "d71c815267c640f17ddbf7f16144b4bb" + }, + "ragg": { + "Package": "ragg", + "Version": "1.2.5", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "systemfonts", + "textshaping" + ], + "Hash": "690bc058ea2b1b8a407d3cfe3dce3ef9" + }, + "rappdirs": { + "Package": "rappdirs", + "Version": "0.3.3", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "5e3c5dc0b071b21fa128676560dbe94d" + }, + "rcmdcheck": { + "Package": "rcmdcheck", + "Version": "1.4.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R6", + "callr", + "cli", + "curl", + "desc", + "digest", + "pkgbuild", + "prettyunits", + "rprojroot", + "sessioninfo", + "utils", + "withr", + "xopen" + ], + "Hash": "8f25ebe2ec38b1f2aef3b0d2ef76f6c4" + }, + "rematch2": { + "Package": "rematch2", + "Version": "2.1.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "tibble" + ], + "Hash": "76c9e04c712a05848ae7a23d2f170a40" + }, + "remotes": { + "Package": "remotes", + "Version": "2.4.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "methods", + "stats", + "tools", + "utils" + ], + "Hash": "227045be9aee47e6dda9bb38ac870d67" + }, + "renv": { + "Package": "renv", + "Version": "0.17.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "utils" + ], + "Hash": "ce3065fc1a0b64a859f55ac3998d6927" + }, + "rex": { + "Package": "rex", + "Version": "1.2.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "lazyeval" + ], + "Hash": "ae34cd56890607370665bee5bd17812f" + }, + "rlang": { + "Package": "rlang", + "Version": "1.1.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "utils" + ], + "Hash": "dc079ccd156cde8647360f473c1fa718" + }, + "rmarkdown": { + "Package": "rmarkdown", + "Version": "2.20", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "bslib", + "evaluate", + "htmltools", + "jquerylib", + "jsonlite", + "knitr", + "methods", + "stringr", + "tinytex", + "tools", + "utils", + "xfun", + "yaml" + ], + "Hash": "716fde5382293cc94a71f68c85b78d19" + }, + "roxygen2": { + "Package": "roxygen2", + "Version": "7.2.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "brew", + "cli", + "commonmark", + "cpp11", + "desc", + "knitr", + "methods", + "pkgload", + "purrr", + "rlang", + "stringi", + "stringr", + "utils", + "withr", + "xml2" + ], + "Hash": "7b153c746193b143c14baa072bae4e27" + }, + "rprojroot": { + "Package": "rprojroot", + "Version": "2.0.3", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "1de7ab598047a87bba48434ba35d497d" + }, + "rstudioapi": { + "Package": "rstudioapi", + "Version": "0.14", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "690bd2acc42a9166ce34845884459320" + }, + "rversions": { + "Package": "rversions", + "Version": "2.1.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "curl", + "utils", + "xml2" + ], + "Hash": "a9881dfed103e83f9de151dc17002cd1" + }, + "sass": { + "Package": "sass", + "Version": "0.4.5", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R6", + "fs", + "htmltools", + "rappdirs", + "rlang" + ], + "Hash": "2bb4371a4c80115518261866eab6ab11" + }, + "sessioninfo": { + "Package": "sessioninfo", + "Version": "1.2.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cli", + "tools", + "utils" + ], + "Hash": "3f9796a8d0a0e8c6eb49a4b029359d1f" + }, + "shiny": { + "Package": "shiny", + "Version": "1.7.4", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R6", + "bslib", + "cachem", + "commonmark", + "crayon", + "ellipsis", + "fastmap", + "fontawesome", + "glue", + "grDevices", + "htmltools", + "httpuv", + "jsonlite", + "later", + "lifecycle", + "methods", + "mime", + "promises", + "rlang", + "sourcetools", + "tools", + "utils", + "withr", + "xtable" + ], + "Hash": "c2eae3d8c670fa9dfa35a12066f4a1d5" + }, + "sourcetools": { + "Package": "sourcetools", + "Version": "0.1.7-1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "5f5a7629f956619d519205ec475fe647" + }, + "spelling": { + "Package": "spelling", + "Version": "2.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "commonmark", + "hunspell", + "knitr", + "xml2" + ], + "Hash": "b8c899a5c83f0d897286550481c91798" + }, + "staged.dependencies": { + "Package": "staged.dependencies", + "Version": "0.2.8", + "Source": "GitHub", + "RemoteType": "github", + "RemoteHost": "api.github.com", + "RemoteUsername": "openpharma", + "RemoteRepo": "staged.dependencies", + "RemoteRef": "main", + "RemoteSha": "ce7c112ba3d75cf48e4dd6310b3140ab0ec3b486", + "Requirements": [ + "desc", + "devtools", + "digest", + "dplyr", + "fs", + "git2r", + "glue", + "httr", + "jsonlite", + "methods", + "rcmdcheck", + "remotes", + "rlang", + "stats", + "tidyr", + "utils", + "withr", + "yaml" + ], + "Hash": "89f2e1d1009601f58f64b7092abcc0d7" + }, + "stringi": { + "Package": "stringi", + "Version": "1.7.12", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "stats", + "tools", + "utils" + ], + "Hash": "ca8bd84263c77310739d2cf64d84d7c9" + }, + "stringr": { + "Package": "stringr", + "Version": "1.5.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cli", + "glue", + "lifecycle", + "magrittr", + "rlang", + "stringi", + "vctrs" + ], + "Hash": "671a4d384ae9d32fc47a14e98bfa3dc8" + }, + "styler": { + "Package": "styler", + "Version": "1.9.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R.cache", + "cli", + "magrittr", + "purrr", + "rlang", + "rprojroot", + "tools", + "vctrs", + "withr" + ], + "Hash": "ed8c90822b7da46beee603f263a85fe0" + }, + "sys": { + "Package": "sys", + "Version": "3.4.1", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "34c16f1ef796057bfa06d3f4ff818a5d" + }, + "systemfonts": { + "Package": "systemfonts", + "Version": "1.0.4", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cpp11" + ], + "Hash": "90b28393209827327de889f49935140a" + }, + "testthat": { + "Package": "testthat", + "Version": "3.1.7", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R6", + "brio", + "callr", + "cli", + "desc", + "digest", + "ellipsis", + "evaluate", + "jsonlite", + "lifecycle", + "magrittr", + "methods", + "pkgload", + "praise", + "processx", + "ps", + "rlang", + "utils", + "waldo", + "withr" + ], + "Hash": "7eb5fd202a61d2fb78af5869b6c08998" + }, + "textshaping": { + "Package": "textshaping", + "Version": "0.3.6", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cpp11", + "systemfonts" + ], + "Hash": "1ab6223d3670fac7143202cb6a2d43d5" + }, + "tibble": { + "Package": "tibble", + "Version": "3.2.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "fansi", + "lifecycle", + "magrittr", + "methods", + "pillar", + "pkgconfig", + "rlang", + "utils", + "vctrs" + ], + "Hash": "37695ff125982007d42a59ad10982ff2" + }, + "tidyr": { + "Package": "tidyr", + "Version": "1.3.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cli", + "cpp11", + "dplyr", + "glue", + "lifecycle", + "magrittr", + "purrr", + "rlang", + "stringr", + "tibble", + "tidyselect", + "utils", + "vctrs" + ], + "Hash": "e47debdc7ce599b070c8e78e8ac0cfcf" + }, + "tidyselect": { + "Package": "tidyselect", + "Version": "1.2.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cli", + "glue", + "lifecycle", + "rlang", + "vctrs", + "withr" + ], + "Hash": "79540e5fcd9e0435af547d885f184fd5" + }, + "timechange": { + "Package": "timechange", + "Version": "0.2.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cpp11" + ], + "Hash": "8548b44f79a35ba1791308b61e6012d7" + }, + "tinytex": { + "Package": "tinytex", + "Version": "0.44", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "xfun" + ], + "Hash": "c0f007e2eeed7722ce13d42b84a22e07" + }, + "urlchecker": { + "Package": "urlchecker", + "Version": "1.0.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cli", + "curl", + "tools", + "xml2" + ], + "Hash": "409328b8e1253c8d729a7836fe7f7a16" + }, + "usethis": { + "Package": "usethis", + "Version": "2.1.6", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cli", + "clipr", + "crayon", + "curl", + "desc", + "fs", + "gert", + "gh", + "glue", + "jsonlite", + "lifecycle", + "purrr", + "rappdirs", + "rlang", + "rprojroot", + "rstudioapi", + "stats", + "utils", + "whisker", + "withr", + "yaml" + ], + "Hash": "a67a22c201832b12c036cc059f1d137d" + }, + "utf8": { + "Package": "utf8", + "Version": "1.2.3", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "1fe17157424bb09c48a8b3b550c753bc" + }, + "vctrs": { + "Package": "vctrs", + "Version": "0.6.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "glue", + "lifecycle", + "rlang" + ], + "Hash": "7e877404388794361277be95d8445de8" + }, + "waldo": { + "Package": "waldo", + "Version": "0.4.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "cli", + "diffobj", + "fansi", + "glue", + "methods", + "rematch2", + "rlang", + "tibble" + ], + "Hash": "035fba89d0c86e2113120f93301b98ad" + }, + "whisker": { + "Package": "whisker", + "Version": "0.4.1", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "c6abfa47a46d281a7d5159d0a8891e88" + }, + "withr": { + "Package": "withr", + "Version": "2.5.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "grDevices", + "graphics", + "stats" + ], + "Hash": "c0e49a9760983e81e55cdd9be92e7182" + }, + "xfun": { + "Package": "xfun", + "Version": "0.37", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "stats", + "tools" + ], + "Hash": "a6860e1400a8fd1ddb6d9b4230cc34ab" + }, + "xml2": { + "Package": "xml2", + "Version": "1.3.3", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "methods" + ], + "Hash": "40682ed6a969ea5abfd351eb67833adc" + }, + "xmlparsedata": { + "Package": "xmlparsedata", + "Version": "1.0.5", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "45e4bf3c46476896e821fc0a408fb4fc" + }, + "xopen": { + "Package": "xopen", + "Version": "1.0.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "processx" + ], + "Hash": "6c85f015dee9cc7710ddd20f86881f58" + }, + "xtable": { + "Package": "xtable", + "Version": "1.8-4", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "stats", + "utils" + ], + "Hash": "b8acdf8af494d9ec19ccb2481a9b11c2" + }, + "yaml": { + "Package": "yaml", + "Version": "2.3.7", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "0d0056cc5383fbc240ccd0cb584bf436" + }, + "zip": { + "Package": "zip", + "Version": "2.2.2", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "c42bfcec3fa6a0cce17ce1f8bc684f88" + } + } +} diff --git a/renv/profiles/4.2/renv/.gitignore b/renv/profiles/4.2/renv/.gitignore new file mode 100644 index 0000000000..0ec0cbba2d --- /dev/null +++ b/renv/profiles/4.2/renv/.gitignore @@ -0,0 +1,7 @@ +library/ +local/ +cellar/ +lock/ +python/ +sandbox/ +staging/ diff --git a/renv/profiles/4.2/renv/settings.dcf b/renv/profiles/4.2/renv/settings.dcf new file mode 100644 index 0000000000..fd205f802c --- /dev/null +++ b/renv/profiles/4.2/renv/settings.dcf @@ -0,0 +1,10 @@ +bioconductor.version: +external.libraries: +ignored.packages: admiral, admiraldev, admiral.test, admiralci +package.dependency.fields: Imports, Depends, LinkingTo +r.version: +snapshot.type: implicit +use.cache: TRUE +vcs.ignore.cellar: TRUE +vcs.ignore.library: TRUE +vcs.ignore.local: TRUE diff --git a/renv/profiles/4.3/renv.lock b/renv/profiles/4.3/renv.lock new file mode 100644 index 0000000000..b875a5b89e --- /dev/null +++ b/renv/profiles/4.3/renv.lock @@ -0,0 +1,1707 @@ +{ + "R": { + "Version": "4.3.0", + "Repositories": [ + { + "Name": "CRAN", + "URL": "https://cloud.r-project.org" + }, + { + "Name": "RSPM", + "URL": "https://packagemanager.posit.co/cran/2023-04-20" + } + ] + }, + "Packages": { + "DT": { + "Package": "DT", + "Version": "0.27", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "crosstalk", + "htmltools", + "htmlwidgets", + "jquerylib", + "jsonlite", + "magrittr", + "promises" + ], + "Hash": "3444e6ed78763f9f13aaa39f2481eb34" + }, + "R.cache": { + "Package": "R.cache", + "Version": "0.16.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R.methodsS3", + "R.oo", + "R.utils", + "digest", + "utils" + ], + "Hash": "fe539ca3f8efb7410c3ae2cf5fe6c0f8" + }, + "R.methodsS3": { + "Package": "R.methodsS3", + "Version": "1.8.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "utils" + ], + "Hash": "278c286fd6e9e75d0c2e8f731ea445c8" + }, + "R.oo": { + "Package": "R.oo", + "Version": "1.25.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R.methodsS3", + "methods", + "utils" + ], + "Hash": "a0900a114f4f0194cf4aa8cd4a700681" + }, + "R.utils": { + "Package": "R.utils", + "Version": "2.12.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R.methodsS3", + "R.oo", + "methods", + "tools", + "utils" + ], + "Hash": "325f01db13da12c04d8f6e7be36ff514" + }, + "R6": { + "Package": "R6", + "Version": "2.5.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "470851b6d5d0ac559e9d01bb352b4021" + }, + "Rcpp": { + "Package": "Rcpp", + "Version": "1.0.10", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "methods", + "utils" + ], + "Hash": "e749cae40fa9ef469b6050959517453c" + }, + "askpass": { + "Package": "askpass", + "Version": "1.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "sys" + ], + "Hash": "e8a22846fff485f0be3770c2da758713" + }, + "backports": { + "Package": "backports", + "Version": "1.4.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "c39fbec8a30d23e721980b8afb31984c" + }, + "base64enc": { + "Package": "base64enc", + "Version": "0.1-3", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "543776ae6848fde2f48ff3816d0628bc" + }, + "brew": { + "Package": "brew", + "Version": "1.0-8", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "d69a786e85775b126bddbee185ae6084" + }, + "brio": { + "Package": "brio", + "Version": "1.1.3", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "976cf154dfb043c012d87cddd8bca363" + }, + "bslib": { + "Package": "bslib", + "Version": "0.4.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "base64enc", + "cachem", + "grDevices", + "htmltools", + "jquerylib", + "jsonlite", + "memoise", + "mime", + "rlang", + "sass" + ], + "Hash": "a7fbf03946ad741129dc81098722fca1" + }, + "cachem": { + "Package": "cachem", + "Version": "1.0.7", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "fastmap", + "rlang" + ], + "Hash": "cda74447c42f529de601fe4d4050daef" + }, + "callr": { + "Package": "callr", + "Version": "3.7.3", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R6", + "processx", + "utils" + ], + "Hash": "9b2191ede20fa29828139b9900922e51" + }, + "cli": { + "Package": "cli", + "Version": "3.6.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "utils" + ], + "Hash": "89e6d8219950eac806ae0c489052048a" + }, + "clipr": { + "Package": "clipr", + "Version": "0.8.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "utils" + ], + "Hash": "3f038e5ac7f41d4ac41ce658c85e3042" + }, + "codetools": { + "Package": "codetools", + "Version": "0.2-19", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "c089a619a7fae175d149d89164f8c7d8" + }, + "commonmark": { + "Package": "commonmark", + "Version": "1.9.0", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "d691c61bff84bd63c383874d2d0c3307" + }, + "covr": { + "Package": "covr", + "Version": "3.6.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "crayon", + "digest", + "httr", + "jsonlite", + "methods", + "rex", + "stats", + "utils", + "withr", + "yaml" + ], + "Hash": "a0d8f9a55add5311d48227b6f7f38e34" + }, + "cpp11": { + "Package": "cpp11", + "Version": "0.4.3", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "ed588261931ee3be2c700d22e94a29ab" + }, + "crayon": { + "Package": "crayon", + "Version": "1.5.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "grDevices", + "methods", + "utils" + ], + "Hash": "e8a1e41acf02548751f45c718d55aa6a" + }, + "credentials": { + "Package": "credentials", + "Version": "1.3.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "askpass", + "curl", + "jsonlite", + "openssl", + "sys" + ], + "Hash": "93762d0a34d78e6a025efdbfb5c6bb41" + }, + "crosstalk": { + "Package": "crosstalk", + "Version": "1.2.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R6", + "htmltools", + "jsonlite", + "lazyeval" + ], + "Hash": "6aa54f69598c32177e920eb3402e8293" + }, + "curl": { + "Package": "curl", + "Version": "5.0.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "e4f97056611e8e6b8b852d13b7400cf1" + }, + "cyclocomp": { + "Package": "cyclocomp", + "Version": "1.1.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "callr", + "crayon", + "desc", + "remotes", + "withr" + ], + "Hash": "53cbed70a2f7472d48fb6aef08442f25" + }, + "desc": { + "Package": "desc", + "Version": "1.4.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R6", + "cli", + "rprojroot", + "utils" + ], + "Hash": "6b9602c7ebbe87101a9c8edb6e8b6d21" + }, + "devtools": { + "Package": "devtools", + "Version": "2.4.5", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cli", + "desc", + "ellipsis", + "fs", + "lifecycle", + "memoise", + "miniUI", + "pkgbuild", + "pkgdown", + "pkgload", + "profvis", + "rcmdcheck", + "remotes", + "rlang", + "roxygen2", + "rversions", + "sessioninfo", + "stats", + "testthat", + "tools", + "urlchecker", + "usethis", + "utils", + "withr" + ], + "Hash": "ea5bc8b4a6a01e4f12d98b58329930bb" + }, + "diffdf": { + "Package": "diffdf", + "Version": "1.0.4", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "tibble" + ], + "Hash": "9ddedef46959baad2080047a1b0117fe" + }, + "diffobj": { + "Package": "diffobj", + "Version": "0.3.5", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "crayon", + "methods", + "stats", + "tools", + "utils" + ], + "Hash": "bcaa8b95f8d7d01a5dedfd959ce88ab8" + }, + "digest": { + "Package": "digest", + "Version": "0.6.31", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "utils" + ], + "Hash": "8b708f296afd9ae69f450f9640be8990" + }, + "downlit": { + "Package": "downlit", + "Version": "0.4.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "brio", + "desc", + "digest", + "evaluate", + "fansi", + "memoise", + "rlang", + "vctrs", + "withr", + "yaml" + ], + "Hash": "79bf3f66590752ffbba20f8d2da94c7c" + }, + "dplyr": { + "Package": "dplyr", + "Version": "1.1.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R6", + "cli", + "generics", + "glue", + "lifecycle", + "magrittr", + "methods", + "pillar", + "rlang", + "tibble", + "tidyselect", + "utils", + "vctrs" + ], + "Hash": "eb5742d256a0d9306d85ea68756d8187" + }, + "ellipsis": { + "Package": "ellipsis", + "Version": "0.3.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "rlang" + ], + "Hash": "bb0eec2fe32e88d9e2836c2f73ea2077" + }, + "evaluate": { + "Package": "evaluate", + "Version": "0.20", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "methods" + ], + "Hash": "4b68aa51edd89a0e044a66e75ae3cc6c" + }, + "fansi": { + "Package": "fansi", + "Version": "1.0.4", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "grDevices", + "utils" + ], + "Hash": "1d9e7ad3c8312a192dea7d3db0274fde" + }, + "fastmap": { + "Package": "fastmap", + "Version": "1.1.1", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "f7736a18de97dea803bde0a2daaafb27" + }, + "fontawesome": { + "Package": "fontawesome", + "Version": "0.5.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "htmltools", + "rlang" + ], + "Hash": "1e22b8cabbad1eae951a75e9f8b52378" + }, + "fs": { + "Package": "fs", + "Version": "1.6.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "methods" + ], + "Hash": "f4dcd23b67e33d851d2079f703e8b985" + }, + "generics": { + "Package": "generics", + "Version": "0.1.3", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "methods" + ], + "Hash": "15e9634c0fcd294799e9b2e929ed1b86" + }, + "gert": { + "Package": "gert", + "Version": "1.9.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "askpass", + "credentials", + "openssl", + "rstudioapi", + "sys", + "zip" + ], + "Hash": "9122b3958e749badb5c939f498038b57" + }, + "gh": { + "Package": "gh", + "Version": "1.4.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cli", + "gitcreds", + "httr2", + "ini", + "jsonlite", + "rlang" + ], + "Hash": "03533b1c875028233598f848fda44c4c" + }, + "git2r": { + "Package": "git2r", + "Version": "0.32.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "graphics", + "utils" + ], + "Hash": "1882d7a76fd8c14b2322865f74c9a348" + }, + "gitcreds": { + "Package": "gitcreds", + "Version": "0.1.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "ab08ac61f3e1be454ae21911eb8bc2fe" + }, + "glue": { + "Package": "glue", + "Version": "1.6.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "methods" + ], + "Hash": "4f2596dfb05dac67b9dc558e5c6fba2e" + }, + "highr": { + "Package": "highr", + "Version": "0.10", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "xfun" + ], + "Hash": "06230136b2d2b9ba5805e1963fa6e890" + }, + "hms": { + "Package": "hms", + "Version": "1.1.3", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "lifecycle", + "methods", + "pkgconfig", + "rlang", + "vctrs" + ], + "Hash": "b59377caa7ed00fa41808342002138f9" + }, + "htmltools": { + "Package": "htmltools", + "Version": "0.5.5", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "base64enc", + "digest", + "ellipsis", + "fastmap", + "grDevices", + "rlang", + "utils" + ], + "Hash": "ba0240784ad50a62165058a27459304a" + }, + "htmlwidgets": { + "Package": "htmlwidgets", + "Version": "1.6.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "grDevices", + "htmltools", + "jsonlite", + "knitr", + "rmarkdown", + "yaml" + ], + "Hash": "a865aa85bcb2697f47505bfd70422471" + }, + "httpuv": { + "Package": "httpuv", + "Version": "1.6.9", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R6", + "Rcpp", + "later", + "promises", + "utils" + ], + "Hash": "1046aa31a57eae8b357267a56a0b6d8b" + }, + "httr": { + "Package": "httr", + "Version": "1.4.5", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R6", + "curl", + "jsonlite", + "mime", + "openssl" + ], + "Hash": "f6844033201269bec3ca0097bc6c97b3" + }, + "httr2": { + "Package": "httr2", + "Version": "0.2.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R6", + "cli", + "curl", + "glue", + "magrittr", + "openssl", + "rappdirs", + "rlang", + "withr" + ], + "Hash": "5c09fe33064978ede54de42309c8b532" + }, + "hunspell": { + "Package": "hunspell", + "Version": "3.0.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "Rcpp", + "digest" + ], + "Hash": "656219b6f3f605499d7cdbe208656639" + }, + "ini": { + "Package": "ini", + "Version": "0.3.1", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "6154ec2223172bce8162d4153cda21f7" + }, + "jquerylib": { + "Package": "jquerylib", + "Version": "0.1.4", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "htmltools" + ], + "Hash": "5aab57a3bd297eee1c1d862735972182" + }, + "jsonlite": { + "Package": "jsonlite", + "Version": "1.8.4", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "methods" + ], + "Hash": "a4269a09a9b865579b2635c77e572374" + }, + "knitr": { + "Package": "knitr", + "Version": "1.42", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "evaluate", + "highr", + "methods", + "tools", + "xfun", + "yaml" + ], + "Hash": "8329a9bcc82943c8069104d4be3ee22d" + }, + "later": { + "Package": "later", + "Version": "1.3.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "Rcpp", + "rlang" + ], + "Hash": "7e7b457d7766bc47f2a5f21cc2984f8e" + }, + "lazyeval": { + "Package": "lazyeval", + "Version": "0.2.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "d908914ae53b04d4c0c0fd72ecc35370" + }, + "lifecycle": { + "Package": "lifecycle", + "Version": "1.0.3", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cli", + "glue", + "rlang" + ], + "Hash": "001cecbeac1cff9301bdc3775ee46a86" + }, + "lintr": { + "Package": "lintr", + "Version": "3.0.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "backports", + "codetools", + "crayon", + "cyclocomp", + "digest", + "glue", + "jsonlite", + "knitr", + "rex", + "stats", + "utils", + "xml2", + "xmlparsedata" + ], + "Hash": "b21ebd652d940f099915221f3328ab7b" + }, + "lubridate": { + "Package": "lubridate", + "Version": "1.9.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "generics", + "methods", + "timechange" + ], + "Hash": "e25f18436e3efd42c7c590a1c4c15390" + }, + "magrittr": { + "Package": "magrittr", + "Version": "2.0.3", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "7ce2733a9826b3aeb1775d56fd305472" + }, + "memoise": { + "Package": "memoise", + "Version": "2.0.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "cachem", + "rlang" + ], + "Hash": "e2817ccf4a065c5d9d7f2cfbe7c1d78c" + }, + "mime": { + "Package": "mime", + "Version": "0.12", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "tools" + ], + "Hash": "18e9c28c1d3ca1560ce30658b22ce104" + }, + "miniUI": { + "Package": "miniUI", + "Version": "0.1.1.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "htmltools", + "shiny", + "utils" + ], + "Hash": "fec5f52652d60615fdb3957b3d74324a" + }, + "openssl": { + "Package": "openssl", + "Version": "2.0.6", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "askpass" + ], + "Hash": "0f7cd2962e3044bb940cca4f4b5cecbe" + }, + "pillar": { + "Package": "pillar", + "Version": "1.9.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "cli", + "fansi", + "glue", + "lifecycle", + "rlang", + "utf8", + "utils", + "vctrs" + ], + "Hash": "15da5a8412f317beeee6175fbc76f4bb" + }, + "pkgbuild": { + "Package": "pkgbuild", + "Version": "1.4.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R6", + "callr", + "cli", + "crayon", + "desc", + "prettyunits", + "processx", + "rprojroot", + "withr" + ], + "Hash": "d6c3008d79653a0f267703288230105e" + }, + "pkgconfig": { + "Package": "pkgconfig", + "Version": "2.0.3", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "utils" + ], + "Hash": "01f28d4278f15c76cddbea05899c5d6f" + }, + "pkgdown": { + "Package": "pkgdown", + "Version": "2.0.7", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "bslib", + "callr", + "cli", + "desc", + "digest", + "downlit", + "fs", + "httr", + "jsonlite", + "magrittr", + "memoise", + "purrr", + "ragg", + "rlang", + "rmarkdown", + "tibble", + "whisker", + "withr", + "xml2", + "yaml" + ], + "Hash": "16fa15449c930bf3a7761d3c68f8abf9" + }, + "pkgload": { + "Package": "pkgload", + "Version": "1.3.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cli", + "crayon", + "desc", + "fs", + "glue", + "methods", + "rlang", + "rprojroot", + "utils", + "withr" + ], + "Hash": "6b0c222c5071efe0f3baf3dae9aa40e2" + }, + "praise": { + "Package": "praise", + "Version": "1.0.0", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "a555924add98c99d2f411e37e7d25e9f" + }, + "prettyunits": { + "Package": "prettyunits", + "Version": "1.1.1", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "95ef9167b75dde9d2ccc3c7528393e7e" + }, + "processx": { + "Package": "processx", + "Version": "3.8.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R6", + "ps", + "utils" + ], + "Hash": "d75b4059d781336efba24021915902b4" + }, + "profvis": { + "Package": "profvis", + "Version": "0.3.7", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "htmlwidgets", + "stringr" + ], + "Hash": "e9d21e79848e02e524bea6f5bd53e7e4" + }, + "promises": { + "Package": "promises", + "Version": "1.2.0.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R6", + "Rcpp", + "later", + "magrittr", + "rlang", + "stats" + ], + "Hash": "4ab2c43adb4d4699cf3690acd378d75d" + }, + "ps": { + "Package": "ps", + "Version": "1.7.5", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "utils" + ], + "Hash": "709d852d33178db54b17c722e5b1e594" + }, + "purrr": { + "Package": "purrr", + "Version": "1.0.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cli", + "lifecycle", + "magrittr", + "rlang", + "vctrs" + ], + "Hash": "d71c815267c640f17ddbf7f16144b4bb" + }, + "ragg": { + "Package": "ragg", + "Version": "1.2.5", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "systemfonts", + "textshaping" + ], + "Hash": "690bc058ea2b1b8a407d3cfe3dce3ef9" + }, + "rappdirs": { + "Package": "rappdirs", + "Version": "0.3.3", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "5e3c5dc0b071b21fa128676560dbe94d" + }, + "rcmdcheck": { + "Package": "rcmdcheck", + "Version": "1.4.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R6", + "callr", + "cli", + "curl", + "desc", + "digest", + "pkgbuild", + "prettyunits", + "rprojroot", + "sessioninfo", + "utils", + "withr", + "xopen" + ], + "Hash": "8f25ebe2ec38b1f2aef3b0d2ef76f6c4" + }, + "rematch2": { + "Package": "rematch2", + "Version": "2.1.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "tibble" + ], + "Hash": "76c9e04c712a05848ae7a23d2f170a40" + }, + "remotes": { + "Package": "remotes", + "Version": "2.4.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "methods", + "stats", + "tools", + "utils" + ], + "Hash": "227045be9aee47e6dda9bb38ac870d67" + }, + "renv": { + "Package": "renv", + "Version": "0.17.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "utils" + ], + "Hash": "ce3065fc1a0b64a859f55ac3998d6927" + }, + "rex": { + "Package": "rex", + "Version": "1.2.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "lazyeval" + ], + "Hash": "ae34cd56890607370665bee5bd17812f" + }, + "rlang": { + "Package": "rlang", + "Version": "1.1.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "utils" + ], + "Hash": "dc079ccd156cde8647360f473c1fa718" + }, + "rmarkdown": { + "Package": "rmarkdown", + "Version": "2.21", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "bslib", + "evaluate", + "fontawesome", + "htmltools", + "jquerylib", + "jsonlite", + "knitr", + "methods", + "stringr", + "tinytex", + "tools", + "utils", + "xfun", + "yaml" + ], + "Hash": "493df4ae51e2e984952ea4d5c75786a3" + }, + "roxygen2": { + "Package": "roxygen2", + "Version": "7.2.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "brew", + "cli", + "commonmark", + "cpp11", + "desc", + "knitr", + "methods", + "pkgload", + "purrr", + "rlang", + "stringi", + "stringr", + "utils", + "withr", + "xml2" + ], + "Hash": "7b153c746193b143c14baa072bae4e27" + }, + "rprojroot": { + "Package": "rprojroot", + "Version": "2.0.3", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "1de7ab598047a87bba48434ba35d497d" + }, + "rstudioapi": { + "Package": "rstudioapi", + "Version": "0.14", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "690bd2acc42a9166ce34845884459320" + }, + "rversions": { + "Package": "rversions", + "Version": "2.1.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "curl", + "utils", + "xml2" + ], + "Hash": "a9881dfed103e83f9de151dc17002cd1" + }, + "sass": { + "Package": "sass", + "Version": "0.4.5", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R6", + "fs", + "htmltools", + "rappdirs", + "rlang" + ], + "Hash": "2bb4371a4c80115518261866eab6ab11" + }, + "sessioninfo": { + "Package": "sessioninfo", + "Version": "1.2.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cli", + "tools", + "utils" + ], + "Hash": "3f9796a8d0a0e8c6eb49a4b029359d1f" + }, + "shiny": { + "Package": "shiny", + "Version": "1.7.4", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R6", + "bslib", + "cachem", + "commonmark", + "crayon", + "ellipsis", + "fastmap", + "fontawesome", + "glue", + "grDevices", + "htmltools", + "httpuv", + "jsonlite", + "later", + "lifecycle", + "methods", + "mime", + "promises", + "rlang", + "sourcetools", + "tools", + "utils", + "withr", + "xtable" + ], + "Hash": "c2eae3d8c670fa9dfa35a12066f4a1d5" + }, + "sourcetools": { + "Package": "sourcetools", + "Version": "0.1.7-1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "5f5a7629f956619d519205ec475fe647" + }, + "spelling": { + "Package": "spelling", + "Version": "2.2.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "commonmark", + "hunspell", + "knitr", + "xml2" + ], + "Hash": "8ed9f010f7caeb8586523088b7f23dcd" + }, + "staged.dependencies": { + "Package": "staged.dependencies", + "Version": "0.2.8", + "Source": "GitHub", + "RemoteType": "github", + "RemoteHost": "api.github.com", + "RemoteUsername": "openpharma", + "RemoteRepo": "staged.dependencies", + "RemoteRef": "main", + "RemoteSha": "ce7c112ba3d75cf48e4dd6310b3140ab0ec3b486", + "Requirements": [ + "desc", + "devtools", + "digest", + "dplyr", + "fs", + "git2r", + "glue", + "httr", + "jsonlite", + "methods", + "rcmdcheck", + "remotes", + "rlang", + "stats", + "tidyr", + "utils", + "withr", + "yaml" + ], + "Hash": "89f2e1d1009601f58f64b7092abcc0d7" + }, + "stringi": { + "Package": "stringi", + "Version": "1.7.12", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "stats", + "tools", + "utils" + ], + "Hash": "ca8bd84263c77310739d2cf64d84d7c9" + }, + "stringr": { + "Package": "stringr", + "Version": "1.5.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cli", + "glue", + "lifecycle", + "magrittr", + "rlang", + "stringi", + "vctrs" + ], + "Hash": "671a4d384ae9d32fc47a14e98bfa3dc8" + }, + "styler": { + "Package": "styler", + "Version": "1.9.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R.cache", + "cli", + "magrittr", + "purrr", + "rlang", + "rprojroot", + "tools", + "vctrs", + "withr" + ], + "Hash": "ed8c90822b7da46beee603f263a85fe0" + }, + "sys": { + "Package": "sys", + "Version": "3.4.1", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "34c16f1ef796057bfa06d3f4ff818a5d" + }, + "systemfonts": { + "Package": "systemfonts", + "Version": "1.0.4", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cpp11" + ], + "Hash": "90b28393209827327de889f49935140a" + }, + "testthat": { + "Package": "testthat", + "Version": "3.1.7", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R6", + "brio", + "callr", + "cli", + "desc", + "digest", + "ellipsis", + "evaluate", + "jsonlite", + "lifecycle", + "magrittr", + "methods", + "pkgload", + "praise", + "processx", + "ps", + "rlang", + "utils", + "waldo", + "withr" + ], + "Hash": "7eb5fd202a61d2fb78af5869b6c08998" + }, + "textshaping": { + "Package": "textshaping", + "Version": "0.3.6", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cpp11", + "systemfonts" + ], + "Hash": "1ab6223d3670fac7143202cb6a2d43d5" + }, + "tibble": { + "Package": "tibble", + "Version": "3.2.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "fansi", + "lifecycle", + "magrittr", + "methods", + "pillar", + "pkgconfig", + "rlang", + "utils", + "vctrs" + ], + "Hash": "a84e2cc86d07289b3b6f5069df7a004c" + }, + "tidyr": { + "Package": "tidyr", + "Version": "1.3.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cli", + "cpp11", + "dplyr", + "glue", + "lifecycle", + "magrittr", + "purrr", + "rlang", + "stringr", + "tibble", + "tidyselect", + "utils", + "vctrs" + ], + "Hash": "e47debdc7ce599b070c8e78e8ac0cfcf" + }, + "tidyselect": { + "Package": "tidyselect", + "Version": "1.2.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cli", + "glue", + "lifecycle", + "rlang", + "vctrs", + "withr" + ], + "Hash": "79540e5fcd9e0435af547d885f184fd5" + }, + "timechange": { + "Package": "timechange", + "Version": "0.2.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cpp11" + ], + "Hash": "8548b44f79a35ba1791308b61e6012d7" + }, + "tinytex": { + "Package": "tinytex", + "Version": "0.45", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "xfun" + ], + "Hash": "e4e357f28c2edff493936b6cb30c3d65" + }, + "urlchecker": { + "Package": "urlchecker", + "Version": "1.0.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cli", + "curl", + "tools", + "xml2" + ], + "Hash": "409328b8e1253c8d729a7836fe7f7a16" + }, + "usethis": { + "Package": "usethis", + "Version": "2.1.6", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cli", + "clipr", + "crayon", + "curl", + "desc", + "fs", + "gert", + "gh", + "glue", + "jsonlite", + "lifecycle", + "purrr", + "rappdirs", + "rlang", + "rprojroot", + "rstudioapi", + "stats", + "utils", + "whisker", + "withr", + "yaml" + ], + "Hash": "a67a22c201832b12c036cc059f1d137d" + }, + "utf8": { + "Package": "utf8", + "Version": "1.2.3", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "1fe17157424bb09c48a8b3b550c753bc" + }, + "vctrs": { + "Package": "vctrs", + "Version": "0.6.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cli", + "glue", + "lifecycle", + "rlang" + ], + "Hash": "a745bda7aff4734c17294bb41d4e4607" + }, + "waldo": { + "Package": "waldo", + "Version": "0.4.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "cli", + "diffobj", + "fansi", + "glue", + "methods", + "rematch2", + "rlang", + "tibble" + ], + "Hash": "035fba89d0c86e2113120f93301b98ad" + }, + "whisker": { + "Package": "whisker", + "Version": "0.4.1", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "c6abfa47a46d281a7d5159d0a8891e88" + }, + "withr": { + "Package": "withr", + "Version": "2.5.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "grDevices", + "graphics", + "stats" + ], + "Hash": "c0e49a9760983e81e55cdd9be92e7182" + }, + "xfun": { + "Package": "xfun", + "Version": "0.38", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "stats", + "tools" + ], + "Hash": "1ed71215d45e85562d3b1b29a068ccec" + }, + "xml2": { + "Package": "xml2", + "Version": "1.3.3", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "methods" + ], + "Hash": "40682ed6a969ea5abfd351eb67833adc" + }, + "xmlparsedata": { + "Package": "xmlparsedata", + "Version": "1.0.5", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "45e4bf3c46476896e821fc0a408fb4fc" + }, + "xopen": { + "Package": "xopen", + "Version": "1.0.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "processx" + ], + "Hash": "6c85f015dee9cc7710ddd20f86881f58" + }, + "xtable": { + "Package": "xtable", + "Version": "1.8-4", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "stats", + "utils" + ], + "Hash": "b8acdf8af494d9ec19ccb2481a9b11c2" + }, + "yaml": { + "Package": "yaml", + "Version": "2.3.7", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "0d0056cc5383fbc240ccd0cb584bf436" + }, + "zip": { + "Package": "zip", + "Version": "2.3.0", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "d98c94dacb7e0efcf83b0a133a705504" + } + } +} diff --git a/renv/profiles/4.3/renv/.gitignore b/renv/profiles/4.3/renv/.gitignore new file mode 100644 index 0000000000..0ec0cbba2d --- /dev/null +++ b/renv/profiles/4.3/renv/.gitignore @@ -0,0 +1,7 @@ +library/ +local/ +cellar/ +lock/ +python/ +sandbox/ +staging/ diff --git a/renv/profiles/4.3/renv/settings.dcf b/renv/profiles/4.3/renv/settings.dcf new file mode 100644 index 0000000000..fd205f802c --- /dev/null +++ b/renv/profiles/4.3/renv/settings.dcf @@ -0,0 +1,10 @@ +bioconductor.version: +external.libraries: +ignored.packages: admiral, admiraldev, admiral.test, admiralci +package.dependency.fields: Imports, Depends, LinkingTo +r.version: +snapshot.type: implicit +use.cache: TRUE +vcs.ignore.cellar: TRUE +vcs.ignore.library: TRUE +vcs.ignore.local: TRUE diff --git a/renv/settings.dcf b/renv/settings.dcf index 0c5119c7f3..fd205f802c 100644 --- a/renv/settings.dcf +++ b/renv/settings.dcf @@ -1,6 +1,10 @@ -ignored.packages: +bioconductor.version: +external.libraries: +ignored.packages: admiral, admiraldev, admiral.test, admiralci package.dependency.fields: Imports, Depends, LinkingTo r.version: snapshot.type: implicit use.cache: TRUE +vcs.ignore.cellar: TRUE vcs.ignore.library: TRUE +vcs.ignore.local: TRUE diff --git a/tests/testthat.R b/tests/testthat.R index 1574d1d430..a3324ee64f 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -6,7 +6,7 @@ # * https://r-pkgs.org/tests.html # * https://testthat.r-lib.org/reference/test_package.html#special-files -library(testthat) -library(admiral) +library(testthat) # nolint: undesirable_function_linter +library(admiral) # nolint: undesirable_function_linter test_check("admiral") diff --git a/tests/testthat/test-compute_age_years.R b/tests/testthat/test-compute_age_years.R new file mode 100644 index 0000000000..00a4a9a539 --- /dev/null +++ b/tests/testthat/test-compute_age_years.R @@ -0,0 +1,63 @@ +## Test 1: compute_age_years() works when `age_unit` is a string ---- +test_that("compute_age_years Test 1: compute_age_years() works when `age_unit` is a string", { + age_input <- c(240, 360, 480, NA) + age_unit_input <- "MONTHS" + + expected_output <- c(20, 30, 40, NA) + + expect_equal( + compute_age_years( + age_input, + age_unit_input + ), + expected_output + ) +}) + +## Test 2: compute_age_years() works when `age_unit` is a vector ---- +test_that("compute_age_years Test 2: compute_age_years() works when `age_unit` is a vector", { + age_input <- c(28, 1461, 10227) + age_unit_input <- c("YEARS", "WEEKS", "DAYS") + + expected_output <- rep(28, 3) + + expect_equal( + compute_age_years( + age_input, + age_unit_input + ), + expected_output + ) +}) + +## Test 3: Error is issued when `age_unit` has invalid length ---- +test_that("compute_age_years Test 3: Error is issued when `age_unit` has invalid length", { + age_input <- c(28, 1461, 10227) + age_unit_input <- c("YEARS", "WEEKS") + + expected_output <- rep(28, 3) + + expect_error( + compute_age_years(age_input, age_unit_input), + paste0( + "`age_unit` must be a single string or a vector of the same length as", + "`age`, but there are 3 values in `age` and 2 values in `age_unit`." + ) + ) +}) + +## Test 4: `age_unit` processes values in a case insensitive manner ---- +test_that("compute_age_years Test 4: `age_unit` processes values in a case insensitive manner", { + age_input <- c(240, 360, 480) + age_unit_input <- c("MONTHS", "Months", "months") + + expected_output <- c(20, 30, 40) + + expect_equal( + compute_age_years( + age_input, + age_unit_input + ), + expected_output + ) +}) diff --git a/tests/testthat/test-compute_kidney.R b/tests/testthat/test-compute_kidney.R new file mode 100644 index 0000000000..426fe80da2 --- /dev/null +++ b/tests/testthat/test-compute_kidney.R @@ -0,0 +1,101 @@ +# compute_egfr ---- + +## Test 1: EGFR CKD-EPI calculation ---- +test_that("compute_egfr Test 1: EGFR CKD-EPI calculation", { + # Expected values are taken from the National Kidney Foundation's + # CKD-EPI Creatinine Equation (2021) calculator at + # https://www.kidney.org/professionals/kdoqi/gfr_calculator + expect_equal(round(compute_egfr( + creat = 1.09, creatu = "mg/dL", age = 55, sex = "M", method = "CKD-EPI" + ), 0L), 80) +}) + +## Test 2: EGFR CKD-EPI calculation ---- +test_that("compute_egfr Test 2: EGFR CKD-EPI calculation", { + # Expected values are taken from the National Kidney Foundation's + # CKD-EPI Creatinine Equation (2021) calculator at + # https://www.kidney.org/professionals/kdoqi/gfr_calculator + expect_equal(round(compute_egfr( + creat = 85, creatu = "umol/L", age = 65, sex = "F", method = "CKD-EPI" + ), 0L), 66) +}) + + +## Test 3: CRCL calculation ---- +test_that("compute_egfr Test 3: CRCL calculation", { + # Expected values are taken from the National Kidney Foundation's + # CRCL Cockcroft and Gault (1973) calculator at + # https://www.kidney.org/professionals/kdoqi/gfr_calculatorCoc + expect_equal(round(compute_egfr( + creat = 1.09, creatu = "mg/dL", age = 55, sex = "M", wt = 90, method = "CRCL" + ), 0L), 97) +}) + + +## Test 4: CRCL calculation ---- +test_that("compute_egfr Test 4: CRCL calculation", { + # Expected values are taken from the National Kidney Foundation's + # CRCL Cockcroft and Gault (1973) calculator at + # https://www.kidney.org/professionals/kdoqi/gfr_calculatorCoc + expect_equal(round(compute_egfr( + creat = 85, creatu = "umol/L", age = 65, sex = "F", wt = 60, method = "CRCL" + ), 0L), 55) +}) + + +## Test 5: EGFR MDRD calculation ---- +test_that("compute_egfr Test 5: EGFR MDRD calculation", { + # Expected values are taken from the MD Calc + # MDRD GFR calculator at + # https://www.mdcalc.com/calc/76/mdrd-gfr-equation + expect_equal(round(compute_egfr( + creat = 1.09, creatu = "mg/dL", age = 55, sex = "M", wt = 90, race = "WHITE", + method = "MDRD" + ), 1L), 70.2) +}) + +## Test 6: EGFR MDRD calculation ---- +test_that("compute_egfr Test 6: EGFR MDRD calculation", { + # Expected values are taken from the MD Calc + # MDRD GFR calculator at + # https://www.mdcalc.com/calc/76/mdrd-gfr-equation + expect_equal(round(compute_egfr( + creat = 85, creatu = "umol/L", age = 65, sex = "F", + race = "BLACK OR AFRICAN AMERICAN", method = "MDRD" + ), 1L), 70.6) +}) + + +## Test 7: CKD-EPI calculated on input data ---- +test_that("compute_egfr Test 7: CKD-EPI calculated on input data", { + input <- tibble::tribble( + ~STUDYID, ~USUBJID, ~AGE, ~SEX, ~RACE, ~WTBL, ~CREATBL, ~CREATBLU, + "P01", "P01-1001", 55, "M", "WHITE", 90.7, 96.3, "umol/L", + "P01", "P01-1002", 52, "F", "BLACK OR AFRICAN AMERICAN", 68, 70, "umol/L", + "P01", "P01-1003", 67, "M", "BLACK OR AFRICAN AMERICAN", 85, 77, "umol/L", + "P01", "P01-1004", 76, "F", "ASIAN", 60, 65, "umol/L" + ) + + expected_output <- tibble::tribble( + ~STUDYID, ~USUBJID, ~AGE, ~SEX, ~RACE, ~WTBL, ~CREATBL, ~CREATBLU, ~EGFR, + "P01", "P01-1001", 55, "M", "WHITE", 90.7, 96.3, "umol/L", 80.2293, + "P01", "P01-1002", 52, "F", "BLACK OR AFRICAN AMERICAN", 68, 70, "umol/L", 89.7175, + "P01", "P01-1003", 67, "M", "BLACK OR AFRICAN AMERICAN", 85, 77, "umol/L", 94.5453, + "P01", "P01-1004", 76, "F", "ASIAN", 60, 65, "umol/L", 84.4646, + ) + + egfr <- input %>% + dplyr::mutate( + EGFR = compute_egfr( + creat = CREATBL, creatu = CREATBLU, age = AGE, wt = WTBL, sex = SEX, + method = "CKD-EPI" + ), + EGFR = round(EGFR, 4L) + ) + + expect_dfs_equal( + egfr, + expected_output, + keys = c("USUBJID") + ) +}) diff --git a/tests/testthat/test-consolidate_metadata.R b/tests/testthat/test-consolidate_metadata.R index c6d9ab3c60..09c92ef0c1 100644 --- a/tests/testthat/test-consolidate_metadata.R +++ b/tests/testthat/test-consolidate_metadata.R @@ -1,4 +1,3 @@ - ## Test 1: consolidation works ---- test_that("consolidate_metadata Test 1: consolidation works", { glob <- tibble::tribble( diff --git a/tests/testthat/test-create_query_data.R b/tests/testthat/test-create_query_data.R index c2112afa90..42dd86bead 100644 --- a/tests/testthat/test-create_query_data.R +++ b/tests/testthat/test-create_query_data.R @@ -1,4 +1,3 @@ - get_smq <- function(basket_select, version, keep_id = FALSE, @@ -12,10 +11,10 @@ get_smq <- function(basket_select, if (is.null(basket_select$name)) { basket_select$name <- paste("SMQ name of", basket_select$id) } - terms <- tibble(TERM_NAME = paste(basket_select$name, "Term", c(1:end), "(", version, ")")) - terms <- mutate(terms, TERM_LEVEL = "AEDECOD", QUERY_NAME = basket_select$name) + terms <- tibble(TERMNAME = paste(basket_select$name, "Term", c(1:end), "(", version, ")")) + terms <- mutate(terms, SRCVAR = "AEDECOD", GRPNAME = basket_select$name) if (keep_id) { - mutate(terms, QUERY_ID = 42) + mutate(terms, GRPID = 42) } else { terms } @@ -25,21 +24,21 @@ get_sdg <- function(basket_select, version, keep_id = FALSE, temp_env) { - terms <- tibble(TERM_NAME = paste(basket_select$name, "Term", c(1:4))) - terms <- mutate(terms, TERM_LEVEL = "CMDECOD", QUERY_NAME = basket_select$name) + terms <- tibble(TERMNAME = paste(basket_select$name, "Term", c(1:4))) + terms <- mutate(terms, SRCVAR = "CMDECOD", GRPNAME = basket_select$name) if (keep_id) { - mutate(terms, QUERY_ID = 42) + mutate(terms, GRPID = 42) } else { terms } } cqterms <- tibble::tribble( - ~TERM_NAME, ~TERM_ID, + ~TERMNAME, ~TERMID, "APPLICATION SITE ERYTHEMA", 10003041L, "APPLICATION SITE PRURITUS", 10003053L ) %>% - mutate(TERM_LEVEL = "AEDECOD") + mutate(SRCVAR = "AEDECOD") # create_query_data ---- # customized query defined by terms ---- ## Test 1: customized query defined by terms ---- @@ -53,14 +52,14 @@ test_that("create_query_data Test 1: customized query defined by terms", { actual_output <- create_query_data(queries = list(cq)) expected_output <- cqterms %>% mutate( - QUERY_NAME = "Application Site Issues", - VAR_PREFIX = "CQ01" + GRPNAME = "Application Site Issues", + PREFIX = "CQ01" ) expect_dfs_equal( base = expected_output, compare = actual_output, - keys = c("VAR_PREFIX", "TERM_NAME") + keys = c("PREFIX", "TERMNAME") ) }) @@ -110,15 +109,15 @@ test_that("create_query_data Test 2: customized query defined by SMQs", { ) ) %>% mutate( - QUERY_NAME = "Immune-Mediated Meningoencephalitis", - VAR_PREFIX = "CQ02", + GRPNAME = "Immune-Mediated Meningoencephalitis", + PREFIX = "CQ02", VERSION = "20.0" ) expect_dfs_equal( base = expected_output, compare = actual_output, - keys = c("VAR_PREFIX", "TERM_NAME") + keys = c("PREFIX", "TERMNAME") ) }) @@ -169,15 +168,15 @@ test_that("create_query_data Test 3: customized query defined by terms and SMQs" ) ) %>% mutate( - QUERY_NAME = "Immune-Mediated Meningoencephalitis or Application Site Issues", - VAR_PREFIX = "CQ03", + GRPNAME = "Immune-Mediated Meningoencephalitis or Application Site Issues", + PREFIX = "CQ03", VERSION = "20.1" ) expect_dfs_equal( base = expected_output, compare = actual_output, - keys = c("VAR_PREFIX", "TERM_NAME") + keys = c("PREFIX", "TERMNAME") ) }) @@ -222,11 +221,11 @@ test_that("SMQs Test 4: SMQs", { version = "20.0" ) %>% mutate( - QUERY_NAME = "Pregnancy and neonatal topics (SMQ)", - QUERY_ID = 13, - QUERY_SCOPE = "NARROW", - QUERY_SCOPE_NUM = 2, - VAR_PREFIX = "SMQ02" + GRPNAME = "Pregnancy and neonatal topics (SMQ)", + GRPID = 13, + SCOPE = "NARROW", + SCOPEN = 2, + PREFIX = "SMQ02" ), get_smq( basket_select( @@ -237,8 +236,8 @@ test_that("SMQs Test 4: SMQs", { version = "20.0" ) %>% mutate( - QUERY_SCOPE = "BROAD", - VAR_PREFIX = "SMQ04" + SCOPE = "BROAD", + PREFIX = "SMQ04" ) ) %>% mutate( @@ -248,7 +247,7 @@ test_that("SMQs Test 4: SMQs", { expect_dfs_equal( base = expected_output, compare = actual_output, - keys = c("VAR_PREFIX", "TERM_NAME") + keys = c("PREFIX", "TERMNAME") ) }) @@ -302,16 +301,16 @@ test_that("SDGs Test 6: SDGs", { version = "2019_09" ) %>% mutate( - QUERY_ID = 42, - VAR_PREFIX = "SDG01", - QUERY_SCOPE = NA_character_, + GRPID = 42, + PREFIX = "SDG01", + SCOPE = NA_character_, VERSION = "2019_09" ) expect_dfs_equal( base = expected_output, compare = actual_output, - keys = c("VAR_PREFIX", "TERM_NAME") + keys = c("PREFIX", "TERMNAME") ) }) @@ -381,30 +380,30 @@ test_that("SDGs Test 10: query: error: invalid definition", { }) # assert_terms ---- -# 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", { +# assert_terms: error: SRCVAR missing ---- +## Test 11: assert_terms: error: SRCVAR missing ---- +test_that("assert_terms Test 11: assert_terms: error: SRCVAR missing", { expect_error( assert_terms( - terms = select(cqterms, -TERM_LEVEL), + terms = select(cqterms, -SRCVAR), source_text = "my test data" ), - regexp = "Required variable `TERM_LEVEL` is missing in my test data.", + regexp = "Required variable `SRCVAR` is missing in my test data.", fixed = TRUE ) }) -# 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", { +# assert_terms: error: TERMNAME and TERMID missing ---- +## Test 12: assert_terms: error: TERMNAME and TERMID missing ---- +test_that("assert_terms Test 12: assert_terms: error: TERMNAME and TERMID missing", { expect_error( assert_terms( - terms = select(cqterms, TERM_LEVEL), + terms = select(cqterms, SRCVAR), source_text = "my test data" ), regexp = paste0( - "Variable `TERM_NAME` or `TERM_ID` is required.\n", - "None of them is in my test data.\nProvided variables: `TERM_LEVEL`" + "Variable `TERMNAME` or `TERMID` is required.\n", + "None of them is in my test data.\nProvided variables: `SRCVAR`" ), fixed = TRUE ) @@ -428,7 +427,7 @@ test_that("assert_terms Test 13: assert_terms: error: no data frame", { test_that("assert_terms Test 14: assert_terms: error: no observations", { expect_error( assert_terms( - terms = filter(cqterms, TERM_ID == 42), + terms = filter(cqterms, TERMID == 42), source_text = "object returned by calling get_my_smq" ), regexp = "object returned by calling get_my_smq does not contain any observations.", @@ -436,30 +435,30 @@ test_that("assert_terms Test 14: assert_terms: error: no observations", { ) }) -# 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", { +# assert_terms: error: GRPNAME is missing ---- +## Test 15: assert_terms: error: GRPNAME is missing ---- +test_that("assert_terms Test 15: assert_terms: error: GRPNAME is missing", { expect_error( assert_terms( terms = cqterms, - expect_query_name = TRUE, + expect_grpname = TRUE, source_text = "object returned by calling get_my_smq" ), - regexp = "Required variable `QUERY_NAME` is missing in object returned by calling get_my_smq.", + regexp = "Required variable `GRPNAME` is missing in object returned by calling get_my_smq.", fixed = TRUE ) }) -# 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", { +# assert_terms: error: GRPID is missing ---- +## Test 16: assert_terms: error: GRPID is missing ---- +test_that("assert_terms Test 16: assert_terms: error: GRPID is missing", { expect_error( assert_terms( terms = cqterms, - expect_query_id = TRUE, + expect_grpid = TRUE, source_text = "object returned by calling get_my_smq" ), - regexp = "Required variable `QUERY_ID` is missing in object returned by calling get_my_smq.", + regexp = "Required variable `GRPID` is missing in object returned by calling get_my_smq.", fixed = TRUE ) }) diff --git a/tests/testthat/test-deprecation.R b/tests/testthat/test-deprecation.R deleted file mode 100644 index 5132bd0dfc..0000000000 --- a/tests/testthat/test-deprecation.R +++ /dev/null @@ -1,249 +0,0 @@ -adsl <- tibble::tribble( - ~USUBJID, ~SEX, ~COUNTRY, - "ST42-1", "F", "AUT", - "ST42-2", "M", "MWI", - "ST42-3", "M", "NOR", - "ST42-4", "F", "UGA" -) %>% mutate(STUDYID = "ST42") - -ex <- tibble::tribble( - ~USUBJID, ~EXSTDTC, - "ST42-1", "2020-12-07", - "ST42-1", "2020-12-14", - "ST42-2", "2021-01-12T12:00:00", - "ST42-2", "2021-01-26T13:21", - "ST42-3", "2021-03-02" -) %>% mutate(STUDYID = "ST42") - -input_worst_flag <- tibble::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, - "TEST01", "PAT01", "PARAM01", "WEEK 2", as.Date("2021-04-30"), 12.0, - "TEST01", "PAT02", "PARAM01", "WEEK 2", as.Date("2021-04-30"), 12.0, - "TEST01", "PAT01", "PARAM02", "SCREENING", as.Date("2021-04-27"), 15.0, - "TEST01", "PAT01", "PARAM02", "BASELINE", as.Date("2021-04-27"), 10.0, - "TEST01", "PAT02", "PARAM02", "BASELINE", as.Date("2021-04-30"), 12.0, - "TEST01", "PAT02", "PARAM03", "SCREENING", as.Date("2021-04-27"), 15.0, - "TEST01", "PAT02", "PARAM03", "WEEK 1", as.Date("2021-04-27"), 10.0, - "TEST01", "PAT02", "PARAM03", "BASELINE", as.Date("2021-04-30"), 12.0 -) - - -## Test 1: An error is issued if `derive_derived_param()` is called ---- -test_that("deprecation Test 1: An error is issued if `derive_derived_param()` - is called", { - input <- tibble::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", - "01-701-1015", "SYSBP", "Systolic Blood Pressure (mmHg)", 121, "mmHg", "BASELINE", - "01-701-1015", "SYSBP", "Systolic Blood Pressure (mmHg)", 121, "mmHg", "WEEK 2", - "01-701-1028", "DIABP", "Diastolic Blood Pressure (mmHg)", 79, "mmHg", "BASELINE", - "01-701-1028", "DIABP", "Diastolic Blood Pressure (mmHg)", 80, "mmHg", "WEEK 2", - "01-701-1028", "SYSBP", "Systolic Blood Pressure (mmHg)", 130, "mmHg", "BASELINE", - "01-701-1028", "SYSBP", "Systolic Blood Pressure (mmHg)", 132, "mmHg", "WEEK 2" - ) - - expect_error( - derive_derived_param( - input, - parameters = c("SYSBP", "DIABP"), - by_vars = exprs(USUBJID, VISIT), - analysis_value = (AVAL.SYSBP + 2 * AVAL.DIABP) / 3, - set_values_to = exprs( - PARAMCD = "MAP", - PARAM = "Mean arterial pressure (mmHg)", - AVALU = "mmHg" - ) - ), - class = "lifecycle_error_deprecated" - ) -}) - -## Test 2: derive_vars_merged_dt: a deprecation error is issued ---- -test_that("deprecation Test 2: derive_vars_merged_dt: a deprecation error - is issued", { - expect_error( - derive_vars_merged_dt( - adsl, - dataset_add = ex, - order = exprs(TRTSDT), - flag_imputation = "date", - by_vars = exprs(STUDYID, USUBJID), - dtc = EXSTDTC, - new_vars_prefix = "TRTS", - mode = "first" - ), - class = "lifecycle_error_deprecated" - ) -}) - -## Test 3: derive_vars_merged_dtm: a deprecation error is issued ---- -test_that("deprecation Test 3: derive_vars_merged_dtm: a deprecation error - is issued", { - expect_error( - derive_vars_merged_dtm( - adsl, - dataset_add = ex, - order = exprs(TRTSDTM), - by_vars = exprs(STUDYID, USUBJID), - dtc = EXSTDTC, - new_vars_prefix = "TRTS", - time_imputation = "first", - mode = "first" - ), - class = "lifecycle_error_deprecated" - ) -}) - - -## Test 4: An error is issued if `derive_var_agegr_ema()` is called ---- -test_that("deprecation Test 4: An error is issued if `derive_var_agegr_ema()` - is called", { - rlang::with_options(lifecycle_verbosity = "error", { - expect_error( - derive_var_agegr_ema(admiral.test::admiral_dm, age_var = AGE, new_var = AGEGR1), - class = "lifecycle_error_deprecated" - ) - }) -}) - -## Test 5: An error is issued if `derive_var_agegr_fda()` is called ---- -test_that("deprecation Test 5: An error is issued if `derive_var_agegr_fda()` - is called", { - rlang::with_options(lifecycle_verbosity = "error", { - expect_error( - derive_var_agegr_fda(admiral.test::admiral_dm, age_var = AGE, new_var = AGEGR1), - class = "lifecycle_error_deprecated" - ) - }) -}) - -## Test 6: An error is issued if `derive_param_first_event()` is called ---- -test_that("deprecation Test 6: An error is issued if `derive_param_first_event()` - is called", { - rlang::with_options(lifecycle_verbosity = "error", { - 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_error( - derive_param_first_event( - adrs, - dataset_adsl = adsl, - dataset_source = adrs, - filter_source = PARAMCD == "OVR" & AVALC == "PD", - date_var = ADT, - set_values_to = exprs( - PARAMCD = "PD", - ANL01FL = "Y" - ) - ), - class = "lifecycle_error_deprecated" - ) - }) -}) - -## Test 7: An warning is issued if `derive_var_worst_flag()` is called ---- -test_that("deprecation Test 7: A warning is issued if Derive worst flag is called", { - expect_warning( - derive_var_worst_flag( - input_worst_flag, - by_vars = exprs(USUBJID, PARAMCD, AVISIT), - order = exprs(desc(ADT)), - new_var = WORSTFL, - param_var = PARAMCD, - analysis_var = AVAL, - worst_high = c("PARAM01", "PARAM03"), - worst_low = "PARAM02" - ), - class = "lifecycle_warning_deprecated" - ) -}) - -## Test 8: A warning is issued if derive confirmation flag is called ---- -test_that("deprecation Test 8: A warning is issued if derive confirmation flag is called", { - data <- tibble::tribble( - ~USUBJID, ~AVISITN, ~AVALC, - "1", 1, "PR", - "1", 2, "CR", - "1", 3, "CR", - "1", 4, "SD", - "1", 5, "NE", - "2", 1, "SD", - "2", 2, "PR", - "2", 3, "PD", - "3", 1, "SD", - "4", 1, "PR", - "4", 2, "PD", - "4", 3, "SD", - "4", 4, "SD", - "4", 5, "PR" - ) - expect_error( - derive_var_confirmation_flag( - data, - new_var = CONFFL, - by_vars = exprs(USUBJID), - join_vars = exprs(AVALC), - join_type = "after", - order = exprs(AVISITN), - filter = AVALC == "PR" & AVALC.join %in% c("CR", "PR") - ), - class = "lifecycle_error_deprecated" - ) -}) - - -## Test 9: A warning is issued if filter_joined is called ---- -test_that("deprecation Test 9: A warning is issued if filter_confirmation is called", { - data <- tibble::tribble( - ~USUBJID, ~AVISITN, ~AVALC, - "1", 1, "PR", - "1", 2, "CR", - "1", 3, "CR", - "1", 4, "SD", - "1", 5, "NE", - "2", 1, "SD", - "2", 2, "PR", - "2", 3, "PD", - "3", 1, "SD", - "4", 1, "PR", - "4", 2, "PD", - "4", 3, "SD", - "4", 4, "SD", - "4", 5, "PR" - ) - expect_error( - filter_confirmation( - data, - by_vars = exprs(USUBJID), - join_vars = exprs(AVISITN, AVALC), - join_type = "after", - order = exprs(AVISITN), - filter = AVALC == "PR" & AVALC.join %in% c("CR", "PR") & - AVISITN < AVISITN.join - ), - class = "lifecycle_error_deprecated" - ) -}) diff --git a/tests/testthat/test-derive_basetype_records.R b/tests/testthat/test-derive_basetype_records.R new file mode 100644 index 0000000000..012c092371 --- /dev/null +++ b/tests/testthat/test-derive_basetype_records.R @@ -0,0 +1,112 @@ +# derive_basetype_records ---- +## Test 1: records are duplicated across different `BASETYPE` values ---- +test_that("derive_basetype_records Test 1: records are duplicated across different `BASETYPE` values", { # nolint + input <- tibble::tribble( + ~USUBJID, ~EPOCH, ~PARAMCD, ~ASEQ, ~AVAL, + "P01", "RUN-IN", "PARAM01", 1, 10.0, + "P01", "RUN-IN", "PARAM01", 2, 9.8, + "P01", "DOUBLE-BLIND", "PARAM01", 3, 9.2, + "P01", "DOUBLE-BLIND", "PARAM01", 4, 10.1, + "P01", "OPEN-LABEL", "PARAM01", 5, 10.4, + "P01", "OPEN-LABEL", "PARAM01", 6, 9.9, + "P02", "RUN-IN", "PARAM01", 1, 12.1, + "P02", "DOUBLE-BLIND", "PARAM01", 2, 10.2, + "P02", "DOUBLE-BLIND", "PARAM01", 3, 10.8, + "P02", "OPEN-LABEL", "PARAM01", 4, 11.4, + "P02", "OPEN-LABEL", "PARAM01", 5, 10.8 + ) + expect_output <- tibble::tribble( + ~USUBJID, ~EPOCH, ~PARAMCD, ~ASEQ, ~AVAL, ~BASETYPE, + "P01", "RUN-IN", "PARAM01", 1, 10.0, "RUN-IN", + "P01", "RUN-IN", "PARAM01", 2, 9.8, "RUN-IN", + "P01", "DOUBLE-BLIND", "PARAM01", 3, 9.2, "RUN-IN", + "P01", "DOUBLE-BLIND", "PARAM01", 4, 10.1, "RUN-IN", + "P01", "OPEN-LABEL", "PARAM01", 5, 10.4, "RUN-IN", + "P01", "OPEN-LABEL", "PARAM01", 6, 9.9, "RUN-IN", + "P01", "DOUBLE-BLIND", "PARAM01", 3, 9.2, "DOUBLE-BLIND", + "P01", "DOUBLE-BLIND", "PARAM01", 4, 10.1, "DOUBLE-BLIND", + "P01", "OPEN-LABEL", "PARAM01", 5, 10.4, "DOUBLE-BLIND", + "P01", "OPEN-LABEL", "PARAM01", 6, 9.9, "DOUBLE-BLIND", + "P01", "OPEN-LABEL", "PARAM01", 5, 10.4, "OPEN-LABEL", + "P01", "OPEN-LABEL", "PARAM01", 6, 9.9, "OPEN-LABEL", + "P02", "RUN-IN", "PARAM01", 1, 12.1, "RUN-IN", + "P02", "DOUBLE-BLIND", "PARAM01", 2, 10.2, "RUN-IN", + "P02", "DOUBLE-BLIND", "PARAM01", 3, 10.8, "RUN-IN", + "P02", "OPEN-LABEL", "PARAM01", 4, 11.4, "RUN-IN", + "P02", "OPEN-LABEL", "PARAM01", 5, 10.8, "RUN-IN", + "P02", "DOUBLE-BLIND", "PARAM01", 2, 10.2, "DOUBLE-BLIND", + "P02", "DOUBLE-BLIND", "PARAM01", 3, 10.8, "DOUBLE-BLIND", + "P02", "OPEN-LABEL", "PARAM01", 4, 11.4, "DOUBLE-BLIND", + "P02", "OPEN-LABEL", "PARAM01", 5, 10.8, "DOUBLE-BLIND", + "P02", "OPEN-LABEL", "PARAM01", 4, 11.4, "OPEN-LABEL", + "P02", "OPEN-LABEL", "PARAM01", 5, 10.8, "OPEN-LABEL", + ) + actual_output <- derive_basetype_records( + dataset = input, + basetypes = rlang::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" + ) + ) + + expect_dfs_equal(actual_output, expect_output, keys = c("USUBJID", "BASETYPE", "PARAMCD", "ASEQ")) +}) + +## Test 2: records that do not match any condition are kept ---- +test_that("derive_basetype_records Test 2: records that do not match any condition are kept", { + input <- tibble::tribble( + ~USUBJID, ~EPOCH, ~PARAMCD, ~ASEQ, ~AVAL, + "P01", "SCREENING", "PARAM01", 1, 10.2, + "P01", "RUN-IN", "PARAM01", 2, 10.0, + "P01", "RUN-IN", "PARAM01", 3, 9.8, + "P01", "DOUBLE-BLIND", "PARAM01", 4, 9.2, + "P01", "DOUBLE-BLIND", "PARAM01", 5, 10.1, + "P01", "OPEN-LABEL", "PARAM01", 6, 10.4, + "P01", "OPEN-LABEL", "PARAM01", 7, 9.9, + "P02", "SCREENING", "PARAM01", 1, 12.2, + "P02", "RUN-IN", "PARAM01", 2, 12.1, + "P02", "DOUBLE-BLIND", "PARAM01", 3, 10.2, + "P02", "DOUBLE-BLIND", "PARAM01", 4, 10.8, + "P02", "OPEN-LABEL", "PARAM01", 5, 11.4, + "P02", "OPEN-LABEL", "PARAM01", 6, 10.8 + ) + expect_output <- tibble::tribble( + ~USUBJID, ~EPOCH, ~PARAMCD, ~ASEQ, ~AVAL, ~BASETYPE, + "P01", "SCREENING", "PARAM01", 1, 10.2, NA, + "P01", "RUN-IN", "PARAM01", 2, 10.0, "RUN-IN", + "P01", "RUN-IN", "PARAM01", 3, 9.8, "RUN-IN", + "P01", "DOUBLE-BLIND", "PARAM01", 4, 9.2, "RUN-IN", + "P01", "DOUBLE-BLIND", "PARAM01", 5, 10.1, "RUN-IN", + "P01", "OPEN-LABEL", "PARAM01", 6, 10.4, "RUN-IN", + "P01", "OPEN-LABEL", "PARAM01", 7, 9.9, "RUN-IN", + "P01", "DOUBLE-BLIND", "PARAM01", 4, 9.2, "DOUBLE-BLIND", + "P01", "DOUBLE-BLIND", "PARAM01", 5, 10.1, "DOUBLE-BLIND", + "P01", "OPEN-LABEL", "PARAM01", 6, 10.4, "DOUBLE-BLIND", + "P01", "OPEN-LABEL", "PARAM01", 7, 9.9, "DOUBLE-BLIND", + "P01", "OPEN-LABEL", "PARAM01", 6, 10.4, "OPEN-LABEL", + "P01", "OPEN-LABEL", "PARAM01", 7, 9.9, "OPEN-LABEL", + "P02", "SCREENING", "PARAM01", 1, 12.2, NA, + "P02", "RUN-IN", "PARAM01", 2, 12.1, "RUN-IN", + "P02", "DOUBLE-BLIND", "PARAM01", 3, 10.2, "RUN-IN", + "P02", "DOUBLE-BLIND", "PARAM01", 4, 10.8, "RUN-IN", + "P02", "OPEN-LABEL", "PARAM01", 5, 11.4, "RUN-IN", + "P02", "OPEN-LABEL", "PARAM01", 6, 10.8, "RUN-IN", + "P02", "DOUBLE-BLIND", "PARAM01", 3, 10.2, "DOUBLE-BLIND", + "P02", "DOUBLE-BLIND", "PARAM01", 4, 10.8, "DOUBLE-BLIND", + "P02", "OPEN-LABEL", "PARAM01", 5, 11.4, "DOUBLE-BLIND", + "P02", "OPEN-LABEL", "PARAM01", 6, 10.8, "DOUBLE-BLIND", + "P02", "OPEN-LABEL", "PARAM01", 5, 11.4, "OPEN-LABEL", + "P02", "OPEN-LABEL", "PARAM01", 6, 10.8, "OPEN-LABEL", + ) + actual_output <- derive_basetype_records( + dataset = input, + basetypes = rlang::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" + ) + ) + + expect_dfs_equal(actual_output, expect_output, keys = c("USUBJID", "BASETYPE", "PARAMCD", "ASEQ")) +}) diff --git a/tests/testthat/test-derive_date_vars.R b/tests/testthat/test-derive_date_vars.R index c528060149..30946a5ad6 100644 --- a/tests/testthat/test-derive_date_vars.R +++ b/tests/testthat/test-derive_date_vars.R @@ -889,6 +889,34 @@ test_that("derive_vars_dt Test 42: Supplying both min/max dates for highest_impu expect_dfs_equal(actual, expected, keys = c("ASTDT", "ASTDTF")) }) +## Test 43: Supplying both min/max dates for highest_imputation = Y works ---- +test_that("derive_vars_dt Test 43: Supplying both min/max dates for highest_imputation = Y works", { # nolint + actual <- data.frame( + AESTDTC = c(NA_character_, NA_character_), + TRTSDT = c(ymd("2022-01-01"), NA), + TRTEDT = c(ymd("2022-01-31"), NA) + ) %>% + mutate(AESTDTC = as.character(AESTDTC)) %>% + derive_vars_dt( + dtc = AESTDTC, + new_vars_prefix = "AST", + highest_imputation = "Y", + date_imputation = "last", + min_dates = exprs(TRTSDT), + max_dates = exprs(TRTEDT) + ) + + expected <- data.frame( + AESTDTC = c(NA_character_, NA_character_), + TRTSDT = c(ymd("2022-01-01"), NA), + TRTEDT = c(ymd("2022-01-31"), NA), + ASTDT = c(ymd("2022-01-31"), NA), + ASTDTF = c("Y", NA) + ) + + expect_dfs_equal(actual, expected, keys = c("ASTDT", "ASTDTF")) +}) + # derive_vars_dtm ---- input <- tibble::tribble( @@ -902,8 +930,8 @@ input <- tibble::tribble( "2019---07" ) -## Test 43: default behavior ---- -test_that("derive_vars_dtm Test 43: default behavior", { +## Test 44: default behavior ---- +test_that("derive_vars_dtm Test 44: default behavior", { expected_output <- tibble::tribble( ~XXSTDTC, ~ASTDTM, ~ASTTMF, "2019-07-18T15:25:40", ymd_hms("2019-07-18T15:25:40"), NA_character_, @@ -928,8 +956,8 @@ test_that("derive_vars_dtm Test 43: default behavior", { ) }) -## Test 44: date imputed to first, auto DTF/TMF ---- -test_that("derive_vars_dtm Test 44: date imputed to first, auto DTF/TMF", { +## Test 45: date imputed to first, auto DTF/TMF ---- +test_that("derive_vars_dtm Test 45: date imputed to first, auto DTF/TMF", { expected_output <- tibble::tribble( ~XXSTDTC, ~ASTDTM, ~ASTDTF, ~ASTTMF, "2019-07-18T15:25:40", ymd_hms("2019-07-18T15:25:40"), NA_character_, NA_character_, @@ -956,8 +984,8 @@ test_that("derive_vars_dtm Test 44: date imputed to first, auto DTF/TMF", { ) }) -## Test 45: date and time imputed to last, no DTF/TMF ---- -test_that("derive_vars_dtm Test 45: date and time imputed to last, no DTF/TMF", { +## Test 46: date and time imputed to last, no DTF/TMF ---- +test_that("derive_vars_dtm Test 46: date and time imputed to last, no DTF/TMF", { expected_output <- tibble::tribble( ~XXSTDTC, ~AENDTM, "2019-07-18T15:25:40", ymd_hms("2019-07-18T15:25:40"), @@ -986,8 +1014,8 @@ test_that("derive_vars_dtm Test 45: date and time imputed to last, no DTF/TMF", ) }) -## Test 46: date and time imputed to last, DTF only ---- -test_that("derive_vars_dtm Test 46: date and time imputed to last, DTF only", { +## Test 47: date and time imputed to last, DTF only ---- +test_that("derive_vars_dtm Test 47: date and time imputed to last, DTF only", { expected_output <- tibble::tribble( ~XXSTDTC, ~AENDTM, ~AENDTF, "2019-07-18T15:25:40", ymd_hms("2019-07-18T15:25:40"), NA_character_, @@ -1016,8 +1044,8 @@ test_that("derive_vars_dtm Test 46: date and time imputed to last, DTF only", { ) }) -## Test 47: date imputed to MID, time to first, TMF only ---- -test_that("derive_vars_dtm Test 47: date imputed to MID, time to first, TMF only", { +## Test 48: date imputed to MID, time to first, TMF only ---- +test_that("derive_vars_dtm Test 48: date imputed to MID, time to first, TMF only", { expected_output <- tibble::tribble( ~XXSTDTC, ~ASTDTM, ~ASTTMF, "2019-07-18T15:25:40", ymd_hms("2019-07-18T15:25:40"), NA_character_, @@ -1046,8 +1074,8 @@ test_that("derive_vars_dtm Test 47: date imputed to MID, time to first, TMF only ) }) -## Test 48: No re-derivation is done if --DTF variable already exists ---- -test_that("derive_vars_dtm Test 48: No re-derivation is done if --DTF variable already exists", { +## Test 49: No re-derivation is done if --DTF variable already exists ---- +test_that("derive_vars_dtm Test 49: No re-derivation is done if --DTF variable already exists", { expected_output <- tibble::tribble( ~XXSTDTC, ~ASTDTM, ~ASTDTF, ~ASTTMF, "2019-07-18T15:25:40", ymd_hms("2019-07-18T15:25:40"), NA_character_, NA_character_, @@ -1078,8 +1106,8 @@ test_that("derive_vars_dtm Test 48: No re-derivation is done if --DTF variable a ) }) -## Test 49: max_dates parameter works as expected ---- -test_that("derive_vars_dtm Test 49: max_dates parameter works as expected", { +## Test 50: max_dates parameter works as expected ---- +test_that("derive_vars_dtm Test 50: max_dates parameter works as expected", { expected_output <- tibble::tribble( ~XXSTDTC, ~ASTDTM, ~ASTDTF, ~ASTTMF, "2019-02", ymd_hms("2019-02-10T00:00:00"), "D", "H", @@ -1115,8 +1143,8 @@ input_secs <- tibble::tribble( "2019---07" ) -## Test 50: NA imputation for highest_imputation = Y & max_dates ---- -test_that("derive_vars_dtm Test 50: NA imputation for highest_imputation = Y & max_dates", { +## Test 51: NA imputation for highest_imputation = Y & max_dates ---- +test_that("derive_vars_dtm Test 51: NA imputation for highest_imputation = Y & max_dates", { actual <- data.frame( AESTDTC = c(NA_character_, NA_character_), TRTSDTM = c(ymd_hms("2022-01-01 23:59:59"), NA) @@ -1143,8 +1171,8 @@ test_that("derive_vars_dtm Test 50: NA imputation for highest_imputation = Y & m expect_dfs_equal(actual, expected, keys = c("ASTDTM", "ASTDTF", "ASTTMF")) }) -## Test 51: NA imputation for highest_imputation = Y & max_dates but date_imputation = first ---- -test_that("derive_vars_dtm Test 51: NA imputation for highest_imputation = Y & max_dates but date_imputation = first", { # nolint +## Test 52: NA imputation for highest_imputation = Y & max_dates but date_imputation = first ---- +test_that("derive_vars_dtm Test 52: NA imputation for highest_imputation = Y & max_dates but date_imputation = first", { # nolint expect_warning( (data.frame( AESTDTC = c(NA_character_, NA_character_), @@ -1164,8 +1192,8 @@ test_that("derive_vars_dtm Test 51: NA imputation for highest_imputation = Y & m ) }) -## Test 52: NA imputation for highest_imputation = Y & min_dates ---- -test_that("derive_vars_dtm Test 52: NA imputation for highest_imputation = Y & min_dates", { +## Test 53: NA imputation for highest_imputation = Y & min_dates ---- +test_that("derive_vars_dtm Test 53: NA imputation for highest_imputation = Y & min_dates", { actual <- data.frame( AESTDTC = c(NA_character_, NA_character_), TRTSDTM = c(ymd_hms("2022-01-01 23:59:59"), NA) @@ -1192,8 +1220,8 @@ test_that("derive_vars_dtm Test 52: NA imputation for highest_imputation = Y & m expect_dfs_equal(actual, expected, keys = c("ASTDTM", "ASTDTF", "ASTTMF")) }) -## Test 53: NA imputation for highest_imputation = Y & min_dates but date_imputation = last ---- -test_that("derive_vars_dtm Test 53: NA imputation for highest_imputation = Y & min_dates but date_imputation = last", { # nolint +## Test 54: NA imputation for highest_imputation = Y & min_dates but date_imputation = last ---- +test_that("derive_vars_dtm Test 54: NA imputation for highest_imputation = Y & min_dates but date_imputation = last", { # nolint expect_warning( (data.frame( AESTDTC = c(NA_character_, NA_character_), @@ -1213,8 +1241,8 @@ test_that("derive_vars_dtm Test 53: NA imputation for highest_imputation = Y & m ) }) -## Test 54: NA imputation for highest_imputation = Y but null min/max dates fails ---- -test_that("derive_vars_dtm Test 54: NA imputation for highest_imputation = Y but null min/max dates fails", { # nolint +## Test 55: NA imputation for highest_imputation = Y but null min/max dates fails ---- +test_that("derive_vars_dtm Test 55: NA imputation for highest_imputation = Y but null min/max dates fails", { # nolint expect_error( (data.frame( AESTDTC = c(NA_character_, NA_character_), @@ -1233,8 +1261,8 @@ test_that("derive_vars_dtm Test 54: NA imputation for highest_imputation = Y but ) }) -## Test 55: Supplying both min/max dates for highest_imputation = Y works ---- -test_that("derive_vars_dtm Test 55: Supplying both min/max dates for highest_imputation = Y works", { # nolint +## Test 56: Supplying both min/max dates for highest_imputation = Y works ---- +test_that("derive_vars_dtm Test 56: Supplying both min/max dates for highest_imputation = Y works", { # nolint actual <- data.frame( AESTDTC = c(NA_character_, NA_character_), TRTSDTM = c(ymd_hms("2022-01-01 23:59:59"), NA), @@ -1245,7 +1273,8 @@ test_that("derive_vars_dtm Test 55: Supplying both min/max dates for highest_imp dtc = AESTDTC, new_vars_prefix = "AST", highest_imputation = "Y", - time_imputation = "last", + date_imputation = "first", + time_imputation = "first", min_dates = exprs(TRTSDTM), max_dates = exprs(TRTEDTM) ) @@ -1261,3 +1290,33 @@ test_that("derive_vars_dtm Test 55: Supplying both min/max dates for highest_imp expect_dfs_equal(actual, expected, keys = c("ASTDTM", "ASTDTF", "ASTTMF")) }) + +## Test 57: Supplying both min/max dates for highest_imputation = Y works ---- +test_that("derive_vars_dtm Test 57: Supplying both min/max dates for highest_imputation = Y works", { # nolint + actual <- data.frame( + AESTDTC = c(NA_character_, NA_character_), + TRTSDTM = c(ymd_hms("2022-01-01 23:59:59"), NA), + TRTEDTM = c(ymd_hms("2022-01-31 23:59:59"), NA) + ) %>% + mutate(AESTDTC = as.character(AESTDTC)) %>% + derive_vars_dtm( + dtc = AESTDTC, + new_vars_prefix = "AEN", + highest_imputation = "Y", + date_imputation = "last", + time_imputation = "last", + min_dates = exprs(TRTSDTM), + max_dates = exprs(TRTEDTM) + ) + + expected <- data.frame( + AESTDTC = c(NA_character_, NA_character_), + TRTSDTM = c(ymd_hms("2022-01-01 23:59:59"), NA), + TRTEDTM = c(ymd_hms("2022-01-31 23:59:59"), NA), + AENDTM = c(ymd_hms("2022-01-31 23:59:59"), NA), + AENDTF = c("Y", NA), + AENTMF = c("H", NA) + ) + + expect_dfs_equal(actual, expected, keys = c("AENDTM", "AENDTF", "AENTMF")) +}) diff --git a/tests/testthat/test-derive_extreme_event.R b/tests/testthat/test-derive_extreme_event.R index 01091cfca1..8905d88e17 100644 --- a/tests/testthat/test-derive_extreme_event.R +++ b/tests/testthat/test-derive_extreme_event.R @@ -1,25 +1,25 @@ # derive_extreme_records ---- -## Test 1: add the worst event for each group ---- -test_that("derive_extreme_records Test 1: add the worst event for each group", { +## Test 1: `mode` = first ---- +test_that("derive_extreme_records Test 1: `mode` = first", { input <- tibble::tribble( - ~USUBJID, ~PARAMCD, ~AVALC, - "1", "NO SLEEP", "N", - "1", "WAKE UP", "N", - "1", "FALL ASLEEP", "N", - "2", "NO SLEEP", "N", - "2", "WAKE UP", "Y", - "2", "FALL ASLEEP", "N", - "3", "NO SLEEP", NA_character_, - "3", "WAKE UP", "N" + ~USUBJID, ~PARAMCD, ~AVALC, ~ADY, + "1", "NO SLEEP", "N", 1, + "1", "WAKE UP", "N", 2, + "1", "FALL ASLEEP", "N", 3, + "2", "NO SLEEP", "N", 1, + "2", "WAKE UP", "Y", 2, + "2", "WAKE UP", "Y", 3, + "2", "FALL ASLEEP", "N", 4, + "3", "NO SLEEP", NA_character_, 1 ) expected_output <- bind_rows( input, tibble::tribble( - ~USUBJID, ~PARAMCD, ~AVALC, ~AVAL, - "1", "WSP", "No sleeping problems", 4, - "2", "WSP", "Waking up more than three times", 2, - "3", "WSP", "Missing", 99 + ~USUBJID, ~PARAMCD, ~AVALC, ~AVAL, ~ADY, + "1", "WSP", "No sleeping problems", 4, 1, + "2", "WSP", "Waking up more than three times", 2, 2, + "3", "WSP", "Missing", 99, 1 ) ) @@ -50,7 +50,7 @@ test_that("derive_extreme_records Test 1: add the worst event for each group", { set_values_to = exprs(AVALC = "Missing", AVAL = 99) ) ), - order = exprs(AVAL), + order = exprs(ADY), mode = "first", set_values_to = exprs( PARAMCD = "WSP" @@ -61,6 +61,72 @@ test_that("derive_extreme_records Test 1: add the worst event for each group", { expect_dfs_equal( base = expected_output, compare = actual_output, - keys = c("USUBJID", "PARAMCD") + keys = c("USUBJID", "PARAMCD", "ADY") + ) +}) + +## Test 2: `mode` = last ---- +test_that("derive_extreme_records Test 2: `mode` = last", { + input <- tibble::tribble( + ~USUBJID, ~PARAMCD, ~AVALC, ~ADY, + "1", "NO SLEEP", "N", 1, + "1", "WAKE UP", "N", 2, + "1", "FALL ASLEEP", "N", 3, + "2", "NO SLEEP", "N", 1, + "2", "WAKE UP", "Y", 2, + "2", "WAKE UP", "Y", 3, + "2", "FALL ASLEEP", "N", 4, + "3", "NO SLEEP", NA_character_, 1 + ) + + expected_output <- bind_rows( + input, + tibble::tribble( + ~USUBJID, ~PARAMCD, ~AVALC, ~AVAL, ~ADY, + "1", "WSP", "No sleeping problems", 4, 3, + "2", "WSP", "Waking up more than three times", 2, 3, + "3", "WSP", "Missing", 99, 1 + ) + ) + + actual_output <- derive_extreme_event( + input, + by_vars = exprs(USUBJID), + events = list( + event( + condition = PARAMCD == "NO SLEEP" & AVALC == "Y", + set_values_to = exprs(AVALC = "No sleep", AVAL = 1) + ), + event( + condition = PARAMCD == "WAKE UP" & AVALC == "Y", + set_values_to = exprs(AVALC = "Waking up more than three times", AVAL = 2) + ), + event( + condition = PARAMCD == "FALL ASLEEP" & AVALC == "Y", + set_values_to = exprs(AVALC = "More than 30 mins to fall asleep", AVAL = 3) + ), + event( + condition = all(AVALC == "N"), + set_values_to = exprs( + AVALC = "No sleeping problems", AVAL = 4 + ) + ), + event( + condition = TRUE, + set_values_to = exprs(AVALC = "Missing", AVAL = 99) + ) + ), + order = exprs(ADY), + mode = "last", + set_values_to = exprs( + PARAMCD = "WSP" + ), + check_type = "none" + ) + + expect_dfs_equal( + base = expected_output, + compare = actual_output, + keys = c("USUBJID", "PARAMCD", "ADY") ) }) diff --git a/tests/testthat/test-derive_extreme_records.R b/tests/testthat/test-derive_extreme_records.R index 48e37d15b1..3e1dea4c83 100644 --- a/tests/testthat/test-derive_extreme_records.R +++ b/tests/testthat/test-derive_extreme_records.R @@ -1,22 +1,22 @@ # derive_extreme_records ---- -## derive_extreme_records Test 1: add last observation for each group ---- +## Test 1: add last observation for each group ---- test_that("derive_extreme_records Test 1: add last observation for each group", { input <- tibble::tribble( ~USUBJID, ~AVISITN, ~AVAL, ~LBSEQ, - 1, 1, 12, 1, - 1, 3, 9, 2, - 2, 2, 42, 1, - 3, 3, 14, 1, - 3, 3, 10, 2 + "1", 1, 12, 1, + "1", 3, 9, 2, + "2", 2, 42, 1, + "3", 3, 14, 1, + "3", 3, 10, 2 ) expected_output <- bind_rows( input, tibble::tribble( ~USUBJID, ~AVISITN, ~AVAL, ~LBSEQ, - 1, 3, 9, 2, - 2, 2, 42, 1, - 3, 3, 10, 2 + "1", 3, 9, 2, + "2", 2, 42, 1, + "3", 3, 10, 2 ) %>% mutate(DTYPE = "LOV") ) @@ -35,3 +35,344 @@ test_that("derive_extreme_records Test 1: add last observation for each group", keys = c("USUBJID", "AVISITN", "LBSEQ", "DTYPE") ) }) + +## Test 2: derive first PD date ---- +test_that("derive_extreme_records Test 2: derive first PD date", { + adsl <- tibble::tribble( + ~USUBJID, + "1", + "2", + "3" + ) %>% + 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) + + actual <- derive_extreme_records( + adrs, + dataset_ref = adsl, + dataset_add = adrs, + by_vars = exprs(USUBJID), + filter_add = PARAMCD == "OVR" & AVALC == "PD", + exist_flag = AVALC, + order = exprs(ADT), + mode = "first", + set_values_to = exprs( + 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 3: derive death date parameter ---- +test_that("derive_extreme_records Test 3: derive death date parameter", { + adsl <- tibble::tribble( + ~USUBJID, ~DTHDT, + "1", ymd("2022-05-13"), + "2", ymd(""), + "3", ymd("") + ) %>% + mutate(STUDYID = "XX1234") + + actual <- derive_extreme_records( + dataset_ref = adsl, + dataset_add = adsl, + by_vars = exprs(STUDYID, USUBJID), + filter_add = !is.na(DTHDT), + exist_flag = AVAL, + true_value = 1, + false_value = 0, + mode = "first", + set_values_to = exprs( + 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") + ) +}) + +## Test 4: latest evaluable tumor assessment date parameter ---- +test_that("derive_extreme_records Test 4: latest evaluable tumor assessment date parameter", { + adsl <- tibble::tribble( + ~USUBJID, + "1", + "2", + "3" + ) %>% + 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", "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) + + actual <- derive_extreme_records( + dataset = adrs, + dataset_ref = adsl, + dataset_add = adrs, + by_vars = exprs(STUDYID, USUBJID), + filter_add = PARAMCD == "OVR" & AVALC != "NE", + order = exprs(ADT), + exist_flag = AVALC, + true_value = "Y", + false_value = "N", + mode = "last", + set_values_to = exprs( + 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") + ) +}) + +## Test 5: latest evaluable tumor assessment date parameter without overwriting existing result ---- +test_that("derive_extreme_records Test 5: latest evaluable tumor assessment date parameter without overwriting existing result", { # nolint + adsl <- tibble::tribble( + ~USUBJID, + "1", + "2", + "3" + ) %>% + 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", "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) + + actual <- derive_extreme_records( + dataset = adrs, + dataset_ref = adsl, + dataset_add = adrs, + by_vars = exprs(STUDYID, USUBJID), + filter_add = PARAMCD == "OVR" & AVALC != "NE", + order = exprs(ADT), + mode = "last", + set_values_to = exprs( + PARAMCD = "LSTEVLDT", + ANL01FL = "Y", + ADT = ADT + ) + ) + + expected <- bind_rows( + adrs, + tibble::tribble( + ~USUBJID, ~ADT, ~AVALC, + "1", ymd("2020-04-01"), "SD", + "2", ymd("2021-07-16"), "SD", + "3", ymd(""), NA + ) %>% + mutate( + STUDYID = "XX1234", + PARAMCD = "LSTEVLDT", + ANL01FL = "Y" + ) + ) + + expect_dfs_equal( + base = expected, + comp = actual, + keys = c("USUBJID", "PARAMCD", "ADT") + ) +}) + +## Test 6: warning if filter argument is used ---- +test_that("derive_extreme_records Test 6: warning if filter argument is used", { + adsl <- tibble::tribble( + ~USUBJID, + "1", + "2", + "3" + ) %>% + 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", "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", + ) %>% + mutate( + STUDYID = "XX1234", + ADT = ymd(ADTC) + ) %>% + select(-ADTC) + + actual <- derive_extreme_records( + adrs, + dataset_ref = adsl, + dataset_add = adrs, + by_vars = exprs(USUBJID), + filter_add = PARAMCD == "OVR" & AVALC == "PD", + exist_flag = AVALC, + order = exprs(ADT), + mode = "first", + set_values_to = exprs( + PARAMCD = "PD", + ANL01FL = "Y", + ADT = ADT + ) + ) + + expect_warning( + derive_extreme_records( + adrs, + dataset_ref = adsl, + dataset_add = adrs, + by_vars = exprs(USUBJID), + filter = PARAMCD == "OVR" & AVALC == "PD", + exist_flag = AVALC, + order = exprs(ADT), + mode = "first", + set_values_to = exprs( + PARAMCD = "PD", + ANL01FL = "Y", + ADT = ADT + ) + ), + class = "lifecycle_warning_deprecated" + ) +}) + +## Test 7: error if no input data ---- +test_that("derive_extreme_records Test 7: error if no input data", { + expect_error( + derive_extreme_records( + set_values_to = exprs(PARAMCD = "HELLO") + ), + regexp = paste( + "Neither `dataset` nor `dataset_add` is specified.", + "At least one of them must be specified.", + sep = "\n" + ), + fixed = TRUE + ) +}) diff --git a/tests/testthat/test-derive_joined.R b/tests/testthat/test-derive_joined.R index a0a41724a9..8574f3b564 100644 --- a/tests/testthat/test-derive_joined.R +++ b/tests/testthat/test-derive_joined.R @@ -98,8 +98,85 @@ test_that("derive_vars_joined Test 3: by_vars with rename", { ) }) -## Test 4: no join_vars, no filter_join ---- -test_that("derive_vars_joined Test 4: no join_vars, no filter_join", { +## Test 4: order with expression ---- +test_that("derive_vars_joined Test 4: order with expression", { + adae <- tibble::tribble( + ~AEGRPID, + "1", + "2" + ) %>% + mutate( + TRTSDTM = ymd_hms("2020-01-06T12:00:00") + ) + + faae <- tibble::tribble( + ~FAGRPID, ~FADTC, ~FAORRES, + "1", "2020-01-01", "1", + "1", "2020-01-03", "2", + "1", "2020-01-05", "3", + "1", "2020-01-08", "4" + ) + expect_dfs_equal( + base = mutate(adae, ATOXGR_pre = c("3", NA)), + comp = derive_vars_joined( + adae, + dataset_add = faae, + by_vars = exprs(AEGRPID = FAGRPID), + order = exprs(FADT = convert_dtc_to_dt(FADTC)), + new_vars = exprs(ATOXGR_pre = FAORRES), + join_vars = exprs(FADT), + filter_join = FADT < TRTSDTM, + mode = "last" + ), + keys = c("AEGRPID") + ) +}) + +## Test 5: join_vars with expression ---- +test_that("derive_vars_joined Test 5: join_vars with expression", { + add <- tibble::tribble( + ~USUBJID, ~TRDTC, ~TRSTRESN, + "1", "2020-02-01", 10, + "1", "2020-02-04", 12, + "1", "2020-02-08", 11, + "1", "2020-02-13", 9, + "1", "2020-02-24", 14, + "1", "2020-03-01", 12, + "2", "2021-01-13", 8 + ) + + expected <- tibble::tribble( + ~USUBJID, ~ADT, ~AVAL, + "1", "2020-02-09", 10, + "1", "2020-02-13", 9, + "1", "2020-02-24", 9, + "1", "2020-03-01", 9, + "2", "2021-01-13", 8 + ) %>% + mutate( + ADT = ymd(ADT) + ) + + expect_dfs_equal( + base = expected, + comp = derive_vars_joined( + select(expected, -AVAL), + dataset_add = add, + by_vars = exprs(USUBJID), + order = exprs(TRSTRESN), + new_vars = exprs(AVAL = TRSTRESN), + join_vars = exprs(TRDT = convert_dtc_to_dt(TRDTC)), + filter_join = TRDT <= ADT, + mode = "first", + check_type = "none" + ), + keys = c("USUBJID", "ADT") + ) +}) + + +## Test 6: no join_vars, no filter_join ---- +test_that("derive_vars_joined Test 6: no join_vars, no filter_join", { adae <- tibble::tribble( ~AEGRPID, "1", @@ -130,3 +207,38 @@ test_that("derive_vars_joined Test 4: no join_vars, no filter_join", { keys = c("AEGRPID") ) }) + +## Test 7: new_vars expressions using variables from both datasets ---- +test_that("derive_vars_joined Test 7: new_vars expressions using variables from both datasets", { + expected <- tibble::tribble( + ~USUBJID, ~ASTDT, ~AESEQ, ~LSTDSDUR, + "1", "2020-02-02", 1, 14, + "1", "2020-02-04", 2, 2 + ) %>% + mutate(ASTDT = ymd(ASTDT)) + + ex <- tibble::tribble( + ~USUBJID, ~EXSDTC, + "1", "2020-01-10", + "1", "2020-01", + "1", "2020-01-20", + "1", "2020-02-03" + ) + + expect_dfs_equal( + base = expected, + compare = derive_vars_joined( + select(expected, -LSTDSDUR), + dataset_add = ex, + by_vars = exprs(USUBJID), + order = exprs(EXSDT = convert_dtc_to_dt(EXSDTC)), + new_vars = exprs(LSTDSDUR = compute_duration( + start_date = EXSDT, end_date = ASTDT + )), + filter_add = !is.na(EXSDT), + filter_join = EXSDT <= ASTDT, + mode = "last" + ), + keys = c("USUBJID", "AESEQ") + ) +}) diff --git a/tests/testthat/test-derive_merged.R b/tests/testthat/test-derive_merged.R index 8640dace38..bddabe58f4 100644 --- a/tests/testthat/test-derive_merged.R +++ b/tests/testthat/test-derive_merged.R @@ -1,4 +1,3 @@ - adsl <- tibble::tribble( ~USUBJID, ~SEX, ~COUNTRY, "ST42-1", "F", "AUT", @@ -147,8 +146,70 @@ test_that("derive_vars_merged Test 5: by_vars with rename", { ) }) -## Test 6: warning if not unique w.r.t the by variables and the order ---- -test_that("derive_vars_merged Test 6: warning if not unique w.r.t the by variables and the order", { +## Test 6: expressions for new_vars and missing_values ---- +test_that("derive_vars_merged Test 6: expressions for new_vars and missing_values", { + actual <- derive_vars_merged( + adsl, + dataset_add = advs, + by_vars = exprs(USUBJID), + order = exprs(AVISIT), + new_vars = exprs(LASTVIS = str_to_upper(AVISIT)), + mode = "last", + missing_values = exprs(LASTVIS = "UNKNOWN") + ) + + expected <- + mutate(adsl, LASTVIS = c("WEEK 2", "BASELINE", "WEEK 4", "UNKNOWN")) + + + expect_dfs_equal( + base = expected, + compare = actual, + keys = "USUBJID" + ) +}) + +## Test 7: use new variables in filter_add and order ---- +test_that("derive_vars_merged Test 7: use new variables in filter_add and order", { + expected <- tibble::tribble( + ~USUBJID, ~TRTSDT, ~TRTSSEQ, + "ST42-1", "2020-12-14", 2, + "ST42-2", "2021-01-26", 2, + "ST42-3", NA, NA, + "ST42-4", NA, NA + ) %>% mutate( + STUDYID = "ST42", + TRTSDT = ymd(TRTSDT) + ) + + ex <- tibble::tribble( + ~USUBJID, ~EXSTDTC, ~EXSEQ, + "ST42-1", "2020-12-07", 1, + "ST42-1", "2020-12-14", 2, + "ST42-2", "2021-01-12T12:00:00", 1, + "ST42-2", "2021-01-26T13:21", 2, + "ST42-3", "2021-03", 1 + ) %>% mutate(STUDYID = "ST42") + + actual <- derive_vars_merged( + select(adsl, STUDYID, USUBJID), + dataset_add = ex, + by_vars = exprs(USUBJID), + order = exprs(TRTSDT), + new_vars = exprs(TRTSDT = convert_dtc_to_dt(EXSTDTC), TRTSSEQ = EXSEQ), + filter_add = !is.na(TRTSDT), + mode = "last" + ) + + expect_dfs_equal( + base = expected, + compare = actual, + keys = "USUBJID" + ) +}) + +## Test 8: warning if not unique w.r.t the by variables and the order ---- +test_that("derive_vars_merged Test 8: warning if not unique w.r.t the by variables and the order", { expect_warning( actual <- derive_vars_merged(advs, dataset_add = adsl2, @@ -161,8 +222,8 @@ test_that("derive_vars_merged Test 6: warning if not unique w.r.t the by variabl ) }) -## Test 7: error if not unique w.r.t the by variables and the order ---- -test_that("derive_vars_merged Test 7: error if not unique w.r.t the by variables and the order", { +## Test 9: error if not unique w.r.t the by variables and the order ---- +test_that("derive_vars_merged Test 9: error if not unique w.r.t the by variables and the order", { expect_error( actual <- derive_vars_merged(advs, dataset_add = adsl2, @@ -176,51 +237,66 @@ test_that("derive_vars_merged Test 7: error if not unique w.r.t the by variables ) }) - -# derive_var_merged_cat ---- -## Test 8: merge categorized variable ---- -test_that("derive_var_merged_cat Test 8: merge categorized variable", { - get_region <- function(x) { - if_else(x %in% c("AUT", "NOR"), "EUROPE", "AFRICA") - } - - actual <- derive_var_merged_cat( - advs, - dataset_add = adsl, - by_vars = exprs(USUBJID), - new_var = REGION, - source_var = COUNTRY, - cat_fun = get_region +## Test 10: error if variables in missing_values but not in new_vars ---- +test_that("derive_vars_merged Test 10: error if variables in missing_values but not in new_vars", { + expect_error( + derive_vars_merged( + adsl, + dataset_add = advs, + by_vars = exprs(USUBJID), + order = exprs(AVISIT), + new_vars = exprs(LASTVIS = str_to_upper(AVISIT)), + mode = "last", + missing_values = exprs(LASTVIS = "UNKNOWN", LASTVISN = -1) + ), + regexp = "The variables `LASTVISN` were specified for `missing_values` but not for `new_vars`.", + fixed = TRUE ) +}) - expected <- left_join(advs, select(adsl, USUBJID, COUNTRY), by = "USUBJID") %>% - mutate(REGION = get_region(COUNTRY)) %>% - select(-COUNTRY) +# derive_var_merged_cat ---- +## Test 11: deprecation warning ---- +test_that("derive_var_merged_cat Test 11: deprecation warning", { + get_vscat <- function(x) { + if_else(x == "BASELINE", "BASELINE", "POST-BASELINE") + } - expect_dfs_equal( - base = expected, - compare = actual, - keys = c("USUBJID", "AVISIT") + expect_warning( + derive_var_merged_cat( + adsl, + dataset_add = advs, + by_vars = exprs(USUBJID), + new_var = LSTVSCAT, + source_var = AVISIT, + cat_fun = get_vscat, + order = exprs(AVISIT), + mode = "last", + missing_value = "MISSING" + ), + class = "lifecycle_warning_deprecated" ) }) -## Test 9: define value for non-matched by groups ---- -test_that("derive_var_merged_cat Test 9: define value for non-matched by groups", { +## Test 12: define value for non-matched by groups ---- +test_that("derive_var_merged_cat Test 12: define value for non-matched by groups", { get_vscat <- function(x) { if_else(x == "BASELINE", "BASELINE", "POST-BASELINE") } - actual <- derive_var_merged_cat( - adsl, - dataset_add = advs, - by_vars = exprs(USUBJID), - new_var = LSTVSCAT, - source_var = AVISIT, - cat_fun = get_vscat, - order = exprs(AVISIT), - mode = "last", - missing_value = "MISSING" + actual <- suppress_warning( + derive_var_merged_cat( + adsl, + dataset_add = advs, + by_vars = exprs(USUBJID), + new_var = LSTVSCAT, + source_var = AVISIT, + cat_fun = get_vscat, + order = exprs(AVISIT), + mode = "last", + missing_value = "MISSING" + ), + regexpr = "was deprecated" ) expected <- @@ -235,23 +311,25 @@ test_that("derive_var_merged_cat Test 9: define value for non-matched by groups" ) }) -## Test 10: by_vars with rename ---- -test_that("derive_var_merged_cat Test 10: by_vars with rename", { +## Test 13: by_vars with rename ---- +test_that("derive_var_merged_cat Test 13: by_vars with rename", { get_region <- function(x) { if_else(x %in% c("AUT", "NOR"), "EUROPE", "AFRICA") } - actual <- derive_var_merged_cat( - advs, - dataset_add = adsl1, - by_vars = exprs(USUBJID = ID), - new_var = REGION, - source_var = COUNTRY, - cat_fun = get_region, - filter_add = SEX == "M" + actual <- suppress_warning( + derive_var_merged_cat( + advs, + dataset_add = adsl1, + by_vars = exprs(USUBJID = ID), + new_var = REGION, + source_var = COUNTRY, + cat_fun = get_region, + filter_add = SEX == "M" + ), + regexpr = "was deprecated" ) - adsl_1 <- adsl1 %>% filter(SEX == "M") expected <- left_join(advs, select(adsl_1, ID, COUNTRY), by = c("USUBJID" = "ID")) %>% mutate(REGION = get_region(COUNTRY)) %>% @@ -270,8 +348,8 @@ test_that("derive_var_merged_cat Test 10: by_vars with rename", { }) # derive_var_merged_exist_flag ---- -## Test 11: merge existence flag ---- -test_that("derive_var_merged_exist_flag Test 11: merge existence flag", { +## Test 14: merge existence flag ---- +test_that("derive_var_merged_exist_flag Test 14: merge existence flag", { actual <- derive_var_merged_exist_flag( adsl, dataset_add = advs, @@ -291,8 +369,8 @@ test_that("derive_var_merged_exist_flag Test 11: merge existence flag", { ) }) -## Test 12: by_vars with rename ---- -test_that("derive_var_merged_exist_flag Test 12: by_vars with rename", { +## Test 15: by_vars with rename ---- +test_that("derive_var_merged_exist_flag Test 15: by_vars with rename", { actual <- derive_var_merged_exist_flag( adsl, dataset_add = advs1, @@ -313,16 +391,36 @@ test_that("derive_var_merged_exist_flag Test 12: by_vars with rename", { }) # derive_var_merged_character ---- -## Test 13: no transformation ---- -test_that("derive_var_merged_character Test 13: no transformation", { - actual <- derive_var_merged_character( - adsl, - dataset_add = advs, - by_vars = exprs(USUBJID), - order = exprs(AVISIT), - new_var = LASTVIS, - source_var = AVISIT, - mode = "last" + +## Test 16: deprecation warning ---- +test_that("derive_var_merged_character Test 16: deprecation warning", { + expect_warning( + derive_var_merged_character( + adsl, + dataset_add = advs, + by_vars = exprs(USUBJID), + order = exprs(AVISIT), + new_var = LASTVIS, + source_var = AVISIT, + mode = "last" + ), + class = "lifecycle_warning_deprecated" + ) +}) + +## Test 17: no transformation ---- +test_that("derive_var_merged_character Test 17: no transformation", { + actual <- suppress_warning( + derive_var_merged_character( + adsl, + dataset_add = advs, + by_vars = exprs(USUBJID), + order = exprs(AVISIT), + new_var = LASTVIS, + source_var = AVISIT, + mode = "last" + ), + regexpr = "was deprecated" ) expected <- @@ -336,18 +434,21 @@ test_that("derive_var_merged_character Test 13: no transformation", { ) }) -## Test 14: upper case ---- -test_that("derive_var_merged_character Test 14: upper case", { - actual <- derive_var_merged_character( - adsl, - dataset_add = advs, - by_vars = exprs(USUBJID), - order = exprs(AVISIT), - new_var = LASTVIS, - source_var = AVISIT, - mode = "last", - case = "upper", - missing_value = "UNKNOWN" +## Test 18: upper case ---- +test_that("derive_var_merged_character Test 18: upper case", { + actual <- suppress_warning( + derive_var_merged_character( + adsl, + dataset_add = advs, + by_vars = exprs(USUBJID), + order = exprs(AVISIT), + new_var = LASTVIS, + source_var = AVISIT, + mode = "last", + case = "upper", + missing_value = "UNKNOWN" + ), + regexpr = "was deprecated" ) expected <- @@ -361,17 +462,20 @@ test_that("derive_var_merged_character Test 14: upper case", { ) }) -## Test 15: lower case ---- -test_that("derive_var_merged_character Test 15: lower case", { - actual <- derive_var_merged_character( - adsl, - dataset_add = advs, - by_vars = exprs(USUBJID), - order = exprs(AVISIT), - new_var = LASTVIS, - source_var = AVISIT, - mode = "last", - case = "lower" +## Test 19: lower case ---- +test_that("derive_var_merged_character Test 19: lower case", { + actual <- suppress_warning( + derive_var_merged_character( + adsl, + dataset_add = advs, + by_vars = exprs(USUBJID), + order = exprs(AVISIT), + new_var = LASTVIS, + source_var = AVISIT, + mode = "last", + case = "lower" + ), + regexpr = "was deprecated" ) expected <- @@ -385,17 +489,20 @@ test_that("derive_var_merged_character Test 15: lower case", { ) }) -## Test 16: title case ---- -test_that("derive_var_merged_character Test 16: title case", { - actual <- derive_var_merged_character( - adsl, - dataset_add = advs, - by_vars = exprs(USUBJID), - order = exprs(AVISIT), - new_var = LASTVIS, - source_var = AVISIT, - mode = "last", - case = "title" +## Test 20: title case ---- +test_that("derive_var_merged_character Test 20: title case", { + actual <- suppress_warning( + derive_var_merged_character( + adsl, + dataset_add = advs, + by_vars = exprs(USUBJID), + order = exprs(AVISIT), + new_var = LASTVIS, + source_var = AVISIT, + mode = "last", + case = "title" + ), + regexpr = "was deprecated" ) expected <- @@ -409,16 +516,19 @@ test_that("derive_var_merged_character Test 16: title case", { ) }) -## Test 17: by_vars with rename ---- -test_that("derive_var_merged_character Test 17: by_vars with rename", { - actual <- derive_var_merged_character( - adsl, - dataset_add = advs1, - by_vars = exprs(USUBJID = ID), - order = exprs(AVISIT), - new_var = LASTVIS, - source_var = AVISIT, - mode = "last" +## Test 21: by_vars with rename ---- +test_that("derive_var_merged_character Test 21: by_vars with rename", { + actual <- suppress_warning( + derive_var_merged_character( + adsl, + dataset_add = advs1, + by_vars = exprs(USUBJID = ID), + order = exprs(AVISIT), + new_var = LASTVIS, + source_var = AVISIT, + mode = "last" + ), + regexpr = "was deprecated" ) expected <- @@ -434,8 +544,8 @@ test_that("derive_var_merged_character Test 17: by_vars with rename", { # derive_vars_merged_lookup ---- -## Test 18: merge lookup table ---- -test_that("derive_vars_merged_lookup Test 18: merge lookup table", { +## Test 22: merge lookup table ---- +test_that("derive_vars_merged_lookup Test 22: merge lookup table", { param_lookup <- tibble::tribble( ~VSTESTCD, ~VSTEST, ~PARAMCD, ~DESCRIPTION, "WEIGHT", "Weight", "WEIGHT", "Weight (kg)", @@ -472,8 +582,8 @@ test_that("derive_vars_merged_lookup Test 18: merge lookup table", { ## the lookup table -## Test 19: all by_vars have records in the lookup table ---- -test_that("derive_vars_merged_lookup Test 19: all by_vars have records in the lookup table", { +## Test 23: all by_vars have records in the lookup table ---- +test_that("derive_vars_merged_lookup Test 23: all by_vars have records in the lookup table", { param_lookup <- tibble::tribble( ~VSTESTCD, ~VSTEST, ~PARAMCD, ~DESCRIPTION, "WEIGHT", "Weight", "WEIGHT", "Weight (kg)", @@ -508,8 +618,8 @@ test_that("derive_vars_merged_lookup Test 19: all by_vars have records in the l ) }) -## Test 20: by_vars with rename ---- -test_that("derive_vars_merged_lookup Test 20: by_vars with rename", { +## Test 24: by_vars with rename ---- +test_that("derive_vars_merged_lookup Test 24: by_vars with rename", { param_lookup <- tibble::tribble( ~TESTCD, ~VSTEST, ~PARAMCD, ~DESCRIPTION, "WEIGHT", "Weight", "WEIGHT", "Weight (kg)", @@ -545,8 +655,8 @@ test_that("derive_vars_merged_lookup Test 20: by_vars with rename", { # get_not_mapped ---- -## Test 21: not all by_vars have records in the lookup table ---- -test_that("get_not_mapped Test 21: not all by_vars have records in the lookup table", { +## Test 25: not all by_vars have records in the lookup table ---- +test_that("get_not_mapped Test 25: not all by_vars have records in the lookup table", { param_lookup <- tibble::tribble( ~VSTESTCD, ~VSTEST, ~PARAMCD, ~DESCRIPTION, "WEIGHT", "Weight", "WEIGHT", "Weight (kg)", @@ -584,8 +694,8 @@ test_that("get_not_mapped Test 21: not all by_vars have records in the lookup ta }) # derive_var_merged_summary ---- -## Test 22: dataset == dataset_add, no filter ---- -test_that("derive_var_merged_summary Test 22: dataset == dataset_add, no filter", { +## Test 26: dataset == dataset_add, no filter ---- +test_that("derive_var_merged_summary Test 26: dataset == dataset_add, no filter", { expected <- tibble::tribble( ~AVISIT, ~ASEQ, ~AVAL, ~MEANVIS, "WEEK 1", 1, 10, 10, @@ -613,8 +723,8 @@ test_that("derive_var_merged_summary Test 22: dataset == dataset_add, no filter" ) }) -## Test 23: dataset != dataset_add, filter ---- -test_that("derive_var_merged_summary Test 23: dataset != dataset_add, filter", { +## Test 27: dataset != dataset_add, filter ---- +test_that("derive_var_merged_summary Test 27: dataset != dataset_add, filter", { expected <- tibble::tribble( ~USUBJID, ~MEANPBL, "1", 13.5, @@ -647,8 +757,8 @@ test_that("derive_var_merged_summary Test 23: dataset != dataset_add, filter", { ) }) -## Test 24: by_vars with rename ---- -test_that("derive_var_merged_summary Test 24: by_vars with rename", { +## Test 28: by_vars with rename ---- +test_that("derive_var_merged_summary Test 28: by_vars with rename", { expected <- tibble::tribble( ~AVISIT, ~ASEQ, ~AVAL, ~MEANVIS, "WEEK 1", 1, 10, 10, diff --git a/tests/testthat/test-derive_param_computed.R b/tests/testthat/test-derive_param_computed.R index f51ca5c340..e1d5ada537 100644 --- a/tests/testthat/test-derive_param_computed.R +++ b/tests/testthat/test-derive_param_computed.R @@ -1,4 +1,6 @@ -test_that("new observations are derived correctly", { +# derive_param_computed ---- +## Test 1: new observations are derived correctly ---- +test_that("derive_param_computed Test 1: new observations are derived correctly", { input <- tibble::tribble( ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, "01-701-1015", "DIABP", "Diastolic Blood Pressure (mmHg)", 51, "mmHg", "BASELINE", @@ -29,7 +31,7 @@ test_that("new observations are derived correctly", { expect_dfs_equal( derive_param_computed( input, - parameters = c("SYSBP", "DIABP"), + parameters = exprs(SYSBP, DIABP), by_vars = exprs(USUBJID, VISIT), analysis_value = (AVAL.SYSBP + 2 * AVAL.DIABP) / 3, set_values_to = exprs( @@ -43,17 +45,18 @@ test_that("new observations are derived correctly", { ) }) -test_that("new observations are derived correctly with constant parameters", { +## Test 2: new observations with constant parameters ---- +test_that("derive_param_computed Test 2: new observations with constant parameters", { input <- tibble::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", - "01-701-1015", "WEIGHT", "Weight (kg)", 54.4, "kg", "BASELINE", - "01-701-1015", "WEIGHT", "Weight (kg)", 53.1, "kg", "WEEK 2", - "01-701-1028", "HEIGHT", "Height (cm)", 163, "cm", "SCREENING", - "01-701-1028", "WEIGHT", "Weight (kg)", 78.5, "kg", "SCREENING", - "01-701-1028", "WEIGHT", "Weight (kg)", 80.3, "kg", "BASELINE", - "01-701-1028", "WEIGHT", "Weight (kg)", 80.7, "kg", "WEEK 2" + ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, + "01-701-1015", "HEIGHT", "Height (cm)", 147.0, "cm", "SCREENING", + "01-701-1015", "WEIGHT", "Weight (kg)", 54.0, "kg", "SCREENING", + "01-701-1015", "WEIGHT", "Weight (kg)", 54.4, "kg", "BASELINE", + "01-701-1015", "WEIGHT", "Weight (kg)", 53.1, "kg", "WEEK 2", + "01-701-1028", "HEIGHT", "Height (cm)", 163.0, "cm", "SCREENING", + "01-701-1028", "WEIGHT", "Weight (kg)", 78.5, "kg", "SCREENING", + "01-701-1028", "WEIGHT", "Weight (kg)", 80.3, "kg", "BASELINE", + "01-701-1028", "WEIGHT", "Weight (kg)", 80.7, "kg", "WEEK 2" ) new_obs <- @@ -90,7 +93,8 @@ test_that("new observations are derived correctly with constant parameters", { ) }) -test_that("no new observations are added if filtered dataset is empty", { +## Test 3: no new observations if filtered dataset is empty ---- +test_that("derive_param_computed Test 3: no new observations if filtered dataset is empty", { input <- tibble::tribble( ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, "01-701-1015", "DIABP", "Diastolic Blood Pressure (mmHg)", 51, "mmHg", "BASELINE", @@ -123,7 +127,8 @@ test_that("no new observations are added if filtered dataset is empty", { ) }) -test_that("no new observations are added if a parameter is missing", { +## Test 4: no new observations are added if a parameter is missing ---- +test_that("derive_param_computed Test 4: no new observations are added if a parameter is missing", { input <- tibble::tribble( ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, "01-701-1015", "DIABP", "Diastolic Blood Pressure (mmHg)", 51, "mmHg", "BASELINE", @@ -140,7 +145,7 @@ test_that("no new observations are added if a parameter is missing", { derive_param_computed( input, filter = PARAMCD == "DIABP", - parameters = c("SYSBP", "DIABP"), + parameters = exprs(SYSBP, DIABP), by_vars = exprs(USUBJID, VISIT), analysis_value = (AVAL.SYSBP + 2 * AVAL.DIABP) / 3, set_values_to = exprs( @@ -156,3 +161,240 @@ test_that("no new observations are added if a parameter is missing", { "The input dataset does not contain any observations fullfiling the filter condition .*" ) }) + + +## Test 5: `dataset_add`, creating new parameters ---- +test_that("derive_param_computed Test 5: `dataset_add`, creating new parameters", { + qs <- tibble::tribble( + ~USUBJID, ~AVISIT, ~QSTESTCD, ~QSORRES, ~QSSTRESN, + "1", "WEEK 2", "CHSF112", NA, 1, + "1", "WEEK 2", "CHSF113", "Yes", NA, + "1", "WEEK 2", "CHSF114", NA, 1, + "1", "WEEK 4", "CHSF112", NA, 2, + "1", "WEEK 4", "CHSF113", "No", NA, + "1", "WEEK 4", "CHSF114", NA, 1 + ) + + adchsf <- tibble::tribble( + ~USUBJID, ~AVISIT, ~PARAMCD, ~QSORRES, ~QSSTRESN, ~AVAL, + "1", "WEEK 2", "CHSF12", NA, 1, 6, + "1", "WEEK 2", "CHSF14", NA, 1, 6, + "1", "WEEK 4", "CHSF12", NA, 2, 12, + "1", "WEEK 4", "CHSF14", NA, 1, 6 + ) + + expected <- bind_rows( + adchsf, + tibble::tribble( + ~USUBJID, ~AVISIT, ~PARAMCD, ~AVAL, + "1", "WEEK 2", "CHSF13", 38, + "1", "WEEK 4", "CHSF13", 25 + ) + ) + + expect_dfs_equal( + base = expected, + compare = derive_param_computed( + adchsf, + dataset_add = qs, + by_vars = exprs(USUBJID, AVISIT), + parameters = exprs(CHSF12, CHSF13 = QSTESTCD %in% c("CHSF113", "CHSF213"), CHSF14), + analysis_value = case_when( + QSORRES.CHSF13 == "Not applicable" ~ 0, + QSORRES.CHSF13 == "Yes" ~ 38, + QSORRES.CHSF13 == "No" ~ if_else( + QSSTRESN.CHSF12 > QSSTRESN.CHSF14, + 25, + 0 + ) + ), + set_values_to = exprs(PARAMCD = "CHSF13") + ), + keys = c("USUBJID", "PARAMCD", "AVISIT") + ) +}) + +## Test 6: no input dataset ---- +test_that("derive_param_computed Test 6: no input dataset", { + qs <- tibble::tribble( + ~USUBJID, ~AVISIT, ~QSTESTCD, ~QSORRES, ~QSSTRESN, + "1", "WEEK 2", "CHSF112", NA, 1, + "1", "WEEK 2", "CHSF113", "Yes", NA, + "1", "WEEK 2", "CHSF114", NA, 1, + "1", "WEEK 4", "CHSF112", NA, 2, + "1", "WEEK 4", "CHSF213", "No", NA, + "1", "WEEK 4", "CHSF114", NA, 1 + ) + + expected <- tibble::tribble( + ~USUBJID, ~AVISIT, ~PARAMCD, ~AVAL, + "1", "WEEK 2", "CHSF13", 38, + "1", "WEEK 4", "CHSF13", 25 + ) + + expect_dfs_equal( + base = expected, + compare = derive_param_computed( + dataset_add = qs, + by_vars = exprs(USUBJID, AVISIT), + parameters = exprs( + CHSF12 = QSTESTCD == "CHSF112", + CHSF13 = QSTESTCD %in% c("CHSF113", "CHSF213"), + CHSF14 = QSTESTCD == "CHSF114" + ), + analysis_value = case_when( + QSORRES.CHSF13 == "Not applicable" ~ 0, + QSORRES.CHSF13 == "Yes" ~ 38, + QSORRES.CHSF13 == "No" ~ if_else( + QSSTRESN.CHSF12 > QSSTRESN.CHSF14, + 25, + 0 + ) + ), + set_values_to = exprs(PARAMCD = "CHSF13") + ), + keys = c("USUBJID", "PARAMCD", "AVISIT") + ) +}) + +## Test 7: expression in constant_parameters ---- +test_that("derive_param_computed Test 7: expression in constant_parameters", { + input <- tibble::tribble( + ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, + "01-701-1015", "WEIGHT", "Weight (kg)", 54.0, "kg", "SCREENING", + "01-701-1015", "WEIGHT", "Weight (kg)", 54.4, "kg", "BASELINE", + "01-701-1015", "WEIGHT", "Weight (kg)", 53.1, "kg", "WEEK 2", + "01-701-1028", "HEIGHT", "Height (cm)", 163.0, "cm", "SCREENING", + "01-701-1028", "WEIGHT", "Weight (kg)", 78.5, "kg", "SCREENING", + "01-701-1028", "WEIGHT", "Weight (kg)", 80.3, "kg", "BASELINE", + "01-701-1028", "WEIGHT", "Weight (kg)", 80.7, "kg", "WEEK 2" + ) + + vs <- tibble::tribble( + ~USUBJID, ~VSTESTCD, ~VSTEST, ~VSSTRESN, ~VSSTRESU, + "01-701-1015", "HGHT", "Height", 147.0, "cm" + ) + + new_obs <- + inner_join(vs %>% filter(VSTESTCD == "HGHT") %>% select(USUBJID, AVAL = VSSTRESN), + input %>% filter(PARAMCD == "WEIGHT") %>% select(USUBJID, VISIT, AVAL), + by = c("USUBJID"), + suffix = c(".HEIGHT", ".WEIGHT") + ) %>% + mutate( + AVAL = AVAL.WEIGHT / (AVAL.HEIGHT / 100)^2, + PARAMCD = "BMI", + PARAM = "Body Mass Index (kg/m2)", + AVALU = "kg/m2" + ) %>% + select(-AVAL.HEIGHT, -AVAL.WEIGHT) + expected_output <- bind_rows(input, new_obs) + + expect_dfs_equal( + derive_param_computed( + input, + dataset_add = vs, + parameters = exprs(WEIGHT), + by_vars = exprs(USUBJID, VISIT), + constant_parameters = exprs("HEIGHT" = VSTESTCD == "HGHT"), + constant_by_vars = exprs(USUBJID), + analysis_value = AVAL.WEIGHT / (VSSTRESN.HEIGHT / 100)^2, + set_values_to = exprs( + PARAMCD = "BMI", + PARAM = "Body Mass Index (kg/m2)", + AVALU = "kg/m2" + ) + ), + expected_output, + keys = c("USUBJID", "PARAMCD", "VISIT") + ) +}) + +## Test 8: no new observations if a constant parameter is missing ---- +test_that("derive_param_computed Test 8: no new observations if a constant parameter is missing", { + input <- tibble::tribble( + ~USUBJID, ~PARAMCD, ~PARAM, ~AVAL, ~AVALU, ~VISIT, + "01-701-1015", "WEIGHT", "Weight (kg)", 54.0, "kg", "SCREENING", + "01-701-1015", "WEIGHT", "Weight (kg)", 54.4, "kg", "BASELINE", + "01-701-1015", "WEIGHT", "Weight (kg)", 53.1, "kg", "WEEK 2", + "01-701-1028", "WEIGHT", "Weight (kg)", 78.5, "kg", "SCREENING", + "01-701-1028", "WEIGHT", "Weight (kg)", 80.3, "kg", "BASELINE", + "01-701-1028", "WEIGHT", "Weight (kg)", 80.7, "kg", "WEEK 2" + ) + + expect_warning( + output <- derive_param_computed( + input, + parameters = c("WEIGHT"), + by_vars = exprs(USUBJID, VISIT), + constant_parameters = c("HEIGHT"), + constant_by_vars = exprs(USUBJID), + analysis_value = AVAL.WEIGHT / (AVAL.HEIGHT / 100)^2, + set_values_to = exprs( + PARAMCD = "BMI", + PARAM = "Body Mass Index (kg/m2)", + AVALU = "kg/m2" + ) + ), + regexp = paste( + paste( + "The input dataset does not contain any observations fullfiling the filter", + "condition (NULL) for the parameter codes (PARAMCD) `HEIGHT`" + ), + "No new observations were added.", + sep = "\n" + ), + fixed = TRUE + ) + + expect_dfs_equal( + output, + input, + keys = c("USUBJID", "PARAMCD", "VISIT") + ) +}) + +# assert_parameters_argument ---- +## Test 9: error if argument is of wrong type ---- +test_that("assert_parameters_argument Test 9: error if argument is of wrong type", { + expect_error( + assert_parameters_argument(myparameters <- c(1, 2, 3)), + regexp = paste( + "`myparameters` must be a character vector or a list of expressions", + "but it is a double vector." + ), + fixed = TRUE + ) +}) + +# get_hori_data ---- +## Test 10: error if variables with more than one dot ---- +test_that("get_hori_data Test 10: error if variables with more than one dot", { + input <- tibble::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", + "01-701-1015", "SYSBP", "Systolic Blood Pressure (mmHg)", 121, "mmHg", "BASELINE", + "01-701-1015", "SYSBP", "Systolic Blood Pressure (mmHg)", 121, "mmHg", "WEEK 2", + "01-701-1028", "DIABP", "Diastolic Blood Pressure (mmHg)", 79, "mmHg", "BASELINE", + "01-701-1028", "DIABP", "Diastolic Blood Pressure (mmHg)", 80, "mmHg", "WEEK 2", + "01-701-1028", "SYSBP", "Systolic Blood Pressure (mmHg)", 130, "mmHg", "BASELINE", + "01-701-1028", "SYSBP", "Systolic Blood Pressure (mmHg)", 132, "mmHg", "WEEK 2" + ) + + expect_error( + get_hori_data( + input, + parameters = exprs(SYSBP, DIABP), + by_vars = exprs(USUBJID, VISIT), + analysis_value = (AVAL.SYSBP + 2 * AVAL.DIA.BP) / 3, + filter = NULL + ), + regexp = paste( + "The `analysis_value` argument contains variable names with more than on dot:", + "`AVAL.DIA.BP`", + sep = "\n" + ), + fixed = TRUE + ) +}) diff --git a/tests/testthat/test-derive_param_exist_flag.R b/tests/testthat/test-derive_param_exist_flag.R index 1fd8088f49..0d35c71744 100644 --- a/tests/testthat/test-derive_param_exist_flag.R +++ b/tests/testthat/test-derive_param_exist_flag.R @@ -29,15 +29,16 @@ adrs <- tibble::tribble( ) # derive_param_merged_exist_flag ---- -## derive_param_merge_exist_flag Test 1: derive parameter indicating PD ---- -test_that("derive_param_exist_flag Test 1: derive parameter indicating PD", { +## Test 1: derive parameter indicating PD ---- +test_that("derive_param_merged_exist_flag Test 1: derive parameter indicating PD", { actual <- derive_param_exist_flag( - dataset_adsl = adsl, + dataset_ref = adsl, dataset_add = adrs, filter_add = PARAMCD == "OVR", condition = AVALC == "PD", false_value = "N", set_values_to = exprs( + AVAL = yn_to_numeric(AVALC), PARAMCD = "PD", ANL01FL = "Y" ) @@ -62,28 +63,6 @@ test_that("derive_param_exist_flag Test 1: derive parameter indicating PD", { ) }) -## derive_param_exist_flag Test 2: error is issued if aval_fun returns wrong type ---- -test_that("derive_param_exist_flag Test 2: error is issued if aval_fun returns wrong type", { - expect_error( - derive_param_exist_flag( - dataset_adsl = adsl, - dataset_add = adrs, - filter_add = PARAMCD == "OVR", - condition = AVALC == "PD", - false_value = "N", - aval_fun = function(x) x, - set_values_to = exprs( - PARAMCD = "PD", - ANL01FL = "Y" - ) - ), - regexp = paste( - "Calling `aval_fun(AVALC)` did not result in a numeric vector.\n", - "A character vector was returned." - ), - fixed = TRUE - ) -}) ## derive_param_exist_flag Test 3: error is issued if paramter already exists in dataset ---- @@ -91,7 +70,7 @@ test_that("derive_param_exist_flag Test 3: error is issued if paramter already e expect_error( derive_param_exist_flag( dataset = adrs, - dataset_adsl = adsl, + dataset_ref = adsl, dataset_add = adrs, filter_add = PARAMCD == "OVR", condition = AVALC == "PD", @@ -107,3 +86,36 @@ test_that("derive_param_exist_flag Test 3: error is issued if paramter already e fixed = TRUE ) }) + + + +## derive_param_merge_exist_flag Test 4: warning for deprecated parameter ---- +test_that("derive_param_exist_flag Test 4: warning for deprecated param `dataset_adsl`", { + expect_warning(derive_param_exist_flag( + dataset_adsl = adsl, + dataset_add = adrs, + filter_add = PARAMCD == "OVR", + condition = AVALC == "PD", + false_value = "N", + set_values_to = exprs( + PARAMCD = "PD", + ANL01FL = "Y" + ) + )) +}) + +## derive_param_merge_exist_flag Test 5: warning for deprecated parameter ---- +test_that("derive_param_exist_flag Test 5: warning for deprecated param `subject_keys`", { + expect_warning(derive_param_exist_flag( + dataset_ref = adsl, + dataset_add = adrs, + subject_keys = get_admiral_option("subject_keys"), + filter_add = PARAMCD == "OVR", + condition = AVALC == "PD", + false_value = "N", + set_values_to = exprs( + PARAMCD = "PD", + ANL01FL = "Y" + ) + )) +}) diff --git a/tests/testthat/test-derive_param_extreme_event.R b/tests/testthat/test-derive_param_extreme_event.R index d9f86106b7..1ad3ee80bc 100644 --- a/tests/testthat/test-derive_param_extreme_event.R +++ b/tests/testthat/test-derive_param_extreme_event.R @@ -30,20 +30,43 @@ adrs <- tibble::tribble( 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", - new_var = AVALC, - order = exprs(ADT), - set_values_to = exprs( - PARAMCD = "PD", - ANL01FL = "Y", - ADT = ADT - ) +## Test 1: deprecation warning if function is called ---- +test_that("derive_param_extreme_event Test 1: deprecation warning if function is called", { + expect_warning( + derive_param_extreme_event( + adrs, + dataset_adsl = adsl, + dataset_source = adrs, + filter_source = PARAMCD == "OVR" & AVALC == "PD", + new_var = AVALC, + order = exprs(ADT), + set_values_to = exprs( + PARAMCD = "PD", + ANL01FL = "Y", + ADT = ADT + ) + ), + class = "lifecycle_warning_deprecated" + ) +}) + +## Test 2: derive first PD date ---- +test_that("derive_param_extreme_event Test 2: derive first PD date", { + actual <- suppress_warning( + derive_param_extreme_event( + adrs, + dataset_adsl = adsl, + dataset_source = adrs, + filter_source = PARAMCD == "OVR" & AVALC == "PD", + new_var = AVALC, + order = exprs(ADT), + set_values_to = exprs( + PARAMCD = "PD", + ANL01FL = "Y", + ADT = ADT + ) + ), + regexpr = "was deprecated" ) expected <- bind_rows( @@ -68,21 +91,24 @@ test_that("derive_param_extreme_event Test 1: derive first PD date", { ) }) -## 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 = exprs( - PARAMCD = "DEATH", - ANL01FL = "Y", - ADT = DTHDT - ) +## Test 3: derive death date parameter ---- +test_that("derive_param_extreme_event Test 3: derive death date parameter", { + actual <- suppress_warning( + 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 = exprs( + PARAMCD = "DEATH", + ANL01FL = "Y", + ADT = DTHDT + ) + ), + regexpr = "was deprecated" ) expected <- tibble::tribble( @@ -129,23 +155,26 @@ adrs <- tibble::tribble( ) %>% select(-ADTC) -## Test 3: 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 = exprs(ADT), - new_var = AVALC, - true_value = "Y", - false_value = "N", - mode = "last", - set_values_to = exprs( - PARAMCD = "LSTEVLDT", - ANL01FL = "Y", - ADT = ADT - ) +## Test 4: latest evaluable tumor assessment date parameter ---- +test_that("derive_param_extreme_event Test 4: latest evaluable tumor assessment date parameter", { + actual <- suppress_warning( + derive_param_extreme_event( + dataset = adrs, + dataset_adsl = adsl, + dataset_source = adrs, + filter_source = PARAMCD == "OVR" & AVALC != "NE", + order = exprs(ADT), + new_var = AVALC, + true_value = "Y", + false_value = "N", + mode = "last", + set_values_to = exprs( + PARAMCD = "LSTEVLDT", + ANL01FL = "Y", + ADT = ADT + ) + ), + regexpr = "was deprecated" ) expected <- bind_rows( @@ -170,21 +199,24 @@ test_that("derive_param_extreme_event Test 3: latest evaluable tumor assessment ) }) -## Test 4: latest evaluable tumor assessment date parameter without overwriting existing result ---- -test_that("derive_param_extreme_event Test 4: latest evaluable tumor assessment date parameter without overwriting existing result", { # nolint - actual <- derive_param_extreme_event( - dataset = adrs, - dataset_adsl = adsl, - dataset_source = adrs, - filter_source = PARAMCD == "OVR" & AVALC != "NE", - order = exprs(ADT), - new_var = NULL, - mode = "last", - set_values_to = exprs( - PARAMCD = "LSTEVLDT", - ANL01FL = "Y", - ADT = ADT - ) +## Test 5: latest evaluable tumor assessment date parameter without overwriting existing result ---- +test_that("derive_param_extreme_event Test 5: latest evaluable tumor assessment date parameter without overwriting existing result", { # nolint + actual <- suppress_warning( + derive_param_extreme_event( + dataset = adrs, + dataset_adsl = adsl, + dataset_source = adrs, + filter_source = PARAMCD == "OVR" & AVALC != "NE", + order = exprs(ADT), + new_var = NULL, + mode = "last", + set_values_to = exprs( + PARAMCD = "LSTEVLDT", + ANL01FL = "Y", + ADT = ADT + ) + ), + regexpr = "was deprecated" ) expected <- bind_rows( diff --git a/tests/testthat/test-derive_param_extreme_record.R b/tests/testthat/test-derive_param_extreme_record.R new file mode 100644 index 0000000000..8cd603f268 --- /dev/null +++ b/tests/testthat/test-derive_param_extreme_record.R @@ -0,0 +1,202 @@ +# derive_param_extreme_record ---- +## Test 1: Analysis date are derived correctly ---- +test_that("derive_param_extreme_record Test 1: Analysis date are derived correctly", { + aevent <- tibble::tribble( + ~STUDYID, ~USUBJID, ~LBSTDTC, ~PARAMCD, ~PARAM, + "1001", "1", "2023-01-01", "TST", "TEST", + "1001", "2", "2023-01-01", "TST", "TEST", + "1001", "3", "2023-01-01", "TST", "TEST" + ) + + cm <- tibble::tribble( + ~STUDYID, ~USUBJID, ~CMDECOD, ~CMSTDTC, + "1001", "1", "ACT", "2020-12-25" + ) + + pr <- tibble::tribble( + ~STUDYID, ~USUBJID, ~PRDECOD, ~PRSTDTC, + "1001", "1", "ACS", "2020-12-27", + "1001", "2", "ACS", "2021-12-25", + "1001", "3", "ACS", "2022-12-25", + ) + expected_output <- tibble::tribble( + ~STUDYID, ~USUBJID, ~LBSTDTC, ~PARAMCD, ~PARAM, ~ADT, ~AVALC, # nolint + "1001", "1", "2023-01-01", "TST", "TEST", NA, NA, # nolint + "1001", "2", "2023-01-01", "TST", "TEST", NA, NA, # nolint + "1001", "3", "2023-01-01", "TST", "TEST", NA, NA, # nolint + "1001", "1", NA, "FIRSTACT", "First Anti-Cancer Therapy", lubridate::ymd("2020-12-25"), "ACT", # nolint + "1001", "2", NA, "FIRSTACT", "First Anti-Cancer Therapy", lubridate::ymd("2021-12-25"), "ACS", # nolint + "1001", "3", NA, "FIRSTACT", "First Anti-Cancer Therapy", lubridate::ymd("2022-12-25"), "ACS" # nolint + ) + actual_output <- derive_param_extreme_record( + dataset = aevent, + sources = list( + records_source( + dataset_name = "cm", + filter = CMDECOD == "ACT", + new_vars = exprs( + ADT = convert_dtc_to_dt(CMSTDTC), + AVALC = CMDECOD + ) + ), + records_source( + dataset_name = "pr", + filter = PRDECOD == "ACS", + new_vars = exprs( + ADT = convert_dtc_to_dt(PRSTDTC), + AVALC = PRDECOD + ) + ) + ), + source_datasets = list(cm = cm, pr = pr), + by_vars = exprs(STUDYID, USUBJID), + order = exprs(ADT), + mode = "first", + set_values_to = exprs( + PARAMCD = "FIRSTACT", + PARAM = "First Anti-Cancer Therapy" + ) + ) + + expect_dfs_equal(expected_output, actual_output, keys = c("USUBJID", "PARAMCD", "PARAM", "ADT", "AVALC")) # nolint +}) + +## Test 2: Error given when order variable is not inside source datasets ---- +test_that("derive_param_extreme_record Test 2: Error given when order variable is not inside source datasets", { # nolint + aevent <- tibble::tribble( + ~STUDYID, ~USUBJID, ~LBSTDTC, ~PARAMCD, ~PARAM, + "1001", "1", "2023-01-01", "TST", "TEST", + "1001", "2", "2023-01-01", "TST", "TEST", + "1001", "3", "2023-01-01", "TST", "TEST" + ) + + cm <- tibble::tribble( + ~STUDYID, ~USUBJID, ~CMDECOD, ~CMSTDTC, + "1001", "1", "ACT", "2020-12-25" + ) + + pr <- tibble::tribble( + ~STUDYID, ~USUBJID, ~PRDECOD, ~PRSTDTC, + "1001", "1", "ACS", "2020-12-27", + "1001", "2", "ACS", "2021-12-25", + "1001", "3", "ACS", "2022-12-25", + ) + expect_error( + derive_param_extreme_record( + dataset = aevent, + sources = list( + records_source( + dataset_name = "cm", + filter = CMDECOD == "ACT", + new_vars = exprs( + ADT = convert_dtc_to_dt(CMSTDTC), + AVALC = CMDECOD + ) + ), + records_source( + dataset_name = "pr", + filter = PRDECOD == "ACS", + new_vars = exprs( + ADT = convert_dtc_to_dt(PRSTDTC), + AVALC = PRDECOD + ) + ) + ), + source_datasets = list(cm = cm, pr = pr), + by_vars = exprs(STUDYID, USUBJID), + order = exprs(ADT2), + mode = "first", + set_values_to = exprs( + PARAMCD = "FIRSTACT", + PARAM = "First Anti-Cancer Therapy" + ) + ), + regexp = "Required variable `ADT2` is missing" + ) +}) + +## Test 3: Error given when sources is not in proper list format ---- +test_that("derive_param_extreme_record Test 3: Error given when sources is not in proper list format", { # nolint + aevent <- tibble::tribble( + ~STUDYID, ~USUBJID, ~LBSTDTC, ~PARAMCD, ~PARAM, + "1001", "1", "2023-01-01", "TST", "TEST", + "1001", "2", "2023-01-01", "TST", "TEST", + "1001", "3", "2023-01-01", "TST", "TEST" + ) + + pr <- tibble::tribble( + ~STUDYID, ~USUBJID, ~PRDECOD, ~PRSTDTC, + "1001", "1", "ACS", "2020-12-27", + "1001", "2", "ACS", "2021-12-25", + "1001", "3", "ACS", "2022-12-25", + ) + expect_error( + derive_param_extreme_record( + dataset = aevent, + sources = records_source( + dataset_name = "pr", + filter = PRDECOD == "ACS", + new_vars = exprs( + ADT = convert_dtc_to_dt(PRSTDTC), + AVALC = PRDECOD + ) + ), + source_datasets = list(pr = pr), + by_vars = exprs(STUDYID, USUBJID), + order = exprs(ADT), + mode = "first", + set_values_to = exprs( + PARAMCD = "FIRSTACT", + PARAM = "First Anti-Cancer Therapy" + ) + ), + regexp = "Each element of `sources` must be an object of class/type 'records_source' but the following are not:" # nolint + ) +}) + +## Test 4: Non-existent/missing values are accounted for ---- +test_that("derive_param_extreme_record Test 4: Non-existent/missing values are accounted for", { + aevent <- tibble::tribble( + ~STUDYID, ~USUBJID, ~LBSTDTC, ~PARAMCD, ~PARAM, + "1001", "1", "2023-01-01", "TST", "TEST", + "1001", "2", "2023-01-01", "TST", "TEST", + "1001", "3", "2023-01-01", "TST", "TEST" + ) + + pr <- tibble::tribble( + ~STUDYID, ~USUBJID, ~PRDECOD, ~PRSTDTC, + "1001", "2", "ACS", "2021-12-25", + "1001", "3", "ACS", "2022-12-25", + ) + expected_output <- tibble::tribble( + ~STUDYID, ~USUBJID, ~LBSTDTC, ~PARAMCD, ~PARAM, ~ADT, ~AVALC, # nolint + "1001", "1", "2023-01-01", "TST", "TEST", NA, NA, # nolint + "1001", "2", "2023-01-01", "TST", "TEST", NA, NA, # nolint + "1001", "3", "2023-01-01", "TST", "TEST", NA, NA, # nolint + "1001", "2", NA, "FIRSTACT", "First Anti-Cancer Therapy", lubridate::ymd("2021-12-25"), "ACS", # nolint + "1001", "3", NA, "FIRSTACT", "First Anti-Cancer Therapy", lubridate::ymd("2022-12-25"), "ACS" # nolint + ) + actual_output <- derive_param_extreme_record( + dataset = aevent, + sources = list( + records_source( + dataset_name = "pr", + filter = PRDECOD == "ACS", + new_vars = exprs( + ADT = convert_dtc_to_dt(PRSTDTC), + AVALC = PRDECOD + ) + ) + ), + source_datasets = list(pr = pr), + by_vars = exprs(STUDYID, USUBJID), + order = exprs(ADT), + mode = "first", + set_values_to = exprs( + PARAMCD = "FIRSTACT", + PARAM = "First Anti-Cancer Therapy" + ) + ) + + expect_dfs_equal(expected_output, actual_output, keys = c("USUBJID", "PARAMCD", "PARAM", "ADT", "AVALC")) # nolint +}) diff --git a/tests/testthat/test-derive_param_tte.R b/tests/testthat/test-derive_param_tte.R index ad9a490eae..f765a6f43b 100644 --- a/tests/testthat/test-derive_param_tte.R +++ b/tests/testthat/test-derive_param_tte.R @@ -332,9 +332,9 @@ test_that("derive_param_tte Test 4: error is issued if DTC variables specified f ## Test 5: by_vars parameter works correctly ---- test_that("derive_param_tte Test 5: by_vars parameter works correctly", { adsl <- tibble::tribble( - ~USUBJID, ~TRTSDT, ~EOSDT, - "01", ymd("2020-12-06"), ymd("2021-03-06"), - "02", ymd("2021-01-16"), ymd("2021-02-03") + ~USUBJID, ~TRTSDT, ~TRTEDT, ~EOSDT, + "01", ymd("2020-12-06"), ymd("2021-03-02"), ymd("2021-03-06"), + "02", ymd("2021-01-16"), ymd("2021-01-20"), ymd("2021-02-03") ) %>% mutate(STUDYID = "AB42") @@ -360,24 +360,24 @@ test_that("derive_param_tte Test 5: by_vars parameter works correctly", { ) ) - eos <- censor_source( + eot <- censor_source( dataset_name = "adsl", - date = EOSDT, + date = pmin(TRTEDT + days(10), EOSDT), censor = 1, set_values_to = exprs( - EVENTDESC = "END OF STUDY", + EVENTDESC = "END OF TRT", SRCDOM = "ADSL", - SRCVAR = "EOSDT" + SRCVAR = "TRTEDT" ) ) # 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" + ~USUBJID, ~ADT, ~CNSR, ~EVENTDESC, ~SRCDOM, ~SRCVAR, ~SRCSEQ, ~PARCAT2, ~PARAMCD, + "01", ymd("2021-01-01"), 0L, "AE", "AE", "AESTDTC", 3, "Flu", "TTAE2", + "02", ymd("2021-01-30"), 1L, "END OF TRT", "ADSL", "TRTEDT", NA, "Flu", "TTAE2", + "01", ymd("2021-03-04"), 0L, "AE", "AE", "AESTDTC", 2, "Cough", "TTAE1", + "02", ymd("2021-01-30"), 1L, "END OF TRT", "ADSL", "TRTEDT", NA, "Cough", "TTAE1" ) %>% # nolint end mutate( @@ -393,7 +393,7 @@ test_that("derive_param_tte Test 5: by_vars parameter works correctly", { by_vars = exprs(AEDECOD), start_date = TRTSDT, event_conditions = list(ttae), - censor_conditions = list(eos), + censor_conditions = list(eot), source_datasets = list(adsl = adsl, ae = ae), set_values_to = exprs( PARAMCD = paste0("TTAE", as.numeric(as.factor(AEDECOD))), @@ -651,7 +651,7 @@ test_that("derive_param_tte Test 9: errors if set_values_to contains invalid exp ) ), regexp = paste0( - "Assigning new variables failed!\n", + "Assigning variables failed!\n", "set_values_to = \\(\n", " PARAMCD = paste0\\(\"TTAE\", as.numeric\\(as.factor\\(AEDECOD\\)\\)\\)\n", " PARAM = past\\(\"Time to First\", AEDECOD, \"Adverse Event\"\\)\n", @@ -805,8 +805,9 @@ test_that("derive_param_tte Test 11: ensuring ADT is not NA because of missing s ) }) +# list_tte_source_objects ---- ## Test 12: error is issued if package does not exist ---- -test_that("derive_param_tte Test 12: error is issued if package does not exist", { +test_that("list_tte_source_objects Test 12: 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" @@ -814,7 +815,7 @@ test_that("derive_param_tte Test 12: error is issued if package does not exist", }) ## Test 13: expected objects produced ---- -test_that("derive_param_tte Test 13: expected objects produced", { +test_that("list_tte_source_objects Test 13: expected objects produced", { expected_output <- tibble::tribble( ~object, ~dataset_name, ~filter, ~date, ~censor, "ae_ser_event", "adae", quote(TRTEMFL == "Y" & AESER == "Y"), "ASTDT", 0, diff --git a/tests/testthat/test-derive_summary_records.R b/tests/testthat/test-derive_summary_records.R index 0620923f05..b61b82790f 100644 --- a/tests/testthat/test-derive_summary_records.R +++ b/tests/testthat/test-derive_summary_records.R @@ -1,6 +1,7 @@ -test_that("creates a new record for each group and new data frame retains grouping", { +## Test 1: creates new record per group and groups are retained ---- +test_that("derive_summary_records Test 1: creates new record per group and groups are retained", { # group --> 4 - input <- tibble(x = rep(1:4, each = 4), y = rep(1:2, each = 8), z = runif(16)) + input <- tibble::tibble(x = rep(1:4, each = 4), y = rep(1:2, each = 8), z = runif(16)) actual_output <- input %>% derive_summary_records( by_vars = exprs(x, y), @@ -12,15 +13,16 @@ test_that("creates a new record for each group and new data frame retains groupi expect_equal(dplyr::group_vars(actual_output), dplyr::group_vars(input)) }) -test_that("`fns` as inlined", { - input <- tibble(x = rep(1:2, each = 2), y = 9:12, z = 101:104) +## Test 2: `fns` as inlined ---- +test_that("derive_summary_records Test 2: `fns` as inlined", { + input <- tibble::tibble(x = rep(1:2, each = 2), y = 9:12, z = 101:104) actual_output <- derive_summary_records( input, by_vars = exprs(x), analysis_var = y, summary_fun = function(x) mean(x, na.rm = TRUE) ) - expected_output <- tibble( + expected_output <- tibble::tibble( x = rep(1:2, each = 3), y = c(9:10, 9.5, 11:12, 11.5), z = c(101:102, NA, 103:104, NA) @@ -29,8 +31,9 @@ test_that("`fns` as inlined", { expect_dfs_equal(actual_output, expected_output, keys = c("x", "y", "z")) }) -test_that("set new value to a derived record", { - input <- tibble(x = rep(1:2, each = 2), y = 9:12) +## Test 3: set new value to a derived record ---- +test_that("derive_summary_records Test 3: set new value to a derived record", { + input <- tibble::tibble(x = rep(1:2, each = 2), y = 9:12) actual_output <- derive_summary_records( input, by_vars = exprs(x), @@ -38,7 +41,7 @@ test_that("set new value to a derived record", { summary_fun = mean, set_values_to = exprs(z = "MEAN") ) - expected_output <- tibble( + expected_output <- tibble::tibble( x = rep(1:2, each = 3), y = c(9:10, 9.5, 11:12, 11.5), z = c(NA, NA, "MEAN", NA, NA, "MEAN") @@ -47,8 +50,9 @@ test_that("set new value to a derived record", { expect_dfs_equal(actual_output, expected_output, keys = c("x", "y", "z")) }) -test_that("check `set_values_to` mapping", { - input <- tibble(x = rep(1:4, each = 4), y = rep(1:2, each = 8), z = runif(16)) +## Test 4: check `set_values_to` mapping ---- +test_that("derive_summary_records Test 4: check `set_values_to` mapping", { + input <- tibble::tibble(x = rep(1:4, each = 4), y = rep(1:2, each = 8), z = runif(16)) actual_output <- input %>% derive_summary_records( by_vars = exprs(x, y), @@ -82,8 +86,9 @@ test_that("check `set_values_to` mapping", { expect_equal(actual_output$p2, tp2) }) -test_that("Filter record within `by_vars`", { - input <- tibble(x = c(rep(1:2, each = 2), 2), y = 9:13, z = c(1, 1, 2, 1, 1)) +## Test 5: Filter record within `by_vars` ---- +test_that("derive_summary_records Test 5: Filter record within `by_vars`", { + input <- tibble::tibble(x = c(rep(1:2, each = 2), 2), y = 9:13, z = c(1, 1, 2, 1, 1)) actual_output <- derive_summary_records( input, @@ -93,7 +98,7 @@ test_that("Filter record within `by_vars`", { filter = n() > 2, set_values_to = exprs(d = "MEAN") ) - expected_output <- tibble( + expected_output <- tibble::tibble( x = c(rep(1, 2), rep(2, 4)), y = c(9:13, 12), z = c(1, 1, 2, 1, 1, NA), @@ -110,7 +115,7 @@ test_that("Filter record within `by_vars`", { filter = z == 1, set_values_to = exprs(d = "MEAN") ) - expected_output <- tibble( + expected_output <- tibble::tibble( x = c(rep(1, 3), rep(2, 4)), y = c(9:10, 9.5, 11:13, 12.5), z = c(1, 1, NA, 2, 1, 1, NA), @@ -120,10 +125,10 @@ test_that("Filter record within `by_vars`", { expect_dfs_equal(actual_output, expected_output, keys = c("x", "y", "z")) }) -# Errors --- -test_that("Errors", { - input <- tibble(x = rep(1:4, each = 4), y = rep(1:2, each = 8), z = runif(16)) +## Test 6: Errors ---- +test_that("derive_summary_records Test 6: Errors", { + input <- tibble::tibble(x = rep(1:4, each = 4), y = rep(1:2, each = 8), z = runif(16)) # Is by_vars quosures/`exprs()` object? expect_error( diff --git a/tests/testthat/test-derive_var_anrind.R b/tests/testthat/test-derive_var_anrind.R index 6c6cb4fa58..3fe0f8a4eb 100644 --- a/tests/testthat/test-derive_var_anrind.R +++ b/tests/testthat/test-derive_var_anrind.R @@ -1,4 +1,7 @@ -test_that("two-sided reference ranges work", { +# derive_var_anrind --- + +## Test 1: two-sided reference ranges work ---- +test_that("derive_var_anrind Test 1: two-sided reference ranges work", { expected_output <- tibble::tribble( ~USUBJID, ~PARAMCD, ~ASEQ, ~AVAL, ~ANRLO, ~ANRHI, ~A1LO, ~A1HI, ~ANRIND, "P01", "PUL", 1, 70, 60, 100, 40, 110, "NORMAL", @@ -14,13 +17,37 @@ test_that("two-sided reference ranges work", { input <- select(expected_output, USUBJID:A1HI) expect_dfs_equal( - derive_var_anrind(input), + derive_var_anrind(input, use_a1hia1lo = TRUE), expected_output, keys = c("USUBJID", "PARAMCD", "ASEQ") ) }) -test_that("implicitly missing extreme ranges are supported", { +## Test 2: explicitly requesting to use `A1LO` and `A1HI` works ---- +test_that("derive_var_anrind Test 2: explicitly requesting to use `A1LO` and `A1HI` works", { + expected_output <- tibble::tribble( + ~USUBJID, ~PARAMCD, ~ASEQ, ~AVAL, ~ANRLO, ~ANRHI, ~A1LO, ~A1HI, ~ANRIND, + "P01", "PUL", 1, 69, 60, 100, 40, 110, "NORMAL", + "P01", "PUL", 2, 55, 60, 100, 40, 110, "LOW", + "P01", "PUL", 3, 60, 60, 100, 40, 110, "NORMAL", + "P01", "DIABP", 1, 102, 60, 80, 40, 90, "HIGH HIGH", + "P02", "PUL", 1, 107, 60, 100, 40, 110, "HIGH", + "P02", "PUL", 2, 100, 60, 100, 40, 110, "NORMAL", + "P02", "DIABP", 1, 51, 60, 80, 40, 90, "LOW", + "P03", "PUL", 1, 32, 60, 100, 40, 110, "LOW LOW", + "P03", "PUL", 2, 107, 60, 100, 40, 110, "HIGH" + ) + input <- select(expected_output, USUBJID:A1HI) + + expect_dfs_equal( + derive_var_anrind(input, use_a1hia1lo = TRUE), + expected_output, + keys = c("USUBJID", "PARAMCD", "ASEQ") + ) +}) + +## Test 3: implicitly missing extreme ranges are supported ---- +test_that("derive_var_anrind Test 3: implicitly missing extreme ranges are supported", { expected_output <- tibble::tribble( ~USUBJID, ~PARAMCD, ~ASEQ, ~AVAL, ~ANRLO, ~ANRHI, ~ANRIND, "P01", "PUL", 1, 70, 60, 100, "NORMAL", @@ -36,13 +63,14 @@ test_that("implicitly missing extreme ranges are supported", { input <- select(expected_output, USUBJID:ANRHI) expect_dfs_equal( - derive_var_anrind(input), + derive_var_anrind(input, use_a1hia1lo = FALSE), expected_output, keys = c("USUBJID", "PARAMCD", "ASEQ") ) }) -test_that("explicitly missing extreme ranges are supported", { +## Test 4: explicitly missing extreme ranges are supported ---- +test_that("derive_var_anrind Test 4: explicitly missing extreme ranges are supported", { expected_output <- tibble::tribble( ~USUBJID, ~PARAMCD, ~ASEQ, ~AVAL, ~ANRLO, ~ANRHI, ~A1LO, ~A1HI, ~ANRIND, "P01", "PUL", 1, 70, 60, 100, NA, NA, "NORMAL", @@ -58,13 +86,14 @@ test_that("explicitly missing extreme ranges are supported", { input <- select(expected_output, USUBJID:A1HI) expect_dfs_equal( - derive_var_anrind(input), + derive_var_anrind(input, use_a1hia1lo = TRUE), expected_output, keys = c("USUBJID", "PARAMCD", "ASEQ") ) }) -test_that("one-sided reference ranges work", { +## Test 5: one-sided reference ranges work ---- +test_that("derive_var_anrind Test 5: one-sided reference ranges work", { expected_output <- tibble::tribble( ~USUBJID, ~PARAMCD, ~ASEQ, ~AVAL, ~ANRLO, ~ANRHI, ~A1LO, ~A1HI, ~ANRIND, "P01", "PUL", 1, 101, NA, 100, NA, 120, "HIGH", @@ -80,13 +109,14 @@ test_that("one-sided reference ranges work", { input <- select(expected_output, USUBJID:A1HI) expect_dfs_equal( - derive_var_anrind(input), + derive_var_anrind(input, use_a1hia1lo = TRUE), expected_output, keys = c("USUBJID", "PARAMCD", "ASEQ") ) }) -test_that("missing `AVAL` is handled properly", { +## Test 6: missing `AVAL` is handled properly ---- +test_that("derive_var_anrind Test 6: missing `AVAL` is handled properly", { expected_output <- tibble::tribble( ~USUBJID, ~PARAMCD, ~ASEQ, ~AVAL, ~ANRLO, ~ANRHI, ~ANRIND, "P01", "PUL", 1, NA_real_, 60, 100, NA_character_ diff --git a/tests/testthat/test-derive_var_atoxgr.R b/tests/testthat/test-derive_var_atoxgr.R index fa62b54e19..7c876c96d9 100644 --- a/tests/testthat/test-derive_var_atoxgr.R +++ b/tests/testthat/test-derive_var_atoxgr.R @@ -1,4 +1,3 @@ - # ---- 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( diff --git a/tests/testthat/test-derive_var_basetype.R b/tests/testthat/test-derive_var_basetype.R index 237e84876b..e59fc3db8f 100644 --- a/tests/testthat/test-derive_var_basetype.R +++ b/tests/testthat/test-derive_var_basetype.R @@ -1,4 +1,6 @@ -test_that("records are duplicated across different `BASETYPE` values", { +# derive_var_basetype ---- +## Test 1: deprecation warning if function is called ---- +test_that("derive_var_basetype Test 1: deprecation warning if function is called", { input <- tibble::tribble( ~USUBJID, ~EPOCH, ~PARAMCD, ~ASEQ, ~AVAL, "P01", "RUN-IN", "PARAM01", 1, 10.0, @@ -39,19 +41,78 @@ test_that("records are duplicated across different `BASETYPE` values", { "P02", "OPEN-LABEL", "PARAM01", 4, 11.4, "OPEN-LABEL", "P02", "OPEN-LABEL", "PARAM01", 5, 10.8, "OPEN-LABEL", ) - actual_output <- derive_var_basetype( - dataset = input, - basetypes = rlang::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" - ) + expect_warning( + derive_var_basetype( + dataset = input, + basetypes = rlang::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" + ) + ), + class = "lifecycle_warning_deprecated" + ) +}) + +## Test 2: records are duplicated across different `BASETYPE` values ---- +test_that("derive_var_basetype Test 2: records are duplicated across different `BASETYPE` values", { + input <- tibble::tribble( + ~USUBJID, ~EPOCH, ~PARAMCD, ~ASEQ, ~AVAL, + "P01", "RUN-IN", "PARAM01", 1, 10.0, + "P01", "RUN-IN", "PARAM01", 2, 9.8, + "P01", "DOUBLE-BLIND", "PARAM01", 3, 9.2, + "P01", "DOUBLE-BLIND", "PARAM01", 4, 10.1, + "P01", "OPEN-LABEL", "PARAM01", 5, 10.4, + "P01", "OPEN-LABEL", "PARAM01", 6, 9.9, + "P02", "RUN-IN", "PARAM01", 1, 12.1, + "P02", "DOUBLE-BLIND", "PARAM01", 2, 10.2, + "P02", "DOUBLE-BLIND", "PARAM01", 3, 10.8, + "P02", "OPEN-LABEL", "PARAM01", 4, 11.4, + "P02", "OPEN-LABEL", "PARAM01", 5, 10.8 + ) + expect_output <- tibble::tribble( + ~USUBJID, ~EPOCH, ~PARAMCD, ~ASEQ, ~AVAL, ~BASETYPE, + "P01", "RUN-IN", "PARAM01", 1, 10.0, "RUN-IN", + "P01", "RUN-IN", "PARAM01", 2, 9.8, "RUN-IN", + "P01", "DOUBLE-BLIND", "PARAM01", 3, 9.2, "RUN-IN", + "P01", "DOUBLE-BLIND", "PARAM01", 4, 10.1, "RUN-IN", + "P01", "OPEN-LABEL", "PARAM01", 5, 10.4, "RUN-IN", + "P01", "OPEN-LABEL", "PARAM01", 6, 9.9, "RUN-IN", + "P01", "DOUBLE-BLIND", "PARAM01", 3, 9.2, "DOUBLE-BLIND", + "P01", "DOUBLE-BLIND", "PARAM01", 4, 10.1, "DOUBLE-BLIND", + "P01", "OPEN-LABEL", "PARAM01", 5, 10.4, "DOUBLE-BLIND", + "P01", "OPEN-LABEL", "PARAM01", 6, 9.9, "DOUBLE-BLIND", + "P01", "OPEN-LABEL", "PARAM01", 5, 10.4, "OPEN-LABEL", + "P01", "OPEN-LABEL", "PARAM01", 6, 9.9, "OPEN-LABEL", + "P02", "RUN-IN", "PARAM01", 1, 12.1, "RUN-IN", + "P02", "DOUBLE-BLIND", "PARAM01", 2, 10.2, "RUN-IN", + "P02", "DOUBLE-BLIND", "PARAM01", 3, 10.8, "RUN-IN", + "P02", "OPEN-LABEL", "PARAM01", 4, 11.4, "RUN-IN", + "P02", "OPEN-LABEL", "PARAM01", 5, 10.8, "RUN-IN", + "P02", "DOUBLE-BLIND", "PARAM01", 2, 10.2, "DOUBLE-BLIND", + "P02", "DOUBLE-BLIND", "PARAM01", 3, 10.8, "DOUBLE-BLIND", + "P02", "OPEN-LABEL", "PARAM01", 4, 11.4, "DOUBLE-BLIND", + "P02", "OPEN-LABEL", "PARAM01", 5, 10.8, "DOUBLE-BLIND", + "P02", "OPEN-LABEL", "PARAM01", 4, 11.4, "OPEN-LABEL", + "P02", "OPEN-LABEL", "PARAM01", 5, 10.8, "OPEN-LABEL", + ) + actual_output <- suppress_warning( + derive_var_basetype( + dataset = input, + basetypes = rlang::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" + ) + ), + regexpr = "was deprecated" ) expect_dfs_equal(actual_output, expect_output, keys = c("USUBJID", "BASETYPE", "PARAMCD", "ASEQ")) }) -test_that("records that do not match any condition are kept", { +## Test 3: records that do not match any condition are kept ---- +test_that("derive_var_basetype Test 3: records that do not match any condition are kept", { input <- tibble::tribble( ~USUBJID, ~EPOCH, ~PARAMCD, ~ASEQ, ~AVAL, "P01", "SCREENING", "PARAM01", 1, 10.2, @@ -96,13 +157,16 @@ test_that("records that do not match any condition are kept", { "P02", "OPEN-LABEL", "PARAM01", 5, 11.4, "OPEN-LABEL", "P02", "OPEN-LABEL", "PARAM01", 6, 10.8, "OPEN-LABEL", ) - actual_output <- derive_var_basetype( - dataset = input, - basetypes = rlang::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" - ) + actual_output <- suppress_warning( + derive_var_basetype( + dataset = input, + basetypes = rlang::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" + ) + ), + regexpr = "was deprecated" ) expect_dfs_equal(actual_output, expect_output, keys = c("USUBJID", "BASETYPE", "PARAMCD", "ASEQ")) diff --git a/tests/testthat/test-derive_var_dthcaus.R b/tests/testthat/test-derive_var_dthcaus.R index 43f5868bd0..59ca13651d 100644 --- a/tests/testthat/test-derive_var_dthcaus.R +++ b/tests/testthat/test-derive_var_dthcaus.R @@ -33,17 +33,14 @@ test_that("derive_var_dthcaus Test 2: DTHCAUS is added from AE and DS", { "TEST01", "PAT01", 1, "INFORMED CONSENT OBTAINED", "INFORMED CONSENT OBTAINED", "2021-04-01", "TEST01", "PAT01", 2, "RANDOMIZATION", "RANDOMIZATION", "2021-04-11", "TEST01", "PAT01", 3, "ADVERSE EVENT", "ADVERSE EVENT", "2021-12-01", - "TEST01", "PAT01", 4, "DEATH", "DEATH DUE TO PROGRESSION OF DISEASE", "2022-02-01", + "TEST01", "PAT01", 4, "DEATH", "DEATH DUE TO progression of disease", "2022-02-01", "TEST01", "PAT02", 1, "INFORMED CONSENT OBTAINED", "INFORMED CONSENT OBTAINED", "2021-04-02", "TEST01", "PAT02", 2, "RANDOMIZATION", "RANDOMIZATION", "2021-04-11", "TEST01", "PAT02", 3, "COMPLETED", "PROTOCOL COMPLETED", "2021-12-01", "TEST01", "PAT03", 1, "INFORMED CONSENT OBTAINED", "INFORMED CONSENT OBTAINED", "2021-04-03", "TEST01", "PAT03", 2, "RANDOMIZATION", "RANDOMIZATION", "2021-04-11", "TEST01", "PAT03", 3, "COMPLETED", "PROTOCOL COMPLETED", "2021-12-01" - ) %>% - mutate( - DSSTDT = ymd(DSSTDTC) - ) + ) src_ae <- dthcaus_source( dataset_name = "ae", @@ -56,9 +53,9 @@ test_that("derive_var_dthcaus Test 2: DTHCAUS is added from AE and DS", { src_ds <- dthcaus_source( dataset_name = "ds", filter = DSDECOD == "DEATH" & grepl("DEATH DUE TO", DSTERM), - date = DSSTDT, + date = convert_dtc_to_dt(DSSTDTC), mode = "first", - dthcaus = DSTERM + dthcaus = str_to_upper(DSTERM) ) expected_output <- tibble::tribble( diff --git a/tests/testthat/test-derive_var_extreme_date.R b/tests/testthat/test-derive_var_extreme_date.R index 9c2e3b0825..de0317ad8c 100644 --- a/tests/testthat/test-derive_var_extreme_date.R +++ b/tests/testthat/test-derive_var_extreme_date.R @@ -125,7 +125,7 @@ test_that("derive_var_extreme_dt Test 3: `NA` dates are excluded", { test_that("derive_var_extreme_dtm Test 4: `LSTALVDTM` and traceability variables are derived", { ae_start <- date_source( dataset_name = "ae", - date = AESTDTM, + date = convert_dtc_to_dtm(AESTDTC), traceability_vars = exprs( LALVDOM = "AE", LALVSEQ = AESEQ, diff --git a/tests/testthat/test-derive_var_extreme_flag.R b/tests/testthat/test-derive_var_extreme_flag.R index 2a16525890..bc7cf0561c 100644 --- a/tests/testthat/test-derive_var_extreme_flag.R +++ b/tests/testthat/test-derive_var_extreme_flag.R @@ -81,105 +81,19 @@ test_that("last observation for each group is flagged", { ) }) -test_that("Derive worst flag works correctly", { - expected_output <- input_worst_flag %>% - mutate(WORSTFL = c( - "Y", NA, NA, "Y", "Y", "Y", NA, "Y", "Y", "Y", NA, - "Y", NA, "Y", "Y", "Y", NA, NA, "Y", "Y", "Y", "Y", - "Y", NA, NA - )) - - actual_output <- derive_var_worst_flag( - input_worst_flag, - by_vars = exprs(USUBJID, PARAMCD, AVISIT), - order = exprs(desc(ADT)), - new_var = WORSTFL, - param_var = PARAMCD, - analysis_var = AVAL, - worst_high = c("PARAM01", "PARAM03"), - worst_low = "PARAM02" - ) - - expect_dfs_equal(expected_output, - actual_output, - keys = c("STUDYID", "USUBJID", "PARAMCD", "AVISIT", "ADT") - ) -}) - -test_that("Derive worst flag works correctly with no worst_high option", { - expected_output <- input_worst_flag %>% - mutate(WORSTFL = c( - NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, - "Y", NA, "Y", "Y", "Y", NA, NA, "Y", "Y", NA, NA, - NA, NA, NA - )) - - actual_output <- derive_var_worst_flag( - input_worst_flag, - by_vars = exprs(USUBJID, PARAMCD, AVISIT), - order = exprs(ADT), - new_var = WORSTFL, - param_var = PARAMCD, - analysis_var = AVAL, - worst_high = character(0), - worst_low = "PARAM02" - ) - - expect_dfs_equal(expected_output, - actual_output, - keys = c("STUDYID", "USUBJID", "PARAMCD", "AVISIT", "ADT") - ) -}) - -test_that("Derive worst flag catches invalid parameters", { - expect_error( - derive_var_worst_flag( - input_worst_flag, - by_vars = exprs(USUBJID, PARAMCD, AVISIT), - order = exprs(ADT), - new_var = WORSTFL, - param_var = PARAMCD, - analysis_var = AVAL, - worst_high = character(0), - worst_low = c("A", "B") - ), - regexp = paste( - "^The following parameter\\(-s\\) in `worst_low`", - "are not available in column PARAMCD: A, B$" - ) - ) - - expect_error( - derive_var_worst_flag( - input_worst_flag, - new_var = WORSTFL, - by_vars = exprs(USUBJID, PARAMCD, AVISIT), - order = exprs(ADT), - param_var = PARAMCD, - analysis_var = AVAL, - worst_high = "A", - worst_low = character(0) - ), - regexp = paste( - "^The following parameter\\(-s\\) in `worst_high`", - "are not available in column PARAMCD: A$" - ) - ) - +## Test 7: An error is issued if `derive_var_worst_flag()` is called ---- +test_that("deprecation Test 7: An error is issued if Derive worst flag is called", { expect_error( derive_var_worst_flag( input_worst_flag, by_vars = exprs(USUBJID, PARAMCD, AVISIT), - order = exprs(ADT), + order = exprs(desc(ADT)), new_var = WORSTFL, param_var = PARAMCD, analysis_var = AVAL, - worst_high = c("A", "B", "C"), - worst_low = c("B", "C", "D") + worst_high = c("PARAM01", "PARAM03"), + worst_low = "PARAM02" ), - regexp = paste( - "^The following parameter\\(-s\\) are both assigned to `worst_high` and `worst_low`", - "flags: B, C$" - ) + class = "lifecycle_error_deprecated" ) }) diff --git a/tests/testthat/test-derive_var_last_dose_amt.R b/tests/testthat/test-derive_var_last_dose_amt.R index fd79f6e02d..96edd7e5f1 100644 --- a/tests/testthat/test-derive_var_last_dose_amt.R +++ b/tests/testthat/test-derive_var_last_dose_amt.R @@ -34,20 +34,20 @@ test_that("derive_var_last_dose_amt Test 1: works as expected", { input_ae, LDOSE = c(10, 10, 10, NA, 0, NA, NA) ) - - res <- derive_var_last_dose_amt( - input_ae, - input_ex, - filter_ex = (EXDOSE > 0) | (EXDOSE == 0 & EXTRT == "placebo"), - by_vars = exprs(STUDYID, USUBJID), - dose_date = EXENDT, - analysis_date = AESTDT, - new_var = LDOSE, - dose_var = EXDOSE, - single_dose_condition = (EXSTDTC == EXENDTC), - traceability_vars = NULL + suppressWarnings( + res <- derive_var_last_dose_amt( + input_ae, + input_ex, + filter_ex = (EXDOSE > 0) | (EXDOSE == 0 & EXTRT == "placebo"), + by_vars = exprs(STUDYID, USUBJID), + dose_date = EXENDT, + analysis_date = AESTDT, + new_var = LDOSE, + dose_var = EXDOSE, + single_dose_condition = (EXSTDTC == EXENDTC), + traceability_vars = NULL + ) ) - expect_dfs_equal(expected_output, res, keys = c("STUDYID", "USUBJID", "AESEQ", "AESTDTC")) }) @@ -60,19 +60,19 @@ test_that("derive_var_last_dose_amt Test 2: returns traceability vars", { LDOSEVAR = c("EXSTDTC", "EXSTDTC", "EXSTDTC", NA, "EXSTDTC", NA, NA), LDOSE = c(10, 10, 10, NA, 0, NA, NA) ) - - res <- derive_var_last_dose_amt( - input_ae, - input_ex, - filter_ex = (EXDOSE > 0) | (EXDOSE == 0 & EXTRT == "placebo"), - by_vars = exprs(STUDYID, USUBJID), - dose_date = EXENDT, - analysis_date = AESTDT, - new_var = LDOSE, - dose_var = EXDOSE, - single_dose_condition = (EXSTDTC == EXENDTC), - traceability_vars = exprs(LDOSEDOM = "EX", LDOSESEQ = EXSEQ, LDOSEVAR = "EXSTDTC") + suppressWarnings( + res <- derive_var_last_dose_amt( + input_ae, + input_ex, + filter_ex = (EXDOSE > 0) | (EXDOSE == 0 & EXTRT == "placebo"), + by_vars = exprs(STUDYID, USUBJID), + dose_date = EXENDT, + analysis_date = AESTDT, + new_var = LDOSE, + dose_var = EXDOSE, + single_dose_condition = (EXSTDTC == EXENDTC), + traceability_vars = exprs(LDOSEDOM = "EX", LDOSESEQ = EXSEQ, LDOSEVAR = "EXSTDTC") + ) ) - expect_dfs_equal(expected_output, res, keys = c("STUDYID", "USUBJID", "AESEQ", "AESTDTC")) }) diff --git a/tests/testthat/test-derive_var_last_dose_date.R b/tests/testthat/test-derive_var_last_dose_date.R index 18c9abc26e..380b4267ae 100644 --- a/tests/testthat/test-derive_var_last_dose_date.R +++ b/tests/testthat/test-derive_var_last_dose_date.R @@ -40,20 +40,20 @@ test_that("derive_var_last_dose_date Test 1: works as expected output_datetime = LDOSEDTM = as.Date(LDOSEDTM), AESTDT = ymd(AESTDTC) ) - - res <- derive_var_last_dose_date( - input_ae, - input_ex, - filter_ex = (EXDOSE > 0) | (EXDOSE == 0 & EXTRT == "placebo"), - by_vars = exprs(STUDYID, USUBJID), - dose_date = EXENDT, - analysis_date = AESTDT, - new_var = LDOSEDTM, - single_dose_condition = (EXSTDTC == EXENDTC), - output_datetime = FALSE, - traceability_vars = NULL + suppressWarnings( + res <- derive_var_last_dose_date( + input_ae, + input_ex, + filter_ex = (EXDOSE > 0) | (EXDOSE == 0 & EXTRT == "placebo"), + by_vars = exprs(STUDYID, USUBJID), + dose_date = EXENDT, + analysis_date = AESTDT, + new_var = LDOSEDTM, + single_dose_condition = (EXSTDTC == EXENDTC), + output_datetime = FALSE, + traceability_vars = NULL + ) ) - expect_dfs_equal(expected_output, res, keys = c("STUDYID", "USUBJID", "AESEQ", "AESTDTC")) }) @@ -73,20 +73,20 @@ test_that("derive_var_last_dose_date Test 2: works as expected with output_datet LDOSEDTM = as.POSIXct(as.character(LDOSEDTM), tz = "UTC"), AESTDT = ymd(AESTDTC) ) - - res <- derive_var_last_dose_date( - input_ae, - input_ex, - filter_ex = (EXDOSE > 0) | (EXDOSE == 0 & EXTRT == "placebo"), - by_vars = exprs(STUDYID, USUBJID), - dose_date = EXENDT, - analysis_date = AESTDT, - new_var = LDOSEDTM, - output_datetime = TRUE, - single_dose_condition = (EXSTDTC == EXENDTC), - traceability_vars = NULL + suppressWarnings( + res <- derive_var_last_dose_date( + input_ae, + input_ex, + filter_ex = (EXDOSE > 0) | (EXDOSE == 0 & EXTRT == "placebo"), + by_vars = exprs(STUDYID, USUBJID), + dose_date = EXENDT, + analysis_date = AESTDT, + new_var = LDOSEDTM, + output_datetime = TRUE, + single_dose_condition = (EXSTDTC == EXENDTC), + traceability_vars = NULL + ) ) - expect_dfs_equal(expected_output, res, keys = c("STUDYID", "USUBJID", "AESEQ", "AESTDTC")) }) @@ -109,19 +109,19 @@ test_that("derive_var_last_dose_date Test 3: returns traceability vars", { LDOSEVAR = c("EXENDTC", "EXENDTC", "EXENDTC", NA, "EXENDTC", NA, NA), AESTDT = ymd(AESTDTC) ) - - res <- derive_var_last_dose_date( - input_ae, - input_ex, - filter_ex = (EXDOSE > 0) | (EXDOSE == 0 & EXTRT == "placebo"), - by_vars = exprs(STUDYID, USUBJID), - dose_date = EXENDT, - analysis_date = AESTDT, - new_var = LDOSEDTM, - single_dose_condition = (EXSTDTC == EXENDTC), - output_datetime = TRUE, - traceability_vars = exprs(LDOSEDOM = "EX", LDOSESEQ = EXSEQ, LDOSEVAR = "EXENDTC") + suppressWarnings( + res <- derive_var_last_dose_date( + input_ae, + input_ex, + filter_ex = (EXDOSE > 0) | (EXDOSE == 0 & EXTRT == "placebo"), + by_vars = exprs(STUDYID, USUBJID), + dose_date = EXENDT, + analysis_date = AESTDT, + new_var = LDOSEDTM, + single_dose_condition = (EXSTDTC == EXENDTC), + output_datetime = TRUE, + traceability_vars = exprs(LDOSEDOM = "EX", LDOSESEQ = EXSEQ, LDOSEVAR = "EXENDTC") + ) ) - expect_dfs_equal(expected_output, res, keys = c("STUDYID", "USUBJID", "AESEQ", "AESTDTC")) }) diff --git a/tests/testthat/test-derive_var_last_dose_grp.R b/tests/testthat/test-derive_var_last_dose_grp.R index c4c9cd7fc3..380b4267ae 100644 --- a/tests/testthat/test-derive_var_last_dose_grp.R +++ b/tests/testthat/test-derive_var_last_dose_grp.R @@ -3,55 +3,125 @@ input_ae <- tibble::tribble( "my_study", "subject1", 1, "2020-01-02", "my_study", "subject1", 2, "2020-08-31", "my_study", "subject1", 3, "2020-10-10", + "my_study", "subject2", 1, "2019-05-15", "my_study", "subject2", 2, "2020-02-20", "my_study", "subject3", 1, "2020-03-02", "my_study", "subject4", 1, "2020-11-02" -) %>% - mutate( - AESTDT = ymd(AESTDTC) - ) +) %>% mutate( + AESTDT = ymd(AESTDTC) +) 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", - "my_study", "subject1", "2020-09-02", "2020-09-02", 3, 4, "treatment", - "my_study", "subject1", "2020-10-20", "2020-10-20", 4, 4, "treatment", - "my_study", "subject2", "2019-05-25", "2019-05-25", 1, 6, "placebo", - "my_study", "subject3", "2020-01-20", "2020-01-20", 2, 7, "placebo", - "my_study", "subject4", "2020-03-15", "2020-03-15", 1, 13, "treatment" + "my_study", "subject1", "2020-01-01", "2020-01-01", 1, 10, "treatment", + "my_study", "subject1", "2020-08-29", "2020-08-29", 2, 10, "treatment", + "my_study", "subject1", "2020-09-02", "2020-09-02", 3, 10, "treatment", + "my_study", "subject1", "2020-10-20", "2020-10-20", 4, 10, "treatment", + "my_study", "subject2", "2019-05-25", "2019-05-25", 1, 0, "placebo", + "my_study", "subject2", "2020-01-20", "2020-01-20", 2, 0, "placebo", + "my_study", "subject3", "2020-03-15", "2020-03-15", 1, 10, "treatment" ) %>% mutate(EXSTDT = as.Date(EXSTDTC), EXENDT = as.Date(EXENDTC)) -# derive_var_last_dose_grp -## Test 1: works as expected ---- -test_that("derive_var_last_dose_grp Test 1: works as expected", { +# derive_var_last_dose_date ---- +## Test 1: works as expected output_datetime = FALSE ---- +test_that("derive_var_last_dose_date Test 1: works as expected output_datetime = FALSE", { 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", - "my_study", "subject1", 3, "2020-10-10", "G1", - "my_study", "subject2", 2, "2020-02-20", "G2", - "my_study", "subject3", 1, "2020-03-02", "G2", - "my_study", "subject4", 1, "2020-11-02", "G3" + ~STUDYID, ~USUBJID, ~AESEQ, ~AESTDTC, ~LDOSEDTM, + "my_study", "subject1", 1, "2020-01-02", "2020-01-01", + "my_study", "subject1", 2, "2020-08-31", "2020-08-29", + "my_study", "subject1", 3, "2020-10-10", "2020-09-02", + "my_study", "subject2", 1, "2019-05-15", NA_character_, + "my_study", "subject2", 2, "2020-02-20", "2020-01-20", + "my_study", "subject3", 1, "2020-03-02", NA_character_, + "my_study", "subject4", 1, "2020-11-02", NA_character_ ) %>% mutate( + LDOSEDTM = as.Date(LDOSEDTM), AESTDT = ymd(AESTDTC) ) + suppressWarnings( + res <- derive_var_last_dose_date( + input_ae, + input_ex, + filter_ex = (EXDOSE > 0) | (EXDOSE == 0 & EXTRT == "placebo"), + by_vars = exprs(STUDYID, USUBJID), + dose_date = EXENDT, + analysis_date = AESTDT, + new_var = LDOSEDTM, + single_dose_condition = (EXSTDTC == EXENDTC), + output_datetime = FALSE, + traceability_vars = NULL + ) + ) + expect_dfs_equal(expected_output, res, keys = c("STUDYID", "USUBJID", "AESEQ", "AESTDTC")) +}) - res <- derive_var_last_dose_grp(input_ae, - input_ex, - filter_ex = (EXDOSE > 0) | (EXDOSE == 0 & EXTRT == "placebo"), - by_vars = exprs(STUDYID, USUBJID), - dose_date = EXENDT, - new_var = LDGRP, - grp_brks = c(1, 5, 10, 15), - grp_lbls = c("G1", "G2", "G3"), - dose_var = EXDOSE, - analysis_date = AESTDT, - single_dose_condition = (EXSTDTC == EXENDTC), - traceability_vars = NULL +## 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 <- 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", + "my_study", "subject1", 3, "2020-10-10", "2020-09-02 00:00:00", + "my_study", "subject2", 1, "2019-05-15", NA_character_, + "my_study", "subject2", 2, "2020-02-20", "2020-01-20 00:00:00", + "my_study", "subject3", 1, "2020-03-02", NA_character_, + "my_study", "subject4", 1, "2020-11-02", NA_character_ + ) %>% + mutate( + LDOSEDTM = as.POSIXct(as.character(LDOSEDTM), tz = "UTC"), + AESTDT = ymd(AESTDTC) + ) + suppressWarnings( + res <- derive_var_last_dose_date( + input_ae, + input_ex, + filter_ex = (EXDOSE > 0) | (EXDOSE == 0 & EXTRT == "placebo"), + by_vars = exprs(STUDYID, USUBJID), + dose_date = EXENDT, + analysis_date = AESTDT, + new_var = LDOSEDTM, + output_datetime = TRUE, + single_dose_condition = (EXSTDTC == EXENDTC), + traceability_vars = NULL + ) ) + expect_dfs_equal(expected_output, res, keys = c("STUDYID", "USUBJID", "AESEQ", "AESTDTC")) +}) +## Test 3: returns traceability vars ---- +test_that("derive_var_last_dose_date Test 3: returns traceability vars", { + 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", + "my_study", "subject1", 3, "2020-10-10", "2020-09-02 00:00:00", + "my_study", "subject2", 1, "2019-05-15", NA_character_, + "my_study", "subject2", 2, "2020-02-20", "2020-01-20 00:00:00", + "my_study", "subject3", 1, "2020-03-02", NA_character_, + "my_study", "subject4", 1, "2020-11-02", NA_character_ + ) %>% + mutate( + LDOSEDTM = as.POSIXct(as.character(LDOSEDTM), tz = "UTC"), + LDOSEDOM = c("EX", "EX", "EX", NA, "EX", NA, NA), + LDOSESEQ = c(1, 2, 3, NA, 2, NA, NA), + LDOSEVAR = c("EXENDTC", "EXENDTC", "EXENDTC", NA, "EXENDTC", NA, NA), + AESTDT = ymd(AESTDTC) + ) + suppressWarnings( + res <- derive_var_last_dose_date( + input_ae, + input_ex, + filter_ex = (EXDOSE > 0) | (EXDOSE == 0 & EXTRT == "placebo"), + by_vars = exprs(STUDYID, USUBJID), + dose_date = EXENDT, + analysis_date = AESTDT, + new_var = LDOSEDTM, + single_dose_condition = (EXSTDTC == EXENDTC), + output_datetime = TRUE, + traceability_vars = exprs(LDOSEDOM = "EX", LDOSESEQ = EXSEQ, LDOSEVAR = "EXENDTC") + ) + ) expect_dfs_equal(expected_output, res, keys = c("STUDYID", "USUBJID", "AESEQ", "AESTDTC")) }) diff --git a/tests/testthat/test-derive_var_relative_flag.R b/tests/testthat/test-derive_var_relative_flag.R index 9fa1d4bc66..139eb95a03 100644 --- a/tests/testthat/test-derive_var_relative_flag.R +++ b/tests/testthat/test-derive_var_relative_flag.R @@ -1,4 +1,3 @@ - ## 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( diff --git a/tests/testthat/test-derive_vars_aage.R b/tests/testthat/test-derive_vars_aage.R index 673c469bc9..0116ae8c83 100644 --- a/tests/testthat/test-derive_vars_aage.R +++ b/tests/testthat/test-derive_vars_aage.R @@ -11,8 +11,8 @@ test_that("derive_vars_aage Test 1: duration and unit variable are added", { }) # 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", { +## Test 2: derive_var_age_years works as expected when AGEU exists ---- +test_that("derive_var_age_years Test 2: derive_var_age_years works as expected when AGEU exists", { input <- tibble::tibble( AGE = c(12, 24, 36, 48, 60), AGEU = c("months", "months", "months", "months", "months") @@ -26,8 +26,10 @@ test_that("derive_var_age_years Test 2: derive_var_age_years works as expected", expect_dfs_equal(derive_var_age_years(input, AGE, new_var = AAGE), expected_output, keys = "AGE") }) -## Test 3: derive_var_age_years works as expected ---- -test_that("derive_var_age_years Test 3: derive_var_age_years works as expected", { +## Test 3: derive_var_age_years works as expected when AGEU doesn't exist and +## `age_unit` is used ---- +test_that("derive_var_age_years Test 3: derive_var_age_years works as expected + when AGEU doesn't exist and `age_unit` is used", { input <- tibble::tibble(AGE = c(12, 24, 36, 48, 60)) expected_output <- mutate( diff --git a/tests/testthat/test-derive_vars_dtm_to_dt.R b/tests/testthat/test-derive_vars_dtm_to_dt.R index 31d24df4fa..f1d79d68e2 100644 --- a/tests/testthat/test-derive_vars_dtm_to_dt.R +++ b/tests/testthat/test-derive_vars_dtm_to_dt.R @@ -1,4 +1,3 @@ - ## Test 1: multiple variables ---- test_that("derive_vars_dtm_to_dt Test 1: multiple variables", { input <- tibble::tribble( diff --git a/tests/testthat/test-derive_vars_last_dose.R b/tests/testthat/test-derive_vars_last_dose.R index fadbb85d09..e602aa20f6 100644 --- a/tests/testthat/test-derive_vars_last_dose.R +++ b/tests/testthat/test-derive_vars_last_dose.R @@ -35,19 +35,19 @@ test_that("derive_vars_last_dose Test 1: function works as expected", { EXDOSE = c(10, 10, 10, NA, 0, NA, NA), EXTRT = c("treatment", "treatment", "treatment", NA, "placebo", NA, NA) ) - - res <- derive_vars_last_dose( - input_ae, - input_ex, - filter_ex = (EXDOSE > 0) | (EXDOSE == 0 & EXTRT == "placebo"), - by_vars = exprs(STUDYID, USUBJID), - dose_date = EXENDT, - new_vars = exprs(EXDOSE, EXTRT, EXSEQ, EXENDT, EXSTDT), - analysis_date = AESTDT, - single_dose_condition = (EXSTDTC == EXENDTC), - traceability_vars = NULL + suppressWarnings( + res <- derive_vars_last_dose( + input_ae, + input_ex, + filter_ex = (EXDOSE > 0) | (EXDOSE == 0 & EXTRT == "placebo"), + by_vars = exprs(STUDYID, USUBJID), + dose_date = EXENDT, + new_vars = exprs(EXDOSE, EXTRT, EXSEQ, EXENDT, EXSTDT), + analysis_date = AESTDT, + single_dose_condition = (EXSTDTC == EXENDTC), + traceability_vars = NULL + ) ) - expect_dfs_equal(expected_output, res, keys = c("STUDYID", "USUBJID", "AESEQ", "AESTDTC")) }) @@ -65,7 +65,7 @@ test_that("derive_vars_last_dose Test 2: function checks validity of start and e ) ) - expect_error( + expect_warning( derive_vars_last_dose( input_ae, input_ex_wrong, @@ -76,7 +76,7 @@ test_that("derive_vars_last_dose Test 2: function checks validity of start and e single_dose_condition = (EXSTDTC == EXENDTC), traceability_vars = NULL ), - regexp = "Specified `single_dose_condition` is not satisfied." + class = "lifecycle_warning_deprecated" ) }) @@ -95,18 +95,19 @@ test_that("derive_vars_last_dose Test 3: function returns traceability vars", { LDOSESEQ = c(1, 2, 3, NA, 2, NA, NA), LDOSEVAR = c("EXSTDTC", "EXSTDTC", "EXSTDTC", NA, "EXSTDTC", NA, NA) ) - - res <- derive_vars_last_dose( - input_ae, - input_ex, - filter_ex = (EXDOSE > 0) | (EXDOSE == 0 & EXTRT == "placebo"), - by_vars = exprs(STUDYID, USUBJID), - dose_date = EXENDT, - analysis_date = AESTDT, - single_dose_condition = (EXSTDTC == EXENDTC), - traceability_vars = exprs(LDOSEDOM = "EX", LDOSESEQ = EXSEQ, LDOSEVAR = "EXSTDTC") + suppressWarnings( + res <- derive_vars_last_dose( + input_ae, + input_ex, + filter_ex = (EXDOSE > 0) | (EXDOSE == 0 & EXTRT == "placebo"), + by_vars = exprs(STUDYID, USUBJID), + dose_date = EXENDT, + analysis_date = AESTDT, + single_dose_condition = (EXSTDTC == EXENDTC), + new_vars = exprs(EXSTDTC, EXENDTC, EXENDT, EXSTDT, EXSEQ, EXDOSE, EXTRT), + traceability_vars = exprs(LDOSEDOM = "EX", LDOSESEQ = EXSEQ, LDOSEVAR = "EXSTDTC") + ) ) - expect_dfs_equal(expected_output, res, keys = c("STUDYID", "USUBJID", "AESEQ", "AESTDTC")) }) @@ -124,29 +125,25 @@ test_that("derive_vars_last_dose Test 4: function errors when multiple doses are ) ) - expected_output <- mutate( - input_ae, - EXSTDTC = c("2020-01-01", "2020-08-29", "2020-09-02", NA, "2020-01-20", NA, NA), - EXENDTC = c("2020-01-01", "2020-08-29", "2020-09-02", NA, "2020-01-20", NA, NA), - EXSTDT = ymd(EXSTDTC), - EXENDT = ymd(EXENDTC), - EXSEQ = c(1, 2, 3, NA, 3, NA, NA), - EXDOSE = c(10, 10, 10, NA, 0, NA, NA), - EXTRT = c("treatment", "treatment", "treatment", NA, "placebo", NA, NA) - ) - - expect_error( - derive_vars_last_dose( - input_ae, - input_ex_dup, - filter_ex = (EXDOSE > 0) | (EXDOSE == 0 & EXTRT == "placebo"), - by_vars = exprs(STUDYID, USUBJID), - dose_date = EXENDT, - analysis_date = AESTDT, - single_dose_condition = (EXSTDTC == EXENDTC), - traceability_vars = NULL + # single_dose_condition not part of `derive_vars_joined()` + expect_warning( + suppress_warning( + derive_vars_last_dose( + input_ae, + input_ex_dup, + filter_ex = (EXDOSE > 0) | (EXDOSE == 0 & EXTRT == "placebo"), + by_vars = exprs(STUDYID, USUBJID), + dose_date = EXENDT, + analysis_date = AESTDT, + single_dose_condition = (EXSTDTC == EXENDTC), + traceability_vars = NULL + ), + regexpr = paste( + "Dataset contains duplicate records with respect to", + "`STUDYID`, `USUBJID`, `tmp_obs_nr_1` and `EXENDT`" + ) ), - regexp = "Multiple doses exist for the same `dose_date`. Update `dose_id` to identify unique doses." # nolint + class = "lifecycle_warning_deprecated" ) }) @@ -171,20 +168,20 @@ test_that("derive_vars_last_dose Test 5: multiple doses on same date - dose_id s EXDOSE = c(10, 10, 10, NA, 0, NA, NA), EXTRT = c("treatment", "treatment", "treatment", NA, "placebo", NA, NA) ) - - res <- derive_vars_last_dose( - input_ae, - input_ex_dup, - filter_ex = (EXDOSE > 0) | (EXDOSE == 0 & EXTRT == "placebo"), - by_vars = exprs(STUDYID, USUBJID), - dose_date = EXENDT, - dose_id = exprs(EXSEQ), - new_vars = exprs(EXDOSE, EXTRT, EXSEQ, EXSTDT, EXENDT), - analysis_date = AESTDT, - single_dose_condition = (EXSTDTC == EXENDTC), - traceability_vars = NULL + suppressWarnings( + res <- derive_vars_last_dose( + input_ae, + input_ex_dup, + filter_ex = (EXDOSE > 0) | (EXDOSE == 0 & EXTRT == "placebo"), + by_vars = exprs(STUDYID, USUBJID), + dose_date = EXENDT, + dose_id = exprs(EXSEQ), + new_vars = exprs(EXDOSE, EXTRT, EXSEQ, EXSTDT, EXENDT), + analysis_date = AESTDT, + single_dose_condition = (EXSTDTC == EXENDTC), + traceability_vars = NULL + ) ) - expect_dfs_equal(expected_output, res, keys = c("STUDYID", "USUBJID", "AESEQ", "AESTDTC")) }) @@ -219,7 +216,7 @@ test_that("derive_vars_last_dose Test 6: error is issued if same variable is fou EXENDT = as.Date(EXENDTC) ) - expect_error( + expect_warning( derive_vars_last_dose( input_ae, input_ex, @@ -231,8 +228,7 @@ test_that("derive_vars_last_dose Test 6: error is issued if same variable is fou single_dose_condition = (EXSTDTC == EXENDTC), traceability_vars = NULL ), - "Variable(s) `EXSTDT` found in both datasets, cannot perform join", - fixed = TRUE + class = "lifecycle_warning_deprecated" ) }) @@ -256,14 +252,16 @@ test_that("derive_vars_last_dose Test 7: no error is raised when setting `dose_d (adex_single <- create_single_dose_dataset(adex)) expect_error( - derive_vars_last_dose( - adae, - adex_single, - by_vars = exprs(USUBJID), - dose_date = EXSTDT, - analysis_date = ASTDT, - new_vars = exprs(EXSTDT = ASTDT) + suppressWarnings( + derive_vars_last_dose( + adae, + adex_single, + by_vars = exprs(USUBJID), + dose_date = EXSTDT, + analysis_date = ASTDT, + new_vars = exprs(EXSTDT = ASTDT) + ) ), - NA + regexp = "Required variable `EXSTDT` is missing" ) }) diff --git a/tests/testthat/test-derive_vars_query.R b/tests/testthat/test-derive_vars_query.R index 6046d22c8d..0a08574866 100644 --- a/tests/testthat/test-derive_vars_query.R +++ b/tests/testthat/test-derive_vars_query.R @@ -3,14 +3,14 @@ test_that("derive_vars_query Test 1: Derive CQ and SMQ variables with two term levels", { # nolint start queries <- tibble::tribble( - ~VAR_PREFIX, ~QUERY_NAME, ~QUERY_ID, ~QUERY_SCOPE, ~QUERY_SCOPE_NUM, ~TERM_LEVEL, ~TERM_NAME, + ~PREFIX, ~GRPNAME, ~GRPID, ~SCOPE, ~SCOPEN, ~SRCVAR, ~TERMNAME, "CQ01", "Immune-Mediated Hepatitis (Diagnosis and Lab Abnormalities)", 20000008, "NARROW", 1, "AEDECOD", "ALANINE AMINOTRANSFERASE ABNORMAL", "CQ01", "Immune-Mediated Hepatitis (Diagnosis and Lab Abnormalities)", 20000008, "NARROW", 1, "AEDECOD", "AMMONIA ABNORMALL", "SMQ03", "Immune-Mediated Hypothyroidism", 20000161, "NARROW", 1, "AEDECOD", "BASEDOW'S DISEASE", "SMQ05", "Immune-Mediated Pneumonitis", NA, "NARROW", 1, "AEDECOD", "ALVEOLAR PROTEINOSIS", "CQ06", "Some query", 11111, NA, NA, "AELLT", "SOME TERM" ) %>% dplyr::mutate( - TERM_ID = as.integer(as.factor(.data$TERM_NAME)) + TERMID = as.integer(as.factor(.data$TERMNAME)) ) adae <- tibble::tribble( @@ -35,28 +35,28 @@ test_that("derive_vars_query Test 1: Derive CQ and SMQ variables with two term l expect_dfs_equal(expected_output, actual_output, keys = "USUBJID") }) -## Test 2: Derive when no unique key excluding `TERM_LEVEL` columns ---- -test_that("derive_vars_query Test 2: Derive when no unique key excluding `TERM_LEVEL` columns", { +## Test 2: Derive when no unique key excluding `SRCVAR` columns ---- +test_that("derive_vars_query Test 2: Derive when no unique key excluding `SRCVAR` columns", { query <- tibble::tribble( - ~VAR_PREFIX, ~QUERY_NAME, ~TERM_LEVEL, ~TERM_NAME, ~QUERY_ID, ~TERM_ID, - "CQ42", "My Query", "AEDECOD", "PTSI", 1, NA_real_, - "CQ42", "My Query", "AELLT", "LLTSI", 1, NA_real_ + ~PREFIX, ~GRPNAME, ~SRCVAR, ~TERMNAME, ~GRPID, ~TERMID, + "CQ42", "My Query", "AEDECOD", "PTSI", 1, NA_real_, + "CQ42", "My Query", "AELLT", "LLTSI", 1, NA_real_ ) my_ae <- tibble::tribble( - ~USUBJID, ~ASTDY, ~AEDECOD, ~AELLT, - "1", 1, "PTSI", "other", - "1", 2, "something", "LLTSI", - "1", 2, "PTSI", "LLTSI", - "1", 2, "something", "other" + ~USUBJID, ~ASTDY, ~AEDECOD, ~AELLT, + "1", 1, "PTSI", "other", + "1", 2, "something", "LLTSI", + "1", 2, "PTSI", "LLTSI", + "1", 2, "something", "other" ) expected_output <- tibble::tribble( - ~USUBJID, ~ASTDY, ~AEDECOD, ~AELLT, ~CQ42NAM, ~CQ42CD, - "1", 1, "PTSI", "other", "My Query", 1, - "1", 2, "something", "LLTSI", "My Query", 1, - "1", 2, "PTSI", "LLTSI", "My Query", 1, - "1", 2, "something", "other", NA_character_, NA_integer_ + ~USUBJID, ~ASTDY, ~AEDECOD, ~AELLT, ~CQ42NAM, ~CQ42CD, + "1", 1, "PTSI", "other", "My Query", 1, + "1", 2, "something", "LLTSI", "My Query", 1, + "1", 2, "PTSI", "LLTSI", "My Query", 1, + "1", 2, "something", "other", NA_character_, NA_integer_ ) actual_output <- derive_vars_query(my_ae, dataset_queries = query) @@ -67,9 +67,9 @@ test_that("derive_vars_query Test 2: Derive when no unique key excluding `TERM_L ## Test 3: Derive when an adverse event is in multiple baskets ---- test_that("derive_vars_query Test 3: Derive when an adverse event is in multiple baskets", { query <- tibble::tribble( - ~VAR_PREFIX, ~QUERY_NAME, ~TERM_LEVEL, ~TERM_NAME, ~QUERY_ID, ~TERM_ID, - "CQ40", "My Query 1", "AEDECOD", "PTSI", 1, NA_real_, - "CQ42", "My Query 2", "AELLT", "LLTSI", 2, NA_real_ + ~PREFIX, ~GRPNAME, ~SRCVAR, ~TERMNAME, ~GRPID, ~TERMID, + "CQ40", "My Query 1", "AEDECOD", "PTSI", 1, NA_real_, + "CQ42", "My Query 2", "AELLT", "LLTSI", 2, NA_real_ ) my_ae <- tibble::tribble( @@ -94,10 +94,10 @@ test_that("derive_vars_query Test 3: Derive when an adverse event is in multiple }) -## Test 4: Derive when no QUERY_ID or QUERY_SCOPE column ---- -test_that("derive_vars_query Test 4: Derive when no QUERY_ID or QUERY_SCOPE column", { +## Test 4: Derive when no GRPID or SCOPE column ---- +test_that("derive_vars_query Test 4: Derive when no GRPID or SCOPE column", { query <- tibble::tribble( - ~VAR_PREFIX, ~QUERY_NAME, ~TERM_LEVEL, ~TERM_NAME, ~TERM_ID, + ~PREFIX, ~GRPNAME, ~SRCVAR, ~TERMNAME, ~TERMID, "CQ42", "My Query", "AEDECOD", "PTSI", NA_real_, "CQ42", "My Query", "AELLT", "LLTSI", NA_real_ ) @@ -123,10 +123,10 @@ test_that("derive_vars_query Test 4: Derive when no QUERY_ID or QUERY_SCOPE colu expect_equal(expected_output, actual_output) }) -## Test 5: Derive decides between TERM_NAME and TERM_ID based on type ---- -test_that("derive_vars_query Test 5: Derive decides between TERM_NAME and TERM_ID based on type", { +## Test 5: Derive decides between TERMNAME and TERMID based on type ---- +test_that("derive_vars_query Test 5: Derive decides between TERMNAME and TERMID based on type", { query <- tibble::tribble( - ~VAR_PREFIX, ~QUERY_NAME, ~TERM_LEVEL, ~TERM_NAME, ~QUERY_ID, ~TERM_ID, + ~PREFIX, ~GRPNAME, ~SRCVAR, ~TERMNAME, ~GRPID, ~TERMID, "CQ40", "My Query 1", "AEDECOD", "PTSI", 1, NA, "CQ42", "My Query 2", "AELLTCD", NA_character_, 2, 1 ) @@ -159,96 +159,96 @@ test_that("derive_vars_query Test 5: Derive decides between TERM_NAME and TERM_I ## Test 6: assert_valid_queries checks ---- test_that("assert_valid_queries Test 6: assert_valid_queries checks", { query <- tibble::tribble( - ~VAR_PREFIX, ~QUERY_NAME, ~TERM_LEVEL, ~TERM_NAME, ~QUERY_ID, ~TERM_ID, + ~PREFIX, ~GRPNAME, ~SRCVAR, ~TERMNAME, ~GRPID, ~TERMID, "CQ40", "My Query 1", "AEDECOD", "PTSI", 1, NA, "CQ42", "My Query 2", "AELLTCD", NA_character_, 2, 1 ) expect_error( assert_valid_queries( - mutate(query, VAR_PREFIX = c("30", "55")), + mutate(query, PREFIX = c("30", "55")), "test" ), - regexp = "`VAR_PREFIX` in `test` must start with 2-3 letters.. Problem with `30` and `55`." + regexp = "`PREFIX` in `test` must start with 2-3 letters.. Problem with `30` and `55`." ) expect_error( assert_valid_queries( - mutate(query, VAR_PREFIX = c("AA", "BB")), + mutate(query, PREFIX = c("AA", "BB")), "test" ), - regexp = "`VAR_PREFIX` in `test` must end with 2-digit numbers. Issue with `AA` and `BB`." + regexp = "`PREFIX` in `test` must end with 2-digit numbers. Issue with `AA` and `BB`." ) expect_error( assert_valid_queries( - mutate(query, QUERY_NAME = c("", "A")), + mutate(query, GRPNAME = c("", "A")), "test" ), - regexp = "`QUERY_NAME` in `test` cannot be empty string or NA." + regexp = "`GRPNAME` in `test` cannot be empty string or NA." ) expect_error( assert_valid_queries( - mutate(query, QUERY_ID = as.character(QUERY_ID)), + mutate(query, GRPID = as.character(GRPID)), "test" ), - regexp = "`QUERY_ID` in `test` should be numeric." + regexp = "`GRPID` in `test` should be numeric." ) expect_error( assert_valid_queries( - mutate(query, QUERY_SCOPE = letters[1:2]), + mutate(query, SCOPE = letters[1:2]), "test" ), - regexp = "`QUERY_SCOPE` in `test` can only be 'BROAD', 'NARROW' or `NA`." + regexp = "`SCOPE` in `test` can only be 'BROAD', 'NARROW' or `NA`." ) expect_error( assert_valid_queries( - mutate(query, QUERY_SCOPE_NUM = 10:11), + mutate(query, SCOPEN = 10:11), "test" ), - regexp = "`QUERY_SCOPE_NUM` in `test` must be one of 1, 2, or NA. Issue with `10` and `11`." + regexp = "`SCOPEN` in `test` must be one of 1, 2, or NA. Issue with `10` and `11`." ) expect_error( assert_valid_queries( - mutate(query, TERM_NAME = c(NA, NA)), + mutate(query, TERMNAME = c(NA, NA)), "test" ), regexp = paste( - "Either `TERM_NAME` or `TERM_ID` need to be specified in `test`.", + "Either `TERMNAME` or `TERMID` need to be specified in `test`.", "They both cannot be NA or empty." ) ) expect_error( assert_valid_queries( - mutate(query, VAR_PREFIX = c("CQ40", "CQ40")), + mutate(query, PREFIX = c("CQ40", "CQ40")), "test" ), - regexp = "In `test`, `QUERY_NAME` of 'CQ40' is not unique." + regexp = "In `test`, `GRPNAME` of 'CQ40' is not unique." ) expect_error( assert_valid_queries( mutate( query, - VAR_PREFIX = c("CQ40", "CQ40"), - QUERY_NAME = c("My Query 1", "My Query 1") + PREFIX = c("CQ40", "CQ40"), + GRPNAME = c("My Query 1", "My Query 1") ), "test" ), - regexp = "In `test`, `QUERY_ID` of 'CQ40' is not unique." + regexp = "In `test`, `GRPID` of 'CQ40' is not unique." ) expect_error( assert_valid_queries( mutate( query, - QUERY_SCOPE = c("BROAD", "NARROW"), - QUERY_SCOPE_NUM = c(1, 1) + SCOPE = c("BROAD", "NARROW"), + SCOPEN = c(1, 1) ), "test" ) diff --git a/tests/testthat/test-filter_exist.R b/tests/testthat/test-filter_exist.R new file mode 100644 index 0000000000..cc6df701ff --- /dev/null +++ b/tests/testthat/test-filter_exist.R @@ -0,0 +1,65 @@ +# filter_exist ---- +## Test 1: filter_exist() works as expected ---- +test_that("filter_exist Test 1: filter_exist() works as expected", { + input_dataset <- tibble::tribble( + ~USUBJID, ~AGE, ~SEX, + "01-701-1015", 63, "F", + "01-701-1034", 77, "F", + "01-701-1115", 84, "M", + "01-701-1444", 63, "M" + ) + + input_dataset_add <- tibble::tribble( + ~USUBJID, ~AEDECOD, ~AESTDTC, + "01-701-1015", "DIARRHOEA", "2014-01-09", + "01-701-1034", "APPLICATION SITE PRURITUS", "2014-08-27", + "01-701-1034", "FATIGUE", "2014-11-02", + "01-701-1115", "FATIGUE", "2013-01-14" + ) + + expected_output <- input_dataset %>% + filter(USUBJID %in% c("01-701-1034", "01-701-1115")) + + expect_equal( + filter_exist( + dataset = input_dataset, + dataset_add = input_dataset_add, + by_vars = exprs(USUBJID), + filter_add = AEDECOD == "FATIGUE" + ), + expected_output + ) +}) + +# filter_not_exist ---- +## Test 2: filter_not_exist() works as expected ---- +test_that("filter_not_exist Test 2: filter_not_exist() works as expected", { + input_dataset <- tibble::tribble( + ~USUBJID, ~AGE, ~SEX, + "01-701-1015", 63, "F", + "01-701-1034", 77, "F", + "01-701-1115", 84, "M", + "01-701-1444", 63, "M" + ) + + input_dataset_add <- tibble::tribble( + ~USUBJID, ~AEDECOD, ~AESTDTC, + "01-701-1015", "DIARRHOEA", "2014-01-09", + "01-701-1034", "APPLICATION SITE PRURITUS", "2014-08-27", + "01-701-1034", "FATIGUE", "2014-11-02", + "01-701-1115", "FATIGUE", "2013-01-14" + ) + + expected_output <- input_dataset %>% + filter(USUBJID %in% c("01-701-1015", "01-701-1444")) + + expect_equal( + filter_not_exist( + dataset = input_dataset, + dataset_add = input_dataset_add, + by_vars = exprs(USUBJID), + filter_add = AEDECOD == "FATIGUE" + ), + expected_output + ) +}) diff --git a/tests/testthat/test-period_dataset.R b/tests/testthat/test-period_dataset.R index 2df7e547e5..4ec4362a90 100644 --- a/tests/testthat/test-period_dataset.R +++ b/tests/testthat/test-period_dataset.R @@ -383,3 +383,41 @@ test_that("derive_vars_period Test 11: error if different type of LHSs", { fixed = TRUE ) }) + +## Test 12: DT and DTM columns exist, pulls only one unique col ---- +test_that("create_period_dataset Test 12: DT and DTM columns exist, pulls only one unique col", { + adsl <- tibble::tribble( + ~USUBJID, ~AP01SDT, ~AP01SDTM, ~AP01EDT, ~AP02SDT, ~AP02EDT, + "1", "2021-01-04", "2021-01-04T12:00:00", "2021-02-06", "2021-02-07", "2021-03-07", + "2", "2021-02-02", "2021-02-02T12:00:00", "2021-03-02", "2021-03-03", "2021-04-01" + ) %>% + mutate( + dplyr::across(matches("AP\\d\\d[ES]DT\\b"), ymd), + dplyr::across(matches("AP\\d\\d[ES]DTM"), ymd_hms), + ) %>% + 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 = exprs(APERSDT = APxxSDT, APEREDT = APxxEDT) + ), + keys = c("USUBJID", "APERIOD") + ) +}) diff --git a/tests/testthat/test-restrict_derivation.R b/tests/testthat/test-restrict_derivation.R index 8569f022ed..5c8eca4258 100644 --- a/tests/testthat/test-restrict_derivation.R +++ b/tests/testthat/test-restrict_derivation.R @@ -54,3 +54,30 @@ test_that("restrict_derivation Test 2: restrict derivation without parameters", keys = c("USUBJID", "AVISITN") ) }) + +## restrict_derivation Test 3: access functions from the parent environment ---- +test_that("restrict_derivation Test 3: access functions from the parent environment", { + my_derivation <- function(dataset, new_var) { + mutate( + dataset, + !!enexpr(new_var) := 42 + ) + } + + my_data <- tibble::tribble( + ~PARAMCD, + "A", + "B" + ) + + expect_silent({ + restrict_derivation( + my_data, + derivation = my_derivation, + args = params( + new_var = X + ), + filter = PARAMCD == "A" + ) + }) +}) diff --git a/tests/testthat/test-user_helpers.R b/tests/testthat/test-user_helpers.R index 755bf0047c..aadf6b59c1 100644 --- a/tests/testthat/test-user_helpers.R +++ b/tests/testthat/test-user_helpers.R @@ -2,7 +2,10 @@ test_that("all templates are listed", { expect_equal( unclass(list_all_templates()), - c("ADAE", "ADCM", "ADEG", "ADEX", "ADLB", "ADLBHY", "ADMH", "ADPC", "ADPP", "ADSL", "ADVS"), + c( + "ADAE", "ADCM", "ADEG", "ADEX", "ADLB", "ADLBHY", "ADMH", "ADPC", "ADPP", + "ADPPK", "ADSL", "ADVS" + ), ignore_attr = TRUE ) }) diff --git a/tests/testthat/test-user_utils.R b/tests/testthat/test-user_utils.R index 6b3ca9351c..66a8ed037d 100644 --- a/tests/testthat/test-user_utils.R +++ b/tests/testthat/test-user_utils.R @@ -167,11 +167,11 @@ test_that("print.source Test 14: `source` objects containing `source` objects", ## 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, + ~TERMNAME, ~TERMID, "APPLICATION SITE ERYTHEMA", 10003041L, "APPLICATION SITE PRURITUS", 10003053L ) %>% - mutate(TERM_LEVEL = "AEDECOD") + mutate(SRCVAR = "AEDECOD") cq <- query( prefix = "CQ01", @@ -185,10 +185,10 @@ test_that("print.source Test 15: `source` objects containing `data.frame`", { "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 " + " TERMNAME TERMID SRCVAR ", + " ", + "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( diff --git a/vignettes/admiral.Rmd b/vignettes/admiral.Rmd index 18f5e49759..7680f72ec4 100644 --- a/vignettes/admiral.Rmd +++ b/vignettes/admiral.Rmd @@ -149,7 +149,7 @@ The most important functions in `{admiral}` are the [derivations](../reference/index.html#derivations-for-adding-variables). Derivations add variables or observations to the input dataset. Existing variables and observations of the input dataset are not changed. Derivation -functions start with `derive_`. The first parameter of these functions expects +functions start with `derive_`. The first argument of these functions expects the input dataset. This allows us to string together derivations using the `%>%` operator. @@ -180,17 +180,13 @@ input and return a vector. Usually these computation functions can not be used w example below: ```{r, eval=TRUE} -# Derive final lab visit date -ds_final_lab_visit <- ds %>% - filter(DSDECOD == "FINAL LAB VISIT") %>% - transmute(USUBJID, FINLABDT = convert_dtc_to_dt(DSSTDTC)) - -# Derive treatment variables +# Add the date of the final lab visit to ADSL adsl <- dm %>% - # Merge on final lab visit date derive_vars_merged( - dataset_add = ds_final_lab_visit, - by_vars = exprs(USUBJID) + dataset_add = ds, + by_vars = exprs(USUBJID), + new_vars = exprs(FINLABDT = convert_dtc_to_dt(DSSTDTC)), + filter_add = DSDECOD == "FINAL LAB VISIT" ) ``` @@ -201,21 +197,21 @@ dataset_vignette( ) ``` -# Parameters +# Arguments -For parameters which expect variable names or expressions of variable names, +For arguments which expect variable names or expressions of variable names, symbols or expressions must be specified rather than strings. -- For parameters which expect a single variable name, the name can be specified +- For arguments which expect a single variable name, the name can be specified without quotes and quotation, e.g. `new_var = TEMPBL` -- For parameters which expect one or more variable names, a list of symbols is +- For arguments which expect one or more variable names, a list of symbols is expected, e.g. `by_vars = exprs(PARAMCD, AVISIT)` -- For parameters which expect a single expression, the expression needs to be +- For arguments which expect a single expression, the expression needs to be passed "as is", e.g. `filter = PARAMCD == "TEMP"` -- For parameters which expect one or more expressions, a list of expressions is +- For arguments which expect one or more expressions, a list of expressions is expected, e.g. `order = exprs(AVISIT, desc(AESEV))` # Handling of Missing Values diff --git a/vignettes/adsl.Rmd b/vignettes/adsl.Rmd index 9b4585ac5d..8a3dfe50dd 100644 --- a/vignettes/adsl.Rmd +++ b/vignettes/adsl.Rmd @@ -125,7 +125,8 @@ and impute missing date or time components. Conversion and imputation is done by Example calls: ```{r eval=TRUE} -# impute start and end time of exposure to first and last respectively, do not impute date +# impute start and end time of exposure to first and last respectively, +# do not impute date ex_ext <- ex %>% derive_vars_dtm( dtc = EXSTDTC, @@ -196,10 +197,12 @@ dataset_vignette( The functions `derive_vars_dt()` and `derive_vars_merged()` can be used to derive a disposition date. First the character disposition date (`DS.DSSTDTC`) -is converted to a numeric date (`DSSTDT`) calling `derive_vars_dt()`. Then the -relevant disposition date is selected by adjusting the `filter_add` parameter. +is converted to a numeric date (`DSSTDT`) calling `derive_vars_dt()`. The `DS` +dataset is extended by the `DSSTDT` variable because the date is required by +other derivations, e.g., `RANDDT` as well. Then the relevant disposition date is +selected by adjusting the `filter_add` argument. -To derive the End of Study date (`EOSDT`), a call could be: +To add the End of Study date (`EOSDT`) to the input dataset, a call could be: ```{r eval=TRUE} # convert character date to numeric date without imputation @@ -218,37 +221,36 @@ adsl <- adsl %>% ) ``` +The `ds_ext` dataset: ```{r, eval=TRUE, echo=FALSE} dataset_vignette( - ds, - display_vars = exprs(USUBJID, DSCAT, DSDECOD, DSTERM, DSSTDTC), + ds_ext, + display_vars = exprs(USUBJID, DSCAT, DSDECOD, DSTERM, DSSTDT, DSSTDTC), filter = DSDECOD != "SCREEN FAILURE" ) ``` -We would get : - +The `adsl` dataset: ```{r, eval=TRUE, echo=FALSE} dataset_vignette(adsl, display_vars = exprs(USUBJID, EOSDT)) ``` -This call would return the input dataset with the column `EOSDT` added. -This function allows the user to impute partial dates as well. If imputation is needed and the date -is to be imputed to the first of the month, then set `date_imputation = "FIRST"`. +The `derive_vars_dt()` function allows to impute partial dates as well. If +imputation is needed and missing days are to be imputed to the first of the +month and missing months to the first month of the year, set `highest_imputation += "M"`. ### Disposition Status (e.g. `EOSSTT`) {#disposition_status} -The function `derive_var_merged_cat()` can be used to derive a disposition status at a specific -timepoint. The relevant disposition variable (`DS.DSDECOD`) is selected by adjusting the filter -parameter and used to derive `EOSSTT`. - -To derive the End of Study status (`EOSSTT`), the function expects a mapping derivation for the `cat_fun` argument. -The mapping derivation for the call below is +The function `derive_vars_merged()` can be used to derive the End of Study +status (`EOSSTT`) based on `DSCAT` and `DSDECOD` from `DS`. The relevant +observations are selected by adjusting the `filter_add` argument. A function +mapping `DSDECOD` values to `EOSSTT` values can be defined and used in the +`new_vars` argument. The mapping for the call below is -- `"NOT STARTED"` if `DSDECOD` is `"SCREEN FAILURE"` - `"COMPLETED"` if `DSDECOD == "COMPLETED"` -- `"DISCONTINUED"` if `DSDECOD` is not `"COMPLETED"` or `NA` -- `"ONGOING"` otherwise +- `NA_character_` if `DSDECOD` is `"SCREEN FAILURE"` +- `"DISCONTINUED"` otherwise Example function `format_eosstt()`: @@ -257,24 +259,23 @@ format_eosstt <- function(x) { case_when( x %in% c("COMPLETED") ~ "COMPLETED", x %in% c("SCREEN FAILURE") ~ NA_character_, - !is.na(x) ~ "DISCONTINUED", - TRUE ~ "ONGOING" + TRUE ~ "DISCONTINUED" ) } ``` -The customized mapping function `format_eosstt()` can now be passed to the main function: +The customized mapping function `format_eosstt()` can now be passed to the main +function. For subjects without a disposition event the end of study status is +set to `"ONGOING"` by specifying the `missing_values` argument. ```{r eval=TRUE} adsl <- adsl %>% - derive_var_merged_cat( + derive_vars_merged( dataset_add = ds, by_vars = exprs(STUDYID, USUBJID), filter_add = DSCAT == "DISPOSITION EVENT", - new_var = EOSSTT, - source_var = DSDECOD, - cat_fun = format_eosstt, - missing_value = "ONGOING" + new_vars = exprs(EOSSTT = format_eosstt(DSDECOD)), + missing_value = exprs(EOSSTT = "ONGOING") ) ``` @@ -284,21 +285,21 @@ dataset_vignette(adsl, display_vars = exprs(USUBJID, EOSDT, EOSSTT)) This call would return the input dataset with the column `EOSSTT` added. -If the derivation must be changed, the user can create his/her own function and pass it to -the `cat_fun` argument of the function (`cat_fun = new_mapping`) to map `DSDECOD` -to a suitable `EOSSTT` value. +If the derivation must be changed, the user can create his/her own function to +map `DSDECOD` to a suitable `EOSSTT` value. ### Disposition Reason(s) (e.g. `DCSREAS`, `DCSREASP`) {#disposition_reason} The main reason for discontinuation is usually stored in `DSDECOD` while `DSTERM` provides additional details regarding subject’s discontinuation (e.g., description of `"OTHER"`). -The function `derive_vars_merged()` can be used to derive a disposition reason (along with the details, if required) at a specific timepoint. -The relevant disposition variable(s) (`DS.DSDECOD`, `DS.DSTERM`) are selected by adjusting the filter parameter and used to derive the main reason (and details). - -To derive the End of Study reason(s) (`DCSREAS` and `DCSREASP`), the function will map +The function `derive_vars_merged()` can be used to derive a disposition reason +(along with the details, if required) at a specific timepoint. The relevant +observations are selected by adjusting the `filter_add` argument. -- `DCSREAS` as `DSDECOD`, and `DCSREASP` as `DSTERM` if `DSDECOD` is not `"COMPLETED"`, `"SCREEN FAILURE"`, or `NA`, `NA` otherwise +To derive the End of Study reason(s) (`DCSREAS` and `DCSREASP`), the function +will map `DCSREAS` as `DSDECOD`, and `DCSREASP` as `DSTERM` if `DSDECOD` is not +`"COMPLETED"`, `"SCREEN FAILURE"`, or `NA`, `NA` otherwise. ```{r} adsl <- adsl %>% @@ -306,7 +307,8 @@ adsl <- adsl %>% dataset_add = ds, by_vars = exprs(USUBJID), new_vars = exprs(DCSREAS = DSDECOD, DCSREASP = DSTERM), - filter_add = DSCAT == "DISPOSITION EVENT" & DSDECOD %notin% c("SCREEN FAILURE", "COMPLETED", NA) + filter_add = DSCAT == "DISPOSITION EVENT" & + !(DSDECOD %in% c("SCREEN FAILURE", "COMPLETED", NA)) ) ``` @@ -333,7 +335,8 @@ adsl <- adsl %>% dataset_add = ds, by_vars = exprs(USUBJID), new_vars = exprs(DCSREAS = DSDECOD), - filter_add = DSCAT == "DISPOSITION EVENT" & DSDECOD %notin% c("SCREEN FAILURE", "COMPLETED", NA) + filter_add = DSCAT == "DISPOSITION EVENT" & + DSDECOD %notin% c("SCREEN FAILURE", "COMPLETED", NA) ) %>% derive_vars_merged( dataset_add = ds, @@ -390,10 +393,11 @@ adsl <- adsl %>% dataset_vignette(adsl, display_vars = exprs(USUBJID, TRTEDT, DTHDTC, DTHDT, DTHFL)) ``` -This call would return the input dataset with the columns `DTHDT` added and, by default, the -associated date imputation flag (`DTHDTF`) populated with the controlled terminology outlined in -the ADaM IG for date imputations. -If the imputation flag is not required, the user must set the argument `flag_imputation` to "none". +This call would return the input dataset with the columns `DTHDT` added and, by +default, the associated date imputation flag (`DTHDTF`) populated with the +controlled terminology outlined in the ADaM IG for date imputations. If the +imputation flag is not required, the user must set the argument +`flag_imputation` to `"none"`. If imputation is needed and the date is to be imputed to the first day of the month/year the call would be: @@ -438,7 +442,7 @@ An example call to define the sources would be: src_ae <- dthcaus_source( dataset_name = "ae", filter = AEOUT == "FATAL", - date = AESTDTM, + date = convert_dtc_to_dtm(AESTDTC, highest_imputation = "M"), mode = "first", dthcaus = AEDECOD ) @@ -473,16 +477,11 @@ dataset_vignette( Once the sources are defined, the function `derive_var_dthcaus()` can be used to derive `DTHCAUS`: ```{r eval=TRUE} -ae_ext <- derive_vars_dtm( - ae, - dtc = AESTDTC, - new_vars_prefix = "AEST", - highest_imputation = "M", - flag_imputation = "none" -) - adsl <- adsl %>% - derive_var_dthcaus(src_ae, src_ds, source_datasets = list(ae = ae_ext, ds = ds_ext)) + derive_var_dthcaus( + src_ae, src_ds, + source_datasets = list(ae = ae, ds = ds_ext) + ) ``` ```{r, eval=TRUE, echo=FALSE} @@ -502,7 +501,7 @@ arguments: src_ae <- dthcaus_source( dataset_name = "ae", filter = AEOUT == "FATAL", - date = AESTDTM, + date = convert_dtc_to_dtm(AESTDTC, highest_imputation = "M"), mode = "first", dthcaus = AEDECOD, traceability_vars = exprs(DTHDOM = "AE", DTHSEQ = AESEQ) @@ -518,7 +517,10 @@ src_ds <- dthcaus_source( ) adsl <- adsl %>% select(-DTHCAUS) %>% # remove it before deriving it again - derive_var_dthcaus(src_ae, src_ds, source_datasets = list(ae = ae_ext, ds = ds_ext)) + derive_var_dthcaus( + src_ae, src_ds, + source_datasets = list(ae = ae, ds = ds_ext) + ) ``` ```{r, eval=TRUE, echo=FALSE} @@ -576,25 +578,24 @@ sources (`date_source()`) are correctly defined. - `dataset_name`: the name of the dataset where to search for date information, - `filter`: the filter to apply on the datasets, - `date`: the date of interest, -- `date_imputation`: whether and how to impute partial dates, - `traceability_vars`: whether the traceability variables need to be added (e.g source domain, sequence, variable) -An example could be : +An example could be (DTC dates are converted to numeric dates imputing missing +day and month to the first): ```{r eval=TRUE} ae_start_date <- date_source( dataset_name = "ae", - date = AESTDT + date = convert_dtc_to_dt(AESTDTC, highest_imputation = "M") ) ae_end_date <- date_source( dataset_name = "ae", - date = AEENDT + date = convert_dtc_to_dt(AEENDTC, highest_imputation = "M") ) lb_date <- date_source( dataset_name = "lb", - date = LBDT, - filter = !is.na(LBDT) + date = convert_dtc_to_dt(LBDTC, highest_imputation = "M") ) trt_end_date <- date_source( dataset_name = "adsl", @@ -606,32 +607,11 @@ Once the sources are defined, the function `derive_var_extreme_dt()` can be used to derive `LSTALVDT`: ```{r eval=TRUE} -# impute AE start and end date to first -ae_ext <- ae %>% - derive_vars_dt( - dtc = AESTDTC, - new_vars_prefix = "AEST", - highest_imputation = "M" - ) %>% - derive_vars_dt( - dtc = AEENDTC, - new_vars_prefix = "AEEN", - highest_imputation = "M" - ) - -# impute LB date to first -lb_ext <- derive_vars_dt( - lb, - dtc = LBDTC, - new_vars_prefix = "LB", - highest_imputation = "M" -) - adsl <- adsl %>% derive_var_extreme_dt( new_var = LSTALVDT, ae_start_date, ae_end_date, lb_date, trt_end_date, - source_datasets = list(ae = ae_ext, adsl = adsl, lb = lb_ext), + source_datasets = list(ae = ae, adsl = adsl, lb = lb), mode = "last" ) ``` @@ -650,18 +630,17 @@ Similarly to `dthcaus_source()`, the traceability variables can be added by spec ```{r eval=TRUE} ae_start_date <- date_source( dataset_name = "ae", - date = AESTDT, + date = convert_dtc_to_dt(AESTDTC, highest_imputation = "M"), traceability_vars = exprs(LALVDOM = "AE", LALVSEQ = AESEQ, LALVVAR = "AESTDTC") ) ae_end_date <- date_source( dataset_name = "ae", - date = AEENDT, + date = convert_dtc_to_dt(AEENDTC, highest_imputation = "M"), traceability_vars = exprs(LALVDOM = "AE", LALVSEQ = AESEQ, LALVVAR = "AEENDTC") ) lb_date <- date_source( dataset_name = "lb", - date = LBDT, - filter = !is.na(LBDT), + date = convert_dtc_to_dt(LBDTC, highest_imputation = "M"), traceability_vars = exprs(LALVDOM = "LB", LALVSEQ = LBSEQ, LALVVAR = "LBDTC") ) trt_end_date <- date_source( @@ -675,7 +654,7 @@ adsl <- adsl %>% derive_var_extreme_dt( new_var = LSTALVDT, ae_start_date, ae_end_date, lb_date, trt_end_date, - source_datasets = list(ae = ae_ext, adsl = adsl, lb = lb_ext), + source_datasets = list(ae = ae, adsl = adsl, lb = lb), mode = "last" ) ``` @@ -772,8 +751,6 @@ The following functions are helpful for many ADSL derivations: - `derive_vars_merged()` - Merge Variables from a Dataset to the Input Dataset - `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). diff --git a/vignettes/bds_exposure.Rmd b/vignettes/bds_exposure.Rmd index 48a11432ed..3d55b3925d 100644 --- a/vignettes/bds_exposure.Rmd +++ b/vignettes/bds_exposure.Rmd @@ -76,7 +76,6 @@ At this step, it may be useful to join `ADSL` to your `EX` domain as well. Only ```{r eval=TRUE} - adsl_vars <- exprs(TRTSDT, TRTSDTM, TRTEDT, TRTEDTM) adex <- derive_vars_merged( diff --git a/vignettes/bds_finding.Rmd b/vignettes/bds_finding.Rmd index 7ecc13d11b..e0aeaba5e2 100644 --- a/vignettes/bds_finding.Rmd +++ b/vignettes/bds_finding.Rmd @@ -80,7 +80,6 @@ At this step, it may be useful to join `ADSL` to your `VS` domain. Only the relevant `ADSL` variables would be added later. ```{r eval=TRUE} - adsl_vars <- exprs(TRTSDT, TRTEDT, TRT01A, TRT01P) advs <- derive_vars_merged( @@ -340,7 +339,6 @@ Similarly, for `ADEG`, the parameters `QTCBF` `QTCBS` and `QTCL` can be created with a function call. See example below for `PARAMCD` = `QTCF`. ```{r eval=FALSE} - adeg <- tibble::tribble( ~USUBJID, ~EGSTRESU, ~PARAMCD, ~AVAL, ~VISIT, "P01", "msec", "QT", 350, "CYCLE 1 DAY 1", @@ -389,7 +387,6 @@ When all `PARAMCD` have been derived and added to the dataset, the other informa from the look-up table (`PARAM`, `PARAMCAT1`,...) should be added. ```{r eval=TRUE} - # Derive PARAM and PARAMN advs <- derive_vars_merged( advs, @@ -579,7 +576,7 @@ dataset_vignette( ## Derive Baseline (`BASETYPE`, `ABLFL`, `BASE`, `BASEC`, `BNRIND`) {#baseline} -The `BASETYPE` should be derived using the function `derive_var_basetype()`. +The `BASETYPE` should be derived using the function `derive_basetype_records()`. The parameter `basetypes` of this function requires a named list of expression detailing how the `BASETYPE` should be assigned. Note, if a record falls into multiple expressions within the basetypes expression, a row will be produced for @@ -587,9 +584,9 @@ each `BASETYPE`. ```{r eval=TRUE} -advs <- derive_var_basetype( +advs <- derive_basetype_records( dataset = advs, - basetypes = rlang::exprs( + basetypes = exprs( "LAST: AFTER LYING DOWN FOR 5 MINUTES" = ATPTN == 815, "LAST: AFTER STANDING FOR 1 MINUTE" = ATPTN == 816, "LAST: AFTER STANDING FOR 3 MINUTES" = ATPTN == 817, @@ -755,7 +752,6 @@ For this example, we will assume we would like to choose the latest and highest value by `USUBJID`, `PARAMCD`, `AVISIT`, and `ATPT`. ```{r eval=TRUE} - advs <- restrict_derivation( advs, derivation = derive_var_extreme_flag, @@ -861,8 +857,8 @@ assigned: ```{r eval=TRUE} avalcat_lookup <- tibble::tribble( ~PARAMCD, ~AVALCA1N, ~AVALCAT1, - "HEIGHT", 1, ">140 cm", - "HEIGHT", 2, "<= 140 cm" + "HEIGHT", 1, ">140 cm", + "HEIGHT", 2, "<= 140 cm" ) format_avalcat1n <- function(param, aval) { diff --git a/vignettes/bds_tte.Rmd b/vignettes/bds_tte.Rmd index 455897f1ea..72b2452194 100644 --- a/vignettes/bds_tte.Rmd +++ b/vignettes/bds_tte.Rmd @@ -72,7 +72,8 @@ adsl <- admiral_adsl ae <- filter(ae, USUBJID %in% c("01-701-1015", "01-701-1023", "01-703-1086", "01-703-1096", "01-707-1037", "01-716-1024")) ``` -The following code creates a minimally viable ADAE dataset to be used throughout the following examples. +The following code creates a minimally viable ADAE dataset to be used throughout +the following examples. ```{r} adae <- ae %>% @@ -430,12 +431,12 @@ adsl <- adsl_bak # define censoring # observation_end <- censor_source( dataset_name = "adsl", - date = EOSDT, + date = pmin(TRTEDT + days(30), EOSDT), censor = 1, set_values_to = exprs( - EVNTDESC = "END OF STUDY", + EVNTDESC = "END OF TREATMENT", SRCDOM = "ADSL", - SRCVAR = "EOSDT" + SRCVAR = "TRTEDT" ) ) @@ -492,7 +493,10 @@ adaette <- call_derivation( ) ), dataset_adsl = adsl, - source_datasets = list(adsl = adsl, ae = adae), + source_datasets = list( + adsl = adsl, + ae = filter(adae, TRTEMFL == "Y") + ), censor_conditions = list(observation_end) ) ``` diff --git a/vignettes/generic.Rmd b/vignettes/generic.Rmd index 2ad249151a..b25515905b 100644 --- a/vignettes/generic.Rmd +++ b/vignettes/generic.Rmd @@ -133,20 +133,14 @@ intermediate additional dataframe would use `derive_vars_merged()` as follows. 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 +# Convert disposition character date to numeric date and +# join as randomization date to ADSL adsl_02 <- adsl_01 %>% derive_vars_merged( - dataset_add = ds_ext, + dataset_add = ds, filter_add = DSDECOD == "RANDOMIZED", by_vars = exprs(STUDYID, USUBJID), - new_vars = exprs(RANDDT = DSSTDT) + new_vars = exprs(RANDDT = convert_dtc_to_dt(DSSTDTC)) ) ``` @@ -158,20 +152,15 @@ 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 +# Convert exposure start date to numeric date without imputation, +# 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 = exprs(TRTSDT = EXSTDT), - order = exprs(EXSTDT, EXSEQ), + dataset_add = ex, + filter_add = (EXDOSE > 0 | (EXDOSE == 0 & str_detect(EXTRT, "PLACEBO"))) & + !is.na(TRTSDT), + new_vars = exprs(TRTSDT = convert_dtc_to_dt(EXSTDTC)), + order = exprs(TRTSDT, EXSEQ), mode = "first", by_vars = exprs(STUDYID, USUBJID) ) @@ -215,9 +204,7 @@ dataset_vignette( ``` 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 +join a user-defined lookup table as commonly used in BDS ADaMs or `derive_var_merged_summary()` to merge summarized values from the additional dataframe. @@ -249,6 +236,13 @@ The above mentioned randomization date variable (let's call it `RAND30DT` here) would use `derive_vars_joined()` as follows. ```{r eval=TRUE} +# 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 only for safety population patients adsl_05 <- adsl_04 %>% derive_vars_joined( @@ -312,17 +306,14 @@ 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 %>% +# Use a numeric version of severity for sorting with severe=1, moderate=2, mild=3 +ae_02 <- ae_01 %>% derive_vars_joined( - dataset_add = ae_ext, + dataset_add = ae_01, filter_add = AESTDY > 0, by_vars = exprs(USUBJID), - order = exprs(TEMP_SEVN), + order = exprs(as.integer(factor(AESEV, levels = c("SEVERE", "MODERATE", "MILD")))), new_vars = exprs(AENADSEV = AESEV), join_vars = exprs(AESTDY), filter_join = AESTDY.join < AESTDY, @@ -366,7 +357,10 @@ ae_03 <- ae_02 %>% derive_var_extreme_flag( new_var = AEHSEVFL, by_vars = exprs(USUBJID), - order = exprs(TEMP_SEVN, AESTDY, AESEQ), + order = exprs( + as.integer(factor(AESEV, levels = c("SEVERE", "MODERATE", "MILD"))), + AESTDY, AESEQ + ), mode = "first" ) ``` diff --git a/vignettes/hys_law.Rmd b/vignettes/hys_law.Rmd index d10eada683..db34b07a5b 100644 --- a/vignettes/hys_law.Rmd +++ b/vignettes/hys_law.Rmd @@ -130,7 +130,7 @@ hylaw_records %>% ## How to Create New Parameters and Rows {#newparams} -Using `derive_param_exist_flag()` you can create a variety of parameters for your final dataset with `AVAL = 1/0` for your specific Hy's Law analysis. Below is an example of how to indicate a potential Hy's Law event, with `PARAMCD` set as `"HYSLAW"` and `PARAM` set to `"ALT/AST >= 3xULN and BILI >= 2xULN"` for **each patient** using the flags from the prior dataset. This method allows for flexibility as well, if parameters for each visit was desired, you would add `AVISIT` and `ADT` to the `select()` and `subject_keys` lines as denoted from the following code. +Using `derive_param_exist_flag()` you can create a variety of parameters for your final dataset with `AVAL = 1/0` for your specific Hy's Law analysis. Below is an example of how to indicate a potential Hy's Law event, with `PARAMCD` set as `"HYSLAW"` and `PARAM` set to `"ALT/AST >= 3xULN and BILI >= 2xULN"` for **each patient** using the flags from the prior dataset. This method allows for flexibility as well, if parameters for each visit was desired, you would add `AVISIT` and `ADT` to the `select()` and `by_vars` lines as denoted from the following code. Additional modifications can be made such as: @@ -148,15 +148,16 @@ hylaw_records_fls <- hylaw_records %>% distinct() hylaw_params <- derive_param_exist_flag( - dataset_adsl = hylaw_records_pts_visits, + dataset_ref = hylaw_records_pts_visits, dataset_add = hylaw_records_fls, condition = CRIT1FL == "Y" & BILI_CRITFL == "Y", false_value = "N", missing_value = "N", - subject_keys = exprs(STUDYID, USUBJID, TRT01A), # add AVISIT, ADT for by visit + by_vars = exprs(STUDYID, USUBJID, TRT01A), # add AVISIT, ADT for by visit set_values_to = exprs( PARAMCD = "HYSLAW", - PARAM = "ALT/AST >= 3xULN and BILI >= 2xULN" + PARAM = "ALT/AST >= 3xULN and BILI >= 2xULN", + AVAL = yn_to_numeric(AVALC) ) ) ``` diff --git a/vignettes/lab_grading.Rmd b/vignettes/lab_grading.Rmd index f570c1b395..9a1b694e0b 100644 --- a/vignettes/lab_grading.Rmd +++ b/vignettes/lab_grading.Rmd @@ -41,9 +41,11 @@ The NCI-CTCAEv5 criteria can be found under the heading # Grading metadata -`{admiral}` will store a metadata data set with required variables and optional variables, the -optional variables are purely for transparency, and will contain detailed information about -the grading criteria. The required variables are those used by `{admiral}` to create the grade. +`{admiral}` will store a metadata data set for each set of grading criteria in the data folder of +`{admiral}`. Currently, we have `atoxgr_criteria_ctcv4()` for NCI-CTCAEv4 and `atoxgr_criteria_ctcv5()` +for NCI-CTCAEv5. Each metadata data set has required variables and optional variables, the optional +variables are purely for transparency, and will contain detailed information about the grading criteria. +The required variables are those used by `{admiral}` to create the grade. ## Structure of metadata set @@ -263,12 +265,11 @@ 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` or -`atoxgr_criteria_ctcv5`, 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} - atoxgr_criteria_ctcv4 %>% filter(!is.na(SI_UNIT_CHECK)) %>% dataset_vignette( @@ -389,7 +390,6 @@ For term "INR Increased" there is the following criteria:
```{r, eval=TRUE, echo=FALSE} - atoxgr_criteria_ctcv4 %>% filter(str_detect(TERM, "INR")) %>% dataset_vignette( @@ -519,11 +519,16 @@ atoxgr_criteria_ctcv5 %>% ## Assumptions made when grading +For terms "Alanine aminotransferase increased", "Alkaline phosphatase increased", +"Aspartate aminotransferase increased", "Blood bilirubin increased" and "GGT increased" the criteria +is dependent on the Baseline Value `BASE` being normal or abnormal. For `BASE` to be abnormal we compare +it with the Upper Limit of Normal (ULN) `ANRHI`, i.e. `BASE > ANRHI`. +This means if `BASE` is abnormal then the grade is always zero for the baseline observation. + For term "INR Increased" there is the following criteria:
```{r, eval=TRUE, echo=FALSE} - atoxgr_criteria_ctcv5 %>% filter(str_detect(TERM, "INR")) %>% dataset_vignette( @@ -548,9 +553,8 @@ Similarly, for terms "Lipase Increased" and "Serum amylase increased" there is t
```{r, eval=TRUE, echo=FALSE} - atoxgr_criteria_ctcv5 %>% - filter(str_detect(TERM, "INR") | str_detect(TERM, "amylase")) %>% + filter(str_detect(TERM, "Lipase") | str_detect(TERM, "amylase")) %>% dataset_vignette( display_vars = exprs(TERM, Grade_2, Grade_3, Grade_4) ) diff --git a/vignettes/occds.Rmd b/vignettes/occds.Rmd index 3bead5a961..104a9c8405 100644 --- a/vignettes/occds.Rmd +++ b/vignettes/occds.Rmd @@ -73,7 +73,6 @@ At this step, it may be useful to join `ADSL` to your `AE` domain as well. Only relevant `ADSL` variables would be added later. ```{r eval=TRUE} - adsl_vars <- exprs(TRTSDT, TRTEDT, TRT01A, TRT01P, DTHDT, EOSDT) adae <- derive_vars_merged( @@ -226,11 +225,7 @@ vignette](visits_periods.html#treatment_bds). ## Derive Date/Date-time of Last Dose {#last_dose} -The function `derive_var_last_dose_date()` can be used to derive the last dose date before the start of the event. - -Additionally, this function can also provide traceability variables -(e.g. `LDOSEDOM`, `LDOSESEQ`) using the `traceability_vars` argument. - +The function `derive_vars_joined()` can be used to derive the last dose date before the start of the event. ```{r eval=TRUE} data(ex_single) @@ -240,17 +235,18 @@ ex_single <- derive_vars_dtm( new_vars_prefix = "EXST", flag_imputation = "none" ) -adae <- adae %>% - derive_var_last_dose_date( - ex_single, - filter_ex = (EXDOSE > 0 | (EXDOSE == 0 & grepl("PLACEBO", EXTRT))) & - !is.na(EXSTDTM), - dose_date = EXSTDTM, - analysis_date = ASTDT, - single_dose_condition = (EXSTDTC == EXENDTC), - new_var = LDOSEDTM, - output_datetime = TRUE - ) + +adae <- derive_vars_joined( + adae, + ex_single, + by_vars = exprs(STUDYID, USUBJID), + new_vars = exprs(LDOSEDTM = EXSTDTM), + join_vars = exprs(EXSTDTM), + order = exprs(EXSTDTM), + filter_add = (EXDOSE > 0 | (EXDOSE == 0 & grepl("PLACEBO", EXTRT))) & !is.na(EXSTDTM), + filter_join = EXSTDTM <= ASTDTM, + mode = "last" +) ``` ```{r, eval=TRUE, echo=FALSE} @@ -361,8 +357,8 @@ derive_var_ontrtfl( ## Derive Occurrence Flags {#occflag} -The function `derive_var_extreme_flag()` can help derive variables such as `AOCCIFL`, -`AOCCPIFL`, `AOCCSIFL`, `AOCXIFL`, `AOCXPIFL`, and `AOCXSIFL`. +The function `derive_var_extreme_flag()` can help derive variables such as +`AOCCIFL`, `AOCCPIFL`, `AOCCSIFL`, and `AOCCzzFL`. If grades were collected, the following can be used to flag first occurrence of maximum toxicity grade. @@ -387,14 +383,17 @@ Flag first occurrence of most severe adverse event: ```{r, eval=TRUE} adae <- adae %>% - mutate( - ASEVN = as.integer(factor(ASEV, levels = c("MILD", "MODERATE", "SEVERE", "DEATH THREATENING"))) - ) %>% restrict_derivation( derivation = derive_var_extreme_flag, args = params( by_vars = exprs(USUBJID), - order = exprs(desc(ASEVN), ASTDTM, AESEQ), + order = exprs( + as.integer(factor( + ASEV, + levels = c("DEATH THREATENING", "SEVERE", "MODERATE", "MILD") + )), + ASTDTM, AESEQ + ), new_var = AOCCIFL, mode = "first" ), @@ -406,8 +405,7 @@ adae <- adae %>% dataset_vignette( adae, display_vars = exprs( - USUBJID, ASTDTM, ASEV, ASEVN, AESEQ, TRTEMFL, - AOCCIFL + USUBJID, ASTDTM, ASEV, AESEQ, TRTEMFL, AOCCIFL ) ) ``` @@ -457,12 +455,12 @@ Standardized Drug Groupings (SDG). ```{r, eval=TRUE} sdg <- tibble::tribble( - ~VAR_PREFIX, ~QUERY_NAME, ~SDG_ID, ~QUERY_SCOPE, ~QUERY_SCOPE_NUM, ~TERM_LEVEL, ~TERM_NAME, ~TERM_ID, - "SDG01", "Diuretics", 11, "BROAD", 1, "CMDECOD", "Diuretic 1", NA, - "SDG01", "Diuretics", 11, "BROAD", 1, "CMDECOD", "Diuretic 2", NA, - "SDG02", "Costicosteroids", 12, "BROAD", 1, "CMDECOD", "Costicosteroid 1", NA, - "SDG02", "Costicosteroids", 12, "BROAD", 1, "CMDECOD", "Costicosteroid 2", NA, - "SDG02", "Costicosteroids", 12, "BROAD", 1, "CMDECOD", "Costicosteroid 3", NA, + ~PREFIX, ~GRPNAME, ~GRPID, ~SCOPE, ~SCOPEN, ~SRCVAR, ~TERMNAME, ~TERMID, + "SDG01", "Diuretics", 11, "BROAD", 1, "CMDECOD", "Diuretic 1", NA, + "SDG01", "Diuretics", 11, "BROAD", 1, "CMDECOD", "Diuretic 2", NA, + "SDG02", "Costicosteroids", 12, "BROAD", 1, "CMDECOD", "Costicosteroid 1", NA, + "SDG02", "Costicosteroids", 12, "BROAD", 1, "CMDECOD", "Costicosteroid 2", NA, + "SDG02", "Costicosteroids", 12, "BROAD", 1, "CMDECOD", "Costicosteroid 3", NA, ) adcm <- tibble::tribble( ~USUBJID, ~ASTDTM, ~CMDECOD, diff --git a/vignettes/pk_adnca.Rmd b/vignettes/pk_adnca.Rmd index 79a29f2c87..df24f633f8 100644 --- a/vignettes/pk_adnca.Rmd +++ b/vignettes/pk_adnca.Rmd @@ -1,9 +1,9 @@ --- -title: "Creating a PK NCA ADaM (ADPC/ADNCA)" +title: "Creating a PK NCA or Population PK ADaM" output: rmarkdown::html_vignette vignette: > - %\VignetteIndexEntry{Creating a PK NCA ADaM (ADPC/ADNCA)} + %\VignetteIndexEntry{Creating a PK NCA or Population PK ADaM} %\VignetteEncoding{UTF-8} %\VignetteEngine{knitr::rmarkdown} editor_options: @@ -23,8 +23,16 @@ library(admiraldev) # Introduction This article describes creating a Pharmacokinetics (PK) -Non-compartmental analysis (NCA) ADaM (ADNCA/ADPC) using the CDISC -Implementation Guide +Non-compartmental analysis (NCA) ADaM (ADNCA/ADPC) or a Population PK +ADaM (ADPPK). The first part of the article describes the NCA file +creation while the second part describes Population PK. This initial +steps for both files are very similar and could be combined in one +script if desired. + +# Programming PK NCA (ADPC/ADNCA) Analysis Data + +The Non-compartmental analysis (NCA) ADaM uses the CDISC Implementation +Guide (). This example presented uses underlying `EX` and `PC` domains where the `EX` and `PC` domains represent data as collected and the `ADPC` ADaM is @@ -55,13 +63,13 @@ the names in the CDISC Implementation Guide. **Note**: *All examples assume CDISC SDTM and/or ADaM format as input unless otherwise specified.* -# Programming Workflow +# `ADPC` Programming Workflow - [Read in Data](#readdata) - [Expand Dosing Records](#expand) -- [Find First Dose and Calculate `AFRLT`](#firstdose) +- [Find First Dose](#firstdose) - [Find Reference Dose Dates Corresponding to PK Records](#dosedates) @@ -107,6 +115,7 @@ data("admiral_adsl") data("admiral_ex") data("admiral_pc") data("admiral_vs") +data("admiral_lb") adsl <- admiral_adsl ex <- convert_blanks_to_na(admiral_ex) @@ -119,6 +128,11 @@ pc <- convert_blanks_to_na(admiral_pc) vs <- convert_blanks_to_na(admiral_vs) +# Load LB for baseline lab values + +lb <- convert_blanks_to_na(admiral_lb) %>% + filter(LBBLFL == "Y") + # ---- Lookup tables ---- param_lookup <- tibble::tribble( ~PCTESTCD, ~PARAMCD, ~PARAM, ~PARAMN, @@ -128,8 +142,12 @@ param_lookup <- tibble::tribble( ``` ```{r echo=FALSE} -ex <- filter(ex, USUBJID %in% c("01-701-1028", "01-701-1033", "01-701-1442", "01-714-1288", "01-718-1101")) -pc <- filter(pc, USUBJID %in% c("01-701-1028", "01-701-1033", "01-701-1442", "01-714-1288", "01-718-1101")) +ex <- filter(ex, USUBJID %in% c( + "01-701-1028", "01-701-1033", "01-701-1442", "01-714-1288", "01-718-1101" +)) +pc <- filter(pc, USUBJID %in% c( + "01-701-1028", "01-701-1033", "01-701-1442", "01-714-1288", "01-718-1101" +)) ``` At this step, it may be useful to join `ADSL` to your `PC` and `EX` @@ -150,10 +168,9 @@ is a traditional variable that will provide a handy tool to identify records but will be dropped from the final dataset in this example. ```{r eval=TRUE} - adsl_vars <- exprs(TRTSDT, TRTSDTM, TRT01P, TRT01A) -adpc <- pc %>% +pc_dates <- pc %>% # Join ADSL with PC (need TRTSDT for ADY derivation) derive_vars_merged( dataset_add = adsl, @@ -181,7 +198,7 @@ adpc <- pc %>% ```{r, eval=TRUE, echo=FALSE} dataset_vignette( - adpc, + pc_dates, display_vars = exprs( USUBJID, PCTEST, ADTM, VISIT, PCTPT, NFRLT ) @@ -197,10 +214,9 @@ times may be used based on study details. Here we create `NFRLT` for using `dplyr::mutate`. ```{r eval=TRUE, echo=TRUE} - # ---- Get dosing information ---- -ex <- ex %>% +ex_dates <- ex %>% derive_vars_merged( dataset_add = adsl, new_vars = adsl_vars, @@ -239,7 +255,7 @@ ex <- ex %>% ```{r, eval=TRUE, echo=FALSE} dataset_vignette( - ex, + ex_dates, display_vars = exprs( USUBJID, EXTRT, EXDOSFRQ, ASTDTM, AENDTM, VISIT, VISITDY, NFRLT ) @@ -269,7 +285,7 @@ final dataset in this example. ```{r eval=TRUE, echo=TRUE} # ---- Expand dosing records between start and end dates ---- -ex_exp <- ex %>% +ex_exp <- ex_dates %>% create_single_dose_dataset( dose_freq = EXDOSFRQ, start_date = ASTDT, @@ -282,8 +298,7 @@ ex_exp <- ex %>% keep_source_vars = exprs( STUDYID, USUBJID, EVID, EXDOSFRQ, EXDOSFRM, NFRLT, EXDOSE, EXDOSU, EXTRT, ASTDT, ASTDTM, AENDT, AENDTM, - VISIT, VISITNUM, VISITDY, - TRT01A, TRT01P, DOMAIN, EXSEQ, !!!adsl_vars + VISIT, VISITNUM, VISITDY, TRT01A, TRT01P, DOMAIN, EXSEQ, !!!adsl_vars ) ) %>% # Derive AVISIT based on nominal relative time @@ -306,11 +321,13 @@ ex_exp <- ex %>% ```{r, eval=TRUE, echo=FALSE} dataset_vignette( ex_exp, - display_vars = exprs(USUBJID, DRUG, EXDOSFRQ, ASTDTM, AENDTM, AVISIT, NFRLT) + display_vars = exprs( + USUBJID, DRUG, EXDOSFRQ, ASTDTM, AENDTM, AVISIT, NFRLT + ) ) ``` -## Find First Dose and Calculate `AFRLT` {#firstdose} +## Find First Dose {#firstdose} In this section we will find the first dose for each subject and drug, using `derive_vars_merged()`. We also create an analysis visit @@ -322,7 +339,7 @@ subject and drug. # ---- Find first dose per treatment per subject ---- # ---- Join with ADPC data and keep only subjects with dosing ---- -adpc <- adpc %>% +adpc_first_dose <- pc_dates %>% derive_vars_merged( dataset_add = ex_exp, filter_add = (EXDOSE > 0 & !is.na(ADTM)), @@ -337,14 +354,16 @@ adpc <- adpc %>% # Define AVISIT based on nominal day mutate( AVISITN = NFRLT %/% 24 + 1, - AVISIT = paste("Day", AVISITN), + AVISIT = paste("Day", AVISITN) ) ``` ```{r, eval=TRUE, echo=FALSE} dataset_vignette( - adpc, - display_vars = exprs(USUBJID, FANLDTM, AVISIT, ADTM, PCTPT) + adpc_first_dose, + display_vars = exprs( + USUBJID, FANLDTM, AVISIT, ADTM, PCTPT + ) ) ``` @@ -358,10 +377,8 @@ previous dose (`ADTM_prev)`, we also keep the actual dose amount ```{r eval=TRUE, echo=TRUE} # ---- Find previous dose ---- -# Use derive_vars_joined() for consistency with other variables -# This is equivalent to derive_vars_last_dose() in this case -adpc <- adpc %>% +adpc_prev <- adpc_first_dose %>% derive_vars_joined( dataset_add = ex_exp, by_vars = exprs(USUBJID), @@ -380,10 +397,9 @@ adpc <- adpc %>% ```{r, eval=TRUE, echo=FALSE} dataset_vignette( - adpc, + adpc_prev, display_vars = exprs( - USUBJID, - VISIT, ADTM, VISIT, PCTPT, ADTM_prev, EXDOSE_prev, AVISIT_prev + USUBJID, VISIT, ADTM, VISIT, PCTPT, ADTM_prev, EXDOSE_prev, AVISIT_prev ) ) ``` @@ -396,7 +412,7 @@ and the next analysis visit `AVISIT_next`. ```{r eval=TRUE, echo=TRUE} # ---- Find next dose ---- -adpc <- adpc %>% +adpc_next <- adpc_prev %>% derive_vars_joined( dataset_add = ex_exp, by_vars = exprs(USUBJID), @@ -415,7 +431,7 @@ adpc <- adpc %>% ```{r, eval=TRUE, echo=FALSE} dataset_vignette( - adpc, + adpc_next, display_vars = exprs( USUBJID, VISIT, ADTM, VISIT, PCTPT, ADTM_next, EXDOSE_next, AVISIT_next @@ -434,7 +450,7 @@ parameter uses the nominal relative times, e.g. `NFRLT > NFRLT.join`. ```{r eval=TRUE, echo=TRUE} # ---- Find previous nominal time ---- -adpc <- adpc %>% +adpc_nom_prev <- adpc_next %>% derive_vars_joined( dataset_add = ex_exp, by_vars = exprs(USUBJID), @@ -449,7 +465,7 @@ adpc <- adpc %>% # ---- Find next nominal time ---- -adpc <- adpc %>% +adpc_nom_next <- adpc_nom_prev %>% derive_vars_joined( dataset_add = ex_exp, by_vars = exprs(USUBJID), @@ -465,7 +481,7 @@ adpc <- adpc %>% ```{r, eval=TRUE, echo=FALSE} dataset_vignette( - adpc, + adpc_nom_next, display_vars = exprs( USUBJID, NFRLT, PCTPT, NFRLT_prev, NFRLT_next ) @@ -496,12 +512,10 @@ We calculate the maximum date for concentration records and only keep the dosing records up to that date. ```{r eval=TRUE, echo=TRUE} - # ---- Combine ADPC and EX data ---- # Derive Relative Time Variables - -adpc <- bind_rows(adpc, ex_exp) %>% +adpc_arrlt <- bind_rows(adpc_nom_next, ex_exp) %>% group_by(USUBJID, DRUG) %>% mutate( FANLDTM = min(FANLDTM, na.rm = TRUE), @@ -561,8 +575,10 @@ adpc <- bind_rows(adpc, ex_exp) %>% ```{r, eval=TRUE, echo=FALSE} dataset_vignette( - adpc, - display_vars = exprs(USUBJID, FANLDTM, AVISIT, PCTPT, AFRLT, ARRLT, AXRLT) + adpc_arrlt, + display_vars = exprs( + USUBJID, FANLDTM, AVISIT, PCTPT, AFRLT, ARRLT, AXRLT + ) ) ``` @@ -570,8 +586,7 @@ For nominal relative times we calculate `NRRLT` generally as `NFRLT - NFRLT_prev` and `NXRLT` as `NFRLT - NFRLT_next`. ```{r eval=TRUE, echo=TRUE} - -adpc <- adpc %>% +adpc_nrrlt <- adpc_arrlt %>% # Derive Nominal Relative Time from Reference Dose (NRRLT) mutate( NRRLT = case_when( @@ -588,8 +603,10 @@ adpc <- adpc %>% ```{r, eval=TRUE, echo=FALSE} dataset_vignette( - adpc, - display_vars = exprs(USUBJID, AVISIT, PCTPT, NFRLT, NRRLT, NXRLT) + adpc_nrrlt, + display_vars = exprs( + USUBJID, AVISIT, PCTPT, NFRLT, NRRLT, NXRLT + ) ) ``` @@ -629,7 +646,7 @@ variables. # Derive PARAMCD and relative time units # Derive AVAL, AVALU and AVALCAT1 -adpc <- adpc %>% +adpc_aval <- adpc_nrrlt %>% mutate( ATPTN = case_when( EVID == 1 ~ 0, @@ -656,7 +673,7 @@ adpc <- adpc %>% DOSEA = case_when( EVID == 1 ~ EXDOSE, is.na(EXDOSE_prev) ~ EXDOSE_next, - TRUE ~ EXDOSE_next + TRUE ~ EXDOSE_prev ), # Derive Planned Dose DOSEP = case_when( @@ -695,8 +712,10 @@ adpc <- adpc %>% ```{r, eval=TRUE, echo=FALSE} dataset_vignette( - adpc, - display_vars = exprs(USUBJID, NFRLT, AVISIT, ATPT, ABLFL, ATPTREF, AVAL, AVALCAT1) + adpc_aval, + display_vars = exprs( + USUBJID, NFRLT, AVISIT, ATPT, ABLFL, ATPTREF, AVAL, AVALCAT1 + ) ) ``` @@ -724,7 +743,7 @@ baseline for the "Day 2" dose. `DOSEA` is set to `EXDOSE_next` and ```{r eval=TRUE, echo=TRUE} # ---- Create DTYPE copy records ---- -dtype <- adpc %>% +dtype <- adpc_aval %>% filter(NFRLT > 0 & NXRLT == 0 & EVID == 0 & !is.na(AVISIT_next)) %>% select(-PCRFTDT, -PCRFTTM) %>% # Re-derive variables in for DTYPE copy records @@ -748,7 +767,9 @@ dtype <- adpc %>% ```{r, eval=TRUE, echo=FALSE} dataset_vignette( dtype, - display_vars = exprs(USUBJID, DTYPE, ATPT, NFRLT, NRRLT, AFRLT, ARRLT, BASETYPE) + display_vars = exprs( + USUBJID, DTYPE, ATPT, NFRLT, NRRLT, AFRLT, ARRLT, BASETYPE + ) ) ``` @@ -768,7 +789,7 @@ figures, etc. ```{r eval=TRUE, echo=TRUE} # ---- Combine original records and DTYPE copy records ---- -adpc <- bind_rows(adpc, dtype) %>% +adpc_dtype <- bind_rows(adpc_aval, dtype) %>% arrange(STUDYID, USUBJID, BASETYPE, ADTM, NFRLT) %>% mutate( # Derive MRRLT, ANL01FL and ANL02FL @@ -779,8 +800,10 @@ adpc <- bind_rows(adpc, dtype) %>% ``` ```{r, eval=TRUE, echo=FALSE} -adpc %>% - dataset_vignette(display_vars = exprs(STUDYID, USUBJID, BASETYPE, ADTM, ATPT, NFRLT, NRRLT, ARRLT, MRRLT)) +adpc_dtype %>% + dataset_vignette(display_vars = exprs( + STUDYID, USUBJID, BASETYPE, ADTM, ATPT, NFRLT, NRRLT, ARRLT, MRRLT + )) ``` ## Calculate Change from Baseline and Assign `ASEQ` {#aseq} @@ -795,10 +818,9 @@ intermediate variables such as those ending with "\_prev" and "\_next". Finally we derive `PARAM` and `PARAMN` from a lookup table. ```{r eval=TRUE, echo=TRUE} - # ---- Derive BASE and Calculate Change from Baseline ---- -adpc <- adpc %>% +adpc_base <- adpc_dtype %>% # Derive BASE derive_var_base( by_vars = exprs(STUDYID, USUBJID, PARAMCD, BASETYPE), @@ -807,11 +829,11 @@ adpc <- adpc %>% filter = ABLFL == "Y" ) -adpc <- derive_var_chg(adpc) +adpc_chg <- derive_var_chg(adpc_base) # ---- Add ASEQ ---- -adpc <- adpc %>% +adpc_aseq <- adpc_chg %>% # Calculate ASEQ derive_var_obs_number( new_var = ASEQ, @@ -826,11 +848,13 @@ adpc <- adpc %>% -ends_with("prev"), -DRUG, -EVID, -AXRLT, -NXRLT, -VISITDY ) %>% # Derive PARAM and PARAMN - derive_vars_merged(dataset_add = select(param_lookup, -PCTESTCD), by_vars = exprs(PARAMCD)) + derive_vars_merged( + dataset_add = select(param_lookup, -PCTESTCD), by_vars = exprs(PARAMCD) + ) ``` ```{r, eval=TRUE, echo=FALSE} -adpc %>% +adpc_aseq %>% dataset_vignette(display_vars = exprs( USUBJID, BASETYPE, DTYPE, AVISIT, ATPT, AVAL, NFRLT, NRRLT, AFRLT, ARRLT, BASE, CHG )) @@ -845,9 +869,8 @@ available. Baseline lab values could also be derived from `LB` or `ADLB` in a similar manner. ```{r eval=TRUE, echo=TRUE} - # Derive additional baselines from VS -adpc <- adpc %>% +adpc_baselines <- adpc_aseq %>% derive_vars_merged( dataset_add = vs, filter_add = VSTESTCD == "HEIGHT", @@ -867,7 +890,7 @@ adpc <- adpc %>% ``` ```{r, eval=TRUE, echo=FALSE} -adpc %>% +adpc_baselines %>% dataset_vignette(display_vars = exprs( USUBJID, HTBL, HTBLU, WTBL, WTBLU, BMIBL, BMIBLU, BASETYPE, ATPT, AVAL )) @@ -879,14 +902,527 @@ If needed, the other `ADSL` variables can now be added: ```{r eval=TRUE, echo=TRUE} # Add all ADSL variables -adpc <- adpc %>% +adpc <- adpc_baselines %>% derive_vars_merged( dataset_add = select(adsl, !!!negate_vars(adsl_vars)), by_vars = exprs(STUDYID, USUBJID) ) ``` -## Add Labels and Attributes {#attributes} +Adding attributes to the `ADPC` file will be discussed +[below](#attributes). We will now turn to the Population PK example. + +# Programming Population PK (ADPPK) Analysis Data + +The Population PK Analysis Data (ADPPK) follows the forthcoming CDISC +Implementation Guide +(). The +programming workflow for Population PK (ADPPK) Analysis Data is similar +to the NCA Programming flow with a few key differences. Population PK +models generally make use of nonlinear mixed effects models that require +numeric variables. The data used in the models will include both dosing +and concentration records, relative time variables, and numeric +covariate variables. A `DV` or dependent variable is often expected. +This is equivalent to the ADaM `AVAL` variable and will be included in +addition to `AVAL` for ADPPK. The ADPPK file will not have the +duplicated records for analysis found in the NCA. + +Here are the relative time variables we will use for the ADPPK data. +These correspond to the names in the forthcoming CDISC Implementation +Guide. + +| Variable | Variable Label | +|----------|-------------------------------------| +| NFRLT | Nominal Rel Time from First Dose | +| AFRLT | Actual Rel Time from First Dose | +| NPRLT | Nominal Rel Time from Previous Dose | +| APRLT | Actual Rel Time from Previous Dose | + +The `ADPPK` will require the numeric Event ID (`EVID`) which we defined +in `ADPC` but did not keep. + +# `ADPPK` Programming Workflow + +- [Read in Data (Same as `ADPC`)](#readdata) + +- [Expand Dosing Records (Same as `ADPC`)](#expand) + +- [Find First Dose](#ppkfirst) + +- [Find Previous Dose](#prevdose) + +- [Combine PC and EX Records for `ADPPK`](#aprlt) + +- [Derive Analysis Variables and Dependent Variable `DV`](#dv) + +- [Add `ASEQ` and Remove Temporary Variables](#ppkaseq) + +- [Derive Numeric Covariates](#covar) + +- [Derive Additional Covariates from VS and LB](#addcovar) + +- [Combine Covariates with `ADPPK` Data](#final) + +## Find First Dose `ADPPK` {#ppkfirst} + +The initial programming steps for `ADPPK` will follow the same sequence +as the `ADPC`. This includes reading in the `{admiral.test}` data, +deriving analysis dates, defining the nominal relative time from first +dose `NFRLT`, and expanding dosing records. For more detail see these +steps above ([Read in Data](#readdata)). + +We will pick this up at the stage where we find the first dose for the +concentration records. We will use `derive_vars_merged()` as we did for +`ADPC`. + +```{r eval=TRUE, echo=TRUE, message=FALSE} +# ---- Find first dose per treatment per subject ---- +# ---- Join with ADPC data and keep only subjects with dosing ---- + +adppk_first_dose <- pc_dates %>% + derive_vars_merged( + dataset_add = ex_exp, + filter_add = (!is.na(ADTM)), + new_vars = exprs(FANLDTM = ADTM, EXDOSE_first = EXDOSE), + order = exprs(ADTM, EXSEQ), + mode = "first", + by_vars = exprs(STUDYID, USUBJID, DRUG) + ) %>% + filter(!is.na(FANLDTM)) %>% + # Derive AVISIT based on nominal relative time + # Derive AVISITN to nominal time in whole days using integer division + # Define AVISIT based on nominal day + mutate( + AVISITN = NFRLT %/% 24 + 1, + AVISIT = paste("Day", AVISITN), + ) +``` + +```{r, eval=TRUE, echo=FALSE} +dataset_vignette( + adppk_first_dose, + display_vars = exprs( + USUBJID, FANLDTM, AVISIT, ADTM, PCTPT + ) +) +``` + +## Find Previous Dose {#prevdose} + +For `ADPPK` we will find the previous dose with respect to actual time +and nominal time. We will use `derive_vars_joined()` as we did for +`ADPC`, but note that we will not need to find the next dose as for +`ADPC`. + +```{r eval=TRUE, echo=TRUE} +# ---- Find previous dose ---- + +adppk_prev <- adppk_first_dose %>% + derive_vars_joined( + dataset_add = ex_exp, + by_vars = exprs(USUBJID), + order = exprs(ADTM), + new_vars = exprs( + ADTM_prev = ADTM, EXDOSE_prev = EXDOSE, AVISIT_prev = AVISIT, + AENDTM_prev = AENDTM + ), + join_vars = exprs(ADTM), + filter_add = NULL, + filter_join = ADTM > ADTM.join, + mode = "last", + check_type = "none" + ) + +# ---- Find previous nominal dose ---- + +adppk_nom_prev <- adppk_prev %>% + derive_vars_joined( + dataset_add = ex_exp, + by_vars = exprs(USUBJID), + order = exprs(NFRLT), + new_vars = exprs(NFRLT_prev = NFRLT), + join_vars = exprs(NFRLT), + filter_add = NULL, + filter_join = NFRLT > NFRLT.join, + mode = "last", + check_type = "none" + ) +``` + +```{r, eval=TRUE, echo=FALSE} +dataset_vignette( + adppk_nom_prev, + display_vars = exprs( + USUBJID, VISIT, ADTM, VISIT, PCTPT, ADTM_prev, NFRLT_prev + ) +) +``` + +## Combine PC and EX Records for `ADPPK` {#aprlt} + +As we did for `ADPC` we will now combine `PC` and `EX` records. We will +derive the relative time variables `AFRLT` (Actual Relative Time from +First Dose), `APRLT` (Actual Relative Time from Previous Dose), and +`NPRLT` (Nominal Relative Time from Previous Dose). Use +`derive_vars_duration()` to derive `AFRLT` and `APRLT`. Note we defined +`EVID` above with values of 0 for observation records and 1 for dosing +records. + +```{r eval=TRUE, echo=TRUE} +# ---- Combine ADPPK and EX data ---- +# Derive Relative Time Variables + +adppk_aprlt <- bind_rows(adppk_nom_prev, ex_exp) %>% + group_by(USUBJID, DRUG) %>% + mutate( + FANLDTM = min(FANLDTM, na.rm = TRUE), + min_NFRLT = min(NFRLT, na.rm = TRUE), + maxdate = max(ADT[EVID == 0], na.rm = TRUE), .after = USUBJID + ) %>% + arrange(USUBJID, ADTM) %>% + ungroup() %>% + filter(ADT <= maxdate) %>% + # Derive Actual Relative Time from First Dose (AFRLT) + derive_vars_duration( + new_var = AFRLT, + start_date = FANLDTM, + end_date = ADTM, + out_unit = "hours", + floor_in = FALSE, + add_one = FALSE + ) %>% + # Derive Actual Relative Time from Reference Dose (APRLT) + derive_vars_duration( + new_var = APRLT, + start_date = ADTM_prev, + end_date = ADTM, + out_unit = "hours", + floor_in = FALSE, + add_one = FALSE + ) %>% + # Derive APRLT + mutate( + APRLT = case_when( + EVID == 1 ~ 0, + is.na(APRLT) ~ AFRLT, + TRUE ~ APRLT + ), + NPRLT = case_when( + EVID == 1 ~ 0, + is.na(NFRLT_prev) ~ NFRLT - min_NFRLT, + TRUE ~ NFRLT - NFRLT_prev + ) + ) +``` + +```{r, eval=TRUE, echo=FALSE} +dataset_vignette( + adppk_aprlt, + display_vars = exprs( + USUBJID, EVID, NFRLT, AFRLT, APRLT, NPRLT + ) +) +``` + +## Derive Analysis Variables and Dependent Variable `DV` {#dv} + +The expected analysis variable for `ADPPK` is `DV` or dependent +variable. For this example `DV` is set to the numeric concentration +value `PCSTRESN`. We will also include `AVAL` equivalent to `DV` for +consistency with CDISC ADaM standards. `MDV` missing dependent variable +will also be included. + +```{r eval=TRUE, echo=TRUE} +# ---- Derive Analysis Variables ---- +# Derive actual dose DOSEA and planned dose DOSEP, +# Derive AVAL and DV + +adppk_aval <- adppk_aprlt %>% + mutate( + # Derive Actual Dose + DOSEA = case_when( + EVID == 1 ~ EXDOSE, + is.na(EXDOSE_prev) ~ EXDOSE_first, + TRUE ~ EXDOSE_prev + ), + # Derive Planned Dose + DOSEP = case_when( + TRT01P == "Xanomeline High Dose" ~ 81, + TRT01P == "Xanomeline Low Dose" ~ 54, + TRT01P == "Placebo" ~ 0 + ), + # Derive PARAMCD + PARAMCD = case_when( + EVID == 1 ~ "DOSE", + TRUE ~ PCTESTCD + ), + ALLOQ = PCLLOQ, + # Derive CMT + CMT = case_when( + EVID == 1 ~ 1, + TRUE ~ 2 + ), + # Derive BLQFL/BLQFN + BLQFL = case_when( + PCSTRESC == "% + # Calculate ASEQ + derive_var_obs_number( + new_var = ASEQ, + by_vars = exprs(STUDYID, USUBJID), + order = exprs(AFRLT, EVID), + check_type = "error" + ) %>% + # Derive PARAM and PARAMN + derive_vars_merged(dataset_add = select(param_lookup, -PCTESTCD), by_vars = exprs(PARAMCD)) %>% + mutate( + PROJID = DRUG, + PROJIDN = 1 + ) %>% + # Remove temporary variables + select( + -DOMAIN, -starts_with("min"), -starts_with("max"), -starts_with("EX"), + -starts_with("PC"), -ends_with("first"), -ends_with("prev"), + -ends_with("DTM"), -ends_with("DT"), -ends_with("TM"), -starts_with("VISIT"), + -starts_with("AVISIT"), -starts_with("PARAM"), + -ends_with("TMF"), -starts_with("TRT"), -starts_with("ATPT"), -DRUG + ) +``` + +```{r, eval=TRUE, echo=FALSE} +dataset_vignette( + adppk_aseq, + display_vars = exprs( + USUBJID, EVID, DOSEA, AMT, NFRLT, AFRLT, CMT, DV, MDV, BLQFN, ASEQ + ) +) +``` + +## Derive Numeric Covariates {#covar} + +A key feature of Population PK modeling is the presence of numeric +covariates. We will create numeric versions of many of our standard +CDISC demographic variables including `STUDYIDN`, `USUBJIDN`, `SEXN`, +`RACEN`, and `ETHNICN`. + +```{r eval=TRUE, echo=TRUE} +#---- Derive Covariates ---- +# Include numeric values for STUDYIDN, USUBJIDN, SEXN, RACEN etc. + +covar <- adsl %>% + mutate( + STUDYIDN = as.numeric(word(USUBJID, 1, sep = fixed("-"))), + SITEIDN = as.numeric(word(USUBJID, 2, sep = fixed("-"))), + USUBJIDN = as.numeric(word(USUBJID, 3, sep = fixed("-"))), + SUBJIDN = as.numeric(SUBJID), + SEXN = case_when( + SEX == "M" ~ 1, + SEX == "F" ~ 2, + TRUE ~ 3 + ), + RACEN = case_when( + RACE == "AMERICAN INDIAN OR ALASKA NATIVE" ~ 1, + RACE == "ASIAN" ~ 2, + RACE == "BLACK OR AFRICAN AMERICAN" ~ 3, + RACE == "NATIVE HAWAIIAN OR OTHER PACIFIC ISLANDER" ~ 4, + RACE == "WHITE" ~ 5, + TRUE ~ 6 + ), + ETHNICN = case_when( + ETHNIC == "HISPANIC OR LATINO" ~ 1, + ETHNIC == "NOT HISPANIC OR LATINO" ~ 2, + TRUE ~ 3 + ), + ARMN = case_when( + ARM == "Placebo" ~ 0, + ARM == "Xanomeline Low Dose" ~ 1, + ARM == "Xanomeline High Dose" ~ 2, + TRUE ~ 3 + ), + ACTARMN = case_when( + ACTARM == "Placebo" ~ 0, + ACTARM == "Xanomeline Low Dose" ~ 1, + ACTARM == "Xanomeline High Dose" ~ 2, + TRUE ~ 3 + ), + COHORT = ARMN, + COHORTC = ARM, + ROUTE = unique(ex$EXROUTE), + ROUTEN = case_when( + ROUTE == "TRANSDERMAL" ~ 3, + TRUE ~ NA_real_ + ), + FORM = unique(ex$EXDOSFRM), + FORMN = case_when( + FORM == "PATCH" ~ 3, + TRUE ~ 4 + ), + COUNTRYN = case_when( + COUNTRY == "USA" ~ 1, + COUNTRY == "CAN" ~ 2, + COUNTRY == "GBR" ~ 3 + ), + REGION1N = COUNTRYN, + ) %>% + select( + STUDYID, STUDYIDN, SITEID, SITEIDN, USUBJID, USUBJIDN, + SUBJID, SUBJIDN, AGE, SEX, SEXN, COHORT, COHORTC, ROUTE, ROUTEN, + RACE, RACEN, ETHNIC, ETHNICN, FORM, FORMN, COUNTRY, COUNTRYN, + REGION1, REGION1N + ) +``` + +```{r, eval=TRUE, echo=FALSE} +dataset_vignette( + covar, + display_vars = exprs( + STUDYIDN, USUBJIDN, SITEIDN, AGE, SEXN, RACEN, COHORT, ROUTEN + ) +) +``` + +## Derive Additional Covariates from VS and LB {#addcovar} + +We will add additional covariates for baseline height `HTBL` and weight +`WTBL` from `VS` and select baseline lab values `CREATBL`, `ALTBL`, +`ASTBL` and `TBILBL` from `LB`. We will calculate BMI and BSA from +height and weight using `compute_bmi()` and `compute_bsa()`. And we will +calculate creatinine clearance `CRCLBL` and estimated glomerular +filtration rate (eGFR) `EGFRBL` using `compute_egfr()` function. + +```{r eval=TRUE, echo=TRUE} +#---- Derive additional baselines from VS and LB ---- + +labsbl <- lb %>% + filter(LBBLFL == "Y" & LBTESTCD %in% c("CREAT", "ALT", "AST", "BILI")) %>% + mutate(LBTESTCDB = paste0(LBTESTCD, "BL")) %>% + select(STUDYID, USUBJID, LBTESTCDB, LBSTRESN) + +covar_vslb <- covar %>% + derive_vars_merged( + dataset_add = vs, + filter_add = VSTESTCD == "HEIGHT", + by_vars = exprs(STUDYID, USUBJID), + new_vars = exprs(HTBL = VSSTRESN) + ) %>% + derive_vars_merged( + dataset_add = vs, + filter_add = VSTESTCD == "WEIGHT" & VSBLFL == "Y", + by_vars = exprs(STUDYID, USUBJID), + new_vars = exprs(WTBL = VSSTRESN) + ) %>% + derive_vars_transposed( + dataset_merge = labsbl, + by_vars = exprs(STUDYID, USUBJID), + key_var = LBTESTCDB, + value_var = LBSTRESN + ) %>% + mutate( + BMIBL = compute_bmi(height = HTBL, weight = WTBL), + BSABL = compute_bsa( + height = HTBL, + weight = HTBL, + method = "Mosteller" + ), + # Derive CRCLBL and EGFRBL using new function + CRCLBL = compute_egfr( + creat = CREATBL, creatu = "SI", age = AGE, wt = WTBL, sex = SEX, + method = "CRCL" + ), + EGFRBL = compute_egfr( + creat = CREATBL, creatu = "SI", age = AGE, wt = WTBL, sex = SEX, + method = "CKD-EPI" + ) + ) %>% + rename(TBILBL = BILIBL) +``` + +```{r, eval=TRUE, echo=FALSE} +dataset_vignette( + covar_vslb, + display_vars = exprs( + USUBJIDN, AGE, SEXN, HTBL, WTBL, CREATBL, ALTBL, ASTBL + ) +) +``` + +## Combine Covariates with `ADPPK` Data {#final} + +Finally, we combine the covariates with the `ADPPK` data. + +```{r eval=TRUE, echo=TRUE} +# Combine covariates with APPPK data + +adppk <- adppk_aseq %>% + derive_vars_merged( + dataset_add = covar_vslb, + by_vars = exprs(STUDYID, USUBJID) + ) %>% + arrange(STUDYIDN, USUBJIDN, AFRLT, EVID) %>% + mutate(RECSEQ = row_number()) +``` + +```{r, eval=TRUE, echo=FALSE} +dataset_vignette( + adppk, + display_vars = exprs( + USUBJIDN, AGE, SEXN, CREATBL, EVID, AMT, DV, MDV, RECSEQ + ) +) +``` + +# Add Labels and Attributes {#attributes} Adding labels and attributes for SAS transport files is supported by the following packages: @@ -914,6 +1450,7 @@ example](https://examples.pharmaverse.org/data/adsl/). # Example Scripts {#example} -| ADaM | Sample Code | -|------------------|------------------------------------------------------| -| ADPC | [ad_adpc.R](https://github.com/pharmaverse/admiral/blob/main/inst/templates/ad_adpc.R){target="_blank"} | +| ADaM | Sample Code | +|------------|------------------------------------------------------------| +| ADPC | [ad_adpc.R](https://github.com/pharmaverse/admiral/blob/main/inst/templates/ad_adpc.R){target="_blank"} | +| ADPPK | [ad_adppk.R](https://github.com/pharmaverse/admiral/blob/main/inst/templates/ad_adppk.R){target="_blank"} | diff --git a/vignettes/queries_dataset.Rmd b/vignettes/queries_dataset.Rmd index f672dbcf47..81f4f33e99 100644 --- a/vignettes/queries_dataset.Rmd +++ b/vignettes/queries_dataset.Rmd @@ -46,14 +46,14 @@ 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 | Scope (Broad/Narrow) of the query | Character | `BROAD`, `NARROW`, `NA` -QUERY_SCOPE_NUM | Scope (Broad/Narrow) of the query | Integer | `1`, `2`, `NA` +**PREFIX** | The prefix used to define the grouping variables | Character | `"SMQ01"` +**GRPNAME** | The value provided to the grouping variables name| Character | `"Immune-Mediated Guillain-Barre Syndrome"` +**SRCVAR** | The variable used to define the grouping. Used in conjunction with TERMNAME | Character | `"AEDECOD"` +**TERMNAME** | A term used to define the grouping. Used in conjunction with SRCVAR | Character | `"GUILLAIN-BARRE SYNDROME"` +**TERMID** | A code used to define the grouping. Used in conjunction with SRCVAR | Integer | `10018767` +GRPID | Id number of the query. This could be a SMQ identifier | Integer | `20000131` +SCOPE | Scope (Broad/Narrow) of the query | Character | `BROAD`, `NARROW`, `NA` +SCOPEN | 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. @@ -66,66 +66,66 @@ are in line. Each row must be unique within the dataset. -As described above, the variables `VAR_PREFIX`, `QUERY_NAME`, `TERM_LEVEL`, `TERM_NAME` and `TERM_ID` are required. +As described above, the variables `PREFIX`, `GRPNAME`, `SRCVAR`, `TERMNAME` and `TERMID` are required. The combination of these variables will allow the creation of the grouping variable. ### Input - + `VAR_PREFIX` must be a character string starting with 2 or 3 letters, followed by a 2-digits number (e.g. "CQ01"). + + `PREFIX` must be a character string starting with 2 or 3 letters, followed by a 2-digits number (e.g. "CQ01"). - + `QUERY_NAME` must be a non missing character string and it must be unique within `VAR_PREFIX`. + + `GRPNAME` must be a non missing character string and it must be unique within `PREFIX`. - + `TERM_LEVEL` must be a non missing character string. + + `SRCVAR` must be a non missing character string. - + Each value in `TERM_LEVEL` represents a variable from `dataset` used to define the grouping variables (e.g. `AEDECOD`,`AEBODSYS`, `AELLTCD`). - + The function `derive_vars_query()` will check that each value given in `TERM_LEVEL` has a corresponding variable in the input `dataset` and issue an error otherwise. + + Each value in `SRCVAR` represents a variable from `dataset` used to define the grouping variables (e.g. `AEDECOD`,`AEBODSYS`, `AELLTCD`). + + The function `derive_vars_query()` will check that each value given in `SRCVAR` has a corresponding variable in the input `dataset` and issue an error otherwise. - + Different `TERM_LEVEL` variables may be specified within a `VAR_PREFIX`. + + Different `SRCVAR` variables may be specified within a `PREFIX`. - + `TERM_NAME` must be a character string. - This **must** be populated if `TERM_ID` is missing. + + `TERMNAME` must be a character string. + This **must** be populated if `TERMID` is missing. - + `TERM_ID` must be an integer. - This **must** be populated if `TERM_NAME` is missing. + + `TERMID` must be an integer. + This **must** be populated if `TERMNAME` is missing. ### Output - + `VAR_PREFIX` will be used to create the grouping variable appending the suffix "NAM". This variable will now be referred to as `ABCzzNAM`: the name of the grouping variable. + + `PREFIX` will be used to create the grouping variable appending the suffix "NAM". This variable will now be referred to as `ABCzzNAM`: the name of the grouping variable. - + E.g. `VAR_PREFIX == "SMQ01"` will create the `SMQ01NAM` variable. + + E.g. `PREFIX == "SMQ01"` will create the `SMQ01NAM` variable. - + For each `VAR_PREFIX`, a new `ABCzzNAM` variable is created in `dataset`. + + For each `PREFIX`, a new `ABCzzNAM` variable is created in `dataset`. - + [`QUERY_NAME`]{#query_name} will be used to populate the corresponding `ABCzzNAM` variable. + + [`GRPNAME`]{#GRPNAME} will be used to populate the corresponding `ABCzzNAM` variable. - + `TERM_LEVEL` will be used to identify the variables from `dataset` used to perform the grouping (e.g. `AEDECOD`,`AEBODSYS`, `AELLTCD`). + + `SRCVAR` will be used to identify the variables from `dataset` used to perform the grouping (e.g. `AEDECOD`,`AEBODSYS`, `AELLTCD`). - + `TERM_NAME` (for character variables), `TERM_ID` (for numeric variables) will be used to identify the records meeting the criteria in `dataset` based on the variable defined in `TERM_LEVEL`. + + `TERMNAME` (for character variables), `TERMID` (for numeric variables) will be used to identify the records meeting the criteria in `dataset` based on the variable defined in `SRCVAR`. + **Result:** - + For each record in `dataset`, where the variable defined by `TERM_LEVEL` match a term from the `TERM_NAME` (for character variables) or `TERM_ID` (for numeric variables) in the `datasets_queries`, `ABCzzNAM` is populated with `QUERY_NAME`. + + For each record in `dataset`, where the variable defined by `SRCVAR` match a term from the `TERMNAME` (for character variables) or `TERMID` (for numeric variables) in the `datasets_queries`, `ABCzzNAM` is populated with `GRPNAME`. - + Note: The type (numeric or character) of the variable defined in `TERM_LEVEL` is checked in `dataset`. If the variable is a character variable (e.g. `AEDECOD`), it is expected that `TERM_NAME` is populated, if it is a numeric variable (e.g. `AEBDSYCD`), it is expected that `TERM_ID` is populated, otherwise an error is issued. + + Note: The type (numeric or character) of the variable defined in `SRCVAR` is checked in `dataset`. If the variable is a character variable (e.g. `AEDECOD`), it is expected that `TERMNAME` is populated, if it is a numeric variable (e.g. `AEBDSYCD`), it is expected that `TERMID` is populated, otherwise an error is issued. ### Example -In this example, one standard MedDRA query (`VAR_PREFIX = "SMQ01"`) and one customized query (`VAR_PREFIX = "CQ02"`) are defined to analyze the adverse events. +In this example, one standard MedDRA query (`PREFIX = "SMQ01"`) and one customized query (`PREFIX = "CQ02"`) are defined to analyze the adverse events. - + The standard MedDRA query variable `SMQ01NAM` [`VAR_PREFIX`] will be populated with "Standard Query 1" [`QUERY_NAME`] if any preferred term (`AEDECOD`) [`TERM_LEVEL`] in `dataset` is equal to "AE1" or "AE2" [`TERM_NAME`] + + The standard MedDRA query variable `SMQ01NAM` [`PREFIX`] will be populated with "Standard Query 1" [`GRPNAME`] if any preferred term (`AEDECOD`) [`SRCVAR`] in `dataset` is equal to "AE1" or "AE2" [`TERMNAME`] - + The customized query (`CQ02NAM`) [`VAR_PREFIX`] will be populated with "Query 2" [`QUERY_NAME`] if any Low Level Term Code (`AELLTCD`) [`TERM_LEVEL`] in `dataset` is equal to 10 [`TERM_ID`] or any preferred term (`AEDECOD`) [`TERM_LEVEL`] in `dataset` is equal to "AE4" [`TERM_NAME`]. + + The customized query (`CQ02NAM`) [`PREFIX`] will be populated with "Query 2" [`GRPNAME`] if any Low Level Term Code (`AELLTCD`) [`SRCVAR`] in `dataset` is equal to 10 [`TERMID`] or any preferred term (`AEDECOD`) [`SRCVAR`] in `dataset` is equal to "AE4" [`TERMNAME`]. #### Query Dataset (`ds_query`) -VAR_PREFIX | QUERY_NAME | TERM_LEVEL | TERM_NAME | TERM_ID | +PREFIX | GRPNAME | SRCVAR | TERMNAME | TERMID | ------- | ----- | ------ | ----- | ----- | ----- SMQ01| Standard Query 1 | AEDECOD | AE1 | SMQ01| Standard Query 1 | AEDECOD | AE2 | @@ -167,22 +167,22 @@ The following variables can be added to `queries_datset` to derive this informat ### Input - + `QUERY_ID` must be an integer. + + `GRPID` must be an integer. - + `QUERY_SCOPE` must be a character string. Possible values are: "BROAD", "NARROW" or `NA`. + + `SCOPE` must be a character string. Possible values are: "BROAD", "NARROW" or `NA`. - + `QUERY_SCOPE_NUM` must be an integer. Possible values are: `1`, `2` or `NA`. + + `SCOPEN` must be an integer. Possible values are: `1`, `2` or `NA`. ### Output - + `QUERY_ID`, `QUERY_SCOPE` and `QUERY_SCOPE_NUM` will be used in the same way as `QUERY_NAME` [(see here)](#query_name) and will help in the creation of the `ABCzzCD`, `ABCzzSC` and `ABCzzSCN` variables. + + `GRPID`, `SCOPE` and `SCOPEN` will be used in the same way as `GRPNAME` [(see here)](#GRPNAME) and will help in the creation of the `ABCzzCD`, `ABCzzSC` and `ABCzzSCN` variables. ### Output Variables These variables are optional and if not populated in `dataset_queries`, the corresponding output variable will not be created: -VAR_PREFIX | QUERY_NAME | QUERY_ID | QUERY_SCOPE |QUERY_SCOPE_NUM | **Variables created** +PREFIX | GRPNAME | GRPID | SCOPE |SCOPEN | **Variables created** ------- | ----- | ------ | ----- | ----- | ----- SMQ01| Query 1 | XXXXXXXX | NARROW | 2 | `SMQ01NAM`, `SMQ01CD`, `SMQ01SC`, `SMQ01SCN` SMQ02| Query 2 | XXXXXXXX |BROAD | | `SMQ02NAM`, `SMQ02CD`, `SMQ02SC` diff --git a/vignettes/questionnaires.Rmd b/vignettes/questionnaires.Rmd index 348709b6e5..57d4a6020b 100644 --- a/vignettes/questionnaires.Rmd +++ b/vignettes/questionnaires.Rmd @@ -68,9 +68,9 @@ dataset_vignette(qs) ```{r} adsl <- tribble( - ~STUDYID, ~USUBJID, ~SITEID, ~ITTFL, ~TRTP, ~TRTSDT, ~DTHCAUS, - "STUDYX", "P0001", 13L, "Y", "DRUG A", lubridate::ymd("2012-11-16"), NA_character_, - "STUDYX", "P0002", 11L, "Y", "DRUG B", lubridate::ymd("2012-11-16"), NA_character_ + ~STUDYID, ~USUBJID, ~SITEID, ~ITTFL, ~TRTSDT, ~DTHCAUS, + "STUDYX", "P0001", 13L, "Y", lubridate::ymd("2012-11-16"), NA_character_, + "STUDYX", "P0002", 11L, "Y", lubridate::ymd("2012-11-16"), "PROGRESSIVE DISEASE" ) ``` ```{r echo=FALSE} @@ -141,7 +141,7 @@ adgad7 <- adqs %>% # Select records to keep in the GAD-7 ADaM filter(PARCAT1 == "GAD-7 V2") %>% derive_summary_records( - by_vars = exprs(STUDYID, USUBJID, AVISIT, ADT, ADY, TRTSDT), + by_vars = exprs(STUDYID, USUBJID, AVISIT, ADT, ADY, TRTSDT, DTHCAUS), analysis_var = AVAL, summary_fun = function(x) sum(x, na.rm = TRUE), # Select records contributing to total score @@ -170,7 +170,7 @@ adgdssf <- adqs %>% # Select records to keep in the GDS-SF ADaM filter(PARCAT1 == "GDS SHORT FORM") %>% derive_summary_records( - by_vars = exprs(STUDYID, USUBJID, AVISIT, ADT, ADY, TRTSDT), + by_vars = exprs(STUDYID, USUBJID, AVISIT, ADT, ADY, TRTSDT, DTHCAUS), analysis_var = AVAL, summary_fun = function(x) { compute_scale( @@ -407,7 +407,7 @@ adgdssf <- adgdssf %>% order = exprs(ADT), new_var = CDTDTHFL, join_vars = exprs(CHGCAT1, ADY), - join_type = "after", + join_type = "all", tmp_obs_nr_var = tmp_obs_nr, filter = CHGCAT1 == "WORSENED" & ( CHGCAT1.join == "WORSENED" & ADY.join >= ADY + 7 | @@ -528,17 +528,7 @@ adgdssf <- adgdssf %>% set_values_to = exprs( PARAMCD = "COMPL90P", PARAM = "Completed at least 90% of questions?", - ) - ) %>% - mutate( - AVALC = if_else( - PARAMCD == "COMPL90P", - if_else( - AVAL == 1, - "YES", - "NO" - ), - AVALC + AVALC = if_else(AVAL == 1, "YES", "NO") ) ) ``` @@ -587,18 +577,8 @@ adgdssf <- adgdssf %>% summary_fun = function(x) all(!is.na(x)), set_values_to = exprs( PARAMCD = "COMPLALL", - PARAM = "Completed all questions?" - ) - ) %>% - mutate( - AVALC = if_else( - PARAMCD == "COMPLALL", - if_else( - AVAL == 1, - "YES", - "NO" - ), - AVALC + PARAM = "Completed all questions?", + AVALC = if_else(AVAL == 1, "YES", "NO") ) ) %>% filter(is.na(filled_in)) %>% diff --git a/vignettes/visits_periods.Rmd b/vignettes/visits_periods.Rmd index 561fd6739b..f4d5baf4ed 100644 --- a/vignettes/visits_periods.Rmd +++ b/vignettes/visits_periods.Rmd @@ -5,6 +5,9 @@ output: vignette: > %\VignetteIndexEntry{Visit and Period Variables} %\VignetteEngine{knitr::rmarkdown} +editor_options: + markdown: + wrap: 72 --- ```{r setup, include=FALSE} @@ -16,13 +19,13 @@ knitr::opts_chunk$set( # 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. +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 @@ -43,15 +46,18 @@ library(admiraldev) 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 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. +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`, ...). -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, @@ -62,8 +68,10 @@ windows <- tribble( "WEEK 4", 23, 30, 4, 26 ) ``` -Then the visits can be assigned based on the analysis day (`ADY`) by calling -`derive_vars_joined()`: + +Then the visits can be assigned based on the analysis day (`ADY`) by +calling `derive_vars_joined()`: + ```{r} adbds <- tribble( ~USUBJID, ~ADY, @@ -83,16 +91,17 @@ derive_vars_joined( # 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. +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 +## Period Reference Dataset {#reference} -The period reference dataset contains one observation per subject and period, -subperiod, or phase. For example: +The period reference dataset contains one observation per subject and +period, subperiod, or phase. For example: ```{r echo=FALSE} phase_ref <- tribble( @@ -111,19 +120,21 @@ phase_ref <- tribble( 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`. +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()`. +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: -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")) @@ -139,11 +150,12 @@ 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()`. +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. +For example the variables `APHASEN`, `PHSDT`, `PHEDT`, `APHASE` can be +derived from the period reference dataset defined above. ```{r} adae <- tribble( @@ -165,12 +177,13 @@ derive_vars_joined( ) ``` -If no period reference dataset is available but period variables are in ADSL, -the period reference dataset can be created from ADSL by calling +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: +For [example]{#adsl_example}, a period reference dataset for phases can +be created from the ADSL dataset created above: + ```{r} create_period_dataset( adsl, @@ -180,17 +193,18 @@ create_period_dataset( # 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. +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()`: +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 @@ -230,8 +244,8 @@ adsl 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. +For example the variables `APERIOD` and `TRTA` can be derived from the +period reference dataset defined above. ```{r} adae <- tribble( @@ -258,15 +272,40 @@ derive_vars_joined( ) ``` -If no period reference dataset is available but period variables are in ADSL, -the period reference dataset can be created from ADSL by calling +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: +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 = exprs(APERSDT = APxxSDT, APEREDT = APxxEDT, TRTA = TRTxxA) ) ``` + +# Study Specific Code + +At some point study specific code is required to derive period/subperiod +variables. There are two options: + +- Study specific code is used to derive the variables `PxxSwSDT` and + `PxxSwEDT` in ADSL. Then `create_period_dataset()` and + `derive_vars_joined()` can be used to derive period/subperiod + variables like `ASPER` or `ASPRSDT` in BDS and OCCDS datasets. (See + [example](#adsl_example).) + +- Study specific code is used to derive a dataset with one + observations per patient, period, and subperiod (see [period + reference dataset](#reference) ). Then `derive_vars_period()` can be + used to derive `PxxSwSDT` and `PxxSwEDT` in ADSL and + `derive_vars_joined()` can be used to derive period/subperiod + variables like `ASPER` or `ASPRSDT` in BDS and OCCDS datasets. + +It depends on the specific definition of the periods/subperiods which +option works best. If the definition is based on other ADSL variables, +the first option would work best. If the definition is based on +vertically structured data like exposure data (EX dataset), the second +option should be used.