Refactor surv_time to enable cell footnotes

NAMESPACE

@@ -34,6 +34,7 @@ export(a_odds_ratio)
 export(a_proportion)
 export(a_proportion_diff)
 export(a_summary)
+export(a_surv_time)
 export(add_riskdiff)
 export(add_rowcounts)
 export(aesi_label)

NEWS.md

@@ -4,9 +4,12 @@
 * Added `ref_group_position` function to place the reference group facet last, first or at a certain position.
 * Added `keep_level_order` split function to retain original order of levels in a split.
 * Added `level_order` split function to reorder manually the levels.
+* Added function `get_indents_from_stats` to format and return indent modifiers for a given set of statistics.
 * Added internal utility function `apply_auto_formatting` to check for `"auto"` formats and replace them with 
   implementation of `format_auto` in analyze functions.
 * Added utility function `labels_use_control` to modify labels with control specifications.
+* Added summarize function version of `count_occurrences` analyze function, `summarize_occurrences`.
+* Added referential footnotes to `surv_time` for censored range observations.
 
 ### Enhancements
 * Added `ref_group_coxph` parameter to `g_km` to specify the reference group used for pairwise Cox-PH calculations when `annot_coxph = TRUE`.
@@ -23,8 +26,6 @@
 
 ### New Features
 * Added the `na_str` argument to `analyze` & `summarize_row_groups` wrapper functions `count_abnormal`, `count_abnormal_by_baseline`, `count_abnormal_by_marked`, `count_abnormal_by_worst_grade`, `count_abnormal_lab_worsen_by_baseline`, `count_cumulative`, `count_missed_doses`, `count_occurrences`, `count_occurrences_by_grade`, `summarize_occurrences_by_grade`, `summarize_patients_events_in_cols`, `count_patients_with_event`, `count_patients_with_flags`, `count_values`, `estimate_multinomial_response`, `estimate_proportion`, `h_tab_one_biomarker`, `estimate_incidence_rate`, `logistic_summary_by_flag`, `estimate_odds_ratio`, `estimate_proportion_diff`, `test_proportion_diff`, `summarize_ancova`, `summarize_change`, `summarize_glm_count`, `summarize_num_patients`, `analyze_num_patients`, `summarize_patients_exposure_in_cols`, `coxph_pairwise`, `tabulate_survival_subgroups`, `surv_time`, and `surv_timepoint`.
-* Added function `get_indents_from_stats` to format and return indent modifiers for a given set of statistics.
-* Added summarize function version of `count_occurrences` analyze function, `summarize_occurrences`.
 
 ### Enhancements
 * Added formatting function `format_count_fraction_lt10` for formatting `count_fraction` with special consideration when count is less than 10.

R/formatting_functions.R

