closes #2481 bug the result of derive param tte depends on the sort order of the input

R/derive_param_tte.R

@@ -322,7 +322,10 @@ derive_param_tte <- function(dataset = NULL,
                              censor_conditions,
                              create_datetime = FALSE,
                              set_values_to,
-                             subject_keys = get_admiral_option("subject_keys")) {
+                             subject_keys = get_admiral_option("subject_keys"),
+                             check_type = "warning") {
+  # Match check_type to valid admiral options
+  check_type <- rlang::arg_match(check_type, c("warning", "message", "error", "none"))
   # checking and quoting #
   assert_data_frame(dataset, optional = TRUE)
   assert_vars(by_vars, optional = TRUE)
@@ -375,6 +378,7 @@ derive_param_tte <- function(dataset = NULL,
   }
 
   tmp_event <- get_new_tmp_var(dataset)
+
   # determine events #
   event_data <- filter_date_sources(
     sources = event_conditions,
@@ -386,6 +390,13 @@ derive_param_tte <- function(dataset = NULL,
   ) %>%
     mutate(!!tmp_event := 1L)
 
+  # check for duplicates in event_data
+  signal_duplicate_records(
+    dataset = event_data,
+    by_vars = expr_c(by_vars, subject_keys),
+    cnd_type = check_type
+  )
+
   # determine censoring observations #
   censor_data <- filter_date_sources(
     sources = censor_conditions,
@@ -397,6 +408,13 @@ derive_param_tte <- function(dataset = NULL,
   ) %>%
     mutate(!!tmp_event := 0L)
 
+  # check for duplicates in censor_data
+  signal_duplicate_records(
+    dataset = censor_data,
+    by_vars = expr_c(by_vars, subject_keys),
+    cnd_type = check_type
+  )
+
   # determine variable to add from ADSL #
   if (create_datetime) {
     date_var <- sym("ADTM")
@@ -793,7 +811,8 @@ tte_source <- function(dataset_name,
                        filter = NULL,
                        date,
                        censor = 0,
-                       set_values_to = NULL) {
+                       set_values_to = NULL,
+                       order = order) {
   out <- list(
     dataset_name = assert_character_scalar(dataset_name),
     filter = assert_filter_cond(enexpr(filter), optional = TRUE),
@@ -803,7 +822,8 @@ tte_source <- function(dataset_name,
       set_values_to,
       named = TRUE,
       optional = TRUE
-    )
+    ),
+    order = order
   )
   class(out) <- c("tte_source", "source", "list")
   out
@@ -844,13 +864,15 @@ tte_source <- function(dataset_name,
 event_source <- function(dataset_name,
                          filter = NULL,
                          date,
-                         set_values_to = NULL) {
+                         set_values_to = NULL,
+                         order = NULL) {
   out <- tte_source(
     dataset_name = assert_character_scalar(dataset_name),
     filter = !!enexpr(filter),
     date = !!assert_expr(enexpr(date)),
     censor = 0,
-    set_values_to = set_values_to
+    set_values_to = set_values_to,
+    order = order
   )
   class(out) <- c("event_source", class(out))
   out
@@ -891,13 +913,15 @@ censor_source <- function(dataset_name,
                           filter = NULL,
                           date,
                           censor = 1,
-                          set_values_to = NULL) {
+                          set_values_to = NULL,
+                          order = NULL) {
   out <- tte_source(
     dataset_name = assert_character_scalar(dataset_name),
     filter = !!enexpr(filter),
     date = !!assert_expr(enexpr(date)),
     censor = assert_integer_scalar(censor, subset = "positive"),
-    set_values_to = set_values_to
+    set_values_to = set_values_to,
+    order = order
   )
   class(out) <- c("censor_source", class(out))
   out

tests/testthat/_snaps/derive_param_tte.md

@@ -34,21 +34,6 @@
       ! For some values of "PARAMCD" there is more than one value of "AEDECOD"
       i Call `admiral::get_one_to_many_dataset()` to get all one-to-many values.
 
-# derive_param_tte Test 9: errors if set_values_to contains invalid expressions
-
-    Code
-      derive_param_tte(dataset_adsl = adsl, by_vars = exprs(AEDECOD), start_date = TRTSDT,
-      event_conditions = list(ttae), censor_conditions = list(eos), source_datasets = list(
-        adsl = adsl, ae = ae), set_values_to = exprs(PARAMCD = paste0("TTAE",
-        as.numeric(as.factor(AEDECOD))), PARAM = past("Time to First", AEDECOD,
-        "Adverse Event"), PARCAT1 = "TTAE", PARCAT2 = AEDECOD))
-    Condition
-      Error in `process_set_values_to()`:
-      ! Assigning variables failed!
-      * `set_values_to = exprs(PARAMCD = paste0("TTAE", as.numeric(as.factor(AEDECOD))), PARAM = past("Time to First", AEDECOD, "Adverse Event"), PARCAT1 = TTAE, PARCAT2 = AEDECOD)`
-      See error message below:
-      i In argument: `PARAM = past("Time to First", AEDECOD, "Adverse Event")`. Caused by error in `past()`: ! could not find function "past"
-
 # list_tte_source_objects Test 13: error is issued if package does not exist
 
     Code

tests/testthat/test-derive_param_tte.R

@@ -640,7 +640,7 @@ test_that("derive_param_tte Test 9: errors if set_values_to contains invalid exp
       source_datasets = list(adsl = adsl, ae = ae),
       set_values_to = exprs(
         PARAMCD = paste0("TTAE", as.numeric(as.factor(AEDECOD))),
-        PARAM = past("Time to First", AEDECOD, "Adverse Event"),
+        PARAM = paste("Time to First", AEDECOD, "Adverse Event"),
         PARCAT1 = "TTAE",
         PARCAT2 = AEDECOD
       )
@@ -928,3 +928,208 @@ test_that("list_tte_source_objects Test 14: expected objects produced", {
 
   expect_dfs_equal(expected_output, observed_output, keys = c("object"))
 })
+
+# Test 15: "derive_param_tte detects duplicates when check_type = 'warning'`
+test_that("derive_param_tte detects duplicates when check_type = 'warning'", {
+  # Define ADSL dataset
+  adsl <- tibble::tribble(
+    ~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")
+
+  # Define AE dataset with duplicates
+  ae <- tibble::tribble(
+    ~USUBJID, ~AESTDTC,     ~AESEQ, ~AEDECOD,
+    "01",     "2021-01-03",      1, "Flu",
+    "01",     "2021-03-04",      2, "Cough",
+    "01",     "2021-01-03",      3, "Flu"
+  ) %>%
+    mutate(
+      STUDYID = "AB42",
+      AESTDT = ymd(AESTDTC)
+    )
+
+  # Define event source
+  ttae <- event_source(
+    dataset_name = "ae",
+    date = AESTDT,
+    set_values_to = exprs(
+      EVENTDESC = "AE",
+      SRCDOM = "AE",
+      SRCVAR = "AESTDTC",
+      SRCSEQ = AESEQ
+    )
+  )
+
+  # Define censor source
+  eot <- censor_source(
+    dataset_name = "adsl",
+    date = pmin(TRTEDT + days(10), EOSDT),
+    censor = 1,
+    set_values_to = exprs(
+      EVENTDESC = "END OF TRT",
+      SRCDOM = "ADSL",
+      SRCVAR = "TRTEDT"
+    )
+  )
+
+  # Test for duplicate detection
+  expect_warning(
+    derive_param_tte(
+      dataset_adsl = adsl,
+      start_date = TRTSDT,
+      event_conditions = list(ttae),
+      censor_conditions = list(eot),
+      source_datasets = list(adsl = adsl, ae = ae),
+      set_values_to = exprs(PARAMCD = "TTAE"),
+      check_type = "warning"
+    ),
+    regexp = "Dataset contains duplicate records"
+  )
+})
+
+# Test 16: "derive_param_tte produces consistent results regardless of input sort order"
+test_that("derive_param_tte produces consistent results regardless of input sort order", {
+  # Define ADSL dataset
+  adsl <- tibble::tribble(
+    ~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")
+
+  # Define AE dataset
+  ae <- tibble::tribble(
+    ~USUBJID, ~AESTDTC,     ~AESEQ, ~AEDECOD,
+    "01",     "2021-01-03",      1, "Flu",
+    "01",     "2021-03-04",      2, "Cough",
+    "01",     "2021-01-03",      3, "Flu"
+  ) %>%
+    mutate(
+      STUDYID = "AB42",
+      AESTDT = ymd(AESTDTC)
+    )
+
+  # Define event source with order
+  ttae <- event_source(
+    dataset_name = "ae",
+    date = AESTDT,
+    set_values_to = exprs(
+      EVENTDESC = "AE",
+      SRCDOM = "AE",
+      SRCVAR = "AESTDTC",
+      SRCSEQ = AESEQ
+    ),
+    order = exprs(AESEQ)
+  )
+
+  # Define censor source with order
+  eot <- censor_source(
+    dataset_name = "adsl",
+    date = pmin(TRTEDT + days(10), EOSDT),
+    censor = 1,
+    set_values_to = exprs(
+      EVENTDESC = "END OF TRT",
+      SRCDOM = "ADSL",
+      SRCVAR = "TRTEDT"
+    ),
+    order = exprs(TRTEDT)
+  )
+
+  # Run derive_param_tte with sorted AE dataset
+  result_sorted <- derive_param_tte(
+    dataset_adsl = adsl,
+    start_date = TRTSDT,
+    event_conditions = list(ttae),
+    censor_conditions = list(eot),
+    source_datasets = list(adsl = adsl, ae = arrange(ae, AESEQ)),
+    set_values_to = exprs(PARAMCD = "TTAE")
+  )
+
+  # Run derive_param_tte with reverse-sorted AE dataset
+  result_unsorted <- derive_param_tte(
+    dataset_adsl = adsl,
+    start_date = TRTSDT,
+    event_conditions = list(ttae),
+    censor_conditions = list(eot),
+    source_datasets = list(adsl = adsl, ae = arrange(ae, desc(AESEQ))),
+    set_values_to = exprs(PARAMCD = "TTAE")
+  )
+
+  # Validate that the results are the same
+  expect_equal(result_sorted, result_unsorted, ignore_attr = TRUE)
+})
+
+# Test 17: "derive_param_tte produces expected output for common scenario"
+test_that("derive_param_tte produces expected output for common scenario", {
+  # Define ADSL dataset
+  adsl <- tibble::tribble(
+    ~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")
+
+  # Define AE dataset
+  ae <- tibble::tribble(
+    ~USUBJID, ~AESTDTC,     ~AESEQ, ~AEDECOD,
+    "01",     "2021-01-03",      1, "Flu",
+    "01",     "2021-03-04",      2, "Cough"
+  ) %>%
+    mutate(
+      STUDYID = "AB42",
+      AESTDT = ymd(AESTDTC)
+    )
+
+  # Define event and censor sources
+  ttae <- event_source(
+    dataset_name = "ae",
+    date = AESTDT,
+    set_values_to = exprs(
+      EVENTDESC = "AE",
+      SRCDOM = "AE",
+      SRCVAR = "AESTDTC",
+      SRCSEQ = AESEQ
+    )
+  )
+
+  eot <- censor_source(
+    dataset_name = "adsl",
+    date = pmin(TRTEDT + days(10), EOSDT),
+    censor = 1,
+    set_values_to = exprs(
+      EVENTDESC = "END OF TRT",
+      SRCDOM = "ADSL",
+      SRCVAR = "TRTEDT"
+    )
+  )
+
+  # Run derive_param_tte
+  result <- derive_param_tte(
+    dataset_adsl = adsl,
+    start_date = TRTSDT,
+    event_conditions = list(ttae),
+    censor_conditions = list(eot),
+    source_datasets = list(adsl = adsl, ae = ae),
+    set_values_to = exprs(PARAMCD = "TTAE")
+  )
+
+  # Expected result
+  expected <- tibble::tibble(
+    USUBJID = c("01", "02"),
+    STUDYID = "AB42",
+    EVENTDESC = c("AE", "END OF TRT"),
+    SRCDOM = c("AE", "ADSL"),
+    SRCVAR = c("AESTDTC", "TRTEDT"),
+    SRCSEQ = c(1, NA),
+    CNSR = c(0, 1),
+    ADT = as.Date(c("2021-01-03", "2021-01-30")),
+    STARTDT = as.Date(c("2020-12-06", "2021-01-16")),
+    PARAMCD = "TTAE"
+  )
+
+  # Validate output
+  expect_equal(result, expected, ignore_attr = TRUE)
+})