diff --git a/.Rprofile b/.Rprofile new file mode 100644 index 0000000000..79806fcf62 --- /dev/null +++ b/.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" + ) + } + }) +} diff --git a/R/g_km.R b/R/g_km.R index f56f7745e6..0c2181926a 100644 --- a/R/g_km.R +++ b/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) + diff --git a/R/h_km.R b/R/h_km.R index 9fd74966b6..70dcb080fc 100644 --- a/R/h_km.R +++ b/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")], diff --git a/man/control_annot.Rd b/man/control_annot.Rd index d6c7c5354f..881189d261 100644 --- a/man/control_annot.Rd +++ b/man/control_annot.Rd @@ -6,7 +6,14 @@ \alias{control_coxph_annot} \title{Control functions for Kaplan-Meier plot annotation tables} \usage{ -control_surv_med_annot(x = 0.8, y = 0.85, w = 0.32, h = 0.16, fill = TRUE) +control_surv_med_annot( + x = 0.8, + y = 0.85, + w = 0.32, + h = 0.16, + fill = TRUE, + digits = 4 +) control_coxph_annot( x = 0.29, @@ -29,6 +36,9 @@ control_coxph_annot( \item{fill}{(\code{flag} or \code{character})\cr whether the annotation table should have a background fill color. Can also be a color code to use as the background fill color. If \code{TRUE}, color code defaults to \code{"#00000020"}.} +\item{digits}{(\code{integer(1)})\cr number of significant digits for median survival +time and confidence interval values. Defaults to \code{4}.} + \item{ref_lbls}{(\code{flag})\cr whether the reference group should be explicitly printed in labels for the annotation table. If \code{FALSE} (default), only comparison groups will be printed in the table labels.} } @@ -54,6 +64,7 @@ by setting it as the \code{control_annot_coxph} argument. }} \examples{ control_surv_med_annot() +control_surv_med_annot(digits = 2) control_coxph_annot() diff --git a/man/h_tbl_median_surv.Rd b/man/h_tbl_median_surv.Rd index 3f759039ab..123af37a0e 100644 --- a/man/h_tbl_median_surv.Rd +++ b/man/h_tbl_median_surv.Rd @@ -4,12 +4,15 @@ \alias{h_tbl_median_surv} \title{Helper function for survival estimations} \usage{ -h_tbl_median_surv(fit_km, armval = "All") +h_tbl_median_surv(fit_km, armval = "All", digits = 4) } \arguments{ \item{fit_km}{(\code{survfit})\cr result of \code{\link[survival:survfit]{survival::survfit()}}.} \item{armval}{(\code{string})\cr used as strata name when treatment arm variable only has one level. Default is \code{"All"}.} + +\item{digits}{(\code{integer(1)})\cr number of significant digits for median and CI values. +Defaults to \code{4}.} } \value{ A summary table with statistics \code{N}, \code{Median}, and \verb{XX\% CI} (\code{XX} taken from \code{fit_km}). @@ -29,5 +32,6 @@ fit <- survfit( data = adtte ) h_tbl_median_surv(fit_km = fit) +h_tbl_median_surv(fit_km = fit, digits = 2) } diff --git a/tests/testthat/_snaps/h_km.md b/tests/testthat/_snaps/h_km.md index dbca98df7f..64b7db269a 100644 --- a/tests/testthat/_snaps/h_km.md +++ b/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 diff --git a/tests/testthat/test-h_km.R b/tests/testthat/test-h_km.R index 16846da227..bbabbd67ef 100644 --- a/tests/testthat/test-h_km.R +++ b/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") |>