bpp_1interim: Bayesian Predictive Power (BPP) for Normally Distributed Endpoint

Description

Compute BPP and posterior density for a Normally distributed endpoint, e.g. log(hazard ratio), assuming either an unblinded or blinded interim result.

Usage

bpp_1interim(prior = c("normal", "flat"), interimSE, finalSE, successmean, 
                            IntEffBoundary, IntFutBoundary, IntFix, priormean, 
                            propA = 0.5, thetas, ...)

Arguments

prior

Prior density on effect sizes.

interimSE

(Known) standard error of estimate at interim analysis.

finalSE

(Known) standard error at which the final analysis of the study under consideration takes place.

successmean

The mean that defines success at the final analysis. Typically chosen to be the minimal detectable difference, i.e. the critical on the scale of the effect size of interest corresponding to the significance level at the final analysis.

IntEffBoundary

Efficacy boundary at the interim analysis.

IntFutBoundary

Futility boundary at the interim analysis.

IntFix

Effect sizes observed at the interim analyis, to compute BPP for an unblinded interim analysis.

priormean

Prior mean.

propA

Proportion of subjects randomized to arm A.

thetas

Grid to compute posterior density on.

...

Further arguments specific to the chosen prior (see bpp_1interim for examples).

Value

A list containing the following elements:

initial BPP

BPP based on the prior.

conditional power interval

Conditional power, updating power at design stage with interval knowledge, i.e. corresponding to IntEffBoundary and IntFutBoundary.

BPP after not stopping at interim interval

BPP after not stopping at a blinded interim, provides the results corresponding to IntEffBoundary and IntFutBoundary.

BPP after not stopping at interim exact

BPP after not stopping at an unblinded interim, provides the results corresponding to IntFix.

posterior density exact

The posterior density, exact knowledge of interim result, i.e. corresponding to IntFix.

posterior density interval

The posterior density, interval knowledge, i.e. corresponding to IntEffBoundary and IntFutBoundary.

References

Rufibach, K., Jordan, P., Abt, M. (2016a). Sequentially Updating the Likelihood of Success of a Phase 3 Pivotal Time-to-Event Trial based on Interim Analyses or External Information. J. Biopharm. Stat., 26(2), 191--201.

Rufibach, K., Burger, H.U., Abt, M. (2016b). Bayesian Predictive Power: Choice of Prior and some Recommendations for its Use as Probability of Success in Drug Development. Pharm. Stat., 15, 438--446.

Examples

Run this code

# NOT RUN {
# ------------------------------------------------------------------------------------------
# Reproduce all the computations in Rufibach et al (2016a) for a Normal prior.
# ------------------------------------------------------------------------------------------

# ------------------------------------------
# set all parameters:
# ------------------------------------------
# prior mean / sd
hr0 <- 0.85
sd0 <- 0.11
priormean <- log(hr0)

# specifications for pivotal study
propA <- 0.5   # proportion of patients randomized to arm A
fac <- (propA * (1 - propA)) ^ (-1)
nevents <- c(0.5, 1) * 1600
finalSE <- sqrt(fac / nevents[2])
alphas <- c(0.001, 0.049)
za <- qnorm(1 - alphas / 2)
hrMDD <- exp(- za * sqrt(fac / nevents))
successmean <- log(hrMDD[2])

# efficacy and futility interim boundary
effi <- log(hrMDD[1])
futi <- log(1.025)

# grid to compute densities on
thetas <- seq(-0.65, 0.3, by = 0.01)

# ------------------------------------------
# compare Normal and flat prior density
# ------------------------------------------
par(las = 1, mar = c(9, 5, 2, 1), mfrow = c(1, 2))
plot(0, 0, type = "n", xlim = c(-0.6, 0.3), ylim = c(-0.1, 5), xlab = "", ylab = "density", 
     main = "")
title(expression("Normal and flat prior density for "*theta), line = 0.7)
basicPlot(leg = FALSE, IntEffBoundary = effi, IntFutBoundary = futi, successmean = successmean, 
          priormean = priormean)
