visr survfit check (#389)

R/get_pvalue.R

@@ -44,7 +44,7 @@ get_pvalue <- function(survfit_object,
                        statlist = c("test", "Chisq", "df", "pvalue"),
                        ...) {
 
-# Input validation --------------------------------------------------------
+  # Input validation --------------------------------------------------------
 
   if (!inherits(survfit_object, "survfit"))
     stop("The function expects an object of class `survfit` as input.")
@@ -58,7 +58,7 @@ get_pvalue <- function(survfit_object,
       !base::all(statlist %in% c("test", "df", "Chisq", "pvalue")))
     stop("Specify valid `statlist` arguments.")
 
-# Re-use Call from survival object ----------------------------------------
+  # Re-use Call from survival object ----------------------------------------
 
   Call <- as.list(rlang::quo_squash(survfit_object$call))
   NewCall <- append(as.list(parse(text = "survival::survdiff")), Call[names(Call) %in% names(formals(survival::survdiff))])
@@ -70,7 +70,7 @@ get_pvalue <- function(survfit_object,
     }
   }
 
-# Summary list ------------------------------------------------------------
+  # Summary list ------------------------------------------------------------
 
   survdifflist <- list(
     `Log-Rank`    = rlang::expr(eval(as.call(
@@ -87,11 +87,29 @@ get_pvalue <- function(survfit_object,
     )))
   )[ptype]
 
-
   survdifflist_eval <-
-    lapply(survdifflist, eval, envir = attr(survfit_object$call, ".Environment"))
-
-# Statlist ----------------------------------------------------------------
+    lapply(
+      survdifflist,
+      function(x) {
+        tryCatch(
+          eval(x, envir = attr(survfit_object$call, ".Environment")),
+          error = function(e) {
+            if (!is_visr_survfit(survfit_object)) {
+              stop("There was an error calculating the p-values.\n",
+                   "The 'survfit' object was not created with `visR::estimate_KM()`.\n",
+                   "The the error will likely be resolved by re-estimating the ",
+                   "'survfit' object with visR.\n",
+                   as.character(e), call. = FALSE)
+            }
+            else {
+              e
+            }
+          }
+        )
+      }
+    )
+
+  # Statlist ----------------------------------------------------------------
 
   statlist <- unique(statlist)
   statlist <- base::sub("test", "Equality across strata", statlist, fixed = TRUE)
@@ -121,7 +139,7 @@ get_pvalue <- function(survfit_object,
     ))
   )[statlist]
 
-# Output to dataframe -----------------------------------------------------
+  # Output to dataframe -----------------------------------------------------
 
   equality <- data.frame(
     lapply(stat_summary, eval, env = environment()),

R/utils_pipe.R

@@ -45,3 +45,12 @@ the_lhs <- function() {
     df <- as.character(sub("\\[.*$", "", deparse(call_list[["data"]]))[1])
   }
 }
+
+#' @title Is visR survfit?
+#'
+#' @return logical
+#' @noRd
+is_visr_survfit <- function(x) {
+  # the visr survift object saves a quosure instead of a call
+  inherits(x, "survfit") && rlang::is_quosure(x$call)
+}

tests/testthat/test-get_pvalue.R

@@ -31,6 +31,9 @@
 #' T4.6 The Chisq statistic has the same precision as the pvalue
 #' T5. Piped datasets still return accurate results
 #' T5.1 P-values are accurate when a filtered data frame is piped
+#' T6. Function works with `survival::survfit()` objects
+#' T6.1 Function works with `survival::survfit()` objects
+#' T6.2 Function messages users appropriately when data is piped, and p-value cannot be calculated
 
 # Requirement T1 ----------------------------------------------------------
 
@@ -243,4 +246,26 @@ testthat::test_that("T5.1 P-values are accurate when a filtered data frame is pi
   testthat::expect_equal(survfit_p, survdiff_p)
 })
 
+# Requirement T6 ---------------------------------------------------------------
+
+testthat::context("get_pvalue - T6. Function works with `survival::survfit()` objects")
+
+testthat::test_that("T6.1 Function works with `survival::survfit()` objects", {
+  expect_error(
+    survival::survfit(survival::Surv(time, status) ~ sex, data = survival::lung) %>%
+      get_pvalue(),
+    NA
+  )
+})
+
+testthat::test_that("T6.2 Function messages users appropriately when data is piped, and p-value cannot be calculated",{
+  expect_error(
+    lung %>%
+      survfit(Surv(time, status) ~ sex, data = .) %>%
+      get_pvalue(),
+    "*estimate_KM*" # error message includes reference to `estimate_KM()` function.
+  )
+})
+
+
 # END OF CODE -------------------------------------------------------------