Skip to content

Control handling of survfit prediction beyond last timepoint #332

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Draft
anikoszabo wants to merge 4 commits into
base: main
Choose a base branch
from
Draft

Control handling of survfit prediction beyond last timepoint #332

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
ea8aac5
More flexible handling of survfit prediction beyond max time
anikoszabo Mar 5, 2026
8eeb420
Apply correct styling
anikoszabo Mar 15, 2026
4434468
Apply correct styling
anikoszabo Mar 15, 2026
109d29f
Merge branch '224_noextend' of https://github.com/anikoszabo/cardx in…
anikoszabo Mar 19, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
39 changes: 27 additions & 12 deletions R/ard_survival_survfit.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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:
Expand Down Expand Up @@ -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 ---------------------------------------------------
Expand Down Expand Up @@ -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)
)

Expand Down Expand Up @@ -224,10 +232,20 @@ 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) {
Expand All @@ -239,6 +257,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)

Expand Down Expand Up @@ -269,10 +288,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 %>%
Expand All @@ -292,13 +307,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") {
Expand Down
14 changes: 13 additions & 1 deletion man/ard_survival_survfit.Rd
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

19 changes: 17 additions & 2 deletions man/dot-process_survfit_time.Rd
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

65 changes: 65 additions & 0 deletions tests/testthat/_snaps/ard_survival_survfit.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 <logical>, not a string.

---

Code
Expand Down Expand Up @@ -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> NA ..ard_survival_survfit.. conf.level CI Confi… 0.95
17 <NA> 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> NA ..ard_survival_survfit.. conf.level CI Confi… 0.95
17 <NA> 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
Expand Down
19 changes: 19 additions & 0 deletions tests/testthat/test-ard_survival_survfit.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down Expand Up @@ -226,6 +233,18 @@ 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", {
Expand Down
Loading