Kaplan meier; Added range_with_cens_info statistic to s_surv_time()

NAMESPACE

@@ -137,6 +137,7 @@ export(format_extreme_values_ci)
 export(format_fraction)
 export(format_fraction_fixed_dp)
 export(format_fraction_threshold)
+export(format_range_cens)
 export(format_sigfig)
 export(format_xx)
 export(g_bland_altman)
@@ -265,6 +266,7 @@ export(range_noinf)
 export(reapply_varlabels)
 export(ref_group_position)
 export(rtable2gg)
+export(s_ancova)
 export(s_bland_altman)
 export(s_compare)
 export(s_count_occurrences)
@@ -280,6 +282,7 @@ export(s_odds_ratio)
 export(s_proportion)
 export(s_proportion_diff)
 export(s_summary)
+export(s_surv_time)
 export(s_surv_timepoint)
 export(s_test_proportion_diff)
 export(sas_na)

NEWS.md

@@ -2,11 +2,15 @@
 
 ### Miscellaneous
 * Updated `roxygen2` to 8.0.0 and added `@exportS3Method` tags for S3 methods in `decorate_grob.R` and `utils_grid.R`.
+* Converted  `s_surv_time()`to exported functions.
 
 ### Enhancements
 * Added `alternative` argument to `s_coxph_pairwise()` to allow one-sided hypothesis testing. 
 * Added `lr_stat_df` to the parameters return list of `s_coxph_pairwise()`.
 * Added `uncond_exact_diff` method to `estimate_proportion_diff()` for the unconditional exact confidence interval for the difference in proportions by inverting one-sided tail tests over a nuisance parameter.
+* Added `range_with_cens_info` statistic to `s_surv_time()`.
+* Added `lsmean_se`, `lsmean_ci`, and `lsmean_diffci` statistics to `s_ancova()`.
+* Added `s_ancova()` to exported functions.
 
 ### Bug Fixes
 * Fixed bug in `prop_diff_cmh()` which previously failed when strata combinations had 0 observations.

R/formatting_functions.R

@@ -42,7 +42,7 @@ format_fraction <- function(x, ...) {
     )
   }
 
-  return(result)
+  result
 }
 
 #' Format fraction and percentage with fixed single decimal place
@@ -77,7 +77,7 @@ format_fraction_fixed_dp <- function(x, ...) {
       " (", sprintf("%.1f", round(x["num"] / x["denom"] * 100, 1)), "%)"
     )
   }
-  return(result)
+  result
 }
 
 #' Format count and fraction
@@ -114,7 +114,7 @@ format_count_fraction <- function(x, ...) {
     paste0(x[1], " (", round(x[2] * 100, 1), "%)")
   }
 
-  return(result)
+  result
 }
 
 #' Format count and percentage with fixed single decimal place
@@ -153,7 +153,7 @@ format_count_fraction_fixed_dp <- function(x, ...) {
     sprintf("%d (%.1f%%)", x[1], x[2] * 100)
   }
 
-  return(result)
+  result
 }
 
 #' Format count and fraction with special case for count < 10
@@ -190,7 +190,7 @@ format_count_fraction_lt10 <- function(x, ...) {
     paste0(x[1], " (", round(x[2] * 100, 1), "%)")
   }
 
-  return(result)
+  result
 }
 
 #' Format XX as a formatting function
@@ -229,17 +229,17 @@ format_xx <- function(str) {
       rounding <- function(x) {
         round(x, digits = ifelse(length(y) > 1, nchar(y[2]), 0))
       }
-      return(rounding)
+      rounding
     }
   )
 
   rtable_format <- function(x, output) {
     values <- Map(y = x, fun = roundings, function(y, fun) fun(y))
     regmatches(x = str, m = positions)[[1]] <- values
-    return(str)
+    str
   }
 
-  return(rtable_format)
+  rtable_format
 }
 
 #' Format numeric values by significant figures
@@ -534,7 +534,7 @@ format_auto <- function(dt_var, x_stat) {
     out[is_even] <- str_vals
     out[!is_even] <- inv_str_fmt
 
-    return(paste0(out, collapse = ""))
+    paste0(out, collapse = "")
   }
 }
 
