Closes #2142 Supersede get_summary_records() and enhance derive_summary_records()

DESCRIPTION

@@ -38,8 +38,9 @@ LazyData: true
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.2.3
 Depends: R (>= 4.0)
+Remotes: pharmaverse/admiraldev 
 Imports:
-    admiraldev (>= 0.4.0),
+    admiraldev (>= 0.5.0.9000),
     dplyr (>= 0.8.4),
     hms (>= 0.5.3),
     lifecycle (>= 0.1.0),

NEWS.md

@@ -13,10 +13,13 @@
 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)
 
+- `derive_summary_records()` was enhanced with the following optional arguments: `dataset_add`, `dataset_ref`, `missing_values`. These arguments respectively, generate summary variables from additional datasets, retain/add specific records from a reference dataset, and impute user-defined missing values. (#2142)
+
 - 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)
@@ -25,6 +28,8 @@ for the event number, which can be used in `order`. (#2140)
 `analysis_var` and `summary_fun` were deprecated in favor of `set_values_to`.
 (#1792)
 
+- In `derive_summary_records()` and `derive_param_exposure()` the argument `filter` was renamed to `filter_add` (#2142)
+
 - In `derive_var_merged_summary()` the arguments `new_var`, `analysis_var`, and
 `summary_fun` were deprecated in favor of `new_vars`. (#1792)
 

R/derive_param_exposure.R

@@ -8,13 +8,40 @@
 #'   `PARAMCD` is expected as well,
 #'   + Either `ASTDTM` and `AENDTM` or `ASTDT` and `AENDT` are also expected.
 #'
-#' @param filter Filter condition
+#' @param dataset_add Additional dataset
 #'
-#'   The specified condition is applied to the input dataset before deriving the
-#'   new parameter, i.e., only observations fulfilling the condition are taken
-#'   into account.
+#'   The variables specified for `by_vars` are expected.
+#'   Observations from the specified dataset are going to be used to calculate and added
+#'   as new records to the input dataset (`dataset`).
 #'
-#'   *Permitted Values:* a condition
+#'
+#' @param filter
+#'
+#'  `r lifecycle::badge("deprecated")` Please use `filter_add` instead.
+#'
+#'   Filter condition as logical expression to apply during
+#'   summary calculation. By default, filtering expressions are computed within
+#'   `by_vars` as this will help when an aggregating, lagging, or ranking
+#'   function is involved.
+#'
+#'   For example,
+#'
+#'   + `filter = (AVAL > mean(AVAL, na.rm = TRUE))` will filter all `AVAL`
+#'   values greater than mean of `AVAL` with in `by_vars`.
+#'   + `filter = (dplyr::n() > 2)` will filter n count of `by_vars` greater
+#'   than 2.
+#'
+#' @param filter_add Filter condition as logical expression to apply during
+#'   summary calculation. By default, filtering expressions are computed within
+#'   `by_vars` as this will help when an aggregating, lagging, or ranking
+#'   function is involved.
+#'
+#'   For example,
+#'
+#'   + `filter_add = (AVAL > mean(AVAL, na.rm = TRUE))` will filter all `AVAL`
+#'   values greater than mean of `AVAL` with in `by_vars`.
+#'   + `filter_add = (dplyr::n() > 2)` will filter n count of `by_vars` greater
+#'   than 2.
 #'
 #' @param input_code Required parameter code
 #'
@@ -95,6 +122,7 @@
 #' # Cumulative dose
 #' adex %>%
 #'   derive_param_exposure(
+#'     dataset_add = adex,
 #'     by_vars = exprs(USUBJID),
 #'     set_values_to = exprs(PARAMCD = "TDOSE", PARCAT1 = "OVERALL"),
 #'     input_code = "DOSE",
@@ -106,6 +134,7 @@
 #' # average dose in w2-24
 #' adex %>%
 #'   derive_param_exposure(
+#'     dataset_add = adex,
 #'     by_vars = exprs(USUBJID),
 #'     filter = VISIT %in% c("WEEK 2", "WEEK 24"),
 #'     set_values_to = exprs(PARAMCD = "AVDW224", PARCAT1 = "WEEK2-24"),
@@ -118,6 +147,7 @@
 #' # Any dose adjustment?
 #' adex %>%
 #'   derive_param_exposure(
+#'     dataset_add = adex,
 #'     by_vars = exprs(USUBJID),
 #'     set_values_to = exprs(PARAMCD = "TADJ", PARCAT1 = "OVERALL"),
 #'     input_code = "ADJ",
@@ -126,11 +156,13 @@
 #'   ) %>%
 #'   select(-ASTDTM, -AENDTM)
 derive_param_exposure <- function(dataset,
+                                  dataset_add,
                                   by_vars,
                                   input_code,
                                   analysis_var,
                                   summary_fun,
                                   filter = NULL,
+                                  filter_add = NULL,
                                   set_values_to = NULL) {
   by_vars <- assert_vars(by_vars)
   analysis_var <- assert_symbol(enexpr(analysis_var))
@@ -158,7 +190,17 @@ derive_param_exposure <- function(dataset,
   assert_data_frame(dataset,
     required_vars = expr_c(by_vars, analysis_var, exprs(PARAMCD), dates)
   )
-  filter <- assert_filter_cond(enexpr(filter), optional = TRUE)
+  assert_data_frame(dataset_add, required_vars = by_vars)
+
+  if (!missing(filter)) {
+    deprecate_warn(
+      "1.0.0",
+      I("derive_param_exposure(filter = )"),
+      "derive_param_exposure(filter_add = )"
+    )
+    filter <- assert_filter_cond(enexpr(filter), optional = TRUE)
+  }
+  filter <- assert_filter_cond(enexpr(filter_add), optional = TRUE)
   assert_varval_list(set_values_to, required_elements = "PARAMCD")
   assert_param_does_not_exist(dataset, set_values_to$PARAMCD)
   assert_character_scalar(input_code)
@@ -172,8 +214,9 @@ derive_param_exposure <- function(dataset,
 
   derive_summary_records(
     dataset,
+    dataset_add,
     by_vars = by_vars,
-    filter = PARAMCD == !!input_code & !!filter,
+    filter_add = PARAMCD == !!input_code & !!filter,
     set_values_to = exprs(
       !!analysis_var := {{ summary_fun }}(!!analysis_var),
       !!!set_dtm,

R/derive_summary_records.R

@@ -11,13 +11,29 @@
 #' retain those common values in the newly derived records. Otherwise new value
 #' will be set to `NA`.
 #'
-#' @param dataset  `r roxygen_param_dataset(expected_vars = c("by_vars", "analysis_var"))`
+#' @param dataset  `r roxygen_param_dataset(expected_vars = c("by_vars"))`
+#'
+#' @param dataset_add Additional dataset
+#'
+#'    The variables specified for `by_vars` are expected.
+#'   Observations from the specified dataset are going to be used to calculate and added
+#'   as new records to the input dataset (`dataset`).
+#'
+#' @param dataset_ref Reference dataset
+#'
+#'   The variables specified for `by_vars` are expected. For each
+#'   observation of the specified dataset a new observation is added to the
+#'   input dataset.
 #'
 #' @param by_vars Variables to consider for generation of groupwise summary
 #'   records. Providing the names of variables in [exprs()] will create a
 #'   groupwise summary and generate summary records for the specified groups.
 #'
-#' @param filter Filter condition as logical expression to apply during
+#' @param filter
+#'
+#'  `r lifecycle::badge("deprecated")` Please use `filter_add` instead.
+#'
+#'   Filter condition as logical expression to apply during
 #'   summary calculation. By default, filtering expressions are computed within
 #'   `by_vars` as this will help when an aggregating, lagging, or ranking
 #'   function is involved.
@@ -29,6 +45,46 @@
 #'   + `filter = (dplyr::n() > 2)` will filter n count of `by_vars` greater
 #'   than 2.
 #'
+#' @param filter_add Filter condition as logical expression to apply during
+#'   summary calculation. By default, filtering expressions are computed within
+#'   `by_vars` as this will help when an aggregating, lagging, or ranking
+#'   function is involved.
+#'
+#'   For example,
+#'
+#'   + `filter_add = (AVAL > mean(AVAL, na.rm = TRUE))` will filter all `AVAL`
+#'   values greater than mean of `AVAL` with in `by_vars`.
+#'   + `filter_add = (dplyr::n() > 2)` will filter n count of `by_vars` greater
+#'   than 2.
+#'
+#' @param set_values_to Variables to be set
+#'
+#'   The specified variables are set to the specified values for the new
+#'   observations.
+#'
+#'   Set a list of variables to some specified value for the new records
+#'   + LHS refer to a variable.
+#'   + RHS refers to the values to set to the variable. This can be a string, a
+#'   symbol, a numeric value, an expression or NA. If summary functions are
+#'   used, the values are summarized by the variables specified for `by_vars`.
+#'
+#'   For example:
+#'   ```
+#'     set_values_to = exprs(
+#'       AVAL = sum(AVAL),
+#'       DTYPE = "AVERAGE",
+#'     )
+#'   ```
+#'
+#' @param missing_values Values for missing summary values
+#'
+#'   For observations of the input dataset (`dataset`) or (`dataset_add`) which do not have a
+#'   complete mapping defined by the summarization defined in `set_values_to`.  Only variables
+#'   specified for `set_values_to` can be specified for `missing_values`.
+#'
+#'   *Permitted Values*: named list of expressions, e.g.,
+#'   `exprs(AVAL = -9999)`
+#'
 #' @inheritParams get_summary_records
 #'
 #' @return A data frame with derived records appended to original dataset.
@@ -72,6 +128,7 @@
 #' # Summarize the average of the triplicate ECG interval values (AVAL)
 #' derive_summary_records(
 #'   adeg,
+#'   dataset_add = adeg,
 #'   by_vars = exprs(USUBJID, PARAM, AVISIT),
 #'   set_values_to = exprs(
 #'     AVAL = mean(AVAL, na.rm = TRUE),
@@ -83,6 +140,7 @@
 #' # Derive more than one summary variable
 #' derive_summary_records(
 #'   adeg,
+#'   dataset_add = adeg,
 #'   by_vars = exprs(USUBJID, PARAM, AVISIT),
 #'   set_values_to = exprs(
 #'     AVAL = mean(AVAL),
@@ -116,6 +174,7 @@
 #' # by group
 #' derive_summary_records(
 #'   adeg,
+#'   dataset_add = adeg,
 #'   by_vars = exprs(USUBJID, PARAM, AVISIT),
 #'   filter = n() > 2,
 #'   set_values_to = exprs(
@@ -125,18 +184,26 @@
 #' ) %>%
 #'   arrange(USUBJID, AVISIT)
 derive_summary_records <- function(dataset,
+                                   dataset_add,
+                                   dataset_ref = NULL,
                                    by_vars,
                                    filter = NULL,
+                                   filter_add = NULL,
                                    analysis_var,
                                    summary_fun,
-                                   set_values_to) {
+                                   set_values_to,
+                                   missing_values = NULL) {
   assert_vars(by_vars)
-  filter <- assert_filter_cond(enexpr(filter), optional = TRUE)
+  assert_data_frame(dataset, required_vars = by_vars)
+  assert_data_frame(dataset_add, required_vars = by_vars)
   assert_data_frame(
-    dataset,
-    required_vars = by_vars
+    dataset_ref,
+    required_vars = by_vars,
+    optional = TRUE
   )
+
   assert_varval_list(set_values_to)
+  assert_expr_list(missing_values, named = TRUE, optional = TRUE)
 
   if (!missing(analysis_var) || !missing(summary_fun)) {
     deprecate_warn(
@@ -149,14 +216,53 @@ derive_summary_records <- function(dataset,
     set_values_to <- exprs(!!analysis_var := {{ summary_fun }}(!!analysis_var), !!!set_values_to)
   }
 
-  # Summarise the analysis value and bind to the original dataset
-  bind_rows(
-    dataset,
-    get_summary_records(
-      dataset,
-      by_vars = by_vars,
-      filter = !!filter,
-      set_values_to = set_values_to
+  if (!missing(filter)) {
+    deprecate_warn(
+      "1.0.0",
+      I("derive_summary_records(filter = )"),
+      "derive_summary_records(filter_add = )"
+    )
+    filter <- assert_filter_cond(enexpr(filter), optional = TRUE)
+  }
+  filter <- assert_filter_cond(enexpr(filter_add), optional = TRUE)
+
+  summary_records <- dataset_add %>%
+    group_by(!!!by_vars) %>%
+    filter_if(filter) %>%
+    summarise(!!!set_values_to) %>%
+    ungroup()
+
+  if (!is.null(missing_values)) {
+    update_missings <- map2(
+      syms(names(missing_values)),
+      missing_values,
+      ~ expr(if_else(is.na(!!.x), !!.y, !!.x))
     )
+    names(update_missings) <- names(missing_values)
+    summary_records <- summary_records %>%
+      mutate(!!!update_missings)
+  }
+
+  df_return <- bind_rows(
+    dataset,
+    summary_records
   )
+
+  if (!is.null(dataset_ref)) {
+    add_vars <- colnames(dataset_add)
+    ref_vars <- colnames(dataset_ref)
+
+    new_ref_obs <- anti_join(
+      select(dataset_ref, intersect(add_vars, ref_vars)),
+      select(summary_records, !!!by_vars),
+      by = map_chr(by_vars, as_name)
+    )
+
+    df_return <- bind_rows(
+      df_return,
+      new_ref_obs
+    )
+  }
+
+  return(df_return)
 }

R/get_summary_records.R

@@ -1,6 +1,12 @@
 #' Create Summary Records
 #'
 #' @description
+#'
+#' `r lifecycle::badge("superseded")`
+#'
+#' Development on `get_summary_records()` is complete, and for new code we recommend
+#' switching to using the `dataset_add` argument in `derive_summary_records()`.
+#'
 #' It is not uncommon to have an analysis need whereby one needs to derive an
 #' analysis value (`AVAL`) from multiple records. The ADaM basic dataset
 #' structure variable `DTYPE` is available to indicate when a new derived
@@ -64,9 +70,9 @@
 #'
 #' @return A data frame of derived records.
 #'
-#' @family der_gen
+#' @family superseded
 #'
-#' @keywords der_gen
+#' @keywords superseded
 #'
 #' @seealso [derive_summary_records()], [derive_var_merged_summary()]
 #'
@@ -154,7 +160,7 @@ get_summary_records <- function(dataset,
                                 filter = NULL,
                                 analysis_var,
                                 summary_fun,
-                                set_values_to) {
+                                set_values_to = NULL) {
   assert_vars(by_vars)
   filter <- assert_filter_cond(enexpr(filter), optional = TRUE)
   assert_data_frame(

inst/templates/ad_adeg.R

@@ -197,8 +197,9 @@ adeg <- adeg %>%
 # (if least 2 records available) for all parameter except EGINTP
 adeg <- adeg %>%
   derive_summary_records(
+    dataset_add = adeg,
     by_vars = exprs(STUDYID, USUBJID, !!!adsl_vars, PARAMCD, AVISITN, AVISIT, ADT),
-    filter = dplyr::n() >= 2 & PARAMCD != "EGINTP",
+    filter_add = dplyr::n() >= 2 & PARAMCD != "EGINTP",
     set_values_to = exprs(
       AVAL = mean(AVAL, na.rm = TRUE),
       DTYPE = "AVERAGE"