diff --git a/.Rbuildignore b/.Rbuildignore index 5bc14a153..91fb891dd 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1,20 +1,6 @@ -^gsDesign2\.Rproj$ -^docs$ -^Meta$ -^doc$ -.travis.yml -^.*\.yml$ -^cran-comments\.md$ -^revdep$ -^CRAN-RELEASE$ -..Rcheck -^\.github$ ^.*\.Rproj$ ^\.Rproj\.user$ ^_pkgdown\.yml$ -^\.gitattributes$ +^docs$ ^pkgdown$ -^LICENSE$ -^LICENSES_THIRD_PARTY$ -^codecov\.yml$ - +^\.github$ diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 52c2b277c..40a4e08b3 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -22,7 +22,6 @@ jobs: - {os: windows-latest, r: 'release'} - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} - {os: ubuntu-latest, r: 'release'} - - {os: ubuntu-latest, r: 'oldrel-1'} env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index 0b2602168..63cbb18a1 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -1,10 +1,8 @@ -# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples +# Workflow derived from https://github.com/r-lib/actions/tree/master/examples # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help on: push: branches: [main, master] - pull_request: - branches: [main, master] release: types: [published] workflow_dispatch: @@ -14,33 +12,24 @@ name: pkgdown jobs: pkgdown: runs-on: ubuntu-latest - # Only restrict concurrency for non-PR jobs - concurrency: - group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: - uses: actions/checkout@v2 - - uses: r-lib/actions/setup-pandoc@v2 + - uses: r-lib/actions/setup-pandoc@v1 - - uses: r-lib/actions/setup-r@v2 + - uses: r-lib/actions/setup-r@v1 with: use-public-rspm: true - - uses: r-lib/actions/setup-r-dependencies@v2 + - uses: r-lib/actions/setup-r-dependencies@v1 with: - extra-packages: any::pkgdown, local::. + extra-packages: pkgdown needs: website - - name: Build site - run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE) - shell: Rscript {0} - - - name: Deploy to GitHub pages 🚀 - if: github.event_name != 'pull_request' - uses: JamesIves/github-pages-deploy-action@4.1.4 - with: - clean: false - branch: gh-pages - folder: docs + - name: Deploy package + run: | + git config --local user.name "$GITHUB_ACTOR" + git config --local user.email "$GITHUB_ACTOR@users.noreply.github.com" + Rscript -e 'pkgdown::deploy_to_branch(new_process = FALSE)' diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index 4b6541829..4fd5ce851 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -28,4 +28,4 @@ jobs: - name: Test coverage run: covr::codecov(quiet = FALSE) - shell: Rscript {0} + shell: Rscript {0} \ No newline at end of file diff --git a/.gitignore b/.gitignore index da75bb873..e7b95d481 100644 --- a/.gitignore +++ b/.gitignore @@ -1,10 +1,12 @@ +^.*\.Rproj$ +^\.Rproj\.user$ +^_pkgdown\.yml$ +^pkgdown$ +^docs$ +^data-raw$ +^LICENSE\.md$ +^LICENSES_THIRD_PARTY$ +^codecov\.yml$ +^tests/testthat/_snaps$ +^\.github$ .Rproj.user -doc -docs -Meta -inst/doc -.Rprofile -.Rhistory -.RData -.Ruserdata -sync_bitbucket.R diff --git a/DESCRIPTION b/DESCRIPTION index 779b80750..611947003 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,47 +1,56 @@ Package: gsDesign2 -Type: Package -Title: Group Sequential Design Under Non-Proportional Hazards +Title: Group sequential design with non-constant effect Version: 0.2.0 Authors@R: c( person("Keaven", "Anderson", email = "keaven_anderson@merck.com", role = c("aut")), - person("Yilong", "Zhang", email = "yilong.zhang@merck.com", role = c("aut", "cre")), + person("Yilong", "Zhang", email = "elong0527@gmail.com", role = c("aut")), + person("Yujie", "Zhao", email = "yujie.zhao@merck.com", role = c("aut", "cre")), + person("Jianxiao", "Yang", email = "yangjx@ucla.edu", role = c("ctb")), + person("Nan", "Xiao", email = "nan.xiao1@merck.com", role = c("ctb")), person("Amin", "Shirazi", email = "ashirazist@gmail.com", role = c("ctb")), person("Ruixue", "Wang", email = "ruixue.wang@merck.com", role = c("ctb")), person("Yi", "Cui", email = "yi.cui@merck.com", role = c("ctb")), person("Ping", "Yang", email = "ping.yang1@merck.com", role = c("ctb")), person("Xin Tong", "Li", email = "xin.tong.li@merck.com", role = c("ctb")), person("Yalin", "Zhu", email = "yalin.zhu@merck.com", role = c("ctb")), - person("Nan", "Xiao", email = "nan.xiao1@merck.com", role = c("ctb")), - person("Merck & Co., Inc., Rahway, NJ, USA and its affiliates", role = "cph") + person("Merck Sharp & Dohme Corp", role = "cph") ) -Maintainer: Yilong Zhang -Description: Compute sample size under non-proportional hazards. -Depends: R (>= 3.5.0) +Description: Basic group sequential design computations extended. License: GPL-3 -URL: https://merck.github.io/gsDesign2/, https://github.com/Merck/gsDesign2 -BugReports: https://github.com/Merck/gsDesign2/issues +URL: https://github.com/LittleBeannie/gsDesign2, + https://littlebeannie.github.io/gsDesign2/ +BugReports: https://github.com/LittleBeannie/gsDesign2/issues +Encoding: UTF-8 +VignetteBuilder: knitr Imports: + gsDesign, + dplyr, tibble, - dplyr (>= 0.8.3) + npsurvSS, + survival, + corpcor, + utils, + mvtnorm, + Rcpp, + methods Suggests: - gsDesign (>= 3.0), - ggplot2 (>= 3.2.0), - stats, - knitr (>= 1.23), - rmarkdown (>= 1.13), - kableExtra, - survival (>= 2.41-3), - mvtnorm (>= 1.0-11), testthat, + knitr, + rmarkdown, + purrr, + devtools, + kableExtra, + gt, + ggplot2, + tidyr, + covr, + bench, + microbenchmark, simtrial, - markdown, - covr -Encoding: UTF-8 -LazyData: true + kableExtra +Remotes: + Merck/simtrial Roxygen: list(markdown = TRUE) -Rmarkdown: echo = TRUE RoxygenNote: 7.2.1 -VignetteBuilder: knitr -Config/testthat/edition: 3 -Remotes: - Merck/simtrial +LinkingTo: + Rcpp diff --git a/LICENSE b/LICENSE index 2d5914758..f288702d2 100644 --- a/LICENSE +++ b/LICENSE @@ -1,7 +1,7 @@ GNU GENERAL PUBLIC LICENSE Version 3, 29 June 2007 - Copyright (C) 2007 Free Software Foundation, Inc. + Copyright (C) 2007 Free Software Foundation, Inc. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. @@ -631,8 +631,8 @@ to attach them to the start of each source file to most effectively state the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. - gsDesign2: Group Sequential Design Under Non-Proportional Hazards - Copyright (c) 2022 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. All rights reserved. + + Copyright (C) This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -645,14 +645,14 @@ the "copyright" line and a pointer to where the full notice is found. GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . + along with this program. If not, see . Also add information on how to contact you by electronic and paper mail. If the program does terminal interaction, make it output a short notice like this when it starts in an interactive mode: - gsDesign2 Copyright (c) 2022 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. All rights reserved. + Copyright (C) This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. @@ -664,11 +664,11 @@ might be different; for a GUI interface, you would use an "about box". You should also get your employer (if you work as a programmer) or school, if any, to sign a "copyright disclaimer" for the program, if necessary. For more information on this, and how to apply and follow the GNU GPL, see -. +. The GNU General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Lesser General Public License instead of this License. But first, please read -. +. diff --git a/LICENSES_THIRD_PARTY b/LICENSES_THIRD_PARTY index f98ea2e5d..382e50d69 100644 --- a/LICENSES_THIRD_PARTY +++ b/LICENSES_THIRD_PARTY @@ -7,11 +7,10 @@ You must agree to the terms of these licenses, in addition to the gsDesign2 source code license, in order to use this software. -------------------------------------------------- -Third party R packages listed by License type + Third party R packages listed by License type [Format: Name - URL] -------------------------------------------------- - -MIT / X11 License (or adaptations) (https://www.opensource.org/licenses/MIT) - * tibble - https://tibble.tidyverse.org/LICENSE.html - * dplyr - https://dplyr.tidyverse.org/LICENSE.html - + + MIT / X11 License (or adaptations) (https://www.opensource.org/licenses/MIT) +* tibble - https://tibble.tidyverse.org/LICENSE.html +* dplyr - https://dplyr.tidyverse.org/LICENSE.html \ No newline at end of file diff --git a/NAMESPACE b/NAMESPACE index 0f96fdec4..6ac47c42a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,11 +1,42 @@ # Generated by roxygen2: do not edit by hand +S3method(as_gt,fixed_design) +S3method(as_gt,gs_design) +S3method(summary,fixed_design) +S3method(summary,gs_design) export(AHR) +export(ahr_blinded) +export(as_gt) export(eAccrual) export(eEvents_df) +export(fixed_design) +export(gs_b) +export(gs_design_ahr) +export(gs_design_combo) +export(gs_design_npe) +export(gs_design_rd) +export(gs_design_wlr) +export(gs_info_ahr) +export(gs_info_combo) +export(gs_info_rd) +export(gs_info_wlr) +export(gs_power_ahr) +export(gs_power_combo) +export(gs_power_npe) +export(gs_power_rd) +export(gs_power_wlr) +export(gs_spending_bound) +export(gs_spending_combo) +export(pmvnorm_combo) export(ppwe) export(s2pwe) +export(summary) export(tEvents) +export(wlr_weight_1) +export(wlr_weight_fh) +export(wlr_weight_n) +import(Rcpp) +import(tibble) importFrom(dplyr,"%>%") importFrom(dplyr,arrange) importFrom(dplyr,desc) @@ -16,11 +47,21 @@ importFrom(dplyr,group_by) importFrom(dplyr,lag) importFrom(dplyr,last) importFrom(dplyr,lead) +importFrom(dplyr,left_join) importFrom(dplyr,mutate) +importFrom(dplyr,right_join) importFrom(dplyr,select) importFrom(dplyr,summarize) importFrom(dplyr,transmute) importFrom(dplyr,ungroup) +importFrom(gsDesign,gsDesign) +importFrom(gsDesign,sfLDOF) +importFrom(mvtnorm,GenzBretz) +importFrom(stats,dnorm) +importFrom(stats,pnorm) +importFrom(stats,qnorm) importFrom(stats,stepfun) importFrom(stats,uniroot) +importFrom(survival,Surv) importFrom(tibble,tibble) +useDynLib(gsDesign2, .registration = TRUE) diff --git a/R/AHR.R b/R/AHR.R index 09b7c7847..b2d955234 100644 --- a/R/AHR.R +++ b/R/AHR.R @@ -1,4 +1,5 @@ -# Copyright (c) 2022 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. All rights reserved. +# Copyright (c) 2021 Merck Sharp & Dohme Corp., a subsidiary of +# Merck & Co., Inc., Kenilworth, NJ, USA. # # This file is part of the gsDesign2 program. # @@ -76,116 +77,127 @@ NULL #' and info0 (information under related null hypothesis) for each value of `totalDuration` input; #' if `simple=FALSE`, `Stratum` and `t` (beginning of each constant HR period) are also returned #' and `HR` is returned instead of `AHR` +#' #' @examples #' # Example: default #' AHR() -#' # Example; default with multiple analysis times (varying totalDuration) -#' AHR(totalDuration=c(15,30)) +#' +#' # Example: default with multiple analysis times (varying totalDuration) +#' +#' AHR(totalDuration = c(15, 30)) +#' #' # Stratified population -#' enrollRates <- tibble::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::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 -#' ) -#' AHR(enrollRates=enrollRates, -#' failRates=failRates, -#' totalDuration=c(15,30) -#' ) +#' enrollRates <- tibble::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::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) +#' AHR(enrollRates = enrollRates, failRates = failRates, totalDuration = c(15, 30)) +#' #' # Same example, give results by strata and time period -#' AHR(enrollRates=enrollRates, -#' failRates=failRates, -#' totalDuration=c(15,30), -#' simple=FALSE -#' ) +#' AHR(enrollRates = enrollRates, failRates = failRates, totalDuration = c(15, 30), simple = FALSE) +#' #' @export #' -AHR <- function(enrollRates=tibble::tibble(Stratum="All", - duration=c(2,2,10), - rate=c(3,6,9)), - failRates=tibble::tibble(Stratum="All", - duration=c(3,100), - failRate=log(2)/c(9,18), - hr=c(.9,.6), - dropoutRate=rep(.001,2)), - totalDuration=30, - ratio=1, - simple=TRUE +AHR <- function(enrollRates = tibble::tibble(Stratum = "All", + duration = c(2, 2, 10), + rate = c(3, 6, 9)), + failRates = tibble::tibble(Stratum = "All", + duration = c(3, 100), + failRate = log(2) / c(9, 18), + hr = c(.9, .6), + dropoutRate = rep(.001, 2)), + totalDuration = 30, + ratio = 1, + simple = TRUE ){ - # check input values - # check input enrollment rate assumptions - if(max(names(enrollRates)=="Stratum") != 1){stop("gsDesign2: enrollRates column names in `AHR()` must contain stratum")} - if(max(names(enrollRates)=="duration") != 1){stop("gsDesign2: enrollRates column names in `AHR()` must contain duration")} - if(max(names(enrollRates)=="rate") != 1){stop("gsDesign2: enrollRates column names in `AHR()' must contain rate")} - - # check input failure rate assumptions - if(max(names(failRates)=="Stratum") != 1){stop("gsDesign2: failRates column names in `AHR()` must contain stratum")} - if(max(names(failRates)=="duration") != 1){stop("gsDesign2: failRates column names in `AHR()` must contain duration")} - if(max(names(failRates)=="failRate") != 1){stop("gsDesign2: failRates column names in `AHR()` must contain failRate")} - if(max(names(failRates)=="hr") != 1){stop("gsDesign2: failRates column names in `AHR()` must contain hr")} - if(max(names(failRates)=="dropoutRate") != 1){stop("gsDesign2: failRates column names in `AHR()` must contain dropoutRate")} - - # check input trial durations - if(!is.numeric(totalDuration)){stop("gsDesign2: totalDuration in `AHR()` must be a non-empty vector of positive numbers")} - if(!is.vector(totalDuration) > 0){stop("gsDesign2: totalDuration in `AHR()` must be a non-empty vector of positive numbers")} - if(!min(totalDuration) > 0){stop("gsDesign2: totalDuration in `AHR()` must be greater than zero")} - strata <- names(table(enrollRates$Stratum)) - strata2 <- names(table(failRates$Stratum)) - length(strata) == length(strata2) - for(s in strata){ - if(max(strata2==s) != 1){stop("gsDesign2: Strata in `AHR()` must be the same in enrollRates and failRates")} - } - # check input simple is logical + # ----------------------------# + # check input values # + # ----------------------------# + check_enrollRates(enrollRates) + check_failRates(failRates) + check_enrollRates_failRates(enrollRates, failRates) + check_totalDuration(totalDuration) + check_ratio(ratio) if(!is.logical(simple)){stop("gsDesign2: simple in `AHR()` must be logical")} - + # compute proportion in each group Qe <- ratio / (1 + ratio) Qc <- 1 - Qe - + # compute expected events by treatment group, stratum and time period - rval <- NULL + ans <- NULL + strata <- unique(enrollRates$Stratum) + for(td in totalDuration){ + events <- NULL + for(s in strata){ # subset to stratum - enroll <- enrollRates %>% filter(Stratum==s) - fail <- failRates %>% filter(Stratum==s) - # Control events - enrollc <- enroll %>% mutate(rate=rate*Qc) - control <- eEvents_df(enrollRates=enrollc,failRates=fail,totalDuration=td,simple=FALSE) - # Experimental events - enrolle <- enroll %>% mutate(rate=rate*Qe) - fre <- fail %>% mutate(failRate=failRate*hr) - experimental <- eEvents_df(enrollRates=enrolle,failRates=fre,totalDuration=td,simple=FALSE) + enroll <- enrollRates %>% filter(Stratum == s) + fail <- failRates %>% filter(Stratum == s) + + # update enrollment rates + enroll_c <- enroll %>% mutate(rate = rate * Qc) + enroll_e <- enroll %>% mutate(rate = rate * Qe) + + # update failure rates + fail_c <- fail + fail_e <- fail %>% mutate(failRate = failRate * hr) + + # compute expected number of events + events_c <- eEvents_df(enrollRates = enroll_c, failRates = fail_c, totalDuration = td, simple = FALSE) + events_e <- eEvents_df(enrollRates = enroll_e, failRates = fail_e, totalDuration = td, simple = FALSE) + # Combine control and experimental; by period recompute HR, events, information - events <- - rbind(control %>% mutate(Treatment="Control"), - experimental %>% mutate(Treatment="Experimental")) %>% - arrange(t, Treatment) %>% ungroup() %>% group_by(t) %>% - summarize(Stratum = s, info = (sum(1 / Events))^(-1), - Events = sum(Events), HR = last(failRate) / first(failRate) - ) %>% - rbind(events) + events <- rbind(events_c %>% mutate(Treatment = "Control"), + events_e %>% mutate(Treatment = "Experimental")) %>% + arrange(t, Treatment) %>% + ungroup() %>% + # recompute HR, events, info by period + group_by(t) %>% + summarize(Stratum = s, + info = (sum(1 / Events))^(-1), + Events = sum(Events), + HR = last(failRate) / first(failRate)) %>% + rbind(events) } - rval <- rbind(rval, - events %>% - mutate(Time=td, lnhr = log(HR), info0 = Events * Qc * Qe) %>% - ungroup() %>% group_by(Time, Stratum, HR) %>% - summarize(t=min(t), Events = sum(Events), info0 = sum(info0), info = sum(info)) - ) + + # summarize events in one stratum + ans_new <- events %>% + mutate(Time = td, + lnhr = log(HR), + info0 = Events * Qc * Qe) %>% + ungroup() %>% + # pool strata together for each time period + group_by(Time, Stratum, HR) %>% + summarize(t = min(t), + Events = sum(Events), + info0 = sum(info0), + info = sum(info)) + ans <- rbind(ans, ans_new) } - - if(!simple) return(rval %>% select(c("Time", "Stratum", "t", "HR", "Events", "info", "info0")) %>% - group_by(Time, Stratum) %>% arrange(t, .by_group = TRUE)) - return(rval %>% + + # output the results + if(!simple){ + ans <- ans %>% + select(Time, Stratum, t, HR, Events, info, info0) %>% + group_by(Time, Stratum) %>% + arrange(t, .by_group = TRUE) %>% + ungroup() + }else{ + ans <- ans %>% group_by(Time) %>% - summarize(AHR = exp(sum(log(HR)*Events)/sum(Events)), + summarize(AHR = exp(sum(log(HR) * Events) / sum(Events)), Events = sum(Events), info = sum(info), - info0 = sum(info0)) - ) -} + info0 = sum(info0)) %>% + ungroup() + + } + return(ans) +} \ No newline at end of file diff --git a/R/AHR_.R b/R/AHR_.R new file mode 100644 index 000000000..47d757a0c --- /dev/null +++ b/R/AHR_.R @@ -0,0 +1,195 @@ +# Copyright (c) 2021 Merck Sharp & Dohme Corp., a subsidiary of +# Merck & Co., Inc., Kenilworth, NJ, USA. +# +# This file is part of the gsDesign2 program. +# +# gsDesign2 is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +#' @importFrom dplyr filter mutate transmute full_join group_by summarize ungroup first "%>%" +#' @importFrom tibble tibble +NULL + +#' Average hazard ratio under non-proportional hazards (test version) +#' +#' \code{AHR()} provides a geometric average hazard ratio under +#' various non-proportional hazards assumptions for either single or multiple strata studies. +#' The piecewise exponential distribution allows a simple method to specify a distribution +#' and enrollment pattern where the enrollment, failure and dropout rates changes over time. +#' @param enrollRates Piecewise constant enrollment rates by stratum and time period. +#' @param failRates Piecewise constant control group failure rates, duration for each piecewise constant period, +#' hazard ratio for experimental vs control, and dropout rates by stratum and time period. +#' @param totalDuration Total follow-up from start of enrollment to data cutoff; +#' this can be a single value or a vector of positive numbers. +#' @param ratio ratio of experimental to control randomization. +#' @param simple logical; if TRUE (default), for each value in input totalDuration overall event count, +#' statistical information and average hazard ratio are given; +#' if FALSE, hazard ratio, expected events and statistical information are produced by stratum and underlying hazard ratio. +#' @section Specification: +#' \if{latex}{ +#' \itemize{ +#' \item Validate if input enrollment rate contains stratum column. +#' \item Validate if input enrollment rate contains total duration column. +#' \item Validate if input enrollment rate contains rate column. +#' \item Validate if input failure rate contains stratum column. +#' \item Validate if input failure rate contains duration column. +#' \item Validate if input failure rate contains failure rate column. +#' \item Validate if input failure rate contains hazard ratio column. +#' \item Validate if input failure rate contains dropout rate column. +#' \item Validate if input trial total follow-up (total duration) is a non-empty vector of positive integers. +#' \item Validate if strata is the same in enrollment rate and failure rate. +#' \item Validate if input simple is logical. +#' \item Compute the proportion in each group. +#' \item Compute the expected events by treatment groups, stratum and time period. +#' \item Calculate the expected number of events for all time points in the total +#' duration and for all stratification variables. +#' \itemize{ +#' \item Compute the expected events in for each strata. +#' \itemize{ +#' \item Combine the expected number of events of all stratification variables. +#' \item Recompute events, hazard ratio and information under the given scenario of the combined data for each strata. +#' } +#' \item Combine the results for all time points by summarizing the results by adding up the number of events, +#' information under the null and the given scenarios. +#' } +#' \item Return a tibble of overall event count, statistical information and average hazard ratio +#' of each value in totalDuration if the input simple is true, or a tibble of hazard ratio, +#' expected events and statistical information produced by stratum and +#' underlying hazard ratio if the input simple is false. +#' \item Calculation of \code{AHR} for different design scenarios, and the comparison to the +#' simulation studies are defined in vignette/AHRVignette.Rmd. +#' } +#' } +#' \if{html}{The contents of this section are shown in PDF user manual only.} +#' +#' @return A `tibble` with `Time` (from `totalDuration`), `AHR` (average hazard ratio), +#' `Events` (expected number of events), info (information under given scenarios), +#' and info0 (information under related null hypothesis) for each value of `totalDuration` input; +#' if `simple=FALSE`, `Stratum` and `t` (beginning of each constant HR period) are also returned +#' and `HR` is returned instead of `AHR` +#' +#' @examples +#' # Example: default +#' gsDesign2:::AHR_() +#' +#' # Example; default with multiple analysis times (varying totalDuration) +#' gsDesign2:::AHR_(totalDuration = c(15,30)) +#' +#' # Stratified population +#' enrollRates <- tibble::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::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 +#' ) +#' gsDesign2:::AHR_(enrollRates=enrollRates, +#' failRates=failRates, +#' totalDuration=c(15,30) +#' ) +#' # Same example, give results by strata and time period +#' gsDesign2:::AHR_(enrollRates=enrollRates, +#' failRates=failRates, +#' totalDuration=c(15,30), +#' simple=FALSE +#' ) +#' +#' @noRd +AHR_ <- function(enrollRates=tibble::tibble(Stratum="All", + duration=c(2,2,10), + rate=c(3,6,9)), + failRates=tibble::tibble(Stratum="All", + duration=c(3,100), + failRate=log(2)/c(9,18), + hr=c(.9,.6), + dropoutRate=rep(.001,2)), + totalDuration=30, + ratio=1, + simple=TRUE +){ + # check input values + # check input enrollment rate assumptions + if(max(names(enrollRates)=="Stratum") != 1){stop("gsDesign2: enrollRates column names in `AHR()` must contain stratum")} + if(max(names(enrollRates)=="duration") != 1){stop("gsDesign2: enrollRates column names in `AHR()` must contain duration")} + if(max(names(enrollRates)=="rate") != 1){stop("gsDesign2: enrollRates column names in `AHR()' must contain rate")} + + # check input failure rate assumptions + if(max(names(failRates)=="Stratum") != 1){stop("gsDesign2: failRates column names in `AHR()` must contain stratum")} + if(max(names(failRates)=="duration") != 1){stop("gsDesign2: failRates column names in `AHR()` must contain duration")} + if(max(names(failRates)=="failRate") != 1){stop("gsDesign2: failRates column names in `AHR()` must contain failRate")} + if(max(names(failRates)=="hr") != 1){stop("gsDesign2: failRates column names in `AHR()` must contain hr")} + if(max(names(failRates)=="dropoutRate") != 1){stop("gsDesign2: failRates column names in `AHR()` must contain dropoutRate")} + + # check input trial durations + if(!is.numeric(totalDuration)){stop("gsDesign2: totalDuration in `AHR()` must be a non-empty vector of positive numbers")} + if(!is.vector(totalDuration) > 0){stop("gsDesign2: totalDuration in `AHR()` must be a non-empty vector of positive numbers")} + if(!min(totalDuration) > 0){stop("gsDesign2: totalDuration in `AHR()` must be greater than zero")} + strata <- names(table(enrollRates$Stratum)) + strata2 <- names(table(failRates$Stratum)) + length(strata) == length(strata2) + for(s in strata){ + if(max(strata2==s) != 1){stop("gsDesign2: Strata in `AHR()` must be the same in enrollRates and failRates")} + } + # check input simple is logical + if(!is.logical(simple)){stop("gsDesign2: simple in `AHR()` must be logical")} + + # compute proportion in each group + Qe <- ratio / (1 + ratio) + Qc <- 1 - Qe + + # compute expected events by treatment group, stratum and time period + rval <- NULL + for(td in totalDuration){ + events <- NULL + for(s in strata){ + # subset to stratum + enroll <- enrollRates %>% filter(Stratum==s) + fail <- failRates %>% filter(Stratum==s) + # Control events + enrollc <- enroll %>% mutate(rate=rate*Qc) + control <- eEvents_df(enrollRates=enrollc,failRates=fail,totalDuration=td,simple=FALSE) + # Experimental events + enrolle <- enroll %>% mutate(rate=rate*Qe) + fre <- fail %>% mutate(failRate=failRate*hr) + experimental <- eEvents_df(enrollRates=enrolle,failRates=fre,totalDuration=td,simple=FALSE) + # Combine control and experimental; by period recompute HR, events, information + events <- + rbind(control %>% mutate(Treatment="Control"), + experimental %>% mutate(Treatment="Experimental")) %>% + arrange(t, Treatment) %>% ungroup() %>% group_by(t) %>% + summarize(Stratum = s, info = (sum(1 / Events))^(-1), + Events = sum(Events), HR = last(failRate) / first(failRate) + ) %>% + rbind(events) + } + rval <- rbind(rval, + events %>% + mutate(Time=td, lnhr = log(HR), info0 = Events * Qc * Qe) %>% + ungroup() %>% group_by(Time, Stratum, HR) %>% + summarize(t=min(t), Events = sum(Events), info0 = sum(info0), info = sum(info)) + ) + } + + if(!simple) return(rval %>% select(c("Time", "Stratum", "t", "HR", "Events", "info", "info0")) %>% + group_by(Time, Stratum) %>% arrange(t, .by_group = TRUE)) + return(rval %>% + group_by(Time) %>% + summarize(AHR = exp(sum(log(HR)*Events)/sum(Events)), + Events = sum(Events), + info = sum(info), + info0 = sum(info0)) + ) +} \ No newline at end of file diff --git a/R/RcppExports.R b/R/RcppExports.R new file mode 100644 index 000000000..07e91dfd6 --- /dev/null +++ b/R/RcppExports.R @@ -0,0 +1,15 @@ +# Generated by using Rcpp::compileAttributes() -> do not edit by hand +# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 + +.gridptsRcpp <- function(r, mu, a, b) { + .Call(`_gsDesign2_gridptsRcpp`, r, mu, a, b) +} + +.h1Rcpp <- function(r, theta, I, a, b) { + .Call(`_gsDesign2_h1Rcpp`, r, theta, I, a, b) +} + +.hupdateRcpp <- function(r, theta, I, a, b, thetam1, Im1, gm1) { + .Call(`_gsDesign2_hupdateRcpp`, r, theta, I, a, b, thetam1, Im1, gm1) +} + diff --git a/R/as_gt.R b/R/as_gt.R new file mode 100644 index 000000000..ad6b94b9f --- /dev/null +++ b/R/as_gt.R @@ -0,0 +1,445 @@ +# Copyright (c) 2021 Merck Sharp & Dohme Corp. a subsidiary of Merck & Co., Inc., Kenilworth, NJ, USA. +# +# This file is part of the gsdmvn program. +# +# gsdmvn is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +#' S3 class method to get summary table into a gt table +#' +#' @param x a summary of fixed or group sequential design +#' @param ... additional arguments +#' +#' @return a gt table +#' @export +#' +as_gt <- function(x, ...) { + UseMethod("as_gt", x) +} + +#' This is the function to format the bounds summary table of fixed design into gt style. +#' @rdname as_gt.fixed_design +#' +#' @param x a summary object of group sequential design +#' @param title title to be displayed +#' @param footnote footnotes to be displayed +#' @param ... additional arguments +#' +#' @return a gt table +#' +#' @export as_gt +#' @exportS3Method +#' +#' @method as_gt fixed_design +#' +#' @examples +#' library(dplyr) +#' library(tibble) +#' +#' # Enrollment rate +#' enrollRates <- tibble( +#' Stratum = "All", +#' duration = 18, +#' rate = 20) +#' +#' # Failure rates +#' failRates <- tibble( +#' Stratum = "All", +#' duration = c(4, 100), +#' failRate = log(2) / 12, +#' hr = c(1, .6), +#' dropoutRate = .001) +#' +#' # Study duration in months +#' studyDuration <- 36 +#' +#' # Experimental / Control randomization ratio +#' ratio <- 1 +#' +#' # 1-sided Type I error +#' alpha <- 0.025 +#' +#' # Type II error (1 - power) +#' beta <- 0.1 +#' +#' # ------------------------- # +#' # AHR # +#' # ------------------------- # +#' # under fixed power +#' fixed_design( +#' x = "AHR", +#' alpha = alpha, power = 1 - beta, +#' enrollRates = enrollRates, failRates = failRates, +#' studyDuration = studyDuration, ratio = ratio +#' ) %>% +#' summary() %>% +#' as_gt() +#' +#' # ------------------------- # +#' # FH # +#' # ------------------------- # +#' # under fixed power +#' fixed_design( +#' x = "FH", +#' alpha = alpha, power = 1 - beta, +#' enrollRates = enrollRates, failRates = failRates, +#' studyDuration = studyDuration, ratio = ratio +#' ) %>% +#' summary() %>% +#' as_gt() +#' +as_gt.fixed_design <- function(x, title = NULL, footnote = NULL, ...){ + # get the design method + if("AHR" %in% class(x)){ + design_mtd <- "AHR" + }else if("FH" %in% class(x)){ + design_mtd <- "FH" + }else if("MB" %in% class(x)){ + design_mtd <- "MB" + }else if("LF" %in% class(x)){ + design_mtd <- "LF" + }else if("RD" %in% class(x)){ + design_mtd <- "RD" + }else if("MaxCombo" %in% class(x)){ + design_mtd <- "MaxCombo" + }else if("Milestone" %in% class(x)){ + design_mtd <- "Milestone" + }else if("RMST" %in% class(x)){ + design_mtd <- "RMST" + }else if("RD" %in% class(x)){ + design_mtd <- "RD" + } + + + # set the default title + if(is.null(title)){ + title <- switch (design_mtd, + "AHR" = {"Fixed Design under AHR Method"}, + "FH" = {"Fixed Design under Fleming-Harrington Method"}, + "MB" = {"Fixed Design under Magirr-Burman Method"}, + "LF" = {"Fixed Design under Lachin and Foulkes Method"}, + "RD" = {"Fixed Design of Risk Difference under Farrington-Manning Method"}, + "MaxCombo" = {"Fixed Design under Max Combo Method"}, + "Milestone" = {"Fixed Design under Milestone Method"}, + "RMST" = {"Fixed Design under Restricted Mean Survival Time Method"}, + "RD" = {"Fixed Design of Risk Difference"} + ) + } + + + # set the default footnote + if(is.null(footnote)){ + footnote <- switch (design_mtd, + "AHR" = {"Power computed with average hazard ratio method."}, + "FH" = {paste0("Power for Fleming-Harrington test ", + substr(x$Design, 19, nchar(x$Design)), + " using method of Yung and Liu.")}, + "MB" = {paste0("Power for ", + x$Design, + " computed with method of Yung and Liu.")}, + "LF" = {"Power using Lachin and Foulkes method applied using expected average hazard ratio (AHR) at time of planned analysis."}, + "RD" = {"Risk difference power without continuity correction using method of Farrington and Manning."}, + "MaxCombo" = {paste0("Power for MaxCombo test with Fleming-Harrington tests", + substr(x$Design, 9, nchar(x$Design)), "." + # paste(apply(do.call(rbind, x$design_par), 2 , paste , collapse = "," ), collapse = ") and ("), + )}, + "Milestone" = {paste0("Power for ", x$Design, " computed with method of Yung and Liu.")}, + "RMST" = {paste0("Power for ", x$Design, " computed with method of Yung and Liu.")} + ) + } + + ans <- x %>% + mutate(Design = design_mtd) %>% + gt::gt() %>% + gt::tab_header(title = title) %>% + gt::tab_footnote(footnote = footnote, locations = gt::cells_title(group = "title")) + + return(ans) +} + + +#' This is the function to format the bounds summary table into gt style. +#' @rdname as_gt.gs_design +#' +#' @param x an object returned by \code{summary_bound} +#' @param title a string to specify the title of the gt table +#' @param subtitle a string to specify the subtitle of the gt table +#' @param colname_spanner a string to specify the spanner of the gt table +#' @param colname_spannersub a vector of strings to specify the spanner details of the gt table +#' @param footnote a list containing \code{content}, \code{location}, and \code{attr}. +#' the \code{content} is a vector of string to specify the footnote text; +#' the \code{location} is a vector of string to specify the locations to put the superscript of the footnote index; +#' the \code{attr} is a vector of string to specify the attributes of the footnotes, e.g., c("colname", "title", "subtitle", "analysis", "spanner"); +#' users can use the functions in the \code{gt} package to custom themselves. +#' @param display_bound a vector of strings specifying the label of the bounds. The default is \code{c("Efficacy", "Futility")} +#' @param display_columns a vector of strings specifying the variables to be displayed in the summary table +#' @param display_inf_bound a logic value (TRUE or FALSE) whether to display the +-inf bound +#' @param ... additional arguments +#' +#' @return a gt table summarizing the bounds table in group sequential designs +#' +#' @export as_gt +#' @exportS3Method +#' +#' @method as_gt gs_design +#' @examples +#' # the default output +#' library(dplyr) +#' +#' gs_design_ahr() %>% +#' summary() %>% +#' as_gt() +#' +#' gs_power_ahr() %>% +#' summary() %>% +#' as_gt() +#' +#' gs_design_wlr() %>% +#' summary() %>% +#' as_gt() +#' +#' gs_power_wlr() %>% +#' summary() %>% +#' as_gt() +#' +#' \dontrun{ +#' gs_design_combo() %>% +#' summary() %>% +#' as_gt() +#' +#' gs_power_combo() %>% +#' summary() %>% +#' as_gt() +#' +#' gs_design_rd() %>% +#' summary() %>% +#' as_gt() +#' +#' gs_power_rd() %>% +#' summary() %>% +#' as_gt() +#' } +#' # usage of title = ..., subtitle = ... +#' # to edit the title/subtitle +#' gs_power_wlr() %>% +#' summary() %>% +#' as_gt( +#' title = "Bound Summary", +#' subtitle = "from gs_power_wlr") +#' +#'# usage of colname_spanner = ..., colname_spannersub = ... +#'# to edit the spanner and its sub-spanner +#' gs_power_wlr() %>% +#' summary() %>% +#' as_gt( +#' colname_spanner = "Cumulative probability to cross boundaries", +#' colname_spannersub = c("under H1", "under H0")) +#' +#'# usage of footnote = ... +#'# to edit the footnote +#' gs_power_wlr() %>% +#' summary() %>% +#' as_gt( +#' footnote = list(content = c("approximate weighted hazard ratio to cross bound.", +#' "wAHR is the weighted AHR.", +#' "the crossing probability.", +#' "this table is generated by gs_power_wlr."), +#' location = c("~wHR at bound", NA, NA, NA), +#' attr = c("colname", "analysis", "spanner", "title"))) +#' +#' # usage of display_bound = ... +#' # to either show efficacy bound or futility bound, or both(default) +#' gs_power_wlr() %>% +#' summary() %>% +#' as_gt(display_bound = "Efficacy") +#' +#' # usage of display_columns = ... +#' # to select the columns to display in the summary table +#' gs_power_wlr() %>% +#' summary() %>% +#' as_gt(display_columns = c("Analysis", "Bound", "Nominal p", "Z", "Probability")) +#' +as_gt.gs_design <- function( + x, + title = NULL, + subtitle = NULL, + colname_spanner = "Cumulative boundary crossing probability", + colname_spannersub = c("Alternate hypothesis", "Null hypothesis"), + footnote = NULL, + display_bound = c("Efficacy", "Futility"), + display_columns = NULL, + display_inf_bound = TRUE, + ... +){ + method <- class(x)[class(x) %in% c("ahr", "wlr", "combo", "rd")] + + + # --------------------------------------------- # + # set defaults # + # --------------------------------------------- # + # set different default title to different methods + if(method == "ahr" && is.null(title)){ + title <- "Bound summary for AHR design" + } + if(method == "wlr" && is.null(title)){ + title <- "Bound summary for WLR design" + } + if(method == "combo" && is.null(title)){ + title <- "Bound summary for Max Combo design" + } + + if(method == "rd" && is.null(title)){ + title <- "Bound summary of Binary Endpoint" + } + + # set different default subtitle to different methods + if(method == "ahr" && is.null(subtitle)){ + subtitle <- "AHR approximations of ~HR at bound" + } + if(method == "wlr" && is.null(subtitle)){ + subtitle <- "WLR approximation of ~wHR at bound" + } + if(method == "combo" && is.null(subtitle)){ + subtitle <- "Max Combo approximation" + } + if(method == "rd" && is.null(subtitle)){ + subtitle <- "measured by risk difference" + } + + # set different default columns to display + if(is.null(display_columns)){ + if(method == "ahr"){ + display_columns <- c("Analysis", "Bound", "Nominal p", "~HR at bound", "Alternate hypothesis", "Null hypothesis") + }else if(method == "wlr"){ + display_columns <- c("Analysis", "Bound", "Nominal p", "~wHR at bound", "Alternate hypothesis", "Null hypothesis") + }else if(method == "combo"){ + display_columns <- c("Analysis", "Bound", "Nominal p", "Alternate hypothesis", "Null hypothesis") + }else if(method == "rd"){ + display_columns <- c("Analysis", "Bound", "Nominal p", "~Risk difference at bound", "Alternate hypothesis", "Null hypothesis") + } + } + # filter the columns to display as the output + ## if `Probability` is selected to output, then transform it to `c("Alternate hypothesis", "Null hypothesis")` + if("Probability" %in% display_columns){ + display_columns <- display_columns[!display_columns == "Probability"] + display_columns <- c(display_columns, "Alternate hypothesis", "Null hypothesis") + } + ## check if the `display_columns` are included in `x` output + if(sum(!(display_columns %in% names(x))) >= 1){ + stop("as_gt: the variable names in display_columns is not outputted in the summary_bound object!") + }else{ + x <- x %>% dplyr::select(all_of(display_columns)) + } + + # set different default footnotes to different methods + if(method == "ahr" && is.null(footnote)){ + footnote <- list(content = c(ifelse("~HR at bound" %in% display_columns, "Approximate hazard ratio to cross bound.", NA), + ifelse("Nominal p" %in% display_columns, "One-sided p-value for experimental vs control treatment. Values < 0.5 favor experimental, > 0.5 favor control.", NA)), + location = c(ifelse("~HR at bound" %in% display_columns, "~HR at bound", NA), + ifelse("Nominal p" %in% display_columns, "Nominal p", NA)), + attr = c(ifelse("~HR at bound" %in% display_columns, "colname", NA), + ifelse("Nominal p" %in% display_columns, "colname", NA))) + footnote <- lapply(footnote, function(x) x[!is.na(x)]) + } + if(method == "wlr" && is.null(footnote)){ + footnote <- list(content = c(ifelse("~wHR at bound" %in% display_columns, "Approximate hazard ratio to cross bound.", NA), + ifelse("Nominal p" %in% display_columns, "One-sided p-value for experimental vs control treatment. Values < 0.5 favor experimental, > 0.5 favor control.", NA), + "wAHR is the weighted AHR."), + location = c(ifelse("~wHR at bound" %in% display_columns, "~wHR at bound", NA), + ifelse("Nominal p" %in% display_columns, "Nominal p", NA), + NA), + attr = c(ifelse("~wHR at bound" %in% display_columns, "colname", NA), + ifelse("Nominal p" %in% display_columns, "colname", NA), + "analysis")) + footnote <- lapply(footnote, function(x) x[!is.na(x)]) + } + if(method == "combo" && is.null(footnote)){ + + footnote <- list(content = c(ifelse("Nominal p" %in% display_columns, "One-sided p-value for experimental vs control treatment. Values < 0.5 favor experimental, > 0.5 favor control.", NA), + "EF is event fraction. AHR is under regular weighted log rank test."), + location = c(ifelse("Nominal p" %in% display_columns, "Nominal p", NA), + NA), + attr = c(ifelse("Nominal p" %in% display_columns, "colname", NA), + "analysis")) + footnote <- lapply(footnote, function(x) x[!is.na(x)]) + } + if(method == "rd" && is.null(footnote)){ + + footnote <- list(content = c(ifelse("Nominal p" %in% display_columns, "One-sided p-value for experimental vs control treatment. Values < 0.5 favor experimental, > 0.5 favor control.", NA)), + location = c(ifelse("Nominal p" %in% display_columns, "Nominal p", NA)), + attr = c(ifelse("Nominal p" %in% display_columns, "colname", NA))) + footnote <- lapply(footnote, function(x) x[!is.na(x)]) + } + # --------------------------------------------- # + # filter out inf bound # + # --------------------------------------------- # + x <- x %>% + subset(!is.na(`Alternate hypothesis`)) %>% + subset(!is.na(`Null hypothesis`)) + + # --------------------------------------------- # + # add spanner # + # --------------------------------------------- # + names(x)[names(x) == "Alternate hypothesis"] <- colname_spannersub[1] + names(x)[names(x) == "Null hypothesis"] <- colname_spannersub[2] + + x <- x %>% + subset(Bound %in% display_bound) %>% + dplyr::arrange(Analysis) %>% + dplyr::group_by(Analysis) %>% + gt::gt() %>% + gt::tab_spanner( + columns = all_of(colname_spannersub), + label = colname_spanner) %>% + gt::tab_header(title = title, subtitle = subtitle) + + # --------------------------------------------- # + # add footnotes # + # --------------------------------------------- # + if(!is.null(footnote$content)){ + if(length(footnote$content) != 0){ + for (i in 1:length(footnote$content)) { + # if the footnotes is added on the colnames + if(footnote$attr[i] == "colname"){ + x <- x %>% + gt::tab_footnote( + footnote = footnote$content[i], + locations = gt::cells_column_labels(columns = footnote$location[i])) + } + # if the footnotes is added on the title/subtitle + if(footnote$attr[i] == "title" || footnote$attr[i] == "subtitle"){ + x <- x %>% + gt::tab_footnote( + footnote = footnote$content[i], + locations = gt::cells_title(group = footnote$attr[i])) + } + # if the footnotes is added on the analysis summary row, which is a grouping variable, i.e., Analysis + if(footnote$attr[i] == "analysis"){ + x <- x %>% + gt::tab_footnote( + footnote = footnote$content[i], + locations = gt::cells_row_groups(groups = dplyr::starts_with("Analysis"))) + } + # if the footnotes is added on the column spanner + if(footnote$attr[i] == "spanner"){ + x <- x %>% + gt::tab_footnote( + footnote = footnote$content[i], + locations = gt::cells_column_spanners(spanners = colname_spanner) + ) + } + } + } + } + return(x) +} \ No newline at end of file diff --git a/R/check_arg.R b/R/check_arg.R new file mode 100644 index 000000000..d9fbcc881 --- /dev/null +++ b/R/check_arg.R @@ -0,0 +1,406 @@ +#' A function to check the arguments \code{enrollRates} used in gsDesign2 +#' +#' @param enrollRates enrollment rates +#' +#' @return TURE or FALSE +#' +#' @examples +#' +#' enrollRates <- tibble::tibble(Stratum = "All", duration = c(2, 2, 10), rate = c(3, 6, 9)) +#' check_enrollRates(enrollRates) +#' +#' @noRd +#' +check_enrollRates <- function(enrollRates){ + + # --------------------------- # + # check the Stratum column # + # --------------------------- # + # if("Stratum" %in% colnames(enrollRates)){ + # stop("The enrollRates is a tibble which contains a column called `Stratum`!") + # } + + # --------------------------- # + # check the duration column # + # --------------------------- # + if(!"duration" %in% colnames(enrollRates)){ + stop("The enrollRates is a tibble which contains a column called `duration`!") + } + # the duration is numerical values + if(!is.numeric(enrollRates$duration)){ + stop("The `duration`column in enrollRates should be numeric!") + } + + # the duration is positive numbers + if(sum(!enrollRates$duration > 0) != 0){ + stop("The `duration` column in enrollRates should be positive numbers!") + } + + # --------------------------- # + # check the rate column # + # --------------------------- # + if(!"rate" %in% colnames(enrollRates)){ + stop("The enrollRates is a tibble which contains a column called `rate`!") + } + + # the rate is numerical values + if(!is.numeric(enrollRates$rate)){ + stop("The `rate`column in enrollRates should be numeric!") + } + + # the rate is positive numbers + if(sum(!enrollRates$rate >= 0) != 0){ + stop("The `rate` column in enrollRates should be positive numbers!") + } +} + + + +#' A function to check the arguments \code{failRates} used in gsDesign2 +#' +#' @param failRates failure rates +#' +#' @return TURE or FALSE +#' +#' @examples +#' +#' failRates <- tibble::tibble(Stratum = "All", duration = c(3, 100), +#' failRate = log(2) / c(9, 18), hr = c(.9, .6), +#' dropoutRate = rep(.001, 2)) +#' check_failRates(failRates) +#' +#' @noRd +check_failRates <- function(failRates){ + + # --------------------------- # + # check the Stratum column # + # --------------------------- # + # if(!"Stratum" %in% colnames(enrollRates)){ + # stop("The enrollRates is a tibble which contains a column called `Stratum`!") + # } + + # --------------------------- # + # check the duration column # + # --------------------------- # + if(!"duration" %in% colnames(failRates)){ + stop("The failRates is a tibble which contains a column called `duration`!") + } + # the duration is numerical values + if(!is.numeric(failRates$duration)){ + stop("The `duration`column in failRates should be numeric!") + } + + # the duration is positive numbers + if(sum(!failRates$duration > 0) != 0){ + stop("The `duration` column in failRates should be positive numbers!") + } + + # --------------------------- # + # check the failRate column # + # --------------------------- # + if(!"failRate" %in% colnames(failRates)){ + stop("The failRates is a tibble which contains a column called `failRate`!") + } + + # the rate is failRates values + if(!is.numeric(failRates$failRate)){ + stop("The `failRate`column in failRates should be numeric!") + } + + # the rate is positive numbers + if(sum(!failRates$failRate > 0) != 0){ + stop("The `failRate` column in failRates should be positive numbers!") + } + + # --------------------------- # + # check the hr column # + # --------------------------- # + if("hr" %in% colnames(failRates)){ + + if(!is.numeric(failRates$hr)){ + stop("The `hr`column in failRates should be numeric!") + } + + if(sum(!failRates$hr > 0) != 0){ + stop("The `hr` column in failRates should be positive numbers!") + } + } + + # --------------------------- # + # check the dropoutRate column# + # --------------------------- # + if(!"dropoutRate" %in% colnames(failRates)){ + stop("The failRates is a tibble which contains a column called `dropoutRate`!") + } + + # the rate is numerical values + if(!is.numeric(failRates$dropoutRate)){ + stop("The `dropoutRate`column in failRates should be numeric!") + } + + # the rate is positive numbers + if(sum(!failRates$dropoutRate >= 0) != 0){ + stop("The `dropoutRate` column in failRates should be positive numbers!") + } +} + + + +#' A function to check the arguments \code{enrollRates} and \code{failRates} used in gsDesign2 +#' +#' @param enrollRates enrollment rates +#' @param failRates failure rates +#' @return TURE or FALSE +#' +#' @examples +#' +#' enrollRates <- tibble::tibble(Stratum = "All", duration = c(2, 2, 10), rate = c(3, 6, 9)) +#' failRates <- tibble::tibble(Stratum = "All", duration = c(3, 100), +#' failRate = log(2) / c(9, 18), hr = c(.9, .6), +#' dropoutRate = rep(.001, 2)) +#' check_enrollRates(enrollRates, failRates) +#' +#' @noRd +#' +check_enrollRates_failRates <- function(enrollRates, failRates){ + + if("Stratum" %in% colnames(enrollRates) && "Stratum" %in% colnames(failRates)){ + strata_enroll <- unique(enrollRates$Stratum) + strata_fail <- unique(failRates$Stratum) + strata_common <- dplyr::intersect(strata_enroll, strata_fail) + + if(sum(strata_common %in% strata_enroll) != length(strata_enroll)){ + stop("The `Strata` column in the input argument `enrollRates` and `failRates` must be the same!") + } + } +} + + +#' A function to check the arguments \code{analysisTimes} used in gsDesign2 +#' +#' @param analysisTimes analysis time +#' +#' @return TURE or FALSE +#' +#' @examples +#' analysisTimes <- 20 +#' check_analysisTimes(analysisTimes) +#' +#' analysisTimes <- c(20, 30) +#' check_analysisTimes(analysisTimes) +#' +#' @noRd +check_analysisTimes <- function(analysisTimes){ + cond1 <- !is.numeric(analysisTimes) + cond2 <- !is.vector(analysisTimes) + cond3 <- min(analysisTimes - dplyr::lag(analysisTimes, def=0))<=0 + if ( cond1 || cond2 || cond3 ){ + stop("The input argument `analysisTimes` must be NULL a numeric vector with positive increasing values!") + } +} + + +#' A function to check the arguments \code{events} used in gsDesign2 +#' +#' @param events number of events +#' +#' @return TURE or FALSE +#' +#' @examples +#' events <- 20 +#' check_events(events) +#' +#' events <- c(20, 30) +#' check_events(events) +#' +#' @noRd +check_events <- function(events){ + cond1 <- !is.numeric(events) + cond2 <- !is.vector(events) + cond3 <- min(events - dplyr::lag(events, default=0))<=0 + if ( cond1 || cond2 || cond3 ){ + stop("The input argument `events` must be NULL or a numeric vector with positive increasing values!") + } +} + +#' A function to check the arguments \code{totalDuration} used in gsDesign2 +#' +#' @param totalDuration total duration +#' +#' @return TURE or FALSE +#' +#' @examples +#' totalDuration <- 36 +#' check_totalDuration(totalDuration) +#' +#' totalDuration <- c(36, 48) +#' check_totalDuration(totalDuration) +#' +#' @noRd +check_totalDuration <- function(totalDuration){ + if(!is.numeric(totalDuration)){ + stop("The input argument `totalDuration` must be a non-empty vector of positive numbers!") + } + + if(sum(!totalDuration > 0) != 0){ + stop("The input argument `totalDuration` must be a non-empty vector of positive numbers!") + } +} + +#' A function to check the arguments \code{ratio} used in gsDesign2 +#' +#' @param ratio randomization ratio +#' +#' @return TURE or FALSE +#' +#' @examples +#' ratio <- 1 +#' check_ratio(ratio) +#' +#' @noRd +check_ratio <- function(ratio){ + if(!is.numeric(ratio)){ + stop("The input argument `ratio` must be a numerical number!") + } + + if(ratio <= 0){ + stop("The input argument `ratio` must be a positive number!") + } +} + +#' A function to check the arguments \code{info} used in `gs_power_npe` or `gs_design_npe` in gsDesign2 +#' +#' @param info statistical information +#' +#' @return TURE or FALSE +#' +#' @examples +#' info <- 1:3 +#' check_info(info) +#' +#' @noRd +check_info <- function(info){ + if(!is.vector(info, mode = "numeric")){ + stop("gs_design_npe() or gs_power_npe(): info must be specified numeric vector!") + } + if (min(info - lag(info, default = 0)) <= 0){ + stop("gs_design_npe() or gs_power_npe(): info much be strictly increasing and positive!") + } +} + +#' A function to check the arguments \code{theta} used in `gs_power_npe` or `gs_design_npe` in gsDesign2 +#' +#' @param theta treatment effect +#' @param K number of total analysis +#' +#' @return TURE or FALSE +#' +#' @examples +#' theta <- 0.5 +#' check_theta(theta) +#' +#' @noRd +check_theta <- function(theta, K){ + if(!is.vector(theta, mode = "numeric")){ + stop("gs_design_npe() or gs_power_npe(): theta must be a real vector!") + } + + if(length(theta) != K){ + stop("gs_design_npe() or gs_power_npe(): if length(theta) > 1, must be same as info!") + } + + if(theta[K] < 0){ + stop("gs_design_npe() or gs_power_npe(): final effect size must be > 0!") + } +} + +#' A function to check the arguments \code{test_upper} used in `gs_power_npe` or `gs_design_npe` in gsDesign2 +#' +#' @param test_upper test upper or lower +#' @param K number of total analysis +#' +#' @return TURE or FALSE +#' +#' @examples +#' test_upper <- TRUE +#' check_test_upper(test_upper) +#' +#' @noRd +check_test_upper <- function(test_upper, K){ + ## Check test_upper and test_lower are logical and correct length + if(!is.vector(test_upper, mode = "logical")){ + stop("gs_design_npe() or gs_power_npe(): test_upper must be logical!") + } + + if(!(length(test_upper) == 1 || length(test_upper) == K)){ + stop("gs_design_npe() or gs_power_npe(): test_upper must be length 1 or same length as info!") + } + + # check that final test_upper value is TRUE + if(!dplyr::last(test_upper)){ + stop("gs_design_npe(): last value of test_upper must be TRUE!") + } + +} + +#' A function to check the arguments \code{text_lower} used in `gs_power_npe` or `gs_design_npe` in gsDesign2 +#' +#' @param test_lower test upper or lower +#' @param K number of total analysis +#' +#' @return TURE or FALSE +#' +#' @examples +#' test_lower <- TRUE +#' check_test_lower(test_lower) +#' +#' @noRd +check_test_lower <- function(test_lower, K){ + ## Check test_upper and test_lower are logical and correct length + if (!is.vector(test_lower, mode = "logical")){ + stop("gs_design_npe() or gs_power_npe(): test_lower must be logical!") + } + + if (!(length(test_lower) == 1 || length(test_lower) == K)){ + stop("gs_design_npe() or gs_power_npe(): test_lower must be length 1 or same length as info!") + } +} + +#' A function to check the arguments \code{alpha} and \code{beta} in gsDesign2 +#' +#' @param alpha type I error +#' @param beta type II error +#' +#' @return TURE or FALSE +#' +#' @examples +#' alpha <- 0.025 +#' beta <- 0.2 +#' check_alpha_beta(alpha, beta) +#' +#' @noRd +check_alpha_beta <- function(alpha, beta){ + if(!is.numeric(alpha)) stop("alpha must be numeric!") + if(!is.numeric(beta)) stop("beta must be numeric!") + if(length(alpha) != 1 || length(beta) != 1) stop("alpha and beta must be length 1!") + if(alpha <= 0 || 1 - beta <= alpha || beta <= 0) stop("must have 0 < alpha < 1 - beta < 1!") +} + +#' A function to check the arguments \code{IF} in gsDesign2 +#' +#' @param IF statistical informational fraction +#' +#' @return TURE or FALSE +#' +#' @examples +#' IF <- 1:3/3 +#' check_IF(IF) +#' +#' @noRd +check_IF <- function(IF){ + msg <- "gs_design_ahr(): IF must be a positive number or positive increasing sequence on (0, 1] with final value of 1" + if(!is.vector(IF, mode = "numeric")) stop(msg) + if(min(IF - dplyr::lag(IF, def = 0)) <= 0) stop(msg) + if(max(IF) != 1) stop(msg) +} + diff --git a/R/eAccrual.R b/R/eAccrual.R index 0c596ef6f..8c259bd14 100644 --- a/R/eAccrual.R +++ b/R/eAccrual.R @@ -1,4 +1,5 @@ -# Copyright (c) 2022 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. All rights reserved. +# Copyright (c) 2021 Merck Sharp & Dohme Corp., a subsidiary of +# Merck & Co., Inc., Kenilworth, NJ, USA. # # This file is part of the gsDesign2 program. # @@ -24,9 +25,11 @@ NULL #' #' \code{eAccrual()} computes the expected cumulative enrollment (accrual) #' given a set of piecewise constant enrollment rates and times. +#' #' @param x times at which enrollment is to be computed. #' @param enrollRates Piecewise constant enrollment rates expressed as a `tibble` with #' `duration` for each piecewise constant period and the `rate` of enrollment for that period. +#' #' @section Specification: #' \if{latex}{ #' \itemize{ @@ -46,44 +49,106 @@ NULL #' \if{html}{The contents of this section are shown in PDF user manual only.} #' #' @return A vector with expected cumulative enrollment for the specified `times`. +#' #' @examples -#' # Example: default +#' library(tibble) +#' +#' # Example 1: default #' eAccrual() +#' +#' # Example 2: unstratified design +#' eAccrual(x = c(5, 10, 20), +#' enrollRates = tibble(duration = c(3, 3, 18), rate = c(5, 10, 20))) +#' +#' eAccrual(x = c(5, 10, 20), +#' enrollRates = tibble(duration = c(3, 3, 18), rate = c(5, 10, 20), +#' Stratum = "All")) +#' +#' # Example 3: stratified design +#' eAccrual(x = c(24, 30, 40), +#' enrollRates = tibble(Stratum=c("subgroup", "complement"), +#' duration = 33, +#' rate = c(30, 30))) +#' #' @export #' eAccrual <- function(x = 0:24, - enrollRates=tibble::tibble(duration=c(3,3,18), - rate=c(5,10,20) -)){ -# check input value + enrollRates = tibble(duration = c(3, 3, 18), rate = c(5, 10, 20))){ + # check input value # check input enrollment rate assumptions - if(!is.numeric(x)){stop("gsDesign2: x in `eAccrual()` must be a strictly increasing non-negative numeric vector")} - if(!min(x) >= 0){stop("gsDesign2: x in `eAccrual()` must be a strictly increasing non-negative numeric vector")} - if(!min(lead(x,default=max(x)+1) - x) > 0){stop("gsDesign2: x in `eAccrual()` must be a strictly increasing non-negative numeric vector")} - + if(!is.numeric(x)){stop("gsDesign2: x in `eAccrual()` must be a strictly increasing non-negative numeric vector!")} + if(!min(x) >= 0){stop("gsDesign2: x in `eAccrual()` must be a strictly increasing non-negative numeric vector!")} + if(!min(lead(x, default = max(x) + 1) - x) > 0){stop("gsDesign2: x in `eAccrual()` must be a strictly increasing non-negative numeric vector!")} + # check enrollment rate assumptions - if(!is.data.frame(enrollRates)){stop("gsDesign2: enrollRates in `eAccrual()` must be a data frame")} - if(!max(names(enrollRates)=="duration") == 1){stop("gsDesign2: enrollRates in `eAccrual()` column names must contain duration")} - if(!max(names(enrollRates)=="rate") == 1){stop("gsDesign2: enrollRates in `eAccrual()` column names must contain rate")} - - # test that enrollment rates are non-negative with at least one positive - if(!min(enrollRates$rate) >= 0){stop("gsDesign2: enrollRates in `eAccrual()` must be non-negative with at least one positive rate")} - if(!max(enrollRates$rate) > 0){stop("gsDesign2: enrollRates in `eAccrual()` must be non-negative with at least one positive rate")} + check_enrollRates(enrollRates) + + # check if it is stratified design + if("Stratum" %in% names(enrollRates)){ + n_strata <- length(unique(enrollRates$Stratum)) + }else{ + n_strata <- 1 + } + + # convert rates to step function + if(n_strata == 1){ + ratefn <- stepfun(x = cumsum(enrollRates$duration), + y = c(enrollRates$rate, 0), + right = TRUE) + }else{ + ratefn <- lapply(unique(enrollRates$Stratum), + FUN = function(s){ + stepfun(x = cumsum((enrollRates %>% filter(Stratum == s))$duration), + y = c((enrollRates %>% filter(Stratum == s))$rate, 0), + right = TRUE) + }) + } + # add times where rates change to enrollRates + if(n_strata == 1){ + xvals <- sort(unique(c(x, cumsum(enrollRates$duration)))) + }else{ + xvals <- lapply(unique(enrollRates$Stratum), + FUN = function(s){ + sort(unique(c(x, cumsum((enrollRates %>% filter(Stratum == s))$duration)))) + }) + } + + # make a tibble + if(n_strata == 1){ + xx <- tibble(x = xvals, + duration = xvals - lag(xvals, default = 0), + rate = ratefn(xvals), # enrollment rates at points (right continuous) + eAccrual = cumsum(rate * duration) # expected accrual + ) + }else{ + xx <- lapply(1:n_strata, + FUN = function(i){ + tibble(x = xvals[[i]], + duration = xvals[[i]] - lag(xvals[[i]], default = 0), + rate = ratefn[[i]](xvals[[i]]), # enrollment rates at points (right continuous) + eAccrual = cumsum(rate * duration) # expected accrual + ) + }) + } + + -# convert rates to step function - ratefn <- stepfun(x=cumsum(enrollRates$duration), - y=c(enrollRates$rate,0), - right=TRUE) -# add times where rates change to enrollRates - xvals <- sort(unique(c(x,cumsum(enrollRates$duration)))) -# make a tibble - xx <- tibble::tibble(x=xvals, - duration= xvals - lag(xvals,default = 0), - rate=ratefn(xvals), # enrollment rates at points (right continuous) - eAccrual=cumsum(rate*duration) # expected accrual - ) -# return survival or cdf - ind <- !is.na(match(xx$x,x)) - return(as.numeric(xx$eAccrual[ind])) -} + # return survival or cdf + if(n_strata == 1){ + ind <- !is.na(match(xx$x, x)) + ans <- as.numeric(xx$eAccrual[ind]) + }else{ + ind <- lapply(1:n_strata, + FUN = function(i){ + !is.na(match(xx[[i]]$x, x)) + }) + ans <- lapply(1:n_strata, + FUN = function(i){ + as.numeric(xx[[i]]$eAccrual[ind[[i]]]) + }) + ans <- do.call("+", ans) + } + + return(ans) +} \ No newline at end of file diff --git a/R/eEvents_.R b/R/eEvents_.R new file mode 100644 index 000000000..a34c2de77 --- /dev/null +++ b/R/eEvents_.R @@ -0,0 +1,86 @@ +# Copyright (c) 2021 Merck Sharp & Dohme Corp., a subsidiary of +# Merck & Co., Inc., Kenilworth, NJ, USA. +# +# This file is part of the gsDesign2 program. +# +# gsDesign2 is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +#' @importFrom stats uniroot +NULL + +#' Predict time at which a targeted event count is achieved +#' +#' \code{tEvents()} is made to match input format with \code{AHR()} and to solve for the +#' time at which the expected accumulated events is equal to an input target. +#' Enrollment and failure rate distributions are specified as follows. +#' The piecewise exponential distribution allows a simple method to specify a distribtuion +#' and enrollment pattern +#' where the enrollment, failure and dropout rates changes over time. +#' @param enrollRates Piecewise constant enrollment rates by stratum and time period. +#' @param failRates Piecewise constant control group failure rates, duration for each piecewise constant period, +#' hazard ratio for experimental vs control, and dropout rates by stratum and time period. +#' @param targetEvents The targeted number of events to be achieved. +#' @param ratio Experimental:Control randomization ratio. +#' @param interval An interval that is presumed to include the time at which +#' expected event count is equal to `targetEvents`. +#' @section Specification: +#' \if{latex}{ +#' \itemize{ +#' \item Use root-finding routine with `AHR()` to find time at which targeted events accrue. +#' \item Return a tibble with a single row with the output from `AHR()` got the specified output. +#' } +#' } +#' @return A `tibble` with `Time` (computed to match events in `targetEvents`), `AHR` (average hazard ratio), +#' `Events` (`targetEvents` input), info (information under given scenarios), +#' and info0 (information under related null hypothesis) for each value of `totalDuration` input; +#' +#' @examples +#' library(dplyr) +#' library(gsDesign2) +#' +#' # Example 1: default +#' gsDesign2:::tEvents_() +#' +#' # Example 2: check that result matches a finding using AHR() +#' # Start by deriving an expected event count +#' enrollRates <- +#' tibble::tibble(Stratum="All", +#' duration=c(2,2,10), +#' rate=c(3,6,9)*5) +#' failRates=tibble::tibble(Stratum="All",duration=c(3,100),failRate=log(2)/c(9,18), +#' hr=c(.9,.6),dropoutRate=rep(.001,2)) +#' totalDuration <- 20 +#' xx <- gsDesign2:::AHR_(enrollRates,failRates,totalDuration) +#' xx +#' # Next we check that the function confirms the timing of the final analysis. +#' gsDesign2:::tEvents_(enrollRates,failRates,targetEvents=xx$Events,interval=c(.5,1.5)*xx$Time) +#' +#' @noRd +tEvents_ <- function(enrollRates=tibble::tibble(Stratum="All", + duration=c(2, 2, 10), + rate=c(3, 6, 9) * 5), + failRates=tibble::tibble(Stratum="All", + duration=c(3, 100), + failRate=log(2) / c(9, 18), + hr=c(.9, .6), + dropoutRate=rep(.001, 2)), + targetEvents=150, + ratio = 1, + interval=c(.01, 100) +){ + res <- try(uniroot(function(x){AHR(enrollRates, failRates, x, ratio)$Events - targetEvents}, + interval)) + if(inherits(res,"try-error")){stop("tEvents solution not found")} + AHR(enrollRates, failRates, res$root, ratio) +} \ No newline at end of file diff --git a/R/eEvents_df.R b/R/eEvents_df.R index 8b44e7305..e520bdab4 100644 --- a/R/eEvents_df.R +++ b/R/eEvents_df.R @@ -1,4 +1,5 @@ -# Copyright (c) 2022 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. All rights reserved. +# Copyright (c) 2021 Merck Sharp & Dohme Corp., a subsidiary of +# Merck & Co., Inc., Kenilworth, NJ, USA. # # This file is part of the gsDesign2 program. # @@ -73,120 +74,135 @@ NULL #' \code{Events} expected events during the period, #' #' The records in the returned \code{tibble} correspond to the input \code{tibble} \code{failRates}. +#' #' @details #' More periods will generally be supplied in output than those that are input. #' The intent is to enable expected event calculations in a tidy format to #' maximize flexibility for a variety of purposes. +#' #' @examples #' library(tibble) +#' library(gsDesign2) +#' #' # Default arguments, simple output (total event count only) #' eEvents_df() +#' #' # Event count by time period -#' eEvents_df(simple=FALSE) +#' eEvents_df(simple = FALSE) +#' #' # Early cutoff -#' eEvents_df(totalDuration=.5) +#' eEvents_df(totalDuration = .5) +#' #' # Single time period example -#' eEvents_df(enrollRates=tibble(duration=10,rate=10), -#' failRates=tibble(duration=100,failRate=log(2)/6,dropoutRate=.01), -#' totalDuration=22, -#' simple=FALSE -#' ) -#' # Single time period example, multiple enrolment periods -#' eEvents_df(enrollRates=tibble(duration=c(5,5), rate=c(10,20)), -#' failRates=tibble(duration=100,failRate=log(2)/6,dropoutRate=.01), -#' totalDuration=22, -#' simple=FALSE -#' ) +#' eEvents_df(enrollRates = tibble(duration = 10,rate = 10), +#' failRates = tibble(duration=100, failRate = log(2) / 6 ,dropoutRate = .01), +#' totalDuration = 22, +#' simple = FALSE) +#' +#' # Single time period example, multiple enrollment periods +#' eEvents_df(enrollRates = tibble(duration = c(5,5), rate = c(10, 20)), +#' failRates = tibble(duration = 100, failRate = log(2)/6, dropoutRate = .01), +#' totalDuration = 22, simple = FALSE) #' @export -eEvents_df <- function(enrollRates=tibble::tibble(duration=c(2,2,10), - rate=c(3,6,9)), - failRates=tibble::tibble(duration=c(3,100), - failRate=log(2)/c(9,18), - dropoutRate=rep(.001,2)), - totalDuration=25, - simple=TRUE +eEvents_df <- function(enrollRates = tibble::tibble(duration = c(2, 2, 10), + rate = c(3, 6, 9)), + failRates = tibble::tibble(duration = c(3, 100), + failRate = log(2) / c(9, 18), + dropoutRate = rep(.001, 2)), + totalDuration = 25, + simple = TRUE ){ - # check input values - # check input enrollment rate assumptions - if(max(names(enrollRates)=="duration") != 1){stop("gsDesign2: enrollRates column names in `eEvents()` must contain duration")} - if(max(names(enrollRates)=="rate") != 1){stop("gsDesign2: enrollRates column names in `eEvents()` must contain rate")} - - # check input failure rate assumptions - if(max(names(failRates)=="duration") != 1){stop("gsDesign2: failRates column names in `eEvents()` must contain duration")} - if(max(names(failRates)=="failRate") != 1){stop("gsDesign2: failRates column names in `eEvents()` must contain failRate")} - if(max(names(failRates)=="dropoutRate") != 1){stop("gsDesign2: failRates column names in `eEvents()` must contain dropoutRate")} - - # check input trial durations - if(!is.numeric(totalDuration)){stop("gsDesign2: totalDuration in `eEvents()` must be a non-empty vector of positive numbers")} - if(!is.vector(totalDuration) > 0){stop("gsDesign2: totalDuration in `eEvents()` must be a non-empty vector of positive numbers")} - if(!min(totalDuration) > 0){stop("gsDesign2: totalDuration in `eEvents()` must be greater than zero")} - - # check input simple is logical - if(!is.logical(simple)){stop("gsDesign2: simple in `eEvents()` must be logical")} - - df_1 <- tibble::tibble(startEnroll = c(0,cumsum(enrollRates$duration)), - endFail = totalDuration - startEnroll, - rate = c(enrollRates$rate,0)) - df_1 <- df_1[df_1$endFail >0, ] - + # ----------------------------# + # check input values # + # ----------------------------# + check_enrollRates(enrollRates) + check_failRates(failRates) + check_enrollRates_failRates(enrollRates, failRates) + check_totalDuration(totalDuration) + if(length(totalDuration) > 1){stop("gsDesign2: totalDuration in `events_df()` must be a numeric number!")} + if(!is.logical(simple)){stop("gsDesign2: simple in `eEvents_df()` must be logical")} + + # ----------------------------# + # divide the time line # + # into sub-intervals # + # ----------------------------# + ## by piecewise enrollment rates + df_1 <- tibble::tibble(startEnroll = c(0, cumsum(enrollRates$duration)), + endFail = totalDuration - startEnroll + #rate = c(enrollRates$rate, 0) + ) %>% subset(endFail > 0) + ## by piecewise failure & dropout rates df_2 <- tibble::tibble(endFail = cumsum(failRates$duration), - startEnroll = totalDuration - endFail, - failRate = failRates$failRate, - dropoutRate = failRates$dropoutRate) - df_2 <- if (last(cumsum(failRates$duration)) < totalDuration) df_2[-nrow(df_2),] else df_2[df_2$startEnroll >0,] # we will use start of failure rate periods repeatedly below - startFail <- c(0,cumsum(failRates$duration)) - # Step function to define failure rates over time + startEnroll = totalDuration - endFail, + failRate = failRates$failRate, + dropoutRate = failRates$dropoutRate) + temp <- cumsum(failRates$duration) + if(temp[length(temp)] < totalDuration){ + df_2 <- df_2[-nrow(df_2), ] + }else{ + df_2 <- df_2[df_2$startEnroll > 0, ] + } + + # ----------------------------# + # create 3 step functions (sf)# + # ----------------------------# + # Step function to define enrollment rates over time + sf.enrollRate <- stepfun(c(0, cumsum(enrollRates$duration)), + c(0, enrollRates$rate,0), + right = FALSE) + # step function to define failure rates over time + startFail <- c(0, cumsum(failRates$duration)) sf.failRate <- stepfun(startFail, - c(0,failRates$failRate,last(failRates$failRate)), - right = FALSE - ) - # Step function to define dropout rates over time + c(0, failRates$failRate, last(failRates$failRate)), + right = FALSE) + # step function to define dropout rates over time sf.dropoutRate <- stepfun(startFail, - c(0,failRates$dropoutRate, - last(failRates$dropoutRate)), - right = FALSE - ) - # sf.startFail is used later to group rows by periods defined by failRates - # # If only a single failure rate period, always 0 - # if(nrow(failRates)==1){x <- 0 - # y <- c(0,0)}else{ - # # if more than 1 failure rate period - # x <- startFail - # y <- c(0,startFail) - # } - sf.startFail <- stepfun(startFail, c(0,startFail), right = FALSE) + c(0, failRates$dropoutRate, last(failRates$dropoutRate)), + right = FALSE) - # Step function to define enrollment rates over time - sf.enrollRate <- stepfun(c(0,cumsum(enrollRates$duration)), - c(0,enrollRates$rate,0), - right = FALSE - ) - # Put everything together as laid out in vignette - # "Computing expected events by interval at risk" - df_join <- full_join(df_1, df_2, by = c("startEnroll", "endFail")) %>% + # ----------------------------# + # combine sub-intervals # + # from # + # enroll + failure + dropout # + # ----------------------------# + # impute the NA by step functions + df <- full_join(df_1, df_2, by = c("startEnroll", "endFail")) %>% arrange(endFail) %>% mutate(endEnroll = lag(startEnroll, default = as.numeric(totalDuration)), startFail = lag(endFail, default = 0), duration = endEnroll - startEnroll, failRate = sf.failRate(startFail), dropoutRate = sf.dropoutRate(startFail), - enrollRate = sf.enrollRate(startEnroll), - q = exp(-duration*(failRate+dropoutRate)), - Q = lag(cumprod(q),default=1) - ) %>% + enrollRate = sf.enrollRate(startEnroll)) %>% + # create 2 auxiliary variable for failure & dropout rate + # q: number of expected events in a sub-interval + # Q: cumulative product of q (pool all sub-intervals) + mutate(q = exp(-duration * (failRate + dropoutRate)), + Q = lag(cumprod(q), default = 1)) %>% arrange(desc(startFail)) %>% + # create another 2 auxiliary variable for enroll rate + # g: number of expected subjects in a sub-interval + # G: cumulative sum of g (pool all sub-intervals) mutate(g = enrollRate * duration, - G = lag(cumsum(g),default = 0) - ) %>% + G = lag(cumsum(g), default = 0)) %>% arrange(startFail) %>% - mutate(d = ifelse(failRate==0,0,Q*(1-q)*failRate/(failRate+dropoutRate)), - nbar = ifelse(failRate==0,0, - G*d + (failRate*Q*enrollRate)/(failRate+dropoutRate)*(duration-(1-q)/(failRate+dropoutRate))) - ) - if (simple) return(as.numeric(sum(df_join$nbar))) - df_join %>% transmute(t=endFail,failRate=failRate,Events=nbar, - startFail = sf.startFail(startFail) - ) %>% group_by(startFail) %>% - summarize(failRate=first(failRate),Events=sum(Events)) %>% - mutate(t=startFail) %>% select("t","failRate","Events") -} + # compute expected events as nbar in a sub-interval + mutate(d = ifelse(failRate == 0, 0, Q * (1 - q) * failRate / (failRate + dropoutRate)), + nbar = ifelse(failRate == 0, 0, G * d + (failRate * Q * enrollRate) / (failRate + dropoutRate) * (duration - (1 - q) / (failRate + dropoutRate)))) + + # ----------------------------# + # output results # + # ----------------------------# + if(simple){ + ans <- as.numeric(sum(df$nbar)) + }else{ + sf.startFail <- stepfun(startFail, c(0, startFail), right = FALSE) + ans <- df %>% + transmute(t = endFail, failRate = failRate, Events = nbar, startFail = sf.startFail(startFail)) %>% + group_by(startFail) %>% + summarize(failRate = first(failRate), Events = sum(Events)) %>% + mutate(t = startFail) %>% + select("t", "failRate", "Events") + } + return(ans) +} \ No newline at end of file diff --git a/R/eEvents_df_.R b/R/eEvents_df_.R new file mode 100644 index 000000000..6b9d8cff0 --- /dev/null +++ b/R/eEvents_df_.R @@ -0,0 +1,197 @@ +# Copyright (c) 2021 Merck Sharp & Dohme Corp., a subsidiary of +# Merck & Co., Inc., Kenilworth, NJ, USA. +# +# This file is part of the gsDesign2 program. +# +# gsDesign2 is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +#' @importFrom dplyr filter select full_join mutate transmute group_by ungroup summarize arrange desc lag last lead "%>%" +#' @importFrom tibble tibble +#' @importFrom stats stepfun +NULL + +#' Expected events observed under piecewise exponential model +#' +#' \code{eEvents_df} computes expected events over time and by strata +#' under the assumption of piecewise constant enrollment rates and piecewise +#' exponential failure and censoring rates. +#' The piecewise exponential distribution allows a simple method to specify a distribtuion +#' and enrollment pattern +#' where the enrollment, failure and dropout rates changes over time. +#' While the main purpose may be to generate a trial that can be analyzed at a single point in time or +#' using group sequential methods, the routine can also be used to simulate an adaptive trial design. +#' The intent is to enable sample size calculations under non-proportional hazards assumptions +#' for stratified populations. +#' +#' @param enrollRates Enrollment rates; see details and examples +#' @param failRates Failure rates and dropout rates by period +#' @param totalDuration Total follow-up from start of enrollment to data cutoff +#' @param simple If default (TRUE), return numeric expected number of events, otherwise +#' a \code{tibble} as described below. +#' @section Specification: +#' \if{latex}{ +#' \itemize{ +#' \item Validate if input enrollment rate contains total duration column. +#' \item Validate if input enrollment rate contains rate column. +#' \item Validate if input failure rate contains duration column. +#' \item Validate if input failure rate contains failure rate column. +#' \item Validate if input failure rate contains dropout rate column. +#' \item Validate if input trial total follow-up (total duration) is a non-empty vector of positive integers. +#' \item Validate if input simple is logical. +#' \item Define a tibble with the start opening for enrollment at zero and cumulative duration. +#' Add the event (or failure) time corresponding to the start of the enrollment. Finally, add the enrollment rate to the tibble +#' corresponding to the start and end (failure) time. This will be recursively used to calculate the expected +#' number of events later. For details, see vignette/eEventsTheory.Rmd +#' \item Define a tibble including the cumulative duration of failure rates, the corresponding start time of +#' the enrollment, failure rate and dropout rates. For details, see vignette/eEventsTheory.Rmd +#' \item Only consider the failure rates in the interval of the end failure rate and total duration. +#' \item Compute the failure rates over time using \code{stepfun} which is used +#' to group rows by periods defined by failRates. +#' \item Compute the dropout rate over time using \code{stepfun}. +#' \item Compute the enrollment rate over time using \code{stepfun}. Details are +#' available in vignette/eEventsTheory.Rmd. +#' \item Compute expected events by interval at risk using the notations and descriptions in +#' vignette/eEventsTheory.Rmd. +#' \item Return \code{eEvents_df} +#' } +#' } +#' @return +#' The default when \code{simple=TRUE} is to return the total expected number of events as a real number. +#' Otherwise, when \code{simple=FALSE} a \code{tibble} is returned with the following variables for each period specified in 'failRates': +#' \code{t} start of period, +#' \code{failRate} failure rate during the period +#' \code{Events} expected events during the period, +#' +#' The records in the returned \code{tibble} correspond to the input \code{tibble} \code{failRates}. +#' @details +#' More periods will generally be supplied in output than those that are input. +#' The intent is to enable expected event calculations in a tidy format to +#' maximize flexibility for a variety of purposes. +#' @examples +#' library(tibble) +#' library(gsDesign2) +#' +#' # Default arguments, simple output (total event count only) +#' gsDesign2:::eEvents_df_() +#' # Event count by time period +#' gsDesign2:::eEvents_df_(simple=FALSE) +#' # Early cutoff +#' gsDesign2:::eEvents_df_(totalDuration=.5) +#' # Single time period example +#' gsDesign2:::eEvents_df_(enrollRates=tibble(duration=10,rate=10), +#' failRates=tibble(duration=100,failRate=log(2)/6,dropoutRate=.01), +#' totalDuration=22, +#' simple=FALSE +#' ) +#' # Single time period example, multiple enrolment periods +#' gsDesign2:::eEvents_df_(enrollRates=tibble(duration=c(5,5), rate=c(10,20)), +#' failRates=tibble(duration=100,failRate=log(2)/6,dropoutRate=.01), +#' totalDuration=22, +#' simple=FALSE +#' ) +#' +#' @noRd +#' +eEvents_df_ <- function(enrollRates=tibble::tibble(duration=c(2,2,10), + rate=c(3,6,9)), + failRates=tibble::tibble(duration=c(3,100), + failRate=log(2)/c(9,18), + dropoutRate=rep(.001,2)), + totalDuration=25, + simple=TRUE +){ + # check input values + # check input enrollment rate assumptions + if(max(names(enrollRates)=="duration") != 1){stop("gsDesign2: enrollRates column names in `eEvents()` must contain duration")} + if(max(names(enrollRates)=="rate") != 1){stop("gsDesign2: enrollRates column names in `eEvents()` must contain rate")} + + # check input failure rate assumptions + if(max(names(failRates)=="duration") != 1){stop("gsDesign2: failRates column names in `eEvents()` must contain duration")} + if(max(names(failRates)=="failRate") != 1){stop("gsDesign2: failRates column names in `eEvents()` must contain failRate")} + if(max(names(failRates)=="dropoutRate") != 1){stop("gsDesign2: failRates column names in `eEvents()` must contain dropoutRate")} + + # check input trial durations + if(!is.numeric(totalDuration)){stop("gsDesign2: totalDuration in `eEvents()` must be a non-empty vector of positive numbers")} + if(!is.vector(totalDuration) > 0){stop("gsDesign2: totalDuration in `eEvents()` must be a non-empty vector of positive numbers")} + if(!min(totalDuration) > 0){stop("gsDesign2: totalDuration in `eEvents()` must be greater than zero")} + + # check input simple is logical + if(!is.logical(simple)){stop("gsDesign2: simple in `eEvents()` must be logical")} + + df_1 <- tibble::tibble(startEnroll = c(0,cumsum(enrollRates$duration)), + endFail = totalDuration - startEnroll, + rate = c(enrollRates$rate,0)) + df_1 <- df_1[df_1$endFail >0, ] + + df_2 <- tibble::tibble(endFail = cumsum(failRates$duration), + startEnroll = totalDuration - endFail, + failRate = failRates$failRate, + dropoutRate = failRates$dropoutRate) + df_2 <- if (last(cumsum(failRates$duration)) < totalDuration) df_2[-nrow(df_2),] else df_2[df_2$startEnroll >0,] # we will use start of failure rate periods repeatedly below + startFail <- c(0,cumsum(failRates$duration)) + # Step function to define failure rates over time + sf.failRate <- stepfun(startFail, + c(0,failRates$failRate,last(failRates$failRate)), + right = FALSE + ) + # Step function to define dropout rates over time + sf.dropoutRate <- stepfun(startFail, + c(0,failRates$dropoutRate, + last(failRates$dropoutRate)), + right = FALSE + ) + # sf.startFail is used later to group rows by periods defined by failRates + # # If only a single failure rate period, always 0 + # if(nrow(failRates)==1){x <- 0 + # y <- c(0,0)}else{ + # # if more than 1 failure rate period + # x <- startFail + # y <- c(0,startFail) + # } + sf.startFail <- stepfun(startFail, c(0,startFail), right = FALSE) + + # Step function to define enrollment rates over time + sf.enrollRate <- stepfun(c(0,cumsum(enrollRates$duration)), + c(0,enrollRates$rate,0), + right = FALSE + ) + # Put everything together as laid out in vignette + # "Computing expected events by interval at risk" + df_join <- full_join(df_1, df_2, by = c("startEnroll", "endFail")) %>% + arrange(endFail) %>% + mutate(endEnroll = lag(startEnroll, default = as.numeric(totalDuration)), + startFail = lag(endFail, default = 0), + duration = endEnroll - startEnroll, + failRate = sf.failRate(startFail), + dropoutRate = sf.dropoutRate(startFail), + enrollRate = sf.enrollRate(startEnroll), + q = exp(-duration*(failRate+dropoutRate)), + Q = lag(cumprod(q),default=1) + ) %>% + arrange(desc(startFail)) %>% + mutate(g = enrollRate * duration, + G = lag(cumsum(g),default = 0) + ) %>% + arrange(startFail) %>% + mutate(d = ifelse(failRate==0,0,Q*(1-q)*failRate/(failRate+dropoutRate)), + nbar = ifelse(failRate==0,0, + G*d + (failRate*Q*enrollRate)/(failRate+dropoutRate)*(duration-(1-q)/(failRate+dropoutRate))) + ) + if (simple) return(as.numeric(sum(df_join$nbar))) + df_join %>% transmute(t=endFail,failRate=failRate,Events=nbar, + startFail = sf.startFail(startFail) + ) %>% group_by(startFail) %>% + summarize(failRate=first(failRate),Events=sum(Events)) %>% + mutate(t=startFail) %>% select("t","failRate","Events") +} \ No newline at end of file diff --git a/R/fixed_design.R b/R/fixed_design.R new file mode 100644 index 000000000..5f8f5be65 --- /dev/null +++ b/R/fixed_design.R @@ -0,0 +1,394 @@ +#' Fixed design sample size +#' +#' Computes fixed design sample size for many sample size methods. +#' Returns a `tibble` with a basic summary +#' @param x Sample size method; default is \code{"AHR"}; +#' other options include \code{"FH"}, \code{"MB"}, \code{"LF"}, \code{"RD"}, \code{"MaxCombo"}, \code{"Milestone"}. +#' @param alpha One-sided Type I error (strictly between 0 and 1) +#' @param power Power (`NULL` to compute power or strictly between 0 and `1 - alpha` otherwise) +#' @param ratio Experimental:Control randomization ratio +#' @param studyDuration study duration +#' @param ... additional arguments like \code{enrollRates}, \code{failRates}, \code{rho}, \code{gamma}, \code{tau} +#' +#' @return a table +#' @export +#' +#' @examples +#' library(dplyr) +#' +#' # Average hazard ratio +#' x <- fixed_design("AHR", +#' alpha = .025, power = .9, +#' enrollRates = tibble::tibble(Stratum = "All", duration = 18, rate = 1), +#' failRates = tibble::tibble(Stratum = "All", duration = c(4, 100), failRate = log(2) / 12, hr = c(1, .6), dropoutRate = .001), +#' studyDuration = 36) +#' x %>% summary() +#' +#' # Lachin and Foulkes (uses gsDesign::nSurv()) +#' x <- fixed_design("LF", +#' alpha = .025, power = .9, +#' enrollRates = tibble::tibble(Stratum = "All", duration = 18, rate = 1), +#' failRates = tibble::tibble(Stratum = "All", duration = 100, failRate = log(2) / 12, hr = .7, dropoutRate = .001), +#' studyDuration = 36) +#' x %>% summary() +#' +#' # RMST +#' x <- fixed_design("RMST", alpha = .025, power = .9, +#' enrollRates = tibble::tibble(Stratum = "All", duration = 18, rate = 1), +#' failRates = tibble::tibble(Stratum = "All", duration = 100, failRate = log(2) / 12, hr = .7, dropoutRate = .001), +#' studyDuration = 36, +#' tau = 18) +#' x %>% summary() +#' +#' # Milestone +#' x <- fixed_design("Milestone", alpha = .025, power = .9, +#' enrollRates = tibble::tibble(Stratum = "All", duration = 18, rate = 1), +#' failRates = tibble::tibble(Stratum = "All", duration = 100, failRate = log(2) / 12, hr = .7, dropoutRate = .001), +#' studyDuration = 36, +#' tau = 18) +#' x %>% summary() +#' +fixed_design <- function(x = c("AHR", "FH", "MB", "LF", "RD", "MaxCombo", "RMST", "Milestone"), + alpha = 0.025, power = NULL, ratio = 1, studyDuration = 36, ...){ + # --------------------------------------------- # + # check inputs # + # --------------------------------------------- # + x <- match.arg(x) + args <- list(...) + + has_weight <- "weight" %in% names(args) + has_rho <- "rho" %in% names(args) + has_gamma <- "gamma" %in% names(args) + has_tau <- "tau" %in% names(args) + has_enrollRates <- "enrollRates" %in% names(args) + has_failRates <- "failRates" %in% names(args) + has_N <- "N" %in% names(args) + + # ------------------------- # + # check inputs # + # ------------------------- # + + # check enrollment rate (not expected for RD) + if(!has_enrollRates && x != "RD"){ + stop("fixed_design: please input enrollRates!") + }else{ + enrollRates <- args$enrollRates + } + + # check failure rate (not expected for RD) + if(!has_failRates && x != "RD"){ + stop("fixed_design: please input failRates!") + }else{ + failRates <- args$failRates + } + + # check test parameters, like rho, gamma, tau + if(has_rho & length(args$rho) > 1 & x %in% c("FH", "MB")){ + stop("fixed_design: multiple rho can not be used in Fleming-Harrington or Magirr-Burman method!") + } + if(has_gamma & length(args$gamma) > 1 & x %in% c("FH", "MB")){ + stop("fixed_design: multiple gamma can not be used in Fleming-Harrington or Magirr-Burman method!") + } + if(has_tau & length(args$tau) > 1 & x %in% c("FH", "MB")){ + stop("fixed_design: multiple tau can not be used in Fleming-Harrington or Magirr-Burman method!") + } + if(has_tau & x == "FH"){ + stop("fixed_design: tau is not needed for Fleming-Harrington (FH) method!") + } + if(has_rho & has_gamma & x == "MB"){ + stop("fixed_design: rho and gamma are not needed for Magirr-Burman (MB) method!") + } + + # check inputs necessary for RD + if(x == "RD"){ + if(!"p_c" %in% names(args)){stop("fixed_design: p_c is needed for RD!")} + if(!"p_e" %in% names(args)){stop("fixed_design: p_e is needed for RD!")} + if(!"rd0" %in% names(args)){stop("fixed_design: rd0 is needed for RD!")} + if(is.null(power) && !has_N){stop("fixed_design: sample size N = ... is needed for RD!")} + } + + # ------------------------- # + # generate design # + # ------------------------- # + y <- switch(x, + "AHR" = { + if (!is.null(power)){ + d <- gs_design_ahr(alpha = alpha, beta = 1 - power, + upar = qnorm(1 - alpha), lpar = -Inf, + enrollRates = enrollRates, + failRates = failRates, + ratio = ratio, + analysisTimes = studyDuration) + }else{ + d <- gs_power_ahr(upar = qnorm(1 - alpha), lpar = -Inf, + enrollRates = enrollRates, + failRates = failRates, + ratio = ratio, + analysisTimes = studyDuration, + events = NULL) + } + ans <- tibble::tibble(Design = "AHR", + N = d$analysis$N, + Events = d$analysis$Events, + Time = d$analysis$Time, + Bound = (d$bounds %>% filter(Bound == "Upper"))$Z, + alpha = alpha, + Power = (d$bounds %>% filter(Bound == "Upper"))$Probability) + + list(enrollRates = d$enrollRates, failRates = d$failRates, analysis = ans, design = "AHR") + }, + + "FH" = { + + if(has_weight + has_rho + has_gamma == 0){ + weight <- function(x, arm0, arm1){wlr_weight_fh(x, arm0, arm1, rho = 0, gamma = 0.5)} + } + if(has_weight == 0 & has_rho + has_gamma >= 1){ + weight <- function(x, arm0, arm1){wlr_weight_fh(x, arm0, arm1, + rho = ifelse(has_rho, args$rho, 0), + gamma = ifelse(has_gamma, args$gamma, 0.5))} + } + if (!is.null(power)){ + d <- gs_design_wlr(alpha = alpha, beta = 1 - power, + upar = qnorm(1 - alpha), lpar = -Inf, + enrollRates = enrollRates, + failRates = failRates, + ratio = ratio, + weight = weight, + analysisTimes = studyDuration) + }else{ + d <- gs_power_wlr(upar = qnorm(1 - alpha), lpar = -Inf, + enrollRates = enrollRates, + failRates = failRates, + ratio = ratio, + weight = weight, + analysisTimes = studyDuration, + events = NULL) + } + ans <- tibble::tibble(Design = "FH", + N = d$analysis$N, + Events = d$analysis$Events, + Time = d$analysis$Time, + Bound = (d$bounds %>% filter(Bound == "Upper"))$Z, + alpha = alpha, + Power = (d$bounds %>% filter(Bound == "Upper"))$Probability) + + list(enrollRates = d$enrollRates, failRates = d$failRates, analysis = ans, + design = "FH", design_par = list(rho = if(has_rho){args$rho}else{0}, + gamma = if(has_gamma){args$gamma}else{0.5}) + ) + }, + + + "MB" = { + # check if power is NULL or not + if(!is.null(power)){ + d <- gs_design_wlr(alpha = alpha, + beta = 1 - power, + enrollRates = enrollRates, + failRates = failRates, + ratio = 1, + weight = function(x, arm0, arm1){wlr_weight_fh(x, arm0, arm1, rho = -1, gamma = 0, + tau = ifelse(has_tau, args$tau, 6))}, + upper = gs_b, + upar = qnorm(1 - alpha), + lower = gs_b, + lpar = -Inf, + analysisTimes = studyDuration) + }else{ + d <- gs_power_wlr(enrollRates = enrollRates, + failRates = failRates, + ratio = 1, + weight = function(x, arm0, arm1){wlr_weight_fh(x, arm0, arm1, rho = -1, gamma = 0, + tau = ifelse(has_tau, args$tau, 6))}, + upper = gs_b, + upar = qnorm(1 - alpha), + lower = gs_b, + lpar = -Inf, + analysisTimes = studyDuration, + events = NULL) + } + + # get the output of MB + ans <- tibble::tibble(Design = "MB", + N = d$analysis$N, + Events = d$analysis$Events, + Time = d$analysis$Time, + Bound = (d$bounds %>% filter(Bound == "Upper"))$Z, + alpha = alpha, + Power = (d$bounds %>% filter(Bound == "Upper"))$Probability) + + list(enrollRates = d$enrollRates, failRates = d$failRates, analysis = ans, + design = "MB", design_par = list(tau = ifelse(has_tau, args$tau, 6))) + + + }, + + + "LF" = { + # check if it is stratum + if(length(unique(enrollRates$Stratum)) != 1 | length(unique(failRates$Stratum)) != 1){ + warning("Lachin-Foulkes is not recommended for stratified designs!") + } + + # calculate the S: duration of piecewise constant event rates + m <- length(failRates$failRate) + if (m == 1){S <- NULL}else{S <- failRates$duration[1:(m-1)]} + + # calculate the ahr as the hr in nSurv + dd <- gsDesign2::AHR(enrollRates = enrollRates, failRates = failRates, totalDuration = studyDuration, ratio = ratio) + + # use nSuve to develop the design + d <- gsDesign::nSurv(alpha = alpha, beta = if(is.null(power)){NULL}else{1 - power}, + ratio = ratio, hr = dd$AHR, + # failRates + lambdaC = failRates$failRate, + S = S, eta = failRates$dropoutRate, + # enrollRates + gamma = enrollRates$rate, R = enrollRates$duration, + T = studyDuration, minfup = studyDuration - sum(enrollRates$duration)) + + ans <- tibble::tibble(Design = "LF", + N = d$n, + Events = d$d, + Time = d$T, + Bound = qnorm(1 - alpha), + alpha = d$alpha, + Power = d$power) + + list(enrollRates = enrollRates %>% mutate(rate = rate * d$n/sum(enrollRates$duration * enrollRates$rate)), + failRates = failRates, + analysis = ans, + design = "LF") + }, + + + "MaxCombo" = { + # organize the tests in max combo + max_combo_test <- data.frame(rho = if(has_rho){args$rho}else{c(0, 0)}, + gamma = if(has_gamma){args$gamma}else{c(0, 0.5)}, + tau = if(has_tau){args$tau}else{-1}) %>% + mutate(test = seq(1, length(rho)), Analysis = 1, analysisTimes = studyDuration) + + # check if power is NULL or not + if(!is.null(power)){ + d <- gs_design_combo(alpha = alpha, beta = 1 - power, ratio = ratio, + enrollRates = enrollRates, + failRates = failRates, + fh_test = max_combo_test, + upper = gs_b, upar = qnorm(1 - alpha), + lower = gs_b, lpar = -Inf) + }else{ + d <- gs_power_combo(ratio = ratio, + enrollRates = enrollRates, + failRates = failRates, + fh_test = max_combo_test, + upper = gs_b, upar = qnorm(1 - alpha), + lower = gs_b, lpar = -Inf) + } + + # get the output of max combo + ans <- tibble::tibble(Design = "MaxCombo", + N = d$analysis$N, + Events = d$analysis$Events, + Time = d$analysis$Time, + Bound = (d$bounds %>% filter(Bound == "Upper"))$Z, + alpha = alpha, + Power = (d$bounds %>% filter(Bound == "Upper"))$Probability) + + list(enrollRates = d$enrollRates, failRates = d$failRates, analysis = ans, + design = "MaxCombo", design_par = list(rho = if(has_rho){args$rho}else{c(0, 0)}, + gamma = if(has_gamma){args$gamma}else{c(0, 0.5)}, + tau = if(has_tau){args$tau}else{c(-1, -1)})) + }, + + "RD" = { + if(!is.null(power)){ + d <- gs_design_rd(p_c = tibble::tibble(Stratum = "All", Rate = args$p_c), + p_e = tibble::tibble(Stratum = "All", Rate = args$p_e), + alpha = alpha, beta = 1 - power, ratio = ratio, + upper = gs_b, upar = qnorm(1 - alpha), + lower = gs_b, lpar = -Inf, + rd0 = args$rd0, weight = "un-stratified") + }else{ + d <- gs_power_rd(p_c = tibble::tibble(Stratum = "All", Rate = args$p_c), + p_e = tibble::tibble(Stratum = "All", Rate = args$p_e), + ratio = ratio, + upper = gs_b, upar = qnorm(1 - alpha), + lower = gs_b, lpar = -Inf, + N = tibble::tibble(Stratum = "All", N = args$N, Analysis = 1), + rd0 = args$rd0, weight = "un-stratified") + } + + # get the output of max combo + ans <- tibble::tibble(Design = "RD", + N = d$analysis$N, + Bound = (d$bounds %>% filter(Bound == "Upper"))$Z, + alpha = alpha, + Power = (d$bounds %>% filter(Bound == "Upper"))$Probability) + + list(enrollRates = d$enrollRates, failRates = d$failRates, analysis = ans, design = "RD") + }, + + + "RMST" = { + if(!is.null(power)){ + d <- fixed_design_size_rmst(alpha = alpha, beta = 1 - power, ratio = ratio, + enrollRates = enrollRates, failRates = failRates, + analysisTimes = studyDuration, + test = "rmst difference", + tau = ifelse(has_tau, args$tau, studyDuration)) + }else{ + d <- fixed_design_power_rmst(alpha = alpha, ratio = ratio, + enrollRates = enrollRates, failRates = failRates, + analysisTimes = studyDuration, + test = "rmst difference", + tau = ifelse(has_tau, args$tau, studyDuration)) + } + + # get the output + ans <- tibble::tibble(Design = "RMST", + N = d$analysis$N, + Events = d$analysis$Events, + Time = d$analysis$Time, + Bound = (d$bounds %>% filter(Bound == "Upper"))$Z, + alpha = alpha, + Power = (d$bounds %>% filter(Bound == "Upper"))$Probability) + + list(enrollRates = d$enrollRates, failRates = d$failRates, analysis = ans, + design = "RMST", design_par = list(tau = ifelse(has_tau, args$tau, studyDuration))) + }, + + "Milestone" = { + if(!is.null(power)){ + d <- fixed_design_size_rmst(alpha = alpha, beta = 1 - power, ratio = ratio, + enrollRates = enrollRates, failRates = failRates, + analysisTimes = studyDuration, + test = "survival difference", + tau = ifelse(has_tau, args$tau, studyDuration)) + }else{ + d <- fixed_design_power_rmst(alpha = alpha, ratio = ratio, + enrollRates = enrollRates, failRates = failRates, + analysisTimes = studyDuration, + test = "survival difference", + tau = ifelse(has_tau, args$tau, studyDuration)) + } + + # get the output of max combo + ans <- tibble::tibble(Design = "Milestone", + N = d$analysis$N, + Events = d$analysis$Events, + Time = d$analysis$Time, + Bound = (d$bounds %>% filter(Bound == "Upper"))$Z, + alpha = alpha, + Power = (d$bounds %>% filter(Bound == "Upper"))$Probability) + + list(enrollRates = d$enrollRates, failRates = d$failRates, analysis = ans, + design = "Milestone", design_par = list(tau = ifelse(has_tau, args$tau, studyDuration))) + } + ) + + class(y) <- c("fixed_design", class(y)) + return(y) +} + diff --git a/R/global.R b/R/global.R deleted file mode 100644 index dc9350959..000000000 --- a/R/global.R +++ /dev/null @@ -1,57 +0,0 @@ -# Copyright (c) 2022 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. All rights reserved. -# -# This file is part of the gsDesign2 program. -# -# gsDesign2 is free software: you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation, either version 3 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program. If not, see . - -# These global variables are declared to eliminate associated `R CMD check` warnings. - -# There is no other identified functional impact of these global declarations. - -utils::globalVariables( - c( - 'Events', - 'G', - 'H', - 'Q', - 'Stratum', - 'Survival', - 'Time', - 'Times', - 'AHR', - 'controlEvents', - 'controlRate', - 'd', - 'dropoutRate', - 'duration', - 'endEnroll', - 'endFail', - 'enrollRate', - 'experimentalEvents', - 'experimentalRate', - 'failRate', - 'first', - 'g', - 'h', - 'hr', - 'lnhr', - 'nbar', - 'rate', - 'startEnroll', - 'Treatment', - 'HR', - 'info0', - 'info' - ) -) diff --git a/R/gridpts_h1_hupdate_oldR.R b/R/gridpts_h1_hupdate_oldR.R new file mode 100644 index 000000000..19bc4052a --- /dev/null +++ b/R/gridpts_h1_hupdate_oldR.R @@ -0,0 +1,201 @@ +# Copyright (c) 2021 Merck Sharp & Dohme Corp. a subsidiary of Merck & Co., Inc., Kenilworth, NJ, USA. +# +# This file is part of the gsdmvn program. +# +# gsdmvn is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +#' @importFrom tibble tibble +NULL +#' Grid points for group sequential design numerical integration +#' +#' Points and weights for Simpson's rule numerical integration from +#' p 349 - 350 of Jennison and Turnbull book. +#' This is not used for arbitrary integration, but for the canonical form of Jennison and Turnbull. +#' mu is computed elsewhere as drift parameter times sqrt of information. +#' Since this is a lower-level routine, no checking of input is done; calling routines should +#' ensure that input is correct. +#' Lower limit of integration can be \code{-Inf} and upper limit of integration can be \code{Inf} +#' +#' @details +#' Jennison and Turnbull (p 350) claim accuracy of \code{10E-6} with \code{r=16}. +#' The numerical integration grid spreads out at the tail to enable accurate tail probability calcuations. +#' +#' +#' @param r Integer, at least 2; default of 18 recommended by Jennison and Turnbull +#' @param mu Mean of normal distribution (scalar) under consideration +#' @param a lower limit of integration (scalar) +#' @param b upper limit of integration (scalar \code{> a}) +#' @section Specification: +#' \if{latex}{ +#' \itemize{ +#' \item Define odd numbered grid points for real line. +#' \item Trim points outside of [a, b] and include those points. +#' \item If extreme, include only 1 point where density will be essentially 0. +#' \item Define even numbered grid points between the odd ones. +#' \item Compute weights for odd numbered grid points. +#' \item Combine odd- and even-numbered grid points with their corresponding weights. +#' \item Return a tibble of with grid points in z and numerical integration weights in z. +#' } +#' } +#' \if{html}{The contents of this section are shown in PDF user manual only.} +#' +#' @return A \code{tibble} with grid points in \code{z} and numerical integration weights in \code{w} +#' @noRd +#' +#' @examples +#' library(dplyr) +#' +#' # approximate variance of standard normal (i.e., 1) +#' gsDesign2:::gridpts_() %>% summarise(var = sum(z^2 * w * dnorm(z))) +#' +#' # approximate probability above .95 quantile (i.e., .05) +#' gsDesign2:::gridpts_(a = qnorm(.95), b = Inf) %>% summarise(p05 = sum(w * dnorm(z))) +gridpts_ <- function(r = 18, mu = 0, a = -Inf, b = Inf){ + # Define odd numbered grid points for real line + x <- c(mu - 3 - 4 * log(r / (1:(r - 1))), + mu - 3 + 3 * (0:(4 * r)) / 2 / r, + mu + 3 + 4 * log(r / (r - 1):1) + ) + # Trim points outside of [a, b] and include those points + if (min(x) < a) x <- c(a, x[x > a]) + if (max(x) > b) x <- c(x[x < b], b) + # If extreme, include only 1 point where density will be essentially 0 + m <- length(x) + if (m == 1) return(tibble::tibble(z=x, w=1)) + + # Define even numbered grid points between the odd ones + y <- (x[2:m] + x[1:(m-1)]) / 2 + + # Compute weights for odd numbered grid points + i <- 2:(m-1) + wodd <- c(x[2] - x[1], + (x[i + 1] - x[i - 1]), + x[m] - x[m - 1]) / 6 + + weven <- 4 * (x[2:m] - x[1:(m-1)]) / 6 + + # Now combine odd- and even-numbered grid points with their + # corresponding weights + z <- rep(0, 2*m - 1) + z[2 * (1:m) - 1] <- x + z[2 * (1:(m-1))] <- y + w <- z + w[2 * (1:m) - 1] <- wodd + w[2 * (1:(m-1))] <- weven + + return(tibble::tibble(z=z, w=w)) +} + + +#' @importFrom stats dnorm pnorm +#' @importFrom tibble tibble +NULL +#' Initialize numerical integration for group sequential design +#' +#' Compute grid points for first interim analysis in a group sequential design +#' +#' @param r Integer, at least 2; default of 18 recommended by Jennison and Turnbull +#' @param theta Drift parameter for first analysis +#' @param I Information at first analysis +#' @param a lower limit of integration (scalar) +#' @param b upper limit of integration (scalar \code{> a}) +#' +#' @details Mean for standard normal distribution under consideration is \code{mu = theta * sqrt(I)} +#' @section Specification: +#' \if{latex}{ +#' \itemize{ +#' \item Compute drift at analysis 1. +#' \item Compute deviation from drift. +#' \item Compute standard normal density, multiply by grid weight. +#' \item Return a tibble of z, w, and h. +#' } +#' } +#' \if{html}{The contents of this section are shown in PDF user manual only.} +#' +#' @return A \code{tibble} with grid points in \code{z}, numerical integration weights in \code{w}, +#' and a normal density with mean \code{mu = theta * sqrt{I}} and variance 1 times the weight in \code{w}. +#' @noRd +#' +#' @examples +#' library(dplyr) +#' # Replicate variance of 1, mean of 35 +#' gsDesign2:::h1_(theta = 5, I = 49) %>% summarise(mu = sum(z * h), var = sum((z - mu)^2 * h)) +#' +#' # Replicate p-value of .0001 by numerical integration of tail +#' gsDesign2:::h1_(a = qnorm(.9999)) %>% summarise(p = sum(h)) +h1_ <- function(r = 18, theta = 0, I = 1, a = -Inf, b = Inf){ + # fix for binding message + z <- w <- h <- NULL + # compute drift at analysis 1 + mu <- theta * sqrt(I); + g <- gridpts(r, mu, a, b) + # compute deviation from drift + x <- g$z - mu + # compute standard normal density, multiply by grid weight and return + # values needed for numerical integration + return(tibble::tibble(z = g$z, w = g$w, h = g$w * dnorm(x))) +} + + +#' @importFrom stats dnorm +#' @importFrom tibble tibble +NULL +#' Update numerical integration for group sequential design +#' +#' Update grid points for numerical integration from one analysis to the next +#' +#' @param r Integer, at least 2; default of 18 recommended by Jennison and Turnbull +#' @param theta Drift parameter for current analysis +#' @param I Information at current analysis +#' @param a lower limit of integration (scalar) +#' @param b upper limit of integration (scalar \code{> a}) +#' @param thetam1 Drift parameter for previous analysis +#' @param Im1 Information at previous analysis +#' @param gm1 numerical integration grid from \code{h1()} or previous run of \code{hupdate()} +#' @section Specification: +#' \if{latex}{ +#' \itemize{ +#' \item Compute the square root of the change in information. +#' \item Compute the grid points for group sequential design numerical integration. +#' \item Update the integration. +#' \item Return a tibble of z, w, and h. +#' } +#' } +#' \if{html}{The contents of this section are shown in PDF user manual only.} +#' +#' @return A \code{tibble} with grid points in \code{z}, numerical integration weights in \code{w}, +#' and a normal density with mean \code{mu = theta * sqrt{I}} and variance 1 times the weight in \code{w}. +#' +#' @examples +#' library(dplyr) +#' # 2nd analysis with no interim bound and drift 0 should have mean 0, variance 1 +#' gsDesign2:::hupdate_() %>% summarise(mu = sum(z * h), var = sum((z - mu)^2 * h)) +#' +#' @noRd +hupdate_ <- function(r = 18, theta = 0, I = 2, a = -Inf, b = Inf, thetam1 = 0, Im1 = 1, gm1 = h1()){ + # sqrt of change in information + rtdelta <- sqrt(I - Im1) + rtI <- sqrt(I) + rtIm1 <- sqrt(Im1) + g <- gridpts(r = r, mu = theta * rtI, a= a, b = b) + # update integration + mu <- theta * I - thetam1 * Im1 + h <- rep(0, length(g$z)) + for(i in seq_along(g$z)){ + x <- (g$z[i] * rtI - gm1$z * rtIm1 - mu ) / rtdelta + h[i] <- sum(gm1$h * dnorm(x)) + } + h <- h * g$w * rtI / rtdelta + return(tibble::tibble(z = g$z, w = g$w, h = h)) +} \ No newline at end of file diff --git a/R/gridpts_h1_hupdate_rcpp_interface.R b/R/gridpts_h1_hupdate_rcpp_interface.R new file mode 100644 index 000000000..9689ddc9c --- /dev/null +++ b/R/gridpts_h1_hupdate_rcpp_interface.R @@ -0,0 +1,145 @@ +# Copyright (c) 2021 Merck Sharp & Dohme Corp. a subsidiary of Merck & Co., Inc., Kenilworth, NJ, USA. +# +# This file is part of the gsDesign2 program. +# +# gsDesign2 is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +#' @import Rcpp +NULL + +#' Grid points for group sequential design numerical integration +#' +#' Points and weights for Simpson's rule numerical integration from +#' p 349 - 350 of Jennison and Turnbull book. +#' This is not used for arbitrary integration, but for the canonical form of Jennison and Turnbull. +#' mu is computed elsewhere as drift parameter times sqrt of information. +#' Since this is a lower-level routine, no checking of input is done; calling routines should +#' ensure that input is correct. +#' Lower limit of integration can be \code{-Inf} and upper limit of integration can be \code{Inf} +#' +#' @details +#' Jennison and Turnbull (p 350) claim accuracy of \code{10E-6} with \code{r=16}. +#' The numerical integration grid spreads out at the tail to enable accurate tail probability calcuations. +#' +#' +#' @param r Integer, at least 2; default of 18 recommended by Jennison and Turnbull +#' @param mu Mean of normal distribution (scalar) under consideration +#' @param a lower limit of integration (scalar) +#' @param b upper limit of integration (scalar \code{> a}) +#' @section Specification: +#' \if{latex}{ +#' \itemize{ +#' \item Define odd numbered grid points for real line. +#' \item Trim points outside of [a, b] and include those points. +#' \item If extreme, include only 1 point where density will be essentially 0. +#' \item Define even numbered grid points between the odd ones. +#' \item Compute weights for odd numbered grid points. +#' \item Combine odd- and even-numbered grid points with their corresponding weights. +#' \item Return a tibble of with grid points in z and numerical integration weights in z. +#' } +#' } +#' \if{html}{The contents of this section are shown in PDF user manual only.} +#' +#' @return A \code{list} with grid points in \code{z} and numerical integration weights in \code{w} +#' +#' @examples +#' +#' # approximate variance of standard normal (i.e., 1) +#' g <- gridpts() +#' sum((g$z)^2 * g$w * dnorm(g$z)) +#' +#' # approximate probability above .95 quantile (i.e., .05) +#' g <- gridpts(a = qnorm(.95), b = Inf) +#' sum(g$w * dnorm(g$z)) +#' @noRd +gridpts <- function(r = 18, mu = 0, a = -Inf, b = Inf) { + .gridptsRcpp(r = r, mu = mu, a = a, b = b) +} + +#' Initialize numerical integration for group sequential design +#' +#' Compute grid points for first interim analysis in a group sequential design +#' +#' @param r Integer, at least 2; default of 18 recommended by Jennison and Turnbull +#' @param theta Drift parameter for first analysis +#' @param I Information at first analysis +#' @param a lower limit of integration (scalar) +#' @param b upper limit of integration (scalar \code{> a}) +#' +#' @details Mean for standard normal distribution under consideration is \code{mu = theta * sqrt(I)} +#' @section Specification: +#' \if{latex}{ +#' \itemize{ +#' \item Compute drift at analysis 1. +#' \item Compute deviation from drift. +#' \item Compute standard normal density, multiply by grid weight. +#' \item Return a tibble of z, w, and h. +#' } +#' } +#' \if{html}{The contents of this section are shown in PDF user manual only.} +#' +#' @return A \code{list} with grid points in \code{z}, numerical integration weights in \code{w}, +#' and a normal density with mean \code{mu = theta * sqrt{I}} and variance 1 times the weight in \code{w}. +#' +#' @examples +#' +#' # Replicate variance of 1, mean of 35 +#' g <- h1(theta = 5, I = 49) +#' mu <- sum(g$z * g$h) +#' var <- sum((g$z - mu)^2 * g$h) +#' +#' # Replicate p-value of .0001 by numerical integration of tail +#' g <- h1(a = qnorm(.9999)) +#' sum(g$h) +#' @noRd +h1 <- function(r = 18, theta = 0, I = 1, a = -Inf, b = Inf){ + .h1Rcpp(r = r, theta = theta, I = I, a = a, b = b) +} + +#' Update numerical integration for group sequential design +#' +#' Update grid points for numerical integration from one analysis to the next +#' +#' @param r Integer, at least 2; default of 18 recommended by Jennison and Turnbull +#' @param theta Drift parameter for current analysis +#' @param I Information at current analysis +#' @param a lower limit of integration (scalar) +#' @param b upper limit of integration (scalar \code{> a}) +#' @param thetam1 Drift parameter for previous analysis +#' @param Im1 Information at previous analysis +#' @param gm1 numerical integration grid from \code{h1()} or previous run of \code{hupdate()} +#' @section Specification: +#' \if{latex}{ +#' \itemize{ +#' \item Compute the square root of the change in information. +#' \item Compute the grid points for group sequential design numerical integration. +#' \item Update the integration. +#' \item Return a tibble of z, w, and h. +#' } +#' } +#' \if{html}{The contents of this section are shown in PDF user manual only.} +#' +#' @return A \code{list} with grid points in \code{z}, numerical integration weights in \code{w}, +#' and a normal density with mean \code{mu = theta * sqrt{I}} and variance 1 times the weight in \code{w}. +#' +#' @examples +#' +#' # 2nd analysis with no interim bound and drift 0 should have mean 0, variance 1 +#' g <- hupdate() +#' mu <- sum(g$z * g$h) +#' var <- sum((g$z - mu)^2 * g$h) +#' @noRd +hupdate <- function(r = 18, theta = 0, I = 2, a = -Inf, b = Inf, thetam1 = 0, Im1 = 1, gm1 = h1()){ + .hupdateRcpp(r = r, theta = theta, I = I, a = a, b = b, thetam1 = thetam1, Im1 = Im1, gm1 = gm1) +} diff --git a/R/gsDesign2-package.R b/R/gsDesign2.R similarity index 81% rename from R/gsDesign2-package.R rename to R/gsDesign2.R index 7ee44b51b..bdb1fa9d6 100644 --- a/R/gsDesign2-package.R +++ b/R/gsDesign2.R @@ -1,4 +1,4 @@ -# Copyright (c) 2022 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. All rights reserved. +# Copyright (c) 2021 Merck Sharp & Dohme Corp. a subsidiary of Merck & Co., Inc., Kenilworth, NJ, USA. # # This file is part of the gsDesign2 program. # @@ -16,4 +16,5 @@ # along with this program. If not, see . #' @keywords internal -"_PACKAGE" +#' @useDynLib gsDesign2, .registration = TRUE +"_PACKAGE" \ No newline at end of file diff --git a/R/gs_b.R b/R/gs_b.R new file mode 100644 index 000000000..63c319f7e --- /dev/null +++ b/R/gs_b.R @@ -0,0 +1,72 @@ +# Copyright (c) 2021 Merck Sharp & Dohme Corp. a subsidiary of Merck & Co., Inc., Kenilworth, NJ, USA. +# +# This file is part of the gsdmvn program. +# +# gsdmvn is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +#' gs_b: Default boundary generation +#' +#' \code{gs_b()} is the simplest version of a function to be used with the \code{upper} and \code{lower} +#' arguments in \code{gs_prob()}, +#' \code{gs_power_nph} and \code{gs_design_nph()}; +#' it simply returns the vector input in the input vector \code{Z} or, if \code{k} is specified \code{par[k]j} is returned. +#' Note that if bounds need to change with changing information at analyses, \code{gs_b()} should not be used. +#' For instance, for spending function bounds use +#' +#' @param par For \code{gs_b()}, this is just Z-values for the boundaries; can include infinite values +#' @param k is NULL (default), return \code{par}, else return \code{par[k]} +#' @param ... further arguments passed to or from other methods +#' +#' @section Specification: +#' \if{latex}{ +#' \itemize{ +#' \item Validate if the input k is null as default. +#' \itemize{ +#' \item If the input k is null as default, return the whole vector of Z-values of the boundaries. +#' \item If the input k is not null, return the corresponding boundary in the vector of Z-values. +#' } +#' \item Return a vector of boundaries. +#' } +#' } +#' \if{html}{The contents of this section are shown in PDF user manual only.} +#' +#' @return returns the vector input \code{par} if \code{k} is NULL, otherwise, \code{par[k]} +#' @export +#' +#' @examples +#' +#' # Simple: enter a vector of length 3 for bound +#' gs_b(par = 4:2) +#' +#' # 2nd element of par +#' gs_b(par = 4:2, k = 2) +#' +#' # Generate an efficacy bound using a spending function +#' # Use Lan-DeMets spending approximation of O'Brien-Fleming bound +#' # as 50%, 75% and 100% of final spending +#' # Information fraction +#' IF <- c(.5, .75, 1) +#' gs_b(par = gsDesign::gsDesign(alpha = .025, k = length(IF), +#' test.type = 1, sfu = gsDesign::sfLDOF, +#' timing = IF)$upper$bound) +#' +gs_b <- function(par = NULL, k = NULL, ...){ + + if(is.null(k)){ + return(par) + }else{ + return(par[k]) + } + +} \ No newline at end of file diff --git a/R/gs_bound.R b/R/gs_bound.R new file mode 100644 index 000000000..fffd8ddf7 --- /dev/null +++ b/R/gs_bound.R @@ -0,0 +1,138 @@ +# Copyright (c) 2021 Merck Sharp & Dohme Corp. a subsidiary of Merck & Co., Inc., Kenilworth, NJ, USA. +# +# This file is part of the gsdmvn program. +# +# gsdmvn is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +#' Lower and Upper Bound of Group Sequential Design +#' +#' @importFrom mvtnorm GenzBretz +#' +#' @param alpha a numeric vector of cumulative allocated alpha in each interim analysis +#' @param beta a numeric vector of cumulative allocated beta in each interim analysis +#' @param theta a numeric vector of effect size under alternative. +#' @param corr a matrix of correlation matrix +#' @param analysis a numeric vector of interim analysis indicator. Default is 1:length(alpha). +#' @param theta0 a numeric vector of effect size under null hypothesis. Default is 0. +#' @param binding_lower_bound a logical value to indicate binding lower bound. +#' @param alpha_bound logical value to indicate if alpha is Type I error or upper bound. Default is FALSE. +#' @param beta_bound logical value to indicate if beta is Type II error or lower bound. Default is FALSE. +#' @inheritParams pmvnorm_combo +#' +#' @section Specification: +#' \if{latex}{ +#' \itemize{ +#' \item Create a vector of allocated alpha in each interim analysis from the cumulative allocated alpha. +#' \item Create a vector of allocated beta in each interim analysis from the cumulative allocated beta. +#' \item Extract the number of analysis. +#' \item Find the upper and lower bound by solving multivariate normal distribution using \code{pmvnorm_combo} +#' \item +#' \item Return a data frame of upper and lower boundaries of group sequential design. +#' } +#' } +#' \if{html}{The contents of this section are shown in PDF user manual only.} +#' +#' @examples +#' library(gsDesign) +#' +#' x <- gsDesign::gsSurv( k = 3 , test.type = 4 , alpha = 0.025 , +#' beta = 0.2 , astar = 0 , timing = c( 1 ) , +#' sfu = sfLDOF , sfupar = c( 0 ) , sfl = sfLDOF , +#' sflpar = c( 0 ) , lambdaC = c( 0.1 ) , +#' hr = 0.6 , hr0 = 1 , eta = 0.01 , +#' gamma = c( 10 ) , +#' R = c( 12 ) , S = NULL , +#' T = 36 , minfup = 24 , ratio = 1 ) +#' +#' cbind(x$lower$bound, x$upper$bound) +#' +#' gsdmvn:::gs_bound(alpha = sfLDOF(0.025, 1:3/3)$spend, +#' beta = sfLDOF(0.2, 1:3/3)$spend, +#' analysis = 1:3, +#' theta = x$theta[2] * sqrt(x$n.I), +#' corr = outer(1:3, 1:3, function(x,y) pmin(x,y) / pmax(x,y))) +#' +#' @noRd +#' +gs_bound <- function(alpha, + beta, + theta, + corr, + analysis = 1:length(alpha), + theta0 = rep(0, length(analysis)), + binding_lower_bound = FALSE, + algorithm = GenzBretz(maxpts= 1e5, abseps= 1e-5), + alpha_bound = FALSE, + beta_bound = FALSE, + ...){ + + + alpha <- c(alpha[1], diff(alpha)) + beta <- c(beta[1], diff(beta)) + + lower <- NULL + upper <- NULL + .lower <- -Inf + + n_analysis <- length(unique(analysis)) + + for(k in 1:n_analysis){ + k_ind <- analysis <= k + + bound_fun <- function(.lower, .upper, .prob, .theta, binding_lower_bound = FALSE){ + + if(binding_lower_bound){ + lower_bound <- c(lower, .lower) + }else{ + lower_bound <- c(rep(-Inf, k-1), .lower) + } + upper_bound <- c(upper, .upper) + + p <- pmvnorm_combo(lower_bound, + upper_bound, + group = analysis[k_ind], + mean = .theta[k_ind], + corr = corr[k_ind, k_ind], ...) + + p - .prob + } + + + # change .lower for different type of test (gsDesign test.type) + if(beta_bound){ + .lower <- sum(beta[1:k]) + }else{ + .lower <- uniroot(bound_fun, .lower = -Inf, .prob = beta[k], .theta = theta, + binding_lower_bound = TRUE, + interval = c(-20, 20), extendInt = "yes")$root + } + + if(alpha_bound){ + .upper <- sum(alpha[1:k]) + }else{ + .upper <- uniroot(bound_fun, .upper = Inf, .prob = alpha[k], .theta = theta0, + binding_lower_bound = FALSE, + interval = c(-20, 20), extendInt = "yes")$root + } + + lower <- c(lower, .lower) + upper <- c(upper, .upper) + } + + # Ensure final analysis bound are the same + lower[n_analysis] <- upper[n_analysis] + + data.frame(upper = upper, lower = lower) + +} diff --git a/R/gs_design_ahr.R b/R/gs_design_ahr.R new file mode 100644 index 000000000..444094085 --- /dev/null +++ b/R/gs_design_ahr.R @@ -0,0 +1,252 @@ +# Copyright (c) 2021 Merck Sharp & Dohme Corp. a subsidiary of Merck & Co., Inc., Kenilworth, NJ, USA. +# +# This file is part of the gsDesign2 program. +# +# gsDesign2 is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +#' @importFrom tibble tibble +#' @importFrom gsDesign gsDesign sfLDOF +#' @importFrom stats qnorm +#' @importFrom dplyr mutate full_join select arrange desc +NULL + +#' Group sequential design using average hazard ratio under non-proportional hazards +#' +#' @param enrollRates enrollment rates +#' @param failRates failure and dropout rates +#' @param ratio Experimental:Control randomization ratio (not yet implemented) +#' @param alpha One-sided Type I error +#' @param beta Type II error +#' @param IF Targeted information fraction at each analysis +#' @param analysisTimes Minimum time of analysis +#' @param binding indicator of whether futility bound is binding; default of FALSE is recommended +#' @param upper Function to compute upper bound +#' @param upar Parameter passed to \code{upper()} +#' @param lower Function to compute lower bound +#' @param lpar Parameter passed to \code{lower()} +#' @param info_scale the information scale for calculation +#' @param h1_spending Indicator that lower bound to be set by spending under alternate hypothesis (input \code{failRates}) +#' if spending is used for lower bound +#' @param 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 \code{info} should indicate which analyses will have an efficacy bound +#' @param 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 \code{info} should indicate which analyses will have a +#' lower bound +#' @param r Integer, at least 2; default of 18 recommended by Jennison and Turnbull +#' @param tol Tolerance parameter for boundary convergence (on Z-scale) +#' @section Specification: +#' \if{latex}{ +#' \itemize{ +#' \item Validate if input analysisTimes is a positive number or positive increasing sequence. +#' \item Validate if input IF is a positive number or positive increasing sequence +#' on (0, 1] with final value of 1. +#' \item Validate if input IF and analysisTimes have the same length if both have length > 1. +#' \item Get information at input analysisTimes +#' \itemize{ +#' \item Use \code{gs_info_ahr()} to get the information and effect size based on AHR approximation. +#' \item Extract the final event. +#' \item Check if input If needed for (any) interim analysis timing. +#' } +#' \item Add the analysis column to the information at input analysisTimes. +#' \item Add the sample size column to the information at input analysisTimes using \code{eAccrual()}. +#' \item Get sample size and bounds using \code{gs_design_npe()} and save them to bounds. +#' \item Add Time, Events, AHR, N that have already been calculated to the bounds. +#' \item Return a list of design enrollment, failure rates, and bounds. +#' } +#' } +#' \if{html}{The contents of this section are shown in PDF user manual only.} +#' +#' @return a \code{tibble} with columns Analysis, Bound, Z, Probability, theta, Time, AHR, Events +#' @details Need to be added +#' @export +#' +#' @examples +#' library(gsDesign) +#' library(gsDesign2) +#' library(dplyr) +#' +#' # call with defaults +#' gs_design_ahr() +#' +#' # Single analysis +#' gs_design_ahr(analysisTimes = 40) +#' +#' # Multiple analysisTimes +#' gs_design_ahr(analysisTimes = c(12, 24, 36)) +#' +#' # Specified information fraction +#' gs_design_ahr(IF = c(.25, .75, 1), analysisTimes = 36) +#' +#' # multiple analysis times & IF +#' # driven by times +#' gs_design_ahr(IF = c(.25, .75, 1), analysisTimes = c(12, 25, 36)) +#' # driven by IF +#' gs_design_ahr(IF = c(1/3, .8, 1), analysisTimes = c(12, 25, 36)) +#' +#' # 2-sided symmetric design with O'Brien-Fleming spending +#' gs_design_ahr( +#' analysisTimes = 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) +#' +#' # 2-sided asymmetric design with O'Brien-Fleming upper spending +#' # Pocock lower spending under H1 (NPH) +#' gs_design_ahr( +#' analysisTimes = 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) +#' +gs_design_ahr <- function(enrollRates = tibble(Stratum = "All", duration = c(2, 2, 10), rate = c(3, 6, 9)), + failRates = tibble(Stratum = "All", duration = c(3, 100), failRate = log(2) / c(9, 18), + hr = c(.9, .6), dropoutRate = rep(.001, 2)), + ratio = 1, alpha = 0.025, beta = 0.1, + IF = NULL, analysisTimes = 36, binding = FALSE, + upper = gs_b, + upar = gsDesign::gsDesign(k = 3, test.type = 1, n.I = c(.25, .75, 1), sfu = sfLDOF, sfupar = NULL)$upper$bound, + lower = gs_b, + lpar = c(qnorm(.1), -Inf, -Inf), + h1_spending = TRUE, + test_upper = TRUE, + test_lower = TRUE, + info_scale = c(0, 1, 2), + r = 18, + tol = 1e-6){ + # --------------------------------------------- # + # initialization # + # --------------------------------------------- # + if(is.null(IF)){IF <- 1} + info_scale <- if(methods::missingArg(info_scale)){2}else{match.arg(as.character(info_scale), choices = 0:2)} + + # --------------------------------------------- # + # check inputs # + # --------------------------------------------- # + check_analysisTimes(analysisTimes) + check_IF(IF) + if((length(analysisTimes) > 1) & (length(IF) > 1) & (length(IF) != length(analysisTimes))){ + stop("gs_design_ahr() IF and analysisTimes must have the same length if both have length > 1!") + } + + # --------------------------------------------- # + # get information at input analysisTimes # + # --------------------------------------------- # + y <- gs_info_ahr(enrollRates, failRates, ratio = ratio, events = NULL, analysisTimes = analysisTimes) + + finalEvents <- y$Events[nrow(y)] + IFalt <- y$Events / finalEvents + + # --------------------------------------------- # + # check if IF needed for (any) IA timing # + # --------------------------------------------- # + K <- max(length(analysisTimes), length(IF)) + nextTime <- max(analysisTimes) + # if IF is not provided by the users + if(length(IF) == 1){ + IF <- IFalt + }else{ + # if there are >= 2 analysis + IFindx <- IF[1:(K-1)] + for(i in seq_along(IFindx)){ + # if ... + if(length(IFalt) == 1){ + y <- rbind(tEvents(enrollRates, failRates, ratio = ratio, targetEvents = IF[K - i] * finalEvents, interval = c(.01, nextTime)) %>% + mutate(theta = -log(AHR), Analysis = K - i), + y) + }else if(IF[K-i] > IFalt[K-i]){ + # if the planned IF > IF under H1 + y[K - i,] <- tEvents(enrollRates, failRates, ratio = ratio, targetEvents = IF[K - i] * finalEvents, interval = c(.01, nextTime)) %>% + dplyr::transmute(Analysis = K - i, Time, Events, AHR, theta = -log(AHR), info, info0) + } + nextTime <- y$Time[K - i] + } + } + + # update `y` (an object from `gs_power_ahr`) with + # 1) analysis NO. + # 2) the accrual sample size, i.e., `N` + # 3) `theta1` and `info1` + y$Analysis <- 1:K + y$N <- eAccrual(x = y$Time, enrollRates = enrollRates) + if(h1_spending){ + theta1 <- y$theta + info1 <- y$info + }else{ + theta1 <- 0 + info1 <- y$info0 + } + + # --------------------------------------------- # + # combine all the calculations # + # --------------------------------------------- # + suppressMessages( + allout <- gs_design_npe( + theta = y$theta, theta0 = 0, theta1 = theta1, + info = y$info, info0 = y$info0, info1 = info1, + info_scale = info_scale, + alpha = alpha, beta = beta, binding = binding, + upper = upper, upar = upar, test_upper = test_upper, + lower = lower, lpar = lpar, test_lower = test_lower, + r = r, tol = tol) + ) + + allout <- allout %>% + # add `~HR at bound`, `HR generic` and `Nominal p` + mutate("~HR at bound" = exp(-Z / sqrt(info0)), "Nominal p" = pnorm(-Z)) %>% + # Add `Time`, `Events`, `AHR`, `N` from gs_info_ahr call above + full_join(y %>% select(-c(info, info0, theta)), by = "Analysis") %>% + # select variables to be output + select(c("Analysis", "Bound", "Time", "N", "Events", "Z", "Probability", "Probability0", "AHR", "theta", + "info", "info0", "IF", "~HR at bound", "Nominal p")) %>% + # arrange the output table + arrange(Analysis, desc(Bound)) + + inflac_fct <- (allout %>% filter(Analysis == K, Bound == "Upper"))$info / (y %>% filter(Analysis == K))$info + allout$Events <- allout$Events * inflac_fct + allout$N <- allout$N * inflac_fct + + # --------------------------------------------- # + # get bounds to output # + # --------------------------------------------- # + bounds <- allout %>% + select(all_of(c("Analysis", "Bound", "Probability", "Probability0", "Z", "~HR at bound", "Nominal p"))) %>% + arrange(Analysis, desc(Bound)) + # --------------------------------------------- # + # get analysis summary to output # + # --------------------------------------------- # + analysis <- allout %>% + select(Analysis, Time, N, Events, AHR, theta, info, info0, IF) %>% + unique() %>% + arrange(Analysis) + + # --------------------------------------------- # + # return the output # + # --------------------------------------------- # + ans <- list( + enrollRates = enrollRates %>% mutate(rate = rate * inflac_fct), + failRates = failRates, + bounds = bounds, + analysis = analysis) + + class(ans) <- c("ahr", "gs_design", class(ans)) + + return(ans) + +} \ No newline at end of file diff --git a/R/gs_design_ahr_.R b/R/gs_design_ahr_.R new file mode 100644 index 000000000..3db32227e --- /dev/null +++ b/R/gs_design_ahr_.R @@ -0,0 +1,218 @@ +# Copyright (c) 2021 Merck Sharp & Dohme Corp. a subsidiary of Merck & Co., Inc., Kenilworth, NJ, USA. +# +# This file is part of the gsdmvn program. +# +# gsdmvn is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +#' @importFrom tibble tibble +#' @importFrom gsDesign gsDesign sfLDOF +#' @importFrom stats qnorm +#' @importFrom dplyr mutate full_join select arrange desc +NULL +#' Group sequential design using average hazard ratio under non-proportional hazards +#' +#' @param enrollRates enrollment rates +#' @param failRates failure and dropout rates +#' @param ratio Experimental:Control randomization ratio (not yet implemented) +#' @param alpha One-sided Type I error +#' @param beta Type II error +#' @param IF Targeted information fraction at each analysis +#' @param analysisTimes Minimum time of analysis +#' @param binding indicator of whether futility bound is binding; default of FALSE is recommended +#' @param upper Function to compute upper bound +#' @param upar Parameter passed to \code{upper()} +#' @param lower Function to compute lower bound +#' @param lpar Parameter passed to \code{lower()} +#' @param h1_spending Indicator that lower bound to be set by spending under alternate hypothesis (input \code{failRates}) +#' if spending is used for lower bound +#' @param 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 \code{info} should indicate which analyses will have an efficacy bound +#' @param 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 \code{info} should indicate which analyses will have a +#' lower bound +#' @param r Integer, at least 2; default of 18 recommended by Jennison and Turnbull +#' @param tol Tolerance parameter for boundary convergence (on Z-scale) +#' @section Specification: +#' \if{latex}{ +#' \itemize{ +#' \item Validate if input analysisTimes is a positive number or positive increasing sequence. +#' \item Validate if input IF is a positive number or positive increasing sequence +#' on (0, 1] with final value of 1. +#' \item Validate if input IF and analysisTimes have the same length if both have length > 1. +#' \item Get information at input analysisTimes +#' \itemize{ +#' \item Use \code{gs_info_ahr()} to get the information and effect size based on AHR approximation. +#' \item Extract the final event. +#' \item Check if input If needed for (any) interim analysis timing. +#' } +#' \item Add the analysis column to the information at input analysisTimes. +#' \item Add the sample size column to the information at input analysisTimes using \code{eAccrual()}. +#' \item Get sample size and bounds using \code{gs_design_npe()} and save them to bounds. +#' \item Add Time, Events, AHR, N that have already been calculated to the bounds. +#' \item Return a list of design enrollment, failure rates, and bounds. +#' } +#' } +#' \if{html}{The contents of this section are shown in PDF user manual only.} +#' +#' @return a \code{tibble} with columns Analysis, Bound, Z, Probability, theta, Time, AHR, Events +#' @details Need to be added +#' @noRd +#' +#' @examples +#' library(gsDesign) +#' library(gsDesign2) +#' library(dplyr) +#' # call with defaults +#' gs_design_ahr() +#' +#' # Single analysis +#' gs_design_ahr(analysisTimes = 40) +#' +#' # Multiple analysisTimes +#' gs_design_ahr(analysisTimes = c(12,24,36)) +#' +#' # Specified information fraction +#' gs_design_ahr(IF = c(.25,.75,1), analysisTimes = 36) +#' +#' # multiple analysis times & IF +#' # driven by times +#' gs_design_ahr(IF = c(.25,.75,1), analysisTimes = c(12,25,36)) +#' # driven by IF +#' gs_design_ahr(IF = c(1/3, .8, 1), analysisTimes = c(12,25,36)) +#' +#' # 2-sided symmetric design with O'Brien-Fleming spending +#' gs_design_ahr(analysisTimes = 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) +#' +#' # 2-sided asymmetric design with O'Brien-Fleming upper spending +#' # Pocock lower spending under H1 (NPH) +#' gs_design_ahr(analysisTimes = 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) +gs_design_ahr_ <- function(enrollRates=tibble::tibble(Stratum="All", + duration=c(2,2,10), + rate=c(3,6,9)), + failRates=tibble::tibble(Stratum="All", + duration=c(3,100), + failRate=log(2)/c(9,18), + hr=c(.9,.6), + dropoutRate=rep(.001,2)), + ratio=1, # Experimental:Control randomization ratio + alpha = 0.025, # One-sided Type I error + beta = 0.1, # NULL if enrollment is not adapted + IF = NULL, # relative information fraction timing (vector, if not NULL; increasing to 1) + analysisTimes = 36, # Targeted times of analysis or just planned study duration + binding = FALSE, + upper = gs_b, + # Default is Lan-DeMets approximation of + upar = gsDesign(k=3, test.type=1, + n.I=c(.25, .75, 1), + sfu=sfLDOF, sfupar = NULL)$upper$bound, + lower = gs_b, + lpar = c(qnorm(.1), -Inf, -Inf), # Futility only at IA1 + h1_spending = TRUE, + test_upper = TRUE, + test_lower = TRUE, + r = 18, + tol = 1e-6 +){ + ################################################################################ + # Check input values + msg <- "analysisTimes must be a positive number or positive increasing sequence" + if (!is.vector(analysisTimes,mode = "numeric")) stop(msg) + if (min(analysisTimes - dplyr::lag(analysisTimes, def=0))<=0) stop(msg) + msg <- "gs_design_ahr(): IF must be a positive number or positive increasing sequence on (0, 1] with final value of 1" + if (is.null(IF)){IF <- 1} + if (!is.vector(IF,mode = "numeric")) stop(msg) + if (min(IF - dplyr::lag(IF, def=0))<=0) stop(msg) + if (max(IF) != 1) stop(msg) + msg <- "gs_design_ahr() IF and analysisTimes must have the same length if both have length > 1" + if ((length(analysisTimes)>1) & (length(IF) > 1) & (length(IF) != length(analysisTimes))) stop(msg) + # end check input values + ################################################################################ + # Get information at input analysisTimes + y <- gs_info_ahr(enrollRates, failRates, ratio = ratio, events = NULL, analysisTimes=analysisTimes) + finalEvents <- y$Events[nrow(y)] + IFalt <- y$Events / finalEvents + # Check if IF needed for (any) IA timing + K <- max(length(analysisTimes), length(IF)) + nextTime <- max(analysisTimes) + if(length(IF)==1){IF <- IFalt}else{ + IFindx <- IF[1:(K-1)] + for(i in seq_along(IFindx)){ + if(length(IFalt) == 1){y <- + rbind(tEvents(enrollRates, failRates, targetEvents = IF[K - i] * finalEvents, ratio = ratio, + interval = c(.01, nextTime)) %>% mutate(theta=-log(AHR), Analysis=K-i), + y) + }else if (IF[K-i] > IFalt[K-i]) y[K - i,] <- + tEvents(enrollRates, failRates, targetEvents = IF[K - i] * finalEvents, ratio = ratio, + interval = c(.01, nextTime)) %>% + dplyr::transmute(Analysis = K - i, Time, Events, AHR, theta=-log(AHR), info, info0) + nextTime <- y$Time[K - i] + } + } + y$Analysis <- 1:K + y$N <- eAccrual(x = y$Time, enrollRates = enrollRates) + if(h1_spending){ + theta1 <- y$theta + info1 <- y$info + }else{ + theta1 <- 0 + info1 <- y$info0 + } + + # Get sample size and bounds using gs_design_npe + bounds <- gs_design_npe_(theta = y$theta, + theta1 = theta1, + info = y$info, + info0 = y$info0, + info1 = info1, + alpha = alpha, + beta = beta, + binding = binding, + upper = upper, + lower = lower, + upar = upar, + lpar = lpar, + test_upper = test_upper, + test_lower = test_lower, + r = r, + tol = tol) %>% + # Add Time, Events, AHR, N from gs_info_ahr call above + full_join(y %>% select(-c(info,info0,theta)), by = "Analysis") %>% + select(c("Analysis", "Bound", "Time", "N", "Events", "Z", "Probability", "AHR", "theta", "info", "info0")) %>% + arrange(desc(Bound), Analysis) + bounds$Events <- bounds$Events * bounds$info[K] / y$info[K] + bounds$N <- bounds$N * bounds$info[K] / y$info[K] + + # Document design enrollment, failure rates, and bounds + return(list(enrollRates = enrollRates %>% + mutate(rate = rate * bounds$info[K] / y$info[K]), + failRates = failRates, + bounds = bounds) + ) +} \ No newline at end of file diff --git a/R/gs_design_combo.R b/R/gs_design_combo.R new file mode 100644 index 000000000..69cbc9eea --- /dev/null +++ b/R/gs_design_combo.R @@ -0,0 +1,307 @@ +# Copyright (c) 2021 Merck Sharp & Dohme Corp. a subsidiary of Merck & Co., Inc., Kenilworth, NJ, USA. +# +# This file is part of the gsdmvn program. +# +# gsdmvn is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +#' Group sequential design using MaxCombo test under non-proportional hazards +#' @importFrom tibble tibble +#' +#' @inheritParams gs_design_ahr +#' @inheritParams pmvnorm_combo +#' @param fh_test a data frame to summarize the test in each analysis. +#' Refer examples for its data structure. +#' @param n_upper_bound a numeric value of upper limit of sample size +#' @importFrom mvtnorm GenzBretz +#' +#' @export +#' +#' @examples +#' # The example is slow to run +#' library(dplyr) +#' library(mvtnorm) +#' library(gsDesign) +#' library(tibble) +#' +#' enrollRates <- tibble( +#' Stratum = "All", +#' duration = 12, +#' rate = 500/12) +#' +#' failRates <- tibble( +#' Stratum = "All", +#' duration = c(4, 100), +#' failRate = log(2) / 15, # median survival 15 month +#' hr = c(1, .6), +#' dropoutRate = 0.001) +#' +#' fh_test <- rbind( +#' data.frame(rho = 0, gamma = 0, tau = -1, +#' test = 1, Analysis = 1:3, analysisTimes = c(12, 24, 36)), +#' data.frame(rho = c(0, 0.5), gamma = 0.5, tau = -1, +#' test = 2:3, Analysis = 3, analysisTimes = 36)) +#' +#' x <- gsSurv( +#' k = 3 , +#' test.type = 4 , +#' alpha = 0.025 , +#' beta = 0.2 , +#' astar = 0 , +#' timing = 1, +#' sfu = sfLDOF , +#' sfupar = 0, +#' sfl = sfLDOF , +#' sflpar = 0, +#' lambdaC = 0.1, +#' hr = 0.6, +#' hr0 = 1, +#' eta = 0.01, +#' gamma = 10, +#' R = 12, +#' S = NULL, +#' T = 36, +#' minfup = 24, +#' ratio = 1) +#' +#' # -------------------------# +#' # example 1 # +#' # ------------------------ # +#' \dontrun{ +#' # User defined boundary +#' gs_design_combo( +#' enrollRates, +#' failRates, +#' fh_test, +#' alpha = 0.025, beta = 0.2, +#' ratio = 1, +#' binding = FALSE, +#' upar = x$upper$bound, +#' lpar = x$lower$bound) +#' } +#' +#' # -------------------------# +#' # example 2 # +#' # ------------------------ # +#' # Boundary derived by spending function +#' gs_design_combo( +#' enrollRates, +#' failRates, +#' fh_test, +#' alpha = 0.025, +#' beta = 0.2, +#' ratio = 1, +#' binding = FALSE, +#' upper = gs_spending_combo, +#' upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025), # alpha spending +#' lower = gs_spending_combo, +#' lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.2), # beta spending +#' ) + +gs_design_combo <- function(enrollRates = tibble(Stratum = "All", + duration = 12, + rate = 500/12), + failRates = tibble(Stratum = "All", + duration = c(4, 100), + failRate = log(2) / 15, + hr = c(1, .6), + dropoutRate = 0.001), + fh_test = rbind(data.frame(rho = 0, gamma = 0, tau = -1, test = 1, Analysis = 1:3, analysisTimes = c(12, 24, 36)), + data.frame(rho = c(0, 0.5), gamma = 0.5, tau = -1, test = 2:3, Analysis = 3, analysisTimes = 36)), + ratio = 1, + alpha = 0.025, + beta = 0.2, + binding = FALSE, + upper = gs_b, + upar = c(3, 2, 1), + lower = gs_b, + lpar = c(-1, 0, 1), + algorithm = mvtnorm::GenzBretz(maxpts = 1e5, abseps = 1e-5), + n_upper_bound = 1e3, + ...){ + + # --------------------------------------------- # + # check input values # + # --------------------------------------------- # + # Currently only support user defined lower and upper bound + #stopifnot( identical(upper, gs_b) | identical(upper, gs_spending_combo) ) + #stopifnot( identical(lower, gs_b) | identical(lower, gs_spending_combo) ) + + # --------------------------------------------- # + # get the number of analysis/test # + # --------------------------------------------- # + n_analysis <- length(unique(fh_test$Analysis)) + n_test <- max(fh_test$test) + + # --------------------------------------------- # + # obtain utilities # + # --------------------------------------------- # + utility <- gs_utility_combo(enrollRates = enrollRates, + failRates = failRates, + fh_test = fh_test, + ratio = ratio, + algorithm = algorithm, + ...) + + info <- utility$info_all + info_fh <- utility$info + theta_fh <- utility$theta + corr_fh <- utility$corr + + # Information Fraction + if(n_analysis == 1){ + min_info_frac <- 1 + }else{ + info_frac <- tapply(info$info0, info$test, function(x) x / max(x)) + min_info_frac <- apply(do.call(rbind, info_frac), 2, min) + } + + # Function to calculate power + foo <- function(n, beta, ...){ + + # Probability Cross Boundary + prob <- gs_prob_combo(upper_bound = bound$upper, + lower_bound = bound$lower, + analysis = info_fh$Analysis, + theta = theta_fh * sqrt(n), + corr = corr_fh, + algorithm = algorithm, ...) + + max(subset(prob, Bound == "Upper")$Probability) - (1 - beta) + } + + # Find sample size and bound + n <- max(info$N) + n0 <- 0 + while( (abs(n - n0)) > 1e-2){ + # print(n) + n0 <- n + + # Obtain spending function + bound <- gs_bound(alpha = upper(upar, min_info_frac), + beta = lower(lpar, min_info_frac), + analysis = info_fh$Analysis, + theta = theta_fh * sqrt(n), + corr = corr_fh, + binding_lower_bound = binding, + algorithm = algorithm, + alpha_bound = identical(upper, gs_b), + beta_bound = identical(lower, gs_b), + ...) + + + n <- uniroot(foo, c(1, n_upper_bound), extendInt = "yes", beta = beta, ...)$root + + } + + # Probability Cross Boundary + prob <- gs_prob_combo(upper_bound = bound$upper, + lower_bound = bound$lower, + analysis = info_fh$Analysis, + theta = theta_fh * sqrt(n), + corr = corr_fh, + algorithm = algorithm, ...) + + # Probability Cross Boundary under Null + prob_null <- gs_prob_combo(upper_bound = bound$upper, + lower_bound = if(binding){bound$lower}else{rep(-Inf, nrow(bound))}, + analysis = info_fh$Analysis, + theta = rep(0, nrow(info_fh)), + corr = corr_fh, + algorithm = algorithm, ...) + + # if(binding == FALSE){ + # prob_null$Probability[prob_null$Bound == "Lower"] <- NA + # } + + prob$Probability_Null <- prob_null$Probability + + # Prepare output + db <- merge( + data.frame(Analysis = 1:(nrow(prob)/2), prob, Z = unlist(bound)), + info_fh %>% + tibble::as_tibble() %>% + select(Analysis, Time, N, Events) %>% + unique()) %>% + # update sample size and events + mutate( + Events = Events * n / max(N), + N = N * n / max(N)) %>% + # arrange the dataset by Upper bound first and then Lower bound + arrange(Analysis, desc(Bound)) + + + # out <- db[order(db$Bound, decreasing = TRUE), c("Analysis", "Bound", "Time", "N", "Events", "Z", "Probability", "Probability_Null")] + out <- db %>% + dplyr::select(Analysis, Bound, Time, N, Events, Z, Probability, Probability_Null) %>% + dplyr::rename(Probability0 = Probability_Null) %>% + dplyr::mutate(`Nominal p` = pnorm(Z * (-1))) + + + # --------------------------------------------- # + # get bounds to output # + # --------------------------------------------- # + bounds <- out %>% + #rbind(out_H1, out_H0) %>% + select(Analysis, Bound, Probability, Probability0, Z, `Nominal p`) %>% + arrange(Analysis,desc(Bound)) + + # --------------------------------------------- # + # get analysis summary to output # + # --------------------------------------------- # + # check if rho, gamma = 0 is included in fh_test + tmp <- fh_test %>% + filter(rho == 0 & gamma == 0 & tau == -1) %>% + select(test) %>% + unlist() %>% + as.numeric() %>% + unique() + if(length(tmp) != 0){ + AHR_dis <- utility$info_all %>% + filter(test == tmp) %>% + select(AHR) %>% + unlist() %>% + as.numeric() + }else{ + AHR_dis <- gs_info_wlr( + enrollRates, + failRates, + ratio, + events = unique(utility$info_all$Events), + analysisTimes = unique(utility$info_all$Time), + weight = eval(parse(text = get_combo_weight(rho = 0, gamma = 0, tau = -1))))$AHR + } + + analysis <- utility$info_all %>% + select(Analysis, test, Time, N, Events)%>% + mutate(theta = utility$info_all$theta, + EF = Events/tapply(Events, test, function(x) max(x)) %>% unlist() %>% as.numeric()) %>% + select(Analysis, Time, N, Events, EF) %>% + unique() %>% + mutate(AHR = AHR_dis) %>% + mutate(N = N *n / max(info_fh$N), + Events = Events * n / max(info_fh$N)) %>% + arrange(Analysis) + + # --------------------------------------------- # + # output # + # --------------------------------------------- # + message("The AHR reported in the `analysis` table is under the log-rank test.") + output <- list( + enrollRates = enrollRates %>% mutate(rate = rate * max(analysis$N) / sum(rate * duration) ), + failRates = failRates, + bounds = bounds, + analysis = analysis) + class(output) <- c("combo", "gs_design", class(output)) + return(output) +} diff --git a/R/gs_design_npe.R b/R/gs_design_npe.R new file mode 100644 index 000000000..b4281b123 --- /dev/null +++ b/R/gs_design_npe.R @@ -0,0 +1,457 @@ +# Copyright (c) 2021 Merck Sharp & Dohme Corp. a subsidiary of Merck & Co., Inc., Kenilworth, NJ, USA. +# +# This file is part of the gsdmvn program. +# +# gsdmvn is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +#' @import tibble tibble +#' @importFrom stats qnorm uniroot +#' @import Rcpp +NULL + +#' Group sequential design computation with non-constant effect and information +#' +#' \code{gs_design_npe()} derives group sequential design size, bounds and boundary crossing probabilities based on proportionate +#' information and effect size at analyses. +#' It allows a non-constant treatment effect over time, but also can be applied for the usual homogeneous effect size designs. +#' It requires treatment effect and proportionate statistical information at each analysis as well as a method of deriving bounds, such as spending. +#' The routine enables two things not available in the gsDesign package: 1) non-constant effect, 2) more flexibility in boundary selection. +#' For many applications, the non-proportional-hazards design function \code{gs_design_nph()} will be used; it calls this function. +#' Initial bound types supported are 1) spending bounds, 2) fixed bounds, and 3) Haybittle-Peto-like bounds. +#' The requirement is to have a boundary update method that can each bound without knowledge of future bounds. +#' As an example, bounds based on conditional power that require knowledge of all future bounds are not supported by this routine; +#' a more limited conditional power method will be demonstrated. +#' Boundary family designs Wang-Tsiatis designs including the original (non-spending-function-based) O'Brien-Fleming and Pocock designs +#' are not supported by \code{gs_power_npe()}. +#' @param theta natural parameter for group sequential design representing expected incremental drift at all analyses; +#' used for power calculation +#' @param theta0 natural parameter used for upper bound spending; if \code{NULL}, this will be set to 0 +#' @param theta1 natural parameter used for lower bound spending; if \code{NULL}, this will be set to \code{theta} +#' which yields the usual beta-spending. If set to 0, spending is 2-sided under null hypothesis. +#' @param info proportionate statistical information at all analyses for input \code{theta} +#' @param info0 proportionate statistical information under null hypothesis, if different than alternative; +#' impacts null hypothesis bound calculation +#' @param info1 proportionate statistical information under alternate hypothesis; +#' impacts null hypothesis bound calculation +#' @param info_scale the information scale for calculation +#' @param alpha One-sided Type I error +#' @param beta Type II error +#' @param binding indicator of whether futility bound is binding; default of FALSE is recommended +#' @param upper function to compute upper bound +#' @param lower function to compare lower bound +#' @param upar parameter to pass to function provided in \code{upper} +#' @param lpar Parameter passed to function provided in \code{lower} +#' @param 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 \code{info} should indicate which analyses will have an efficacy bound +#' @param 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 \code{info} should indicate which analyses will have a +#' lower bound +#' @param r Integer, at least 2; default of 18 recommended by Jennison and Turnbull +#' @param tol Tolerance parameter for boundary convergence (on Z-scale) +#' @section Specification: +#' \if{latex}{ +#' \itemize{ +#' \item Validate if input info is a numeric vector or NULL, if non-NULL validate if it +#' is strictly increasing and positive. +#' \item Validate if input info0 is a numeric vector or NULL, if non-NULL validate if it +#' is strictly increasing and positive. +#' \item Validate if input info1 is a numeric vector or NULL, if non-NULL validate if it +#' is strictly increasing and positive. +#' \item Validate if input theta is a real vector and has the same length as info. +#' \item Validate if input theta1 is a real vector and has the same length as info. +#' \item Validate if input test_upper and test_lower are logical and have the same length as info. +#' \item Validate if input test_upper value is TRUE. +#' \item Validate if input alpha and beta are positive and of length one. +#' \item Validate if input alpha and beta are from the unit interval and alpha is smaller than beta. +#' \item Initialize bounds, numerical integration grids, boundary crossing probabilities. +#' \item Compute fixed sample size for desired power and Type I error. +#' \item Find an interval for information inflation to give correct power using \code{gs_power_npe()}. + +#' \item +#' \item If there is no interim analysis, return a tibble including Analysis time, upper bound, Z-value, +#' Probability of crossing bound, theta, info0 and info1. +#' \item If the design is a group sequential design, return a tibble of Analysis, +#' Bound, Z, Probability, theta, info, info0. +#' } +#' } +#' \if{html}{The contents of this section are shown in PDF user manual only.} +#' +#' @return a \code{tibble} with columns Analysis, Bound, Z, Probability, theta, info, info0 +#' @details The inputs \code{info} and \code{info0} should be vectors of the same length with increasing positive numbers. +#' The design returned will change these by some constant scale factor to ensure the design has power \code{1 - beta}. +#' The bound specifications in \code{upper, lower, upar, lpar} will be used to ensure Type I error and other boundary properties are as specified. +#' +#' @author Keaven Anderson \email{keaven_anderson@@merck.com} +#' +#' @export +#' +#' @examples +#' library(dplyr) +#' library(gsDesign) +#' +#' # ---------------------------------# +#' # example 1 # +#' # ---------------------------------# +#' # Single analysis +#' # Lachin book p 71 difference of proportions example +#' pc <- .28 # Control response rate +#' pe <- .40 # Experimental response rate +#' p0 <- (pc + pe) / 2 # Ave response rate under H0 +#' +#' # Information per increment of 1 in sample size +#' info0 <- 1 / (p0 * (1 - p0) * 4) +#' info <- 1 / (pc * (1 - pc) * 2 + pe * (1 - pe) * 2) +#' +#' # Result should round up to next even number = 652 +#' # Divide information needed under H1 by information per patient added +#' gs_design_npe(theta = pe - pc, info = info, info0 = info0) +#' +#' +#' # ---------------------------------# +#' # example 2 # +#' # ---------------------------------# +#' # Fixed bound +#' x <- gs_design_npe( +#' theta = c(.1, .2, .3), +#' info = (1:3) * 80, +#' info0 = (1:3) * 80, +#' upper = gs_b, +#' upar = gsDesign::gsDesign(k = 3, sfu = gsDesign::sfLDOF)$upper$bound, +#' lower = gs_b, +#' lpar = c(-1, 0, 0)) +#' x +#' +#' # Same upper bound; this represents non-binding Type I error and will total 0.025 +#' gs_power_npe( +#' theta = rep(0, 3), +#' info = (x %>% filter(Bound == "Upper"))$info, +#' upper = gs_b, +#' upar = (x %>% filter(Bound == "Upper"))$Z, +#' lower = gs_b, +#' lpar = rep(-Inf, 3)) +#' +#' # ---------------------------------# +#' # example 3 # +#' # ---------------------------------# +#' # Spending bound examples +#' # Design with futility only at analysis 1; efficacy only at analyses 2, 3 +#' # Spending bound for efficacy; fixed bound for futility +#' # NOTE: test_upper and test_lower DO NOT WORK with gs_b; must explicitly make bounds infinite +#' # test_upper and test_lower DO WORK with gs_spending_bound +#' gs_design_npe( +#' theta = c(.1, .2, .3), +#' info = (1:3) * 40, +#' info0 = (1:3) * 40, +#' upper = gs_spending_bound, +#' upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), +#' lower = gs_b, +#' lpar = c(-1, -Inf, -Inf), +#' test_upper = c(FALSE, TRUE, TRUE)) +#' +#' # one can try `info_scale = 1` or `info_scale = 0` here +#' gs_design_npe( +#' theta = c(.1, .2, .3), +#' info = (1:3) * 40, +#' info0 = (1:3) * 30, +#' info_scale = 1, +#' upper = gs_spending_bound, +#' upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), +#' lower = gs_b, +#' lpar = c(-1, -Inf, -Inf), +#' test_upper = c(FALSE, TRUE, TRUE)) +#' +#' # ---------------------------------# +#' # example 4 # +#' # ---------------------------------# +#' # Spending function bounds +#' # 2-sided asymmetric bounds +#' # Lower spending based on non-zero effect +#' gs_design_npe( +#' theta = c(.1, .2, .3), +#' info = (1:3) * 40, +#' info0 = (1:3) * 30, +#' upper = gs_spending_bound, +#' upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), +#' lower = gs_spending_bound, +#' lpar = list(sf = gsDesign::sfHSD, total_spend = 0.1, param = -1, timing = NULL)) +#' +#' # ---------------------------------# +#' # example 5 # +#' # ---------------------------------# +#' # Two-sided symmetric spend, O'Brien-Fleming spending +#' # Typically, 2-sided bounds are binding +#' xx <- gs_design_npe( +#' theta = c(.1, .2, .3), +#' info = (1:3) * 40, +#' binding = TRUE, +#' upper = gs_spending_bound, +#' upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), +#' lower = gs_spending_bound, +#' lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL)) +#' xx +#' +#' # Re-use these bounds under alternate hypothesis +#' # Always use binding = TRUE for power calculations +#' gs_power_npe( +#' theta = c(.1, .2, .3), +#' info = (1:3) * 40, +#' binding = TRUE, +#' upper = gs_b, +#' lower = gs_b, +#' upar = (xx %>% filter(Bound == "Upper"))$Z, +#' lpar = -(xx %>% filter(Bound == "Upper"))$Z) +#' +gs_design_npe <- function(theta = .1, theta0 = NULL, theta1 = NULL, # 3 theta + info = 1, info0 = NULL, info1 = NULL, # 3 info + info_scale = c(0, 1, 2), + alpha = 0.025, beta = .1, + upper = gs_b, upar = qnorm(.975), + lower = gs_b, lpar = -Inf, + test_upper = TRUE, test_lower = TRUE, binding = FALSE, + r = 18, tol = 1e-6){ + + # --------------------------------------------- # + # check & set up parameters # + # --------------------------------------------- # + K <- length(info) + + # check alpha & beta + check_alpha_beta(alpha, beta) + + # check theta, theta0, theta1 + if(length(theta) == 1){ + theta <- rep(theta, K) + } + + if(is.null(theta1)){ + theta1 <- theta + }else if(length(theta1) == 1){ + theta1 <- rep(theta1, K) + } + + if(is.null(theta0)){ + theta0 <- rep(0, K) + }else if(length(theta0) == 1){ + theta0 <- rep(theta0, K) + } + + check_theta(theta, K) + check_theta(theta0, K) + check_theta(theta1, K) + + # check test_upper & test_lower + if (length(test_upper) == 1 && K > 1) test_upper <- rep(test_upper, K) + if (length(test_lower) == 1 && K > 1) test_lower <- rep(test_lower, K) + check_test_upper(test_upper, K) + check_test_lower(test_lower, K) + + # --------------------------------------------- # + # set up info # + # --------------------------------------------- # + if(is.null(info0)){ + info0 <- info + } + + if(is.null(info1)){ + info1 <- info + } + + # set up info_scale + info_scale <- if(methods::missingArg(info_scale)){2}else{match.arg(as.character(info_scale), choices = 0:2)} + if(info_scale == 0){ + info <- info0 + info1 <- info0 + } + if(info_scale == 1){ + info <- info1 + info0 <- info1 + } + + # check info, info0, info1 + check_info(info) + check_info(info0) + check_info(info1) + if(length(info0) != length(info)) stop("gs_design_npe(): length of info, info0 must be the same!") + if(length(info1) != length(info)) stop("gs_design_npe(): length of info, info1 must be the same!") + + # --------------------------------------------- # + # check design type # + # --------------------------------------------- # + if(identical(lower, gs_b) & (!is.list(lpar))){ + two_sided <- ifelse(identical(lpar, rep(-Inf, K)), FALSE, TRUE) + }else{ + two_sided <- TRUE + } + + # --------------------------------------------- # + # initialization # + # --------------------------------------------- # + a <- rep(-Inf, K) # bounds + b <- rep(Inf, K) + hgm1_0 <- NULL # numerical integration grids + hgm1_1 <- NULL + upperProb <- rep(NA, K) # boundary crossing probabilities + lowerProb <- rep(NA, K) + + # --------------------------------------------- # + # fixed design # + # --------------------------------------------- # + # compute fixed sample size for desired power and Type I error. + min_x <- ((qnorm(alpha) / sqrt(info0[K]) + qnorm(beta) / sqrt(info[K])) / theta[K])^2 + # for a fixed design, this is all you need. + if (K == 1){ + ans <- tibble(Analysis = 1, Bound = "Upper", Z = qnorm(1 - alpha), + Probability = 1 - beta, Probability0 = alpha, theta = theta, + info = info * min_x, info0 = info0 * min_x, info1 = info1 * min_x, + IF = info / max(info)) + return(ans) + } + + # --------------------------------------------- # + # search for the inflation factor to info # + # --------------------------------------------- # + # ensure `min_x` gives power < 1 - beta + # and `max_x` gives power > 1 - beta + min_temp <- gs_power_npe(theta = theta, theta0 = theta0, theta1 = theta1, + info = info * min_x, info0 = info0 * min_x, info1 = info * min_x, info_scale = info_scale, + upper = upper, upar = upar, test_upper = test_upper, + lower = lower, lpar = lpar, test_lower = test_lower, + binding = binding, r = r, tol = tol) + min_power <- (min_temp[min_temp$Bound == "Upper" & min_temp$Analysis == K, ])$Probability + + # a flag indicates if max_x can be found + flag <- FALSE + if (min_power < 1 - beta){ + # if min_power < 1 - beta + # then find a max_power > 1 - beta + # by increasing `min_x` to `max_x` until `max_power` > 1 - beta + max_x <- 1.05 * min_x + + for(i in 1:10){ + max_temp <- gs_power_npe(theta = theta, theta0 = theta0, theta1 = theta1, + info = info * max_x, info0 = info0 * max_x, info1 = info * max_x, info_scale = info_scale, + upper = upper, upar = upar, test_upper = test_upper, + lower = lower, lpar = lpar, test_lower = test_lower, + binding = binding, r = r, tol = tol) + max_power <- (max_temp[max_temp$Bound == "Upper" & max_temp$Analysis == K, ])$Probability + + if (max_power < 1 - beta){ + min_x <- max_x + max_x <- 1.05 * max_x + }else{ + flag <- TRUE + break + } + } + if(!flag) stop("gs_design_npe: could not inflate information to bracket power before root finding!") + }else{ + # if min_power > 1 - beta + # then find a micro_power < 1 - beta + # by decreasing `min_x` to `micro_x` until `micro_power` < 1 - beta + micro_x <- min_x / 1.05 + + for(i in 1:10){ + micro_temp <- gs_power_npe(theta = theta, theta0 = theta0, theta1 = theta1, + info = info * micro_x, info0 = info0 * micro_x, info1 = info * micro_x, info_scale = info_scale, + upper = upper, upar = upar, test_upper = test_upper, + lower = lower, lpar = lpar, test_lower = test_lower, + binding = binding, r = r, tol = tol) + micro_power <- (micro_temp[micro_temp$Bound == "Upper" & micro_temp$Analysis == K, ])$Probability + + if(micro_power > 1 - beta){ + min_x <- micro_x + micro_x <- micro_x / 1.05 + }else{ + flag <- TRUE + break + } + } + + if(!flag) stop("gs_design_npe: could not deflate information to bracket targeted power before root finding!") + max_x <- min_x + min_x <- micro_x + } + + # use root finding with the above function to find needed sample size inflation + # now we can solve for the inflation factor for the enrollment rate to achieve the desired power + res <- try(uniroot(errbeta, + lower = min_x, upper = max_x, + theta = theta, theta0 = theta0, theta1 = theta1, + info = info, info0 = info0, info1 = info1, info_scale = info_scale, + Zupper = upper, upar = upar, test_upper = test_upper, + Zlower = lower, lpar = lpar, test_lower = test_lower, + beta = beta, K = K, binding = binding, r = r, tol = tol)) + if(inherits(res, "try-error")){ + stop("gs_design_npe(): Sample size solution not found!") + }else{ + inflation_factor <- res$root + } + + # --------------------------------------------- # + # return the output # + # --------------------------------------------- # + # calculate the probability under H1 + ans_H1 <- gs_power_npe(theta = theta, theta0 = theta0, theta1 = theta1, + info = info * inflation_factor, info0 = info0 * inflation_factor, info1 = info1 * inflation_factor, + info_scale = info_scale, + upper = upper, upar = upar, + lower = lower, lpar = lpar, + test_upper = test_upper, test_lower = test_lower, + binding = binding, r = r, tol = tol) + + # calculate the probability under H0 + ans_H0 <- gs_power_npe(theta = 0, theta0 = theta0, theta1 = theta1, + info = info * inflation_factor, info0 = info0 * inflation_factor, info1 = info1 * inflation_factor, + info_scale = info_scale, + upper = upper, upar = upar, + lower = if(!two_sided){gs_b}else{lower}, + lpar = if(!two_sided){rep(-Inf, K)}else{lpar}, + test_upper = test_upper, test_lower = test_lower, + binding = binding, r = r, tol = tol) + + # combine probability under H0 and H1 + suppressMessages( + ans <- ans_H1 %>% full_join(ans_H0 %>% select(Analysis, Bound, Probability) %>% dplyr::rename(Probability0 = Probability)) + ) + + ans <- ans %>% select(Analysis, Bound, Z, Probability, Probability0, theta, IF, info, info0, info1) + + ans <- ans %>% arrange(Analysis) + + return(ans) +} + + +## Create a function that uses gs_power_npe to compute difference from targeted power +## for a given sample size inflation factor +errbeta <- function(x = 1, K = 1, + beta = .1, + theta = .1, theta0 = 0, theta1 = .1, + info = 1, info0 = 1, info1 = 1, info_scale = 2, + Zupper = gs_b, upar = qnorm(.975), + Zlower = gs_b, lpar = -Inf, + test_upper = TRUE, test_lower = TRUE, + binding = FALSE, r = 18, tol = 1e-6){ + + x_temp <- gs_power_npe(theta = theta, theta0 = theta0, theta1 = theta1, + info = info * x, info0 = info0 * x, info1 = info1 * x, info_scale = info_scale, + upper = Zupper, upar = upar, test_upper = test_upper, + lower = Zlower, lpar = lpar, test_lower = test_lower, + binding = binding, r = r, tol = tol) + + x_power <- (x_temp[x_temp$Bound == "Upper" & x_temp$Analysis == K, ])$Probability + + ans <- 1 - beta - x_power + return(ans) +} diff --git a/R/gs_design_npe_.R b/R/gs_design_npe_.R new file mode 100644 index 000000000..bf27d08cf --- /dev/null +++ b/R/gs_design_npe_.R @@ -0,0 +1,338 @@ +# Copyright (c) 2021 Merck Sharp & Dohme Corp. a subsidiary of Merck & Co., Inc., Kenilworth, NJ, USA. +# +# This file is part of the gsdmvn program. +# +# gsdmvn is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +#' @importFrom tibble tibble +#' @importFrom stats qnorm uniroot +NULL +#' Group sequential design computation with non-constant effect and information +#' +#' \code{gs_design_npe()} derives group sequential design size, bounds and boundary crossing probabilities based on proportionate +#' information and effect size at analyses. +#' It allows a non-constant treatment effect over time, but also can be applied for the usual homogeneous effect size designs. +#' It requires treatment effect and proportionate statistical information at each analysis as well as a method of deriving bounds, such as spending. +#' The routine enables two things not available in the gsDesign package: 1) non-constant effect, 2) more flexibility in boundary selection. +#' For many applications, the non-proportional-hazards design function \code{gs_design_nph()} will be used; it calls this function. +#' Initial bound types supported are 1) spending bounds, 2) fixed bounds, and 3) Haybittle-Peto-like bounds. +#' The requirement is to have a boundary update method that can each bound without knowledge of future bounds. +#' As an example, bounds based on conditional power that require knowledge of all future bounds are not supported by this routine; +#' a more limited conditional power method will be demonstrated. +#' Boundary family designs Wang-Tsiatis designs including the original (non-spending-function-based) O'Brien-Fleming and Pocock designs +#' are not supported by \code{gs_power_npe()}. +#' @param theta natural parameter for group sequential design representing expected incremental drift at all analyses; +#' used for power calculation +#' @param theta1 natural parameter used for lower bound spending; if \code{NULL}, this will be set to \code{theta} +#' which yields the usual beta-spending. If set to 0, spending is 2-sided under null hypothesis. +#' @param info proportionate statistical information at all analyses for input \code{theta} +#' @param info0 proportionate statistical information under null hypothesis, if different than alternative; +#' impacts null hypothesis bound calculation +#' @param info1 proportionate statistical information under alternate hypothesis; +#' impacts null hypothesis bound calculation +#' @param alpha One-sided Type I error +#' @param beta Type II error +#' @param binding indicator of whether futility bound is binding; default of FALSE is recommended +#' @param upper function to compute upper bound +#' @param lower function to compare lower bound +#' @param upar parameter to pass to function provided in \code{upper} +#' @param lpar Parameter passed to function provided in \code{lower} +#' @param 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 \code{info} should indicate which analyses will have an efficacy bound +#' @param 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 \code{info} should indicate which analyses will have a +#' lower bound +#' @param r Integer, at least 2; default of 18 recommended by Jennison and Turnbull +#' @param tol Tolerance parameter for boundary convergence (on Z-scale) +#' @section Specification: +#' \if{latex}{ +#' \itemize{ +#' \item Validate if input info is a numeric vector or NULL, if non-NULL validate if it +#' is strictly increasing and positive. +#' \item Validate if input info0 is a numeric vector or NULL, if non-NULL validate if it +#' is strictly increasing and positive. +#' \item Validate if input info1 is a numeric vector or NULL, if non-NULL validate if it +#' is strictly increasing and positive. +#' \item Validate if input theta is a real vector and has the same length as info. +#' \item Validate if input theta1 is a real vector and has the same length as info. +#' \item Validate if input test_upper and test_lower are logical and have the same length as info. +#' \item Validate if input test_upper value is TRUE. +#' \item Validate if input alpha and beta are positive and of length one. +#' \item Validate if input alpha and beta are from the unit interval and alpha is smaller than beta. +#' \item Initialize bounds, numerical integration grids, boundary crossing probabilities. +#' \item Compute fixed sample size for desired power and Type I error. +#' \item Find an interval for information inflation to give correct power using \code{gs_power_npe()}. + +#' \item +#' \item If there is no interim analysis, return a tibble including Analysis time, upper bound, Z-value, +#' Probability of crossing bound, theta, info0 and info1. +#' \item If the desing is a group sequential design, return a tibble of Analysis, +#' Bound, Z, Probability, theta, info, info0. +#' } +#' } +#' \if{html}{The contents of this section are shown in PDF user manual only.} +#' +#' @return a \code{tibble} with columns Analysis, Bound, Z, Probability, theta, info, info0 +#' @details The inputs \code{info} and \code{info0} should be vectors of the same length with increasing positive numbers. +#' The design returned will change these by some constant scale factor to ensure the design has power \code{1 - beta}. +#' The bound specifications in \code{upper, lower, upar, lpar} will be used to ensure Type I error and other boundary properties are as specified. +#' @author Keaven Anderson \email{keaven_anderson@@merck.com} +#' +#' @noRd +#' +#' @examples +#' +#' library(gsDesign) +#' library(gsDesign2) +#' library(dplyr) +#' +#' # Single analysis +#' # Lachin book p 71 difference of proportions example +#' pc <- .28 # Control response rate +#' pe <- .40 # Experimental response rate +#' p0 <- (pc + pe) / 2 # Ave response rate under H0 +#' # Information per increment of 1 in sample size +#' info0 <- 1 / (p0 * (1 - p0) * 4) +#' info1 <- 1 / (pc * (1 - pc) * 2 + pe * (1 - pe) * 2) +#' # Result should round up to next even number = 652 +#' # Divide information needed under H1 by information per patient added +#' gsDesign2:::gs_design_npe_(theta = pe - pc, info = info1, info0 = info0)$info[1] / info1 +#' +#' # Fixed bound +#' design <- gsDesign2:::gs_design_npe_(theta = c(.1, .2, .3), info = (1:3) * 80, +#' info0 = (1:3) * 80, info1 = (1:3) * 80, +#' upper = gs_b, upar = gsDesign::gsDesign(k=3,sfu=gsDesign::sfLDOF)$upper$bound, +#' lower = gs_b, lpar = c(-1, 0, 0)) +#' design +#' +#' # Same fixed bounds, null hypothesis +#' gsDesign2:::gs_design_npe_(theta = rep(0,3), info = design$info0[1:3], +#' upar = design$Z[1:3], lpar = design$Z[4:6]) +#' +#' # Same upper bound; this represents non-binding Type I error and will total 0.025 +#' gsDesign2:::gs_design_npe_(theta = rep(0,3), info = design$info0[1:3], +#' upar = design$Z[1:3], lpar = rep(-Inf,3)) %>% +#' filter(Bound=="Upper") +#' +#' # Spending bound examples +#' +#' # Design with futility only at analysis 1; efficacy only at analyses 2, 3 +#' # Spending bound for efficacy; fixed bound for futility +#' # NOTE: test_upper and test_lower DO NOT WORK with gs_b; must explicitly make bounds infinite +#' # test_upper and test_lower DO WORK with gs_spending_bound +#' design <- gsDesign2:::gs_design_npe_(theta = c(.1, .2, .3), info = (1:3) * 40, info0 = (1:3) * 40, +#' upper = gs_spending_bound, +#' upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, +#' param = NULL, timing = NULL), +#' lower = gs_b, lpar = c(-1, -Inf, -Inf), +#' test_upper = c(FALSE, TRUE, TRUE)) +#' design +#' +#' # Spending function bounds +#' # 2-sided asymmetric bounds +#' # Lower spending based on non-zero effect +#' gsDesign2:::gs_design_npe_(theta = c(.1, .2, .3), info = (1:3) * 40, +#' upper = gs_spending_bound, +#' upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, +#' param = NULL, timing = NULL), +#' lower = gs_spending_bound, +#' lpar = list(sf = gsDesign::sfHSD, total_spend = 0.1, +#' param = -1, timing = NULL)) +#' +#' # Two-sided symmetric spend, O'Brien-Fleming spending +#' # Typically, 2-sided bounds are binding +#' xx <- gsDesign2:::gs_design_npe_(theta = c(.1, .2, .3), theta1 = rep(0, 3), info = (1:3) * 40, +#' binding = TRUE, +#' upper = gs_spending_bound, +#' upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, +#' param = NULL, timing = NULL), +#' lower = gs_spending_bound, +#' lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, +#' param = NULL, timing = NULL)) +#' xx +#' +#' # Re-use these bounds under alternate hypothesis +#' # Always use binding = TRUE for power calculations +#' upar <- (xx %>% filter(Bound=="Upper"))$Z +#' gsDesign2:::gs_design_npe_(theta = c(.1, .2, .3), info = (1:3) * 40, +#' binding = TRUE, +#' upar = upar, +#' lpar = -upar) +#' +gs_design_npe_ <- function(theta = .1, theta1 = NULL, info = 1, info0 = NULL, info1 = NULL, + alpha = 0.025, beta = .1, binding = FALSE, + upper=gs_b, lower=gs_b, upar = qnorm(.975), lpar= -Inf, + test_upper = TRUE, test_lower = TRUE, + r = 18, tol = 1e-6){ + ####################################################################################### + # WRITE INPUT CHECK TESTS AND RETURN APPROPRIATE ERROR MESSAGES + # info should be a scalar or vector of positive increasing values + # info0, info1 should be NULL or of the same form as info + # theta should be a scalar or vector of real values; if vector, same length as info + # theta0, theta1 should be NULL or same form and length as theta + # test_upper and test_lower should be logical scalar or vector; if vector same length as info + # alpha and beta should be scalars with 0 < alpha < 1 - beta < 1 + + # CHECK STATISTICAL INFORMATION PARAMETERS: info, info0, info1 + if (!is.vector(info, mode = "numeric")) stop("gs_design_npe(): info must be specified numeric vector") + K <- length(info) + if (is.null(info0)) info0 <- info + if (is.null(info1)) info1 <- info + if (!is.vector(info0, mode = "numeric")) stop("gs_design_npe(): info0 must be specified numeric vector or NULL") + if (!is.vector(info1, mode = "numeric")) stop("gs_design_npe(): info1 must be specified numeric vector or NULL") + if (length(info1) != length(info) || length(info0) != length(info) ) stop("gs_design_npe(): length of info, info0, info1 must be the same") + if (min(info - lag(info,default = 0)<=0)) stop("gs_design_npe(): info much be strictly increasing and positive") + if (min(info0 - lag(info0,default = 0)<=0)) stop("gs_design_npe(): info0 much be NULL or strictly increasing and positive") + if (min(info1 - lag(info1,default = 0)<=0)) stop("gs_design_npe(): info1 much be NULL or strictly increasing and positive") + + # CHECK TREATMENT EFFECT PARAMETERS: theta, theta0, theta1 + if (!is.vector(theta, mode = "numeric")) stop("gs_design_npe(): theta must be a real vector") + if (length(theta) == 1 && K > 1) theta <- rep(theta, K) + if (length(theta) != K) stop("gs_design_npe(): if length(theta) > 1, must be same as info") + if (theta[K] <= 0) stop("gs_design_npe(): final effect size must be > 0") + if (is.null(theta1)){theta1 <- theta}else if (length(theta1)==1) theta1 <- rep(theta1,K) + if (!is.vector(theta1, mode = "numeric")) stop("gs_design_npe(): theta1 must be a real vector") + if (length(theta1) != K) stop("gs_design_npe(): if length(theta1) > 1, must be same as info") + # CHECK CORRECT SPEC OF test_upper and test_lower + if (length(test_upper) == 1 && K > 1) test_upper <- rep(test_upper, K) + if (length(test_lower) == 1 && K > 1) test_lower <- rep(test_lower, K) + + ## Check test_upper and test_lower are logical and correct length + if (!is.vector(test_upper, mode = "logical") || !is.vector(test_lower, mode = "logical")) + stop("gs_design_npe(): test_upper and test_lower must be logical") + if (!(length(test_upper) == 1 || length(test_upper) == K)) + stop("gs_design_npe(): test_upper must be length 1 or same length as info") + if (!(length(test_lower) == 1 || length(test_lower) == K)) + stop("gs_design_npe(): test_lower must be length 1 or same length as info") + ## Check that final test_upper value is TRUE + if (!dplyr::last(test_upper)) stop("gs_design_npe(): last value of test_upper must be TRUE") + + ## Check alpha and beta numeric, scalar, 0 < alpha < 1 - beta + if (!is.numeric(alpha)) stop("gs_design_npe(): alpha must be numeric") + if (!is.numeric(beta)) stop("gs_design_npe(): beta must be numeric") + if (length(alpha) != 1 || length(beta) != 1) stop("gs_design_npe(): alpha and beta must be length 1") + if (alpha <= 0 || 1 - beta <= alpha || beta <= 0) stop("gs_design_npe(): must have 0 < alpha < 1 - beta < 1") + + ## END OF INPUT CHECKS ############################################################################ + + # Initialize bounds, numerical integration grids, boundary crossing probabilities + a <- rep(-Inf, K) + b <- rep(Inf, K) + hgm1_0 <- NULL + hgm1_1 <- NULL + upperProb <- rep(NA, K) + lowerProb <- rep(NA, K) + + ## Compute fixed sample size for desired power and Type I error. + minx <- ((qnorm(alpha) / sqrt(info0[K]) + qnorm(beta) / sqrt(info[K])) / theta[K])^2 + + ## For a fixed design, this is all you need. + if (K == 1) return(tibble::tibble( + Analysis = 1, + Bound = "Upper", + Z= qnorm(1-alpha), + Probability = 1 - beta, + theta = theta, + info = info * minx, + info0 =info0 * minx) + ) + + ## Find an interval for information inflation to give correct power + minpwr <- gs_power_npe_(theta = theta, theta1 = theta1, + info = info * minx, info1 = info * minx, info0 = info0 * minx, + binding = binding, + upper=upper, lower=lower, upar = upar, lpar= lpar, + test_upper = test_upper, test_lower = test_lower, + r = r, tol = tol)$Probability[K] + + ##### FOLLOWING IS PAINFUL AND SHOULD NEVER BE NEEDED + ##### BUT IF IT IS NEEDED, IT TELLS YOU WHAT WENT WRONG! + ##### NEED TO BRACKET TARGETED POWER BEFORE ROOT FINDING + + ## Ensure minx gives power < 1 - beta and maxx gives power > 1 - beta + if (minpwr < 1 - beta){ + maxx <- 1.05 * minx + ## Ensure maxx is sufficient information inflation to overpower + err <- 1 + for(i in 1:10){ + maxpwr <- gs_power_npe_(theta = theta, theta1 = theta1, + info = info * maxx, info1 = info * maxx, info0 = info0 * maxx, + binding = binding, + upper=upper, lower=lower, upar = upar, lpar= lpar, + test_upper = test_upper, test_lower = test_lower, + r = r, tol = tol)$Probability[K] + if (1 - beta > maxpwr){ + minx <- maxx + maxx <- 1.05 * maxx + }else{ + err <- 0 + break + } + } + if (err) stop("gs_design_npe: could not inflate information to bracket power before root finding") + }else{ + maxx <- minx + minx <- maxx / 1.05 + err <- 1 + for(i in 1:10){ + if (1 - beta < gs_power_npe_(theta = theta, theta1 = theta1, + info = info * minx, info1 = info1 * minx, info0 = info0 * minx, + binding = binding, + upper=upper, lower=lower, upar = upar, lpar= lpar, + test_upper = test_upper, test_lower = test_lower, + r = r, tol = tol)$Probability[K] + ){maxx <- minx + minx <- minx / 1.05}else{err <- 0 + break + } + } + if (err) stop("gs_design_npe: could not deflate information to bracket targeted power before root finding") + } + #### EITHER TARGETED POWER NOW BRACKETED OR ERROR MESSAGE HAS BEEN RETURNED + #### AND WE CAN ACTUALLY GO ON TO FIND THE ROOT + + ## Use root finding with the above function to find needed sample size inflation + # Now we can solve for the inflation factor for the enrollment rate to achieve the desired power + res <- try( + uniroot(errbeta_, lower = minx, upper = maxx, + theta = theta, theta1 = theta1, K = K, beta = beta, + info = info, info1 = info1, info0 = info0, binding = binding, + Zupper=upper, Zlower=lower, upar = upar, lpar= lpar, + test_upper = test_upper, test_lower = test_lower, + r = r, tol = tol) + ) + if(inherits(res,"try-error")){stop("gs_design_npe: Sample size solution not found")} + + ## Update targeted info, info0 based on inflation factor and return a tibble with + ## bounds, targeted information, and boundary crossing probabilities at each analysis + return(gs_power_npe_(theta = theta, theta1 = theta1, + info = info * res$root, info1 = info1 * res$root, info0 = info0 * res$root, + binding = binding, + upper=upper, lower=lower, upar = upar, lpar= lpar, + test_upper = test_upper, test_lower = test_lower, + r = r, tol = tol)) +} +## Create a function that uses gs_power_npe to compute difference from targeted power +## for a given sample size inflation factor +errbeta_ <- function(x = 1, K = 1, beta = .1, theta = .1, theta1 = .1, info = 1, info1 = 1, info0 = 1, binding = FALSE, + Zupper=gs_b, Zlower=gs_b, upar = qnorm(.975), lpar= -Inf, + test_upper = TRUE, test_lower = TRUE, + r = 18, tol = 1e-6){ + return(1 - beta - + gs_power_npe_(theta = theta, theta1 = theta1, + info = info * x, info1 = info1 * x, info0 = info0 * x, binding = binding, + upper = Zupper, lower = Zlower, upar = upar, lpar= lpar, + test_upper = test_upper, test_lower = test_lower, + r = r, tol = tol)$Probability[K]) +} diff --git a/R/gs_design_rd.R b/R/gs_design_rd.R new file mode 100644 index 000000000..a779f3f36 --- /dev/null +++ b/R/gs_design_rd.R @@ -0,0 +1,231 @@ +# Copyright (c) 2021 Merck Sharp & Dohme Corp. a subsidiary of Merck & Co., Inc., Kenilworth, NJ, USA. +# +# This file is part of the gsdmvn program. +# +# gsdmvn is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +#' @importFrom tibble tibble +#' @importFrom gsDesign gsDesign sfLDOF +#' @importFrom stats qnorm +#' @importFrom dplyr mutate full_join select arrange desc +NULL + +#' Group sequential design using average hazard ratio under non-proportional hazards +#' +#' @param p_c rate at the control group +#' @param p_e rate at the experimental group +#' @param IF statistical information fraction +#' @param rd0 treatment effect under super-superiority designs, the default is 0 +#' @param alpha One-sided Type I error +#' @param beta Type II error +#' @param ratio Experimental:Control randomization ratio (not yet implemented) +#' @param stratum_prev randomization ratio of different stratum. +#' If it is un-stratified design then \code{NULL}. +#' Otherwise it is a tibble containing two columns (Stratum and prevalence). +#' @param binding indicator of whether futility bound is binding; default of FALSE is recommended +#' @param upper Function to compute upper bound +#' @param upar Parameter passed to \code{upper()} +#' @param lower Function to compute lower bound +#' @param lpar Parameter passed to \code{lower()} +#' @param 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 \code{info} should indicate which analyses will have an efficacy bound +#' @param 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 \code{info} should indicate which analyses will have a +#' lower bound +#' @param h1_spending Indicator that lower bound to be set by spending under alternate hypothesis (input \code{failRates}) +#' if spending is used for lower bound +#' +#' @param r Integer, at least 2; default of 18 recommended by Jennison and Turnbull + +#' +#' @param info_scale the information scale for calculation +#' @param weight the weighting scheme for stratified population +#' @param tol Tolerance parameter for boundary convergence (on Z-scale) +#' +#' @return a \code{tibble} with columns Analysis, Bound, Z, Probability, theta, Time, AHR, Events +#' @details Need to be added +#' @export +#' +#' @examples +#' library(tibble) +#' library(gsDesign) +#' +#' # ----------------- # +#' # example 1 # +#' #------------------ # +#' # un-stratified group sequential design +#' gs_design_rd( +#' p_c = tibble(Stratum = "All", Rate = .2), +#' p_e = tibble(Stratum = "All", Rate = .15), +#' IF = c(0.7, 1), +#' rd0 = 0, +#' alpha = .025, +#' beta = .1, +#' ratio = 1, +#' stratum_prev = NULL, +#' weight = "un-stratified", +#' upper = gs_b, +#' lower = gs_b, +#' upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, +#' lpar = c(qnorm(.1), rep(-Inf, 2)) +#' ) +#' +#' # ----------------- # +#' # example 2 # +#' # ----------------- # +#' # stratified group sequential design +#' gs_design_rd( +#' p_c = tibble(Stratum = c("biomarker positive", "biomarker negative"), Rate = c(.2, .25)), +#' p_e = tibble(Stratum = c("biomarker positive", "biomarker negative"), Rate = c(.15,.22)), +#' IF = c(0.7, 1), +#' rd0 = 0, +#' alpha = .025, +#' beta = .1, +#' ratio = 1, +#' stratum_prev = tibble(Stratum = c("biomarker positive", "biomarker negative"), prevalence = c(.4, .6)), +#' weight = "ss", +#' upper = gs_spending_bound,lower = gs_b, +#' upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), +#' lpar = rep(-Inf, 2) +#' ) +#' +gs_design_rd <- function( + p_c = tibble(Stratum = "All", Rate = .2), + p_e = tibble(Stratum = "All", Rate = .15), + IF = 1:3/3, + rd0 = 0, + alpha = .025, + beta = .1, + ratio = 1, + stratum_prev = NULL, + weight = c("un-stratified", "ss", "invar"), + upper = gs_b, + lower = gs_b, + upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, + lpar = c(qnorm(.1), rep(-Inf, 2)), + test_upper = TRUE, + test_lower = TRUE, + info_scale = c(0, 1, 2), + binding = FALSE, + r = 18, + tol = 1e-6, + h1_spending = FALSE +){ + # --------------------------------------------- # + # check input values # + # --------------------------------------------- # + info_scale <- if(methods::missingArg(info_scale)){2}else{match.arg(as.character(info_scale), choices = 0:2)} + weight <- if(methods::missingArg(weight)){"un-stratified"}else{match.arg(weight)} + n_strata <- length(unique(p_c$Stratum)) + if(methods::missingArg(IF)){ + k <- 1 + }else{ + k <- length(IF) + } + + # --------------------------------------------- # + # calculate the sample size # + # under fixed design # + # --------------------------------------------- # + x_fix <- gs_info_rd( + p_c = p_c, + p_e = p_e, + N = tibble(Analysis = 1, + Stratum = p_c$Stratum, + N = if(is.null(stratum_prev)){1}else{(stratum_prev %>% mutate(x = prevalence / sum(prevalence)))$x}), + rd0 = rd0, + ratio = ratio, + weight = weight) + + # --------------------------------------------- # + # calculate the sample size # + # under group sequential design # + # --------------------------------------------- # + x_gs <- gs_info_rd( + p_c = p_c, + p_e = p_e, + N = tibble(Analysis = rep(1:k, n_strata), + Stratum = rep(p_c$Stratum, each = k), + N = if(is.null(stratum_prev)){ + IF + }else{ + rep((stratum_prev %>% mutate(x = prevalence / sum(prevalence)))$x, each = k) * IF + }), + rd0 = rd0, + ratio = ratio, + weight = weight) + + if(k == 1){ + x <- x_fix + }else{ + x <- x_gs + } + + if(h1_spending){ + theta1 <- x$theta + info1 <- x$info + }else{ + theta1 <- 0 + info1 <- x$info0 + } + + y_gs <- gs_design_npe(theta = x$rd, theta1 = theta1, + info = x$info1, info0 = x$info0, info1 = info1, + info_scale = info_scale, + alpha = alpha, beta = beta, binding = binding, + upper = upper, upar = upar, test_upper = test_upper, + lower = lower, lpar = lpar, test_lower = test_lower, + r = r, tol = tol) + + + + + # --------------------------------------------- # + # get statistical information # + # --------------------------------------------- # + allout <- y_gs %>% + mutate(rd = x_fix$rd, + rd0 = rd0, + "~Risk difference at bound" = Z / sqrt(info) / theta * (rd -rd0) + rd0, + "Nominal p" = pnorm(-Z), + IF0 = if(sum(!is.na(info0)) == 0){NA}else{info0 / max(info0)}, + N = (y_gs %>% filter(Bound == "Upper", Analysis == k))$info + / ifelse(info_scale == 0, x_fix$info0[1], x_fix$info1[1]) * IF) %>% + select(c(Analysis, Bound, N, rd, rd0, Z, Probability, Probability0, info, info0, IF, IF0, `~Risk difference at bound`, `Nominal p`)) %>% + arrange(Analysis, desc(Bound)) + + # --------------------------------------------- # + # get bounds to output # + # --------------------------------------------- # + bounds <- allout %>% + select(Analysis, Bound, Probability, Probability0, Z, `~Risk difference at bound`, `Nominal p`) + + # --------------------------------------------- # + # get analysis summary to output # + # --------------------------------------------- # + analysis <- allout %>% + filter(Bound == "Upper") %>% + select(Analysis, N, rd, rd0, info, info0, IF, IF0) + + # --------------------------------------------- # + # return the output # + # --------------------------------------------- # + ans <- list( + bounds = bounds, + analysis = analysis) + + class(ans) <- c("rd", "gs_design", class(ans)) + + return(ans) +} diff --git a/R/gs_design_wlr.R b/R/gs_design_wlr.R new file mode 100644 index 000000000..721905bdc --- /dev/null +++ b/R/gs_design_wlr.R @@ -0,0 +1,234 @@ +# Copyright (c) 2021 Merck Sharp & Dohme Corp. a subsidiary of Merck & Co., Inc., Kenilworth, NJ, USA. +# +# This file is part of the gsdmvn program. +# +# gsdmvn is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +#' Group sequential design using weighted log-rank test under non-proportional hazards +#' +#' @import tibble tibble +#' @inheritParams gs_design_ahr +#' @inheritParams gs_info_wlr +#' @section Specification: +#' \if{latex}{ +#' \itemize{ +#' \item Validate if input analysisTimes is a positive number or a positive increasing sequence. +#' \item Validate if input IF is a positive number or positive increasing sequence on (0, 1] with final value of 1. +#' \item Validate if inputs IF and analysisTimes have the same length if both have length > 1. +#' \item Compute information at input analysisTimes using \code{gs_info_wlr()}. +#' \item Compute sample size and bounds using \code{gs_design_npe()}. +#' \item Return a list of design enrollment, failure rates, and bounds. +#' } +#' } +#' \if{html}{The contents of this section are shown in PDF user manual only.} +#' +#' @export +#' +#' @examples +#' library(dplyr) +#' library(mvtnorm) +#' library(gsDesign) +#' library(tibble) +#' library(gsDesign2) +#' +#' # set enrollment rates +#' enrollRates <- tibble(Stratum = "All", duration = 12, rate = 500/12) +#' +#' # set failure rates +#' failRates <- tibble( +#' Stratum = "All", +#' duration = c(4, 100), +#' failRate = log(2) / 15, # median survival 15 month +#' hr = c(1, .6), +#' dropoutRate = 0.001) +#' +#' # -------------------------# +#' # example 1 # +#' # ------------------------ # +#' # Boundary is fixed +#' x <- gsSurv( +#' k = 3, +#' test.type = 4, +#' alpha = 0.025, beta = 0.2, +#' astar = 0, timing = 1, +#' sfu = sfLDOF, sfupar = 0, +#' sfl = sfLDOF, sflpar = 0, +#' lambdaC = 0.1, +#' hr = 0.6, hr0 = 1, +#' eta = 0.01, gamma = 10, +#' R = 12, S = NULL, +#' T = 36, minfup = 24, +#' ratio = 1) +#' +#' gs_design_wlr( +#' enrollRates = enrollRates, +#' failRates = failRates, +#' ratio = 1, +#' alpha = 0.025, beta = 0.2, +#' weight = function(x, arm0, arm1){wlr_weight_fh(x, arm0, arm1, rho = 0, gamma = 0.5)}, +#' upper = gs_b, +#' upar = x$upper$bound, +#' lower = gs_b, +#' lpar = x$lower$bound, +#' analysisTimes = c(12, 24, 36)) +#' +#' # -------------------------# +#' # example 2 # +#' # ------------------------ # +#' # Boundary derived by spending function +#' gs_design_wlr( +#' enrollRates = enrollRates, +#' failRates = failRates, +#' ratio = 1, +#' alpha = 0.025, beta = 0.2, +#' weight = function(x, arm0, arm1){wlr_weight_fh(x, arm0, arm1, rho = 0, gamma = 0.5)}, +#' upper = gs_spending_bound, +#' upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025), +#' lower = gs_spending_bound, +#' lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.2), +#' analysisTimes = c(12, 24, 36)) +#' +gs_design_wlr <- function(enrollRates = tibble(Stratum = "All", duration = c(2, 2, 10), + rate = c(3, 6, 9)), + failRates = tibble(Stratum = "All", duration = c(3, 100), + failRate = log(2)/c(9, 18), hr = c(.9, .6), + dropoutRate = rep(.001, 2)), + weight = wlr_weight_fh, approx = "asymptotic", + alpha = 0.025, beta = 0.1, ratio = 1, + IF = NULL, info_scale = c(0, 1, 2), + analysisTimes = 36, + binding = FALSE, + upper = gs_b, + upar = gsDesign(k = 3, test.type = 1, n.I = c(.25, .75, 1), sfu = sfLDOF, sfupar = NULL)$upper$bound, + lower = gs_b, + lpar = c(qnorm(.1), -Inf, -Inf), + test_upper = TRUE, + test_lower = TRUE, + h1_spending = TRUE, + r = 18, tol = 1e-6 +){ + # --------------------------------------------- # + # check input values # + # --------------------------------------------- # + msg <- "gs_design_wlr(): analysisTimes must be a positive number or positive increasing sequence" + if (!is.vector(analysisTimes,mode = "numeric")) stop(msg) + if (min(analysisTimes - dplyr::lag(analysisTimes, def = 0)) <= 0) stop(msg) + msg <- "gs_design_wlr(): IF must be a positive number or positive increasing sequence on (0, 1] with final value of 1" + if (is.null(IF)){IF <- 1} + if (!is.vector(IF,mode = "numeric")) stop(msg) + if (min(IF - dplyr::lag(IF, def = 0)) <= 0) stop(msg) + if (max(IF) != 1) stop(msg) + msg <- "gs_design_wlr(): IF and analysisTimes must have the same length if both have length > 1" + if ((length(analysisTimes) > 1) & (length(IF) > 1) & (length(IF) != length(analysisTimes))) stop(msg) + # get the info_scale + info_scale <- if(methods::missingArg(info_scale)){2}else{match.arg(as.character(info_scale), choices = 0:2)} + + # --------------------------------------------- # + # get information at input analysisTimes # + # --------------------------------------------- # + y <- gs_info_wlr(enrollRates, failRates, ratio = ratio, events = NULL, + analysisTimes = analysisTimes, weight = weight, approx = approx) + + finalEvents <- y$Events[nrow(y)] + IFalt <- y$Events / finalEvents + + # Check if IF needed for (any) IA timing + K <- max(length(analysisTimes), length(IF)) + nextTime <- max(analysisTimes) + + if(length(IF) == 1){ + IF <- IFalt + }else{ + IFindx <- IF[1 : (K-1)] + for(i in seq_along(IFindx)){ + if(length(IFalt) == 1){ + y <- rbind(tEvents(enrollRates, failRates, + targetEvents = IF[K - i] * finalEvents, + ratio = ratio, interval = c(.01, nextTime)) %>% + mutate(theta = -log(AHR), Analysis = K - i), + y) + }else if(IF[K-i] > IFalt[K-i]){ + y[K - i,] <- tEvents(enrollRates, failRates, + targetEvents = IF[K - i] * finalEvents, + ratio = ratio, interval = c(.01, nextTime)) %>% + dplyr::transmute(Analysis = K - i, Time, Events, AHR, theta = -log(AHR), info, info0) + } + nextTime <- y$Time[K - i] + } + } + + y$Analysis <- 1:K + y$N <- eAccrual(x = y$Time, enrollRates = enrollRates) + + # h1 spending + if(h1_spending){ + theta1 <- y$theta + info1 <- y$info + }else{ + theta1 <- 0 + info1 <- y$info0 + } + + # --------------------------------------------- # + # combine all the calculations # + # --------------------------------------------- # + suppressMessages( + allout <- gs_design_npe(theta = y$theta, theta1 = theta1, + info = y$info, info0 = y$info0, info1 = info1, info_scale = info_scale, + alpha = alpha, beta = beta, binding = binding, + upper = upper, upar = upar, test_upper = test_upper, + lower = lower, lpar = lpar, test_lower = test_lower, + r = r, tol = tol) %>% + full_join(y %>% select(-c(info, info0, theta)), by = "Analysis") %>% + select(c("Analysis", "Bound", "Time", "N", "Events", "Z", + "Probability", "Probability0", "AHR", "theta", "info", "info0", "IF")) %>% + arrange(Analysis, desc(Bound)) + ) + + # calculate sample size & events + inflac_fct <- (allout %>% filter(Analysis == K, Bound == "Upper"))$info / (y %>% filter(Analysis == K))$info + allout$Events <- allout$Events * inflac_fct + allout$N <- allout$N * inflac_fct + + # add `~HR at bound`, `HR generic` and `Nominal p` + allout <- allout %>% mutate( + "~HR at bound" = gsDesign::zn2hr(z = Z, n = Events, ratio = ratio), + "Nominal p" = pnorm(-Z) + ) + + # --------------------------------------------- # + # return the output # + # --------------------------------------------- # + # bounds table + bounds <- allout %>% + select(all_of(c("Analysis", "Bound", "Probability", "Probability0", "Z", "~HR at bound", "Nominal p" ))) %>% + arrange(Analysis, desc(Bound)) + + # analysis table + analysis <- allout %>% + select(Analysis, Time, N, Events, AHR, theta, info, info0, IF) %>% + unique() %>% + arrange(Analysis) + + # final output + ans <- list( + enrollRates = enrollRates %>% mutate(rate = rate * inflac_fct), + failRates = failRates, + bounds = bounds, + analysis = analysis) + class(ans) <- c("wlr", "gs_design", class(ans)) + + return(ans) + +} \ No newline at end of file diff --git a/R/gs_info_ahr.R b/R/gs_info_ahr.R new file mode 100644 index 000000000..d3283f37c --- /dev/null +++ b/R/gs_info_ahr.R @@ -0,0 +1,154 @@ +# Copyright (c) 2021 Merck Sharp & Dohme Corp. a subsidiary of Merck & Co., Inc., Kenilworth, NJ, USA. +# +# This file is part of the gsdmvn program. +# +# gsdmvn is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +#' @importFrom tibble tibble +#' @importFrom dplyr lag +NULL +#' Information and effect size based on AHR approximation +#' +#' Based on piecewise enrollment rate, failure rate, and dropout rates computes +#' approximate information and effect size using an average hazard ratio model. +#' @param enrollRates enrollment rates +#' @param failRates failure and dropout rates +#' @param ratio Experimental:Control randomization ratio +#' @param events Targeted minimum events at each analysis +#' @param analysisTimes Targeted minimum study duration at each analysis +#' +#' @section Specification: +#' \if{latex}{ +#' \itemize{ +#' \item Validate if input events is a numeric value vector or a vector with increasing values. +#' \item Validate if input analysisTime is a numeric value vector or a vector with increasing values. +#' \item Validate if inputs events and analysisTime have the same length if they are both specified. +#' \item Compute average hazard ratio: +#' \itemize{ +#' \item If analysisTime is specified, calculate average hazard ratio using \code{gsDesign2::AHR()}. +#' \item If events is specified, calculate average hazard ratio using \code{gsDesign2::tEvents()}. +#' } +#' \item Return a tibble of Analysis, Time, AHR, Events, theta, info, info0. +#' } +#' } +#' \if{html}{The contents of this section are shown in PDF user manual only.} +#' +#' @return a \code{tibble} with columns \code{Analysis, Time, AHR, Events, theta, info, info0.} +#' \code{info, info0} contains statistical information under H1, H0, respectively. +#' For analysis \code{k}, \code{Time[k]} is the maximum of \code{analysisTimes[k]} and the expected time +#' required to accrue the targeted \code{events[k]}. +#' \code{AHR} is expected average hazard ratio at each analysis. +#' +#' @details The \code{AHR()} function computes statistical information at targeted event times. +#' The \code{tEvents()} function is used to get events and average HR at targeted \code{analysisTimes}. +#' +#' @export +#' +#' @examples +#' library(gsDesign) +#' library(gsDesign2) +#' +#' # ------------------------ # +#' # Example 1 # +#' # ------------------------ # +#' # Only put in targeted events +#' gs_info_ahr(events = c(30, 40, 50)) +#' +#' # ------------------------ # +#' # Example 2 # +#' # ------------------------ # +#' # Only put in targeted analysis times +#' gs_info_ahr(analysisTimes = c(18, 27, 36)) +#' +#' # ------------------------ # +#' # Example 3 # +#' # ------------------------ # +#' # Some analysis times after time at which targeted events accrue +#' # Check that both Time >= input analysisTime and Events >= input events +#' gs_info_ahr(events = c(30, 40, 50), analysisTimes = c(16, 19, 26)) +#' gs_info_ahr(events = c(30, 40, 50), analysisTimes = c(14, 20, 24)) +#' +gs_info_ahr <- function(enrollRates = tibble::tibble(Stratum = "All", + duration = c(2, 2, 10), + rate = c(3, 6, 9)), + failRates = tibble::tibble(Stratum = "All", + duration = c(3, 100), + failRate = log(2) / c(9, 18), + hr = c(.9, .6), + dropoutRate = rep(.001, 2)), + ratio = 1, # Experimental:Control randomization ratio + events = NULL, # Events at analyses + analysisTimes = NULL # Times of analyses +){ + # ----------------------------# + # check input values # + # ----------------------------# + check_enrollRates(enrollRates) + check_failRates(failRates) + check_enrollRates_failRates(enrollRates, failRates) + + if(is.null(analysisTimes) && is.null(events)){ + stop("gs_info_ahr(): One of `events` and `analysisTimes` must be a numeric value or vector with increasing values") + } + + K <- 0 + if(!is.null(analysisTimes)){ + check_analysisTimes(analysisTimes) + K <- length(analysisTimes) + } + + if (!is.null(events)){ + check_events(events) + if(K == 0){ + K <- length(events) + }else if(K != length(events)){ + stop("gs_info_ahr(): If both events and analysisTimes specified, must have same length") + } + } + + # ----------------------------# + # check input values # + # ----------------------------# + avehr <- NULL + if(!is.null(analysisTimes)){ + # calculate AHR, Events, info, info0 given the analysisTimes + avehr <- AHR(enrollRates = enrollRates, failRates = failRates, + ratio = ratio, totalDuration = analysisTimes) + # check if the output Events is larger enough than the targeted events + for(i in seq_along(events)){ + if (avehr$Events[i] < events[i]){ + avehr[i,] <- tEvents(enrollRates = enrollRates, failRates = failRates, + ratio = ratio, targetEvents = events[i]) + } + } + }else{ + for(i in seq_along(events)){ + avehr <- rbind(avehr, + gsDesign2::tEvents(enrollRates = enrollRates, failRates = failRates, + ratio = ratio, targetEvents = events[i])) + } + } + + # ----------------------------# + # compute theta # + # ----------------------------# + avehr$Analysis <- 1:nrow(avehr) + avehr$theta = -log(avehr$AHR) + + # ----------------------------# + # output results # + # ----------------------------# + ans <- avehr %>% dplyr::transmute(Analysis, Time, Events, AHR, theta, info, info0) + return(ans) +} \ No newline at end of file diff --git a/R/gs_info_combo.R b/R/gs_info_combo.R new file mode 100644 index 000000000..33ba522ed --- /dev/null +++ b/R/gs_info_combo.R @@ -0,0 +1,61 @@ +# Copyright (c) 2021 Merck Sharp & Dohme Corp. a subsidiary of Merck & Co., Inc., Kenilworth, NJ, USA. +# +# This file is part of the gsDesign2 program. +# +# gsDesign2 is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +#' Information and effect size for max combo test +#' @importFrom mvtnorm GenzBretz +#' @importFrom tibble tibble +#' @importFrom tibble tibble +#' +#' @param enrollRates enrollment rates +#' @param failRates failure and dropout rates +#' @param ratio Experimental:Control randomization ratio (not yet implemented) +#' @param events Targeted events at each analysis +#' @param analysisTimes Minimum time of analysis +#' @param rho Weighting parameters +#' @param gamma Weighting parameters +#' @param tau Weighting parameters +#' @param approx Approximation method +#' +#' @export +gs_info_combo <- function(enrollRates = tibble(Stratum = "All", + duration = c(2, 2, 10), + rate = c(3, 6, 9)), + failRates = tibble(Stratum = "All", + duration = c(3,100), + failRate = log(2) / c(9, 18), + hr = c(.9, .6), + dropoutRate = rep(.001, 2)), + ratio = 1, + events = NULL, + analysisTimes = NULL, + rho, + gamma, + tau = rep(-1, length(rho)), + approx = "asymptotic"){ + + weight <- get_combo_weight(rho, gamma, tau) + + info <- lapply(weight, function(x){ + x <- eval(parse(text = x)) + gs_info_wlr(enrollRates, failRates, ratio, events = events, analysisTimes = analysisTimes, weight = x) + }) + + info <- dplyr::bind_rows(info, .id = "test") + info$test <- as.numeric(info$test) + + return(info) +} diff --git a/R/gs_info_rd.R b/R/gs_info_rd.R new file mode 100644 index 000000000..a122857c6 --- /dev/null +++ b/R/gs_info_rd.R @@ -0,0 +1,229 @@ +# Copyright (c) 2021 Merck Sharp & Dohme Corp. a subsidiary of Merck & Co., Inc., Kenilworth, NJ, USA. +# +# This file is part of the gsdmvn program. +# +# gsdmvn is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +#' @importFrom tibble tibble +#' @importFrom dplyr lag +NULL +#' Information and effect size under risk difference +#' +#' @param p_c rate at the control group +#' @param p_e rate at the experimental group +#' @param N sample size +#' @param rd0 the risk difference under H0 +#' @param ratio Experimental:Control randomization ratio +#' @param weight weigting method, either "un-stratified" or "ss" or "invar" +#' @export +#' @examples +#' library(tibble) +#' # --------------------- # +#' # example 1 # +#' # --------------------- # +#' # un-stratified case with H0: rd0 = 0 +#' gs_info_rd( +#' p_c = tibble(Stratum = "All", Rate = .15), +#' p_e = tibble(Stratum = "All", Rate = .1), +#' N = tibble(Stratum = "All", N = c(100, 200, 300), Analysis = 1:3), +#' rd0 = 0, +#' ratio = 1 +#' ) +#' +#' # --------------------- # +#' # example 2 # +#' # --------------------- # +#' # un-stratified case with H0: rd0 != 0 +#' gs_info_rd( +#' p_c = tibble(Stratum = "All", Rate = .2), +#' p_e = tibble(Stratum = "All", Rate = .15), +#' N = tibble(Stratum = "All", N = c(100, 200, 300), Analysis = 1:3), +#' rd0 = 0.005, +#' ratio = 1 +#' ) +#' +#' # --------------------- # +#' # example 3 # +#' # --------------------- # +#' # stratified case under sample size weighting and H0: rd0 = 0 +#' gs_info_rd( +#' p_c = tibble(Stratum = c("S1", "S2", "S3"), Rate = c(.15, .2, .25)), +#' p_e = tibble(Stratum = c("S1", "S2", "S3"), Rate = c(.1, .16, .19)), +#' N = tibble(Stratum = rep(c("S1", "S2", "S3"), each = 3), +#' Analysis = rep(1:3, 3), +#' N = c(50, 100, 200, 40, 80, 160, 60, 120, 240)), +#' rd0 = 0, +#' ratio = 1, +#' weight = "ss") +#' +#' # --------------------- # +#' # example 4 # +#' # --------------------- # +#' # stratified case under inverse variance weighting and H0: rd0 = 0 +#' gs_info_rd( +#' p_c = tibble(Stratum = c("S1", "S2", "S3"), +#' Rate = c(.15, .2, .25)), +#' p_e = tibble(Stratum = c("S1", "S2", "S3"), +#' Rate = c(.1, .16, .19)), +#' N = tibble(Stratum = rep(c("S1", "S2", "S3"), each = 3), +#' Analysis = rep(1:3, 3), +#' N = c(50, 100, 200, 40, 80, 160, 60, 120, 240)), +#' rd0 = 0, +#' ratio = 1, +#' weight = "invar") +#' +#' # --------------------- # +#' # example 5 # +#' # --------------------- # +#' # stratified case under sample size weighting and H0: rd0 != 0 +#' gs_info_rd( +#' p_c = tibble(Stratum = c("S1", "S2", "S3"), +#' Rate = c(.15, .2, .25)), +#' p_e = tibble(Stratum = c("S1", "S2", "S3"), +#' Rate = c(.1, .16, .19)), +#' N = tibble(Stratum = rep(c("S1", "S2", "S3"), each = 3), +#' Analysis = rep(1:3, 3), +#' N = c(50, 100, 200, 40, 80, 160, 60, 120, 240)), +#' rd0 = 0.02, +#' ratio = 1, +#' weight = "ss") +#' +#' # --------------------- # +#' # example 6 # +#' # --------------------- # +#' # stratified case under inverse variance weighting and H0: rd0 != 0 +#' gs_info_rd( +#' p_c = tibble(Stratum = c("S1", "S2", "S3"), +#' Rate = c(.15, .2, .25)), +#' p_e = tibble(Stratum = c("S1", "S2", "S3"), +#' Rate = c(.1, .16, .19)), +#' N = tibble(Stratum = rep(c("S1", "S2", "S3"), each = 3), +#' Analysis = rep(1:3, 3), +#' N = c(50, 100, 200, 40, 80, 160, 60, 120, 240)), +#' rd0 = 0.02, +#' ratio = 1, +#' weight = "invar") +#' +#' # --------------------- # +#' # example 7 # +#' # --------------------- # +#' # stratified case under inverse variance weighting and H0: rd0 != 0 and +#' # rd0 difference for different statum +#' gs_info_rd( +#' p_c = tibble(Stratum = c("S1", "S2", "S3"), +#' Rate = c(.15, .2, .25)), +#' p_e = tibble(Stratum = c("S1", "S2", "S3"), +#' Rate = c(.1, .16, .19)), +#' N = tibble(Stratum = rep(c("S1", "S2", "S3"), each = 3), +#' Analysis = rep(1:3, 3), +#' N = c(50, 100, 200, 40, 80, 160, 60, 120, 240)), +#' rd0 = tibble(Stratum = c("S1", "S2", "S3"), +#' rd0 = c(0.01, 0.02, 0.03)), +#' ratio = 1, +#' weight = "invar") +#' +gs_info_rd <- function( + p_c = tibble::tibble(Stratum = "All", + Rate = .2), + p_e = tibble::tibble(Stratum = "All", + Rate = .15), + N = tibble::tibble(Stratum = "All", + N = c(100, 200, 300), + Analysis = 1:3), + rd0 = 0, + ratio = 1, + weight = c("un-stratified", "ss", "invar") +){ + + K <- max(N$Analysis) + weight <- match.arg(weight) + + # -------------------------------------------------# + # pool the input arguments together # + # -------------------------------------------------# + suppressMessages( + tbl <- N %>% + left_join(p_c) %>% + dplyr::rename(p_c = Rate) %>% + left_join(p_e) %>% + dplyr::rename(p_e = Rate) %>% + left_join(if("data.frame" %in% class(rd0)){rd0}else{tibble::tibble(Analysis = 1:K, rd0 = rd0)}) %>% + mutate( + N_e = N / (1 + ratio), + N_c = N * ratio / (1 + ratio), + d = ifelse(p_c > p_e, 1, -1), + p_pool_per_k_per_s = (N_c * p_c + N_e * p_e) / N, + p_e0 = (p_c + ratio * p_e - d * rd0) / (ratio + 1), + p_c0 = p_e0 + d * rd0) + ) + + + + # -------------------------------------------------# + # calculate the variance of the risk difference # + # -------------------------------------------------# + if(is.numeric(rd0) && rd0 == 0){ + tbl <- tbl %>% mutate(sigma2_H0_per_k_per_s = p_pool_per_k_per_s * (1 - p_pool_per_k_per_s) * (1 / N_c + 1 / N_e), + sigma2_H1_per_k_per_s = p_c * (1 - p_c) / N_c + p_e * (1 - p_e) / N_e) + }else if("data.frame" %in% class(rd0) || rd0 != 0){ + tbl <- tbl %>% mutate(sigma2_H0_per_k_per_s = p_c0 * (1 - p_c0) / N_c + p_e0 * (1 - p_e0) / N_e, + sigma2_H1_per_k_per_s = p_c * (1 - p_c) / N_c + p_e * (1 - p_e) / N_e) + } + + # -------------------------------------------------# + # assign weights # + # -------------------------------------------------# + if(weight == "un-stratified"){ + tbl <- tbl %>% mutate(weight_per_k_per_s = 1) + }else if(weight == "ss"){ + suppressMessages( + tbl <- tbl %>% + left_join(tbl %>% dplyr::group_by(Analysis) %>% summarize(sum_ss = sum(N_c * N_e / (N_c + N_e)))) %>% + mutate(weight_per_k_per_s = N_c * N_e / (N_c + N_e) / sum_ss ) %>% + select(-sum_ss) + ) + }else if(weight == "invar"){ + suppressMessages( + tbl <- tbl %>% + left_join(tbl %>% dplyr::group_by(Analysis) %>% summarize(sum_inv_var_per_s = sum(1/sigma2_H0_per_k_per_s))) %>% + mutate(weight_per_k_per_s = 1/sigma2_H0_per_k_per_s / sum_inv_var_per_s) %>% + select(-sum_inv_var_per_s) + ) + } + + # -------------------------------------------------# + # pool the strata together # + # -------------------------------------------------# + ans <- tbl %>% + dplyr::group_by(Analysis) %>% + summarize(N = sum(N), + rd = sum((p_c - p_e) * d * weight_per_k_per_s), + rd0 = sum(rd0 * weight_per_k_per_s), + sigma2_H0 = sum((weight_per_k_per_s^2 * p_c0 * (1 - p_c0) + + weight_per_k_per_s^2 * p_e0 * (1 - p_e0) / ratio ) * (1 + ratio)), + sigma2_H0 = sum(if(sum(rd0 == 0) == 0){ + weight_per_k_per_s^2 * p_pool_per_k_per_s * (1 - p_pool_per_k_per_s) * (1/N_c + 1/N_e) + }else{ + weight_per_k_per_s^2 * p_c0 * (1 - p_c0) / N_c + weight_per_k_per_s^2 * p_e0 * (1 - p_e0) / N_e + }), + sigma2_H1 = sum(weight_per_k_per_s^2 * p_c * (1 - p_c) / N_c + weight_per_k_per_s^2 * p_e * (1 - p_e) / N_e)) %>% + mutate(theta1 = rd / sqrt(sigma2_H1), + theta0 = rd0 / sqrt(sigma2_H0), + info1 = 1 / sigma2_H1, + info0 = 1 / sigma2_H0) %>% + dplyr::ungroup() %>% + select(Analysis, N, rd, rd0, theta1, theta0, info1, info0) + + return(ans) +} diff --git a/R/gs_info_wlr.R b/R/gs_info_wlr.R new file mode 100644 index 000000000..e841d83bb --- /dev/null +++ b/R/gs_info_wlr.R @@ -0,0 +1,303 @@ +# Copyright (c) 2021 Merck Sharp & Dohme Corp. a subsidiary of Merck & Co., Inc., Kenilworth, NJ, USA. +# +# This file is part of the gsdmvn program. +# +# gsdmvn is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +### +# Weighted log-rank test +### + +#' For a subject in the provided arm, calculate the probability he or +#' she is observed to be at risk at time=teval after enrollment. +#' @noRd +prob_risk <- function(arm, teval, tmax) { + if(is.null(tmax)){ + tmax <- arm$total_time + } + + npsurvSS::psurv(teval, arm, lower.tail = F) * + npsurvSS::ploss(teval, arm, lower.tail = F) * + npsurvSS::paccr(pmin(arm$accr_time, tmax - teval), arm) +} + +#' For a subject in the provided arm, calculate the density of event +#' at time=teval after enrollment. +#' @noRd +dens_event <- function(arm, teval, tmax = NULL) { + + if(is.null(tmax)){ + tmax <- arm$total_time + } + + npsurvSS::dsurv(teval, arm) * + npsurvSS::ploss(teval, arm, lower.tail = F) * + npsurvSS::paccr(pmin(arm$accr_time, tmax - teval), arm) +} + +#' For a subject in the provided arm, calculate the probability he or +#' she is observed to have experienced an event by time=teval after enrollment. +#' @noRd +prob_event <- function(arm, tmin = 0, tmax = arm$total_time) { + UseMethod("prob_event", arm) +} + +#' prob_event for arm of class "arm" +#' @noRd +prob_event.arm <- function(arm, tmin = 0, tmax = arm$total_time) { + l = length(tmax) + if (l == 1) { + return(stats::integrate(function(x) dens_event(arm, x, tmax = tmax), lower = tmin, upper = tmax)$value) + } else { + if (length(tmin) == 1) { + tmin = rep(tmin, l) + } + return(sapply(seq(l), function(i) prob_event(arm, tmin[i], tmax[i]))) + } +} + +#' @noRd +gs_delta_wlr <- function(arm0, + arm1, + tmax = NULL, + weight= wlr_weight_fh, + approx="asymptotic", + normalization = FALSE) { + + if(is.null(tmax)){ + tmax <- arm0$total_time + } + + p1 <- arm1$size / (arm0$size + arm1$size) + p0 <- 1 - p1 + + if (approx == "event driven") { + + if (sum(arm0$surv_shape != arm1$surv_shape) > 0 | + length( unique(arm1$surv_scale / arm0$surv_scale) ) > 1) { + + stop("gs_delta_wlr(): Hazard is not proportional over time.", call. = F) + + } else if (wlr_weight_fh(seq(0,tmax,length.out = 10), arm0, arm1) != "1") { + + stop("gs_delta_wlr(): Weight must equal `1`.", call. = F) + } + + theta <- c(arm0$surv_shape * log( arm1$surv_scale / arm0$surv_scale ))[1] # log hazard ratio + nu <- p0 * prob_event(arm0, tmax = tmax) + p1 * prob_event(arm1, tmax = tmax) # probability of event + delta <- theta * p0 * p1 * nu + + } else if (approx == "asymptotic") { + + delta <- stats::integrate(function(x){ + + term0 <- p0 * prob_risk(arm0, x, tmax) + term1 <- p1 * prob_risk(arm1, x, tmax) + term <- (term0 * term1) / (term0 + term1) + term <- ifelse(is.na(term), 0, term) + weight(x, arm0, arm1) * term * ( npsurvSS::hsurv(x, arm1) - npsurvSS::hsurv(x, arm0) )}, + lower = 0, + upper = tmax, rel.tol = 1e-5)$value + + + } else if (approx == "generalized schoenfeld") { + + delta <- stats::integrate(function(x){ + + if(normalization){ + log_hr_ratio <- 1 + }else{ + log_hr_ratio <- log( npsurvSS::hsurv(x, arm1) / npsurvSS::hsurv(x, arm0) ) + } + + weight(x, arm0, arm1) * + log_hr_ratio * + p0 * prob_risk(arm0, x, tmax) * p1 * prob_risk(arm1, x, tmax) / + ( p0 * prob_risk(arm0, x, tmax) + p1 * prob_risk(arm1, x, tmax) )^2 * + ( p0 * dens_event(arm0, x, tmax) + p1 * dens_event(arm1, x, tmax))}, + lower = 0, + upper = tmax)$value + } else { + + stop("gs_delta_wlr(): Please specify a valid approximation for the mean.", call. = F) + + } + + return(delta) + +} + +#' @noRd +gs_sigma2_wlr <- function(arm0, + arm1, + tmax = NULL, + weight= wlr_weight_fh, + approx="asymptotic") { + + if(is.null(tmax)){ + tmax <- arm0$total_time + } + + p1 <- arm1$size / (arm0$size + arm1$size) + p0 <- 1 - p1 + + if (approx == "event driven") { + + nu <- p0 * prob_event(arm0, tmax = tmax) + p1 * prob_event(arm1, tmax = tmax) + sigma2 <- p0 * p1 * nu + + } else if (approx %in% c("asymptotic", "generalized schoenfeld")) { + + sigma2 <- stats::integrate(function(x) weight(x, arm0, arm1)^2 * + p0 * prob_risk(arm0, x, tmax) * p1 * prob_risk(arm1, x, tmax) / + ( p0 * prob_risk(arm0, x, tmax) + p1 * prob_risk(arm1, x, tmax) )^2 * + ( p0 * dens_event(arm0, x, tmax) + p1 * dens_event(arm1, x, tmax)), + lower = 0, + upper= tmax)$value + + } else { + stop("gs_sigma2_wlr(): Please specify a valid approximation for the mean.", call. = F) + } + + return(sigma2) + +} + +#' Information and effect size for Weighted Log-rank test +#' +#' Based on piecewise enrollment rate, failure rate, and dropout rates computes +#' approximate information and effect size using an average hazard ratio model. +#' @param enrollRates enrollment rates +#' @param failRates failure and dropout rates +#' @param ratio Experimental:Control randomization ratio +#' @param events Targeted minimum events at each analysis +#' @param analysisTimes Targeted minimum study duration at each analysis +#' @param weight weight of weighted log rank test +#' - `"1"`=unweighted, +#' - `"n"`=Gehan-Breslow, +#' - `"sqrtN"`=Tarone-Ware, +#' - `"FH_p[a]_q[b]"`= Fleming-Harrington with p=a and q=b +#' @param approx approximate estimation method for Z statistics +#' - `"event driven"` = only work under proportional hazard model with log rank test +#' - `"asymptotic"` +#' +#' @return a \code{tibble} with columns \code{Analysis, Time, N, Events, AHR, delta, sigma2, theta, info, info0.} +#' \code{info, info0} contains statistical information under H1, H0, respectively. +#' For analysis \code{k}, \code{Time[k]} is the maximum of \code{analysisTimes[k]} and the expected time +#' required to accrue the targeted \code{events[k]}. +#' \code{AHR} is expected average hazard ratio at each analysis. +#' +#' @details The \code{AHR()} function computes statistical information at targeted event times. +#' The \code{tEvents()} function is used to get events and average HR at targeted \code{analysisTimes}. +#' +#' @export +#' +gs_info_wlr <- function(enrollRates=tibble::tibble(Stratum="All", + duration=c(2,2,10), + rate=c(3,6,9)), + failRates=tibble::tibble(Stratum="All", + duration=c(3,100), + failRate=log(2)/c(9,18), + hr=c(.9,.6), + dropoutRate=rep(.001,2)), + ratio=1, # Experimental:Control randomization ratio + events = NULL, # Events at analyses + analysisTimes = NULL, # Times of analyses + weight = wlr_weight_fh, + approx = "asymptotic" +){ + + if (is.null(analysisTimes) && is.null(events)){ + stop("gs_info_wlr(): One of events and analysisTimes must be a numeric value or vector with increasing values!") + } + + # Obtain Analysis time + avehr <- NULL + if(!is.null(analysisTimes)){ + avehr <- gsDesign2::AHR(enrollRates = enrollRates, failRates = failRates, ratio = ratio, + totalDuration = analysisTimes) + for(i in seq_along(events)){ + if (avehr$Events[i] < events[i]){ + avehr[i,] <- gsDesign2::tEvents(enrollRates = enrollRates, failRates = failRates, ratio = ratio, + targetEvents = events[i]) + } + } + }else{ + for(i in seq_along(events)){ + avehr <- rbind(avehr, + gsDesign2::tEvents(enrollRates = enrollRates, failRates = failRates, ratio = ratio, + targetEvents = events[i])) + } + } + + time <- avehr$Time + + # Create Arm object + gs_arm <- gs_create_arm(enrollRates, failRates, ratio) + + arm0 <- gs_arm$arm0 + arm1 <- gs_arm$arm1 + + + + # Randomization ratio + p0 <- arm0$size/(arm0$size + arm1$size) + p1 <- 1 - p0 + + # Null arm + arm_null <- arm0 + arm_null$surv_scale <- p0* arm0$surv_scale + p1 * arm1$surv_scale + + arm_null1 <- arm_null + arm_null1$size <- arm1$size + + delta <- c() # delta of effect size in each analysis + sigma2_h1 <- c() # sigma square of effect size in each analysis under null + sigma2_h0 <- c() # sigma square of effect size in each analysis under alternative + p_event <- c() # probability of events in each analysis + p_subject <- c() # probability of subjects enrolled + num_log_ahr <- c() + dem_log_ahr <- c() + + # Used to calculate average hazard ratio + arm01 <- arm0; arm01$size <- 1 + arm11 <- arm1; arm11$size <- 1 + + for(i in seq_along(time)){ + t <- time[i] + p_event[i] <- p0 * prob_event.arm(arm0, tmax = t) + p1 * prob_event.arm(arm1, tmax = t) + p_subject[i] <- p0 * npsurvSS::paccr(t, arm0) + p1 * npsurvSS::paccr(t, arm1) + delta[i] <- gs_delta_wlr(arm0, arm1, tmax = t, weight = weight, approx = approx) + num_log_ahr[i] <- gs_delta_wlr(arm01, arm11, tmax = t, weight = weight, approx = approx) + dem_log_ahr[i] <- gs_delta_wlr(arm01, arm11, tmax = t, weight = weight, + approx = "generalized schoenfeld", normalization = TRUE) + + sigma2_h1[i] <- gs_sigma2_wlr(arm0, arm1, tmax = t, weight = weight, approx = approx) + sigma2_h0[i] <- gs_sigma2_wlr(arm_null, arm_null1, tmax = t, weight = weight, approx = approx) + } + + N <- tail(avehr$Events / p_event,1) * p_subject + theta <- (- delta) / sigma2_h1 + data.frame(Analysis = 1:length(time), + Time = time, + N = N, + Events = avehr$Events, + AHR = exp(num_log_ahr/dem_log_ahr), + delta = delta, + sigma2 = sigma2_h1, + theta = theta, + info = sigma2_h1 * N, + info0 = sigma2_h0 * N) + +} diff --git a/R/gs_power_ahr.R b/R/gs_power_ahr.R new file mode 100644 index 000000000..6ddea6d09 --- /dev/null +++ b/R/gs_power_ahr.R @@ -0,0 +1,204 @@ +# Copyright (c) 2021 Merck Sharp & Dohme Corp. a subsidiary of Merck & Co., Inc., Kenilworth, NJ, USA. +# +# This file is part of the gsdmvn program. +# +# gsdmvn is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +#' @importFrom tibble tibble +#' @importFrom gsDesign gsDesign sfLDOF +#' @importFrom stats qnorm +#' @importFrom dplyr select arrange desc right_join +NULL + +#' Group sequential design power using average hazard ratio under non-proportional hazards +#' +#' @param enrollRates enrollment rates +#' @param failRates failure and dropout rates +#' @param ratio Experimental:Control randomization ratio (not yet implemented) +#' @param events Targeted events at each analysis +#' @param analysisTimes Minimum time of analysis +#' @param binding indicator of whether futility bound is binding; default of FALSE is recommended +#' @param info_scale the information scale for calculation +#' @param upper Function to compute upper bound +#' @param upar Parameter passed to \code{upper()} +#' @param lower Function to compute lower bound +#' @param lpar Parameter passed to \code{lower()} +#' @param 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 \code{info} should indicate which analyses will have an efficacy bound +#' @param 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 \code{info} should indicate which analyses will have a +#' lower bound +#' @param r Integer, at least 2; default of 18 recommended by Jennison and Turnbull +#' @param tol Tolerance parameter for boundary convergence (on Z-scale) +#' +#' @section Specification: +#' \if{latex}{ +#' \itemize{ +#' \item Calculate information and effect size based on AHR approximation using \code{gs_info_ahr()}. +#' \item Return a tibble of with columns Analysis, Bound, Z, Probability, theta, +#' Time, AHR, Events and contains a row for each analysis and each bound. +#' } +#' } +#' \if{html}{The contents of this section are shown in PDF user manual only.} +#' +#' @return a \code{tibble} with columns \code{Analysis, Bound, Z, Probability, theta, Time, AHR, Events}. +#' Contains a row for each analysis and each bound. +#' +#' @details +#' Bound satisfy input upper bound specification in \code{upper, upar} and lower bound specification in \code{lower, lpar}. +#' The \code{AHR()} function computes statistical information at targeted event times. +#' The \code{tEvents()} function is used to get events and average HR at targeted \code{analysisTimes}. +#' +#' @export +#' +#' @examples +#' library(gsDesign2) +#' library(dplyr) +#' +#' # -------------------------# +#' # example 1 # +#' # ------------------------ # +#' # The default output of \code{gs_power_ahr} is driven by events, i.e., +#' # \code{events = c(30, 40, 50), analysisTimes = NULL} +#' gs_power_ahr() +#' +#' # -------------------------# +#' # example 2 # +#' # -------------------------# +#' # 2-sided symmetric O'Brien-Fleming spending bound, +#' # driven by analysis time, i.e., \code{events = NULL, analysisTimes = c(12, 24, 36)} +#' gs_power_ahr( +#' analysisTimes = c(12, 24, 36), +#' events = NULL, +#' 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)) +#' +#' # -------------------------# +#' # example 3 # +#' # -------------------------# +#' # 2-sided symmetric O'Brien-Fleming spending bound, +#' # driven by events, i.e., \code{events = c(20, 50, 70), analysisTimes = NULL} +#' gs_power_ahr( +#' analysisTimes = NULL, +#' events = c(20, 50, 70), +#' 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)) +#' +#' # -------------------------# +#' # example 4 # +#' # -------------------------# +#' # 2-sided symmetric O'Brien-Fleming spending bound, +#' # driven by both `events` and `analysisTimes`, i.e., +#' # both `events` and `analysisTimes` are not `NULL`, +#' # then the analysis will driven by the maximal one, i.e., +#' # Time = max(analysisTime, calculated Time for targeted events) +#' # Events = max(events, calculated events for targeted analysisTime) +#' gs_power_ahr( +#' analysisTimes = c(12, 24, 36), +#' events = c(30, 40, 50), +#' 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)) +#' +gs_power_ahr <- function(enrollRates = tibble(Stratum = "All", duration = c(2, 2, 10), rate = c(3, 6, 9)), + failRates = tibble(Stratum = "All", duration = c(3, 100), failRate = log(2)/c(9, 18), + hr = c(.9, .6), dropoutRate = rep(.001, 2)), + events = c(30, 40, 50), + analysisTimes = NULL, + upper = gs_b, + upar = gsDesign(k = length(events), test.type = 1, n.I = events, maxn.IPlan = max(events), sfu = sfLDOF, sfupar = NULL)$upper$bound, + lower = gs_b, + lpar = c(qnorm(.1), rep(-Inf, 2)), + test_lower = TRUE, + test_upper = TRUE, + ratio = 1, binding = FALSE, info_scale = c(0, 1, 2), r = 18, tol = 1e-6 + ){ + + # get the number of analysis + K <- max(length(events), length(analysisTimes), na.rm = TRUE) + + # get the info_scale + info_scale <- if(methods::missingArg(info_scale)){2}else{match.arg(as.character(info_scale), choices = 0:2)} + + # check if it is two-sided design or not + if(identical(lower, gs_b) & (!is.list(lpar))){ + two_sided <- ifelse(identical(lpar, rep(-Inf, K)), FALSE, TRUE) + }else{ + two_sided <- TRUE + } + # ---------------------------------------- # + # calculate the asymptotic variance # + # and statistical information # + # ---------------------------------------- # + x <- gs_info_ahr(enrollRates = enrollRates, failRates = failRates, + ratio = ratio, events = events, analysisTimes = analysisTimes) + + # ---------------------------------------- # + # given the above statistical information # + # calculate the power # + # ---------------------------------------- # + y_H1 <- gs_power_npe(theta = x$theta, + info = x$info, info0 = x$info0, info_scale = info_scale, + upper = upper, upar = upar, test_upper = test_upper, + lower = lower, lpar = lpar, test_lower = test_lower, + binding = binding, r = r, tol = tol) + + y_H0 <- gs_power_npe(theta = 0, + info = x$info0, info0 = x$info0, info_scale = info_scale, + upper = upper, upar = upar, test_upper = test_upper, + lower = if(!two_sided){gs_b}else{lower}, + lpar = if(!two_sided){rep(-Inf, K)}else{lpar}, + test_lower = test_lower, + binding = binding, r = r, tol = tol) + + # ---------------------------------------- # + # organize the outputs # + # ---------------------------------------- # + # summarize the bounds + suppressMessages( + bounds <- y_H1 %>% + mutate(`~HR at bound` = exp(-Z / sqrt(info)), `Nominal p` = pnorm(-Z)) %>% + left_join( + y_H0 %>% + select(Analysis, Bound, Probability) %>% + dplyr::rename(Probability0 = Probability)) %>% + select(Analysis, Bound, Probability, Probability0, Z, `~HR at bound`, `Nominal p`) %>% + arrange(Analysis, desc(Bound)) + ) + # summarize the analysis + suppressMessages( + analysis <- x %>% + select(Analysis, Time, Events, AHR) %>% + mutate(N = eAccrual(x = x$Time, enrollRates = enrollRates)) %>% + left_join(y_H1 %>% select(Analysis, info, IF, theta) %>% unique()) %>% + left_join(y_H0 %>% select(Analysis, info, IF) %>% dplyr::rename(info0 = info, IF0 = IF) %>% unique()) %>% + select(Analysis, Time, N, Events, AHR, theta, info, info0, IF, IF0) %>% + arrange(Analysis) + ) + + ans <- list(enrollRates = enrollRates, failRates = failRates, + bounds = bounds, analysis = analysis) + + class(ans) <- c("ahr", "gs_design", class(ans)) + + return(ans) +} diff --git a/R/gs_power_ahr_.R b/R/gs_power_ahr_.R new file mode 100644 index 000000000..043a2e9c4 --- /dev/null +++ b/R/gs_power_ahr_.R @@ -0,0 +1,114 @@ +# Copyright (c) 2021 Merck Sharp & Dohme Corp. a subsidiary of Merck & Co., Inc., Kenilworth, NJ, USA. +# +# This file is part of the gsdmvn program. +# +# gsdmvn is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +#' @importFrom tibble tibble +#' @importFrom gsDesign gsDesign sfLDOF +#' @importFrom stats qnorm +#' @importFrom dplyr select arrange desc right_join +NULL +#' Group sequential design power using average hazard ratio under non-proportional hazards +#' +#' @param enrollRates enrollment rates +#' @param failRates failure and dropout rates +#' @param ratio Experimental:Control randomization ratio (not yet implemented) +#' @param events Targeted events at each analysis +#' @param analysisTimes Minimum time of analysis +#' @param binding indicator of whether futility bound is binding; default of FALSE is recommended +#' @param upper Function to compute upper bound +#' @param upar Parameter passed to \code{upper()} +#' @param lower Function to compute lower bound +#' @param lpar Parameter passed to \code{lower()} +#' @param 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 \code{info} should indicate which analyses will have an efficacy bound +#' @param 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 \code{info} should indicate which analyses will have a +#' lower bound +#' @param r Integer, at least 2; default of 18 recommended by Jennison and Turnbull +#' @param tol Tolerance parameter for boundary convergence (on Z-scale) +#' @section Specification: +#' \if{latex}{ +#' \itemize{ +#' \item Calculate information and effect size based on AHR approximation using \code{gs_info_ahr()}. +#' \item Return a tibble of with columns Analysis, Bound, Z, Probability, theta, +#' Time, AHR, Events and contains a row for each analysis and each bound. +#' } +#' } +#' \if{html}{The contents of this section are shown in PDF user manual only.} +#' +#' @return a \code{tibble} with columns \code{Analysis, Bound, Z, Probability, theta, Time, AHR, Events}. +#' Contains a row for each analysis and each bound. +#' @details +#' Bound satisfy input upper bound specification in \code{upper, upar} and lower bound specification in \code{lower, lpar}. +#' The \code{AHR()} function computes statistical information at targeted event times. +#' The \code{tEvents()} function is used to get events and average HR at targeted \code{analysisTimes}. +#' +#' @noRd +#' +#' @examples +#' library(gsDesign2) +#' library(dplyr) +#' +#' gs_power_ahr() %>% filter(abs(Z) < Inf) +#' +#' # 2-sided symmetric O'Brien-Fleming spending bound +#' # NOT CURRENTLY WORKING +#' gs_power_ahr(analysisTimes = 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)) +#' +gs_power_ahr_ <- function(enrollRates=tibble::tibble(Stratum="All", + duration=c(2,2,10), + rate=c(3,6,9)), + failRates=tibble::tibble(Stratum="All", + duration=c(3,100), + failRate=log(2)/c(9,18), + hr=c(.9,.6), + dropoutRate=rep(.001,2)), + ratio=1, # Experimental:Control randomization ratio + events = c(30, 40, 50), # Targeted events of analysis + analysisTimes = NULL, # Targeted times of analysis + binding = FALSE, + upper = gs_b, + # Default is Lan-DeMets approximation of + upar = gsDesign(k=length(events), test.type=1, + n.I=events, maxn.IPlan = max(events), + sfu=sfLDOF, sfupar = NULL)$upper$bound, + lower = gs_b, + lpar = c(qnorm(.1), rep(-Inf, length(events) - 1)), # Futility only at IA1 + test_upper = TRUE, + test_lower = TRUE, + r = 18, + tol = 1e-6 +){ + x <- gs_info_ahr(enrollRates = enrollRates, + failRates = failRates, + ratio = ratio, + events = events, + analysisTimes = analysisTimes + ) + return(gs_power_npe_(theta = x$theta, info = x$info, info0 = x$info0, binding = binding, + upper=upper, lower=lower, upar = upar, lpar= lpar, + test_upper = test_upper, test_lower = test_lower, + r = r, tol = tol) %>% + right_join(x %>% select(-c(info, info0, theta)), by = "Analysis") %>% + select(c(Analysis, Bound, Time, Events, Z, Probability, AHR, theta, info, info0)) %>% + arrange(desc(Bound), Analysis) + ) +} \ No newline at end of file diff --git a/R/gs_power_combo.R b/R/gs_power_combo.R new file mode 100644 index 000000000..7d5446733 --- /dev/null +++ b/R/gs_power_combo.R @@ -0,0 +1,235 @@ +# Copyright (c) 2021 Merck Sharp & Dohme Corp. a subsidiary of Merck & Co., Inc., Kenilworth, NJ, USA. +# +# This file is part of the gsdmvn program. +# +# gsdmvn is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +#' Group sequential design power using MaxCombo test under non-proportional hazards +#' @importFrom mvtnorm GenzBretz +#' @importFrom tibble tibble +#' +#' @inheritParams gs_design_combo +#' @inheritParams pmvnorm_combo +#' +#' @examples +#' library(dplyr) +#' library(mvtnorm) +#' library(gsDesign) +#' library(gsDesign2) +#' library(tibble) +#' +#' enrollRates <- tibble( +#' Stratum = "All", +#' duration = 12, +#' rate = 500/12) +#' +#' failRates <- tibble( +#' Stratum = "All", +#' duration = c(4, 100), +#' failRate = log(2) / 15, # median survival 15 month +#' hr = c(1, .6), +#' dropoutRate = 0.001) +#' +#' fh_test <- rbind( +#' data.frame(rho = 0, gamma = 0, tau = -1, test = 1, Analysis = 1:3, analysisTimes = c(12, 24, 36)), +#' data.frame(rho = c(0, 0.5), gamma = 0.5, tau = -1, test = 2:3, Analysis = 3, analysisTimes = 36) +#' ) +#' +#' # -------------------------# +#' # example 1 # +#' # ------------------------ # +#' # Minimal Information Fraction derived bound +#' gs_power_combo( +#' enrollRates, +#' failRates, +#' fh_test, +#' upper = gs_spending_combo, +#' upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025), +#' lower = gs_spending_combo, +#' lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.2)) +#' +#' +#' @section Specification: +#' \if{latex}{ +#' \itemize{ +#' \item Validate if lower and upper bounds have been specified. +#' \item Extract info, info_fh, theta_fh and corr_fh from utility. +#' \item Extract sample size via the maximum sample size of info. +#' \item Calculate information fraction either for fixed or group sequential design. +#' \item Compute spending function using \code{gs_bound()}. +#' \item Compute probability of crossing bounds under the null and alternative +#' hypotheses using \code{gs_prob_combo()}. +#' \item Export required information for boundary and crossing probability +#' } +#' } +#' \if{html}{The contents of this section are shown in PDF user manual only.} +#' +#' @export +gs_power_combo <- function(enrollRates = tibble(Stratum = "All", + duration = 12, + rate = 500 / 12), + failRates = tibble(Stratum = "All", + duration = c(4, 100), + failRate = log(2) / 15, + hr = c(1, .6), + dropoutRate = 0.001), + fh_test = rbind(data.frame(rho = 0, gamma = 0, tau = -1, test = 1, + Analysis = 1:3, analysisTimes = c(12, 24, 36)), + data.frame(rho = c(0, 0.5), gamma = 0.5, tau = -1, test = 2:3, + Analysis = 3, analysisTimes = 36)), + ratio = 1, + binding = FALSE, + upper = gs_b, + upar = c(3, 2, 1), + lower = gs_b, + lpar = c(-1, 0, 1), + algorithm = GenzBretz(maxpts = 1e5, abseps = 1e-5), + ...){ + + # Currently only support user defined lower and upper bound + stopifnot( identical(upper, gs_b) | identical(upper, gs_spending_combo) ) + stopifnot( identical(lower, gs_b) | identical(lower, gs_spending_combo) ) + + # --------------------------------------------- # + # get the number of analysis/test # + # --------------------------------------------- # + n_analysis <- length(unique(fh_test$Analysis)) + n_test <- max(fh_test$test) + + # Obtain utilities + utility <- gs_utility_combo(enrollRates = enrollRates, + failRates = failRates, + fh_test = fh_test, + ratio = ratio, + algorithm = algorithm, ...) + + info <- utility$info_all + info_fh <- utility$info + theta_fh <- utility$theta + corr_fh <- utility$corr + + # Sample size + n <- max(info$N) + + # Information Fraction + if(length(unique(fh_test$Analysis)) == 1){ + # Fixed design + min_info_frac <- 1 + }else{ + info_frac <- tapply(info$info0, info$test, function(x) x / max(x)) + min_info_frac <- apply(do.call(rbind, info_frac), 2, min) + } + + # Obtain spending function + bound <- gs_bound(alpha = upper(upar, min_info_frac), + beta = lower(lpar, min_info_frac), + analysis = info_fh$Analysis, + theta = theta_fh * sqrt(n), + corr = corr_fh, + binding_lower_bound = binding, + algorithm = algorithm, + alpha_bound = identical(upper, gs_b), + beta_bound = identical(lower, gs_b), + ...) + + + # Probability Cross Boundary under Alternative + prob <- gs_prob_combo(upper_bound = bound$upper, + lower_bound = bound$lower, + analysis = info_fh$Analysis, + theta = theta_fh * sqrt(n), + corr = corr_fh, + algorithm = algorithm, ...) + + # Probability Cross Boundary under Null + prob_null <- gs_prob_combo(upper_bound = bound$upper, + lower_bound = if(binding){bound$lower}else{rep(-Inf, nrow(bound))}, + analysis = info_fh$Analysis, + theta = rep(0, nrow(info_fh)), + corr = corr_fh, + algorithm = algorithm, ...) + + # if(binding == FALSE){ + # prob_null$Probability[prob_null$Bound == "Lower"] <- NA + # } + + prob$Probability_Null <- prob_null$Probability + + # Prepare output + db <- merge( + data.frame(Analysis = 1:(nrow(prob)/2), prob, Z = unlist(bound)), + info_fh %>% + tibble::as_tibble() %>% + select(Analysis, Time, N, Events) %>% + unique()) %>% + arrange(Analysis, desc(Bound)) + + # --------------------------------------------- # + # get bounds to output # + # --------------------------------------------- # + bounds <- db %>% + dplyr::mutate(`Nominal p` = pnorm(Z * (-1))) %>% + dplyr::select(Analysis, Bound, Probability, Probability_Null, Z, `Nominal p`) %>% + dplyr::rename(Probability0 = Probability_Null) %>% + arrange(Analysis,desc(Bound)) + + # --------------------------------------------- # + # get analysis summary to output # + # --------------------------------------------- # + # check if rho, gamma = 0 is included in fh_test + tmp <- fh_test %>% + filter(rho == 0 & gamma == 0 & tau == -1) %>% + select(test) %>% + unlist() %>% + as.numeric() %>% + unique() + if(length(tmp) != 0){ + AHR_dis <- utility$info_all %>% + filter(test == tmp) %>% + select(AHR) %>% + unlist() %>% + as.numeric() + }else{ + AHR_dis <- gs_info_wlr( + enrollRates, + failRates, + ratio, + events = unique(utility$info_all$Events), + analysisTimes = unique(utility$info_all$Time), + weight = eval(parse(text = get_combo_weight(rho = 0, gamma = 0, tau = -1))))$AHR + } + + analysis <- utility$info_all %>% + select(Analysis, test, Time, N, Events) %>% + mutate(theta = utility$info_all$theta, + EF = Events/tapply(Events, test, function(x) max(x)) %>% unlist() %>% as.numeric()) %>% + select(Analysis, Time, N, Events, EF) %>% + unique() %>% + mutate(AHR = AHR_dis) %>% + mutate(N = N *n / max(info_fh$N), + Events = Events * n / max(info_fh$N)) %>% + arrange(Analysis) + + # --------------------------------------------- # + # output # + # --------------------------------------------- # + message("The AHR reported in the `analysis` table is under the log-rank test.") + output <- list( + enrollRates = enrollRates %>% mutate(rate = rate * max(analysis$N) / sum(rate * duration) ), + failRates = failRates, + bounds = bounds, + analysis = analysis) + class(output) <- c("combo", "gs_design", class(output)) + return(output) +} diff --git a/R/gs_power_npe.R b/R/gs_power_npe.R new file mode 100644 index 000000000..d12849dca --- /dev/null +++ b/R/gs_power_npe.R @@ -0,0 +1,277 @@ +# Copyright (c) 2021 Merck Sharp & Dohme Corp. a subsidiary of Merck & Co., Inc., Kenilworth, NJ, USA. +# +# This file is part of the gsdmvn program. +# +# gsdmvn is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +#' @importFrom tibble tibble +#' @importFrom stats qnorm pnorm +NULL + +#' Group sequential bound computation with non-constant effect +#' +#' \code{gs_power_npe()} derives group sequential bounds and boundary crossing probabilities for a design. +#' It allows a non-constant treatment effect over time, but also can be applied for the usual homogeneous effect size designs. +#' It requires treatment effect and statistical information at each analysis as well as a method of deriving bounds, such as spending. +#' The routine enables two things not available in the gsDesign package: 1) non-constant effect, 2) more flexibility in boundary selection. +#' For many applications, the non-proportional-hazards design function \code{gs_design_nph()} will be used; it calls this function. +#' Initial bound types supported are 1) spending bounds, 2) fixed bounds, and 3) Haybittle-Peto-like bounds. +#' The requirement is to have a boundary update method that can each bound without knowledge of future bounds. +#' As an example, bounds based on conditional power that require knowledge of all future bounds are not supported by this routine; +#' a more limited conditional power method will be demonstrated. +#' Boundary family designs Wang-Tsiatis designs including the original (non-spending-function-based) O'Brien-Fleming and Pocock designs +#' are not supported by \code{gs_power_npe()}. +#' @param theta natural parameter for group sequential design representing +#' expected incremental drift at all analyses; used for power calculation +#' @param theta0 natural parameter for null hypothesis, if needed for upper bound computation +#' @param theta1 natural parameter for alternate hypothesis, if needed for lower bound computation +#' @param info statistical information at all analyses for input \code{theta} +#' @param info0 statistical information under null hypothesis, if different than \code{info}; +#' impacts null hypothesis bound calculation +#' @param info1 statistical information under hypothesis used for futility bound calculation if different from +#' \code{info}; impacts futility hypothesis bound calculation +#' @param info_scale the information scale for calculation, default is 2, other options are 0 or 1. +#' @param binding indicator of whether futility bound is binding; default of FALSE is recommended +#' @param upper function to compute upper bound +#' @param lower function to compare lower bound +#' @param upar parameter to pass to upper +#' @param lpar parameter to pass to lower +#' @param 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 \code{info} should indicate which analyses will have an efficacy bound +#' @param test_lower indicator of which analyses should include a 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 \code{info} should indicate which analyses will have a lower bound +#' @param r Integer, at least 2; default of 18 recommended by Jennison and Turnbull +#' @param tol Tolerance parameter for boundary convergence (on Z-scale) +#' @section Specification: +#' \if{latex}{ +#' \itemize{ +#' \item Extract the length of input info as the number of interim analysis. +#' \item Validate if input info0 is NULL, so set it equal to info. +#' \item Validate if the length of inputs info and info0 are the same. +#' \item Validate if input theta is a scalar, so replicate the value for all k interim analysis. +#' \item Validate if input theta1 is NULL and if it is a scalar. If it is NULL, +#' set it equal to input theta. If it is a scalar, replicate the value for all k interim analysis. +#' \item Validate if input test_upper is a scalar, so replicate the value for all k interim analysis. +#' \item Validate if input test_lower is a scalar, so replicate the value for all k interim analysis. +#' \item Define vector a to be -Inf with length equal to the number of interim analysis. +#' \item Define vector b to be Inf with length equal to the number of interim analysis. +#' \item Define hgm1_0 and hgm1 to be NULL. +#' \item Define upperProb and lowerProb to be vectors of NA with length of the number of interim analysis. +#' \item Update lower and upper bounds using \code{gs_b()}. +#' \item If there are no interim analysis, compute proabilities of crossing upper and lower bounds +#' using \code{h1()}. +#' \item Compute cross upper and lower bound probabilities using \code{hupdate()} and \code{h1()}. +#' \item Return a tibble of analysis number, Bounds, Z-values, Probability of crossing bounds, +#' theta, theta1, info, and info0. +#' } +#' } +#' \if{html}{The contents of this section are shown in PDF user manual only.} +#' +#' @author Keaven Anderson \email{keaven_anderson@@merck.com} +#' +#' @export +#' +#' @examples +#' library(gsDesign) +#' library(gsDesign2) +#' library(dplyr) +#' +#' # Default (single analysis; Type I error controlled) +#' gs_power_npe(theta = 0) %>% filter(Bound == "Upper") +#' +#' # Fixed bound +#' gs_power_npe( +#' theta = c(.1, .2, .3), +#' info = (1:3) * 40, +#' upper = gs_b, +#' upar = gsDesign::gsDesign(k = 3,sfu = gsDesign::sfLDOF)$upper$bound, +#' lower = gs_b, +#' lpar = c(-1, 0, 0)) +#' +#' # Same fixed efficacy bounds, no futility bound (i.e., non-binding bound), null hypothesis +#' gs_power_npe( +#' theta = rep(0, 3), +#' info = (1:3) * 40, +#' upar = gsDesign::gsDesign(k = 3,sfu = gsDesign::sfLDOF)$upper$bound, +#' lpar = rep(-Inf, 3)) %>% +#' filter(Bound == "Upper") +#' +#' # Fixed bound with futility only at analysis 1; efficacy only at analyses 2, 3 +#' gs_power_npe( +#' theta = c(.1, .2, .3), +#' info = (1:3) * 40, +#' upper = gs_b, +#' upar = c(Inf, 3, 2), +#' lower = gs_b, +#' lpar = c(qnorm(.1), -Inf, -Inf)) +#' +#' # Spending function bounds +#' # Lower spending based on non-zero effect +#' gs_power_npe( +#' theta = c(.1, .2, .3), +#' info = (1:3) * 40, +#' upper = gs_spending_bound, +#' upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), +#' lower = gs_spending_bound, +#' lpar = list(sf = gsDesign::sfHSD, total_spend = 0.1, param = -1, timing = NULL)) +#' +#' # Same bounds, but power under different theta +#' gs_power_npe( +#' theta = c(.15, .25, .35), +#' info = (1:3) * 40, +#' upper = gs_spending_bound, +#' upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), +#' lower = gs_spending_bound, +#' lpar = list(sf = gsDesign::sfHSD, total_spend = 0.1, param = -1, timing = NULL)) +#' +#' # Two-sided symmetric spend, O'Brien-Fleming spending +#' # Typically, 2-sided bounds are binding +#' x <- gs_power_npe( +#' theta = rep(0, 3), +#' info = (1:3) * 40, +#' binding = TRUE, +#' upper = gs_spending_bound, +#' upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), +#' lower = gs_spending_bound, +#' lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL)) +#' +#' # Re-use these bounds under alternate hypothesis +#' # Always use binding = TRUE for power calculations +#' gs_power_npe( +#' theta = c(.1, .2, .3), +#' info = (1:3) * 40, +#' binding = TRUE, +#' upar = (x %>% filter(Bound == "Upper"))$Z, +#' lpar = -(x %>% filter(Bound == "Upper"))$Z) + +gs_power_npe <- function(theta = .1, theta0 = NULL, theta1 = NULL, # 3 theta + info = 1, info0 = NULL, info1 = NULL, # 3 info + info_scale = c(0, 1, 2), + upper = gs_b, upar = qnorm(.975), + lower = gs_b, lpar = -Inf, + test_upper = TRUE, test_lower = TRUE, binding = FALSE, + r = 18, tol = 1e-6){ + + # --------------------------------------------- # + # check & set up parameters # + # --------------------------------------------- # + K <- length(info) + if (length(theta) == 1 && K > 1) theta <- rep(theta, K) + if (is.null(theta0)){theta0 <- rep(0, K)}else if(length(theta0) == 1){theta0 <- rep(theta0, K)} + if (is.null(theta1)){theta1 <- theta}else if(length(theta1) == 1){theta1 <- rep(theta1, K)} + if (length(test_upper) == 1 && K > 1) test_upper <- rep(test_upper, K) + if (length(test_lower) == 1 && K > 1) test_lower <- rep(test_lower, K) + + # --------------------------------------------- # + # set up info # + # --------------------------------------------- # + # impute info + if(is.null(info0)){ + info0 <- info + } + + if(is.null(info1)){ + info1 <- info + } + + # set up info_scale + info_scale <- if(methods::missingArg(info_scale)){2}else{match.arg(as.character(info_scale), choices = 0:2)} + if(info_scale == 0){ + info <- info0 + info1 <- info0 + } + if(info_scale == 1){ + info <- info1 + info0 <- info1 + } + + # check info + check_info(info) + check_info(info0) + check_info(info1) + if(length(info0) != length(info)) stop("gs_design_npe(): length of info, info0 must be the same!") + if(length(info1) != length(info)) stop("gs_design_npe(): length of info, info1 must be the same!") + + + # --------------------------------------------- # + # initialization # + # --------------------------------------------- # + a <- rep(-Inf, K) + b <- rep(Inf, K) + hgm1_0 <- NULL + hgm1_1 <- NULL + hgm1 <- NULL + upperProb <- rep(NA, K) + lowerProb <- rep(NA, K) + + # --------------------------------------------- # + # calculate crossing prob under H1 # + # --------------------------------------------- # + for(k in 1:K){ + # compute/update lower/upper bound + a[k] <- lower(k = k, par = lpar, hgm1 = hgm1_1, info = info1, r = r, tol = tol, test_bound = test_lower, + theta = theta1, efficacy = FALSE) + b[k] <- upper(k = k, par = upar, hgm1 = hgm1_0, info = info0, r = r, tol = tol, test_bound = test_upper) + + # if it is the first analysis + if(k == 1){ + # compute the probability to cross upper/lower bound + upperProb[1] <- if(b[1] < Inf) {pnorm( sqrt(info[1]) * (theta[1] - b[1] / sqrt(info0[1])))}else{0} + lowerProb[1] <- if(a[1] > -Inf){pnorm(-sqrt(info[1]) * (theta[1] - a[1] / sqrt(info0[1])))}else{0} + # update the grids + hgm1_0 <- h1(r = r, theta = theta0[1], I = info0[1], a = if(binding){a[1]}else{-Inf}, b = b[1]) + hgm1_1 <- h1(r = r, theta = theta1[1], I = info1[1], a = a[1], b = b[1]) + hgm1 <- h1(r = r, theta = theta[1], I = info[1], a = a[1], b = b[1]) + }else{ + # compute the probability to cross upper bound + upperProb[k] <- if(b[k]< Inf){ + sum(hupdate(theta = theta[k], thetam1 = theta[k - 1], + I = info[k], Im1 = info[k - 1], + a = b[k], b = Inf, gm1 = hgm1, r = r)$h) + }else{0} + # compute the probability to cross lower bound + lowerProb[k] <- if(a[k] > -Inf){ + sum(hupdate(theta = theta[k], thetam1 = theta[k - 1], + I = info[k], Im1 = info[k - 1], + a = -Inf, b = a[k], gm1 = hgm1, r = r)$h) + }else{0} + + # update the grids + if(k < K){ + hgm1_0 <- hupdate(r = r, theta = theta0[k], I = info0[k], a = if(binding){a[k]}else{-Inf}, b = b[k], thetam1 = 0, Im1 = info0[k-1], gm1 = hgm1_0) + hgm1_1 <- hupdate(r = r, theta = theta1[k], I = info1[k], a = a[k], b = b[k], thetam1 = theta1[k-1], Im1 = info1[k-1], gm1 = hgm1_1) + hgm1 <- hupdate(r = r, theta = theta[k], I = info[k], a = a[k], b = b[k], thetam1 = theta[k-1], Im1 = info[k-1], gm1 = hgm1) + } + } + } + + ans <- tibble::tibble( + Analysis = rep(1:K, 2), + Bound = c(rep("Upper", K), rep("Lower", K)), + Z = c(b, a), + Probability = c(cumsum(upperProb), cumsum(lowerProb)), + theta = rep(theta, 2), + theta1 = rep(theta1, 2), + IF = rep(info / max(info), 2), + info = rep(info, 2)) %>% + mutate(info0 = rep(info0, 2), + info1 = rep(info1, 2)) %>% + #filter(abs(Z) < Inf) %>% + arrange(desc(Bound), Analysis) + + return(ans) +} \ No newline at end of file diff --git a/R/gs_power_npe_.R b/R/gs_power_npe_.R new file mode 100644 index 000000000..cc2701cc5 --- /dev/null +++ b/R/gs_power_npe_.R @@ -0,0 +1,267 @@ +# Copyright (c) 2021 Merck Sharp & Dohme Corp. a subsidiary of Merck & Co., Inc., Kenilworth, NJ, USA. +# +# This file is part of the gsdmvn program. +# +# gsdmvn is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +#' @importFrom tibble tibble +#' @importFrom stats qnorm pnorm +NULL +#' Group sequential bound computation with non-constant effect +#' +#' \code{gs_power_npe()} derives group sequential bounds and boundary crossing probabilities for a design. +#' It allows a non-constant treatment effect over time, but also can be applied for the usual homogeneous effect size designs. +#' It requires treatment effect and statistical information at each analysis as well as a method of deriving bounds, such as spending. +#' The routine enables two things not available in the gsDesign package: 1) non-constant effect, 2) more flexibility in boundary selection. +#' For many applications, the non-proportional-hazards design function \code{gs_design_nph()} will be used; it calls this function. +#' Initial bound types supported are 1) spending bounds, 2) fixed bounds, and 3) Haybittle-Peto-like bounds. +#' The requirement is to have a boundary update method that can each bound without knowledge of future bounds. +#' As an example, bounds based on conditional power that require knowledge of all future bounds are not supported by this routine; +#' a more limited conditional power method will be demonstrated. +#' Boundary family designs Wang-Tsiatis designs including the original (non-spending-function-based) O'Brien-Fleming and Pocock designs +#' are not supported by \code{gs_power_npe()}. +#' @param theta natural parameter for group sequential design representing +#' expected incremental drift at all analyses; used for power calculation +#' @param theta1 natural parameter for alternate hypothesis, if needed for lower bound computation +#' @param info statistical information at all analyses for input \code{theta} +#' @param info0 statistical information under null hypothesis, if different than \code{info}; +#' impacts null hypothesis bound calculation +#' @param info1 statistical information under hypothesis used for futility bound calculation if different from +#' \code{info}; impacts futility hypothesis bound calculation +#' @param binding indicator of whether futility bound is binding; default of FALSE is recommended +#' @param upper function to compute upper bound +#' @param lower function to compare lower bound +#' @param upar parameter to pass to upper +#' @param lpar parameter to pass to lower +#' @param 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 \code{info} should indicate which analyses will have an efficacy bound +#' @param test_lower indicator of which analyses should include a 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 \code{info} should indicate which analyses will have a lower bound +#' @param r Integer, at least 2; default of 18 recommended by Jennison and Turnbull +#' @param tol Tolerance parameter for boundary convergence (on Z-scale) +#' @section Specification: +#' \if{latex}{ +#' \itemize{ +#' \item Extract the length of input info as the number of interim analysis. +#' \item Validate if input info0 is NULL, so set it equal to info. +#' \item Validate if input info1 is NULL, so set it equal to info. +#' \item Validate if the length of inputs info, info0, and info1 are the same. +#' \item Validate if input theta is a scalar, so replicate the value for all k interim analysis. +#' \item Validate if input theta1 is NULL and if it is a scalar. If it is NULL, +#' set it equal to input theta. If it is a scalar, replicate the value for all k interim analysis. +#' \item Validate if input test_upper is a scalar, so replicate the value for all k interim analysis. +#' \item Validate if input test_lower is a scalar, so replicate the value for all k interim analysis. +#' \item Define vector a to be -Inf with length equal to the number of interim analysis. +#' \item Define vector b to be Inf with length equal to the number of interim analysis. +#' \item Define hgm1_0 and hgm1 to be NULL. +#' \item Define upperProb and lowerProb to be vectors of NA with length of the number of interim analysis. +#' \item Update lower and upper bounds using \code{gs_b()}. +#' \item If there are no interim analysis, compute proabilities of crossing upper and lower bounds +#' using \code{h1()}. +#' \item Compute cross upper and lower bound probabilities using \code{hupdate()} and \code{h1()}. +#' \item Return a tibble of analysis number, Bounds, Z-values, Probability of crossing bounds, +#' theta, theta1, info, info0, and info1 +#' } +#' } +#' \if{html}{The contents of this section are shown in PDF user manual only.} +#' +#' @author Keaven Anderson \email{keaven_anderson@@merck.com} +#' +#' +#' @examples +#' +#' library(gsDesign) +#' library(gsDesign2) +#' library(dplyr) +#' +#' # Default (single analysis; Type I error controlled) +#' gsDesign2:::gs_power_npe_(theta=0) %>% filter(Bound=="Upper") +#' +#' # Fixed bound +#' gsDesign2:::gs_power_npe_(theta = c(.1, .2, .3), info = (1:3) * 40, info0 = (1:3) * 40, +#' upper = gs_b, +#' upar = gsDesign::gsDesign(k = 3, +#' sfu = gsDesign::sfLDOF)$upper$bound, +#' lower = gs_b, +#' lpar = c(-1, 0, 0)) +#' +#' # Same fixed efficacy bounds, +#' # no futility bound (i.e., non-binding bound), null hypothesis +#' gsDesign2:::gs_power_npe_(theta = rep(0,3), +#' info = (1:3) * 40, +#' upar = gsDesign::gsDesign(k = 3, +#' sfu = gsDesign::sfLDOF)$upper$bound, +#' lpar = rep(-Inf, 3)) %>% filter(Bound=="Upper") +#' +#' # Fixed bound with futility only at analysis 1; +#' # efficacy only at analyses 2, 3 +#' gsDesign2:::gs_power_npe_(theta = c(.1, .2, .3), +#' info = (1:3) * 40, +#' upar = c(Inf, 3, 2), +#' lpar = c(qnorm(.1), -Inf, -Inf)) +#' +#' # Spending function bounds +#' # Lower spending based on non-zero effect +#' gsDesign2:::gs_power_npe_(theta = c(.1, .2, .3), +#' info = (1:3) * 40, +#' upper = gs_spending_bound, +#' upar = list(sf = gsDesign::sfLDOF, +#' total_spend = 0.025, +#' param = NULL, +#' timing = NULL), +#' lower = gs_spending_bound, +#' lpar = list(sf = gsDesign::sfHSD, +#' total_spend = 0.1, +#' param = -1, +#' timing = NULL)) +#' +#' # Same bounds, but power under different theta +#' gsDesign2:::gs_power_npe_(theta = c(.15, .25, .35), +#' theta1 = c(.1, .2, .3), +#' info = (1:3) * 40, +#' upper = gs_spending_bound, +#' upar = list(sf = gsDesign::sfLDOF, +#' total_spend = 0.025, +#' param = NULL, +#' timing = NULL), +#' lower = gs_spending_bound, +#' lpar = list(sf = gsDesign::sfHSD, +#' total_spend = 0.1, +#' param = -1, +#' timing = NULL)) +#' +#' # Two-sided symmetric spend, O'Brien-Fleming spending +#' # Typically, 2-sided bounds are binding +#' xx <- gsDesign2:::gs_power_npe_(theta = rep(0, 3), +#' theta1 = rep(0, 3), +#' info = (1:3) * 40, +#' upper = gs_spending_bound, +#' binding = TRUE, +#' 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)) +#' xx +#' +#' # Re-use these bounds under alternate hypothesis +#' # Always use binding = TRUE for power calculations +#' upar <- (xx %>% filter(Bound == "Upper"))$Z +#' gsDesign2:::gs_power_npe_(theta = c(.1, .2, .3), +#' info = (1:3) * 40, +#' binding = TRUE, +#' upar = upar, +#' lpar = -upar) +#' +#' @noRd +gs_power_npe_ <- function(theta = .1, theta1 = NULL, info = 1, info1 = NULL, info0 = NULL, + binding = FALSE, + upper=gs_b, lower=gs_b, upar = qnorm(.975), lpar= -Inf, + test_upper = TRUE, test_lower = TRUE, + r = 18, tol = 1e-6){ + ####################################################################################### + # WRITE INPUT CHECK TESTS AND RETURN APPROPRIATE ERROR MESSAGES + # theta should be a scalar or vector of real values; if vector, same length as info + # info should be a scalar or vector of positive increasing values + # info0 should be NULL or of the same form as info + # test_upper and test_lower should be logical scalar or vector; if vector same length as info + # END INPUT CHECKS + ####################################################################################### + # SET UP PARAMETERS + K <- length(info) + if (is.null(info0)) info0 <- info + if (is.null(info1)) info1 <- info + if (length(info1) != length(info) || length(info0) != length(info)) stop("gs_power_npe: length of info, info0, info1 must be the same") + if (length(theta) == 1 && K > 1) theta <- rep(theta, K) + if (is.null(theta1)){theta1 <- theta}else if (length(theta1)==1) theta1 <- rep(theta1,K) + if (length(test_upper) == 1 && K > 1) test_upper <- rep(test_upper, K) + if (length(test_lower) == 1 && K > 1) test_lower <- rep(test_lower, K) + a <- rep(-Inf, K) + b <- rep(Inf, K) + hgm1_0 <- NULL + hgm1_1 <- NULL + hgm1 <- NULL + upperProb <- rep(NA, K) + lowerProb <- rep(NA, K) + ###################################################################################### + # COMPUTE BOUNDS + for(k in 1:K){ + # Lower bound update + a[k] <- lower(k = k, par = lpar, hgm1 = hgm1_1, theta = theta1, info = info1, r = r, tol = tol, test_bound = test_lower, + efficacy = FALSE) + # Upper bound update + b[k] <- upper(k = k, par = upar, hgm1 = hgm1_0, info = info0, r = r, tol = tol, test_bound = test_upper) + if(k==1){ + upperProb[1] <- if(b[1] < Inf) {pnorm( sqrt(info[1]) * (theta[1] - b[1] / sqrt(info0[1])))}else{0} + lowerProb[1] <- if(a[1] > -Inf){pnorm(-sqrt(info[1]) * (theta[1] - a[1] / sqrt(info0[1])))}else{0} + + # hgm1_0 <- h1(r = r, theta = 0, I = info0[1], a = if(binding){a[1]}else{-Inf}, b = b[1]) + hgm1_0 <- h1(r = r, theta = 0, I = info0[1], a = if(binding){a[1]}else{-Inf}, b = b[1]) + # hgm1_1 <- h1(r = r, theta = theta1[1], I = info1[1], a = a[1], b = b[1]) + hgm1_1 <- h1(r = r, theta = theta1[1], I = info1[1], a = a[1], b = b[1]) + # hgm1 <- h1(r = r, theta = theta[1], I = info[1], a = a[1], b = b[1]) + hgm1 <- h1(r = r, theta = theta[1], I = info[1], a = a[1], b = b[1]) + }else{ + # Cross upper bound + upperProb[k] <- if(b[k]< Inf){ + # hupdate(r = r, theta = theta[k], I = info[k], a = b[k], b = Inf, + # thetam1 = theta[k - 1], Im1 = info[k - 1], gm1 = hgm1) %>% + # summarise(sum(h)) %>% as.numeric() + sum(hupdate(r = r, theta = theta[k], I = info[k], a = b[k], b = Inf, + thetam1 = theta[k - 1], Im1 = info[k - 1], gm1 = hgm1)$h) + }else{0} + # Cross lower bound + lowerProb[k] <- if(a[k] > -Inf){ + # hupdate(r = r, theta = theta[k], I = info[k], a = -Inf, b = a[k], + # thetam1 = theta[k - 1], Im1 = info[k - 1], gm1 = hgm1) %>% + # summarise(sum(h)) %>% as.numeric() + sum(hupdate(r = r, theta = theta[k], I = info[k], a = -Inf, b = a[k], + thetam1 = theta[k - 1], Im1 = info[k - 1], gm1 = hgm1)$h) + }else{0} + if(k < K){ + # hgm1_0 <- hupdate(r = r, theta = 0, I = info0[k], a = if(binding){a[k]}else{-Inf}, b = b[k], + # thetam1 = 0, Im1 = info0[k-1], gm1 = hgm1_0) + hgm1_0 <- hupdate(r = r, theta = 0, I = info0[k], a = if(binding){a[k]}else{-Inf}, b = b[k], + thetam1 = 0, Im1 = info0[k-1], gm1 = hgm1_0) + # hgm1_1 <- hupdate(r = r, theta = theta1[k], I = info1[k], a = a[k], b = b[k], + # thetam1 = theta1[k-1], Im1 = info1[k-1], gm1 = hgm1_1) + hgm1_1 <- hupdate(r = r, theta = theta1[k], I = info1[k], a = a[k], b = b[k], + thetam1 = theta1[k-1], Im1 = info1[k-1], gm1 = hgm1_1) + # hgm1 <- hupdate(r = r, theta = theta[k], I = info[k], a = a[k], b = b[k], + # thetam1 = theta[k-1], Im1 = info[k-1], gm1 = hgm1) + hgm1 <- hupdate(r = r, theta = theta[k], I = info[k], a = a[k], b = b[k], + thetam1 = theta[k-1], Im1 = info[k-1], gm1 = hgm1) + } + } + } + return(tibble::tibble( + Analysis = rep(1:K, 2), + Bound = c(rep("Upper", K), rep("Lower", K)), + Z= c(b, a), + Probability = c(cumsum(upperProb), + cumsum(lowerProb)), + theta = rep(theta, 2), + theta1 = rep(theta1, 2), + info = rep(info, 2), + info0 = rep(info0, 2), + info1 = rep(info1, 2)) + ) +} \ No newline at end of file diff --git a/R/gs_power_rd.R b/R/gs_power_rd.R new file mode 100644 index 000000000..4a9ebd653 --- /dev/null +++ b/R/gs_power_rd.R @@ -0,0 +1,290 @@ +# Copyright (c) 2021 Merck Sharp & Dohme Corp. a subsidiary of Merck & Co., Inc., Kenilworth, NJ, USA. +# +# This file is part of the gsdmvn program. +# +# gsdmvn is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +#' Group sequential design power under risk difference +#' +#' @param p_c rate at the control group +#' @param p_e rate at the experimental group +#' @param N sample size +#' @param rd0 treatment effect under super-superiority designs, the default is 0 +#' @param ratio experimental:control randomization ratio +#' @param upper function to compute upper bound +#' @param upar parameter to pass to upper +#' @param lower function to compare lower bound +#' @param lpar parameter to pass to lower +#' @param info_scale the information scale for calculation +#' @param weight weigting method, either "un-stratified" or "ss" or "invar" +#' @param binding indicator of whether futility bound is binding; default of FALSE is recommended +#' @param 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 \code{info} should indicate which analyses will have an efficacy bound +#' @param test_lower indicator of which analyses should include a 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 \code{info} should indicate which analyses will have a lower bound +#' @param r Integer, at least 2; default of 18 recommended by Jennison and Turnbull +#' @param tol Tolerance parameter for boundary convergence (on Z-scale) +#' +#' @return a \code{tibble} with columns Analysis, Bound, Z, Probability, theta, Time, AHR, Events +#' +#' @export +#' +#' @examples +#' # --------------------- # +#' # example 1 # +#' # --------------------- # +#' library(gsDesign) +#' +#' # un-stratified case with H0: rd0 = 0 +#' gs_power_rd( +#' p_c = tibble::tibble(Stratum = "All", +#' Rate = .2), +#' p_e = tibble::tibble(Stratum = "All", +#' Rate = .15), +#' N = tibble::tibble(Stratum = "All", +#' N = c(20, 40, 60), +#' Analysis = 1:3), +#' rd0 = 0, +#' ratio = 1, +#' upper = gs_b, +#' lower = gs_b, +#' upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, +#' lpar = c(qnorm(.1), rep(-Inf, 2)) +#' ) +#' +#' # --------------------- # +#' # example 2 # +#' # --------------------- # +#' # un-stratified case with H0: rd0 != 0 +#' gs_power_rd( +#' p_c = tibble::tibble(Stratum = "All", +#' Rate = .2), +#' p_e = tibble::tibble(Stratum = "All", +#' Rate = .15), +#' N = tibble::tibble(Stratum = "All", +#' N = c(20, 40, 60), +#' Analysis = 1:3), +#' rd0 = 0.005, +#' ratio = 1, +#' upper = gs_b, +#' lower = gs_b, +#' upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, +#' lpar = c(qnorm(.1), rep(-Inf, 2)) +#' ) +#' +#' # use spending function +#' gs_power_rd( +#' p_c = tibble::tibble(Stratum = "All", +#' Rate = .2), +#' p_e = tibble::tibble(Stratum = "All", +#' Rate = .15), +#' N = tibble::tibble(Stratum = "All", +#' N = c(20, 40, 60), +#' Analysis = 1:3), +#' rd0 = 0.005, +#' ratio = 1, +#' upper = gs_spending_bound, +#' lower = gs_b, +#' upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), +#' lpar = c(qnorm(.1), rep(-Inf, 2)) +#' ) +#' +#' # --------------------- # +#' # example 3 # +#' # --------------------- # +#' # stratified case under sample size weighting and H0: rd0 = 0 +#' gs_power_rd( +#' p_c = tibble::tibble(Stratum = c("S1", "S2", "S3"), +#' Rate = c(.15, .2, .25)), +#' p_e = tibble::tibble(Stratum = c("S1", "S2", "S3"), +#' Rate = c(.1, .16, .19)), +#' N = tibble::tibble(Stratum = rep(c("S1", "S2", "S3"), each = 3), +#' Analysis = rep(1:3, 3), +#' N = c(10, 20, 24, 18, 26, 30, 10, 20, 24)), +#' rd0 = 0, +#' ratio = 1, +#' weight = "ss", +#' upper = gs_b, +#' lower = gs_b, +#' upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, +#' lpar = c(qnorm(.1), rep(-Inf, 2))) +#' +#' # --------------------- # +#' # example 4 # +#' # --------------------- # +#' # stratified case under inverse variance weighting and H0: rd0 = 0 +#' gs_power_rd( +#' p_c = tibble::tibble(Stratum = c("S1", "S2", "S3"), +#' Rate = c(.15, .2, .25)), +#' p_e = tibble::tibble(Stratum = c("S1", "S2", "S3"), +#' Rate = c(.1, .16, .19)), +#' N = tibble::tibble(Stratum = rep(c("S1", "S2", "S3"), each = 3), +#' Analysis = rep(1:3, 3), +#' N = c(10, 20, 24, 18, 26, 30, 10, 20, 24)), +#' rd0 = 0, +#' ratio = 1, +#' weight = "invar", +#' upper = gs_b, +#' lower = gs_b, +#' upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, +#' lpar = c(qnorm(.1), rep(-Inf, 2))) +#' +#' # --------------------- # +#' # example 5 # +#' # --------------------- # +#' # stratified case under sample size weighting and H0: rd0 != 0 +#' gs_power_rd( +#' p_c = tibble::tibble(Stratum = c("S1", "S2", "S3"), +#' Rate = c(.15, .2, .25)), +#' p_e = tibble::tibble(Stratum = c("S1", "S2", "S3"), +#' Rate = c(.1, .16, .19)), +#' N = tibble::tibble(Stratum = rep(c("S1", "S2", "S3"), each = 3), +#' Analysis = rep(1:3, 3), +#' N = c(10, 20, 24, 18, 26, 30, 10, 20, 24)), +#' rd0 = 0.02, +#' ratio = 1, +#' weight = "ss", +#' upper = gs_b, +#' lower = gs_b, +#' upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, +#' lpar = c(qnorm(.1), rep(-Inf, 2))) +#' +#' # --------------------- # +#' # example 6 # +#' # --------------------- # +#' # stratified case under inverse variance weighting and H0: rd0 != 0 +#' gs_power_rd( +#' p_c = tibble::tibble(Stratum = c("S1", "S2", "S3"), +#' Rate = c(.15, .2, .25)), +#' p_e = tibble::tibble(Stratum = c("S1", "S2", "S3"), +#' Rate = c(.1, .16, .19)), +#' N = tibble::tibble(Stratum = rep(c("S1", "S2", "S3"), each = 3), +#' Analysis = rep(1:3, 3), +#' N = c(10, 20, 24, 18, 26, 30, 10, 20, 24)), +#' rd0 = 0.03, +#' ratio = 1, +#' weight = "invar", +#' upper = gs_b, +#' lower = gs_b, +#' upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, +#' lpar = c(qnorm(.1), rep(-Inf, 2))) +#' +gs_power_rd <- function( + p_c = tibble::tibble(Stratum = "All", + Rate = .2), + p_e = tibble::tibble(Stratum = "All", + Rate = .15), + N = tibble::tibble(Stratum = "All", + N = c(40, 50, 60), + Analysis = 1:3), + rd0 = 0, + ratio = 1, + weight = c("un-stratified", "ss", "invar"), + upper = gs_b, + lower = gs_b, + upar = list(par = gsDesign(k = length(N), test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound), + lpar = list(par = c(qnorm(.1), rep(-Inf, length(N) - 1))), + info_scale = c(0, 1, 2), + binding = FALSE, + test_upper = TRUE, + test_lower = TRUE, + r = 18, + tol = 1e-6 +){ + + # get the number of analysis + K <- max(N$Analysis) + # get the info_scale + info_scale <- if(methods::missingArg(info_scale)){2}else{match.arg(as.character(info_scale), choices = 0:2)} + # get the weighting scheme + weight <- if(methods::missingArg(weight)){"un-stratified"}else{match.arg(weight)} + + # ---------------------------------------- # + # calculate the asymptotic variance # + # and statistical information # + # ---------------------------------------- # + x <- gs_info_rd( + p_c = p_c, + p_e = p_e, + N = N, + rd0 = rd0, + ratio = ratio, + weight = weight) + + # ---------------------------------------- # + # given the above statistical information # + # calculate the power # + # ---------------------------------------- # + y_H1 <- gs_power_npe( + theta = x$rd, + info = x$info1, + info0 = x$info0, + info1 = x$info1, + info_scale = info_scale, + binding = binding, + upper = upper, + lower = lower, + upar = upar, + lpar = lpar, + test_upper = test_upper, + test_lower = test_lower, + r = r, + tol = tol) + + y_H0 <- gs_power_npe( + theta = x$rd0, + info = x$info0, + info0 = x$info0, + info1 = x$info1, + info_scale = info_scale, + binding = binding, + upper = upper, + upar = upar, + test_upper = test_upper, + lower = lower, + lpar = lpar, + test_lower = test_lower, + r = r, + tol = tol) + + # ---------------------------------------- # + # organize the outputs # + # ---------------------------------------- # + # summarize the bounds + suppressMessages( + bounds <- y_H1 %>% + mutate(`~Risk difference at bound` = Z / sqrt(info) / theta * (x$rd[1] - x$rd0[1]) + x$rd0[1], `Nominal p` = pnorm(-Z)) %>% + left_join(y_H0 %>% select(Analysis, Bound, Probability) %>% dplyr::rename(Probability0 = Probability)) %>% + select(Analysis, Bound, Probability, Probability0, Z, `~Risk difference at bound`, `Nominal p`) + ) + # summarize the analysis + suppressMessages( + analysis <- x %>% + select(Analysis, N, rd, rd0, theta1, theta0) %>% + left_join(y_H1 %>% select(Analysis, info, IF) %>% unique()) %>% + left_join(y_H0 %>% select(Analysis, info, IF) %>% dplyr::rename(info0 = info, IF0 = IF) %>% unique()) %>% + select(Analysis, N, rd, rd0, theta1, theta0, info, info0, IF, IF0) + ) + + ans <- list( + bounds = bounds, + analysis = analysis) + + class(ans) <- c("rd", "gs_design", class(ans)) + + return(ans) +} \ No newline at end of file diff --git a/R/gs_power_wlr.R b/R/gs_power_wlr.R new file mode 100644 index 000000000..eb36c0055 --- /dev/null +++ b/R/gs_power_wlr.R @@ -0,0 +1,249 @@ +# Copyright (c) 2021 Merck Sharp & Dohme Corp. a subsidiary of Merck & Co., Inc., Kenilworth, NJ, USA. +# +# This file is part of the gsDesign2 program. +# +# gsDesign2 is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +#' Group sequential design power using weighted log rank test under non-proportional hazards +#' +#' @importFrom tibble tibble +#' @importFrom gsDesign gsDesign +#' @importFrom dplyr left_join +#' +#' @inheritParams gs_design_wlr +#' @inheritParams gs_power_ahr +#' +#' @section Specification: +#' \if{latex}{ +#' \itemize{ +#' \item Compute information and effect size for Weighted Log-rank test using \code{gs_info_wlr()}. +#' \item Compute group sequential bound computation with non-constant effect using \code{gs_power_npe()}. +#' \item Combine information and effect size and power and return a +#' tibble with columns Analysis, Bound, Time, Events, Z, Probability, AHR, theta, info, and info0. +#' } +#' } +#' \if{html}{The contents of this section are shown in PDF user manual only.} +#' +#' @export +#' +#' @examples +#' library(tibble) +#' library(gsDesign) +#' library(gsDesign2) +#' +#' # set enrollment rates +#' enrollRates <- tibble(Stratum = "All", duration = 12, rate = 500/12) +#' +#' # set failure rates +#' failRates <- tibble( +#' Stratum = "All", +#' duration = c(4, 100), +#' failRate = log(2) / 15, # median survival 15 month +#' hr = c(1, .6), +#' dropoutRate = 0.001) +#' +#' # set the targeted number of events and analysis time +#' target_events <- c(30, 40, 50) +#' target_analysisTime <- c(10, 24, 30) +#' +#' # -------------------------# +#' # example 1 # +#' # ------------------------ # +#' # fixed bounds and calculate the power for targeted number of events +#' gs_power_wlr( +#' enrollRates = enrollRates, +#' failRates = failRates, +#' events = target_events, +#' analysisTimes = NULL, +#' upper = gs_b, +#' upar = gsDesign(k = length(target_events), test.type = 1, n.I = target_events, maxn.IPlan = max(target_events), sfu = sfLDOF, sfupar = NULL)$upper$bound, +#' lower = gs_b, +#' lpar = c(qnorm(.1), rep(-Inf, 2))) +#' +#' # -------------------------# +#' # example 2 # +#' # ------------------------ # +#' # fixed bounds and calculate the power for targeted analysis time +#' gs_power_wlr( +#' enrollRates = enrollRates, +#' failRates = failRates, +#' events = NULL, +#' analysisTimes = target_analysisTime, +#' upper = gs_b, +#' upar = gsDesign(k = length(target_events), test.type = 1, n.I = target_events, maxn.IPlan = max(target_events), sfu = sfLDOF, sfupar = NULL)$upper$bound, +#' lower = gs_b, +#' lpar = c(qnorm(.1), rep(-Inf, 2))) +#' +#' # -------------------------# +#' # example 3 # +#' # ------------------------ # +#' # fixed bounds and calculate the power for targeted analysis time & number of events +#' gs_power_wlr( +#' enrollRates = enrollRates, +#' failRates = failRates, +#' events = target_events, +#' analysisTimes = target_analysisTime, +#' upper = gs_b, +#' upar = gsDesign(k = length(target_events), test.type = 1, n.I = target_events, maxn.IPlan = max(target_events), sfu = sfLDOF, sfupar = NULL)$upper$bound, +#' lower = gs_b, +#' lpar = c(qnorm(.1), rep(-Inf, 2))) +#' +#' # -------------------------# +#' # example 4 # +#' # ------------------------ # +#' # spending bounds and calculate the power for targeted number of events +#' gs_power_wlr( +#' enrollRates = enrollRates, +#' failRates = failRates, +#' events = target_events, +#' analysisTimes = NULL, +#' upper = gs_spending_bound, +#' upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025), +#' lower = gs_spending_bound, +#' lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.2)) +#' +#' # -------------------------# +#' # example 5 # +#' # ------------------------ # +#' # spending bounds and calculate the power for targeted analysis time +#' gs_power_wlr( +#' enrollRates = enrollRates, +#' failRates = failRates, +#' events = NULL, +#' analysisTimes = target_analysisTime, +#' upper = gs_spending_bound, +#' upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025), +#' lower = gs_spending_bound, +#' lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.2)) +#' +#' # -------------------------# +#' # example 6 # +#' # ------------------------ # +#' # spending bounds and calculate the power for targeted analysis time & number of events +#' gs_power_wlr( +#' enrollRates = enrollRates, +#' failRates = failRates, +#' events = target_events, +#' analysisTimes = target_analysisTime, +#' upper = gs_spending_bound, +#' upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025), +#' lower = gs_spending_bound, +#' lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.2)) +#' +gs_power_wlr <- function(enrollRates = tibble(Stratum = "All", duration = c(2, 2, 10), rate = c(3, 6, 9)), + failRates = tibble(Stratum = "All", duration = c(3, 100), failRate = log(2)/c(9, 18), + hr = c(.9, .6), dropoutRate = rep(.001, 2)), + events = c(30, 40, 50), + analysisTimes = NULL, + binding = FALSE, + upper = gs_b, + lower = gs_b, + upar = gsDesign(k = 3, test.type = 1, n.I = c(30, 40, 50), maxn.IPlan = 50, sfu = sfLDOF, sfupar = NULL)$upper$bound, + lpar = c(qnorm(.1), rep(-Inf, 2)), + test_upper = TRUE, + test_lower = TRUE, + ratio = 1, + weight = wlr_weight_fh, + info_scale = c(0, 1, 2), + approx = "asymptotic", + r = 18, + tol = 1e-6){ + # get the number of analysis + K <- max(length(events), length(analysisTimes), na.rm = TRUE) + # get the info_scale + info_scale <- if(methods::missingArg(info_scale)){2}else{match.arg(as.character(info_scale), choices = 0:2)} + + # ---------------------------------------- # + # calculate the asymptotic variance # + # and statistical information # + # ---------------------------------------- # + x <- gs_info_wlr( + enrollRates = enrollRates, + failRates = failRates, + ratio = ratio, + events = events, + weight = weight, + analysisTimes = analysisTimes + ) + + # ---------------------------------------- # + # given the above statistical information # + # calculate the power # + # ---------------------------------------- # + y_H1 <- gs_power_npe( + theta = x$theta, + info = x$info, + info0 = x$info0, + info_scale = info_scale, + binding = binding, + upper = upper, + lower = lower, + upar = upar, + lpar= lpar, + test_upper = test_upper, + test_lower = test_lower, + r = r, + tol = tol) + + y_H0 <- gs_power_npe( + theta = 0, #x$theta, + info = x$info0, + info0 = x$info0, + info_scale = info_scale, + binding = binding, + upper = upper, + lower = lower, + upar = upar, + lpar= lpar, + test_upper = test_upper, + test_lower = test_lower, + r = r, + tol = tol) + + # ---------------------------------------- # + # organize the outputs # + # ---------------------------------------- # + # summarize the bounds + suppressMessages( + bounds <- y_H0 %>% + select(Analysis, Bound, Z, Probability) %>% + dplyr::rename(Probability0 = Probability) %>% + dplyr::left_join(x %>% select(Analysis, Events)) %>% + mutate(`~HR at bound` = gsDesign::zn2hr(z = Z, n = Events, ratio = ratio), `Nominal p` = pnorm(-Z)) %>% + dplyr::left_join(y_H1 %>% select(Analysis, Bound, Probability)) %>% + select(Analysis, Bound, Probability, Probability0, Z, `~HR at bound`, `Nominal p`) %>% + arrange(Analysis, desc(Bound)) + ) + + # summarize the analysis + suppressMessages( + analysis <- x %>% + select(Analysis, Time, Events, AHR) %>% + mutate(N = eAccrual(x = x$Time, enrollRates = enrollRates)) %>% + dplyr::left_join(y_H1 %>% select(Analysis, info, IF, theta) %>% unique()) %>% + dplyr::left_join(y_H0 %>% select(Analysis, info, IF) %>% dplyr::rename(info0 = info, IF0 = IF) %>% unique()) %>% + select(Analysis, Time, N, Events, AHR, theta, info, info0, IF, IF0) %>% + arrange(Analysis) + ) + + ans <- list( + enrollRates = enrollRates, + failRates = failRates, + bounds = bounds, + analysis = analysis) + + class(ans) <- c("wlr", "gs_design", class(ans)) + + return(ans) +} diff --git a/R/gs_spending_bound.R b/R/gs_spending_bound.R new file mode 100644 index 000000000..321e68262 --- /dev/null +++ b/R/gs_spending_bound.R @@ -0,0 +1,227 @@ +# Copyright (c) 2021 Merck Sharp & Dohme Corp. a subsidiary of Merck & Co., Inc., Kenilworth, NJ, USA. +# +# This file is part of the gsdmvn program. +# +# gsdmvn is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +#' @importFrom dplyr summarize +#' @importFrom gsDesign gsDesign sfLDOF +#' @importFrom stats qnorm +NULL +#' Derive spending bound for group sequential boundary +#' +#' Computes one bound at a time based on spending under given distributional assumptions. +#' While user specifies \code{gs_spending_bound()} for use with other functions, +#' it is not intended for use on its own. +#' Most important user specifications are made through a list provided to functions using \code{gs_spending_bound()}. +#' Function uses numerical integration and Newton-Raphson iteration to derive an individual bound for a group sequential +#' design that satisfies a targeted boundary crossing probability. +#' Algorithm is a simple extension of that in Chapter 19 of Jennison and Turnbull (2000). +#' +#' @param k analysis for which bound is to be computed +#' @param par a list with the following items: +#' \code{sf} (class spending function), +#' \code{total_spend} (total spend), +#' \code{param} (any parameters needed by the spending function \code{sf()}), +#' \code{timing} (a vector containing values at which spending function is to be evaluated or NULL if information-based spending is used), +#' \code{max_info} (when \code{timing} is NULL, this can be input as positive number to be used with \code{info} for information fraction at each analysis) +#' @param hgm1 subdensity grid from h1 (k=2) or hupdate (k>2) for analysis k-1; if k=1, this is not used and may be NULL +#' @param theta natural parameter used for lower bound only spending; +#' represents average drift at each time of analysis at least up to analysis k; +#' upper bound spending is always set under null hypothesis (theta = 0) +#' @param info statistical information at all analyses, at least up to analysis k +#' @param efficacy TRUE (default) for efficacy bound, FALSE otherwise +#' @param test_bound a logical vector of the same length as \code{info} should indicate which analyses will have a bound +#' @param r Integer, at least 2; default of 18 recommended by Jennison and Turnbull +#' @param tol Tolerance parameter for convergence (on Z-scale) +#' @section Specification: +#' \if{latex}{ +#' \itemize{ +#' \item Set the spending time at analysis. +#' \item Compute the cumulative spending at analysis. +#' \item Compute the incremental spend at each analysis. +#' \item Set test_bound a vector of length k > 1 if input as a single value. +#' \item Compute spending for current bound. +#' \item Iterate to convergence as in gsbound.c from gsDesign. +#' \item Compute subdensity for final analysis in rejection region. +#' \item Validate the output and return an error message in case of failure. +#' \item Return a numeric bound (possibly infinite). +#' } +#' } +#' \if{html}{The contents of this section are shown in PDF user manual only.} +#' +#' @return returns a numeric bound (possibly infinite) or, upon failure, generates an error message. +#' @author Keaven Anderson \email{keaven_anderson@@merck.com} +#' @references Jennison C and Turnbull BW (2000), \emph{Group Sequential +#' Methods with Applications to Clinical Trials}. Boca Raton: Chapman and Hall. +#' @export +gs_spending_bound <- function(k = 1, + par = list(sf = gsDesign::sfLDOF, + total_spend = 0.025, + param = NULL, + timing = NULL, + max_info = NULL), + hgm1 = NULL, + theta = .1, + info = 1:3, + efficacy = TRUE, + test_bound = TRUE, + r = 18, + tol = 1e-6){ + # ---------------------------------- # + # check and initialize inputs # + # ---------------------------------- # + # Make test_bound a vector of length k > 1 if input as a single value + if(length(test_bound) == 1 && k > 1){test_bound <- rep(test_bound, k)} + + # ---------------------------------- # + # set spending time at analyses # + # ---------------------------------- # + 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 + } + } + + # ---------------------------------- # + # compute cumulative spending # + # at each analyses # + # ---------------------------------- # + spend <- par$sf(alpha = par$total_spend, t = timing, param = par$param)$spend + + # ---------------------------------- # + # compute incremental spending # + # at each analyses # + # ---------------------------------- # + old_spend <- 0 + + for(i in 1:k){ + if (test_bound[i]){ # Check if spending is taken at analysis i + xx <- spend[i] - old_spend # Cumulative spending minus previous spending + old_spend <- spend[i] # Reset previous spending + spend[i] <- xx # Incremental spend at analysis i + }else{ + spend[i] <- 0 # 0 incremental spend if no testing at analysis i + } + } + + + # Now just get spending for current bound + spend <- spend[k] + + # ---------------------------------- # + # compute lower bound # + # at each analyses # + # ---------------------------------- # + # lower bound + if (!efficacy){ + # If no spending, return -Inf for bound + if(spend <= 0){return(-Inf)} + + # if theta not a vector, make it one + # theta is for lower bound only + if(length(theta) == 1) theta <- rep(theta, length(info)) + + # set starting value + a <- qnorm(spend) + sqrt(info[k]) * theta[k] + + # if it is the first analysis: no need for iteration + if(k == 1){return(a)} + + # Extremes for numerical integration + mu <- theta[k] * sqrt(info[k]) + EXTREMElow <- mu - 3 - 4 * log(r) + EXTREMEhi <- mu + 3 + 4 * log(r) + + # iterate to convergence as in gsbound.c from gsDesign + adelta <- 1 + j <- 0 + + # ---------------------------------------------------------------- # + # FOLLOWING UPDATE ALGORITHM FROM GSDESIGN::GSBOUND.C # + # use 1st order Taylor's series to update boundaries # + # maximum allowed change is 1 # + # maximum value allowed is z1[m1]*rtIk to keep within grid points # + # ---------------------------------------------------------------- # + while(abs(adelta) > tol){ + + # get grid for rejection region + hg <- hupdate(theta = theta[k], I = info[k], a = -Inf, b = a, thetam1 = theta[k-1], Im1 = info[k-1], gm1 = hgm1, r = r) + i <- length(hg$h) + + # compute lower bound crossing (pik) + 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 > EXTREMEhi){ + a <- EXTREMEhi + }else if(a < EXTREMElow){ + a <- EXTREMElow + } + + 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{ + # ---------------------------------- # + # compute upper bound # + # at each analyses # + # ---------------------------------- # + if(spend <= 0){return(Inf)} + + # set starting value + b <- qnorm(spend, lower.tail = FALSE) + + # if it is the first analysis: no iteration needed + if(k == 1){return(b)} + + # if it is not the first analysis + for(iter in 0:20){ + + # sub-density for final analysis in rejection region + hg <- hupdate(theta = 0, I = info[k], a = b, b = Inf, thetam1 = 0, Im1 = info[k-1], gm1 = hgm1, r = r) + + # compute probability of crossing bound + pik <- sum(hg$h) + + # compute the derivative of bound crossing at b[k] + dpikdb <- hg$h[1] / hg$w[1] + + # update upper boundary by Newton-Raphson method + b_old <- b + b <- b - (spend - pik) / dpikdb + if(abs(b - b_old) < tol){return(b)} + } + stop(paste("gs_spending_bound(): bound_update did not converge for upper bound calculation, analysis", k, " !")) + } +} \ No newline at end of file diff --git a/R/gs_spending_combo.R b/R/gs_spending_combo.R new file mode 100644 index 000000000..e2a7c46fe --- /dev/null +++ b/R/gs_spending_combo.R @@ -0,0 +1,36 @@ +# Copyright (c) 2021 Merck Sharp & Dohme Corp. a subsidiary of Merck & Co., Inc., Kenilworth, NJ, USA. +# +# This file is part of the gsdmvn program. +# +# gsdmvn is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +#' Derive spending bound for MaxCombo group sequential boundary +#' +#' @inheritParams gs_spending_bound +#' @param ... additional parameters transfered to `par$sf`. +#' +#' @examples +#' +#' # alpha-spending +#' par <- list(sf = gsDesign::sfLDOF, total_spend = 0.025) +#' gs_spending_combo(par, info = 1:3/3) +#' +#' # beta-spending +#' par <- list(sf = gsDesign::sfLDOF, total_spend = 0.2) +#' gs_spending_combo(par, info = 1:3/3) +#' +#' @export +gs_spending_combo <- function(par = NULL, info = NULL, ...){ + par$sf(par$total_spend, info, ...)$spend +} \ No newline at end of file diff --git a/R/helper_functions.R b/R/helper_functions.R new file mode 100644 index 000000000..ffbd9983a --- /dev/null +++ b/R/helper_functions.R @@ -0,0 +1,248 @@ +# Copyright (c) 2021 Merck Sharp & Dohme Corp. a subsidiary of Merck & Co., Inc., Kenilworth, NJ, USA. +# +# This file is part of the gsdmvn program. +# +# gsdmvn is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +#' Blinded estimation of average hazard ratio +#' +#' Based on blinded data and assumed hazard ratios in different intervals, compute +#' a blinded estimate of average hazard ratio (AHR) and corresponding estimate of statistical information. +#' This function is intended for use in computing futility bounds based on spending assuming +#' the input hazard ratio (hr) values for intervals specified here. +#' @importFrom tibble tibble +#' @importFrom survival Surv +#' @param Srv input survival object (see \code{Surv}); note that only 0=censored, 1=event for \code{Surv} +#' @param intervals Vector containing positive values indicating interval lengths where the +#' exponential rates are assumed. +#' Note that a final infinite interval is added if any events occur after the final interval +#' specified. +#' @param hr vector of hazard ratios assumed for each interval +#' @param ratio ratio of experimental to control randomization. +#' +#' @section Specification: +#' \if{latex}{ +#' \itemize{ +#' \item Validate if input hr is a numeric vector. +#' \item Validate if input hr is non-negative. +#' \item Simulate piece-wise exponential survival estimation with the inputs survival object Srv +#' and intervals. +#' \item Save the length of hr and events to an object, and if the length of hr is shorter than +#' the intervals, add replicates of the last element of hr and the corresponding numbers of events +#' to hr. +#' \item Compute the blinded estimation of average hazard ratio. +#' \item Compute adjustment for information. +#' \item Return a tibble of the sum of events, average hazard raito, blinded average hazard +#' ratio, and the information. +#' } +#' } +#' \if{html}{The contents of this section are shown in PDF user manual only.} +#' +#' @return A \code{tibble} with one row containing +#' `AHR` blinded average hazard ratio based on assumed period-specific hazard ratios input in `failRates` +#' and observed events in the corresponding intervals +#' `Events` total observed number of events, `info` statistical information based on Schoenfeld approximation, +#' and info0 (information under related null hypothesis) for each value of `totalDuration` input; +#' if `simple=FALSE`, `Stratum` and `t` (beginning of each constant HR period) are also returned +#' and `HR` is returned instead of `AHR` +#' +#' @examples +#' \dontrun{ +#' library(simtrial) +#' library(survival) +#' ahr_blinded(Srv = Surv(time = simtrial::Ex2delayedEffect$month, +#' event = simtrial::Ex2delayedEffect$evntd), +#' intervals = c(4, 100), +#' hr = c(1, .55), +#' ratio = 1) +#' } +#' +#' @export +ahr_blinded <- function (Srv = Surv(time = simtrial::Ex1delayedEffect$month, + event = simtrial::Ex1delayedEffect$evntd), + intervals = array(3, 3), + hr = c(1, .6), + ratio = 1){ + + msg <- "hr must be a vector of positive numbers" + if (!is.vector(hr, mode = "numeric")) stop(msg) + if (min(hr) <= 0) stop(msg) + + events <- simtrial::pwexpfit(Srv, intervals)[ , 3] + nhr <- length(hr) + nx <- length(events) + # Add to hr if length shorter than intervals + if (length(hr) < length(events)) hr <- c(hr, rep(hr[nhr], nx - nhr)) + + # Compute blinded AHR + theta <- sum(log(hr[1 : nx]) * events) / sum(events) + + # Compute adjustment for information + Qe <- ratio / (1 + ratio) + + ans <- tibble(Events = sum(events), AHR = exp(theta), + theta = theta, info0 = sum(events) * (1 - Qe) * Qe) + return(ans) +} + +#' @importFrom dplyr last +#' @importFrom tibble tibble +#' @importFrom stats stepfun +NULL + +#' Piecewise exponential cumulative distribution function +#' +#' \code{ppwe} computes the cumulative distribution function (CDF) or survival rate +#' for a piecewise exponential distribution. +#' @param x times at which distribution is to be computed. +#' @param failRates Piecewise constant failure rates in `rate`, +#' `duration` for each piecewise constant failure rate period. +#' @param lower.tail Indicator of whether lower (TRUE) or upper tail (FALSE; default) +#' of CDF is to be computed. +#' @details +#' Suppose \eqn{\lambda_i} is the failure rate in the interval \eqn{(t_{i-1},t_i], i=1,2,\ldots,M} where +#' \eqn{0=t_00} is then: +#' +#' \deqn{\Lambda(t)=\sum_{i=1}^M \delta(t\le t_i)(\min(t,t_i)-t_{i-1})\lambda_i.} +#' The survival at time \eqn{t} is then +#' \deqn{S(t)=\exp(-\Lambda(t)).} +#' @section Specification: +#' \if{latex}{ +#' \itemize{ +#' \item Validate if input enrollment rate is a strictly increasing non-negative numeric vector. +#' \item Validate if input failure rate is of type data.frame. +#' \item Validate if input failure rate contains duration column. +#' \item Validate if input failure rate contains rate column. +#' \item Validate if input lower.tail is logical. +#' \item Convert rates to step function. +#' \item Add times where rates change to enrollment rates. +#' \item Make a tibble of the input time points x, duration, hazard rates at points, +#' cumulative hazard and survival. +#' \item Extract the expected cumulative or survival of piecewise exponential distribution. +#' \item If input lower.tail is true, return the cdf, else return the survival for \code{ppwe} +#' } +#' } +#' \if{html}{The contents of this section are shown in PDF user manual only.} +#' @return A vector with cumulative distribution function or survival values +#' @examples +#' # Example: default +#' ppwe(seq(0:10)) +#' # Example: plot a survival function with 2 different sets of time values +#' # to demonstrate plot precision corresponding to input parameters. +#' fr <- tibble::tibble(duration=c(3,3,1),rate=c(.2,.1,.005)) +#' Time <- seq(0,10,10/pi) +#' Survival <- ppwe(Time,fr) +#' plot(Time,Survival,type="l",ylim=c(0,1)) +#' Time <- seq(0,10,.25) +#' Survival <- ppwe(Time,fr) +#' lines(Time,Survival,col=2) +#' @export +ppwe <- function(x = 0:20, + failRates = tibble::tibble(duration = c(3, 100), rate = log(2) / c(9, 18)), + lower.tail = FALSE +){ + # check input values + # check input enrollment rate assumptions + if(!is.numeric(x)){stop("gsDesign2: x in `ppwe()` must be a strictly increasing non-negative numeric vector")} + if(!min(x) >= 0){stop("gsDesign2: x in `ppwe()` must be a strictly increasing non-negative numeric vector")} + if(!min(x[x>0] - lag(x[x > 0], default = 0)) > 0){stop("gsDesign2: x in `ppwe()` must be a strictly increasing non-negative numeric vector")} + + # check input failure rate assumptions + if(!is.data.frame(failRates)){stop("gsDesign2: failRates in `ppwe()` must be a data.frame")} + if(!max(names(failRates) == "duration") == 1){stop("gsDesign2: failRates in `ppwe()` column names must contain duration")} + if(!max(names(failRates) == "rate") == 1){stop("gsDesign2: failRates in `ppwe()` column names must contain rate")} + + # check lower.tail + if(!is.logical(lower.tail)){stop("gsDesign2: lower.tail in `ppwe()` must be logical")} + + # convert rates to step function + ratefn <- stepfun(x = cumsum(failRates$duration), + y = c(failRates$rate, last(failRates$rate)), + right = TRUE) + # add times where rates change to failRates + xvals <- sort(unique(c(x, cumsum(failRates$duration)))) + # make a tibble + xx <- tibble::tibble(x = xvals, + duration = xvals - lag(xvals, default = 0), + h = ratefn(xvals), # hazard rates at points (right continuous) + H = cumsum(h * duration), # cumulative hazard + survival = exp(-H) # survival + ) + # return survival or cdf + ind <- !is.na(match(xx$x, x)) + survival <- as.numeric(xx$survival[ind]) + if(lower.tail){ + return(1 - survival)}else{ + return(survival)} +} + +#' @importFrom dplyr lag select "%>%" +#' @importFrom tibble tibble +NULL + +#' Approximate survival distribution with piecewise exponential distribution +#' +#' \code{s2pwe} converts a discrete set of points from an arbitrary survival distribution +#' to a piecewise exponential approximation +#' @param times Positive increasing times at which survival distribution is provided. +#' @param survival Survival (1 - cumulative distribution function) at specified `times` +#' @section Specification: +#' \if{latex}{ +#' \itemize{ +#' \item Validate if input times is increasing positive finite numbers. +#' \item Validate if input survival is numeric and same length as input times. +#' \item Validate if input survival is positive, non-increasing, less than or equal to 1 and greater than 0. +#' \item Create a tibble of inputs times and survival. +#' \item Calculate the duration, hazard and the rate. +#' \item Return the duration and rate by \code{s2pwe} +#' } +#' } +#' \if{html}{The contents of this section are shown in PDF user manual only.}#' @return A `tibble` with `duration` and 'rate' +#' @return A tibble containing the duration and rate. +#' @examples +#' # Example: arbitrary numbers +#' s2pwe(1:9, (9:1)/10) +#' # Example: lognormal +#' s2pwe(c(1:6,9), plnorm(c(1:6,9),meanlog = 0, sdlog = 2,lower.tail = FALSE)) +#' @export +s2pwe <- function(times, survival){ + # check input values + # check that times are positive, ordered, unique and finite numbers + if(!is.numeric(times)){stop("gsDesign2: times in `s2pwe()` must be increasing positive finite numbers")} + if(!min(times) > 0){stop("gsDesign2: times in `s2pwe()` must be increasing positive finite numbers")} + if(!max(times) < Inf){stop("gsDesign2: times in `s2pwe()` must be increasing positive finite numbers")} + len <- length(times) + if(!if(len>1){min(times[2 : len] - times[1 : (len - 1)]) > 0}){stop("gsDesign2: times in `s2pwe()`must be increasing positive finite numbers")} + + # check that survival is numeric and same length as times + if(!is.numeric(survival)){stop("gsDesign2: survival in `s2pwe()` must be numeric and of same length as times")} + if(!length(survival) == len){stop("gsDesign2: survival in `s2pwe()` must be numeric and of same length as times")} + + # check that survival is positive, non-increasing, less than or equal to 1 and gt 0 + if(!min(survival) > 0){stop("gsDesign2: survival in `s2pwe()` must be non-increasing positive finite numbers less than or equal to 1 with at least 1 value < 1")} + if(!max(survival) <= 1){stop("gsDesign2: survival in `s2pwe()` must be non-increasing positive finite numbers less than or equal to 1 with at least 1 value < 1")} + if(!min(survival) < 1){stop("gsDesign2: survival in `s2pwe()` must be non-increasing positive finite numbers less than or equal to 1 with at least 1 value < 1")} + if(len > 1){ + if(!min(survival[2 : len] - survival[1 : (len - 1)]) <= 0 ){ + stop("gsDesign2: survival in `s2pwe()` must be non-increasing positive finite numbers less than or equal to 1 with at least 1 value < 1") + } + } + + ans <- tibble::tibble(Times = times, Survival = survival) %>% + mutate(duration = Times - lag(Times, default = 0), + H = -log(Survival), + rate = (H - lag(H,default = 0)) / duration) %>% + select(duration,rate) + return(ans) +} diff --git a/R/ppwe.R b/R/ppwe.R deleted file mode 100644 index 4fdb8d47b..000000000 --- a/R/ppwe.R +++ /dev/null @@ -1,108 +0,0 @@ -# Copyright (c) 2022 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. All rights reserved. -# -# This file is part of the gsDesign2 program. -# -# gsDesign2 is free software: you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation, either version 3 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program. If not, see . - -#' @importFrom dplyr last -#' @importFrom tibble tibble -#' @importFrom stats stepfun -NULL - -#' Piecewise exponential cumulative distribution function -#' -#' \code{ppwe} computes the cumulative distribution function (CDF) or survival rate -#' for a piecewise exponential distribution. -#' @param x times at which distribution is to be computed. -#' @param failRates Piecewise constant failure rates in `rate`, -#' `duration` for each piecewise constant failure rate period. -#' @param lower.tail Indicator of whether lower (TRUE) or upper tail (FALSE; default) -#' of CDF is to be computed. -#' @details -#' Suppose \eqn{\lambda_i} is the failure rate in the interval \eqn{(t_{i-1},t_i], i=1,2,\ldots,M} where -#' \eqn{0=t_00} is then: -#' -#' \deqn{\Lambda(t)=\sum_{i=1}^M \delta(t\le t_i)(\min(t,t_i)-t_{i-1})\lambda_i.} -#' The survival at time \eqn{t} is then -#' \deqn{S(t)=\exp(-\Lambda(t)).} -#' @section Specification: -#' \if{latex}{ -#' \itemize{ -#' \item Validate if input enrollment rate is a strictly increasing non-negative numeric vector. -#' \item Validate if input failure rate is of type data.frame. -#' \item Validate if input failure rate contains duration column. -#' \item Validate if input failure rate contains rate column. -#' \item Validate if input lower.tail is logical. -#' \item Convert rates to step function. -#' \item Add times where rates change to enrollment rates. -#' \item Make a tibble of the input time points x, duration, hazard rates at points, -#' cumulative hazard and survival. -#' \item Extract the expected cumulative or survival of piecewise exponential distribution. -#' \item If input lower.tail is true, return the cdf, else return the survival for \code{ppwe} -#' } -#' } -#' \if{html}{The contents of this section are shown in PDF user manual only.} -#' @return A vector with cumulative distribution function or survival values -#' @examples -#' # Example: default -#' ppwe(seq(0:10)) -#' # Example: plot a survival function with 2 different sets of time values -#' # to demonstrate plot precision corresponding to input parameters. -#' fr <- tibble::tibble(duration=c(3,3,1),rate=c(.2,.1,.005)) -#' Time <- seq(0,10,10/pi) -#' Survival <- ppwe(Time,fr) -#' plot(Time,Survival,type="l",ylim=c(0,1)) -#' Time <- seq(0,10,.25) -#' Survival <- ppwe(Time,fr) -#' lines(Time,Survival,col=2) -#' @export -ppwe <- function(x = 0:20, - failRates=tibble::tibble(duration=c(3,100), - rate=log(2)/c(9,18)), - lower.tail=FALSE -){ -# check input values - # check input enrollment rate assumptions - if(!is.numeric(x)){stop("gsDesign2: x in `ppwe()` must be a strictly increasing non-negative numeric vector")} - if(!min(x) >= 0){stop("gsDesign2: x in `ppwe()` must be a strictly increasing non-negative numeric vector")} - if(!min(x[x>0] - lag(x[x>0],default=0)) > 0){stop("gsDesign2: x in `ppwe()` must be a strictly increasing non-negative numeric vector")} - - # check input failure rate assumptions - if(!is.data.frame(failRates)){stop("gsDesign2: failRates in `ppwe()` must be a data.frame")} - if(!max(names(failRates)=="duration") == 1){stop("gsDesign2: failRates in `ppwe()` column names must contain duration")} - if(!max(names(failRates)=="rate") == 1){stop("gsDesign2: failRates in `ppwe()` column names must contain rate")} - - # check lower.tail - if(!is.logical(lower.tail)){stop("gsDesign2: lower.tail in `ppwe()` must be logical")} - -# convert rates to step function - ratefn <- stepfun(x=cumsum(failRates$duration), - y=c(failRates$rate,last(failRates$rate)), - right=TRUE) -# add times where rates change to failRates - xvals <- sort(unique(c(x,cumsum(failRates$duration)))) -# make a tibble - xx <- tibble::tibble(x=xvals, - duration= xvals - lag(xvals,default = 0), - h=ratefn(xvals), # hazard rates at points (right continuous) - H=cumsum(h*duration), # cumulative hazard - survival=exp(-H) # survival - ) -# return survival or cdf - ind <- !is.na(match(xx$x,x)) - survival <- as.numeric(xx$survival[ind]) - if(lower.tail){ - return(1-survival)}else{ - return(survival)} -} diff --git a/R/rmst.R b/R/rmst.R new file mode 100644 index 000000000..02f23ffd5 --- /dev/null +++ b/R/rmst.R @@ -0,0 +1,148 @@ +#' Sample Size Calculation based on RMST method +#' +#' @param enrollRates enrollment rates +#' @param failRates failure and dropout rates +#' @param analysisTimes Minimum time of analysis +#' @param ratio Experimental:Control randomization ratio +#' @param alpha One-sided Type I error (strictly between 0 and 1) +#' @param beta Power (`NULL` to compute power or strictly between 0 and `1 - alpha` otherwise) +#' @param test A string specifies the type of statistical test. +#' Default is \code{"survival difference"} (a Kaplan-Meier based test). +#' One can also set it as \code{"rmst difference"} (another Kaplan-Meier based test) +#' @param tau desired milestone for \code{test = "survival difference"} or \code{test = "rmst difference"} +#' @return a list with \code{enrollRates}, \code{failRates}, \code{bounds}, \code{analysis} and \code{design} +#' +#' @examples +#' # set enrollment rates +#' enrollRates <- tibble::tibble(Stratum = "All", duration = 12, rate = 500/12) +#' +#' # set failure rates +#' failRates <- tibble::tibble( +#' Stratum = "All", +#' duration = c(4, 100), +#' failRate = log(2) / 15, # median survival 15 month +#' hr = c(1, .6), +#' dropoutRate = 0.001) +#' +#' fixed_design_size_rmst(enrollRates, failRates, analysisTimes = 36) +#' fixed_design_size_rmst(enrollRates, failRates, analysisTimes = 36, beta = 1 - 0.887) +#' fixed_design_size_rmst(enrollRates, failRates, analysisTimes = 36, tau = 18) +#' +#' @noRd +fixed_design_size_rmst <- function(enrollRates, + failRates, + analysisTimes, + ratio = 1, + alpha = 0.025, + beta = 0.1, + test = "rmst difference", + tau = NULL){ + + gs_arm <- gs_create_arm(enrollRates, failRates, ratio = ratio, total_time = analysisTimes) + arm0 <- gs_arm[["arm0"]] + arm1 <- gs_arm[["arm1"]] + + n <- sum(enrollRates$duration * enrollRates$rate) + + # Sample size for RMST at cut point + npsurv <- npsurvSS::size_two_arm(arm0, arm1, + alpha = alpha, power = 1 - beta, + test = list(test = test, milestone = if(is.null(tau)){arm0$total_time}else{tau})) + bounds <- tibble::tibble( + Analysis = 1, + Bound = "Upper", + Probability = 1 - beta, + Probability0 = alpha, + Z = - qnorm(alpha) + ) + + analysis <- tibble::tibble( + Analysis = 1, + Time = analysisTimes, + N = npsurv[["n"]], + Events = npsurv[["d"]] + ) + + + res <- list(enrollRates = enrollRates %>% mutate(rate = rate * npsurv[["n"]] / n), + failRates = failRates, + bounds = bounds, + analysis = analysis) + + res +} + + +#' Power calculation based on RMST method +#' +#' @param enrollRates enrollment rates +#' @param failRates failure and dropout rates +#' @param analysisTimes Minimum time of analysis +#' @param ratio Experimental:Control randomization ratio +#' @param alpha One-sided Type I error (strictly between 0 and 1) +#' @param test A string specifies the type of statistical test. +#' Default is \code{"survival difference"} (a Kaplan-Meier based test). +#' One can also set it as \code{"rmst difference"} (another Kaplan-Meier based test) +#' @param tau desired milestone for \code{test = "survival difference"} or \code{test = "rmst difference"} +#' +#' @examples +#' # set enrollment rates +#' enrollRates <- tibble::tibble(Stratum = "All", duration = 12, rate = 500/12) +#' +#' # set failure rates +#' failRates <- tibble::tibble( +#' Stratum = "All", +#' duration = c(4, 100), +#' failRate = log(2) / 15, # median survival 15 month +#' hr = c(1, .6), +#' dropoutRate = 0.001) +#' +#' fixed_design_power_rmst(enrollRates, failRates, analysisTimes = 36) +#' fixed_design_power_rmst(enrollRates, failRates, analysisTimes = 36, tau = 18) +#' +#' @noRd +fixed_design_power_rmst <- function(enrollRates, + failRates, + analysisTimes, + ratio = 1, + alpha = 0.025, + test = "rmst difference", + tau = NULL){ + + gs_arm <- gs_create_arm(enrollRates, failRates, ratio = ratio, total_time = analysisTimes) + arm0 <- gs_arm[["arm0"]] + arm1 <- gs_arm[["arm1"]] + + n <- sum(enrollRates$duration * enrollRates$rate) + n0 <- n / (ratio + 1) + n1 <- n - n0 + arm0$size <- n0 + arm1$size <- n1 + + d <- prob_event.arm(arm0, tmax = arm0$total_time) * n0 + prob_event.arm(arm1, tmax = arm0$total_time) * n1 + + # Sample size for RMST at cut point + npsurv <- npsurvSS::power_two_arm(arm0, arm1, + alpha = alpha, + test = list(test = test, milestone = if(is.null(tau)){arm0$total_time}else{tau})) + + bounds <- tibble::tibble( + Analysis = 1, + Bound = "Upper", + Probability = npsurv, + Probability0 = alpha, + Z = - qnorm(alpha)) + + analysis <- tibble::tibble( + Analysis = 1, + Time = analysisTimes, + N = n, + Events = d) + + res <- list(enrollRates = enrollRates, + failRates = failRates, + bounds = bounds, + analysis = analysis) + + res +} \ No newline at end of file diff --git a/R/s2pwe.R b/R/s2pwe.R deleted file mode 100644 index 5cb0229e0..000000000 --- a/R/s2pwe.R +++ /dev/null @@ -1,75 +0,0 @@ -# Copyright (c) 2022 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. All rights reserved. -# -# This file is part of the gsDesign2 program. -# -# gsDesign2 is free software: you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation, either version 3 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program. If not, see . - -#' @importFrom dplyr lag select "%>%" -#' @importFrom tibble tibble -NULL - -#' Approximate survival distribution with piecewise exponential distribution -#' -#' \code{s2pwe} converts a discrete set of points from an arbitrary survival distribution -#' to a piecewise exponential approximation -#' @param times Positive increasing times at which survival distribution is provided. -#' @param survival Survival (1 - cumulative distribution function) at specified `times` -#' @section Specification: -#' \if{latex}{ -#' \itemize{ -#' \item Validate if input times is increasing positive finite numbers. -#' \item Validate if input survival is numeric and same length as input times. -#' \item Validate if input survival is positive, non-increasing, less than or equal to 1 and greater than 0. -#' \item Create a tibble of inputs times and survival. -#' \item Calculate the duration, hazard and the rate. -#' \item Return the duration and rate by \code{s2pwe} -#' } -#' } -#' \if{html}{The contents of this section are shown in PDF user manual only.}#' @return A `tibble` with `duration` and 'rate' -#' @return A tibble containing the duration and rate. -#' @examples -#' # Example: arbitrary numbers -#' s2pwe(1:9,(9:1)/10) -#' # Example: lognormal -#' s2pwe(c(1:6,9),plnorm(c(1:6,9),meanlog=0,sdlog=2,lower.tail=FALSE)) -#' @export -s2pwe <- function(times, survival){ -# check input values - # check that times are positive, ordered, unique and finite numbers - if(!is.numeric(times)){stop("gsDesign2: times in `s2pwe()` must be increasing positive finite numbers")} - if(!min(times) > 0){stop("gsDesign2: times in `s2pwe()` must be increasing positive finite numbers")} - if(!max(times) < Inf){stop("gsDesign2: times in `s2pwe()` must be increasing positive finite numbers")} - len <- length(times) - if(!if(len>1){min(times[2:len]-times[1:(len-1)]) > 0}){stop("gsDesign2: times in `s2pwe()`must be increasing positive finite numbers")} - - # check that survival is numeric and same length as times - if(!is.numeric(survival)){stop("gsDesign2: survival in `s2pwe()` must be numeric and of same length as times")} - if(!length(survival) == len){stop("gsDesign2: survival in `s2pwe()` must be numeric and of same length as times")} - - # check that survival is positive, non-increasing, less than or equal to 1 and gt 0 - if(!min(survival) > 0){stop("gsDesign2: survival in `s2pwe()` must be non-increasing positive finite numbers less than or equal to 1 with at least 1 value < 1")} - if(!max(survival) <= 1){stop("gsDesign2: survival in `s2pwe()` must be non-increasing positive finite numbers less than or equal to 1 with at least 1 value < 1")} - if(!min(survival) < 1){stop("gsDesign2: survival in `s2pwe()` must be non-increasing positive finite numbers less than or equal to 1 with at least 1 value < 1")} - if(len>1){ - if(!min(survival[2:len]-survival[1:(len-1)]) <= 0 ){stop("gsDesign2: survival in `s2pwe()` must be non-increasing positive finite numbers less than or equal to 1 with at least 1 value < 1")} - } - - xx <- tibble::tibble(Times=times, Survival = survival) %>% - mutate(duration = Times - lag(Times, default = 0), - H = -log(Survival), - rate = (H-lag(H,default=0)) / duration - ) %>% - select(duration,rate) - return(xx) -} diff --git a/R/summary.R b/R/summary.R new file mode 100644 index 000000000..8c1a5a491 --- /dev/null +++ b/R/summary.R @@ -0,0 +1,500 @@ +# Copyright (c) 2021 Merck Sharp & Dohme Corp. a subsidiary of Merck & Co., Inc., Kenilworth, NJ, USA. +# +# This file is part of the gsdmvn program. +# +# gsdmvn is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +#' S3 class method to summary fixed or group sequential design +#' +#' @param x a fixed design object or a group sequential design object +#' @param ... additional arguments +#' +#' @return a R data frame +#' @export +#' +summary <- function(x, ...) { + UseMethod("summary", x) +} + +#' summary function to fixed_design class +#' @rdname summary.fixed_design +#' +#' @title summary for \code{fixed_design()} object +#' @param x a fixed design object returned by \code{fixed_design()} +#' @param ... additional arguments +#' +#' @export summary +#' @exportS3Method +#' @method summary fixed_design +#' +#' @examples +#' library(dplyr) +#' +#' # Enrollment rate +#' enrollRates <- tibble::tibble( +#' Stratum = "All", +#' duration = 18, +#' rate = 20) +#' +#' # Failure rates +#' failRates <- tibble::tibble( +#' Stratum = "All", +#' duration = c(4, 100), +#' failRate = log(2) / 12, +#' hr = c(1, .6), +#' dropoutRate = .001) +#' +#' # Study duration in months +#' studyDuration <- 36 +#' +#' # Experimental / Control randomization ratio +#' ratio <- 1 +#' +#' # 1-sided Type I error +#' alpha <- 0.025 +#' # Type II error (1 - power) +#' beta <- 0.1 +#' +#' # ------------------------- # +#' # AHR # +#' # ------------------------- # +#' # under fixed power +#' fixed_design( +#' x = "AHR", +#' alpha = alpha, +#' power = 1 - beta, +#' enrollRates = enrollRates, +#' failRates = failRates, +#' studyDuration = studyDuration, +#' ratio = ratio +#' ) %>% summary() +#' +#' # ------------------------- # +#' # FH # +#' # ------------------------- # +#' # under fixed power +#' fixed_design( +#' x = "FH", +#' alpha = alpha, +#' power = 1 - beta, +#' enrollRates = enrollRates, +#' failRates = failRates, +#' studyDuration = studyDuration, +#' ratio = ratio +#' ) %>% summary() +#' +summary.fixed_design <- function(x, ...){ + x_design <- switch(x$design, + "AHR" = {"Average hazard ratio"}, + "LF" = {"Lachin and Foulkes"}, + "RD" = {"Risk difference"}, + "Milestone" = {paste0("Milestone: tau = ", x$design_par$tau)}, + "RMST" = {paste0("RMST: tau = ", x$design_par$tau)}, + "MB" = {paste0("Modestly weighted LR: tau = ", x$design_par$tau)}, + "FH" = { + if(x$design_par$rho == 0 & x$design_par$gamma == 0){ + paste0("Fleming-Harrington FH(0, 0) (logrank)") + }else{ + paste0("Fleming-Harrington FH(", x$design_par$rho, ", ", x$design_par$gamma, ")") + } + }, + "MaxCombo" = { + temp <- paste0("MaxCombo: FH(", + paste(apply(do.call(rbind, x$design_par[c(1:2)]), 2 , paste , collapse = ", " ), collapse = "), FH("), + ")") + gsub(pattern = "FH\\(0, 0\\)", replacement = "logrank", x = temp) + } + ) + + ans <- x$analysis %>% mutate(Design = x_design) + class(ans) <- c("fixed_design", x$design, class(ans)) + return(ans) +} + + +#' This is the function to generate a R table summarizing the bounds +#' in the group sequential design generated by +#' \code{gs_design_ahr} or \code{gs_design_wlr} or \code{gs_design_combo}. +#' +#' @rdname summary.gs_design +#' +#' @param x an object returned by \code{gs_design_ahr} or \code{gs_design_wlr} or \code{gs_design_combo} +#' @param analysis_vars the variables to be put at the summary header of each analysis +#' @param analysis_decimals the displayed number of digits of \code{analysis_vars} +#' @param col_vars the variables to be displayed +#' @param col_decimals the decimals to be displayed for the displayed variables in \code{col_vars} +#' @param bound_names names for bounds; default = c("Efficacy", "Futility"). +#' @param ... additional arguments +#' @return a summary table +#' +#' @export summary +#' @exportS3Method +#' @method summary gs_design +#' +#' @examples +#' # ---------------------------- # +#' # design parameters # +#' # ---------------------------- # +#' library(tibble) +#' library(gsDesign) +#' library(gsDesign2) +#' library(dplyr) +#' +#' # enrollment/failure rates +#' enrollRates <- tibble(Stratum = "All", +#' duration = 12, +#' rate = 1) +#' failRates <- tibble(Stratum = "All", duration = c(4, 100), +#' failRate = log(2) / 12, +#' hr = c(1, .6), +#' dropoutRate = .001) +#' +#' # Information fraction +#' IF <- (1:3)/3 +#' +#' # Analysis times in months; first 2 will be ignored as IF will not be achieved +#' analysisTimes <- c(.01, .02, 36) +#' +#' # Experimental / Control randomization ratio +#' ratio <- 1 +#' +#' # 1-sided Type I error +#' alpha <- 0.025 +#' +#' # Type II error (1 - power) +#' beta <- .1 +#' +#' # Upper bound +#' upper <- gs_spending_bound +#' upar <- list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL) +#' +#' # Lower bound +#' lower <- gs_spending_bound +#' lpar <- list(sf = gsDesign::sfHSD, total_spend = 0.1, param = 0, timing = NULL) +#' +#' # weight function in WLR +#' wgt00 <- function(x, arm0, arm1){wlr_weight_fh(x, arm0, arm1, rho = 0, gamma = 0)} +#' wgt05 <- function(x, arm0, arm1){wlr_weight_fh(x, arm0, arm1, rho = 0, gamma = .5)} +#' +#' # test in COMBO +#' fh_test <- rbind( +#' data.frame(rho = 0, gamma = 0, tau = -1, test = 1, Analysis = 1:3,analysisTimes = c(12, 24, 36)), +#' data.frame(rho = c(0, 0.5), gamma = 0.5, tau = -1, test = 2:3, Analysis = 3, analysisTimes = 36) +#' ) +#' +#' # ---------------------------- # +#' # ahr # +#' # ---------------------------- # +#' x_ahr <- gs_design_ahr( +#' enrollRates = enrollRates, +#' failRates = failRates, +#' IF = IF, # Information fraction +#' analysisTimes = analysisTimes, +#' ratio = ratio, +#' alpha = alpha, +#' beta = beta, +#' upper = upper, +#' upar = upar, +#' lower = lower, +#' lpar = lpar) +#' +#' x_ahr %>% summary() +#' x_ahr %>% summary(analysis_vars = c("Time", "Events", "IF"), analysis_decimals = c(1, 0, 2)) +#' x_ahr %>% summary(bound_names = c("A is better", "B is better")) +#' +#' # ---------------------------- # +#' # wlr # +#' # ---------------------------- # +#' x_wlr <- gs_design_wlr( +#' enrollRates = enrollRates, +#' failRates = failRates, +#' weight = wgt05, +#' IF = NULL, +#' analysisTimes = sort(unique(x_ahr$analysis$Time)), +#' ratio = ratio, +#' alpha = alpha, +#' beta = beta, +#' upper = upper, +#' upar = upar, +#' lower = lower, +#' lpar = lpar +#' ) +#' x_wlr %>% summary() +#' +#' # ---------------------------- # +#' # max combo # +#' # ---------------------------- # +#' x_combo <- gs_design_combo( +#' ratio = 1, +#' alpha = 0.025, +#' beta = 0.2, +#' enrollRates = tibble::tibble(Stratum = "All", duration = 12, rate = 500/12), +#' failRates = tibble::tibble(Stratum = "All", duration = c(4, 100), +#' failRate = log(2) / 15, hr = c(1, .6), dropoutRate = .001), +#' fh_test = fh_test, +#' upper = gs_spending_combo, +#' upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025), +#' lower = gs_spending_combo, +#' lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.2)) +#' x_combo %>% summary() +#' +#' # ---------------------------- # +#' # risk difference # +#' # ---------------------------- # +#' gs_design_rd( +#' p_c = tibble(Stratum = "All", Rate = .2), +#' p_e = tibble(Stratum = "All", Rate = .15), +#' IF = c(0.7, 1), +#' rd0 = 0, +#' alpha = .025, +#' beta = .1, +#' ratio = 1, +#' stratum_prev = NULL, +#' weight = "un-stratified", +#' upper = gs_b, +#' lower = gs_b, +#' upar = gsDesign::gsDesign(k = 3, test.type = 1, sfu = gsDesign::sfLDOF, sfupar = NULL)$upper$bound, +#' lpar = c(qnorm(.1), rep(-Inf, 2)) +#' ) %>% summary() +#' +summary.gs_design <- function( + x, + analysis_vars = NULL, + analysis_decimals = NULL, + col_vars = NULL, + col_decimals = NULL, + bound_names = c("Efficacy", "Futility"), + ... +){ + method <- class(x)[class(x) %in% c("ahr", "wlr", "combo", "rd")] + x_bounds <- x$bounds + x_analysis <- x$analysis + K <- max(x_analysis$Analysis) + + # --------------------------------------------- # + # prepare the columns decimals # + # --------------------------------------------- # + if(method == "ahr"){ + if(is.null(col_vars) & is.null(col_decimals)){ + x_decimals <- tibble::tibble( + col_vars = c("Analysis", "Bound", "Z", "~HR at bound", "Nominal p", "Alternate hypothesis", "Null hypothesis"), + col_decimals = c(NA, NA, 2, 4, 4, 4, 4)) + }else{ + x_decimals <- tibble::tibble(col_vars = col_vars, col_decimals = col_decimals) + } + } + if(method == "wlr"){ + if(is.null(col_vars) & is.null(col_decimals)){ + x_decimals <- tibble::tibble( + col_vars = c("Analysis", "Bound", "Z", "~wHR at bound", "Nominal p", "Alternate hypothesis", "Null hypothesis"), + col_decimals = c(NA, NA, 2, 4, 4, 4, 4)) + }else{ + x_decimals <- tibble::tibble(col_vars = col_vars, col_decimals = col_decimals) + } + } + if(method == "combo"){ + if(is.null(col_vars) & is.null(col_decimals)){ + x_decimals <- tibble::tibble( + col_vars = c("Analysis", "Bound", "Z", "Nominal p", "Alternate hypothesis", "Null hypothesis"), + col_decimals = c(NA, NA, 2, 4, 4, 4)) + }else{ + x_decimals <- tibble::tibble(col_vars = col_vars, col_decimals = col_decimals) + } + } + + if(method == "rd"){ + if(is.null(col_vars) & is.null(col_decimals)){ + x_decimals <- tibble::tibble( + col_vars = c("Analysis", "Bound", "Z", "~Risk difference at bound", "Nominal p", "Alternate hypothesis", "Null hypothesis"), + col_decimals = c(NA, NA, 2, 4, 4, 4, 4)) + }else{ + x_decimals <- tibble::tibble(col_vars = col_vars, col_decimals = col_decimals) + } + } + + # --------------------------------------------- # + # prepare the analysis summary row # + # --------------------------------------------- # + # get the + # (1) analysis variables to be displayed on the header + # (2) decimals to be displayed for the analysis variables in (3) + if(is.null(analysis_vars) & is.null(analysis_decimals)){ + if(method %in% c("ahr", "wlr")){ + analysis_vars <- c("Time", "N", "Events", "AHR", "IF") + analysis_decimals <- c(1, 1, 1, 2, 2) + } + if(method == "combo"){ + analysis_vars <- c("Time", "N", "Events", "AHR", "EF") + analysis_decimals <- c(1, 1, 1, 2, 2) + } + if(method == "rd"){ + analysis_vars <- c("N", "rd", "IF") + analysis_decimals <- c(1, 4, 2) + } + }else if(is.null(analysis_vars) & !is.null(analysis_decimals)){ + stop("summary: please input analysis_vars and analysis_decimals in pairs!") + }else if(!is.null(analysis_vars) & is.null(analysis_decimals)){ + stop("summary: please input analysis_vars and analysis_decimals in pairs!") + } + # set the analysis summary header + analyses <- x_analysis %>% + dplyr::group_by(Analysis) %>% + dplyr::filter(dplyr::row_number() == 1) %>% + dplyr::select(all_of(c("Analysis", analysis_vars))) %>% + dplyr::arrange(Analysis) + + # --------------------------------------------- # + # merge 2 tables: # + # (1) alternate hypothesis table # + # (2) null hypothesis table # + # --------------------------------------------- # + # table A: a table under alternative hypothesis + xy <- x_bounds %>% + dplyr::rename("Alternate hypothesis" = Probability) %>% + dplyr::rename("Null hypothesis" = Probability0) %>% + # change Upper -> bound_names[1], e.g., Efficacy + # change Lower -> bound_names[2], e.g., Futility + dplyr::mutate(Bound = dplyr::recode(Bound, "Upper" = bound_names[1], "Lower" = bound_names[2])) + + if("Probability0" %in% colnames(x_bounds)){ + xy <- x_bounds %>% + dplyr::rename("Alternate hypothesis" = Probability) %>% + dplyr::rename("Null hypothesis" = Probability0) + }else{ + xy <- x_bounds %>% + dplyr::rename("Alternate hypothesis" = Probability) %>% + tibble::add_column("Null hypothesis" = "-") + } + # change Upper -> bound_names[1], e.g., Efficacy + # change Lower -> bound_names[2], e.g., Futility + xy <- xy %>% + dplyr::mutate(Bound = dplyr::recode(Bound, "Upper" = bound_names[1], "Lower" = bound_names[2])) %>% + dplyr::arrange(Analysis,desc(Bound)) + + # tbl_a <- x_bounds %>% + # dplyr::filter(hypothesis == "H1") %>% + # dplyr::rename("Alternate hypothesis" = Probability) %>% + # # change Upper -> bound_names[1], e.g., Efficacy + # # change Lower -> bound_names[2], e.g., Futility + # dplyr::mutate(Bound = dplyr::recode(Bound, "Upper" = bound_names[1], "Lower" = bound_names[2])) + # + # # table B: a table under null hypothesis + # tbl_b <- x_bounds %>% + # dplyr::filter(hypothesis == "H0") %>% + # dplyr::rename("Null hypothesis" = Probability) %>% + # dplyr::mutate(Bound = dplyr::recode(Bound, "Upper" = bound_names[1], "Lower" = bound_names[2])) %>% + # dplyr::select(all_of(c("Analysis", "Bound", "Null hypothesis"))) + # + # xy <- full_join(tbl_a, tbl_b, by = c("Analysis", "Bound")) + + # --------------------------------------------- # + # merge 2 tables: # + # (1) analysis summary table # + # (2) xy: bound_summary_detail table # + # --------------------------------------------- # + # Merge 3 tables: 1 line per analysis, alternate hypothesis table, null hypothesis table + # if the method is AHR + if(method == "ahr"){ + # header + analysis_summary_header <- analyses %>% dplyr::select(all_of(c("Analysis", analysis_vars))) + # bound details + bound_summary_detail <- xy + } + + # if the method is WLR, change AHR to wAHR + if(method == "wlr"){ + # header + analysis_summary_header <- analyses %>% dplyr::select(all_of(c("Analysis", analysis_vars))) + if("AHR" %in% analysis_vars){ + analysis_summary_header <- analysis_summary_header %>% dplyr::rename(wAHR = AHR) + } + # bound details + if("~HR at bound" %in% names(xy)){ + bound_summary_detail <- xy %>% dplyr::rename("~wHR at bound" = "~HR at bound") + }else{ + bound_summary_detail <- xy + } + } + + # if the method is COMBO, remove the column of "~HR at bound", and remove AHR from header + if(method == "combo"){ + # header + analysis_summary_header <- analyses %>% dplyr::select(all_of(c("Analysis", analysis_vars))) + # bound details + if("~HR at bound" %in% names(xy)){ + stop("summary: ~HR at bound can't be display!") + }else{ + bound_summary_detail <- xy + } + } + + # if the method is RD + if(method == "rd"){ + # header + analysis_summary_header <- analyses %>% + dplyr::select(all_of(c("Analysis", analysis_vars))) %>% + dplyr::rename("risk difference" = rd) + # bound details + bound_summary_detail <- xy + } + + output <- table_ab( + # A data frame to be show as the summary header + # It has only ONE record for each value of `byvar` + table_a = analysis_summary_header, + # A data frame to be shown as the listing details + # It has >= 1 records for each value of `byvar` + table_b = bound_summary_detail, + decimals = c(0, analysis_decimals), + byvar = "Analysis" + ) %>% + dplyr::group_by(Analysis) + + + if(method == "ahr"){ + output <- output %>% select(Analysis, Bound, Z, `~HR at bound`, `Nominal p`, `Alternate hypothesis`, `Null hypothesis`) + }else if(method == "wlr"){ + output <- output %>% select(Analysis, Bound, Z, `~wHR at bound`, `Nominal p`, `Alternate hypothesis`, `Null hypothesis`) + }else if(method == "combo"){ + output <- output %>% select(Analysis, Bound, Z, `Nominal p`, `Alternate hypothesis`, `Null hypothesis`) + }else if(method == "rd"){ + output <- output %>% select(Analysis, Bound, Z, `~Risk difference at bound`, `Nominal p`, `Alternate hypothesis`, `Null hypothesis`) + } + + # --------------------------------------------- # + # set the decimals to display # + # --------------------------------------------- # + output <- output %>% select(x_decimals$col_vars) + if("Z" %in% colnames(output)){ + output <- output %>% dplyr::mutate_at("Z", round, (x_decimals %>% filter(col_vars == "Z"))$col_decimals) + } + if("~HR at bound" %in% colnames(output)){ + output <- output %>% dplyr::mutate_at("~HR at bound", round, (x_decimals %>% filter(col_vars == "~HR at bound"))$col_decimals) + } + if("~Risk difference at bound" %in% colnames(output)){ + output <- output %>% dplyr::mutate_at("~Risk difference at bound", round, (x_decimals %>% filter(col_vars == "~Risk difference at bound"))$col_decimals) + } + if("Nominal p" %in% colnames(output)){ + output <- output %>% dplyr::mutate_at("Nominal p", round, (x_decimals %>% filter(col_vars == "Nominal p"))$col_decimals) + } + if("Alternate hypothesis" %in% colnames(output)){ + output <- output %>% dplyr::mutate_at("Alternate hypothesis", round, (x_decimals %>% filter(col_vars == "Alternate hypothesis"))$col_decimals) + } + if("Null hypothesis" %in% colnames(output) & is.vector(output[["Null hypothesis"]], mode = "numeric")){ + output <- output %>% dplyr::mutate_at("Null hypothesis", round, (x_decimals %>% filter(col_vars == "Null hypothesis"))$col_decimals) + } + + class(output) <- c(method, "gs_design", class(output)) + return(output) +} \ No newline at end of file diff --git a/R/tEvents.R b/R/tEvents.R index 6bf48b06a..5bea50e87 100644 --- a/R/tEvents.R +++ b/R/tEvents.R @@ -1,4 +1,5 @@ -# Copyright (c) 2022 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. All rights reserved. +# Copyright (c) 2021 Merck Sharp & Dohme Corp., a subsidiary of +# Merck & Co., Inc., Kenilworth, NJ, USA. # # This file is part of the gsDesign2 program. # @@ -33,6 +34,7 @@ NULL #' @param ratio Experimental:Control randomization ratio. #' @param interval An interval that is presumed to include the time at which #' expected event count is equal to `targetEvents`. +#' #' @section Specification: #' \if{latex}{ #' \itemize{ @@ -40,41 +42,78 @@ NULL #' \item Return a tibble with a single row with the output from `AHR()` got the specified output. #' } #' } +#' #' @return A `tibble` with `Time` (computed to match events in `targetEvents`), `AHR` (average hazard ratio), #' `Events` (`targetEvents` input), info (information under given scenarios), #' and info0 (information under related null hypothesis) for each value of `totalDuration` input; +#' #' @examples -#' # Example 1: default +#' # ------------------------# +#' # Example 1 # +#' # ------------------------# +#' # default #' tEvents() -#' # Example 2: check that result matches a finding using AHR() +#' +#' # ------------------------# +#' # Example 2 # +#' # ------------------------# +#' # check that result matches a finding using AHR() #' # Start by deriving an expected event count -#' enrollRates <- -#' tibble::tibble(Stratum="All", -#' duration=c(2,2,10), -#' rate=c(3,6,9)*5) -#' failRates=tibble::tibble(Stratum="All",duration=c(3,100),failRate=log(2)/c(9,18), -#' hr=c(.9,.6),dropoutRate=rep(.001,2)) +#' enrollRates <- tibble::tibble(Stratum = "All", duration = c(2, 2, 10), rate = c(3, 6, 9) * 5) +#' failRates <- tibble::tibble(Stratum = "All", duration = c(3, 100), failRate = log(2) / c(9, 18), +#' hr = c(.9,.6), dropoutRate = rep(.001, 2)) #' totalDuration <- 20 -#' xx <- AHR(enrollRates,failRates,totalDuration) +#' xx <- AHR(enrollRates, failRates, totalDuration) #' xx +#' #' # Next we check that the function confirms the timing of the final analysis. -#' tEvents(enrollRates,failRates,targetEvents=xx$Events,interval=c(.5,1.5)*xx$Time) +#' tEvents(enrollRates, failRates, +#' targetEvents = xx$Events, interval = c(.5, 1.5) * xx$Time) +#' #' @export #' -tEvents <- function(enrollRates=tibble::tibble(Stratum="All", - duration=c(2, 2, 10), - rate=c(3, 6, 9) * 5), - failRates=tibble::tibble(Stratum="All", - duration=c(3, 100), - failRate=log(2) / c(9, 18), - hr=c(.9, .6), - dropoutRate=rep(.001, 2)), - targetEvents=150, +tEvents <- function(enrollRates = tibble::tibble(Stratum = "All", + duration = c(2, 2, 10), + rate = c(3, 6, 9) * 5), + failRates = tibble::tibble(Stratum = "All", + duration = c(3, 100), + failRate = log(2) / c(9, 18), + hr = c(.9, .6), + dropoutRate = rep(.001, 2)), + targetEvents = 150, ratio = 1, - interval=c(.01, 100) + interval = c(.01, 100) ){ - res <- try(uniroot(function(x){AHR(enrollRates, failRates, x, ratio)$Events - targetEvents}, - interval)) - if(inherits(res,"try-error")){stop("tEvents solution not found")} - AHR(enrollRates, failRates, res$root, ratio) -} + # ----------------------------# + # check inputs # + # ----------------------------# + check_ratio(ratio) + if(length(targetEvents) > 1){ + stop("tEvents(): the input targetEvents` should be a positive numer, rather than a vector!") + } + + # ----------------------------# + # build a help function # + # ----------------------------# + # find the difference between `AHR()` and different values of totalDuration + foo <- function(x){ + ans <- AHR(enrollRates = enrollRates, failRates = failRates, + totalDuration = x, ratio = ratio)$Events - targetEvents + return(ans) + } + + # ----------------------------# + # uniroot AHR() # + # over totalDuration # + # ----------------------------# + res <- try(uniroot(foo, interval)) + + if(inherits(res,"try-error")){ + stop("tEvents(): solution not found!") + }else{ + ans <- AHR(enrollRates = enrollRates, failRates = failRates, + totalDuration = res$root, ratio = ratio) + return(ans) + } + +} \ No newline at end of file diff --git a/R/tEvents_.R b/R/tEvents_.R new file mode 100644 index 000000000..669379c65 --- /dev/null +++ b/R/tEvents_.R @@ -0,0 +1,84 @@ +# Copyright (c) 2021 Merck Sharp & Dohme Corp., a subsidiary of +# Merck & Co., Inc., Kenilworth, NJ, USA. +# +# This file is part of the gsDesign2 program. +# +# gsDesign2 is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +#' @importFrom stats uniroot +NULL + +#' Predict time at which a targeted event count is achieved +#' +#' \code{tEvents()} is made to match input format with \code{AHR()} and to solve for the +#' time at which the expected accumulated events is equal to an input target. +#' Enrollment and failure rate distributions are specified as follows. +#' The piecewise exponential distribution allows a simple method to specify a distribtuion +#' and enrollment pattern +#' where the enrollment, failure and dropout rates changes over time. +#' @param enrollRates Piecewise constant enrollment rates by stratum and time period. +#' @param failRates Piecewise constant control group failure rates, duration for each piecewise constant period, +#' hazard ratio for experimental vs control, and dropout rates by stratum and time period. +#' @param targetEvents The targeted number of events to be achieved. +#' @param ratio Experimental:Control randomization ratio. +#' @param interval An interval that is presumed to include the time at which +#' expected event count is equal to `targetEvents`. +#' @section Specification: +#' \if{latex}{ +#' \itemize{ +#' \item Use root-finding routine with `AHR()` to find time at which targeted events accrue. +#' \item Return a tibble with a single row with the output from `AHR()` got the specified output. +#' } +#' } +#' +#' @return A `tibble` with `Time` (computed to match events in `targetEvents`), `AHR` (average hazard ratio), +#' `Events` (`targetEvents` input), info (information under given scenarios), +#' and info0 (information under related null hypothesis) for each value of `totalDuration` input; +#' +#' @examples +#' # Example 1: default +#' gsDesign2:::tEvents_() +#' +#' # Example 2: check that result matches a finding using AHR() +#' # Start by deriving an expected event count +#' enrollRates <- +#' tibble::tibble(Stratum="All", +#' duration=c(2,2,10), +#' rate=c(3,6,9)*5) +#' failRates=tibble::tibble(Stratum="All",duration=c(3,100),failRate=log(2)/c(9,18), +#' hr=c(.9,.6),dropoutRate=rep(.001,2)) +#' totalDuration <- 20 +#' xx <- AHR(enrollRates,failRates,totalDuration) +#' xx +#' # Next we check that the function confirms the timing of the final analysis. +#' gsDesign2:::tEvents_(enrollRates,failRates,targetEvents=xx$Events,interval=c(.5,1.5)*xx$Time) +#' +#' @noRd +tEvents_ <- function(enrollRates=tibble::tibble(Stratum="All", + duration=c(2, 2, 10), + rate=c(3, 6, 9) * 5), + failRates=tibble::tibble(Stratum="All", + duration=c(3, 100), + failRate=log(2) / c(9, 18), + hr=c(.9, .6), + dropoutRate=rep(.001, 2)), + targetEvents=150, + ratio = 1, + interval=c(.01, 100) +){ + res <- try(uniroot(function(x){AHR(enrollRates, failRates, x, ratio)$Events - targetEvents}, + interval)) + if(inherits(res,"try-error")){stop("tEvents solution not found")} + AHR(enrollRates, failRates, res$root, ratio) +} \ No newline at end of file diff --git a/R/utility_combo.R b/R/utility_combo.R new file mode 100644 index 000000000..77a1a8e4e --- /dev/null +++ b/R/utility_combo.R @@ -0,0 +1,478 @@ +# Copyright (c) 2021 Merck Sharp & Dohme Corp. a subsidiary of Merck & Co., Inc., Kenilworth, NJ, USA. +# +# This file is part of the gsdmvn program. +# +# gsdmvn is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +#' @importFrom mvtnorm GenzBretz +#' +#' @param enrollRates enrollment rates +#' @param failRates failure and dropout rates +#' @param ratio Experimental:Control randomization ratio (not yet implemented) +#' @param fh_test weighting tests +#' @param algorithm numerical algorithms +#' +#' @section Specification: +#' \if{latex}{ +#' \itemize{ +#' \item Define the analysis time from input fh_test. +#' \item Compute arm0 and arm1 using \code{gs_create_arm()}. +#' \item Set a unique test. +#' \item Compute the information fraction using \code{gs_info_combo()}. +#' \item Compute the correlation between tests. +#' \item Compute the correlation between analysis. +#' \item Compute the overall correlation. +#' \item Extract the sample size from info. +#' \item Compute information restricted to actual analysis. +#' \item Compute the effect size. +#' \item Return a list of info_all = info, info = info_fh, theta = theta_fh, corr = corr_fh. +#' } +#' } +#' \if{html}{The contents of this section are shown in PDF user manual only.} +#' +#' @noRd +gs_utility_combo <- function(enrollRates, + failRates, + fh_test, + ratio = 1, + algorithm = GenzBretz(maxpts = 1e5, abseps = 1e-5), + ...){ + + # Define analysis time + analysisTimes <- sort(unique(fh_test$analysisTimes)) + + # Define Arm + gs_arm <- gs_create_arm(enrollRates, failRates, + ratio = ratio, # Randomization ratio + total_time = max(analysisTimes)) # Total study duration + + arm0 <- gs_arm[["arm0"]] + arm1 <- gs_arm[["arm1"]] + + # Unique test + u_fh_test <- unique(fh_test[, c("test","rho", "gamma", "tau")] ) + + # Information Fraction + info <- gs_info_combo(enrollRates, failRates, ratio, + analysisTimes = analysisTimes, + rho = u_fh_test$rho, + gamma = u_fh_test$gamma) + + # Correlation between test + corr_test <- with(u_fh_test, + lapply(analysisTimes, function(tmax){ + cov2cor(gs_sigma2_combo(arm0, arm1, tmax = tmax, + rho = rho, gamma = gamma, tau = tau)) + }) + ) + + # Correlation between analysis + info_split <- split(info, info$test) + corr_time <- lapply(info_split, function(x){ + corr <- with(x, outer(sqrt(info), sqrt(info), function(x,y) pmin(x,y) / pmax(x,y))) + rownames(corr) <- analysisTimes + colnames(corr) <- analysisTimes + corr + }) + + # Overall Correlation + corr_combo <- diag(1, nrow = nrow(info)) + for(i in 1:nrow(info)){ + for(j in 1:nrow(info)){ + t1 <- as.numeric(info$Analysis[i]) + t2 <- as.numeric(info$Analysis[j]) + if(t1 <= t2){ + test1 <- as.numeric(info$test[i]) + test2 <- as.numeric(info$test[j]) + corr_combo[i,j] <- corr_test[[t1]][test1,test2] * corr_time[[test2]][t1, t2] + corr_combo[j,i] <- corr_combo[i,j] + } + } + } + + # Sample size + n <- max(info$N) + + # Restricted to actual analysis + info_fh <- merge(info, fh_test, all = TRUE) + corr_fh <- corr_combo[! is.na(info_fh$gamma), ! is.na(info_fh$gamma)] + info_fh <- subset(info_fh, ! is.na(gamma)) + + # Effect size + theta_fh <- (- info_fh$delta) / sqrt(info_fh$sigma2) + + list(info_all = info, info = info_fh, theta = theta_fh, corr = corr_fh) + +} + + +#' Multivariate Normal Distribution for Multivariate Maximum Statistics +#' +#' Computes the distribution function of the multivariate normal distribution +#' with maximum statistics for arbitrary limits and correlation matrices +#' @importFrom mvtnorm GenzBretz +#' @inheritParams mvtnorm::pmvnorm +#' +#' @param group the vector of test statistics group. +#' @param ... additional parameters transfer to `mvtnorm::pmvnorm` +#' +#' @details +#' Let $Z = {Z_ij}$ be a multivariate normal distribution. +#' Here i is a group indicator and j is a within group statistics indicator. +#' Let G_i = max({Z_ij}) for all test within one group. +#' This program are calculating the probability +#' +#' $$Pr( lower < max(G) < upper )$$ +#' +#' @export +pmvnorm_combo <- function(lower, + upper, + group, + mean, + corr, + algorithm = GenzBretz(maxpts= 1e5, abseps= 1e-5), + ...){ + + # Number of test in each group + n_test <- as.numeric(table(group)) + + + # Ensure positive definitive of the correlation matrix + if(! corpcor::is.positive.definite(corr)){ + corr <- corpcor::make.positive.definite(corr) + corr <- stats::cov2cor(corr) + } + + # One dimension test + if(length(mean) == 1){ + p <- pnorm(mean, lower) - pnorm(mean, upper) + return(p) + } + + # One test for all group or lower bound is -Inf. + if(all(n_test == 1) | all(lower == -Inf) ){ + p <- mvtnorm::pmvnorm(lower = rep(lower, n_test), + upper = rep(upper, n_test), + mean = mean, + corr = corr, + sigma = NULL, + algorithm = algorithm, + ...) + + return(p) + + # General Algorithm + }else{ + + # Re-arrange test based on the order for number of test + group <- as.numeric(factor(group, order(n_test))) + + mean <- mean[order(group)] + corr <- corr[order(group), order(group)] + group <- group[order(group)] + + n_test <- as.numeric(table(group)) + + + + # Split by number of test == 1 + lower1 <- lower[n_test == 1] + upper1 <- upper[n_test == 1] + + lower2 <- lower[n_test > 1] + upper2 <- upper[n_test > 1] + + # Combination of all possible test + k <- length(lower2) + test_ind <- split(matrix(c(1,-1), nrow = k, ncol = 2, byrow = TRUE), 1:k) + test_ind <- expand.grid(test_ind) + test <- split(test_ind, 1:nrow(test_ind)) + + p <- sapply(test, function(x){ + lower_bound <- rep(c(lower1, rep(-Inf, k)), n_test) + upper_bound <- rep(c(upper1, ifelse(x == 1, upper2, lower2)), n_test) + + p_bound <- mvtnorm::pmvnorm(lower = lower_bound, + upper = upper_bound, + mean = mean, + corr = corr, + sigma = NULL, + algorithm = algorithm, + ...) + + prod(x) * p_bound + + }) + + return(sum(p)) + + } + +} + + +#' Create "npsurvSS" arm object +#' +#' @param total_time total analysis time +#' @inheritParams gs_info_ahr +#' +#' @section Specification: +#' \if{latex}{ +#' \itemize{ +#' \item Validate if there is only one stratum. +#' \item Calculate the accrual duration. +#' \item calculate the accrual intervals. +#' \item Calculate the accrual parameter as the proportion of enrollment rate*duration. +#' \item Set cure proportion to zero. +#' \item set survival intervals and shape. +#' \item Set fail rate in failRates to the Weibull scale parameter for the survival distribution in the arm 0. +#' \item Set the multiplication of hazard ratio and fail rate to the Weibull scale parameter +#' for the survival distribution in the arm 1. +#' \item Set the shape parameter to one as the exponential distribution for +#' shape parameter for the loss to follow-up distribution +#' \item Set the scale parameter to one as the scale parameter for the loss to follow-up +#' distribution since the exponential distribution is supported only +#' \item Create arm 0 using \code{npsurvSS::create_arm()} using the parameters for arm 0. +#' \item Create arm 1 using \code{npsurvSS::create_arm()} using the parameters for arm 1. +#' \item Set the class of the two arms. +#' \item Return a list of the two arms. +#' } +#' } +#' \if{html}{The contents of this section are shown in PDF user manual only.} +#' +#' @noRd +gs_create_arm <- function(enrollRates, + failRates, + ratio, + total_time = 1e6){ + + n_stratum <- length(unique(enrollRates$Stratum)) + if(n_stratum > 1){ + stop("Only one stratum is supported") + } + + accr_time <- sum(enrollRates$duration) + accr_interval <- cumsum(enrollRates$duration) + accr_param <- enrollRates$rate * enrollRates$duration / sum(enrollRates$rate * enrollRates$duration) + + surv_cure <- 0 # No cure proportion + surv_interval <- c(0, c(utils::head(failRates$duration, -1), Inf)) + surv_shape <- 1 # Exponential Distribution + surv_scale0 <- failRates$failRate + surv_scale1 <- failRates$hr * failRates$failRate + + loss_shape <- 1 # Exponential Distribution + loss_scale <- failRates$dropoutRate[1] # Only Exponential Distribution is supported + + # Control Group + arm0 <- npsurvSS::create_arm(size = 1, + + accr_time = accr_time, + accr_dist = "pieceuni", + accr_interval = accr_interval, + accr_param = accr_param, + + surv_cure = surv_cure, + surv_interval = surv_interval, + surv_shape = surv_shape, + surv_scale = surv_scale0, + + loss_shape = loss_shape, + loss_scale = loss_scale, + + total_time = total_time) + + + # Control Group + arm1 <- npsurvSS::create_arm(size = ratio, + + accr_time = accr_time, + accr_dist = "pieceuni", + accr_interval = accr_interval, + accr_param = accr_param, + + surv_cure = surv_cure, + surv_interval = surv_interval, + surv_shape = surv_shape, + surv_scale = surv_scale1, + + loss_shape = loss_shape, + loss_scale = loss_scale, + + total_time = total_time) + + class(arm0) <- c("list", "arm") + class(arm1) <- c("list", "arm") + + list(arm0 = arm0, + arm1 = arm1) + +} + +#' Create weight in max combo test +#' @param rho weighting parameter +#' @param gamma weighting parameter +#' @param tau weighting parameter +#' +#' @noRd +get_combo_weight <- function(rho, gamma, tau){ + + stopifnot(length(rho) == length(gamma)) + stopifnot(length(rho) == length(tau)) + + weight <- list() + for(i in 1:length(rho)){ + + if(tau[i] == -1){ + tmp_tau <- NULL + }else{ + tmp_tau <- tau[i] + } + + text <- paste0("weight <- function(x, arm0, arm1){ + wlr_weight_fh(x, arm0, arm1 + ,rho =", rho[i], + ", gamma =", gamma[i], + ", tau =", tmp_tau, ")}") + + weight[[i]] <- text + + } + + weight +} + +#' Compute delta in max combo test +#' @noRd +gs_delta_combo <- function(arm0, + arm1, + tmax = NULL, + rho, + gamma, + tau = rep(-1, length(rho)), + approx="asymptotic", + normalization = FALSE) { + + stopifnot(length(tmax) == 1) + + weight <- get_combo_weight(rho, gamma, tau) + delta <- sapply(weight, function(x){ + x <- eval(parse(text = x)) + gs_delta_wlr(arm0, arm1, tmax = tmax, weight = x, + approx = approx, normalization = normalization) + }) + + delta + +} + +#' Compute delta in max combo test +#' @noRd +gs_sigma2_combo <- function(arm0, + arm1, + tmax = NULL, + rho, + gamma, + tau = rep(-1, length(rho)), + approx="asymptotic"){ + + stopifnot(length(tmax) == 1) + stopifnot(length(rho) == length(gamma)) + stopifnot(length(rho) == length(tau)) + + rho1 <- outer(rho, rho, function(x,y) (x+y)/2 ) + gamma1 <- outer(gamma, gamma, function(x,y) (x+y)/2 ) + + sigma2 <- rho1 + for(i in 1:length(rho)){ + + weight <- get_combo_weight(rho1[i,], gamma1[i,],tau) + + sigma2[i,] <- sapply(weight, function(x){ + x <- eval(parse(text = x)) + gs_sigma2_wlr(arm0, arm1, tmax = tmax, weight = x, + approx = approx) + + }) + } + + sigma2 + +} + +#' MaxCombo Group sequential boundary crossing probabilities +#' +#' @inheritParams pmvnorm_combo +#' @param upper_bound a numeric vector of upper bound +#' @param lower_bound a numeric vector of lower bound +#' @param analysis an integer vector of the interim analysis index +#' @param theta a numeric vector of effect size under alternative hypothesis +#' @param corr a matrix of correlation matrix +#' +#' @importFrom mvtnorm GenzBretz +#' +#' @noRd +gs_prob_combo <- function(upper_bound, + lower_bound, + analysis, + theta, + corr, + algorithm = GenzBretz(maxpts= 1e5, abseps= 1e-5), + ...){ + + n_analysis <- length(unique(analysis)) + + p <- c() + q <- c() + for(k in 1:n_analysis){ + k_ind <- analysis <= k + + + # Efficacy Bound + if(k == 1){ + lower <- upper_bound[1] + upper <- Inf + }else{ + lower <- c(lower_bound[1:(k-1)], upper_bound[k]) + upper <- c(upper_bound[1:(k-1)], Inf) + } + + + p[k] <- pmvnorm_combo(lower, + upper, + group = analysis[k_ind], + mean = theta[k_ind], + corr = corr[k_ind, k_ind]) + + # Futility Bound + if(k == 1){ + lower <- -Inf + upper <- lower_bound[k] + }else{ + lower <- c(lower_bound[1:(k-1)], -Inf) + upper <- c(upper_bound[1:(k-1)], lower_bound[k]) + } + + q[k] <- pmvnorm_combo(lower, + upper, + group = analysis[k_ind], + mean = theta[k_ind], + corr = corr[k_ind, k_ind]) + + } + + data.frame(Bound = rep(c("Upper", "Lower"), each = n_analysis), + Probability = c(cumsum(p),cumsum(q))) + +} \ No newline at end of file diff --git a/R/utility_tidy_tbl.R b/R/utility_tidy_tbl.R new file mode 100644 index 000000000..7ed41db39 --- /dev/null +++ b/R/utility_tidy_tbl.R @@ -0,0 +1,77 @@ +#' One-to-many table merge for presentation +#' @description +#' A table is desired based on a one-to-many mapping. +#' The data frame in `table_a` maps into `table_b` with the by variable `by_a` +#' Examples show how to use with the *gt* package for printing a compact combined table. +#' +#' @param table_a A data frame with one record for each value of `byvar`. +#' @param table_b A data frame with one or more records for each value of `byvar`. +#' @param byvar A mapping a one-to-many relation from `table_a` to `table_b`. +#' @param decimals A vector with the number of decimals to be displayed for variables in `table_a`. +#' @param aname The text label for the index `byvar` +#' +#' @return A data frame merging data frames `table_a` and `table_b` with the name from +#' `aname` and a character string concatenating variables from `table_a` (appropriately rounded). +#' The columns of `table_b` are also included. This is intended for use with gt() grouping by +#' rows in a. +#' +#' @examples +#' library(dplyr) +#' library(tidyr) +#' library(gt) +#' a <- data.frame(Index = 1:2, a1 = c(1.1234, 5.9876), a2 = c("text 1", "text 2"), a3 = c(3.12, 4.98) ) +#' b <- data.frame(Index = c(1, 2, 2), +#' b1 = c("apple", "table", "penny"), +#' b2 = 1:3 * (9 / 8), +#' b3 = (10:8) / 3 +#' ) +#' table_ab(a, b, byvar = "Index", decimals = c(0, 2, 0, 1), aname = "Index") %>% +#' group_by(Index) %>% gt() %>% fmt_number(b3, decimals = 2) %>% +#' tab_header(title = "Grouped data table") %>% +#' tab_footnote("The table a variables have been concatenated into a text string, rounded appropriately.", +#' cells_row_groups(groups = 1)) %>% +#' tab_footnote("Note that footnotes cannot be made for individual variables in the row groups generated using table a.", +#' cells_row_groups(groups = 2)) +#' +#' @noRd +table_ab <- function(table_a, table_b, byvar, decimals = 1, aname = names(table_a)[1]){ + # Convert tibbles to data frames, if needed + if(tibble::is_tibble(table_a)) table_a <- data.frame(table_a, check.names = FALSE) + if(tibble::is_tibble(table_b)) table_b <- data.frame(table_b, check.names = FALSE) + # Round values in table_a + table_a <- table_a %>% rounddf(digits = decimals) + # Put names from table_a in a data frame + anames <- data.frame(t(paste0(names(table_a), ":"))) + # Bind columns from these 2 data frames together + xx <- cbind(table_a, anames) + # Get order of names to unite table_a columns together with names into a string + col_order <- c(rbind(names(anames), names(table_a))) + # Now unite columns of table_a into a string + astring <- xx %>% tidyr::unite("_alab", col_order, sep = " ") + # Bind this together with the byvar column + astring <- cbind(table_a %>% select(all_of(byvar)), astring) + # Now merge with table_b + ab <- left_join(astring, table_b, by = byvar) %>% + select(-one_of(!!byvar)) %>% + # select(-!!byvar) %>% + dplyr::rename(!!aname := !!"_alab") + return(ab) + # return(ab %>% group_by(!!aname)) # This grouping is not working +} + +#' From https://github.com/sashahafner/jumbled/blob/master/rounddf.R +#' @noRd +rounddf <- function(x, digits = rep(2, ncol(x)), func = round) { + if (length(digits) == 1) { + digits <- rep(digits, ncol(x)) + } else if (length(digits) != ncol(x)) { + digits <- c(digits, rep(digits[1], ncol(x) - length(digits))) + warning('First value in digits repeated to match length.') + } + + for(i in 1:ncol(x)) { + if(class(x[, i, drop = TRUE])[1] == 'numeric') x[, i] <- func(x[, i], digits[i]) + } + + return(x) +} \ No newline at end of file diff --git a/R/wlr_weight.R b/R/wlr_weight.R new file mode 100644 index 000000000..6e0df016b --- /dev/null +++ b/R/wlr_weight.R @@ -0,0 +1,80 @@ +# Copyright (c) 2021 Merck Sharp & Dohme Corp. a subsidiary of Merck & Co., Inc., Kenilworth, NJ, USA. +# +# This file is part of the gsdmvn program. +# +# gsdmvn is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +#' Weight Function of Weighted Log-rank Test +#' +#' * `wlr_weight_fh` is Fleming-Harriongton, FH(rho, gamma) weight function. +#' * `wlr_weight_1` is constant for log rank test +#' * `wlr_weight_power` is Gehan-Breslow and Tarone-Ware weight function. +#' +#' @param x analysis time +#' @param arm0 an "arm" object defined in `npsurvSS` package +#' @param arm1 an "arm" object defined in `npsurvSS` package +#' @param rho A scalar parameter that controls the type of test +#' @param gamma A scalar parameter that controls the type of test +#' @param tau A scalar parameter of the cut-off time for modest weighted log rank test +#' @param power A scalar parameter that controls the power of the weight function +#' @section Specification: +#' \if{latex}{ +#' \itemize{ +#' \item Compute the sample size via the sum of arm sizes. +#' \item Compute the proportion of size in the two arms. +#' \item If the input tau is specified, define time up to the cut off time tau. +#' \item Compute the CDF using the proportion of the size in the two arms and \code{npsruvSS::psurv()}. +#' \item Return the Fleming-Harriongton weights for weighted Log-rank test. +#' } +#' } +#' \if{html}{The contents of this section are shown in PDF user manual only.} +#' +#' @name wlr_weight + +#' @rdname wlr_weight +#' @export +wlr_weight_fh <- function(x, arm0, arm1, rho = 0, gamma = 0, tau = NULL) { + + n <- arm0$size + arm1$size + p1 <- arm1$size / n + p0 <- 1 - p1 + + if(! is.null(tau)){ + # Define time up to cut-off time tau + if(tau > 0){x <- pmin(x, tau)} + } + + # CDF + esurv <- p0 * npsurvSS::psurv(x, arm0) + p1 * npsurvSS::psurv(x, arm1) + (1-esurv)^rho * esurv^gamma + +} + +#' @rdname wlr_weight +#' @export +wlr_weight_1 <- function(x, arm0, arm1){ + 1 +} + +#' @rdname wlr_weight +#' @export +wlr_weight_n <- function(x, arm0, arm1, power = 1){ + + n <- arm0$size + arm1$size + p1 <- arm1$size / n + p0 <- 1 - p1 + tmax <- arm0$total_time + + (n * (p0 * prob_risk(arm0, x, tmax) + p1 * prob_risk(arm1, x,tmax)))^power +} diff --git a/README.Rmd b/README.Rmd new file mode 100644 index 000000000..ed86b075b --- /dev/null +++ b/README.Rmd @@ -0,0 +1,139 @@ +--- +output: github_document +knit: (function(inputFile, encoding) { rmarkdown::render(input = inputFile, encoding = encoding); output <- paste0(basename(tools::file_path_sans_ext(inputFile)), ".md"); content_old <- paste0(readLines(output), collapse = "\n"); content_new <- gsub("", replacement = "", content_old); writeLines(content_new, con = output); invisible(output) }) +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = FALSE, + comment = "#>" +) +``` + + +[![R-CMD-check](https://github.com/LittleBeannie/gsDesign2/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/LittleBeannie/gsDesign2/actions/workflows/R-CMD-check.yaml) +[![CRAN status](https://www.r-pkg.org/badges/version/gsDesign2)](https://CRAN.R-project.org/package=gsDesign2) + + +## Objective +The goal of **gsDesign2** is to enable fixed or group sequential design under non-proportional hazards. Piecewise constant enrollment, failure rates and dropout rates for a stratified population are available to enable highly flexible enrollment, time-to-event and time-to-dropout assumptions. Substantial flexibility on top of what is in the gsDesign package is intended for selecting boundaries. While this work is in progress, substantial capabilities have been enabled. Comments on usability and features are encouraged as this is a development version of the package. + +The goal of **gsDesign2** is to enable group sequential trial design for time-to-event endpoints under non-proportional hazards assumptions. The package is still maturing; as the package functions become more stable, they will likely be included in the **gsDesign2** package. + +## Installation + +You can install `gsDesign2` with: + +```{r, eval=FALSE} +remotes::install_github("LittleBeannie/gsDesign2") +``` + +## Use cases + +### Step 1: specifying enrollment and failure rates + +This is a basic example which shows you how to solve a common problem. +We assume there is a 4 month delay in treatment effect. Specifically, we +assume a hazard ratio of 1 for 4 months and 0.6 thereafter. For this +example we assume an exponential failure rate and low exponential +dropout rate. The `enrollRates` specification indicates an expected +enrollment duration of 12 months with exponential inter-arrival times. + +```{r, message=FALSE, warning=FALSE, collapse=TRUE} +library(gsDesign) +library(gsDesign2) +library(dplyr) +library(gt) + +# Basic example + +# Constant enrollment over 12 months +# Rate will be adjusted later by gsDesignNPH to get sample size +enrollRates <- tibble::tibble(Stratum = "All", duration = 12, rate = 1) + +# 12 month median exponential failure rate in control +# 4 month delay in effect with HR=0.6 after +# Low exponential dropout rate +medianSurv <- 12 +failRates <- tibble::tibble( + Stratum = "All", + duration = c(4, Inf), + failRate = log(2) / medianSurv, + hr = c(1, .6), + dropoutRate = .001 +) +``` + +The resulting failure rate specification is the following table. As many +rows and strata as needed can be specified to approximate whatever +patterns you wish. + +```{r, collapse = TRUE} +failRates %>% + gt() %>% + as_raw_html(inline_css = FALSE) +``` + +### Step 2: compute the design + +Computing a fixed sample size design with 2.5% one-sided Type I error +and 90% power. We specify a trial duration of 36 months with +`analysisTimes`. Since there is a single analysis, we specify an upper +p-value bound of 0.025 with `upar = qnorm(0.975)`. There is no lower +bound which is specified with `lpar = -Inf`. + +```{r, collapse = TRUE} +x <- gs_design_ahr( + enrollRates, failRates, + upper = gs_b, upar = qnorm(.975), + lower = gs_b, lpar = -Inf, + IF = 1, analysisTimes = 36 +) +``` + +The input enrollment rates are scaled to achieve power: + +```{r, collapse = TRUE} +x$enrollRates %>% + gt() %>% + as_raw_html(inline_css = FALSE) +``` + +The failure and dropout rates remain unchanged from what was input: + +```{r, collapse = TRUE} +x$failRates %>% + gt() %>% + as_raw_html(inline_css = FALSE) +``` + +Additionally, the summary of bounds and crossing probability is +available at + +```{r, collapse = TRUE} +x$bounds %>% + gt() %>% + as_raw_html(inline_css = FALSE) +``` + +Finally, the expected analysis time is in `Time`, sample size `N`, +events required `Events` and average hazard ratio `AHR` are in `x$analysis`. +Note that `AHR` is the average hazard ratio used to calculate the targeted event +counts. The natural parameter (`log(AHR)`) is in theta and corresponding +statistical information under the alternate hypothesis are in `info` and +under the null hypothesis in `info0`. + +```{r, collapse = TRUE} +x$analysis %>% + gt() %>% + as_raw_html(inline_css = FALSE) +``` + +### Step 3: summarize the design + +```{r, collapse = TRUE} +x %>% + summary() %>% + as_gt() %>% + as_raw_html(inline_css = FALSE) +``` diff --git a/README.md b/README.md index 615738953..1a596645a 100644 --- a/README.md +++ b/README.md @@ -1,26 +1,333 @@ -# gsDesign2 -[![CRAN status](https://www.r-pkg.org/badges/version/gsDesign2)](https://CRAN.R-project.org/package=gsDesign2) -[![Codecov test coverage](https://codecov.io/gh/Merck/gsDesign2/branch/main/graph/badge.svg)](https://app.codecov.io/gh/Merck/gsDesign2?branch=main) -[![R-CMD-check](https://github.com/Merck/gsDesign2/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/Merck/gsDesign2/actions/workflows/R-CMD-check.yaml) + +[![R-CMD-check](https://github.com/LittleBeannie/gsDesign2/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/LittleBeannie/gsDesign2/actions/workflows/R-CMD-check.yaml) +[![CRAN +status](https://www.r-pkg.org/badges/version/gsDesign2)](https://CRAN.R-project.org/package=gsDesign2) -## Overview +## Objective + +The goal of **gsDesign2** is to enable fixed or group sequential design +under non-proportional hazards. Piecewise constant enrollment, failure +rates and dropout rates for a stratified population are available to +enable highly flexible enrollment, time-to-event and time-to-dropout +assumptions. Substantial flexibility on top of what is in the gsDesign +package is intended for selecting boundaries. While this work is in +progress, substantial capabilities have been enabled. Comments on +usability and features are encouraged as this is a development version +of the package. -The gsDesign2 package supports recent innovations group sequential clinical -trial design including non-proportional hazards and graphical multiplicity -control with group sequential design. -Computations are based on piecewise constant enrollment and piecewise -exponential failure rates. -Stratified populations are supported. -Power and sample size calculations based on using testing based on the -logrank test. +The goal of **gsDesign2** is to enable group sequential trial design for +time-to-event endpoints under non-proportional hazards assumptions. The +package is still maturing; as the package functions become more stable, +they will likely be included in the **gsDesign2** package. ## Installation -You can install from GitHub: +You can install `gsDesign2` with: + +``` r +remotes::install_github("LittleBeannie/gsDesign2") +``` + +## Use cases + +### Step 1: specifying enrollment and failure rates + +This is a basic example which shows you how to solve a common problem. +We assume there is a 4 month delay in treatment effect. Specifically, we +assume a hazard ratio of 1 for 4 months and 0.6 thereafter. For this +example we assume an exponential failure rate and low exponential +dropout rate. The `enrollRates` specification indicates an expected +enrollment duration of 12 months with exponential inter-arrival times. + +``` r +library(gsDesign) +library(gsDesign2) +library(dplyr) +library(gt) + +# Basic example + +# Constant enrollment over 12 months +# Rate will be adjusted later by gsDesignNPH to get sample size +enrollRates <- tibble::tibble(Stratum = "All", duration = 12, rate = 1) + +# 12 month median exponential failure rate in control +# 4 month delay in effect with HR=0.6 after +# Low exponential dropout rate +medianSurv <- 12 +failRates <- tibble::tibble( + Stratum = "All", + duration = c(4, Inf), + failRate = log(2) / medianSurv, + hr = c(1, .6), + dropoutRate = .001 +) +``` + +The resulting failure rate specification is the following table. As many +rows and strata as needed can be specified to approximate whatever +patterns you wish. + +``` r +failRates %>% + gt() %>% + as_raw_html(inline_css = FALSE) +``` + +
+ + + + + + + + + + + + + + + + + + + + + + + + + + +
StratumdurationfailRatehrdropoutRate
All40.057762271.00.001
AllInf0.057762270.60.001
+
+ +### Step 2: compute the design + +Computing a fixed sample size design with 2.5% one-sided Type I error +and 90% power. We specify a trial duration of 36 months with +`analysisTimes`. Since there is a single analysis, we specify an upper +p-value bound of 0.025 with `upar = qnorm(0.975)`. There is no lower +bound which is specified with `lpar = -Inf`. + +``` r +x <- gs_design_ahr( + enrollRates, failRates, + upper = gs_b, upar = qnorm(.975), + lower = gs_b, lpar = -Inf, + IF = 1, analysisTimes = 36 +) +``` + +The input enrollment rates are scaled to achieve power: + +``` r +x$enrollRates %>% + gt() %>% + as_raw_html(inline_css = FALSE) +``` + +
+ + + + + + + + + + + + + + + + + +
Stratumdurationrate
All1235.05288
+
+ +The failure and dropout rates remain unchanged from what was input: + +``` r +x$failRates %>% + gt() %>% + as_raw_html(inline_css = FALSE) +``` + +
+ + + + + + + + + + + + + + + + + + + + + + + + + + +
StratumdurationfailRatehrdropoutRate
All40.057762271.00.001
AllInf0.057762270.60.001
+
+ +Additionally, the summary of bounds and crossing probability is +available at -```r -remotes::install_github("Merck/gsDesign2") +``` r +x$bounds %>% + gt() %>% + as_raw_html(inline_css = FALSE) ``` + +
+ + + + + + + + + + + + + + + + + + + + + + + + + +
AnalysisBoundProbabilityProbability0Z~HR at boundNominal p
1Upper0.90.0251.9599640.8006930.025
+
+ +Finally, the expected analysis time is in `Time`, sample size `N`, +events required `Events` and average hazard ratio `AHR` are in +`x$analysis`. Note that `AHR` is the average hazard ratio used to +calculate the targeted event counts. The natural parameter (`log(AHR)`) +is in theta and corresponding statistical information under the +alternate hypothesis are in `info` and under the null hypothesis in +`info0`. + +``` r +x$analysis %>% + gt() %>% + as_raw_html(inline_css = FALSE) +``` + +
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
AnalysisTimeNEventsAHRthetainfoinfo0IF
136420.6346311.00280.69172440.368567676.7438377.750691
+
+ +### Step 3: summarize the design + +``` r +x %>% + summary() %>% + as_gt() %>% + as_raw_html(inline_css = FALSE) +``` + +
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Bound summary for AHR design
AHR approximations of ~HR at bound
BoundNominal p1~HR at bound2 + Cumulative boundary crossing probability +
Alternate hypothesisNull hypothesis
Analysis: 1 Time: 36 N: 420.6 Events: 311 AHR: 0.69 IF: 1
Efficacy0.0250.80070.90.025
1 One-sided p-value for experimental vs control treatment. Values < 0.5 favor experimental, > 0.5 favor control.
2 Approximate hazard ratio to cross bound.
+
diff --git a/_config.yml b/_config.yml new file mode 100644 index 000000000..2f7efbeab --- /dev/null +++ b/_config.yml @@ -0,0 +1 @@ +theme: jekyll-theme-minimal \ No newline at end of file diff --git a/_pkgdown.yml b/_pkgdown.yml index 657ace21d..971bb820b 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -1,23 +1,172 @@ destination: docs -url: https://merck.github.io/gsDesign2/ +url: https://littlebeannie.github.io/gsDesign2/ template: bootstrap: 5 bslib: - primary: "#00857c" - navbar-light-brand-color: "#fff" - navbar-light-brand-hover-color: "#fff" - navbar-light-color: "#fff" - navbar-light-hover-color: "#fff" - navbar-light-active-color: "#fff" - dropdown-link-hover-color: "#fff" - dropdown-link-hover-bg: "#00857c" + primary: '#00857c' + navbar-light-brand-color: '#fff' + navbar-light-brand-hover-color: '#fff' + navbar-light-color: '#fff' + navbar-light-hover-color: '#fff' + navbar-light-active-color: '#fff' + dropdown-link-hover-color: '#fff' + dropdown-link-hover-bg: '#00857c' footer: structure: - left: [developed_by, built_with, legal] - right: [blank] + left: + - developed_by + - built_with + - legal + right: blank components: - legal: "
Copyright © 2022 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. All rights reserved." - blank: "" + legal:
Copyright © 2022 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. + All rights reserved. + blank: + +navbar: + left: + - text: Home + href: index.html + - text: Reference + href: reference/index.html + - text: Articles + href: articles/index.html + +reference: +- title: High-level Functions + desc: > + Functions to calculate fixed/group sequential design under multiple tests. + contents: + - fixed_design +- title: AHR + desc: > + Functions for the average hazard ratio (AHR) method. + contents: + - AHR + - tEvents + - eEvents_df + - gs_info_ahr + - gs_power_ahr + - gs_design_ahr +- title: "WLR" + desc: > + Functions for the weighted logrank test (WLR) method. + contents: + - wlr_weight_fh + - wlr_weight_1 + - gs_info_wlr + - gs_power_wlr + - gs_design_wlr +- title: Max Combo + desc: > + Functions for the max combo method. + contents: + - pmvnorm_combo + - gs_info_combo + - gs_spending_combo + - gs_power_combo + - gs_design_combo +- title: Risk differnce + desc: > + Functions for risk differences. + contents: + - gs_info_rd + - gs_power_rd + - gs_design_rd +- title: Summary and display tables + desc: > + Functions to summarize fixed / group sequential design results. + contents: + - summary + - summary.fixed_design + - summary.gs_design + - as_gt + - as_gt.fixed_design + - as_gt.gs_design +- title: Boundary functions + desc: > + Functions to specify the upper and lower bound in group sequential designs. + They are not recommended to use alone. + Instead, they should be used companied with gs_design_npe, gs_power_npe, ect.. + contents: + - gs_b + - gs_spending_bound +- title: Lower level helper functions + desc: > + Functions to calculate sample size or number of events under non-constant treatment effect over time. + contents: + - gs_power_npe + - gs_design_npe + - eAccrual + - ahr_blinded + - ppwe + - s2pwe + +articles: +- title: "Use gsDesign2 to solve practical problems" + navbar: ~ + desc: > + The following vignettes cover cases where gsDesin2 can be used to solve problems in practics. + contents: + - story_quick_start + - story_npe_background + - story_design_with_ahr + - story_ahr_under_nph + - story_design_with_spending + - story_spending_time_example + - story_power_evaluation_with_spending_bound + - story_summarize_designs + - story_compare_power_delay_effect + - story_compute_npe_bound + - story_npe_integration + - story_arbitrary_distribution + - story_compute_expected_events + - story_risk_difference + - NPH_Futility +- title: "Use case of functions" + navbar: ~ + desc: > + The following vignettes cover the usage of the key functions in gsDesign2. + contents: + - usage_eEvents_df + - usage_AHR + - usage_tEvents + - usage_gs_info_ahr + - usage_gs_info_wlr + - usage_gs_info_combo + - usage_gs_power_ahr + - usage_gs_power_wlr + - usage_gs_power_combo + - usage_gs_design_ahr + - usage_gs_design_wlr + - usage_gs_design_combo + - usage_gs_b + - usage_gs_spending_bound + - usage_gs_power_npe + - usage_eAccural + - usage_summary_as_gt + - usage_fixed_design + +- title: "Check of functions" + navbar: Testing & checks of functions + desc: > + The following vignettes cover the tests and checks of the key functions in gsDesign2. + contents: + - check_gridpts_h1_hupdate + - check_eEvents_df + - check_AHR + - check_tEvents + - check_gs_power_npe + - check_gs_design_npe + - check_gs_info_ahr + - check_gs_info_wlr + - check_gs_info_combo + - check_gs_power_ahr + - check_gs_power_wlr + - check_gs_power_combo + - check_gs_design_ahr + - check_gs_design_wlr + - check_gs_design_combo diff --git a/gsDesign2.Rproj b/gsDesign2.Rproj index 34154a1fc..21a4da087 100644 --- a/gsDesign2.Rproj +++ b/gsDesign2.Rproj @@ -1,8 +1,8 @@ Version: 1.0 -RestoreWorkspace: No -SaveWorkspace: No -AlwaysSaveHistory: No +RestoreWorkspace: Default +SaveWorkspace: Default +AlwaysSaveHistory: Default EnableCodeIndexing: Yes UseSpacesForTab: Yes @@ -12,12 +12,6 @@ Encoding: UTF-8 RnwWeave: Sweave LaTeX: pdfLaTeX -AutoAppendNewline: Yes -StripTrailingWhitespace: Yes - BuildType: Package PackageUseDevtools: Yes PackageInstallArgs: --no-multiarch --with-keep.source -PackageBuildBinaryArgs: --no-multiarch -PackageCheckArgs: --no-multiarch -PackageRoxygenize: rd,collate,namespace diff --git a/inst/Rbadges/build-failing.svg b/inst/Rbadges/build-failing.svg deleted file mode 100644 index faf4ec3fc..000000000 --- a/inst/Rbadges/build-failing.svg +++ /dev/null @@ -1 +0,0 @@ - buildbuildfailingfailing \ No newline at end of file diff --git a/inst/Rbadges/build-passing.svg b/inst/Rbadges/build-passing.svg deleted file mode 100644 index 3e64ff4a8..000000000 --- a/inst/Rbadges/build-passing.svg +++ /dev/null @@ -1 +0,0 @@ - buildbuildpassingpassing \ No newline at end of file diff --git a/inst/Rbadges/coverage-high.svg b/inst/Rbadges/coverage-high.svg deleted file mode 100644 index 41e4a67c9..000000000 --- a/inst/Rbadges/coverage-high.svg +++ /dev/null @@ -1 +0,0 @@ - coveragecoverage80~100%80~100% \ No newline at end of file diff --git a/inst/Rbadges/coverage-low.svg b/inst/Rbadges/coverage-low.svg deleted file mode 100644 index 7c371af99..000000000 --- a/inst/Rbadges/coverage-low.svg +++ /dev/null @@ -1 +0,0 @@ - coveragecoverage20~60%20~60% \ No newline at end of file diff --git a/inst/Rbadges/coverage-medium.svg b/inst/Rbadges/coverage-medium.svg deleted file mode 100644 index 1028ae161..000000000 --- a/inst/Rbadges/coverage-medium.svg +++ /dev/null @@ -1 +0,0 @@ - coveragecoverage60~80%60~80% \ No newline at end of file diff --git a/inst/Rbadges/coverage-poor.svg b/inst/Rbadges/coverage-poor.svg deleted file mode 100644 index 63dfbf435..000000000 --- a/inst/Rbadges/coverage-poor.svg +++ /dev/null @@ -1 +0,0 @@ - coveragecoverage0~20%0~20% \ No newline at end of file diff --git a/inst/Rbadges/lifecycle-customer-review.svg b/inst/Rbadges/lifecycle-customer-review.svg deleted file mode 100644 index cef84ea14..000000000 --- a/inst/Rbadges/lifecycle-customer-review.svg +++ /dev/null @@ -1 +0,0 @@ - lifecyclelifecyclecustomer reviewcustomer review diff --git a/inst/Rbadges/lifecycle-deprecated.svg b/inst/Rbadges/lifecycle-deprecated.svg deleted file mode 100644 index a12979963..000000000 --- a/inst/Rbadges/lifecycle-deprecated.svg +++ /dev/null @@ -1 +0,0 @@ - lifecyclelifecycledeprecateddeprecated \ No newline at end of file diff --git a/inst/Rbadges/lifecycle-development.svg b/inst/Rbadges/lifecycle-development.svg deleted file mode 100644 index d40d3ce67..000000000 --- a/inst/Rbadges/lifecycle-development.svg +++ /dev/null @@ -1 +0,0 @@ - lifecyclelifecycledevelopmentdevelopment \ No newline at end of file diff --git a/inst/Rbadges/lifecycle-retired.svg b/inst/Rbadges/lifecycle-retired.svg deleted file mode 100644 index 33f406b12..000000000 --- a/inst/Rbadges/lifecycle-retired.svg +++ /dev/null @@ -1 +0,0 @@ - lifecyclelifecycleretiredretired \ No newline at end of file diff --git a/inst/Rbadges/lifecycle-reviewing.svg b/inst/Rbadges/lifecycle-reviewing.svg deleted file mode 100644 index 515556b88..000000000 --- a/inst/Rbadges/lifecycle-reviewing.svg +++ /dev/null @@ -1 +0,0 @@ - lifecyclelifecyclereviewingreviewing \ No newline at end of file diff --git a/inst/Rbadges/lifecycle-specification.svg b/inst/Rbadges/lifecycle-specification.svg deleted file mode 100644 index 00d8bc1af..000000000 --- a/inst/Rbadges/lifecycle-specification.svg +++ /dev/null @@ -1 +0,0 @@ - lifecyclelifecyclespecificationspecification \ No newline at end of file diff --git a/inst/Rbadges/lifecycle-stable.svg b/inst/Rbadges/lifecycle-stable.svg deleted file mode 100644 index be0966740..000000000 --- a/inst/Rbadges/lifecycle-stable.svg +++ /dev/null @@ -1 +0,0 @@ - lifecyclelifecyclestablestable \ No newline at end of file diff --git a/inst/Rbadges/lifecycle-validation.svg b/inst/Rbadges/lifecycle-validation.svg deleted file mode 100644 index 22fde2663..000000000 --- a/inst/Rbadges/lifecycle-validation.svg +++ /dev/null @@ -1 +0,0 @@ - lifecyclelifecyclevalidationvalidation \ No newline at end of file diff --git a/inst/Rbadges/risk-low.svg b/inst/Rbadges/risk-low.svg deleted file mode 100644 index b5198fd69..000000000 --- a/inst/Rbadges/risk-low.svg +++ /dev/null @@ -1 +0,0 @@ - riskrisklowlow \ No newline at end of file diff --git a/inst/Rbadges/risk-medium.svg b/inst/Rbadges/risk-medium.svg deleted file mode 100644 index 308e101aa..000000000 --- a/inst/Rbadges/risk-medium.svg +++ /dev/null @@ -1 +0,0 @@ - riskriskmediummedium \ No newline at end of file diff --git a/inst/Rbadges/risk-open.svg b/inst/Rbadges/risk-open.svg deleted file mode 100644 index 49d71e9ef..000000000 --- a/inst/Rbadges/risk-open.svg +++ /dev/null @@ -1 +0,0 @@ - riskriskopenopen \ No newline at end of file diff --git a/inst/Rbadges/validation-double-programming.svg b/inst/Rbadges/validation-double-programming.svg deleted file mode 100644 index f70442577..000000000 --- a/inst/Rbadges/validation-double-programming.svg +++ /dev/null @@ -1 +0,0 @@ - validationvalidationdouble programmingdouble programming diff --git a/inst/Rbadges/validation-independent-testing.svg b/inst/Rbadges/validation-independent-testing.svg deleted file mode 100644 index e24e74a82..000000000 --- a/inst/Rbadges/validation-independent-testing.svg +++ /dev/null @@ -1 +0,0 @@ - validationvalidationindependent testingindependent testing diff --git a/inst/logo/logo.R b/inst/logo/logo.R deleted file mode 100644 index de1ed13a7..000000000 --- a/inst/logo/logo.R +++ /dev/null @@ -1,13 +0,0 @@ -sysfonts::font_add("Invention", regular = "Invention_Lt.ttf") - -hexSticker::sticker( - subplot = ~ plot.new(), s_x = 1, s_y = 1, s_width = 0.1, s_height = 0.1, - package = "gsDesign2", p_family = "Invention", - p_color = "#ffffff", p_x = 1, p_y = 1.05, p_size = 23, - h_fill = "#00857c", h_color = "#005c55", h_size = 1.2, - filename = "man/figures/logo.png", dpi = 320 -) - -magick::image_read("man/figures/logo.png") - -rstudioapi::restartSession() diff --git a/man/AHR.Rd b/man/AHR.Rd index f1d63b7e0..a7a8aae3d 100644 --- a/man/AHR.Rd +++ b/man/AHR.Rd @@ -84,27 +84,23 @@ and enrollment pattern where the enrollment, failure and dropout rates changes o \examples{ # Example: default AHR() -# Example; default with multiple analysis times (varying totalDuration) -AHR(totalDuration=c(15,30)) + +# Example: default with multiple analysis times (varying totalDuration) + +AHR(totalDuration = c(15, 30)) + # Stratified population -enrollRates <- tibble::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::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 -) -AHR(enrollRates=enrollRates, - failRates=failRates, - totalDuration=c(15,30) - ) +enrollRates <- tibble::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::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) +AHR(enrollRates = enrollRates, failRates = failRates, totalDuration = c(15, 30)) + # Same example, give results by strata and time period -AHR(enrollRates=enrollRates, - failRates=failRates, - totalDuration=c(15,30), - simple=FALSE -) +AHR(enrollRates = enrollRates, failRates = failRates, totalDuration = c(15, 30), simple = FALSE) + } diff --git a/man/ahr_blinded.Rd b/man/ahr_blinded.Rd new file mode 100644 index 000000000..e40996ada --- /dev/null +++ b/man/ahr_blinded.Rd @@ -0,0 +1,73 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/helper_functions.R +\name{ahr_blinded} +\alias{ahr_blinded} +\title{Blinded estimation of average hazard ratio} +\usage{ +ahr_blinded( + Srv = Surv(time = simtrial::Ex1delayedEffect$month, event = + simtrial::Ex1delayedEffect$evntd), + intervals = array(3, 3), + hr = c(1, 0.6), + ratio = 1 +) +} +\arguments{ +\item{Srv}{input survival object (see \code{Surv}); note that only 0=censored, 1=event for \code{Surv}} + +\item{intervals}{Vector containing positive values indicating interval lengths where the +exponential rates are assumed. +Note that a final infinite interval is added if any events occur after the final interval +specified.} + +\item{hr}{vector of hazard ratios assumed for each interval} + +\item{ratio}{ratio of experimental to control randomization.} +} +\value{ +A \code{tibble} with one row containing +\code{AHR} blinded average hazard ratio based on assumed period-specific hazard ratios input in \code{failRates} +and observed events in the corresponding intervals +\code{Events} total observed number of events, \code{info} statistical information based on Schoenfeld approximation, +and info0 (information under related null hypothesis) for each value of \code{totalDuration} input; +if \code{simple=FALSE}, \code{Stratum} and \code{t} (beginning of each constant HR period) are also returned +and \code{HR} is returned instead of \code{AHR} +} +\description{ +Based on blinded data and assumed hazard ratios in different intervals, compute +a blinded estimate of average hazard ratio (AHR) and corresponding estimate of statistical information. +This function is intended for use in computing futility bounds based on spending assuming +the input hazard ratio (hr) values for intervals specified here. +} +\section{Specification}{ + +\if{latex}{ + \itemize{ + \item Validate if input hr is a numeric vector. + \item Validate if input hr is non-negative. + \item Simulate piece-wise exponential survival estimation with the inputs survival object Srv + and intervals. + \item Save the length of hr and events to an object, and if the length of hr is shorter than + the intervals, add replicates of the last element of hr and the corresponding numbers of events + to hr. + \item Compute the blinded estimation of average hazard ratio. + \item Compute adjustment for information. + \item Return a tibble of the sum of events, average hazard raito, blinded average hazard + ratio, and the information. + } +} +\if{html}{The contents of this section are shown in PDF user manual only.} +} + +\examples{ +\dontrun{ +library(simtrial) +library(survival) +ahr_blinded(Srv = Surv(time = simtrial::Ex2delayedEffect$month, + event = simtrial::Ex2delayedEffect$evntd), + intervals = c(4, 100), + hr = c(1, .55), + ratio = 1) +} + +} diff --git a/man/as_gt.Rd b/man/as_gt.Rd new file mode 100644 index 000000000..9d21fa0ab --- /dev/null +++ b/man/as_gt.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/as_gt.R +\name{as_gt} +\alias{as_gt} +\title{S3 class method to get summary table into a gt table} +\usage{ +as_gt(x, ...) +} +\arguments{ +\item{x}{a summary of fixed or group sequential design} + +\item{...}{additional arguments} +} +\value{ +a gt table +} +\description{ +S3 class method to get summary table into a gt table +} diff --git a/man/as_gt.fixed_design.Rd b/man/as_gt.fixed_design.Rd new file mode 100644 index 000000000..25b8b719c --- /dev/null +++ b/man/as_gt.fixed_design.Rd @@ -0,0 +1,80 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/as_gt.R +\name{as_gt.fixed_design} +\alias{as_gt.fixed_design} +\title{This is the function to format the bounds summary table of fixed design into gt style.} +\usage{ +\method{as_gt}{fixed_design}(x, title = NULL, footnote = NULL, ...) +} +\arguments{ +\item{x}{a summary object of group sequential design} + +\item{title}{title to be displayed} + +\item{footnote}{footnotes to be displayed} + +\item{...}{additional arguments} +} +\value{ +a gt table +} +\description{ +This is the function to format the bounds summary table of fixed design into gt style. +} +\examples{ +library(dplyr) +library(tibble) + +# Enrollment rate +enrollRates <- tibble( + Stratum = "All", + duration = 18, + rate = 20) + +# Failure rates +failRates <- tibble( + Stratum = "All", + duration = c(4, 100), + failRate = log(2) / 12, + hr = c(1, .6), + dropoutRate = .001) + +# Study duration in months +studyDuration <- 36 + +# Experimental / Control randomization ratio +ratio <- 1 + +# 1-sided Type I error +alpha <- 0.025 + +# Type II error (1 - power) +beta <- 0.1 + +# ------------------------- # +# AHR # +# ------------------------- # +# under fixed power +fixed_design( + x = "AHR", + alpha = alpha, power = 1 - beta, + enrollRates = enrollRates, failRates = failRates, + studyDuration = studyDuration, ratio = ratio + ) \%>\% + summary() \%>\% + as_gt() + +# ------------------------- # +# FH # +# ------------------------- # +# under fixed power +fixed_design( + x = "FH", + alpha = alpha, power = 1 - beta, + enrollRates = enrollRates, failRates = failRates, + studyDuration = studyDuration, ratio = ratio + ) \%>\% + summary() \%>\% + as_gt() + +} diff --git a/man/as_gt.gs_design.Rd b/man/as_gt.gs_design.Rd new file mode 100644 index 000000000..9deb0e5d1 --- /dev/null +++ b/man/as_gt.gs_design.Rd @@ -0,0 +1,128 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/as_gt.R +\name{as_gt.gs_design} +\alias{as_gt.gs_design} +\title{This is the function to format the bounds summary table into gt style.} +\usage{ +\method{as_gt}{gs_design}( + x, + title = NULL, + subtitle = NULL, + colname_spanner = "Cumulative boundary crossing probability", + colname_spannersub = c("Alternate hypothesis", "Null hypothesis"), + footnote = NULL, + display_bound = c("Efficacy", "Futility"), + display_columns = NULL, + display_inf_bound = TRUE, + ... +) +} +\arguments{ +\item{x}{an object returned by \code{summary_bound}} + +\item{title}{a string to specify the title of the gt table} + +\item{subtitle}{a string to specify the subtitle of the gt table} + +\item{colname_spanner}{a string to specify the spanner of the gt table} + +\item{colname_spannersub}{a vector of strings to specify the spanner details of the gt table} + +\item{footnote}{a list containing \code{content}, \code{location}, and \code{attr}. +the \code{content} is a vector of string to specify the footnote text; +the \code{location} is a vector of string to specify the locations to put the superscript of the footnote index; +the \code{attr} is a vector of string to specify the attributes of the footnotes, e.g., c("colname", "title", "subtitle", "analysis", "spanner"); +users can use the functions in the \code{gt} package to custom themselves.} + +\item{display_bound}{a vector of strings specifying the label of the bounds. The default is \code{c("Efficacy", "Futility")}} + +\item{display_columns}{a vector of strings specifying the variables to be displayed in the summary table} + +\item{display_inf_bound}{a logic value (TRUE or FALSE) whether to display the +-inf bound} + +\item{...}{additional arguments} +} +\value{ +a gt table summarizing the bounds table in group sequential designs +} +\description{ +This is the function to format the bounds summary table into gt style. +} +\examples{ +# the default output +library(dplyr) + +gs_design_ahr() \%>\% + summary() \%>\% + as_gt() + +gs_power_ahr() \%>\% + summary() \%>\% + as_gt() + +gs_design_wlr() \%>\% + summary() \%>\% + as_gt() + +gs_power_wlr() \%>\% + summary() \%>\% + as_gt() + +\dontrun{ +gs_design_combo() \%>\% + summary() \%>\% + as_gt() + +gs_power_combo() \%>\% + summary() \%>\% + as_gt() + +gs_design_rd() \%>\% + summary() \%>\% + as_gt() + +gs_power_rd() \%>\% + summary() \%>\% + as_gt() +} +# usage of title = ..., subtitle = ... +# to edit the title/subtitle +gs_power_wlr() \%>\% + summary() \%>\% + as_gt( + title = "Bound Summary", + subtitle = "from gs_power_wlr") + +# usage of colname_spanner = ..., colname_spannersub = ... +# to edit the spanner and its sub-spanner +gs_power_wlr() \%>\% + summary() \%>\% + as_gt( + colname_spanner = "Cumulative probability to cross boundaries", + colname_spannersub = c("under H1", "under H0")) + +# usage of footnote = ... +# to edit the footnote +gs_power_wlr() \%>\% + summary() \%>\% + as_gt( + footnote = list(content = c("approximate weighted hazard ratio to cross bound.", + "wAHR is the weighted AHR.", + "the crossing probability.", + "this table is generated by gs_power_wlr."), + location = c("~wHR at bound", NA, NA, NA), + attr = c("colname", "analysis", "spanner", "title"))) + +# usage of display_bound = ... +# to either show efficacy bound or futility bound, or both(default) +gs_power_wlr() \%>\% + summary() \%>\% + as_gt(display_bound = "Efficacy") + +# usage of display_columns = ... +# to select the columns to display in the summary table +gs_power_wlr() \%>\% + summary() \%>\% + as_gt(display_columns = c("Analysis", "Bound", "Nominal p", "Z", "Probability")) + +} diff --git a/man/eAccrual.Rd b/man/eAccrual.Rd index ba0861e48..575b5ac0d 100644 --- a/man/eAccrual.Rd +++ b/man/eAccrual.Rd @@ -6,7 +6,7 @@ \usage{ eAccrual( x = 0:24, - enrollRates = tibble::tibble(duration = c(3, 3, 18), rate = c(5, 10, 20)) + enrollRates = tibble(duration = c(3, 3, 18), rate = c(5, 10, 20)) ) } \arguments{ @@ -43,6 +43,23 @@ given a set of piecewise constant enrollment rates and times. } \examples{ -# Example: default +library(tibble) + +# Example 1: default eAccrual() + +# Example 2: unstratified design +eAccrual(x = c(5, 10, 20), + enrollRates = tibble(duration = c(3, 3, 18), rate = c(5, 10, 20))) + +eAccrual(x = c(5, 10, 20), + enrollRates = tibble(duration = c(3, 3, 18), rate = c(5, 10, 20), + Stratum = "All")) + +# Example 3: stratified design +eAccrual(x = c(24, 30, 40), + enrollRates = tibble(Stratum=c("subgroup", "complement"), + duration = 33, + rate = c(30, 30))) + } diff --git a/man/eEvents_df.Rd b/man/eEvents_df.Rd index 18c6dbf82..e95bafbf7 100644 --- a/man/eEvents_df.Rd +++ b/man/eEvents_df.Rd @@ -80,22 +80,25 @@ maximize flexibility for a variety of purposes. \examples{ library(tibble) +library(gsDesign2) + # Default arguments, simple output (total event count only) eEvents_df() + # Event count by time period -eEvents_df(simple=FALSE) +eEvents_df(simple = FALSE) + # Early cutoff -eEvents_df(totalDuration=.5) +eEvents_df(totalDuration = .5) + # Single time period example -eEvents_df(enrollRates=tibble(duration=10,rate=10), - failRates=tibble(duration=100,failRate=log(2)/6,dropoutRate=.01), - totalDuration=22, - simple=FALSE - ) -# Single time period example, multiple enrolment periods -eEvents_df(enrollRates=tibble(duration=c(5,5), rate=c(10,20)), - failRates=tibble(duration=100,failRate=log(2)/6,dropoutRate=.01), - totalDuration=22, - simple=FALSE - ) +eEvents_df(enrollRates = tibble(duration = 10,rate = 10), + failRates = tibble(duration=100, failRate = log(2) / 6 ,dropoutRate = .01), + totalDuration = 22, + simple = FALSE) + +# Single time period example, multiple enrollment periods +eEvents_df(enrollRates = tibble(duration = c(5,5), rate = c(10, 20)), + failRates = tibble(duration = 100, failRate = log(2)/6, dropoutRate = .01), + totalDuration = 22, simple = FALSE) } diff --git a/man/figures/logo.png b/man/figures/logo.png deleted file mode 100644 index 2f10c7c7e..000000000 Binary files a/man/figures/logo.png and /dev/null differ diff --git a/man/fixed_design.Rd b/man/fixed_design.Rd new file mode 100644 index 000000000..e7b35a64c --- /dev/null +++ b/man/fixed_design.Rd @@ -0,0 +1,72 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fixed_design.R +\name{fixed_design} +\alias{fixed_design} +\title{Fixed design sample size} +\usage{ +fixed_design( + x = c("AHR", "FH", "MB", "LF", "RD", "MaxCombo", "RMST", "Milestone"), + alpha = 0.025, + power = NULL, + ratio = 1, + studyDuration = 36, + ... +) +} +\arguments{ +\item{x}{Sample size method; default is \code{"AHR"}; +other options include \code{"FH"}, \code{"MB"}, \code{"LF"}, \code{"RD"}, \code{"MaxCombo"}, \code{"Milestone"}.} + +\item{alpha}{One-sided Type I error (strictly between 0 and 1)} + +\item{power}{Power (\code{NULL} to compute power or strictly between 0 and \code{1 - alpha} otherwise)} + +\item{ratio}{Experimental:Control randomization ratio} + +\item{studyDuration}{study duration} + +\item{...}{additional arguments like \code{enrollRates}, \code{failRates}, \code{rho}, \code{gamma}, \code{tau}} +} +\value{ +a table +} +\description{ +Computes fixed design sample size for many sample size methods. +Returns a \code{tibble} with a basic summary +} +\examples{ +library(dplyr) + +# Average hazard ratio +x <- fixed_design("AHR", + alpha = .025, power = .9, + enrollRates = tibble::tibble(Stratum = "All", duration = 18, rate = 1), + failRates = tibble::tibble(Stratum = "All", duration = c(4, 100), failRate = log(2) / 12, hr = c(1, .6), dropoutRate = .001), + studyDuration = 36) +x \%>\% summary() + +# Lachin and Foulkes (uses gsDesign::nSurv()) +x <- fixed_design("LF", + alpha = .025, power = .9, + enrollRates = tibble::tibble(Stratum = "All", duration = 18, rate = 1), + failRates = tibble::tibble(Stratum = "All", duration = 100, failRate = log(2) / 12, hr = .7, dropoutRate = .001), + studyDuration = 36) +x \%>\% summary() + +# RMST +x <- fixed_design("RMST", alpha = .025, power = .9, + enrollRates = tibble::tibble(Stratum = "All", duration = 18, rate = 1), + failRates = tibble::tibble(Stratum = "All", duration = 100, failRate = log(2) / 12, hr = .7, dropoutRate = .001), + studyDuration = 36, + tau = 18) +x \%>\% summary() + +# Milestone +x <- fixed_design("Milestone", alpha = .025, power = .9, + enrollRates = tibble::tibble(Stratum = "All", duration = 18, rate = 1), + failRates = tibble::tibble(Stratum = "All", duration = 100, failRate = log(2) / 12, hr = .7, dropoutRate = .001), + studyDuration = 36, + tau = 18) +x \%>\% summary() + +} diff --git a/man/gsDesign2-package.Rd b/man/gsDesign2-package.Rd index caa0c1eaf..1cab62206 100644 --- a/man/gsDesign2-package.Rd +++ b/man/gsDesign2-package.Rd @@ -1,42 +1,42 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/gsDesign2-package.R +% Please edit documentation in R/gsDesign2.R \docType{package} \name{gsDesign2-package} \alias{gsDesign2} \alias{gsDesign2-package} -\title{gsDesign2: Group Sequential Design Under Non-Proportional Hazards} +\title{gsDesign2: Group sequential design with non-constant effect} \description{ -\if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} - -Compute sample size under non-proportional hazards. +Basic group sequential design computations extended. } \seealso{ Useful links: \itemize{ - \item \url{https://merck.github.io/gsDesign2/} - \item \url{https://github.com/Merck/gsDesign2} - \item Report bugs at \url{https://github.com/Merck/gsDesign2/issues} + \item \url{https://github.com/LittleBeannie/gsDesign2} + \item \url{https://littlebeannie.github.io/gsDesign2/} + \item Report bugs at \url{https://github.com/LittleBeannie/gsDesign2/issues} } } \author{ -\strong{Maintainer}: Yilong Zhang \email{yilong.zhang@merck.com} +\strong{Maintainer}: Yujie Zhao \email{yujie.zhao@merck.com} Authors: \itemize{ \item Keaven Anderson \email{keaven_anderson@merck.com} + \item Yilong Zhang \email{elong0527@gmail.com} } Other contributors: \itemize{ + \item Jianxiao Yang \email{yangjx@ucla.edu} [contributor] + \item Nan Xiao \email{nan.xiao1@merck.com} [contributor] \item Amin Shirazi \email{ashirazist@gmail.com} [contributor] \item Ruixue Wang \email{ruixue.wang@merck.com} [contributor] \item Yi Cui \email{yi.cui@merck.com} [contributor] \item Ping Yang \email{ping.yang1@merck.com} [contributor] \item Xin Tong Li \email{xin.tong.li@merck.com} [contributor] \item Yalin Zhu \email{yalin.zhu@merck.com} [contributor] - \item Nan Xiao \email{nan.xiao1@merck.com} [contributor] - \item Merck & Co., Inc., Rahway, NJ, USA and its affiliates [copyright holder] + \item Merck Sharp & Dohme Corp [copyright holder] } } diff --git a/man/gs_b.Rd b/man/gs_b.Rd new file mode 100644 index 000000000..7512d70b4 --- /dev/null +++ b/man/gs_b.Rd @@ -0,0 +1,59 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gs_b.R +\name{gs_b} +\alias{gs_b} +\title{gs_b: Default boundary generation} +\usage{ +gs_b(par = NULL, k = NULL, ...) +} +\arguments{ +\item{par}{For \code{gs_b()}, this is just Z-values for the boundaries; can include infinite values} + +\item{k}{is NULL (default), return \code{par}, else return \code{par[k]}} + +\item{...}{further arguments passed to or from other methods} +} +\value{ +returns the vector input \code{par} if \code{k} is NULL, otherwise, \code{par[k]} +} +\description{ +\code{gs_b()} is the simplest version of a function to be used with the \code{upper} and \code{lower} +arguments in \code{gs_prob()}, +\code{gs_power_nph} and \code{gs_design_nph()}; +it simply returns the vector input in the input vector \code{Z} or, if \code{k} is specified \code{par[k]j} is returned. +Note that if bounds need to change with changing information at analyses, \code{gs_b()} should not be used. +For instance, for spending function bounds use +} +\section{Specification}{ + +\if{latex}{ + \itemize{ + \item Validate if the input k is null as default. + \itemize{ + \item If the input k is null as default, return the whole vector of Z-values of the boundaries. + \item If the input k is not null, return the corresponding boundary in the vector of Z-values. + } + \item Return a vector of boundaries. + } +} +\if{html}{The contents of this section are shown in PDF user manual only.} +} + +\examples{ + +# Simple: enter a vector of length 3 for bound +gs_b(par = 4:2) + +# 2nd element of par +gs_b(par = 4:2, k = 2) + +# Generate an efficacy bound using a spending function +# Use Lan-DeMets spending approximation of O'Brien-Fleming bound +# as 50\%, 75\% and 100\% of final spending +# Information fraction +IF <- c(.5, .75, 1) +gs_b(par = gsDesign::gsDesign(alpha = .025, k = length(IF), + test.type = 1, sfu = gsDesign::sfLDOF, + timing = IF)$upper$bound) + +} diff --git a/man/gs_design_ahr.Rd b/man/gs_design_ahr.Rd new file mode 100644 index 000000000..b39fed4bf --- /dev/null +++ b/man/gs_design_ahr.Rd @@ -0,0 +1,148 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gs_design_ahr.R +\name{gs_design_ahr} +\alias{gs_design_ahr} +\title{Group sequential design using average hazard ratio under non-proportional hazards} +\usage{ +gs_design_ahr( + enrollRates = tibble(Stratum = "All", duration = c(2, 2, 10), rate = c(3, 6, 9)), + failRates = tibble(Stratum = "All", duration = c(3, 100), failRate = log(2)/c(9, 18), + hr = c(0.9, 0.6), dropoutRate = rep(0.001, 2)), + ratio = 1, + alpha = 0.025, + beta = 0.1, + IF = NULL, + analysisTimes = 36, + binding = FALSE, + upper = gs_b, + upar = gsDesign::gsDesign(k = 3, test.type = 1, n.I = c(0.25, 0.75, 1), sfu = sfLDOF, + sfupar = NULL)$upper$bound, + lower = gs_b, + lpar = c(qnorm(0.1), -Inf, -Inf), + h1_spending = TRUE, + test_upper = TRUE, + test_lower = TRUE, + info_scale = c(0, 1, 2), + r = 18, + tol = 1e-06 +) +} +\arguments{ +\item{enrollRates}{enrollment rates} + +\item{failRates}{failure and dropout rates} + +\item{ratio}{Experimental:Control randomization ratio (not yet implemented)} + +\item{alpha}{One-sided Type I error} + +\item{beta}{Type II error} + +\item{IF}{Targeted information fraction at each analysis} + +\item{analysisTimes}{Minimum time of analysis} + +\item{binding}{indicator of whether futility bound is binding; default of FALSE is recommended} + +\item{upper}{Function to compute upper bound} + +\item{upar}{Parameter passed to \code{upper()}} + +\item{lower}{Function to compute lower bound} + +\item{lpar}{Parameter passed to \code{lower()}} + +\item{h1_spending}{Indicator that lower bound to be set by spending under alternate hypothesis (input \code{failRates}) +if spending is used for lower bound} + +\item{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 \code{info} should indicate which analyses will have an efficacy bound} + +\item{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 \code{info} should indicate which analyses will have a +lower bound} + +\item{info_scale}{the information scale for calculation} + +\item{r}{Integer, at least 2; default of 18 recommended by Jennison and Turnbull} + +\item{tol}{Tolerance parameter for boundary convergence (on Z-scale)} +} +\value{ +a \code{tibble} with columns Analysis, Bound, Z, Probability, theta, Time, AHR, Events +} +\description{ +Group sequential design using average hazard ratio under non-proportional hazards +} +\details{ +Need to be added +} +\section{Specification}{ + +\if{latex}{ + \itemize{ + \item Validate if input analysisTimes is a positive number or positive increasing sequence. + \item Validate if input IF is a positive number or positive increasing sequence + on (0, 1] with final value of 1. + \item Validate if input IF and analysisTimes have the same length if both have length > 1. + \item Get information at input analysisTimes + \itemize{ + \item Use \code{gs_info_ahr()} to get the information and effect size based on AHR approximation. + \item Extract the final event. + \item Check if input If needed for (any) interim analysis timing. + } + \item Add the analysis column to the information at input analysisTimes. + \item Add the sample size column to the information at input analysisTimes using \code{eAccrual()}. + \item Get sample size and bounds using \code{gs_design_npe()} and save them to bounds. + \item Add Time, Events, AHR, N that have already been calculated to the bounds. + \item Return a list of design enrollment, failure rates, and bounds. + } +} +\if{html}{The contents of this section are shown in PDF user manual only.} +} + +\examples{ +library(gsDesign) +library(gsDesign2) +library(dplyr) + +# call with defaults +gs_design_ahr() + +# Single analysis +gs_design_ahr(analysisTimes = 40) + +# Multiple analysisTimes +gs_design_ahr(analysisTimes = c(12, 24, 36)) + +# Specified information fraction +gs_design_ahr(IF = c(.25, .75, 1), analysisTimes = 36) + +# multiple analysis times & IF +# driven by times +gs_design_ahr(IF = c(.25, .75, 1), analysisTimes = c(12, 25, 36)) +# driven by IF +gs_design_ahr(IF = c(1/3, .8, 1), analysisTimes = c(12, 25, 36)) + +# 2-sided symmetric design with O'Brien-Fleming spending +gs_design_ahr( + analysisTimes = 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) + +# 2-sided asymmetric design with O'Brien-Fleming upper spending +# Pocock lower spending under H1 (NPH) +gs_design_ahr( + analysisTimes = 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) + +} diff --git a/man/gs_design_combo.Rd b/man/gs_design_combo.Rd new file mode 100644 index 000000000..ade04b0d9 --- /dev/null +++ b/man/gs_design_combo.Rd @@ -0,0 +1,143 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gs_design_combo.R +\name{gs_design_combo} +\alias{gs_design_combo} +\title{Group sequential design using MaxCombo test under non-proportional hazards} +\usage{ +gs_design_combo( + enrollRates = tibble(Stratum = "All", duration = 12, rate = 500/12), + failRates = tibble(Stratum = "All", duration = c(4, 100), failRate = log(2)/15, hr = + c(1, 0.6), dropoutRate = 0.001), + fh_test = rbind(data.frame(rho = 0, gamma = 0, tau = -1, test = 1, Analysis = 1:3, + analysisTimes = c(12, 24, 36)), data.frame(rho = c(0, 0.5), gamma = 0.5, tau = -1, + test = 2:3, Analysis = 3, analysisTimes = 36)), + ratio = 1, + alpha = 0.025, + beta = 0.2, + binding = FALSE, + upper = gs_b, + upar = c(3, 2, 1), + lower = gs_b, + lpar = c(-1, 0, 1), + algorithm = mvtnorm::GenzBretz(maxpts = 1e+05, abseps = 1e-05), + n_upper_bound = 1000, + ... +) +} +\arguments{ +\item{enrollRates}{enrollment rates} + +\item{failRates}{failure and dropout rates} + +\item{fh_test}{a data frame to summarize the test in each analysis. +Refer examples for its data structure.} + +\item{ratio}{Experimental:Control randomization ratio (not yet implemented)} + +\item{alpha}{One-sided Type I error} + +\item{beta}{Type II error} + +\item{binding}{indicator of whether futility bound is binding; default of FALSE is recommended} + +\item{upper}{Function to compute upper bound} + +\item{upar}{Parameter passed to \code{upper()}} + +\item{lower}{Function to compute lower bound} + +\item{lpar}{Parameter passed to \code{lower()}} + +\item{algorithm}{ an object of class \code{\link[mvtnorm]{GenzBretz}}, + \code{\link[mvtnorm]{Miwa}} or \code{\link[mvtnorm]{TVPACK}} + specifying both the algorithm to be used as well as + the associated hyper parameters.} + +\item{n_upper_bound}{a numeric value of upper limit of sample size} + +\item{...}{additional parameters transfer to \code{mvtnorm::pmvnorm}} +} +\description{ +Group sequential design using MaxCombo test under non-proportional hazards +} +\examples{ +# The example is slow to run +library(dplyr) +library(mvtnorm) +library(gsDesign) +library(tibble) + +enrollRates <- tibble( + Stratum = "All", + duration = 12, + rate = 500/12) + +failRates <- tibble( + Stratum = "All", + duration = c(4, 100), + failRate = log(2) / 15, # median survival 15 month + hr = c(1, .6), + dropoutRate = 0.001) + +fh_test <- rbind( + data.frame(rho = 0, gamma = 0, tau = -1, + test = 1, Analysis = 1:3, analysisTimes = c(12, 24, 36)), + data.frame(rho = c(0, 0.5), gamma = 0.5, tau = -1, + test = 2:3, Analysis = 3, analysisTimes = 36)) + +x <- gsSurv( + k = 3 , + test.type = 4 , + alpha = 0.025 , + beta = 0.2 , + astar = 0 , + timing = 1, + sfu = sfLDOF , + sfupar = 0, + sfl = sfLDOF , + sflpar = 0, + lambdaC = 0.1, + hr = 0.6, + hr0 = 1, + eta = 0.01, + gamma = 10, + R = 12, + S = NULL, + T = 36, + minfup = 24, + ratio = 1) + +# -------------------------# +# example 1 # +# ------------------------ # +\dontrun{ +# User defined boundary +gs_design_combo( + enrollRates, + failRates, + fh_test, + alpha = 0.025, beta = 0.2, + ratio = 1, + binding = FALSE, + upar = x$upper$bound, + lpar = x$lower$bound) +} + +# -------------------------# +# example 2 # +# ------------------------ # +# Boundary derived by spending function +gs_design_combo( + enrollRates, + failRates, + fh_test, + alpha = 0.025, + beta = 0.2, + ratio = 1, + binding = FALSE, + upper = gs_spending_combo, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025), # alpha spending + lower = gs_spending_combo, + lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.2), # beta spending +) +} diff --git a/man/gs_design_npe.Rd b/man/gs_design_npe.Rd new file mode 100644 index 000000000..48a9e1167 --- /dev/null +++ b/man/gs_design_npe.Rd @@ -0,0 +1,242 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gs_design_npe.R +\name{gs_design_npe} +\alias{gs_design_npe} +\title{Group sequential design computation with non-constant effect and information} +\usage{ +gs_design_npe( + theta = 0.1, + theta0 = NULL, + theta1 = NULL, + info = 1, + info0 = NULL, + info1 = NULL, + info_scale = c(0, 1, 2), + alpha = 0.025, + beta = 0.1, + upper = gs_b, + upar = qnorm(0.975), + lower = gs_b, + lpar = -Inf, + test_upper = TRUE, + test_lower = TRUE, + binding = FALSE, + r = 18, + tol = 1e-06 +) +} +\arguments{ +\item{theta}{natural parameter for group sequential design representing expected incremental drift at all analyses; +used for power calculation} + +\item{theta0}{natural parameter used for upper bound spending; if \code{NULL}, this will be set to 0} + +\item{theta1}{natural parameter used for lower bound spending; if \code{NULL}, this will be set to \code{theta} +which yields the usual beta-spending. If set to 0, spending is 2-sided under null hypothesis.} + +\item{info}{proportionate statistical information at all analyses for input \code{theta}} + +\item{info0}{proportionate statistical information under null hypothesis, if different than alternative; +impacts null hypothesis bound calculation} + +\item{info1}{proportionate statistical information under alternate hypothesis; +impacts null hypothesis bound calculation} + +\item{info_scale}{the information scale for calculation} + +\item{alpha}{One-sided Type I error} + +\item{beta}{Type II error} + +\item{upper}{function to compute upper bound} + +\item{upar}{parameter to pass to function provided in \code{upper}} + +\item{lower}{function to compare lower bound} + +\item{lpar}{Parameter passed to function provided in \code{lower}} + +\item{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 \code{info} should indicate which analyses will have an efficacy bound} + +\item{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 \code{info} should indicate which analyses will have a +lower bound} + +\item{binding}{indicator of whether futility bound is binding; default of FALSE is recommended} + +\item{r}{Integer, at least 2; default of 18 recommended by Jennison and Turnbull} + +\item{tol}{Tolerance parameter for boundary convergence (on Z-scale)} +} +\value{ +a \code{tibble} with columns Analysis, Bound, Z, Probability, theta, info, info0 +} +\description{ +\code{gs_design_npe()} derives group sequential design size, bounds and boundary crossing probabilities based on proportionate +information and effect size at analyses. +It allows a non-constant treatment effect over time, but also can be applied for the usual homogeneous effect size designs. +It requires treatment effect and proportionate statistical information at each analysis as well as a method of deriving bounds, such as spending. +The routine enables two things not available in the gsDesign package: 1) non-constant effect, 2) more flexibility in boundary selection. +For many applications, the non-proportional-hazards design function \code{gs_design_nph()} will be used; it calls this function. +Initial bound types supported are 1) spending bounds, 2) fixed bounds, and 3) Haybittle-Peto-like bounds. +The requirement is to have a boundary update method that can each bound without knowledge of future bounds. +As an example, bounds based on conditional power that require knowledge of all future bounds are not supported by this routine; +a more limited conditional power method will be demonstrated. +Boundary family designs Wang-Tsiatis designs including the original (non-spending-function-based) O'Brien-Fleming and Pocock designs +are not supported by \code{gs_power_npe()}. +} +\details{ +The inputs \code{info} and \code{info0} should be vectors of the same length with increasing positive numbers. +The design returned will change these by some constant scale factor to ensure the design has power \code{1 - beta}. +The bound specifications in \code{upper, lower, upar, lpar} will be used to ensure Type I error and other boundary properties are as specified. +} +\section{Specification}{ + +\if{latex}{ + \itemize{ + \item Validate if input info is a numeric vector or NULL, if non-NULL validate if it + is strictly increasing and positive. + \item Validate if input info0 is a numeric vector or NULL, if non-NULL validate if it + is strictly increasing and positive. + \item Validate if input info1 is a numeric vector or NULL, if non-NULL validate if it + is strictly increasing and positive. + \item Validate if input theta is a real vector and has the same length as info. + \item Validate if input theta1 is a real vector and has the same length as info. + \item Validate if input test_upper and test_lower are logical and have the same length as info. + \item Validate if input test_upper value is TRUE. + \item Validate if input alpha and beta are positive and of length one. + \item Validate if input alpha and beta are from the unit interval and alpha is smaller than beta. + \item Initialize bounds, numerical integration grids, boundary crossing probabilities. + \item Compute fixed sample size for desired power and Type I error. + \item Find an interval for information inflation to give correct power using \code{gs_power_npe()}. + \item + \item If there is no interim analysis, return a tibble including Analysis time, upper bound, Z-value, + Probability of crossing bound, theta, info0 and info1. + \item If the design is a group sequential design, return a tibble of Analysis, + Bound, Z, Probability, theta, info, info0. + } +} +\if{html}{The contents of this section are shown in PDF user manual only.} +} + +\examples{ +library(dplyr) +library(gsDesign) + +# ---------------------------------# +# example 1 # +# ---------------------------------# +# Single analysis +# Lachin book p 71 difference of proportions example +pc <- .28 # Control response rate +pe <- .40 # Experimental response rate +p0 <- (pc + pe) / 2 # Ave response rate under H0 + +# Information per increment of 1 in sample size +info0 <- 1 / (p0 * (1 - p0) * 4) +info <- 1 / (pc * (1 - pc) * 2 + pe * (1 - pe) * 2) + +# Result should round up to next even number = 652 +# Divide information needed under H1 by information per patient added +gs_design_npe(theta = pe - pc, info = info, info0 = info0) + + +# ---------------------------------# +# example 2 # +# ---------------------------------# +# Fixed bound +x <- gs_design_npe( + theta = c(.1, .2, .3), + info = (1:3) * 80, + info0 = (1:3) * 80, + upper = gs_b, + upar = gsDesign::gsDesign(k = 3, sfu = gsDesign::sfLDOF)$upper$bound, + lower = gs_b, + lpar = c(-1, 0, 0)) +x + +# Same upper bound; this represents non-binding Type I error and will total 0.025 +gs_power_npe( + theta = rep(0, 3), + info = (x \%>\% filter(Bound == "Upper"))$info, + upper = gs_b, + upar = (x \%>\% filter(Bound == "Upper"))$Z, + lower = gs_b, + lpar = rep(-Inf, 3)) + +# ---------------------------------# +# example 3 # +# ---------------------------------# +# Spending bound examples +# Design with futility only at analysis 1; efficacy only at analyses 2, 3 +# Spending bound for efficacy; fixed bound for futility +# NOTE: test_upper and test_lower DO NOT WORK with gs_b; must explicitly make bounds infinite +# test_upper and test_lower DO WORK with gs_spending_bound +gs_design_npe( + theta = c(.1, .2, .3), + info = (1:3) * 40, + info0 = (1:3) * 40, + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), + lower = gs_b, + lpar = c(-1, -Inf, -Inf), + test_upper = c(FALSE, TRUE, TRUE)) + +# one can try `info_scale = 1` or `info_scale = 0` here +gs_design_npe( + theta = c(.1, .2, .3), + info = (1:3) * 40, + info0 = (1:3) * 30, + info_scale = 1, + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), + lower = gs_b, + lpar = c(-1, -Inf, -Inf), + test_upper = c(FALSE, TRUE, TRUE)) + +# ---------------------------------# +# example 4 # +# ---------------------------------# +# Spending function bounds +# 2-sided asymmetric bounds +# Lower spending based on non-zero effect +gs_design_npe( + theta = c(.1, .2, .3), + info = (1:3) * 40, + info0 = (1:3) * 30, + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), + lower = gs_spending_bound, + lpar = list(sf = gsDesign::sfHSD, total_spend = 0.1, param = -1, timing = NULL)) + +# ---------------------------------# +# example 5 # +# ---------------------------------# +# Two-sided symmetric spend, O'Brien-Fleming spending +# Typically, 2-sided bounds are binding +xx <- gs_design_npe( + theta = c(.1, .2, .3), + info = (1:3) * 40, + binding = TRUE, + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), + lower = gs_spending_bound, + lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL)) +xx + +# Re-use these bounds under alternate hypothesis +# Always use binding = TRUE for power calculations +gs_power_npe( + theta = c(.1, .2, .3), + info = (1:3) * 40, + binding = TRUE, + upper = gs_b, + lower = gs_b, + upar = (xx \%>\% filter(Bound == "Upper"))$Z, + lpar = -(xx \%>\% filter(Bound == "Upper"))$Z) + +} +\author{ +Keaven Anderson \email{keaven_anderson@merck.com} +} diff --git a/man/gs_design_rd.Rd b/man/gs_design_rd.Rd new file mode 100644 index 000000000..a3fa342f1 --- /dev/null +++ b/man/gs_design_rd.Rd @@ -0,0 +1,129 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gs_design_rd.R +\name{gs_design_rd} +\alias{gs_design_rd} +\title{Group sequential design using average hazard ratio under non-proportional hazards} +\usage{ +gs_design_rd( + p_c = tibble(Stratum = "All", Rate = 0.2), + p_e = tibble(Stratum = "All", Rate = 0.15), + IF = 1:3/3, + rd0 = 0, + alpha = 0.025, + beta = 0.1, + ratio = 1, + stratum_prev = NULL, + weight = c("un-stratified", "ss", "invar"), + upper = gs_b, + lower = gs_b, + upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, + lpar = c(qnorm(0.1), rep(-Inf, 2)), + test_upper = TRUE, + test_lower = TRUE, + info_scale = c(0, 1, 2), + binding = FALSE, + r = 18, + tol = 1e-06, + h1_spending = FALSE +) +} +\arguments{ +\item{p_c}{rate at the control group} + +\item{p_e}{rate at the experimental group} + +\item{IF}{statistical information fraction} + +\item{rd0}{treatment effect under super-superiority designs, the default is 0} + +\item{alpha}{One-sided Type I error} + +\item{beta}{Type II error} + +\item{ratio}{Experimental:Control randomization ratio (not yet implemented)} + +\item{stratum_prev}{randomization ratio of different stratum. +If it is un-stratified design then \code{NULL}. +Otherwise it is a tibble containing two columns (Stratum and prevalence).} + +\item{weight}{the weighting scheme for stratified population} + +\item{upper}{Function to compute upper bound} + +\item{lower}{Function to compute lower bound} + +\item{upar}{Parameter passed to \code{upper()}} + +\item{lpar}{Parameter passed to \code{lower()}} + +\item{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 \code{info} should indicate which analyses will have an efficacy bound} + +\item{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 \code{info} should indicate which analyses will have a +lower bound} + +\item{info_scale}{the information scale for calculation} + +\item{binding}{indicator of whether futility bound is binding; default of FALSE is recommended} + +\item{r}{Integer, at least 2; default of 18 recommended by Jennison and Turnbull} + +\item{tol}{Tolerance parameter for boundary convergence (on Z-scale)} + +\item{h1_spending}{Indicator that lower bound to be set by spending under alternate hypothesis (input \code{failRates}) +if spending is used for lower bound} +} +\value{ +a \code{tibble} with columns Analysis, Bound, Z, Probability, theta, Time, AHR, Events +} +\description{ +Group sequential design using average hazard ratio under non-proportional hazards +} +\details{ +Need to be added +} +\examples{ +library(tibble) +library(gsDesign) + +# ----------------- # +# example 1 # +#------------------ # +# un-stratified group sequential design +gs_design_rd( + p_c = tibble(Stratum = "All", Rate = .2), + p_e = tibble(Stratum = "All", Rate = .15), + IF = c(0.7, 1), + rd0 = 0, + alpha = .025, + beta = .1, + ratio = 1, + stratum_prev = NULL, + weight = "un-stratified", + upper = gs_b, + lower = gs_b, + upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, + lpar = c(qnorm(.1), rep(-Inf, 2)) + ) + +# ----------------- # +# example 2 # +# ----------------- # +# stratified group sequential design +gs_design_rd( + p_c = tibble(Stratum = c("biomarker positive", "biomarker negative"), Rate = c(.2, .25)), + p_e = tibble(Stratum = c("biomarker positive", "biomarker negative"), Rate = c(.15,.22)), + IF = c(0.7, 1), + rd0 = 0, + alpha = .025, + beta = .1, + ratio = 1, + stratum_prev = tibble(Stratum = c("biomarker positive", "biomarker negative"), prevalence = c(.4, .6)), + weight = "ss", + upper = gs_spending_bound,lower = gs_b, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), + lpar = rep(-Inf, 2) +) + +} diff --git a/man/gs_design_wlr.Rd b/man/gs_design_wlr.Rd new file mode 100644 index 000000000..77e7a0969 --- /dev/null +++ b/man/gs_design_wlr.Rd @@ -0,0 +1,169 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gs_design_wlr.R +\name{gs_design_wlr} +\alias{gs_design_wlr} +\title{Group sequential design using weighted log-rank test under non-proportional hazards} +\usage{ +gs_design_wlr( + enrollRates = tibble(Stratum = "All", duration = c(2, 2, 10), rate = c(3, 6, 9)), + failRates = tibble(Stratum = "All", duration = c(3, 100), failRate = log(2)/c(9, 18), + hr = c(0.9, 0.6), dropoutRate = rep(0.001, 2)), + weight = wlr_weight_fh, + approx = "asymptotic", + alpha = 0.025, + beta = 0.1, + ratio = 1, + IF = NULL, + info_scale = c(0, 1, 2), + analysisTimes = 36, + binding = FALSE, + upper = gs_b, + upar = gsDesign(k = 3, test.type = 1, n.I = c(0.25, 0.75, 1), sfu = sfLDOF, sfupar = + NULL)$upper$bound, + lower = gs_b, + lpar = c(qnorm(0.1), -Inf, -Inf), + test_upper = TRUE, + test_lower = TRUE, + h1_spending = TRUE, + r = 18, + tol = 1e-06 +) +} +\arguments{ +\item{enrollRates}{enrollment rates} + +\item{failRates}{failure and dropout rates} + +\item{weight}{weight of weighted log rank test +\itemize{ +\item \code{"1"}=unweighted, +\item \code{"n"}=Gehan-Breslow, +\item \code{"sqrtN"}=Tarone-Ware, +\item \code{"FH_p[a]_q[b]"}= Fleming-Harrington with p=a and q=b +}} + +\item{approx}{approximate estimation method for Z statistics +\itemize{ +\item \code{"event driven"} = only work under proportional hazard model with log rank test +\item \code{"asymptotic"} +}} + +\item{alpha}{One-sided Type I error} + +\item{beta}{Type II error} + +\item{ratio}{Experimental:Control randomization ratio (not yet implemented)} + +\item{IF}{Targeted information fraction at each analysis} + +\item{info_scale}{the information scale for calculation} + +\item{analysisTimes}{Minimum time of analysis} + +\item{binding}{indicator of whether futility bound is binding; default of FALSE is recommended} + +\item{upper}{Function to compute upper bound} + +\item{upar}{Parameter passed to \code{upper()}} + +\item{lower}{Function to compute lower bound} + +\item{lpar}{Parameter passed to \code{lower()}} + +\item{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 \code{info} should indicate which analyses will have an efficacy bound} + +\item{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 \code{info} should indicate which analyses will have a +lower bound} + +\item{h1_spending}{Indicator that lower bound to be set by spending under alternate hypothesis (input \code{failRates}) +if spending is used for lower bound} + +\item{r}{Integer, at least 2; default of 18 recommended by Jennison and Turnbull} + +\item{tol}{Tolerance parameter for boundary convergence (on Z-scale)} +} +\description{ +Group sequential design using weighted log-rank test under non-proportional hazards +} +\section{Specification}{ + +\if{latex}{ + \itemize{ + \item Validate if input analysisTimes is a positive number or a positive increasing sequence. + \item Validate if input IF is a positive number or positive increasing sequence on (0, 1] with final value of 1. + \item Validate if inputs IF and analysisTimes have the same length if both have length > 1. + \item Compute information at input analysisTimes using \code{gs_info_wlr()}. + \item Compute sample size and bounds using \code{gs_design_npe()}. + \item Return a list of design enrollment, failure rates, and bounds. + } +} +\if{html}{The contents of this section are shown in PDF user manual only.} +} + +\examples{ +library(dplyr) +library(mvtnorm) +library(gsDesign) +library(tibble) +library(gsDesign2) + +# set enrollment rates +enrollRates <- tibble(Stratum = "All", duration = 12, rate = 500/12) + +# set failure rates +failRates <- tibble( + Stratum = "All", + duration = c(4, 100), + failRate = log(2) / 15, # median survival 15 month + hr = c(1, .6), + dropoutRate = 0.001) + +# -------------------------# +# example 1 # +# ------------------------ # +# Boundary is fixed +x <- gsSurv( + k = 3, + test.type = 4, + alpha = 0.025, beta = 0.2, + astar = 0, timing = 1, + sfu = sfLDOF, sfupar = 0, + sfl = sfLDOF, sflpar = 0, + lambdaC = 0.1, + hr = 0.6, hr0 = 1, + eta = 0.01, gamma = 10, + R = 12, S = NULL, + T = 36, minfup = 24, + ratio = 1) + +gs_design_wlr( + enrollRates = enrollRates, + failRates = failRates, + ratio = 1, + alpha = 0.025, beta = 0.2, + weight = function(x, arm0, arm1){wlr_weight_fh(x, arm0, arm1, rho = 0, gamma = 0.5)}, + upper = gs_b, + upar = x$upper$bound, + lower = gs_b, + lpar = x$lower$bound, + analysisTimes = c(12, 24, 36)) + +# -------------------------# +# example 2 # +# ------------------------ # +# Boundary derived by spending function +gs_design_wlr( + enrollRates = enrollRates, + failRates = failRates, + ratio = 1, + alpha = 0.025, beta = 0.2, + weight = function(x, arm0, arm1){wlr_weight_fh(x, arm0, arm1, rho = 0, gamma = 0.5)}, + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025), + lower = gs_spending_bound, + lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.2), + analysisTimes = c(12, 24, 36)) + +} diff --git a/man/gs_info_ahr.Rd b/man/gs_info_ahr.Rd new file mode 100644 index 000000000..c7a5c14ad --- /dev/null +++ b/man/gs_info_ahr.Rd @@ -0,0 +1,85 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gs_info_ahr.R +\name{gs_info_ahr} +\alias{gs_info_ahr} +\title{Information and effect size based on AHR approximation} +\usage{ +gs_info_ahr( + enrollRates = tibble::tibble(Stratum = "All", duration = c(2, 2, 10), rate = c(3, 6, + 9)), + failRates = tibble::tibble(Stratum = "All", duration = c(3, 100), failRate = + log(2)/c(9, 18), hr = c(0.9, 0.6), dropoutRate = rep(0.001, 2)), + ratio = 1, + events = NULL, + analysisTimes = NULL +) +} +\arguments{ +\item{enrollRates}{enrollment rates} + +\item{failRates}{failure and dropout rates} + +\item{ratio}{Experimental:Control randomization ratio} + +\item{events}{Targeted minimum events at each analysis} + +\item{analysisTimes}{Targeted minimum study duration at each analysis} +} +\value{ +a \code{tibble} with columns \code{Analysis, Time, AHR, Events, theta, info, info0.} +\code{info, info0} contains statistical information under H1, H0, respectively. +For analysis \code{k}, \code{Time[k]} is the maximum of \code{analysisTimes[k]} and the expected time +required to accrue the targeted \code{events[k]}. +\code{AHR} is expected average hazard ratio at each analysis. +} +\description{ +Based on piecewise enrollment rate, failure rate, and dropout rates computes +approximate information and effect size using an average hazard ratio model. +} +\details{ +The \code{AHR()} function computes statistical information at targeted event times. +The \code{tEvents()} function is used to get events and average HR at targeted \code{analysisTimes}. +} +\section{Specification}{ + +\if{latex}{ + \itemize{ + \item Validate if input events is a numeric value vector or a vector with increasing values. + \item Validate if input analysisTime is a numeric value vector or a vector with increasing values. + \item Validate if inputs events and analysisTime have the same length if they are both specified. + \item Compute average hazard ratio: + \itemize{ + \item If analysisTime is specified, calculate average hazard ratio using \code{gsDesign2::AHR()}. + \item If events is specified, calculate average hazard ratio using \code{gsDesign2::tEvents()}. + } + \item Return a tibble of Analysis, Time, AHR, Events, theta, info, info0. + } +} +\if{html}{The contents of this section are shown in PDF user manual only.} +} + +\examples{ +library(gsDesign) +library(gsDesign2) + +# ------------------------ # +# Example 1 # +# ------------------------ # +# Only put in targeted events +gs_info_ahr(events = c(30, 40, 50)) + +# ------------------------ # +# Example 2 # +# ------------------------ # +# Only put in targeted analysis times +gs_info_ahr(analysisTimes = c(18, 27, 36)) + +# ------------------------ # +# Example 3 # +# ------------------------ # +# Some analysis times after time at which targeted events accrue +# Check that both Time >= input analysisTime and Events >= input events +gs_info_ahr(events = c(30, 40, 50), analysisTimes = c(16, 19, 26)) +gs_info_ahr(events = c(30, 40, 50), analysisTimes = c(14, 20, 24)) + +} diff --git a/man/gs_info_combo.Rd b/man/gs_info_combo.Rd new file mode 100644 index 000000000..64e72ba58 --- /dev/null +++ b/man/gs_info_combo.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gs_info_combo.R +\name{gs_info_combo} +\alias{gs_info_combo} +\title{Information and effect size for max combo test} +\usage{ +gs_info_combo( + enrollRates = tibble(Stratum = "All", duration = c(2, 2, 10), rate = c(3, 6, 9)), + failRates = tibble(Stratum = "All", duration = c(3, 100), failRate = log(2)/c(9, 18), + hr = c(0.9, 0.6), dropoutRate = rep(0.001, 2)), + ratio = 1, + events = NULL, + analysisTimes = NULL, + rho, + gamma, + tau = rep(-1, length(rho)), + approx = "asymptotic" +) +} +\arguments{ +\item{enrollRates}{enrollment rates} + +\item{failRates}{failure and dropout rates} + +\item{ratio}{Experimental:Control randomization ratio (not yet implemented)} + +\item{events}{Targeted events at each analysis} + +\item{analysisTimes}{Minimum time of analysis} + +\item{rho}{Weighting parameters} + +\item{gamma}{Weighting parameters} + +\item{tau}{Weighting parameters} + +\item{approx}{Approximation method} +} +\description{ +Information and effect size for max combo test +} diff --git a/man/gs_info_rd.Rd b/man/gs_info_rd.Rd new file mode 100644 index 000000000..a6c0c1a6e --- /dev/null +++ b/man/gs_info_rd.Rd @@ -0,0 +1,138 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gs_info_rd.R +\name{gs_info_rd} +\alias{gs_info_rd} +\title{Information and effect size under risk difference} +\usage{ +gs_info_rd( + p_c = tibble::tibble(Stratum = "All", Rate = 0.2), + p_e = tibble::tibble(Stratum = "All", Rate = 0.15), + N = tibble::tibble(Stratum = "All", N = c(100, 200, 300), Analysis = 1:3), + rd0 = 0, + ratio = 1, + weight = c("un-stratified", "ss", "invar") +) +} +\arguments{ +\item{p_c}{rate at the control group} + +\item{p_e}{rate at the experimental group} + +\item{N}{sample size} + +\item{rd0}{the risk difference under H0} + +\item{ratio}{Experimental:Control randomization ratio} + +\item{weight}{weigting method, either "un-stratified" or "ss" or "invar"} +} +\description{ +Information and effect size under risk difference +} +\examples{ +library(tibble) +# --------------------- # +# example 1 # +# --------------------- # +# un-stratified case with H0: rd0 = 0 +gs_info_rd( + p_c = tibble(Stratum = "All", Rate = .15), + p_e = tibble(Stratum = "All", Rate = .1), + N = tibble(Stratum = "All", N = c(100, 200, 300), Analysis = 1:3), + rd0 = 0, + ratio = 1 +) + +# --------------------- # +# example 2 # +# --------------------- # +# un-stratified case with H0: rd0 != 0 +gs_info_rd( + p_c = tibble(Stratum = "All", Rate = .2), + p_e = tibble(Stratum = "All", Rate = .15), + N = tibble(Stratum = "All", N = c(100, 200, 300), Analysis = 1:3), + rd0 = 0.005, + ratio = 1 +) + +# --------------------- # +# example 3 # +# --------------------- # +# stratified case under sample size weighting and H0: rd0 = 0 +gs_info_rd( + p_c = tibble(Stratum = c("S1", "S2", "S3"), Rate = c(.15, .2, .25)), + p_e = tibble(Stratum = c("S1", "S2", "S3"), Rate = c(.1, .16, .19)), + N = tibble(Stratum = rep(c("S1", "S2", "S3"), each = 3), + Analysis = rep(1:3, 3), + N = c(50, 100, 200, 40, 80, 160, 60, 120, 240)), + rd0 = 0, + ratio = 1, + weight = "ss") + +# --------------------- # +# example 4 # +# --------------------- # +# stratified case under inverse variance weighting and H0: rd0 = 0 +gs_info_rd( + p_c = tibble(Stratum = c("S1", "S2", "S3"), + Rate = c(.15, .2, .25)), + p_e = tibble(Stratum = c("S1", "S2", "S3"), + Rate = c(.1, .16, .19)), + N = tibble(Stratum = rep(c("S1", "S2", "S3"), each = 3), + Analysis = rep(1:3, 3), + N = c(50, 100, 200, 40, 80, 160, 60, 120, 240)), + rd0 = 0, + ratio = 1, + weight = "invar") + +# --------------------- # +# example 5 # +# --------------------- # +# stratified case under sample size weighting and H0: rd0 != 0 +gs_info_rd( + p_c = tibble(Stratum = c("S1", "S2", "S3"), + Rate = c(.15, .2, .25)), + p_e = tibble(Stratum = c("S1", "S2", "S3"), + Rate = c(.1, .16, .19)), + N = tibble(Stratum = rep(c("S1", "S2", "S3"), each = 3), + Analysis = rep(1:3, 3), + N = c(50, 100, 200, 40, 80, 160, 60, 120, 240)), + rd0 = 0.02, + ratio = 1, + weight = "ss") + +# --------------------- # +# example 6 # +# --------------------- # +# stratified case under inverse variance weighting and H0: rd0 != 0 +gs_info_rd( + p_c = tibble(Stratum = c("S1", "S2", "S3"), + Rate = c(.15, .2, .25)), + p_e = tibble(Stratum = c("S1", "S2", "S3"), + Rate = c(.1, .16, .19)), + N = tibble(Stratum = rep(c("S1", "S2", "S3"), each = 3), + Analysis = rep(1:3, 3), + N = c(50, 100, 200, 40, 80, 160, 60, 120, 240)), + rd0 = 0.02, + ratio = 1, + weight = "invar") + +# --------------------- # +# example 7 # +# --------------------- # +# stratified case under inverse variance weighting and H0: rd0 != 0 and +# rd0 difference for different statum +gs_info_rd( + p_c = tibble(Stratum = c("S1", "S2", "S3"), + Rate = c(.15, .2, .25)), + p_e = tibble(Stratum = c("S1", "S2", "S3"), + Rate = c(.1, .16, .19)), + N = tibble(Stratum = rep(c("S1", "S2", "S3"), each = 3), + Analysis = rep(1:3, 3), + N = c(50, 100, 200, 40, 80, 160, 60, 120, 240)), + rd0 = tibble(Stratum = c("S1", "S2", "S3"), + rd0 = c(0.01, 0.02, 0.03)), + ratio = 1, + weight = "invar") + +} diff --git a/man/gs_info_wlr.Rd b/man/gs_info_wlr.Rd new file mode 100644 index 000000000..3bfcd0660 --- /dev/null +++ b/man/gs_info_wlr.Rd @@ -0,0 +1,58 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gs_info_wlr.R +\name{gs_info_wlr} +\alias{gs_info_wlr} +\title{Information and effect size for Weighted Log-rank test} +\usage{ +gs_info_wlr( + enrollRates = tibble::tibble(Stratum = "All", duration = c(2, 2, 10), rate = c(3, 6, + 9)), + failRates = tibble::tibble(Stratum = "All", duration = c(3, 100), failRate = + log(2)/c(9, 18), hr = c(0.9, 0.6), dropoutRate = rep(0.001, 2)), + ratio = 1, + events = NULL, + analysisTimes = NULL, + weight = wlr_weight_fh, + approx = "asymptotic" +) +} +\arguments{ +\item{enrollRates}{enrollment rates} + +\item{failRates}{failure and dropout rates} + +\item{ratio}{Experimental:Control randomization ratio} + +\item{events}{Targeted minimum events at each analysis} + +\item{analysisTimes}{Targeted minimum study duration at each analysis} + +\item{weight}{weight of weighted log rank test +\itemize{ +\item \code{"1"}=unweighted, +\item \code{"n"}=Gehan-Breslow, +\item \code{"sqrtN"}=Tarone-Ware, +\item \code{"FH_p[a]_q[b]"}= Fleming-Harrington with p=a and q=b +}} + +\item{approx}{approximate estimation method for Z statistics +\itemize{ +\item \code{"event driven"} = only work under proportional hazard model with log rank test +\item \code{"asymptotic"} +}} +} +\value{ +a \code{tibble} with columns \code{Analysis, Time, N, Events, AHR, delta, sigma2, theta, info, info0.} +\code{info, info0} contains statistical information under H1, H0, respectively. +For analysis \code{k}, \code{Time[k]} is the maximum of \code{analysisTimes[k]} and the expected time +required to accrue the targeted \code{events[k]}. +\code{AHR} is expected average hazard ratio at each analysis. +} +\description{ +Based on piecewise enrollment rate, failure rate, and dropout rates computes +approximate information and effect size using an average hazard ratio model. +} +\details{ +The \code{AHR()} function computes statistical information at targeted event times. +The \code{tEvents()} function is used to get events and average HR at targeted \code{analysisTimes}. +} diff --git a/man/gs_power_ahr.Rd b/man/gs_power_ahr.Rd new file mode 100644 index 000000000..52b8b5e34 --- /dev/null +++ b/man/gs_power_ahr.Rd @@ -0,0 +1,142 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gs_power_ahr.R +\name{gs_power_ahr} +\alias{gs_power_ahr} +\title{Group sequential design power using average hazard ratio under non-proportional hazards} +\usage{ +gs_power_ahr( + enrollRates = tibble(Stratum = "All", duration = c(2, 2, 10), rate = c(3, 6, 9)), + failRates = tibble(Stratum = "All", duration = c(3, 100), failRate = log(2)/c(9, 18), + hr = c(0.9, 0.6), dropoutRate = rep(0.001, 2)), + events = c(30, 40, 50), + analysisTimes = NULL, + upper = gs_b, + upar = gsDesign(k = length(events), test.type = 1, n.I = events, maxn.IPlan = + max(events), sfu = sfLDOF, sfupar = NULL)$upper$bound, + lower = gs_b, + lpar = c(qnorm(0.1), rep(-Inf, 2)), + test_lower = TRUE, + test_upper = TRUE, + ratio = 1, + binding = FALSE, + info_scale = c(0, 1, 2), + r = 18, + tol = 1e-06 +) +} +\arguments{ +\item{enrollRates}{enrollment rates} + +\item{failRates}{failure and dropout rates} + +\item{events}{Targeted events at each analysis} + +\item{analysisTimes}{Minimum time of analysis} + +\item{upper}{Function to compute upper bound} + +\item{upar}{Parameter passed to \code{upper()}} + +\item{lower}{Function to compute lower bound} + +\item{lpar}{Parameter passed to \code{lower()}} + +\item{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 \code{info} should indicate which analyses will have a +lower bound} + +\item{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 \code{info} should indicate which analyses will have an efficacy bound} + +\item{ratio}{Experimental:Control randomization ratio (not yet implemented)} + +\item{binding}{indicator of whether futility bound is binding; default of FALSE is recommended} + +\item{info_scale}{the information scale for calculation} + +\item{r}{Integer, at least 2; default of 18 recommended by Jennison and Turnbull} + +\item{tol}{Tolerance parameter for boundary convergence (on Z-scale)} +} +\value{ +a \code{tibble} with columns \code{Analysis, Bound, Z, Probability, theta, Time, AHR, Events}. +Contains a row for each analysis and each bound. +} +\description{ +Group sequential design power using average hazard ratio under non-proportional hazards +} +\details{ +Bound satisfy input upper bound specification in \code{upper, upar} and lower bound specification in \code{lower, lpar}. +The \code{AHR()} function computes statistical information at targeted event times. +The \code{tEvents()} function is used to get events and average HR at targeted \code{analysisTimes}. +} +\section{Specification}{ + +\if{latex}{ + \itemize{ + \item Calculate information and effect size based on AHR approximation using \code{gs_info_ahr()}. + \item Return a tibble of with columns Analysis, Bound, Z, Probability, theta, + Time, AHR, Events and contains a row for each analysis and each bound. + } +} +\if{html}{The contents of this section are shown in PDF user manual only.} +} + +\examples{ +library(gsDesign2) +library(dplyr) + +# -------------------------# +# example 1 # +# ------------------------ # +# The default output of \code{gs_power_ahr} is driven by events, i.e., +# \code{events = c(30, 40, 50), analysisTimes = NULL} +gs_power_ahr() + +# -------------------------# +# example 2 # +# -------------------------# +# 2-sided symmetric O'Brien-Fleming spending bound, +# driven by analysis time, i.e., \code{events = NULL, analysisTimes = c(12, 24, 36)} +gs_power_ahr( + analysisTimes = c(12, 24, 36), + events = NULL, + 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)) + +# -------------------------# +# example 3 # +# -------------------------# +# 2-sided symmetric O'Brien-Fleming spending bound, +# driven by events, i.e., \code{events = c(20, 50, 70), analysisTimes = NULL} +gs_power_ahr( + analysisTimes = NULL, + events = c(20, 50, 70), + 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)) + +# -------------------------# +# example 4 # +# -------------------------# +# 2-sided symmetric O'Brien-Fleming spending bound, +# driven by both `events` and `analysisTimes`, i.e., +# both `events` and `analysisTimes` are not `NULL`, +# then the analysis will driven by the maximal one, i.e., +# Time = max(analysisTime, calculated Time for targeted events) +# Events = max(events, calculated events for targeted analysisTime) +gs_power_ahr( + analysisTimes = c(12, 24, 36), + events = c(30, 40, 50), + 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)) + +} diff --git a/man/gs_power_combo.Rd b/man/gs_power_combo.Rd new file mode 100644 index 000000000..a8cd8d526 --- /dev/null +++ b/man/gs_power_combo.Rd @@ -0,0 +1,109 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gs_power_combo.R +\name{gs_power_combo} +\alias{gs_power_combo} +\title{Group sequential design power using MaxCombo test under non-proportional hazards} +\usage{ +gs_power_combo( + enrollRates = tibble(Stratum = "All", duration = 12, rate = 500/12), + failRates = tibble(Stratum = "All", duration = c(4, 100), failRate = log(2)/15, hr = + c(1, 0.6), dropoutRate = 0.001), + fh_test = rbind(data.frame(rho = 0, gamma = 0, tau = -1, test = 1, Analysis = 1:3, + analysisTimes = c(12, 24, 36)), data.frame(rho = c(0, 0.5), gamma = 0.5, tau = -1, + test = 2:3, Analysis = 3, analysisTimes = 36)), + ratio = 1, + binding = FALSE, + upper = gs_b, + upar = c(3, 2, 1), + lower = gs_b, + lpar = c(-1, 0, 1), + algorithm = GenzBretz(maxpts = 1e+05, abseps = 1e-05), + ... +) +} +\arguments{ +\item{enrollRates}{enrollment rates} + +\item{failRates}{failure and dropout rates} + +\item{fh_test}{a data frame to summarize the test in each analysis. +Refer examples for its data structure.} + +\item{ratio}{Experimental:Control randomization ratio (not yet implemented)} + +\item{binding}{indicator of whether futility bound is binding; default of FALSE is recommended} + +\item{upper}{Function to compute upper bound} + +\item{upar}{Parameter passed to \code{upper()}} + +\item{lower}{Function to compute lower bound} + +\item{lpar}{Parameter passed to \code{lower()}} + +\item{algorithm}{ an object of class \code{\link[mvtnorm]{GenzBretz}}, + \code{\link[mvtnorm]{Miwa}} or \code{\link[mvtnorm]{TVPACK}} + specifying both the algorithm to be used as well as + the associated hyper parameters.} + +\item{...}{additional parameters transfer to \code{mvtnorm::pmvnorm}} +} +\description{ +Group sequential design power using MaxCombo test under non-proportional hazards +} +\section{Specification}{ + +\if{latex}{ + \itemize{ + \item Validate if lower and upper bounds have been specified. + \item Extract info, info_fh, theta_fh and corr_fh from utility. + \item Extract sample size via the maximum sample size of info. + \item Calculate information fraction either for fixed or group sequential design. + \item Compute spending function using \code{gs_bound()}. + \item Compute probability of crossing bounds under the null and alternative + hypotheses using \code{gs_prob_combo()}. + \item Export required information for boundary and crossing probability + } +} +\if{html}{The contents of this section are shown in PDF user manual only.} +} + +\examples{ +library(dplyr) +library(mvtnorm) +library(gsDesign) +library(gsDesign2) +library(tibble) + +enrollRates <- tibble( + Stratum = "All", + duration = 12, + rate = 500/12) + +failRates <- tibble( + Stratum = "All", + duration = c(4, 100), + failRate = log(2) / 15, # median survival 15 month + hr = c(1, .6), + dropoutRate = 0.001) + +fh_test <- rbind( + data.frame(rho = 0, gamma = 0, tau = -1, test = 1, Analysis = 1:3, analysisTimes = c(12, 24, 36)), + data.frame(rho = c(0, 0.5), gamma = 0.5, tau = -1, test = 2:3, Analysis = 3, analysisTimes = 36) +) + +# -------------------------# +# example 1 # +# ------------------------ # +# Minimal Information Fraction derived bound +gs_power_combo( + enrollRates, + failRates, + fh_test, + upper = gs_spending_combo, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025), + lower = gs_spending_combo, + lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.2)) + + +} diff --git a/man/gs_power_npe.Rd b/man/gs_power_npe.Rd new file mode 100644 index 000000000..1c69d721c --- /dev/null +++ b/man/gs_power_npe.Rd @@ -0,0 +1,182 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gs_power_npe.R +\name{gs_power_npe} +\alias{gs_power_npe} +\title{Group sequential bound computation with non-constant effect} +\usage{ +gs_power_npe( + theta = 0.1, + theta0 = NULL, + theta1 = NULL, + info = 1, + info0 = NULL, + info1 = NULL, + info_scale = c(0, 1, 2), + upper = gs_b, + upar = qnorm(0.975), + lower = gs_b, + lpar = -Inf, + test_upper = TRUE, + test_lower = TRUE, + binding = FALSE, + r = 18, + tol = 1e-06 +) +} +\arguments{ +\item{theta}{natural parameter for group sequential design representing +expected incremental drift at all analyses; used for power calculation} + +\item{theta0}{natural parameter for null hypothesis, if needed for upper bound computation} + +\item{theta1}{natural parameter for alternate hypothesis, if needed for lower bound computation} + +\item{info}{statistical information at all analyses for input \code{theta}} + +\item{info0}{statistical information under null hypothesis, if different than \code{info}; +impacts null hypothesis bound calculation} + +\item{info1}{statistical information under hypothesis used for futility bound calculation if different from +\code{info}; impacts futility hypothesis bound calculation} + +\item{info_scale}{the information scale for calculation, default is 2, other options are 0 or 1.} + +\item{upper}{function to compute upper bound} + +\item{upar}{parameter to pass to upper} + +\item{lower}{function to compare lower bound} + +\item{lpar}{parameter to pass to lower} + +\item{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 \code{info} should indicate which analyses will have an efficacy bound} + +\item{test_lower}{indicator of which analyses should include a 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 \code{info} should indicate which analyses will have a lower bound} + +\item{binding}{indicator of whether futility bound is binding; default of FALSE is recommended} + +\item{r}{Integer, at least 2; default of 18 recommended by Jennison and Turnbull} + +\item{tol}{Tolerance parameter for boundary convergence (on Z-scale)} +} +\description{ +\code{gs_power_npe()} derives group sequential bounds and boundary crossing probabilities for a design. +It allows a non-constant treatment effect over time, but also can be applied for the usual homogeneous effect size designs. +It requires treatment effect and statistical information at each analysis as well as a method of deriving bounds, such as spending. +The routine enables two things not available in the gsDesign package: 1) non-constant effect, 2) more flexibility in boundary selection. +For many applications, the non-proportional-hazards design function \code{gs_design_nph()} will be used; it calls this function. +Initial bound types supported are 1) spending bounds, 2) fixed bounds, and 3) Haybittle-Peto-like bounds. +The requirement is to have a boundary update method that can each bound without knowledge of future bounds. +As an example, bounds based on conditional power that require knowledge of all future bounds are not supported by this routine; +a more limited conditional power method will be demonstrated. +Boundary family designs Wang-Tsiatis designs including the original (non-spending-function-based) O'Brien-Fleming and Pocock designs +are not supported by \code{gs_power_npe()}. +} +\section{Specification}{ + +\if{latex}{ + \itemize{ + \item Extract the length of input info as the number of interim analysis. + \item Validate if input info0 is NULL, so set it equal to info. + \item Validate if the length of inputs info and info0 are the same. + \item Validate if input theta is a scalar, so replicate the value for all k interim analysis. + \item Validate if input theta1 is NULL and if it is a scalar. If it is NULL, + set it equal to input theta. If it is a scalar, replicate the value for all k interim analysis. + \item Validate if input test_upper is a scalar, so replicate the value for all k interim analysis. + \item Validate if input test_lower is a scalar, so replicate the value for all k interim analysis. + \item Define vector a to be -Inf with length equal to the number of interim analysis. + \item Define vector b to be Inf with length equal to the number of interim analysis. + \item Define hgm1_0 and hgm1 to be NULL. + \item Define upperProb and lowerProb to be vectors of NA with length of the number of interim analysis. + \item Update lower and upper bounds using \code{gs_b()}. + \item If there are no interim analysis, compute proabilities of crossing upper and lower bounds + using \code{h1()}. + \item Compute cross upper and lower bound probabilities using \code{hupdate()} and \code{h1()}. + \item Return a tibble of analysis number, Bounds, Z-values, Probability of crossing bounds, + theta, theta1, info, and info0. + } +} +\if{html}{The contents of this section are shown in PDF user manual only.} +} + +\examples{ +library(gsDesign) +library(gsDesign2) +library(dplyr) + +# Default (single analysis; Type I error controlled) +gs_power_npe(theta = 0) \%>\% filter(Bound == "Upper") + +# Fixed bound +gs_power_npe( + theta = c(.1, .2, .3), + info = (1:3) * 40, + upper = gs_b, + upar = gsDesign::gsDesign(k = 3,sfu = gsDesign::sfLDOF)$upper$bound, + lower = gs_b, + lpar = c(-1, 0, 0)) + +# Same fixed efficacy bounds, no futility bound (i.e., non-binding bound), null hypothesis +gs_power_npe( + theta = rep(0, 3), + info = (1:3) * 40, + upar = gsDesign::gsDesign(k = 3,sfu = gsDesign::sfLDOF)$upper$bound, + lpar = rep(-Inf, 3)) \%>\% + filter(Bound == "Upper") + +# Fixed bound with futility only at analysis 1; efficacy only at analyses 2, 3 +gs_power_npe( + theta = c(.1, .2, .3), + info = (1:3) * 40, + upper = gs_b, + upar = c(Inf, 3, 2), + lower = gs_b, + lpar = c(qnorm(.1), -Inf, -Inf)) + +# Spending function bounds +# Lower spending based on non-zero effect +gs_power_npe( + theta = c(.1, .2, .3), + info = (1:3) * 40, + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), + lower = gs_spending_bound, + lpar = list(sf = gsDesign::sfHSD, total_spend = 0.1, param = -1, timing = NULL)) + +# Same bounds, but power under different theta +gs_power_npe( + theta = c(.15, .25, .35), + info = (1:3) * 40, + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), + lower = gs_spending_bound, + lpar = list(sf = gsDesign::sfHSD, total_spend = 0.1, param = -1, timing = NULL)) + +# Two-sided symmetric spend, O'Brien-Fleming spending +# Typically, 2-sided bounds are binding +x <- gs_power_npe( + theta = rep(0, 3), + info = (1:3) * 40, + binding = TRUE, + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), + lower = gs_spending_bound, + lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL)) + +# Re-use these bounds under alternate hypothesis +# Always use binding = TRUE for power calculations +gs_power_npe( + theta = c(.1, .2, .3), + info = (1:3) * 40, + binding = TRUE, + upar = (x \%>\% filter(Bound == "Upper"))$Z, + lpar = -(x \%>\% filter(Bound == "Upper"))$Z) +} +\author{ +Keaven Anderson \email{keaven_anderson@merck.com} +} diff --git a/man/gs_power_rd.Rd b/man/gs_power_rd.Rd new file mode 100644 index 000000000..b7dd72434 --- /dev/null +++ b/man/gs_power_rd.Rd @@ -0,0 +1,211 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gs_power_rd.R +\name{gs_power_rd} +\alias{gs_power_rd} +\title{Group sequential design power under risk difference} +\usage{ +gs_power_rd( + p_c = tibble::tibble(Stratum = "All", Rate = 0.2), + p_e = tibble::tibble(Stratum = "All", Rate = 0.15), + N = tibble::tibble(Stratum = "All", N = c(40, 50, 60), Analysis = 1:3), + rd0 = 0, + ratio = 1, + weight = c("un-stratified", "ss", "invar"), + upper = gs_b, + lower = gs_b, + upar = list(par = gsDesign(k = length(N), test.type = 1, sfu = sfLDOF, sfupar = + NULL)$upper$bound), + lpar = list(par = c(qnorm(0.1), rep(-Inf, length(N) - 1))), + info_scale = c(0, 1, 2), + binding = FALSE, + test_upper = TRUE, + test_lower = TRUE, + r = 18, + tol = 1e-06 +) +} +\arguments{ +\item{p_c}{rate at the control group} + +\item{p_e}{rate at the experimental group} + +\item{N}{sample size} + +\item{rd0}{treatment effect under super-superiority designs, the default is 0} + +\item{ratio}{experimental:control randomization ratio} + +\item{weight}{weigting method, either "un-stratified" or "ss" or "invar"} + +\item{upper}{function to compute upper bound} + +\item{lower}{function to compare lower bound} + +\item{upar}{parameter to pass to upper} + +\item{lpar}{parameter to pass to lower} + +\item{info_scale}{the information scale for calculation} + +\item{binding}{indicator of whether futility bound is binding; default of FALSE is recommended} + +\item{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 \code{info} should indicate which analyses will have an efficacy bound} + +\item{test_lower}{indicator of which analyses should include a 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 \code{info} should indicate which analyses will have a lower bound} + +\item{r}{Integer, at least 2; default of 18 recommended by Jennison and Turnbull} + +\item{tol}{Tolerance parameter for boundary convergence (on Z-scale)} +} +\value{ +a \code{tibble} with columns Analysis, Bound, Z, Probability, theta, Time, AHR, Events +} +\description{ +Group sequential design power under risk difference +} +\examples{ +# --------------------- # +# example 1 # +# --------------------- # +library(gsDesign) + +# un-stratified case with H0: rd0 = 0 +gs_power_rd( + p_c = tibble::tibble(Stratum = "All", + Rate = .2), + p_e = tibble::tibble(Stratum = "All", + Rate = .15), + N = tibble::tibble(Stratum = "All", + N = c(20, 40, 60), + Analysis = 1:3), + rd0 = 0, + ratio = 1, + upper = gs_b, + lower = gs_b, + upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, + lpar = c(qnorm(.1), rep(-Inf, 2)) +) + +# --------------------- # +# example 2 # +# --------------------- # +# un-stratified case with H0: rd0 != 0 +gs_power_rd( + p_c = tibble::tibble(Stratum = "All", + Rate = .2), + p_e = tibble::tibble(Stratum = "All", + Rate = .15), + N = tibble::tibble(Stratum = "All", + N = c(20, 40, 60), + Analysis = 1:3), + rd0 = 0.005, + ratio = 1, + upper = gs_b, + lower = gs_b, + upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, + lpar = c(qnorm(.1), rep(-Inf, 2)) +) + +# use spending function +gs_power_rd( + p_c = tibble::tibble(Stratum = "All", + Rate = .2), + p_e = tibble::tibble(Stratum = "All", + Rate = .15), + N = tibble::tibble(Stratum = "All", + N = c(20, 40, 60), + Analysis = 1:3), + rd0 = 0.005, + ratio = 1, + upper = gs_spending_bound, + lower = gs_b, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), + lpar = c(qnorm(.1), rep(-Inf, 2)) +) + +# --------------------- # +# example 3 # +# --------------------- # +# stratified case under sample size weighting and H0: rd0 = 0 +gs_power_rd( + p_c = tibble::tibble(Stratum = c("S1", "S2", "S3"), + Rate = c(.15, .2, .25)), + p_e = tibble::tibble(Stratum = c("S1", "S2", "S3"), + Rate = c(.1, .16, .19)), + N = tibble::tibble(Stratum = rep(c("S1", "S2", "S3"), each = 3), + Analysis = rep(1:3, 3), + N = c(10, 20, 24, 18, 26, 30, 10, 20, 24)), + rd0 = 0, + ratio = 1, + weight = "ss", + upper = gs_b, + lower = gs_b, + upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, + lpar = c(qnorm(.1), rep(-Inf, 2))) + +# --------------------- # +# example 4 # +# --------------------- # +# stratified case under inverse variance weighting and H0: rd0 = 0 +gs_power_rd( + p_c = tibble::tibble(Stratum = c("S1", "S2", "S3"), + Rate = c(.15, .2, .25)), + p_e = tibble::tibble(Stratum = c("S1", "S2", "S3"), + Rate = c(.1, .16, .19)), + N = tibble::tibble(Stratum = rep(c("S1", "S2", "S3"), each = 3), + Analysis = rep(1:3, 3), + N = c(10, 20, 24, 18, 26, 30, 10, 20, 24)), + rd0 = 0, + ratio = 1, + weight = "invar", + upper = gs_b, + lower = gs_b, + upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, + lpar = c(qnorm(.1), rep(-Inf, 2))) + +# --------------------- # +# example 5 # +# --------------------- # +# stratified case under sample size weighting and H0: rd0 != 0 +gs_power_rd( + p_c = tibble::tibble(Stratum = c("S1", "S2", "S3"), + Rate = c(.15, .2, .25)), + p_e = tibble::tibble(Stratum = c("S1", "S2", "S3"), + Rate = c(.1, .16, .19)), + N = tibble::tibble(Stratum = rep(c("S1", "S2", "S3"), each = 3), + Analysis = rep(1:3, 3), + N = c(10, 20, 24, 18, 26, 30, 10, 20, 24)), + rd0 = 0.02, + ratio = 1, + weight = "ss", + upper = gs_b, + lower = gs_b, + upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, + lpar = c(qnorm(.1), rep(-Inf, 2))) + +# --------------------- # +# example 6 # +# --------------------- # +# stratified case under inverse variance weighting and H0: rd0 != 0 +gs_power_rd( + p_c = tibble::tibble(Stratum = c("S1", "S2", "S3"), + Rate = c(.15, .2, .25)), + p_e = tibble::tibble(Stratum = c("S1", "S2", "S3"), + Rate = c(.1, .16, .19)), + N = tibble::tibble(Stratum = rep(c("S1", "S2", "S3"), each = 3), + Analysis = rep(1:3, 3), + N = c(10, 20, 24, 18, 26, 30, 10, 20, 24)), + rd0 = 0.03, + ratio = 1, + weight = "invar", + upper = gs_b, + lower = gs_b, + upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, + lpar = c(qnorm(.1), rep(-Inf, 2))) + +} diff --git a/man/gs_power_wlr.Rd b/man/gs_power_wlr.Rd new file mode 100644 index 000000000..700aff7a0 --- /dev/null +++ b/man/gs_power_wlr.Rd @@ -0,0 +1,197 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gs_power_wlr.R +\name{gs_power_wlr} +\alias{gs_power_wlr} +\title{Group sequential design power using weighted log rank test under non-proportional hazards} +\usage{ +gs_power_wlr( + enrollRates = tibble(Stratum = "All", duration = c(2, 2, 10), rate = c(3, 6, 9)), + failRates = tibble(Stratum = "All", duration = c(3, 100), failRate = log(2)/c(9, 18), + hr = c(0.9, 0.6), dropoutRate = rep(0.001, 2)), + events = c(30, 40, 50), + analysisTimes = NULL, + binding = FALSE, + upper = gs_b, + lower = gs_b, + upar = gsDesign(k = 3, test.type = 1, n.I = c(30, 40, 50), maxn.IPlan = 50, sfu = + sfLDOF, sfupar = NULL)$upper$bound, + lpar = c(qnorm(0.1), rep(-Inf, 2)), + test_upper = TRUE, + test_lower = TRUE, + ratio = 1, + weight = wlr_weight_fh, + info_scale = c(0, 1, 2), + approx = "asymptotic", + r = 18, + tol = 1e-06 +) +} +\arguments{ +\item{enrollRates}{enrollment rates} + +\item{failRates}{failure and dropout rates} + +\item{events}{Targeted events at each analysis} + +\item{analysisTimes}{Minimum time of analysis} + +\item{binding}{indicator of whether futility bound is binding; default of FALSE is recommended} + +\item{upper}{Function to compute upper bound} + +\item{lower}{Function to compute lower bound} + +\item{upar}{Parameter passed to \code{upper()}} + +\item{lpar}{Parameter passed to \code{lower()}} + +\item{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 \code{info} should indicate which analyses will have an efficacy bound} + +\item{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 \code{info} should indicate which analyses will have a +lower bound} + +\item{ratio}{Experimental:Control randomization ratio (not yet implemented)} + +\item{weight}{weight of weighted log rank test +\itemize{ +\item \code{"1"}=unweighted, +\item \code{"n"}=Gehan-Breslow, +\item \code{"sqrtN"}=Tarone-Ware, +\item \code{"FH_p[a]_q[b]"}= Fleming-Harrington with p=a and q=b +}} + +\item{info_scale}{the information scale for calculation} + +\item{approx}{approximate estimation method for Z statistics +\itemize{ +\item \code{"event driven"} = only work under proportional hazard model with log rank test +\item \code{"asymptotic"} +}} + +\item{r}{Integer, at least 2; default of 18 recommended by Jennison and Turnbull} + +\item{tol}{Tolerance parameter for boundary convergence (on Z-scale)} +} +\description{ +Group sequential design power using weighted log rank test under non-proportional hazards +} +\section{Specification}{ + +\if{latex}{ + \itemize{ + \item Compute information and effect size for Weighted Log-rank test using \code{gs_info_wlr()}. + \item Compute group sequential bound computation with non-constant effect using \code{gs_power_npe()}. + \item Combine information and effect size and power and return a + tibble with columns Analysis, Bound, Time, Events, Z, Probability, AHR, theta, info, and info0. + } +} +\if{html}{The contents of this section are shown in PDF user manual only.} +} + +\examples{ +library(tibble) +library(gsDesign) +library(gsDesign2) + +# set enrollment rates +enrollRates <- tibble(Stratum = "All", duration = 12, rate = 500/12) + +# set failure rates +failRates <- tibble( + Stratum = "All", + duration = c(4, 100), + failRate = log(2) / 15, # median survival 15 month + hr = c(1, .6), + dropoutRate = 0.001) + +# set the targeted number of events and analysis time +target_events <- c(30, 40, 50) +target_analysisTime <- c(10, 24, 30) + +# -------------------------# +# example 1 # +# ------------------------ # +# fixed bounds and calculate the power for targeted number of events +gs_power_wlr( + enrollRates = enrollRates, + failRates = failRates, + events = target_events, + analysisTimes = NULL, + upper = gs_b, + upar = gsDesign(k = length(target_events), test.type = 1, n.I = target_events, maxn.IPlan = max(target_events), sfu = sfLDOF, sfupar = NULL)$upper$bound, + lower = gs_b, + lpar = c(qnorm(.1), rep(-Inf, 2))) + +# -------------------------# +# example 2 # +# ------------------------ # +# fixed bounds and calculate the power for targeted analysis time +gs_power_wlr( + enrollRates = enrollRates, + failRates = failRates, + events = NULL, + analysisTimes = target_analysisTime, + upper = gs_b, + upar = gsDesign(k = length(target_events), test.type = 1, n.I = target_events, maxn.IPlan = max(target_events), sfu = sfLDOF, sfupar = NULL)$upper$bound, + lower = gs_b, + lpar = c(qnorm(.1), rep(-Inf, 2))) + +# -------------------------# +# example 3 # +# ------------------------ # +# fixed bounds and calculate the power for targeted analysis time & number of events +gs_power_wlr( + enrollRates = enrollRates, + failRates = failRates, + events = target_events, + analysisTimes = target_analysisTime, + upper = gs_b, + upar = gsDesign(k = length(target_events), test.type = 1, n.I = target_events, maxn.IPlan = max(target_events), sfu = sfLDOF, sfupar = NULL)$upper$bound, + lower = gs_b, + lpar = c(qnorm(.1), rep(-Inf, 2))) + +# -------------------------# +# example 4 # +# ------------------------ # +# spending bounds and calculate the power for targeted number of events +gs_power_wlr( + enrollRates = enrollRates, + failRates = failRates, + events = target_events, + analysisTimes = NULL, + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025), + lower = gs_spending_bound, + lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.2)) + +# -------------------------# +# example 5 # +# ------------------------ # +# spending bounds and calculate the power for targeted analysis time +gs_power_wlr( + enrollRates = enrollRates, + failRates = failRates, + events = NULL, + analysisTimes = target_analysisTime, + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025), + lower = gs_spending_bound, + lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.2)) + +# -------------------------# +# example 6 # +# ------------------------ # +# spending bounds and calculate the power for targeted analysis time & number of events +gs_power_wlr( + enrollRates = enrollRates, + failRates = failRates, + events = target_events, + analysisTimes = target_analysisTime, + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025), + lower = gs_spending_bound, + lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.2)) + +} diff --git a/man/gs_spending_bound.Rd b/man/gs_spending_bound.Rd new file mode 100644 index 000000000..395dbe2e7 --- /dev/null +++ b/man/gs_spending_bound.Rd @@ -0,0 +1,82 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gs_spending_bound.R +\name{gs_spending_bound} +\alias{gs_spending_bound} +\title{Derive spending bound for group sequential boundary} +\usage{ +gs_spending_bound( + 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 +) +} +\arguments{ +\item{k}{analysis for which bound is to be computed} + +\item{par}{a list with the following items: +\code{sf} (class spending function), +\code{total_spend} (total spend), +\code{param} (any parameters needed by the spending function \code{sf()}), +\code{timing} (a vector containing values at which spending function is to be evaluated or NULL if information-based spending is used), +\code{max_info} (when \code{timing} is NULL, this can be input as positive number to be used with \code{info} for information fraction at each analysis)} + +\item{hgm1}{subdensity grid from h1 (k=2) or hupdate (k>2) for analysis k-1; if k=1, this is not used and may be NULL} + +\item{theta}{natural parameter used for lower bound only spending; +represents average drift at each time of analysis at least up to analysis k; +upper bound spending is always set under null hypothesis (theta = 0)} + +\item{info}{statistical information at all analyses, at least up to analysis k} + +\item{efficacy}{TRUE (default) for efficacy bound, FALSE otherwise} + +\item{test_bound}{a logical vector of the same length as \code{info} should indicate which analyses will have a bound} + +\item{r}{Integer, at least 2; default of 18 recommended by Jennison and Turnbull} + +\item{tol}{Tolerance parameter for convergence (on Z-scale)} +} +\value{ +returns a numeric bound (possibly infinite) or, upon failure, generates an error message. +} +\description{ +Computes one bound at a time based on spending under given distributional assumptions. +While user specifies \code{gs_spending_bound()} for use with other functions, +it is not intended for use on its own. +Most important user specifications are made through a list provided to functions using \code{gs_spending_bound()}. +Function uses numerical integration and Newton-Raphson iteration to derive an individual bound for a group sequential +design that satisfies a targeted boundary crossing probability. +Algorithm is a simple extension of that in Chapter 19 of Jennison and Turnbull (2000). +} +\section{Specification}{ + +\if{latex}{ + \itemize{ + \item Set the spending time at analysis. + \item Compute the cumulative spending at analysis. + \item Compute the incremental spend at each analysis. + \item Set test_bound a vector of length k > 1 if input as a single value. + \item Compute spending for current bound. + \item Iterate to convergence as in gsbound.c from gsDesign. + \item Compute subdensity for final analysis in rejection region. + \item Validate the output and return an error message in case of failure. + \item Return a numeric bound (possibly infinite). + } +} +\if{html}{The contents of this section are shown in PDF user manual only.} +} + +\references{ +Jennison C and Turnbull BW (2000), \emph{Group Sequential +Methods with Applications to Clinical Trials}. Boca Raton: Chapman and Hall. +} +\author{ +Keaven Anderson \email{keaven_anderson@merck.com} +} diff --git a/man/gs_spending_combo.Rd b/man/gs_spending_combo.Rd new file mode 100644 index 000000000..a3e2f7b2c --- /dev/null +++ b/man/gs_spending_combo.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gs_spending_combo.R +\name{gs_spending_combo} +\alias{gs_spending_combo} +\title{Derive spending bound for MaxCombo group sequential boundary} +\usage{ +gs_spending_combo(par = NULL, info = NULL, ...) +} +\arguments{ +\item{par}{a list with the following items: +\code{sf} (class spending function), +\code{total_spend} (total spend), +\code{param} (any parameters needed by the spending function \code{sf()}), +\code{timing} (a vector containing values at which spending function is to be evaluated or NULL if information-based spending is used), +\code{max_info} (when \code{timing} is NULL, this can be input as positive number to be used with \code{info} for information fraction at each analysis)} + +\item{info}{statistical information at all analyses, at least up to analysis k} + +\item{...}{additional parameters transfered to \code{par$sf}.} +} +\description{ +Derive spending bound for MaxCombo group sequential boundary +} +\examples{ + +# alpha-spending +par <- list(sf = gsDesign::sfLDOF, total_spend = 0.025) +gs_spending_combo(par, info = 1:3/3) + +# beta-spending +par <- list(sf = gsDesign::sfLDOF, total_spend = 0.2) +gs_spending_combo(par, info = 1:3/3) + +} diff --git a/man/pmvnorm_combo.Rd b/man/pmvnorm_combo.Rd new file mode 100644 index 000000000..79332feaa --- /dev/null +++ b/man/pmvnorm_combo.Rd @@ -0,0 +1,46 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utility_combo.R +\name{pmvnorm_combo} +\alias{pmvnorm_combo} +\title{Multivariate Normal Distribution for Multivariate Maximum Statistics} +\usage{ +pmvnorm_combo( + lower, + upper, + group, + mean, + corr, + algorithm = GenzBretz(maxpts = 1e+05, abseps = 1e-05), + ... +) +} +\arguments{ +\item{lower}{ the vector of lower limits of length n.} + +\item{upper}{ the vector of upper limits of length n.} + +\item{group}{the vector of test statistics group.} + +\item{mean}{ the mean vector of length n.} + +\item{corr}{ the correlation matrix of dimension n.} + +\item{algorithm}{ an object of class \code{\link[mvtnorm]{GenzBretz}}, + \code{\link[mvtnorm]{Miwa}} or \code{\link[mvtnorm]{TVPACK}} + specifying both the algorithm to be used as well as + the associated hyper parameters.} + +\item{...}{additional parameters transfer to \code{mvtnorm::pmvnorm}} +} +\description{ +Computes the distribution function of the multivariate normal distribution +with maximum statistics for arbitrary limits and correlation matrices +} +\details{ +Let $Z = {Z_ij}$ be a multivariate normal distribution. +Here i is a group indicator and j is a within group statistics indicator. +Let G_i = max({Z_ij}) for all test within one group. +This program are calculating the probability + +$$Pr( lower < max(G) < upper )$$ +} diff --git a/man/ppwe.Rd b/man/ppwe.Rd index e538e2a46..66f051a76 100644 --- a/man/ppwe.Rd +++ b/man/ppwe.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ppwe.R +% Please edit documentation in R/helper_functions.R \name{ppwe} \alias{ppwe} \title{Piecewise exponential cumulative distribution function} diff --git a/man/s2pwe.Rd b/man/s2pwe.Rd index 07b621690..f98488a91 100644 --- a/man/s2pwe.Rd +++ b/man/s2pwe.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/s2pwe.R +% Please edit documentation in R/helper_functions.R \name{s2pwe} \alias{s2pwe} \title{Approximate survival distribution with piecewise exponential distribution} @@ -35,7 +35,7 @@ to a piecewise exponential approximation \examples{ # Example: arbitrary numbers -s2pwe(1:9,(9:1)/10) +s2pwe(1:9, (9:1)/10) # Example: lognormal -s2pwe(c(1:6,9),plnorm(c(1:6,9),meanlog=0,sdlog=2,lower.tail=FALSE)) +s2pwe(c(1:6,9), plnorm(c(1:6,9),meanlog = 0, sdlog = 2,lower.tail = FALSE)) } diff --git a/man/summary.Rd b/man/summary.Rd new file mode 100644 index 000000000..bd7a65537 --- /dev/null +++ b/man/summary.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/summary.R +\name{summary} +\alias{summary} +\title{S3 class method to summary fixed or group sequential design} +\usage{ +summary(x, ...) +} +\arguments{ +\item{x}{a fixed design object or a group sequential design object} + +\item{...}{additional arguments} +} +\value{ +a R data frame +} +\description{ +S3 class method to summary fixed or group sequential design +} diff --git a/man/summary.fixed_design.Rd b/man/summary.fixed_design.Rd new file mode 100644 index 000000000..93c428e16 --- /dev/null +++ b/man/summary.fixed_design.Rd @@ -0,0 +1,73 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/summary.R +\name{summary.fixed_design} +\alias{summary.fixed_design} +\title{summary for \code{fixed_design()} object} +\usage{ +\method{summary}{fixed_design}(x, ...) +} +\arguments{ +\item{x}{a fixed design object returned by \code{fixed_design()}} + +\item{...}{additional arguments} +} +\description{ +summary function to fixed_design class +} +\examples{ +library(dplyr) + +# Enrollment rate +enrollRates <- tibble::tibble( + Stratum = "All", + duration = 18, + rate = 20) + +# Failure rates +failRates <- tibble::tibble( + Stratum = "All", + duration = c(4, 100), + failRate = log(2) / 12, + hr = c(1, .6), + dropoutRate = .001) + +# Study duration in months +studyDuration <- 36 + +# Experimental / Control randomization ratio +ratio <- 1 + +# 1-sided Type I error +alpha <- 0.025 +# Type II error (1 - power) +beta <- 0.1 + +# ------------------------- # +# AHR # +# ------------------------- # +# under fixed power +fixed_design( + x = "AHR", + alpha = alpha, + power = 1 - beta, + enrollRates = enrollRates, + failRates = failRates, + studyDuration = studyDuration, + ratio = ratio + ) \%>\% summary() + +# ------------------------- # +# FH # +# ------------------------- # +# under fixed power +fixed_design( + x = "FH", + alpha = alpha, + power = 1 - beta, + enrollRates = enrollRates, + failRates = failRates, + studyDuration = studyDuration, + ratio = ratio + ) \%>\% summary() + +} diff --git a/man/summary.gs_design.Rd b/man/summary.gs_design.Rd new file mode 100644 index 000000000..aeb7a90cf --- /dev/null +++ b/man/summary.gs_design.Rd @@ -0,0 +1,168 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/summary.R +\name{summary.gs_design} +\alias{summary.gs_design} +\title{This is the function to generate a R table summarizing the bounds +in the group sequential design generated by +\code{gs_design_ahr} or \code{gs_design_wlr} or \code{gs_design_combo}.} +\usage{ +\method{summary}{gs_design}( + x, + analysis_vars = NULL, + analysis_decimals = NULL, + col_vars = NULL, + col_decimals = NULL, + bound_names = c("Efficacy", "Futility"), + ... +) +} +\arguments{ +\item{x}{an object returned by \code{gs_design_ahr} or \code{gs_design_wlr} or \code{gs_design_combo}} + +\item{analysis_vars}{the variables to be put at the summary header of each analysis} + +\item{analysis_decimals}{the displayed number of digits of \code{analysis_vars}} + +\item{col_vars}{the variables to be displayed} + +\item{col_decimals}{the decimals to be displayed for the displayed variables in \code{col_vars}} + +\item{bound_names}{names for bounds; default = c("Efficacy", "Futility").} + +\item{...}{additional arguments} +} +\value{ +a summary table +} +\description{ +This is the function to generate a R table summarizing the bounds +in the group sequential design generated by +\code{gs_design_ahr} or \code{gs_design_wlr} or \code{gs_design_combo}. +} +\examples{ +# ---------------------------- # +# design parameters # +# ---------------------------- # +library(tibble) +library(gsDesign) +library(gsDesign2) +library(dplyr) + +# enrollment/failure rates +enrollRates <- tibble(Stratum = "All", + duration = 12, + rate = 1) +failRates <- tibble(Stratum = "All", duration = c(4, 100), + failRate = log(2) / 12, + hr = c(1, .6), + dropoutRate = .001) + +# Information fraction +IF <- (1:3)/3 + +# Analysis times in months; first 2 will be ignored as IF will not be achieved +analysisTimes <- c(.01, .02, 36) + +# Experimental / Control randomization ratio +ratio <- 1 + +# 1-sided Type I error +alpha <- 0.025 + +# Type II error (1 - power) +beta <- .1 + +# Upper bound +upper <- gs_spending_bound +upar <- list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL) + +# Lower bound +lower <- gs_spending_bound +lpar <- list(sf = gsDesign::sfHSD, total_spend = 0.1, param = 0, timing = NULL) + +# weight function in WLR +wgt00 <- function(x, arm0, arm1){wlr_weight_fh(x, arm0, arm1, rho = 0, gamma = 0)} +wgt05 <- function(x, arm0, arm1){wlr_weight_fh(x, arm0, arm1, rho = 0, gamma = .5)} + +# test in COMBO +fh_test <- rbind( + data.frame(rho = 0, gamma = 0, tau = -1, test = 1, Analysis = 1:3,analysisTimes = c(12, 24, 36)), + data.frame(rho = c(0, 0.5), gamma = 0.5, tau = -1, test = 2:3, Analysis = 3, analysisTimes = 36) +) + +# ---------------------------- # +# ahr # +# ---------------------------- # +x_ahr <- gs_design_ahr( + enrollRates = enrollRates, + failRates = failRates, + IF = IF, # Information fraction + analysisTimes = analysisTimes, + ratio = ratio, + alpha = alpha, + beta = beta, + upper = upper, + upar = upar, + lower = lower, + lpar = lpar) + +x_ahr \%>\% summary() +x_ahr \%>\% summary(analysis_vars = c("Time", "Events", "IF"), analysis_decimals = c(1, 0, 2)) +x_ahr \%>\% summary(bound_names = c("A is better", "B is better")) + +# ---------------------------- # +# wlr # +# ---------------------------- # +x_wlr <- gs_design_wlr( + enrollRates = enrollRates, + failRates = failRates, + weight = wgt05, + IF = NULL, + analysisTimes = sort(unique(x_ahr$analysis$Time)), + ratio = ratio, + alpha = alpha, + beta = beta, + upper = upper, + upar = upar, + lower = lower, + lpar = lpar +) +x_wlr \%>\% summary() + +# ---------------------------- # +# max combo # +# ---------------------------- # +x_combo <- gs_design_combo( + ratio = 1, + alpha = 0.025, + beta = 0.2, + enrollRates = tibble::tibble(Stratum = "All", duration = 12, rate = 500/12), + failRates = tibble::tibble(Stratum = "All", duration = c(4, 100), + failRate = log(2) / 15, hr = c(1, .6), dropoutRate = .001), + fh_test = fh_test, + upper = gs_spending_combo, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025), + lower = gs_spending_combo, + lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.2)) +x_combo \%>\% summary() + +# ---------------------------- # +# risk difference # +# ---------------------------- # +gs_design_rd( + p_c = tibble(Stratum = "All", Rate = .2), + p_e = tibble(Stratum = "All", Rate = .15), + IF = c(0.7, 1), + rd0 = 0, + alpha = .025, + beta = .1, + ratio = 1, + stratum_prev = NULL, + weight = "un-stratified", + upper = gs_b, + lower = gs_b, + upar = gsDesign::gsDesign(k = 3, test.type = 1, sfu = gsDesign::sfLDOF, sfupar = NULL)$upper$bound, + lpar = c(qnorm(.1), rep(-Inf, 2)) +) \%>\% summary() + +} diff --git a/man/tEvents.Rd b/man/tEvents.Rd index ec4e037ca..978b8d320 100644 --- a/man/tEvents.Rd +++ b/man/tEvents.Rd @@ -51,19 +51,26 @@ where the enrollment, failure and dropout rates changes over time. } \examples{ -# Example 1: default +# ------------------------# +# Example 1 # +# ------------------------# +# default tEvents() -# Example 2: check that result matches a finding using AHR() + +# ------------------------# +# Example 2 # +# ------------------------# +# check that result matches a finding using AHR() # Start by deriving an expected event count -enrollRates <- - tibble::tibble(Stratum="All", - duration=c(2,2,10), - rate=c(3,6,9)*5) -failRates=tibble::tibble(Stratum="All",duration=c(3,100),failRate=log(2)/c(9,18), - hr=c(.9,.6),dropoutRate=rep(.001,2)) +enrollRates <- tibble::tibble(Stratum = "All", duration = c(2, 2, 10), rate = c(3, 6, 9) * 5) +failRates <- tibble::tibble(Stratum = "All", duration = c(3, 100), failRate = log(2) / c(9, 18), + hr = c(.9,.6), dropoutRate = rep(.001, 2)) totalDuration <- 20 -xx <- AHR(enrollRates,failRates,totalDuration) +xx <- AHR(enrollRates, failRates, totalDuration) xx + # Next we check that the function confirms the timing of the final analysis. -tEvents(enrollRates,failRates,targetEvents=xx$Events,interval=c(.5,1.5)*xx$Time) +tEvents(enrollRates, failRates, + targetEvents = xx$Events, interval = c(.5, 1.5) * xx$Time) + } diff --git a/man/wlr_weight.Rd b/man/wlr_weight.Rd new file mode 100644 index 000000000..16268caea --- /dev/null +++ b/man/wlr_weight.Rd @@ -0,0 +1,51 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wlr_weight.R +\name{wlr_weight} +\alias{wlr_weight} +\alias{wlr_weight_fh} +\alias{wlr_weight_1} +\alias{wlr_weight_n} +\title{Weight Function of Weighted Log-rank Test} +\usage{ +wlr_weight_fh(x, arm0, arm1, rho = 0, gamma = 0, tau = NULL) + +wlr_weight_1(x, arm0, arm1) + +wlr_weight_n(x, arm0, arm1, power = 1) +} +\arguments{ +\item{x}{analysis time} + +\item{arm0}{an "arm" object defined in \code{npsurvSS} package} + +\item{arm1}{an "arm" object defined in \code{npsurvSS} package} + +\item{rho}{A scalar parameter that controls the type of test} + +\item{gamma}{A scalar parameter that controls the type of test} + +\item{tau}{A scalar parameter of the cut-off time for modest weighted log rank test} + +\item{power}{A scalar parameter that controls the power of the weight function} +} +\description{ +\itemize{ +\item \code{wlr_weight_fh} is Fleming-Harriongton, FH(rho, gamma) weight function. +\item \code{wlr_weight_1} is constant for log rank test +\item \code{wlr_weight_power} is Gehan-Breslow and Tarone-Ware weight function. +} +} +\section{Specification}{ + +\if{latex}{ + \itemize{ + \item Compute the sample size via the sum of arm sizes. + \item Compute the proportion of size in the two arms. + \item If the input tau is specified, define time up to the cut off time tau. + \item Compute the CDF using the proportion of the size in the two arms and \code{npsruvSS::psurv()}. + \item Return the Fleming-Harriongton weights for weighted Log-rank test. + } +} +\if{html}{The contents of this section are shown in PDF user manual only.} +} + diff --git a/pkgdown/favicon/apple-touch-icon-120x120.png b/pkgdown/favicon/apple-touch-icon-120x120.png deleted file mode 100644 index 837a48d4d..000000000 Binary files a/pkgdown/favicon/apple-touch-icon-120x120.png and /dev/null differ diff --git a/pkgdown/favicon/apple-touch-icon-152x152.png b/pkgdown/favicon/apple-touch-icon-152x152.png deleted file mode 100644 index 16160ff56..000000000 Binary files a/pkgdown/favicon/apple-touch-icon-152x152.png and /dev/null differ diff --git a/pkgdown/favicon/apple-touch-icon-180x180.png b/pkgdown/favicon/apple-touch-icon-180x180.png deleted file mode 100644 index b0ef01787..000000000 Binary files a/pkgdown/favicon/apple-touch-icon-180x180.png and /dev/null differ diff --git a/pkgdown/favicon/apple-touch-icon-60x60.png b/pkgdown/favicon/apple-touch-icon-60x60.png deleted file mode 100644 index dbe2e48fc..000000000 Binary files a/pkgdown/favicon/apple-touch-icon-60x60.png and /dev/null differ diff --git a/pkgdown/favicon/apple-touch-icon-76x76.png b/pkgdown/favicon/apple-touch-icon-76x76.png deleted file mode 100644 index e74788d06..000000000 Binary files a/pkgdown/favicon/apple-touch-icon-76x76.png and /dev/null differ diff --git a/pkgdown/favicon/apple-touch-icon.png b/pkgdown/favicon/apple-touch-icon.png deleted file mode 100644 index 3f39d0d81..000000000 Binary files a/pkgdown/favicon/apple-touch-icon.png and /dev/null differ diff --git a/pkgdown/favicon/favicon-16x16.png b/pkgdown/favicon/favicon-16x16.png deleted file mode 100644 index 3d79b2643..000000000 Binary files a/pkgdown/favicon/favicon-16x16.png and /dev/null differ diff --git a/pkgdown/favicon/favicon-32x32.png b/pkgdown/favicon/favicon-32x32.png deleted file mode 100644 index 1f369954c..000000000 Binary files a/pkgdown/favicon/favicon-32x32.png and /dev/null differ diff --git a/pkgdown/favicon/favicon.ico b/pkgdown/favicon/favicon.ico deleted file mode 100644 index 7377c13f6..000000000 Binary files a/pkgdown/favicon/favicon.ico and /dev/null differ diff --git a/src/.gitignore b/src/.gitignore new file mode 100644 index 000000000..779abc69e --- /dev/null +++ b/src/.gitignore @@ -0,0 +1,3 @@ +*.o +*.so +*.dll \ No newline at end of file diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp new file mode 100644 index 000000000..de1258e83 --- /dev/null +++ b/src/RcppExports.cpp @@ -0,0 +1,71 @@ +// Generated by using Rcpp::compileAttributes() -> do not edit by hand +// Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 + +#include + +using namespace Rcpp; + +#ifdef RCPP_USE_GLOBAL_ROSTREAM +Rcpp::Rostream& Rcpp::Rcout = Rcpp::Rcpp_cout_get(); +Rcpp::Rostream& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get(); +#endif + +// gridptsRcpp +List gridptsRcpp(int r, double mu, double a, double b); +RcppExport SEXP _gsDesign2_gridptsRcpp(SEXP rSEXP, SEXP muSEXP, SEXP aSEXP, SEXP bSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< int >::type r(rSEXP); + Rcpp::traits::input_parameter< double >::type mu(muSEXP); + Rcpp::traits::input_parameter< double >::type a(aSEXP); + Rcpp::traits::input_parameter< double >::type b(bSEXP); + rcpp_result_gen = Rcpp::wrap(gridptsRcpp(r, mu, a, b)); + return rcpp_result_gen; +END_RCPP +} +// h1Rcpp +List h1Rcpp(int r, double theta, double I, double a, double b); +RcppExport SEXP _gsDesign2_h1Rcpp(SEXP rSEXP, SEXP thetaSEXP, SEXP ISEXP, SEXP aSEXP, SEXP bSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< int >::type r(rSEXP); + Rcpp::traits::input_parameter< double >::type theta(thetaSEXP); + Rcpp::traits::input_parameter< double >::type I(ISEXP); + Rcpp::traits::input_parameter< double >::type a(aSEXP); + Rcpp::traits::input_parameter< double >::type b(bSEXP); + rcpp_result_gen = Rcpp::wrap(h1Rcpp(r, theta, I, a, b)); + return rcpp_result_gen; +END_RCPP +} +// hupdateRcpp +List hupdateRcpp(int r, double theta, double I, double a, double b, double thetam1, double Im1, List gm1); +RcppExport SEXP _gsDesign2_hupdateRcpp(SEXP rSEXP, SEXP thetaSEXP, SEXP ISEXP, SEXP aSEXP, SEXP bSEXP, SEXP thetam1SEXP, SEXP Im1SEXP, SEXP gm1SEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< int >::type r(rSEXP); + Rcpp::traits::input_parameter< double >::type theta(thetaSEXP); + Rcpp::traits::input_parameter< double >::type I(ISEXP); + Rcpp::traits::input_parameter< double >::type a(aSEXP); + Rcpp::traits::input_parameter< double >::type b(bSEXP); + Rcpp::traits::input_parameter< double >::type thetam1(thetam1SEXP); + Rcpp::traits::input_parameter< double >::type Im1(Im1SEXP); + Rcpp::traits::input_parameter< List >::type gm1(gm1SEXP); + rcpp_result_gen = Rcpp::wrap(hupdateRcpp(r, theta, I, a, b, thetam1, Im1, gm1)); + return rcpp_result_gen; +END_RCPP +} + +static const R_CallMethodDef CallEntries[] = { + {"_gsDesign2_gridptsRcpp", (DL_FUNC) &_gsDesign2_gridptsRcpp, 4}, + {"_gsDesign2_h1Rcpp", (DL_FUNC) &_gsDesign2_h1Rcpp, 5}, + {"_gsDesign2_hupdateRcpp", (DL_FUNC) &_gsDesign2_hupdateRcpp, 8}, + {NULL, NULL, 0} +}; + +RcppExport void R_init_gsDesign2(DllInfo *dll) { + R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); + R_useDynamicSymbols(dll, FALSE); +} diff --git a/src/gridpts_h1_hupdate.cpp b/src/gridpts_h1_hupdate.cpp new file mode 100644 index 000000000..9016ee114 --- /dev/null +++ b/src/gridpts_h1_hupdate.cpp @@ -0,0 +1,107 @@ +#include +#include +using namespace Rcpp; + +// [[Rcpp::export(".gridptsRcpp")]] +List gridptsRcpp(int r, double mu, double a, double b) +{ + + // Define odd numbered grid points for real line + NumericVector x(6*r-1); + for (int i = 0; i < r-1; i++) { + double tmp = 3 + 4 * log(r/(double)(i+1)); + x[i] = mu - tmp; + x[6*r-2-i] = mu + tmp; + } + for (int i = r-1; i <= 5*r-1; i++) { + x[i] = mu - 3 + 3 * (i - (r-1)) / (double)(2*r); + } + + // Trim points outside of [a, b] and include those points + if (min(x) < a) { + x = x[x > a]; + x.insert(x.begin(), a); + } + if (max(x) > b) { + x = x[x < b]; + x.push_back(b); + } + + // If extreme, include only 1 point where density will be essentially 0 + int m = x.size(); + if (m == 1) return List::create(Named("z") = x, Named("w") = 1); + + // Initialize output vectors + NumericVector z(2*m-1); + NumericVector w(2*m-1); + + // First two points with corresponding weights + z[0] = x[0]; + z[1] = (x[0] + x[1]) / (double)2; + w[0] = x[1] - x[0]; + w[1] = 4 * (x[1] - x[0]); + + for (int i = 2; i <= 2*m-4; i+=2) { + z[i] = x[i/2]; // odd grid points + z[i+1] = (x[i/2] + x[i/2+1]) / (double)2; // even grid points + w[i] = x[i/2+1] - x[i/2-1]; // odd weights + w[i+1] = 4 * (x[i/2+1] - x[i/2]); // even weights + } + + // Last odd point with corresponding weight + z[2*m-2] = x[m-1]; + w[2*m-2] = x[m-1] - x[m-2]; + + // Divide weights by 6 + w = w / (double)6; + + return List::create(Named("z") = z, + Named("w") = w); +} + +// [[Rcpp::export(".h1Rcpp")]] +List h1Rcpp(int r, double theta, double I, double a, double b) +{ + // compute drift at analysis 1 + double mu = theta * sqrt(I); + List g = gridptsRcpp(r, mu, a, b); + SEXP zz = g[0]; NumericVector z(zz); + SEXP ww = g[1]; NumericVector w(ww); + // compute deviation from drift + NumericVector h = w * dnorm(z - mu); + // compute standard normal density, multiply by grid weight and return + // values needed for numerical integration + + return List::create(Named("z") = z, + Named("w") = w, + Named("h") = h); +} + +// [[Rcpp::export(".hupdateRcpp")]] +List hupdateRcpp(int r, double theta, double I, double a, double b, + double thetam1, double Im1, List gm1){ + // sqrt of change in information + double rtdelta = sqrt(I - Im1); + double rtI = sqrt(I); + double rtIm1 = sqrt(Im1); + List g = gridptsRcpp(r, theta * rtI, a, b); + SEXP zz = g[0]; NumericVector z(zz); + SEXP ww = g[1]; NumericVector w(ww); + SEXP zzm1 = gm1[0]; NumericVector zm1(zzm1); + SEXP hhm1 = gm1[2]; NumericVector hm1(hhm1); + // update integration + double mu = theta * I - thetam1 * Im1; + double d = rtI / rtdelta; + NumericVector t = (zm1 * rtIm1 + mu) / rtdelta; + NumericVector h(z.size()); + NumericVector x(zm1.size()); + for(int i = 0; i < z.size(); i++){ + x = dnorm(z[i] * d - t); + h[i] = std::inner_product(hm1.begin(), hm1.end(), x.begin(), 0.0); + } + h = h * w * d; + + return List::create(Named("z") = z, + Named("w") = w, + Named("h") = h); +} diff --git a/tests/testthat.R b/tests/testthat.R index 6d3132429..56ad91129 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -1,4 +1,6 @@ library(testthat) +library(gsDesign) library(gsDesign2) +library(dplyr) -test_check("gsDesign2") +test_check("gsDesign2") \ No newline at end of file diff --git a/tests/testthat/fixtures/simulation_test_data.Rdata b/tests/testthat/fixtures/simulation_test_data.Rdata deleted file mode 100644 index 6a9686498..000000000 Binary files a/tests/testthat/fixtures/simulation_test_data.Rdata and /dev/null differ diff --git a/tests/testthat/test-developer-gs_b.R b/tests/testthat/test-developer-gs_b.R new file mode 100644 index 000000000..3a8634836 --- /dev/null +++ b/tests/testthat/test-developer-gs_b.R @@ -0,0 +1,4 @@ +test_that("Test that gs_b() returns intended values", { + expect_equal(1:3, gs_b(1:3)) + expect_equal(2, gs_b(1:3, k = 2)) +}) \ No newline at end of file diff --git a/tests/testthat/test-developer-gs_spending_bound.R b/tests/testthat/test-developer-gs_spending_bound.R new file mode 100644 index 000000000..00cd5d996 --- /dev/null +++ b/tests/testthat/test-developer-gs_spending_bound.R @@ -0,0 +1,194 @@ +test_that("gs_spending_bound() does not execute as expected", { + expect_true(is.numeric(b <- gs_spending_bound())) + expect_true(is.numeric(a <- gs_spending_bound(efficacy=FALSE))) + hgm1_0 <- h1(theta=0, I = 1, a = a, b = b) + hgm1_1 <- h1(theta=.1, I = 1, a = a, b = b) + expect_true(is.numeric(b2 <- gs_spending_bound(k = 2, theta = 0, hgm1 = hgm1_0))) + expect_true(is.numeric(a2 <- gs_spending_bound(k = 2, theta = .1, hgm1 = hgm1_1, efficacy = FALSE))) +}) + + +# Parameters used repeatedly +library(gsDesign) +library(gsDesign2) +K <- 3 +timing <- c(.45, .8, 1) +sfu <- gsDesign::sfPower +sfupar <- 4 +sfl <- gsDesign::sfHSD +sflpar <- 2 +delta <- .2 +alpha <- .02 +beta <- .15 + + +test_that("One-sided design fails to reproduce gsDesign package bounds", { + gsd <- gsDesign(test.type = 1, k = K, sfu = sfu, sfupar = sfupar, sfl = sfl, sflpar = sflpar, timing = timing, + delta = delta, alpha = alpha, beta = beta) + gsdv <- gs_design_npe(theta = delta, info = timing, beta = beta, + upper = gs_spending_bound, + upar = list(sf = sfu, total_spend = alpha, param = sfupar), + lower = gs_b, + lpar = rep(-Inf, K)) %>% filter(Bound == "Upper") + expect_equal(gsd$upper$bound, gsdv$Z, tolerance = 7e-6) + expect_equal(gsd$n.I, gsdv$info, tolerance = .001) + + # get design properties under null hypothesis (theta = 0) + gsdv0 <- gs_power_npe(theta = 0, info = gsdv$info, + upper = gs_spending_bound, + upar = list(sf = sfu, total_spend = alpha, param = sfupar), + lower = gs_b, + lpar = rep(-Inf, K)) %>% filter(Bound == "Upper") + expect_equal(gsdv0$Probability, sfu(alpha = alpha, t = timing, param = sfupar)$spend) + + # get design properties under null hypothesis (theta = 0) + expect_equal(gsdv$Probability0, sfu(alpha = alpha, t = timing, param = sfupar)$spend) + +}) + + +test_that("Two-sided symmetric design fails to reproduce gsDesign test.type=2 bounds", { + gsd <- gsDesign(test.type = 2, k = K, sfu = sfu, sfupar = sfupar, sfl = sfl, sflpar = sflpar, timing = timing, + delta = delta, alpha = alpha, beta = beta, tol = 1e-6) + gsdv <- gs_design_npe(theta = delta, info = timing, beta = beta, + theta1 = rep(0,3), # Use this for lower bound spending under null hypothesis + binding = TRUE, # Use this for 2-sided symmetric design + upper = gs_spending_bound, + upar = list(sf = sfu, total_spend = alpha, param = sfupar), + lower = gs_spending_bound, + lpar = list(sf = sfu, total_spend = alpha, param = sfupar), + tol = 1e-6) + # compare boundaries + expect_equal(gsd$upper$bound, (gsdv %>% filter(Bound == "Upper"))$Z, tolerance = 7e-6) + expect_equal(gsd$lower$bound, (gsdv %>% filter(Bound == "Lower"))$Z, tolerance = 7e-6) + + # compare statistical information + # While tolerance should not be problematic, it seems large + expect_equal(gsd$n.I, (gsdv %>% filter(Bound == "Upper"))$info, tolerance = .04) + + # compare crossing boundaries probability + expect_equal((gsdv %>% filter(Bound == "Upper"))$Probability0, sfu(alpha = alpha, t = timing, param = sfupar)$spend) + expect_equal((gsdv %>% filter(Bound == "Lower"))$Probability0, sfu(alpha = alpha, t = timing, param = sfupar)$spend) + + # get design properties under null hypothesis (theta = 0) + gsdv0 <- gs_power_npe(theta = 0, info = (gsdv %>% filter(Bound == "Upper"))$info, + upper = gs_spending_bound, + upar = list(sf = sfu, total_spend = alpha, param = sfupar), + lower = gs_spending_bound, + lpar = list(sf = sfu, total_spend = alpha, param = sfupar)) + + expect_equal((gsdv0 %>% filter(Bound == "Upper"))$Probability, sfu(alpha = alpha, t = timing, param = sfupar)$spend) + +}) + +test_that("Two-sided asymmetric design fails to reproduce gsDesign test.type=3 bounds", { + gsd <- gsDesign(test.type = 3, k = K, sfu = sfu, sfupar = sfupar, sfl = sfl, sflpar = sflpar, timing = timing, + delta = delta, alpha = alpha, beta = beta) + + gsdv <- gs_design_npe(theta = delta, info = timing, beta = beta, + binding = TRUE, # Use this for test.type=3 and 5 + upper = gs_spending_bound, + upar = list(sf = sfu, total_spend = alpha, param = sfupar), + lower = gs_spending_bound, + lpar = list(sf = sfl, total_spend = beta, param = sflpar)) + + expect_equal(gsd$upper$bound, (gsdv %>% filter(Bound == "Upper"))$Z, tolerance = 7e-6) + expect_equal(gsd$lower$bound, (gsdv %>% filter(Bound == "Lower"))$Z, tolerance = 9e-6) + expect_equal(gsd$n.I, (gsdv %>% filter(Bound == "Upper"))$info, tolerance = .04) # While tolerance should not be problematic, it seems large + + # get design properties under null hypothesis (theta = 0) + gsdv0 <- gs_power_npe(theta = 0, info = (gsdv %>% filter(Bound == "Upper"))$info, + upper = gs_spending_bound, + upar = list(sf = sfu, total_spend = alpha, param = sfupar), + lower = gs_spending_bound, + lpar = list(sf = sfu, total_spend = alpha, param = sfupar)) + expect_equal((gsdv0 %>% filter(Bound == "Upper"))$Probability, sfu(alpha = alpha, t = timing, param = sfupar)$spend) + + # get design properties under null hypothesis (theta = 0) + expect_equal((gsdv %>% filter(Bound == "Upper"))$Probability0, sfu(alpha = alpha, t = timing, param = sfupar)$spend) + +}) + +test_that("Two-sided asymmetric design fails to reproduce gsDesign test.type=4 bounds", { + gsd <- gsDesign(test.type = 4, k = K, sfu = sfu, sfupar = sfupar, sfl = sfl, sflpar = sflpar, timing = timing, + delta = delta, alpha = alpha, beta = beta) + gsdv <- gs_design_npe(theta = delta, info = timing, beta = beta, + binding = FALSE, # Use this for test.type=4 and 6 + upper = gs_spending_bound, + upar = list(sf = sfu, total_spend = alpha, param = sfupar), + lower = gs_spending_bound, + lpar = list(sf = sfl, total_spend = beta, param = sflpar)) + + expect_equal(gsd$upper$bound, (gsdv %>% filter(Bound == "Upper"))$Z, tolerance = 7e-6) + expect_equal(gsd$lower$bound, (gsdv %>% filter(Bound == "Lower"))$Z, tolerance = 9e-6) + expect_equal(gsd$n.I, (gsdv %>% filter(Bound == "Upper"))$info, tolerance = .04) # While tolerance should not be problematic, it seems large + + # get design properties under null hypothesis (theta = 0) + gsdv0 <- gs_power_npe(theta = 0, info = (gsdv %>% filter(Bound == "Upper"))$info, + upper = gs_spending_bound, + upar = list(sf = sfu, total_spend = alpha, param = sfupar), + lower = gs_b, + lpar = rep(-Inf, K)) %>% filter(Bound == "Upper") + expect_equal(gsdv0$Probability, sfu(alpha = alpha, t = timing, param = sfupar)$spend) + + # get design properties under null hypothesis (theta = 0) + #expect_equal((gsdv %>% filter(Bound == "Upper"))$Probability0, sfu(alpha = alpha, t = timing, param = sfupar)$spend) + +}) + + +test_that("Two-sided asymmetric design fails to reproduce gsDesign test.type=5 bounds", { + astar <- 0.2 + gsd <- gsDesign(test.type = 5, k = K, sfu = sfu, sfupar = sfupar, sfl = sfl, sflpar = sflpar, timing = timing, + delta = delta, alpha = alpha, beta = beta, astar = astar) + gsdv <- gs_design_npe(theta = delta, info = timing, beta = beta, + theta1 = 0, # Spending for lower bound under H0 + binding = TRUE, # Use this for test.type=3 and 5 + upper = gs_spending_bound, + upar = list(sf = sfu, total_spend = alpha, param = sfupar), + lower = gs_spending_bound, + lpar = list(sf = sfl, total_spend = astar, param = sflpar)) + + expect_equal(gsd$upper$bound, (gsdv %>% filter(Bound == "Upper"))$Z, tolerance = 7e-6) + expect_equal(gsd$lower$bound, (gsdv %>% filter(Bound == "Lower"))$Z, tolerance = 9e-6) + expect_equal(gsd$n.I, (gsdv %>% filter(Bound == "Upper"))$info, tolerance = .04) # While tolerance should not be problematic, it seems large + # get design properties under null hypothesis (theta = 0) + gsdv0 <- gs_power_npe(theta = 0, info = (gsdv %>% filter(Bound == "Upper"))$info, + upper = gs_spending_bound, + upar = list(sf = sfu, total_spend = alpha, param = sfupar), + lower = gs_spending_bound, + lpar = list(sf = sfu, total_spend = alpha, param = sfupar)) + expect_equal((gsdv0 %>% filter(Bound == "Upper"))$Probability, sfu(alpha = alpha, t = timing, param = sfupar)$spend) + + # get design properties under null hypothesis (theta = 0) + expect_equal((gsdv %>% filter(Bound == "Upper"))$Probability0, sfu(alpha = alpha, t = timing, param = sfupar)$spend) + +}) + +test_that("Two-sided asymmetric design fails to reproduce gsDesign test.type=6 bounds", { + astar <- 0.2 + gsd <- gsDesign(test.type = 6, k = K, sfu = sfu, sfupar = sfupar, sfl = sfl, sflpar = sflpar, timing = timing, + delta = delta, alpha = alpha, beta = beta, astar = astar) + gsdv <- gs_design_npe(theta = delta, info = timing, beta = beta, + theta1 = 0, # Spending for lower bound under H0 + binding = FALSE, # Use this for test.type=3 and 5 + upper = gs_spending_bound, + upar = list(sf = sfu, total_spend = alpha, param = sfupar), + lower = gs_spending_bound, + lpar = list(sf = sfl, total_spend = astar, param = sflpar)) + + expect_equal(gsd$upper$bound, (gsdv %>% filter(Bound == "Upper"))$Z, tolerance = 7e-6) + expect_equal(gsd$lower$bound, (gsdv %>% filter(Bound == "Lower"))$Z, tolerance = 9e-6) + expect_equal(gsd$n.I, (gsdv %>% filter(Bound == "Upper"))$info, tolerance = .04) # While tolerance should not be problematic, it seems large + # get design properties under null hypothesis (theta = 0) + gsdv0 <- gs_power_npe(theta = 0, info = (gsdv %>% filter(Bound == "Upper"))$info, + upper = gs_spending_bound, + upar = list(sf = sfu, total_spend = alpha, param = sfupar), + lower = gs_spending_bound, + lpar = list(sf = sfu, total_spend = alpha, param = sfupar)) + expect_equal((gsdv0 %>% filter(Bound == "Upper"))$Probability, sfu(alpha = alpha, t = timing, param = sfupar)$spend) + + # get design properties under null hypothesis (theta = 0) + expect_equal((gsdv %>% filter(Bound == "Upper"))$Probability0, sfu(alpha = alpha, t = timing, param = sfupar)$spend, tolerance = 1e-3) + +}) \ No newline at end of file diff --git a/tests/testthat/test-double_programming_AHR.R b/tests/testthat/test-double_programming_AHR.R deleted file mode 100644 index 4732b851c..000000000 --- a/tests/testthat/test-double_programming_AHR.R +++ /dev/null @@ -1,207 +0,0 @@ -test_AHR <- function(enrollRates = tibble::tibble(Stratum = "All", duration = c(2, 2, 10), rate = c(3, 6, 9)), - failRates = tibble::tibble(Stratum = "All",duration = c(3, 100), failRate = log(2)/c(9, 18), - hr = c(0.9, 0.6), dropoutRate = rep(0.001, 2)), - totalDuration = 30, - ratio = 1, - simple = TRUE){ - - Bystratum <- NULL - AHR_allstrata <- NULL - for (Omega in unique(totalDuration)){ - bystratum <- NULL - ahr_allstrata <- NULL - for (stratum in unique(enrollRates$Stratum)){ - enrollRates.e <- enrollRates.c <- enrollRates[enrollRates$Stratum==stratum,] - enrollRates.e$rate <- enrollRates.e$rate*ratio/(1+ratio) - enrollRates.c$rate <- enrollRates.c$rate/(1+ratio) - - failRates.c <- failRates.e <- failRates[failRates$Stratum==stratum,] - failRates.e$failRate <- failRates.e$failRate*failRates.e$hr - - Events.e <- eEvents_df(enrollRates = enrollRates.e, failRates = failRates.e, totalDuration = Omega, simple = FALSE) - Events.c <- eEvents_df(enrollRates = enrollRates.c, failRates = failRates.c, totalDuration = Omega, simple = FALSE) - - names(Events.e)[2:3] <- c('failRate.e','Events.e') - names(Events.c)[2:3] <- c('failRate.c','Events.c') - Events <- cbind(Events.e[,1:3],Events.c[,2:3]) - Events$lnhr <- log(Events$failRate.e/Events$failRate.c) - Events$Events <- Events$Events.e + Events$Events.c - - ahr <- tibble::tibble(Stratum=stratum, - Time=Omega, - avehr=sum(Events$lnhr*Events$Events)/sum(Events$Events), - info=sum(1/(1/Events$Events.e+1/Events$Events.c)), - info0=sum(Events$Events*ratio/(1+ratio)^2), - Events=sum(Events$Events)) - - ahr_allstrata <- rbind(ahr_allstrata, ahr) - - bystratum <- tibble::tibble(Time=Omega, - Stratum=stratum, - t=Events$t, - HR=failRates[failRates$Stratum==stratum,]$hr, - info=1/(1/Events$Events.e+1/Events$Events.c), - info0=Events$Events*ratio/(1+ratio)^2, - Events=Events$Events) - bystratum <- bystratum %>% dplyr::relocate(Events, .before = info) - - Bystratum <- rbind(Bystratum, bystratum) - } - AHR_allstrata <- rbind(AHR_allstrata, tibble::tibble(Time=ahr_allstrata$Time, - AHR=exp(sum(ahr_allstrata$avehr*ahr_allstrata$Events)/sum(ahr_allstrata$Events)), - Events=sum(ahr_allstrata$Events), - info=sum(ahr_allstrata$info), - info0=sum(ahr_allstrata$info0))[1,]) - } - - if (simple==FALSE){ - return(Bystratum) - } else { - return(AHR_allstrata) - } -} - -# Test 1: for the situation of single stratum and single cutoff #### - - -testthat::test_that("Validation passed for the situation of single stratum and single cutoff",{ - enrollRates <- tibble::tibble(Stratum = "All", - duration = c(2, 2, 10), - rate = c(3, 6, 9)) - failRates <- tibble::tibble(Stratum = "All", - duration = c(3, Inf), - failRate = log(2)/c(9, 18), - hr = c(0.9, 0.6), - dropoutRate = rep(0.001, 2)) - totalDuration <- 30 - ratio <- 1 - testthat::expect_equal(data.frame(test_AHR(enrollRates = enrollRates, - failRates = failRates, - totalDuration = totalDuration, - ratio = ratio, - simple = TRUE)), - data.frame(AHR(enrollRates = enrollRates, - failRates = failRates, - totalDuration = totalDuration, - ratio = ratio, - simple = TRUE))) - - testthat::expect_equal(data.frame(test_AHR(enrollRates = enrollRates, - failRates = failRates, - totalDuration = totalDuration, - ratio = ratio, - simple = FALSE)), - data.frame(AHR(enrollRates = enrollRates, - failRates = failRates, - totalDuration = totalDuration, - ratio = ratio, - simple = FALSE))) -}) - -# Test 2: for the situation of single stratum and multiple cutoffs #### - -testthat::test_that("Validation passed for the situation of single stratum and multiple cutoffs",{ - enrollRates <- tibble::tibble(Stratum = "All", - duration = c(2, 2, 10), - rate = c(3, 6, 9)) - failRates <- tibble::tibble(Stratum = "All", - duration = c(3, Inf), - failRate = log(2)/c(9, 18), - hr = c(0.9, 0.6), - dropoutRate = rep(0.001, 2)) - totalDuration <- c(15, 30) - ratio <- 1 - - testthat::expect_equal(data.frame(test_AHR(enrollRates = enrollRates, - failRates = failRates, - totalDuration = totalDuration, - ratio = ratio, - simple = TRUE)), - data.frame(AHR(enrollRates = enrollRates, - failRates = failRates, - totalDuration = totalDuration, - ratio = ratio, - simple = TRUE))) - testthat::expect_equal(data.frame(test_AHR(enrollRates = enrollRates, - failRates = failRates, - totalDuration = totalDuration, - ratio = ratio, - simple = FALSE)), - data.frame(AHR(enrollRates = enrollRates, - failRates = failRates, - totalDuration = totalDuration, - ratio = ratio, - simple = FALSE))) -}) - -# Test 3: for the situation of multiple strata and single cutoff #### - -testthat::test_that("Validation passed for the situation of multiple strata and single cutoff",{ - enrollRates <- tibble::tibble(Stratum = c(rep("High",3), rep("Low",3)), - duration = c(2, 2, 10, 3, 3, 6), - rate = c(3, 6, 9, 2, 3, 4)) - failRates <- tibble::tibble(Stratum = c(rep("High",2), rep("Low",2)), - duration = c(3, Inf, 5, Inf), - failRate = c(log(2)/c(9, 18), log(2)/c(12, 25)), - hr = c(0.9, 0.6, 1, 0.8), - dropoutRate = rep(0.001, 4)) - totalDuration <- 30 - ratio <- 1 - testthat::expect_equal(data.frame(test_AHR(enrollRates = enrollRates, - failRates = failRates, - totalDuration = totalDuration, - ratio = ratio, - simple = TRUE)), - data.frame(AHR(enrollRates = enrollRates, - failRates = failRates, - totalDuration = totalDuration, - ratio = ratio, - simple = TRUE))) - testthat::expect_equal(data.frame(test_AHR(enrollRates = enrollRates, - failRates = failRates, - totalDuration = totalDuration, - ratio = ratio, - simple = FALSE)), - data.frame(AHR(enrollRates = enrollRates, - failRates = failRates, - totalDuration = totalDuration, - ratio = ratio, - simple = FALSE))) -}) - -# Test 4: for the situation of multiple strata and multiple cutoffs #### - -testthat::test_that("Validation passed for the situation of multiple strata and multiple cutoffs",{ - enrollRates <- tibble::tibble(Stratum = c(rep("High",3), rep("Low",3)), - duration = c(2, 2, 10, 3, 3, 6), - rate = c(3, 6, 9, 2, 3, 4)) - failRates <- tibble::tibble(Stratum = c(rep("High",2), rep("Low",2)), - duration = c(3, Inf, 5, Inf), - failRate = c(log(2)/c(9, 18), log(2)/c(12, 25)), - hr = c(0.9, 0.6, 1, 0.8), - dropoutRate = rep(0.001, 4)) - totalDuration <- c(15, 30) - ratio <- 1 - - testthat::expect_equal(data.frame(test_AHR(enrollRates = enrollRates, - failRates = failRates, - totalDuration = totalDuration, - ratio = ratio, - simple = TRUE)), - data.frame(AHR(enrollRates = enrollRates, - failRates = failRates, - totalDuration = totalDuration, - ratio = ratio, - simple = TRUE))) - testthat::expect_equal(data.frame(test_AHR(enrollRates = enrollRates, - failRates = failRates, - totalDuration = totalDuration, - ratio = ratio, - simple = FALSE)), - data.frame(AHR(enrollRates = enrollRates, - failRates = failRates, - totalDuration = totalDuration, - ratio = ratio, - simple = FALSE))) -}) - diff --git a/tests/testthat/test-double_programming_ppwe.R b/tests/testthat/test-double_programming_ppwe.R deleted file mode 100644 index 6525edee9..000000000 --- a/tests/testthat/test-double_programming_ppwe.R +++ /dev/null @@ -1,217 +0,0 @@ -test_ppwe = function(x = 0:20, - failRates = tibble::tibble(duration = c(3, 100), rate = log(2) / c(9, 18)), - lower.tail = FALSE) { - boundary = cumsum(failRates$duration) - rate = failRates$rate - xvals = unique(c(x, boundary)) - H <- numeric(length(xvals)) - maxlen=sum(failRates$duration) - max.x=max(x) - - if (length(x)<=maxlen){ - for (t in 1:length(xvals)) { - val = xvals[t] - if (val <= boundary[1]) { - H[t] = val * rate[1] - } - else if (val <= boundary[2]) { - H[t] = boundary[1] * rate[1] + (val - boundary[1]) * rate[2] - } - else { - H[t] = boundary[1] * rate[1] + (boundary[2] - boundary[1]) * rate[2] - } - } - surv = exp(-H) - } else{ - boundary1=boundary - boundary1[2]<-max.x - for (t in 1:length(xvals)) { - val = xvals[t] - if (val <= boundary1[1]) { - H[t] = val * rate[1] - } - else if (val <= boundary1[2]) { - H[t] = boundary1[1] * rate[1] + (val - boundary1[1]) * rate[2] - } - else { - H[t] = boundary1[1] * rate[1] + (boundary1[2] - boundary1[1]) * rate[2] - } - } - surv = exp(-H) - } - - ind <- !is.na(match(xvals, x)) - - if (lower.tail) { - return(1 - surv[ind]) - } else{ - return(surv[ind]) - } -} - -# Double programming of ppwe when there are 3 steps of failure rates. -#The method is a simple extention of test_ppwe. -test_2_ppwe = function(x = 0:20, - failRates = tibble::tibble(duration = c(3, 20, 100), - rate = log(2) / c(9, 12, 18)), - lower.tail = FALSE) { - boundary = cumsum(failRates$duration) - rate = failRates$rate - xvals = unique(c(x, boundary)) - H <- numeric(length(xvals)) - for (t in 1:length(xvals)) { - val = xvals[t] - if (val <= boundary[1]) { - H[t] = val * rate[1] - } - else if (val <= boundary[2]) { - H[t] = boundary[1] * rate[1] + (val - boundary[1]) * rate[2] - } - else if (val <= boundary[3]) { - H[t] = boundary[1] * rate[1] + (boundary[2] - boundary[1]) * rate[2] + (val - - boundary[3]) * rate[3] - } - else { - H[t] = boundary[1] * rate[1] + (boundary[2] - boundary[1]) * rate[2] + (boundary[3] - - boundary[2]) * rate[3] - } - } - surv = exp(-H) - - ind <- !is.na(match(xvals, x)) - - if (lower.tail) { - return(1 - surv[ind]) - } else{ - return(surv[ind]) - } -} - - - -testthat::test_that("ppwe is incorrect when there are 2-step fail rates", { - testthat::expect_equal( - ppwe(x = 0:20, - failRates = tibble::tibble(duration = c(13, 100), rate = log(12) / c(9, 18)), - lower.tail = FALSE), - test_ppwe(x = 0:20, - failRates = tibble::tibble(duration = c(13, 100), rate = log(12) / c(9, 18)), - lower.tail = FALSE)) -}) - -testthat::test_that("ppwe is incorrect if varable x is longer than the max duration of fail rates", { - testthat::expect_equal( - ppwe(x = 0:80, - failRates = tibble::tibble(duration = c(13, 50), rate = log(4) / c(19, 9)), - lower.tail = FALSE), - test_ppwe(x = 0:80, - failRates = tibble::tibble(duration = c(13, 50), rate = log(4) / c(19, 9)), - lower.tail = FALSE)) -}) - - -testthat::test_that("ppwe is incorrect when there are 3-step fail rates", { - testthat::expect_equal( - ppwe(x = 0:20, - failRates = tibble::tibble(duration = c(3, 20, 100), rate = log(12) / c(9, 12, 18)), - lower.tail = FALSE), - test_2_ppwe(x = 0:20, - failRates = tibble::tibble(duration = c(3, 20, 100), rate = log(12) / c(9, 12, 18)), - lower.tail = FALSE)) -}) - - -## add the following test case - - - -testthat::test_that("ppwe fail to identify a non-numerical input",{ - x=c(0:20, "NA") - expect_error(expect_message(ppwe(x=x), "gsDesign2: x in `ppwe()` must be a strictly increasing non-negative numeric vector")) - -}) - -testthat::test_that("ppwe fail to identify a negative input",{ - x=-20:-1 - expect_error(expect_message(ppwe(x=x), "gsDesign2: x in `ppwe()` must be a strictly increasing non-negative numeric vector")) - -}) - - -testthat::test_that("ppwe fail to identify a non-increasing input",{ - x=20:1 - expect_error(expect_message(ppwe(x=x), "gsDesign2: x in `ppwe()` must be a strictly increasing non-negative numeric vector")) - -}) - -testthat::test_that("ppwe fail to identify a non-dataframe input",{ - failRates=as.matrix(tibble::tibble(duration = c(13, 100), rate = log(12) / c(9, 18))) - expect_error(expect_message(ppwe(failRates = failRates), "gsDesign2: failRates in `ppwe()` must be a data.frame")) -}) - - -testthat::test_that("ppwe fail to identify duration input",{ - failRates=tibble::tibble(Times = c(13, 100), rate = log(12) / c(9, 18)) - expect_error(expect_message(ppwe(failRates = failRates), "gsDesign2: failRates in `ppwe()` column names must contain duration")) -}) - - -testthat::test_that("ppwe fail to identify rates input",{ - failRates=tibble::tibble(duration = c(13, 100), freqs = log(12) / c(9, 18)) - expect_error(expect_message(ppwe(failRates = failRates), "gsDesign2: failRates in `ppwe()` column names must contain rate")) -}) - -testthat::test_that("ppwe fail to identify lower.tail input",{ - lower.tail=123 - expect_error(expect_message(ppwe(lower.tail = lower.tail), "gsDesign2: lower.tail in `ppwe()` must be logical")) -}) - - -## add the following test case - - - -testthat::test_that("ppwe fail to identify a non-numerical input",{ - x=c(0:20, "NA") - expect_error(expect_message(ppwe(x=x), "gsDesign2: x in `ppwe()` must be a strictly increasing non-negative numeric vector")) - -}) - -testthat::test_that("ppwe fail to identify a negative input",{ - x=-20:-1 - expect_error(expect_message(ppwe(x=x), "gsDesign2: x in `ppwe()` must be a strictly increasing non-negative numeric vector")) - -}) - - -testthat::test_that("ppwe fail to identify a non-increasing input",{ - x=20:1 - expect_error(expect_message(ppwe(x=x), "gsDesign2: x in `ppwe()` must be a strictly increasing non-negative numeric vector")) - -}) - -testthat::test_that("ppwe fail to identify a non-dataframe input",{ - failRates=as.matrix(tibble::tibble(duration = c(13, 100), rate = log(12) / c(9, 18))) - expect_error(expect_message(ppwe(failRates = failRates), "gsDesign2: failRates in `ppwe()` must be a data.frame")) -}) - - -testthat::test_that("ppwe fail to identify duration input",{ - failRates=tibble::tibble(Times = c(13, 100), rate = log(12) / c(9, 18)) - expect_error(expect_message(ppwe(failRates = failRates), "gsDesign2: failRates in `ppwe()` column names must contain duration")) -}) - - -testthat::test_that("ppwe fail to identify rates input",{ - failRates=tibble::tibble(duration = c(13, 100), freqs = log(12) / c(9, 18)) - expect_error(expect_message(ppwe(failRates = failRates), "gsDesign2: failRates in `ppwe()` column names must contain rate")) -}) - -testthat::test_that("ppwe fail to identify lower.tail input",{ - lower.tail=123 - expect_error(expect_message(ppwe(lower.tail = lower.tail), "gsDesign2: lower.tail in `ppwe()` must be logical")) -}) - - - - diff --git a/tests/testthat/test-eEvents_df.R b/tests/testthat/test-eEvents_df.R deleted file mode 100644 index 9ecdeae96..000000000 --- a/tests/testthat/test-eEvents_df.R +++ /dev/null @@ -1,23 +0,0 @@ - -testthat::test_that("expected events is different from gsDesign::eEvents and eEvents_df",{ - enrollRates <- tibble::tibble(duration=c(2,1,2),rate=c(5,10,20)) - failRates <- tibble::tibble(duration=c(1,1,1),failRate=c(.05,.02,.01),dropoutRate=.01) - totalDuration <- 20 - testthat::expect_equal(gsDesign2::eEvents_df(enrollRates,failRates,totalDuration,simple=TRUE), - gsDesign::eEvents(lambda=failRates$failRate,S=failRates$duration[1:(nrow(failRates)-1)], - eta=failRates$dropoutRate,gamma=enrollRates$rate, - R=enrollRates$duration,T=totalDuration)$d - ) -}) -testthat::test_that("data frame returned from eEvents_df not as expected",{ - # test case from gsSurvNPH - enrollRates <-tibble::tibble(duration=c(1,1,8),rate=c(3,2,0)) - failRates <- tibble::tibble(duration=c(4,Inf),failRate=c(.03,.06),dropoutRate=c(.001,.002)) - totalDuration <- 7 - xx <- gsDesign2::eEvents_df(enrollRates,failRates,totalDuration,simple=FALSE) %>% data.frame() - # expected checked with alternate calculations in gsSurvNPH vignette - expected <- data.frame(t=c(0,4), - failRate=c(0.03,0.06), - Events=c(0.5642911, 0.5194821)) - testthat::expect_equal(xx,expected) -}) diff --git a/tests/testthat/test-independent-check_arg.R b/tests/testthat/test-independent-check_arg.R new file mode 100644 index 000000000..8dd8abc18 --- /dev/null +++ b/tests/testthat/test-independent-check_arg.R @@ -0,0 +1,104 @@ +test_that("check enrollments",{ + expect_error(gsDesign2:::check_enrollRates(tibble::tibble(rate = c(2, 4)))) + expect_error(gsDesign2:::check_enrollRates(tibble::tibble(duration = c(10, 20), rate = c("a", "b")))) + expect_error(gsDesign2:::check_enrollRates(tibble::tibble(duration = c(10, 20), rate = c(2, -4)))) + + expect_error(gsDesign2:::check_enrollRates(tibble::tibble(duration = c(10, 20)))) + expect_error(gsDesign2:::check_enrollRates(tibble::tibble(rate = c(2, 4), duration = c("a", "b")))) + expect_error(gsDesign2:::check_enrollRates(tibble::tibble(rate = c(2, 4), duration = c(10, -20)))) +}) + +test_that("check failRates",{ + # lack duration + expect_error(gsDesign2:::check_failRates(tibble::tibble(failRates = c(0.2, 0.4), dropoutRates = 0.01))) + # lack failRates + expect_error(gsDesign2:::check_failRates(tibble::tibble(duration = c(2, 4), dropoutRates = 0.01))) + # lack dropoutRates + expect_error(gsDesign2:::check_failRates(tibble::tibble(failRates = c(0.2, 0.4), duration = c(10, 20)))) + + # check of column `duration` + expect_error(gsDesign2:::check_failRates(tibble::tibble(failRates = c(2, 4), duration = c("a", "b"), dropoutRates = 0.01))) + expect_error(gsDesign2:::check_failRates(tibble::tibble(failRates = c(2, 4), duration = c(10, -20), dropoutRates = 0.01))) + + #check of column `failRates` + expect_error(gsDesign2:::check_failRates(tibble::tibble(duration = c(10, 20), failRates = c("a", "b"), dropoutRates = 0.01))) + expect_error(gsDesign2:::check_failRates(tibble::tibble(duration = c(10, 20), failRates = c(2, -4), dropoutRates = 0.01))) + + #check of column `hr` + expect_error(gsDesign2:::check_failRates(tibble::tibble(duration = c(10, 20), failRates = c(0.02, 0.04), dropoutRates = 0.01, hr = "a"))) + expect_error(gsDesign2:::check_failRates(tibble::tibble(duration = c(10, 20), failRates = c(2, -4), dropoutRates = 0.01, hr = -1))) + + #check of column `dropoutRate` + expect_error(gsDesign2:::check_failRates(tibble::tibble(duration = c(10, 20), failRates = c(0.02, 0.04), dropoutRates = "a", hr = 0.6))) + expect_error(gsDesign2:::check_failRates(tibble::tibble(duration = c(10, 20), failRates = c(2, -4), dropoutRates = -1, hr = 0.6))) +}) + +test_that("check enrollments and failRates together",{ + expect_error(gsDesign2:::check_enrollRates_failRates(enrollRates = tibble::tibble(duration = c(10, 20), + rate = c(2, 4), + Stratum = "All"), + failRates = tibble::tibble(duration = c(10, 20), + failRates = c(0.02, 0.04), + dropoutRates = 0.001, + hr = 0.6, + Stratum = c("S1", "S2")))) + +}) + +test_that("check analysisTimes",{ + expect_error(gsDesign2:::check_analysisTimes("a")) + expect_error(gsDesign2:::check_analysisTimes(c(20, 10))) +}) + +test_that("check events",{ + expect_error(gsDesign2:::check_events("a")) + expect_error(gsDesign2:::check_events(c(20, 10))) +}) + +testthat::test_that("check totalDuration",{ + expect_error(gsDesign2:::check_totalDuration("a")) + expect_error(gsDesign2:::check_totalDuration(c(-10, 10))) +}) + +test_that("check ratio",{ + expect_error(gsDesign2:::check_ratio("a")) + expect_error(gsDesign2:::check_ratio(-2)) +}) + +test_that("check info",{ + expect_error(gsDesign2:::check_info(c("a", "b"))) + expect_error(gsDesign2:::check_info(c(20, 10))) +}) + +test_that("check theta",{ + expect_error(gsDesign2:::check_theta(c("a", "b"), K = 2)) + expect_error(gsDesign2:::check_theta(c(20, 10), K = 1)) + expect_error(gsDesign2:::check_theta(c(20, -10), K = 2)) +}) + +test_that("check test_upper",{ + expect_error(gsDesign2:::check_test_upper(c("a", "b"), K = 2)) + expect_error(gsDesign2:::check_test_upper(c(TRUE, FALSE, FALSE), K = 1)) + expect_error(gsDesign2:::check_test_upper(c(TRUE, FALSE), K = 2)) +}) + +test_that("check test_lower",{ + expect_error(gsDesign2:::check_test_lower(c("a", "b"), K = 2)) + expect_error(gsDesign2:::check_test_lower(c(TRUE, FALSE, FALSE), K = 1)) +}) + +test_that("check check_alpha_beta",{ + expect_error(gsDesign2:::check_alpha_beta(alpha = "a", beta = 0.2)) + expect_error(gsDesign2:::check_alpha_beta(alpha = 0.025, beta = "b")) + expect_error(gsDesign2:::check_alpha_beta(alpha = c(0.025, 0.05), beta = 0.2)) + expect_error(gsDesign2:::check_alpha_beta(alpha = 0.025, beta = c(0.2, 0.3))) + expect_error(gsDesign2:::check_alpha_beta(alpha = -1, beta = 0.1)) + expect_error(gsDesign2:::check_alpha_beta(alpha = 0.025, beta = -0.1)) + expect_error(gsDesign2:::check_alpha_beta(alpha = 0.5, beta = 0.6)) +}) + +test_that("check check_IF",{ + expect_error(gsDesign2:::check_IF(c("a", "b"))) + expect_error(gsDesign2:::check_IF(c(2/3, 1/3, 1))) + expect_error(gsDesign2:::check_IF(c(2/3, 3/4))) +}) diff --git a/tests/testthat/test-double_programming_eAccural.R b/tests/testthat/test-independent-eAccrual.R similarity index 69% rename from tests/testthat/test-double_programming_eAccural.R rename to tests/testthat/test-independent-eAccrual.R index a7af1e444..c2097523b 100644 --- a/tests/testthat/test-double_programming_eAccural.R +++ b/tests/testthat/test-independent-eAccrual.R @@ -50,20 +50,20 @@ testthat::test_that("eAccrual doesn't match with the double programming e_Acurra testthat::test_that("eAccrual fail to identify a non-numerical input",{ x=c(0:20, "NA") expect_error(expect_message(eAccrual(x=x), "gsDesign2: x in `eAccrual()` must be a strictly increasing non-negative numeric vector")) - + }) testthat::test_that("eAccrual fail to identify a negative input",{ x=-20:-1 expect_error(expect_message(eAccrual(x=x), "gsDesign2: x in `eAccrual()` must be a strictly increasing non-negative numeric vector")) - + }) testthat::test_that("eAccrual fail to identify a non-increasing input",{ x=20:1 expect_error(expect_message(eAccrual(x=x), "gsDesign2: x in `eAccrual()` must be a strictly increasing non-negative numeric vector")) - + }) @@ -97,3 +97,40 @@ testthat::test_that("eAccrual fail to identify a non-dataframe input",{ enrollRates=tibble::tibble(duration=c(3,3,18), rate=c(-15,-10,-2)) expect_error(expect_message(eAccrual(enrollRates = enrollRates), "gsDesign2: enrollRates in `eAccrual()` must be non-negative with at least one positive rate")) }) + +## add test cases for stratified design +testthat::test_that("eAccrual fail to identify a non-dataframe input",{ + x <- eAccrual(x = 40, enrollRates = tibble(Stratum = c("S1", "S2"), + duration = 33, + rate = c(30, 30))) + expect_equal(x, 33*30*2) +}) + +testthat::test_that("eAccrual fail to identify a non-dataframe input",{ + x <- eAccrual(x = 33, enrollRates = tibble(Stratum = c("S1", "S2"), + duration = 33, + rate = c(30, 30))) + expect_equal(x, 33*30*2) +}) + +testthat::test_that("eAccrual fail to identify a non-dataframe input",{ + x <- eAccrual(x = 30, enrollRates = tibble(Stratum = c("S1", "S2"), + duration = 33, + rate = c(30, 30))) + expect_equal(x, 30*30*2) +}) + +testthat::test_that("eAccrual fail to identify a non-dataframe input",{ + x <- eAccrual(x = 10, enrollRates = tibble(Stratum = c("S1", "S2"), + duration = 33, + rate = c(30, 30))) + expect_equal(x, 10*30*2) +}) + +testthat::test_that("eAccrual fail to identify a non-dataframe input",{ + x <- eAccrual(x = c(5, 10, 20, 33, 50), enrollRates = tibble(Stratum = c("S1", "S2"), + duration = 33, + rate = c(30, 30))) + expect_equal(x, c(5, 10, 20, 33, 33) * 30 * 2) +}) + diff --git a/tests/testthat/test-double_programming_eEvents_df.R b/tests/testthat/test-independent-eEvents_df.R similarity index 71% rename from tests/testthat/test-double_programming_eEvents_df.R rename to tests/testthat/test-independent-eEvents_df.R index d47e05947..876b22a57 100644 --- a/tests/testthat/test-double_programming_eEvents_df.R +++ b/tests/testthat/test-independent-eEvents_df.R @@ -1,3 +1,28 @@ +test_that("expected events is different from gsDesign::eEvents and eEvents_df",{ + enrollRates <- tibble::tibble(duration=c(2,1,2),rate=c(5,10,20)) + failRates <- tibble::tibble(duration=c(1,1,1),failRate=c(.05,.02,.01),dropoutRate=.01) + totalDuration <- 20 + testthat::expect_equal(gsDesign2::eEvents_df(enrollRates,failRates,totalDuration,simple=TRUE), + gsDesign::eEvents(lambda=failRates$failRate,S=failRates$duration[1:(nrow(failRates)-1)], + eta=failRates$dropoutRate,gamma=enrollRates$rate, + R=enrollRates$duration,T=totalDuration)$d, + ignore_attr = TRUE) +}) + +test_that("data frame returned from eEvents_df not as expected",{ + # test case from gsSurvNPH + enrollRates <-tibble::tibble(duration=c(1,1,8),rate=c(3,2,0)) + failRates <- tibble::tibble(duration=c(4,Inf),failRate=c(.03,.06),dropoutRate=c(.001,.002)) + totalDuration <- 7 + xx <- gsDesign2::eEvents_df(enrollRates,failRates,totalDuration,simple=FALSE) %>% data.frame() + # expected checked with alternate calculations in gsSurvNPH vignette + expected <- data.frame(t=c(0,4), + failRate=c(0.03,0.06), + Events=c(0.5642911, 0.5194821)) + testthat::expect_equal(xx,expected) +}) + +# double programming tests nEvent = function(followup) { failduration = failRates$duration failtime = cumsum(failduration) @@ -6,23 +31,23 @@ nEvent = function(followup) { lamda = failRate + dropoutRate lamda1 = c(lamda, last(lamda)) failRate1 = c(failRate, last(failRate)) - + failtimeend = c(0, failtime[failtime < followup], followup) failtimeend1 = c(failtime[failtime < followup], followup) lamda2 = lamda1[c(1:(length(failtimeend) - 1))] failRate2 = failRate1[c(1:(length(failtimeend) - 1))] - + failduration = diff(failtimeend) failduration2 = followup - failtimeend1 - + fail = lamda2 * failduration sumfail = cumsum(fail) Bi1 = c(1, exp(-sumfail)) diffbi = diff(Bi1) Bi = Bi1[c(1:(length(Bi1) - 1))] - + totalevent = diffbi * (1 / lamda2 - failduration2) + Bi * failduration - + failevent = totalevent * (failRate2 / lamda2) return(sum(failevent)) } @@ -36,7 +61,7 @@ test_Event = function(enrollRates, failRates, totalDuration) { enrollrate = enrollRates$rate[i] followup = totalDuration - enrolltime[i] nEventnum = 0 - + if (followup > 0 && followup <= enrollmentend) { nEventnum = nEvent(followup) * enrollrate } else if (followup > 0 && followup > enrollmentend) { @@ -85,5 +110,4 @@ testthat::test_that("expected events is different from double-programmed vs eEve totalDuration=80 testthat::expect_equal(test_Event(enrollRates, failRates, totalDuration), eEvents_df(enrollRates, failRates, totalDuration, simple)) - }) - + }) \ No newline at end of file diff --git a/tests/testthat/test-independent-fixed_design.R b/tests/testthat/test-independent-fixed_design.R new file mode 100644 index 000000000..28964f109 --- /dev/null +++ b/tests/testthat/test-independent-fixed_design.R @@ -0,0 +1,164 @@ +# Enrollment rate +enrollRates <- tibble::tibble( + Stratum = "All", + duration = 18, + rate = 20) + +# Failure rates +failRates <- tibble::tibble( + Stratum = "All", + duration = c(4, 100), + failRate = log(2) / 12, + hr = c(1, .6), + dropoutRate = .001) + +# Study duration in months +studyDuration <- 36 + +# Experimental / Control randomization ratio +ratio <- 1 + +test_that("input checking", { + # miss enrollRates + expect_error(fixed_design("AHR", alpha = 0.025, power = 0.9, failRates = failRates, studyDuration = studyDuration, ratio = ratio)) + + # miss failRates + expect_error(fixed_design("AHR", alpha = 0.025, power = 0.9, enrollRates = enrollRates, studyDuration = studyDuration, ratio = ratio)) + + # multiple rho for FH/MB + expect_error(fixed_design("FH", alpha = 0.025, power = 0.9, enrollRates = enrollRates, failRates = failRates, + studyDuration = studyDuration, ratio = ratio, rho = c(0.5, 0))) + expect_error(fixed_design("MB", alpha = 0.025, power = 0.9, enrollRates = enrollRates, failRates = failRates, + studyDuration = studyDuration, ratio = ratio, rho = c(0.5, 0))) + + # multiple tau for FH/MB + expect_error(fixed_design("FH", alpha = 0.025, power = 0.9, enrollRates = enrollRates, failRates = failRates, + studyDuration = studyDuration, ratio = ratio, tau = c(0.5, 0))) + expect_error(fixed_design("MB", alpha = 0.025, power = 0.9, enrollRates = enrollRates, failRates = failRates, + studyDuration = studyDuration, ratio = ratio, tau = c(0.5, 0))) + + # redundant tau in FH + expect_error(fixed_design("FH", alpha = 0.025, power = 0.9, enrollRates = enrollRates, failRates = failRates, + studyDuration = studyDuration, ratio = ratio, tau = 0.5)) + + # redundant rho/gamma in MB + expect_error(fixed_design("MB", alpha = 0.025, power = 0.9, enrollRates = enrollRates, failRates = failRates, + studyDuration = studyDuration, ratio = ratio, rho = 0.5, gamma = 0.5)) + + # p_c/p_e/rd0 not input in RD + expect_error(fixed_design("RD", alpha = 0.025, power = 0.9, p_e = 0.1, rd0 = 0, ratio = ratio)) + expect_error(fixed_design("RD", alpha = 0.025, power = 0.9, p_c = 0.1, rd0 = 0, ratio = ratio)) + expect_error(fixed_design("RD", alpha = 0.025, power = 0.9, p_c= 0.2, p_e = 0.1, ratio = ratio)) + expect_error(fixed_design("RD", alpha = 0.025, p_c= 0.2, p_e = 0.1, rd0 = 0, ratio = ratio)) +}) + +test_that("AHR", { + x <- fixed_design(x = "AHR", + alpha = 0.025, power = 0.9, + enrollRates = enrollRates, failRates = failRates, + studyDuration = studyDuration, ratio = ratio) + + y <- fixed_design(x = "AHR", + alpha = 0.025, + enrollRates = enrollRates %>% mutate(rate = x$analysis$N/duration), failRates = failRates, + studyDuration = studyDuration, ratio = ratio) + + expect(y$analysis$Power, 0.9) +}) + +test_that("FH", { + x <- fixed_design(x = "FH", + alpha = 0.025, power = 0.9, + enrollRates = enrollRates, failRates = failRates, + studyDuration = studyDuration, ratio = ratio, + rho = 0.5, gamma = 0.5) + + y <- fixed_design(x = "FH", + alpha = 0.025, + enrollRates = enrollRates %>% mutate(rate = x$analysis$N/duration), failRates = failRates, + studyDuration = studyDuration, ratio = ratio, + rho = 0.5, gamma = 0.5) + + expect(y$analysis$Power, 0.9) +}) + +test_that("MB", { + x <- fixed_design(x = "MB", + alpha = 0.025, power = 0.9, + enrollRates = enrollRates, failRates = failRates, + studyDuration = studyDuration, ratio = ratio, + tau = 8) + + y <- fixed_design(x = "MB", + alpha = 0.025, + enrollRates = enrollRates %>% mutate(rate = x$analysis$N/duration), failRates = failRates, + studyDuration = studyDuration, ratio = ratio, + tau = 8) + + expect(y$analysis$Power, 0.9) +}) + +test_that("LF", { + x <- fixed_design(x = "LF", + alpha = 0.025, power = 0.9, + enrollRates = enrollRates, failRates = failRates, + studyDuration = studyDuration, ratio = ratio) + + y <- fixed_design(x = "LF", + alpha = 0.025, + enrollRates = enrollRates %>% mutate(rate = x$analysis$N/duration), failRates = failRates, + studyDuration = studyDuration, ratio = ratio) + + expect(y$analysis$Power, 0.9) +}) + +test_that("MaxCombo", { + x <- fixed_design(x = "MaxCombo", + alpha = 0.025, power = 0.9, + enrollRates = enrollRates, failRates = failRates, + studyDuration = studyDuration, ratio = ratio, + rho = c(0, 0.5, 0.5), + gamma = c(0, 0, 0.5), + tau = c(-1, 4, 6)) + + y <- fixed_design(x = "MaxCombo", + alpha = 0.025, + enrollRates = enrollRates %>% mutate(rate = x$analysis$N/duration), failRates = failRates, + studyDuration = studyDuration, ratio = ratio, + rho = c(0, 0.5, 0.5), + gamma = c(0, 0, 0.5), + tau = c(-1, 4, 6)) + + expect(y$analysis$Power, 0.9) +}) + +test_that("RMST", { + x <- fixed_design(x = "RMST", + alpha = 0.025, power = 0.9, + enrollRates = enrollRates, failRates = failRates, + studyDuration = studyDuration, ratio = ratio, + tau = 18) + + y <- fixed_design(x = "RMST", + alpha = 0.025, + enrollRates = enrollRates %>% mutate(rate = x$analysis$N/duration), failRates = failRates, + studyDuration = studyDuration, ratio = ratio, + tau = 18) + + expect(y$analysis$Power, 0.9) +}) + +test_that("RD", { + x <- fixed_design(x = "RD", + alpha = 0.025, power = 0.9, + p_c = .15, p_e = .1, rd0 = 0, ratio = ratio, + tau = 18) + + y <- fixed_design(x = "RD", + alpha = 0.025, N = x$analysis$N, + p_c = .15, p_e = .1, rd0 = 0, ratio = ratio, + tau = 18) + + expect(y$analysis$Power, 0.9) +}) + diff --git a/tests/testthat/test-independent-gridpts.R b/tests/testthat/test-independent-gridpts.R new file mode 100644 index 000000000..b8e34976c --- /dev/null +++ b/tests/testthat/test-independent-gridpts.R @@ -0,0 +1,11 @@ +test_that("compare gridpts results with gsDesign::normalGrid results", { + x1 <- gridpts(r = 18, mu = 4, a = -Inf, b = Inf) + x2 <- gsDesign::normalGrid(r = 18, bounds = c(-40, 40), mu = 4, sigma = 1) + expect_equal(x1$w, x2$gridwgts) + expect_equal(x1$z, x2$z) + + x1 <- gridpts(r = 18, mu = 2, a = -Inf, b = Inf) + x2 <- gsDesign::normalGrid(r = 18, bounds = c(-40, 40), mu = 2, sigma = 1) + expect_equal(x1$w, x2$gridwgts) + expect_equal(x1$z, x2$z) +}) diff --git a/tests/testthat/test-independent-gs_b.R b/tests/testthat/test-independent-gs_b.R new file mode 100644 index 000000000..9d2826720 --- /dev/null +++ b/tests/testthat/test-independent-gs_b.R @@ -0,0 +1,15 @@ +test_that("gs_b() returns values as expected", { + IF <- c(.6, .8, 1) + par = gsDesign::gsDesign(alpha = .02, k = length(IF), test.type = 1, sfu = gsDesign::sfLDOF, timing = IF)$upper$bound + expect_equal(par, gs_b(par)) + + par = 1:10 + k = 5 + expect_equal(par[5], gs_b(par,k = k)) +}) + +testthat::test_that("gs_b() returns NA if the number of interim analysis is larger than the length of par", { + IF <- c(.8, 1) + par = gsDesign::gsDesign(alpha = .025, k = length(IF), test.type = 1, sfu = gsDesign::sfLDOF, timing = IF)$upper$bound + expect_true(is.na(gs_b(par,k = 3))) +}) \ No newline at end of file diff --git a/tests/testthat/test-independent-gs_design_npe.R b/tests/testthat/test-independent-gs_design_npe.R new file mode 100644 index 000000000..f21da039e --- /dev/null +++ b/tests/testthat/test-independent-gs_design_npe.R @@ -0,0 +1,165 @@ +library(gsDesign) +# Parameters used repeatedly +K <- 3 +timing <- c(.6, .8, 1) +sfu <- sfHSD +sfupar <- -12 +sfl <- sfPower +sflpar <- 4 +delta <- .2 +alpha <- .025 +beta <- .1 + +testthat::test_that("One-sided design to reproduce gsDesign package bounds", { + gsd <- gsDesign::gsDesign(test.type = 1, k = K, sfu = sfu, sfupar = sfupar, sfl = sfl, sflpar = sflpar, timing = timing, + delta = delta, alpha = alpha, beta = beta) + gsdv <- gs_design_npe(theta = delta, info = timing, beta = beta, + upper = gs_spending_bound, + upar = list(sf = sfu, total_spend = alpha, param = sfupar), + lower = gs_b, + lpar = rep(-Inf, K) + ) %>% filter(Bound == "Upper") + expect_equal(gsd$upper$bound, gsdv$Z, tolerance = 0.0001) + expect_equal(gsd$n.I, gsdv$info, tolerance = 0.5) + + gsdv0 <- gs_power_npe(theta = 0, info = gsdv$info, + upper = gs_spending_bound, + upar = list(sf = sfu, total_spend = alpha, param = sfupar), + lower = gs_b, + lpar = rep(-Inf, K)) %>% filter(Bound == "Upper") + expect_equal(gsdv0$Probability, sfu(alpha = alpha, t = timing, param = sfupar)$spend) + + expect_equal((gsdv %>% filter(Bound == "Upper"))$Probability0, sfu(alpha = alpha, t = timing, param = sfupar)$spend) +}) + + +testthat::test_that("Two-sided symmetric design to reproduce gsDesign test.type=2 bounds", { + gsd <- gsDesign(test.type = 2, k = K, sfu = sfu, sfupar = sfupar, sfl = sfl, sflpar = sflpar, timing = timing, + delta = delta, alpha = alpha, beta = beta, tol = 1e-6) + gsdv <- gs_design_npe(theta = delta, info = timing, beta = beta, + theta1 = rep(0,3), + binding = FALSE, + upper = gs_spending_bound, + upar = list(sf = sfu, total_spend = alpha, param = sfupar), + lower = gs_spending_bound, + lpar = list(sf = sfu, total_spend = alpha, param = sfupar), + tol = 1e-6) + + expect_equal(gsd$upper$bound, (gsdv %>% filter(Bound == "Upper"))$Z, tolerance = 0.0001) + expect_equal(gsd$lower$bound, (gsdv %>% filter(Bound == "Lower"))$Z, tolerance = 0.0001) + expect_equal(gsd$n.I, (gsdv %>% filter(Bound == "Upper"))$info, tolerance = 0.5) + + gsdv0 <- gs_power_npe(theta = 0, info = (gsdv %>% filter(Bound == "Upper"))$info, + upper = gs_spending_bound, + upar = list(sf = sfu, total_spend = alpha, param = sfupar), + lower = gs_spending_bound, + lpar = list(sf = sfu, total_spend = alpha, param = sfupar)) + expect_equal(gsdv0$Probability[1:K], sfu(alpha = alpha, t = timing, param = sfupar)$spend) + + expect_equal((gsdv %>% filter(Bound == "Upper"))$Probability0, sfu(alpha = alpha, t = timing, param = sfupar)$spend) + expect_equal((gsdv %>% filter(Bound == "Lower"))$Probability0, sfu(alpha = alpha, t = timing, param = sfupar)$spend) +}) + +testthat::test_that("Two-sided asymmetric design to reproduce gsDesign test.type=3 bounds", { + gsd <- gsDesign(test.type = 3, k = K, sfu = sfu, sfupar = sfupar, sfl = sfl, sflpar = sflpar, timing = timing, + delta = delta, alpha = alpha, beta = beta) + gsdv <- gs_design_npe(theta = delta, info = timing, beta = beta, + binding = TRUE, + upper = gs_spending_bound, + upar = list(sf = sfu, total_spend = alpha, param = sfupar), + lower = gs_spending_bound, + lpar = list(sf = sfl, total_spend = beta, param = sflpar)) + + expect_equal(gsd$upper$bound, (gsdv%>% filter(Bound == "Upper"))$Z, tolerance = 0.0001) + expect_equal(gsd$lower$bound, (gsdv%>% filter(Bound == "Lower"))$Z, tolerance = 0.0001) + expect_equal(gsd$n.I, (gsdv %>% filter(Bound == "Upper"))$info, tolerance = 0.5) + + gsdv0 <- gs_power_npe(theta = 0, info = (gsdv %>% filter(Bound == "Upper"))$info, + upper = gs_spending_bound, + upar = list(sf = sfu, total_spend = alpha, param = sfupar), + lower = gs_spending_bound, + lpar = list(sf = sfu, total_spend = alpha, param = sfupar)) + expect_equal((gsdv0 %>% filter(Bound == "Upper"))$Probability, sfu(alpha = alpha, t = timing, param = sfupar)$spend) + + expect_equal((gsdv %>% filter(Bound == "Upper"))$Probability0, sfu(alpha = alpha, t = timing, param = sfupar)$spend) + #expect_equal((gsdv %>% filter(Bound == "Lower"))$Probability0, sfu(alpha = beta, t = timing, param = sflpar)$spend) +}) + +testthat::test_that("Two-sided asymmetric design fails to reproduce gsDesign test.type=4 bounds", { + gsd <- gsDesign(test.type = 4, k = K, sfu = sfu, sfupar = sfupar, sfl = sfl, sflpar = sflpar, timing = timing, + delta = delta, alpha = alpha, beta = beta) + gsdv <- gs_design_npe(theta = delta, info = timing, beta = beta, + binding = FALSE, # Use this for test.type=4 and 6 + upper = gs_spending_bound, + upar = list(sf = sfu, total_spend = alpha, param = sfupar), + lower = gs_spending_bound, + lpar = list(sf = sfl, total_spend = beta, param = sflpar)) + + expect_equal(gsd$upper$bound, (gsdv%>% filter(Bound == "Upper"))$Z, tolerance = 0.0001) + expect_equal(gsd$lower$bound, (gsdv%>% filter(Bound == "Lower"))$Z, tolerance = 0.0001) + expect_equal(gsd$n.I, (gsdv %>% filter(Bound == "Upper"))$info, tolerance = 0.5) + + + gsdv0 <- gs_power_npe(theta = 0, info = (gsdv %>% filter(Bound == "Upper"))$info, + upper = gs_spending_bound, + upar = list(sf = sfu, total_spend = alpha, param = sfupar), + lower = gs_b, + lpar = rep(-Inf, K)) + expect_equal((gsdv0 %>% filter(Bound == "Upper"))$Probability, sfu(alpha = alpha, t = timing, param = sfupar)$spend) + + expect_equal((gsdv %>% filter(Bound == "Upper"))$Probability0, sfu(alpha = alpha, t = timing, param = sfupar)$spend, tolerance = 0.01) +}) + + +testthat::test_that("Two-sided asymmetric design fails to reproduce gsDesign test.type=5 bounds", { + astar <- 0.2 + gsd <- gsDesign(test.type = 5, k = K, sfu = sfu, sfupar = sfupar, sfl = sfl, sflpar = sflpar, timing = timing, + delta = delta, alpha = alpha, beta = beta, astar = astar) + gsdv <- gs_design_npe(theta = delta, info = timing, beta = beta, + theta1 = 0, + binding = TRUE, + upper = gs_spending_bound, + upar = list(sf = sfu, total_spend = alpha, param = sfupar), + lower = gs_spending_bound, + lpar = list(sf = sfl, total_spend = astar, param = sflpar)) + + expect_equal(gsd$upper$bound, (gsdv%>% filter(Bound == "Upper"))$Z, tolerance = 0.0001) + expect_equal(gsd$lower$bound, (gsdv%>% filter(Bound == "Lower"))$Z, tolerance = 0.0001) + expect_equal(gsd$n.I, (gsdv %>% filter(Bound == "Upper"))$info, tolerance = 0.5) + + + gsdv0 <- gs_power_npe(theta = 0, info = (gsdv %>% filter(Bound == "Upper"))$info, + upper = gs_spending_bound, + upar = list(sf = sfu, total_spend = alpha, param = sfupar), + lower = gs_spending_bound, + lpar = list(sf = sfu, total_spend = alpha, param = sfupar)) + expect_equal((gsdv0 %>% filter(Bound == "Upper"))$Probability, sfu(alpha = alpha, t = timing, param = sfupar)$spend) + + expect_equal((gsdv %>% filter(Bound == "Upper"))$Probability0, sfu(alpha = alpha, t = timing, param = sfupar)$spend) +}) + +testthat::test_that("Two-sided asymmetric design fails to reproduce gsDesign test.type=6 bounds", { + astar <- 0.2 + gsd <- gsDesign(test.type = 6, k = K, sfu = sfu, sfupar = sfupar, sfl = sfl, sflpar = sflpar, timing = timing, + delta = delta, alpha = alpha, beta = beta, astar = astar) + gsdv <- gs_design_npe(theta = delta, info = timing, beta = beta, + theta1 = 0, # Spending for lower bound under H0 + binding = FALSE, # Use this for test.type=3 and 5 + upper = gs_spending_bound, + upar = list(sf = sfu, total_spend = alpha, param = sfupar), + lower = gs_spending_bound, + lpar = list(sf = sfl, total_spend = astar, param = sflpar)) + + expect_equal(gsd$upper$bound, (gsdv%>% filter(Bound == "Upper"))$Z, tolerance = 0.0001) + expect_equal(gsd$lower$bound, (gsdv%>% filter(Bound == "Lower"))$Z, tolerance = 0.0001) + expect_equal(gsd$n.I, (gsdv %>% filter(Bound == "Upper"))$info, tolerance = 0.5) + + gsdv0 <- gs_power_npe(theta = 0, info = (gsdv %>% filter(Bound == "Upper"))$info, + upper = gs_spending_bound, + upar = list(sf = sfu, total_spend = alpha, param = sfupar), + lower = gs_spending_bound, + lpar = list(sf = sfu, total_spend = alpha, param = sfupar)) + expect_equal((gsdv0 %>% filter(Bound == "Upper"))$Probability, sfu(alpha = alpha, t = timing, param = sfupar)$spend) + + expect_equal((gsdv %>% filter(Bound == "Upper"))$Probability0, sfu(alpha = alpha, t = timing, param = sfupar)$spend) +}) diff --git a/tests/testthat/test-independent-gs_power_npe.R b/tests/testthat/test-independent-gs_power_npe.R new file mode 100644 index 000000000..48e7a1859 --- /dev/null +++ b/tests/testthat/test-independent-gs_power_npe.R @@ -0,0 +1,78 @@ +test_that("expect equal with mvtnorm for efficacy and futility bounds",{ + + info <- c(40,100) + r <- info[1]/info[2] + + test <- gs_power_npe(theta = 0, + info = info, + info0 = NULL, + binding = FALSE, + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, param = NULL, total_spend = 0.025), + lower = gs_spending_bound, + lpar = list(sf = gsDesign::sfLDOF, param = NULL, total_spend = 0.02)) + + test1 <- test%>% filter(Bound == "Upper") + test2 <- test%>% filter(Bound == "Lower") + + alpha.t <- 0.025 + b.ia <- gsDesign::sfLDOF(alpha = alpha.t, t = r) + alpha.ia <- b.ia$spend + + Pb <- function(alpha.t, alpha.ia, r, b){ + temp = mvtnorm::pmvnorm(lower = c(-Inf, b), + upper = c(qnorm(1-alpha.ia), Inf), + corr = rbind(c(1, sqrt(r)), c(sqrt(r), 1))) + return(alpha.t - alpha.ia - temp) + } + + b <- uniroot(Pb, c(1.96, 4), alpha.t = alpha.t, alpha.ia = alpha.ia, r = r) + + pb <- 1- pnorm(b$root) + + expect_equal(object = test1$Z, expected = c(qnorm(1-alpha.ia),b$root), tolerance = 0.001) + expect_equal(object = test1$Probability, expected = cumsum(c(b.ia$spend,pb)), tolerance = 0.001) + + beta.t <- 0.02 + a.ia <- gsDesign::sfLDOF(alpha = beta.t, t = r) + beta.ia <- a.ia$spend + + Pa <- function(beta.t, beta.ia, r, a){ + temp <- mvtnorm::pmvnorm(lower = c(-Inf, qnorm(beta.ia)), + upper = c(a, Inf), + corr = rbind(c(1, sqrt(r)), c(sqrt(r), 1))) + return(beta.t - beta.ia - temp) + } + + a <- uniroot(Pa, c(-4, 1.96), beta.t = beta.t, beta.ia = beta.ia, r = r) + + pa <- pnorm(a$root) + + expect_equal(object = test2$Z, expected = c(qnorm(beta.ia), a$root), tolerance = 0.001) + expect_equal(object = test2$Probability, expected = cumsum(c(a.ia$spend,pa)), tolerance = 0.001) +}) + + +test_that("expect equal with gsDesign::gsProbability outcome for efficacy bounds",{ + + info <- c(40, 150, 200) + + test3 <- + gs_power_npe(theta = .1, + info = info, info0 = NULL, binding = FALSE, + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, param = NULL, total_spend = 0.025), + lower = gs_b, + lpar = rep(-Inf, 3) + ) %>% filter(Bound == "Upper") + + x3 <- gsDesign::gsProbability(k = 3, + theta = .1, + n.I = info, + a = rep(-20, 3), + b = gsDesign(k = 3, test.type=1, sfu = sfLDOF, n.I = info)$upper$bound) + + + expect_equal(ifelse(is.infinite(test3$Z), 20, test3$Z), x3$upper$bound, tolerance = 0.0001) + expect_equal(test3$Probability, cumsum(x3$upper$prob), tolerance = 0.0001) +}) diff --git a/tests/testthat/test-independent-gs_spending_bound.R b/tests/testthat/test-independent-gs_spending_bound.R new file mode 100644 index 000000000..1b330cd94 --- /dev/null +++ b/tests/testthat/test-independent-gs_spending_bound.R @@ -0,0 +1,166 @@ +test_that("compare gs_spending_bound with gsDesign results with equal IA timing for upper and lower bound", { + + x <- gsDesign::gsSurv(k = 3, + test.type = 4, + alpha = 0.025, + beta = 0.2, + timing = 1, + sfu = gsDesign::sfLDOF, + sfupar = c( 0 ), + sfl = gsDesign::sfLDOF, + sflpar = c( 0 ), + lambdaC = c( 0.1 ), + hr = 0.6, + hr0 = 1, + eta = 0.01, + gamma = c( 10 ), + R = c( 12 ), + S = NULL, + T = 36, + minfup = 24, + ratio = 1 ) + + info <- x$n.I + a <- -Inf + b <- Inf + b <- gs_spending_bound() + hgm1_0 <- h1(theta = 0, + I = info[1], + a = a, + b = b) + b2 <- gs_spending_bound(k = 2, + theta = 0, + hgm1 = hgm1_0, + info = info) + hgm2_0<-hupdate(theta = 0, + I = info[2], + a = a, + b = b2, + Im1 = info[1], + gm1 = hgm1_0) + b3 <- gs_spending_bound(k = 3, + theta = 0, + hgm1 = hgm2_0, + info = info) + test1<- cbind(b, b2, b3) + + a <- gs_spending_bound(k = 1, + par = list(sf = gsDesign::sfLDOF, total_spend = 0.2, param = NULL, timing = NULL,max_info = NULL), + theta = x$theta[2], + hgm1 = NULL, + efficacy = FALSE, + info = info) + hgm1_1 <- h1(theta = x$theta[2], I = info[1], a = a, b = b) + + a2 <- gs_spending_bound(k = 2, + par = list(sf = gsDesign::sfLDOF, total_spend = 0.2, param = NULL, timing = NULL, max_info = NULL), + theta = x$theta[2], + hgm1 = hgm1_1, + efficacy = FALSE, + info = info) + + hgm2_1 <- hupdate(theta = x$theta[2], + I = info[2], + a = a2, + b = b2, + Im1=info[1], + gm1 = hgm1_1, + thetam1 = x$theta[2]) + + a3 <- gs_spending_bound(k = 3, + par = list(sf = gsDesign::sfLDOF, total_spend = 0.2, param = NULL, timing = NULL ,max_info = NULL), + theta = x$theta[2], + hgm1 = hgm2_1, + efficacy = FALSE, + info = info) + + test2 <- cbind(a,a2,a3) + + expect_equal(object = as.numeric(test1), expected = x$upper$bound, tolerance = 0.0001) + expect_equal(object = as.numeric(test2), expected = x$lower$bound, tolerance = 0.0001) + +}) + + +test_that("compare gs_spending_bound with gsDesign results with unequal IA timing for upper and lower bound", { + y<- gsDesign::gsSurv(k = 3, + test.type = 4, + alpha = 0.025, + beta = 0.2, + timing = c( 0.6,0.8), + sfu = gsDesign::sfLDOF, + sfupar = c( 0 ), + sfl = gsDesign::sfLDOF, + sflpar = c( 0 ), + lambdaC = c( 0.1 ), + hr = 0.6, + hr0 = 1, + eta = 0.01, + gamma = c( 10 ), + R = c( 12 ), + S = NULL, + T = 36, + minfup = 24, + ratio = 1 ) + info <- y$n.I + a <- -Inf + b <- Inf + b <- gs_spending_bound(k = 1, + theta = 0, + hgm1 = NULL, + info = info) + hgm1_0 <- h1(theta = 0, + I = info[1], + a = a, + b = b) + b2 <- gs_spending_bound(k = 2, + theta = 0, + hgm1 = hgm1_0, + info=info) + hgm2_0 <- hupdate(theta = 0, + I = info[2], + a = a, + b = b2, + Im1 = info[1], + gm1 = hgm1_0) + b3 <- gs_spending_bound(k = 3, + theta = 0, + hgm1 = hgm2_0, + info = info) + + test3<-cbind(b, b2, b3) + a <- gs_spending_bound(k = 1, + par = list(sf = gsDesign::sfLDOF, total_spend = 0.2, param = NULL, timing = NULL, max_info = NULL), + theta = y$theta[2], + hgm1 = NULL, + efficacy = FALSE, + info = info) + + hgm1_1 <- h1(theta = y$theta[2], I = info[1], a = a, b = b) + + a2 <- gs_spending_bound(k = 2, + par = list(sf = gsDesign::sfLDOF, total_spend = 0.2, param = NULL, timing = NULL, max_info = NULL), + theta = y$theta[2], + hgm1 = hgm1_1, + efficacy = FALSE, + info = info) + + hgm2_1 <- hupdate(theta = y$theta[2], + I = info[2], + a = a2, + b = b2, + Im1 = info[1], + gm1 = hgm1_1, + thetam1 = y$theta[2]) + + a3 <- gs_spending_bound(k = 3, par = list(sf = gsDesign::sfLDOF, + total_spend = 0.2, + param = NULL, + timing = NULL , + max_info = NULL),theta = y$theta[2], hgm1 = hgm2_1, efficacy=FALSE, info=info) + + test4 <- cbind(a, a2, a3) + + expect_equal(object = as.numeric(test3), expected = y$upper$bound, tolerance = 0.0001) + expect_equal(object = as.numeric(test4), expected = y$lower$bound, tolerance = 0.0001) +}) \ No newline at end of file diff --git a/tests/testthat/test-independent-h1.R b/tests/testthat/test-independent-h1.R new file mode 100644 index 000000000..83ac63506 --- /dev/null +++ b/tests/testthat/test-independent-h1.R @@ -0,0 +1,38 @@ +test_that("h1() returns results as expected ",{ + #the design + gstry <- gsDesign::gsDesign(k = 3, + sfl = gsDesign::sfLDOF, + delta = 0) + #probabilities calculated based on function h1() + upper.null <- sum(h1(theta = gstry$theta[1], + I = gstry$n.I[1], + a = gstry$upper$bound[1], + b = Inf)$h) + upper.alt <- sum(h1(theta = gstry$theta[2], + I = gstry$n.I[1], + a = gstry$upper$bound[1], + b = Inf)$h) + lower.null <- sum(h1(theta = gstry$theta[1], + I = gstry$n.I[1], + a = -Inf, + b = gstry$lower$bound[1])$h) + lower.alt <- sum(h1(theta = gstry$theta[2], + I = gstry$n.I[1], + a = -Inf, + b = gstry$lower$bound[1])$h) + #probabilities calculated based on function gsProbability + x <- gsDesign::gsProbability( + k = 3, + a = gstry$lower$bound, + b = gstry$upper$bound, + n.I = gstry$n.I , theta = gstry$theta + ) + expect_equal(object = as.numeric(c(upper.null, upper.alt)), expected = x$upper$prob[1,], tolerance = 0.0001) + expect_equal(object = as.numeric(c(lower.null, lower.alt)), expected = x$lower$prob[1,], tolerance = 0.0001) +}) + +test_that("h1() returns probability almost zero for extreme case",{ + exmtest1 <- sum(h1(theta = 9, I = 0.5, a = -Inf, b=0)$h) + exmtest2 <- sum(h1(theta = 1, I = 0.5, a = 9, b = Inf)$h) + expect_equal(object = as.numeric(c(exmtest1, exmtest2)), expected = c(0,0), tolerance = 0.0001) +}) \ No newline at end of file diff --git a/tests/testthat/test-independent-hupdate.R b/tests/testthat/test-independent-hupdate.R new file mode 100644 index 000000000..77c007b7d --- /dev/null +++ b/tests/testthat/test-independent-hupdate.R @@ -0,0 +1,94 @@ +test_that("hupdate() returns results as expected ",{ + #the design + gstry <- gsDesign::gsDesign(k = 3, + sfl = gsDesign::sfLDOF, + delta = 0) + #probabilities calculated based on function h1(), IA1 needs to full between low and upper bound + #in order to continue to IA2 + null.01 <- h1(theta = gstry$theta[1], + I = gstry$n.I[1], + a = gstry$lower$bound[1], + b = gstry$upper$bound[1]) + #IA2 to reject H0, we integrate from upper bound to Inf + upper.null.02 <- sum(hupdate(theta = gstry$theta[1], + thetam1 = gstry$theta[1], + I = gstry$n.I[2], + Im1 = gstry$n.I[1], + gm1 = null.01, + a = gstry$upper$bound[2], + b = Inf)$h) + #IA2 to accept H0, we integrate from -Inf to lower bound + lower.null.02 <- sum(hupdate(theta = gstry$theta[1], + thetam1 = gstry$theta[1], + I = gstry$n.I[2], + Im1 = gstry$n.I[1], + gm1 = null.01, + a = -Inf, + b = gstry$lower$bound[2])$h) + + alt.01 <- h1(theta = gstry$theta[2], + I = gstry$n.I[1], + a = gstry$lower$bound[1], + b = gstry$upper$bound[1]) + #IA2 to reject H0, we integrate from upper bound to Inf + upper.alt.02 <- sum(hupdate(theta = gstry$theta[2], + thetam1 = gstry$theta[2], + I = gstry$n.I[2], + Im1 = gstry$n.I[1], + gm1 = alt.01, + a = gstry$upper$bound[2], + b = Inf)$h) + #IA2 to accept H0, we integrate from -Inf to lower bound + lower.alt.02 <- sum(hupdate(theta = gstry$theta[2], + thetam1 = gstry$theta[2], + I = gstry$n.I[2], + Im1 = gstry$n.I[1], + gm1 = alt.01, + a = -Inf, + b = gstry$lower$bound[2])$h) + #probabilities calculated based on function gsProbability + x <- gsDesign::gsProbability( + k = 3, + a = gstry$lower$bound, + b = gstry$upper$bound, + n.I = gstry$n.I, + theta = gstry$theta + ) + + expect_equal(object = as.numeric(c(lower.null.02, lower.alt.02)), expected = x$lower$prob[2, ], tolerance = 0.0001) + expect_equal(object = as.numeric(c(upper.null.02, upper.alt.02)), expected = x$upper$prob[2, ], tolerance = 0.0001) + #problem with below code on extreme case: + #hupdate(theta = gstry$theta[1], thetam1= gstry$theta[1], + # I=gstry$n.I[1]+0.00000000000001,Im1=gstry$n.I[1],gm1=null.01, + # a = gstry$upper$bound[2],b=Inf) %>% summarise(p = sum(h)) +}) + +test_that("hupdate() returns probability almost zero for extreme case",{ + #the design + gstry <- gsDesign::gsDesign(k = 3, + sfl = gsDesign::sfLDOF, + delta = 0) + null.01 <- h1(theta = gstry$theta[1], + I = gstry$n.I[1], + a = gstry$lower$bound[1], + b = gstry$upper$bound[1]) + #IA2 to reject H0, we integrate from upper bound to Inf + #-8 is an arbitrary extreme case for theta + poor.02 <- sum(hupdate(theta = -8, + thetam1 = gstry$theta[1], + I = gstry$n.I[2], + Im1 = gstry$n.I[1], + gm1 = null.01, + a = gstry$upper$bound[2], + b = Inf)$h) + #IA2 to accept H0, we integrate from -Inf to lower bound + #-8 is an arbitrary extreme case for the bound + high.02 <- sum(hupdate(theta = gstry$theta[2], + thetam1 = gstry$theta[2], + I = gstry$n.I[2], + Im1 = gstry$n.I[1], + gm1 = null.01, + a = -Inf, + b = -8)$h) + expect_equal(object = as.numeric(c(poor.02, high.02)), expected = c(0, 0), tolerance = 0.0001) +}) \ No newline at end of file diff --git a/tests/testthat/test-double_programming_tEvents.R b/tests/testthat/test-independent-tEvents.R similarity index 99% rename from tests/testthat/test-double_programming_tEvents.R rename to tests/testthat/test-independent-tEvents.R index 4613d072e..f322a768a 100644 --- a/tests/testthat/test-double_programming_tEvents.R +++ b/tests/testthat/test-independent-tEvents.R @@ -30,7 +30,7 @@ testthat::test_that("tEvents does not equal to eEvent_df's result", { enrollRates = tibble::tibble(Stratum = "All", duration = c(2, 2, 10), rate = c(3, 6, 9) * 5) - + failRates = tibble::tibble(Stratum = "All", duration = c(3, 100), failRate = log(2) / c(9, 18), @@ -65,7 +65,7 @@ testthat::test_that("tEvents does not euqal to AHR's result",{ failRates = failRates, targetEvents = targetEvents, interval = interval) - + testthat::expect_equal( t1$Events, AHR(enrollRates=enrollRates, @@ -74,4 +74,4 @@ testthat::test_that("tEvents does not euqal to AHR's result",{ ratio=1, simple = TRUE)$Events ) -}) +}) \ No newline at end of file diff --git a/tests/testthat/test-independent-utility_tbl.R b/tests/testthat/test-independent-utility_tbl.R new file mode 100644 index 000000000..ff9a7c944 --- /dev/null +++ b/tests/testthat/test-independent-utility_tbl.R @@ -0,0 +1,30 @@ +test_that("test rounddf", { + x2 <- rnorm(3) + x3 <- rnorm(3) + tbl <- tibble::tibble(x1 = c("a", "b", "c"), x2 = x2, x3 = x3) + + tbl_new <- gsDesign2:::rounddf(tbl, digits = 2) + expect_equal(tbl_new$x1, tbl$x1) + expect_equal(tbl_new$x2, round(x2, 2)) + expect_equal(tbl_new$x3, round(x3, 2)) + + tbl_new <- gsDesign2:::rounddf(tbl, digits = c(1, 1, 2)) + expect_equal(tbl_new$x1, tbl$x1) + expect_equal(tbl_new$x2, round(x2, 1)) + expect_equal(tbl_new$x3, round(x3, 2)) +}) + +test_that("test table_ab", { + a <- data.frame(Index = 1:2, a1 = c(1.1234, 5.6789), a2 = c("text 1", "text 2")) + b <- data.frame(Index = 1:2, + b1 = c("apple", "penny"), + b2 = 1:2, + b3 = 3:4) + tbl <- gsDesign2:::table_ab(a, b, byvar = "Index", decimals = c(0, 2, 0), aname = "Index") + + expect_equal(tbl$Index, c(paste0("Index: 1 a1: ", round(1.1234, 2), " a2: text 1"), + paste0("Index: 2 a1: ", round(5.6789, 2), " a2: text 2"))) + expect_equal(tbl$b1, b$b1) + expect_equal(tbl$b2, b$b2) + expect_equal(tbl$b3, b$b3) +}) \ No newline at end of file diff --git a/tests/testthat/test-independent_test_eEvents_df.R b/tests/testthat/test-independent_test_eEvents_df.R deleted file mode 100644 index e49eaee86..000000000 --- a/tests/testthat/test-independent_test_eEvents_df.R +++ /dev/null @@ -1,23 +0,0 @@ - -testthat::test_that("expected events is different from gsDesign::eEvents and eEvents_df",{ - enrollRates <- tibble::tibble(duration=c(2,1,2),rate=c(5,10,20)) - failRates <- tibble::tibble(duration=c(1,1,1),failRate=c(.05,.02,.01),dropoutRate=.01) - totalDuration <- 20 - testthat::expect_equal(gsDesign2::eEvents_df(enrollRates,failRates,totalDuration,simple=TRUE), - gsDesign::eEvents(lambda=failRates$failRate,S=failRates$duration[1:(nrow(failRates)-1)], - eta=failRates$dropoutRate,gamma=enrollRates$rate, - R=enrollRates$duration,T=totalDuration)$d, - ignore_attr = TRUE) -}) -testthat::test_that("data frame returned from eEvents_df not as expected",{ - # test case from gsSurvNPH - enrollRates <-tibble::tibble(duration=c(1,1,8),rate=c(3,2,0)) - failRates <- tibble::tibble(duration=c(4,Inf),failRate=c(.03,.06),dropoutRate=c(.001,.002)) - totalDuration <- 7 - xx <- gsDesign2::eEvents_df(enrollRates,failRates,totalDuration,simple=FALSE) %>% data.frame() - # expected checked with alternate calculations in gsSurvNPH vignette - expected <- data.frame(t=c(0,4), - failRate=c(0.03,0.06), - Events=c(0.5642911, 0.5194821)) - testthat::expect_equal(xx,expected) -}) diff --git a/tests/testthat/test-independent_test_s2pwe.R b/tests/testthat/test-independent_test_s2pwe.R deleted file mode 100644 index 0304f7341..000000000 --- a/tests/testthat/test-independent_test_s2pwe.R +++ /dev/null @@ -1,82 +0,0 @@ -testthat::test_that("s2pwe fails to come up with the correct answer",{ - time=c(1,5,6,8,10) - survival=c(0.5,0.4,0.3,0.2,0.1) - expect_equal(ignore_attr = TRUE, - round(s2pwe(time=time,survival=survival),3), - round(tibble(duration=c(1,4,1,2,2),rate=c(0.693,0.0558,0.288,0.203,0.347)),3) - ) -}) - - - - -testthat::test_that("s2pwe fails to identify non-numeric value",{ - times=c(1,"NA") - survival=c(0.5,0.4) - expect_error(expect_message(s2pwe(times=times,survival=survival), "gsDesign2: times in `s2pwe()` must be increasing positive finite numbers")) - -}) - - -testthat::test_that("s2pwe fails to identify non-positive value",{ - times2=c(1,NA) - survival=c(0.5,0.4) - expect_error(expect_message(s2pwe(times=times2,survival=survival), "gsDesign2: times in `s2pwe()` must be increasing positive finite numbers")) - -}) - - - -testthat::test_that("s2pwe fails to identify infinity value",{ - times3=c(1,Inf) - survival=c(0.5,0.4) - expect_error(expect_message(s2pwe(times=times2,survival=survival), "gsDesign2: times in `s2pwe()` must be increasing positive finite numbers")) - -}) - - -testthat::test_that("s2pwe fails to identify non-increasing value",{ - times4=c(1,2,1) - survival=c(0.5,0.4,0.3) - expect_error(expect_message(s2pwe(times=times4,survival=survival), "gsDesign2: times in `s2pwe()` must be increasing positive finite numbers")) - -}) - -testthat::test_that("s2pwe fails to identify non-numerical survival",{ - times5=c(1,2) - survival=c(0.5,"NA") - expect_error(expect_message(s2pwe(times=times5,survival=survival), "gsDesign2: survival in `s2pwe()` must be numeric and of same length as times")) - -}) - -testthat::test_that("s2pwe survival and time should have the same length",{ - times6=c(1,2,5) - survival=c(0.5,0.3) - expect_error(expect_message(s2pwe(times=times6,survival=survival), "gsDesign2: survival in `s2pwe()` must be numeric and of same length as times")) - -}) - - - -testthat::test_that("s2pwe fails to identify non-positive survival",{ - times=c(1,3) - survival2=c(0.5,-0.1) - expect_error(expect_message(s2pwe(times=times,survival=survival2), "gsDesign2: survival in `s2pwe()` must be non-increasing positive finite numbers less than or equal to 1 with at least 1 value < 1")) - -}) - - -testthat::test_that("s2pwe fails to identify large than 1 survival",{ - times=c(1,3) - survival3=c(0.5,1.5) - expect_error(expect_message(s2pwe(times=times,survival=survival3), "gsDesign2: survival in `s2pwe()` must be non-increasing positive finite numbers less than or equal to 1 with at least 1 value < 1")) - -}) - - -testthat::test_that("s2pwe fails to identify an increasing survival series",{ - times=c(1,3) - survival4=c(0.5,0.9) - expect_error(expect_message(s2pwe(times=times,survival=survival4), "gsDesign2: survival in `s2pwe()` must be non-increasing positive finite numbers less than or equal to 1 with at least 1 value < 1")) - -}) diff --git a/tests/testthat/test-simulation_test_AHR.R b/tests/testthat/test-simulation_test_AHR.R deleted file mode 100644 index 1fb00e33b..000000000 --- a/tests/testthat/test-simulation_test_AHR.R +++ /dev/null @@ -1,55 +0,0 @@ -load("./fixtures/simulation_test_data.Rdata") - -testthat::test_that("AHR results are consistent with simulation results for single stratum and multiple cutoff", { - enrollRates=tibble::tibble(Stratum="All", - duration=c(2,2,10), - rate=c(3,6,9)) - failRates=tibble::tibble(Stratum="All", - duration=c(3,100), - failRate=log(2)/c(9,18), - hr=c(.9,.6), - dropoutRate=rep(.001,2)) - actual <- AHR(enrollRates = enrollRates, - failRates = failRates, - totalDuration=c(12, 24, 36)) - - testthat::expect_true(all.equal(simulation_AHR1$AHR, actual$AHR, tolerance = 0.005)) - testthat::expect_true(all.equal(simulation_AHR1$Events, actual$Events, tolerance = 0.005)) -}) - -testthat::test_that("AHR results are consistent with simulation results for single stratum and single cutoff", { - enrollRates=tibble::tibble(Stratum="All", - duration=c(2,2,10), - rate=c(3,6,9)) - failRates=tibble::tibble(Stratum="All", - duration=c(3,100), - failRate=log(2)/c(9,18), - hr=c(.9,.6), - dropoutRate=rep(.001,2)) - totalDuration = 30 - actual <- AHR(enrollRates = enrollRates, - failRates = failRates, - totalDuration=totalDuration) - testthat::expect_true(all.equal(simulation_AHR2$AHR, actual$AHR, tolerance = 1e-3)) - testthat::expect_true(all.equal(simulation_AHR2$Events, actual$Events, tolerance = 2e-3)) - -}) - -testthat::test_that("AHR results are consistent with simulation results for single stratum and multiple cutoff", { - enrollRates <- tibble::tibble(Stratum = "All", - duration = c(2, 2, 10), - rate = c(3, 6, 9)) - failRates <- tibble::tibble(Stratum = "All", - duration = c(3, Inf), - failRate = log(2)/c(9, 18), - hr = c(0.9, 0.6), - dropoutRate = rep(0.001, 2)) - totalDuration <- c(15, 30) - - actual <- AHR(enrollRates = enrollRates, - failRates = failRates, - totalDuration=totalDuration) - testthat::expect_true(all.equal(simulation_AHR3$AHR, actual$AHR, tolerance = 5e-3)) - testthat::expect_true(all.equal(simulation_AHR3$Events, actual$Events, tolerance = 7e-3)) - -}) diff --git a/vignettes/NPH_Futility.Rmd b/vignettes/NPH_Futility.Rmd new file mode 100644 index 000000000..44c78d26f --- /dev/null +++ b/vignettes/NPH_Futility.Rmd @@ -0,0 +1,154 @@ +--- +title: "Futility bounds at design and analysis under non-proportional hazards" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + number_sections: true + highlight: "textmate" + css: "custom.css" +bibliography: "ggsd.bib" +vignette: > + %\VignetteEngine{knitr::rmarkdown} + %\VignetteIndexEntry{Futility Bounds at Design and Analysis Under Non-proportional Hazards} +--- + + +```{r, warning=FALSE, message = FALSE} +library(gsDesign2) +library(gt) +library(dplyr) +library(tibble) +library(ggplot2) +``` + + +# Overview + +We set up futility bounds under a non-proportional hazards assumption. +We consider methods presented by @kornfreidlin2018 for setting such bounds and then consider an alternate futility bound based on $\beta-$spending under a delayed or crossing treatment effect to simplify implementation. +Finally, we show how to update this $\beta-$spending bound based on blinded interim data. +We will consider an example to reproduce a line of @kornfreidlin2018 Table 1 with the alternative futility bounds considered. + + +## Initial design set-up for fixed analysis + +@kornfreidlin2018 considered delayed effect scenarios and proposed a futility bound that is a modification of an earlier method proposed by @wieand. +We begin with the enrollment and failure rate assumptions which @kornfreidlin2018 based on an example by @ttchen2013. + +```{r} +# Enrollment assumed to be 680 patients over 12 months with no ramp-up +enrollRates <- tibble(Stratum = "All", duration = 12, rate = 680 / 12) +# Failure rates +## Control exponential with median of 12 mos +## Delayed effect with HR = 1 for 3 months and HR = .693 thereafter +## Censoring rate is 0 +failRates <- tibble(Stratum = "All", duration = c(3, 100), + failRate = -log(.5) / 12, hr = c(1, .693), dropoutRate = 0) +## Study duration was 34.8 in Korn & Freidlin Table 1 +## We change to 34.86 here to obtain 512 expected events more precisely +studyDuration <- 34.86 +``` + +We now derive a fixed sample size based on these assumptions. +Ideally, we would allow a targeted event count and variable follow-up in `fixed_design()` so that the study duration will be computed automatically. + + +```{r} +fixedevents <- fixed_design(x = "AHR", alpha = 0.025, power = NULL, + enrollRates = enrollRates, + failRates = failRates, + studyDuration = studyDuration) +fixedevents %>% summary() %>% + select(-Bound) %>% + as_gt(footnote="Power based on 512 events") %>% + fmt_number(columns = 3:4, decimals = 2) %>% + fmt_number(columns = 5:6, decimals = 3) +``` + + + +# Modified Wieand futility bound + +The @wieand rule recommends stopping after 50% of planned events accrue if the observed HR > 1. +kornfreidlin2018 modified this by adding a second interim analysis after 75% of planned events and stop if the observed HR > 1 +This is implemented here by requiring a trend in favor of control with a direction $Z$-bound at 0 resulting in the *Nominal p* bound being 0.5 for interim analyses in the table below. +A fixed bound is specified with the 'gs_b()` function for `upper` and `lower` and its correspoinding parameters `upar` for the upper (efficacy) bound and `lpar` for the lower (futility) bound. +The final efficacy bound is for a 1-sided nominal p-value of 0.025; the futility bound lowers this to 0.0247 as noted in the lower-right-hand corner of the table below. +In the last row under *Alternate hypothesis* below we see the power is 88.44%. +@kornfreidlin2018 computed 88.4% power for this design with 100,000 simulations which estimate the standard error for the power calculation to be `r paste(100 * round(sqrt(.884 * (1 - .884)/100000),4),'%',sep='')`. + +```{r} +wieand <- gs_power_ahr(enrollRates = enrollRates, failRates = failRates, + upper = gs_b, upar = c(rep(Inf, 2), qnorm(.975)), + lower = gs_b, lpar = c(0, 0, -Inf), + events = 512 * c(.5, .75, 1)) +wieand %>% summary() %>% + as_gt(title="Group sequential design with futility only at interim analyses", + subtitle="Wieand futility rule stops if HR > 1") +``` + +# Beta-spending futility bound with AHR + +Need to summarize here. + + +```{r} +betaspending <- gs_power_ahr(enrollRates = enrollRates, failRates = failRates, + upper = gs_b, upar = c(rep(Inf, 2), qnorm(.975)), + lower = gs_spending_bound, + lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, + param = NULL, timing = NULL), + events = 512 * c(.5, .75, 1), + test_lower = c(TRUE, TRUE, FALSE)) +betaspending %>% + summary() %>% as_gt(title="Group sequential design with futility only", + subtitle="Beta-spending futility bound") +``` + +# Classical beta-spending futility bound + +A classical $\beta-$spending bound would assume a constant treatment effect over time using the proportional hazards assumption. We use the average hazard ratio at the fixed design analysis for this purpose. + +# Korn and Freidlin futility bound + +The @kornfreidlin2018 futility bound is set *when at least 50% of the expected events have occurred and at least two thirds of the observed events have occurred later than 3 months from randomization*. +The expected timing for this is demonstrated below. + +## Accumulation of events by time interval + +We consider the accumulation of events over time that occur during the no-effect interval for the first 3 months after randomization and events after this time interval. +This is done for the overall trial without dividing out by treatment group using the `gsDesign2::AHR()` function. +We consider monthly accumulation of events through the 34.86 months planned trial duration. +We note in the summary of early expected events below that all events during the first 3 months on-study are expected prior to the first interim analysis. + +```{r} +event_accumulation <- +AHR(enrollRates = enrollRates, + failRates = failRates, + totalDuration = c(1:34, 34.86), + ratio = 1, + simple = FALSE) +head(event_accumulation, n = 7) %>% gt() +``` + +We can look at the proportion of events after the first 3 months as follows: + +```{r} +event_accumulation %>% + group_by(Time) %>% + summarize(`Total events` = sum(Events), "Proportion early" = first(Events) / `Total events`) %>% + ggplot(aes(x=Time, y=`Proportion early`)) + geom_line() +``` + +For the @kornfreidlin2018 bound the targeted timing is when both 50% of events have occurred and at least 2/3 are more than 3 months after enrollment with 3 months being the delayed effect period. +We see above that about 1/3 of events are still within 3 months of enrollment at month 20. + +## Korn and Freidlin bound + +The bound proposed by @kornfreidlin2018 + + + +# References diff --git a/vignettes/check_AHR.Rmd b/vignettes/check_AHR.Rmd new file mode 100644 index 000000000..a2f25455d --- /dev/null +++ b/vignettes/check_AHR.Rmd @@ -0,0 +1,55 @@ +--- +title: "Test of the function AHR" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + highlight: "textmate" + css: "custom.css" +# bibliography: "example.bib" +vignette: > + %\VignetteEngine{knitr::rmarkdown} + %\VignetteIndexEntry{Test of the function AHR} +--- + +```{r, message=FALSE} +library(tibble) +library(dplyr) +library(testthat) +devtools::load_all() +``` + +# Test 1: unstratified population +```{r} +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(enrollRates = enrollRates, failRates = failRates, totalDuration = c(15, 30)) +x2 <- AHR_(enrollRates = enrollRates, failRates = failRates, totalDuration = c(15, 30)) + +expect_equal(x1, x2) +``` + +# Test 2: stratified population +```{r} +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(enrollRates = enrollRates, failRates = failRates, totalDuration = c(15, 30)) +x2 <- AHR_(enrollRates = enrollRates, failRates = failRates, totalDuration = c(15, 30)) + +expect_equal(x1, x2) +``` + diff --git a/vignettes/check_eEvents_df.Rmd b/vignettes/check_eEvents_df.Rmd new file mode 100644 index 000000000..13671965f --- /dev/null +++ b/vignettes/check_eEvents_df.Rmd @@ -0,0 +1,60 @@ +--- +title: "Test of the function eEvents_df" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + number_sections: true + highlight: "textmate" + css: "custom.css" +vignette: > + %\VignetteEngine{knitr::rmarkdown} + %\VignetteIndexEntry{Test of the function eEvents_df} +--- + +```{r, echo=FALSE, message=FALSE} +library(gt) +library(dplyr) +library(tibble) +#library(gsDesign2) +devtools::load_all() +``` + + +# Test 1 +```{r} +enrollRates <- tibble(duration = c(2, 1, 2), rate = c(5, 10, 20)) +failRates <- tibble(duration = c(1, 1, 1),failRate = c(.05, .02, .01), dropoutRate = .01) +totalDuration <- 20 + +x1 <- gsDesign::eEvents(lambda = failRates$failRate, + S = failRates$duration[1 : (nrow(failRates) - 1)], + eta = failRates$dropoutRate, + gamma = enrollRates$rate, + R = enrollRates$duration, + T = totalDuration)$d + +x2 <- eEvents_df_(enrollRates, failRates, totalDuration, simple = TRUE) + +x3 <- eEvents_df(enrollRates, failRates, totalDuration, simple = TRUE) + +tibble(method = c("gsDesign", "old version", "new version"), + exp_events = c(x1, x2, x3)) %>% gt() +``` + +# Test 2 +```{r} +enrollRates <- tibble(duration = c(1, 1, 8), rate = c(3, 2, 0)) +failRates <- tibble(duration = c(4, Inf), failRate = c(.03, .06), dropoutRate = c(.001, .002)) +totalDuration <- 7 + +x <- eEvents_df(enrollRates, failRates, totalDuration, simple = FALSE) %>% data.frame() +# expected checked with alternate calculations in gsSurvNPH vignette +y <- data.frame(t = c(0, 4), failRate = c(0.03, 0.06), Events = c(0.5642911, 0.5194821)) + +x %>% gt() %>% tab_header(title = "From gsDesign2 new version") + +y %>% gt() %>% tab_header(title = "From gsSurvNPH vignette") +``` + diff --git a/vignettes/check_gridpts_h1_hupdate.Rmd b/vignettes/check_gridpts_h1_hupdate.Rmd new file mode 100644 index 000000000..d80b34b96 --- /dev/null +++ b/vignettes/check_gridpts_h1_hupdate.Rmd @@ -0,0 +1,143 @@ +--- +title: "Test of the functions gridpts, h1, hupdate" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + highlight: "textmate" + css: "custom.css" +# bibliography: "example.bib" +vignette: > + %\VignetteEngine{knitr::rmarkdown} + %\VignetteIndexEntry{Test of the functions gridpts, h1, hupdate} +--- + +```{r, message=FALSE} +library(tibble) +library(dplyr) +library(testthat) +library(gt) +devtools::load_all() +``` + + +# Tests of `gridpts` + +## default (N(0,1)) + +approximate variance of standard normal (i.e., 1) +```{r} +x1 <- gridpts_(mu = 0, a = -20, b = 20, r = 18) +x2 <- gridpts(mu = 0, a = -20, b = 20, r = 18) +x3a <- gsDesign::normalGrid(bounds = c(-10, 10), mu = 0, sigma = 1, r = 18) +x3b <- gsDesign::normalGrid(bounds = c(-20, 20), mu = 0, sigma = 1, r = 18) +x3c <- gsDesign::normalGrid(bounds = c(-80, 80), mu = 0, sigma = 1, r = 18) +``` + + + +```{r, echo=FALSE} +tibble(Rcpp = length(x1$z), + R = length(x2$z), + `C with (a, b) = (-10, 10)` = length(x3a$z), + `C with (a, b) = (-20, 20)` = length(x3b$z), + `C with (a, b) = (-80, 80)` = length(x3c$z)) %>% gt() %>% tab_header("Number of grid points") +``` + +```{r, echo=FALSE} +tibble(diff_z = sum(abs(x1$z - x2$z)), + diff_w = sum(abs(x1$w - x2$w))) %>% gt() %>% tab_header(title = "Difference between Rcpp and R", subtitle = "in gsdmvn") +``` + +```{r, echo=FALSE, warning=FALSE} +tibble(diff_z = sum(abs(x1$z - x3a$z)), + diff_w = sum(abs(x1$w - x3a$gridwgts))) %>% gt() %>% tab_header(title = "Difference between gsDesign (C) and gsdmvn (Rcpp)", subtitle = "under (a, b) = (-10, 10)") +``` + +```{r, echo=FALSE} +tibble(diff_z = sum(abs(x1$z - x3b$z)), + diff_w = sum(abs(x1$w - x3b$gridwgts))) %>% gt() %>% tab_header(title = "Difference between gsDesign and gsdmvn", subtitle = "under (a, b) = (-20, 20)") +``` + +```{r, echo=FALSE} +tibble(diff_z = sum(abs(x1$z - x3b$z)), + diff_w = sum(abs(x1$w - x3b$gridwgts))) %>% gt() %>% tab_header(title = "Difference between gsDesign and gsdmvn", subtitle = "under (a, b) = (-80, 80)") +``` + +## approximate probability of N(0,1) above .95 quantile (i.e., .05) + +```{r} +x1 <- gridpts_(mu = 0, a = qnorm(0.95), b = Inf, r = 18) +x2 <- gridpts(mu = 0, a = qnorm(0.95), b = Inf, r = 18) +x3a <- gsDesign::normalGrid(bounds = c(qnorm(0.95), 10), mu = 0, sigma = 1, r = 18) +x3b <- gsDesign::normalGrid(bounds = c(qnorm(0.95), 20), mu = 0, sigma = 1, r = 18) +x3c <- gsDesign::normalGrid(bounds = c(qnorm(0.95), 80), mu = 0, sigma = 1, r = 18) +``` + +```{r, echo=FALSE} +tibble(Rcpp = length(x1$z), + R = length(x2$z), + `C with (a, b) = (-10, 10)` = length(x3a$z), + `C with (a, b) = (-20, 20)` = length(x3b$z), + `C with (a, b) = (-80, 80)` = length(x3c$z)) %>% gt() %>% tab_header("Number of grid points") +``` + +```{r, echo=FALSE} +tibble(diff_z = sum(abs(x1$z - x2$z)), + diff_w = sum(abs(x1$w - x2$w))) %>% gt() %>% tab_header(title = "Difference between Rcpp and R", subtitle = "in gsdmvn") +``` + +```{r, echo=FALSE, warning=FALSE} +tibble(diff_z = sum(abs(x2$z - x3a$z)), + diff_w = sum(abs(x2$w - x3a$gridwgts))) %>% gt() %>% tab_header(title = "Difference between gsDesign (C) and gsdmvn (Rcpp)", subtitle = "under (a, b) = (-10, 10)") +``` + +```{r, echo=FALSE} +tibble(diff_z = sum(abs(x2$z - x3b$z)), + diff_w = sum(abs(x2$w - x3b$gridwgts))) %>% gt() %>% tab_header(title = "Difference between gsDesign and gsdmvn", subtitle = "under (a, b) = (-20, 20)") +``` + +```{r, echo=FALSE} +tibble(diff_z = sum(abs(x2$z - x3b$z)), + diff_w = sum(abs(x2$w - x3b$gridwgts))) %>% gt() %>% tab_header(title = "Difference between gsDesign and gsdmvn", subtitle = "under (a, b) = (-80, 80)") +``` + + +## approximate probability of N(0.5, 1) above .95 quantile (i.e., .05) + +```{r} +x1 <- gridpts_(mu = 0.5, a = qnorm(0.95), b = Inf, r = 18) +x2 <- gridpts(mu = 0.5, a = qnorm(0.95), b = Inf, r = 18) +x3a <- gsDesign::normalGrid(bounds = c(qnorm(0.95), 10), mu = 0.5, sigma = 1, r = 18) +x3b <- gsDesign::normalGrid(bounds = c(qnorm(0.95), 20), mu = 0.5, sigma = 1, r = 18) +x3c <- gsDesign::normalGrid(bounds = c(qnorm(0.95), 80), mu = 0.5, sigma = 1, r = 18) +``` + +```{r, echo=FALSE} +tibble(Rcpp = length(x1$z), + R = length(x2$z), + `C with (a, b) = (-10, 10)` = length(x3a$z), + `C with (a, b) = (-20, 20)` = length(x3b$z), + `C with (a, b) = (-80, 80)` = length(x3c$z)) %>% gt() %>% tab_header("Number of grid points") +``` + +```{r, echo=FALSE} +tibble(diff_z = sum(abs(x1$z - x2$z)), + diff_w = sum(abs(x1$w - x2$w))) %>% gt() %>% tab_header(title = "Difference between Rcpp and R", subtitle = "in gsdmvn") +``` + +```{r, echo=FALSE, warning=FALSE} +tibble(diff_z = sum(abs(x1$z - x3a$z)), + diff_w = sum(abs(x1$w - x3a$gridwgts))) %>% gt() %>% tab_header(title = "Difference between gsDesign (C) and gsdmvn (Rcpp)", subtitle = "under (a, b) = (-10, 10)") +``` + +```{r, echo=FALSE} +tibble(diff_z = sum(abs(x1$z - x3b$z)), + diff_w = sum(abs(x1$w - x3b$gridwgts))) %>% gt() %>% tab_header(title = "Difference between gsDesign and gsdmvn", subtitle = "under (a, b) = (-20, 20)") +``` + +```{r, echo=FALSE} +tibble(diff_z = sum(abs(x1$z - x3b$z)), + diff_w = sum(abs(x1$w - x3b$gridwgts))) %>% gt() %>% tab_header(title = "Difference between gsDesign and gsdmvn", subtitle = "under (a, b) = (-80, 80)") +``` diff --git a/vignettes/check_gs_design_ahr.Rmd b/vignettes/check_gs_design_ahr.Rmd new file mode 100644 index 000000000..cb3db5520 --- /dev/null +++ b/vignettes/check_gs_design_ahr.Rmd @@ -0,0 +1,294 @@ +--- +title: "Test of the function gs_design_ahr" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + highlight: "textmate" + css: "custom.css" +# bibliography: "example.bib" +vignette: > + %\VignetteEngine{knitr::rmarkdown} + %\VignetteIndexEntry{Test of the function gs_design_ahr} +--- + +```{r, message=FALSE} +library(tibble) +library(dplyr) +library(gt) +library(testthat) +devtools::load_all() +``` + +# Test 1 + +Call with defaults. +```{r} +x1 <- gs_design_ahr() +x2 <- gs_design_ahr_() +``` + +```{r, echo=FALSE} +tibble(version = c(rep("new", 1), rep("old", 1)), + analysis = rep(1, 2), + samplesize = c(x1$analysis$N, x2$bounds$N), + events = c(x1$analysis$Events, x2$bounds$Events), + time = c(x1$analysis$Time, x2$bounds$Time), + theta = c(x1$analysis$theta, x2$bounds$theta), + Z_upper = c((x1$bounds %>% filter(Bound == "Upper"))$Z, (x2$bounds %>% filter(Bound == "Upper"))$Z), + #Z_lower = c((x1$bounds %>% filter(Bound == "Lower"))$Z, NA, NA, (x2 %>% filter(Bound == "Lower"))$Z), + prob_upper = c((x1$bounds %>% filter(Bound == "Upper"))$Probability, (x2$bounds %>% filter(Bound == "Upper"))$Probability), + #prob_lower = c((x1$bounds %>% filter(Bound == "Lower"))$Probability, NA, NA, (x2 %>% filter(Bound == "Upper"))$Probability), + AHR = c(x1$analysis$AHR, x2$bounds$AHR), + info = c(x1$analysis$info, x2$bounds$info), + info0 = c(x1$analysis$info0, x2$bounds$info0) + ) %>% + arrange(analysis) %>% + group_by(analysis) %>% + gt() %>% + tab_style( + style = list(cell_fill(color = "#d3edeb")), + locations = cells_body(rows = `version` == "old")) +``` + +# Test 2 + +Single analysis. +```{r} +x1 <- gs_design_ahr(analysisTimes = 40) +x2 <- gs_design_ahr_(analysisTimes = 40) +``` + +```{r, echo=FALSE} +tibble(version = c(rep("new", 1), rep("old", 1)), + analysis = rep(1, 2), + samplesize = c(x1$analysis$N, x2$bounds$N), + events = c(x1$analysis$Events, x2$bounds$Events), + time = c(x1$analysis$Time, x2$bounds$Time), + theta = c(x1$analysis$theta, x2$bounds$theta), + Z_upper = c((x1$bounds %>% filter(Bound == "Upper"))$Z, (x2$bounds %>% filter(Bound == "Upper"))$Z), + #Z_lower = c((x1$bounds %>% filter(Bound == "Lower"))$Z, NA, NA, (x2 %>% filter(Bound == "Lower"))$Z), + prob_upper = c((x1$bounds %>% filter(Bound == "Upper"))$Probability, (x2$bounds %>% filter(Bound == "Upper"))$Probability), + #prob_lower = c((x1$bounds %>% filter(Bound == "Lower"))$Probability, NA, NA, (x2 %>% filter(Bound == "Upper"))$Probability), + AHR = c(x1$analysis$AHR, x2$bounds$AHR), + info = c(x1$analysis$info, x2$bounds$info), + info0 = c(x1$analysis$info0, x2$bounds$info0) + ) %>% + arrange(analysis) %>% + group_by(analysis) %>% + gt() %>% + tab_style( + style = list(cell_fill(color = "#d3edeb")), + locations = cells_body(rows = `version` == "old")) +``` + +# Test 3 + +Multiple analysisTimes. +```{r} +x1 <- gs_design_ahr(analysisTimes = c(12, 24, 36)) +x2 <- gs_design_ahr_(analysisTimes = c(12, 24, 36)) +``` + +```{r, echo=FALSE} +tibble(version = c(rep("new", 3), rep("old", 3)), + analysis = rep(1:3, 2), + samplesize = c(x1$analysis$N, x2$bounds$N[1:3]), + events = c(x1$analysis$Events, x2$bounds$Events[1:3]), + time = c(x1$analysis$Time, x2$bounds$Time[1:3]), + theta = c(x1$analysis$theta, x2$bounds$theta[1:3]), + Z_upper = c((x1$bounds %>% filter(Bound == "Upper"))$Z, (x2$bounds %>% filter(Bound == "Upper"))$Z), + Z_lower = c((x1$bounds %>% filter(Bound == "Lower"))$Z, (x2$bounds %>% filter(Bound == "Lower"))$Z), + prob_upper = c((x1$bounds %>% filter(Bound == "Upper"))$Probability, (x2$bounds %>% filter(Bound == "Upper"))$Probability), + prob_lower = c((x1$bounds %>% filter(Bound == "Lower"))$Probability, (x2$bounds %>% filter(Bound == "Upper"))$Probability), + AHR = c(x1$analysis$AHR, x2$bounds$AHR[1:3]), + info = c(x1$analysis$info, x2$bounds$info[1:3]), + info0 = c(x1$analysis$info0, x2$bounds$info0[1:3]) + ) %>% + arrange(analysis) %>% + group_by(analysis) %>% + gt() %>% + tab_style( + style = list(cell_fill(color = "#d3edeb")), + locations = cells_body(rows = `version` == "old")) +``` + +# Test 4 + +Specified information fraction +```{r} +x1 <- gs_design_ahr(IF = c(.25, .75, 1), analysisTimes = 36) +x2 <- gs_design_ahr_(IF = c(.25, .75, 1), analysisTimes = 36) +``` + +```{r, echo=FALSE} +tibble(version = c(rep("new", 3), rep("old", 3)), + analysis = rep(1:3, 2), + samplesize = c(x1$analysis$N, x2$bounds$N[1:3]), + events = c(x1$analysis$Events, x2$bounds$Events[1:3]), + time = c(x1$analysis$Time, x2$bounds$Time[1:3]), + theta = c(x1$analysis$theta, x2$bounds$theta[1:3]), + Z_upper = c((x1$bounds %>% filter(Bound == "Upper"))$Z, (x2$bounds %>% filter(Bound == "Upper"))$Z), + Z_lower = c((x1$bounds %>% filter(Bound == "Lower"))$Z, (x2$bounds %>% filter(Bound == "Lower"))$Z), + prob_upper = c((x1$bounds %>% filter(Bound == "Upper"))$Probability, (x2$bounds %>% filter(Bound == "Upper"))$Probability), + prob_lower = c((x1$bounds %>% filter(Bound == "Lower"))$Probability, (x2$bounds %>% filter(Bound == "Upper"))$Probability), + AHR = c(x1$analysis$AHR, x2$bounds$AHR[1:3]), + info = c(x1$analysis$info, x2$bounds$info[1:3]), + info0 = c(x1$analysis$info0, x2$bounds$info0[1:3]) + ) %>% + arrange(analysis) %>% + group_by(analysis) %>% + gt() %>% + tab_style( + style = list(cell_fill(color = "#d3edeb")), + locations = cells_body(rows = `version` == "old")) +``` + +# Test 5 + +Multiple analysis times & IF and driven by times. +```{r} +x1 <- gs_design_ahr(IF = c(.25, .75, 1), analysisTimes = c(12, 25, 36)) +x2 <- gs_design_ahr_(IF = c(.25, .75, 1), analysisTimes = c(12, 25, 36)) +``` + +```{r, echo=FALSE} +tibble(version = c(rep("new", 3), rep("old", 3)), + analysis = rep(1:3, 2), + samplesize = c(x1$analysis$N, x2$bounds$N[1:3]), + events = c(x1$analysis$Events, x2$bounds$Events[1:3]), + time = c(x1$analysis$Time, x2$bounds$Time[1:3]), + theta = c(x1$analysis$theta, x2$bounds$theta[1:3]), + Z_upper = c((x1$bounds %>% filter(Bound == "Upper"))$Z, (x2$bounds %>% filter(Bound == "Upper"))$Z), + Z_lower = c((x1$bounds %>% filter(Bound == "Lower"))$Z, (x2$bounds %>% filter(Bound == "Lower"))$Z), + prob_upper = c((x1$bounds %>% filter(Bound == "Upper"))$Probability, (x2$bounds %>% filter(Bound == "Upper"))$Probability), + prob_lower = c((x1$bounds %>% filter(Bound == "Lower"))$Probability, (x2$bounds %>% filter(Bound == "Upper"))$Probability), + AHR = c(x1$analysis$AHR, x2$bounds$AHR[1:3]), + info = c(x1$analysis$info, x2$bounds$info[1:3]), + info0 = c(x1$analysis$info0, x2$bounds$info0[1:3]) + ) %>% + arrange(analysis) %>% + group_by(analysis) %>% + gt() %>% + tab_style( + style = list(cell_fill(color = "#d3edeb")), + locations = cells_body(rows = `version` == "old")) +``` + +# Test 6 + +Multiple analysis times & IF and driven by IF. +```{r} +x1 <- gs_design_ahr(IF = c(1/3, .8, 1), analysisTimes = c(12, 25, 36)) +x2 <- gs_design_ahr_(IF = c(1/3, .8, 1), analysisTimes = c(12, 25, 36)) +``` + +```{r, echo=FALSE} +tibble(version = c(rep("new", 3), rep("old", 3)), + analysis = rep(1:3, 2), + samplesize = c(x1$analysis$N, x2$bounds$N[1:3]), + events = c(x1$analysis$Events, x2$bounds$Events[1:3]), + time = c(x1$analysis$Time, x2$bounds$Time[1:3]), + theta = c(x1$analysis$theta, x2$bounds$theta[1:3]), + Z_upper = c((x1$bounds %>% filter(Bound == "Upper"))$Z, (x2$bounds %>% filter(Bound == "Upper"))$Z), + Z_lower = c((x1$bounds %>% filter(Bound == "Lower"))$Z, (x2$bounds %>% filter(Bound == "Lower"))$Z), + prob_upper = c((x1$bounds %>% filter(Bound == "Upper"))$Probability, (x2$bounds %>% filter(Bound == "Upper"))$Probability), + prob_lower = c((x1$bounds %>% filter(Bound == "Lower"))$Probability, (x2$bounds %>% filter(Bound == "Upper"))$Probability), + AHR = c(x1$analysis$AHR, x2$bounds$AHR[1:3]), + info = c(x1$analysis$info, x2$bounds$info[1:3]), + info0 = c(x1$analysis$info0, x2$bounds$info0[1:3]) + ) %>% + arrange(analysis) %>% + group_by(analysis) %>% + gt() %>% + tab_style( + style = list(cell_fill(color = "#d3edeb")), + locations = cells_body(rows = `version` == "old")) +``` + + +# Test 7 + +2-sided symmetric design with O'Brien-Fleming spending + +```{r} +x1 <- gs_design_ahr(analysisTimes = 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) +x2 <- gs_design_ahr_(analysisTimes = 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) +``` + +```{r, echo=FALSE} +tibble(version = c(rep("new", 3), rep("old", 3)), + analysis = rep(1:3, 2), + samplesize = c(x1$analysis$N, x2$bounds$N[1:3]), + events = c(x1$analysis$Events, x2$bounds$Events[1:3]), + time = c(x1$analysis$Time, x2$bounds$Time[1:3]), + theta = c(x1$analysis$theta, x2$bounds$theta[1:3]), + Z_upper = c((x1$bounds %>% filter(Bound == "Upper"))$Z, (x2$bounds %>% filter(Bound == "Upper"))$Z), + Z_lower = c((x1$bounds %>% filter(Bound == "Lower"))$Z, (x2$bounds %>% filter(Bound == "Lower"))$Z), + prob_upper = c((x1$bounds %>% filter(Bound == "Upper"))$Probability, (x2$bounds %>% filter(Bound == "Upper"))$Probability), + prob_lower = c((x1$bounds %>% filter(Bound == "Lower"))$Probability, (x2$bounds %>% filter(Bound == "Upper"))$Probability), + AHR = c(x1$analysis$AHR, x2$bounds$AHR[1:3]), + info = c(x1$analysis$info, x2$bounds$info[1:3]), + info0 = c(x1$analysis$info0, x2$bounds$info0[1:3]) + ) %>% + arrange(analysis) %>% + group_by(analysis) %>% + gt() %>% + tab_style( + style = list(cell_fill(color = "#d3edeb")), + locations = cells_body(rows = `version` == "old")) +``` + +# Test 8 + +Pocock lower spending under H1 (NPH). + +```{r} +x1 <- gs_design_ahr(analysisTimes = 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) + +x2 <- gs_design_ahr_(analysisTimes = 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) +``` + +```{r, echo=FALSE} +tibble(version = c(rep("new", 3), rep("old", 3)), + analysis = rep(1:3, 2), + samplesize = c(x1$analysis$N, x2$bounds$N[1:3]), + events = c(x1$analysis$Events, x2$bounds$Events[1:3]), + time = c(x1$analysis$Time, x2$bounds$Time[1:3]), + theta = c(x1$analysis$theta, x2$bounds$theta[1:3]), + Z_upper = c((x1$bounds %>% filter(Bound == "Upper"))$Z, (x2$bounds %>% filter(Bound == "Upper"))$Z), + Z_lower = c((x1$bounds %>% filter(Bound == "Lower"))$Z, (x2$bounds %>% filter(Bound == "Lower"))$Z), + prob_upper = c((x1$bounds %>% filter(Bound == "Upper"))$Probability, (x2$bounds %>% filter(Bound == "Upper"))$Probability), + prob_lower = c((x1$bounds %>% filter(Bound == "Lower"))$Probability, (x2$bounds %>% filter(Bound == "Upper"))$Probability), + AHR = c(x1$analysis$AHR, x2$bounds$AHR[1:3]), + info = c(x1$analysis$info, x2$bounds$info[1:3]), + info0 = c(x1$analysis$info0, x2$bounds$info0[1:3]) + ) %>% + arrange(analysis) %>% + group_by(analysis) %>% + gt() %>% + tab_style( + style = list(cell_fill(color = "#d3edeb")), + locations = cells_body(rows = `version` == "old")) +``` \ No newline at end of file diff --git a/vignettes/check_gs_design_combo.Rmd b/vignettes/check_gs_design_combo.Rmd new file mode 100644 index 000000000..75d6f8766 --- /dev/null +++ b/vignettes/check_gs_design_combo.Rmd @@ -0,0 +1,25 @@ +--- +title: "Test of the function gs_design_combo" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + highlight: "textmate" + css: "custom.css" +# bibliography: "example.bib" +vignette: > + %\VignetteEngine{knitr::rmarkdown} + %\VignetteIndexEntry{Test of the function gs_design_combo} +--- + +```{r, message=FALSE} +library(tibble) +library(dplyr) +library(testthat) +devtools::load_all() +``` + +# Test 1: + +TODO \ No newline at end of file diff --git a/vignettes/check_gs_design_npe.Rmd b/vignettes/check_gs_design_npe.Rmd new file mode 100644 index 000000000..60108a237 --- /dev/null +++ b/vignettes/check_gs_design_npe.Rmd @@ -0,0 +1,300 @@ +--- +title: "Test of the function gs_design_npe" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + number_sections: true + highlight: "textmate" + css: "custom.css" +# bibliography: "example.bib" +vignette: > + %\VignetteEngine{knitr::rmarkdown} + %\VignetteIndexEntry{Test of the function gs_design_npe} +--- + +```{r, message=FALSE} +library(tibble) +library(dplyr) +library(testthat) +library(gt) +devtools::load_all() +``` + +# Test 1: verify by `gs_power_npe` {.tabset} + +## new version +```{r} +x <- gs_design_npe(theta = c(.1, .2, .3), info = (1:3) * 40, beta = 0.1, + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), + lower = gs_spending_bound, + lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), binding = TRUE) +x %>% gt() +``` +The power is 0.9. If we re-use these bounds under alternate hypothesis, then we can get a power close to 0.9. + +```{r} +gs_power_npe(theta = c(.1, .2, .3),info = (1:3) * 40, + upper = gs_b, upar = (x %>% filter(Bound == "Upper"))$Z, + lower = gs_b, lpar = -(x %>% filter(Bound == "Upper"))$Z, + binding = TRUE # Always use binding = TRUE for power calculations + ) %>% gt() +``` + + +## old version +```{r} +x <- gs_design_npe_(theta = c(.1, .2, .3), info = (1:3) * 40, beta = 0.1, + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), + lower = gs_spending_bound, + lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), binding = TRUE) +x %>% gt() +``` +The power is 0.9. If we re-use these bounds under alternate hypothesis, then we can get a power close to 0.9. + +```{r} +gs_power_npe_(theta = c(.1, .2, .3),info = (1:3) * 40, + upper = gs_b, upar = (x %>% filter(Bound == "Upper"))$Z, + lower = gs_b, lpar = -(x %>% filter(Bound == "Upper"))$Z, + binding = TRUE # Always use binding = TRUE for power calculations + ) %>% gt() +``` + + +# Test 1: examples in spec {.tabset} + +## difference of proportions +```{r} +# Lachin book p71 +pc <- .28 # Control response rate +pe <- .40 # Experimental response rate +p0 <- (pc + pe) / 2 # Ave response rate under H0 + +# Information per increment of 1 in sample size +info0 <- 1 / (p0 * (1 - p0) * 4) +info <- 1 / (pc * (1 - pc) * 2 + pe * (1 - pe) * 2) + +# Result should round up to next even number = 652 +# Divide information needed under H1 by information per patient added +x1_a <- gs_design_npe(theta = pe - pc, info = info, info0 = info0, info_scale = 0) %>% mutate(`Computated from` = "new version", `Info scale` = 0) +x1_b <- gs_design_npe(theta = pe - pc, info = info, info0 = info0, info_scale = 1) %>% mutate(`Computated from` = "new version", `Info scale` = 1) +x1_c <- gs_design_npe(theta = pe - pc, info = info, info0 = info0, info_scale = 2) %>% mutate(`Computated from` = "new version", `Info scale` = 2) + +x2 <- gs_design_npe_(theta = pe - pc, info = info, info0 = info0) %>% mutate(`Computated from` = "old version") +``` + +```{r, echo=FALSE} +x1_a %>% + union_all(x1_b) %>% + union_all(x1_c) %>% + union_all(x2) %>% + gt() %>% + tab_style( + style = list(cell_fill(color = "#d3edeb")), + locations = cells_body(rows = `Computated from` == "old version")) +``` + +## fixed design {.tabset} + +### `info` = `info0` = `info1` +```{r} +x1_a <- gs_design_npe(theta = c(.1, .2, .3), + info = (1:3) * 80, info_scale = 0, + upper = gs_b, upar = gsDesign::gsDesign(k = 3, sfu = gsDesign::sfLDOF)$upper$bound, + lower = gs_b, lpar = c(-1, 0, 0)) %>% mutate(`Computated from` = "new version", `Info scale` = 0) +x1_b <- gs_design_npe(theta = c(.1, .2, .3), + info = (1:3) * 80, info_scale = 1, + upper = gs_b, upar = gsDesign::gsDesign(k = 3, sfu = gsDesign::sfLDOF)$upper$bound, + lower = gs_b, lpar = c(-1, 0, 0)) %>% mutate(`Computated from` = "new version", `Info scale` = 1) +x1_c <- gs_design_npe(theta = c(.1, .2, .3), + info = (1:3) * 80, info_scale = 2, + upper = gs_b, upar = gsDesign::gsDesign(k = 3, sfu = gsDesign::sfLDOF)$upper$bound, + lower = gs_b, lpar = c(-1, 0, 0)) %>% mutate(`Computated from` = "new version", `Info scale` = 2) +x2 <- gs_design_npe_(theta = c(.1, .2, .3), + info = (1:3) * 80, + upper = gs_b, upar = gsDesign::gsDesign(k = 3, sfu = gsDesign::sfLDOF)$upper$bound, + lower = gs_b, lpar = c(-1, 0, 0)) %>% mutate(`Computated from` = "old version") +``` + +```{r, echo=FALSE} +x1_a %>% + union_all(x1_b) %>% + union_all(x1_c) %>% + union_all(x2) %>% + arrange(Analysis) %>% + group_by(Analysis, Bound) %>% + gt() %>% + tab_style( + style = list(cell_fill(color = "#d3edeb")), + locations = cells_body(rows = `Computated from` == "old version")) +``` + +### `info` != `info0` != `info1` +```{r} +x1_a <- gs_design_npe(theta = c(.1, .2, .3), + info = (1:3) * 80, info0 = (1:3) * 90 + 10, info1 = (1:3) * 70 - 5, info_scale = 0, + upper = gs_b, upar = gsDesign::gsDesign(k = 3, sfu = gsDesign::sfLDOF)$upper$bound, + lower = gs_b, lpar = c(-1, 0, 0)) %>% mutate(`Computated from` = "new version", `Info scale` = 0) +x1_b <- gs_design_npe(theta = c(.1, .2, .3), + info = (1:3) * 80, info0 = (1:3) * 90+ 10, info1 = (1:3) * 70 - 5, info_scale = 1, + upper = gs_b, upar = gsDesign::gsDesign(k = 3, sfu = gsDesign::sfLDOF)$upper$bound, + lower = gs_b, lpar = c(-1, 0, 0)) %>% mutate(`Computated from` = "new version", `Info scale` = 1) +x1_c <- gs_design_npe(theta = c(.1, .2, .3), + info = (1:3) * 80, info0 = (1:3) * 90+ 10, info1 = (1:3) * 70 - 5, info_scale = 2, + upper = gs_b, upar = gsDesign::gsDesign(k = 3, sfu = gsDesign::sfLDOF)$upper$bound, + lower = gs_b, lpar = c(-1, 0, 0)) %>% mutate(`Computated from` = "new version", `Info scale` = 2) +x2 <- gs_design_npe_(theta = c(.1, .2, .3), + info = (1:3) * 80, info0 = (1:3) * 90+ 10, info1 = (1:3) * 70 - 5, + upper = gs_b, upar = gsDesign::gsDesign(k = 3, sfu = gsDesign::sfLDOF)$upper$bound, + lower = gs_b, lpar = c(-1, 0, 0)) %>% mutate(`Computated from` = "old version") +``` + +```{r, echo=FALSE} +x1_a %>% + union_all(x1_b) %>% + union_all(x1_c) %>% + union_all(x2) %>% + arrange(Analysis) %>% + group_by(Analysis, Bound) %>% + gt() %>% + tab_style( + style = list(cell_fill(color = "#d3edeb")), + locations = cells_body(rows = `Computated from` == "old version")) +``` + + +## futility at IA1; efficacy only at IA2 +FA +```{r} +x1_a <- gs_design_npe(theta = c(.1, .2, .3), + info = (1:3) * 40, info0 = (1:3) * 40, info_scale = 0, + upper = gs_spending_bound, upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), + lower = gs_b, lpar = c(-1, -Inf, -Inf), + test_upper = c(FALSE, TRUE, TRUE)) %>% mutate(`Computated from` = "new version", `Info scale` = 0) + +x1_b <- gs_design_npe(theta = c(.1, .2, .3), + info = (1:3) * 40, info0 = (1:3) * 40, info_scale = 1, + upper = gs_spending_bound, upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), + lower = gs_b, lpar = c(-1, -Inf, -Inf), + test_upper = c(FALSE, TRUE, TRUE)) %>% mutate(`Computated from` = "new version", `Info scale` = 1) + +x1_c <- gs_design_npe(theta = c(.1, .2, .3), + info = (1:3) * 40, info0 = (1:3) * 40, info_scale = 2, + upper = gs_spending_bound, upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), + lower = gs_b, lpar = c(-1, -Inf, -Inf), + test_upper = c(FALSE, TRUE, TRUE)) %>% mutate(`Computated from` = "new version", `Info scale` = 2) + +x2 <- gs_design_npe_(theta = c(.1, .2, .3), + info = (1:3) * 40, info0 = (1:3) * 40, + upper = gs_spending_bound, upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), + lower = gs_b, lpar = c(-1, -Inf, -Inf), + test_upper = c(FALSE, TRUE, TRUE)) %>% mutate(`Computated from` = "old version", `Info scale` = 0) +``` + +```{r} +x1_a %>% + union_all(x1_b) %>% + union_all(x1_c) %>% + union_all(x2) %>% + arrange(Analysis) %>% + group_by(Analysis, Bound) %>% + gt() %>% + tab_style( + style = list(cell_fill(color = "#d3edeb")), + locations = cells_body(rows = `Computated from` == "old version")) +``` + +## spending bounds +```{r} +x1_a <- gs_design_npe(theta = c(.1, .2, .3), + info = (1:3) * 40, info0 = (1:3) * 50, info_scale = 0, + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), + lower = gs_spending_bound, + lpar = list(sf = gsDesign::sfHSD, total_spend = 0.1, param = -1, timing = NULL)) %>% mutate(`Computated from` = "new version", `Info scale` = 0) + +x1_b <- gs_design_npe(theta = c(.1, .2, .3), + info = (1:3) * 40, info0 = (1:3) * 50, info_scale = 1, + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), + lower = gs_spending_bound, + lpar = list(sf = gsDesign::sfHSD, total_spend = 0.1, param = -1, timing = NULL)) %>% mutate(`Computated from` = "new version", `Info scale` = 1) + +x1_c <- gs_design_npe(theta = c(.1, .2, .3), + info = (1:3) * 40, info0 = (1:3) * 50, info_scale = 2, + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), + lower = gs_spending_bound, + lpar = list(sf = gsDesign::sfHSD, total_spend = 0.1, param = -1, timing = NULL)) %>% mutate(`Computated from` = "new version", `Info scale` = 2) + +x2 <- gs_design_npe_(theta = c(.1, .2, .3), + info = (1:3) * 40, info0 = (1:3) * 50, + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), + lower = gs_spending_bound, + lpar = list(sf = gsDesign::sfHSD, total_spend = 0.1, param = -1, timing = NULL)) %>% mutate(`Computated from` = "old version") +``` + +```{r, echo=FALSE} +x1_a %>% + union_all(x1_b) %>% + union_all(x1_c) %>% + union_all(x2) %>% + arrange(Analysis) %>% + group_by(Analysis, Bound) %>% + gt() %>% + tab_style( + style = list(cell_fill(color = "#d3edeb")), + locations = cells_body(rows = `Computated from` == "old version")) +``` + +## 2-sided symmetric spend +```{r} +x1_a <- gs_design_npe(theta = c(.1, .2, .3), + info = (1:3) * 40, info_scale = 0, + binding = TRUE, + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), + lower = gs_spending_bound, + lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL)) %>% mutate(`Computated from` = "new version", `Info scale` = 0) + +x1_b <- gs_design_npe(theta = c(.1, .2, .3), + info = (1:3) * 40, info_scale = 1, + binding = TRUE, + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), + lower = gs_spending_bound, + lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL)) %>% mutate(`Computated from` = "new version", `Info scale` = 1) + +x1_c <- gs_design_npe(theta = c(.1, .2, .3), + info = (1:3) * 40, info_scale = 2, + binding = TRUE, + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), + lower = gs_spending_bound, + lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL)) %>% mutate(`Computated from` = "new version", `Info scale` = 2) + +x2 <- gs_design_npe_(theta = c(.1, .2, .3), + info = (1:3) * 40, + binding = TRUE, + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), + lower = gs_spending_bound, + lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL)) %>% mutate(`Computated from` = "old version") +``` + +```{r, echo=FALSE} +x1_a %>% + union_all(x1_b) %>% + union_all(x1_c) %>% + union_all(x2) %>% + arrange(Analysis) %>% + group_by(Analysis, Bound) %>% + gt() %>% + tab_style( + style = list(cell_fill(color = "#d3edeb")), + locations = cells_body(rows = `Computated from` == "old version")) +``` + diff --git a/vignettes/check_gs_design_wlr.Rmd b/vignettes/check_gs_design_wlr.Rmd new file mode 100644 index 000000000..4ff9d05b8 --- /dev/null +++ b/vignettes/check_gs_design_wlr.Rmd @@ -0,0 +1,25 @@ +--- +title: "Test of the function gs_design_wlr" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + highlight: "textmate" + css: "custom.css" +# bibliography: "example.bib" +vignette: > + %\VignetteEngine{knitr::rmarkdown} + %\VignetteIndexEntry{Test of the function gs_design_wlr} +--- + +```{r, message=FALSE} +library(tibble) +library(dplyr) +library(testthat) +devtools::load_all() +``` + +# Test 1: + +TODO \ No newline at end of file diff --git a/vignettes/check_gs_info_ahr.Rmd b/vignettes/check_gs_info_ahr.Rmd new file mode 100644 index 000000000..1fdedb37a --- /dev/null +++ b/vignettes/check_gs_info_ahr.Rmd @@ -0,0 +1,25 @@ +--- +title: "Test of the function gs_info_ahr" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + highlight: "textmate" + css: "custom.css" +# bibliography: "example.bib" +vignette: > + %\VignetteEngine{knitr::rmarkdown} + %\VignetteIndexEntry{Test of the function gs_info_ahr} +--- + +```{r, message=FALSE} +library(tibble) +library(dplyr) +library(testthat) +devtools::load_all() +``` + +# Test 1: + +TODO \ No newline at end of file diff --git a/vignettes/check_gs_info_combo.Rmd b/vignettes/check_gs_info_combo.Rmd new file mode 100644 index 000000000..76dc7860f --- /dev/null +++ b/vignettes/check_gs_info_combo.Rmd @@ -0,0 +1,25 @@ +--- +title: "Test of the function gs_info_combo" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + highlight: "textmate" + css: "custom.css" +# bibliography: "example.bib" +vignette: > + %\VignetteEngine{knitr::rmarkdown} + %\VignetteIndexEntry{Test of the function gs_info_combo} +--- + +```{r, message=FALSE} +library(tibble) +library(dplyr) +library(testthat) +devtools::load_all() +``` + +# Test 1: + +TODO \ No newline at end of file diff --git a/vignettes/check_gs_info_wlr.Rmd b/vignettes/check_gs_info_wlr.Rmd new file mode 100644 index 000000000..d28cb0f11 --- /dev/null +++ b/vignettes/check_gs_info_wlr.Rmd @@ -0,0 +1,25 @@ +--- +title: "Test of the function gs_info_wlr" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + highlight: "textmate" + css: "custom.css" +# bibliography: "example.bib" +vignette: > + %\VignetteEngine{knitr::rmarkdown} + %\VignetteIndexEntry{Test of the function gs_info_wlr} +--- + +```{r, message=FALSE} +library(tibble) +library(dplyr) +library(testthat) +devtools::load_all() +``` + +# Test 1: + +TODO \ No newline at end of file diff --git a/vignettes/check_gs_power_ahr.Rmd b/vignettes/check_gs_power_ahr.Rmd new file mode 100644 index 000000000..38bdb5e30 --- /dev/null +++ b/vignettes/check_gs_power_ahr.Rmd @@ -0,0 +1,180 @@ +--- +title: "Test of the function gs_power_ahr" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + highlight: "textmate" + css: "custom.css" +# bibliography: "example.bib" +vignette: > + %\VignetteEngine{knitr::rmarkdown} + %\VignetteIndexEntry{Test of the function gs_power_ahr} +--- + +```{r, message=FALSE} +library(tibble) +library(dplyr) +library(gt) +library(testthat) +devtools::load_all() +``` + +# Test 1 + +```{r} +x1 <- gs_power_ahr() +x2 <- gs_power_ahr_() +``` + +```{r, echo=FALSE} +tibble(version = c(rep("new", 3), rep("old", 3)), + analysis = rep(1:3, 2), + samplesize = c(x1$analysis$N, rep(NA, 3)), + events = c(x1$analysis$Events, x2$Events[1:3]), + time = c(x1$analysis$Time, x2$Time[1:3]), + theta = c(x1$analysis$theta, x2$theta[1:3]), + Z_upper = c((x1$bounds %>% filter(Bound == "Upper"))$Z, (x2 %>% filter(Bound == "Upper"))$Z), + Z_lower = c((x1$bounds %>% filter(Bound == "Lower"))$Z, (x2 %>% filter(Bound == "Lower"))$Z), + prob_upper = c((x1$bounds %>% filter(Bound == "Upper"))$Probability, (x2 %>% filter(Bound == "Upper"))$Probability), + prob_lower = c((x1$bounds %>% filter(Bound == "Lower"))$Probability, (x2 %>% filter(Bound == "Lower"))$Probability), + AHR = c(x1$analysis$AHR, x2$AHR[1:3]), + info = c(x1$analysis$info, x2$info[1:3]), + info0 = c(x1$analysis$info0, x2$info0[1:3]) + ) %>% + arrange(analysis) %>% + group_by(analysis) %>% + gt() %>% + tab_style( + style = list(cell_fill(color = "#d3edeb")), + locations = cells_body(rows = `version` == "old")) +``` + +# Test 2 + +```{r} +x1 <- gs_power_ahr(analysisTimes = c(12, 24, 36), + events = NULL, + 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)) + +x2 <- gs_power_ahr_(analysisTimes = c(12, 24, 36), + events = NULL, + 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)) +``` + +```{r, echo=FALSE} +tibble(version = c(rep("new", 3), rep("old", 3)), + analysis = rep(1:3, 2), + samplesize = c(x1$analysis$N, rep(NA, 3)), + events = c(x1$analysis$Events, x2$Events[1:3]), + time = c(x1$analysis$Time, x2$Time[1:3]), + theta = c(x1$analysis$theta, x2$theta[1:3]), + Z_upper = c((x1$bounds %>% filter(Bound == "Upper"))$Z, (x2 %>% filter(Bound == "Upper"))$Z), + Z_lower = c((x1$bounds %>% filter(Bound == "Lower"))$Z, (x2 %>% filter(Bound == "Lower"))$Z), + prob_upper = c((x1$bounds %>% filter(Bound == "Upper"))$Probability, (x2 %>% filter(Bound == "Upper"))$Probability), + prob_lower = c((x1$bounds %>% filter(Bound == "Lower"))$Probability, (x2 %>% filter(Bound == "Lower"))$Probability), + AHR = c(x1$analysis$AHR, x2$AHR[1:3]), + info = c(x1$analysis$info, x2$info[1:3]), + info0 = c(x1$analysis$info0, x2$info0[1:3]) + ) %>% + arrange(analysis) %>% + group_by(analysis) %>% + gt() %>% + tab_style( + style = list(cell_fill(color = "#d3edeb")), + locations = cells_body(rows = `version` == "old")) +``` + +# Test 3 +```{r} +x1 <- gs_power_ahr(analysisTimes = NULL, + events = c(20, 50, 70), + 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)) + +x2 <- gs_power_ahr_(analysisTimes = NULL, + events = c(20, 50, 70), + 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)) +``` + +```{r, echo=FALSE} +tibble(version = c(rep("new", 3), rep("old", 3)), + analysis = rep(1:3, 2), + samplesize = c(x1$analysis$N, rep(NA, 3)), + events = c(x1$analysis$Events, x2$Events[1:3]), + time = c(x1$analysis$Time, x2$Time[1:3]), + theta = c(x1$analysis$theta, x2$theta[1:3]), + Z_upper = c((x1$bounds %>% filter(Bound == "Upper"))$Z, (x2 %>% filter(Bound == "Upper"))$Z), + Z_lower = c((x1$bounds %>% filter(Bound == "Lower"))$Z, (x2 %>% filter(Bound == "Lower"))$Z), + prob_upper = c((x1$bounds %>% filter(Bound == "Upper"))$Probability, (x2 %>% filter(Bound == "Upper"))$Probability), + prob_lower = c((x1$bounds %>% filter(Bound == "Lower"))$Probability, (x2 %>% filter(Bound == "Lower"))$Probability), + AHR = c(x1$analysis$AHR, x2$AHR[1:3]), + info = c(x1$analysis$info, x2$info[1:3]), + info0 = c(x1$analysis$info0, x2$info0[1:3]) + ) %>% + arrange(analysis) %>% + group_by(analysis) %>% + gt() %>% + tab_style( + style = list(cell_fill(color = "#d3edeb")), + locations = cells_body(rows = `version` == "old")) +``` + +# Test 4 +```{r} +x1 <- gs_power_ahr(analysisTimes = c(12, 24, 36), + events = c(30, 40, 50), + 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)) + +x2 <- gs_power_ahr_(analysisTimes = c(12, 24, 36), + events = c(30, 40, 50), + 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)) + +``` + +```{r, echo=FALSE} +tibble(version = c(rep("new", 3), rep("old", 3)), + analysis = rep(1:3, 2), + samplesize = c(x1$analysis$N, rep(NA, 3)), + events = c(x1$analysis$Events, x2$Events[1:3]), + time = c(x1$analysis$Time, x2$Time[1:3]), + theta = c(x1$analysis$theta, x2$theta[1:3]), + Z_upper = c((x1$bounds %>% filter(Bound == "Upper"))$Z, (x2 %>% filter(Bound == "Upper"))$Z), + Z_lower = c((x1$bounds %>% filter(Bound == "Lower"))$Z, (x2 %>% filter(Bound == "Lower"))$Z), + prob_upper = c((x1$bounds %>% filter(Bound == "Upper"))$Probability, (x2 %>% filter(Bound == "Upper"))$Probability), + prob_lower = c((x1$bounds %>% filter(Bound == "Lower"))$Probability, (x2 %>% filter(Bound == "Lower"))$Probability), + AHR = c(x1$analysis$AHR, x2$AHR[1:3]), + info = c(x1$analysis$info, x2$info[1:3]), + info0 = c(x1$analysis$info0, x2$info0[1:3]) + ) %>% + arrange(analysis) %>% + group_by(analysis) %>% + gt() %>% + tab_style( + style = list(cell_fill(color = "#d3edeb")), + locations = cells_body(rows = `version` == "old")) +``` \ No newline at end of file diff --git a/vignettes/check_gs_power_combo.Rmd b/vignettes/check_gs_power_combo.Rmd new file mode 100644 index 000000000..bfa425888 --- /dev/null +++ b/vignettes/check_gs_power_combo.Rmd @@ -0,0 +1,25 @@ +--- +title: "Test of the function gs_power_combo" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + highlight: "textmate" + css: "custom.css" +# bibliography: "example.bib" +vignette: > + %\VignetteEngine{knitr::rmarkdown} + %\VignetteIndexEntry{Test of the function gs_power_combo} +--- + +```{r, message=FALSE} +library(tibble) +library(dplyr) +library(testthat) +devtools::load_all() +``` + +# Test 1: + +TODO \ No newline at end of file diff --git a/vignettes/check_gs_power_npe.Rmd b/vignettes/check_gs_power_npe.Rmd new file mode 100644 index 000000000..bd570883b --- /dev/null +++ b/vignettes/check_gs_power_npe.Rmd @@ -0,0 +1,450 @@ +--- +title: "Test of the function gs_power_npe" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + number_sections: true + highlight: "textmate" + css: "custom.css" +bibliography: "ggsd.bib" +vignette: > + %\VignetteEngine{knitr::rmarkdown} + %\VignetteIndexEntry{Test of the function gs_power_npe} + %\VignetteEncoding{UTF-8} +--- + +```{r setup, include=FALSE, message=FALSE, warning=FALSE} +knitr::opts_chunk$set(echo = TRUE) +``` + +```{r, echo=FALSE, message=FALSE} +library(gt) +library(dplyr) +library(tibble) +library(testthat) +library(gsDesign) +#library(gsDesign2) +devtools::load_all() +``` + + +# Test 1: Examples from spec + +## Default +The default of `gs_power_npe` is a single analysis with type I error controlled. +```{r} +x1 <- gs_power_npe(theta = 0) %>% filter(Bound == "Upper") +x2 <- gsDesign2:::gs_power_npe_(theta = 0) %>% filter(Bound == "Upper") +``` + +```{r, echo=FALSE} +x1 %>% + union_all(x2) %>% + mutate(`Computated from` = c("new version", "old version")) %>% + gt() %>% + tab_style( + style = list(cell_fill(color = "#d3edeb")), + locations = cells_body(rows = `Computated from` == "old version")) +``` + +## Fixed bound +```{r} +x1 <- gs_power_npe(theta = c(.1, .2, .3), + info = (1:3) * 40, + upper = gs_b, + upar = gsDesign::gsDesign(k = 3,sfu = gsDesign::sfLDOF)$upper$bound, + lower = gs_b, + lpar = c(-1, 0, 0)) %>% mutate(`Computated from` = "new version") + +x2 <- gs_power_npe_(theta = c(.1, .2, .3), + info = (1:3) * 40, + upper = gs_b, + upar = gsDesign::gsDesign(k = 3,sfu = gsDesign::sfLDOF)$upper$bound, + lower = gs_b, + lpar = c(-1, 0, 0)) %>% mutate(`Computated from` = "old version") +``` + +```{r, echo=FALSE} +x1 %>% + union_all(x2) %>% + gt() %>% + tab_style( + style = list(cell_fill(color = "#d3edeb")), + locations = cells_body(rows = `Computated from` == "old version")) +``` + +## Same fixed efficacy bounds, no futility bound (i.e., non-binding bound), null hypothesis +```{r} +x1 <- gs_power_npe(theta = rep(0, 3), + info = (1:3) * 40, + upar = gsDesign::gsDesign(k = 3,sfu = gsDesign::sfLDOF)$upper$bound, + lpar = rep(-Inf, 3)) %>% mutate(`Computated from` = "new version") + +x2 <- gs_power_npe_(theta = rep(0, 3), + info = (1:3) * 40, + upar = gsDesign::gsDesign(k = 3,sfu = gsDesign::sfLDOF)$upper$bound, + lpar = rep(-Inf, 3)) %>% mutate(`Computated from` = "old version") +``` + +```{r, echo=FALSE} +x1 %>% + union_all(x2) %>% + gt() %>% + tab_style( + style = list(cell_fill(color = "#d3edeb")), + locations = cells_body(rows = `Computated from` == "old version")) +``` + + +## Fixed bound with futility only at analysis 1; efficacy only at analyses 2, 3 +```{r} +x1 <- gs_power_npe(theta = c(.1, .2, .3), + info = (1:3) * 40, + upper = gs_b, + upar = c(Inf, 3, 2), + lower = gs_b, + lpar = c(qnorm(.1), -Inf, -Inf)) %>% mutate(`Computated from` = "new version") + +x2 <- gs_power_npe_(theta = c(.1, .2, .3), + info = (1:3) * 40, + upper = gs_b, + upar = c(Inf, 3, 2), + lower = gs_b, + lpar = c(qnorm(.1), -Inf, -Inf)) %>% mutate(`Computated from` = "old version") +``` + +```{r, echo=FALSE} +x1 %>% + union_all(x2) %>% + gt() %>% + tab_style( + style = list(cell_fill(color = "#d3edeb")), + locations = cells_body(rows = `Computated from` == "old version")) +``` + +## Spending function bounds +```{r} +# Lower spending based on non-zero effect +x1 <- gs_power_npe(theta = c(.1, .2, .3), + info = (1:3) * 40, + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), + lower = gs_spending_bound, + lpar = list(sf = gsDesign::sfHSD, total_spend = 0.1, param = -1, timing = NULL)) %>% mutate(`Computated from` = "new version") + +x2 <- gs_power_npe_(theta = c(.1, .2, .3), + info = (1:3) * 40, + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), + lower = gs_spending_bound, + lpar = list(sf = gsDesign::sfHSD, total_spend = 0.1, param = -1, timing = NULL)) %>% mutate(`Computated from` = "old version") +``` + +```{r, echo=FALSE} +x1 %>% + union_all(x2) %>% + gt() %>% + tab_style( + style = list(cell_fill(color = "#d3edeb")), + locations = cells_body(rows = `Computated from` == "old version")) +``` + +## Same bounds, but power under different theta +```{r} +x1 <- gs_power_npe(theta = c(.15, .25, .35), + info = (1:3) * 40, + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), + lower = gs_spending_bound, + lpar = list(sf = gsDesign::sfHSD, total_spend = 0.1, param = -1, timing = NULL)) %>% mutate(`Computated from` = "new version") + +x2 <- gs_power_npe_(theta = c(.15, .25, .35), + info = (1:3) * 40, + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), + lower = gs_spending_bound, + lpar = list(sf = gsDesign::sfHSD, total_spend = 0.1, param = -1, timing = NULL)) %>% mutate(`Computated from` = "old version") +``` + +```{r, echo=FALSE} +x1 %>% + union_all(x2) %>% + gt() %>% + tab_style( + style = list(cell_fill(color = "#d3edeb")), + locations = cells_body(rows = `Computated from` == "old version")) +``` + +## Two-sided symmetric spend, O'Brien-Fleming spending +Typically, 2-sided bounds are binding +```{r} +x1 <- gs_power_npe(theta = rep(0, 3), + info = (1:3) * 40, + binding = TRUE, + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), + lower = gs_spending_bound, + lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL)) %>% mutate(`Computated from` = "new version") + +x2 <- gs_power_npe_(theta = rep(0, 3), + info = (1:3) * 40, + binding = TRUE, + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), + lower = gs_spending_bound, + lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL)) %>% mutate(`Computated from` = "old version") +``` + +```{r, echo=FALSE} +x1 %>% + union_all(x2) %>% + gt() %>% + tab_style( + style = list(cell_fill(color = "#d3edeb")), + locations = cells_body(rows = `Computated from` == "old version")) +``` + +## Re-use these bounds under alternate hypothesis +Always use binding = TRUE for power calculations +```{r} +xx1 <- gs_power_npe(theta = c(.1, .2, .3), + info = (1:3) * 40, + binding = TRUE, + upar = (x1 %>% filter(Bound == "Upper"))$Z, + lpar = -(x1 %>% filter(Bound == "Upper"))$Z) %>% mutate(`Computated from` = "new version") + +xx2 <- gs_power_npe_(theta = c(.1, .2, .3), + info = (1:3) * 40, + binding = TRUE, + upar = (x1 %>% filter(Bound == "Upper"))$Z, + lpar = -(x1 %>% filter(Bound == "Upper"))$Z) %>% mutate(`Computated from` = "old version") +``` + +```{r, echo=FALSE} +xx1 %>% + union_all(xx2) %>% + gt() %>% + tab_style( + style = list(cell_fill(color = "#d3edeb")), + locations = cells_body(rows = `Computated from` == "old version")) +``` + + + + + +# Test 2: Fixed Design +The power at the following analysis is expected at 0.975. + +```{r} +gs_power_npe(theta = 0, + upper = gs_b, upar = qnorm(0.025), + lower = gs_b, lpar = -Inf) +``` + + +# Test 3: `info` != `info0` != `info1` + +If one inputs `info` in `upar` +```{r} +x1_a <- gs_power_npe(theta = c(.1, .2, .3), + info = (1:3) * 80, info0 = (1:3) * 90 + 10, info1 = (1:3) * 70 - 5, info_scale = 0, + upper = gs_b, upar = gsDesign::gsDesign(k = 3, sfu = gsDesign::sfLDOF)$upper$bound, + lower = gs_b, lpar = c(-1, 0, 0)) %>% mutate(`Computated from` = "new version", `Info scale` = 0) +x1_b <- gs_power_npe(theta = c(.1, .2, .3), + info = (1:3) * 80, info0 = (1:3) * 90 + 10, info1 = (1:3) * 70 - 5, info_scale = 1, + upper = gs_b, upar = gsDesign::gsDesign(k = 3, sfu = gsDesign::sfLDOF)$upper$bound, + lower = gs_b, lpar = c(-1, 0, 0)) %>% mutate(`Computated from` = "new version", `Info scale` = 1) +x1_c <- gs_power_npe(theta = c(.1, .2, .3), + info = (1:3) * 80, info0 = (1:3) * 90 + 10, info1 = (1:3) * 70 - 5, info_scale = 2, + upper = gs_b, upar = gsDesign::gsDesign(k = 3, sfu = gsDesign::sfLDOF)$upper$bound, + lower = gs_b, lpar = c(-1, 0, 0)) %>% mutate(`Computated from` = "new version", `Info scale` = 2) +x2 <- gs_power_npe_(theta = c(.1, .2, .3), + info = (1:3) * 80, info0 = (1:3) * 90 + 10, info1 = (1:3) * 70 - 5, + upper = gs_b, upar = gsDesign::gsDesign(k = 3, sfu = gsDesign::sfLDOF)$upper$bound, + lower = gs_b, lpar = c(-1, 0, 0)) %>% mutate(`Computated from` = "old version") +``` + +```{r} +x1_a %>% + union_all(x1_b) %>% + union_all(x1_c) %>% + union_all(x2) %>% + arrange(Analysis) %>% + group_by(Analysis, Bound) %>% + gt() %>% + tab_style( + style = list(cell_fill(color = "#d3edeb")), + locations = cells_body(rows = `Computated from` == "old version")) +``` + +# Test 3: Developer Tests + +## 1-sided test +```{r} +r = 80 +x <- gs_power_npe(theta = 0, + info = (1:3) * 400, + binding = FALSE, r = r, + upper = gs_b, #gs_spending_bound, + upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF)$upper$bound, + #list(par = list(sf = gsDesign::sfLDOF, param = NULL, total_spend = 0.025)), + lower = gs_b, + lpar = rep(-Inf, 3)) %>% filter(Bound == "Upper") + +y <- gsDesign2:::gs_power_npe_(theta = 0, + info = (1:3) * 400, + binding = FALSE, r = r, + upper = gs_b, #gs_spending_bound, + upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF)$upper$bound, + #list(par = list(sf = gsDesign::sfLDOF, param = NULL, total_spend = 0.025)), + lower = gs_b, + lpar = rep(-Inf, 3)) %>% filter(Bound == "Upper") + +z <- gsProbability(k = 3, + theta = 0, + n.I = (1:3) * 400, + b = gsDesign(k = 3, test.type = 1, sfu = sfLDOF)$upper$bound, a = rep(-20, 3), r = r) +``` + +```{r, echo=FALSE} +tibble(`Calculated from` = rep(c("new version", "old version", "gsDesign"), each = 3), + Analysis = rep(1:3, 3), + `upper bound` = c(x %>% filter(Bound == "Upper") %>% select(Z) %>% unlist() %>% as.numeric(), + y %>% filter(Bound == "Upper") %>% select(Z) %>% unlist() %>% as.numeric(), + z$upper$bound), + `upper prob` = c(x %>% filter(Bound == "Upper") %>% select(Probability) %>% unlist() %>% as.numeric(), + y %>% filter(Bound == "Upper") %>% select(Probability) %>%unlist() %>% as.numeric(), + cumsum(z$upper$prob))) %>% + arrange(Analysis) %>% + group_by(Analysis) %>% + gt() +``` + + + +# Test 4: Independent Tests + +## Expect equal with mvtnorm for efficacy and futility bounds +```{r} +info <- c(40, 100) +r <- info[1] / info[2] + +test<-gs_power_npe(theta = 0, + info = info, + info0 = NULL, + binding = FALSE, + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, param = NULL, total_spend = 0.025), + lower = gs_spending_bound, + lpar = list(sf = gsDesign::sfLDOF, param = NULL, total_spend = 0.02) +) + +test1 <- test%>% filter(Bound == "Upper") +test2 <- test%>% filter(Bound == "Lower") + +alpha.t <- 0.025 +b.ia <- gsDesign::sfLDOF(alpha = alpha.t, t = r) +alpha.ia <- b.ia$spend + +Pb <- function(alpha.t, alpha.ia, r, b){ + temp = mvtnorm::pmvnorm(lower = c(-Inf, b), + upper = c(qnorm(1-alpha.ia), Inf), + corr = rbind(c(1, sqrt(r)), c(sqrt(r), 1))) + return(alpha.t - alpha.ia - temp) +} + +b <- uniroot(Pb, c(1.96, 4), alpha.t = alpha.t, alpha.ia = alpha.ia, r = r) + +pb <- 1- pnorm(b$root) + +expect_equal(object = test1$Z, expected = c(qnorm(1-alpha.ia),b$root), tolerance = 0.001) +expect_equal(object = test1$Probability, expected = cumsum(c(b.ia$spend,pb)), tolerance = 0.001) + + beta.t <- 0.02 + a.ia <- gsDesign::sfLDOF(alpha = beta.t, t = r) + beta.ia <- a.ia$spend + + Pa <- function(beta.t, beta.ia, r, a){ + temp <- mvtnorm::pmvnorm(lower = c(-Inf, qnorm(beta.ia)), + upper = c(a, Inf), + corr = rbind(c(1, sqrt(r)), c(sqrt(r), 1))) + return(beta.t - beta.ia - temp) + } + + a <- uniroot(Pa, c(-4, 1.96), beta.t = beta.t, beta.ia = beta.ia, r = r) + + pa <- pnorm(a$root) + + expect_equal(object = test2$Z, expected = c(qnorm(beta.ia), a$root), tolerance = 0.001) + expect_equal(object = test2$Probability, expected = cumsum(c(a.ia$spend,pa)), tolerance = 0.001) +``` + +## Expect equal with `gsDesign::gsProbability` outcome for efficacy bounds + +```{r} +info <- c(40, 150, 200) + +x <- gs_power_npe(theta = .1, + info = info, binding = FALSE, + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, param = NULL, total_spend = 0.025), + lower = gs_b, + lpar = rep(-Inf, 3)) %>% filter(Bound == "Upper") + +y <- gs_power_npe(theta = .1, + info = info, binding = FALSE, + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, param = NULL, total_spend = 0.025), + lower = gs_b, + lpar = rep(-Inf, 3)) %>% filter(Bound == "Upper") + +z <- gsDesign::gsProbability(k = 3, theta = .1, + n.I = info, + a = rep(-20, 3), + b = gsDesign(k = 3, test.type=1, sfu = sfLDOF, n.I = info)$upper$bound) +``` + +```{r, echo=FALSE} +tibble(`Calculated from` = rep(c("new version", "old version", "gsDesign"), each = 3), + Analysis = rep(1:3, 3), + `upper bound` = c(x %>% filter(Bound == "Upper") %>% select(Z) %>% unlist() %>% as.numeric(), + y %>% filter(Bound == "Upper") %>% select(Z) %>% unlist() %>% as.numeric(), + z$upper$bound), + `upper prob` = c(x %>% filter(Bound == "Upper") %>% select(Probability) %>% unlist() %>% as.numeric(), + y %>% filter(Bound == "Upper") %>% select(Probability) %>%unlist() %>% as.numeric(), + cumsum(z$upper$prob))) %>% + arrange(Analysis) %>% + group_by(Analysis) %>% + gt() +``` + + +# Test 5: Compare with `gsDesign` under information-based design + +Information-based design is useful when testing for a natural parameter $\delta$ (e.g., treatment difference on a relevant scale such as risk difference) where the variance of the estimate of $\delta$ is unknown. +The basic *canonical form* of represents information-based design, so it is a particularly simple way to check corresponding basic calculations for sample size, bounds and power in `gs_power_npe()` and `gs_design_npe()`. + +## Step 1: set the design assumptions + +```{r} +k <- 2 # Number of analyses +test.type <- 4 +alpha <- 0.025 # 1-sided Type I error +beta <- 0.15 # Type 2 error (1 - targeted power) +astar <- .1 +timing <- 0.4 # Timing (information fraction) at interim analyses +sfu <- sfHSD # Efficacy bound spending function +sfupar <- -1 # Upper bound spending function parameters, if any +sfl <- sfLDPocock# Lower bound spending function, if used (test.type > 2) +sflpar <- 0 # Lower bound spending function parameters, if any +delta <- 0.1 # Natural parameter difference (assumed value - H0 value) +delta1 <- 0.1 # Natural parameter assumed value +delta0 <- 0 # Natural parameter difference under H0 +endpoint <- 'info' +n.fix <- 0 +``` + +# References \ No newline at end of file diff --git a/vignettes/check_gs_power_wlr.Rmd b/vignettes/check_gs_power_wlr.Rmd new file mode 100644 index 000000000..417182109 --- /dev/null +++ b/vignettes/check_gs_power_wlr.Rmd @@ -0,0 +1,25 @@ +--- +title: "Test of the function gs_power_wlr" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + highlight: "textmate" + css: "custom.css" +# bibliography: "example.bib" +vignette: > + %\VignetteEngine{knitr::rmarkdown} + %\VignetteIndexEntry{Test of the function gs_power_wlr} +--- + +```{r, message=FALSE} +library(tibble) +library(dplyr) +library(testthat) +devtools::load_all() +``` + +# Test 1: + +TODO \ No newline at end of file diff --git a/vignettes/check_tEvents.Rmd b/vignettes/check_tEvents.Rmd new file mode 100644 index 000000000..f491d39a3 --- /dev/null +++ b/vignettes/check_tEvents.Rmd @@ -0,0 +1,67 @@ +--- +title: "Test of the function tEvents" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + number_sections: true + highlight: "textmate" + css: "custom.css" +vignette: > + %\VignetteEngine{knitr::rmarkdown} + %\VignetteIndexEntry{Test of the function tEvents} +--- + +```{r, echo=FALSE, message=FALSE} +library(gt) +library(dplyr) +library(tibble) +#library(gsDesign2) +devtools::load_all() +``` + + +# Test 1 + +In this test, we verify `tEvents()` by `AHR()`. +```{r} +enrollRates <- tibble(Stratum = "All", duration = c(2, 2, 10), rate = c(3, 6, 9) * 5) +failRates <- tibble(Stratum = "All", duration = c(3, 100), failRate = log(2) / c(9, 18), hr = c(.9, .6), dropoutRate = rep(.001, 2)) +ratio <- 1 + +x <- AHR(enrollRates = enrollRates, failRates = failRates, + ratio = ratio, totalDuration = 20) +cat("The number of events by 20 months is ", x$Events, ".\n") + +y <- tEvents(enrollRates = enrollRates, failRates = failRates, + ratio = ratio, targetEvents = x$Events) + +cat("The time to get ", x$Events, " is ", y$Time, "months.\n") +``` + +# Test 2 +```{r} +x1 <- tEvents() +x2 <- gsDesign2:::tEvents_() + +x1 %>% + union_all(x2) %>% + mutate(`function comes from` = c("new version", "old version")) %>% + select(`function comes from`, Time, AHR, Events, info, info0) +``` + +# Test 3 +```{r} +enrollRates <- tibble(Stratum = "All", duration = c(2, 2, 10), rate = c(3, 6, 9) * 5) +failRates <- tibble(Stratum = "All", duration = c(3, 100), failRate = log(2) / c(9, 18), hr = c(.9, .6), dropoutRate = rep(.001, 2)) +ratio <- 1 + +x1 <- tEvents(enrollRates = enrollRates, failRates = failRates, ratio = ratio, targetEvents = 200) +x2 <- gsDesign2:::tEvents_(enrollRates = enrollRates, failRates = failRates, ratio = ratio, targetEvents = 200) + +x1 %>% + union_all(x2) %>% + mutate(`function comes from` = c("new version", "old version")) %>% + select(`function comes from`, Time, AHR, Events, info, info0) +``` diff --git a/vignettes/custom.css b/vignettes/custom.css new file mode 100644 index 000000000..30540029f --- /dev/null +++ b/vignettes/custom.css @@ -0,0 +1,122 @@ +body { + font-family: -apple-system, BlinkMacSystemFont, "Segoe UI", Roboto, "Helvetica Neue", Arial, "Noto Sans", "Liberation Sans", sans-serif, "Apple Color Emoji", "Segoe UI Emoji", "Segoe UI Symbol", "Noto Color Emoji"; + font-size: 16px; + line-height: 1.5; + color: #000; + padding-top: 25px; + padding-bottom: 25px; +} + +h1.title { + padding-bottom: 10px; +} + +h1, h2, h3, h4, h5, h6 { + color: #000; + font-weight: 500; +} + +h1.title { + font-size: 38px; +} + +h1 { + font-size: 32px; +} + +h2 { + font-size: 28px; +} + +h3 { + font-size: 24px; +} + +h4 { + font-size: 20px; +} + +h5 { + font-size: 18px; +} + +h6 { + font-size: 16px; +} + +h4.author { + padding-bottom: 10px; +} + +h4.author>em { + font-size: 14px; + font-style: normal; + font-weight: 300; +} + +h4.date { + padding-bottom: 10px; +} + +h4.date>em { + font-size: 14px; + font-style: normal; + font-weight: 300; +} + +a { + color: #00857c; + text-decoration: none; +} + +a:hover, a:focus, a:active { + color: #005c55; + text-decoration: underline; +} + +a:focus { + outline: thin dotted; +} + +a:hover, a:active { + outline: 0; +} + +pre, code { + font-family: SFMono-Regular, Menlo, Monaco, Consolas, "Liberation Mono", "Courier New", monospace; + background-color: #F7F7F7; +} + +/* selection */ + +::-moz-selection { + background: #6eceb2; +} + +::selection { + background: #6eceb2; +} + +/* float toc */ + +.list-group-item.active, .list-group-item.active:focus, .list-group-item.active:hover { + background-color: #00857C; + border-color: #00857C; +} + +/* figure */ + +div.figure { + text-align: center; +} + +p.caption { + text-align: center; +} + +.footnote { + position: absolute; + bottom: 3em; + padding-right: 4em; + color: #00857C; +} \ No newline at end of file diff --git a/vignettes/figures/east_n_fix.png b/vignettes/figures/east_n_fix.png new file mode 100644 index 000000000..c0296e8e1 Binary files /dev/null and b/vignettes/figures/east_n_fix.png differ diff --git a/vignettes/figures/east_n_gs.png b/vignettes/figures/east_n_gs.png new file mode 100644 index 000000000..125205f1b Binary files /dev/null and b/vignettes/figures/east_n_gs.png differ diff --git a/vignettes/figures/east_n_gs_pool.png b/vignettes/figures/east_n_gs_pool.png new file mode 100644 index 000000000..65991f462 Binary files /dev/null and b/vignettes/figures/east_n_gs_pool.png differ diff --git a/vignettes/figures/east_n_gs_unpool.png b/vignettes/figures/east_n_gs_unpool.png new file mode 100644 index 000000000..6467f005c Binary files /dev/null and b/vignettes/figures/east_n_gs_unpool.png differ diff --git a/vignettes/figures/readme.PNG b/vignettes/figures/readme.PNG new file mode 100644 index 000000000..dd19d01ee Binary files /dev/null and b/vignettes/figures/readme.PNG differ diff --git a/vignettes/fixtures/compute_expected_events.Rdata b/vignettes/fixtures/compute_expected_events.Rdata new file mode 100644 index 000000000..0a4ecf523 Binary files /dev/null and b/vignettes/fixtures/compute_expected_events.Rdata differ diff --git a/vignettes/fixtures/rd_simu_power_gspowernpe_2_weight.Rdata b/vignettes/fixtures/rd_simu_power_gspowernpe_2_weight.Rdata new file mode 100644 index 000000000..4b50f5f15 Binary files /dev/null and b/vignettes/fixtures/rd_simu_power_gspowernpe_2_weight.Rdata differ diff --git a/vignettes/ggsd.bib b/vignettes/ggsd.bib new file mode 100644 index 000000000..3d0585424 --- /dev/null +++ b/vignettes/ggsd.bib @@ -0,0 +1,380 @@ +@manual{gsDesign, + title = {{gsDesign}: Group Sequential Design}, + author = {Keaven Anderson}, + year = {2020}, + note = {R package version 3.1.1}, + url = {https://CRAN.R-project.org/package=gsDesign} +} + +@article{r2rtf, + title = {{r2rtf}---an R Package to Produce Rich Text Format ({RTF}) Tables and Figures}, + author = {Wang, Siruo and Ye, Simiao and Anderson, Keaven M and Zhang, Yilong}, + year = {2020} +} + +@article{WPGSD, + title={A unified framework for weighted parametric group sequential design}, + author={Anderson, Keaven M and Guo, Zifang and Zhao, Jing and Sun, Linda Z}, + journal={Biometrical Journal}, + year={2022}, + publisher={Wiley Online Library} +} + +@article{MehrotraRailkar, + title={Minimum risk weights for comparing treatments in stratified binomial trials}, + author={Mehrotra, Devan V and Railkar, Radha}, + journal={Statistics in medicine}, + volume={19}, + number={6}, + pages={811--825}, + year={2000}, + publisher={Wiley Online Library} +} +@ARTICLE{LachinFoulkes, + author = "Lachin, John M. and Foulkes, Mary A.", + title = "Evaluation of sample size and power for analyses of survival with allowance for nonuniform patient entry, losses to follow-up, noncompliance, and stratification.", + journal = "Biometrics", + volume = "42", + year = "1986", + pages = "507-519"} + +@ARTICLE{LachinCCT, + author = "Lachin, John M.", + title = "Introduction to sample size determination and power analysis for clinical trials.", + journal = "Controlled Clinical Trials", + volume="2", + year="1981", + pages = "91-113"} + +@ARTICLE{Schoenfeld, + author="David Schoenfeld", + title="The asymptotic properties of nonparametric tests for comparing survival distributions", + journal="Biometrika", + volume="68", + pages="316-319", + year="1981"} + +@article{FarringtonManning, + title={Test statistics and sample size formulae for comparative binomial trials with null hypothesis of non-zero risk difference or non-unity relative risk}, + author={Farrington, Conor P and Manning, Godfrey}, + journal={Statistics in medicine}, + volume={9}, + number={12}, + pages={1447--1454}, + year={1990}, + publisher={Wiley Online Library} +} + +@article{NPHWGdesign, + title={Robust design and analysis of clinical trials with nonproportional hazards: a straw man guidance from a cross-pharma working group}, + author={Roychoudhury, Satrajit and Anderson, Keaven M and Ye, Jiabu and Mukhopadhyay, Pralay}, + journal={Statistics in Biopharmaceutical Research}, + pages={1--15}, + year={2021}, + publisher={Taylor \& Francis} +} + +@article{Magirrdesign, + title={Design and analysis of group-sequential clinical trials based on a modestly weighted log-rank test in anticipation of a delayed separation of survival curves: A practical guidance}, + author={Magirr, Dominic and Jim{\'e}nez, Jos{\'e} L}, + journal={Clinical Trials}, + volume={19}, + number={2}, + pages={201--210}, + year={2022}, + publisher={SAGE Publications Sage UK: London, England} +} + +@article{YungLiu, + title={Sample size and power for the weighted log-rank test and Kaplan-Meier based tests with allowance for nonproportional hazards}, + author={Yung, Godwin and Liu, Yi}, + journal={Biometrics}, + year={2019}, + publisher={Wiley Online Library} +} + +@article{Wason2016, + title={Some recommendations for multi-arm multi-stage trials}, + author={Wason, James and Magirr, Dominic and Law, Martin and Jaki, Thomas}, + journal={Statistical methods in medical research}, + volume={25}, + number={2}, + pages={716--727}, + year={2016}, + publisher={SAGE Publications Sage UK: London, England} +} + +@article{MukhopadhyayAHR, + title={Statistical and practical considerations in designing of immuno-oncology trials}, + author={Mukhopadhyay, Pralay and Huang, Wenmei and Metcalfe, Paul and {\"O}hrn, Fredrik and Jenner, Mary and Stone, Andrew}, + journal={Journal of Biopharmaceutical Statistics}, + volume={30}, + number={6}, + pages={1130--1146}, + year={2020}, + publisher={Taylor \& Francis} +} + +@article{MagirrBurman, + title={Modestly weighted logrank tests}, + author={Magirr, Dominic and Burman, Carl-Fredrik}, + journal={Statistics in medicine}, + volume={38}, + number={20}, + pages={3782--3790}, + year={2019}, + publisher={Wiley Online Library} +} + +@book{JTBook, + author = "Jennison, Christopher and Turnbull, Bruce W", + title ="Group sequential methods with applications to clinical trials", + publisher = "CRC Press", + year = "1999"} + +@book{PLWBook, + author = "Michael A. Proschan and K. K. Gordon Lan and Janet Turk Wittes", + title = "Statistical Monitoring of Clinical Trials. A Unified Approach.", + publisher = "Springer", + address = "New York, NY", + year = "2006"} + +@article{Mukhopadhyay2020, + title={Statistical and practical considerations in designing of immuno-oncology trials}, + author={Mukhopadhyay, Pralay and Huang, Wenmei and Metcalfe, Paul and {\"O}hrn, Fredrik and Jenner, Mary and Stone, Andrew}, + journal={Journal of Biopharmaceutical Statistics}, + pages={1--17}, + year={2020}, + publisher={Taylor \& Francis} +} + +@article{NPHWG2020sim, + title={Alternative analysis methods for time to event endpoints under nonproportional hazards: a comparative analysis}, + author={Lin, Ray S and Lin, Ji and Roychoudhury, Satrajit and Anderson, Keaven M and Hu, Tianle and Huang, Bo and Leon, Larry F and Liao, Jason JZ and Liu, Rong and Luo, Xiaodong and others}, + journal={Statistics in Biopharmaceutical Research}, + volume={12}, + number={2}, + pages={187--198}, + year={2020}, + publisher={Taylor \& Francis} +} + +@article{Tsiatis, + author="Anastasios A. Tsiatis", + title="Repeated significance testing for a general class of statistics use in censored survival analysis.", + journal="Journal of the American Statistical Association", + volume="77", + pages="855-861", + year="1982"} + +@article{CAPTURE, + title={Randomised placebo-controlled trial of abciximab before and during coronary intervention in refractory unstable angina: the CAPTURE study}, + author={Capture Investigators and others}, + journal={Lancet}, + volume={349}, + pages={1429--1435}, + year={1997} +} + +@book{LachinBook, + title={Biostatistical methods: the assessment of relative risks}, + author={Lachin, John M}, + volume={509}, + year={2009}, + publisher={John Wiley \& Sons} +} + +@article{LanDeMets, + author = "Lan, K.~K.~G. and DeMets, David L.", + title = "Discrete sequential boundaries for clinical trials.", + journal = "Biometrika", + volume = "70", + year = "1983", + pages = "659-663"} + +@article{CCmyth, + title={The myth of continuity-corrected sample size formulae}, + author={Gordon, Ian and Watson, Ray}, + journal={Biometrics}, + pages={71--76}, + year={1996}, + publisher={JSTOR} +} + +@article{Chan2002, + title={Power and sample size determination for noninferiority trials using an exact method}, + author={Chan, Ivan SF}, + journal={Journal of biopharmaceutical statistics}, + volume={12}, + number={4}, + pages={457--469}, + year={2002}, + publisher={Taylor \& Francis} +} + +@article{AGZS2021unified, + title={A unified framework for weighted parametric group sequential design (WPGSD)}, + author={Anderson, Keaven M and Guo, Zifang and Zhao, Jing and Sun, Linda Z}, + journal={arXiv preprint arXiv:2103.10537}, + year={2021} +} + +@article{FHO, + title={Designs for group sequential tests}, + author={Fleming, Thomas R and Harrington, David P and O'Brien, Peter C}, + journal={Controlled Clinical Trials}, + volume={5}, + number={4}, + pages={348--361}, + year={1984}, + publisher={Elsevier} +} + +@article{FPG, + title={Monitoring pairwise comparisons in multi-armed clinical trials}, + author={Follmann, Dean A and Proschan, Michael A and Geller, Nancy L}, + journal={Biometrics}, + pages={325--336}, + year={1994}, + publisher={JSTOR} +} + +@article{LanDeMets1989, + author = "Lan, K.~K.~G. and DeMets, David L.", + title = "Group sequential procedures: Calendar versus information time.", + journal = "Statistics in Medicine", + volume = "8", + year = "1989", + pages = "1191-1198", + DOI="10.1002/sim.4780081003"} + +@article{MaurerBretz2013, + author="Willi Maurer and Frank Bretz", + title="Multiple testing in group sequential trials using graphical approaches", + journal="Statistics in Biopharmaceutical Research", + volume="5", + year="2013", + pages="311-320", + DOI="10.1080/19466315.2013.807748"} + +@article{NPHWG2021Design, + title={Robust design and analysis of clinical trials with non-proportional hazards: a straw man guidance from a cross-pharma working group}, + author={Roychoudhury, Satrajit and Anderson, Keaven M and Ye, Jiabu and Mukhopadhyay, Pralay}, + journal={Statistics in Biopharmaceutical Research}, + pages={1--37}, + year={2021}, + publisher={Taylor \& Francis} +} + +@article{Kalbfleisch1981, + title={Estimation of the average hazard ratio}, + author={Kalbfleisch, John D and Prentice, Ross L}, + journal={Biometrika}, + volume={68}, + number={1}, + pages={105--112}, + year={1981} +} + +@article{Schemper2009, + title="The estimation of average hazard ratios by weighted Cox regression", + author="Schemper, Michael and Wakounig, Samo and Heinze, Georg", + journal="Statistics in medicine", + volume="28", + number="19", + pages="2473--2489", + year="2009" +} + +@article{Schoenfeld1981, + title={The asymptotic properties of nonparametric tests for comparing survival distributions}, + author={Schoenfeld, David}, + journal={Biometrika}, + volume={68}, + number={1}, + pages={316--319}, + year={1981}, + publisher={Oxford University Press} +} + +@article{FTU, + title={A simple approximation for calculating sample sizes for comparing independent proportions}, + author={Fleiss, Joseph L and Tytun, Alex and Ury, Hans K}, + journal={Biometrics}, + pages={343--346}, + year={1980}, + publisher={JSTOR} +} + +@article{Lachin1981, + title={Introduction to sample size determination and power analysis for clinical trials}, + author={Lachin, John M}, + journal={Controlled clinical trials}, + volume={2}, + number={2}, + pages={93--113}, + year={1981}, + publisher={Elsevier} +} + +@article{MantelHaenszel, + title={Statistical aspects of the analysis of data from retrospective studies of disease}, + author={Mantel, Nathan and Haenszel, William}, + journal={Journal of the national cancer institute}, + volume={22}, + number={4}, + pages={719--748}, + year={1959}, + publisher={Oxford University Press} +} + +@article{Mehrotra2000, + title={Minimum risk weights for comparing treatments in stratified binomial trials}, + author={Mehrotra, Devan V and Railkar, Radha}, + journal={Statistics in medicine}, + volume={19}, + number={6}, + pages={811--825}, + year={2000}, + publisher={Wiley Online Library} +} + +@article{mehrotra2000minimum, + title={Minimum risk weights for comparing treatments in stratified binomial trials}, + author={Mehrotra, Devan V and Railkar, Radha}, + journal={Statistics in medicine}, + volume={19}, + number={6}, + pages={811--825}, + year={2000}, +} +@article{kornfreidlin2018, + title={Interim futility monitoring assessing immune therapies with a potentially delayed treatment effect}, + author={Korn, Edward L and Freidlin, Boris}, + journal={Journal of Clinical Oncology}, + volume={36}, + number={23}, + pages={2444}, + year={2018}, + publisher={American Society of Clinical Oncology} +} +@article{wieand, + title={Stopping when the experimental regimen does not appear to help}, + author={Wieand, Sam and Schroeder, Georgene and O'Fallon, Judith Rich}, + journal={Statistics in medicine}, + volume={13}, + number={13-14}, + pages={1453--1458}, + year={1994}, + publisher={Wiley Online Library} +} +@article{ttchen2013, + title={Statistical issues and challenges in immuno-oncology}, + author={Chen, Tai-Tsang}, + journal={Journal for immunotherapy of cancer}, + volume={1}, + number={1}, + pages={1--9}, + year={2013}, + publisher={BioMed Central} +} \ No newline at end of file diff --git a/vignettes/gsDesign.bib b/vignettes/gsDesign.bib index 74b85fd46..9cd4baf1d 100644 --- a/vignettes/gsDesign.bib +++ b/vignettes/gsDesign.bib @@ -1,3 +1,14 @@ +@article{Haybittle, + title={Repeated assessment of results in clinical trials of cancer treatment}, + author={Haybittle, JL}, + journal={The British journal of radiology}, + volume={44}, + number={526}, + pages={793--797}, + year={1971}, + publisher={The British Institute of Radiology} +} + @BOOK{JTBook, author = "Jennison, Christopher and Turnbull, Bruce W.", title = "Group Sequential Methods with Applications to Clinical Trials", @@ -13,6 +24,14 @@ @ARTICLE{KimTsiatis year = "1990", pages = "81-92"} +@book{LachinBook, + title={Biostatistical methods: the assessment of relative risks}, + author={Lachin, John M}, + volume={509}, + year={2009}, + publisher={John Wiley \& Sons} +} + @ARTICLE{LachinFoulkes, author = "Lachin, John M. and Foulkes, Mary A.", title = "Evaluation of sample size and power for analyses of survival with allowance for nonuniform patient entry, losses to follow-up, noncompliance, and stratification.", @@ -57,6 +76,36 @@ @ARTICLE{MaurerBretz2013 pages="311-320", DOI="10.1080/19466315.2013.807748"} +@article{Peto, + title={Design and analysis of randomized clinical trials requiring prolonged observation of each patient. I. Introduction and design}, + author={Peto, Richard and Pike, MCetal and Armitage, Pet and Breslow, NE and Cox, DR and Howard, Sf V and Mantel, N and McPherson, K and Peto, J and Smith, PG}, + journal={British journal of cancer}, + volume={34}, + number={6}, + pages={585--612}, + year={1976}, + publisher={Nature Publishing Group} +} +@article{Mehrotra2000, + title={Minimum risk weights for comparing treatments in stratified binomial trials}, + author={Mehrotra, Devan V and Railkar, Radha}, + journal={Statistics in medicine}, + volume={19}, + number={6}, + pages={811--825}, + year={2000}, + publisher={Wiley Online Library} +} +@article{MantelHaenszel, + title={Statistical aspects of the analysis of data from retrospective studies of disease}, + author={Mantel, Nathan and Haenszel, William}, + journal={Journal of the national cancer institute}, + volume={22}, + number={4}, + pages={719--748}, + year={1959}, + publisher={Oxford University Press} +} @BOOK{PLWBook, author = "Michael A. Proschan and K. K. Gordon Lan and Janet Turk Wittes", title = "Statistical Monitoring of Clinical Trials. A Unified Approach.", @@ -81,16 +130,7 @@ @ARTICLE{Schemper2009 pages="2473--2489", year="2009" } -@article{Schoenfeld1981, - title={The asymptotic properties of nonparametric tests for comparing survival distributions}, - author={Schoenfeld, David}, - journal={Biometrika}, - volume={68}, - number={1}, - pages={316--319}, - year={1981}, - publisher={Oxford University Press} -} + @ARTICLE{Kalbfleisch1981, title={Estimation of the average hazard ratio}, author={Kalbfleisch, John D and Prentice, Ross L}, @@ -104,8 +144,8 @@ @ARTICLE{Kalbfleisch1981 @UNPUBLISHED{NPHWGDesign, title={Robust design and analysis of clinical trials with non-proportional hazards: a straw man guidance from a cross-pharma working group}, author={Satrajit Roychoudhury and Keaven M. Anderson and Jiabu Ye and Pralay Mukhopadhyay}, - note={Submitted for publication}, - year={2019} + ee= {https://arxiv.org/abs/1908.07112}, + year={2020} } @UNPUBLISHED{NPHWGSimulation, @@ -155,3 +195,313 @@ @article{Lee2007 year={2007}, publisher={Elsevier} } + +@article{Schoenfeld1981, + title={The asymptotic properties of nonparametric tests for comparing survival distributions}, + author={Schoenfeld, David}, + journal={Biometrika}, + volume={68}, + number={1}, + pages={316--319}, + year={1981}, + publisher={Oxford University Press} +} + +@manual{RHubWhitepaper, + title={A Risk-based Approach for Assessing R package Accuracy within a Validated Infrastructure: White Paper Summary}, + author={Andy Nicholls}, + url={https://www.pharmar.org/blog/2020/01/30/2020-05-07-a-risk-based-approach-for-assessing-r-package-accuracy-within-a-validated-infrastructure-white-paper-summary/}, + year={2020} +} + +@manual{RFoundation, + title={R: Regulatory Compliance and Validation Issues A Guidance Document for the Use of R in Regulated Clinical Trial Environments}, + author={"The R Foundation for Statistical Computing}, + url={https://www.r-project.org/doc/R-FDA.pdf}, + year={2018} +} + +@manual{FDAsoftware, + title={Statistical Software Clarifying Statement}, + author={Food and Drug Administration}, + url={https://www.fda.gov/media/109552/download}, + year={2015} +} + +@article{Yung2019Bcs, + title={Sample size and power for the weighted log-rank test and Kaplan-Meier based tests with allowance for nonproportional hazards}, + author={Yung, Godwin and Liu, Yi}, + journal={Biometrics}, + year={2019}, + publisher={Wiley Online Library} +} + +@Manual{npsurvss, + title = {npsurvSS: Sample Size and Power Calculation for Common Non-Parametric Tests in Survival Analysis}, + author = {Godwin Yung and Yi Liu}, + year = {2019}, + url = {https://cran.r-project.org/web/packages/npsurvSS} +} + +@article{Luo2019SIM, + title={Design and monitoring of survival trials in complex scenarios}, + author={Luo, Xiaodong and Mao, Xuezhou and Chen, Xun and Qiu, Junshan and Bai, Steven and Quan, Hui}, + journal={Statistics in medicine}, + volume={38}, + number={2}, + pages={192--209}, + year={2019}, + publisher={Wiley Online Library} +} + +@Manual{PWEALL, + title = {PWEALL: Design and Monitoring of Survival Trials Accounting for Complex Situations}, + author = {Xiaodong Luo and Xuezhou Mao and Xun Chen and Hui Quan}, + year = {2019}, + url = {https://cran.r-project.org/web/packages/PWEALL} +} + + @Manual{gsDesign, + title = {gsDesign: Group Sequential Design}, + author = {Keaven Anderson}, + year = {2020}, + note = {R package version 3.1.1}, + url = {https://CRAN.R-project.org/package=gsDesign} + } + +@article{Liu2008, + title={On adaptive extensions of group sequential trials for clinical investigations}, + author={Liu, Qing and Anderson, Keaven M}, + journal={Journal of the American Statistical Association}, + volume={103}, + number={484}, + pages={1621--1630}, + year={2008}, + publisher={Taylor \& Francis} +} + +@BOOK{EAST, + author = "Cytel, Inc.", + title = "EAST 5", + publisher = "Cytel, Inc.", + address = "Cambridge, MA", + year = "2007"} + +@inproceedings{Gillen2013, + title={Designing, monitoring, and analyzing group sequential clinical trials using the RCTdesign Package for R}, + author={Gillen, Daniel L and Emerson, Scott S}, + booktitle={Proceedings of the Fourth Seattle Symposium in Biostatistics: Clinical Trials}, + pages={177--208}, + year={2013}, + organization={Springer} +} + +@Manual{RCTdesign, + title = {RCTdesign.org : Methods and Software for Clinical Trials}, + author = {Scott S. Emerson and Daniel L. Gillen and John M. Kittelson and Sarah C. Emerson and Gregory P. Levin}, + year = {2020}, + url = {http://rctdesign.org/} +} + +@article{Yung2019Bcs, + title={Sample size and power for the weighted log-rank test and Kaplan-Meier based tests with allowance for nonproportional hazard, Godwin and Liu, Yi}, + journal={Biometricss}, + author={Yung}, + year={2019}, + publisher={Wiley Online Library} +} + +@Manual{npsurvss, + title = {npsurvSS: Sample Size and Power Calculation for Common Non-Parametric Tests in Survival Analysis}, + author = {Godwin Yung and Yi Liu}, + year = {2019}, + url = {https://cran.r-project.org/web/packages/npsurvSS} +} + +@article{Luo2019SIM, + title={Design and monitoring of survival trials in complex scenarios}, + author={Luo, Xiaodong and Mao, Xuezhou and Chen, Xun and Qiu, Junshan and Bai, Steven and Quan, Hui}, + journal={Statistics in medicine}, + volume={38}, + number={2}, + pages={192--209}, + year={2019}, + publisher={Wiley Online Library} +} + +@Manual{PWEALL, + title = {PWEALL: Design and Monitoring of Survival Trials Accounting for Complex Situations}, + author = {Xiaodong Luo and Xuezhou Mao and Xun Chen and Hui Quan}, + year = {2019}, + url = {https://cran.r-project.org/web/packages/PWEALL} +} + +@misc{rpact, + title={rpact: Confirmatory adaptive clinical trial design and analysis (R package version 2.0. 2)}, + author={Wassmer, G and Pahlke, F}, + year={2019} +} + +@article{Magirr2019, + title={Modestly weighted logrank tests}, + author={Magirr, Dominic and Burman, Carl-Fredrik}, + journal={Statistics in medicine}, + volume={38}, + number={20}, + pages={3782--3790}, + year={2019}, + publisher={Wiley Online Library} +} + +@Manual{survRM2, + title = {survRM2: Comparing Restricted Mean Survival Time}, + author = { Hajime Uno and Lu Tian and Miki Horiguchi and Angel Cronin and Chakib Battioui and James Bell}, + year = {2020}, + url = {https://cran.r-project.org/web/packages/survRM2} +} + +@article{FHO, + title={Designs for group sequential tests}, + author={Fleming, Thomas R and Harrington, David P and O'Brien, Peter C}, + journal={Controlled Clinical Trials}, + volume={5}, + number={4}, + pages={348--361}, + year={1984}, + publisher={Elsevier} +} + +@article{Mukhopadhyay2020, + title={Statistical and practical considerations in designing of immuno-oncology trials}, + author={Mukhopadhyay, Pralay and Huang, Wenmei and Metcalfe, Paul and {\"O}hrn, Fredrik and Jenner, Mary and Stone, Andrew}, + journal={Journal of Biopharmaceutical Statistics}, + pages={1--17}, + year={2020}, + publisher={Taylor \& Francis} +} + +@article{NPHWG2021Design, + title={Robust design and analysis of clinical trials with non-proportional hazards: a straw man guidance from a cross-pharma working group}, + author={Roychoudhury, Satrajit and Anderson, Keaven M and Ye, Jiabu and Mukhopadhyay, Pralay}, + journal={Statistics in Biopharmaceutical Research}, + pages={1--37}, + year={2021}, + publisher={Taylor \& Francis} +} + +@article{NPHWG2020sim, + title={Alternative analysis methods for time to event endpoints under nonproportional hazards: a comparative analysis}, + author={Lin, Ray S and Lin, Ji and Roychoudhury, Satrajit and Anderson, Keaven M and Hu, Tianle and Huang, Bo and Leon, Larry F and Liao, Jason JZ and Liu, Rong and Luo, Xiaodong and others}, + journal={Statistics in Biopharmaceutical Research}, + volume={12}, + number={2}, + pages={187--198}, + year={2020}, + publisher={Taylor \& Francis} +} + +@article{FPG, + title={Monitoring pairwise comparisons in multi-armed clinical trials}, + author={Follmann, Dean A and Proschan, Michael A and Geller, Nancy L}, + journal={Biometrics}, + pages={325--336}, + year={1994}, + publisher={JSTOR} +} + +@article{AGZS2021unified, + title={A unified framework for weighted parametric group sequential design (WPGSD)}, + author={Anderson, Keaven M and Guo, Zifang and Zhao, Jing and Sun, Linda Z}, + journal={arXiv preprint arXiv:2103.10537}, + year={2021} +} + +@article{CAPTURE, + title={Randomised placebo-controlled trial of abciximab before and during coronary intervention in refractory unstable angina: the CAPTURE study}, + author={Capture Investigators and others}, + journal={Lancet}, + volume={349}, + pages={1429--1435}, + year={1997} +} + +@article{CCmyth, + title={The myth of continuity-corrected sample size formulae}, + author={Gordon, Ian and Watson, Ray}, + journal={Biometrics}, + pages={71--76}, + year={1996}, + publisher={JSTOR} +} + +@article{FarringtonManning, + title={Test statistics and sample size formulae for comparative binomial trials with null hypothesis of non-zero risk difference or non-unity relative risk}, + author={Farrington, Conor P and Manning, Godfrey}, + journal={Statistics in medicine}, + volume={9}, + number={12}, + pages={1447--1454}, + year={1990}, + publisher={Wiley Online Library} +} + +@article{Chan2003, + title={Confidence Interval and Hypothesis Testing"}, + author={Chan, Ivan SF and Mehrotra, Devan V}, + journal={Encyclopedia of Biopharmaceutical Statistics}, + pages={231--234}, + year={2003}, + publisher={Informa Health Care} +} + +@article{Chan2002, + title={Power and sample size determination for noninferiority trials using an exact method}, + author={Chan, Ivan SF}, + journal={Journal of biopharmaceutical statistics}, + volume={12}, + number={4}, + pages={457--469}, + year={2002}, + publisher={Taylor \& Francis} +} + +@article{FTU, + title={A simple approximation for calculating sample sizes for comparing independent proportions}, + author={Fleiss, Joseph L and Tytun, Alex and Ury, Hans K}, + journal={Biometrics}, + pages={343--346}, + year={1980}, + publisher={JSTOR} +} + +@article{Lachin1981, + title={Introduction to sample size determination and power analysis for clinical trials}, + author={Lachin, John M}, + journal={Controlled clinical trials}, + volume={2}, + number={2}, + pages={93--113}, + year={1981}, + publisher={Elsevier} +} + +@article{mehrotra2000minimum, + title={Minimum risk weights for comparing treatments in stratified binomial trials}, + author={Mehrotra, Devan V and Railkar, Radha}, + journal={Statistics in medicine}, + volume={19}, + number={6}, + pages={811--825}, + year={2000}, +} + +@article{ristl2021delayed, + title={Delayed treatment effects, treatment switching and heterogeneous patient populations: How to design and analyze RCTs in oncology}, + author={Ristl, Robin and Ballarini, Nicol{\'a}s M and G{\"o}tte, Heiko and Sch{\"u}ler, Armin and Posch, Martin and K{\"o}nig, Franz}, + journal={Pharmaceutical statistics}, + volume={20}, + number={1}, + pages={129--145}, + year={2021}, + publisher={Wiley Online Library} +} \ No newline at end of file diff --git a/vignettes/AHRVignette.Rmd b/vignettes/story_ahr_under_nph.Rmd similarity index 88% rename from vignettes/AHRVignette.Rmd rename to vignettes/story_ahr_under_nph.Rmd index c2c3c693c..4a6606480 100644 --- a/vignettes/AHRVignette.Rmd +++ b/vignettes/story_ahr_under_nph.Rmd @@ -1,23 +1,31 @@ --- -title: Average hazard ratio and sample size under non-proportional hazards -output: rmarkdown::html_vignette -bibliography: gsDesign.bib +title: "Average hazard ratio and sample size under non-proportional hazards" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + number_sections: true + highlight: "textmate" + css: "custom.css" +bibliography: "ggsd.bib" vignette: > %\VignetteIndexEntry{Average hazard ratio and sample size under non-proportional hazards} %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} --- + ```{r setup, include = FALSE,message=FALSE,warning=FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>", dev = "png" ) - options(width = 58) ``` -## Introduction +# Introduction This document demonstrates applications of the average hazard ratio concept in the design of fixed designs without interim analysis. Throughout we consider a 2-arm trial with an experimental and control group and a time-to-event endpoint. @@ -33,7 +41,7 @@ There are two things to note regarding differences between `simtrial::simfix()` 1. `simtrial::simfix()` is less flexible in that it requires all strata are enrolled at the same relative rates throughout the trial whereas `gsDesign2::AHR()` allows, for example, enrollment to start or stop at different times in different strata. In this document, we use the more restrictive parameterization of `simtrial::simfix()` so that we can confirm the asymptotic sample size approximation based on `gsDesign2::AHR()` by simulation. 2. `simtrial::simfix()` provides more flexibility in test statistics used than `gsDesign2::AHR()` as documented in the pMaxCombo vignette demonstrating use of Fleming-Harrington weighted logrank tests and combinations of such tests. -### Document organization +## Document organization This vignette is organized as follows: @@ -85,7 +93,7 @@ We load packages needed below. - Hidden underneath this is the `gsDesign2::eEvents_df()` routine that provides expected event counts for each period and stratum where the hazard ratio differs. This is the basic calculation used in the `gsDesign2::AHR()` routine. ```{r libraries,message=FALSE,warning=FALSE} -library(gsDesign2) +devtools::load_all() library(gsDesign) library(ggplot2) library(dplyr) @@ -93,11 +101,12 @@ library(tibble) library(simtrial) library(survival) library(knitr) +library(gt) ``` -## Single stratum non-proportional hazards example +# Single stratum non-proportional hazards example -### Design scenario +## Design scenario We set up the first scenario design parameters. Enrollment ramps up over the course of the first 4 months follow-up by a steady state enrollment thereafter. @@ -127,31 +136,29 @@ Since there is a single stratum, we set `strata` to the default: strata <- tibble::tibble(Stratum = "All", p = 1) ``` -### Computing average hazard ratio +## Computing average hazard ratio We compute an average hazard ratio using the `gsDesign2::AHR()` (average hazard ratio) routine. We will modify enrollment rates proportionately below when the sample size is computed. This result is for the given enrollment rates which will be adjusted in our next step. However, since they will be adjusted proportionately with relative enrollment timing not changing, the average hazard ratio will not change. Approximations of statistical information under the null (`info0`) and alternate (`info`) hypotheses are provided here. Recall that the parameterization here is in terms of $\log(HR)$, and, thus the information is intended to approximate 1 over the variance for the Cox regression coefficient for treatment effect; this will be checked with simulation later. ```{r avehr,warning=FALSE,message=FALSE} -avehr <- gsDesign2::AHR( +avehr <- AHR( enrollRates = enrollRates, failRates = failRates, totalDuration = as.numeric(totalDuration) ) -avehr %>% kable(digits = 3) +avehr %>% gt() ``` This result can be explained by the number of events observed before and after the first 3 months of treatment in each treatment group. ```{r} -xx <- - gsDesign2::AHR( - enrollRates = enrollRates, - failRates = failRates, - totalDuration = as.numeric(totalDuration), - simple = FALSE - ) -xx %>% kable(digits = 3) +xx <- AHR( + enrollRates = enrollRates, + failRates = failRates, + totalDuration = as.numeric(totalDuration), + simple = FALSE) +xx %>% gt() ``` Now we can replicate the geometric average hazard ratio (AHR) computed using the `AHR()` routine above. @@ -161,22 +168,21 @@ Exponentiating the resulting weighted average gives the geometric mean hazard ra ```{r, message=FALSE} xx %>% summarize(AHR = exp(sum(Events * log(HR) / sum(Events)))) %>% - kable(digits = 3) + gt() ``` -### Deriving the design +## Deriving the design With this average hazard ratio, we use the call for `gsDesign::nEvents()` which uses the @Schoenfeld1981 approximation to derive a targeted number of events. All you need for this is the average hazard ratio from above, the randomization ratio (experimental/control), Type I error and Type II error (1 - power). ```{r} -targetEvents <- - gsDesign::nEvents( - hr = avehr$AHR, # average hazard ratio computed above - ratio = 1, # randomization ratio - alpha = .025, # 1-sided Type I error - beta = .1 # Type II error (1-power) - ) +targetEvents <- nEvents( + hr = avehr$AHR, # average hazard ratio computed above + ratio = 1, # randomization ratio + alpha = .025, # 1-sided Type I error + beta = .1 # Type II error (1-power) +) targetEvents <- ceiling(targetEvents) targetEvents ``` @@ -186,12 +192,12 @@ We also compute proportionately increase the enrollment rates to achieve this ta ```{r} # Update enrollRates to obtain targeted events enrollRates$rate <- ceiling(targetEvents) / avehr$Events * enrollRates$rate -avehr <- gsDesign2::AHR( +avehr <- AHR( enrollRates = enrollRates, failRates = failRates, totalDuration = as.numeric(totalDuration) ) -avehr %>% kable(digits = 3) +avehr %>% gt() ``` We also compute sample size, rounding up to the nearest even integer. @@ -202,30 +208,31 @@ sampleSize <- ceiling(sum(enrollRates$rate * enrollRates$duration) / 2) * 2 sampleSize ``` -### Average hazard ratio and expected event accumulation over time +## Average hazard ratio and expected event accumulation over time We examine the average hazard ratio as a function of trial duration with the modified enrollment required to power the trial. We also plot expected event accrual over time; although the graphs go through 40 months, recall that the targeted trial duration is 30 months. A key design consideration is selecting trial duration based on things like the degree of AHR improvement over time versus the urgency of completing the trial as quickly as possible, noting that the required sample size will decrease with longer follow-up. -```{r avehrplot,warning = FALSE,message = FALSE,fig.width = 6.5} -avehrtbl <- gsDesign2::AHR( +```{r avehrplot, warning=FALSE, message=FALSE, fig.width=3.5} +avehrtbl <- AHR( enrollRates = enrollRates, failRates = failRates, - totalDuration = 1:(totalDuration + 10) -) + totalDuration = 1:(totalDuration + 10)) + ggplot(avehrtbl, aes(x = Time, y = AHR)) + geom_line() + ylab("Average HR") + - ggtitle("Average HR as a function of study duration") + - scale_x_continuous(breaks = seq(0, 48, 6)) + ggtitle("Average HR as a function of study duration") #+ + #scale_x_continuous(breaks = seq(0, 48, 6)) + ggplot(avehrtbl, aes(x = Time, y = Events)) + geom_line() + ylab("Expected events") + - ggtitle("Expected event accumulation as a function of study duration") + - scale_x_continuous(breaks = seq(0, 48, 6)) + ggtitle("Expected event accumulation as a function of study duration") #+ + #scale_x_continuous(breaks = seq(0, 48, 6)) ``` -### Simulation to verify power +## Simulation to verify power We use function `simtrial::simfix()` to simplify setting up and executing a simulation to evaluate the sample size derivation above. Arguments for `simtrial::simfix()` are slightly different than the set-up that was used for the `gsDesign2::AHR()` function used above. @@ -254,7 +261,6 @@ The statistical information computed in the simulation is computed as one over t ```{r summary1,message=FALSE,warning=FALSE} load("./fixtures/results1.Rdata") # loading the data previously saved - results1$Positive <- results1$Z <= qnorm(.025) results1 %>% group_by(cut) %>% @@ -273,12 +279,12 @@ In this case, the information approximation under the alternate hypothesis appea Nonetheless, the approximation for power appear quite good as noted above. ```{r} -avehr %>% kable(digits = 3) +avehr %>% gt() ``` -## Different proportional hazards by strata +# Different proportional hazards by strata -### Design scenario +## Design scenario We set up the design scenario parameter. We are limited here to simultaneous enrollment of strata since the `simtrial::simfix()` routine uses `simtrial::simPWSurv()` which is limited to this scenario. @@ -290,11 +296,13 @@ We specify three strata: ```{r scenario2,warning=FALSE,message=FALSE} strata <- tibble::tibble(Stratum = c("High", "Moderate", "Low"), p = c(1 / 3, 1 / 2, 1 / 6)) + enrollRates <- tibble::tibble( Stratum = c(array("High", 4), array("Moderate", 4), array("Low", 4)), duration = rep(c(2, 2, 2, 18), 3), rate = c((1:4) / 3, (1:4) / 2, (1:4) / 6) ) + failRates <- tibble::tibble( Stratum = c("High", "Moderate", "Low"), duration = 100, @@ -302,23 +310,24 @@ failRates <- tibble::tibble( hr = c(1.2, 1 / 3, 1), dropoutRate = .001 ) + totalDuration <- 36 ``` -### Computing average hazard ratio +## Computing average hazard ratio Now we transform the enrollment rates to account for stratified population. ```{r avehr2,warning = FALSE,message = FALSE} -ahr2 <- gsDesign2::AHR(enrollRates, failRates, totalDuration) -ahr2 %>% kable(digits = 3) +ahr2 <- AHR(enrollRates, failRates, totalDuration) +ahr2 %>% gt() ``` We examine the expected events by stratum. ```{r} -xx <- gsDesign2::AHR(enrollRates, failRates, totalDuration, simple = FALSE) -xx %>% kable(digits = 3) +xx <- AHR(enrollRates, failRates, totalDuration, simple = FALSE) +xx %>% gt() ``` Getting the average of `log(HR)` weighted by `Events` and exponentiating, we get the overall `AHR` just derived. @@ -327,22 +336,21 @@ Getting the average of `log(HR)` weighted by `Events` and exponentiating, we get xx %>% ungroup() %>% summarise(lnhr = sum(Events * log(HR)) / sum(Events), AHR = exp(lnhr)) %>% - kable(digits = 3) + gt() ``` -### Deriving the design +## Deriving the design We derive the sample size as before. We plan the sample size based on the average hazard ratio for the overall population and use that across strata. First, we derive the targeted events: ```{r gsDesign2,warning = FALSE,message = FALSE} -targetEvents <- - gsDesign::nEvents( - hr = ahr2$AHR, - ratio = 1, - alpha = .025, - beta = .1 - ) +targetEvents <- gsDesign::nEvents( + hr = ahr2$AHR, + ratio = 1, + alpha = .025, + beta = .1 +) targetEvents <- ceiling(targetEvents) targetEvents ``` @@ -351,12 +359,12 @@ Next, we adapt enrollment rates proportionately so that the trial will be powere ```{r inflate2, message=FALSE} enrollRates <- enrollRates %>% mutate(rate = targetEvents / ahr2$Events * rate) -gsDesign2::AHR( + +AHR( enrollRates = enrollRates, failRates = failRates, totalDuration = totalDuration -) %>% - kable(digits = 3) +) %>% gt() ``` The targeted sample size, rounding up to an even integer, is: @@ -366,31 +374,33 @@ sampleSize <- ceiling(sum(enrollRates$rate * enrollRates$duration) / 2) * 2 sampleSize ``` -### Average HR and expected event accumulation over time +## Average HR and expected event accumulation over time Plotting the average hazard ratio as a function of study duration, we see that it improves considerably over the course of the study. We also plot expected event accumulation. As before, we plot for 10 months more than the planned study duration of 36 months to allow evaluation of event accumulation versus treatment effect for different trial durations. -```{r avehrplot2,warning=FALSE,message=FALSE,fig.width=6.5} -avehrtbl <- gsDesign2::AHR( +```{r avehrplot2,warning=FALSE,message=FALSE,fig.width=4.5} +avehrtbl <- AHR( enrollRates = enrollRates, failRates = failRates, totalDuration = 1:(totalDuration + 10) ) + ggplot(avehrtbl, aes(x = Time, y = AHR)) + geom_line() + ylab("Average HR") + - ggtitle("Average HR as a function of study duration") + - scale_x_continuous(breaks = seq(0, 48, 6)) + ggtitle("Average HR as a function of study duration") #+ + #scale_x_continuous(breaks = seq(0, 48, 6)) + ggplot(avehrtbl, aes(x = Time, y = Events)) + geom_line() + ylab("Expected events") + - ggtitle("Expected event accumulation as a function of study duration") + - scale_x_continuous(breaks = seq(0, 48, 6)) + ggtitle("Expected event accumulation as a function of study duration") #+ + #scale_x_continuous(breaks = seq(0, 48, 6)) ``` -### Simulation to verify power +## Simulation to verify power We change the enrollment rates by stratum produced by `gsDesign::nSurv()` to overall enrollment rates needed for `simtrial::simfix()`. @@ -402,7 +412,8 @@ er <- enrollRates %>% mutate(period = 1:n()) %>% group_by(period) %>% summarise(rate = sum(rate), duration = last(duration)) -er %>% kable(digits = 3) + +er %>% gt() ``` @@ -410,8 +421,7 @@ Now we simulate and summarize results. Once again, we see that the expected statistical information from the simulation is greater than what would be expected by the Schoenfeld approximation which is the expected events divided by 4. ```{r simfix2,cache=FALSE,warning=FALSE,message=FALSE, eval=FALSE} -results2 <- - simtrial::simfix( +results2 <- simtrial::simfix( nsim = nsim, block = block, sampleSize = sampleSize, @@ -427,7 +437,6 @@ results2 <- ```{r summary2,warning=FALSE,message=FALSE} load("./fixtures/results2.Rdata") - results2$Positive <- (pnorm(results2$Z) <= .025) results2 %>% group_by(cut) %>% @@ -444,11 +453,11 @@ The achieved power by simulation is just below the targeted 90%; noting that the Using the final cutoff that requires both the targeted events and minimum follow-up seems a reasonable convention to preserved targeted design power. ```{r} -gsDesign2::AHR( +AHR( enrollRates = enrollRates, failRates = failRates, totalDuration = totalDuration -) %>% kable(digits = 3) +) %>% gt() ``` -## References +# References \ No newline at end of file diff --git a/vignettes/ArbitraryDistribution.Rmd b/vignettes/story_arbitrary_distribution.Rmd similarity index 91% rename from vignettes/ArbitraryDistribution.Rmd rename to vignettes/story_arbitrary_distribution.Rmd index 6924e5baa..3346a0bbf 100644 --- a/vignettes/ArbitraryDistribution.Rmd +++ b/vignettes/story_arbitrary_distribution.Rmd @@ -1,13 +1,20 @@ --- title: "Approximating an Arbitrary Survival Distribution" -author: "Keaven Anderson" -output: rmarkdown::html_vignette -bibliography: gsDesign.bib +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + number_sections: true + highlight: "textmate" + css: "custom.css" +# bibliography: "example.bib" vignette: > %\VignetteIndexEntry{Approximating an Arbitrary Survival Distribution} %\VignetteEngine{knitr::rmarkdown} --- + ```{r setup, include=FALSE} knitr::opts_chunk$set(echo = TRUE) ``` @@ -17,6 +24,7 @@ library(simtrial) library(tibble) library(ggplot2) library(gsDesign) +devtools::load_all() ``` ## Introduction @@ -36,8 +44,7 @@ Note that when the resulting `lnormRates` is used, the final piecewise exponenti That is, we have arbitrarily approximated with 6 piecewise exponential rates for a duration of 1 unit of time (say, month) followed by a final rate which extends to infinity. ```{r, message=FALSE, warning=FALSE} -library(gsDesign2) -lnormRates <- gsDesign2::s2pwe( +lnormRates <- s2pwe( times = c(1:6, 9), survival = plnorm(c(1:6, 9), meanlog = 0, sdlog = 2, lower.tail = FALSE) ) @@ -50,15 +57,14 @@ We note that at the beginning of each rate period in the approximation the actua ```{r, fig.width=6.5, fig.height=4} # Use a large number of points to plot lognormal survival times <- seq(0, 12, .025) + plot(times, plnorm(times, meanlog = 0, sdlog = 2, lower.tail = FALSE), log = "y", type = "l", main = "Lognormal Distribution vs. Piecewise Approximation", yaxt = "n", - ylab = "log(Survival)", col = 1 -) + ylab = "log(Survival)", col = 1) # Now plot the pieceise approximation using the 7-point approximation from above -lines(times, gsDesign2::ppwe(x = times, failRates = lnormRates), col = 2) - +lines(times, ppwe(x = times, failRates = lnormRates), col = 2) # Finally, add point markers at the points used in the approximation points(x = c(0:6), plnorm(c(0:6), meanlog = 0, sdlog = 2, lower.tail = FALSE), col = 1) text(x = c(5, 5), y = c(.5, .4), labels = c("Log-normal", "Piecewise Approximation (7 pts)"), col = 1:2, pos = 4) @@ -93,15 +99,15 @@ lambda <- log(2) / 10 theta <- -log(.4) times <- 0:40 plot(times, pPM(times, theta, lambda), type = "l", ylab = "Survival", xlab = "Time", log = "y") + # Now compute piecewise expoential approximation x <- seq(8, 40, 8) -pmRates <- gsDesign2::s2pwe( +pmRates <- s2pwe( times = x, - survival = pPM(x, theta = theta, lambda = lambda) -) + survival = pPM(x, theta = theta, lambda = lambda)) # Now plot the pieceise approximation using the 7-point approximation from above -lines(c(0, x), gsDesign2::ppwe(x = c(0, x), failRates = pmRates), col = 2) +lines(c(0, x), ppwe(x = c(0, x), failRates = pmRates), col = 2) points(c(0, x), pPM(c(0, x), theta, lambda)) ``` @@ -124,4 +130,4 @@ We confirm the survival at time 30: ```{r} pPM(30, theta, lambda) -``` +``` \ No newline at end of file diff --git a/vignettes/story_compare_power_delay_effect.Rmd b/vignettes/story_compare_power_delay_effect.Rmd new file mode 100644 index 000000000..db01eeb87 --- /dev/null +++ b/vignettes/story_compare_power_delay_effect.Rmd @@ -0,0 +1,276 @@ +--- +title: "Power for Delayed Effect Scenarios" +date: "`r format(Sys.time(), '%d %B, %Y')`" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + number_sections: true + highlight: "textmate" + css: "custom.css" +# bibliography: "example.bib" +vignette: > + %\VignetteEngine{knitr::rmarkdown} + %\VignetteIndexEntry{Power for Delayed Effect Scenarios} +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set(echo = TRUE) +``` + +```{r packages, message=FALSE, warning=FALSE} +library(gt) +library(dplyr) +library(tidyr) +library(tibble) +library(ggplot2) +library(gsDesign) +devtools::load_all() +``` + +# Overview + +We consider a delayed effect scenario where + +- The control group time-to-event distribution is exponential with a median of 15 months. +- The experimental group has a hazard ratio vs. control of 1 for 6 months and 0.6 thereafter. +- Enrollment at a constant rate for 12 months. +- Total study duration from 20 to 48 months. +- Exponential dropout rate of 0.001 per month. + +```{r} +enrollRates <- tibble(Stratum = "All", duration = 12, rate = 1) +failRates <- tibble(Stratum = "All", + duration = c(6, 100), + failRate = log(2) / 15, + hr = c(1, .6), + dropoutRate = 0.001) +enrollRates %>% gt() %>% tab_header(title = "Enrollment Table of Scenario 1") +failRates %>% gt() %>% tab_header(title = "Failure Table of Scenario 1") +``` + +For the above scenarios, we investigate the power, sample size and events under 6 tests: + +- `FH05`: The Fleming-Harrington with $\rho=0, \gamma=0.5$ test to obtain power of 85\% given 1-sided Type I error of 0.025. +- `FH00`: The regular logrank test with $\rho=0, \gamma=0$ under fixed study duration $\in\{20, 24, 28, \ldots, 60\}$. +- `mc2_test`: The Max Combo test including 2 WLR tests, i.e., $\{(\rho=0, \gamma=0, \tau = -1), (\rho=0, \gamma=0.5, \tau = -1)\}$. +- `mc2_test`: The Max Combo test including 3 WLR tests, i.e., $\{(\rho=0, \gamma=0, \tau = -1), (\rho=0, \gamma=0.5, \tau = -1), (\rho=0.5, \gamma=0.5, \tau = -1)\}$. +- `mc4_test`: The Max Combo test including 4 WLR tests, i.e., $\{(\rho=0, \gamma=0, \tau = -1), (\rho=0, \gamma=0.5, \tau = -1), (\rho=0.5, \gamma=0.5, \tau = -1), (\rho=0.5, \gamma=0, \tau = -1)\}$. +- `MB6`: The Magirr-Burman with $\rho=-1, \gamma=0, \tau = 6$ test with fixed study duration $\in\{20, 24, 28, \ldots, 60\}$. + + +We then compute power for the logrank test. +The general summary is that the Fleming-Harrington test has a meaningful power gain relative to logrank regardless of the study durations evaluated. + + +```{r, message=FALSE} +tab <- NULL + +for(trial_duration in seq(24, 60, 4)){ + + # Fleming-Harrington rho=0, gamma=0.5 test + FH05 <- gs_design_wlr(enrollRates = enrollRates, + failRates = failRates, + ratio = 1, + alpha = 0.025, beta = 0.15, + weight = function(x, arm0, arm1){wlr_weight_fh(x, arm0, arm1, rho = 0, gamma = 0.5)}, + upar = qnorm(.975), + lpar = -Inf, + analysisTimes = trial_duration) + + # regular logrank test + FH00 <- gs_power_wlr(enrollRates = FH05$enrollRates, + failRates = failRates, + ratio = 1, + weight = function(x, arm0, arm1){wlr_weight_fh(x, arm0, arm1, rho = 0, gamma = 0)}, + upar = qnorm(.975), + lpar = -Inf, + analysisTimes = trial_duration, + events = .1) + + # max combo test 1 + mc2_test <- data.frame(rho = 0, gamma = c(0, .5), tau = -1, + test = 1:2, Analysis = 1, analysisTimes = trial_duration) + + MC2 <- gs_power_combo(enrollRates = FH05$enrollRates, + failRates = failRates, + fh_test = mc2_test, + upper = gs_spending_combo, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025), + lower = gs_spending_combo, + lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.01)) + + # max combo test 2 + mc3_test <- data.frame(rho = c(0, 0, .5), gamma = c(0, .5, .5), tau = -1, + test = 1:3, Analysis = 1, analysisTimes = trial_duration) + + MC3 <- gs_power_combo(enrollRates = FH05$enrollRates, + failRates = failRates, + fh_test = mc3_test, + upper = gs_spending_combo, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025), + lower = gs_spending_combo, + lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.01)) + + # max combo test + mc4_test <- data.frame(rho = c(0, 0, .5, .5), gamma = c(0, .5, .5, 0), tau = -1, + test = 1:4, Analysis = 1, analysisTimes = trial_duration) + + MC4 <- gs_power_combo(enrollRates = FH05$enrollRates, + failRates = failRates, + fh_test = mc4_test, + upper = gs_spending_combo, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025), + lower = gs_spending_combo, + lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.01)) + + # Magirr-Burman rho=-1, gamma=0, tau = 6 test + MB6 <- gs_power_wlr(enrollRates = FH05$enrollRates, + failRates = failRates, + ratio = 1, + weight = function(x, arm0, arm1){wlr_weight_fh(x, arm0, arm1, rho = -1, gamma = 0, tau = 20)}, + upar = qnorm(.975), + lpar = -Inf, + analysisTimes = trial_duration, + events = .1) + + tab_new <- tibble(`Study duration` = trial_duration, + N = FH05$analysis$N[1], + Events = FH05$analysi$Events[1], + `Events/N` = Events/N, + # we use the AHR from regular WLR as the AHR of different max combo test + AHR = as.numeric(FH00$analysis$AHR[1]), + `FH(0, 0.5) power` = FH05$bounds$Probability[1], + `FH(0, 0) power` = FH00$bounds$Probability[1], + `MC2 power` = MC2$bounds$Probability[1], + `MC4 power` = MC4$bounds$Probability[1], + `MC3 power` = MC3$bounds$Probability[1], + `MB6 power` = MB6$bounds$Probability[1]) + tab <- rbind(tab, tab_new) +} + +tab %>% + gt() %>% + fmt_number(columns = c(2, 3), decimals = 1) %>% + fmt_number(columns = 4, decimals = 2) %>% + fmt_number(columns = 5, decimals = 4) %>% + fmt_number(columns = 6:11, decimals = 2) +``` + +# An Alternative Scenario + +Now we consider an alternate scenario where the placebo group starts with the same median, but then has a piecewise change to a median of 30 after 16 months and with a hazard ratio of 0.85 during that late period. + +```{r} +enrollRates <- tibble(Stratum = "All", duration = 12, rate = 1) +failRates <- tibble(Stratum = "All", + duration = c(6, 10, 100), + # in Scenario 1: failRate = log(2) / 15, + failRate = log(2) / c(15, 15, 30), + # in Scenario 1: hr = c(1, .6) + hr = c(1, .6, .85), + dropoutRate = 0.001) +enrollRates %>% gt() %>% tab_header(title = "Enrollment Table of Scenario 2") +failRates %>% gt() %>% tab_header(title = "Failure Table of Scenario 2") +``` + +```{r, message=FALSE} +tab <- NULL + +for(trial_duration in seq(20, 60, 4)){ + # Fleming-Harrington rho=0, gamma=0.5 test + FH05 <- gs_design_wlr(enrollRates = enrollRates, + failRates = failRates, + ratio = 1, + alpha = 0.025, beta = 0.15, + weight = function(x, arm0, arm1){wlr_weight_fh(x, arm0, arm1, rho = 0, gamma = 0.5)}, + upper = gs_b, + upar = qnorm(.975), + lower = gs_b, + lpar = -Inf, + analysisTimes = trial_duration) + + # regular logrank test + FH00 <- gs_power_wlr(enrollRates = FH05$enrollRates, + failRates = failRates, + ratio = 1, + weight = function(x, arm0, arm1){wlr_weight_fh(x, arm0, arm1, rho = 0, gamma = 0)}, + upper = gs_b, + upar = qnorm(.975), + lower = gs_b, + lpar = -Inf, + analysisTimes = trial_duration, + events = .1) + + # max combo test + mc2_test <- data.frame(rho = 0, gamma = c(0, .5), tau = -1, + test = 1:2, Analysis = 1, analysisTimes = trial_duration) + MC2 <- gs_power_combo(enrollRates = FH05$enrollRates, + failRates = failRates, + fh_test = mc2_test, + upper = gs_spending_combo, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025), + lower = gs_spending_combo, + lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.01)) + + # max combo test + mc3_test <- data.frame(rho = c(0,0,.5), gamma = c(0, .5, .5), tau = -1, + test = 1:3, Analysis = 1, analysisTimes = trial_duration) + + MC3 <- gs_power_combo(enrollRates = FH05$enrollRates, + failRates = failRates, + fh_test = mc3_test, + upper = gs_spending_combo, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025), + lower = gs_spending_combo, + lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.01)) + + # max combo test + mc4_test <- data.frame(rho = c(0,0,.5,.5), gamma = c(0, .5, .5, 0), tau = -1, + test = 1:4, Analysis = 1, analysisTimes = trial_duration) + + MC4 <- gs_power_combo(enrollRates = FH05$enrollRates, + failRates = failRates, fh_test = mc4_test, + upper = gs_spending_combo, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025), + lower = gs_spending_combo, + lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.01)) + + # Magirr-Burman rho=-1, gamma=0, tau = 6 test + MB6 <- gs_power_wlr(enrollRates = FH05$enrollRates, + failRates = failRates, + ratio = 1, + weight = function(x, arm0, arm1){wlr_weight_fh(x, arm0, arm1, rho = -1, gamma = 0, tau = 6)}, + upar = qnorm(.975), + lpar = -Inf, + analysisTimes = trial_duration, + events = .1) + + tab_new <- tibble(`Study duration` = trial_duration, + N = FH05$analysis$N[1], + Events = FH05$analysi$Events[1], + `Events/N` = Events/N, + # we use the AHR from regular WLR as the AHR of different max combo test + AHR = as.numeric(FH00$analysis$AHR[1]), + `FH(0, 0.5) power` = FH05$bounds$Probability[1], + `FH(0, 0) power` = FH00$bounds$Probability[1], + `MC2 power` = MC2$bounds$Probability[1], + `MC4 power` = MC4$bounds$Probability[1], + `MC3 power` = MC3$bounds$Probability[1], + `MB6 power` = MB6$bounds$Probability[1]) + + tab <- rbind(tab, tab_new) +} + +tab %>% + gt() %>% + fmt_number(columns = c(2, 3), decimals = 1) %>% + fmt_number(columns = 4, decimals = 2) %>% + fmt_number(columns = 5, decimals = 4) %>% + fmt_number(columns = 6:11, decimals = 2) +``` + + + + diff --git a/vignettes/eEventsTheory.Rmd b/vignettes/story_compute_expected_events.Rmd similarity index 90% rename from vignettes/eEventsTheory.Rmd rename to vignettes/story_compute_expected_events.Rmd index 29e93958f..6ad0ec33f 100644 --- a/vignettes/eEventsTheory.Rmd +++ b/vignettes/story_compute_expected_events.Rmd @@ -1,12 +1,21 @@ --- -title: Computing expected events by interval at risk -output: rmarkdown::html_vignette -bibliography: gsDesign.bib +title: "Computing expected events by interval at risk" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + number_sections: true + highlight: "textmate" + css: "custom.css" +bibliography: "ggsd.bib" vignette: > %\VignetteIndexEntry{Computing expected events by interval at risk} %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} --- + ```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, @@ -16,17 +25,18 @@ knitr::opts_chunk$set( message = FALSE, warning = FALSE ) - options(width = 58) + +devtools::load_all() ``` -## Introduction +# Introduction This document derives an algorithm for computing expected events observed for a model with piecewise constant enrollment, failure and dropout rates similar to @LachinFoulkes. Specifically, we design this to enable computation of an _average hazard ratio_ which we will use elsewhere to approximate sample size for fixed or group sequential designs under a non-proportional hazards assumption (@Kalbfleisch1981, @Schemper2009). The expected events calculation outlined here is implemented in the function `eEvents_df()`. -## General formulation and notation +# General formulation and notation For notation, the study time scale will denoted with $\omega$ with the study start first opening for enrollment at $\omega=0$. We will use the variable $t$ to indicate patient time with $t=0$ representing the time a patient is enrolled. @@ -60,7 +70,7 @@ P\{t_1% kable_styling(c("striped", "bordered")) %>% add_header_above(c("Failure and dropout rates" = 4, "Enrollment rates" = 3)) @@ -175,10 +186,11 @@ kable(x) %>% We define for $m=1,\ldots,M$ intermediate probability calculations for use in calculating $\bar n(t_{m-1},t_m)$ as follows: \begin{align} -q_m&=P\{\min(X_m,Y_m)>t_m\}=\exp^{-(\lambda_m+\eta_m)(t_m-t_{m-1})} \label{eq:qm}\\ +q_m&=P\{\min(X_m,Y_m)>t_m-t_{m-1}\}=\exp^{-(\lambda_m+\eta_m)(t_m-t_{m-1})} \label{eq:qm}\\ Q_m&=P\{\min(X,Y)>t_m\}=\prod_{j=1}^m q_j\label{eq:Qm}\\ d_m&=P\{t_{m-1}t_{m-1}\}P\{0t_{m-1}\}\cdot P\{0<\min (X_m,Y_m)\le t_m-t_{m-1},X_m\le Y_m\}\\ +&=P\{\min(X,Y)>t_{m-1}\}\cdot P\{0<\min (X_m,Y_m)\le t_m-t_{m-1}\}\cdot P\{X_m\le Y_m|0<\min (X_m,Y_m)\le t_m-t_{m-1}\}\\ &=Q_{m-1}(1-e^{-(\lambda_m+\eta_m)(t_m-t_{m-1})}) \frac{\lambda_m}{\lambda_m+\eta_m}\\ \bar n_m&=E\{\bar n(t_{m-1},t_m)\} @@ -204,7 +216,9 @@ We now add $q_m$, $Q_m$, and $d_m$ to the calculations above to enable computati ```{r,results='markup',warning=FALSE} namesTem <- names(x) + names(x) <- c("m", "tm", "lambda", "eta", "j", "omega", "gamma") + y <- x %>% mutate( tdel = tm - lag(tm, default = 0), @@ -212,27 +226,29 @@ y <- x %>% Q = lag(cumprod(q), default = 1), d = Q * (1 - q) * lambda / (lambda + eta), G = c(5, 5, 3, 0), - nbar = G * d + (lambda * Q * gamma) / (lambda + eta) * (tdel - (1 - q) / (lambda + eta)) - ) + nbar = G * d + (lambda * Q * gamma) / (lambda + eta) * (tdel - (1 - q) / (lambda + eta))) + yy <- y + names(yy) <- c( "$m$", "$t_m$", "$\\lambda_m$", "$\\eta_m$", "$j$", "$\\omega_j=t_M-t_{m-1}$", "$\\gamma_j$", "$t_m-t_{m-1}$", "$q_m$", "$Q_{m-1}$", "$d_m$", "$G_{j-1}$", "$\\bar{n}_m$" ) + yy <- yy %>% select(c(1:7, 12, 8:11, 13)) + yy %>% kable(digits = 4) %>% kable_styling(c("striped", "bordered")) %>% add_header_above(c( "Failure and dropout rates" = 4, "Enrollment" = 4, - "Events by time period" = 5 - )) + "Events by time period" = 5)) ``` -### Verifying calculations +## Verifying calculations We check the above for the total number of events using the **gsDesign** function `eEvents()`. First, we sum the $\bar{n}_m$ values `sum(y$nbar)` to get `r round(sum(y$nbar),6)` and compare to: @@ -244,29 +260,19 @@ Events <- gsDesign::eEvents( gamma = y$gamma[length(y$gamma):1], S = y$tdel[1:(length(y$tdel) - 1)], R = y$tdel[(length(y$tdel):1)], - T = max(y$tm) -)$d + T = max(y$tm))$d + Events ``` Next, we examine by the periods defined by `failRates`: ```{r} -library(gsDesign2) - eEvents_df( - enrollRates = tibble( - duration = c(1, 1), - rate = c(3, 2) - ), - failRates = tibble( - duration = c(4, 3), - failRate = c(.03, .06), - dropoutRate = c(.001, .002) - ), + enrollRates = tibble(duration = c(1, 1), rate = c(3, 2)), + failRates = tibble(duration = c(4, 3), failRate = c(.03, .06), dropoutRate = c(.001, .002)), totalDuration = 7, - simple = FALSE -) + simple = FALSE) ``` Now we group rows of `y` above into these same intervals. @@ -277,15 +283,17 @@ y %>% group_by(t) %>% summarise( failRate = first(lambda), - Events = sum(nbar) - ) + Events = sum(nbar)) ``` Finally, we approximate specific numbers using simulation. First, we simulate a large dataset and confirm the simulation has the targeted enrollment pattern. -```{r, warning=FALSE} -nsim <- 1000000 +```{r} +nsim <- 1e6 +``` + +```{r, warning=FALSE, eval=FALSE} xx <- simtrial::simPWSurv( n = nsim, block = (rep("xx", 4)), @@ -297,8 +305,13 @@ xx <- simtrial::simPWSurv( dropoutRates = tibble( Stratum = "All", period = 1:2, Treatment = "xx", rate = c(.001, .002), duration = c(4, Inf) - ) -) + )) + +save(xx, file = "./fixtures/compute_expected_events.Rdata") +``` + +```{r} +load("./fixtures/compute_expected_events.Rdata") ecat <- 1 + (xx$enrollTime > 1) + (xx$enrollTime > 2) cat("Enrollment pattern: ", table(ecat) / nsim) ``` @@ -314,4 +327,4 @@ cat("Event by interval: ", table(yy$tcat) / nsim * 5, "\n") cat("Total events: ", sum(yy$event) / nsim * 5) ``` -## References +# References \ No newline at end of file diff --git a/vignettes/story_compute_npe_bound.Rmd b/vignettes/story_compute_npe_bound.Rmd new file mode 100644 index 000000000..d33c69973 --- /dev/null +++ b/vignettes/story_compute_npe_bound.Rmd @@ -0,0 +1,159 @@ +--- +title: "Computing Bounds Under Non-Constant Treatment Effect" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + number_sections: true + highlight: "textmate" + css: "custom.css" +bibliography: "ggsd.bib" +vignette: > + %\VignetteIndexEntry{Computing Bounds Under Non-Constant Treatment Effect} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r setup, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +## Overview + +We consider group sequential designs with possibly non-constant treatment effects over time. +This can be useful for situations such as an assumed non-proportional hazards model as laid out in `vignette("NPEbackground", package="gsdmvn")`. +In general, we assume $K\ge 1$ analyses with statistical information $\mathcal{I}_k$ and information fraction $t_k=\mathcal{I}_k/\mathcal{I}_k$ at analysis $k$, $1\le k\le K$. +We denote the null hypothesis $H_{0}$: $\theta(t)=0$ and an alternate hypothesis $H_1$: $\theta(t)=\theta_1(t)$ for $t> 0$ where $t$ represents the information fraction for a study. +While a study is planned to stop at information fraction $t=1$, we define $\theta(t)$ for $t>0$ since a trial can overrun its planned statistical information at the final analysis. +As before, we use a shorthand notation in to have $\theta$ represent $\theta()$, $\theta=0$ to represent +$\theta(t)\equiv 0$ for all $t$ and $\theta_1$ to represent $\theta_i(t_k)$, the effect size at analysis $k$, $1\le k\le K$. + +For our purposes, $H_0$ will represent no treatment difference, but it could represent a non-inferiority hypothesis. +Recall that we assume $K$ analyses and bounds $-\infty \le a_k< b_k<\le \infty$ for $1\le k < K$ and $-\infty \le a_K\le b_K<\infty$. +We denote the probability of crossing the upper boundary at analysis $k$ without previously crossing a bound by + +$$\alpha_{k}(\theta)=P_{\theta}(\{Z_{k}\geq b_{k}\}\cap_{j=1}^{k-1}\{a_{j}\le Z_{j}< b_{j}\}),$$ +$k=1,2,\ldots,K.$ +The total probability of crossing an upper bound prior to crossing a lower bound is denoted by + +$$\alpha(\theta)\equiv\sum_{k=1}^K\alpha_k(\theta).$$ + +For non-binding bounds, we define the probability + +$$\alpha_{k}^{+}(\theta)=P_{\theta}\{\{Z_{k}\geq b_{k}\}\cap_{j=1}^{k-1} \{Z_{j}< b_{j}\}\}$$ +which ignores the lower bounds when computing upper boundary crossing probabilities. +The non-binding Type I error is the probability of ever crossing the upper bound +when $\theta=0$. The value $\alpha^+_{k}(0)$ is commonly referred to as +the amount of Type I error spent at analysis $k$, $1\leq k\leq K$. The +total upper boundary crossing probability for a trial is denoted in this +one-sided scenario by +$$\alpha^+(\theta) \equiv\sum_{k=1}^{K}\alpha^+_{k}(\theta).$$ +We will primarily be interested in $\alpha(\theta)$ to compute power when $\theta > 0$. +For Type I error, we may be interested in $\alpha(0)$ for binding lower bounds, but more often we will consider non-binding Type I error calculations, $\alpha^{+}(0)$. + +We denote the probability of crossing a lower bound at analysis $k$ without previously crossing any bound by + +$$\beta_{k}(\theta)=P_{\theta}((Z_{k}< a_{k}\}\cap_{j=1}^{k-1}\{ a_{j}\le Z_{j}< b_{j}\}).$$ + +Efficacy bounds $b_k$, $1\le k\le K$, for a group sequential design will be derived to control Type I at some level $\alpha=\alpha(0)$. + +Lower bounds $a_k$, $1\le k\le K$ may be used to control boundary crossing probabilities under either the null hypothesis (2-sided testing), the alternate hypothesis or some other hypothesis (futility testing). + +Thus, we may consider up to 3 values of $\theta(t)$: + +- under the null hypothesis $\theta_0(t)=0$ for computing efficacy bounds, +- under a value $\theta_1(t)$ for computing lower bounds, and +- under a value $\theta_a(t)$ for computing sample size or power. + +We refer to the information under these 3 assumptions as $\mathcal{I}^{(0)}(t)$, $\mathcal{I}^{(1)}(t)$, and $\mathcal{I}^{(a)}(t)$, respectively. Often we will assume +$\mathcal{I}(t)=\mathcal{I}^{(0)}(t)=\mathcal{I}^{(1)}(t)=\mathcal{I}^{(a)}(t).$ + +We note that information may differ under different values of $\theta(t)$. +For fixed designs, \cite{LachinBook} computes sample size based on different variances under the null and alternate hypothesis. + +## Spending bounds + +We consider different boundary types in the **gsDesign** package and simplify them into two types according to whether lower bounds are binding or non-binding. +The concept is to implicitly derive Z-value bounds $a_k, b_k, k=1,\cdots,K$ based on probabilities specified in the following table. +We include the `test.type` argument from the `gsDesign::gsDesign()` function for reference. + + + `test.type` Upper bound Lower bound Design type + ------------- ------------------- ------------------- ------------------------------------------ + 1 $\alpha_k^{+}(0)$ None One-sided efficacy + 2 $\alpha_k(0)$ $\alpha_k(0)$ 2-sided symmetric + 3 $\alpha_k(0)$ $\beta_k(\theta_a)$ $\beta$-spending with binding futility + 4 $\alpha_k^{+}(0)$ $\beta_k(\theta_a)$ $\beta$-spending with non-binding futility + 5 $\alpha_k(0)$ $\beta_i(\theta_1)$ $\theta$-spending with binding futility + 6 $\alpha^{+}(0)$ $\beta_i(\theta_1)$ $\theta$-spending with non-binding futility + + : Boundary crossing probabilities used to set Z-value boundaries + +This can be reduced to just two types distinguishing by whether or not lower bounds are binding or non-binding: + + `test.type` Upper bound Lower bound Design type + ------------- ------------------- ------------------- ------------------------------------------ + 2, 3, 5 $\alpha_k(0)$ $\beta_k(\theta)$ Binding lower bound + 1, 4, 6 $\alpha_k^{+}(0)$ $\beta_k(\theta)$ Non-binding lower bound + + : Reduced options for boundary crossing probabilities used to set Z-value boundaries + + +In this second table we have used $\theta=0$ to derive the upper bound to control Type I error in all cases. +We have chosen some arbitrary $\theta$ which could be 0 for any other `test.type`, $\theta_a$ for $\beta$-spending or some arbitrary $\theta_1$ otherwise. +We note that for a one-sided design we let $\beta_k(\theta)=0$ so that $a_k=-\infty, k=1,\cdots,K$. +For `test.type=3, 4` we let $\theta=\theta_a$, while for `test.type=5, 6` $\theta\ge 0$ is arbitrary. +We note that asymmetric $\alpha$-spending bounds can be derived using `test.type > 2` and $\theta=0.$ + +## Two-sided testing and design + +We denote an alternative $H_{a}$: $\theta(t)=\theta_a(t)$; we will always assume $H_a$ for power calculations; when using $\beta$-spending we will also use $H_a$ for controlling lower boundary $a_k$ crossing probabilities by letting $\theta=\theta_a$ for lower bound spending. +A value of $\theta(t)>0$ will reflect a positive benefit. +We will not restrict the alternate hypothesis to $\theta_a(t)>0$ for all $t$. +The value of $\theta(t)$ will be referred to as the (standardized) treatment effect at information fraction $t$. + +We assume there is interest in stopping early if there is good evidence to reject one hypothesis in favor of the other. + +If $a_k= -\infty$ at analysis $k$ for some $1\le k\le K$ then the alternate hypothesis cannot be rejected at analysis $k$; i.e., there is no futility bound at analysis $k$. +For $k=1,2,\ldots,K$, the trial is stopped at analysis $k$ to reject $H_0$ if $a_j0$ such as $\epsilon= 0.001$ which yields $b_k=3.09$. +While the original proposal was to use $b_K=\Phi^{-1}(1-\alpha)$ at the final analysis, to fully control one-sided Type I error at level $\alpha$ we suggest computing the final bound $b_K$ using the above algorithm so that $\alpha(0)=\alpha$. + +Bounds computed with spending $\alpha_k(0)$ at analysis $k$ can be computed by using equation (9) for $b_1$. +Then for $k=2,\ldots,K$ the algorithm of the previous section is used. +As noted by @JTBook, $b_1,\ldots,b_K$ if determined under the null hypothesis depend only on $t_k$ and $\alpha_k(0)$ with no dependence on $\mathcal{I}_k$, $k=1,\ldots,K$. +When computing bounds based on $\beta_k(\theta)$, $k=1,\ldots,K$, where some $\theta(t_k)\neq 0$ we have an additional dependency with $a_k$ depending not only on $t_k$ and $b_k$, $k=1,\ldots,K$, but also on the final total information $\mathcal{I}_K$. +Thus, a spending bound under something other than the null hypothesis needs to be recomputed each time $\mathcal{I}_K$ changes, whereas it only needs to be computed once when $\theta(t_k)=0$, $k=1,\ldots,K$. + +### Bounds based on boundary families + +Assume constants $b_1^*,\ldots,b_K^*$ and a total targeted one-sided Type I error $\alpha$. +We wish to find $C_u$ as a function of $t_1,\ldots t_K$ such that if $b_k=C_ub_k^*$ then $\alpha(0)=\alpha.$ +Thus, the problem is to solve for $C_u$. If $a_k$, $k=1,2,\ldots,K$ are fixed then this is a simple root finding problem. +Since one normally normally uses non-binding efficacy bounds, it will normally be the case that $a_k=-\infty$, $k=1,\ldots,K$ for this problem. + +Now we assume constants $a_k^*$ and wish to find $C_l$ such that if $a_k=C_la_k^*+\theta(t_k)\sqrt{\mathcal{I}_k}$ for $k=1,\ldots,K$ then +$\beta(\theta)=\beta$. If we use the constant upper bounds from the previous paragraph, finding $C_l$ is a simple root-finding problem. + +For 2-sided symmetric bounds with $a_k=-b_k$, $k=1,\ldots,K$, we only need to solve for $C_u$ and again use simple root finding. + +At this point, we do not solve for this type of bound for asymmetric upper and lower bounds. + +## Sample size + +For sample size, we assume $t_k$, and $\theta(t_k)$ $1,\ldots,K$ are fixed. +We assume $\beta(\theta)$ is decreasing as $\mathcal{I}$ is decreasing. +This will automatically be the case when $\theta(t_k)>0$, $k=1,\ldots,K$ and for many other cases. +Thus, the information required is done by a search for $\mathcal{I_K}$ that yields $\alpha(\theta)$ yields the targeted power. + +## References diff --git a/vignettes/story_design_with_ahr.Rmd b/vignettes/story_design_with_ahr.Rmd new file mode 100644 index 000000000..104788fe0 --- /dev/null +++ b/vignettes/story_design_with_ahr.Rmd @@ -0,0 +1,455 @@ +--- +title: "Design Using Average Hazard Ratio" +date: "`r format(Sys.time(), '%d %B, %Y')`" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + number_sections: true + highlight: "textmate" + css: "custom.css" +bibliography: "ggsd.bib" +vignette: > + %\VignetteIndexEntry{Design Using Average Hazard Ratio} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown} +--- + +```{r setup, include=FALSE, message=FALSE, warning=FALSE} +knitr::opts_chunk$set(echo = TRUE) +``` + +# Introduction + +We consider fixed and group sequential design under non-proportional hazards when testing with the logrank test. +We focus primarily on the average hazard ratio approach, expanding the asymptotic approach of @Mukhopadhyay2020 to both group sequential design and more complex enrollment assumptions. +The theoretical background for this is provided in other vignettes in this package. +We provide a few basic examples along the lines of @NPHWG2020sim for illustration of design considerations under the following assumptions: + +1. Proportional hazards +1. Short delayed effect +1. Longer delayed effect +1. Crossing survival + +Illustrations include + +1. Expected average hazard ratio (AHR) over time. +1. Expected event accumulation over time. +1. The impact of planned study duration on required number of events. +1. Power across scenarios when a trial is designed under the assumption of a short delayed effect. +1. Timing of interim analyses. +1. $\alpha$-spending considerations. + +We focus on results rather than code, but hidden code can be revealed for all examples. + +# Packages used + +The primary packages needed are **gsdmvn** and **gsDesign2** which will likely be combined into **gsDesign2** in the near future. +Other packages used are supportive. + +```{r packages, message=FALSE, warning=FALSE} +library(gsDesign) +library(ggplot2) +library(dplyr) +library(gt) +library(tidyr) +library(tibble) +devtools::load_all() +``` + + +# Scenarios + +Expected enrollment duration is 18 months with piecewise constant enrollment rates escalating every 2 months until month 6 where enrollment is assumed to have reached steady state. +We will later assume a similar ramp-up period with 24 months expected enrollment duration. + +```{r} +# Set the enrollment table of totally 24 month +enroll24 <- tibble( + Stratum = rep("All", 4), # un-stratified + duration = c(rep(2, 3), 18), # 6 month ramp-up of enrollment, 24 months enrollment time target + rate = 1:4 # ratio of the enrollment rate + ) +# Adjust enrollment rates to enroll 100 subjects +enroll24$rate <- enroll24$rate * 100 / sum(enroll24$duration * enroll24$rate) + +# Set the enrollment table for 18 month expected enrollment +enroll18 <- tibble( + Stratum = rep("All", 4), # un-stratified + duration = c(rep(2, 3), 12), # 6 month ramp-up of enrollment, 18 months enrollment time target + rate = 1:4 # ratio of the enrollment rate + ) +# Adjust enrollment rates to enroll 100 subjects +enroll18$rate <- enroll18$rate * 100 / sum(enroll18$duration * enroll18$rate) + +# Put these in a single tibble by scenario +# We will use 18 month enrollment for delayed effect and crossing hazards scenarios +enrollRates <- rbind( + enroll18 %>% mutate(Scenario = "PH"), + enroll18 %>% mutate(Scenario = "Shorter delayed effect"), + enroll18 %>% mutate(Scenario = "Longer delayed effect"), + enroll18 %>% mutate(Scenario = "Crossing") +) +``` + +We will consider the following failure rate assumptions: + +- PH: Proportional hazards is assumed. + - Control group has exponential failure rate with a median of 14 months. + - Constant hazard ratio of 0.7 (experimental/control). +- Shorter delayed effect + - Control group has exponential failure rate with a median of 10 months. + - Hazard ratio of 1 for 6 months followed by a hazard ratio of 0.6. +- Longer delayed effect + - Control group has exponential failure rate with a median of 10 months. + - Hazard ratio of 1 for 6 months followed by a hazard ratio of 0.6. +- Crossing hazards + - Control group has exponential failure rate with a median of 10 months. + - Hazard ratio of 1.5 for 4 months followed by a hazard ratio of 0.5. + + +```{r, } +Month <- c(0, 4, 6, 44) +duration <- Month - c(0, Month[1:3]) +control_rate <- log(2) / c(rep(16, 4), rep(14, 4), rep(14, 4)) +s <- tibble(Scenario = c(rep("PH", 4), rep("Delayed effect", 4), rep("Crossing", 4)), + Treatment = rep("Control", 12), + Month = rep(Month, 3), + duration = rep(duration, 3), + rate = control_rate, + hr = c(rep(.7, 4), c(1, 1, 1, .575), c(1.5,1.5, .5, .5))) + +s <- rbind(s, + s %>% mutate(Treatment = "Experimental", rate = rate * hr)) %>% + group_by(Scenario, Treatment) %>% + mutate(Survival = exp(-cumsum(duration * rate))) +ggplot(s, aes(x = Month, y = Survival, col = Scenario, lty = Treatment)) + + geom_line() + + scale_y_log10(breaks = (1 : 10) / 10, lim = c(.1, 1))+ + scale_x_continuous(breaks = seq(0, 42, 6)) +``` + + +```{r} +# get 4 scenarios +control_median <- c(14, 12, 12, 12) +Month <- c(0, 4, 6, 44) +duration <- Month - c(0, Month[1:3]) +# HR by time period for each scenario +hr <- c(rep(.7, 4), # constant hazard ratio of 0.7 + 1, 1, .6, .6, # hazard ratio of 1 for 4 months followed by a hazard ratio of 0.6. + 1, 1, 1, .6, # hr = 1 for 6 months followed by hr = .6 + 1.5, 1.5, .5, .5) # hazard ratio of 1.5 for 4 months followed by a hazard ratio of 0.5. +``` + +The survival curves for these 4 scenarios are shown below: + +```{r} +# Put parameters together in a tibble +s <- tibble( + Scenario = c(rep("PH", 4), rep("Shorter delayed effect", 4), rep("Longer delayed effect", 4), rep("Crossing", 4)), + Treatment = rep("Control", 16), + Month = rep(Month, 4), # Periods for constant HR + duration = rep(duration, 4), + rate = log(2) / c(rep(control_median[1], 4), + rep(control_median[2], 4), + rep(control_median[3], 4), + rep(control_median[4], 4)), + hr = hr) + +# calculate the survival at each change point for each scenario +s <- rbind(s, s %>% mutate(Treatment = "Experimental", rate = rate * hr)) %>% + group_by(Scenario, Treatment) %>% + mutate(Survival = exp(-cumsum(duration * rate))) +``` + +```{r, fig.width=3} +# plot the survival curve +ggplot(s, aes(x = Month, y = Survival, col = Scenario, lty = Treatment, shape = Treatment)) + + geom_line() + + annotate("text", x = 18, y = .1, label = "Control for scenarios other than PH have same survival") + + scale_y_log10(breaks = (1:10) /10, lim = c(.07, 1)) + + scale_x_continuous(breaks = seq(0, 42, 6)) + + ggtitle("Survival over time for 4 scenarios studied") +``` + +The average hazard ratio for these 4 scenarios are shown below. +We note that under the *Shorter delayed effect* scenario, the average hazard ratio approaches that of the *PH* scenario after a study duration of about 36 months. + +```{r} +# Durations to be used in common for all failure rate scenarios +dur <- Month[2:4] - Month[1:3] + +# Set the failure table +# We use exponential failure, proportional hazards +failRates <- rbind( + tibble(Scenario = "PH", Stratum = "All", + duration = dur, failRate = log(2) / 14, + hr = hr[1], dropoutRate = .001), + tibble(Scenario = "Shorter delayed effect", Stratum = "All", + duration = dur, failRate = log(2) / 11, + hr = hr[6:8], dropoutRate = .001), + tibble(Scenario = "Longer delayed effect", Stratum = "All", + duration = dur, failRate = log(2) / 11, + hr = hr[10:12], dropoutRate = .001), + tibble(Scenario = "Crossing", Stratum = "All", + duration = dur, failRate = log(2) / 11, + hr = hr[14:16], dropoutRate = .001)) + +hr <- do.call( + rbind, + lapply( + c("PH", "Shorter delayed effect", "Longer delayed effect", "Crossing"), + function(x){ + AHR(enrollRates = enrollRates %>% filter(Scenario == x), + failRates = failRates %>% filter(Scenario == x), + totalDuration = c(.001, seq(4, 44, 4))) %>% mutate(Scenario = x) + })) +``` + +```{r, fig.width=3.5} +ggplot(hr, aes(x = Time, y = AHR, col = Scenario)) + + geom_line() + + scale_x_continuous(breaks = seq(0, 42, 6)) + + ggtitle("Average hazard ratio (AHR) by study duration", + subtitle = "Under the 4 scenarios examined") +``` + +The number of events for these 4 scenarios are shown below. +Under the 3 NPH scenarios events accumulate faster than under the PH scenario both due to a lower control median and/or a delayed effect. + +```{r, fig.width=3.5} +ggplot(hr, aes(x = Time, y = `Events`, col = Scenario)) + + geom_line() + + scale_x_continuous(breaks = seq(0, 42, 6)) + + ylab("Expected events per 100 enrolled") + + ggtitle("Expected event accumulation under the 4 scenarios studied") +``` +From the above, we see that slight variations in control failure rates and the potential for a delayed effect can substantially accelerate the accumulation of events. +If doing an event-based cutoff for analysis these slight variations can lead to earlier analyses than anticipated when the average hazard ratio that is expected with longer follow-up would never be achieved. +We examine the implications further below. + +# Sample Size and Events by Scenarios + +## Fixed Design using AHR and Logrank + +We power a fixed design at 90\% with 2.5\% one-sided Type I error under the different scenarios under consideration. +We now assume the 18 month enrollment pattern for all scenarios. +For the *PH* and *Shorter delayed effect* scenarios we need a similar AHR, number of events and sample size for a 36 month study. +The other two scenarios with crossing survival curves or a large effect delay would require substantially larger sample sizes due to not achieving a similar AHR by month 36. + +```{r} +ss_ahr_fixed <- do.call( + rbind, + lapply(c("PH", "Shorter delayed effect", "Longer delayed effect", "Crossing"), + function(x) { + xx <- gs_design_ahr(enrollRates = enrollRates %>% filter(Scenario == x), + failRates = failRates %>% filter(Scenario == x), + analysisTimes = 36, + upper = gs_b, + upar = qnorm(.975), + lower = gs_b, + lpar = -Inf, + alpha = .025, + beta = .1) + ans <- xx$analysis %>% select(Time, N, Events, AHR) %>% mutate(Scenario = x) + return(ans) + } + ) + ) + + +ss_ahr_fixed %>% + gt() %>% + fmt_number(columns = 1:3,decimals = 0) %>% + fmt_number(columns = 4, decimals = 3) %>% + tab_header(title = "Sample Size and Events Required by Scenario", + subtitle = "36 Month Trial duration, 2.5% One-sided Type 1 Error, 90% Power") +``` + +Assuming the shorter delayed effect is the primary scenario for which we wish to protect power, how long should the trial be to optimize the tradeoffs between sample size, AHR and events required? +We will inform this tradeoff by looking sizing the trial for different assumed trial durations with the same failure rates and assumed relative enrollment rates. +The counts of events required is perhaps the most interesting here in that a 24 month trial requires almost twice the events to be powered at 90% compared to a trial of 42 months duration. +For further study, we will consider the 36 month trial duration as a reasonable tradeoff between time, sample size and power under a presumed delayed effect of 4 months followed by a hazard ratio of 0.6 thereafter. + +```{r} +do.call( + rbind, + lapply(c(24, 30, 36, 42), + function(x){ + ans <- gs_design_ahr(enrollRates = enrollRates %>% filter(Scenario == "Shorter delayed effect"), + failRates = failRates %>% filter(Scenario == "Shorter delayed effect"), + analysisTimes = x, + upper = gs_b, upar = qnorm(.975), + lower = gs_b, lpar = -Inf, + alpha = .025, + beta = .1)$analysis %>% + select(Time, N, Events, AHR) %>% + mutate(Scenario = "Shorter delayed effect") + return(ans) + } + ) + ) %>% + gt() %>% + fmt_number(columns = 1:3, decimals = 0) %>% + fmt_number(columns = 4, decimals = 3) %>% + tab_header(title = "Sample Size and Events Required by Trial Duration", + subtitle = "Delayed Effect of 4 Months, HR = 0.6 Thereafter; 90% Power") +``` + + +## Alternate Hypothesis Mapping + +Under the different scenarios of interest, we can examine the expected number of events in time periods of interest. + +```{r, message=FALSE} +events_by_time_period <- NULL + +for(g in c("PH", "Shorter delayed effect", "Longer delayed effect", "Crossing")){ + events_by_time_period <- rbind( + events_by_time_period, + + AHR(enrollRates = enrollRates %>% filter(Scenario == g), + failRates = failRates %>% filter(Scenario == g), + totalDuration = c(12, 20, 28, 36), simple = FALSE) %>% mutate(Scenario = g)) +} +``` + +Recall that our alternate hypothesis assumes no treatment effect (HR=1) for 4 months and then HR = 0.6 thereafter. +For any of the above scenarios, if we wish to base a futility bound on this assumption plus the above number of events in the first 4 months and after 4 months, then we can compute the average hazard ratio under the alternate hazard ratio for each scenario at 20 months as follows. +You can see that an interim futility spending bound based on the alternate hypothesis can depend fairly heavily on enrollment and the control failure rate. +Note also that at the time of interim analysis, the alternate hypothesis AHR can be computed in this same fashion based on observed events by time period. +Note that this can be quite different than the scenario HR; e.g., for PH, we assume HR=0.7 throughout, but for the futility bound comparison, we compute blinded AHR that decreases with each analysis under the alternate hypothesis. + + +```{r, message=FALSE} +# Time periods for each scenario were 0-4, 4-6, and 6+ +# Thus H1 has HR as follows +hr1 <- tibble(t = c(0, 4, 6), hr1 = c(1, .6, .6)) + +ahr_by_analysis <- events_by_time_period %>% + full_join(hr1) %>% + group_by(Scenario, Time) %>% + summarize(AHR1 = exp(sum(Events * log(hr1))/ sum(Events))) + +ahr_by_analysis %>% + pivot_wider(names_from = Scenario, values_from = AHR1) %>% + gt() %>% + fmt_number(columns=2:5, decimals = 3) +``` + + +## Group Sequential Design + +Here we assume the design is under a delayed effect model where the delay is not too long and the long-term average hazard ratio benefit is strong. +proportional hazards scenario, but we look at power under the alternate scenarios. +We will plan a 36 month group sequential design under the Shorter delayed effect scenario. +Interim analyses are planned after 12, 20, and 28 months. + + +### AHR method + +```{r} +analysisTimes <- c(12, 20, 28, 36) +upar <- list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL, theta = 0) +lpar <- list(sf = gsDesign::sfHSD, total_spend = .1, param = -2, timing = NULL, theta = NULL) + +NPHasymmetric <- gs_design_ahr(enrollRates = enrollRates, + failRates = failRates, + ratio = 1, alpha = .025, beta = 0.1, + # Information fraction not required (but available!) + analysisTimes = analysisTimes, + # Function to enable spending bound + upper = gs_spending_bound, + lower = gs_spending_bound, + # Spending function and parameters used + upar = upar, + lpar = lpar) + +summary(NPHasymmetric) %>% as_gt() +``` + +By scenario, we now wish to compute the adjusted expected futility bounds and the power implied. + +```{r, message= FALSE} +do.call( + rbind, + lapply( + c("PH", "Shorter delayed effect","Longer delayed effect", "Crossing"), + function(x){ + AHR1 <- (ahr_by_analysis %>% filter(Scenario == x))$AHR1 + + lparx <- lpar + lparx$theta1 <- -log(AHR1) + + yy <- gs_power_ahr(enrollRates = enrollRates %>% filter(Scenario == x), + failRates = failRates %>% filter(Scenario == x), + events = NULL, + analysisTimes = c(12, 20, 28, 36), + upper = gs_spending_bound, + upar = upar, + lower = gs_spending_bound, + lpar = lparx)$analysis %>% + mutate(Scenario = x) + } + ) + ) %>% + gt() %>% + fmt_number(columns = "Events", decimals = 1) %>% + fmt_number(columns = 5:10, decimals = 4) +``` + +### Weighted Logrank Method + +We investigate two types of the weighting scheme for weight logrank method. + +The fixed design under the first weighting scheme for four scenario are summarized as follows. +```{r, eval = FALSE} +do.call( + rbind, + lapply( + c("PH", "Shorter delayed effect","Longer delayed effect", "Crossing"), + function(x){ + gs_design_wlr(enrollRates = enrollRates %>% filter(Scenario == x), + failRates = failRates %>% filter(Scenario == x), + weight = function(x, arm0, arm1){wlr_weight_fh(x, arm0, arm1, rho = 0, gamma = 0.5, tau = 4)}, + alpha = .025, + beta = .1, + upar = qnorm(.975), + lpar = -Inf, + analysisTimes = 44)$analysis %>% + mutate(Scenario = x) + } + )) %>% + gt() %>% + fmt_number(columns = 3:6, decimals = 4) +``` + +The fixed design under the second weighting scheme for four scenario are summarized as follows. + +```{r} +# Ignore tau or (tau can be -1) +do.call( + rbind, + lapply( + c("PH", "Shorter delayed effect","Longer delayed effect", "Crossing"), + function(x){ + gs_design_wlr(enrollRates = enrollRates %>% filter(Scenario == x), + failRates = failRates %>% filter(Scenario == x), + weight = function(x, arm0, arm1){wlr_weight_fh(x, arm0, arm1, rho = 0, gamma = 0.5)}, + alpha = .025, + beta = .1, + upar = qnorm(.975), + lpar = -Inf, + analysisTimes = 44)$analysis %>% + mutate(Scenario = x) + } + )) %>% + gt() %>% + fmt_number(columns = 3:6, decimals = 4) +``` + + + +# References diff --git a/vignettes/story_design_with_spending.Rmd b/vignettes/story_design_with_spending.Rmd new file mode 100644 index 000000000..798640c26 --- /dev/null +++ b/vignettes/story_design_with_spending.Rmd @@ -0,0 +1,213 @@ +--- +title: "Trial design with spending under NPH" +date: "`r format(Sys.time(), '%d %B, %Y')`" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + number_sections: true + highlight: "textmate" + css: "custom.css" +# bibliography: "example.bib" +vignette: > + %\VignetteIndexEntry{Trial design with spending under NPH} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +```{r, message=FALSE, warning=FALSE} +#library(gsdmvn) +devtools::load_all() +library(dplyr) +library(tibble) +library(gsDesign) +library(gsDesign2) +library(gt) +``` + +# Overview + +This vignette covers how to implement designs for trials with spending assuming non-proportional hazards. +We are primarily concerned with practical issues of implementation rather than design strategies, but we will not ignore design strategy. + +# Scenario for Consideration + +Here we set up enrollment, failure and dropout rates along with assumptions for enrollment duration and times of analyses. + +In this example, we assume there are 4 analysis (3 interim analysis + 1 final analysis), and they are conducted after 18, 24, 30, 36 months after the trail starts. +```{r} +K <- 4 +analysisTimes <- c(18, 24, 30, 36) +``` + +And we further assume there is not stratum and the enrollment last for 12 months. +For the first 2 months, second 2 months, third 2 months and the reminder month, the enrollment rate is $8:12:16:24$. +Please note that $8:12:16:24$ is not the real enrollment rate. +Instead, it only specifies the enrollment rate ratio between different duration. +```{r} +enrollRates <- tibble( + Stratum = "All", + duration = c(2, 2, 2, 6), + rate = c(8, 12, 16, 24)) + +enrollRates %>% + gt() %>% + tab_header(title = "Table of Enrollment") +``` + +Moreover, we assume the hazard ratio (HR) of the first 3 month is 0.9 and thereafter is 0.6. +We also assume the the survival time follow a piecewise exponential distribution with a median of 8 month for the first 3 months and 14 month thereafter. +```{r} +failRates <- tibble( + Stratum = "All", + duration = c(3, 100), + failRate = log(2) / c(8, 14), + hr = c(.9, .6), + dropoutRate = .001) + +failRates %>% + gt() %>% + tab_header(title = "Table of Failure Rate") +``` + +# Deriving Power for a Given Sample Size + +In this section, we discuss how to drive the power, given a known sample size. + +First, we calculate the number of events and statistical information (both under H0 and H1) at targeted analysis times. + +```{r} +xx <- AHR(enrollRates = enrollRates, + failRates = failRates, + totalDuration = analysisTimes) + +xx %>% gt() +``` + +Then, we can use `gs_info_ahr()` to calculate (1) the treatment effect (`theta`), (2) AHR, (3) the statistical information (both under H0 and H1) under the targeted number of events. + +```{r} +#Events <- ceiling(xx$Events) +yy <- gs_info_ahr(enrollRates = enrollRates, + failRates = failRates, + events = ceiling(xx$Events)) %>% + mutate(timing = info0 / max(info0)) + +yy %>% + gt() %>% + fmt_number(columns = 2:8, decimals = 4) +``` + +Finally, we can calculate the power of `yy` by using `gs_power_npe()`. + +```{r} +zz <- gs_power_npe( + # set the treatment effet + theta = yy$theta, + # set the statistical information under H0 and H1 + info = yy$info, + info0 = yy$info0, + # set the upper bound + upper = gs_b, + upar = gsDesign(k = K, test.type = 2, sfu = sfLDOF, alpha = .025, timing = yy$timing)$upper$bound, + # set the lower bound + lower = gs_b, + lpar = gsDesign(k = K, test.type = 2, sfu = sfLDOF, alpha = .025, timing = yy$timing)$lower$bound) + +zz %>% + filter(Bound == "Upper") %>% + select(Analysis, Bound, Z, Probability, IF) %>% + gt() %>% + fmt_number(columns = 3:5, decimals = 4) +``` +From the above table, we find the power is 0.6267. + +# Deriving Sample Size for a Given Power + +In this section, we discuss how to calculate the sample size for a given power (we take the given power as 0.9 in this section). +And we discuss the calulation into 2 scenario: (1) fixed design and (2) group sequential design. + +```{r} +target_power <- 0.9 +``` + +## Fixed Design + +If we were using a fixed design, we would approximate the sample size as follows: + +```{r} +minx <- ((qnorm(.025) / sqrt(zz$info0[K]) + qnorm(1 - target_power) / sqrt(zz$info[K])) / zz$theta[K])^2 +minx +``` + +If we inflate the enrollment rates by `minx` and use a fixed design, we will see this achieves the targeted power. + +```{r} +gs_power_npe( + theta = yy$theta[K], + info = yy$info[K] * minx, + info0 = yy$info0[K] * minx, + upar = qnorm(.975), + lpar = -Inf) %>% + filter(Bound == "Upper") %>% + select(Probability) +``` + +## Group Sequential Design + +The power for a group sequential design with the same final sample size is a bit lower: + +```{r} +gs_power_npe( + theta = yy$theta, + info = yy$info * minx, + info0 = yy$info0 * minx, + upper = gs_spending_bound, + lower = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), + lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL) + ) %>% + filter(Bound == "Upper", Analysis == K) %>% + select(Probability) %>% + gt() +``` + +If we inflate this a bit we will be overpowered. + +```{r} +gs_power_npe( + theta = yy$theta, + info = yy$info * minx * 1.2, + info0 = yy$info0 * minx * 1.2, + upper = gs_spending_bound, + lower = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), + lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL)) %>% + filter(Bound == "Upper", Analysis == K) %>% + select(Probability) %>% + gt() +``` + +Now we use `gs_design_npe()` to inflate the information proportionately to power the trial. + +```{r} +gs_design_npe( + theta = yy$theta, + info = yy$info, + info0 = yy$info0, + upper = gs_spending_bound, + lower = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), + lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL)) %>% + filter(Bound == "Upper", Analysis == K) %>% + select(Probability) %>% + gt() +``` diff --git a/vignettes/story_npe_background.Rmd b/vignettes/story_npe_background.Rmd new file mode 100644 index 000000000..e90c011b3 --- /dev/null +++ b/vignettes/story_npe_background.Rmd @@ -0,0 +1,179 @@ +--- +title: "Non-Proportional Effect Size in Group Sequential Design" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + number_sections: true + highlight: "textmate" + css: "custom.css" +bibliography: "ggsd.bib" +vignette: > + %\VignetteIndexEntry{Non-Proportional Effect Size in Group Sequential Design} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +library(tibble) +library(dplyr) +library(knitr) +devtools::load_all() +``` + +## Overview + +The acronym NPES is short for non-proportional effect size. +While it is motivated primarily by a use for when designing a time-to-event trial under non-proportional hazards (NPH), we have simplified and generalized the concept here. The model is likely to be useful for rank-based survival tests beyond the logrank test that will be considered initially by @Tsiatis. +It could also be useful in other situations where treatment effect may vary over time in a trial for some reason. +We generalize the framework of Chapter 2 of @PLWBook to incorporate the possibility of the treatment effect changing during the course of a trial in some systematic way. +This vignettes addresses distribution theory and initial technical issues around computing + +- boundary crossing probabilities +- bounds satisfying targeted boundary crossing probabilities + +This is then applied to generalize computational algorithms provided in Chapter 19 of @JTBook that are used to compute boundary crossing probabilities as well as boundaries for group sequential designs. +Additional specifics around boundary computation, power and sample size are provided in a separate vignette. + +## The probability model + +### The continuous model and E-process + +We consider a simple example here to motivate distribution theory that is quite general and applies across many situations. +For instance @PLWBook immediately suggest paired observations, time-to-event and binary outcomes as endpoints where the theory is applicable. + +We assume for a given integer $N>0$ that $X_{i}$ are independent, $i=1,2,\ldots$. +For some integer $K\le N$ we assume we will perform analysis $K$ times after $0% kable(escape = FALSE) +``` + +### Conditional independence, covariance and canonical form + +We assume independent increments in the B-process. +That is, for $1\le j < k\le K$ +$$\tag{1} B_k - B_j \sim \hbox{Normal} (\sqrt{\mathcal{I}_K}(t_k\theta(t_k)- t_j\theta(t_j)), t_k-t_j)$$ +independent of $B_1,\ldots,B_j$. +As noted above, for a given $1\le k\le K$ we have for our example +$$B_j=\sum_{i=1}^{n_j}X_i / \sqrt N.$$ +Because of independence of the sequence $X_i$, $i=1,2,\ldots$, we immediately have for $1\le j\le k\le K$ +$$\hbox{Cov}(B_j,B_k) = \hbox{Var}(B_j) = t_j.$$ +This leads further to +$$\hbox{Corr}(B_j,B_k)=\frac{t_j}{\sqrt{t_jt_k}}=\sqrt{t_j/t_k}=\hbox{Corr}(Z_j,Z_k)=\hbox{Cov}(Z_j,Z_k)$$ +which is the covariance structure in the so-called *canonical form* of @JTBook. +For our example, we have +$$B_k=\frac{1}{\sqrt N}\sum_{i=1}^{n_k}X_i$$ +and +$$B_k-B_j=\frac{1}{\sqrt N}\sum_{i=n_j + 1}^{n_k}X_i$$ +and the covariance is obvious. +We assume independent increments in the B-process that will be demonstrated for the simple example above. +That is, for $1\le j < k\le K$ +$$\tag{1} B_k - B_j \sim \hbox{Normal} (\mathcal{I}_k\theta(t_k)- \mathcal{I}_j\theta(t_j), t_k-t_j)$$ +independent of $B_1,\ldots,B_j$. +For a given $1\le j\le k\le K$ we have for our example +$$B_j=\sum_{i=1}^{n_j}X_i / (\sqrt N\sigma).$$ +Because of independence of the sequence $X_i$, $i=1,2,\ldots$, we immediately have for $1\le j\le k\le K$ +$$\hbox{Cov}(B_j,B_k) = \hbox{Var}(B_j) = t_j/t_k =\mathcal{I}_j/\mathcal{I}_k.$$ +This leads to +$$\mathcal{I}_j/\mathcal{I}_k=\sqrt{t_j/t_k}=\hbox{Corr}(B_j,B_k)=\hbox{Corr}(Z_j,Z_k)=\hbox{Cov}(Z_j,Z_k)$$ +which is the covariance structure in the so-called *canonical form* of @JTBook. +The independence of $B_j$ and +$$B_k-B_j=\sum_{i=n_j + 1}^{n_k}X_i/(\sqrt N\sigma)$$ +is obvious for this example. + +## Test bounds and crossing probabilities + +In this section we define notation for bounds and boundary crossing probabilities for a group sequential design. +We also define an algorithm for computing bounds based on a targeted boundary crossing probability at each analysis. +The notation will be used elsewhere for defining one- and two-sided group sequential hypothesis testing. +A value of $\theta(t)>0$ will reflect a positive benefit. + +For $k=1,2,\ldots,K-1$, interim cutoffs $-\infty \le a_k< b_k\le \infty$ are set; final cutoffs $-\infty \le a_K\leq b_K <\infty$ are also set. +An infinite efficacy bound at an analysis means that bound cannot be crossed at that analysis. +Thus, $3K$ parameters define a group sequential design: $a_k$, $b_k$, and $\mathcal{I}_k$, $k=1,2,\ldots,K$. + +### Notation for boundary crossing probabilities + +We now apply the above distributional assumptions to compute boundary crossing probabilities. +We use a shorthand notation in this section to have $\theta$ represent $\theta()$ and $\theta=0$ to represent $\theta(t)\equiv 0$ for all $t$. +We denote the probability of crossing the upper boundary at analysis $k$ without previously crossing a bound by + +$$\alpha_{k}(\theta)=P_{\theta}(\{Z_{k}\geq b_{k}\}\cap_{j=1}^{i-1}\{a_{j}\le Z_{j}< b_{j}\}),$$ +$k=1,2,\ldots,K.$ + + +Next, we consider analogous notation for the lower bound. For $k=1,2,\ldots,K$ +denote the probability of crossing a lower bound at analysis $k$ without previously crossing any bound by + +$$\beta_{k}(\theta)=P_{\theta}((Z_{k}< a_{k}\}\cap_{j=1}^{k-1}\{ a_{j}\le Z_{j}< b_{j}\}).$$ +For symmetric testing for analysis $k$ we would have $a_k= - b_k$, $\beta_k(0)=\alpha_k(0),$ $k=1,2,\ldots,K$. +The total lower boundary crossing probability for a trial is denoted by +$$\beta(\theta)\equiv\sum_{k=1}^{K}\beta_{k}(\theta).$$ +Note that we can also set $a_k= -\infty$ for any or all analyses if a lower bound is not desired, $k=1,2,\ldots,K$. +For $k-\infty$ or $b_k<\infty$. + + + +# References diff --git a/vignettes/story_npe_integration.Rmd b/vignettes/story_npe_integration.Rmd new file mode 100644 index 000000000..fdcb6a0db --- /dev/null +++ b/vignettes/story_npe_integration.Rmd @@ -0,0 +1,309 @@ +--- +title: "Numerical Integration Non-Proportional Effect Size in Group Sequential Design" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + number_sections: true + highlight: "textmate" + css: "custom.css" +bibliography: "ggsd.bib" +vignette: | + %\VignetteIndexEntry{Numerical integration for NPES} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +library(tibble) +library(dplyr) +library(knitr) +devtools::load_all() +``` + +## Overview + +We have provided asymptotic distribution theory and notation for group sequential boundaries in +`vignette("NPEbackground", package="gsdmvn")`. + +This vignettes generalize computational algorithms provided in Chapter 19 of @JTBook that are used to compute boundary crossing probabilities as well as derive boundaries for group sequential designs. + +## Asymptotic normal and boundary crossing probabilities + +We assume $Z_1,\cdots,Z_K$ has a multivariate normal distribution with variance for $1\le k\le K$ of +$$\hbox{Var}(Z_k) = 1$$ +and the expected value is + +$$E(Z_{k})= \sqrt{\mathcal{I}_k}\theta(t_{k})= \sqrt{n_k}E(\bar X_k) .$$ + +## Notation for boundary crossing probabilities + +We use a shorthand notation in this section to have $\theta$ represent $\theta()$ and $\theta=0$ to represent $\theta(t)\equiv 0$ for all $t$. +We denote the probability of crossing the upper boundary at analysis $k$ without previously crossing a bound by + +$$\alpha_{k}(\theta)=P_{\theta}(\{Z_{k}\geq b_{k}\}\cap_{j=1}^{i-1}\{a_{j}\le Z_{j}< b_{j}\}),$$ +$k=1,2,\ldots,K.$ + +Next, we consider analogous notation for the lower bound. For $k=1,2,\ldots,K$ +denote the probability of crossing a lower bound at analysis $k$ without previously crossing any bound by + +$$\beta_{k}(\theta)=P_{\theta}((Z_{k}< a_{k}\}\cap_{j=1}^{k-1}\{ a_{j}\le Z_{j}< b_{j}\}).$$ +For symmetric testing for analysis $k$ we would have $a_k= - b_k$, $\beta_k(0)=\alpha_k(0),$ $k=1,2,\ldots,K$. +The total lower boundary crossing probability for a trial is denoted by +$$\beta(\theta)\equiv\sum_{k=1}^{K}\beta_{k}(\theta).$$ +Note that we can also set $a_k= -\infty$ for any or all analyses if a lower bound is not desired, $k=1,2,\ldots,K$; thus, we will not use the $\alpha^+(\theta)$ notation here. +For $k-\infty$ or $b_k<\infty$. + + + +## Recursive algorithms for numerical integration + +We now provide a small update to the algorithm of Chapter 19 of @JTBook to do the numerical integration required to compute the boundary crossing probabilites of the previous section and also identifying group sequential boundaries satisfying desired characteristics. +The key to these calculations is the conditional power identitity in equation (1) above which allows building recursive numerical integration identities to enable simple, efficient numerical integration. + +We define + +$$g_1(z;\theta) = \frac{d}{dz}P(Z_1\le z) = \phi\left(z - \sqrt{\mathcal{I}_1}\theta(t_1)\right)\tag{2}$$ + +and for $k=2,3,\ldots K$ we recursively define the subdensity function + +$$\begin{align} +g_k(z; \theta) &= \frac{d}{dz}P_\theta(\{Z_k\le z\}\cap_{j=1}^{k-1}\{a_j\le Z_j0$ and $\pi_k(b^{(i+1)};\theta)-\alpha_k(\theta)$ is suitably small. +A simple starting value for any $k$ is + +$$b^{(0)} = \Phi^{-1}(1- \alpha_k(\theta)) + \sqrt{\mathcal{I}_k}\theta(t_k).\tag{9}$$ +Normally, $b_k$ will be calculated with $\theta(t_k)=0$ for $k=1,2,\ldots,K$ which simplifies the above. +However, $a_k$ computed analogously will often use a non-zero $\theta$ to enable so-called $\beta$-spending. + +## Numerical integration + +The numerical integration required to compute boundary probabilities and derive boundaries is the same as that defined in section 19.3 of @JTBook. The single change is the replacement of the non-proportional effect size assumption of equation (3) above replacing the equivalent of equation (4) used for a constant effect size as in @JTBook. + +### Demonstrating calculations + +We walk through how to perform the basic calculations above. +The basic scenario will have one interim analysis in addition to the final analysis. +We will target Type I error $\alpha=0.025$ and Type II error $\beta = 0.1$, the latter corresponding to a target of 90% power. +We will assume a power spending function with $\rho=2$ for both bounds. +That is, for information fraction $t$, the cumulative spending will be $\alpha \times t^2$ for the upper bound and $\beta \times t^2$ for the lower bound. +Statistical information will be 1 for the first analysis and 4 for the final analysis, leading to information fraction $t_1= 1/4, t_2=1$ for the interim and final, respectively. +We assume $\theta_1 = .5$, $\theta_3=1.5$. + +- Set up overall study parameters + +```{r} +# Information for both null and alternative +info <- c(1, 4) +# information fraction +timing <- info / max(info) +# Type I error +alpha <- 0.025 +# Type II error (1 - power) +beta <- 0.1 +# Cumulative alpha-spending at IA, Final +alphaspend <- alpha * timing^2 +# Cumulative beta-spending at IA, Final +betaspend <- beta * timing^2 +# Average treatment effect at analyses +theta <- c(1, 3)/2 +``` + +- Calculate interim bounds + +```{r} +# Upper bound under null hypothesis +b1 <- qnorm(alphaspend[1], lower.tail = FALSE) +# Lower bound under alternate hypothesis +a1 <- qnorm(betaspend[1], mean = sqrt(info[1]) * theta[1]) +# Compare probability of crossing vs target for bounds: +cat("Upper bound =", b1, "Target spend =", alphaspend[1], + "Actual spend =", pnorm(b1, lower.tail=FALSE)) +``` + +```{r} +# Lower bound under alternate hypothesis +a1 <- qnorm(betaspend[1], mean = sqrt(info[1]) * theta[1]) +# Compare probability of crossing vs target for bounds: +cat("Lower bound =", a1, "Target spend =", betaspend[1], + "Actual spend =", pnorm(a1, mean = sqrt(info[1]) * theta[1])) +``` + +- Set up numerical integration grid for next (final) analysis + +We set up a table for numerical integration over the continuation region which we can subsequently use to compute boundary crossing probabilities for bounds at the second interim analysis. +We begin with the null hypothesis. +The columns in the resulting table are + - `z` - $Z$-values for the grid; recall that each interim test statistic is normally distributed with variance 1 + - `w` - weights for numerical integration + - `h` - weights `w` times the normal density that can be used for numerical integration; we will demonstrate use below + +```{r} +# Set up grid over continuation region +# Null hypothesis +grid1_0 <- h1(theta = 0, I = info[1], a = a1, b = b1) +grid1_0 %>% head() +``` +The probability of not crossing a bound under the null hypothesis is computed as follows: + +```{r} +probH0continue <- sum(grid1_0$h) +cat("Probability of continuing trial under null hypothesis\n", + " Using numerical integration:", probH0continue, + "\n Using normal cdf:", pnorm(b1) - pnorm(a1), "\n") +``` + +We now set up numerical integration grid under the alternate hypothesis and the compute continuation probability. + +```{r} +grid1_1 <- h1(theta = theta[1], I = info[1], a = a1, b = b1) +probH1continue <- sum(grid1_1$h) +h1mean <- sqrt(info[1]) * theta[1] +cat("Probability of continuing trial under alternate hypothesis\n", + " Using numerical integration:", probH1continue, + "\n Using normal cdf:", pnorm(b1, mean = h1mean) - pnorm(a1, h1mean), "\n") +``` + +- Compute initial iteration for analysis 2 bounds + +The initial estimate of the second analysis bounds are computed the same way as the actual first analysis bounds. + +```{r} +# Upper bound under null hypothesis +# incremental spend +spend0 <- alphaspend[2] - alphaspend[1] +# H0 bound at 2nd analysis; 1st approximation +b2_0 <- qnorm(spend0, lower.tail = FALSE) +# Lower bound under alternate hypothesis +spend1 <- betaspend[2] - betaspend[1] +a2_0 <- qnorm(spend1, mean = sqrt(info[2]) * theta[2]) +cat("Initial bound approximation for 2nd analysis\n (", + a2_0, ", ", b2_0,")\n", sep="") +``` + +- Compute actual boundary crossing probabilities with initial approximations + +To get actual boundary crossing probabilities at the second analysis, we update our numerical integration grids. +Under the null hypothesis, we need to update to the interval above `b2_0`. + +```{r} +# Upper rejection region grid under H0 +grid2_0 <- hupdate(theta = 0, I = info[2], a = b2_0, b = Inf, Im1 = info[1], gm1 = grid1_0) +pupper_0 <- sum(grid2_0$h) +cat("Upper spending at analysis 2\n Target:", spend0, "\n Using initial bound approximation:", + pupper_0,"\n") +``` + +To get a first order Taylor's series approximation to update this bound, we need the derivative of the above probability with respect to the Z-value cutoff. This was given above as the subdensity computed in the grid. +As before, the grid contains the numerical integration weight in `w` and that weight times the subdensity in `h`. Thus, to get the subdensity at the bound, which is the estimated derivative in the boundary crossing probability, we compute: + +```{r} +# First point in grid is at bound +# Compute derivative +dpdb2 <- grid2_0$h[1] / grid2_0$w[1] +# Compute difference between target and actual bound crossing probability +pdiff <- spend0 - pupper_0 +# Taylor's series update +b2_1 <- b2_0 - pdiff / dpdb2 +# Compute boundary crossing probability at updated bound +cat("Original bound approximation:", b2_0, + "\nUpdated bound approximation:", b2_1 + ) +grid2_0 <- hupdate(theta = 0, I = info[2], a = b2_1, b = Inf, Im1 = info[1], gm1 = grid1_0) +pupper_1 <- sum(grid2_0$h) +cat("\nOriginal boundary crossing probability:", pupper_0, + "\nUpdated boundary crossing probability:", pupper_1, + "\nTarget:", spend0, "\n" + ) +``` + +We see that the Taylor's series update has gotten us substantially closer to the targeted boundary probability. +We now update the lower bound in an analogous fashion. + +```{r} +# Lower rejection region grid under H1 +grid2_1 <- hupdate(theta = theta[2], I = info[2], a = -Inf, b = a2_0, + thetam1 = theta[1], Im1 = info[1], gm1 = grid1_1) +plower_0 <- sum(grid2_1$h) +# Last point in grid is at bound +# Compute derivative +indx <- length(grid2_1$h) +dpda2 <- grid2_1$h[indx] / grid2_1$w[indx] +# Compute difference between target and actual bound crossing probability +pdiff <- spend1 - plower_0 +# Taylor's series update +a2_1 <- a2_0 + pdiff / dpda2 +# Compute boundary crossing probability at updated bound +cat("Original bound approximation:", a2_0, + "\nUpdated bound approximation:", a2_1) + +grid2_1 <- hupdate(theta = theta[2], I = info[2], a = -Inf, b = a2_1, + thetam1 = theta[1], Im1 = info[1], gm1 = grid1_1) +plower_1 <- sum(grid2_1$h) +cat("\nOriginal boundary crossing probability:", plower_0, + "\nUpdated boundary crossing probability:", plower_1, + "\nTarget:", spend1, "\n" + ) +``` + +- Confirm with `gs_power_npe()` + +```{r, message = FALSE} +gs_power_npe(theta = theta, theta1 = theta, info = info, binding = TRUE, + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfPower, total_spend = 0.025, param = 2), + lower = gs_spending_bound, + lpar = list(sf = gsDesign::sfPower, total_spend = 0.1, param = 2) +) +``` + +# References diff --git a/vignettes/story_power_evaluation_with_spending_bound.Rmd b/vignettes/story_power_evaluation_with_spending_bound.Rmd new file mode 100644 index 000000000..80aa35697 --- /dev/null +++ b/vignettes/story_power_evaluation_with_spending_bound.Rmd @@ -0,0 +1,253 @@ +--- +title: "Power Evaluation with Spending bounds" +date: "`r format(Sys.time(), '%d %B, %Y')`" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + number_sections: true + highlight: "textmate" + css: "custom.css" +bibliography: "ggsd.bib" +vignette: > + %\VignetteIndexEntry{Power Evaluation with Spending bounds} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +```{r, message=FALSE, echo=FALSE, warning=FALSE} +library(tibble) +library(gt) +devtools::load_all() +library(dplyr) +``` + +# Overview + +This vignette covers how to compute power or Type I error for a design derived with a spending bound. We will write this with a general non-constant treatment effect using `gs_design_npe()` to derived the design under one parameter setting and computing power under another setting. We will use a trial with a binary endpoint to enable a full illustration. + +# Scenario for Consideration + +We consider a scenario largely based on the CAPTURE study (@CAPTURE) where the primary endpoint was a composite of death, acute myocardial infarction or the need for recurrent percutaneous intervention within 30 days of randomization. + +The detailed introduction of this trial is listed as follows. + +- We consider a 2-arm trial with an experimental arm and a control arm. + +- We will assume $K=3$ analyses after $350$, $700$, and $1400$ patients have been observed with equal randomization between the treatment groups. + +- The primary endpoint for the trial is a binary indicator for each participant if they have a failed outcome. For this case, we consider the parameter $$ + \theta = p_1 - p _2 + $$ where $p_1$ denotes the probability that a trial participant in the control group experiences a failure and $p_2$ represents the same probability for a trial participant in the experimental group. + +- The study was designed with approximately 80% power (Type II error $\beta = 1 - 0.8 = 0.2$) and 2.5% one-sided Type I error ($\alpha = 0.025$) to detect a reduction from a 15% event rate ($p_1 = 0.15$) in the control group to 10% ($p_2 = 0.1$) in the experimental group. + +```{r} +p0 <- 0.15 # assumed failure rate in control group +p1 <- 0.10 # assumed failure rate in experimental group +alpha <- 0.025 # type I error +beta <- 0.2 # type II error for 80% power +``` + +In this example, the parameter of interest is $\theta = p_1 - p_2$. We denote the alternate hypothesis as $$ + H_1: \theta = \theta_1= p_1^1 - p_2^1 = 0.15 - 0.10 = 0.05 +$$ and the null hypothesis $$ + H_0: \theta = \theta_0 = 0 = p_1^0 - p_2^0 +$$ where $p^0_1 = p^0_2= (p_1^1+p_2^1)/2 = 0.125$ as laid out in @LachinBook. + +We note that had we considered a success outcome such as objective response in an oncology study, we would let $p_1$ denote the experimental group and $p_2$ the control group response rate. Thus, we always set up the notation so the $p_1>p_2$ represents superiority for the experimental group. + +# Notations + +We assume + +- $k$: the index of analysis, i.e., $k = 1, \ldots, K$; +- $i$: the index of arm, i.e., $i = 1$ for the control group and $i = 2$ for the experimental group; +- $n_{ik}$: the number of subjects in group $i$ and analysis $k$; +- $n_k$: the number of subjects at analysis $k$, i.e., $n_k = n_{1k} + n_{2k}$; +- $X_{ij}$: the independent random variable whether the $j$-th subject in group $i$ has response, i.e, $$ + X_{ij} \sim \hbox{Bernoulli}(p_i); + $$ +- $Y_{ik}$: the number of subject having response in group $i$ and analysis $k$, i.e., $$ + Y_{ik} = \sum_{j = 1}^{n_{ik}} X_{ij}; + $$ + +# Statistical Testing + +In this section, we will discuss the estimation of statistical information and variance of porprotion under both null hypothesis $H_0: p_1^0 = p_2^0 \equiv p_0$ and alternative hypothesis $H_1: \theta = \theta_1= p_1^1 - p_2^1$. Then, we will introduce the test statistics in the group sequential design. + +## Estimation of Statistical Information under H1 + +Under the alternative hypothesis, one can estimate the proportion of failures in group $i$ at analysis $k$ as $$ + \hat{p}_{ik} = Y_{ik}/n_{ik}. +$$ We note its variance is $$ + \hbox{Var}(\hat p_{ik})=\frac{p_{i}(1-p_i)}{n_{ik}}, +$$ and its consistent estimator $$ + \widehat{\hbox{Var}}(\hat p_{ik})=\frac{\hat p_{ik}(1-\hat p_{ik})}{n_{ik}}, +$$ for any $i = 1, 2$ and $k = 1, 2, \ldots, K$. Letting $\hat\theta_k = \hat p_{1k} - \hat p_{2k},$ we also have $$ + \sigma^2_k + \equiv + \hbox{Var}(\hat\theta_k) + = + \frac{p_1(1-p_1)}{n_{1k}}+\frac{p_2(1-p_2)}{n_{2k}}, +$$ its consistent estimator $$ + \hat\sigma^2_k + = + \frac{\hat p_{1k}(1-\hat p_{1k})}{n_{1k}}+\frac{\hat p_{2k}(1-\hat p_{2k})}{n_{2k}}, +$$ + +Statistical information for each of these quantities and their corresponding estimators are denoted by +$$ + \left\{ + \begin{align} + \mathcal{I}_k = &1/\sigma^2_k,\\ + \mathcal{\hat I}_k = &1/\hat \sigma^2_k, + \end{align} + \right. +$$ + +## Estimation of Statistical Information under H0 + +Under the null hypothesis, one can estimate the proportion of failures in group $i$ at analysis $k$ as we estimate +$$ + \hat{p}_{0k} + = + \frac{Y_{1k}+ Y_{2k}}{n_{1k}+ n_{2k}} + = + \frac{n_{1k}\hat p_{1k} + n_{2k}\hat p_{2k}}{n_{1k} + n_{2k}}. +$$ +The corresponding null hypothesis estimator +$$ + \hat\sigma^2_{0k} + \equiv + \widehat{\text{Var}}(\hat{p}_{0k}) + = + \hat p_{0k}(1-\hat p_{0k})\left(\frac{1}{n_{1k}}+ \frac{1}{n_{2k}}\right), +$$ +for any $k = 1,2, \ldots, K$. + +Statistical information for each of these quantities and their corresponding estimators are denoted by +$$ + \left\{ + \begin{align} + \mathcal{I}_{0k} =& 1/ \sigma^2_{0k},\\ + \mathcal{\hat I}_{0k} =& 1/\hat \sigma^2_{0k}, + \end{align} + \right. +$$ for any $k = 1, 2, \ldots, K$. + +## Testing Statistics + +Testing, as recommended by @LachinBook, is done with the large sample test with the null hypothesis variance estimate and without continuity correction: $$ +Z_k = \hat\theta_k/\hat\sigma_{0k}=\frac{\hat p_{1k} - \hat p_{2k}}{\sqrt{(1/n_{1k}+ 1/n_{2k})\hat p_{0k}(1-\hat p_{0k})} }, +$$ +which is asymptotically $\text{Normal}(0,1)$ if $p_1 = p_2$ and $\text{Normal}(0, \sigma_{0k}^2/\sigma_k^2)$ more generally for any $p_1, p_2$ and $k = 1, 2, \ldots, K$. + +If we further assume a constant proportion $\xi_i$ randomized to each group $i=1,2.$ Thus, +$$ + Z_k + \approx + \frac{\sqrt{n_k}(\hat p_{1k} - \hat p_{2k})}{\sqrt{(1/\xi_1+ 1/\xi_2)p_{0}(1- p_0)} }. +$$ + +Then, we have the asymptotic distribution +$$ + Z_k + \sim + \hbox{Normal} + \left( + \sqrt{n_k}\frac{p_1 - p_2}{\sqrt{(1/\xi_1+ 1/\xi_2) p_0(1- p_0)} }, + \sigma^2_{0k}/\sigma^2_{1k} + \right), +$$ where we note that +$$ + \sigma^2_{0k}/\sigma^2_{1k} + = + \frac{ p_0(1-p_0)\left(1/\xi_1+ 1/\xi_2\right)}{p_1(1-p_1)/\xi_1+p_2(1-p_2)/\xi_2}. +$$ +We also note by definition that $\sigma^2_{0k}/\sigma^2_{1k}=\mathcal I_k/\mathcal I_{0k}.$ Based on an input $p_1, p_2, n_k, \xi_1, \xi_2 = 1-\xi_1$ we will compute $\theta, \mathcal{I}_k, \mathcal{I}_{0k}$ for any $k = 1, 2, \ldots, K$. + +We note that $\chi^2=Z^2_k$ is the $\chi^2$ test without continuity correction as recommended by @CCmyth. Note finally that this extends in a straightforward way the non-inferiority test of @FarringtonManning if the null hypothesis is $\theta = p_1 - p_2 - \delta = 0$ for some non-inferiority margin $\delta > 0$; $\delta < 0$ would correspond to what is referred to as super-superiority @Chan2002, requiring that experimental therapy has been shown to be superior to control by at least a margin $-\delta>0$. + +# Power Calculations + +We begin with developing a function `gs_info_binomial()` to calculate the statistical infomation discussed above. + +```{r} +gs_info_binomial <- function(p1, p2, xi1, n, delta = NULL){ + if (is.null(delta)) delta <- p1 - p2 + # Compute (constant) effect size at each analysis theta + theta <- rep(p1 - p2, length(n)) + # compute null hypothesis rate, p0 + p0 <- xi1 * p1 + (1 - xi1) * p2 + # compute information based on p1, p2 + info <- n / (p1 * (1 - p1) / xi1 + p2 * (1 - p2) / (1 - xi1)) + # compute information based on null hypothesis rate of p0 + info0 <- n / (p0 * (1 - p0)*(1 / xi1 + 1 / (1 - xi1))) + # compute information based on H1 rates of p1star, p2star + p1star <- p0 + delta * xi1 + p2star <- p0 - delta * (1 - xi1) + info1 <- n / (p1star * (1 - p1star) / xi1 + p2star * (1 - p2star) / (1 - xi1)) + + out <- tibble(Analysis = 1:length(n), + n = n, + theta = theta, + theta1 = rep(delta, length(n)), + info = info, + info0 = info0, + info1 = info1) + return(out) +} +``` + +For the CAPTURE trial, we have + +```{r} +h1 <- gs_info_binomial(p1 = .15, p2 = .1, xi1 = .5, n = c(350, 700, 1400)) +h1 %>% gt() +``` + +We can plug these into `gs_power_npe()` with the intended spending functions. We begin with power under the alternate hypothesis + +```{r} +gs_power_npe( + theta = h1$theta, + theta1 = h1$theta, + info = h1$info, + info0 = h1$info0, + info1 = h1$info1, + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025), + lower = gs_spending_bound, + lpar = list(sf = gsDesign::sfHSD, param = -2, total_spend = 0.2) + ) %>% + gt() %>% + fmt_number(columns = 3:10, decimals = 4) +``` + +Now we examine information for a smaller assumed treatment difference than the alternative: + +```{r} +h <- gs_info_binomial(p1 = .15, p2 = .12, xi1 = .5, delta = .05, n = c(350, 700, 1400)) + +gs_power_npe( + theta = h$theta, theta1 = h$theta1, info = h$info, + info0 = h$info0, info1 = h$info1, + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025), + lower = gs_spending_bound, + lpar = list(sf = gsDesign::sfHSD, param = -2, total_spend = 0.2) + ) %>% + gt() %>% + fmt_number(columns = 3:10, decimals = 4) +``` + +# References diff --git a/vignettes/story_quick_start.Rmd b/vignettes/story_quick_start.Rmd new file mode 100644 index 000000000..cc9c8a543 --- /dev/null +++ b/vignettes/story_quick_start.Rmd @@ -0,0 +1,300 @@ +--- +title: "Quick Start for NPH Sample Size and Power" +date: "`r format(Sys.time(), '%d %B, %Y')`" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + number_sections: true + highlight: "textmate" + css: "custom.css" +bibliography: "ggsd.bib" +vignette: | + %\VignetteIndexEntry{Quick Start for NPH Sample Size and Power} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +# Overview + +We provide simple examples for use of the **gsdmvn** package for deriving fixed and group sequential designs under non-proportional hazards. +The piecewise model for enrollment, failure rates, dropout rates and changing hazard ratio over time allow great flexibility in design assumptions. +Users are encouraged to suggest features that would be of immediate and long-term interest to add. + +Topics included here are: + +- Packages required and how they are used. +- Specifying enrollment rates. +- Specifying failure and dropout rates with possibly changing hazard ratio over time. +- Deriving a fixed design with no interim analysis. +- Simple boundary specification for group sequential design. +- Deriving a group sequential design under non-proportional hazards. +- Displaying design properties. +- Design properties under alternate assumptions. +- Differences from **gsDesign**. +- Future enhancement priorities. + +All of these items are discussed briefly to enable a quick start for early adopters while also suggesting the ultimate possibilities that the software enables. +Finally, while the final section provides current enhancement priorities, potential topic-related enhancements are discussed throughout the document. + +# Packages Used + +- The **gsdmvn** package is used here to implement group sequential distribution theory under non-proportional hazards and to derive a wide variety of boundary types for group sequential designs. +- The **gsDesign** package is used as a check for results under proportional hazards as well as a source from deriving bounds using spending functions. +- The **gsDesign2** package provides computations to compute expected event accumulation and average hazard ratio over time; these are key inputs to the group sequential distribution parameters. +- The **simtrial** package is used to verify design properties using simulation. + +The **gsdmvn** package will likely will likely be incorporated eventually into the **gsDesign2** package, resulting in a fully featured design package. +However, features and implementation in **gsdmvn** will be allowed to change as needed during the agile rapid development phase. + +```{r, message=FALSE, warning=FALSE} +devtools::load_all() +library(gsDesign) +#library(gsDesign2) +library(simtrial) +library(knitr) +library(dplyr) +library(gt) +``` + +# Enrollment Rates + +Piecewise constant enrollment rates are input in a tabular format. +Here we assume enrollment will ramp-up with $25\%$, $50\%$, and $75\%$ of the final enrollment rate for $2$ months each followed by a steady state $100\%$ enrollment for another $6$ months. +The rates will be increased later to power the design appropriately. +However, the fixed enrollment rate periods will remain unchanged. + +```{r} +enrollRates <- tibble( + Stratum = "All", + duration = c(2, 2, 2, 6), + rate = (1:4) / 4) + +enrollRates %>% gt() +``` + +# Failure and Dropout Rates + +Constant failure and dropout rates are specified by study period and stratum; we consider a single stratum here. +A hazard ratio is provided for treatment/control hazard rate for each period and stratum. +The dropout rate for each period is assumed the same for each treatment group; this restriction could be eliminated in a future version, if needed. +Generally, we take advantage of the identity for an exponential distribution with median $m$, the corresponding failure rate $\lambda$ is + +$$\lambda = \log(2) / m.$$ + +We consider a control group exponential time-to-event with a $12$ month median. +We assume a hazard ratio of $1$ for $4$ months, followed by a hazard ratio of $0.6$ thereafter. +Finally, we assume a low $0.001$ exponential dropout rate per month for both treatment groups. + +```{r} +medianSurv <- 12 +failRates <- tibble::tibble( + Stratum = "All", + duration = c(4, Inf), + failRate = log(2) / medianSurv, + hr = c(1, .6), + dropoutRate = .001) + +failRates %>% gt() +``` + +# Fixed Design + +Under the above enrollment, failure and dropout rate assumptions we now derive sample size for a trial targeted to complete in 36 months with no interim analysis, $90\%$ power and $2.5\%$ Type I error. + + +```{r} +alpha <- .025 +beta <- .1 # 1 - targeted power +d <- fixed_design( + x = "AHR", # method for computing sample size + enrollRates = enrollRates, # Relative enrollment rates + failRates = failRates, # Failure rates from above + alpha = alpha, # Type I error + power = 1 - beta, # Type II error = 1 - power + studyDuration = 36 # Planned trial duration +) +``` + +A quick summary of the targeted sample size is obtained below. +Note that you would normally round up `N` up to an even number and `Events` to the next integer. + +```{r} +d %>% summary() %>% as_gt() +``` + + +The enrollment rates for each period have been increased proportionately to size the trial for the desired properties; the duration for each enrollment rate has not changed. + +```{r} +d$enrollRates %>% gt() +``` + +# Group Sequential Design + +We will not go into detail for group sequential designs here. +In brief, however, a sequence of tests $Z_1, Z_2,\ldots, Z_K$ that follow a multivariate normal distribution are performed to test if a new treatment is better than control (@JTBook). +We assume $Z_k > 0$ is favorable for the experimental treatment. +Generally Type I error for this set of tests will be controlled under the null hypothesis of no treatment difference by a sequence of bounds $b_1, b_2,\ldots,b_K$ such that for a chosen Type I error $\alpha > 0$ we have + +$$ + \alpha = 1 - P_0(\cap_{k=1}^K Z_k < b_k) +$$ +Where $P_0()$ refers to a probability under the null hypothesis. +This is referred to as a non-binding bound since it is assumed the trial will not be stopped early for futility if some $Z_k$ is small. + +## Simple Efficacy Bound Definition + +@LanDeMets developed the spending function method for deriving group sequential bounds. +This involves use of a non-decreasing spending function $f(t)$ for $t\ge 0$ where $f(0)=0$ and $f(t)=\alpha$ for $t \ge 1$. +Suppose for $K>0$ analyses are performed when proportion $t_1< t_2 <\ldots t_K=1$ of some planned statistical information (e.g., proportion of planned events for a time-to-event endpoint trial for proportion of observations for a binomial or normal endpoint). +Bounds through the first $k$ analyses $1\le k\le K$ are recursively defined by the spending function and the multivariate normal distribution to satisfy + +$$ + f(t_k) = 1 - P_0(\cap_{j=1}^k Z_j < b_j). +$$ +For this quick start, we will only illustrate this type of efficacy bound. + +Perhaps the most common spending function for this approach is the @LanDeMets approximation to the O'Brien-Fleming bound with + +$$ + f(t) = 2-2\Phi\left(\frac{\Phi^{-1}(1-\alpha/2)}{t^{1/2}}\right). +$$ + +```{r, echo=FALSE, fig.width=6.5} +ggplot( + data = tibble(t = (0:50) / 50, `f(t)` = 2 - 2 * pnorm(qnorm(1 - .0125) / sqrt(t))), + aes(x = t, y = `f(t)`)) + + geom_line() +``` + +Suppose $K=3$ and $t_1=0.5$, $t_2 = 0.75$, $t_3 = 1$. +We can use the assumptions above for a group sequential design with only an efficacy bound using the Lan-DeMets O'Brien-Fleming spending function for $\alpha = 0.025$ with + +```{r} +design1s <- gs_design_ahr( + alpha = alpha, + beta = beta, + enrollRates = enrollRates, + failRates = failRates, + analysisTimes = c(16, 26, 36), # Calendar time of planned analyses + upper = gs_spending_bound, # Spending function bound for efficacy + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025), # specify spending function and total Type I error + lower = gs_b, lpar = rep(-Inf, 3), # No futility bound + info_scale = 2 +) +``` + +Bounds at the 3 analyses are as follows. +Note that expected sample size at time of each data cutoff for analysis is also here in `N`. We filter on the upper bound so that lower bounds with `Z = -Inf` are not shown. + +```{r} +design1s %>% + summary() %>% + as_gt(title = "1-sided group sequential bound using AHR method", + subtitle = "Lan-DeMets spending to approximate O'Brien-Fleming bound") +``` + + +gsDesign to replicate above bounds (this will not replicate sample size). + +```{r, class.source = 'fold-show'} +x <- gsDesign(k = 3, test.type = 1, timing = design1s$analysis$IF, sfu = sfLDOF) +cat("gsDesign\n Upper bound: ",x$upper$bound, + "\n Cumulative boundary crossing probability (H0): ", cumsum(x$upper$prob[, 1]), + "\n Timing (IF): ", x$timing, + "\ngs_design_ahr\n Upper bound: ", design1s$bounds$Z, + "\n Cumulative boundary crossing probability (H0): ", design1s$bounds$Probability0, + "\n Timinng (IF): ", design1s$analysis$IF, + "\n") +``` + + + +## Two-Sided Testing + +We will consider both symmetric and asymmetric 2-sided designs. + +### Symmetric 2-sided bounds + +Our first 2-sided design is a symmetric design. + +```{r} +design2ss <- gs_design_ahr( + alpha = alpha, + beta = beta, + enrollRates = enrollRates, + failRates = failRates, + analysisTimes = c(16, 26, 36), # Calendar analysis times + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025), + lower = gs_spending_bound, + lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.025), + h1_spending = FALSE # This specifies futility testing with spending under NULL +) +``` + + +Design bounds are confirmed with: + +```{r, message=FALSE} +design2ss %>% + summary() %>% + as_gt(title = "2-sided symmetric group sequential bound using AHR method", + subtitle = "Lan-DeMets spending to approximate O'Brien-Fleming bound") +``` + +The bounds can be plotted easily: + +```{r, out.width = "50%"} +ggplot(data = design2ss$analysis %>% left_join(design2ss$bounds, by = "Analysis"), + aes(x = Events, y = Z, group = Bound)) + + geom_line(aes(linetype = Bound)) + + geom_point() + + ggtitle("2-sided symmetric bounds with O'Brien-Fleming-like spending") +``` + +### Asymmetric 2-sided bounds + +Asymmetric 2-sided designs are more common than symmetric since the objectives of the two bounds tend to be different. +There is often caution to analyze early for efficacy or to use other than a conservative bound; both of these principles have been used with the example designs so far. +Stopping when there is a lack of benefit for experimental treatment over control or for an overt indication of an unfavorable trend generally might be examined early and bounds be less stringent. +We will add an early futility analysis where if there is a nominal 1-sided p-value of $0.05$ in the wrong direction ($Z=\Phi^{-1}(0.05)$ after 30% or $50\%$ of events have accrued. +This might be considered a *disaster check*. After this point in time, there may not be a perceived need for further futility analysis. +For efficacy, we add an infinite bound at this first interim analysis. + +```{r} +design2sa <- gs_design_ahr( + alpha = alpha, + beta = beta, + enrollRates = enrollRates, + failRates = failRates, + analysisTimes = c(12, 16, 26, 36), + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025), # Same efficacy bound as before + test_lower = c(FALSE, TRUE, TRUE, TRUE), # Only test efficacy after IA1 + lower = gs_b, + lpar = c(rep(qnorm(.05),2), -Inf, -Inf) # Fixed lower bound at first 2 analyses +) +``` + +We now have a slightly larger sample size to account for the possibility of an early futility stop. +Bounds are now: + +```{r} +design2sa %>% + summary() %>% + as_gt(title = "2-sided asymmetric group sequential bound using AHR method", + subtitle = "Lan-DeMets spending to approximate O'Brien-Fleming bound for efficacy, futility disaster check at IA1, IA2 only") +``` + + +# References diff --git a/vignettes/story_risk_difference.Rmd b/vignettes/story_risk_difference.Rmd new file mode 100644 index 000000000..02bb5e450 --- /dev/null +++ b/vignettes/story_risk_difference.Rmd @@ -0,0 +1,1672 @@ +--- +title: "Group Sequential Design for Binary Outcomes" +output: + rmarkdown::html_document: + toc: true + toc_depth: 3 + toc_float: true + theme: flatly + code_folding: hide + number_sections: true + highlight: "textmate" + css: "custom.css" +bibliography: ggsd.bib +vignette: | + %\VignetteIndexEntry{Group Sequential Design for Binary Outcomes} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown} +editor_options: + markdown: + wrap: 72 +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) + +library(tibble) +library(dplyr) +library(knitr) +devtools::load_all() +library(gsDesign) +library(gt) +library(mvtnorm) +``` + +# Overview + +We consider group sequential design examining the risk difference +between two treatment groups for a binary outcome. There are several +issues to consider: + +- The measure of treatment difference or natural parameter; we focus + on risk difference. +- Incorporation of both null and alternate hypothesis variances. +- Superiority, non-inferiority and super-superiority designs. +- Stratified populations. +- Fixed and group sequential designs. + +For single stratum designs, we focus on sample size or power using the +method of @FarringtonManning for a trial to test the difference between +two binomial event rates. The routine can be used for a test of +superiority, non-inferiority or super-superiority. For a design that +tests for superiority, the methods are consistent with those of @FTU, +but without the continuity correction. Methods for sample size and power +are the same as `gsDesign::nBinomial()` when testing on the +risk-difference scale for a single stratum. This is also consistent with +the **Hmisc** R package routines `bsamsize()` and `bpower()` for +superiority designs. + +For trials with multiple strata, testing for a risk difference is often +done by weighting each stratum according to the inverse of the variance +(@MantelHaenszel). Since risk differences may also be assumed to be +different for different strata, we will also explore weighting by strata +sample sizes as in @Mehrotra2000. + +The focus here is for sample sizes that are large enough for asymptotic +theory to work well without continuity corrections. The concepts are +incorporated in the following functions intended for use in fixed and +group sequential designs: + +- `gs_info_rd()` to support asymptotic variance and statistical + information calculation. +- `gs_power_rd()` to support power calculations. +- `gs_design_rd()` to support sample size calculations. + +Simulation is used throughout to check the examples presented. + +# Notation + +- $K$: total number of analyses (including the final analysis) in the + group sequential design. For fixed design, $K= 1$. + +- $S$: total number of strata. If the population is un-stratified + population, then $S=1$. + +- $w_{s,k}$: the **underlying** weight assigned for the $s$-th strata + at the $k$-th analysis. WHY SWITH ORDER OF s, k FROM w? + +- $\widehat w_{s,k}$: the **estimated** weight assigned for the $s$-th + strata at the $k$-th analysis. + +- $N_{C,k,s}, N_{E,k,s}$: the **planned** sample size in the + control/treatment group at the $k$-th analysis of the $s$-th strata. + +- $\widehat N_{C,k,s}, \widehat N_{E,k,s}$: the **observed** sample + size in the control/treatment group at the $k$-th analysis of the + $s$-th strata. + +- $r$: **planned** randomization ratio, i.e., $$ + r = N_{E,k,s} / N_{C,k,s} \;\; \forall k = 1, \ldots, K \;\; \text{and} \;\; s = 1, \ldots, S. + $$ + +- $p_{C,s}, p_{E,s}$: the **planned** rate of the control/treatment + arm, i.e., the independent observations in the control/treatment + group with a binary outcome that is observed with probability + $p_{C,s}$ at any $k$-th analysis of the $s$-th strata. + +- $d$: an indicator whether is an outcome is failure (bad outcome) or + response (good outcome), i.e., $$ + d + = + \left\{ + \begin{array}{lll} + -1 & \text{if } p_{C,s} < p_{E,s} & \text{the control arm is better}\\ + 1 & \text{if } p_{C,s} > p_{E,s} & \text{the treatment arm is better}\\ + \end{array} + \right. + $$ Here we assume if $\exists s^* \in \{1, \ldots, S\}$, s.t., + $p_{C,s^*} < p_{E,s^*}$, then + $p_{C,s} < p_{E,s}, \forall s \in \{1, \ldots, S\}$, and vice versa. + +- $X_{C,k,s}, X_{E,k,s}$: random variables indicating the number of + subjects failed in control/treatment arm, i.e., + $X_{C,k,s} \sim \hbox{Binomial}(N_{C,k,s}, p_{C,k,s})$, + $X_{E,k,s} \sim \hbox{Binomial}(N_{E,k,s}, p_{E,k,s})$ at the $k$-th + analysis of the $s$-th strata. + +- $x_{C,k,s}, x_{E,k,s}$: the observed outcome of + $X_{C, k, s}, X_{E, k, s}$ at the $k$-th analysis of the $s$-th + strata, respectively. + +- $\widehat p_{C,k,s}, \widehat p_{E,k,s}$: observed rates of the + control/treatment group at the $k$-th analysis of the $s$-th strata, + i.e., $$ + \widehat p_{C,k,s} = x_{C,k,s} / \widehat N_{C,k,s}.\\ + \widehat p_{E,k,s} = x_{E,k,s} / \widehat N_{E,k,s}. + $$ + +- $\delta_{s}^{null}$: the **planned** risk difference under $H_0$ at + any $k$-th analysis of the $s$-th strata. + +- $\delta_{s}$: the **planned** risk difference under $H_1$ at any + $k$-th analysis of the $s$-th strata is denoted by $$ + \delta_{s} = |p_{C,s} - p_{E,s}|. + $$ + +- $\hat\delta_{s}$: estimation of risk difference with $$ + \widehat\theta_{k,s} = |\widehat p_{C,k,s} - \widehat p_{E,k,s}| + $$ We have + $E(\widehat\theta_{k,s}) = \theta_{s}, \;\forall k = 1, \ldots, K$. + +# Testing + +The test statistics at the $k$-th analysis is $$ + Z_{k} + = + \frac{ + \sum_{s=1}^S \widehat w_{s,k} \; |\widehat \delta_{k,s} - \delta_{s}^{null} | + }{ + \sqrt{\sum_{s=1}^S \widehat w_{s,k}^2 \widehat\sigma_{H_0,k,s}^2} + } +$$ where +$\widehat\sigma^2_{k,s} = \widehat{\hbox{Var}}(\widehat p_C -\widehat p_E)$. +And the value of $\widehat\sigma^2_{k,s}$ depends on the hypothesis and +design, i.e., whether it is a superiority design, or non-inferiority +design, or super-superiority design. We will discuss +$\widehat\sigma^2_{k,s}$ in the following 3 subsections. + +## Superiority Design + +A superiority design ($\delta_{s}^{null} = 0$) is to show that +experimental group is superior to the control group above some +thresholds. Its hypothesis is +$$ + H_0: \delta_{s} = 0 \text{ vs. } H_1: \delta_{s} > 0, \; \forall k = 1, \ldots, K, s = 1, \ldots, S +$$ + +- **Variance per strata per analysis:** + + - Under the null hypothesis, we have $$ + \begin{array}{ll} + \sigma^2_{H_0,k,s} + & = + \text{Var}(p_C - p_E | H_0) + = + p_{k,s}^{pool} \left(1 - p^{pool}_{k,s} \right) \left(\frac{1}{N_{C,k,s}} + \frac{1}{N_{E,k,s}} \right), \\ + \widehat\sigma^2_{H_0,k,s} + & = + \widehat{\text{Var}}(\hat p_C - \hat p_E | H_0) + = + \widehat p_{k,s}^{pool} \left(1 - \widehat p^{pool}_{k,s} \right) \left(\frac{1}{N_{C,k,s}} + \frac{1}{N_{E,k,s}} \right), + \end{array} + $$ where + $p_{k,s}^{pool} = (p_{C,s} N_{C,k,s} + p_{E,s} N_{E,k,s}) / (N_{C,k,s} + N_{E,k,s})$ + and + $\widehat p_{k,s}^{pool} = (x_{C,k,s} + x_{E,k,s}) / (\widehat N_{C,k,s} + \widehat N_{E,k,s}).$ + + - Under the alternative hypothesis, we have $$ + \begin{array}{ll} + \sigma_{H_1,k,s}^2 + & = + \text{Var}(p_C - p_E | H_1) + = + \frac{p_{C,s} (1- p_{C,s})}{N_{C,k,s}} + \frac{p_{E,s} (1 - p_{E,s})}{N_{E,k,s}} \\ + \widehat\sigma_{H_1,k,s}^2 + & = + \widehat{\text{Var}}(\hat p_C - \hat p_E | H_1) + = + \frac{\widehat p_{C,k,s} (1- \widehat p_{C,k,s})}{N_{C,k,s}} + \frac{\widehat p_{E,k,s} (1 - \widehat p_{E,k,s})}{N_{E,k,s}} + \end{array} + $$ where + $\widehat p_{C,k,s} = x_{C,k,s} / N_{C,k,s} \text{ and } \widehat p_{E,k,s} = x_{E,k,s} / N_{E,k,s}$. + Testing will be one-sided at level $\alpha \in (0, 1)$ and the + null hypothesis will be rejected if $Z_k$ cross the upper + boundary. And the upper boundary can be either fixed or derived + from spending functions. + +- **Standardized treatment effect per analysis:** + + - Under the null hypothesis, we have $$ + \theta_{H_0,k} = 0 \\ + \widehat \theta_{H_0,k} = 0 + $$ + + - Under the alternative hypothesis, we have $$ + \begin{array}{ll} + \theta_{H_1,k} + & = \frac{\sum_{s=1}^S w_{k,s} (p_{C,s} - p_{E,s})}{\sqrt{\sum_{s=1}^S w_{k,s}^2 \sigma_{H_1, k,s}^2}}\\ + \widehat\theta_{H_1,k} + & = + \frac{ + \sum_{s=1}^S \widehat w_{k,s} (\widehat p_C - \widehat p_E) + }{ + \sqrt{\sum_{s=1}^S \widehat w_{k,s}^2 \widehat\sigma_{H_1, k,s}^2} + }. + \end{array} + $$ + +- **Standardized information per analysis:** + + @LachinBook or @Lachin1981 provide fixed sample size calculations + based on the values $\psi_0$ under the null hypothesis and $\psi_1$ + under the alternate hypothesis. Here we propose using the same + variance calculations to compute statistical information for a group + sequential design and apply the formulation for power and sample + size calculation in the vignette *Computing Bounds Under + Non-Constant Treatment Effect*. + + - Under the null hypothesis, we have $$ + \begin{array}{ll} + \mathcal I_{H0,k} + & = + \left[ + \sum_{s=1}^S + w_{k,s}^2 \frac{p_{k,s}^{pool} (1 - p_{k,s}^{pool})}{N_{C, k, s}} + + w_{k,s}^2 \frac{p_{k,s}^{pool} (1 - p_{k,s}^{pool})}{N_{E, k, s}} + \right]^{-1} \\ + \widehat{\mathcal I}_{H0,k} + & = + \left[ + \sum_{s=1}^S + \widehat w_{k,s}^2 \frac{\widehat p_{k,s}^{pool} (1 - \widehat p_{k,s}^{pool})}{\widehat N_{C,k,s}} + + \widehat w_{k,s}^2 \frac{\widehat p_{k,s}^{pool} (1 - \widehat p_{k,s}^{pool})}{\widehat N_{C,k,s}} + \right]^{-1} + \end{array} + $$ + + - Under the alternative hypothesis, we have $$ + \begin{array}{ll} + \mathcal I_{H1,k} + = + \left[ + \sum_{s=1}^S w_{k,s}^2 \frac{p_{C,k,s} (1 - p_{C,k,s})}{N_{C,k,s}} + + + \sum_{s=1}^S w_{k,s}^2 \frac{p_{E,k,s} (1 - p_{E,k,s})}{N_{E,k,s}} + \right]^{-1}\\ + \widehat{\mathcal I}_{H1,k} + = + \left[ + \sum_{s=1}^S \widehat w_{k,s}^2 \frac{\widehat p_{C,k,s} (1 - \widehat p_{C,k,s})}{\widehat N_{C,k,s}} + + + \sum_{s=1}^S \widehat w_{k,s}^2 \frac{\widehat p_{E,k,s} (1 - \widehat p_{E,k,s})}{\widehat N_{E,k,s}} + \right]^{-1} + \end{array} + $$ + +## Super-Superiority Design + +The hypothesis of the super-superiority design is + +$$ + H_0: \delta_{k,s} = \delta_{k,s}^{null} + \;\; vs. \;\; + H_1: \delta > \delta_{k,s}^{null} \text{ with } \delta_{k,s}^{null} > 0. +$$ +Here $\theta_{k,s_1}^{null} = \theta_{k,s_2}^{null}$ or +$\theta_{k,s_1}^{null} \neq \theta_{k,s_2}^{null}$ for $s_1 \neq s_2$. + +Under the null hypothesis $\theta_{0,k,s} \neq 0$, the estimation of +rates $\widehat p_{C0,k,s}, \widehat p_{E0,k,s}$ satisfy +$$ + \left\{ + \begin{array}{l} + \widehat p_{C0,k,s} = \widehat p_{E0,k,s} + d_{k,s} \times \delta_{k,s}^{null} \\ + \widehat p_{C0,k,s} + r\widehat p_{E0,k,s} = \widehat p_{C,k,s} + r\widehat p_{E,k,s} . + \end{array} + \right. +$$ +Solving these 2 equations with 2 unknowns yields +$$ + \left\{ + \begin{array}{l} + \widehat p_{E0,k,s} & = (\widehat p_{C,k,s} + r \widehat p_{E,k,s} - d_{k,s} \delta_{k,s}^{null}) / (r + 1)\\ + \widehat p_{C0,k,s} & = \widehat p_{E0,k,s} + d_{k,s} \delta_{k,s}^{null}. + \end{array} + \right. +$$ + +- **Variance per strata per analysis:** + + - Under $H_0$, we have + +$$ + \hat\sigma^2_{H_0,k,s} + = + \frac{\widehat p_{C0,k,s}(1- \widehat p_{C0,k,s})}{N_{C,k,s}} + \frac{ \widehat p_{E0,k,s} (1 - \widehat p_{E0,k,s})}{N_{E,k,s}}. +$$ + +- Under $H_1$, we have + +$$ + \widehat\sigma_{H_1,k,s}^2 + = + \frac{\widehat p_{C,k,s} (1- \widehat p_{C,k,s})}{N_{C,k,s}} + \frac{\widehat p_{E,k,s} (1 - \widehat p_{E,k,s})}{N_{E,k,s}}. +$$ + +- **Standardized treatment effect per analysis:** + + - Under the null hypothesis, we have + +$$ + \widehat \theta_{H_0,k} + = + \frac{ + \sum_{s=1}^S w_{k,s} \delta_{s,k}^{null} + }{ + \sqrt{\sum_{s=1}^S w_{k,s}^2 \widehat \sigma_{H_0,k,s}}^2 + }. +$$ + +- Under the alternative hypothesis, we have + +$$ + \widehat \theta_{H_1} + = + \frac{ + \sum_{s=1}^S w_{k,s} d_{k,s} \times (\widehat p_{C,k,s} - \widehat p_{E,k,s}) + }{ + \sqrt{\sum_{s=1}^S w_{k,s}^2 \widehat \sigma_{H_1,k,s}^2} + }. +$$ + +- **Standardized information per analysis:** + + - Under the null hypothesis, we have + +$$ + \widehat{\mathcal I}_{H0,k} + = + \left[ + \sum_{s=1}^S w_{k,s}^2 \frac{\bar p_{C0,s} (1 - \bar p_{C0,s})}{N_{C,s}} + w_{k,s}^2\frac{\bar p_{E0,s} (1 - \bar p_{E0,s})}{N_{E,s}} + \right]^{-1}. +$$ + +- Under the alternative hypothesis, we have + +$$ + \widehat{\mathcal I}_{H1,k} + = + \left[ + \sum_{s=1}^S \left( w_{k,s}^2 \frac{\bar p_{C,k,s} (1 - \bar p_{C,k,s})}{N_{C,k,s}} + w_{k,s}^2 \frac{\bar p_{E,k,s} (1 - \bar p_{E,k,s})}{N_{E,k,s}} \right) + \right]^{-1}. +$$ + +## Non-inferiority Design + +The non-inferiority Design means that, while the treatment group is +definitely not better than the control group, it is not unacceptably +worse. Its hypothesis is +$H_0: \delta_{k,s} = \delta_{k,s}^{null} \;\; vs. \;\; H_1: \delta_{k,s} > \delta_{k,s}^{null}$ +with $\delta_{k,s}^{null} <0$. Its variance, standardized treatment +effect and statistical information is the same as that from +super-superiority design by setting $\delta_{k,s}^{null}$ as negative +numbers. + +# Weighting Options + +As previously noted, we will consider weighting based on either +inverse-variance weights (@MantelHaenszel) or strata sample size weights +(@mehrotra2000minimum). + +- **Inverse-variance weights (INVAR):** +$$ + w_{s,k} = \frac{1/\sigma^2_{s,k}}{\sum_{s=1}^S 1/\sigma^2_{s,k}}. \\ + \widehat w_{s,k} = \frac{1/\widehat\sigma^2_{s,k}}{\sum_{s=1}^S 1/\widehat\sigma^2_{s,k}}. +$$ +where + $\widehat\sigma_{s,k}^2 \in \{\widehat\sigma_{H_0, k,s}^2, \widehat\sigma_{H_1, k,s}^2 \}$ + depending on the infomation scale `info_scale = ...` in + `gs_info_rd()`, `gs_power_rd()` and `gs_design_rd()`. + +- **Sample-Size Weights (SS):** +$$ + w_{s,k} + = + \frac{ + (N_{C, s, k} \; N_{E, s, k}) / (N_{C, s, k} + N_{E, s, k}) + }{ + \sum_{s=1}^S (N_{C, s, k} \; N_{E, s, k}) / (N_{C, s, k} + N_{E, s, k}) + },\\ + \widehat w_{s,k} + = + \frac{ + (\widehat N_{C, s, k} \; \widehat N_{E, s, k}) / (\widehat N_{C, s, k} + \widehat N_{E, s, k}) + }{ + \sum_{s=1}^S (\widehat N_{C, s, k} \; \widehat N_{E, s, k}) / (\widehat N_{C, s, k} + \widehat N_{E, s, k}) + }, +$$ +where $N_{C,s,k}, N_{E,s,k}$ are the planned sample size of the $s$-th strata and $k$-th analysis of the control group and experimental group, respectively. And $\widehat N_{C,s,k}, \widehat N_{E,s,k}$ are the observed sample size of the $s$-th strata and $k$-th analysis of the control group and experimental group, respectively. + +# Simulations + +We do a quick 20,000 simulations and compare the density histogram of +outcomes to the standard normal density. Assume +$r=1, d = 1, p_C=p_E=0.125, N=200$. We then compute $\sigma$ as +`r round(sqrt(.125 * .875/200 * 4), 3)`. Even for this *not huge* sample +size the normal density fits quite well other than some flatness in the +middle. + +```{r, message = FALSE} +# Hypothesized failure rate +p <- .125 +# Other parameters +set.seed(123) +r <- 1 +N <- 200 +NC <- N / (r + 1) +NE <- r * N / (r + 1) +library(ggplot2) +# Generate random counts of events for each treatment +xC <- rbinom(n = 20000, size = NC, prob = p) +xE <- rbinom(n = 20000, size = NE, prob = p) +# Treatment difference estimate +thetahat <- xC / NC - xE / NE +# Standard error under H0 +pbar <- (xC + xE) / N +se0 <- sqrt(pbar * (1 - pbar)*(1 / NC + 1 / NE)) +# Z to test H0 +Z <- thetahat / se0 +x <- seq(-4, 4, .1) +se0a <- sqrt(p * (1 - p) * (1 / NC + 1 / NE)) +y <- data.frame(Z = x, Density = dnorm(x = x, mean = 0, sd = 1)) + +ggplot() + + geom_histogram(data = data.frame(Z), aes(x = Z, y = ..density..), color = 1, fill = "white") + + geom_line(data = y, aes(x = Z, y = Density), linetype = 1) + + ylab("Density") + + ggtitle("Binomial outcomes by simulation vs. asymptotic normal density", + subtitle = "Histogram of 20,000 simulations") +``` + +# Examples + +## Unstratified Fixed Design {.tabset} + +The example discussed in this section is an unstratified fixed design +with equal sized groups to detect a 30% reduction in mortality +associated with congestive heart failure, where the 1-year mortality in +the control group is assumed to be no greater than 0.4. So +$p_C=0.4, p_E = .28$. Under the null hypothesis, we assume +$p_C=p_E =0.34$. We desire 90% power for a two-sided test for two +proportions at $\alpha = 0.05$. And we would like to calculate the +sample size to achieve the 90% power. + +### `gsDesign2` + +First, we set the parameters. + +```{r} +p_c <- .28 +p_e <- .4 +p_pool <- (p_c + p_e) / 2 + +N <- 1 +ratio <- 1 +N_c <- N / (1 + ratio) +N_e <- N_c * ratio +``` + +Then we calculate the variance under $H_0$ and $H_1$. Their mathmatical +formulation are shown as follows. +$$ + \begin{array}{ll} + \sigma^2_{H_0} + = + p^{pool} \left(1 - p^{pool} \right) \left(\frac{1}{N_C} + \frac{1}{N_{E}} \right) + = + p^{pool} \left(1 - p^{pool} \right) \left(\frac{1}{N \xi_C} + \frac{1}{N \xi_E} \right) + \overset{r=1}{=} + p^{pool} \left(1 - p^{pool} \right) \frac{4}{N} \\ + \sigma^2_{H_1} + = + \frac{p_C \left(1 - p_C \right)}{N_C} + + \frac{p_E \left(1 - p_E \right)}{N_E} + = + \frac{p_C \left(1 - p_C \right)}{N \xi_C} + + \frac{p_E \left(1 - p_E \right)}{N \xi_E} + \overset{r=1}{=} + \left[ + p_C \left(1 - p_C \right) + + p_E \left(1 - p_E \right) + \right] \frac{2}{N} + \end{array} +$$ +And their calculation results are + +```{r} +sigma_H0 <- sqrt(p_pool*(1 - p_pool) * 4 / N) +sigma_H1 <- sqrt((p_c*(1 - p_c) + p_e*(1 - p_e)) * 2 / N) + +info_H0 <- 1/(sigma_H0^2) +info_H1 <- 1/(sigma_H1^2) +``` + +Next, we calculate the standarized treatment effect under $H_0$ and +$H_1$, whose mathmatical formulation are +$$ + \begin{array}{ll} + \theta_{H_0} = 0; \\ + \theta_{H_1} = \frac{|p_c - p_e|}{\sigma_{H_1}} + \end{array}. +$$ + +And their calculation results are + +```{r} +theta_H0 <- 0 +theta_H1 <- abs(p_c - p_e)/sigma_H1 + +tibble::tribble( + ~N_c, ~N_e, ~p_c, ~p_e, ~theta_H1, ~theta_H0, ~info_H1, ~info_H0, + N_c, N_e, p_c, p_e, theta_H1, theta_H0, info_H1, info_H0, +) %>% gt::gt() +``` + +The above logic is implemented in teh function `gs_info_rd()`. + +```{r} +x <- gs_info_rd( + p_c = tibble::tibble(Stratum = "All", Rate = .28), + p_e = tibble::tibble(Stratum = "All", Rate = .4), + N = tibble::tibble(Stratum = "All", N = 1, Analysis = 1), + rd0 = 0, + ratio = 1, + weight = "un-stratified") + +x %>% + gt::gt() %>% + gt::fmt_number(columns = 5:8, decimals = 6) +``` + +By plugging the `theta` and `info` above into `gs_design_npe()`, one can +calculate the sample size to achieve the 90% power. + +```{r} +# under info_scale = 0 +y_0 <- gs_design_npe( + theta = .4 - .28, + info = x$info0, + info0 = x$info0, + info_scale = 0, + alpha = .025, + beta = .1, + upper = gs_b, + lower = gs_b, + upar = list(par = -qnorm(.025)), + lpar = list(par = -Inf)) + +# under info_scale = 1 +y_1 <- gs_design_npe( + theta = .4 - .28, + info = x$info1, + info0 = x$info0, + info_scale = 1, + alpha = .025, + beta = .1, + upper = gs_b, + lower = gs_b, + upar = list(par = -qnorm(.025)), + lpar = list(par = -Inf)) + +# under info_scale = 2 +y_2 <- gs_design_npe( + theta = .4 - .28, + info = x$info1, + info0 = x$info0, + info_scale = 2, + alpha = .025, + beta = .1, + upper = gs_b, + lower = gs_b, + upar = list(par = -qnorm(.025)), + lpar = list(par = -Inf)) + +tibble(`info_scale = 0` = y_0$info0[1] / x$info0[1], + `info_scale = 1` = y_1$info1[1] / x$info1[1], + `info_scale = 2` = y_2$info[1] / x$info1[1]) %>% + gt::gt() %>% + gt::tab_header(title = "The sample size calculated by gsDesign2 under 3 info_scale") +``` + +The above logic is implement in `gs_design_rd()` to calculate the sample +size given fixed power in one-step. + +```{r} +z_info_scale_0 <- gs_design_rd( + p_c = tibble::tibble(Stratum = "All", Rate = .28), + p_e = tibble::tibble(Stratum = "All", Rate = .4), + rd0 = 0, + alpha = 0.025, + beta = 0.1, + ratio = 1, + weight = "un-stratified", + upper = gs_b, + lower = gs_b, + upar = -qnorm(.025), + lpar = -Inf, + info_scale = 0) + +z_info_scale_1 <- gs_design_rd( + p_c = tibble::tibble(Stratum = "All", Rate = .28), + p_e = tibble::tibble(Stratum = "All", Rate = .4), + rd0 = 0, + alpha = 0.025, + beta = 0.1, + ratio = 1, + weight = "un-stratified", + upper = gs_b, + lower = gs_b, + upar = -qnorm(.025), + lpar = -Inf, + info_scale = 1) + +z_info_scale_2 <- gs_design_rd( + p_c = tibble::tibble(Stratum = "All", Rate = .28), + p_e = tibble::tibble(Stratum = "All", Rate = .4), + rd0 = 0, + alpha = 0.025, + beta = 0.1, + ratio = 1, + weight = "un-stratified", + upper = gs_b, + lower = gs_b, + upar = -qnorm(.025), + lpar = -Inf, + info_scale = 2) +``` + +### `gsDesign` + +```{r, echo=FALSE} +x_gsDesign <- gsDesign::nBinomial(p1 = .28, p2 = .4, delta0 = 0, alpha = .025, sided = 1, beta = .1, outtype = 3) +``` + +### EAST + +```{r label = EastFix, echo = FALSE, fig.cap = "Sample size calculated by EAST", out.width = '90%'} +knitr::include_graphics("./figures/east_n_fix.png") +``` + +### Summary +```{r} +tibble::tibble(gsDesign2_info_scale_0 = z_info_scale_0$analysis$N, + gsDesign2_info_scale_1 = z_info_scale_1$analysis$N, + gsDesign2_info_scale_2 = z_info_scale_2$analysis$N, + gsDesign = x_gsDesign$n, + EAST_unpool = 645, + EAST_pool = 651) %>% + gt::gt() %>% + gt::tab_spanner(label = "gsDesign2", + columns = c(gsDesign2_info_scale_0, gsDesign2_info_scale_1, gsDesign2_info_scale_2)) %>% + gt::tab_spanner(label = "EAST", + columns = c(EAST_unpool, EAST_pool)) %>% + cols_label(gsDesign2_info_scale_0 = "info_scale = 0", + gsDesign2_info_scale_1 = "info_scale = 1", + gsDesign2_info_scale_2 = "info_scale = 2", + EAST_unpool = "un-pooled", + EAST_pool = "pooled") +``` + +## Unstratified Group Sequential Design {.tabset} + +The example discussed in this section is an unstratified group +sequential design with equal sized groups to detect +$p_C = 0.15, p_E = .1$.\ +Under the null hypothesis, we assume $p_C = p_E = 0.125$. We desire 90% +power for a two-sided test for two proportions at $\alpha = 0.05$. And +we would like to calculate the sample size to achieve the 90% power. + +### `gsDesign2` + +To calculate the sample size, one can use `gs_design_rd()`. The logic of +`gs_design_rd()` is to calculate the sample size of fixed design first. + +```{r} +x_gs <- gs_info_rd( + p_c = tibble::tibble(Stratum = "All", Rate = .15), + p_e = tibble::tibble(Stratum = "All", Rate = .1), + N = tibble::tibble(Stratum = "All", N = 1:3/3, Analysis = 1:3), + rd0 = 0, + ratio = 1, + weight = "un-stratified" +) + +x_gs %>% + gt::gt() %>% + gt::tab_header(title = "The statistical information of the group sequential design") +``` + +```{r} +# info_scale = 0 +y_gs0 <- gs_design_npe( + theta = .05, + info = x_gs$info0, + info0 = x_gs$info0, + info_scale = 0, + alpha = .025, beta = .1, binding = FALSE, + upper = gs_b, + lower = gs_b, + upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, + lpar = rep(-Inf, 3), + test_lower = FALSE) + +# info_scale = 1 +y_gs1 <- gs_design_npe( + theta = .05, + info = x_gs$info1, + info0 = x_gs$info1, + info_scale = 2, + alpha = .025, beta = .1, binding = FALSE, + upper = gs_b, + lower = gs_b, + upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, + lpar = rep(-Inf, 3), + test_lower = FALSE) + +# info_scale = 2 +y_gs2 <- gs_design_npe( + theta = .05, + info = x_gs$info1, + info0 = x_gs$info0, + info_scale = 2, + alpha = .025, beta = .1, binding = FALSE, + upper = gs_b, + lower = gs_b, + upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, + lpar = rep(-Inf, 3), + test_lower = FALSE) + +tibble(`info_scale = 0` = y_gs0$info0 / x_gs$info0[3], + `info_scale = 1` = y_gs1$info1 / x_gs$info1[3], + `info_scale = 2` = y_gs2$info / x_gs$info1[3]) %>% + gt::gt() %>% + gt::tab_header(title = "The sample size calculated by `gsDesign2` under 3 info_scale", subtitle = "under group sequential design") +``` + +The above logic is implemented in `gs_design_rd()`. + +```{r} +x_gsDesign2_info_scale_0 <- gs_design_rd( + p_c = tibble::tibble(Stratum = "All", Rate = .15), + p_e = tibble::tibble(Stratum = "All", Rate = .1), + IF = 1:3/3, + rd0 = 0, + alpha = .025, + beta = .1, + ratio = 1, + weight = "un-stratified", + upper = gs_b, + lower = gs_b, + upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, + lpar = rep(-Inf, 3), + test_lower = FALSE, + info_scale = 0 +) + +x_gsDesign2_info_scale_1 <- gs_design_rd( + p_c = tibble::tibble(Stratum = "All", Rate = .15), + p_e = tibble::tibble(Stratum = "All", Rate = .1), + IF = 1:3/3, + rd0 = 0, + alpha = .025, + beta = .1, + ratio = 1, + weight = "un-stratified", + upper = gs_b, + lower = gs_b, + upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, + lpar = rep(-Inf, 3), + test_lower = FALSE, + info_scale = 1 +) + +x_gsDesign2_info_scale_2 <- gs_design_rd( + p_c = tibble::tibble(Stratum = "All", Rate = .15), + p_e = tibble::tibble(Stratum = "All", Rate = .1), + IF = 1:3/3, + rd0 = 0, + alpha = .025, + beta = .1, + ratio = 1, + weight = "un-stratified", + upper = gs_b, + lower = gs_b, + upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, + lpar = rep(-Inf, 3), + test_lower = FALSE, + info_scale = 2 +) +``` + +### `gsDesign` + +```{r} +n_fix <- nBinomial( + # Control event rate + p1 = .15, + # Experimental event rate + p2 = .1, + # Null hypothesis event rate difference (control - experimental) + delta0 = 0, + # 1-sided Type I error + alpha = .025, + # Type II error (1 - Power) + beta = .1, + # Experimental/Control randomization ratio + ratio = 1) + +cat("The sample size of fixed-design calculated by `gsDesign` is ", n_fix, ".\n") + +x_gsDesign <- gsDesign( + k = 3, + test.type = 1, + # 1-sided Type I error + alpha = .025, + # Type II error (1 - Power) + beta = .1, + # If test.type = 5 or 6, this sets maximum spending for futility + # under the null hypothesis. Otherwise, this is ignored. + astar = 0, + timing = 1:3/3, + sfu = sfLDOF, + sfupar = NULL, + sfl = sfLDOF, + sflpar = NULL, + # Difference in event rates under alternate hypothesis + delta = 0, + # Difference in rates under H1 + delta1 = .05, + # Difference in rates under H0 + delta0 = 0, + endpoint = "Binomial", + # Fixed design sample size from nBinomial above + n.fix = n_fix) + +cat("The sample size calcuated by `gsDesign` is ", x_gsDesign$n.I, ".\n") + +gsBoundSummary(x_gsDesign, digits = 4, ddigits = 2, tdigits = 1) +``` + +### EAST + +```{r label = EastGs, echo = FALSE, fig.cap = "Sample size calculated by EAST", out.width = '90%'} +knitr::include_graphics("./figures/east_n_gs.png") +``` + +```{r label = EastGsUnpool, echo = FALSE, fig.cap = "Sample size calculated by EAST", out.width = '90%'} +knitr::include_graphics("./figures/east_n_gs_unpool.png") +``` + +```{r label = EastGsPool, echo = FALSE, fig.cap = "Sample size calculated by EAST", out.width = '90%'} +knitr::include_graphics("./figures/east_n_gs_pool.png") +``` + + +### Summary + +```{r} +tibble::tibble(gsDesign2_info_scale_0 = x_gsDesign2_info_scale_0$analysis$N, + gsDesign2_info_scale_1 = x_gsDesign2_info_scale_1$analysis$N, + gsDesign2_info_scale_2 = x_gsDesign2_info_scale_2$analysis$N, + gsDesign = x_gsDesign$n.I, + EAST_unpool = c(617, 1233, 1850), + EAST_pool = c(619, 1238, 1857)) %>% + gt::gt() %>% + gt::tab_spanner(label = "gsDesign2", + columns = c(gsDesign2_info_scale_0, gsDesign2_info_scale_1, gsDesign2_info_scale_2)) %>% + gt::tab_spanner(label = "EAST", + columns = c(EAST_unpool, EAST_pool)) %>% + cols_label(gsDesign2_info_scale_0 = "info_scale = 0", + gsDesign2_info_scale_1 = "info_scale = 1", + gsDesign2_info_scale_2 = "info_scale = 2", + EAST_unpool = "un-pooled", + EAST_pool = "pooled") +``` + +## Stratified Group Sequential Design {.tabset} + +In this example, we consider 3 strata in a group sequential design with +3 analyses. + +### `gsDesign2` + +```{r, message=FALSE} +ratio <- 1 +prevalence_ratio <- c(4, 5, 6) +p_c_by_stratum <- c(.3, .37, .6) +p_e_by_stratum <- c(.25, .3, .5) + +p_c <- tibble::tibble(Stratum = c("S1", "S2", "S3"), Rate = p_c_by_stratum) +p_e <- tibble::tibble(Stratum = c("S1", "S2", "S3"), Rate = p_e_by_stratum) +ratio_strata_c <- tibble::tibble(Stratum = c("S1", "S2", "S3"), ratio = prevalence_ratio) +ratio_strata_e <- ratio_strata_c + +N <- 1 +IF <- 1:3/3 +N_c <- N / (1 + ratio) +N_e <- ratio * N_c + +x <- p_c %>% + rename(p_c = Rate) %>% + left_join(p_e) %>% + rename(p_e = Rate) %>% + mutate(p_pool = (p_c + p_e) / 2) %>% + mutate(xi_c = (ratio_strata_c %>% mutate(prop = ratio / sum(ratio)))$prop) %>% + mutate(xi_e = (ratio_strata_e %>% mutate(prop = ratio / sum(ratio)))$prop) %>% + mutate(N_c = N_c * xi_c, N_e = N_e * xi_e) + +x %>% + gt::gt() %>% + gt::fmt_number(columns = 4:8, decimals = 4) %>% + gt::tab_footnote(footnote = "p_pool = (p_c * N_c + p_e * N_e) / (N_c * N_e).", + locations = gt::cells_column_labels(columns = p_pool)) %>% + gt::tab_footnote(footnote = "xi_c = sample size of a strata / sample size of the control arm.", + locations = gt::cells_column_labels(columns = xi_c)) %>% + gt::tab_footnote(footnote = "xi_e = sample size of a strata / sample size of the experimental arm.", + locations = gt::cells_column_labels(columns = xi_e)) %>% + gt::tab_footnote(footnote = "N_c = total sample size of the control arm.", + locations = gt::cells_column_labels(columns = N_c)) %>% + gt::tab_footnote(footnote = "N_e = total size of the experimental arm.", + locations = gt::cells_column_labels(columns = N_e)) %>% + gt::tab_header(title = "Stratified Example") +``` + +First, we calculate the variance +$$ + \left\{ + \begin{array}{ll} + \sigma^2_{H_0,k,s} + & = + p_{k,s}^{pool} \left(1 - p^{pool}_{k,s} \right) + \left(\frac{1}{N_{C,k,s}} + \frac{1}{N_{E,k,s}} \right) + = + p_{k,s}^{pool} \left(1 - p^{pool}_{k,s} \right) + \left(\frac{1}{ \frac{\xi_s}{1+r} N_{k}} + \frac{1}{ \frac{r \xi_s}{1+r} N_{k}} \right) \\ + \sigma_{H_1,k,s}^2 + & = + \frac{p_{C,s} (1- p_{C,s})}{N_{C,k,s}} + \frac{p_{E,s} (1 - p_{E,s})}{N_{E,k,s}} + = + \frac{p_{C,s} (1- p_{C,s})}{\frac{\xi_s}{1+r} N_{k}} + \frac{p_{E,s} (1 - p_{E,s})}{\frac{r \xi_s}{1+r} N_{k}} + \end{array} + \right. +$$ + +```{r, message=FALSE} +x <- x %>% + union_all(x) %>% + union_all(x) %>% + mutate(Analysis = rep(1:3, each = 3)) %>% + left_join(tibble(Analysis = 1:3, IF = IF)) %>% + mutate(N_c = N_c * IF, N_e = N_e * IF) %>% + select(Analysis, Stratum, p_c, p_pool, p_e, N_c, N_e, xi_c, xi_e) %>% + mutate(sigma_H0 = sqrt(p_pool * (1 - p_pool) * (1 / N_c + 1 / N_e)), + sigma_H1 = sqrt(p_c * (1 - p_c) / N_c + p_e * (1 - p_e) / N_e)) + +x %>% + gt() %>% + gt::fmt_number(6:11, decimals = 4) %>% + gt::tab_footnote(footnote = "sigma_H0 = the H0 sd per stratum per analysis.", + locations = gt::cells_column_labels(columns = sigma_H0)) %>% + gt::tab_footnote(footnote = "sigma_H1 = the H0 sd per stratum per analysis.", + locations = gt::cells_column_labels(columns = sigma_H1)) +``` + +Second, we calculate the weight by using inverse variance + +$$ + w_{s,k} = \frac{1/\sigma^2_{s,k}}{\sum_{s=1}^S 1/\sigma^2_{s,k}}. +$$ + +```{r, message=FALSE} +temp <- x %>% + group_by(Analysis) %>% + summarise(sum_invar_H0 = sum(1/sigma_H0^2), + sum_invar_H1 = sum(1/sigma_H1^2), + sum_ss = sum((N_c * N_e) / (N_c + N_e))) + +x <- x %>% + left_join(temp) %>% + mutate(weight_invar_H0 = 1/sigma_H0^2 / sum_invar_H0, + weight_invar_H1 = 1/sigma_H1^2 / sum_invar_H1, + weight_ss = (N_c * N_e) / (N_c + N_e) / sum_ss) %>% + select(-c(sum_invar_H0, sum_invar_H1, sum_ss)) + +x %>% + gt() %>% + fmt_number(6:14, decimals = 4) %>% + gt::tab_footnote(footnote = "weight_invar_H0 = the weight per stratum per analysis calculated by INVAR by using variance under H0.", + locations = gt::cells_column_labels(columns = weight_invar_H0)) %>% + gt::tab_footnote(footnote = "weight_invar_H1 = the weight per stratum per analysis calculated by INVAR by using variance under H1.", + locations = gt::cells_column_labels(columns = weight_invar_H1)) %>% + gt::tab_footnote(footnote = "weight_ss = the weight per stratum per analysis calculated by SS.", + locations = gt::cells_column_labels(columns = weight_ss)) +``` + +Third, we calculate the weighted risk difference and weighted +statistical information. +$$ + \left\{ + \begin{array}{ll} + \delta_{H_0,k} + & = 0\\ + \delta_{H_1,k} + & = \sum_{s=1}^S w_{k,s} |p_{C,s} - p_{E,s}| + \end{array} + \right. \\ + \left\{ + \begin{array}{ll} + \mathcal I_{H_0,k} + & = + \left[ + \sum_{s=1}^S + w_{k,s}^2 \frac{p_{k,s}^{pool} (1 - p_{k,s}^{pool})}{N_{C, k, s}} + + w_{k,s}^2 \frac{p_{k,s}^{pool} (1 - p_{k,s}^{pool})}{N_{E, k, s}} + \right]^{-1}\\ + \mathcal I_{H_1,k} + & = + \left[ + \sum_{s=1}^S w_{k,s}^2 \frac{p_{C,k,s} (1 - p_{C,k,s})}{N_{C,k,s}} + + + \sum_{s=1}^S w_{k,s}^2 \frac{p_{E,k,s} (1 - p_{E,k,s})}{N_{E,k,s}} + \right]^{-1} + \end{array} + \right. \\ +$$ + +```{r} +x <- x %>% + group_by(Analysis) %>% + summarise(rd_invar_H0 = sum(weight_invar_H0 * abs(p_c - p_e)), + rd_invar_H1 = sum(weight_invar_H1 * abs(p_c - p_e)), + rd_ss = sum(weight_ss * abs(p_c - p_e)), + rd0 = 0, + info_invar_H0 = 1 / sum(weight_invar_H0^2*p_c*(1-p_c)/N_c + weight_invar_H0^2*p_e*(1-p_e)/N_e), + info_invar_H1 = 1 / sum(weight_invar_H1^2*p_c*(1-p_c)/N_c + weight_invar_H1^2*p_e*(1-p_e)/N_e), + info_ss = 1 / sum(weight_ss^2*p_c*(1-p_c)/N_c + weight_ss^2*p_e*(1-p_e)/N_e), + info0_invar_H0 = 1 / sum(weight_invar_H0^2*p_pool*(1-p_pool)/N_c + weight_invar_H0^2*p_pool*(1-p_pool)/N_e), + info0_invar_H1 = 1 / sum(weight_invar_H1^2*p_pool*(1-p_pool)/N_c + weight_invar_H1^2*p_pool*(1-p_pool)/N_e), + info0_ss = 1 / sum(weight_ss^2*p_pool*(1-p_pool)/N_c + weight_ss^2*p_pool*(1-p_pool)/N_e) + ) +``` + + +```{r} +x %>% + gt::gt() %>% + fmt_number(c(2:4, 6:11), decimals = 6) %>% + gt::tab_footnote(footnote = "info_invar_H0 = the statistical information under H1 per stratum per analysis calculated by INVAR by using variance under H0.", + locations = gt::cells_column_labels(columns = info_invar_H0)) %>% + gt::tab_footnote(footnote = "info_invar_H1 = the statistical information under H1 per stratum per analysis calculated by INVAR by using variance under H0.", + locations = gt::cells_column_labels(columns = info_invar_H1)) %>% + gt::tab_footnote(footnote = "info_ss = the statistical information under H1 per stratum per analysis calculated by SS.", + locations = gt::cells_column_labels(columns = info_ss)) %>% + gt::tab_footnote(footnote = "info0_invar_H0 = the statistical information under H0 per stratum per analysis calculated by INVAR by using variance under H0.", + locations = gt::cells_column_labels(columns = info0_invar_H0)) %>% + gt::tab_footnote(footnote = "info0_invar_H1 = the statistical information under H0 per stratum per analysis calculated by INVAR by using variance under H0.", + locations = gt::cells_column_labels(columns = info0_invar_H1)) %>% + gt::tab_footnote(footnote = "info0_ss = the statistical information under H0 per stratum per analysis calculated by SS.", + locations = gt::cells_column_labels(columns = info0_ss)) +``` + +```{r} +# ----------------------------------- # +# sample size under H0 # +# ----------------------------------- # +y_invar_H0 <- gs_design_npe( + theta = x$rd_invar_H0, + info = x$info0_invar_H0, + info0 = x$info0_invar_H0, + info_scale = 2, + alpha = 0.025, + beta = 0.2, + upper = gs_b, + lower = gs_b, + upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, + lpar = rep(-Inf, 3), + test_lower = FALSE, +) + +y_invar_H1 <- gs_design_npe( + theta = x$rd_invar_H1, + info = x$info0_invar_H1, + info0 = x$info0_invar_H1, + info_scale = 2, + alpha = 0.025, + beta = 0.2, + upper = gs_b, + lower = gs_b, + upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, + lpar = rep(-Inf, 3), + test_lower = FALSE, +) + +y_ss <- gs_design_npe( + theta = x$rd_ss, + info = x$info0_ss, + info0 = x$info0_ss, + info_scale = 2, + alpha = 0.025, + beta = 0.2, + upper = gs_b, + lower = gs_b, + upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, + lpar = rep(-Inf, 3), + test_lower = FALSE, +) + +# ----------------------------------- # +# sample size under H1 # +# ----------------------------------- # +yy_invar_H0 <- gs_design_npe( + theta = x$rd_invar_H0, + info = x$info_invar_H0, + info0 = x$info0_invar_H0, + info_scale = 2, + alpha = 0.025, + beta = 0.2, + upper = gs_b, + lower = gs_b, + upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, + lpar = rep(-Inf, 3), + test_lower = FALSE, +) + +yy_invar_H1 <- gs_design_npe( + theta = x$rd_invar_H1, + info = x$info_invar_H1, + info0 = x$info0_invar_H1, + info_scale = 2, + alpha = 0.025, + beta = 0.2, + upper = gs_b, + lower = gs_b, + upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, + lpar = rep(-Inf, 3), + test_lower = FALSE, +) + +yy_ss <- gs_design_npe( + theta = x$rd_ss, + info = x$info_ss, + info0 = x$info0_ss, + info_scale = 2, + alpha = 0.025, + beta = 0.2, + upper = gs_b, + lower = gs_b, + upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, + lpar = rep(-Inf, 3), + test_lower = FALSE, +) + +ans_math <- tibble::tibble(`Weighting method` = rep(c("INVAR-H0", "INVAR-H1", "Sample Size"), 2), + `Calculated under` = c(rep("H0", 3), rep("H1", 3)), + `Sample size` = c(y_invar_H0$info[3] / x$info0_invar_H0[3], + y_invar_H1$info[3] / x$info0_invar_H1[3], + y_ss$info[3] / x$info0_ss[3], + yy_invar_H0$info[3] / x$info_invar_H0[3], + yy_invar_H1$info[3] / x$info_invar_H1[3], + yy_ss$info[3] / x$info_ss[3])) + +ans_math %>% + gt::gt() %>% + gt::tab_header(title = "Sample size calculated by INVAR and SS") +``` + +The above logic is implemented in `gs_design_rd()`. + +```{r} +## sample size weighting + information scale = 0 +x_ss0 <- gs_design_rd( + p_c = p_c, + p_e = p_e, + IF = 1:3/3, + rd0 = 0, + alpha = .025, + beta = .2, + ratio = 1, + stratum_prev = tibble::tibble(Stratum = c("S1", "S2", "S3"), prevalence = 4:6), + weight = "ss", + upper = gs_b, + lower = gs_b, + upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, + lpar = c(qnorm(.1), rep(-Inf, 2)), + info_scale = 0, + binding = FALSE) +``` + +```{r} +## sample size weighting + information scale = 1 +x_ss1 <- gs_design_rd( + p_c = p_c, + p_e = p_e, + IF = 1:3/3, + rd0 = 0, + alpha = .025, + beta = .2, + ratio = 1, + stratum_prev = tibble::tibble(Stratum = c("S1", "S2", "S3"), prevalence = 4:6), + weight = "ss", + upper = gs_b, + lower = gs_b, + upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, + lpar = c(qnorm(.1), rep(-Inf, 2)), + info_scale = 1, + binding = FALSE) +``` + +```{r} +## sample size weighting + information scale = 2 +x_ss2 <- gs_design_rd( + p_c = p_c, + p_e = p_e, + IF = 1:3/3, + rd0 = 0, + alpha = .025, + beta = .2, + ratio = 1, + stratum_prev = tibble::tibble(Stratum = c("S1", "S2", "S3"), prevalence = 4:6), + weight = "ss", + upper = gs_b, + lower = gs_b, + upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, + lpar = c(qnorm(.1), rep(-Inf, 2)), + info_scale = 2, + binding = FALSE) +``` + +```{r} +## inverse variance weighting + information scale = 0 +x_invar0 <- gs_design_rd( + p_c = p_c, + p_e = p_e, + IF = 1:3/3, + rd0 = 0, + alpha = .025, + beta = .2, + ratio = 1, + stratum_prev = tibble::tibble(Stratum = c("S1", "S2", "S3"), prevalence = 1:3), + weight = "invar", + upper = gs_b, + lower = gs_b, + upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, + lpar = c(qnorm(.1), rep(-Inf, 2)), + info_scale = 0, + binding = FALSE) +``` + +```{r} +## inverse variance weighting + information scale = 1 +x_invar1 <- gs_design_rd( + p_c = p_c, + p_e = p_e, + IF = 1:3/3, + rd0 = 0, + alpha = .025, + beta = .2, + ratio = 1, + stratum_prev = tibble::tibble(Stratum = c("S1", "S2", "S3"), prevalence = 1:3), + weight = "invar", + upper = gs_b, + lower = gs_b, + upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, + lpar = c(qnorm(.1), rep(-Inf, 2)), + info_scale = 1, + binding = FALSE) +``` + +```{r} +## inverse variance weighting + information scale = 2 +x_invar2 <- gs_design_rd( + p_c = p_c, + p_e = p_e, + IF = 1:3/3, + rd0 = 0, + alpha = .025, + beta = .2, + ratio = 1, + stratum_prev = tibble::tibble(Stratum = c("S1", "S2", "S3"), prevalence = 1:3), + weight = "invar", + upper = gs_b, + lower = gs_b, + upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, + lpar = c(qnorm(.1), rep(-Inf, 2)), + info_scale = 2, + binding = FALSE) +``` + +```{r} +ans <- tibble::tibble(INVAR0 = x_invar0$analysis$N[1:3], + INVAR1 = x_invar1$analysis$N[1:3], + INVAR2 = x_invar2$analysis$N[1:3], + SS0 = x_ss0$analysis$N[1:3], + SS1 = x_ss1$analysis$N[1:3], + SS2 = x_ss2$analysis$N[1:3]) +ans %>% + gt::gt() %>% + gt::tab_header(title = "Sample size calculated by INVAR and SS") %>% + gt::tab_spanner(label = "Inverse variance weighting", + columns = c(INVAR0, INVAR1, INVAR2)) %>% + gt::tab_spanner(label = "Sample size wighting", + columns = c(SS0, SS1, SS2)) %>% + cols_label(INVAR0 = "info_scale = 0", + INVAR1 = "info_scale = 1", + INVAR2 = "info_scale = 2", + SS0 = "info_scale = 0", + SS1 = "info_scale = 1", + SS2 = "info_scale = 2") +``` + +### Simulations + + +```{r} +run_simulation <- function(N, weight_method, n_sim, prevalence_ratio, IF, under_H0 = TRUE, integration = "gs_power_npe"){ + + ans <- NULL + + N_S1 <- ceiling(N * prevalence_ratio[1] / sum(prevalence_ratio)) * IF + N_S2 <- ceiling(N * prevalence_ratio[2] / sum(prevalence_ratio)) * IF + N_S3 <- ceiling(N * prevalence_ratio[3] / sum(prevalence_ratio)) * IF + + # begin the simulations + for (simu in 1:n_sim) { + + # set the random seed + set.seed(simu) + + # observations of 3 strata in FA + x_e_S1 <- lapply(diff(c(0, ceiling(N_S1/2))), function(x){rbinom(n = x, size = 1, prob = p_e$Rate[1])}) + x_e_S2 <- lapply(diff(c(0, ceiling(N_S2/2))), function(x){rbinom(n = x, size = 1, prob = p_e$Rate[2])}) + x_e_S3 <- lapply(diff(c(0, ceiling(N_S3/2))), function(x){rbinom(n = x, size = 1, prob = p_e$Rate[3])}) + x_c_S1 <- lapply(diff(c(0, ceiling(N_S1/2))), function(x){rbinom(n = x, size = 1, prob = p_c$Rate[1])}) + x_c_S2 <- lapply(diff(c(0, ceiling(N_S2/2))), function(x){rbinom(n = x, size = 1, prob = p_c$Rate[2])}) + x_c_S3 <- lapply(diff(c(0, ceiling(N_S3/2))), function(x){rbinom(n = x, size = 1, prob = p_c$Rate[3])}) + + # calculate the number of events at FA + n_e_S1 <- cumsum(do.call(c, lapply(x_e_S1, sum))) + n_e_S2 <- cumsum(do.call(c, lapply(x_e_S2, sum))) + n_e_S3 <- cumsum(do.call(c, lapply(x_e_S3, sum))) + n_c_S1 <- cumsum(do.call(c, lapply(x_c_S1, sum))) + n_c_S2 <- cumsum(do.call(c, lapply(x_c_S2, sum))) + n_c_S3 <- cumsum(do.call(c, lapply(x_c_S3, sum))) + + # calculate the events rates + p_e_S1 <- n_e_S1 / (N_S1/2) + p_e_S2 <- n_e_S2 / (N_S2/2) + p_e_S3 <- n_e_S3 / (N_S3/2) + p_c_S1 <- n_c_S1 / (N_S1/2) + p_c_S2 <- n_c_S2 / (N_S2/2) + p_c_S3 <- n_c_S3 / (N_S3/2) + + # calculate the variance per stratum per analysis + x <- tibble::tibble(analysis = rep(1:3, 3), + statum = rep(c("S1", "S2", "S3"), each = 3), + IF = rep(IF, 3), + N_e = c(N_S1/2, N_S2/2, N_S3/2), + N_c = N_e, + n_e = c(n_e_S1, n_e_S2, n_e_S3), + n_c = c(n_c_S1, n_c_S2, n_c_S3), + p_e = c(p_e_S1, p_e_S2, p_e_S3), + p_c = c(p_c_S1, p_c_S2, p_c_S3) + )%>% + mutate(p_pool = (n_c + n_e) / (N_c + N_e), + sigma_H0 = sqrt(p_pool * (1 - p_pool) * (1 / N_c + 1 / N_e)), + sigma_H1 = sqrt(p_c * (1 - p_c) / N_c + p_e * (1 - p_e) / N_e)) + # calculate the sum of weights + sum_weight <- x %>% + group_by(analysis) %>% + summarize(sum_invar_H0 = sum(1/sigma_H0^2), + sum_invar_H1 = sum(1/sigma_H1^2), + sum_ss = sum((N_c * N_e) / (N_c + N_e))) %>% + ungroup() + # calculate the weight per stratum + suppressMessages( + x <- x %>% + left_join(sum_weight) %>% + mutate(weight_invar_H0 = 1/sigma_H0^2 / sum_invar_H0, + weight_invar_H1 = 1/sigma_H1^2 / sum_invar_H1, + weight_ss = (N_c * N_e) / (N_c + N_e) / sum_ss) %>% + select(-c(sum_invar_H0, sum_invar_H1, sum_ss)) %>% + # calculated the weighted rd and info + group_by(analysis) %>% + summarise(# weighted risk difference + rd_invar_H0 = sum(weight_invar_H0 * abs(p_c - p_e)), + rd_invar_H1 = sum(weight_invar_H1 * abs(p_c - p_e)), + rd_ss = sum(weight_ss * abs(p_c - p_e)), + rd0 = 0, + # weighted statistical information under H1 + info_invar_H0 = 1 / sum(weight_invar_H0^2*p_c*(1-p_c)/N_c + weight_invar_H0^2*p_e*(1-p_e)/N_e), + info_invar_H1 = 1 / sum(weight_invar_H1^2*p_c*(1-p_c)/N_c + weight_invar_H1^2*p_e*(1-p_e)/N_e), + info_ss = 1 / sum(weight_ss^2 *p_c*(1-p_c)/N_c + weight_ss^2 *p_e*(1-p_e)/N_e), + # weighted statistical information under H0 + info0_invar_H0 = 1 / sum(weight_invar_H0^2*p_pool*(1-p_pool) * (1/N_c + 1/N_e)), + info0_invar_H1 = 1 / sum(weight_invar_H1^2*p_pool*(1-p_pool) * (1/N_c + 1/N_e)), + info0_ss = 1 / sum(weight_ss^2 *p_pool*(1-p_pool) * (1/N_c + 1/N_e))) %>% + ungroup() + ) + + + # calculate the power + if(integration == "gs_power_npe"){ + res <- switch (weight_method, + "invar_H0" = { + gs_power_npe(theta = x$rd_invar_H0, + info = x$info_invar_H0, + info_scale = 2, + binding = FALSE, + upper = gs_b, + lower = gs_b, + upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, + lpar = c(qnorm(.1), rep(-Inf, 2)), + test_upper = TRUE, + test_lower = TRUE, + r = 18, + tol = 1e-6 + ) + }, + "invar_H1" = { + gs_power_npe(theta = x$rd_invar_H1, + info = x$info_invar_H1, + info_scale = 2, + binding = FALSE, + upper = gs_b, + lower = gs_b, + upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, + lpar = c(qnorm(.1), rep(-Inf, 2)), + test_upper = TRUE, + test_lower = TRUE, + r = 18, + tol = 1e-6 + ) + }, + "ss" = { + gs_power_npe(theta = x$rd_ss, + info = x$info_ss, + info_scale = 2, + binding = FALSE, + upper = gs_b, + lower = gs_b, + upar = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, + lpar = c(qnorm(.1), rep(-Inf, 2)), + test_upper = TRUE, + test_lower = TRUE, + r = 18, + tol = 1e-6 + ) + } + ) + + ans_new <- tibble::tibble(simu_ID = simu, method = weight_method, + power = res %>% filter(Bound == "Upper", Analysis == 3) %>% select(Probability) %>% unlist() %>% as.numeric()) + } + + if(integration == "pmvtnorm"){ + + if(weight_method == "invar_H0"){ + if(under_H0){ + IF_sim <- x$info0_invar_H0 / x$info0_invar_H0[3] + mean_sim <- x$rd_invar_H0 * sqrt(x$info0_invar_H0) + }else{ + IF_sim <- x$info_invar_H1 / x$info_invar_H1[3] + mean_sim <- x$rd_invar_H1 * sqrt(x$info_invar_H1) + } + } + + if(weight_method == "invar_H1"){ + if(under_H0){ + IF_sim <- x$info0_invar_H1 / x$info0_invar_H1[3] + mean_sim <- x$rd_invar_H1 * sqrt(x$info0_invar_H1) + }else{ + IF_sim <- x$info_invar_H1 / x$info_invar_H1[3] + mean_sim <- x$rd_invar_H1 * sqrt(x$info_invar_H1) + } + } + + if(weight_method == "ss"){ + + if(under_H0){ + IF_sim <- x$info0_ss / x$info0_ss[3] + mean_sim <- x$rd_ss * sqrt(x$info0_ss) + }else{ + IF_sim <- x$info_ss / x$info_ss[3] + mean_sim <- x$rd_ss * sqrt(x$info_ss) + } + } + + p <- pmvnorm(lower = c(rep(-Inf, 3)), + upper = gsDesign(k = 3, test.type = 1, sfu = sfLDOF, sfupar = NULL)$upper$bound, + mean = mean_sim, + corr = matrix(c(1, sqrt(IF_sim[1]/IF_sim[2]), sqrt(IF_sim[1]/IF_sim[3]), + sqrt(IF_sim[1]/IF_sim[2]), 1, sqrt(IF_sim[2]/IF_sim[3]), + sqrt(IF_sim[1]/IF_sim[3]), sqrt(IF_sim[2]/IF_sim[3]), 1), + nrow = 3, byrow = TRUE), + sigma = NULL, + algorithm = GenzBretz(maxpts = 1e5, abseps = 1e-5), keepAttr = FALSE) + + # summarize this simulation + ans_new <- tibble::tibble(simu_ID = simu, method = weight_method, power = 1- p) + } + + ans <- rbind(ans, ans_new) + print(simu) + } + + return(ans) +} +``` + + +```{r, message=FALSE, eval=FALSE} +n_sim <- 1e3 +run simulations +ans_H0 <- do.call(cbind, + lapply(list(list("ss_H0", ans$SS0), + list("invar_H0", ans$INVAR0)), + function(x){return(run_simulation(N = x[[2]], + weight_method = x[[1]], + n_sim = n_sim, prevalence_ratio = prevalence_ratio, + IF = IF, under_H0 = TRUE, integration = "gs_power_npe"))})) + +ans_H1 <- do.call(cbind, + lapply(list(list("ss_H1", ans$SS1), + list("invar_H1", ans$INVAR1)), + function(x){return(run_simulation(N = x[[2]], + weight_method = x[[1]], + n_sim = n_sim, prevalence_ratio = prevalence_ratio, + IF = IF, under_H0 = FALSE, integration = "gs_power_npe"))})) + +ans <- tibble::tibble(simu_ID = rep(ans_H0$simu_ID, 2), + ss = c(ans_H0[, 3], ans_H1[, 3]), + invar = c(ans_H0[, 6], ans_H1[, 6]), + `calculated under` = c(rep("H0", n_sim), rep("H1", n_sim))) + +save(ans, file = "./fixtures/rd_simu_power_gspowernpe_2_weight.Rdata") +``` + + +```{r} +load("./fixtures/rd_simu_power_gspowernpe_2_weight.Rdata") +ans %>% + group_by(`calculated under`) %>% + summarize(`simulated power - ss` = mean(ss), + `simulated power - invar` = mean(invar)) %>% + gt::gt() %>% + gt::tab_header(title = "Simulated power under different weightin methods", + subtitle = "by gs_power_npe") +``` + +# Summary + ++-----------------------------+----------------------------------------+ +| Parameters | Notes | ++:============================+:=======================================+ +| ***risk difference:*** | | ++-----------------------------+----------------------------------------+ +| $\widehat\delta | $\delta_{k,s}^{null}$ is the risk | +| _{H_0,k} = \sum_{s=1}^S w | difference under $H_0$. | +| _{k,s} \delta_{k,s}^{null}$ | | +| | It is 0, positive, and negative for | +| | superiority, super-superiority and | +| | non-inferiority design, respectively. | ++-----------------------------+----------------------------------------+ +| $\widehat \delta_{H_1,k} | $\widehat p_{C,k,s} = \frac{ x | +| =\sum_{s=1}^S w_{k,s} | _{C,k,s}}{N_{C,k,s}}, \; \widehat p_{ | +| (p_{C,k,s} -\widehat | E,k,s} = \frac{x_{E,k,s} }{N_{E,k,s}}$ | +| p_{E,k,s})$ | | ++-----------------------------+----------------------------------------+ +| ***standardized treatment | | +| effect:*** | | ++-----------------------------+----------------------------------------+ +| $\widehat\theta_{H_0,k} | For superiority design, | +| = \frac{\sum_{s=1}^S | $\widehat \sigma^2_{H_0,k,s} | +| w_{k,s}\delta_{s,k}^{null}}| = \widehat p | +| {\sqrt { | _{k,s}^{pool} \left(1 - \widehat p | +| \sum_{s=1}^S w_{k,s}^2 | ^{pool}_{k,s} \right) \left( | +| \widehat \sigma | \frac{1}{N_{C,k,s}} + | +| _{H_0,k,s}^2}}$ | \frac{1}{N_{E,k,s}} \right)$
| +| | | +| | For super-superiority design and | +| | non-inferiority design, | +| | $\hat \sigma^2 | +| | _{H_0,k,s} = \frac {\widehat p | +| | _{C0,k,s}(1- \widehat p_{C0,k,s})}{N_ | +| | {C,k,s}} + \frac{ \widehat p_{E0,k,s} | +| | (1 - \widehat p_{E0,k,s})}{N_{E,k,s}}$ | ++-----------------------------+----------------------------------------+ +| $\widehat\theta_{H_1 ,k} | $\widehat \sigma_{H_1,k,s} | +| = \frac{\sum_{s=1}^S w_{k | = \sqrt{\frac{\widehat p_{C,k,s} | +| ,s} (\widehat p_{C,k,s} - | (1- \widehat p_{C,k,s})}{ | +| \widehat p_{E,k,s})}{\sqrt | N_{C,k,s}} + \frac{\widehat p_{E,k,s} | +| {\sum_{s=1}^S w_{k,s}^2 | (1 - \widehat p_{E,k,s})}{N_{E,k,s}}}$ | +| \widehat | | +| \sigma_{H_1,k,s}^2}}$ | | ++-----------------------------+----------------------------------------+ +| ***statistical | | +| information:*** | | ++-----------------------------+----------------------------------------+ +| $\widehat{\mathcal I} | $N_{k,s} = N_{C,k,s} + N_{E,k,s}$ and | +| _{H_0,k} = \left\{ \begin | $\widehat p_{k,s | +| {array}{ll} \left[ \sum_{ | } = (x_{C,k,s} + x_{E,k,s}) / N_{k,s}$ | +| s=1}^S w_{k,s}^2 \frac{p_ { | | +| k,s}^{pool} (1 - p_{k,s}^{ | | +| pool})}{N_{k,s}}\right]^{-1}| | +| & \text{for superiority | | +| design | | +| } \\ \left[ \sum_{s=1 }^S w | | +| _{k,s}^2 \frac{\bar p_{C0,s}| | +| (1 - \bar p_{C0,s})} {N | | +| _{C,s}} + w_{k,s}^2 \frac{ | | +| \bar p_{E0,s} (1 - \bar p | | +| _{E0,s})}{N_{E,s}} \right] | | +| ^{-1} & \text{for | | +| super-superiority and | | +| non-inferiority design} | | +| \end{array} \right.$ | | ++-----------------------------+----------------------------------------+ +| $\widehat{ | | +| \mathcal I}_{H_1,k} = \left[| | +| \sum_{s=1}^S w_{k,s}^2 \frac| | +| {\widehat p_{C,k,s} (1 - | | +| \widehat p_{C,k,s})}{N_{C,k,| | +| s}} + \sum_{s=1} ^S w | | +| _{k,s}^2 \frac{\widehat p | | +| _{E,k,s} (1 - \widehat p | | +| _{E,k,s})}{N_{E,k,s}} | | +| \right]^{-1}$ | | ++-----------------------------+----------------------------------------+ + +# References diff --git a/vignettes/story_spending_time_example.Rmd b/vignettes/story_spending_time_example.Rmd new file mode 100644 index 000000000..5c640acdf --- /dev/null +++ b/vignettes/story_spending_time_example.Rmd @@ -0,0 +1,963 @@ +--- +title: "Spending Time Examples" +date: "`r format(Sys.time(), '%d %B, %Y')`" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + number_sections: true + highlight: "textmate" + css: "custom.css" +bibliography: "ggsd.bib" +vignette: > + %\VignetteIndexEntry{Spending time examples} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown} +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set(echo = TRUE, message=FALSE, warning = FALSE) +``` + + +```{r} +#library(gsdmvn) +devtools::load_all() +library(gsDesign) +library(tibble) +library(dplyr) +library(gt) +``` + +# Overview + +There are multiple scenarios where event-based spending for group sequential designs has limitations in terms of ensuring adequate follow-up and in ensuring adequate spending is preserved for the final analysis. +Example contexts where this often arises is in trials where + +- there may be a delayed treatment effect, +- control failure rates are different than expected, and +- multiple hypotheses are being tested. + +In general, for such situations we have found that ensuring both adequate follow-up duration and an adequate number of events is important to fully evaluate the potential effectiveness of a new treatment. +For testing of multiple hypotheses, carefully thinking through possible spending issues can be critical. +In addition, for group sequential trials, preserving adequate $\alpha$-spending for a final evaluation of a hypothesis is important and difficult to do using traditional event-based spending. + +In this document, we outline three examples to demonstrate these issues: + +- For a delayed effect scenario we demonstrate: + - the importance of both adequate events and adequate follow-up duration to ensure power in a fixed design, and + - the importance of guaranteeing a reasonable amount of $\alpha$-spending for the final analysis in a group sequential design. +- For a trial examining an outcome in a biomarker positive and overall populations, we show the importance of considering how the design reacts to incorrect design assumptions on biomarker prevalence. + +For the group sequential design options, we demonstrate that the concept of spending time is an effective way to adapt. +Traditionally @LanDeMets, spending has been done according to targeting a specific number of events for an outcome at the end of the trial. +However, for delayed treatment effect scenarios there is substantial literature (e.g., @NPHWG2020sim, @NPHWG2021Design) documenting the importance of adequate follow-up duration in addition to requiring an adequate number of events under the traditional proportional hazards assumption. + +While other approaches could be taken, we have found the spending time approach generalizes well for addressing a variety of scenarios. +The fact that spending does not need to correspond to information fraction was perhaps first raised by @LanDeMets1989 where calendar-time spending was discussed. +However, we note that @PLWBook have raised other scenarios where spending alternatives are considered. +Two specific spending approaches are suggested here: + +- Spending according to the minimum of planned and observed event counts. This is suggested for the delayed effect examples. +- Spending with a common spending time across multiple hypotheses; e.g., in the multiple population example, spending in the overall population at the same rate as in the biomarker positive subgroup regardless of event counts over time in the overall population. This is consistent with @FPG as applied when multiple experimental treatments are compared to a common control. Spending time in this case corresponds to the approach of @FHO where fixed incremental spending is set for a potentially variable number of interim analyses. + +This document is fairly long in that it demonstrates a number of scenarios relevant to the spending time concept. +The layout is intended to make it as easy as possibly to focus on the individual examples for those not interested in the full review. +Code is available to unhide for those interested in implementation. +Rather than bog down the conceptual discussion with implementation details, we have tried to provide sufficient comments in the code to guide implementation for those who are interested in that. + + +# Delayed Effect Scenario + +We consider an example in a single stratum where there is a possibility of a delayed treatment effect. +The next two sections will consider both a 1) fixed design with no interim analysis, and 2) a design with interim analysis. +Following are the common assumptions: + +- The control group time-to-event is exponentially distributed with a median of 12 months. +- 2.5% one-sided Type I error. +- 90% power. +- A constant enrollment rate with an expected enrollment duration of 12 months. +- A targeted trial duration of 30 months. +- A delayed effect for the experimental group compared to control, with a hazard ratio of 1 for the first 4 months and a hazard ratio of 0.6 thereafter. + +The restrictions on constant control failure rate, only two hazard ratio time intervals and constant enrollment are not required, but simplify the example. +The approach taken uses an average-hazard ratio approach for approximating treatment effect as in @Mukhopadhyay2020 and the asymptotic group sequential theory of @Tsiatis. + +```{r} +# control median +m <- 12 +# enrollment rate +enrollRates <- tibble( + Stratum = "All", # single stratum + duration = 12, # expected enrollment duration of 12 months + rate = 1 # here the rate is a ratio, which will be updated to achieve the desired sample size + ) +# failure rate +failRates <- tibble( + Stratum = "All", + duration = c(4, 100), # hazard ratio of 1 for the first 4 months and a hazard ratio of 0.6 thereafter + hr = c(1, .6), + failRate = log(2) / m, # exponential distribution + dropoutRate = .001 + ) +``` + +# Fixed Design, Delayed Effect + +The sample size and events for this design are shown below. +We see that the average hazard ratio (AHR) under the above assumptions is 0.7026, part way between the early HR of 1 and the later HR of 0.6 assumed for experimental versus control therapy. + +```{r} +# bounds for fixed design are just a fixed bound for nominal p = 0.025, 1-sided +Z_025 <- qnorm(.975) + +# fixed design, single stratum +# find sample size for 30 month trial under given +# enrollment and sample size assumptions +xx <- gs_design_ahr(enrollRates, + failRates, + analysisTimes = 30, + upar = Z_025, + lpar = Z_025) + +# get the summary table of the fixed design +summary(xx, + analysis_vars = c("Time", "N", "Events", "AHR","IF"), + analysis_decimals = c(0, 0, 0, 4, 4)) %>% as_gt() +``` + +## Power When Assumptions Design are Wrong + +### Scenario 1: Less Experimental Benefit + +If we assume instead that the effect delay is 6 months instead of 4 and the control median is 10 months instead of 12, there is a substantial impact on power. +Here, we have assumed only the targeted events is required to do the final analysis resulting in an expected final analysis time of 25 months instead of the planned 30 and an average hazard ratio of 0.78 at the expected time of analysis rather than the targeted average hazard ratio of 0.70 under the original assumptions. + +```{r} +# update the median of control arm +am <- 10 # alternate control median (the original is 12) + +# update the failure rate table +failRates$duration[1] <- 6 # the original is 4 +failRates$failRate <- log(2) / am # the original is log(2)/12 + +# get the targeted number of events +target_events <- xx$analysis$Events + +# update the design and calculate the power under the targeted events +yy <- gs_power_ahr( + enrollRates = xx$enrollRates, + failRates = failRates, + # here we want to achieve the target events + # and set analysisTimes as NULL + # so the analysisTime will be calculated according to the target events + events = target_events, + analysisTimes = NULL, + upar = Z_025, + lpar = Z_025) + +yy %>% + summary() %>% + as_gt() +``` + +Now we also require 30 months trial duration in addition to the targeted events. +This improves the power from 63\% above to 76\% with an increase from 25 to 30 months duration and 340 to 377 expected events, an important gain. +This is driven both by the average hazard ratio of 0.78 above compared to 0.76 below and by the increased expected number of events. +It also ensures adequate follow-up to better describe longer-term differences in survival; this may be particularly important if early follow-up suggests a delayed effect or crossing survival curves. +Thus, the adaptation of event-based design based to also require adequate follow-up can help ensure power for a large clinical trial investment where there is an clinically relevant underlying survival benefit. + +```{r} +yy <- gs_power_ahr( + enrollRates = xx$enrollRates, + failRates = failRates, + # here we want to achieve the targeted events, + # but also keep the 30 month as the analysisTime + events = target_events, + analysisTimes = 30, + upar = Z_025, + lpar = Z_025) + +# get the summary table of updated design +yy %>% + summary() %>% + as_gt() +``` + +## Scenario 2: Low Control Event Rates + +Now we assume a longer than planned control median, 16 months to demonstrate the value of retaining the event count requirement. +If we analyze after 30 months, the power of the trial is 87\% with 288 events expected. + +```{r} +# alternate control median +am <- 16 # the original is 12 + +# update the failure rate +failRates$failRate <- log(2) / am +failRates$duration[1] <- 4 + +# calculate the power when trial duration is 30 month +yy <- gs_power_ahr( + enrollRates = xx$enrollRates, + failRates = failRates, + # here we set analysisTime as 30 + # and calculate the corresponding number of events + events = NULL, + analysisTimes = 30, + upper = gs_b, upar = Z_025, + lower = gs_b, lpar = Z_025) + +yy %>% + summary() %>% + as_gt() +``` + +If we also require adequate events, we restore power to 94.5, above the originally targeted level of 90%. +The cost is that the expected trial duration becomes 38.5 months rather than 30; however, since the control median is now larger, the additional follow-up should be useful to characterize tail behavior. +Note that for this scenario we are likely particularly interested in retaining power as the treatment effect is actually stronger than the original alternate hypothesis. +Thus, for this example, the time cutoff alone would not have ensured sufficient follow-up to power the trial. + +```{r} +# calculate the power when trial duration is 30 month and the events is the targeted events +yy <- gs_power_ahr( + enrollRates = xx$enrollRates, + failRates = failRates, + # here we set trial duration as 30 month + # and keep the events as the target events + events = target_events, + analysisTimes = 30, + upar = Z_025, + lpar = Z_025) + +yy %>% + summary() %>% + as_gt() +``` + +## Conclusions for Fixed Design + +In summary, we have demonstrated the value of requiring both adequate events and adequate follow-up duration over an approach where the analysis is done with only one of these requirements. +Requiring both will retain both power and important treatment benefit characterization over time when there is potential for delayed onset of a positive beneficial treatment effect. + + +# Group Sequential Design + +## Alternative Spending Strategies + +We extend the above design to detect a delayed effect to a group sequential design with a single interim analysis after 80% of the final planned events have accrued. +We will assume the final analysis will require both the targeted trial duration and events based on the fixed design based on the evaluations above. +We assume the efficacy bound uses the @LanDeMets spending function approximating an O'Brien-Fleming bound. +No futility bound is planned, with the exception of a demonstration for one scenario. +The interim analysis is far enough into the trial so that there is a substantial probability of stopping early under design assumptions. + +Coding for the different strategies must be done carefully. + +**Spending approach 1:** +At the time of design, we specify only the spending function when specifying the use of information fraction for design. +```{r} +# Spending for design with planned information fraction (IF) +upar_design_IF <- list( + # total_spend represents one-sided Type I error + total_spend = 0.025, + # Spending function and associated + # parameter (NULL, in this case) + sf = sfLDOF, + param = NULL, + # Do NOT specify spending time here as it will be set + # by information fraction specified in call to gs_design_ahr() + timing = NULL, + # Do NOT specify maximum information here as it will be + # set as the design maximum information + max_info = NULL) +``` + +**Spending approach 2:** +If we wished to use 22 and 30 months as calendar analysis times and use calendar fraction for spending, we would need to specify spending time for the design. + +```{r} +# CF is for calendar fraction +upar_design_CF <- upar_design_IF +# Now switch spending time to calendar fraction +upar_design_CF$timing <- c(22, 30)/30 +``` + +**Spending approach 3:** +Next we show how to set up information-based spending for power calculation when timing of analysis is not based on information fraction; e.g., we will propose requiring not only achieving planned event counts, but also planned study duration before an analysis is performed. +It is critical to set the maximum planned information to update the information fraction calculation in this case. + +```{r} +# We now need to change max_info from spending as specified for design +upar_actual_IF <- upar_design_IF +# Note that we still have timing = NULL, unchanged from information-based design +upar_actual_IF <- NULL +# Replace NULL maximum information with planned maximum null hypothesis +# information from design +# This max will be updated for each planned design later +upar_actual_IF$max_info <- 100 +``` + +**Spending approach 4:** +The final case will be to replace information fraction for a design to a specific spending time which will be plugged into the spending function to compute incremental $\alpha$-spending for each analysis. +For our case, we will use planned information fraction from the design, which is 0.8 at the interim analysis and 1 for the final analysis. +This will be used regardless of what scenario we are using to compute power, but recall that information fraction is still used for computing correlations in the asymptotic distribution approximation for design tests. + +```{r} +# Copy original upper planned spending +upar_planned_IF <- upar_design_IF +# Interim and final spending time will always be the same, regardless of +# expected events or calendar timing of analysis +upar_planned_IF$timing <- c(0.8, 1) +# We will reset planned maximum information later +``` + +## Planned design + +We extend the design studied above to a group sequential design with a single interim analysis after 80% of the final planned events have accrued. +We will assume the final analysis will require both the targeted trial duration and events based on the fixed design evaluations made above. +We assume the efficacy bound uses the Lan-DeMets spending function approximating an O'Brien-Fleming bound. +No futility bound is planned. +The interim analysis is far enough into the trial that there is a substantial probability of stopping early under design assumptions. + +```{r} +# Control median +m <- 12 + +# Planned information fraction at interim(s) and final +planned_IF <- c(.8, 1) + +# No futility bound +lpar <- rep(-Inf, 2) + +# enrollment rate +enrollRates <- tibble( + Stratum = "All", + duration = 12, + rate = 1) + +# failure rate +failRates <- tibble( + Stratum = "All", + duration = c(4, 100), + hr = c(1, .6), + failRate = log(2) / m, + dropoutRate = .001) + +# get the group sequential design model +xx <- gs_design_ahr( + enrollRates, + failRates, + # final analysis time set to targeted study duration; + # analysis times before are 'small' to ensure use of information fraction for timing + analysisTimes = c(1, 30), + # timing here matches what went into planned_IF above + IF = planned_IF, + # upper bound : spending approach 1 + upper = gs_spending_bound, + upar = upar_design_IF, + # lower bound: no futility bound + lower = gs_b, + lpar = lpar) + +# get the summary table +xx %>% + summary() %>% + as_gt() +``` + +## Two Alternate Approaches + +We consider two alternate approaches to demonstrate the spending time concept that may be helpful in practice. +However, skipping the following two subsections can be done if these are not of interest. +The first demonstrates calendar spending as in @LanDeMets1989. +The second is a basically the method of @FHO where a fixed incremental spend is used for a potentially variable number of interim analyses, with the final bound computed based on the unspent one-sided Type I error assigned to a hypothesis. + +### Calendar Spending + +We use the same sample size as above, but change efficacy bound spending to calendar-based. +The reason this spending is different than information-based spending is mainly due to the fact that the expected information is not linear in time. +In this case, the calendar fraction at interim is less than the information fraction, but exactly the opposite would be true earlier in the trial. +We just note that if calendar-based spending is chosen, it may be worth comparing the design bounds with bounds using the same spending function, but with information-based spending to see if there are important differences to the trial team or possibly to the scientific or regulatory community. +We note also that there is risk there will not be enough events to achieve targeted power at the final analysis under a calendar-based spending strategy. +We will not examine calendar-based spending further in this document. + +```{r} +yy <- gs_power_ahr( + enrollRates = xx$enrollRates, + failRates = xx$failRates, + # Planned time will drive timing since information accrues faster + events = 1:2, + # Interim time rounded + analysisTimes = c(22, 30), + # upper bound: use calendar fraction + upper = gs_spending_bound, + upar = upar_design_CF, + # lower bound: no futility bound + lower = gs_b, + lpar = lpar + ) + +yy %>% + summary() %>% + as_gt() +``` + +### Fixed Incremental Spend with a Variable Number of Aanalyses + +As noted, this method was proposed by @FHO. +The general strategy demonstrated is to do an interim analyses every 6 months until a both a final targeted follow-up time and cumulative number of events is achieved. +Once efficacy analyses start, a fixed incremental spend of 0.001 is used at each interim. +When the criteria for final analysis is met, the remaining $\alpha$ is spent. +Cumulative spending at months 18 and 24 will be 0.001 and 0.002, respectively, with the full cumulative $\alpha$-spending of 0.025 at the final analysis. +This is done by setting the spending time at 18 and 24 months to 1/25, 2/25 and 1; i.e., 1/25 incremental $\alpha$-spending is incorporated at each interim analysis and any remaining $\alpha$ is spent at the final analysis. +This enables a strategy such as analyzing every 6 months until both a minimum targeted follow-up and minimum number of events are observed, at which time the final analysis is performed. +We will skip efficacy analyses at the first two interim analyses at months 6 and 12. + +For futility, we simply use a nominal 1-sided p-value of 0.05 favoring control at each interim. +We note that this only raises a flag if the futility bound is crossed and a Data Monitoring Committee (DMC) can choose to continue the trial even if a futility bound is crossed. +However, the bound may be more effective in providing a DMC guidance not to stop for futility prematurely. +For comparison with the above designs, we will leave the enrollment rates, failure rates, dropout rates and final analysis time as before. + +We see in the following table summarizing efficacy bounds and power that there is little impact on the total power by having futility analyses as specified. +While the cumulative $\alpha$-spending is 0.001 and 0.002 at the efficacy interim analyses, we see that the nominal p-value bound at the second interim is 0.0015, more then the 0.001 incremental $\alpha$-spend. +We also note that with these nominal p-values for testing, the approximate hazard ratio required to cross the bounds would presumably help justify consideration of completing the trial based on a definitive interim efficacy finding. +Also, with the small interim spend, the final nominal p-value is not reduced much from the overall $\alpha=0.025$ Type I error set for the group sequential design. + +We also examine the futility bound. +The nominal p-value of 0.05 at each analysis is the one-sided p-value in favor of control over experimental treatment. +We can see that the probability of stopping early under the alternate hypothesis ($\beta$-spending) is not substantial even given the early delayed effect. +Also, the substantial approximate observed hazard ratios to cross a futility bound seem reasonable given the timing and number of events observed; the exception to this is the small number of events at the first interim, but a larger number could be observed by this time if there were early excess risk. +It may be useful to plan additional analyses if a futility bound is crossed to support stopping or not. +For example, looking in subgroups or evaluating smoothed hazard rates over time for each treatment group may be useful. +A clinical trial study team should have a complete discussion of futility bound considerations at the time of design. + + +```{r} +# Cumulative spending at IA3 and IA4 will be 0.001 and 0.002, respectively. +# Power spending function sfPower with param = 1 is linear in timing +# which makes setting the above cumulative spending targets simple by +# setting timing variable the the cumulative proportion of spending at each analysis. +# There will be no efficacy testing at IA1 or IA2. +# Thus, incremental spend, which will be unused, is set very small for these analyses. +upar_FHO <- list( + total_spend = 0.025, + sf = sfPower, + param = 1, + timing = c((1:2)/250, (1:2)/25, 1)) + +FHO <- gs_power_ahr( + enrollRates = xx$enrollRates, + failRates = xx$failRates, + events = NULL, + analysisTimes = seq(6, 30, 6), + upper = gs_spending_bound, + upar = upar_FHO, + # No efficacy testing at IA1 or IA2 + # Thus, the small alpha the spending function would have + # allocated will not be used + test_upper = c(FALSE, FALSE, TRUE, TRUE, TRUE), + lower = gs_b, + lpar = c(rep(qnorm(.05), 4), -Inf)) + +FHO %>% + summary() %>% + as_gt() +``` + +## Scenario with Less Treatment Effect + +As before, we compute power under the assumption of changing the median control group time-to-event to 10 months rather than the assumed 12 and the delay in effect onset is 6 months rather than 4. +We otherwise do not change enrollment, dropout or hazard ratio assumptions. +In both of the following examples, we require both the targeted number of events and targeted trial duration from the group sequential design before doing the interim and final analyses. +The first example, which uses interim spending based on the event count observed over the originally planned final event count has the information fraction 323 / 355 = 0.91. +This gives event-based spending of 0.0191, substantially above the targeted information fraction of 284 / 355 = 0.8 with targeted interim spending of 0.0122. +This reduces the power overall from 76% to 73% and lowers the nominal p-value bound at the final analysis from 0.0218 to 0.0165; see the following two tables. +Noting that the average hazard ratio is 0.8 at the interim and 0.76 at the final analysis emphasizes the value of preserving $\alpha$-spending until the final analysis. +Thus, in this example it is valuable to limit spending at the interim analysis to the minimum of planned spending as opposed to using event-based spending. + +```{r} +# Alternate control median +am <- 10 + +# Update the failure rate +failRates$failRate <- log(2) / am +failRates$duration[1] <- 6 + +# Set planned maximum information from planned design +max_info0 <- max(xx$analysis$info) +upar_actual_IF <- upar_design_IF +upar_actual_IF$max_info <- max_info0 + +# compute power if actual information fraction relative to original +# planned total is used +yy <- gs_power_ahr( + enrollRates = xx$enrollRates, + failRates = failRates, + # Planned time will drive timing since information accrues faster + events = 1:2, + analysisTimes = xx$analysis$Time, + upper = gs_spending_bound, + upar = upar_actual_IF, + lower = gs_b, + lpar = lpar + ) + +yy %>% + summary() %>% + filter(Bound == "Efficacy") %>% + gt() %>% + fmt_number(columns = 3:6, decimals = 4) +``` + +Just as important, the general design principle of making interim analysis criteria more stringent that final is ensured for this alternate scenario. +There are multiple trials where delayed effects have been observed where this difference in the final nominal p-value bound would have made a difference to ensure a statistically significant finding. + +```{r} +yz <- gs_power_ahr( + enrollRates = xx$enrollRates, + failRates = failRates, + events = xx$analysis$Events, + analysisTimes = xx$analysis$Time, + upper = gs_spending_bound, + upar = upar_planned_IF, + lpar = lpar) + +yz %>% + summary() %>% + gt() %>% + fmt_number(columns = 3:6, decimals = 4) +``` + +## Scenario with Longer Control Median + +Now we return to the example where the control median is longer than expected to confirm that spending according to the planned level alone without considering the actual number of events will also result in a power reduction. +While the power gain is not great (94.2% vs 95.0%) the interim and final p-value bounds are more aligned with the intent of emphasizing the final analysis where a smaller average hazard ratio is expected (0.680 vs 0.723 at the interim). +First, we show the result using planned spending. + +```{r} +# Alternate control median +am <- 16 + +# Update the failure rate +failRates$failRate <- log(2) / am +# Return to 4 month delay with HR=1 before HR = 0.6 +failRates$duration[1] <- 4 + +# Start with spending based on planned information +# which is greater than actual information +yy <- gs_power_ahr( + enrollRates = xx$enrollRates, + failRates = failRates, + events = c(1, max(xx$analysis$Events)), + analysisTimes = xx$analysis$Time, + upper = gs_spending_bound, + upar = upar_planned_IF, + lower = gs_b, + lpar = lpar) + +yy %>% + summary() %>% + gt() %>% + fmt_number(columns = 3:6, decimals = 4) +``` + +Since the number of events was less than expected, if we had used the actual number of events the interim bound would be more stringent than above and we obtain slightly greater power. + +```{r} +yz <- gs_power_ahr( + enrollRates = xx$enrollRates, + failRates = failRates, + events = c(1, max(xx$analysis$Events)), + analysisTimes = xx$analysis$Time, + upper = gs_spending_bound, + upar = upar_actual_IF, + lower = gs_b, + lpar = lpar) + +yz %>% + summary() %>% + gt() %>% + fmt_number(columns = 3:6, decimals = 4) +``` + +## Summary for Spending Time Motivation Assuming Delayed Benefit + +In summary, using the minimum of planned and actual spending to adapt the design based on event-based spending adapts the interim bound to be more stringent than the final bound under different scenarios and ensures better power than event-based interim analysis and spending. + + +# Testing Multiple hypotheses + +## Assumptions + +We consider a simple case where we use the method of @MaurerBretz2013 to test both in the overall population and in a biomarker subgroup for the same endpoint. +We assume an exponential failure rate with a median of 12 for the control group regardless of population. +The hazard ratio in the biomarker positive subgroup will be assumed to be 0.6, and in the negative population 0.8. +We assume the biomarker positive group represents half of the population, meaning that enrollment rates will be assumed to be the same in negative and positive patients. +The only difference between failure rates in the two strata is the hazard ratio. +For this case, we assume proportional hazards within negative (HR = 0.8) and positive (HR = 0.6) patients. + +```{r} +# we assume an exponential failure rate with a median of 12 +# for the control group regardless of population. +m <- 12 + +# the enrollment rate of both subgroup and population is the same +enrollRates <- tibble( + Stratum = c("Positive", "Negative"), + duration = 12, + rate = 20) + +# the hazard ratio in the biomarker positive subgroup will be assumed to be 0.6, +# and in the negative population 0.8. +failRates <- tibble( + Stratum = c("Positive", "Negative"), + hr = c(0.6, 0.8), + duration = 100, + failRate = log(2) / m, + dropoutRate = 0.001) +``` + +For illustrative purposes, we are choosing a strategy based on the possible feeling of much less certainty at study start as to whether there is any underlying benefit in the biomarker negative population. +We wish to ensure power for the biomarker positive group, but allow a good chance of a positive overall population finding if there is a lesser benefit in the biomarker negative population. +If an alternative trial strategy is planned, an alternate approach to the following should be considered. +In any case, we design first for the biomarker positive population with one-sided Type I error controlled at $\alpha = 0.0125$: + +## Planned Design for Biomarker Positive Population + +```{r} +# Since execution will be event-based for biomarker population, +# there will be no need to change spending plan for different scenarios. + +# upper bound: spending based on information fraction +upar_design_spend <- list( + sf = gsDesign::sfLDOF, # spending function + total_spend = 0.0125, # total alpha spend is now 0.0125 + timing = NULL, # to select maximum planned information for information fraction + param = NULL + ) + +# lower bound: no futility bound +lpar <- rep(-Inf, 2) # Z = -infinity for lower bound + +# we will base the combined hypothesis design to ensure power in the biomarker subgroup +positive <- gs_design_ahr( + # enroll/failure rates + enrollRates = enrollRates %>% filter(Stratum == "Positive"), + failRates = failRates %>% filter(Stratum == "Positive"), + # Following drives information fraction for interim + IF = c(.8, 1), + # Total study duration driven by final analysisTimes value, i.e., 30 + # Enter small increasing values before that + # so information fraction in planned_IF drives timing of interims + analysisTimes = c(1, 30), + # upper bound + upper = gs_spending_bound, + upar = upar_design_spend, + # lower lower + lower = gs_b, + lpar = lpar) + +positive %>% + summary() %>% + gt() %>% + fmt_number(columns = 3:6, decimals = 4) +``` + +## Planned Design for Overall Population + +We adjust the overall study enrollment rate to match the design requirement for the biomarker positive population. + +```{r} +# Get enrollment rate inflation factor compared to originally input rate +inflation_factor <- positive$enrollRates$rate[1] / enrollRates$rate[1] + +# Using this inflation factor, set planned enrollment rates +planned_enrollRates <- enrollRates %>% mutate(rate = rate * inflation_factor) +planned_enrollRates %>% gt() + +# Store overall enrollment rates for future use +overall_enrollRates <- planned_enrollRates %>% + summarize( + Stratum = "All", + duration = first(duration), + rate = sum(rate)) + +overall_enrollRates %>% gt() +``` + +Now we can examine the power for the overall population based on hazard ratio assumptions in biomarker negative and biomarker positive subgroups and the just calculated enrollment assumption. +We use the analysis times from the biomarker positive population design. +We see that the interim information fraction for the overall population is slightly greater than the biomarker positive population above. +To compensate for this and to enable flexibility below as biomarker positive prevalence changes, we use the same spending time as the biomarker positive subgroup regardless of the true fraction of final planned events at each analysis. +Thus, the interim nominal p-value bound is the same for both the biomarker positive and overall populations. +While this does not make much difference here, we see that we have a very natural way to adapt the design if the observed biomarker positive prevalence is different than what was assumed for the design. + + +```{r} +# Set total spend for overall population, O'Brien-Fleming spending function, and +# same spending time as biomarker subgroup +upar_overall_planned_IF <- list( + sf = gsDesign::sfLDOF, # O'Brien-Fleming spending function + param = NULL, + total_spend = 0.0125, # alpha + timing = c(.8, 1), # same spending time as biomarker subgroup + max_info = NULL # we will use actual final information as planned initially + ) + +overall_planned_bounds <- gs_power_ahr( + # enroll/failure rates + enrollRates = planned_enrollRates, + failRates = failRates, + # analysis time: the planed analysis time for biomarker positive population + analysisTimes = positive$analysis$Time, + # events will be determined by expected events at planned analysis times + events = NULL, + # upper bound: planned spending times are specified the same as before + upper = gs_spending_bound, + upar = upar_overall_planned_IF, + # lower bound: no futility + lower = gs_b, + lpar = lpar) + +overall_planned_bounds %>% + summary() %>% + gt() %>% + fmt_number(columns = 3:6, decimals = 4) +``` + + +## Alternate Scenarios Overview + +We divide our further evaluations into three subsections: + +1. one with a higher prevalence of biomarker positive patients than expected; +1. one with a lower biomarker prevalence; +1. differing event rate and hazard ratio assumptions. + +For each case, we will assume the total enrollment rate of `r round(sum(planned_enrollRates$rate), 1)` per month as planned above. +We also assume that we enroll until the targeted biomarker positive subgroup enrollment of +`r ceiling(sum(positive$enrollRates$rate * positive$enrollRates$duration))` from above is achieved, regardless of the overall enrollment. + +The specify interim analysis timing to require both 80\% of the planned final analysis events in the biomarker positive population and at least 10 months of minimum follow-up; thus, for the biomarker population we will never vary events or spending here. +The same spending time will be used for the overall population, but we will compare with event-based spending. +The above choices are arbitrary. +While we think they are reasonable, the design planner should think carefully about other variations to suit their clinical trial team needs. + +```{r} +## Setting spending alternatives + +# Using information (event)-based spending time relative to overall population plan +# Set total spend for overall population, O'Brien-Fleming spending function. +# For design information-spending, we set timing = NULL and max_info to plan from above +upar_overall_planned_IF <- list( + sf = gsDesign::sfLDOF, # O'Brien-Fleming spending function + total_spend = 0.0125, # alpha + max_info = max(overall_planned_bounds$info0), # we will use planned final information for + # overall population from design to + # compute information fraction relative to plan + param = NULL, + timing = planned_IF) + +# Using planned information fraction will demonstrate problems below. +# Set total spend for overall population, O'Brien-Fleming spending function, and +# same spending time as biomarker subgroup +upar_overall_actual_IF <- list( + sf = gsDesign::sfLDOF, # O'Brien-Fleming spending function + total_spend = 0.0125, # alpha + max_info = max(overall_planned_bounds$info0), # we will use planned final information + # for overall population from design + param = NULL, + timing = NULL) +``` + +### Biomarker Subgroup Prevalence Higher than Planned + +#### Biomarker Subgroup Power + +We suppose the biomarker prevalence is 60\%, higher then the 50\% prevalence the design anticipated. +The enrollment rates by positive versus negative patients and expected enrollment duration are now: + +```{r} +# update the enrollment rate due to 60% prevalence +positive_60_enrollRates <- rbind( + overall_enrollRates %>% mutate(Stratum = "Positive", rate = 0.6 * rate), + overall_enrollRates %>% mutate(Stratum = "Negative", rate = 0.4 * rate) +) + +# update the enrollment duration +positive_60_enrollRates$duration <- max(positive$analysis$N) / + overall_enrollRates$rate / + 0.6 + +# display the updated enrollment rate table +positive_60_enrollRates %>% + gt() %>% + fmt_number(columns = "rate", decimals = 1) +``` + +Now we can compute the power for the biomarker positive group with the targeted events. +Since we have a simple proportional hazards model, they only thing that is changing here from the original design is that this takes slightly less time. + +```{r} +positive_60_power <- gs_power_ahr( + # enrollment/failure rate + enrollRates = positive_60_enrollRates %>% filter(Stratum == "Positive"), + failRates = failRates %>% filter(Stratum == "Positive"), + # number of events + events = positive$analysis$Events, # positive$bounds$Events[1:K], + # analysis time will be calcuated to achieve the targeted events + analysisTimes = NULL, + # upper bound + upper = gs_spending_bound, + upar = upar_design_spend, + # lower bound + lower = gs_b, + lpar = lpar) + +positive_60_power %>% + summary() %>% + gt() %>% + fmt_number(columns = 3:6, decimals = 4) +``` + +#### Overall Population Power + +Now we use the same spending as above for the overall population, resulting in full $\alpha$-spending at the end of the trial even though the originally targeted events are not expected to be achieved. +We note that the information fraction computed here is based on the originally planned events for the overall population. +Given this and the larger proportion of patients that are biomarker positive, the average hazard ratio is stronger than originally planned and the power for the overall population is still over 90\%. + +```{r} +gs_power_ahr( + # set the enrollment/failure rate + enrollRates = positive_60_enrollRates, + failRates = failRates, + # set evnets and analysis time + events = NULL, + analysisTimes = positive_60_power$analysis$Time, + # set upper bound: use planned spending in spite of lower overall information + upper = gs_spending_bound, + upar = upar_overall_planned_IF, + # set lower bound: no futility + lower = gs_b, + lpar = rep(-Inf, 2) + ) %>% + summary() %>% + gt() %>% + fmt_number(columns = 3:6, decimals = 4) +``` + +If we had used information-based (i.e., event-based) spending, we would not have reached full spending at final analysis and thus would have lower power. + +```{r} +gs_power_ahr( + # set the enrollment/failure rate + enrollRates = positive_60_enrollRates, + failRates = failRates, + # set evnets and analysis time + events = NULL, + analysisTimes = positive_60_power$analysis$Time, + # upper bound: use actual spending which uses less than complete alpha + upper = gs_spending_bound, + upar = upar_overall_actual_IF, + # lower bound: no futility + lower = gs_b, + lpar = lpar + ) %>% + summary() %>% + gt() %>% + fmt_number(columns = 3:6, decimals = 4) +``` + +### Biomarker Subgroup Prevalence Lower Than Planned + +We suppose the biomarker prevalence is 40%, lower than the 50\% prevalence the design anticipated. +The enrollment rates by positive versus negative patients and expected enrollment duration will now be: + +```{r} +# set the enrollment rate under 40% prevalence +positive_40_enrollRates <- rbind( + overall_enrollRates %>% mutate(Stratum = "Positive", rate = 0.4 * rate), + overall_enrollRates %>% mutate(Stratum = "Negative", rate = 0.6 * rate) +) + +# update the duration of enrollment table +positive_40_enrollRates$duration <- max(positive$analysis$N) / + positive_40_enrollRates$rate[1] + +# display the enrollment table +positive_40_enrollRates %>% + gt() %>% + fmt_number(columns = "rate", decimals = 1) +``` + +#### Biomarker Positive Subgroup Power + +Now we can compute the power for the biomarker positive group with the targeted events. + +```{r} +upar_actual_IF$total_spend <- 0.0125 +upar_actual_IF$max_info <- max(positive$analysis$info) + +positive_40_power <- gs_power_ahr( + # set enrollment/failure rate + enrollRates = positive_40_enrollRates %>% filter(Stratum == "Positive"), + failRates = failRates %>% filter(Stratum == "Positive"), + # set events/analysis time + events = positive$analysis$Events, + analysisTimes = NULL, + # set upper bound + upper = gs_spending_bound, + upar = upar_actual_IF, + # set lower bound + lower = gs_b, + lpar = rep(-Inf, 2)) + +positive_40_power %>% + summary() %>% + gt() %>% + fmt_number(columns = 3:6, decimals = 4) +``` + +#### Overall Population Power + +We see that by adapting the overall sample size and spending according to the biomarker subgroup, we retain 90\% power. +In spite of the lower overall effect size, the larger adapted sample size ensures power retention. + +```{r} +gs_power_ahr( + enrollRates = positive_40_enrollRates, + failRates = failRates, + events = 1:2, + analysisTimes = positive_40_power$analysis$Time, + upper = gs_spending_bound, + upar = upar_overall_planned_IF, + lower = gs_b, + lpar = rep(-Inf,2)) %>% + summary() %>% + gt() %>% + fmt_number(columns = 3:6, decimals = 4) +``` + +## Summary of Findings + +We suggested two overall findings when planning and executing a trial with a potentially delayed treatment effect: + +- Require both a targeted event count minimum follow-up before completing analysis of a trial helps ensure both powering the trial appropriately and having a better description of the tail behavior that may be essential if long-term results are key to establishing a potentially positive risk-benefit. +- Do not over-spend Type I error at interim analyses by using event-based spending. +This helps to ensure the least stringent bounds are at the final analysis when the most complete risk-benefit assessment can be made. +We gave two options to this: + - Use a fixed, small incremental $\alpha$-spend at each interim such as proposed by @FHO with a variable number of interim analyses to ensure adequate follow-up. + - Use the minimum of planned and actual spending at interim analyses. + +When implementing the @FHO approach, we also suggested a simple approach to futility that may be quite useful practically in a scenario with a potentially delayed onset of treatment effect. +This basically looks for evidence of a favorable control group effect relative to experimental by setting a nominal p-value cutoff at a 1-sided 0.05 level for early interim futility analyses. +Where crossing survival curves or inferior survival curves may exist, this may be a useful way to ensure continuing a trial is ethical; this approach is perhaps most useful when the experimental treatment is replacing components of the control treatment or in a case where add-on treatment may be toxic or potentially have other detrimental effects. + +In addition to the delayed effect example, we considered an example testing in both a biomarker positive subgroup and the overall population. +Using a common spending time for all hypotheses with a common interim analysis strategy as advocated by @FPG can be helpful to implement spending so that all hypotheses have adequate $\alpha$ to spend at the final analysis and also to ensure full utilization of $\alpha$-spending. We suggested again using the minimum of planned and actual spending at interim analysis. Spending can be based on a key hypothesis (e.g., the biomarker positive population) or the minimum spending time among all hypotheses being tested. +Taking advantage of know correlations to ensure full $\alpha$ utilitization in multiple hypothesis testing is also more simply implemented with this strategy @AGZS2021unified. + +In summary, we have illustrated both the motivation and the illustration of the spending time approach through examples we have commonly encountered. Approaches suggested included an implementation of @FHO with a fixed incremental $\alpha$-spend at each interim analysis as well as the use of the minimum of planned and actual spending at interim analyses. + +## References diff --git a/vignettes/story_summarize_designs.Rmd b/vignettes/story_summarize_designs.Rmd new file mode 100644 index 000000000..aa6648b05 --- /dev/null +++ b/vignettes/story_summarize_designs.Rmd @@ -0,0 +1,379 @@ +--- +title: "Summarize Group Sequential Designs in Nice gt Tables" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + number_sections: true + highlight: "textmate" + css: "custom.css" +bibliography: ggsd.bib +vignette: | + %\VignetteIndexEntry{Summarize Group Sequential Designs in Nice gt Tables} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown} +--- + +```{r setup, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +```{r, message=FALSE, warning=FALSE} +library(dplyr) +library(tibble) +library(gt) +devtools::load_all() +``` + +# Overview + +This vignette introduces publication quality table production for group sequential designs in the **gsDesign2** package. +It also demonstrates designs for an example scenario using multiple design approaches. +We divide the document into 3 parts: + +- Design specification and derivation +- Printing design summary tables +- Details of output from design functions +- Details on table output options + +The reader can decide which of these sections is of interest to them. + +The function used to generate bounds tables is `gsDesign2::summary()`. +Users can use `gsDesign2::as_gt()` to format the above table using the **gt** package. + +In this vignette, we introduce a general approach to bound summaries by examples using different design approaches for a time-to-event outcome: + +- the average hazard ratio (AHR) method extended from @MukhopadhyayAHR using `gsDesign2::gs_design_ahr()`; +- the weighted logrank (WLR) method of @YungLiu using `gsDesign2::gs_design_wlr()`; + +# Design Specification and Derivation + +## Design Parameters + +The design parameters we use across the different designs derived are: + +```{r} +# enrollment/failure rates +enrollRates <- tibble::tibble( + Stratum = "All", + duration = 12, + rate = 30) +failRates <- tibble::tibble( + Stratum = "All", + duration = c(4, 100), + failRate = log(2) / 12, + hr = c(1, .6), + dropoutRate = .001) + +# Information fraction +IF <- (1:3)/3 +# Analysis times in months; first 2 will be ignored as IF will not be achieved +analysisTimes <- c(.01, .02, 36) + +# Experimental / Control randomization ratio +ratio <- 1 + +# 1-sided Type I error +alpha <- 0.025 +# Type II error (1 - power) +beta <- 0.1 + +# Upper bound +upper <- gsDesign2::gs_spending_bound # alpha-spending bound +upar <- list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL) + +# Lower bound +lower <- gsDesign2::gs_spending_bound # beta-spending bound +lpar <- list(sf = gsDesign::sfHSD, total_spend = 0.1, param = 0, timing = NULL) + +# Fleming-Harrington (FH) weight functions for weighted logrank (WLR) +wgt00 <- function(x, arm0, arm1){ # Equal weighting for logrank + gsDesign2::wlr_weight_fh(x, arm0, arm1, rho = 0, gamma = 0)} +wgt05 <- function(x, arm0, arm1){ # Early downweighting with FH(0,.5) + gsDesign2::wlr_weight_fh(x, arm0, arm1, rho = 0, gamma = .5)} + +# Both of above tests for MaxCombo: logrank and FH(0,.5) +fh_test <- rbind( + # Include logrank for all 3 analyses + data.frame(rho = 0, gamma = 0, tau = -1, test = 1, Analysis = 1:3, analysisTimes = c(12, 24, 36)), + # Only include FH(0,.5) for analyses 2 and 3 + data.frame(rho = c(0, 0.5), gamma = 0.5, tau = -1, test = 2:3, Analysis = 3, analysisTimes = 36)) +``` + +## Deriving Designs + +### AHR design derivation + +Using the design parameters above, the AHR design is derived as follows: + +By using the design parameters above, one can generate an AHR model by `gs_design_ahr` as + +```{r, message=FALSE} +x_design_ahr <- gs_design_ahr( + enrollRates = enrollRates, + failRates = failRates, + IF = IF, + analysisTimes = analysisTimes, + ratio = ratio, + alpha = alpha, + beta = beta, + upper = upper, + upar = upar, + lower = lower, + lpar = lpar +) + +x_power_ahr <- gs_power_ahr( + enrollRates = x_design_ahr$enrollRates, + failRates = x_design_ahr$failRates, + events = c(100, 200, 300), + analysisTimes = NULL, + upper = upper, + upar = upar, + lower = lower, + lpar = lpar +) +``` + + +### WLR design derivation + +```{r, message=FALSE} +x_design_wlr <- gs_design_wlr( + enrollRates = enrollRates, + failRates = failRates, + weight = wgt05, + IF = NULL, + analysisTimes = sort(unique(x_design_ahr$analysis$Time)), + ratio = ratio, + alpha = alpha, + beta = beta, + upper = upper, + upar = upar, + lower = lower, + lpar = lpar +) + +x_power_wlr <- gs_power_wlr( + enrollRates = x_design_wlr$enrollRates, + failRates = x_design_wlr$failRates, + weight = wgt05, + events = c(50, 100, 150), + analysisTimes = NULL, + upper = upper, + upar = upar, + lower = lower, + lpar = lpar +) +``` + +# Default Summary Table Production + +Instead of outputting 4 detailed tables (a table of enrollment rates, a table of failure rates, a table of analysis summary, a table of bounds summary), users can get a com pensive summary table by calling `summary(x)`, where `x` is the object returned either by `gs_design_ahr` or `gs_design_wlr`. +The `summary()` function produces an overall summary table for bounds for publication in a protocol. + +For example, the default output of `summary()` for the AHR method is +```{r} +x_design_ahr %>% + summary() %>% + gt::gt() %>% + gt::fmt_number(columns = c(3:6), decimals = 4) +``` + +Please note the `summary()` can also be applied to objected returned by `gs_power_ahr()`. +For example, +```{r} +x_power_ahr %>% + summary() %>% + gt::gt() %>% + gt::fmt_number(columns = c(3:6), decimals = 4) +``` + + +And the default output of `summary()` for the WLR method is + +```{r} +x_design_wlr %>% + summary() %>% + gt::gt() %>% + gt::fmt_number(columns = c(3:6), decimals = 4) +``` + +Note that `summary()` can also be applied to summarize an object returned by `gs_power_wlr()`. +```{r} +x_power_wlr %>% + summary() %>% + gt::gt() %>% + gt::fmt_number(columns = c(3:6), decimals = 4) +``` + + +# Detailed Summary Table Formatting + +Here we demonstrate options for formatting analysis rows, bound rows as well as other table parameters such as titles, labels and footnotes. + +## Custom the Variables to be Summaried for Each Analysis + +In the above default table summary table generated by `summary(x)`, the variables used to summarize each analysis includes `Analysis`, `Time`, `N`(sample size), `Events`, `AHR`, and `IF` (information fraction). +But users can customize these variables chosen using `analysis_vars = ...` and the corresponding decimals displayed using the argument `analysis_decimals = ...`. +For example +```{r} +summary( + x_design_ahr, + analysis_vars = c("N", "Events"), + analysis_decimals = c(1, 1) + ) %>% + gt::gt() %>% + gt::fmt_number(columns = c(3:6), decimals = 4) +``` + +Please note that there is no need to input `"Analysis"` into `analysis_vars = ...` as it will always appear. + +## Custom the Bound Names + +Users can also customize the bound names. +In the default output generated by `summary(x)`, the bound name is `c("Efficacy", "Futility")`, which can be changed into `c("A is better", "B is better")` for a 2-sided design by using the argument `bound_names = ...`. +For example, + +```{r} +summary( + x_design_ahr, + bound_names = c("A is better", "B is better") + ) %>% + mutate_if(is.numeric, round, digits = 4) %>% + gt::gt() %>% + gt::fmt_number(columns = c(3:6), decimals = 4) +``` + +## Custom into a gt Table and Add Title/SubTitle/Footnotes/Spanners + +Users can also use `as_gt()` to get the the above R table into a gt table. +Furthermore, they can edit the title/subtitle/spanner/footnotes of the gt table by using the arguments in `summary`. + +```{r} +summary(x_design_ahr) %>% + as_gt(title = "Summary of the Crossing Probability", + subtitle = "by Using gs_design_ahr", + colname_spanner = "Cumulative boundary crossing probability", + colname_spannersub = c("Alternate hypothesis", "Null hypothesis"), + footnote = list(content = c("approximate hazard ratio to cross bound.", + "gs_design_ahr is a function in gsDesign2.", + "AHR is average hazard ratio; IF is information fraction."), + location = c("~HR at bound", NA, NA), + attr = c("colname", "subtitle", "analysis"))) +``` + +The above objective can also be realized by using functions in the R package `gt` for custom design of table layout. +We note that `as_gt()` always produces a `gt` object and, thus, can be further customized with **gt** package formatting functions. +In the future, we to support rich text format using a function `as_rtf()` in a fashion similar to `as_gt()`. + +## Custom the Variables to Display + +Users can select the variables to be displayed in the summary table by using the argument `display_colunm = ...`. +```{r} +summary(x_design_ahr) %>% + as_gt(display_columns = c("Analysis", "Bound", "Z", "Probability")) +``` + +## Custom Whether to Show Infinity Bound or Not + +Users have options to either show the infinity bounds or not by taking advantage of `display_inf_bound = ...`. +```{r} +summary(x_design_ahr) %>% + as_gt(display_inf_bound = FALSE) +``` + + + +# Details of Output from Design/Power Functions + +There are four components in the objects returned by either `gs_design_ahr()`/`gs_design_wlr()` or `gs_power_ahr()`/`gs_power_wlr()`: +1. failure rates: a table summarizing failure rate and dropout rate. +1. enrollment rates: a table summarizing the enrollment rate. +1. bounds: a table summarize the bound of each analysis. +1. analysis: a table summarize the each analysis, with each one row for one analysis one hypothsis. + +## Failure Rates + +The failure rates of different gsDesign object can be obtained by using `x$failRates`, where `x` is the object returned either by `gs_design_ahr` or `gs_design_wlr`. +For example, the failure rates of the AHR design derivation can be returned by calling +```{r} +x_design_ahr$failRates %>% + gt::gt() %>% + gt::fmt_number(columns = 3:5, decimals = 4) +``` + +Please note that both `x_design_ahr` and `x_wlr` returns the same failure rates, which is the same as that inputted as `failRates`. +To verify, let's take a look at the failure rate of the WLR design derivation, which are shown as below. + +```{r} +x_design_wlr$failRates %>% + gt::gt() %>% + gt::fmt_number(columns = 3:5, decimals = 4) +``` + + +## Enrollment + +The enrollment rate of a gs design derivation can be collected by using `x$failRates`, where `x` is the object returned either by `gs_design_ahr` or `gs_design_wlr`. +For example, the enrollment rates of the AHR/WLR design derivation is + +```{r} +x_design_ahr$enrollRates %>% + gt::gt() %>% + gt::fmt_number(columns = 3, decimals = 4) +``` + +```{r} +x_design_wlr$enrollRates %>% + gt::gt() %>% + gt::fmt_number(columns = 3, decimals = 4) +``` + +It can be seen that, although the design derivation is different, the enrollment rate table share the same table structure, same enrollment period durations for each rate. +Yet, the enrollment rates differ between designs only by a multiplicative constant. + +## Analysis + +The analysis summary table has the structure of one row per analysis per hypothesis. +And columns can vary with different defaults for each design option. +This type of tables are useful for understanding commonalities in how designs are summarized for different models. +To get analysis summary table, users can call `x$analysis`, where `x` is the object returned either by `gs_design_ahr` or `gs_design_wlr`. +For example, the analysis summary of the AHR/WLR design derivation is +```{r} +x_design_ahr$analysis %>% + gt::gt() %>% + gt::fmt_number(columns = 2:8, decimals = 4) +``` + +```{r} +x_design_wlr$analysis %>% + gt::gt() %>% + gt::fmt_number(columns = 2:8, decimals = 4) +``` + + +## Bounds + +The analysis summary table has the structure of One row per analysis per bound per hypothesis. Columns can vary with different defaults for each design option. +To get a bouns summary table, users can call `x$analysis`, where `x` is the object returned either by `gs_design_ahr` or `gs_design_wlr`. +For example, the bounds summary of the AHR/WLR design derivation is + +```{r} +x_design_ahr$bounds %>% + gt::gt() %>% + gt::fmt_number(columns = c(3, 5:7), decimals = 4) +``` + +```{r} +x_design_wlr$bounds %>% + gt::gt() %>% + gt::fmt_number(columns = c(3, 5:7), decimals = 4) +``` + + +# References diff --git a/vignettes/testing_AHR.Rmd b/vignettes/testing_AHR.Rmd deleted file mode 100644 index 3daeff1c0..000000000 --- a/vignettes/testing_AHR.Rmd +++ /dev/null @@ -1,261 +0,0 @@ ---- -title: Simulation for testing average hazard ratio and sample size under non-proportional hazards -output: rmarkdown::html_vignette -bibliography: gsDesign.bib -vignette: > - %\VignetteIndexEntry{Simulation for testing average hazard ratio and sample size under non-proportional hazards} - %\VignetteEngine{knitr::rmarkdown} ---- - -```{r setup, include = FALSE} -knitr::opts_chunk$set( - eval = FALSE, - collapse = TRUE, - comment = "#>", - dev = "png" -) - -options(width = 58) -``` - -```{r, message=FALSE, warning=FALSE} -library(gsDesign2) -library(gsDesign) -library(ggplot2) -library(dplyr) -library(tibble) -library(simtrial) -library(survival) -library(knitr) -``` - -## Introduction - -This document demonstrates a simple simulation for unit testing of average hazard ratio -function (`AHR()`). The details on calculating average hazard ratio is already available in -`vignette("AHRVignette")`, and the purpose of this vignette is to show how a simulation can be conducted -in order to approximate the average hazard ratio. The results were used for unit test to see -whether the simulation results could be good approximation of the actual results from `AHR()`. - -The simulation is wrapped into a function which gives the users the flexibility the design -assumptions. The simulations are based on targeted event only, but for other scenarios, -similar approach can be taken. - -### Intial setup - -We begin by setting two parameters that will be used throughout in simulations used to verify accuracy of power approximations; either could be customized for each simulation. -First, we set the number of simulations to be performed. -You can increase this to improve accuracy of simulation estimates of power. - -```{r nsim,warning=FALSE,message=FALSE} -nsim <- 2000 -block <- rep(c("Experimental", "Control"), 2) -strata <- tibble::tibble(Stratum = "All", p = 1) -``` - -### Design scenario - -We set up the design parameters. -Enrollment ramps up over the course of the first 4 months follow-up by a steady state enrollment thereafter. -This will be adjusted proportionately to power the trial later. -The control group has a piecewise exponential distribution with median 9 for the first 3 months and 18 thereafter. -The hazard ratio of the experimental group versus control is 0.9 for the first 3 months followed by 0.6 thereafter. - -```{r} -enrollRates <- tibble::tibble( - Stratum = "All", - duration = c(2, 2, 10), - rate = c(3, 6, 9) -) -failRates <- tibble::tibble( - Stratum = "All", - duration = c(3, 100), - failRate = log(2) / c(9, 18), - hr = c(.9, .6), - dropoutRate = rep(.001, 2) -) -``` - -The Fleming-Harrington weights can be defined in case the users want to run any weighted -logrank tests, and is defined as `rg` as follows. - -```{r} -rg <- tibble(rho = 0, gamma = 0) -``` - -For this simulation, we consider the sample size and the events are given as `N` and `events` and -the bounds for the interim analysis are provided as `bounds`. - -```{r} -N <- enrollRates %>% summarise(N = sum(rate * duration)) -events <- c(20.4, 48.9, 66.1) -bounds <- tibble::tibble( - k = 1:3, - upper = c(2.962588, 2.359018, 2.014084), - lower = c(qnorm(.05), qnorm(.1), -Inf) -) -``` - -The simulation for the average hazard ratio for $k = 3$ interim analysis can be then -conducted as follows: - -```{r, eval=FALSE} -K <- length(events) -fr <- simtrial::simfix2simPWSurv(failRates = failRates) -simresult <- NULL -for (i in 1:nsim) { - sim <- simtrial::simPWSurv( - n = as.numeric(N), - enrollRates = enrollRates, - failRates = fr$failRates, - dropoutRates = fr$dropoutRates, - strata = strata, - block = block - ) - for (e in 1:K) { - dt <- simtrial::getCutDateForCount(x = sim, count = events[e]) - ds <- sim %>% simtrial::cutData(dt) - res.cox <- coxph(Surv(time = tte, event = event) ~ Treatment + strata(Stratum), data = ds) - Cox.coef <- res.cox$coefficients - Z <- sim %>% - cutDataAtCount(events[e]) %>% # cut simulation for analysis at targeted events - tensurv(txval = "Experimental") %>% - tenFH(rg = rg) - simresult <- rbind( - simresult, - tibble( - sim = i, - k = e, - Events = events[e], - Z = -Z$Z, # Change sign for Z - Time = dt, - Cox.coef = Cox.coef - ) - ) - } -} - -simresult <- tibble(simresult, N) %>% mutate(N = as.integer(N)) -simresult -``` - -After combining the simulation results they can be summarized with respect to the -analysis time as - -```{r, eval=FALSE} -simresult %>% - full_join(bounds, by = "k") %>% - tidyr::gather(c("upper", "lower"), key = "Bounds", value = "value") %>% - group_by(k, Bounds) %>% - summarize( - n = n(), - Time = mean(Time), - AHR = exp(mean(Cox.coef)), - z = unique(value), - Events = unique(Events) - ) %>% - mutate_if(is.numeric, round, digits = 4) %>% - arrange(desc(Bounds)) %>% - select(k, Bounds, Time, Events, AHR, z) -``` - -## Putting them all into a function - -Finally, the whole simulation approach is wrapped into a function `sim_gsd` where the -users can modify the design assumptions based on their desired design. - -```{r} -sim_gsd <- function(nsim = 1000, - block = rep(c("Experimental", "Control"), 2), - strata = tibble::tibble(Stratum = "All", p = 1), - enrollRates = tibble::tibble( - Stratum = "All", - duration = c(2, 2, 10), - rate = c(3, 6, 9) - ), - failRates = tibble::tibble( - Stratum = "All", - duration = c(3, 100), - failRate = log(2) / c(9, 18), - hr = c(.9, .6), - dropoutRate = rep(.001, 2) - ), - rg = tibble(rho = 0, gamma = 0), - N = NULL, - # events = c(158.954, 200.636, 252.077), - events = c(20.4, 48.9, 66.1), - bounds = tibble::tibble( - k = 1:3, - upper = c(2.962588, 2.359018, 2.014084), - lower = c(qnorm(.05), qnorm(.1), -Inf) - )) { - N <- ifelse(is.null(N), enrollRates %>% summarise(N = sum(rate * duration)), N) - K <- length(events) - fr <- simtrial::simfix2simPWSurv(failRates = failRates) - simresult <- NULL - for (i in 1:nsim) { - sim <- simtrial::simPWSurv( - n = as.numeric(N), - enrollRates = enrollRates, - failRates = fr$failRates, - dropoutRates = fr$dropoutRates, - strata = strata, - block = block - ) - for (e in 1:K) { - dt <- simtrial::getCutDateForCount(x = sim, count = events[e]) - ds <- sim %>% simtrial::cutData(dt) - res.cox <- coxph(Surv(time = tte, event = event) ~ Treatment + strata(Stratum), data = ds) - Cox.coef <- res.cox$coefficients - Z <- sim %>% - cutDataAtCount(events[e]) %>% # cut simulation for analysis at targeted events - tensurv(txval = "Experimental") %>% - tenFH(rg = rg) - simresult <- rbind( - simresult, - tibble( - sim = i, - k = e, - Events = events[e], - Z = -Z$Z, # Change sign for Z - Time = dt, - Cox.coef = Cox.coef - ) - ) - } - } - - simresult <- tibble(simresult, N) %>% mutate(N = as.integer(N)) - res <- simresult %>% - full_join(bounds, by = "k") %>% - tidyr::gather(c("upper", "lower"), key = "Bounds", value = "value") %>% - group_by(k, Bounds) %>% - summarize( - n = n(), - Time = mean(Time), - AHR = exp(mean(Cox.coef)), - z = unique(value), - Events = unique(Events) - ) %>% - mutate_if(is.numeric, round, digits = 4) %>% - arrange(desc(Bounds)) %>% - select(k, Bounds, Time, Events, AHR, z) - res <- tibble::tibble( - Analysis = res$k, - Bound = res$Bounds, - Z = res$z, - Time = res$Time, - AHR = res$AHR, - Events = res$Events - ) - - res <- tibble(res, N) %>% mutate(N = as.integer(N)) - return(res) -} -``` - -Here is a small simulation of size 10 to show the results of `sim_gsd` - -```{r, eval=FALSE} -sim_gsd(nsim = 100) -``` diff --git a/vignettes/usage_AHR.Rmd b/vignettes/usage_AHR.Rmd new file mode 100644 index 000000000..456e0d4b1 --- /dev/null +++ b/vignettes/usage_AHR.Rmd @@ -0,0 +1,192 @@ +--- +title: "AHR: computes AHR under NPH assumptions and (stratified) populations" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + number_sections: true + highlight: "textmate" + css: "custom.css" +# bibliography: "example.bib" +vignette: > + %\VignetteEngine{knitr::rmarkdown} + %\VignetteIndexEntry{AHR: computes AHR under NPH assumptions and (stratified) populations} +--- + +```{r, message=FALSE} +library(tibble) +library(dplyr) +#library(gsDesign2) +devtools::load_all() +``` + +# Introduction of `AHR()` + +`AHR()` provides a **geometric average hazard ratio** under various non-proportional hazards assumptions for either single or multiple strata studies. +The piecewise exponential distribution allows a simple method to specify a distribution and enrollment pattern where the enrollment, failure and dropout rates changes over time. + +# Usage of `AHR()` + +## Example 1: Un-stratified population +```{r} +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) +AHR(enrollRates = enrollRates, failRates = failRates, totalDuration = c(15, 30)) +``` + + +## Example 2: Stratified population +```{r} +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) +AHR(enrollRates = enrollRates, failRates = failRates, totalDuration = c(15, 30)) +``` + +# Inner Logic of `AHR()` + +Let's take the un-stratified population as an example, where the enrollment rate, failure rates and dropout rates are +```{r} +enrollRates <- tibble(Stratum = "All", + duration = c(2, 10, 4), + rate = c(5, 10, 0)) +failRates <- tibble(Stratum = "All", + duration = 1, + failRate = c(.1, .2), + hr = c(.9, .75), + dropoutRate = .001) + +ratio <- 2 + +totalDuration <- 30 +``` + +**Step 1:** compute proportion in each group +```{r} +Qe <- ratio / (1 + ratio) +Qc <- 1 - Qe +``` + +```{r, echo=FALSE} +cat("The proportion of the experimental arm is ", Qe, "\n") +cat("The proportion of the control arm is ", Qc, "\n") +``` +To compute the expected events over different treatment group, stratum and time period, we iterate over `totalDuration` and `Strata`. +Since in this example, we only have one analysis time (`totalDuration = 30`) and one stratum (`Stratum = "All"`), we only iterate once. +In one has multiple analysis time and strata, one can use a for loop and bind the results by row. + +```{r} +td <- totalDuration +s <- "All" +``` + + + +**Step 2:** subset the enrollment rates and failure rates by stratum. +```{r} +enroll <- enrollRates %>% filter(Stratum == s) +fail <- failRates %>% filter(Stratum == s) +``` + +**Step 3:** we calculate the enrollment rates in experimental arm and control arm, respectively. +```{r} +enroll_c <- enroll %>% mutate(rate = rate * Qc) +enroll_e <- enroll %>% mutate(rate = rate * Qe) +``` + +**Step 4:** we update the failure rate in the control and experimental arm. +```{r} +fail_c <- fail +fail_e <- fail %>% mutate(failRate = failRate * hr) +``` + +**Step 5:** we calculate the expected number of events in the control and experimental by `eEvents_df()`. +```{r} +events_c <- eEvents_df(enrollRates = enroll_c, failRates = fail_c, totalDuration = td, simple = FALSE) +events_e <- eEvents_df(enrollRates = enroll_e, failRates = fail_e, totalDuration = td, simple = FALSE) +``` + +```{r, echo=FALSE} +cat("The expected number of events in the control arm is \n") +events_c + +cat("The expected number of events in the experimental arm is \n") +events_e +``` + + +Here the `t` column is the start of period, the `failRate` column is the failure rate during the period, and the `Events` column is the expected events during the period. + +**Step 6:** we combine the results together and output it. +```{r, message=FALSE} + # combine control and experimental +events <- rbind(events_c %>% mutate(Treatment = "Control"), + events_e %>% mutate(Treatment = "Experimental")) %>% + arrange(t, Treatment) %>% + ungroup() %>% + # recompute HR, events, info by period + group_by(t) %>% + summarize(Stratum = s, + info = (sum(1 / Events))^(-1), + Events = sum(Events), + HR = last(failRate) / first(failRate)) %>% + # compute info0 + mutate(Time = td, + lnhr = log(HR), + info0 = Events * Qc * Qe) %>% + ungroup() %>% + + group_by(Time, Stratum, HR) %>% + summarize(t = min(t), + Events = sum(Events), + info0 = sum(info0), + info = sum(info)) %>% + # pool time period together + group_by(Time) %>% + summarize(AHR = exp(sum(log(HR) * Events) / sum(Events)), + Events = sum(Events), + info = sum(info), + info0 = sum(info0)) +``` + +```{r, echo=FALSE} +cat("The overall expected number of events over the time is \n") +events +``` + +Please note that, in the output, the `info` column is based on the following input. +```{r, eval=FALSE} +enrollRates <- tibble(Stratum = "All", + duration = c(2, 10, 4), + rate = c(5, 10, 0)) +failRates <- tibble(Stratum = "All", + duration = 1, + failRate = c(.1, .2), + hr = c(.9, .75), + dropoutRate = .001) +``` +If the alternative hypothesis $H_1$ is +$$ + \text{hr} + = + \left\{ + \begin{array}{ll} + 0.9 & \text{for the first 1 month} \\ + 0.75 & \text{afterwards}, + \end{array} + \right. +$$ +then `info = info1`, where `info1` is the statistical information under $H_1$. +But notice that the above `enrollRates` and `failRates` is not always the $H_1$, so we call it as `info`, rather than `info1`. \ No newline at end of file diff --git a/vignettes/usage_eAccural.Rmd b/vignettes/usage_eAccural.Rmd new file mode 100644 index 000000000..7eaf0d1e5 --- /dev/null +++ b/vignettes/usage_eAccural.Rmd @@ -0,0 +1,65 @@ +--- +title: "eAccrual: computes the expected cumulative enrollment (accrual) given a set of piecewise constant enrollment rates and times." +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + number_sections: true + highlight: "textmate" + css: "custom.css" +vignette: > + %\VignetteEngine{knitr::rmarkdown} + %\VignetteIndexEntry{eAccrual: computes the expected cumulative enrollment (accrual) given a set of piecewise constant enrollment rates and times.} +--- + +```{r, message=FALSE} +library(tibble) +library(dplyr) +#library(gsDesign2) +devtools::load_all() +``` + +# Introduction of `eAccrual()` + + +# Use cases of `eAccrual()` + +## Example 1 +For the enrollment in the first 3 months, it is exactly $3 \times 5 = 15$. +```{r} +eAccrual(x = 3, + enrollRates = tibble(duration = c(3, 3, 18), rate = c(5, 10, 20))) +``` + +## Example 2 +For the enrollment in the first 6 months, it is exactly $3 \times 5 + 3 \times 10 = 45$. +```{r} +eAccrual(x = 6, + enrollRates = tibble(duration = c(3, 3, 18), rate = c(5, 10, 20))) +``` + +## Example 3 +For the enrollment in the first 24 months, it is exactly $3 \times 5 + 3 \times 10 + 18 * 20 = 405$. +```{r} +eAccrual(x = 24, + enrollRates = tibble(duration = c(3, 3, 18), rate = c(5, 10, 20))) +``` + +## Example 4 +For the enrollment after 24 months, it is the same as that from the 24 months, since the enrollment is stopped. +```{r} +eAccrual(x = 25, + enrollRates = tibble(duration = c(3, 3, 18), rate = c(5, 10, 20))) +``` + +## Example 5 +Instead of compute the enrolled subjects one time point by one time point, we can also compute it once. +```{r} +eAccrual(x = c(3, 6, 24, 25), + enrollRates = tibble(duration = c(3, 3, 18), rate = c(5, 10, 20))) +``` + +# Inner Logic of `eAccrual()` + +TODO \ No newline at end of file diff --git a/vignettes/usage_eEvents_df.Rmd b/vignettes/usage_eEvents_df.Rmd new file mode 100644 index 000000000..960b3a4c4 --- /dev/null +++ b/vignettes/usage_eEvents_df.Rmd @@ -0,0 +1,293 @@ +--- +title: "eEvents_df: compute expected number of events at 1 time point" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + number_sections: true + highlight: "textmate" + css: "custom.css" +vignette: > + %\VignetteEngine{knitr::rmarkdown} + %\VignetteIndexEntry{eEvents_df: compute expected number of events at 1 time point} +--- + + +```{r, essage=FALSE, echo=FALSE} +knitr::opts_chunk$set(fig.width = 5, fig.height = 4, fig.align = 'center') +``` + +```{r, message=FALSE, echo=FALSE} +library(gt) +library(tibble) +library(dplyr) +library(testthat) +#library(gsDesign2) +devtools::load_all() +``` + +# Introduction of `eEvents_df` + +`eEvents_df()` computes expected number of events at a **given analysis time by strata** under the assumption of piecewise model: + +- piecewise constant enrollment rates +- piecewise exponential failure rates +- piecewise censoring rates. + +The above piecewise exponential distribution allows a simple method to specify a distribution and enrollment pattern where the enrollment, failure and dropout rates changes over time. + + +Here the `df` in `eEvents_df()` is short for data frame, since its output is a data frame. + +# Use Cases + +## Example 1: Single Enroll + Single Fail Period +```{r} +enrollRates <- tibble(duration = 10, rate = 10) +failRates <- tibble(duration = 100, failRate = log(2) / 6, dropoutRate = .01) +totalDuration <- 22 + +eEvents_df(enrollRates = enrollRates, failRates = failRates, totalDuration = totalDuration, simple = FALSE) +``` + +## Example 2: Multiple Enroll + Single Fail Period +```{r} +enrollRates <- tibble(duration = c(5, 5), rate = c(10, 20)) +failRates <- tibble(duration = 100, failRate = log(2)/6, dropoutRate = .01) +totalDuration <- 22 + +eEvents_df(enrollRates = enrollRates, failRates = failRates, totalDuration = totalDuration, simple = FALSE) +``` + + +## Example 3: Signle Enroll + Multiple Fail Period +```{r} +enrollRates <- tibble(duration = 10, rate = 10) +failRates <- tibble(duration = c(20, 80), failRate = c(log(2)/6, log(2)/4), dropoutRate = .01) +totalDuration <- 22 + +eEvents_df(enrollRates = enrollRates, failRates = failRates, totalDuration = totalDuration, simple = FALSE) +``` + +## Example 4: Multiple Duration +```{r} +enrollRates <- tibble(duration = 10, rate = 10) +failRates <- tibble(duration = 100, failRate = log(2) / 6, dropoutRate = .01) +totalDuration <- c(2, 22) + +try(eEvents_df(enrollRates = enrollRates, failRates = failRates, totalDuration = totalDuration, simple = FALSE)) +``` + + + +# Inner Logic of `eEvents_df()` + +**Step 1:** set the analysis time. +```{r} +totalDuration <- 50 +``` + +**Step 2:** set the enrollment rates. +```{r} +enrollRates <- tibble(duration = c(5, 5), rate = c(10, 20)) + +# create a step function (sf) to define enrollment rates over time +sf.enrollRate <- stepfun(c(0, cumsum(enrollRates$duration)), + c(0, enrollRates$rate, 0), + right = FALSE) + +plot(sf.enrollRate, + xlab = "duration", ylab = "enrollment rates", + main = "Piecewise enrollment rate over time", xlim = c(-0.01, 21)) +``` + +**Step 3:** set the failure rates and dropout rates. +```{r} +failRates <- tibble(duration = c(20, 80), failRate = c(0.1, 0.2), dropoutRate = .01) + +# get the time points where the failure rates change +startFail <- c(0, cumsum(failRates$duration)) + +# plot the piecewise failure rates +sf.failRate <- stepfun(startFail, + c(0, failRates$failRate, last(failRates$failRate)), + right = FALSE) +plot(sf.failRate, + xlab = "duration", ylab = "failure rates", + main = "Piecewise failure rate over time", xlim = c(-0.01, 101)) + +# plot the piecewise dropout rate +sf.dropoutRate <- stepfun(startFail, + c(0, failRates$dropoutRate, last(failRates$dropoutRate)), + right = FALSE) +plot(sf.dropoutRate, + xlab = "duration", ylab = "dropout rates", + main = "Piecewise dropout rate over time", xlim = c(-0.01, 101)) +``` + + + +Given the above piecewise enrollment rates, failure rates, dropout rates, the time line is divided into several parts: + +- $(0, 5]$ (5 is the change point of the enrollment rates); +- $(5, 10]$ (10 is another change point of the enrollment rates); +- $(10, 20]$ (20 is the change point of the failure rates); +- $(20, 50]$ (50 is the analysis time); +- $(50, \infty]$ (after the analysis time). + +```{r, echo=FALSE} +plot(sf.enrollRate, + xlab = "time", ylab = "enrollment rates", + lty = 1, col = "red", pch = 1, + main = "Piecewise enrollment, failure, dropout rate over time", xlim = c(-0.01, 101)) + +plot(sf.failRate, + xlab = "time", ylab = "failure rates", + lty = 2, col = "blue", pch = 2, + xlim = c(-0.01, 101), add = TRUE) + +plot(sf.dropoutRate, + xlab = "time", ylab = "dropout rates", + lty = 3, col = "green", pch = 3, + xlim = c(-0.01, 101), add = TRUE) + +legend(60, 20, c("enrollment rate", "failure rate", "dropout rate"), col = c("red", "blue", "green"), + lty = c(1, 2, 3), pch = c(1, 2, 3), + merge = TRUE, bg = "gray90") +``` + +Given the above sub-intervals, our objective is to calculate the expected number of events in each sub-intervals. + +**Step 4:** divide the time line for enrollments +```{r} +df_1 <- tibble(startEnroll = c(0, cumsum(enrollRates$duration)), + endFail = totalDuration - startEnroll, + rate = c(enrollRates$rate, 0)) +``` + +```{r, echo=FALSE} +df_1 %>% + gt() %>% + tab_header(title = "df_1") %>% + tab_footnote(footnote = "The time when the enrollment starts.", locations = cells_column_labels("startEnroll")) %>% + tab_footnote(footnote = "The time from startEnroll to the analysis time.", locations = cells_column_labels("endFail")) %>% + tab_footnote(footnote = "The enrollment rates", locations = cells_column_labels("rate")) +``` + +**Step 5:** divide the time line for failure \& dropout rates +```{r} +df_2 <- tibble(endFail = cumsum(failRates$duration), + startEnroll = totalDuration - endFail, + failRate = failRates$failRate, + dropoutRate = failRates$dropoutRate) +``` + +```{r, echo=FALSE} +df_2 %>% + gt() %>% + tab_header(title = "df_2") %>% + tab_footnote(footnote = "The time when the failure changes.", locations = cells_column_labels("endFail")) %>% + tab_footnote(footnote = "The time from endFail to the analysis time.", locations = cells_column_labels("startEnroll")) %>% + tab_footnote(footnote = "The failure rates", locations = cells_column_labels("failRate")) %>% + tab_footnote(footnote = "The dropout rates", locations = cells_column_labels("dropoutRate")) +``` + +For the above `df_2`, one needs to discriminate if the analysis time (`totalDuration = 50`) is beyond the total failure rate duration. +```{r} +# if the analysis time is after the total failure rate duration +if(sum(failRates$duration) < totalDuration){ + df_2 <- df_2[-nrow(df_2), ] +}else{ + df_2 <- df_2 %>% filter(startEnroll > 0) +} +``` + +```{r, echo=FALSE} +df_2 %>% + gt() %>% + tab_header(title = "df_2", subtitle = "Updated by adjusting the analysis time and failRates duration") %>% + tab_footnote(footnote = "The time when the failure changes.", locations = cells_column_labels("endFail")) %>% + tab_footnote(footnote = "The time from endFail to the analysis time.", locations = cells_column_labels("startEnroll")) %>% + tab_footnote(footnote = "The failure rates", locations = cells_column_labels("failRate")) %>% + tab_footnote(footnote = "The dropout rates", locations = cells_column_labels("dropoutRate")) +``` + + +**Step 6:** divide the time line considering both the change points in enrollment, failure, dropout rates. +```{r} +df <- full_join(df_1, df_2, by = c("startEnroll", "endFail")) %>% arrange(endFail) +``` + +```{r, echo=FALSE} +df %>% + gt() %>% + tab_header(title = "df") %>% + tab_footnote(footnote = "The time when the enrollment rate starts.", locations = cells_column_labels("startEnroll")) %>% + tab_footnote(footnote = "The time when the failure rate ends. And startEnroll + endFail = 50", locations = cells_column_labels("endFail")) %>% + tab_footnote(footnote = "The enrollment rates.", locations = cells_column_labels("rate")) +``` + +We find there are lots of `NA`, which can be imputed by the piecewise model. +```{r} +df <- df %>% mutate(endEnroll = lag(startEnroll, default = as.numeric(totalDuration)), + startFail = lag(endFail, default = 0), + duration = endEnroll - startEnroll, + failRate = sf.failRate(startFail), + dropoutRate = sf.dropoutRate(startFail), + enrollRate = sf.enrollRate(startEnroll)) %>% + select(-rate) +``` + + +```{r, echo=FALSE} +df %>% + select(startEnroll, endEnroll, startFail, endFail, enrollRate, failRate, dropoutRate, duration) %>% + arrange(startEnroll) %>% + gt() %>% + tab_footnote(footnote = "The time when the enrollment rate starts.", + locations = cells_column_labels("startEnroll")) %>% + tab_footnote(footnote = "The (startEnroll, endEnroll] forms the piecewise model of the enrollment rates", + locations = cells_column_labels("endEnroll")) %>% + tab_footnote(footnote = "The time when the failure rate starts.", + locations = cells_column_labels("startFail")) %>% + tab_footnote(footnote = "The time when the failure rate ends. And startEnroll + endFail = 50. Besides, (startFail, endFail ] forms the piecewise model of the enrollment rates.", + locations = cells_column_labels("endFail")) %>% + tab_footnote(footnote = "endEnroll - startEnroll", + locations = cells_column_labels("duration")) +``` + +**Step 7:** compute the expected number of events in sub-intervals following the technical details in the vignette [``computing expected events by interval at risk''](https://merck.github.io/gsDesign2/articles/eEventsTheory.html) + +```{r} + # create 2 auxiliary variable for failure & dropout rate + # q: number of expected events in a sub-interval + # Q: cumulative product of q (pool all sub-intervals) +df <- df %>% mutate(q = exp(-duration * (failRate + dropoutRate)), + Q = lag(cumprod(q), default = 1)) %>% + arrange(desc(startFail)) %>% + # create another 2 auxiliary variable for enroll rate + # g: number of expected subjects in a sub-interval + # G: cumulative sum of g (pool all sub-intervals) + mutate(g = enrollRate * duration, + G = lag(cumsum(g), default = 0)) %>% + arrange(startFail) %>% + # compute expected events as nbar in a sub-interval + mutate(d = ifelse(failRate == 0, 0, Q * (1 - q) * failRate / (failRate + dropoutRate)), + nbar = ifelse(failRate == 0, 0, G * d + (failRate * Q * enrollRate) / (failRate + dropoutRate) * (duration - (1 - q) / (failRate + dropoutRate)))) + +``` + +**Step 8:** output results +```{R} +sf.startFail <- stepfun(startFail, c(0, startFail), right = FALSE) +df <- df %>% + transmute(t = endFail, failRate = failRate, Events = nbar, startFail = sf.startFail(startFail)) %>% + group_by(startFail) %>% + summarize(failRate = first(failRate), Events = sum(Events)) %>% + mutate(t = startFail) %>% + select("t", "failRate", "Events") + +df %>% gt() +``` + diff --git a/vignettes/usage_fixed_design.Rmd b/vignettes/usage_fixed_design.Rmd new file mode 100644 index 000000000..9ca0669d5 --- /dev/null +++ b/vignettes/usage_fixed_design.Rmd @@ -0,0 +1,374 @@ +--- +title: "fixed_design: compute sample size/power of a fixed design" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + number_sections: true + code_folding: hide + highlight: "textmate" + css: "custom.css" +bibliography: gsDesign.bib +vignette: | + %\VignetteIndexEntry{fixed_design: compute sample size/power of a fixed design} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown} +--- + + +```{r, message=FALSE, warning=FALSE} +library(gsDesign) +library(tibble) +library(gt) +# load the develop version of gsDesign2 +# it will finally be replaced by `libraray(gsDesign2)` +devtools::load_all() +``` + +# Parameters +```{r} +# Enrollment rate +enrollRates <- tibble::tibble( + Stratum = "All", + duration = 18, + rate = 20) + +# Failure rates +failRates <- tibble::tibble( + Stratum = "All", + duration = c(4, 100), + failRate = log(2) / 12, + hr = c(1, .6), + dropoutRate = .001) + +# Study duration in months +studyDuration <- 36 + +# Experimental / Control randomization ratio +ratio <- 1 + +# 1-sided Type I error +alpha <- 0.025 +# Type II error (1 - power) +beta <- 0.1 +``` + +# AHR {.tabset} + +## under fixed power +```{r} +x <- fixed_design(x = "AHR", + alpha = alpha, power = 1 - beta, + enrollRates = enrollRates, failRates = failRates, + studyDuration = studyDuration, ratio = ratio) + +x %>% summary() + +x %>% summary() %>% as_gt() +``` + +## under fixed sample size +```{r} +fixed_design(x = "AHR", + alpha = alpha, + enrollRates = enrollRates, failRates = failRates, + studyDuration = studyDuration, ratio = ratio) %>% + summary() %>% + as_gt() +``` + +# FH {.tabset} + +## under fixed power (default rho/gamma) +```{r} +# fixed design with a given power with default rho/gamma +x <- fixed_design(x = "FH", + alpha = alpha, power = 1 - beta, + enrollRates = enrollRates, failRates = failRates, + studyDuration = studyDuration, ratio = ratio) +x %>% summary() +x %>% summary() %>% as_gt() +``` + +## under fixed power (custom rho/gamma) +```{r} +# fixed design with a given power with input rho/gamma +fixed_design(x = "FH", + alpha = alpha, power = 1 - beta, + enrollRates = enrollRates, failRates = failRates, + studyDuration = studyDuration, ratio = ratio, + rho = 0.5, gamma = 0.5) %>% + summary() %>% + as_gt() +``` + + +## under fixed sample size (default rho/gamma) +```{r} +# fixed design with power calculated +fixed_design(x = "FH", + alpha = alpha, + enrollRates = enrollRates, failRates = failRates, + studyDuration = studyDuration, ratio = ratio) %>% + summary() %>% + as_gt() +``` + +## under fixed sample size (custom rho/gamma) +```{r} +# fixed design with power calculated +fixed_design(x = "FH", + alpha = alpha, + enrollRates = enrollRates, failRates = failRates, + studyDuration = studyDuration, ratio = ratio, + rho = 0.5, gamma = 0.5) %>% + summary() %>% + as_gt() +``` + +# MB {.tabset} + +## under fixed power (default tau) +```{r} +x <- fixed_design(x = "MB", + ratio = ratio, + alpha = alpha, power = 1 - beta, + enrollRates = enrollRates, + failRates = failRates, + studyDuration = studyDuration) +x %>% summary() +x %>% summary() %>% as_gt() +``` + +## under fixed power (custom tau) +```{r} +fixed_design(x = "MB", + ratio = ratio, + alpha = alpha, power = 1 - beta, + enrollRates = enrollRates, + failRates = failRates, + studyDuration = studyDuration, + tau = 4) %>% + summary() %>% + as_gt() +``` + + +## under fixed sample size (default tau) +```{r} +fixed_design(x = "MB", + ratio = ratio, + alpha = alpha, + enrollRates = enrollRates, + failRates = failRates, + studyDuration = studyDuration) %>% + summary() %>% + as_gt() +``` + +## under fixed sample size (custom tau) +```{r} +fixed_design(x = "MB", + ratio = ratio, + alpha = alpha, + enrollRates = enrollRates, + failRates = failRates, + studyDuration = studyDuration, + tau = 4) %>% + summary() %>% + as_gt() +``` + +# LF {.tabset} + +## under fixed power +```{r} +fixed_design(x = "LF", alpha = alpha, power = 1 - beta, + ratio = ratio, + enrollRates = enrollRates, + failRates = failRates, + studyDuration = studyDuration) %>% + summary() %>% + as_gt() +``` + + +## under sample size +```{r} +fixed_design(x = "LF", alpha = alpha, + ratio = ratio, + enrollRates = enrollRates, + failRates = failRates, + studyDuration = studyDuration) %>% + summary() %>% + as_gt() +``` + +# MaxCombo {.tabset} + +## under fixed power (default rho/gamma/tau) +```{r} +x <- fixed_design(x = "MaxCombo", alpha = alpha, power = 1 - beta, + ratio = ratio, + enrollRates = enrollRates, + failRates = failRates, + studyDuration = studyDuration) +x %>% summary() +x %>% summary() %>% as_gt() +``` + +## under fixed power (custom rho/gamma/tau) +```{r} +fixed_design(x = "MaxCombo", alpha = alpha, power = 1 - beta, + ratio = ratio, + enrollRates = enrollRates, + failRates = failRates, + studyDuration = studyDuration, + rho = c(0, 0.5, 0.5), + gamma = c(0, 0, 0.5), + tau = c(-1, 4, 6)) %>% + summary() %>% + as_gt() +``` + + +## under sample size (default rho/gamma/tau) + +```{r} +fixed_design(x = "MaxCombo", alpha = alpha, + ratio = ratio, + enrollRates = enrollRates, + failRates = failRates, + studyDuration = studyDuration) %>% + summary() %>% + as_gt() +``` + + +## under sample size (custom rho/gamma/tau) +```{r} +fixed_design(x = "MaxCombo", alpha = alpha, + ratio = ratio, + enrollRates = enrollRates, + failRates = failRates, + studyDuration = studyDuration, + rho = c(0, 0.5, 0.5), + gamma = c(0, 0, 0.5), + tau = c(-1, 4, 6)) %>% + summary() %>% + as_gt() +``` + + + +# RMST {.tabset} + +## under fixed power +```{r} +x <- fixed_design(x = "RMST", + alpha = alpha, power = 1 - beta, + enrollRates = enrollRates, failRates = failRates, + studyDuration = studyDuration, ratio = ratio, + tau = 18) + +x %>% summary() + +x %>% summary() %>% as_gt() +``` + +## under fixed sample size +```{r} +fixed_design(x = "RMST", + alpha = alpha, + enrollRates = enrollRates, failRates = failRates, + studyDuration = studyDuration, ratio = ratio, + tau = 18) %>% + summary() %>% + as_gt() +``` + + +# Milestone {.tabset} + +## under fixed power +```{r} +x <- fixed_design(x = "Milestone", + alpha = alpha, power = 1 - beta, + enrollRates = enrollRates, failRates = failRates, + studyDuration = studyDuration, ratio = ratio, + tau = 18) + +x %>% summary() + +x %>% summary() %>% as_gt() +``` + +## under fixed sample size +```{r} +fixed_design(x = "Milestone", + alpha = alpha, + enrollRates = enrollRates, failRates = failRates, + studyDuration = studyDuration, ratio = ratio, + tau = 18) %>% + summary() %>% + as_gt() +``` + + +# RD {.tabset} + +## under fixed power +```{r} +x <- fixed_design(x = "RD", + alpha = alpha, power = 1 - beta, + p_c = .15, p_e = .1, rd0 = 0, + ratio = ratio) + +x %>% summary() +x %>% summary() %>% as_gt() +``` + +## under fixed sample size +```{r} +fixed_design(x = "RD", + alpha = alpha, power = NULL, + p_c = .15, p_e = .1, rd0 = 0, + N = 2000, ratio = ratio) %>% + summary() %>% + as_gt() +``` + +# Multiple Designs + +```{r, message = FALSE} +x_AHR <- fixed_design(x = "AHR", alpha = alpha, ratio = ratio, + enrollRates = enrollRates, failRates = failRates, + studyDuration = studyDuration) + +x_FH <- fixed_design(x = "FH", alpha = alpha, ratio = ratio, + enrollRates = enrollRates, failRates = failRates, studyDuration = studyDuration, + rho = 0.5, gamma = 0.5) + +x_MB <- fixed_design(x = "MB", alpha = alpha, ratio = ratio, + enrollRates = enrollRates,failRates = failRates, studyDuration = studyDuration, + tau = 4) + +x_LF <- fixed_design(x = "LF", alpha = alpha, ratio = ratio, + enrollRates = enrollRates, failRates = failRates, studyDuration = studyDuration) + +x_MaxCombo <- fixed_design(x = "MaxCombo", alpha = alpha, ratio = ratio, + enrollRates = enrollRates, failRates = failRates, studyDuration = studyDuration, + rho = c(0, 0.5, 0.5), gamma = c(0, 0, 0.5), tau = c(-1, 4, 6)) + +x_RMST <- fixed_design(x = "RMST", alpha = alpha, ratio = ratio, + enrollRates = enrollRates, failRates = failRates, studyDuration = studyDuration, + tau = 30) + +x_Milestone <- fixed_design(x = "Milestone", alpha = alpha, ratio = ratio, + enrollRates = enrollRates, failRates = failRates, studyDuration = studyDuration, + tau = 30) + +rbind(summary(x_AHR), summary(x_FH), summary(x_MB), summary(x_LF), summary(x_MaxCombo), summary(x_RMST), summary(x_Milestone)) %>% gt() +``` + diff --git a/vignettes/usage_gs_b.Rmd b/vignettes/usage_gs_b.Rmd new file mode 100644 index 000000000..2e282d404 --- /dev/null +++ b/vignettes/usage_gs_b.Rmd @@ -0,0 +1,75 @@ +--- +title: "gs_b: specify fixed boundaries in group sequential designs" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + number_sections: true + highlight: "textmate" + css: "custom.css" +# bibliography: "example.bib" +vignette: > + %\VignetteEngine{knitr::rmarkdown} + %\VignetteIndexEntry{gs_b: specify fixed boundaries in group sequential designs} +--- + +```{r, message=FALSE} +library(tibble) +library(dplyr) +#library(gsDesign2) +devtools::load_all() +``` + +# Introduction of `gs_b()` + +`gs_b()` can be used to derive fixed boundary in fixed/group sequential design. It is usually used in the `upper = ...` and `lower = ...` arguments in ++ `gs_power_npe()` ++ `gs_design_npe()` ++ `gs_power_ahr()` ++ `gs_design_ahr()` ++ `gs_power_wlr()` ++ `gs_design_wlr()` ++ `gs_power_combo()` ++ `gs_design_combo()` + +# Usage of `gs_b()` + +## Example 1 +Assume it is a group sequential design with 3 analysis, one can input its upper bound as a vector `c(4, 3, 2)` by using `gs_b()` as follows. +```{r} +gs_b(par = 4:2) +``` + + +## Example 2 +In the above example, one can assign the upper bound at the second analysis by +```{r} +gs_b(par = 4:2, k = 2) +``` + +## Example 3 +Generate an efficacy bound using a spending function. +Use Lan-DeMets spending approximation of O'Brien-Fleming bound as 50\%, 75\% and 100\% of final spending +```{r} +# information fraction +IF <- c(.5, .75, 1) +# Lan-DeMets spending approximation of O'Brien-Fleming +par <- gsDesign::gsDesign(alpha = .025, k = length(IF), + test.type = 1, sfu = gsDesign::sfLDOF, + timing = IF)$upper$bound +gs_b(par = par) +``` + + +# Inner Logic of `gs_b()` + +`gs_b` is a short function with 2 key arguments: `par = ...` and `k = ...` +```{r, eval=FALSE} +if(is.null(k)){ + return(par) +}else{ + return(par[k]) +} +``` + diff --git a/vignettes/usage_gs_design_ahr.Rmd b/vignettes/usage_gs_design_ahr.Rmd new file mode 100644 index 000000000..2acfaafa5 --- /dev/null +++ b/vignettes/usage_gs_design_ahr.Rmd @@ -0,0 +1,34 @@ +--- +title: "gs_design_ahr: compute sample size by the AHR method" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + number_sections: true + highlight: "textmate" + css: "custom.css" +# bibliography: "example.bib" +vignette: > + %\VignetteEngine{knitr::rmarkdown} + %\VignetteIndexEntry{gs_design_ahr: compute sample size by the AHR method} +--- + +```{r, message=FALSE} +library(tibble) +library(dplyr) +#library(gsDesign2) +devtools::load_all() +``` + +# Introduction of `gs_design_ahr()` + +TODO + +# Usage of `gs_design_ahr()` + +TODO + +# Inner Logic of `gs_design_ahr()` + +TODO \ No newline at end of file diff --git a/vignettes/usage_gs_design_combo.Rmd b/vignettes/usage_gs_design_combo.Rmd new file mode 100644 index 000000000..8e137a6c2 --- /dev/null +++ b/vignettes/usage_gs_design_combo.Rmd @@ -0,0 +1,34 @@ +--- +title: "gs_design_combo: compute sample size by the max combo method" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + number_sections: true + highlight: "textmate" + css: "custom.css" +# bibliography: "example.bib" +vignette: > + %\VignetteEngine{knitr::rmarkdown} + %\VignetteIndexEntry{gs_design_combo: compute sample size by the max combo method} +--- + +```{r, message=FALSE} +library(tibble) +library(dplyr) +#library(gsDesign2) +devtools::load_all() +``` + +# Introduction of `gs_design_combo()` + +TODO + +# Usage of `gs_design_combo()` + +TODO + +# Inner Logic of `gs_design_combo()` + +TODO \ No newline at end of file diff --git a/vignettes/usage_gs_design_wlr.Rmd b/vignettes/usage_gs_design_wlr.Rmd new file mode 100644 index 000000000..aa7806d41 --- /dev/null +++ b/vignettes/usage_gs_design_wlr.Rmd @@ -0,0 +1,34 @@ +--- +title: "gs_design_wlr: compute sample size by the WLR method" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + number_sections: true + highlight: "textmate" + css: "custom.css" +# bibliography: "example.bib" +vignette: > + %\VignetteEngine{knitr::rmarkdown} + %\VignetteIndexEntry{gs_design_wlr: compute sample size by the WLR method} +--- + +```{r, message=FALSE} +library(tibble) +library(dplyr) +#library(gsDesign2) +devtools::load_all() +``` + +# Introduction of `gs_design_wlr()` + +TODO + +# Usage of `gs_design_wlr()` + +TODO + +# Inner Logic of `gs_design_wlr()` + +TODO \ No newline at end of file diff --git a/vignettes/usage_gs_info_ahr.Rmd b/vignettes/usage_gs_info_ahr.Rmd new file mode 100644 index 000000000..22c9e022a --- /dev/null +++ b/vignettes/usage_gs_info_ahr.Rmd @@ -0,0 +1,187 @@ +--- +title: "gs_info_ahr: compute statistical information by the AHR method" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + number_sections: true + highlight: "textmate" + css: "custom.css" +vignette: > + %\VignetteEngine{knitr::rmarkdown} + %\VignetteIndexEntry{gs_info_ahr: compute statistical information by the AHR method} +--- + + +```{r, essage=FALSE, echo=FALSE} +knitr::opts_chunk$set(fig.width = 5, fig.height = 4, fig.align = 'center') +``` + +```{r, message=FALSE, echo=FALSE} +library(gt) +library(tibble) +library(dplyr) +library(testthat) +devtools::load_all() +#library(gsDesign2) +``` + +# Introduction of `gs_info_ahr()` + +`tEvents()` calculate the analysis time (`Time` in its output), number of events (`Events` in its output), average hazard ratio (`AHR` in its outputs), effect size (`theta` in its output), statistical information (`info` and `info0` in its output) using an average hazard ratio model. + +The aforementioned calculation is based on piecewise model: ++ piecewise constant enrollment rates ++ piecewise exponential failure rates ++ piecewise censoring rates. + + +# Use Cases + +## Example 1 + +In this example, we only input the target number of events by `events = ...`, and derive the time when these events will be arrived. +```{r} +enrollRates <- tibble(Stratum = "All", duration = c(2, 2, 10), rate = c(3, 6, 9) * 5) +failRates <- tibble(Stratum = "All", duration = c(3, 100), failRate = log(2) / c(9, 18), hr = c(.9, .6), dropoutRate = rep(.001, 2)) +ratio <- 1 + +gs_info_ahr(enrollRates = enrollRates, failRates = failRates, + ratio = ratio, events = c(50, 80, 100)) +``` + +## Example 2 + +In this example, we only input the analysis time by `analysisTimes = ...`, and derive the number of events at these analysis time. +```{r} +enrollRates <- tibble(Stratum = "All", duration = c(2, 2, 10), rate = c(3, 6, 9) * 5) +failRates <- tibble(Stratum = "All", duration = c(3, 100), failRate = log(2) / c(9, 18), hr = c(.9, .6), dropoutRate = rep(.001, 2)) +ratio <- 1 + +gs_info_ahr(enrollRates = enrollRates, failRates = failRates, + ratio = ratio, analysisTimes = c(10, 15, 20)) +``` + +## Example 3 + +In this example, we both input `analysisTimes = ...` and `events = ...`. +In this case, one will see ++ the derived analysis time (`Time` column) $\geq$ input `analysisTimes` ++ the derived number of event (`Events` column) $\geq$ input `events` + +```{r} +enrollRates <- tibble(Stratum = "All", duration = c(2, 2, 10), rate = c(3, 6, 9) * 5) +failRates <- tibble(Stratum = "All", duration = c(3, 100), failRate = log(2) / c(9, 18), hr = c(.9, .6), dropoutRate = rep(.001, 2)) +ratio <- 1 + +gs_info_ahr(enrollRates = enrollRates, failRates = failRates, + ratio = ratio, analysisTimes = c(10, 15, 20), events = c(80, # > events in example 2 + 140, # < > events in example 2 + 220 # > events in example 2 + )) +``` + + + + + +# Inner Logic of `gs_info_ahr()` + +To explain the inner logic of `gs_info_ahr()`, we discuss 3 scenario. + +1. only input `analysisTimes` +1. only input `events` +1. both input `analysisTimes` and `events` + +## Scenario 1: only input `analysisTimes` + +If only `analysisTimes = ...` is input, essentially, `gs_info_ahr()` uses `AHR()` to calculate the number of events at these `analysisTimes`. +```{r} +enrollRates <- tibble(Stratum = "All", duration = c(2, 2, 10), rate = c(3, 6, 9) * 5) +failRates <- tibble(Stratum = "All", duration = c(3, 100), failRate = log(2) / c(9, 18), hr = c(.9, .6), dropoutRate = rep(.001, 2)) +ratio <- 1 +analysisTimes <- c(10, 15, 20) + +AHR(enrollRates = enrollRates, failRates = failRates, + ratio = ratio, totalDuration = analysisTimes) %>% + mutate(theta = -log(AHR), Analysis = 1 : length(analysisTimes)) %>% + select(Analysis, Time, Events, AHR, theta, info, info0) %>% + gt() +``` + +This is exactly the output from `gs_info_ahr()`: +```{r} +gs_info_ahr(enrollRates = enrollRates, failRates = failRates, + ratio = ratio, analysisTimes = analysisTimes) %>% gt() +``` + + +## Scenario 2: only input `events` + +If only `events = ...` is input, essentially, `gs_info_ahr()` uses `tEvents()` to calculate the time when these events will be arrived. +```{r} +enrollRates <- tibble(Stratum = "All", duration = c(2, 2, 10), rate = c(3, 6, 9) * 5) +failRates <- tibble(Stratum = "All", duration = c(3, 100), failRate = log(2) / c(9, 18), hr = c(.9, .6), dropoutRate = rep(.001, 2)) +ratio <- 1 +events <- c(70, 150, 200) + +ans <- NULL +for(i in seq_along(events)){ + ans_new <- gsDesign2::tEvents(enrollRates = enrollRates, failRates = failRates, + ratio = ratio, targetEvents = events[i]) + ans <- rbind(ans, ans_new) +} + +ans %>% + mutate(theta = -log(AHR), Analysis = 1 : length(analysisTimes)) %>% + select(Analysis, Time, Events, AHR, theta, info, info0) %>% + gt() +``` + +This is exactly the output from `gs_info_ahr()`: +```{r} +gs_info_ahr(enrollRates = enrollRates, failRates = failRates, + ratio = ratio, events = events) %>% gt() +``` + + +## Scenario 3: both input `analysisTimes` and `events` + +If both `analysisTimes = ...` and `events = ...` are input, `gs_info_ahr()` uses both `AHR()` and `tEvents()`. +In this way, it is guaranteed that ++ the derived number of event (`Events` column) $\geq$ input `events` ++ the derived analysis time (`Time` column) $\geq$ input `analysisTimes` + +```{r} +enrollRates <- tibble(Stratum = "All", duration = c(2, 2, 10), rate = c(3, 6, 9) * 5) +failRates <- tibble(Stratum = "All", duration = c(3, 100), failRate = log(2) / c(9, 18), hr = c(.9, .6), dropoutRate = rep(.001, 2)) +ratio <- 1 +analysisTimes <- c(10, 15, 20) +events <- c(70, 150, 200) + +ans <- NULL + +# first, use `AHR()` to calculate the number of events at the input `analysisTimes` +ans <- AHR(enrollRates = enrollRates, failRates = failRates, + ratio = ratio, totalDuration = analysisTimes) + +# second, compare if the events derived above meet the targeted number of events input in `events` +for(i in seq_along(events)){ + if (ans$Events[i] < events[i]){ + ans[i,] <- tEvents(enrollRates = enrollRates, failRates = failRates, + ratio = ratio, targetEvents = events[i]) + } +} + +ans %>% + mutate(theta = -log(AHR), Analysis = 1 : length(analysisTimes)) %>% + select(Analysis, Time, Events, AHR, theta, info, info0) %>% + gt() +``` + +This is exactly the output from `gs_info_ahr()`: +```{r} +gs_info_ahr(enrollRates = enrollRates, failRates = failRates, + ratio = ratio, events = events, analysisTimes = analysisTimes) %>% gt() +``` \ No newline at end of file diff --git a/vignettes/usage_gs_info_combo.Rmd b/vignettes/usage_gs_info_combo.Rmd new file mode 100644 index 000000000..1417c4d04 --- /dev/null +++ b/vignettes/usage_gs_info_combo.Rmd @@ -0,0 +1,34 @@ +--- +title: "gs_info_combo: compute statistical information by the max combo method" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + number_sections: true + highlight: "textmate" + css: "custom.css" +# bibliography: "example.bib" +vignette: > + %\VignetteEngine{knitr::rmarkdown} + %\VignetteIndexEntry{gs_info_combo: compute statistical information by the max combo method} +--- + +```{r, message=FALSE} +library(tibble) +library(dplyr) +#library(gsDesign2) +devtools::load_all() +``` + +# Introduction of `gs_info_combo()` + +TODO + +# Usage of `gs_info_combo()` + +TODO + +# Inner Logic of `gs_info_combo()` + +TODO \ No newline at end of file diff --git a/vignettes/usage_gs_info_wlr.Rmd b/vignettes/usage_gs_info_wlr.Rmd new file mode 100644 index 000000000..78cc3f461 --- /dev/null +++ b/vignettes/usage_gs_info_wlr.Rmd @@ -0,0 +1,34 @@ +--- +title: "gs_info_wlr: compute statistical information by the WLR method" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + number_sections: true + highlight: "textmate" + css: "custom.css" +# bibliography: "example.bib" +vignette: > + %\VignetteEngine{knitr::rmarkdown} + %\VignetteIndexEntry{gs_info_wlr: compute statistical information by the WLR method} +--- + +```{r, message=FALSE} +library(tibble) +library(dplyr) +#library(gsDesign2) +devtools::load_all() +``` + +# Introduction of `gs_info_wlr()` + +TODO + +# Usage of `gs_info_wlr()` + +TODO + +# Inner Logic of `gs_info_wlr()` + +TODO \ No newline at end of file diff --git a/vignettes/usage_gs_power_ahr.Rmd b/vignettes/usage_gs_power_ahr.Rmd new file mode 100644 index 000000000..ed103c193 --- /dev/null +++ b/vignettes/usage_gs_power_ahr.Rmd @@ -0,0 +1,47 @@ +--- +title: "gs_power_ahr: computes power using average hazard ratio under non-proportional hazards" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + number_sections: true + highlight: "textmate" + css: "custom.css" +vignette: > + %\VignetteEngine{knitr::rmarkdown} + %\VignetteIndexEntry{gs_power_ahr: computes power using average hazard ratio under non-proportional hazards} +--- + +```{r, message=FALSE} +library(tibble) +library(dplyr) +#library(gsDesign2) +devtools::load_all() +``` + +# Introduction of `gs_power_ahr()` + + +# Use cases of `gs_power_ahr()` + +## Example 1 + +```{r} +x <- gs_power_ahr(enrollRates = tibble(Stratum = "All", duration = c(2, 2, 10), rate = c(3, 6, 9)), + failRates = tibble(Stratum = "All", duration = c(3, 100), failRate = log(2) / c(9, 18), + hr = c(.9, .6), dropoutRate = rep(.001, 2)), + analysisTimes = c(12, 24, 36), events = NULL, + 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)) +x +``` + + + +# Inner Logic of `gs_power_ahr()` + +TODO \ No newline at end of file diff --git a/vignettes/usage_gs_power_combo.Rmd b/vignettes/usage_gs_power_combo.Rmd new file mode 100644 index 000000000..bf976462f --- /dev/null +++ b/vignettes/usage_gs_power_combo.Rmd @@ -0,0 +1,34 @@ +--- +title: "gs_power_combo: compute power by the max combo method" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + number_sections: true + highlight: "textmate" + css: "custom.css" +# bibliography: "example.bib" +vignette: > + %\VignetteEngine{knitr::rmarkdown} + %\VignetteIndexEntry{gs_power_combo: compute power by the max combo method} +--- + +```{r, message=FALSE} +library(tibble) +library(dplyr) +#library(gsDesign2) +devtools::load_all() +``` + +# Introduction of `gs_power_combo()` + +TODO + +# Usage of `gs_power_combo()` + +TODO + +# Inner Logic of `gs_power_combo()` + +TODO \ No newline at end of file diff --git a/vignettes/usage_gs_power_npe.Rmd b/vignettes/usage_gs_power_npe.Rmd new file mode 100644 index 000000000..7488b5905 --- /dev/null +++ b/vignettes/usage_gs_power_npe.Rmd @@ -0,0 +1,127 @@ +--- +title: "gs_power_npe: derives bounds and crossing probabilities for group sequential designs under NPH assumptions" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + number_sections: true + highlight: "textmate" + css: "custom.css" +# bibliography: "example.bib" +vignette: > + %\VignetteEngine{knitr::rmarkdown} + %\VignetteIndexEntry{gs_power_npe: derives bounds and crossing probabilities for group sequential designs under NPH assumptions} +--- + +```{r, message=FALSE} +library(tibble) +library(dplyr) +library(gt) +#library(gsDesign2) +devtools::load_all() +``` + +# Introduction of `gs_power_npe()` + +`gs_power_npe()` derives group sequential **bounds** and boundary crossing **probabilities** for a design. +It allows a **non-constant treatment effect** over time, but also can be applied for the usual homogeneous effect size designs. +It requires ++ treatment effect (`theta`, `theta1`) ++ statistical information at each analysis (`info`, `info0`, `info1`) ++ a method of deriving bounds, such as fixed bounds or spending (`upper`, `upar`, `lower`, `lpar`). + +The routine enables two things not available in the gsDesign package: + +1. non-constant effect, +1. more flexibility in boundary selection. + + + +# Usage of `gs_power_npe()` + +## Example 1: Fixed bound {.tabset} + +### no futility bound + +```{r} +# Same fixed efficacy bounds, (i.e., non-binding bound), null hypothesis +gs_power_npe( + theta = rep(0, 3), + info = (1:3) * 40, + upar = gsDesign::gsDesign(k = 3,sfu = gsDesign::sfLDOF)$upper$bound, + lpar = rep(-Inf, 3)) %>% + filter(Bound == "Upper") %>% gt() +``` + +### with futility bound +```{r} +# Fixed bound +gs_power_npe( + theta = c(.1, .2, .3), + info = (1:3) * 40, + upper = gs_b, + upar = gsDesign::gsDesign(k = 3,sfu = gsDesign::sfLDOF)$upper$bound, + lower = gs_b, + lpar = c(-1, 0, 0)) %>% gt() +``` + + +### futility only at analysis 1 +```{r} +gs_power_npe( + theta = c(.1, .2, .3), + info = (1:3) * 40, + upper = gs_b, + upar = c(Inf, 3, 2), + lower = gs_b, + lpar = c(qnorm(.1), -Inf, -Inf)) %>% gt() +``` + + +## Example 2: spending bounds {.tabset} + +### lower spending based on non-zero effect +```{r} +gs_power_npe( + theta = c(.1, .2, .3), # non-zero effect + info = (1:3) * 40, + upper = gs_spending_bound, + upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL), + lower = gs_spending_bound, + lpar = list(sf = gsDesign::sfHSD, total_spend = 0.1, param = -1, timing = NULL)) +``` + +### 2-sided symmetric spend +```{r} +x <- gs_power_npe( + theta = rep(0, 3), + info = (1:3) * 40, + # typically, 2-sided bounds are binding + binding = TRUE, + upper = gs_spending_bound, + # O'Brien-Fleming spending + 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)) + +x %>% gt() +``` + +```{r} +# Re-use these bounds under alternate hypothesis +# Always use binding = TRUE for power calculations +gs_power_npe( + theta = c(.1, .2, .3), + info = (1:3) * 40, + binding = TRUE, + upar = (x %>% filter(Bound == "Upper"))$Z, + lpar = -(x %>% filter(Bound == "Upper"))$Z) %>% gt() +``` + + +# Inner Logic of `gs_spending_bound()` + +TODO + + diff --git a/vignettes/usage_gs_power_wlr.Rmd b/vignettes/usage_gs_power_wlr.Rmd new file mode 100644 index 000000000..ece4c7652 --- /dev/null +++ b/vignettes/usage_gs_power_wlr.Rmd @@ -0,0 +1,34 @@ +--- +title: "gs_power_wlr: compute power by the WLR method" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + number_sections: true + highlight: "textmate" + css: "custom.css" +# bibliography: "example.bib" +vignette: > + %\VignetteEngine{knitr::rmarkdown} + %\VignetteIndexEntry{gs_power_wlr: compute power by the WLR method} +--- + +```{r, message=FALSE} +library(tibble) +library(dplyr) +#library(gsDesign2) +devtools::load_all() +``` + +# Introduction of `gs_power_wlr()` + +TODO + +# Usage of `gs_power_wlr()` + +TODO + +# Inner Logic of `gs_power_wlr()` + +TODO \ No newline at end of file diff --git a/vignettes/usage_gs_spending_bound.Rmd b/vignettes/usage_gs_spending_bound.Rmd new file mode 100644 index 000000000..1cbdc7f85 --- /dev/null +++ b/vignettes/usage_gs_spending_bound.Rmd @@ -0,0 +1,87 @@ +--- +title: "gs_spending_bound: compute spending boundary in group sequential design" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + number_sections: true + highlight: "textmate" + css: "custom.css" +# bibliography: "example.bib" +vignette: > + %\VignetteEngine{knitr::rmarkdown} + %\VignetteIndexEntry{gs_spending_bound: compute spending boundary in group sequential design} +--- + +```{r, message=FALSE} +library(tibble) +library(dplyr) +#library(gsDesign2) +devtools::load_all() +``` + +# Introduction of `gs_spending_bound()` + +`gs_spending_bound()` can be used to derive spending boundary in group sequential design. It is usually used in the `upper = ...` and `lower = ...` arguments in ++ `gs_power_npe()` ++ `gs_design_npe()` ++ `gs_power_ahr()` ++ `gs_design_ahr()` ++ `gs_power_wlr()` ++ `gs_design_wlr()` ++ `gs_power_combo()` ++ `gs_design_combo()` + +# Usage of `gs_spending_bound()` + +## Example 1 + + +```{r} +info <- (1:3) * 10 +IF <- info / max(info) +k <- length(IF) + +# 1st analysis +a1 <- gs_spending_bound(k = 1, efficacy = FALSE, theta = 0, + par = list(sf = gsDesign::sfLDOF, total_spend = 0.025, timing = IF, param = NULL), + hgm1 = NULL) + +b1 <- gs_spending_bound(k = 1, efficacy = TRUE, theta = 0, + par = list(sf = gsDesign::sfLDOF, total_spend = 0.025, timing = IF, param = NULL), + hgm1 = NULL) +cat("The (lower, upper) boundary at the 1st analysis is (", a1, ", ", b1, ").\n") + +# 2st analysis +a2 <- gs_spending_bound(k = 2, efficacy = FALSE, theta = 0, + par = list(sf = gsDesign::sfLDOF, total_spend = 0.025, timing = IF, param = NULL), + hgm1 = h1(r = 18, theta = 0, I = info[1], a = a1, b = b1)) + +b2 <- gs_spending_bound(k = 2, efficacy = TRUE, theta = 0, + par = list(sf = gsDesign::sfLDOF, total_spend = 0.025, timing = IF, param = NULL), + hgm1 = h1(r = 18, theta = 0, I = info[1], a = a1, b = b1)) +cat("The upper boundary at the 2nd analysis is (", a2, ", ", b2, ").\n") + +# 3nd analysis +# a3 <- gs_spending_bound(k = 2, efficacy = FALSE, theta = 0, +# par = list(sf = gsDesign::sfLDOF, total_spend = 0.025, timing = IF, param = NULL), +# hgm1 = hupdate(r = 18, theta = 0, I = info[2], a = a2, b = b2, +# thetam1 = 0, Im1 = info[2], +# gm1 = h1(r = 18, theta = 1, I = info[1], a = a1, b = b1))) +# +# b3 <- gs_spending_bound(k = 2, efficacy = TRUE, theta = 0, +# par = list(sf = gsDesign::sfLDOF, total_spend = 0.025, timing = IF, param = NULL), +# hgm1 = hupdate(r = 18, theta = 0, I = info[2], a = a2, b = b2, +# thetam1 = 0, Im1 = info[2], +# gm1 = h1(r = 18, theta = 0, I = info[1], a = a1, b = b1))) +# cat("The upper boundary at the 2nd analysis is (", a3, ", ", b3, ").\n") +``` + + + +# Inner Logic of `gs_spending_bound()` + +TODO + + diff --git a/vignettes/usage_summary_as_gt.Rmd b/vignettes/usage_summary_as_gt.Rmd new file mode 100644 index 000000000..1df44f3b4 --- /dev/null +++ b/vignettes/usage_summary_as_gt.Rmd @@ -0,0 +1,379 @@ +--- +title: "summary & as_gt: summarize group sequential design" +output: + rmarkdown::html_document: + toc: true + toc_depth: 3 + toc_float: true + theme: flatly + code_folding: hide + number_sections: true + highlight: "textmate" + css: "custom.css" +bibliography: gsDesign.bib +vignette: | + %\VignetteIndexEntry{summary & as_gt: summarize group sequential design} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown} +--- + + +```{r setup, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +```{r, message=FALSE, warning=FALSE} +library(dplyr) +library(tibble) +library(gt) +devtools::load_all() +``` + +# Overview + +This vignette introduces publication quality table production for group sequential designs in the **gsDesign2** package. +It also demonstrates designs for an example scenario using multiple design approaches. +We divide the document into 3 parts: + +- Design specification and derivation +- Printing design summary tables +- Details of output from design functions +- Details on table output options + +The reader can decide which of these sections is of interest to them. + +The function used to generate bounds tables is `gsDesign2::summary()`. +Users can use `gsDesign2::as_gt()` to format the above table using the **gt** package. + +In this vignette, we introduce a general approach to bound summaries by examples using different design approaches for a time-to-event outcome: + +- the average hazard ratio (AHR) method extended from @Mukhopadhyay2020 using `gsDesign2::gs_design_ahr()`; +- the weighted logrank (WLR) method of @Yung2019Bcs using `gsDesign2::gs_design_wlr()`; + +# Design Specification and Derivation + +## Design Parameters + +The design parameters we use across the different designs derived are: + +```{r} +# enrollment/failure rates +enrollRates <- tibble::tibble( + Stratum = "All", + duration = 12, + rate = 1) +failRates <- tibble::tibble( + Stratum = "All", + duration = c(4, 100), + failRate = log(2) / 12, + hr = c(1, .6), + dropoutRate = .001) + +# Information fraction +IF <- (1:3)/3 +# Analysis times in months; first 2 will be ignored as IF will not be achieved +analysisTimes <- c(.01, .02, 36) + +# Experimental / Control randomization ratio +ratio <- 1 + +# 1-sided Type I error +alpha <- 0.025 +# Type II error (1 - power) +beta <- 0.1 + +# Upper bound +upper <- gsDesign2::gs_spending_bound # alpha-spending bound +upar <- list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL) + +# Lower bound +lower <- gsDesign2::gs_spending_bound # beta-spending bound +lpar <- list(sf = gsDesign::sfHSD, total_spend = 0.1, param = 0, timing = NULL) + +# Fleming-Harrington (FH) weight functions for weighted logrank (WLR) +wgt00 <- function(x, arm0, arm1){ # Equal weighting for logrank + gsDesign2:::wlr_weight_fh(x, arm0, arm1, rho = 0, gamma = 0)} +wgt05 <- function(x, arm0, arm1){ # Early downweighting with FH(0,.5) + gsDesign2:::wlr_weight_fh(x, arm0, arm1, rho = 0, gamma = .5)} + +# Both of above tests for MaxCombo: logrank and FH(0,.5) +fh_test <- rbind( + # Include logrank for all 3 analyses + data.frame(rho = 0, gamma = 0, tau = -1, test = 1, Analysis = 1:3, analysisTimes = c(12, 24, 36)), + # Only include FH(0,.5) for analyses 2 and 3 + data.frame(rho = c(0, 0.5), gamma = 0.5, tau = -1, test = 2:3, Analysis = 3, analysisTimes = 36)) +``` + +## Deriving Designs + +### AHR Design Derivation + +Using the design parameters above, the AHR design is derived as follows: + +By using the design parameters above, one can generate an AHR model by `gs_design_ahr` as + +```{r, message=FALSE} +x_design_ahr <- gs_design_ahr( + enrollRates = enrollRates, + failRates = failRates, + IF = IF, + analysisTimes = analysisTimes, + ratio = ratio, + alpha = alpha, + beta = beta, + upper = upper, + upar = upar, + lower = lower, + lpar = lpar +) + +x_power_ahr <- gs_power_ahr( + enrollRates = x_design_ahr$enrollRates, + failRates = x_design_ahr$failRates, + events = c(100, 200, 400), + analysisTimes = NULL, + upper = upper, + upar = upar, + lower = lower, + lpar = lpar +) +``` + + +### WLR Design Derivation + +```{r, message=FALSE} +x_design_wlr <- gs_design_wlr( + enrollRates = enrollRates, + failRates = failRates, + weight = wgt05, + IF = NULL, + analysisTimes = sort(unique(x_design_ahr$analysis$Time)), + ratio = ratio, + alpha = alpha, + beta = beta, + upper = upper, + upar = upar, + lower = lower, + lpar = lpar +) + +# x_power_wlr <- gs_power_wlr( +# enrollRates = x_design_wlr$enrollRates, +# failRates = x_design_wlr$failRates, +# weight = wgt05, +# events = c(100, 150, 250), +# analysisTimes = NULL, +# upper = upper, +# upar = upar, +# lower = lower, +# lpar = lpar +# ) +``` + +# Default Summary Table Production + +Instead of outputting 4 detailed tables (a table of enrollment rates, a table of failure rates, a table of analysis summary, a table of bounds summary), users can get a com pensive summary table by calling `summary(x)`, where `x` is the object returned either by `gs_design_ahr` or `gs_design_wlr`. +The `summary()` function produces an overall summary table for bounds for publication in a protocol. + +For example, the default output of `summary()` for the AHR method is +```{r} +x_design_ahr %>% + summary() %>% + gt::gt() %>% + gt::fmt_number(columns = c(3:6), decimals = 4) +``` + +Please note the `summary()` can also be applied to objected returned by `gs_power_ahr()`. +For example, +```{r} +x_power_ahr %>% + summary() %>% + gt::gt() %>% + gt::fmt_number(columns = c(3:6), decimals = 4) +``` + + +And the default output of `summary()` for the WLR method is + +```{r} +x_design_wlr %>% + summary() %>% + gt::gt() %>% + gt::fmt_number(columns = c(3:6), decimals = 4) +``` + +Note that `summary()` can also be applied to summarize an object returned by `gs_power_wlr()`. +```{r, eval=FALSE} +summary(x_power_wlr) %>% + gt::gt() %>% + gt::fmt_number(columns = c(3:6), decimals = 4) +``` + + +# Detailed Summary Table Formatting + +Here we demonstrate options for formatting analysis rows, bound rows as well as other table parameters such as titles, labels and footnotes. + +## Custom the Variables to be Summaried for Each Analysis + +In the above default table summary table generated by `summary(x)`, the variables used to summarize each analysis includes `Analysis`, `Time`, `N`(sample size), `Events`, `AHR`, and `IF` (information fraction). +But users can customize these variables chosen using `analysis_vars = ...` and the corresponding decimals displayed using the argument `analysis_decimals = ...`. +For example +```{r} +x_design_ahr %>% + summary(analysis_vars = c("N", "Events"), + analysis_decimals = c(1, 1)) %>% + gt::gt() %>% + gt::fmt_number(columns = c(3:6), decimals = 4) +``` + +Please note that there is no need to input `"Analysis"` into `analysis_vars = ...` as it will always appear. + +## Custom the Bound Names + +Users can also customize the bound names. +In the default output generated by `summary(x)`, the bound name is `c("Efficacy", "Futility")`, which can be changed into `c("A is better", "B is better")` for a 2-sided design by using the argument `bound_names = ...`. +For example, + +```{r, message=FALSE} +x_design_ahr %>% + summary(bound_names = c("A is better", "B is better")) %>% + mutate_if(is.numeric, round, digits = 4) %>% + gt::gt() %>% + gt::fmt_number(columns = c(3:6), decimals = 4) +``` + +## Custom into a gt Table and Add Title/SubTitle/Footnotes/Spanners + +Users can also use `as_gt()` to get the the above R table into a gt table. +Furthermore, they can edit the title/subtitle/spanner/footnotes of the gt table by using the arguments in `summary`. + +```{r} +summary(x_design_ahr) %>% + as_gt(title = "Summary of the Crossing Probability", + subtitle = "by Using gs_design_ahr", + colname_spanner = "Cumulative boundary crossing probability", + colname_spannersub = c("Alternate hypothesis", "Null hypothesis"), + footnote = list(content = c("approximate hazard ratio to cross bound.", + "gs_design_ahr is a function in gsDesign2.", + "AHR is average hazard ratio; IF is information fraction."), + location = c("~HR at bound", NA, NA), + attr = c("colname", "subtitle", "analysis"))) +``` + +The above objective can also be realized by using functions in the R package `gt` for custom design of table layout. +We note that `as_gt()` always produces a `gt` object and, thus, can be further customized with **gt** package formatting functions. +In the future, we to support rich text format using a function `as_rtf()` in a fashion similar to `as_gt()`. + +## Custom the Variables to Display + +Users can select the variables to be displayed in the summary table by using the argument `display_colunm = ...`. +```{r} +x_design_ahr %>% + summary() %>% + as_gt(display_columns = c("Analysis", "Bound", "Z", "Probability")) +``` + +## Custom Whether to Show Infinity Bound or Not + +Users have options to either show the infinity bounds or not by taking advantage of `display_inf_bound = ...`. +```{r} +x_design_ahr %>% + summary() %>% + as_gt(display_inf_bound = FALSE) +``` + + + +# Details of Output from Design/Power Functions + +There are four components in the objects returned by either `gs_design_ahr()`/`gs_design_wlr()` or `gs_power_ahr()`/`gs_power_wlr()`: +1. failure rates: a table summarizing failure rate and dropout rate. +1. enrollment rates: a table summarizing the enrollment rate. +1. bounds: a table summarize the bound of each analysis. +1. analysis: a table summarize the each analysis, with each one row for one analysis one hypothsis. + +## Failure Rates + +The failure rates of different gsDesign object can be obtained by using `x$failRates`, where `x` is the object returned either by `gs_design_ahr` or `gs_design_wlr`. +For example, the failure rates of the AHR design derivation can be returned by calling +```{r} +x_design_ahr$failRates %>% + gt::gt() %>% + gt::fmt_number(columns = 3:5, decimals = 4) +``` + +Please note that both `x_design_ahr` and `x_wlr` returns the same failure rates, which is the same as that inputted as `failRates`. +To verify, let's take a look at the failure rate of the WLR design derivation, which are shown as below. + +```{r} +x_design_wlr$failRates %>% + gt::gt() %>% + gt::fmt_number(columns = 3:5, decimals = 4) +``` + + +## Enrollment + +The enrollment rate of a gs design derivation can be collected by using `x$failRates`, where `x` is the object returned either by `gs_design_ahr` or `gs_design_wlr`. +For example, the enrollment rates of the AHR/WLR design derivation is + +```{r} +x_design_ahr$enrollRates %>% + gt::gt() %>% + gt::fmt_number(columns = 3, decimals = 4) +``` + +```{r} +x_design_wlr$enrollRates %>% + gt::gt() %>% + gt::fmt_number(columns = 3, decimals = 4) +``` + +It can be seen that, although the design derivation is different, the enrollment rate table share the same table structure, same enrollment period durations for each rate. +Yet, the enrollment rates differ between designs only by a multiplicative constant. + +## Analysis + +The analysis summary table has the structure of one row per analysis per hypothesis. +And columns can vary with different defaults for each design option. +This type of tables are useful for understanding commonalities in how designs are summarized for different models. +To get analysis summary table, users can call `x$analysis`, where `x` is the object returned either by `gs_design_ahr` or `gs_design_wlr`. +For example, the analysis summary of the AHR/WLR design derivation is +```{r} +x_design_ahr$analysis %>% + gt::gt() %>% + gt::fmt_number(columns = 2:8, decimals = 4) +``` + +```{r} +x_design_wlr$analysis %>% + gt::gt() %>% + gt::fmt_number(columns = 2:8, decimals = 4) +``` + + +## Bounds + +The analysis summary table has the structure of One row per analysis per bound per hypothesis. Columns can vary with different defaults for each design option. +To get a bouns summary table, users can call `x$analysis`, where `x` is the object returned either by `gs_design_ahr` or `gs_design_wlr`. +For example, the bounds summary of the AHR/WLR design derivation is + +```{r} +x_design_ahr$bounds %>% + gt::gt() %>% + gt::fmt_number(columns = c(3, 5:7), decimals = 4) +``` + +```{r} +x_design_wlr$bounds %>% + gt::gt() %>% + gt::fmt_number(columns = c(3, 5:7), decimals = 4) +``` + + +# References diff --git a/vignettes/usage_tEvents.Rmd b/vignettes/usage_tEvents.Rmd new file mode 100644 index 000000000..743d99647 --- /dev/null +++ b/vignettes/usage_tEvents.Rmd @@ -0,0 +1,106 @@ +--- +title: "tEvents: compute time when a targeted number of events is made" +output: + rmarkdown::html_document: + toc: true + toc_float: true + toc_depth: 2 + number_sections: true + highlight: "textmate" + css: "custom.css" +vignette: > + %\VignetteEngine{knitr::rmarkdown} + %\VignetteIndexEntry{tEvents: compute time when a targeted number of events is made} +--- + + +```{r, essage=FALSE, echo=FALSE} +knitr::opts_chunk$set(fig.width = 5, fig.height = 4, fig.align = 'center') +``` + +```{r, message=FALSE, echo=FALSE} +library(gt) +library(tibble) +library(dplyr) +library(testthat) +#library(gsDesign2) +devtools::load_all() +``` + +# Introduction of `tEvents` + +`tEvents()` predicts time at which a targeted events is made. +It is designed as a twins to `AHR()`: it matches input/output format with `AHR()`. + +# Use Cases + +## Example 1: +```{r} +enrollRates <- tibble(Stratum = "All", duration = c(2, 2, 10), rate = c(3, 6, 9) * 5) +failRates <- tibble(Stratum = "All", duration = c(3, 100), failRate = log(2) / c(9, 18), hr = c(.9, .6), dropoutRate = rep(.001, 2)) +ratio <- 1 + +x <- tEvents(enrollRates = enrollRates, failRates = failRates, + ratio = ratio, targetEvents = 200) + +x %>% gt() +``` + +## Example 2: + +In this example, we verify `tEvents()` by `AHR()`. +```{r} +enrollRates <- tibble(Stratum = "All", duration = c(2, 2, 10), rate = c(3, 6, 9) * 5) +failRates <- tibble(Stratum = "All", duration = c(3, 100), failRate = log(2) / c(9, 18), hr = c(.9, .6), dropoutRate = rep(.001, 2)) +ratio <- 1 + +x <- AHR(enrollRates = enrollRates, failRates = failRates, + ratio = ratio, totalDuration = 20) +cat("The number of events by 20 months is ", x$Events, ".\n") + +y <- tEvents(enrollRates = enrollRates, failRates = failRates, + ratio = ratio, targetEvents = x$Events) + +cat("The time to get ", x$Events, " is ", y$Time, "months.\n") +``` + + + + + +# Inner Logic of `tEvents()` + +The inner logic of `tEvents()` is to uniroot `AHR()` on `totalDuration`. + +**Step 1:** find the difference between `AHR()` and different values of `totalDuration`. +```{r} +foo <- function(x){ + ans <- AHR(enrollRates = enrollRates, failRates = failRates, + totalDuration = x, ratio = ratio)$Events - targetEvents + return(ans) +} +``` + + +```{r} +enrollRates <- tibble(Stratum = "All", duration = c(2, 2, 10), rate = c(3, 6, 9) * 5) +failRates <- tibble(Stratum = "All", duration = c(3, 100), failRate = log(2) / c(9, 18), hr = c(.9, .6), dropoutRate = rep(.001, 2)) +ratio <- 1 +targetEvents <- 200 + +cat("The difference between `targetEvents = 200` and the events after 30 months is ", foo(30), ".\n") +``` + + +**Step 2:** uniroot `AHR()` on `totalDuration`. +```{r} +res <- uniroot(foo, interval = c(0.01, 100)) + +ans <- AHR(enrollRates = enrollRates, failRates = failRates, + totalDuration = res$root, ratio = ratio) +cat("After ", ans$Time, " months, there will be ", targetEvents, " events .\n") +``` + + + +