Skip to contents

Group sequential design using average hazard ratio under non-proportional hazards

Usage

gs_design_ahr(
  enroll_rate = define_enroll_rate(duration = c(2, 2, 10), rate = c(3, 6, 9)),
  fail_rate = define_fail_rate(duration = c(3, 100), fail_rate = log(2)/c(9, 18), hr =
    c(0.9, 0.6), dropout_rate = 0.001),
  alpha = 0.025,
  beta = 0.1,
  info_frac = NULL,
  analysis_time = 36,
  ratio = 1,
  binding = FALSE,
  upper = gs_spending_bound,
  upar = list(sf = gsDesign::sfLDOF, total_spend = alpha),
  lower = gs_spending_bound,
  lpar = list(sf = gsDesign::sfLDOF, total_spend = beta),
  h1_spending = TRUE,
  test_upper = TRUE,
  test_lower = TRUE,
  info_scale = c("h0_h1_info", "h0_info", "h1_info"),
  r = 18,
  tol = 1e-06,
  interval = c(0.01, 1000)
)

Arguments

enroll_rate

Enrollment rates.

fail_rate

Failure and dropout rates.

alpha

One-sided Type I error.

beta

Type II error.

info_frac

Targeted information fraction at each analysis.

analysis_time

Minimum time of analysis.

ratio

Experimental:Control randomization ratio (not yet implemented).

binding

Indicator of whether futility bound is binding; default of FALSE is recommended.

upper

Function to compute upper bound.

upar

Parameters passed to upper.

lower

Function to compute lower bound.

lpar

Parameters passed to lower.

h1_spending

Indicator that lower bound to be set by spending under alternate hypothesis (input fail_rate) if spending is used for lower bound.

test_upper

Indicator of which analyses should include an upper (efficacy) bound; single value of TRUE (default) indicates all analyses; otherwise, a logical vector of the same length as info should indicate which analyses will have an efficacy bound.

test_lower

Indicator of which analyses should include an lower bound; single value of TRUE (default) indicates all analyses; single value FALSE indicated no lower bound; otherwise, a logical vector of the same length as info should indicate which analyses will have a lower bound.

info_scale

Information scale for calculation. Options are:

  • "h0_h1_info" (default): variance under both null and alternative hypotheses is used.

  • "h0_info": variance under null hypothesis is used.

  • "h1_info": variance under alternative hypothesis is used.

r

Integer value controlling grid for numerical integration as in Jennison and Turnbull (2000); default is 18, range is 1 to 80. Larger values provide larger number of grid points and greater accuracy. Normally, r will not be changed by the user.

tol

Tolerance parameter for boundary convergence (on Z-scale).

interval

An interval that is presumed to include the time at which expected event count is equal to targeted event.

Value

A list with input parameters, enrollment rate, analysis, and bound.

Details

To be added.

Specification

The contents of this section are shown in PDF user manual only.

Examples

library(gsDesign)
#> 
#> Attaching package: ‘gsDesign’
#> The following objects are masked from ‘package:gsDesign2’:
#> 
#>     as_gt, as_rtf
library(gsDesign2)
library(dplyr)

# Example 1 ----
# call with defaults
gs_design_ahr()
#> $input
#> $input$enroll_rate
#> # A tibble: 3 × 3
#>   stratum duration  rate
#>   <chr>      <dbl> <dbl>
#> 1 All            2     3
#> 2 All            2     6
#> 3 All           10     9
#> 
#> $input$fail_rate
#> # A tibble: 2 × 5
#>   stratum duration fail_rate dropout_rate    hr
#>   <chr>      <dbl>     <dbl>        <dbl> <dbl>
#> 1 All            3    0.0770        0.001   0.9
#> 2 All          100    0.0385        0.001   0.6
#> 
#> $input$alpha
#> [1] 0.025
#> 
#> $input$beta
#> [1] 0.1
#> 
#> $input$ratio
#> [1] 1
#> 
#> $input$info_frac
#> [1] 1
#> 
#> $input$analysis_time
#> [1] 36
#> 
#> $input$upper
#> function (k = 1, par = list(sf = gsDesign::sfLDOF, total_spend = 0.025, 
#>     param = NULL, timing = NULL, max_info = NULL), hgm1 = NULL, 
#>     theta = 0.1, info = 1:3, efficacy = TRUE, test_bound = TRUE, 
#>     r = 18, tol = 1e-06) 
#> {
#>     if (length(test_bound) == 1 && k > 1) {
#>         test_bound <- rep(test_bound, k)
#>     }
#>     if (!is.null(par$timing)) {
#>         timing <- par$timing
#>     }
#>     else {
#>         if (is.null(par$max_info)) {
#>             timing <- info/max(info)
#>         }
#>         else {
#>             timing <- info/par$max_info
#>         }
#>     }
#>     spend <- par$sf(alpha = par$total_spend, t = timing, param = par$param)$spend
#>     old_spend <- 0
#>     for (i in 1:k) {
#>         if (test_bound[i]) {
#>             xx <- spend[i] - old_spend
#>             old_spend <- spend[i]
#>             spend[i] <- xx
#>         }
#>         else {
#>             spend[i] <- 0
#>         }
#>     }
#>     spend <- spend[k]
#>     if (!efficacy) {
#>         if (spend <= 0) {
#>             return(-Inf)
#>         }
#>         if (length(theta) == 1) 
#>             theta <- rep(theta, length(info))
#>         a <- qnorm(spend) + sqrt(info[k]) * theta[k]
#>         if (k == 1) {
#>             return(a)
#>         }
#>         mu <- theta[k] * sqrt(info[k])
#>         extreme_low <- mu - 3 - 4 * log(r)
#>         extreme_high <- mu + 3 + 4 * log(r)
#>         adelta <- 1
#>         j <- 0
#>         while (abs(adelta) > tol) {
#>             hg <- hupdate(theta = theta[k], info = info[k], a = -Inf, 
#>                 b = a, thetam1 = theta[k - 1], im1 = info[k - 
#>                   1], gm1 = hgm1, r = r)
#>             i <- length(hg$h)
#>             pik <- sum(hg$h)
#>             adelta <- spend - pik
#>             dplo <- hg$h[i]/hg$w[i]
#>             if (adelta > dplo) {
#>                 adelta <- 1
#>             }
#>             else if (adelta < -dplo) {
#>                 adelta <- -1
#>             }
#>             else {
#>                 adelta <- adelta/dplo
#>             }
#>             a <- a + adelta
#>             if (a > extreme_high) {
#>                 a <- extreme_high
#>             }
#>             else if (a < extreme_low) {
#>                 a <- extreme_low
#>             }
#>             if (abs(adelta) < tol) {
#>                 return(a)
#>             }
#>             j <- j + 1
#>             if (j > 20) {
#>                 stop(paste("gs_spending_bound(): bound_update did not converge for lower bound calculation, analysis", 
#>                   k, " !"))
#>             }
#>         }
#>     }
#>     else {
#>         if (spend <= 0) {
#>             return(Inf)
#>         }
#>         if (length(theta) == 1) 
#>             theta <- rep(theta, length(info))
#>         b <- qnorm(spend, lower.tail = FALSE)
#>         if (k == 1) {
#>             return(b)
#>         }
#>         mu <- theta[k] * sqrt(info[k])
#>         extreme_low <- mu - 3 - 4 * log(r)
#>         extreme_high <- mu + 3 + 4 * log(r)
#>         bdelta <- 1
#>         j <- 1
#>         while (abs(bdelta) > tol) {
#>             hg <- hupdate(theta = 0, info = info[k], a = b, b = Inf, 
#>                 thetam1 = 0, im1 = info[k - 1], gm1 = hgm1, r = r)
#>             pik <- sum(hg$h)
#>             bdelta <- spend - pik
#>             dpikdb <- hg$h[1]/hg$w[1]
#>             if (bdelta > dpikdb) {
#>                 bdelta <- 1
#>             }
#>             else if (bdelta < -dpikdb) {
#>                 bdelta <- -1
#>             }
#>             else {
#>                 bdelta <- bdelta/dpikdb
#>             }
#>             b <- b - bdelta
#>             if (b > extreme_high) {
#>                 b <- extreme_high
#>             }
#>             else if (b < extreme_low) {
#>                 b <- extreme_low
#>             }
#>             if (abs(bdelta) < tol) {
#>                 return(b)
#>             }
#>             j <- j + 1
#>             if (j > 20) {
#>                 stop(paste("gs_spending_bound(): bound_update did not converge for lower bound calculation, analysis", 
#>                   k, " !"))
#>             }
#>         }
#>     }
#> }
#> <bytecode: 0x55ec2b3bbd08>
#> <environment: namespace:gsDesign2>
#> 
#> $input$upar
#> $input$upar$sf
#> function (alpha, t, param = NULL) 
#> {
#>     checkScalar(alpha, "numeric", c(0, Inf), c(FALSE, FALSE))
#>     checkVector(t, "numeric", c(0, Inf), c(TRUE, FALSE))
#>     if (is.null(param) || param < 0.005 || param > 20) 
#>         param <- 1
#>     checkScalar(param, "numeric", c(0.005, 20), c(TRUE, TRUE))
#>     t[t > 1] <- 1
#>     if (param == 1) {
#>         rho <- 1
#>         txt <- "Lan-DeMets O'Brien-Fleming approximation"
#>         parname <- "none"
#>     }
#>     else {
#>         rho <- param
#>         txt <- "Generalized Lan-DeMets O'Brien-Fleming"
#>         parname <- "rho"
#>     }
#>     z <- -qnorm(alpha/2)
#>     x <- list(name = txt, param = param, parname = parname, sf = sfLDOF, 
#>         spend = 2 * (1 - pnorm(z/t^(rho/2))), bound = NULL, prob = NULL)
#>     class(x) <- "spendfn"
#>     x
#> }
#> <bytecode: 0x55ec28bf0d80>
#> <environment: namespace:gsDesign>
#> 
#> $input$upar$total_spend
#> [1] 0.025
#> 
#> 
#> $input$lower
#> function (k = 1, par = list(sf = gsDesign::sfLDOF, total_spend = 0.025, 
#>     param = NULL, timing = NULL, max_info = NULL), hgm1 = NULL, 
#>     theta = 0.1, info = 1:3, efficacy = TRUE, test_bound = TRUE, 
#>     r = 18, tol = 1e-06) 
#> {
#>     if (length(test_bound) == 1 && k > 1) {
#>         test_bound <- rep(test_bound, k)
#>     }
#>     if (!is.null(par$timing)) {
#>         timing <- par$timing
#>     }
#>     else {
#>         if (is.null(par$max_info)) {
#>             timing <- info/max(info)
#>         }
#>         else {
#>             timing <- info/par$max_info
#>         }
#>     }
#>     spend <- par$sf(alpha = par$total_spend, t = timing, param = par$param)$spend
#>     old_spend <- 0
#>     for (i in 1:k) {
#>         if (test_bound[i]) {
#>             xx <- spend[i] - old_spend
#>             old_spend <- spend[i]
#>             spend[i] <- xx
#>         }
#>         else {
#>             spend[i] <- 0
#>         }
#>     }
#>     spend <- spend[k]
#>     if (!efficacy) {
#>         if (spend <= 0) {
#>             return(-Inf)
#>         }
#>         if (length(theta) == 1) 
#>             theta <- rep(theta, length(info))
#>         a <- qnorm(spend) + sqrt(info[k]) * theta[k]
#>         if (k == 1) {
#>             return(a)
#>         }
#>         mu <- theta[k] * sqrt(info[k])
#>         extreme_low <- mu - 3 - 4 * log(r)
#>         extreme_high <- mu + 3 + 4 * log(r)
#>         adelta <- 1
#>         j <- 0
#>         while (abs(adelta) > tol) {
#>             hg <- hupdate(theta = theta[k], info = info[k], a = -Inf, 
#>                 b = a, thetam1 = theta[k - 1], im1 = info[k - 
#>                   1], gm1 = hgm1, r = r)
#>             i <- length(hg$h)
#>             pik <- sum(hg$h)
#>             adelta <- spend - pik
#>             dplo <- hg$h[i]/hg$w[i]
#>             if (adelta > dplo) {
#>                 adelta <- 1
#>             }
#>             else if (adelta < -dplo) {
#>                 adelta <- -1
#>             }
#>             else {
#>                 adelta <- adelta/dplo
#>             }
#>             a <- a + adelta
#>             if (a > extreme_high) {
#>                 a <- extreme_high
#>             }
#>             else if (a < extreme_low) {
#>                 a <- extreme_low
#>             }
#>             if (abs(adelta) < tol) {
#>                 return(a)
#>             }
#>             j <- j + 1
#>             if (j > 20) {
#>                 stop(paste("gs_spending_bound(): bound_update did not converge for lower bound calculation, analysis", 
#>                   k, " !"))
#>             }
#>         }
#>     }
#>     else {
#>         if (spend <= 0) {
#>             return(Inf)
#>         }
#>         if (length(theta) == 1) 
#>             theta <- rep(theta, length(info))
#>         b <- qnorm(spend, lower.tail = FALSE)
#>         if (k == 1) {
#>             return(b)
#>         }
#>         mu <- theta[k] * sqrt(info[k])
#>         extreme_low <- mu - 3 - 4 * log(r)
#>         extreme_high <- mu + 3 + 4 * log(r)
#>         bdelta <- 1
#>         j <- 1
#>         while (abs(bdelta) > tol) {
#>             hg <- hupdate(theta = 0, info = info[k], a = b, b = Inf, 
#>                 thetam1 = 0, im1 = info[k - 1], gm1 = hgm1, r = r)
#>             pik <- sum(hg$h)
#>             bdelta <- spend - pik
#>             dpikdb <- hg$h[1]/hg$w[1]
#>             if (bdelta > dpikdb) {
#>                 bdelta <- 1
#>             }
#>             else if (bdelta < -dpikdb) {
#>                 bdelta <- -1
#>             }
#>             else {
#>                 bdelta <- bdelta/dpikdb
#>             }
#>             b <- b - bdelta
#>             if (b > extreme_high) {
#>                 b <- extreme_high
#>             }
#>             else if (b < extreme_low) {
#>                 b <- extreme_low
#>             }
#>             if (abs(bdelta) < tol) {
#>                 return(b)
#>             }
#>             j <- j + 1
#>             if (j > 20) {
#>                 stop(paste("gs_spending_bound(): bound_update did not converge for lower bound calculation, analysis", 
#>                   k, " !"))
#>             }
#>         }
#>     }
#> }
#> <bytecode: 0x55ec2b3bbd08>
#> <environment: namespace:gsDesign2>
#> 
#> $input$lpar
#> $input$lpar$sf
#> function (alpha, t, param = NULL) 
#> {
#>     checkScalar(alpha, "numeric", c(0, Inf), c(FALSE, FALSE))
#>     checkVector(t, "numeric", c(0, Inf), c(TRUE, FALSE))
#>     if (is.null(param) || param < 0.005 || param > 20) 
#>         param <- 1
#>     checkScalar(param, "numeric", c(0.005, 20), c(TRUE, TRUE))
#>     t[t > 1] <- 1
#>     if (param == 1) {
#>         rho <- 1
#>         txt <- "Lan-DeMets O'Brien-Fleming approximation"
#>         parname <- "none"
#>     }
#>     else {
#>         rho <- param
#>         txt <- "Generalized Lan-DeMets O'Brien-Fleming"
#>         parname <- "rho"
#>     }
#>     z <- -qnorm(alpha/2)
#>     x <- list(name = txt, param = param, parname = parname, sf = sfLDOF, 
#>         spend = 2 * (1 - pnorm(z/t^(rho/2))), bound = NULL, prob = NULL)
#>     class(x) <- "spendfn"
#>     x
#> }
#> <bytecode: 0x55ec28bf0d80>
#> <environment: namespace:gsDesign>
#> 
#> $input$lpar$total_spend
#> [1] 0.1
#> 
#> 
#> $input$test_upper
#> [1] TRUE
#> 
#> $input$test_lower
#> [1] TRUE
#> 
#> $input$h1_spending
#> [1] TRUE
#> 
#> $input$binding
#> [1] FALSE
#> 
#> $input$info_scale
#> [1] "h0_h1_info"
#> 
#> $input$r
#> [1] 18
#> 
#> $input$tol
#> [1] 1e-06
#> 
#> 
#> $enroll_rate
#> # A tibble: 3 × 3
#>   stratum duration  rate
#>   <chr>      <dbl> <dbl>
#> 1 All            2  13.2
#> 2 All            2  26.4
#> 3 All           10  39.7
#> 
#> $fail_rate
#> # A tibble: 2 × 5
#>   stratum duration fail_rate dropout_rate    hr
#>   <chr>      <dbl>     <dbl>        <dbl> <dbl>
#> 1 All            3    0.0770        0.001   0.9
#> 2 All          100    0.0385        0.001   0.6
#> 
#> $bound
#> # A tibble: 1 × 7
#>   analysis bound probability probability0     z `~hr at bound` `nominal p`
#>      <dbl> <chr>       <dbl>        <dbl> <dbl>          <dbl>       <dbl>
#> 1        1 upper         0.9        0.025  1.96          0.795      0.0250
#> 
#> $analysis
#> # A tibble: 1 × 10
#>   analysis  time     n event   ahr theta  info info0 info_frac info_frac0
#>      <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>     <dbl>      <dbl>
#> 1        1    36  476.  292. 0.683 0.381  71.7  73.0         1          1
#> 
#> attr(,"class")
#> [1] "non_binding" "ahr"         "gs_design"   "list"       