@@ -499,7 +499,8 @@ format_auto <- function(dt_var, x_stat) {
     # Defaults - they may be a param in the future
     der_stats <- c(
       "mean", "sd", "se", "median", "geom_mean", "quantiles", "iqr",
-      "mean_sd", "mean_se", "mean_se", "mean_ci", "mean_sei", "mean_sdi"
+      "mean_sd", "mean_se", "mean_se", "mean_ci", "mean_sei", "mean_sdi",
+      "median_ci"
     )
     nonder_stats <- c("n", "range", "min", "max")
 

R/survival_time.R

@@ -83,18 +83,71 @@ s_surv_time <- function(df,
 #' @return
 #' * `a_surv_time()` returns the corresponding list with formatted [rtables::CellValue()].
 #'
-#' @keywords internal
-a_surv_time <- make_afun(
-  s_surv_time,
-  .formats = c(
-    "median" = "xx.x",
-    "median_ci" = "(xx.x, xx.x)",
-    "quantiles" = "xx.x, xx.x",
-    "range_censor" = "xx.x to xx.x",
-    "range_event" = "xx.x to xx.x",
-    "range" = "xx.x to xx.x"
+#' @examples
+#' a_surv_time(
+#'   df,
+#'   .df_row = df,
+#'   .var = "AVAL",
+#'   is_event = "is_event"
+#' )
+#'
+#' @export
+a_surv_time <- function(df,
+                        labelstr = "",
+                        .var = NULL,
+                        .df_row = NULL,
+                        is_event,
+                        control = control_surv_time(),
+                        .stats = NULL,
+                        .formats = NULL,
+                        .labels = NULL,
+                        .indent_mods = NULL,
+                        na_str = NA_character_) {
+  x_stats <- s_surv_time(
+    df = df, .var = .var, is_event = is_event, control = control
+  )
+  rng_censor_lwr <- x_stats[["range_censor"]][1]
+  rng_censor_upr <- x_stats[["range_censor"]][2]
+
+  # Use method-specific defaults
+  fmts <- c(median_ci = "(xx.x, xx.x)", quantiles = "xx.x, xx.x", range = "xx.x to xx.x")
+  lbls <- c(median_ci = "95% CI", range = "Range", range_censor = "Range (censored)", range_event = "Range (event)")
+  lbls_custom <- .labels
+  .formats <- c(.formats, fmts[setdiff(names(fmts), names(.formats))])
+  .labels <- c(.labels, lbls[setdiff(names(lbls), names(lbls_custom))])
+
+  # Fill in with formatting defaults if needed
+  .stats <- get_stats("surv_time", stats_in = .stats)
+  .formats <- get_formats_from_stats(.stats, .formats)
+  .labels <- get_labels_from_stats(.stats, .labels) %>% labels_use_control(control, lbls_custom)
+  .indent_mods <- get_indents_from_stats(.stats, .indent_mods)
+
+  x_stats <- x_stats[.stats]
+
+  # Auto format handling
+  .formats <- apply_auto_formatting(.formats, x_stats, .df_row, .var)
+
+  cell_fns <- setNames(vector("list", length = length(x_stats)), .labels)
+  if ("range" %in% names(x_stats)) {
+    if (x_stats[["range"]][1] == rng_censor_lwr && x_stats[["range"]][2] == rng_censor_upr) {
+      cell_fns[[.labels[["range"]]]] <- "Censored observations: range minimum & maximum"
+    } else if (x_stats[["range"]][1] == rng_censor_lwr) {
+      cell_fns[[.labels[["range"]]]] <- "Censored observation: range minimum"
+    } else if (x_stats[["range"]][2] == rng_censor_upr) {
+      cell_fns[[.labels[["range"]]]] <- "Censored observation: range maximum"
+    }
+  }
+
+  in_rows(
+    .list = x_stats,
+    .formats = .formats,
+    .names = .labels,
+    .labels = .labels,
+    .indent_mods = .indent_mods,
+    .format_na_strs = na_str,
+    .cell_footnotes = cell_fns
   )
-)
+}
 
 #' @describeIn survival_time Layout-creating function which can take statistics function arguments
 #'   and additional format arguments. This function is a wrapper for [rtables::analyze()].
@@ -127,30 +180,25 @@ surv_time <- function(lyt,
                       nested = TRUE,
                       ...,
                       var_labels = "Time to Event",
+                      show_labels = "visible",
                       table_names = vars,
-                      .stats = c("median", "median_ci", "quantiles", "range_censor", "range_event"),
+                      .stats = c("median", "median_ci", "quantiles", "range"),
                       .formats = NULL,
                       .labels = NULL,
-                      .indent_mods = c(
-                        "median" = 0L, "median_ci" = 1L, "quantiles" = 0L,
-                        "range_censor" = 0L, "range_event" = 0L, "range" = 0L
-                      )) {
-  afun <- make_afun(
-    a_surv_time,
-    .stats = .stats,
-    .formats = .formats,
-    .labels = .labels,
-    .indent_mods = extract_by_name(.indent_mods, .stats)
+                      .indent_mods = c(median_ci = 1L)) {
+  extra_args <- list(
+    .stats = .stats, .formats = .formats, .labels = .labels, .indent_mods = .indent_mods, na_str = na_str
   )
+
   analyze(
-    lyt,
-    vars,
-    na_str = na_str,
-    nested = nested,
+    lyt = lyt,
+    vars = vars,
+    afun = a_surv_time,
     var_labels = var_labels,
-    show_labels = "visible",
+    show_labels = show_labels,
     table_names = table_names,
-    afun = afun,
-    extra_args = list(...)
+    na_str = na_str,
+    nested = nested,
+    extra_args = c(extra_args, list(...))
   )
 }

R/utils_default_stats_formats_labels.R

@@ -77,6 +77,7 @@ get_stats <- function(method_groups = "analyze_vars_numeric", stats_in = NULL, a
         "range", "min", "max", "median_range", "cv", "geom_mean", "geom_mean_ci",
         "geom_cv"
       ),
+      "surv_time" = c("median", "median_ci", "quantiles", "range_censor", "range_event", "range"),
       stop(
         "The selected method group (", mgi, ") has no default statistical method."
       )
@@ -401,7 +402,9 @@ tern_default_formats <- c(
   geom_mean_ci = "(xx.xx, xx.xx)",
   geom_cv = "xx.x",
   pval = "x.xxxx | (<0.0001)",
-  pval_counts = "x.xxxx | (<0.0001)"
+  pval_counts = "x.xxxx | (<0.0001)",
+  range_censor = "xx.x to xx.x",
+  range_event = "xx.x to xx.x"
 )
 
 #' @describeIn default_stats_formats_labels Named `character` vector of default labels for `tern`.

tests/testthat/_snaps/survival_time.md

@@ -70,6 +70,33 @@
       [1] "Range"
 
 
+# a_surv_time works with default arguments
+
+    Code
+      res
+    Output
+      RowsVerticalSection (in_rows) object print method:
+      ----------------------------
+                row_name formatted_cell indent_mod        row_label
+      1           Median           24.8          0           Median
+      2           95% CI   (21.1, 31.3)          0           95% CI
+      3  25% and 75%-ile     10.8, 47.6          0  25% and 75%-ile
+      4 Range (censored)    0.8 to 78.9          0 Range (censored)
+      5    Range (event)   0.1 to 155.5          0    Range (event)
+      6            Range   0.1 to 155.5          0            Range
+
+# a_surv_time works with customized arguments
+
+    Code
+      res
+    Output
+      RowsVerticalSection (in_rows) object print method:
+      ----------------------------
+               row_name               formatted_cell indent_mod       row_label
+      1 median conf int (13.591239860, 37.970548966)          3 median conf int
+      2 20% and 80%-ile                 6.65 / 51.09          0 20% and 80%-ile
+      3           Range                 0.1 to 154.1          0           Range
+
 # surv_time works with default arguments
 
     Code
@@ -81,8 +108,7 @@
         Median                     32.0           23.9           20.8    
           95% CI               (22.5, 49.3)   (18.3, 32.9)   (12.9, 26.0)
         25% and 75%-ile         17.4, 65.3     9.8, 42.0      7.3, 37.1  
-        Range (censored)       0.8 to 63.5    6.2 to 78.9    3.4 to 52.4 
-        Range (event)          0.3 to 155.5   0.1 to 154.1   0.6 to 80.7 
+        Range                  0.3 to 155.5   0.1 to 154.1   0.6 to 80.7 
 
 # surv_time works with customized arguments
 
@@ -97,4 +123,26 @@
         40% and 60%-ile         25.6, 46.5     18.3, 29.2     13.0, 25.7 
         Range (censored)       0.8 to 63.5    6.2 to 78.9    3.4 to 52.4 
         Range (event)          0.3 to 155.5   0.1 to 154.1   0.6 to 80.7 
+        Range                  0.3 to 155.5   0.1 to 154.1   0.6 to 80.7 
+
+# surv_time works with referential footnotes
+
+    Code
+      res
+    Output
+                               ARM A              ARM B              ARM C              All       
+      ————————————————————————————————————————————————————————————————————————————————————————————
+      Time to Event                                                                               
+        Median                  32.0               23.9              20.8               24.9      
+          95% CI            (22.6, 53.4)       (18.3, 32.9)      (12.9, 26.0)       (21.5, 31.7)  
+        25% and 75%-ile      17.4, 65.3         9.8, 42.7          7.3, 37.1         11.5, 49.3   
+        Range             0.3 to 155.5 {1}   0.1 to 154.1 {2}   0.6 to 80.7 {3}   0.1 to 155.5 {4}
+      ————————————————————————————————————————————————————————————————————————————————————————————
+
+      {1} - Censored observation: range minimum
+      {2} - Censored observations: range minimum & maximum
+      {3} - Censored observation: range maximum
+      {4} - Censored observation: range minimum
+      ————————————————————————————————————————————————————————————————————————————————————————————
+