@@ -546,11 +546,11 @@ str_extract <- function(string, pattern = "xx|xx\\.|xx\\.x+", invert = FALSE) {
 # Helper function
 count_decimalplaces <- function(dec) {
   if (is.na(dec)) {
-    return(0)
+    0
   } else if (abs(dec - round(dec)) > .Machine$double.eps^0.5) { # For precision
     nchar(strsplit(format(dec, scientific = FALSE, trim = FALSE), ".", fixed = TRUE)[[1]][[2]])
   } else {
-    return(0)
+    0
   }
 }
 
@@ -573,3 +573,34 @@ apply_auto_formatting <- function(.formats, x_stats, .df_row, .var) {
   }
   .formats
 }
+
+#' Format range with censoring indicators
+#'
+#' @description `r lifecycle::badge("experimental")`
+#'
+#' Formats a survival time range where the minimum and/or maximum may be a censored observation.
+#' A `+` suffix is appended to a bound when the corresponding censoring flag is `TRUE`.
+#'
+#' @param digits (`integer(1)`)\cr number of decimal places to display. Defaults to `1L`.
+#'
+#' @return An `rtables` formatting function that takes a `numeric(4)` vector of the form
+#'   `c(min, max, lower_censored, upper_censored)`, where `lower_censored` and `upper_censored`
+#'   are `0`/`1` (or `FALSE`/`TRUE`) flags, and returns a string in the format `"min to max"`,
+#'   with `+` appended to `min` and/or `max` when the corresponding censoring flag is non-zero.
+#'
+#' @examples
+#' fmt <- format_range_cens(1L)
+#' fmt(c(1.23, 9.87, 1, 0))
+#' fmt(c(1.23, 9.87, 0, 0))
+#'
+#' @family formatting functions
+#' @export
+format_range_cens <- function(digits = 1L) {
+  checkmate::assert_integerish(digits)
+  function(x, ...) {
+    checkmate::assert_numeric(x, len = 4)
+    l_result <- paste0(round(x[1], digits), if (x[3] != 0) "+" else "")
+    h_result <- paste0(round(x[2], digits), if (x[4] != 0) "+" else "")
+    paste(l_result, "to", h_result)
+  }
+}

R/summarize_ancova.R

