diff --git a/R/boundsPostprob.R b/R/boundsPostprob.R index a35fef8d..874a8c99 100644 --- a/R/boundsPostprob.R +++ b/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 diff --git a/R/boundsPredprob.R b/R/boundsPredprob.R index 66a0de3c..c118671b 100644 --- a/R/boundsPredprob.R +++ b/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 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. diff --git a/R/ocPredprob.R b/R/ocPredprob.R index c0f4bd65..f97976c1 100644 --- a/R/ocPredprob.R +++ b/R/ocPredprob.R @@ -211,8 +211,8 @@ 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 : @@ -220,8 +220,8 @@ h_get_decision_two_predprob <- function(nnr, truep, p0, p1, parE = c(1, 1), nnE, #' - 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 diff --git a/R/plotBounds.R b/R/plotBounds.R index b396549a..4e956771 100644 --- a/R/plotBounds.R +++ b/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 ) diff --git a/R/predprob.R b/R/predprob.R index 93329528..f550e018 100644 --- a/R/predprob.R +++ b/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) diff --git a/examples/boundsPredprob.R b/examples/boundsPredprob.R index 2444ddea..0ec7021b 100644 --- a/examples/boundsPredprob.R +++ b/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. diff --git a/examples/ocPostprob.R b/examples/ocPostprob.R index b7aded5d..05062f78 100644 --- a/examples/ocPostprob.R +++ b/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), diff --git a/examples/ocPostprobDist.R b/examples/ocPostprobDist.R index 42355591..3161f6f5 100644 --- a/examples/ocPostprobDist.R +++ b/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), diff --git a/examples/ocPredprob.R b/examples/ocPredprob.R index bed3d299..72741aea 100644 --- a/examples/ocPredprob.R +++ b/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. diff --git a/examples/ocPredprobDist.R b/examples/ocPredprobDist.R index 4bc2715e..7ebee7e1 100644 --- a/examples/ocPredprobDist.R +++ b/examples/ocPredprobDist.R @@ -2,15 +2,11 @@ # Efficacy Looks and Futility looks are identical at sample size of 10, 20 and 30. # True response rate or truep of the treatment group = 40% # Desired difference to Standard of Care for Efficacy and Futility = 10% -# Delta calculation is absolute case. The following are the Final Stop rules respectively : -# - Final look for Efficacy: -# Pr( response rate + deltaE > 25% ) > 60% or P(response rate + deltaE > p0) > tT -# - Final look for Futility: -# Pr( response rate + deltaF < 25% ) < 60% or P(response rate + deltaF > 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 +# The following are the Final Stop rules respectively : +# - Final look for Efficacy: Pr( RR + deltaE > 25% ) > 60% +# - Final look for Futility: Pr( RR + deltaF < 25% ) < 60% +# - Interim look for Efficacy: Pr( success at final ) > 80% +# - Interim look for Futility: Pr( failure at final ) < 20% # We assume a prior of treatment arm parE = Beta(1,1), unless otherwise indicated. set.seed(20) @@ -41,10 +37,10 @@ result$oc # Desired difference to Standard of Care for Efficacy and Futility is 10% and -10% respectively. # Grey zone occurs due to different posterior probability distribution in the Efficacy and Futility rules. # Delta calculation is absolute case. The following are the Final Stop rules respectively : -# - Final look for Efficacy: Pr( response rate + deltaE > 25% ) > 60% or P(response rate + deltaE > p0) > tT -# - Final look for Futility: Pr( response rate + deltaF < 25% ) < 60% or P(response rate + deltaF > 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 +# - Final look for Efficacy: Pr( RR + deltaE > 25% ) > 60% +# - Final look for Futility: Pr( RR + deltaF < 25% ) < 60% +# - Interim look for Efficacy: Pr( success at final ) > 80% +# - Interim look for Futility: Pr( failure at final ) < 20% # We assume a prior of treatment arm parE = Beta(1,1), unless otherwise indicated. # set.seed(20) @@ -74,12 +70,9 @@ result$oc # True response rate or truep of the treatment group = 40% # Desired difference to Standard of Care for Efficacy and Futility = 50% # Delta calculation is absolute case. The following are the Final Stop rules respectively : -# - Final look for Efficacy: Pr( response rate + deltaE > 25% ) > 60% or -# P(response rate + deltaE > p0) > tT -# - Final look for Futility: Pr( response rate + deltaF < 25% ) < 60% or -# P(response rate + deltaF > p0) < tT -# - Interim look for Efficacy: Pr( success at final ) > 80% or -# P(success at final) > phiU +# - Final look for Efficacy: Pr( RR + deltaE > 25% ) > 60% or P(RR + deltaE > p0) > tT +# - Final look for Futility: Pr( RR + deltaF < 25% ) < 60% or P(RR + deltaF > 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. @@ -111,10 +104,10 @@ result$oc # True response rate or truep of the treatment group = 40% # Desired difference to Standard of Care for Efficacy and Futility = 50% # Delta calculation is relative case. The following are the Final Stop rules respectively : -# - Final look for Efficacy: P( P_S + (1-P_S)*deltaE > 25% ) > 60% or P( P_S + (1-P_S)*deltaE > p0) > tT -# - Final look for Futility: P( P_S + (1-P_S)*deltaEF < 25% ) < 60% or P( P_S + (1-P_S)*deltaF > p0) < tT -# - Interim look for Efficacy: P( success at final ) > 80% or P(success at final) > phiU -# - Interim look for Futility: P( failure at final ) < 20% or P(success at final) < phiL +# - Final look for Efficacy: P( P_S + (1-P_S)*deltaE > 25% ) > 60% +# - Final look for Futility: P( P_S + (1-P_S)*deltaEF < 25% ) < 60% +# - Interim look for Efficacy: P( success at final ) > 80% +# - Interim look for Futility: P( failure at final ) < 20% # We assume a prior of treatment arm parE = Beta(1,1), unless otherwise indicated. set.seed(20) diff --git a/examples/plotBounds.R b/examples/plotBounds.R index c28479ea..c39fc05b 100644 --- a/examples/plotBounds.R +++ b/examples/plotBounds.R @@ -1,9 +1,16 @@ # examples +plotBounds( + boundsPostprob( + looks = c(10, 20, 30, 40), p0 = 0.20, + tL = 0.10, tU = 0.90, parE = c(1, 1) + ), + yt = "p", add = TRUE +) plotBounds(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.10, phiU = 0.90, ), yt = "x") plotBounds(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.10, phiU = 0.90, ), yt = "p") diff --git a/man/boundsPostprob.Rd b/man/boundsPostprob.Rd index b21240cd..e97bf85e 100644 --- a/man/boundsPostprob.Rd +++ b/man/boundsPostprob.Rd @@ -38,9 +38,11 @@ binomial test. } } \description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[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 } \examples{ diff --git a/man/boundsPredprob.Rd b/man/boundsPredprob.Rd index e0e28cce..04d6756b 100644 --- a/man/boundsPredprob.Rd +++ b/man/boundsPredprob.Rd @@ -2,60 +2,102 @@ % Please edit documentation in R/boundsPredprob.R \name{boundsPredprob} \alias{boundsPredprob} -\title{Decision cutpoints for boundary (based on predictive probability)} +\title{Decision cutpoints for boundary (based on predictive probability) for Decision 1 rule.} \usage{ -boundsPredprob(nvec, Nmax = max(nvec), p, tT, phiL, phiU, a, b) +boundsPredprob( + looks, + Nmax = max(looks), + p0, + tT, + phiL, + phiU, + parE = c(1, 1), + weights +) } \arguments{ -\item{nvec}{a vector of number of patients} +\item{looks}{(\code{numeric}):\cr A vector of number of patients in each look.} -\item{Nmax}{maximum number of patients at the end of the trial -(default: maximum of \code{nvec})} +\item{Nmax}{(\code{number}):\cr maximum number of patients at the end of the trial in the \code{E} group.} -\item{p}{threshold on the response rate} +\item{p0}{(\code{number}):\cr lower Futility threshold of response rate.} -\item{tT}{threshold on the posterior probability to be above p} +\item{tT}{(\code{number}):\cr threshold of which assumed \code{truep} exceeds acceptable threshold of \code{p0}.} -\item{phiL}{futility boundary predictive probability threshold} +\item{phiL}{(\code{number}):\cr lower threshold on the predictive probability.} -\item{phiU}{efficacy boundary predictive probability threshold} +\item{phiU}{(\code{number}):\cr upper threshold on the predictive probability.} -\item{a}{the alpha parameter of a beta prior of treatment group} +\item{parE}{(\code{numeric}):\cr the beta parameters matrix, with K rows and 2 columns, +corresponding to the beta parameters of the K components.} -\item{b}{the beta parameter of a beta prior of treatment group} +\item{weights}{(\code{numeric}):\cr the mixture weights of the beta mixture prior.} } \value{ -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). +A matrix for each same size in \code{looks}. For each sample size, the following is returned: +\itemize{ +\item \code{xL} : the maximum number of responses that meet the futility +threshold. +\item \code{pL} : response rate corresponding to \code{xL}. +\item \code{predL} : predictive probability corresponding to \code{xL} +\item \code{postL}: posterior probability corresponding to \code{xL}. +\item \code{pL_upper_ci} : upper bound of one sided 95\% CI for the response rate based on an +exact binomial test. +\item \code{xU} : the minimal number of responses that meet the efficacy threshold. +\item \code{pU} : response rate corresponding to \code{xU}. +\item \code{predU} : predictive probability corresponding to \code{xU}. +\item \code{postU}: posterior probability corresponding to \code{xU}. +\item \code{pU_lower_ci} : lower bound of one sided 95\% CI for the response rate based on exact +binomial test. +} } \description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + This function is used to identify the efficacy boundary and futility -boundary based on predictive probabilities, i.e.: +boundary based on rules in @details. +} +\details{ +see also \code{predprob()} +The following rules are Decision 1 rules: Efficacy boundary: find minimum x (xU) where -Pr(Pr(P > p | x, Y) >= tT | x) > phiU, +Pr(Pr(RR > p0 | data) >= tT | x) >= phiU, Futility boundary: find maximum x (xL) where -Pr(Pr(P > p | x, Y) >= tT | x) < phiL +Pr(Pr(RR > p0 | data) >= tT | x) =< phiL } \examples{ -## 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( + 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( - nvec = c(10, 20, 30, 40), p = 0.20, tT = 0.80, - phiL = 0.10, phiU = 0.90, a = 1, b = 1 + 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. } \keyword{graphics} diff --git a/man/ocPostprob.Rd b/man/ocPostprob.Rd index 950cde0a..9f7802ef 100644 --- a/man/ocPostprob.Rd +++ b/man/ocPostprob.Rd @@ -85,8 +85,8 @@ maximum sample size) # 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), diff --git a/man/ocPostprobDist.Rd b/man/ocPostprobDist.Rd index d047ebc1..7f54795e 100644 --- a/man/ocPostprobDist.Rd +++ b/man/ocPostprobDist.Rd @@ -76,11 +76,11 @@ respectively. Stop criteria for Efficacy : -\code{Pr(truep > P_S + deltaE) > tU} +\code{Pr(RR > P_S + deltaE) > tU} Stop criteria for Futility : -\code{Pr(truep < P_S + deltaF) > tL} +\code{Pr(RR < P_S + deltaF) > tL} Where \code{truep} is the assumed true rate of response and \code{p1} and \code{p0} respectively are the thresholds for Efficacy and Futility respectively. @@ -121,8 +121,6 @@ or \code{Pr(truep > P_S + (1 - P_S) * deltaF | data)} for Futility looks. # 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), diff --git a/man/ocPredprob.Rd b/man/ocPredprob.Rd index 63e17a09..05595ace 100644 --- a/man/ocPredprob.Rd +++ b/man/ocPredprob.Rd @@ -97,8 +97,8 @@ The criteria for Decision 1 for Interim looks are : The criteria for Decision 1 for Final looks are: \itemize{ -\item Final GO = P( response rate > p0 | data) > tT -\item Final STOP = P( response rate > p0 | data ) < tT +\item Final GO = P( RR > p0 | data) > tT +\item Final STOP = P( RR > p0 | data ) < tT } } @@ -112,8 +112,8 @@ The criteria for Decision 2 for Interim looks are : The criteria for Decision 2 for Futility looks are : \itemize{ -\item Final GO = P( response rate > p0) > tT -\item Final STOP = P( response rate < p1) > tF +\item Final GO = P( RR > p0) > tT +\item Final STOP = P( RR < p1) > tF } } } @@ -121,8 +121,8 @@ The criteria for Decision 2 for Futility looks are : # 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. @@ -196,8 +196,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. diff --git a/man/ocPredprobDist.Rd b/man/ocPredprobDist.Rd index 3a570cfa..85eef12a 100644 --- a/man/ocPredprobDist.Rd +++ b/man/ocPredprobDist.Rd @@ -136,15 +136,11 @@ seen in the evaluation for the final futility look in \code{\link[=ocPredprobDis # Efficacy Looks and Futility looks are identical at sample size of 10, 20 and 30. # True response rate or truep of the treatment group = 40\% # Desired difference to Standard of Care for Efficacy and Futility = 10\% -# Delta calculation is absolute case. The following are the Final Stop rules respectively : -# - Final look for Efficacy: -# Pr( response rate + deltaE > 25\% ) > 60\% or P(response rate + deltaE > p0) > tT -# - Final look for Futility: -# Pr( response rate + deltaF < 25\% ) < 60\% or P(response rate + deltaF > 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 +# The following are the Final Stop rules respectively : +# - Final look for Efficacy: Pr( RR + deltaE > 25\% ) > 60\% +# - Final look for Futility: Pr( RR + deltaF < 25\% ) < 60\% +# - Interim look for Efficacy: Pr( success at final ) > 80\% +# - Interim look for Futility: Pr( failure at final ) < 20\% # We assume a prior of treatment arm parE = Beta(1,1), unless otherwise indicated. set.seed(20) @@ -175,10 +171,10 @@ result$oc # Desired difference to Standard of Care for Efficacy and Futility is 10\% and -10\% respectively. # Grey zone occurs due to different posterior probability distribution in the Efficacy and Futility rules. # Delta calculation is absolute case. The following are the Final Stop rules respectively : -# - Final look for Efficacy: Pr( response rate + deltaE > 25\% ) > 60\% or P(response rate + deltaE > p0) > tT -# - Final look for Futility: Pr( response rate + deltaF < 25\% ) < 60\% or P(response rate + deltaF > 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 +# - Final look for Efficacy: Pr( RR + deltaE > 25\% ) > 60\% +# - Final look for Futility: Pr( RR + deltaF < 25\% ) < 60\% +# - Interim look for Efficacy: Pr( success at final ) > 80\% +# - Interim look for Futility: Pr( failure at final ) < 20\% # We assume a prior of treatment arm parE = Beta(1,1), unless otherwise indicated. # set.seed(20) @@ -208,12 +204,9 @@ result$oc # True response rate or truep of the treatment group = 40\% # Desired difference to Standard of Care for Efficacy and Futility = 50\% # Delta calculation is absolute case. The following are the Final Stop rules respectively : -# - Final look for Efficacy: Pr( response rate + deltaE > 25\% ) > 60\% or -# P(response rate + deltaE > p0) > tT -# - Final look for Futility: Pr( response rate + deltaF < 25\% ) < 60\% or -# P(response rate + deltaF > p0) < tT -# - Interim look for Efficacy: Pr( success at final ) > 80\% or -# P(success at final) > phiU +# - Final look for Efficacy: Pr( RR + deltaE > 25\% ) > 60\% or P(RR + deltaE > p0) > tT +# - Final look for Futility: Pr( RR + deltaF < 25\% ) < 60\% or P(RR + deltaF > 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. @@ -245,10 +238,10 @@ result$oc # True response rate or truep of the treatment group = 40\% # Desired difference to Standard of Care for Efficacy and Futility = 50\% # Delta calculation is relative case. The following are the Final Stop rules respectively : -# - Final look for Efficacy: P( P_S + (1-P_S)*deltaE > 25\% ) > 60\% or P( P_S + (1-P_S)*deltaE > p0) > tT -# - Final look for Futility: P( P_S + (1-P_S)*deltaEF < 25\% ) < 60\% or P( P_S + (1-P_S)*deltaF > p0) < tT -# - Interim look for Efficacy: P( success at final ) > 80\% or P(success at final) > phiU -# - Interim look for Futility: P( failure at final ) < 20\% or P(success at final) < phiL +# - Final look for Efficacy: P( P_S + (1-P_S)*deltaE > 25\% ) > 60\% +# - Final look for Futility: P( P_S + (1-P_S)*deltaEF < 25\% ) < 60\% +# - Interim look for Efficacy: P( success at final ) > 80\% +# - Interim look for Futility: P( failure at final ) < 20\% # We assume a prior of treatment arm parE = Beta(1,1), unless otherwise indicated. set.seed(20) diff --git a/man/plotBounds.Rd b/man/plotBounds.Rd index 0ee0034d..0caf508c 100644 --- a/man/plotBounds.Rd +++ b/man/plotBounds.Rd @@ -56,13 +56,20 @@ and \code{\link{boundsPostprob}} } \examples{ # examples +plotBounds( + boundsPostprob( + looks = c(10, 20, 30, 40), p0 = 0.20, + tL = 0.10, tU = 0.90, parE = c(1, 1) + ), + yt = "p", add = TRUE +) plotBounds(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.10, phiU = 0.90, ), yt = "x") plotBounds(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.10, phiU = 0.90, ), yt = "p") } \keyword{graphics} diff --git a/tests/testthat/test-boundsPredprob.R b/tests/testthat/test-boundsPredprob.R new file mode 100644 index 00000000..af3c9f90 --- /dev/null +++ b/tests/testthat/test-boundsPredprob.R @@ -0,0 +1,151 @@ +# boundsPredprob ---- +test_that("boundsPredprob gives correct result and when default weight is not assigned", { + result_weights <- boundsPredprob( + looks = c(10, 20, 30, 40), + p0 = 0.2, + tT = 0.80, + phiL = 0.10, + phiU = 0.90, + parE = c(1, 1), + weights = 1 + ) + result <- boundsPredprob( + looks = c(10, 20, 30, 40), + p0 = 0.2, + tT = 0.80, + phiL = 0.10, + phiU = 0.90, + parE = c(1, 1) + ) + expected <- data.frame( + list( + looks = c(10, 20, 30, 40), + xL = c(0, 2, 5, 9), + pL = c(0, 0.1, 0.1667, 0.225), + predL = c(0.0268, 0.0269, 0.0446, 0.0000), + postL = c(0.0859, 0.1787, 0.3931, 0.704), + UciL = c(0.2589, 0.2826, 0.319, 0.3598), + xU = c(4, 7, 9, 10), + pU = c(0.4, 0.35, 0.3, 0.25), + predU = c(0.9287, 0.9600, 0.9604, 1.0000), + postU = c(0.9496, 0.9569, 0.9254, 0.8177), + LciU = c(0.15, 0.1773, 0.1663, 0.1424) + ) + ) + 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$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$pU_lower_ci, c(0.15, 0.1773, 0.1663, 0.1424)) +}) + +test_that("boundsPredprob with Beta Mixture Priors give correct results", { + result <- boundsPredprob( + looks = c(10, 20), + p0 = 0.20, + tT = 0.80, + phiL = 0.10, + phiU = 0.90, + 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_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], 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) +})