# Example 2 ----
# Single analysis
gs_design_ahr(analysis_time = 40)
#> $input
#> $input$enroll_rate
#> # A tibble: 3 × 3
#>   stratum duration  rate
#>   <chr>      <dbl> <dbl>
#> 1 All            2     3
#> 2 All            2     6
#> 3 All           10     9
#> 
#> $input$fail_rate
#> # A tibble: 2 × 5
#>   stratum duration fail_rate dropout_rate    hr
#>   <chr>      <dbl>     <dbl>        <dbl> <dbl>
#> 1 All            3    0.0770        0.001   0.9
#> 2 All          100    0.0385        0.001   0.6
#> 
#> $input$alpha
#> [1] 0.025
#> 
#> $input$beta
#> [1] 0.1
#> 
#> $input$ratio
#> [1] 1
#> 
#> $input$info_frac
#> [1] 1
#> 
#> $input$analysis_time
#> [1] 40
#> 
#> $input$upper
#> function (k = 1, par = list(sf = gsDesign::sfLDOF, total_spend = 0.025, 
#>     param = NULL, timing = NULL, max_info = NULL), hgm1 = NULL, 
#>     theta = 0.1, info = 1:3, efficacy = TRUE, test_bound = TRUE, 
#>     r = 18, tol = 1e-06) 
#> {
#>     if (length(test_bound) == 1 && k > 1) {
#>         test_bound <- rep(test_bound, k)
#>     }
#>     if (!is.null(par$timing)) {
#>         timing <- par$timing
#>     }
#>     else {
#>         if (is.null(par$max_info)) {
#>             timing <- info/max(info)
#>         }
#>         else {
#>             timing <- info/par$max_info
#>         }
#>     }
#>     spend <- par$sf(alpha = par$total_spend, t = timing, param = par$param)$spend
#>     old_spend <- 0
#>     for (i in 1:k) {
#>         if (test_bound[i]) {
#>             xx <- spend[i] - old_spend
#>             old_spend <- spend[i]
#>             spend[i] <- xx
#>         }
#>         else {
#>             spend[i] <- 0
#>         }
#>     }
#>     spend <- spend[k]
#>     if (!efficacy) {
#>         if (spend <= 0) {
#>             return(-Inf)
#>         }
#>         if (length(theta) == 1) 
#>             theta <- rep(theta, length(info))
#>         a <- qnorm(spend) + sqrt(info[k]) * theta[k]
#>         if (k == 1) {
#>             return(a)
#>         }
#>         mu <- theta[k] * sqrt(info[k])
#>         extreme_low <- mu - 3 - 4 * log(r)
#>         extreme_high <- mu + 3 + 4 * log(r)
#>         adelta <- 1
#>         j <- 0
#>         while (abs(adelta) > tol) {
#>             hg <- hupdate(theta = theta[k], info = info[k], a = -Inf, 
#>                 b = a, thetam1 = theta[k - 1], im1 = info[k - 
#>                   1], gm1 = hgm1, r = r)
#>             i <- length(hg$h)
#>             pik <- sum(hg$h)
#>             adelta <- spend - pik
#>             dplo <- hg$h[i]/hg$w[i]
#>             if (adelta > dplo) {
#>                 adelta <- 1
#>             }
#>             else if (adelta < -dplo) {
#>                 adelta <- -1
#>             }
#>             else {
#>                 adelta <- adelta/dplo
#>             }
#>             a <- a + adelta
#>             if (a > extreme_high) {
#>                 a <- extreme_high
#>             }
#>             else if (a < extreme_low) {
#>                 a <- extreme_low
#>             }
#>             if (abs(adelta) < tol) {
#>                 return(a)
#>             }
#>             j <- j + 1
#>             if (j > 20) {
#>                 stop(paste("gs_spending_bound(): bound_update did not converge for lower bound calculation, analysis", 
#>                   k, " !"))
#>             }
#>         }
#>     }
#>     else {
#>         if (spend <= 0) {
#>             return(Inf)
#>         }
#>         if (length(theta) == 1) 
#>             theta <- rep(theta, length(info))
#>         b <- qnorm(spend, lower.tail = FALSE)
#>         if (k == 1) {
#>             return(b)
#>         }
#>         mu <- theta[k] * sqrt(info[k])
#>         extreme_low <- mu - 3 - 4 * log(r)
#>         extreme_high <- mu + 3 + 4 * log(r)
#>         bdelta <- 1
#>         j <- 1
#>         while (abs(bdelta) > tol) {
#>             hg <- hupdate(theta = 0, info = info[k], a = b, b = Inf, 
#>                 thetam1 = 0, im1 = info[k - 1], gm1 = hgm1, r = r)
#>             pik <- sum(hg$h)
#>             bdelta <- spend - pik
#>             dpikdb <- hg$h[1]/hg$w[1]
#>             if (bdelta > dpikdb) {
#>                 bdelta <- 1
#>             }
#>             else if (bdelta < -dpikdb) {
#>                 bdelta <- -1
#>             }
#>             else {
#>                 bdelta <- bdelta/dpikdb
#>             }
#>             b <- b - bdelta
#>             if (b > extreme_high) {
#>                 b <- extreme_high
#>             }
#>             else if (b < extreme_low) {
#>                 b <- extreme_low
#>             }
#>             if (abs(bdelta) < tol) {
#>                 return(b)
#>             }
#>             j <- j + 1
#>             if (j > 20) {
#>                 stop(paste("gs_spending_bound(): bound_update did not converge for lower bound calculation, analysis", 
#>                   k, " !"))
#>             }
#>         }
#>     }
#> }
#> <bytecode: 0x55ec2b3bbd08>
#> <environment: namespace:gsDesign2>
#> 
#> $input$upar
#> $input$upar$sf
#> function (alpha, t, param = NULL) 
#> {
#>     checkScalar(alpha, "numeric", c(0, Inf), c(FALSE, FALSE))
#>     checkVector(t, "numeric", c(0, Inf), c(TRUE, FALSE))
#>     if (is.null(param) || param < 0.005 || param > 20) 
#>         param <- 1
#>     checkScalar(param, "numeric", c(0.005, 20), c(TRUE, TRUE))
#>     t[t > 1] <- 1
#>     if (param == 1) {
#>         rho <- 1
#>         txt <- "Lan-DeMets O'Brien-Fleming approximation"
#>         parname <- "none"
#>     }
#>     else {
#>         rho <- param
#>         txt <- "Generalized Lan-DeMets O'Brien-Fleming"
#>         parname <- "rho"
#>     }
#>     z <- -qnorm(alpha/2)
#>     x <- list(name = txt, param = param, parname = parname, sf = sfLDOF, 
#>         spend = 2 * (1 - pnorm(z/t^(rho/2))), bound = NULL, prob = NULL)
#>     class(x) <- "spendfn"
#>     x
#> }
#> <bytecode: 0x55ec28bf0d80>
#> <environment: namespace:gsDesign>
#> 
#> $input$upar$total_spend
#> [1] 0.025
#> 
#> 
#> $input$lower
#> function (k = 1, par = list(sf = gsDesign::sfLDOF, total_spend = 0.025, 
#>     param = NULL, timing = NULL, max_info = NULL), hgm1 = NULL, 
#>     theta = 0.1, info = 1:3, efficacy = TRUE, test_bound = TRUE, 
#>     r = 18, tol = 1e-06) 
#> {
#>     if (length(test_bound) == 1 && k > 1) {
#>         test_bound <- rep(test_bound, k)
#>     }
#>     if (!is.null(par$timing)) {
#>         timing <- par$timing
#>     }
#>     else {
#>         if (is.null(par$max_info)) {
#>             timing <- info/max(info)
#>         }
#>         else {
#>             timing <- info/par$max_info
#>         }
#>     }
#>     spend <- par$sf(alpha = par$total_spend, t = timing, param = par$param)$spend
#>     old_spend <- 0
#>     for (i in 1:k) {
#>         if (test_bound[i]) {
#>             xx <- spend[i] - old_spend
#>             old_spend <- spend[i]
#>             spend[i] <- xx
#>         }
#>         else {
#>             spend[i] <- 0
#>         }
#>     }
#>     spend <- spend[k]
#>     if (!efficacy) {
#>         if (spend <= 0) {
#>             return(-Inf)
#>         }
#>         if (length(theta) == 1) 
#>             theta <- rep(theta, length(info))
#>         a <- qnorm(spend) + sqrt(info[k]) * theta[k]
#>         if (k == 1) {
#>             return(a)
#>         }
#>         mu <- theta[k] * sqrt(info[k])
#>         extreme_low <- mu - 3 - 4 * log(r)
#>         extreme_high <- mu + 3 + 4 * log(r)
#>         adelta <- 1
#>         j <- 0
#>         while (abs(adelta) > tol) {
#>             hg <- hupdate(theta = theta[k], info = info[k], a = -Inf, 
#>                 b = a, thetam1 = theta[k - 1], im1 = info[k - 
#>                   1], gm1 = hgm1, r = r)
#>             i <- length(hg$h)
#>             pik <- sum(hg$h)
#>             adelta <- spend - pik
#>             dplo <- hg$h[i]/hg$w[i]
#>             if (adelta > dplo) {
#>                 adelta <- 1
#>             }
#>             else if (adelta < -dplo) {
#>                 adelta <- -1
#>             }
#>             else {
#>                 adelta <- adelta/dplo
#>             }
#>             a <- a + adelta
#>             if (a > extreme_high) {
#>                 a <- extreme_high
#>             }
#>             else if (a < extreme_low) {
#>                 a <- extreme_low
#>             }
#>             if (abs(adelta) < tol) {
#>                 return(a)
#>             }
#>             j <- j + 1
#>             if (j > 20) {
#>                 stop(paste("gs_spending_bound(): bound_update did not converge for lower bound calculation, analysis", 
#>                   k, " !"))
#>             }
#>         }
#>     }
#>     else {
#>         if (spend <= 0) {
#>             return(Inf)
#>         }
#>         if (length(theta) == 1) 
#>             theta <- rep(theta, length(info))
#>         b <- qnorm(spend, lower.tail = FALSE)
#>         if (k == 1) {
#>             return(b)
#>         }
#>         mu <- theta[k] * sqrt(info[k])
#>         extreme_low <- mu - 3 - 4 * log(r)
#>         extreme_high <- mu + 3 + 4 * log(r)
#>         bdelta <- 1
#>         j <- 1
#>         while (abs(bdelta) > tol) {
#>             hg <- hupdate(theta = 0, info = info[k], a = b, b = Inf, 
#>                 thetam1 = 0, im1 = info[k - 1], gm1 = hgm1, r = r)
#>             pik <- sum(hg$h)
#>             bdelta <- spend - pik
#>             dpikdb <- hg$h[1]/hg$w[1]
#>             if (bdelta > dpikdb) {
#>                 bdelta <- 1
#>             }
#>             else if (bdelta < -dpikdb) {
#>                 bdelta <- -1
#>             }
#>             else {
#>                 bdelta <- bdelta/dpikdb
#>             }
#>             b <- b - bdelta
#>             if (b > extreme_high) {
#>                 b <- extreme_high
#>             }
#>             else if (b < extreme_low) {
#>                 b <- extreme_low
#>             }
#>             if (abs(bdelta) < tol) {
#>                 return(b)
#>             }
#>             j <- j + 1
#>             if (j > 20) {
#>                 stop(paste("gs_spending_bound(): bound_update did not converge for lower bound calculation, analysis", 
#>                   k, " !"))
#>             }
#>         }
#>     }
#> }
#> <bytecode: 0x55ec2b3bbd08>
#> <environment: namespace:gsDesign2>
#> 
#> $input$lpar
#> $input$lpar$sf
#> function (alpha, t, param = NULL) 
#> {
#>     checkScalar(alpha, "numeric", c(0, Inf), c(FALSE, FALSE))
#>     checkVector(t, "numeric", c(0, Inf), c(TRUE, FALSE))
#>     if (is.null(param) || param < 0.005 || param > 20) 
#>         param <- 1
#>     checkScalar(param, "numeric", c(0.005, 20), c(TRUE, TRUE))
#>     t[t > 1] <- 1
#>     if (param == 1) {
#>         rho <- 1
#>         txt <- "Lan-DeMets O'Brien-Fleming approximation"
#>         parname <- "none"
#>     }
#>     else {
#>         rho <- param
#>         txt <- "Generalized Lan-DeMets O'Brien-Fleming"
#>         parname <- "rho"
#>     }
#>     z <- -qnorm(alpha/2)
#>     x <- list(name = txt, param = param, parname = parname, sf = sfLDOF, 
#>         spend = 2 * (1 - pnorm(z/t^(rho/2))), bound = NULL, prob = NULL)
#>     class(x) <- "spendfn"
#>     x
#> }
#> <bytecode: 0x55ec28bf0d80>
#> <environment: namespace:gsDesign>
#> 
#> $input$lpar$total_spend
#> [1] 0.1
#> 
#> 
#> $input$test_upper
#> [1] TRUE
#> 
#> $input$test_lower
#> [1] TRUE
#> 
#> $input$h1_spending
#> [1] TRUE
#> 
#> $input$binding
#> [1] FALSE
#> 
#> $input$info_scale
#> [1] "h0_h1_info"
#> 
#> $input$r
#> [1] 18
#> 
#> $input$tol
#> [1] 1e-06
#> 
#> 
#> $enroll_rate
#> # A tibble: 3 × 3
#>   stratum duration  rate
#>   <chr>      <dbl> <dbl>
#> 1 All            2  11.9
#> 2 All            2  23.8
#> 3 All           10  35.6
#> 
#> $fail_rate
#> # A tibble: 2 × 5
#>   stratum duration fail_rate dropout_rate    hr
#>   <chr>      <dbl>     <dbl>        <dbl> <dbl>
#> 1 All            3    0.0770        0.001   0.9
#> 2 All          100    0.0385        0.001   0.6
#> 
#> $bound
#> # A tibble: 1 × 7
#>   analysis bound probability probability0     z `~hr at bound` `nominal p`
#>      <dbl> <chr>       <dbl>        <dbl> <dbl>          <dbl>       <dbl>
#> 1        1 upper         0.9        0.025  1.96          0.791      0.0250
#> 
#> $analysis
#> # A tibble: 1 × 10
#>   analysis  time     n event   ahr theta  info info0 info_frac info_frac0
#>      <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>     <dbl>      <dbl>
#> 1        1    40  428.  280. 0.678 0.389  68.8  69.9         1          1
#> 
#> attr(,"class")
#> [1] "non_binding" "ahr"         "gs_design"   "list"       

