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

R/derive_joined.R

@@ -478,7 +478,7 @@ derive_vars_joined <- function(dataset,
     derive_var_obs_number(
       new_var = !!tmp_obs_nr,
       by_vars = by_vars_left,
-      check_type = "none"
+      "none"
     )
 
   data_joined <- get_joined_data(

R/derive_param_tte.R

@@ -322,8 +322,11 @@ derive_param_tte <- function(dataset = NULL,
                              censor_conditions,
                              create_datetime = FALSE,
                              set_values_to,
-                             subject_keys = get_admiral_option("subject_keys")) {
-  # checking and quoting #
+                             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)
   start_date <- assert_symbol(enexpr(start_date))
@@ -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,11 @@ 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 +406,11 @@ 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")
@@ -463,7 +477,7 @@ derive_param_tte <- function(dataset = NULL,
     }
   }
 
-  # add new parameter to input dataset #
+    # add new parameter to input dataset #
   bind_rows(dataset, new_param)
 }
 
@@ -793,7 +807,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 +818,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 +860,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 +909,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