From ea8aac53afcb93a6b1d1eb89352805816181eb66 Mon Sep 17 00:00:00 2001 From: anikoszabo Date: Thu, 5 Mar 2026 15:02:38 -0600 Subject: [PATCH 1/3] More flexible handling of survfit prediction beyond max time Add `summary.args = list(extend=TRUE/FALSE)` argument to ard_survival_survfit --- R/ard_survival_survfit.R | 35 ++++++---- man/ard_survival_survfit.Rd | 14 +++- man/dot-process_survfit_time.Rd | 15 ++++- tests/testthat/_snaps/ard_survival_survfit.md | 65 +++++++++++++++++++ tests/testthat/test-ard_survival_survfit.R | 20 ++++++ 5 files changed, 134 insertions(+), 15 deletions(-) diff --git a/R/ard_survival_survfit.R b/R/ard_survival_survfit.R index d666ecc68..b0e33ba06 100644 --- a/R/ard_survival_survfit.R +++ b/R/ard_survival_survfit.R @@ -31,6 +31,10 @@ #' [survival::survfit()]. Default is `NULL` for an unstratified model, e.g. `Surv() ~ 1`. #' @param method.args (named `list`)\cr #' named list of arguments that will be passed to [survival::survfit()]. +#' @param summary.args (named `list`)\cr +#' named list of arguments to modify the output of [survival::summary.survfit()]. Default is +#' `list(extend = TRUE)`, which reports estimates even when no subjects are at risk. If set to +#' `list(extend = FALSE)`, those estimates are set to NA. #' @inheritParams rlang::args_dots_empty #' #' @section Formula Specification: @@ -107,7 +111,8 @@ ard_survival_survfit <- function(x, ...) { #' @rdname ard_survival_survfit #' @export -ard_survival_survfit.survfit <- function(x, times = NULL, probs = NULL, type = NULL, ...) { +ard_survival_survfit.survfit <- function(x, times = NULL, probs = NULL, type = NULL, + summary.args = list(extend = TRUE), ...) { set_cli_abort_call() # check installed packages --------------------------------------------------- @@ -152,10 +157,13 @@ ard_survival_survfit.survfit <- function(x, times = NULL, probs = NULL, type = N ) } + # summary.args should have extend argument + check_scalar_logical(summary.args$extend) + # build ARD ------------------------------------------------------------------ est_type <- ifelse(is.null(probs), "times", "probs") tidy_survfit <- switch(est_type, - "times" = .process_survfit_time(x, times, type %||% "survival"), + "times" = .process_survfit_time(x, times, type %||% "survival", summary.args), "probs" = .process_survfit_probs(x, probs) ) @@ -224,10 +232,16 @@ ard_survival_survfit.data.frame <- function(x, y, #' #' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("survival", "broom"))) #' survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> -#' cardx:::.process_survfit_time(times = c(60, 180), type = "risk") +#' cardx:::.process_survfit_time(times = c(60, 180), type = "risk", +#' summary.args = list(extend = TRUE)) +#' +#' # don't evaluate values beyond last timepoint +#' survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> +#' cardx:::.process_survfit_time(times = c(60, 200), type = "risk", +#' summary.args = list(extend = FALSE)) #' #' @keywords internal -.process_survfit_time <- function(x, times, type, start.time = NULL) { +.process_survfit_time <- function(x, times, type, summary.args, start.time = NULL) { # add start time min_time <- min(x$time) if (is.null(start.time) && min_time < 0) { @@ -239,6 +253,7 @@ ard_survival_survfit.data.frame <- function(x, y, } else if (is.null(start.time)) { start.time <- 0 } + # call with extend = TRUE to get placeholders even if extend = FALSE is intended x <- survival::survfit0(x, start.time) %>% summary(times, extend = TRUE) @@ -269,10 +284,6 @@ ard_survival_survfit.data.frame <- function(x, y, # get requested estimates df_stat <- tidy_x %>% - # find max time - dplyr::group_by_at(., dplyr::vars(dplyr::any_of("strata"))) %>% - dplyr::mutate(time_max = max(.data$time)) %>% - dplyr::ungroup() %>% # add requested timepoints dplyr::full_join( tidy_x %>% @@ -292,13 +303,13 @@ ard_survival_survfit.data.frame <- function(x, y, df_stat <- df_stat %>% dplyr::arrange(.data$time) %>% - # if user-specified time is after max time, make estimate NA + # if summary.args$extend = FALSE and n.risk = 0, make estimate NA dplyr::mutate_at( - dplyr::vars("estimate", "conf.high", "conf.low"), - ~ ifelse(.data$time > .data$time_max, NA_real_, .) + dplyr::vars("estimate", "std.error", "conf.high", "conf.low"), + ~ ifelse(.data$n.risk == 0L & !summary.args$extend, NA_real_, .) ) %>% dplyr::mutate(context = type) %>% - dplyr::select(!dplyr::any_of(c("time_max", "col_name"))) + dplyr::select(!dplyr::any_of(c("col_name"))) # convert estimates to requested type if (type != "survival") { diff --git a/man/ard_survival_survfit.Rd b/man/ard_survival_survfit.Rd index 5421cc91d..ec7f35c45 100644 --- a/man/ard_survival_survfit.Rd +++ b/man/ard_survival_survfit.Rd @@ -8,7 +8,14 @@ \usage{ ard_survival_survfit(x, ...) -\method{ard_survival_survfit}{survfit}(x, times = NULL, probs = NULL, type = NULL, ...) +\method{ard_survival_survfit}{survfit}( + x, + times = NULL, + probs = NULL, + type = NULL, + summary.args = list(extend = TRUE), + ... +) \method{ard_survival_survfit}{data.frame}( x, @@ -43,6 +50,11 @@ Must be one of the following:\tabular{ll}{ \code{"cumhaz"} \tab \code{-log(x)} \cr }} +\item{summary.args}{(named \code{list})\cr +named list of arguments to modify the output of \code{\link[survival:summary.survfit]{survival::summary.survfit()}}. Default is +\code{list(extend = TRUE)}, which reports estimates even when no subjects are at risk. If set to +\code{list(extend = FALSE)}, those estimates are set to NA.} + \item{y}{(\code{Surv} or \code{string})\cr an object of class \code{Surv} created using \code{\link[survival:Surv]{survival::Surv()}}. This object will be passed as the left-hand side of the formula constructed and passed to \code{\link[survival:survfit]{survival::survfit()}}. This object can also be passed as a string.} diff --git a/man/dot-process_survfit_time.Rd b/man/dot-process_survfit_time.Rd index ea5009b17..f7fd4e27d 100644 --- a/man/dot-process_survfit_time.Rd +++ b/man/dot-process_survfit_time.Rd @@ -4,7 +4,7 @@ \alias{.process_survfit_time} \title{Process Survival Fit For Time Estimates} \usage{ -.process_survfit_time(x, times, type, start.time = NULL) +.process_survfit_time(x, times, type, summary.args, start.time = NULL) } \arguments{ \item{x}{(\code{survfit} or \code{data.frame})\cr @@ -23,6 +23,11 @@ Must be one of the following:\tabular{ll}{ \code{"cumhaz"} \tab \code{-log(x)} \cr }} +\item{summary.args}{(named \code{list})\cr +named list of arguments to modify the output of \code{\link[survival:summary.survfit]{survival::summary.survfit()}}. Default is +\code{list(extend = TRUE)}, which reports estimates even when no subjects are at risk. If set to +\code{list(extend = FALSE)}, those estimates are set to NA.} + \item{start.time}{(\code{numeric})\cr default starting time. See \code{\link[survival:survfit0]{survival::survfit0()}} for more details.} } @@ -35,7 +40,13 @@ Process Survival Fit For Time Estimates \examples{ \dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("survival", "broom")))) withAutoprint(\{ # examplesIf} survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> - cardx:::.process_survfit_time(times = c(60, 180), type = "risk") + cardx:::.process_survfit_time(times = c(60, 180), type = "risk", + summary.args = list(extend = TRUE)) + +# don't evaluate values beyond last timepoint +survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> + cardx:::.process_survfit_time(times = c(60, 200), type = "risk", + summary.args = list(extend = FALSE)) \dontshow{\}) # examplesIf} } \keyword{internal} diff --git a/tests/testthat/_snaps/ard_survival_survfit.md b/tests/testthat/_snaps/ard_survival_survfit.md index a1cea1115..aa8614175 100644 --- a/tests/testthat/_snaps/ard_survival_survfit.md +++ b/tests/testthat/_snaps/ard_survival_survfit.md @@ -320,6 +320,15 @@ Error in `ard_survival_survfit()`: ! One and only one of `times` and `probs` must be specified. +--- + + Code + ard_survival_survfit(survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, + cards::ADTTE), times = 100, summary.args = list(extend = "notatype")) + Condition + Error in `ard_survival_survfit()`: + ! The `summary.args$extend` argument must be a scalar with class , not a string. + --- Code @@ -398,6 +407,62 @@ Message i 4 more variables: context, fmt_fun, warning, error +--- + + Code + print(ard_survival_survfit(survival::survfit(survival::Surv(AVAL, 1 - CNSR) ~ TRTA, cards::ADTTE), times = 200), n = Inf) + Message + {cards} data frame: 17 x 11 + Output + group1 group1_level variable variable_level stat_name stat_label stat + 1 TRTA Placebo time 200 n.risk Number o… 0 + 2 TRTA Placebo time 200 estimate Survival… 0.626 + 3 TRTA Placebo time 200 std.error Standard… 0.056 + 4 TRTA Placebo time 200 conf.high CI Upper… 0.746 + 5 TRTA Placebo time 200 conf.low CI Lower… 0.526 + 6 TRTA Xanomeli… time 200 n.risk Number o… 0 + 7 TRTA Xanomeli… time 200 estimate Survival… 0.092 + 8 TRTA Xanomeli… time 200 std.error Standard… 0.041 + 9 TRTA Xanomeli… time 200 conf.high CI Upper… 0.221 + 10 TRTA Xanomeli… time 200 conf.low CI Lower… 0.038 + 11 TRTA Xanomeli… time 200 n.risk Number o… 0 + 12 TRTA Xanomeli… time 200 estimate Survival… 0.126 + 13 TRTA Xanomeli… time 200 std.error Standard… 0.044 + 14 TRTA Xanomeli… time 200 conf.high CI Upper… 0.249 + 15 TRTA Xanomeli… time 200 conf.low CI Lower… 0.064 + 16 NA ..ard_survival_survfit.. conf.level CI Confi… 0.95 + 17 NA ..ard_survival_survfit.. conf.type CI Type log + Message + i 4 more variables: context, fmt_fun, warning, error + +--- + + Code + print(ard_survival_survfit(survival::survfit(survival::Surv(AVAL, 1 - CNSR) ~ TRTA, cards::ADTTE), times = 200, summary.args = list(extend = FALSE)), n = Inf) + Message + {cards} data frame: 17 x 11 + Output + group1 group1_level variable variable_level stat_name stat_label stat + 1 TRTA Placebo time 200 n.risk Number o… 0 + 2 TRTA Placebo time 200 estimate Survival… NA + 3 TRTA Placebo time 200 std.error Standard… NA + 4 TRTA Placebo time 200 conf.high CI Upper… NA + 5 TRTA Placebo time 200 conf.low CI Lower… NA + 6 TRTA Xanomeli… time 200 n.risk Number o… 0 + 7 TRTA Xanomeli… time 200 estimate Survival… NA + 8 TRTA Xanomeli… time 200 std.error Standard… NA + 9 TRTA Xanomeli… time 200 conf.high CI Upper… NA + 10 TRTA Xanomeli… time 200 conf.low CI Lower… NA + 11 TRTA Xanomeli… time 200 n.risk Number o… 0 + 12 TRTA Xanomeli… time 200 estimate Survival… NA + 13 TRTA Xanomeli… time 200 std.error Standard… NA + 14 TRTA Xanomeli… time 200 conf.high CI Upper… NA + 15 TRTA Xanomeli… time 200 conf.low CI Lower… NA + 16 NA ..ard_survival_survfit.. conf.level CI Confi… 0.95 + 17 NA ..ard_survival_survfit.. conf.type CI Type log + Message + i 4 more variables: context, fmt_fun, warning, error + # ard_survival_survfit.data.frame() works as expected Code diff --git a/tests/testthat/test-ard_survival_survfit.R b/tests/testthat/test-ard_survival_survfit.R index c646fba52..9b431eacd 100644 --- a/tests/testthat/test-ard_survival_survfit.R +++ b/tests/testthat/test-ard_survival_survfit.R @@ -153,6 +153,13 @@ test_that("ard_survival_survfit() errors are properly handled", { error = TRUE ) + expect_snapshot( + survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> + ard_survival_survfit(times = 100, summary.args = list(extend = "notatype")), + error = TRUE + ) + + expect_snapshot( ard_survival_survfit( x = cards::ADTTE, @@ -226,6 +233,19 @@ test_that("ard_survival_survfit() extends to times outside range", { ard_survival_survfit(times = 200) |> print(n = Inf) ) + + expect_snapshot( + survival::survfit(survival::Surv(AVAL, 1-CNSR) ~ TRTA, cards::ADTTE) |> + ard_survival_survfit(times = 200) |> + print(n = Inf) + ) + + expect_snapshot( + survival::survfit(survival::Surv(AVAL, 1-CNSR) ~ TRTA, cards::ADTTE) |> + ard_survival_survfit(times = 200, summary.args = list(extend = FALSE)) |> + print(n = Inf) + ) + }) test_that("ard_survival_survfit.data.frame() works as expected", { From 8eeb42024645e81e65209d711e6840f042b6bb20 Mon Sep 17 00:00:00 2001 From: anikoszabo Date: Sun, 15 Mar 2026 12:53:21 -0500 Subject: [PATCH 2/3] Apply correct styling --- R/ard_survival_survfit.R | 14 +++++++++----- tests/testthat/test-ard_survival_survfit.R | 5 ++--- 2 files changed, 11 insertions(+), 8 deletions(-) diff --git a/R/ard_survival_survfit.R b/R/ard_survival_survfit.R index b0e33ba06..7f33fd323 100644 --- a/R/ard_survival_survfit.R +++ b/R/ard_survival_survfit.R @@ -112,7 +112,7 @@ ard_survival_survfit <- function(x, ...) { #' @rdname ard_survival_survfit #' @export ard_survival_survfit.survfit <- function(x, times = NULL, probs = NULL, type = NULL, - summary.args = list(extend = TRUE), ...) { + summary.args = list(extend = TRUE), ...) { set_cli_abort_call() # check installed packages --------------------------------------------------- @@ -232,13 +232,17 @@ ard_survival_survfit.data.frame <- function(x, y, #' #' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("survival", "broom"))) #' survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> -#' cardx:::.process_survfit_time(times = c(60, 180), type = "risk", -#' summary.args = list(extend = TRUE)) +#' cardx:::.process_survfit_time( +#' times = c(60, 180), type = "risk", +#' summary.args = list(extend = TRUE) +#' ) #' #' # don't evaluate values beyond last timepoint #' survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> -#' cardx:::.process_survfit_time(times = c(60, 200), type = "risk", -#' summary.args = list(extend = FALSE)) +#' cardx:::.process_survfit_time( +#' times = c(60, 200), type = "risk", +#' summary.args = list(extend = FALSE) +#' ) #' #' @keywords internal .process_survfit_time <- function(x, times, type, summary.args, start.time = NULL) { diff --git a/tests/testthat/test-ard_survival_survfit.R b/tests/testthat/test-ard_survival_survfit.R index 9b431eacd..7ebab828b 100644 --- a/tests/testthat/test-ard_survival_survfit.R +++ b/tests/testthat/test-ard_survival_survfit.R @@ -235,17 +235,16 @@ test_that("ard_survival_survfit() extends to times outside range", { ) expect_snapshot( - survival::survfit(survival::Surv(AVAL, 1-CNSR) ~ TRTA, cards::ADTTE) |> + survival::survfit(survival::Surv(AVAL, 1 - CNSR) ~ TRTA, cards::ADTTE) |> ard_survival_survfit(times = 200) |> print(n = Inf) ) expect_snapshot( - survival::survfit(survival::Surv(AVAL, 1-CNSR) ~ TRTA, cards::ADTTE) |> + survival::survfit(survival::Surv(AVAL, 1 - CNSR) ~ TRTA, cards::ADTTE) |> ard_survival_survfit(times = 200, summary.args = list(extend = FALSE)) |> print(n = Inf) ) - }) test_that("ard_survival_survfit.data.frame() works as expected", { From 4434468d15c24c213ba2a51233a58a9ae1f932ed Mon Sep 17 00:00:00 2001 From: anikoszabo Date: Sun, 15 Mar 2026 12:53:21 -0500 Subject: [PATCH 3/3] Apply correct styling --- R/ard_survival_survfit.R | 14 +++++++++----- man/dot-process_survfit_time.Rd | 12 ++++++++---- tests/testthat/test-ard_survival_survfit.R | 5 ++--- 3 files changed, 19 insertions(+), 12 deletions(-) diff --git a/R/ard_survival_survfit.R b/R/ard_survival_survfit.R index b0e33ba06..7f33fd323 100644 --- a/R/ard_survival_survfit.R +++ b/R/ard_survival_survfit.R @@ -112,7 +112,7 @@ ard_survival_survfit <- function(x, ...) { #' @rdname ard_survival_survfit #' @export ard_survival_survfit.survfit <- function(x, times = NULL, probs = NULL, type = NULL, - summary.args = list(extend = TRUE), ...) { + summary.args = list(extend = TRUE), ...) { set_cli_abort_call() # check installed packages --------------------------------------------------- @@ -232,13 +232,17 @@ ard_survival_survfit.data.frame <- function(x, y, #' #' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("survival", "broom"))) #' survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> -#' cardx:::.process_survfit_time(times = c(60, 180), type = "risk", -#' summary.args = list(extend = TRUE)) +#' cardx:::.process_survfit_time( +#' times = c(60, 180), type = "risk", +#' summary.args = list(extend = TRUE) +#' ) #' #' # don't evaluate values beyond last timepoint #' survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> -#' cardx:::.process_survfit_time(times = c(60, 200), type = "risk", -#' summary.args = list(extend = FALSE)) +#' cardx:::.process_survfit_time( +#' times = c(60, 200), type = "risk", +#' summary.args = list(extend = FALSE) +#' ) #' #' @keywords internal .process_survfit_time <- function(x, times, type, summary.args, start.time = NULL) { diff --git a/man/dot-process_survfit_time.Rd b/man/dot-process_survfit_time.Rd index f7fd4e27d..d88c26102 100644 --- a/man/dot-process_survfit_time.Rd +++ b/man/dot-process_survfit_time.Rd @@ -40,13 +40,17 @@ Process Survival Fit For Time Estimates \examples{ \dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("survival", "broom")))) withAutoprint(\{ # examplesIf} survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> - cardx:::.process_survfit_time(times = c(60, 180), type = "risk", - summary.args = list(extend = TRUE)) + cardx:::.process_survfit_time( + times = c(60, 180), type = "risk", + summary.args = list(extend = TRUE) + ) # don't evaluate values beyond last timepoint survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> - cardx:::.process_survfit_time(times = c(60, 200), type = "risk", - summary.args = list(extend = FALSE)) + cardx:::.process_survfit_time( + times = c(60, 200), type = "risk", + summary.args = list(extend = FALSE) + ) \dontshow{\}) # examplesIf} } \keyword{internal} diff --git a/tests/testthat/test-ard_survival_survfit.R b/tests/testthat/test-ard_survival_survfit.R index 9b431eacd..7ebab828b 100644 --- a/tests/testthat/test-ard_survival_survfit.R +++ b/tests/testthat/test-ard_survival_survfit.R @@ -235,17 +235,16 @@ test_that("ard_survival_survfit() extends to times outside range", { ) expect_snapshot( - survival::survfit(survival::Surv(AVAL, 1-CNSR) ~ TRTA, cards::ADTTE) |> + survival::survfit(survival::Surv(AVAL, 1 - CNSR) ~ TRTA, cards::ADTTE) |> ard_survival_survfit(times = 200) |> print(n = Inf) ) expect_snapshot( - survival::survfit(survival::Surv(AVAL, 1-CNSR) ~ TRTA, cards::ADTTE) |> + survival::survfit(survival::Surv(AVAL, 1 - CNSR) ~ TRTA, cards::ADTTE) |> ard_survival_survfit(times = 200, summary.args = list(extend = FALSE)) |> print(n = Inf) ) - }) test_that("ard_survival_survfit.data.frame() works as expected", {