Closes #2652 derive_vars_joined_summary: Implement derive_vars_joined_summary()

NAMESPACE

@@ -110,6 +110,7 @@ export(derive_vars_duration)
 export(derive_vars_dy)
 export(derive_vars_extreme_event)
 export(derive_vars_joined)
+export(derive_vars_joined_summary)
 export(derive_vars_merged)
 export(derive_vars_merged_lookup)
 export(derive_vars_period)
@@ -280,6 +281,7 @@ importFrom(rlang,syms)
 importFrom(rlang,type_of)
 importFrom(rlang,zap)
 importFrom(stats,setNames)
+importFrom(stringr,fixed)
 importFrom(stringr,str_c)
 importFrom(stringr,str_count)
 importFrom(stringr,str_detect)

NEWS.md

@@ -10,6 +10,12 @@
     - The output of the structured examples used for complex functions is
     displayed in the help pages in RStudio.
 
+- New function `derive_vars_joined_summary()` to derive summary variables from
+  selected records of an additional dataset where the selection depends on
+  variables from both the input dataset and the additional dataset. For example,
+  the cumulative dose up to each adverse event in `ADAE` can be derived with the
+  new function. (#2652)
+
 - New lab grading metadata for US (Conventional) units for the three grading criteria
 `admiral` already produces for SI units (#2557).
     - `atoxgr_criteria_ctcv4_uscv` (NCI-CTCAEv4 criteria)
@@ -34,6 +40,7 @@ the `filter_add` argument is used. (#2863)
 ## Breaking Changes
 
 - Lab grading metadata `atoxgr_criteria_ctcv4()`, `atoxgr_criteria_ctcv5()` and `atoxgr_criteria_daids()` variable `SI_UNIT_CHECK` renamed to `UNIT_CHECK` (#2557).
+
 - The values of the variable specified for `tmp_obs_nr_var` in
 `derive_vars_joined()`, `derive_var_joined_exist_flag()`, `filter_joined()` are
 now populated differently if there are multiple records in `dataset` or

R/admiral-package.R

@@ -22,7 +22,7 @@
 #'   inform is_call is_expression is_missing is_named list2 new_environment
 #'   parse_expr parse_exprs set_names sym syms type_of zap
 #' @importFrom stats setNames
-#' @importFrom stringr str_c str_count str_detect str_extract str_glue
+#' @importFrom stringr fixed str_c str_count str_detect str_extract str_glue
 #'             str_length str_locate str_locate_all str_match str_remove
 #'             str_remove_all str_replace str_replace_all str_split str_starts
 #'             str_sub str_subset str_to_lower str_to_title str_to_upper

R/derive_joined.R

@@ -158,9 +158,9 @@
 #'
 #' @param check_type Check uniqueness?
 #'
-#'   If `"warning"` or `"error"` is specified, the specified message is issued
-#'   if the observations of the (restricted) joined dataset are not unique with
-#'   respect to the by variables and the order.
+#'   If `"message"`, `"warning"` or `"error"` is specified, the specified
+#'   message is issued if the observations of the (restricted) joined dataset
+#'   are not unique with respect to the by variables and the order.
 #'
 #'   This argument is ignored if `order` is not specified. In this case an error
 #'   is issued independent of `check_type` if the restricted joined dataset
@@ -837,7 +837,7 @@ derive_vars_joined <- function(dataset,
 #'   prior to the observation. For example, to identify AEs occurring on or
 #'   after seven days before a COVID AE. Thus `join_type = "all"` could be used.
 #'
-#' @permitted [join]
+#' @permitted [join_type]
 #'
 #' @param tmp_obs_nr_var Temporary observation number
 #'
@@ -1131,7 +1131,7 @@ get_joined_data <- function(dataset,
   } else {
     joined_data <- get_joined_sub_data(
       data,
-      dataset_add = data_add,
+      dataset_add = data_add_to_join,
       by_vars = by_vars_left,
       tmp_obs_nr_var = tmp_obs_nr_var,
       tmp_obs_nr_left = tmp_obs_nr_left,

R/derive_merged.R

@@ -1034,16 +1034,50 @@ derive_var_merged_summary <- function(dataset,
   )
 
   # Summarise the analysis value and merge to the original dataset
-  derive_vars_merged(
-    dataset,
-    dataset_add = derive_summary_records(
-      dataset_add = dataset_add,
-      by_vars = by_vars_right,
-      filter_add = !!filter_add,
-      set_values_to = new_vars,
-    ) %>%
-      select(!!!by_vars_right, names(new_vars)),
-    by_vars = by_vars,
-    missing_values = missing_values
+  # If for one of the new variables no summary function is used, i.e., more than
+  # one record is created per by group, the error from signal_duplicates_records()
+  # need to be updated and the warning from dplyr needs to be suppressed as it
+  # is misleading.
+  tryCatch(
+    withCallingHandlers(
+      derive_vars_merged(
+        dataset,
+        dataset_add = derive_summary_records(
+          dataset_add = dataset_add,
+          by_vars = by_vars_right,
+          filter_add = !!filter_add,
+          set_values_to = new_vars,
+        ) %>%
+          select(!!!by_vars_right, names(new_vars)),
+        by_vars = by_vars,
+        missing_values = missing_values
+      ),
+      warning = function(cnd) {
+        if (any(str_detect(
+          cnd$message,
+          fixed("Returning more (or less) than 1 row per `summarise()` group was deprecated")
+        ))) {
+          cnd_muffle(cnd)
+        }
+      }
+    ),
+    duplicate_records = function(cnd) {
+      cli_abort(
+        c(
+          paste(
+            "After summarising, the dataset contains duplicate records with",
+            "respect to {.var {cnd$by_vars}}."
+          ),
+          paste(
+            "Please check {.arg new_vars} if summary functions like {.fun mean},",
+            "{.fun sum}, ... are used on the right hand side."
+          ),
+          i = "Run {.run admiral::get_duplicates_dataset()} to access the duplicate records"
+        ),
+        class = cnd$class,
+        call = NULL,
+        by_vars = cnd$by_vars
+      )
+    }
   )
 }

R/derive_var_obs_number.R

@@ -23,15 +23,15 @@
 #'   The new variable is set to the observation number for each by group. The
 #'   numbering starts with 1.
 #'
+#' @permitted [var]
 #'
 #' @param check_type Check uniqueness?
 #'
-#'   If `"warning"` or `"error"` is specified, the specified message is issued
-#'   if the observations of the input dataset are not unique with respect to the
-#'   by variables and the order.
+#'   If `"message"`, `"warning"` or `"error"` is specified, the specified
+#'   message is issued if the observations of the input dataset are not unique
+#'   with respect to the by variables and the order.
 #'
-#'
-#' @permitted `"none"`, `"warning"`, `"error"`
+#' @permitted [msg_type]
 #'
 #' @details For each group (with respect to the variables specified for the
 #'   `by_vars` parameter) the first or last observation (with respect to the