debugging on parE issue with giving correct results and other documen…

…tation consistencies

R/boundsPostprob.R

@@ -32,11 +32,11 @@ boundsPostprob <- function(looks, p0, p1 = p0, tL, tU, parE = c(1, 1), weights)
   assert_number(tL, lower = 0, upper = 1)
   assert_number(tU, lower = 0, upper = 1)
   assert_numeric(parE, min.len = 2, any.missing = FALSE)
-  z <- matrix(NA, nrow = length(looks), ncol = 8)
   znames <- c(
     "xL", "pL", "postL", "pL_upper_ci",
     "xU", "pU", "postU", "pU_lower_ci"
   )
+  z <- matrix(NA, nrow = length(looks), ncol = length(znames))
   dimnames(z) <- list(looks, znames)
   k <- 0
   parE <- t(parE)

R/boundsPredprob.R

@@ -43,12 +43,15 @@ boundsPredprob <- function(looks, Nmax = max(looks), p0, tT, phiL, phiU, parE =
   assert_number(phiU, lower = 0, upper = 1)
   assert_numeric(parE, min.len = 2, any.missing = FALSE)
   znames <- c(
-    "xL", "pL", "predL", "postL", "UciL",
-    "xU", "pU", "predU", "postU", "LciU"
+    "xL", "pL", "predL", "postL", "pL_upper_ci",
+    "xU", "pU", "predU", "postU", "pU_lower_ci"
   )
   z <- matrix(NA, length(looks), length(znames))
   dimnames(z) <- list(looks, znames)
   k <- 0
+  if (missing(weights)) {
+    weights <- rep(1, nrow(t(parE)))
+  }
   assert_numeric(weights, min.len = 0, len = nrow(par), finite = TRUE)
   for (n in looks) {
     k <- k + 1

R/postprob.R

@@ -55,7 +55,7 @@ postprobBeta <- function(x, n, p, a = 1, b = 1) {
 #'  threshold that `P_E` is measured.
 #' @typed parE : matrix
 #'  the beta parameters matrix, with `K` rows and 2 columns,
-#'  corresponding to the beta parameters of the `K` components.
+#'  corresponding to the beta parameters of the `K` priors.
 #' @typed weights : vector
 #'  The mixture weights of the beta mixture prior.
 #' @typed betamixPost : matrix

R/predprob.R

@@ -31,7 +31,7 @@
 #'  threshold on the probability to be above p.
 #' @typed parE : numeric
 #'  the beta parameters matrix, with K rows and 2 columns,
-#'  corresponding to the beta parameters of the K components.
+#'  corresponding to the beta parameters of the K priors.
 #' @typed weights : numeric
 #'  the mixture weights of the beta mixture prior.
 #' @return A `list` is returned with names `result` for predictive probability and

tests/testthat/test-boundsPredprob.R

@@ -35,11 +35,11 @@ test_that("boundsPredprob gives correct result and when default weight is not as
   expect_equal(result$xL, c(0, 2, 5, 9))
   expect_equal(result$pL, c(0, 0.1, 0.1667, 0.225))
   expect_equal(result$postL, c(0.0859, 0.1787, 0.3931, 0.704))
-  expect_equal(result$UciL, c(0.2589, 0.2826, 0.319, 0.3598))
+  expect_equal(result$pL_upper_ci, c(0.2589, 0.2826, 0.319, 0.3598))
   expect_equal(result$xU, c(4, 7, 9, 10))
   expect_equal(result$pU, c(0.4, 0.35, 0.3, 0.25))
   expect_equal(result$postU, c(0.9496, 0.9569, 0.9254, 0.8177))
-  expect_equal(result$LciU, c(0.15, 0.1773, 0.1663, 0.1424))
+  expect_equal(result$pU_lower_ci, c(0.15, 0.1773, 0.1663, 0.1424))
 })
 
 test_that("boundsPredprob with Beta Mixture Priors give correct results", {
@@ -52,51 +52,94 @@ test_that("boundsPredprob with Beta Mixture Priors give correct results", {
     parE = cbind(c(1, 1), c(3, 10)),
     weights = c(0.2, 0.8)
   )
-  result_predprob_lower <- predprob(
-    x = 2,
-    n = 10,
-    p = 0.20,
-    Nmax = 20,
-    thetaT = 0.80,
-    parE = cbind(c(1, 1), c(3, 10)),
-    weights = c(0.2, 0.8)
-  )
-  result_predprob_upper <- predprob(
-    x = 6,
-    n = 10,
-    p = 0.20,
-    Nmax = 20,
-    thetaT = 0.80,
-    parE = cbind(c(1, 1), c(3, 10)),
-    weights = c(0.2, 0.8)
+  expected_lower_bound_results <- data.frame(
+    list(interim_predL =  # predL of interim data
+           predprob(
+             x = result$xL[1],
+             n = 10,
+             p = 0.20,
+             Nmax = 20,
+             thetaT = 0.80,
+             parE = cbind(c(1, 1), c(3, 10)),
+             weights = c(0.2, 0.8)
+           )$result,
+         interim_post = # postL of interim data
+           postprob(
+             x = 2,
+             n = 10,
+             p = 0.2,
+             parE = cbind(c(1, 1), c(3, 10)),
+             weights = c(0.2, 0.8),
+             log.p = FALSE),
+         final_predL = # predU of interim data
+           predprob(
+             x = result$xL[2],
+             n = 20,
+             p = 0.20,
+             Nmax = 20,
+             thetaT = 0.80,
+             parE = cbind(c(1, 1), c(3, 10)),
+             weights = c(0.2, 0.8)
+           )$result,
+         final_post = # postU of final data
+           postprob(
+             x = 6,
+             n = 20,
+             p = 0.2,
+             parE = cbind(c(1, 1), c(3, 10)),
+             weights = c(0.2, 0.8),
+             log.p = FALSE)
+    )
   )
-  expected <- data.frame(
-    list(
-      looks = c(10, 20),
-      xL = c(2, 6),
-      pL = c(0.2, 0.3),
-      predL = c(0.0409, 0),
-      postL = c(0.367, 0.7734),
-      UciL = c(0.5069, 0.5078),
-      xU = c(6, 7),
-      pU = c(0.6, 0.35),
-      predU = c(0.9859, 1),
-      postU = c(0.9875, 0.8919),
-      LciU = c(0.3035, 0.1773)
+  expected_upper_bound_results <- data.frame(
+    list(interim_predU =  # predL of interim data
+           predprob(
+             x = result$xU[1],
+             n = 10,
+             p = 0.20,
+             Nmax = 20,
+             thetaT = 0.80,
+             parE = cbind(c(1, 1), c(3, 10)),
+             weights = c(0.2, 0.8)
+           )$result,
+         interim_post = # postL of interim data
+           postprob(
+             x = result$xU[1],
+             n = 10,
+             p = 0.2,
+             parE = cbind(c(1, 1), c(3, 10)),
+             weights = c(0.2, 0.8),
+             log.p = FALSE),
+         final_predU = # predU of interim data
+           predprob(
+             x = result$xU[2],
+             n = 20,
+             p = 0.20,
+             Nmax = 20,
+             thetaT = 0.80,
+             parE = cbind(c(1, 1), c(3, 10)),
+             weights = c(0.2, 0.8)
+           )$result,
+         final_post = # postU of final data
+           postprob(
+             x = result$xU[2],
+             n = 20,
+             p = 0.2,
+             parE = cbind(c(1, 1), c(3, 10)),
+             weights = c(0.2, 0.8),
+             log.p = FALSE)
     )
   )
+  # lower bound predictive and posterior probabilities
   expect_equal(result$xL[1], 2)
-  expect_equal(result$predL[1], result_predprob_lower$result, tolerance = 1e-3)
-  expect_equal(result$xL[2], 6)
-  expect_equal(result$predU[1], result_predprob_upper$result, tolerance = 1e-4)
-  expect_equal(result$xL, c(2, 6))
-  expect_equal(result$pL, c(0.2, 0.3))
-  expect_equal(result$predL, c(0.0409, 0))
-  expect_equal(result$postL, c(0.27410, 0.69650))
-  expect_equal(result$UciL, c(0.5069, 0.5078))
-  expect_equal(result$xU, c(6, 7))
-  expect_equal(result$pU, c(0.6, 0.35))
-  expect_equal(result$predU, c(0.9859, 1))
-  expect_equal(result$postU, c(0.97480, 0.840))
-  expect_equal(result$LciU, c(0.3035, 0.1773))
+  expect_equal(result$predL[1], expected_lower_bound_results$interim_predL, tolerance = 1e-3)
+  expect_equal(result$postL[1], expected_lower_bound_results$interim_post, tolerance = 1e-4)
+  expect_equal(result$predL[2], expected_lower_bound_results$final_predL, tolerance = 1e-3)
+  expect_equal(result$postL[2], expected_lower_bound_results$final_post, tolerance = 1e-4)
+  # lower bound predictive and posterior probabilities
+  expect_equal(result$xU[1], 6)
+  expect_equal(result$predU[1], expected_upper_bound_results$interim_predU, tolerance = 1e-3)
+  expect_equal(result$postU[1], expected_upper_bound_results$interim_post, tolerance = 1e-4)
+  expect_equal(result$predU[2], expected_upper_bound_results$final_predU, tolerance = 1e-3)
+  expect_equal(result$postU[2], expected_upper_bound_results$final_post, tolerance = 1e-4)
 })