library(tibble)
library(dplyr)
library(testthat)
devtools::load_all()
setwd('./..')
getwd()
## [1] "/home/zhayuji4/Rtemp/test_temp/gsDesign2-merck/inst"
my_path <- "./old_function/"              
source_files <- list.files(my_path, "*.R$") 
source_files
## [1] "AHR_.R"                    "eEvents_.R"               
## [3] "eEvents_df_.R"             "gridpts_h1_hupdate_oldR.R"
## [5] "gs_design_ahr_.R"          "gs_design_npe_.R"         
## [7] "gs_power_ahr_.R"           "gs_power_npe_.R"          
## [9] "tEvents_.R"
sapply(paste0(my_path, source_files), source)
##         ./old_function/AHR_.R ./old_function/eEvents_.R
## value   ?                     ?                        
## visible FALSE                 FALSE                    
##         ./old_function/eEvents_df_.R ./old_function/gridpts_h1_hupdate_oldR.R
## value   ?                            ?                                       
## visible FALSE                        FALSE                                   
##         ./old_function/gs_design_ahr_.R ./old_function/gs_design_npe_.R
## value   ?                               ?                              
## visible FALSE                           FALSE                          
##         ./old_function/gs_power_ahr_.R ./old_function/gs_power_npe_.R
## value   ?                              ?                             
## visible FALSE                          FALSE                         
##         ./old_function/tEvents_.R
## value   ?                        
## visible FALSE

Test 1: unstratified population

enrollRates <- tibble(Stratum = "All",
                      duration = c(2, 10, 4, 4, 8),
                      rate = c(5, 10, 0, 3, 6))
failRates <- tibble(Stratum = "All",
                    duration = 1,
                    failRate = c(.1, .2, .3, .4),
                    hr = c(.9, .75, .8, .6),
                    dropoutRate = .001)

x1 <- AHR(enroll_rate = enrollRates, 
          fail_rate = failRates %>% rename(fail_rate = failRate, dropout_rate = dropoutRate), 
          total_duration = c(15, 30))

x2 <- AHR_(enrollRates = enrollRates, 
           failRates = failRates, 
           totalDuration = c(15, 30))

x1 %>% gt::gt() %>% gt::tab_header("AHR from gsDesign2 new version")
AHR from gsDesign2 new version
Time AHR Events info info0
15 0.6943679 90.97762 22.63594 22.74440
30 0.6847565 154.31467 37.85916 38.57867
x2 %>% gt::gt() %>% gt::tab_header("AHR from gsDesign2 old version")
AHR from gsDesign2 old version
Time AHR Events info info0
15 0.6943679 90.97762 22.63594 22.74440
30 0.6847565 154.31467 37.85916 38.57867

Test 2: stratified population

enrollRates <- tibble(Stratum = c(rep("Low", 2), rep("High", 3)),
                      duration = c(2, 10, 4, 4, 8),
                      rate = c(5, 10, 0, 3, 6))

failRates <- tibble(Stratum = c(rep("Low", 2), rep("High", 2)),
                    duration = 1,
                    failRate = c(.1, .2, .3, .4),
                    hr = c(.9, .75, .8, .6),
                    dropoutRate = .001)

x1 <- AHR(enroll_rate = enrollRates, 
          fail_rate = failRates %>% rename(fail_rate = failRate, dropout_rate = dropoutRate), 
          total_duration = c(15, 30))

x2 <- AHR_(enrollRates = enrollRates, 
           failRates = failRates, 
           totalDuration = c(15, 30))

x1 %>% gt::gt() %>% gt::tab_header("AHR from gsDesign2 new version")
AHR from gsDesign2 new version
Time AHR Events info info0
15 0.7332218 113.2782 28.11984 28.31954
30 0.7175169 166.1836 41.30913 41.54590
x2 %>% gt::gt() %>% gt::tab_header("AHR from gsDesign2 old version")
AHR from gsDesign2 old version
Time AHR Events info info0
15 0.7332218 113.2782 28.11984 28.31954
30 0.7175169 166.1836 41.30913 41.54590