keep testing we expect to be numeric numeric

epinowcast · Oct 8, 2024 · 462780d · 462780d
1 parent 2d073eb
commit 462780d
Show file tree

Hide file tree

Showing 3 changed files with 11 additions and 6 deletions.
diff --git 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
@@ -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
@@ -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)