Merge branch 'main' into 2146_compute_tmf_bug

pharmaverse · Nov 3, 2023 · 8e682d0 · 8e682d0
2 parents fe2171f + 4fd22ce
commit 8e682d0
Show file tree

Hide file tree

Showing 12 changed files with 244 additions and 126 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -6,15 +6,21 @@
 
 - `derive_extreme_records()`, `derive_var_extreme_flag()`,`derive_vars_joined()` and `derive_vars_merged()` were enhanced with the arguments `true_value` and `false_value` to align with preexisting functions that had similar functionality (#2125)
 
-- `restrict_derivation()` now allows `{dplyr}` functions like `mutate` in the `derivation argument (#2143)
+- `restrict_derivation()` now allows `{dplyr}` functions like `mutate` in the
+`derivation` argument (#2143)
 
 - `derive_summary_records()`, `derive_var_merged_summary()`, and `get_summary_records()`
 were enhanced such that more than one summary variable can be derived, e.g.,
 `AVAL` as the sum and `ADT` as the maximum of the contributing records. (#1792)
 
+- The `tmp_event_nr_var` argument was added to `derive_extreme_records()` to
+allow more control of the selection of records. It creates a temporary variable
+for the event number, which can be used in `order`. (#2140)
 
 ## Breaking Changes
 
+- `derive_extreme_records()` the `dataset_add` argument is now mandatory. (#2139)
+
 - In `derive_summary_records()` and `get_summary_records()` the arguments
 `analysis_var` and `summary_fun` were deprecated in favor of `set_values_to`.
 (#1792)
@@ -28,6 +34,31 @@ were enhanced such that more than one summary variable can be derived, e.g.,
 
 - The default value for the `false_value` argument in `derive_extreme_records()` was changed to `NA_character_` (#2125)
 
+- The `ignore_event_order` argument in `derive_extreme_event()` was deprecated
+and the selection of the records was changed to allow more control. Before, the
+records were selected first by event and then by `order`. Now they are selected
+by `order` only but the event number can be added to it.
+
+   To achieve the old behavior update
+```
+order = exprs(my_order_var),
+ignore_event_order = FALSE,
+```
+to
+```
+tmp_event_nr_var = event_nr,
+order = exprs(event_nr, my_order_var),
+```
+and
+```
+order = exprs(my_order_var),
+ignore_event_order = TRUE,
+```
+to
+```
+order = exprs(my_order_var),
+```
+
 - The following functions, which were deprecated in previous `{admiral}` versions, have been removed: (#2098)
   - `derive_param_extreme_event()`
   - `derive_vars_last_dose()`

diff --git a/R/derive_extreme_event.R b/R/derive_extreme_event.R
@@ -18,6 +18,16 @@
 #'   For `event_joined()` events the observations are selected by calling
 #'   `filter_joined`. The `condition` field is passed to the `filter` argument.
 #'
+#' @param tmp_event_nr_var Temporary event number variable
+#'
+#'   The specified variable is added to all source datasets and is set to the
+#'   number of the event before selecting the records of the event.
+#'
+#'   It can be used in `order` to determine which record should be used if
+#'   records from more than one event are selected.
+#'
+#'   The variable is not included in the output dataset.
+#'
 #' @param order Sort order
 #'
 #'   If a particular event from `events` has more than one observation, within
@@ -41,6 +51,13 @@
 #'
 #' @param ignore_event_order Ignore event order
 #'
+#'   `r lifecycle::badge("deprecated")`
+#'
+#'   This argument is *deprecated*. If event order should be ignored, please
+#'   specify neither `ignore_event_order` nor `tmp_event_nr_var`. If the event
+#'   order should be considered, don't specify `ignore_event_order` but specify
+#'   `tmp_event_nr_var` and and the specified variable to `order`.
+#'
 #'   If the argument is set to `TRUE`, all events defined by `events` are
 #'   considered equivalent. If there is more than one observation per by group
 #'   the first or last (with respect to `mode` and `order`) is select without
@@ -73,12 +90,14 @@
 #'
 #'       1. The variables specified by the `set_values_to` field of the event
 #'       are added to the selected observations.
+#'       1. The variable specified for `tmp_event_nr_var` is added and set to
+#'       the number of the event.
 #'       1. Only the variables specified for the `keep_source_vars` field of the
 #'       event, and the by variables (`by_vars`) and the variables created by
 #'       `set_values_to` are kept.
+#'   1. All selected observations are bound together.
 #'   1. For each group (with respect to the variables specified for the
-#'   `by_vars` parameter) the first event is selected. If there is more than one
-#'   observation per event the first or last observation (with respect to 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
@@ -141,8 +160,9 @@
 #'       set_values_to = exprs(AVALC = "Missing", AVAL = 99)
 #'     )
 #'   ),
-#'   order = exprs(ADY),
-#'   mode = "last",
+#'   tmp_event_nr_var = event_nr,
+#'   order = exprs(event_nr, desc(ADY)),
+#'   mode = "first",
 #'   set_values_to = exprs(
 #'     PARAMCD = "WSP",
 #'     PARAM = "Worst Sleeping Problems"
@@ -178,7 +198,8 @@
 #'       set_values_to = exprs(AVALC = "Y")
 #'     )
 #'   ),
-#'   order = exprs(AVISITN),
+#'   tmp_event_nr_var = event_nr,
+#'   order = exprs(event_nr, AVISITN),
 #'   mode = "first",
 #'   keep_source_vars = exprs(AVISITN),
 #'   set_values_to = exprs(
@@ -243,7 +264,8 @@
 #' derive_extreme_event(
 #'   adrs,
 #'   by_vars = exprs(USUBJID),
-#'   order = exprs(ADT),
+#'   tmp_event_nr_var = event_nr,
+#'   order = exprs(event_nr, ADT),
 #'   mode = "first",
 #'   source_datasets = list(adsl = adsl),
 #'   events = list(
@@ -321,6 +343,7 @@
 derive_extreme_event <- function(dataset,
                                  by_vars = NULL,
                                  events,
+                                 tmp_event_nr_var = NULL,
                                  order,
                                  mode,
                                  source_datasets = NULL,
@@ -355,7 +378,29 @@ derive_extreme_event <- function(dataset,
     )
   }
 
-  assert_logical_scalar(ignore_event_order)
+  if (!missing(ignore_event_order)) {
+    assert_logical_scalar(ignore_event_order)
+    if (ignore_event_order) {
+      deprecate_details <- paste(
+        "The event order is ignored by default.",
+        "Please remove `ignore_event_order = TRUE` from the call.",
+        sep = "\n"
+      )
+    } else {
+      deprecate_details <- c(
+        "Please remove `ignore_event_order = FALSE` from the call.",
+        "Specify `tmp_event_nr_var`.",
+        "Add the specified variable to `order`."
+      )
+    }
+    deprecate_warn(
+      "1.0.0",
+      "derive_extreme_event(ignore_event_order=)",
+      "derive_extreme_event(tmp_event_nr_var=)",
+      details = deprecate_details
+    )
+  }
+  tmp_event_nr_var <- assert_symbol(enexpr(tmp_event_nr_var), optional = TRUE)
   check_type <-
     assert_character_scalar(
       check_type,
@@ -368,11 +413,6 @@ derive_extreme_event <- function(dataset,
   # Create new observations
   ## Create a dataset (selected_records) from `events`
   event_index <- as.list(seq_along(events))
-  if (ignore_event_order) {
-    tmp_event_no <- NULL
-  } else {
-    tmp_event_no <- get_new_tmp_var(dataset, prefix = "tmp_event_no")
-  }
 
   selected_records_ls <- map2(
     events,
@@ -383,6 +423,9 @@ derive_extreme_event <- function(dataset,
       } else {
         data_source <- source_datasets[[event$dataset_name]]
       }
+      if (!is.null(tmp_event_nr_var)) {
+        data_source <- mutate(data_source, !!tmp_event_nr_var := index)
+      }
       if (is.null(event$order)) {
         event_order <- order
       } else {
@@ -417,41 +460,26 @@ derive_extreme_event <- function(dataset,
       } else {
         event_keep_source_vars <- event$keep_source_vars
       }
-      if (!ignore_event_order) {
-        data_events <- mutate(data_events, !!tmp_event_no := index)
-      }
       data_events %>%
         process_set_values_to(set_values_to = event$set_values_to) %>%
-        select(!!!event_keep_source_vars, !!tmp_event_no, !!!by_vars, names(event$set_values_to))
+        select(
+          !!!event_keep_source_vars, !!tmp_event_nr_var, !!!by_vars,
+          names(event$set_values_to)
+        )
     }
   )
   selected_records <- bind_rows(selected_records_ls)
 
-  ## tmp obs number within by_vars and a type of event
-  tmp_obs <- get_new_tmp_var(selected_records)
-  selected_records <- selected_records %>%
-    derive_var_obs_number(
-      new_var = !!tmp_obs,
-      order = order,
-      by_vars = expr_c(by_vars, tmp_event_no),
-      check_type = check_type
-    )
-
   ## filter_extreme
-  if (mode == "first") {
-    tmp_obs_expr <- expr(!!tmp_obs)
-  } else {
-    tmp_obs_expr <- expr(desc(!!tmp_obs))
-  }
   new_obs <- selected_records %>%
     filter_extreme(
       by_vars = by_vars,
-      order = expr_c(tmp_event_no, tmp_obs_expr),
-      mode = "first",
+      order = order,
+      mode = mode,
       check_type = check_type
     ) %>%
     mutate(!!!set_values_to) %>%
-    select(-!!tmp_event_no, -!!tmp_obs)
+    select(-!!tmp_event_nr_var)
 
   # Create output dataset
   bind_rows(dataset, new_obs)

diff --git a/R/derive_extreme_records.R b/R/derive_extreme_records.R
@@ -1,18 +1,14 @@
 #' 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. 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()`,
+#' new observations can be selected from the 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 `r roxygen_param_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
@@ -21,18 +17,12 @@
 #'
 #' @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 additional 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 by the `by_vars` and `order` argument (if
-#'   applicable) are expected.
+#'   The variables specified in the `by_vars` and `filter_add` parameters are expected
+#'   in this dataset. If `mode` and `order` are specified, the first or last observation
+#'   within each by group, defined by `by_vars`, is selected.
 #'
 #' @param by_vars Grouping variables
 #'
@@ -149,6 +139,7 @@
 #' # Specify the variables that need to be kept in the new records.
 #' derive_extreme_records(
 #'   adlb,
+#'   dataset_add = adlb,
 #'   by_vars = exprs(USUBJID),
 #'   order = exprs(AVAL, AVISITN),
 #'   mode = "first",
@@ -165,6 +156,7 @@
 #' # AVISITN. Set AVISITN = 98 and DTYPE = MAXIMUM for these new records.
 #' derive_extreme_records(
 #'   adlb,
+#'   dataset_add = adlb,
 #'   by_vars = exprs(USUBJID),
 #'   order = exprs(desc(AVAL), AVISITN),
 #'   mode = "first",
@@ -179,6 +171,7 @@
 #' # Set AVISITN = 99 and DTYPE = LOV for these new records.
 #' derive_extreme_records(
 #'   adlb,
+#'   dataset_add = adlb,
 #'   by_vars = exprs(USUBJID),
 #'   order = exprs(AVISITN),
 #'   mode = "last",
@@ -254,7 +247,7 @@
 #'   )
 #' )
 derive_extreme_records <- function(dataset = NULL,
-                                   dataset_add = NULL,
+                                   dataset_add,
                                    dataset_ref = NULL,
                                    by_vars = NULL,
                                    order = NULL,
@@ -271,21 +264,13 @@ derive_extreme_records <- function(dataset = NULL,
   assert_expr_list(order, optional = TRUE)
   assert_expr_list(keep_source_vars, optional = TRUE)
 
-  if (is.null(dataset_add)) {
-    expected_vars <- expr_c(by_vars, extract_vars(order))
-  } else {
-    expected_vars <- by_vars
-  }
-
   assert_data_frame(
     dataset,
-    required_vars = expected_vars,
     optional = TRUE
   )
   assert_data_frame(
     dataset_add,
-    required_vars = expr_c(by_vars, extract_vars(order)),
-    optional = TRUE
+    required_vars = expr_c(by_vars, extract_vars(order))
   )
   assert_data_frame(
     dataset_ref,
@@ -307,18 +292,8 @@ derive_extreme_records <- function(dataset = NULL,
   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
-  if (is.null(dataset_add)) {
-    dataset_add <- dataset
-  }
   new_add_obs <- filter_if(dataset_add, filter_add)
 
   if (!is.null(order)) {