# Example 3 ----
# Multiple analysis_time
gs_design_ahr(analysis_time = c(12, 24, 36))
#> $input
#> $input$enroll_rate
#> # A tibble: 3 × 3
#>   stratum duration  rate
#>   <chr>      <dbl> <dbl>
#> 1 All            2     3
#> 2 All            2     6
#> 3 All           10     9
#> 
#> $input$fail_rate
#> # A tibble: 2 × 5
#>   stratum duration fail_rate dropout_rate    hr
#>   <chr>      <dbl>     <dbl>        <dbl> <dbl>
#> 1 All            3    0.0770        0.001   0.9
#> 2 All          100    0.0385        0.001   0.6
#> 
#> $input$alpha
#> [1] 0.025
#> 
#> $input$beta
#> [1] 0.1
#> 
#> $input$ratio
#> [1] 1
#> 
#> $input$info_frac
#> [1] 0.3080415 0.7407917 1.0000000
#> 
#> $input$analysis_time
#> [1] 12 24 36
#> 
#> $input$upper
#> function (k = 1, par = list(sf = gsDesign::sfLDOF, total_spend = 0.025, 
#>     param = NULL, timing = NULL, max_info = NULL), hgm1 = NULL, 
#>     theta = 0.1, info = 1:3, efficacy = TRUE, test_bound = TRUE, 
#>     r = 18, tol = 1e-06) 
#> {
#>     if (length(test_bound) == 1 && k > 1) {
#>         test_bound <- rep(test_bound, k)
#>     }
#>     if (!is.null(par$timing)) {
#>         timing <- par$timing
#>     }
#>     else {
#>         if (is.null(par$max_info)) {
#>             timing <- info/max(info)
#>         }
#>         else {
#>             timing <- info/par$max_info
#>         }
#>     }
#>     spend <- par$sf(alpha = par$total_spend, t = timing, param = par$param)$spend
#>     old_spend <- 0
#>     for (i in 1:k) {
#>         if (test_bound[i]) {
#>             xx <- spend[i] - old_spend
#>             old_spend <- spend[i]
#>             spend[i] <- xx
#>         }
#>         else {
#>             spend[i] <- 0
#>         }
#>     }
#>     spend <- spend[k]
#>     if (!efficacy) {
#>         if (spend <= 0) {
#>             return(-Inf)
#>         }
#>         if (length(theta) == 1) 
#>             theta <- rep(theta, length(info))
#>         a <- qnorm(spend) + sqrt(info[k]) * theta[k]
#>         if (k == 1) {
#>             return(a)
#>         }
#>         mu <- theta[k] * sqrt(info[k])
#>         extreme_low <- mu - 3 - 4 * log(r)
#>         extreme_high <- mu + 3 + 4 * log(r)
#>         adelta <- 1
#>         j <- 0
#>         while (abs(adelta) > tol) {
#>             hg <- hupdate(theta = theta[k], info = info[k], a = -Inf, 
#>                 b = a, thetam1 = theta[k - 1], im1 = info[k - 
#>                   1], gm1 = hgm1, r = r)
#>             i <- length(hg$h)
#>             pik <- sum(hg$h)
#>             adelta <- spend - pik
#>             dplo <- hg$h[i]/hg$w[i]
#>             if (adelta > dplo) {
#>                 adelta <- 1
#>             }
#>             else if (adelta < -dplo) {
#>                 adelta <- -1
#>             }
#>             else {
#>                 adelta <- adelta/dplo
#>             }
#>             a <- a + adelta
#>             if (a > extreme_high) {
#>                 a <- extreme_high
#>             }
#>             else if (a < extreme_low) {
#>                 a <- extreme_low
#>             }
#>             if (abs(adelta) < tol) {
#>                 return(a)
#>             }
#>             j <- j + 1
#>             if (j > 20) {
#>                 stop(paste("gs_spending_bound(): bound_update did not converge for lower bound calculation, analysis", 
#>                   k, " !"))
#>             }
#>         }
#>     }
#>     else {
#>         if (spend <= 0) {
#>             return(Inf)
#>         }
#>         if (length(theta) == 1) 
#>             theta <- rep(theta, length(info))
#>         b <- qnorm(spend, lower.tail = FALSE)
#>         if (k == 1) {
#>             return(b)
#>         }
#>         mu <- theta[k] * sqrt(info[k])
#>         extreme_low <- mu - 3 - 4 * log(r)
#>         extreme_high <- mu + 3 + 4 * log(r)
#>         bdelta <- 1
#>         j <- 1
#>         while (abs(bdelta) > tol) {
#>             hg <- hupdate(theta = 0, info = info[k], a = b, b = Inf, 
#>                 thetam1 = 0, im1 = info[k - 1], gm1 = hgm1, r = r)
#>             pik <- sum(hg$h)
#>             bdelta <- spend - pik
#>             dpikdb <- hg$h[1]/hg$w[1]
#>             if (bdelta > dpikdb) {
#>                 bdelta <- 1
#>             }
#>             else if (bdelta < -dpikdb) {
#>                 bdelta <- -1
#>             }
#>             else {
#>                 bdelta <- bdelta/dpikdb
#>             }
#>             b <- b - bdelta
#>             if (b > extreme_high) {
#>                 b <- extreme_high
#>             }
#>             else if (b < extreme_low) {
#>                 b <- extreme_low
#>             }
#>             if (abs(bdelta) < tol) {
#>                 return(b)
#>             }
#>             j <- j + 1
#>             if (j > 20) {
#>                 stop(paste("gs_spending_bound(): bound_update did not converge for lower bound calculation, analysis", 
#>                   k, " !"))
#>             }
#>         }
#>     }
#> }
#> <bytecode: 0x55ec2b3bbd08>
#> <environment: namespace:gsDesign2>
#> 
#> $input$upar
#> $input$upar$sf
#> function (alpha, t, param = NULL) 
#> {
#>     checkScalar(alpha, "numeric", c(0, Inf), c(FALSE, FALSE))
#>     checkVector(t, "numeric", c(0, Inf), c(TRUE, FALSE))
#>     if (is.null(param) || param < 0.005 || param > 20) 
#>         param <- 1
#>     checkScalar(param, "numeric", c(0.005, 20), c(TRUE, TRUE))
#>     t[t > 1] <- 1
#>     if (param == 1) {
#>         rho <- 1
#>         txt <- "Lan-DeMets O'Brien-Fleming approximation"
#>         parname <- "none"
#>     }
#>     else {
#>         rho <- param
#>         txt <- "Generalized Lan-DeMets O'Brien-Fleming"
#>         parname <- "rho"
#>     }
#>     z <- -qnorm(alpha/2)
#>     x <- list(name = txt, param = param, parname = parname, sf = sfLDOF, 
#>         spend = 2 * (1 - pnorm(z/t^(rho/2))), bound = NULL, prob = NULL)
#>     class(x) <- "spendfn"
#>     x
#> }
#> <bytecode: 0x55ec28bf0d80>
#> <environment: namespace:gsDesign>
#> 
#> $input$upar$total_spend
#> [1] 0.025
#> 
#> 
#> $input$lower
#> function (k = 1, par = list(sf = gsDesign::sfLDOF, total_spend = 0.025, 
#>     param = NULL, timing = NULL, max_info = NULL), hgm1 = NULL, 
#>     theta = 0.1, info = 1:3, efficacy = TRUE, test_bound = TRUE, 
#>     r = 18, tol = 1e-06) 
#> {
#>     if (length(test_bound) == 1 && k > 1) {
#>         test_bound <- rep(test_bound, k)
#>     }
#>     if (!is.null(par$timing)) {
#>         timing <- par$timing
#>     }
#>     else {
#>         if (is.null(par$max_info)) {
#>             timing <- info/max(info)
#>         }
#>         else {
#>             timing <- info/par$max_info
#>         }
#>     }
#>     spend <- par$sf(alpha = par$total_spend, t = timing, param = par$param)$spend
#>     old_spend <- 0
#>     for (i in 1:k) {
#>         if (test_bound[i]) {
#>             xx <- spend[i] - old_spend
#>             old_spend <- spend[i]
#>             spend[i] <- xx
#>         }
#>         else {
#>             spend[i] <- 0
#>         }
#>     }
#>     spend <- spend[k]
#>     if (!efficacy) {
#>         if (spend <= 0) {
#>             return(-Inf)
#>         }
#>         if (length(theta) == 1) 
#>             theta <- rep(theta, length(info))
#>         a <- qnorm(spend) + sqrt(info[k]) * theta[k]
#>         if (k == 1) {
#>             return(a)
#>         }
#>         mu <- theta[k] * sqrt(info[k])
#>         extreme_low <- mu - 3 - 4 * log(r)
#>         extreme_high <- mu + 3 + 4 * log(r)
#>         adelta <- 1
#>         j <- 0
#>         while (abs(adelta) > tol) {
#>             hg <- hupdate(theta = theta[k], info = info[k], a = -Inf, 
#>                 b = a, thetam1 = theta[k - 1], im1 = info[k - 
#>                   1], gm1 = hgm1, r = r)
#>             i <- length(hg$h)
#>             pik <- sum(hg$h)
#>             adelta <- spend - pik
#>             dplo <- hg$h[i]/hg$w[i]
#>             if (adelta > dplo) {
#>                 adelta <- 1
#>             }
#>             else if (adelta < -dplo) {
#>                 adelta <- -1
#>             }
#>             else {
#>                 adelta <- adelta/dplo
#>             }
#>             a <- a + adelta
#>             if (a > extreme_high) {
#>                 a <- extreme_high
#>             }
#>             else if (a < extreme_low) {
#>                 a <- extreme_low
#>             }
#>             if (abs(adelta) < tol) {
#>                 return(a)
#>             }
#>             j <- j + 1
#>             if (j > 20) {
#>                 stop(paste("gs_spending_bound(): bound_update did not converge for lower bound calculation, analysis", 
#>                   k, " !"))
#>             }
#>         }
#>     }
#>     else {
#>         if (spend <= 0) {
#>             return(Inf)
#>         }
#>         if (length(theta) == 1) 
#>             theta <- rep(theta, length(info))
#>         b <- qnorm(spend, lower.tail = FALSE)
#>         if (k == 1) {
#>             return(b)
#>         }
#>         mu <- theta[k] * sqrt(info[k])
#>         extreme_low <- mu - 3 - 4 * log(r)
#>         extreme_high <- mu + 3 + 4 * log(r)
#>         bdelta <- 1
#>         j <- 1
#>         while (abs(bdelta) > tol) {
#>             hg <- hupdate(theta = 0, info = info[k], a = b, b = Inf, 
#>                 thetam1 = 0, im1 = info[k - 1], gm1 = hgm1, r = r)
#>             pik <- sum(hg$h)
#>             bdelta <- spend - pik
#>             dpikdb <- hg$h[1]/hg$w[1]
#>             if (bdelta > dpikdb) {
#>                 bdelta <- 1
#>             }
#>             else if (bdelta < -dpikdb) {
#>                 bdelta <- -1
#>             }
#>             else {
#>                 bdelta <- bdelta/dpikdb
#>             }
#>             b <- b - bdelta
#>             if (b > extreme_high) {
#>                 b <- extreme_high
#>             }
#>             else if (b < extreme_low) {
#>                 b <- extreme_low
#>             }
#>             if (abs(bdelta) < tol) {
#>                 return(b)
#>             }
#>             j <- j + 1
#>             if (j > 20) {
#>                 stop(paste("gs_spending_bound(): bound_update did not converge for lower bound calculation, analysis", 
#>                   k, " !"))
#>             }
#>         }
#>     }
#> }
#> <bytecode: 0x55ec2b3bbd08>
#> <environment: namespace:gsDesign2>
#> 
#> $input$lpar
#> $input$lpar$sf
#> function (alpha, t, param = NULL) 
#> {
#>     checkScalar(alpha, "numeric", c(0, Inf), c(FALSE, FALSE))
#>     checkVector(t, "numeric", c(0, Inf), c(TRUE, FALSE))
#>     if (is.null(param) || param < 0.005 || param > 20) 
#>         param <- 1
#>     checkScalar(param, "numeric", c(0.005, 20), c(TRUE, TRUE))
#>     t[t > 1] <- 1
#>     if (param == 1) {
#>         rho <- 1
#>         txt <- "Lan-DeMets O'Brien-Fleming approximation"
#>         parname <- "none"
#>     }
#>     else {
#>         rho <- param
#>         txt <- "Generalized Lan-DeMets O'Brien-Fleming"
#>         parname <- "rho"
#>     }
#>     z <- -qnorm(alpha/2)
#>     x <- list(name = txt, param = param, parname = parname, sf = sfLDOF, 
#>         spend = 2 * (1 - pnorm(z/t^(rho/2))), bound = NULL, prob = NULL)
#>     class(x) <- "spendfn"
#>     x
#> }
#> <bytecode: 0x55ec28bf0d80>
#> <environment: namespace:gsDesign>
#> 
#> $input$lpar$total_spend
#> [1] 0.1
#> 
#> 
#> $input$test_upper
#> [1] TRUE
#> 
#> $input$test_lower
#> [1] TRUE
#> 
#> $input$h1_spending
#> [1] TRUE
#> 
#> $input$binding
#> [1] FALSE
#> 
#> $input$info_scale
#> [1] "h0_h1_info"
#> 
#> $input$r
#> [1] 18
#> 
#> $input$tol
#> [1] 1e-06
#> 
#> 
#> $enroll_rate
#> # A tibble: 3 × 3
#>   stratum duration  rate
#>   <chr>      <dbl> <dbl>
#> 1 All            2  14.5
#> 2 All            2  29.1
#> 3 All           10  43.6
#> 
#> $fail_rate
#> # A tibble: 2 × 5
#>   stratum duration fail_rate dropout_rate    hr
#>   <chr>      <dbl>     <dbl>        <dbl> <dbl>
#> 1 All            3    0.0770        0.001   0.9
#> 2 All          100    0.0385        0.001   0.6
#> 
#> $bound
#> # A tibble: 6 × 7
#>   analysis bound probability probability0      z `~hr at bound` `nominal p`
#>      <int> <chr>       <dbl>        <dbl>  <dbl>          <dbl>       <dbl>
#> 1        1 upper     0.00248    0.0000538  3.87           0.459   0.0000538
#> 2        1 lower     0.00321    0.0443    -1.70           1.41    0.956    
#> 3        2 upper     0.579      0.00921    2.36           0.736   0.00919  
#> 4        2 lower     0.0556     0.830      0.953          0.884   0.170    
#> 5        3 upper     0.900      0.0244     2.01           0.799   0.0222   
#> 6        3 lower     0.100      0.976      2.01           0.799   0.0223   
#> 
#> $analysis
#> # A tibble: 3 × 10
#>   analysis  time     n event   ahr theta  info info0 info_frac info_frac0
#>      <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>     <dbl>      <dbl>
#> 1        1    12  436.  98.8 0.811 0.210  24.4  24.7     0.309      0.308
#> 2        2    24  523. 238.  0.715 0.335  58.1  59.4     0.738      0.741
#> 3        3    36  523. 321.  0.683 0.381  78.8  80.2     1          1    
#> 
#> attr(,"class")
#> [1] "non_binding" "ahr"         "gs_design"   "list"       

