From 48704fc432cc1a344946bbe9dc2af38d80d87790 Mon Sep 17 00:00:00 2001
From: Sam <s.e.abbott12@gmail.com>
Date: Tue, 8 Oct 2024 18:37:15 +0100
Subject: [PATCH] fall back to the numerical solution when pwindow is large

---
 R/primary_censored_dist.R                   | 17 +++++++++++++++--
 tests/testthat/test-primary_censored_dist.R |  4 ++--
 2 files changed, 17 insertions(+), 4 deletions(-)

diff --git a/R/primary_censored_dist.R b/R/primary_censored_dist.R
index 0a1b43d..b088895 100644
--- a/R/primary_censored_dist.R
+++ b/R/primary_censored_dist.R
@@ -263,6 +263,12 @@ primary_censored_cdf.pcens_pweibull_dunif <- function(
     )
   }
 
+  if (pwindow > 3) {
+    return(
+      primary_censored_cdf.default(object, q, pwindow, use_numeric)
+    )
+  }
+
   # Extract Weibull distribution parameters
   shape <- object$args$shape
   scale <- object$args$scale
@@ -284,9 +290,16 @@ primary_censored_cdf.pcens_pweibull_dunif <- function(
   g <- function(t) {
     # Use the lower incomplete gamma function
     scaled_t <- (t * inv_scale)^shape
-    vapply(scaled_t, function(x) {
-      pracma::gammainc(x, 1 + inv_shape)["lowinc"]
+    g_out <- vapply(scaled_t, function(x) {
+      a <- 1 + inv_shape
+      if (abs(-x + a * log(x)) > 700 || abs(a) > 170) {
+        return(0)
+      } else {
+        result <- pracma::gammainc(x, a)["lowinc"]
+      }
+      return(result)
     }, numeric(1))
+    return(g_out)
   }
 
   # Adjust q so that we have [q-pwindow, q]
diff --git a/tests/testthat/test-primary_censored_dist.R b/tests/testthat/test-primary_censored_dist.R
index 7f022f1..8fcdb0e 100644
--- a/tests/testthat/test-primary_censored_dist.R
+++ b/tests/testthat/test-primary_censored_dist.R
@@ -257,9 +257,9 @@ test_that(
     dprimary_name <- "dunif"
     dprimary <- dunif
 
-    shapes <- c(0.5, 1, 2, 3)
+    shapes <- c(0.5, 1, 2)
     scales <- c(0.5, 1, 2)
-    pwindows <- c(1, 2, 5)
+    pwindows <- c(1, 2, 3, 4, 5)
 
     for (shape in shapes) {
       for (scale in scales) {