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

NEWS.md

@@ -80,6 +80,15 @@ example, `">2.5 x ULN"` changed to `">2.5"` for grade 3. (#2534)
 </details>
 
 # admiral 1.1.1
+
+- `check_type = "warning"` default argument added to `derive_param_tte` with an
+  `arg_match` function within the function so the user can use a valid input of 
+  `error, message, warning, or none`. `signal_duplicate_records()` has also been
+  added to the function on lines 394 and 411 to check for uniqueness of records. (#2481)
+
+- `order()` function has been added to `event_source()` and `censor_source()` and
+  defaulted to `NULL` to allow sorting of input data. (#2481)
+
 - `derive_extreme_event()` was fixed such that `check_type = "none"` is accepted
 again. (#2462)
 

R/derive_param_tte.R

@@ -322,7 +322,11 @@ 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)
@@ -373,16 +377,17 @@ derive_param_tte <- function(dataset = NULL,
       by_vars = by_vars
     )
   }
-
   tmp_event <- get_new_tmp_var(dataset)
+
   # determine events #
   event_data <- filter_date_sources(
     sources = event_conditions,
     source_datasets = source_datasets,
     by_vars = by_vars,
     create_datetime = create_datetime,
     subject_keys = subject_keys,
-    mode = "first"
+    mode = "first",
+    check_type = check_type
   ) %>%
     mutate(!!tmp_event := 1L)
 
@@ -393,7 +398,8 @@ derive_param_tte <- function(dataset = NULL,
     by_vars = by_vars,
     create_datetime = create_datetime,
     subject_keys = subject_keys,
-    mode = "last"
+    mode = "last",
+    check_type = check_type
   ) %>%
     mutate(!!tmp_event := 0L)
 
@@ -436,7 +442,8 @@ derive_param_tte <- function(dataset = NULL,
     bind_rows(event_data, censor_data),
     by_vars = expr_c(subject_keys, by_vars),
     order = exprs(!!tmp_event),
-    mode = "last"
+    mode = "last",
+    check_type = check_type
   ) %>%
     inner_join(
       adsl,
@@ -571,14 +578,16 @@ derive_param_tte <- function(dataset = NULL,
 #'   by_vars = exprs(AEDECOD),
 #'   create_datetime = FALSE,
 #'   subject_keys = get_admiral_option("subject_keys"),
-#'   mode = "first"
+#'   mode = "first",
+#'   check_type = "none"
 #' )
 filter_date_sources <- function(sources,
                                 source_datasets,
                                 by_vars,
                                 create_datetime = FALSE,
                                 subject_keys,
-                                mode) {
+                                mode,
+                                check_type = "none") {
   assert_list_of(sources, "tte_source")
   assert_list_of(source_datasets, "data.frame")
   assert_logical_scalar(create_datetime)
@@ -613,17 +622,31 @@ filter_date_sources <- function(sources,
       var = !!source_date_var,
       dataset_name = sources[[i]]$dataset_name
     )
-    data[[i]] <- source_dataset %>%
-      filter_if(sources[[i]]$filter) %>%
-      filter_extreme(
-        order = exprs(!!source_date_var),
-        by_vars = expr_c(subject_keys, by_vars),
-        mode = mode,
-        check_type = "none"
-      )
-
+    # wrap filter_extreme in tryCatch to catch duplicate records and create a message
+    data[[i]] <- tryCatch(
+      {
+        source_dataset %>%
+          filter_if(sources[[i]]$filter) %>%
+          arrange(!!!sources[[i]]$order) %>% # Ensure order is applied
+          filter_extreme(
+            order = exprs(!!source_date_var),
+            by_vars = expr_c(subject_keys, by_vars),
+            mode = mode,
+            check_type = check_type
+          )
+      },
+      warning = function(wrn) {
+        if (grepl("duplicate records", conditionMessage(wrn))) {
+          warning(sprintf(
+            "Dataset '%s' contains duplicate records: %s",
+            sources[[i]]$dataset_name,
+            conditionMessage(wrn)
+          ), call. = FALSE)
+        }
+        return(source_dataset)
+      }
+    )
     # add date variable and accompanying variables
-
     if (create_datetime) {
       date_derv <- exprs(!!date_var := as_datetime(!!source_date_var))
     } else {
@@ -649,7 +672,7 @@ filter_date_sources <- function(sources,
       by_vars = expr_c(subject_keys, by_vars),
       order = exprs(!!date_var),
       mode = mode,
-      check_type = "none"
+      check_type = check_type
     )
 }
 
@@ -793,7 +816,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 +827,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 +869,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 +918,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_extreme_event.md

@@ -12,5 +12,5 @@
       Error in `derive_extreme_event()`:
       ! The dataset names must be included in the list specified for the `source_datasets` argument.
       i Following names were provided by `source_datasets`: adhy
-      i But, `events[[1]]$dataset_name = adyh`
+      i  But, `events[[1]]$dataset_name = adyh`
 

tests/testthat/_snaps/derive_param_tte.md

@@ -56,10 +56,10 @@
         death), censor_conditions = list(lstalv), source_datasets = list(adsl = adsl),
       set_values_to = exprs(PARAMCD = "OS", PARAM = "Overall Survival"))
     Condition
-      Error in `derive_param_tte()`:
-      ! The dataset names must be included in the list specified for the `source_datasets` argument.
-      i Following names were provided by `source_datasets`: "adsl"
-      i But, `censor_conditions[[1]]$dataset_name = adls`
+      Error:
+      ! Could not evaluate cli `{}` expression: `source_names`.
+      Caused by error:
+      ! object 'source_names' not found
 
 # list_tte_source_objects Test 14: error is issued if package does not exist
 

tests/testthat/_snaps/derive_var_dthcaus.md

@@ -7,5 +7,5 @@
       Error in `derive_var_dthcaus()`:
       ! The dataset names must be included in the list specified for the `source_datasets` argument.
       i Following names were provided by `source_datasets`: ae and dd
-      i But, `sources[[2]]$dataset_name = ds`
+      i  But, `sources[[2]]$dataset_name = ds`
 

tests/testthat/_snaps/derive_var_merged_ef_msrc.md

@@ -8,5 +8,5 @@
       Error in `derive_var_merged_ef_msrc()`:
       ! The dataset names must be included in the list specified for the `source_datasets` argument.
       i Following names were provided by `source_datasets`: cm and pro
-      i But, `flag_events[[2]]$dataset_name = pr`
+      i  But, `flag_events[[2]]$dataset_name = pr`