# Example 4 ----
# Specified information fraction
# \donttest{
gs_design_ahr(info_frac = c(.25, .75, 1), analysis_time = 36)
#> $input
#> $input$enroll_rate
#> # A tibble: 3 × 3
#>   stratum duration  rate
#>   <chr>      <dbl> <dbl>
#> 1 All            2     3
#> 2 All            2     6
#> 3 All           10     9
#> 
#> $input$fail_rate
#> # A tibble: 2 × 5
#>   stratum duration fail_rate dropout_rate    hr
#>   <chr>      <dbl>     <dbl>        <dbl> <dbl>
#> 1 All            3    0.0770        0.001   0.9
#> 2 All          100    0.0385        0.001   0.6
#> 
#> $input$alpha
#> [1] 0.025
#> 
#> $input$beta
#> [1] 0.1
#> 
#> $input$ratio
#> [1] 1
#> 
#> $input$info_frac
#> [1] 0.25 0.75 1.00
#> 
#> $input$analysis_time
#> [1] 36
#> 
#> $input$upper
#> function (k = 1, par = list(sf = gsDesign::sfLDOF, total_spend = 0.025, 
#>     param = NULL, timing = NULL, max_info = NULL), hgm1 = NULL, 
#>     theta = 0.1, info = 1:3, efficacy = TRUE, test_bound = TRUE, 
#>     r = 18, tol = 1e-06) 
#> {
#>     if (length(test_bound) == 1 && k > 1) {
#>         test_bound <- rep(test_bound, k)
#>     }
#>     if (!is.null(par$timing)) {
#>         timing <- par$timing
#>     }
#>     else {
#>         if (is.null(par$max_info)) {
#>             timing <- info/max(info)
#>         }
#>         else {
#>             timing <- info/par$max_info
#>         }
#>     }
#>     spend <- par$sf(alpha = par$total_spend, t = timing, param = par$param)$spend
#>     old_spend <- 0
#>     for (i in 1:k) {
#>         if (test_bound[i]) {
#>             xx <- spend[i] - old_spend
#>             old_spend <- spend[i]
#>             spend[i] <- xx
#>         }
#>         else {
#>             spend[i] <- 0
#>         }
#>     }
#>     spend <- spend[k]
#>     if (!efficacy) {
#>         if (spend <= 0) {
#>             return(-Inf)
#>         }
#>         if (length(theta) == 1) 
#>             theta <- rep(theta, length(info))
#>         a <- qnorm(spend) + sqrt(info[k]) * theta[k]
#>         if (k == 1) {
#>             return(a)
#>         }
#>         mu <- theta[k] * sqrt(info[k])
#>         extreme_low <- mu - 3 - 4 * log(r)
#>         extreme_high <- mu + 3 + 4 * log(r)
#>         adelta <- 1
#>         j <- 0
#>         while (abs(adelta) > tol) {
#>             hg <- hupdate(theta = theta[k], info = info[k], a = -Inf, 
#>                 b = a, thetam1 = theta[k - 1], im1 = info[k - 
#>                   1], gm1 = hgm1, r = r)
#>             i <- length(hg$h)
#>             pik <- sum(hg$h)
#>             adelta <- spend - pik
#>             dplo <- hg$h[i]/hg$w[i]
#>             if (adelta > dplo) {
#>                 adelta <- 1
#>             }
#>             else if (adelta < -dplo) {
#>                 adelta <- -1
#>             }
#>             else {
#>                 adelta <- adelta/dplo
#>             }
#>             a <- a + adelta
#>             if (a > extreme_high) {
#>                 a <- extreme_high
#>             }
#>             else if (a < extreme_low) {
#>                 a <- extreme_low
#>             }
#>             if (abs(adelta) < tol) {
#>                 return(a)
#>             }
#>             j <- j + 1
#>             if (j > 20) {
#>                 stop(paste("gs_spending_bound(): bound_update did not converge for lower bound calculation, analysis", 
#>                   k, " !"))
#>             }
#>         }
#>     }
#>     else {
#>         if (spend <= 0) {
#>             return(Inf)
#>         }
#>         if (length(theta) == 1) 
#>             theta <- rep(theta, length(info))
#>         b <- qnorm(spend, lower.tail = FALSE)
#>         if (k == 1) {
#>             return(b)
#>         }
#>         mu <- theta[k] * sqrt(info[k])
#>         extreme_low <- mu - 3 - 4 * log(r)
#>         extreme_high <- mu + 3 + 4 * log(r)
#>         bdelta <- 1
#>         j <- 1
#>         while (abs(bdelta) > tol) {
#>             hg <- hupdate(theta = 0, info = info[k], a = b, b = Inf, 
#>                 thetam1 = 0, im1 = info[k - 1], gm1 = hgm1, r = r)
#>             pik <- sum(hg$h)
#>             bdelta <- spend - pik
#>             dpikdb <- hg$h[1]/hg$w[1]
#>             if (bdelta > dpikdb) {
#>                 bdelta <- 1
#>             }
#>             else if (bdelta < -dpikdb) {
#>                 bdelta <- -1
#>             }
#>             else {
#>                 bdelta <- bdelta/dpikdb
#>             }
#>             b <- b - bdelta
#>             if (b > extreme_high) {
#>                 b <- extreme_high
#>             }
#>             else if (b < extreme_low) {
#>                 b <- extreme_low
#>             }
#>             if (abs(bdelta) < tol) {
#>                 return(b)
#>             }
#>             j <- j + 1
#>             if (j > 20) {
#>                 stop(paste("gs_spending_bound(): bound_update did not converge for lower bound calculation, analysis", 
#>                   k, " !"))
#>             }
#>         }
#>     }
#> }
#> <bytecode: 0x55ec2b3bbd08>
#> <environment: namespace:gsDesign2>
#> 
#> $input$upar
#> $input$upar$sf
#> function (alpha, t, param = NULL) 
#> {
#>     checkScalar(alpha, "numeric", c(0, Inf), c(FALSE, FALSE))
#>     checkVector(t, "numeric", c(0, Inf), c(TRUE, FALSE))
#>     if (is.null(param) || param < 0.005 || param > 20) 
#>         param <- 1
#>     checkScalar(param, "numeric", c(0.005, 20), c(TRUE, TRUE))
#>     t[t > 1] <- 1
#>     if (param == 1) {
#>         rho <- 1
#>         txt <- "Lan-DeMets O'Brien-Fleming approximation"
#>         parname <- "none"
#>     }
#>     else {
#>         rho <- param
#>         txt <- "Generalized Lan-DeMets O'Brien-Fleming"
#>         parname <- "rho"
#>     }
#>     z <- -qnorm(alpha/2)
#>     x <- list(name = txt, param = param, parname = parname, sf = sfLDOF, 
#>         spend = 2 * (1 - pnorm(z/t^(rho/2))), bound = NULL, prob = NULL)
#>     class(x) <- "spendfn"
#>     x
#> }
#> <bytecode: 0x55ec28bf0d80>
#> <environment: namespace:gsDesign>
#> 
#> $input$upar$total_spend
#> [1] 0.025
#> 
#> 
#> $input$lower
#> function (k = 1, par = list(sf = gsDesign::sfLDOF, total_spend = 0.025, 
#>     param = NULL, timing = NULL, max_info = NULL), hgm1 = NULL, 
#>     theta = 0.1, info = 1:3, efficacy = TRUE, test_bound = TRUE, 
#>     r = 18, tol = 1e-06) 
#> {
#>     if (length(test_bound) == 1 && k > 1) {
#>         test_bound <- rep(test_bound, k)
#>     }
#>     if (!is.null(par$timing)) {
#>         timing <- par$timing
#>     }
#>     else {
#>         if (is.null(par$max_info)) {
#>             timing <- info/max(info)
#>         }
#>         else {
#>             timing <- info/par$max_info
#>         }
#>     }
#>     spend <- par$sf(alpha = par$total_spend, t = timing, param = par$param)$spend
#>     old_spend <- 0
#>     for (i in 1:k) {
#>         if (test_bound[i]) {
#>             xx <- spend[i] - old_spend
#>             old_spend <- spend[i]
#>             spend[i] <- xx
#>         }
#>         else {
#>             spend[i] <- 0
#>         }
#>     }
#>     spend <- spend[k]
#>     if (!efficacy) {
#>         if (spend <= 0) {
#>             return(-Inf)
#>         }
#>         if (length(theta) == 1) 
#>             theta <- rep(theta, length(info))
#>         a <- qnorm(spend) + sqrt(info[k]) * theta[k]
#>         if (k == 1) {
#>             return(a)
#>         }
#>         mu <- theta[k] * sqrt(info[k])
#>         extreme_low <- mu - 3 - 4 * log(r)
#>         extreme_high <- mu + 3 + 4 * log(r)
#>         adelta <- 1
#>         j <- 0
#>         while (abs(adelta) > tol) {
#>             hg <- hupdate(theta = theta[k], info = info[k], a = -Inf, 
#>                 b = a, thetam1 = theta[k - 1], im1 = info[k - 
#>                   1], gm1 = hgm1, r = r)
#>             i <- length(hg$h)
#>             pik <- sum(hg$h)
#>             adelta <- spend - pik
#>             dplo <- hg$h[i]/hg$w[i]
#>             if (adelta > dplo) {
#>                 adelta <- 1
#>             }
#>             else if (adelta < -dplo) {
#>                 adelta <- -1
#>             }
#>             else {
#>                 adelta <- adelta/dplo
#>             }
#>             a <- a + adelta
#>             if (a > extreme_high) {
#>                 a <- extreme_high
#>             }
#>             else if (a < extreme_low) {
#>                 a <- extreme_low
#>             }
#>             if (abs(adelta) < tol) {
#>                 return(a)
#>             }
#>             j <- j + 1
#>             if (j > 20) {
#>                 stop(paste("gs_spending_bound(): bound_update did not converge for lower bound calculation, analysis", 
#>                   k, " !"))
#>             }
#>         }
#>     }
#>     else {
#>         if (spend <= 0) {
#>             return(Inf)
#>         }
#>         if (length(theta) == 1) 
#>             theta <- rep(theta, length(info))
#>         b <- qnorm(spend, lower.tail = FALSE)
#>         if (k == 1) {
#>             return(b)
#>         }
#>         mu <- theta[k] * sqrt(info[k])
#>         extreme_low <- mu - 3 - 4 * log(r)
#>         extreme_high <- mu + 3 + 4 * log(r)
#>         bdelta <- 1
#>         j <- 1
#>         while (abs(bdelta) > tol) {
#>             hg <- hupdate(theta = 0, info = info[k], a = b, b = Inf, 
#>                 thetam1 = 0, im1 = info[k - 1], gm1 = hgm1, r = r)
#>             pik <- sum(hg$h)
#>             bdelta <- spend - pik
#>             dpikdb <- hg$h[1]/hg$w[1]
#>             if (bdelta > dpikdb) {
#>                 bdelta <- 1
#>             }
#>             else if (bdelta < -dpikdb) {
#>                 bdelta <- -1
#>             }
#>             else {
#>                 bdelta <- bdelta/dpikdb
#>             }
#>             b <- b - bdelta
#>             if (b > extreme_high) {
#>                 b <- extreme_high
#>             }
#>             else if (b < extreme_low) {
#>                 b <- extreme_low
#>             }
#>             if (abs(bdelta) < tol) {
#>                 return(b)
#>             }
#>             j <- j + 1
#>             if (j > 20) {
#>                 stop(paste("gs_spending_bound(): bound_update did not converge for lower bound calculation, analysis", 
#>                   k, " !"))
#>             }
#>         }
#>     }
#> }
#> <bytecode: 0x55ec2b3bbd08>
#> <environment: namespace:gsDesign2>
#> 
#> $input$lpar
#> $input$lpar$sf
#> function (alpha, t, param = NULL) 
#> {
#>     checkScalar(alpha, "numeric", c(0, Inf), c(FALSE, FALSE))
#>     checkVector(t, "numeric", c(0, Inf), c(TRUE, FALSE))
#>     if (is.null(param) || param < 0.005 || param > 20) 
#>         param <- 1
#>     checkScalar(param, "numeric", c(0.005, 20), c(TRUE, TRUE))
#>     t[t > 1] <- 1
#>     if (param == 1) {
#>         rho <- 1
#>         txt <- "Lan-DeMets O'Brien-Fleming approximation"
#>         parname <- "none"
#>     }
#>     else {
#>         rho <- param
#>         txt <- "Generalized Lan-DeMets O'Brien-Fleming"
#>         parname <- "rho"
#>     }
#>     z <- -qnorm(alpha/2)
#>     x <- list(name = txt, param = param, parname = parname, sf = sfLDOF, 
#>         spend = 2 * (1 - pnorm(z/t^(rho/2))), bound = NULL, prob = NULL)
#>     class(x) <- "spendfn"
#>     x
#> }
#> <bytecode: 0x55ec28bf0d80>
#> <environment: namespace:gsDesign>
#> 
#> $input$lpar$total_spend
#> [1] 0.1
#> 
#> 
#> $input$test_upper
#> [1] TRUE
#> 
#> $input$test_lower
#> [1] TRUE
#> 
#> $input$h1_spending
#> [1] TRUE
#> 
#> $input$binding
#> [1] FALSE
#> 
#> $input$info_scale
#> [1] "h0_h1_info"
#> 
#> $input$r
#> [1] 18
#> 
#> $input$tol
#> [1] 1e-06
#> 
#> 
#> $enroll_rate
#> # A tibble: 3 × 3
#>   stratum duration  rate
#>   <chr>      <dbl> <dbl>
#> 1 All            2  14.6
#> 2 All            2  29.1
#> 3 All           10  43.7
#> 
#> $fail_rate
#> # A tibble: 2 × 5
#>   stratum duration fail_rate dropout_rate    hr
#>   <chr>      <dbl>     <dbl>        <dbl> <dbl>
#> 1 All            3    0.0770        0.001   0.9
#> 2 All          100    0.0385        0.001   0.6
#> 
#> $bound
#> # A tibble: 6 × 7
#>   analysis bound probability probability0     z `~hr at bound` `nominal p`
#>      <int> <chr>       <dbl>        <dbl> <dbl>          <dbl>       <dbl>
#> 1        1 upper    0.000295   0.00000737  4.33          0.380  0.00000737
#> 2        1 lower    0.00108    0.0135     -2.21          1.64   0.987     
#> 3        2 upper    0.599      0.00965     2.34          0.740  0.00965   
#> 4        2 lower    0.0570     0.843       1.01          0.878  0.157     
#> 5        3 upper    0.900      0.0244      2.01          0.799  0.0221    
#> 6        3 lower    0.100      0.976       2.01          0.799  0.0221    
#> 
#> $analysis
#> # A tibble: 3 × 10
#>   analysis  time     n event   ahr theta  info info0 info_frac info_frac0
#>      <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>     <dbl>      <dbl>
#> 1        1  10.7  382.  80.4 0.823 0.195  19.8  20.1     0.251      0.250
#> 2        2  24.4  524. 241.  0.714 0.337  59.0  60.3     0.747      0.750
#> 3        3  36    524. 322.  0.683 0.381  79.0  80.4     1          1    
#> 
#> attr(,"class")
#> [1] "non_binding" "ahr"         "gs_design"   "list"       
# }

