diff --git a/R/boundsPredprob.R b/R/boundsPredprob.R index 27e916b9..a92e6726 100644 --- 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 index ae62fee8..e6a9601f 100644 --- 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)) +})