lines(thetas, dnorm(thetas, mean = log(hr0), sd = sd0), col = 2, lwd = 2)

# flat prior:
hr0flat <- 0.866
width1 <- 0.21
height1 <- 2.48

lines(thetas, dUniformNormalTails(thetas, mu = log(hr0flat), width = width1, height = height1), 
      lwd = 2, col = 3)

# ------------------------------------------
# computations for Normal prior
# ------------------------------------------

# prior probabilities to be below 0.7 or above 1:
lims <- c(0.7, 1)
pnorm1 <- plnorm(lims[1], meanlog = log(hr0), sdlog = sd0, lower.tail = TRUE, log.p = FALSE)   
# pnorm(log(lims[1]), mean = log(hr0), sd = sd0)
pnorm2 <- plnorm(lims[2], meanlog = log(hr0), sdlog = sd0, lower.tail = FALSE, log.p = FALSE)  
# 1 - pnorm(log(lims[2]), mean = log(hr0), sd = sd0)

# initial bpp
bpp0 <- bpp(prior = "normal", successmean = successmean, finalSE = finalSE, 
            priormean = log(hr0), priorsigma = sd0)

# update prior with first external study
hr1 <- 0.396
sd1 <- 0.837
up1 <- NormalNormalPosterior(datamean = log(hr1), sigma = sd1, n = 1, 
                             nu = log(hr0), tau = sd0)
bpp1 <- bpp(prior = "normal", successmean = successmean, finalSE = finalSE, 
            priormean = up1$postmean, priorsigma = up1$postsigma)

# update prior with second external study (result derived from pooled analysis: 
# Cox regression on patient level, stratified by study):
hr2 <- 0.287
sd2 <- 0.658
up2 <- NormalNormalPosterior(datamean = log(hr2), sigma = sd2, n = 1, nu = log(hr0), tau = sd0)
bpp2 <- bpp(prior = "normal", successmean = successmean, finalSE = finalSE, 
            priormean = up2$postmean, priorsigma = up2$postsigma)

# compute bpp after not stopping at interim:
# assuming both boundaries:
bpp3.tmp <- bpp_1interim(prior = "normal", interimSE = sqrt(fac / nevents[1]), 
                         finalSE = finalSE, successmean = successmean, 
                         IntEffBoundary = effi, IntFutBoundary = futi, IntFix = log(1), 
                         priormean = up2$postmean, propA = 0.5, thetas, 
                         priorsigma = up2$postsigma)
bpp3 <- bpp3.tmp$"BPP after not stopping at interim interval"
post3 <- bpp3.tmp$"posterior density interval"

# assuming only efficacy boundary:
bpp3_effi_only <- bpp_1interim(prior = "normal", interimSE = sqrt(fac / nevents[1]), 
                               finalSE = finalSE, successmean = successmean, 
                               IntEffBoundary = effi, IntFutBoundary = log(Inf), IntFix = log(1), 
                               priormean = up2$postmean, propA = 0.5, thetas = thetas, 
                               priorsigma = 
                               up2$postsigma)$"BPP after not stopping at interim interval"

# assuming only futility boundary:
bpp3_futi_only <- bpp_1interim(prior = "normal", interimSE = sqrt(fac / nevents[1]), 
                               finalSE = finalSE, successmean = successmean, 
                               IntEffBoundary = log(0), IntFutBoundary = futi, IntFix = log(1), 
                               priormean = up2$postmean, propA = 0.5, thetas = thetas, 
                               priorsigma = 
                               up2$postsigma)$"BPP after not stopping at interim interval"

# assuming interim efficacy boundary: 
bpp4.tmp <- bpp_1interim(prior = "normal", interimSE = sqrt(fac / nevents[1]), 
                         finalSE = finalSE, successmean = successmean, IntEffBoundary = effi, 
                         IntFutBoundary = Inf, IntFix = c(effi, futi), priormean = up2$postmean, 
                         propA = 0.5, thetas, priorsigma = up2$postsigma)
bpp4 <- bpp4.tmp$"BPP after not stopping at interim exact"[2, 1]
post4 <- bpp4.tmp$"posterior density exact"[, 1]

