Truncate PMFs longer than the data

To the length of the data and throw a warning rather than an error.
This change allows us to run on old right-truncation estimates.

R/fit_model.R

@@ -160,15 +160,24 @@ format_right_truncation <- function(pmf, data) {
     # silently removed if length of the PMF was longer than the data,
     # effectively eliminating the right-truncation correction
 
-    cli::cli_abort(
+    trunc_idx <- nrow(data) - 1
+    cli::cli_warn(
       c(
+        "Removing right-truncation PMF elements after {.val {trunc_idx}}",
         "Right truncation PMF longer than the data",
         "PMF length: {.val {length(pmf)}}",
         "Data length: {.val {nrow(data)}}",
-        "PMF can only be up to length as the data"
+        "PMF can only be up to the length of the data"
       ),
       class = "right_trunc_too_long"
     )
+    suppressWarnings({
+      EpiNow2::trunc_opts(
+        dist = EpiNow2::dist_spec(
+          pmf = pmf[seq_len(trunc_idx)]
+        )
+      )
+    })
   } else {
     suppressWarnings({
       EpiNow2::trunc_opts(

tests/testthat/_snaps/fit_model.md

@@ -0,0 +1,8 @@
+# Right truncation longer than data throws error
+
+    Removing right-truncation PMF elements after 1
+    Right truncation PMF longer than the data
+    PMF length: 3
+    Data length: 2
+    PMF can only be up to the length of the data
+

tests/testthat/test-fit_model.R

@@ -178,12 +178,11 @@ test_that("Right truncation longer than data throws error", {
   data <- data.frame(x = c(1, 2))
   right_truncation_pmf <- c(0.1, 0.2, 0.7)
 
-  expect_error(
+  expect_snapshot_warning(
     format_right_truncation(
       right_truncation_pmf,
       data
-    ),
-    class = "right_trunc_too_long"
+    )
   )
 })