Expose statistic function arguments in analyze functions (#1134)

Fixes #1133
insightsengineering · Nov 23, 2023 · 45e5915 · 45e5915
1 parent 01af0b0
commit 45e5915
Show file tree

Hide file tree

Showing 65 changed files with 668 additions and 402 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -1,4 +1,4 @@
-# tern 0.9.2.9015
+# tern 0.9.2.9016
 
 ### New Features
 * Added `ref_group_position` function to place the reference group facet last, first or at a certain position.

diff --git a/R/abnormal.R b/R/abnormal.R
@@ -13,6 +13,8 @@
 #' @param abnormal (named `list`)\cr list identifying the abnormal range level(s) in `var`. Defaults to
 #'   `list(Low = "LOW", High = "HIGH")` but you can also group different levels into the named list,
 #'   for example, `abnormal = list(Low = c("LOW", "LOW LOW"), High = c("HIGH", "HIGH HIGH"))`.
+#' @param exclude_base_abn (`flag`)\cr whether to exclude subjects with baseline abnormality
+#'   from numerator and denominator.
 #' @param .stats (`character`)\cr statistics to select for the table. Run `get_stats("abnormal")`
 #'   to see available statistics for this function.
 #'
@@ -31,9 +33,6 @@ NULL
 #' @describeIn abnormal Statistics function which counts patients with abnormal range values
 #'   for a single `abnormal` level.
 #'
-#' @param exclude_base_abn (`flag`)\cr whether to exclude subjects with baseline abnormality
-#'   from numerator and denominator.
-#'
 #' @return
 #' * `s_count_abnormal()` returns the statistic `fraction` which is a vector with `num` and `denom` counts of patients.
 #'
@@ -145,6 +144,9 @@ a_count_abnormal <- make_afun(
 #' @order 2
 count_abnormal <- function(lyt,
                            var,
+                           abnormal = list(Low = "LOW", High = "HIGH"),
+                           variables = list(id = "USUBJID", baseline = "BNRIND"),
+                           exclude_base_abn = FALSE,
                            na_str = NA_character_,
                            nested = TRUE,
                            ...,
@@ -153,6 +155,8 @@ count_abnormal <- function(lyt,
                            .formats = NULL,
                            .labels = NULL,
                            .indent_mods = NULL) {
+  extra_args <- list(abnormal = abnormal, variables = variables, exclude_base_abn = exclude_base_abn, ...)
+
   afun <- make_afun(
     a_count_abnormal,
     .stats = .stats,
@@ -171,7 +175,7 @@ count_abnormal <- function(lyt,
     na_str = na_str,
     nested = nested,
     table_names = table_names,
-    extra_args = list(...),
+    extra_args = extra_args,
     show_labels = "hidden"
   )
 }
diff --git a/R/abnormal_by_baseline.R b/R/abnormal_by_baseline.R
@@ -191,6 +191,7 @@ a_count_abnormal_by_baseline <- make_afun(
 count_abnormal_by_baseline <- function(lyt,
                                        var,
                                        abnormal,
+                                       variables = list(id = "USUBJID", baseline = "BNRIND"),
                                        na_str = "<Missing>",
                                        nested = TRUE,
                                        ...,
@@ -201,6 +202,9 @@ count_abnormal_by_baseline <- function(lyt,
                                        .indent_mods = NULL) {
   checkmate::assert_character(abnormal, len = length(table_names), names = "named")
   checkmate::assert_string(var)
+
+  extra_args <- list(abnormal = abnormal, variables = variables, na_str = na_str, ...)
+
   afun <- make_afun(
     a_count_abnormal_by_baseline,
     .stats = .stats,
@@ -210,16 +214,17 @@ count_abnormal_by_baseline <- function(lyt,
     .ungroup_stats = "fraction"
   )
   for (i in seq_along(abnormal)) {
-    abn <- abnormal[i]
+    extra_args[["abnormal"]] <- abnormal[i]
+
     lyt <- analyze(
       lyt = lyt,
       vars = var,
-      var_labels = names(abn),
+      var_labels = names(abnormal[i]),
       afun = afun,
       na_str = na_str,
       nested = nested,
       table_names = table_names[i],
-      extra_args = c(list(abnormal = abn, na_str = na_str), list(...)),
+      extra_args = extra_args,
       show_labels = "visible"
     )
   }

diff --git a/R/abnormal_by_marked.R b/R/abnormal_by_marked.R
@@ -198,6 +198,8 @@ a_count_abnormal_by_marked <- make_afun(
 #' @order 2
 count_abnormal_by_marked <- function(lyt,
                                      var,
+                                     category = list(single = "SINGLE", last_replicated = c("LAST", "REPLICATED")),
+                                     variables = list(id = "USUBJID", param = "PARAM", direction = "abn_dir"),
                                      na_str = NA_character_,
                                      nested = TRUE,
                                      ...,
@@ -207,6 +209,8 @@ count_abnormal_by_marked <- function(lyt,
                                      .indent_mods = NULL) {
   checkmate::assert_string(var)
 
+  extra_args <- list(category = category, variables = variables, ...)
+
   afun <- make_afun(
     a_count_abnormal_by_marked,
     .stats = .stats,
@@ -223,7 +227,7 @@ count_abnormal_by_marked <- function(lyt,
     na_str = na_str,
     nested = nested,
     show_labels = "hidden",
-    extra_args = c(list(...))
+    extra_args = extra_args
   )
   lyt
 }
diff --git a/R/abnormal_by_worst_grade.R b/R/abnormal_by_worst_grade.R
@@ -134,13 +134,20 @@ a_count_abnormal_by_worst_grade <- make_afun( # nolint
 #' @order 2
 count_abnormal_by_worst_grade <- function(lyt,
                                           var,
+                                          variables = list(
+                                            id = "USUBJID",
+                                            param = "PARAM",
+                                            grade_dir = "GRADE_DIR"
+                                          ),
                                           na_str = NA_character_,
                                           nested = TRUE,
                                           ...,
                                           .stats = NULL,
                                           .formats = NULL,
                                           .labels = NULL,
                                           .indent_mods = NULL) {
+  extra_args <- list(variables = variables, ...)
+
   afun <- make_afun(
     a_count_abnormal_by_worst_grade,
     .stats = .stats,
@@ -155,7 +162,7 @@ count_abnormal_by_worst_grade <- function(lyt,
     afun = afun,
     na_str = na_str,
     nested = nested,
-    extra_args = list(...),
+    extra_args = extra_args,
     show_labels = "hidden"
   )
 }

diff --git a/R/abnormal_by_worst_grade_worsen.R b/R/abnormal_by_worst_grade_worsen.R
@@ -5,6 +5,10 @@
 #' Patient count and fraction for laboratory events (worsen from baseline) shift table.
 #'
 #' @inheritParams argument_convention
+#' @param variables (named `list` of `string`)\cr list of additional analysis variables including:
+#'   * `id` (`string`)\cr subject variable name.
+#'   * `baseline_var` (`string`)\cr name of the data column containing baseline toxicity variable.
+#'   * `direction_var` (`string`)\cr see `direction_var` for more details.
 #' @param .stats (`character`)\cr statistics to select for the table. Run `get_stats("abnormal_by_worst_grade_worsen")`
 #'   to see all available statistics.
 #'
@@ -266,11 +270,6 @@ h_worsen_counter <- function(df, id, .var, baseline_var, direction_var) {
 #' @describeIn abnormal_by_worst_grade_worsen Statistics function for patients whose worst post-baseline
 #'   lab grades are worse than their baseline grades.
 #'
-#' @param variables (named `list` of `string`)\cr list of additional analysis variables including:
-#'   * `id` (`string`)\cr subject variable name.
-#'   * `baseline_var` (`string`)\cr name of the data column containing baseline toxicity variable.
-#'   * `direction_var` (`string`)\cr see `direction_var` for more details.
-#'
 #' @return
 #' * `s_count_abnormal_lab_worsen_by_baseline()` returns the counts and fraction of patients whose worst
 #'   post-baseline lab grades are worse than their baseline grades, for post-baseline worst grades
@@ -359,6 +358,11 @@ a_count_abnormal_lab_worsen_by_baseline <- make_afun( # nolint
 #' @order 2
 count_abnormal_lab_worsen_by_baseline <- function(lyt, # nolint
                                                   var,
+                                                  variables = list(
+                                                    id = "USUBJID",
+                                                    baseline_var = "BTOXGR",
+                                                    direction_var = "GRADDR"
+                                                  ),
                                                   na_str = NA_character_,
                                                   nested = TRUE,
                                                   ...,
@@ -369,6 +373,8 @@ count_abnormal_lab_worsen_by_baseline <- function(lyt, # nolint
                                                   .indent_mods = NULL) {
   checkmate::assert_string(var)
 
+  extra_args <- list(variables = variables, ...)
+
   afun <- make_afun(
     a_count_abnormal_lab_worsen_by_baseline,
     .stats = .stats,
@@ -383,7 +389,7 @@ count_abnormal_lab_worsen_by_baseline <- function(lyt, # nolint
     afun = afun,
     na_str = na_str,
     nested = nested,
-    extra_args = list(...),
+    extra_args = extra_args,
     show_labels = "hidden"
   )
 

diff --git a/R/argument_convention.R b/R/argument_convention.R
@@ -32,8 +32,6 @@
 #' @param data (`data.frame`)\cr the dataset containing the variables to summarize.
 #' @param df (`data.frame`)\cr data set containing all analysis variables.
 #' @param draw (`flag`)\cr whether the plot should be drawn.
-#' @param drop (`flag`)\cr should non appearing occurrence levels be dropped from the resulting table.
-#'   Note that in that case the remaining occurrence levels in the table are sorted alphabetically.
 #' @param groups_lists (named `list` of `list`)\cr optionally contains for each `subgroups` variable a
 #'   list, which specifies the new group levels via the names and the
 #'   levels that belong to it in the character vectors that are elements of the list.

diff --git a/R/count_cumulative.R b/R/count_cumulative.R
@@ -7,6 +7,7 @@
 #'
 #' @inheritParams h_count_cumulative
 #' @inheritParams argument_convention
+#' @param thresholds (`numeric`)\cr vector of cutoff value for the counts.
 #' @param .stats (`character`)\cr statistics to select for the table. Run `get_stats("count_cumulative")`
 #'   to see available statistics for this function.
 #'
@@ -94,8 +95,6 @@ d_count_cumulative <- function(threshold, lower_tail, include_eq) {
 
 #' @describeIn count_cumulative Statistics function that produces a named list given a numeric vector of thresholds.
 #'
-#' @param thresholds (`numeric`)\cr vector of cutoff value for the counts.
-#'
 #' @return
 #' * `s_count_cumulative()` returns a named list of `count_fraction`s: a list with each `thresholds` value as a
 #'   component, each component containing a vector for the count and fraction.
@@ -153,6 +152,9 @@ a_count_cumulative <- make_afun(
 #' @order 2
 count_cumulative <- function(lyt,
                              vars,
+                             thresholds,
+                             lower_tail = TRUE,
+                             include_eq = TRUE,
                              var_labels = vars,
                              show_labels = "visible",
                              na_str = NA_character_,
@@ -163,6 +165,8 @@ count_cumulative <- function(lyt,
                              .formats = NULL,
                              .labels = NULL,
                              .indent_mods = NULL) {
+  extra_args <- list(thresholds = thresholds, lower_tail = lower_tail, include_eq = include_eq, ...)
+
   afun <- make_afun(
     a_count_cumulative,
     .stats = .stats,
@@ -180,6 +184,6 @@ count_cumulative <- function(lyt,
     var_labels = var_labels,
     show_labels = show_labels,
     nested = nested,
-    extra_args = list(...)
+    extra_args = extra_args
   )
 }
diff --git a/R/count_missed_doses.R b/R/count_missed_doses.R
@@ -5,7 +5,9 @@
 #' These are specific functions to count patients with missed doses. The difference to [count_cumulative()] is
 #' mainly the special labels.
 #'
+#' @inheritParams s_count_cumulative
 #' @inheritParams argument_convention
+#' @param thresholds (vector of `count`)\cr number of missed doses the patients at least had.
 #' @param .stats (`character`)\cr statistics to select for the table. Run `get_stats("count_missed_doses")`
 #'   to see available statistics for this function.
 #'
@@ -42,8 +44,6 @@ d_count_missed_doses <- function(thresholds) {
 
 #' @describeIn count_missed_doses Statistics function to count patients with missed doses.
 #'
-#' @param thresholds (vector of `count`)\cr number of missed doses the patients at least had.
-#'
 #' @return
 #' * `s_count_missed_doses()` returns the statistics `n` and `count_fraction` with one element for each threshold.
 #'
@@ -81,8 +81,6 @@ a_count_missed_doses <- make_afun(
 #' @describeIn count_missed_doses Layout-creating function which can take statistics function arguments
 #'   and additional format arguments. This function is a wrapper for [rtables::analyze()].
 #'
-#' @inheritParams s_count_cumulative
-#'
 #' @return
 #' * `count_missed_doses()` returns a layout object suitable for passing to further layouting functions,
 #'   or to [rtables::build_table()]. Adding this function to an `rtable` layout will add formatted rows containing
@@ -110,6 +108,7 @@ a_count_missed_doses <- make_afun(
 #' @order 2
 count_missed_doses <- function(lyt,
                                vars,
+                               thresholds,
                                var_labels = vars,
                                show_labels = "visible",
                                na_str = NA_character_,
@@ -120,6 +119,8 @@ count_missed_doses <- function(lyt,
                                .formats = NULL,
                                .labels = NULL,
                                .indent_mods = NULL) {
+  extra_args <- list(thresholds = thresholds, ...)
+
   afun <- make_afun(
     a_count_missed_doses,
     .stats = .stats,
@@ -137,6 +138,6 @@ count_missed_doses <- function(lyt,
     show_labels = show_labels,
     na_str = na_str,
     nested = nested,
-    extra_args = list(...)
+    extra_args = extra_args
   )
 }
diff --git a/R/count_occurrences.R b/R/count_occurrences.R
@@ -8,6 +8,8 @@
 #' counted only once.
 #'
 #' @inheritParams argument_convention
+#' @param drop (`flag`)\cr should non appearing occurrence levels be dropped from the resulting table.
+#'   Note that in that case the remaining occurrence levels in the table are sorted alphabetically.
 #' @param .stats (`character`)\cr statistics to select for the table. Run `get_stats("count_occurrences")`
 #'   to see available statistics for this function.
 #'
@@ -209,6 +211,8 @@ a_count_occurrences <- function(df,
 #' @order 2
 count_occurrences <- function(lyt,
                               vars,
+                              id = "USUBJID",
+                              drop = TRUE,
                               var_labels = vars,
                               show_labels = "hidden",
                               riskdiff = FALSE,
@@ -225,15 +229,16 @@ count_occurrences <- function(lyt,
   extra_args <- list(
     .stats = .stats, .formats = .formats, .labels = .labels, .indent_mods = .indent_mods, na_str = na_str
   )
+  s_args <- list(id = id, drop = drop, ...)
 
   if (isFALSE(riskdiff)) {
-    extra_args <- c(extra_args, list(...))
+    extra_args <- c(extra_args, s_args)
   } else {
     extra_args <- c(
       extra_args,
       list(
         afun = list("s_count_occurrences" = a_count_occurrences),
-        s_args = list(...)
+        s_args = s_args
       )
     )
   }
@@ -274,6 +279,8 @@ count_occurrences <- function(lyt,
 #' @order 3
 summarize_occurrences <- function(lyt,
                                   var,
+                                  id = "USUBJID",
+                                  drop = TRUE,
                                   riskdiff = FALSE,
                                   na_str = NA_character_,
                                   ...,
@@ -286,15 +293,16 @@ summarize_occurrences <- function(lyt,
   extra_args <- list(
     .stats = .stats, .formats = .formats, .labels = .labels, .indent_mods = .indent_mods, na_str = na_str
   )
+  s_args <- list(id = id, drop = drop, ...)
 
   if (isFALSE(riskdiff)) {
-    extra_args <- c(extra_args, list(...))
+    extra_args <- c(extra_args, s_args)
   } else {
     extra_args <- c(
       extra_args,
       list(
         afun = list("s_count_occurrences" = a_count_occurrences),
-        s_args = list(...)
+        s_args = s_args
       )
     )
   }