1301 feature request add confidence intervals for quantiles in surv time

NEWS.md

@@ -1,6 +1,10 @@
 # tern 0.9.6
 
 ### Enhancements
+* Added `median_long`, `quantiles_lower` and `quantiles_upper` to `s_surv_time` which includes estimate and confidence interval in one statistic.
+* Added `hr_long` to `s_coxph_pairwise` which includes estimate and confidence interval in one statistic.
+* Added `event_free_rate_long` to `s_surv_timepoint` which includes estimate and confidence interval in one statistic.
+* Added `rate_diff_long` to `s_surv_timepoint_diff` which includes estimate and confidence interval in one statistic.
 * Added `errorbar_width` and `linetype` parameters to `g_lineplot`.
 * Added the `.formats` argument to `tabulate_rsp_subgroups` and `tabulate_survival_subgroups` to allow users to specify formats.
 * Added the `riskdiff` argument to `tabulate_rsp_subgroups` and `tabulate_survival_subgroups` to allow users to add a risk difference table column, and function `control_riskdiff` to specify settings for the risk difference column.

R/survival_coxph_pairwise.R

@@ -65,6 +65,7 @@ s_coxph_pairwise <- function(df,
         pvalue = formatters::with_label("", paste0("p-value (", pval_method, ")")),
         hr = formatters::with_label("", "Hazard Ratio"),
         hr_ci = formatters::with_label("", f_conf_level(conf_level)),
+        hr_long = formatters::with_label("", paste0("Hazard Ratio (", f_conf_level(conf_level), ")")),
         n_tot = formatters::with_label("", "Total n"),
         n_tot_events = formatters::with_label("", "Total events")
       )
@@ -111,6 +112,10 @@ s_coxph_pairwise <- function(df,
     pvalue = formatters::with_label(unname(pval), paste0("p-value (", pval_method, ")")),
     hr = formatters::with_label(sum_cox$conf.int[1, 1], "Hazard Ratio"),
     hr_ci = formatters::with_label(unname(sum_cox$conf.int[1, 3:4]), f_conf_level(conf_level)),
+    hr_long = formatters::with_label(
+      c(sum_cox$conf.int[1, 1], unname(sum_cox$conf.int[1, 3:4])),
+      paste0("Hazard Ratio (", f_conf_level(conf_level), ")")
+    ),
     n_tot = formatters::with_label(sum_cox$n, "Total n"),
     n_tot_events = formatters::with_label(sum_cox$nevent, "Total events")
   )
