---
title: "Test of the function gs_design_npe"
output:
  rmarkdown::html_document:
    toc: true
    toc_float: true
    toc_depth: 2
    number_sections: true
    highlight: "textmate"
    css: "custom.css"
# bibliography: "example.bib"
vignette: >
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteIndexEntry{Test of the function gs_design_npe}
---

```{r, message=FALSE}
library(tibble)
library(dplyr)
library(testthat)
library(gt)
devtools::load_all()
```

```{r, warning=FALSE, message=FALSE}
setwd("./..")
my_path <- "./old_function/"
source_files <- list.files(my_path, "*.R$")
sapply(paste0(my_path, source_files), source)
```

# Test 1: verify by `gs_power_npe` {.tabset}

## new version

```{r}
x <- gs_design_npe(
  theta = c(.1, .2, .3), info = (1:3) * 40, beta = 0.1,
  upper = gs_spending_bound,
  upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL),
  lower = gs_spending_bound,
  lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), binding = TRUE
)
x %>% gt()
```

The power is 0.9. If we re-use these bounds under alternate hypothesis, then we can get a power close to 0.9.

```{r}
gs_power_npe(
  theta = c(.1, .2, .3), info = (1:3) * 40,
  upper = gs_b, upar = (x %>% filter(bound == "upper"))$z,
  lower = gs_b, lpar = -(x %>% filter(bound == "upper"))$z,
  binding = TRUE # Always use binding = TRUE for power calculations
) %>% gt()
```

## old version

```{r}
x <- gs_design_npe_(
  theta = c(.1, .2, .3), info = (1:3) * 40, beta = 0.1,
  upper = gs_spending_bound,
  upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL),
  lower = gs_spending_bound,
  lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), binding = TRUE
)
x %>% gt()
```

The power is 0.9. If we re-use these bounds under alternate hypothesis, then we can get a power close to 0.9.

```{r}
gs_power_npe_(
  theta = c(.1, .2, .3), info = (1:3) * 40,
  upper = gs_b, upar = (x %>% filter(Bound == "Upper"))$Z,
  lower = gs_b, lpar = -(x %>% filter(Bound == "Upper"))$Z,
  binding = TRUE # Always use binding = TRUE for power calculations
) %>% gt()
```

# Test 1: examples in spec {.tabset}

## difference of proportions

```{r}
# Lachin book p71
pc <- .28 # Control response rate
pe <- .40 # Experimental response rate
p0 <- (pc + pe) / 2 # Ave response rate under H0

# Information per increment of 1 in sample size
info0 <- 1 / (p0 * (1 - p0) * 4)
info <- 1 / (pc * (1 - pc) * 2 + pe * (1 - pe) * 2)

# Result should round up to next even number = 652
# Divide information needed under H1 by information per patient added
x1_a <- gs_design_npe(theta = pe - pc, info = info, info0 = info0, info_scale = 0) %>% mutate(`Computated from` = "new version", `Info scale` = 0)
x1_b <- gs_design_npe(theta = pe - pc, info = info, info0 = info0, info_scale = 1) %>% mutate(`Computated from` = "new version", `Info scale` = 1)
x1_c <- gs_design_npe(theta = pe - pc, info = info, info0 = info0, info_scale = 2) %>% mutate(`Computated from` = "new version", `Info scale` = 2)

x2 <- gs_design_npe_(theta = pe - pc, info = info, info0 = info0) %>% 
  mutate(`Computated from` = "old version") %>% 
  rename(analysis = Analysis,
         bound = Bound, z = Z, probability = Probability)
```

```{r, echo=FALSE}
x1_a %>%
  union_all(x1_b) %>%
  union_all(x1_c) %>%
  union_all(x2) %>%
  gt() %>%
  tab_style(
    style = list(cell_fill(color = "#d3edeb")),
    locations = cells_body(rows = `Computated from` == "old version")
  )
```

## fixed design {.tabset}

### `info` = `info0` = `info1`

```{r}
x1_a <- gs_design_npe(
  theta = c(.1, .2, .3),
  info = (1:3) * 80, info_scale = 0,
  upper = gs_b, upar = gsDesign::gsDesign(k = 3, sfu = gsDesign::sfLDOF)$upper$bound,
  lower = gs_b, lpar = c(-1, 0, 0)
) %>% mutate(`Computated from` = "new version", `Info scale` = 0)
x1_b <- gs_design_npe(
  theta = c(.1, .2, .3),
  info = (1:3) * 80, info_scale = 1,
  upper = gs_b, upar = gsDesign::gsDesign(k = 3, sfu = gsDesign::sfLDOF)$upper$bound,
  lower = gs_b, lpar = c(-1, 0, 0)
) %>% mutate(`Computated from` = "new version", `Info scale` = 1)
x1_c <- gs_design_npe(
  theta = c(.1, .2, .3),
  info = (1:3) * 80, info_scale = 2,
  upper = gs_b, upar = gsDesign::gsDesign(k = 3, sfu = gsDesign::sfLDOF)$upper$bound,
  lower = gs_b, lpar = c(-1, 0, 0)
) %>% mutate(`Computated from` = "new version", `Info scale` = 2)

x2 <- gs_design_npe_(
  theta = c(.1, .2, .3),
  info = (1:3) * 80,
  upper = gs_b, upar = gsDesign::gsDesign(k = 3, sfu = gsDesign::sfLDOF)$upper$bound,
  lower = gs_b, lpar = c(-1, 0, 0)) %>% 
  mutate(`Computated from` = "old version") %>% 
  rename(analysis = Analysis,
         bound = Bound, z = Z, probability = Probability)
```