# assuming interim futility boundary: 
bpp5.tmp <- bpp_1interim(prior = "normal", interimSE = sqrt(fac / nevents[1]), 
                         finalSE = finalSE, successmean = successmean, IntEffBoundary = effi, 
                         IntFutBoundary = Inf, IntFix = futi, priormean = up2$postmean, 
                         propA = 0.5, thetas, priorsigma = up2$postsigma)
bpp5 <- bpp5.tmp$"BPP after not stopping at interim exact"[2, 1]
post5 <- bpp5.tmp$"posterior density exact"     # same as post4[, 2]

# ------------------------------------------
# reproduce plots in paper
# ------------------------------------------

# first two updates
par(las = 1, mar = c(9, 5, 2, 1), mfrow = c(1, 2))
plot(0, 0, type = "n", xlim = c(-0.6, 0.3), ylim = c(-0.1, 5), xlab = "", ylab = "density", 
     main = "")
title(expression("Normal prior density and corresponding posteriors for "*theta), line = 0.7)
basicPlot(leg = FALSE, IntEffBoundary = effi, IntFutBoundary = futi, successmean = successmean, 
          priormean = priormean)
lines(thetas, dnorm(thetas, mean = log(hr0), sd = sd0), col = 2, lwd = 2)
lines(thetas, dnorm(thetas, mean = up1$postmean, sd = up1$postsigma), col = 3, lwd = 2)
lines(thetas, dnorm(thetas, mean = up2$postmean, sd = up2$postsigma), col = 4, lwd = 2)
lines(thetas, post3, col = 1, lwd = 2)
legend(-0.64, 5.2, c("prior", "posterior after Sub1", "posterior after Sub1 & Sub2", 
                     "posterior after Sub1 & Sub2 and not stopping at interim"), 
       lty = 1, col = c(2:4, 1), bty = "n", lwd = 2)

# posterior densities for interval knowledge and thetahat equal to boundaries:
plot(0, 0, type = "n", xlim = c(-0.6, 0.3), ylim = c(-0.1, 8), xlab = "", ylab = "density", 
     main = "")
title(expression("Posteriors for "*theta*" after not stopping at interim, for Normal prior"), 
      line = 0.7)
basicPlot(leg = FALSE, IntEffBoundary = effi, IntFutBoundary = futi, successmean = successmean, 
          priormean = priormean)
lines(thetas, post3, col = 1, lwd = 2)
lines(thetas, post4, col = 2, lwd = 2)
lines(thetas, post5, col = 3, lwd = 2)

leg2 <- c("interval knowledge", 
          expression(hat(theta)*" = efficacy boundary"), 
          expression(hat(theta)*" = futility boundary")
)

legend(-0.62, 8.2, leg2, lty = 1, col = 1:3, lwd = 2, bty = "n", 
       title = "posterior after not stopping at interim,")

# ------------------------------------------------------------------------------------------
# Reproduce all the computations in Rufibach et al (2016a) for flat prior.
# ------------------------------------------------------------------------------------------

# ------------------------------------------
# set all parameters first:
# ------------------------------------------

# parameters of flat prior:
priormean <- log(hr0flat)

# ------------------------------------------
# computations for flat prior
# ------------------------------------------

# prior probabilities to be below 0.7 or above 1:
lims <- c(0.7, 1)
flat1 <- pUniformNormalTails(x = log(lims[1]), mu = priormean, width = width1, height = height1)
flat2 <- 1 - pUniformNormalTails(x = log(lims[2]), mu = priormean, 
                                 width = width1, height = height1)

# prior
bpp0_1 <- bpp(prior = "flat", successmean = successmean, finalSE = finalSE, 
              priormean = priormean, width = width1, height = height1)

# update with first external study
hr1 <- 0.396
sd1 <- 0.837
bpp1_1 <- integrate(FlatNormalPosterior, lower = -Inf, upper = Inf, successmean = successmean, 
                     finalSE = finalSE, interimmean = log(hr1), interimSE = sd1, 
                     priormean = priormean, width = width1, height = height1)$value

