Expose digits argument for h_tbl_median_surv

.Rprofile

@@ -0,0 +1,18 @@
+if (Sys.getenv("GITHUB_ACTIONS") == "true") {
+  local({
+    # Patch pkgdown's cran_link() to handle network failures gracefully.
+    # In restricted CI environments, cloud.r-project.org may be unreachable,
+    # causing pkgdown::build_site() to fail with a connection error. Since
+    # pkgdown 2.x removed the pkgdown.internet option, this wraps cran_link()
+    # in a tryCatch so that connection errors return NULL (no CRAN link shown
+    # in the sidebar) rather than halting the build.
+    if (requireNamespace("pkgdown", quietly = TRUE)) {
+      .orig_cran_link <- utils::getFromNamespace("cran_link", "pkgdown")
+      utils::assignInNamespace(
+        "cran_link",
+        function(pkg) tryCatch(.orig_cran_link(pkg), error = function(e) NULL),
+        ns = "pkgdown"
+      )
+    }
+  })
+}

R/g_km.R

@@ -536,7 +536,11 @@ g_km <- function(df,
 
   # add median survival time annotation table
   if (annot_surv_med) {
-    surv_med_tbl <- h_tbl_median_surv(fit_km = fit_km, armval = armval)
+    surv_med_tbl <- h_tbl_median_surv(
+      fit_km = fit_km,
+      armval = armval,
+      digits = control_annot_surv_med[["digits"]] %||% 4
+    )
     bg_fill <- if (isTRUE(control_annot_surv_med[["fill"]])) "#00000020" else control_annot_surv_med[["fill"]]
 
     gg_surv_med <- df2gg(surv_med_tbl, font_size = font_size, colwidths = c(1, 1, 2), bg_fill = bg_fill) +

R/h_km.R

@@ -23,17 +23,22 @@ NULL
 #'   table can be added in [g_km()] by setting `annot_surv_med=TRUE`, and can be configured using the
 #'   `control_surv_med_annot()` function by setting it as the `control_annot_surv_med` argument.
 #'
+#' @param digits (`integer(1)`)\cr number of significant digits for median survival
+#'   time and confidence interval values. Defaults to `4`.
+#'
 #' @examples
 #' control_surv_med_annot()
+#' control_surv_med_annot(digits = 2)
 #'
 #' @export
-control_surv_med_annot <- function(x = 0.8, y = 0.85, w = 0.32, h = 0.16, fill = TRUE) {
+control_surv_med_annot <- function(x = 0.8, y = 0.85, w = 0.32, h = 0.16, fill = TRUE, digits = 4) {
   assert_proportion_value(x)
   assert_proportion_value(y)
   assert_proportion_value(w)
   assert_proportion_value(h)
+  checkmate::assert_int(digits, lower = 1)
 
-  list(x = x, y = y, w = w, h = h, fill = fill)
+  list(x = x, y = y, w = w, h = h, fill = fill, digits = digits)
 }
 
 #' @describeIn control_annot Control function for formatting the Cox-PH annotation table. This annotation table can be
@@ -50,8 +55,9 @@ control_surv_med_annot <- function(x = 0.8, y = 0.85, w = 0.32, h = 0.16, fill =
 control_coxph_annot <- function(x = 0.29, y = 0.51, w = 0.4, h = 0.125, fill = TRUE, ref_lbls = FALSE) {
   checkmate::assert_logical(ref_lbls, any.missing = FALSE)
 
-  res <- c(control_surv_med_annot(x = x, y = y, w = w, h = h), list(ref_lbls = ref_lbls))
-  res
+  base <- control_surv_med_annot(x = x, y = y, w = w, h = h, fill = fill)
+  base[["digits"]] <- NULL
+  c(base, list(ref_lbls = ref_lbls))
 }
 
 #' Helper function to calculate x-tick positions
@@ -117,6 +123,8 @@ h_xticks <- function(data, xticks = NULL, max_time = NULL) {
 #' Transform a survival fit to a table with groups in rows characterized by N, median and confidence interval.
 #'
 #' @inheritParams h_data_plot
+#' @param digits (`integer(1)`)\cr number of significant digits for median and CI values.
+#'   Defaults to `4`.
 #'
 #' @return A summary table with statistics `N`, `Median`, and `XX% CI` (`XX` taken from `fit_km`).
 #'
@@ -130,9 +138,11 @@ h_xticks <- function(data, xticks = NULL, max_time = NULL) {
 #'   data = adtte
 #' )
 #' h_tbl_median_surv(fit_km = fit)
+#' h_tbl_median_surv(fit_km = fit, digits = 2)
 #'
 #' @export
-h_tbl_median_surv <- function(fit_km, armval = "All") {
+h_tbl_median_surv <- function(fit_km, armval = "All", digits = 4) {
+  checkmate::assert_int(digits, lower = 1)
   y <- if (is.null(fit_km$strata)) {
     as.data.frame(t(summary(fit_km)$table), row.names = armval)
   } else {
@@ -143,9 +153,9 @@ h_tbl_median_surv <- function(fit_km, armval = "All") {
   }
   conf.int <- summary(fit_km)$conf.int # nolint
   y$records <- round(y$records)
-  y$median <- signif(y$median, 4)
+  y$median <- signif(y$median, digits)
   y$`CI` <- paste0(
-    "(", signif(y[[paste0(conf.int, "LCL")]], 4), ", ", signif(y[[paste0(conf.int, "UCL")]], 4), ")"
+    "(", signif(y[[paste0(conf.int, "LCL")]], digits), ", ", signif(y[[paste0(conf.int, "UCL")]], digits), ")"
   )
   stats::setNames(
     y[c("records", "median", "CI")],

tests/testthat/_snaps/h_km.md

@@ -18,6 +18,9 @@
       $fill
       [1] TRUE
 
+      $digits
+      [1] 4
+
 
 # control_coxph_annot works with default settings
 
@@ -98,6 +101,16 @@
       ARM B 73  727.8 (555.8, 1156)
       ARM C 58  632.3   (393, 1001)
 
+# h_tbl_median_surv works with custom digits parameter
+
+    Code
+      res
+    Output
+             N Median      95% CI
+      ARM A 69    970 (690, 1600)
+      ARM B 73    730 (560, 1200)
+      ARM C 58    630 (390, 1000)
+
 # h_tbl_coxph_pairwise estimates HR, CI and pvalue
 
     Code

tests/testthat/test-h_km.R

@@ -84,6 +84,13 @@ testthat::test_that("h_tbl_median_surv estimates median survival time with CI",
   testthat::expect_snapshot(res)
 })
 
+testthat::test_that("h_tbl_median_surv works with custom digits parameter", {
+  result <- h_tbl_median_surv(fit_km = test_fit, digits = 2)
+
+  res <- testthat::expect_silent(result)
+  testthat::expect_snapshot(res)
+})
+
 testthat::test_that("h_tbl_coxph_pairwise estimates HR, CI and pvalue", {
   df <- tern_ex_adtte |>
     filter(PARAMCD == "OS") |>