# Example 5 ----
# multiple analysis times & info_frac
# driven by times
gs_design_ahr(info_frac = c(.25, .75, 1), analysis_time = c(12, 25, 36))
#> $input
#> $input$enroll_rate
#> # A tibble: 3 × 3
#>   stratum duration  rate
#>   <chr>      <dbl> <dbl>
#> 1 All            2     3
#> 2 All            2     6
#> 3 All           10     9
#> 
#> $input$fail_rate
#> # A tibble: 2 × 5
#>   stratum duration fail_rate dropout_rate    hr
#>   <chr>      <dbl>     <dbl>        <dbl> <dbl>
#> 1 All            3    0.0770        0.001   0.9
#> 2 All          100    0.0385        0.001   0.6
#> 
#> $input$alpha
#> [1] 0.025
#> 
#> $input$beta
#> [1] 0.1
#> 
#> $input$ratio
#> [1] 1
#> 
#> $input$info_frac
#> [1] 0.25 0.75 1.00
#> 
#> $input$analysis_time
#> [1] 12 25 36
#> 
#> $input$upper
#> function (k = 1, par = list(sf = gsDesign::sfLDOF, total_spend = 0.025, 
#>     param = NULL, timing = NULL, max_info = NULL), hgm1 = NULL, 
#>     theta = 0.1, info = 1:3, efficacy = TRUE, test_bound = TRUE, 
#>     r = 18, tol = 1e-06) 
#> {
#>     if (length(test_bound) == 1 && k > 1) {
#>         test_bound <- rep(test_bound, k)
#>     }
#>     if (!is.null(par$timing)) {
#>         timing <- par$timing
#>     }
#>     else {
#>         if (is.null(par$max_info)) {
#>             timing <- info/max(info)
#>         }
#>         else {
#>             timing <- info/par$max_info
#>         }
#>     }
#>     spend <- par$sf(alpha = par$total_spend, t = timing, param = par$param)$spend
#>     old_spend <- 0
#>     for (i in 1:k) {
#>         if (test_bound[i]) {
#>             xx <- spend[i] - old_spend
#>             old_spend <- spend[i]
#>             spend[i] <- xx
#>         }
#>         else {
#>             spend[i] <- 0
#>         }
#>     }
#>     spend <- spend[k]
#>     if (!efficacy) {
#>         if (spend <= 0) {
#>             return(-Inf)
#>         }
#>         if (length(theta) == 1) 
#>             theta <- rep(theta, length(info))
#>         a <- qnorm(spend) + sqrt(info[k]) * theta[k]
#>         if (k == 1) {
#>             return(a)
#>         }
#>         mu <- theta[k] * sqrt(info[k])
#>         extreme_low <- mu - 3 - 4 * log(r)
#>         extreme_high <- mu + 3 + 4 * log(r)
#>         adelta <- 1
#>         j <- 0
#>         while (abs(adelta) > tol) {
#>             hg <- hupdate(theta = theta[k], info = info[k], a = -Inf, 
#>                 b = a, thetam1 = theta[k - 1], im1 = info[k - 
#>                   1], gm1 = hgm1, r = r)
#>             i <- length(hg$h)
#>             pik <- sum(hg$h)
#>             adelta <- spend - pik
#>             dplo <- hg$h[i]/hg$w[i]
#>             if (adelta > dplo) {
#>                 adelta <- 1
#>             }
#>             else if (adelta < -dplo) {
#>                 adelta <- -1
#>             }
#>             else {
#>                 adelta <- adelta/dplo
#>             }
#>             a <- a + adelta
#>             if (a > extreme_high) {
#>                 a <- extreme_high
#>             }
#>             else if (a < extreme_low) {
#>                 a <- extreme_low
#>             }
#>             if (abs(adelta) < tol) {
#>                 return(a)
#>             }
#>             j <- j + 1
#>             if (j > 20) {
#>                 stop(paste("gs_spending_bound(): bound_update did not converge for lower bound calculation, analysis", 
#>                   k, " !"))
#>             }
#>         }
#>     }
#>     else {
#>         if (spend <= 0) {
#>             return(Inf)
#>         }
#>         if (length(theta) == 1) 
#>             theta <- rep(theta, length(info))
#>         b <- qnorm(spend, lower.tail = FALSE)
#>         if (k == 1) {
#>             return(b)
#>         }
#>         mu <- theta[k] * sqrt(info[k])
#>         extreme_low <- mu - 3 - 4 * log(r)
#>         extreme_high <- mu + 3 + 4 * log(r)
#>         bdelta <- 1
#>         j <- 1
#>         while (abs(bdelta) > tol) {
#>             hg <- hupdate(theta = 0, info = info[k], a = b, b = Inf, 
#>                 thetam1 = 0, im1 = info[k - 1], gm1 = hgm1, r = r)
#>             pik <- sum(hg$h)
#>             bdelta <- spend - pik
#>             dpikdb <- hg$h[1]/hg$w[1]
#>             if (bdelta > dpikdb) {
#>                 bdelta <- 1
#>             }
#>             else if (bdelta < -dpikdb) {
#>                 bdelta <- -1
#>             }
#>             else {
#>                 bdelta <- bdelta/dpikdb
#>             }
#>             b <- b - bdelta
#>             if (b > extreme_high) {
#>                 b <- extreme_high
#>             }
#>             else if (b < extreme_low) {
#>                 b <- extreme_low
#>             }
#>             if (abs(bdelta) < tol) {
#>                 return(b)
#>             }
#>             j <- j + 1
#>             if (j > 20) {
#>                 stop(paste("gs_spending_bound(): bound_update did not converge for lower bound calculation, analysis", 
#>                   k, " !"))
#>             }
#>         }
#>     }
#> }
#> <bytecode: 0x55ec2b3bbd08>
#> <environment: namespace:gsDesign2>
#> 
#> $input$upar
#> $input$upar$sf
#> function (alpha, t, param = NULL) 
#> {
#>     checkScalar(alpha, "numeric", c(0, Inf), c(FALSE, FALSE))
#>     checkVector(t, "numeric", c(0, Inf), c(TRUE, FALSE))
#>     if (is.null(param) || param < 0.005 || param > 20) 
#>         param <- 1
#>     checkScalar(param, "numeric", c(0.005, 20), c(TRUE, TRUE))
#>     t[t > 1] <- 1
#>     if (param == 1) {
#>         rho <- 1
#>         txt <- "Lan-DeMets O'Brien-Fleming approximation"
#>         parname <- "none"
#>     }
#>     else {
#>         rho <- param
#>         txt <- "Generalized Lan-DeMets O'Brien-Fleming"
#>         parname <- "rho"
#>     }
#>     z <- -qnorm(alpha/2)
#>     x <- list(name = txt, param = param, parname = parname, sf = sfLDOF, 
#>         spend = 2 * (1 - pnorm(z/t^(rho/2))), bound = NULL, prob = NULL)
#>     class(x) <- "spendfn"
#>     x
#> }
#> <bytecode: 0x55ec28bf0d80>
#> <environment: namespace:gsDesign>
#> 
#> $input$upar$total_spend
#> [1] 0.025
#> 
#> 
#> $input$lower
#> function (k = 1, par = list(sf = gsDesign::sfLDOF, total_spend = 0.025, 
#>     param = NULL, timing = NULL, max_info = NULL), hgm1 = NULL, 
#>     theta = 0.1, info = 1:3, efficacy = TRUE, test_bound = TRUE, 
#>     r = 18, tol = 1e-06) 
#> {
#>     if (length(test_bound) == 1 && k > 1) {
#>         test_bound <- rep(test_bound, k)
#>     }
#>     if (!is.null(par$timing)) {
#>         timing <- par$timing
#>     }
#>     else {
#>         if (is.null(par$max_info)) {
#>             timing <- info/max(info)
#>         }
#>         else {
#>             timing <- info/par$max_info
#>         }
#>     }
#>     spend <- par$sf(alpha = par$total_spend, t = timing, param = par$param)$spend
#>     old_spend <- 0
#>     for (i in 1:k) {
#>         if (test_bound[i]) {
#>             xx <- spend[i] - old_spend
#>             old_spend <- spend[i]
#>             spend[i] <- xx
#>         }
#>         else {
#>             spend[i] <- 0
#>         }
#>     }
#>     spend <- spend[k]
#>     if (!efficacy) {
#>         if (spend <= 0) {
#>             return(-Inf)
#>         }
#>         if (length(theta) == 1) 
#>             theta <- rep(theta, length(info))
#>         a <- qnorm(spend) + sqrt(info[k]) * theta[k]
#>         if (k == 1) {
#>             return(a)
#>         }
#>         mu <- theta[k] * sqrt(info[k])
#>         extreme_low <- mu - 3 - 4 * log(r)
#>         extreme_high <- mu + 3 + 4 * log(r)
#>         adelta <- 1
#>         j <- 0
#>         while (abs(adelta) > tol) {
#>             hg <- hupdate(theta = theta[k], info = info[k], a = -Inf, 
#>                 b = a, thetam1 = theta[k - 1], im1 = info[k - 
#>                   1], gm1 = hgm1, r = r)
#>             i <- length(hg$h)
#>             pik <- sum(hg$h)
#>             adelta <- spend - pik
#>             dplo <- hg$h[i]/hg$w[i]
#>             if (adelta > dplo) {
#>                 adelta <- 1
#>             }
#>             else if (adelta < -dplo) {
#>                 adelta <- -1
#>             }
#>             else {
#>                 adelta <- adelta/dplo
#>             }
#>             a <- a + adelta
#>             if (a > extreme_high) {
#>                 a <- extreme_high
#>             }
#>             else if (a < extreme_low) {
#>                 a <- extreme_low
#>             }
#>             if (abs(adelta) < tol) {
#>                 return(a)
#>             }
#>             j <- j + 1
#>             if (j > 20) {
#>                 stop(paste("gs_spending_bound(): bound_update did not converge for lower bound calculation, analysis", 
#>                   k, " !"))
#>             }
#>         }
#>     }
#>     else {
#>         if (spend <= 0) {
#>             return(Inf)
#>         }
#>         if (length(theta) == 1) 
#>             theta <- rep(theta, length(info))
#>         b <- qnorm(spend, lower.tail = FALSE)
#>         if (k == 1) {
#>             return(b)
#>         }
#>         mu <- theta[k] * sqrt(info[k])
#>         extreme_low <- mu - 3 - 4 * log(r)
#>         extreme_high <- mu + 3 + 4 * log(r)
#>         bdelta <- 1
#>         j <- 1
#>         while (abs(bdelta) > tol) {
#>             hg <- hupdate(theta = 0, info = info[k], a = b, b = Inf, 
#>                 thetam1 = 0, im1 = info[k - 1], gm1 = hgm1, r = r)
#>             pik <- sum(hg$h)
#>             bdelta <- spend - pik
#>             dpikdb <- hg$h[1]/hg$w[1]
#>             if (bdelta > dpikdb) {
#>                 bdelta <- 1
#>             }
#>             else if (bdelta < -dpikdb) {
#>                 bdelta <- -1
#>             }
#>             else {
#>                 bdelta <- bdelta/dpikdb
#>             }
#>             b <- b - bdelta
#>             if (b > extreme_high) {
#>                 b <- extreme_high
#>             }
#>             else if (b < extreme_low) {
#>                 b <- extreme_low
#>             }
#>             if (abs(bdelta) < tol) {
#>                 return(b)
#>             }
#>             j <- j + 1
#>             if (j > 20) {
#>                 stop(paste("gs_spending_bound(): bound_update did not converge for lower bound calculation, analysis", 
#>                   k, " !"))
#>             }
#>         }
#>     }
#> }
#> <bytecode: 0x55ec2b3bbd08>
#> <environment: namespace:gsDesign2>
#> 
#> $input$lpar
#> $input$lpar$sf
#> function (alpha, t, param = NULL) 
#> {
#>     checkScalar(alpha, "numeric", c(0, Inf), c(FALSE, FALSE))
#>     checkVector(t, "numeric", c(0, Inf), c(TRUE, FALSE))
#>     if (is.null(param) || param < 0.005 || param > 20) 
#>         param <- 1
#>     checkScalar(param, "numeric", c(0.005, 20), c(TRUE, TRUE))
#>     t[t > 1] <- 1
#>     if (param == 1) {
#>         rho <- 1
#>         txt <- "Lan-DeMets O'Brien-Fleming approximation"
#>         parname <- "none"
#>     }
#>     else {
#>         rho <- param
#>         txt <- "Generalized Lan-DeMets O'Brien-Fleming"
#>         parname <- "rho"
#>     }
#>     z <- -qnorm(alpha/2)
#>     x <- list(name = txt, param = param, parname = parname, sf = sfLDOF, 
#>         spend = 2 * (1 - pnorm(z/t^(rho/2))), bound = NULL, prob = NULL)
#>     class(x) <- "spendfn"
#>     x
#> }
#> <bytecode: 0x55ec28bf0d80>
#> <environment: namespace:gsDesign>
#> 
#> $input$lpar$total_spend
#> [1] 0.1
#> 
#> 
#> $input$test_upper
#> [1] TRUE
#> 
#> $input$test_lower
#> [1] TRUE
#> 
#> $input$h1_spending
#> [1] TRUE
#> 
#> $input$binding
#> [1] FALSE
#> 
#> $input$info_scale
#> [1] "h0_h1_info"
#> 
#> $input$r
#> [1] 18
#> 
#> $input$tol
#> [1] 1e-06
#> 
#> 
#> $enroll_rate
#> # A tibble: 3 × 3
#>   stratum duration  rate
#>   <chr>      <dbl> <dbl>
#> 1 All            2  14.6
#> 2 All            2  29.3
#> 3 All           10  43.9
#> 
#> $fail_rate
#> # A tibble: 2 × 5
#>   stratum duration fail_rate dropout_rate    hr
#>   <chr>      <dbl>     <dbl>        <dbl> <dbl>
#> 1 All            3    0.0770        0.001   0.9
#> 2 All          100    0.0385        0.001   0.6
#> 
#> $bound
#> # A tibble: 6 × 7
#>   analysis bound probability probability0     z `~hr at bound` `nominal p`
#>      <int> <chr>       <dbl>        <dbl> <dbl>          <dbl>       <dbl>
#> 1        1 upper     0.00251    0.0000538  3.87          0.460   0.0000538
#> 2        1 lower     0.00321    0.0446    -1.70          1.41    0.955    
#> 3        2 upper     0.635      0.0105     2.31          0.746   0.0104   
#> 4        2 lower     0.0599     0.862      1.09          0.871   0.138    
#> 5        3 upper     0.900      0.0243     2.02          0.799   0.0219   
#> 6        3 lower     0.100      0.976      2.01          0.799   0.0220   
#> 
#> $analysis
#> # A tibble: 3 × 10
#>   analysis  time     n event   ahr theta  info info0 info_frac info_frac0
#>      <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>     <dbl>      <dbl>
#> 1        1    12  439.  99.5 0.811 0.210  24.5  24.9     0.309      0.308
#> 2        2    25  527. 248.  0.711 0.341  60.5  61.9     0.763      0.766
#> 3        3    36  527. 323.  0.683 0.381  79.3  80.7     1          1    
#> 
#> attr(,"class")
#> [1] "non_binding" "ahr"         "gs_design"   "list"       
# driven by info_frac
# \donttest{
gs_design_ahr(info_frac = c(1 / 3, .8, 1), analysis_time = c(12, 25, 36))
#> $input
#> $input$enroll_rate
#> # A tibble: 3 × 3
#>   stratum duration  rate
#>   <chr>      <dbl> <dbl>
#> 1 All            2     3
#> 2 All            2     6
#> 3 All           10     9
#> 
#> $input$fail_rate
#> # A tibble: 2 × 5
#>   stratum duration fail_rate dropout_rate    hr
#>   <chr>      <dbl>     <dbl>        <dbl> <dbl>
#> 1 All            3    0.0770        0.001   0.9
#> 2 All          100    0.0385        0.001   0.6
#> 
#> $input$alpha
#> [1] 0.025
#> 
#> $input$beta
#> [1] 0.1
#> 
#> $input$ratio
#> [1] 1
#> 
#> $input$info_frac
#> [1] 0.3333333 0.8000000 1.0000000
#> 
#> $input$analysis_time
#> [1] 12 25 36
#> 
#> $input$upper
#> function (k = 1, par = list(sf = gsDesign::sfLDOF, total_spend = 0.025, 
#>     param = NULL, timing = NULL, max_info = NULL), hgm1 = NULL, 
#>     theta = 0.1, info = 1:3, efficacy = TRUE, test_bound = TRUE, 
#>     r = 18, tol = 1e-06) 
#> {
#>     if (length(test_bound) == 1 && k > 1) {
#>         test_bound <- rep(test_bound, k)
#>     }
#>     if (!is.null(par$timing)) {
#>         timing <- par$timing
#>     }
#>     else {
#>         if (is.null(par$max_info)) {
#>             timing <- info/max(info)
#>         }
#>         else {
#>             timing <- info/par$max_info
#>         }
#>     }
#>     spend <- par$sf(alpha = par$total_spend, t = timing, param = par$param)$spend
#>     old_spend <- 0
#>     for (i in 1:k) {
#>         if (test_bound[i]) {
#>             xx <- spend[i] - old_spend
#>             old_spend <- spend[i]
#>             spend[i] <- xx
#>         }
#>         else {
#>             spend[i] <- 0
#>         }
#>     }
#>     spend <- spend[k]
#>     if (!efficacy) {
#>         if (spend <= 0) {
#>             return(-Inf)
#>         }
#>         if (length(theta) == 1) 
#>             theta <- rep(theta, length(info))
#>         a <- qnorm(spend) + sqrt(info[k]) * theta[k]
#>         if (k == 1) {
#>             return(a)
#>         }
#>         mu <- theta[k] * sqrt(info[k])
#>         extreme_low <- mu - 3 - 4 * log(r)
#>         extreme_high <- mu + 3 + 4 * log(r)
#>         adelta <- 1
#>         j <- 0
#>         while (abs(adelta) > tol) {
#>             hg <- hupdate(theta = theta[k], info = info[k], a = -Inf, 
#>                 b = a, thetam1 = theta[k - 1], im1 = info[k - 
#>                   1], gm1 = hgm1, r = r)
#>             i <- length(hg$h)
#>             pik <- sum(hg$h)
#>             adelta <- spend - pik
#>             dplo <- hg$h[i]/hg$w[i]
#>             if (adelta > dplo) {
#>                 adelta <- 1
#>             }
#>             else if (adelta < -dplo) {
#>                 adelta <- -1
#>             }
#>             else {
#>                 adelta <- adelta/dplo
#>             }
#>             a <- a + adelta
#>             if (a > extreme_high) {
#>                 a <- extreme_high
#>             }
#>             else if (a < extreme_low) {
#>                 a <- extreme_low
#>             }
#>             if (abs(adelta) < tol) {
#>                 return(a)
#>             }
#>             j <- j + 1
#>             if (j > 20) {
#>                 stop(paste("gs_spending_bound(): bound_update did not converge for lower bound calculation, analysis", 
#>                   k, " !"))
#>             }
#>         }
#>     }
#>     else {
#>         if (spend <= 0) {
#>             return(Inf)
#>         }
#>         if (length(theta) == 1) 
#>             theta <- rep(theta, length(info))
#>         b <- qnorm(spend, lower.tail = FALSE)
#>         if (k == 1) {
#>             return(b)
#>         }
#>         mu <- theta[k] * sqrt(info[k])
#>         extreme_low <- mu - 3 - 4 * log(r)
#>         extreme_high <- mu + 3 + 4 * log(r)
#>         bdelta <- 1
#>         j <- 1
#>         while (abs(bdelta) > tol) {
#>             hg <- hupdate(theta = 0, info = info[k], a = b, b = Inf, 
#>                 thetam1 = 0, im1 = info[k - 1], gm1 = hgm1, r = r)
#>             pik <- sum(hg$h)
#>             bdelta <- spend - pik
#>             dpikdb <- hg$h[1]/hg$w[1]
#>             if (bdelta > dpikdb) {
#>                 bdelta <- 1
#>             }
#>             else if (bdelta < -dpikdb) {
#>                 bdelta <- -1
#>             }
#>             else {
#>                 bdelta <- bdelta/dpikdb
#>             }
#>             b <- b - bdelta
#>             if (b > extreme_high) {
#>                 b <- extreme_high
#>             }
#>             else if (b < extreme_low) {
#>                 b <- extreme_low
#>             }
#>             if (abs(bdelta) < tol) {
#>                 return(b)
#>             }
#>             j <- j + 1
#>             if (j > 20) {
#>                 stop(paste("gs_spending_bound(): bound_update did not converge for lower bound calculation, analysis", 
#>                   k, " !"))
#>             }
#>         }
#>     }
#> }
#> <bytecode: 0x55ec2b3bbd08>
#> <environment: namespace:gsDesign2>
#> 
#> $input$upar
#> $input$upar$sf
#> function (alpha, t, param = NULL) 
#> {
#>     checkScalar(alpha, "numeric", c(0, Inf), c(FALSE, FALSE))
#>     checkVector(t, "numeric", c(0, Inf), c(TRUE, FALSE))
#>     if (is.null(param) || param < 0.005 || param > 20) 
#>         param <- 1
#>     checkScalar(param, "numeric", c(0.005, 20), c(TRUE, TRUE))
#>     t[t > 1] <- 1
#>     if (param == 1) {
#>         rho <- 1
#>         txt <- "Lan-DeMets O'Brien-Fleming approximation"
#>         parname <- "none"
#>     }
#>     else {
#>         rho <- param
#>         txt <- "Generalized Lan-DeMets O'Brien-Fleming"
#>         parname <- "rho"
#>     }
#>     z <- -qnorm(alpha/2)
#>     x <- list(name = txt, param = param, parname = parname, sf = sfLDOF, 
#>         spend = 2 * (1 - pnorm(z/t^(rho/2))), bound = NULL, prob = NULL)
#>     class(x) <- "spendfn"
#>     x
#> }
#> <bytecode: 0x55ec28bf0d80>
#> <environment: namespace:gsDesign>
#> 
#> $input$upar$total_spend
#> [1] 0.025
#> 
#> 
#> $input$lower
#> function (k = 1, par = list(sf = gsDesign::sfLDOF, total_spend = 0.025, 
#>     param = NULL, timing = NULL, max_info = NULL), hgm1 = NULL, 
#>     theta = 0.1, info = 1:3, efficacy = TRUE, test_bound = TRUE, 
#>     r = 18, tol = 1e-06) 
#> {
#>     if (length(test_bound) == 1 && k > 1) {
#>         test_bound <- rep(test_bound, k)
#>     }
#>     if (!is.null(par$timing)) {
#>         timing <- par$timing
#>     }
#>     else {
#>         if (is.null(par$max_info)) {
#>             timing <- info/max(info)
#>         }
#>         else {
#>             timing <- info/par$max_info
#>         }
#>     }
#>     spend <- par$sf(alpha = par$total_spend, t = timing, param = par$param)$spend
#>     old_spend <- 0
#>     for (i in 1:k) {
#>         if (test_bound[i]) {
#>             xx <- spend[i] - old_spend
#>             old_spend <- spend[i]
#>             spend[i] <- xx
#>         }
#>         else {
#>             spend[i] <- 0
#>         }
#>     }
#>     spend <- spend[k]
#>     if (!efficacy) {
#>         if (spend <= 0) {
#>             return(-Inf)
#>         }
#>         if (length(theta) == 1) 
#>             theta <- rep(theta, length(info))
#>         a <- qnorm(spend) + sqrt(info[k]) * theta[k]
#>         if (k == 1) {
#>             return(a)
#>         }
#>         mu <- theta[k] * sqrt(info[k])
#>         extreme_low <- mu - 3 - 4 * log(r)
#>         extreme_high <- mu + 3 + 4 * log(r)
#>         adelta <- 1
#>         j <- 0
#>         while (abs(adelta) > tol) {
#>             hg <- hupdate(theta = theta[k], info = info[k], a = -Inf, 
#>                 b = a, thetam1 = theta[k - 1], im1 = info[k - 
#>                   1], gm1 = hgm1, r = r)
#>             i <- length(hg$h)
#>             pik <- sum(hg$h)
#>             adelta <- spend - pik
#>             dplo <- hg$h[i]/hg$w[i]
#>             if (adelta > dplo) {
#>                 adelta <- 1
#>             }
#>             else if (adelta < -dplo) {
#>                 adelta <- -1
#>             }
#>             else {
#>                 adelta <- adelta/dplo
#>             }
#>             a <- a + adelta
#>             if (a > extreme_high) {
#>                 a <- extreme_high
#>             }
#>             else if (a < extreme_low) {
#>                 a <- extreme_low
#>             }
#>             if (abs(adelta) < tol) {
#>                 return(a)
#>             }
#>             j <- j + 1
#>             if (j > 20) {
#>                 stop(paste("gs_spending_bound(): bound_update did not converge for lower bound calculation, analysis", 
#>                   k, " !"))
#>             }
#>         }
#>     }
#>     else {
#>         if (spend <= 0) {
#>             return(Inf)
#>         }
#>         if (length(theta) == 1) 
#>             theta <- rep(theta, length(info))
#>         b <- qnorm(spend, lower.tail = FALSE)
#>         if (k == 1) {
#>             return(b)
#>         }
#>         mu <- theta[k] * sqrt(info[k])
#>         extreme_low <- mu - 3 - 4 * log(r)
#>         extreme_high <- mu + 3 + 4 * log(r)
#>         bdelta <- 1
#>         j <- 1
#>         while (abs(bdelta) > tol) {
#>             hg <- hupdate(theta = 0, info = info[k], a = b, b = Inf, 
#>                 thetam1 = 0, im1 = info[k - 1], gm1 = hgm1, r = r)
#>             pik <- sum(hg$h)
#>             bdelta <- spend - pik
#>             dpikdb <- hg$h[1]/hg$w[1]
#>             if (bdelta > dpikdb) {
#>                 bdelta <- 1
#>             }
#>             else if (bdelta < -dpikdb) {
#>                 bdelta <- -1
#>             }
#>             else {
#>                 bdelta <- bdelta/dpikdb
#>             }
#>             b <- b - bdelta
#>             if (b > extreme_high) {
#>                 b <- extreme_high
#>             }
#>             else if (b < extreme_low) {
#>                 b <- extreme_low
#>             }
#>             if (abs(bdelta) < tol) {
#>                 return(b)
#>             }
#>             j <- j + 1
#>             if (j > 20) {
#>                 stop(paste("gs_spending_bound(): bound_update did not converge for lower bound calculation, analysis", 
#>                   k, " !"))
#>             }
#>         }
#>     }
#> }
#> <bytecode: 0x55ec2b3bbd08>
#> <environment: namespace:gsDesign2>
#> 
#> $input$lpar
#> $input$lpar$sf
#> function (alpha, t, param = NULL) 
#> {
#>     checkScalar(alpha, "numeric", c(0, Inf), c(FALSE, FALSE))
#>     checkVector(t, "numeric", c(0, Inf), c(TRUE, FALSE))
#>     if (is.null(param) || param < 0.005 || param > 20) 
#>         param <- 1
#>     checkScalar(param, "numeric", c(0.005, 20), c(TRUE, TRUE))
#>     t[t > 1] <- 1
#>     if (param == 1) {
#>         rho <- 1
#>         txt <- "Lan-DeMets O'Brien-Fleming approximation"
#>         parname <- "none"
#>     }
#>     else {
#>         rho <- param
#>         txt <- "Generalized Lan-DeMets O'Brien-Fleming"
#>         parname <- "rho"
#>     }
#>     z <- -qnorm(alpha/2)
#>     x <- list(name = txt, param = param, parname = parname, sf = sfLDOF, 
#>         spend = 2 * (1 - pnorm(z/t^(rho/2))), bound = NULL, prob = NULL)
#>     class(x) <- "spendfn"
#>     x
#> }
#> <bytecode: 0x55ec28bf0d80>
#> <environment: namespace:gsDesign>
#> 
#> $input$lpar$total_spend
#> [1] 0.1
#> 
#> 
#> $input$test_upper
#> [1] TRUE
#> 
#> $input$test_lower
#> [1] TRUE
#> 
#> $input$h1_spending
#> [1] TRUE
#> 
#> $input$binding
#> [1] FALSE
#> 
#> $input$info_scale
#> [1] "h0_h1_info"
#> 
#> $input$r
#> [1] 18
#> 
#> $input$tol
#> [1] 1e-06
#> 
#> 
#> $enroll_rate
#> # A tibble: 3 × 3
#>   stratum duration  rate
#>   <chr>      <dbl> <dbl>
#> 1 All            2  14.7
#> 2 All            2  29.5
#> 3 All           10  44.2
#> 
#> $fail_rate
#> # A tibble: 2 × 5
#>   stratum duration fail_rate dropout_rate    hr
#>   <chr>      <dbl>     <dbl>        <dbl> <dbl>
#> 1 All            3    0.0770        0.001   0.9
#> 2 All          100    0.0385        0.001   0.6
#> 
#> $bound
#> # A tibble: 6 × 7
#>   analysis bound probability probability0     z `~hr at bound` `nominal p`
#>      <int> <chr>       <dbl>        <dbl> <dbl>          <dbl>       <dbl>
#> 1        1 upper     0.00510     0.000104  3.71          0.490    0.000104
#> 2        1 lower     0.00459     0.0665   -1.50          1.33     0.934   
#> 3        2 upper     0.701       0.0122    2.25          0.756    0.0122  
#> 4        2 lower     0.0655      0.896     1.26          0.856    0.104   
#> 5        3 upper     0.900       0.0241    2.03          0.799    0.0214  
#> 6        3 lower     0.100       0.976     2.02          0.799    0.0216  
#> 
#> $analysis
#> # A tibble: 3 × 10
#>   analysis  time     n event   ahr theta  info info0 info_frac info_frac0
#>      <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>     <dbl>      <dbl>
#> 1        1  12.5  465.  108. 0.806 0.216  26.7  27.1     0.334      0.333
#> 2        2  26.4  530.  260. 0.706 0.348  63.7  65.1     0.797      0.800
#> 3        3  36    530.  325. 0.683 0.381  79.9  81.3     1          1    
#> 
#> attr(,"class")
#> [1] "non_binding" "ahr"         "gs_design"   "list"       
# }

