Improve add_pvalue() messaging

Author: ddsjoberg

NEWS.md

@@ -2,6 +2,8 @@
 
 * Updates to account for changes in ggplot2 v4.0.0. (#241)
 
+* Improved messaging when users pass competing risks models to `add_pvalue()` when more than one outcome is on display.
+
 * Added an example to the gallery for combining multiple survival endpoints. (#212)
 
 * Fixed confidence interval labels being incorrectly swapped for multi-state models in `tidy_survfit()`. Multi-state models now preserve the correct ordering of `conf.low` and `conf.high` from the underlying `broom::tidy()` output. (#215)

R/add_pvalue.R

@@ -78,7 +78,6 @@ update_add_pvalue <- function(p, add_pvalue_empty_list) {
     cli_abort(c("!" = "The {.code add_pvalue(prepend_p=)} argument must be a logical."))
   }
 
-
   # extract survfit object
   build <- suppressWarnings(ggplot2::ggplot_build(p))
   survfit <- build$plot[["data"]][["survfit"]][[1]]
@@ -98,6 +97,23 @@ update_add_pvalue <- function(p, add_pvalue_empty_list) {
     return(p)
   }
 
+  # check only a single outcome is selected
+  if (inherits(survfit, "tidycuminc")) {
+    outcomes_chosen <- suppressWarnings(ggplot2::ggplot_build(p))$plot$data$outcome |> unique()
+    outcomes_all <- tidycmprsk::tidy(survfit) |>
+      dplyr::pull("outcome") |>
+      unique()
+    outcomes_chosen_position <- which(outcomes_all %in% outcomes_chosen)
+    if (length(outcomes_chosen) > 1L) {
+      cli_abort(
+        c("{.fun add_pvalue} supports reporting a single competing event
+                p-value and the plot contains {.val {outcomes_chosen}}.",
+          i = "To place more than one p-value, calculate the p-values with {.code tidycmprsk::tidy},
+               and insert them into the plot using {.pkg ggplot2} functions.")
+      )
+    }
+  }
+
   # calculate p-value
   if (inherits(survfit, "survfit2")) {
     p.value <- survfit2_p(survfit,
@@ -108,7 +124,7 @@ update_add_pvalue <- function(p, add_pvalue_empty_list) {
   else if (inherits(survfit, "tidycuminc")) {
     p.value <-
       tidycmprsk::glance(survfit) %>%
-      dplyr::pull("p.value_1") %>%
+      dplyr::pull(paste0("p.value_", outcomes_chosen_position)) %>%
       pvalue_fun() %>%
       {dplyr::case_when(
         !prepend_p ~ .,

R/survfit2_p.R

@@ -38,6 +38,9 @@ survfit2_p <- function(x, pvalue_fun = format_p, prepend_p = TRUE, rho = 0) {
         "i" = "Create a {.cls survfit2} object with {.code survfit2()}.")
     )
   }
+  if (inherits(x, "survfitms")) {
+    cli_abort("The {.fun survfit2_p} does not support multi-state models.")
+  }
 
   survival::survdiff(
     formula = .extract_formula_from_survfit(x),

tests/testthat/_snaps/add_pvalue.md

@@ -0,0 +1,10 @@
+# add_pvalue() throws proper errors
+
+    Code
+      tidycmprsk::cuminc(Surv(ttdeath, death_cr) ~ trt, tidycmprsk::trial) %>%
+        ggcuminc(outcome = c("death other causes", "death from cancer")) + add_pvalue()
+    Condition
+      Error in `update_add_pvalue()`:
+      ! `add_pvalue()` supports reporting a single competing event p-value and the plot contains "death from cancer" and "death other causes".
+      i To place more than one p-value, calculate the p-values with `tidycmprsk::tidy`, and insert them into the plot using ggplot2 functions.
+

tests/testthat/_snaps/survfit2_p.md

@@ -0,0 +1,11 @@
+# survfit2_p() throws error
+
+    Code
+      survfit2(Surv(ttdeath, death_cr) ~ trt, tidycmprsk::trial) %>% ggcuminc() +
+        add_pvalue()
+    Message
+      Plotting outcome "death from cancer".
+    Condition
+      Error in `survfit2_p()`:
+      ! The `survfit2_p()` does not support multi-state models.
+

tests/testthat/test-add_pvalue.R

@@ -92,4 +92,11 @@ test_that("add_pvalue() throws proper errors", {
       add_pvalue(prepend_p = letters)) %>%
       ggsurvfit_build()
   )
+
+  expect_snapshot(
+    error = TRUE,
+    tidycmprsk::cuminc(Surv(ttdeath, death_cr) ~ trt, tidycmprsk::trial) %>%
+      ggcuminc(outcome = c("death other causes", "death from cancer")) +
+      add_pvalue()
+  )
 })

tests/testthat/test-survfit2_p.R

@@ -30,4 +30,11 @@ test_that("survfit2_p() works", {
 
 test_that("survfit2_p() throws error", {
   expect_error(survfit2_p(mtcars))
+
+  expect_snapshot(
+    error = TRUE,
+    survfit2(Surv(ttdeath, death_cr) ~ trt, tidycmprsk::trial) %>%
+      ggcuminc() +
+      add_pvalue()
+  )
 })