@@ -124,11 +129,12 @@ s_coxph_pairwise <- function(df,
 #' @keywords internal
 a_coxph_pairwise <- make_afun(
   s_coxph_pairwise,
-  .indent_mods = c(pvalue = 0L, hr = 0L, hr_ci = 1L, n_tot = 0L, n_tot_events = 0L),
+  .indent_mods = c(pvalue = 0L, hr = 0L, hr_ci = 1L, n_tot = 0L, n_tot_events = 0L, hr_long = 0L),
   .formats = c(
     pvalue = "x.xxxx | (<0.0001)",
     hr = "xx.xx",
     hr_ci = "(xx.xx, xx.xx)",
+    hr_long = "xx.xx (xx.xx - xx.xx)",
     n_tot = "xx.xx",
     n_tot_events = "xx.xx"
   )

R/survival_time.R

@@ -43,7 +43,10 @@ NULL
 #' * `s_surv_time()` returns the statistics:
 #'   * `median`: Median survival time.
 #'   * `median_ci`: Confidence interval for median time.
+#'   * `median_long`: Median with confidence interval for median time.
 #'   * `quantiles`: Survival time for two specified quantiles.
+#'   * `quantiles_lower`: quantile with confidence interval for the first specified quantile.
+#'   * `quantiles_upper`: quantile with confidence interval for the second specified quantile.
 #'   * `range_censor`: Survival time range for censored observations.
 #'   * `range_event`: Survival time range for observations with events.
 #'   * `range`: Survival time range for all observations.
@@ -70,10 +73,24 @@ s_surv_time <- function(df,
     conf.type = conf_type
   )
   srv_tab <- summary(srv_fit, extend = TRUE)$table
-  srv_qt_tab <- stats::quantile(srv_fit, probs = quantiles)$quantile
+  srv_qt_tab_pre <- stats::quantile(srv_fit, probs = quantiles)
+  srv_qt_tab <- srv_qt_tab_pre$quantile
   range_censor <- range_noinf(df[[.var]][!df[[is_event]]], na.rm = TRUE)
   range_event <- range_noinf(df[[.var]][df[[is_event]]], na.rm = TRUE)
   range <- range_noinf(df[[.var]], na.rm = TRUE)
+
+  names(quantiles) <- as.character(100 * quantiles)
+  srv_qt_tab_pre <- unlist(srv_qt_tab_pre)
+  srv_qt_ci <- lapply(quantiles, function(x) {
+    name <- as.character(100 * x)
+
+    c(
+      srv_qt_tab_pre[[paste0("quantile.", name)]],
+      srv_qt_tab_pre[[paste0("lower.", name)]],
+      srv_qt_tab_pre[[paste0("upper.", name)]]
+    )
+  })
+
   list(
     median = formatters::with_label(unname(srv_tab["median"]), "Median"),
     median_ci = formatters::with_label(
@@ -84,7 +101,20 @@ s_surv_time <- function(df,
     ),
     range_censor = formatters::with_label(range_censor, "Range (censored)"),
     range_event = formatters::with_label(range_event, "Range (event)"),
-    range = formatters::with_label(range, "Range")
+    range = formatters::with_label(range, "Range"),
+    median_long = formatters::with_label(
+      c(
+        unname(srv_tab["median"]),
+        unname(srv_tab[paste0(srv_fit$conf.int, c("LCL", "UCL"))])
+      ),
+      paste0("Median (", f_conf_level(conf_level), ")")
+    ),
+    quantiles_lower = formatters::with_label(
+      unname(srv_qt_ci[[1]]), paste0(quantiles[1] * 100, "%-ile (", f_conf_level(conf_level), ")")
+    ),
+    quantiles_upper = formatters::with_label(
+      unname(srv_qt_ci[[2]]), paste0(quantiles[2] * 100, "%-ile (", f_conf_level(conf_level), ")")
+    )
   )
 }
 
@@ -121,8 +151,17 @@ a_surv_time <- function(df,
   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)")
+  fmts <- c(
+    median_ci = "(xx.x, xx.x)", quantiles = "xx.x, xx.x", range = "xx.x to xx.x",
+    median_long = "xx.x (xx.x - xx.x)",
+    quantiles_lower = "xx.x (xx.x - xx.x)", quantiles_upper = "xx.x (xx.x - xx.x)"
+  )
+  lbls <- c(
+    median_ci = "95% CI", range = "Range", range_censor = "Range (censored)", range_event = "Range (event)",
+    median_long = "Median (95% CI)",
+    quantiles_lower = "25%-ile (95% CI)",
+    quantiles_upper = "75%-ile (95% CI)"
+  )
   lbls_custom <- .labels
   .formats <- c(.formats, fmts[setdiff(names(fmts), names(.formats))])
   .labels <- c(.labels, lbls[setdiff(names(lbls), names(lbls_custom))])
@@ -155,7 +194,6 @@ a_surv_time <- function(df,
     .names = .labels,
     .labels = .labels,
     .indent_mods = .indent_mods,
-    .format_na_strs = na_str,
     .cell_footnotes = cell_fns
   )
 }
@@ -198,7 +236,7 @@ surv_time <- function(lyt,
                       .labels = NULL,
                       .indent_mods = c(median_ci = 1L)) {
   extra_args <- list(
-    .stats = .stats, .formats = .formats, .labels = .labels, .indent_mods = .indent_mods, na_str = na_str,
+    .stats = .stats, .formats = .formats, .labels = .labels, .indent_mods = .indent_mods,
     is_event = is_event, control = control, ref_fn_censor = ref_fn_censor, ...
   )
 

R/survival_timepoint.R

@@ -39,6 +39,7 @@ NULL
 #'   * `event_free_rate`: Event-free rate (%).
 #'   * `rate_se`: Standard error of event free rate.
 #'   * `rate_ci`: Confidence interval for event free rate.
+#'   * `event_free_rate_long`: Event-free rate (%) with Confidence interval.
 #'
 #' @keywords internal
 s_surv_timepoint <- function(df,
@@ -73,11 +74,15 @@ s_surv_timepoint <- function(df,
     rate_se <- df_srv_fit$std.err
     rate_ci <- c(df_srv_fit$lower, df_srv_fit$upper)
   }
+  event_free_rate_long <- c(event_free_rate, rate_ci)
   list(
     pt_at_risk = formatters::with_label(pt_at_risk, "Patients remaining at risk"),
     event_free_rate = formatters::with_label(event_free_rate * 100, "Event Free Rate (%)"),
     rate_se = formatters::with_label(rate_se * 100, "Standard Error of Event Free Rate"),
-    rate_ci = formatters::with_label(rate_ci * 100, f_conf_level(conf_level))
+    rate_ci = formatters::with_label(rate_ci * 100, f_conf_level(conf_level)),
+    event_free_rate_long = formatters::with_label(
+      event_free_rate_long * 100, paste0("Event Free Rate (", f_conf_level(conf_level), ")")
+    )
   )
 }
 
@@ -110,6 +115,7 @@ a_surv_timepoint <- make_afun(
 #' * `s_surv_timepoint_diff()` returns the statistics:
 #'   * `rate_diff`: Event-free rate difference between two groups.
 #'   * `rate_diff_ci`: Confidence interval for the difference.
+#'   * `rate_diff_long`: Event-free rate difference and confidence interval between two groups.
 #'   * `ztest_pval`: p-value to test the difference is 0.
 #'
 #' @keywords internal
@@ -125,6 +131,9 @@ s_surv_timepoint_diff <- function(df,
       list(
         rate_diff = formatters::with_label("", "Difference in Event Free Rate"),
         rate_diff_ci = formatters::with_label("", f_conf_level(control$conf_level)),
+        rate_diff_long = formatters::with_label(
+          "", paste0("Difference in Event Free Rate", f_conf_level(control$conf_level))
+        ),
         ztest_pval = formatters::with_label("", "p-value (Z-test)")
       )
     )
@@ -142,6 +151,7 @@ s_surv_timepoint_diff <- function(df,
 
   qs <- c(-1, 1) * stats::qnorm(1 - (1 - control$conf_level) / 2)
   rate_diff_ci <- rate_diff + qs * se_diff
+  rate_diff_long <- c(rate_diff, rate_diff_ci)
   ztest_pval <- if (is.na(rate_diff)) {
     NA
   } else {
@@ -150,6 +160,9 @@ s_surv_timepoint_diff <- function(df,
   list(
     rate_diff = formatters::with_label(rate_diff, "Difference in Event Free Rate"),
     rate_diff_ci = formatters::with_label(rate_diff_ci, f_conf_level(control$conf_level)),
+    rate_diff_long = formatters::with_label(
+      rate_diff_long, paste0("Difference in Event Free Rate", f_conf_level(control$conf_level))
+    ),
     ztest_pval = formatters::with_label(ztest_pval, "p-value (Z-test)")
   )
 }
@@ -166,6 +179,7 @@ a_surv_timepoint_diff <- make_afun(
   .formats = c(
     rate_diff = "xx.xx",
     rate_diff_ci = "(xx.xx, xx.xx)",
+    rate_diff_long = format_xx("xx.xx (xx.xx, xx.xx)"),
     ztest_pval = "x.xxxx | (<0.0001)"
   )
 )
@@ -259,8 +273,8 @@ surv_timepoint <- function(lyt,
   extra_args <- list(time_point = time_point, is_event = is_event, control = control, ...)
 
   f <- list(
-    surv = c("pt_at_risk", "event_free_rate", "rate_se", "rate_ci"),
-    surv_diff = c("rate_diff", "rate_diff_ci", "ztest_pval")
+    surv = c("pt_at_risk", "event_free_rate", "rate_se", "rate_ci", "event_free_rate_long"),
+    surv_diff = c("rate_diff", "rate_diff_ci", "ztest_pval", "rate_diff_long")
   )
   .stats <- h_split_param(.stats, .stats, f = f)
   .formats <- h_split_param(.formats, names(.formats), f = f)

R/utils_default_stats_formats_labels.R

@@ -344,6 +344,20 @@ labels_use_control <- function(labels_default, control, labels_custom = NULL) {
       labels_default["quantiles"]
     )
   }
+  if ("quantiles" %in% names(control) && "quantiles_lower" %in% names(labels_default) &&
+    !"quantiles_lower" %in% names(labels_custom)) { # nolint
+    labels_default["quantiles_lower"] <- gsub(
+      "[0-9]+%-ile", paste0(control[["quantiles"]][1] * 100, "%-ile", ""),
+      labels_default["quantiles_lower"]
+    )
+  }
+  if ("quantiles" %in% names(control) && "quantiles_upper" %in% names(labels_default) &&
+    !"quantiles_upper" %in% names(labels_custom)) { # nolint
+    labels_default["quantiles_upper"] <- gsub(
+      "[0-9]+%-ile", paste0(control[["quantiles"]][2] * 100, "%-ile", ""),
+      labels_default["quantiles_upper"]
+    )
+  }
   if ("test_mean" %in% names(control) && "mean_pval" %in% names(labels_default) &&
     !"mean_pval" %in% names(labels_custom)) { # nolint
     labels_default["mean_pval"] <- gsub(
@@ -372,7 +386,8 @@ tern_default_stats <- list(
   analyze_vars_numeric = c(
     "n", "sum", "mean", "sd", "se", "mean_sd", "mean_se", "mean_ci", "mean_sei", "mean_sdi", "mean_pval",
     "median", "mad", "median_ci", "quantiles", "iqr", "range", "min", "max", "median_range", "cv",
-    "geom_mean", "geom_mean_ci", "geom_cv"
+    "geom_mean", "geom_mean_ci", "geom_cv",
+    "mean_long", "median_long", "geom_mean_long"
   ),
   count_cumulative = c("count_fraction", "count_fraction_fixed_dp"),
   count_missed_doses = c("n", "count_fraction", "count_fraction_fixed_dp"),
@@ -392,8 +407,14 @@ tern_default_stats <- list(
   summarize_glm_count = c("n", "rate", "rate_ci", "rate_ratio", "rate_ratio_ci", "pval"),
   summarize_num_patients = c("unique", "nonunique", "unique_count"),
   summarize_patients_events_in_cols = c("unique", "all"),
-  surv_time = c("median", "median_ci", "quantiles", "range_censor", "range_event", "range"),
-  surv_timepoint = c("pt_at_risk", "event_free_rate", "rate_se", "rate_ci", "rate_diff", "rate_diff_ci", "ztest_pval"),
+  surv_time = c(
+    "median", "median_ci", "median_long", "quantiles",
+    "quantiles_lower", "quantiles_upper", "range_censor", "range_event", "range"
+  ),
+  surv_timepoint = c(
+    "pt_at_risk", "event_free_rate", "rate_se", "rate_ci", "rate_diff", "rate_diff_ci", "ztest_pval",
+    "event_free_rate_long"
+  ),
   tabulate_rsp_biomarkers = c("n_tot", "n_rsp", "prop", "or", "ci", "pval"),
   tabulate_rsp_subgroups = c("n", "n_rsp", "prop", "n_tot", "or", "ci", "pval"),
   tabulate_survival_biomarkers = c("n_tot", "n_tot_events", "median", "hr", "ci", "pval"),
@@ -431,7 +452,10 @@ tern_default_formats <- c(
   median = "xx.x",
   mad = "xx.x",
   median_ci = "(xx.xx, xx.xx)",
+  median_long = "xx.xx (xx.xx - xx.xx)",
   quantiles = "xx.x - xx.x",
+  quantiles_lower = "xx.xx (xx.xx - xx.xx)",
+  quantiles_upper = "xx.xx (xx.xx - xx.xx)",
   iqr = "xx.x",
   range = "xx.x - xx.x",
   min = "xx.x",
@@ -480,7 +504,10 @@ tern_default_labels <- c(
   median = "Median",
   mad = "Median Absolute Deviation",
   median_ci = "Median 95% CI",
+  median_long = "Median (95% CI)",
   quantiles = "25% and 75%-ile",
+  quantiles_lower = "25%-ile (95% CI)",
+  quantiles_upper = "75%-ile (95% CI)",
   iqr = "IQR",
   range = "Min - Max",
   min = "Minimum",

tests/testthat/_snaps/survival_coxph_pairwise.md

@@ -18,6 +18,11 @@
       attr(,"label")
       [1] "95% CI"
 
+      $hr_long
+      [1] 0.7108557 0.4779138 1.0573368
+      attr(,"label")
+      [1] "Hazard Ratio (95% CI)"
+
       $n_tot
       [1] 142
       attr(,"label")
@@ -49,6 +54,11 @@
       attr(,"label")
       [1] "90% CI"
 
+      $hr_long
+      [1] 0.7108557 0.5094153 0.9919525
+      attr(,"label")
+      [1] "Hazard Ratio (90% CI)"
+
       $n_tot
       [1] 142
       attr(,"label")
@@ -80,6 +90,11 @@
       attr(,"label")
       [1] "95% CI"
 
+      $hr_long
+      [1] 0.6251817 0.4014842 0.9735181
+      attr(,"label")
+      [1] "Hazard Ratio (95% CI)"
+
       $n_tot
       [1] 142
       attr(,"label")
@@ -111,6 +126,11 @@
       attr(,"label")
       [1] "90% CI"
 
+      $hr_long
+      [1] 0.6251817 0.4311132 0.9066115
+      attr(,"label")
+      [1] "Hazard Ratio (90% CI)"
+
       $n_tot
       [1] 142
       attr(,"label")