# Example 6 ----
# 2-sided symmetric design with O'Brien-Fleming spending
# \donttest{
gs_design_ahr(
  analysis_time = c(12, 24, 36),
  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),
  h1_spending = FALSE
)
#> $input
#> $input$enroll_rate
#> # A tibble: 3 × 3
#>   stratum duration  rate
#>   <chr>      <dbl> <dbl>
#> 1 All            2     3
#> 2 All            2     6
#> 3 All           10     9
#> 
#> $input$fail_rate
#> # A tibble: 2 × 5
#>   stratum duration fail_rate dropout_rate    hr
#>   <chr>      <dbl>     <dbl>        <dbl> <dbl>
#> 1 All            3    0.0770        0.001   0.9
#> 2 All          100    0.0385        0.001   0.6
#> 
#> $input$alpha
#> [1] 0.025
#> 
#> $input$beta
#> [1] 0.1
#> 
#> $input$ratio
#> [1] 1
#> 
#> $input$info_frac
#> [1] 0.3080415 0.7407917 1.0000000
#> 
#> $input$analysis_time
#> [1] 12 24 36
#> 
#> $input$upper
#> function (k = 1, par = list(sf = gsDesign::sfLDOF, total_spend = 0.025, 
#>     param = NULL, timing = NULL, max_info = NULL), hgm1 = NULL, 
#>     theta = 0.1, info = 1:3, efficacy = TRUE, test_bound = TRUE, 
#>     r = 18, tol = 1e-06) 
#> {
#>     if (length(test_bound) == 1 && k > 1) {
#>         test_bound <- rep(test_bound, k)
#>     }
#>     if (!is.null(par$timing)) {
#>         timing <- par$timing
#>     }
#>     else {
#>         if (is.null(par$max_info)) {
#>             timing <- info/max(info)
#>         }
#>         else {
#>             timing <- info/par$max_info
#>         }
#>     }
#>     spend <- par$sf(alpha = par$total_spend, t = timing, param = par$param)$spend
#>     old_spend <- 0
#>     for (i in 1:k) {
#>         if (test_bound[i]) {
#>             xx <- spend[i] - old_spend
#>             old_spend <- spend[i]
#>             spend[i] <- xx
#>         }
#>         else {
#>             spend[i] <- 0
#>         }
#>     }
#>     spend <- spend[k]
#>     if (!efficacy) {
#>         if (spend <= 0) {
#>             return(-Inf)
#>         }
#>         if (length(theta) == 1) 
#>             theta <- rep(theta, length(info))
#>         a <- qnorm(spend) + sqrt(info[k]) * theta[k]
#>         if (k == 1) {
#>             return(a)
#>         }
#>         mu <- theta[k] * sqrt(info[k])
#>         extreme_low <- mu - 3 - 4 * log(r)
#>         extreme_high <- mu + 3 + 4 * log(r)
#>         adelta <- 1
#>         j <- 0
#>         while (abs(adelta) > tol) {
#>             hg <- hupdate(theta = theta[k], info = info[k], a = -Inf, 
#>                 b = a, thetam1 = theta[k - 1], im1 = info[k - 
#>                   1], gm1 = hgm1, r = r)
#>             i <- length(hg$h)
#>             pik <- sum(hg$h)
#>             adelta <- spend - pik
#>             dplo <- hg$h[i]/hg$w[i]
#>             if (adelta > dplo) {
#>                 adelta <- 1
#>             }
#>             else if (adelta < -dplo) {
#>                 adelta <- -1
#>             }
#>             else {
#>                 adelta <- adelta/dplo
#>             }
#>             a <- a + adelta
#>             if (a > extreme_high) {
#>                 a <- extreme_high
#>             }
#>             else if (a < extreme_low) {
#>                 a <- extreme_low
#>             }
#>             if (abs(adelta) < tol) {
#>                 return(a)
#>             }
#>             j <- j + 1
#>             if (j > 20) {
#>                 stop(paste("gs_spending_bound(): bound_update did not converge for lower bound calculation, analysis", 
#>                   k, " !"))
#>             }
#>         }
#>     }
#>     else {
#>         if (spend <= 0) {
#>             return(Inf)
#>         }
#>         if (length(theta) == 1) 
#>             theta <- rep(theta, length(info))
#>         b <- qnorm(spend, lower.tail = FALSE)
#>         if (k == 1) {
#>             return(b)
#>         }
#>         mu <- theta[k] * sqrt(info[k])
#>         extreme_low <- mu - 3 - 4 * log(r)
#>         extreme_high <- mu + 3 + 4 * log(r)
#>         bdelta <- 1
#>         j <- 1
#>         while (abs(bdelta) > tol) {
#>             hg <- hupdate(theta = 0, info = info[k], a = b, b = Inf, 
#>                 thetam1 = 0, im1 = info[k - 1], gm1 = hgm1, r = r)
#>             pik <- sum(hg$h)
#>             bdelta <- spend - pik
#>             dpikdb <- hg$h[1]/hg$w[1]
#>             if (bdelta > dpikdb) {
#>                 bdelta <- 1
#>             }
#>             else if (bdelta < -dpikdb) {
#>                 bdelta <- -1
#>             }
#>             else {
#>                 bdelta <- bdelta/dpikdb
#>             }
#>             b <- b - bdelta
#>             if (b > extreme_high) {
#>                 b <- extreme_high
#>             }
#>             else if (b < extreme_low) {
#>                 b <- extreme_low
#>             }
#>             if (abs(bdelta) < tol) {
#>                 return(b)
#>             }
#>             j <- j + 1
#>             if (j > 20) {
#>                 stop(paste("gs_spending_bound(): bound_update did not converge for lower bound calculation, analysis", 
#>                   k, " !"))
#>             }
#>         }
#>     }
#> }
#> <bytecode: 0x55ec2b3bbd08>
#> <environment: namespace:gsDesign2>
#> 
#> $input$upar
#> $input$upar$sf
#> function (alpha, t, param = NULL) 
#> {
#>     checkScalar(alpha, "numeric", c(0, Inf), c(FALSE, FALSE))
#>     checkVector(t, "numeric", c(0, Inf), c(TRUE, FALSE))
#>     if (is.null(param) || param < 0.005 || param > 20) 
#>         param <- 1
#>     checkScalar(param, "numeric", c(0.005, 20), c(TRUE, TRUE))
#>     t[t > 1] <- 1
#>     if (param == 1) {
#>         rho <- 1
#>         txt <- "Lan-DeMets O'Brien-Fleming approximation"
#>         parname <- "none"
#>     }
#>     else {
#>         rho <- param
#>         txt <- "Generalized Lan-DeMets O'Brien-Fleming"
#>         parname <- "rho"
#>     }
#>     z <- -qnorm(alpha/2)
#>     x <- list(name = txt, param = param, parname = parname, sf = sfLDOF, 
#>         spend = 2 * (1 - pnorm(z/t^(rho/2))), bound = NULL, prob = NULL)
#>     class(x) <- "spendfn"
#>     x
#> }
#> <bytecode: 0x55ec28bf0d80>
#> <environment: namespace:gsDesign>
#> 
#> $input$upar$total_spend
#> [1] 0.025
#> 
#> $input$upar$param
#> NULL
#> 
#> $input$upar$timing
#> NULL
#> 
#> 
#> $input$lower
#> function (k = 1, par = list(sf = gsDesign::sfLDOF, total_spend = 0.025, 
#>     param = NULL, timing = NULL, max_info = NULL), hgm1 = NULL, 
#>     theta = 0.1, info = 1:3, efficacy = TRUE, test_bound = TRUE, 
#>     r = 18, tol = 1e-06) 
#> {
#>     if (length(test_bound) == 1 && k > 1) {
#>         test_bound <- rep(test_bound, k)
#>     }
#>     if (!is.null(par$timing)) {
#>         timing <- par$timing
#>     }
#>     else {
#>         if (is.null(par$max_info)) {
#>             timing <- info/max(info)
#>         }
#>         else {
#>             timing <- info/par$max_info
#>         }
#>     }
#>     spend <- par$sf(alpha = par$total_spend, t = timing, param = par$param)$spend
#>     old_spend <- 0
#>     for (i in 1:k) {
#>         if (test_bound[i]) {
#>             xx <- spend[i] - old_spend
#>             old_spend <- spend[i]
#>             spend[i] <- xx
#>         }
#>         else {
#>             spend[i] <- 0
#>         }
#>     }
#>     spend <- spend[k]
#>     if (!efficacy) {
#>         if (spend <= 0) {
#>             return(-Inf)
#>         }
#>         if (length(theta) == 1) 
#>             theta <- rep(theta, length(info))
#>         a <- qnorm(spend) + sqrt(info[k]) * theta[k]
#>         if (k == 1) {
#>             return(a)
#>         }
#>         mu <- theta[k] * sqrt(info[k])
#>         extreme_low <- mu - 3 - 4 * log(r)
#>         extreme_high <- mu + 3 + 4 * log(r)
#>         adelta <- 1
#>         j <- 0
#>         while (abs(adelta) > tol) {
#>             hg <- hupdate(theta = theta[k], info = info[k], a = -Inf, 
#>                 b = a, thetam1 = theta[k - 1], im1 = info[k - 
#>                   1], gm1 = hgm1, r = r)
#>             i <- length(hg$h)
#>             pik <- sum(hg$h)
#>             adelta <- spend - pik
#>             dplo <- hg$h[i]/hg$w[i]
#>             if (adelta > dplo) {
#>                 adelta <- 1
#>             }
#>             else if (adelta < -dplo) {
#>                 adelta <- -1
#>             }
#>             else {
#>                 adelta <- adelta/dplo
#>             }
#>             a <- a + adelta
#>             if (a > extreme_high) {
#>                 a <- extreme_high
#>             }
#>             else if (a < extreme_low) {
#>                 a <- extreme_low
#>             }
#>             if (abs(adelta) < tol) {
#>                 return(a)
#>             }
#>             j <- j + 1
#>             if (j > 20) {
#>                 stop(paste("gs_spending_bound(): bound_update did not converge for lower bound calculation, analysis", 
#>                   k, " !"))
#>             }
#>         }
#>     }
#>     else {
#>         if (spend <= 0) {
#>             return(Inf)
#>         }
#>         if (length(theta) == 1) 
#>             theta <- rep(theta, length(info))
#>         b <- qnorm(spend, lower.tail = FALSE)
#>         if (k == 1) {
#>             return(b)
#>         }
#>         mu <- theta[k] * sqrt(info[k])
#>         extreme_low <- mu - 3 - 4 * log(r)
#>         extreme_high <- mu + 3 + 4 * log(r)
#>         bdelta <- 1
#>         j <- 1
#>         while (abs(bdelta) > tol) {
#>             hg <- hupdate(theta = 0, info = info[k], a = b, b = Inf, 
#>                 thetam1 = 0, im1 = info[k - 1], gm1 = hgm1, r = r)
#>             pik <- sum(hg$h)
#>             bdelta <- spend - pik
#>             dpikdb <- hg$h[1]/hg$w[1]
#>             if (bdelta > dpikdb) {
#>                 bdelta <- 1
#>             }
#>             else if (bdelta < -dpikdb) {
#>                 bdelta <- -1
#>             }
#>             else {
#>                 bdelta <- bdelta/dpikdb
#>             }
#>             b <- b - bdelta
#>             if (b > extreme_high) {
#>                 b <- extreme_high
#>             }
#>             else if (b < extreme_low) {
#>                 b <- extreme_low
#>             }
#>             if (abs(bdelta) < tol) {
#>                 return(b)
#>             }
#>             j <- j + 1
#>             if (j > 20) {
#>                 stop(paste("gs_spending_bound(): bound_update did not converge for lower bound calculation, analysis", 
#>                   k, " !"))
#>             }
#>         }
#>     }
#> }
#> <bytecode: 0x55ec2b3bbd08>
#> <environment: namespace:gsDesign2>
#> 
#> $input$lpar
#> $input$lpar$sf
#> function (alpha, t, param = NULL) 
#> {
#>     checkScalar(alpha, "numeric", c(0, Inf), c(FALSE, FALSE))
#>     checkVector(t, "numeric", c(0, Inf), c(TRUE, FALSE))
#>     if (is.null(param) || param < 0.005 || param > 20) 
#>         param <- 1
#>     checkScalar(param, "numeric", c(0.005, 20), c(TRUE, TRUE))
#>     t[t > 1] <- 1
#>     if (param == 1) {
#>         rho <- 1
#>         txt <- "Lan-DeMets O'Brien-Fleming approximation"
#>         parname <- "none"
#>     }
#>     else {
#>         rho <- param
#>         txt <- "Generalized Lan-DeMets O'Brien-Fleming"
#>         parname <- "rho"
#>     }
#>     z <- -qnorm(alpha/2)
#>     x <- list(name = txt, param = param, parname = parname, sf = sfLDOF, 
#>         spend = 2 * (1 - pnorm(z/t^(rho/2))), bound = NULL, prob = NULL)
#>     class(x) <- "spendfn"
#>     x
#> }
#> <bytecode: 0x55ec28bf0d80>
#> <environment: namespace:gsDesign>
#> 
#> $input$lpar$total_spend
#> [1] 0.025
#> 
#> $input$lpar$param
#> NULL
#> 
#> $input$lpar$timing
#> NULL
#> 
#> 
#> $input$test_upper
#> [1] TRUE
#> 
#> $input$test_lower
#> [1] TRUE
#> 
#> $input$h1_spending
#> [1] FALSE
#> 
#> $input$binding
#> [1] TRUE
#> 
#> $input$info_scale
#> [1] "h0_h1_info"
#> 
#> $input$r
#> [1] 18
#> 
#> $input$tol
#> [1] 1e-06
#> 
#> 
#> $enroll_rate
#> # A tibble: 3 × 3
#>   stratum duration  rate
#>   <chr>      <dbl> <dbl>
#> 1 All            2  13.7
#> 2 All            2  27.5
#> 3 All           10  41.2
#> 
#> $fail_rate
#> # A tibble: 2 × 5
#>   stratum duration fail_rate dropout_rate    hr
#>   <chr>      <dbl>     <dbl>        <dbl> <dbl>
#> 1 All            3    0.0770        0.001   0.9
#> 2 All          100    0.0385        0.001   0.6
#> 
#> $bound
#> # A tibble: 6 × 7
#>   analysis bound probability probability0     z `~hr at bound` `nominal p`
#>      <int> <chr>       <dbl>        <dbl> <dbl>          <dbl>       <dbl>
#> 1        1 upper 0.00226        0.0000538  3.87          0.449   0.0000538
#> 2        1 lower 0.000000613    0.0000538 -3.87          2.23    1.00     
#> 3        2 upper 0.550          0.00921    2.36          0.730   0.00919  
#> 4        2 lower 0.00000125     0.00921   -2.36          1.37    0.991    
#> 5        3 upper 0.900          0.0250     2.01          0.794   0.0222   
#> 6        3 lower 0.00000128     0.0250    -2.01          1.26    0.978    
#> 
#> $analysis
#> # A tibble: 3 × 10
#>   analysis  time     n event   ahr theta  info info0 info_frac info_frac0
#>      <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>     <dbl>      <dbl>
#> 1        1    12  412.  93.4 0.811 0.210  23.0  23.3     0.309      0.308
#> 2        2    24  494. 224.  0.715 0.335  54.9  56.1     0.738      0.741
#> 3        3    36  494. 303.  0.683 0.381  74.4  75.8     1          1    
#> 
#> attr(,"class")
#> [1] "ahr"       "gs_design" "list"     
# }
# 2-sided asymmetric design with O'Brien-Fleming upper spending
# Pocock lower spending under H1 (NPH)
# \donttest{
gs_design_ahr(
  analysis_time = c(12, 24, 36),
  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::sfLDPocock, total_spend = 0.1, param = NULL, timing = NULL),
  h1_spending = TRUE
)
#> $input
#> $input$enroll_rate
#> # A tibble: 3 × 3
#>   stratum duration  rate
#>   <chr>      <dbl> <dbl>
#> 1 All            2     3
#> 2 All            2     6
#> 3 All           10     9
#> 
#> $input$fail_rate
#> # A tibble: 2 × 5
#>   stratum duration fail_rate dropout_rate    hr
#>   <chr>      <dbl>     <dbl>        <dbl> <dbl>
#> 1 All            3    0.0770        0.001   0.9
#> 2 All          100    0.0385        0.001   0.6
#> 
#> $input$alpha
#> [1] 0.025
#> 
#> $input$beta
#> [1] 0.1
#> 
#> $input$ratio
#> [1] 1
#> 
#> $input$info_frac
#> [1] 0.3080415 0.7407917 1.0000000
#> 
#> $input$analysis_time
#> [1] 12 24 36
#> 
#> $input$upper
#> function (k = 1, par = list(sf = gsDesign::sfLDOF, total_spend = 0.025, 
#>     param = NULL, timing = NULL, max_info = NULL), hgm1 = NULL, 
#>     theta = 0.1, info = 1:3, efficacy = TRUE, test_bound = TRUE, 
#>     r = 18, tol = 1e-06) 
#> {
#>     if (length(test_bound) == 1 && k > 1) {
#>         test_bound <- rep(test_bound, k)
#>     }
#>     if (!is.null(par$timing)) {
#>         timing <- par$timing
#>     }
#>     else {
#>         if (is.null(par$max_info)) {
#>             timing <- info/max(info)
#>         }
#>         else {
#>             timing <- info/par$max_info
#>         }
#>     }
#>     spend <- par$sf(alpha = par$total_spend, t = timing, param = par$param)$spend
#>     old_spend <- 0
#>     for (i in 1:k) {
#>         if (test_bound[i]) {
#>             xx <- spend[i] - old_spend
#>             old_spend <- spend[i]
#>             spend[i] <- xx
#>         }
#>         else {
#>             spend[i] <- 0
#>         }
#>     }
#>     spend <- spend[k]
#>     if (!efficacy) {
#>         if (spend <= 0) {
#>             return(-Inf)
#>         }
#>         if (length(theta) == 1) 
#>             theta <- rep(theta, length(info))
#>         a <- qnorm(spend) + sqrt(info[k]) * theta[k]
#>         if (k == 1) {
#>             return(a)
#>         }
#>         mu <- theta[k] * sqrt(info[k])
#>         extreme_low <- mu - 3 - 4 * log(r)
#>         extreme_high <- mu + 3 + 4 * log(r)
#>         adelta <- 1
#>         j <- 0
#>         while (abs(adelta) > tol) {
#>             hg <- hupdate(theta = theta[k], info = info[k], a = -Inf, 
#>                 b = a, thetam1 = theta[k - 1], im1 = info[k - 
#>                   1], gm1 = hgm1, r = r)
#>             i <- length(hg$h)
#>             pik <- sum(hg$h)
#>             adelta <- spend - pik
#>             dplo <- hg$h[i]/hg$w[i]
#>             if (adelta > dplo) {
#>                 adelta <- 1
#>             }
#>             else if (adelta < -dplo) {
#>                 adelta <- -1
#>             }
#>             else {
#>                 adelta <- adelta/dplo
#>             }
#>             a <- a + adelta
#>             if (a > extreme_high) {
#>                 a <- extreme_high
#>             }
#>             else if (a < extreme_low) {
#>                 a <- extreme_low
#>             }
#>             if (abs(adelta) < tol) {
#>                 return(a)
#>             }
#>             j <- j + 1
#>             if (j > 20) {
#>                 stop(paste("gs_spending_bound(): bound_update did not converge for lower bound calculation, analysis", 
#>                   k, " !"))
#>             }
#>         }
#>     }
#>     else {
#>         if (spend <= 0) {
#>             return(Inf)
#>         }
#>         if (length(theta) == 1) 
#>             theta <- rep(theta, length(info))
#>         b <- qnorm(spend, lower.tail = FALSE)
#>         if (k == 1) {
#>             return(b)
#>         }
#>         mu <- theta[k] * sqrt(info[k])
#>         extreme_low <- mu - 3 - 4 * log(r)
#>         extreme_high <- mu + 3 + 4 * log(r)
#>         bdelta <- 1
#>         j <- 1
#>         while (abs(bdelta) > tol) {
#>             hg <- hupdate(theta = 0, info = info[k], a = b, b = Inf, 
#>                 thetam1 = 0, im1 = info[k - 1], gm1 = hgm1, r = r)
#>             pik <- sum(hg$h)
#>             bdelta <- spend - pik
#>             dpikdb <- hg$h[1]/hg$w[1]
#>             if (bdelta > dpikdb) {
#>                 bdelta <- 1
#>             }
#>             else if (bdelta < -dpikdb) {
#>                 bdelta <- -1
#>             }
#>             else {
#>                 bdelta <- bdelta/dpikdb
#>             }
#>             b <- b - bdelta
#>             if (b > extreme_high) {
#>                 b <- extreme_high
#>             }
#>             else if (b < extreme_low) {
#>                 b <- extreme_low
#>             }
#>             if (abs(bdelta) < tol) {
#>                 return(b)
#>             }
#>             j <- j + 1
#>             if (j > 20) {
#>                 stop(paste("gs_spending_bound(): bound_update did not converge for lower bound calculation, analysis", 
#>                   k, " !"))
#>             }
#>         }
#>     }
#> }
#> <bytecode: 0x55ec2b3bbd08>
#> <environment: namespace:gsDesign2>
#> 
#> $input$upar
#> $input$upar$sf
#> function (alpha, t, param = NULL) 
#> {
#>     checkScalar(alpha, "numeric", c(0, Inf), c(FALSE, FALSE))
#>     checkVector(t, "numeric", c(0, Inf), c(TRUE, FALSE))
#>     if (is.null(param) || param < 0.005 || param > 20) 
#>         param <- 1
#>     checkScalar(param, "numeric", c(0.005, 20), c(TRUE, TRUE))
#>     t[t > 1] <- 1
#>     if (param == 1) {
#>         rho <- 1
#>         txt <- "Lan-DeMets O'Brien-Fleming approximation"
#>         parname <- "none"
#>     }
#>     else {
#>         rho <- param
#>         txt <- "Generalized Lan-DeMets O'Brien-Fleming"
#>         parname <- "rho"
#>     }
#>     z <- -qnorm(alpha/2)
#>     x <- list(name = txt, param = param, parname = parname, sf = sfLDOF, 
#>         spend = 2 * (1 - pnorm(z/t^(rho/2))), bound = NULL, prob = NULL)
#>     class(x) <- "spendfn"
#>     x
#> }
#> <bytecode: 0x55ec28bf0d80>
#> <environment: namespace:gsDesign>
#> 
#> $input$upar$total_spend
#> [1] 0.025
#> 
#> $input$upar$param
#> NULL
#> 
#> $input$upar$timing
#> NULL
#> 
#> 
#> $input$lower
#> function (k = 1, par = list(sf = gsDesign::sfLDOF, total_spend = 0.025, 
#>     param = NULL, timing = NULL, max_info = NULL), hgm1 = NULL, 
#>     theta = 0.1, info = 1:3, efficacy = TRUE, test_bound = TRUE, 
#>     r = 18, tol = 1e-06) 
#> {
#>     if (length(test_bound) == 1 && k > 1) {
#>         test_bound <- rep(test_bound, k)
#>     }
#>     if (!is.null(par$timing)) {
#>         timing <- par$timing
#>     }
#>     else {
#>         if (is.null(par$max_info)) {
#>             timing <- info/max(info)
#>         }
#>         else {
#>             timing <- info/par$max_info
#>         }
#>     }
#>     spend <- par$sf(alpha = par$total_spend, t = timing, param = par$param)$spend
#>     old_spend <- 0
#>     for (i in 1:k) {
#>         if (test_bound[i]) {
#>             xx <- spend[i] - old_spend
#>             old_spend <- spend[i]
#>             spend[i] <- xx
#>         }
#>         else {
#>             spend[i] <- 0
#>         }
#>     }
#>     spend <- spend[k]
#>     if (!efficacy) {
#>         if (spend <= 0) {
#>             return(-Inf)
#>         }
#>         if (length(theta) == 1) 
#>             theta <- rep(theta, length(info))
#>         a <- qnorm(spend) + sqrt(info[k]) * theta[k]
#>         if (k == 1) {
#>             return(a)
#>         }
#>         mu <- theta[k] * sqrt(info[k])
#>         extreme_low <- mu - 3 - 4 * log(r)
#>         extreme_high <- mu + 3 + 4 * log(r)
#>         adelta <- 1
#>         j <- 0
#>         while (abs(adelta) > tol) {
#>             hg <- hupdate(theta = theta[k], info = info[k], a = -Inf, 
#>                 b = a, thetam1 = theta[k - 1], im1 = info[k - 
#>                   1], gm1 = hgm1, r = r)
#>             i <- length(hg$h)
#>             pik <- sum(hg$h)
#>             adelta <- spend - pik
#>             dplo <- hg$h[i]/hg$w[i]
#>             if (adelta > dplo) {
#>                 adelta <- 1
#>             }
#>             else if (adelta < -dplo) {
#>                 adelta <- -1
#>             }
#>             else {
#>                 adelta <- adelta/dplo
#>             }
#>             a <- a + adelta
#>             if (a > extreme_high) {
#>                 a <- extreme_high
#>             }
#>             else if (a < extreme_low) {
#>                 a <- extreme_low
#>             }
#>             if (abs(adelta) < tol) {
#>                 return(a)
#>             }
#>             j <- j + 1
#>             if (j > 20) {
#>                 stop(paste("gs_spending_bound(): bound_update did not converge for lower bound calculation, analysis", 
#>                   k, " !"))
#>             }
#>         }
#>     }
#>     else {
#>         if (spend <= 0) {
#>             return(Inf)
#>         }
#>         if (length(theta) == 1) 
#>             theta <- rep(theta, length(info))
#>         b <- qnorm(spend, lower.tail = FALSE)
#>         if (k == 1) {
#>             return(b)
#>         }
#>         mu <- theta[k] * sqrt(info[k])
#>         extreme_low <- mu - 3 - 4 * log(r)
#>         extreme_high <- mu + 3 + 4 * log(r)
#>         bdelta <- 1
#>         j <- 1
#>         while (abs(bdelta) > tol) {
#>             hg <- hupdate(theta = 0, info = info[k], a = b, b = Inf, 
#>                 thetam1 = 0, im1 = info[k - 1], gm1 = hgm1, r = r)
#>             pik <- sum(hg$h)
#>             bdelta <- spend - pik
#>             dpikdb <- hg$h[1]/hg$w[1]
#>             if (bdelta > dpikdb) {
#>                 bdelta <- 1
#>             }
#>             else if (bdelta < -dpikdb) {
#>                 bdelta <- -1
#>             }
#>             else {
#>                 bdelta <- bdelta/dpikdb
#>             }
#>             b <- b - bdelta
#>             if (b > extreme_high) {
#>                 b <- extreme_high
#>             }
#>             else if (b < extreme_low) {
#>                 b <- extreme_low
#>             }
#>             if (abs(bdelta) < tol) {
#>                 return(b)
#>             }
#>             j <- j + 1
#>             if (j > 20) {
#>                 stop(paste("gs_spending_bound(): bound_update did not converge for lower bound calculation, analysis", 
#>                   k, " !"))
#>             }
#>         }
#>     }
#> }
#> <bytecode: 0x55ec2b3bbd08>
#> <environment: namespace:gsDesign2>
#> 
#> $input$lpar
#> $input$lpar$sf
#> function (alpha, t, param) 
#> {
#>     checkScalar(alpha, "numeric", c(0, Inf), c(FALSE, FALSE))
#>     checkVector(t, "numeric", c(0, Inf), c(TRUE, FALSE))
#>     t[t > 1] <- 1
#>     x <- list(name = "Lan-DeMets Pocock approximation", param = NULL, 
#>         parname = "none", sf = sfLDPocock, spend = alpha * log(1 + 
#>             (exp(1) - 1) * t), bound = NULL, prob = NULL)
#>     class(x) <- "spendfn"
#>     x
#> }
#> <bytecode: 0x55ec28de2b18>
#> <environment: namespace:gsDesign>
#> 
#> $input$lpar$total_spend
#> [1] 0.1
#> 
#> $input$lpar$param
#> NULL
#> 
#> $input$lpar$timing
#> NULL
#> 
#> 
#> $input$test_upper
#> [1] TRUE
#> 
#> $input$test_lower
#> [1] TRUE
#> 
#> $input$h1_spending
#> [1] TRUE
#> 
#> $input$binding
#> [1] TRUE
#> 
#> $input$info_scale
#> [1] "h0_h1_info"
#> 
#> $input$r
#> [1] 18
#> 
#> $input$tol
#> [1] 1e-06
#> 
#> 
#> $enroll_rate
#> # A tibble: 3 × 3
#>   stratum duration  rate
#>   <chr>      <dbl> <dbl>
#> 1 All            2  16.5
#> 2 All            2  32.9
#> 3 All           10  49.4
#> 
#> $fail_rate
#> # A tibble: 2 × 5
#>   stratum duration fail_rate dropout_rate    hr
#>   <chr>      <dbl>     <dbl>        <dbl> <dbl>
#> 1 All            3    0.0770        0.001   0.9
#> 2 All          100    0.0385        0.001   0.6
#> 
#> $bound
#> # A tibble: 6 × 7
#>   analysis bound probability probability0      z `~hr at bound` `nominal p`
#>      <int> <chr>       <dbl>        <dbl>  <dbl>          <dbl>       <dbl>
#> 1        1 upper     0.00305    0.0000538  3.87           0.481   0.0000538
#> 2        1 lower     0.0430     0.268     -0.619          1.12    0.732    
#> 3        2 upper     0.638      0.00921    2.36           0.750   0.00920  
#> 4        2 lower     0.0823     0.874      1.13           0.871   0.129    
#> 5        3 upper     0.900      0.0250     1.98           0.813   0.0240   
#> 6        3 lower     0.100      0.975      1.97           0.813   0.0243   
#> 
#> $analysis
#> # A tibble: 3 × 10
#>   analysis  time     n event   ahr theta  info info0 info_frac info_frac0
#>      <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>     <dbl>      <dbl>
#> 1        1    12  494.  112. 0.811 0.210  27.6  28.0     0.309      0.308
#> 2        2    24  593.  269. 0.715 0.335  65.9  67.3     0.738      0.741
#> 3        3    36  593.  364. 0.683 0.381  89.3  90.9     1          1    
#> 
#> attr(,"class")
#> [1] "ahr"       "gs_design" "list"     
# }