```{r, echo=FALSE}
x1_a %>%
  union_all(x1_b) %>%
  union_all(x1_c) %>%
  union_all(x2) %>%
  arrange(analysis) %>%
  group_by(analysis, bound) %>%
  gt() %>%
  tab_style(
    style = list(cell_fill(color = "#d3edeb")),
    locations = cells_body(rows = `Computated from` == "old version")
  )
```

### `info` != `info0` != `info1`

```{r}
x1_a <- gs_design_npe(
  theta = c(.1, .2, .3),
  info = (1:3) * 80, info0 = (1:3) * 90 + 10, info1 = (1:3) * 70 - 5, info_scale = 0,
  upper = gs_b, upar = gsDesign::gsDesign(k = 3, sfu = gsDesign::sfLDOF)$upper$bound,
  lower = gs_b, lpar = c(-1, 0, 0)
) %>% mutate(`Computated from` = "new version", `Info scale` = 0)
x1_b <- gs_design_npe(
  theta = c(.1, .2, .3),
  info = (1:3) * 80, info0 = (1:3) * 90 + 10, info1 = (1:3) * 70 - 5, info_scale = 1,
  upper = gs_b, upar = gsDesign::gsDesign(k = 3, sfu = gsDesign::sfLDOF)$upper$bound,
  lower = gs_b, lpar = c(-1, 0, 0)
) %>% mutate(`Computated from` = "new version", `Info scale` = 1)
x1_c <- gs_design_npe(
  theta = c(.1, .2, .3),
  info = (1:3) * 80, info0 = (1:3) * 90 + 10, info1 = (1:3) * 70 - 5, info_scale = 2,
  upper = gs_b, upar = gsDesign::gsDesign(k = 3, sfu = gsDesign::sfLDOF)$upper$bound,
  lower = gs_b, lpar = c(-1, 0, 0)
) %>% mutate(`Computated from` = "new version", `Info scale` = 2)

x2 <- gs_design_npe_(
  theta = c(.1, .2, .3),
  info = (1:3) * 80, info0 = (1:3) * 90 + 10, info1 = (1:3) * 70 - 5,
  upper = gs_b, upar = gsDesign::gsDesign(k = 3, sfu = gsDesign::sfLDOF)$upper$bound,
  lower = gs_b, lpar = c(-1, 0, 0)) %>% 
  mutate(`Computated from` = "old version") %>% 
  rename(analysis = Analysis,
         bound = Bound, z = Z, probability = Probability)
```

```{r, echo=FALSE}
x1_a %>%
  union_all(x1_b) %>%
  union_all(x1_c) %>%
  union_all(x2) %>%
  arrange(analysis) %>%
  group_by(analysis, bound) %>%
  gt() %>%
  tab_style(
    style = list(cell_fill(color = "#d3edeb")),
    locations = cells_body(rows = `Computated from` == "old version")
  )
```

## futility at IA1; efficacy only at IA2 +FA

```{r}
x1_a <- gs_design_npe(
  theta = c(.1, .2, .3),
  info = (1:3) * 40, info0 = (1:3) * 40, info_scale = 0,
  upper = gs_spending_bound, upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL),
  lower = gs_b, lpar = c(-1, -Inf, -Inf),
  test_upper = c(FALSE, TRUE, TRUE)
) %>% mutate(`Computated from` = "new version", `Info scale` = 0)

x1_b <- gs_design_npe(
  theta = c(.1, .2, .3),
  info = (1:3) * 40, info0 = (1:3) * 40, info_scale = 1,
  upper = gs_spending_bound, upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL),
  lower = gs_b, lpar = c(-1, -Inf, -Inf),
  test_upper = c(FALSE, TRUE, TRUE)
) %>% mutate(`Computated from` = "new version", `Info scale` = 1)

x1_c <- gs_design_npe(
  theta = c(.1, .2, .3),
  info = (1:3) * 40, info0 = (1:3) * 40, info_scale = 2,
  upper = gs_spending_bound, upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL),
  lower = gs_b, lpar = c(-1, -Inf, -Inf),
  test_upper = c(FALSE, TRUE, TRUE)
) %>% mutate(`Computated from` = "new version", `Info scale` = 2)

x2 <- gs_design_npe_(
  theta = c(.1, .2, .3),
  info = (1:3) * 40, info0 = (1:3) * 40,
  upper = gs_spending_bound, upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL),
  lower = gs_b, lpar = c(-1, -Inf, -Inf),
  test_upper = c(FALSE, TRUE, TRUE)) %>% 
  mutate(`Computated from` = "old version", `Info scale` = 0) %>% 
  rename(analysis = Analysis,
         bound = Bound, z = Z, probability = Probability)
```

