Design plots a clinical trial
Here we show how to create outcome and operating characteristic plots for a clinical trial comparing a developmental drug against placebo. The primary endpoint is binary (with event probability \(p\)) and we use an informative prior for the placebo arm event rate. The experimental drug is believed to lower the event rate, and the criteria for study outcome are hence as follows:
\[
\begin{align*}
\textrm{Criterion 1:} \Pr(p_{trt} / p_{pbo} < 1) &> 0.9\\
\textrm{Criterion 2:} \Pr(p_{trt} / p_{pbo} < 0.5) &> 0.5
\end{align*}
\]
The outcome is success (GO) if both criteria are satisfied, futility (STOP) if neither is satisfied, and indeterminate if only one or the other is satisfied.
We now create a plot that shows the study conclusion, given any combination of outcomes on the two treatment arms.
# Define prior distributions
prior_pbo <- mixbeta(inf1=c(0.60, 19, 29), inf2=c(0.30, 4, 5), rob=c(0.10, 1, 1))
prior_trt <- mixbeta(c(1, 1/3, 1/3))
# Study sample size
n_trt <- 50
n_pbo <- 20
# Create decision rules and designs to represent success and futility
success <- decision2S(pc=c(0.90, 0.50), qc=c(log(1), log(0.50)), lower.tail=TRUE, link="log")
futility <- decision2S(pc=c(0.10, 0.50), qc=c(log(1), log(0.50)), lower.tail=FALSE, link="log")
design_suc <- oc2S(prior_trt, prior_pbo, n_trt, n_pbo, success)
design_fut <- oc2S(prior_trt, prior_pbo, n_trt, n_pbo, futility)
crit_suc <- decision2S_boundary(prior_trt, prior_pbo, n_trt, n_pbo, success)
crit_fut <- decision2S_boundary(prior_trt, prior_pbo, n_trt, n_pbo, futility)
# Create a data frame that holds the outcomes for y1 (treatment) that define success and futility,
# conditional on the number of events on y2 (placebo)
outcomes <- data.frame(y2=c(0:n_pbo), suc=crit_suc(0:n_pbo), fut=crit_fut(0:n_pbo), max=n_trt)
outcomes$suc <- with(outcomes, ifelse(suc<0, 0, suc)) # don't allow negative number of events
# Finally put it all together in a plot.
o <- 0.5 # offset
ggplot(outcomes, aes(x=y2, ymin=-o, ymax=suc+o)) + geom_linerange(size=4, colour="green", alpha=0.6) +
geom_linerange(aes(ymin=suc+o, ymax=fut+o), colour="orange", size=4, alpha=0.6) +
geom_linerange(aes(ymin=fut+o, ymax=max+o), colour="red", size=4, alpha=0.6) +
annotate("text", x=c(2,14), y=c(36,8), label=c("STOP", "GO"), size=10) +
scale_x_continuous(breaks=seq(0,n_pbo,by=2)) +
scale_y_continuous(breaks=seq(0,n_trt,by=4)) +
labs(x="Events on placebo", y="Events on treatment", title="Study outcomes") +
coord_flip() + theme_bw(base_size=12)
We can also use the design functions that were already derived (design_suc and design_fut) to compute operating characteristics.
# Define the grid of true event rates for which to evaluate OC
p_trt <- seq(0, 0.5, length=200)
p_pbo <- c(0.35, 0.40, 0.45, 0.50)
# Loop through the values for placebo and compute outcome probabilities
oc_list <- lapply(p_pbo, function(x) {
p_go <- design_suc(p_trt, x)
p_stop <- design_fut(p_trt, x)
data.frame(p_trt, p_pbo=x, Go=p_go, Stop=p_stop, Indeterminate=1-p_go-p_stop)
})
# The above returns a list, so we bind the elements together into one data frame
oc <- bind_rows(oc_list)
# And convert from wide to long format
oc <- gather(oc, "Outcome", "Probability", 3:5)
oc$facet_text <- as.factor(paste("True placebo rate = ", oc$p_pbo, sep=""))
# Finally we are ready to plot
ggplot(oc, aes(x=p_trt, y=Probability, colour=Outcome, linetype=Outcome)) +
facet_wrap(~facet_text) + geom_line(size=1) +
scale_colour_manual(values=c("green", "orange", "red"), name="Outcome") +
scale_linetype(guide=FALSE) +
geom_hline(yintercept=c(0.1, 0.8), linetype=3) +
scale_y_continuous(breaks=seq(0, 1, by=0.2)) +
labs(x="True event rate for treatment", y="Probability", title="Operating Characteristics") +
theme_bw(base_size=12)
## R version 3.6.1 (2019-07-05)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Ubuntu 16.04.6 LTS
##
## Matrix products: default
## BLAS: /usr/lib/libblas/libblas.so.3.6.0
## LAPACK: /usr/lib/lapack/liblapack.so.3.6.0
##
## locale:
## [1] C
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] tidyr_1.0.0 scales_1.0.0 ggplot2_3.2.1 purrr_0.3.3
## [5] dplyr_0.8.3 bayesplot_1.7.0 knitr_1.25 RBesT_1.6-1
## [9] Rcpp_1.0.2
##
## loaded via a namespace (and not attached):
## [1] rstan_2.19.2 tidyselect_0.2.5 xfun_0.10
## [4] reshape2_1.4.3 vctrs_0.2.0 colorspace_1.4-1
## [7] htmltools_0.4.0 stats4_3.6.1 loo_2.1.0
## [10] yaml_2.2.0 rlang_0.4.0 pkgbuild_1.0.6
## [13] pillar_1.4.2 glue_1.3.1 withr_2.1.2
## [16] lifecycle_0.1.0 matrixStats_0.55.0 plyr_1.8.4
## [19] stringr_1.4.0 munsell_0.5.0 gtable_0.3.0
## [22] mvtnorm_1.0-11 codetools_0.2-16 evaluate_0.14
## [25] labeling_0.3 inline_0.3.15 callr_3.3.2
## [28] ps_1.3.0 parallel_3.6.1 highr_0.8
## [31] backports_1.1.5 checkmate_1.9.4 StanHeaders_2.19.0
## [34] gridExtra_2.3 digest_0.6.21 stringi_1.4.3
## [37] processx_3.4.1 grid_3.6.1 cli_1.1.0
## [40] tools_3.6.1 magrittr_1.5 lazyeval_0.2.2
## [43] tibble_2.1.3 Formula_1.2-3 zeallot_0.1.0
## [46] crayon_1.3.4 pkgconfig_2.0.3 ellipsis_0.3.0
## [49] prettyunits_1.0.2 ggridges_0.5.1 assertthat_0.2.1
## [52] rmarkdown_1.16 R6_2.4.0 compiler_3.6.1
