Honoring start.time specifications (#197)

* updates

* Update test-tidy_survfit.R

* test updates

* Update test-add_risktable.R

* removing base R pipe

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: ggsurvfit
 Title: Flexible Time-to-Event Figures
-Version: 1.0.0.9000
+Version: 1.0.0.9001
 Authors@R: c(
     person("Daniel D.", "Sjoberg", , "[email protected]", role = c("aut", "cre", "cph"),
            comment = c(ORCID = "0000-0003-0862-2018")),

NEWS.md

@@ -2,6 +2,10 @@
 
 * Updated legend position syntax to account for changes in ggplot v3.5.0.
 
+* The `tidy_survfit()` (and subsequently `ggsurvfit()`) now honor the `survfit(start.time)` if specified. (#192)
+
+* We now allow for negative follow-up times in `tidy_survfit()` (and subsequently `ggsurvfit()`). When negative follow-up times are present users should specify `survfit(start.time)` and we print a note to this effect when not set. (#192) 
+
 # ggsurvfit 1.0.0
 
 * By default, a model plot created with `ggsurvfit()` or `ggcuminc()` uses the color aesthetic to plot curves by the stratifying variable(s), and further, `ggcuminc()` uses the linetype aesthetic for plots that contain multiple outcomes (i.e. competing events). We now introduce the global option `"ggsurvfit.switch-color-linetype"` to switch these defaults, giving users more flexibility over the output figures. Furthermore, when the `linetype_aes=` argument is called in a situation when it does not apply, it will be silently ignored (previously, an error message _may_ have been thrown). (#166)

R/tidy_survfit.R

@@ -39,13 +39,17 @@ tidy_survfit <- function(x,
   }
   if (inherits(x, "survfitms")) type <- "cuminc"
   else if (is.character(type)) type <- match.arg(type)
-  if (!is.null(times) && any(times < 0)) {
-    cli_abort("The {.var times} cannot be negative.")
-  }
+
 
   # create base tidy tibble ----------------------------------------------------
+  if (is.null(x$start.time) && min(x$time) < 0) {
+    cli::cli_inform(c(
+      "!" ="Setting start time to {.val {min(x$time)}}.",
+      "i" = "Specify {.code ggsurvfit::survfit2(start.time)} to override this default."
+    ))
+  }
   df_tidy <-
-    survival::survfit0(x, start.time = 0) %>%
+    survival::survfit0(x) %>%
     broom::tidy()
 
   # if a competing risks model, filter on the outcome of interest

tests/testthat/_snaps/tidy_survfit.md

@@ -0,0 +1,8 @@
+# tidy_survfit() messaging
+
+    Code
+      survfit(Surv(time - 500, status) ~ 1, df_lung) %>% tidy_survfit() %>% invisible()
+    Message
+      ! Setting start time to -499.835728952772.
+      i Specify `ggsurvfit::survfit2(start.time)` to override this default.
+

tests/testthat/test-add_risktable.R

@@ -298,3 +298,25 @@ test_that("add_risktable() works with Cox models", {
   )
 })
 
+test_that("add_risktable() works with ggsurvfit() `start.time` and negative times", {
+  expect_error(
+    sf_negative_time <-
+      survfit(Surv(time - 10, status) ~ 1, df_lung, start.time = -10) %>%
+      ggsurvfit() +
+      add_risktable(),
+    NA
+  )
+
+  expect_error(
+    sf_start_time <-
+      survfit(Surv(time, status) ~ sex, df_lung, start.time = 10) %>%
+      ggsurvfit() +
+      add_risktable(),
+    NA
+  )
+
+  skip_on_ci()
+  vdiffr::expect_doppelganger("sf-negative_time", sf_negative_time)
+  vdiffr::expect_doppelganger("sf-start_time", sf_start_time)
+})
+

tests/testthat/test-tidy_survfit.R

@@ -84,7 +84,6 @@ test_that("tidy_survfit() works with survfit2()", {
 
 test_that("tidy_survfit() throws appropriate errors", {
   expect_error(tidy_survfit(mtcars))
-  expect_error(tidy_survfit(sf1, times = -5:5))
   expect_error(tidy_survfit(sf1, type = "not_a_type"))
 })
 
@@ -207,4 +206,17 @@ test_that("tidy_survfit() works with multi-state models", {
   )
 })
 
-
+test_that("tidy_survfit() messaging", {
+  # expect a message about the start time when there are negative times and no start.time
+  expect_snapshot(
+    survfit(Surv(time - 500, status) ~ 1, df_lung) %>%
+      tidy_survfit() %>%
+      invisible()
+  )
+  # no longer see message when start.time specified
+  expect_invisible(
+    survfit(Surv(time - 500, status) ~ 1, df_lung, start.time = -500) %>%
+      tidy_survfit() %>%
+      invisible()
+  )
+})