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,10 +4,13 @@
 * 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 list containing default statistics for each method group, `tern_default_stats`.
+* Added summarize function version of `count_occurrences` analyze function, `summarize_occurrences`.
+* Added referential footnotes to `surv_time` for censored range observations, controlled via the `ref_fn_censor` parameter.
 
 ### Enhancements
 * Added `ref_group_coxph` parameter to `g_km` to specify the reference group used for pairwise Cox-PH calculations when `annot_coxph = TRUE`.
@@ -25,8 +28,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/analyze_variables.R

@@ -517,6 +517,7 @@ a_summary <- function(x,
     lbls
   }
 
+  if ("count_fraction_fixed_dp" %in% .stats) x_stats[["count_fraction_fixed_dp"]] <- x_stats[["count_fraction"]]
   x_stats <- x_stats[.stats]
 
   if (is.factor(x) || is.character(x)) {

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

@@ -85,25 +85,81 @@ 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(),
+                        ref_fn_censor = TRUE,
+                        .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) && ref_fn_censor) {
+    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()].
 #'
 #' @param .indent_mods (named `vector` of `integer`)\cr indent modifiers for the labels. Each element of the vector
 #'   should be a name-value pair with name corresponding to a statistic specified in `.stats` and value the indentation
 #'   for that statistic's row label.
+#' @param ref_fn_censor (`flag`)\cr whether referential footnotes indicating censored observations should be printed
+#'   when the `range` statistic is included.
 #'
 #' @return
 #' * `surv_time()` returns a layout object suitable for passing to further layouting functions,
@@ -125,34 +181,31 @@ a_surv_time <- make_afun(
 #' @export
 surv_time <- function(lyt,
                       vars,
+                      ref_fn_censor = TRUE,
                       na_str = NA_character_,
                       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, ref_fn_censor = ref_fn_censor
   )
+
   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

@@ -438,7 +438,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`.