96 bounds predprob

R/boundsPostprob.R

@@ -1,8 +1,10 @@
 #' Decision cutpoints for boundary (based on posterior probability)
 #'
+#' @description `r lifecycle::badge("experimental")`
+#'
 #' This function is used to identify the efficacy and futility
 #' boundaries based on the following rules:
-#' Efficacy boundary: find minimum x (xU) where Pr(RR > p1 |x, n, a, b) >= tU and
+#' Efficacy boundary: find minimum x (xU) where Pr(RR > p1 | x, n, a, b) >= tU and
 #' Futility boundary: find maximum x (xL) where Pr(RR < p0 | x, n, a, b) >= tL
 #'
 #' @inheritParams postprob
@@ -24,17 +26,17 @@
 #' @example examples/boundsPostprob.R
 #' @export
 boundsPostprob <- function(looks, p0, p1 = p0, tL, tU, parE = c(1, 1), weights) {
-  assert_numeric(looks)
+  assert_numeric(looks, any.missing = FALSE)
   assert_number(p0, lower = 0, upper = 1)
   assert_number(p1, lower = 0, upper = 1)
   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)
@@ -48,12 +50,12 @@ boundsPostprob <- function(looks, p0, p1 = p0, tL, tU, parE = c(1, 1), weights)
     xL <- NA
     xU <- NA
     for (x in 0:n) {
-      postp_fut <- 1 - postprob(x, n, p0, parE, weights) # futility look
+      postp_fut <- 1 - postprob(x = x, n = n, p = p0, parE = parE, weights = weights) # futility look
       if (postp_fut >= tL) { # Rule is P(RR < p0) > tL
         postL <- postp_fut
         xL <- x
       }
-      postp_eff <- postprob(x, n, p1, parE, weights) # efficacy look
+      postp_eff <- postprob(x = x, n = n, p = p1, parE = parE, weights = weights) # efficacy look
       if (postp_eff >= tU) { # Rule is P(RR > p1) > tU
         postU <- postp_eff
         xU <- x

R/boundsPredprob.R

@@ -1,74 +1,105 @@
-#' Decision cutpoints for boundary (based on predictive probability)
+#' Decision cutpoints for boundary (based on predictive probability) for Decision 1 rule.
+#'
+#' @description `r lifecycle::badge("experimental")`
 #'
 #' This function is used to identify the efficacy boundary and futility
-#' boundary based on predictive probabilities, i.e.:
-#' Efficacy boundary: find minimum x (xU) where
-#' Pr(Pr(P > p | x, Y) >= tT | x) > phiU,
-#' Futility boundary: find maximum x (xL) where
-#' Pr(Pr(P > p | x, Y) >= tT | x) < phiL
+#' boundary based on rules in @details.
 #'
-#' @param nvec  a vector of number of patients
-#' @param Nmax  maximum number of patients at the end of the trial
-#' (default: maximum of \code{nvec})
-#' @param p  threshold on the response rate
-#' @param tT  threshold on the posterior probability to be above p
-#' @param phiL  futility boundary predictive probability threshold
-#' @param phiU  efficacy boundary predictive probability threshold
-#' @param a  the alpha parameter of a beta prior of treatment group
-#' @param b  the beta parameter of a beta prior of treatment group
-#' @return A matrix where for each sample size in \code{nvec}, this function
-#' returns the maximum number of responses that meet the futility
-#' threshold (xL), its corresponding response rate (pL), predictive probability
-#' (ppL) and posterior probability (postL), the upper bound of one
-#' sided 95% CI for the response rate based on an
-#' exact binomial test (UciL), and the same boundary parameters for efficacy:
-#' the minimal number of responses that meet the efficacy threshold (xU),
-#' the corresponding response rate (pU), predictive probability
-#' (ppL) and posterior probability (postU), the lower bound of one sided
-#' 95% CI for the response rate based on exact binomial test (LciU).
+#' @inheritParams predprob
+#' @inheritParams ocPredprob
+#' @inheritParams boundsPostprob
+#' @return A matrix for each same size in `looks`. For each sample size, the following is returned:
+#' - `xL` : the maximum number of responses that meet the futility
+#'          threshold.
+#' - `pL` : response rate corresponding to `xL`.
+#' - `predL` : predictive probability corresponding to `xL`
+#' - `postL`: posterior probability corresponding to `xL`.
+#' - `pL_upper_ci` : upper bound of one sided 95% CI for the response rate based on an
+#'            exact binomial test.
+#' - `xU` : the minimal number of responses that meet the efficacy threshold.
+#' - `pU` : response rate corresponding to `xU`.
+#' - `predU` : predictive probability corresponding to `xU`.
+#' - `postU`: posterior probability corresponding to `xU`.
+#' - `pU_lower_ci` : lower bound of one sided 95% CI for the response rate based on exact
+#'            binomial test.
 #'
 #' @importFrom stats binom.test
 #'
+#' @details see also `predprob()`
+#' The following rules are Decision 1 rules:
+#' Efficacy boundary: find minimum x (xU) where
+#' Pr(Pr(RR > p0 | data) >= tT | x) >= phiU,
+#' Futility boundary: find maximum x (xL) where
+#' Pr(Pr(RR > p0 | data) >= tT | x) =< phiL
+#'
 #' @example examples/boundsPredprob.R
 #' @export
 #' @keywords graphics
-boundsPredprob <- function(nvec, Nmax = max(nvec), p, tT, phiL, phiU, a, b) {
+boundsPredprob <- function(looks, Nmax = max(looks), p0, tT, phiL, phiU, parE = c(1, 1), weights) {
+  assert_numeric(looks, any.missing = FALSE)
+  assert_number(p0, lower = 0, upper = 1)
+  assert_number(tT, lower = 0, upper = 1)
+  assert_number(phiL, lower = 0, upper = 1)
+  assert_number(phiU, lower = 0, upper = 1)
+  assert_numeric(parE, min.len = 2, any.missing = FALSE)
   znames <- c(
-    "xL", "pL", "ppL", "postL", "UciL",
-    "xU", "pU", "ppU", "postU", "LciU"
+    "xL", "pL", "predL", "postL", "pL_upper_ci",
+    "xU", "pU", "predU", "postU", "pU_lower_ci"
   )
-  z <- matrix(NA, length(nvec), length(znames))
-  dimnames(z) <- list(nvec, znames)
+  z <- matrix(NA, length(looks), length(znames))
+  dimnames(z) <- list(looks, znames)
   k <- 0
-  for (n in nvec) {
+  if (missing(weights)) {
+    weights <- rep(1, nrow(t(parE)))
+  }
+  assert_numeric(weights, min.len = 0, len = nrow(parE), finite = TRUE)
+  for (n in looks) {
     k <- k + 1
     # initialize so will return NA if 0 or n in "continue" region
     xL <- NA
     xU <- NA
     for (x in 0:n) {
-      pp <- predprob(x, n, Nmax, p, tT, parE = c(a, b))$result
-      if (pp <= phiL) {
+      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( RR > p0 | x, Y) >= tT | x) =< phiL
         xL <- x
+        predL <- predprob
       }
-      if (pp >= phiU) {
+      if (predprob >= phiU) { # Efficacy look, Rule Pr(Pr( RR > p0 | x, Y) >= tT | x) >= phiU,
         xU <- x
-        # done: leave innermost for loop
+        predU <- predprob
         break
       }
     }
-    # reset xU to NA if phiU=1 and n<Nmax
+    # reset xU to NA if phiU = 1 and n < Nmax
     if (n < Nmax && phiU == 1) {
       xU <- NA
     }
     # calculate predictive and posterior probabilities at boundaries
-    ppL <- predprob(xL, n, Nmax, p, tT, parE = c(a, b))$result
-    ppU <- predprob(xU, n, Nmax, p, tT, parE = c(a, b))$result
-    postL <- postprob(xL, n, p, parE = c(a, b))
-    postU <- postprob(xU, n, p, parE = c(a, b))
+    postL <- postprob(x = xL, n = n, p = p0, parE = parE, weights = weights, log.p = FALSE)
+    postU <- postprob(x = xU, n = n, p = p0, parE = parE, weights = weights, log.p = FALSE)
     # calculate lower CI at boundaries
-    UciL <- ifelse(!is.na(xL), stats::binom.test(xL, n, alt = "less")$conf.int[2], NA)
-    LciU <- ifelse(!is.na(xU), stats::binom.test(xU, n, alt = "greater")$conf.int[1], NA)
-    z[k, ] <- c(xL, xL / n, ppL, postL, UciL, xU, xU / n, ppU, postU, LciU)
+    pL_upper_ci <- ifelse(!is.na(xL), stats::binom.test(xL, n, alt = "less")$conf.int[2], NA)
+    pU_lower_ci <- ifelse(!is.na(xU), stats::binom.test(xU, n, alt = "greater")$conf.int[1], NA)
+    z[k, ] <- c(
+      xL,
+      xL / n,
+      predL,
+      postL,
+      pL_upper_ci,
+      xU,
+      xU / n,
+      predU,
+      postU,
+      pU_lower_ci
+    )
   }
-  return(round(data.frame(nvec, z), 4))
+  round(data.frame(looks, z), 4)
 }

R/ocPostprobDist.R

@@ -103,11 +103,11 @@ h_get_decisionDist <- function(nnr,
 #'
 #' Stop criteria for Efficacy :
 #'
-#' `Pr(truep > P_S + deltaE) > tU`
+#' `Pr(RR > P_S + deltaE) > tU`
 #'
 #' Stop criteria for Futility :
 #'
-#' `Pr(truep < P_S + deltaF) > tL`
+#' `Pr(RR < P_S + deltaF) > tL`
 #'
 #' Where `truep` is the assumed true rate of response and `p1` and `p0` respectively are
 #' the thresholds for Efficacy and Futility respectively.

R/ocPredprob.R

@@ -211,17 +211,17 @@ h_get_decision_two_predprob <- function(nnr, truep, p0, p1, parE = c(1, 1), nnE,
 #' - interim STOP = P(successful trial at final) < phiL
 #'
 #' The criteria for Decision 1 for Final looks are:
-#' - Final GO = P( response rate > p0 | data) > tT
-#' - Final STOP = P( response rate > p0 | data ) < tT
+#' - Final GO = P( RR > p0 | data) > tT
+#' - Final STOP = P( RR > p0 | data ) < tT
 #'
 #' ## Decision 2:
 #' The criteria for Decision 2 for Interim looks are :
 #' - Interim GO : P ( success at final) > phiU
 #' - Interim STOP : P (failure at final ) > phiFu
 #'
 #' The criteria for Decision 2 for Futility looks are :
-#' - Final GO = P( response rate > p0) > tT
-#' - Final STOP = P( response rate  < p1) > tF
+#' - Final GO = P( RR > p0) > tT
+#' - Final STOP = P( RR  < p1) > tF
 #'
 #' @inheritParams h_get_decision_one_predprob
 #' @inheritParams h_get_decision_two_predprob

R/plotBounds.R

@@ -31,8 +31,8 @@ plotBounds <- function(z, area = TRUE, grid = TRUE, yt = "x", add = FALSE,
                        cols = c("green", "red", "darkgreen", "orange"),
                        lwds = c(3, 3), ltype = "l", lpch = 16, lcex = 1, gy = 20) {
   n <- nrow(z)
-  nmin <- min(z$nvec)
-  nmax <- max(z$nvec)
+  nmin <- min(z$looks)
+  nmax <- max(z$looks)
   if (yt == "x") {
     z1 <- z$xL
     z2 <- z$xU
@@ -51,38 +51,38 @@ plotBounds <- function(z, area = TRUE, grid = TRUE, yt = "x", add = FALSE,
     stop("yt can only be x or p")
   }
   if (add) {
-    graphics::lines(z$nvec, z2,
+    graphics::lines(z$looks, z2,
       lwd = lwds[1], col = cols[3], type = ltype,
       pch = lpch, cex = lcex
     )
-    graphics::lines(z$nvec, z1,
+    graphics::lines(z$looks, z1,
       lwd = lwds[2], col = cols[4], type = ltype,
       pch = lpch, cex = lcex
     )
     return(invisible())
   }
-  graphics::plot(z$nvec, rep(0, n),
-    xlim = c(0, max(z$nvec)), ylim = c(0, yU), type = "n",
+  graphics::plot(z$looks, rep(0, n),
+    xlim = c(0, max(z$looks)), ylim = c(0, yU), type = "n",
     xlab = "n", ylab = ylabel
   )
   if (grid) {
     graphics::abline(h = gridy, col = "gray")
   }
   if (area) {
-    graphics::polygon(c(z$nvec, nmax, nmin), c(z2, yU, yU2),
+    graphics::polygon(c(z$looks, nmax, nmin), c(z2, yU, yU2),
       lwd = lwds[1],
       col = cols[1], border = cols[1]
     )
-    graphics::polygon(c(z$nvec, nmax, nmin), c(z1, 0, 0),
+    graphics::polygon(c(z$looks, nmax, nmin), c(z1, 0, 0),
       lwd = lwds[2],
       col = cols[2], border = cols[2]
     )
   } else {
-    graphics::lines(z$nvec, z2,
+    graphics::lines(z$looks, z2,
       lwd = lwds[1], col = cols[1], type = ltype,
       pch = lpch, cex = lcex
     )
-    graphics::lines(z$nvec, z1,
+    graphics::lines(z$looks, z1,
       lwd = lwds[2], col = cols[2], type = ltype,
       pch = lpch, cex = lcex
     )

R/predprob.R

@@ -63,7 +63,7 @@ predprob <- function(x, n, Nmax, p, thetaT, parE = c(1, 1),
     betamixPost,
     dbetabinomMix(x = 0:m, m = m, par = par, weights = weights)
   )
-  assert_numeric(density, lower = 0, upper = 1, finite = TRUE, any.missing = FALSE)
+  assert_numeric(density, lower = 0, upper = 1 + .Machine$double.eps, finite = TRUE, any.missing = FALSE)
   assert_number(thetaT, lower = 0, upper = 1, finite = TRUE)
   # posterior probabilities to be above threshold p
   posterior <- postprob(x = x + c(0:m), n = Nmax, p = p, parE = parE, weights = weights)

examples/boundsPredprob.R

@@ -1,12 +1,33 @@
-## 40 pts trial with interim looks after each 10 pts.,
-## final efficacy decision if more than 80% probability to be above 20% ORR,
-## final futility decision otherwise.
-## Interim efficacy decision if more than 90% predictive probability reach this,
-## interim futility decision if less than 10% predictive probability.
-## Uniform prior (i.e. beta(1, 1)) on the ORR:
+# 40 pts trial with interim looks after each 10 patients.
+# Final efficacy decision if more than 80% probability to be above 20% ORR,
+# Final futility decision otherwise.
+# Interim efficacy decision if more than 90% predictive probability reach this or
+# Efficacy look Pr(Pr(RR > p0 | x, Y) >= tT | x) >= phiU,
+# Interim futility decision if less than 10% predictive probability or
+# Futility look Pr(Pr(RR > p0 | x, Y) >= tT | x) =< phiL
+# Uniform prior (i.e. beta(1, 1)) on the ORR:
 boundsPredprob(
-  nvec = c(10, 20, 30, 40), p = 0.20, tT = 0.80,
-  phiL = 0.10, phiU = 0.90, a = 1, b = 1
+  looks = c(10, 20, 30, 40),
+  p0 = 0.20,
+  tT = 0.80,
+  phiL = 0.60,
+  phiU = 0.90
+)
+
+# 25 pts trial with interim looks at 7 and 15 pts.
+# Efficacy decision if more than 80% probability to be above 20% ORR,
+# Final futility decision otherwise.
+# Interim efficacy decision if more than 90% predictive probability reach this or
+# Efficacy look Pr(Pr(RR > p0 | x, Y) >= tT | x) >= phiU,
+# Interim futility decision if less than 60% predictive probability or
+# Futility look Pr(Pr(RR > p0 | x, Y) >= tT | x) =< phi
+# with mixed prior and weights:
+boundsPredprob(
+  looks = c(7, 15, 25),
+  p0 = 0.20,
+  tT = 0.80,
+  phiL = 0.60,
+  phiU = 0.90,
+  parE = cbind(c(1, 1), c(3, 10)),
+  weights = c(0.2, 0.8)
 )
-## From this we see e.g. that at the first IA at 10 pts, we would stop for futility
-## if no patient responded, and for efficacy if 4 or more pts responded.

examples/ocPostprob.R

@@ -1,8 +1,8 @@
 # For three looks of 10, 20 and 30 we have the following assumptions :
 # True response rate or truep of the treatment group = 40%
 # The following are the Stop rules respectively :
-# Look for Efficacy: Pr(truep > 30% )> 80%
-# Look for Futility: Pr(truep < 20% )> 60%
+# Look for Efficacy: Pr(RR > 30% )> 80%
+# Look for Futility: Pr(RR < 20% )> 60%
 # Prior of treatment arm parE= Beta(1,1).
 res <- ocPostprob(
   nnE = c(10, 20, 30), truep = 0.40, p0 = 0.20, p1 = 0.30, tL = 0.60, tU = 0.80, parE = c(1, 1),

examples/ocPostprobDist.R

@@ -3,8 +3,6 @@
 # True response rate or truep of the treatment group = 40%
 # The following are the Go and Stop rules respectively :
 # Prior of treatment arm parE= Beta(1,1).
-# stop for efficacy (deltaE): Pr(truep > P_S + deltaE) > tU
-# stop for futility (deltaF): Pr(truep < P_S + deltaF) > tL
 # Without random distance allowed for Futility and Efficacy Looks.
 res1 <- ocPostprobDist(
   nnE = c(10, 20, 30),

examples/ocPredprob.R

@@ -1,8 +1,8 @@
 # Here we illustrate an example for Decision 1 with the following assumptions :
 # True response rate or truep of the treatment group = 40%
 # The following are the Final Stop rules respectively :
-# - Final look for Efficacy: Pr( response rate > 25% ) > 60% or P(response rate > p0) > tT
-# - Final look for Futility: Pr( response rate < 25% ) < 60% or P(response rate > p0) < tT
+# - Final look for Efficacy: Pr( RR > 25% ) > 60% or P( RR > p0) > tT
+# - Final look for Futility: Pr( RR < 25% ) < 60% or P(RR > p0) < tT
 # - Interim look for Efficacy: Pr( success at final ) > 80% or P(success at final) > phiU
 # - Interim look for Futility: Pr( failure at final ) < 20% or P(success at final) < phiL
 # We assume a prior of treatment arm parE = Beta(1,1), unless otherwise indicated.
@@ -76,8 +76,8 @@ result$oc
 # Here we illustrate an example for Decision 2 with the following assumptions :
 # True response rate or truep of the treatment group = 60%
 # The following are the Final Stop rules respectively :
-# - Final look for Efficacy: Pr( response rate > 25% ) > 60% or P(response rate > p0) > tT
-# - Final look for Futility: Pr( response rate < 25% ) < 60% or P(response rate < p1) > tF
+# - Final look for Efficacy: Pr( RR > 25% ) > 60% or P(RR > p0) > tT
+# - Final look for Futility: Pr( RR < 25% ) < 60% or P(RR < p1) > tF
 # - Interim look for Efficacy: Pr( success at final ) > 80% or P(success at final) > phiU
 # - Interim look for Futility: Pr( failure at final ) > 80% or P(failure at final) > phiFu
 # We assume a prior of treatment arm parE = Beta(1,1), unless otherwise indicated.