# Example 7 ----
# \donttest{
gs_design_ahr(
  alpha = 0.0125,
  analysis_time = c(12, 24, 36),
  upper = gs_spending_bound,
  upar = list(sf = gsDesign::sfLDOF, total_spend = 0.0125, param = NULL, timing = NULL),
  lower = gs_b,
  lpar = rep(-Inf, 3)
)
#> $input
#> $input$enroll_rate
#> # A tibble: 3 × 3
#>   stratum duration  rate
#>   <chr>      <dbl> <dbl>
#> 1 All            2     3
#> 2 All            2     6
#> 3 All           10     9
#> 
#> $input$fail_rate
#> # A tibble: 2 × 5
#>   stratum duration fail_rate dropout_rate    hr
#>   <chr>      <dbl>     <dbl>        <dbl> <dbl>
#> 1 All            3    0.0770        0.001   0.9
#> 2 All          100    0.0385        0.001   0.6
#> 
#> $input$alpha
#> [1] 0.0125
#> 
#> $input$beta
#> [1] 0.1
#> 
#> $input$ratio
#> [1] 1
#> 
#> $input$info_frac
#> [1] 0.3080415 0.7407917 1.0000000
#> 
#> $input$analysis_time
#> [1] 12 24 36
#> 
#> $input$upper
#> function (k = 1, par = list(sf = gsDesign::sfLDOF, total_spend = 0.025, 
#>     param = NULL, timing = NULL, max_info = NULL), hgm1 = NULL, 
#>     theta = 0.1, info = 1:3, efficacy = TRUE, test_bound = TRUE, 
#>     r = 18, tol = 1e-06) 
#> {
#>     if (length(test_bound) == 1 && k > 1) {
#>         test_bound <- rep(test_bound, k)
#>     }
#>     if (!is.null(par$timing)) {
#>         timing <- par$timing
#>     }
#>     else {
#>         if (is.null(par$max_info)) {
#>             timing <- info/max(info)
#>         }
#>         else {
#>             timing <- info/par$max_info
#>         }
#>     }
#>     spend <- par$sf(alpha = par$total_spend, t = timing, param = par$param)$spend
#>     old_spend <- 0
#>     for (i in 1:k) {
#>         if (test_bound[i]) {
#>             xx <- spend[i] - old_spend
#>             old_spend <- spend[i]
#>             spend[i] <- xx
#>         }
#>         else {
#>             spend[i] <- 0
#>         }
#>     }
#>     spend <- spend[k]
#>     if (!efficacy) {
#>         if (spend <= 0) {
#>             return(-Inf)
#>         }
#>         if (length(theta) == 1) 
#>             theta <- rep(theta, length(info))
#>         a <- qnorm(spend) + sqrt(info[k]) * theta[k]
#>         if (k == 1) {
#>             return(a)
#>         }
#>         mu <- theta[k] * sqrt(info[k])
#>         extreme_low <- mu - 3 - 4 * log(r)
#>         extreme_high <- mu + 3 + 4 * log(r)
#>         adelta <- 1
#>         j <- 0
#>         while (abs(adelta) > tol) {
#>             hg <- hupdate(theta = theta[k], info = info[k], a = -Inf, 
#>                 b = a, thetam1 = theta[k - 1], im1 = info[k - 
#>                   1], gm1 = hgm1, r = r)
#>             i <- length(hg$h)
#>             pik <- sum(hg$h)
#>             adelta <- spend - pik
#>             dplo <- hg$h[i]/hg$w[i]
#>             if (adelta > dplo) {
#>                 adelta <- 1
#>             }
#>             else if (adelta < -dplo) {
#>                 adelta <- -1
#>             }
#>             else {
#>                 adelta <- adelta/dplo
#>             }
#>             a <- a + adelta
#>             if (a > extreme_high) {
#>                 a <- extreme_high
#>             }
#>             else if (a < extreme_low) {
#>                 a <- extreme_low
#>             }
#>             if (abs(adelta) < tol) {
#>                 return(a)
#>             }
#>             j <- j + 1
#>             if (j > 20) {
#>                 stop(paste("gs_spending_bound(): bound_update did not converge for lower bound calculation, analysis", 
#>                   k, " !"))
#>             }
#>         }
#>     }
#>     else {
#>         if (spend <= 0) {
#>             return(Inf)
#>         }
#>         if (length(theta) == 1) 
#>             theta <- rep(theta, length(info))
#>         b <- qnorm(spend, lower.tail = FALSE)
#>         if (k == 1) {
#>             return(b)
#>         }
#>         mu <- theta[k] * sqrt(info[k])
#>         extreme_low <- mu - 3 - 4 * log(r)
#>         extreme_high <- mu + 3 + 4 * log(r)
#>         bdelta <- 1
#>         j <- 1
#>         while (abs(bdelta) > tol) {
#>             hg <- hupdate(theta = 0, info = info[k], a = b, b = Inf, 
#>                 thetam1 = 0, im1 = info[k - 1], gm1 = hgm1, r = r)
#>             pik <- sum(hg$h)
#>             bdelta <- spend - pik
#>             dpikdb <- hg$h[1]/hg$w[1]
#>             if (bdelta > dpikdb) {
#>                 bdelta <- 1
#>             }
#>             else if (bdelta < -dpikdb) {
#>                 bdelta <- -1
#>             }
#>             else {
#>                 bdelta <- bdelta/dpikdb
#>             }
#>             b <- b - bdelta
#>             if (b > extreme_high) {
#>                 b <- extreme_high
#>             }
#>             else if (b < extreme_low) {
#>                 b <- extreme_low
#>             }
#>             if (abs(bdelta) < tol) {
#>                 return(b)
#>             }
#>             j <- j + 1
#>             if (j > 20) {
#>                 stop(paste("gs_spending_bound(): bound_update did not converge for lower bound calculation, analysis", 
#>                   k, " !"))
#>             }
#>         }
#>     }
#> }
#> <bytecode: 0x55ec2b3bbd08>
#> <environment: namespace:gsDesign2>
#> 
#> $input$upar
#> $input$upar$sf
#> function (alpha, t, param = NULL) 
#> {
#>     checkScalar(alpha, "numeric", c(0, Inf), c(FALSE, FALSE))
#>     checkVector(t, "numeric", c(0, Inf), c(TRUE, FALSE))
#>     if (is.null(param) || param < 0.005 || param > 20) 
#>         param <- 1
#>     checkScalar(param, "numeric", c(0.005, 20), c(TRUE, TRUE))
#>     t[t > 1] <- 1
#>     if (param == 1) {
#>         rho <- 1
#>         txt <- "Lan-DeMets O'Brien-Fleming approximation"
#>         parname <- "none"
#>     }
#>     else {
#>         rho <- param
#>         txt <- "Generalized Lan-DeMets O'Brien-Fleming"
#>         parname <- "rho"
#>     }
#>     z <- -qnorm(alpha/2)
#>     x <- list(name = txt, param = param, parname = parname, sf = sfLDOF, 
#>         spend = 2 * (1 - pnorm(z/t^(rho/2))), bound = NULL, prob = NULL)
#>     class(x) <- "spendfn"
#>     x
#> }
#> <bytecode: 0x55ec28bf0d80>
#> <environment: namespace:gsDesign>
#> 
#> $input$upar$total_spend
#> [1] 0.0125
#> 
#> $input$upar$param
#> NULL
#> 
#> $input$upar$timing
#> NULL
#> 
#> 
#> $input$lower
#> function (par = NULL, k = NULL, ...) 
#> {
#>     if (is.null(k)) {
#>         return(par)
#>     }
#>     else {
#>         return(par[k])
#>     }
#> }
#> <bytecode: 0x55ec2b3b8db8>
#> <environment: namespace:gsDesign2>
#> 
#> $input$lpar
#> [1] -Inf -Inf -Inf
#> 
#> $input$test_upper
#> [1] TRUE
#> 
#> $input$test_lower
#> [1] TRUE
#> 
#> $input$h1_spending
#> [1] TRUE
#> 
#> $input$binding
#> [1] FALSE
#> 
#> $input$info_scale
#> [1] "h0_h1_info"
#> 
#> $input$r
#> [1] 18
#> 
#> $input$tol
#> [1] 1e-06
#> 
#> 
#> $enroll_rate
#> # A tibble: 3 × 3
#>   stratum duration  rate
#>   <chr>      <dbl> <dbl>
#> 1 All            2  16.1
#> 2 All            2  32.2
#> 3 All           10  48.3
#> 
#> $fail_rate
#> # A tibble: 2 × 5
#>   stratum duration fail_rate dropout_rate    hr
#>   <chr>      <dbl>     <dbl>        <dbl> <dbl>
#> 1 All            3    0.0770        0.001   0.9
#> 2 All          100    0.0385        0.001   0.6
#> 
#> $bound
#> # A tibble: 3 × 7
#>   analysis bound probability probability0     z `~hr at bound` `nominal p`
#>      <int> <chr>       <dbl>        <dbl> <dbl>          <dbl>       <dbl>
#> 1        1 upper    0.000619   0.00000679  4.35          0.435  0.00000679
#> 2        2 upper    0.505      0.00371     2.68          0.719  0.00371   
#> 3        3 upper    0.900      0.0125      2.28          0.785  0.0114    
#> 
#> $analysis
#> # A tibble: 3 × 10
#>   analysis  time     n event   ahr theta  info info0 info_frac info_frac0
#>      <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>     <dbl>      <dbl>
#> 1        1    12  483.  109. 0.811 0.210  27.0  27.4     0.309      0.308
#> 2        2    24  579.  263. 0.715 0.335  64.3  65.8     0.738      0.741
#> 3        3    36  579.  355. 0.683 0.381  87.2  88.8     1          1    
#> 
#> attr(,"class")
#> [1] "non_binding" "ahr"         "gs_design"   "list"       