```{r}
x1_a %>%
  union_all(x1_b) %>%
  union_all(x1_c) %>%
  union_all(x2) %>%
  arrange(analysis) %>%
  group_by(analysis, bound) %>%
  gt() %>%
  tab_style(
    style = list(cell_fill(color = "#d3edeb")),
    locations = cells_body(rows = `Computated from` == "old version")
  )
```

## spending bounds

```{r}
x1_a <- gs_design_npe(
  theta = c(.1, .2, .3),
  info = (1:3) * 40, info0 = (1:3) * 50, info_scale = 0,
  upper = gs_spending_bound,
  upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL),
  lower = gs_spending_bound,
  lpar = list(sf = gsDesign::sfHSD, total_spend = 0.1, param = -1, timing = NULL)
) %>% mutate(`Computated from` = "new version", `Info scale` = 0)

x1_b <- gs_design_npe(
  theta = c(.1, .2, .3),
  info = (1:3) * 40, info0 = (1:3) * 50, info_scale = 1,
  upper = gs_spending_bound,
  upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL),
  lower = gs_spending_bound,
  lpar = list(sf = gsDesign::sfHSD, total_spend = 0.1, param = -1, timing = NULL)
) %>% mutate(`Computated from` = "new version", `Info scale` = 1)

x1_c <- gs_design_npe(
  theta = c(.1, .2, .3),
  info = (1:3) * 40, info0 = (1:3) * 50, info_scale = 2,
  upper = gs_spending_bound,
  upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL),
  lower = gs_spending_bound,
  lpar = list(sf = gsDesign::sfHSD, total_spend = 0.1, param = -1, timing = NULL)
) %>% mutate(`Computated from` = "new version", `Info scale` = 2)

x2 <- gs_design_npe_(
  theta = c(.1, .2, .3),
  info = (1:3) * 40, info0 = (1:3) * 50,
  upper = gs_spending_bound,
  upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL),
  lower = gs_spending_bound,
  lpar = list(sf = gsDesign::sfHSD, total_spend = 0.1, param = -1, timing = NULL)
) %>% mutate(`Computated from` = "old version") %>% 
  rename(analysis = Analysis,
         bound = Bound, z = Z, probability = Probability)
```

```{r, echo=FALSE}
x1_a %>%
  union_all(x1_b) %>%
  union_all(x1_c) %>%
  union_all(x2) %>%
  arrange(analysis) %>%
  group_by(analysis, bound) %>%
  gt() %>%
  tab_style(
    style = list(cell_fill(color = "#d3edeb")),
    locations = cells_body(rows = `Computated from` == "old version")
  )
```

## 2-sided symmetric spend

```{r}
x1_a <- gs_design_npe(
  theta = c(.1, .2, .3),
  info = (1:3) * 40, info_scale = 0,
  binding = TRUE,
  upper = gs_spending_bound,
  upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL),
  lower = gs_spending_bound,
  lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL)
) %>% mutate(`Computated from` = "new version", `Info scale` = 0)

x1_b <- gs_design_npe(
  theta = c(.1, .2, .3),
  info = (1:3) * 40, info_scale = 1,
  binding = TRUE,
  upper = gs_spending_bound,
  upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL),
  lower = gs_spending_bound,
  lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL)
) %>% mutate(`Computated from` = "new version", `Info scale` = 1)

x1_c <- gs_design_npe(
  theta = c(.1, .2, .3),
  info = (1:3) * 40, info_scale = 2,
  binding = TRUE,
  upper = gs_spending_bound,
  upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL),
  lower = gs_spending_bound,
  lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL)
) %>% mutate(`Computated from` = "new version", `Info scale` = 2)

x2 <- gs_design_npe_(
  theta = c(.1, .2, .3),
  info = (1:3) * 40,
  binding = TRUE,
  upper = gs_spending_bound,
  upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL),
  lower = gs_spending_bound,
  lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL)
) %>% mutate(`Computated from` = "old version") %>% 
  rename(analysis = Analysis,
         bound = Bound, z = Z, probability = Probability)
```

```{r, echo=FALSE}
x1_a %>%
  union_all(x1_b) %>%
  union_all(x1_c) %>%
  union_all(x2) %>%
  arrange(analysis) %>%
  group_by(analysis, bound) %>%
  gt() %>%
  tab_style(
    style = list(cell_fill(color = "#d3edeb")),
    locations = cells_body(rows = `Computated from` == "old version")
  )
```
