Add unit tests for extrapolation-factor and fix existing visual tests

Author: Sakuski

R/ppc-censoring.R

@@ -204,7 +204,8 @@ ppc_km_overlay_grouped <- function(
   status_y,
   left_truncation_y = NULL,
   size = 0.25,
-  alpha = 0.7
+  alpha = 0.7,
+  extrapolation_factor = 1.2
 ) {
   check_ignored_arguments(...)
 
@@ -216,7 +217,8 @@ ppc_km_overlay_grouped <- function(
     status_y = status_y,
     left_truncation_y = left_truncation_y,
     size = size,
-    alpha = alpha
+    alpha = alpha,
+    extrapolation_factor = extrapolation_factor
   )
 
   p_overlay +

tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-default-2.svg

@@ -5,7 +5,8 @@ source(test_path("data-for-ppc-tests.R"))
 
 test_that("ppc_km_overlay returns a ggplot object", {
   skip_if_not_installed("ggfortify")
-  expect_gg(ppc_km_overlay(y, yrep, status_y = status_y, left_truncation_y = left_truncation_y, size = 0.5, alpha = 0.2))
+  expect_gg(ppc_km_overlay(y, yrep, status_y = status_y, left_truncation_y = left_truncation_y, size = 0.5, alpha = 0.2, extrapolation_factor = Inf))
+  expect_gg(ppc_km_overlay(y, yrep, status_y = status_y, left_truncation_y = left_truncation_y, size = 0.5, alpha = 0.2, extrapolation_factor = 1))
   expect_gg(ppc_km_overlay(y2, yrep2, status_y = status_y2))
 })
 
@@ -60,6 +61,14 @@ test_that("ppc_km_overlay errors if bad left_truncation_y value", {
   )
 })
 
+test_that("ppc_km_overlay errors if bad extrapolation_factor value", {
+  skip_if_not_installed("ggfortify")
+  expect_error(
+    ppc_km_overlay(y, yrep, status_y = status_y, extrapolation_factor = 0.99),
+    "`extrapolation_factor` must be greater than or equal to 1."
+  )
+})
+
 # Visual tests -----------------------------------------------------------------
 
 test_that("ppc_km_overlay renders correctly", {