tests/testthat/test-add_quantile.R

In ggsurvfit: Flexible Time-to-Event Figures

sf1 <- survfit2(Surv(time, status) ~ 1, data = df_lung)
sf2 <- survfit2(Surv(time, status) ~ sex, data = df_lung)
sf3 <- survfit2(Surv(time, status) ~ sex + ph.ecog, data = df_lung)

test_that("add_quantile() works with ggsurvfit()", {
  expect_error(
    lst_survfit2_quantile <-
      list(sf1, sf2, sf3) %>%
      lapply(function(x) ggsurvfit(x) + add_quantile()),
    NA
  )

  expect_error(
    list(sf1, sf2, sf3) %>%
      lapply(function(x) (ggsurvfit(x) + add_quantile()) %>% print()),
    NA
  )

  expect_error(
    list(sf1, sf2, sf3) %>%
      lapply(function(x) (ggsurvfit(x, type = function(x) x) + add_quantile()) %>% print()),
    NA
  )

  expect_equal(
    sf1 %>%
      tidy_survfit() %>%
      dplyr::select(x = time, y = estimate) %>%
      .create_y_value_df(y_value = 0.5) %>%
      dplyr::pull(x) %>%
      `[`(1),
    quantile(sf1, probs = 0.5, conf.int = FALSE) %>% as.numeric()
  )

  expect_equal(
    sf2 %>%
      tidy_survfit() %>%
      dplyr::select(x = time, y = estimate, group = strata) %>%
      .create_y_value_df(y_value = 0.5) %>%
      dplyr::pull(x) %>%
      setdiff(0),
    quantile(sf2, probs = 0.5, conf.int = FALSE) %>% as.numeric()
  )

  # a single quantile line is shown, because only one group reached median survival
  sf2_colon <- survfit2(Surv(time, status) ~ surg, data = df_colon)
  expect_equal(
    sf2_colon %>%
      tidy_survfit() %>%
      dplyr::select(x = time, y = estimate, group = strata) %>%
      .create_y_value_df(y_value = 0.5) %>%
      dplyr::pull(x) %>%
      setdiff(0),
    quantile(sf2_colon, probs = 0.5, conf.int = FALSE) %>%
      as.numeric() %>%
      na.omit(),
    ignore_attr = TRUE
  )

  expect_error(
    `sf2_colon-quantile` <-
      sf2_colon %>%
      ggsurvfit() +
      add_quantile(),
    NA
  )

  expect_error(
    `sf2_colon-quantile-no-line` <-
      sf2_colon %>%
      ggsurvfit() +
      add_quantile(y_value = 0.2),
    NA
  )


  skip_on_ci()
  vdiffr::expect_doppelganger("sf1-quantile", lst_survfit2_quantile[[1]])
  vdiffr::expect_doppelganger("sf2-quantile", lst_survfit2_quantile[[2]])
  vdiffr::expect_doppelganger("sf3-quantile", lst_survfit2_quantile[[3]])


  vdiffr::expect_doppelganger("sf2_colon-quantile", `sf2_colon-quantile`)

  # no lines added, because 20% not reached
  vdiffr::expect_doppelganger("sf2_colon-quantile-no-line", `sf2_colon-quantile-no-line`)

  # testing that both increasing and decreasing function work
  vdiffr::expect_doppelganger(
    "sf-mtcars-decreasing",
    survfit2(Surv(mpg, am) ~ cyl, mtcars %>% dplyr::filter(cyl %in% c(4, 6))) %>%
      ggsurvfit() +
      add_quantile()
  )
  vdiffr::expect_doppelganger(
    "sf-mtcars-increasing",
    survfit2(Surv(mpg, am) ~ cyl, mtcars %>% dplyr::filter(cyl %in% c(4, 6))) %>%
      ggsurvfit(type = "risk") +
      add_quantile()
  )


  vdiffr::expect_doppelganger(
    "sf-mtcars-decreasing-many-quantiles",
    survfit2(Surv(mpg, am) ~ cyl, mtcars) %>%
      ggsurvfit() +
      add_quantile(y_value = 0.75, linetype = "dotted") +
      add_quantile(y_value = 0.25)
  )
  vdiffr::expect_doppelganger(
    "sf-mtcars-increasing-many-quantiles",
    survfit2(Surv(mpg, am) ~ cyl, mtcars) %>%
      ggsurvfit(type = "risk") +
      add_quantile(y_value = 0.75, linetype = "dotted") +
      add_quantile(y_value = 0.25)
  )

  vdiffr::expect_doppelganger(
    "sf-mtcars-timing",
    survfit2(Surv(mpg, am) ~ 1, mtcars %>% dplyr::filter(cyl == 4)) %>%
      ggsurvfit() +
      add_quantile(y_value = 0.75) + # previous obs is a censor
      add_quantile(y_value = 0.5) # previous obs is an event
  )
})

