inst/ppseq-package-paper/zabor-hobbs-kane.R

In zabore/ppseq: Design Clinical Trials using Sequential Predictive Probability Monitoring

# Generated by `rjournal_article()` using `knitr::purl()`: do not edit by hand
# Please edit zabor-hobbs-kane.Rmd to modify this file

## ----setup, include=FALSE-----------------------------------------------------
knitr::opts_chunk$set(echo = TRUE, warning = FALSE, message = FALSE)
library(plotly)
library(ggplot2)
library(patchwork)


## ----eval = FALSE-------------------------------------------------------------
#> install.packages("ppseq")


## -----------------------------------------------------------------------------
library(ppseq)


## ----message = FALSE----------------------------------------------------------
set.seed(123)

cal_thresh <-
  calibrate_thresholds(
    p_null = 0.1, 
    p_alt = 0.4,
    n = seq(5, 15, 5), 
    N = 15,
    pp_threshold = c(0.85, 0.9),
    ppp_threshold = c(0.1, 0.2),
    S = 50, 
    nsim = 50
    )


## -----------------------------------------------------------------------------
print(cal_thresh)


## -----------------------------------------------------------------------------
optimize_design(cal_thresh, type1_range = c(0.025, 0.1), minimum_power = 0.75)


## -----------------------------------------------------------------------------
calc_decision_rules(
  n = seq(5, 15, 5), 
  N = 15,
  theta = 0.9,
  ppp = 0.2,
  p0 = 0.1,
  S = 50
)


## ----eval = FALSE-------------------------------------------------------------
#> library(future)
#> 
#> set.seed(123)
#> 
#> future::plan(future::multicore(workers = 40))
#> 
#> two_sample_cal_tbl <-
#>   calibrate_thresholds(
#>     p_null = c(0.1, 0.1),
#>     p_alt = c(0.1, 0.25),
#>     n = cbind(seq(10, 50, 10), seq(10, 50, 10)),
#>     N = c(50, 50),
#>     pp_threshold = seq(0.9, 0.99, 0.01),
#>     ppp_threshold = seq(0.05, 0.2, 0.05),
#>     direction = "greater",
#>     delta = 0,
#>     prior = c(0.5, 0.5),
#>     S = 5000,
#>     nsim = 1000
#>   )


## ----eval = FALSE-------------------------------------------------------------
#> plot(
#>   two_sample_cal_tbl,
#>   type1_range = c(0.05, 0.1),
#>   minimum_power = 0.7,
#>   plotly = TRUE
#> )


## ----echo = FALSE, message = FALSE, fig.width = 8, fig.height = 4.4, out.width = "110%", include = knitr::is_latex_output(), eval = knitr::is_latex_output(), fig.cap = "Plot of design options made with the {ggplot2} package. The accuracy designs are on the left and the efficiency designs are on the right. The color represents the Euclidean distance to the top left point and the optimal design is indicated by a diamond."----
p <- plot(
  two_sample_cal_tbl,
  type1_range = c(0.05, 0.1),
  minimum_power = 0.7,
  plotly = FALSE
  )

# change limits based on reviewer comment
p1_v2 <- 
  p[[1]] + 
  scale_x_continuous(limits = c(0.05, 0.1), breaks = seq(0.05, 0.1, 0.01)) + 
  scale_y_continuous(limits = c(0.7, 1), breaks = seq(0.7, 1, 0.05))
p2_v2 <-
  p[[2]] +
  scale_x_continuous(limits = c(26, 30)) + 
  scale_y_continuous(limits = c(43, 47))

p1_v2 + p2_v2


## ----echo = FALSE, include=knitr::is_html_output(), eval=knitr::is_html_output(), fig.cap = "Plot of efficiency design options made with the {plotly} package. The color represents the Euclidean distance to the top left point and the optimal design is indicated by a diamond. A similar plot is available for the accuracy design options."----
#> p <- plot(
#>   two_sample_cal_tbl,
#>   type1_range = c(0.05, 0.1),
#>   minimum_power = 0.7,
#>   plotly = FALSE
#>   )
#> p2_v2 <-
#>   p[[2]] +
#>   scale_x_continuous(limits = c(26, 30)) +
#>   scale_y_continuous(limits = c(43, 47))
#> 
#> # Right now only including the efficiency design plot in the html paper version
#> ggplotly(p2_v2)


## -----------------------------------------------------------------------------
optimize_design(
  two_sample_cal_tbl, 
  type1_range = c(0.05, 0.1), 
  minimum_power = 0.7
)


## ----eval = FALSE-------------------------------------------------------------
#> set.seed(123)
#> 
#> two_sample_decision_tbl <-
#>   calc_decision_rules(
#>     n = cbind(seq(10, 50, 10), seq(10, 50, 10)),
#>     N = c(50, 50),
#>     theta = 0.92,
#>     ppp = 0.05,
#>     p0 = NULL,
#>     direction = "greater",
#>     delta = 0,
#>     prior = c(0.5, 0.5),
#>     S = 5000
#>     )


## ----message = FALSE, fig.height = 6, fig.width = 6, include = knitr::is_latex_output(), eval = knitr::is_latex_output(), fig.cap = "Plot of decision rules made with ggplot. The color indicates whether the trial should stop or proceed for a given number of responses at each interim analysis."----
dtp <- plot(two_sample_decision_tbl, plotly = FALSE)

dtp + 
  theme(legend.position="bottom")


## ----message = FALSE, fig.height = 6, fig.width = 8, include=knitr::is_html_output(), eval=knitr::is_html_output(), fig.cap = "Plot of decision rules made with plotly. The color indicates whether the trial should stop or proceed for a given number of responses at each interim analysis."----
#> plot(two_sample_decision_tbl)

```{.r .distill-force-highlighting-css}
```