# update prior (result derived from pooled analysis: Cox regression on patient level, 
# stratified by study)
hr2 <- 0.287
sd2 <- 0.658
bpp2_1 <- integrate(FlatNormalPosterior, -Inf, Inf, successmean = successmean, 
                     finalSE = finalSE, interimmean = log(hr2), 
                     interimSE = sd2, priormean = priormean, 
                     width = width1, height = height1)$value

# update after not stopping at interim
# first compute synthesized prior:
hr0 <- 0.85
sd0 <- 0.11
up2 <- NormalNormalPosterior(datamean = log(hr2), sigma = sd2, n = 1, nu = log(hr0), tau = sd0)

# assuming both boundaries:
bpp3.tmp_1 <- bpp_1interim(prior = "flat", interimSE = sqrt(fac / nevents[1]), 
                         finalSE = finalSE, successmean = successmean, 
                         IntEffBoundary = effi, IntFutBoundary = futi, IntFix = log(1), 
                         priormean = up2$postmean, propA = 0.5, thetas, 
                         width = width1, height = height1)
bpp3_1 <- bpp3.tmp_1$"BPP after not stopping at interim interval"
post3_1 <- bpp3.tmp_1$"posterior density interval"

# assuming only efficacy boundary:
bpp3_1_effi_only <- bpp_1interim(prior = "flat", interimSE = sqrt(fac / nevents[1]), 
                               finalSE = finalSE, successmean = successmean, 
                               IntEffBoundary = effi, IntFutBoundary = log(Inf), IntFix = log(1), 
                               priormean = up2$postmean, propA = 0.5, thetas = thetas, 
                               width = width1, 
                               height = height1)$"BPP after not stopping at interim interval"

# assuming only futility boundary:
bpp3_1_futi_only <- bpp_1interim(prior = "flat", interimSE = sqrt(fac / nevents[1]), 
                               finalSE = finalSE, successmean = successmean, 
                               IntEffBoundary = log(0), IntFutBoundary = futi, IntFix = log(1), 
                               priormean = up2$postmean, propA = 0.5, thetas = thetas, 
                               width = width1, 
                               height = height1)$"BPP after not stopping at interim interval"

# assuming interim efficacy boundary: 
bpp4_1.tmp <- bpp_1interim(prior = "flat", interimSE = sqrt(fac / nevents[1]), 
                               finalSE = finalSE, successmean = successmean, 
                               IntEffBoundary = log(0), IntFutBoundary = effi, IntFix = effi, 
                               priormean = up2$postmean, propA = 0.5, thetas = thetas, 
                               width = width1, height = height1)
bpp4_1 <- bpp4_1.tmp$"BPP after not stopping at interim exact"[2, 1]
post4_1 <- bpp4_1.tmp$"posterior density exact"

# assuming interim futility boundary: 
bpp5_1 <- integrate(Vectorize(estimate_toIntegrate), lower = -Inf, upper = Inf, prior = "flat",
                    successmean = successmean, finalSE = finalSE, interimmean = futi, 
                    interimSE = sqrt(fac / nevents[1]), priormean = up2$postmean, width = width1, 
                    height = height1)$value


bpp5_1.tmp <- bpp_1interim(prior = "flat", interimSE = sqrt(fac / nevents[1]), 
                               finalSE = finalSE, successmean = successmean, 
                               IntEffBoundary = log(0), IntFutBoundary = effi, IntFix = futi, 
                               priormean = up2$postmean, propA = 0.5, thetas = thetas, 
                               width = width1, height = height1)
bpp5_1 <- bpp5_1.tmp$"BPP after not stopping at interim exact"[2, 1]
post5_1 <- bpp5_1.tmp$"posterior density exact"


# ------------------------------------------
# plots for flat prior
# ------------------------------------------

