diff --git a/R/g_km.R b/R/g_km.R index 3fab8a8ddf..326ca3f61e 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 bc7dd6b06d..78d56ee693 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 to use for rounding the +#' median survival time estimates and confidence interval values in the annotation table. 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 @@ -117,6 +122,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 to use for rounding the +#' median survival time estimates and confidence interval values. Defaults to `4`. #' #' @return A summary table with statistics `N`, `Median`, and `XX% CI` (`XX` taken from `fit_km`). #' @@ -130,9 +137,12 @@ 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 { @@ -141,11 +151,12 @@ h_tbl_median_surv <- function(fit_km, armval = "All") { rownames(tbl) <- matrix(unlist(rownames_lst), ncol = 2, byrow = TRUE)[, 2] as.data.frame(tbl) } + 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..dedb9ec610 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 to use for rounding the +median survival time estimates and confidence interval values in the annotation table. 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 06ab4c1817..c38c35ba11 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 to use for rounding the +median survival time estimates and confidence interval 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/test-h_km.R b/tests/testthat/test-h_km.R index b8c51aa4ef..b3c7178c5b 100644 --- a/tests/testthat/test-h_km.R +++ b/tests/testthat/test-h_km.R @@ -11,6 +11,13 @@ testthat::test_that("control_surv_med_annot works with default settings", { testthat::expect_snapshot(res) }) +testthat::test_that("control_surv_med_annot works with custom digits", { + result <- control_surv_med_annot(digits = 2) + + res <- testthat::expect_silent(result) + testthat::expect_snapshot(res) +}) + testthat::test_that("control_coxph_annot works with default settings", { result <- control_coxph_annot() @@ -84,6 +91,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 respects 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") %>%