progress

R/ard_survival_survfit_diff.R

@@ -25,9 +25,10 @@ ard_survival_survfit_diff <- function(x, times, conf.level = 0.95) {
   check_not_missing(x)
   check_not_missing(times)
   check_class(x, "survfit")
-  if (inherits(x, "survfitms")) {
+
+  if (inherits(x, c("survfitms", "survfitcox"))) {
     cli::cli_abort(
-      "Argument {.arg x} cannot be class {.cls survfitms}.",
+      "Argument {.arg x} cannot be class {.cls {c('survfitms', 'survfitcox')}}.",
       call = get_cli_abort_call()
     )
   }
@@ -39,7 +40,7 @@ ard_survival_survfit_diff <- function(x, times, conf.level = 0.95) {
   )
   if (length(x$strata) < 2) {
     cli::cli_abort(
-      "The {.cls survift} object passed in argument {.arg x} must have more than 1 stratifying level.",
+      "The {.cls survift} object's stratifying variable must have 2 or more levels.",
       call = get_cli_abort_call()
     )
   }

tests/testthat/_snaps/ard_survival_survfit_diff.md

@@ -0,0 +1,27 @@
+# ard_survival_survfit_diff() messaging
+
+    Code
+      ard_survival_survfit_diff(survfit(Surv(AVAL, 1 - CNSR) ~ SEX + TRTA, cards::ADTTE),
+      times = c(25, 50))
+    Condition
+      Error in `ard_survival_survfit_diff()`:
+      ! The <survift> object passed in argument `x` must be stratified by a single variable.
+
+---
+
+    Code
+      ard_survival_survfit_diff(survfit(Surv(AVAL, 1 - CNSR) ~ constant, dplyr::mutate(
+        cards::ADTTE, constant = 1L)), times = c(25, 50))
+    Condition
+      Error in `ard_survival_survfit_diff()`:
+      ! The <survift> object's stratifying variable must have 2 or more levels.
+
+---
+
+    Code
+      ard_survival_survfit_diff(survfit(coxph(Surv(AVAL, CNSR) ~ SEX + strata(TRTA),
+      cards::ADTTE)), times = c(25, 50))
+    Condition
+      Error in `ard_survival_survfit_diff()`:
+      ! Argument `x` cannot be class <survfitms/survfitcox>.
+

tests/testthat/test-ard_survival_survfit_diff.R

@@ -0,0 +1,56 @@
+test_that("ard_survival_survfit_diff() works", {
+  withr::local_package("survival")
+  sf <- survfit(Surv(AVAL, 1- CNSR) ~ SEX, cards::ADTTE)
+  expect_silent(
+    ard1 <- ard_survival_survfit_diff(sf, times = c(25, 50))
+  )
+
+  # check the survival differences are accurate
+  expect_equal(
+    ard1 |>
+      dplyr::filter(variable_level == 25, stat_name == "estimate") |>
+      dplyr::pull(stat) |>
+      unlist(),
+    summary(sf, times = 25) |>
+      getElement("surv") |>
+      reduce(`-`)
+  )
+  expect_equal(
+    ard1 |>
+      dplyr::filter(variable_level == 50, stat_name == "estimate") |>
+      dplyr::pull(stat) |>
+      unlist(),
+    summary(sf, times = 50) |>
+      getElement("surv") |>
+      reduce(`-`)
+  )
+})
+
+test_that("ard_survival_survfit_diff() messaging", {
+  withr::local_package("survival")
+
+  # we can only do one stratifying variable at a time
+  expect_snapshot(
+    error = TRUE,
+    survfit(Surv(AVAL, 1- CNSR) ~ SEX + TRTA, cards::ADTTE) |>
+      ard_survival_survfit_diff(times = c(25, 50))
+  )
+
+  # the stratifying variable must have 2 or more levels
+  expect_snapshot(
+    error = TRUE,
+    survfit(
+      Surv(AVAL, 1- CNSR) ~ constant,
+      cards::ADTTE |> dplyr::mutate(constant = 1L)
+    ) |>
+      ard_survival_survfit_diff(times = c(25, 50))
+  )
+
+  # cannot pass a multi-state model or stratified Cox
+  expect_snapshot(
+    error = TRUE,
+    coxph(Surv(AVAL, CNSR) ~ SEX + strata(TRTA), cards::ADTTE) |>
+      survfit() |>
+      ard_survival_survfit_diff(times = c(25, 50))
+  )
+})