--- title: "Reproduce Results From Fujikawa et al. (2020)" author: "Lukas Baumann" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Reproduce Results From Fujikawa et al. (2020)} %\VignetteEncoding{UTF-8} %\VignetteEngine{knitr::rmarkdown} editor_options: chunk_output_type: console --- ```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ``` In this vignette it is shown how the results from Fujikawa et al. (2020) can be reproduced using `baskexact`. At first, we have to set up a a design object, using either `setupOneStageBasket()` for a single-stage design or `setupTwoStageBasket()`for a two-stage design with one interim analysis. ```{r setup, eval=FALSE} library(baskexact) design1 <- setupOneStageBasket(k = 3, shape1 = 1, shape2 = 1, p0 = 0.2) ``` To get the results shown in Figure 1, `basket_test()` can be used, which computes posterior probabilities for a given results-vector and also shows the pairwise weights and the parameters of the Beta posterior distribution. ```{r, eval=FALSE} basket_test(design1, n = 15, r = c(1, 5, 7), lambda = 0.99, weight_fun = weights_fujikawa, weight_params = list(epsilon = 2, tau = 0.5, logbase = exp(1))) # $weights # Basket 1 Basket 2 Basket 3 # Basket 1 1 0.0000000 0.0000000 # Basket 2 0 1.0000000 0.7832585 # Basket 3 0 0.7832585 1.0000000 # # $post_dist_noborrow # Basket 1 Basket 2 Basket 3 # shape1 2 6 8 # shape2 15 11 9 # # $post_dist_borrow # Basket 1 Basket 2 Basket 3 # shape1 2 12.26607 12.69955 # shape2 15 18.04933 17.61584 # # $post_prob_noborrow # Basket 1 Basket 2 Basket 3 # 0.1407375 0.9183121 0.9929964 # # $post_prob_borrow # Basket 1 Basket 2 Basket 3 # 0.1407375 0.9942795 0.9965258 ``` Note that at the moment it's not possible to reproduce the results from Table 1, as `baskexact` currently doesn't support baskets with unequal sample sizes. To reproduce the results from Table 2 we can use `toer()` and `pow()`. First, the results from the single-stage design with two different choices of tuning parameter values. Fujikawa et al.'s "Proposed design (i)" uses $\varepsilon = 2$ and $\tau = 0$, "Proposed design (ii)" uses $\varepsilon = 2$ and $\tau = 0.5$. Note that the default value for the logbase parameter is 2, such that the weights are always bounded between 0 and 1, but Fujikawa et al. use the natural logarithm, which leads to a lower limit for the weights that is strictly greater than 0. ```{r, eval=FALSE} ## p = (0.2, 0.2, 0.2) # Proposed design (i) toer( design = design1, n = 24, lambda = 0.99, weight_fun = weights_fujikawa, weight_params = list(epsilon = 2, tau = 0, logbase = exp(1)), results = "group" ) # $rejection_probabilities # [1] 0.02158174 0.02158174 0.02158174 # # $fwer # [1] 0.03600149 # Proposed design (ii) toer( design = design1, n = 24, lambda = 0.99, weight_fun = weights_fujikawa, weight_params = list(epsilon = 2, tau = 0.5, logbase = exp(1)), results = "group" ) # $rejection_probabilities # [1] 0.03239555 0.03239555 0.03239555 # # $fwer # [1] 0.06315308 ``` For the results from the two-stage design, we have to set up a different design object at first: ```{r, eval=FALSE} design2 <- setupTwoStageBasket(k = 3, shape1 = 1, shape2 = 1, p0 = 0.2) ``` Fujikawa et al. use an interim analysis that allows stopping of individual baskets based on the posterior predictive probability. ```{r, eval = FALSE} ## p = (0.2, 0.2, 0.2) # Proposed design (i) toer( design = design2, n = 24, n1 = 15, lambda = 0.99, interim_fun = interim_postpred, interim_params = list(prob_futstop = 0.1, prob_effstop = 0.9), weight_fun = weights_fujikawa, weight_params = list(logbase = exp(1), tau = 0, epsilon = 2), results = "group" ) # $rejection_probabilities # [1] 0.01703198 0.01703198 0.01703198 # # $fwer # [1] 0.03722851 ess( design = design2, n = 24, n1 = 15, lambda = 0.99, interim_fun = interim_postpred, interim_params = list(prob_futstop = 0.1, prob_effstop = 0.9), weight_fun = weights_fujikawa, weight_params = list(logbase = exp(1), tau = 0, epsilon = 2) ) # [1] 16.06847 16.06847 16.06847 # Proposed design (ii) toer( design = design2, n = 24, n1 = 15, lambda = 0.99, interim_fun = interim_postpred, interim_params = list(prob_futstop = 0.1, prob_effstop = 0.9), weight_fun = weights_fujikawa, weight_params = list(logbase = exp(1), tau = 0.5, epsilon = 2), results = "group" ) # $rejection_probabilities # [1] 0.02175429 0.02175429 0.02175429 # # $fwer # [1] 0.04955128 ess( design = design2, n = 24, n1 = 15, lambda = 0.99, interim_fun = interim_postpred, interim_params = list(prob_futstop = 0.1, prob_effstop = 0.9), weight_fun = weights_fujikawa, weight_params = list(logbase = exp(1), tau = 0.5, epsilon = 2) ) # [1] 16.22526 16.22526 16.22526 ``` To reproduce the rest of Table 2, `p1` has to be changed accordingly. Note that the results are slightly different, as Fujikawa et al.'s results are based on simulation with $n_{\text{sim}} = 5000$. `baskexact` calculates the results analytically. ## References Fujikawa, K., Teramukai, S., Yokota, I., & Daimon, T. (2020). A Bayesian basket trial design that borrows information across strata based on the similarity between the posterior distributions of the response probability. Biometrical Journal, 62(2), 330-338.