Add tests for ppc_km_overlay() with left-truncation

Author: Sakuski

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

@@ -3,6 +3,7 @@ y <- rnorm(100)
 yrep <- matrix(rnorm(2500), ncol = 100)
 group <- gl(4, 25, labels = LETTERS[1:4])
 status_y <- rep_len(0:1, length.out = length(y))
+left_truncation_y <- y - 10
 
 y2 <- rpois(30, 1)
 yrep2 <- matrix(rpois(30, 1), ncol = 30)
@@ -22,6 +23,22 @@ vdiff_yrep2 <- matrix(rpois(30 * 10, 1), ncol = 30, nrow = 10)
 vdiff_group2 <- rep_len(c(1,2), length.out = 30)
 vdiff_status_y2 <- rep_len(0:1, length.out = length(vdiff_y2))
 
+vdiff_y3 <- rexp(50, rate = 0.2)
+vdiff_status_y3 <- rep_len(0:1, length.out = length(vdiff_y3))
+vdiff_group3 <- rep_len(c(1,2), length.out = 50)
+vdiff_left_truncation_y3 <- runif(length(vdiff_y3), min = 0, max = 0.6) * vdiff_y3
+
+simulate_truncated_exp <- function(n, rate, trunc_point) {
+  u <- runif(n)
+  return(trunc_point - log(u) / rate)
+}
+
+rate <- 0.2
+vdiff_yrep3 <- matrix(NA, nrow = 10, ncol = 50)
+for (i in 1:50) {
+  vdiff_yrep3[, i] <- simulate_truncated_exp(10, rate, vdiff_left_truncation_y3[i])
+}
+
 vdiff_loo_y <- rnorm(100, 30, 5)
 vdiff_loo_yrep <- matrix(rnorm(100 * 400, 30, 5), nrow = 400)
 vdiff_loo_lw <- vdiff_loo_yrep

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

@@ -5,18 +5,24 @@ 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, 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))
   expect_gg(ppc_km_overlay(y2, yrep2, status_y = status_y2))
 })
 
 test_that("ppc_km_overlay_grouped returns a ggplot object", {
   skip_if_not_installed("ggfortify")
   expect_gg(ppc_km_overlay_grouped(y, yrep, group,
-                                   status_y = status_y))
+                                   status_y = status_y,
+                                   left_truncation_y = left_truncation_y,
+                                   size = 0.5, alpha = 0.2))
   expect_gg(ppc_km_overlay_grouped(y, yrep, as.numeric(group),
-                                   status_y = status_y))
+                                   status_y = status_y,
+                                   left_truncation_y = left_truncation_y,
+                                   size = 0.5, alpha = 0.2))
   expect_gg(ppc_km_overlay_grouped(y, yrep, as.integer(group),
-                                   status_y = status_y))
+                                   status_y = status_y,
+                                   left_truncation_y = left_truncation_y,
+                                   size = 0.5, alpha = 0.2))
 
   expect_gg(ppc_km_overlay_grouped(y2, yrep2, group2,
                                    status_y = status_y2))
@@ -44,6 +50,17 @@ test_that("ppc_km_overlay renders correctly", {
     size = 2,
     alpha = .2)
   vdiffr::expect_doppelganger("ppc_km_overlay (size, alpha)", p_custom)
+
+  p_base2 <- ppc_km_overlay(vdiff_y3, vdiff_yrep3, status_y = vdiff_status_y3)
+  vdiffr::expect_doppelganger("ppc_km_overlay (default 2)", p_base2)
+
+  p_custom2 <- ppc_km_overlay(
+    vdiff_y3,
+    vdiff_yrep3,
+    status_y = vdiff_status_y3,
+    left_truncation_y = vdiff_left_truncation_y3)
+  vdiffr::expect_doppelganger("ppc_km_overlay (left_truncation_y)",
+                              p_custom2)
 })
 
 test_that("ppc_km_overlay_grouped renders correctly", {
@@ -69,4 +86,21 @@ test_that("ppc_km_overlay_grouped renders correctly", {
     "ppc_km_overlay_grouped (size, alpha)",
     p_custom
   )
+
+  p_base2 <- ppc_km_overlay_grouped(vdiff_y3, vdiff_yrep3, vdiff_group3,
+                                   status_y = vdiff_status_y3)
+  vdiffr::expect_doppelganger("ppc_km_overlay_grouped (default 2)", p_base2)
+
+  p_custom2 <- ppc_km_overlay_grouped(
+    vdiff_y3,
+    vdiff_yrep3,
+    vdiff_group3,
+    status_y = vdiff_status_y3,
+    left_truncation_y = vdiff_left_truncation_y3
+  )
+
+  vdiffr::expect_doppelganger(
+    "ppc_km_overlay_grouped (left_truncation_y)",
+    p_custom2
+  )
 })