# first two updates with external studies
# compute posteriors
flatpost1 <- rep(NA, length(thetas))
flatpost2 <- flatpost1
for (i in 1:length(thetas)){
  flatpost1[i] <- estimate_posterior(x = thetas[i], prior = "flat", interimmean = log(hr1), 
                                     interimSE = sd1, priormean = priormean, 
                                     width = width1, height = height1)
  flatpost2[i] <- estimate_posterior(x = thetas[i], prior = "flat", interimmean = log(hr2), 
                                     interimSE = sd2, priormean = priormean, 
                                     width = width1, height = height1)
}

par(las = 1, mar = c(9, 5, 2, 1), mfrow = c(1, 2))
plot(0, 0, type = "n", xlim = c(-0.6, 0.3), ylim = c(-0.10, 5), xlab = "", ylab = "density", 
     main = "")
title(expression("Flat prior density and corresponding posteriors for "*theta), line = 0.7)
basicPlot(leg = FALSE, IntEffBoundary = effi, IntFutBoundary = futi, successmean = successmean, 
          priormean = priormean)
lines(thetas, dUniformNormalTails(thetas, mu = priormean, width = width1, height = height1), 
      lwd = 2, col = 2)
lines(thetas, flatpost1, col = 3, lwd = 2)
lines(thetas, flatpost2, col = 4, lwd = 2)
lines(thetas, post3_1, col = 1, lwd = 2)

legend(-0.64, 5.2, c("prior", "posterior after Sub1", "posterior after Sub1 & Sub2", 
                     "posterior after Sub1 & Sub2 and not stopping at interim"), lty = 1, 
                     col = c(2:4, 1), bty = "n", lwd = 2)

# posterior densities for interval knowledge and thetahat equal to boundaries:
plot(0, 0, type = "n", xlim = c(-0.6, 0.3), ylim = c(-0.10, 8), xlab = "", ylab = "density", 
     main = "")
title(expression("Posteriors for "*theta*" after not stopping at interim, for Flat prior"), 
      line = 0.7)
basicPlot(leg = FALSE, IntEffBoundary = effi, IntFutBoundary = futi, successmean = successmean, 
          priormean = priormean)
lines(thetas, post3_1, col = 1, lwd = 2)
lines(thetas, post4_1, col = 2, lwd = 2)
lines(thetas, post5_1, col = 3, lwd = 2)

leg.flat <- c("interval knowledge", 
              expression(hat(theta)*" = efficacy boundary"), 
              expression(hat(theta)*" = futility boundary")
)

legend(-0.62, 8.2, leg.flat, lty = 1, col = 1:3, lwd = 2, bty = "n", 
       title = "posterior after not stopping at interim,")

# ------------------------------------------
# reproduce Table 1 in Rufibach et al (2016a)
# ------------------------------------------
mat <- matrix(NA, ncol = 2, nrow = 10)
mat[, 1] <- c(pnorm1, pnorm2, bpp0, bpp1, bpp2, bpp3, bpp3_futi_only, bpp3_effi_only, 
              bpp4, bpp5)
mat[, 2] <- c(flat1, flat2, bpp0_1, bpp1_1, bpp2_1, bpp3_1, bpp3_1_futi_only, 
              bpp3_1_effi_only, bpp4_1, bpp5_1)
colnames(mat) <- c("Normal prior", "Flat prior")
rownames(mat) <- c(paste("Probability for hazard ratio to be $le$ ", lims[1], sep = ""), 
paste("Probability for hazard ratio to be $ge$ ", lims[2], sep = ""), 
"PoS based on prior distribution", "PoS after Sub1", "PoS after Sub1 and Sub2", 
"PoS after not stopping at interim, assuming $inte{hat theta} in [effi{theta}, futi{theta}]$", 
"PoS after not stopping at interim, assuming $inte{hat theta} in [-infty, futi{theta}]$", 
"PoS after not stopping at interim, assuming $inte{hat theta} in [effi{theta}, infty]$", 
"PoS after not stopping at interim, assuming $inte{hat theta} = effi{theta}$", 
"PoS after not stopping at interim, assuming $inte{hat theta} = futi{theta}$")
as.data.frame(format(mat, digits = 2))

# }

Run the code above in your browser using DataLab