## ----include=FALSE------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  dev = "svg",
  fig.ext = "svg",
  fig.width = 7.2916667,
  fig.asp = 0.618,
  fig.align = "center",
  out.width = "80%"
)

options(width = 68)

## ----echo=FALSE, message=FALSE, warning=FALSE---------------------
library(gsDesign)
library(knitr)

## -----------------------------------------------------------------
survival_time <- c(0, 12, 24, 36)
control_survival <- c(1, .50, .40, .35)
control_failure_rate <- -diff(log(control_survival)) / diff(survival_time)
enrollment_duration <- c(rep(1, 5), 11)
relative_enrollment_rate <- 1:6

survival_args <- list(
  k = 3,
  alpha = .025,
  beta = .1,
  hr = .7,
  timing = c(.4, .7),
  sfu = sfLDOF,
  sfl = sfHSD,
  sflpar = 1,
  lambdaC = control_failure_rate,
  S = c(12, 24),
  eta = .02 / 12,
  gamma = relative_enrollment_rate,
  R = enrollment_duration,
  T = 36,
  minfup = 20
)

## -----------------------------------------------------------------
# Non-binding futility only at IA1; efficacy starts at IA2
x1 <- do.call(gsSurv, c(survival_args, list(
  test.type = 4,
  testUpper = c(FALSE, TRUE, TRUE),
  testLower = c(TRUE, FALSE, FALSE)
)))

## -----------------------------------------------------------------
gsBoundSummary(x1, exclude = NULL) |> gt::gt()

## -----------------------------------------------------------------
xs <- do.call(gsSurv, c(survival_args, list(
  test.type = 6,
  astar = .15,
  testUpper = c(FALSE, TRUE, TRUE),
  testLower = c(TRUE, TRUE, FALSE)
)))
gsBoundSummary(xs, exclude = NULL) |>
  gt::gt()

## -----------------------------------------------------------------
# Harm bound design with harm monitoring only at IA1 and IA2
xh <- do.call(gsSurv, c(survival_args, list(
  test.type = 8,
  astar = .15,
  sfharm = sfHSD,
  sfharmparam = 1,
  testUpper = c(FALSE, TRUE, TRUE),
  testHarm = c(TRUE, TRUE, FALSE)
)))
gsBoundSummary(xh, exclude = NULL) |> gt::gt()

## -----------------------------------------------------------------
common_harm_args <- c(survival_args, list(
  test.type = 8,
  astar = .15,
  testUpper = c(FALSE, TRUE, TRUE),
  sfharm = sfHSD,
  sfharmparam = 1
))

x_all_lower <- do.call(gsSurv, c(
  common_harm_args,
  list(
    testLower = c(TRUE, TRUE, TRUE),
    testHarm = c(TRUE, TRUE, TRUE)
  )
))

x_final_harm <- do.call(gsSurv, c(
  common_harm_args,
  list(
    testLower = c(TRUE, TRUE, FALSE),
    testHarm = c(TRUE, TRUE, TRUE)
  )
))

x_matched_lower <- do.call(gsSurv, c(
  common_harm_args,
  list(
    testLower = c(TRUE, TRUE, FALSE),
    testHarm = c(TRUE, TRUE, FALSE)
  )
))

harm_comparison <- data.frame(
  Analysis = seq_len(x_all_lower$k),
  `All lower bounds active` = x_all_lower$harm$bound,
  `Final harm only` = x_final_harm$harm$bound,
  `Both final lower bounds skipped` = x_matched_lower$harm$bound,
  check.names = FALSE
)
kable(harm_comparison, digits = 3, caption = "Harm bounds by final-analysis testing schedule")

## -----------------------------------------------------------------
# Futility only at IA1; efficacy at IA2 and Final
x5 <- do.call(gsSurv, c(survival_args, list(
  test.type = 4,
  testUpper = c(FALSE, TRUE, TRUE),
  testLower = c(TRUE, FALSE, FALSE)
)))
gsBoundSummary(x5, exclude = NULL) |> gt::gt()

## ----error=TRUE---------------------------------------------------
try({
# This fails: testUpper must be TRUE at the final analysis
try(do.call(gsSurv, c(survival_args, list(
  test.type = 3,
  testUpper = c(TRUE, TRUE, FALSE)
))))
})

## ----error=TRUE---------------------------------------------------
try({
# This fails: no bound active at analysis 1
try(do.call(gsSurv, c(survival_args, list(
  test.type = 4,
  testUpper = c(FALSE, TRUE, TRUE),
  testLower = c(FALSE, TRUE, TRUE)
))))
})

## -----------------------------------------------------------------
x1$testUpper
x1$testLower
x1$testHarm

## -----------------------------------------------------------------
# Baseline non-binding design; efficacy starts at IA2
x_nb <- do.call(gsSurv, c(survival_args, list(
  test.type = 4,
  testUpper = c(FALSE, TRUE, TRUE)
)))

# Remove futility at IA2 and final
x_nb_sel <- do.call(gsSurv, c(survival_args, list(
  test.type = 4,
  testUpper = c(FALSE, TRUE, TRUE),
  testLower = c(TRUE, FALSE, FALSE))
))

# Non-binding alpha (computed ignoring lower bounds)
nb_alpha_base <- sum(gsDesign:::gsprob(0, x_nb$n.I, rep(-20, 3), x_nb$upper$bound, r = x_nb$r)$probhi)
nb_alpha_sel  <- sum(gsDesign:::gsprob(0, x_nb_sel$n.I, rep(-20, 3), x_nb_sel$upper$bound, r = x_nb_sel$r)$probhi)
cat("Baseline non-binding alpha: ", nb_alpha_base, "\n")
cat("Selective non-binding alpha:", nb_alpha_sel, "\n")
cat("Upper bounds identical:     ", all.equal(x_nb$upper$bound, x_nb_sel$upper$bound), "\n")

## -----------------------------------------------------------------
nb_alpha_eff <- sum(gsDesign:::gsprob(
  0, x_nb$n.I, rep(-20, 3), x_nb$upper$bound, r = x_nb$r
)$probhi)
cat("Non-binding alpha (skip IA1 efficacy):", nb_alpha_eff, "\n")

## -----------------------------------------------------------------
# Baseline binding design
x_b <- do.call(gsSurv, c(survival_args, list(test.type = 3)))
cat("Baseline alpha:", sum(x_b$upper$prob[, 1]), "\n")

# Remove futility at IA2 and final
x_b_sel <- do.call(gsSurv, c(survival_args, list(
  test.type = 3,
  testLower = c(TRUE, FALSE, FALSE))
))
cat("Selective alpha:", sum(x_b_sel$upper$prob[, 1]), "\n")
cat("Selective power:", sum(x_b_sel$upper$prob[, 2]), "\n")

# Remove efficacy at IA1
x_b_eff <- do.call(gsSurv, c(survival_args, list(
  test.type = 3,
  testUpper = c(FALSE, TRUE, TRUE))
))
cat("Skip IA1 efficacy alpha:", sum(x_b_eff$upper$prob[, 1]), "\n")
cat("Skip IA1 efficacy power:", sum(x_b_eff$upper$prob[, 2]), "\n")