test case with pred prob passes with missing weights argument

Genentech · Oct 10, 2024 · e4864b5 · e4864b5
1 parent eba4d49
commit e4864b5
Show file tree

Hide file tree

Showing 2 changed files with 38 additions and 2 deletions.
diff --git a/R/boundsPredprob.R b/R/boundsPredprob.R
@@ -42,7 +42,6 @@ boundsPredprob <- function(looks, Nmax = max(looks), p0, tT, phiL, phiU, parE =
   z <- matrix(NA, length(looks), length(znames))
   dimnames(z) <- list(looks, znames)
   k <- 0
-  parE <- t(parE)
   if (missing(weights)) {
     weights <- rep(1, nrow(parE))
   }
@@ -53,7 +52,7 @@ boundsPredprob <- function(looks, Nmax = max(looks), p0, tT, phiL, phiU, parE =
     xL <- NA
     xU <- NA
     for (x in 0:n) {
-      predprob <- predprob(x, n, Nmax, p0, tT, parE = parE)$result
+      predprob <- predprob(x = x, n = n, Nmax = max(looks), p = p0, thetaT = tT, parE = parE, weights = weights)$result
       if (predprob <= phiL) { # Futility look, Rule Pr(Pr(P > p0 | x, Y, a, b) >= tT | x) =< phiL
         xL <- x
         predL <- predprob

diff --git a/tests/testthat/test-boundsPredprob.R b/tests/testthat/test-boundsPredprob.R
@@ -67,3 +67,40 @@ test_that("boundsPredprob of beta mixture gives correct result", {
   expect_equal(result$postU, c(0.9883, 0.9727, 0.8919))
   expect_equal(result$LciU, c(0.3413, 0.2437, 0.1773))
 })
+
+test_that("boundsPredprob of beta mixture gives correct result", {
+  result <- boundsPredprob(
+    looks = c(7, 15, 20),
+    p0 = 0.2,
+    tT = 0.80,
+    phiL = 0.10,
+    phiU = 0.90,
+    parE = rbind(c(1, 1), c(3, 10)),
+    weights = c(0.2, 0.8)
+  )
+  expected <- data.frame(
+    list(
+      looks = c(7, 15, 20),
+      xL = c(1, 3, 6),
+      pL = c(0.1429, 0.2000, 0.3000),
+      predL = c(0.0446, 0.0121, 0.0000),
+      postL = c(0.2407, 0.3818, 0.7734),
+      UciL = c(0.5207, 0.4398, 0.5078),
+      xU = c(5, 7, 7),
+      pU = c(0.7143, 0.4667, 0.3500),
+      predU = c(0.9843, 1.0000, 1.0000),
+      postU = c(0.9883, 0.9727, 0.8919),
+      LciU = c(0.3413, 0.2437, 0.1773)
+    )
+  )
+  expect_equal(result$xL, c(1, 3, 6))
+  expect_equal(result$pL, c(0.1429, 0.2000, 0.3000))
+  expect_equal(result$predL, c(0.0446, 0.0121, 0.0000))
+  expect_equal(result$postL, c(0.2407, 0.3818, 0.7734))
+  expect_equal(result$UciL, c(0.5207, 0.4398, 0.5078))
+  expect_equal(result$xU, c(5, 7, 7))
+  expect_equal(result$pU, c(0.7143, 0.4667, 0.3500))
+  expect_equal(result$predU, c(0.9843, 1.0000, 1.0000))
+  expect_equal(result$postU, c(0.9883, 0.9727, 0.8919))
+  expect_equal(result$LciU, c(0.3413, 0.2437, 0.1773))
+})