gs_design_ahr(
  alpha = 0.0125,
  analysis_time = c(12, 24, 36),
  upper = gs_b,
  upar = gsDesign::gsDesign(
    k = 3, test.type = 1, n.I = c(.25, .75, 1),
    sfu = sfLDOF, sfupar = NULL, alpha = 0.0125
  )$upper$bound,
  lower = gs_b,
  lpar = rep(-Inf, 3)
)
#> $input
#> $input$enroll_rate
#> # A tibble: 3 × 3
#>   stratum duration  rate
#>   <chr>      <dbl> <dbl>
#> 1 All            2     3
#> 2 All            2     6
#> 3 All           10     9
#> 
#> $input$fail_rate
#> # A tibble: 2 × 5
#>   stratum duration fail_rate dropout_rate    hr
#>   <chr>      <dbl>     <dbl>        <dbl> <dbl>
#> 1 All            3    0.0770        0.001   0.9
#> 2 All          100    0.0385        0.001   0.6
#> 
#> $input$alpha
#> [1] 0.0125
#> 
#> $input$beta
#> [1] 0.1
#> 
#> $input$ratio
#> [1] 1
#> 
#> $input$info_frac
#> [1] 0.3080415 0.7407917 1.0000000
#> 
#> $input$analysis_time
#> [1] 12 24 36
#> 
#> $input$upper
#> function (par = NULL, k = NULL, ...) 
#> {
#>     if (is.null(k)) {
#>         return(par)
#>     }
#>     else {
#>         return(par[k])
#>     }
#> }
#> <bytecode: 0x55ec2b3b8db8>
#> <environment: namespace:gsDesign2>
#> 
#> $input$upar
#> [1] 4.859940 2.658446 2.280095
#> 
#> $input$lower
#> function (par = NULL, k = NULL, ...) 
#> {
#>     if (is.null(k)) {
#>         return(par)
#>     }
#>     else {
#>         return(par[k])
#>     }
#> }
#> <bytecode: 0x55ec2b3b8db8>
#> <environment: namespace:gsDesign2>
#> 
#> $input$lpar
#> [1] -Inf -Inf -Inf
#> 
#> $input$test_upper
#> [1] TRUE
#> 
#> $input$test_lower
#> [1] TRUE
#> 
#> $input$h1_spending
#> [1] TRUE
#> 
#> $input$binding
#> [1] FALSE
#> 
#> $input$info_scale
#> [1] "h0_h1_info"
#> 
#> $input$r
#> [1] 18
#> 
#> $input$tol
#> [1] 1e-06
#> 
#> 
#> $enroll_rate
#> # A tibble: 3 × 3
#>   stratum duration  rate
#>   <chr>      <dbl> <dbl>
#> 1 All            2  16.1
#> 2 All            2  32.2
#> 3 All           10  48.3
#> 
#> $fail_rate
#> # A tibble: 2 × 5
#>   stratum duration fail_rate dropout_rate    hr
#>   <chr>      <dbl>     <dbl>        <dbl> <dbl>
#> 1 All            3    0.0770        0.001   0.9
#> 2 All          100    0.0385        0.001   0.6
#> 
#> $bound
#> # A tibble: 3 × 7
#>   analysis bound probability probability0     z `~hr at bound` `nominal p`
#>      <int> <chr>       <dbl>        <dbl> <dbl>          <dbl>       <dbl>
#> 1        1 upper   0.0000938  0.000000587  4.86          0.395 0.000000587
#> 2        2 upper   0.513      0.00393      2.66          0.721 0.00393    
#> 3        3 upper   0.900      0.0125       2.28          0.785 0.0113     
#> 
#> $analysis
#> # A tibble: 3 × 10
#>   analysis  time     n event   ahr theta  info info0 info_frac info_frac0
#>      <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>     <dbl>      <dbl>
#> 1        1    12  483.  110. 0.811 0.210  27.0  27.4     0.309      0.308
#> 2        2    24  580.  263. 0.715 0.335  64.4  65.9     0.738      0.741
#> 3        3    36  580.  356. 0.683 0.381  87.3  88.9     1          1    
#> 
#> attr(,"class")
#> [1] "non_binding" "ahr"         "gs_design"   "list"       
# }