From 462780d2485cd40eff497cbc95b28523c43983db Mon Sep 17 00:00:00 2001
From: Sam <s.e.abbott12@gmail.com>
Date: Tue, 8 Oct 2024 11:56:21 +0100
Subject: [PATCH] keep testing we expect to be numeric numeric

---
 R/primary_censored_dist.R                     | 9 ++++-----
 tests/testthat/test-primary_censored_dist.R   | 2 +-
 tests/testthat/test-rpd-primarycensoreddist.R | 6 ++++++
 3 files changed, 11 insertions(+), 6 deletions(-)

diff --git a/R/primary_censored_dist.R b/R/primary_censored_dist.R
index a95c492..60ef7eb 100644
--- a/R/primary_censored_dist.R
+++ b/R/primary_censored_dist.R
@@ -284,10 +284,9 @@ primary_censored_cdf.pcens_pweibull_dunif <- function(
   g <- function(t) {
     # Use the lower incomplete gamma function
     scaled_t <- (t * inv_scale)^shape
-    gamma_1k <- vapply(scaled_t, function(x) {
-      pracma::gammainc(1 + inv_shape, x)["lowinc"]
+    vapply(scaled_t, function(x) {
+      pracma::gammainc(x, 1 + inv_shape)["lowinc"]
     }, numeric(1))
-    return(gamma_1k)
   }
 
   # Adjust q so that we have [q-pwindow, q]
@@ -308,12 +307,12 @@ primary_censored_cdf.pcens_pweibull_dunif <- function(
     g_q_pwindow <- g(non_zero_q + pwindow)
 
     Q_T <- 1 - pweibull_q_pwindow
-    Delta_g <- scale * (g_q_pwindow - g_q)
+    Delta_g <- (g_q_pwindow - g_q)
     Delta_F_T <- pweibull_q_pwindow - pweibull_q
 
     # Calculate Q_Splus using the analytical formula
     Q_Splus <- Q_T +
-      (1 / pwindow) * Delta_g -
+      (scale / pwindow) * Delta_g -
       (non_zero_q / pwindow) * Delta_F_T
 
     # Compute the CDF as 1 - Q_Splus
diff --git a/tests/testthat/test-primary_censored_dist.R b/tests/testthat/test-primary_censored_dist.R
index d97d258..f6717aa 100644
--- a/tests/testthat/test-primary_censored_dist.R
+++ b/tests/testthat/test-primary_censored_dist.R
@@ -67,7 +67,7 @@ test_that(
     expect_s3_class(obj_weibull, "pcens_pweibull_dunif")
 
     q_values <- c(5, 10)
-    pwindow <- 10
+    pwindow <- 2
 
     expect_no_error(
       primary_censored_cdf(obj_gamma, q = q_values, pwindow = pwindow)
diff --git a/tests/testthat/test-rpd-primarycensoreddist.R b/tests/testthat/test-rpd-primarycensoreddist.R
index 4d3154a..b85c97d 100644
--- a/tests/testthat/test-rpd-primarycensoreddist.R
+++ b/tests/testthat/test-rpd-primarycensoreddist.R
@@ -104,6 +104,8 @@ test_that(
 
     samples <- rpcens(
       n, rweibull, pwindow, swindow,
+      rprimary = rexpgrowth,
+      rprimary_args = list(r = 0.5),
       D = D, shape = shape, scale = scale
     )
 
@@ -115,6 +117,8 @@ test_that(
     x_values <- seq(0, D - swindow, by = swindow)
     pmf <- dpcens(
       x_values, pweibull, pwindow, swindow,
+      dprimary = dexpgrowth,
+      dprimary_args = list(r = 0.5),
       D = D, shape = shape, scale = scale
     )
     theoretical_mean <- sum(x_values * pmf)
@@ -132,6 +136,8 @@ test_that(
     empirical_cdf <- ecdf(samples)(x_values)
     theoretical_cdf <- ppcens(
       c(x_values[-1], D), pweibull, pwindow, D,
+      dprimary = dexpgrowth,
+      dprimary_args = list(r = 0.5),
       shape = shape, scale = scale
     )
     expect_equal(cumsum(pmf), theoretical_cdf, tolerance = 0.01)