@@ -101,16 +101,20 @@ h_ancova <- function(.var,
 #'   of the investigated linear model.
 #'
 #' @return
-#' * `s_ancova()` returns a named list of 5 statistics:
+#' * `s_ancova()` returns a named list of 8 statistics:
 #'   * `n`: Count of complete sample size for the group.
 #'   * `lsmean`: Estimated marginal means in the group.
+#'   * `lsmean_se`: Adjusted mean with standard error as a 2-element vector `c(emmean, SE)`.
+#'   * `lsmean_ci`: Adjusted mean with confidence interval as a 3-element vector `c(emmean, lower.CL, upper.CL)`.
 #'   * `lsmean_diff`: Difference in estimated marginal means in comparison to the reference group.
 #'     If working with the reference group, this will be empty.
 #'   * `lsmean_diff_ci`: Confidence level for difference in estimated marginal means in comparison
 #'     to the reference group.
+#'   * `lsmean_diff_with_ci`: Difference in adjusted means with confidence interval as a 3-element vector
+#'     `c(estimate, lower.CL, upper.CL)`.
 #'   * `pval`: p-value (not adjusted for multiple comparisons).
 #'
-#' @keywords internal
+#' @export
 s_ancova <- function(df,
                      .var,
                      .df_row,
@@ -165,8 +169,20 @@ s_ancova <- function(df,
     list(
       n = length(y[!is.na(y)]),
       lsmean = formatters::with_label(sum_fit_level$emmean, "Adjusted Mean"),
+      lsmean_se = formatters::with_label(
+        c(sum_fit_level$emmean, sum_fit_level$SE),
+        "Adjusted Mean (SE)"
+      ),
+      lsmean_ci = formatters::with_label(
+        c(sum_fit_level$emmean, sum_fit_level$lower.CL, sum_fit_level$upper.CL),
+        f_conf_level(conf_level)
+      ),
       lsmean_diff = formatters::with_label(numeric(), "Difference in Adjusted Means"),
       lsmean_diff_ci = formatters::with_label(numeric(), f_conf_level(conf_level)),
+      lsmean_diff_with_ci = formatters::with_label(
+        numeric(),
+        paste0("Difference in Adjusted Means (", f_conf_level(conf_level), ")")
+      ),
       pval = formatters::with_label(numeric(), "p-value")
     )
   } else {
@@ -202,11 +218,23 @@ s_ancova <- function(df,
     list(
       n = length(y[!is.na(y)]),
       lsmean = formatters::with_label(sum_fit_level$emmean, "Adjusted Mean"),
+      lsmean_se = formatters::with_label(
+        c(sum_fit_level$emmean, sum_fit_level$SE),
+        "Adjusted Mean (SE)"
+      ),
+      lsmean_ci = formatters::with_label(
+        c(sum_fit_level$emmean, sum_fit_level$lower.CL, sum_fit_level$upper.CL),
+        f_conf_level(conf_level)
+      ),
       lsmean_diff = formatters::with_label(sum_contrasts_level$estimate, "Difference in Adjusted Means"),
       lsmean_diff_ci = formatters::with_label(
         c(sum_contrasts_level$lower.CL, sum_contrasts_level$upper.CL),
         f_conf_level(conf_level)
       ),
+      lsmean_diff_with_ci = formatters::with_label(
+        c(sum_contrasts_level$estimate, sum_contrasts_level$lower.CL, sum_contrasts_level$upper.CL),
+        paste0("Difference in Adjusted Means (", f_conf_level(conf_level), ")")
+      ),
       pval = formatters::with_label(sum_contrasts_level$p.value, "p-value")
     )
   }

R/survival_coxph_pairwise.R

@@ -112,37 +112,37 @@ s_coxph_pairwise <- function(df,
 
   pval <- if (pval_method == "wald") {
     if (alternative == "two.sided") {
-        sum_cox$waldtest["pvalue"]
+      sum_cox$waldtest["pvalue"]
     } else {
-        # Need to calculate the signed Wald statistic.
-        beta_est <- unname(cox_fit$coefficients)
-        beta_se <- sqrt(cox_fit$var[1, 1])
-        signed_wald_stat <- beta_est / beta_se
-        if (alternative == "less") {
-          stats::pnorm(signed_wald_stat)
-        } else {
-          stats::pnorm(signed_wald_stat, lower.tail = FALSE)
-        }
-    }    
+      # Need to calculate the signed Wald statistic.
+      beta_est <- unname(cox_fit$coefficients)
+      beta_se <- sqrt(cox_fit$var[1, 1])
+      signed_wald_stat <- beta_est / beta_se
+      if (alternative == "less") {
+        stats::pnorm(signed_wald_stat)
+      } else {
+        stats::pnorm(signed_wald_stat, lower.tail = FALSE)
+      }
+    }
   } else if (pval_method == "log-rank") {
     if (alternative == "two.sided") {
-        original_survdiff$pvalue
+      original_survdiff$pvalue
     } else {
-        # Need to calculate the signed log-rank statistic, 
-        # which is not included in the original survdiff output.
-        otmp <- rowSums(original_survdiff$obs)
-        etmp <- rowSums(original_survdiff$exp)
-        signed_lr_stat <- (otmp[2] - etmp[2]) / sqrt(original_survdiff$var[2, 2])
+      # Need to calculate the signed log-rank statistic,
+      # which is not included in the original survdiff output.
+      otmp <- rowSums(original_survdiff$obs)
+      etmp <- rowSums(original_survdiff$exp)
+      signed_lr_stat <- (otmp[2] - etmp[2]) / sqrt(original_survdiff$var[2, 2])
 
-        if (alternative == "less") {
-          stats::pnorm(signed_lr_stat)
-        } else {
-          stats::pnorm(signed_lr_stat, lower.tail = FALSE)
-        }
+      if (alternative == "less") {
+        stats::pnorm(signed_lr_stat)
+      } else {
+        stats::pnorm(signed_lr_stat, lower.tail = FALSE)
+      }
     }
   } else if (pval_method == "likelihood") {
     if (alternative != "two.sided") {
-        stop("Likelihood ratio test does not support one-sided alternatives")
+      stop("Likelihood ratio test does not support one-sided alternatives")
     }
     sum_cox$logtest["pvalue"]
   } else {

R/survival_time.R

@@ -51,8 +51,9 @@ NULL
 #'   * `range_censor`: Survival time range for censored observations.
 #'   * `range_event`: Survival time range for observations with events.
 #'   * `range`: Survival time range for all observations.
+#'   * `range_with_cens_info`: Survival time range for all observations, with `+` suffix on censored bounds.
 #'
-#' @keywords internal
+#' @export
 s_surv_time <- function(df,
                         .var,
                         ...,
@@ -81,6 +82,11 @@ s_surv_time <- function(df,
   range_event <- range_noinf(df[[.var]][df[[is_event]]], na.rm = TRUE)
   range <- range_noinf(df[[.var]], na.rm = TRUE)
 
+  any_censored <- !all(df[[is_event]])
+  no_event <- !any(df[[is_event]])
+  lower_censored <- any_censored && (no_event || range_censor[1] < range_event[1])
+  upper_censored <- any_censored && (no_event || range_censor[2] > range_event[2])
+
   names(quantiles) <- as.character(100 * quantiles)
   srv_qt_tab_pre <- unlist(srv_qt_tab_pre)
   srv_qt_ci <- lapply(quantiles, function(x) {
@@ -116,6 +122,10 @@ s_surv_time <- function(df,
     ),
     quantiles_upper = formatters::with_label(
       unname(srv_qt_ci[[2]]), paste0(quantiles[2] * 100, "%-ile (", f_conf_level(conf_level), ")")
+    ),
+    range_with_cens_info = formatters::with_label(
+      c(range, lower_censored, upper_censored),
+      "Min - Max (with censoring)"
     )
   )
 }

R/utils_default_stats_formats_labels.R

@@ -580,14 +580,16 @@ tern_default_stats <- list(
   estimate_odds_ratio = c("or_ci", "n_tot"),
   estimate_proportion = c("n_prop", "prop_ci"),
   estimate_proportion_diff = c("diff", "diff_ci"),
-  summarize_ancova = c("n", "lsmean", "lsmean_diff", "lsmean_diff_ci", "pval"),
+  summarize_ancova = c("n", "lsmean", "lsmean_se", "lsmean_ci",
+                       "lsmean_diff", "lsmean_diff_ci", "lsmean_diff_with_ci", "pval"),
   summarize_coxreg = c("n", "hr", "ci", "pval", "pval_inter"),
   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", "median_ci_3d", "quantiles",
-    "quantiles_lower", "quantiles_upper", "range_censor", "range_event", "range"
+    "quantiles_lower", "quantiles_upper", "range_censor", "range_event", "range",
+    "range_with_cens_info"
   ),
   surv_timepoint = c("pt_at_risk", "event_free_rate", "rate_se", "rate_ci", "event_free_rate_3d"),
   surv_timepoint_diff = c("rate_diff", "rate_diff_ci", "ztest_pval", "rate_diff_ci_3d"),
@@ -626,8 +628,11 @@ tern_default_formats <- c(
   lr_stat_df = "xx.xx (xx.)",
   iqr = "xx.x",
   lsmean = "xx.xx",
+  lsmean_ci = "xx.xx (xx.xx - xx.xx)",
   lsmean_diff = "xx.xx",
   lsmean_diff_ci = "(xx.xx, xx.xx)",
+  lsmean_diff_with_ci = "xx.xx (xx.xx - xx.xx)",
+  lsmean_se = "xx.xx (xx.xx)",
   mad = "xx.x",
   max = "xx.x",
   mean = "xx.x",
@@ -677,6 +682,7 @@ tern_default_formats <- c(
   rate_ratio = "xx.xxxx",
   rate_ratio_ci = "(xx.xxxx, xx.xxxx)",
   rate_se = "xx.xx",
+  range_with_cens_info = list(format_range_cens(1L)),
   riskdiff = "xx.x (xx.x - xx.x)",
   sd = "xx.x",
   se = "xx.x",
@@ -730,6 +736,7 @@ tern_default_labels <- c(
   range = "Min - Max",
   range_censor = "Range (censored)",
   range_event = "Range (event)",
+  range_with_cens_info = "Min - Max (with censoring)",
   rate = "Adjusted Rate",
   rate_ratio = "Adjusted Rate Ratio",
   sd = "SD",

_pkgdown.yml

@@ -64,6 +64,7 @@ reference:
       - -estimate_coef
       - -summarize_functions
       - s_surv_timepoint
+      - s_surv_time
       - s_test_proportion_diff
 
   - title: Model-Specific Functions