test_that("add_quantile() errors with ggsurvfit()", {
  expect_error(
    (mtcars %>%
       ggplot2::ggplot(ggplot2::aes(y = mpg, x = hp)) +
       add_quantile()) %>%
      print()
  )

  expect_error(
    (sf2 %>%
      ggsurvfit() +
      add_quantile(y_value = c(0.2, 0.5))) %>% print()
  )
})




cuminc1 <- tidycmprsk::cuminc(Surv(ttdeath, death_cr) ~ 1, data = tidycmprsk::trial)
cuminc2 <- tidycmprsk::cuminc(Surv(ttdeath, death_cr) ~ trt, data = tidycmprsk::trial)
cuminc3 <- tidycmprsk::cuminc(Surv(ttdeath, death_cr) ~ trt + grade, data = tidycmprsk::trial)


test_that("add_quantile() works with ggcuminc()", {
  expect_error(
    lst_cuminc_quantile <-
      list(cuminc1, cuminc2, cuminc3) %>%
      lapply(function(x) ggcuminc(x) + add_quantile(y_value = 0.2)),
    NA
  )

  # only check on mac
  skip_on_ci()
  vdiffr::expect_doppelganger("cuminc1-quantile", lst_cuminc_quantile[[1]])
  vdiffr::expect_doppelganger("cuminc2-quantile", lst_cuminc_quantile[[2]])
  vdiffr::expect_doppelganger("cuminc3-quantile", lst_cuminc_quantile[[3]])
})

test_that("add_quantile() works with ggcuminc() and multiple outcomes", {
  expect_error(
    lst_cuminc_quantile_outcomes <-
      list(cuminc1, cuminc2, cuminc3) %>%
      lapply(function(x) ggcuminc(x, outcome = c("death from cancer", "death other causes")) + add_quantile(y_value = 0.2)),
    NA
  )

  skip_on_ci()
  vdiffr::expect_doppelganger("cuminc1-quantile-all-outcomes", lst_cuminc_quantile_outcomes[[1]])
  vdiffr::expect_doppelganger("cuminc2-quantile-all-outcomes", lst_cuminc_quantile_outcomes[[2]])
  vdiffr::expect_doppelganger("cuminc3-quantile-all-outcomes", lst_cuminc_quantile_outcomes[[3]])
})

test_that("add_quantile() works x_value", {
  expect_error(
    ggquanitle_x_value1 <-
      survfit2(Surv(time, status) ~ sex, data = df_lung) %>%
      ggsurvfit() +
      add_quantile(linetype = 2, y_value = NULL, x_value = 10),
    NA
  )

  expect_error(
    ggquanitle_x_value2 <-
      survfit2(Surv(time, status) ~ sex, data = df_lung) %>%
      ggsurvfit() +
      add_quantile(linetype = 2, y_value = NULL, x_value = 10000),
    NA
  )

  expect_error(
    ggquanitle_x_value3 <-
      survfit2(Surv(time, status) ~ sex, data = df_lung) %>%
      ggsurvfit() +
      add_quantile(linetype = 2, y_value = NULL, x_value = 33),
    NA
  )

  skip_on_ci()
  vdiffr::expect_doppelganger("sf2-quantile-x_value", ggquanitle_x_value1)
  vdiffr::expect_doppelganger("sf2-quantile-x_value-out-of-bounds", ggquanitle_x_value2)
  vdiffr::expect_doppelganger("sf2-quantile-x_value-not-all-groups", ggquanitle_x_value3)
})