Closes #2468 Implement derive_vars_crit_flag()

.github/pull_request_template.md

@@ -6,7 +6,7 @@ Please check off each taskbox as an acknowledgment that you completed the task o
 - [ ] Code is formatted according to the [tidyverse style guide](https://style.tidyverse.org/). Run `styler::style_file()` to style R and Rmd files
 - [ ] Updated relevant unit tests or have written new unit tests, which should consider realistic data scenarios and edge cases, e.g. empty datasets, errors, boundary cases etc. - See [Unit Test Guide](https://pharmaverse.github.io/admiraldev/articles/unit_test_guidance.html#tests-should-be-robust-to-cover-realistic-data-scenarios)
 - [ ] If you removed/replaced any function and/or function parameters, did you fully follow the [deprecation guidance](https://pharmaverse.github.io/admiraldev/articles/programming_strategy.html#deprecation)?
-- [ ] Review the [Cheat Sheet](https://github.com/pharmaverse/admiral/blob/main/inst/cheatsheet/admiral_cheatsheet.pdf). Make any required updates to it by editing the file `inst/cheatsheet/admiral_cheatsheet.pptx` and re-upload a PDF version of it to the same folder.
+- [ ] Review the [Cheat Sheet](https://github.com/pharmaverse/admiral/blob/main/inst/cheatsheet/admiral_cheatsheet.pdf). Make any required updates to it by editing the file `inst/cheatsheet/admiral_cheatsheet.pptx` and re-upload a PDF and a PNG version of it to the same folder. (The PNG version can be created by taking a screenshot of the PDF version.)
 - [ ] Update to all relevant roxygen headers and examples, including keywords and families. Refer to the [categorization of functions](https://pharmaverse.github.io/admiraldev/articles/programming_strategy.html#categorization-of-functions) to tag appropriate keyword/family.
 - [ ] Run `devtools::document()` so all `.Rd` files in the `man` folder and the `NAMESPACE` file in the project root are updated appropriately
 - [ ] Address any updates needed for vignettes and/or templates

NAMESPACE

@@ -101,6 +101,7 @@ export(derive_var_trtemfl)
 export(derive_vars_aage)
 export(derive_vars_atc)
 export(derive_vars_computed)
+export(derive_vars_crit_flag)
 export(derive_vars_dt)
 export(derive_vars_dtm)
 export(derive_vars_dtm_to_dt)

NEWS.md

@@ -2,6 +2,9 @@
 
 ## New Features
 
+- New function `derive_vars_crit_flag()` for deriving criterion flag variables
+(`CRITy`, `CRITyFL`, `CRITyFLN`). (#2468)
+
 ## Updates of Existing Functions
 
 ## Breaking Changes
@@ -486,7 +489,7 @@ dates updated (#2028)
 
 ## Various
 
-- The list of package authors/contributors has been reformatted so that those who are actively maintaining the code base are now marked as *authors*, whereas those who made a significant contribution in the past are now down as *contributors*. All other acknowledgements have been moved to README section (#1941).
+- The list of package authors/contributors has been reformatted so that those who are actively maintaining the code base are now marked as *authors*, whereas those who made a significant contribution in the past are now down as *contributors*. All other acknowledgments have been moved to README section (#1941).
 
 - `derive_vars_joined()` had two bugs with regards to duplicates messaging and when `new_vars` was set to `NULL` that have now been addressed (#1966). 
 

R/derive_vars_crit_flag.R

@@ -0,0 +1,161 @@
+#' Derive Criterion Flag Variables `CRITy`, `CRITyFL`, and `CRITyFLN`
+#'
+#' @description
+#'
+#' The function derives ADaM compliant criterion flags. I.e., if a criterion
+#' flag can't be derived with this function, the derivation is not ADaM
+#' compliant. It helps to ensure that
+#' - the condition of the criterion depends only on variables of the same row,
+#' - the `CRITyFL` is populated with valid values, i.e, either `"Y"` and `NA` or
+#'  `"Y"`, `"N"`, and `NA`.
+#' - the `CRITy` variable is populated correctly, i.e.,
+#'   - set to a constant value within a parameter if `CRITyFL` is populated with
+#'   `"Y"`, `"N"`, and `NA` and
+#'   - set to a constant value within a parameter if the criterion condition is
+#'   fulfilled and to `NA` otherwise if `CRITyFL` is populated with `"Y"`,  and
+#'   `NA`
+#'
+#' @param dataset Input dataset
+#' @param crit_nr The criterion number, i.e., the `y` in `CRITy`
+#'
+#'   *Permitted Values*: a positive integer
+#' @param condition Condition for flagging records
+#'
+#'   See description of the `values_yn` argument for details on how the
+#'   `CRITyFL` variable is populated.
+#'
+#'   *Permitted Values*: an unquoted expression which evaluates to a logical (in
+#'    `dataset`)
+#' @param description The description of the criterion
+#'
+#'   The `CRITy` variable is set to the specified value.
+#'
+#'   An expression can be specified to set the value depending on the parameter.
+#'   Please note that the value must be constant within a parameter.
+#'
+#'   *Permitted Values*: an unquoted expression which evaluates to a character
+#'    (in `dataset`)
+#' @param values_yn Should `"Y"` and `"N"` be used for `CRITyFL`?
+#'
+#'   If set to `TRUE`, the `CRITyFL` variable is set to `"Y"` if the condition
+#'   (`condition`) evaluates to `TRUE`, it is set to `"N"` if the condition
+#'   evaluate to `FALSE`, and to `NA` if it evaluates to `NA`.
+#'
+#'   Otherwise, the `CRITyFL` variable is set to `"Y"` if the condition
+#'   (`condition`) evaluates to `TRUE`, and to `NA` otherwise.
+#'
+#'   *Permitted Values*: `TRUE`, `FALSE`
+#' @param create_numeric_flag Create a numeric flag?
+#'
+#'   If set to `TRUE`, the `CRITyFLN` variable is created. It is set to `1` if
+#'   `CRITyFL == "Y"`, it set to `0` if `CRITyFL == "N"`, and to `NA` otherwise.
+#'
+#'   *Permitted Values*: `TRUE`, `FALSE`
+#' @return The input dataset with the variables `CRITy`, `CRITyFL`, and
+#'   optionally `CRITyFLN` added.
+#'
+#' @family der_bds_findings
+#' @keywords der_bds_findings
+#'
+#' @export
+#'
+#' @examples
+#' library(tibble)
+#' adbds <- tribble(
+#'   ~PARAMCD, ~AVAL,
+#'   "AST",    42,
+#'   "AST",    52,
+#'   "AST",    NA_real_,
+#'   "ALT",    33,
+#'   "ALT",    51
+#' )
+#'
+#' # Create a criterion flag with values "Y" and NA
+#' derive_vars_crit_flag(
+#'   adbds,
+#'   condition = AVAL > 50,
+#'   description = "Absolute value > 50"
+#' )
+#'
+#' # Create criterion flag with values "Y", "N", and NA and parameter dependent
+#' # criterion description
+#' derive_vars_crit_flag(
+#'   adbds,
+#'   crit_nr = 2,
+#'   condition = AVAL > 50,
+#'   description = paste(PARAMCD, "> 50"),
+#'   values_yn = TRUE,
+#'   create_numeric_flag = TRUE
+#' )
+derive_vars_crit_flag <- function(dataset,
+                                  crit_nr = 1,
+                                  condition,
+                                  description,
+                                  values_yn = FALSE,
+                                  create_numeric_flag = FALSE) {
+  assert_data_frame(dataset)
+  assert_integer_scalar(crit_nr, subset = "positive")
+  condition <- assert_filter_cond(enexpr(condition))
+  description <- assert_expr(enexpr(description))
+  assert_logical_scalar(values_yn)
+  assert_logical_scalar(create_numeric_flag)
+
+  new_critvar <- paste0("CRIT", as.character(crit_nr))
+  new_critflvar <- paste0("CRIT", as.character(crit_nr), "FL")
+
+  warn_if_vars_exist(dataset, new_critvar)
+  warn_if_vars_exist(dataset, new_critflvar)
+
+  if (values_yn) {
+    crityfl_no <- "N"
+    crityfln_no <- 0L
+  } else {
+    crityfl_no <- NA_character_
+    crityfln_no <- NA_integer_
+  }
+
+  tryCatch(
+    dataset <- dataset %>% mutate(!!new_critflvar := if_else(!!condition, "Y", crityfl_no)),
+    error = function(cnd) {
+      cli_abort(
+        c(
+          "Evaluating {.arg condition} ({.code {as_label(condition)}}) in {.arg dataset} failed:",
+          ` ` = cnd$parent$message
+        ),
+        call = parent.frame(n = 4)
+      )
+    }
+  )
+
+  tryCatch(
+    {
+      if (values_yn) {
+        dataset <- dataset %>% mutate(!!new_critvar := !!description)
+      } else {
+        dataset <- dataset %>% mutate(
+          !!new_critvar := if_else(!!sym(new_critflvar) == "Y", !!description, NA_character_)
+        )
+      }
+    },
+    error = function(cnd) {
+      cli_abort(
+        c(
+          paste(
+            "Evaluating {.arg description} ({.code {as_label(description)}}) in",
+            "{.arg dataset} failed:"
+          ),
+          ` ` = cnd$parent$message
+        ),
+        call = parent.frame(n = 4)
+      )
+    }
+  )
+
+  if (create_numeric_flag) {
+    new_critflnvar <- paste0("CRIT", as.character(crit_nr), "FLN")
+    dataset <- dataset %>% mutate(
+      !!new_critflnvar := yn_to_numeric(!!sym(new_critflvar))
+    )
+  }
+  dataset
+}

R/user_helpers.R

@@ -1,19 +1,19 @@
 #' 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 names
+#'   `r map_chr(list_all_templates(), ~ paste0("\\code{\"", .x, "\"}"))`.
+#'   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`.
 #' @param open Whether to open the script right away.
 #'
 #' @return No return values, called for side effects
 #'
-#' @details Running without any arguments such as `use_ad_template()` auto-generates adsl.R in
+#' @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
 #' @keywords utils_examples
 #'

inst/WORDLIST

@@ -4,7 +4,6 @@ ADEG
 ADEX
 ADJAE
 ADLB
-ADLBHY
 ADMH
 ADNCA
 ADPC
@@ -37,7 +36,6 @@ Alanine
 Alkalosis
 Analyte
 Ania
-Asha
 Aspartate
 BDS
 BILI
@@ -61,7 +59,6 @@ CTCAEV
 CTCAEv
 CVD
 Carlucci
-Chakma
 Cheatsheet
 Chemistries
 Chol
@@ -96,7 +93,6 @@ Fibrinogen
 Findability
 Framingham
 Franciszek
-Francois
 Fridericia
 Fridericia's
 Fujimoto
@@ -240,14 +236,12 @@ ULN
 USUBJID
 USUBJIDs
 Upadhyay
-VAD
 Vignesh
 WBC
 Walkowiak
 Wenyi
 XXXXXXXX
 Yohann
-acknowledgements
 admiralci
 admiraldev
 admiralonco

inst/templates/ad_adlbhy.R

@@ -22,24 +22,24 @@ adlb <- admiral_adlb
 
 adlb_annotated <- adlb %>%
   filter(PARAMCD %in% c("AST", "ALT", "BILI") & is.na(DTYPE)) %>%
-  mutate(CRIT1 = case_when(
-    PARAMCD == "AST" ~ "AST >=3xULN",
-    PARAMCD == "ALT" ~ "ALT >=3xULN",
-    PARAMCD == "BILI" ~ "BILI >=2xULN"
-  )) %>%
   # Assign flags for contribution to potential Hy's Law event
-  call_derivation(
-    .,
-    derivation = derive_var_merged_exist_flag,
-    dataset_add = .,
-    by_vars = exprs(USUBJID, LBSEQ, PARAMCD, ADT),
-    variable_params = list(
-      params(
-        new_var = CRIT1FL,
-        condition = (
-          (AVAL / ANRHI >= 3 & PARAMCD %in% c("AST", "ALT")) |
-            (AVAL / ANRHI >= 2 & PARAMCD == "BILI")
-        )
+  slice_derivation(
+    derive_vars_crit_flag,
+    args = params(
+      values_yn = TRUE
+    ),
+    derivation_slice(
+      filter = PARAMCD %in% c("AST", "ALT"),
+      args = params(
+        condition = AVAL / ANRHI >= 3,
+        description = paste(PARAMCD, ">=3xULN")
+      )
+    ),
+    derivation_slice(
+      filter = PARAMCD == "BILI",
+      args = params(
+        condition = AVAL / ANRHI >= 2,
+        description = "BILI >= 2xULN"
       )
     )
   ) %>%
@@ -52,14 +52,14 @@ altast_records <- adlb_annotated %>%
 bili_records <- adlb_annotated %>%
   filter(PARAMCD %in% c("BILI"))
 
-# Use a join and filter to accomplish time-window search
+# Flag elevated AST/ALT values with a BILI elevation within 14 days
 hylaw_records <- derive_vars_joined(
   dataset = altast_records,
   dataset_add = bili_records,
   by_vars = exprs(STUDYID, USUBJID),
   order = exprs(ADY),
   join_type = "all",
-  filter_join = ADT.join - ADT <= 14 & CRIT1FL == "Y" & CRIT1FL.join == "Y",
+  filter_join = 0 <= ADT.join - ADT & ADT.join - ADT <= 14 & CRIT1FL == "Y" & CRIT1FL.join == "Y",
   new_vars = exprs(BILI_LBSEQ = LBSEQ, BILI_DT = ADT, BILI_CRITFL = CRIT1FL),
   mode = "first"
 )