From e360aade759662f198b1c63b60237ff6211ec620 Mon Sep 17 00:00:00 2001 From: John Blischak Date: Fri, 8 May 2026 14:23:09 -0400 Subject: [PATCH] Clean up repository --- ..Rcheck/00check.log | 14 - .Rbuildignore | 2 + .gitignore | 2 + R/generate_event_cc.R | 9 +- R/generate_event_ol.R | 15 +- R/generate_event_table_.R | 21 +- .../aiprompts/EventTable_README.md | 0 man/generate_event_table_.Rd | 21 +- man/generate_event_table_cc.Rd | 9 +- man/generate_event_table_ol.Rd | 15 +- vignettes/.gitignore | 1 + vignettes/adj-seq-p.html | 2960 ------- vignettes/corr_calculation.Rmd | 2 +- wpgsd.Rcheck/00_pkg_src/wpgsd/DESCRIPTION | 45 - .../00_pkg_src/wpgsd/EventTable_README.md | 124 - wpgsd.Rcheck/00_pkg_src/wpgsd/NAMESPACE | 37 - wpgsd.Rcheck/00_pkg_src/wpgsd/NEWS.md | 17 - wpgsd.Rcheck/00_pkg_src/wpgsd/R/calc_seq_p.R | 144 - wpgsd.Rcheck/00_pkg_src/wpgsd/R/closed_test.R | 102 - wpgsd.Rcheck/00_pkg_src/wpgsd/R/d_corr.R | 33 - wpgsd.Rcheck/00_pkg_src/wpgsd/R/find_astar.R | 90 - wpgsd.Rcheck/00_pkg_src/wpgsd/R/find_xi.R | 90 - .../00_pkg_src/wpgsd/R/generate_bounds.R | 326 - .../00_pkg_src/wpgsd/R/generate_corr.R | 112 - .../00_pkg_src/wpgsd/R/generate_event_cc.R | 80 - .../00_pkg_src/wpgsd/R/generate_event_ol.R | 94 - .../00_pkg_src/wpgsd/R/generate_event_table.R | 112 - .../wpgsd/R/generate_event_table_.R | 73 - wpgsd.Rcheck/00_pkg_src/wpgsd/R/globals.R | 32 - wpgsd.Rcheck/00_pkg_src/wpgsd/R/s7_classes.R | 165 - .../00_pkg_src/wpgsd/R/utils-tidy-eval.R | 107 - .../00_pkg_src/wpgsd/R/wpgsd-package.R | 3 - wpgsd.Rcheck/00_pkg_src/wpgsd/README.md | 62 - .../00_pkg_src/wpgsd/build/partial.rdb | Bin 60 -> 0 bytes .../00_pkg_src/wpgsd/build/vignette.rds | Bin 362 -> 0 bytes .../wpgsd/examples/event_table_integration.R | 71 - .../wpgsd/examples/test_event_table.R | 50 - wpgsd.Rcheck/00_pkg_src/wpgsd/inst/CITATION | 12 - .../compute_correlations_prompts.txt | 76 - .../wpgsd/inst/aiprompts/s7 prompts.md | 101 - .../00_pkg_src/wpgsd/inst/doc/adj-seq-p.R | 739 -- .../00_pkg_src/wpgsd/inst/doc/adj-seq-p.Rmd | 810 -- .../00_pkg_src/wpgsd/inst/doc/adj-seq-p.html | 3399 ------- .../wpgsd/inst/doc/corr_calculation.R | 86 - .../wpgsd/inst/doc/corr_calculation.Rmd | 180 - .../wpgsd/inst/doc/corr_calculation.html | 4137 --------- .../wpgsd/inst/doc/tech-detail-wb.R | 477 - .../wpgsd/inst/doc/tech-detail-wb.Rmd | 599 -- .../wpgsd/inst/doc/tech-detail-wb.html | 7117 --------------- .../00_pkg_src/wpgsd/inst/doc/wpgsd.R | 335 - .../00_pkg_src/wpgsd/inst/doc/wpgsd.Rmd | 591 -- .../00_pkg_src/wpgsd/inst/doc/wpgsd.html | 7846 ----------------- .../wpgsd/inst/extdata/adsl.sas7bdat | Bin 139264 -> 0 bytes .../wpgsd/inst/extdata/adtte.sas7bdat | Bin 45056 -> 0 bytes .../00_pkg_src/wpgsd/man/calc_seq_p.Rd | 101 - .../00_pkg_src/wpgsd/man/closed_test.Rd | 38 - .../00_pkg_src/wpgsd/man/figures/logo.png | Bin 5934 -> 0 bytes .../00_pkg_src/wpgsd/man/figures/logo.xcf | Bin 763172 -> 0 bytes .../00_pkg_src/wpgsd/man/find_astar.Rd | 78 - wpgsd.Rcheck/00_pkg_src/wpgsd/man/find_xi.Rd | 75 - .../00_pkg_src/wpgsd/man/generate_bounds.Rd | 135 - .../00_pkg_src/wpgsd/man/generate_corr.Rd | 50 - .../wpgsd/man/generate_event_table.Rd | 58 - wpgsd.Rcheck/00_pkg_src/wpgsd/man/tidyeval.Rd | 98 - .../00_pkg_src/wpgsd/man/wpgsd-package.Rd | 41 - .../00_pkg_src/wpgsd/tests/testthat.R | 4 - .../tests/testthat/helper-generate_corr_new.R | 126 - ...per-generate_event_commoncontrol_addhypo.R | 23 - ...eloper-generate_event_population_addhypo.R | 23 - .../testthat/test-independent-closed_test.R | 25 - .../test-independent-generate_bounds.R | 580 -- .../testthat/test-independent-generate_corr.R | 31 - .../test-independent-generate_corr_new.R | 62 - .../tests/testthat/test-s7-event-table.R | 171 - .../00_pkg_src/wpgsd/vignettes/adj-seq-p.Rmd | 810 -- .../wpgsd/vignettes/corr_calculation.Rmd | 180 - .../00_pkg_src/wpgsd/vignettes/custom.css | 122 - .../wpgsd/vignettes/figures/ex1-pop.png | Bin 25014 -> 0 bytes .../wpgsd/vignettes/tech-detail-wb.Rmd | 599 -- .../00_pkg_src/wpgsd/vignettes/wpgsd.Rmd | 591 -- .../00_pkg_src/wpgsd/vignettes/wpgsd.bib | 53 - wpgsd.Rcheck/00check.log | 89 - wpgsd.Rcheck/00install.out | 15 - wpgsd.Rcheck/build_vignettes.log | 0 wpgsd.Rcheck/tests/startup.Rs | 4 - wpgsd.Rcheck/tests/testthat.R | 4 - wpgsd.Rcheck/tests/testthat.Rout.fail | 53 - .../tests/testthat/helper-generate_corr_new.R | 126 - ...per-generate_event_commoncontrol_addhypo.R | 23 - ...eloper-generate_event_population_addhypo.R | 23 - .../testthat/test-independent-closed_test.R | 25 - .../test-independent-generate_bounds.R | 580 -- .../testthat/test-independent-generate_corr.R | 31 - .../test-independent-generate_corr_new.R | 62 - .../tests/testthat/test-s7-event-table.R | 171 - .../tests/testthat/testthat-problems.rds | Bin 13706 -> 0 bytes wpgsd.Rcheck/vign_test/wpgsd/DESCRIPTION | 45 - .../vign_test/wpgsd/EventTable_README.md | 124 - wpgsd.Rcheck/vign_test/wpgsd/NAMESPACE | 37 - wpgsd.Rcheck/vign_test/wpgsd/NEWS.md | 17 - wpgsd.Rcheck/vign_test/wpgsd/R/calc_seq_p.R | 144 - wpgsd.Rcheck/vign_test/wpgsd/R/closed_test.R | 102 - wpgsd.Rcheck/vign_test/wpgsd/R/d_corr.R | 33 - wpgsd.Rcheck/vign_test/wpgsd/R/find_astar.R | 90 - wpgsd.Rcheck/vign_test/wpgsd/R/find_xi.R | 90 - .../vign_test/wpgsd/R/generate_bounds.R | 326 - .../vign_test/wpgsd/R/generate_corr.R | 112 - .../vign_test/wpgsd/R/generate_event_cc.R | 80 - .../vign_test/wpgsd/R/generate_event_ol.R | 94 - .../vign_test/wpgsd/R/generate_event_table.R | 112 - .../vign_test/wpgsd/R/generate_event_table_.R | 73 - wpgsd.Rcheck/vign_test/wpgsd/R/globals.R | 32 - wpgsd.Rcheck/vign_test/wpgsd/R/s7_classes.R | 165 - .../vign_test/wpgsd/R/utils-tidy-eval.R | 107 - .../vign_test/wpgsd/R/wpgsd-package.R | 3 - wpgsd.Rcheck/vign_test/wpgsd/README.md | 62 - .../vign_test/wpgsd/build/partial.rdb | Bin 60 -> 0 bytes .../vign_test/wpgsd/build/vignette.rds | Bin 362 -> 0 bytes .../wpgsd/examples/event_table_integration.R | 71 - .../wpgsd/examples/test_event_table.R | 50 - wpgsd.Rcheck/vign_test/wpgsd/inst/CITATION | 12 - .../compute_correlations_prompts.txt | 76 - .../wpgsd/inst/aiprompts/s7 prompts.md | 101 - .../vign_test/wpgsd/inst/doc/adj-seq-p.R | 739 -- .../vign_test/wpgsd/inst/doc/adj-seq-p.Rmd | 810 -- .../vign_test/wpgsd/inst/doc/adj-seq-p.html | 3399 ------- .../wpgsd/inst/doc/corr_calculation.R | 86 - .../wpgsd/inst/doc/corr_calculation.Rmd | 180 - .../wpgsd/inst/doc/corr_calculation.html | 4137 --------- .../vign_test/wpgsd/inst/doc/tech-detail-wb.R | 477 - .../wpgsd/inst/doc/tech-detail-wb.Rmd | 599 -- .../wpgsd/inst/doc/tech-detail-wb.html | 7117 --------------- wpgsd.Rcheck/vign_test/wpgsd/inst/doc/wpgsd.R | 335 - .../vign_test/wpgsd/inst/doc/wpgsd.Rmd | 591 -- .../vign_test/wpgsd/inst/doc/wpgsd.html | 7846 ----------------- .../wpgsd/inst/extdata/adsl.sas7bdat | Bin 139264 -> 0 bytes .../wpgsd/inst/extdata/adtte.sas7bdat | Bin 45056 -> 0 bytes .../vign_test/wpgsd/man/calc_seq_p.Rd | 101 - .../vign_test/wpgsd/man/closed_test.Rd | 38 - .../vign_test/wpgsd/man/figures/logo.png | Bin 5934 -> 0 bytes .../vign_test/wpgsd/man/figures/logo.xcf | Bin 763172 -> 0 bytes .../vign_test/wpgsd/man/find_astar.Rd | 78 - wpgsd.Rcheck/vign_test/wpgsd/man/find_xi.Rd | 75 - .../vign_test/wpgsd/man/generate_bounds.Rd | 135 - .../vign_test/wpgsd/man/generate_corr.Rd | 50 - .../wpgsd/man/generate_event_table.Rd | 58 - wpgsd.Rcheck/vign_test/wpgsd/man/tidyeval.Rd | 98 - .../vign_test/wpgsd/man/wpgsd-package.Rd | 41 - wpgsd.Rcheck/vign_test/wpgsd/tests/testthat.R | 4 - .../tests/testthat/helper-generate_corr_new.R | 126 - ...per-generate_event_commoncontrol_addhypo.R | 23 - ...eloper-generate_event_population_addhypo.R | 23 - .../testthat/test-independent-closed_test.R | 25 - .../test-independent-generate_bounds.R | 580 -- .../testthat/test-independent-generate_corr.R | 31 - .../test-independent-generate_corr_new.R | 62 - .../tests/testthat/test-s7-event-table.R | 171 - .../wpgsd/vignettes/.build.timestamp | 0 .../vign_test/wpgsd/vignettes/adj-seq-p.R | 384 - .../vign_test/wpgsd/vignettes/adj-seq-p.Rmd | 810 -- .../figure-html/unnamed-chunk-6-1.png | Bin 111496 -> 0 bytes .../wpgsd/vignettes/corr_calculation.Rmd | 180 - .../vign_test/wpgsd/vignettes/custom.css | 122 - .../wpgsd/vignettes/figures/ex1-pop.png | Bin 25014 -> 0 bytes .../wpgsd/vignettes/tech-detail-wb.Rmd | 599 -- .../vign_test/wpgsd/vignettes/wpgsd.Rmd | 591 -- .../vign_test/wpgsd/vignettes/wpgsd.bib | 53 - wpgsd.Rcheck/wpgsd-Ex.R | 298 - wpgsd.Rcheck/wpgsd-Ex.Rout | 842 -- wpgsd.Rcheck/wpgsd-Ex.pdf | Bin 3611 -> 0 bytes wpgsd.Rcheck/wpgsd/CITATION | 12 - wpgsd.Rcheck/wpgsd/DESCRIPTION | 46 - wpgsd.Rcheck/wpgsd/INDEX | 16 - wpgsd.Rcheck/wpgsd/Meta/Rd.rds | Bin 728 -> 0 bytes wpgsd.Rcheck/wpgsd/Meta/features.rds | Bin 122 -> 0 bytes wpgsd.Rcheck/wpgsd/Meta/hsearch.rds | Bin 727 -> 0 bytes wpgsd.Rcheck/wpgsd/Meta/links.rds | Bin 293 -> 0 bytes wpgsd.Rcheck/wpgsd/Meta/nsInfo.rds | Bin 481 -> 0 bytes wpgsd.Rcheck/wpgsd/Meta/package.rds | Bin 1517 -> 0 bytes wpgsd.Rcheck/wpgsd/Meta/vignette.rds | Bin 362 -> 0 bytes wpgsd.Rcheck/wpgsd/NAMESPACE | 37 - wpgsd.Rcheck/wpgsd/NEWS.md | 17 - wpgsd.Rcheck/wpgsd/R/wpgsd | 27 - wpgsd.Rcheck/wpgsd/R/wpgsd.rdb | Bin 32693 -> 0 bytes wpgsd.Rcheck/wpgsd/R/wpgsd.rdx | Bin 504 -> 0 bytes .../compute_correlations_prompts.txt | 76 - wpgsd.Rcheck/wpgsd/aiprompts/s7 prompts.md | 101 - wpgsd.Rcheck/wpgsd/doc/adj-seq-p.R | 739 -- wpgsd.Rcheck/wpgsd/doc/adj-seq-p.Rmd | 810 -- wpgsd.Rcheck/wpgsd/doc/adj-seq-p.html | 3399 ------- wpgsd.Rcheck/wpgsd/doc/corr_calculation.R | 86 - wpgsd.Rcheck/wpgsd/doc/corr_calculation.Rmd | 180 - wpgsd.Rcheck/wpgsd/doc/corr_calculation.html | 4137 --------- wpgsd.Rcheck/wpgsd/doc/index.html | 44 - wpgsd.Rcheck/wpgsd/doc/tech-detail-wb.R | 477 - wpgsd.Rcheck/wpgsd/doc/tech-detail-wb.Rmd | 599 -- wpgsd.Rcheck/wpgsd/doc/tech-detail-wb.html | 7117 --------------- wpgsd.Rcheck/wpgsd/doc/wpgsd.R | 335 - wpgsd.Rcheck/wpgsd/doc/wpgsd.Rmd | 591 -- wpgsd.Rcheck/wpgsd/doc/wpgsd.html | 7846 ----------------- wpgsd.Rcheck/wpgsd/extdata/adsl.sas7bdat | Bin 139264 -> 0 bytes wpgsd.Rcheck/wpgsd/extdata/adtte.sas7bdat | Bin 45056 -> 0 bytes wpgsd.Rcheck/wpgsd/help/AnIndex | 16 - wpgsd.Rcheck/wpgsd/help/aliases.rds | Bin 226 -> 0 bytes wpgsd.Rcheck/wpgsd/help/figures/logo.png | Bin 5934 -> 0 bytes wpgsd.Rcheck/wpgsd/help/paths.rds | Bin 246 -> 0 bytes wpgsd.Rcheck/wpgsd/help/wpgsd.rdb | Bin 29044 -> 0 bytes wpgsd.Rcheck/wpgsd/help/wpgsd.rdx | Bin 377 -> 0 bytes wpgsd.Rcheck/wpgsd/html/00Index.html | 41 - wpgsd.Rcheck/wpgsd/html/R.css | 130 - wpgsd_0.1.0.tar.gz | Bin 1931373 -> 0 bytes wpgsd_0.2.0.tar.gz | Bin 1935382 -> 0 bytes 212 files changed, 62 insertions(+), 97714 deletions(-) delete mode 100644 ..Rcheck/00check.log rename EventTable_README.md => inst/aiprompts/EventTable_README.md (100%) create mode 100644 vignettes/.gitignore delete mode 100644 vignettes/adj-seq-p.html delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/DESCRIPTION delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/EventTable_README.md delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/NAMESPACE delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/NEWS.md delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/R/calc_seq_p.R delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/R/closed_test.R delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/R/d_corr.R delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/R/find_astar.R delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/R/find_xi.R delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/R/generate_bounds.R delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/R/generate_corr.R delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/R/generate_event_cc.R delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/R/generate_event_ol.R delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/R/generate_event_table.R delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/R/generate_event_table_.R delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/R/globals.R delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/R/s7_classes.R delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/R/utils-tidy-eval.R delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/R/wpgsd-package.R delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/README.md delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/build/partial.rdb delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/build/vignette.rds delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/examples/event_table_integration.R delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/examples/test_event_table.R delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/inst/CITATION delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/inst/aiprompts/compute_correlations_prompts.txt delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/inst/aiprompts/s7 prompts.md delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/adj-seq-p.R delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/adj-seq-p.Rmd delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/adj-seq-p.html delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/corr_calculation.R delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/corr_calculation.Rmd delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/corr_calculation.html delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/tech-detail-wb.R delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/tech-detail-wb.Rmd delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/tech-detail-wb.html delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/wpgsd.R delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/wpgsd.Rmd delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/wpgsd.html delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/inst/extdata/adsl.sas7bdat delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/inst/extdata/adtte.sas7bdat delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/man/calc_seq_p.Rd delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/man/closed_test.Rd delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/man/figures/logo.png delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/man/figures/logo.xcf delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/man/find_astar.Rd delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/man/find_xi.Rd delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/man/generate_bounds.Rd delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/man/generate_corr.Rd delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/man/generate_event_table.Rd delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/man/tidyeval.Rd delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/man/wpgsd-package.Rd delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat.R delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/helper-generate_corr_new.R delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-developer-generate_event_commoncontrol_addhypo.R delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-developer-generate_event_population_addhypo.R delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-independent-closed_test.R delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-independent-generate_bounds.R delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-independent-generate_corr.R delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-independent-generate_corr_new.R delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-s7-event-table.R delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/adj-seq-p.Rmd delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/corr_calculation.Rmd delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/custom.css delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/figures/ex1-pop.png delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/tech-detail-wb.Rmd delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/wpgsd.Rmd delete mode 100644 wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/wpgsd.bib delete mode 100644 wpgsd.Rcheck/00check.log delete mode 100644 wpgsd.Rcheck/00install.out delete mode 100644 wpgsd.Rcheck/build_vignettes.log delete mode 100644 wpgsd.Rcheck/tests/startup.Rs delete mode 100644 wpgsd.Rcheck/tests/testthat.R delete mode 100644 wpgsd.Rcheck/tests/testthat.Rout.fail delete mode 100644 wpgsd.Rcheck/tests/testthat/helper-generate_corr_new.R delete mode 100644 wpgsd.Rcheck/tests/testthat/test-developer-generate_event_commoncontrol_addhypo.R delete mode 100644 wpgsd.Rcheck/tests/testthat/test-developer-generate_event_population_addhypo.R delete mode 100644 wpgsd.Rcheck/tests/testthat/test-independent-closed_test.R delete mode 100644 wpgsd.Rcheck/tests/testthat/test-independent-generate_bounds.R delete mode 100644 wpgsd.Rcheck/tests/testthat/test-independent-generate_corr.R delete mode 100644 wpgsd.Rcheck/tests/testthat/test-independent-generate_corr_new.R delete mode 100644 wpgsd.Rcheck/tests/testthat/test-s7-event-table.R delete mode 100644 wpgsd.Rcheck/tests/testthat/testthat-problems.rds delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/DESCRIPTION delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/EventTable_README.md delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/NAMESPACE delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/NEWS.md delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/R/calc_seq_p.R delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/R/closed_test.R delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/R/d_corr.R delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/R/find_astar.R delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/R/find_xi.R delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/R/generate_bounds.R delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/R/generate_corr.R delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/R/generate_event_cc.R delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/R/generate_event_ol.R delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/R/generate_event_table.R delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/R/generate_event_table_.R delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/R/globals.R delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/R/s7_classes.R delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/R/utils-tidy-eval.R delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/R/wpgsd-package.R delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/README.md delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/build/partial.rdb delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/build/vignette.rds delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/examples/event_table_integration.R delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/examples/test_event_table.R delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/inst/CITATION delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/inst/aiprompts/compute_correlations_prompts.txt delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/inst/aiprompts/s7 prompts.md delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/inst/doc/adj-seq-p.R delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/inst/doc/adj-seq-p.Rmd delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/inst/doc/adj-seq-p.html delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/inst/doc/corr_calculation.R delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/inst/doc/corr_calculation.Rmd delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/inst/doc/corr_calculation.html delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/inst/doc/tech-detail-wb.R delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/inst/doc/tech-detail-wb.Rmd delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/inst/doc/tech-detail-wb.html delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/inst/doc/wpgsd.R delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/inst/doc/wpgsd.Rmd delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/inst/doc/wpgsd.html delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/inst/extdata/adsl.sas7bdat delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/inst/extdata/adtte.sas7bdat delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/man/calc_seq_p.Rd delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/man/closed_test.Rd delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/man/figures/logo.png delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/man/figures/logo.xcf delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/man/find_astar.Rd delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/man/find_xi.Rd delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/man/generate_bounds.Rd delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/man/generate_corr.Rd delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/man/generate_event_table.Rd delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/man/tidyeval.Rd delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/man/wpgsd-package.Rd delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/tests/testthat.R delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/helper-generate_corr_new.R delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-developer-generate_event_commoncontrol_addhypo.R delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-developer-generate_event_population_addhypo.R delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-independent-closed_test.R delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-independent-generate_bounds.R delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-independent-generate_corr.R delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-independent-generate_corr_new.R delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-s7-event-table.R delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/vignettes/.build.timestamp delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/vignettes/adj-seq-p.R delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/vignettes/adj-seq-p.Rmd delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/vignettes/adj-seq-p_files/figure-html/unnamed-chunk-6-1.png delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/vignettes/corr_calculation.Rmd delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/vignettes/custom.css delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/vignettes/figures/ex1-pop.png delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/vignettes/tech-detail-wb.Rmd delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/vignettes/wpgsd.Rmd delete mode 100644 wpgsd.Rcheck/vign_test/wpgsd/vignettes/wpgsd.bib delete mode 100644 wpgsd.Rcheck/wpgsd-Ex.R delete mode 100644 wpgsd.Rcheck/wpgsd-Ex.Rout delete mode 100644 wpgsd.Rcheck/wpgsd-Ex.pdf delete mode 100644 wpgsd.Rcheck/wpgsd/CITATION delete mode 100644 wpgsd.Rcheck/wpgsd/DESCRIPTION delete mode 100644 wpgsd.Rcheck/wpgsd/INDEX delete mode 100644 wpgsd.Rcheck/wpgsd/Meta/Rd.rds delete mode 100644 wpgsd.Rcheck/wpgsd/Meta/features.rds delete mode 100644 wpgsd.Rcheck/wpgsd/Meta/hsearch.rds delete mode 100644 wpgsd.Rcheck/wpgsd/Meta/links.rds delete mode 100644 wpgsd.Rcheck/wpgsd/Meta/nsInfo.rds delete mode 100644 wpgsd.Rcheck/wpgsd/Meta/package.rds delete mode 100644 wpgsd.Rcheck/wpgsd/Meta/vignette.rds delete mode 100644 wpgsd.Rcheck/wpgsd/NAMESPACE delete mode 100644 wpgsd.Rcheck/wpgsd/NEWS.md delete mode 100644 wpgsd.Rcheck/wpgsd/R/wpgsd delete mode 100644 wpgsd.Rcheck/wpgsd/R/wpgsd.rdb delete mode 100644 wpgsd.Rcheck/wpgsd/R/wpgsd.rdx delete mode 100644 wpgsd.Rcheck/wpgsd/aiprompts/compute_correlations_prompts.txt delete mode 100644 wpgsd.Rcheck/wpgsd/aiprompts/s7 prompts.md delete mode 100644 wpgsd.Rcheck/wpgsd/doc/adj-seq-p.R delete mode 100644 wpgsd.Rcheck/wpgsd/doc/adj-seq-p.Rmd delete mode 100644 wpgsd.Rcheck/wpgsd/doc/adj-seq-p.html delete mode 100644 wpgsd.Rcheck/wpgsd/doc/corr_calculation.R delete mode 100644 wpgsd.Rcheck/wpgsd/doc/corr_calculation.Rmd delete mode 100644 wpgsd.Rcheck/wpgsd/doc/corr_calculation.html delete mode 100644 wpgsd.Rcheck/wpgsd/doc/index.html delete mode 100644 wpgsd.Rcheck/wpgsd/doc/tech-detail-wb.R delete mode 100644 wpgsd.Rcheck/wpgsd/doc/tech-detail-wb.Rmd delete mode 100644 wpgsd.Rcheck/wpgsd/doc/tech-detail-wb.html delete mode 100644 wpgsd.Rcheck/wpgsd/doc/wpgsd.R delete mode 100644 wpgsd.Rcheck/wpgsd/doc/wpgsd.Rmd delete mode 100644 wpgsd.Rcheck/wpgsd/doc/wpgsd.html delete mode 100644 wpgsd.Rcheck/wpgsd/extdata/adsl.sas7bdat delete mode 100644 wpgsd.Rcheck/wpgsd/extdata/adtte.sas7bdat delete mode 100644 wpgsd.Rcheck/wpgsd/help/AnIndex delete mode 100644 wpgsd.Rcheck/wpgsd/help/aliases.rds delete mode 100644 wpgsd.Rcheck/wpgsd/help/figures/logo.png delete mode 100644 wpgsd.Rcheck/wpgsd/help/paths.rds delete mode 100644 wpgsd.Rcheck/wpgsd/help/wpgsd.rdb delete mode 100644 wpgsd.Rcheck/wpgsd/help/wpgsd.rdx delete mode 100644 wpgsd.Rcheck/wpgsd/html/00Index.html delete mode 100644 wpgsd.Rcheck/wpgsd/html/R.css delete mode 100644 wpgsd_0.1.0.tar.gz delete mode 100644 wpgsd_0.2.0.tar.gz diff --git a/..Rcheck/00check.log b/..Rcheck/00check.log deleted file mode 100644 index 78d4bc4..0000000 --- a/..Rcheck/00check.log +++ /dev/null @@ -1,14 +0,0 @@ -* using log directory ‘/Users/Anderkea/Documents/GitHub/wpgsd/..Rcheck’ -* using R version 4.5.0 (2025-04-11) -* using platform: aarch64-apple-darwin20 -* R was compiled by - Apple clang version 14.0.0 (clang-1400.0.29.202) - GNU Fortran (GCC) 14.2.0 -* running under: macOS Sequoia 15.6.1 -* using session charset: UTF-8 -* using option ‘--no-manual’ -* checking for file ‘./DESCRIPTION’ ... ERROR -Required fields missing or empty: - ‘Author’ ‘Maintainer’ -* DONE -Status: 1 ERROR diff --git a/.Rbuildignore b/.Rbuildignore index bfc2061..b0d641c 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -10,3 +10,5 @@ ^CITATION\.cff$ ^doc$ ^Meta$ +^examples$ +^inst/aiprompts$ diff --git a/.gitignore b/.gitignore index b1e2565..afb2531 100644 --- a/.gitignore +++ b/.gitignore @@ -6,3 +6,5 @@ docs /doc/ /Meta/ +*.tar.gz +*.Rcheck/ diff --git a/R/generate_event_cc.R b/R/generate_event_cc.R index 12c95d3..fd531f6 100644 --- a/R/generate_event_cc.R +++ b/R/generate_event_cc.R @@ -18,7 +18,8 @@ #' #------------------------Example of IA and FA #' event <- data.frame( #' Population = c("Experimental 1", "Experimental 2", "Experimental 3", "Control"), -#' IA = c(70, 75, 80, 85), # Interim Analysis values indicating the number of events observed in each group +#' # Interim Analysis values indicating the number of events observed in each group +#' IA = c(70, 75, 80, 85), #' FA = c(135, 150, 165, 170) #' ) #' @@ -33,8 +34,10 @@ #' #----------------------Example of two IAs and FA #' event <- data.frame( #' Population = c("Experimental 1", "Experimental 2", "Experimental 3", "Control"), -#' IA1 = c(70, 75, 80, 85), # First Interim Analysis values indicating the number of events observed in each group -#' IA2 = c(90, 95, 100, 105), # Second Interim Analysis values indicating the number of events observed in each group +#' # First Interim Analysis values indicating the number of events observed in each group +#' IA1 = c(70, 75, 80, 85), +#' # Second Interim Analysis values indicating the number of events observed in each group +#' IA2 = c(90, 95, 100, 105), #' FA = c(135, 150, 165, 170) #' ) #' diff --git a/R/generate_event_ol.R b/R/generate_event_ol.R index cf60af2..243f29b 100644 --- a/R/generate_event_ol.R +++ b/R/generate_event_ol.R @@ -22,8 +22,10 @@ #' @examples #' #------------------------Example of IA and FA #' event <- data.frame( -#' Population = c("Population 1", "Population 2", "Population 1 Intersection 2", "Overall population"), -#' IA = c(100, 110, 80, 225), # Interim Analysis values indicating the number of events observed in each group +#' Population = c("Population 1", "Population 2", "Population 1 Intersection 2", +#' "Overall population"), +#' # Interim Analysis values indicating the number of events observed in each group +#' IA = c(100, 110, 80, 225), #' FA = c(200, 220, 160, 450) #' ) #' @@ -37,9 +39,12 @@ #' #' #----------------------Example of two IAs and FA #' event <- data.frame( -#' Population = c("Population 1", "Population 2", "Population 1 Intersection 2", "Overall population"), -#' IA1 = c(100, 110, 80, 225), # First Interim Analysis values indicating the number of events observed in each group -#' IA2 = c(120, 130, 90, 240), # Second Interim Analysis values indicating the number of events observed in each group +#' Population = c("Population 1", "Population 2", "Population 1 Intersection 2", +#' "Overall population"), +#' # First Interim Analysis values indicating the number of events observed in each group +#' IA1 = c(100, 110, 80, 225), +#' # Second Interim Analysis values indicating the number of events observed in each group +#' IA2 = c(120, 130, 90, 240), #' FA = c(200, 220, 160, 450) #' ) #' diff --git a/R/generate_event_table_.R b/R/generate_event_table_.R index 8644095..a6aafda 100644 --- a/R/generate_event_table_.R +++ b/R/generate_event_table_.R @@ -27,29 +27,32 @@ #' # ----------------------- Example of common control #' event <- data.frame( #' Population = c("Experimental 1", "Experimental 2", "Experimental 3", "Control"), -#' IA = c(70, 75, 80, 85), # Interim analysis values indicating the number of events observed in each experimental group. -#' FA = c(135, 150, 165, 170) # Final analysis values indicating the cumulative number of events observed in each group. +#' # Interim analysis values indicating the number of events observed in each experimental group. +#' IA = c(70, 75, 80, 85), +#' # Final analysis values indicating the cumulative number of events observed in each group. +#' FA = c(135, 150, 165, 170) #' ) #' #' hypothesis <- list( -#' H1 = "Experimental 1 vs. Control", # Hypothesis comparing Experimental 1 with Control. -#' H2 = "Experimental 2 vs. Control", # Hypothesis comparing Experimental 2 with Control. -#' H3 = "Experimental 1 vs. Experimental 2" # Hypothesis comparing Experimental 1 and Experimental 2. +#' H1 = "Experimental 1 vs. Control", +#' H2 = "Experimental 2 vs. Control", +#' H3 = "Experimental 1 vs. Experimental 2" #' ) #' #' generate_event_table_(event, hypothesis, type = "common_control") #' #' # ------------------------ Example of overall population #' event <- data.frame( -#' Population = c("Population 1", "Population 2", "Population 1 Intersection 2", "Overall population"), +#' Population = c("Population 1", "Population 2", "Population 1 Intersection 2", +#' "Overall population"), #' IA = c(100, 110, 80, 225), # Interim analysis values for the overall population. #' FA = c(200, 220, 160, 450) # Final analysis values for the overall population. #' ) #' #' hypothesis <- list( -#' H1 = "Efficacy in Population 1", # Hypothesis assessing efficacy in Population 1. -#' H2 = "Efficacy in Population 2", # Hypothesis assessing efficacy in Population 2. -#' H3 = "Efficacy in Overall population" # Hypothesis assessing efficacy in the overall population. +#' H1 = "Efficacy in Population 1", +#' H2 = "Efficacy in Population 2", +#' H3 = "Efficacy in Overall population" #' ) #' #' generate_event_table_(event, hypothesis, type = "overlap_population") diff --git a/EventTable_README.md b/inst/aiprompts/EventTable_README.md similarity index 100% rename from EventTable_README.md rename to inst/aiprompts/EventTable_README.md diff --git a/man/generate_event_table_.Rd b/man/generate_event_table_.Rd index b088395..c72acfb 100644 --- a/man/generate_event_table_.Rd +++ b/man/generate_event_table_.Rd @@ -44,29 +44,32 @@ It can handle two types of analysis: one comparing experimental groups to a comm # ----------------------- Example of common control event <- data.frame( Population = c("Experimental 1", "Experimental 2", "Experimental 3", "Control"), - IA = c(70, 75, 80, 85), # Interim analysis values indicating the number of events observed in each experimental group. - FA = c(135, 150, 165, 170) # Final analysis values indicating the cumulative number of events observed in each group. + # Interim analysis values indicating the number of events observed in each experimental group. + IA = c(70, 75, 80, 85), + # Final analysis values indicating the cumulative number of events observed in each group. + FA = c(135, 150, 165, 170) ) hypothesis <- list( - H1 = "Experimental 1 vs. Control", # Hypothesis comparing Experimental 1 with Control. - H2 = "Experimental 2 vs. Control", # Hypothesis comparing Experimental 2 with Control. - H3 = "Experimental 1 vs. Experimental 2" # Hypothesis comparing Experimental 1 and Experimental 2. + H1 = "Experimental 1 vs. Control", + H2 = "Experimental 2 vs. Control", + H3 = "Experimental 1 vs. Experimental 2" ) generate_event_table_(event, hypothesis, type = "common_control") # ------------------------ Example of overall population event <- data.frame( - Population = c("Population 1", "Population 2", "Population 1 Intersection 2", "Overall population"), + Population = c("Population 1", "Population 2", "Population 1 Intersection 2", + "Overall population"), IA = c(100, 110, 80, 225), # Interim analysis values for the overall population. FA = c(200, 220, 160, 450) # Final analysis values for the overall population. ) hypothesis <- list( - H1 = "Efficacy in Population 1", # Hypothesis assessing efficacy in Population 1. - H2 = "Efficacy in Population 2", # Hypothesis assessing efficacy in Population 2. - H3 = "Efficacy in Overall population" # Hypothesis assessing efficacy in the overall population. + H1 = "Efficacy in Population 1", + H2 = "Efficacy in Population 2", + H3 = "Efficacy in Overall population" ) generate_event_table_(event, hypothesis, type = "overlap_population") diff --git a/man/generate_event_table_cc.Rd b/man/generate_event_table_cc.Rd index d6963f9..11480c4 100644 --- a/man/generate_event_table_cc.Rd +++ b/man/generate_event_table_cc.Rd @@ -34,7 +34,8 @@ This function generates a table of events for given experimental arms and a cont #------------------------Example of IA and FA event <- data.frame( Population = c("Experimental 1", "Experimental 2", "Experimental 3", "Control"), - IA = c(70, 75, 80, 85), # Interim Analysis values indicating the number of events observed in each group + # Interim Analysis values indicating the number of events observed in each group + IA = c(70, 75, 80, 85), FA = c(135, 150, 165, 170) ) @@ -49,8 +50,10 @@ generate_event_table_cc(event, hypothesis) #----------------------Example of two IAs and FA event <- data.frame( Population = c("Experimental 1", "Experimental 2", "Experimental 3", "Control"), - IA1 = c(70, 75, 80, 85), # First Interim Analysis values indicating the number of events observed in each group - IA2 = c(90, 95, 100, 105), # Second Interim Analysis values indicating the number of events observed in each group + # First Interim Analysis values indicating the number of events observed in each group + IA1 = c(70, 75, 80, 85), + # Second Interim Analysis values indicating the number of events observed in each group + IA2 = c(90, 95, 100, 105), FA = c(135, 150, 165, 170) ) diff --git a/man/generate_event_table_ol.Rd b/man/generate_event_table_ol.Rd index ff45b6f..70f47df 100644 --- a/man/generate_event_table_ol.Rd +++ b/man/generate_event_table_ol.Rd @@ -36,8 +36,10 @@ This function generates a table of events for specified populations based on the \examples{ #------------------------Example of IA and FA event <- data.frame( - Population = c("Population 1", "Population 2", "Population 1 Intersection 2", "Overall population"), - IA = c(100, 110, 80, 225), # Interim Analysis values indicating the number of events observed in each group + Population = c("Population 1", "Population 2", "Population 1 Intersection 2", + "Overall population"), + # Interim Analysis values indicating the number of events observed in each group + IA = c(100, 110, 80, 225), FA = c(200, 220, 160, 450) ) @@ -51,9 +53,12 @@ generate_event_table_ol(event, hypothesis) #----------------------Example of two IAs and FA event <- data.frame( - Population = c("Population 1", "Population 2", "Population 1 Intersection 2", "Overall population"), - IA1 = c(100, 110, 80, 225), # First Interim Analysis values indicating the number of events observed in each group - IA2 = c(120, 130, 90, 240), # Second Interim Analysis values indicating the number of events observed in each group + Population = c("Population 1", "Population 2", "Population 1 Intersection 2", + "Overall population"), + # First Interim Analysis values indicating the number of events observed in each group + IA1 = c(100, 110, 80, 225), + # Second Interim Analysis values indicating the number of events observed in each group + IA2 = c(120, 130, 90, 240), FA = c(200, 220, 160, 450) ) diff --git a/vignettes/.gitignore b/vignettes/.gitignore new file mode 100644 index 0000000..2d19fc7 --- /dev/null +++ b/vignettes/.gitignore @@ -0,0 +1 @@ +*.html diff --git a/vignettes/adj-seq-p.html b/vignettes/adj-seq-p.html deleted file mode 100644 index 98a667a..0000000 --- a/vignettes/adj-seq-p.html +++ /dev/null @@ -1,2960 +0,0 @@ - - - - - - - - - - - - - - -Adjusted Sequential p-values - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Adjusted Sequential p-values

- - - -
-

Introduction

-

This vignette demonstrates the calculation of adjusted sequential -p-values for multiple populations in a group sequential trial design. -We’ll show a streamlined approach using helper functions to reduce code -repetition while maintaining technical accuracy. The methods implemented -in this vignette are based on the work by Zhao et -al. (2025). The end result is a adjusted p-value at both interim -and final analysis for each hypothesis tested. In all cases, this -adjusted p-value can be compared to the family-wise error rate (FWER) -for the trial simplifying interpretation by adjusting for multiplicity -created by testing multiple hypotheses at group sequential analyses.

-
library(wpgsd)
-library(dplyr)
-library(purrr)
-library(tibble)
-library(gt)
-library(gsDesign)
-library(gMCPLite)
-
-
-

Example Overview

-

In a 2-arm controlled clinical trial with one primary endpoint, there -are 3 null hypotheses based on populations defined defined by biomarker -status. In each case the null hypothesis assumes no difference in the -distribution of the time until a primary endpoint is reached between the -treatment and control groups:

- -
-

Multiplicity Strategy

-

We will use a graphical approach to visualize the multiplicity -strategy.

-
# Transition matrix and initial weights
-m <- matrix(c(
-  0, 3/7, 4/7,
-  3/7, 0, 4/7,
-  0.5, 0.5, 0
-), nrow = 3, byrow = TRUE)
-
-w <- c(0.3, 0.3, 0.4)  # Initial weights
-
-# Visualize strategy
-name_hypotheses <- c("H1: Biomarker A positive", "H2: Biomarker B positive", "H3: Overall Population")
-
-hplot <- gMCPLite::hGraph(
-  3,
-  alphaHypotheses = w, m = m,
-  nameHypotheses = name_hypotheses, trhw = .2, trhh = .1,
-  digits = 5, trdigits = 3, size = 5, halfWid = 1, halfHgt = 0.5,
-  offset = 0.2, trprop = 0.4,
-  fill = as.factor(c(2, 3, 1)),
-  palette = c("#BDBDBD", "#E0E0E0", "#EEEEEE"),
-  wchar = "w"
-)
-hplot
-

-
-
-

Study Setup

-

We assume 2 analyses: an interim analysis (IA) and a final analysis -(FA). For the multiplicity adjustments, we need the number of events in -the treatment and control groups combined that are available for testing -each hypothesis at both analyses for each population and the -intersection of populations. In the following AB positive means positive -for both biomarker A and biomarker B.

-
# Create event data systematically
-create_event_data <- function() {
-  populations <- rep(c("A positive", "B positive", "AB positive", "overall"), 2)
-  analyses <- rep(c(1, 2), each = 4)
-  events <- c(100, 110, 80, 225, 200, 220, 160, 450)  # IA, then FA
-  
-  tibble(
-    population = populations,
-    analysis = analyses, 
-    event = events
-  )
-}
-
-event_tbl <- create_event_data()
-event_tbl %>%
-  gt() %>%
-  tab_header(title = "Event Count by Population and Analysis")
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Event Count by Population and Analysis
populationanalysisevent
A positive1100
B positive1110
AB positive180
overall1225
A positive2200
B positive2220
AB positive2160
overall2450
-
-

We assume the following unadjusted p-values at each analysis for each -hypothesis.

-
# Observed p-values
-obs_tbl <- tribble(
-  ~hypothesis, ~analysis, ~obs_p,
-  "H1", 1, 0.02,
-  "H2", 1, 0.01,
-  "H3", 1, 0.012,
-  "H1", 2, 0.015,
-  "H2", 2, 0.012,
-  "H3", 2, 0.010
-) %>%
-  mutate(obs_Z = -qnorm(obs_p))
-
-obs_tbl %>%
-  gt() %>%
-  tab_header(title = "Nominal p-values")
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Nominal p-values
hypothesisanalysisobs_pobs_Z
H110.0202.053749
H210.0102.326348
H310.0122.257129
H120.0152.170090
H220.0122.257129
H320.0102.326348
-
-

-p_obs_IA <- (obs_tbl %>% filter(analysis == 1))$obs_p
-p_obs_FA <- (obs_tbl %>% filter(analysis == 2))$obs_p
-

We now have all the information we need to perform testing and -adjusting p-values.

-
-
-

Information Fractions

-

Next we calculate information fractions at interim and final -analyses. The final event count at each analysis is assumed to be the -planned count for each population.

-
# Helper function to extract events
-get_events <- function(analysis_num, population_name) {
-  event_tbl %>% 
-    filter(analysis == analysis_num, population == population_name) %>% 
-    pull(event)
-}
-
-# Extract event counts
-events_IA <- event_tbl %>% filter(analysis == 1)
-events_FA <- event_tbl %>% filter(analysis == 2)
-
-a_pos_IA <- get_events(1, "A positive")
-b_pos_IA <- get_events(1, "B positive")
-ab_pos_IA <- get_events(1, "AB positive")
-overall_IA <- get_events(1, "overall")
-
-a_pos_FA <- get_events(2, "A positive")
-b_pos_FA <- get_events(2, "B positive")
-ab_pos_FA <- get_events(2, "AB positive")
-overall_FA <- get_events(2, "overall")
-
-# Calculate information fractions
-IF_IA <- c(
-  (a_pos_IA + overall_IA) / (a_pos_FA + overall_FA),    # H1
-  (b_pos_IA + overall_IA) / (b_pos_FA + overall_FA),    # H2  
-  (ab_pos_IA + overall_IA) / (ab_pos_FA + overall_FA)   # H3
-)
-
-tibble(
-  Hypothesis = c("H1", "H2", "H3"),
-  Information_Fraction = IF_IA
-) %>%
-  gt() %>%
-  tab_header(title = "Information Fractions at Interim Analysis") %>%
-  fmt_number(columns = 2, decimals = 3)
-
- - - - - - - - - - - - - - - - - - - - - - -
Information Fractions at Interim Analysis
HypothesisInformation_Fraction
H10.500
H20.500
H30.500
-
-
-
-

Correlation Matrix

-

Now we can create a correlation matrix for all tests performed based -on the methods of Anderson et al. (2022) -(or Chen et al. (2021)).

-
# Create correlation matrix using event intersections
-event_intersections <- tribble(
-  ~H1, ~H2, ~Analysis, ~Event,
-  # Analysis 1 - Interim
-  1, 1, 1, a_pos_IA,
-  2, 2, 1, b_pos_IA, 
-  3, 3, 1, overall_IA,
-  1, 2, 1, ab_pos_IA,
-  1, 3, 1, a_pos_IA,
-  2, 3, 1, b_pos_IA,
-  # Analysis 2 - Final
-  1, 1, 2, a_pos_FA,
-  2, 2, 2, b_pos_FA,
-  3, 3, 2, overall_FA, 
-  1, 2, 2, ab_pos_FA,
-  1, 3, 2, a_pos_FA,
-  2, 3, 2, b_pos_FA
-)
-
-# Generate correlation from events
-correlation_matrix <- generate_corr(event_intersections)
-
-correlation_matrix %>% 
-  round(3) %>%
-  knitr::kable(caption = "Correlation Matrix (6x6)")
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Correlation Matrix (6x6)
H1_A1H2_A1H3_A1H1_A2H2_A2H3_A2
1.0000.7630.6670.7070.5390.471
0.7631.0000.6990.5390.7070.494
0.6670.6991.0000.4710.4940.707
0.7070.5390.4711.0000.7630.667
0.5390.7070.4940.7631.0000.699
0.4710.4940.7070.6670.6991.000
-
-
-

Sequential P-value Calculations

-
# Helper function for systematic calculations
-calculate_seq_p_systematic <- function(test_analysis, p_obs_IA, p_obs_FA, w, m, correlation_matrix, IF_IA) {
-  
-  combinations <- c("H1, H2, H3", "H1, H2", "H1, H3", "H2, H3", "H1", "H2", "H3")
-  
-  results <- map_dfr(combinations, ~ {
-    seq_p <- calc_seq_p(
-      test_analysis = test_analysis,
-      test_hypothesis = .x,
-      p_obs = tibble(
-        analysis = 1:2,
-        H1 = c(p_obs_IA[1], p_obs_FA[1]),
-        H2 = c(p_obs_IA[2], p_obs_FA[2]),
-        H3 = c(p_obs_IA[3], p_obs_FA[3])
-      ),
-      alpha_spending_type = 2,
-      n_analysis = 2,
-      initial_weight = w,
-      transition_mat = m,
-      z_corr = correlation_matrix,
-      spending_fun = gsDesign::sfHSD,
-      spending_fun_par = -4,
-      info_frac = c(min(IF_IA), 1),
-      interval = c(1e-4, 0.2)
-    )
-    
-    tibble(
-      combination = .x,
-      sequential_p = seq_p
-    )
-  })
-  
-  return(results)
-}
-
-# Calculate for both interim and final analyses
-ia_results <- calculate_seq_p_systematic(1, p_obs_IA, p_obs_FA, w, m, correlation_matrix, IF_IA) %>%
-  mutate(analysis = "Interim")
-
-fa_results <- calculate_seq_p_systematic(2, p_obs_IA, p_obs_FA, w, m, correlation_matrix, IF_IA) %>%
-  mutate(analysis = "Final")
-
-
-

Results Summary

-
# Combined results table
-combined_results <- bind_rows(ia_results, fa_results)
-
-combined_results %>%
-  gt() %>%
-  tab_header(title = "Sequential p-values - Comprehensive Results") %>%
-  fmt_number(columns = "sequential_p", decimals = 4) %>%
-  tab_style(
-    style = cell_fill(color = "lightblue"),
-    locations = cells_body(rows = analysis == "Interim")
-  ) %>%
-  tab_style(
-    style = cell_fill(color = "lightgreen"), 
-    locations = cells_body(rows = analysis == "Final")
-  )
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Sequential p-values - Comprehensive Results
combinationsequential_panalysis
H1, H2, H30.1943Interim
H1, H20.1400Interim
H1, H30.1553Interim
H2, H30.1529Interim
H10.1678Interim
H20.0839Interim
H30.1007Interim
H1, H2, H30.0206Final
H1, H20.0210Final
H1, H30.0165Final
H2, H30.0162Final
H10.0159Final
H20.0127Final
H30.0106Final
-
-
-
-

Adjusted Sequential P-values

-
# Calculate adjusted sequential p-values (max over relevant combinations)
-calculate_adjusted <- function(results_df) {
-  h1_adj <- max(
-    results_df$sequential_p[results_df$combination == "H1, H2, H3"],
-    results_df$sequential_p[results_df$combination == "H1, H2"],
-    results_df$sequential_p[results_df$combination == "H1, H3"],
-    results_df$sequential_p[results_df$combination == "H1"]
-  )
-  
-  h2_adj <- max(
-    results_df$sequential_p[results_df$combination == "H1, H2, H3"],
-    results_df$sequential_p[results_df$combination == "H1, H2"],
-    results_df$sequential_p[results_df$combination == "H2, H3"],
-    results_df$sequential_p[results_df$combination == "H2"]
-  )
-  
-  h3_adj <- max(
-    results_df$sequential_p[results_df$combination == "H1, H2, H3"],
-    results_df$sequential_p[results_df$combination == "H1, H3"],
-    results_df$sequential_p[results_df$combination == "H2, H3"],
-    results_df$sequential_p[results_df$combination == "H3"]
-  )
-  
-  tibble(
-    hypothesis = c("H1", "H2", "H3"),
-    adjusted_sequential_p = c(h1_adj, h2_adj, h3_adj)
-  )
-}
-
-# Calculate for both analyses
-ia_adjusted <- calculate_adjusted(ia_results) %>% mutate(analysis = "Interim")
-fa_adjusted <- calculate_adjusted(fa_results) %>% mutate(analysis = "Final")
-
-adjusted_results <- bind_rows(ia_adjusted, fa_adjusted)
-
-adjusted_results %>%
-  gt() %>%
-  tab_header(title = "Adjusted Sequential p-values") %>%
-  fmt_number(columns = "adjusted_sequential_p", decimals = 4) %>%
-  tab_style(
-    style = cell_fill(color = "pink"),
-    locations = cells_body(rows = adjusted_sequential_p <= 0.025)
-  )
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Adjusted Sequential p-values
hypothesisadjusted_sequential_panalysis
H10.1943Interim
H20.1943Interim
H30.1943Interim
H10.0210Final
H20.0210Final
H30.0206Final
-
-
-
-
-

Interpretation and Conclusions

-

The systematic approach demonstrates:

-
    -
  1. Interim Analysis: Shows proper adjustment for -multiplicity and sequential testing
  2. -
  3. Final Analysis: Provides definitive conclusions -with Type I error control
  4. -
  5. Efficiency: Helper functions reduce code repetition -by ~80% while maintaining accuracy
  6. -
  7. Flexibility: Easy to modify for different -hypothesis combinations or parameters
  8. -
-

The adjusted sequential p-values account for both: - Multiple -comparisons (across populations)
-- Sequential testing (interim and final analyses)

-

Results highlighted in pink indicate rejection at α = 0.025 -level.

-
-
-Anderson, Keaven M, Zifang Guo, Jing Zhao, and Linda Z Sun. 2022. -“A Unified Framework for Weighted Parametric Group Sequential -Design.” Biometrical Journal 64 (7): 1219–39. -
-
-Chen, Ting-Yu, Jing Zhao, Linda Sun, and Keaven M Anderson. 2021. -“Multiplicity for a Group Sequential Trial with Biomarker -Subpopulations.” Contemporary Clinical Trials 101: -106249. -
-
-Zhao, Yujie, Qi Liu, Linda Z Sun, and Keaven M Anderson. 2025. -“Adjusted Inference for Multiple Testing Procedure in -Group-Sequential Designs.” Biometrical Journal 67 (1): -e70020. -
-
-
- - - - - - - - - - - diff --git a/vignettes/corr_calculation.Rmd b/vignettes/corr_calculation.Rmd index 74ecebb..353a17e 100644 --- a/vignettes/corr_calculation.Rmd +++ b/vignettes/corr_calculation.Rmd @@ -1,5 +1,5 @@ --- -title: "Correlated test statistics for " +title: "Correlated test statistics" author: "Chenguang Zhang, Yujie Zhao and Keaven Anderson" output: rmarkdown::html_document: diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/DESCRIPTION b/wpgsd.Rcheck/00_pkg_src/wpgsd/DESCRIPTION deleted file mode 100644 index f2d0d12..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/DESCRIPTION +++ /dev/null @@ -1,45 +0,0 @@ -Package: wpgsd -Title: Weighted Parametric Group Sequential Design -Version: 0.1.0 -Authors@R: c( - person("Keaven", "Anderson", email = "keaven_anderson@merck.com", role = "aut"), - person("Zifang", "Guo", email = "zifang.guo@merck.com", role = "aut"), - person("Jing", "Zhao", email = "jing_zhaox@merck.com", role = "aut"), - person("Linda", "Sun", email = "linda_sun@merck.com", role = "aut"), - person("Yi", "Cui", email = "yi.cui@merck.com", role = "aut"), - person("Yujie", "Zhao", email = "yujie.zhao@merck.com", role = c("aut", "cre")), - person("Larry", "Leon", email = "larry.leon2@merck.com", role = "aut"), - person("Merck Sharp & Dohme Corp", role = c("cph")) - ) -Description: Adjusted inference for weighted parametric group sequential design. - Weighted parametric group sequential design (WPGSD) by Anderson et al. (2022) - allows one to take advantage of the known - correlation structure in constructing efficacy bounds to control - family-wise error rate (FWER) for a group sequential design. - Here, correlation may be due to common observations in nested populations, - due to common observations in overlapping populations, or due to common - observations in the control arm. -License: GPL (>= 3) -URL: https://merck.github.io/wpgsd/, https://github.com/Merck/wpgsd -BugReports: https://github.com/Merck/wpgsd/issues -Encoding: UTF-8 -Depends: R (>= 3.6), S7 -Imports: dplyr, gMCPLite, gsDesign, mvtnorm, rlang (>= 0.4.11), S7, - stats, tibble, tidyselect -Suggests: covr, gt, haven, knitr, reshape2, rmarkdown, roxygen2, - testthat (>= 3.0.0), tidyr -VignetteBuilder: knitr -Config/testthat/edition: 3 -Roxygen: list(markdown = TRUE) -RoxygenNote: 7.3.1 -NeedsCompilation: no -Packaged: 2025-08-29 19:14:20 UTC; Anderkea -Author: Keaven Anderson [aut], - Zifang Guo [aut], - Jing Zhao [aut], - Linda Sun [aut], - Yi Cui [aut], - Yujie Zhao [aut, cre], - Larry Leon [aut], - Merck Sharp & Dohme Corp [cph] -Maintainer: Yujie Zhao diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/EventTable_README.md b/wpgsd.Rcheck/00_pkg_src/wpgsd/EventTable_README.md deleted file mode 100644 index 8c3917b..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/EventTable_README.md +++ /dev/null @@ -1,124 +0,0 @@ -# EventTable S7 Class Implementation - -## Overview - -The `EventTable` S7 class provides a type-safe, validated data structure for representing event count data used in the wpgsd package. This is the first step in converting the wpgsd package to use S7 classes throughout. - -## Features - -### Core Properties -- **data**: A tibble containing the event count data with required columns `H1`, `H2`, `Analysis`, `Event` -- **n_hypotheses**: Automatically calculated number of hypotheses -- **n_analyses**: Automatically calculated number of analyses - -### Validation -- Validates presence of required columns (`H1`, `H2`, `Analysis`, `Event`) -- Ensures proper data types (all numeric) -- Validates logical constraints: - - Hypothesis indices must be positive integers - - Analysis numbers must be positive integers - - Event counts must be non-negative - -### Methods -- **print()**: Clean formatted output showing key information -- **summary()**: Detailed summary including event count statistics -- **subset_event_table()**: Subset by analysis or hypotheses -- **as_event_table()**: Convert tibble to EventTable -- **validate_event_table_data()**: Validate data format before processing - -## Usage Examples - -### Basic Usage -```r -library(wpgsd) - -# Create event data -event_data <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160, - 1, 2, 1, 85, - 1, 1, 2, 305, - 2, 2, 2, 320, - 1, 2, 2, 170 -) - -# Create EventTable object -event_table <- EventTable(data = event_data) -print(event_table) -``` - -### Data Validation -```r -# The constructor automatically validates data -tryCatch({ - invalid_data <- tibble::tibble( - H1 = c(1, -2), # Invalid: negative hypothesis index - H2 = c(1, 2), - Analysis = c(1, 1), - Event = c(100, 200) - ) - EventTable(data = invalid_data) -}, error = function(e) { - cat("Validation error:", e$message) -}) -``` - -### Subsetting -```r -# Subset by analysis -analysis_1 <- subset_event_table(event_table, analysis = 1) - -# Subset by hypotheses -h1_h2 <- subset_event_table(event_table, hypotheses = c(1, 2)) -``` - -### Integration with Existing Functions -```r -# Use with existing wpgsd functions -correlation_matrix <- generate_corr(event_table@data) -``` - -## Files Created - -- `R/s7_classes.R`: Main S7 class definition -- `tests/testthat/test-s7-event-table.R`: Comprehensive unit tests -- `examples/test_event_table.R`: Basic usage examples -- `examples/event_table_integration.R`: Integration with existing functions - -## Dependencies - -- Added `S7` to package imports in `DESCRIPTION` -- Uses existing dependencies: `tibble`, `dplyr` - -## Benefits - -1. **Type Safety**: Prevents invalid data from being passed to wpgsd functions -2. **Validation**: Automatic validation of data format and constraints -3. **Documentation**: Self-documenting data structures -4. **Method Dispatch**: Extensible with specialized methods -5. **User Experience**: Clear error messages and helpful summaries - -## Next Steps - -This EventTable implementation provides the foundation for converting the wpgsd package to S7 classes. Future steps include: - -1. Create `CorrelationMatrix` S7 class for `generate_corr()` output -2. Create `Bounds` S7 class for `generate_bounds()` output -3. Update existing functions to accept/return S7 objects -4. Maintain backward compatibility with existing tibble/data.frame inputs - -## Testing - -Run the comprehensive test suite: -```r -testthat::test_file("tests/testthat/test-s7-event-table.R") -``` - -The tests cover: -- Object creation with valid data -- Validation of required columns -- Data type and value validation -- Print and summary methods -- Subsetting functionality -- Data conversion utilities diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/NAMESPACE b/wpgsd.Rcheck/00_pkg_src/wpgsd/NAMESPACE deleted file mode 100644 index d451590..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/NAMESPACE +++ /dev/null @@ -1,37 +0,0 @@ -# Generated by roxygen2: do not edit by hand - -export(":=") -export(.data) -export(as_label) -export(as_name) -export(calc_seq_p) -export(closed_test) -export(enquo) -export(enquos) -export(find_astar) -export(find_xi) -export(generate_bounds) -export(generate_corr) -export(generate_event_table) -importFrom(dplyr,"%>%") -importFrom(dplyr,arrange) -importFrom(dplyr,bind_rows) -importFrom(dplyr,filter) -importFrom(dplyr,mutate) -importFrom(dplyr,num_range) -importFrom(dplyr,select) -importFrom(gMCPLite,gMCP) -importFrom(gMCPLite,getWeights) -importFrom(mvtnorm,GenzBretz) -importFrom(mvtnorm,pmvnorm) -importFrom(rlang,":=") -importFrom(rlang,.data) -importFrom(rlang,as_label) -importFrom(rlang,as_name) -importFrom(rlang,enquo) -importFrom(rlang,enquos) -importFrom(stats,pnorm) -importFrom(stats,qnorm) -importFrom(stats,uniroot) -importFrom(tibble,tibble) -importFrom(tidyselect,all_of) diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/NEWS.md b/wpgsd.Rcheck/00_pkg_src/wpgsd/NEWS.md deleted file mode 100644 index d58f9e4..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/NEWS.md +++ /dev/null @@ -1,17 +0,0 @@ -# wpgsd 0.1.0 - -- Initial release. - -The wpgsd package is now available on GitHub, install it with - -``` -remotes::install_github("Merck/wpgsd") -``` - -If you prefer to use a specific version, install it with - -``` -remotes::install_github("Merck/wpgsd@v0.1.0") -``` - -where `v0.1.0` is the GitHub release version number. diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/R/calc_seq_p.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/R/calc_seq_p.R deleted file mode 100644 index e123680..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/R/calc_seq_p.R +++ /dev/null @@ -1,144 +0,0 @@ -# Copyright (c) 2023 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. -# All rights reserved. -# -# This file is part of the wpgsd program. -# -# wpgsd 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 . - -#' Calculate sequential p-values for interaction/elementary hypothesis -#' -#' @param test_analysis The index of the analysis to be tested, such as 1, 2, ... -#' @param test_hypothesis A character of the tested interaction/elementary hypothesis, -#' such as `"H1, H2, H3"`, `H1, H2`, `"H1"`. -#' @param p_obs Observed p-values up to `test_analysis`. -#' @param n_analysis Total number of analysis. -#' @param alpha_spending_type Type Boundary type. -#' - `0` - Bonferroni. Separate alpha spending for each hypotheses. -#' - `1` - Fixed alpha spending for all hypotheses. Method 3a in the manuscript. -#' - `2` - Overall alpha spending for all hypotheses. Method 3b in the manuscript. -#' - `3` - Separate alpha spending for each hypotheses. Method 3c in the manuscript. -#' @param initial_weight Initial weight assigned to the elementary hypothesis. -#' @param transition_mat Transition matrix. -#' @param z_corr Correlation matrix of the Z statistics. -#' @param spending_fun Spending function. -#' @param spending_fun_par Parameter of the spending function. -#' @param info_frac Information fractions. -#' @param interval Interval to search the uniroot. -#' -#' @return The sequential p-values of the `test_hypothesis` at the `test_analysis`. -#' -#' @importFrom dplyr %>% filter num_range select -#' @importFrom stats uniroot -#' -#' @export -#' -#' @examples -#' \donttest{ -#' calc_seq_p( -#' test_analysis = 2, -#' test_hypothesis = "H1, H2, H3", -#' p_obs = tibble::tibble( -#' analysis = 1:2, -#' H1 = c(0.02, 0.0015), -#' H2 = c(0.01, 0.01), -#' H3 = c(0.01, 0.004) -#' ), -#' alpha_spending_type = 2, -#' n_analysis = 2, -#' initial_weight = c(0.3, 0.3, 0.4), -#' transition_mat = matrix(c( -#' 0.0000000, 0.4285714, 0.5714286, -#' 0.4285714, 0.0000000, 0.5714286, -#' 0.5000000, 0.5000000, 0.0000000 -#' ), nrow = 3, byrow = TRUE), -#' z_corr = matrix( -#' c( -#' 1.0000000, 0.7627701, 0.6666667, 0.7071068, 0.5393599, 0.4714045, -#' 0.7627701, 1.0000000, 0.6992059, 0.5393599, 0.7071068, 0.4944132, -#' 0.6666667, 0.6992059, 1.0000000, 0.4714045, 0.4944132, 0.7071068, -#' 0.7071068, 0.5393599, 0.4714045, 1.0000000, 0.7627701, 0.6666667, -#' 0.5393599, 0.7071068, 0.4944132, 0.7627701, 1.0000000, 0.6992059, -#' 0.4714045, 0.4944132, 0.7071068, 0.6666667, 0.6992059, 1.0000000 -#' ), -#' nrow = 6, byrow = TRUE -#' ), -#' spending_fun = gsDesign::sfHSD, -#' spending_fun_par = -4, -#' info_frac = c(0.5, 1), -#' interval = c(1e-4, 0.2) -#' ) -#' } -calc_seq_p <- function( - test_analysis = 2, - test_hypothesis = "H1, H2, H3", - p_obs = tibble::tibble( - analysis = 1:2, - H1 = c(0.02, 0.0015), - H2 = c(0.01, 0.01), - H3 = c(0.01, 0.004) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = c(0.3, 0.3, 0.4), - transition_mat = matrix(c( - 0.0000000, 0.4285714, 0.5714286, - 0.4285714, 0.0000000, 0.5714286, - 0.5000000, 0.5000000, 0.0000000 - ), nrow = 3, byrow = TRUE), - z_corr = matrix( - c( - 1.0000000, 0.7627701, 0.6666667, 0.7071068, 0.5393599, 0.4714045, - 0.7627701, 1.0000000, 0.6992059, 0.5393599, 0.7071068, 0.4944132, - 0.6666667, 0.6992059, 1.0000000, 0.4714045, 0.4944132, 0.7071068, - 0.7071068, 0.5393599, 0.4714045, 1.0000000, 0.7627701, 0.6666667, - 0.5393599, 0.7071068, 0.4944132, 0.7627701, 1.0000000, 0.6992059, - 0.4714045, 0.4944132, 0.7071068, 0.6666667, 0.6992059, 1.0000000 - ), - nrow = 6, byrow = TRUE - ), - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(0.5, 1), - interval = c(1e-4, 0.2)) { - foo <- function(x) { - all_hypothesis <- strsplit(test_hypothesis, split = ", ") %>% unlist() - all_hypothesis_idx <- as.numeric(gsub(".*?([0-9]+).*", "\\1", all_hypothesis)) - - ans <- generate_bounds( - type = alpha_spending_type, - k = n_analysis, - w = initial_weight, - m = transition_mat, - corr = z_corr, - alpha = x, - sf = spending_fun, - sfparm = spending_fun_par, - t = info_frac - ) %>% - arrange(Analysis) %>% - filter(Analysis <= test_analysis, Hypotheses == test_hypothesis) - - p_diff <- NULL - for (hhh in all_hypothesis) { - p_diff_new <- (p_obs %>% filter(analysis <= test_analysis))[[hhh]] - ans[[hhh]] - p_diff <- c(p_diff, p_diff_new) - } - - return(min(p_diff)) - } - - seq_p <- uniroot(foo, lower = interval[1], upper = interval[2])$root - - return(seq_p) -} diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/R/closed_test.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/R/closed_test.R deleted file mode 100644 index 0da045d..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/R/closed_test.R +++ /dev/null @@ -1,102 +0,0 @@ -# Copyright (c) 2023 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. -# All rights reserved. -# -# This file is part of the wpgsd program. -# -# wpgsd 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 . - -#' Perform closed testing procedure -#' -#' @param bounds A tibble of nominal p-value boundaries from [generate_bounds()] -#' containing columns `Analysis`, `Hypotheses`, `H1`, `H2`, etc. -#' @param p_obs A tibble of observed p-values containing columns -#' `Analysis`, `H1`, `H2`, etc. -#' -#' @return An outcome matrix summarizing the testing results. -#' -#' @importFrom dplyr %>% filter num_range select -#' -#' @export -#' -#' @examples -#' p_obs <- dplyr::bind_rows( -#' tibble::tibble(Analysis = 1, H1 = 0.001, H2 = 0.001), -#' tibble::tibble(Analysis = 2, H1 = 0.001, H2 = 0.001) -#' ) -#' bound <- tibble::tribble( -#' ~Analysis, ~Hypotheses, ~H1, ~H2, -#' 1, "H1", 0.02, NA, -#' 1, "H1, H2", 0.0001, 0.00001, -#' 1, "H2", NA, 0.003, -#' 2, "H1", 0.02, NA, -#' 2, "H1, H2", 0.02, 0.00001, -#' 2, "H2", NA, 0.003 -#' ) -#' -#' closed_test <- closed_test(bound, p_obs) -closed_test <- function(bounds, p_obs) { - n_analyses <- max(p_obs$Analysis) - n_hypotheses <- ncol(p_obs) - 1 - - result <- NULL - - for (i in 1:n_analyses) { - # results comparing p-value with bound at current analysis - p_tmp <- p_obs %>% - filter(Analysis == i) %>% - select(num_range("H", 1:n_hypotheses)) - bounds_tmp <- bounds %>% - filter(Analysis == i) %>% - select(num_range("H", 1:n_hypotheses)) - test_raw <- c(unlist(p_tmp)) < t(bounds_tmp) - - # number of intersection hypothesis - n_inter <- ncol(test_raw) - - # initial testing result of each intersection hypothesis - test_inter <- apply(test_raw, 2, any, na.rm = TRUE) - - # if a hypothesis was rejected in a previous analysis, then all - # intersection hypothesis including that hypothesis is rejected - if (i != 1) { - # previous testing results - prev_res <- apply(result %>% dplyr::select(num_range("H", 1:n_hypotheses)), 2, any) - # hypothesis number that was rejected in any previous analyses - prev_reject <- c(1:n_hypotheses)[prev_res] - # intersection hypothesis that includes previous rejected hypothesis - inter_reject <- matrix(!is.na(test_raw[prev_reject, ]), ncol = n_inter) - indx_inter_reject <- c(1:n_inter)[apply(inter_reject, 2, sum) > 0] - # convert testing result to TRUE for above intersection hypothesis - test_inter[indx_inter_reject] <- TRUE - } - - # testing result of each elementary hypothesis - test_tmp <- rep(NA, n_hypotheses) - for (j in 1:n_hypotheses) { - indx <- !is.na(test_raw[j, ]) - test_elem <- all(test_inter[indx]) - test_tmp[j] <- test_elem - } - names(test_tmp) <- paste("H", 1:n_hypotheses, sep = "") - test_tmp <- data.frame(t(test_tmp)) - test_tmp$Analysis <- paste("Analysis", i) - result <- dplyr::bind_rows(result, test_tmp) - } - - result[result == TRUE] <- "Success" - result[result == FALSE] <- "Fail" - rownames(result) <- NULL - - return(result) -} diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/R/d_corr.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/R/d_corr.R deleted file mode 100644 index a8b68ba..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/R/d_corr.R +++ /dev/null @@ -1,33 +0,0 @@ -# Copyright (c) 2023 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. -# All rights reserved. -# -# This file is part of the wpgsd program. -# -# wpgsd 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 . - -#' Convert event matrix to correlation matrix -#' -#' @param D Event matrix. -#' -#' @return Correlation matrix. -#' -#' @noRd -#' -#' @examples -#' d_corr(D = matrix(c(1, 2, 3, 4, 5, 6, 7, 8, 9), nrow = 3)) -d_corr <- function(D) { - B <- matrix(0, nrow = nrow(D), ncol = nrow(D)) - diag(B) <- 1 / sqrt(diag(D)) - return(B %*% D %*% B) -} diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/R/find_astar.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/R/find_astar.R deleted file mode 100644 index 628769d..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/R/find_astar.R +++ /dev/null @@ -1,90 +0,0 @@ -# Copyright (c) 2023 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. -# All rights reserved. -# -# This file is part of the wpgsd program. -# -# wpgsd 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 . - -#' Utility function for root-finding to compute crossing probabilities -#' with the overall alpha spending approach -#' -#' @param a Cumulative overall alpha spending up to current analysis. -#' @param alpha_prev alpha boundary at previous interim analyses using -#' the WPGSD approach. -#' @param astar Total nominal alpha level at current analysis from -#' the WPGSD approach. -#' @param w Vector of alpha weights at current analysis. -#' @param sig Correlation matrix of previous and current analyses test statistics. -#' @param maxpts GenzBretz function maximum number of function values as integer. -#' @param abseps GenzBretz function absolute error tolerance. -#' @param ... Additional arguments. -#' -#' @return Difference. Should be 0 with `a` and `astar` identified. -#' -#' @export -#' -#' @examples -#' # Input event count of intersection of paired hypotheses - Table 2 -#' my_event <- tibble::tribble( -#' ~H1, ~H2, ~Analysis, ~Event, -#' 1, 1, 1, 155, -#' 2, 2, 1, 160, -#' 3, 3, 1, 165, -#' 1, 2, 1, 85, -#' 1, 3, 1, 85, -#' 2, 3, 1, 85, -#' 1, 1, 2, 305, -#' 2, 2, 2, 320, -#' 3, 3, 2, 335, -#' 1, 2, 2, 170, -#' 1, 3, 2, 170, -#' 2, 3, 2, 170 -#' ) -#' -#' # Generate correlation from events -#' my_corr <- generate_corr(my_event) -#' -#' # Find the inflation factor for H1, H2 at analysis 1 -#' find_astar( -#' a = 0.0008708433, -#' alpha_prev = NULL, -#' aprime = c(0.0004588644, 0.0004119789), -#' astar = 1, -#' w = c(0.5, 0.5), -#' sig = my_corr[ -#' colnames(my_corr) %in% c("H1_A1", "H2_A1"), -#' colnames(my_corr) %in% c("H1_A1", "H2_A1") -#' ] -#' ) -find_astar <- function(a, alpha_prev = NULL, astar, w, sig, maxpts = 50000, abseps = 0.00001, ...) { - # Remove column name for proper pmvnorm run - colnames(sig) <- NULL - - if (is.null(alpha_prev)) { - res <- 1 - a - mvtnorm::pmvnorm( - lower = -Inf, - upper = qnorm(1 - w * astar), - sigma = sig, - algorithm = mvtnorm::GenzBretz(maxpts = maxpts, abseps = abseps) - ) - } else { - res <- 1 - a - mvtnorm::pmvnorm( - lower = -Inf, - upper = c(qnorm(1 - alpha_prev), qnorm(1 - w * astar)), - sigma = sig, - algorithm = mvtnorm::GenzBretz(maxpts = maxpts, abseps = abseps) - ) - } - return(res) -} diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/R/find_xi.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/R/find_xi.R deleted file mode 100644 index b99e9a4..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/R/find_xi.R +++ /dev/null @@ -1,90 +0,0 @@ -# Copyright (c) 2023 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. -# All rights reserved. -# -# This file is part of the wpgsd program. -# -# wpgsd 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 . - -#' Utility function for root-finding to compute inflation factor xi -#' with the separate alpha spending approach -#' -#' @param a Sum of cumulative alpha spending from the Bonferroni approach. -#' @param alpha_prev alpha boundary at previous interim analyses using the MTP approach. -#' @param aprime Nominal alpha boundary from the Bonferroni approach. -#' @param xi Inflation factor. -#' @param sig Correlation matrix of previous and current analyses test statistics. -#' @param maxpts GenzBretz function maximum number of function values as integer. -#' @param abseps GenzBretz function absolute error tolerance. -#' @param ... Additional arguments. -#' -#' @return Difference. Should be 0 with `xi` identified. -#' -#' @importFrom mvtnorm pmvnorm GenzBretz -#' @importFrom stats qnorm -#' -#' @export -#' -#' @examples -#' # Input event count of intersection of paired hypotheses - Table 2 -#' my_event <- tibble::tribble( -#' ~H1, ~H2, ~Analysis, ~Event, -#' 1, 1, 1, 155, -#' 2, 2, 1, 160, -#' 3, 3, 1, 165, -#' 1, 2, 1, 85, -#' 1, 3, 1, 85, -#' 2, 3, 1, 85, -#' 1, 1, 2, 305, -#' 2, 2, 2, 320, -#' 3, 3, 2, 335, -#' 1, 2, 2, 170, -#' 1, 3, 2, 170, -#' 2, 3, 2, 170 -#' ) -#' -#' # Generate correlation from events -#' my_corr <- generate_corr(my_event) -#' -#' # Find the inflation factor for H1, H2 at analysis 1 -#' find_xi( -#' a = 0.0008708433, -#' alpha_prev = NULL, -#' aprime = c(0.0004588644, 0.0004119789), -#' xi = 1, -#' sig = my_corr[ -#' colnames(my_corr) %in% c("H1_A1", "H2_A1"), -#' colnames(my_corr) %in% c("H1_A1", "H2_A1") -#' ] -#' ) -find_xi <- function(a, alpha_prev = NULL, aprime, xi, sig, maxpts = 50000, abseps = 0.00001, ...) { - # Remove column name for proper pmvnorm run - colnames(sig) <- NULL - - if (is.null(alpha_prev)) { - res <- 1 - a - pmvnorm( - lower = -Inf, - upper = qnorm(1 - xi * aprime), - sigma = sig, - algorithm = GenzBretz(maxpts = maxpts, abseps = abseps) - ) - } else { - res <- 1 - a - pmvnorm( - lower = -Inf, - upper = c(qnorm(1 - alpha_prev), qnorm(1 - xi * aprime)), - sigma = sig, - algorithm = GenzBretz(maxpts = maxpts, abseps = abseps) - ) - } - return(res) -} diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/R/generate_bounds.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/R/generate_bounds.R deleted file mode 100644 index 91754c4..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/R/generate_bounds.R +++ /dev/null @@ -1,326 +0,0 @@ -# Copyright (c) 2023 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. -# All rights reserved. -# -# This file is part of the wpgsd program. -# -# wpgsd 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 . - -#' Compute p-value boundaries of the parametric MTP method with overall -#' alpha spending for all hypotheses -#' -#' @param type Boundary type. -#' - `0` = Bonferroni. Separate alpha spending for each hypotheses. -#' - `1` = Fixed alpha spending for all hypotheses. Method 3a in the manuscript. -#' - `2` = Overall alpha spending for all hypotheses. Method 3b in the manuscript. -#' - `3` = Separate alpha spending for each hypotheses. Method 3c in the manuscript. -#' @param k Number of analyses up to the current analysis. -#' @param w Initial weights. -#' @param m Transition matrix. -#' @param corr Correlation matrix of all test statistics up to the -#' current analysis. dim = k * length(w). -#' @param alpha Overall alpha. -#' @param cum_alpha Cumulative alpha spent at each analysis. -#' Only required for `type = 1`. -#' @param sf A list of alpha spending functions to spend alpha for -#' each hypotheses. -#' - If `type = 0` or `3` then length equals to number of hypotheses. -#' - If `type = 1` then `sf` is not needed. -#' - If `type = 2` then only the first component is used. -#' @param sfparm A list of parameters to be supplied to sfs. -#' - If `type = 0` or `3` then length equals to number of hypotheses. -#' - If `type = 1` then `sfparm` is not needed. -#' - If `type = 2` then only the first component is used. -#' @param t A list of information fraction used for alpha spending, -#' may be different from the actual information fraction. -#' Each component corresponds to a hypothesis. -#' - If `type = 0` or `3` then length equals to number of hypotheses. -#' - If `type = 1` then `t` is not needed. -#' - If `type = 2` then only the first component is used. -#' @param maxpts GenzBretz function maximum number of function values -#' as integer. -#' @param abseps GenzBretz function absolute error tolerance. -#' @param tol Find root tolerance. -#' @param ... Additional arguments. -#' -#' @return A tibble with `k * (2^(n_hypotheses - 1))` rows of -#' p-value boundaries. Inflation factor is also provided if `type = 3`. -#' -#' @importFrom dplyr %>% bind_rows arrange mutate -#' @importFrom gMCPLite gMCP getWeights -#' @importFrom tibble tibble -#' @importFrom stats pnorm uniroot -#' -#' @export -#' -#' @examples -#' # Build the transition matrix -#' m <- matrix(c( -#' 0, 0.5, 0.5, -#' 0.5, 0, 0.5, -#' 0.5, 0.5, 0 -#' ), nrow = 3, byrow = TRUE) -#' -#' # Initialize weights -#' w <- c(1 / 3, 1 / 3, 1 / 3) -#' -#' # Input information fraction -#' IF_IA <- c(155 / 305, 160 / 320, 165 / 335) -#' -#' # Input event count of intersection of paired hypotheses - Table 2 -#' event <- tibble::tribble( -#' ~H1, ~H2, ~Analysis, ~Event, -#' 1, 1, 1, 155, -#' 2, 2, 1, 160, -#' 3, 3, 1, 165, -#' 1, 2, 1, 85, -#' 1, 3, 1, 85, -#' 2, 3, 1, 85, -#' 1, 1, 2, 305, -#' 2, 2, 2, 320, -#' 3, 3, 2, 335, -#' 1, 2, 2, 170, -#' 1, 3, 2, 170, -#' 2, 3, 2, 170 -#' ) -#' -#' # Generate correlation from events -#' gs_corr <- generate_corr(event) -#' -#' # Generate bounds -#' generate_bounds( -#' type = 3, -#' k = 2, -#' w = w, -#' m = m, -#' corr = gs_corr, -#' alpha = 0.025, -#' sf = list(gsDesign::sfLDOF, gsDesign::sfLDOF, gsDesign::sfLDOF), -#' sfparm = list(0, 0, 0), -#' t = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[3], 1)) -#' ) -generate_bounds <- function(type = 1, k = 2, w = w, m = m, - corr = corr, alpha = 0.025, cum_alpha = NULL, - maxpts = 50000, abseps = 0.00001, tol = 1e-10, - sf = gsDesign::sfHSD, sfparm = -4, t = c(0.5, 1), ...) { - if (type == 1 && is.null(cum_alpha)) { - stop("Boundary type is 1 (fixed alpha spending) but no cummulative alpha was provided.") - } - - if (type == 2) { - if (is.list(sf)) { - sf <- sf[[1]] - } - if (is.list(sfparm)) { - sfparm <- sfparm[[1]] - } - if (is.list(t)) { - t <- t[[1]] - } - } - - # Number of hypotheses - n_hypotheses <- length(w) - - # Get weights for all intersection hypotheses - graph <- gMCPLite::matrix2graph(m) - graph <- gMCPLite::setWeights(graph, w) - - # Set up hypothetical pvalues (0 or 1) to obtain all combinations - pvals <- NULL - for (i in 1:n_hypotheses) { - if (i == 1) { - pvals <- data.frame(x = c(0, 1)) - names(pvals) <- paste("pval_H", i, sep = "") - } else { - tmp <- data.frame(x = c(0, 1)) - names(tmp) <- paste("pval_H", i, sep = "") - pvals <- merge(pvals, tmp) - } - } - - # Weights for each intersection hypothesis - inter_weight <- NULL - for (i in seq_len(nrow(pvals))) { - pval_tmp <- as.numeric(pvals[i, ]) - graph_tmp <- gMCPLite::gMCP(graph = graph, pvalues = pval_tmp, alpha = alpha) - weight_tmp <- gMCPLite::getWeights(graph_tmp) - inter_weight <- dplyr::bind_rows(inter_weight, weight_tmp) - } - - inter_weight <- replace(inter_weight, pvals == 0, NA) - inter_weight <- inter_weight[-1, ] - # inter_weight <- replace(inter_weight, inter_weight == 0, NA) - - # Get boundaries - bounds <- NULL - for (j in seq_len(nrow(inter_weight))) { - w_tmp0 <- inter_weight[j, ] - # Hypotheses included in the intersection hypothesis - hypotheses <- col(w_tmp0)[!is.na(w_tmp0)] - - # Remove NA from weight - w_tmp <- w_tmp0[(!is.na(w_tmp0))] - w_tmp0 <- as.numeric(w_tmp0) - - if (type == 0) { # Bonferroni - - bounds_tmp <- tibble( - Analysis = 1:k, - Hypotheses = paste("H", hypotheses, sep = "", collapse = ", ") - ) - - for (h in 1:n_hypotheses) { - if (!h %in% hypotheses) { - p_tmp <- NA - } else { - # Index to select from the correlation matrix - indx <- expand.grid(h, (1:k)) - indx <- indx[, 1] + (indx[, 2] - 1) * n_hypotheses - corr_tmp <- corr[indx, indx] - # Boundary for a single hypothesis across k for the intersection hypothesis - p_tmp <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = t[[h]], - n.I = corr_tmp[, ncol(corr_tmp)]^2, - alpha = alpha * w_tmp0[h], - sfu = sf[[h]], - sfupar = sfparm[[h]] - )$upper$bound) - } - # Record results - h_var <- paste("H", h, sep = "") - bounds_tmp <- bounds_tmp %>% - mutate(!!h_var := p_tmp) - } - bounds <- dplyr::bind_rows(bounds, bounds_tmp) - } else { # WPGSD Methods - for (i in 1:k) { - if (type %in% c(1, 2)) { - if (is.null(cum_alpha)) { - alpha_tmp <- sf(alpha = alpha, t = t, param = sfparm)$spend[i] - } else { - alpha_tmp <- cum_alpha[i] - } - - if (i == 1) { - alpha_prev <- NULL - } - - # index to select from the correlation matrix - indx <- expand.grid(hypotheses, (1:i)) - indx <- indx[, 1] + (indx[, 2] - 1) * n_hypotheses - corr_tmp <- corr[indx, indx] - - p_tmp <- w_tmp * uniroot(find_astar, - a = alpha_tmp, - alpha_prev = alpha_prev, - w = w_tmp, - sig = corr_tmp, - lower = 0, - upper = alpha_tmp * 5, - maxpts = maxpts, - abseps = abseps, - tol = tol - )$root - } - - if (type == 3) { - if (i == 1) { - alpha_prev <- NULL - } - - # First find Bonferroni spending - cum_alpha_B <- NULL - bounds_B <- NULL - for (h in hypotheses) { - indx_B <- expand.grid(h, (1:k)) - indx_B <- indx_B[, 1] + (indx_B[, 2] - 1) * n_hypotheses - corr_B_tmp <- corr[indx_B, indx_B] - # Cummulative Bonferroni spending for a single hypothesis at anlaysis k - cum_alpha_B_tmp <- sf[[h]](alpha = alpha * w_tmp0[h], t = t[[h]], param = sfparm[[h]])$spend[i] - cum_alpha_B <- c(cum_alpha_B, cum_alpha_B_tmp) - - # Bonferroni nominal boundary for a single hypothesis at analysis i - p_B_tmp <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = t[[h]], - n.I = corr_B_tmp[, ncol(corr_B_tmp)]^2, - alpha = alpha * w_tmp0[h], - sfu = sf[[h]], - sfupar = sfparm[[h]] - )$upper$bound)[i] - bounds_B <- c(bounds_B, p_B_tmp) - } - - # Find inflation factor xi - - if (length(hypotheses) == 1) { - xi <- 1 - } else { - # index to select from the correlation matrix - indx <- expand.grid(hypotheses, (1:i)) - indx <- indx[, 1] + (indx[, 2] - 1) * n_hypotheses - corr_tmp <- corr[indx, indx] - - xi <- uniroot(find_xi, - lower = 0.5, - upper = 10, - a = sum(cum_alpha_B), - alpha_prev = alpha_prev, - aprime = bounds_B, - sig = corr_tmp, - maxpts = maxpts, - abseps = abseps, - tol = tol - )$root - } - - p_tmp <- xi * bounds_B - } - - # record results - pval_tmp <- rep(NA, n_hypotheses) - pval_tmp[hypotheses] <- p_tmp - names(pval_tmp) <- paste("H", 1:n_hypotheses, sep = "") - - if (type == 3) { - bounds_tmp <- tibble( - Analysis = i, - Hypotheses = paste("H", hypotheses, sep = "", collapse = ", "), - as.data.frame(t(pval_tmp)), - xi = xi - ) - } else { - bounds_tmp <- tibble( - Analysis = i, - Hypotheses = paste("H", hypotheses, sep = "", collapse = ", "), - as.data.frame(t(pval_tmp)) - ) - } - - bounds <- dplyr::bind_rows(bounds, bounds_tmp) - - # Update alpha_prev - alpha_prev <- c(alpha_prev, p_tmp) - } - } - } - - bounds <- bounds %>% - dplyr::arrange(Analysis, Hypotheses, .by_group = FALSE) - - return(bounds) -} diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/R/generate_corr.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/R/generate_corr.R deleted file mode 100644 index 947784a..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/R/generate_corr.R +++ /dev/null @@ -1,112 +0,0 @@ -# Copyright (c) 2023 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. -# All rights reserved. -# -# This file is part of the wpgsd program. -# -# wpgsd 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 . - -#' Generate correlation matrix based on event counts -#' -#' @param event Event count of each hypothesis at each analysis, including -#' event count of the intersection of hypotheses. -#' It contains 4 columns: `H1`, `H2`, `Analysis`, `Event`. -#' `H1` needs to be listed as 1, 2, 3, etc. as numbers. -#' -#' @return A correlation matrix. -#' -#' @importFrom dplyr filter select %>% -#' -#' @export -#' -#' @examples -#' # Build the transition matrix -#' m <- matrix(c( -#' 0, 0.5, 0.5, -#' 0.5, 0, 0.5, -#' 0.5, 0.5, 0 -#' ), nrow = 3, byrow = TRUE) -#' # initialize weights -#' w <- c(1 / 3, 1 / 3, 1 / 3) -#' -#' # Input event count of intersection of paired hypotheses - Table 2 -#' event <- tibble::tribble( -#' ~H1, ~H2, ~Analysis, ~Event, -#' 1, 1, 1, 155, -#' 2, 2, 1, 160, -#' 3, 3, 1, 165, -#' 1, 2, 1, 85, -#' 1, 3, 1, 85, -#' 2, 3, 1, 85, -#' 1, 1, 2, 305, -#' 2, 2, 2, 320, -#' 3, 3, 2, 335, -#' 1, 2, 2, 170, -#' 1, 3, 2, 170, -#' 2, 3, 2, 170 -#' ) -#' -#' # Generate correlation from events -#' gs_corr <- generate_corr(event) -generate_corr <- function(event) { - elem <- event %>% subset(H1 == H2) - inter <- event %>% subset(H1 != H2) - n_hypotheses <- max(as.numeric(elem$H1)) - n_analyses <- max(elem$Analysis) - - # Diagonal - D <- diag(elem$Event) - - # Within hypothesis across analyses - for (i in 1:n_hypotheses) { - for (j in 2:n_analyses) { - count <- as.numeric(event %>% - filter(H1 == i & H2 == i & Analysis == j - 1) %>% - select(Event)) - D[i, n_hypotheses * (j - 1) + i] <- count - D[n_hypotheses * (j - 1) + i, i] <- count - } - } - - # Between hypotheses - for (i in 1:n_hypotheses) { - for (j in c(1:n_hypotheses)[-i]) { - for (k in 1:n_analyses) { - count1 <- as.numeric(event %>% - subset(((H1 == i & H2 == j) | (H1 == j & H2 == i)) & Analysis == k) %>% - select(Event)) - D[n_hypotheses * (k - 1) + i, n_hypotheses * (k - 1) + j] <- count1 - for (l in c(1:n_analyses)[-k]) { - count2 <- as.numeric(event %>% - subset(((H1 == i & H2 == j) | (H1 == j & H2 == i)) & Analysis == min(k, l)) %>% - select(Event)) - D[n_hypotheses * (k - 1) + i, n_hypotheses * (l - 1) + j] <- count2 - } - } - } - } - - corr_mat <- d_corr(D) - - col_names <- NULL - for (k in 1:n_analyses) { - for (i in 1:n_hypotheses) { - name_tmp <- paste("H", i, "_A", k, sep = "") - col_names <- c(col_names, name_tmp) - } - } - - colnames(corr_mat) <- col_names - - return(corr_mat) -} diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/R/generate_event_cc.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/R/generate_event_cc.R deleted file mode 100644 index 8e25bf4..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/R/generate_event_cc.R +++ /dev/null @@ -1,80 +0,0 @@ -#' This function generates a table of events for given experimental arms and a control group based on specified hypotheses. -#' -#' @param event A dataframe containing the following columns: -#' - `Population`: A character vector listing the population groups (e.g., experimental arms and control). -#' - `IA`: A numeric vector indicating the number of events observed in each group during interim analysis. -#' - `FA`: A numeric vector indicating the number of events observed in each group during final analysis. -#' The dataframe must contain at least these columns and can include additional analysis columns as needed. -#' @param hypothesis A list containing hypotheses specifying comparisons between experimental arms and the control group, -#' as well as comparisons among experimental arms. -#' -#' @return A dataframe with columns: -#' - `one_hypothesis`: The index of the first selected hypothesis from the provided list. -#' - `another_hypothesis`: The index of the second selected hypothesis from the provided list. -#' - `analysis`: The index indicating which analysis is being performed (e.g., interim or final). -#' - `common_events`: The calculated number of common events associated with the selected hypotheses. -#' -#' @examples -#' #------------------------Example of IA and FA -#' event <- data.frame( -#' Population = c("Experimental 1", "Experimental 2", "Experimental 3", "Control"), -#' IA = c(70, 75, 80, 85), # Interim Analysis values indicating the number of events observed in each group -#' FA = c(135, 150, 165, 170) -#' ) -#' -#' hypothesis <- list( -#' H1 = "Experimental 1 vs. Control", -#' H2 = "Experimental 2 vs. Control", -#' H3 = "Experimental 1 vs. Experimental 2" -#' ) -#' -#' generate_event_table_cc(event, hypothesis) -#' -#' #----------------------Example of two IAs and FA -#' event <- data.frame( -#' Population = c("Experimental 1", "Experimental 2", "Experimental 3", "Control"), -#' IA1 = c(70, 75, 80, 85), # First Interim Analysis values indicating the number of events observed in each group -#' IA2 = c(90, 95, 100, 105), # Second Interim Analysis values indicating the number of events observed in each group -#' FA = c(135, 150, 165, 170) -#' ) -#' -#' hypothesis <- list( -#' H1 = "Experimental 1 vs. Control", -#' H2 = "Experimental 2 vs. Control", -#' H3 = "Experimental 1 vs. Experimental 2" -#' ) -#' -#' generate_event_table_cc(event, hypothesis) -generate_event_table_cc <- function(event, hypothesis) { - result_df <- tibble( - one_hypothesis = integer(), - another_hypothesis = integer(), - analysis = integer(), - common_events = integer() - ) - - # Iterate through the input data to calculate the events - for (i in 1:length(hypothesis)) { # number of hypothesis - for (j in i:length(hypothesis)) { - for (k in 1:(ncol(event) - 1)) { # Iterate through the analyses - if (i != j) { - hyp_i <- unlist(strsplit(hypothesis[[i]], " vs. ")) - hyp_j <- unlist(strsplit(hypothesis[[j]], " vs. ")) - common_factor <- intersect(hyp_i, hyp_j) - eventn <- event[event$Population == common_factor, k + 1] - } else { - eventn <- event[i, k + 1] + event[event$Population == "Control", k + 1] - } - - result_df <- rbind(result_df, tibble( - one_hypothesis = i, - another_hypothesis = j, - analysis = k, - common_events = eventn - )) - result_df <- result_df[order(result_df$analysis), ] - } - } - } - return(result_df) -} diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/R/generate_event_ol.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/R/generate_event_ol.R deleted file mode 100644 index dd39253..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/R/generate_event_ol.R +++ /dev/null @@ -1,94 +0,0 @@ -#' This function generates a table of events for specified populations based on the provided hypotheses. -#' -#' @param event` dataframe should have the following structure: -#' - `Population`: A character vector indicating the population groups (e.g., "Population 1", "Population 2", "Population 1 Intersection 2", and "Overall population"). -#' - `IA`: Numeric vector indicating the number of events observed in each group during interim analysis. -#' - `FA`: Numeric vector indicating the number of events observed in each group during final analysis. -#' The dataframe must contain at least these columns and can include additional analysis columns as needed. -#' @param hypothesis A list of strings where each item represents a hypothesis regarding efficacy, formatted as follows: -#' - H1: "Efficacy in Population 1" -#' - H2: "Efficacy in Population 2" -#' - H3: "Efficacy in Overall population" -#' Each hypothesis is used for comparisons in the generated event table. -#' -#' @return A dataframe with the following columns: -#' - `one_hypothesis`: The index of the first selected hypothesis from the provided list. -#' - `another_hypothesis`: The index of the second selected hypothesis from the provided list. -#' - `analysis`: The index indicating which analysis is being performed (e.g., interim or final). -#' - `common_events`: The calculated number of common events associated with the selected hypotheses. -#' -#' @export -#' -#' @examples -#' #------------------------Example of IA and FA -#' event <- data.frame( -#' Population = c("Population 1", "Population 2", "Population 1 Intersection 2", "Overall population"), -#' IA = c(100, 110, 80, 225), # Interim Analysis values indicating the number of events observed in each group -#' FA = c(200, 220, 160, 450) -#' ) -#' -#' hypothesis <- list( -#' H1 = "Efficacy in Population 1", -#' H2 = "Efficacy in Population 2", -#' H3 = "Efficacy in Overall population" -#' ) -#' -#' generate_event_table_ol(event, hypothesis) -#' -#' #----------------------Example of two IAs and FA -#' event <- data.frame( -#' Population = c("Population 1", "Population 2", "Population 1 Intersection 2", "Overall population"), -#' IA1 = c(100, 110, 80, 225), # First Interim Analysis values indicating the number of events observed in each group -#' IA2 = c(120, 130, 90, 240), # Second Interim Analysis values indicating the number of events observed in each group -#' FA = c(200, 220, 160, 450) -#' ) -#' -#' hypothesis <- list( -#' H1 = "Efficacy in Population 1", -#' H2 = "Efficacy in Population 2", -#' H3 = "Efficacy in Overall population" -#' ) -#' -#' generate_event_table_ol(event, hypothesis) -#' -generate_event_table_ol <- function(event, hypothesis) { - result_df <- tibble( - one_hypothesis = integer(), - another_hypothesis = integer(), - analysis = integer(), - common_events = integer() - ) - - for (i in 1:length(hypothesis)) { - for (j in i:length(hypothesis)) { - for (k in 1:(ncol(event) - 1)) { - hyp_i <- unlist(strsplit(hypothesis[[i]], "Efficacy in "))[2] - hyp_j <- unlist(strsplit(hypothesis[[j]], "Efficacy in "))[2] - - common_factor <- intersect(hyp_i, hyp_j) - - if (length(common_factor) > 0) { - if ("Overall population" %in% c(hyp_i, hyp_j)) { - eventn <- event[event$Population == "Overall population", k + 1] - } else { - eventn <- event[i, k + 1] - } - } else if ("Overall population" %in% c(hyp_i, hyp_j)) { - eventn <- event[i, k + 1] - } else { - eventn <- event[event$Population == "Population 1 Intersection 2", k + 1] - } - - result_df <- rbind(result_df, tibble( - one_hypothesis = i, - another_hypothesis = j, - analysis = k, - common_events = eventn - )) - result_df <- result_df[order(result_df$analysis), ] - } - } - } - - return(result_df) -} diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/R/generate_event_table.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/R/generate_event_table.R deleted file mode 100644 index a835be4..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/R/generate_event_table.R +++ /dev/null @@ -1,112 +0,0 @@ -# Copyright (c) 2023 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. -# All rights reserved. -# -# This file is part of the wpgsd program. -# -# wpgsd 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 . - -#' Generate table of event counts from ADSL and ADTTE datasets -#' -#' @param paths A vector of paths for analysis datasets. -#' Length should be equal to the number of analyses completed. -#' @param h_select Selection criterion for each hypothesis. -#' Should be a tibble containing 2 columns: `Hypothesis` and `Crit`. -#' @param adsl_name SAS dataset name for subject-level analysis data. -#' Usually it is `"adsl"`. -#' @param adtte_name SAS dataset name for time-to-event analysis data. -#' Usually it is `"adtte"`. -#' @param key_var Key variable to join the `adsl` and `adtte` datasets. -#' For example, `"USUBJID"` or `"SUBJID"`. -#' @param cnsr_var Variable to indicate censoring (`1` = censor; `0` = event). -#' For example, `"CNSR"`. -#' -#' @return A list with two components: -#' - `event`: an event count table as input for [generate_bounds()]. -#' - `dsets`: analysis datasets of each hypothesis. -#' -#' @importFrom tibble tibble -#' @importFrom dplyr %>% filter select -#' @importFrom tidyselect all_of -#' -#' @export -#' -#' @examples -#' library(dplyr) -#' -#' paths <- system.file("extdata/", package = "wpgsd") -#' -#' # Selection criteria for each hypothesis -#' h_select <- tibble::tribble( -#' ~Hypothesis, ~Crit, -#' 1, "PARAMCD == 'OS' & TRT01P %in% c('Xanomeline High Dose', 'Placebo')", -#' 2, "PARAMCD == 'OS' & TRT01P %in% c('Xanomeline Low Dose', 'Placebo')" -#' ) -#' -#' event <- generate_event_table(paths, h_select, -#' adsl_name = "adsl", adtte_name = "adtte", -#' key_var = "USUBJID", cnsr_var = "CNSR" -#' )$event -#' -#' event %>% -#' gt::gt() %>% -#' gt::tab_header(title = "Event Count - Computed from SAS Datasets Example") -generate_event_table <- function(paths, h_select, - adsl_name, adtte_name, - key_var, cnsr_var) { - event <- NULL - dsets <- list() - for (i in seq_along(paths)) { # Number of path is number of analysis - path <- paths[i] - adsl <- haven::read_sas(paste(path, "/", adsl_name, ".sas7bdat", sep = "")) - adtte <- haven::read_sas(paste(path, "/", adtte_name, ".sas7bdat", sep = "")) - dset <- dplyr::left_join(adtte, adsl, by = key_var, suffix = c("", ".y")) - - for (j in seq_len(nrow(h_select))) { # number of time-to-event hypotheses - h_var <- paste("H", j, sep = "") - crit <- h_select[j, 2] - dset <- dset %>% dplyr::mutate(!!h_var := ifelse(eval(str2expression(as.character(crit))), - 1, 0 - )) - event_tmp <- tibble( - H1 = paste(j), - H2 = paste(j), - Analysis = i, - Event = sum(dset %>% - filter(eval(str2expression(as.character(cnsr_var))) == 0) %>% - select(all_of(h_var)), na.rm = TRUE) - ) - event <- rbind(event, event_tmp) - - if (j > 1) { - for (k in 1:(j - 1)) { - h_var_k <- paste("H", k, sep = "") - - event_tmp <- tibble( - H1 = paste(k), - H2 = paste(j), - Analysis = i, - Event = sum(dset %>% - filter(eval(str2expression(as.character(cnsr_var))) == 0 & eval(str2expression(as.character(h_var_k))) == 1) %>% - select(all_of(h_var)), na.rm = TRUE) - ) - event <- rbind(event, event_tmp) - } - } - } - - dsets[[i]] <- dset - } - - return(list(event = event, dsets = dsets)) -} diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/R/generate_event_table_.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/R/generate_event_table_.R deleted file mode 100644 index 68b99a8..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/R/generate_event_table_.R +++ /dev/null @@ -1,73 +0,0 @@ -#' This function creates a table summarizing event counts based on specified hypotheses and user input data. -#' It can handle two types of analysis: one comparing experimental groups to a common control and another analyzing the overlap of populations. -#' -#' @param event` dataframe should have the following structure: -#' - `Population`: A character vector indicating the population groups. For example, "Population 1", "Population 2", "Overall population" in overlap population situation; or experimental arms and control in common control situation. -#' - `IA`: Numeric vector indicating the number of events observed in each group during interim analysis. -#' - `FA`: Numeric vector indicating the number of events observed in each group during final analysis. -#' The dataframe must contain at least these columns and can include additional analysis columns as needed. -#' @param hypothesis A list containing hypotheses that specify the comparisons to be made between the groups: -#' - For example: -#' - "Experimental 1 vs. Control" -#' - "Efficacy in Population 1" -#' -#' @param type A character string specifying the type of analysis to conduct. It should be one of the following: -#' - `"common_control"`: Analyze the event counts comparing experimental groups to common control. -#' - `"overlap_population"`: Analyze the event counts to assess overlap in populations. -#' -#' @return A dataframe with four columns: -#' - `one_hypothesis`: The index of the first selected hypothesis from the provided list. -#' - `another_hypothesis`: The index of the second selected hypothesis from the provided list. -#' - `analysis`: The index indicating which analysis is being performed (e.g., interim or final). -#' - `common_events`: The calculated number of common events associated with the selected hypotheses. -#' -#' @export -#' -#' @examples -#' # ----------------------- Example of common control -#' event <- data.frame( -#' Population = c("Experimental 1", "Experimental 2", "Experimental 3", "Control"), -#' IA = c(70, 75, 80, 85), # Interim analysis values indicating the number of events observed in each experimental group. -#' FA = c(135, 150, 165, 170) # Final analysis values indicating the cumulative number of events observed in each group. -#' ) -#' -#' hypothesis <- list( -#' H1 = "Experimental 1 vs. Control", # Hypothesis comparing Experimental 1 with Control. -#' H2 = "Experimental 2 vs. Control", # Hypothesis comparing Experimental 2 with Control. -#' H3 = "Experimental 1 vs. Experimental 2" # Hypothesis comparing Experimental 1 and Experimental 2. -#' ) -#' -#' generate_event_table_(event, hypothesis, type = "common_control") -#' -#' # ------------------------ Example of overall population -#' event <- data.frame( -#' Population = c("Population 1", "Population 2", "Population 1 Intersection 2", "Overall population"), -#' IA = c(100, 110, 80, 225), # Interim analysis values for the overall population. -#' FA = c(200, 220, 160, 450) # Final analysis values for the overall population. -#' ) -#' -#' hypothesis <- list( -#' H1 = "Efficacy in Population 1", # Hypothesis assessing efficacy in Population 1. -#' H2 = "Efficacy in Population 2", # Hypothesis assessing efficacy in Population 2. -#' H3 = "Efficacy in Overall population" # Hypothesis assessing efficacy in the overall population. -#' ) -#' -#' generate_event_table_(event, hypothesis, type = "overlap_population") -#' -generate_event_table_ <- function(event, hypothesis, type = c("common_control", "overlap_population")) { - type <- match.arg(type) - - result_df <- tibble( - one_hypothesis = integer(), - another_hypothesis = integer(), - analysis = integer(), - common_events = integer() - ) - - if (type == "common_control") { - result_df <- generate_event_table_cc(event, hypothesis) # see generate_event_cc.R - } else if (type == "overlap_population") { - result_df <- generate_event_table_ol(event, hypothesis) # see generate_event_ol.R - } - return(result_df) -} diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/R/globals.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/R/globals.R deleted file mode 100644 index bc243a2..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/R/globals.R +++ /dev/null @@ -1,32 +0,0 @@ -# Copyright (c) 2023 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. -# All rights reserved. -# -# This file is part of the wpgsd program. -# -# wpgsd 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 . - -utils::globalVariables( - unique( - c( - # From `calc_seq_p()` - c("analysis"), - # From `closed_test()` - c("Analysis"), - # From `generate_bounds()` - c("Analysis", "Hypotheses"), - # From `generate_corr()` - c("H1", "H2", "Analysis", "Event") - ) - ) -) diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/R/s7_classes.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/R/s7_classes.R deleted file mode 100644 index 953161d..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/R/s7_classes.R +++ /dev/null @@ -1,165 +0,0 @@ -# Copyright (c) 2023 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. -# All rights reserved. -# -# This file is part of the wpgsd program. -# -# wpgsd 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 . - -# S7 Classes for wpgsd Package -# -# This file contains S7 class definitions for the wpgsd package. -# These classes provide type safety and method dispatch for the main -# data structures used in weighted parametric group sequential designs. - -#' @importFrom S7 new_class new_object - -#' EventTable S7 Class -#' -#' Represents event count data structure used in generate_corr() and generate_event_table() -#' -#' @param data A tibble containing H1, H2, Analysis, and Event columns -#' -#' @export -EventTable <- S7::new_class( - "EventTable", - properties = list( - data = S7::class_data.frame, - n_hypotheses = S7::class_integer, - n_analyses = S7::class_integer - ), - constructor = function(data = tibble::tibble()) { - # Validate required columns - required_cols <- c("H1", "H2", "Analysis", "Event") - missing_cols <- setdiff(required_cols, names(data)) - if (length(missing_cols) > 0) { - stop("EventTable requires columns: ", paste(missing_cols, collapse = ", ")) - } - - # Calculate derived properties - n_hypotheses <- max(c(data$H1, data$H2), na.rm = TRUE) - n_analyses <- max(data$Analysis, na.rm = TRUE) - - S7::new_object( - EventTable, - data = data, - n_hypotheses = as.integer(n_hypotheses), - n_analyses = as.integer(n_analyses) - ) - }, - validator = function(self) { - # Validate data types - if (!is.numeric(self@data$H1) || !is.numeric(self@data$H2)) { - "@data$H1 and @data$H2 must be numeric" - } else if (!is.numeric(self@data$Analysis)) { - "@data$Analysis must be numeric" - } else if (!is.numeric(self@data$Event)) { - "@data$Event must be numeric" - } else if (any(self@data$H1 <= 0, na.rm = TRUE) || any(self@data$H2 <= 0, na.rm = TRUE)) { - "Hypothesis indices (H1, H2) must be positive integers" - } else if (any(self@data$Analysis <= 0, na.rm = TRUE)) { - "Analysis numbers must be positive integers" - } else if (any(self@data$Event < 0, na.rm = TRUE)) { - "Event counts must be non-negative" - } - } -) - -# TODO: Add S7 method definitions later -# #' Print method for EventTable -# S7::method(show, EventTable) <- function(object) { ... } -# -# #' Summary method for EventTable -# S7::method(summary, EventTable) <- function(object, ...) { ... } - -#' Subset method for EventTable -#' -#' @param x An EventTable object -#' @param analysis Analysis number(s) to subset -#' @param hypotheses Hypothesis indices to subset -#' @param ... Additional arguments (unused) -#' -#' @export -subset_event_table <- function(x, analysis = NULL, hypotheses = NULL) { - if (!S7::S7_inherits(x, EventTable)) { - stop("x must be an EventTable object") - } - - data_subset <- x@data - - if (!is.null(analysis)) { - data_subset <- data_subset[data_subset$Analysis %in% analysis, ] - } - - if (!is.null(hypotheses)) { - data_subset <- data_subset[ - (data_subset$H1 %in% hypotheses) & (data_subset$H2 %in% hypotheses), - ] - } - - EventTable(data = data_subset) -} - -#' Convert tibble to EventTable -#' -#' @param data A tibble with H1, H2, Analysis, Event columns -#' -#' @export -as_event_table <- function(data) { - if (S7::S7_inherits(data, EventTable)) { - return(data) - } - EventTable(data = data) -} - -#' Validate EventTable data format -#' -#' @param data A data frame or tibble to validate -#' -#' @return TRUE if valid, stops with error message if not -#' -#' @export -validate_event_table_data <- function(data) { - required_cols <- c("H1", "H2", "Analysis", "Event") - missing_cols <- setdiff(required_cols, names(data)) - - if (length(missing_cols) > 0) { - stop("Missing required columns: ", paste(missing_cols, collapse = ", ")) - } - - if (!is.numeric(data$H1) || !is.numeric(data$H2)) { - stop("H1 and H2 must be numeric") - } - - if (!is.numeric(data$Analysis)) { - stop("Analysis must be numeric") - } - - if (!is.numeric(data$Event)) { - stop("Event must be numeric") - } - - if (any(data$H1 <= 0, na.rm = TRUE) || any(data$H2 <= 0, na.rm = TRUE)) { - stop("Hypothesis indices (H1, H2) must be positive integers") - } - - if (any(data$Analysis <= 0, na.rm = TRUE)) { - stop("Analysis numbers must be positive integers") - } - - if (any(data$Event < 0, na.rm = TRUE)) { - stop("Event counts must be non-negative") - } - - TRUE -} diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/R/utils-tidy-eval.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/R/utils-tidy-eval.R deleted file mode 100644 index 09c3698..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/R/utils-tidy-eval.R +++ /dev/null @@ -1,107 +0,0 @@ -#' Tidy eval helpers -#' -#' @description -#' This page lists the tidy eval tools reexported in this package from -#' rlang. To learn about using tidy eval in scripts and packages at a -#' high level, see the [dplyr programming -#' vignette](https://dplyr.tidyverse.org/articles/programming.html) -#' and the [ggplot2 in packages -#' vignette](https://ggplot2.tidyverse.org/articles/ggplot2-in-packages.html). -#' The [Metaprogramming -#' section](https://adv-r.hadley.nz/metaprogramming.html) of [Advanced -#' R](https://adv-r.hadley.nz) may also be useful for a deeper dive. -#' -#' * The tidy eval operators `{{`, `!!`, and `!!!` are syntactic -#' constructs which are specially interpreted by tidy eval functions. -#' You will mostly need `{{`, as `!!` and `!!!` are more advanced -#' operators which you should not have to use in simple cases. -#' -#' The curly-curly operator `{{` allows you to tunnel data-variables -#' passed from function arguments inside other tidy eval functions. -#' `{{` is designed for individual arguments. To pass multiple -#' arguments contained in dots, use `...` in the normal way. -#' -#' ``` -#' my_function <- function(data, var, ...) { -#' data %>% -#' group_by(...) %>% -#' summarise(mean = mean({{ var }})) -#' } -#' ``` -#' -#' * [enquo()] and [enquos()] delay the execution of one or several -#' function arguments. The former returns a single expression, the -#' latter returns a list of expressions. Once defused, expressions -#' will no longer evaluate on their own. They must be injected back -#' into an evaluation context with `!!` (for a single expression) and -#' `!!!` (for a list of expressions). -#' -#' ``` -#' my_function <- function(data, var, ...) { -#' # Defuse -#' var <- enquo(var) -#' dots <- enquos(...) -#' -#' # Inject -#' data %>% -#' group_by(!!!dots) %>% -#' summarise(mean = mean(!!var)) -#' } -#' ``` -#' -#' In this simple case, the code is equivalent to the usage of `{{` -#' and `...` above. Defusing with `enquo()` or `enquos()` is only -#' needed in more complex cases, for instance if you need to inspect -#' or modify the expressions in some way. -#' -#' * The `.data` pronoun is an object that represents the current -#' slice of data. If you have a variable name in a string, use the -#' `.data` pronoun to subset that variable with `[[`. -#' -#' ``` -#' my_var <- "disp" -#' mtcars %>% summarise(mean = mean(.data[[my_var]])) -#' ``` -#' -#' * Another tidy eval operator is `:=`. It makes it possible to use -#' glue and curly-curly syntax on the LHS of `=`. For technical -#' reasons, the R language doesn't support complex expressions on -#' the left of `=`, so we use `:=` as a workaround. -#' -#' ``` -#' my_function <- function(data, var, suffix = "foo") { -#' # Use `{{` to tunnel function arguments and the usual glue -#' # operator `{` to interpolate plain strings. -#' data %>% -#' summarise("{{ var }}_mean_{suffix}" := mean({{ var }})) -#' } -#' ``` -#' -#' * Many tidy eval functions like `dplyr::mutate()` or -#' `dplyr::summarise()` give an automatic name to unnamed inputs. If -#' you need to create the same sort of automatic names by yourself, -#' use `as_label()`. For instance, the glue-tunnelling syntax above -#' can be reproduced manually with: -#' -#' ``` -#' my_function <- function(data, var, suffix = "foo") { -#' var <- enquo(var) -#' prefix <- as_label(var) -#' data %>% -#' summarise("{prefix}_mean_{suffix}" := mean(!!var)) -#' } -#' ``` -#' -#' Expressions defused with `enquo()` (or tunnelled with `{{`) need -#' not be simple column names, they can be arbitrarily complex. -#' `as_label()` handles those cases gracefully. If your code assumes -#' a simple column name, use `as_name()` instead. This is safer -#' because it throws an error if the input is not a name as expected. -#' -#' @md -#' @name tidyeval -#' @keywords internal -#' @importFrom rlang enquo enquos .data := as_name as_label -#' @aliases enquo enquos .data := as_name as_label -#' @export enquo enquos .data := as_name as_label -NULL diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/R/wpgsd-package.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/R/wpgsd-package.R deleted file mode 100644 index f3fd052..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/R/wpgsd-package.R +++ /dev/null @@ -1,3 +0,0 @@ -#' @keywords internal -"_PACKAGE" -NULL diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/README.md b/wpgsd.Rcheck/00_pkg_src/wpgsd/README.md deleted file mode 100644 index e2a7c93..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/README.md +++ /dev/null @@ -1,62 +0,0 @@ -# wpgsd - - -[![R-CMD-check](https://github.com/Merck/wpgsd/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/Merck/wpgsd/actions/workflows/R-CMD-check.yaml) -[![Codecov test coverage](https://codecov.io/gh/Merck/wpgsd/branch/main/graph/badge.svg)](https://app.codecov.io/gh/Merck/wpgsd?branch=main) - - -Weighted parametric group sequential design (WPGSD) allows one to take advantage -of the known correlation structure in constructing efficacy bounds to control -family-wise error rate (FWER) for a group sequential design. Here correlation -may be due to common observations in nested populations, due to common -observations in overlapping populations, or due to common observations -in the control arm. - -## Installation - -The easiest way to get wpgsd is to install from CRAN: - -```r -install.packages("wpgsd") -``` - -Alternatively, to use a new feature or get a bug fix, -you can install the development version of wpgsd from GitHub: - -```r -# install.packages("remotes") -remotes::install_github("Merck/wpgsd") -``` - -## Current limitations - -There are some limitations that are currently being addressed. -Please use the package with caution in production environments. - -- The current implementation may have limitations when handling more - complex scenarios beyond what has been demonstrated. -- The API is subject to potential breaking changes as it is currently - being reviewed and refactored. -- Further validation is needed to ensure the reliability of the package. -- More documentation is expected in the future releases. - -## References - -Anderson, K. M., Guo, Z., Zhao, J., & Sun, L. Z. (2022). -A unified framework for weighted parametric group sequential design. -_Biometrical Journal_, 64(7), 1219--1239. - -BibTeX entry: - -``` -@article{anderson2022unified, - 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}, - volume = {64}, - number = {7}, - pages = {1219--1239}, - year = {2022}, - publisher = {Wiley Online Library} -} -``` diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/build/partial.rdb b/wpgsd.Rcheck/00_pkg_src/wpgsd/build/partial.rdb deleted file mode 100644 index c78d6ee06a404621905e3ec5985a35cc97f23098..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 60 zcmb2|=3oE==I#ec2?+^F35l$e&L}K1V3ycmz{u&wCdTHcaCX-88MC8!QaBt`B>yoo M%+tSm+Z?C~0PEoqEdT%j diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/build/vignette.rds b/wpgsd.Rcheck/00_pkg_src/wpgsd/build/vignette.rds deleted file mode 100644 index 5ec4d87decb5d8ba6b51641b0f6989042223cbea..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 362 zcmV-w0hRtAiwFP!000001C3HmPXaLzU0^}MV2J3&c<3Kkeu9ZgxOhS1!J8@V0LAWh z?S~s~{%`{h(BiTr#%wz6yqTT%^4ix<6h-wYZencUvC+rS!qvkSvw36d-2v z&8T~oO+jmw2|uOxd25%v0rhdRO;+3*&>HLXC>c* zv&XIn(N)hqe&QY9h}h2FaYTRY|LlwF7;2uTnb8z4YFBJ|FdhjBq2Wc?ebN{YNB&sb z3mrlZ84p)^`UuNHY0M9a+FBKZK-S&7-Y*R6_4>Q2h)HUKq5yU{wRAAm_&;W=AB*f} Ik^ce!0D^Y2(*OVf diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/examples/event_table_integration.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/examples/event_table_integration.R deleted file mode 100644 index 06fb2b6..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/examples/event_table_integration.R +++ /dev/null @@ -1,71 +0,0 @@ -# Example integration of EventTable S7 class with existing wpgsd functions -# This shows how EventTable can work with generate_corr() - -library(wpgsd) -library(tibble) - -# Example 1: Using EventTable with generate_corr() -# Create event data using the EventTable class -event_data_raw <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160, - 3, 3, 1, 165, - 1, 2, 1, 85, - 1, 3, 1, 85, - 2, 3, 1, 85, - 1, 1, 2, 305, - 2, 2, 2, 320, - 3, 3, 2, 335, - 1, 2, 2, 170, - 1, 3, 2, 170, - 2, 3, 2, 170 -) - -# Create EventTable object -event_table <- EventTable(data = event_data_raw) -print("Created EventTable:") -print(event_table) - -# Use with generate_corr (currently expects tibble/data.frame) -# The @data slot extracts the underlying tibble -correlation_matrix <- generate_corr(event_table@data) -print("Generated correlation matrix:") -print(correlation_matrix) - -# Example 2: Data validation before processing -cat("\nExample 2: Data validation\n") -cat("==========================\n") - -# Try to create EventTable with invalid data -tryCatch({ - invalid_data <- tibble::tibble( - H1 = c(1, 2, -1), # Invalid: negative hypothesis index - H2 = c(1, 2, 3), - Analysis = c(1, 1, 1), - Event = c(100, 200, 150) - ) - - invalid_table <- EventTable(data = invalid_data) -}, error = function(e) { - cat("Validation caught error:", e$message, "\n") -}) - -# Example 3: Subsetting capabilities -cat("\nExample 3: Subsetting\n") -cat("=====================\n") - -# Get only first analysis -analysis_1 <- subset_event_table(event_table, analysis = 1) -cat("Analysis 1 events:\n") -print(analysis_1@data) - -# Get only H1-H2 hypothesis pairs -h1_h2_events <- subset_event_table(event_table, hypotheses = c(1, 2)) -cat("\nH1-H2 hypothesis events:\n") -print(h1_h2_events@data) - -# Example 4: Summary information -cat("\nExample 4: Summary\n") -cat("==================\n") -summary(event_table) diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/examples/test_event_table.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/examples/test_event_table.R deleted file mode 100644 index d55ecbf..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/examples/test_event_table.R +++ /dev/null @@ -1,50 +0,0 @@ -# Test script for EventTable S7 class -# This demonstrates how to use the new EventTable class - -library(wpgsd) -library(tibble) - -# Create sample event data as used in the package -event_data <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160, - 3, 3, 1, 165, - 1, 2, 1, 85, - 1, 3, 1, 85, - 2, 3, 1, 85, - 1, 1, 2, 305, - 2, 2, 2, 320, - 3, 3, 2, 335, - 1, 2, 2, 170, - 1, 3, 2, 170, - 2, 3, 2, 170 -) - -# Create EventTable object -event_table <- EventTable(data = event_data) - -# Print the object -print(event_table) - -# Get summary -summary(event_table) - -# Subset by analysis -subset_analysis_1 <- subset_event_table(event_table, analysis = 1) -print("Analysis 1 subset:") -print(subset_analysis_1) - -# Subset by hypotheses -subset_h1_h2 <- subset_event_table(event_table, hypotheses = c(1, 2)) -print("H1-H2 subset:") -print(subset_h1_h2) - -# Convert existing tibble to EventTable -converted_table <- as_event_table(event_data) -print("Converted table:") -print(converted_table) - -# Validate data -validate_event_table_data(event_data) -print("Data validation passed!") diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/CITATION b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/CITATION deleted file mode 100644 index 4cf24a4..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/CITATION +++ /dev/null @@ -1,12 +0,0 @@ -bibentry( - "Article", - title = "A unified framework for weighted parametric group sequential design", - author = "Keaven M Anderson and Zifang Guo and Jing Zhao and Linda Z Sun", - journal = "Biometrical Journal", - volume = "64", - number = "7", - pages = "1219--1239", - year = "2022", - publisher = "Wiley Online Library", - doi = "10.1002/bimj.202100085", -) diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/aiprompts/compute_correlations_prompts.txt b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/aiprompts/compute_correlations_prompts.txt deleted file mode 100644 index 6c9d599..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/aiprompts/compute_correlations_prompts.txt +++ /dev/null @@ -1,76 +0,0 @@ -Three functions are defined here, one for checking input data (`check_event_data()`) and -another for computing correlations (`compute_correlations()`) and one (`gen_corr()`) for transforming a data frame where correlations are computed -to a correlation matrix. -All three should be exported. -When users enter the `event` input to `compute_correlations()`, it is advised to call `check_event_data()` first by -specifying check = TRUE (the default). -Output will be output either as a data frame or as a correlation matrix, as specified below. -An exported function `gen_corr()` will do a transformation from the data frame output to a symmetric matrix. - -Let M > 1 be the integer number of hypotheses to be tested. -Assume there are integer K > 1 analyses. -Let real-valued Z[i, k] be the standardized normal test statistic for -hypothesis i, 1 <= i <= M, analysis k, 1 <= k <= K. -We wish to compute and return correlations for all hypothesis tests -performed across analyses. -For tests Z[i1, k1], Z[i2, k2], 1 <= i1 <= i2 <= M, 1 <= k1 <= k2 <= K that are -performed we will provide the count of events (for time-to-event outcomes) or -sample size (for other outcomes) that are common between the two tests. -This is input in a data frame called `event` -with the following columns: - -`H1` - hypothesis i1 = H1 -`H2` - hypothesis i2 = H2 -`Analysis` - value in 1,2,...,K -`Event` - event count for time-to-event endpoints, otherwise sample size which -is included in the both test Z[H1, Analysis] and Z[H2, Analysis]. - -Other arguments for `compute_correlations()` are - -`check` - logical indicating whether to perform input checks using `check_event_data()` (default is TRUE) -`return_matrix` - logical indicating whether to return a correlation matrix (default is TRUE) - -The function `check_event_data()` will have the argument `event` as specified above. -Data checks in `check_event_data()` : -- Check that `event` is a data frame and return an informative error message if not. -- Check that columns specified above exist and return informative error message, if not. -- Check that H1 <= H2 for each row and provide informative error message, if not. -- Check that the combination of H1, H2, Analysis is a unique in the input; -this should be evaluated and appropriate error message returned if not unique. -Check that Event is an integer >= 0 for all rows and provide an -appropriate error message, if not. -- Check that unique values of Analysis are sequential positive integers with -minimum value 1 and maximum value > 1; K from above will be the maximum value. -Return an informative error message if any of these checks fail. -- Check that unique values of H1 are sequential integers with minimum value 1 -and maximum value > 1; M from above will be the maximum value. -Same for H2. -Return an informative error message if any of these checks fail. -- Check that for k=1,...,K that if there is a row with H1 < H2, then there is also a row with H1 == H2. -Return an informative error message if not. -- Check that for any value of Analysis, and H1 = i1 < H2 = i2 specified that there is also a row with H1 = i1, H2 = i1 and another with -H1 = i2, H2 = i2. Return an informative error message if not. - - -Returned value from `compute_correlations()`. -The returned value either a data frame (if `return_matrix = FALSE`) or a correlation matrix, otherwise. -The data frame has the following columns. - H1 - hypothesis i1 - H2 - hypothesis i2 >= i1 - Analysis1 - k1. - Analysis2 - k2 >= k1. - Correlation - correlation between Z[i1, k1] and Z[i2, k2]. - -Correlation is computed as -Event for i1, i2 and k1 divided by square root of the product of -Event for H1 = i1, H2 = i1, Analysis = min(k1, k2) times -Event for H1 = i2, H2 = i2, Analysis = k2. - -If `return_ matrix = TRUE` (default) then a symmetric matrix should be returned as follows. -Columns should be named `H1_A1`, `H1_A2`, ..., `H1_AK`, `H2_A1`, `H2_A2`, ..., `H2_AK`, ..., `HM_A1`, `HM_A2`, ..., `HM_AK` where -M and K are as computed from `event`. -Rows should be labeled the same way. -Diagonal elements are all 1. -Off-diagonal elements are filled with the computed correlations. -Only cells included should be where `Event` value was provided for the combination of Analysis, H1 and H2. - diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/aiprompts/s7 prompts.md b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/aiprompts/s7 prompts.md deleted file mode 100644 index 69bae54..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/aiprompts/s7 prompts.md +++ /dev/null @@ -1,101 +0,0 @@ -## Prompt for s7 Class conversion - -We want to convert the wpgsd R package to operate with s7 classes throughout. -Please check for exported functions in the R directory suggest what s7 classes need to be developed. - -## Suggested S7 Classes for wpgsd Package Conversion - -Based on the exported functions and their data structures, here are the key S7 classes that should be developed: - -### 1. **EventTable Class** -- **Purpose**: Represents event count data structure used in `generate_corr()` and `generate_event_table()` -- **Key Fields**: - - `H1`, `H2`: Hypothesis indices - - `Analysis`: Analysis number - - `Event`: Event count -- **Methods**: Validation, printing, subsetting - -### 2. **CorrelationMatrix Class** -- **Purpose**: Represents correlation matrices returned by `generate_corr()` -- **Key Fields**: - - `matrix`: The correlation matrix - - `n_hypotheses`: Number of hypotheses - - `n_analyses`: Number of analyses - - `column_names`: Named columns (e.g., "H1_A1", "H2_A1", etc.) -- **Methods**: Validation (positive definite), printing, subsetting - -### 3. **TransitionMatrix Class** -- **Purpose**: Represents transition matrices used in graphical procedures -- **Key Fields**: - - `matrix`: The transition matrix - - `n_hypotheses`: Number of hypotheses -- **Methods**: Validation (row sums ≤ 1), printing - -### 4. **Bounds Class** -- **Purpose**: Represents p-value boundaries from `generate_bounds()` -- **Key Fields**: - - `data`: Tibble with Analysis, Hypotheses, H1, H2, etc., xi columns - - `type`: Boundary type (0, 1, 2, or 3) - - `alpha`: Overall alpha level - - `n_hypotheses`: Number of hypotheses - - `n_analyses`: Number of analyses -- **Methods**: Validation, printing, plotting - -### 5. **ObservedPValues Class** -- **Purpose**: Represents observed p-values for `closed_test()` -- **Key Fields**: - - `data`: Tibble with Analysis, H1, H2, etc. columns - - `n_hypotheses`: Number of hypotheses - - `n_analyses`: Number of analyses -- **Methods**: Validation, printing - -### 6. **ClosedTestResult Class** -- **Purpose**: Represents results from `closed_test()` -- **Key Fields**: - - `outcome_matrix`: Matrix summarizing testing results - - `bounds`: Associated bounds used - - `p_obs`: Observed p-values used - - `rejected_hypotheses`: List of rejected hypotheses by analysis -- **Methods**: Validation, printing, summary - -### 7. **StudyDesign Class** -- **Purpose**: High-level class to encapsulate entire study design -- **Key Fields**: - - `initial_weights`: Vector of initial hypothesis weights - - `transition_matrix`: TransitionMatrix object - - `n_hypotheses`: Number of hypotheses - - `n_analyses`: Number of planned analyses - - `alpha`: Overall alpha level - - `spending_functions`: List of spending functions -- **Methods**: Validation, printing, summary - -### 8. **SequentialPValue Class** -- **Purpose**: Represents sequential p-values from `calc_seq_p()` -- **Key Fields**: - - `value`: The sequential p-value - - `test_analysis`: Analysis index - - `test_hypothesis`: Hypothesis being tested - - `method_type`: Alpha spending type used -- **Methods**: Validation, printing - -## Implementation Benefits - -1. **Type Safety**: S7 classes provide strong typing and validation -2. **Method Dispatch**: Can implement specialized methods for each class -3. **Consistency**: Standardized data structures across the package -4. **User Experience**: Better error messages and documentation -5. **Extensibility**: Easy to add new methods and functionality - -## Migration Strategy - -1. Start with core data structures (`EventTable`, `CorrelationMatrix`) -2. Update `generate_corr()` to return `CorrelationMatrix` objects -3. Update `generate_bounds()` to return `Bounds` objects -4. Progressively convert other functions -5. Ensure backward compatibility during transition -6. Update documentation and vignettes - -This S7 class structure would provide a solid foundation for the wpgsd package while maintaining the existing functionality and improving the user experience with better type safety and method dispatch. - -Claude Sonnet 4 running under VSCode returned the following: - diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/adj-seq-p.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/adj-seq-p.R deleted file mode 100644 index 63d7cc2..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/adj-seq-p.R +++ /dev/null @@ -1,739 +0,0 @@ -## ----message = FALSE, warning = FALSE----------------------------------------- -library(wpgsd) -library(gsDesign) -library(tibble) -library(gt) -library(dplyr) - -## ----------------------------------------------------------------------------- -event_tbl <- tribble( - ~population, ~analysis, ~event, - "A positive", 1, 100, - "B positive", 1, 110, - "AB positive", 1, 80, - "overall", 1, 225, - "A positive", 2, 200, - "B positive", 2, 220, - "AB positive", 2, 160, - "overall", 2, 450, -) - -## ----------------------------------------------------------------------------- -obs_tbl <- tribble( - ~hypothesis, ~analysis, ~obs_p, - "H1", 1, 0.02, - "H2", 1, 0.01, - "H3", 1, 0.012, - "H1", 2, 0.015, - "H2", 2, 0.012, - "H3", 2, 0.010 -) %>% - mutate(obs_Z = -qnorm(obs_p)) - -obs_tbl %>% - gt() %>% - tab_header(title = "Nominal p-values") - -p_obs_IA <- (obs_tbl %>% filter(analysis == 1))$obs_p -p_obs_FA <- (obs_tbl %>% filter(analysis == 2))$obs_p - -## ----------------------------------------------------------------------------- -IF_IA <- c( - ((event_tbl %>% filter(analysis == 1, population == "A positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "A positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event), - ((event_tbl %>% filter(analysis == 1, population == "B positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "B positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event), - ((event_tbl %>% filter(analysis == 1, population == "AB positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "AB positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event) -) - -IF_IA - -## ----------------------------------------------------------------------------- -# Transition matrix in Figure A1 -m <- matrix(c( - 0, 3 / 7, 4 / 7, - 3 / 7, 0, 4 / 7, - 0.5, 0.5, 0 -), nrow = 3, byrow = TRUE) -# Initial weights -w <- c(0.3, 0.3, 0.4) - -## ----------------------------------------------------------------------------- -name_hypotheses <- c("H1: Biomarker A positive", "H2: Biomarker B positive", "H3: Overall Population") - -hplot <- gMCPLite::hGraph( - 3, - alphaHypotheses = w, m = m, - nameHypotheses = name_hypotheses, trhw = .2, trhh = .1, - digits = 5, trdigits = 3, size = 5, halfWid = 1, halfHgt = 0.5, - offset = 0.2, trprop = 0.4, - fill = as.factor(c(2, 3, 1)), - palette = c("#BDBDBD", "#E0E0E0", "#EEEEEE"), - wchar = "w" -) -hplot - -## ----------------------------------------------------------------------------- -# Event count of intersection of paired hypotheses - Table 2 -# H1, H2: Hypotheses intersected. -# (1, 1) represents counts for hypothesis 1 -# (1, 2) for counts for the intersection of hypotheses 1 and 2 -event <- tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, event_tbl %>% filter(analysis == 1, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 2, 1, event_tbl %>% filter(analysis == 1, population == "B positive") %>% select(event) %>% as.numeric(), - 3, 3, 1, event_tbl %>% filter(analysis == 1, population == "overall") %>% select(event) %>% as.numeric(), - 1, 2, 1, event_tbl %>% filter(analysis == 1, population == "AB positive") %>% select(event) %>% as.numeric(), - 1, 3, 1, event_tbl %>% filter(analysis == 1, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 3, 1, event_tbl %>% filter(analysis == 1, population == "B positive") %>% select(event) %>% as.numeric(), - 1, 1, 2, event_tbl %>% filter(analysis == 2, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 2, 2, event_tbl %>% filter(analysis == 2, population == "B positive") %>% select(event) %>% as.numeric(), - 3, 3, 2, event_tbl %>% filter(analysis == 2, population == "overall") %>% select(event) %>% as.numeric(), - 1, 2, 2, event_tbl %>% filter(analysis == 2, population == "AB positive") %>% select(event) %>% as.numeric(), - 1, 3, 2, event_tbl %>% filter(analysis == 2, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 3, 2, event_tbl %>% filter(analysis == 2, population == "B positive") %>% select(event) %>% as.numeric() -) -event - -# Generate correlation from events -gs_corr <- wpgsd::generate_corr(event) -gs_corr %>% round(2) - -## ----wpgsdSeqIA, message=FALSE------------------------------------------------ -seq_p_IA_H123 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H1, H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H12 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H1, H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H13 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H1, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H23 <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H1 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H1", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H2 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H3 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -## ----weightedBonferroniSeqIA, message=FALSE----------------------------------- -seq_p_IA_H123_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H1, H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -seq_p_IA_H12_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H1, H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H13_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H1, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -seq_p_IA_H23_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -seq_p_IA_H1_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H1", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -seq_p_IA_H2_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -seq_p_IA_H3_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -## ----wpgsdSeqFA, message=FALSE------------------------------------------------ -seq_p_FA_H123 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1, H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.15) -) - -seq_p_FA_H12 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1, H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.15) -) - -seq_p_FA_H13 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.15) -) - -seq_p_FA_H23 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.15) -) - -seq_p_FA_H1 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H2 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H3 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -## ----weightedBonferroniSeqFA, message=FALSE----------------------------------- -seq_p_FA_H123_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1, H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H12_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1, H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H13_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H23_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H1_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H2_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H3_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -## ----wpgsdAdjSeqIA------------------------------------------------------------ -adj_seq_IA_H1 <- max(seq_p_IA_H123, seq_p_IA_H12, seq_p_IA_H13, seq_p_IA_H1) -adj_seq_IA_H2 <- max(seq_p_IA_H123, seq_p_IA_H12, seq_p_IA_H23, seq_p_IA_H2) -adj_seq_IA_H3 <- max(seq_p_IA_H123, seq_p_IA_H13, seq_p_IA_H23, seq_p_IA_H3) - -cat("The adjusted-sequential p-value of H1, H2, H3 in IA via WPGSD is", adj_seq_IA_H1, adj_seq_IA_H2, adj_seq_IA_H3, "\n") - -## ----weightedBonferroniAdjSeqIA----------------------------------------------- -adj_seq_IA_H1_B <- max(seq_p_IA_H123_B, seq_p_IA_H12_B, seq_p_IA_H13_B, seq_p_IA_H1_B) -adj_seq_IA_H2_B <- max(seq_p_IA_H123_B, seq_p_IA_H12_B, seq_p_IA_H23_B, seq_p_IA_H2_B) -adj_seq_IA_H3_B <- max(seq_p_IA_H123_B, seq_p_IA_H13_B, seq_p_IA_H23_B, seq_p_IA_H3_B) - -cat("The adjusted-sequential p-value of H1, H2, H3 in FA via weighted Bonferroni is", adj_seq_IA_H1_B, adj_seq_IA_H2_B, adj_seq_IA_H3_B, "\n") - -## ----wpgsdAdjSeqFA------------------------------------------------------------ -adj_seq_FA_H1 <- max(seq_p_FA_H123, seq_p_FA_H12, seq_p_FA_H13, seq_p_FA_H1) -adj_seq_FA_H2 <- max(seq_p_FA_H123, seq_p_FA_H12, seq_p_FA_H23, seq_p_FA_H2) -adj_seq_FA_H3 <- max(seq_p_FA_H123, seq_p_FA_H13, seq_p_FA_H23, seq_p_FA_H3) - -cat("The adjusted-sequential p-value of H1, H2, H3 in FA via WPGSD is", adj_seq_FA_H1, adj_seq_FA_H2, adj_seq_FA_H3, "\n") - -## ----weightedBonferroniAdjSeqFA----------------------------------------------- -adj_seq_FA_H1_B <- max(seq_p_FA_H123_B, seq_p_FA_H12_B, seq_p_FA_H13_B, seq_p_FA_H1_B) -adj_seq_FA_H2_B <- max(seq_p_FA_H123_B, seq_p_FA_H12_B, seq_p_FA_H23_B, seq_p_FA_H2_B) -adj_seq_FA_H3_B <- max(seq_p_FA_H123_B, seq_p_FA_H13_B, seq_p_FA_H23_B, seq_p_FA_H3_B) - -cat("The adjusted-sequential p-value of H1, H2, H3 in FA via weighted Bonferroni is", adj_seq_FA_H1_B, adj_seq_FA_H2_B, adj_seq_FA_H3_B, "\n") - -## ----------------------------------------------------------------------------- -ans <- tribble( - ~Analysis, ~Hypothesis, ~`Sequential p-values of WPGSD`, ~`Sequential p-values of Weighted Bonferroni`, ~`Adjusted-sequential p-values of WPGSD`, ~`Adjusted-sequential p-values of Weighted Bonferroni`, - "IA", "H123", seq_p_IA_H123, seq_p_IA_H123_B, NA, NA, - "IA", "H12", seq_p_IA_H12, seq_p_IA_H12_B, NA, NA, - "IA", "H13", seq_p_IA_H13, seq_p_IA_H13_B, NA, NA, - "IA", "H23", seq_p_IA_H23, seq_p_IA_H23_B, NA, NA, - "IA", "H1", seq_p_IA_H1, seq_p_IA_H1_B, adj_seq_IA_H1, adj_seq_IA_H1_B, - "IA", "H2", seq_p_IA_H2, seq_p_IA_H2_B, adj_seq_IA_H2, adj_seq_IA_H2_B, - "IA", "H3", seq_p_IA_H3, seq_p_IA_H3_B, adj_seq_IA_H3, adj_seq_IA_H3_B, - "FA", "H123", seq_p_FA_H123, seq_p_FA_H123_B, NA, NA, - "FA", "H12", seq_p_FA_H12, seq_p_FA_H12_B, NA, NA, - "FA", "H13", seq_p_FA_H13, seq_p_FA_H13_B, NA, NA, - "FA", "H23", seq_p_FA_H23, seq_p_FA_H23_B, NA, NA, - "FA", "H1", seq_p_FA_H1, seq_p_FA_H1_B, adj_seq_FA_H1, adj_seq_FA_H1_B, - "FA", "H2", seq_p_FA_H2, seq_p_FA_H2_B, adj_seq_FA_H2, adj_seq_FA_H2_B, - "FA", "H3", seq_p_FA_H3, seq_p_FA_H3_B, adj_seq_FA_H3, adj_seq_FA_H3_B -) - -ans %>% - select( - Analysis, Hypothesis, - `Sequential p-values of Weighted Bonferroni`, `Adjusted-sequential p-values of Weighted Bonferroni`, - `Sequential p-values of WPGSD`, `Adjusted-sequential p-values of WPGSD` - ) %>% - gt() %>% - tab_spanner( - label = "Weighted Bonferroni", - columns = c(`Sequential p-values of Weighted Bonferroni`, `Adjusted-sequential p-values of Weighted Bonferroni`) - ) %>% - tab_spanner( - label = "WPGSD", - columns = c(`Sequential p-values of WPGSD`, `Adjusted-sequential p-values of WPGSD`) - ) %>% - tab_style_body( - columns = where(is.numeric), - style = cell_fill(color = "pink"), - fn = function(x) x <= 0.025 - ) %>% - fmt_number(columns = 3:6, decimals = 4) %>% - tab_header( - title = "(Adjusted-) sequential p-values", - subtitle = "Multiple populations" - ) # %>% as_latex() - diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/adj-seq-p.Rmd b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/adj-seq-p.Rmd deleted file mode 100644 index df94c1c..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/adj-seq-p.Rmd +++ /dev/null @@ -1,810 +0,0 @@ ---- -title: "Adjusted sequential p-values" -author: "Yujie Zhao, Qi Liu, Linda Sun, Keaven Anderson" -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{Adjusted sequential p-values} ---- - -```{r, message = FALSE, warning = FALSE} -library(wpgsd) -library(gsDesign) -library(tibble) -library(gt) -library(dplyr) -``` - -# Example overview - -In a 2-arm controlled clinical trial example with one primary endpoint, there are 3 patient populations defined by the status of two biomarkers A and B: - -- biomarker A positive, -- biomarker B positive, -- overall population. - -The 3 primary elementary hypotheses are: - -- $H_1$: the experimental treatment is superior to the control in the biomarker A positive population; -- \item $H_2$: the experimental treatment is superior to the control in the biomarker B positive population; -- \item $H_3$: the experimental treatment is superior to the control in the overall population. - -Assume an interim analysis and a final analysis are planned for the study and the number of events are listed as - -```{r} -event_tbl <- tribble( - ~population, ~analysis, ~event, - "A positive", 1, 100, - "B positive", 1, 110, - "AB positive", 1, 80, - "overall", 1, 225, - "A positive", 2, 200, - "B positive", 2, 220, - "AB positive", 2, 160, - "overall", 2, 450, -) -``` - -The observed p-values are - -```{r} -obs_tbl <- tribble( - ~hypothesis, ~analysis, ~obs_p, - "H1", 1, 0.02, - "H2", 1, 0.01, - "H3", 1, 0.012, - "H1", 2, 0.015, - "H2", 2, 0.012, - "H3", 2, 0.010 -) %>% - mutate(obs_Z = -qnorm(obs_p)) - -obs_tbl %>% - gt() %>% - tab_header(title = "Nominal p-values") - -p_obs_IA <- (obs_tbl %>% filter(analysis == 1))$obs_p -p_obs_FA <- (obs_tbl %>% filter(analysis == 2))$obs_p -``` - -The information fraction of $H_1, H_2, H_3$ at IA is - -```{r} -IF_IA <- c( - ((event_tbl %>% filter(analysis == 1, population == "A positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "A positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event), - ((event_tbl %>% filter(analysis == 1, population == "B positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "B positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event), - ((event_tbl %>% filter(analysis == 1, population == "AB positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "AB positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event) -) - -IF_IA -``` - -We assign the initial weights of $H_1, H_2, H_3$ as$\left(w_1(I), w_2(I), w_3(I) \right) = (0.3, 0.3, 0.4).$ And its multiplicity strategy is visualized in below. If $H_1$ is rejected, then $3/7$ local significance level $\alpha_1$ will be propagated to $H_2$, and $4/7$ will go to $H_3$. If $H_3$ is rejected, then half of $\alpha_3$ goes to $H_1$, and half goes to $H_2$. - -```{r} -# Transition matrix in Figure A1 -m <- matrix(c( - 0, 3 / 7, 4 / 7, - 3 / 7, 0, 4 / 7, - 0.5, 0.5, 0 -), nrow = 3, byrow = TRUE) -# Initial weights -w <- c(0.3, 0.3, 0.4) -``` - -```{r} -name_hypotheses <- c("H1: Biomarker A positive", "H2: Biomarker B positive", "H3: Overall Population") - -hplot <- gMCPLite::hGraph( - 3, - alphaHypotheses = w, m = m, - nameHypotheses = name_hypotheses, trhw = .2, trhh = .1, - digits = 5, trdigits = 3, size = 5, halfWid = 1, halfHgt = 0.5, - offset = 0.2, trprop = 0.4, - fill = as.factor(c(2, 3, 1)), - palette = c("#BDBDBD", "#E0E0E0", "#EEEEEE"), - wchar = "w" -) -hplot -``` - -The correlation of the 6 statistisc (2 analysis $\times$ 3 hypothesis) are - -```{r} -# Event count of intersection of paired hypotheses - Table 2 -# H1, H2: Hypotheses intersected. -# (1, 1) represents counts for hypothesis 1 -# (1, 2) for counts for the intersection of hypotheses 1 and 2 -event <- tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, event_tbl %>% filter(analysis == 1, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 2, 1, event_tbl %>% filter(analysis == 1, population == "B positive") %>% select(event) %>% as.numeric(), - 3, 3, 1, event_tbl %>% filter(analysis == 1, population == "overall") %>% select(event) %>% as.numeric(), - 1, 2, 1, event_tbl %>% filter(analysis == 1, population == "AB positive") %>% select(event) %>% as.numeric(), - 1, 3, 1, event_tbl %>% filter(analysis == 1, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 3, 1, event_tbl %>% filter(analysis == 1, population == "B positive") %>% select(event) %>% as.numeric(), - 1, 1, 2, event_tbl %>% filter(analysis == 2, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 2, 2, event_tbl %>% filter(analysis == 2, population == "B positive") %>% select(event) %>% as.numeric(), - 3, 3, 2, event_tbl %>% filter(analysis == 2, population == "overall") %>% select(event) %>% as.numeric(), - 1, 2, 2, event_tbl %>% filter(analysis == 2, population == "AB positive") %>% select(event) %>% as.numeric(), - 1, 3, 2, event_tbl %>% filter(analysis == 2, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 3, 2, event_tbl %>% filter(analysis == 2, population == "B positive") %>% select(event) %>% as.numeric() -) -event - -# Generate correlation from events -gs_corr <- wpgsd::generate_corr(event) -gs_corr %>% round(2) -``` - -# Sequential p-value - -## IA - -```{r, wpgsdSeqIA, message=FALSE} -seq_p_IA_H123 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H1, H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H12 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H1, H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H13 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H1, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H23 <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H1 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H1", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H2 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H3 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) -``` - -```{r, weightedBonferroniSeqIA, message=FALSE} -seq_p_IA_H123_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H1, H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -seq_p_IA_H12_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H1, H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H13_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H1, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -seq_p_IA_H23_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -seq_p_IA_H1_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H1", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -seq_p_IA_H2_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -seq_p_IA_H3_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) -``` - -## FA - -```{r, wpgsdSeqFA, message=FALSE} -seq_p_FA_H123 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1, H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.15) -) - -seq_p_FA_H12 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1, H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.15) -) - -seq_p_FA_H13 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.15) -) - -seq_p_FA_H23 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.15) -) - -seq_p_FA_H1 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H2 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H3 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) -``` - -```{r, weightedBonferroniSeqFA, message=FALSE} -seq_p_FA_H123_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1, H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H12_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1, H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H13_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H23_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H1_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H2_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H3_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) -``` - -# Adjusted-Sequential p-value - -## IA - -```{r, wpgsdAdjSeqIA} -adj_seq_IA_H1 <- max(seq_p_IA_H123, seq_p_IA_H12, seq_p_IA_H13, seq_p_IA_H1) -adj_seq_IA_H2 <- max(seq_p_IA_H123, seq_p_IA_H12, seq_p_IA_H23, seq_p_IA_H2) -adj_seq_IA_H3 <- max(seq_p_IA_H123, seq_p_IA_H13, seq_p_IA_H23, seq_p_IA_H3) - -cat("The adjusted-sequential p-value of H1, H2, H3 in IA via WPGSD is", adj_seq_IA_H1, adj_seq_IA_H2, adj_seq_IA_H3, "\n") -``` - -```{r, weightedBonferroniAdjSeqIA} -adj_seq_IA_H1_B <- max(seq_p_IA_H123_B, seq_p_IA_H12_B, seq_p_IA_H13_B, seq_p_IA_H1_B) -adj_seq_IA_H2_B <- max(seq_p_IA_H123_B, seq_p_IA_H12_B, seq_p_IA_H23_B, seq_p_IA_H2_B) -adj_seq_IA_H3_B <- max(seq_p_IA_H123_B, seq_p_IA_H13_B, seq_p_IA_H23_B, seq_p_IA_H3_B) - -cat("The adjusted-sequential p-value of H1, H2, H3 in FA via weighted Bonferroni is", adj_seq_IA_H1_B, adj_seq_IA_H2_B, adj_seq_IA_H3_B, "\n") -``` - -## FA - -### WPGSD -```{r, wpgsdAdjSeqFA} -adj_seq_FA_H1 <- max(seq_p_FA_H123, seq_p_FA_H12, seq_p_FA_H13, seq_p_FA_H1) -adj_seq_FA_H2 <- max(seq_p_FA_H123, seq_p_FA_H12, seq_p_FA_H23, seq_p_FA_H2) -adj_seq_FA_H3 <- max(seq_p_FA_H123, seq_p_FA_H13, seq_p_FA_H23, seq_p_FA_H3) - -cat("The adjusted-sequential p-value of H1, H2, H3 in FA via WPGSD is", adj_seq_FA_H1, adj_seq_FA_H2, adj_seq_FA_H3, "\n") -``` - -```{r, weightedBonferroniAdjSeqFA} -adj_seq_FA_H1_B <- max(seq_p_FA_H123_B, seq_p_FA_H12_B, seq_p_FA_H13_B, seq_p_FA_H1_B) -adj_seq_FA_H2_B <- max(seq_p_FA_H123_B, seq_p_FA_H12_B, seq_p_FA_H23_B, seq_p_FA_H2_B) -adj_seq_FA_H3_B <- max(seq_p_FA_H123_B, seq_p_FA_H13_B, seq_p_FA_H23_B, seq_p_FA_H3_B) - -cat("The adjusted-sequential p-value of H1, H2, H3 in FA via weighted Bonferroni is", adj_seq_FA_H1_B, adj_seq_FA_H2_B, adj_seq_FA_H3_B, "\n") -``` - -# Summary - -```{r} -ans <- tribble( - ~Analysis, ~Hypothesis, ~`Sequential p-values of WPGSD`, ~`Sequential p-values of Weighted Bonferroni`, ~`Adjusted-sequential p-values of WPGSD`, ~`Adjusted-sequential p-values of Weighted Bonferroni`, - "IA", "H123", seq_p_IA_H123, seq_p_IA_H123_B, NA, NA, - "IA", "H12", seq_p_IA_H12, seq_p_IA_H12_B, NA, NA, - "IA", "H13", seq_p_IA_H13, seq_p_IA_H13_B, NA, NA, - "IA", "H23", seq_p_IA_H23, seq_p_IA_H23_B, NA, NA, - "IA", "H1", seq_p_IA_H1, seq_p_IA_H1_B, adj_seq_IA_H1, adj_seq_IA_H1_B, - "IA", "H2", seq_p_IA_H2, seq_p_IA_H2_B, adj_seq_IA_H2, adj_seq_IA_H2_B, - "IA", "H3", seq_p_IA_H3, seq_p_IA_H3_B, adj_seq_IA_H3, adj_seq_IA_H3_B, - "FA", "H123", seq_p_FA_H123, seq_p_FA_H123_B, NA, NA, - "FA", "H12", seq_p_FA_H12, seq_p_FA_H12_B, NA, NA, - "FA", "H13", seq_p_FA_H13, seq_p_FA_H13_B, NA, NA, - "FA", "H23", seq_p_FA_H23, seq_p_FA_H23_B, NA, NA, - "FA", "H1", seq_p_FA_H1, seq_p_FA_H1_B, adj_seq_FA_H1, adj_seq_FA_H1_B, - "FA", "H2", seq_p_FA_H2, seq_p_FA_H2_B, adj_seq_FA_H2, adj_seq_FA_H2_B, - "FA", "H3", seq_p_FA_H3, seq_p_FA_H3_B, adj_seq_FA_H3, adj_seq_FA_H3_B -) - -ans %>% - select( - Analysis, Hypothesis, - `Sequential p-values of Weighted Bonferroni`, `Adjusted-sequential p-values of Weighted Bonferroni`, - `Sequential p-values of WPGSD`, `Adjusted-sequential p-values of WPGSD` - ) %>% - gt() %>% - tab_spanner( - label = "Weighted Bonferroni", - columns = c(`Sequential p-values of Weighted Bonferroni`, `Adjusted-sequential p-values of Weighted Bonferroni`) - ) %>% - tab_spanner( - label = "WPGSD", - columns = c(`Sequential p-values of WPGSD`, `Adjusted-sequential p-values of WPGSD`) - ) %>% - tab_style_body( - columns = where(is.numeric), - style = cell_fill(color = "pink"), - fn = function(x) x <= 0.025 - ) %>% - fmt_number(columns = 3:6, decimals = 4) %>% - tab_header( - title = "(Adjusted-) sequential p-values", - subtitle = "Multiple populations" - ) # %>% as_latex() -``` diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/adj-seq-p.html b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/adj-seq-p.html deleted file mode 100644 index 0236e45..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/adj-seq-p.html +++ /dev/null @@ -1,3399 +0,0 @@ - - - - - - - - - - - - - - -Adjusted sequential p-values - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- - - -
-
-
-
-
- -
- - - - - - - -
library(wpgsd)
-library(gsDesign)
-library(tibble)
-library(gt)
-library(dplyr)
-
-

1 Example overview

-

In a 2-arm controlled clinical trial example with one primary -endpoint, there are 3 patient populations defined by the status of two -biomarkers A and B:

-
    -
  • biomarker A positive,
  • -
  • biomarker B positive,
  • -
  • overall population.
  • -
-

The 3 primary elementary hypotheses are:

-
    -
  • \(H_1\): the experimental treatment -is superior to the control in the biomarker A positive population;
  • -
  • \(H_2\): the experimental treatment -is superior to the control in the biomarker B positive population;
  • -
  • \(H_3\): the experimental treatment -is superior to the control in the overall population.
  • -
-

Assume an interim analysis and a final analysis are planned for the -study and the number of events are listed as

-
event_tbl <- tribble(
-  ~population, ~analysis, ~event,
-  "A positive", 1, 100,
-  "B positive", 1, 110,
-  "AB positive", 1, 80,
-  "overall", 1, 225,
-  "A positive", 2, 200,
-  "B positive", 2, 220,
-  "AB positive", 2, 160,
-  "overall", 2, 450,
-)
-

The observed p-values are

-
obs_tbl <- tribble(
-  ~hypothesis, ~analysis, ~obs_p,
-  "H1", 1, 0.02,
-  "H2", 1, 0.01,
-  "H3", 1, 0.012,
-  "H1", 2, 0.015,
-  "H2", 2, 0.012,
-  "H3", 2, 0.010
-) %>%
-  mutate(obs_Z = -qnorm(obs_p))
-
-obs_tbl %>%
-  gt() %>%
-  tab_header(title = "Nominal p-values")
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Nominal p-values
hypothesisanalysisobs_pobs_Z
H110.0202.053749
H210.0102.326348
H310.0122.257129
H120.0152.170090
H220.0122.257129
H320.0102.326348
-
-
p_obs_IA <- (obs_tbl %>% filter(analysis == 1))$obs_p
-p_obs_FA <- (obs_tbl %>% filter(analysis == 2))$obs_p
-

The information fraction of \(H_1, H_2, -H_3\) at IA is

-
IF_IA <- c(
-  ((event_tbl %>% filter(analysis == 1, population == "A positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) /
-    ((event_tbl %>% filter(analysis == 2, population == "A positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event),
-  ((event_tbl %>% filter(analysis == 1, population == "B positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) /
-    ((event_tbl %>% filter(analysis == 2, population == "B positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event),
-  ((event_tbl %>% filter(analysis == 1, population == "AB positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) /
-    ((event_tbl %>% filter(analysis == 2, population == "AB positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event)
-)
-
-IF_IA
-
## [1] 0.5 0.5 0.5
-

We assign the initial weights of \(H_1, -H_2, H_3\) as\(\left(w_1(I), w_2(I), -w_3(I) \right) = (0.3, 0.3, 0.4).\) And its multiplicity strategy -is visualized in below. If \(H_1\) is -rejected, then \(3/7\) local -significance level \(\alpha_1\) will be -propagated to \(H_2\), and \(4/7\) will go to \(H_3\). If \(H_3\) is rejected, then half of \(\alpha_3\) goes to \(H_1\), and half goes to \(H_2\).

-
# Transition matrix in Figure A1
-m <- matrix(c(
-  0, 3 / 7, 4 / 7,
-  3 / 7, 0, 4 / 7,
-  0.5, 0.5, 0
-), nrow = 3, byrow = TRUE)
-# Initial weights
-w <- c(0.3, 0.3, 0.4)
-
name_hypotheses <- c("H1: Biomarker A positive", "H2: Biomarker B positive", "H3: Overall Population")
-
-hplot <- gMCPLite::hGraph(
-  3,
-  alphaHypotheses = w, m = m,
-  nameHypotheses = name_hypotheses, trhw = .2, trhh = .1,
-  digits = 5, trdigits = 3, size = 5, halfWid = 1, halfHgt = 0.5,
-  offset = 0.2, trprop = 0.4,
-  fill = as.factor(c(2, 3, 1)),
-  palette = c("#BDBDBD", "#E0E0E0", "#EEEEEE"),
-  wchar = "w"
-)
-hplot
-

-

The correlation of the 6 statistisc (2 analysis \(\times\) 3 hypothesis) are

-
# Event count of intersection of paired hypotheses - Table 2
-# H1, H2: Hypotheses intersected.
-# (1, 1) represents counts for hypothesis 1
-# (1, 2) for counts for the intersection of hypotheses 1 and 2
-event <- tribble(
-  ~H1, ~H2, ~Analysis, ~Event,
-  1, 1, 1, event_tbl %>% filter(analysis == 1, population == "A positive") %>% select(event) %>% as.numeric(),
-  2, 2, 1, event_tbl %>% filter(analysis == 1, population == "B positive") %>% select(event) %>% as.numeric(),
-  3, 3, 1, event_tbl %>% filter(analysis == 1, population == "overall") %>% select(event) %>% as.numeric(),
-  1, 2, 1, event_tbl %>% filter(analysis == 1, population == "AB positive") %>% select(event) %>% as.numeric(),
-  1, 3, 1, event_tbl %>% filter(analysis == 1, population == "A positive") %>% select(event) %>% as.numeric(),
-  2, 3, 1, event_tbl %>% filter(analysis == 1, population == "B positive") %>% select(event) %>% as.numeric(),
-  1, 1, 2, event_tbl %>% filter(analysis == 2, population == "A positive") %>% select(event) %>% as.numeric(),
-  2, 2, 2, event_tbl %>% filter(analysis == 2, population == "B positive") %>% select(event) %>% as.numeric(),
-  3, 3, 2, event_tbl %>% filter(analysis == 2, population == "overall") %>% select(event) %>% as.numeric(),
-  1, 2, 2, event_tbl %>% filter(analysis == 2, population == "AB positive") %>% select(event) %>% as.numeric(),
-  1, 3, 2, event_tbl %>% filter(analysis == 2, population == "A positive") %>% select(event) %>% as.numeric(),
-  2, 3, 2, event_tbl %>% filter(analysis == 2, population == "B positive") %>% select(event) %>% as.numeric()
-)
-event
-
## # A tibble: 12 × 4
-##       H1    H2 Analysis Event
-##    <dbl> <dbl>    <dbl> <dbl>
-##  1     1     1        1   100
-##  2     2     2        1   110
-##  3     3     3        1   225
-##  4     1     2        1    80
-##  5     1     3        1   100
-##  6     2     3        1   110
-##  7     1     1        2   200
-##  8     2     2        2   220
-##  9     3     3        2   450
-## 10     1     2        2   160
-## 11     1     3        2   200
-## 12     2     3        2   220
-
# Generate correlation from events
-gs_corr <- wpgsd::generate_corr(event)
-gs_corr %>% round(2)
-
##      H1_A1 H2_A1 H3_A1 H1_A2 H2_A2 H3_A2
-## [1,]  1.00  0.76  0.67  0.71  0.54  0.47
-## [2,]  0.76  1.00  0.70  0.54  0.71  0.49
-## [3,]  0.67  0.70  1.00  0.47  0.49  0.71
-## [4,]  0.71  0.54  0.47  1.00  0.76  0.67
-## [5,]  0.54  0.71  0.49  0.76  1.00  0.70
-## [6,]  0.47  0.49  0.71  0.67  0.70  1.00
-
-
-

2 Sequential p-value

-
-

2.1 IA

-
seq_p_IA_H123 <- calc_seq_p(
-  test_analysis = 1,
-  test_hypothesis = "H1, H2, H3",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ),
-  alpha_spending_type = 2,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = gsDesign::sfHSD,
-  spending_fun_par = -4,
-  info_frac = c(min(IF_IA), 1),
-  interval = c(1e-4, 0.2)
-)
-
-seq_p_IA_H12 <- calc_seq_p(
-  test_analysis = 1,
-  test_hypothesis = "H1, H2",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ),
-  alpha_spending_type = 2,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = gsDesign::sfHSD,
-  spending_fun_par = -4,
-  info_frac = c(min(IF_IA), 1),
-  interval = c(1e-4, 0.2)
-)
-
-seq_p_IA_H13 <- calc_seq_p(
-  test_analysis = 1,
-  test_hypothesis = "H1, H3",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ),
-  alpha_spending_type = 2,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = gsDesign::sfHSD,
-  spending_fun_par = -4,
-  info_frac = c(min(IF_IA), 1),
-  interval = c(1e-4, 0.2)
-)
-
-seq_p_IA_H23 <- calc_seq_p(
-  test_analysis = 1, # stage of interest
-  test_hypothesis = "H2, H3",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ),
-  alpha_spending_type = 2,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = gsDesign::sfHSD,
-  spending_fun_par = -4,
-  info_frac = c(min(IF_IA), 1),
-  interval = c(1e-4, 0.2)
-)
-
-seq_p_IA_H1 <- calc_seq_p(
-  test_analysis = 1,
-  test_hypothesis = "H1",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ),
-  alpha_spending_type = 2,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = gsDesign::sfHSD,
-  spending_fun_par = -4,
-  info_frac = c(min(IF_IA), 1),
-  interval = c(1e-4, 0.2)
-)
-
-seq_p_IA_H2 <- calc_seq_p(
-  test_analysis = 1,
-  test_hypothesis = "H2",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ),
-  alpha_spending_type = 2,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = gsDesign::sfHSD,
-  spending_fun_par = -4,
-  info_frac = c(min(IF_IA), 1),
-  interval = c(1e-4, 0.2)
-)
-
-seq_p_IA_H3 <- calc_seq_p(
-  test_analysis = 1,
-  test_hypothesis = "H3",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ),
-  alpha_spending_type = 2,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = gsDesign::sfHSD,
-  spending_fun_par = -4,
-  info_frac = c(min(IF_IA), 1),
-  interval = c(1e-4, 0.2)
-)
-
seq_p_IA_H123_B <- calc_seq_p(
-  test_analysis = 1, # stage of interest
-  test_hypothesis = "H1, H2, H3",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 0,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
-  spending_fun_par = list(-4, -4, -4),
-  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
-  interval = c(1e-4, 0.3)
-)
-
-seq_p_IA_H12_B <- calc_seq_p(
-  test_analysis = 1, # stage of interest
-  test_hypothesis = "H1, H2",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 0,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
-  spending_fun_par = list(-4, -4, -4),
-  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
-  interval = c(1e-4, 0.2)
-)
-
-seq_p_IA_H13_B <- calc_seq_p(
-  test_analysis = 1, # stage of interest
-  test_hypothesis = "H1, H3",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 0,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
-  spending_fun_par = list(-4, -4, -4),
-  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
-  interval = c(1e-4, 0.3)
-)
-
-seq_p_IA_H23_B <- calc_seq_p(
-  test_analysis = 1, # stage of interest
-  test_hypothesis = "H2, H3",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 0,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
-  spending_fun_par = list(-4, -4, -4),
-  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
-  interval = c(1e-4, 0.3)
-)
-
-seq_p_IA_H1_B <- calc_seq_p(
-  test_analysis = 1, # stage of interest
-  test_hypothesis = "H1",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 0,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
-  spending_fun_par = list(-4, -4, -4),
-  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
-  interval = c(1e-4, 0.3)
-)
-
-seq_p_IA_H2_B <- calc_seq_p(
-  test_analysis = 1, # stage of interest
-  test_hypothesis = "H2",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 0,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
-  spending_fun_par = list(-4, -4, -4),
-  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
-  interval = c(1e-4, 0.3)
-)
-
-seq_p_IA_H3_B <- calc_seq_p(
-  test_analysis = 1, # stage of interest
-  test_hypothesis = "H3",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 0,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
-  spending_fun_par = list(-4, -4, -4),
-  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
-  interval = c(1e-4, 0.3)
-)
-
-
-

2.2 FA

-
seq_p_FA_H123 <- calc_seq_p(
-  test_analysis = 2, # stage of interest
-  test_hypothesis = "H1, H2, H3",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 2,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = gsDesign::sfHSD,
-  spending_fun_par = -4,
-  info_frac = c(min(IF_IA), 1),
-  interval = c(1e-4, 0.15)
-)
-
-seq_p_FA_H12 <- calc_seq_p(
-  test_analysis = 2, # stage of interest
-  test_hypothesis = "H1, H2",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 2,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = gsDesign::sfHSD,
-  spending_fun_par = -4,
-  info_frac = c(min(IF_IA), 1),
-  interval = c(1e-4, 0.15)
-)
-
-seq_p_FA_H13 <- calc_seq_p(
-  test_analysis = 2, # stage of interest
-  test_hypothesis = "H1, H3",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 2,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = gsDesign::sfHSD,
-  spending_fun_par = -4,
-  info_frac = c(min(IF_IA), 1),
-  interval = c(1e-4, 0.15)
-)
-
-seq_p_FA_H23 <- calc_seq_p(
-  test_analysis = 2, # stage of interest
-  test_hypothesis = "H2, H3",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 2,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = gsDesign::sfHSD,
-  spending_fun_par = -4,
-  info_frac = c(min(IF_IA), 1),
-  interval = c(1e-4, 0.15)
-)
-
-seq_p_FA_H1 <- calc_seq_p(
-  test_analysis = 2, # stage of interest
-  test_hypothesis = "H1",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 2,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = gsDesign::sfHSD,
-  spending_fun_par = -4,
-  info_frac = c(min(IF_IA), 1),
-  interval = c(1e-4, 0.2)
-)
-
-seq_p_FA_H2 <- calc_seq_p(
-  test_analysis = 2, # stage of interest
-  test_hypothesis = "H2",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 2,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = gsDesign::sfHSD,
-  spending_fun_par = -4,
-  info_frac = c(min(IF_IA), 1),
-  interval = c(1e-4, 0.2)
-)
-
-seq_p_FA_H3 <- calc_seq_p(
-  test_analysis = 2, # stage of interest
-  test_hypothesis = "H3",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 2,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = gsDesign::sfHSD,
-  spending_fun_par = -4,
-  info_frac = c(min(IF_IA), 1),
-  interval = c(1e-4, 0.2)
-)
-
seq_p_FA_H123_B <- calc_seq_p(
-  test_analysis = 2, # stage of interest
-  test_hypothesis = "H1, H2, H3",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 0,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
-  spending_fun_par = list(-4, -4, -4),
-  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
-  interval = c(1e-4, 0.2)
-)
-
-seq_p_FA_H12_B <- calc_seq_p(
-  test_analysis = 2, # stage of interest
-  test_hypothesis = "H1, H2",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 0,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
-  spending_fun_par = list(-4, -4, -4),
-  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
-  interval = c(1e-4, 0.2)
-)
-
-seq_p_FA_H13_B <- calc_seq_p(
-  test_analysis = 2, # stage of interest
-  test_hypothesis = "H1, H3",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 0,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
-  spending_fun_par = list(-4, -4, -4),
-  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
-  interval = c(1e-4, 0.2)
-)
-
-seq_p_FA_H23_B <- calc_seq_p(
-  test_analysis = 2, # stage of interest
-  test_hypothesis = "H2, H3",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 0,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
-  spending_fun_par = list(-4, -4, -4),
-  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
-  interval = c(1e-4, 0.2)
-)
-
-seq_p_FA_H1_B <- calc_seq_p(
-  test_analysis = 2, # stage of interest
-  test_hypothesis = "H1",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 0,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
-  spending_fun_par = list(-4, -4, -4),
-  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
-  interval = c(1e-4, 0.2)
-)
-
-seq_p_FA_H2_B <- calc_seq_p(
-  test_analysis = 2, # stage of interest
-  test_hypothesis = "H2",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 0,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
-  spending_fun_par = list(-4, -4, -4),
-  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
-  interval = c(1e-4, 0.2)
-)
-
-seq_p_FA_H3_B <- calc_seq_p(
-  test_analysis = 2, # stage of interest
-  test_hypothesis = "H3",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 0,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
-  spending_fun_par = list(-4, -4, -4),
-  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
-  interval = c(1e-4, 0.2)
-)
-
-
-
-

3 Adjusted-Sequential -p-value

-
-

3.1 IA

-
adj_seq_IA_H1 <- max(seq_p_IA_H123, seq_p_IA_H12, seq_p_IA_H13, seq_p_IA_H1)
-adj_seq_IA_H2 <- max(seq_p_IA_H123, seq_p_IA_H12, seq_p_IA_H23, seq_p_IA_H2)
-adj_seq_IA_H3 <- max(seq_p_IA_H123, seq_p_IA_H13, seq_p_IA_H23, seq_p_IA_H3)
-
-cat("The adjusted-sequential p-value of H1, H2, H3 in IA via WPGSD is", adj_seq_IA_H1, adj_seq_IA_H2, adj_seq_IA_H3, "\n")
-
## The adjusted-sequential p-value of H1, H2, H3 in IA via WPGSD is 0.1942751 0.1942751 0.1942751
-
adj_seq_IA_H1_B <- max(seq_p_IA_H123_B, seq_p_IA_H12_B, seq_p_IA_H13_B, seq_p_IA_H1_B)
-adj_seq_IA_H2_B <- max(seq_p_IA_H123_B, seq_p_IA_H12_B, seq_p_IA_H23_B, seq_p_IA_H2_B)
-adj_seq_IA_H3_B <- max(seq_p_IA_H123_B, seq_p_IA_H13_B, seq_p_IA_H23_B, seq_p_IA_H3_B)
-
-cat("The adjusted-sequential p-value of H1, H2, H3 in FA via weighted Bonferroni is", adj_seq_IA_H1_B, adj_seq_IA_H2_B, adj_seq_IA_H3_B, "\n")
-
## The adjusted-sequential p-value of H1, H2, H3 in FA via weighted Bonferroni is 0.2516717 0.2516717 0.2516717
-
-
-

3.2 FA

-
-

3.2.1 WPGSD

-
adj_seq_FA_H1 <- max(seq_p_FA_H123, seq_p_FA_H12, seq_p_FA_H13, seq_p_FA_H1)
-adj_seq_FA_H2 <- max(seq_p_FA_H123, seq_p_FA_H12, seq_p_FA_H23, seq_p_FA_H2)
-adj_seq_FA_H3 <- max(seq_p_FA_H123, seq_p_FA_H13, seq_p_FA_H23, seq_p_FA_H3)
-
-cat("The adjusted-sequential p-value of H1, H2, H3 in FA via WPGSD is", adj_seq_FA_H1, adj_seq_FA_H2, adj_seq_FA_H3, "\n")
-
## The adjusted-sequential p-value of H1, H2, H3 in FA via WPGSD is 0.02097944 0.02097944 0.02063497
-
adj_seq_FA_H1_B <- max(seq_p_FA_H123_B, seq_p_FA_H12_B, seq_p_FA_H13_B, seq_p_FA_H1_B)
-adj_seq_FA_H2_B <- max(seq_p_FA_H123_B, seq_p_FA_H12_B, seq_p_FA_H23_B, seq_p_FA_H2_B)
-adj_seq_FA_H3_B <- max(seq_p_FA_H123_B, seq_p_FA_H13_B, seq_p_FA_H23_B, seq_p_FA_H3_B)
-
-cat("The adjusted-sequential p-value of H1, H2, H3 in FA via weighted Bonferroni is", adj_seq_FA_H1_B, adj_seq_FA_H2_B, adj_seq_FA_H3_B, "\n")
-
## The adjusted-sequential p-value of H1, H2, H3 in FA via weighted Bonferroni is 0.0265823 0.0265823 0.0265823
-
-
-
-
-

4 Summary

-
ans <- tribble(
-  ~Analysis, ~Hypothesis, ~`Sequential p-values of WPGSD`, ~`Sequential p-values of Weighted Bonferroni`, ~`Adjusted-sequential p-values of WPGSD`, ~`Adjusted-sequential p-values of Weighted Bonferroni`,
-  "IA", "H123", seq_p_IA_H123, seq_p_IA_H123_B, NA, NA,
-  "IA", "H12", seq_p_IA_H12, seq_p_IA_H12_B, NA, NA,
-  "IA", "H13", seq_p_IA_H13, seq_p_IA_H13_B, NA, NA,
-  "IA", "H23", seq_p_IA_H23, seq_p_IA_H23_B, NA, NA,
-  "IA", "H1", seq_p_IA_H1, seq_p_IA_H1_B, adj_seq_IA_H1, adj_seq_IA_H1_B,
-  "IA", "H2", seq_p_IA_H2, seq_p_IA_H2_B, adj_seq_IA_H2, adj_seq_IA_H2_B,
-  "IA", "H3", seq_p_IA_H3, seq_p_IA_H3_B, adj_seq_IA_H3, adj_seq_IA_H3_B,
-  "FA", "H123", seq_p_FA_H123, seq_p_FA_H123_B, NA, NA,
-  "FA", "H12", seq_p_FA_H12, seq_p_FA_H12_B, NA, NA,
-  "FA", "H13", seq_p_FA_H13, seq_p_FA_H13_B, NA, NA,
-  "FA", "H23", seq_p_FA_H23, seq_p_FA_H23_B, NA, NA,
-  "FA", "H1", seq_p_FA_H1, seq_p_FA_H1_B, adj_seq_FA_H1, adj_seq_FA_H1_B,
-  "FA", "H2", seq_p_FA_H2, seq_p_FA_H2_B, adj_seq_FA_H2, adj_seq_FA_H2_B,
-  "FA", "H3", seq_p_FA_H3, seq_p_FA_H3_B, adj_seq_FA_H3, adj_seq_FA_H3_B
-)
-
-ans %>%
-  select(
-    Analysis, Hypothesis,
-    `Sequential p-values of Weighted Bonferroni`, `Adjusted-sequential p-values of Weighted Bonferroni`,
-    `Sequential p-values of WPGSD`, `Adjusted-sequential p-values of WPGSD`
-  ) %>%
-  gt() %>%
-  tab_spanner(
-    label = "Weighted Bonferroni",
-    columns = c(`Sequential p-values of Weighted Bonferroni`, `Adjusted-sequential p-values of Weighted Bonferroni`)
-  ) %>%
-  tab_spanner(
-    label = "WPGSD",
-    columns = c(`Sequential p-values of WPGSD`, `Adjusted-sequential p-values of WPGSD`)
-  ) %>%
-  tab_style_body(
-    columns = where(is.numeric),
-    style = cell_fill(color = "pink"),
-    fn = function(x) x <= 0.025
-  ) %>%
-  fmt_number(columns = 3:6, decimals = 4) %>%
-  tab_header(
-    title = "(Adjusted-) sequential p-values",
-    subtitle = "Multiple populations"
-  ) # %>% as_latex()
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(Adjusted-) sequential p-values
Multiple populations
AnalysisHypothesis -
Weighted Bonferroni
-
-
WPGSD
-
Sequential p-values of Weighted BonferroniAdjusted-sequential p-values of Weighted BonferroniSequential p-values of WPGSDAdjusted-sequential p-values of WPGSD
IAH1230.2517NA0.1943NA
IAH120.1678NA0.1400NA
IAH130.1762NA0.1553NA
IAH230.1762NA0.1529NA
IAH10.16780.25170.16780.1943
IAH20.08390.25170.08390.1943
IAH30.10070.25170.10070.1943
FAH1230.0266NA0.0206NA
FAH120.0255NA0.0210NA
FAH130.0186NA0.0165NA
FAH230.0186NA0.0162NA
FAH10.01590.02660.01590.0210
FAH20.01270.02660.01270.0210
FAH30.01060.02660.01060.0206
-
-
- - - -
-
- -
- - - - - - - - - - - - - - - - diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/corr_calculation.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/corr_calculation.R deleted file mode 100644 index 9b8c02d..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/corr_calculation.R +++ /dev/null @@ -1,86 +0,0 @@ -## ----message=FALSE------------------------------------------------------------ -library(dplyr) -library(tibble) -library(gt) - -## ----------------------------------------------------------------------------- -event_tb <- tribble( - ~Population, ~"Number of Event in IA", ~"Number of Event in FA", - "Population 1", 100, 200, - "Population 2", 110, 220, - "Overlap of Population 1 and 2", 80, 160, - "Overall Population", 225, 450 -) -event_tb %>% - gt() %>% - tab_header(title = "Number of events at each population") - -## ----------------------------------------------------------------------------- -event_tbl <- tribble( - ~Population, ~"Number of Event in IA", - "Population 1", 100, - "Population 2", 110, - "Overlap in population 1 and 2", 80 -) -event_tbl %>% - gt() %>% - tab_header(title = "Number of events at each population in example 1") - -## ----------------------------------------------------------------------------- -Corr1 <- 80 / sqrt(100 * 110) -round(Corr1, 2) - -## ----------------------------------------------------------------------------- -event_tb2 <- tribble( - ~Population, ~"Number of Event in IA", ~"Number of Event in FA", - "Population 1", 100, 200 -) -event_tb2 %>% - gt() %>% - tab_header(title = "Number of events at each analyses in example 2") - -## ----------------------------------------------------------------------------- -Corr1 <- 100 / sqrt(100 * 200) -round(Corr1, 2) - -## ----------------------------------------------------------------------------- -event_tb3 <- tribble( - ~Population, ~"Number of Event in IA", ~"Number of Event in FA", - "Population 1", 100, 200, - "Population 2", 110, 220, - "Overlap in population 1 and 2", 80, 160 -) -event_tb3 %>% - gt() %>% - tab_header(title = "Number of events at each population & analyses in example 3") - -## ----------------------------------------------------------------------------- -Corr1 <- 80 / sqrt(100 * 220) -round(Corr1, 2) - -## ----message=FALSE------------------------------------------------------------ -library(wpgsd) -# The event table -event <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 100, - 2, 2, 1, 110, - 3, 3, 1, 225, - 1, 2, 1, 80, - 1, 3, 1, 100, - 2, 3, 1, 110, - 1, 1, 2, 200, - 2, 2, 2, 220, - 3, 3, 2, 450, - 1, 2, 2, 160, - 1, 3, 2, 200, - 2, 3, 2, 220 -) - -event %>% - gt() %>% - tab_header(title = "Number of events at each population & analyses") - -## ----------------------------------------------------------------------------- -generate_corr(event) - diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/corr_calculation.Rmd b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/corr_calculation.Rmd deleted file mode 100644 index df67ae9..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/corr_calculation.Rmd +++ /dev/null @@ -1,180 +0,0 @@ ---- -title: "Correlated test statistics" -author: "Chenguang Zhang, Yujie Zhao" -output: - rmarkdown::html_document: - toc: true - toc_float: true - toc_depth: 2 - number_sections: true - highlight: "textmate" - css: "custom.css" - code_fold: hide -vignette: > - %\VignetteEngine{knitr::rmarkdown} - %\VignetteIndexEntry{Correlated test statistics} -bibliography: wpgsd.bib ---- - -The weighted parametric group sequential design (WPGSD) (@anderson2022unified) approach allows one to take advantage of the known correlation structure in constructing efficacy bounds to control family-wise error rate (FWER) for a group sequential design. Here correlation may be due to common observations in nested populations, due to common observations in overlapping populations, or due to common observations in the control arm. - -# Methodologies to calculate correlations - -Suppose that in a group sequential trial there are $m$ elementary null hypotheses $H_i$, $i \in I={1,...,m}$, and there are $K$ analyses. Let $k$ be the index for the interim analyses and final analyses, $k=1,2,...K$. For any nonempty set $J \subseteq I$, we denote the intersection hypothesis $H_J=\cap_{j \in J}H_j$. We note that $H_I$ is the global null hypothesis. - -We assume the plan is for all hypotheses to be tested at each of the $k$ planned analyses if the trial continues to the end for all hypotheses. We further assume that the distribution of the $m \times K$ tests of $m$ individual hypotheses at all $k$ analyses is multivariate normal with a completely known correlation matrix. - -Let $Z_{ik}$ be the standardized normal test statistic for hypothesis $i \in I$, analysis $1 \le k \le K$. Let $n_{ik}$ be the number of events collected cumulatively through stage $k$ for hypothesis $i$. Then $n_{i \wedge i',k \wedge k'}$ is the number of events included in both $Z_{ik}$ and $i$, $i' \in I$, $1 \le k$, $k' \le K$. The key of the parametric tests to utilize the correlation among the test statistics. The correlation between $Z_{ik}$ and $Z_{i'k'}$ is -$$Corr(Z_{ik},Z_{i'k'})=\frac{n_{i \wedge i',k \wedge k'}}{\sqrt{n_{ik}*n_{i'k'}}}$$. - -# Examples - -We borrow an example from a paper by Anderson et al. (@anderson2022unified), demonstrated in Section 2 - Motivating Examples, we use Example 1 as the basis here. The setting will be: - -In a two-arm controlled clinical trial with one primary endpoint, there are three patient populations defined by the status of two biomarkers, A and B: - -* Biomarker A positive, the population 1, -* Biomarker B positive, the population 2, -* Overall population. - -The 3 primary elementary hypotheses are: - -* **H1**: the experimental treatment is superior to the control in the population 1 -* **H2**: the experimental treatment is superior to the control in the population 2 -* **H3**: the experimental treatment is superior to the control in the overall population - -Assume an interim analysis and a final analysis are planned for the study. The number of events are listed as -```{r,message=FALSE} -library(dplyr) -library(tibble) -library(gt) -``` - -```{r} -event_tb <- tribble( - ~Population, ~"Number of Event in IA", ~"Number of Event in FA", - "Population 1", 100, 200, - "Population 2", 110, 220, - "Overlap of Population 1 and 2", 80, 160, - "Overall Population", 225, 450 -) -event_tb %>% - gt() %>% - tab_header(title = "Number of events at each population") -``` - -## Correlation of different populations within the same analysis -Let's consider a simple situation, we want to compare the population 1 and population 2 in only interim analyses. Then $k=1$, and to compare $H_{1}$ and $H_{2}$, the $i$ will be $i=1$ and $i=2$. -The correlation matrix will be -$$Corr(Z_{11},Z_{21})=\frac{n_{1 \wedge 2,1 \wedge 1}}{\sqrt{n_{11}*n_{21}}}$$ -The number of events are listed as -```{r} -event_tbl <- tribble( - ~Population, ~"Number of Event in IA", - "Population 1", 100, - "Population 2", 110, - "Overlap in population 1 and 2", 80 -) -event_tbl %>% - gt() %>% - tab_header(title = "Number of events at each population in example 1") -``` -The the corrleation could be simply calculated as -$$Corr(Z_{11},Z_{21})=\frac{80}{\sqrt{100*110}}=0.76$$ -```{r} -Corr1 <- 80 / sqrt(100 * 110) -round(Corr1, 2) -``` - -## Correlation of different analyses within the same population -Let's consider another simple situation, we want to compare single population, for example, the population 1, but in different analyses, interim and final analyses. Then $i=1$, and to compare IA and FA, the $k$ will be $k=1$ and $k=2$. -The correlation matrix will be -$$Corr(Z_{11},Z_{12})=\frac{n_{1 \wedge 1,1 \wedge 2}}{\sqrt{n_{11}*n_{12}}}$$ -The number of events are listed as -```{r} -event_tb2 <- tribble( - ~Population, ~"Number of Event in IA", ~"Number of Event in FA", - "Population 1", 100, 200 -) -event_tb2 %>% - gt() %>% - tab_header(title = "Number of events at each analyses in example 2") -``` -The the corrleation could be simply calculated as -$$\text{Corr}(Z_{11},Z_{12})=\frac{100}{\sqrt{100*200}}=0.71$$ -The 100 in the numerator is the overlap number of events of interim analysis and final analysis in population 1. -```{r} -Corr1 <- 100 / sqrt(100 * 200) -round(Corr1, 2) -``` - -## Correlation of different analyses and different population -Let's consider the situation that we want to compare population 1 in interim analyses and population 2 in final analyses. Then for different population, $i=1$ and $i=2$, and to compare IA and FA, the $k$ will be $k=1$ and $k=2$. -The correlation matrix will be -$$\text{Corr}(Z_{11},Z_{22})=\frac{n_{1 \wedge 1,2 \wedge 2}}{\sqrt{n_{11}*n_{22}}}$$ -The number of events are listed as -```{r} -event_tb3 <- tribble( - ~Population, ~"Number of Event in IA", ~"Number of Event in FA", - "Population 1", 100, 200, - "Population 2", 110, 220, - "Overlap in population 1 and 2", 80, 160 -) -event_tb3 %>% - gt() %>% - tab_header(title = "Number of events at each population & analyses in example 3") -``` - -The correlation could be simply calculated as -$$\text{Corr}(Z_{11},Z_{22})=\frac{80}{\sqrt{100*220}}=0.54$$ -The 80 in the numerator is the overlap number of events of population 1 in interim analysis and population 2 in final analysis. -```{r} -Corr1 <- 80 / sqrt(100 * 220) -round(Corr1, 2) -``` - -# Generate the correlation matrix by `generate_corr()` -Now we know how to calculate the correlation values under different situations, and the `generate_corr()` function was built based on this logic. We can directly calculate the results for each cross situation via the function. - -First, we need a event table including the information of the study. - -- `H1` refers to one hypothesis, selected depending on the interest, while `H2` refers to the other hypothesis, both of which are listed for multiplicity testing. For example, `H1` means the experimental treatment is superior to the control in the population 1/experimental arm 1; `H2` means the experimental treatment is superior to the control in the population 2/experimental arm 2; -- `Analysis` means different analysis stages, for example, 1 means the interim analysis, and 2 means the final analysis; -- `Event` is the common events overlap by `H1` and `H2`. - -For example: `H1=1`, `H2=1`, `Analysis=1`, `Event=100 `indicates that in the first population, there are 100 cases where the experimental treatment is superior to the control in the interim analysis. - -Another example: `H1=1`, `H2=2`, `Analysis=2`, `Event=160` indicates that the number of overlapping cases where the experimental treatment is superior to the control in population 1 and 2 in the final analysis is 160. - -To be noticed, the column names in this function are fixed to be `H1`, `H2`, `Analysis`, `Event`. -```{r, message=FALSE} -library(wpgsd) -# The event table -event <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 100, - 2, 2, 1, 110, - 3, 3, 1, 225, - 1, 2, 1, 80, - 1, 3, 1, 100, - 2, 3, 1, 110, - 1, 1, 2, 200, - 2, 2, 2, 220, - 3, 3, 2, 450, - 1, 2, 2, 160, - 1, 3, 2, 200, - 2, 3, 2, 220 -) - -event %>% - gt() %>% - tab_header(title = "Number of events at each population & analyses") -``` - -Then we input the above event table to the function of `generate_corr()`, and get the correlation matrix as follow. -```{r} -generate_corr(event) -``` - -# References - diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/corr_calculation.html b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/corr_calculation.html deleted file mode 100644 index 28c00f5..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/corr_calculation.html +++ /dev/null @@ -1,4137 +0,0 @@ - - - - - - - - - - - - - - -Correlated test statistics - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- - - -
-
-
-
-
- -
- - - - - - - -

The weighted parametric group sequential design (WPGSD) (Anderson et al. (2022)) approach allows one to -take advantage of the known correlation structure in constructing -efficacy bounds to control family-wise error rate (FWER) for a group -sequential design. Here correlation may be due to common observations in -nested populations, due to common observations in overlapping -populations, or due to common observations in the control arm.

-
-

1 Methodologies to -calculate correlations

-

Suppose that in a group sequential trial there are \(m\) elementary null hypotheses \(H_i\), \(i \in -I={1,...,m}\), and there are \(K\) analyses. Let \(k\) be the index for the interim analyses -and final analyses, \(k=1,2,...K\). For -any nonempty set \(J \subseteq I\), we -denote the intersection hypothesis \(H_J=\cap_{j \in J}H_j\). We note that \(H_I\) is the global null hypothesis.

-

We assume the plan is for all hypotheses to be tested at each of the -\(k\) planned analyses if the trial -continues to the end for all hypotheses. We further assume that the -distribution of the \(m \times K\) -tests of \(m\) individual hypotheses at -all \(k\) analyses is multivariate -normal with a completely known correlation matrix.

-

Let \(Z_{ik}\) be the standardized -normal test statistic for hypothesis \(i \in -I\), analysis \(1 \le k \le K\). -Let \(n_{ik}\) be the number of events -collected cumulatively through stage \(k\) for hypothesis \(i\). Then \(n_{i -\wedge i',k \wedge k'}\) is the number of events included -in both \(Z_{ik}\) and \(i\), \(i' \in -I\), \(1 \le k\), \(k' \le K\). The key of the parametric -tests to utilize the correlation among the test statistics. The -correlation between \(Z_{ik}\) and -\(Z_{i'k'}\) is \[Corr(Z_{ik},Z_{i'k'})=\frac{n_{i \wedge -i',k \wedge k'}}{\sqrt{n_{ik}*n_{i'k'}}}\].

-
-
-

2 Examples

-

We borrow an example from a paper by Anderson et al. (Anderson et al. (2022)), demonstrated in Section -2 - Motivating Examples, we use Example 1 as the basis here. The setting -will be:

-

In a two-arm controlled clinical trial with one primary endpoint, -there are three patient populations defined by the status of two -biomarkers, A and B:

-
    -
  • Biomarker A positive, the population 1,
  • -
  • Biomarker B positive, the population 2,
  • -
  • Overall population.
  • -
-

The 3 primary elementary hypotheses are:

-
    -
  • H1: the experimental treatment is superior to the -control in the population 1
  • -
  • H2: the experimental treatment is superior to the -control in the population 2
  • -
  • H3: the experimental treatment is superior to the -control in the overall population
  • -
-

Assume an interim analysis and a final analysis are planned for the -study. The number of events are listed as

-
library(dplyr)
-library(tibble)
-library(gt)
-
event_tb <- tribble(
-  ~Population, ~"Number of Event in IA", ~"Number of Event in FA",
-  "Population 1", 100, 200,
-  "Population 2", 110, 220,
-  "Overlap of Population 1 and 2", 80, 160,
-  "Overall Population", 225, 450
-)
-event_tb %>%
-  gt() %>%
-  tab_header(title = "Number of events at each population")
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Number of events at each population
PopulationNumber of Event in IANumber of Event in FA
Population 1100200
Population 2110220
Overlap of Population 1 and 280160
Overall Population225450
-
-
-

2.1 Correlation of -different populations within the same analysis

-

Let’s consider a simple situation, we want to compare the population -1 and population 2 in only interim analyses. Then \(k=1\), and to compare \(H_{1}\) and \(H_{2}\), the \(i\) will be \(i=1\) and \(i=2\). The correlation matrix will be \[Corr(Z_{11},Z_{21})=\frac{n_{1 \wedge 2,1 \wedge -1}}{\sqrt{n_{11}*n_{21}}}\] The number of events are listed -as

-
event_tbl <- tribble(
-  ~Population, ~"Number of Event in IA",
-  "Population 1", 100,
-  "Population 2", 110,
-  "Overlap in population 1 and 2", 80
-)
-event_tbl %>%
-  gt() %>%
-  tab_header(title = "Number of events at each population in example 1")
-
- - - - - - - - - - - - - - - - - - - - - - -
Number of events at each population in example 1
PopulationNumber of Event in IA
Population 1100
Population 2110
Overlap in population 1 and 280
-
-

The the corrleation could be simply calculated as \[Corr(Z_{11},Z_{21})=\frac{80}{\sqrt{100*110}}=0.76\]

-
Corr1 <- 80 / sqrt(100 * 110)
-round(Corr1, 2)
-
## [1] 0.76
-
-
-

2.2 Correlation of -different analyses within the same population

-

Let’s consider another simple situation, we want to compare single -population, for example, the population 1, but in different analyses, -interim and final analyses. Then \(i=1\), and to compare IA and FA, the \(k\) will be \(k=1\) and \(k=2\). The correlation matrix will be \[Corr(Z_{11},Z_{12})=\frac{n_{1 \wedge 1,1 \wedge -2}}{\sqrt{n_{11}*n_{12}}}\] The number of events are listed -as

-
event_tb2 <- tribble(
-  ~Population, ~"Number of Event in IA", ~"Number of Event in FA",
-  "Population 1", 100, 200
-)
-event_tb2 %>%
-  gt() %>%
-  tab_header(title = "Number of events at each analyses in example 2")
-
- - - - - - - - - - - - - - - - - - - - -
Number of events at each analyses in example 2
PopulationNumber of Event in IANumber of Event in FA
Population 1100200
-
-

The the corrleation could be simply calculated as \[\text{Corr}(Z_{11},Z_{12})=\frac{100}{\sqrt{100*200}}=0.71\] -The 100 in the numerator is the overlap number of events of interim -analysis and final analysis in population 1.

-
Corr1 <- 100 / sqrt(100 * 200)
-round(Corr1, 2)
-
## [1] 0.71
-
-
-

2.3 Correlation of -different analyses and different population

-

Let’s consider the situation that we want to compare population 1 in -interim analyses and population 2 in final analyses. Then for different -population, \(i=1\) and \(i=2\), and to compare IA and FA, the \(k\) will be \(k=1\) and \(k=2\). The correlation matrix will be \[\text{Corr}(Z_{11},Z_{22})=\frac{n_{1 \wedge 1,2 -\wedge 2}}{\sqrt{n_{11}*n_{22}}}\] The number of events are -listed as

-
event_tb3 <- tribble(
-  ~Population, ~"Number of Event in IA", ~"Number of Event in FA",
-  "Population 1", 100, 200,
-  "Population 2", 110, 220,
-  "Overlap in population 1 and 2", 80, 160
-)
-event_tb3 %>%
-  gt() %>%
-  tab_header(title = "Number of events at each population & analyses in example 3")
-
- - - - - - - - - - - - - - - - - - - - - - - - - - -
Number of events at each population & analyses in example 3
PopulationNumber of Event in IANumber of Event in FA
Population 1100200
Population 2110220
Overlap in population 1 and 280160
-
-

The correlation could be simply calculated as \[\text{Corr}(Z_{11},Z_{22})=\frac{80}{\sqrt{100*220}}=0.54\] -The 80 in the numerator is the overlap number of events of population 1 -in interim analysis and population 2 in final analysis.

-
Corr1 <- 80 / sqrt(100 * 220)
-round(Corr1, 2)
-
## [1] 0.54
-
-
-
-

3 Generate the -correlation matrix by generate_corr()

-

Now we know how to calculate the correlation values under different -situations, and the generate_corr() function was built -based on this logic. We can directly calculate the results for each -cross situation via the function.

-

First, we need a event table including the information of the -study.

-
    -
  • H1 refers to one hypothesis, selected depending on the -interest, while H2 refers to the other hypothesis, both of -which are listed for multiplicity testing. For example, H1 -means the experimental treatment is superior to the control in the -population 1/experimental arm 1; H2 means the experimental -treatment is superior to the control in the population 2/experimental -arm 2;
  • -
  • Analysis means different analysis stages, for example, -1 means the interim analysis, and 2 means the final analysis;
  • -
  • Event is the common events overlap by H1 -and H2.
  • -
-

For example: H1=1, H2=1, -Analysis=1, Event=100indicates that in the -first population, there are 100 cases where the experimental treatment -is superior to the control in the interim analysis.

-

Another example: H1=1, H2=2, -Analysis=2, Event=160 indicates that the -number of overlapping cases where the experimental treatment is superior -to the control in population 1 and 2 in the final analysis is 160.

-

To be noticed, the column names in this function are fixed to be -H1, H2, Analysis, -Event.

-
library(wpgsd)
-# The event table
-event <- tibble::tribble(
-  ~H1, ~H2, ~Analysis, ~Event,
-  1, 1, 1, 100,
-  2, 2, 1, 110,
-  3, 3, 1, 225,
-  1, 2, 1, 80,
-  1, 3, 1, 100,
-  2, 3, 1, 110,
-  1, 1, 2, 200,
-  2, 2, 2, 220,
-  3, 3, 2, 450,
-  1, 2, 2, 160,
-  1, 3, 2, 200,
-  2, 3, 2, 220
-)
-
-event %>%
-  gt() %>%
-  tab_header(title = "Number of events at each population & analyses")
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Number of events at each population & analyses
H1H2AnalysisEvent
111100
221110
331225
12180
131100
231110
112200
222220
332450
122160
132200
232220
-
-

Then we input the above event table to the function of -generate_corr(), and get the correlation matrix as -follow.

-
generate_corr(event)
-
##          H1_A1     H2_A1     H3_A1     H1_A2     H2_A2     H3_A2
-## [1,] 1.0000000 0.7627701 0.6666667 0.7071068 0.5393599 0.4714045
-## [2,] 0.7627701 1.0000000 0.6992059 0.5393599 0.7071068 0.4944132
-## [3,] 0.6666667 0.6992059 1.0000000 0.4714045 0.4944132 0.7071068
-## [4,] 0.7071068 0.5393599 0.4714045 1.0000000 0.7627701 0.6666667
-## [5,] 0.5393599 0.7071068 0.4944132 0.7627701 1.0000000 0.6992059
-## [6,] 0.4714045 0.4944132 0.7071068 0.6666667 0.6992059 1.0000000
-
-
-

References

-
-
-Anderson, Keaven M, Zifang Guo, Jing Zhao, and Linda Z Sun. 2022. -“A Unified Framework for Weighted Parametric Group Sequential -Design.” Biometrical Journal 64 (7): 1219–39. -
-
-
- - - -
-
- -
- - - - - - - - - - - - - - - - - diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/tech-detail-wb.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/tech-detail-wb.R deleted file mode 100644 index 81d0f9a..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/tech-detail-wb.R +++ /dev/null @@ -1,477 +0,0 @@ -## ----message = FALSE, warning = FALSE----------------------------------------- -library(tibble) -library(gt) -library(gsDesign) -library(dplyr) -library(wpgsd) - -## ----------------------------------------------------------------------------- -k <- 2 # Number of total analysis -n_hypotheses <- 3 # Number of hypotheses - -## ----------------------------------------------------------------------------- -obs_tbl <- tribble( - ~hypothesis, ~analysis, ~obs_p, - "H1", 1, 0.02, - "H2", 1, 0.01, - "H3", 1, 0.006, - "H1", 2, 0.015, - "H2", 2, 0.012, - "H3", 2, 0.004 -) %>% - mutate(obs_Z = -qnorm(obs_p)) - -obs_tbl %>% - gt() %>% - tab_header(title = "Nominal p-values") - -p_obs_IA <- (obs_tbl %>% filter(analysis == 1))$obs_p -p_obs_FA <- (obs_tbl %>% filter(analysis == 2))$obs_p - -## ----------------------------------------------------------------------------- -alpha <- 0.025 -event_tbl <- tribble( - ~population, ~analysis, ~event, - "A positive", 1, 80, - "B positive", 1, 88, - "AB positive", 1, 64, - "overall", 1, 180, - "A positive", 2, 160, - "B positive", 2, 176, - "AB positive", 2, 128, - "overall", 2, 360, -) - -## ----------------------------------------------------------------------------- -IF_IA <- c( - ((event_tbl %>% filter(analysis == 1, population == "A positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "A positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event), - ((event_tbl %>% filter(analysis == 1, population == "B positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "B positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event), - ((event_tbl %>% filter(analysis == 1, population == "AB positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "AB positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event) -) - -IF_IA - -## ----------------------------------------------------------------------------- -m <- matrix(c( # Transition matrix - 0, 3 / 7, 4 / 7, - 3 / 7, 0, 4 / 7, - 1 / 2, 1 / 2, 0 -), nrow = 3, byrow = TRUE) - -w <- c(0.3, 0.3, 0.4) # Initial weights - -## ----------------------------------------------------------------------------- -name_hypotheses <- c( - "H1: Biomarker A positive", - "H2: Biomarker B positive", - "H3: Overall Population" -) - -hplot <- gMCPLite::hGraph( - 3, - alphaHypotheses = w, m = m, - nameHypotheses = name_hypotheses, trhw = .2, trhh = .1, - digits = 5, trdigits = 3, size = 5, halfWid = 1, halfHgt = 0.5, - offset = 0.2, trprop = 0.4, - fill = as.factor(c(2, 3, 1)), - palette = c("#BDBDBD", "#E0E0E0", "#EEEEEE"), - wchar = "w" -) -hplot - -## ----------------------------------------------------------------------------- -# Get weights for all intersection hypotheses -graph <- gMCPLite::matrix2graph(m) -graph <- gMCPLite::setWeights(graph, w) - -## ----------------------------------------------------------------------------- -# Set up hypothetical p-values (0 or 1) to obtain all combinations -pvals <- NULL -for (i in 1:n_hypotheses) { - if (i == 1) { - pvals <- data.frame(x = c(0, 1)) - names(pvals) <- paste("pval_H", i, sep = "") - } else { - tmp <- data.frame(x = c(0, 1)) - names(tmp) <- paste("pval_H", i, sep = "") - pvals <- merge(pvals, tmp) - } -} -# Get the weights for each intersection hypothesis -inter_weight <- NULL # Create an empty table to store the weight of interaction hypotheses -for (i in seq_len(nrow(pvals))) { # Each row in `pvals` is 1 possible interaction hypothesis - pval_tmp <- as.numeric(pvals[i, ]) - graph_tmp <- gMCPLite::gMCP(graph = graph, pvalues = pval_tmp, alpha = alpha) - weight_tmp <- gMCPLite::getWeights(graph_tmp) - inter_weight <- dplyr::bind_rows(inter_weight, weight_tmp) -} - -inter_weight <- replace(inter_weight, pvals == 0, NA) # Replace the empty hypothesis as NA -inter_weight <- inter_weight[-1, ] # Delete the first row since it is empty set - -inter_weight %>% - gt() %>% - tab_header("Weight of all possible interaction hypothesis") - -## ----------------------------------------------------------------------------- -# Event count of intersection of paired hypotheses - Table 2 -# H1, H2: Hypotheses intersected. -# (1, 1) represents counts for hypothesis 1 -# (1, 2) for counts for the intersection of hypotheses 1 and 2 -event <- tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, event_tbl %>% filter(analysis == 1, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 2, 1, event_tbl %>% filter(analysis == 1, population == "B positive") %>% select(event) %>% as.numeric(), - 3, 3, 1, event_tbl %>% filter(analysis == 1, population == "overall") %>% select(event) %>% as.numeric(), - 1, 2, 1, event_tbl %>% filter(analysis == 1, population == "AB positive") %>% select(event) %>% as.numeric(), - 1, 3, 1, event_tbl %>% filter(analysis == 1, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 3, 1, event_tbl %>% filter(analysis == 1, population == "B positive") %>% select(event) %>% as.numeric(), - 1, 1, 2, event_tbl %>% filter(analysis == 2, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 2, 2, event_tbl %>% filter(analysis == 2, population == "B positive") %>% select(event) %>% as.numeric(), - 3, 3, 2, event_tbl %>% filter(analysis == 2, population == "overall") %>% select(event) %>% as.numeric(), - 1, 2, 2, event_tbl %>% filter(analysis == 2, population == "AB positive") %>% select(event) %>% as.numeric(), - 1, 3, 2, event_tbl %>% filter(analysis == 2, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 3, 2, event_tbl %>% filter(analysis == 2, population == "B positive") %>% select(event) %>% as.numeric() -) -event - -# Generate correlation from events -corr <- wpgsd::generate_corr(event) -corr %>% round(2) - -## ----------------------------------------------------------------------------- -w_H1 <- 1 - -# Index to select from the correlation matrix -indx <- grep("H1", colnames(corr)) -corr_H1 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H1 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[1], - n.I = corr_H1[, ncol(corr_H1)]^2, - alpha = alpha * w_H1[1], - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H1", - `H1 p-value boundary` = pval_H1, - `H2 p-value boundary` = NA, - `H3 p-value boundary` = NA -) -ans %>% gt() - -## ----------------------------------------------------------------------------- -w_H2 <- 1 - -# Index to select from the correlation matrix -indx <- grep("H2", colnames(corr)) -corr_H2 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H2 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[2], - n.I = corr_H2[, ncol(corr_H2)]^2, - alpha = alpha * w_H2[1], - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans_new <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H2", - `H1 p-value boundary` = NA, - `H2 p-value boundary` = pval_H2, - `H3 p-value boundary` = NA -) -ans_new %>% gt() -ans <- rbind(ans, ans_new) - -## ----------------------------------------------------------------------------- -w_H3 <- 1 - -# Index to select from the correlation matrix -indx <- grep("H3", colnames(corr)) -corr_H3 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H3 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[3], - n.I = corr_H3[, ncol(corr_H3)]^2, - alpha = alpha * w_H3[1], - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans_new <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H3", - `H1 p-value boundary` = NA, - `H2 p-value boundary` = NA, - `H3 p-value boundary` = pval_H1 -) -ans_new %>% gt() -ans <- rbind(ans, ans_new) - -## ----------------------------------------------------------------------------- -w_H12 <- inter_weight %>% filter(!is.na(H1), !is.na(H2), is.na(H3)) -w_H12 <- w_H12[(!is.na(w_H12))] # Remove NA from weight -w_H12 - -## ----------------------------------------------------------------------------- -# -------------# -# H1 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H1", colnames(corr)) -corr_H1 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H1 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[1], - n.I = corr_H1[, ncol(corr_H1)]^2, - alpha = alpha * w_H12[1], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -# -------------# -# H2 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H2", colnames(corr)) -corr_H2 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H2 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[2], - n.I = corr_H2[, ncol(corr_H2)]^2, - alpha = alpha * w_H12[2], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans_new <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H1, H2", - `H1 p-value boundary` = pval_H1, - `H2 p-value boundary` = pval_H2, - `H3 p-value boundary` = NA -) -ans_new %>% gt() -ans <- rbind(ans, ans_new) - -## ----------------------------------------------------------------------------- -w_H13 <- inter_weight %>% filter(!is.na(H1), is.na(H2), !is.na(H3)) -w_H13 <- w_H13[(!is.na(w_H13))] # Remove NA from weight -w_H13 - -## ----------------------------------------------------------------------------- -# -------------# -# H1 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H1", colnames(corr)) -corr_H1 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H1 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[1], - n.I = corr_H1[, ncol(corr_H1)]^2, - alpha = alpha * w_H13[1], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -# -------------# -# H3 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H3", colnames(corr)) -corr_H3 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H3 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[3], - n.I = corr_H3[, ncol(corr_H3)]^2, - alpha = alpha * w_H13[2], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans_new <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H1, H3", - `H1 p-value boundary` = pval_H1, - `H2 p-value boundary` = NA, - `H3 p-value boundary` = pval_H3 -) -ans_new %>% gt() -ans <- rbind(ans, ans_new) - -## ----------------------------------------------------------------------------- -w_H23 <- inter_weight %>% filter(is.na(H1), !is.na(H2), !is.na(H3)) -w_H23 <- w_H23[(!is.na(w_H23))] # Remove NA from weight -w_H23 - -## ----------------------------------------------------------------------------- -# -------------# -# H2 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H2", colnames(corr)) -corr_H2 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H2 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[2], - n.I = corr_H2[, ncol(corr_H2)]^2, - alpha = alpha * w_H23[1], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -# -------------# -# H3 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H3", colnames(corr)) -corr_H3 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H3 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[3], - n.I = corr_H3[, ncol(corr_H3)]^2, - alpha = alpha * w_H23[2], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans_new <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H2, H3", - `H1 p-value boundary` = NA, - `H2 p-value boundary` = pval_H2, - `H3 p-value boundary` = pval_H3 -) -ans_new %>% gt() -ans <- rbind(ans, ans_new) - -## ----------------------------------------------------------------------------- -w_H123 <- inter_weight %>% filter(!is.na(H1), !is.na(H2), !is.na(H3)) -w_H123 <- w_H123[(!is.na(w_H123))] # Remove NA from weight -w_H123 - -## ----------------------------------------------------------------------------- -# -------------# -# H1 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H1", colnames(corr)) -corr_H1 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H1 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[1], - n.I = corr_H1[, ncol(corr_H1)]^2, - alpha = alpha * w_H123[1], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -# -------------# -# H2 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H2", colnames(corr)) -corr_H2 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H2 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[2], - n.I = corr_H2[, ncol(corr_H2)]^2, - alpha = alpha * w_H123[1], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -# -------------# -# H3 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H3", colnames(corr)) -corr_H3 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H3 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[3], - n.I = corr_H3[, ncol(corr_H3)]^2, - alpha = alpha * w_H123[3], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans_new <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H1, H2, H3", - `H1 p-value boundary` = pval_H1, - `H2 p-value boundary` = pval_H2, - `H3 p-value boundary` = pval_H3 -) -ans_new %>% gt() -ans <- rbind(ans, ans_new) - -## ----------------------------------------------------------------------------- -ans %>% - mutate( - `H1 Z-statistics boundary` = -qnorm(`H1 p-value boundary`), - `H1 Z-statistics boundary` = -qnorm(`H2 p-value boundary`), - `H1 Z-statistics boundary` = -qnorm(`H3 p-value boundary`) - ) %>% - arrange(Analysis, `Interaction/Elementary hypotheses`) %>% - gt() %>% - tab_header("p-values/Z-statistics boundaries of weighted Bonferroni") - -## ----------------------------------------------------------------------------- -generate_bounds( - type = 0, - k = 2, - w = w, - m = m, - corr = corr, - alpha = 0.025, - sf = list(sfHSD, sfHSD, sfHSD), - sfparm = list(-4, -4, -4), - t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1)) -) %>% gt() - diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/tech-detail-wb.Rmd b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/tech-detail-wb.Rmd deleted file mode 100644 index 1eec9cb..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/tech-detail-wb.Rmd +++ /dev/null @@ -1,599 +0,0 @@ ---- -title: "Procedure to compute p-value boundaries by weighted Bonferroni" -author: "Yujie Zhao" -output: - rmarkdown::html_document: - toc: true - toc_float: true - toc_depth: 2 - number_sections: true - highlight: "textmate" - css: "custom.css" - code_fold: hide -vignette: > - %\VignetteEngine{knitr::rmarkdown} - %\VignetteIndexEntry{Procedure to compute p-value boundaries by weighted Bonferroni} ---- - -```{r, message = FALSE, warning = FALSE} -library(tibble) -library(gt) -library(gsDesign) -library(dplyr) -library(wpgsd) -``` - -# Example overview - -In a 2-arm controlled clinical trial example with one primary endpoint, -there are 3 patient populations defined by the status of two biomarkers A and B: - -- biomarker A positive, -- biomarker B positive, -- overall population. - -The 3 primary elementary hypotheses are: - -- $H_1$: the experimental treatment is superior to the control in the biomarker A positive population; -- $H_2$: the experimental treatment is superior to the control in the biomarker B positive population; -- $H_3$: the experimental treatment is superior to the control in the overall population. - -Assume an interim analysis and a final analysis are planned for the study and the number of events are listed as - -```{r} -k <- 2 # Number of total analysis -n_hypotheses <- 3 # Number of hypotheses -``` - -## Observed p-values - -```{r} -obs_tbl <- tribble( - ~hypothesis, ~analysis, ~obs_p, - "H1", 1, 0.02, - "H2", 1, 0.01, - "H3", 1, 0.006, - "H1", 2, 0.015, - "H2", 2, 0.012, - "H3", 2, 0.004 -) %>% - mutate(obs_Z = -qnorm(obs_p)) - -obs_tbl %>% - gt() %>% - tab_header(title = "Nominal p-values") - -p_obs_IA <- (obs_tbl %>% filter(analysis == 1))$obs_p -p_obs_FA <- (obs_tbl %>% filter(analysis == 2))$obs_p -``` - -## Information fraction - -```{r} -alpha <- 0.025 -event_tbl <- tribble( - ~population, ~analysis, ~event, - "A positive", 1, 80, - "B positive", 1, 88, - "AB positive", 1, 64, - "overall", 1, 180, - "A positive", 2, 160, - "B positive", 2, 176, - "AB positive", 2, 128, - "overall", 2, 360, -) -``` - -The information fraction of $H_1$, $H_2$, $H_3$ at IA is - -```{r} -IF_IA <- c( - ((event_tbl %>% filter(analysis == 1, population == "A positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "A positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event), - ((event_tbl %>% filter(analysis == 1, population == "B positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "B positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event), - ((event_tbl %>% filter(analysis == 1, population == "AB positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "AB positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event) -) - -IF_IA -``` - -## Initial weight and transition matrix - -We assign the initial weights of $H_1$, $H_2$, $H_3$ as -$\left(w_1(I), w_2(I), w_3(I) \right) = (0.3, 0.3, 0.4).$ -And its multiplicity strategy is visualized in below. -If $H_1$ is rejected, then $3/7$ local significance level $\alpha_1$ will be -propagated to $H_2$, and $4/7$ will go to $H_3$. If $H_3$ is rejected, -then half of $\alpha_3$ goes to $H_1$, and half goes to $H_2$. - -```{r} -m <- matrix(c( # Transition matrix - 0, 3 / 7, 4 / 7, - 3 / 7, 0, 4 / 7, - 1 / 2, 1 / 2, 0 -), nrow = 3, byrow = TRUE) - -w <- c(0.3, 0.3, 0.4) # Initial weights -``` - -```{r} -name_hypotheses <- c( - "H1: Biomarker A positive", - "H2: Biomarker B positive", - "H3: Overall Population" -) - -hplot <- gMCPLite::hGraph( - 3, - alphaHypotheses = w, m = m, - nameHypotheses = name_hypotheses, trhw = .2, trhh = .1, - digits = 5, trdigits = 3, size = 5, halfWid = 1, halfHgt = 0.5, - offset = 0.2, trprop = 0.4, - fill = as.factor(c(2, 3, 1)), - palette = c("#BDBDBD", "#E0E0E0", "#EEEEEE"), - wchar = "w" -) -hplot -``` - -```{r} -# Get weights for all intersection hypotheses -graph <- gMCPLite::matrix2graph(m) -graph <- gMCPLite::setWeights(graph, w) -``` - -```{r} -# Set up hypothetical p-values (0 or 1) to obtain all combinations -pvals <- NULL -for (i in 1:n_hypotheses) { - if (i == 1) { - pvals <- data.frame(x = c(0, 1)) - names(pvals) <- paste("pval_H", i, sep = "") - } else { - tmp <- data.frame(x = c(0, 1)) - names(tmp) <- paste("pval_H", i, sep = "") - pvals <- merge(pvals, tmp) - } -} -# Get the weights for each intersection hypothesis -inter_weight <- NULL # Create an empty table to store the weight of interaction hypotheses -for (i in seq_len(nrow(pvals))) { # Each row in `pvals` is 1 possible interaction hypothesis - pval_tmp <- as.numeric(pvals[i, ]) - graph_tmp <- gMCPLite::gMCP(graph = graph, pvalues = pval_tmp, alpha = alpha) - weight_tmp <- gMCPLite::getWeights(graph_tmp) - inter_weight <- dplyr::bind_rows(inter_weight, weight_tmp) -} - -inter_weight <- replace(inter_weight, pvals == 0, NA) # Replace the empty hypothesis as NA -inter_weight <- inter_weight[-1, ] # Delete the first row since it is empty set - -inter_weight %>% - gt() %>% - tab_header("Weight of all possible interaction hypothesis") -``` - -## Correlations - -The correlation of the 6 statistic (2 analyses $\times$ 3 hypotheses) are - -```{r} -# Event count of intersection of paired hypotheses - Table 2 -# H1, H2: Hypotheses intersected. -# (1, 1) represents counts for hypothesis 1 -# (1, 2) for counts for the intersection of hypotheses 1 and 2 -event <- tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, event_tbl %>% filter(analysis == 1, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 2, 1, event_tbl %>% filter(analysis == 1, population == "B positive") %>% select(event) %>% as.numeric(), - 3, 3, 1, event_tbl %>% filter(analysis == 1, population == "overall") %>% select(event) %>% as.numeric(), - 1, 2, 1, event_tbl %>% filter(analysis == 1, population == "AB positive") %>% select(event) %>% as.numeric(), - 1, 3, 1, event_tbl %>% filter(analysis == 1, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 3, 1, event_tbl %>% filter(analysis == 1, population == "B positive") %>% select(event) %>% as.numeric(), - 1, 1, 2, event_tbl %>% filter(analysis == 2, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 2, 2, event_tbl %>% filter(analysis == 2, population == "B positive") %>% select(event) %>% as.numeric(), - 3, 3, 2, event_tbl %>% filter(analysis == 2, population == "overall") %>% select(event) %>% as.numeric(), - 1, 2, 2, event_tbl %>% filter(analysis == 2, population == "AB positive") %>% select(event) %>% as.numeric(), - 1, 3, 2, event_tbl %>% filter(analysis == 2, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 3, 2, event_tbl %>% filter(analysis == 2, population == "B positive") %>% select(event) %>% as.numeric() -) -event - -# Generate correlation from events -corr <- wpgsd::generate_corr(event) -corr %>% round(2) -``` - -# Boundary calculation - -## Boundary of $H_1$ - -For the elementary hypothesis $H_1$, its weight is 1, namely, - -```{r} -w_H1 <- 1 - -# Index to select from the correlation matrix -indx <- grep("H1", colnames(corr)) -corr_H1 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H1 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[1], - n.I = corr_H1[, ncol(corr_H1)]^2, - alpha = alpha * w_H1[1], - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H1", - `H1 p-value boundary` = pval_H1, - `H2 p-value boundary` = NA, - `H3 p-value boundary` = NA -) -ans %>% gt() -``` - -## Boundary of $H_2$ - -For the elementary hypothesis $H_2$, its weight is 1, namely, - -```{r} -w_H2 <- 1 - -# Index to select from the correlation matrix -indx <- grep("H2", colnames(corr)) -corr_H2 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H2 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[2], - n.I = corr_H2[, ncol(corr_H2)]^2, - alpha = alpha * w_H2[1], - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans_new <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H2", - `H1 p-value boundary` = NA, - `H2 p-value boundary` = pval_H2, - `H3 p-value boundary` = NA -) -ans_new %>% gt() -ans <- rbind(ans, ans_new) -``` - -## Boundary of $H_3$ - -For the elementary hypothesis $H_3$, its weight is 1, namely, - -```{r} -w_H3 <- 1 - -# Index to select from the correlation matrix -indx <- grep("H3", colnames(corr)) -corr_H3 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H3 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[3], - n.I = corr_H3[, ncol(corr_H3)]^2, - alpha = alpha * w_H3[1], - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans_new <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H3", - `H1 p-value boundary` = NA, - `H2 p-value boundary` = NA, - `H3 p-value boundary` = pval_H1 -) -ans_new %>% gt() -ans <- rbind(ans, ans_new) -``` - -## Boundary of $H_1 \cap H_2$ - -For the interaction hypothesis $H_1 \cap H_2$, its weight is - -```{r} -w_H12 <- inter_weight %>% filter(!is.na(H1), !is.na(H2), is.na(H3)) -w_H12 <- w_H12[(!is.na(w_H12))] # Remove NA from weight -w_H12 -``` - -And the boundary for $H_1$ and $H_2$ are - -```{r} -# -------------# -# H1 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H1", colnames(corr)) -corr_H1 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H1 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[1], - n.I = corr_H1[, ncol(corr_H1)]^2, - alpha = alpha * w_H12[1], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -# -------------# -# H2 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H2", colnames(corr)) -corr_H2 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H2 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[2], - n.I = corr_H2[, ncol(corr_H2)]^2, - alpha = alpha * w_H12[2], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans_new <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H1, H2", - `H1 p-value boundary` = pval_H1, - `H2 p-value boundary` = pval_H2, - `H3 p-value boundary` = NA -) -ans_new %>% gt() -ans <- rbind(ans, ans_new) -``` - -## Boundary of $H_1 \cap H_3$ - -For the interaction hypothesis $H_1 \cap H_2$, its weight is - -```{r} -w_H13 <- inter_weight %>% filter(!is.na(H1), is.na(H2), !is.na(H3)) -w_H13 <- w_H13[(!is.na(w_H13))] # Remove NA from weight -w_H13 -``` - -And the boundary for $H_1$ and $H_3$ are - -```{r} -# -------------# -# H1 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H1", colnames(corr)) -corr_H1 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H1 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[1], - n.I = corr_H1[, ncol(corr_H1)]^2, - alpha = alpha * w_H13[1], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -# -------------# -# H3 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H3", colnames(corr)) -corr_H3 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H3 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[3], - n.I = corr_H3[, ncol(corr_H3)]^2, - alpha = alpha * w_H13[2], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans_new <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H1, H3", - `H1 p-value boundary` = pval_H1, - `H2 p-value boundary` = NA, - `H3 p-value boundary` = pval_H3 -) -ans_new %>% gt() -ans <- rbind(ans, ans_new) -``` - -## Boundary of $H_2 \cap H_3$ - -For the interaction hypothesis $H_2 \cap H_3$, its weight is - -```{r} -w_H23 <- inter_weight %>% filter(is.na(H1), !is.na(H2), !is.na(H3)) -w_H23 <- w_H23[(!is.na(w_H23))] # Remove NA from weight -w_H23 -``` - -And the boundary for $H_2$ and $H_3$ are - -```{r} -# -------------# -# H2 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H2", colnames(corr)) -corr_H2 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H2 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[2], - n.I = corr_H2[, ncol(corr_H2)]^2, - alpha = alpha * w_H23[1], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -# -------------# -# H3 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H3", colnames(corr)) -corr_H3 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H3 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[3], - n.I = corr_H3[, ncol(corr_H3)]^2, - alpha = alpha * w_H23[2], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans_new <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H2, H3", - `H1 p-value boundary` = NA, - `H2 p-value boundary` = pval_H2, - `H3 p-value boundary` = pval_H3 -) -ans_new %>% gt() -ans <- rbind(ans, ans_new) -``` - -## Boundary of $H1 \cap H_2 \cap H_3$ - -For the interaction hypothesis $H_1 \cap H_2$, its weight is - -```{r} -w_H123 <- inter_weight %>% filter(!is.na(H1), !is.na(H2), !is.na(H3)) -w_H123 <- w_H123[(!is.na(w_H123))] # Remove NA from weight -w_H123 -``` - -And the boundary for $H_1$, $H_2$, and $H_3$ are - -```{r} -# -------------# -# H1 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H1", colnames(corr)) -corr_H1 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H1 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[1], - n.I = corr_H1[, ncol(corr_H1)]^2, - alpha = alpha * w_H123[1], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -# -------------# -# H2 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H2", colnames(corr)) -corr_H2 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H2 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[2], - n.I = corr_H2[, ncol(corr_H2)]^2, - alpha = alpha * w_H123[1], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -# -------------# -# H3 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H3", colnames(corr)) -corr_H3 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H3 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[3], - n.I = corr_H3[, ncol(corr_H3)]^2, - alpha = alpha * w_H123[3], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans_new <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H1, H2, H3", - `H1 p-value boundary` = pval_H1, - `H2 p-value boundary` = pval_H2, - `H3 p-value boundary` = pval_H3 -) -ans_new %>% gt() -ans <- rbind(ans, ans_new) -``` - -# Summary - -With the p-value boundaries, one can get the Z-statistics boundaries by `qnorm()`. - -```{r} -ans %>% - mutate( - `H1 Z-statistics boundary` = -qnorm(`H1 p-value boundary`), - `H1 Z-statistics boundary` = -qnorm(`H2 p-value boundary`), - `H1 Z-statistics boundary` = -qnorm(`H3 p-value boundary`) - ) %>% - arrange(Analysis, `Interaction/Elementary hypotheses`) %>% - gt() %>% - tab_header("p-values/Z-statistics boundaries of weighted Bonferroni") -``` - -# Implementation in wpgsd - -The above results can be computed in one function call in wpgsd by using -the `generate_bounds()` function as - -```{r} -generate_bounds( - type = 0, - k = 2, - w = w, - m = m, - corr = corr, - alpha = 0.025, - sf = list(sfHSD, sfHSD, sfHSD), - sfparm = list(-4, -4, -4), - t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1)) -) %>% gt() -``` diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/tech-detail-wb.html b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/tech-detail-wb.html deleted file mode 100644 index 63b3a07..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/tech-detail-wb.html +++ /dev/null @@ -1,7117 +0,0 @@ - - - - - - - - - - - - - - -Procedure to compute p-value boundaries by weighted Bonferroni - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- - - -
-
-
-
-
- -
- - - - - - - -
library(tibble)
-library(gt)
-library(gsDesign)
-library(dplyr)
-library(wpgsd)
-
-

1 Example overview

-

In a 2-arm controlled clinical trial example with one primary -endpoint, there are 3 patient populations defined by the status of two -biomarkers A and B:

-
    -
  • biomarker A positive,
  • -
  • biomarker B positive,
  • -
  • overall population.
  • -
-

The 3 primary elementary hypotheses are:

-
    -
  • \(H_1\): the experimental treatment -is superior to the control in the biomarker A positive population;
  • -
  • \(H_2\): the experimental treatment -is superior to the control in the biomarker B positive population;
  • -
  • \(H_3\): the experimental treatment -is superior to the control in the overall population.
  • -
-

Assume an interim analysis and a final analysis are planned for the -study and the number of events are listed as

-
k <- 2 # Number of total analysis
-n_hypotheses <- 3 # Number of hypotheses
-
-

1.1 Observed -p-values

-
obs_tbl <- tribble(
-  ~hypothesis, ~analysis, ~obs_p,
-  "H1", 1, 0.02,
-  "H2", 1, 0.01,
-  "H3", 1, 0.006,
-  "H1", 2, 0.015,
-  "H2", 2, 0.012,
-  "H3", 2, 0.004
-) %>%
-  mutate(obs_Z = -qnorm(obs_p))
-
-obs_tbl %>%
-  gt() %>%
-  tab_header(title = "Nominal p-values")
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Nominal p-values
hypothesisanalysisobs_pobs_Z
H110.0202.053749
H210.0102.326348
H310.0062.512144
H120.0152.170090
H220.0122.257129
H320.0042.652070
-
-
p_obs_IA <- (obs_tbl %>% filter(analysis == 1))$obs_p
-p_obs_FA <- (obs_tbl %>% filter(analysis == 2))$obs_p
-
-
-

1.2 Information -fraction

-
alpha <- 0.025
-event_tbl <- tribble(
-  ~population, ~analysis, ~event,
-  "A positive", 1, 80,
-  "B positive", 1, 88,
-  "AB positive", 1, 64,
-  "overall", 1, 180,
-  "A positive", 2, 160,
-  "B positive", 2, 176,
-  "AB positive", 2, 128,
-  "overall", 2, 360,
-)
-

The information fraction of \(H_1\), -\(H_2\), \(H_3\) at IA is

-
IF_IA <- c(
-  ((event_tbl %>% filter(analysis == 1, population == "A positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) /
-    ((event_tbl %>% filter(analysis == 2, population == "A positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event),
-  ((event_tbl %>% filter(analysis == 1, population == "B positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) /
-    ((event_tbl %>% filter(analysis == 2, population == "B positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event),
-  ((event_tbl %>% filter(analysis == 1, population == "AB positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) /
-    ((event_tbl %>% filter(analysis == 2, population == "AB positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event)
-)
-
-IF_IA
-
## [1] 0.5 0.5 0.5
-
-
-

1.3 Initial weight and -transition matrix

-

We assign the initial weights of \(H_1\), \(H_2\), \(H_3\) as \(\left(w_1(I), w_2(I), w_3(I) \right) = (0.3, 0.3, -0.4).\) And its multiplicity strategy is visualized in below. If -\(H_1\) is rejected, then \(3/7\) local significance level \(\alpha_1\) will be propagated to \(H_2\), and \(4/7\) will go to \(H_3\). If \(H_3\) is rejected, then half of \(\alpha_3\) goes to \(H_1\), and half goes to \(H_2\).

-
m <- matrix(c( # Transition matrix
-  0, 3 / 7, 4 / 7,
-  3 / 7, 0, 4 / 7,
-  1 / 2, 1 / 2, 0
-), nrow = 3, byrow = TRUE)
-
-w <- c(0.3, 0.3, 0.4) # Initial weights
-
name_hypotheses <- c(
-  "H1: Biomarker A positive",
-  "H2: Biomarker B positive",
-  "H3: Overall Population"
-)
-
-hplot <- gMCPLite::hGraph(
-  3,
-  alphaHypotheses = w, m = m,
-  nameHypotheses = name_hypotheses, trhw = .2, trhh = .1,
-  digits = 5, trdigits = 3, size = 5, halfWid = 1, halfHgt = 0.5,
-  offset = 0.2, trprop = 0.4,
-  fill = as.factor(c(2, 3, 1)),
-  palette = c("#BDBDBD", "#E0E0E0", "#EEEEEE"),
-  wchar = "w"
-)
-hplot
-

-
# Get weights for all intersection hypotheses
-graph <- gMCPLite::matrix2graph(m)
-graph <- gMCPLite::setWeights(graph, w)
-
# Set up hypothetical p-values (0 or 1) to obtain all combinations
-pvals <- NULL
-for (i in 1:n_hypotheses) {
-  if (i == 1) {
-    pvals <- data.frame(x = c(0, 1))
-    names(pvals) <- paste("pval_H", i, sep = "")
-  } else {
-    tmp <- data.frame(x = c(0, 1))
-    names(tmp) <- paste("pval_H", i, sep = "")
-    pvals <- merge(pvals, tmp)
-  }
-}
-# Get the weights for each intersection hypothesis
-inter_weight <- NULL # Create an empty table to store the weight of interaction hypotheses
-for (i in seq_len(nrow(pvals))) { # Each row in `pvals` is 1 possible interaction hypothesis
-  pval_tmp <- as.numeric(pvals[i, ])
-  graph_tmp <- gMCPLite::gMCP(graph = graph, pvalues = pval_tmp, alpha = alpha)
-  weight_tmp <- gMCPLite::getWeights(graph_tmp)
-  inter_weight <- dplyr::bind_rows(inter_weight, weight_tmp)
-}
-
-inter_weight <- replace(inter_weight, pvals == 0, NA) # Replace the empty hypothesis as NA
-inter_weight <- inter_weight[-1, ] # Delete the first row since it is empty set
-
-inter_weight %>%
-  gt() %>%
-  tab_header("Weight of all possible interaction hypothesis")
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Weight of all possible interaction hypothesis
H1H2H3
1.0000000NANA
NA1.0000000NA
0.50000000.5000000NA
NANA1.0000000
0.4285714NA0.5714286
NA0.42857140.5714286
0.30000000.30000000.4000000
-
-
-
-

1.4 Correlations

-

The correlation of the 6 statistic (2 analyses \(\times\) 3 hypotheses) are

-
# Event count of intersection of paired hypotheses - Table 2
-# H1, H2: Hypotheses intersected.
-# (1, 1) represents counts for hypothesis 1
-# (1, 2) for counts for the intersection of hypotheses 1 and 2
-event <- tribble(
-  ~H1, ~H2, ~Analysis, ~Event,
-  1, 1, 1, event_tbl %>% filter(analysis == 1, population == "A positive") %>% select(event) %>% as.numeric(),
-  2, 2, 1, event_tbl %>% filter(analysis == 1, population == "B positive") %>% select(event) %>% as.numeric(),
-  3, 3, 1, event_tbl %>% filter(analysis == 1, population == "overall") %>% select(event) %>% as.numeric(),
-  1, 2, 1, event_tbl %>% filter(analysis == 1, population == "AB positive") %>% select(event) %>% as.numeric(),
-  1, 3, 1, event_tbl %>% filter(analysis == 1, population == "A positive") %>% select(event) %>% as.numeric(),
-  2, 3, 1, event_tbl %>% filter(analysis == 1, population == "B positive") %>% select(event) %>% as.numeric(),
-  1, 1, 2, event_tbl %>% filter(analysis == 2, population == "A positive") %>% select(event) %>% as.numeric(),
-  2, 2, 2, event_tbl %>% filter(analysis == 2, population == "B positive") %>% select(event) %>% as.numeric(),
-  3, 3, 2, event_tbl %>% filter(analysis == 2, population == "overall") %>% select(event) %>% as.numeric(),
-  1, 2, 2, event_tbl %>% filter(analysis == 2, population == "AB positive") %>% select(event) %>% as.numeric(),
-  1, 3, 2, event_tbl %>% filter(analysis == 2, population == "A positive") %>% select(event) %>% as.numeric(),
-  2, 3, 2, event_tbl %>% filter(analysis == 2, population == "B positive") %>% select(event) %>% as.numeric()
-)
-event
-
## # A tibble: 12 × 4
-##       H1    H2 Analysis Event
-##    <dbl> <dbl>    <dbl> <dbl>
-##  1     1     1        1    80
-##  2     2     2        1    88
-##  3     3     3        1   180
-##  4     1     2        1    64
-##  5     1     3        1    80
-##  6     2     3        1    88
-##  7     1     1        2   160
-##  8     2     2        2   176
-##  9     3     3        2   360
-## 10     1     2        2   128
-## 11     1     3        2   160
-## 12     2     3        2   176
-
# Generate correlation from events
-corr <- wpgsd::generate_corr(event)
-corr %>% round(2)
-
##      H1_A1 H2_A1 H3_A1 H1_A2 H2_A2 H3_A2
-## [1,]  1.00  0.76  0.67  0.71  0.54  0.47
-## [2,]  0.76  1.00  0.70  0.54  0.71  0.49
-## [3,]  0.67  0.70  1.00  0.47  0.49  0.71
-## [4,]  0.71  0.54  0.47  1.00  0.76  0.67
-## [5,]  0.54  0.71  0.49  0.76  1.00  0.70
-## [6,]  0.47  0.49  0.71  0.67  0.70  1.00
-
-
-
-

2 Boundary -calculation

-
-

2.1 Boundary of \(H_1\)

-

For the elementary hypothesis \(H_1\), its weight is 1, namely,

-
w_H1 <- 1
-
-# Index to select from the correlation matrix
-indx <- grep("H1", colnames(corr))
-corr_H1 <- corr[indx, indx]
-
-# Boundary for a single hypothesis across k for the intersection hypothesis
-pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
-  k = k,
-  test.type = 1,
-  usTime = IF_IA[1],
-  n.I = corr_H1[, ncol(corr_H1)]^2,
-  alpha = alpha * w_H1[1],
-  sfu = sfHSD,
-  sfupar = -4
-)$upper$bound)
-
-ans <- tibble(
-  Analysis = 1:2,
-  `Interaction/Elementary hypotheses` = "H1",
-  `H1 p-value boundary` = pval_H1,
-  `H2 p-value boundary` = NA,
-  `H3 p-value boundary` = NA
-)
-ans %>% gt()
-
- - - - - - - - - - - - - - - - - - - - - - - - - -
AnalysisInteraction/Elementary hypothesesH1 p-value boundaryH2 p-value boundaryH3 p-value boundary
1H10.002980073NANA
2H10.023788266NANA
-
-
-
-

2.2 Boundary of \(H_2\)

-

For the elementary hypothesis \(H_2\), its weight is 1, namely,

-
w_H2 <- 1
-
-# Index to select from the correlation matrix
-indx <- grep("H2", colnames(corr))
-corr_H2 <- corr[indx, indx]
-
-# Boundary for a single hypothesis across k for the intersection hypothesis
-pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
-  k = k,
-  test.type = 1,
-  usTime = IF_IA[2],
-  n.I = corr_H2[, ncol(corr_H2)]^2,
-  alpha = alpha * w_H2[1],
-  sfu = sfHSD,
-  sfupar = -4
-)$upper$bound)
-
-ans_new <- tibble(
-  Analysis = 1:2,
-  `Interaction/Elementary hypotheses` = "H2",
-  `H1 p-value boundary` = NA,
-  `H2 p-value boundary` = pval_H2,
-  `H3 p-value boundary` = NA
-)
-ans_new %>% gt()
-
- - - - - - - - - - - - - - - - - - - - - - - - - -
AnalysisInteraction/Elementary hypothesesH1 p-value boundaryH2 p-value boundaryH3 p-value boundary
1H2NA0.002980073NA
2H2NA0.023788266NA
-
-
ans <- rbind(ans, ans_new)
-
-
-

2.3 Boundary of \(H_3\)

-

For the elementary hypothesis \(H_3\), its weight is 1, namely,

-
w_H3 <- 1
-
-# Index to select from the correlation matrix
-indx <- grep("H3", colnames(corr))
-corr_H3 <- corr[indx, indx]
-
-# Boundary for a single hypothesis across k for the intersection hypothesis
-pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
-  k = k,
-  test.type = 1,
-  usTime = IF_IA[3],
-  n.I = corr_H3[, ncol(corr_H3)]^2,
-  alpha = alpha * w_H3[1],
-  sfu = sfHSD,
-  sfupar = -4
-)$upper$bound)
-
-ans_new <- tibble(
-  Analysis = 1:2,
-  `Interaction/Elementary hypotheses` = "H3",
-  `H1 p-value boundary` = NA,
-  `H2 p-value boundary` = NA,
-  `H3 p-value boundary` = pval_H1
-)
-ans_new %>% gt()
-
- - - - - - - - - - - - - - - - - - - - - - - - - -
AnalysisInteraction/Elementary hypothesesH1 p-value boundaryH2 p-value boundaryH3 p-value boundary
1H3NANA0.002980073
2H3NANA0.023788266
-
-
ans <- rbind(ans, ans_new)
-
-
-

2.4 Boundary of \(H_1 \cap H_2\)

-

For the interaction hypothesis \(H_1 \cap -H_2\), its weight is

-
w_H12 <- inter_weight %>% filter(!is.na(H1), !is.na(H2), is.na(H3))
-w_H12 <- w_H12[(!is.na(w_H12))] # Remove NA from weight
-w_H12
-
## [1] 0.5 0.5
-

And the boundary for \(H_1\) and -\(H_2\) are

-
# -------------#
-#      H1      #
-# -------------#
-# Index to select from the correlation matrix
-indx <- grep("H1", colnames(corr))
-corr_H1 <- corr[indx, indx]
-
-# Boundary for a single hypothesis across k for the intersection hypothesis
-pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
-  k = k,
-  test.type = 1,
-  usTime = IF_IA[1],
-  n.I = corr_H1[, ncol(corr_H1)]^2,
-  alpha = alpha * w_H12[1], # alpha is different since the weight is updated
-  sfu = sfHSD,
-  sfupar = -4
-)$upper$bound)
-
-# -------------#
-#      H2      #
-# -------------#
-# Index to select from the correlation matrix
-indx <- grep("H2", colnames(corr))
-corr_H2 <- corr[indx, indx]
-
-# Boundary for a single hypothesis across k for the intersection hypothesis
-pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
-  k = k,
-  test.type = 1,
-  usTime = IF_IA[2],
-  n.I = corr_H2[, ncol(corr_H2)]^2,
-  alpha = alpha * w_H12[2], # alpha is different since the weight is updated
-  sfu = sfHSD,
-  sfupar = -4
-)$upper$bound)
-
-ans_new <- tibble(
-  Analysis = 1:2,
-  `Interaction/Elementary hypotheses` = "H1, H2",
-  `H1 p-value boundary` = pval_H1,
-  `H2 p-value boundary` = pval_H2,
-  `H3 p-value boundary` = NA
-)
-ans_new %>% gt()
-
- - - - - - - - - - - - - - - - - - - - - - - - - -
AnalysisInteraction/Elementary hypothesesH1 p-value boundaryH2 p-value boundaryH3 p-value boundary
1H1, H20.0014900370.001490037NA
2H1, H20.0117828000.011782800NA
-
-
ans <- rbind(ans, ans_new)
-
-
-

2.5 Boundary of \(H_1 \cap H_3\)

-

For the interaction hypothesis \(H_1 \cap -H_2\), its weight is

-
w_H13 <- inter_weight %>% filter(!is.na(H1), is.na(H2), !is.na(H3))
-w_H13 <- w_H13[(!is.na(w_H13))] # Remove NA from weight
-w_H13
-
## [1] 0.4285714 0.5714286
-

And the boundary for \(H_1\) and -\(H_3\) are

-
# -------------#
-#      H1      #
-# -------------#
-# Index to select from the correlation matrix
-indx <- grep("H1", colnames(corr))
-corr_H1 <- corr[indx, indx]
-
-# Boundary for a single hypothesis across k for the intersection hypothesis
-pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
-  k = k,
-  test.type = 1,
-  usTime = IF_IA[1],
-  n.I = corr_H1[, ncol(corr_H1)]^2,
-  alpha = alpha * w_H13[1], # alpha is different since the weight is updated
-  sfu = sfHSD,
-  sfupar = -4
-)$upper$bound)
-
-# -------------#
-#      H3      #
-# -------------#
-# Index to select from the correlation matrix
-indx <- grep("H3", colnames(corr))
-corr_H3 <- corr[indx, indx]
-
-# Boundary for a single hypothesis across k for the intersection hypothesis
-pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
-  k = k,
-  test.type = 1,
-  usTime = IF_IA[3],
-  n.I = corr_H3[, ncol(corr_H3)]^2,
-  alpha = alpha * w_H13[2], # alpha is different since the weight is updated
-  sfu = sfHSD,
-  sfupar = -4
-)$upper$bound)
-
-ans_new <- tibble(
-  Analysis = 1:2,
-  `Interaction/Elementary hypotheses` = "H1, H3",
-  `H1 p-value boundary` = pval_H1,
-  `H2 p-value boundary` = NA,
-  `H3 p-value boundary` = pval_H3
-)
-ans_new %>% gt()
-
- - - - - - - - - - - - - - - - - - - - - - - - - -
AnalysisInteraction/Elementary hypothesesH1 p-value boundaryH2 p-value boundaryH3 p-value boundary
1H1, H30.001277174NA0.001702899
2H1, H30.010079863NA0.013489389
-
-
ans <- rbind(ans, ans_new)
-
-
-

2.6 Boundary of \(H_2 \cap H_3\)

-

For the interaction hypothesis \(H_2 \cap -H_3\), its weight is

-
w_H23 <- inter_weight %>% filter(is.na(H1), !is.na(H2), !is.na(H3))
-w_H23 <- w_H23[(!is.na(w_H23))] # Remove NA from weight
-w_H23
-
## [1] 0.4285714 0.5714286
-

And the boundary for \(H_2\) and -\(H_3\) are

-
# -------------#
-#      H2      #
-# -------------#
-# Index to select from the correlation matrix
-indx <- grep("H2", colnames(corr))
-corr_H2 <- corr[indx, indx]
-
-# Boundary for a single hypothesis across k for the intersection hypothesis
-pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
-  k = k,
-  test.type = 1,
-  usTime = IF_IA[2],
-  n.I = corr_H2[, ncol(corr_H2)]^2,
-  alpha = alpha * w_H23[1], # alpha is different since the weight is updated
-  sfu = sfHSD,
-  sfupar = -4
-)$upper$bound)
-
-# -------------#
-#      H3      #
-# -------------#
-# Index to select from the correlation matrix
-indx <- grep("H3", colnames(corr))
-corr_H3 <- corr[indx, indx]
-
-# Boundary for a single hypothesis across k for the intersection hypothesis
-pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
-  k = k,
-  test.type = 1,
-  usTime = IF_IA[3],
-  n.I = corr_H3[, ncol(corr_H3)]^2,
-  alpha = alpha * w_H23[2], # alpha is different since the weight is updated
-  sfu = sfHSD,
-  sfupar = -4
-)$upper$bound)
-
-ans_new <- tibble(
-  Analysis = 1:2,
-  `Interaction/Elementary hypotheses` = "H2, H3",
-  `H1 p-value boundary` = NA,
-  `H2 p-value boundary` = pval_H2,
-  `H3 p-value boundary` = pval_H3
-)
-ans_new %>% gt()
-
- - - - - - - - - - - - - - - - - - - - - - - - - -
AnalysisInteraction/Elementary hypothesesH1 p-value boundaryH2 p-value boundaryH3 p-value boundary
1H2, H3NA0.0012771740.001702899
2H2, H3NA0.0100798630.013489389
-
-
ans <- rbind(ans, ans_new)
-
-
-

2.7 Boundary of \(H1 \cap H_2 \cap H_3\)

-

For the interaction hypothesis \(H_1 \cap -H_2\), its weight is

-
w_H123 <- inter_weight %>% filter(!is.na(H1), !is.na(H2), !is.na(H3))
-w_H123 <- w_H123[(!is.na(w_H123))] # Remove NA from weight
-w_H123
-
## [1] 0.3 0.3 0.4
-

And the boundary for \(H_1\), \(H_2\), and \(H_3\) are

-
# -------------#
-#      H1      #
-# -------------#
-# Index to select from the correlation matrix
-indx <- grep("H1", colnames(corr))
-corr_H1 <- corr[indx, indx]
-
-# Boundary for a single hypothesis across k for the intersection hypothesis
-pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
-  k = k,
-  test.type = 1,
-  usTime = IF_IA[1],
-  n.I = corr_H1[, ncol(corr_H1)]^2,
-  alpha = alpha * w_H123[1], # alpha is different since the weight is updated
-  sfu = sfHSD,
-  sfupar = -4
-)$upper$bound)
-
-# -------------#
-#      H2      #
-# -------------#
-# Index to select from the correlation matrix
-indx <- grep("H2", colnames(corr))
-corr_H2 <- corr[indx, indx]
-
-# Boundary for a single hypothesis across k for the intersection hypothesis
-pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
-  k = k,
-  test.type = 1,
-  usTime = IF_IA[2],
-  n.I = corr_H2[, ncol(corr_H2)]^2,
-  alpha = alpha * w_H123[1], # alpha is different since the weight is updated
-  sfu = sfHSD,
-  sfupar = -4
-)$upper$bound)
-
-# -------------#
-#      H3      #
-# -------------#
-# Index to select from the correlation matrix
-indx <- grep("H3", colnames(corr))
-corr_H3 <- corr[indx, indx]
-
-# Boundary for a single hypothesis across k for the intersection hypothesis
-pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
-  k = k,
-  test.type = 1,
-  usTime = IF_IA[3],
-  n.I = corr_H3[, ncol(corr_H3)]^2,
-  alpha = alpha * w_H123[3], # alpha is different since the weight is updated
-  sfu = sfHSD,
-  sfupar = -4
-)$upper$bound)
-
-ans_new <- tibble(
-  Analysis = 1:2,
-  `Interaction/Elementary hypotheses` = "H1, H2, H3",
-  `H1 p-value boundary` = pval_H1,
-  `H2 p-value boundary` = pval_H2,
-  `H3 p-value boundary` = pval_H3
-)
-ans_new %>% gt()
-
- - - - - - - - - - - - - - - - - - - - - - - - - -
AnalysisInteraction/Elementary hypothesesH1 p-value boundaryH2 p-value boundaryH3 p-value boundary
1H1, H2, H30.00089402190.00089402190.001192029
2H1, H2, H30.00702549790.00702549790.009399818
-
-
ans <- rbind(ans, ans_new)
-
-
-
-

3 Summary

-

With the p-value boundaries, one can get the Z-statistics boundaries -by qnorm().

-
ans %>%
-  mutate(
-    `H1 Z-statistics boundary` = -qnorm(`H1 p-value boundary`),
-    `H1 Z-statistics boundary` = -qnorm(`H2 p-value boundary`),
-    `H1 Z-statistics boundary` = -qnorm(`H3 p-value boundary`)
-  ) %>%
-  arrange(Analysis, `Interaction/Elementary hypotheses`) %>%
-  gt() %>%
-  tab_header("p-values/Z-statistics boundaries of weighted Bonferroni")
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
p-values/Z-statistics boundaries of weighted Bonferroni
AnalysisInteraction/Elementary hypothesesH1 p-value boundaryH2 p-value boundaryH3 p-value boundaryH1 Z-statistics boundary
1H10.0029800731NANANA
1H1, H20.00149003650.0014900365NANA
1H1, H2, H30.00089402190.00089402190.0011920293.037681
1H1, H30.0012771742NA0.0017028992.928520
1H2NA0.0029800731NANA
1H2, H3NA0.00127717420.0017028992.928520
1H3NANA0.0029800732.749966
2H10.0237882657NANANA
2H1, H20.01178280030.0117828003NANA
2H1, H2, H30.00702549790.00702549790.0093998182.349480
2H1, H30.0100798631NA0.0134893892.211825
2H2NA0.0237882657NANA
2H2, H3NA0.01007986310.0134893892.211825
2H3NANA0.0237882661.981131
-
-
-
-

4 Implementation in -wpgsd

-

The above results can be computed in one function call in wpgsd by -using the generate_bounds() function as

-
generate_bounds(
-  type = 0,
-  k = 2,
-  w = w,
-  m = m,
-  corr = corr,
-  alpha = 0.025,
-  sf = list(sfHSD, sfHSD, sfHSD),
-  sfparm = list(-4, -4, -4),
-  t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1))
-) %>% gt()
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
AnalysisHypothesesH1H2H3
1H10.0029800731NANA
1H1, H20.00149003650.0014900365NA
1H1, H2, H30.00089402190.00089402190.001192029
1H1, H30.0012771742NA0.001702899
1H2NA0.0029800731NA
1H2, H3NA0.00127717420.001702899
1H3NANA0.002980073
2H10.0237882657NANA
2H1, H20.01178280030.0117828003NA
2H1, H2, H30.00702549790.00702549790.009399818
2H1, H30.0100798631NA0.013489389
2H2NA0.0237882657NA
2H2, H3NA0.01007986310.013489389
2H3NANA0.023788266
-
-
- - - -
-
- -
- - - - - - - - - - - - - - - - - diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/wpgsd.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/wpgsd.R deleted file mode 100644 index 8aea00b..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/wpgsd.R +++ /dev/null @@ -1,335 +0,0 @@ -## ----include = FALSE---------------------------------------------------------- -knitr::opts_chunk$set( - collapse = TRUE, - comment = "#>", - error = TRUE, - fig.align = "center" -) - -## ----message=FALSE, warning=FALSE--------------------------------------------- -library(wpgsd) -library(gsDesign) -library(gMCPLite) -library(haven) -library(dplyr) -library(tidyr) -library(reshape2) -library(gt) - -## ----eval=FALSE, echo=FALSE--------------------------------------------------- -# library(ggplot2) -# library(ggforce) -# -# ellipse_data <- data.frame( -# id = c("H1: Population 1", "H2: Population 2", "H3: Overall Population"), -# x = c(0, 1, 0.5), -# y = c(0, 0, 0), -# a = c(1, 1, 2), -# b = c(0.5, 0.5, 1) -# ) -# -# ragg::agg_png( -# "vignettes/figures/ex1-pop.png", -# width = 1920, -# height = 1920 / 1.618, -# res = 96, -# scaling = 2 -# ) -# ggplot() + -# geom_ellipse( -# aes( -# x0 = x, y0 = y, a = a, b = b, angle = 0, fill = id -# ), -# data = ellipse_data[ellipse_data$id == "H3: Overall Population", ], -# color = NA, alpha = 0.5, show.legend = FALSE -# ) + -# geom_ellipse( -# aes( -# x0 = x, y0 = y, a = a, b = b, angle = 0, fill = id -# ), -# data = ellipse_data[ellipse_data$id != "H3: Overall Population", ], -# color = NA, alpha = 0.85, show.legend = FALSE -# ) + -# geom_text(aes( -# x = x, y = y, label = id, -# hjust = ifelse(id == "H1: Population 1", 1.1, -# ifelse(id == "H2: Population 2", -0.1, 0.5) -# ), -# vjust = ifelse(id == "H3: Overall Population", -9, 0.5) -# ), data = ellipse_data, size = 6) + -# scale_fill_manual(values = c("#E69F00", "#56B4E9", "#999999"), guide = "none") + -# coord_fixed() + -# theme_void() -# dev.off() - -## ----echo=FALSE, out.width="90%", fig.cap="Ex1: Populations"------------------ -knitr::include_graphics("figures/ex1-pop.png") - -## ----out.width="80%"---------------------------------------------------------- -# Transition matrix -m <- matrix(c( - 0, 0, 1, - 0, 0, 1, - 0.5, 0.5, 0 -), nrow = 3, byrow = TRUE) -# Weight matrix -w <- c(0.3, 0.3, 0.4) - -# Multiplicity graph -cbPalette <- c("#999999", "#E69F00", "#56B4E9") - -nameHypotheses <- c( - "H1: Population 1", - "H2: Population 2", - "H3: Overall Population" -) - -hplot <- hGraph(3, - alphaHypotheses = w, - m = m, - nameHypotheses = nameHypotheses, - trhw = .2, trhh = .1, - digits = 5, trdigits = 3, size = 5, halfWid = 1, - halfHgt = 0.5, offset = 0.2, trprop = 0.4, - fill = as.factor(c(2, 3, 1)), - palette = cbPalette, - wchar = "w" -) -hplot - -## ----out.width="80%", echo = FALSE-------------------------------------------- -cbPalette <- c( - "#999999", "#E69F00", "#56B4E9", "#009E73", - "#F0E442", "#0072B2", "#D55E00", "#CC79A7" -) -nameHypotheses <- c( - "H1: Experimental 1 vs Control", - "H2: Experimental 2 vs Control", - "H3: Experimental 3 vs Control" -) -m <- matrix(c( - 0, 0.5, 0.5, - 0.5, 0, 0.5, - 0.5, 0.5, 0 -), nrow = 3, byrow = TRUE) -alphaHypotheses <- c(1 / 3, 1 / 3, 1 / 3) - -hplot <- hGraph(3, - alphaHypotheses = alphaHypotheses, m = m, - nameHypotheses = nameHypotheses, trhw = .2, trhh = .1, - digits = 3, trdigits = 4, size = 5, halfWid = 1.2, halfHgt = 0.5, - offset = 0.2, trprop = 0.35, - fill = as.factor(c(2, 3, 1)), - palette = cbPalette[1:3], - wchar = "w" -) -hplot - -## ----------------------------------------------------------------------------- -event <- tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 100, - 2, 2, 1, 110, - 3, 3, 1, 225, - 1, 2, 1, 80, - 1, 3, 1, 100, - 2, 3, 1, 110, - 1, 1, 2, 200, - 2, 2, 2, 220, - 3, 3, 2, 450, - 1, 2, 2, 160, - 1, 3, 2, 200, - 2, 3, 2, 220 -) -event %>% - gt() %>% - tab_header(title = "Event Count") - -## ----------------------------------------------------------------------------- -# Alternatively, one can manually enter paths for analysis datasets, -# example below uses an example dataset assuming currently we are at IA1. -paths <- system.file("extdata/", package = "wpgsd") - -### Generate event count table from ADSL and ADTTE datasets -# Selection criteria for each hypothesis -h_select <- tribble( - ~Hypothesis, ~Crit, - 1, "PARAMCD=='OS' & TRT01P %in% c('Xanomeline High Dose', 'Placebo')", - 2, "PARAMCD=='OS' & TRT01P %in% c('Xanomeline Low Dose', 'Placebo')" -) - -event2 <- generate_event_table(paths, h_select, - adsl_name = "adsl", adtte_name = "adtte", - key_var = "USUBJID", cnsr_var = "CNSR" -)$event - -event2 %>% - gt() %>% - tab_header(title = "Event Count - Computed from SAS Datasets Example") - -## ----------------------------------------------------------------------------- -## Generate correlation from events -corr <- generate_corr(event) - -corr %>% - as_tibble() %>% - gt() %>% - fmt_number(columns = everything(), decimals = 2) %>% - tab_header(title = "Correlation Matrix") - -## ----------------------------------------------------------------------------- -# Bonferroni bounds -bound_Bonf <- generate_bounds( - type = 0, k = 2, w = w, m = m, - corr = corr, alpha = 0.025, - sf = list(sfHSD, sfHSD, sfHSD), - sfparm = list(-4, -4, -4), - t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1)) -) - -bound_Bonf %>% - gt() %>% - fmt_number(columns = 3:5, decimals = 4) %>% - tab_header(title = "Bonferroni bounds") - -## ----------------------------------------------------------------------------- -set.seed(1234) -# WPGSD bounds, spending approach 1 -bound_WPGSD <- generate_bounds( - type = 2, k = 2, w = w, m = m, - corr = corr, alpha = 0.025, - sf = sfHSD, - sfparm = -4, - t = c(min(100 / 200, 110 / 220, 225 / 450), 1) -) - -bound_WPGSD %>% - gt() %>% - fmt_number(columns = 3:5, decimals = 4) %>% - tab_header(title = "WPGSD bounds") - -## ----echo=FALSE--------------------------------------------------------------- -# Combine and back-calculate xi -bounds <- left_join(bound_Bonf, bound_WPGSD, - by = c("Hypotheses", "Analysis"), - suffix = c(".B", ".W") -) - -bounds <- bounds %>% - rowwise() %>% - mutate(xi = sum(H1.W, H2.W, H3.W, na.rm = TRUE) / - sum(H1.B, H2.B, H3.B, na.rm = TRUE)) - -# Reorder for output -bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2) -bounds <- bounds %>% - arrange(Analysis, order) %>% - select(-order) - -# Bonferroni and WPGSD Bounds (Table 6 in the manuscript) -bounds %>% - gt() %>% - fmt_number(columns = 3:9, decimals = 4) %>% - tab_header(title = "Bonferroni and WPGSD Bounds") - -## ----------------------------------------------------------------------------- -## Observed p-values. -## The tibble must contain columns Analysis, H1, H2 etc for all hypotheses -p_obs <- tribble( - ~Analysis, ~H1, ~H2, ~H3, - 1, 0.01, 0.0004, 0.03, - 2, 0.05, 0.002, 0.015 -) - -## Closed testing ## -test_result <- closed_test(bound_WPGSD, p_obs) - -p_obs %>% - gt() %>% - fmt_number(columns = 2:4, decimals = 8, drop_trailing_zeros = TRUE) %>% - tab_header("Observed Nominal p-Values") - -## ----------------------------------------------------------------------------- -test_result %>% - gt() %>% - tab_header(title = "Closed Testing Results") - -## ----------------------------------------------------------------------------- -set.seed(1234) - -# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ex2 BH ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~# -# Transition matrix in Figure A2 -m <- matrix(c( - 0, 0.5, 0.5, - 0.5, 0, 0.5, - 0.5, 0.5, 0 -), nrow = 3, byrow = TRUE) -# Initial weights -w <- c(1 / 3, 1 / 3, 1 / 3) - -# Event count of intersection of paired hypotheses - Table 2 -event <- tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160, - 3, 3, 1, 165, - 1, 2, 1, 85, - 1, 3, 1, 85, - 2, 3, 1, 85, - 1, 1, 2, 305, - 2, 2, 2, 320, - 3, 3, 2, 335, - 1, 2, 2, 170, - 1, 3, 2, 170, - 2, 3, 2, 170 -) - -event %>% - gt() %>% - tab_header(title = "Event Count") - -## ----------------------------------------------------------------------------- -# Generate correlation from events -corr <- generate_corr(event) - -# Correlation matrix in Table 4 -corr %>% - as_tibble() %>% - gt() %>% - fmt_number(columns = everything(), decimals = 2) %>% - tab_header(title = "Correlation Matrix") - -## ----------------------------------------------------------------------------- -# WPGSD bounds, spending method 3c -bound_WPGSD <- generate_bounds( - type = 3, k = 2, w = w, m = m, corr = corr, alpha = 0.025, - sf = list(sfLDOF, sfLDOF, sfLDOF), - sfparm = list(0, 0, 0), - t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1)) -) - -# Bonferroni bounds -bound_Bonf <- generate_bounds( - type = 0, k = 2, w = w, m = m, corr = corr, alpha = 0.025, - sf = list(sfLDOF, sfLDOF, sfLDOF), - sfparm = list(0, 0, 0), - t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1)) -) - -bounds <- left_join(bound_Bonf, bound_WPGSD, - by = c("Hypotheses", "Analysis"), - suffix = c(".B", ".W") -) - -# Reorder for output -bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2) -bounds <- bounds %>% - arrange(Analysis, order) %>% - select(-order) - -# Table A6 -bounds %>% - gt() %>% - fmt_number(columns = 3:9, decimals = 4) %>% - tab_header(title = "Bonferroni and WPGSD Bounds") - diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/wpgsd.Rmd b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/wpgsd.Rmd deleted file mode 100644 index 4771094..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/wpgsd.Rmd +++ /dev/null @@ -1,591 +0,0 @@ ---- -title: "Quickstart guide" -author: "Zifang Guo, Keaven Anderson, Jing Zhao, Linda Z. Sun" -output: - rmarkdown::html_document: - toc: true - toc_depth: 3 - toc_float: true - code_folding: hide - number_sections: true - highlight: "textmate" - css: "custom.css" -bibliography: wpgsd.bib -vignette: > - %\VignetteIndexEntry{Quickstart guide} - %\VignetteEncoding{UTF-8} - %\VignetteEngine{knitr::rmarkdown} -editor_options: - markdown: - wrap: 72 ---- - -```{r, include = FALSE} -knitr::opts_chunk$set( - collapse = TRUE, - comment = "#>", - error = TRUE, - fig.align = "center" -) -``` - -```{r, message=FALSE, warning=FALSE} -library(wpgsd) -library(gsDesign) -library(gMCPLite) -library(haven) -library(dplyr) -library(tidyr) -library(reshape2) -library(gt) -``` - -# Background - -The weighted parametric group sequential design (WPGSD) (@anderson2022unified) approach allows one to take advantage of the known correlation structure in constructing efficacy bounds to control family-wise error rate (FWER) for a group sequential design. Here correlation may be due to common observations in nested populations, due to common observations in overlapping populations, or due to common observations in the control arm. This document illustrates the use of the R package wpgsd to implement this approach. - -# Methods and Examples - -## Closed Testing and Parametric Tests - -We aim to control the familywise error rate (FWER) at level $\alpha$. Let $J \subseteq I$. The intersection hypothesis $H_J$ assumes the null hypothesis for all individual hypotheses $H_i$ with $i \in J$. Closed testing principle is as follows: if for all sets $J \subseteq I$ with $j \in J$, $H_J$ can be rejected at level $\alpha$, then $H_j$ can be rejected. Weighted parametric tests can be used for this: @bretz2011graphical, @xi2017unified for fixed designs or @maurer2013multiple for group sequential. - -## Consonance - -A closed procedure is called consonant if the rejection of the complete intersection null hypothesis $H_I$ further implies that at least one elementary hypothesis $H_i, i \in I$, is rejected. Consonance is a desirable property leading to short-cut procedures that give the same rejection decisions as the original closed procedure but with fewer operations. For WPGSD, consonance does not always hold and in general the closed-testing procedure is required. - -## Group Sequential Design Notations and Assumptions - -- A set $I$ of hypotheses for $i \in I$. -- $K$ group sequential analyses, $k = 1, \ldots, K$ -- Single endpoint - * Not required, and can be generalized -- Assume tests $Z_{ik}$, $i \in I$, $1 \leq k \leq K$ where a large $Z_{ik}$ is used to reject $H_i$ - -## Correlation Structure - -- Notation - * Events for individual hypothesis $H_i$,$i \in I$ at analysis k denoted by $n_{ik}$. - * Assume the same endpoint for all hypotheses (can be relaxed) - * For binary or continuous outcomes $n_{ik}$ represents sample size - * $Z_{ik}$ is standardized normal test for treatment effect for individual hypothesis $H_i$ at analysis $k$ - * Denote $n_{i\wedge i^\prime,k\wedge k^\prime}$ as the number of observations (or events) included in both $Z_{ik}$ and $Z_{i^\prime k^\prime}$, $i\in I$, $1\le k\le K$. -- Key result - $$ \hbox{Corr}(Z_{ik}, Z_{i^\prime k^\prime }) = \frac{n_{i\wedge i^\prime ,k\wedge k^\prime }}{\sqrt{n_{ik}n_{i^\prime k^\prime }}} $$ -- Proof builds on standard group sequential theory (@chen2021multiplicity) - -## Example 1: Overlapping Populations, Two Analyses - -Following illustrates the first example, which has overlapping populations (e.g. due to biomarker) and is also example 1 in @anderson2022unified. - -```{r, eval=FALSE, echo=FALSE} -library(ggplot2) -library(ggforce) - -ellipse_data <- data.frame( - id = c("H1: Population 1", "H2: Population 2", "H3: Overall Population"), - x = c(0, 1, 0.5), - y = c(0, 0, 0), - a = c(1, 1, 2), - b = c(0.5, 0.5, 1) -) - -ragg::agg_png( - "vignettes/figures/ex1-pop.png", - width = 1920, - height = 1920 / 1.618, - res = 96, - scaling = 2 -) -ggplot() + - geom_ellipse( - aes( - x0 = x, y0 = y, a = a, b = b, angle = 0, fill = id - ), - data = ellipse_data[ellipse_data$id == "H3: Overall Population", ], - color = NA, alpha = 0.5, show.legend = FALSE - ) + - geom_ellipse( - aes( - x0 = x, y0 = y, a = a, b = b, angle = 0, fill = id - ), - data = ellipse_data[ellipse_data$id != "H3: Overall Population", ], - color = NA, alpha = 0.85, show.legend = FALSE - ) + - geom_text(aes( - x = x, y = y, label = id, - hjust = ifelse(id == "H1: Population 1", 1.1, - ifelse(id == "H2: Population 2", -0.1, 0.5) - ), - vjust = ifelse(id == "H3: Overall Population", -9, 0.5) - ), data = ellipse_data, size = 6) + - scale_fill_manual(values = c("#E69F00", "#56B4E9", "#999999"), guide = "none") + - coord_fixed() + - theme_void() -dev.off() -``` - -```{r, echo=FALSE, out.width="90%", fig.cap="Ex1: Populations"} -knitr::include_graphics("figures/ex1-pop.png") -``` - -The multiplicity strategy is defined as follows. - -```{r, out.width="80%"} -# Transition matrix -m <- matrix(c( - 0, 0, 1, - 0, 0, 1, - 0.5, 0.5, 0 -), nrow = 3, byrow = TRUE) -# Weight matrix -w <- c(0.3, 0.3, 0.4) - -# Multiplicity graph -cbPalette <- c("#999999", "#E69F00", "#56B4E9") - -nameHypotheses <- c( - "H1: Population 1", - "H2: Population 2", - "H3: Overall Population" -) - -hplot <- hGraph(3, - alphaHypotheses = w, - m = m, - nameHypotheses = nameHypotheses, - trhw = .2, trhh = .1, - digits = 5, trdigits = 3, size = 5, halfWid = 1, - halfHgt = 0.5, offset = 0.2, trprop = 0.4, - fill = as.factor(c(2, 3, 1)), - palette = cbPalette, - wchar = "w" -) -hplot -``` - -The event count of each hypothesis at each analysis is shown below. - -| Population | Number of Events at IA | Number of Events at FA | -|:---------------------:|:----------------------:|:----------------------:| -| Population 1 | 100 | 200 | -| Population 2 | 110 | 220 | -| Population 1 $\cap$ 2 | 80 | 160 | -| Overall Population | 225 | 450 | - -Table: Number of events at each analysis for each population in Example 1. -IA: interim analysis. FA: final analysis. - -The correlation matrix among test statistics is as follows. - -| $i,k$ | 1,1 | 2,1 | 3,1 | 1,2 | 2,2 | 3,2 | -|:---:|:---:|:---:|:---:|:---:|:---:|:---:| -| 1,1 | 1 | $\frac{80}{\sqrt{100\cdot 110}}$ | $\frac{100}{\sqrt{100 \cdot 225}}$ | $\frac{100}{\sqrt{100\cdot 200}}$ | $\frac{80}{\sqrt{100\cdot 220}}$ | $\frac{100}{\sqrt{100 \cdot 450}}$ | -| 2,1 | 0.76 | 1 | $\frac{110}{\sqrt{110 \cdot 225}}$ | $\frac{80}{\sqrt{110\cdot 200}}$ | $\frac{110}{\sqrt{110\cdot 220}}$ | $\frac{110}{\sqrt{110 \cdot 450}}$ | -| 3,1 | 0.67 | 0.70 | 1 | $\frac{100}{\sqrt{225 \cdot 200}}$ | $\frac{110}{\sqrt{225 \cdot 220}}$ | $\frac{225}{\sqrt{225 \cdot 450}}$ | -| 1,2 | 0.71 | 0.54 | 0.47 | 1 | $\frac{160}{\sqrt{200 \cdot 220}}$ | $\frac{200}{\sqrt{200 \cdot 450}}$ | -| 2,2 | 0.54 | 0.71 | 0.49 | 0.76 | 1 | $\frac{220}{\sqrt{220 \cdot 450}}$ | -| 3,2 | 0.47 | 0.49 | 0.71 | 0.67 | 0.70 | 1 | - -Table: Correlation Matrix of Test Statistics for Example 1. -Identical numeric values (lower triangular) and formulas (upper triangular) shown. - -## Example 2: Common Control, Two Analyses - -Following illustrates the second example in which correlation comes from common control arm. This is also example 2 in @anderson2022unified. - -```{r, out.width="80%", echo = FALSE} -cbPalette <- c( - "#999999", "#E69F00", "#56B4E9", "#009E73", - "#F0E442", "#0072B2", "#D55E00", "#CC79A7" -) -nameHypotheses <- c( - "H1: Experimental 1 vs Control", - "H2: Experimental 2 vs Control", - "H3: Experimental 3 vs Control" -) -m <- matrix(c( - 0, 0.5, 0.5, - 0.5, 0, 0.5, - 0.5, 0.5, 0 -), nrow = 3, byrow = TRUE) -alphaHypotheses <- c(1 / 3, 1 / 3, 1 / 3) - -hplot <- hGraph(3, - alphaHypotheses = alphaHypotheses, m = m, - nameHypotheses = nameHypotheses, trhw = .2, trhh = .1, - digits = 3, trdigits = 4, size = 5, halfWid = 1.2, halfHgt = 0.5, - offset = 0.2, trprop = 0.35, - fill = as.factor(c(2, 3, 1)), - palette = cbPalette[1:3], - wchar = "w" -) -hplot -``` - -| Treatment Arm | Number of Events at IA | Number of Events at FA | -|:--------------:|:----------------------:|:----------------------:| -| Experimental 1 | 70 | 135 | -| Experimental 2 | 75 | 150 | -| Experimental 3 | 80 | 165 | -| Control | 85 | 170 | - -Table: Number of events at each analysis for each treatment arm in Example 2. -IA: interim analysis. FA: final analysis. - -| $i,k$ | 1,1 | 2,1 | 3,1 | 1,2 | 2,2 | 3,2 | -|:---:|:---:|:---:|:---:|:---:|:---:|:---:| -| 1,1 | 1 | $\frac{85}{\sqrt{155\cdot 160}}$ | $\frac{85}{\sqrt{155 \cdot 165}}$ | $\frac{155}{\sqrt{155\cdot 305}}$ | $\frac{85}{\sqrt{155\cdot 320}}$ | $\frac{85}{\sqrt{155 \cdot 335}}$ | -| 2,1 | 0.54 | 1 | $\frac{85}{\sqrt{160 \cdot 165}}$ | $\frac{85}{\sqrt{160 \cdot 305}}$ | $\frac{160}{\sqrt{160\cdot 320}}$ | $\frac{85}{\sqrt{160 \cdot 335}}$ | -| 3,1 | 0.53 | 0.52 | 1 | $\frac{85}{\sqrt{165 \cdot 305}}$ | $\frac{85}{\sqrt{165\cdot 320}}$ | $\frac{165}{\sqrt{165 \cdot 335}}$ | -| 1,2 | 0.71 | 0.38 | 0.38 | 1 | $\frac{170}{\sqrt{305\cdot 320}}$ | $\frac{170}{\sqrt{305 \cdot 335}}$ | -| 2,2 | 0.38 | 0.71 | 0.37 | 0.54 | 1 | $\frac{170}{\sqrt{320 \cdot 335}}$ | -| 3,2 | 0.37 | 0.37 | 0.70 | 0.53 | 0.52 | 1 | - -Table: Correlation Matrix for Example 2. -Identical numeric values (lower triangular) and formulas (upper triangular) shown. - -## Hypotheses Set - -These 2 examples each has 7 intersection hypotheses and the corresponding weighting strategies are illustrated below. - -| $H_J$ | $w_1(J)$ | $w_2(J)$ | $w_3(J)$ | -|:-----------------------:|:--------:|:--------:|:--------:| -| $H_1 \cap H_2 \cap H_3$ | 0.3 | 0.3 | 0.4 | -| $H_1 \cap H_2$ | 0.5 | 0.5 | - | -| $H_1 \cap H_3$ | 0.3 | - | 0.7 | -| $H_2 \cap H_3$ | - | 0.3 | 0.7 | -| $H_1$ | 1 | - | - | -| $H_2$ | - | 1 | - | -| $H_3$ | - | - | 1 | - -Table: Weighting strategy of Example 1. - -| $H_J$ | $w_1(J)$ | $w_2(J)$ | $w_3(J)$ | -|:-----------------------:|:--------:|:--------:|:--------:| -| $H_1 \cap H_2 \cap H_3$ | 1/3 | 1/3 | 1/3 | -| $H_1 \cap H_2$ | 1/2 | 1/2 | - | -| $H_1 \cap H_3$ | 1/2 | - | 1/2 | -| $H_2 \cap H_3$ | - | 1/2 | 1/2 | -| $H_1$ | 1 | - | - | -| $H_2$ | - | 1 | - | -| $H_3$ | - | - | 1 | - -Table: Weighting strategy of Example 2. - -## $\alpha$ Spending: 3 approaches - -The WPGSD approach uses all known correlations between tests in the study. This relaxes bounds and allows increased power or smaller sample size. Three spending approaches have been proposed: - -- Fixed spending (Fleming-Harrington-O'Brien (FHO) approach). Specify $0 < \alpha_1(J) < \alpha_2(J) < \ldots < \alpha_K(J) = \alpha(J) \leq \alpha$ for all $J\subseteq I$, where $\alpha(J)$ is the total alpha for intersection hypothesis $H_J$ according to the graphical approach. - -- $\alpha$-spending approach 1. We choose a spending function family $f(t,\alpha)$ and set $\alpha_k(J)=f(t_k(J),\alpha(J))$ for $1\le k\le K$ for all intersection hypotheses $J\subseteq I$. - -- $\alpha$-spending approach 2. For each elementary hypothesis $i$ ($i$ = 1, 2, \ldots, $m$), specify the $\alpha$-spending function family $f_i(t,\gamma)$ where $\gamma$ is the $\alpha$ level for the hypothesis and $f_i(t_{ik},\gamma)$ determines how much $\alpha$ to spend up to analysis $k$ for hypothesis $i$ when level $\gamma$ is allocated to the hypothesis. Then $\alpha_k(J) = \sum_{i \in J} f_i(t_{ik}, w_i(J)\alpha)$. - -## Bounds Computation: Parametric Test, Fixed Design (For Example, Two Populations, One Analysis) - -- Assume ($Z_1,Z_2$) bivariate normal with known correlation - -- Find $\alpha$-inflation factor $c_J$ such that - $$ \alpha = P[\cup_{i \in J} \{p_i \leq c_Jw_{J,i}\alpha \}] = P[\cup_{i \in J} \{Z_i \geq \Phi^{-1}(1-c_Jw_{J,i}\alpha \}]$$ - -- Basic algorithm code in @bretz2011graphical - -### Bounds Computation: WPGSD - Fixed spending and $\alpha$ spending approach 1 {.smaller} - -- Assume for $j < k$ that bounds $c_{ij} (J), i \in J, j < k$, have already been set and remain unchanged. - -- At analysis $k$, compute the correlation matrix of $Z_{ij}$, $i \in J$, $j = 1, \ldots, k$. - - i Initialize $\alpha_{k}^{*}(J) = \alpha_{k}(J) - \alpha_{k-1}(J)$. - - ii Set $b_{ik} = \Phi^{-1}(1 - w_{i}(J)\alpha_{k}^{*} (J))$, $i\in J$. - - iii Compute type I error rate up to analysis $k$ - $$ 1 - Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} \cap_{i \in J, j < k} \{ Z_{ij} < c_{ij}(J) \} ). $$ - - iv Update $\alpha_{k}^{*}(J)$ using root-finding with steps ii - iii until the type I error rate through analysis $k$ is controlled at $\alpha_{k}(J)$ for $H_J$. That is, - $$ 1 - Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} \cap_{i \in J, j < k} \{ Z_{ij} < c_{ij}(J) \} ) = \alpha_{k}. $$ - - v Set $c_{ik}(J) = b_{ik}$ from the previous step. The corresponding nominal $p$-value boundary is $p_{ik}(J)= 1-\Phi(c_{ik}(J)) = w_i(J)\alpha_k^*(J)$. - -- Note: interim bound does not depend on future analyses. Solution only requires root finding for a single $\alpha_{k}^{*}(J)$ at a time, $k = 1, \ldots, K$. Requires multivariate normal computation from mvtnorm R package Genz et al. (2020). - -### Bounds Computation: WPGSD - $\alpha$ spending approach 2 {.smaller} - -- Assume for $j < k$ that bounds $c_{ij} (J), i \in J, j < k$, have already been set and remain unchanged. - -- At analysis $k$, compute the correlation matrix of $Z_{ij}$, $i \in J$, $j = 1, \ldots, k$. - - i Determine what the nominal $p$-value boundary would be for each elementary hypothesis in $J$ for a weighted Bonferroni test in a group sequential design as described in @maurer2013multiple. Let these nominal $p$-value boundaries be $\alpha^\prime_{ik}(J)$. - - ii Choose an inflation factor $\xi_{k}(J) > 1$ and set $$b_{ik} = \Phi^{-1}(1 - \xi_k(J) \alpha^\prime_{ik}(J)).$$ - - iii Update $\xi_k(J)$ until this type I error rate up to analysis $k$ is controlled at $\alpha_{k}(J)$ for $H_J$. That is, - $$ 1 - Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} \cap_{i \in J, j < k} \{ Z_{ij} < c_{ij}(J) \} ) = \alpha_{k}(J).$$ - - iv After the appropriate $\xi_k(J)$ has been derived, the nominal $p$-value boundaries are $p_{ik}(J)=\xi_k(J) \alpha^\prime_{ik}(J)$, and $b_{ik}$ is computed as in step ii, we set $c_{ik}(J) = b_{ik}$. - -- Note: interim bound does not depend on future analyses. Solution only requires root finding for a single $\xi_k(J)$ at a time, $k = 1, \ldots, K$. Requires multivariate normal computation from the mvtnorm R package Genz et al. (2020). - -## Implementation of Example 1 with Overlapping Populations - -We first define the transition matrix and weights as shown above in Section 2.5. Next we set up the event count table as follows: - -- Analysis: Analysis number (1 for interim, 2 for final). -- Event: Event counts. -- H1, H2: Hypotheses intersected. - * (1, 1) represents counts for hypothesis 1 - * (1, 2) for counts for the intersection of hypotheses 1 and 2 - -```{r} -event <- tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 100, - 2, 2, 1, 110, - 3, 3, 1, 225, - 1, 2, 1, 80, - 1, 3, 1, 100, - 2, 3, 1, 110, - 1, 1, 2, 200, - 2, 2, 2, 220, - 3, 3, 2, 450, - 1, 2, 2, 160, - 1, 3, 2, 200, - 2, 3, 2, 220 -) -event %>% - gt() %>% - tab_header(title = "Event Count") -``` - -```{r} -# Alternatively, one can manually enter paths for analysis datasets, -# example below uses an example dataset assuming currently we are at IA1. -paths <- system.file("extdata/", package = "wpgsd") - -### Generate event count table from ADSL and ADTTE datasets -# Selection criteria for each hypothesis -h_select <- tribble( - ~Hypothesis, ~Crit, - 1, "PARAMCD=='OS' & TRT01P %in% c('Xanomeline High Dose', 'Placebo')", - 2, "PARAMCD=='OS' & TRT01P %in% c('Xanomeline Low Dose', 'Placebo')" -) - -event2 <- generate_event_table(paths, h_select, - adsl_name = "adsl", adtte_name = "adtte", - key_var = "USUBJID", cnsr_var = "CNSR" -)$event - -event2 %>% - gt() %>% - tab_header(title = "Event Count - Computed from SAS Datasets Example") -``` - -Then we compute correlation matrix using the event count table and `generate_corr()`. We see that the correlations not accounted for by the Bonferroni approach are substantial and, thus, might expect a non-trivial impact on bounds for hypothesis tests. - -```{r} -## Generate correlation from events -corr <- generate_corr(event) - -corr %>% - as_tibble() %>% - gt() %>% - fmt_number(columns = everything(), decimals = 2) %>% - tab_header(title = "Correlation Matrix") -``` - -Bonferroni and WPGSD bounds can then be computed via `generate_bounds()`. In this example, we useHSD(-4) as $\alpha$-spending for all hypotheses. Of note, `generate_bounds()` input type specifies boundary type. - -- 0 = Bonferroni. Separate alpha spending for each hypotheses. -- 1 = Fixed alpha spending for all hypotheses. Method 3a in the manuscript. -- 2 = Overall alpha spending for all hypotheses. Method 3b in the manuscript. -- 3 = Separate alpha spending for each hypotheses. Method 3c in the manuscript. - -Compute Bonferroni bounds. - -```{r} -# Bonferroni bounds -bound_Bonf <- generate_bounds( - type = 0, k = 2, w = w, m = m, - corr = corr, alpha = 0.025, - sf = list(sfHSD, sfHSD, sfHSD), - sfparm = list(-4, -4, -4), - t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1)) -) - -bound_Bonf %>% - gt() %>% - fmt_number(columns = 3:5, decimals = 4) %>% - tab_header(title = "Bonferroni bounds") -``` - -Compute WPGSD Bounds using $\alpha$-spending approach 1 with HSD(-4) spending. Here spending time was defined as minimum of the 3 observed information fractions. - -```{r} -set.seed(1234) -# WPGSD bounds, spending approach 1 -bound_WPGSD <- generate_bounds( - type = 2, k = 2, w = w, m = m, - corr = corr, alpha = 0.025, - sf = sfHSD, - sfparm = -4, - t = c(min(100 / 200, 110 / 220, 225 / 450), 1) -) - -bound_WPGSD %>% - gt() %>% - fmt_number(columns = 3:5, decimals = 4) %>% - tab_header(title = "WPGSD bounds") -``` - -Below shows the comparison between the Bonferroni and WPGSD bounds. Nominal level at final analysis by using the WPGSD method increased by up to 1.3× over those obtained via the Bonferroni approach. - -```{r, echo=FALSE} -# Combine and back-calculate xi -bounds <- left_join(bound_Bonf, bound_WPGSD, - by = c("Hypotheses", "Analysis"), - suffix = c(".B", ".W") -) - -bounds <- bounds %>% - rowwise() %>% - mutate(xi = sum(H1.W, H2.W, H3.W, na.rm = TRUE) / - sum(H1.B, H2.B, H3.B, na.rm = TRUE)) - -# Reorder for output -bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2) -bounds <- bounds %>% - arrange(Analysis, order) %>% - select(-order) - -# Bonferroni and WPGSD Bounds (Table 6 in the manuscript) -bounds %>% - gt() %>% - fmt_number(columns = 3:9, decimals = 4) %>% - tab_header(title = "Bonferroni and WPGSD Bounds") -``` - -Closed testing procedure can then be performed using `closed_test()`. - -```{r} -## Observed p-values. -## The tibble must contain columns Analysis, H1, H2 etc for all hypotheses -p_obs <- tribble( - ~Analysis, ~H1, ~H2, ~H3, - 1, 0.01, 0.0004, 0.03, - 2, 0.05, 0.002, 0.015 -) - -## Closed testing ## -test_result <- closed_test(bound_WPGSD, p_obs) - -p_obs %>% - gt() %>% - fmt_number(columns = 2:4, decimals = 8, drop_trailing_zeros = TRUE) %>% - tab_header("Observed Nominal p-Values") -``` - -```{r} -test_result %>% - gt() %>% - tab_header(title = "Closed Testing Results") -``` - -## Implementation of Example 2 with Common Control - -Similarly, codes below reproduce the result of Example 2 of @anderson2022unified, which uses spending method 3c specified in the paper. - -```{r} -set.seed(1234) - -# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ex2 BH ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~# -# Transition matrix in Figure A2 -m <- matrix(c( - 0, 0.5, 0.5, - 0.5, 0, 0.5, - 0.5, 0.5, 0 -), nrow = 3, byrow = TRUE) -# Initial weights -w <- c(1 / 3, 1 / 3, 1 / 3) - -# Event count of intersection of paired hypotheses - Table 2 -event <- tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160, - 3, 3, 1, 165, - 1, 2, 1, 85, - 1, 3, 1, 85, - 2, 3, 1, 85, - 1, 1, 2, 305, - 2, 2, 2, 320, - 3, 3, 2, 335, - 1, 2, 2, 170, - 1, 3, 2, 170, - 2, 3, 2, 170 -) - -event %>% - gt() %>% - tab_header(title = "Event Count") -``` - -```{r} -# Generate correlation from events -corr <- generate_corr(event) - -# Correlation matrix in Table 4 -corr %>% - as_tibble() %>% - gt() %>% - fmt_number(columns = everything(), decimals = 2) %>% - tab_header(title = "Correlation Matrix") -``` - -```{r} -# WPGSD bounds, spending method 3c -bound_WPGSD <- generate_bounds( - type = 3, k = 2, w = w, m = m, corr = corr, alpha = 0.025, - sf = list(sfLDOF, sfLDOF, sfLDOF), - sfparm = list(0, 0, 0), - t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1)) -) - -# Bonferroni bounds -bound_Bonf <- generate_bounds( - type = 0, k = 2, w = w, m = m, corr = corr, alpha = 0.025, - sf = list(sfLDOF, sfLDOF, sfLDOF), - sfparm = list(0, 0, 0), - t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1)) -) - -bounds <- left_join(bound_Bonf, bound_WPGSD, - by = c("Hypotheses", "Analysis"), - suffix = c(".B", ".W") -) - -# Reorder for output -bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2) -bounds <- bounds %>% - arrange(Analysis, order) %>% - select(-order) - -# Table A6 -bounds %>% - gt() %>% - fmt_number(columns = 3:9, decimals = 4) %>% - tab_header(title = "Bonferroni and WPGSD Bounds") -``` - -## Power Considerations - -The above illustrates the use of the WPGSD approach to compute bounds at the analysis stage. At the design stage, one can take one of the following 2 options: 1) The trial can be first designed as if the testing would be done with a weighted Bonferroni with conservative sample size estimate. At the analysis stage, the correlation can be taken into consideration with the WPGSD approach for bound calculation; or 2) To adjust the sample size downward using the WPGSD approach at the design stage, one can power the study by taking the minimum $p$-value bound for a given individual hypothesis from the WPGSD table (with assumed correlation structure). For example, for $H_2$ of example 1, this is $\hbox{min}(0.0011,0.0017,0.0010,0.0030)=0.0010$ for $k=1$ and $\hbox{min}(0.0092,0.0144,0.0081,0.0238)=0.0081$ for $k=2$. Then the $H_2$ bounds of 0.0010 ($k=1$) and 0.0081 ($k=2$) can be used to power $H_2$. R function for the 2nd option is in development. - -# Conclusions - -The WPGSD approach provides an unification of previous work on parametric testing in group sequential design. It enabled more complex scenarios and requires attention to consonance and intersection hypotheses. Although detailed closed testing is required, this should not be a deterrent. The approach accommodates various spending approaches and provides more relaxed bounds -and improved power compared to the Bonferroni approach. - -# References diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/wpgsd.html b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/wpgsd.html deleted file mode 100644 index 7d0095d..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/wpgsd.html +++ /dev/null @@ -1,7846 +0,0 @@ - - - - - - - - - - - - - - -Quickstart guide - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- - - -
-
-
-
-
- -
- - - - - - - -
library(wpgsd)
-library(gsDesign)
-library(gMCPLite)
-library(haven)
-library(dplyr)
-library(tidyr)
-library(reshape2)
-library(gt)
-
-

1 Background

-

The weighted parametric group sequential design (WPGSD) (Anderson et al. (2022)) approach allows one to -take advantage of the known correlation structure in constructing -efficacy bounds to control family-wise error rate (FWER) for a group -sequential design. Here correlation may be due to common observations in -nested populations, due to common observations in overlapping -populations, or due to common observations in the control arm. This -document illustrates the use of the R package wpgsd to implement this -approach.

-
-
-

2 Methods and -Examples

-
-

2.1 Closed Testing and -Parametric Tests

-

We aim to control the familywise error rate (FWER) at level \(\alpha\). Let \(J -\subseteq I\). The intersection hypothesis \(H_J\) assumes the null hypothesis for all -individual hypotheses \(H_i\) with -\(i \in J\). Closed testing principle -is as follows: if for all sets \(J \subseteq -I\) with \(j \in J\), \(H_J\) can be rejected at level \(\alpha\), then \(H_j\) can be rejected. Weighted parametric -tests can be used for this: Bretz et al. -(2011), Xi et al. (2017) for fixed -designs or Maurer and Bretz (2013) for -group sequential.

-
-
-

2.2 Consonance

-

A closed procedure is called consonant if the rejection of the -complete intersection null hypothesis \(H_I\) further implies that at least one -elementary hypothesis \(H_i, i \in I\), -is rejected. Consonance is a desirable property leading to short-cut -procedures that give the same rejection decisions as the original closed -procedure but with fewer operations. For WPGSD, consonance does not -always hold and in general the closed-testing procedure is required.

-
-
-

2.3 Group Sequential -Design Notations and Assumptions

-
    -
  • A set \(I\) of hypotheses for \(i \in I\).
  • -
  • \(K\) group sequential analyses, -\(k = 1, \ldots, K\)
  • -
  • Single endpoint -
      -
    • Not required, and can be generalized
    • -
  • -
  • Assume tests \(Z_{ik}\), \(i \in I\), \(1 -\leq k \leq K\) where a large \(Z_{ik}\) is used to reject \(H_i\)
  • -
-
-
-

2.4 Correlation -Structure

-
    -
  • Notation -
      -
    • Events for individual hypothesis \(H_i\),\(i \in -I\) at analysis k denoted by \(n_{ik}\).
    • -
    • Assume the same endpoint for all hypotheses (can be relaxed)
    • -
    • For binary or continuous outcomes \(n_{ik}\) represents sample size
    • -
    • \(Z_{ik}\) is standardized normal -test for treatment effect for individual hypothesis \(H_i\) at analysis \(k\)
    • -
    • Denote \(n_{i\wedge i^\prime,k\wedge -k^\prime}\) as the number of observations (or events) included in -both \(Z_{ik}\) and \(Z_{i^\prime k^\prime}\), \(i\in I\), \(1\le -k\le K\).
    • -
  • -
  • Key result \[ \hbox{Corr}(Z_{ik}, -Z_{i^\prime k^\prime }) = \frac{n_{i\wedge i^\prime ,k\wedge k^\prime -}}{\sqrt{n_{ik}n_{i^\prime k^\prime }}} \]
  • -
  • Proof builds on standard group sequential theory (Chen et al. (2021))
  • -
-
-
-

2.5 Example 1: -Overlapping Populations, Two Analyses

-

Following illustrates the first example, which has overlapping -populations (e.g. due to biomarker) and is also example 1 in Anderson et al. (2022).

-
-Ex1: Populations -

-Ex1: Populations -

-
-

The multiplicity strategy is defined as follows.

-
# Transition matrix
-m <- matrix(c(
-  0, 0, 1,
-  0, 0, 1,
-  0.5, 0.5, 0
-), nrow = 3, byrow = TRUE)
-# Weight matrix
-w <- c(0.3, 0.3, 0.4)
-
-# Multiplicity graph
-cbPalette <- c("#999999", "#E69F00", "#56B4E9")
-
-nameHypotheses <- c(
-  "H1: Population 1",
-  "H2: Population 2",
-  "H3: Overall Population"
-)
-
-hplot <- hGraph(3,
-  alphaHypotheses = w,
-  m = m,
-  nameHypotheses = nameHypotheses,
-  trhw = .2, trhh = .1,
-  digits = 5, trdigits = 3, size = 5, halfWid = 1,
-  halfHgt = 0.5, offset = 0.2, trprop = 0.4,
-  fill = as.factor(c(2, 3, 1)),
-  palette = cbPalette,
-  wchar = "w"
-)
-hplot
-

-

The event count of each hypothesis at each analysis is shown -below.

- - ----- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Number of events at each analysis for each population in -Example 1. IA: interim analysis. FA: final analysis.
PopulationNumber of Events at IANumber of Events at FA
Population 1100200
Population 2110220
Population 1 \(\cap\) 280160
Overall Population225450
-

The correlation matrix among test statistics is as follows.

- - --------- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Correlation Matrix of Test Statistics for Example 1. Identical -numeric values (lower triangular) and formulas (upper triangular) -shown.
\(i,k\)1,12,13,11,22,23,2
1,11\(\frac{80}{\sqrt{100\cdot -110}}\)\(\frac{100}{\sqrt{100 -\cdot 225}}\)\(\frac{100}{\sqrt{100\cdot -200}}\)\(\frac{80}{\sqrt{100\cdot -220}}\)\(\frac{100}{\sqrt{100 -\cdot 450}}\)
2,10.761\(\frac{110}{\sqrt{110 -\cdot 225}}\)\(\frac{80}{\sqrt{110\cdot -200}}\)\(\frac{110}{\sqrt{110\cdot -220}}\)\(\frac{110}{\sqrt{110 -\cdot 450}}\)
3,10.670.701\(\frac{100}{\sqrt{225 -\cdot 200}}\)\(\frac{110}{\sqrt{225 -\cdot 220}}\)\(\frac{225}{\sqrt{225 -\cdot 450}}\)
1,20.710.540.471\(\frac{160}{\sqrt{200 -\cdot 220}}\)\(\frac{200}{\sqrt{200 -\cdot 450}}\)
2,20.540.710.490.761\(\frac{220}{\sqrt{220 -\cdot 450}}\)
3,20.470.490.710.670.701
-
-
-

2.6 Example 2: Common -Control, Two Analyses

-

Following illustrates the second example in which correlation comes -from common control arm. This is also example 2 in Anderson et al. (2022).

-

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Number of events at each analysis for each treatment arm in -Example 2. IA: interim analysis. FA: final analysis.
Treatment ArmNumber of Events at IANumber of Events at FA
Experimental 170135
Experimental 275150
Experimental 380165
Control85170
- - --------- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Correlation Matrix for Example 2. Identical numeric values -(lower triangular) and formulas (upper triangular) shown.
\(i,k\)1,12,13,11,22,23,2
1,11\(\frac{85}{\sqrt{155\cdot -160}}\)\(\frac{85}{\sqrt{155 \cdot -165}}\)\(\frac{155}{\sqrt{155\cdot -305}}\)\(\frac{85}{\sqrt{155\cdot -320}}\)\(\frac{85}{\sqrt{155 \cdot -335}}\)
2,10.541\(\frac{85}{\sqrt{160 \cdot -165}}\)\(\frac{85}{\sqrt{160 \cdot -305}}\)\(\frac{160}{\sqrt{160\cdot -320}}\)\(\frac{85}{\sqrt{160 \cdot -335}}\)
3,10.530.521\(\frac{85}{\sqrt{165 \cdot -305}}\)\(\frac{85}{\sqrt{165\cdot -320}}\)\(\frac{165}{\sqrt{165 -\cdot 335}}\)
1,20.710.380.381\(\frac{170}{\sqrt{305\cdot -320}}\)\(\frac{170}{\sqrt{305 -\cdot 335}}\)
2,20.380.710.370.541\(\frac{170}{\sqrt{320 -\cdot 335}}\)
3,20.370.370.700.530.521
-
-
-

2.7 Hypotheses Set

-

These 2 examples each has 7 intersection hypotheses and the -corresponding weighting strategies are illustrated below.

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Weighting strategy of Example 1.
\(H_J\)\(w_1(J)\)\(w_2(J)\)\(w_3(J)\)
\(H_1 \cap H_2 \cap -H_3\)0.30.30.4
\(H_1 \cap -H_2\)0.50.5-
\(H_1 \cap -H_3\)0.3-0.7
\(H_2 \cap -H_3\)-0.30.7
\(H_1\)1--
\(H_2\)-1-
\(H_3\)--1
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Weighting strategy of Example 2.
\(H_J\)\(w_1(J)\)\(w_2(J)\)\(w_3(J)\)
\(H_1 \cap H_2 \cap -H_3\)1/31/31/3
\(H_1 \cap -H_2\)1/21/2-
\(H_1 \cap -H_3\)1/2-1/2
\(H_2 \cap -H_3\)-1/21/2
\(H_1\)1--
\(H_2\)-1-
\(H_3\)--1
-
-
-

2.8 \(\alpha\) Spending: 3 approaches

-

The WPGSD approach uses all known correlations between tests in the -study. This relaxes bounds and allows increased power or smaller sample -size. Three spending approaches have been proposed:

-
    -
  • Fixed spending (Fleming-Harrington-O’Brien (FHO) approach). -Specify \(0 < \alpha_1(J) < \alpha_2(J) -< \ldots < \alpha_K(J) = \alpha(J) \leq \alpha\) for all -\(J\subseteq I\), where \(\alpha(J)\) is the total alpha for -intersection hypothesis \(H_J\) -according to the graphical approach.

  • -
  • \(\alpha\)-spending approach 1. -We choose a spending function family \(f(t,\alpha)\) and set \(\alpha_k(J)=f(t_k(J),\alpha(J))\) for \(1\le k\le K\) for all intersection -hypotheses \(J\subseteq I\).

  • -
  • \(\alpha\)-spending approach 2. -For each elementary hypothesis \(i\) -(\(i\) = 1, 2, , \(m\)), specify the \(\alpha\)-spending function family \(f_i(t,\gamma)\) where \(\gamma\) is the \(\alpha\) level for the hypothesis and \(f_i(t_{ik},\gamma)\) determines how much -\(\alpha\) to spend up to analysis -\(k\) for hypothesis \(i\) when level \(\gamma\) is allocated to the hypothesis. -Then \(\alpha_k(J) = \sum_{i \in J} -f_i(t_{ik}, w_i(J)\alpha)\).

  • -
-
-
-

2.9 Bounds Computation: -Parametric Test, Fixed Design (For Example, Two Populations, One -Analysis)

-
    -
  • Assume (\(Z_1,Z_2\)) bivariate -normal with known correlation

  • -
  • Find \(\alpha\)-inflation factor -\(c_J\) such that \[ \alpha = P[\cup_{i \in J} \{p_i \leq -c_Jw_{J,i}\alpha \}] = P[\cup_{i \in J} \{Z_i \geq -\Phi^{-1}(1-c_Jw_{J,i}\alpha \}]\]

  • -
  • Basic algorithm code in Bretz et al. -(2011)

  • -
-
-

2.9.1 -Bounds Computation: WPGSD - Fixed spending and \(\alpha\) spending approach 1

-
    -
  • Assume for \(j < k\) that -bounds \(c_{ij} (J), i \in J, j < -k\), have already been set and remain unchanged.

  • -
  • At analysis \(k\), compute the -correlation matrix of \(Z_{ij}\), \(i \in J\), \(j = -1, \ldots, k\).

    -

    i Initialize \(\alpha_{k}^{*}(J) = -\alpha_{k}(J) - \alpha_{k-1}(J)\).

    -

    ii Set \(b_{ik} = \Phi^{-1}(1 - -w_{i}(J)\alpha_{k}^{*} (J))\), \(i\in -J\).

    -

    iii Compute type I error rate up to analysis \(k\) \[ 1 - -Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} \cap_{i \in J, j < k} \{ -Z_{ij} < c_{ij}(J) \} ). \]

    -

    iv Update \(\alpha_{k}^{*}(J)\) -using root-finding with steps ii - iii until the type I error rate -through analysis \(k\) is controlled at -\(\alpha_{k}(J)\) for \(H_J\). That is, \[ 1 - Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} -\cap_{i \in J, j < k} \{ Z_{ij} < c_{ij}(J) \} ) = \alpha_{k}. -\]

    -

    v Set \(c_{ik}(J) = b_{ik}\) from -the previous step. The corresponding nominal \(p\)-value boundary is \(p_{ik}(J)= 1-\Phi(c_{ik}(J)) -= w_i(J)\alpha_k^*(J)\).

  • -
  • Note: interim bound does not depend on future analyses. Solution -only requires root finding for a single \(\alpha_{k}^{*}(J)\) at a time, \(k = 1, \ldots, K\). Requires multivariate -normal computation from mvtnorm R package Genz et al. (2020).

  • -
-
-
-

2.9.2 -Bounds Computation: WPGSD - \(\alpha\) -spending approach 2

-
    -
  • Assume for \(j < k\) that -bounds \(c_{ij} (J), i \in J, j < -k\), have already been set and remain unchanged.

  • -
  • At analysis \(k\), compute the -correlation matrix of \(Z_{ij}\), \(i \in J\), \(j = -1, \ldots, k\).

    -

    i Determine what the nominal \(p\)-value boundary would be for each -elementary hypothesis in \(J\) for a -weighted Bonferroni test in a group sequential design as described in -Maurer and Bretz (2013). Let these nominal -\(p\)-value boundaries be \(\alpha^\prime_{ik}(J)\).

    -

    ii Choose an inflation factor \(\xi_{k}(J) -> 1\) and set \[b_{ik} = -\Phi^{-1}(1 - \xi_k(J) \alpha^\prime_{ik}(J)).\]

    -

    iii Update \(\xi_k(J)\) until this -type I error rate up to analysis \(k\) -is controlled at \(\alpha_{k}(J)\) for -\(H_J\). That is, \[ 1 - Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} -\cap_{i \in J, j < k} \{ Z_{ij} < c_{ij}(J) \} ) = -\alpha_{k}(J).\]

    -

    iv After the appropriate \(\xi_k(J)\) has been derived, the nominal -\(p\)-value boundaries are \(p_{ik}(J)=\xi_k(J) \alpha^\prime_{ik}(J)\), -and \(b_{ik}\) is computed as in step -ii, we set \(c_{ik}(J) = -b_{ik}\).

  • -
  • Note: interim bound does not depend on future analyses. Solution -only requires root finding for a single \(\xi_k(J)\) at a time, \(k = 1, \ldots, K\). Requires multivariate -normal computation from the mvtnorm R package Genz et -al. (2020).

  • -
-
-
-
-

2.10 Implementation of -Example 1 with Overlapping Populations

-

We first define the transition matrix and weights as shown above in -Section 2.5. Next we set up the event count table as follows:

-
    -
  • Analysis: Analysis number (1 for interim, 2 for final).
  • -
  • Event: Event counts.
  • -
  • H1, H2: Hypotheses intersected. -
      -
    • (1, 1) represents counts for hypothesis 1
    • -
    • (1, 2) for counts for the intersection of hypotheses 1 and 2
    • -
  • -
-
event <- tribble(
-  ~H1, ~H2, ~Analysis, ~Event,
-  1, 1, 1, 100,
-  2, 2, 1, 110,
-  3, 3, 1, 225,
-  1, 2, 1, 80,
-  1, 3, 1, 100,
-  2, 3, 1, 110,
-  1, 1, 2, 200,
-  2, 2, 2, 220,
-  3, 3, 2, 450,
-  1, 2, 2, 160,
-  1, 3, 2, 200,
-  2, 3, 2, 220
-)
-event %>%
-  gt() %>%
-  tab_header(title = "Event Count")
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Event Count
H1H2AnalysisEvent
111100
221110
331225
12180
131100
231110
112200
222220
332450
122160
132200
232220
-
-
# Alternatively, one can manually enter paths for analysis datasets,
-# example below uses an example dataset assuming currently we are at IA1.
-paths <- system.file("extdata/", package = "wpgsd")
-
-### Generate event count table from ADSL and ADTTE datasets
-# Selection criteria for each hypothesis
-h_select <- tribble(
-  ~Hypothesis, ~Crit,
-  1, "PARAMCD=='OS' & TRT01P %in% c('Xanomeline High Dose', 'Placebo')",
-  2, "PARAMCD=='OS' & TRT01P %in% c('Xanomeline Low Dose', 'Placebo')"
-)
-
-event2 <- generate_event_table(paths, h_select,
-  adsl_name = "adsl", adtte_name = "adtte",
-  key_var = "USUBJID", cnsr_var = "CNSR"
-)$event
-
-event2 %>%
-  gt() %>%
-  tab_header(title = "Event Count - Computed from SAS Datasets Example")
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Event Count - Computed from SAS Datasets Example
H1H2AnalysisEvent
11166
22159
12145
-
-

Then we compute correlation matrix using the event count table and -generate_corr(). We see that the correlations not accounted -for by the Bonferroni approach are substantial and, thus, might expect a -non-trivial impact on bounds for hypothesis tests.

-
## Generate correlation from events
-corr <- generate_corr(event)
-
-corr %>%
-  as_tibble() %>%
-  gt() %>%
-  fmt_number(columns = everything(), decimals = 2) %>%
-  tab_header(title = "Correlation Matrix")
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Correlation Matrix
H1_A1H2_A1H3_A1H1_A2H2_A2H3_A2
1.000.760.670.710.540.47
0.761.000.700.540.710.49
0.670.701.000.470.490.71
0.710.540.471.000.760.67
0.540.710.490.761.000.70
0.470.490.710.670.701.00
-
-

Bonferroni and WPGSD bounds can then be computed via -generate_bounds(). In this example, we useHSD(-4) as \(\alpha\)-spending for all hypotheses. Of -note, generate_bounds() input type specifies boundary -type.

-
    -
  • 0 = Bonferroni. Separate alpha spending for each hypotheses.
  • -
  • 1 = Fixed alpha spending for all hypotheses. Method 3a in the -manuscript.
  • -
  • 2 = Overall alpha spending for all hypotheses. Method 3b in the -manuscript.
  • -
  • 3 = Separate alpha spending for each hypotheses. Method 3c in the -manuscript.
  • -
-

Compute Bonferroni bounds.

-
# Bonferroni bounds
-bound_Bonf <- generate_bounds(
-  type = 0, k = 2, w = w, m = m,
-  corr = corr, alpha = 0.025,
-  sf = list(sfHSD, sfHSD, sfHSD),
-  sfparm = list(-4, -4, -4),
-  t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1))
-)
-
-bound_Bonf %>%
-  gt() %>%
-  fmt_number(columns = 3:5, decimals = 4) %>%
-  tab_header(title = "Bonferroni bounds")
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Bonferroni bounds
AnalysisHypothesesH1H2H3
1H10.0030NANA
1H1, H20.00150.0015NA
1H1, H2, H30.00090.00090.0012
1H1, H30.0013NA0.0016
1H2NA0.0030NA
1H2, H3NA0.00130.0016
1H3NANA0.0030
2H10.0238NANA
2H1, H20.01180.0118NA
2H1, H2, H30.00700.00700.0094
2H1, H30.0106NA0.0130
2H2NA0.0238NA
2H2, H3NA0.01060.0130
2H3NANA0.0238
-
-

Compute WPGSD Bounds using \(\alpha\)-spending approach 1 with HSD(-4) -spending. Here spending time was defined as minimum of the 3 observed -information fractions.

-
set.seed(1234)
-# WPGSD bounds, spending approach 1
-bound_WPGSD <- generate_bounds(
-  type = 2, k = 2, w = w, m = m,
-  corr = corr, alpha = 0.025,
-  sf = sfHSD,
-  sfparm = -4,
-  t = c(min(100 / 200, 110 / 220, 225 / 450), 1)
-)
-
-bound_WPGSD %>%
-  gt() %>%
-  fmt_number(columns = 3:5, decimals = 4) %>%
-  tab_header(title = "WPGSD bounds")
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
WPGSD bounds
AnalysisHypothesesH1H2H3
1H10.0030NANA
1H1, H20.00170.0017NA
1H1, H2, H30.00110.00110.0014
1H1, H30.0014NA0.0018
1H2NA0.0030NA
1H2, H3NA0.00150.0018
1H3NANA0.0030
2H10.0238NANA
2H1, H20.01440.0144NA
2H1, H2, H30.00920.00920.0123
2H1, H30.0122NA0.0149
2H2NA0.0238NA
2H2, H3NA0.01240.0152
2H3NANA0.0238
-
-

Below shows the comparison between the Bonferroni and WPGSD bounds. -Nominal level at final analysis by using the WPGSD method increased by -up to 1.3× over those obtained via the Bonferroni approach.

-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Bonferroni and WPGSD Bounds
AnalysisHypothesesH1.BH2.BH3.BH1.WH2.WH3.Wxi
1H1, H2, H30.00090.00090.00120.00110.00110.00141.1770
1H1, H20.00150.0015NA0.00170.0017NA1.1363
1H1, H30.0013NA0.00160.0014NA0.00181.0810
1H2, H3NA0.00130.0016NA0.00150.00181.0962
1H10.0030NANA0.0030NANA1.0000
1H2NA0.0030NANA0.0030NA1.0000
1H3NANA0.0030NANA0.00301.0000
2H1, H2, H30.00700.00700.00940.00920.00920.01231.3092
2H1, H20.01180.0118NA0.01440.0144NA1.2250
2H1, H30.0106NA0.01300.0122NA0.01491.1532
2H2, H3NA0.01060.0130NA0.01240.01521.1735
2H10.0238NANA0.0238NANA1.0000
2H2NA0.0238NANA0.0238NA1.0000
2H3NANA0.0238NANA0.02381.0000
-
-

Closed testing procedure can then be performed using -closed_test().

-
## Observed p-values.
-## The tibble must contain columns Analysis, H1, H2 etc for all hypotheses
-p_obs <- tribble(
-  ~Analysis, ~H1, ~H2, ~H3,
-  1, 0.01, 0.0004, 0.03,
-  2, 0.05, 0.002, 0.015
-)
-
-## Closed testing ##
-test_result <- closed_test(bound_WPGSD, p_obs)
-
-p_obs %>%
-  gt() %>%
-  fmt_number(columns = 2:4, decimals = 8, drop_trailing_zeros = TRUE) %>%
-  tab_header("Observed Nominal p-Values")
-
- - - - - - - - - - - - - - - - - - - - - - - - - - -
Observed Nominal p-Values
AnalysisH1H2H3
10.010.00040.03
20.050.0020.015
-
-
test_result %>%
-  gt() %>%
-  tab_header(title = "Closed Testing Results")
-
- - - - - - - - - - - - - - - - - - - - - - - - - - -
Closed Testing Results
H1H2H3Analysis
FailSuccessFailAnalysis 1
FailSuccessFailAnalysis 2
-
-
-
-

2.11 Implementation of -Example 2 with Common Control

-

Similarly, codes below reproduce the result of Example 2 of Anderson et al. (2022), which uses spending -method 3c specified in the paper.

-
set.seed(1234)
-
-# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ex2 BH ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~#
-# Transition matrix in Figure A2
-m <- matrix(c(
-  0, 0.5, 0.5,
-  0.5, 0, 0.5,
-  0.5, 0.5, 0
-), nrow = 3, byrow = TRUE)
-# Initial weights
-w <- c(1 / 3, 1 / 3, 1 / 3)
-
-# Event count of intersection of paired hypotheses - Table 2
-event <- tribble(
-  ~H1, ~H2, ~Analysis, ~Event,
-  1, 1, 1, 155,
-  2, 2, 1, 160,
-  3, 3, 1, 165,
-  1, 2, 1, 85,
-  1, 3, 1, 85,
-  2, 3, 1, 85,
-  1, 1, 2, 305,
-  2, 2, 2, 320,
-  3, 3, 2, 335,
-  1, 2, 2, 170,
-  1, 3, 2, 170,
-  2, 3, 2, 170
-)
-
-event %>%
-  gt() %>%
-  tab_header(title = "Event Count")
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Event Count
H1H2AnalysisEvent
111155
221160
331165
12185
13185
23185
112305
222320
332335
122170
132170
232170
-
-
# Generate correlation from events
-corr <- generate_corr(event)
-
-# Correlation matrix in Table 4
-corr %>%
-  as_tibble() %>%
-  gt() %>%
-  fmt_number(columns = everything(), decimals = 2) %>%
-  tab_header(title = "Correlation Matrix")
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Correlation Matrix
H1_A1H2_A1H3_A1H1_A2H2_A2H3_A2
1.000.540.530.710.380.37
0.541.000.520.380.710.37
0.530.521.000.380.370.70
0.710.380.381.000.540.53
0.380.710.370.541.000.52
0.370.370.700.530.521.00
-
-
# WPGSD bounds, spending method 3c
-bound_WPGSD <- generate_bounds(
-  type = 3, k = 2, w = w, m = m, corr = corr, alpha = 0.025,
-  sf = list(sfLDOF, sfLDOF, sfLDOF),
-  sfparm = list(0, 0, 0),
-  t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1))
-)
-
-# Bonferroni bounds
-bound_Bonf <- generate_bounds(
-  type = 0, k = 2, w = w, m = m, corr = corr, alpha = 0.025,
-  sf = list(sfLDOF, sfLDOF, sfLDOF),
-  sfparm = list(0, 0, 0),
-  t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1))
-)
-
-bounds <- left_join(bound_Bonf, bound_WPGSD,
-  by = c("Hypotheses", "Analysis"),
-  suffix = c(".B", ".W")
-)
-
-# Reorder for output
-bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2)
-bounds <- bounds %>%
-  arrange(Analysis, order) %>%
-  select(-order)
-
-# Table A6
-bounds %>%
-  gt() %>%
-  fmt_number(columns = 3:9, decimals = 4) %>%
-  tab_header(title = "Bonferroni and WPGSD Bounds")
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Bonferroni and WPGSD Bounds
AnalysisHypothesesH1.BH2.BH3.BH1.WH2.WH3.Wxi
1H1, H2, H30.00020.00020.00020.00020.00020.00021.0421
1H1, H20.00050.0004NA0.00050.0004NA1.0266
1H1, H30.0005NA0.00040.0005NA0.00041.0247
1H2, H3NA0.00040.0004NA0.00040.00041.0230
1H10.0017NANA0.0017NANA1.0000
1H2NA0.0015NANA0.0015NA1.0000
1H3NANA0.0014NANA0.00141.0000
2H1, H2, H30.00830.00830.00830.00950.00950.00951.1493
2H1, H20.01230.0124NA0.01350.0135NA1.0942
2H1, H30.0123NA0.01240.0135NA0.01351.0898
2H2, H3NA0.01240.0124NA0.01340.01341.0855
2H10.0245NANA0.0245NANA1.0000
2H2NA0.0245NANA0.0245NA1.0000
2H3NANA0.0245NANA0.02451.0000
-
-
-
-

2.12 Power -Considerations

-

The above illustrates the use of the WPGSD approach to compute bounds -at the analysis stage. At the design stage, one can take one of the -following 2 options: 1) The trial can be first designed as if the -testing would be done with a weighted Bonferroni with conservative -sample size estimate. At the analysis stage, the correlation can be -taken into consideration with the WPGSD approach for bound calculation; -or 2) To adjust the sample size downward using the WPGSD approach at the -design stage, one can power the study by taking the minimum \(p\)-value bound for a given individual -hypothesis from the WPGSD table (with assumed correlation structure). -For example, for \(H_2\) of example 1, -this is \(\hbox{min}(0.0011,0.0017,0.0010,0.0030)=0.0010\) -for \(k=1\) and \(\hbox{min}(0.0092,0.0144,0.0081,0.0238)=0.0081\) -for \(k=2\). Then the \(H_2\) bounds of 0.0010 (\(k=1\)) and 0.0081 (\(k=2\)) can be used to power \(H_2\). R function for the 2nd option is in -development.

-
-
-
-

3 Conclusions

-

The WPGSD approach provides an unification of previous work on -parametric testing in group sequential design. It enabled more complex -scenarios and requires attention to consonance and intersection -hypotheses. Although detailed closed testing is required, this should -not be a deterrent. The approach accommodates various spending -approaches and provides more relaxed bounds and improved power compared -to the Bonferroni approach.

-
-
-

References

-
-
-Anderson, Keaven M, Zifang Guo, Jing Zhao, and Linda Z Sun. 2022. -“A Unified Framework for Weighted Parametric Group Sequential -Design.” Biometrical Journal 64 (7): 1219–39. -
-
-Bretz, Frank, Martin Posch, Ekkehard Glimm, Florian Klinglmueller, Willi -Maurer, and Kornelius Rohmeyer. 2011. “Graphical Approaches for -Multiple Comparison Procedures Using Weighted Bonferroni, Simes, or -Parametric Tests.” Biometrical Journal 53 (6): 894–913. -
-
-Chen, Ting-Yu, Jing Zhao, Linda Sun, and Keaven M Anderson. 2021. -“Multiplicity for a Group Sequential Trial with Biomarker -Subpopulations.” Contemporary Clinical Trials 101: -106249. -
-
-Maurer, Willi, and Frank Bretz. 2013. “Multiple Testing in Group -Sequential Trials Using Graphical Approaches.” Statistics in -Biopharmaceutical Research 5 (4): 311–20. -
-
-Xi, Dong, Ekkehard Glimm, Willi Maurer, and Frank Bretz. 2017. “A -Unified Framework for Weighted Parametric Multiple Test -Procedures.” Biometrical Journal 59 (5): 918–31. -
-
-
- - - -
-
- -
- - - - - - - - - - - - - - - - - diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/extdata/adsl.sas7bdat b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/extdata/adsl.sas7bdat deleted file mode 100644 index cb0d0a88730a1b0b74c03c1bd00192df92319586..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 139264 zcmeIb3A`OweI|Ik;t)YQ!32vXTohv@kl=1_17ps!-g}nt)8hA@7qJ-0(vzhiBt?<| zcalkkP6O#U-E^SSs5>MIFf_xEKt^;1nkAJqO&|#Hl1XqvCk_yY5IPV{SP}yB{kN)9 z_nx{>u6wIz<~R4+_m!&dcFy_gzc0tR{PBBV{@J}}ulS+QeE63xb3gF=t-G&$>g7Mw zac+aVz_s#s#r}0g;o|b_a${lp;{4p~%Ixy|N~7#i_)z48K2M*;OGkh5*Z=!$a4f!? z-f_8ebO;|a&u+GwtsPAqyEslR9zJ^KtHU>p|28QFkXT2 z3XE4^yaMAD7_Y#11;#5dUV-rnj8|a10^=1JufTW(#w##hf$<8AS75vX;}!V-%?e!V zF2!6wyG|y&@uK3yQ@ws=@v{5&C34~8^kI5jAcw_^<@jzrx9gYd`8D?adVY_*-FZE( zb@<*texDy}y|4KCn=e5606)GfAOC*uJZYL2y9=F8*ZrWLKS4f**W~pl={Ze<-v6UL z=TFmf%9x-lB;`UURBp4V4A8*n`+82dHI4rgy-)4+$Ml>(zUTZYJ?BsFIp3n^c0aXxUZ2tP zN9*rz?K$7k^ZuK9&R?qMbf41rU#;gqtmpr#=l#E==QiIr_q>jeWe+8t@7sHvd$M~J zzj~D(H#0ABuB*pu^!l6=vfrlHckA_A^?a|MAJX&VdVIAW6DREE_4>Xy==Z%zU;h=o z{&vin9`DrSyY+ML)Azq$-=FIBkL&RsJ$_cd=Rrq!JNG3$eoc?x*4NzyGM>xyc=-kL z{wwv^(BsAnWPO@?K7E0(ORwkK^tfB!cdH)v>h(kV{^NT6)p|YA^VjR~4f;MFH2?W0 z1?zprpK;alwCr8WD>u#U**@oPTE6MJ7viV~x4eC29;bY~eyQbVmv*?7rIluDx6|WJ zInL_&ET1pWt?>E09_Maaa&GqK>*w%QZtG1u=5{U5yV>jcNncC<#&IVdZ(5q&I#17? zc<=K3t!{p0+s^G<@$cD%g+*N3zOur{`2{)Ox@*VoXL2j zIxge=H*d$PwB}Zp7M54$R<^pOh54Oy#Pyvw?U>&w=Xn3tx%sWT=5Sn^pIzQMw_^t~ zJaAWI`+?P?rw$)Hyn5oMqlbUu&eg{9owxt^>i$!~ z3$z}67aIqUooJjog!j|e$agItKDAo>-0ow?j;tPN@C(SdcCo6=O#D1|J0rP zjx@@?VvX1ND;)9y=jZleHW=W-;S(oMHRfM^{MgAmPpmdh9m~JE@V>=;rEha{cb?d1 z6V3;=@xZ>jPHvig-^s>tS(8m}>z%K-^9Vlq%GLfCXYW{b zy1w{l!-CK0?(y=`&a2nuPm>=+RdLjboB84!>8^dtoI#UJ#|-O_p#&r z(?DtA$i6#p{~tXCK(?$L+rl&Gd&B&}gNOI;+u!%et;b$*{K)F5)e|RaHE&s6eR*TL z_rsC*v?hDsgt0~5*X~B%H+T4e+?;yf&K*9v{}}G`qqxDdoAw2umHhgF#sPZqSYvkn z1=;;RcX;&x-sY~`cXIW};iIb!5N~7S%kOy3D{gCV!gXE$!pjCkc5&P4;X4kUYHZy9 zicQ(ITlCt?@7T0wb)PKF{DC|7^Id{*1^3^sqbFBS(b8eCs~AUkFX^Sm#vPd5p_7|* zJa##ItBooA-kT4fJbViDXtcewdT{l`>QUSj%cu68IE8!i)ar9q4!>fR?g?GT{5|tW z4+QU^GmLNrACs@$h(n{*Zh%S5?>m8edu8>+E1tb6{QZ3GdD72OY{3?YH|;xmVBd)Y zhyOV^1KtSQJIwS$UxV>1VIgp15)bP68s~`LHCB$D+IM6yKH*pf(fBv{pT6gXTDeRj^6L>dz%>!JujFpWXGPD$EV{J`2WZXJlj1RBTfIA4A=LJIw`sC zORl?;>*-@lzQ5$UFS+hYuBVSF`TmmYzT~Er!KyFsPQje{Pdwdf7Otm zcNbqZ)bD@kqT%lUk6$z#|9S64Rwk*Wa|KY!*T3o}*w{Wo8v>O;lff73-O z7At=K^+V48_>k-Wl8c7pf42^~{?}YomH*3K*SKgn{&#WZ-~Zf&g#3dSR@EQg$De=y zg+C?}sd)dqq4Mv`&mO}t^XG<7*2kE^n%7v zzyHn)*6ZijK3v4Hv60#TYyaT*9pe=kufTW(#w##hf$<8AS75vX;}saMz<345D==Px z|JSX+BlUm0nd3*la_MmXo1eOLIRDl0OEpZp_Ih3*p4P3DIJtZK;x43lHd|Y!@WgR~ zp7=NZM{?l))!UC1zA$#p-Z1DjdXL|Fzo%nzT#hb1$meve@JM#~YbGb`($`+FXMT2R z`Ic?SQMGHO$FIF$VcYiQ-LuFfZR}cVEY7ZM-?@w4y@wz8$A37D$NCxHp4f6tr^#oB zZ}%O3+~Dc0&NV&#O&-2iu0K5QuYG=t^M;by`+d9F>TbbmHQVy9Dg2Ax@7zXDe`$V{ zoVqxVq(-_>d{|E1f#PL1r9jWIXZU@pVPJCWA_mF z>?p-&=gysb_PB%mxE3qkX*$QSEFTaY9=GCU9Gm%=-gS=`G?z1c-0$2+__Vh)r?)gG zz$=kEx!Rb2CDJd07p8Pbbjf3>;`mGh zpJ~D8)_q5hy+YC$w;>~uGfHFE_&5BDAM_f%Cs{9a;}?{El7s$J=kPeP?D;!x{G=Sy z8~x>Kl~%2pB+1Qtu*>E%IHV%d4Vnlum8+J!RP*4<@c3-(tGdq^6r3sp1}0e z+0vZa(wZ?!YIS9#LO(RWO7tVQ41JZyQbqCUfPOkkKf!u09(xtT<6_rjY&V4XWbe1v z_;|D8vq$l9a-TY5M-N>WgwX}Tv*wK@eD7v~I z8LyOGDvyxAr8kw~(*-`=dg#Zi+)3Y}_&j(}_{WUUPjZ*ik6#`FpM^E(M>y7V6(2_H zCHsYr7k4Q>8~B)>x=-lpq|fk4jv79YIxWTr%#JuEJ%oN}eii6vB9uQQ!eaVCcdFIw zPSqoS{MSY9B;S^!bIQWCVy?l-P~o5jK7uRQ!0Pnc)ReikL}j+H01c3_v(4h z-`xLT`2+se-qIrd0RQT2Y0ty$rCF^kU&>F3GH-x8r?q>l4A{H}Wxw_7v%Nxjhz^f#d&NTR0V zqw)vyt3W?j1@x0%7pI?=Jo@-sCQpXJC;bDZn@<`2Tvf#9!9>oXYt&3X4^8=N+N8m= z{QuZ~;bRZ)(D6+2G5xpq3jf_Rm*JEAzUgn!+NMB1(Bx*ew5IS?cwFx3ugCl<>2ES5 z`icZg6{DXP>>oU9!spKg7Y`mmgK&w`jp+y7|0LJlF#K(R{+8?489uCEpH(^d0iz$a zV}9c^g3n!hGJM>hDL$k{n)|PgM=i`Jg()=pm)74vsS4NjgzIOa~q$@DM{%^IW zasR9R60_%H*KBZuUZeLU&@Jhh{;bK568qo1a2We?4gHHb(nAw^v#~bz^J+((yOGD| zRB!he+^6>CLU#ZA8%=&dKUVu6oT?x{XnqysM|l5xELD_0b(*bKr&*K!wNvr=NyP{H zG2zw!sEI$p`d9zVX_N1a*5s<-@W8T{u?T;1-!b`-Q45__tD_< zXu&0YoZ{oQir(`^o33I{h<@&$)vA@>=!JtTX#X?0Em|d(^H8?8~Pc zJ~J6U6fBUzD?acKR>0?~fPT_VCHPE3KbThiAh0Dz!r#n4lm3I*FSBxg-mUzt{WdT2 ztcQNYKO>UH^aIo1SPq>u|EBOaw@>|>SHCcmKgr)l{WBdIx9~Uj-AeXLK|d(*&xm?W z!8QCpa(u24y7A9f`f=i~&HT>~9v6ISq94IW=*RHkGxKl0d$-;n!rzh?nSQV4yw|(%(qU#{YuPxBlyTKlSCn}G1Cv?HzJkx=y;lZ^gHg6>zi-R@%dUnKY|bWH#Jx*^pjMhpD@0b zsw-FqJN`S;6&Pgy&$L?z%k}Z6(cJ&PBlmss6}|s6`%>@!9siZ@JG7LlG5%8IPb@dS zaJ&3&YVjA5)9KwRKOWke-T%o4)qa83xUK$u_`g6&^icVZ`Bjkbh4|P<;`U3s*@4r# zCjBe@s^H?EV)|E!{U7xoU$;2B^#;nhm|a-fzIAqIV|K?p|3j9>{`zwJMeIxQ&sctj zeC&Yg874oT>G}Gi>c@){89pg|k789qekeZ31W@@d_|W_+;1k-H36?4*KR`V#JZqw# z&nf+US?MP+eN^e^i|>?maW(136kpyW9^+P^j5??J8D|&t_hp^kUt9b?xBuN|m44tq zX8#N+uoFIUQZ2jDG5jk1_omH2X!+>alY*KIYD-{c?YvKjZ(==%n?nC4g+Qb9)0qK2Gkx?k68j~Y7hDpHU!KvtmCiEbm26b|-wkEI^ykjdy^!V4 zi2O1Ai_Z|hWIgOVx9~WeyIRK6`i$_sbGK#u%^|QTRzIjFi(j@{^b;n3(rWR`Q2+8+ zswh5F6Rq}Ce|&5t_;~nkX%@*LIlAN}s+S5ruJyb8x=VIO{4*wQ8ryfyZHM?FNwhe- ze8X%52`bxf*3`i({ebw`9?G8)`_lYpOg|4Fkl*!c=USe{Pni6Z8x1gdrQ!qqjo0UKf={w_6!f!J{w9sUCC1;FeqdiR*SmVr^Q)G3 z^|5>P{@I@6bG_jMtxe+t(Bum70h(V0{UF3A-ByCn4CK#De}2^mYk=%htRJF&=1F#nSR!r{m-~8s2}f)+$WY_n;tXzX=nH(@GXh{2CK3w|H|oS z1CO8PS0TO}>euAriO~;2+6b@p+dm`WZ|RQ-E@@ZsF@A!4Ku3?So|R*iznyRX^IG`u zFCnuk$bW|Y&p5r-?icmXd`k0cPv`nU@-+3&Agb1;{7v|0kV&KV{{|jE&2LD25?v}8 z?D+3US73ns-)T*?@a&Txqv1~n_5OdO-v6ccfBpKg#s7I>FIWFp=AZ0(y6!jLFY>MP zRDX@SApL%mABc}h{2%v!(f&^{zY6jr)Q=sOD$1YQ-Bzbvll*Y^s(txAwJ*!?8Onb= zfIo43x#*vfvjfFAo#prauEsA<&t~$&AvX+M2`=MiX8%J4E7&gy=2roqP=2KMl*o@R z!vEcx?EmyjiVI>GbbmT0d32e7{|&$7`Es&7q8|@0KLY=8V)0Af{s`ldnoO_}}D4xAw_)%bFzAB%iXH&}joKtG#Rz7zdu{y$X$$l%qlgZWj;{}1vn zu~bofCZSPG))c=?o~-i6{F_eVxEcNUQ=aEplYUI}V>iL`!~ErQz4c9MC!VzYjJ!T0 zeWK}KQ(MRtO!+g&Z&Lr+&b5l^3P5e>d)>{`srByjIQ%rRsJmG@+Yj%XsUgQ_`oF3OZ_?y^Q(kUUVrAWR8jhY zf2L#pnV3I0c1^~{n|1Wn-vP)Uo}? zj$mhmW3-otRiIrRh{Uq|+79BMc#8cK!y9Ft+7=*)y%7>igEZ|K+zVzRdC+`ImhEZx%V`oakT4D?Taw=?e$5``^JQ zAo4xW?;}s8e5>%a1oNvPKiWZld0Bp6w>{IsvmXD9L+p>{k$`^b=#qIkT7A-0Z`JcU z`TZG@lPVZ-0EXBKMC`z5PxZf_`ppa zlkeRwB0k-k>N676yV4sJpECV8sndVPh;+?v-k^1Fsw+(#y{rjWwZ?*-O^ks@q#@{slV);$c{PI!R zFU-l-QAR)A^^6wuFTv?Wo|oD5+&k63|DD`^aZTlKu>aeW;B;`Fp+2LaAJhCQ;PY%9 z5)T1O700IweER*Hqlv$$|IG53U840F_p9IPzx=PVK12Cu*6MG<)A!_YF|Oo}tAFO8 zjzjea8sy)!AIReWtiK_C$;YhzO!b2$wO{Ve>Bj~7L7pGjX~`GM=V*Qv z_*;lif~AV$Gd0<2PNDvc@CoQ=B>c^({Bh_}#q&WNneX3oOLG3V8vjS!xt9Jw9RHV< zwEQNPKW|g{^D*4S1~iRF7KfBVC;GQYGYe30K{4(Nh@ee#gpCttDgv}7DRH9zCrb25C=kE#8S zt_(~+RGg97KZ0wD7*7R!Lj5{#K}HKUevEVl%ItrVA2YcBXY~G$$%@!D8{DAR=slF1 zO-G;Ak8S63x>k5Z^UKdSep%|DgnN?WFU*n7n*UgSSM$p=|Chvt(p3HXE|BkE%=ItM zA4B{F_Wz80kLq7YZe859ywX_N)mYfIxVY<0d$o-|{mUE#zN{eBbHi z_odHBvPtE~L(k3llZW6H{|xSCs*eRe=pR$?&(QoT$oGPMiKU9-)0#mA0Q@sO@_i)o z!+%5YNi4q)`LVJdDnHh}U(V~HAB11>{)~nAGV=cgpX+rz;y-qeSN-_XpgtCb6M_m= zEz7@<->3GA`rWGK_iYaR`wmML#RvJzEy`c6gMJ)(OA#K_Bb1KL2|tj32Y-jE|1bA% z3V#zMEWeNKe&k=uaoNi#6rU%U{*~7^`D@Mo&+vhKH~si>{ya6e8W4Zk{+#*7&SR$< zJ62BxbEc$rNjap8=?mie7g`RY{!;CiKtCP{{g7_SKmL5f$NY&(KWF}D^j{K<+?WaD z^2=7|ej|_1^7#EJ!)H3(Rd|8u1vEo#=k3^^PX{LdS8Nc>G$su(`7{!xEclYU@&Tl#dxr>s8%^rhDfm=BeDMz6phl&;jKQGGBLZ`U5!*6<;2R4-gW3EPsa2;6D?syBPoX zr>wp_$j|r?<3lNdnSOx$nHJ5<_+pCs+6w&bnE^gNR$oi_Orid4swVv{y-exmv3e}a z->ipz)cz5QDd^W0A9zUlti=Z&E%%d4^8PdF#m3(zGW~ios}EHD;D;;mw@`meY^enI z@!wIdzySNdJ%jqb8P$&i{c9xrDV^5){x&_P%D3OR>}h_<*FMHa=Mayop}#NLFJ}LT z%8o<+GV5Vkeyr+IZ#Vg#*C&zVP_!=MO86JzW1s}J|Fv#&wbK1>Ayr-qELBv#&wxM8 zD1VCiTVmJf3+XZFHGac6wJ+5V;IjB7zncH4&Auf0&XS^I!jy5DH2JaMWe_6Y6VzXd zweyUuK7)GT0u{&)Sp8c655BJUrGAc#_eWm8Y$^v0A^l|BzU*|6U*4&UezY%Ea=Xco z7mD9@aY@$YBflZXX#Vo3^kbU7!)6u5_!#4aKJxsc)-U_3@0D{O_|I-+`T^Ad6|Ij& zC5`%L#9mHO{4&74++C927xu?Wuv9Vn=|H~Y*{6Sv#J;4Y9h!e?`Tu7ue_7Y%3EJNz zNtXAJ&zfJtf5`I7ug~>k_{Ky(rmBD8Z}4xn_WW&4|0{Dt|K z?VpkDZ=&|gGi{u?{qO!l`5RmP%<1S~Dt|=(O1@Z0KMwOR6D(B}AM|JFQh$aX|K>>W zvHWHK8sl$w$bGw6?%S-tsf*eF=Znuk`vtc{(SDKp&`&e8UsfXYgMB)hP3%9@gnfw=n(oN;w=c{6n5ZAxxjDhd`u}}R^Ji+p zhx{{YU!vnrUQFZ?%MUdFv(S&f%lv0sGXCcN+U$R1WoUc=o=(j_)A$W?1S;5<;gAw6 zRUiE@J~O}v^wWdSNaT;#qUl8YXgYVT+_#p$x%;%<$FcgE^QE6s{)Y4!(yxVnOqpeA zw7<8$R{YQDYfL}L^D_$d({CEojsxa&F@ou>>KPjO#icTe8m0{j@2uF_?MxV$Oy#mnjTXB%witDNfwR2foih; zGuHoH>>t`6qyj!+{6A~aYb!E7j&23Y?0@1zI((jcoyada0?)e*XvZ&H|do8|Wv?U!VxQvAh+ z#7l&wit?v6_GfIvzN|xjxMvAIk8=G>@L~S6-sA_5BQ^cY z^z=55BmIx2e+B-Tje-55@&le4)sHo=1ND~` z$oQ+}_l37if?GI>&lL8Tni=xHkJjKmwiZ%X+82s@@H7mELwbw!9srqKJGPqlztv%{ju`?nJH{9 z@z212ru{Pze`)gPwQkKL{!#&-Fr_Dr zuO|IK0?Zi-e&!q=e&$U_*-(D%AfT+Gy0*PTbX{{Cx7H~ zB!4RS&k7+wEL9XA#BW*@zv+=bBjImJN9pH)(ocFw*F)*&^Bfb`toKWzuaMd74H8~ek53`7=LPG0~tK);ZN?r3od@0@uxd@9kTvd zw!d#QetEwB?78|4g3$@BY-{WAN`QK8PfB81;|3@SgqlefvyYUCTM(;_qKZCzg@o_Kp_SwR*rv5(SKNkDNoK-A8 z4(tBdS6lo={QF7Q>c?hs`5xq7vj3R%W2?_l|1suQK|eN?gO-BY*hldJdqWG&KKdDr ze`bT?@@&IL*8}pL@p+T#$H_4I*IND=p&#?_n}3sk-|IMRf71h&-xS1`!~Ny7{<4|n z|BL-kdQ1iVxUhc)mMV%5`v0}5|6d*SlcL^~*1y?1AFx2 zk@-jMC%cc4O!UN=gX8v~8j5$6-{xTo4{pE#z$p6gpX-{6?M748lzpz(E{zaW=XkL~V zMSXTE;1k*}Ds zLjIZZH~CzG`Bk8wP``FriJlujM!f<9?0<28seT-@M`G7(e1l%2_oS*9r=W5E%o(#U z`7HmF3?n}V-2d$VD*BHL{AsV!q009Jw!Uc7n=<}HfnT}*QGcoaNyJ5p{(a1^l6{${ zv?XQo9s84ZXn)c=^y37%r3`}Am+vjXr#AV4^fApJ3z@aU{tP@WZ}nqpCpJv~3hc{2 zH~Sy_N#g&s|B}Z4#c$vcAFF^*7+>~Ss+j!ff`IU>2_N16k77)`9u^mqll*TojQ@B5 z{cwICQ%ttMkLX?M-(P3)L+zJ8vHoRw{a6z2|EKuCere0#RX;}ZWCi;rjF0&e|4bMC z|M9E|AM6dn^Y}MC~ ztDpHw(SAvvVgBcQ{|xHwC;9<({TKb1D2czv^a{+cLVuvJK7+PNkJ8Ts^2;ZXUtS0O znBDKqKa<|Z_nXWu_?rx~zg#K(fV<`WXG|EI{V%^>j1MI5zE{TQx8?lpDMmlADzpA_ z)_+#*%c}mFK!3x}#PDgMzZ{-5;WHU9)MlNJ<3FQcfin9aa;iOz_{%inFFp7FX#D%gEv4D` zS1P#a9io5EEc5l`b?5l#hLi8-(?1rO?Ljgs{rcBP@JXOl03PRWRD9emlE3^FwHqcsDERo8 z{W6OB$LweewW5)eP9yA@gzQ!`)5co%Ji>%|1y;yBHvRKhgaZFh5fNh z^e=3Q0({^ekpISmNPb+7Cf{H3 zF+Gp%Up^{)M82DU-~2Otyx-_Y{45TeSn@bsPCw*$6#9XGlj<`hzpsc7=2roqkiSu= zH-=9K#wDIL$saTwg6m=1NCbRlj@rydluL6JT1R^oLwgew|XHcP06FyzRCE2F< zq$^sNr}wS(H%*4Yr__D{JSFkvt+&g40Xx$1L-m87GW(xIgXjmoZTP@`(f9y70Ui0= z22V$tUj=;3ppP~OB zUckT>N{#LLru~bofrm+9t6!QP;(63Y2 z&b$oEiVyZN5pS02wQuCJ0i7h2 z@|zSNv1n|62EIS6{(0T4ijUBN``=B!&h4M{QOe(_>zVe?pnu6c)c<_h!2FD|{=l6; ze;fDzlLf8i?*RM1gZfK6`}osH{QK0KjV6?!2RI$6Zwno={POAF@qFrP@lS^SV|0uc z`(N}f%U?GBq<*=-(EUjtz9p0Iw1)?z2Iv16(8HSeR=on&h1+pyOtWXb?eSu_$f!lmzpxqj?X+bdEXR%ModS&aX4^YKUC|Ib7kjW(qeg5Le* zkY~_DemR~~%}MN!6^m8IuF)6LW6*2#I`v(rqkEMez1f$1HTbjJUo)vLDH1Y!=4Y3d zhnDY(k7yL8j51obKf@l&&yfA){m+_zKgiEO?*hgLBxLnt@Shd(Gd$*3LI1KL(K;kp zsyIG~kCA>%_>5Yc!96HoTqpPKN!7o8^=*1RX8)hBeOYe5h<{(?yDf&{Bd8gF zQ#I^{C0d4Dm7l8Q&-HKl9No>rwqP*IIvu?YaEP^8e9Qj^dXriHv?k z|MKwbRKTYj>R(u@K75d80M`sXrhbU#1^CcwE<~9{Zp0vHUYj zR$=)A|1;B1*57n9k0br(mYR@WKA38Xv&^rfOfR-Lton{0a4g1WVONKhu=o1o=bz10ls}I*>o3 zr62VJl*X5lcV0*SneaE!-z>k0*Z*_9`!lu~rv&?J@#|kfJ&(oL0{>=CKjuFZ`l;wY zEA(%IiW|iT`TtGI|E~j|jciP3i78N_@BKll`PNr??_jm z%>F0-1pN!odhUPn9nnPmr0U06e!1FpANa5QxBqvgtbdH& z|6jNMBzgafG|-Rr{-^zYTQo0=OVj)+*e|AX&=)0GswjV&hW<4T{fqchOkT&X(HGKV z&};mLKT^JgIr4dFeMbHG7=Pk%SpMa^cgwgmkJ7)y_V*3)`|h*+f5>-=zkoSGz8C5< z9OhR6pRhk^`hP|AW6)0v`}^Qo4?fg;mDVHcFYo4cJ?Lui7^*&_oPI=ph(=}cOQsvt zU-GZ-U6P~bRi}?u{cBy2zl`2dK!vNuEWZ!^<=ZlPu`k^%746GBrH4`kWAuaerr7@v z{+T-Hhl)aI9{#aLKjuG^*=2wIF#YAq@e%$e_!R7atB*Zt{<969#^SFu|4iOLBl$C< z9~hQdenzps3C*tp{e=53Q5*X>KA@i|rJq1Q9!dPgtN$#0k>ZoyD*hSEi+J*fd0ku- zpAq=a*uJEd&-c$@`gxnx|64ybt%JGQ@-Kt>*wDVz`b!YgqZQ7<2{wIE-JCejKBpb_@1@3-&*e(8%#o{UAY&9pjLw ze{)&=n~#3GULOXZwd@zs-wORruzx0BU05#Qll=OpDa(D)nl1M+WjCYsTY z#+SjID&Q092Odim#is*&I(6Z*N%$IVuHyJn7GJI) z=k?^jaDJcF_nH5g9JC|} zmMY4hP(RkD`ms9fmsIomk}Q9$#C~zH{v;#NkMsTv2Q5Fz&pNefNm0(mf({tM*PR; zi_co}L-a4R|3&Z8{WG%u|7{uHpQ(Rl-CTx``)7s^vLz(G%qkeqNBue!L#u#K*dL49 zJjL;u0zT?L3-sfW#9vbI2AYSz)bO!c@YLo9|zsRGYe?h)8fBS&ZkK{M` zEw(>)9>4T|WBd(S%UWL!Nw4%H^)uw0te_v;kZ6DjmMVr%2lfk|_3$?j-atQ|T7A=l zCH+lmivI`x=Y!#5IM>_1O!Tkx4)vd5w*ZTe`LI8u_QwK$Ytg*S|4j3%KtHAu@;70r zqWHjm>C|SwsQ)Yp{AbMfH|u@-q)&Pt+)(j>wfLLp$EF|f@7<&K$%9s(A^a_Qi^j*k zlJ{p!&_fqeN36=M|4dOorukLCC)5w3{bwM5I$d~Yx~jj$Y?atGo+JJYdX3-nSIXbe zgM!aX<P$aC)JE$wpeZOm8~F1n=2t=fg#G2x3rqN07yY%m{r>0C=m$?xe0C`PG!E%{ zsDAL`kIH#EjQ?x^KCB&xrPC{am`<+VspC=mAMqQWM>d%`%Zz@NhW z*d*3}iR1_TGkEslGaC7Ef$}FX$8bIwKJF*=dJLcQmG7ncm->$xiL;g;Yx14B){OOE z*7(@PmVcSY$I|ba{erHH8vjQov*IKEV^^&{iJGKYeL0D#sD3;J`C;+Pm_8M|CTo2j z`q$GHpY4iIRzG9kpvUO`8RttsrTD;n$?{{f{mTp=M(vFn2eQ64zi9ZpFtcA07#2c5 zGjPm^e+HJO%6IX*rI_FH%1v{78Y}ZlJGSqfU74S2T(_sOynENqiM*;`m|*v1_uXYxB1hz4Ph4{>4f^50>~h z>xut^zmfM$G=V~V8TGL=F3L;fqvfAXTm4zSKVxBk;4Ht~{AWTxG`~vpljk=jSgJTa z$PaA7z9f7`?cemjEBwOiJ{r!I_5Z)24*Os8GgyDi=!f-!2ULH{`u|H_wZHEk)$0QN z;3MjvLH~cQKa)z%mf$M+86GvB73imsKZB);;se@+Ra*}}?m@vPc}y?;sC~IZ^J`uG z`I|;R;!V3kjFVTt2|`V0gJdg*60 z`nC3NO0~|`xgP!Cb?V=&EB+bi2PS`5KSBJH?|*OlTbIw1GpfH`o#$`*&*%P4ix0qm zHYxO@_CMxV0iV$RN#UlGuN?m!`3jWT|0Lg$eu-z_{XY`@%U`d23H4PnsXcmBzHsG# zmh)s7`*M(eoW;iyyZ>35Wc|y`AF+YQ;SqlkZQ%JCe{%Dzf5GcTyDo|SlG~ROAEV~h z734=)KjyGhQT~Mf|4r)uUx)tXUn02ppI3ZJ>-&bWUk2Hiq<@KgxA+UM|9-6>dth1a z58Xe;{Rhim&g;t^_J$Qy)c(hznbjw${)PEf;7@kTV2sXTsiOFxe{7Tb$M)!7qmdt4 zf0V}bEO{xUC0`a(IXd{6(K%8!R~``@GSo7gYNzohsw zCC_B_rf7J0~QTY3^;&j=2^?FVEG2gXB+^|G&P# z?2oH{>`XttQtp$3Rv#Gfw};LDOoeC6>9GHd_0Q1!8R*9q=qJqocUY)&ktXFg{2%R&eK)#jhc_iuK{ z%@S0gwP}76BAH4*8+iO4^Q(Z*bWp!ctze?~V1I@-?ax5}$9!e6YdmB88T1;z=Wm66 zDEW=g_wJJ;p9Ftuvo9$=z(_n~$}FG3zGOXNdAE+I&Bx@X{`f%pWuqTN1+w}xi!V!j zfabS2yY+^~u7$?@!ov2gvs+1Vw8!GU{V#7EJJ^^%c<}K4ef#gS>xKA0EdLDlPkVZT zo;C5e?+QNt2NfUWVaVWAKlsr9Cg;)k=g{#r&3_h;jPW^aBt7OojMOX#YE1D#LDk9N`KKu>U*o@8ekye@fQteQ$n%Qvd!i z{VxXD|HLLl|0>-7Tg^Xd@qdxi?qBrtC)#^m!QC&YCL_fseME?qv9m+4KMRA#bM&tjM--o{0nS6(1OXx@Q zFWG=HFEP>j@ekOKYv zvtO8gu>TV4VOf4`lgH_vVE)Zue=O9_iTr`%Ozao(Z?iy<2E~vi)aF{^+7*2akSk z(@i_Q%ya+Q5!f$GKa9x1LVVfwmrs_x{HW5;U#k6*k~dWMZ~6k$57%dCe_-;@6!$l& z7QYPlH}P1i7(U&07x_)-uhrv!9*uv~{Ab@5oLpJ|%$odXL_gL)qfktQ{)~)E!~AE0 zkH5(3&+_~X7y8ene{)d3c{zWN$NVbzXH2D}p`_pJ#|L~Axijehhxh=tIBA9bfkz{M z7KE>5anLe++|9MnkKiNvo6(QOZ}^zyZ>s;fVex@{{|suZEcyZBpJe}QB$V-WiVt+~ z3iyQmGn_7!eC_z}NLQf5{+IiI68HaP-~B%l{*-D{$JG4C(7!~!3g1q)n*CCje?PPT z*W3MX@|};^r%V=F?tlNw7XN>SzedD|^YF2Xe1{0p`Xoqt6?SU>KedwnwK0(I)C#Fr zelR{9zC;kFhd+%3ANMTPyE=MIy!iJwE8l+qugm(RF?@#3FAwwk7R}gZzJ&f|f{*2A zh<`u*p!N6NoXK~$$@DLZiZN2upRp~tYX5TdXRN@V3h`xx5aaj&nl?81A$(%~`q(uY z+uHv9Jm#scl z@JYU@_RH0IetGg}qaS2ls{RH3R)~+KFg_~KPiX(Al)~B5KZE%j>d%^}KkMahBf-b^ z&onvYlIs;G#pe&-rsp-~pD{k7e}y+I)n~9D-~sbLEB*Ym@waDY{4ELX7mbfW5^4V> zjsHW3u7FQrNRj$w#%B`w%ag?1YT$3F)|a~N7Nd8TB)T{#Z1>3jEDN7PJltmMTg=Q@{t^|9k0YH2Q({ zYtud_uA%W|v%5e4QO_Xxn&=1hXL~e1(DVbw2l+GnyU8{=>b@TS3XA^-`^%wr0r*JP zKgl1YX+RQn`19s(s@9(|jNi~!S8;p@nws>3bV}&PudbmVxS0NSzW$j3@`wF1f`l2{ zCVz_f2!Hc?jK5uz(T@-6n{0n=WNH-qGhlud=qHpv36?635AthKzsd9y)74_vEq{AcHdk28EkFEIHt=VdN}k2_-gE!W>t)SwF0AX|d;YuNwD1W@`> zTrs~2_!vpk5WFsx3}^gzq$@DU{-1{aHLdzr>|T#uv%w8|jo#y*DEB@2$mKKU-3$|04Te@e%u<=2t;K zHkL^%;IULue9(UhZqb_buY1LwPO$j^4Fa{QYB#7|m+c=@k9-gP$A*u|4?dnV|BT3i z^h%9ip3e0zhmFO64>`|de{BAj$q%i+{G&?tOQ;{G*a9tz&jdDToapx9GZOnUy;bQZ zt8cp2GfcL>&+gNDK8$|6qjdjF!ACr0mj5rmul}bQeE?# z(Eo2nzDM_Gs8-)ZMy&PENU&5g(Xh5zr5L(!rx3kQ2#Udl&pK+znlt>ME*ePX#Wh@FU9=8YW7Q*AM3GH zaeSa3V1J-m?0>rVXukR8+;?bvU|FueN#i&02h^9}BuJREiqBBL$*4WNjmP1%50ihY z#cy)^#r<(kKNi0MJ{lhox}*73uwTOXK!T-;;nVIQzr0hE|2eUJO|AYciw~%OGpqk! z9Hu`*sr-@t8FYs@M2>{nTYP|V`pPYekLquq*7)+-JU_#me!yM-nUcu9EYc6=R{@`H zAb&iTDvD1R^%>Y7xEA`MO;vbtjwzo5KD;iLS9C<_C#qkcFMlh~ZxVbMkz)P~@;8}& z9=D?S2p#ylG(PZ9o?lD3r^4Uz_zm)B3jUb{^Q(kU-rpqER!X#70ws&&RIW@CLm`@3FchvooE)&D&=S$D!oMp!+}9zpOv0$c+O+hewL{fBId^f64p* zQQ%6r61tK~e2gqjl^^2INMRgS(7!eZ@qdpJrzn4de;?J$ef()8`f;*D_)^v%8(u=e zMdiode=X-j#g|L%|2<;ANPULoXE1-X`q*Ck^0!t0N;(La<%x6QdvB>xI zsEsq%j~xOdK!xKkoS#83W%;nP8LIXr9PZYv#lXcp>*`MJe(+^NTlhwys{lC=JraxFI z|3BOxE5*;m@tFWVYG20mvDh_R*g>!Hd%h`jAp~kZUe=Fbv5fH@({^w4_|2&fTjr&u< zhxVxE`6R`C5tA=|Lax`ke}+grtDj-HgZvrcZ`QwA^aKCDSbQMQuT4Y$jONe4|E&6( z;)?lIurI^<402_~@j?G)?BCpL|Bpn!_MZ}bD7lyM@wdy-{Lkk;BIij>`T;utME+36 zQt}!zT9#k?TC;z&{{OcvJ`m&wqBo}LZyf(8? zCc#q0@adv?CZ2uxj6}YtUs8OYp!9P_`^RekzvM~hbbW@2j}5|y=ttxSdBjM5@R`;B zJBz1^97vvcuZ+j%@k`3V20oA)v}>&V3;LJ(&s4r+eii74k_;>mnqaB=@Igclo(Fm& zNH)_9>-$E75BlO^ft)w}%RNu#pX`?7XaA!dqx&@U~E{&I{@%pQqd<1yjS zpx5X2NBo;6@nwH(){pmF{h89Su5+@}`ZMJDO_X~fT#X#h@~^yq`34?8^=Gd@KLvbB z=%?F(cc#;i&q(+i)jm2rXmesZI?Xr9^n(Wz&zIdW`AwzxuzzNc=x-01|BQdn_BVOB zSU=<6Wd6^a;2ZAYkfvN{xjuoOh4yrF_?akzsYjw9fpti`4jk`h1w`IFFF9# zmI*${FDLy#^2-bQHO;RAe+%4|-G6{pw$@_@q7fJlgPy^`ALk z`BO?iAwJpuXN(W}|MBsp`On1uci%AmI`=>On=HOYS!aw7WpWnkn`nL&@Coy0vQ$c1 zukmBFD^OY`>h= z`2XE6^s>@TJ|+)Xf07_S2|3uf>tRwhW&aphGSH7zeu)0%Fuw}-e<BrgvfUL0JbceBp7bm;T70`v0NvQTfilobAuRXTG=p@-umS{=eMAM+bRk z@`GYWB0s1rsr(D|8H$hQFQfm&u<{*C6~$+2rq!B4{utpCvqxgrc#ilp=rwwe_0338 zLr>=p{WJL3_h`{78DR|I8$IpdV-QUG)sJLw1>b&-Y(WVB2S?Xnr~L zuY&xb`Bk8wuzoB7#4&u@P2~5X`BFXfvrciDG5)6b_+`c^dCVsTFPztxAIp-wWBkqZ zFY($Ke-l3CFI9Zj<@rqs8dn?rTo9!nL&r;Gi| z@$BPoBe5^3w=Vs7dO-0>Udrd0{r|=H%lT0BGsu3S_&+}qiw`jUSpUB>%Q_y>57H@( zU(V$H%iLU!kM(cP>oX)i;834YK|cuN%hckn4<{d* zR8f2o|7=qHlkgd}e}Y~#E5^>}^l`RdmL=!f&qXavp~GhuEwY5SiW zJ{vr}C;1(-|MUF7BQk3KJvK~dpuR3A9ESePkUV|`uF%T;uR>f|3PuBnF)H< zbpKy0_rK)< z|2rf`ihZg3%fo(|$@X6o`f-?F1$@H(u}Lid68x>(o}gzv^keu|L?GJ?f%}V<-*!-K~KTH1c9>MKous=g6f3$uEabuM~S9rR^(toIw{~z{0&qTG} zvE#!CSD?)PCpm@oWq8(e|5MR4O(VHYMJ^m?vZURP36p z@!I+^?MFfHO}?V?9sV;q?|TfjzwZG4#^@CJ8`F>V$LiR9qIB?cX1_c+qaTMku>REq zKAK;SNM=*!pr6D1D(GLva_OrQ{7fHzV| zf2;yN4=?+0ozovy`(;la|M$0;{2>v<@+XMD2tG8w3iwD!)&Cge|FUiSZ_)veWC_Y{Aw{Bhh?P9^jqenZ>r_{b2Mt>{!Z%Y15 zQ9s}_i{IRB@f*P>ol`#SW^(xx_Gb|L1(s$}KcM+lpr1m0AeJhM&m{88Cy^Z3Lq8+Q z&q&p8mhGSERUa_=`QC2}ZmzESK++Ewk%Okc$$fA2GfVpWlK=1iu=8Zo5>$OZeEt(*ZfTn`-i#V`oRB;J&pt)cxBW-gZ$bS&CB|3()=peKVg4H zr%NSYJN`S;6)3a+N&lLG{FqVs5y*Q$sY5LdndOiIw#D3vB zebM+6pFLUQ|C?8IJj$PbRP)Ck2>M?J{jn_n68iC^&#qxh@B{a@%Whoy?~Cn#Tt zztki@lADD;B|j%e*XW6l{R`V4dl>tFE%`3`m&KP^|AK$NXkQ9G>B}sBN!&~w0GI=7 z#nd%c>XWFGY*X+Ny@2LdLB5CfzsJwS@tFob$j>185wj&@*JNyK+n3b4h~JACEgzGT z{Qr9T|7rd||FX0GJ}m7&X8o~x^2`6d`DcRq%g}$E?Vn-#vFg>BUj=+7!uT?lDvA%n zW37pP`92!{_Eo{hBfclAv`3F>cVGFR<-8{QCFqZJ*7EIL+B}ZrOSb=C z9v{o=W060j^)rz4nm?m?9T3hH_*-cIdn{EPA1GiG@Nf3$Un9ZC{F)v)rj8zE{LK$j zzq}TIV~*A-ID4JtH<|xg=8@+I7H%0VRU9AC&ty&Xlia8B=K`gly@rqSw-2a(;Og-|2lZ#? z3?D}8f&FSn7UTc!7tO!T>5vzNcg-IxEZ(?28n_48C1Gd{>aBa^sT>otT87e{Jaohfx->PK)g!p8vM!t9a zca$qI!2WNyQQz0D>HhcVC&BZuK0j_w?79!!DA%ukhaCMd{HZ+tBKALXq|*iYu}SZL zXYpl?UmjBVvDnV+%k=9e-{Ifa{g)^b!}D^Q*M#{EsUK78jTnDw&mjMQM(xW{`)7zB z(>y$4v~+Zd`9oB`FaDNXcf;8K<@iYdCE-t&zszT^Rr&rEy-%#Z+^c_PPwt;_P>eGD zOXWL7nt49T*QkGS1$;vPOj@FUb`Ti37yHHJJJXNF$1?w>+L!J#!hiSd&G1QYH~ovU zS%43i+f25<+|@Gv*HywNq#uW+isFO)XF9b1OfCAC^)*5K)zJg?C9lub%Y2?3Imbs= zPyaIYp9z06W1GDJ$Unnq@F?bIxW}0M$^A19yjkc6Tut#o{BlMthov zRTLle$LdgjtUB=1asL0y?pE3b>{3d@ezY6jv>~HE~`!gVZ(`}*t9~%JHf=`ORpEQqTTIt6f z7W!FG`g!uF`E}=pi7yY(4>-R`?91Nx0FBEb?~RYT|DXFtWdEj%jecNQs(+?0zX|iJ zKtJ8U|D0f{V)TRb4D@GE`4fu;#IDJl&LcjsP4T%?@kvYK1GV}$d9;biACX44i~XPN z-*gq@lzzwJYdQV61(QEOMfY!_owj8Sguf-2Uj=-^_>IF-#qmLDV7K3YHWK^ay+ClG z`cs*Y_CH%(mh%sPQm+rg-`1iZ@jsjW!_uwcUFH{ ztNf5VoibV|nU3%O@9x$3nBD)+=5Z!}Z}KC*|J~M{Kbd}vMcY+<(bbcKYdP|0Tj_3IcwrpMFMykJG%F^oc$6(-3@;yA+?H{AUC7<2=8-WAcOV zkB7~EG5t&QW6EEq#d66t89vG1n14p)JDkUm?}h%pG`|Y;Q;;8&qTU<71U@jG=qdCQ z)3svPcn3W4k5aqj@)&-{S1n8ydS78uJSa+qcec#qVa1#eMr<-Z*x!F@Nyj;r;ve z-(@d^{jm}(RScgFlw&;W!6z}h|0cyJ+yBpoXvdoRXEHuaF=wrQhJW$6*8i_F|C!K_ zzs>aHT^aop$A=zB%NAuP&zY6$-L!uP*C_X4{Li@6MMe@3{! zTyjYqpKf;&_6wXdb?9%&Rf3COQhZ!b{NMC9_-p$61C6wQ#-at=SzADSK%zR=D;{cx z{JG^f<@#IlG{Xn+<&1us1^JU;eih_Tfqt-5ee{Dq9nDG9H%$T`xM-$F9lx=w})yexho3T=iC-pG$YwLO0zlo>->jzL1;D0XUKc^2=@^2RW&!1A&(TyJ?Ux70FAN&cMW6`tk{vV0` zlJ&m;{qm&Fs9t(zSd`H~*+G!Z)^0>_JnV(%+9!Y;WlkZvnCG(#J?eF_IlkaNB z&zSzTnBD&g5?6&k;l@|~g!-4Z3{^k(luGiw5WkG|Um|=uu>a8jfcaC*9*JGEg&g!6 zy~jUVa7m{WpR)RYKaBiX%f1x*KQ!jt@l}x@=tClNQTZ{U_?*uB%Xv871s}vOrGAV$ z$rSyQm|q3?9_}CGuv9Vm(V74OO&~v(dK9N+#y{L`vyG@W&fAU zcgerx-$)D})4y20pEUoO$Pe<*h}_TnGbCR&`T;6h-v{~Ll93DjP>$51|V2e`|?LUsR4y7x=(`R)_uKpP;yyAFa&(PlnPD z2H*qrO(Hf~{if(|y3c*Ke|g)}A|=Pwzj->Z&j{^HbQ;l}8b*>o(+uMO4oelIpH3V3 zfo%c@{|EFl8vR=9&youjC+KOsK9?@@dbltAwj7h1;y3Kyl2wX?$C^7=FKr19r9e}?>o75H00zmC=jM?aAXUDVCZD&_ugWGm{ zw$XUn%ma3XQ7RHYA`yvz_>oBbFcLo_{=g4Vj8p<7B3KlK@CYIi11umS9tJ`Z5+}d4~52BAB z`GJQYsRBF(6A;9*o@;oXTIy}=yyTQAE(-(-1PTNS1PTNS1PTNS1PTNS1PTNS z1PTNS1PTNS1PTNS1PTNS1PTNS1PTNS1PTNS1PTNS1PTPcI}msj9>p8|;+xIg9(&#J zT`Q&^879LWo{T?a%TJgBpMAibziP`f{oeN&!Yh1@YYy~rhv~vx#-F!R=yNIbd#^WD z-FEJz&~K&C=ThkR4yCl8Lcf(lpG%?NV;o2NpF+QtLZ3^a-)Jo)y6@t?G-Wy1L1oxr6o`UtE4rHMxZ>))9mrBo9~ z1M7ccf|Tcz6ORSfzozT2PrN6vzNvP3f>pr#`M34`KR3Z9%)7qfzcRrp?p?p8`Oi$e z<3RUcns{4a{Ue(H(O~=x+k5cNK>nuMt8g&=`%_vfrjL8Z{Ji#C*5@#tT-qU+1a@se z@hkk$7`Tcq4y5n5; z_?qks)&E)N`WKz@pW^Eho~itA^EH`vy8aAb+xz=H=lYMF>n}Lhf5q4Iyr{jqd`%$K{(Wxm6)vX>>yK~qP2Xi-OvDl&wp6QqvGM$316qsiCZ6D8>*ATG@k{+|lm5=G z;>u2QUWV2Be3Sl`v2v^V9JE*4twtN@+~jlP;;O!0L0X;usO(C8wf>Af&tuz{>PxM5 zeYK61>i9Rm+*)m3T5dO*t@+mKeB%NZ#`C2*wuR?b69v6hUszbeHn41?-N16&JJ((= zEne$xZ1=ABx|`;@)!Xh45V8Eljowf0bW5$BD?ib_x;^|Gu3d%tS{GLO{q^p(5`Hb6 z-R$q&Ea5%VZ=>|mvE?TLRy$X_^gEr2((1khxE8fJi?l`ud(gjLTIg+VZI_xa-Ry7e zY<5fA{Zf0g+u6Q>{T(U0)JZL>`_b6h>}>b?8`SQ$ZKZVVTIc1hCs)=x8ynd9z1H!b zu5Ryi*7r#6HT8L=v)Q@P-R^Fd8r`j{o4uRFfbiJptiQa~+bUh^tnYO3e)zuHy&L*2 znm>hiP`a?$TkCC<^vz!HZ(4Zi{<(bI4wXUre0O83zX@RKV--W_ZLAGs@=@>f%$~z=F#=H?DNC-B#y%cl+hiO8@50x&dopy|V`JH9W8x z_&)j=IKGa@z-8*!H?mE+o>IbXcchqgCe9Dm9@(?=b8%T9@c#sX2lcvo#leqodM#7v zB86^)D7PK;kZIVZ%M`jup+gE?y(PJQLoGfF1PTNS1PTNS1PTNS1PTNS1PTNS1pechnL=SDCW*TJ;}qt!1^Dbd^bZFhTqRk@-($K|Mf}A zPHzYIe@@qLOulzd1pfDL69(z|#$s!JWpU|3yBtl^w)zwJc_J!TDNza_SH;xH6EkIQ zOMLJg=9~E<;dJ*j<%eL>JkJa5hb$HjAs_6OrIcp9(OOzv zXf9LU8;{R_<0H?nb~{`BjVKL?+O#eyE{anz4)DPKNGwn_@gIL8=q$fs&H(QhnEJii zz0xOgd?eBAkK-b7R#1(Y~uLPm8&!ljbYH-P7Y~hin@eRUc(pRoC;932d2qH^LEV86k1f*a_A0 zv=dr8;C%)Gd6ALW?dFBV?wUp-<``QhUnJ7(L^Kl-)DVV*m@^274=@sNcu+ge_10e0 zCUd}I#x%_qm2zA=Q4&sz1}z zU-S)NkF-pve>3($d_VVVH#hCTmWlNUN2K{_N19Ajsx@K&;#p7a&|Xxr1y@fp5~bXb zz?P|>BOH_jax+Tk5z znrPd4Q7aRQVZ7+qIG%X? ze%T4-a`Z=n0L}SG9RKfOK0BrPyD{9pBOK$e|AjICra6OL%*{)!2*!&O zL^N$|vkJ?E2qSf}&e8`*b3@{oMgo|lI%7Hd+U7JpjAl*b0*=2PFRmAlFcODtzjDh7 z$uk-W%Tc_`a?HviRU%`X!B-}Y`Rj&8!g5q^vmAY8BF#=zW;qdbDJVNO!~OX%pVgH?B;v7t2IGIpV?E|5yP-%p z(QIrnE3-x>!h8q3Vtj`DZ}uJeN3$+R@Rf-)B&t>R9V^4*|M4uQ;;fjwVxQ2{dC3GO zDDbAia#YtXM_(k;w4=&)!j*|Jk>Cu7vg7~T*9VcvGOov#H4-kz%q(V&vt!DUiG3q0 z6V3iDYsKI38Iwy%HX(^d_eIHjzdWI0j`G!*qi0<2Xa~Ns8RwX47}u9Mi|)h|`yydt z%&(aK$gkRdHF85@K@fDxa{MpL(KoV6MZ(4t?O{8yFA_#3F0i(4@>z89iZL&D3=+&y zSdQM>;n;~inW%6kBxsHae%K(OB5S|q24x~kJAs2yl8Kn(`z=RbnQ$Vj7>TID(RNTK zL>xE$iDzKZt|iSeCeieL;m4SEf-U9mcK!9f7D;0cUp82aH?vl#wY>BYTh>6i9Fdrf^i_Bz zL}0$2^Mm4uwGS`kC4KOMMnaBo^hF}gB2{XUhFbbsB;%zXV+5YENSqy%i7ZDrz|kyo zlvT?yGbE7~cv#cF|X)V%9UNWKBUo%JeXXfaw9cli$dXijIKt5z2}dSQ>apHQ z9P8P5!q-lic;X!f0re;&0j0cT0$Zl%4@i1UQrk(IWX;us^rV?KcQ4aO6hj`hq+2+L8%9DT=nX-HINcqN3R z9ph!k#6K8IDZZDVQ2t{*m!tRiKTSKTHIqB`jxkMS#j9+^6O6=eZlhjonaqT8IU>!^ zcQ~WoSUalIX8iB2m>N$e)I4iPi;=))l5&DcG`cU3JR!DB6-GEB%@2uGnXua7n-elI zCeJb1nIBrGn{?MnG`cSjB(PlRn2w zP3ahJiq_%qT<@~yIvf+jJ!lY6ybb{1Ol}s5*Jd$CY5n3sk)WM1)8%PIqRP41pjmIb zLIdJ8Awz4uv(yf#3A|~vVT?UTk7NV=WWuq{F%p$BuM-NJ&8l#}ew?)R5i5V>uGc>|s?eMh|+Dq9d1njqSjAmthNG9aDP$V2Xv4_MAuX+#C4)q4pA2G%K z!c543Z_ZLXuw_z?5span(+($w8$g0%xF96p&p88PSF>UcD`~zaiAMKD$GCGioJDsz zdTU1-647*|`y+zpdIe|4gk2|;pPj&#siPwtk>)28j>U{+q7rdr6@-NRcg~K*an8^x zx=gd^6^%s9F`o7IMIucmDplh6u33h$zmzLAy5 zgs{a_HMW?$d5?O9%P})MQRTJX@|mC*^B*}AV%M0W*H5yJNi^lN8k=2Aj zKuuaCN`pvbYB4`xWP&+@UES)91bYaqm*0^%{*S#>b=u5kxoa-=l|F+xuWVL}j5&_~ zlXNbLX76}RJ;auE4VNPl{q!)+HrIHB6E@dt*Zs?zj0DDT1JP`j(uXY*5+fYFk#O{I zR*!IIafDNjhyeoYxk}CCW_d@Y_z)wJyO&ZfN9y`P-U$&SQ8~$3>Y$7y{HyU&GM?+r zd%fNWM{gt??TC@UMc*V5073hD%FA~FX{QwfYu2%*54*4uw%8%SPi|KMic>KKRu8nVOrY;bima1pbYFCg8ExYl3o30n#_woB zS~fBf*}dMr7SqfzeV!w$KV!=Y)!e-3ltu!Wqp+FN?2wq^nH66*ko-iHbdMWnTBOHB^aAZQi9W&Bz z$K;s{XRJ3~c1$TFql)Kp;C601lCWjMZG9=#7GR; zi7exK^v|Rnqa1zLjyb*~Mj|?CkO-UW6{lDh>>Lv;O| zV-6Hq#oAF#dE3^$v);ywe#h7eyDJ~^^Brs_6myjP<^liJF=^USE3?IPqV0W=FusF# za!EduNgIf)GPRiOJ1nPo&$q8k+?Vmc`7g*rtKK8M);prL-aK=meAiqU>HCb4K56$G zquodv*Co;L`RHTJv7WU^E=O$RKzg``M76B@NBNuz5YZ8{fXs1>i>qWg<)Mkmn2%cEy2>U=STY znMl;JGMI@lzj&sELe(IRB^N-}EbmFUb2}`qc>kuE&M_8~vY6 z|7PRy^|-Q;dN|#@=RzA3%4TOte3cySdreuM38e!BdV(7Dhr>Vzq^hW{c6sGj zS65e4Q@gypR8>_~QBhG=R=zsAl9H0FtgMWTjFgm=xVX54goKEQh=PKGqN1XZkdVB* zynuiJ2L}f)FYnEpH|6ByfVeOg7M829Y;0`&{QP2KVq9EYJUl$CtgLM8>}x-^aIaqi z(V;^#(^Wm4pzr`yElnU6b8&IOlpOv0@87fYbE3%L^_^|CTN;X{Mw`34`OR-mfB!;1 zdo;N?ud1spXKk)zgc5VIlX0+-bh*Rhe-DK51Dx%cBZ7c{dllX7eveBYb+pcZTf0i9 zm7OyB^^1g?ql}rcYG$(3Z3}*Hx8k==5mirK^}qj0SOwf10AF{&&Vo8As;0MxNloe9 zUi0|i>CBV~VY2&+!zAhCOL)hAE8ygn#aAC#x zGa6_k4fF;-PwgHaTI6Q}=7zF%*2*Y-`=SR5>S`&kUIacZy{@H3?dEXJ#;jqm|LEi= z{LXD*R|ko-_|6YwALhQgmle=D+tOPZ)7e`xn4*53p2Cu2cv4~kYZJi18t`yJ+E~gO zqvC5SnH7*!_ne@jLV&)OQ%N2W41hx(#vXtoODrLEpE7&sDlkq0;B;RfFJs5^0#X#w_ZIg zK(MKy8Swkp$zQ5%qRn&ilcPT;KX(^SpVFV*!VC+nxxo3^FLCDD=h(8WdM z^?5XL3NcPhnlcVB!8A9hOtS7#)-~phKew+Wc^UmMX!k+;!<@vd`FYme%Xo}Y9Zz?} z(y7wk<-@VW08{O*F@J>8uqWKiWMiglbqe~!=|S9_vxbWv+~0USyob=%QjGUk ziYiXfTlhpBR(-0Nc!axwh5sZs;=SRTP#&PZBfRc5vC@FN7fsbbA3qFP=%qhiqr3!Se zJkbt<+u=}nPoyz(``QDwaMTSb0r@eeKLA#l32Q7pe&OFQF{M&HkB0Pv7x_BH9tK4A z&{iu#+(EhynSlmU4+4tM-Em}^7w^!{e51h#C0zH$!s!ph!N z(zpsXT&l_@_*xQPy`7UxM*6oG99}c`aC66eSB|l>?%X#gdQ#J%MQ*yLI(?2}UgM8Z zHN%9j)MSJLu0g(@K_GA3F`aPc-su8TXuV>FE9oxlkK_jwX|@;`Hh2kNHmk<9HN)Rr zHC^R=BV|17cJ2=9Y(lMUS07bvKgmH8Rc4+Q0NTrL9|zj2gr_O0b0(^34;jfxQTAeJU>odn%BeA!4+&xPQ@ZV@fqzR>UKB+_}`8TX!aH}~* zDMF_-goJ4t(b5y~IwDbzgsCLJD#}(ow90rBA1ZZ`9VE4wwje@9=UC9>L(y&vb;R4f z7uuT3pD0O`kRXDH*m$Jl?&$3>fxZJ|%`?pn+kE$!iTDZ^G*H`FVxUo75=*Rw<8|x* zRZeL9^DS#K(Bb_d{#q=*iYmY5md=RC|In%I%dMR$K{4%c_fXR65sHuh+|A+rOD<(P zc3w7G?3sdo6DtElTX(~XRcl)auOHINn=D&uZDbR1a7V-v-#S64%NaJKrCps*Im^@w&e~8Qho2uOuG>ZQvbHR(_#9gY z{gL1fG4ZS*ZjL<_USng{l!&br!Uv>~LpPv`;+f|q*qF@8w3_E0;$-5C2Q@u%>R_ro zucU%j8_8w)l{quC;ug#gh%6HVkyO?(o+bZ88H^rzS~FR+I#D@jFPVT1q~E0r5mk{mfdDNg`6&w6~oRH80Os{V2B zM>a$o2~|~i5Y`-@{40`#)8$9;FF}%#03{}P{@yz`+1M7YkPpfD41)tFeqPpWO0CtfkCv$< zUB2bvjiDbK`^{vg{bpHgAa+Dvnhb@03-qI3we7qu=y^$ZE3d~ff2zmV7w4r(s#gpc zB>ObqwJik=CIS>(SVXA)BT*#pfe_mu>P zb>bS#rYbDx4GBJBdV^xL=uHQc{-W@HI%+9za`eTdjN4Iu%zHeDaX^8jE{h6!!eVjk zFtT|8#Yumu$|t2kmYVD$gshtq^d0GBcD{wX)ehe9e;X{!4o3=7{=HAV3u(rc5^71D zX*WNJlW+PodPh2PdhN;t<#xLE0qbG2cHyK{5oz+3)_gM!(VS^q?g}7@`rB!SgajpH zFdqIbv!`%kW)&NxI<7WuL|s?8v@S(TCWy zjSG&*(4&y?9XFHySX_WzRbQeu$!wWRegDQGSQn|ArO{`*dY5lp703!Hpu(~gm9q}`@W*a>+*qMu)$XiCyui(YD?y7 zGm>EBP_HFwDAwtlF7Y)V;pHkf`Hi09t9$#NBzBeO_2qDXvUKnwIXv?8ZcPQgUdT4^ z7xmdSy8LHDXV&rplcvpGtGwWXqz;mYZ}D&;BF^AC+=M}vj{a3 zR9Q>2{o-qyRUcHuF~9CW$V6W(bHg7ZEZ&QSz^#*jZmiA$%AW|d#agDXFiKN%)e zGe4T@Nu9gvnv_F3JrUB)B(|t^BL}+tQ2M!@kKm4&fu*|hGNJ)l_h6al-QHsualwRA zN{{t5Z9g^Wb6@EKL~^*9ohEGI_AJZS&!&yZ0SQ?wg~h2q%p} z+m`Q?Z_{6bX};uY(M=M!+{8)SH$qmx(9v7J!y_{7j}uCkMd$fSbW3h=;+qeX6yx^E z{Ht71US!JEZ|XHMCdIZ8{T_@)XpPb0bSC~H8&V6Z!3)*@Uqx6y#kQT?-}xQ(5pGE_ zjPU&cAj9dlUVey)I$6n&=srIgXzyM`{$6~kN@Cc0Ib!7ybFkoc_5Sw`JI`xJ$DETb zD_z_xC-OUAi@CfwOpEYSpJ-|BpgG>HM3r2eKzb89_(3E{wRk!O09( z*{<`GB< zRgs63_ZRkhUyqO_R_t{gxtDi~w1@mKi~W1v6O~H52ys3g`Op>iNp1U0OE5JxPX!9C(y&wo*M`qMj+*#R?2L z?q~fm^U49@NaQnYc>`@T3U0U!Z5LB@AY7e&H|V8(d#E4@Ww*LPG(Lsmgu<;sKvx#> zV5&#-dTd<=uCi+3qKW&7p;iI9(P|8=R;VM;*Y^WuNZWP z+n?PuJ{e&zfM06ZY+sHj6g)!I38Ztd()J+0REU1kIXX`0_F*)`10eyuiV9jeQwy|N zb(*rVrTwiJohgp4#&m`$Um^r`{k0#;q-1GcWmxJYI>x83TGWQs3dYcu&O9UxcyYR?W7Ap5X zyRv}8gQw6BE>7(W->PeQZVB%WtqFpMzqHRFQCZ}XE9A)VhFdI7-!$7l6z`WVe0AKG zpi}3#155v?Qf=B}wC{flo&DmvNPCY!z!IY!&94+||1;h12@dVfkGEJyWu+HL3q39z z_6cLbViDn|+uPeC-Cg_;SI-@Kx%&LI_xiRGuc8%{&P&#J$?WG_hL~-46-Gb@&q`l* zcHG5UeNZ-*g5B%Q)(i$YZu+|mmn<+0x-~dN>Z9XLtUJyT2ieJg+mqjxiegI@-!kug z6*d(tyL0_?j%j~Mf3FP2{yi``%+T=allYVV-d7=0LCcc9z#U3opzutj)bPm3tSsj6 zu4Iu)OjT3QAit{`Vd@DpSh@SritAw*!z1Lku>HLm?y-O;Fd>jUjIz%eF31V;}8CqL&p z8dOiDimX~PmOKK{H&Dl!awV=bQ2Zd(P^a{^?F(d$<0N9HPzn#ue)o`I7ct1_^&F$2 zL6gt=;F5k{%hZv|WcvCbySRYU6mN9wOBFSrbxl6_XPFnO z+t+K=RI~4a zUqBnu2@(jbPxM6D?ltpac81Eagn_z#@QXN70wy-KrG+gx{^)VvTBOScZ1Yy>%m5a5 zt5fL2Ehqlk7+GDNYxuP9x=QN8z{xo_Yop$)37PXFZwAO+=v4up)MIA?oO##(zs z_+C9dui!)3nnU=pGgWv4x9osM-;E;h$vAch8Oha1R*@YLnURBMrGY>4!pwS4m*-CN zV3YDBixEC$Lbm2FhTIA%rUsFgQa<#d{w#4O2+Sae5{dXN1HULXb9$bM@NpO*>OhO)1d-C?Kpkum+aa{mU z>9;Ows&|^(f%Mwk4^&gr32n6v^V_iu+P3#r3-J;cXN+*vvLxX?%F&Oma9}3~`9cpl z!WN(^stU*DbDPp{B-;@2;}9M3pQvSS0sOeF@xX@n`*A3nx~Ss#S?&&jXXsJNCfy0m z2R~R6i~F#dFNBaIV?53TI^{*RdPhkT7Mdlu9X~?AfvuDx;{Rjdm&&3aLa?N+d~A zNku5xl6@b`%zMxIKhO8x>%GQE{p$DYU*4I|eV%jAz3<)cx!>)4Pp>}x2c-?at!LVu zHEY!}3?pKrVMKL7fq&0pipS*f01_}o8b-)lm+IAv}#tNOQC#oCu$mVG(pti+~9 zR*2jvkE`rGyW9-NGhDWlm3XF%b^K-5@dvTIWPY(0_<`)pDRToY>n$Vkv2x1RQ)1P7 zn=G#WXjb^$)47hT?5?+tzusYPLat$!Rd&~Vvr0}dvcgBoIY?5;<-Nn*>ap`ERD&XnEtvQ7J3qRzAd4Y}(x=kIC)j4!z@ zF0^m-SvQyUS>ag{9txF5>) zG5O0`;iFOQ9FvsoW3tLwt%qILa^YTSx?E+iyUY!=tS8&_A5%Tn7I;jvQSWI!2*0T> z>v-MeOL051f<|+J$5r;a%UO}rjFzu2lXYBWuej@MmgMOOGIlKnhM*}ivH zIjes&d{VZ`IhhTEvakhk>=75%&qk)FkU6y+kD)rXAv&z=J zv&#N`oc)1tzej_yT~G67*hdrDme*aDeS~#2@MrDADqH)o%UQ*@8ZBoxlXa{zi-uRq zvzAG@d9yRy54YcK))#mqc#S+wo8brbtj5M&<}sqx#wv!#Rrb2eS&8lEpScnKG8&sR z^EEqakMv%H`*fFm0OnR2GIT`09%(}c_UqHVa%82Ry>1)W zZ{XmxN?s;Vy)^mE2i}raNEG{IHV>OueaBT+syFX5bV&OigFAHVKd4`iGEEz#;XktmRz3euXX8`it)S`!j;c|5dyJJ=c(-G1M+ zj+okGx*SsnOf9*(mw>-eOu?8apq6I&lF>kH1rzJJ5jF`d^REmhr(D8ShJb&jKFw8* za+RZ9^l6E<-K9A+=$_Hi<2wp)&6jX!W%SJ|yT;EfIGi)GduJG95}q3Qj) zjp)IajOP+^Wu^Yz2H!qxP+FNxtI#wPuhxLHem#Z`?J>BE{hBqoxlDTPnspo0ytzzM zT(Qg=T*qFs=fD9&vAp$wJ9`Y^1BF$rO$_NXvIiE_ty8n6{LrfHIdE`~UV{e?8_*rg z%J!5${G_9^O?%US{T}|nd7XU>fBm7fznD(;@{8$YJ6udB+p^%3tzkDLW$-~}NC7YKYq%)p)u*!uTQrjX(Qy*-mlw$Uc>M)O)Jx5K>DyD z+|sSxhV)49-e+)++t}`;^&2`EmH7n@zc|r%*pQ)pdX7lD4eeA9u6pah;pzPccJGna z6Fa52!iu~24Na?Evq3$(qIZuzy?PH#t6!T!1=kRfFkm{c~ z^BJZPukuujtJ1Q8zpC3Tt|=O!VbrykXY{h_8(eO2W*du}K5jA9V*a%_ZE-7+ z^bMoUPuBcZmMUnpf54i*j$bVN-FS(`opLO`Sxh5_(e*=XzFR$;vuwW3X8Sz4+2_&C z-fp*N?Bz3UUTE{D7WW9TxX-&be`fI@DxvrrddlKq`~u@|qu zTKuR8;D#~rHfw(35S#7#XFFN*lTTRu0woRny+8vW{-!=_@eF%@Mg?nr)<+h<(az?Z zZMKj1jeG3*M{R!5=D9Z8*YS-t_WX}F@3(k?eLWUZn!w-UM2nZ!v-p!cEM7&a2Y+iG zw)kuNK7UifnqP1KZqr-V{7*R+Z?&JJZCTd*FP2(q>@H-@@4M3CgA*-27H{!Md;a9h z*1XR;K94a&<~_zcHm|VR5&=ENPJ8~i#hzfBDHY*8@|3f=uFWki4%ujNCqiKk13wY>Wbo9*rQ>2J;Vx99uY`x_8r)!$(~N1kCrt@%4^SbVqjJbAL` zSo8N=&#!09J=XlV0Tw@IJ)fQ@toFw<;Z3XlnVT$r_5qupv3aJ=3vK??=I?F(#pWD~ zp9`_MsLkbVu4l9LUV5H;)t+Bu@$@RP+aTJMeL#eLTNOD$}++857Do9y|$Hrw}UN~ASECE4aGHaD`ljm@2G?rZZ% zo5$Nc+2%PmFSdEL&6{lAYjdu}QzLCowz-PUjcjgXb0?eo+C0+c@itGkd5+DCZC-8j zCY$%#oNMv4NSl*wu3~c|o7>pj$>zQ`kF&AAp&kF+`2<|;Nfvbl}Toow!F^GKV=+dSFkIW{l0d9}@( zY~E{guEjGVZBDkiip`B|Zew#NoBP^4(&q6tPqulE&5LbbZSy9Z_u8Cm@ytk@lWneI zb0eGE*xbqHzBZ4vdA!Y&ZJuNEVw+dnyvgRhHs@OWYNXA{HdnE^k0)i!Uk zd9Tg67SD>bIoakaHaD`ljm@2G?rZZ%o5$Nc+2%PmFSdEL&6{lAYjdu}vmpj$>zQ`kFQhz^2{{~>uN^Ad8c$EUKcb~H{$g9rW!`9E@-N06w(DvwTu{D&{W%q)&)&< zj3`~uRM&{q`KNkDgyxhTIMXxtxS;#Vy7S#n))#a?Sy#~gWL-h`lXV5%Pu3N5KUtUm zesbP@PnGvnJWfo1FE~%|5y75}7%g@}s?_!qsA5z& zF0bAw_*yt#o6$ybU7^4!NtZXyHzn(G#`&fcUDi0?R6>_A&Nr3RrHz87RGnrNG?mh& zjDn^#ooW;`1TbWd5w`bQ!@`g8c=b6nszcC!+F&mceDzl?1O893nVL@FT%pd_{C@X<~iBu7VE>&KKNF zRKBn@TwR?mc)eh@;4Hy!i0Y)b6fU(cBiK&xF2NasYl-S~a4N35t|EB7AgpbunJ4%o zu5x}+Bz%VJiOBy}=YNykZ*cy%HvijN(kQLnQwgJtcBT}gtj@kj_pCFL@uumKf=iO| zW~uO#B%PH)94ELY1+SJ$FiE;Y3F32tn@ix`(y1khw+hZIiML95_K9mjr%qFjNq1EuyYH5 z`Gv&%!lYa1%rBg}g;=++dok}jLhFHbAsXw2M3oa(2e(1D5F9VKmZ((m+7QI_ErK(N zYLBNDWHwz}aD?D8qRNe_2_a9n7kpmuXNrTmQVrrAg6|X6$%yKZA9ZWNiGrIbY3kDH z#J++Hi0XJ)HHfD=OYn(m=e9MTXN}6b=s8m*UCgLdKt0#BmKD7Ge80Q!Z_eFbLBH|W zoxT2r>%;Li3!JNUozA`A|MdH+<11=CyQrb-g2#e8g1dl6fE$Bf1Q!D@t)TUhVus!Z z{<5f{LQNEAVL?T#Fb3S({$W3GBg{VmE((4d>m9}qzXPuU=YU^BeG-=656%SN0=^a8 z5Ihc?0Dcqe?ZNurf|p^3o|7m%hXtuvVF0)#I1AhdoC1CV%Xx(FfIkOs0#CyagY!_h z3oDezidTZ$g3EyiRnY2G5DL#>g?0GFGVpBhZt!T-^V)O-Hv*@FZ^I9ALr{3c{sDId z7oGkIj6JAuUX<2Yp*nt10^AYv2eHCv@W|fju=H#w`6cs$=6O%`SP>rs_?KS+>ZjS^kDk{Ac0SYCAFKcO?d1`zyNa0l{{(r3%jsmJ znoclk>u96C4l^3-AfqXwK(oUPUC5{jO({(*W0j4fVveN=mF7>HH8YHG-M|RdjSxAS zX?S%L!=tmk%fx>1Pup&s-mh{`96h*q*NskquJ7BI2h++ItZS%tG-#+V?qPnu-E8BbiaTRO7={aPdOQCdf{Sm4_CFYe8<1CYs?xX#X45UW z4JzhExeq~z5y5OQRtVGeMQ5dcNbquae$;Cz6^&wA9qmce zr+Tl17%LBVrEy+Oj}imo_m#y&c>G4%vdhN^oCM|UzI&d|M4a|d3R@N7d%!^{S{vB9a zAC5#ju9}&VxIZfL=P0`3#z&)FS2gmYai5g;^BB7M`WHewuTqYZ^o&?|6IESB(jUj6 z_19O&eg2SSsMGtL)*O?;$LS4SB2bT~epVGuh)jD|WGAI~6&A6_F< zdyFO&LA>{1t|69YV9mPt6+asMi14FAp@knEeth^L;s=QzCVr&&v7*VH&J=#Y=!D@1 zjfxJPJC0K*aAyC^dzR~|&@p?~+ImJ_@hitJJ`{`x)0cYNYuh96bo%11es)s~9#LP) zfaSh8Jg2_Y!7Ei^JgjDHpU)HV2$&70<|N^6DlBW0GFp~~U$GUFaORRIsP8G6ToN_gy4(;uqf2{hv-tEzaeRfk>ac(hfqc{T8S zs+Paj#G`5kKWNs%L#|4FS_ea^N+B7l_W@?pr6z@S!wr7;qCmUBt7UGuDI^lFnfcuf-e`Q3%q`a=V?$MZSMLssD~-T|4p-(ox+6(=Y_~Nmfr%SNBgE1OkHWBe#o!iS$y z8yz85z)cLkSPX&*#}Ne1kWmT${CjBLS}Q0M!aX(LOTrsKK*&42;-O1JDA)Ur%)K>< z-Zh{4^8OkW7R?RWl_(sVYloNS^WjsAJA^PS!QA~|X?~A=>iu>eex%Lsx`gnfZSJ@u znjdlV;Qg@_*v$jO!uf$WclHPtA${ZZd>Ga8bPDEX-V=o=lB-{DrmUepsYC(XJUImI zAf)aUQ+HC&7w|rrIW$sw!Yk;@NEZlb$-zu~Gn4jz5o$+~EFH|-0;+SP0KSZg= zj2iq)HM~G(Snn-W_z?-dWeZ(=X6V4Z75I^f8FRd>*1jY|CCw5jv5^a}DtzxP^A z4V80Ers2C!o4pztx=WDO_dr8vm>aCsL=SFM!ZzHpnRwOo{BW(`hB`19PVs(F2M_z9}4Pa}SRzbW(^ z>I9?ns7^4phMGHLWN3gZj_(`&&Q!$t72?;3uQ@GB{6f)+!iKY?v zg=iY_YedtC|B{+U+*i;vLOz0~@p85YT86n|3yHR|HdeHapNfmNaio%H8)lm{vDtp z?+~;YhCL*RrGT%v2({tSE{!8hEMTH_ge?0nue~|GdYjGzvM0Q}V8yzPTXya}l#{D+ za}Mv@wQcj7kKUR#@%}q*Xj(2R!8jFOv(vpVytn=s91TY{y#Mr|wiQDoA!yWwf8nRM zMqN>oEm`jV4N-KaDD@&wT&d5bCey&fy8vRm_~{Dly{PR0|u?;Hf@rN+Csk+=6n7`nbM0 z8D1|h+DhItiK49>8yX^xh3}hFT~@OYVT3mE*Z{A%5mumMH_S38?+Oy%!J2B~J2=^o z0*zW&Omvprttr;1$Ad*>`6NkHmR~R7`=ES7`D&<~ln{^}6w10!y`fZUPF4&9>APq! zRbK>!a~r3tMHptrqg&x+xEG2^#v?nRDXk5OHGJMyb56k^lvfLSNy3015c)H=7*v?c z7b-N)--p5!R_>`2FaY^7N*HFbaYqoF{Rr%4v3DQBb=VY98YZ-dauT5}Wx~3a_+)NT zt)GNGQgIRVku6cMAGg_vXh_w(s$quQbpr8}lVFW5`vKxEw-a8TcLmVlA&qB^PVDJ63=b`|N1MCE%8a~Ag8#a=>N*{zh@8MXuU=P*Z+3pHKntTG9%?gMu#{N zN!ek|ApO-7YXE!VFaUt|L`ruwCeheLM>ZYXlxR^=TAM`(~c`^-~>F z=uh=+d8KDrI#YccpU4V>9(0_+ND;S^{mkG;{B;p$9dD3s6vzxvLU!^{aPO=ZFFRJ}ZyJ_w51zq;aF-8mcB5!(M zF^s@0Kk*1d3(V+#8%3G$cG|#LByT4x7O9zN6AV0HumKH(^ls$WC>V$2Sje3iB*)X? z#2>k1kLUt+#~e8t2JJeIhC$acwFkEc#L+YyFNoy{p+|(C5o#gSK&W}}ceE~9u}M~3 zQg%?_Y^?r{|3B}IIlp%bC4Zm!aql7x;c4{cz1KCCx}SM!Rx`F1=K6tgbWxZmrqrX^ zSuKU793e+*I(S9+|Djtjg@3iF1ASU*Wn-G|)LRwltT6K?L`$^Mj`pGg%quA#i(`Yl z)B)7TsS;>(=my#@)ypxW2>jGQB8+l-(U7U04`JYf`Xo`*fgN=vs_5iZ;==GDpa_vZ z!|8WZPk3maR5OA^CzvVGLu#rgl4AWN@n+~J`GCT3i$_)8Zm9=tMLjrHQ~Vk`Q^c>a zHaf`A>l>oiMG&F~yX|hEb^l;^AI6`C@^HF7Ohx71L1|k8Y)3aAfF`lfgHrLguSso zRuy*fHNj|5^r$9=sdH=c2CHvE8)FyxUTi#nf6hNTAJNRnc29rw_xaX$I{jN#2P?qJ z3A7^fdzF7;Kvw?A3D$BmgShff{O-9Y27Kk8tXsm{VofxK<)5;HM;n1-4;5L$ea%_U zf6Y1XzUD0Fzvi5GuD8SauQ}(f>#m1MCWGdJaeQj@76$0)xq>4FTL~8B^P_k0+pFIe z%oe;tFojQ&-c9G7UL-h1@Cw01euwooey{cGf=Fsem}iV@CCshf;EULD2Ly7 z{fXeCg4YYC@rg6{NFee8!Mg>U3r6Kp9Qcy(B;f`^Dxbd{m}X-dfT=E~U|x%}`%L@$ zPy72$JAJ6F$Ye?f?ulNTf+hxuxhF~!`6tSt`KPn{IWY^aUjuTu$REIqjZFB{} zn*=8aeo9n1K@@p(b-~*NpA%d|RJmb{f7+Y62p{209z;Tlsp z!9~!a6btKs9{}GDZUdfC1R-?_+x!V@u17^NEO-HYCAb^-A#iyxI)v(9v859b!}M%a zGz8xcz7w1dUVtrm_G66$9@NZ3O*Qafa363T@T*uO=m_?;1KV1JinO?MBoKFdI9;==4w>|#0rt&%M27Tks#IRfUWc9|ddS%4n=6N7}oXceq4;G4`m2w4g zA=HQ9E0~{SP#=ab;rTck%Omh*%+FD%kHXinAdZHF5{cz81#krFWAVkb*f^`*4_xQK zb@o5k|J3JMwjLO%Q7;(m)>%jLIRHGu$g}j(_zXwjN$nr)8@9WYGQqz3}=QH+3g&rg67HoL* zV}ctPxqJ!@iE!}Q8pe;Fg`p_JT1imC|=%Litm+% zS1vsKL@2`@B2QutS+(EcoNiY}`vw|DADMX$GZhV^l+0|$r*8`s+wVfyBBbL>_Z;RP zmbu}Wy9#rc$lNE`e=c-j6?{0Dx@x=+KV2Gv_Mfx56IQ+pb6sR^Cg!R`B`&6dsNM!0 zz`8pS7W_G9bz>}@jJZ)V_aJwJxw@pcVO;X znR^Fw6(S5@p=FlMt%YMOLa>Aj1Z$Tre zYh&309Ol!U$;M0{%(Ujr7nmuDnXqHf+>;cxzZRG24IDuaEEyAP7+u&2(CWEk_28jv z-#xK&pflxnw9#1SOzxy>`4e(E{Vkl%g$$B%CU@s^8vLAz;RNo9W?W~Y(aD({vCv_+ zcz8Z_z%Bj<&i~@R|47sG1N*P((hL{Tw+p^Q#2ZFapuSvig5V~;9J(x{OLTw1_lW9b zB&~(|3c=?Ex6^5<)7fQF4;TDIx-a_TC4buug42m=pH~vKH4q#txR&-tEnOV7m8Wfi zba%`Nrv*~C5qwr~8($_}T~e)$5d4&=%)&HM>du0*#b9|PgfZ3{kqf{HfalU;~v4)qIRexQ8Ic8z9Xu}$w*Nt z+6zu0sy$xOCK@@KMSc@r3{(J1;Pnf@jzCP6z$rUiP#skYXStt$Pn~4|@c)MU%U_p& z{;yic*>2zp1g-!ij?K`c>mq$mgbBSmHw=PV9n`FauyzZ03V1xYA9xYC5qK9?G^4O$ zQB-U|MHYA_cqn)Xcn0`VFcT!9BbW-ygDMZzTh~U#TyQt=Nbp2(EATRKVemn$#}q@Q zF#j6(O7IMWC<~D}D`5#DeF+ZNayKM}ez>=VQfVUKD=8ip#)BSTG*k z4tyF>M(`BR<-=AC>Q0lpZX z1;i}>KS|(qaUMy2Ein>da7;8s7l-BYaJU-ml9n69af?{NVwRi4a=W_Aj*FJ=T(>*c zaqs5mDz!O-3jd=D(}A0UC% zcQDIW&PAaLP4eJjs7TC#J$WgN_YWf)Ef)#yRFM;?>42I^;K}HQSV_UTxd9gc#fV!| zMX=;XENPD=;RmtgQ7m~Lyb^pF*2qB*7Zt)Kl~D5v_y+LJ;BnyM;CG>vu7l%rEBG0> zSj|u@=!^vw!Sv3y#e#!aVIX)pcmnuY@EkC+^?m}r6#OGN4SXEhYfv5vF{s!AE(87q zTnjuGdsz&B%l0Jtx>8+a)ATJQ+)W#CcZOTf%8+!*{2xIXw%aBcA8Ha~3F zGx0I=5NCs%f$s)i4!#q79hm8cnV+~Tcp&&1a5lIlm?xG2egj+yyaHSV{4+h|a6YSG z9~8!&s40ylUx1r~7l8YMCxf2@4+ry?*VAu(7#FpUL94yfZNhJ*XIQUgsi%FBlY7_` zzg3>8Q!OpZZ;@w;eZNKCZ;iLC@_vgv^XEI(ct87tbu0_L+d1x(-OgL5oZngQ%%2;y zb9N9<;QTN4`>zKV!5g3=ekGwbfwM}5BGG0=v`58=UlhaJpd0g@&~p;;HmH*5Hd`L8 zVR5_`Ds(?dU(a_$zncV~l}a&5_J|dmWT=WJl4W?Z3{nw))co9jux{OKDU+{Io-7-E! zMH!i*hv0OvV{=13&Qf^WI1_?E8_93VJB@NGd@w6G2=V{B>I>Nvha`Vk$UB7KdH|Ir!ff?ai- z0Wq9GGTeh_I0I`qgKfCA4)=&^)<|krFsnNNH-F%5{-9ecJEA}M^W0$DM)`tm{XwAT z2Hj>#OB*=Nl%wiR@&4>l)5?; zO43u=Yg)IdXN0keq^Gk#g}yNZ5o5}iK+>NwzpK7muvUG9im81bl754|uk`@I8VwLD zrVe^Z`fc{k(02-6+7NG*GGj>kd%j|NnqXhSj7EqRLrf$||0rSq^908Tb`-4A7y)A# zmWrgeu#13REcmS8V8JUh&xzGb$AMcB-t0XFSuPgIEq-^MD!!Tr+tA33msTv#W_ZY-MN|EIh&lkuvQ)@ z|9FV(T*JxfLcp#L&bA!RzfaCz=ve>Ac{}S~Xq$oa|6kpIT}(!xyk77*!5<_IZIX;( zd7a=G!Fhr|F+Ht{Qj(=ML&n7HB6zppGlFjkelEB}GTD0aB$I6f^AYQK!DPWQf>i|T z2xbV@609azLC{)1in55#l}-OD_@&@{!Dj^r3$_(3M^xS%Irx==PYd26m_~6%Z<76T~L{%hDa%a6OcpXuN?2!apphlr3cAaqKeuf9Y(GS(~Q7!qO&YL(9#DT$&8#o%FB_|{tV~ern5iyF*wKNjuN8| z>W&DbuF1$R>XpN=*G{knzkf^S%g5@c(sY4zS+&+>xut|c$ z1Um{g7pyK=POzk4vY-`1W-VdK2o;-3V~_61xG;69nS_BI z%aG8ogXs+SQhOUobl0g)wAiT89_a@1VTyG3IC#CJx|t~*H_RhLL!@u(53OjDSIaJy zyqwEhFvX3z^7>#&$ob2t;>>R2%YC&4ve)Fd>*t?$tXToh-)Z zufSiKKqj!Qf^@(@-T&w30#>KLJxS2Td<^;JA!}ePf7}CO92gJ4hQyin0%<-7f zqei*S@x;+f=XmWLZyr5-j>pgO06Jbl$5ZHd4#|!;(d}V$zQz82Lzd>~?pNekXdKRO zsmb3GIF=(f2hQIb6wQfyx%lqCD!hW3z*W>o%&@N_7PF_J3SY#Yh$?h3yC|yYHS9y8 ziv7qgAF2!n=S@T|_0!^->P6Fmevy7H6}E~#FjeY^ILbQHxS(g#rKaL{ipQ-L?GAc2 zopUPbh`8ziJHc@#Gi23SG!G40Z#gr9%LJU`*2tF!!tzbzpW$hOu)>6Tz1bYfLjMa{} zj9xUyv*vi*950;XnRC2#jt9^2=s6xfvg7%4Jb`4#J4kkaGaV1&AL-S{t5}c*<=Cj) z?6z0A%Z}}e95{a~P0q!7|KX%MQA#{kZ}LLu%jw)w8$-qUHJqr9CyI;gNuoNPDvq?5 zh{{(%9Bs3SO4SfY+)Sd%OBF}m6GU|^PCR%ci0aocW-`-V1y|BBqpOMoZ~{>s2xop{ zeUsoa`g3#{@f(g1T+45&t|Unyvjx}l>#M7C2u3|d@N0gbb&~Xryj5_n^pHFv<1^}J z(l>Iv;8#R+#}U(2Yr%&ER}j_daIsxA6TDaO9l>1`8+388X0;W(SMV*t?G!L{5ix9C zD%eMGqTu_2TZu|Vh{da>;0@(3XjRHDRh={MP6@_xzBFHdc0TB=NK=2*sU^w%=kr#- zN&oNN5v>>6_8w@oBy7>=ON z&ItZ&1fB$uEhGn_jO!87xCD`mstA^3V@Z2(Gw|bBBm6Yh_{s`;RAxMuFb~jG;FjPC zSR>*T*7yc%EaNr`W68Z(at*jK_$lt?7}od}YrM-fiekx7EV&L`8~hB`@E)*_<4sf) z#{#AZVmNDM@Fe_l7nU>E&o2~_F;|hu?CO3Bo;6{w+9v!JZ!-KR*dJWci32VqjyBbSw#*%2>lId8o7)$o?qz7UN6DyVFZ?RwlR`?qHFy>QG z&l|zLdiP?%+gLCazdX(ZZeK|omuH7BMH~jQ!O7%g&Lg`s?D+$)tn7#G41N9pF6O** zL{VnPbHq`)MIDipo>EIJy=eEGgsa^f)B8xw7ncjTi7EQ#GO1tqG2#`H$ZrZd%OU~r zK9X)Gng1pVZu2s2U>!*nI7aY08RE9Qhh;XuLVA-E%|m`Tz-C3)fd z9R3!EAfw=R7U%Umj)kkDPRNkB*K#O9D+yG%_<#M0{^*kO#}2#8RQ9ZS%Oc`lcE0lO z`wf#BI5Eu3b>LW7=q&TcLOU5t$WA5`hy8KYbiO$j7&_$~D-8W~jwOb!JIfjqxC*=y zfvaF$1^qU%`qW2;pTfx48=iwCLA&9i)ooDw60$}ibCSLqjHF5GR5TXULdAQiV9uc1 z!C!(?QJ(@{hxy*%2fzp()(v1Ii8_T}{>n{WgPO@$G7a1gOT2rrn zNnT>*Pb^ykzHYr%5}e#CSfwQ1SiPR_tsWy-GnHvmev-5);|1%NqT75shFdz5TP2fY zR^b$6=&C2h#hxhxSpDK5>4}o9MMloWS~8f`L~+h%%8*t&Ju;f^M7r%YMp$tIU964{ zR?v&n>A^DfTAd=?WtxATbwNdzU4Q=lg%}#673lSNxtAjyX*qN)7y=#wE)QOg`V9z5@fAVE zI8<~6Hv-Q?LOkytEXj#L%}c1c5_}c-B`k?NfhBvqsF{zN#^Bq)s#NIYyt1D4a z84HGkhl8ttSD}70eyNgB@fa$4gPVfi$1j8SV@Yl-YFfn{`<3sli-4_cQfIq|*Jv*_lym-_+jhZgt=HR!nM2`Gq6l$iR<~ndY@M~BSb`-xk z!XuxB8Xo!e;3-%VeG*F!1fzymFbmujJPAt@@|<&e4>gxy39s!_T#}0=JCQzCzl)ki zU|xsEup}N!^i~`_7u3aqZs2jwg3Va42o=@s1@}7(HiTdlw@Y050`&&B&X8YkaC8W_ z{@~UfSa$0VEW33Gmfd;;%LVBYj!xl(MU(TV32;KF^AC~xTf^kaP`QCKzBul&2TyYi zOw5n|CNwh7en2{Pv;KrPsG5295vz%U)=%(t!M&oTRT2HHuizYNY1oD+Yqdm88z%TZ zl{Hu%L}zOz+S*vbRn*y3tWQ+8t3+vgN^rgCY{{at-6Hsk;7(E8s)^z@RPX~)-y%@Dy_@BwfKN#9;H5$}NBAer9rnMc{m{a&It%qx16 zBy)UT@cJZ%39F(cDwMzpf>$Qv)lj}zl9o*LdYtHFmx)ex8cFM+lPwpWY_wog>SQV> zR8+IYqLd96L~?wjraTxV8rodZ&3Xxz77cB)=w{CfwigX8FIF_PPbK^1Xu*b}ryU3q zJ#CigXoL?EI=Dof zPZ5t)2S%K$T=WKnKkGyBTMZN}Epg}HinnX5U`EA2s<*QYU~XerpzJpc{+qAG-DJg zK%Jj~IE<8``zIA5Q6VEcxYpnDJ5_uE6wd4RQ<*Hg$cv*j3ynP$gd;X1h8_sPQJV>O z?+L?^o9Ry-kHFEJakqUIjWh7Y-!%U;lrAGLsLse0zIdEWUP8-}?;S0QQ_79YxaEPj zwkG4u4hMxr6)IMydZWv48Z>tDqVJAo2bV@VLI{iwJBl@aL`^#^nGR+INgphTI*LLK zWO&0*)KMgI)1RQ?J#bB=d>ag&4z7w2>y%t9*olg#Q85J-rB0)8Ei%hZK_a;mQ3%Ga z%b`lUgDikiIzq?TLP=Fj^qBF0wGXS*SgwiolhoPBknF(l-@@zfIpGIx@`n z(1>3UEqE5jI)KjmG6r0O*YO!o3Vn>@O5*KSz5%Ip9Uf^_itfTKRns_n!$OSSkc6RT z?}T3vO60bN>Iz;Z*jw;E!O4Q}2!1KJO9r_LLJmckw2H9{h^{QyNU)t? zXF+6y#M04%)<9U(rMy6JsUYIwu+Dda2<}69w;)`*QE&$MFt|SW2)Hg7=`Llxli+mBp9WU}`@j`t z>*ZYgD=Fn7;zV-Ls^T7_o!=$AeVS+N?o#+qC;){U{G5yq`u@6jT?guk=`I?kJDTli>T^2L)09O0 zgZdR?Js8%{5dKm|DG9}=-IYlXnB0K2SazOdoEB}gd?VSq$P*d740{b6)9<-X^|iV4 z;cC1~d0!7HZQ#zSZ|=+XEJJu>Q>_v=HPNO~a&so`sY>3^7`IgwTiXbCRux*(5SLhm z&TN4DYkIO(2JW%C>S#UOW>tB8UEFCEIh8hA)%hsRw<>KZExD#=&A+ zY)XK+`e~n}45<16?Ir4p@2EnW-fr8OAixY8@C#D|m|?f?U_JmdwEG5j|2I8XuApVs z%$RKeZA zb}#H^Q{eM98uu;xG5JdNdixk2qtI+TM%l(_QE=F=oE?|w7-FAzZj^o38Pvlgpskp; zW7?Bx1LvvHCS4b{>iW1aXCB8;LtYKO5_}c-8qiWr%Qzo6YM!l^@i=@%;tY4{Ao9-a0WWlpV)?$L94c!Pdn0%|lIs*x}oEXx1&o*qb{~eV$zp zDWK!EZ_l*r8>VCdPdESO&zEn(e;Y;qbIG4F9 ze6gKgKQ3=jbeE45-ypNpy_=aq!o2)F#VA9w%H$LLmYPMz9^(hpEc*CKkIoKhChrel zEPi9z;g7#!t_i+J6!!QoF%v!WK=6H{pM^nn47#KLg@JnX$?*N6lIC>9U_(J8Dc?6I z@2E8zQJnaI=nHauL-Z4|E#mvgiPtMbK1kv6elkBPr@-<453X-YQ^RL|cw-oohMW5z zuS^ZW{N(yzCSfpl3@^--3+9Q*<(Xi?G-uaj>T9*IG21}(ZXJI4)f-ir>cBK#PGJHA zGiP)p1G&s!x**;wNvlt*GdRr5dn}p(WopNj%&nxR#WFZeZI?lmP4#3b-%j;;D&2l+ ze=CN~DK(03s+tzU@rKohu^iS|eOrQWt@^1H-GA!mH2M?OwlaK!)%FtfUaD_n>2y>} z!{~ohvpsyL^=P6}ZRw*_hsx4jslJKiTdtobD%FxXIMt50a6FNE1_dO2c^FV_3Jb-9 zsqYCjoRm%hE+|nhkb3iPyaL(zl0H!k zbPtS@zw90;ADCs=6P4FYZ$%1zYb`Y!~7)>o(ACO*n z-wM7bI7M)bU?0IN1se)h6f8niL89*KL(;YHC&AT%9}2!L_?qC0f=>!QBzTYD5W#_h z{RDdp_7LnQc#B{s7g{yeQfp1?SJoD+tyx>P_G0bP+Pifm)=^nU_@QjsI&$kQa7Om& z;R?yQYU{kMYhYau>)Ke?$+~8^e(r94PTA@5cOiCn7yKub3pyX?oZVc|dIi<}6VBOv zj0K&8`@EfULF*M%=ic@|p|xj!P$au3eFc?B)C}c zBf;f@D+N~ze&s@|##(BvY5mIDg0(ek%hq13Jx-M^SVv+Vm34&H(OO4torQHq*4bHS znk2ssk#nyEA~>kKc5HlznoW-jy!k3p*yJ19Xx4u?Dlu`c6ac02jTeh zd-*e{GtZYlzn4FoIy+|2{O(Ndag+VIy-JEhk=^+GdA(A^!706Pa-Vz9We7$_K?ue;z|NHR|(!Fh4*M2V{vttG8@Qu*h zBu)B6!Dd7iv`MtT^eVreUx(?btS_|pu*_CytaOtPrY61?*B3PT>IsJoVV$T+=z;{f4A&J-r5>=v4GO@oWc(deVkIs>N>@x*hOIG&aJraxb zq+mVTe)R@P$3B9nN}7_1{X@Z9Bp-X!ammE~N@2+`SyvpmR`0&r@aQ>uUroevIC>=Y zD<`ozeGS#%XmEx~s3J~ZYe)sF0kER7tf3ezQNU_ItWUeuPuR*HVKqcn!^B3)ns_s; zOcm}3M0b9tM0g;a2GpI@w=ld9{?1fRhbOw$osLj+x6|>(DK&8Z@G4#0_g}xt{){U0 zNH~&e)j_Cj1d>*Pr-7H&MpoW~Om!Yx%g~ocp>GfP1@OyMlJ-Sm06K3CL$`=QP8;yE z;Bgp4)B7t5-(!5urc7;~Zs>{NK^TtHvjc^XFpg(KcNNIi}_-F8I7$X5g zfvUqH7(e0R!dkZkZvj7rSGo>HWZniIhe7vhVXXL{z@srvd>tey{|Y<~=^IipY{O6B z{%A*Pb4)?-L+GoMmw=|`M+i>0pa*$v2#IfkA41lM zg%>jPP3WN29=rfN13k9lPs2fZBs3bSz~Gx~2VPwA4-ZOewSAVrL#Mqn`P)b)r?=Wo zvfDcBj_h>WTW5d?vcElMHhq6)E~hs(*%`Eg>^JVC9`xpb~?-zERdr$tS-hVV1JFOfs6GVS)D9K@DI0HRilEc)NC^nSHE~=*!jm~Scy6^?EDWh>cl9) zax&`tY8jJakc>TV7MHQ-Ka`OxZspkX>Qt-@LH~w~Y|%l6pg$ZgL(sn@BVRO^A?SB{ zWeEC5WMqt*GWPuUGGxX`8GBxplCkGMks&pD%c%3Yg=N(Fw`ItU>t($8qY*OR{8Slf zzJ-i5ztbxt&5xI{I;zXC^6MI-d$n5`{4-^zQ+Ig@sdJRc3n`L*x$KWAk>^t+FQi0L znRF|Xf%E?}_uT#4f9n006r0r`H*|&Ea37SuI40#};?;$ysA?}5?JW4-UQh)Kx?qKD zE;x-}e1`?hb6N=tZUNtm1+iSP4ht5bqN2Uv9`}N`?O${PBM=J01b)GNye>K?QmI13 z2}e3oNIcU8+ltN^azM1r7X({~&Ka~@w9TgkGezh0Y!hvBykJdgKzf5Ho1+BFQ#aCI zh^{$Ubj=h~w9I9KJw?|{$Q3Q~9l@JK*Nn;$E%PgZR99jev!v7 z23aDJqehbbq7(I0iWQcaVcD1bqDXn$9!0gXti&2yDW|O1NXAF<;+?Bba(s5D*|TE$ zXhYyDVs&J;R7!Ui3wM4F#!)&sIhap_`8fRXlvXUIm4hP^QFG3@lLO~}G2VY&Lq?#x zTX1D8o&r_GB z7_SGC9g}niXoppy9lip-kHhjEKw&-9#7m(bA{JXu0FMR#4Bm*>ygJmwnotk3!4HDh zf`5dTm5z25-Rtf<=AM66--bybW67W8ei0A@yMB!RV7v6Eo3lT?h5> zDe!BED*e@qaSFqZKv8TC1+gs@#L3_nkuh<92+VOo$j+}@qrGef4e@15Q&fk;(57xj z+u9zja6L4(Nb}6Z+3I*CY=N7R*0CcL#OhEG-vr+W{qSTV*bveAU3Y;jG@T(QBtAsCDg=0=@_vFqZDB9MxBks z9!bb$t2aPP>{kOQl{gW6b0s-2GMWOlU=od3mr|BGt1%Oh&wWKjd#Re~i1 zHYSpOOEkbP)Bs`E5k+u`D1!Y&5mY5a5nL^b;0VD=q6e-QJ@5g+x}paDENbARf(=9& z+~E;raH1%KO+*>oWhsNth%$I7l|i*PNOZ#IL>p{IZBXsV76d+(FNCtE;xj`pfXcLC0r&dVNX#Ba}z`*Tp%i8M^Oon zM2Jc_RaC;}q7v@#ib^M(8;_ZI<&HXCT$LtbavEp#viXom-S=wx-`(I^FF<=3DTp~)p`3D zjk+u*1ReBp)z1sYbt)eTBgiS=wq;XCbU(n4&eE~{UwEmy|3K{KRj4h8-P+PMqLgF-iPeoUv zzu}|mRiIX>E!R|o7G?f2AS@kXpt)-xMx>6^=H`A8wQ%I-M^}35u>0kKXR2pF*7Erl zUKiHD@a28jw>Zuwo@e6(AGp~a#r0d|{1IO6d3UszyX?1Got=`&ZM=8NPVj`o?uam! z{g$z_4f>1@`@NB2?(=razje;;W$yFMUv{6fyBs+Gv+uieJ)C>)X6L>;{NK6%`WlJU zx>T@+V5(q*#BLpysI3ix9|_J7d_-`t;0=P82$m(P5TAs0Z53Q9_>$n=f}I30BnT`+ z#pun@hr|Z|so-S6fr2dslX%heK{3jIBKVx(ZGtt3D)@vL=vN9NVj%^?4+~ZzD$ijt z)-MzsCYT|H`=Fy@vVT`_xL^aK3WnJWX0SH|ZzaN@BnJF11@9MZAjW*}UNPfO7HlEL z{GdHz#(zf84jkJlX8b1vYf0eP8nNQ{f_2W$SNMB#9lDJ+`O9wOj=StO06AqRZopwD zrodr$%mK@8gOd}ZKz3pm+`^#~=irWgaEx9~jD%wx3!Hybd|;c30q*xa1NrZ{d)|G| z-DT&VyV<$#4mI&WRc^o zS$I~ltn#A80(6<+1A;4v7?Ve=Mb`+vDEJHGcyvuC)&S)-Onjrui1lf>;8z^sPnQ$h z)F`6**(0W_mV&Pl)u{xrZw)4@pM%8yb)Dd64FA*(#7OowyVmKtVnbWRP*B}KOl%)k zKPTGWi2(m!vK3(J_X_5pcLy4{%T6@A!|rHzmfaQpL zd{pp#!C#9rc)g?q5?m`dUhv~2#u-P_w_MUPpJ^Z;ULM|Y$i~> zZGSz)?4*Yps_-=Af_n>DRIfi&SL@m+lv;s|aSM=8HE1j{$f*hl!np~V9`!^dSIyjy z6my58P%5_>-8y<9bSLFU#PF;|kB`)!QK*bU+BWn7VYpAlBMA5T9^FLRnkZC7AkYXf zQmp7X=s&U&kwWpi5Gj<0(4i~Xy-ZJMc2*U?msuqBK%xrW%1o{L7RlG@T`vP$^p)O? zG1gcd&x&mf<7%Ag*Z7dwy&8z!%d=Z-TCWK96U-p0u+w75`a*EJ;8?*Pf|m(a5-cuQ zNHACoUx<>0`OE4JX(2*aQDc^+=`2jvOcqQRY$4cP(AvvuQeIz94#h{(a$FpZ7v=fo z#b|f9{8<6p?%?g;U$#08I=W3o$$FVzw{tqB{1#h1l^xyY&+~8Xi_3V7?x?T-v>Z5p z|Gnq6$bauSf1!K9<$u@x|6in|(=pHn$D-$7Tbm!Z`5TLsiiT=87BQZgHutxAs?BRH zR=FWi=EkD0U^$yFv$?m;<87X6^J<%aw)rR-L8Bp1`^ZT)SF^dP&6nBS&gN@uzR~6` zHutc(yUn-Qe1px-@2;@tTiA?z8nXY=Hph|S|1;5nNltLTeZXsNUSRVxHV?P?Mw@Gr zi(v!dRzYv(B`d1^5zOvr?m#(kT`rDiAdvF!@4W)~Q~o(=@thP51+lviio2ZuiT$lU zIR*F2@pt)kBs}-m+p$C!WOa6|&5o7Tv9Qy+p5LlY&$Z*lriYteZ%2^~oWEs6E9kyE zb?$raF8@33zqWGsA&(z&FCeEM(8}*;<@&So{#iKyt$cvU4T$UvOcaRR3=O4QPEWz7 z1eXf#mmWGLrH9V7f{zM*BE5BjPe^Z_+R{&_pWvJ9t)sjLq|;7q>8>+W@LlP&6LwrW z?X;0jJCmf-j%Sy2+R2cVEMo;X6=B|%4CzBRu_(LM1??tj%jyqXegzu6#dJSH4D#Ns zVvxT=%j+9})$FNnROTGYo6GxDLx{$nHkc`i| z{JIe53(~9ntZ6v2|lAbwVNza_|g3Y9V z&XHj0pEFl_=G-QjEd6u7mYz9d1glH`ob}Q(CtI+Rbji#@ zBKR@}b~~}%R~6g+O0m>;l@2+-hKa#`q?qTA$BTJ>f@EgMDRK#J)kBl5xH4!F2hpt{L>4haV zv5G$#g(p?d6l_jZo}VJ|!0Nk+D#gc4WO}|Jl5im>SJ3uwJh*x^5ozo=ppsrFcok6v z{lYQI^cWemu#_o-7A_LJl8E1P>_RH& zY^XV?;a7z2gvdj9&>zQCJ{u2vVb_>R9Ma7hGl_$}Ib$Yq5Gsyu#$n+aW8&yk=a5OazrelroM7Hu1 z(1FN-cdRsc&UjE{f0{gw+2eO6T50t-)Q{hZXr$-`ZNY0WSwng9opKf(P$VXt<$=z`553yaqfq4DTEKe+NTC@e*es zVE}jocuEKcoQJRQU`Q~M(xpMBg22-j!!LTaW9Dwmyc}fcOe7mnrC`WC9O}iW+L-$o zvQ^#{h7r6MGq+*JH{CEUPt)efSk4>`Gp1o?wt<(_Y#)9E<+d!VSFcIKP;|jkKK2fF zF_G`5uH(fUsn-V)M+D)`RAxz%Uc%Q@-x7=$R2`2Z=~wu+>XspRPt^`DNk1fGSyc{2 z^PyLBcq`p646m!oElkq$Wb~`6!}0d21GqG}AW!pE*7YLr^6Kwpz^pqXIeL~anWW$4 z8?A4M;<#Fe!%2EF2iek%qVZbmO)~n{Ju!H#l}bfY0|ocz5+pfzAAAe=N{rZbEDHWm z?^d`yr@;L=9NZM{&!VT0I^ib|{GYENm%_d9fY!yxUn&*e&(Dx`VF?_coxq)oAXMvD zk*MKCj9QtLi_8s~31>0~xC4&e0n4^95wrBavL-@!@01?XW{UKfULvu* z-PmLLL?QN=p3SJ>c7T1sO$_}M+WL%a9E+3K%@J_Oj^IWvNO*GuH*!J38-)W$fGbFN zW2lcKypexPfTJMi2yy;oejy^foll5k7>XmrIRj4Pe08>`S>SyC_4ikg7lTs`+DG)a zVwJi}M8cBDE>qReO9gKus@Rhv6V4I5LL|eGeIgS+C78ijK)q1}!+S(9OtS>TkHs3- zT?E6}lOht%5xjz^LiUMd_>^EhT2=IV5e$cmU|7Nw!SDmY&LSR0$-uPC$_gQ|xrm3J zZ6Y2%AXtIAjb0_vVPBCB6HbeCI9ITp$cVwaMLK*;usVA#=&wXX93UcMkz5fD-x9n^ zM8uH2A|g%@tjVU!{6-|iL4rkdDILxuTtx`pgZJn$Ox5@<#o6)~NB?!?v-$|?azdQY zE}~CjF!E1nv?M_o!_(tpFX}yb8a=4@x>#fWw`D^|E+jkq{k?LbBNLJxxzLdbt(;d3 zGUKq0mTYL{#A0474*Y1PUbb>(xn)I;6ln#WSp!)o;@lDg*XN8Z9k@RK$@7DppL>EM zkc$cOP%H2f@GFQ6E9%22qDLbjKK6pDbrNp7>rws?g zsK!SksUG?&7{=|`!(=aK?lX*!G1E|HHW^7+Pk$eTH(J%}k9uqg#V1x^)Ya2Pq1--={laJ@ z^cQ>;n9mDYy!M1au>1n)y~aSC>X8d<{`_v%w9)t&l40i$v)FXUUKv z%fw#tyK0m!4{`5P{G=zQxNQ8)aZCo-Nu(0si|bkVJJZJey-92SKkPk!UzfoA*?nIE z*W=%PJtEIZgA=IvUtWO=`9~SR<%D{;UHVSYmlFu)1cv1|p*iL=$8<)Yr(-h9@8fjL zV{Vg}6I)%uzkW9OYdj z&dG*KY*5q029F+WEXzxR zN?Mvimge75(8_BHqM35r-8uj7_jx{N=FBjA14RABzFxEMbI#0}XXecFJT)6zLAW^*e3c7&xc0>MgPRXkN54vHh@W zYAh1lh7O<_op`IEiYj&D-$N^@UMJpduAuqG61%@tPIW1fxRiCiiPhm!s$Ge{4Jn~& zo_K!_j}T4VQ(8z>FR}epu7!z*hjF-|tMfZ~99HPszJvk}!)UIy)(9uKy59L}73aY^ zyM8rE;SfmIi`O)8E$@2f@&*o@cD{Vm=fV>lr;{SIlsTN>BnmdtukO6sG9l3IC!;e45e)QQ}!LQnmDG2(V&qL%7iBK%JtX6vk~ zr;6yz7)WN481nu=s+oxp4K${~$J)Jv3C>MJ=w9QrG?2|W7dO)F$GLbY^#`0QhVh+A zUqvz6|3@RCqxVzbb}9)nM(~j6hiPN(PSON)jiQ@c@h?d)@IBg?^){&p{+&a&yP@kT ztUlB9b>)AT;_A+N8ke1a-Fu`;*ionXy5h^^kv?735g+-(n%M^u!wj!gNa6}44e?_FjMVCBc|?-kWh+t#)7#- z>{+=U6$=U2n_|VMD-58X zzhGC4s(h(Q)y27UxUaKl>-ChSq8*yErQ~^nfBoLUTkzLoRwC`L);?dIW zy3@Ixv{iJtBTmo%#-uFUS9FbLeW1NFX!^QGX}gI;r)4B6b^b&Le;Xl@60Mwb7A5^& z(n+CO^&TCWM;i)>P!q3E7uH!Ar8^NFsri78yl#_zL4A}C&84R1`^J0&VkeH5spL)zkH+9pE9`u7$A%qFb~d^5 z!yO^c`Liy7H3igz_Os zNqo!ClS?N4K89zJ?CNOO#k7!rKAerPtLqyfo^mMh@(C;vOZ=*qCo$^UeSL(7QFOgI zm)1XtI*Dhe@%=ur=`(!$PyBu&w**~JOjFry>-zf~lbyA$*OnHuo7T1G=ST4%%&un^ z6|hg%+41X>ZFa{x-~GWQpA)nlosTd3bbwR59lIaBYH~hz$~*q~i_4EK z;$XtAcc1w2k}nL;<4Ur#P21ok=Du;1)9DLcy@Q>ru99!=97h$VtK=Iy*stm;{>BcL z$aEE5y_H?6E_?2?+$Zlk_CAs*Mtxni*S^YrK&Lk47kdUfZPrq%-P}ZRQ^f-sxCvuT z9XFZW6Q=Wb%~-INh+Ru?fYzlNBn4~O67Nj&iacXJgBLw-m~a~bmpD5_Wb~T znvTe%rN8S8(`VYF3_Sg&zjnpwqwUT;V)iwwpQa$#OE3QJ_7zL!&z#cKP+3}#6EqY( zm|Id=KlJbkUpRZ|x9@oP*|*!w*<^cce>{7P)EB#slItw(?J!9lj&z*ldUfm}vo&&9 zhrML!NJ(dkbpUL!>@2hOO3jd~7xHSzU5Cll2C**4>ojFLP8^u>I!=5qVdshOE1Av{ z-*@=_!$C23PIcX7P&}2CvnMCa*~cA$Kk(zS~EQKA|1J%j@(QVl+TjmG>trq z|5y~d8APjzJ3pk2oWGG^WgJZpWj{h2Pt%6>3(~X9C#AH02d^tmfv1GAn&d8Dqm9Ue zzzoft{H67I`wAwRC6GS~|()`T>QF8a9%z^Fb-y_4JnAVVAo!LUM^HZVK`Ab0f zPg^U6|J2be1UmDCCZ|=Xac&ekoS%}Ko4)C7n((21s7fD7$tQzNT&EPU57jYG_)z~n zu9!n|FAgu^0NrnLO38M+x|S;JN+n+XbUAxcKaUAd>YY=nINZ0obO6TyUplUaTbW(g z`fIt>N!(Uh&q}BDBg9G!4^I>;G2C}#Bez$(e==$qw_mSaQFs{L-Q84@Waen#Y$JjH zZyh^y1rA+-g!8L-e zGZX3za){I!&#^-kTJXF|VTP`{Z~RB6Pu>|g<^F_8AHP$b^kW*nF^rCUcGbT_^hG)c zo_){GD1Dm_rE&fp|IVZDv`258{q^7dr-;7VF12*RnO|A^*PUhb9k*+CIJYofJ8I(R zPFvLW{ku24*4bu}Z2ALA~=f7?{t5#zVwCkDg%qX*bZd%Fplw1!fGo2*8 zA=e9%sU+zEan?_!l6a(_k~SjO9fj+rme^Cu<|VNU>-CPrUe zV9r2W_YR>DO2Yp@1E-|}4>eLeAdyE4UXvG7w^<~J#%~)=!M()nU59aA+rD`uSzn^| z&!eb*CuaPI{E^+1120-jV^bGXPJHIuG*rZGuG!* z&v=8zyDp-Ex6jc~*gM4N*r&r91qc(bm5ChD`y&hrHY7Tyh$PVhF=pX<;o*EscsMsH z!o&HIOb*?yisaBwb>ZB6Q(@=ESt61`oo9-q(9X{ZhvwBW!lC&?v28bw2!*Lt=d$#5H_V4i_&+C%;`FLO-H$`&7x>}k6zQEV_W6td~tYtIJ zu{@60O4BuOqB`4EK^v#h=%DrdW|;+M?mM2sS+vy_rL+5ZtjnjpO0DdvbjGz*@V`yk zsHcLjqzS-&PkNm_CH!ugC1wtjXp8#x8cx&wvFyVR`1R?M@3!dSeL9j|G|Ojae(v7( zIV{fKjT5b$Q01-|Cs8@_%t=!rH4Sg@9r)LERkrs$r>^~g-MUWy z=YIS)=af41PhI=R4$dQWgr|J%&k0T*bwrQ3^v;*~KC(Oa*u_75>}~#t`EB$O+mue~ zGmdt0s3Nq5Z|uYVI;SJ?(%MUp9PR9R_lcVqjHkrj?(t`S_2-YgxU=5bwc{VZ|MAk9 zWAk%-&*u&M%;^`jf8$4YJ^a-3|9JJy?f>1`ndsQ@-rH}!`j6)x|Ly7@eErJvrZ*3a za;cnh;_xnaWcbJBJ0IWa=#Ca?+plM%B>lSQc(s9}N?WcPFpT<1U9W#*4Bv`7U;Oql zw6LenDnN5-g)vTmwl!vNbkMt{lBlf z<;pXf3Szz&j-PY!Rp0#4+6Omsg?anEogEYk-0|M_t*<`+)FbzAIaIXXD%up%}KRquNp=RyLLUkxQ^a2m*3Gb?#b7l6RiAWSJEr1#IMoY5xTHDHm+KDR5(Z{?tW*}9oL*P zM9ZPO)y}Se|K+}0+Gib+UqtnEYv<1Qw!it>Kes&l*!_2`{Myp$Nzf$I8+}F)d#N)9I6k8>cgS>aHtM=>wtGV^Zr27 z^0gg${O?`^^>Z}1G4-I?9dms?`KA%kwKF%-ZLV272s_EfwmwC2no}lFM zD$h0-?!G?c*$#WQ$%_=_5yYQG|M?t#|2k|Fe6_so&>ykJvz^b|^ieB`sXt})JE@)I zmzSSKS<@t*Gq$V%zYpF9{t{dd{!vi;OTHHs`PxQtNO^5DxE1V>d|h6A<@GrB8$emU z^7<6)&jc5ME#Pu+CAb<~2W|v6gImE4$v1*v9Bcraz$xHNZ~@o?E(ceFtHE{PMsPE@ z73`4wcMyz&4PX;E1)K>k09(N2;7V{cxDMP1ZU(o49g=Sb!8q6eHi1*XncxDj1zZlU z1XqLWz>VN$a4Xm$`Bo5&gAHI4I0c*uE&yA=<={$iHMkDk2yOK#DGq@G(klYpo<6r~W1Wo~Gf(yVFa5=aVTn(-RH-ekNtzd`b z+d(i6Hh@jw6mTZE0Bix5gDb(+;5u+4xEb6Ec1Ugyf^o0`Yyzi%Gr0hfa-!PVe8a3i=G+zNI`z83`J zU<23$P620v3&0j|Ik*yB4Xy(>f}6puV29*?gJ2wN0Gq%m;7o7<*a9vGSAwg-b>K#D zGq@G(kbFM~#=!=#37i7X1Q&oU;Bs&!xEfpsZUi@jTfq*=4}xGEYyg|UDd0?S0oVdA z2Umit!FAw9a5K0S?2z0M1mj=>*aS`iXMzjB7H~PZ5?l?g12=-3!L4A2%fiRW^gOm zA-OvU#=!=#37i7X1Q&oU;Bs&!xEfpsZUi@jTfq*=JwY%IHh@jw6mTZE0Bix5gDb(+ z;5u+4xEb6Ec1U&v!8q6eHi1*XncxDj1zZlU1XqLWz>VN$a4Xm$*%<`mU<23$P60oV z>?#0{1Fryo1->SkV4sBg--!}%FgOmx`H30WKL@-V{3>`8cnA1f@CopF@J(>HBuR<* zPa!dc`8cnA1f@CopF@J(>HpelSak|p^{us;Ko*Gu(%2m3z- z?*ab+{!5ZZM)04i90%fjMP6@Jk=I*QQI1N>4e;yLbHK~NuYxy$cYwbIp8%f+-voC{ zYJRW;91M;Fj{|3b=YW@kUj=Uh?*M-bJ^?-tz6tJ@G+vQ3|0`*;qfFn^f3;*_u4FI< zejUX7gzDseXa;yLi0c{p8uotx{to;=GCUYO75pZM-z$vI85t^%M<#(^1o8PImtcPx z_#N=4;630U!2bun27VwJHNXO}4jc_m0>3Dk%W(v{UilHpB90%>e(7|{^7kYMY?Q3K zM{@(HNDf~mdDsN-Uda(0ccAk|;P{9|*k20X0Nw(w1)q}~ ziStL|{E-*p`0d~elB4jwM&Wg%PQ>xq;39A-cmsF~xE6c}dF0odlbkUSoC(5SW_%0#KLLLYJ_^FlPQm%7;QUiySEt~0r|guk zpDEi7b>^3_e-^k{a&`-d?>~Db_E&@Jz>VN$a4Xm$d0G&RgAHI4I0eM_I^%S?f9B66 z=fUpJ`HtK_H!6AlW0Du+I$SnN?k~appcU7BDeSwgO+MegO!CUfAg=pW$H@JwmV*z2 zuYkC|S8HO62bh|hlw-sd{J|8=;&*WvnJhwFRYb@IIHz6bscybpXF{2TZNxKr{g z7FYxh1jmAt!7qVlfs4WG!0$L-R@Cd; zaKF9%GxGS)V0U-mes%}!?asU9^Q$L-xG$~7^J^3G_+1gO0vrb7yt_`s{%mj&xD>nr zyaikfJ_J4mz65Ru6OzA-fEC~{Z~}NDI2&99E(LD@ZvoeW4}nif{%V8duW?=O9U=FB zTP?YMzT^hfzeoQf_aDc7Y!lkMr(g$9kCo3qje79(m#~j|@bqHrqaHl{J?#GsybpXF z{2TZNxKr{O3oHT$f@8tS;FrL&z{TKo;P=3vf%k!rgMS0x0C!6M)dGvaf#6thGWaF% zEO0S+o#eAyC7%mOJ|6)qz+vD7@I-JnxCmSd-T>YLt_2?gp8{V3w}T1E7b0KD(=g#*30K#9RnTa13}XcrrK-ycE0^{4RJqcrW-E_#F5;xI^-F6D$Pl!7<>m z;K|@T$v1Jod~*r*uLo}i?*tzJp9Eh3-vakYz7+sV!6D$0;PK!o;Cyfics+PCcqjM( z_$2rO_!hWFa%%uA1&4q~g2#iWfb+p6;Pv3m;GN(D;FI7BlG|Sbw}T1EcOqZ~I1HQs zo(Rqc7lBK`8^Bw@wctbGQ{YSBb}%9NZUn3Vhk+Bo6T#WwB5)~q19%I#7JLYN3VaFN z4kjf369Fs0Vc-PtM9KH3fpfqM!K=U@dMXupS%(9t)lf&I2z6uLZvg z-VWXiJ_bGqz7Fn?>@>kbupS&ENkb+0Pj!w5PXXtHOTg>Fo54H52f!!67r?i`J%XAq z0G5J7z$3xq!BfEb;1ck9@MiE%@B#2i@CEQKaE~O7{^LJQDFugsM}o(Lr-1XpCE)eo z&ETDq`daWI@G0;ma66cgG$LRHI1HQso(Rqc7lBK`8^Bw@wctbGQ{YSBb}%7nM!*Vi z7&rku5u6P!0+)g}fVY5a!H2-7z?Z=7U_#Q0fEAK~YH%bt5u66j0WSov0&fIw1@8tQ z0iOY12H%qms$ecy4UPmSg44h`;Dz8-;Emv|;N9RO;4|RM;CqrG70d;z!I9uZa2hxV zyb!z!yiqdxUGR4BUhpySIq-FGhh&Zk7J~KQ81Pu|WN;pMDR?dTUGR4BUhpySIq-FG zhh)qI3&DDD40tSfGB^*s6ucJvE_l0SF0N1h&*Xm5_aw{ildPX5Ib@yWP#M3`hRQgb zHuN7j{toC!4wLaDZCEAtWjse4b~N@s3!Vm^2eyG<2Y(3O1wIV^8T<$M4(Lb@kAjup zaPVmGv*06=BXC^~KT+`(H|K zdQ|dR8Q0gh)iFYIBw9Kg#2eHyCtKz zV~w;+;}_4%<9Cgd{N-mQey9ToW@(;Mr{b33ArC(?K;RU(> zSOCQR?XmgTUjeQH*MPF!G9KH6{VkwuAB@L3<^JO#uncSj$AeSBS>Qsj66l96}Sdm4{idtfZM=M$&Def z3~U6)gHyp-;6kt!Tmh~E*MRH6P2d)A8`vqiDFl{*jo^52DmV*V2)2SNz*XQHa6PyQ z+yZU`J0<@V0?WWga6C8_oCPifTfr6JDsT%mRn7H}KbDfx5=ECU1y_Kpz%}4{a1*!% z+y-_^J`)1Vz(#O9I2D`)E(BY_72qmx4Y(fM1a1Mhft`|n4S{7~BRC$M3eEx-g00{R za22=)Tn}ynw}9KgPRVCOU>Vp5jt8fLv%rO5E4Tt&1+D?tgPXuD;5M*RlGYF6KjZ(E zfsNpJa4I+pTnM&;E5KFY8gMV1eSq~ z;COHd*| zAF6+c>fgbvZ<%Ess(**-UuK;+nEO4|KeNTBE3}Y;Ld!QRw0yHdiz_I!#+gD3Ehx0$ z22D{|snFsJN|~>kh5*zmw4RDWi!vy*v=^;aIz-9yH7K;q6D?*sRLSuTQ)rQ6g_iZA z^?^nxv?#R_^o^n+1c%dFLZiilmiJOe7W5sZD84p-vy%S&2A`=M;fpH6eMQPZ`qY*5DU0aSM5#pEH$kE0(yfehYXe#RpCZ>O5p}RKNG((jR|Cof)lu4f?dh+Hwkwu8 zR*9;^)9o+E*RTBsx^u8Cv!%C1GwQx?15NNVp6*JA(;cai?nJe8_bKxYrpbRs(4A!* z-7(t28Rw`Qe2Q|E&##R3Od`5ZPdc* z2rZxDP;la?{lFj9OErR}M54E5|4{3#^clZZ_|09P)S(x)7u37bSxTi zXq(`5-96J`s&CS!oI_()bR?Nx` z<%RPd>>IRi=SB0)0xhCP^&BHc7c0-7pIeY-d1|{#zmhswD^N#iLG>t2QEB}mjeZxc zRxj0t>rw3p-PGvrOux-Qz1AqzhZ|A-2*cEmHsWRt{YFK`NHb&@)@V~R;#Q40$SO2P zS|PK*uCp|=#*SOV>>MlKUu|1fjX!P=^XJ$lfpWiP*9VII(O^{|;;#yp1ayBxFfULR zDh~PsgF*#CCr}zL4h4e)!}%dKSQ;q|heHD+d0{P77R`^)PEI_U8_~j*IeF1wBtKS| zLsvXf6N}~eqw(C_STx6p#_|etqcJn5Ixm_VipBF|d2~f%`2~6TkvuE6rXZ3Z%JW_i zs?kcNT1oZ4i0Xb+8LL`Ko7$`z+Bh|$9i~!kRx7kBwO%V$hiWl(wB{GrOwo_h0{Y=v zuHLAX>a|qQ%d{bSzNQ$5=^-s(4ATuQ*J#vBjat3hDAP5w-pHpPx|V8wKK(cJGPByy ztxB`h2+{vsBcJ{U42P~>1zlIaU22t@G5VitI{so}!1Vizh^iSQ7FcSakQlatfdYS_ zZCZK60;=+PfqXw#ET(DepK2R!^hi`}S%DC?jA(?m zqM<;Ls=C-xgBDl&NF*E#DX}oNwU8g%fv`?jn~#U-_i^$np~Z}$dWlh|4=~E< zy4M*6dXWBy^*s7-=v;?&y2f$3?iFSpUH1wzn7r;bUEw&HTB(&s*PX97-68}vGly76 z*S&xku>yjol`F45UEKn@?h!%0?tH!T{UN~+U3b3Pd34=_Vk;-0;cDA~v}>e&T&|Hu z^)YS)>3^P)NB{X6l@c|h|JNw(8yb6m!+Nz?8K&k?t7FT)q3RPB7}7?n`PvY1$Ewvz zspZL~Rwtk~QLDoiXzOFB?HNWbOTAX5S5V7Ss5w*zBAQJWXlXh0zu2hPtBeX=rC+~L z50LFe^<4UI>812vqhG&_zGa1(Z{*Vdu#xszt#*alIEC6frGWac<>~;XPAyS}sxi@z z9nUQ!eO66tQiIwkHBW1xma>N0!ZK1)uS~_AFD<6;aZVCP^-|Zw0gZ* z8>Z)I7JWini_(8bD>Me_X{Gzy6eoiA)at4wTAeyTD;M|o!?Xys&nA^_=;O4scMi5In%bmL8&19UMx|7(RjSo8YU}fr z5o(xPenY&oqfJn4ZA^MUJ>0G+>QU6=AFagHp-Qn@uT-fOqHlkg8c~i=%`AQU4We(K z_8I!wug}_tj%-Nx4V32I`_Q3`bF}8(`_O@mbByNR`_OjAIaYJ;eP}b|9DjRSADUwi zd&Lp-_VjBIY!~s0%$Pu$AE9QP6K?PQ8u&8KiMA)NLB{WT@cXtOwLg)qZ>? z^X4^EVXZrP=fVZE2KgqmIxSRKtAqZfLA_HeKUfecq+45#9-|I?o|$hIgbD*i3iW^a z2zBkLM`{;_i_Bszhnj6VqUTfBpE@r&#fcJn5%rh$@sXRXa(u>YL^V3vbYZp~uDzCM&Fj5fC zSMy4XatcEQW`03&tSDUQFNl`p7l(_2g-*eMl5labNGq%?4VMIqjiR!6q%>G!6_=Jp z;=xjXNlAI6EExBfIweIF(ehxKKdzJ(RYod;<^D1?URV{a3{?2bwX(ti(W*eDzd|c7 zs*Vf@RN0k!MR85IIxxVl(kplW_1>FWXMd_bw>DfuKGFc{ojAMpy!?lsFJCl$Vz@3; z>#wn^wEDXX|_mp`}6t8!8POG6n{IX7ZRco6~6@d$+YA|aA6`1@{ z>!`rwP8AiH`h}@L{K9i4QGxs_{<-H&paR`fW{;%;-JKa#RA6f-Rf>zLz*d_alpwh) zA#xveatMR87s|1tNZX3=Zp5sT`rUSm~To?}X!Vld*EiT6^=j5^D6%%b{i)?0O^ zIA)4-wF+mDNfpfW9Mvj2R<+MPZkSHbn4V{-ht4(i{*_DTOltH#X;N(uC7){WKBZRY zIXm~fLKXG0Ig?waq1f68@J6l z;V?clDpig)=t!r7-}~ECCuGgHHuyTJuE&~uTCzq{4l7xsCs88Ht;BPiD3j&xoK{U~ zEVhXDEBJiMU%BT`4f{sA+mk3CwQLVJ{g<8JW>UrH^635*rSg&$n#xO7=w>RQ|ca`)ZiXgY6mzwJ6?J0S1a47 zba~XN8=Ne2tVv~#aINs9!;L}XoIP9r@|&BM&Y`*{?a9BvmpEg@Q9dPQC!>A-q@Bcv z`eLqaOt1HqxZ9H}d{y#{C6~;fKndaG>4PW(oI0ISyzVK}X{E?zZCu_dL#e!!oltp6 zJ1L>^T-%sN<++BdfaV{5iOds?39Y2PTC;%U$P zNsHvO{e?=>BBc#$)V`%!Ge7mb*dkL$EYZGsk8u0uwr1RNdM%RAv*K!+Me?zfMY=7V zCM+`5>RA;!ERv7O7ETu}oHRW5s9u?vJdCTq_pn~2q>RY>q*<*Guv4Zq#QU69okKpx zE05jzwewFpdN4o3?VDMv)fAJbA&(zU$7KVj)>d)<@BWq7o`2E^998ND$zx=tjlxWw z`r+ivyznns2w+PMXd+;q6C#twmL4=<(czFIEILfDHbOSG!(mOdoqPu{!m?LNarlTO z?2_*Q6xmGLb0F%VPs;7B8nu&qltWAQP=hfiMsQ)Vat4gjV zELyg)v2uAp3+wN4nesVPhXT@XOv5ua;?{@G%8Z2 zD_dxz(h=6@8Z;j@s$2^k?XgU5UyT7)(hf%^t&{u3Ms+m98s$6cH5_1gi%b_bDL;T# zTjA`WE-2aN%t?dM$f|W5WstTnOIGTKiFf@8-6gm@XCMU{_&y+Po&yc9aG*grZxNqw z5Bu%sP9H};e9}iF6_(pn(gcIjiD!rHn4}ZWK3>v^r=4oy#IudFk0+dXY4FFBrie=+ zb6hlc8kNEgB)Q&a&xlefZUcEt%5^8lEa|$lou*v(vu9MMTz5J@<+{(Ar1~n1DqW!% zeX;JR{}d^r|F&LC{}o*!6R$A*^uLf2pA}}rD53wRVUmH<9{n$*uv4iOF-!~DDaoDt)^ zPB1{5VvCX!lmp}JStJ<1mKoH^)#OZCBoxFAfbK@Z==mK~;eK-NjIzb(R)-@789f_z zC~8Jj;d*kD9*p{vHvm0qqEj7=`Ezs_F`uR6DCkymBhCp!w-X)6wLA^FnrjFbRo))V zJY5*Lydn7WHDU0w$qp1y3IZlCkLU%8XlPwG)+|)W{G{p1n}8!+($tYeQPOU?&9+M@ z>oY*wvfI{cB?{VI*Hbl0m1JAY$LN+GSIN?(-I}5ZvrH2<&&S;N(>y(Ec}!1huDSo< zwyP4JX`~P9$Q7ZJ1OfLh^`Y>uE(C zGM)fT%tmx4ltXd~w4K3NFh}*Yom!6LX*)@0lH3dAIx)jzN)*`kw4GL->S;Rz`HH9Q z^cQIPPFm|}6gX*yLs{lzY=@1_DRiwt8k<_=_IK<}jqZi81L>WbrH-fF zl>K8TqusR2l#F)MDtF3MVMVUBaj8zZmb4?+29=6bWJbQ$tWqkyl{7~irWR=f)k>|B zBt%8(a4o8irMfafb5vbFQVZ!LwS0XD359C38fw%V^gKKoKT^k38Rj0O@6)sTQF zuA5YG^Yk#KbAx&TZR^x&A7GeNT}zAz{f`-R`AABkiKaj`0#tcR%v|~(GgYd>rIz0e z2r6bSG2b$%>K2leA|x6E!%{>eP(aEcZVbY9j;P88)qHLMa!Jv{J;I>h5V!o?faVX2 ztw_KW%|K4j3dlwv7PQa^_=AdQ1h|<{f;O6gKuAk910nXyxQYkDX0jPj!)mf2@JFPF z#;;N$X0jo$qMB$3WX)DQ4S}9xCu_4mM){TGo)XhN{XipE^)v+jJjK%xQ0>ig(wYK2 zU-sE#LtqtHVF`#%b)+DR^d?gRqEOB7N^eR?0-}gpUXY|W+=*}{Aey+5G=jn+g%PxZ)B&zCh3jbasn*A;cXV*$U3A6 z@eOYWL#pTya96?`nKP1iJ1wjv?{?{tIU{+uv!iPAZpU!|`p~FJCdIj3KS9R1rC+dj z9KidVv0&Gg^K>WVU`bC;LJpSnWC}SH`aQD=IW+n``y%9Ug#GvI2Nu~y9zT$UR4G5u z6xN^a2l6l7ogWwr#)Kcp9$}^*$PL`S`hnhSP4;n+1u6U12`{BPaNj%OIl_K=>VyY` z4S74^eqlqo0iQqZ`e+-{Br_yh-4Dr3X4h&cC9AV_t?G;ty}PcJO;=)HyH;u6%-GN` z$xe4I?$O$TY;V&(p|zoRVGv0x55)aFt=xbwIdEWq?n7zs8S-^&XQNfW;tIdg&WZSX zuY2i2m2}}wKLt_U4q%962z8Y9-i1e@jB_YAZ+QkVWECC-n$tf&rEz(nRFA?VJL4S6 zfb}|n!OS>^qWrxMV9+zp32x}|8t`y2lKrNC9}05xd<{N^(_Li~B9Yd@xrUWOAKruY z6;2Bagg(SaZ~B)`(#U+2j}9t7+oP|aDciZ8W4PBWBev2*hWm0T>$M;Itj3|JUUb7U zp_93swpvLILP>Pm5+!tqD4|CQGPlXA1gUnFAg!GD_9#J)_bNdqd6Xb?)0809QVDWp zTT5Gb!?F&c;z+4L&YnFsr2;v7dZnuZxtOwX(e6|r%_$WKou5*H(D_0I!dek3taVR% zXhx=C%>fF@6cAiJ;jm=jMuvzS(kZxsR~f2t1I7*s6+|TWJ81!4vo@a0?~I{0l@s+6-8@dx>fyei z8{qY*6fT-Sp<9(g+@n&M?olaBmMR6x;VikNEl9~5F74bepFpL#!QIJJn!D}MC@h#W zE~QbR%bn6FQ1aBHQJCh@C`^*QQ zs+CkM&@NZXoMbf6%@nBRN-~b&=K9nM)f3s1N7c%X3%}H~cR*03^t+q68;f7o4Hv4E ze|N)m@)wpdL90fg1ibuZ=O;6Ge3n8P_|z}%#upt*!BZwrrr_PM<6vh;GGR#3LW6Sf zZds#ABtS`cnIWW$DJzTa^Cjj_@Fw90^(zT4@_KtG;gRHvr;_mJo<<4yWt3v{CFYDv zCE+RJk0iWI?Dd+2=fs{T2|pc4c&Z}lN%(m)sJvFi6L#~8L@0jk5sCOo@W+xX8JP|w zC084|9$b<4!GCkaN0X*c;rzoe|K)PZpm z)5p1qX;A}vPE02gT{MM&dmnT&)6}?7qHC|r^fhf(`?5AJ51Hv>l9_3)fjwuYlPNDM z&%F~SQ`4dq%aWS5+FLoPOVOQPlDck?y0@gRD@yD>sT<65GLpI`*?^nVkx5-COXSdC zPf1;WkxofnR|3WF;Z5qYW!c4jPwL75Hrr13NnJOHz3)j~B_mbSm!z(@4ohQ5PwJ+U zMk1+8I@@lOx}IcFw@KY(f+#(yOI^wTQ2mrPVKz<^ptIU?dTTfDV zZd2BzuIR3%Cv`<%u)WP7qu>I??RI)4E3=c8-IL#SrP)H1;mz;P9_z{PPEY1{MVBo- zzYA%$(cY>c{JD1?H768K%cIJmXe7jWQ4W;$J&ziW8fke{Dd**od$v5Pw7~t#qjJ{O zPr+50M`c+A+gRW7s4QV}TPr24i3y^q}IJZh?^Y}FbyoJW(!rCf^X{_` zP?eW<7HAg2_b(rja(6D8pVi$F#^`l-rpA4>ZoA|0cBudD)xE>pApvlkMrOw4k?#G} z!&4s5f;m||9+LT{dpwh=Jh$EPI6Tw?-`n9~l`xgpdT=wfNMmHr)JkE){$y%Hu|OX) zwIqP>Xq-N7d0Ot|xys`7JS{i1R=j_CTGx~5DNoBDXv(6M%00JSb=H*ONz>Zf51xNg zKmFiLmxY_rlppMROTrKKXdJzMu=I|y_`&k6H5hEDS?KlS9=-l_k0U%eDc5HmvDXnE z$8m5>j~Gv6P6xKFP^Ya>nrW8ZZ5mR z^!GEDU1Wzo@wsfNe(YZ^TV^sp%3O9Tdcm&bzC|yb3@y`s$1gG>QZhEe@r$e;9zX33 zV5Gb}zB42P7#;~So3}TBk@7PUz(`4v*^TTyfbsS-_ukz8WimP0EJvCtpfGyx0EQcZ zNR1*m_cYHag5%s#1la-@ZTzM)d1yjPek`LD2s5Oj6!T_yh6)^$94e3{O5slUaiCQP zG0IC9TK!cWutw$omg*oq)RS^s12n2LH6Ez1p&se7`f0r9fe7`aoYjL8>N$=ZY&j~x zRWJ4)>ehaYhTOp`MPbD&AVb6ZrH#g^sBoK{KzVORW#K9_SP2z`H}3vPrFbbKt!{ zQGeztV&PM)8-~~C9QQvq?@_P@<>J) zrWx3HbW?YdR_^emeH#)^@$6+0^{~BWFY}7n`qwO0>Xlh%FXP!FyKfeK=`)*=49q*T zS$}1kBWMOvIkQ=Jx8=0!Kti?sy@RB^U#Piviy#k;{y{?}kKsq-~wAQNt zk3@=T<&n5U?`;NQ5<{k)LmB>F1$cpsb4*`SfEQDS?lp_D5a8Jv=TI7|X8|6~yiT&% zw9iH{^=#K5ZANqw38$SyaXr2UH1loRjOasX9{Q0q*F4W3&%*1pb0~hm*T7G+Lc8C` z6-n|;YiX}#(I@4Z(;jr}!xZFwBHsJM6bpV5-rFPY%PJh)-{<#G7Wt!m?56U2c)&*X zOTb9)@v%CeW+!pOl1X6{jh}9dwlCv}L^3r@G-#ThYNZJqygC9`7eo31dR7EMkM=pS z341AHq_U-3WsI0nFsT;sC}WPtoDEVf;8DiRZIV+8hMSjBiBT#sQyU|+E!}Bjri*C> zlX3x%Hf9p0ZIE&Sk2YrZSUGJ&xVhEU7`cKzqcY)&-lPyiB#?U>m7f$;xY04IMo$}+ zpNgC5HAP8rR4P@S8kFCSenY0G<)HjjV%nqMpp-NX%I|!wE!-?4*lN3PHx0^PeC~{x zE8q|UjP3*+lTrc>${=SGaL5F-N5C;v^&Pb=L0aBmGbuKyJf2K%-WQ^-enaRly3=no zr^e?~205F4Lnfd-`i;p{UTdP|aw@O&BM~Ub#Hm%Tr=>GFgw!X2!V_!1wRmQ8di~<; zsgYgA%XN|ldMC95u9P=jppX)KrUVKpp=UP&1#h<0D^M6K1qzfQrE4tfk>2hTdhAJF zfx?7rdTdcY;vPNrbdNw`a#D`Xc~P%GVURm9UrU>x>JgX62H)%zD2&S{$rkma#3RX` z<`F1NOe(TDG3pg4)VcHWT}0)zrbbuqYtBAUp!Pbp+ACq(x3Se9Mb18T2jsEULc5-- zZP{}6?gT;dM60?N?Yg%Xx;NtZ-Wft~(q3i;lj3z`1ieZ7#=%0o-tqEdtG_`%u&l&p zyRYlgg(rK&>sfR5B5SvI&faZZS-dWqwoA@EEk^4>x#FAST=hDg-)2!A=HeF3{hUX= zo;_#J`MfMSd$ib`vls0e%|;ZZ;#}>`F-iIQMdwm+t@}HK`{1R$Q(9+#p*w`zO{w*F z2)8%wZI{wG{Cy)(t3J*B-fvTc<1cC&2U z>SWjL)B95`l6GRZlWxDc=d^dSb61y|JNzEz?AuX+ zNgHr;;-YWZopOJAWpesF?)4hYtvU&zd1$RB)Fs&its;Yyuj!3ov@vIHaoEWeFscAV?rJVTHRb=zTc<#intkLdE zYC4rP$Vo-|KMH|M=+7tw@03_lB-(Ro+Mn!%r+3FvnQ2c)oSU;AGt+7P z|7?R04oeoteSWX6Wx($~%`CZ#+r>efq7 zOY@Nql*)sjH3?%7q@U#Rvu2N_@>~xx%mEi>zKZx zr)dvZBf9tWcWm2o`n&xfDG`eC$aJYP5MWOCBeYnhcK?i|JvUgq~Dq^ZDtM z-(`-I@E4n&$?tj}C()mjxSlr9%^fF^5@z={`JI%D8kIeblkkeMxeb+*-=+NC)Ho!M zo1GM8v$^)-X1n5S?sbY`5@}AB*Ujb*Z_3SP$4U&7(0sDNq{T2ZhDk^-+2dtT9qcP~ zdy0K@vf~~nd%B#zo|a-z$ZWa1^idMhOZIr#lc_wnne3yJUE*=FrzPjFSA4DAPkHyz z>k6dUyZ=Kq4vemVJIy>)!=1;n|5M)WJyc`gbOo7_kglRCkG`9YKQ-r_>xcF}=bbxN zBc<-9Y@lb(yY53F#z1%EX+OtmAQY0#D@+fCxN2@TbTL*VP0`JzAAnE@O~}V%HQsw} z9T}c9c3Q=@W9j7=&7F`8g>Wpx8wweOq3PK|A#Hs6B^NB1JuVs9;LwCOvQdY@=2Ekr z9@*&sBrp}UYF^*x*W+nwKbraV4#235{);}`8K}JT>mB?Ekn0eq&#vb$(X!00_c4e7 z{pgx=PT&|%s{Q5gxZ}=VkfG1!fmz-Nken*o9qub;FYrzo-D3pEo7?0`{0^?NMiW!9 zWt+mUCuI$5J@WnOQ~2ct0^LsG*ORh_ebf(Y3cr1e|FH0`zr!Bn^n2-3_;nZmF+C&S zvrXamVa0#EHLZ=-i#`xjM;!XYJE%fXjDPb;5&27(NG{8*^VN~qs?U`5wOw$j6V;N4F} z*q!LQC+8^biqfi#eO1K;w8QsW@3VJRT(*9zL)WjT=?nL#=gPw^`Z6Ig= zL+_jR4b1j5ePD@Nr|h*ts=99zA@Um2*(SQ>HKx52-KKpWyIpbA3Ek=s`+9dBuhDY1 z7|P?lyQY;zE2Zv>=CnqOr|Ts{eVE8oX-+>Ul6{KIw9l8Jm!#*?b$uE8qm-a;oMQMU zD5N!vHmASVx51|=O+H&0;|nPxeL2c7U%oQLSELN|#g!T#uUI=kDfiVVaj|OaAf?dP zpyc^jA2?iz`bH>WAHVed;xm@An6yWvnn28Dkq}&eNiflA32I89x*C6m&)Zw z9%&u-M5jR#B1cr~vl^D%uK487qJnq2YY`e2=3Pg=ts zbbvi+1P|zQyXZ51NDtg&K2};p`b?kb&y$=`C8<{unvlKqN~{TKi~5!&XGBQ}j#$-^ zMQ}u6dpe<&CSpumXvfvExM}`uS{9Mkk0J_5EkGwtd?_ZNNUBjrrKVy$&YgjxuWA-v zYbTqUh1S?@3)9cZ1-esEB=sm%pqpekCOHR1AN4G}Y)@7_%LVhPz}D2niEb7-y8=VY z7>sOH(Zq?}PdwmNLb$Oejw|;*@qqi&xa!XC6d2XXEU%kXb_EznCT9^~Y=8FtRaefX zuPsB&>IPrp%p$rI?v84uI5pdPUS@}Ew9RlQfA{kDf#K1l>FqR?wyi( z&0gL6Ago3wPft(DOWnIk6`PBr)sD|Q>!cFs-evaAlaZh1$;k5x_Oh;1@{i|9OzLau zuq>TCJv}2YW$)&O)}H1d8w=X;OQ*Qe&-y)gVPM?&>egE*@l4pL(o7qlH zh?LB1Q?kt!y?I6cav~(LnwvMd<`wxPv&|xZ6E@@bNs<3#H?uAJj(caeT_rS&{F8mp z($qAB$GIy1?t0BMB88d)S~ZypWa;L_WG0p`#w^^P2BZ0Pb~%3cD(!91>LSa3q*Tb1umsO>3$VB zH>E76s>Vo#l*!1E3aLDGW_Nz?JauZgmRTe7)EUBRwoe+Vkm*u%KT^RhGmCfE`N|)E z@lC3uvh@nm#P_t2Dvwl1_VcqicT#BG?NEhkcc_BUhI*X4<1ti${RHa!FQYCY4^^1P zLlu(U{A|9R&{=mkR$+RjJ61txLp{FTB#c#HH-XA)?KzVk7Lz8)#qhjyRCJd~H?bg7 z=3;nmCY`n3nTz4=dnP?h>#fVh@K__NM6Bf0Gwxz|-b}j8X7#=pp45qcQZnh>KBtyH za9y+g8%dGXkH2JQmK9OO1cJioG90Gv{dn%KVgkW5l{Q;&?|!`NufdOZWuwB6Pxg%E z0tmt{qbe@VIP9Z=6vue{__nwEElVvMVV9}#?v|2Bwc443IM{QQOG%{93Cv4Lq~_Xo2N!w< zaiqz+xyjZBqy}-gb}GBn$w3^hy}IE(F^D5+x9)gaZ(POoWm9n#*Ne>(S8@GTvIlAP z(bPf`Q^)%3WK1L@q|(N(!{Cd_^g6dQn;8cgq!()YBO$3ULw%UO=fF!yG%>Y)`ihkM zKQyCn5)#=2cejW|_DGP_g4(%$&+4=v_RtJhiJiWLg>;9VVl`thqgtYQEYG`y#fK3I z$~H8^ows*v=J-Yt3G#$yQrgh&BSFYqi7f6AEngj}h14T8om8EcK30qB!?hxPpw|Cc zpZc!LDI~RX#59Gj(=;PQQa@Agv&fEFwxHkQB|dtzwZ~m4*!RSi)>egzk$j z=fK8xEb2f9#lpP)96h+T5^h#t30RHw9h`#qB|t6JI#GC zPs>=*Uh@oylPlVLV;SC`dWf2@j8MbMIMq;( zl6LL1^!0=*)GEchuK7`_B5JjvjZ^y~M9#jhx!)M7TUjT8tTm$hF$rXeW%O~@>$LA| z_!L7Or-aoJVyZ}}N56H_||)lo{W+NhMOwaNfeC=5~y#iX4)&87J4G##U&9i{rU z(Ly%M6U0_&73x5(NFAo-sG~K%%JN1-AD5ivw@k0rYV}gBLC>RAzZ>t#l@UTc)5Pije0J(gLr{E%4 zYKqUPYE7!6@Vzpk9j4}ML#VS^r&efH;!5+Ub@U-xo@(lYw5S@=>$RZT=9LE;$CBL_ zl8iWyK1WRPs}cGvA({fzujHtflBeqQ`>IM2P5R2$@nb8eJ6JNmkE@*SV12H>$l-R9 zZ0@6c?4a^LqzCRLpJIux~O8ks01wX5nU*S!S_=rW9=9IktR0u|VXNZK3vMZCs!f zmDTl6Xu+A`EJ6!pmRV@AqlNQRG|Lth*xE%`lnQKBDRYpDW9~ir-L5dpb*x=0Gmo4O z@rnebv+7MI%J;)cg{d`*SZBab(L{imKaz}S@`o-$$!rRd zKq{xn!{7h=_Xp`($X{G*rs3~PE}C~te?%b^Du2Q&&Cnj|cB#47a0>{7G%eLQpHR;5#+dsY@t z=Ei@#Z2o661MT~s8_(ZM^2!y~O^ti9bls-LlUcdU)OeHA$*YRD1yKDAS_zL-tJS>l z9;e1d>dccGKOVYgDS`E*#^*MPmG|7#TW_iH_A4&Gkme;@M$?6{?sf;d#;vJ0_(|*&mJq+-jjE$UUTDg|DI0;wrT~OB0A7HWOue9CC^E&?#iG^KO zcFT z+4ba*r&jm|BvVg)Od*?8-?_ZmV^S$(N&#m}AbZOem_SUdi zOnL9A_1vs%fO4w)H?`jXg{*8Uzr*J0l;~82U8OI#PD<&AoRyu*3$dn>I-CJcWo6yu zsH?#0H7o0;OuYh0Z&ucw+6QX)jJ#4Gv$9fVNp(!xk-ypJ#8VTQPxoYICnqzr+!6PR z-3L|rDpT6wR6qXQ)3WvBMW})XRWUYQuT}%bKt=Tb2u|8QF&xz07Jz<{^>u36q=bghoq*Uvx&8-p2 zDi@jscBv=V9HyLd_FQwJt@e2ih}?kf_e1^IU9Oo8HX4cq1DF-l4Cx7L)7w^EJ_Lm9qu~u<)K$>Lvp90)-^RR?=~k;|NlYn_c8odh^Qu z;zUsucO+9bpPCV;F%|X2v-}AZ=2vr|z8}Pujgzu89ais;in> zDj*eIFf#l!t7_Mue)XLtryb*V9o-;+MG=CX9j?dj>X&5ym{tmKU3bqNz^o}q8*eJD z-yKB2MmdTmq~&N(dVGM7Y4t;$UBU&MGiiu9C>0$bw=T6#fC^&{x62^}$00f(z58y5 z5LCNE2!tEwi4IJ`5CZAOd7=aJn#4i@*O2FTH0d3wICkeb7$K}u`1YOw1T!$19-HVn zGb-Hy1Q*keH#RT{0|=xOmx>LXbJ|#}6R`N=qgySyTjuFeQagt9Le@O$4h4j&3|@D$ zm?qgPH)BQ-Rf&M1lW~`s8a0$9R`j4`I$i27TZC(cj#fAG>bgJ zJgu}DabW&I+S4L3?;oJ|u%m_$n*?%skCISAZW5p~12mnr1N9?MgdK=k;uhe~=RGZE zKyk(U7IObKoz44Bt}0?Nyh4LbN3=WzHv)OYOs=}Xf)blvTa$*(f zg_f97jP2XvAE$_|R=$SUO{XK`zQ9w%TeOn8S)vrXeQlnc-lEYAYKe^C@tJ(gjBBM1 z?gD(aNk`2xJuXKyNVTLXj_PHqn3qyoy-6xaqrxcHFjpquM=1O!j_PQlSz9TO8glK0 z(Xdp5+Gy_d8+3xs@fU zk90aZUwdNhjYrF7KHBcA9n5Y7;ts-n=j5q~a^*%*Yw#%hhW& zOD&>IsIHb%HaDRf1N1V@G%EFCEo4+sYBZN-o{4J3lnf1O3W<+tE+NgPB>;+aU5k)G z7V3_cZx)its@(oka@)2F%zRo?lSKO@Q?~ScE00W8*A1KM9c?*!h?HM3Gh)PuIb_I& zKW67xQPVU?HDO1o1=kEGkmIL80JLq9>MKIV8=xU~5i-`WWtw`Bw?lS_Oguo_A=(bo zoSJGV91PK3(6%i*6r$~*KVZ`+hcN8~gJMsyEP4^|`AK1>(0uazGSYg`{DBtj@#%ir zQ*D(DF%b5PecNx-o}c#YpdB#$S`L3K`Z!`=@%!oH^2el)6tn_HjK7GDeJ!Bm@>k>| z7WD(HpcAliZE?h+BcvS->UlODvFI|;SEkn}K_%a&V-{Z`ag21|bc8P0PS~QOCcTz^Bpm(!?0t8j9L16M zc9`9_?>#-`oP~%2gaQJCFd%}+Ip>^2&VmO|1lcCp1_RCkY;v@*$zYotLYnMDoqclP0Q>aEN^hpSs(M1#ud2GI3R&}Ms`A+cXA|_b16_|D zUB&r?9`7(ZZ*g7^)R?w%KH>8g{p}!ysf*WRRD%9=-VU|suLr4d30e~0Vi6OQ7Kcfk z0P?BDLUAN$F`!X{9VTtUZPvFDmBA~C`pe_7Mh_}G+A@{l7B?i}sZMQ{+pxKD1huK5 z35b0Rlm447jne}r1uVya6!c32|Gz8PnHyB^sXu?h@<(8EkJ;E?rzorDUdmU|fR zFq5+$8az-_d(^w9@4NA8*u05O*vWuO@6rhoItcQe+@Ie0#S=GOdG5iRLs>{q!#%M- z0s=Mn)MF~6<821pU^B%CZLtvnTUc}_s&N9#^gz?0hnNK077X%44L43(=!cpeWIF8t zY^&(RZqg2Hq8?T|drZX8}2PB#E~Und6t*Q+i8EY~`!@VRSARpY-7%=&~5YpRNwRIlML!~a`AeHF*LrcgT< z#2pTHKAlSd@(KTi%jmA+ucWRz68x3mFAaA)!C$Cj@BdOrv6S%Nw$tJ-i+1dk!OQ_r z<8Rk#2U`By0`kM(3U+_^TVpohmY|OY+k*8ps^77o<6L%LH_;-`TtA56&pu5@7s!vC(*`}zjq@} z*W#tH$j?4~!FK8DY47O^=KIyt^Uhs(>Vi%D>gjpso^|peEA#5NY4>d-C2A}LBk9=2(^NP5z-hs{kFNl!XvU;1E~gWsp0 zykNg^{sUrU)i`21@atcI^g>Ega>jzbWJ@I6LjNP@BiUl_ z(zB4i;Dn>*p*#P5>hTA!hVF<@qT$pN4n_A~Y(P!Hk^r|kWUS7e(nA~L#um=Gp&Hg0 z^}}9K##uE?;o1x5XtkBkDKBE#@a@)^z;{W3TF$Bw%Kh=pm%n}WnFnvP@;DYn4Qiwt zQFm{@`SM*?oxayc#*-v9a*%s_+0UN&)|IF2u^z_G{^36@To=ud^I)2k{XVR4`+kk< zFM-QH09HTf-|sPo|ApTQSYH9_e=m&pOD}u%QI&L)Ui?Jomg%AYOXuD%-F7D2sSo4t zFV$oJ1D*Fl{@#TA|ApTQox4Kk_Nz1Tozmac{(o8LE`ps~_WLmE!S{1af2kh(Z|J-a z^7mhm|G)5Cp>zLEo$~kUqhkpCY4R_NRnI`>1ZbI*mH`p@?JXVam} zyPng48}aY2(P94%o%cchehvBW@o$CBU7>T|cb)r>rbEwx-hVHDvHtnL`1fC{!+r(5 z_d)*t4f5Z^-wK_(Lg&8kI`_TQU;l`_-fum7D(uV;)98*&X0e8t^WEsblwN~`x)fFhrbm%cZJS<-*xUkqW(M^ zdjGxp{VjSf)>;4PfB!A|>tCVwKFHrsA^$!4t3L_JbmYF<&RGXJ z8P7fa*n@YQH=$Zt4LOPBV0sU-4ZrRCbPcbJ=7VFvmoViZ# z+h?72{NelTu+do1<700*mF==tCfbQ{I=Zt1&k{m*~?`e(1Nb&dBERe1 z4=-+>e>Tbu@RjVf?HpTKJG+vO$|^YM!qHZ}h5_ zTH0;$^vYXcd;;A%JE!7$`qajizV3&6n+s2-iUV}@J8wDDRMyU}9x`!o3g4tLkeS}3 z$&i_Lt3swf*k+@VkePOy0GVKXB;9TUncZF{vTnY$uKROyDQ@4de)i+nUR~S0CHLyb zui;jyS60FC+jMW=_#xjq^YR3A=ezyJzfc#toA#xV>BFEqY;i7mDS6SoFwp&(+5O^; zAB4`yOZLU&1^s+2erm+WGL3y9dEP!p5A;oXw&8&Zm3=;W&Mr~UI{zSrBzZy3+h@%) ziU%aUiIH8BJZqn^PdA_P{IkvpPTQySla>cWos%V&J10-sC+!m&!wih2FP*iI>&N&d z>3neUyY#GQWpBT!ObbtW{+zDL)bwTO8d4d@2mJPrsSFF<<{{hRfV5j}^-7W+^vtNd zbMn#q?>KjKpE;}2*ZE-YyEGSOWs?Qs!ULW+6XMeMpbl|-z>@{yLbr{O?QlTatqO7J zK{v!LIAqUl)*tD`xp(p8eme_KiC&IhzVQR|D$={j!N2~P9@tc#Lcjer-W$ueUA;6e z%&Iqj5MB-QBC^VP9zT?m^lsP}24v)+Z-QH%Jnx=MxCzhy$NmiyiUf~eFIoEg-~Ib9 ze)0ou2`@nU^!(!|{?yyzi6+mer%mDM(@T*&ZJtumJ4a7HJZJR;4Mm>5yg>3!n8yvj zpK;#=?}UA<@#ym`FYZm}?W5)qd9M<@ZSn>seAa$neb4awW}iy<&7$7+5&M1nJ@Z|~ zZ>RLn&fD+Wht)%-(BFKI&fAB~gN+BCEO4^lHE6L9ng`7NVLT)uP}m3T{pLP(uZm<7 zFQTyb+xyJD_8xxUJMKd+igQjo_K@8-pRxGu^GWq@H>WG9te(C914!X}?Z5Ky${7DH zZ#Snlt}?_Q>@;ueRHV2F-Bwz&q8CFQp21{y%^9um3UwYVXf)(p&!`RF!&eb@x_t=^uXg?>~S26@Y}| zb83lub~5SCKm6Bke)0NiFTZTkCQUl(nK8uVe}4O`fBn%buNZFCOh~N?FXa%K0KfYA zPhO+YG};HIBcPb_rZQV$dL(A-0#hq}+*t9>8KeGIr5aLM{;nqBuep8EzG!9XLJ zw2yvJKcK-!qmR1VeMhr4G0+3l$1op*KI(qWee~VxJL=ocYZl9W48}u!bgqxS%Y93; zJ|RBlVS_%#_tEzdAN_50m-?3aX7f%c9a17$Cj(*BNpmNSPU=o|hxUC$ooFbB&_{!j zMjw5Ly4~GoAx!!h?qisbzDuWl)NT4!71WaNV<1cVXy(IxZc#V0>OvoLkGY%r80JHL z^zEUKzNvX5^qBRX40kf$lur6Kb*ly=eUrLT-Qcd*Q7`i?>1A%$G^AU!@1?I-*O55l zM19Pi2I8oX<~|ynsE_)F`a0{!Y9I2;&4DiKTX@n@`);!enT!|qoq6IB`|L2cqp~Vg z=Gmt%IB@3;2Mnb80q386+6jm4x#h%>WHMfO?it4)w&xbBOsou|7NGtP>vybzGVxHe zCm*%n_UjE?yYkjz*x1J%vioLJV7{&1SL>_vRr`9~Sybrj4A=#`Z?O^?jAx&I;!y|g zy4CuS2>o};v4`%x?VK)1q=Vy*+<)gy$3r4@JK@OvciLnnNF+6R%)xtXHM<6h;b7JP zNbDt3bl)96IuR0A@e-YTdk)mvAAbF#XCJ!#E1zB4{deP!zj@=O$L_!L+H1c0l`nnq z^PjtVRri~B-u%_;FFtnfZMWQf;|Z8 zZ{PLJJMXw1J#M<;`s==)5??ja{Y&Gm|N8YCuRim=2kyV`-h1x;&bROS7WKUK=9_N3 z{dHaxrDcEo&wqRUm1iFL-uJ%y@Iwz~1m7frTW-4XhU+5f zSAC|#Evmis?jL{m>!1GM`6r)v{IN$LedPO~EFqPF%dlA36|V92?|=JmZ@l*0GfzMD z)RRR07^sQ-p`7G9Nittm7%MLP%FkT>(sN6eJp1f3&piD!Q+weu?r7k5-ofPlQu)4p z?&_;PbH%4)>PWaByT4Jmrzttzc77tbRaad8DG^Pwg&J4R!oyvo`}|Emc)oAfGC3}u zM*rzg(!h(8$8|$C zQPa?iV{ak91mufp+$5Usxlq%E%h36y@t2+_$E^qX#}{AdiTR1ib$e=g;ctK%;T!K? z8$Wm=znI7`Ajw30&)u!m^v-0|cxma{ap&>cGWo}lge@iJCl<-(H?D>J$^!W!kxUN^ zmo0Y*fefDFBZ+R`KB{#MspY;!)VOqhZRpk!`9dBxNxu0e5se2PWD7OF@O*bu%@;GIZPV($IY6OQ+m@p8SlMI2G-w<%N@{Cih*)ap@pO zO20GDI1QtwJ9hnbe9u@kJu$j#EIXs7OUHfZJJ)w^FOi>q+Nn8W-0`n|gu=}o`1m74C{>8G6n@)J1WqDI-!3(j4LkjsVV!M8kQ=jj?D zm$xpYS~ExNHLqH)EIsG+;}6??lc9a)sY;(l(a*C^KM5g|v(G#Qp6IsI(47pfQ%^YR zfL%69(EZfokJx|54F~(~sEhgY=Lfhyz58E3dFI~hF7G}0#N!jU$o!)5=D+>$$-BRC z#iDcZCZ2KHDJPwH{D1u9xrc85@+V0*UWk_rPx;K#ahpy!?rOn1JVQ)ey!uFSdHSg* zpLoJ?grj)1h~NUemAz--tsqXvW&}vH2~K$4%;{JmxEL?;1$dS$8k~+lZUG}Iy(Ot= za5~}mV~=5|ObJ9Z#Mk%u2jBN9e*zcYeEXhgyY(+C8(ea9RHfRTF(6zS1VaEZ+I5%Qc?gDpz4q9Bw_SEl`{RoJc?j5b z=bZu{I*(fZe&_nXf@;zIAq*kJQs{r;8(*Eg_G`$7JG0{QRJ zkK-UK3c!E3@{kYgUHmRB&(4CGLkqKeV%1Ss)=bx#x;jyCr?>ZAT7sQLk#WELh(3r0 z$qH?q`?zj8_VLw<%LAU1_)4G%D}xS66!wx5q;Aq`u07mA(OI^}ch) ziANr=%jQ@o2rJ3FPQVwl!$#8}F1r?p;{#qC<8=bxZ6d^_-Kr3m9&|$-)}6e=D%?Y+h5ZuAUzL$Y6EKyn=k;#f4|&7sn~T>|FJ$RqjPB1@KM%CB`#T>a#$o2slp;G zap|Y{nRacw*j+&3O}s;g(aQDo^kH<>D7+a~#5ug_AK=uHl~HN8+5`%3@&m+*IEOcV zx5;Z){=7I{16sGzoYmE*AFlLuZR`V_cqjL#mFwy06RATc4*ZHZ2RQvxoD7+1w<=`% z1FVR1fYW!I0GSAI`eh)OW&KnZvfVSZ z$RkfQJbPN4#6nQ|oU;W^TAZXeF8}OlVNyL|_$)1^<`*}0v_P6IZdxqJIKP-4mQ!Vk zlomH>fk)2fmprjJ6D_^VLZvK)S}gp?GK_s9;bjjxFH4^0AyrrkrG-sd@Kg`*dt2XV zaRa(&cB+UbvGS8QZ~mOl%F5{r+BLW`o(@i-tt{h5SB9snlv5{D;nA?OW3@^(J?L4d zvQ)OaOzyKwD}D8idK+h)c+~7v5sha(Dlgr5awWBQF-p`Rq;RMRZ;u z%)iO>24b1<>6mwTlWAQ{JxJp#zR9$BZy%7wKawg-^kM1VVqq`834qquEG_9{$*XbC zqbY@K1CT|1S`4#y6DPyl1L7rpbGN0Hy>zw+FIw!kyy#`Io=4JYRJ1`rc$x25EQeVv zhc)l?I|Qi7VqwnmN*Og-S}Eh95j$zISVObChGuRzxADZRZLs(qnuUk$J2Rb4UAD4D zI#E$X1V(~~2$UBYn|7;>tqhfe1F)HFB{C9xw<%;KWZMa5R+b&U_cpV;`l`z+eYFjG z-=TT9|86tW`BaC%bgGVpz;q6x?#S4*TNMK3U@z=GgTS=gL^2by?F0~bz^#r!u)| z2GcxMw<;{Vhc=QVv)kNmZ!@==Tinf>)deYqFuyJ6sLkGNZpzdJ$s&&CR(p$~mK)6t zj>n$oNNpBv=6Zdd@){$@k=x95<{SF!x`d~>-dtzDVZLszRo9R_i;;*t3!X$rZRQ&D zHT6};<1{y09!0uh&OY zC!mB+=vG^~QV$1nN3TUyf4p-vdEH6_CUsv&qtchGpDLvBuy=#y0C}l8szV+fh~)rz zq1#52AusJ#g}iXE{z%A68Bc&bnA2WfsycoMTQ@TucqeV%f0@*3HaOV2C8|fiIJiWC z(Y8EP{$Zv+|4B}Tk=FRrbFjVJnhknMlU&X+@5Pi_4eDuKV*ipY>Aa#U+70T7;6PM2uW=6ZXb z`$phdu5y~!LZb#fR;FCBeYwiD8gA9T)m&~qtv{twT4@zpeFe3ePnl2Z%UEmc#^MHaF!t~V9bKuc zmFn9Gb#nW>j-Ec4_V5SiZd7H29FS=_iQGQlZ3?-4SSgfm9_;kW+Z^KBW_C|s*ZNp0 zZ1gsutFeJU#LOTtRk&jzFjdmiATa3VnN zT?5JzyZ1$%zK$LCYo)4~4NEwFUY&A4DtSd=_kQ?lB4|?c(ui`SvL~g^#iWuK965f? zW%BVwU?af;gr%N)TY_WdMrGVRGbynfHjP!pMrH8(iYBGPru}S-cV<$WXwyEO%``GL zw3hmVydATRNvYuZWxQ$Yf8>Luyz?3v+de6hQmT-f53&l+v4OS}ok*@-xV*iOv2`jo^n-cg`YExR)efnC>Hf$y@ zZ&T{8iRD|S-&uoy#aqRxCbl_^slMdAW!z2|t1qaOHrTOweX2gEQax@{ZL3NDvmQ5} zRafiO2F}xxmM2}TuGBev$Y`lmLsP3OaIGbpI@87K)0vjnz>iqVo69vcwfbbhfL1MU zKBYftE>o9=F$+RyAVkpe<}!V$xkO!@=d3*jn9Izi`Vw=oxk!CNXbD{eKMXh<(3*?& zMdlOc(Y=gum1T>U@owRn(b5io zgA_2YtFjWn%zvsjlp-j>FBwbUAO*~uQt1u{b4RaHu_;bYo>_TEzEkTPutBA-vaEO6 z!jtip(9CF^h`&M#mth zP#DR0(aF(=NU>w0Us(w!d{kcIA_f7J0DcjC4Qqiv!Y%becRQy9fryk(OKd)QZW({1 z7K2)VFMI$3SEV(W2~a9^O4L)P)G0AfQuL$sB__$R@cORUf<9T5IsOF$2BR3$_zSO3Ebr!6ITj%v18&QrzYcU zBG^y>VeLUU1|RsocC!za)M%ks|*g!`5JK5==-D}dj^M^;gaA`Gn_Tfxzy9=`3v0XbImyh zp4G+uz@h0iXPdJc3qQedTI5gk8trDGIkR!b$09g3i!|Vr+RfRT+szr~^u}oyMsO?g ziN6LtwVTt-sf|<4=j$UlHh^PlC;r;En^Vlm&6D`@V(~<-K~Bx)Bz>Yf!Flm9d+poJ ziRJ`-ygJT#_Bs`BPSK#Jc5}Qr&Kz4=K=uFvjlor=Kx68v*60(uJ>T|&Yt{VAOb?d4HWb7)UOm3hv=B_y2Emy~f1_)0FJ zzDS&02{@KvAY8t-4xu0v5GKO)GItQ}TpMRFpcBw>Ij$hEX}OM|xuiX=3NDG08#|#z z)DsuC=wb?{3g$&)_K;RYyx_i;;i&)~Sp%l83{3;v32l)xfn@+Y9U-|nLo*TwC>1Cq zoX>DNa26mXpfn5g!VE?=!*GC6jaGAvIa)`Ybp*1YMXNc=9H~+WHz#Tj!9q)|`UrEl zia2YQOPs0Ipw%3v4^^d{rPUm24$%jz0%z@Msnr~84$=pz63*sO&8_A@dw|+s@fBrq z1FbpG9ANf0`>B07kRY|(Dp`b-K77x)d_Ivz*oPHDn6x*hH9`uM1dzDz1_aJWPU%zh ze2i53TZR|)pnNDFBxJi+*bVcJV@yFVCGC%C4U%S#n~H*@+0t0p)q*qzem|M)cZr=n z3X{snL{6Zg55sAXjOFlc5fTO58h1X_vVSH9BMOuTw=!P0BBzW3r38E##Kw?_kJ(EC zrD0j#+^i5N%{Js@?qNWh5GW06Yk5#K*Eg^8%U$jKL&dv%im;af4Mj==?9pm}d8D)m zdjVwhR~!ST>=PiavZimY32{e_SZO(&25|dJVx_tS82_?ZX>bqwi+8RDhRug7H$X6Alo5!0|< zCu?r4Kt&PLV#GB-RU9!5Yj(wmXdE#W=UB#977?Y0DbWZ1=3_;`qKK(u7q!*J6xbmb zQJ>{FVjIR6BCauL=`$T7x`BUiVKWzyz(t?#;NrH2L;@~-s>?-mW4I+3lb}nV?7WMd z@y}dL0WW=G(SgliQNT+dU&fpK&j4NkzJl`_0GGT=f<*uy`<}7y8hlTIMSWBlwQwfS zRRC9jPZKOgP#!qPu&53buQ<;+1}}9;4CR5A0M{HQ(54P5<1DQjplJ?N2ap+Hj?obu z=V8(9SH_uW1vJgRZl8Em0gf$0s@d1wmtOj&Vzgj zNYX`j)&D6ZPt>}*ikc>CCwSup}k@~WNN16d_s|TpQsC;BrmOleH z2Y}UIP>9TCkYDCoy3gvizNL6^?kc*TB5e$00FrbevwX?0c{zt?^X_B7P(i`wr=s|5 z0Po-f3J5kYi&jZ#KTBvPj1mlNUQ&qPW)K@7uyN7n{4#1F&mcBHRO91U`-Rl7=$Jul zSQHFV+ANBjMOlN#7NWG|8%u<^6#_$)wp|pLqO2iG+a6-gxe}#qyhWG}RBpN|;rhqS7dB%s)hN2}0FL_&nc7 zfysL;MsW#5voLKICC;EwV6-euOZ-Eamb^fuXjg#R0Mi0n@K29Y zM>_U>i~KVm)Ev<~oTJEM17z%DC$xEJWCUc~gO5s}*gTkH%;heu;9m1U26`HM%shrv z7d-3K|BYJ>K*;52bp(EvAxiJ#+R_Su>AhTJ2IOJY>}>&IY7Yg!TLvw#Y75|}c7uV@ zFRV6pIj8{U#Mv}Ccnb`!g?`epi&oCP*i%6i%Y$Tm!@8y$Ce(ry2MMcmUvMwo%SLmRzMwhb=-@s1m8=8 z7vuHk)Mxe8>MD0-;6>O=PBlrSt)S9N(>5V&1X7=IS7ep}MQ}AnPwSW(TQ@^5M1QYP zmp4DnKrSA-Fe8tYx@l&n5j0hot554sxfIZa8SMj=UiwPur9Z8Jx#}{$^&A!^&zXRm zcu6mWlzlIKsk%h=g^GVoAztaldrBcuV_&GcRAa}Gx=8U}DB>k3PZB9yOTE-(ntN&N z98w=we&-U|0$PIDYzt`gQt&sam&OhvwOB=7vjnqgCo1vEdTHzO~5{S9gx) zFnaKoNg{c()Jvzm6nV>M%ecZWDdI&wt@P61MZFXN-7TbR%=Rh~FIxQ7i>McQ-qcGk zRA;&~=o)E9l<<-z;?RryZw2tzXQ_f z`n=Ffe0l0cpvPf;hklW6p0?vOb`<^b^`b3=M*?xjysCpJzv54~ikl`I`g(3p5p zFMTrg((rIqwERn9X9*pLK3e*~gI3WJGc6GlAM)?@NzzACA9&e{4G@YUhyg>gXq}j3 zQ6G&y`e=2O;-zRYBFG3Jl+X9kN9iNg5sH_iB@8ZojORoCuk_J}tHUIqEnYtbv;>`SQZY987&Qg4m7yj^jXg2)|1o33N*zy}#a1?;C>M5-8Uk5zydbz(soK zee~YS`~BL-3@9p~;VJ9=4R}xwy_eckMZtE78)yJKfw%O~0DZSRT~B7pP!Hl^z{BjN z_tfy?^=@ugF*;}*5z!znBq8(I^&aHU6TPAK z9n}tH?Z&s89rX@+d$(OiFNTW&>yK(Sl7b;5ZDhKbjm<~(Mry8QIx&UFtRb${W;fDv&4zBP*yN!$i#D^7L7Uk?eT1&l zZZ1ZTv{~O~Kcd$c6UuB#<`8i-b1kUsN6h+Wy~do)ys2b1w!Y17U_N5eX6ER1HB;qV zELzOEcDBO^sl|ey(Af1Xx0qRKrcSw8aHAHxu90rfgg2&SO%VroU#!5batGOj#J8k z{FtMWeNSj96CF#&Rm;HB>kibJaK3cPNp(~iu?(Ej@bPtv?A(>h*g<|IW#1#glzEUP zr^L8vbk~?#GVx*Pa^r*?)JGhi(bBM)Sne4_(>>?w7TLKgr?G?luq*J@4(u@X$wg{? zdR&)W%;X}RE}ZULfj%2OW$?nVMKnJydR{3pgwtK;`zF%EjSu3H(2IvHg85<7Wy^I# zG+j8QFf3C0(S!UTKWGum_l$3v5JNO25#%?<%f?F+Q6G2!E;ysT@B&XPR}ImWf{^aI zP}3{N)VOsd9NEY|0W*w^NEm+4(GBN|=BxGtr&x$put-8rG&a}T~?vNRQJ$Y+U`Br~yyrh((G(+kV8 z`M&SBFAGP)H{2}Ew2FdHr>oOmpvT3xOs-l6POm#%w@{1lJ$6T4I9xATxI(K=Md0b= zS57*SE?TZyMAH+ehejh$hYsppc7_!i(<<1P>V((me)G6-&-}o1)W~fIYLM>)I~M^l zmMgRh`v%pq&(lRSu?(D^H{CTFIqo{BN%&4X?#MTbFPJtZ67h4#E@&mjz+-A2I>>j} zUT#*PRWN21B3Uodu=$3|J(J6(drq>6nuPDL{r218-NenJ&5nTE%1ZbLU(7ibk3wlG>>ryHJ%#$`vcA$+@Sx7}vzL87A%164!fLfZZB3HtPWBK{)C=1zh|jn+;O_)o_Oo6=5NU+ zJxu5@Vj)$ue*-%-en!s+NZsy;#qFwg`Q^?#@vY(;O?P_!mLhlFrkiZ+-2+9YKZeU@drJ9+Q1Zp% z8Rbbg+4!S)ky)m0p;SAoofJ%Iwf(Q?-5^@JTE1L}1?@*S+K*+znShZ_qt!gxj8bj) zYoX);Z?XAio6QTPbLR$;IwI6wq}onx`zsl)ztqjyYMxPfMYmVkt8!vuD?FhX)G$zK!r}{ z1QMN^r#AhajCG^A8*aG41|L~}{q@${mE0Q)6tPdp(>zd}4m8lIP1MG3iogvw_y`lu zSyy{;8p9-ULZ)$jF`4?Pf(`zAl1FrN=B&H!Y<7k;J2OJ2`L<|3N|GjIYC{DR{7)Ds z)6JR%7l~XP&BBOEvoMWoD^jWT)p}}T$AQoq4}D^=!8biQ0u7a zjkV{q9HG&h1{#v1aUY0A6zG8JAj{DAY8OpuJnAF(#6rahEm5q;c)kUr!JH)fx`hz%Cm2OMl^?_1Cy=>aW3H zt)W&|%$*!F;;ub+jXO)Dq24--hI+4N*og~$HAbQ_l6+syob_sIRmFS_^UeBd9yRf$ zQE29?S5>PRIBRh6aL)r*jS*-bLFma`SJ5jgcKI}1G?5>AYR^++ti)5Ttfx9$6}fqO zw!ujC48uG%?y-jS&=WkT>Xn3}fon$`4P+C?te<9%dL=c*!3Cs#CfCp4YBVHk8YA(W zq9$j(40AIqHT2R`6?*B(YLWsk1DR%R1DVvzq`b7}r6;M0F70KaUIr4Sm!3?$)CA7) zUEKtwQ8uY8NQ#d~_u=nR_ zJiuVUk{8S8*$(pOH{sC)Hd+5oHjdfH=RX>W&7I%Kj|P{UKR>sOJpgO&hA2OGjJHVysNlELB6ueTm^4_8Y#$^D_#$yN{pMY{X*>#mE_!acA7 z|MljqJ9{>B!Odi|Ld4SfS+ihp2=s%yu;KGFXX13$UD%-i%o#I?3lB15L+967hYSd^ z9~hAVbi^L#r%z{$XYM>2VngTGUK^JbcW3rEzt&oGn(qy`gzj{HO+HOr=%Q#e#AdBE z*PNCL_1&4xn$xDO!PWtFr@_!@xceGwtS%T%Txjsj2HjU*eYF75q5E3I2Ip7hu>>xG z&1$Qyx(YK-xrFYkuCg)#HZkY1gUcGLQ}oTl^Og3}Wx z@(5*!QTK@xCt%=ZrzebWb9($ZzE01Cbu;v-8n4C?qA1qbiZpgOJGOXMQ{S=6#?Yt< z1E{YS4rBEg()jT?JywlTqZOloW}X_EtoA?4@4d=;{*TJ%Z^?T8I8 z{(JQEar_Tgw(<`;d;CDRxN>3NK-XJ28~?gWlkd_1WRpUsjoFL;L|@o)`fE-n74mFw zI;oIngR=;SJR74!Iw_>gu5mgkra=O1&LZr)O`nT z#YYwrpp-qf1f^e*|0H`8@=2cUbMGvnTFfmEj=t8;r;iP3Q8-EKE7g}Ne^>SeH+?Cl zd;*j#E0}zR780Nob2Zv06emEDZ0F%yGs?3_2~e`L@po*L0HrnAtpAWY{eC;n)o4*P zmS42`+wyrmO@0)-_islR7rYN84mb^{f1_3&;S1hVnfKcGGz}=~A9ET|-)#z|0nHK? z<7;~=e{45GCh@oB`+Q1#zfStH)FCi^^~Q1@Q2$O%fxxs|6$1UiHXDuNJfObYM9Kr2 zB`k(ODt{~j<>ep+uulBYIT2_)N9`*}1X_HL+)JZNrat8XEuH$3Hb9bnrs{*uAbyYHtO4A<+%hbG6qO4Q2B7O_+^LsCQqx{!;72eorN@w zL3uN-%H)_or(Rhln`(n3O`{~)I!1*!DYwtjSe$f}W>-I8{O8AkAp4X!pQACJbu?4r z42?GTIg`1YK0a=jpkGBFAKM4Q=S(!~=yN8AkB{@*cs}|MkEFP^y+7pKpf9Szr%c!u zopQ@QFt&axbolf*aLa!hmCw;=vCTSsUTkkQx0stLM`QSUD}3T)d2=;wiMBUdj3Uo5 ze3Wdk!5MkFB98eFoGdm{mwk6^L1(U`ZOZyu)+xyYiNd)XYeH~{ZW%mQU%TP`7@O@_m zRWP&8Y4JiaB2J4Ja2f*BZdC}B1Iqr&Y4HM1lU11JW7duySH(ap!90n0$zJZ2;HLeL!)M&ps^p372x z$11~ozcs;u%zw&^*AAp9GhWPv=D2`#S!TR|(armzVA_E+2LGrCE<$vc7_X>!C@Gyw z6XTUB3)fE)SnU(zWvVAu7K#(&iGsU4en;Kd`j^ z!wQSfFG60tAWS~ru+TpAK_lhGv;G4Rk``+p(lH8o@kG~UJmU``74qU)(9tI$fhW<0 zECkJKxKY#{5oQXAzNRo=Ykc)Kukb8dg*5w$BIL!hJlN1`zb>>PcaLPnvtF^~+c+U> zs`N_Q=(7b@h}33FKaNDk@`A*W<~8KUDa(o%GVjPI46JO;eT$cRy}C}6hLo$l1t)1h zWiqK)vD}7}Ulc62@s%N&@|{}g3ySrERZKU?OB0<;l)?zfge)ph_e9ZS7X_-}5tXGOwU0F(eI8>d^S8|-nX=84Fljdj zkEq;kGn_}Q+-_4ok6M}8hFsxo%(i?QwY=_BNTb#+5vjQc3aG8wX1+sd)biZ2M5L5P zt-aaizDb5AebZiMwxM!Ve`eeLkyBPMvUDzqTC6rni>aHH|JJ=+ZBi1o{>(OqBx*6w zyxK%{1ekQ8q)eIC1d`klRB>6BGa!}7%$f z|60fcs*poXzJI4r)8hPV^r0Ai|BX+;S`x&BkIf7|{o>EaJS}~SCYTl9I1Kt*o8Kf+uuP1i_=t^g)%00bu5IjjW911Fkwcks=7e)TanSYU*Dt+qQ-sah-&FOtBgl#KpXHhxGOc7@qWCoC#S%*wM;L@XznRc5;T;0&4Ly-e3^E=6g|VDZ1Uc8m%3Rm2iJQh6wFFQYhRj8SBD>z79I$wFkR!-)%$NodzDaV20yfZ(3dsS6OB`&l$09~?%>o+m?aFhGig z%`}&%EP@rO{KjK1A7mf(AH1j=|h8c?G`_#jxt-Y_{WfTEO z?0tzRl$-mF`yPKhNN$Y|ARNN*lLr}luenG2cmlPwn)}EX-H*BNd=Rk=WXv~_sub{3 zZthb&p&YWv{#Lg+KvR2b-`%1y^7i(=@t!~oF&T`|N8#nLMQK>{^~f*NkF}4FuG9EM z5w^%=SJ#TalF7>(`|4}KyC{bk#hJ|dGxZx^y4gDd?I6Z|A^WVm+-P^7)2X9iQxKtV zs{;VJtMd*>1~H-P13n37=Os8G87*Z}A%h>Ef*0Va2rzml$Q_6X)i|9{k$FO!E`|lkE05)A-m`d|~AnrtzV&K@p+PMCe(T>(gA&IRA2d zJ|0jmWO<qMGc{-=dTyh z2g{OdTKPm~v3#?LK6}n`UE_0X9$$IhPx>s{;6oTnWEMWI7XG?7pX(Z*VB_QK@L6@n zKTa5ikFWWIYVGBlv-H9&m$p8IvZSaJ3CpJfk$ts_ArzJiZsHiK#p^-1Hn}puA7B-I z^-7X2cPJQ9b9nF6ww z7tEDHy7@&jiO8cuXTjwQ5jMDdTu4{kw<1cadsLecn}ve}q-k;N2y+R!%(q?Jbue?6 z{+0$Bx2}VU+obMnS7(V*lQeFBfStY|spyEIFz~%Jx;TNTM6WE8qfkq`XuQ5jwT-cn zGo^0Oe#M|X9tM{ub?gEPhU%RZerkT57Zloic8zQ9=qJoZzMZ<WKd4{7PJa%bZNGkz2MufAn z1fMX#VwQy(=|h%NT>@!CmQ!5<=|WPUu&rMQLqYIVr&-AgeqD*jSn%sSmS$L(WeoF) zKHBCx3;Dzp{DYZ^# zwqyrWo;K#JkB`%Qs?(`Dh9G(|uePMjR6MGXM8xOhJ|@l_rg&78h9u@}@O@-R^Qlgx zE7BNqobfEQQsNMf3;3+oQj|I$_UAQ{KiPhTh*Ec! zBO)crl+>NHdQ=WwNCTFxNR>esg){T3PUai&;*k2X^XpvsG836^rV!91-#4s^xB7KR z7Z$aad5lOC)(`N}5|O$}w^=|+fv+T>nFlX*dEVR107yWD@_WUeYBAhNc{wSd8NA$b zcTxF(X2=LiIl;1^B)MzqBFCAF&zL0jB>GkuQ+*B~7+_9DBb*VH)Hfd{?;M6oOmf%p9Q(?++*m&eWlK&N>H_ zlz9rD-WPyUADPcRtqyDtl;$9FpgF+pkLzvW94Eqb`%)&bI5BA4YW6kzxV@z{&WB|V zu=|_+sMYLk_R8Q{q?)*GPqRmsN6Q?LwOOBq3VEUq&gg95Np!p0-OR3P7suC}~W?TPI-L2ZhWXV57I_Q4HT?! z3I)^2yKUzjs%vTd?U((UUuz4n;%zm)ax1S2mO-q5j{6d2`!p#~#vm)8Lt)o;L0N{J z<#>l#$koa^WE7AkFe)#Y9)n<(C^LAD0-%|1=%R>g-unw{exYD`oKri%tHdlNAtrIo z{JZ>`Ur2;W0NEOiC4dSEFx$hQ@+*RQ@QZyz( zinNxmDP|sGqxTXI-R+^Tan?m1I?JF{K&Wx%$8(Y3GWctpzL=rAKTol7>IFW{WqSy0 zoJ^@JgSSZewgm(wouv4KjT8I&$|A8b3^tEX9aTxUO>SM@VQe1T55$V+);uN+^Ty0$ zm$7-2_eR@8Ve<%&qj@Y086yepnul==nUY|(^BS9noFooudo*;OxIG%W)a7i4hOPxk zr5uw5&Js51ecjQmwIc|H19IuTT>-)4R;uHm_H?if@_3m~IgRu=unl6wOi|clVq@2X zBRrMXfVEN~LisVZVy%&EkU9L0k(TO1Ak(DBXv-K)C~TR|A{(RGUTw!VL5knR(}GSi zH6j-yT5O8lq2ffy@aR0Q#~iKC?`XGD^WAP1m>+WtX{qgevt?t8U3{CxNV3e2)MhEs z3C2M!8AmhU`W%gFUTj4WwzgZj)VH{(EyhXl3l*ZT?U0wEs8piK^y7!R>tdcU_L}R- z55-m@;A?w76qW=PB^3THJYkNoxfLjKL637e-s~Kl_x*X=@&@50zXa(%c z1E@lq`LeBONI=~_G)ss?tvZ!US)sE!N#5f;J@z<@6__Z1s{0Mia^~fe^C(;NIFaAE z1!VIcCo(c0-yUPhhf@boChPt@PNZ~$KiUps4SY(qPiSrDak{;-fN>cT+CB4>0e=Z$ z34P4&g4_Xpi#Vuv&HT|Kx)Ro@oij`?E9szir0cNa8?!v}V>8rhZXY?hWl#v0d#`eE zCE(KAC}tYUJ>|f48@sjJic(99Yn+EyyEP>`);YM&L!sWnARROTxdnX2&`R*BHghqM zLsm$fY>^Sn&O?%FhE`Oo*xDi)bAVPm&uofZVJSaqA%0Xr!gA7N_fewBbCWs|7Wu^- zw*+pXf`p_vZfrO|;wH(IL-J$f;Mzh)M!d45$O)1xH`j;wJS)nUOgWK}vP5qwb}4rT4;$}#&pAf+d@kr?&%8g+89a2 z-HhriwevS~b(Zpo*QU-=naA0@C|#^<=W;eb4!{&hZ0B<}7pKdWd8aeme$%{wAv5gm zDf2m-=lKQ8Jnn^PE-gt)w6=ejQ=+wmjG6Rew3VW@{crv;$bjp(%0ec;75~&3j-$Or z{<678kVu{8a?#{sJePbzb&6Zg=ATevsSIH=9F!7EWf-f|MM^5M)E~-{(}@}Y%kepp z|9?3yCvyKU$KzCoho#ka4k!Gt<@lSZ--)V7)-zYJyJif#jB>Br$TTeV_rhKXuR$KmHPj3sxovH8xx(sm9f z3K$enHbzCYX{-C1AsGriVC;gIMN~wdP?S*+^vz=|ftj1DVFA$SGHz0Qz#_Y4kyi$P z&5wY9;JOtT&H9>Qya=#VTfof;ARej_5WXg;Ie;XdrTChlegV}&klF=_uTVf|lUYa+ z>d#B%f&`Td5>zfoDAlCLZsHxzCNq+CT#DSn!_K6$$#k{0!T2%`md_?@o3&JqgGJwD z?PRTFP0M2l^cLr;YbMhwYsB^d6<1A&Vu4os z)z7d6D8?)JPK!08S#fPM;DtWTof;|xWs-|4kP={RAArSXos%fQ+TV5^^4uE7pW`E} z?Y+Xrv1fCLwLibGam>QyY}(OBH;y`k5idjAR^N~+0JRUnQj9gO{Uf+kL@g?5-wqEY zT1h4C`|}N@q!{*MfK0 z*!|FyGx>S>_$#eR>X!H_`IQ-P=_uyg>L2QzG{;xl`G;_#Qj{%=ltTIU>mEw=9$FnO zMoJ0r^wzFz^pyYwImY2SmPcO+pr{^EI|os3PH>mTc?%Amn%6G!N~q!rG1(ZpkYqZA zyCQVikD9j5p`Pp52@SmR*wxrz%TgG$8zx8|P0ne#ci3F76b8vXM6TzYpJ_J`03(>m zJCg*C0zSz4ox)uJM}aD2W99-rc@QK3YOJ%Nhr7UqK#(9zPp1+=c@QKBvui6zv~%(x zNWeyLN#H8<0ql@Z+e2$IBZI(Xnpq>6B@k#mELNu_YuMGbhgE^f1m~)&C#yLRssx|O zwCWlO&Q(`+tHiX)>ebbfRjbHEY8Yk%ZFSXTmFmjKC(X3NuZn)j%GIf6CE+HNRh+4= zWTsf~uYy0((V6NLJ2?htx18-VTr_Su?iCdFa-1s!@|NRTL0K=yv4Ufi?q$tyXbGwu zKtu3a_+leo$iq_Ha$G8GcZoLPltBne(zV%BDqCeJke3B6^Wnv?h)1Ex{#_~*g-ad5 zatKifP4@3nDTF5bcc~~e*}qHWI5gSc5}r##lda%HN*fT;;#B1}%CspCA3Pt#?fP}7 z;=p8?Kb0>GAGi_}glJ%M$7pS@%%O7q#4YXiDDmK9sO1h73NrZ6WI2XNXtE5K#AOM? z6sIX(zq4DaEgWM{JBO;dSxek9^Qa7BljIK)1h&Q*)g~0{3@t5QP+NZrwGtS7N|e=EPIW-~>ew3UDMom6_HGM+6EQ5S38}KxwYV$WufV zwQ7u70X_68+M`y6GSyYg%FZJXAymK=JC#HvIZR1bG9K9i64h2prs#-DaHl%irF`T} zZE|%|hD^07)ycI<)rlEW(Q$2Jb%OQCMg40NYZI#D4UjDKuTAI}pNum=HtAoRP#a$x zmyFd@LVr5$7;DF9PhT6~F|IbYV~iP{L&CNjD1#1d9=+TT0-8rI_ltm%O66uj-nS^N zR8BfLTjJ@bQhC@Z;aK_i=Ux2mh023>@%I%f7wR~%0(!UC-`p=eB72g8-30yzO{ zU0sN$1sB84&cb*>pNkvNn7L7DoXsMh7S_Uw4u--A%Nz`~w$u_WIv6NS!;Vf-r(49+ ziiki8*R7%9jI_EKYIRp|QACC7)l7+#VOQ1b6d@sjW8hlUKdE3_a51VYCsW-@+Pf?P z5J-_Xrc5h90=XG#GC4Z|5=33ANtVw9SA-O{nrPs_gfpVD)dcO&WJ(^z5j+fJYQ8aU zD!Vk9qVE{zB47|j?{dJ&pE_0b(Dwcr?5 zsCNgB>m!>ZJc@LTu8-;%*)c*frqEG+WPL<3T&G>@BkIG=Fyjg9BRYrIhqFB6) zSZ!#GL~%eTDD$u^PZl+5zagO0-$I4kv$Zw9P>}_S%9riqa89dLjetikoRbgr*qzl* zVS7P&SjHioQ?7_5RFV~BE;FgkwyvL@0G7(a@%ly4qz>hjb6#InH_7;8VbsY;Z1>|pfAm2(_&PcNjeJnhz2ziRYWBk)J$+GpP)g_ zc+%*Z)~$^<<4BulI=41Xk4*}uwHlM88dXedH#%WcT}(zo?d zc4XCSTT!5TM3ptO=-T=SH=GRiaMUrJ{wB3c>N6Rp(v~`usUE6XLzCL=9M(D1`hN6x zbx0L7a=vSb9^8@s-8tB?V(uE+Ii!1VGRQD(*O0Ek-Gkh~Drn{Jj)9%rqkB;IK;5JL z+3tazJ+TVcJ|d7soJDPjy%iz?`5jQf6*t(d6o)5@em~R=@0*G_W|~7H0>$l5VH1(r zys_C%UbO}LGt)%|(Os%(pWptJX%GqtP_TgF5@Gjnv|T9;78I>T`%zS^Y}x#j=@G*= zVZ8MzSZ8{J{Gx0)PkKkSS$nlq3=sN@YRkv{MVmOUzYMHAvN*jlAlA;kppJZSBe>@tc8a8Nw8^+b=Lh+(>V8&+f~cxjFvU+2+nH&x;YNvcyAZRDOiizyP5CSkOtCE1UgarbnXeYap^;Th~uP7`aIxRT) zwJFJDF&K3~8q6fdhI53~>Ihfdi86Dzsit z4^DP>qpfGapl;h`@z+3*cXxH+%)su!UAoiwzdAc}S~0b6GMy5%K&GKYqhxWuGM_P< z*Wxp_+Bd;xEb0NVOvGo*>j$wb%6vw#EMlKAwr`SIZl?A=W2Q~SkJG8oShP;aXKd92 z$#lm)W6%S^zDcO8Xz3mdyJl?P1T9dVMjm5EEsIUb8sae)t(yczNJ+C~)M9BEc#K7D zQC-!Rc#O0JMIIw9d<9)Wv)8a46WcbyU(DM!)hW%%IYKcy)TE?E5vYk4rVOokWrm8H zU{X^im?|!H7_;dw4r5Rt;_|6TfsnaU8|w<@4LOVynao_oWVDOS8!|==TtwDRtn@xb`3Q{#1tYEr)!9c zOq|+a!wNzafgV&%6-4Ktda4qVfhzrbz`!ImaB4kuRtcmC8Uu!;e|HS1LMezUaNS-0 zua0iRDudKQ-7AG!mtuu6uzO%v2P=$0T}h{7g)z9RyR(B8#*j``cc2>7HKem%uS10l z!SEFSKdf##x^O(K-qm4n8N=#BV1o^-kLWP98vox_ip$(-t*+Eh_3ZrppSk zOgmcPMX;Y+0Lp92)Rom>Id3r`EGAxXEeP7Fznr&gAzZ`3dRb?d6=gn40h<(>3K?Rt-)@2+3Fgro}XjrzV}FV2(}Q44Q~? zj$kr#GqQ8ZO3f*$pFt>19TNoa-Q+Nf38(2?6*%oCi4el~1d}hpIUw~!@;1VROn|Kk zrb=VNsyHY8$a`S?p3od0%~CoA2p{jpg_$g8s^hDv%RxPAI8IWRLyl{R<|pZ#tYXgA z5X~2tgB%GuuAz!%a606;HcE{QZU?y}wNW*8I|R~en4yVxJ8GC|6w@)O+d)Si!__bc z7#FanJUhDqZ*fg?T~s$M;*sQ>jOI!j)&HVb*Nf5=I8K^S}noxh>o7x5FCxDb>i=lwWMnB|EOA5 zbqM|)TJ6LG8B;a*cWgCDhS$bbyOSRLJ2Z)Bx75z2s@P@?s+|ppLRD-tRl_}|s@PN` z6`CJg7DFGyeGGO@n5d5)-yDajhjlfu30;Vd@oWrNQMC|bx!qt%%rFbXVx(P<4ei#q z6FofeiPCPyqQomtVrsXbH&ck-aJzvoP32w{PiJYjXg6rr6AXNB@JET*<|xc|3vx?4 zI=II;TBX0w^$g~LS@lnFjFjO67WlWi-nUDA#?f3Aviwx>3t#%BHybW z{_X~|?v8p5 z#84^_T2ocs1tB~jTkV4Q9t^Fcn$W;-SzXnExFEVbm2}FbRc&JGeAy5@sDo}8tPHwU zxRtg;ZnUyPpk{_7iS5QC8Jcw1DjwIcq}w_?%;9*1(9d`wy73x}u-a7V?Ez!QZ&%%n zz+2gE2IGAmWV+yL4mW+(O)B9>rK4#!!*>MCXiSdAuyN@bnr3>q9u|6NuF9;3si8ta zQ;pk)I_98xdZ9mFd@cu#c0=@l6gQZrbT~Fc)L`jt&}#7FHwQ6sIMhHEA~oD-=#{3` z2!EspIzG}v%wPkgY4i-^HaXHg)KC64J_{e?FZ&}F-mE&~HGL2H7CNVG{;6$YXTXXK}?{J*WzQMH=j z-+EQ!ZLH(ns@FQJCaL1zYGUzkN8<4Ak>IXGS-i-Ju@?VUt-`+;RMKVZn99{;pjF1; zeKN-3-zsiP-QWUE9k;5ATVu%Gf>!wFn&0tNC_kq>jUWl6C zABNxGQfK?5kM_EMmS3^%^^Z^s`~CR+3*>x|zaK(Ae%|c+aM$bZK{=>JXP$8Q-doQ? zmE2HpkE`TLGVl3wdZZc@*U#(XYEa1R%~d$KN^Ypav2vxa2eqEgIPu5>cG-M7D&U4< zdRzfFl(|9y4=Gm;L$8-~Q@nKMsYQxSFzlb+wR!TS{{J zLQbe)mlowrUZ(1{R7#^zHA7K(+p-FI<^_IS-Kb4+!MP}JN>?Ry!%>{XXEN{N;w0f7 zad}gJ@hgw=#Ywn$Fc&9b8Wazv;v^w2`jqLFtaLEygmm>O)F$ahZIZK2Lyc3qc&Z+3 zs5nWejm5=D!mZ>Qr~V#Ify}g9m5Y-w4eAF|agw*gt%S_8L-BCPtb3WLP4bQ}bV>z; zU!&qAS!IwUDo*0_oI5IXTD)~soTN2{I@LK9W-STSxzK5mOQ;lrLZ{8P1;kOD4^R?n9#3B^hBJVKce^C-VLoxO|SrHOC(927*0_eHf03q6Nt5NH3NhoqoT>5gX?P3`|*23sqRD4{nmGYt5@b{jvnaA?tp50%C_Dh8HsAJe0J-$l4nvAf`mdl11Mln{VU( zC!T1Rg4o<=9?NqISq<&I>K^wfB}Fc;C0+RrPl%3%i2mm18b zN%E?pQiH`eeoV=`PL&4vJug;vlW60QSZ)SHx>yLHCUE9V}KvvX%TyX~Vosx_D|$%@*i7+qQ6 z392>NuCy!F8qD(vrCsfVt+fWNFTbwuH;=bVE2{2Q>C`CJcD47IbYc{Xuj{nZpna&d zIFs^~25Dm2`|W-C0!&hA&^{2dc4uWGEE024r9sQ7L$mZ|_FI&))80X;xm%Np+B*#= z8`HPCf}~LU&)#Nkm0E-L?)HgAov$?*q)`I1I1yRpdR7M2jTgH`DEStkkxIVtjNWtG zIUSW%(}~|TP)fc@=}|8E<|qEtiIqWVx7sR|j&Lw{G*x`_j3>{jH0M~9jYnK#<6d_L zD!v7HB%_Mw^v+w(gvfO2*CCP)r1~gVeDhO(GDN1`st_3t)*nd)-#p_95INI$k!o$3p|^^JA(3QtwO3$?=6hRz+#uax>LQkGJw=it5>98X%QfUG72g{rlaO+Z+Ueg=%`A~Ec=*#G|wT+{Oi7N zmRMhGG+%^Nqt;t_5mNhIhgxs#uu*Egh2;D(HmV0QxuLR6s0fp<^_EZ0PZ@_Z1(2WS z+GiXtQ5kpJG~;llG)Mu^)Z^Om-z}>TXTMDqX(Z!tQE7zQ@d_D-%asNx0IBt6@6FUk zK9fGxdV@;y3Lu{37RtfgoT;I_+Ca-q#^)T)bIhv8Q?0j{W2`nPC!#{Fx1grHH1M=H znCs1T<{MJ$t-qXz>T9l`jEFMMiWrg((^xaU=2~-&`I;mhrfP3x*%q@r`1xvYWtkC? ztKN?|=A0!6)}O6h%}UbFUHmSz-3haUYMaxeD{H3y#Dq?AA-p=AKBO`}?bbCq)Y~F+ ziR*3oZd1sGNNZ!-bt+5A*WYG#PhWj$rO(doeHXg!$k{=$&FqH2)T0;+fvF!k4Fc0{ zbqJILGMBh0m)DsS$%#k{V;TsAlLCvW+Y5B>LLI$1J7_F2Ox8@b9ebLN+z79;d|gca z^7x|WOkSqyU8S}Xm+xxTpQI@jm+x98K1xyZ+2@wR!;v6D(ZfiVxM#`v%U0U8mYIl`a#S|~1+*C3TQ|+#DQ>mpet%o(v;>}#cgF;RCE$$k0pWabR8;__v2dFif@^G+jkT)Wa;l6H-ib?hm1o0?OLvtg!_yyQ%+MPwe&_tNPde?>h@m zUU0~s+sq)h7%?K)(*^=FaDYG@_*#w-m}1Ce2u!rLYHUx^P(kf zpEoI|mb#D0bIX=c@VN*m3DmQOk6mU++fp-HKPA<#T7f{SU$p{(;_6qyWR87f#LP;A zOjP|UX=6wuA^`uo6$CWbzA87Pov(e>YDSv}H9}A20j6T@s{kfss=9j-I%{i2OW>&t z0;Kj;9!@eNnrdIQH=^Cc!Mu+>?|=;&{&hPeT1sEFGocmy>-Gg7%`NU`4fDDTQ$+t$ z=_@kx+v$H4D(T0FHrG+{s|=@NOd%s$e_cnI(yIRTHAR0uZ$hiDwucllk)`-mJ5Zsj z9qNmUp(B{ctp+p|ziJ08l04k?Tl|WOP`Tw4zcN?4l4Pp+)Z*pIRAcq;T8dv~z#?h7 zIhU&LH=A7Z65rfDom`YlRey$Z(G_!mn@>c!R6|m@VlCuQ{Hh#YC?k$ei(loFt>#m| zN%1SH;6czP=}?Pl<+60D`r>x!P_uNZdHz|257Qgcsp^ln&)5^vsp`d&vnNY0m*vip zbgKO)m{X_yfAZct(2}ak_dh#Sop5vC?!Mi(a|F7ffd(2-Kt%*aB}b8HKv0yRK$9*s zG&x7fIf@`4IfGzAK|r14gy)-|Z{EC__hz0W1A6ZMt+m%)wfC;tb?$H8Fa7cUxcBxs zb{fw+1Q%(aCQHt-i5)=3Ta#kJ1bt)hMn05cKsA~R=jKh?5ucM z4m&Fz^ux}!9n{7ZsGFWzEVCl&@`-s>XXkk)79XVzGpZPOy68 z>rE(OAr&jGUSTE5d|%gkFZGy!qeT%-Nu_*5^{`&zVbg;xNnET@mMd1Nwti(jO%LlO z?-L0-=Vek@E>^wu0#9O#>{XdWriZ$7@(x#LuhU5YV^N{KD!$}&s7BS(eK}`VE0Wei zQq3&oy;yqH9ckwU=5q??l?G#l&Z`cLPauMmut zc3vSED=m%k8uXHB-6dg?;51p4%d$(64=#g0U{l^)Jg@P*Aksz1h$c)4y;B&g;Dj~7zJGx@4JMP#j6NqGPl*b)gWsg>Q z)Uj3egkDj{R@t)yId*K7Q#8!Oj;*p_eMr|yoZBu*+ta(iVqv54YTH%phtc?=we-wE zPTuPxeP{E&1CuO6qMWE2=O|tlg`=z#5R)sm z`bGJI1j)mj7Gfzxk7k~$jN-&aJu6F&(mO}_bXp2=_0v2lo#@44=xTbd+!%`?N}hyr zBi%4jU9knpdz2(Ez4!v<#E)noe=VSZwc;v7NID~xbfa?*+5b%4*AtI-s zN9sCx7IuB@(bx4%IYsmFln}zmj-ZIG!C40DWePrT&$i>fCu}@2OPKEoD~tUixlsn) zSGgx_TK=#lIroIEs-J|d*nJgoRoD|Y-7yyXsB%x(`nG_+Cv08Qal%#kp0M0YilL9{ zps9MossnrBs`P>C09CYL!H9v zs=s|N)I9m5f4*%0#N!h7kyKBRDDxN|ZEXKgKXFk`Jt|;JNrR5e!aRX3rFNe#ptyS`!7PT-Lm9j14fcuYEC|RXb;ULJeB!cz2>Sz6to~Wu;)6> zRkl5?fgZq=350zieK&OkScQkBN?jWD{?%r?G%{(f+E49U23S?QKX&&z?6C64A?gGA zKibcu4pN`1qCOO~A47gsegDUhU#0g|`>4IuUV2Y_pWaP% z+-x@~~M^DX;S-*EAebUIV#BPwy$Og6yIssIm8ySA->3*3-~?%F85t z9tBxIo%fWNaE^dC=+JxF1Cm-X94jrwF&wL`#Ox5|dEPIFWm6AB23S5^SHupBDFBe_NW@{`F~>^Cv=USt#9^gX zmc1w9uzGn5<=GhvI_dx{8$6{;jEEGklO92V+e zcmFS0Hyv_EV)tqGWzSougJJ*Vst(G%q*Laqx~jd@o-*p69BZr9&jN>)*1^fofbgP; zMnTtBK-HeUCnz>h#%(EaMJbf7fpT3>`tC0K?4v=H<1zKF+!qviShzQmYcHaDLD zmsL=l3HLxv;X=h3re}Q@U7R@0SRE~ok9x+MBu+8lQtNdVU8p$OB&)n$wbV)CL<4s^ z)z^6yxHNEqZrPLf9#Xb&SrRm_N1Ydy2`Za*Nwa=Q5@=UbxKF6JPT@U4nIh*2Djra_ zP!YkQ!6#ykN6mx%2H;{)(=YQvD=A`J=e273#j@6x6;T{fUFD1wQ5@E*&WoPY9HOT1 zoaXbGAN2B^(1}0cIT`l`pqL|{=9d)U&K9ck>Ry3|_is-i3 zSS_Vp@e@#!P1kJMDT>I0##%`gO;K~}j#nCCbrA1(P2aks)`?;b6Kln(S}N6Id#_Vc zEw=YcCDvk7F)iS$l&$nxt^|$Y+le;IK3#*yE*DJf)MDuNBMg3G1v5_VSJ0 zM5u6zI{g>T~N>JMa@yqdO1i( zJ?mv59rdi2hctl}mlc!T8bQx`c}Rwyv96JJ$-}i%8ENaV@m6%F-sw#RJ<|t@0|eZU zR93}M-Nb$(sf(nU8f;s4pCfv5FZJG#0rYl}K@}F&4M+7_6e7=3>IPn`r-@|bSyeH~ zqZw;Haevy%Fshh$c2tM0H<8_)_byd^Su;ufWKj>U+DQ3vRZ`5*`2hf;)eCJEQH!b#?77Xn3ZQ4P z%Kg97z@A#*Q>W|ys}1ZK&;ux*|6dx|ml?{Tj+3U5mXfMSrwX(}2T^?rXC_al|KZ`) zl2-@WmqEmy!j(b1PI@xGG6!lfr6cnfTsH{gs;@8!tQzmP)7nj1vX zzmPupwZMcUgZgGKM<$QNt-Tfk<(F`4T>XsoMScOdmX`rTBBwkYx7OczqYe{?;?`cP zfZ|};BF)H_Othf8}h@e!{}iCSf?BNN++nz|=)5+r!F(A|+q(;kt>r95ErYJ^<)vc$tw*3;;NoZ zt&*UcJg&zh0aF3|B14<9&6ufxfH)d8hNU1N4k-`}Z9=dLLQfbF$L}Zfn=S$35RrsX zOjALvAb!CtLmmVIKMRoD@_d;`#4$1ju?mEUi;+utfr#@|Xqc+N^|u9y=lr|ESEr(HJ^UpJr?z5R;# znt|0Y(gSyYsPjX<1}Ba-YwOg6@3s_QF(-LFiK9NRd0`EY-BvZ~_{-fyk9$h=XT@h2%9jrQW>;D+t8*;q zoyvX%r>>Ksd0;UmYQK4O9e zHm=ICV-ed+s~TlB(K{d-5BE>iLUupwSj2}+O@$9Db6ClvTA^0~@+`ta`55=*DLvWN zY7ImAbb--g&tf7dU#J6W3sZv?%~ng$wiJF(KqW66gCn`xR9aVsTHv+B#&XaMe$Fca zBKf#(h)Te&MLHy38N3CMku5UN3}gWzloVq;#%@v35kzH~4ZIF{Ef5iqkF`KLAYTmL zQcI1~kr2J5Es~Gli3F`CkUvy~yM;);5b&HYZUO>nWB8tn^OkI3VxRsSkM0e>g zR*~xRc*@kf`+c!gMXKcLK_1UhIgG5bs3DOS_=t_MPVOmP4JnXXXW)rTZx@#z&5u?@!KRJN|R z7Isai9H()W!)z6=toUqQZE1>HlwXN)*}99~(!JP-!d#F?^=Ez!VTf zA8yS&RZZ4y${z+?vBbXvLufunSWCbGx-};o7cQW4z|{o;kwdPUB^EGKwK?7fgqj!= zQGjlbi6B4&18k-QR2#9J5r7Ctl!%flr|W`}ilDa(IKoTq{p)+g!$A};Zo zPf1&-PbHfeI(!MgdWRJl`W}g<*vZ)APcJ9yk3%@GO*Q4mqz!rH#bink4U{L+g$ulu z%G538h2Y5E=80L6l}Pbx9g7+a!<$*&Y_$|Z_0 zjF~NXxw;(4AK;ojTGn<7(N)Ca5g&w0vxn2Ay4n6DWA+M`*3vd^Y9UC6V{*Ab7kZ;yx~{PiJ>t6;wN4>t?WYjcQ$U;mH* z&KKeB`+>36EI6-n03eT+8rcEF7ZYD)f7@|hJ3x{|HZ059vP_fCHW17CId5yT<#L%Ul|3=nkdq!-CbK+y|D1ty&>0JH7F2M3F6KIc^wV44WAEagmSV)^xig;sNP zDQA-7x|B1C!o+gGFtc=&Gc{-FC}Tns%dbVSETAl-j7iMMql^j7E`^rPjC?u;7RrSH zq3N~|N8U`6MgG(`+MK3?oJox|gPe(8kKv&?EG=%jGp!$jff&k)U;;eJf+?>CMFEiR z8_XP*c5qM+wBcPCF8T+g3oAnd0AmCgEe4MMe%yxeXuvDFpwidZZ$rvRpXg}2Z5a5H zeefC>0N8*?o1fOn+Wq$LKsy6CEh3_aEHJv+YTCa;ttcQxla(ePP7%4Kh^!6q;Hmh7 zB{80qIQh8vBQ`ho`SKLb05`2_MBXGV51JbljO@!wYGVOMS6!k2oOD{`6U!4&YTA%Z zRA^8nSQ|f~Y4YY9sKVNWGOw3`EsM+z(V-Dl%?5}U8Kf<5#gZ;6vfo@}DoYbkR;oz6 zt_VE2ns5fHlDOw{B^avE<>YguouOXb(bZrI;mb&Bwum0LkmhN(`&rl>n?JwhN=xW+ zT4T~aq9Rm#ET5^0If__zb~Oxg7t^z1mLeEBFJ>(KdlbiG_X4cXVvcrTPRT&<(burY z=^GKl%|hhc!-RoH2(%uO))C=+?HkIAIhqY3PMT(;gxQQDKR5^kS$NLPMkn#je(fZF zu)pI3J_mj$&D4RuwnMqAj&w7%uhVuY_ilT@{%f?;Y%8;D>=@O7On=aK+FgBnFiZ>&&eiL~<})+n*ql;%hiu1>KCUlm^O%|&9NEpU6>Fqz+`Q1Oj-3zvEouKwZw=ac z0Ki%Mx4$_GGhwvZZ)b(bHT)e1Ix>hoP>=iJ_pDsQ@A>Tx>m`}eL-4x~hFuC!>!sPa4(E}o#AVE$!YUMAa~iUzxGvQM7&v85{)z)|cPTcj zxmgsOTfj-qO0gNUr#Lp7*}4>)brhK~cM9WjHkL(kSMg6lDd?8!%F%%0eQwT9Y7WR{RUkrf*N z)^=tyEsV%&pyOh5A7oDyxd(0bLPju~>PUhlstJ80zGUiXi z_UhAZ^m)^O#GSdTkn^XOy#@z?r;IUsW~&c=kG1lqwvPsz;5u6~n{6ALRW9u{*_V&N z6*(<$!|!pRDdV-Mvgz=x_7F-WvxK+fb*02e# z4dBZc5vp&fS;Qxxt-JU%FsO>?ln=CAbQ&Bmg?w{E#41x6UXco}6F*;>A zYWF}s1ixqGO?YN*j>?@w4P$;jkaghqj7-5Z^RjWc3Jj3gmjIu=1J}inmhgK_FUS_? zS=n+3>YHezT2K>fDgplZ{X4T<7Q8yM2XByNJJVEToV zxH~Yd5SSK-3QuDc6`IB^K&DdyHUy&5cGI}oC)`&!)Yo#;I0HyJeT671G?7KyxUa4a z!h&Df2td-&5{Wem{hP5agLHSr5XVZkrU@Z4QDO*_ZSGv{Coij%hF7Ouq*{`dken8Y1+WQXM=xUq-Q{( zaS*;RsdD(;QJVk=eVLxE=IKQ++cr{zdNY8dPc$BdII_7KkQ)KCevz673%|>NG{3Rz zs4b;b6XN;!D=emg8t8M=pl?7G(?IpN+%&)dN#}T|UqXN+kp?g6&LRd#nh4F#fIW*t zoy?t0-5#`Ov9F!mvpU)yw&xJI@%HavOW40NTK)E1Qh*$54K%00S)9@A*l8dkK;pUW z&=Rh4|i5k@_RiEBMX_y8^u2C(yN)5~93gV(#Aji}OatLmD zXsI>Qz>UWz%Uo^z!Ef1Qv*0(*ocZ}s)`owNWdeRLfHLwDm^s7n zX<(wl?-4EF8JamWvki-xvr4y%nKNH6R5SI4cIGr;<~&lGIpb<+F>@4ru9Kt|TgX1K zQjUrxa*miQ7mMj~h3J>7MFuyoe-M2pz6KXUIGzDlViT^yB_Pu|$TrC|U4<(k9QS7{ z;GAoa>;bhA_+1ogz7G2};BEA`l$Kk9)@-6i>~%OFZb2+xhug}`9^WQ%q&V-h}0 zHxV7E&PX|tb)#d+2El(0oC_&uLMa%`!jH>qJi_PU@m2F?X<)IjN2#s;Tjr(^F2){7#pr7{de{= znYBBt|KIxOxE)S2|2zNudIw|vzxeqT?B{>w=a=xlseayt*ZfC*-htPu&sj;i)9&& zj?><@j7Eo|9k*{Vf9n4Gzy8w}=J%8D|Nfu<>;Lh$fAPy-zWeUR<~>5Q!y^PzBV!RZ z|HE&8^Q-*b{2l$aJ=_7HiP4b&vYT1G7THY{lU>#fSeTf@*jtzwW9%)mo5^BJJxpv( z)563UV-EoBgLmI<&P3x+jfnwdi5+(o0lS&gYk}QFliYDN?5;qUv@J@ELA@5(?Vyv3 zV0XpKa*GmUj6Ljb|6RA4<#uO2pp!r(G5GX<{cHKl0M|_*dnAdKIrIP$1CG6W2Xi1T zt{YG(`1GG49ui4k2z^A77>^J>kC+l={y+!um%qZVg5N?d+Ql0m{O&*f)vv1?vNsgq zPQn*6-OKz~y1j<|+>zEzxD$HT6Th+_+ON7})|+)eWX5mIUWS0T;ft_|cpLZi&$mQo z_q{F~b9fu%!8I-32H%6!QA=cYFI&8-@rU*2oN@AT78?h|nKgqGa}Izj_{l%zpF`yiBN@a2)MO?dqAv)AovP zb=P;{Y6N;NM=l##>6+YSO{cNUU*RJ}&n3*brRTa!cj=z71ZqJJW^h7Rb4Lxd!B1id*KLW#P4rQOc2XW5BpVa&GGS986s0gw4&}z!flJ z_H*^K_d#wjYWb;wyeDEy#MoSqX^OGAe2pW0FpU=%j$;vD;dm7h$D#^p5)n2x?4qrb zTtvj?BE_P5mD}sErbD*`Xl^*R@1G4<^K;=<9(U+2Q!IRc?hu+Avkdi9-6vlSI(O?* zPi;KTbboH5Sk(3BCW=K}e{M^$K)^+{AE<`**7DgZ7?FE-LesFPb!~HQ`5ilL^AFa4 zaL(!9`r6_9tme74X3zpmS%ECT)XmRLr#I#lFKfn|Vb0;X*Q<$OIylk% zFnF8~PW#~0ZyoccgLYfZvu$<11(>>tJjVh|-3(m`J1kz7!w%^I%8vz@vixAy;knna zL)4*uw?p#*BwPReAO7=do<v|(`epSJPBMg;mPUc+al)h^rYt?;nL6^d zau8Dr2jxi#{dQj=apRG24$({zkBg|4f83$hIEbmXE%S8=Nlg$_otTjt+Uz65G#<^j z#1{|M&2I(Ga>aw9v?re7`nw7m{~^RwKhXnJ`ndkS-xrP;_WPwK`|*hC0q*xJ0b#14 zU9m@B$G90pnCc$wezD1ZT?2k~ySj~3{dB$EK87TN-oT*sus$eS?-3>1fQB7Ri~%{KiP}vgR^Ri`;IurA4}zErQf`rxg?J z9U2q*-+k_}X#it}{S^_b4f}%!4#sSOk(_$K{)(67us?pV&6ov7x|hv|{e5J)+g}l$ ze$B{8%VJjVZdgt{5E&VVy8CF1c?V6WEu=2pUPfUMZ}8J4)KJvTgov` zTRxSx(KT*Ej*$YHRs!N~JQl|g{U`vY;BeDeElsV}M&DOpQ(nQB~$eh7IcoXe@8+-GfzLWaGMgetj3B?^f&oz(uS^ zW0NA(&u^o#bkTX!k;eQYi1*EE%(M?I40s_LOZT$HXe^8Lw7F@6OD}^HeJ3|2 zA^dK2+8?-#1v@Na{T$d~LHb<@JLJH^z)Kt7ZzZ~?lx79CZ+9yj`VExu$@%E@9lD%nu4&HLICNEV# zqgo9dko;xta!|@4(eR}VXZBMOAQFAxw>hChB*tM|{1D|J4*Y28)aw$m)pFp+_=$+b zcnl8PDnKO0wh$4CC@PiEk5RaIHV)c^NKEIYlh4^2N*v57og_wLW`lX`I`uQ+X%mF` za?tja#Io~L7!_+1Q~7;a<2;f7WE>?iotTP}iw#*#XfNv%Q=ka;NK3_cL=fkz@!AxS z#4uiaQWHWFbq^2)q~fK-G)@wck(f$Mse`q=gBXc^fBIew%w*1Z`-H44B?F#iJl83Z{kpojKunW+p-5Ek^609-|9L>q7T>5Zxdvz z7m0!yiPT?IT`OJ3Yl84f=;Y}ciFG83kdc@sQG|@dGzAfRZTITMO_W4)m7Jo-DD~Qw zt_Nw@Wz=^@!(Q9?$$E7e#a`R>{ob&Ps61UluWfl@?=GYA6f1;{XV?GH7G+ik>jtW^ z(kotHV+lNP?q(EAHBRxC&S^|9Ue;XP=ywnH*m3rXhAv*V2nr`q2?B#NaB5?s@$6}T zv^AO4!I}Z=&kG*x4<0yo1N$okZxQUTcv%kna}Rdiehl_kylg(~4+=qGaA<$#k5=TM zPJ@4Oy+Hlayt|T(2o*@=J4@gR=Wa-Y6x3;09|M7#o^&?i&3-rFf5P>rP}iW|QH+zQ zr~VOYNNHyyY>}p1y0O(vSEPvrPW(tEdBF;bG~ud)cOM3dG}Y3Leog&A)%Y6mim*i? z8iOSgEe5Dkjjs_e%4G4z7HMkM4fON!IaOn9^s|%ClpIf3b5Ti=#Hyuy(zsGeaZ4ic-mPxFDFbuKI+7JwpoEJK*im>&xHl|kv=RSF_D2*6f z8);#PWNoM_dlQz9ShZM}P}9sE-ion(iOo&A-*%{JrqIK1WTYsP;&H!iX$ca(XEs6< zxwAF*+fH}m#y+3E-?mKBmDKsZ-*z2ci3x~ly(Gpi6A;OirS*&mh`reozUy|qp82lZ z@_ZsJdcq<1Fy*e>@;p4gbk}U|x-IQ?q(ex@fAC%4sOz>orx#m-x^7E&Kk*}^>o}^` z%A%(zcHNe4d%A13Iv%@j!!2+n!bIFxbn+W^b3NcteSPv6OP~n%u1=6epE&IGHu+UR zQ1pgOG>*b_q2u*_k^QMi*}FNZCVB#9}EUG>78H3Usnu7t}viKN40aWA#L9XI@90tlC5MnyN8}-B*7e zEN6uF5Q=Lx=1{yO3)2{{jH?$-&6=coK|Zf)-Jz`k#y*p^Nxg}lENH;h4&d1Tlo^I;#DwkGT6BxWuB*~@ z@bkS>Xe*eVVdU+vwq6?=Tw^%YdM^;F|PTTg%_0smI- z-Jyjj^Rg_~#o{8Uddbu*^6MAH3#!&9nwmv^{T$rJQfm{jW}2?1+S^-dZK8a_6pLnl z35;b&K+QBQm$<%U9z{`R@h#(a1#GFaiBMOpEb~*P604EoyC!iX4_7MngWc~u^%NV( zl)RbyRZpAPYoTA=BYM4chI_7te1ZAO8}*?mqTPqVZB2XHwmYU zREv#ks_53bH{92wriu>Hd|L)}+>}Q&Mb$J-_f^-JtE-xe`b9NW)V?aEkQdi@2`oh^ z^fgr^`AuHhv#5$@3owPw^ zcu;CK961mvvK6UPKh8 zZKyYD;+qEKvR+KF9k@8&fQ_t|Q)~z>jx`f0L6z`+ZWxZu&U;BJ$`dr0ox&$VgIQ;B z!?7j27qP%7G0;-L7hx<0?GHQzJ z@w|vCi1Lfd|gaf@@>r;bPz1*$OB{~VFIVTW@bR_)EKdIcTM?FTtP@2?!oDeQeKiw@^0 z=&$~CW7jZiz?IE9Q)xh1>+W`ykILHHPShjfd!)H(OWA$s+2qZ2s9Fjf8Qi`xV|>4p!(Xq^}Eqs zd*!=M)Gg8(&Uhiy3!sFLL1vT}IsG=fq*yF~rY$9S>M1NG+*}jfw^uE`%4G31wv>=W zOkpWK?6A&KhOoo5E^_fTU7EF)67F}2CAX}KxV86UBW>+zDW`z`f}+@hvFx$Th>MU@ zEHd`cT352{p|lRcbpBM95}+6fo%K4Uz=AR45X-G~I>?YiE(gc;QZkkVImBc4<4cFB zN1a4HBFJHHbBU0{c>JmsBIMBPJnDE{kVS*pJ?do8(%u%cd*q2HB1p>Xc&N3cKH{78 zT1)yP>}TtR1rf)VwYIE?q9zmi3no@iEUM5o(?dfIEV%}q>l!YADwWkNQ z1(B+@rzb6D%v2e27%MJ`Sh+#H*INV&`UdqVjIr7(=ygnx!*ug{1>KHA$f35)C=tt^(WL$9&xCPCaE6eG5Ik% zc)Lm4p7NgjON>LmBODGJENe^CMaH3qCeymoZ63KGVg693v?NjBzauXi7H?6$AWs0r zk8fo6k|=MNu&v&ULe=g<<0T_%05)w2tK^04;9yoLQd0OQd|c)gB8s5y*=t$ zagD5zQ}&_aDp}lC%4?Y{rzAe2RH5aqRKLYlL2(%ib=_*ExWwOa6iXskJHBo0To&=wkb&zP@!e-oUXD8TcPC@RxgR(0*bSFYn=fVP@yHVaA-fh{gWt5J;WA8 z2`ZMbI@^o0C@qDtm+^#prmfIY-8dzOAZJsUP7sqREGLLb521BJnY5c+zqQQ5q{w;^ zWC~;bq9juo>!@2u&GPc?M-Hp3L}6rc_X5boEv(S8c$Ni_Ig3PL>}58Er7+gjZ;@L_ z6vkd=lPQe#hSEe7MsH(LT1n!1Qy5VI%Y0z%-igww(BCDAS}cDu!C(yKPwYjuS$#h3 zHN_qw4Wg1{B7$-Sm`$l-*1s0A*l8WFgq8!AdAsK<# z1PYEi4R9e0qfP)^^friLtg;WVYq3Z$4yYx0nQ@?lw&5X$G45v^GY+VsI73{*l%U3! z`kQEA;kD#h{WdJhR<@QGBu(Tk%OzVZ${JUb4FxT{u?KEto#KBjsEdR>swq# zH}~-V!^K3DIjYLy&A9b$605SkZtjs#!6XD_y_-b1FCi#FGFbp zN~J8c%^OO2AaN+mWmwWvRK{uRHLo4lyW!eYP6`~Rq-PVWm-_t0D1~#S^m)IfxuKus+TLGP}W;Yrci2!`C$Ph zuLq_Q1hozTBzIKKQ+ns7pxZ>@E=!=Y6v}WcPuU;}rQXSt z)jYeHI38&LkN}QHitnL;LWvv?&+8y+C5c^`;h8i5w4)9q_IEiQ`d)10abq#V^*t@klX%h(zg80MzC@CQ&jTKr9bMzjp~0 zotZ4|s!h8(>58P}+hp;7DI!-l#sAa*R|iGXDO_DKvaGr5lx448mQb{NFD24@Wsmz! zNzm%br`90_a$A-=T0}%Kls)ds0kN9mt{foIPjOd{I$F2|#&Xfr3y~=9%8@loh@vQ% zR$U!>KJ`UW+#j3fD9aj1ec2 zhvY}4E#_)x-eMgxJ6P3C+B&tpsjZai?U2}+QZ)q0s1GSub**X<5j#`Hj)|RK1qnun zdQl~IG7m~d#LifaLaa@wMU1s!Mbm|rC}4KRV=yTSu{Plt%!LvbYvV^?1~M``St&j2 zCf^uZ7bhVe#Oy2+?HFvsU?~RH#9$kScBleu6C!K0Wp?sA3C95)=o1(ZnSyvEur_6= z2Ld~@62b#e2^D}xsH+D4-ve78{C|eDj2BuDae`UbOJ`6?#BrursDrAeyQPHh|0FFD z-%xIJnY>F=eO(-bwkX_pc@YinX`I6Jh@;Tbsc+SL9&x0a!t#hORqKbb;}Ks--~Y)s ztEeNy;l1jISRpirV*Rk!0-8CPw4~nen1j?5ekZL$K04Pet&!J}rTSpm>4<&I6y#^I z7u=T9)9Xy`;iRNa5=0>-DYGLT2er=Zh)>Jt?ijoQCNv<(K~2jH)!3&i`Trw?r!-nT98A3qIVPygqn6cKu0c0grUkHAy5_|)RZom?POAA zutZ28)U?}~+_qwzm{o=x)H=HZz~mac10Aj5V6ke+t?=T0Ip*mt_ zq;0_siRql*L~bIE@sybxs9MoFPx?-Ls#^8R`K7B`)vxo&gTztwF&?W&@<33no;knR zA5<&2g`%3DclZ55Q4b5Z`m8^$S|#)TD3X`gbL1YfSY7g?QXY;WQb5(JF34lvZ$3j_ zB304CEWIwoV}(h6%2-E`%K9XgX)Z5U7I{aCX~2Y9@vK|sx_KJN#oQ=9iA zdo~^4F)*6#Rc+p{fIXXv?ifmuJwsk`+U! zk0f6(*$!%=rU5=T!crCYitkC0b@1sO1t4$S1*=d;(;xLi)w@Q`?eAoXBQNR4G#COMq(%hvCy$ zB%S6!`mGj4V)7{_m|PO^F;ABg*nA$5etpbC(yxC#rmvYJ{rdD(kIO}I0_#b?9QP#9 zvEn3_sDT_MiS)~_MiyWmkbaQ>7*hk=GeXjD2dII0z>s8WAkno$(r@2r+me16KUby( zhNNFp5Cr>&RYVPpS-%9JV`?A*=7{x6#BEd1P4oUR?i%N>)5%wNr#)-^wSt8?S-Y5s zCR!!aFLJApZq}w>atBd+gR0(M)+{CJ?c|4jOezPG?zW#OZh|c@0m^L@#7Yb?ahip} z#MCS$>NRB#P2q$lecD;;EyQXOIBpInIPsPB(B+VX`H!e!j0>>PJc5QW!TFQg1QtLO z`4^D85`^(=rCA}9jB&A%NiHK2Q@Nah#Y|<+z?i8V=U+OJeKAuxjw+LjSH{7}hMpRv zaybDLfK-k>b#s9Tkjflh7^&<7Olw|u?o#mPp{H&VQkmb>oQE-^36|SuVa;(i;1o}? z0I7^7nUKmpy2!E6PPfMO1SGF8eeaJmWS zuHuO+mzav<%B{bOXMDa`EmD;{0!V@tV!B=+N{%ZBGPQ|{XqX)+$ENl(7af+L?3hh3 zo7!g+VmvEl6P``YGdPQK2|#bpr>H;^7#$YB5~nP(sUc!Gztx^;W;6r-aLA_a%*ZU8 z8s9}UYB?$c8gXaTv#I+=fhFo*g>zMov4&4pP2Iy{*!NI`{(A^}10~Xy)={TdihXw`!-Ay8x^=Zd~?gw-?i69`69Sa)K z-A)AU-_efe^H$N_A)j|iv7SD;sB+mh7ny}wCB};dx)S5Xd{tb!TqQH}r1Oye;-nPLU(OikMJc6g z&N0E|j9FVgZi={1muEKHfNO2K*pBRZHOmx_=@OM=2Dbalxi!|EIgc_#7w?;p%!T!} zY=#V?e`f}O%k3*U;%7m;Z$c`^7j56DvJ`W^P(^Vu_f2b-Am(`y?>ocoBHG6g^Q?&W z&B1mN?HOW@7i()EFXFxF?{o1UA?9=`5BDR&94}WynA4?92y?t#F^i*1xxdqLVCfKH z-nJ2c7!c+}pH~%x`H)3QhY0ik6%aEa%wrJq5{ocL5VJ>^*MXSB3!Q9%4|$j?#33&W zt{5bMXZCvG>jN`|F!R@Ad6f9enawENai&1wt~tX5S56yp1yKY)40xC;_>k8g)y1{b zfm|VX*9!(P%oX@LYLAE_Z|EDzhE);#`iC)B;DFa0Vn;AA1a#yg__ZNdpbEs`pae`i zg}jc%w9|FMnD(K8PQP$h5n|e#F6gxZ(@s}P?m`|y+VL7fNIU)=?I?h><8@Mnw6`sg zd?13fkF~O9X0IL(X~%#kb7e8!2x%X0jyOoWf-UoN=^*Wc5bzMvK0lxBAni*t?I7(r zDDQN=B%7ld(%uh1a)z|8)T1hdv=bbgA?=&0A-Hd8EC$@WncsnLpgFx2%zQm++#{;2 zn`yGh2|J^$X*!twdL$3NK{MPgW`A>71mC6{(nT!j47G~+uLq6$Hv2)qbm8f;fwr6f z0|TOPbXkAy=Knx{znlLW1dQf?e_tPbhxnbLfYG^Bv_ zJmThOmH_i(t)b>HJWGK2@umjAJbtfmNbnm0^W)7q0GLM{I|AnCgW3{cUc)m`I)v|U z6n+pezcd>R0Q0l6WtsrB0rQLWJT)7T;|!RWdaaTccFutLd1{elzSVKa>@7CWnYy%$XwgHX+{jyK{^27H7}UK(k*LbEe~FOx`EmnIG(HyE&sf z!ku}Hw=`?I?Ex2gTkWZwiPjcpbL$QTRQQ_rY_sas|KVL0p*$XQQ1B z!tar+3D3;V=I0BunQ%t59)vT}r*rr{YU9e>Y_Xo6tuo=cZ3#Tv@8e)m*(; zP1h?F#+A&TnXIbyHY`EsF{DK`W;-Av?iB3m0BEnW*VvW@fr>=CbpRl1`#*3;~@Fi$T6 zFSL;wfLpNeT6hdh@MdaIZm4F$Jw@~7Y_&{|s7>s(Anl&Dy%tu=QL#kMvDdYKN z?xmb)pB{~g=OD93BJ4R>C5OdwIScBt3&oh+Kn%%EMN>}nJr%ucqVb$mVhh;^MXph? zRE~?eaJ@89(q1{7OwOE*yGNGFpcenXly5B<3mC>wiQ`pYtd}1 z5v|6SqSII{`Wu^x!Nw{v+}K!5Ypf8{8ykw5jb&nXW3iaqSSaQ<=7~j(aj~>9Q*786 z6)PJUQ6m9!60LR!b`e1+k_NOBT8f`e+x~rXWR83oHKFKaYvm3Jll1ro^bRbyKg(J8s?N0KslK>`PeTV zu=Aomc(@oJu08I^&wX;sQFsWbly#?{c+3%dZ$CH=4@ZG7b~+4l@TV6ohKGId;?8+7J5P&J`@Vy6qynpk?2VXn>sDpNzInjEiVUFA3wEyRSwgq19iQhQth~tr$ zd&1YgaKNXw8iWsY{0hLRoOtY44%zEt^Wg&>zZf2#bnH=w?)~x2-~$~GES6Kg`SmXy z^x19t;R78H+}u;X1%vFj^L+R~$M?aDPd?#mUp(NG8^Q-V9*8V!Pdx7E!}i{x10U#1 z08IPHbo+tc*}<5%r}+5=Y!83lg2&~bH{rSBXItR${^6f~_jhluHt&D%KYsU{cYpe- ze75`C^KY&&|M;ih|HI$>@~1C9@!0ntf8xm}pL+V4XP$lT=Znp6yZ`fdfBDvH&pi5_ z2fzE!!{7VfBah+>o_O*pe8tb_n7{h>fBelae(=)?g>IychO zKOZ&kzV~1L;?38deBg%bzJ2|TH{E>eZMXZ^+kqc>6bH7u{&}Byuu?Jr(>_?Am2CeB)S&ieDt zzwn|6{o2>Raoh>tJn^Kpr=E6(JAez^N4WZ09N?yS z06trAx*mP($gdpzwPU_WYo&`GJFv6F=f(LLc9l$B4 zoj&0|0iFUpiO~_Q4c*dFV3G7us1MoSx@h18Vcouks`;UkYz}6!nLG&5$a^?~4z3*^70Q())q1MHm1tCOd-t7`NQ|d3yl%6v8Kfs|Zd(G=TjY z>F@ik^Jc|7fbe{lD0bGXR0QN$%1JDQ;xDntyTz&a#6kATjiI|M!ra31W5a6|03KYao`1;GIJB*LYPUjqz49|FG#I0pMM z@PfEpUU6pQ*?srJ&j4Q|T!fI~UMMdT7oW4& z-uu8wz_W-`p*RA29)m-`6H$zSL*Q2mV_dZ7UVFnSz_VCCfc+3|1a}a22zmbN7woa; zUT_Mc0q9DgBXEbnBfz&|zYh2ua=kcLocHSPd+Z6PfW8Dif-l>z0p=6V2RI9OJ+6gs z6TVLSF>r`=XWKDe-);9j;1m=C(6>qq~x830kxGxdE z1iF&!0l<8+N5F^RjsXwC4k6Eaecfjg1K_t%96>n3NhjN5z=Jqlo*^d0nXi2s27pr- zeggU$aR8i9$9$bffa~$ZlW++9959AFU7TSZzgoNgeMr8KI%JRSH*+ZV13t4xXN`>@ zbw1^|BMJ1yC=@u!1#+eS}xo@-2~wWqzm_V}+JvHz~yY(})ggZA1PiWrTJ zAhkXI=)?Bid376h2oEqR-fjDF*dbvE587>qMX*Ervcvb?Ws4kkNDub=%nq|G7zxtv zFMocIk1T{8?*FMRmD{0tzx&?5{5N0}Zf5>4`Tqa>r{DedZ~pw9cl6sE0W|3k|Kq>@ z=fD25?CsVs79l9s z`MUU_`jPr^_LF%(l|T7CJoVDcFTe82tFQjx2NE_a*qHx#>?iq;|M2_^FTVJa-6&s` zuu;9Pf7txd(2qMm`uz`|d;a+s+-CWTcojf`uVt^#{h@ySy=R|u+vH2)W%&wFb$`%& zZTjo&*Tgdd6ZPli3jhjyNxrOJ$zE;$p!Hh+57evTY1}HF6R=gnR{e7J%B)vgulxy< zbZIvM8~p|78U0f0<^EUtURE!?k176BPus2XIr+SPA$xK5OU)Pm?FC4|i*3M$cuqgx zdST$j&I|ha4{VzKgnUvwC7)K$sAse1WQ;J^Zlz zo_GYhRl`R8c>cubldUJR$HjNWL-JwqJ*WyjsvgU}KmK?V`a=H^lh^Ochs47Qw&+J& zkM)1Q^H}~U?DzrT;65l}n}TimBhw#kJ(7LzgNN_CA5vcV9SNJ%L)pXQ-)las9}@Qh z*XVu$&jVuNyRC=%9_~DpL)Yg&Vsdz|gl*~p^_~2|(eJh%%)bLe-zDyr_ej{H?#~{W z{hj=Q{Qf`P2PqJc9AJaGSKrqU!wuZuyf3>~+%E4BcPiMT?`hsUcwhV8{2t(;-zsmz zEzr36uKe!Nds=trcd0x7Xj2(r;NGt8$nG4wt9fU32QZIr5;x0Rpgr?#`t~_@9%CF3>(3b!D}KdVOwo-t_ZZ=Vj;W_4=Id+3VIpx5jhw^)t?GuFuZVXX|y7 zXPpV{8Q0}!&pfAjcD7ERrO%w4I73e8GqbbC)-}({&eRk7jK=9Upo$&VPo8ten)UA$ z4D?kVf!=B?x4{$8tvhZy+*nY+-ulKGWA=eXpf6|)6)#(|L8Ikf_L()!RgL%7yRbaC zreS7J^uO4c5IdYUdFr>;oc7+@~hTQ(o9aizXn3$d;ju}5Hf%H?kb3u@BjXv|I2TG z^DFhPerI{{@Xyt|h+AEN;gw!1?GxEA#9L$b$$!E(@srtG>dm3z&A;|fBh0R4F?av? z_ka5r@$=cw#2fFKKmFlfAX@+VyUllUVA17{ItTc3WWK)Bd^-nXYwnnHh!{6N)^9iM z>vGGRBkZ{Rk^Du|zAghQYi9YY$e?SznM2GEpV6<&*Rr2Cqvwb{r+${dkr(fz=k%-c z6$8)a05Qk$=-KR54eXl?p3B{HM9|UDwO_s{e%u5S55Ceri!2=Td=AfMrDrt|!sY8Z zJWHbjFdbftbR7MxcqWHuGuT)7tbRs6t>D?rKAXKj^d0-`Q|ih5<;;$dIr6xETEnv% zp{_4wFJ^9Jd^J6fefiB}*$bK7WBj~+41liBXU}EN()0RB;H0}g{`wL5Jq^!iFb+Mh zAy#YX)33j0VXkhAhIfQpuo1s`P(GExF;%x9{f3^`FqVEq!C3eX?lx>-tjz62+aATV z1$zwx#PzWZ-lM;VTQr3BkRmSc#v{|kX!-#K?|~?OkGdNHuDC_p{m>TQ=wAarz;1#= zvv1-}+_<=V>w|dM58y%2HVt83K~SfDisohs+jMf9x>?_Z@500I@6xw=D7Xe8QFqb4 z2&uy@g%xx{%wSJQ6sT^&mcRf;xC0v?hvVV9xLvTY@6)&V5%sra&`Ma`s&COZWAkGT z@E`v^$$b%Fn+AxE4z?lajZv(C+JpD$Vt=#^J3)e2K)*w2w`u70@0$}-3t`tV3XVlr zwgq$>*ro$;4mGJFC>;pLxwt>=`ZMyjsI@Rimv3224XW^cMGGnrvG9F%Ob{S!4UEly zLE4JORa{PA zQ^&%8_I52wsLcpA67ik*v9VO+7?jz$g+4ADZ_FrUw7IA;;2r=leWONJylm0tjrUIm zJM-x^dSdYX#@s^e7Q_2N?2faVn8W*>@&N!H-e0_IKD_@}`x<56PYU%9zx~axk*SJ$ zW8RwKB`$MMW^c(i2i((t_nTj7t9+uptP}Y5)Q{dkJ4uB5mmP!Ob$#+Wh|5`k{$CP z0`0=lcngY~soetZ<9_%o-^U~KqcILngS@GlE$Uu%4;YW)2>g3+3+jrv(-fkpzk_?y zAbqqAl}b3|YHAy53m6$VcK<$9BvLri9q8*@j9K1>+F~4XHMI@f-%nl-2UE8Zg{OPn z-KAZIl7(^x?#oJD2)GGlNjfp+_l4U~CPLO~c^me<2dZpE2ECj?*ZYDc=R5I-{qjTk zjNS(_XnP|DvKzh6^-ZiwB(ua(UL^RUh!~QDfNZ=KGGu&^u6}wrPqJMula@YsUd;!J0ZY%b6F+u(H7KyT=R@~KyftHAA3o1;arq3mN{~R@E6Wi`pcS>rr%D^N<$8mO z1Dz=AnktN$jC9REj|L3tZ53Vf*33K-E1Tbf8bQiNdnc75+lDG73#xdy1q~ea;eg_PTg-410Z^PhVJJgTgbTEmT_Fn*3WK=L1nw_i>jy_bbJJcksxP` ztBIQvldwqZmprZ}?9NXugrQ6b;^1*LcvPV%Nhcj1SK~YLlM`ci$G95jH48!W{!Tc# zqoZO`3gu2%xs%0v$;Wv?vyFZ)pkrpai(MWz`sHJ0Ul|G-ii13fk2xi1668*PD?F;O z{Vi=~5cH8N;U?3yAwxno?7j9enh4vPoj zYSMxxEu&O|+|e4^hEjp~;p#aWqupSSiKB`q^+lSjO~_((ZSk zu`bZ>35%cP^-#ZLG#-^jSt~)m0G3KXRMccvN>VR*AC@`2Dk~^}vZuq6r3BPC7h3&@ z-qVS@@HqUKWwjK58pon)IHvc4>h{Uof{H7bG}-WBNwa&)gCLmR@~Og`QNdH)Y;Kaa zR7xfj-y2INtX^3I$`YLrMO&9;8BR!|GoZZ3GNH{Ba_LK{>UtTJBC9}~GO{KGv>_iR zUDtd_4Zs!3s5nYK4A#i3Fo{AgNv6F^qY@|sZAfaluuAV`VG@Bi3%|GnmyEK(V++S8uLgIJgBxR% zO)pdpp=?le?_mjb{<0z^90^@eUR}DvOx!ncV&6+2C-!KzhfA;!5Sr?(uL7 zNl~5+J)f7V?y(d0^Es?*Q7jF`YVzwvwKP=8P^~7v1}>O9V{br?Y?`1+VHIHw3L$L&VthZrn^58{ZJLtZMS05Mxu; zS=6=O7#mbQvA-#4sX91r-z@fpHr9oqMdibhQB7I-;)bBKHE!(bF*d2joMkb|7#sZw2B3yngbDOLR$Y`Oala^*Da*QxDro>W&Q(@c!q7K@7Ymd; zR!I~rW0yElm3dh*7D>2K1>CZ-5*hnca&WSuyu7}LVg@&XSZPJ2r^U%w1m#U$=|fRw znUgmdSKFnn9)PNDBJU=@ZGvKJRY2i(k!vA`ND3&g0g9_3izt;;*{hO7iYq028a^s? zl%e?I8lkuxKC2Z_?>A*2Wa=_;DSX;OKvNPaF0P7iD3Ktq7kZD(;u}jOh}0CcagabD z;E_iTovar~c@BP}G+LG935uY_x@YKQeR&nc1)MC4K9zO7^t#nQC>DD+S`|hRt_!{B zd)bSe-TB^c`qFGDilOAE)(+)~@OfQHI2ze$5(*-Z?2E6mP%M%p7Soj2k{Z%`z0_94 zklyP@4uzJq5S?tD&Jsufw^m0El@LB}P+r9qP2NgMC%-Je$sU;ssAX3uzbH!@OHS5% zMtOuhwmdRASykwfJWLiIxvH?(XH^^`zgDlX=r_gZalgIVW{c19))f2`P z{o{ACMtWBnV|2W8RQsXhl$D;bURzO@xMyriS=F8ZfwLH$l(Ld8O@6iz?6eRfM<*?< zC|jPRlaSV3^{2RJY#jzw!biZvOf_zlmZPJcc(O$5U659wb`l>4tDO{9y%Vz5xM?i5 zfYqPGMz18S8d@O|Nk=24&TjF-s-Sryl63T^(qwUL8(T+#)7y1FybJ7yM~hpyd6JI) zm@d)VY}?p$??we}W8;C4Xh5CT$|xP*yHRc#W(eZ`I{hT0Xs(yGCQBNbQZl$nvaq$Z z%2}?BnrrGblJB80SEWX#yKkuaX|9MhlJ(Ui#3wH+L{iq=W;1z7ppt2uIeAg!QByv1 z@`At|r?qbKyy#Y)SVpP1I=S8|B`-C4tLd%Yf$gL%s7xPo60z zOi=d)4R>{4>2wK=ra0Xc_vh4Uo;cMM_vlphlq#iSt#RYm>z+8tIHSzUS2ddATL=#7 zZ8Q-agjL=;T}8Ks;2<*6^+r>C!+_DQ*H+Xiaf~^wm%5_LF+2!ua8+H=u`xWT-e?L7 z59;MJ2_DqTW)eK8m&-I39z@DqR#$Rt1P@~DM69mVr<~zI-ep#NWZ{f!6fn~4xcj+2 zP#$2QHeG&a=rHAerYDd>?VH92g${FaucDk=7FT8MV0Vv0AQ?~<>xx^o)h3S*N-3fI ztaO%_B%4O{wvX{azDUe^N8C726p(tgPugaxPgZTK*Fxd&LAW<>T)lcx>*JKVq8d`` z_$*5IcSl z3V6B4G4X?{!ixP%i60bqL8S)k<=)4vt4MwD{GhluYTWxc>}*QCkE5%Pw!`Myy@xvY&p0*vh$6$=7`R)P6r)Cu4lQ` z-c`E3UIU2>ZoVncW(}-!e^^YdI!j+{#fl^rQ^R5}-PjX5vF_JTch%Ii2gFsy?$=JW z<rU%^pgKy}QgB)W$&U&2y}`{t>X@<*6qQPQ**KwOpN zwbGOil!pQmu%{1{2ZO5j^nnOh@*2pMR$S3!*$@t{RMs*tD)n$Bc7kQNQmBJu%_OW^ zhAWd{ofSn#9*VA(_Zey+Ry`T5RObc3F!i*8gjPxkAPIcDt)LblUswUtx6wSL2Cc)IZ7cByexbySz-Hc7A=w|<>*SW@S*7V z_TM}TwFPIqQniu4w(Y;mjr_6Gux(9Vku8KPrJ5HjX#Y*J7lM=+uH^d^I~sTdSK{8q z9w!(Fi>{nTV&FbA)xF?B}-g>D~l1@CIMx~u-sX-O;~nhQ{@Yq;Ubx_Wk)Y4 z6;pMPDawv%K>^7C35*Miz9fkS!u0!CFyy}B@l*vPEIOtK2}GjwMSY80C$S)i)Ynjv7B(VjMbVt(*&@p zvJ82Q6vC=>t!ok=Rn9f(pdwj>`&!Q=w-+__NVR>ooh)jb#Ym2uCqKkquBsajRh9Bg zjH)V2hYjyw)mX`VB{JJeY$<~0L+JoqUqFiqg`>Oqb_J>`mJVqDm!$aVO+}L8ho~y- zkze&ph^mTR7ZD|(5oJYutY-=sG@dBodgO=NgB|PR9{J4fmPL>Jkln2usw&hTL{(K0 zewjs8vF;GUFWni?;A+B#-XR>!nnz}m=&s?aW_KxNUgpR$J5Cp?F}Zqe8c3IY@AQ404)(sexXJN zymOd5+(!De4!8oDjr6^ikjxY}X{gVe=yu1db&#JkUrDP3M`bLM`DL%z0FZSMl_FW$ zI&}9rqUTK-YVYn|hn1{FIcy6T@6+}{?k2zxEfiVeK4Q4s%14K8Mb?v2l+`; zTRp=#D|QyP&X>MPLw`aPvQw>gNq~dZ+Xv&|U}^hcKBH^xgDBu&sd^XG{DO5P{V`mX zqM$23Z0!11+CB)V>80%h!olj?gV`}90vM>Fw`sBGn70Z9LZ>mI2w+I^Z~&glLHv5XN8t4Pc2FPe@=1 zdNnnM2S^yd9J~B`NEp!pVy;AcMhFSR9`XnY^K^iaEYTU&(?ZFi1ie00Hv3msAUO2W z!nY6FKIP?_4VLZ0s!TOmhPp-1R9V>j#p_n@_3j3$GU<>@6%SJ^J)|;a^=Z>%@m}vL zJ|${HE>>mCE)td{cp0ReE32I`XXnKXydA&?LiGu(%9ImjUcA>IpWLywV1sc=*qh=~ zYxnx20?IOeN1WjnQL-je*4qmx%jo)Cxn|v-i!y2Sny4w(WLt{_l8u(_Vq6T;^HpQxrAA#c>0@`r#!~E40g#QOB>~xdv~10jb1^E1(Gr1d{Ca|_5o9IIna%7pW`(0A0oi=8 zWXuX8e2}OpEs%{FQ)wU@hDyY8gpd_vM|mI{22}{10hYr8T3fNAr1}s?GAmhfM7XsoqvV{+G`4#MV?Ds8)&f8dF(N zWdgO>QUN=XvPr@a+fKuWzLykc}rzkQ-^5y93`Sl0`^XxnC+ts*Q6eFlT`;Oy~ zn59ZNo`TUhX0>KD$5fQyA^R@GM#>pkgntUzcbyr{>CGU$^Y|d*-G%hKKEMYlzz1?3gNibx?wZ}vd9NJ^enQ|_1W68y_-(wV} zoURKR98P-X2x6Mj9Bl?^ikikuK}FX&-qjv!Ov%2X>(QjjCage&4& z(WGat)!+bg1c!jg)P`^|2!ETFYlR_Uu&?EqO~kdrkicB4X&vMU65+~ot*RWskZU!w zMI6Dgmgic9;RFcsNtrcZ2~sjESILA?0P)?#Bx~x~#%85T3atQBkm5805Gf(GdP515 zu3S_HPIEBn{B$zQ(2&GP*?gICwjdT;u|z-!D9bI{f_N(Ci{&C+kz0TcRpeGJkQIif znlFlC49_Y#&jjTe5>+$?ejegH6LVst(3)e$^OESYEudM|oK15QB^FbE0Fp(5i?+be zzZTd6dSwfQ6lX|C?Tp!rof+D)7kxcNjH-a%7qS=oMl;J^GXZ4WjJb{vrxQEWQ{x)59057=}&w~)L@G{)iolf5$mv#PrC{Tc6ABSleA zP|Tyu^Niwz#;7sIDQX-MjRPVA0v8I=E72&?&|-%)v1y6MHnfO9K^35x+N9HI+a$)M z(}|s!#N>6-X=A4~5$e4ETI+xAJ+}%pN%!~CFD>6k{qDKLIeV|O_C9Ovwf5dsuI{|3 z?GBsuNxQ4Z4r$Wr>hkHt4r%hf?2s1kyqMOV(z@@E=IRbWaAHwx@mhjRLsaqT~7_cR%%@g zOEDw8ZYc<2M#}Rf9zYbG#qQswV|x;WG$YFz8@7a9o*Y5Hpv#lP?;CV^a)=pO`Q&i> z_=)h4JUJqmk!FU*yNLT0&y7@5Q1RTrR(loCjo6HgpBu6-xj4n5mE}Ds<*6Y?WLd*= z4YCJi`N>hX*Yct6mD4R0r#GZJz1EuWvXM5t=4wTIpRJ9!_<2~_g2g)k!G}p7+o_Mwc zWq^I=dX@IXlN~5+PrM5K@7_B?x5~Pf!Pb^umthpKO3GG>^lM==2FR&P*6Rg*+=OmP z4~gyARJY1biQD9=%Tu;IJk_pvH~SQ921*=5# zNpvmW;Pr?SHVXErRgJWbxKs5(Vuw?&E?w#;vvu)S-Boo#ZF0BGRH>g#)#S?kq`ne8 zN>`^#{iNwwO||T`X*yP0C3|g(9?4#t)=S!6o1#BrlbDX>b6M539=YURn>p<%Yq8g+ z?IziMuT2yi517imHk&f_*owIqv`Y5cY)+?A^13EfgTJ!ZrtBu!2mfWSP1(WF_S*FD zPXE#lhC{+EcQACZkD=|gX*(F&UYp}eI~dAto5>vv)4_D^V3^ds7k!c7My+_z1&HF3;fjkrA-Xl}*CGK@l7nE$!s=9P(H{w)n zRC+#E*G4sdsV~XksTlVkZgo_;^I1F>BDt8!9 z#P|t`C!^f^c<<1LoQJ(b<^GoU4vqA__sj;Foc1AAndI)FO_?B_()(WCJyiM-Hx=kz zm)%2~({o%+&wgnKBNIz5zRroduY64r0gCV z?-&{H9vbf$xyw%@Wu&}gr0gCV?-=P~;!jcwtc6N%ovQN^_rt9XOLrk#n=Q3CzsBYL zs6u}pmfBoUonxD;s`g4d3I|nbwz{e+yDPO-KKgTOb@_Z1Z4>Fwt<`06_#$Lqmkacs z^vH$TYL$IeHe{Qt)jN0~pZvOXjIQ&YypSEZlIrd_4kG@$RCs!zy8!|OoUu&<}6*nzXXh>J# zZ*w|AdlfCoq_AZ-+G`cwYf1(9+k*Dmgj#39TKugGGkB+W7~%DRunD#HgId%&htm!X zdtmSRA!xHL;UMnvIxg`1lvn`TW`_lR{NygLDc$k6yvyq#zooRxYtEnI#k;)5d!@=Q zugSeqvCFI1QK3maQ2HL&1HBJ)+{54gDIa^Fw?N0M@w!JC;%~F+cq2+0Vh{8o(D4vu z?->jZ`vs!o4dG~*USn0q#|2gXaY0XH_x6KnJH&4YM*HQRWT*L=ik)PeFj8bY$xino z==p7)?It_QYjoq?WP2bLjXSyql{>oTP>NdY-#r96G%)NR^bUsyb#TA4C`;OR@wZm@ z?;aTR_hSvpVoc5rR{Fjt8Wiu}-OnHFi3U~s6HEKkPV+Kuyg%&#Z$M&y+UaiOwWgk_ zkYl`ObxknAm%H>d_N<=hS9_!UMo;dN>{;EzAA=FiDY|F%ZJzCDD|=SQJK8pSqugq5 zqKh4EGrz4k`vADnA}iV1Ipa@LS*^s*&J(?AS7aqSJ2xZuI+hi7cFrBHI72INY$5 z+`-r>ca&4@PQ;G3t=?}dzn@)&opL8)_uEm};Z}C$l^uC|xMQ50I|V!6wg!hQzn?xH zyYb2{zvHn}?g+O@%hcN)jvaQ#VfS2YhT^uSqRQWdb5JJP6*w-F?ED*-Ddo0iXI6gS zpLL8f$?m`?Q+`h6_nkwKlk7e$^%#vEdu5m5{_en%tXQt<<12oba%W&)U+jfk+HJVB z^Ke3-|NP3 zb^`pqv@aSqCBx2Y@fo}o?rm7Ma@BLE9sB3DDVprBhXP<@HSFzXCy@Q!mSaiF+rF}L z!O?#&yRyX4?)x)o~_$)uKFB`*&6mbHq0J8Y+Z}tYvPhPxKc&)uu-+r$uAoma_ z@ILHbk1YKg|L!KoNso?yExXz2uXRhmi=^=QIZ6-tUwM`Me&IEG0<6jTVefkP2H*L5 z%`}M3?wkDB6i>=t`n6u2KliS27hxs?ejYk6_Bp;Jal5W;gU6q$*!9YKY42)xAyQZI z+m!QNfAGnAr)BfJv)>mN*nX%*mNI*nyH{W~!&O*nWubpf#(60>J}#%$QVMF9gP26l za-T(1mwQ)W@s+FmtD}WE=bwAbDqSkBp8iTJ$e(#1a&b9iL0#!ym3RKd?Kj^9BE>V2 zpki7xk;(@#neGzzQtv~UtcD*|J3kIbo(ch?;U#|{zqsH6??Ozh(_i@bg@0MC^Mm|k zDUmc&Jw2-b{&S@&a)ApjywJPI!}pPkdTI2bdgn)tbEPbHZWUJI>mE)oU-wa<9?nnP z{wI~b%Tx2q-g(~n@?{@i?&Z}rhArr z2lFKGoxaY0q{p0kYWxN74EMd5iGCK+!rm90)8f2QGwl@n)H@y1CC>2hDW=Gs?Y^(S z^M>1J-YNR2cba#)hfk5kfZq;ue(MiD@#IrZ@lJIY$VW(DI3sxPVCSvu*pp5^*~9zZ z0wkxNj?A$$hB}Aqr=4_?hqsXkwg9;drw?=9a+~L#cp|c9PsaT6Q^N%#oWtR;6Xts- z`X~7(hxq*{=WuS^2`6~-k&SRtc=BlHNW-+_{S$)u;fd}^W1Pco-`Vs0<3qeL&N-YK zHfL@yFFf8oVS;nGY8++@%nj#Fat`;LGJAGvjyrdek@disuS;Ygrq%_Fk864c7*1f&ym# z7Q!`s)~45lgi<+?mv(f79W zig0Cp&8fxVO~H-94M)(+1vh4Hs$QJEDRpCbLvVfY;m+$m z99*Bdq4vh?4JjOkn3x(Z3a(3kxX1OG52vmRuMHLj*941F*EU?2y*6AFUK1<~uJ#wE zu4!D9xh93z!Bqj;cX)O0h3TtPSA|!~O7-p);g!u-rLPRH2z6Q9=(6zgepjR~4=)Qp z6kO_E5`3r%t+nQ|)Q3`705G^1jpmZd+I7hceOVfum;UInsh-g*7cPoEclAk+nb+;eju$evgA zf%LiI`$ME-duM0f-{aiu`_t!y$RP~Rip~t**ZZ8z`%-uvA~n!EtL5y>S*bHaO}>fV zn>#aiR@Is5_l9SL?+H(LPfMNA^S#+K(s&&r5*PEMVaI#E&z(zavH?QgV+`RPM)Et@3IdE=fPHJ`v0dRMQ zH@nxI{Ot6slt$nN&dSV8Bha0i);V=XpP9KC>FH_Y^!Zb=(^E6*re~(5r=}1{>o+Ys zH8UkOIW@_h=ufGiT0JF$*D1u$qvKj8XD4MQrY5AuA8~t*Ynqgsn3<3spBm?mb)6%A z-|;mQYbIpIr^lrcBln%o^x)p(b2vy#T+HdL8QEi8er#q;8o>n2B5{tm4Wp~ZR*lJy zP9K*Z<&Mlaok4RjrhatxxXh^ZNN+^W>C6nQKQ1>aGcr9Q7+!@_46PcKADJDIMtr&& z4YB8l%*d({+2QG7siC#_d7ofJ_3-Sl%+U0ZdZ#lxpmtbxXci;A4NhnEpsJy{A(_FM zK|S%qhQZk(xxv{%nSs5WPPm+d^MkSjGXr|#M}5OV`GMI1nf`rH!s-@pVAX&u0t9`X zPOpbIAm2ZS@!J;XNZ6}?RZAA*c?0m9K2`m47$8m>+R42zZ2eN3Cunp1JnTC0c6(CD zY(5W7z56fYMLPX!Jv9Az_F;JjVR^A@4_!e#_b@qsFrNG2p<6iG@8X#s9=eF5{Z8f% z23L5Omp==RGM@y`PMzX@w9h1|8P7|d;2s=hrisiYaX%>K3@VmtDNla)(fWP#EH;lZ zILbVd=zJf&j(MeFP`z)wPX+Co12X%>W`OH$ND<`4jxvz5@uDz9+~hSe^Smpw2VMk zS8kEt#F>Z56zS;H0ISP%|3vZ?{Zk@*5+rgGB^le2r;)9QIVm#PJxF98#`%TF{loi` z`xvi!R?aT;PQb%F@qTg+N#{KDm6nDSbeTlr&z0p`Bne3-msBPfBKf%VeklPP$w1+3 ze^!M4RK9P^yCkQJpf|+(;ryEgdSE^$<#Ds!3AvZk%8pB0s^$N-d%G&&hWsLm|RSEg`=fPb87VAau5x zmK2tzmsq+G2E8y5rF$lXi_ToGWJyioSeu3tjgt35bmeh!wd5(dItiuxo<)7V5iYVL zQj8bJk>Fr>I4*@~u|$>Q42M9cpd{asDePXwcPtVd;USQ!$bvvTE^(Y5BH0R2Y5GYT z5j)Epigfyk^!WBpdSGfm)ZZJP8YbVdsGj6NxLuCZEfF3I<RNu75 zk2B132%9CE93M#@k{!iS9ly7HmSKKG202I>J&IGKqtcPYangwYWHsVrvEu;opDZFi zaU>bTXr&{G7$hGjl~V%aj;}m5&(@1RR%Z(1=_spWm8Wl`!>Q~g`$)a}8 z#M2_NW~6*(t7zFgx+7;?$SEo1emI^cBK;;jDD6@0SIJL;(>?U4-Fsolv9@`BUHj+c zED`BZ%Zr4RbHk-u^GP)?aaDBWcF zU76qK9<{TTjLNPHU|E+KPVStv`Sh3s`6dy0d4)OcruIi zfzp3^$UCd-fvr~!#`vY_edT1$)M&R$?`!>_t2t-M?@8b2Y0jCQ&w5|!FN0FfS^S=) zU}G3wd)3NGd%kAnSkEhyN2K?YY_s^C6na1D4?72!642te(u1QxAug91QGQ3}_4!@i zNe{%RHoqgCuO&aYOgAgPlj+~tqCKm8CC;_!>{sfHE&U7~B)aeTW9crFN148<=5i{9 zq(313&Mw%JAp)eDSu&?|rPv1qWI!a(Yuc2AQ)DXzE*Le-BOL(`sE@WU`Lg>}C$u9iZ zJ(!Q#9yY12t0if3MEv(+qy;u%Z2498ZqgeZIsN=@eOPRjNe?1Z>bmw+(uYY;;pvpR zWKR`;BE1e~cW|bP%sNT-ZqkcH$LPbPzwkJtuCm{YbHpQ^QP;JvvMh1*14rq@Y!-<- z2R808dNF^tr>0@o-b(r(EaHIjCVMOEm%^F;47lSJ`RUfXNxr!|&F|KaS-0X(jVk)F zWSVP~m{S)UlQv7(n-pI)nawVF|fCuxB; zqfWZExJPnzMqS*ONorTr99Hyg=)Wow!_s}iiry?l&Plm9%k+-t(^=n!M0F(2#tCB5 zE6Ho?%ka7}N+by-6KADo%k^{{ypjQlm^lyDy!$pY+oHLi+GFK;D`nTvpA%bF<$l2|jc|77Ec%k&I|hHIhYq8%V~7nI z1bdyvd` zbZ@Y|%I`^+5svH}QF1=bOp+OC;RttloQ5xH^X5W^!@DOYOY8TTm}~}5JjYhnM(dhz zFNw*qI~uQJ5R?*=<9;MPC>ZE=OSlgQL@=)GJJxF;@1%eHo7jRu#tE&R*oKkR8eThSwYniob8^q2<)%*qyZ0Vq+?4>mL8;>np|5gsce>#Y^iLLGAOBR)>~LATRAmZ(z42_$pO=|%BjgA)3ds! zvPoicQzqH-Bo~sZY-)bVf2n*5yAvbzYq~a98Pf69`A81*ShI-uB=7oscE@56s#{|X zF^cY@S$1u#SdteDNy#dRl_qn?-Y*2H=p=%8k7@5WjjVoC=TN35qbb$$q={49r9EV; z!_t%nw<^ack)*iGr=s&@5yv5fE`r!xlCmO+CgOv3*b8?wKCn}_Y0wLWfjZxlhsJ1XD(0f6+5W1=Z*RV ziD@*_^9Jyq%8DjdP}wHR^bVWCgi2A#YdR?)D z%2rXX!B6zM=^i0XR%@=7WF)wMaK^v6>ye5CYS z&zskje$%u#rN6d15C18iq~+&R)WaN-`c2m&%=@z`h?3MVS{NtwH{=2&^~(f{WKw?v zY#+?B(lqUwOfspzDU(VEnzmg|>X)9^PkEZIE=m2(NO;cTZ#m)FlKQKmZw-lr=blI} z4g*W-50PZtSW0-7r2aVJS(5tWgy%S^UlN{^+Ucn-l)Ip)$xG-)R#$zHPvb5q#4|YA z1^JCZ!Y0l&M*0knpU9YBS<($m`NlK2>^;kx4{=9@d2PDpLwwi6`mm${RrOI_rqlyv z>Y~!~xT?;t^-KLxzBXOzfx;Toiz?htzcjrgRh?n~Q&Sz4p2w-Gko}KMS&;iKQx>fE zu_+63-{m=MI+4re;{Hc9qDL;B&1?TtgDDF(rK$9%jxSm-*lh;O@&m`wqG;v-&=H-;;Sja7kQlU0l znPbtMuH_ty5TEolRh92iwWN_nTj>XWhPic-t4dw;Jb1cRN z^?q`WMV!6A3;jhhd%urAtdzZvITr4bikp_F!sn}H@W>?R>)??*aHaDzxz<*B==@CO zF&UMTlg`gnKAo#p$<^jUs(gTX*LAqL`D{uh*^sSM`IS4rc;0oDD!z4oO*-$oSEezY z)43`hIzN$TE)~!AXvVy24>E1h*&h8d@7iX2r0`C2*peC)#bw&wAmg*g1!~AJp#}S92(u5mfJpT! z3>zSW>M#$D>KXd@+Yg<<(69lTln(OvD>F`pV!m!X<3#4`#xqXF1vRA^Cw+opetj_3 zFV8rcg5E7T1)yVHe;4( zsCPCBVfd!fVIBU~VxDLVT8N9+{jmhX5VVjw)FK;X@V7p2@lKzhe>f1MF(ZQ-%%O4p zwA9O&79z7mlk;2BIt$6>w;YGK)L_3~X?{!IpIn;XGR4bb#VMQL63->!{1(JAl6P1% zt{2J>U^e3rXk1Dp9t;Wl2BL92!{dS~ltwge9A-0)4jO#XxOg^WRWQjnjhpVLz43l6 z#s!+-hYav!K4Uy*#?|>nHfQEIuV-n_Oalf8^WJ0^b7qhmn=F-wYt~>1jz)h_(BjAU zGlv+j2mSUuxu5Zjy%v9vC-+lk?4|TdkvrW>muA}x^!iuKwsA4XXI{nCCizufEX}_D z5U;@>?TIu4J)4IW#d5C9XdCAB!K$Q#T$$0vnK`+Y6=!O7-|_-?l2_$QJ!KA9UvCJ; z*hjln-Xs@uz^YbPe18J$x{+QlSIXGO8|Kzyo!Bfkc|sX$)>eEI()q6)*Tl14j&pmK zX5uusqaB;|GP@$jxHTVP9*)d;iRa-Abo)EWc{ncS`pm2RP4uU=JHf#`oM2_;_tS5=fiuaia->8<+`djEjM_>fNzU)}890JejqX-}hzS&Qv$+NO@#_lg!zP%Y#{+xqX%2cRNrXncF0De55=w zx2dOloKxjaa!{VCj*9QgjHW?uiO9uTBN?anHr?N`>pwP6~dGybj`w+60nCUr zjJIl<7V*kzY54gyG%;*JrMjvVynMWcAC(tW3hCun<&HRTWz^hg$i0^&wf^nx5liONjrywTpo5w&ulJ(lxH^-^P@)w$PeC-TI;YlN`jp{9_|>;^gpAYbl>XIL}7 zj6h&**biUH;z5SwWjDa1Y=C^VZ|DYtaE=~$o(;hlGI*jvbzGVBDd-i9#HWqHarld8 zoey=v<4qoJn8;V>kH_B{e~ z6|(q%akSTwQvgMon#7dO!@ocwDBgD$S(_aGS9xPc80F zeLmEs2V`6(rN<3e087m52AJ7trHspnu^2Bs(3s8Z(gTgz1}w|dh&$oy(gQM;*~Vq^ zcu%G>`^rqWr3VI-%xs&=oLqWf7)*#7WJbmlnd4CzdsvT$i5(zXXVaL62F(=@>rf}i zmZvcf^!s;xRO5z6?mVy4ap!s-q(0jV@OP${a%OmGyqbt7ToxRGr(7Ov!IQ4q>4|x; zH8{#)E^M;T6AN3s6S1&Gm^Er)i!E7R*+?vGcwMltMTB7{s}^N-rfgw1LW9F}h)>Ha z8|74Vu3Ff#vXQDb=2MG>?W;xUVfBWtD;t@GJrwp%HAI;2V(-{|>hXc!#omeMQy<&j z`F-XHdtR%%rb0@2tyyx78!RxM&Z4&Q8aK^Y6`>AwYtWY47po$OFD9!Zw7|o!!s~`^ zYur@9qN_=)iqIz<7TBr?V}q3M!J@0Ku(5g|U9D_mP4%-CHdZfxWXZ;QiuP4(yTr4Z zX}kE9wu`Nol0!**mDVE|f}W!uwkA3!{FU_xhG4yv0pWna)=L?eSdU;VG7QAIPp+3z zUXLKQ-iG*nz1Vsa=RUUHrh3_u_151Tn6%!){S|ki5g97++8yH(4Jf$|z|k6z_^9#P z9q~EoCN#=%wD`({LSz{F@c^Udt*yp)$7Lv`hhcwDjeNX74eZ`-uy zAS}h$GK*(Zi)EJVIbd(mK8)=#u@4jWm|JO&wdUek?qVOtmRW2c!ZP!_SY{cS|1PD7 z=f5ZCbi+Oj->fW8DxUi;<%#FM$K}D?_jH%J@4-qpRhs)QYcYNSm)io2Y`0WT1;_49N(y`q-MP9Y-ER7V^1tMe<)dlv?PB z{7$;41`KD&d8EsdPDjq0>_4QfgIM@W<4F zKjyXH?f>4@{r^e&mwpz}i+BIOD}(<>I^d@f$}9hOoZ#n<6F%waKX19?crV#&cQ*3A zuD93DR&Wnrp9Ox9uSbAm?REA$j+4I(uU-64pSbvzs~6rPpQP|V!2byU2g&Q>*Ws_@ zWbj|!m#-tmOkV@e;Kb{GiPyQr>w$^a`NZq0#OvzB>sq{)>&5@lcp=x8^AF=|z!@s9 zBm4u0BwqKF*ZBWW_+S1Pe(xLQgHrY7dywe&2Pm_j{Tcad;|{4WYP>_rC+tH?Iry)1 zE=aG*ZcVD`8T~NT^gQ`8`AbsDjPLiBx(e<3sovvxd^~wJc^SEwY$ZQNK1@DIK0`uX z@GsTxTH^qoZ}7j^@z5(tz4=aR=z1Q1oct?t7x{Ve>*No~Um1saWDjyMIf*=xd_Q?5 zc?-Fo{5bhnZlZ;}{-~`M4dAZ6lvE zj{mN4GVjl1(;KW{Ywu5KBu!sZQ>OCx6!JWBA-Rk!k`I!fCijqEB3~qbO#a$9H6$C! zVdPZu6!JWBA-Rk!k`I!fCijqEB40F4-(s9??Ibn(1v{SeIpYbZ7*A|8p7NM+!B5FI zjqmx1@hoZc(A%?`$Ppy(%UKI}d;z(LTtRLiA0i(k+sNn0m&jMiH;iYe$tH3HIh|ZU zUO+A)SCAXXhsejsHskyL!uSCgH~5!2?^*I6jTg-|UTl3<>f%>;{JQZH-+1W`H@=Qo5v%`8RTi?h2*uy z+qM}Cqe%9zYkp+Mx8G`9|9SH3EKjm~k<#a#gbU)>E|84gB z`#(bdIr$lKpK;R z5BVkXMe@hwuZ^Dy$wuSD+l`NynUvZ-#g4bLeSPLaJO1k#5jr<7t=j3O| zedL$PZ<9YI-!wjvAs;tBIm!4G+xb)T?RfVxV;i4CZHsx_N>Y#89_I0r+^m=j;!^_*uSxfc$&%pUIz-hmBvV zBKwhJ$T{SD$xFx^jDP!<@$c?5e)WFi-_JBY|98e0cz<5t{ds}+=LO!Muk-$Vy|;b; z>m$h-! zH$%wDXKOkQ-_H@a5au7L@oKK!(Y#d|k{ny6ktH`CsmY0kJ?<2)^ zhC@8~3#8q*^e}SdkL~@Dzc!8vNz>=_DAUjMDAVWks8jg4>2rG2LLM(8i{yjkr^!9! zm&g~%ACtc}9v700_=f1-XHIho2I=O(nfLuhbAUBW?k&lsWEr_P0&)?# zg4{qpL_S8gko2I=O(nfLuhbAUBW?k&lsWrcjb>SL*ejmA&+(8~BzeawK`~`W$cuh6gLXIWp zl4p{ak~flT$ot5xkI7#f|1u;S$zkMF@)Ytsav`~lERqkBpEiD)&zn#4dGk2= zS-$_IjpwDG?6B`YY2$h6C%?<%e20$&ZqsB%dHV z$gh&$CI6Lt%lK5D>`RU&XOm};7n9eMtI3a&pCq3kJIJq+-!<;#^Jg!gKkeip@^i1* z_df5E_2eLOA~~Nthol~VehH6nCm$fUkx!AIBVQnYK)z=Df=kwugUE^GeDWOf3UUc~ zJNW>)jeLsy9QgwI1M)TF7hSTR9Ax~;5R%WKuaPg1-<)ore{%tO0lA1=L2e))BB{UM zY~%5BK^`Q(Mt+a{1$o5y(`vGX981n6&m=D;ZzR`{_mNx49mZcgNj_tIjr=wF z<`?Y!H@`u?LcVU~_*0tWPic-nrGG>H{mn`I-nryen{yokJxTuI(deu8|Q z+)sXm{0{ju@;AonEZK(~Mb0$#m`$Ex>_s+{EoSFrS}wECTNab8;{i|KEs z<$1pUGWkm~GWM?}2aw~*?u!LZiJuVHi1;JcT@u zTu3e>i{yjkr^!9!m&g~%ACtc}P7KLLau_+4JcT@uTu3e>i{yjkr^!9!myFY%BVRJk zBIl9w&Cbcp|5y8b{#(Wq^JHIgG)a9vk@|b$#eDyIay9u;@{{BfWC!_G^1I}}l5ZJL z%9DM`(d2CM4Dw>~dU7@SQSy`I6J!VZRr0&!zmjhmPtF@puO?fJ@A;nbEb<()gEHs5 zX79h>?4Zp1>v?Q;Q0Dy;c|4yyhrEJZLf%e3KyD+SB0opIK>mPy&3LX$){}$CiR66p z9P$cs33)sD0J)8Piu@e;0{H{-HRA_dvfg-613848Y`m1be7YT9ZuU>+@(Xxu_D|;W z6+GTRK14o7wvo?~FOjd3Zy2vglTG9Zayq$yyntLpt{^v%50Q_NZRB(0OXREM8^$Zs zWD_}poK7wvFCZ5g7hOlLB=0s}Pu^s9Pv$1Gdonkf-IKZLpndPAuaVT(n|{ILBgVzm zWD7Z#oJ*cbUP|6bt|9Luw~{-^gXGu9?~%VCj~H*RCR@m{23fat(POxs}{O z9yBg{hJ2oU*|?G{n7xxJn7xx(PhM=tpZu2b z;SU?PZ6Y5bpC-RReuI34eBJn0KG{GHAt#e3k>`?EkxR)t$W7!URs_gV4)`S;{MlRqa98xK^G{m3!o9P+*7CFBic zfxMUe3-Yt%0rKz3eav%9+ z^4sK3$v2HJWsKip`}$|g$IE=L&fb5S{n-x>+VLyXNXwVXymCH|uOXL{cafXPM@h^7 z%e*?#izUy?h?XUTsg z|AqW_qnU3`=CwK=4>bPjlg9t-XMAIp@y(^ix2SJNF1O<&H&RWkMzi;_O&_u2ravb?L+&HLOn#gEDfyCb#*v$hqd!9axp5rjH__TvcH&-pf8yVg-y(lP{-<$LitI%W zC#R98lIN4xkju%t$j#)V zZ1N29V)A-&wef@Y9L;{no_pELTJ8PIsfSltzmr|~XZHR=vqQ2ADd&Y>ayftI1o*JIOyIx0AccFOuIRe?357PK4@IImE2=oGtAh^``gO<+sgaf%KO{O``gO< zyDn|NTh~O6Ag7ZH$P36tyB>4>aJoz&DOENM(R7(yZ$CJmCXOowai^*2Vekza8C$AxwlXsDu$w$e(VfDY6$ioSa6UN}f;h_m6+yj-S|1 zvVA|n_WZ=p`2KH@^tbd@;Y)Qc{lk9@^NxM`4#dzO8ogREw=}2@K5gd zwTGO}XCB2~7`v7@t%-wT@}SUK8)4FKYih02`RtB4PUoJ&Y^SqhGyWXfKHE9+?9LnU zvh7a%Ij{xC&pdt+UhZ0gKl|^+pMzWF%_pwJ%iSySr+p*-9NH$o+;I(FzT@dG#+QzM zx>a(zOQ+}gPHR_R93}N@C}Ibb_Kl6jVN%DY z;t;K6?;^H6*;8mP4wQ@aEB2R*^)L3*iw!9Dm5U83_K}MXDK^Q)E*@IMJ{h}~3@`SS zi;XPykc%Bxtka8)E@GpN-K)kHtEK+qi+Q= ~%2HmQg`JNB%ZQcTIkrWFH~#Pp&k zSG#Fu(N$>_ajm&UNTZmPM!}>}FliJhje<#|VA3d18U>R^!K6_zX%r|8Op+666igZg zlSYBkC=7O@J$(x%jDiWHKw%V27zGnXfx;-5FbXD&f(fHQVH8Xl1rtWWgi)X{3MPz# z38O$^6ex^>38NswC_os6*3>gj6wPtG2n%dSSf)F|+O!eYvW})Wxd?03Mp#QX!n(B) zmhFzPhHZp3up_K(9bxh92y5#`SR*^a`nnO;yp6DSc7!#wBdm8FVNKi!YvV>(CpW@+ zxe?aQjj)Dpg!ObItgRbif$j+F?nYRDH^Q2?k?+ioTxTw3u&>264!7Oex(8d>9N2<= zTQ+t~g&I71QRp1$*mek;n(Vq6wY`4Fv$z%e?t&O@--}I94sOLJESnFE5Ounw!8!8i z_Ghqd%I=j-PUq5{gG5Uq>bv)~i0)vcl`RMRi25uX^i zXkhy`;Ey%+$1lapWK&10TiBX?1`}2i)hL#$Q7l)ZSguB~RE=V}8pU!oilu54OVucr zt5GahqsVG#D>}4YTM>FKZAEQ&YAZUhMOu;cT@#Af=VsT<+KTpV&{lMCtG1$N9=~*Y z5#ryyQX3Kau_8o=MkJL(^G{T+P_A5|T)9HIa)nam3gyZb%9SgWDpx2~u28OApll$1u9pN$`!P7h3gz2 z4MG}2Hk#~IN8_RVV^sN@qG3+oXb_aWzbgB%sOcz5js>INLCGP)sMUMciFP0Fbl$Tc zf3_Z)=N!56@n`2boon~tcw+~SzrRi1{qPQX_x8Pbck=-pL$z_dbSIAQ-Y0J!#G98r zDsL{|h2!%1u6UdCt&{U@lB?MHZrFk2kCe`Lsh)4y(ayKV%7?E@p`+_s{bwDk3{FD2kQVb^>K#k z)ta2)#m;qm(K8iM_nyuuy;=`vbg}b>9q6NqkN~T(bwgSMl)14#$}*AI>YPOo}C$6jUY!lSzRxDVR*G?PLm+Nr5tv z76X|`bAe2>sX!*uP9PI$B#;R{6q%rPs7wkblY+@at_GPDC=UHPn>2vaeAXM_Hsr=jdZ5%i3(8jT0AD+CTdfGOidfGOY?b5b!&wf0HrNft| zAs0JN+Qy2fwQX!{$1_<}Pnt&8ix%{va&K`_^v`-xxwp7zp;Ip^_ZAn`dy9+8y;bGY zi%Lfix<|5Z0C zb;9qw?co0k*=0KAsb6xY+SbGNI-uUqqvH4MT8uw!Mf{;{rq0wYINpC>>CGpu#>?Gh zXUa~u2ya%LPMoPHZ;*HID*g2FOXR03@Ta}o`Nlh~ap?}j)e}#vZM}M02R5sxb?DKX z)YICvSUjz$EeA&n<;)kyi#>9&I$FDKQAcb4ed1{0!yd(v`0$CV)zR9$N*%5CP2y-l z41J2QUZ35uNFA-V_3CIH*sP8gt~H?8tTj+itL-lFv~a><#YVZ>CF*JIUZFN(`+Z^~ z;=?h;8oip@h`U#fFILn@yd~5~yd~5~yd|lTcuS~}cuQ@?EW9PDQh`+xZwXZrZwXa` zwNi0KDsnD7|-Z{FZGFM|q?|1LuV<;IaX-=jB`hX$l|aOC2hT1RVot)rz^H9oji)fi(N zs>Zul>3~7|CK)imty4XQ;;SC-U9WoFu~`QUFf>swiVTNb6}jzBRpbL(bi@Gl(h-AQ zOH`5f->ZszaH}dZuBIafyH}|mw{KECKD1r+7*|t0-n(A)xMQ>WI#86+qR6|FG`QWj`x^+o4VebISTU%Vlyz9_v^UzEPBDDIHdUj_-J{^Aay z{^Aay{&0t+{xU`&^%r*t^)Fcc3r8Cp=-NU9$a3*cU0umFOUwQJE?dYc2e~Qcv3OM?4;r`*hz~xX~BxB zMz@_+?Qot|OmjP{*y?sxwWoPjv9#>0VsqPB3pgu`*qJbBr$%s8FuXDz{my6@z$4+A z4#RLv*iC57-RxU&)M53Sfh!*7O=|Vtsvf2|r!;WY!>lxLuT^`wRXjrVB{4#S-`n}t z#~y2RNo#JMcx&tSs<*bOL%lUvqT;Q|xBH2^wqYMekHia9Zw+NoZ|&Bd>aE?qA45rE z|BAB)Q}mfS@z$0jQ4gz|}{te%sVPlqv3J~5S1KJm!ZbF%UkI<_@?EOh_v}aiCsz~AmTm~`RIa9~y|F`8 z8&?z6maEmsNW{9ms@t17RJU<8)$JR0sBV8`A38~K8CA7WH&yLri0NS@;-38wNU6#@}e6+e&ykq!w0kseANK@*7fV-Sc8Rj4PZ0@1+( z2thM7zZsPky;zUlz>=BJ$*yYa0U&d%82WCVnsc41{%zsEKI z-{x}X*P7P>t5W>xuHnr`HN2@YkGtSG(63fMxNCTGAwEAwc(cFL8eiw|q3uPn*Kj3u zE86Z9w*vNQsyGEE=%W{@TY(slxE1^E61M_ZtuBtmhmT*PZpH4E>K?am6!*CE(6*k% z;bP7$RIg%BLEYny&Eg)TQhkd9^kV8&wB6aim@G-5z>?my#4%60z`660z`6 z5?J_Bk^)O27CuTMUM)%j17Au~U`b%$M|*mUQ;UMYsg;5hSP-%AQIJAw{*dFAqHk!v z7zefJn^@S`S+*2?6IT>l-jaDpAx59=fEb^>F9;@X| zjUOk5Jnq1oI)VbpU!?JO_ikmK5;!!xPdx^f*_#;t9P$f*Rx}@xSqJ3 zBZ`PJKD+Y@rqn{5c?(Tj8lW!KFbtloE*xSmj*$;GrPvAUkSZ&TN^eWSRZ zxY(@XVFx-4&vW-`hyu}rgeYX}1)>lwg(yTzAqvq_5rt?eL?K!VQHYj86r!af3ei%C zLbMd3(6JYYLflY@LflY@LevzZkg*pLg}9**g{Ub+0XI}cp+heag}9**g}9**1>8^( zMS-FaHx#0fp%;ikhh88G@j@XA@j@XAc%dSS0!1NSC`2J%C`17-R76oQQ4~xRg;uZC zDUaE_Q$tCHsk@HZU~A`6m|9#>Z2gRYfrY7)V>Ylb;7?6Pz`(-P;)({&EQYCZd+_Po zwx#lDb^Bn!QYQdrHss*?;ss(L#s1_X9Yy%LFTE+reVG#pd_@xY8v~NlT+jnQNu~9oN@5Y>@)?Orl6;hm;+9uAqbpC93PxUoGzS3y&{}OqZc@hI88VW zTqrvY0yuLb5BDd)eS$Zo{%{ueFAo_YXoUdKxTwx)4WLJxQQ!4@%T?QUs8qE*co)ti zj64pG52#=9FuRBPpYYI)iD zRLaXm%5V$hr*giJ$oX#AQ97Rrd7YdOHXJ^(lE~>+NJ$X*nd3x0#T0x0ucp;K*afhK-4>dK-61-K*UvoK*ZpNK-9B=K;&u=h&Un; zh{S6l5cP>55OG={5Q(-zAmY$KAbK?jL=+wZ5$6X2QIj14k@GaQ*`6>j%^tsH30KO?FcUsXFQUR9LPt}1${ zR~1cEHN|yRO*eI@ny%X`YATvIPBIp@9#S>k*sf~2;%QY=G)`61EeBOi@7b?v+N~_o z)tLmew_{o4{##i@1+*-p1garc7EuD#5G{);0m>pupc zT;RX9;GQ<)o;Drheu_VQjQd$N&uMkwH*SEFx@!pr{*X~5R?8L~x7~?j82LCpv>nGC zoAGB)LEhZ4P~O~zvvjI za+Q4PiL2vZ?!Qldd5fOzV))>Kvt?j@f64VZC9sr*OHEux$r9AKZ zNlgi@%24>S>Wh{{AVv>=m$$pjXo$OPdFm5F3LLM8>132aS~ z2?8IY0Rsyr6Sz+z6IiDz6N#BXCIyoT{4S9R>{^wHBxFJ+1(OMEVUYR_2@G$MNdbWn$OPJ3k_md&d9XR=s9h*_m83FeF%B;_qog=W z7FZqZ4oQ8KFh?VLSFtxGHBwR}`=NIgdsI><2WczptMNritsIHoRUAICWhJ~a9=)qL zgp!geshQKzyNVqwDVwv=yUs=Lin1YX*>PHPjuUCSTB!};(o*ZVS6au-`exT=dV{os zQZwDXS{sM9D{ZFIuDUkUwo)@iqy;}`Gwme>C`KEl742ThR&=ShqJvwt745%wIvgRC zL>dw9$VHQ-6&={3t*GrzYehS6uvWBPTT#bmYelQI6~XDTR-t?2Pf zv=trPYOUz578wWFwOAUF#Dw}tD>|@QTT$EkUPY9)fYL&}QCd^)OJ|9CqqL&lC@sux zDJ`^HODpP)(n7t_rY5Ls^3yt)$eVp-zcr$&BwDe`?K~Ah}cP_Udr{rVbs>$7556^KaOp!}%NbVH`ys`8t{pcST3@m+jKg z{CoC81Y!cqV7{2ygCwtT#nU>Pzp)(+RUY~>m@hU!vjnQv?bXrzO&vO#kBiA@zSN~b zB2^pq!J!nhSx56>i|AuwqB>)!qWEU0q8P$DK5tbN8$-wEwTf~z8J=eq#lS`tWoz43Pgvk)Hwn9r>09TQ?fau{&iF>Wz ztAT;d2Q)AM|7wafl%+ehq1?R>PZiNaX(w`%#!8am@~5?-Y;4CPNc2$JiG+fNOOoN* zJ=#za2>1Iv1?YqL>=rusVzXrlBpZ zvnVF&tcr;`i(;bAqL`?&D5f+V)>*tbZ8=(JbtqA1b@@SQob13Bjg#RfX$WN35)FauzgOdA2e)dR z3>VW7$nI4d0%_kQArPEzFuYZGUDs#`WX~E6fpl!v5D0GONI1H3Gc^X%cBjNZQ2B9i zisfc%3}n|59sS;auZ(`<9!-TiEdxI~`n`LV#z5LPA>+z9w0%y|WKm4YLKR13Au$lh zLi7f*5WRscL~leE(3@yam8cCwA#NW;0VhyJAt4ZmLIQOVg#_wE6cPe~C?o^|QHb#k zQAngtL?Iy%h(baj5QUiS5Cxo66@`RAAPNbAKok-J5mCUuRZ&O`1foC;L_`5!K}8`k z5QsuzAP|N46%Yly3>Ae8=R*_{1A!>ukU$g#6GZ_bhj(ZJ;v&KZM5q7uu|hnn)b*5^ zdU!&qOPUOUh|7wkC0I%pJ`k4{sTHu4ECeDhuZuw4TAU?Tag7{Gs4vk1yUmNk$dkmk zAhZIT45TS63DHW5=it5C6GIh63CrL3FOX832^75J(J|dqX2T_Q2@E|QUJN}D1h8} z6ac|5DL}yr02O@ukkvcgFPm8jVRlOdY)y4Ko!{R!=k3B3$)J#gD1 z8Hh>5n0}8y%v?;6=qyS#ibpU53x3nuJsOUJ1*vh6t;hvMIO?AL5(mM^YgVFBaQ-w7 zviYFKK{o7@I0))h2hUAHRT>A`)S+>Zb$c}q0Qb`m<5(Sln7?K)MGf9YN<{Kui*HJ`I4VB*c$|B-E|c_=ieDd`^jfm?R36 zgc#-;|4>P&)ecGM)pU4UB_Zyh20%;_ay1Qrs3gQ(ha@ymqr=-O2?^9dv6k*sNuZPZ zU1EY_>59esyGB05l1@fG#L_-iF z%jqnK7U7ZMTN)rdYG_fVaZ8s_rN&U;KWP*Zb0HA^gM>BwxAl;!{l<1x`{hro+M|4` z_FE3B+TXoj)&ACg3x+3;}^SES^VOOD>Z&`aI3~I z_TQTm%Xilj4PU@^)9}TCEgHUPyVJrKJ8!h`#dZl_B(EY70bE5Q0=SBphPaAG1aK9J z2;eFb5x`Z%ro>ewARt$ffB>!{0Rdb^0|Gm5w1B{N2?*#_{-DA7Dny+86P)Pd7+pVl zWXwkJyF|ux1piST!Pm&x9XeS5_K~snqejLcBr#U;*M{&lGPc(uZNK|nMoAE5MMdzx z7=2s@{`VAg;2(yM4*Vb5rUU=&8+G7+_eu`@U!nv52e<0L|Gv8>h~Kd5W*PUFJisv$ zK09Co|7~}0;D3=0{2$tG1OJV+iwyinZA}tA zL)At5r1Cu^eAcm9)o<^5RX-@Ys^6jQs($U8RQ-0ZGWC1nN>#suTUGt`-|NGTKD=v* zY9GwEgh&byNukr(GgpEOA`uBLKq3-cfJDR=ghVX3aLHr|E-~uEf!81e$HMjtYNbszElLZ%6S#SXoNdy-l5e+WfqQM1`hz1w7Sa6}J!7~vF znu>}<+6qJ>Z3QBcwjv^twgQnzTY*TVtw1E&Rv;2-D-ema6^I0OK18BTrBWona|i>Y zWWRIl3`2CK5Qa2IafE)?*jcMAVSp|vN(7AK&I&S+=$D1WByxT5okC(GNIl;UcPB+f})65mm0$s$6mrRjzHST)2oR7cQd8g^P%C;UcPBca0L? z1{W#dB7gARf~T&Lp2VsZH|%Jwl{6)Mph1q!2QBIQaFBx`Tn|A2TXo^v-^DiiqpZk zN9PJtAMcjKTkt+`tkbJX;jPXqpU?~hs|n({5~$LFeAGq<@|W$>f&6>+W9&=D$z>d0 z#*8P)1eUdXbRd6YhYsXp%vc8UC5$s#LSF0k>PY^k4jsuy9d#uCh8;SRzhNIzi7gWb z1NkVM4&*P}r33l*>_?bdt|sI7;^y?02`np~)`9$u?TBg1hcb>Y7poU9YTaHP$luhV z1No4E4CIRpa^iq(*oOfH35)4KKCTvuHr%>Xwc(!q7+okH*>X^nK?PFet%X3umV!Vu zUrI;$RUqPGKp6ikQtRUmRT z9pyKHh`*$x{3;N+nhf$&AmaQ$AYyPrAo8Jv$0!iF7z82_J00aWfvDF5fr!TifrzR@ zAnJ}mAYztkfJ_BaP=ORoAca=<1dIgD)fF`2i5ik>^}B`uB!x>>(2$faiJM7^S3G@1 zLIC0j9V-Md6$uWqf=1j1#leylG@!XrtE3%>o_Con2JZrICT0jGnnY=aV8x6>S!d%9 zh^lGgL0klFK$5_Tbiu8Mr2UASGhLkM);-#QHg#wN!tIa-B>Fi)LSgIoVjxZQQyUOm zcWpqo?$ic!_dXC9o+mXc~SCjT5p`#WVAXvLc8_>oMZ9s5| zqydSs-?g}+Jt(edk7zfGD{io=w-#4@WKnMxS0Y^~u4s=0u|$fh-dbF7I#67RJ&AU+ zxZ*maxN8EEZRq4T>wxM%CMjtA3CacbzJpc(lh-Jn@8+u_y7Axy~HvcDlsOkz=3kHvIe;^IGO$ATUvh!|nG;_ymRVC0>OqYxrdMDh;2sZ<6o{ zsw1l$iV>~hleYC5J~^;i!zZYghEH}a*6>N&T@pUQ`FbIN2#(<;8a~;*Lc=HR_euB! zmSGDL_~c?5KH0rm!zb;VBz%I4$ts6(F&(;YyF-SqVa|_|=m{>SL)W_&>(F)ET{3iy zi^=+Iaxopc-hG=6UANySL)W;Ntj~t?U9CgcyH`u}qa*)so z_)U zOppWo4wZw%P9O(~oj?xaqd*Qwhf+C+kqJ47$q6|~=tSfo1L%;0n5U3~ctVf^OjnhI zjG#jfV%S0s;zL0WFnU!EGJ*~{z#@hm3bK5KtLbr=^r-1_=t(twE{+;@jhRT=9kPLt zU1IaABrQ)?H3o=`ilLe@2$YZ0biZWGMA8A1F%t+h8JbMQ{xmRh z4KzCuptU9?4MCT)Nrn>tu;pxUreq7np#P&6wPxozS}fD|C$3a|-@Qupy?vAF`=RZs z@9_NoFMDs+B-NE|Yi`kqPJnu)`d+CfrBvUgy65@_GLU5^hNP1x0Rcitz!n}tu|Z(q zR(8V7AL5=cE6n0@4dZeu%5e`5Z{e-#SL9p$iMoK-H^$mK!o$O(140ns4?83x-1k~@ z>^a@%9AmDv?C;}8?C?CzB#cK1fXN)2OKsVRPEcds0kyEjJ=3vGyW&*n&QSPYTF zVu&0TL*%d+B8QbBa##$J!(xcUJ{cmh4@2azmBbE}KC(oT50=Pbu>^<3k~mmG1Ws4-y1kNR)ziGPQ^}jp zD|;w;>sScX)$x~GcR0HGx3f6OjV7jNUqh3TpuN}7ycRL1M00X^fXs88S|P0*=m?^w zvCN}1nkwU$amzfUS?kqJL>^txTore_7gtyXl+LBIGMR>#CKB7{Gs>_7; zaMOhM@d**$XbVrN+lkRkco!Phc?QO<^Dx>A>Xf3`FyWo2+@kn8Tz*xx7?qlhh-HLR zdK%ztM9B6@{(}*r7N9b)5l+4^!X&iUJlP0kY8c_f%@U1`P%$KlCK%yL$r6o?P(CQG zI~d{7%yrucRVf(Z(J&%TjZh{it~(gv>dHot^LL6XstHsZWDBm;Hl+5UUgC;s4b>dk zvJ%xI*|HL)ifUKNmX#=#Bq`bQKk&rgZ=u!Ck{>B``N*6SS9%Gd%EG%>$MIGQjqI)I z5;C@gy{Nr*scNw$xl(9IsQhKzLM3jqQcZ2Rja@ijw+kOG+l6r(E0rU`gHKfL!TXE$ zV4Tz*Txi;Zf19ue?>KJ{#+&THL*()lA_L==Y^c&L*(mR)>d)8h!9SPn!5D4DW+XW9 ziK-p=hoT*rLfDE;p=rhD*n|}u*G&)+uA|^3RHvxO8npq4tL+)2m9;kt))*>BtTFI~ZjGTe>cs`MA!`h!gF$0Bx6K+ubHs}aswW@T z_5{T}))+`4tT8l(tua&vgT^qnt5ajB7pyUqV`~gBw$>P0r>!y6^41ti2U3jzRcP95 zm0L4gW!lU(e%$GY`G01sten{@)B0{b#Z&H<+y0|I&e!{hyqy(&yP$zg!oC4?7_O)eL@ELAD^B zEYSL0D_wqsv;_hj$C73xfsyipG*UNyd2KS8Zr8aWZMwcN<(I7PWlbHnqzb~s(NDBP zKykMO1R~?h4^{m&f`U-_HB}J4wSv$Z4GO|gP!JATL7+km3c_hC2(?pI5K2EvN|TxP z^X7>Byj^)-9Z$vY<{2WX+yNp=oIyl| zpAb_k!raEM3j)%hJxI2$a04evD|UmatDYgu?G5t4^M&)L<3axuFP`8rS9fvA&vsGyG#i7dQ*;b*6o|eSZ zwn)~wyz@i-K53tpDpt$er%OKtpFX?wLk{6!9oA{7S^Uw3{7>QW@<$Hkh-O&&#~ZSW zf_^C^F6IBf(A|WZQD|7rAbYZ!@%@<9jN|l0v3tQV{bGn2BpMbo_R~X^_Li~nf%>ah zfKQ6DGV4Pl*P|(ow9lg?NCX~5DZV9wFp5%gO9UQ8ge{{ud$&U1QIy*AY?X{iAV^11 zUW8=ghObZ6`-LrWFBV_9L)OTzOkG5~N z={$*6cE3e#I!_kHI~OUmwf~ze>9pn(Nop!GNk`RpgCYR>Rs?pQw<7QxJvwYXppG2` z0c^7%pne_%0d@DVX@Pou*u#KlOqHVA&VqpYf)E7A;3Wu1_@SoJXjTM<*a`qefYF{* zBEI9i6@lL-_!`t`76eGHAC?pTP_z@CsIp>Iqsa$Vi%?HVcC!;|uYzd zU{K_eQXNuIqVWgF*3VfTASbx`RQ{Xn^7r8&H&S1Byli6paQb zmfiqG(i@;Cmj)F5Q6ZCpqQM+92E|D^prkuP5HtcMHYn^%f2pUqp@r|-&_D}ovOVdu zg*Eeu8`?lY8!2S*sFtp5VU6NZ8!)J1?iG(=PkL6PsVSjJJmMfk!F0`7jxjSdW)1Q_^<*4R#y;FUp<;N*O-B{K}LSflDGt);Tk zDim5_{#gx{&OfWr(t0hOzpJ_3roL6%h55ViWB#rK4_K>V{^}89{-I?2TGV&D{Jc_N zrmvOjYA#EsFXo%+D|u%6?53_|DMYt-BG8TmnZ%-<3bbQ^$ZU0CWy?}TW^18&r^KQi z5IQ9m?U10I5=3Te=LA&%&U~#qb_j)&>rQ&_SeM5~r)@FEzprh_x&yqk^CUMp`iu?m zdL9fXN2gw)E)@aTY02fvulCjk1&@@uGhbSvEbg{KIdRn9+8nV$NxWI1Ed69}t>x{l z&C@!EO+IIDEgiDA)(iGlm1inV#&+0SE5F)X8_`)+M;^&R@7fxvMEtpQdiXrK0!)#r;4tzotA7WgH|XT!&WGXCQCM|V6Q|f zXAK6;r&Es=Fzoq&VVM#zBvS&0$|Ar}kpvi_X4>kNfq)^`2Mm{2r|(m>B`{ok9kS~K zMpl@mV950WLq!~5Sf&IFmw3Ca`T#~&{-t2JI6Pq02QcLOfT6ZI2D9n|7%DOWLmhT1 zIa4rPkPcd=1PoWJfRPoi27{Uw&xmtTYXM^Ae33MlSgA@KV*-DOR=- z(=WE$qbC0JGx7h&{C;!0o!fAAfqRx+1C{<5TZOWqhrOSY%cRVzq=xF2dejsMPfo&X zo_wTbo?OeMSt$N9i>6U}$X%@TXh}6nj}}<77sC%Mw`OYwawzlUg{FD(V=PBU=^0WN_%Y4#UiD{*v@E7N_%Xjt0JYt*v@55N_%Y4 z#U`c0*v@P`cKa^xMUZV|H=nMe<=VX0arIVb`-`8VqIJcFX{V@^Qe>XjTpl2E>HHP$qA+#9)ZS01Q`jR!a!1ovi)zOv>?AwR+ez?ZJ4w1@BKcnW0FolboQ!d}mp<*l zxMN-%5nWe>bPXqJsYht!b7c|yn6aIKedWkb7_@Z2 zg2Gn}(y>Nr)}6TEyVndvp0<|>OdNer8weM_6UR^Pw(BjWUJX(&wMhM%lKkJAV{4Fxjkb;TkFC9o}{;y2)D|aP%tDan|4ZfAvD$PAhnu|ch(XLuCQyC02{}>yP zb(*cj3A5EagV}EW!fYj3nC;H6UsERkTQm8Xto%2)mv%nr%rH>UD2JIg$S*&!|c%2d9x)L?d&!KP+Q7sG7n zVwFMbVkGC8*~-9_i76vf8(Fq{++ulqwXdnh>a_xSvupzAm|FM>vV}@xZlBTg*x&~-Ig>RBI>-F^f+DriavL(rVt=AdbgIB2RTAJ>^| z#XVBS@bN8U!+P123iTBr7`Pp z34i5}e#e{+C zn!`XvhYVD7V4$J{105Y0s7kCg>gd2ggsygZlY&F`xzqIY`WX9Wh&gk)zq%|%1&9)u zPqtc!`={SOll$AjaP(e?P$d**Ux*NR)~N+WG@0S{K{uIid#`Y+4u|WuPvq2ZpmhhZ zB2p%-AdtUWLD9*^9I&XMa%&f~Lz#!7yFP zSmyS_bVc-<+xK*p9x`3!rkXD4oTjT(lIbc(5w)LASBapxeNUI1)YEk{nvR?e)75Au z_rr9Ra57zWwJ}|dW^O-BH}-U6Pd64%uMLZ}0amsMK?k>Ft6#DMlora<>+D!nXv#m$ z)3YZda(&d6zj$pJ^$lP3Q?5Y?FzFiIlGzNgS;d6dG0vcuZCb_KsO8 z_-%sCOr>{OD8Nh|=Zv9t`x8~4<~-7p*Gov!0bz`0x6jw@_KYUCzw(dsmvlfFquK9= z>h^m^v)}JHZ@>R-!lyYGns$3~U%UMeMZ5ips!wwsY02v~nhpppsnyl2cwU zP!fZ}K}veWfD#)N>s>lgH-Ms&#=1rT#lEW}bpt5!T?-ol6m0|mC{ot|MWqd(xYE&i z&H)saL4cx2k#3fPqR{|FqdB+&C=e3{MWZ>o42o+pKv9{Z^|FJ_m$~?jr~_w z$a>D%U%!}U@b6vB%oy)xOGX=L5S)N*ns0G~57!O5&n;|mg9x#3?<;JD#y-q+teG$` z9kjf|QH{tuWE(mQh6Ljq6Xum8mUrp}okOb3&V+e!mk9HA<$i6J-5AzUFiK*~mlyY% zFRz~RDWuJj$2cKqa$Ifqz_{k78CR+d!Z zB5qm(dxL5QR`$feBvX_nKL3+}S!_*4;B-8bRCFTHY?6vLhgO=ONh*9=u*LpGcBJ5O zq+4rw1<7JJqqCOx4NSld+T3pPe$y7X&^gU+1B^0rg$r`Y@!YDHYkud!rO++)e4deQ=)_H)-(=I6FqGASLjWKtWFWWs1V z4M-kp$z=S9B@^u$k4k`tz7zJ8-zCkYUHLHEZ{9ntZ;@nD+>2x)KsXd=5|FSF$u4`Q z_9Y2`sC$elS~bxgCIJw6ruH{U0g-2F_mcpKJX1TPq=3jX0Ysh&AgYN4h<9BF5LL_o zBE=9uq!U*mLVg3yNM*8IHgT(T3j_%m@0-*4c`C>@?Mrb{g%Kg45t<*4ea^3I$

TQS?kl z+2HA>`oxZ1MMo+gHMq~3R8^v;1h0)cnvcYmo zN9v7VVxL%wqbPc&qX|TqfNEWcT{QtNKv!Q@O(60F7$IT;+&#*^te${M$O>LH0o0c{ z0qq`D5~m4p(YlVc(*!h@k~mKQ51y6Y{?v;Ly8BZvR*JbnJ~?syvY5)g?q8O z@OeBgWUkQkMtX&u_4dyIzu7V!+O!W?_uKiI@_swnh~{^jz5OVlT`CL}C`}R4C=Z8a zpuEn*7LPBeP5_CNUsb!ZjB-nsF@8ywfyb--YNjK@IK3ppV5Jj=foNZbQHf<3Cl*yE zfH8f9mI2MlGRke{S9q4H6Tq01Usb!xugWdvSFmJu5T-FHznbYNzdGGyegzNV-ep>j z@~cYB{0f%CvleMNU&n?Kj;8!-x~;<&3k&QVOVd?;RqZmrD!2L+57>FU#F6pL$GKn>tSWl*lEVe7ij`Yn<3Q?uUbz;QqLb-EhOpWl001Ffz<~n!|xLbG?*A~ zBmrD&_Gyr+Ool%WqKR#jxvuQ}_~v>xTy;c`iq$;o{4nKavM| zy(yC4a(T1vhh-Cp0xL1T5SI$~t}&9DYU(V8v5Ra&#IQ(_R3%mzMf!**70n zY#GSl9c%>T`S43nfsE#(N00gFv12}b=89xAA4MgKWHcW>Wq#L&`RMWLyH@kzX#B1X z^U+L zL#wIO{ePU&fA@~3QuqF&@bf+2#h%XJ4L_%F%8Z~N!Z1HTe}-u2(6QV;(S zKi`A@AN&`8^upMW4)HhWo{!^zP*=kLpXSd`PT=2E3Z*8!&bOnzt$qfiKGXMertfDo zGhcttr}}=zx~%oru?=$k+Ec)HO?F3fU9%H>&9RoyZ+2}^k=j^Joi7_YusntZ#-ZeHI5l4jc1K>#=7yU z@tX0v@kYS^ZOFLCxYxMPxZildIBFa-P8!b|=ZtmZRpT||b>oeI|ND?}k8y9n|05gl z|FVAnZ@>Oe_J`O1={{p}eZbeF#xdih@vL#qST|lZUNc@d-U#^r4jK0t_Zs&Z_Ztrw zM~!2~N#j}LoUv}aYP@E=ZoCoj{~I#yG43_)GwwIq&U%?}{r0GF%s6R08}R0kaCa)a zZ}&a*aDC5J<2B=Ti-O?*8y{c>TjG##Li4 z;78KNj4^8*HjWr`#=J2ymW;E;d1Gu`Hm(>~jlF;$O&c@DY`~B03HWi#nHdS!nVd0i zjEp7Yta08L8<&kM##Li4;3v|?j4>PVlTpA=j~H{tyfOKG$=9>Sd1Gu`Hm(>~jlF=M zNgFf9tZ~>lV$2!y#>jXz;OF)R{N-8WyfHQ|8&{00#$LeBr;Qn7);Me&G3JbUV`MBD zXN~g#zu>?7QXH;?Qr+L$qBjl%)I83p{7|L!qg zKUNB_KQ?QeH^#v#A#F#VYjghfroHfoHrbtO>!((Yy@3Bh+L$qB zjl;$fW6qcl_&4m2`~5lgYkvLLqVW4)D;Z~v^Tyb?Y+Ny}8hZi%X4;rBW{tzf5o6An zH%7*ian?9*jE&3272~S07w}(78#Bg{fWPj)|J%86{kQYR$XGJY8t08y1OA3T|G)3o zzwi5fe>wdA`zyv(V=v&pk~U_HS>v#A#F#VYjghfroHfoHW8<=M#kgwh1^mslF=Nac zhm9k~oH1{Vj3wi2z<<@hKd>CG|89aSzFsx<0zPg0?R2>Q?Tj&N95#*^bH=b_^&58 z?CTL@F5qZ_d0$7yl5y5JZ;Xx0#uekLu@~@1X=BEiH4Ym`j5%Z87#T~(S>wDhHZB`i zjH||8z~|D&j4^8*HjWr`#=J2ymID6$1ZRCcZ;S)Jkl?bfSB$I1UciHCW5$>@4jV^| zIb+@!8B4}ljtHxfy7t_X!F>4$)ju>;syfHGCjI+jhV{BYDt{7JXjwRR& z*N4-_Ou!=vW_>+u95LpMd1GWO8E1|2#@M)QTrsX1djXH8jTvLsIBXm-=8Sn`WGoqH zjq}FXxNKZ8t{Qs*kEM+nW7arq90^!RFz4&MF$(xbf+b(i8t09%aoM$k+Ec)HO>b- zonY+iW#dY~GYPKxx)-pVHfD@j$k+Ec)HO?Djj2FCF87d-WVH~jVs1gV=v%L+L$qBjl;$fW6qcl z`0phc`MPAB4fr1$k+Ec)HO?Dj<8r|NFu@gHuNr#+=ZzQA;rc?xm^BU?M~pdR z-WVB6##!UMF*Yt6SB$I1Ucf&}8#BhNao9Lw%o+2>$XGJY8t09%aoM$XE*4NpRNJ^Ts&ff0E#`uUCw##$LexG;Pcn zv&LcLh%sl(8zW=MIBT3Y#>QpiigDH03;3U+50Th%sl(8zW=MIBT3Y#>QpiigDH03;18AjTvLsIBXm- z=8Sn`WGoqHjq}FXxNKZ8t{Qs*|EshyW6TjCo^Z zEE#8w^8r^9jD5XqTnYH!C%EeCUcmn$ZOj<6#$n@#F=xyhBV)-pYn(U6#%1G*an;xh z_&=tN8DrKsY#cG>jCo^ZEE#8w^Tyb?Y+Ny}8hZi%r*y#oIl+vtv&P|o|2V-BU+0W@ zV`MBDXN~j5*tl$5F|HbW0aw$;j4^8*HjWr`#=J2ymW;E;d1Gu`Hm(>~jlF<>mNsUL zS>v#A#F#VY1OA^0M!qf?X9NC|1m}Gn8<&kM##Li4;Qy00W{g?muyMqgGvlV$2!y#>iMQ&Kl>9v2oeBVq7)$0^XB0W{g?muyMqgGvjtHxfyhttN4F>4$) zju>;syfHGCjI+jhV{BYDt{7L1y@2VoF=Nachm9k~oH1{VjHQ6@PjJ@P^Ts&fo&=YD zy<%K7_5yw=ZOj<6#$n@#F=xyhBV)-pYn(U6#%1G*an;xh_~EoMW6Tj2F zCF87d-WVH~jVs30fWMevFI;~-ZOjDxWP({=4;x2}Ib+@!8B4}ljtHxfy zPo<3+W7arq95LpMd1GWO8E1|2#@M)QTrsX1djUV4HfD@jU zlCNit^Tyb?Y+Ny}8hZi1ls0CJS>v#A#F#VYjghfroHfoHW8<=M#kgwh1^jZ_m@#IJ z!^RO~&X_kw#*%T?I3Mt<3C6x&Hm(Hx#z??#t{Qs*_oa;)W7arq^xy5v`8scmj3wi& zao!jkmyIjNRbwyUx6;OpF>4$)ju>;syfHGCjI+jhV{BYDt{7L1y?~F^13sQMW{g?m zuyG{dcm2L6^5Ob>2}Zsy8E1|2#@M)QTrsX1djX$J8#BhNao9Lw%o+2>$XGJY8t09% zaoM;)p*T#-FPG5fg$4_<6h%F<9_1-yG9Ise@c>f!naSB=+;fIrL!{Cjc0XZ`xKH^TM5F=X6h+-uxt+;2Q! z95s#^Cyi%~bH=*ys_~lfy75N9QD6V~K)C)l_Zjyalh;RmJ!YIVo;A)H>&C0bYsTxw z8v%c3$hgP2*SIg>?^ylT8=yl%V^@P#4c9^+o) zKI4Al0pqA~%s3hFMgRRFUmv;}UO#lrc-?p-;LAfs|J}=beZ9}P-*~_{Y8*3820ZNV zg;%V%SN!@bXT$GbnKRanSB=+<*Nryr4$87GZrjdRAj@v8Bf z@w)Lwz#~HekL?Ti+FoOFz2DadjHAXejFZN*#yMl%c-45#c-?p-;2T56J;uGpea8L91IAI~m~k@TPT-Kxdb?V& z-Y+LBA#L(DLuLYpgiqSU;R^|0h^YPlZ`Zj~edcyo-ob8);G$KS>A4{`is z9KVm_4{`i4jz7oo&vE=Uj(>^cU*q_<*7(npaXb>ob8);G$KS>A4{`is9KVm_4{`i4 zjz7oo&vE>>Y8)@eaV?GyK+~-^B54Yy9`cIIhO=avay<_%M!-;`lg@PvZD2j?d%x zB91TP_&Sci#qmuX-?qm8Sd8Op952UlEshW4_$ZE#fC0jj*}AmPz&+@syNF9!8WwE3Saw@T(V z$(U`qSpa5>Jy=^C1z@(=#E%;VTtfTlR&(@X1zQk!Y(e0$<+i_rjgfnJoNQTO=e5ka zJ^c>ycl#c;+hFlN;txHAJbDXx>@MuFWeL7>^ZskMi0|E!N1H`__YQlsBE|Rbh(~Ku zdmQg9@`;!bS0ZC zyv?bBoqF>Ad)mrkvIw2LjJ>o|FE73Fd-Tk*{jlD0L+#|f^eRl_J3ou>{Cs(xy@BsL zueI0QA%7KdjxBG>YwqXnn7@ec`+0oddF?&pKJlj!=bs?XR}tsf8>+kxAH#L{sQbbn z!FBip#Q7n_`Let2mk{UJ5(lyVEn@vUkG-K_g*C+bea8CCrnh-0dtgfz_Gi>v5pm;* z?OPGSFC}HbFW46NG`3_p8{n5+?Adi6?Q`IlP|R+$@ku8?9mX|cr}6S7*sU&J4)n1T z#+&XC3-#Ml^%e{4!pkkD_5N+fM~Wv8IzKL>BQx$#wipq8C@V%RcKcUE`B-)3W`|4A zC+?xr1e;vROJWY-{5Dx=V-|<%NwB>+uRYq94~dI-gsB@ z%h$NK>&m-R>)z(Ib$`&ay>`Gv$FZHt33QU}g^x88ajUBv*s_p28Pvwt)Osk;xl;7I zDQGCY^0AJuPjNPq`>CON&*+mW^rr5WQ?*anyI$^D4jg|TG`^g9rMNETNotPR(xs#3 zsJZS`nFDBPZM=G8E14=6kmHoXX5uyLmNsdlwUo(8Yus>$8}HORxaIF`x#e#o zeoR=CugmhLe!kW!bL@5-x_p~fx#;}9c@L%U<@n_`?t|`N%VqA=RPym6>^HfUZ`Ay< zi0^{v!CK$z#xJzb1%DiQkCqkJb#ku^9E^ z3pjIM#CPm zP9min@pC&|?*7BPwAN=6E}VW460fclKJ!R;a;0d@gPITb`tgUTqmi6?Q--?Y4_7&L zt(k3Og1HSpvd2Od4>uO#218Bxg*%W+&Qt4q+xU2HBNW(SEqGQqwQBTo45MxSFdGztpVz5^-bg-Btn4kwPlH` z19ePAvD)w4XjSyyrhe!C@}l>O-}gO#?l<0Cd7yZ*==ERPxUQHA>V1SuZ(v;Xw(HLqb_mCi<9<>4&l4^q=e_}Uc<@r`(LNrEl)OmJ=Y1VkU3^cf zJoysxnB(h>dFH6Ugtd~;DDgeeI-us{I-cq2vrcYcouJJv<-kUEYsgVY1AH2FXRQWm zey-!FuX>5MN$AcC8)dwWL#yH1aO%!Ee%A4}id-kx>h0_Ig8j#FU7Wxw5Y~|9I9A(# z6`9IY$W#uTPY2DPv!d&1{Zexx*DrG|x9FE#$K8n&xqeylvE)Rqh!CBM+{5+DT%3*g49e;X&GOpg-B>>7amkr)XL)#GJh|KFGgq5qv}>qK>4`NK*8RSJ zKipU5_~jb%06p=`!aC|oH*5K24z*hBH9%ci>wlg2MQryOYPBS9u6bGe;u~le>@`4L zx$Pce9P8C=Zk2A@*lsnvHivT``xH=b*1BUSUSsy0@%9-i%OrcQd0EHXHvv9H-idm1 z+x^)%^yX!kjkmr&Cu4^_=h409&G}S!tKkr)#^Wdafoo&FQIKa|9=x zE_yEe47HTHV(J&HMYTCyLywxR`KGBJhO4HgO;QeOnzrQ_t5a=E7|Wi7!5_ z`h^bY)nz}W^mErK&NZKV@u~6RfO%2#WA1Uqd@CEi`h29;^E9*WhF91( zRB8hB^|+ezG%elH1y-SE&Z5%(Ix-Qcv}Edh<==l zH}XRhoaocZ0K3JUIyKq_5RhoJIZkCC*>0TLm_KuTx$+JiR_Om@{oOB$&oo!E zKRN3k>vTxXXIx{<_1tD1AqrwoR$dMMz3wn&3Np^0{~0^zb1+N}IBs^GnK) znwvZLWzO`*9IuVq-&0*m^9uXJOWwBPyd~$~+iMaHM)S&d(8?wMSn=jH5HOd{89^D5T|QUC1OUOn;?`|yiqtaU!kPv>#n z;+iVvxV6rgi!t~y6pLGW@lN7vU%Y-7cHPFC8J^^hHj-h@5hGVObHxlZtm&0n>g2d` zX4ro0^B;KsJi&TH+24o^J4`?J`471NV}3fvt=uz6^3$4IS(_<+@_C;$Og~Ne za@cs#<~w{0zt4R(lw8;^o=sR}M}5fc^?S>6`^~V87Yb_|o`m zpYz;))3}W<_fYTJZ+v9)*&PoL1p^G3CTcbvA`UjbZ0~`T$&VY07>^$C7%;vxzLcDD z-}A|%#;}H@ooQoYJ6#YX?!_IUK_S!8($h<8ebY;_Mb(J??%t2#+SyI#+Sp!c!Qj;@ul&l z@ul(Q=&_LTZU230d}(}Xd^t#78@6K`Um9N;Um9QbpGA!CM$e|km&TXIm&3+*gPgDN zrSYZlrSawHv5@g?|9xtFX?$sXIY?d`wqqM#8ebY;8ejIGMU3x8&!)zg#+SyI!^U`n zoUiev@ul&l@#W~TknwH*eQJDZd}(|+NM0MZV;f%@Um9N;U-q9xjPFLzrpA}Xm&TXF z#(0CAukoevrSYZl<>;}H@ooQoYJ52`zC7(d@%%aKR{dx0q(ARY_>1nC|J;4#zi>zV zW%q%<>JIs9ZpB}BOa6vi@VDHY|HjSw@7%P%<0k!GH{tKOF<(q?xKI1Yi3e=t0R0J{a)Ex>L8b_=jufZYP@ z7GSpkyVd#=b}Ri^Y_TSpE7)Tv?0GQlu~hhg@9UVm>nGf8KjpslGx)yFx|@F9eeDuesoh@nD}SYk_^_t3Hw_BV9-P zb)54h+P@5lK%DbG4~W2k2n>ioob%5FL?Bpz*YH(b!#@s)z<>zEHT-Bm1O`N4Km_6% zz8nyN0TCDwfw+dx1Vms!1mYS#9uR?n5s2$S`_J^cE7BkRclEdz23$kLmkhYH?%u=m zv;2bjwD<+{DJEQFe)$MzhNk=?pZhDE89K3YWv5B_#O77rTQsm&W1fN^8}pR#G3M2g zkE{5i9~all_?p1=wpTt*<7*$hzO*am-!rGCb~WA{G2UDW9#P%?|A2p)eg&>v!+l^c zTuH*Zg!{mhu+HK>PzdXkKhs87A3<|S32OzKLrPe)&>V!YCZIXA2!Re<0OrQA|y$8)%277bZ+yEZY(-uuknR>h0>49E!|jianbzW zYd@cH=RW7oxd)LK@8G^jbjVxC8{EM8MRdrk$Qw|H6kfcD`)*O>$cv|O{{IxUETn*w z$WfiZ`GtxcdGQGH2BOH3fr^81#K>@WaJMF!>MdjyZs6N4n(Ea6t3p#1hP#NnU{RUK zaHnxKp~^%$IEgIL34GhBGLhkqAgdrM6B$kuKRuW#$vF?E#7_^3rdsF0B`7DNscPaM zgTjO>#LNSmQ7<-9l+OrBRrg$kq?FGH5goEFLYAPDhz_YKe+)Vtt_SeiZh5fZe3_e% z=AgqkPf32WDF=Ot^Hd`anq7Bx{C0kU{i{4_Q+|Q{tGu_?^)w%s`~v$Ivn}12{4#~> z*EBL2%zNkjavaw$$$RVj7tO~yF22S$TWT!Gdp3tTWYtPLR164TRJnA`xH?AQiz=6% zV_Y30@I_S{!5A^#e9yeOAbKPD@jHC~m?;!~WHy(1Y|_VNoR?F6Jdf`mGrGc$#r}M! zgyX(LL^E3`9LG!{bK|^9U&dK4<+$^RXl4tAlZWMQS9^TXkMmpla4x<+#PyeTpS&;1#n%PsH$(j1J^Kna zDQh};ucA3r`wBKOzHC~@x_lq`3*jE}A!{5{J}mn440xP5Q|fKxG}bSsoQ7+rnnyQI zWz`|`;?z0GsjNB_PG!|$s&lgHP*gJV7c-qHSFq|(_={DCk-x@~6}LGhoZ8h+%Ddet zob`Ilh*M1^g|l8yD4g|rshY}qJ<-a@U(B#Jidu7i?z!`#X`V(P)!c%x4jH@C$bR~d*V+$r7$@Vad_WGy<^9#JpV z_Y}gZIKLe1bu%+haV}wPqv(yAC%Jk=^hQ}dl5!j~oy=Fu>JiCT%jyy4tA*oO+bBAk ztRA7#BCAIVn@y=PcCZc35UgSB#N=FMA=;^|vPh|o*-hraWtD~Gz-5&MbKpX4tYH+@ zOjcP?t&&w1Ix4!+J=YXkRI3x!#;wV~(?KBFDh>=F9U6x;#kyGPZZfeFkUe9Mm7kzbSJvC&t%t{LpJnKIbdI{9 ztd$XcQYz=t)yT}t3Qw~3QFKA6oD-gu$~oal);<=ab(F|;%!G>8DphOg>RDz(h3ilzF9OAY7KFRV-L)h{XM(=V(`P5qK`J}VlTFRx=+R5VUwZH3J# zuBOl0sfPR+A*_DwH9}JIXN0i&HI0yz{8`t?e0d%DqplIY1Cy`3YyW@XzvTF6;C~-- zzRcN=IZLh2Xue^enqC=F^9_3G-gUcp?7*_NKnK1ZS_H;o_mIbzKx_2e8Mr}1-uk6kh!dnCc;xa!|-91rY~BzmvD zU()=V#>2kj%SEo2>9uc9-KyDQf4l=c+H23Bx-KZ_S)%OFjh*Z4um_!dCb53O=GA-W zqn5o?By=PCx=7fAemIy{H!@fKo0f{beRix1kX7<2XR1Cvm`RRz_Wj>SoHw=o$%O2a zDcWTl`z)`!KK#Ax*(iEnoBo3LFUDH=O3gFu+sHL6%va`kSn~{fgo z-qag-m@pau-B*Pu=>76`=#%Ex-9EyM3a;{#bRfF!6(+eWLOtjOv!qb z^f;aRPs+NTz3mfJj6q|wdG*{YDB7#W!=1W!$_k~u?H0s&rF7q?-azwVxZXAC6WOQ! zKCpo1myvsX!1y!gKh1LN_s-f;=5Bjtl7&sT58tPaXV~+c^`)%$OZA_wJcG|wOt$iu z^5&Y;G!68`!PlH1=c{y;1YC<}~(X z=Nca7%QdHIe%A5E9{a2>?HX_N>C%?|tmBRSxa59~@wSK0?PwqNtY_^g?=NT{oL{=v zi_TETll3`i{~yVL%lhpm{eL6}F6&~_{y%jqR|}g(wMGcGh(xD*2T6`y)|@x#9V9t+ zS?!Yc4$_@rSU1_t``zvWa=nAPbqkHXgJz3^eROC9ojOEydFJwYYM+LWod=AN~r)MG1cZEoEifa8_*f7G2c&%mDLdKu| zkJB@QrCMUkr`$J)YoF-H6Xm`U+%tl`KiKz!`$TY$h|+Fj4?6If?$4r{dm<`@n3{1>mJ^j{?bCYkJoBAJD{x|-Q&W--Vv{&W-&;>v#9B82>l^{(FpnAAi4y@d|(ce}onTI{*Lx diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/man/find_astar.Rd b/wpgsd.Rcheck/00_pkg_src/wpgsd/man/find_astar.Rd deleted file mode 100644 index 0a922b5..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/man/find_astar.Rd +++ /dev/null @@ -1,78 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/find_astar.R -\name{find_astar} -\alias{find_astar} -\title{Utility function for root-finding to compute crossing probabilities -with the overall alpha spending approach} -\usage{ -find_astar( - a, - alpha_prev = NULL, - astar, - w, - sig, - maxpts = 50000, - abseps = 1e-05, - ... -) -} -\arguments{ -\item{a}{Cumulative overall alpha spending up to current analysis.} - -\item{alpha_prev}{alpha boundary at previous interim analyses using -the WPGSD approach.} - -\item{astar}{Total nominal alpha level at current analysis from -the WPGSD approach.} - -\item{w}{Vector of alpha weights at current analysis.} - -\item{sig}{Correlation matrix of previous and current analyses test statistics.} - -\item{maxpts}{GenzBretz function maximum number of function values as integer.} - -\item{abseps}{GenzBretz function absolute error tolerance.} - -\item{...}{Additional arguments.} -} -\value{ -Difference. Should be 0 with \code{a} and \code{astar} identified. -} -\description{ -Utility function for root-finding to compute crossing probabilities -with the overall alpha spending approach -} -\examples{ -# Input event count of intersection of paired hypotheses - Table 2 -my_event <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160, - 3, 3, 1, 165, - 1, 2, 1, 85, - 1, 3, 1, 85, - 2, 3, 1, 85, - 1, 1, 2, 305, - 2, 2, 2, 320, - 3, 3, 2, 335, - 1, 2, 2, 170, - 1, 3, 2, 170, - 2, 3, 2, 170 -) - -# Generate correlation from events -my_corr <- generate_corr(my_event) - -# Find the inflation factor for H1, H2 at analysis 1 -find_astar( - a = 0.0008708433, - alpha_prev = NULL, - aprime = c(0.0004588644, 0.0004119789), - astar = 1, - w = c(0.5, 0.5), - sig = my_corr[ - colnames(my_corr) \%in\% c("H1_A1", "H2_A1"), - colnames(my_corr) \%in\% c("H1_A1", "H2_A1") - ] -) -} diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/man/find_xi.Rd b/wpgsd.Rcheck/00_pkg_src/wpgsd/man/find_xi.Rd deleted file mode 100644 index 0e33534..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/man/find_xi.Rd +++ /dev/null @@ -1,75 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/find_xi.R -\name{find_xi} -\alias{find_xi} -\title{Utility function for root-finding to compute inflation factor xi -with the separate alpha spending approach} -\usage{ -find_xi( - a, - alpha_prev = NULL, - aprime, - xi, - sig, - maxpts = 50000, - abseps = 1e-05, - ... -) -} -\arguments{ -\item{a}{Sum of cumulative alpha spending from the Bonferroni approach.} - -\item{alpha_prev}{alpha boundary at previous interim analyses using the MTP approach.} - -\item{aprime}{Nominal alpha boundary from the Bonferroni approach.} - -\item{xi}{Inflation factor.} - -\item{sig}{Correlation matrix of previous and current analyses test statistics.} - -\item{maxpts}{GenzBretz function maximum number of function values as integer.} - -\item{abseps}{GenzBretz function absolute error tolerance.} - -\item{...}{Additional arguments.} -} -\value{ -Difference. Should be 0 with \code{xi} identified. -} -\description{ -Utility function for root-finding to compute inflation factor xi -with the separate alpha spending approach -} -\examples{ -# Input event count of intersection of paired hypotheses - Table 2 -my_event <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160, - 3, 3, 1, 165, - 1, 2, 1, 85, - 1, 3, 1, 85, - 2, 3, 1, 85, - 1, 1, 2, 305, - 2, 2, 2, 320, - 3, 3, 2, 335, - 1, 2, 2, 170, - 1, 3, 2, 170, - 2, 3, 2, 170 -) - -# Generate correlation from events -my_corr <- generate_corr(my_event) - -# Find the inflation factor for H1, H2 at analysis 1 -find_xi( - a = 0.0008708433, - alpha_prev = NULL, - aprime = c(0.0004588644, 0.0004119789), - xi = 1, - sig = my_corr[ - colnames(my_corr) \%in\% c("H1_A1", "H2_A1"), - colnames(my_corr) \%in\% c("H1_A1", "H2_A1") - ] -) -} diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/man/generate_bounds.Rd b/wpgsd.Rcheck/00_pkg_src/wpgsd/man/generate_bounds.Rd deleted file mode 100644 index 53c1660..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/man/generate_bounds.Rd +++ /dev/null @@ -1,135 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/generate_bounds.R -\name{generate_bounds} -\alias{generate_bounds} -\title{Compute p-value boundaries of the parametric MTP method with overall -alpha spending for all hypotheses} -\usage{ -generate_bounds( - type = 1, - k = 2, - w = w, - m = m, - corr = corr, - alpha = 0.025, - cum_alpha = NULL, - maxpts = 50000, - abseps = 1e-05, - tol = 1e-10, - sf = gsDesign::sfHSD, - sfparm = -4, - t = c(0.5, 1), - ... -) -} -\arguments{ -\item{type}{Boundary type. -\itemize{ -\item \code{0} = Bonferroni. Separate alpha spending for each hypotheses. -\item \code{1} = Fixed alpha spending for all hypotheses. Method 3a in the manuscript. -\item \code{2} = Overall alpha spending for all hypotheses. Method 3b in the manuscript. -\item \code{3} = Separate alpha spending for each hypotheses. Method 3c in the manuscript. -}} - -\item{k}{Number of analyses up to the current analysis.} - -\item{w}{Initial weights.} - -\item{m}{Transition matrix.} - -\item{corr}{Correlation matrix of all test statistics up to the -current analysis. dim = k * length(w).} - -\item{alpha}{Overall alpha.} - -\item{cum_alpha}{Cumulative alpha spent at each analysis. -Only required for \code{type = 1}.} - -\item{maxpts}{GenzBretz function maximum number of function values -as integer.} - -\item{abseps}{GenzBretz function absolute error tolerance.} - -\item{tol}{Find root tolerance.} - -\item{sf}{A list of alpha spending functions to spend alpha for -each hypotheses. -\itemize{ -\item If \code{type = 0} or \code{3} then length equals to number of hypotheses. -\item If \code{type = 1} then \code{sf} is not needed. -\item If \code{type = 2} then only the first component is used. -}} - -\item{sfparm}{A list of parameters to be supplied to sfs. -\itemize{ -\item If \code{type = 0} or \code{3} then length equals to number of hypotheses. -\item If \code{type = 1} then \code{sfparm} is not needed. -\item If \code{type = 2} then only the first component is used. -}} - -\item{t}{A list of information fraction used for alpha spending, -may be different from the actual information fraction. -Each component corresponds to a hypothesis. -\itemize{ -\item If \code{type = 0} or \code{3} then length equals to number of hypotheses. -\item If \code{type = 1} then \code{t} is not needed. -\item If \code{type = 2} then only the first component is used. -}} - -\item{...}{Additional arguments.} -} -\value{ -A tibble with \code{k * (2^(n_hypotheses - 1))} rows of -p-value boundaries. Inflation factor is also provided if \code{type = 3}. -} -\description{ -Compute p-value boundaries of the parametric MTP method with overall -alpha spending for all hypotheses -} -\examples{ -# Build the transition matrix -m <- matrix(c( - 0, 0.5, 0.5, - 0.5, 0, 0.5, - 0.5, 0.5, 0 -), nrow = 3, byrow = TRUE) - -# Initialize weights -w <- c(1 / 3, 1 / 3, 1 / 3) - -# Input information fraction -IF_IA <- c(155 / 305, 160 / 320, 165 / 335) - -# Input event count of intersection of paired hypotheses - Table 2 -event <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160, - 3, 3, 1, 165, - 1, 2, 1, 85, - 1, 3, 1, 85, - 2, 3, 1, 85, - 1, 1, 2, 305, - 2, 2, 2, 320, - 3, 3, 2, 335, - 1, 2, 2, 170, - 1, 3, 2, 170, - 2, 3, 2, 170 -) - -# Generate correlation from events -gs_corr <- generate_corr(event) - -# Generate bounds -generate_bounds( - type = 3, - k = 2, - w = w, - m = m, - corr = gs_corr, - alpha = 0.025, - sf = list(gsDesign::sfLDOF, gsDesign::sfLDOF, gsDesign::sfLDOF), - sfparm = list(0, 0, 0), - t = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[3], 1)) -) -} diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/man/generate_corr.Rd b/wpgsd.Rcheck/00_pkg_src/wpgsd/man/generate_corr.Rd deleted file mode 100644 index 4a139c9..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/man/generate_corr.Rd +++ /dev/null @@ -1,50 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/generate_corr.R -\name{generate_corr} -\alias{generate_corr} -\title{Generate correlation matrix based on event counts} -\usage{ -generate_corr(event) -} -\arguments{ -\item{event}{Event count of each hypothesis at each analysis, including -event count of the intersection of hypotheses. -It contains 4 columns: \code{H1}, \code{H2}, \code{Analysis}, \code{Event}. -\code{H1} needs to be listed as 1, 2, 3, etc. as numbers.} -} -\value{ -A correlation matrix. -} -\description{ -Generate correlation matrix based on event counts -} -\examples{ -# Build the transition matrix -m <- matrix(c( - 0, 0.5, 0.5, - 0.5, 0, 0.5, - 0.5, 0.5, 0 -), nrow = 3, byrow = TRUE) -# initialize weights -w <- c(1 / 3, 1 / 3, 1 / 3) - -# Input event count of intersection of paired hypotheses - Table 2 -event <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160, - 3, 3, 1, 165, - 1, 2, 1, 85, - 1, 3, 1, 85, - 2, 3, 1, 85, - 1, 1, 2, 305, - 2, 2, 2, 320, - 3, 3, 2, 335, - 1, 2, 2, 170, - 1, 3, 2, 170, - 2, 3, 2, 170 -) - -# Generate correlation from events -gs_corr <- generate_corr(event) -} diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/man/generate_event_table.Rd b/wpgsd.Rcheck/00_pkg_src/wpgsd/man/generate_event_table.Rd deleted file mode 100644 index 3b355c4..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/man/generate_event_table.Rd +++ /dev/null @@ -1,58 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/generate_event_table.R -\name{generate_event_table} -\alias{generate_event_table} -\title{Generate table of event counts from ADSL and ADTTE datasets} -\usage{ -generate_event_table(paths, h_select, adsl_name, adtte_name, key_var, cnsr_var) -} -\arguments{ -\item{paths}{A vector of paths for analysis datasets. -Length should be equal to the number of analyses completed.} - -\item{h_select}{Selection criterion for each hypothesis. -Should be a tibble containing 2 columns: \code{Hypothesis} and \code{Crit}.} - -\item{adsl_name}{SAS dataset name for subject-level analysis data. -Usually it is \code{"adsl"}.} - -\item{adtte_name}{SAS dataset name for time-to-event analysis data. -Usually it is \code{"adtte"}.} - -\item{key_var}{Key variable to join the \code{adsl} and \code{adtte} datasets. -For example, \code{"USUBJID"} or \code{"SUBJID"}.} - -\item{cnsr_var}{Variable to indicate censoring (\code{1} = censor; \code{0} = event). -For example, \code{"CNSR"}.} -} -\value{ -A list with two components: -\itemize{ -\item \code{event}: an event count table as input for \code{\link[=generate_bounds]{generate_bounds()}}. -\item \code{dsets}: analysis datasets of each hypothesis. -} -} -\description{ -Generate table of event counts from ADSL and ADTTE datasets -} -\examples{ -library(dplyr) - -paths <- system.file("extdata/", package = "wpgsd") - -# Selection criteria for each hypothesis -h_select <- tibble::tribble( - ~Hypothesis, ~Crit, - 1, "PARAMCD == 'OS' & TRT01P \%in\% c('Xanomeline High Dose', 'Placebo')", - 2, "PARAMCD == 'OS' & TRT01P \%in\% c('Xanomeline Low Dose', 'Placebo')" -) - -event <- generate_event_table(paths, h_select, - adsl_name = "adsl", adtte_name = "adtte", - key_var = "USUBJID", cnsr_var = "CNSR" -)$event - -event \%>\% - gt::gt() \%>\% - gt::tab_header(title = "Event Count - Computed from SAS Datasets Example") -} diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/man/tidyeval.Rd b/wpgsd.Rcheck/00_pkg_src/wpgsd/man/tidyeval.Rd deleted file mode 100644 index f773abf..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/man/tidyeval.Rd +++ /dev/null @@ -1,98 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils-tidy-eval.R -\name{tidyeval} -\alias{tidyeval} -\alias{enquo} -\alias{enquos} -\alias{.data} -\alias{:=} -\alias{as_name} -\alias{as_label} -\title{Tidy eval helpers} -\description{ -This page lists the tidy eval tools reexported in this package from -rlang. To learn about using tidy eval in scripts and packages at a -high level, see the \href{https://dplyr.tidyverse.org/articles/programming.html}{dplyr programming vignette} -and the \href{https://ggplot2.tidyverse.org/articles/ggplot2-in-packages.html}{ggplot2 in packages vignette}. -The \href{https://adv-r.hadley.nz/metaprogramming.html}{Metaprogramming section} of \href{https://adv-r.hadley.nz}{Advanced R} may also be useful for a deeper dive. -\itemize{ -\item The tidy eval operators \verb{\{\{}, \verb{!!}, and \verb{!!!} are syntactic -constructs which are specially interpreted by tidy eval functions. -You will mostly need \verb{\{\{}, as \verb{!!} and \verb{!!!} are more advanced -operators which you should not have to use in simple cases. - -The curly-curly operator \verb{\{\{} allows you to tunnel data-variables -passed from function arguments inside other tidy eval functions. -\verb{\{\{} is designed for individual arguments. To pass multiple -arguments contained in dots, use \code{...} in the normal way. - -\if{html}{\out{

}} -\item \code{\link[=enquo]{enquo()}} and \code{\link[=enquos]{enquos()}} delay the execution of one or several -function arguments. The former returns a single expression, the -latter returns a list of expressions. Once defused, expressions -will no longer evaluate on their own. They must be injected back -into an evaluation context with \verb{!!} (for a single expression) and -\verb{!!!} (for a list of expressions). - -\if{html}{\out{
}}\preformatted{my_function <- function(data, var, ...) \{ - # Defuse - var <- enquo(var) - dots <- enquos(...) - - # Inject - data \%>\% - group_by(!!!dots) \%>\% - summarise(mean = mean(!!var)) -\} -}\if{html}{\out{
}} - -In this simple case, the code is equivalent to the usage of \verb{\{\{} -and \code{...} above. Defusing with \code{enquo()} or \code{enquos()} is only -needed in more complex cases, for instance if you need to inspect -or modify the expressions in some way. -\item The \code{.data} pronoun is an object that represents the current -slice of data. If you have a variable name in a string, use the -\code{.data} pronoun to subset that variable with \code{[[}. - -\if{html}{\out{
}}\preformatted{my_var <- "disp" -mtcars \%>\% summarise(mean = mean(.data[[my_var]])) -}\if{html}{\out{
}} -\item Another tidy eval operator is \verb{:=}. It makes it possible to use -glue and curly-curly syntax on the LHS of \code{=}. For technical -reasons, the R language doesn't support complex expressions on -the left of \code{=}, so we use \verb{:=} as a workaround. - -\if{html}{\out{
}}\preformatted{my_function <- function(data, var, suffix = "foo") \{ - # Use `\{\{` to tunnel function arguments and the usual glue - # operator `\{` to interpolate plain strings. - data \%>\% - summarise("\{\{ var \}\}_mean_\{suffix\}" := mean(\{\{ var \}\})) -\} -}\if{html}{\out{
}} -\item Many tidy eval functions like \code{dplyr::mutate()} or -\code{dplyr::summarise()} give an automatic name to unnamed inputs. If -you need to create the same sort of automatic names by yourself, -use \code{as_label()}. For instance, the glue-tunnelling syntax above -can be reproduced manually with: - -\if{html}{\out{
}}\preformatted{my_function <- function(data, var, suffix = "foo") \{ - var <- enquo(var) - prefix <- as_label(var) - data \%>\% - summarise("\{prefix\}_mean_\{suffix\}" := mean(!!var)) -\} -}\if{html}{\out{
}} - -Expressions defused with \code{enquo()} (or tunnelled with \verb{\{\{}) need -not be simple column names, they can be arbitrarily complex. -\code{as_label()} handles those cases gracefully. If your code assumes -a simple column name, use \code{as_name()} instead. This is safer -because it throws an error if the input is not a name as expected. -} -} -\keyword{internal} diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/man/wpgsd-package.Rd b/wpgsd.Rcheck/00_pkg_src/wpgsd/man/wpgsd-package.Rd deleted file mode 100644 index bc49567..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/man/wpgsd-package.Rd +++ /dev/null @@ -1,41 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wpgsd-package.R -\docType{package} -\name{wpgsd-package} -\alias{wpgsd} -\alias{wpgsd-package} -\title{wpgsd: Weighted Parametric Group Sequential Design} -\description{ -\if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} - -Adjusted inference for weighted parametric group sequential design. Weighted parametric group sequential design (WPGSD) by Anderson et al. (2022) \doi{10.1002/bimj.202100085} allows one to take advantage of the known correlation structure in constructing efficacy bounds to control family-wise error rate (FWER) for a group sequential design. Here, correlation may be due to common observations in nested populations, due to common observations in overlapping populations, or due to common observations in the control arm. -} -\seealso{ -Useful links: -\itemize{ - \item \url{https://merck.github.io/wpgsd/} - \item \url{https://github.com/Merck/wpgsd} - \item Report bugs at \url{https://github.com/Merck/wpgsd/issues} -} - -} -\author{ -\strong{Maintainer}: Yujie Zhao \email{yujie.zhao@merck.com} - -Authors: -\itemize{ - \item Keaven Anderson \email{keaven_anderson@merck.com} - \item Zifang Guo \email{zifang.guo@merck.com} - \item Jing Zhao \email{jing_zhaox@merck.com} - \item Linda Sun \email{linda_sun@merck.com} - \item Yi Cui \email{yi.cui@merck.com} - \item Larry Leon \email{larry.leon2@merck.com} -} - -Other contributors: -\itemize{ - \item Merck Sharp & Dohme Corp [copyright holder] -} - -} -\keyword{internal} diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat.R deleted file mode 100644 index 39921f0..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat.R +++ /dev/null @@ -1,4 +0,0 @@ -library(testthat) -library(wpgsd) - -test_check("wpgsd") diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/helper-generate_corr_new.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/helper-generate_corr_new.R deleted file mode 100644 index d378ff3..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/helper-generate_corr_new.R +++ /dev/null @@ -1,126 +0,0 @@ -# Helper functions used by test-independent-generate_corr_new.R - -#' Generate correlation matrix based on event counts -#' -#' @param event Event count of each hypothesis at each analysis, including -#' event count of the intersection of hypotheses. -#' It contains 4 columns: `H1`, `H2`, `Analysis`, `Event`. -#' `H1` needs to be listed as 1, 2, 3, etc. as numbers. -#' -#' @return A correlation matrix. -#' -#' @importFrom dplyr filter select %>% -#' -#' @export -#' -#' @examples -#' # Build the transition matrix -#' m <- matrix(c( -#' 0, 0.5, 0.5, -#' 0.5, 0, 0.5, -#' 0.5, 0.5, 0 -#' ), nrow = 3, byrow = TRUE) -#' # initialize weights -#' w <- c(1 / 3, 1 / 3, 1 / 3) -#' -#' # Input event count of intersection of paired hypotheses - Table 2 -#' event <- tibble::tribble( -#' ~H1, ~H2, ~Analysis, ~Event, -#' 1, 1, 1, 155, -#' 2, 2, 1, 160, -#' 3, 3, 1, 165, -#' 1, 2, 1, 85, -#' 1, 3, 1, 85, -#' 2, 3, 1, 85, -#' 1, 1, 2, 305, -#' 2, 2, 2, 320, -#' 3, 3, 2, 335, -#' 1, 2, 2, 170, -#' 1, 3, 2, 170, -#' 2, 3, 2, 170 -#' ) -#' -#' # Generate correlation from events -#' gs_corr <- generate_corr_new(event) -generate_corr_new <- function(event) { - elem <- event %>% subset(H1 == H2) - inter <- event %>% subset(H1 != H2) - n_hypotheses <- max(as.numeric(elem$H1)) - n_analyses <- max(elem$Analysis) - - # Diagonal - D <- diag(elem$Event) - - # Within hypothesis across analyses - if (n_analyses > 1) { - for (i in 1:n_hypotheses) { - for (j in 1:(n_analyses - 1)) { - count <- D[(j - 1) * n_hypotheses + i, (j - 1) * n_hypotheses + i] - for (k in (j + 1):n_analyses) { - D[(j - 1) * n_hypotheses + i, (k - 1) * n_hypotheses + i] <- count - D[(k - 1) * n_hypotheses + i, (j - 1) * n_hypotheses + i] <- count - } - } - } - } - - # Between hypotheses and analyses - for (i in 1:(n_hypotheses - 1)) { - for (j in c((i + 1):n_hypotheses)) { - for (k in 1:n_analyses) { - count1 <- as.numeric(event %>% - subset(((H1 == i & H2 == j) | (H1 == j & H2 == i)) & Analysis == k) %>% - select(Event))[1] - for (l in (k:n_analyses)) { - D[n_hypotheses * (l - 1) + i, n_hypotheses * (k - 1) + j] <- count1 - D[n_hypotheses * (l - 1) + j, n_hypotheses * (k - 1) + i] <- count1 - D[n_hypotheses * (k - 1) + j, n_hypotheses * (l - 1) + i] <- count1 - D[n_hypotheses * (k - 1) + i, n_hypotheses * (l - 1) + j] <- count1 - } - } - } - } - - corr_mat <- d_corr(D) - - col_names <- NULL - for (k in 1:n_analyses) { - for (i in 1:n_hypotheses) { - name_tmp <- paste("H", i, "_A", k, sep = "") - col_names <- c(col_names, name_tmp) - } - } - - colnames(corr_mat) <- col_names - - return(corr_mat) -} - -test_generate_corr_new <- function() { - a1 <- 80 - b1 <- 100 - ab1 <- 60 - a2 <- 120 - b2 <- 150 - ab2 <- 80 - - event <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, a1, - 2, 2, 1, b1, - 1, 2, 1, ab1, - 1, 1, 2, a2, - 2, 2, 2, b2, - 1, 2, 2, ab2 - ) - - list( - "a1" = a1, - "b1" = b1, - "ab1" = ab1, - "a2" = a2, - "b2" = b2, - "ab2" = ab2, - "event" = event - ) -} diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-developer-generate_event_commoncontrol_addhypo.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-developer-generate_event_commoncontrol_addhypo.R deleted file mode 100644 index 9c2a339..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-developer-generate_event_commoncontrol_addhypo.R +++ /dev/null @@ -1,23 +0,0 @@ -test_that("Generate event table returns the expected sorted data", { - expected_data <- tibble( - one_hypothesis = as.integer(c(1, 1, 1, 2, 2, 3, 1, 1, 1, 2, 2, 3)), - another_hypothesis = as.integer(c(1, 2, 3, 2, 3, 3, 1, 2, 3, 2, 3, 3)), - analysis = as.integer(c(1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2)), - common_events = c(155, 85, 70, 160, 75, 165, 305, 170, 135, 320, 150, 335) - ) - - event <- data.frame( - Population = c("Experimental 1", "Experimental 2", "Experimental 3", "Control"), - IA = c(70, 75, 80, 85), - FA = c(135, 150, 165, 170) - ) - - hypothesis <- list( - H1 = "Experimental 1 vs. Control", - H2 = "Experimental 2 vs. Control", - H3 = "Experimental 1 vs. Experimental 2" - ) - - result_table <- generate_event_table_cc(event, hypothesis) - expect_identical(result_table, expected_data) -}) diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-developer-generate_event_population_addhypo.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-developer-generate_event_population_addhypo.R deleted file mode 100644 index c611242..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-developer-generate_event_population_addhypo.R +++ /dev/null @@ -1,23 +0,0 @@ -test_that("Generate event table ol returns the expected sorted data", { - expected_data <- tibble( - one_hypothesis = as.integer(c(1, 1, 1, 2, 2, 3, 1, 1, 1, 2, 2, 3)), - another_hypothesis = as.integer(c(1, 2, 3, 2, 3, 3, 1, 2, 3, 2, 3, 3)), - analysis = as.integer(c(1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2)), - common_events = c(100, 80, 100, 110, 110, 225, 200, 160, 200, 220, 220, 450) - ) - - event <- data.frame( - Population = c("Population 1", "Population 2", "Population 1 Intersection 2", "Overall population"), - IA = c(100, 110, 80, 225), - FA = c(200, 220, 160, 450) - ) - - hypothesis <- list( - H1 = "Efficacy in Population 1", - H2 = "Efficacy in Population 2", - H3 = "Efficacy in Overall population" - ) - - result_table <- generate_event_table_ol(event, hypothesis) - expect_identical(result_table, expected_data) -}) diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-independent-closed_test.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-independent-closed_test.R deleted file mode 100644 index ef088a0..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-independent-closed_test.R +++ /dev/null @@ -1,25 +0,0 @@ -test_that("closed_test reject hypothesis as expected", { - p_obs <- dplyr::bind_rows( - tibble::tibble(Analysis = 1, H1 = 0.001, H2 = 0.001), - tibble::tibble(Analysis = 2, H1 = 0.001, H2 = 0.001) - ) - - bound <- tibble::tribble( - ~Analysis, ~Hypotheses, ~H1, ~H2, - 1, "H1", 0.02, NA, - 1, "H1, H2", 0.0001, 0.00001, - 1, "H2", NA, 0.003, - 2, "H1", 0.02, NA, - 2, "H1, H2", 0.02, 0.00001, - 2, "H2", NA, 0.003 - ) - - closed_test <- closed_test(bound, p_obs) - closed_test_a1 <- closed_test %>% dplyr::filter(Analysis == "Analysis 1") - closed_test_a2 <- closed_test %>% dplyr::filter(Analysis == "Analysis 2") - - expect_equal(closed_test_a1$H1, "Fail") - expect_equal(closed_test_a1$H2, "Fail") - expect_equal(closed_test_a2$H1, "Success") - expect_equal(closed_test_a2$H2, "Success") -}) diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-independent-generate_bounds.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-independent-generate_bounds.R deleted file mode 100644 index 67d474b..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-independent-generate_bounds.R +++ /dev/null @@ -1,580 +0,0 @@ -test_that("BH bounds replicate tables A3 and A4", { - # Example 1 BH weighting results in Table A3 and A4 - set.seed(1234) - - # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ex1 BH ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~# - # Transition matrix in Figure A1 - m <- matrix(c( - 0, 3 / 7, 4 / 7, - 3 / 7, 0, 4 / 7, - 1 / 2, 1 / 2, 0 - ), nrow = 3, byrow = TRUE) - # Initial weights - w <- c(0.3, 0.3, 0.4) - - # Event count of intersection of paired hypotheses - Table 1 - event <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 100, - 2, 2, 1, 110, - 3, 3, 1, 225, - 1, 2, 1, 80, - 1, 3, 1, 100, - 2, 3, 1, 110, - 1, 1, 2, 200, - 2, 2, 2, 220, - 3, 3, 2, 450, - 1, 2, 2, 160, - 1, 3, 2, 200, - 2, 3, 2, 220 - ) - event - - # Generate correlation from events - corr <- generate_corr(event) - corr # correlation matrix in Table 3 - - # WPGSD bounds, spending method 3b - bound_WPGSD <- generate_bounds( - type = 2, k = 2, w = w, m = m, corr = corr, alpha = 0.025, - sf = gsDesign::sfHSD, - sfparm = -4, - t = c(min(100 / 200, 110 / 220, 225 / 450), 1) - ) - - # Bonferroni bounds - bound_Bonf <- generate_bounds( - type = 0, k = 2, w = w, m = m, corr = corr, alpha = 0.025, - sf = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - sfparm = list(-4, -4, -4), - t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1)) - ) - - # Combine and back-calculate xi - bounds <- dplyr::left_join( - bound_Bonf, - bound_WPGSD, - by = c("Hypotheses", "Analysis"), - suffix = c(".B", ".W") - ) - bounds <- bounds %>% - dplyr::rowwise() %>% - dplyr::mutate(xi = sum(H1.W, H2.W, H3.W, na.rm = TRUE) / - sum(H1.B, H2.B, H3.B, na.rm = TRUE)) - # Reorder for output - bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2) - bounds <- bounds %>% dplyr::arrange(Analysis, order) - - # Z-statistics boundary, Table A4 - zbounds <- bounds %>% - dplyr::mutate( - zH1.B = -qnorm(H1.B), - zH2.B = -qnorm(H2.B), - zH3.B = -qnorm(H3.B), - zH1.W = -qnorm(H1.W), - zH2.W = -qnorm(H2.W), - zH3.W = -qnorm(H3.W) - ) %>% - select(Analysis, Hypotheses, zH1.B, zH2.B, zH3.B, zH1.W, zH2.W, zH3.W) - - - # Table A3 - # Test H1 - # From publication Weighted Bonferroni - A3_result1 <- c( - 0.0009, 0.0015, 0.0013, NA, - 0.003, NA, NA, 0.007, 0.0118, - 0.0101, NA, 0.0238, NA, NA - ) - - A3_result1_test <- round(bounds$H1.B, 4) - - expect_equal(A3_result1_test, A3_result1) - - # WPGSD - - wA3_result1 <- c( - 0.0011, 0.0017, 0.0014, NA, - 0.003, NA, NA, 0.0092, 0.0144, - 0.0116, NA, 0.0238, NA, NA - ) - - wA3_result1_test <- round(bounds$H1.W, 4) - - expect_equal(wA3_result1_test, wA3_result1) - - - # Table A4 - # Test H1 - # From publication Weighted Bonferroni - A4_result1 <- c( - 3.12, 2.97, 3.02, NA, 2.75, NA, NA, - 2.46, 2.26, 2.32, NA, 1.98, NA, NA - ) - - A4_result1_test <- round(zbounds$zH1.B, 2) - - expect_equal(A4_result1_test, A4_result1) - - # WPGSD - wA4_result1 <- c( - 3.08, 2.93, 2.99, NA, 2.75, NA, NA, - 2.36, 2.19, 2.27, NA, 1.98, NA, NA - ) - - wA4_result1_test <- round(zbounds$zH1.W, 2) - - expect_equal(wA4_result1_test, wA4_result1) - - - ######################## - # Next, reproduce H2? - ######################## - - A3_result2 <- c( - 0.0009, 0.0015, NA, 0.0013, NA, - 0.003, NA, 0.007, 0.0118, NA, 0.0101, NA, 0.0238, NA - ) - - A3_result2_test <- round(bounds$H2.B, 4) - - expect_equal(A3_result2_test, A3_result2) - - # WPGSD - - wA3_result2 <- c( - 0.0011, 0.0017, NA, 0.0014, NA, - 0.003, NA, 0.0092, 0.0144, - NA, 0.0118, NA, 0.0238, NA - ) - - wA3_result2_test <- round(bounds$H2.W, 4) - - expect_equal(wA3_result2_test, wA3_result2) - - # A4 - - A4_result2 <- c( - 3.12, 2.97, NA, 3.02, NA, 2.75, NA, 2.46, 2.26, NA, 2.32, - NA, 1.98, NA - ) - - A4_result2_test <- round(zbounds$zH2.B, 2) - - expect_equal(A4_result2_test, A4_result2) - - # WPGSD - wA4_result2 <- c( - 3.08, 2.93, NA, 2.99, NA, 2.75, NA, 2.36, 2.19, - NA, 2.26, NA, 1.98, NA - ) - - wA4_result2_test <- round(zbounds$zH2.W, 2) - - expect_equal(wA4_result2_test, wA4_result2) - - - ######################## - # Next, reproduce H3? - ######################## - - A3_result3 <- c( - 0.0012, NA, 0.0017, 0.0017, NA, NA, 0.003, 0.0094, NA, - 0.0135, 0.0135, NA, NA, 0.0238 - ) - - A3_result3_test <- round(bounds$H3.B, 4) - - expect_equal(A3_result3_test, A3_result3) - - # WPGSD - - wA3_result3 <- c( - 0.0014, NA, 0.0018, 0.0019, NA, NA, 0.003, 0.0123, NA, - 0.0155, 0.0158, NA, NA, 0.0238 - ) - - wA3_result3_test <- round(bounds$H3.W, 4) - - expect_equal(wA3_result3_test, wA3_result3) - - # A4 - - A4_result3 <- c(3.04, NA, 2.93, 2.93, NA, NA, 2.75, 2.35, NA, 2.21, 2.21, NA, NA, 1.98) - - A4_result3_test <- round(zbounds$zH3.B, 2) - - expect_equal(A4_result3_test, A4_result3) - - # WPGSD - wA4_result3 <- c(2.99, NA, 2.9, 2.9, NA, NA, 2.75, 2.25, NA, 2.16, 2.15, NA, NA, 1.98) - - wA4_result3_test <- round(zbounds$zH3.W, 2) - - expect_equal(wA4_result3_test, wA4_result3) -}) - -test_that("BH bounds replicate tables A6 and A7", { - # From wpgsd github: - # Example 2 BH weighting results in Table A6 and A7 - set.seed(1234) - - # Transition matrix in Figure A2 - m <- matrix(c( - 0, 0.5, 0.5, - 0.5, 0, 0.5, - 0.5, 0.5, 0 - ), nrow = 3, byrow = TRUE) - # Initial weights - w <- c(1 / 3, 1 / 3, 1 / 3) - - # Event count of intersection of paired hypotheses - Table 2 - event <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160, - 3, 3, 1, 165, - 1, 2, 1, 85, - 1, 3, 1, 85, - 2, 3, 1, 85, - 1, 1, 2, 305, - 2, 2, 2, 320, - 3, 3, 2, 335, - 1, 2, 2, 170, - 1, 3, 2, 170, - 2, 3, 2, 170 - ) - event - - # Generate correlation from events - corr <- generate_corr(event) - corr # correlation matrix in Table 4 - - # WPGSD bounds, spending method 3c - bound_WPGSD <- generate_bounds( - type = 3, k = 2, w = w, m = m, corr = corr, alpha = 0.025, - sf = list(gsDesign::sfLDOF, gsDesign::sfLDOF, gsDesign::sfLDOF), - sfparm = list(0, 0, 0), - t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1)) - ) - - # Bonferroni bounds - bound_Bonf <- generate_bounds( - type = 0, k = 2, w = w, m = m, corr = corr, alpha = 0.025, - sf = list(gsDesign::sfLDOF, gsDesign::sfLDOF, gsDesign::sfLDOF), - sfparm = list(0, 0, 0), - t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1)) - ) - - bounds <- dplyr::left_join( - bound_Bonf, - bound_WPGSD, - by = c("Hypotheses", "Analysis"), - suffix = c(".B", ".W") - ) - - # Reorder for output - bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2) - bounds <- bounds %>% arrange(Analysis, order) - - # Table A6 - bounds - - bounds <- bounds %>% arrange(Analysis, order) - - # Z-statistics boundary, Table A7 - zbounds <- bounds %>% - mutate( - zH1.B = -qnorm(H1.B), - zH2.B = -qnorm(H2.B), - zH3.B = -qnorm(H3.B), - zH1.W = -qnorm(H1.W), - zH2.W = -qnorm(H2.W), - zH3.W = -qnorm(H3.W) - ) %>% - select(Analysis, Hypotheses, zH1.B, zH2.B, zH3.B, zH1.W, zH2.W, zH3.W) - - - # Table A6 - # Test H1 - # From publication Weighted Bonferroni - A6_result1 <- c( - 0.00021488, - 0.000458864, - 0.000458864, - NA, - 0.001665671, - NA, - NA, - 0.008259394, - 0.0123448, - 0.0123448, - NA, - 0.024455472, - NA, - NA - ) - - A6_result1_test <- round(bounds$H1.B, 4) - - expect_equal(A6_result1_test, round(A6_result1, 4)) - - # H2 - - A6_result2 <- c( - 0.000190676, - 0.000411979, - NA, - 0.000411979, - NA, - 0.001525323, - NA, - 0.0082675, - 0.012360191, - NA, - 0.012360191, - NA, - 0.024499778, - NA - ) - - A6_result2_test <- round(bounds$H2.B, 4) - - expect_equal(A6_result2_test, round(A6_result2, 4)) - - # H3 - - A6_result3 <- c( - 0.000170445, - NA, - 0.000372343, - 0.000372343, - NA, - NA, - 0.001404398, - 0.008274305, - NA, - 0.012373258, - 0.012373258, - NA, - NA, - 0.024538108 - ) - - A6_result3_test <- round(bounds$H3.B, 4) - - expect_equal(A6_result3_test, round(A6_result3, 4)) - - ######## - # WPGSD - ######## - - wA6_result1 <- c( - 0.000224701, - 0.000471076, - 0.000470177, - NA, - 0.001665671, - NA, - NA, - 0.009491524, - 0.013508544, - 0.013452942, - NA, - 0.024455472, - NA, - NA - ) - - wA6_result1_test <- round(bounds$H1.W, 4) - - expect_equal(wA6_result1_test, round(wA6_result1, 4)) - - - - wA6_result2 <- c( - 0.00019939, - 0.000422943, - NA, - 0.000421453, - NA, - 0.001525323, - NA, - 0.00950084, - 0.013525386, - NA, - 0.01341849, - NA, - 0.024499778, - NA - ) - - wA6_result2_test <- round(bounds$H2.W, 4) - - expect_equal(wA6_result2_test, round(wA6_result2, 4)) - - - wA6_result3 <- c( - 0.000178234, - NA, - 0.000381523, - 0.000380905, - NA, - NA, - 0.001404398, - 0.00950866, - NA, - 0.013483955, - 0.013432676, - NA, - NA, - 0.024538108 - ) - - wA6_result3_test <- round(bounds$H3.W, 4) - - expect_equal(wA6_result3_test, round(wA6_result3, 4)) - - - # Z-statistics - - - # Table A7 - A7_result1 <- c( - 3.521099809, - 3.314604451, - 3.314604451, - NA, - 2.93538486, - NA, - NA, - 2.397246926, - 2.246225001, - 2.246225001, - NA, - 1.969367163, - NA, - NA - ) - - A7_result1_test <- round(zbounds$zH1.B, 4) - - expect_equal(A7_result1_test, round(A7_result1, 4)) - - - A7_result2 <- c( - 3.552662921, - 3.34461863, - NA, - 3.34461863, - NA, - 2.962588043, - NA, - 2.396887486, - 2.245744429, - NA, - 2.245744429, - NA, - 1.968595527, - NA - ) - - A7_result2_test <- round(zbounds$zH2.B, 4) - - expect_equal(A7_result2_test, round(A7_result2, 4)) - - - - A7_result3 <- c( - 3.582064348, - NA, - 3.372575697, - 3.372575697, - NA, - NA, - 2.987923795, - 2.396585993, - NA, - 2.24533684, - 2.24533684, - NA, - NA, - 1.967928919 - ) - - A7_result3_test <- round(zbounds$zH3.B, 4) - - expect_equal(A7_result3_test, round(A7_result3, 4)) - - - - - - # Table A7 - wA7_result1 <- c( - 3.509232997, - 3.307254785, - 3.307789645, - NA, - 2.93538486, - NA, - NA, - 2.345863682, - 2.21127083, - 2.212880514, - NA, - 1.969367163, - NA, - NA - ) - - wA7_result1_test <- round(zbounds$zH1.W, 4) - - expect_equal(wA7_result1_test, round(wA7_result1, 4)) - - - wA7_result2 <- c( - 3.540889382, - 3.337326516, - NA, - 3.338307071, - NA, - 2.962588043, - NA, - 2.345498009, - 2.210784367, - NA, - 2.213880806, - NA, - 1.968595527, - NA - ) - - - wA7_result2_test <- round(zbounds$zH2.W, 4) - - expect_equal(wA7_result2_test, round(wA7_result2, 4)) - - - - wA7_result3 <- c( - 3.570376445, - NA, - 3.365863239, - 3.366309865, - NA, - NA, - 2.987923795, - 2.345191286, - NA, - 2.21198197, - 2.213468666, - NA, - NA, - 1.967928919 - ) - - wA7_result3_test <- round(zbounds$zH3.W, 4) - - expect_equal(wA7_result3_test, round(wA7_result3, 4)) -}) diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-independent-generate_corr.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-independent-generate_corr.R deleted file mode 100644 index a1699f5..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-independent-generate_corr.R +++ /dev/null @@ -1,31 +0,0 @@ -test_that("2 endpoints 2 analysis correlation as expected", { - a1 <- 80 - b1 <- 100 - ab1 <- 60 - a2 <- 120 - b2 <- 150 - ab2 <- 80 - - event <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, a1, - 2, 2, 1, b1, - 1, 2, 1, ab1, - 1, 1, 2, a2, - 2, 2, 2, b2, - 1, 2, 2, ab2 - ) - - corr <- generate_corr(event) - corr_test <- matrix( - c( - 1, ab1 / sqrt(a1 * b1), a1 / sqrt(a1 * a2), ab1 / sqrt(a1 * b2), - ab1 / sqrt(a1 * b1), 1, ab1 / sqrt(a2 * b1), b1 / sqrt(b1 * b2), - a1 / sqrt(a1 * a2), ab1 / sqrt(a2 * b1), 1, ab2 / sqrt(a2 * b2), - ab1 / sqrt(a1 * b2), b1 / sqrt(b1 * b2), ab2 / sqrt(a2 * b2), 1 - ), - nrow = 4, byrow = TRUE - ) - - expect_equal(matrix(corr %>% as.numeric(), nrow = 4, byrow = TRUE), corr_test) -}) diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-independent-generate_corr_new.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-independent-generate_corr_new.R deleted file mode 100644 index aae7943..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-independent-generate_corr_new.R +++ /dev/null @@ -1,62 +0,0 @@ -test_that("2 endpoints 2 analysis correlation as expected", { - res <- test_generate_corr_new() - a1 <- res$a1 - b1 <- res$b1 - ab1 <- res$ab1 - a2 <- res$a2 - b2 <- res$b2 - ab2 <- res$ab2 - event <- res$event - - corr <- generate_corr_new(event) - corr_test <- matrix( - c( - 1, ab1 / sqrt(a1 * b1), a1 / sqrt(a1 * a2), ab1 / sqrt(a1 * b2), - ab1 / sqrt(a1 * b1), 1, ab1 / sqrt(a2 * b1), b1 / sqrt(b1 * b2), - a1 / sqrt(a1 * a2), ab1 / sqrt(a2 * b1), 1, ab2 / sqrt(a2 * b2), - ab1 / sqrt(a1 * b2), b1 / sqrt(b1 * b2), ab2 / sqrt(a2 * b2), 1 - ), - nrow = 4, byrow = TRUE - ) - - expect_equal(matrix(corr %>% as.numeric(), nrow = 4, byrow = TRUE), corr_test) -}) - -# This is a 2 hypothesis, 3 analysis example -test_that("2 hypotheses 3 analysis correlation as expected", { - event <- tibble::tribble( - ~Analysis, ~H1, ~H2, ~Event, - 1, 1, 1, 147, - 1, 2, 2, 167, - 1, 1, 2, 88, - 2, 1, 1, 278, - 2, 2, 2, 289, - 2, 1, 2, 158, - 3, 1, 1, 342, - 3, 2, 2, 350, - 3, 1, 2, 192 - ) - corr <- generate_corr_new(event) - n_hypotheses <- 2 - n_analyses <- 3 - corr_test <- diag(1, n_hypotheses * n_analyses) - for (k in 1:n_analyses) { - for (l in k:n_analyses) { - for (i in 1:(n_hypotheses)) { - countkii <- as.numeric((event %>% filter(H1 == i & H2 == i & Analysis == k))$Event) - for (j in i:n_hypotheses) { - countkjj <- as.numeric((event %>% filter(H1 == j & H2 == j & Analysis == k))$Event) - countljj <- as.numeric((event %>% filter(H1 == j & H2 == j & Analysis == l))$Event) - countlii <- as.numeric((event %>% filter(H1 == i & H2 == i & Analysis == l))$Event) - countkij <- as.numeric((event %>% filter(H1 == i & H2 == j & Analysis == k))$Event) - corr_test[(k - 1) * n_hypotheses + i, (l - 1) * n_hypotheses + j] <- countkij / sqrt(countkii * countljj) - corr_test[(k - 1) * n_hypotheses + j, (l - 1) * n_hypotheses + i] <- countkij / sqrt(countkjj * countlii) - corr_test[(l - 1) * n_hypotheses + i, (k - 1) * n_hypotheses + j] <- countkij / sqrt(countlii * countkjj) - corr_test[(l - 1) * n_hypotheses + j, (k - 1) * n_hypotheses + i] <- countkij / sqrt(countljj * countkii) - } - } - } - } - - expect_equal(matrix(corr %>% as.numeric(), nrow = 6, byrow = TRUE), corr_test) -}) diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-s7-event-table.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-s7-event-table.R deleted file mode 100644 index ceca45c..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-s7-event-table.R +++ /dev/null @@ -1,171 +0,0 @@ -test_that("EventTable can be created with valid data", { - # Create valid event data - event_data <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160, - 1, 2, 1, 85, - 1, 1, 2, 305, - 2, 2, 2, 320, - 1, 2, 2, 170 - ) - - # Create EventTable - event_table <- EventTable(data = event_data) - - # Check that object was created successfully - expect_true(S7::S7_inherits(event_table, EventTable)) - expect_equal(event_table@n_hypotheses, 2L) - expect_equal(event_table@n_analyses, 2L) - expect_equal(nrow(event_table@data), 6) -}) - -test_that("EventTable validates required columns", { - # Missing Event column - invalid_data1 <- tibble::tibble( - H1 = c(1, 2), - H2 = c(1, 2), - Analysis = c(1, 1) - ) - - expect_error( - EventTable(data = invalid_data1), - "EventTable requires columns: Event" - ) - - # Missing H1 column - invalid_data2 <- tibble::tibble( - H2 = c(1, 2), - Analysis = c(1, 1), - Event = c(100, 200) - ) - - expect_error( - EventTable(data = invalid_data2), - "EventTable requires columns: H1" - ) -}) - -test_that("EventTable validates data types and values", { - # Non-numeric H1 - invalid_data1 <- tibble::tibble( - H1 = c("A", "B"), - H2 = c(1, 2), - Analysis = c(1, 1), - Event = c(100, 200) - ) - - expect_error( - EventTable(data = invalid_data1), - "@data\\$H1 and @data\\$H2 must be numeric" - ) - - # Negative hypothesis index - invalid_data2 <- tibble::tibble( - H1 = c(-1, 2), - H2 = c(1, 2), - Analysis = c(1, 1), - Event = c(100, 200) - ) - - expect_error( - EventTable(data = invalid_data2), - "Hypothesis indices \\(H1, H2\\) must be positive integers" - ) - - # Negative event count - invalid_data3 <- tibble::tibble( - H1 = c(1, 2), - H2 = c(1, 2), - Analysis = c(1, 1), - Event = c(-100, 200) - ) - - expect_error( - EventTable(data = invalid_data3), - "Event counts must be non-negative" - ) -}) - -test_that("EventTable print method works", { - event_data <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160 - ) - - event_table <- EventTable(data = event_data) - - # Test the show method (which S7 uses for printing) - expect_output(show(event_table), "EventTable with 2 rows") - expect_output(show(event_table), "Hypotheses: 2") - expect_output(show(event_table), "Analyses: 1") -}) - -test_that("subset_event_table works correctly", { - event_data <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160, - 1, 2, 1, 85, - 1, 1, 2, 305, - 2, 2, 2, 320, - 1, 2, 2, 170 - ) - - event_table <- EventTable(data = event_data) - - # Subset by analysis - subset_a1 <- subset_event_table(event_table, analysis = 1) - expect_equal(subset_a1@n_analyses, 1L) - expect_equal(nrow(subset_a1@data), 3) - - # Subset by hypotheses - subset_h1 <- subset_event_table(event_table, hypotheses = c(1)) - expect_equal(nrow(subset_h1@data), 2) # Only H1-H1 pairs - - # Error for non-EventTable input - expect_error( - subset_event_table(data.frame(), analysis = 1), - "x must be an EventTable object" - ) -}) - -test_that("as_event_table conversion works", { - event_data <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160 - ) - - # Convert tibble to EventTable - event_table <- as_event_table(event_data) - expect_true(S7::S7_inherits(event_table, EventTable)) - - # Should return same object if already EventTable - event_table2 <- as_event_table(event_table) - expect_identical(event_table, event_table2) -}) - -test_that("validate_event_table_data works", { - # Valid data should pass - valid_data <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160 - ) - - expect_true(validate_event_table_data(valid_data)) - - # Invalid data should fail - invalid_data <- tibble::tribble( - ~H1, ~H2, ~Analysis, # Missing Event column - 1, 1, 1, - 2, 2, 1 - ) - - expect_error( - validate_event_table_data(invalid_data), - "Missing required columns: Event" - ) -}) diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/adj-seq-p.Rmd b/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/adj-seq-p.Rmd deleted file mode 100644 index df94c1c..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/adj-seq-p.Rmd +++ /dev/null @@ -1,810 +0,0 @@ ---- -title: "Adjusted sequential p-values" -author: "Yujie Zhao, Qi Liu, Linda Sun, Keaven Anderson" -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{Adjusted sequential p-values} ---- - -```{r, message = FALSE, warning = FALSE} -library(wpgsd) -library(gsDesign) -library(tibble) -library(gt) -library(dplyr) -``` - -# Example overview - -In a 2-arm controlled clinical trial example with one primary endpoint, there are 3 patient populations defined by the status of two biomarkers A and B: - -- biomarker A positive, -- biomarker B positive, -- overall population. - -The 3 primary elementary hypotheses are: - -- $H_1$: the experimental treatment is superior to the control in the biomarker A positive population; -- \item $H_2$: the experimental treatment is superior to the control in the biomarker B positive population; -- \item $H_3$: the experimental treatment is superior to the control in the overall population. - -Assume an interim analysis and a final analysis are planned for the study and the number of events are listed as - -```{r} -event_tbl <- tribble( - ~population, ~analysis, ~event, - "A positive", 1, 100, - "B positive", 1, 110, - "AB positive", 1, 80, - "overall", 1, 225, - "A positive", 2, 200, - "B positive", 2, 220, - "AB positive", 2, 160, - "overall", 2, 450, -) -``` - -The observed p-values are - -```{r} -obs_tbl <- tribble( - ~hypothesis, ~analysis, ~obs_p, - "H1", 1, 0.02, - "H2", 1, 0.01, - "H3", 1, 0.012, - "H1", 2, 0.015, - "H2", 2, 0.012, - "H3", 2, 0.010 -) %>% - mutate(obs_Z = -qnorm(obs_p)) - -obs_tbl %>% - gt() %>% - tab_header(title = "Nominal p-values") - -p_obs_IA <- (obs_tbl %>% filter(analysis == 1))$obs_p -p_obs_FA <- (obs_tbl %>% filter(analysis == 2))$obs_p -``` - -The information fraction of $H_1, H_2, H_3$ at IA is - -```{r} -IF_IA <- c( - ((event_tbl %>% filter(analysis == 1, population == "A positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "A positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event), - ((event_tbl %>% filter(analysis == 1, population == "B positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "B positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event), - ((event_tbl %>% filter(analysis == 1, population == "AB positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "AB positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event) -) - -IF_IA -``` - -We assign the initial weights of $H_1, H_2, H_3$ as$\left(w_1(I), w_2(I), w_3(I) \right) = (0.3, 0.3, 0.4).$ And its multiplicity strategy is visualized in below. If $H_1$ is rejected, then $3/7$ local significance level $\alpha_1$ will be propagated to $H_2$, and $4/7$ will go to $H_3$. If $H_3$ is rejected, then half of $\alpha_3$ goes to $H_1$, and half goes to $H_2$. - -```{r} -# Transition matrix in Figure A1 -m <- matrix(c( - 0, 3 / 7, 4 / 7, - 3 / 7, 0, 4 / 7, - 0.5, 0.5, 0 -), nrow = 3, byrow = TRUE) -# Initial weights -w <- c(0.3, 0.3, 0.4) -``` - -```{r} -name_hypotheses <- c("H1: Biomarker A positive", "H2: Biomarker B positive", "H3: Overall Population") - -hplot <- gMCPLite::hGraph( - 3, - alphaHypotheses = w, m = m, - nameHypotheses = name_hypotheses, trhw = .2, trhh = .1, - digits = 5, trdigits = 3, size = 5, halfWid = 1, halfHgt = 0.5, - offset = 0.2, trprop = 0.4, - fill = as.factor(c(2, 3, 1)), - palette = c("#BDBDBD", "#E0E0E0", "#EEEEEE"), - wchar = "w" -) -hplot -``` - -The correlation of the 6 statistisc (2 analysis $\times$ 3 hypothesis) are - -```{r} -# Event count of intersection of paired hypotheses - Table 2 -# H1, H2: Hypotheses intersected. -# (1, 1) represents counts for hypothesis 1 -# (1, 2) for counts for the intersection of hypotheses 1 and 2 -event <- tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, event_tbl %>% filter(analysis == 1, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 2, 1, event_tbl %>% filter(analysis == 1, population == "B positive") %>% select(event) %>% as.numeric(), - 3, 3, 1, event_tbl %>% filter(analysis == 1, population == "overall") %>% select(event) %>% as.numeric(), - 1, 2, 1, event_tbl %>% filter(analysis == 1, population == "AB positive") %>% select(event) %>% as.numeric(), - 1, 3, 1, event_tbl %>% filter(analysis == 1, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 3, 1, event_tbl %>% filter(analysis == 1, population == "B positive") %>% select(event) %>% as.numeric(), - 1, 1, 2, event_tbl %>% filter(analysis == 2, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 2, 2, event_tbl %>% filter(analysis == 2, population == "B positive") %>% select(event) %>% as.numeric(), - 3, 3, 2, event_tbl %>% filter(analysis == 2, population == "overall") %>% select(event) %>% as.numeric(), - 1, 2, 2, event_tbl %>% filter(analysis == 2, population == "AB positive") %>% select(event) %>% as.numeric(), - 1, 3, 2, event_tbl %>% filter(analysis == 2, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 3, 2, event_tbl %>% filter(analysis == 2, population == "B positive") %>% select(event) %>% as.numeric() -) -event - -# Generate correlation from events -gs_corr <- wpgsd::generate_corr(event) -gs_corr %>% round(2) -``` - -# Sequential p-value - -## IA - -```{r, wpgsdSeqIA, message=FALSE} -seq_p_IA_H123 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H1, H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H12 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H1, H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H13 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H1, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H23 <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H1 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H1", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H2 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H3 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) -``` - -```{r, weightedBonferroniSeqIA, message=FALSE} -seq_p_IA_H123_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H1, H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -seq_p_IA_H12_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H1, H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H13_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H1, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -seq_p_IA_H23_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -seq_p_IA_H1_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H1", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -seq_p_IA_H2_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -seq_p_IA_H3_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) -``` - -## FA - -```{r, wpgsdSeqFA, message=FALSE} -seq_p_FA_H123 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1, H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.15) -) - -seq_p_FA_H12 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1, H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.15) -) - -seq_p_FA_H13 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.15) -) - -seq_p_FA_H23 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.15) -) - -seq_p_FA_H1 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H2 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H3 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) -``` - -```{r, weightedBonferroniSeqFA, message=FALSE} -seq_p_FA_H123_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1, H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H12_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1, H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H13_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H23_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H1_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H2_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H3_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) -``` - -# Adjusted-Sequential p-value - -## IA - -```{r, wpgsdAdjSeqIA} -adj_seq_IA_H1 <- max(seq_p_IA_H123, seq_p_IA_H12, seq_p_IA_H13, seq_p_IA_H1) -adj_seq_IA_H2 <- max(seq_p_IA_H123, seq_p_IA_H12, seq_p_IA_H23, seq_p_IA_H2) -adj_seq_IA_H3 <- max(seq_p_IA_H123, seq_p_IA_H13, seq_p_IA_H23, seq_p_IA_H3) - -cat("The adjusted-sequential p-value of H1, H2, H3 in IA via WPGSD is", adj_seq_IA_H1, adj_seq_IA_H2, adj_seq_IA_H3, "\n") -``` - -```{r, weightedBonferroniAdjSeqIA} -adj_seq_IA_H1_B <- max(seq_p_IA_H123_B, seq_p_IA_H12_B, seq_p_IA_H13_B, seq_p_IA_H1_B) -adj_seq_IA_H2_B <- max(seq_p_IA_H123_B, seq_p_IA_H12_B, seq_p_IA_H23_B, seq_p_IA_H2_B) -adj_seq_IA_H3_B <- max(seq_p_IA_H123_B, seq_p_IA_H13_B, seq_p_IA_H23_B, seq_p_IA_H3_B) - -cat("The adjusted-sequential p-value of H1, H2, H3 in FA via weighted Bonferroni is", adj_seq_IA_H1_B, adj_seq_IA_H2_B, adj_seq_IA_H3_B, "\n") -``` - -## FA - -### WPGSD -```{r, wpgsdAdjSeqFA} -adj_seq_FA_H1 <- max(seq_p_FA_H123, seq_p_FA_H12, seq_p_FA_H13, seq_p_FA_H1) -adj_seq_FA_H2 <- max(seq_p_FA_H123, seq_p_FA_H12, seq_p_FA_H23, seq_p_FA_H2) -adj_seq_FA_H3 <- max(seq_p_FA_H123, seq_p_FA_H13, seq_p_FA_H23, seq_p_FA_H3) - -cat("The adjusted-sequential p-value of H1, H2, H3 in FA via WPGSD is", adj_seq_FA_H1, adj_seq_FA_H2, adj_seq_FA_H3, "\n") -``` - -```{r, weightedBonferroniAdjSeqFA} -adj_seq_FA_H1_B <- max(seq_p_FA_H123_B, seq_p_FA_H12_B, seq_p_FA_H13_B, seq_p_FA_H1_B) -adj_seq_FA_H2_B <- max(seq_p_FA_H123_B, seq_p_FA_H12_B, seq_p_FA_H23_B, seq_p_FA_H2_B) -adj_seq_FA_H3_B <- max(seq_p_FA_H123_B, seq_p_FA_H13_B, seq_p_FA_H23_B, seq_p_FA_H3_B) - -cat("The adjusted-sequential p-value of H1, H2, H3 in FA via weighted Bonferroni is", adj_seq_FA_H1_B, adj_seq_FA_H2_B, adj_seq_FA_H3_B, "\n") -``` - -# Summary - -```{r} -ans <- tribble( - ~Analysis, ~Hypothesis, ~`Sequential p-values of WPGSD`, ~`Sequential p-values of Weighted Bonferroni`, ~`Adjusted-sequential p-values of WPGSD`, ~`Adjusted-sequential p-values of Weighted Bonferroni`, - "IA", "H123", seq_p_IA_H123, seq_p_IA_H123_B, NA, NA, - "IA", "H12", seq_p_IA_H12, seq_p_IA_H12_B, NA, NA, - "IA", "H13", seq_p_IA_H13, seq_p_IA_H13_B, NA, NA, - "IA", "H23", seq_p_IA_H23, seq_p_IA_H23_B, NA, NA, - "IA", "H1", seq_p_IA_H1, seq_p_IA_H1_B, adj_seq_IA_H1, adj_seq_IA_H1_B, - "IA", "H2", seq_p_IA_H2, seq_p_IA_H2_B, adj_seq_IA_H2, adj_seq_IA_H2_B, - "IA", "H3", seq_p_IA_H3, seq_p_IA_H3_B, adj_seq_IA_H3, adj_seq_IA_H3_B, - "FA", "H123", seq_p_FA_H123, seq_p_FA_H123_B, NA, NA, - "FA", "H12", seq_p_FA_H12, seq_p_FA_H12_B, NA, NA, - "FA", "H13", seq_p_FA_H13, seq_p_FA_H13_B, NA, NA, - "FA", "H23", seq_p_FA_H23, seq_p_FA_H23_B, NA, NA, - "FA", "H1", seq_p_FA_H1, seq_p_FA_H1_B, adj_seq_FA_H1, adj_seq_FA_H1_B, - "FA", "H2", seq_p_FA_H2, seq_p_FA_H2_B, adj_seq_FA_H2, adj_seq_FA_H2_B, - "FA", "H3", seq_p_FA_H3, seq_p_FA_H3_B, adj_seq_FA_H3, adj_seq_FA_H3_B -) - -ans %>% - select( - Analysis, Hypothesis, - `Sequential p-values of Weighted Bonferroni`, `Adjusted-sequential p-values of Weighted Bonferroni`, - `Sequential p-values of WPGSD`, `Adjusted-sequential p-values of WPGSD` - ) %>% - gt() %>% - tab_spanner( - label = "Weighted Bonferroni", - columns = c(`Sequential p-values of Weighted Bonferroni`, `Adjusted-sequential p-values of Weighted Bonferroni`) - ) %>% - tab_spanner( - label = "WPGSD", - columns = c(`Sequential p-values of WPGSD`, `Adjusted-sequential p-values of WPGSD`) - ) %>% - tab_style_body( - columns = where(is.numeric), - style = cell_fill(color = "pink"), - fn = function(x) x <= 0.025 - ) %>% - fmt_number(columns = 3:6, decimals = 4) %>% - tab_header( - title = "(Adjusted-) sequential p-values", - subtitle = "Multiple populations" - ) # %>% as_latex() -``` diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/corr_calculation.Rmd b/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/corr_calculation.Rmd deleted file mode 100644 index df67ae9..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/corr_calculation.Rmd +++ /dev/null @@ -1,180 +0,0 @@ ---- -title: "Correlated test statistics" -author: "Chenguang Zhang, Yujie Zhao" -output: - rmarkdown::html_document: - toc: true - toc_float: true - toc_depth: 2 - number_sections: true - highlight: "textmate" - css: "custom.css" - code_fold: hide -vignette: > - %\VignetteEngine{knitr::rmarkdown} - %\VignetteIndexEntry{Correlated test statistics} -bibliography: wpgsd.bib ---- - -The weighted parametric group sequential design (WPGSD) (@anderson2022unified) approach allows one to take advantage of the known correlation structure in constructing efficacy bounds to control family-wise error rate (FWER) for a group sequential design. Here correlation may be due to common observations in nested populations, due to common observations in overlapping populations, or due to common observations in the control arm. - -# Methodologies to calculate correlations - -Suppose that in a group sequential trial there are $m$ elementary null hypotheses $H_i$, $i \in I={1,...,m}$, and there are $K$ analyses. Let $k$ be the index for the interim analyses and final analyses, $k=1,2,...K$. For any nonempty set $J \subseteq I$, we denote the intersection hypothesis $H_J=\cap_{j \in J}H_j$. We note that $H_I$ is the global null hypothesis. - -We assume the plan is for all hypotheses to be tested at each of the $k$ planned analyses if the trial continues to the end for all hypotheses. We further assume that the distribution of the $m \times K$ tests of $m$ individual hypotheses at all $k$ analyses is multivariate normal with a completely known correlation matrix. - -Let $Z_{ik}$ be the standardized normal test statistic for hypothesis $i \in I$, analysis $1 \le k \le K$. Let $n_{ik}$ be the number of events collected cumulatively through stage $k$ for hypothesis $i$. Then $n_{i \wedge i',k \wedge k'}$ is the number of events included in both $Z_{ik}$ and $i$, $i' \in I$, $1 \le k$, $k' \le K$. The key of the parametric tests to utilize the correlation among the test statistics. The correlation between $Z_{ik}$ and $Z_{i'k'}$ is -$$Corr(Z_{ik},Z_{i'k'})=\frac{n_{i \wedge i',k \wedge k'}}{\sqrt{n_{ik}*n_{i'k'}}}$$. - -# Examples - -We borrow an example from a paper by Anderson et al. (@anderson2022unified), demonstrated in Section 2 - Motivating Examples, we use Example 1 as the basis here. The setting will be: - -In a two-arm controlled clinical trial with one primary endpoint, there are three patient populations defined by the status of two biomarkers, A and B: - -* Biomarker A positive, the population 1, -* Biomarker B positive, the population 2, -* Overall population. - -The 3 primary elementary hypotheses are: - -* **H1**: the experimental treatment is superior to the control in the population 1 -* **H2**: the experimental treatment is superior to the control in the population 2 -* **H3**: the experimental treatment is superior to the control in the overall population - -Assume an interim analysis and a final analysis are planned for the study. The number of events are listed as -```{r,message=FALSE} -library(dplyr) -library(tibble) -library(gt) -``` - -```{r} -event_tb <- tribble( - ~Population, ~"Number of Event in IA", ~"Number of Event in FA", - "Population 1", 100, 200, - "Population 2", 110, 220, - "Overlap of Population 1 and 2", 80, 160, - "Overall Population", 225, 450 -) -event_tb %>% - gt() %>% - tab_header(title = "Number of events at each population") -``` - -## Correlation of different populations within the same analysis -Let's consider a simple situation, we want to compare the population 1 and population 2 in only interim analyses. Then $k=1$, and to compare $H_{1}$ and $H_{2}$, the $i$ will be $i=1$ and $i=2$. -The correlation matrix will be -$$Corr(Z_{11},Z_{21})=\frac{n_{1 \wedge 2,1 \wedge 1}}{\sqrt{n_{11}*n_{21}}}$$ -The number of events are listed as -```{r} -event_tbl <- tribble( - ~Population, ~"Number of Event in IA", - "Population 1", 100, - "Population 2", 110, - "Overlap in population 1 and 2", 80 -) -event_tbl %>% - gt() %>% - tab_header(title = "Number of events at each population in example 1") -``` -The the corrleation could be simply calculated as -$$Corr(Z_{11},Z_{21})=\frac{80}{\sqrt{100*110}}=0.76$$ -```{r} -Corr1 <- 80 / sqrt(100 * 110) -round(Corr1, 2) -``` - -## Correlation of different analyses within the same population -Let's consider another simple situation, we want to compare single population, for example, the population 1, but in different analyses, interim and final analyses. Then $i=1$, and to compare IA and FA, the $k$ will be $k=1$ and $k=2$. -The correlation matrix will be -$$Corr(Z_{11},Z_{12})=\frac{n_{1 \wedge 1,1 \wedge 2}}{\sqrt{n_{11}*n_{12}}}$$ -The number of events are listed as -```{r} -event_tb2 <- tribble( - ~Population, ~"Number of Event in IA", ~"Number of Event in FA", - "Population 1", 100, 200 -) -event_tb2 %>% - gt() %>% - tab_header(title = "Number of events at each analyses in example 2") -``` -The the corrleation could be simply calculated as -$$\text{Corr}(Z_{11},Z_{12})=\frac{100}{\sqrt{100*200}}=0.71$$ -The 100 in the numerator is the overlap number of events of interim analysis and final analysis in population 1. -```{r} -Corr1 <- 100 / sqrt(100 * 200) -round(Corr1, 2) -``` - -## Correlation of different analyses and different population -Let's consider the situation that we want to compare population 1 in interim analyses and population 2 in final analyses. Then for different population, $i=1$ and $i=2$, and to compare IA and FA, the $k$ will be $k=1$ and $k=2$. -The correlation matrix will be -$$\text{Corr}(Z_{11},Z_{22})=\frac{n_{1 \wedge 1,2 \wedge 2}}{\sqrt{n_{11}*n_{22}}}$$ -The number of events are listed as -```{r} -event_tb3 <- tribble( - ~Population, ~"Number of Event in IA", ~"Number of Event in FA", - "Population 1", 100, 200, - "Population 2", 110, 220, - "Overlap in population 1 and 2", 80, 160 -) -event_tb3 %>% - gt() %>% - tab_header(title = "Number of events at each population & analyses in example 3") -``` - -The correlation could be simply calculated as -$$\text{Corr}(Z_{11},Z_{22})=\frac{80}{\sqrt{100*220}}=0.54$$ -The 80 in the numerator is the overlap number of events of population 1 in interim analysis and population 2 in final analysis. -```{r} -Corr1 <- 80 / sqrt(100 * 220) -round(Corr1, 2) -``` - -# Generate the correlation matrix by `generate_corr()` -Now we know how to calculate the correlation values under different situations, and the `generate_corr()` function was built based on this logic. We can directly calculate the results for each cross situation via the function. - -First, we need a event table including the information of the study. - -- `H1` refers to one hypothesis, selected depending on the interest, while `H2` refers to the other hypothesis, both of which are listed for multiplicity testing. For example, `H1` means the experimental treatment is superior to the control in the population 1/experimental arm 1; `H2` means the experimental treatment is superior to the control in the population 2/experimental arm 2; -- `Analysis` means different analysis stages, for example, 1 means the interim analysis, and 2 means the final analysis; -- `Event` is the common events overlap by `H1` and `H2`. - -For example: `H1=1`, `H2=1`, `Analysis=1`, `Event=100 `indicates that in the first population, there are 100 cases where the experimental treatment is superior to the control in the interim analysis. - -Another example: `H1=1`, `H2=2`, `Analysis=2`, `Event=160` indicates that the number of overlapping cases where the experimental treatment is superior to the control in population 1 and 2 in the final analysis is 160. - -To be noticed, the column names in this function are fixed to be `H1`, `H2`, `Analysis`, `Event`. -```{r, message=FALSE} -library(wpgsd) -# The event table -event <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 100, - 2, 2, 1, 110, - 3, 3, 1, 225, - 1, 2, 1, 80, - 1, 3, 1, 100, - 2, 3, 1, 110, - 1, 1, 2, 200, - 2, 2, 2, 220, - 3, 3, 2, 450, - 1, 2, 2, 160, - 1, 3, 2, 200, - 2, 3, 2, 220 -) - -event %>% - gt() %>% - tab_header(title = "Number of events at each population & analyses") -``` - -Then we input the above event table to the function of `generate_corr()`, and get the correlation matrix as follow. -```{r} -generate_corr(event) -``` - -# References - diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/custom.css b/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/custom.css deleted file mode 100644 index 3054002..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/custom.css +++ /dev/null @@ -1,122 +0,0 @@ -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/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/figures/ex1-pop.png b/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/figures/ex1-pop.png deleted file mode 100644 index d335b8fb0d94588efe0360e9629cd19652b15668..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 25014 zcmd?R^;gtS{4f66WvQh*1r!A&S4t2hq@|=&SU|cKkdj)u1XLuXLrPk@7Z6aoI~I`c z2C2L6`}yAAzW=~I_ng_YuX)xy=P}QjdG5^XY~&j?1tKUt6aWAsB}G|H0Ki2803-(w z3q!FuglJ>F@DYjzZU8{s`QHcB<6QU-0KiY)sA$Wr7aEC{5( zzu&s<@BRJ#;Nala*4EwK-RbG+?(Xj5;^O%D`0DEF*x1<3&5hm9fup0N+uPge>1o^g zwZp^1`T2PQV$#dYOKMWA<@|>m8yjdedUkf!vElDR_Jf|Dp0%~Lg!b9V$;smGamy++ zH8u6w*;!wI|5Q3-_b2+^-d>wJbZG0sQt|V}GP#qJlV87n<^GzSuhbaosWva0zPh^d zZ(geE8C@>q0)apS{eN2j3=bzWjEsz2UtgznOpkOG&sCe+R!?NRQ(atK*j0@T{%P*) z9m2x_5B7G>)Y=hJGw$#2H~bzMZ~NTSH}J7-{)x0E)f3+M_;{<@Rm1GxN`X1m)z!U) z($n>>oSd8`{xoT6X=Cl*o;}9#s;qA*(l-4urXdDxY;5G!vT>lKbSVo9i;$`3O2L!L%F3Yf9}}%n zB_$HPfsT3T8Pir+_; z_X44(-*?jgeKB#wJv>oK_+q7K9&mcw@<}}a1dv?(sl$XO?SF+7{$G(of-nUD;rv(r zhw=Y1?|(q~|HtM39-e-3=iRLPLeW8LKK`7r>X^gtu=1RT|K=`-%DYKoGe>KeFSq;x z=63!VjRjPWmIrQeJzX?DAqJQ&(I**|lgaWIis`rT*c*3i7)&F5Qk zEW#WAoi_+x;*l6OP&DU!%Poa8OFw_R^xZ(vveq|xci*+Cbuni+X~8J1@9BU>qOf1x zg%%blEL8OUDqKuf%kiYBM&R|Hv!(YBR|z3e`fiPes$?QC;R)Bi5u&gD1#fNL0q1dL zR9_v-&NDoiZ^&K^N!8PatCZ;L9i|Pf*s6-QSp^(Wn3#OsgP<35sZCe?0S?{t?C!8? zb3!m--LTN=_tamjSzJF4gkrm0_|>{qH!g4?wEjJ<>IK`n))Tj5)S1OaUA70>LU^#7 z-^=5~?Si|8X01c??r9JiAJ-2A5ZYFcI;Gskl6My_Ps@5=yk>YJk6adQn%mhIe?8Cj z3`{tLrYDyElIiZL_C#Vs2^ON)mW~H28LA~9YVM>QM1gV5^2mk8xF_e}meN)KI5 z>nJ@FR8wO`Rs8;Z@zv1Iq;vHB2Yyma9WUIU-rID|{-sGl;Ish`gx1Pv(Tbxt*V?+| zqKK*IC+)n+E2No3Z2|Y2MeA+ECxax6FEVfEIEp+{PCt6+kXJkLK13ZJW_xn1E(H39->7Cx#ds>F180M3(#a)Lye| z?1WH*2_>0*!e^rdE)3$!h&nOj)l)rZzq@wVS&?pr!O_5#cgX4dn1yeHzv6KWaB{k* znqIwC(H^<7q#>^bXcN43WEE4({g@^S|_^5zlc;bslFod2w za#zI%S=AN~%DA4Z4SYzCZ)etih5VKpuVbBI`Er)$2_*U3v~VD<^05kUC9Vex%Gb+R z#;8?%Cm+Glfd^xzT&gV;Ux;Eq*Q6@NV?~Kew6d9AHW#U2cyZCreu7sWlJSR?!uYJH zd9l`POY6%!*Y}%5V9>f+3M!E6a;CimHI_>TcPfoG*NZ_X@mBg^G@rZ0^y)d69EP^I zdD{Ms2E*w2kG1rssPuf1P%<+@l`7lX`BHA~U2gCf-Wq*uFbF#y$s)noL&xew#4QU9#Vu42tuFOI`bpcw^CB4aHavTVuhUQYJ>h>UjRVL5( z2@fN0a`X5Mo7V7Av$PR43;d01wNxJ!>J!B>t1i71ilw0S<3I36By&GI2#gcAq`Zr% z!N?ZB3(=FpZt5-_?~&MK@NvdnHyRm8zY%PpBm=fX0OP&m&Mf%}eF#tP?KtURQf5JU znTg|rI>%iUm+4q|yKIO{WKl4oxmJcI$_&to_Q%BqxC||*^Vf-|ty|a`F^f~bgDZgy zgwWv{3@~&ck!A>ogNi)@(hH*HbjL|f2w{BJvV^rb*5jZ9K}$?CwA5`b{g0)-Tvm2G zeSk;Hh7>Z)0DbAnTre#$!K3|>c5QBogot^?$Pt2MH23;YWKyFKRCwq?SPgu@$3Qy9 zkI07x*R6kBf%w00T_Fge(r>@E(off56+@nsRvQSR%f_cjR^*?*J4PQ}0X;4of~fc^5B)4^NpEyZX}` zjx^gX;Sq3!z})+}1yVwgW+jaLm|E#gHpZLI`m8-Dyf^y^0jN_%*gxr9-w%L0NAAHP zgskt5Xc*dnVKb{Mnu2!^;j~0^*J&Qu0LXvWxr+Z0oL0D4d8b4eV5w@Y?)?{mG>d?_ zL4a9J!FVM++Azr5Az+xIF^3FB7}!P8m;pk|oU3jAeuaW5iXgCnM;#yxXgJ;5qab@I zAiIH#<%SRjEBbqGHGz@p{8h^IACb$-H;=EdkrHEQ>_Lp;aKN$H&?7K#%dd`MW|yZg zVSh0NE?w#SonT-b%p(gC4y1pO4^Sc6QSQfKg-3J<3$y_+{ksx`EHyYRZW@i^0%*ZL z3?=1ww5K-<4>88g^4i4$3@piDg$(71w#{JVL;f}u8H_Y9wK}o>0{}kFh^WHE@I(It zEgu}@h<46Jkt{15aaG%&@=5$>!rX_amJaC?&c)QuxR0aOoJ*SUXz#9_KW8s3yO`02 zJ(c|CENR<(#oRWrowusJ)vSB-D?y;n$To8(bw#l?^Q)P|pSV}ebY}epb1M}xk>~zJ zckJ-A1RMEavcqwir4t19e4<4X+wrS!8OYN7gOLyK3|er`?8g}8s2#qKJ-yPDd+JlFzBK7q(~9{oFk{QtmvZk2rTv<9{A3~P0n2Uy~YQ&lIhd}20JYu1h^z# z_{0?<$BKHBA@g^$cp`)S2TYYvR`gTL7=h>Ad}z0ag?%{*EoFJKJffP!H{4|i)AO1O zb#aXk(HOO!sZK&{5c{_lAzgDw|0Lf>ITZFXwt~8|^{ZmCvRQH(FT#X0``RzzCZVxx z@PoJrhcaK=sb1!8UU&qL0}jTuxqp_s986%|8s-n*cHNCQw{F5|c%q_Ca!>!})o(iX zL%4rON^(8&)x-1pV8)FPQm2@6xb2ojt)1t(-6zODj+BTbGF3j?-L0q#ye2)IPw?8t z2FZ}D>(v@0ksWFuI>s+u)Z<;&-WH8xnexgI@ctl)+dRo!7>laz%^2 zKpyQC50z}sT@$<2$MZ5bSR0N>#-AqdlnK-`kumD91L<{*{n#!{aJ3uGL-4%VxRziy z;cQv|+3;g{Z&F7J71vtgV3}HK&y`v{tv=P31`=CZD@u3MolZk^gdQS`>U8oXR}7muUru49G#e?oa7p~JI)n<(Skc)X;pb!Zne-+ zHhnKFa5r^GzGnxI7mGsHEbD?7RzRSgoZs(9O$r*{Q0nY)N_MbXTdh4W76NAo-i}@} z_K;V|xdi$QW$P@&Zz<{8AS_-Zts^kwbqyFegCn+nK?4j)Yak(c zQbhK%S-aI-PnV}>MCjm$V=;qAR1#0xs};U8&*U$f%Bg@qO3 zX+d`Wku-LA+wB~G3nB*((~2Q#mV3ah3~H)F-UgEdTci*y83-^mYQ1` zH+<*ElWMJhHs@W7BYrxq?>x;S`JH$Qi36&))cAW_HeR!e-&L&VDDQ zJqv8Tf|bB|B7bTF)GQ(aJgM;c^X#0anlz{zs{pgu{oT1hn*N30O}Ef#u5RaYQA=Xb z2*fpgrE8>Zl$iQ7>_?}kN!*ug+mc#7#JMfVb0Iprq-@KiLGCbU{3Baq=h#dugppA1 zDQ1qZXnjNxuz{Hba5-o(s~p8?DhH@8z9;$)+xSS>i0@`3`^S{US7qf_-WS@BYo&Gc z`u`Fn<(=wb`v&Y4qzt+JwC0)M%D+zceT{Ohe+}Bn{p6e+g0#p&6Y07@(p0ENoVg** zdHvdXFVQ9LXCIjMJ9I3Pk|x&7%kld>_8hwBmQN{$zdA5!u~(TFA5~DLeBV<>6@^#z7*n6}>ZG!lK(Bqlj6IZ6;CY$W{^K?X-rOm#xScV>JN$pu#c3HjmMH5% z*(z>y^DERpM9mY-8ipsb2+b#rL5}bdzCk_dgdM--J2N>wX%yb7Ns#K% z(6Bq6fYvkB({-?58^`bLbiu7%3!n8ev?oA(3rH&@jPsCZ7@y9A$Y8#uXWK~A@xOSN zCcNP$-dGhMUN2h|8~?OIw06I!EggN||>3dkggc4~HzCHFH; zb4kLr5MZ^{A$7%QqAb5POE(9H0wJ_0n`1tltgKg_O`pv?{}qS2*XpfIT?NZx%^MHr zIrmC^KFWUsud;t$%iUsmvXxooM9PctZKQeoo9;V0*JvGlR3G{#V0}8#`nC&eH%ZRf z!pmq=)kQTt#xp-Ie1M>$eDbn&72R{v28i=DS4w-ry(kU@R@--z@D8cMn{=l?kCCE( zDo7(ON9fRE5+G{D=Lgpb0;sD1Kg*kmu7mCN-z59(ZwFVUdK+ThKw8=~cVZ*f0a?fld6=Mc%X7W<3c z%%Mr%yOd6XmqSVW?5oZmn@{P`E2>;emv*lmzquC!KJpR_l4n;iZIVNpRsTWfsJ4&| zW`yP=lpf>$PRHbMx88#UQ7D)@p)pak^_l`6UUQ-A_VhI)JZ_^cH0g5QTerHsn+kO9 z<$vWmMf!Q5AW2!nwI`N_nV`*JIq|3~rS+v`{%y_J#(NcL1^Z<_V*37^PGQ~Imv1Ou z|GmKV#Fav`Dr;nqA5o|JQ}zC(hSzg=$jy zmYVBFdaf4z7nYih#?E%p3$sKLyJu5zHA0=&;pOEw^9K^16NCYG6&^3<7fZH2Fbi(Q z?f9JStS>ZSl+!8IW9)+$Gf%=j4l@ZR#QZP(>+^S3ms29cjkY;h(hX`O*ieI8@F}H2 z^wk+(Ao#WIeijyFnk>eIR}yoMlbU4x1+U`P>lhD0i~jZ)yo(yO<`pA_OZ5cVfE{vi z5+#BGEbAXW-Z~FKwSVGuc|}O!Sy>5sROE0mNVBm63rgylGpjobiaPq|ITS+6u`DsC zMGohxA*tAV41Cpoj#|`*O#iIW+x5W))&_(t>7xOo9G8eb0-%ilS1BCaKVS+VUNNg< zQ^4b`Grf;#0M2%;cF450W3xL5;2fWq7s9JhYGihi21%{Gm|;l)QUev@0Cbqw<47Pi zEBL?XZY!}(T#(f{9gvnBZe`C6?%x#vU?i%@yc9pHJpsTMcT$D|Z4~L@dISI`!;on! zqLzLMEY!u2Ocft4sP!9)G>HgE4!q6AKUAeQtwH<&kOqeOALWo-Z+*LR+W`0@CMX+< zyA=#5RM18PrsWw^Od#aekDV<7kkt_tAOh!*vcN-JS;yhj%K|7)Eb-5nK_?2Bxq<@R zU>h-#*=5o5uyLy>lVcekooDe1J$ERJT9#MP6dF4+*9Jy-)`XKkPL|EN+5aM07IR*r|keNiH#q?CC#`c7$iXM5-cb? z`@aJi`R|i1;F6ypH5Y(%0s!e!`vtR-HUnvOZ7G}xFidQ=?)uMCK4ot z=VyX|bGISEY9ny}sQ~c1T}Vu;@iD5z9|y1{B!ye{dy8g*q?i^(!6jiXCVmh=^Vl48MOWwK@n7fKNLjnva6}9pt&VtsrSby;0Do`kMlm`0~E_drI2eUA#-g2%gaz_2p0p|M9m0zBh80VGX;=X zFXr$o#B*fQDuJx1Yz|Ojmq=XzNb2FlDny@HHLV25N@N3b2Zm7(Y6EXnm9aq7{#QEe z8&82kg_b=1AK1xjdO#N2TB7+=YBY*_g99kE6_!GFoqdlLpaisarlgT_UHf{!QwXP=*7Zk_~uV`M2*@-(BPqn|AtH{6g|%nsS#3;m|SXX^6k(tL{I4)BQ2 z3yr)owz9mod7iGuM*dlmgOZ*hH6vqjyXc41(B$dq^t3()Wuz>5knD6vnwd*>EYt89wDX= zG7V#S$gQ8-V$MAS!Ulq8L-Bd)GCjr&?Q4debPNgxD)rS24BnNCvFIEiP`crj=j_Y&-V6Q zj=hehW+-mjCD|Eyd(g(770zJrvU_$|r0bqbNKgU4LXqD4M)8==%CVv;UL}M(-AH)m zG&yl4xBn){$U2!uy(*RJXQL%<_Z4LiEmfatLeJ-MJOpkW^Pd-e;^ppo412nNO02oR z6GaJ}@X}Ef9519B2Y9Jl%@*qO9X*=LO52{rtKjgu4)R?dDBWdy#2@3yMNbj_=nt!< zOd3hK_Ub~^dcl-}9)9J=6wDd!{Yt*pz_;A*uFEZqE3zNN3i`)SSH4QDEYufN`#Z`q zTG<)0wLp@40yJE_J*$t;wHtm<>dWpE^YLATj zBFMD(_S+}BfH-(RvuXN!9dG6L$#P>kJN7Inhqgd|YF7oNKT~?&8Z?y|h=&L=m&bnw zAheIqblA$qQ^vzO=b5OJPK{g@nb5c>dPwTQ+2YM2V)RIKYuwdq zc;MoLv#+yA6TLNzo3i0~*B4RLi0+_-w932D&(FSmXlg&y82pSIuBBxb)>6krcx_>P z7G$%>hEntDKaYP^?HT&inu4?0!a7t-OGQ-6%(7pC4Rua1Y}&JtCeTzpHC|b9CNTQ1 zJ}E($O;=>!T7LEjjEh&XcU!vN>^A(xzb(lo#dP_N>)g)?gJ+VfCR`=u-3IAvh1&qA zR*&`89Wg3OXI`3+P+aw>i7uY~yO!3G#-yP^!wdT___pi>^NPs5@$Q{C#%J+!W}`Ft z__kwV9nbDruuPlSz9-H68vO>2qk#V_J}+@&doY{x@tio+v-O}1fe;mMl&0Ndf(kG@ zN-CME>&peWv|wAMKk&(wd3WJK@co;+$D!@AbfT38Tn9@fz%iDuuawa=C85|=@ z7cC4{3DAMXE4vNpjfWa2Sn4YDbo|nr4mHp!iOokrA<1`!&MO=pcGlT3Pjq?b$4elEvWSXyB=B`78?cnJFcj?SMY3}oJ) z4c%9IK7XlW@|Lk%*_E7-5e-m<&|*_$;j1~s&Q+jWBt-5pId-6+8WYPDF&1oyFMjmyI zUW(-_zUnwh>~QB$h4&c1qczTGAOi_j8)(FuuGREZ&<`(D+C!n(?b$ zwTfRAHNY>hQ*8Hjr@Y3mbLL{PV7IT`EPkY5P+xzByGj5u|9DSsNjv`B?}{otwCW%; zn~S*Y(+T4|$B84@=@Y)GcJOEG^U|qSM#iajJxFe|d+!TkPHIb2C$7;yIFabUy79v=!|IkI-lD)+g>%&MSoh*LPd+Dy1WS z1FLv?vovHXd@!lnn%C*AfD5J5T(|mMDGnNqtWv6LtH`xD=%*fwVEI4q0+1ap9s!*h z4IesdV{F8Ik4h$J&);Fsk5u}O@l7$|AHrmgz$R6|hq#y}Q-_p~Qvw6$YYT^8J*&q%$2;_dQ|LQ7I#xKAB9^(##&f0tk_Qbq zQy++^qxRFkgn#a(I_!_)E7+K>^3yvq9|~^0x!a@XrhLFh={M&en_=+nAvy#1)4JdD z7MG*M@Yt1s8wtO$7mC_Bt1gQvy(Zt-;h;@FVv_}-69zu7vl4f7p={6UXDMACjZIDL z=B?DN(sORFyz>(BboNhqX`kohqJLh!KNko!i4X^SmYuuApo_j?+fI^g|`KCM>T zhK(O?L(WE)+2jvk6n^q-jrRGx6o{#5p!CehWv?M*k`G(&bEL^6;eMhVm>Ol5>}J?@ zbb4*xq{ERZnO%**9LXQR(JZ==80L0tkM$O}$?^8JZo3T*?%%H)Um7i9kxgcPzY9jO zjlSr8(WCt6>CFw@56gB3@0(-k_9Q*JG|uzStbHZb{%FK~^cx%cZ6&Cf;1((ozB)Ko zSIY4QA-=D5xZh84==Aa5Ymc!5w|{v{x3RKX2vpHy=wgfpxHizj`JbQae_pw9F;c3u zpJ~iX#CAZ$9kIga_--{}9A2i$DQs{e_`d;dU#HN}AS_OOzRP$O(h3|zK!k~$ibR{E zoIIm4qcVd?G*SpD8Q8EC;nr4q_y!@1eceJhio>gfVna#}TKpsG={%ltdQ&mMxV70& zdKjy6DJ;>Uqs+d#RkxcL-{RO~UX4gQh9CCmv%tBse9(>TG#xG_^XxR@W1oUq>sr2^ zk_qEq%1o9Z7eB`|Ngf*r_WB|a>d^@X5pR;@&o>6_W zF@4kPC%2z;z`}vm$|o0LyE@J52Oh2jR1sQ6aA0n-7~Qn(E^NthD& zE_$prJizQo{#O@6DWwgzJ+>ao7VK||JjWT8Z19g6>^NGv)+JZL#{H#@_$;?MM48nm zb0!KuyE5P++a3lL1WjZUaK8%32j0@_>166;_La*B7>W$esa=r}Q&fPfcdK@*#0CFm z;|`4zg6_M6_?Gz`79;Ata}&tjH@(CU-!2s)0yUnzE3`4o0V`YZDP?N=Af|` z;xw&Mp0|FJuRkgye!&t=XD^gCJwAZ=uAp~uUGYaEx+g1t$`JUm;cH(H40?IdXJpLn z%s1N;(p3t)?Xb^+Qu32-1oba>7%o@;*`ITu&yxJ#1_i4|j8~IVihO6UGafJ#UqPRjkJGu70 zgPGjVX%1#@82S8a25NcR-4TDI0>3Yhq=6Gr{J!rle^V&IKD|eYmh?Tv-X+7?;@aXe z;Qnp?07gKE-JH^T;~PBK;iCTUHC>~yxTZ*=I%a?>Lk`rS4L_XAyh|OCX1~W#36ZScx%%PpcwV|U&=tKLeU2}4 z>~90@sSk}uR~JN-t(U!|b8_@&M9$K=5G~-rf6(B|s>>=4>X7U{%O}Ce=WZE$qDR(8 z);RJXVedybJ`3;AAe!RcZho&S9IXsVRu!~-74?4qaBb*)!P^$3n+Y<8nNHFi4xv|Q zL_;x$l3E@}XF5q}cuxQkq=0Qr>hSd*SdA|5{NF37d-{7JQU?}&(nfxebsETD$$HWm z2Fv+8f~s;S5LqQJG2Q$aK$jf2>hffH=xpl;b{c}<^zDo24bz=+TH0`8o{j4klM(|| z@eRS9B^-t*D$(Ued*5N-^TTNCwb{0*4(acM0_bQ7jd|@Spk7}B+S>>Tad?yd7-EYH zJiaHyDE)qw)HnP-56mQVPjLO5mUcZ**{WI-q`vl|d*gj~8yt>9+^wAsRy!x`OuUU> z_WIpM_>n~9iv!=ORRTCe)jcfk>Ul;$OB)Pmj-ebzH7v@flxm=MieiVa+m1xmZ%uK! zW7F!tZEyIryaE-ZNWbW5JM!v{30{^Ap^jBBO_hc6ptS`Q8B9kF>aP#f`+uV@X)oIP z1S18t(vdwB50<*hFS!}{yj&3C4>2pFZ>zOL>k2@V-N`|ypO)W3-72o7zbdBJB zYBRtHL!N~Zl0Y2MUVptGc$Gc^F%P-g)NQH&1VQ>i`pcpwpOIopgZ((YNIW>cdG54mKRg)3CL`W(#c-7E@ti8jRanif&fvPNFSaqP}yPwpcI=(d# z7$yTmj#w}x4^;;etZ6opgEH0lK_wtY5_QrP9Qio$*Zf4{x{=6u?JQLw6$rD1kD=^_ zUu7Ea4OSgkTt24o1Lj~b2|b{)>c_j=kX z{ZxueN`}mktdTd7ll1U)klP1U>myx+q7>IF8S;NxCBJA8VM%zU=!zh$NteGXvSIFw z_RHAfDd?|dBL*V-l^O1g(*$)CH`Q@rG>7K5;it)%^~fRhG>Y@piGeup`2Acf?OT)p z>scHS@W*=j5HFjN`dl$69ACjIh`_7tPEx6D)S#IRj?XR1{o8D>*BAksYQwRY0V{(E zT=nVP^p|w*PbBD!QR&<2n>ZLi28}wni1pB3+;i(7B?W7C$Q z3`BJ>w7lP72|HZesJZrK@Gg{aPNea#4IC8L1a$r$E3g|K971Ay5*hIesAZcJ3@r(=dDSuox=zL^QK&HM%iiYbqF8e=NjkdSoDC0yEwcU#>!= z)kWpXg49!_gXkVdn0=Ft>VNkJG?m`oC~a-^i6tylCOonDuE>;-6a7O#pGK}iwgN-+ zd{z>#so#a~Rk|G@SGUQ{*dtr<3&WV;QjmdqRc#AY;=Ev*lnO@)mw1i0kbV&Ojx1gb zt}!Ff70>vRN-uaG%&HRy<_o1f40#Br6oTA@&A&ofABkw4l;6rKg31e}WU%S&hV6zc z4I(+v=Mhjr?W}B^Qk)0kI19ua=v>ZW4o<96Fb^(~=%$1|0SEdAGuAnI1ypc6>nP)g zDYgXT8&qyB0!2++C|!V-9cU7f$AWrgubg9z(Y1OaXbI`3W_%--zHLc@f~=2G7`ym9%gxEU%N8c}as$iboE&r(TFNhZYqDDO>_ zaT6!#>LFiC^`=}a^?3pjwGgfGb^E=kr$%7~`e%~Rw zHQ+{el^d=P4toNJ{f6MM(gX?(Li}?Wk<2pGFxq#Z;Pywbci>{@xCE?gj=U7nbU>pL60i3n034xeC>9%4ajxunybrZB*2w8s={nW1{xNo=eWj|8>9mCE+g4@X-X_%b?`9sCE>1rv z#n%@d>sNZu$KpJC{k}+J<~`l1Ko@XhykvCb%?St-vf@;J@fpnm`Jz~a7*O)_9#K0e zgGrd3lAm#1l@9^X6s!NViA9`~B}jMtSCmHW!htR$YO|PG!*W=#AB{W0_ZTbrNX+i* z6c|2L`WPTF-aN+wnlirQ!2f8F@yA4KNazuwoVR?qB)nRHRh;2HAXAe~1rUGTy&TK0C(vTA_F_z~;Pos>-%8szxRh3y3dPZC zAHpL**%xaG>@NR^RI3pLSKJgv%uLNnoM&?2pbI|X`04>P$|uDsE;N93?MRVP>3_Za zgj3@F2tkf~K-pqm)q|I}@e^3wrnBveAi+X$eeBI=2TST;8g~ji-LeNCnpEFa^CJbs z6!Bv;j@EzwFc2%JowaFd6mUshuN6n`ZR^zORyF!eH|~y@t26UG>-OsfRv0# zloBA%M^c$@d;E?c3uQ#~$o!Pw>)5L0S&V%WbWeVv|9L*PHxOr?G>~Q>xm(v~4y^l- z38q&q=$mQ(+EsRBzK+9;h1i>L3r9fSpw$`^uxlAmErjyIVU!OU`o;dli*I&3q>ehB zhck|w<|EZU^_@V4pHXz)%YmvH=!^GDnlWo2fdwf)Uj8|0En&|THe>+ET|}4?wV}QF zA;!vxCW!Ux-zF{`^xIc=<1Yx?LT(Z39!o8=4#nvN@5anzXWSTIv)P?ESg6o!I%S_1 z&s7gR|F-5m=)8m%<*n9s|{0fzOIXf%KOa@Y*mVo~soEl$jrt>B2M$ zsLBXE=X1BQC#%B;Og;Z>Ip84o@E=mwh+k}sL~@n}Sv3XzGuEzDc(cYbfOpvj2)^WU zc?_cE@ffVgC$lp|M+ubogAYaTo;lty7(1Iau6QupZ;6fExW}grS^?9h*2Fxf`L3a} z)zFkZ?CsIa<+faqHGcAQPS2m18x|1CzBZ{GA2r=D0rI7mLp>lV!}aKvc=_u7FcAhA zl?j}fck_C)w0;J`8WV*)B_}27`Ga_sfqs|H^A=dyYbWK24lK{agvYFK)JzzdcHjYt z$Ukm;AQ$hFIr-h6O%mwfc-cco!W$z;V~vj# zHK~8AQjPMNaW%5q)JZ3s;boxW2<@tV4xmVWnG{0MHbh=?c~)zbt3NF*WCcqccQ>UN zQ8q=Mn!lC}jZ<*@-8#?j-yU#($Trv;I|T?6IH;;GMu9_oY^^w>SV3f^5IRG7pjQZI z{YIp>L};79cC3<&UkwjqqE56s{(YbF3DVny@@8q|?$J-V>_e9ubz@-+LQ5bdGahnj z@?7m^V-dt%6qFIpQARG%KqG=wp8ioeLxp>YE!~^G8G!}QVDKR2Rq$@5*#cb-A*+b6 zVV084p9H^ZNUO6_*L5cP({B9(oR*)RWQ!n2z8?y;U+?4r>)sl8otEl*&0OEJsp%3_ zaS!JJG_HAoHZIDa3Gu96g=UGl{q}hSE$EWd?kAX$093Dxm$N}8I|HmYn#Bvr6#4^j z0Ko|`;s2%R0vS7f`Dyo2$AU64Rt7Nr@=b!r3}9|7XEgugT}y~E=7YW)AT`|YuhpCw)O4Z1b4NhJ_>?_;% z`d9!KQVwujPYetQHp#ES!9(?EpJN-Iv%Q5X>(bBo<7i_G*K$OJ>L5qK07mSt& zA%d6DFd=i5tluZsFMSy{=*ntnaR#1yrlZ|J){N5f?qJbT z36Yx?1fhKSpkFgYlbY+fggG(TzyN)JfiT0!mw8POwm*t#x7d(`a)Ikp0eCAzp}Me) zTFBgg2u1-+6D^Lo&__V*UKb4AzjY4g*w^afPLrB`Oad?Xh7qSJjE)py(d4@i##X=v z2mu^G8LK`zGL_F<)6OHl2Jwm*Zg!N`)4=ch$ zQ)DY>U4TDka$p_diW}4*4(Ep4+;wCjy0*QFO54KOGv9s}wt)rDX zqFQvVeq)A@<>lk=^0kv9paEEKGSjMj2G9cBP;^=ZUhx`Dqs?Q54}wTH_Dfjf)Cs<+QFC&e0da%Z?B0)#l5jDdzd7jtYQLt{`7Aa$$M#=}vcafaVPzp!5hzrv?X_wHj3c*iy_Hm=@~dAdHM_ zaaUWFRorT#MBVCJ5-_5!xv-`ijBQ%zJ5N?8VgC)|JAhk=^GyU6a0A=TV*=Rnvn&AW zjG*&Abq|MURD%E8)@uz;8zWoL^bwcfhP65AXGle)s&o&~pB%*W478h+InNwjlyzki zfu--NokjTsxHOyA`=KUHandjRuw#2zbA1mpk-33P`d>{OV695pc?Ao24$ z9Qvp-H(sm?iqsn(^ds(^yav42Pk}mpKz@$Q>@uTQO_~NlmPm@URKOOtKOnfnx}?- zx%cnW(rC_KAm0HnBKWJ2I<~C71D`C2`z2?^gKR^X)X+J{Zk(>n;1VSBCn>Q-FjH;MH0a;H3ciFJ6(Nj&mPbG235H z2mGK#X4?3$OK6dyOd8cAp9G!TOV1HTQ2$ZSfB`C46R$bt{ELj zp^&^&lmjy5#0fj*b8V<;jgonE33JWEb$&Q>Jf}x#V{eRo7stf1Je*GY#?`d^H-;cleBdNV2Zy!Vq#wdVPL{Kgkmzcw(*Oid%XWLw<%8W zbQxKt_48TKA1uURHx|03Pz$#_j>;6P_OLl8Clo|Wp=yCymn*G+dje#B%B>I;VEWVZ zyXgbeDkGEc2L^niN5Dpp7cd`ZzG%@bp=%tH(9`sFhZgBF@*aX&CCvd7GwqOFF~7`z zrkE71?zDx9dHy+a#7e>X3vhm_F)3Vo+8Df*H81jBT1@+OuI|T;`EBl|$)6t?AK_h$)Jo=;hgo`Cw@ zFhd=-_vvdDW?x1`*Stlrc&<3eWCC#9u8Q^j-!t^gxk+dI#PD1R24_($zCj{>_rAi{ z@+XZII`tky&)o=tBsUY9_p0C3<)5A8t;#;E(y)!kY@iPz=)7F8&okIw!~ge_C7TVo z$J%V}MjQIiR?+L_hF(8UYKeKQ4t{a4>1qFYoqA2M96WO!f)sTsp+mii)*O1ls03s@ zd;YqS0$B$ox-mQ>OT-^{Hs=}18#=nPq()--@-2#<2Pmjj;5Fk#9F@k3nBalDwhE;l za_7I)B1C0w`f#;sP@ul`8))zN4Y6su+z%}_w8;B8y3A`JJlW&lu?asfZqWaN|M7KA zd*7x~5WV`?-(QbSvVt@<#p$ zl4t4AMx_pZ3G+^T%ekTb{lBfywR^X6FP*|y!XE%9?cz7wvg*{G$_baNx~S(Tq%Y4))<0oo5EQse?b`c!gBb7QD^8ezKlhq zwxh*RNss1Qg4L^R&y9fA8JO?E))ZH1-Rcy9(UkM$dYjnPrNX^eg_+k*@KWO4Z|94! zIuoxL=r?|SrxPsp5nQOzHdt6R zGz1y{OQ}h;O}@CpagjOB(qsO|A+j7 ziyhun{w(CP6NDRg=-F^^D6;r056>nH8x=3^^G{BIgxYZB!?&G1v{8&=|ySPohADJ>T;L_BcY>24eyZ z718h!`N4rU={(X$S*w7t^iXJXsK_Z4T0epim%j@e`ip*vlaI`{qxFw`7$PqX@}!Fm zuXG=l5Q&@Cz653daT#@Ob*7*^r0xSXL=OGk^#3?hD1{}Xc%UZz24&mnrbzhcSp-Bo ztG$aFR zw13~jY#dc0`a-GTVCehJB+81li%*5pTERG+!{}`A+m^adKRD4rTgi+))*t+a#eYkY z2o7W2mN|T;M5q|V;x~y*cY(CC%szYf8Hv2&w1d`no;u6*9DZXIhjIfxS!cAc^zCa| z>@=YV3D11D{R`qh82sEE*hY@{SK&Bwb@7*b~St?$npbT{g0RW6I2y@yd?-~3`kpavANg; zoV{do-mNmasM}gBfp%f;mrko9h80;~-mA?Hp4|Qf@Be&2Yl2NZ-_`zDGslb|k%>K~ z;ELA(#4OB2$M!i{7EFxlXZdCoUxKvg_Oj8(E5#+q76oLmXDr44Sm%@>eMG@n3UD;g z57JLCF#|D}cD0k~A5kZ>!f-Lvv=AZ23F^Z{6dA1u7z-CpjLLB!qeeKa;Sn+h24Z1k zREgy*L3IcSPAm!qO2&fep=xLS_Q}yq&kOFC`r%z5T285r z!YfFCz9DLzJy1p@40wAY4*<-}|NSq(&|i^G`OUxW)HW}1`U@^p#;FmLz9C+eN}ud6 zd2J5~zc9_IC95A8xPUyr#l5*Cz~B_=8A#FH!-zbawvcS{j3lUUY4?qg_h1zib;@pj zcl7c_{OXFw$)A?&x5lW-p*ub$f=iV+HxWJ!T=@I^9_j0b7QP<@^&|eDXywc)@oA;a zA%B=+j={Vl5u*@4{Zlj01O5M1&UZyM83pV92@oPpLhncyL5LDckSa~2iG^N5ks?w; zlWyorl_o(tD2P<0_W%M4p(DLYRayY4QcgT)owe>d>pa|t`*zpb5A)B=KeP9qz4yG# zd@ZsSf}HOULz*x){mR(wB?)BNV5Ay3(_nBlQ~gKrg&=Y?MK;ml_B93BiiJRA#jLW$ zj`Xz!!K+|9?zh)AJFLl>nuKV)QSyb~F_@7^Io02m$J(we$G5ig0qUJj*j3~62U8df zr)Y->2c!V117o|c^avxRDrG`TcoX?RKaA;pIxm9EAqOyzW9)O@*tXd5t)Mw zIl(mR4Nr2Mcu?Gu>$Hcwh^Rpv1@0#MsZA z%^^Os=YB^sv)=|$xvuWLPgk9Lejm3bEFH|=7&kbI5=KxP5tyirDqV(sKFua$Y|7KW z4ZTw1W2y-5xRx0j^u@=uN?@TWdvI5(;+kBq5(%Oym@h8TXAVmYp*|sw7lG{OQ)8<@ z-PD!6zgX`;ET@Uf>sA*v$qlA9s&T6X6-V4Ol4PjJmnxwxa0nj@%}hopsThl8xh3PA zeuO+x0X6z2ERt=$X9z32vMZi!6*T(jqF>z~%yqx&g5WhB8zFo zJZ%v5R`1y-V3&7agWiXhCBD$8y1u|_c#Fz|1&cFmt|U`%7oF42Zh4nj+qIr*1}jux0#q=5Xq7yu2u7cz!amK!hZ|z zerIQL+w8z$h<+F5ZHJj}Qr7iZD*XyKK)^@t9W%$tXpgHDkZnHa7TEu1Uwpsywx{Ye zc-x(2#4Wot`S~)g^_p6t#$|-m5;zVSuP+}Ld_aZorD9ytIxFtZ>DJDS9wU=mx>aJe zD69S`v^L?!s^xRR?wU|B`hyr>P@#kvN$+1=2xK)7b+(c0n|;yuzK?R^7ffbzI(BHe zE<#>0qcvXwDHczBSJcTi_nBnEUJtUVFEWQHwCaZceIG ztAP0a2E;{BvPqw}ASY!_TaA5{>3JaED(| z#$37sW!V^cm#_;(j~KpNabJ(c`Cptl3_81)b%W{@z%K6WOK^3GDvnu%%1F@4hjZUC zR~Hv|K2+omc!Wwv0V|%JG%m9tQpDdSHc&J&p}Bv5*6k&vj6{zwaGa?d8{&N39IOaq?NAeQI##HnU6c zcU z>71}$R~%2DTi3_6Xe3-$8KEX}e$SuF{Z^nJcOot72gk*3^Kq;9e@Rw}b(z!1J9{3k zyEZ!@?hvCuw%Kyk3HH`~ofZ3mLm<92IeVop;0={oH%*Bw<-~3WPEDIr&Cz`(mpOV# zeAZBkCCY+~!}OIxv(dX|qgu4stf8kRYmUGvBRtSZ96J#`wETOpmMh=fTaTjBDG}c| z5&XnW6m|5s;%)s)&JRWCh+zJ>)`sqRdD~fLgvJ0kjxzv6#s8fv1TEfe84>^f*Q*vX zxjCFPjt8p(@3#E7vYWb?FTmE7Nhx!<4-@4MslT!+h+PtYe0i9s1Y;5+7j~A zWtgUPoF*`IN!;ykv8Ldb1rGgcVByIfghU&jl(O%_{fsf={KLr!qY4bPe_iF4hiKRE z9a77sV@ftNyTjU7&sA}^YHIfcnyi1bOy{o1?6}=Q6qo;5=Rh4ift7ASvAln7bYbr$ zF7=pmDTI6-;Oa{>k9LfP9+Mfjgs0GJB5ZCYs2;Flhi@9BO(9$@ujwjM zRfu~iA@-7o$8348mO&l{YOSGf2rbVWeFEpxG$Zpkp)|WNNNhoXgEH?%?c^;#AsEjI zk2X@Yw5^Db2JWTy&JVw*fPu=bBd+En=rw+IB|ai#dYE0@HTN&ap55%$R>cW8EcRaS zV3{=vnKhcvwftzg!{{&6JH!rySKix!L?aoPJ>&|GD2$rgNE0J4HZ8&B`2i{jiZQ2G zEzv>2V{58IZ{neKRIveEPHq`#{C0_h;!T>Zp;Zdy$~LOFr<3@j&tuwj6igYK4G}@P z-e&5pPQ!FCH(#k;vEeC-me(Pyly(H>o?oeL^VN>CVVHV|dfRoDbMWawASgo#?tntsemS(@W;oPKK9+zxYpu7p*Dw9;!HP5<}HCDuFBBs`-{V`}IM#QalUN68#U? zYlG`io%IV}%U6$C&cAqfTrVP4m5R&1w(|wLrdRY;M}_rmdbD`oEI@84)v5BPz77w5 z^+lBF{j-s-Z)MVUMmo+@2-8+&aiLxM{^&9M;{zim!d(Al##-&huSxW#(Ap`n3ml(6 zn8muM^g-sG;sebfvYt2dzn%+&m;4kS4A+n~9kOD#8aEzksC$W${f_XP&|N-~|;=nWpQ2^@a9k$ToMeY)b& zDpCKK6dP*v9HLU&hZ@UTsV}ZPaKeE^OG!8u)k=&F^L#T@vf^9A8|nI{B%B7ACJab@ zR+&F1#-vXg=IuDLi42v3rJB920yM2Ir1-GGhfsAvEl3OgUQQpKOM_jLjuhuP=Z+=Rn`fOZEPAu>rVWE z!nfi!?H~c&Af%6E_D5bEN4Omum3+ZJ-khxUp3@A-0R%GekIAktY}01< zBg@s6vFSKkl(_R()<;}BE=8{;o z(Z)Uh41U1qv-C=0U{0${1iX2WWF&Y0SM!K+lC8d@KHzb`93c$7*#@-Tts`=0{&V;#s z4x~x%`Lq79{o*7s6XUK)?1rYv9T$u0*2})KN6n_-!Xqy}@4)j~pFC(q`P?mX8r-jnfoD|(8~rDR z?Hh_FlBrgbCL>;Jq}j|=?^|~mK!^S`+QFf+Z+{T^;zuXwr9Y+fn;*@D+NWlvtY?uQ z5A4zBj4UV$jvOY_b~cyOmaPW-+Y0sFl?2UGCj*ReIE`#OK1}kJtN+{i7%08v-&6lQ zs2iMYmEV8>v(uBQdb&3G^RG^raU6}~KA!Y8mXBiFu)>e<_ zRHph<)R9NCdtOzae@D7Bt6lTybTrXU&6BR&u;#_~g(4f{ z$eqfQ3x|oszxn3L9{rvZpJ-g?bbCynmK%mVIXSpZ?1W2AxL(u|uN%1&o4wy7wqq$f zlZlU{zWmtHM!mvlX9z>xRAr6+Srf@_xKx1VDYM*=)s@4o}GyRR6eOhGPP+7%`lZzr7sAkuV`rCJg zR_i4(J?fqe=>ER_VC=J9_S)AU?l%neZ12~a)cEXg3+`vkigmxE=J|UfLPApV46XhF zebc+3Gk!@|B3quuBla|~^R-K*A{RAVxKwM;fXPf|Ro&XxV;6~;qHX>Lr2QBFzUSkJ z-FHN<--ChikEY>^xbNszVz1OxC`)DS0 z`E4;XV%+v;_B{L+&J0@f+;8RvB7;9Zt7|E!yU1N3-K#yotY}8B+VlLPAEEHb zTp~oG#QJe%5y${Wqe6l~8}LN|8}Y6Z0LCg0($(`7C{7}ShyYldMO7Fo&Kd-O?PhjG zl1T9Sq5wR?x4S%s23~Fr!ti+OY$bmN8JIpNCBgVmnnnT9NftKCV9fK+#PEWD9I`e7 z*CsEBsqHrBZ9kAwS;s4098nhtc}h4erv@3^xzz;+?j_IYlNueyE- zY-|9++rcnFl(NEPm9GuR5fI^;uR!9S1*YrM0H>1{#4O>d6;0&{4E9=&wy+tqpi)-p z!-1TX<$7M6!GzJ%DiVx>fiwfChD`hs7$a8V>z@cH7NeOcfvO7gN2C*C`g5IN%-~Jc z(!Mv%pjC5G0BRnf0YkBG-97|e({7ZK{`Q*~?JK}t1}zcr^P6J)ASI*CrT|sURG^Do&qPHSKv21@V*@3mzdhE413oTRuUlvrvV~ptQ^CO8l-NUNuw3}ftQ7#b znrZ%!35<{B2cT>(;-Lgl>BPh{V$U*j;*2~mu5$L?l=<=i1eh_IS=okxR^dzlX>5lf zsgIc4RcgTH>oJj;bp#*d*%$=iJHI8wEn%p!ToC4mJy^6)ATWmm+cjYM8)z zin#qq2rwUAd7_00b*t~}3rMQC~}sm#4gyPY{-##$yICh7(q zBviTUOSo-gg<0JP_bZGaE-$mM;5A)b64R3QfisihC`6LWME2oG>Ni)K1u^%1LyToF z$qAId^3F2y;uxG;z3Cqh0;~ov#2H|m7+ZG>w+#~eOvz*}1*UQwML0NC4 zOirJWbkxR}@YMi%H`{)+>#?)cs0p-!<<$P3ZLU#MjU(sTi^zQP0t!JaCC=+Vs6kl> z=Fngs_bo$=J+71=5Bjs1F@4I2N^h&q1$=Irwu13j zH)0n7pUl{Q^rb>Tq)^0oadES^tUyx%j4>y*c1zj_f@*L3R3)$R?JQBq<2_49i6G)#v3t&WDsIaF&NUnOtnb;HqOG-=x6B>&v@NDFpm4y2XFpefV zl!6oYXavoI|8JBlf)SbjD6X=;T6N}y@tS(_ za#E}i(pglEMA6buOtAETK%9kq^m~Kn({V_3_I>|gUznL$R1Q6t>Y;LX_L$3E7zfbH%HBChp@Vwxmf3C z10$E-6&hbq7GL_i$^i-5)N8i{+vND$Isn*Fw;yYqzI{@P<0I#6Owwv>Mm2bhz1z%Q}VN2j-^1~Qe2)A&PLVb zy~1s-f%q1ysX=z` zalY2iL#?!$5W+a^M;qzX@P$)Iss4RTTA3Es_dN;3J|VmX&5zTb>sjGvN%mN7AkLIs z=L!1(3i>Rvj1+s~3{CA)ST}T>HpHYA2Ch}#Uw2-tUq4jm0oir2w>w1-4R*KhPt}wI zD(rSzB)m;Mw<&MR@!`&pusC_cE9Dg)KUqPm*=5R(yi@}jr*GSS+zSQvB_a`fb_lsn zsi>=6ETq^MRf6pVg1O~*EGLprLvaipI|6;n{0#EMR2~_>&2cs<1v7QLTnM-ChOSG zj1FWs`e;$+h?-noYPWB1;wv-AjxNsXvA<+A%xElO=L#=Q8~^D_^b|1Q_Cswwn3@z@ zBwG?1>ueQKyV!VTtc;b17|1|VAA7t#i?UA^chvmpa{j1cksO^#6b0RzO@V(>NriRlw;s0Qls?KXkiR3 z%4gh)lW8tt)oNt!y;~;~6rrabu@vyAn0#K}b#LOI0dXTq^T#GhtNSATPe&)W)G&*U zPQyAZlWeQ`>CO5RMra~1ZZNAwq+Lgo;s&+zAuo>5H0hS&Jj=FvDOzj%bSxU^(Bc?r z`k0yQ-Ci%YH#$xNL-|x6GN`5%irPD-tF?WV#P%JKyBRSVgwe%dT>qSEz`w}^k+#ADb9wti)Rw>5L>O>sQ!=vzD z!_6Pivo~(+MEA9@yaGBHstO5Q))GH?27GoFsX70tC5q|1uzcrj;B>FBcw4K_++(+# z9u&bUW42UrTVUJ2-86jn$FCbiP+-UMujiiQOyXdwroPwHUd*cLs!`cVv$phPvkj8- zWT1#6!A{>Q;Vp)jFJIKosMh}yBVzFyOgB~g6nAo$Zy%O6#4h2l;Ru1ny^`A@pC;)V7>mh*3RT^iH-|bBe zJ8Z6n(@QJ9{_{hndlh#i`yU1a9R$As^KMt={%tj`U%9_Kn`tu9=hvY`v6AHiz5L{x{mW(*FQFCkpq>mGdr`{jMGh96;gz4Gf5cH~ - %\VignetteEngine{knitr::rmarkdown} - %\VignetteIndexEntry{Procedure to compute p-value boundaries by weighted Bonferroni} ---- - -```{r, message = FALSE, warning = FALSE} -library(tibble) -library(gt) -library(gsDesign) -library(dplyr) -library(wpgsd) -``` - -# Example overview - -In a 2-arm controlled clinical trial example with one primary endpoint, -there are 3 patient populations defined by the status of two biomarkers A and B: - -- biomarker A positive, -- biomarker B positive, -- overall population. - -The 3 primary elementary hypotheses are: - -- $H_1$: the experimental treatment is superior to the control in the biomarker A positive population; -- $H_2$: the experimental treatment is superior to the control in the biomarker B positive population; -- $H_3$: the experimental treatment is superior to the control in the overall population. - -Assume an interim analysis and a final analysis are planned for the study and the number of events are listed as - -```{r} -k <- 2 # Number of total analysis -n_hypotheses <- 3 # Number of hypotheses -``` - -## Observed p-values - -```{r} -obs_tbl <- tribble( - ~hypothesis, ~analysis, ~obs_p, - "H1", 1, 0.02, - "H2", 1, 0.01, - "H3", 1, 0.006, - "H1", 2, 0.015, - "H2", 2, 0.012, - "H3", 2, 0.004 -) %>% - mutate(obs_Z = -qnorm(obs_p)) - -obs_tbl %>% - gt() %>% - tab_header(title = "Nominal p-values") - -p_obs_IA <- (obs_tbl %>% filter(analysis == 1))$obs_p -p_obs_FA <- (obs_tbl %>% filter(analysis == 2))$obs_p -``` - -## Information fraction - -```{r} -alpha <- 0.025 -event_tbl <- tribble( - ~population, ~analysis, ~event, - "A positive", 1, 80, - "B positive", 1, 88, - "AB positive", 1, 64, - "overall", 1, 180, - "A positive", 2, 160, - "B positive", 2, 176, - "AB positive", 2, 128, - "overall", 2, 360, -) -``` - -The information fraction of $H_1$, $H_2$, $H_3$ at IA is - -```{r} -IF_IA <- c( - ((event_tbl %>% filter(analysis == 1, population == "A positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "A positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event), - ((event_tbl %>% filter(analysis == 1, population == "B positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "B positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event), - ((event_tbl %>% filter(analysis == 1, population == "AB positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "AB positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event) -) - -IF_IA -``` - -## Initial weight and transition matrix - -We assign the initial weights of $H_1$, $H_2$, $H_3$ as -$\left(w_1(I), w_2(I), w_3(I) \right) = (0.3, 0.3, 0.4).$ -And its multiplicity strategy is visualized in below. -If $H_1$ is rejected, then $3/7$ local significance level $\alpha_1$ will be -propagated to $H_2$, and $4/7$ will go to $H_3$. If $H_3$ is rejected, -then half of $\alpha_3$ goes to $H_1$, and half goes to $H_2$. - -```{r} -m <- matrix(c( # Transition matrix - 0, 3 / 7, 4 / 7, - 3 / 7, 0, 4 / 7, - 1 / 2, 1 / 2, 0 -), nrow = 3, byrow = TRUE) - -w <- c(0.3, 0.3, 0.4) # Initial weights -``` - -```{r} -name_hypotheses <- c( - "H1: Biomarker A positive", - "H2: Biomarker B positive", - "H3: Overall Population" -) - -hplot <- gMCPLite::hGraph( - 3, - alphaHypotheses = w, m = m, - nameHypotheses = name_hypotheses, trhw = .2, trhh = .1, - digits = 5, trdigits = 3, size = 5, halfWid = 1, halfHgt = 0.5, - offset = 0.2, trprop = 0.4, - fill = as.factor(c(2, 3, 1)), - palette = c("#BDBDBD", "#E0E0E0", "#EEEEEE"), - wchar = "w" -) -hplot -``` - -```{r} -# Get weights for all intersection hypotheses -graph <- gMCPLite::matrix2graph(m) -graph <- gMCPLite::setWeights(graph, w) -``` - -```{r} -# Set up hypothetical p-values (0 or 1) to obtain all combinations -pvals <- NULL -for (i in 1:n_hypotheses) { - if (i == 1) { - pvals <- data.frame(x = c(0, 1)) - names(pvals) <- paste("pval_H", i, sep = "") - } else { - tmp <- data.frame(x = c(0, 1)) - names(tmp) <- paste("pval_H", i, sep = "") - pvals <- merge(pvals, tmp) - } -} -# Get the weights for each intersection hypothesis -inter_weight <- NULL # Create an empty table to store the weight of interaction hypotheses -for (i in seq_len(nrow(pvals))) { # Each row in `pvals` is 1 possible interaction hypothesis - pval_tmp <- as.numeric(pvals[i, ]) - graph_tmp <- gMCPLite::gMCP(graph = graph, pvalues = pval_tmp, alpha = alpha) - weight_tmp <- gMCPLite::getWeights(graph_tmp) - inter_weight <- dplyr::bind_rows(inter_weight, weight_tmp) -} - -inter_weight <- replace(inter_weight, pvals == 0, NA) # Replace the empty hypothesis as NA -inter_weight <- inter_weight[-1, ] # Delete the first row since it is empty set - -inter_weight %>% - gt() %>% - tab_header("Weight of all possible interaction hypothesis") -``` - -## Correlations - -The correlation of the 6 statistic (2 analyses $\times$ 3 hypotheses) are - -```{r} -# Event count of intersection of paired hypotheses - Table 2 -# H1, H2: Hypotheses intersected. -# (1, 1) represents counts for hypothesis 1 -# (1, 2) for counts for the intersection of hypotheses 1 and 2 -event <- tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, event_tbl %>% filter(analysis == 1, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 2, 1, event_tbl %>% filter(analysis == 1, population == "B positive") %>% select(event) %>% as.numeric(), - 3, 3, 1, event_tbl %>% filter(analysis == 1, population == "overall") %>% select(event) %>% as.numeric(), - 1, 2, 1, event_tbl %>% filter(analysis == 1, population == "AB positive") %>% select(event) %>% as.numeric(), - 1, 3, 1, event_tbl %>% filter(analysis == 1, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 3, 1, event_tbl %>% filter(analysis == 1, population == "B positive") %>% select(event) %>% as.numeric(), - 1, 1, 2, event_tbl %>% filter(analysis == 2, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 2, 2, event_tbl %>% filter(analysis == 2, population == "B positive") %>% select(event) %>% as.numeric(), - 3, 3, 2, event_tbl %>% filter(analysis == 2, population == "overall") %>% select(event) %>% as.numeric(), - 1, 2, 2, event_tbl %>% filter(analysis == 2, population == "AB positive") %>% select(event) %>% as.numeric(), - 1, 3, 2, event_tbl %>% filter(analysis == 2, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 3, 2, event_tbl %>% filter(analysis == 2, population == "B positive") %>% select(event) %>% as.numeric() -) -event - -# Generate correlation from events -corr <- wpgsd::generate_corr(event) -corr %>% round(2) -``` - -# Boundary calculation - -## Boundary of $H_1$ - -For the elementary hypothesis $H_1$, its weight is 1, namely, - -```{r} -w_H1 <- 1 - -# Index to select from the correlation matrix -indx <- grep("H1", colnames(corr)) -corr_H1 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H1 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[1], - n.I = corr_H1[, ncol(corr_H1)]^2, - alpha = alpha * w_H1[1], - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H1", - `H1 p-value boundary` = pval_H1, - `H2 p-value boundary` = NA, - `H3 p-value boundary` = NA -) -ans %>% gt() -``` - -## Boundary of $H_2$ - -For the elementary hypothesis $H_2$, its weight is 1, namely, - -```{r} -w_H2 <- 1 - -# Index to select from the correlation matrix -indx <- grep("H2", colnames(corr)) -corr_H2 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H2 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[2], - n.I = corr_H2[, ncol(corr_H2)]^2, - alpha = alpha * w_H2[1], - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans_new <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H2", - `H1 p-value boundary` = NA, - `H2 p-value boundary` = pval_H2, - `H3 p-value boundary` = NA -) -ans_new %>% gt() -ans <- rbind(ans, ans_new) -``` - -## Boundary of $H_3$ - -For the elementary hypothesis $H_3$, its weight is 1, namely, - -```{r} -w_H3 <- 1 - -# Index to select from the correlation matrix -indx <- grep("H3", colnames(corr)) -corr_H3 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H3 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[3], - n.I = corr_H3[, ncol(corr_H3)]^2, - alpha = alpha * w_H3[1], - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans_new <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H3", - `H1 p-value boundary` = NA, - `H2 p-value boundary` = NA, - `H3 p-value boundary` = pval_H1 -) -ans_new %>% gt() -ans <- rbind(ans, ans_new) -``` - -## Boundary of $H_1 \cap H_2$ - -For the interaction hypothesis $H_1 \cap H_2$, its weight is - -```{r} -w_H12 <- inter_weight %>% filter(!is.na(H1), !is.na(H2), is.na(H3)) -w_H12 <- w_H12[(!is.na(w_H12))] # Remove NA from weight -w_H12 -``` - -And the boundary for $H_1$ and $H_2$ are - -```{r} -# -------------# -# H1 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H1", colnames(corr)) -corr_H1 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H1 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[1], - n.I = corr_H1[, ncol(corr_H1)]^2, - alpha = alpha * w_H12[1], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -# -------------# -# H2 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H2", colnames(corr)) -corr_H2 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H2 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[2], - n.I = corr_H2[, ncol(corr_H2)]^2, - alpha = alpha * w_H12[2], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans_new <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H1, H2", - `H1 p-value boundary` = pval_H1, - `H2 p-value boundary` = pval_H2, - `H3 p-value boundary` = NA -) -ans_new %>% gt() -ans <- rbind(ans, ans_new) -``` - -## Boundary of $H_1 \cap H_3$ - -For the interaction hypothesis $H_1 \cap H_2$, its weight is - -```{r} -w_H13 <- inter_weight %>% filter(!is.na(H1), is.na(H2), !is.na(H3)) -w_H13 <- w_H13[(!is.na(w_H13))] # Remove NA from weight -w_H13 -``` - -And the boundary for $H_1$ and $H_3$ are - -```{r} -# -------------# -# H1 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H1", colnames(corr)) -corr_H1 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H1 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[1], - n.I = corr_H1[, ncol(corr_H1)]^2, - alpha = alpha * w_H13[1], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -# -------------# -# H3 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H3", colnames(corr)) -corr_H3 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H3 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[3], - n.I = corr_H3[, ncol(corr_H3)]^2, - alpha = alpha * w_H13[2], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans_new <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H1, H3", - `H1 p-value boundary` = pval_H1, - `H2 p-value boundary` = NA, - `H3 p-value boundary` = pval_H3 -) -ans_new %>% gt() -ans <- rbind(ans, ans_new) -``` - -## Boundary of $H_2 \cap H_3$ - -For the interaction hypothesis $H_2 \cap H_3$, its weight is - -```{r} -w_H23 <- inter_weight %>% filter(is.na(H1), !is.na(H2), !is.na(H3)) -w_H23 <- w_H23[(!is.na(w_H23))] # Remove NA from weight -w_H23 -``` - -And the boundary for $H_2$ and $H_3$ are - -```{r} -# -------------# -# H2 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H2", colnames(corr)) -corr_H2 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H2 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[2], - n.I = corr_H2[, ncol(corr_H2)]^2, - alpha = alpha * w_H23[1], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -# -------------# -# H3 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H3", colnames(corr)) -corr_H3 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H3 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[3], - n.I = corr_H3[, ncol(corr_H3)]^2, - alpha = alpha * w_H23[2], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans_new <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H2, H3", - `H1 p-value boundary` = NA, - `H2 p-value boundary` = pval_H2, - `H3 p-value boundary` = pval_H3 -) -ans_new %>% gt() -ans <- rbind(ans, ans_new) -``` - -## Boundary of $H1 \cap H_2 \cap H_3$ - -For the interaction hypothesis $H_1 \cap H_2$, its weight is - -```{r} -w_H123 <- inter_weight %>% filter(!is.na(H1), !is.na(H2), !is.na(H3)) -w_H123 <- w_H123[(!is.na(w_H123))] # Remove NA from weight -w_H123 -``` - -And the boundary for $H_1$, $H_2$, and $H_3$ are - -```{r} -# -------------# -# H1 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H1", colnames(corr)) -corr_H1 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H1 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[1], - n.I = corr_H1[, ncol(corr_H1)]^2, - alpha = alpha * w_H123[1], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -# -------------# -# H2 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H2", colnames(corr)) -corr_H2 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H2 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[2], - n.I = corr_H2[, ncol(corr_H2)]^2, - alpha = alpha * w_H123[1], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -# -------------# -# H3 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H3", colnames(corr)) -corr_H3 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H3 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[3], - n.I = corr_H3[, ncol(corr_H3)]^2, - alpha = alpha * w_H123[3], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans_new <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H1, H2, H3", - `H1 p-value boundary` = pval_H1, - `H2 p-value boundary` = pval_H2, - `H3 p-value boundary` = pval_H3 -) -ans_new %>% gt() -ans <- rbind(ans, ans_new) -``` - -# Summary - -With the p-value boundaries, one can get the Z-statistics boundaries by `qnorm()`. - -```{r} -ans %>% - mutate( - `H1 Z-statistics boundary` = -qnorm(`H1 p-value boundary`), - `H1 Z-statistics boundary` = -qnorm(`H2 p-value boundary`), - `H1 Z-statistics boundary` = -qnorm(`H3 p-value boundary`) - ) %>% - arrange(Analysis, `Interaction/Elementary hypotheses`) %>% - gt() %>% - tab_header("p-values/Z-statistics boundaries of weighted Bonferroni") -``` - -# Implementation in wpgsd - -The above results can be computed in one function call in wpgsd by using -the `generate_bounds()` function as - -```{r} -generate_bounds( - type = 0, - k = 2, - w = w, - m = m, - corr = corr, - alpha = 0.025, - sf = list(sfHSD, sfHSD, sfHSD), - sfparm = list(-4, -4, -4), - t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1)) -) %>% gt() -``` diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/wpgsd.Rmd b/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/wpgsd.Rmd deleted file mode 100644 index 4771094..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/wpgsd.Rmd +++ /dev/null @@ -1,591 +0,0 @@ ---- -title: "Quickstart guide" -author: "Zifang Guo, Keaven Anderson, Jing Zhao, Linda Z. Sun" -output: - rmarkdown::html_document: - toc: true - toc_depth: 3 - toc_float: true - code_folding: hide - number_sections: true - highlight: "textmate" - css: "custom.css" -bibliography: wpgsd.bib -vignette: > - %\VignetteIndexEntry{Quickstart guide} - %\VignetteEncoding{UTF-8} - %\VignetteEngine{knitr::rmarkdown} -editor_options: - markdown: - wrap: 72 ---- - -```{r, include = FALSE} -knitr::opts_chunk$set( - collapse = TRUE, - comment = "#>", - error = TRUE, - fig.align = "center" -) -``` - -```{r, message=FALSE, warning=FALSE} -library(wpgsd) -library(gsDesign) -library(gMCPLite) -library(haven) -library(dplyr) -library(tidyr) -library(reshape2) -library(gt) -``` - -# Background - -The weighted parametric group sequential design (WPGSD) (@anderson2022unified) approach allows one to take advantage of the known correlation structure in constructing efficacy bounds to control family-wise error rate (FWER) for a group sequential design. Here correlation may be due to common observations in nested populations, due to common observations in overlapping populations, or due to common observations in the control arm. This document illustrates the use of the R package wpgsd to implement this approach. - -# Methods and Examples - -## Closed Testing and Parametric Tests - -We aim to control the familywise error rate (FWER) at level $\alpha$. Let $J \subseteq I$. The intersection hypothesis $H_J$ assumes the null hypothesis for all individual hypotheses $H_i$ with $i \in J$. Closed testing principle is as follows: if for all sets $J \subseteq I$ with $j \in J$, $H_J$ can be rejected at level $\alpha$, then $H_j$ can be rejected. Weighted parametric tests can be used for this: @bretz2011graphical, @xi2017unified for fixed designs or @maurer2013multiple for group sequential. - -## Consonance - -A closed procedure is called consonant if the rejection of the complete intersection null hypothesis $H_I$ further implies that at least one elementary hypothesis $H_i, i \in I$, is rejected. Consonance is a desirable property leading to short-cut procedures that give the same rejection decisions as the original closed procedure but with fewer operations. For WPGSD, consonance does not always hold and in general the closed-testing procedure is required. - -## Group Sequential Design Notations and Assumptions - -- A set $I$ of hypotheses for $i \in I$. -- $K$ group sequential analyses, $k = 1, \ldots, K$ -- Single endpoint - * Not required, and can be generalized -- Assume tests $Z_{ik}$, $i \in I$, $1 \leq k \leq K$ where a large $Z_{ik}$ is used to reject $H_i$ - -## Correlation Structure - -- Notation - * Events for individual hypothesis $H_i$,$i \in I$ at analysis k denoted by $n_{ik}$. - * Assume the same endpoint for all hypotheses (can be relaxed) - * For binary or continuous outcomes $n_{ik}$ represents sample size - * $Z_{ik}$ is standardized normal test for treatment effect for individual hypothesis $H_i$ at analysis $k$ - * Denote $n_{i\wedge i^\prime,k\wedge k^\prime}$ as the number of observations (or events) included in both $Z_{ik}$ and $Z_{i^\prime k^\prime}$, $i\in I$, $1\le k\le K$. -- Key result - $$ \hbox{Corr}(Z_{ik}, Z_{i^\prime k^\prime }) = \frac{n_{i\wedge i^\prime ,k\wedge k^\prime }}{\sqrt{n_{ik}n_{i^\prime k^\prime }}} $$ -- Proof builds on standard group sequential theory (@chen2021multiplicity) - -## Example 1: Overlapping Populations, Two Analyses - -Following illustrates the first example, which has overlapping populations (e.g. due to biomarker) and is also example 1 in @anderson2022unified. - -```{r, eval=FALSE, echo=FALSE} -library(ggplot2) -library(ggforce) - -ellipse_data <- data.frame( - id = c("H1: Population 1", "H2: Population 2", "H3: Overall Population"), - x = c(0, 1, 0.5), - y = c(0, 0, 0), - a = c(1, 1, 2), - b = c(0.5, 0.5, 1) -) - -ragg::agg_png( - "vignettes/figures/ex1-pop.png", - width = 1920, - height = 1920 / 1.618, - res = 96, - scaling = 2 -) -ggplot() + - geom_ellipse( - aes( - x0 = x, y0 = y, a = a, b = b, angle = 0, fill = id - ), - data = ellipse_data[ellipse_data$id == "H3: Overall Population", ], - color = NA, alpha = 0.5, show.legend = FALSE - ) + - geom_ellipse( - aes( - x0 = x, y0 = y, a = a, b = b, angle = 0, fill = id - ), - data = ellipse_data[ellipse_data$id != "H3: Overall Population", ], - color = NA, alpha = 0.85, show.legend = FALSE - ) + - geom_text(aes( - x = x, y = y, label = id, - hjust = ifelse(id == "H1: Population 1", 1.1, - ifelse(id == "H2: Population 2", -0.1, 0.5) - ), - vjust = ifelse(id == "H3: Overall Population", -9, 0.5) - ), data = ellipse_data, size = 6) + - scale_fill_manual(values = c("#E69F00", "#56B4E9", "#999999"), guide = "none") + - coord_fixed() + - theme_void() -dev.off() -``` - -```{r, echo=FALSE, out.width="90%", fig.cap="Ex1: Populations"} -knitr::include_graphics("figures/ex1-pop.png") -``` - -The multiplicity strategy is defined as follows. - -```{r, out.width="80%"} -# Transition matrix -m <- matrix(c( - 0, 0, 1, - 0, 0, 1, - 0.5, 0.5, 0 -), nrow = 3, byrow = TRUE) -# Weight matrix -w <- c(0.3, 0.3, 0.4) - -# Multiplicity graph -cbPalette <- c("#999999", "#E69F00", "#56B4E9") - -nameHypotheses <- c( - "H1: Population 1", - "H2: Population 2", - "H3: Overall Population" -) - -hplot <- hGraph(3, - alphaHypotheses = w, - m = m, - nameHypotheses = nameHypotheses, - trhw = .2, trhh = .1, - digits = 5, trdigits = 3, size = 5, halfWid = 1, - halfHgt = 0.5, offset = 0.2, trprop = 0.4, - fill = as.factor(c(2, 3, 1)), - palette = cbPalette, - wchar = "w" -) -hplot -``` - -The event count of each hypothesis at each analysis is shown below. - -| Population | Number of Events at IA | Number of Events at FA | -|:---------------------:|:----------------------:|:----------------------:| -| Population 1 | 100 | 200 | -| Population 2 | 110 | 220 | -| Population 1 $\cap$ 2 | 80 | 160 | -| Overall Population | 225 | 450 | - -Table: Number of events at each analysis for each population in Example 1. -IA: interim analysis. FA: final analysis. - -The correlation matrix among test statistics is as follows. - -| $i,k$ | 1,1 | 2,1 | 3,1 | 1,2 | 2,2 | 3,2 | -|:---:|:---:|:---:|:---:|:---:|:---:|:---:| -| 1,1 | 1 | $\frac{80}{\sqrt{100\cdot 110}}$ | $\frac{100}{\sqrt{100 \cdot 225}}$ | $\frac{100}{\sqrt{100\cdot 200}}$ | $\frac{80}{\sqrt{100\cdot 220}}$ | $\frac{100}{\sqrt{100 \cdot 450}}$ | -| 2,1 | 0.76 | 1 | $\frac{110}{\sqrt{110 \cdot 225}}$ | $\frac{80}{\sqrt{110\cdot 200}}$ | $\frac{110}{\sqrt{110\cdot 220}}$ | $\frac{110}{\sqrt{110 \cdot 450}}$ | -| 3,1 | 0.67 | 0.70 | 1 | $\frac{100}{\sqrt{225 \cdot 200}}$ | $\frac{110}{\sqrt{225 \cdot 220}}$ | $\frac{225}{\sqrt{225 \cdot 450}}$ | -| 1,2 | 0.71 | 0.54 | 0.47 | 1 | $\frac{160}{\sqrt{200 \cdot 220}}$ | $\frac{200}{\sqrt{200 \cdot 450}}$ | -| 2,2 | 0.54 | 0.71 | 0.49 | 0.76 | 1 | $\frac{220}{\sqrt{220 \cdot 450}}$ | -| 3,2 | 0.47 | 0.49 | 0.71 | 0.67 | 0.70 | 1 | - -Table: Correlation Matrix of Test Statistics for Example 1. -Identical numeric values (lower triangular) and formulas (upper triangular) shown. - -## Example 2: Common Control, Two Analyses - -Following illustrates the second example in which correlation comes from common control arm. This is also example 2 in @anderson2022unified. - -```{r, out.width="80%", echo = FALSE} -cbPalette <- c( - "#999999", "#E69F00", "#56B4E9", "#009E73", - "#F0E442", "#0072B2", "#D55E00", "#CC79A7" -) -nameHypotheses <- c( - "H1: Experimental 1 vs Control", - "H2: Experimental 2 vs Control", - "H3: Experimental 3 vs Control" -) -m <- matrix(c( - 0, 0.5, 0.5, - 0.5, 0, 0.5, - 0.5, 0.5, 0 -), nrow = 3, byrow = TRUE) -alphaHypotheses <- c(1 / 3, 1 / 3, 1 / 3) - -hplot <- hGraph(3, - alphaHypotheses = alphaHypotheses, m = m, - nameHypotheses = nameHypotheses, trhw = .2, trhh = .1, - digits = 3, trdigits = 4, size = 5, halfWid = 1.2, halfHgt = 0.5, - offset = 0.2, trprop = 0.35, - fill = as.factor(c(2, 3, 1)), - palette = cbPalette[1:3], - wchar = "w" -) -hplot -``` - -| Treatment Arm | Number of Events at IA | Number of Events at FA | -|:--------------:|:----------------------:|:----------------------:| -| Experimental 1 | 70 | 135 | -| Experimental 2 | 75 | 150 | -| Experimental 3 | 80 | 165 | -| Control | 85 | 170 | - -Table: Number of events at each analysis for each treatment arm in Example 2. -IA: interim analysis. FA: final analysis. - -| $i,k$ | 1,1 | 2,1 | 3,1 | 1,2 | 2,2 | 3,2 | -|:---:|:---:|:---:|:---:|:---:|:---:|:---:| -| 1,1 | 1 | $\frac{85}{\sqrt{155\cdot 160}}$ | $\frac{85}{\sqrt{155 \cdot 165}}$ | $\frac{155}{\sqrt{155\cdot 305}}$ | $\frac{85}{\sqrt{155\cdot 320}}$ | $\frac{85}{\sqrt{155 \cdot 335}}$ | -| 2,1 | 0.54 | 1 | $\frac{85}{\sqrt{160 \cdot 165}}$ | $\frac{85}{\sqrt{160 \cdot 305}}$ | $\frac{160}{\sqrt{160\cdot 320}}$ | $\frac{85}{\sqrt{160 \cdot 335}}$ | -| 3,1 | 0.53 | 0.52 | 1 | $\frac{85}{\sqrt{165 \cdot 305}}$ | $\frac{85}{\sqrt{165\cdot 320}}$ | $\frac{165}{\sqrt{165 \cdot 335}}$ | -| 1,2 | 0.71 | 0.38 | 0.38 | 1 | $\frac{170}{\sqrt{305\cdot 320}}$ | $\frac{170}{\sqrt{305 \cdot 335}}$ | -| 2,2 | 0.38 | 0.71 | 0.37 | 0.54 | 1 | $\frac{170}{\sqrt{320 \cdot 335}}$ | -| 3,2 | 0.37 | 0.37 | 0.70 | 0.53 | 0.52 | 1 | - -Table: Correlation Matrix for Example 2. -Identical numeric values (lower triangular) and formulas (upper triangular) shown. - -## Hypotheses Set - -These 2 examples each has 7 intersection hypotheses and the corresponding weighting strategies are illustrated below. - -| $H_J$ | $w_1(J)$ | $w_2(J)$ | $w_3(J)$ | -|:-----------------------:|:--------:|:--------:|:--------:| -| $H_1 \cap H_2 \cap H_3$ | 0.3 | 0.3 | 0.4 | -| $H_1 \cap H_2$ | 0.5 | 0.5 | - | -| $H_1 \cap H_3$ | 0.3 | - | 0.7 | -| $H_2 \cap H_3$ | - | 0.3 | 0.7 | -| $H_1$ | 1 | - | - | -| $H_2$ | - | 1 | - | -| $H_3$ | - | - | 1 | - -Table: Weighting strategy of Example 1. - -| $H_J$ | $w_1(J)$ | $w_2(J)$ | $w_3(J)$ | -|:-----------------------:|:--------:|:--------:|:--------:| -| $H_1 \cap H_2 \cap H_3$ | 1/3 | 1/3 | 1/3 | -| $H_1 \cap H_2$ | 1/2 | 1/2 | - | -| $H_1 \cap H_3$ | 1/2 | - | 1/2 | -| $H_2 \cap H_3$ | - | 1/2 | 1/2 | -| $H_1$ | 1 | - | - | -| $H_2$ | - | 1 | - | -| $H_3$ | - | - | 1 | - -Table: Weighting strategy of Example 2. - -## $\alpha$ Spending: 3 approaches - -The WPGSD approach uses all known correlations between tests in the study. This relaxes bounds and allows increased power or smaller sample size. Three spending approaches have been proposed: - -- Fixed spending (Fleming-Harrington-O'Brien (FHO) approach). Specify $0 < \alpha_1(J) < \alpha_2(J) < \ldots < \alpha_K(J) = \alpha(J) \leq \alpha$ for all $J\subseteq I$, where $\alpha(J)$ is the total alpha for intersection hypothesis $H_J$ according to the graphical approach. - -- $\alpha$-spending approach 1. We choose a spending function family $f(t,\alpha)$ and set $\alpha_k(J)=f(t_k(J),\alpha(J))$ for $1\le k\le K$ for all intersection hypotheses $J\subseteq I$. - -- $\alpha$-spending approach 2. For each elementary hypothesis $i$ ($i$ = 1, 2, \ldots, $m$), specify the $\alpha$-spending function family $f_i(t,\gamma)$ where $\gamma$ is the $\alpha$ level for the hypothesis and $f_i(t_{ik},\gamma)$ determines how much $\alpha$ to spend up to analysis $k$ for hypothesis $i$ when level $\gamma$ is allocated to the hypothesis. Then $\alpha_k(J) = \sum_{i \in J} f_i(t_{ik}, w_i(J)\alpha)$. - -## Bounds Computation: Parametric Test, Fixed Design (For Example, Two Populations, One Analysis) - -- Assume ($Z_1,Z_2$) bivariate normal with known correlation - -- Find $\alpha$-inflation factor $c_J$ such that - $$ \alpha = P[\cup_{i \in J} \{p_i \leq c_Jw_{J,i}\alpha \}] = P[\cup_{i \in J} \{Z_i \geq \Phi^{-1}(1-c_Jw_{J,i}\alpha \}]$$ - -- Basic algorithm code in @bretz2011graphical - -### Bounds Computation: WPGSD - Fixed spending and $\alpha$ spending approach 1 {.smaller} - -- Assume for $j < k$ that bounds $c_{ij} (J), i \in J, j < k$, have already been set and remain unchanged. - -- At analysis $k$, compute the correlation matrix of $Z_{ij}$, $i \in J$, $j = 1, \ldots, k$. - - i Initialize $\alpha_{k}^{*}(J) = \alpha_{k}(J) - \alpha_{k-1}(J)$. - - ii Set $b_{ik} = \Phi^{-1}(1 - w_{i}(J)\alpha_{k}^{*} (J))$, $i\in J$. - - iii Compute type I error rate up to analysis $k$ - $$ 1 - Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} \cap_{i \in J, j < k} \{ Z_{ij} < c_{ij}(J) \} ). $$ - - iv Update $\alpha_{k}^{*}(J)$ using root-finding with steps ii - iii until the type I error rate through analysis $k$ is controlled at $\alpha_{k}(J)$ for $H_J$. That is, - $$ 1 - Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} \cap_{i \in J, j < k} \{ Z_{ij} < c_{ij}(J) \} ) = \alpha_{k}. $$ - - v Set $c_{ik}(J) = b_{ik}$ from the previous step. The corresponding nominal $p$-value boundary is $p_{ik}(J)= 1-\Phi(c_{ik}(J)) = w_i(J)\alpha_k^*(J)$. - -- Note: interim bound does not depend on future analyses. Solution only requires root finding for a single $\alpha_{k}^{*}(J)$ at a time, $k = 1, \ldots, K$. Requires multivariate normal computation from mvtnorm R package Genz et al. (2020). - -### Bounds Computation: WPGSD - $\alpha$ spending approach 2 {.smaller} - -- Assume for $j < k$ that bounds $c_{ij} (J), i \in J, j < k$, have already been set and remain unchanged. - -- At analysis $k$, compute the correlation matrix of $Z_{ij}$, $i \in J$, $j = 1, \ldots, k$. - - i Determine what the nominal $p$-value boundary would be for each elementary hypothesis in $J$ for a weighted Bonferroni test in a group sequential design as described in @maurer2013multiple. Let these nominal $p$-value boundaries be $\alpha^\prime_{ik}(J)$. - - ii Choose an inflation factor $\xi_{k}(J) > 1$ and set $$b_{ik} = \Phi^{-1}(1 - \xi_k(J) \alpha^\prime_{ik}(J)).$$ - - iii Update $\xi_k(J)$ until this type I error rate up to analysis $k$ is controlled at $\alpha_{k}(J)$ for $H_J$. That is, - $$ 1 - Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} \cap_{i \in J, j < k} \{ Z_{ij} < c_{ij}(J) \} ) = \alpha_{k}(J).$$ - - iv After the appropriate $\xi_k(J)$ has been derived, the nominal $p$-value boundaries are $p_{ik}(J)=\xi_k(J) \alpha^\prime_{ik}(J)$, and $b_{ik}$ is computed as in step ii, we set $c_{ik}(J) = b_{ik}$. - -- Note: interim bound does not depend on future analyses. Solution only requires root finding for a single $\xi_k(J)$ at a time, $k = 1, \ldots, K$. Requires multivariate normal computation from the mvtnorm R package Genz et al. (2020). - -## Implementation of Example 1 with Overlapping Populations - -We first define the transition matrix and weights as shown above in Section 2.5. Next we set up the event count table as follows: - -- Analysis: Analysis number (1 for interim, 2 for final). -- Event: Event counts. -- H1, H2: Hypotheses intersected. - * (1, 1) represents counts for hypothesis 1 - * (1, 2) for counts for the intersection of hypotheses 1 and 2 - -```{r} -event <- tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 100, - 2, 2, 1, 110, - 3, 3, 1, 225, - 1, 2, 1, 80, - 1, 3, 1, 100, - 2, 3, 1, 110, - 1, 1, 2, 200, - 2, 2, 2, 220, - 3, 3, 2, 450, - 1, 2, 2, 160, - 1, 3, 2, 200, - 2, 3, 2, 220 -) -event %>% - gt() %>% - tab_header(title = "Event Count") -``` - -```{r} -# Alternatively, one can manually enter paths for analysis datasets, -# example below uses an example dataset assuming currently we are at IA1. -paths <- system.file("extdata/", package = "wpgsd") - -### Generate event count table from ADSL and ADTTE datasets -# Selection criteria for each hypothesis -h_select <- tribble( - ~Hypothesis, ~Crit, - 1, "PARAMCD=='OS' & TRT01P %in% c('Xanomeline High Dose', 'Placebo')", - 2, "PARAMCD=='OS' & TRT01P %in% c('Xanomeline Low Dose', 'Placebo')" -) - -event2 <- generate_event_table(paths, h_select, - adsl_name = "adsl", adtte_name = "adtte", - key_var = "USUBJID", cnsr_var = "CNSR" -)$event - -event2 %>% - gt() %>% - tab_header(title = "Event Count - Computed from SAS Datasets Example") -``` - -Then we compute correlation matrix using the event count table and `generate_corr()`. We see that the correlations not accounted for by the Bonferroni approach are substantial and, thus, might expect a non-trivial impact on bounds for hypothesis tests. - -```{r} -## Generate correlation from events -corr <- generate_corr(event) - -corr %>% - as_tibble() %>% - gt() %>% - fmt_number(columns = everything(), decimals = 2) %>% - tab_header(title = "Correlation Matrix") -``` - -Bonferroni and WPGSD bounds can then be computed via `generate_bounds()`. In this example, we useHSD(-4) as $\alpha$-spending for all hypotheses. Of note, `generate_bounds()` input type specifies boundary type. - -- 0 = Bonferroni. Separate alpha spending for each hypotheses. -- 1 = Fixed alpha spending for all hypotheses. Method 3a in the manuscript. -- 2 = Overall alpha spending for all hypotheses. Method 3b in the manuscript. -- 3 = Separate alpha spending for each hypotheses. Method 3c in the manuscript. - -Compute Bonferroni bounds. - -```{r} -# Bonferroni bounds -bound_Bonf <- generate_bounds( - type = 0, k = 2, w = w, m = m, - corr = corr, alpha = 0.025, - sf = list(sfHSD, sfHSD, sfHSD), - sfparm = list(-4, -4, -4), - t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1)) -) - -bound_Bonf %>% - gt() %>% - fmt_number(columns = 3:5, decimals = 4) %>% - tab_header(title = "Bonferroni bounds") -``` - -Compute WPGSD Bounds using $\alpha$-spending approach 1 with HSD(-4) spending. Here spending time was defined as minimum of the 3 observed information fractions. - -```{r} -set.seed(1234) -# WPGSD bounds, spending approach 1 -bound_WPGSD <- generate_bounds( - type = 2, k = 2, w = w, m = m, - corr = corr, alpha = 0.025, - sf = sfHSD, - sfparm = -4, - t = c(min(100 / 200, 110 / 220, 225 / 450), 1) -) - -bound_WPGSD %>% - gt() %>% - fmt_number(columns = 3:5, decimals = 4) %>% - tab_header(title = "WPGSD bounds") -``` - -Below shows the comparison between the Bonferroni and WPGSD bounds. Nominal level at final analysis by using the WPGSD method increased by up to 1.3× over those obtained via the Bonferroni approach. - -```{r, echo=FALSE} -# Combine and back-calculate xi -bounds <- left_join(bound_Bonf, bound_WPGSD, - by = c("Hypotheses", "Analysis"), - suffix = c(".B", ".W") -) - -bounds <- bounds %>% - rowwise() %>% - mutate(xi = sum(H1.W, H2.W, H3.W, na.rm = TRUE) / - sum(H1.B, H2.B, H3.B, na.rm = TRUE)) - -# Reorder for output -bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2) -bounds <- bounds %>% - arrange(Analysis, order) %>% - select(-order) - -# Bonferroni and WPGSD Bounds (Table 6 in the manuscript) -bounds %>% - gt() %>% - fmt_number(columns = 3:9, decimals = 4) %>% - tab_header(title = "Bonferroni and WPGSD Bounds") -``` - -Closed testing procedure can then be performed using `closed_test()`. - -```{r} -## Observed p-values. -## The tibble must contain columns Analysis, H1, H2 etc for all hypotheses -p_obs <- tribble( - ~Analysis, ~H1, ~H2, ~H3, - 1, 0.01, 0.0004, 0.03, - 2, 0.05, 0.002, 0.015 -) - -## Closed testing ## -test_result <- closed_test(bound_WPGSD, p_obs) - -p_obs %>% - gt() %>% - fmt_number(columns = 2:4, decimals = 8, drop_trailing_zeros = TRUE) %>% - tab_header("Observed Nominal p-Values") -``` - -```{r} -test_result %>% - gt() %>% - tab_header(title = "Closed Testing Results") -``` - -## Implementation of Example 2 with Common Control - -Similarly, codes below reproduce the result of Example 2 of @anderson2022unified, which uses spending method 3c specified in the paper. - -```{r} -set.seed(1234) - -# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ex2 BH ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~# -# Transition matrix in Figure A2 -m <- matrix(c( - 0, 0.5, 0.5, - 0.5, 0, 0.5, - 0.5, 0.5, 0 -), nrow = 3, byrow = TRUE) -# Initial weights -w <- c(1 / 3, 1 / 3, 1 / 3) - -# Event count of intersection of paired hypotheses - Table 2 -event <- tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160, - 3, 3, 1, 165, - 1, 2, 1, 85, - 1, 3, 1, 85, - 2, 3, 1, 85, - 1, 1, 2, 305, - 2, 2, 2, 320, - 3, 3, 2, 335, - 1, 2, 2, 170, - 1, 3, 2, 170, - 2, 3, 2, 170 -) - -event %>% - gt() %>% - tab_header(title = "Event Count") -``` - -```{r} -# Generate correlation from events -corr <- generate_corr(event) - -# Correlation matrix in Table 4 -corr %>% - as_tibble() %>% - gt() %>% - fmt_number(columns = everything(), decimals = 2) %>% - tab_header(title = "Correlation Matrix") -``` - -```{r} -# WPGSD bounds, spending method 3c -bound_WPGSD <- generate_bounds( - type = 3, k = 2, w = w, m = m, corr = corr, alpha = 0.025, - sf = list(sfLDOF, sfLDOF, sfLDOF), - sfparm = list(0, 0, 0), - t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1)) -) - -# Bonferroni bounds -bound_Bonf <- generate_bounds( - type = 0, k = 2, w = w, m = m, corr = corr, alpha = 0.025, - sf = list(sfLDOF, sfLDOF, sfLDOF), - sfparm = list(0, 0, 0), - t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1)) -) - -bounds <- left_join(bound_Bonf, bound_WPGSD, - by = c("Hypotheses", "Analysis"), - suffix = c(".B", ".W") -) - -# Reorder for output -bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2) -bounds <- bounds %>% - arrange(Analysis, order) %>% - select(-order) - -# Table A6 -bounds %>% - gt() %>% - fmt_number(columns = 3:9, decimals = 4) %>% - tab_header(title = "Bonferroni and WPGSD Bounds") -``` - -## Power Considerations - -The above illustrates the use of the WPGSD approach to compute bounds at the analysis stage. At the design stage, one can take one of the following 2 options: 1) The trial can be first designed as if the testing would be done with a weighted Bonferroni with conservative sample size estimate. At the analysis stage, the correlation can be taken into consideration with the WPGSD approach for bound calculation; or 2) To adjust the sample size downward using the WPGSD approach at the design stage, one can power the study by taking the minimum $p$-value bound for a given individual hypothesis from the WPGSD table (with assumed correlation structure). For example, for $H_2$ of example 1, this is $\hbox{min}(0.0011,0.0017,0.0010,0.0030)=0.0010$ for $k=1$ and $\hbox{min}(0.0092,0.0144,0.0081,0.0238)=0.0081$ for $k=2$. Then the $H_2$ bounds of 0.0010 ($k=1$) and 0.0081 ($k=2$) can be used to power $H_2$. R function for the 2nd option is in development. - -# Conclusions - -The WPGSD approach provides an unification of previous work on parametric testing in group sequential design. It enabled more complex scenarios and requires attention to consonance and intersection hypotheses. Although detailed closed testing is required, this should not be a deterrent. The approach accommodates various spending approaches and provides more relaxed bounds -and improved power compared to the Bonferroni approach. - -# References diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/wpgsd.bib b/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/wpgsd.bib deleted file mode 100644 index 0285346..0000000 --- a/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/wpgsd.bib +++ /dev/null @@ -1,53 +0,0 @@ -@article{anderson2022unified, - 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}, - volume = {64}, - number = {7}, - pages = {1219--1239}, - year = {2022}, - publisher = {Wiley Online Library} -} - -@article{bretz2011graphical, - title = {Graphical approaches for multiple comparison procedures using weighted Bonferroni, Simes, or parametric tests}, - author = {Bretz, Frank and Posch, Martin and Glimm, Ekkehard and Klinglmueller, Florian and Maurer, Willi and Rohmeyer, Kornelius}, - journal = {Biometrical Journal}, - volume = {53}, - number = {6}, - pages = {894--913}, - year = {2011}, - publisher = {Wiley Online Library} -} - -@article{chen2021multiplicity, - title = {Multiplicity for a group sequential trial with biomarker subpopulations}, - author = {Chen, Ting-Yu and Zhao, Jing and Sun, Linda and Anderson, Keaven M}, - journal = {Contemporary Clinical Trials}, - volume = {101}, - pages = {106249}, - year = {2021}, - publisher = {Elsevier} -} - -@article{maurer2013multiple, - title = {Multiple testing in group sequential trials using graphical approaches}, - author = {Maurer, Willi and Bretz, Frank}, - journal = {Statistics in Biopharmaceutical Research}, - volume = {5}, - number = {4}, - pages = {311--320}, - year = {2013}, - publisher = {Taylor \& Francis} -} - -@article{xi2017unified, - title = {A unified framework for weighted parametric multiple test procedures}, - author = {Xi, Dong and Glimm, Ekkehard and Maurer, Willi and Bretz, Frank}, - journal = {Biometrical Journal}, - volume = {59}, - number = {5}, - pages = {918--931}, - year = {2017}, - publisher = {Wiley Online Library} -} \ No newline at end of file diff --git a/wpgsd.Rcheck/00check.log b/wpgsd.Rcheck/00check.log deleted file mode 100644 index 3d59ff8..0000000 --- a/wpgsd.Rcheck/00check.log +++ /dev/null @@ -1,89 +0,0 @@ -* using log directory ‘/Users/Anderkea/Documents/GitHub/wpgsd/wpgsd.Rcheck’ -* using R version 4.5.0 (2025-04-11) -* using platform: aarch64-apple-darwin20 -* R was compiled by - Apple clang version 14.0.0 (clang-1400.0.29.202) - GNU Fortran (GCC) 14.2.0 -* running under: macOS Sequoia 15.6 -* using session charset: UTF-8 -* using option ‘--no-manual’ -* checking for file ‘wpgsd/DESCRIPTION’ ... OK -* this is package ‘wpgsd’ version ‘0.1.0’ -* package encoding: UTF-8 -* checking package namespace information ... OK -* checking package dependencies ... OK -* checking if this is a source package ... OK -* checking if there is a namespace ... OK -* checking for executable files ... OK -* checking for hidden files and directories ... OK -* checking for portable file names ... WARNING -Found the following file with a non-portable file name: - inst/aiprompts/s7 prompts.md -These are not fully portable file names. -See section ‘Package structure’ in the ‘Writing R Extensions’ manual. -* checking for sufficient/correct file permissions ... OK -* checking whether package ‘wpgsd’ can be installed ... OK -* checking installed package size ... INFO - installed size is 5.0Mb - sub-directories of 1Mb or more: - doc 4.7Mb -* checking package directory ... OK -* checking ‘build’ directory ... OK -* checking DESCRIPTION meta-information ... NOTE -Package listed in more than one of Depends, Imports, Suggests, Enhances: - ‘S7’ -A package should be listed in only one of these fields. -* checking top-level files ... OK -* checking for left-over files ... OK -* checking index information ... OK -* checking package subdirectories ... OK -* checking code files for non-ASCII characters ... OK -* checking R files for syntax errors ... OK -* checking whether the package can be loaded ... OK -* checking whether the package can be loaded with stated dependencies ... OK -* checking whether the package can be unloaded cleanly ... OK -* checking whether the namespace can be loaded with stated dependencies ... OK -* checking whether the namespace can be unloaded cleanly ... OK -* checking loading without being on the library search path ... OK -* checking dependencies in R code ... NOTE -Package in Depends field not imported from: ‘S7’ - These packages need to be imported from (in the NAMESPACE file) - for when this namespace is loaded but not attached. -* checking S3 generic/method consistency ... OK -* checking replacement functions ... OK -* checking foreign function calls ... OK -* checking R code for possible problems ... OK -* checking Rd files ... OK -* checking Rd metadata ... OK -* checking Rd cross-references ... OK -* checking for missing documentation entries ... OK -* checking for code/documentation mismatches ... OK -* checking Rd \usage sections ... OK -* checking Rd contents ... OK -* checking for unstated dependencies in examples ... OK -* checking installed files from ‘inst/doc’ ... OK -* checking files in ‘vignettes’ ... OK -* checking examples ... OK -* checking for unstated dependencies in ‘tests’ ... OK -* checking tests ... ERROR - Running ‘testthat.R’ -Running the tests in ‘tests/testthat.R’ failed. -Last 13 lines of output: - 1. └─testthat::expect_output(show(event_table), "Hypotheses: 2") at test-s7-event-table.R:101:3 - 2. └─testthat::expect_match(...) - 3. └─testthat:::expect_match_(...) - ── Failure ('test-s7-event-table.R:102:3'): EventTable print method works ────── - `show\(event_table\)` does not match "Analyses: 1". - Actual value: " function \(data = tibble::tibble\(\)\) \\n @ data : tibble \[2 x 4\] \(S3: tbl_df/tbl/data\.frame\)\\n \$ H1 : num \[1:2\] 1 2\\n \$ H2 : num \[1:2\] 1 2\\n \$ Analysis: num \[1:2\] 1 1\\n \$ Event : num \[1:2\] 155 160\\n @ n_hypotheses: int 2\\n @ n_analyses : int 1" - Backtrace: - ▆ - 1. └─testthat::expect_output(show(event_table), "Analyses: 1") at test-s7-event-table.R:102:3 - 2. └─testthat::expect_match(...) - 3. └─testthat:::expect_match_(...) - - [ FAIL 3 | WARN 1 | SKIP 0 | PASS 50 ] - Error: Test failures - Execution halted -* checking for unstated dependencies in vignettes ... OK -* checking package vignettes ... OK -* checking re-building of vignette outputs ... \ No newline at end of file diff --git a/wpgsd.Rcheck/00install.out b/wpgsd.Rcheck/00install.out deleted file mode 100644 index acdb88e..0000000 --- a/wpgsd.Rcheck/00install.out +++ /dev/null @@ -1,15 +0,0 @@ -* installing *source* package ‘wpgsd’ ... -** this is package ‘wpgsd’ version ‘0.1.0’ -** using staged installation -** R -** inst -** byte-compile and prepare package for lazy loading -** help -*** installing help indices -*** copying figures -** building package indices -** installing vignettes -** testing if installed package can be loaded from temporary location -** testing if installed package can be loaded from final location -** testing if installed package keeps a record of temporary installation path -* DONE (wpgsd) diff --git a/wpgsd.Rcheck/build_vignettes.log b/wpgsd.Rcheck/build_vignettes.log deleted file mode 100644 index e69de29..0000000 diff --git a/wpgsd.Rcheck/tests/startup.Rs b/wpgsd.Rcheck/tests/startup.Rs deleted file mode 100644 index 8ad6d25..0000000 --- a/wpgsd.Rcheck/tests/startup.Rs +++ /dev/null @@ -1,4 +0,0 @@ -## A custom startup file for tests -## Run as if a system Rprofile, so no packages, no assignments -options(useFancyQuotes = FALSE) - diff --git a/wpgsd.Rcheck/tests/testthat.R b/wpgsd.Rcheck/tests/testthat.R deleted file mode 100644 index 39921f0..0000000 --- a/wpgsd.Rcheck/tests/testthat.R +++ /dev/null @@ -1,4 +0,0 @@ -library(testthat) -library(wpgsd) - -test_check("wpgsd") diff --git a/wpgsd.Rcheck/tests/testthat.Rout.fail b/wpgsd.Rcheck/tests/testthat.Rout.fail deleted file mode 100644 index e20d75c..0000000 --- a/wpgsd.Rcheck/tests/testthat.Rout.fail +++ /dev/null @@ -1,53 +0,0 @@ - -R version 4.5.0 (2025-04-11) -- "How About a Twenty-Six" -Copyright (C) 2025 The R Foundation for Statistical Computing -Platform: aarch64-apple-darwin20 - -R is free software and comes with ABSOLUTELY NO WARRANTY. -You are welcome to redistribute it under certain conditions. -Type 'license()' or 'licence()' for distribution details. - -R is a collaborative project with many contributors. -Type 'contributors()' for more information and -'citation()' on how to cite R or R packages in publications. - -Type 'demo()' for some demos, 'help()' for on-line help, or -'help.start()' for an HTML browser interface to help. -Type 'q()' to quit R. - -> library(testthat) -> library(wpgsd) -Loading required package: S7 -> -> test_check("wpgsd") -[ FAIL 3 | WARN 1 | SKIP 0 | PASS 50 ] - -══ Failed tests ════════════════════════════════════════════════════════════════ -── Failure ('test-s7-event-table.R:100:3'): EventTable print method works ────── -`show\(event_table\)` does not match "EventTable with 2 rows". -Actual value: " function \(data = tibble::tibble\(\)\) \\n @ data : tibble \[2 x 4\] \(S3: tbl_df/tbl/data\.frame\)\\n \$ H1 : num \[1:2\] 1 2\\n \$ H2 : num \[1:2\] 1 2\\n \$ Analysis: num \[1:2\] 1 1\\n \$ Event : num \[1:2\] 155 160\\n @ n_hypotheses: int 2\\n @ n_analyses : int 1" -Backtrace: - ▆ - 1. └─testthat::expect_output(show(event_table), "EventTable with 2 rows") at test-s7-event-table.R:100:3 - 2. └─testthat::expect_match(...) - 3. └─testthat:::expect_match_(...) -── Failure ('test-s7-event-table.R:101:3'): EventTable print method works ────── -`show\(event_table\)` does not match "Hypotheses: 2". -Actual value: " function \(data = tibble::tibble\(\)\) \\n @ data : tibble \[2 x 4\] \(S3: tbl_df/tbl/data\.frame\)\\n \$ H1 : num \[1:2\] 1 2\\n \$ H2 : num \[1:2\] 1 2\\n \$ Analysis: num \[1:2\] 1 1\\n \$ Event : num \[1:2\] 155 160\\n @ n_hypotheses: int 2\\n @ n_analyses : int 1" -Backtrace: - ▆ - 1. └─testthat::expect_output(show(event_table), "Hypotheses: 2") at test-s7-event-table.R:101:3 - 2. └─testthat::expect_match(...) - 3. └─testthat:::expect_match_(...) -── Failure ('test-s7-event-table.R:102:3'): EventTable print method works ────── -`show\(event_table\)` does not match "Analyses: 1". -Actual value: " function \(data = tibble::tibble\(\)\) \\n @ data : tibble \[2 x 4\] \(S3: tbl_df/tbl/data\.frame\)\\n \$ H1 : num \[1:2\] 1 2\\n \$ H2 : num \[1:2\] 1 2\\n \$ Analysis: num \[1:2\] 1 1\\n \$ Event : num \[1:2\] 155 160\\n @ n_hypotheses: int 2\\n @ n_analyses : int 1" -Backtrace: - ▆ - 1. └─testthat::expect_output(show(event_table), "Analyses: 1") at test-s7-event-table.R:102:3 - 2. └─testthat::expect_match(...) - 3. └─testthat:::expect_match_(...) - -[ FAIL 3 | WARN 1 | SKIP 0 | PASS 50 ] -Error: Test failures -Execution halted diff --git a/wpgsd.Rcheck/tests/testthat/helper-generate_corr_new.R b/wpgsd.Rcheck/tests/testthat/helper-generate_corr_new.R deleted file mode 100644 index d378ff3..0000000 --- a/wpgsd.Rcheck/tests/testthat/helper-generate_corr_new.R +++ /dev/null @@ -1,126 +0,0 @@ -# Helper functions used by test-independent-generate_corr_new.R - -#' Generate correlation matrix based on event counts -#' -#' @param event Event count of each hypothesis at each analysis, including -#' event count of the intersection of hypotheses. -#' It contains 4 columns: `H1`, `H2`, `Analysis`, `Event`. -#' `H1` needs to be listed as 1, 2, 3, etc. as numbers. -#' -#' @return A correlation matrix. -#' -#' @importFrom dplyr filter select %>% -#' -#' @export -#' -#' @examples -#' # Build the transition matrix -#' m <- matrix(c( -#' 0, 0.5, 0.5, -#' 0.5, 0, 0.5, -#' 0.5, 0.5, 0 -#' ), nrow = 3, byrow = TRUE) -#' # initialize weights -#' w <- c(1 / 3, 1 / 3, 1 / 3) -#' -#' # Input event count of intersection of paired hypotheses - Table 2 -#' event <- tibble::tribble( -#' ~H1, ~H2, ~Analysis, ~Event, -#' 1, 1, 1, 155, -#' 2, 2, 1, 160, -#' 3, 3, 1, 165, -#' 1, 2, 1, 85, -#' 1, 3, 1, 85, -#' 2, 3, 1, 85, -#' 1, 1, 2, 305, -#' 2, 2, 2, 320, -#' 3, 3, 2, 335, -#' 1, 2, 2, 170, -#' 1, 3, 2, 170, -#' 2, 3, 2, 170 -#' ) -#' -#' # Generate correlation from events -#' gs_corr <- generate_corr_new(event) -generate_corr_new <- function(event) { - elem <- event %>% subset(H1 == H2) - inter <- event %>% subset(H1 != H2) - n_hypotheses <- max(as.numeric(elem$H1)) - n_analyses <- max(elem$Analysis) - - # Diagonal - D <- diag(elem$Event) - - # Within hypothesis across analyses - if (n_analyses > 1) { - for (i in 1:n_hypotheses) { - for (j in 1:(n_analyses - 1)) { - count <- D[(j - 1) * n_hypotheses + i, (j - 1) * n_hypotheses + i] - for (k in (j + 1):n_analyses) { - D[(j - 1) * n_hypotheses + i, (k - 1) * n_hypotheses + i] <- count - D[(k - 1) * n_hypotheses + i, (j - 1) * n_hypotheses + i] <- count - } - } - } - } - - # Between hypotheses and analyses - for (i in 1:(n_hypotheses - 1)) { - for (j in c((i + 1):n_hypotheses)) { - for (k in 1:n_analyses) { - count1 <- as.numeric(event %>% - subset(((H1 == i & H2 == j) | (H1 == j & H2 == i)) & Analysis == k) %>% - select(Event))[1] - for (l in (k:n_analyses)) { - D[n_hypotheses * (l - 1) + i, n_hypotheses * (k - 1) + j] <- count1 - D[n_hypotheses * (l - 1) + j, n_hypotheses * (k - 1) + i] <- count1 - D[n_hypotheses * (k - 1) + j, n_hypotheses * (l - 1) + i] <- count1 - D[n_hypotheses * (k - 1) + i, n_hypotheses * (l - 1) + j] <- count1 - } - } - } - } - - corr_mat <- d_corr(D) - - col_names <- NULL - for (k in 1:n_analyses) { - for (i in 1:n_hypotheses) { - name_tmp <- paste("H", i, "_A", k, sep = "") - col_names <- c(col_names, name_tmp) - } - } - - colnames(corr_mat) <- col_names - - return(corr_mat) -} - -test_generate_corr_new <- function() { - a1 <- 80 - b1 <- 100 - ab1 <- 60 - a2 <- 120 - b2 <- 150 - ab2 <- 80 - - event <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, a1, - 2, 2, 1, b1, - 1, 2, 1, ab1, - 1, 1, 2, a2, - 2, 2, 2, b2, - 1, 2, 2, ab2 - ) - - list( - "a1" = a1, - "b1" = b1, - "ab1" = ab1, - "a2" = a2, - "b2" = b2, - "ab2" = ab2, - "event" = event - ) -} diff --git a/wpgsd.Rcheck/tests/testthat/test-developer-generate_event_commoncontrol_addhypo.R b/wpgsd.Rcheck/tests/testthat/test-developer-generate_event_commoncontrol_addhypo.R deleted file mode 100644 index 9c2a339..0000000 --- a/wpgsd.Rcheck/tests/testthat/test-developer-generate_event_commoncontrol_addhypo.R +++ /dev/null @@ -1,23 +0,0 @@ -test_that("Generate event table returns the expected sorted data", { - expected_data <- tibble( - one_hypothesis = as.integer(c(1, 1, 1, 2, 2, 3, 1, 1, 1, 2, 2, 3)), - another_hypothesis = as.integer(c(1, 2, 3, 2, 3, 3, 1, 2, 3, 2, 3, 3)), - analysis = as.integer(c(1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2)), - common_events = c(155, 85, 70, 160, 75, 165, 305, 170, 135, 320, 150, 335) - ) - - event <- data.frame( - Population = c("Experimental 1", "Experimental 2", "Experimental 3", "Control"), - IA = c(70, 75, 80, 85), - FA = c(135, 150, 165, 170) - ) - - hypothesis <- list( - H1 = "Experimental 1 vs. Control", - H2 = "Experimental 2 vs. Control", - H3 = "Experimental 1 vs. Experimental 2" - ) - - result_table <- generate_event_table_cc(event, hypothesis) - expect_identical(result_table, expected_data) -}) diff --git a/wpgsd.Rcheck/tests/testthat/test-developer-generate_event_population_addhypo.R b/wpgsd.Rcheck/tests/testthat/test-developer-generate_event_population_addhypo.R deleted file mode 100644 index c611242..0000000 --- a/wpgsd.Rcheck/tests/testthat/test-developer-generate_event_population_addhypo.R +++ /dev/null @@ -1,23 +0,0 @@ -test_that("Generate event table ol returns the expected sorted data", { - expected_data <- tibble( - one_hypothesis = as.integer(c(1, 1, 1, 2, 2, 3, 1, 1, 1, 2, 2, 3)), - another_hypothesis = as.integer(c(1, 2, 3, 2, 3, 3, 1, 2, 3, 2, 3, 3)), - analysis = as.integer(c(1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2)), - common_events = c(100, 80, 100, 110, 110, 225, 200, 160, 200, 220, 220, 450) - ) - - event <- data.frame( - Population = c("Population 1", "Population 2", "Population 1 Intersection 2", "Overall population"), - IA = c(100, 110, 80, 225), - FA = c(200, 220, 160, 450) - ) - - hypothesis <- list( - H1 = "Efficacy in Population 1", - H2 = "Efficacy in Population 2", - H3 = "Efficacy in Overall population" - ) - - result_table <- generate_event_table_ol(event, hypothesis) - expect_identical(result_table, expected_data) -}) diff --git a/wpgsd.Rcheck/tests/testthat/test-independent-closed_test.R b/wpgsd.Rcheck/tests/testthat/test-independent-closed_test.R deleted file mode 100644 index ef088a0..0000000 --- a/wpgsd.Rcheck/tests/testthat/test-independent-closed_test.R +++ /dev/null @@ -1,25 +0,0 @@ -test_that("closed_test reject hypothesis as expected", { - p_obs <- dplyr::bind_rows( - tibble::tibble(Analysis = 1, H1 = 0.001, H2 = 0.001), - tibble::tibble(Analysis = 2, H1 = 0.001, H2 = 0.001) - ) - - bound <- tibble::tribble( - ~Analysis, ~Hypotheses, ~H1, ~H2, - 1, "H1", 0.02, NA, - 1, "H1, H2", 0.0001, 0.00001, - 1, "H2", NA, 0.003, - 2, "H1", 0.02, NA, - 2, "H1, H2", 0.02, 0.00001, - 2, "H2", NA, 0.003 - ) - - closed_test <- closed_test(bound, p_obs) - closed_test_a1 <- closed_test %>% dplyr::filter(Analysis == "Analysis 1") - closed_test_a2 <- closed_test %>% dplyr::filter(Analysis == "Analysis 2") - - expect_equal(closed_test_a1$H1, "Fail") - expect_equal(closed_test_a1$H2, "Fail") - expect_equal(closed_test_a2$H1, "Success") - expect_equal(closed_test_a2$H2, "Success") -}) diff --git a/wpgsd.Rcheck/tests/testthat/test-independent-generate_bounds.R b/wpgsd.Rcheck/tests/testthat/test-independent-generate_bounds.R deleted file mode 100644 index 67d474b..0000000 --- a/wpgsd.Rcheck/tests/testthat/test-independent-generate_bounds.R +++ /dev/null @@ -1,580 +0,0 @@ -test_that("BH bounds replicate tables A3 and A4", { - # Example 1 BH weighting results in Table A3 and A4 - set.seed(1234) - - # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ex1 BH ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~# - # Transition matrix in Figure A1 - m <- matrix(c( - 0, 3 / 7, 4 / 7, - 3 / 7, 0, 4 / 7, - 1 / 2, 1 / 2, 0 - ), nrow = 3, byrow = TRUE) - # Initial weights - w <- c(0.3, 0.3, 0.4) - - # Event count of intersection of paired hypotheses - Table 1 - event <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 100, - 2, 2, 1, 110, - 3, 3, 1, 225, - 1, 2, 1, 80, - 1, 3, 1, 100, - 2, 3, 1, 110, - 1, 1, 2, 200, - 2, 2, 2, 220, - 3, 3, 2, 450, - 1, 2, 2, 160, - 1, 3, 2, 200, - 2, 3, 2, 220 - ) - event - - # Generate correlation from events - corr <- generate_corr(event) - corr # correlation matrix in Table 3 - - # WPGSD bounds, spending method 3b - bound_WPGSD <- generate_bounds( - type = 2, k = 2, w = w, m = m, corr = corr, alpha = 0.025, - sf = gsDesign::sfHSD, - sfparm = -4, - t = c(min(100 / 200, 110 / 220, 225 / 450), 1) - ) - - # Bonferroni bounds - bound_Bonf <- generate_bounds( - type = 0, k = 2, w = w, m = m, corr = corr, alpha = 0.025, - sf = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - sfparm = list(-4, -4, -4), - t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1)) - ) - - # Combine and back-calculate xi - bounds <- dplyr::left_join( - bound_Bonf, - bound_WPGSD, - by = c("Hypotheses", "Analysis"), - suffix = c(".B", ".W") - ) - bounds <- bounds %>% - dplyr::rowwise() %>% - dplyr::mutate(xi = sum(H1.W, H2.W, H3.W, na.rm = TRUE) / - sum(H1.B, H2.B, H3.B, na.rm = TRUE)) - # Reorder for output - bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2) - bounds <- bounds %>% dplyr::arrange(Analysis, order) - - # Z-statistics boundary, Table A4 - zbounds <- bounds %>% - dplyr::mutate( - zH1.B = -qnorm(H1.B), - zH2.B = -qnorm(H2.B), - zH3.B = -qnorm(H3.B), - zH1.W = -qnorm(H1.W), - zH2.W = -qnorm(H2.W), - zH3.W = -qnorm(H3.W) - ) %>% - select(Analysis, Hypotheses, zH1.B, zH2.B, zH3.B, zH1.W, zH2.W, zH3.W) - - - # Table A3 - # Test H1 - # From publication Weighted Bonferroni - A3_result1 <- c( - 0.0009, 0.0015, 0.0013, NA, - 0.003, NA, NA, 0.007, 0.0118, - 0.0101, NA, 0.0238, NA, NA - ) - - A3_result1_test <- round(bounds$H1.B, 4) - - expect_equal(A3_result1_test, A3_result1) - - # WPGSD - - wA3_result1 <- c( - 0.0011, 0.0017, 0.0014, NA, - 0.003, NA, NA, 0.0092, 0.0144, - 0.0116, NA, 0.0238, NA, NA - ) - - wA3_result1_test <- round(bounds$H1.W, 4) - - expect_equal(wA3_result1_test, wA3_result1) - - - # Table A4 - # Test H1 - # From publication Weighted Bonferroni - A4_result1 <- c( - 3.12, 2.97, 3.02, NA, 2.75, NA, NA, - 2.46, 2.26, 2.32, NA, 1.98, NA, NA - ) - - A4_result1_test <- round(zbounds$zH1.B, 2) - - expect_equal(A4_result1_test, A4_result1) - - # WPGSD - wA4_result1 <- c( - 3.08, 2.93, 2.99, NA, 2.75, NA, NA, - 2.36, 2.19, 2.27, NA, 1.98, NA, NA - ) - - wA4_result1_test <- round(zbounds$zH1.W, 2) - - expect_equal(wA4_result1_test, wA4_result1) - - - ######################## - # Next, reproduce H2? - ######################## - - A3_result2 <- c( - 0.0009, 0.0015, NA, 0.0013, NA, - 0.003, NA, 0.007, 0.0118, NA, 0.0101, NA, 0.0238, NA - ) - - A3_result2_test <- round(bounds$H2.B, 4) - - expect_equal(A3_result2_test, A3_result2) - - # WPGSD - - wA3_result2 <- c( - 0.0011, 0.0017, NA, 0.0014, NA, - 0.003, NA, 0.0092, 0.0144, - NA, 0.0118, NA, 0.0238, NA - ) - - wA3_result2_test <- round(bounds$H2.W, 4) - - expect_equal(wA3_result2_test, wA3_result2) - - # A4 - - A4_result2 <- c( - 3.12, 2.97, NA, 3.02, NA, 2.75, NA, 2.46, 2.26, NA, 2.32, - NA, 1.98, NA - ) - - A4_result2_test <- round(zbounds$zH2.B, 2) - - expect_equal(A4_result2_test, A4_result2) - - # WPGSD - wA4_result2 <- c( - 3.08, 2.93, NA, 2.99, NA, 2.75, NA, 2.36, 2.19, - NA, 2.26, NA, 1.98, NA - ) - - wA4_result2_test <- round(zbounds$zH2.W, 2) - - expect_equal(wA4_result2_test, wA4_result2) - - - ######################## - # Next, reproduce H3? - ######################## - - A3_result3 <- c( - 0.0012, NA, 0.0017, 0.0017, NA, NA, 0.003, 0.0094, NA, - 0.0135, 0.0135, NA, NA, 0.0238 - ) - - A3_result3_test <- round(bounds$H3.B, 4) - - expect_equal(A3_result3_test, A3_result3) - - # WPGSD - - wA3_result3 <- c( - 0.0014, NA, 0.0018, 0.0019, NA, NA, 0.003, 0.0123, NA, - 0.0155, 0.0158, NA, NA, 0.0238 - ) - - wA3_result3_test <- round(bounds$H3.W, 4) - - expect_equal(wA3_result3_test, wA3_result3) - - # A4 - - A4_result3 <- c(3.04, NA, 2.93, 2.93, NA, NA, 2.75, 2.35, NA, 2.21, 2.21, NA, NA, 1.98) - - A4_result3_test <- round(zbounds$zH3.B, 2) - - expect_equal(A4_result3_test, A4_result3) - - # WPGSD - wA4_result3 <- c(2.99, NA, 2.9, 2.9, NA, NA, 2.75, 2.25, NA, 2.16, 2.15, NA, NA, 1.98) - - wA4_result3_test <- round(zbounds$zH3.W, 2) - - expect_equal(wA4_result3_test, wA4_result3) -}) - -test_that("BH bounds replicate tables A6 and A7", { - # From wpgsd github: - # Example 2 BH weighting results in Table A6 and A7 - set.seed(1234) - - # Transition matrix in Figure A2 - m <- matrix(c( - 0, 0.5, 0.5, - 0.5, 0, 0.5, - 0.5, 0.5, 0 - ), nrow = 3, byrow = TRUE) - # Initial weights - w <- c(1 / 3, 1 / 3, 1 / 3) - - # Event count of intersection of paired hypotheses - Table 2 - event <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160, - 3, 3, 1, 165, - 1, 2, 1, 85, - 1, 3, 1, 85, - 2, 3, 1, 85, - 1, 1, 2, 305, - 2, 2, 2, 320, - 3, 3, 2, 335, - 1, 2, 2, 170, - 1, 3, 2, 170, - 2, 3, 2, 170 - ) - event - - # Generate correlation from events - corr <- generate_corr(event) - corr # correlation matrix in Table 4 - - # WPGSD bounds, spending method 3c - bound_WPGSD <- generate_bounds( - type = 3, k = 2, w = w, m = m, corr = corr, alpha = 0.025, - sf = list(gsDesign::sfLDOF, gsDesign::sfLDOF, gsDesign::sfLDOF), - sfparm = list(0, 0, 0), - t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1)) - ) - - # Bonferroni bounds - bound_Bonf <- generate_bounds( - type = 0, k = 2, w = w, m = m, corr = corr, alpha = 0.025, - sf = list(gsDesign::sfLDOF, gsDesign::sfLDOF, gsDesign::sfLDOF), - sfparm = list(0, 0, 0), - t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1)) - ) - - bounds <- dplyr::left_join( - bound_Bonf, - bound_WPGSD, - by = c("Hypotheses", "Analysis"), - suffix = c(".B", ".W") - ) - - # Reorder for output - bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2) - bounds <- bounds %>% arrange(Analysis, order) - - # Table A6 - bounds - - bounds <- bounds %>% arrange(Analysis, order) - - # Z-statistics boundary, Table A7 - zbounds <- bounds %>% - mutate( - zH1.B = -qnorm(H1.B), - zH2.B = -qnorm(H2.B), - zH3.B = -qnorm(H3.B), - zH1.W = -qnorm(H1.W), - zH2.W = -qnorm(H2.W), - zH3.W = -qnorm(H3.W) - ) %>% - select(Analysis, Hypotheses, zH1.B, zH2.B, zH3.B, zH1.W, zH2.W, zH3.W) - - - # Table A6 - # Test H1 - # From publication Weighted Bonferroni - A6_result1 <- c( - 0.00021488, - 0.000458864, - 0.000458864, - NA, - 0.001665671, - NA, - NA, - 0.008259394, - 0.0123448, - 0.0123448, - NA, - 0.024455472, - NA, - NA - ) - - A6_result1_test <- round(bounds$H1.B, 4) - - expect_equal(A6_result1_test, round(A6_result1, 4)) - - # H2 - - A6_result2 <- c( - 0.000190676, - 0.000411979, - NA, - 0.000411979, - NA, - 0.001525323, - NA, - 0.0082675, - 0.012360191, - NA, - 0.012360191, - NA, - 0.024499778, - NA - ) - - A6_result2_test <- round(bounds$H2.B, 4) - - expect_equal(A6_result2_test, round(A6_result2, 4)) - - # H3 - - A6_result3 <- c( - 0.000170445, - NA, - 0.000372343, - 0.000372343, - NA, - NA, - 0.001404398, - 0.008274305, - NA, - 0.012373258, - 0.012373258, - NA, - NA, - 0.024538108 - ) - - A6_result3_test <- round(bounds$H3.B, 4) - - expect_equal(A6_result3_test, round(A6_result3, 4)) - - ######## - # WPGSD - ######## - - wA6_result1 <- c( - 0.000224701, - 0.000471076, - 0.000470177, - NA, - 0.001665671, - NA, - NA, - 0.009491524, - 0.013508544, - 0.013452942, - NA, - 0.024455472, - NA, - NA - ) - - wA6_result1_test <- round(bounds$H1.W, 4) - - expect_equal(wA6_result1_test, round(wA6_result1, 4)) - - - - wA6_result2 <- c( - 0.00019939, - 0.000422943, - NA, - 0.000421453, - NA, - 0.001525323, - NA, - 0.00950084, - 0.013525386, - NA, - 0.01341849, - NA, - 0.024499778, - NA - ) - - wA6_result2_test <- round(bounds$H2.W, 4) - - expect_equal(wA6_result2_test, round(wA6_result2, 4)) - - - wA6_result3 <- c( - 0.000178234, - NA, - 0.000381523, - 0.000380905, - NA, - NA, - 0.001404398, - 0.00950866, - NA, - 0.013483955, - 0.013432676, - NA, - NA, - 0.024538108 - ) - - wA6_result3_test <- round(bounds$H3.W, 4) - - expect_equal(wA6_result3_test, round(wA6_result3, 4)) - - - # Z-statistics - - - # Table A7 - A7_result1 <- c( - 3.521099809, - 3.314604451, - 3.314604451, - NA, - 2.93538486, - NA, - NA, - 2.397246926, - 2.246225001, - 2.246225001, - NA, - 1.969367163, - NA, - NA - ) - - A7_result1_test <- round(zbounds$zH1.B, 4) - - expect_equal(A7_result1_test, round(A7_result1, 4)) - - - A7_result2 <- c( - 3.552662921, - 3.34461863, - NA, - 3.34461863, - NA, - 2.962588043, - NA, - 2.396887486, - 2.245744429, - NA, - 2.245744429, - NA, - 1.968595527, - NA - ) - - A7_result2_test <- round(zbounds$zH2.B, 4) - - expect_equal(A7_result2_test, round(A7_result2, 4)) - - - - A7_result3 <- c( - 3.582064348, - NA, - 3.372575697, - 3.372575697, - NA, - NA, - 2.987923795, - 2.396585993, - NA, - 2.24533684, - 2.24533684, - NA, - NA, - 1.967928919 - ) - - A7_result3_test <- round(zbounds$zH3.B, 4) - - expect_equal(A7_result3_test, round(A7_result3, 4)) - - - - - - # Table A7 - wA7_result1 <- c( - 3.509232997, - 3.307254785, - 3.307789645, - NA, - 2.93538486, - NA, - NA, - 2.345863682, - 2.21127083, - 2.212880514, - NA, - 1.969367163, - NA, - NA - ) - - wA7_result1_test <- round(zbounds$zH1.W, 4) - - expect_equal(wA7_result1_test, round(wA7_result1, 4)) - - - wA7_result2 <- c( - 3.540889382, - 3.337326516, - NA, - 3.338307071, - NA, - 2.962588043, - NA, - 2.345498009, - 2.210784367, - NA, - 2.213880806, - NA, - 1.968595527, - NA - ) - - - wA7_result2_test <- round(zbounds$zH2.W, 4) - - expect_equal(wA7_result2_test, round(wA7_result2, 4)) - - - - wA7_result3 <- c( - 3.570376445, - NA, - 3.365863239, - 3.366309865, - NA, - NA, - 2.987923795, - 2.345191286, - NA, - 2.21198197, - 2.213468666, - NA, - NA, - 1.967928919 - ) - - wA7_result3_test <- round(zbounds$zH3.W, 4) - - expect_equal(wA7_result3_test, round(wA7_result3, 4)) -}) diff --git a/wpgsd.Rcheck/tests/testthat/test-independent-generate_corr.R b/wpgsd.Rcheck/tests/testthat/test-independent-generate_corr.R deleted file mode 100644 index a1699f5..0000000 --- a/wpgsd.Rcheck/tests/testthat/test-independent-generate_corr.R +++ /dev/null @@ -1,31 +0,0 @@ -test_that("2 endpoints 2 analysis correlation as expected", { - a1 <- 80 - b1 <- 100 - ab1 <- 60 - a2 <- 120 - b2 <- 150 - ab2 <- 80 - - event <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, a1, - 2, 2, 1, b1, - 1, 2, 1, ab1, - 1, 1, 2, a2, - 2, 2, 2, b2, - 1, 2, 2, ab2 - ) - - corr <- generate_corr(event) - corr_test <- matrix( - c( - 1, ab1 / sqrt(a1 * b1), a1 / sqrt(a1 * a2), ab1 / sqrt(a1 * b2), - ab1 / sqrt(a1 * b1), 1, ab1 / sqrt(a2 * b1), b1 / sqrt(b1 * b2), - a1 / sqrt(a1 * a2), ab1 / sqrt(a2 * b1), 1, ab2 / sqrt(a2 * b2), - ab1 / sqrt(a1 * b2), b1 / sqrt(b1 * b2), ab2 / sqrt(a2 * b2), 1 - ), - nrow = 4, byrow = TRUE - ) - - expect_equal(matrix(corr %>% as.numeric(), nrow = 4, byrow = TRUE), corr_test) -}) diff --git a/wpgsd.Rcheck/tests/testthat/test-independent-generate_corr_new.R b/wpgsd.Rcheck/tests/testthat/test-independent-generate_corr_new.R deleted file mode 100644 index aae7943..0000000 --- a/wpgsd.Rcheck/tests/testthat/test-independent-generate_corr_new.R +++ /dev/null @@ -1,62 +0,0 @@ -test_that("2 endpoints 2 analysis correlation as expected", { - res <- test_generate_corr_new() - a1 <- res$a1 - b1 <- res$b1 - ab1 <- res$ab1 - a2 <- res$a2 - b2 <- res$b2 - ab2 <- res$ab2 - event <- res$event - - corr <- generate_corr_new(event) - corr_test <- matrix( - c( - 1, ab1 / sqrt(a1 * b1), a1 / sqrt(a1 * a2), ab1 / sqrt(a1 * b2), - ab1 / sqrt(a1 * b1), 1, ab1 / sqrt(a2 * b1), b1 / sqrt(b1 * b2), - a1 / sqrt(a1 * a2), ab1 / sqrt(a2 * b1), 1, ab2 / sqrt(a2 * b2), - ab1 / sqrt(a1 * b2), b1 / sqrt(b1 * b2), ab2 / sqrt(a2 * b2), 1 - ), - nrow = 4, byrow = TRUE - ) - - expect_equal(matrix(corr %>% as.numeric(), nrow = 4, byrow = TRUE), corr_test) -}) - -# This is a 2 hypothesis, 3 analysis example -test_that("2 hypotheses 3 analysis correlation as expected", { - event <- tibble::tribble( - ~Analysis, ~H1, ~H2, ~Event, - 1, 1, 1, 147, - 1, 2, 2, 167, - 1, 1, 2, 88, - 2, 1, 1, 278, - 2, 2, 2, 289, - 2, 1, 2, 158, - 3, 1, 1, 342, - 3, 2, 2, 350, - 3, 1, 2, 192 - ) - corr <- generate_corr_new(event) - n_hypotheses <- 2 - n_analyses <- 3 - corr_test <- diag(1, n_hypotheses * n_analyses) - for (k in 1:n_analyses) { - for (l in k:n_analyses) { - for (i in 1:(n_hypotheses)) { - countkii <- as.numeric((event %>% filter(H1 == i & H2 == i & Analysis == k))$Event) - for (j in i:n_hypotheses) { - countkjj <- as.numeric((event %>% filter(H1 == j & H2 == j & Analysis == k))$Event) - countljj <- as.numeric((event %>% filter(H1 == j & H2 == j & Analysis == l))$Event) - countlii <- as.numeric((event %>% filter(H1 == i & H2 == i & Analysis == l))$Event) - countkij <- as.numeric((event %>% filter(H1 == i & H2 == j & Analysis == k))$Event) - corr_test[(k - 1) * n_hypotheses + i, (l - 1) * n_hypotheses + j] <- countkij / sqrt(countkii * countljj) - corr_test[(k - 1) * n_hypotheses + j, (l - 1) * n_hypotheses + i] <- countkij / sqrt(countkjj * countlii) - corr_test[(l - 1) * n_hypotheses + i, (k - 1) * n_hypotheses + j] <- countkij / sqrt(countlii * countkjj) - corr_test[(l - 1) * n_hypotheses + j, (k - 1) * n_hypotheses + i] <- countkij / sqrt(countljj * countkii) - } - } - } - } - - expect_equal(matrix(corr %>% as.numeric(), nrow = 6, byrow = TRUE), corr_test) -}) diff --git a/wpgsd.Rcheck/tests/testthat/test-s7-event-table.R b/wpgsd.Rcheck/tests/testthat/test-s7-event-table.R deleted file mode 100644 index ceca45c..0000000 --- a/wpgsd.Rcheck/tests/testthat/test-s7-event-table.R +++ /dev/null @@ -1,171 +0,0 @@ -test_that("EventTable can be created with valid data", { - # Create valid event data - event_data <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160, - 1, 2, 1, 85, - 1, 1, 2, 305, - 2, 2, 2, 320, - 1, 2, 2, 170 - ) - - # Create EventTable - event_table <- EventTable(data = event_data) - - # Check that object was created successfully - expect_true(S7::S7_inherits(event_table, EventTable)) - expect_equal(event_table@n_hypotheses, 2L) - expect_equal(event_table@n_analyses, 2L) - expect_equal(nrow(event_table@data), 6) -}) - -test_that("EventTable validates required columns", { - # Missing Event column - invalid_data1 <- tibble::tibble( - H1 = c(1, 2), - H2 = c(1, 2), - Analysis = c(1, 1) - ) - - expect_error( - EventTable(data = invalid_data1), - "EventTable requires columns: Event" - ) - - # Missing H1 column - invalid_data2 <- tibble::tibble( - H2 = c(1, 2), - Analysis = c(1, 1), - Event = c(100, 200) - ) - - expect_error( - EventTable(data = invalid_data2), - "EventTable requires columns: H1" - ) -}) - -test_that("EventTable validates data types and values", { - # Non-numeric H1 - invalid_data1 <- tibble::tibble( - H1 = c("A", "B"), - H2 = c(1, 2), - Analysis = c(1, 1), - Event = c(100, 200) - ) - - expect_error( - EventTable(data = invalid_data1), - "@data\\$H1 and @data\\$H2 must be numeric" - ) - - # Negative hypothesis index - invalid_data2 <- tibble::tibble( - H1 = c(-1, 2), - H2 = c(1, 2), - Analysis = c(1, 1), - Event = c(100, 200) - ) - - expect_error( - EventTable(data = invalid_data2), - "Hypothesis indices \\(H1, H2\\) must be positive integers" - ) - - # Negative event count - invalid_data3 <- tibble::tibble( - H1 = c(1, 2), - H2 = c(1, 2), - Analysis = c(1, 1), - Event = c(-100, 200) - ) - - expect_error( - EventTable(data = invalid_data3), - "Event counts must be non-negative" - ) -}) - -test_that("EventTable print method works", { - event_data <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160 - ) - - event_table <- EventTable(data = event_data) - - # Test the show method (which S7 uses for printing) - expect_output(show(event_table), "EventTable with 2 rows") - expect_output(show(event_table), "Hypotheses: 2") - expect_output(show(event_table), "Analyses: 1") -}) - -test_that("subset_event_table works correctly", { - event_data <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160, - 1, 2, 1, 85, - 1, 1, 2, 305, - 2, 2, 2, 320, - 1, 2, 2, 170 - ) - - event_table <- EventTable(data = event_data) - - # Subset by analysis - subset_a1 <- subset_event_table(event_table, analysis = 1) - expect_equal(subset_a1@n_analyses, 1L) - expect_equal(nrow(subset_a1@data), 3) - - # Subset by hypotheses - subset_h1 <- subset_event_table(event_table, hypotheses = c(1)) - expect_equal(nrow(subset_h1@data), 2) # Only H1-H1 pairs - - # Error for non-EventTable input - expect_error( - subset_event_table(data.frame(), analysis = 1), - "x must be an EventTable object" - ) -}) - -test_that("as_event_table conversion works", { - event_data <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160 - ) - - # Convert tibble to EventTable - event_table <- as_event_table(event_data) - expect_true(S7::S7_inherits(event_table, EventTable)) - - # Should return same object if already EventTable - event_table2 <- as_event_table(event_table) - expect_identical(event_table, event_table2) -}) - -test_that("validate_event_table_data works", { - # Valid data should pass - valid_data <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160 - ) - - expect_true(validate_event_table_data(valid_data)) - - # Invalid data should fail - invalid_data <- tibble::tribble( - ~H1, ~H2, ~Analysis, # Missing Event column - 1, 1, 1, - 2, 2, 1 - ) - - expect_error( - validate_event_table_data(invalid_data), - "Missing required columns: Event" - ) -}) diff --git a/wpgsd.Rcheck/tests/testthat/testthat-problems.rds b/wpgsd.Rcheck/tests/testthat/testthat-problems.rds deleted file mode 100644 index b126813354b9317fa73396d1a6e4c15bcc655b68..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 13706 zcmYj&c|4TsANHw!DV30LBE}NRl2ghg%VY})l_ZHdDIuaFOUz8WK}^V&WwK?92?<%| zoEix+*~u~)%h;ze#*EpX_a5i{yq~u}>f>=g_xk-_-|M>WCs^F}KQ{hsSwiiM%JNPT z9!Nf`nQ_3NSJQ#8x^V1vuc1Tc(~mDxdoJwIOOx}Jet9ZgGx=t~NpXW@Pu;!e4nJ;h z+3KOMvbo~k`9@U^^6qq%&gQZ@o#Kb`Ljv`N*x1MNdmCukM&$1X$ze&WVw1$k@WZ)C!%7>Q|%SbMV@61KSjt_0tzR=>Mcl<}V2x3MnSZIA8{ zs!d0YrTl^|I>J_i>_Td4ya~vO5J}R> z?$43yU1zlJ#|Q}ygpi-)z`LO*qigZ%M+`s4Mg|AjxUwxCJ)7aKyPrY4 zFtmgz4rx+nKFTE;8teUXe?H^d^0}#DPq&pB4?o);P|HyZ!kf?P!wJINxAc#!=3<>;qgO?!bq7X4)r8Dty=klxFS`?g|QsMU4T z#PDMozlMtvxd!r`@S9VKOz%$<3$824n!`rouOlpP{g$fo3d~W{48EG6o053i$4*m6 zo~o5bomjh;t&p3P`BWzDM|a(Ul4?TO-|o8RmJjmU7Tdb5)D%YYoX>LArY#fB%9q%d z^cTRyciBTzNXgFx}h$?i1Cv2*;-Xy?s~IkIvv|1#e-%M=GQF#LpaWH3{Vl zMyBLrBYz*BvGRMc$JWXHB56P4dsS`;z+Z?h@;YJ~!t{w{PR+HAh5`w*# zwlwf=BDnVBaB7|TleKRXVz*0SZ61P^>n8?MJQpLT5)5Q7Q{>%MI&w{ZWcU0w!wp|i zsLplSV-j-Kmvh&+^j7liuxq7;CF^-jO`gl`1$s>Xxa!*~iN_YQX8gZRnChjBeoMV` z^ph#|?~3Gx`1UhR!T9L)6Yb2$i4ME-wcCaRm9o#Q{LFf4!lq&J$V)D_;pKVfhnbYTkv6J%`uta-lkttw1(rozq1yfCU;q@ z87FjB6NVMKU-kOp?{Oz@S~lt>EzTu(B9T!#wO_BN0)KuPUe~U^9q?_$$!GJ-A~Dl|M>qN? z2)k6!Kp)s#eShsz6>ZbBt9RgAA1ipW#LFDC0qv!?3ZxM=KO$|4wNR?m= z=7fUNuKD}luGV}#+gjo?@;!I8`1JLaQxc|;wXY|<>g9XmR}~YV*GHuMYg^{jIc;np zQ@6jNWN9@c&`Ksk#@(xSbpU2!n+72b0EDvyRX}@f8oHmi3U#$mP?a-uyT*y zc4!Mwhl4jRhVWqOX2; z$O~!B_pmr^9PHE+Z=`Btc=k@kueZHhR59si4dJ|s?+dW%ldpNpl3II)le}xS^KYss z<+v|BhL65nYAEb;?i?e;-G+rgV-vmv6zrsxn4IkQe|`ihX&b4}GtVDgyFNHP`zBzZ z;J3tdc4#-5UwhE9QS)W)2~J8uq{F-36rQj;K;`4{fm-#MDk5psN~X0CS#znN(XWG8 zYO-%kbBk$XIr3+*A*r-TQNOhQGjEz7mY3ahQ>v)p+>66mRo5mz85kc~h`d1TaqoW| z6x=kUcjxTeM~#uC$DPI=lX|w6?AN!QuA4g+`A_0y$9$Ku?(D=0R-#gPlkp8N?iYsD z)Me&9LsmuP04k)ia^;xZ@mYFcORPzN?R1ArNQHHfuvWFa^S4<`ivp39f_7Uz4<(rd z9BVoB#wJRVVKX(c9DR=&4-+f$<*71l579NtE;gTif2Ct~058E!A^gDO-_Ldv z|6rK6h?nBaniW`sha4}COYgVgA847oh-Z+t#n|wk^K!UK7JYq#LM2EH8ApGAi* zYCZ9O1?wGbn`iIILnj|JTj(aX?Ireoc2Y%cRpt6D-+#+R#a=}O6I5BQ(s>vIQ42Jd z>Ux=zQNWhT!vvFN$`EfZ+XxJfrxyuhp3YLP#*!a=K;Wo6J$_V=lcp6U7h6*byZ;a8 zsKEWeKpr|;O5p#N^Uj8+w-;0OEXW1rmy@w3@!DtIcBiBuv4Aa=hq+CP6qm+48|s!* zX5chYMygc8fpHrwr!}^`@;8?Fd^P1M7PFtxAG;|Q^LQu*v~oItdMU+lx{wpxx{h#J zJhl_ZDN4+dV8Hj#HLUmsq^=LYu^7#{4smHnmx=;!Ck)kt*T@XkH^N zp_ju+6m#ww3lhaHswNK)QZh96nGJuZ9ZbcFZ`#hRCa+_NLxo^WeGOCGH4^bfxFLyn zVNn~*)HSg=ONxQ8ZNy122+|D$pVfsm1%v}u`~@uG(ynuSMUvUA327+5Kyr_ou=N$K zK7|P#s#Mf7p;Bxg%gk zp}e6n(1@-n+Ad;2)Uz2`EQgInje#)-?dYmj{KyzK7zGiB>IIMBc1TC?dl|aA6@ME^ z8Ehh?GN%JJQI%RIYXniGBT1l@dMW(&Cvk_U>e|S@lrj9anCS64PIXm2aZy5XQ{u%E z%HQQWkwtPrER*2vA=ejZQT0ivI#CkRp# zZnYPtW6m$goHKiQ8{tAsd(}F8*p_9m&db&jSXaOKDyBx%@4!vVnf`=K8R(XWI+13A zCquA)Nkv+FjuTQ9-AFw)PbnkuK*D@39N+RMbnWRZgva75PNdDVeJTh05I89^9SKGh z`jg<=hu?BAPSI!9)1E~+;=1EI4}&}I_gy7g26}%%IVlMDON^u7gNQQ3YS8-+?DJ1sjx=Gtul)-)#B&z z>!f^qc(VgaE>^D!#65PE2{!nqy>KQGT{*Cg{^Qold~m_gQ5FxhHLQ%6Go|XQo4q-a zL)Dje&qW)O5N86)t#KS3EWxFK4Y#(5E5AUr#BvqgZ-XUiQ+*B&I16xxSca6x!e#*6<>z4?*UB<)5e3k2z4GWxJ8xAxx)NM(%Teg15Y&XccGi*6y$ zS7zAi*l5qXKA!)izNQtA9y;BO+$Jfg=Td)_4xP;lN`qkCy^XSM_LwLs`pQ88Pfzw&BYJ9#?v6Xjs7$(a)gbSM#W1#FvUI^xia%x^!=L=`Z0)X7=71;+8ig)t`=0~0l#Fhf-Nn@&2 z#_5@?$|pC+N=+{8p$Y&-WeiP=@InjqP>M{EP37%;DSYyZsG`bct4VgZH-&9v8!0AOvkMOtHdkd3J0{|6r2KUC*~ zlc$AsX0_*pkHOT++nxHkXA607*18EJ>bW&4P|NHTmOH8%n#O$s2FmuLfIgD zSJ+!C^{<4_5^W!hf0+={HJeibq-d`l2Z)AL7yQqnkEYxqa8MDzk6~uc&T2jt;{AkW zs>%;0?#6w=hxlZ z$@iw0_0bw@N!%x~jYLk(Y?|AuFQh@OWKRoPf=Hg1pc~fXNPa4(MD%MV#&J?UY9bbQ z5rdVQWU|}I1AK)k)`BcJm_IRuJxFt`FoTW2Tq5G6mLR*;LOD||Q@>vhApEe^c+i|F%>9x_Msl0YYn=aI4#^m*+S6UlVNtFwCSQjhDnP-vDqAWnUgbb@fbB8x=~FC02D4~T?W8R;j$Da7gZ z(@Kc=2nJ5p*inGCAR*O1{+nmRpTtTY>=EX1!m0k^N6ZHIAd75yan$=>TBXDssdYr| zLuG++cMs+#^3TJ`csH=~MF)weSUam4hmm{nheO}$2r}X_r3A+L50#hj8Lo)ge`^;w zmy3@)0*G=oDrY5}zDb$e$wiYmapK*?u0}TeS1u(F0oMt7IW8%i$<{&56I4i?nEI<4 zC0VLOQ);mJ(7&Ia>$`Zoi|N}|eE#QdO3 ze9y|AeXxrK0{2S4NuxMrLBm6ig7r_LY^DP8ovjDm4{~NGcM|>FLbYRLGQsTw1cW6dxV(5U~Z}`>!WLt zIQ3Nzl^FyzvtoeFNWIWI(aQWhB5qb`shI^lb)?SsKdpVuSid#IMSL_k!G(acqp_1>yYmZesK+WGU;&H{OB` zRy0eB20%?##KpzCELRXpxEKKmbPTu|y&e4(#}_mVv2{&WDe8g~7NZb5hH!pLz{11| zegN(wX@|7Ia!vf|5#vb6is@rEa!b{-iaH`XZ% zv*tL`rOT_c7y~fYH+EdyZ~OghgiLMVs@$;Kn@oQa4-?Qoo)FDjTkYoIC%RL{5a9Nx-x}i#*w0s*PYRN- ze*7CRjx0?FwVG$LL4B6I!b&MN*fqLT16h>%2bz>cyJpB`oJRmx7 zq%^M-NEbp92rCBfc!yxCEe1BNZ;KV8EY~Hj;3Xnh>vAA&`)J4w?$fNd_6DF~F?ov@ zr4}%hZ80M5qr4|_=(8pC*Ie25yAX7y5o9P)XRR1?Y$MWTDCO!=*dUGfAE$b{0yvf9 z-RWg0=Roso04K2=K#!Q}mH1+WEtbo_ytoy>HYCoN+@44*YRRem{R3gSQCfWf9kJpg zv8Fx%35|N3K+id~qcFOY=No=M5Y5Dk!i%7^jzfai;V{tU9)=5;X%GorBoyIdtyiQ7 zz{3EZ#*b$$dCEn)2sT+)Q0Ohfzd?tR1u$@?jb46u7N8Slmu;3H>&4@M()kzQ!Mue1 zN%)uoO4&N1GsP46s8s(@9;^I$c)#LdA5<5uBSb(c5ITU^@`y3%(C7!H_7=*%fUF?_ zs+g-zP}g6DvHOv?E*;${wrM_1H(~*P{a0-(Z17v_-K~$9ndT!UQ}-3vz!yo z*Eh$vjS~ybuitd#2K)d10iUCdd_|tc3iZD8_(~?LY%3fvY?PqWR`=;#C7iP5WB z>)``3;V2aq8+?e^(Q>I6qYU!;BB;0omFC1Bv(o`C_g?(I$;X#Rz_F~}7YHM#)cs&* zt=~cS@EZ4&b?aO5Y1T-IAOL0!(NYHQUI7Y zG!>y|WG^tYuE3iFY50^9V*%56Lahc=!;Yb&%XiywN@&<;{jhT+t~WQVVklxBoSpFg zxu}7B0rOxp<#V(hB11|LhqdlUSW8cKtP<38j&^@BMEq;uQBDupk^o>Yt+XaRfkHV2>-%^IJ)-I${TfEnaEB zs31OFHMbyP@GG=io{zA=XW6D}Ld853IUK~KaD7!O=JMh#kuQ-f@+AnWB8vl332g#- zv#{YM!2k0S>V~vLFIuox_7@FoQyHK*b@TThQ08Vb2hyU1avsFb^KdNlQ3Se^mpsx> zceR2#x!&XWQGalrOQd|IM%dAXRwb{n5}@`6(u`Y{fmDMIQ;QCr1bm&blN7zZ62n*f zPwUg=cvV2_CqnwNKk_likE_HOPNeSob)jduQ_+f;ygxK$cBZ)`Ds9CBy!?5J+=z%c zCD>#!#UAl;5)t@K)F-jW_d@2C(fvqZ;z-7r-UQS5LUKB1B{(aDTo#Sz@#a`QUep0Xvs0XD zneY$Q73jrKhe*ZPN1aPt;5k>~%ZNZ2VKmnsgUmu`p&zRavgN(VWf(EQdai=e5J7(U z1>WW{Bvy(g&;ZNTyGTLCG!+Ohfhsh(RU|&_h3+vJw}p}Ns4!0yQkIv@-SYGs1hYnp zWDy=KseKOx>8`!zidd6=o_-bB$KzD3gW#$5+9$4$lo|%3^TvihsJG;dl1Qs3O63mJ zenWfR0Hm6J@FUX^_fmY0mr|J289b1fYp_ zG|k@V%L63+Jz=LpV=KS`<(_RIIMk-EzjjrjBDF&^K(h{8k>l5~;rO|D z!9@0+c~2UUq0xX=s|jno2Ekm32_m}{k_L{SU@w&K1*-W6 znP9RME78O-uSEz#(GJZ71B}>;{6oBk2tjJ&#;$>KwtEAQvj4-QF)t)AnIMggxplO& z{lPM!4JAPRZ z6((&1-7c;(j}uOj(wc(jWB^&kt29M}EIcLZ4!<|D9qfp6fj(eVFlmvw=|jo^TMOxK zn43i#`-Yc^90#qKrEveOOeq=x3iW2w%&EEZhiOrXWQdT1Oqz$=(vkKUowX{iAa<5$ zMC3aL5I~me%OD&R$BC&z&qZ05lLl#>D(OWK35Fev-n~lk2%9?B7)fab&#u5i%z)60ePCu%%2>k{jpkX<_u&s#>q_m4Bu3QZtiEQTI6Wzl9_2_H$F(yl@r=rJ+3W4WP z>G-!SN(tZ5wTpe-B;m3x(B^$MwA6SjxZY03s1zv{aC=wQG zbKp7|qvbZ=F-hO6ga9lAOCy_P(k}=%PfM)uF{wkt^Mngi>(H2&vF?Kp7(>P;>l|pL zrOQQR`z-9Q+yoX&))3Qk=cu$QdY|eH$atI@Nf0C* zR|@ROWunbH3ZTJxB$xx1p}{jGUjnr5QV-z(i8EjGfta)^2*H$X&qYu!5M2sj?_a=X z!e%**=OUh%KuxZTn}JeDMC_yI0R2xQKIA-9BV$$?XlkrMDK(*TrH<$+mU9Kn^RQeb zo-3(N;)lh6D+p665yzQ}1$|KRXzTO~8+$`P+96=@!!)J|Ia1_77ZO>M#A&>;r~q#fC&}!g0{|Up(MGk>w z1zz%;&pJ7%kada?B;DX3xDPDNvY{q0KIJsu$~p&w&{;DAkqX=c(y~a^1e3@ItWah_ z-AqpX6RxWhmJzJQs0OY^<~lo&D!<1|DA>d31m+G>ju-pP25Pq8%2|w3T=mwA$YhDM zk{}(`WxClkrHIS+rcL0|LmgAIN6+E@Gzi;N zfX1nznir1H)6nH;eV`54g(2$t5UxdvxB9k7CgXGC=nI?WKs3GahTyFOuxc&aMhdGC?t0*v=j z`By2$6jkuB{*c*%2x&<8fC+mSOyK~mn2E`lYW(gqk;_gTx5NrvL>F#RZGLXRTtUAS zRXIcg5Ixk6YR^kR9{pEL5Q&^yEq}D&wGBG~!XDc||G%aQJ)o8#*EV~L%>RXr%P2Py zw?)qUQxyRo(KfEhXrjxgsA2zC|Mz+V)FwbzYSd^L@CgWrR{M)VW|sG5=DF^n|LY_J zyhi5KHcv5iLIm9RT#1tv--UGnH7h{+yc~zpl(arx5}>U|@eykY@*_98^93~|oO1!I zBp`bz28em# zb>?g`U-mTxb8cKEM=}_56q$yy6-wi5!-gN1np+J(0kGgkN69G1+%JDJ%t|7h z`V7wI9O)#QkKv1Eq9b2HHq#P4>u(o5D}#!OR}#C5yxB3$0|26$%>hXVKSEB6XmDrV zv;JWb59sE%1qdD^xd*rQjG5p{1h-cx`v`;6_TqQZ>mP@{%(DUY`>?pFGP)1Mx^$afs6*F*vy)2A!~ib3o*u#HR{Q zEh736i9l0GiZ0F}{9a1X1jd%z2FNI`CC3HYYi)*q%|?(x23kQm8#m`$YMsjdPSra zBi`83BnerCjq*SWVt|DsTZ#EgkXD^k>mW$pTL~ShH+{@G6l+l2Y_kWE1H6DNwgsq6 z=OOQQ3iS+G@stOq(I%$+0?{UMO@3U~OQ#>0TFi)JEk35)+9Yb)6^_e>5io!)cP2WC z+DwuL{__EHL`P33OH>QC1);HceAv!|J;g4UylimH8fs`D|!*onoH~(l( z_^kf-Oc--LE<`BE;!5mkq z3a;B-aZY+*IO@@TyJGd|-=pKJ7_kGiJx*0Y{s&U;6l!{0>m7d`?~@(%{dw}q1Y?w7 z-eJM;9sP3Cd_l5Qh~t<2g31F`)rbm2TF_|7mDYKQ1$bcl)j{8eE>j=)sCOAWD{AF6 zODeo4emBS$@TuP@e2vaAaUn%Qxot0c^OwFqL}JH(BcVn=UeGf>%g?5VN*HP zJ_$9(TbDKA-`$TT)1EIuQtT?&n6Xt{3-;y+s+qMpZL#$>4c^rAbMbjuv#89G(4>lI}M1M*nM8`oB(0)v>r2rd>g- zXlnTgv$D1RVN^itZ%v0I>Swo{oRg?elXiIhW$gDOxqwA?pKZ`?$(Gu#@!0Fk zUql(jF~alH(EAAIt|vU!W5y}UE#+VKy_MCSL&G;QHTfZQ!=D7j+tBl`n{I1Ra-sH? zkw&X%?X>)$u|J>T9}s2J9#?wbSk+U{Uu)r-`d zi@?;bhe7^d)L*_Zm}n>F=b65Icl&Uk^WZOkcc56pTy#epbfg_#Tt5H0ed&D~oMx;b z`S31W-}CCZ{wmmaDLp;64=_^-E;SZ+Fv^~n-1ykzPVM27b#01yg{e<68$atE*H`N6 z8QpAoH)>{6SJ#d+>pi%@q^nQxW3lE{<}!}rrhID~*(~`Tq0&PKJ(glZ0`GrcocaI0 zb**;wdQ)wXWEy0+Xt`lSn9|4w}$?BEcQ8gIYN!L&Kv-Z-x^$JXTa*{Pzc+&gG7 zQ%36Q-cOz8R)uS(_k^eFYR}PbXJ5{M9USPcE+gs>%h*|ojXBK3_#4ehES$4`r=IoN zO%fG$#*5Lcw5`WgxoK-d66#>uuE@D(Up$WR_n1Ye{qFm$Gl`fWX~=ZfnQYHSHEkL3 zikV2GiyLGo=f_wb`=}w{lwBAu_0^R%VZHKtuCTt6y#QO~{K$*9%Pp?{p+xWapWFKr zA6ALxdb@v~+JCO$NxJ!x+-vuvxHBf>^7?%%LdWTWYZt;_e_85dstn|2{`2FuJ+Ae~ zo$jwb+kXF?Q9Z4HCRECXK7!Jn=o!^p`W^o%Q(ktIR_87joPS5EcGqCacZtqFA4m~y zD~J9M_JZ}MyIDEi{cchNce?e?yAG)>iPE||9%XcKn};3`{bM*R3^|$M_h7Hyw&fqC zkJ%Hul?`&|)Q@;CtDM2&K_nl5vaBX0*qb|Kt9L@`&RG+3_WQt;3BS;xse#^hs3-#@C?HUq)r;a5gI$CGe}WQ%4pL zdHuMAD#nRz8*}S!=kIy(E4Y0I4*r^m{Di|___#Z4?tjYCPs~hCV;+pZKXU#^u_W)l z@))~%eAD1N+TZ;FL;1YAjIQUG>4$x8GauJNB>%JUn ze>_iS+3e!S&!g9z!%P~>e`#1YJ{*GlRAj!0FMZF7`ErCC8;3?sNeuUPZht0Y#H;UW z9$K?CkzR_6&rT?h4I6)6@q=R=06vjFer4*^>(adB#SwDQEf-qC=f~v5<{;R3JF@Cl z>az;bceoufHc49;>B%qKb|4SOfe&%V!w-zs_}}T$DY^a(@p<319`5lohfUd@rW<+!klTnbdZ)ROKkpsZ{mM+o zhK1Ths%N7F9M8~Oyb~XAd^YumvgYRE*6>+mV8fr~bEYwU^o1 z9UB-LgYd1T#>wInfzR@4An*2JHuq9*Tq1fV=dkZ+1B zzYPyM@zGk26EGsn7@wWlk29{{SNpHNT2;$mdgpfqBJcd{}-VRUb?-u3lOS)5mQnJq>5(R3t)6D&fl7QTvyglv-R4Id?*yU5 z%f;uO%4nwWt6!$fmF9emeO_6)US@}^Bm305-eb!j-~}J8Z00uAmg~hYNh}4A&`vr= zMt*n87(YG-{k*d`5Yf;wJhy)woj@8I(q8UtQt}wvxmE6Mb936^x~GX!ORSll)KZ*8 zfXv-s_c+_kY`NchmdqjQ6tlCvh;8s>HBR2RD$Ic*2F0DYJ=5Sg_v`sTaX0hfR>9bT zDy*Z7m^+JhNnlz<@OR6t=_9hw)%fZ@6!*NcbDli8_GwY)noHNid)}!J8G8?4rqloV z_bI^{vRZM{{wr>T>M*v@?uLH5r1YThh|bPS^3~~6`Uh`r-4`gEaqU=s*x0wTA=|=A z((4DkJ@(B{z}$D7{`bOr{~Pw3FxR~TR8I`;G_N&di)FHCHw8_+m%9JkR?~v=+#Yo- g>+1E6e}<0!^>J6-_#5wE&>t(i(ge%LH~sN{00{_3+yDRo diff --git a/wpgsd.Rcheck/vign_test/wpgsd/DESCRIPTION b/wpgsd.Rcheck/vign_test/wpgsd/DESCRIPTION deleted file mode 100644 index f2d0d12..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/DESCRIPTION +++ /dev/null @@ -1,45 +0,0 @@ -Package: wpgsd -Title: Weighted Parametric Group Sequential Design -Version: 0.1.0 -Authors@R: c( - person("Keaven", "Anderson", email = "keaven_anderson@merck.com", role = "aut"), - person("Zifang", "Guo", email = "zifang.guo@merck.com", role = "aut"), - person("Jing", "Zhao", email = "jing_zhaox@merck.com", role = "aut"), - person("Linda", "Sun", email = "linda_sun@merck.com", role = "aut"), - person("Yi", "Cui", email = "yi.cui@merck.com", role = "aut"), - person("Yujie", "Zhao", email = "yujie.zhao@merck.com", role = c("aut", "cre")), - person("Larry", "Leon", email = "larry.leon2@merck.com", role = "aut"), - person("Merck Sharp & Dohme Corp", role = c("cph")) - ) -Description: Adjusted inference for weighted parametric group sequential design. - Weighted parametric group sequential design (WPGSD) by Anderson et al. (2022) - allows one to take advantage of the known - correlation structure in constructing efficacy bounds to control - family-wise error rate (FWER) for a group sequential design. - Here, correlation may be due to common observations in nested populations, - due to common observations in overlapping populations, or due to common - observations in the control arm. -License: GPL (>= 3) -URL: https://merck.github.io/wpgsd/, https://github.com/Merck/wpgsd -BugReports: https://github.com/Merck/wpgsd/issues -Encoding: UTF-8 -Depends: R (>= 3.6), S7 -Imports: dplyr, gMCPLite, gsDesign, mvtnorm, rlang (>= 0.4.11), S7, - stats, tibble, tidyselect -Suggests: covr, gt, haven, knitr, reshape2, rmarkdown, roxygen2, - testthat (>= 3.0.0), tidyr -VignetteBuilder: knitr -Config/testthat/edition: 3 -Roxygen: list(markdown = TRUE) -RoxygenNote: 7.3.1 -NeedsCompilation: no -Packaged: 2025-08-29 19:14:20 UTC; Anderkea -Author: Keaven Anderson [aut], - Zifang Guo [aut], - Jing Zhao [aut], - Linda Sun [aut], - Yi Cui [aut], - Yujie Zhao [aut, cre], - Larry Leon [aut], - Merck Sharp & Dohme Corp [cph] -Maintainer: Yujie Zhao diff --git a/wpgsd.Rcheck/vign_test/wpgsd/EventTable_README.md b/wpgsd.Rcheck/vign_test/wpgsd/EventTable_README.md deleted file mode 100644 index 8c3917b..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/EventTable_README.md +++ /dev/null @@ -1,124 +0,0 @@ -# EventTable S7 Class Implementation - -## Overview - -The `EventTable` S7 class provides a type-safe, validated data structure for representing event count data used in the wpgsd package. This is the first step in converting the wpgsd package to use S7 classes throughout. - -## Features - -### Core Properties -- **data**: A tibble containing the event count data with required columns `H1`, `H2`, `Analysis`, `Event` -- **n_hypotheses**: Automatically calculated number of hypotheses -- **n_analyses**: Automatically calculated number of analyses - -### Validation -- Validates presence of required columns (`H1`, `H2`, `Analysis`, `Event`) -- Ensures proper data types (all numeric) -- Validates logical constraints: - - Hypothesis indices must be positive integers - - Analysis numbers must be positive integers - - Event counts must be non-negative - -### Methods -- **print()**: Clean formatted output showing key information -- **summary()**: Detailed summary including event count statistics -- **subset_event_table()**: Subset by analysis or hypotheses -- **as_event_table()**: Convert tibble to EventTable -- **validate_event_table_data()**: Validate data format before processing - -## Usage Examples - -### Basic Usage -```r -library(wpgsd) - -# Create event data -event_data <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160, - 1, 2, 1, 85, - 1, 1, 2, 305, - 2, 2, 2, 320, - 1, 2, 2, 170 -) - -# Create EventTable object -event_table <- EventTable(data = event_data) -print(event_table) -``` - -### Data Validation -```r -# The constructor automatically validates data -tryCatch({ - invalid_data <- tibble::tibble( - H1 = c(1, -2), # Invalid: negative hypothesis index - H2 = c(1, 2), - Analysis = c(1, 1), - Event = c(100, 200) - ) - EventTable(data = invalid_data) -}, error = function(e) { - cat("Validation error:", e$message) -}) -``` - -### Subsetting -```r -# Subset by analysis -analysis_1 <- subset_event_table(event_table, analysis = 1) - -# Subset by hypotheses -h1_h2 <- subset_event_table(event_table, hypotheses = c(1, 2)) -``` - -### Integration with Existing Functions -```r -# Use with existing wpgsd functions -correlation_matrix <- generate_corr(event_table@data) -``` - -## Files Created - -- `R/s7_classes.R`: Main S7 class definition -- `tests/testthat/test-s7-event-table.R`: Comprehensive unit tests -- `examples/test_event_table.R`: Basic usage examples -- `examples/event_table_integration.R`: Integration with existing functions - -## Dependencies - -- Added `S7` to package imports in `DESCRIPTION` -- Uses existing dependencies: `tibble`, `dplyr` - -## Benefits - -1. **Type Safety**: Prevents invalid data from being passed to wpgsd functions -2. **Validation**: Automatic validation of data format and constraints -3. **Documentation**: Self-documenting data structures -4. **Method Dispatch**: Extensible with specialized methods -5. **User Experience**: Clear error messages and helpful summaries - -## Next Steps - -This EventTable implementation provides the foundation for converting the wpgsd package to S7 classes. Future steps include: - -1. Create `CorrelationMatrix` S7 class for `generate_corr()` output -2. Create `Bounds` S7 class for `generate_bounds()` output -3. Update existing functions to accept/return S7 objects -4. Maintain backward compatibility with existing tibble/data.frame inputs - -## Testing - -Run the comprehensive test suite: -```r -testthat::test_file("tests/testthat/test-s7-event-table.R") -``` - -The tests cover: -- Object creation with valid data -- Validation of required columns -- Data type and value validation -- Print and summary methods -- Subsetting functionality -- Data conversion utilities diff --git a/wpgsd.Rcheck/vign_test/wpgsd/NAMESPACE b/wpgsd.Rcheck/vign_test/wpgsd/NAMESPACE deleted file mode 100644 index d451590..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/NAMESPACE +++ /dev/null @@ -1,37 +0,0 @@ -# Generated by roxygen2: do not edit by hand - -export(":=") -export(.data) -export(as_label) -export(as_name) -export(calc_seq_p) -export(closed_test) -export(enquo) -export(enquos) -export(find_astar) -export(find_xi) -export(generate_bounds) -export(generate_corr) -export(generate_event_table) -importFrom(dplyr,"%>%") -importFrom(dplyr,arrange) -importFrom(dplyr,bind_rows) -importFrom(dplyr,filter) -importFrom(dplyr,mutate) -importFrom(dplyr,num_range) -importFrom(dplyr,select) -importFrom(gMCPLite,gMCP) -importFrom(gMCPLite,getWeights) -importFrom(mvtnorm,GenzBretz) -importFrom(mvtnorm,pmvnorm) -importFrom(rlang,":=") -importFrom(rlang,.data) -importFrom(rlang,as_label) -importFrom(rlang,as_name) -importFrom(rlang,enquo) -importFrom(rlang,enquos) -importFrom(stats,pnorm) -importFrom(stats,qnorm) -importFrom(stats,uniroot) -importFrom(tibble,tibble) -importFrom(tidyselect,all_of) diff --git a/wpgsd.Rcheck/vign_test/wpgsd/NEWS.md b/wpgsd.Rcheck/vign_test/wpgsd/NEWS.md deleted file mode 100644 index d58f9e4..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/NEWS.md +++ /dev/null @@ -1,17 +0,0 @@ -# wpgsd 0.1.0 - -- Initial release. - -The wpgsd package is now available on GitHub, install it with - -``` -remotes::install_github("Merck/wpgsd") -``` - -If you prefer to use a specific version, install it with - -``` -remotes::install_github("Merck/wpgsd@v0.1.0") -``` - -where `v0.1.0` is the GitHub release version number. diff --git a/wpgsd.Rcheck/vign_test/wpgsd/R/calc_seq_p.R b/wpgsd.Rcheck/vign_test/wpgsd/R/calc_seq_p.R deleted file mode 100644 index e123680..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/R/calc_seq_p.R +++ /dev/null @@ -1,144 +0,0 @@ -# Copyright (c) 2023 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. -# All rights reserved. -# -# This file is part of the wpgsd program. -# -# wpgsd 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 . - -#' Calculate sequential p-values for interaction/elementary hypothesis -#' -#' @param test_analysis The index of the analysis to be tested, such as 1, 2, ... -#' @param test_hypothesis A character of the tested interaction/elementary hypothesis, -#' such as `"H1, H2, H3"`, `H1, H2`, `"H1"`. -#' @param p_obs Observed p-values up to `test_analysis`. -#' @param n_analysis Total number of analysis. -#' @param alpha_spending_type Type Boundary type. -#' - `0` - Bonferroni. Separate alpha spending for each hypotheses. -#' - `1` - Fixed alpha spending for all hypotheses. Method 3a in the manuscript. -#' - `2` - Overall alpha spending for all hypotheses. Method 3b in the manuscript. -#' - `3` - Separate alpha spending for each hypotheses. Method 3c in the manuscript. -#' @param initial_weight Initial weight assigned to the elementary hypothesis. -#' @param transition_mat Transition matrix. -#' @param z_corr Correlation matrix of the Z statistics. -#' @param spending_fun Spending function. -#' @param spending_fun_par Parameter of the spending function. -#' @param info_frac Information fractions. -#' @param interval Interval to search the uniroot. -#' -#' @return The sequential p-values of the `test_hypothesis` at the `test_analysis`. -#' -#' @importFrom dplyr %>% filter num_range select -#' @importFrom stats uniroot -#' -#' @export -#' -#' @examples -#' \donttest{ -#' calc_seq_p( -#' test_analysis = 2, -#' test_hypothesis = "H1, H2, H3", -#' p_obs = tibble::tibble( -#' analysis = 1:2, -#' H1 = c(0.02, 0.0015), -#' H2 = c(0.01, 0.01), -#' H3 = c(0.01, 0.004) -#' ), -#' alpha_spending_type = 2, -#' n_analysis = 2, -#' initial_weight = c(0.3, 0.3, 0.4), -#' transition_mat = matrix(c( -#' 0.0000000, 0.4285714, 0.5714286, -#' 0.4285714, 0.0000000, 0.5714286, -#' 0.5000000, 0.5000000, 0.0000000 -#' ), nrow = 3, byrow = TRUE), -#' z_corr = matrix( -#' c( -#' 1.0000000, 0.7627701, 0.6666667, 0.7071068, 0.5393599, 0.4714045, -#' 0.7627701, 1.0000000, 0.6992059, 0.5393599, 0.7071068, 0.4944132, -#' 0.6666667, 0.6992059, 1.0000000, 0.4714045, 0.4944132, 0.7071068, -#' 0.7071068, 0.5393599, 0.4714045, 1.0000000, 0.7627701, 0.6666667, -#' 0.5393599, 0.7071068, 0.4944132, 0.7627701, 1.0000000, 0.6992059, -#' 0.4714045, 0.4944132, 0.7071068, 0.6666667, 0.6992059, 1.0000000 -#' ), -#' nrow = 6, byrow = TRUE -#' ), -#' spending_fun = gsDesign::sfHSD, -#' spending_fun_par = -4, -#' info_frac = c(0.5, 1), -#' interval = c(1e-4, 0.2) -#' ) -#' } -calc_seq_p <- function( - test_analysis = 2, - test_hypothesis = "H1, H2, H3", - p_obs = tibble::tibble( - analysis = 1:2, - H1 = c(0.02, 0.0015), - H2 = c(0.01, 0.01), - H3 = c(0.01, 0.004) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = c(0.3, 0.3, 0.4), - transition_mat = matrix(c( - 0.0000000, 0.4285714, 0.5714286, - 0.4285714, 0.0000000, 0.5714286, - 0.5000000, 0.5000000, 0.0000000 - ), nrow = 3, byrow = TRUE), - z_corr = matrix( - c( - 1.0000000, 0.7627701, 0.6666667, 0.7071068, 0.5393599, 0.4714045, - 0.7627701, 1.0000000, 0.6992059, 0.5393599, 0.7071068, 0.4944132, - 0.6666667, 0.6992059, 1.0000000, 0.4714045, 0.4944132, 0.7071068, - 0.7071068, 0.5393599, 0.4714045, 1.0000000, 0.7627701, 0.6666667, - 0.5393599, 0.7071068, 0.4944132, 0.7627701, 1.0000000, 0.6992059, - 0.4714045, 0.4944132, 0.7071068, 0.6666667, 0.6992059, 1.0000000 - ), - nrow = 6, byrow = TRUE - ), - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(0.5, 1), - interval = c(1e-4, 0.2)) { - foo <- function(x) { - all_hypothesis <- strsplit(test_hypothesis, split = ", ") %>% unlist() - all_hypothesis_idx <- as.numeric(gsub(".*?([0-9]+).*", "\\1", all_hypothesis)) - - ans <- generate_bounds( - type = alpha_spending_type, - k = n_analysis, - w = initial_weight, - m = transition_mat, - corr = z_corr, - alpha = x, - sf = spending_fun, - sfparm = spending_fun_par, - t = info_frac - ) %>% - arrange(Analysis) %>% - filter(Analysis <= test_analysis, Hypotheses == test_hypothesis) - - p_diff <- NULL - for (hhh in all_hypothesis) { - p_diff_new <- (p_obs %>% filter(analysis <= test_analysis))[[hhh]] - ans[[hhh]] - p_diff <- c(p_diff, p_diff_new) - } - - return(min(p_diff)) - } - - seq_p <- uniroot(foo, lower = interval[1], upper = interval[2])$root - - return(seq_p) -} diff --git a/wpgsd.Rcheck/vign_test/wpgsd/R/closed_test.R b/wpgsd.Rcheck/vign_test/wpgsd/R/closed_test.R deleted file mode 100644 index 0da045d..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/R/closed_test.R +++ /dev/null @@ -1,102 +0,0 @@ -# Copyright (c) 2023 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. -# All rights reserved. -# -# This file is part of the wpgsd program. -# -# wpgsd 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 . - -#' Perform closed testing procedure -#' -#' @param bounds A tibble of nominal p-value boundaries from [generate_bounds()] -#' containing columns `Analysis`, `Hypotheses`, `H1`, `H2`, etc. -#' @param p_obs A tibble of observed p-values containing columns -#' `Analysis`, `H1`, `H2`, etc. -#' -#' @return An outcome matrix summarizing the testing results. -#' -#' @importFrom dplyr %>% filter num_range select -#' -#' @export -#' -#' @examples -#' p_obs <- dplyr::bind_rows( -#' tibble::tibble(Analysis = 1, H1 = 0.001, H2 = 0.001), -#' tibble::tibble(Analysis = 2, H1 = 0.001, H2 = 0.001) -#' ) -#' bound <- tibble::tribble( -#' ~Analysis, ~Hypotheses, ~H1, ~H2, -#' 1, "H1", 0.02, NA, -#' 1, "H1, H2", 0.0001, 0.00001, -#' 1, "H2", NA, 0.003, -#' 2, "H1", 0.02, NA, -#' 2, "H1, H2", 0.02, 0.00001, -#' 2, "H2", NA, 0.003 -#' ) -#' -#' closed_test <- closed_test(bound, p_obs) -closed_test <- function(bounds, p_obs) { - n_analyses <- max(p_obs$Analysis) - n_hypotheses <- ncol(p_obs) - 1 - - result <- NULL - - for (i in 1:n_analyses) { - # results comparing p-value with bound at current analysis - p_tmp <- p_obs %>% - filter(Analysis == i) %>% - select(num_range("H", 1:n_hypotheses)) - bounds_tmp <- bounds %>% - filter(Analysis == i) %>% - select(num_range("H", 1:n_hypotheses)) - test_raw <- c(unlist(p_tmp)) < t(bounds_tmp) - - # number of intersection hypothesis - n_inter <- ncol(test_raw) - - # initial testing result of each intersection hypothesis - test_inter <- apply(test_raw, 2, any, na.rm = TRUE) - - # if a hypothesis was rejected in a previous analysis, then all - # intersection hypothesis including that hypothesis is rejected - if (i != 1) { - # previous testing results - prev_res <- apply(result %>% dplyr::select(num_range("H", 1:n_hypotheses)), 2, any) - # hypothesis number that was rejected in any previous analyses - prev_reject <- c(1:n_hypotheses)[prev_res] - # intersection hypothesis that includes previous rejected hypothesis - inter_reject <- matrix(!is.na(test_raw[prev_reject, ]), ncol = n_inter) - indx_inter_reject <- c(1:n_inter)[apply(inter_reject, 2, sum) > 0] - # convert testing result to TRUE for above intersection hypothesis - test_inter[indx_inter_reject] <- TRUE - } - - # testing result of each elementary hypothesis - test_tmp <- rep(NA, n_hypotheses) - for (j in 1:n_hypotheses) { - indx <- !is.na(test_raw[j, ]) - test_elem <- all(test_inter[indx]) - test_tmp[j] <- test_elem - } - names(test_tmp) <- paste("H", 1:n_hypotheses, sep = "") - test_tmp <- data.frame(t(test_tmp)) - test_tmp$Analysis <- paste("Analysis", i) - result <- dplyr::bind_rows(result, test_tmp) - } - - result[result == TRUE] <- "Success" - result[result == FALSE] <- "Fail" - rownames(result) <- NULL - - return(result) -} diff --git a/wpgsd.Rcheck/vign_test/wpgsd/R/d_corr.R b/wpgsd.Rcheck/vign_test/wpgsd/R/d_corr.R deleted file mode 100644 index a8b68ba..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/R/d_corr.R +++ /dev/null @@ -1,33 +0,0 @@ -# Copyright (c) 2023 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. -# All rights reserved. -# -# This file is part of the wpgsd program. -# -# wpgsd 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 . - -#' Convert event matrix to correlation matrix -#' -#' @param D Event matrix. -#' -#' @return Correlation matrix. -#' -#' @noRd -#' -#' @examples -#' d_corr(D = matrix(c(1, 2, 3, 4, 5, 6, 7, 8, 9), nrow = 3)) -d_corr <- function(D) { - B <- matrix(0, nrow = nrow(D), ncol = nrow(D)) - diag(B) <- 1 / sqrt(diag(D)) - return(B %*% D %*% B) -} diff --git a/wpgsd.Rcheck/vign_test/wpgsd/R/find_astar.R b/wpgsd.Rcheck/vign_test/wpgsd/R/find_astar.R deleted file mode 100644 index 628769d..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/R/find_astar.R +++ /dev/null @@ -1,90 +0,0 @@ -# Copyright (c) 2023 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. -# All rights reserved. -# -# This file is part of the wpgsd program. -# -# wpgsd 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 . - -#' Utility function for root-finding to compute crossing probabilities -#' with the overall alpha spending approach -#' -#' @param a Cumulative overall alpha spending up to current analysis. -#' @param alpha_prev alpha boundary at previous interim analyses using -#' the WPGSD approach. -#' @param astar Total nominal alpha level at current analysis from -#' the WPGSD approach. -#' @param w Vector of alpha weights at current analysis. -#' @param sig Correlation matrix of previous and current analyses test statistics. -#' @param maxpts GenzBretz function maximum number of function values as integer. -#' @param abseps GenzBretz function absolute error tolerance. -#' @param ... Additional arguments. -#' -#' @return Difference. Should be 0 with `a` and `astar` identified. -#' -#' @export -#' -#' @examples -#' # Input event count of intersection of paired hypotheses - Table 2 -#' my_event <- tibble::tribble( -#' ~H1, ~H2, ~Analysis, ~Event, -#' 1, 1, 1, 155, -#' 2, 2, 1, 160, -#' 3, 3, 1, 165, -#' 1, 2, 1, 85, -#' 1, 3, 1, 85, -#' 2, 3, 1, 85, -#' 1, 1, 2, 305, -#' 2, 2, 2, 320, -#' 3, 3, 2, 335, -#' 1, 2, 2, 170, -#' 1, 3, 2, 170, -#' 2, 3, 2, 170 -#' ) -#' -#' # Generate correlation from events -#' my_corr <- generate_corr(my_event) -#' -#' # Find the inflation factor for H1, H2 at analysis 1 -#' find_astar( -#' a = 0.0008708433, -#' alpha_prev = NULL, -#' aprime = c(0.0004588644, 0.0004119789), -#' astar = 1, -#' w = c(0.5, 0.5), -#' sig = my_corr[ -#' colnames(my_corr) %in% c("H1_A1", "H2_A1"), -#' colnames(my_corr) %in% c("H1_A1", "H2_A1") -#' ] -#' ) -find_astar <- function(a, alpha_prev = NULL, astar, w, sig, maxpts = 50000, abseps = 0.00001, ...) { - # Remove column name for proper pmvnorm run - colnames(sig) <- NULL - - if (is.null(alpha_prev)) { - res <- 1 - a - mvtnorm::pmvnorm( - lower = -Inf, - upper = qnorm(1 - w * astar), - sigma = sig, - algorithm = mvtnorm::GenzBretz(maxpts = maxpts, abseps = abseps) - ) - } else { - res <- 1 - a - mvtnorm::pmvnorm( - lower = -Inf, - upper = c(qnorm(1 - alpha_prev), qnorm(1 - w * astar)), - sigma = sig, - algorithm = mvtnorm::GenzBretz(maxpts = maxpts, abseps = abseps) - ) - } - return(res) -} diff --git a/wpgsd.Rcheck/vign_test/wpgsd/R/find_xi.R b/wpgsd.Rcheck/vign_test/wpgsd/R/find_xi.R deleted file mode 100644 index b99e9a4..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/R/find_xi.R +++ /dev/null @@ -1,90 +0,0 @@ -# Copyright (c) 2023 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. -# All rights reserved. -# -# This file is part of the wpgsd program. -# -# wpgsd 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 . - -#' Utility function for root-finding to compute inflation factor xi -#' with the separate alpha spending approach -#' -#' @param a Sum of cumulative alpha spending from the Bonferroni approach. -#' @param alpha_prev alpha boundary at previous interim analyses using the MTP approach. -#' @param aprime Nominal alpha boundary from the Bonferroni approach. -#' @param xi Inflation factor. -#' @param sig Correlation matrix of previous and current analyses test statistics. -#' @param maxpts GenzBretz function maximum number of function values as integer. -#' @param abseps GenzBretz function absolute error tolerance. -#' @param ... Additional arguments. -#' -#' @return Difference. Should be 0 with `xi` identified. -#' -#' @importFrom mvtnorm pmvnorm GenzBretz -#' @importFrom stats qnorm -#' -#' @export -#' -#' @examples -#' # Input event count of intersection of paired hypotheses - Table 2 -#' my_event <- tibble::tribble( -#' ~H1, ~H2, ~Analysis, ~Event, -#' 1, 1, 1, 155, -#' 2, 2, 1, 160, -#' 3, 3, 1, 165, -#' 1, 2, 1, 85, -#' 1, 3, 1, 85, -#' 2, 3, 1, 85, -#' 1, 1, 2, 305, -#' 2, 2, 2, 320, -#' 3, 3, 2, 335, -#' 1, 2, 2, 170, -#' 1, 3, 2, 170, -#' 2, 3, 2, 170 -#' ) -#' -#' # Generate correlation from events -#' my_corr <- generate_corr(my_event) -#' -#' # Find the inflation factor for H1, H2 at analysis 1 -#' find_xi( -#' a = 0.0008708433, -#' alpha_prev = NULL, -#' aprime = c(0.0004588644, 0.0004119789), -#' xi = 1, -#' sig = my_corr[ -#' colnames(my_corr) %in% c("H1_A1", "H2_A1"), -#' colnames(my_corr) %in% c("H1_A1", "H2_A1") -#' ] -#' ) -find_xi <- function(a, alpha_prev = NULL, aprime, xi, sig, maxpts = 50000, abseps = 0.00001, ...) { - # Remove column name for proper pmvnorm run - colnames(sig) <- NULL - - if (is.null(alpha_prev)) { - res <- 1 - a - pmvnorm( - lower = -Inf, - upper = qnorm(1 - xi * aprime), - sigma = sig, - algorithm = GenzBretz(maxpts = maxpts, abseps = abseps) - ) - } else { - res <- 1 - a - pmvnorm( - lower = -Inf, - upper = c(qnorm(1 - alpha_prev), qnorm(1 - xi * aprime)), - sigma = sig, - algorithm = GenzBretz(maxpts = maxpts, abseps = abseps) - ) - } - return(res) -} diff --git a/wpgsd.Rcheck/vign_test/wpgsd/R/generate_bounds.R b/wpgsd.Rcheck/vign_test/wpgsd/R/generate_bounds.R deleted file mode 100644 index 91754c4..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/R/generate_bounds.R +++ /dev/null @@ -1,326 +0,0 @@ -# Copyright (c) 2023 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. -# All rights reserved. -# -# This file is part of the wpgsd program. -# -# wpgsd 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 . - -#' Compute p-value boundaries of the parametric MTP method with overall -#' alpha spending for all hypotheses -#' -#' @param type Boundary type. -#' - `0` = Bonferroni. Separate alpha spending for each hypotheses. -#' - `1` = Fixed alpha spending for all hypotheses. Method 3a in the manuscript. -#' - `2` = Overall alpha spending for all hypotheses. Method 3b in the manuscript. -#' - `3` = Separate alpha spending for each hypotheses. Method 3c in the manuscript. -#' @param k Number of analyses up to the current analysis. -#' @param w Initial weights. -#' @param m Transition matrix. -#' @param corr Correlation matrix of all test statistics up to the -#' current analysis. dim = k * length(w). -#' @param alpha Overall alpha. -#' @param cum_alpha Cumulative alpha spent at each analysis. -#' Only required for `type = 1`. -#' @param sf A list of alpha spending functions to spend alpha for -#' each hypotheses. -#' - If `type = 0` or `3` then length equals to number of hypotheses. -#' - If `type = 1` then `sf` is not needed. -#' - If `type = 2` then only the first component is used. -#' @param sfparm A list of parameters to be supplied to sfs. -#' - If `type = 0` or `3` then length equals to number of hypotheses. -#' - If `type = 1` then `sfparm` is not needed. -#' - If `type = 2` then only the first component is used. -#' @param t A list of information fraction used for alpha spending, -#' may be different from the actual information fraction. -#' Each component corresponds to a hypothesis. -#' - If `type = 0` or `3` then length equals to number of hypotheses. -#' - If `type = 1` then `t` is not needed. -#' - If `type = 2` then only the first component is used. -#' @param maxpts GenzBretz function maximum number of function values -#' as integer. -#' @param abseps GenzBretz function absolute error tolerance. -#' @param tol Find root tolerance. -#' @param ... Additional arguments. -#' -#' @return A tibble with `k * (2^(n_hypotheses - 1))` rows of -#' p-value boundaries. Inflation factor is also provided if `type = 3`. -#' -#' @importFrom dplyr %>% bind_rows arrange mutate -#' @importFrom gMCPLite gMCP getWeights -#' @importFrom tibble tibble -#' @importFrom stats pnorm uniroot -#' -#' @export -#' -#' @examples -#' # Build the transition matrix -#' m <- matrix(c( -#' 0, 0.5, 0.5, -#' 0.5, 0, 0.5, -#' 0.5, 0.5, 0 -#' ), nrow = 3, byrow = TRUE) -#' -#' # Initialize weights -#' w <- c(1 / 3, 1 / 3, 1 / 3) -#' -#' # Input information fraction -#' IF_IA <- c(155 / 305, 160 / 320, 165 / 335) -#' -#' # Input event count of intersection of paired hypotheses - Table 2 -#' event <- tibble::tribble( -#' ~H1, ~H2, ~Analysis, ~Event, -#' 1, 1, 1, 155, -#' 2, 2, 1, 160, -#' 3, 3, 1, 165, -#' 1, 2, 1, 85, -#' 1, 3, 1, 85, -#' 2, 3, 1, 85, -#' 1, 1, 2, 305, -#' 2, 2, 2, 320, -#' 3, 3, 2, 335, -#' 1, 2, 2, 170, -#' 1, 3, 2, 170, -#' 2, 3, 2, 170 -#' ) -#' -#' # Generate correlation from events -#' gs_corr <- generate_corr(event) -#' -#' # Generate bounds -#' generate_bounds( -#' type = 3, -#' k = 2, -#' w = w, -#' m = m, -#' corr = gs_corr, -#' alpha = 0.025, -#' sf = list(gsDesign::sfLDOF, gsDesign::sfLDOF, gsDesign::sfLDOF), -#' sfparm = list(0, 0, 0), -#' t = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[3], 1)) -#' ) -generate_bounds <- function(type = 1, k = 2, w = w, m = m, - corr = corr, alpha = 0.025, cum_alpha = NULL, - maxpts = 50000, abseps = 0.00001, tol = 1e-10, - sf = gsDesign::sfHSD, sfparm = -4, t = c(0.5, 1), ...) { - if (type == 1 && is.null(cum_alpha)) { - stop("Boundary type is 1 (fixed alpha spending) but no cummulative alpha was provided.") - } - - if (type == 2) { - if (is.list(sf)) { - sf <- sf[[1]] - } - if (is.list(sfparm)) { - sfparm <- sfparm[[1]] - } - if (is.list(t)) { - t <- t[[1]] - } - } - - # Number of hypotheses - n_hypotheses <- length(w) - - # Get weights for all intersection hypotheses - graph <- gMCPLite::matrix2graph(m) - graph <- gMCPLite::setWeights(graph, w) - - # Set up hypothetical pvalues (0 or 1) to obtain all combinations - pvals <- NULL - for (i in 1:n_hypotheses) { - if (i == 1) { - pvals <- data.frame(x = c(0, 1)) - names(pvals) <- paste("pval_H", i, sep = "") - } else { - tmp <- data.frame(x = c(0, 1)) - names(tmp) <- paste("pval_H", i, sep = "") - pvals <- merge(pvals, tmp) - } - } - - # Weights for each intersection hypothesis - inter_weight <- NULL - for (i in seq_len(nrow(pvals))) { - pval_tmp <- as.numeric(pvals[i, ]) - graph_tmp <- gMCPLite::gMCP(graph = graph, pvalues = pval_tmp, alpha = alpha) - weight_tmp <- gMCPLite::getWeights(graph_tmp) - inter_weight <- dplyr::bind_rows(inter_weight, weight_tmp) - } - - inter_weight <- replace(inter_weight, pvals == 0, NA) - inter_weight <- inter_weight[-1, ] - # inter_weight <- replace(inter_weight, inter_weight == 0, NA) - - # Get boundaries - bounds <- NULL - for (j in seq_len(nrow(inter_weight))) { - w_tmp0 <- inter_weight[j, ] - # Hypotheses included in the intersection hypothesis - hypotheses <- col(w_tmp0)[!is.na(w_tmp0)] - - # Remove NA from weight - w_tmp <- w_tmp0[(!is.na(w_tmp0))] - w_tmp0 <- as.numeric(w_tmp0) - - if (type == 0) { # Bonferroni - - bounds_tmp <- tibble( - Analysis = 1:k, - Hypotheses = paste("H", hypotheses, sep = "", collapse = ", ") - ) - - for (h in 1:n_hypotheses) { - if (!h %in% hypotheses) { - p_tmp <- NA - } else { - # Index to select from the correlation matrix - indx <- expand.grid(h, (1:k)) - indx <- indx[, 1] + (indx[, 2] - 1) * n_hypotheses - corr_tmp <- corr[indx, indx] - # Boundary for a single hypothesis across k for the intersection hypothesis - p_tmp <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = t[[h]], - n.I = corr_tmp[, ncol(corr_tmp)]^2, - alpha = alpha * w_tmp0[h], - sfu = sf[[h]], - sfupar = sfparm[[h]] - )$upper$bound) - } - # Record results - h_var <- paste("H", h, sep = "") - bounds_tmp <- bounds_tmp %>% - mutate(!!h_var := p_tmp) - } - bounds <- dplyr::bind_rows(bounds, bounds_tmp) - } else { # WPGSD Methods - for (i in 1:k) { - if (type %in% c(1, 2)) { - if (is.null(cum_alpha)) { - alpha_tmp <- sf(alpha = alpha, t = t, param = sfparm)$spend[i] - } else { - alpha_tmp <- cum_alpha[i] - } - - if (i == 1) { - alpha_prev <- NULL - } - - # index to select from the correlation matrix - indx <- expand.grid(hypotheses, (1:i)) - indx <- indx[, 1] + (indx[, 2] - 1) * n_hypotheses - corr_tmp <- corr[indx, indx] - - p_tmp <- w_tmp * uniroot(find_astar, - a = alpha_tmp, - alpha_prev = alpha_prev, - w = w_tmp, - sig = corr_tmp, - lower = 0, - upper = alpha_tmp * 5, - maxpts = maxpts, - abseps = abseps, - tol = tol - )$root - } - - if (type == 3) { - if (i == 1) { - alpha_prev <- NULL - } - - # First find Bonferroni spending - cum_alpha_B <- NULL - bounds_B <- NULL - for (h in hypotheses) { - indx_B <- expand.grid(h, (1:k)) - indx_B <- indx_B[, 1] + (indx_B[, 2] - 1) * n_hypotheses - corr_B_tmp <- corr[indx_B, indx_B] - # Cummulative Bonferroni spending for a single hypothesis at anlaysis k - cum_alpha_B_tmp <- sf[[h]](alpha = alpha * w_tmp0[h], t = t[[h]], param = sfparm[[h]])$spend[i] - cum_alpha_B <- c(cum_alpha_B, cum_alpha_B_tmp) - - # Bonferroni nominal boundary for a single hypothesis at analysis i - p_B_tmp <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = t[[h]], - n.I = corr_B_tmp[, ncol(corr_B_tmp)]^2, - alpha = alpha * w_tmp0[h], - sfu = sf[[h]], - sfupar = sfparm[[h]] - )$upper$bound)[i] - bounds_B <- c(bounds_B, p_B_tmp) - } - - # Find inflation factor xi - - if (length(hypotheses) == 1) { - xi <- 1 - } else { - # index to select from the correlation matrix - indx <- expand.grid(hypotheses, (1:i)) - indx <- indx[, 1] + (indx[, 2] - 1) * n_hypotheses - corr_tmp <- corr[indx, indx] - - xi <- uniroot(find_xi, - lower = 0.5, - upper = 10, - a = sum(cum_alpha_B), - alpha_prev = alpha_prev, - aprime = bounds_B, - sig = corr_tmp, - maxpts = maxpts, - abseps = abseps, - tol = tol - )$root - } - - p_tmp <- xi * bounds_B - } - - # record results - pval_tmp <- rep(NA, n_hypotheses) - pval_tmp[hypotheses] <- p_tmp - names(pval_tmp) <- paste("H", 1:n_hypotheses, sep = "") - - if (type == 3) { - bounds_tmp <- tibble( - Analysis = i, - Hypotheses = paste("H", hypotheses, sep = "", collapse = ", "), - as.data.frame(t(pval_tmp)), - xi = xi - ) - } else { - bounds_tmp <- tibble( - Analysis = i, - Hypotheses = paste("H", hypotheses, sep = "", collapse = ", "), - as.data.frame(t(pval_tmp)) - ) - } - - bounds <- dplyr::bind_rows(bounds, bounds_tmp) - - # Update alpha_prev - alpha_prev <- c(alpha_prev, p_tmp) - } - } - } - - bounds <- bounds %>% - dplyr::arrange(Analysis, Hypotheses, .by_group = FALSE) - - return(bounds) -} diff --git a/wpgsd.Rcheck/vign_test/wpgsd/R/generate_corr.R b/wpgsd.Rcheck/vign_test/wpgsd/R/generate_corr.R deleted file mode 100644 index 947784a..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/R/generate_corr.R +++ /dev/null @@ -1,112 +0,0 @@ -# Copyright (c) 2023 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. -# All rights reserved. -# -# This file is part of the wpgsd program. -# -# wpgsd 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 . - -#' Generate correlation matrix based on event counts -#' -#' @param event Event count of each hypothesis at each analysis, including -#' event count of the intersection of hypotheses. -#' It contains 4 columns: `H1`, `H2`, `Analysis`, `Event`. -#' `H1` needs to be listed as 1, 2, 3, etc. as numbers. -#' -#' @return A correlation matrix. -#' -#' @importFrom dplyr filter select %>% -#' -#' @export -#' -#' @examples -#' # Build the transition matrix -#' m <- matrix(c( -#' 0, 0.5, 0.5, -#' 0.5, 0, 0.5, -#' 0.5, 0.5, 0 -#' ), nrow = 3, byrow = TRUE) -#' # initialize weights -#' w <- c(1 / 3, 1 / 3, 1 / 3) -#' -#' # Input event count of intersection of paired hypotheses - Table 2 -#' event <- tibble::tribble( -#' ~H1, ~H2, ~Analysis, ~Event, -#' 1, 1, 1, 155, -#' 2, 2, 1, 160, -#' 3, 3, 1, 165, -#' 1, 2, 1, 85, -#' 1, 3, 1, 85, -#' 2, 3, 1, 85, -#' 1, 1, 2, 305, -#' 2, 2, 2, 320, -#' 3, 3, 2, 335, -#' 1, 2, 2, 170, -#' 1, 3, 2, 170, -#' 2, 3, 2, 170 -#' ) -#' -#' # Generate correlation from events -#' gs_corr <- generate_corr(event) -generate_corr <- function(event) { - elem <- event %>% subset(H1 == H2) - inter <- event %>% subset(H1 != H2) - n_hypotheses <- max(as.numeric(elem$H1)) - n_analyses <- max(elem$Analysis) - - # Diagonal - D <- diag(elem$Event) - - # Within hypothesis across analyses - for (i in 1:n_hypotheses) { - for (j in 2:n_analyses) { - count <- as.numeric(event %>% - filter(H1 == i & H2 == i & Analysis == j - 1) %>% - select(Event)) - D[i, n_hypotheses * (j - 1) + i] <- count - D[n_hypotheses * (j - 1) + i, i] <- count - } - } - - # Between hypotheses - for (i in 1:n_hypotheses) { - for (j in c(1:n_hypotheses)[-i]) { - for (k in 1:n_analyses) { - count1 <- as.numeric(event %>% - subset(((H1 == i & H2 == j) | (H1 == j & H2 == i)) & Analysis == k) %>% - select(Event)) - D[n_hypotheses * (k - 1) + i, n_hypotheses * (k - 1) + j] <- count1 - for (l in c(1:n_analyses)[-k]) { - count2 <- as.numeric(event %>% - subset(((H1 == i & H2 == j) | (H1 == j & H2 == i)) & Analysis == min(k, l)) %>% - select(Event)) - D[n_hypotheses * (k - 1) + i, n_hypotheses * (l - 1) + j] <- count2 - } - } - } - } - - corr_mat <- d_corr(D) - - col_names <- NULL - for (k in 1:n_analyses) { - for (i in 1:n_hypotheses) { - name_tmp <- paste("H", i, "_A", k, sep = "") - col_names <- c(col_names, name_tmp) - } - } - - colnames(corr_mat) <- col_names - - return(corr_mat) -} diff --git a/wpgsd.Rcheck/vign_test/wpgsd/R/generate_event_cc.R b/wpgsd.Rcheck/vign_test/wpgsd/R/generate_event_cc.R deleted file mode 100644 index 8e25bf4..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/R/generate_event_cc.R +++ /dev/null @@ -1,80 +0,0 @@ -#' This function generates a table of events for given experimental arms and a control group based on specified hypotheses. -#' -#' @param event A dataframe containing the following columns: -#' - `Population`: A character vector listing the population groups (e.g., experimental arms and control). -#' - `IA`: A numeric vector indicating the number of events observed in each group during interim analysis. -#' - `FA`: A numeric vector indicating the number of events observed in each group during final analysis. -#' The dataframe must contain at least these columns and can include additional analysis columns as needed. -#' @param hypothesis A list containing hypotheses specifying comparisons between experimental arms and the control group, -#' as well as comparisons among experimental arms. -#' -#' @return A dataframe with columns: -#' - `one_hypothesis`: The index of the first selected hypothesis from the provided list. -#' - `another_hypothesis`: The index of the second selected hypothesis from the provided list. -#' - `analysis`: The index indicating which analysis is being performed (e.g., interim or final). -#' - `common_events`: The calculated number of common events associated with the selected hypotheses. -#' -#' @examples -#' #------------------------Example of IA and FA -#' event <- data.frame( -#' Population = c("Experimental 1", "Experimental 2", "Experimental 3", "Control"), -#' IA = c(70, 75, 80, 85), # Interim Analysis values indicating the number of events observed in each group -#' FA = c(135, 150, 165, 170) -#' ) -#' -#' hypothesis <- list( -#' H1 = "Experimental 1 vs. Control", -#' H2 = "Experimental 2 vs. Control", -#' H3 = "Experimental 1 vs. Experimental 2" -#' ) -#' -#' generate_event_table_cc(event, hypothesis) -#' -#' #----------------------Example of two IAs and FA -#' event <- data.frame( -#' Population = c("Experimental 1", "Experimental 2", "Experimental 3", "Control"), -#' IA1 = c(70, 75, 80, 85), # First Interim Analysis values indicating the number of events observed in each group -#' IA2 = c(90, 95, 100, 105), # Second Interim Analysis values indicating the number of events observed in each group -#' FA = c(135, 150, 165, 170) -#' ) -#' -#' hypothesis <- list( -#' H1 = "Experimental 1 vs. Control", -#' H2 = "Experimental 2 vs. Control", -#' H3 = "Experimental 1 vs. Experimental 2" -#' ) -#' -#' generate_event_table_cc(event, hypothesis) -generate_event_table_cc <- function(event, hypothesis) { - result_df <- tibble( - one_hypothesis = integer(), - another_hypothesis = integer(), - analysis = integer(), - common_events = integer() - ) - - # Iterate through the input data to calculate the events - for (i in 1:length(hypothesis)) { # number of hypothesis - for (j in i:length(hypothesis)) { - for (k in 1:(ncol(event) - 1)) { # Iterate through the analyses - if (i != j) { - hyp_i <- unlist(strsplit(hypothesis[[i]], " vs. ")) - hyp_j <- unlist(strsplit(hypothesis[[j]], " vs. ")) - common_factor <- intersect(hyp_i, hyp_j) - eventn <- event[event$Population == common_factor, k + 1] - } else { - eventn <- event[i, k + 1] + event[event$Population == "Control", k + 1] - } - - result_df <- rbind(result_df, tibble( - one_hypothesis = i, - another_hypothesis = j, - analysis = k, - common_events = eventn - )) - result_df <- result_df[order(result_df$analysis), ] - } - } - } - return(result_df) -} diff --git a/wpgsd.Rcheck/vign_test/wpgsd/R/generate_event_ol.R b/wpgsd.Rcheck/vign_test/wpgsd/R/generate_event_ol.R deleted file mode 100644 index dd39253..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/R/generate_event_ol.R +++ /dev/null @@ -1,94 +0,0 @@ -#' This function generates a table of events for specified populations based on the provided hypotheses. -#' -#' @param event` dataframe should have the following structure: -#' - `Population`: A character vector indicating the population groups (e.g., "Population 1", "Population 2", "Population 1 Intersection 2", and "Overall population"). -#' - `IA`: Numeric vector indicating the number of events observed in each group during interim analysis. -#' - `FA`: Numeric vector indicating the number of events observed in each group during final analysis. -#' The dataframe must contain at least these columns and can include additional analysis columns as needed. -#' @param hypothesis A list of strings where each item represents a hypothesis regarding efficacy, formatted as follows: -#' - H1: "Efficacy in Population 1" -#' - H2: "Efficacy in Population 2" -#' - H3: "Efficacy in Overall population" -#' Each hypothesis is used for comparisons in the generated event table. -#' -#' @return A dataframe with the following columns: -#' - `one_hypothesis`: The index of the first selected hypothesis from the provided list. -#' - `another_hypothesis`: The index of the second selected hypothesis from the provided list. -#' - `analysis`: The index indicating which analysis is being performed (e.g., interim or final). -#' - `common_events`: The calculated number of common events associated with the selected hypotheses. -#' -#' @export -#' -#' @examples -#' #------------------------Example of IA and FA -#' event <- data.frame( -#' Population = c("Population 1", "Population 2", "Population 1 Intersection 2", "Overall population"), -#' IA = c(100, 110, 80, 225), # Interim Analysis values indicating the number of events observed in each group -#' FA = c(200, 220, 160, 450) -#' ) -#' -#' hypothesis <- list( -#' H1 = "Efficacy in Population 1", -#' H2 = "Efficacy in Population 2", -#' H3 = "Efficacy in Overall population" -#' ) -#' -#' generate_event_table_ol(event, hypothesis) -#' -#' #----------------------Example of two IAs and FA -#' event <- data.frame( -#' Population = c("Population 1", "Population 2", "Population 1 Intersection 2", "Overall population"), -#' IA1 = c(100, 110, 80, 225), # First Interim Analysis values indicating the number of events observed in each group -#' IA2 = c(120, 130, 90, 240), # Second Interim Analysis values indicating the number of events observed in each group -#' FA = c(200, 220, 160, 450) -#' ) -#' -#' hypothesis <- list( -#' H1 = "Efficacy in Population 1", -#' H2 = "Efficacy in Population 2", -#' H3 = "Efficacy in Overall population" -#' ) -#' -#' generate_event_table_ol(event, hypothesis) -#' -generate_event_table_ol <- function(event, hypothesis) { - result_df <- tibble( - one_hypothesis = integer(), - another_hypothesis = integer(), - analysis = integer(), - common_events = integer() - ) - - for (i in 1:length(hypothesis)) { - for (j in i:length(hypothesis)) { - for (k in 1:(ncol(event) - 1)) { - hyp_i <- unlist(strsplit(hypothesis[[i]], "Efficacy in "))[2] - hyp_j <- unlist(strsplit(hypothesis[[j]], "Efficacy in "))[2] - - common_factor <- intersect(hyp_i, hyp_j) - - if (length(common_factor) > 0) { - if ("Overall population" %in% c(hyp_i, hyp_j)) { - eventn <- event[event$Population == "Overall population", k + 1] - } else { - eventn <- event[i, k + 1] - } - } else if ("Overall population" %in% c(hyp_i, hyp_j)) { - eventn <- event[i, k + 1] - } else { - eventn <- event[event$Population == "Population 1 Intersection 2", k + 1] - } - - result_df <- rbind(result_df, tibble( - one_hypothesis = i, - another_hypothesis = j, - analysis = k, - common_events = eventn - )) - result_df <- result_df[order(result_df$analysis), ] - } - } - } - - return(result_df) -} diff --git a/wpgsd.Rcheck/vign_test/wpgsd/R/generate_event_table.R b/wpgsd.Rcheck/vign_test/wpgsd/R/generate_event_table.R deleted file mode 100644 index a835be4..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/R/generate_event_table.R +++ /dev/null @@ -1,112 +0,0 @@ -# Copyright (c) 2023 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. -# All rights reserved. -# -# This file is part of the wpgsd program. -# -# wpgsd 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 . - -#' Generate table of event counts from ADSL and ADTTE datasets -#' -#' @param paths A vector of paths for analysis datasets. -#' Length should be equal to the number of analyses completed. -#' @param h_select Selection criterion for each hypothesis. -#' Should be a tibble containing 2 columns: `Hypothesis` and `Crit`. -#' @param adsl_name SAS dataset name for subject-level analysis data. -#' Usually it is `"adsl"`. -#' @param adtte_name SAS dataset name for time-to-event analysis data. -#' Usually it is `"adtte"`. -#' @param key_var Key variable to join the `adsl` and `adtte` datasets. -#' For example, `"USUBJID"` or `"SUBJID"`. -#' @param cnsr_var Variable to indicate censoring (`1` = censor; `0` = event). -#' For example, `"CNSR"`. -#' -#' @return A list with two components: -#' - `event`: an event count table as input for [generate_bounds()]. -#' - `dsets`: analysis datasets of each hypothesis. -#' -#' @importFrom tibble tibble -#' @importFrom dplyr %>% filter select -#' @importFrom tidyselect all_of -#' -#' @export -#' -#' @examples -#' library(dplyr) -#' -#' paths <- system.file("extdata/", package = "wpgsd") -#' -#' # Selection criteria for each hypothesis -#' h_select <- tibble::tribble( -#' ~Hypothesis, ~Crit, -#' 1, "PARAMCD == 'OS' & TRT01P %in% c('Xanomeline High Dose', 'Placebo')", -#' 2, "PARAMCD == 'OS' & TRT01P %in% c('Xanomeline Low Dose', 'Placebo')" -#' ) -#' -#' event <- generate_event_table(paths, h_select, -#' adsl_name = "adsl", adtte_name = "adtte", -#' key_var = "USUBJID", cnsr_var = "CNSR" -#' )$event -#' -#' event %>% -#' gt::gt() %>% -#' gt::tab_header(title = "Event Count - Computed from SAS Datasets Example") -generate_event_table <- function(paths, h_select, - adsl_name, adtte_name, - key_var, cnsr_var) { - event <- NULL - dsets <- list() - for (i in seq_along(paths)) { # Number of path is number of analysis - path <- paths[i] - adsl <- haven::read_sas(paste(path, "/", adsl_name, ".sas7bdat", sep = "")) - adtte <- haven::read_sas(paste(path, "/", adtte_name, ".sas7bdat", sep = "")) - dset <- dplyr::left_join(adtte, adsl, by = key_var, suffix = c("", ".y")) - - for (j in seq_len(nrow(h_select))) { # number of time-to-event hypotheses - h_var <- paste("H", j, sep = "") - crit <- h_select[j, 2] - dset <- dset %>% dplyr::mutate(!!h_var := ifelse(eval(str2expression(as.character(crit))), - 1, 0 - )) - event_tmp <- tibble( - H1 = paste(j), - H2 = paste(j), - Analysis = i, - Event = sum(dset %>% - filter(eval(str2expression(as.character(cnsr_var))) == 0) %>% - select(all_of(h_var)), na.rm = TRUE) - ) - event <- rbind(event, event_tmp) - - if (j > 1) { - for (k in 1:(j - 1)) { - h_var_k <- paste("H", k, sep = "") - - event_tmp <- tibble( - H1 = paste(k), - H2 = paste(j), - Analysis = i, - Event = sum(dset %>% - filter(eval(str2expression(as.character(cnsr_var))) == 0 & eval(str2expression(as.character(h_var_k))) == 1) %>% - select(all_of(h_var)), na.rm = TRUE) - ) - event <- rbind(event, event_tmp) - } - } - } - - dsets[[i]] <- dset - } - - return(list(event = event, dsets = dsets)) -} diff --git a/wpgsd.Rcheck/vign_test/wpgsd/R/generate_event_table_.R b/wpgsd.Rcheck/vign_test/wpgsd/R/generate_event_table_.R deleted file mode 100644 index 68b99a8..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/R/generate_event_table_.R +++ /dev/null @@ -1,73 +0,0 @@ -#' This function creates a table summarizing event counts based on specified hypotheses and user input data. -#' It can handle two types of analysis: one comparing experimental groups to a common control and another analyzing the overlap of populations. -#' -#' @param event` dataframe should have the following structure: -#' - `Population`: A character vector indicating the population groups. For example, "Population 1", "Population 2", "Overall population" in overlap population situation; or experimental arms and control in common control situation. -#' - `IA`: Numeric vector indicating the number of events observed in each group during interim analysis. -#' - `FA`: Numeric vector indicating the number of events observed in each group during final analysis. -#' The dataframe must contain at least these columns and can include additional analysis columns as needed. -#' @param hypothesis A list containing hypotheses that specify the comparisons to be made between the groups: -#' - For example: -#' - "Experimental 1 vs. Control" -#' - "Efficacy in Population 1" -#' -#' @param type A character string specifying the type of analysis to conduct. It should be one of the following: -#' - `"common_control"`: Analyze the event counts comparing experimental groups to common control. -#' - `"overlap_population"`: Analyze the event counts to assess overlap in populations. -#' -#' @return A dataframe with four columns: -#' - `one_hypothesis`: The index of the first selected hypothesis from the provided list. -#' - `another_hypothesis`: The index of the second selected hypothesis from the provided list. -#' - `analysis`: The index indicating which analysis is being performed (e.g., interim or final). -#' - `common_events`: The calculated number of common events associated with the selected hypotheses. -#' -#' @export -#' -#' @examples -#' # ----------------------- Example of common control -#' event <- data.frame( -#' Population = c("Experimental 1", "Experimental 2", "Experimental 3", "Control"), -#' IA = c(70, 75, 80, 85), # Interim analysis values indicating the number of events observed in each experimental group. -#' FA = c(135, 150, 165, 170) # Final analysis values indicating the cumulative number of events observed in each group. -#' ) -#' -#' hypothesis <- list( -#' H1 = "Experimental 1 vs. Control", # Hypothesis comparing Experimental 1 with Control. -#' H2 = "Experimental 2 vs. Control", # Hypothesis comparing Experimental 2 with Control. -#' H3 = "Experimental 1 vs. Experimental 2" # Hypothesis comparing Experimental 1 and Experimental 2. -#' ) -#' -#' generate_event_table_(event, hypothesis, type = "common_control") -#' -#' # ------------------------ Example of overall population -#' event <- data.frame( -#' Population = c("Population 1", "Population 2", "Population 1 Intersection 2", "Overall population"), -#' IA = c(100, 110, 80, 225), # Interim analysis values for the overall population. -#' FA = c(200, 220, 160, 450) # Final analysis values for the overall population. -#' ) -#' -#' hypothesis <- list( -#' H1 = "Efficacy in Population 1", # Hypothesis assessing efficacy in Population 1. -#' H2 = "Efficacy in Population 2", # Hypothesis assessing efficacy in Population 2. -#' H3 = "Efficacy in Overall population" # Hypothesis assessing efficacy in the overall population. -#' ) -#' -#' generate_event_table_(event, hypothesis, type = "overlap_population") -#' -generate_event_table_ <- function(event, hypothesis, type = c("common_control", "overlap_population")) { - type <- match.arg(type) - - result_df <- tibble( - one_hypothesis = integer(), - another_hypothesis = integer(), - analysis = integer(), - common_events = integer() - ) - - if (type == "common_control") { - result_df <- generate_event_table_cc(event, hypothesis) # see generate_event_cc.R - } else if (type == "overlap_population") { - result_df <- generate_event_table_ol(event, hypothesis) # see generate_event_ol.R - } - return(result_df) -} diff --git a/wpgsd.Rcheck/vign_test/wpgsd/R/globals.R b/wpgsd.Rcheck/vign_test/wpgsd/R/globals.R deleted file mode 100644 index bc243a2..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/R/globals.R +++ /dev/null @@ -1,32 +0,0 @@ -# Copyright (c) 2023 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. -# All rights reserved. -# -# This file is part of the wpgsd program. -# -# wpgsd 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 . - -utils::globalVariables( - unique( - c( - # From `calc_seq_p()` - c("analysis"), - # From `closed_test()` - c("Analysis"), - # From `generate_bounds()` - c("Analysis", "Hypotheses"), - # From `generate_corr()` - c("H1", "H2", "Analysis", "Event") - ) - ) -) diff --git a/wpgsd.Rcheck/vign_test/wpgsd/R/s7_classes.R b/wpgsd.Rcheck/vign_test/wpgsd/R/s7_classes.R deleted file mode 100644 index 953161d..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/R/s7_classes.R +++ /dev/null @@ -1,165 +0,0 @@ -# Copyright (c) 2023 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. -# All rights reserved. -# -# This file is part of the wpgsd program. -# -# wpgsd 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 . - -# S7 Classes for wpgsd Package -# -# This file contains S7 class definitions for the wpgsd package. -# These classes provide type safety and method dispatch for the main -# data structures used in weighted parametric group sequential designs. - -#' @importFrom S7 new_class new_object - -#' EventTable S7 Class -#' -#' Represents event count data structure used in generate_corr() and generate_event_table() -#' -#' @param data A tibble containing H1, H2, Analysis, and Event columns -#' -#' @export -EventTable <- S7::new_class( - "EventTable", - properties = list( - data = S7::class_data.frame, - n_hypotheses = S7::class_integer, - n_analyses = S7::class_integer - ), - constructor = function(data = tibble::tibble()) { - # Validate required columns - required_cols <- c("H1", "H2", "Analysis", "Event") - missing_cols <- setdiff(required_cols, names(data)) - if (length(missing_cols) > 0) { - stop("EventTable requires columns: ", paste(missing_cols, collapse = ", ")) - } - - # Calculate derived properties - n_hypotheses <- max(c(data$H1, data$H2), na.rm = TRUE) - n_analyses <- max(data$Analysis, na.rm = TRUE) - - S7::new_object( - EventTable, - data = data, - n_hypotheses = as.integer(n_hypotheses), - n_analyses = as.integer(n_analyses) - ) - }, - validator = function(self) { - # Validate data types - if (!is.numeric(self@data$H1) || !is.numeric(self@data$H2)) { - "@data$H1 and @data$H2 must be numeric" - } else if (!is.numeric(self@data$Analysis)) { - "@data$Analysis must be numeric" - } else if (!is.numeric(self@data$Event)) { - "@data$Event must be numeric" - } else if (any(self@data$H1 <= 0, na.rm = TRUE) || any(self@data$H2 <= 0, na.rm = TRUE)) { - "Hypothesis indices (H1, H2) must be positive integers" - } else if (any(self@data$Analysis <= 0, na.rm = TRUE)) { - "Analysis numbers must be positive integers" - } else if (any(self@data$Event < 0, na.rm = TRUE)) { - "Event counts must be non-negative" - } - } -) - -# TODO: Add S7 method definitions later -# #' Print method for EventTable -# S7::method(show, EventTable) <- function(object) { ... } -# -# #' Summary method for EventTable -# S7::method(summary, EventTable) <- function(object, ...) { ... } - -#' Subset method for EventTable -#' -#' @param x An EventTable object -#' @param analysis Analysis number(s) to subset -#' @param hypotheses Hypothesis indices to subset -#' @param ... Additional arguments (unused) -#' -#' @export -subset_event_table <- function(x, analysis = NULL, hypotheses = NULL) { - if (!S7::S7_inherits(x, EventTable)) { - stop("x must be an EventTable object") - } - - data_subset <- x@data - - if (!is.null(analysis)) { - data_subset <- data_subset[data_subset$Analysis %in% analysis, ] - } - - if (!is.null(hypotheses)) { - data_subset <- data_subset[ - (data_subset$H1 %in% hypotheses) & (data_subset$H2 %in% hypotheses), - ] - } - - EventTable(data = data_subset) -} - -#' Convert tibble to EventTable -#' -#' @param data A tibble with H1, H2, Analysis, Event columns -#' -#' @export -as_event_table <- function(data) { - if (S7::S7_inherits(data, EventTable)) { - return(data) - } - EventTable(data = data) -} - -#' Validate EventTable data format -#' -#' @param data A data frame or tibble to validate -#' -#' @return TRUE if valid, stops with error message if not -#' -#' @export -validate_event_table_data <- function(data) { - required_cols <- c("H1", "H2", "Analysis", "Event") - missing_cols <- setdiff(required_cols, names(data)) - - if (length(missing_cols) > 0) { - stop("Missing required columns: ", paste(missing_cols, collapse = ", ")) - } - - if (!is.numeric(data$H1) || !is.numeric(data$H2)) { - stop("H1 and H2 must be numeric") - } - - if (!is.numeric(data$Analysis)) { - stop("Analysis must be numeric") - } - - if (!is.numeric(data$Event)) { - stop("Event must be numeric") - } - - if (any(data$H1 <= 0, na.rm = TRUE) || any(data$H2 <= 0, na.rm = TRUE)) { - stop("Hypothesis indices (H1, H2) must be positive integers") - } - - if (any(data$Analysis <= 0, na.rm = TRUE)) { - stop("Analysis numbers must be positive integers") - } - - if (any(data$Event < 0, na.rm = TRUE)) { - stop("Event counts must be non-negative") - } - - TRUE -} diff --git a/wpgsd.Rcheck/vign_test/wpgsd/R/utils-tidy-eval.R b/wpgsd.Rcheck/vign_test/wpgsd/R/utils-tidy-eval.R deleted file mode 100644 index 09c3698..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/R/utils-tidy-eval.R +++ /dev/null @@ -1,107 +0,0 @@ -#' Tidy eval helpers -#' -#' @description -#' This page lists the tidy eval tools reexported in this package from -#' rlang. To learn about using tidy eval in scripts and packages at a -#' high level, see the [dplyr programming -#' vignette](https://dplyr.tidyverse.org/articles/programming.html) -#' and the [ggplot2 in packages -#' vignette](https://ggplot2.tidyverse.org/articles/ggplot2-in-packages.html). -#' The [Metaprogramming -#' section](https://adv-r.hadley.nz/metaprogramming.html) of [Advanced -#' R](https://adv-r.hadley.nz) may also be useful for a deeper dive. -#' -#' * The tidy eval operators `{{`, `!!`, and `!!!` are syntactic -#' constructs which are specially interpreted by tidy eval functions. -#' You will mostly need `{{`, as `!!` and `!!!` are more advanced -#' operators which you should not have to use in simple cases. -#' -#' The curly-curly operator `{{` allows you to tunnel data-variables -#' passed from function arguments inside other tidy eval functions. -#' `{{` is designed for individual arguments. To pass multiple -#' arguments contained in dots, use `...` in the normal way. -#' -#' ``` -#' my_function <- function(data, var, ...) { -#' data %>% -#' group_by(...) %>% -#' summarise(mean = mean({{ var }})) -#' } -#' ``` -#' -#' * [enquo()] and [enquos()] delay the execution of one or several -#' function arguments. The former returns a single expression, the -#' latter returns a list of expressions. Once defused, expressions -#' will no longer evaluate on their own. They must be injected back -#' into an evaluation context with `!!` (for a single expression) and -#' `!!!` (for a list of expressions). -#' -#' ``` -#' my_function <- function(data, var, ...) { -#' # Defuse -#' var <- enquo(var) -#' dots <- enquos(...) -#' -#' # Inject -#' data %>% -#' group_by(!!!dots) %>% -#' summarise(mean = mean(!!var)) -#' } -#' ``` -#' -#' In this simple case, the code is equivalent to the usage of `{{` -#' and `...` above. Defusing with `enquo()` or `enquos()` is only -#' needed in more complex cases, for instance if you need to inspect -#' or modify the expressions in some way. -#' -#' * The `.data` pronoun is an object that represents the current -#' slice of data. If you have a variable name in a string, use the -#' `.data` pronoun to subset that variable with `[[`. -#' -#' ``` -#' my_var <- "disp" -#' mtcars %>% summarise(mean = mean(.data[[my_var]])) -#' ``` -#' -#' * Another tidy eval operator is `:=`. It makes it possible to use -#' glue and curly-curly syntax on the LHS of `=`. For technical -#' reasons, the R language doesn't support complex expressions on -#' the left of `=`, so we use `:=` as a workaround. -#' -#' ``` -#' my_function <- function(data, var, suffix = "foo") { -#' # Use `{{` to tunnel function arguments and the usual glue -#' # operator `{` to interpolate plain strings. -#' data %>% -#' summarise("{{ var }}_mean_{suffix}" := mean({{ var }})) -#' } -#' ``` -#' -#' * Many tidy eval functions like `dplyr::mutate()` or -#' `dplyr::summarise()` give an automatic name to unnamed inputs. If -#' you need to create the same sort of automatic names by yourself, -#' use `as_label()`. For instance, the glue-tunnelling syntax above -#' can be reproduced manually with: -#' -#' ``` -#' my_function <- function(data, var, suffix = "foo") { -#' var <- enquo(var) -#' prefix <- as_label(var) -#' data %>% -#' summarise("{prefix}_mean_{suffix}" := mean(!!var)) -#' } -#' ``` -#' -#' Expressions defused with `enquo()` (or tunnelled with `{{`) need -#' not be simple column names, they can be arbitrarily complex. -#' `as_label()` handles those cases gracefully. If your code assumes -#' a simple column name, use `as_name()` instead. This is safer -#' because it throws an error if the input is not a name as expected. -#' -#' @md -#' @name tidyeval -#' @keywords internal -#' @importFrom rlang enquo enquos .data := as_name as_label -#' @aliases enquo enquos .data := as_name as_label -#' @export enquo enquos .data := as_name as_label -NULL diff --git a/wpgsd.Rcheck/vign_test/wpgsd/R/wpgsd-package.R b/wpgsd.Rcheck/vign_test/wpgsd/R/wpgsd-package.R deleted file mode 100644 index f3fd052..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/R/wpgsd-package.R +++ /dev/null @@ -1,3 +0,0 @@ -#' @keywords internal -"_PACKAGE" -NULL diff --git a/wpgsd.Rcheck/vign_test/wpgsd/README.md b/wpgsd.Rcheck/vign_test/wpgsd/README.md deleted file mode 100644 index e2a7c93..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/README.md +++ /dev/null @@ -1,62 +0,0 @@ -# wpgsd - - -[![R-CMD-check](https://github.com/Merck/wpgsd/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/Merck/wpgsd/actions/workflows/R-CMD-check.yaml) -[![Codecov test coverage](https://codecov.io/gh/Merck/wpgsd/branch/main/graph/badge.svg)](https://app.codecov.io/gh/Merck/wpgsd?branch=main) - - -Weighted parametric group sequential design (WPGSD) allows one to take advantage -of the known correlation structure in constructing efficacy bounds to control -family-wise error rate (FWER) for a group sequential design. Here correlation -may be due to common observations in nested populations, due to common -observations in overlapping populations, or due to common observations -in the control arm. - -## Installation - -The easiest way to get wpgsd is to install from CRAN: - -```r -install.packages("wpgsd") -``` - -Alternatively, to use a new feature or get a bug fix, -you can install the development version of wpgsd from GitHub: - -```r -# install.packages("remotes") -remotes::install_github("Merck/wpgsd") -``` - -## Current limitations - -There are some limitations that are currently being addressed. -Please use the package with caution in production environments. - -- The current implementation may have limitations when handling more - complex scenarios beyond what has been demonstrated. -- The API is subject to potential breaking changes as it is currently - being reviewed and refactored. -- Further validation is needed to ensure the reliability of the package. -- More documentation is expected in the future releases. - -## References - -Anderson, K. M., Guo, Z., Zhao, J., & Sun, L. Z. (2022). -A unified framework for weighted parametric group sequential design. -_Biometrical Journal_, 64(7), 1219--1239. - -BibTeX entry: - -``` -@article{anderson2022unified, - 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}, - volume = {64}, - number = {7}, - pages = {1219--1239}, - year = {2022}, - publisher = {Wiley Online Library} -} -``` diff --git a/wpgsd.Rcheck/vign_test/wpgsd/build/partial.rdb b/wpgsd.Rcheck/vign_test/wpgsd/build/partial.rdb deleted file mode 100644 index c78d6ee06a404621905e3ec5985a35cc97f23098..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 60 zcmb2|=3oE==I#ec2?+^F35l$e&L}K1V3ycmz{u&wCdTHcaCX-88MC8!QaBt`B>yoo M%+tSm+Z?C~0PEoqEdT%j diff --git a/wpgsd.Rcheck/vign_test/wpgsd/build/vignette.rds b/wpgsd.Rcheck/vign_test/wpgsd/build/vignette.rds deleted file mode 100644 index 5ec4d87decb5d8ba6b51641b0f6989042223cbea..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 362 zcmV-w0hRtAiwFP!000001C3HmPXaLzU0^}MV2J3&c<3Kkeu9ZgxOhS1!J8@V0LAWh z?S~s~{%`{h(BiTr#%wz6yqTT%^4ix<6h-wYZencUvC+rS!qvkSvw36d-2v z&8T~oO+jmw2|uOxd25%v0rhdRO;+3*&>HLXC>c* zv&XIn(N)hqe&QY9h}h2FaYTRY|LlwF7;2uTnb8z4YFBJ|FdhjBq2Wc?ebN{YNB&sb z3mrlZ84p)^`UuNHY0M9a+FBKZK-S&7-Y*R6_4>Q2h)HUKq5yU{wRAAm_&;W=AB*f} Ik^ce!0D^Y2(*OVf diff --git a/wpgsd.Rcheck/vign_test/wpgsd/examples/event_table_integration.R b/wpgsd.Rcheck/vign_test/wpgsd/examples/event_table_integration.R deleted file mode 100644 index 06fb2b6..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/examples/event_table_integration.R +++ /dev/null @@ -1,71 +0,0 @@ -# Example integration of EventTable S7 class with existing wpgsd functions -# This shows how EventTable can work with generate_corr() - -library(wpgsd) -library(tibble) - -# Example 1: Using EventTable with generate_corr() -# Create event data using the EventTable class -event_data_raw <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160, - 3, 3, 1, 165, - 1, 2, 1, 85, - 1, 3, 1, 85, - 2, 3, 1, 85, - 1, 1, 2, 305, - 2, 2, 2, 320, - 3, 3, 2, 335, - 1, 2, 2, 170, - 1, 3, 2, 170, - 2, 3, 2, 170 -) - -# Create EventTable object -event_table <- EventTable(data = event_data_raw) -print("Created EventTable:") -print(event_table) - -# Use with generate_corr (currently expects tibble/data.frame) -# The @data slot extracts the underlying tibble -correlation_matrix <- generate_corr(event_table@data) -print("Generated correlation matrix:") -print(correlation_matrix) - -# Example 2: Data validation before processing -cat("\nExample 2: Data validation\n") -cat("==========================\n") - -# Try to create EventTable with invalid data -tryCatch({ - invalid_data <- tibble::tibble( - H1 = c(1, 2, -1), # Invalid: negative hypothesis index - H2 = c(1, 2, 3), - Analysis = c(1, 1, 1), - Event = c(100, 200, 150) - ) - - invalid_table <- EventTable(data = invalid_data) -}, error = function(e) { - cat("Validation caught error:", e$message, "\n") -}) - -# Example 3: Subsetting capabilities -cat("\nExample 3: Subsetting\n") -cat("=====================\n") - -# Get only first analysis -analysis_1 <- subset_event_table(event_table, analysis = 1) -cat("Analysis 1 events:\n") -print(analysis_1@data) - -# Get only H1-H2 hypothesis pairs -h1_h2_events <- subset_event_table(event_table, hypotheses = c(1, 2)) -cat("\nH1-H2 hypothesis events:\n") -print(h1_h2_events@data) - -# Example 4: Summary information -cat("\nExample 4: Summary\n") -cat("==================\n") -summary(event_table) diff --git a/wpgsd.Rcheck/vign_test/wpgsd/examples/test_event_table.R b/wpgsd.Rcheck/vign_test/wpgsd/examples/test_event_table.R deleted file mode 100644 index d55ecbf..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/examples/test_event_table.R +++ /dev/null @@ -1,50 +0,0 @@ -# Test script for EventTable S7 class -# This demonstrates how to use the new EventTable class - -library(wpgsd) -library(tibble) - -# Create sample event data as used in the package -event_data <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160, - 3, 3, 1, 165, - 1, 2, 1, 85, - 1, 3, 1, 85, - 2, 3, 1, 85, - 1, 1, 2, 305, - 2, 2, 2, 320, - 3, 3, 2, 335, - 1, 2, 2, 170, - 1, 3, 2, 170, - 2, 3, 2, 170 -) - -# Create EventTable object -event_table <- EventTable(data = event_data) - -# Print the object -print(event_table) - -# Get summary -summary(event_table) - -# Subset by analysis -subset_analysis_1 <- subset_event_table(event_table, analysis = 1) -print("Analysis 1 subset:") -print(subset_analysis_1) - -# Subset by hypotheses -subset_h1_h2 <- subset_event_table(event_table, hypotheses = c(1, 2)) -print("H1-H2 subset:") -print(subset_h1_h2) - -# Convert existing tibble to EventTable -converted_table <- as_event_table(event_data) -print("Converted table:") -print(converted_table) - -# Validate data -validate_event_table_data(event_data) -print("Data validation passed!") diff --git a/wpgsd.Rcheck/vign_test/wpgsd/inst/CITATION b/wpgsd.Rcheck/vign_test/wpgsd/inst/CITATION deleted file mode 100644 index 4cf24a4..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/inst/CITATION +++ /dev/null @@ -1,12 +0,0 @@ -bibentry( - "Article", - title = "A unified framework for weighted parametric group sequential design", - author = "Keaven M Anderson and Zifang Guo and Jing Zhao and Linda Z Sun", - journal = "Biometrical Journal", - volume = "64", - number = "7", - pages = "1219--1239", - year = "2022", - publisher = "Wiley Online Library", - doi = "10.1002/bimj.202100085", -) diff --git a/wpgsd.Rcheck/vign_test/wpgsd/inst/aiprompts/compute_correlations_prompts.txt b/wpgsd.Rcheck/vign_test/wpgsd/inst/aiprompts/compute_correlations_prompts.txt deleted file mode 100644 index 6c9d599..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/inst/aiprompts/compute_correlations_prompts.txt +++ /dev/null @@ -1,76 +0,0 @@ -Three functions are defined here, one for checking input data (`check_event_data()`) and -another for computing correlations (`compute_correlations()`) and one (`gen_corr()`) for transforming a data frame where correlations are computed -to a correlation matrix. -All three should be exported. -When users enter the `event` input to `compute_correlations()`, it is advised to call `check_event_data()` first by -specifying check = TRUE (the default). -Output will be output either as a data frame or as a correlation matrix, as specified below. -An exported function `gen_corr()` will do a transformation from the data frame output to a symmetric matrix. - -Let M > 1 be the integer number of hypotheses to be tested. -Assume there are integer K > 1 analyses. -Let real-valued Z[i, k] be the standardized normal test statistic for -hypothesis i, 1 <= i <= M, analysis k, 1 <= k <= K. -We wish to compute and return correlations for all hypothesis tests -performed across analyses. -For tests Z[i1, k1], Z[i2, k2], 1 <= i1 <= i2 <= M, 1 <= k1 <= k2 <= K that are -performed we will provide the count of events (for time-to-event outcomes) or -sample size (for other outcomes) that are common between the two tests. -This is input in a data frame called `event` -with the following columns: - -`H1` - hypothesis i1 = H1 -`H2` - hypothesis i2 = H2 -`Analysis` - value in 1,2,...,K -`Event` - event count for time-to-event endpoints, otherwise sample size which -is included in the both test Z[H1, Analysis] and Z[H2, Analysis]. - -Other arguments for `compute_correlations()` are - -`check` - logical indicating whether to perform input checks using `check_event_data()` (default is TRUE) -`return_matrix` - logical indicating whether to return a correlation matrix (default is TRUE) - -The function `check_event_data()` will have the argument `event` as specified above. -Data checks in `check_event_data()` : -- Check that `event` is a data frame and return an informative error message if not. -- Check that columns specified above exist and return informative error message, if not. -- Check that H1 <= H2 for each row and provide informative error message, if not. -- Check that the combination of H1, H2, Analysis is a unique in the input; -this should be evaluated and appropriate error message returned if not unique. -Check that Event is an integer >= 0 for all rows and provide an -appropriate error message, if not. -- Check that unique values of Analysis are sequential positive integers with -minimum value 1 and maximum value > 1; K from above will be the maximum value. -Return an informative error message if any of these checks fail. -- Check that unique values of H1 are sequential integers with minimum value 1 -and maximum value > 1; M from above will be the maximum value. -Same for H2. -Return an informative error message if any of these checks fail. -- Check that for k=1,...,K that if there is a row with H1 < H2, then there is also a row with H1 == H2. -Return an informative error message if not. -- Check that for any value of Analysis, and H1 = i1 < H2 = i2 specified that there is also a row with H1 = i1, H2 = i1 and another with -H1 = i2, H2 = i2. Return an informative error message if not. - - -Returned value from `compute_correlations()`. -The returned value either a data frame (if `return_matrix = FALSE`) or a correlation matrix, otherwise. -The data frame has the following columns. - H1 - hypothesis i1 - H2 - hypothesis i2 >= i1 - Analysis1 - k1. - Analysis2 - k2 >= k1. - Correlation - correlation between Z[i1, k1] and Z[i2, k2]. - -Correlation is computed as -Event for i1, i2 and k1 divided by square root of the product of -Event for H1 = i1, H2 = i1, Analysis = min(k1, k2) times -Event for H1 = i2, H2 = i2, Analysis = k2. - -If `return_ matrix = TRUE` (default) then a symmetric matrix should be returned as follows. -Columns should be named `H1_A1`, `H1_A2`, ..., `H1_AK`, `H2_A1`, `H2_A2`, ..., `H2_AK`, ..., `HM_A1`, `HM_A2`, ..., `HM_AK` where -M and K are as computed from `event`. -Rows should be labeled the same way. -Diagonal elements are all 1. -Off-diagonal elements are filled with the computed correlations. -Only cells included should be where `Event` value was provided for the combination of Analysis, H1 and H2. - diff --git a/wpgsd.Rcheck/vign_test/wpgsd/inst/aiprompts/s7 prompts.md b/wpgsd.Rcheck/vign_test/wpgsd/inst/aiprompts/s7 prompts.md deleted file mode 100644 index 69bae54..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/inst/aiprompts/s7 prompts.md +++ /dev/null @@ -1,101 +0,0 @@ -## Prompt for s7 Class conversion - -We want to convert the wpgsd R package to operate with s7 classes throughout. -Please check for exported functions in the R directory suggest what s7 classes need to be developed. - -## Suggested S7 Classes for wpgsd Package Conversion - -Based on the exported functions and their data structures, here are the key S7 classes that should be developed: - -### 1. **EventTable Class** -- **Purpose**: Represents event count data structure used in `generate_corr()` and `generate_event_table()` -- **Key Fields**: - - `H1`, `H2`: Hypothesis indices - - `Analysis`: Analysis number - - `Event`: Event count -- **Methods**: Validation, printing, subsetting - -### 2. **CorrelationMatrix Class** -- **Purpose**: Represents correlation matrices returned by `generate_corr()` -- **Key Fields**: - - `matrix`: The correlation matrix - - `n_hypotheses`: Number of hypotheses - - `n_analyses`: Number of analyses - - `column_names`: Named columns (e.g., "H1_A1", "H2_A1", etc.) -- **Methods**: Validation (positive definite), printing, subsetting - -### 3. **TransitionMatrix Class** -- **Purpose**: Represents transition matrices used in graphical procedures -- **Key Fields**: - - `matrix`: The transition matrix - - `n_hypotheses`: Number of hypotheses -- **Methods**: Validation (row sums ≤ 1), printing - -### 4. **Bounds Class** -- **Purpose**: Represents p-value boundaries from `generate_bounds()` -- **Key Fields**: - - `data`: Tibble with Analysis, Hypotheses, H1, H2, etc., xi columns - - `type`: Boundary type (0, 1, 2, or 3) - - `alpha`: Overall alpha level - - `n_hypotheses`: Number of hypotheses - - `n_analyses`: Number of analyses -- **Methods**: Validation, printing, plotting - -### 5. **ObservedPValues Class** -- **Purpose**: Represents observed p-values for `closed_test()` -- **Key Fields**: - - `data`: Tibble with Analysis, H1, H2, etc. columns - - `n_hypotheses`: Number of hypotheses - - `n_analyses`: Number of analyses -- **Methods**: Validation, printing - -### 6. **ClosedTestResult Class** -- **Purpose**: Represents results from `closed_test()` -- **Key Fields**: - - `outcome_matrix`: Matrix summarizing testing results - - `bounds`: Associated bounds used - - `p_obs`: Observed p-values used - - `rejected_hypotheses`: List of rejected hypotheses by analysis -- **Methods**: Validation, printing, summary - -### 7. **StudyDesign Class** -- **Purpose**: High-level class to encapsulate entire study design -- **Key Fields**: - - `initial_weights`: Vector of initial hypothesis weights - - `transition_matrix`: TransitionMatrix object - - `n_hypotheses`: Number of hypotheses - - `n_analyses`: Number of planned analyses - - `alpha`: Overall alpha level - - `spending_functions`: List of spending functions -- **Methods**: Validation, printing, summary - -### 8. **SequentialPValue Class** -- **Purpose**: Represents sequential p-values from `calc_seq_p()` -- **Key Fields**: - - `value`: The sequential p-value - - `test_analysis`: Analysis index - - `test_hypothesis`: Hypothesis being tested - - `method_type`: Alpha spending type used -- **Methods**: Validation, printing - -## Implementation Benefits - -1. **Type Safety**: S7 classes provide strong typing and validation -2. **Method Dispatch**: Can implement specialized methods for each class -3. **Consistency**: Standardized data structures across the package -4. **User Experience**: Better error messages and documentation -5. **Extensibility**: Easy to add new methods and functionality - -## Migration Strategy - -1. Start with core data structures (`EventTable`, `CorrelationMatrix`) -2. Update `generate_corr()` to return `CorrelationMatrix` objects -3. Update `generate_bounds()` to return `Bounds` objects -4. Progressively convert other functions -5. Ensure backward compatibility during transition -6. Update documentation and vignettes - -This S7 class structure would provide a solid foundation for the wpgsd package while maintaining the existing functionality and improving the user experience with better type safety and method dispatch. - -Claude Sonnet 4 running under VSCode returned the following: - diff --git a/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/adj-seq-p.R b/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/adj-seq-p.R deleted file mode 100644 index 63d7cc2..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/adj-seq-p.R +++ /dev/null @@ -1,739 +0,0 @@ -## ----message = FALSE, warning = FALSE----------------------------------------- -library(wpgsd) -library(gsDesign) -library(tibble) -library(gt) -library(dplyr) - -## ----------------------------------------------------------------------------- -event_tbl <- tribble( - ~population, ~analysis, ~event, - "A positive", 1, 100, - "B positive", 1, 110, - "AB positive", 1, 80, - "overall", 1, 225, - "A positive", 2, 200, - "B positive", 2, 220, - "AB positive", 2, 160, - "overall", 2, 450, -) - -## ----------------------------------------------------------------------------- -obs_tbl <- tribble( - ~hypothesis, ~analysis, ~obs_p, - "H1", 1, 0.02, - "H2", 1, 0.01, - "H3", 1, 0.012, - "H1", 2, 0.015, - "H2", 2, 0.012, - "H3", 2, 0.010 -) %>% - mutate(obs_Z = -qnorm(obs_p)) - -obs_tbl %>% - gt() %>% - tab_header(title = "Nominal p-values") - -p_obs_IA <- (obs_tbl %>% filter(analysis == 1))$obs_p -p_obs_FA <- (obs_tbl %>% filter(analysis == 2))$obs_p - -## ----------------------------------------------------------------------------- -IF_IA <- c( - ((event_tbl %>% filter(analysis == 1, population == "A positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "A positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event), - ((event_tbl %>% filter(analysis == 1, population == "B positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "B positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event), - ((event_tbl %>% filter(analysis == 1, population == "AB positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "AB positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event) -) - -IF_IA - -## ----------------------------------------------------------------------------- -# Transition matrix in Figure A1 -m <- matrix(c( - 0, 3 / 7, 4 / 7, - 3 / 7, 0, 4 / 7, - 0.5, 0.5, 0 -), nrow = 3, byrow = TRUE) -# Initial weights -w <- c(0.3, 0.3, 0.4) - -## ----------------------------------------------------------------------------- -name_hypotheses <- c("H1: Biomarker A positive", "H2: Biomarker B positive", "H3: Overall Population") - -hplot <- gMCPLite::hGraph( - 3, - alphaHypotheses = w, m = m, - nameHypotheses = name_hypotheses, trhw = .2, trhh = .1, - digits = 5, trdigits = 3, size = 5, halfWid = 1, halfHgt = 0.5, - offset = 0.2, trprop = 0.4, - fill = as.factor(c(2, 3, 1)), - palette = c("#BDBDBD", "#E0E0E0", "#EEEEEE"), - wchar = "w" -) -hplot - -## ----------------------------------------------------------------------------- -# Event count of intersection of paired hypotheses - Table 2 -# H1, H2: Hypotheses intersected. -# (1, 1) represents counts for hypothesis 1 -# (1, 2) for counts for the intersection of hypotheses 1 and 2 -event <- tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, event_tbl %>% filter(analysis == 1, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 2, 1, event_tbl %>% filter(analysis == 1, population == "B positive") %>% select(event) %>% as.numeric(), - 3, 3, 1, event_tbl %>% filter(analysis == 1, population == "overall") %>% select(event) %>% as.numeric(), - 1, 2, 1, event_tbl %>% filter(analysis == 1, population == "AB positive") %>% select(event) %>% as.numeric(), - 1, 3, 1, event_tbl %>% filter(analysis == 1, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 3, 1, event_tbl %>% filter(analysis == 1, population == "B positive") %>% select(event) %>% as.numeric(), - 1, 1, 2, event_tbl %>% filter(analysis == 2, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 2, 2, event_tbl %>% filter(analysis == 2, population == "B positive") %>% select(event) %>% as.numeric(), - 3, 3, 2, event_tbl %>% filter(analysis == 2, population == "overall") %>% select(event) %>% as.numeric(), - 1, 2, 2, event_tbl %>% filter(analysis == 2, population == "AB positive") %>% select(event) %>% as.numeric(), - 1, 3, 2, event_tbl %>% filter(analysis == 2, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 3, 2, event_tbl %>% filter(analysis == 2, population == "B positive") %>% select(event) %>% as.numeric() -) -event - -# Generate correlation from events -gs_corr <- wpgsd::generate_corr(event) -gs_corr %>% round(2) - -## ----wpgsdSeqIA, message=FALSE------------------------------------------------ -seq_p_IA_H123 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H1, H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H12 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H1, H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H13 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H1, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H23 <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H1 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H1", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H2 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H3 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -## ----weightedBonferroniSeqIA, message=FALSE----------------------------------- -seq_p_IA_H123_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H1, H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -seq_p_IA_H12_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H1, H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H13_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H1, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -seq_p_IA_H23_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -seq_p_IA_H1_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H1", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -seq_p_IA_H2_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -seq_p_IA_H3_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -## ----wpgsdSeqFA, message=FALSE------------------------------------------------ -seq_p_FA_H123 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1, H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.15) -) - -seq_p_FA_H12 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1, H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.15) -) - -seq_p_FA_H13 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.15) -) - -seq_p_FA_H23 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.15) -) - -seq_p_FA_H1 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H2 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H3 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -## ----weightedBonferroniSeqFA, message=FALSE----------------------------------- -seq_p_FA_H123_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1, H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H12_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1, H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H13_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H23_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H1_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H2_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H3_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -## ----wpgsdAdjSeqIA------------------------------------------------------------ -adj_seq_IA_H1 <- max(seq_p_IA_H123, seq_p_IA_H12, seq_p_IA_H13, seq_p_IA_H1) -adj_seq_IA_H2 <- max(seq_p_IA_H123, seq_p_IA_H12, seq_p_IA_H23, seq_p_IA_H2) -adj_seq_IA_H3 <- max(seq_p_IA_H123, seq_p_IA_H13, seq_p_IA_H23, seq_p_IA_H3) - -cat("The adjusted-sequential p-value of H1, H2, H3 in IA via WPGSD is", adj_seq_IA_H1, adj_seq_IA_H2, adj_seq_IA_H3, "\n") - -## ----weightedBonferroniAdjSeqIA----------------------------------------------- -adj_seq_IA_H1_B <- max(seq_p_IA_H123_B, seq_p_IA_H12_B, seq_p_IA_H13_B, seq_p_IA_H1_B) -adj_seq_IA_H2_B <- max(seq_p_IA_H123_B, seq_p_IA_H12_B, seq_p_IA_H23_B, seq_p_IA_H2_B) -adj_seq_IA_H3_B <- max(seq_p_IA_H123_B, seq_p_IA_H13_B, seq_p_IA_H23_B, seq_p_IA_H3_B) - -cat("The adjusted-sequential p-value of H1, H2, H3 in FA via weighted Bonferroni is", adj_seq_IA_H1_B, adj_seq_IA_H2_B, adj_seq_IA_H3_B, "\n") - -## ----wpgsdAdjSeqFA------------------------------------------------------------ -adj_seq_FA_H1 <- max(seq_p_FA_H123, seq_p_FA_H12, seq_p_FA_H13, seq_p_FA_H1) -adj_seq_FA_H2 <- max(seq_p_FA_H123, seq_p_FA_H12, seq_p_FA_H23, seq_p_FA_H2) -adj_seq_FA_H3 <- max(seq_p_FA_H123, seq_p_FA_H13, seq_p_FA_H23, seq_p_FA_H3) - -cat("The adjusted-sequential p-value of H1, H2, H3 in FA via WPGSD is", adj_seq_FA_H1, adj_seq_FA_H2, adj_seq_FA_H3, "\n") - -## ----weightedBonferroniAdjSeqFA----------------------------------------------- -adj_seq_FA_H1_B <- max(seq_p_FA_H123_B, seq_p_FA_H12_B, seq_p_FA_H13_B, seq_p_FA_H1_B) -adj_seq_FA_H2_B <- max(seq_p_FA_H123_B, seq_p_FA_H12_B, seq_p_FA_H23_B, seq_p_FA_H2_B) -adj_seq_FA_H3_B <- max(seq_p_FA_H123_B, seq_p_FA_H13_B, seq_p_FA_H23_B, seq_p_FA_H3_B) - -cat("The adjusted-sequential p-value of H1, H2, H3 in FA via weighted Bonferroni is", adj_seq_FA_H1_B, adj_seq_FA_H2_B, adj_seq_FA_H3_B, "\n") - -## ----------------------------------------------------------------------------- -ans <- tribble( - ~Analysis, ~Hypothesis, ~`Sequential p-values of WPGSD`, ~`Sequential p-values of Weighted Bonferroni`, ~`Adjusted-sequential p-values of WPGSD`, ~`Adjusted-sequential p-values of Weighted Bonferroni`, - "IA", "H123", seq_p_IA_H123, seq_p_IA_H123_B, NA, NA, - "IA", "H12", seq_p_IA_H12, seq_p_IA_H12_B, NA, NA, - "IA", "H13", seq_p_IA_H13, seq_p_IA_H13_B, NA, NA, - "IA", "H23", seq_p_IA_H23, seq_p_IA_H23_B, NA, NA, - "IA", "H1", seq_p_IA_H1, seq_p_IA_H1_B, adj_seq_IA_H1, adj_seq_IA_H1_B, - "IA", "H2", seq_p_IA_H2, seq_p_IA_H2_B, adj_seq_IA_H2, adj_seq_IA_H2_B, - "IA", "H3", seq_p_IA_H3, seq_p_IA_H3_B, adj_seq_IA_H3, adj_seq_IA_H3_B, - "FA", "H123", seq_p_FA_H123, seq_p_FA_H123_B, NA, NA, - "FA", "H12", seq_p_FA_H12, seq_p_FA_H12_B, NA, NA, - "FA", "H13", seq_p_FA_H13, seq_p_FA_H13_B, NA, NA, - "FA", "H23", seq_p_FA_H23, seq_p_FA_H23_B, NA, NA, - "FA", "H1", seq_p_FA_H1, seq_p_FA_H1_B, adj_seq_FA_H1, adj_seq_FA_H1_B, - "FA", "H2", seq_p_FA_H2, seq_p_FA_H2_B, adj_seq_FA_H2, adj_seq_FA_H2_B, - "FA", "H3", seq_p_FA_H3, seq_p_FA_H3_B, adj_seq_FA_H3, adj_seq_FA_H3_B -) - -ans %>% - select( - Analysis, Hypothesis, - `Sequential p-values of Weighted Bonferroni`, `Adjusted-sequential p-values of Weighted Bonferroni`, - `Sequential p-values of WPGSD`, `Adjusted-sequential p-values of WPGSD` - ) %>% - gt() %>% - tab_spanner( - label = "Weighted Bonferroni", - columns = c(`Sequential p-values of Weighted Bonferroni`, `Adjusted-sequential p-values of Weighted Bonferroni`) - ) %>% - tab_spanner( - label = "WPGSD", - columns = c(`Sequential p-values of WPGSD`, `Adjusted-sequential p-values of WPGSD`) - ) %>% - tab_style_body( - columns = where(is.numeric), - style = cell_fill(color = "pink"), - fn = function(x) x <= 0.025 - ) %>% - fmt_number(columns = 3:6, decimals = 4) %>% - tab_header( - title = "(Adjusted-) sequential p-values", - subtitle = "Multiple populations" - ) # %>% as_latex() - diff --git a/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/adj-seq-p.Rmd b/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/adj-seq-p.Rmd deleted file mode 100644 index df94c1c..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/adj-seq-p.Rmd +++ /dev/null @@ -1,810 +0,0 @@ ---- -title: "Adjusted sequential p-values" -author: "Yujie Zhao, Qi Liu, Linda Sun, Keaven Anderson" -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{Adjusted sequential p-values} ---- - -```{r, message = FALSE, warning = FALSE} -library(wpgsd) -library(gsDesign) -library(tibble) -library(gt) -library(dplyr) -``` - -# Example overview - -In a 2-arm controlled clinical trial example with one primary endpoint, there are 3 patient populations defined by the status of two biomarkers A and B: - -- biomarker A positive, -- biomarker B positive, -- overall population. - -The 3 primary elementary hypotheses are: - -- $H_1$: the experimental treatment is superior to the control in the biomarker A positive population; -- \item $H_2$: the experimental treatment is superior to the control in the biomarker B positive population; -- \item $H_3$: the experimental treatment is superior to the control in the overall population. - -Assume an interim analysis and a final analysis are planned for the study and the number of events are listed as - -```{r} -event_tbl <- tribble( - ~population, ~analysis, ~event, - "A positive", 1, 100, - "B positive", 1, 110, - "AB positive", 1, 80, - "overall", 1, 225, - "A positive", 2, 200, - "B positive", 2, 220, - "AB positive", 2, 160, - "overall", 2, 450, -) -``` - -The observed p-values are - -```{r} -obs_tbl <- tribble( - ~hypothesis, ~analysis, ~obs_p, - "H1", 1, 0.02, - "H2", 1, 0.01, - "H3", 1, 0.012, - "H1", 2, 0.015, - "H2", 2, 0.012, - "H3", 2, 0.010 -) %>% - mutate(obs_Z = -qnorm(obs_p)) - -obs_tbl %>% - gt() %>% - tab_header(title = "Nominal p-values") - -p_obs_IA <- (obs_tbl %>% filter(analysis == 1))$obs_p -p_obs_FA <- (obs_tbl %>% filter(analysis == 2))$obs_p -``` - -The information fraction of $H_1, H_2, H_3$ at IA is - -```{r} -IF_IA <- c( - ((event_tbl %>% filter(analysis == 1, population == "A positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "A positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event), - ((event_tbl %>% filter(analysis == 1, population == "B positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "B positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event), - ((event_tbl %>% filter(analysis == 1, population == "AB positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "AB positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event) -) - -IF_IA -``` - -We assign the initial weights of $H_1, H_2, H_3$ as$\left(w_1(I), w_2(I), w_3(I) \right) = (0.3, 0.3, 0.4).$ And its multiplicity strategy is visualized in below. If $H_1$ is rejected, then $3/7$ local significance level $\alpha_1$ will be propagated to $H_2$, and $4/7$ will go to $H_3$. If $H_3$ is rejected, then half of $\alpha_3$ goes to $H_1$, and half goes to $H_2$. - -```{r} -# Transition matrix in Figure A1 -m <- matrix(c( - 0, 3 / 7, 4 / 7, - 3 / 7, 0, 4 / 7, - 0.5, 0.5, 0 -), nrow = 3, byrow = TRUE) -# Initial weights -w <- c(0.3, 0.3, 0.4) -``` - -```{r} -name_hypotheses <- c("H1: Biomarker A positive", "H2: Biomarker B positive", "H3: Overall Population") - -hplot <- gMCPLite::hGraph( - 3, - alphaHypotheses = w, m = m, - nameHypotheses = name_hypotheses, trhw = .2, trhh = .1, - digits = 5, trdigits = 3, size = 5, halfWid = 1, halfHgt = 0.5, - offset = 0.2, trprop = 0.4, - fill = as.factor(c(2, 3, 1)), - palette = c("#BDBDBD", "#E0E0E0", "#EEEEEE"), - wchar = "w" -) -hplot -``` - -The correlation of the 6 statistisc (2 analysis $\times$ 3 hypothesis) are - -```{r} -# Event count of intersection of paired hypotheses - Table 2 -# H1, H2: Hypotheses intersected. -# (1, 1) represents counts for hypothesis 1 -# (1, 2) for counts for the intersection of hypotheses 1 and 2 -event <- tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, event_tbl %>% filter(analysis == 1, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 2, 1, event_tbl %>% filter(analysis == 1, population == "B positive") %>% select(event) %>% as.numeric(), - 3, 3, 1, event_tbl %>% filter(analysis == 1, population == "overall") %>% select(event) %>% as.numeric(), - 1, 2, 1, event_tbl %>% filter(analysis == 1, population == "AB positive") %>% select(event) %>% as.numeric(), - 1, 3, 1, event_tbl %>% filter(analysis == 1, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 3, 1, event_tbl %>% filter(analysis == 1, population == "B positive") %>% select(event) %>% as.numeric(), - 1, 1, 2, event_tbl %>% filter(analysis == 2, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 2, 2, event_tbl %>% filter(analysis == 2, population == "B positive") %>% select(event) %>% as.numeric(), - 3, 3, 2, event_tbl %>% filter(analysis == 2, population == "overall") %>% select(event) %>% as.numeric(), - 1, 2, 2, event_tbl %>% filter(analysis == 2, population == "AB positive") %>% select(event) %>% as.numeric(), - 1, 3, 2, event_tbl %>% filter(analysis == 2, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 3, 2, event_tbl %>% filter(analysis == 2, population == "B positive") %>% select(event) %>% as.numeric() -) -event - -# Generate correlation from events -gs_corr <- wpgsd::generate_corr(event) -gs_corr %>% round(2) -``` - -# Sequential p-value - -## IA - -```{r, wpgsdSeqIA, message=FALSE} -seq_p_IA_H123 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H1, H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H12 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H1, H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H13 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H1, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H23 <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H1 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H1", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H2 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H3 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) -``` - -```{r, weightedBonferroniSeqIA, message=FALSE} -seq_p_IA_H123_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H1, H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -seq_p_IA_H12_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H1, H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H13_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H1, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -seq_p_IA_H23_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -seq_p_IA_H1_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H1", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -seq_p_IA_H2_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -seq_p_IA_H3_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) -``` - -## FA - -```{r, wpgsdSeqFA, message=FALSE} -seq_p_FA_H123 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1, H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.15) -) - -seq_p_FA_H12 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1, H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.15) -) - -seq_p_FA_H13 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.15) -) - -seq_p_FA_H23 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.15) -) - -seq_p_FA_H1 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H2 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H3 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) -``` - -```{r, weightedBonferroniSeqFA, message=FALSE} -seq_p_FA_H123_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1, H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H12_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1, H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H13_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H23_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H1_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H2_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H3_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) -``` - -# Adjusted-Sequential p-value - -## IA - -```{r, wpgsdAdjSeqIA} -adj_seq_IA_H1 <- max(seq_p_IA_H123, seq_p_IA_H12, seq_p_IA_H13, seq_p_IA_H1) -adj_seq_IA_H2 <- max(seq_p_IA_H123, seq_p_IA_H12, seq_p_IA_H23, seq_p_IA_H2) -adj_seq_IA_H3 <- max(seq_p_IA_H123, seq_p_IA_H13, seq_p_IA_H23, seq_p_IA_H3) - -cat("The adjusted-sequential p-value of H1, H2, H3 in IA via WPGSD is", adj_seq_IA_H1, adj_seq_IA_H2, adj_seq_IA_H3, "\n") -``` - -```{r, weightedBonferroniAdjSeqIA} -adj_seq_IA_H1_B <- max(seq_p_IA_H123_B, seq_p_IA_H12_B, seq_p_IA_H13_B, seq_p_IA_H1_B) -adj_seq_IA_H2_B <- max(seq_p_IA_H123_B, seq_p_IA_H12_B, seq_p_IA_H23_B, seq_p_IA_H2_B) -adj_seq_IA_H3_B <- max(seq_p_IA_H123_B, seq_p_IA_H13_B, seq_p_IA_H23_B, seq_p_IA_H3_B) - -cat("The adjusted-sequential p-value of H1, H2, H3 in FA via weighted Bonferroni is", adj_seq_IA_H1_B, adj_seq_IA_H2_B, adj_seq_IA_H3_B, "\n") -``` - -## FA - -### WPGSD -```{r, wpgsdAdjSeqFA} -adj_seq_FA_H1 <- max(seq_p_FA_H123, seq_p_FA_H12, seq_p_FA_H13, seq_p_FA_H1) -adj_seq_FA_H2 <- max(seq_p_FA_H123, seq_p_FA_H12, seq_p_FA_H23, seq_p_FA_H2) -adj_seq_FA_H3 <- max(seq_p_FA_H123, seq_p_FA_H13, seq_p_FA_H23, seq_p_FA_H3) - -cat("The adjusted-sequential p-value of H1, H2, H3 in FA via WPGSD is", adj_seq_FA_H1, adj_seq_FA_H2, adj_seq_FA_H3, "\n") -``` - -```{r, weightedBonferroniAdjSeqFA} -adj_seq_FA_H1_B <- max(seq_p_FA_H123_B, seq_p_FA_H12_B, seq_p_FA_H13_B, seq_p_FA_H1_B) -adj_seq_FA_H2_B <- max(seq_p_FA_H123_B, seq_p_FA_H12_B, seq_p_FA_H23_B, seq_p_FA_H2_B) -adj_seq_FA_H3_B <- max(seq_p_FA_H123_B, seq_p_FA_H13_B, seq_p_FA_H23_B, seq_p_FA_H3_B) - -cat("The adjusted-sequential p-value of H1, H2, H3 in FA via weighted Bonferroni is", adj_seq_FA_H1_B, adj_seq_FA_H2_B, adj_seq_FA_H3_B, "\n") -``` - -# Summary - -```{r} -ans <- tribble( - ~Analysis, ~Hypothesis, ~`Sequential p-values of WPGSD`, ~`Sequential p-values of Weighted Bonferroni`, ~`Adjusted-sequential p-values of WPGSD`, ~`Adjusted-sequential p-values of Weighted Bonferroni`, - "IA", "H123", seq_p_IA_H123, seq_p_IA_H123_B, NA, NA, - "IA", "H12", seq_p_IA_H12, seq_p_IA_H12_B, NA, NA, - "IA", "H13", seq_p_IA_H13, seq_p_IA_H13_B, NA, NA, - "IA", "H23", seq_p_IA_H23, seq_p_IA_H23_B, NA, NA, - "IA", "H1", seq_p_IA_H1, seq_p_IA_H1_B, adj_seq_IA_H1, adj_seq_IA_H1_B, - "IA", "H2", seq_p_IA_H2, seq_p_IA_H2_B, adj_seq_IA_H2, adj_seq_IA_H2_B, - "IA", "H3", seq_p_IA_H3, seq_p_IA_H3_B, adj_seq_IA_H3, adj_seq_IA_H3_B, - "FA", "H123", seq_p_FA_H123, seq_p_FA_H123_B, NA, NA, - "FA", "H12", seq_p_FA_H12, seq_p_FA_H12_B, NA, NA, - "FA", "H13", seq_p_FA_H13, seq_p_FA_H13_B, NA, NA, - "FA", "H23", seq_p_FA_H23, seq_p_FA_H23_B, NA, NA, - "FA", "H1", seq_p_FA_H1, seq_p_FA_H1_B, adj_seq_FA_H1, adj_seq_FA_H1_B, - "FA", "H2", seq_p_FA_H2, seq_p_FA_H2_B, adj_seq_FA_H2, adj_seq_FA_H2_B, - "FA", "H3", seq_p_FA_H3, seq_p_FA_H3_B, adj_seq_FA_H3, adj_seq_FA_H3_B -) - -ans %>% - select( - Analysis, Hypothesis, - `Sequential p-values of Weighted Bonferroni`, `Adjusted-sequential p-values of Weighted Bonferroni`, - `Sequential p-values of WPGSD`, `Adjusted-sequential p-values of WPGSD` - ) %>% - gt() %>% - tab_spanner( - label = "Weighted Bonferroni", - columns = c(`Sequential p-values of Weighted Bonferroni`, `Adjusted-sequential p-values of Weighted Bonferroni`) - ) %>% - tab_spanner( - label = "WPGSD", - columns = c(`Sequential p-values of WPGSD`, `Adjusted-sequential p-values of WPGSD`) - ) %>% - tab_style_body( - columns = where(is.numeric), - style = cell_fill(color = "pink"), - fn = function(x) x <= 0.025 - ) %>% - fmt_number(columns = 3:6, decimals = 4) %>% - tab_header( - title = "(Adjusted-) sequential p-values", - subtitle = "Multiple populations" - ) # %>% as_latex() -``` diff --git a/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/adj-seq-p.html b/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/adj-seq-p.html deleted file mode 100644 index 0236e45..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/adj-seq-p.html +++ /dev/null @@ -1,3399 +0,0 @@ - - - - - - - - - - - - - - -Adjusted sequential p-values - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- - - -
-
-
-
-
- -
- - - - - - - -
library(wpgsd)
-library(gsDesign)
-library(tibble)
-library(gt)
-library(dplyr)
-
-

1 Example overview

-

In a 2-arm controlled clinical trial example with one primary -endpoint, there are 3 patient populations defined by the status of two -biomarkers A and B:

-
    -
  • biomarker A positive,
  • -
  • biomarker B positive,
  • -
  • overall population.
  • -
-

The 3 primary elementary hypotheses are:

-
    -
  • \(H_1\): the experimental treatment -is superior to the control in the biomarker A positive population;
  • -
  • \(H_2\): the experimental treatment -is superior to the control in the biomarker B positive population;
  • -
  • \(H_3\): the experimental treatment -is superior to the control in the overall population.
  • -
-

Assume an interim analysis and a final analysis are planned for the -study and the number of events are listed as

-
event_tbl <- tribble(
-  ~population, ~analysis, ~event,
-  "A positive", 1, 100,
-  "B positive", 1, 110,
-  "AB positive", 1, 80,
-  "overall", 1, 225,
-  "A positive", 2, 200,
-  "B positive", 2, 220,
-  "AB positive", 2, 160,
-  "overall", 2, 450,
-)
-

The observed p-values are

-
obs_tbl <- tribble(
-  ~hypothesis, ~analysis, ~obs_p,
-  "H1", 1, 0.02,
-  "H2", 1, 0.01,
-  "H3", 1, 0.012,
-  "H1", 2, 0.015,
-  "H2", 2, 0.012,
-  "H3", 2, 0.010
-) %>%
-  mutate(obs_Z = -qnorm(obs_p))
-
-obs_tbl %>%
-  gt() %>%
-  tab_header(title = "Nominal p-values")
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Nominal p-values
hypothesisanalysisobs_pobs_Z
H110.0202.053749
H210.0102.326348
H310.0122.257129
H120.0152.170090
H220.0122.257129
H320.0102.326348
-
-
p_obs_IA <- (obs_tbl %>% filter(analysis == 1))$obs_p
-p_obs_FA <- (obs_tbl %>% filter(analysis == 2))$obs_p
-

The information fraction of \(H_1, H_2, -H_3\) at IA is

-
IF_IA <- c(
-  ((event_tbl %>% filter(analysis == 1, population == "A positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) /
-    ((event_tbl %>% filter(analysis == 2, population == "A positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event),
-  ((event_tbl %>% filter(analysis == 1, population == "B positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) /
-    ((event_tbl %>% filter(analysis == 2, population == "B positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event),
-  ((event_tbl %>% filter(analysis == 1, population == "AB positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) /
-    ((event_tbl %>% filter(analysis == 2, population == "AB positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event)
-)
-
-IF_IA
-
## [1] 0.5 0.5 0.5
-

We assign the initial weights of \(H_1, -H_2, H_3\) as\(\left(w_1(I), w_2(I), -w_3(I) \right) = (0.3, 0.3, 0.4).\) And its multiplicity strategy -is visualized in below. If \(H_1\) is -rejected, then \(3/7\) local -significance level \(\alpha_1\) will be -propagated to \(H_2\), and \(4/7\) will go to \(H_3\). If \(H_3\) is rejected, then half of \(\alpha_3\) goes to \(H_1\), and half goes to \(H_2\).

-
# Transition matrix in Figure A1
-m <- matrix(c(
-  0, 3 / 7, 4 / 7,
-  3 / 7, 0, 4 / 7,
-  0.5, 0.5, 0
-), nrow = 3, byrow = TRUE)
-# Initial weights
-w <- c(0.3, 0.3, 0.4)
-
name_hypotheses <- c("H1: Biomarker A positive", "H2: Biomarker B positive", "H3: Overall Population")
-
-hplot <- gMCPLite::hGraph(
-  3,
-  alphaHypotheses = w, m = m,
-  nameHypotheses = name_hypotheses, trhw = .2, trhh = .1,
-  digits = 5, trdigits = 3, size = 5, halfWid = 1, halfHgt = 0.5,
-  offset = 0.2, trprop = 0.4,
-  fill = as.factor(c(2, 3, 1)),
-  palette = c("#BDBDBD", "#E0E0E0", "#EEEEEE"),
-  wchar = "w"
-)
-hplot
-

-

The correlation of the 6 statistisc (2 analysis \(\times\) 3 hypothesis) are

-
# Event count of intersection of paired hypotheses - Table 2
-# H1, H2: Hypotheses intersected.
-# (1, 1) represents counts for hypothesis 1
-# (1, 2) for counts for the intersection of hypotheses 1 and 2
-event <- tribble(
-  ~H1, ~H2, ~Analysis, ~Event,
-  1, 1, 1, event_tbl %>% filter(analysis == 1, population == "A positive") %>% select(event) %>% as.numeric(),
-  2, 2, 1, event_tbl %>% filter(analysis == 1, population == "B positive") %>% select(event) %>% as.numeric(),
-  3, 3, 1, event_tbl %>% filter(analysis == 1, population == "overall") %>% select(event) %>% as.numeric(),
-  1, 2, 1, event_tbl %>% filter(analysis == 1, population == "AB positive") %>% select(event) %>% as.numeric(),
-  1, 3, 1, event_tbl %>% filter(analysis == 1, population == "A positive") %>% select(event) %>% as.numeric(),
-  2, 3, 1, event_tbl %>% filter(analysis == 1, population == "B positive") %>% select(event) %>% as.numeric(),
-  1, 1, 2, event_tbl %>% filter(analysis == 2, population == "A positive") %>% select(event) %>% as.numeric(),
-  2, 2, 2, event_tbl %>% filter(analysis == 2, population == "B positive") %>% select(event) %>% as.numeric(),
-  3, 3, 2, event_tbl %>% filter(analysis == 2, population == "overall") %>% select(event) %>% as.numeric(),
-  1, 2, 2, event_tbl %>% filter(analysis == 2, population == "AB positive") %>% select(event) %>% as.numeric(),
-  1, 3, 2, event_tbl %>% filter(analysis == 2, population == "A positive") %>% select(event) %>% as.numeric(),
-  2, 3, 2, event_tbl %>% filter(analysis == 2, population == "B positive") %>% select(event) %>% as.numeric()
-)
-event
-
## # A tibble: 12 × 4
-##       H1    H2 Analysis Event
-##    <dbl> <dbl>    <dbl> <dbl>
-##  1     1     1        1   100
-##  2     2     2        1   110
-##  3     3     3        1   225
-##  4     1     2        1    80
-##  5     1     3        1   100
-##  6     2     3        1   110
-##  7     1     1        2   200
-##  8     2     2        2   220
-##  9     3     3        2   450
-## 10     1     2        2   160
-## 11     1     3        2   200
-## 12     2     3        2   220
-
# Generate correlation from events
-gs_corr <- wpgsd::generate_corr(event)
-gs_corr %>% round(2)
-
##      H1_A1 H2_A1 H3_A1 H1_A2 H2_A2 H3_A2
-## [1,]  1.00  0.76  0.67  0.71  0.54  0.47
-## [2,]  0.76  1.00  0.70  0.54  0.71  0.49
-## [3,]  0.67  0.70  1.00  0.47  0.49  0.71
-## [4,]  0.71  0.54  0.47  1.00  0.76  0.67
-## [5,]  0.54  0.71  0.49  0.76  1.00  0.70
-## [6,]  0.47  0.49  0.71  0.67  0.70  1.00
-
-
-

2 Sequential p-value

-
-

2.1 IA

-
seq_p_IA_H123 <- calc_seq_p(
-  test_analysis = 1,
-  test_hypothesis = "H1, H2, H3",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ),
-  alpha_spending_type = 2,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = gsDesign::sfHSD,
-  spending_fun_par = -4,
-  info_frac = c(min(IF_IA), 1),
-  interval = c(1e-4, 0.2)
-)
-
-seq_p_IA_H12 <- calc_seq_p(
-  test_analysis = 1,
-  test_hypothesis = "H1, H2",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ),
-  alpha_spending_type = 2,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = gsDesign::sfHSD,
-  spending_fun_par = -4,
-  info_frac = c(min(IF_IA), 1),
-  interval = c(1e-4, 0.2)
-)
-
-seq_p_IA_H13 <- calc_seq_p(
-  test_analysis = 1,
-  test_hypothesis = "H1, H3",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ),
-  alpha_spending_type = 2,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = gsDesign::sfHSD,
-  spending_fun_par = -4,
-  info_frac = c(min(IF_IA), 1),
-  interval = c(1e-4, 0.2)
-)
-
-seq_p_IA_H23 <- calc_seq_p(
-  test_analysis = 1, # stage of interest
-  test_hypothesis = "H2, H3",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ),
-  alpha_spending_type = 2,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = gsDesign::sfHSD,
-  spending_fun_par = -4,
-  info_frac = c(min(IF_IA), 1),
-  interval = c(1e-4, 0.2)
-)
-
-seq_p_IA_H1 <- calc_seq_p(
-  test_analysis = 1,
-  test_hypothesis = "H1",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ),
-  alpha_spending_type = 2,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = gsDesign::sfHSD,
-  spending_fun_par = -4,
-  info_frac = c(min(IF_IA), 1),
-  interval = c(1e-4, 0.2)
-)
-
-seq_p_IA_H2 <- calc_seq_p(
-  test_analysis = 1,
-  test_hypothesis = "H2",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ),
-  alpha_spending_type = 2,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = gsDesign::sfHSD,
-  spending_fun_par = -4,
-  info_frac = c(min(IF_IA), 1),
-  interval = c(1e-4, 0.2)
-)
-
-seq_p_IA_H3 <- calc_seq_p(
-  test_analysis = 1,
-  test_hypothesis = "H3",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ),
-  alpha_spending_type = 2,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = gsDesign::sfHSD,
-  spending_fun_par = -4,
-  info_frac = c(min(IF_IA), 1),
-  interval = c(1e-4, 0.2)
-)
-
seq_p_IA_H123_B <- calc_seq_p(
-  test_analysis = 1, # stage of interest
-  test_hypothesis = "H1, H2, H3",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 0,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
-  spending_fun_par = list(-4, -4, -4),
-  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
-  interval = c(1e-4, 0.3)
-)
-
-seq_p_IA_H12_B <- calc_seq_p(
-  test_analysis = 1, # stage of interest
-  test_hypothesis = "H1, H2",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 0,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
-  spending_fun_par = list(-4, -4, -4),
-  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
-  interval = c(1e-4, 0.2)
-)
-
-seq_p_IA_H13_B <- calc_seq_p(
-  test_analysis = 1, # stage of interest
-  test_hypothesis = "H1, H3",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 0,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
-  spending_fun_par = list(-4, -4, -4),
-  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
-  interval = c(1e-4, 0.3)
-)
-
-seq_p_IA_H23_B <- calc_seq_p(
-  test_analysis = 1, # stage of interest
-  test_hypothesis = "H2, H3",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 0,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
-  spending_fun_par = list(-4, -4, -4),
-  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
-  interval = c(1e-4, 0.3)
-)
-
-seq_p_IA_H1_B <- calc_seq_p(
-  test_analysis = 1, # stage of interest
-  test_hypothesis = "H1",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 0,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
-  spending_fun_par = list(-4, -4, -4),
-  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
-  interval = c(1e-4, 0.3)
-)
-
-seq_p_IA_H2_B <- calc_seq_p(
-  test_analysis = 1, # stage of interest
-  test_hypothesis = "H2",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 0,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
-  spending_fun_par = list(-4, -4, -4),
-  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
-  interval = c(1e-4, 0.3)
-)
-
-seq_p_IA_H3_B <- calc_seq_p(
-  test_analysis = 1, # stage of interest
-  test_hypothesis = "H3",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 0,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
-  spending_fun_par = list(-4, -4, -4),
-  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
-  interval = c(1e-4, 0.3)
-)
-
-
-

2.2 FA

-
seq_p_FA_H123 <- calc_seq_p(
-  test_analysis = 2, # stage of interest
-  test_hypothesis = "H1, H2, H3",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 2,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = gsDesign::sfHSD,
-  spending_fun_par = -4,
-  info_frac = c(min(IF_IA), 1),
-  interval = c(1e-4, 0.15)
-)
-
-seq_p_FA_H12 <- calc_seq_p(
-  test_analysis = 2, # stage of interest
-  test_hypothesis = "H1, H2",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 2,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = gsDesign::sfHSD,
-  spending_fun_par = -4,
-  info_frac = c(min(IF_IA), 1),
-  interval = c(1e-4, 0.15)
-)
-
-seq_p_FA_H13 <- calc_seq_p(
-  test_analysis = 2, # stage of interest
-  test_hypothesis = "H1, H3",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 2,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = gsDesign::sfHSD,
-  spending_fun_par = -4,
-  info_frac = c(min(IF_IA), 1),
-  interval = c(1e-4, 0.15)
-)
-
-seq_p_FA_H23 <- calc_seq_p(
-  test_analysis = 2, # stage of interest
-  test_hypothesis = "H2, H3",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 2,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = gsDesign::sfHSD,
-  spending_fun_par = -4,
-  info_frac = c(min(IF_IA), 1),
-  interval = c(1e-4, 0.15)
-)
-
-seq_p_FA_H1 <- calc_seq_p(
-  test_analysis = 2, # stage of interest
-  test_hypothesis = "H1",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 2,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = gsDesign::sfHSD,
-  spending_fun_par = -4,
-  info_frac = c(min(IF_IA), 1),
-  interval = c(1e-4, 0.2)
-)
-
-seq_p_FA_H2 <- calc_seq_p(
-  test_analysis = 2, # stage of interest
-  test_hypothesis = "H2",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 2,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = gsDesign::sfHSD,
-  spending_fun_par = -4,
-  info_frac = c(min(IF_IA), 1),
-  interval = c(1e-4, 0.2)
-)
-
-seq_p_FA_H3 <- calc_seq_p(
-  test_analysis = 2, # stage of interest
-  test_hypothesis = "H3",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 2,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = gsDesign::sfHSD,
-  spending_fun_par = -4,
-  info_frac = c(min(IF_IA), 1),
-  interval = c(1e-4, 0.2)
-)
-
seq_p_FA_H123_B <- calc_seq_p(
-  test_analysis = 2, # stage of interest
-  test_hypothesis = "H1, H2, H3",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 0,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
-  spending_fun_par = list(-4, -4, -4),
-  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
-  interval = c(1e-4, 0.2)
-)
-
-seq_p_FA_H12_B <- calc_seq_p(
-  test_analysis = 2, # stage of interest
-  test_hypothesis = "H1, H2",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 0,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
-  spending_fun_par = list(-4, -4, -4),
-  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
-  interval = c(1e-4, 0.2)
-)
-
-seq_p_FA_H13_B <- calc_seq_p(
-  test_analysis = 2, # stage of interest
-  test_hypothesis = "H1, H3",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 0,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
-  spending_fun_par = list(-4, -4, -4),
-  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
-  interval = c(1e-4, 0.2)
-)
-
-seq_p_FA_H23_B <- calc_seq_p(
-  test_analysis = 2, # stage of interest
-  test_hypothesis = "H2, H3",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 0,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
-  spending_fun_par = list(-4, -4, -4),
-  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
-  interval = c(1e-4, 0.2)
-)
-
-seq_p_FA_H1_B <- calc_seq_p(
-  test_analysis = 2, # stage of interest
-  test_hypothesis = "H1",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 0,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
-  spending_fun_par = list(-4, -4, -4),
-  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
-  interval = c(1e-4, 0.2)
-)
-
-seq_p_FA_H2_B <- calc_seq_p(
-  test_analysis = 2, # stage of interest
-  test_hypothesis = "H2",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 0,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
-  spending_fun_par = list(-4, -4, -4),
-  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
-  interval = c(1e-4, 0.2)
-)
-
-seq_p_FA_H3_B <- calc_seq_p(
-  test_analysis = 2, # stage of interest
-  test_hypothesis = "H3",
-  p_obs = tibble(
-    analysis = 1:2,
-    H1 = c(p_obs_IA[1], p_obs_FA[1]),
-    H2 = c(p_obs_IA[2], p_obs_FA[2]),
-    H3 = c(p_obs_IA[3], p_obs_FA[3])
-  ), # observed p-value
-  alpha_spending_type = 0,
-  n_analysis = 2,
-  initial_weight = w,
-  transition_mat = m,
-  z_corr = gs_corr,
-  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
-  spending_fun_par = list(-4, -4, -4),
-  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
-  interval = c(1e-4, 0.2)
-)
-
-
-
-

3 Adjusted-Sequential -p-value

-
-

3.1 IA

-
adj_seq_IA_H1 <- max(seq_p_IA_H123, seq_p_IA_H12, seq_p_IA_H13, seq_p_IA_H1)
-adj_seq_IA_H2 <- max(seq_p_IA_H123, seq_p_IA_H12, seq_p_IA_H23, seq_p_IA_H2)
-adj_seq_IA_H3 <- max(seq_p_IA_H123, seq_p_IA_H13, seq_p_IA_H23, seq_p_IA_H3)
-
-cat("The adjusted-sequential p-value of H1, H2, H3 in IA via WPGSD is", adj_seq_IA_H1, adj_seq_IA_H2, adj_seq_IA_H3, "\n")
-
## The adjusted-sequential p-value of H1, H2, H3 in IA via WPGSD is 0.1942751 0.1942751 0.1942751
-
adj_seq_IA_H1_B <- max(seq_p_IA_H123_B, seq_p_IA_H12_B, seq_p_IA_H13_B, seq_p_IA_H1_B)
-adj_seq_IA_H2_B <- max(seq_p_IA_H123_B, seq_p_IA_H12_B, seq_p_IA_H23_B, seq_p_IA_H2_B)
-adj_seq_IA_H3_B <- max(seq_p_IA_H123_B, seq_p_IA_H13_B, seq_p_IA_H23_B, seq_p_IA_H3_B)
-
-cat("The adjusted-sequential p-value of H1, H2, H3 in FA via weighted Bonferroni is", adj_seq_IA_H1_B, adj_seq_IA_H2_B, adj_seq_IA_H3_B, "\n")
-
## The adjusted-sequential p-value of H1, H2, H3 in FA via weighted Bonferroni is 0.2516717 0.2516717 0.2516717
-
-
-

3.2 FA

-
-

3.2.1 WPGSD

-
adj_seq_FA_H1 <- max(seq_p_FA_H123, seq_p_FA_H12, seq_p_FA_H13, seq_p_FA_H1)
-adj_seq_FA_H2 <- max(seq_p_FA_H123, seq_p_FA_H12, seq_p_FA_H23, seq_p_FA_H2)
-adj_seq_FA_H3 <- max(seq_p_FA_H123, seq_p_FA_H13, seq_p_FA_H23, seq_p_FA_H3)
-
-cat("The adjusted-sequential p-value of H1, H2, H3 in FA via WPGSD is", adj_seq_FA_H1, adj_seq_FA_H2, adj_seq_FA_H3, "\n")
-
## The adjusted-sequential p-value of H1, H2, H3 in FA via WPGSD is 0.02097944 0.02097944 0.02063497
-
adj_seq_FA_H1_B <- max(seq_p_FA_H123_B, seq_p_FA_H12_B, seq_p_FA_H13_B, seq_p_FA_H1_B)
-adj_seq_FA_H2_B <- max(seq_p_FA_H123_B, seq_p_FA_H12_B, seq_p_FA_H23_B, seq_p_FA_H2_B)
-adj_seq_FA_H3_B <- max(seq_p_FA_H123_B, seq_p_FA_H13_B, seq_p_FA_H23_B, seq_p_FA_H3_B)
-
-cat("The adjusted-sequential p-value of H1, H2, H3 in FA via weighted Bonferroni is", adj_seq_FA_H1_B, adj_seq_FA_H2_B, adj_seq_FA_H3_B, "\n")
-
## The adjusted-sequential p-value of H1, H2, H3 in FA via weighted Bonferroni is 0.0265823 0.0265823 0.0265823
-
-
-
-
-

4 Summary

-
ans <- tribble(
-  ~Analysis, ~Hypothesis, ~`Sequential p-values of WPGSD`, ~`Sequential p-values of Weighted Bonferroni`, ~`Adjusted-sequential p-values of WPGSD`, ~`Adjusted-sequential p-values of Weighted Bonferroni`,
-  "IA", "H123", seq_p_IA_H123, seq_p_IA_H123_B, NA, NA,
-  "IA", "H12", seq_p_IA_H12, seq_p_IA_H12_B, NA, NA,
-  "IA", "H13", seq_p_IA_H13, seq_p_IA_H13_B, NA, NA,
-  "IA", "H23", seq_p_IA_H23, seq_p_IA_H23_B, NA, NA,
-  "IA", "H1", seq_p_IA_H1, seq_p_IA_H1_B, adj_seq_IA_H1, adj_seq_IA_H1_B,
-  "IA", "H2", seq_p_IA_H2, seq_p_IA_H2_B, adj_seq_IA_H2, adj_seq_IA_H2_B,
-  "IA", "H3", seq_p_IA_H3, seq_p_IA_H3_B, adj_seq_IA_H3, adj_seq_IA_H3_B,
-  "FA", "H123", seq_p_FA_H123, seq_p_FA_H123_B, NA, NA,
-  "FA", "H12", seq_p_FA_H12, seq_p_FA_H12_B, NA, NA,
-  "FA", "H13", seq_p_FA_H13, seq_p_FA_H13_B, NA, NA,
-  "FA", "H23", seq_p_FA_H23, seq_p_FA_H23_B, NA, NA,
-  "FA", "H1", seq_p_FA_H1, seq_p_FA_H1_B, adj_seq_FA_H1, adj_seq_FA_H1_B,
-  "FA", "H2", seq_p_FA_H2, seq_p_FA_H2_B, adj_seq_FA_H2, adj_seq_FA_H2_B,
-  "FA", "H3", seq_p_FA_H3, seq_p_FA_H3_B, adj_seq_FA_H3, adj_seq_FA_H3_B
-)
-
-ans %>%
-  select(
-    Analysis, Hypothesis,
-    `Sequential p-values of Weighted Bonferroni`, `Adjusted-sequential p-values of Weighted Bonferroni`,
-    `Sequential p-values of WPGSD`, `Adjusted-sequential p-values of WPGSD`
-  ) %>%
-  gt() %>%
-  tab_spanner(
-    label = "Weighted Bonferroni",
-    columns = c(`Sequential p-values of Weighted Bonferroni`, `Adjusted-sequential p-values of Weighted Bonferroni`)
-  ) %>%
-  tab_spanner(
-    label = "WPGSD",
-    columns = c(`Sequential p-values of WPGSD`, `Adjusted-sequential p-values of WPGSD`)
-  ) %>%
-  tab_style_body(
-    columns = where(is.numeric),
-    style = cell_fill(color = "pink"),
-    fn = function(x) x <= 0.025
-  ) %>%
-  fmt_number(columns = 3:6, decimals = 4) %>%
-  tab_header(
-    title = "(Adjusted-) sequential p-values",
-    subtitle = "Multiple populations"
-  ) # %>% as_latex()
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(Adjusted-) sequential p-values
Multiple populations
AnalysisHypothesis -
Weighted Bonferroni
-
-
WPGSD
-
Sequential p-values of Weighted BonferroniAdjusted-sequential p-values of Weighted BonferroniSequential p-values of WPGSDAdjusted-sequential p-values of WPGSD
IAH1230.2517NA0.1943NA
IAH120.1678NA0.1400NA
IAH130.1762NA0.1553NA
IAH230.1762NA0.1529NA
IAH10.16780.25170.16780.1943
IAH20.08390.25170.08390.1943
IAH30.10070.25170.10070.1943
FAH1230.0266NA0.0206NA
FAH120.0255NA0.0210NA
FAH130.0186NA0.0165NA
FAH230.0186NA0.0162NA
FAH10.01590.02660.01590.0210
FAH20.01270.02660.01270.0210
FAH30.01060.02660.01060.0206
-
-
- - - -
-
- -
- - - - - - - - - - - - - - - - diff --git a/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/corr_calculation.R b/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/corr_calculation.R deleted file mode 100644 index 9b8c02d..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/corr_calculation.R +++ /dev/null @@ -1,86 +0,0 @@ -## ----message=FALSE------------------------------------------------------------ -library(dplyr) -library(tibble) -library(gt) - -## ----------------------------------------------------------------------------- -event_tb <- tribble( - ~Population, ~"Number of Event in IA", ~"Number of Event in FA", - "Population 1", 100, 200, - "Population 2", 110, 220, - "Overlap of Population 1 and 2", 80, 160, - "Overall Population", 225, 450 -) -event_tb %>% - gt() %>% - tab_header(title = "Number of events at each population") - -## ----------------------------------------------------------------------------- -event_tbl <- tribble( - ~Population, ~"Number of Event in IA", - "Population 1", 100, - "Population 2", 110, - "Overlap in population 1 and 2", 80 -) -event_tbl %>% - gt() %>% - tab_header(title = "Number of events at each population in example 1") - -## ----------------------------------------------------------------------------- -Corr1 <- 80 / sqrt(100 * 110) -round(Corr1, 2) - -## ----------------------------------------------------------------------------- -event_tb2 <- tribble( - ~Population, ~"Number of Event in IA", ~"Number of Event in FA", - "Population 1", 100, 200 -) -event_tb2 %>% - gt() %>% - tab_header(title = "Number of events at each analyses in example 2") - -## ----------------------------------------------------------------------------- -Corr1 <- 100 / sqrt(100 * 200) -round(Corr1, 2) - -## ----------------------------------------------------------------------------- -event_tb3 <- tribble( - ~Population, ~"Number of Event in IA", ~"Number of Event in FA", - "Population 1", 100, 200, - "Population 2", 110, 220, - "Overlap in population 1 and 2", 80, 160 -) -event_tb3 %>% - gt() %>% - tab_header(title = "Number of events at each population & analyses in example 3") - -## ----------------------------------------------------------------------------- -Corr1 <- 80 / sqrt(100 * 220) -round(Corr1, 2) - -## ----message=FALSE------------------------------------------------------------ -library(wpgsd) -# The event table -event <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 100, - 2, 2, 1, 110, - 3, 3, 1, 225, - 1, 2, 1, 80, - 1, 3, 1, 100, - 2, 3, 1, 110, - 1, 1, 2, 200, - 2, 2, 2, 220, - 3, 3, 2, 450, - 1, 2, 2, 160, - 1, 3, 2, 200, - 2, 3, 2, 220 -) - -event %>% - gt() %>% - tab_header(title = "Number of events at each population & analyses") - -## ----------------------------------------------------------------------------- -generate_corr(event) - diff --git a/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/corr_calculation.Rmd b/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/corr_calculation.Rmd deleted file mode 100644 index df67ae9..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/corr_calculation.Rmd +++ /dev/null @@ -1,180 +0,0 @@ ---- -title: "Correlated test statistics" -author: "Chenguang Zhang, Yujie Zhao" -output: - rmarkdown::html_document: - toc: true - toc_float: true - toc_depth: 2 - number_sections: true - highlight: "textmate" - css: "custom.css" - code_fold: hide -vignette: > - %\VignetteEngine{knitr::rmarkdown} - %\VignetteIndexEntry{Correlated test statistics} -bibliography: wpgsd.bib ---- - -The weighted parametric group sequential design (WPGSD) (@anderson2022unified) approach allows one to take advantage of the known correlation structure in constructing efficacy bounds to control family-wise error rate (FWER) for a group sequential design. Here correlation may be due to common observations in nested populations, due to common observations in overlapping populations, or due to common observations in the control arm. - -# Methodologies to calculate correlations - -Suppose that in a group sequential trial there are $m$ elementary null hypotheses $H_i$, $i \in I={1,...,m}$, and there are $K$ analyses. Let $k$ be the index for the interim analyses and final analyses, $k=1,2,...K$. For any nonempty set $J \subseteq I$, we denote the intersection hypothesis $H_J=\cap_{j \in J}H_j$. We note that $H_I$ is the global null hypothesis. - -We assume the plan is for all hypotheses to be tested at each of the $k$ planned analyses if the trial continues to the end for all hypotheses. We further assume that the distribution of the $m \times K$ tests of $m$ individual hypotheses at all $k$ analyses is multivariate normal with a completely known correlation matrix. - -Let $Z_{ik}$ be the standardized normal test statistic for hypothesis $i \in I$, analysis $1 \le k \le K$. Let $n_{ik}$ be the number of events collected cumulatively through stage $k$ for hypothesis $i$. Then $n_{i \wedge i',k \wedge k'}$ is the number of events included in both $Z_{ik}$ and $i$, $i' \in I$, $1 \le k$, $k' \le K$. The key of the parametric tests to utilize the correlation among the test statistics. The correlation between $Z_{ik}$ and $Z_{i'k'}$ is -$$Corr(Z_{ik},Z_{i'k'})=\frac{n_{i \wedge i',k \wedge k'}}{\sqrt{n_{ik}*n_{i'k'}}}$$. - -# Examples - -We borrow an example from a paper by Anderson et al. (@anderson2022unified), demonstrated in Section 2 - Motivating Examples, we use Example 1 as the basis here. The setting will be: - -In a two-arm controlled clinical trial with one primary endpoint, there are three patient populations defined by the status of two biomarkers, A and B: - -* Biomarker A positive, the population 1, -* Biomarker B positive, the population 2, -* Overall population. - -The 3 primary elementary hypotheses are: - -* **H1**: the experimental treatment is superior to the control in the population 1 -* **H2**: the experimental treatment is superior to the control in the population 2 -* **H3**: the experimental treatment is superior to the control in the overall population - -Assume an interim analysis and a final analysis are planned for the study. The number of events are listed as -```{r,message=FALSE} -library(dplyr) -library(tibble) -library(gt) -``` - -```{r} -event_tb <- tribble( - ~Population, ~"Number of Event in IA", ~"Number of Event in FA", - "Population 1", 100, 200, - "Population 2", 110, 220, - "Overlap of Population 1 and 2", 80, 160, - "Overall Population", 225, 450 -) -event_tb %>% - gt() %>% - tab_header(title = "Number of events at each population") -``` - -## Correlation of different populations within the same analysis -Let's consider a simple situation, we want to compare the population 1 and population 2 in only interim analyses. Then $k=1$, and to compare $H_{1}$ and $H_{2}$, the $i$ will be $i=1$ and $i=2$. -The correlation matrix will be -$$Corr(Z_{11},Z_{21})=\frac{n_{1 \wedge 2,1 \wedge 1}}{\sqrt{n_{11}*n_{21}}}$$ -The number of events are listed as -```{r} -event_tbl <- tribble( - ~Population, ~"Number of Event in IA", - "Population 1", 100, - "Population 2", 110, - "Overlap in population 1 and 2", 80 -) -event_tbl %>% - gt() %>% - tab_header(title = "Number of events at each population in example 1") -``` -The the corrleation could be simply calculated as -$$Corr(Z_{11},Z_{21})=\frac{80}{\sqrt{100*110}}=0.76$$ -```{r} -Corr1 <- 80 / sqrt(100 * 110) -round(Corr1, 2) -``` - -## Correlation of different analyses within the same population -Let's consider another simple situation, we want to compare single population, for example, the population 1, but in different analyses, interim and final analyses. Then $i=1$, and to compare IA and FA, the $k$ will be $k=1$ and $k=2$. -The correlation matrix will be -$$Corr(Z_{11},Z_{12})=\frac{n_{1 \wedge 1,1 \wedge 2}}{\sqrt{n_{11}*n_{12}}}$$ -The number of events are listed as -```{r} -event_tb2 <- tribble( - ~Population, ~"Number of Event in IA", ~"Number of Event in FA", - "Population 1", 100, 200 -) -event_tb2 %>% - gt() %>% - tab_header(title = "Number of events at each analyses in example 2") -``` -The the corrleation could be simply calculated as -$$\text{Corr}(Z_{11},Z_{12})=\frac{100}{\sqrt{100*200}}=0.71$$ -The 100 in the numerator is the overlap number of events of interim analysis and final analysis in population 1. -```{r} -Corr1 <- 100 / sqrt(100 * 200) -round(Corr1, 2) -``` - -## Correlation of different analyses and different population -Let's consider the situation that we want to compare population 1 in interim analyses and population 2 in final analyses. Then for different population, $i=1$ and $i=2$, and to compare IA and FA, the $k$ will be $k=1$ and $k=2$. -The correlation matrix will be -$$\text{Corr}(Z_{11},Z_{22})=\frac{n_{1 \wedge 1,2 \wedge 2}}{\sqrt{n_{11}*n_{22}}}$$ -The number of events are listed as -```{r} -event_tb3 <- tribble( - ~Population, ~"Number of Event in IA", ~"Number of Event in FA", - "Population 1", 100, 200, - "Population 2", 110, 220, - "Overlap in population 1 and 2", 80, 160 -) -event_tb3 %>% - gt() %>% - tab_header(title = "Number of events at each population & analyses in example 3") -``` - -The correlation could be simply calculated as -$$\text{Corr}(Z_{11},Z_{22})=\frac{80}{\sqrt{100*220}}=0.54$$ -The 80 in the numerator is the overlap number of events of population 1 in interim analysis and population 2 in final analysis. -```{r} -Corr1 <- 80 / sqrt(100 * 220) -round(Corr1, 2) -``` - -# Generate the correlation matrix by `generate_corr()` -Now we know how to calculate the correlation values under different situations, and the `generate_corr()` function was built based on this logic. We can directly calculate the results for each cross situation via the function. - -First, we need a event table including the information of the study. - -- `H1` refers to one hypothesis, selected depending on the interest, while `H2` refers to the other hypothesis, both of which are listed for multiplicity testing. For example, `H1` means the experimental treatment is superior to the control in the population 1/experimental arm 1; `H2` means the experimental treatment is superior to the control in the population 2/experimental arm 2; -- `Analysis` means different analysis stages, for example, 1 means the interim analysis, and 2 means the final analysis; -- `Event` is the common events overlap by `H1` and `H2`. - -For example: `H1=1`, `H2=1`, `Analysis=1`, `Event=100 `indicates that in the first population, there are 100 cases where the experimental treatment is superior to the control in the interim analysis. - -Another example: `H1=1`, `H2=2`, `Analysis=2`, `Event=160` indicates that the number of overlapping cases where the experimental treatment is superior to the control in population 1 and 2 in the final analysis is 160. - -To be noticed, the column names in this function are fixed to be `H1`, `H2`, `Analysis`, `Event`. -```{r, message=FALSE} -library(wpgsd) -# The event table -event <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 100, - 2, 2, 1, 110, - 3, 3, 1, 225, - 1, 2, 1, 80, - 1, 3, 1, 100, - 2, 3, 1, 110, - 1, 1, 2, 200, - 2, 2, 2, 220, - 3, 3, 2, 450, - 1, 2, 2, 160, - 1, 3, 2, 200, - 2, 3, 2, 220 -) - -event %>% - gt() %>% - tab_header(title = "Number of events at each population & analyses") -``` - -Then we input the above event table to the function of `generate_corr()`, and get the correlation matrix as follow. -```{r} -generate_corr(event) -``` - -# References - diff --git a/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/corr_calculation.html b/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/corr_calculation.html deleted file mode 100644 index 28c00f5..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/corr_calculation.html +++ /dev/null @@ -1,4137 +0,0 @@ - - - - - - - - - - - - - - -Correlated test statistics - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- - - - - - - - - - - - - - - - - diff --git a/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/tech-detail-wb.R b/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/tech-detail-wb.R deleted file mode 100644 index 81d0f9a..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/tech-detail-wb.R +++ /dev/null @@ -1,477 +0,0 @@ -## ----message = FALSE, warning = FALSE----------------------------------------- -library(tibble) -library(gt) -library(gsDesign) -library(dplyr) -library(wpgsd) - -## ----------------------------------------------------------------------------- -k <- 2 # Number of total analysis -n_hypotheses <- 3 # Number of hypotheses - -## ----------------------------------------------------------------------------- -obs_tbl <- tribble( - ~hypothesis, ~analysis, ~obs_p, - "H1", 1, 0.02, - "H2", 1, 0.01, - "H3", 1, 0.006, - "H1", 2, 0.015, - "H2", 2, 0.012, - "H3", 2, 0.004 -) %>% - mutate(obs_Z = -qnorm(obs_p)) - -obs_tbl %>% - gt() %>% - tab_header(title = "Nominal p-values") - -p_obs_IA <- (obs_tbl %>% filter(analysis == 1))$obs_p -p_obs_FA <- (obs_tbl %>% filter(analysis == 2))$obs_p - -## ----------------------------------------------------------------------------- -alpha <- 0.025 -event_tbl <- tribble( - ~population, ~analysis, ~event, - "A positive", 1, 80, - "B positive", 1, 88, - "AB positive", 1, 64, - "overall", 1, 180, - "A positive", 2, 160, - "B positive", 2, 176, - "AB positive", 2, 128, - "overall", 2, 360, -) - -## ----------------------------------------------------------------------------- -IF_IA <- c( - ((event_tbl %>% filter(analysis == 1, population == "A positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "A positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event), - ((event_tbl %>% filter(analysis == 1, population == "B positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "B positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event), - ((event_tbl %>% filter(analysis == 1, population == "AB positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "AB positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event) -) - -IF_IA - -## ----------------------------------------------------------------------------- -m <- matrix(c( # Transition matrix - 0, 3 / 7, 4 / 7, - 3 / 7, 0, 4 / 7, - 1 / 2, 1 / 2, 0 -), nrow = 3, byrow = TRUE) - -w <- c(0.3, 0.3, 0.4) # Initial weights - -## ----------------------------------------------------------------------------- -name_hypotheses <- c( - "H1: Biomarker A positive", - "H2: Biomarker B positive", - "H3: Overall Population" -) - -hplot <- gMCPLite::hGraph( - 3, - alphaHypotheses = w, m = m, - nameHypotheses = name_hypotheses, trhw = .2, trhh = .1, - digits = 5, trdigits = 3, size = 5, halfWid = 1, halfHgt = 0.5, - offset = 0.2, trprop = 0.4, - fill = as.factor(c(2, 3, 1)), - palette = c("#BDBDBD", "#E0E0E0", "#EEEEEE"), - wchar = "w" -) -hplot - -## ----------------------------------------------------------------------------- -# Get weights for all intersection hypotheses -graph <- gMCPLite::matrix2graph(m) -graph <- gMCPLite::setWeights(graph, w) - -## ----------------------------------------------------------------------------- -# Set up hypothetical p-values (0 or 1) to obtain all combinations -pvals <- NULL -for (i in 1:n_hypotheses) { - if (i == 1) { - pvals <- data.frame(x = c(0, 1)) - names(pvals) <- paste("pval_H", i, sep = "") - } else { - tmp <- data.frame(x = c(0, 1)) - names(tmp) <- paste("pval_H", i, sep = "") - pvals <- merge(pvals, tmp) - } -} -# Get the weights for each intersection hypothesis -inter_weight <- NULL # Create an empty table to store the weight of interaction hypotheses -for (i in seq_len(nrow(pvals))) { # Each row in `pvals` is 1 possible interaction hypothesis - pval_tmp <- as.numeric(pvals[i, ]) - graph_tmp <- gMCPLite::gMCP(graph = graph, pvalues = pval_tmp, alpha = alpha) - weight_tmp <- gMCPLite::getWeights(graph_tmp) - inter_weight <- dplyr::bind_rows(inter_weight, weight_tmp) -} - -inter_weight <- replace(inter_weight, pvals == 0, NA) # Replace the empty hypothesis as NA -inter_weight <- inter_weight[-1, ] # Delete the first row since it is empty set - -inter_weight %>% - gt() %>% - tab_header("Weight of all possible interaction hypothesis") - -## ----------------------------------------------------------------------------- -# Event count of intersection of paired hypotheses - Table 2 -# H1, H2: Hypotheses intersected. -# (1, 1) represents counts for hypothesis 1 -# (1, 2) for counts for the intersection of hypotheses 1 and 2 -event <- tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, event_tbl %>% filter(analysis == 1, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 2, 1, event_tbl %>% filter(analysis == 1, population == "B positive") %>% select(event) %>% as.numeric(), - 3, 3, 1, event_tbl %>% filter(analysis == 1, population == "overall") %>% select(event) %>% as.numeric(), - 1, 2, 1, event_tbl %>% filter(analysis == 1, population == "AB positive") %>% select(event) %>% as.numeric(), - 1, 3, 1, event_tbl %>% filter(analysis == 1, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 3, 1, event_tbl %>% filter(analysis == 1, population == "B positive") %>% select(event) %>% as.numeric(), - 1, 1, 2, event_tbl %>% filter(analysis == 2, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 2, 2, event_tbl %>% filter(analysis == 2, population == "B positive") %>% select(event) %>% as.numeric(), - 3, 3, 2, event_tbl %>% filter(analysis == 2, population == "overall") %>% select(event) %>% as.numeric(), - 1, 2, 2, event_tbl %>% filter(analysis == 2, population == "AB positive") %>% select(event) %>% as.numeric(), - 1, 3, 2, event_tbl %>% filter(analysis == 2, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 3, 2, event_tbl %>% filter(analysis == 2, population == "B positive") %>% select(event) %>% as.numeric() -) -event - -# Generate correlation from events -corr <- wpgsd::generate_corr(event) -corr %>% round(2) - -## ----------------------------------------------------------------------------- -w_H1 <- 1 - -# Index to select from the correlation matrix -indx <- grep("H1", colnames(corr)) -corr_H1 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H1 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[1], - n.I = corr_H1[, ncol(corr_H1)]^2, - alpha = alpha * w_H1[1], - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H1", - `H1 p-value boundary` = pval_H1, - `H2 p-value boundary` = NA, - `H3 p-value boundary` = NA -) -ans %>% gt() - -## ----------------------------------------------------------------------------- -w_H2 <- 1 - -# Index to select from the correlation matrix -indx <- grep("H2", colnames(corr)) -corr_H2 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H2 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[2], - n.I = corr_H2[, ncol(corr_H2)]^2, - alpha = alpha * w_H2[1], - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans_new <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H2", - `H1 p-value boundary` = NA, - `H2 p-value boundary` = pval_H2, - `H3 p-value boundary` = NA -) -ans_new %>% gt() -ans <- rbind(ans, ans_new) - -## ----------------------------------------------------------------------------- -w_H3 <- 1 - -# Index to select from the correlation matrix -indx <- grep("H3", colnames(corr)) -corr_H3 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H3 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[3], - n.I = corr_H3[, ncol(corr_H3)]^2, - alpha = alpha * w_H3[1], - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans_new <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H3", - `H1 p-value boundary` = NA, - `H2 p-value boundary` = NA, - `H3 p-value boundary` = pval_H1 -) -ans_new %>% gt() -ans <- rbind(ans, ans_new) - -## ----------------------------------------------------------------------------- -w_H12 <- inter_weight %>% filter(!is.na(H1), !is.na(H2), is.na(H3)) -w_H12 <- w_H12[(!is.na(w_H12))] # Remove NA from weight -w_H12 - -## ----------------------------------------------------------------------------- -# -------------# -# H1 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H1", colnames(corr)) -corr_H1 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H1 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[1], - n.I = corr_H1[, ncol(corr_H1)]^2, - alpha = alpha * w_H12[1], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -# -------------# -# H2 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H2", colnames(corr)) -corr_H2 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H2 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[2], - n.I = corr_H2[, ncol(corr_H2)]^2, - alpha = alpha * w_H12[2], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans_new <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H1, H2", - `H1 p-value boundary` = pval_H1, - `H2 p-value boundary` = pval_H2, - `H3 p-value boundary` = NA -) -ans_new %>% gt() -ans <- rbind(ans, ans_new) - -## ----------------------------------------------------------------------------- -w_H13 <- inter_weight %>% filter(!is.na(H1), is.na(H2), !is.na(H3)) -w_H13 <- w_H13[(!is.na(w_H13))] # Remove NA from weight -w_H13 - -## ----------------------------------------------------------------------------- -# -------------# -# H1 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H1", colnames(corr)) -corr_H1 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H1 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[1], - n.I = corr_H1[, ncol(corr_H1)]^2, - alpha = alpha * w_H13[1], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -# -------------# -# H3 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H3", colnames(corr)) -corr_H3 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H3 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[3], - n.I = corr_H3[, ncol(corr_H3)]^2, - alpha = alpha * w_H13[2], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans_new <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H1, H3", - `H1 p-value boundary` = pval_H1, - `H2 p-value boundary` = NA, - `H3 p-value boundary` = pval_H3 -) -ans_new %>% gt() -ans <- rbind(ans, ans_new) - -## ----------------------------------------------------------------------------- -w_H23 <- inter_weight %>% filter(is.na(H1), !is.na(H2), !is.na(H3)) -w_H23 <- w_H23[(!is.na(w_H23))] # Remove NA from weight -w_H23 - -## ----------------------------------------------------------------------------- -# -------------# -# H2 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H2", colnames(corr)) -corr_H2 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H2 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[2], - n.I = corr_H2[, ncol(corr_H2)]^2, - alpha = alpha * w_H23[1], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -# -------------# -# H3 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H3", colnames(corr)) -corr_H3 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H3 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[3], - n.I = corr_H3[, ncol(corr_H3)]^2, - alpha = alpha * w_H23[2], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans_new <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H2, H3", - `H1 p-value boundary` = NA, - `H2 p-value boundary` = pval_H2, - `H3 p-value boundary` = pval_H3 -) -ans_new %>% gt() -ans <- rbind(ans, ans_new) - -## ----------------------------------------------------------------------------- -w_H123 <- inter_weight %>% filter(!is.na(H1), !is.na(H2), !is.na(H3)) -w_H123 <- w_H123[(!is.na(w_H123))] # Remove NA from weight -w_H123 - -## ----------------------------------------------------------------------------- -# -------------# -# H1 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H1", colnames(corr)) -corr_H1 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H1 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[1], - n.I = corr_H1[, ncol(corr_H1)]^2, - alpha = alpha * w_H123[1], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -# -------------# -# H2 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H2", colnames(corr)) -corr_H2 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H2 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[2], - n.I = corr_H2[, ncol(corr_H2)]^2, - alpha = alpha * w_H123[1], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -# -------------# -# H3 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H3", colnames(corr)) -corr_H3 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H3 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[3], - n.I = corr_H3[, ncol(corr_H3)]^2, - alpha = alpha * w_H123[3], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans_new <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H1, H2, H3", - `H1 p-value boundary` = pval_H1, - `H2 p-value boundary` = pval_H2, - `H3 p-value boundary` = pval_H3 -) -ans_new %>% gt() -ans <- rbind(ans, ans_new) - -## ----------------------------------------------------------------------------- -ans %>% - mutate( - `H1 Z-statistics boundary` = -qnorm(`H1 p-value boundary`), - `H1 Z-statistics boundary` = -qnorm(`H2 p-value boundary`), - `H1 Z-statistics boundary` = -qnorm(`H3 p-value boundary`) - ) %>% - arrange(Analysis, `Interaction/Elementary hypotheses`) %>% - gt() %>% - tab_header("p-values/Z-statistics boundaries of weighted Bonferroni") - -## ----------------------------------------------------------------------------- -generate_bounds( - type = 0, - k = 2, - w = w, - m = m, - corr = corr, - alpha = 0.025, - sf = list(sfHSD, sfHSD, sfHSD), - sfparm = list(-4, -4, -4), - t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1)) -) %>% gt() - diff --git a/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/tech-detail-wb.Rmd b/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/tech-detail-wb.Rmd deleted file mode 100644 index 1eec9cb..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/tech-detail-wb.Rmd +++ /dev/null @@ -1,599 +0,0 @@ ---- -title: "Procedure to compute p-value boundaries by weighted Bonferroni" -author: "Yujie Zhao" -output: - rmarkdown::html_document: - toc: true - toc_float: true - toc_depth: 2 - number_sections: true - highlight: "textmate" - css: "custom.css" - code_fold: hide -vignette: > - %\VignetteEngine{knitr::rmarkdown} - %\VignetteIndexEntry{Procedure to compute p-value boundaries by weighted Bonferroni} ---- - -```{r, message = FALSE, warning = FALSE} -library(tibble) -library(gt) -library(gsDesign) -library(dplyr) -library(wpgsd) -``` - -# Example overview - -In a 2-arm controlled clinical trial example with one primary endpoint, -there are 3 patient populations defined by the status of two biomarkers A and B: - -- biomarker A positive, -- biomarker B positive, -- overall population. - -The 3 primary elementary hypotheses are: - -- $H_1$: the experimental treatment is superior to the control in the biomarker A positive population; -- $H_2$: the experimental treatment is superior to the control in the biomarker B positive population; -- $H_3$: the experimental treatment is superior to the control in the overall population. - -Assume an interim analysis and a final analysis are planned for the study and the number of events are listed as - -```{r} -k <- 2 # Number of total analysis -n_hypotheses <- 3 # Number of hypotheses -``` - -## Observed p-values - -```{r} -obs_tbl <- tribble( - ~hypothesis, ~analysis, ~obs_p, - "H1", 1, 0.02, - "H2", 1, 0.01, - "H3", 1, 0.006, - "H1", 2, 0.015, - "H2", 2, 0.012, - "H3", 2, 0.004 -) %>% - mutate(obs_Z = -qnorm(obs_p)) - -obs_tbl %>% - gt() %>% - tab_header(title = "Nominal p-values") - -p_obs_IA <- (obs_tbl %>% filter(analysis == 1))$obs_p -p_obs_FA <- (obs_tbl %>% filter(analysis == 2))$obs_p -``` - -## Information fraction - -```{r} -alpha <- 0.025 -event_tbl <- tribble( - ~population, ~analysis, ~event, - "A positive", 1, 80, - "B positive", 1, 88, - "AB positive", 1, 64, - "overall", 1, 180, - "A positive", 2, 160, - "B positive", 2, 176, - "AB positive", 2, 128, - "overall", 2, 360, -) -``` - -The information fraction of $H_1$, $H_2$, $H_3$ at IA is - -```{r} -IF_IA <- c( - ((event_tbl %>% filter(analysis == 1, population == "A positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "A positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event), - ((event_tbl %>% filter(analysis == 1, population == "B positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "B positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event), - ((event_tbl %>% filter(analysis == 1, population == "AB positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "AB positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event) -) - -IF_IA -``` - -## Initial weight and transition matrix - -We assign the initial weights of $H_1$, $H_2$, $H_3$ as -$\left(w_1(I), w_2(I), w_3(I) \right) = (0.3, 0.3, 0.4).$ -And its multiplicity strategy is visualized in below. -If $H_1$ is rejected, then $3/7$ local significance level $\alpha_1$ will be -propagated to $H_2$, and $4/7$ will go to $H_3$. If $H_3$ is rejected, -then half of $\alpha_3$ goes to $H_1$, and half goes to $H_2$. - -```{r} -m <- matrix(c( # Transition matrix - 0, 3 / 7, 4 / 7, - 3 / 7, 0, 4 / 7, - 1 / 2, 1 / 2, 0 -), nrow = 3, byrow = TRUE) - -w <- c(0.3, 0.3, 0.4) # Initial weights -``` - -```{r} -name_hypotheses <- c( - "H1: Biomarker A positive", - "H2: Biomarker B positive", - "H3: Overall Population" -) - -hplot <- gMCPLite::hGraph( - 3, - alphaHypotheses = w, m = m, - nameHypotheses = name_hypotheses, trhw = .2, trhh = .1, - digits = 5, trdigits = 3, size = 5, halfWid = 1, halfHgt = 0.5, - offset = 0.2, trprop = 0.4, - fill = as.factor(c(2, 3, 1)), - palette = c("#BDBDBD", "#E0E0E0", "#EEEEEE"), - wchar = "w" -) -hplot -``` - -```{r} -# Get weights for all intersection hypotheses -graph <- gMCPLite::matrix2graph(m) -graph <- gMCPLite::setWeights(graph, w) -``` - -```{r} -# Set up hypothetical p-values (0 or 1) to obtain all combinations -pvals <- NULL -for (i in 1:n_hypotheses) { - if (i == 1) { - pvals <- data.frame(x = c(0, 1)) - names(pvals) <- paste("pval_H", i, sep = "") - } else { - tmp <- data.frame(x = c(0, 1)) - names(tmp) <- paste("pval_H", i, sep = "") - pvals <- merge(pvals, tmp) - } -} -# Get the weights for each intersection hypothesis -inter_weight <- NULL # Create an empty table to store the weight of interaction hypotheses -for (i in seq_len(nrow(pvals))) { # Each row in `pvals` is 1 possible interaction hypothesis - pval_tmp <- as.numeric(pvals[i, ]) - graph_tmp <- gMCPLite::gMCP(graph = graph, pvalues = pval_tmp, alpha = alpha) - weight_tmp <- gMCPLite::getWeights(graph_tmp) - inter_weight <- dplyr::bind_rows(inter_weight, weight_tmp) -} - -inter_weight <- replace(inter_weight, pvals == 0, NA) # Replace the empty hypothesis as NA -inter_weight <- inter_weight[-1, ] # Delete the first row since it is empty set - -inter_weight %>% - gt() %>% - tab_header("Weight of all possible interaction hypothesis") -``` - -## Correlations - -The correlation of the 6 statistic (2 analyses $\times$ 3 hypotheses) are - -```{r} -# Event count of intersection of paired hypotheses - Table 2 -# H1, H2: Hypotheses intersected. -# (1, 1) represents counts for hypothesis 1 -# (1, 2) for counts for the intersection of hypotheses 1 and 2 -event <- tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, event_tbl %>% filter(analysis == 1, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 2, 1, event_tbl %>% filter(analysis == 1, population == "B positive") %>% select(event) %>% as.numeric(), - 3, 3, 1, event_tbl %>% filter(analysis == 1, population == "overall") %>% select(event) %>% as.numeric(), - 1, 2, 1, event_tbl %>% filter(analysis == 1, population == "AB positive") %>% select(event) %>% as.numeric(), - 1, 3, 1, event_tbl %>% filter(analysis == 1, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 3, 1, event_tbl %>% filter(analysis == 1, population == "B positive") %>% select(event) %>% as.numeric(), - 1, 1, 2, event_tbl %>% filter(analysis == 2, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 2, 2, event_tbl %>% filter(analysis == 2, population == "B positive") %>% select(event) %>% as.numeric(), - 3, 3, 2, event_tbl %>% filter(analysis == 2, population == "overall") %>% select(event) %>% as.numeric(), - 1, 2, 2, event_tbl %>% filter(analysis == 2, population == "AB positive") %>% select(event) %>% as.numeric(), - 1, 3, 2, event_tbl %>% filter(analysis == 2, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 3, 2, event_tbl %>% filter(analysis == 2, population == "B positive") %>% select(event) %>% as.numeric() -) -event - -# Generate correlation from events -corr <- wpgsd::generate_corr(event) -corr %>% round(2) -``` - -# Boundary calculation - -## Boundary of $H_1$ - -For the elementary hypothesis $H_1$, its weight is 1, namely, - -```{r} -w_H1 <- 1 - -# Index to select from the correlation matrix -indx <- grep("H1", colnames(corr)) -corr_H1 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H1 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[1], - n.I = corr_H1[, ncol(corr_H1)]^2, - alpha = alpha * w_H1[1], - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H1", - `H1 p-value boundary` = pval_H1, - `H2 p-value boundary` = NA, - `H3 p-value boundary` = NA -) -ans %>% gt() -``` - -## Boundary of $H_2$ - -For the elementary hypothesis $H_2$, its weight is 1, namely, - -```{r} -w_H2 <- 1 - -# Index to select from the correlation matrix -indx <- grep("H2", colnames(corr)) -corr_H2 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H2 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[2], - n.I = corr_H2[, ncol(corr_H2)]^2, - alpha = alpha * w_H2[1], - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans_new <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H2", - `H1 p-value boundary` = NA, - `H2 p-value boundary` = pval_H2, - `H3 p-value boundary` = NA -) -ans_new %>% gt() -ans <- rbind(ans, ans_new) -``` - -## Boundary of $H_3$ - -For the elementary hypothesis $H_3$, its weight is 1, namely, - -```{r} -w_H3 <- 1 - -# Index to select from the correlation matrix -indx <- grep("H3", colnames(corr)) -corr_H3 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H3 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[3], - n.I = corr_H3[, ncol(corr_H3)]^2, - alpha = alpha * w_H3[1], - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans_new <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H3", - `H1 p-value boundary` = NA, - `H2 p-value boundary` = NA, - `H3 p-value boundary` = pval_H1 -) -ans_new %>% gt() -ans <- rbind(ans, ans_new) -``` - -## Boundary of $H_1 \cap H_2$ - -For the interaction hypothesis $H_1 \cap H_2$, its weight is - -```{r} -w_H12 <- inter_weight %>% filter(!is.na(H1), !is.na(H2), is.na(H3)) -w_H12 <- w_H12[(!is.na(w_H12))] # Remove NA from weight -w_H12 -``` - -And the boundary for $H_1$ and $H_2$ are - -```{r} -# -------------# -# H1 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H1", colnames(corr)) -corr_H1 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H1 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[1], - n.I = corr_H1[, ncol(corr_H1)]^2, - alpha = alpha * w_H12[1], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -# -------------# -# H2 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H2", colnames(corr)) -corr_H2 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H2 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[2], - n.I = corr_H2[, ncol(corr_H2)]^2, - alpha = alpha * w_H12[2], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans_new <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H1, H2", - `H1 p-value boundary` = pval_H1, - `H2 p-value boundary` = pval_H2, - `H3 p-value boundary` = NA -) -ans_new %>% gt() -ans <- rbind(ans, ans_new) -``` - -## Boundary of $H_1 \cap H_3$ - -For the interaction hypothesis $H_1 \cap H_2$, its weight is - -```{r} -w_H13 <- inter_weight %>% filter(!is.na(H1), is.na(H2), !is.na(H3)) -w_H13 <- w_H13[(!is.na(w_H13))] # Remove NA from weight -w_H13 -``` - -And the boundary for $H_1$ and $H_3$ are - -```{r} -# -------------# -# H1 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H1", colnames(corr)) -corr_H1 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H1 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[1], - n.I = corr_H1[, ncol(corr_H1)]^2, - alpha = alpha * w_H13[1], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -# -------------# -# H3 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H3", colnames(corr)) -corr_H3 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H3 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[3], - n.I = corr_H3[, ncol(corr_H3)]^2, - alpha = alpha * w_H13[2], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans_new <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H1, H3", - `H1 p-value boundary` = pval_H1, - `H2 p-value boundary` = NA, - `H3 p-value boundary` = pval_H3 -) -ans_new %>% gt() -ans <- rbind(ans, ans_new) -``` - -## Boundary of $H_2 \cap H_3$ - -For the interaction hypothesis $H_2 \cap H_3$, its weight is - -```{r} -w_H23 <- inter_weight %>% filter(is.na(H1), !is.na(H2), !is.na(H3)) -w_H23 <- w_H23[(!is.na(w_H23))] # Remove NA from weight -w_H23 -``` - -And the boundary for $H_2$ and $H_3$ are - -```{r} -# -------------# -# H2 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H2", colnames(corr)) -corr_H2 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H2 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[2], - n.I = corr_H2[, ncol(corr_H2)]^2, - alpha = alpha * w_H23[1], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -# -------------# -# H3 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H3", colnames(corr)) -corr_H3 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H3 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[3], - n.I = corr_H3[, ncol(corr_H3)]^2, - alpha = alpha * w_H23[2], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans_new <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H2, H3", - `H1 p-value boundary` = NA, - `H2 p-value boundary` = pval_H2, - `H3 p-value boundary` = pval_H3 -) -ans_new %>% gt() -ans <- rbind(ans, ans_new) -``` - -## Boundary of $H1 \cap H_2 \cap H_3$ - -For the interaction hypothesis $H_1 \cap H_2$, its weight is - -```{r} -w_H123 <- inter_weight %>% filter(!is.na(H1), !is.na(H2), !is.na(H3)) -w_H123 <- w_H123[(!is.na(w_H123))] # Remove NA from weight -w_H123 -``` - -And the boundary for $H_1$, $H_2$, and $H_3$ are - -```{r} -# -------------# -# H1 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H1", colnames(corr)) -corr_H1 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H1 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[1], - n.I = corr_H1[, ncol(corr_H1)]^2, - alpha = alpha * w_H123[1], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -# -------------# -# H2 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H2", colnames(corr)) -corr_H2 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H2 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[2], - n.I = corr_H2[, ncol(corr_H2)]^2, - alpha = alpha * w_H123[1], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -# -------------# -# H3 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H3", colnames(corr)) -corr_H3 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H3 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[3], - n.I = corr_H3[, ncol(corr_H3)]^2, - alpha = alpha * w_H123[3], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans_new <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H1, H2, H3", - `H1 p-value boundary` = pval_H1, - `H2 p-value boundary` = pval_H2, - `H3 p-value boundary` = pval_H3 -) -ans_new %>% gt() -ans <- rbind(ans, ans_new) -``` - -# Summary - -With the p-value boundaries, one can get the Z-statistics boundaries by `qnorm()`. - -```{r} -ans %>% - mutate( - `H1 Z-statistics boundary` = -qnorm(`H1 p-value boundary`), - `H1 Z-statistics boundary` = -qnorm(`H2 p-value boundary`), - `H1 Z-statistics boundary` = -qnorm(`H3 p-value boundary`) - ) %>% - arrange(Analysis, `Interaction/Elementary hypotheses`) %>% - gt() %>% - tab_header("p-values/Z-statistics boundaries of weighted Bonferroni") -``` - -# Implementation in wpgsd - -The above results can be computed in one function call in wpgsd by using -the `generate_bounds()` function as - -```{r} -generate_bounds( - type = 0, - k = 2, - w = w, - m = m, - corr = corr, - alpha = 0.025, - sf = list(sfHSD, sfHSD, sfHSD), - sfparm = list(-4, -4, -4), - t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1)) -) %>% gt() -``` diff --git a/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/tech-detail-wb.html b/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/tech-detail-wb.html deleted file mode 100644 index 63b3a07..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/tech-detail-wb.html +++ /dev/null @@ -1,7117 +0,0 @@ - - - - - - - - - - - - - - -Procedure to compute p-value boundaries by weighted Bonferroni - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- - - -
-
-
-
-
- -
- - - - - - - -
library(tibble)
-library(gt)
-library(gsDesign)
-library(dplyr)
-library(wpgsd)
-
-

1 Example overview

-

In a 2-arm controlled clinical trial example with one primary -endpoint, there are 3 patient populations defined by the status of two -biomarkers A and B:

-
    -
  • biomarker A positive,
  • -
  • biomarker B positive,
  • -
  • overall population.
  • -
-

The 3 primary elementary hypotheses are:

-
    -
  • \(H_1\): the experimental treatment -is superior to the control in the biomarker A positive population;
  • -
  • \(H_2\): the experimental treatment -is superior to the control in the biomarker B positive population;
  • -
  • \(H_3\): the experimental treatment -is superior to the control in the overall population.
  • -
-

Assume an interim analysis and a final analysis are planned for the -study and the number of events are listed as

-
k <- 2 # Number of total analysis
-n_hypotheses <- 3 # Number of hypotheses
-
-

1.1 Observed -p-values

-
obs_tbl <- tribble(
-  ~hypothesis, ~analysis, ~obs_p,
-  "H1", 1, 0.02,
-  "H2", 1, 0.01,
-  "H3", 1, 0.006,
-  "H1", 2, 0.015,
-  "H2", 2, 0.012,
-  "H3", 2, 0.004
-) %>%
-  mutate(obs_Z = -qnorm(obs_p))
-
-obs_tbl %>%
-  gt() %>%
-  tab_header(title = "Nominal p-values")
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Nominal p-values
hypothesisanalysisobs_pobs_Z
H110.0202.053749
H210.0102.326348
H310.0062.512144
H120.0152.170090
H220.0122.257129
H320.0042.652070
-
-
p_obs_IA <- (obs_tbl %>% filter(analysis == 1))$obs_p
-p_obs_FA <- (obs_tbl %>% filter(analysis == 2))$obs_p
-
-
-

1.2 Information -fraction

-
alpha <- 0.025
-event_tbl <- tribble(
-  ~population, ~analysis, ~event,
-  "A positive", 1, 80,
-  "B positive", 1, 88,
-  "AB positive", 1, 64,
-  "overall", 1, 180,
-  "A positive", 2, 160,
-  "B positive", 2, 176,
-  "AB positive", 2, 128,
-  "overall", 2, 360,
-)
-

The information fraction of \(H_1\), -\(H_2\), \(H_3\) at IA is

-
IF_IA <- c(
-  ((event_tbl %>% filter(analysis == 1, population == "A positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) /
-    ((event_tbl %>% filter(analysis == 2, population == "A positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event),
-  ((event_tbl %>% filter(analysis == 1, population == "B positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) /
-    ((event_tbl %>% filter(analysis == 2, population == "B positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event),
-  ((event_tbl %>% filter(analysis == 1, population == "AB positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) /
-    ((event_tbl %>% filter(analysis == 2, population == "AB positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event)
-)
-
-IF_IA
-
## [1] 0.5 0.5 0.5
-
-
-

1.3 Initial weight and -transition matrix

-

We assign the initial weights of \(H_1\), \(H_2\), \(H_3\) as \(\left(w_1(I), w_2(I), w_3(I) \right) = (0.3, 0.3, -0.4).\) And its multiplicity strategy is visualized in below. If -\(H_1\) is rejected, then \(3/7\) local significance level \(\alpha_1\) will be propagated to \(H_2\), and \(4/7\) will go to \(H_3\). If \(H_3\) is rejected, then half of \(\alpha_3\) goes to \(H_1\), and half goes to \(H_2\).

-
m <- matrix(c( # Transition matrix
-  0, 3 / 7, 4 / 7,
-  3 / 7, 0, 4 / 7,
-  1 / 2, 1 / 2, 0
-), nrow = 3, byrow = TRUE)
-
-w <- c(0.3, 0.3, 0.4) # Initial weights
-
name_hypotheses <- c(
-  "H1: Biomarker A positive",
-  "H2: Biomarker B positive",
-  "H3: Overall Population"
-)
-
-hplot <- gMCPLite::hGraph(
-  3,
-  alphaHypotheses = w, m = m,
-  nameHypotheses = name_hypotheses, trhw = .2, trhh = .1,
-  digits = 5, trdigits = 3, size = 5, halfWid = 1, halfHgt = 0.5,
-  offset = 0.2, trprop = 0.4,
-  fill = as.factor(c(2, 3, 1)),
-  palette = c("#BDBDBD", "#E0E0E0", "#EEEEEE"),
-  wchar = "w"
-)
-hplot
-

-
# Get weights for all intersection hypotheses
-graph <- gMCPLite::matrix2graph(m)
-graph <- gMCPLite::setWeights(graph, w)
-
# Set up hypothetical p-values (0 or 1) to obtain all combinations
-pvals <- NULL
-for (i in 1:n_hypotheses) {
-  if (i == 1) {
-    pvals <- data.frame(x = c(0, 1))
-    names(pvals) <- paste("pval_H", i, sep = "")
-  } else {
-    tmp <- data.frame(x = c(0, 1))
-    names(tmp) <- paste("pval_H", i, sep = "")
-    pvals <- merge(pvals, tmp)
-  }
-}
-# Get the weights for each intersection hypothesis
-inter_weight <- NULL # Create an empty table to store the weight of interaction hypotheses
-for (i in seq_len(nrow(pvals))) { # Each row in `pvals` is 1 possible interaction hypothesis
-  pval_tmp <- as.numeric(pvals[i, ])
-  graph_tmp <- gMCPLite::gMCP(graph = graph, pvalues = pval_tmp, alpha = alpha)
-  weight_tmp <- gMCPLite::getWeights(graph_tmp)
-  inter_weight <- dplyr::bind_rows(inter_weight, weight_tmp)
-}
-
-inter_weight <- replace(inter_weight, pvals == 0, NA) # Replace the empty hypothesis as NA
-inter_weight <- inter_weight[-1, ] # Delete the first row since it is empty set
-
-inter_weight %>%
-  gt() %>%
-  tab_header("Weight of all possible interaction hypothesis")
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Weight of all possible interaction hypothesis
H1H2H3
1.0000000NANA
NA1.0000000NA
0.50000000.5000000NA
NANA1.0000000
0.4285714NA0.5714286
NA0.42857140.5714286
0.30000000.30000000.4000000
-
-
-
-

1.4 Correlations

-

The correlation of the 6 statistic (2 analyses \(\times\) 3 hypotheses) are

-
# Event count of intersection of paired hypotheses - Table 2
-# H1, H2: Hypotheses intersected.
-# (1, 1) represents counts for hypothesis 1
-# (1, 2) for counts for the intersection of hypotheses 1 and 2
-event <- tribble(
-  ~H1, ~H2, ~Analysis, ~Event,
-  1, 1, 1, event_tbl %>% filter(analysis == 1, population == "A positive") %>% select(event) %>% as.numeric(),
-  2, 2, 1, event_tbl %>% filter(analysis == 1, population == "B positive") %>% select(event) %>% as.numeric(),
-  3, 3, 1, event_tbl %>% filter(analysis == 1, population == "overall") %>% select(event) %>% as.numeric(),
-  1, 2, 1, event_tbl %>% filter(analysis == 1, population == "AB positive") %>% select(event) %>% as.numeric(),
-  1, 3, 1, event_tbl %>% filter(analysis == 1, population == "A positive") %>% select(event) %>% as.numeric(),
-  2, 3, 1, event_tbl %>% filter(analysis == 1, population == "B positive") %>% select(event) %>% as.numeric(),
-  1, 1, 2, event_tbl %>% filter(analysis == 2, population == "A positive") %>% select(event) %>% as.numeric(),
-  2, 2, 2, event_tbl %>% filter(analysis == 2, population == "B positive") %>% select(event) %>% as.numeric(),
-  3, 3, 2, event_tbl %>% filter(analysis == 2, population == "overall") %>% select(event) %>% as.numeric(),
-  1, 2, 2, event_tbl %>% filter(analysis == 2, population == "AB positive") %>% select(event) %>% as.numeric(),
-  1, 3, 2, event_tbl %>% filter(analysis == 2, population == "A positive") %>% select(event) %>% as.numeric(),
-  2, 3, 2, event_tbl %>% filter(analysis == 2, population == "B positive") %>% select(event) %>% as.numeric()
-)
-event
-
## # A tibble: 12 × 4
-##       H1    H2 Analysis Event
-##    <dbl> <dbl>    <dbl> <dbl>
-##  1     1     1        1    80
-##  2     2     2        1    88
-##  3     3     3        1   180
-##  4     1     2        1    64
-##  5     1     3        1    80
-##  6     2     3        1    88
-##  7     1     1        2   160
-##  8     2     2        2   176
-##  9     3     3        2   360
-## 10     1     2        2   128
-## 11     1     3        2   160
-## 12     2     3        2   176
-
# Generate correlation from events
-corr <- wpgsd::generate_corr(event)
-corr %>% round(2)
-
##      H1_A1 H2_A1 H3_A1 H1_A2 H2_A2 H3_A2
-## [1,]  1.00  0.76  0.67  0.71  0.54  0.47
-## [2,]  0.76  1.00  0.70  0.54  0.71  0.49
-## [3,]  0.67  0.70  1.00  0.47  0.49  0.71
-## [4,]  0.71  0.54  0.47  1.00  0.76  0.67
-## [5,]  0.54  0.71  0.49  0.76  1.00  0.70
-## [6,]  0.47  0.49  0.71  0.67  0.70  1.00
-
-
-
-

2 Boundary -calculation

-
-

2.1 Boundary of \(H_1\)

-

For the elementary hypothesis \(H_1\), its weight is 1, namely,

-
w_H1 <- 1
-
-# Index to select from the correlation matrix
-indx <- grep("H1", colnames(corr))
-corr_H1 <- corr[indx, indx]
-
-# Boundary for a single hypothesis across k for the intersection hypothesis
-pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
-  k = k,
-  test.type = 1,
-  usTime = IF_IA[1],
-  n.I = corr_H1[, ncol(corr_H1)]^2,
-  alpha = alpha * w_H1[1],
-  sfu = sfHSD,
-  sfupar = -4
-)$upper$bound)
-
-ans <- tibble(
-  Analysis = 1:2,
-  `Interaction/Elementary hypotheses` = "H1",
-  `H1 p-value boundary` = pval_H1,
-  `H2 p-value boundary` = NA,
-  `H3 p-value boundary` = NA
-)
-ans %>% gt()
-
- - - - - - - - - - - - - - - - - - - - - - - - - -
AnalysisInteraction/Elementary hypothesesH1 p-value boundaryH2 p-value boundaryH3 p-value boundary
1H10.002980073NANA
2H10.023788266NANA
-
-
-
-

2.2 Boundary of \(H_2\)

-

For the elementary hypothesis \(H_2\), its weight is 1, namely,

-
w_H2 <- 1
-
-# Index to select from the correlation matrix
-indx <- grep("H2", colnames(corr))
-corr_H2 <- corr[indx, indx]
-
-# Boundary for a single hypothesis across k for the intersection hypothesis
-pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
-  k = k,
-  test.type = 1,
-  usTime = IF_IA[2],
-  n.I = corr_H2[, ncol(corr_H2)]^2,
-  alpha = alpha * w_H2[1],
-  sfu = sfHSD,
-  sfupar = -4
-)$upper$bound)
-
-ans_new <- tibble(
-  Analysis = 1:2,
-  `Interaction/Elementary hypotheses` = "H2",
-  `H1 p-value boundary` = NA,
-  `H2 p-value boundary` = pval_H2,
-  `H3 p-value boundary` = NA
-)
-ans_new %>% gt()
-
- - - - - - - - - - - - - - - - - - - - - - - - - -
AnalysisInteraction/Elementary hypothesesH1 p-value boundaryH2 p-value boundaryH3 p-value boundary
1H2NA0.002980073NA
2H2NA0.023788266NA
-
-
ans <- rbind(ans, ans_new)
-
-
-

2.3 Boundary of \(H_3\)

-

For the elementary hypothesis \(H_3\), its weight is 1, namely,

-
w_H3 <- 1
-
-# Index to select from the correlation matrix
-indx <- grep("H3", colnames(corr))
-corr_H3 <- corr[indx, indx]
-
-# Boundary for a single hypothesis across k for the intersection hypothesis
-pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
-  k = k,
-  test.type = 1,
-  usTime = IF_IA[3],
-  n.I = corr_H3[, ncol(corr_H3)]^2,
-  alpha = alpha * w_H3[1],
-  sfu = sfHSD,
-  sfupar = -4
-)$upper$bound)
-
-ans_new <- tibble(
-  Analysis = 1:2,
-  `Interaction/Elementary hypotheses` = "H3",
-  `H1 p-value boundary` = NA,
-  `H2 p-value boundary` = NA,
-  `H3 p-value boundary` = pval_H1
-)
-ans_new %>% gt()
-
- - - - - - - - - - - - - - - - - - - - - - - - - -
AnalysisInteraction/Elementary hypothesesH1 p-value boundaryH2 p-value boundaryH3 p-value boundary
1H3NANA0.002980073
2H3NANA0.023788266
-
-
ans <- rbind(ans, ans_new)
-
-
-

2.4 Boundary of \(H_1 \cap H_2\)

-

For the interaction hypothesis \(H_1 \cap -H_2\), its weight is

-
w_H12 <- inter_weight %>% filter(!is.na(H1), !is.na(H2), is.na(H3))
-w_H12 <- w_H12[(!is.na(w_H12))] # Remove NA from weight
-w_H12
-
## [1] 0.5 0.5
-

And the boundary for \(H_1\) and -\(H_2\) are

-
# -------------#
-#      H1      #
-# -------------#
-# Index to select from the correlation matrix
-indx <- grep("H1", colnames(corr))
-corr_H1 <- corr[indx, indx]
-
-# Boundary for a single hypothesis across k for the intersection hypothesis
-pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
-  k = k,
-  test.type = 1,
-  usTime = IF_IA[1],
-  n.I = corr_H1[, ncol(corr_H1)]^2,
-  alpha = alpha * w_H12[1], # alpha is different since the weight is updated
-  sfu = sfHSD,
-  sfupar = -4
-)$upper$bound)
-
-# -------------#
-#      H2      #
-# -------------#
-# Index to select from the correlation matrix
-indx <- grep("H2", colnames(corr))
-corr_H2 <- corr[indx, indx]
-
-# Boundary for a single hypothesis across k for the intersection hypothesis
-pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
-  k = k,
-  test.type = 1,
-  usTime = IF_IA[2],
-  n.I = corr_H2[, ncol(corr_H2)]^2,
-  alpha = alpha * w_H12[2], # alpha is different since the weight is updated
-  sfu = sfHSD,
-  sfupar = -4
-)$upper$bound)
-
-ans_new <- tibble(
-  Analysis = 1:2,
-  `Interaction/Elementary hypotheses` = "H1, H2",
-  `H1 p-value boundary` = pval_H1,
-  `H2 p-value boundary` = pval_H2,
-  `H3 p-value boundary` = NA
-)
-ans_new %>% gt()
-
- - - - - - - - - - - - - - - - - - - - - - - - - -
AnalysisInteraction/Elementary hypothesesH1 p-value boundaryH2 p-value boundaryH3 p-value boundary
1H1, H20.0014900370.001490037NA
2H1, H20.0117828000.011782800NA
-
-
ans <- rbind(ans, ans_new)
-
-
-

2.5 Boundary of \(H_1 \cap H_3\)

-

For the interaction hypothesis \(H_1 \cap -H_2\), its weight is

-
w_H13 <- inter_weight %>% filter(!is.na(H1), is.na(H2), !is.na(H3))
-w_H13 <- w_H13[(!is.na(w_H13))] # Remove NA from weight
-w_H13
-
## [1] 0.4285714 0.5714286
-

And the boundary for \(H_1\) and -\(H_3\) are

-
# -------------#
-#      H1      #
-# -------------#
-# Index to select from the correlation matrix
-indx <- grep("H1", colnames(corr))
-corr_H1 <- corr[indx, indx]
-
-# Boundary for a single hypothesis across k for the intersection hypothesis
-pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
-  k = k,
-  test.type = 1,
-  usTime = IF_IA[1],
-  n.I = corr_H1[, ncol(corr_H1)]^2,
-  alpha = alpha * w_H13[1], # alpha is different since the weight is updated
-  sfu = sfHSD,
-  sfupar = -4
-)$upper$bound)
-
-# -------------#
-#      H3      #
-# -------------#
-# Index to select from the correlation matrix
-indx <- grep("H3", colnames(corr))
-corr_H3 <- corr[indx, indx]
-
-# Boundary for a single hypothesis across k for the intersection hypothesis
-pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
-  k = k,
-  test.type = 1,
-  usTime = IF_IA[3],
-  n.I = corr_H3[, ncol(corr_H3)]^2,
-  alpha = alpha * w_H13[2], # alpha is different since the weight is updated
-  sfu = sfHSD,
-  sfupar = -4
-)$upper$bound)
-
-ans_new <- tibble(
-  Analysis = 1:2,
-  `Interaction/Elementary hypotheses` = "H1, H3",
-  `H1 p-value boundary` = pval_H1,
-  `H2 p-value boundary` = NA,
-  `H3 p-value boundary` = pval_H3
-)
-ans_new %>% gt()
-
- - - - - - - - - - - - - - - - - - - - - - - - - -
AnalysisInteraction/Elementary hypothesesH1 p-value boundaryH2 p-value boundaryH3 p-value boundary
1H1, H30.001277174NA0.001702899
2H1, H30.010079863NA0.013489389
-
-
ans <- rbind(ans, ans_new)
-
-
-

2.6 Boundary of \(H_2 \cap H_3\)

-

For the interaction hypothesis \(H_2 \cap -H_3\), its weight is

-
w_H23 <- inter_weight %>% filter(is.na(H1), !is.na(H2), !is.na(H3))
-w_H23 <- w_H23[(!is.na(w_H23))] # Remove NA from weight
-w_H23
-
## [1] 0.4285714 0.5714286
-

And the boundary for \(H_2\) and -\(H_3\) are

-
# -------------#
-#      H2      #
-# -------------#
-# Index to select from the correlation matrix
-indx <- grep("H2", colnames(corr))
-corr_H2 <- corr[indx, indx]
-
-# Boundary for a single hypothesis across k for the intersection hypothesis
-pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
-  k = k,
-  test.type = 1,
-  usTime = IF_IA[2],
-  n.I = corr_H2[, ncol(corr_H2)]^2,
-  alpha = alpha * w_H23[1], # alpha is different since the weight is updated
-  sfu = sfHSD,
-  sfupar = -4
-)$upper$bound)
-
-# -------------#
-#      H3      #
-# -------------#
-# Index to select from the correlation matrix
-indx <- grep("H3", colnames(corr))
-corr_H3 <- corr[indx, indx]
-
-# Boundary for a single hypothesis across k for the intersection hypothesis
-pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
-  k = k,
-  test.type = 1,
-  usTime = IF_IA[3],
-  n.I = corr_H3[, ncol(corr_H3)]^2,
-  alpha = alpha * w_H23[2], # alpha is different since the weight is updated
-  sfu = sfHSD,
-  sfupar = -4
-)$upper$bound)
-
-ans_new <- tibble(
-  Analysis = 1:2,
-  `Interaction/Elementary hypotheses` = "H2, H3",
-  `H1 p-value boundary` = NA,
-  `H2 p-value boundary` = pval_H2,
-  `H3 p-value boundary` = pval_H3
-)
-ans_new %>% gt()
-
- - - - - - - - - - - - - - - - - - - - - - - - - -
AnalysisInteraction/Elementary hypothesesH1 p-value boundaryH2 p-value boundaryH3 p-value boundary
1H2, H3NA0.0012771740.001702899
2H2, H3NA0.0100798630.013489389
-
-
ans <- rbind(ans, ans_new)
-
-
-

2.7 Boundary of \(H1 \cap H_2 \cap H_3\)

-

For the interaction hypothesis \(H_1 \cap -H_2\), its weight is

-
w_H123 <- inter_weight %>% filter(!is.na(H1), !is.na(H2), !is.na(H3))
-w_H123 <- w_H123[(!is.na(w_H123))] # Remove NA from weight
-w_H123
-
## [1] 0.3 0.3 0.4
-

And the boundary for \(H_1\), \(H_2\), and \(H_3\) are

-
# -------------#
-#      H1      #
-# -------------#
-# Index to select from the correlation matrix
-indx <- grep("H1", colnames(corr))
-corr_H1 <- corr[indx, indx]
-
-# Boundary for a single hypothesis across k for the intersection hypothesis
-pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
-  k = k,
-  test.type = 1,
-  usTime = IF_IA[1],
-  n.I = corr_H1[, ncol(corr_H1)]^2,
-  alpha = alpha * w_H123[1], # alpha is different since the weight is updated
-  sfu = sfHSD,
-  sfupar = -4
-)$upper$bound)
-
-# -------------#
-#      H2      #
-# -------------#
-# Index to select from the correlation matrix
-indx <- grep("H2", colnames(corr))
-corr_H2 <- corr[indx, indx]
-
-# Boundary for a single hypothesis across k for the intersection hypothesis
-pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
-  k = k,
-  test.type = 1,
-  usTime = IF_IA[2],
-  n.I = corr_H2[, ncol(corr_H2)]^2,
-  alpha = alpha * w_H123[1], # alpha is different since the weight is updated
-  sfu = sfHSD,
-  sfupar = -4
-)$upper$bound)
-
-# -------------#
-#      H3      #
-# -------------#
-# Index to select from the correlation matrix
-indx <- grep("H3", colnames(corr))
-corr_H3 <- corr[indx, indx]
-
-# Boundary for a single hypothesis across k for the intersection hypothesis
-pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
-  k = k,
-  test.type = 1,
-  usTime = IF_IA[3],
-  n.I = corr_H3[, ncol(corr_H3)]^2,
-  alpha = alpha * w_H123[3], # alpha is different since the weight is updated
-  sfu = sfHSD,
-  sfupar = -4
-)$upper$bound)
-
-ans_new <- tibble(
-  Analysis = 1:2,
-  `Interaction/Elementary hypotheses` = "H1, H2, H3",
-  `H1 p-value boundary` = pval_H1,
-  `H2 p-value boundary` = pval_H2,
-  `H3 p-value boundary` = pval_H3
-)
-ans_new %>% gt()
-
- - - - - - - - - - - - - - - - - - - - - - - - - -
AnalysisInteraction/Elementary hypothesesH1 p-value boundaryH2 p-value boundaryH3 p-value boundary
1H1, H2, H30.00089402190.00089402190.001192029
2H1, H2, H30.00702549790.00702549790.009399818
-
-
ans <- rbind(ans, ans_new)
-
-
-
-

3 Summary

-

With the p-value boundaries, one can get the Z-statistics boundaries -by qnorm().

-
ans %>%
-  mutate(
-    `H1 Z-statistics boundary` = -qnorm(`H1 p-value boundary`),
-    `H1 Z-statistics boundary` = -qnorm(`H2 p-value boundary`),
-    `H1 Z-statistics boundary` = -qnorm(`H3 p-value boundary`)
-  ) %>%
-  arrange(Analysis, `Interaction/Elementary hypotheses`) %>%
-  gt() %>%
-  tab_header("p-values/Z-statistics boundaries of weighted Bonferroni")
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
p-values/Z-statistics boundaries of weighted Bonferroni
AnalysisInteraction/Elementary hypothesesH1 p-value boundaryH2 p-value boundaryH3 p-value boundaryH1 Z-statistics boundary
1H10.0029800731NANANA
1H1, H20.00149003650.0014900365NANA
1H1, H2, H30.00089402190.00089402190.0011920293.037681
1H1, H30.0012771742NA0.0017028992.928520
1H2NA0.0029800731NANA
1H2, H3NA0.00127717420.0017028992.928520
1H3NANA0.0029800732.749966
2H10.0237882657NANANA
2H1, H20.01178280030.0117828003NANA
2H1, H2, H30.00702549790.00702549790.0093998182.349480
2H1, H30.0100798631NA0.0134893892.211825
2H2NA0.0237882657NANA
2H2, H3NA0.01007986310.0134893892.211825
2H3NANA0.0237882661.981131
-
-
-
-

4 Implementation in -wpgsd

-

The above results can be computed in one function call in wpgsd by -using the generate_bounds() function as

-
generate_bounds(
-  type = 0,
-  k = 2,
-  w = w,
-  m = m,
-  corr = corr,
-  alpha = 0.025,
-  sf = list(sfHSD, sfHSD, sfHSD),
-  sfparm = list(-4, -4, -4),
-  t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1))
-) %>% gt()
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
AnalysisHypothesesH1H2H3
1H10.0029800731NANA
1H1, H20.00149003650.0014900365NA
1H1, H2, H30.00089402190.00089402190.001192029
1H1, H30.0012771742NA0.001702899
1H2NA0.0029800731NA
1H2, H3NA0.00127717420.001702899
1H3NANA0.002980073
2H10.0237882657NANA
2H1, H20.01178280030.0117828003NA
2H1, H2, H30.00702549790.00702549790.009399818
2H1, H30.0100798631NA0.013489389
2H2NA0.0237882657NA
2H2, H3NA0.01007986310.013489389
2H3NANA0.023788266
-
-
- - - -
-
- -
- - - - - - - - - - - - - - - - - diff --git a/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/wpgsd.R b/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/wpgsd.R deleted file mode 100644 index 8aea00b..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/wpgsd.R +++ /dev/null @@ -1,335 +0,0 @@ -## ----include = FALSE---------------------------------------------------------- -knitr::opts_chunk$set( - collapse = TRUE, - comment = "#>", - error = TRUE, - fig.align = "center" -) - -## ----message=FALSE, warning=FALSE--------------------------------------------- -library(wpgsd) -library(gsDesign) -library(gMCPLite) -library(haven) -library(dplyr) -library(tidyr) -library(reshape2) -library(gt) - -## ----eval=FALSE, echo=FALSE--------------------------------------------------- -# library(ggplot2) -# library(ggforce) -# -# ellipse_data <- data.frame( -# id = c("H1: Population 1", "H2: Population 2", "H3: Overall Population"), -# x = c(0, 1, 0.5), -# y = c(0, 0, 0), -# a = c(1, 1, 2), -# b = c(0.5, 0.5, 1) -# ) -# -# ragg::agg_png( -# "vignettes/figures/ex1-pop.png", -# width = 1920, -# height = 1920 / 1.618, -# res = 96, -# scaling = 2 -# ) -# ggplot() + -# geom_ellipse( -# aes( -# x0 = x, y0 = y, a = a, b = b, angle = 0, fill = id -# ), -# data = ellipse_data[ellipse_data$id == "H3: Overall Population", ], -# color = NA, alpha = 0.5, show.legend = FALSE -# ) + -# geom_ellipse( -# aes( -# x0 = x, y0 = y, a = a, b = b, angle = 0, fill = id -# ), -# data = ellipse_data[ellipse_data$id != "H3: Overall Population", ], -# color = NA, alpha = 0.85, show.legend = FALSE -# ) + -# geom_text(aes( -# x = x, y = y, label = id, -# hjust = ifelse(id == "H1: Population 1", 1.1, -# ifelse(id == "H2: Population 2", -0.1, 0.5) -# ), -# vjust = ifelse(id == "H3: Overall Population", -9, 0.5) -# ), data = ellipse_data, size = 6) + -# scale_fill_manual(values = c("#E69F00", "#56B4E9", "#999999"), guide = "none") + -# coord_fixed() + -# theme_void() -# dev.off() - -## ----echo=FALSE, out.width="90%", fig.cap="Ex1: Populations"------------------ -knitr::include_graphics("figures/ex1-pop.png") - -## ----out.width="80%"---------------------------------------------------------- -# Transition matrix -m <- matrix(c( - 0, 0, 1, - 0, 0, 1, - 0.5, 0.5, 0 -), nrow = 3, byrow = TRUE) -# Weight matrix -w <- c(0.3, 0.3, 0.4) - -# Multiplicity graph -cbPalette <- c("#999999", "#E69F00", "#56B4E9") - -nameHypotheses <- c( - "H1: Population 1", - "H2: Population 2", - "H3: Overall Population" -) - -hplot <- hGraph(3, - alphaHypotheses = w, - m = m, - nameHypotheses = nameHypotheses, - trhw = .2, trhh = .1, - digits = 5, trdigits = 3, size = 5, halfWid = 1, - halfHgt = 0.5, offset = 0.2, trprop = 0.4, - fill = as.factor(c(2, 3, 1)), - palette = cbPalette, - wchar = "w" -) -hplot - -## ----out.width="80%", echo = FALSE-------------------------------------------- -cbPalette <- c( - "#999999", "#E69F00", "#56B4E9", "#009E73", - "#F0E442", "#0072B2", "#D55E00", "#CC79A7" -) -nameHypotheses <- c( - "H1: Experimental 1 vs Control", - "H2: Experimental 2 vs Control", - "H3: Experimental 3 vs Control" -) -m <- matrix(c( - 0, 0.5, 0.5, - 0.5, 0, 0.5, - 0.5, 0.5, 0 -), nrow = 3, byrow = TRUE) -alphaHypotheses <- c(1 / 3, 1 / 3, 1 / 3) - -hplot <- hGraph(3, - alphaHypotheses = alphaHypotheses, m = m, - nameHypotheses = nameHypotheses, trhw = .2, trhh = .1, - digits = 3, trdigits = 4, size = 5, halfWid = 1.2, halfHgt = 0.5, - offset = 0.2, trprop = 0.35, - fill = as.factor(c(2, 3, 1)), - palette = cbPalette[1:3], - wchar = "w" -) -hplot - -## ----------------------------------------------------------------------------- -event <- tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 100, - 2, 2, 1, 110, - 3, 3, 1, 225, - 1, 2, 1, 80, - 1, 3, 1, 100, - 2, 3, 1, 110, - 1, 1, 2, 200, - 2, 2, 2, 220, - 3, 3, 2, 450, - 1, 2, 2, 160, - 1, 3, 2, 200, - 2, 3, 2, 220 -) -event %>% - gt() %>% - tab_header(title = "Event Count") - -## ----------------------------------------------------------------------------- -# Alternatively, one can manually enter paths for analysis datasets, -# example below uses an example dataset assuming currently we are at IA1. -paths <- system.file("extdata/", package = "wpgsd") - -### Generate event count table from ADSL and ADTTE datasets -# Selection criteria for each hypothesis -h_select <- tribble( - ~Hypothesis, ~Crit, - 1, "PARAMCD=='OS' & TRT01P %in% c('Xanomeline High Dose', 'Placebo')", - 2, "PARAMCD=='OS' & TRT01P %in% c('Xanomeline Low Dose', 'Placebo')" -) - -event2 <- generate_event_table(paths, h_select, - adsl_name = "adsl", adtte_name = "adtte", - key_var = "USUBJID", cnsr_var = "CNSR" -)$event - -event2 %>% - gt() %>% - tab_header(title = "Event Count - Computed from SAS Datasets Example") - -## ----------------------------------------------------------------------------- -## Generate correlation from events -corr <- generate_corr(event) - -corr %>% - as_tibble() %>% - gt() %>% - fmt_number(columns = everything(), decimals = 2) %>% - tab_header(title = "Correlation Matrix") - -## ----------------------------------------------------------------------------- -# Bonferroni bounds -bound_Bonf <- generate_bounds( - type = 0, k = 2, w = w, m = m, - corr = corr, alpha = 0.025, - sf = list(sfHSD, sfHSD, sfHSD), - sfparm = list(-4, -4, -4), - t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1)) -) - -bound_Bonf %>% - gt() %>% - fmt_number(columns = 3:5, decimals = 4) %>% - tab_header(title = "Bonferroni bounds") - -## ----------------------------------------------------------------------------- -set.seed(1234) -# WPGSD bounds, spending approach 1 -bound_WPGSD <- generate_bounds( - type = 2, k = 2, w = w, m = m, - corr = corr, alpha = 0.025, - sf = sfHSD, - sfparm = -4, - t = c(min(100 / 200, 110 / 220, 225 / 450), 1) -) - -bound_WPGSD %>% - gt() %>% - fmt_number(columns = 3:5, decimals = 4) %>% - tab_header(title = "WPGSD bounds") - -## ----echo=FALSE--------------------------------------------------------------- -# Combine and back-calculate xi -bounds <- left_join(bound_Bonf, bound_WPGSD, - by = c("Hypotheses", "Analysis"), - suffix = c(".B", ".W") -) - -bounds <- bounds %>% - rowwise() %>% - mutate(xi = sum(H1.W, H2.W, H3.W, na.rm = TRUE) / - sum(H1.B, H2.B, H3.B, na.rm = TRUE)) - -# Reorder for output -bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2) -bounds <- bounds %>% - arrange(Analysis, order) %>% - select(-order) - -# Bonferroni and WPGSD Bounds (Table 6 in the manuscript) -bounds %>% - gt() %>% - fmt_number(columns = 3:9, decimals = 4) %>% - tab_header(title = "Bonferroni and WPGSD Bounds") - -## ----------------------------------------------------------------------------- -## Observed p-values. -## The tibble must contain columns Analysis, H1, H2 etc for all hypotheses -p_obs <- tribble( - ~Analysis, ~H1, ~H2, ~H3, - 1, 0.01, 0.0004, 0.03, - 2, 0.05, 0.002, 0.015 -) - -## Closed testing ## -test_result <- closed_test(bound_WPGSD, p_obs) - -p_obs %>% - gt() %>% - fmt_number(columns = 2:4, decimals = 8, drop_trailing_zeros = TRUE) %>% - tab_header("Observed Nominal p-Values") - -## ----------------------------------------------------------------------------- -test_result %>% - gt() %>% - tab_header(title = "Closed Testing Results") - -## ----------------------------------------------------------------------------- -set.seed(1234) - -# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ex2 BH ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~# -# Transition matrix in Figure A2 -m <- matrix(c( - 0, 0.5, 0.5, - 0.5, 0, 0.5, - 0.5, 0.5, 0 -), nrow = 3, byrow = TRUE) -# Initial weights -w <- c(1 / 3, 1 / 3, 1 / 3) - -# Event count of intersection of paired hypotheses - Table 2 -event <- tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160, - 3, 3, 1, 165, - 1, 2, 1, 85, - 1, 3, 1, 85, - 2, 3, 1, 85, - 1, 1, 2, 305, - 2, 2, 2, 320, - 3, 3, 2, 335, - 1, 2, 2, 170, - 1, 3, 2, 170, - 2, 3, 2, 170 -) - -event %>% - gt() %>% - tab_header(title = "Event Count") - -## ----------------------------------------------------------------------------- -# Generate correlation from events -corr <- generate_corr(event) - -# Correlation matrix in Table 4 -corr %>% - as_tibble() %>% - gt() %>% - fmt_number(columns = everything(), decimals = 2) %>% - tab_header(title = "Correlation Matrix") - -## ----------------------------------------------------------------------------- -# WPGSD bounds, spending method 3c -bound_WPGSD <- generate_bounds( - type = 3, k = 2, w = w, m = m, corr = corr, alpha = 0.025, - sf = list(sfLDOF, sfLDOF, sfLDOF), - sfparm = list(0, 0, 0), - t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1)) -) - -# Bonferroni bounds -bound_Bonf <- generate_bounds( - type = 0, k = 2, w = w, m = m, corr = corr, alpha = 0.025, - sf = list(sfLDOF, sfLDOF, sfLDOF), - sfparm = list(0, 0, 0), - t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1)) -) - -bounds <- left_join(bound_Bonf, bound_WPGSD, - by = c("Hypotheses", "Analysis"), - suffix = c(".B", ".W") -) - -# Reorder for output -bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2) -bounds <- bounds %>% - arrange(Analysis, order) %>% - select(-order) - -# Table A6 -bounds %>% - gt() %>% - fmt_number(columns = 3:9, decimals = 4) %>% - tab_header(title = "Bonferroni and WPGSD Bounds") - diff --git a/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/wpgsd.Rmd b/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/wpgsd.Rmd deleted file mode 100644 index 4771094..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/wpgsd.Rmd +++ /dev/null @@ -1,591 +0,0 @@ ---- -title: "Quickstart guide" -author: "Zifang Guo, Keaven Anderson, Jing Zhao, Linda Z. Sun" -output: - rmarkdown::html_document: - toc: true - toc_depth: 3 - toc_float: true - code_folding: hide - number_sections: true - highlight: "textmate" - css: "custom.css" -bibliography: wpgsd.bib -vignette: > - %\VignetteIndexEntry{Quickstart guide} - %\VignetteEncoding{UTF-8} - %\VignetteEngine{knitr::rmarkdown} -editor_options: - markdown: - wrap: 72 ---- - -```{r, include = FALSE} -knitr::opts_chunk$set( - collapse = TRUE, - comment = "#>", - error = TRUE, - fig.align = "center" -) -``` - -```{r, message=FALSE, warning=FALSE} -library(wpgsd) -library(gsDesign) -library(gMCPLite) -library(haven) -library(dplyr) -library(tidyr) -library(reshape2) -library(gt) -``` - -# Background - -The weighted parametric group sequential design (WPGSD) (@anderson2022unified) approach allows one to take advantage of the known correlation structure in constructing efficacy bounds to control family-wise error rate (FWER) for a group sequential design. Here correlation may be due to common observations in nested populations, due to common observations in overlapping populations, or due to common observations in the control arm. This document illustrates the use of the R package wpgsd to implement this approach. - -# Methods and Examples - -## Closed Testing and Parametric Tests - -We aim to control the familywise error rate (FWER) at level $\alpha$. Let $J \subseteq I$. The intersection hypothesis $H_J$ assumes the null hypothesis for all individual hypotheses $H_i$ with $i \in J$. Closed testing principle is as follows: if for all sets $J \subseteq I$ with $j \in J$, $H_J$ can be rejected at level $\alpha$, then $H_j$ can be rejected. Weighted parametric tests can be used for this: @bretz2011graphical, @xi2017unified for fixed designs or @maurer2013multiple for group sequential. - -## Consonance - -A closed procedure is called consonant if the rejection of the complete intersection null hypothesis $H_I$ further implies that at least one elementary hypothesis $H_i, i \in I$, is rejected. Consonance is a desirable property leading to short-cut procedures that give the same rejection decisions as the original closed procedure but with fewer operations. For WPGSD, consonance does not always hold and in general the closed-testing procedure is required. - -## Group Sequential Design Notations and Assumptions - -- A set $I$ of hypotheses for $i \in I$. -- $K$ group sequential analyses, $k = 1, \ldots, K$ -- Single endpoint - * Not required, and can be generalized -- Assume tests $Z_{ik}$, $i \in I$, $1 \leq k \leq K$ where a large $Z_{ik}$ is used to reject $H_i$ - -## Correlation Structure - -- Notation - * Events for individual hypothesis $H_i$,$i \in I$ at analysis k denoted by $n_{ik}$. - * Assume the same endpoint for all hypotheses (can be relaxed) - * For binary or continuous outcomes $n_{ik}$ represents sample size - * $Z_{ik}$ is standardized normal test for treatment effect for individual hypothesis $H_i$ at analysis $k$ - * Denote $n_{i\wedge i^\prime,k\wedge k^\prime}$ as the number of observations (or events) included in both $Z_{ik}$ and $Z_{i^\prime k^\prime}$, $i\in I$, $1\le k\le K$. -- Key result - $$ \hbox{Corr}(Z_{ik}, Z_{i^\prime k^\prime }) = \frac{n_{i\wedge i^\prime ,k\wedge k^\prime }}{\sqrt{n_{ik}n_{i^\prime k^\prime }}} $$ -- Proof builds on standard group sequential theory (@chen2021multiplicity) - -## Example 1: Overlapping Populations, Two Analyses - -Following illustrates the first example, which has overlapping populations (e.g. due to biomarker) and is also example 1 in @anderson2022unified. - -```{r, eval=FALSE, echo=FALSE} -library(ggplot2) -library(ggforce) - -ellipse_data <- data.frame( - id = c("H1: Population 1", "H2: Population 2", "H3: Overall Population"), - x = c(0, 1, 0.5), - y = c(0, 0, 0), - a = c(1, 1, 2), - b = c(0.5, 0.5, 1) -) - -ragg::agg_png( - "vignettes/figures/ex1-pop.png", - width = 1920, - height = 1920 / 1.618, - res = 96, - scaling = 2 -) -ggplot() + - geom_ellipse( - aes( - x0 = x, y0 = y, a = a, b = b, angle = 0, fill = id - ), - data = ellipse_data[ellipse_data$id == "H3: Overall Population", ], - color = NA, alpha = 0.5, show.legend = FALSE - ) + - geom_ellipse( - aes( - x0 = x, y0 = y, a = a, b = b, angle = 0, fill = id - ), - data = ellipse_data[ellipse_data$id != "H3: Overall Population", ], - color = NA, alpha = 0.85, show.legend = FALSE - ) + - geom_text(aes( - x = x, y = y, label = id, - hjust = ifelse(id == "H1: Population 1", 1.1, - ifelse(id == "H2: Population 2", -0.1, 0.5) - ), - vjust = ifelse(id == "H3: Overall Population", -9, 0.5) - ), data = ellipse_data, size = 6) + - scale_fill_manual(values = c("#E69F00", "#56B4E9", "#999999"), guide = "none") + - coord_fixed() + - theme_void() -dev.off() -``` - -```{r, echo=FALSE, out.width="90%", fig.cap="Ex1: Populations"} -knitr::include_graphics("figures/ex1-pop.png") -``` - -The multiplicity strategy is defined as follows. - -```{r, out.width="80%"} -# Transition matrix -m <- matrix(c( - 0, 0, 1, - 0, 0, 1, - 0.5, 0.5, 0 -), nrow = 3, byrow = TRUE) -# Weight matrix -w <- c(0.3, 0.3, 0.4) - -# Multiplicity graph -cbPalette <- c("#999999", "#E69F00", "#56B4E9") - -nameHypotheses <- c( - "H1: Population 1", - "H2: Population 2", - "H3: Overall Population" -) - -hplot <- hGraph(3, - alphaHypotheses = w, - m = m, - nameHypotheses = nameHypotheses, - trhw = .2, trhh = .1, - digits = 5, trdigits = 3, size = 5, halfWid = 1, - halfHgt = 0.5, offset = 0.2, trprop = 0.4, - fill = as.factor(c(2, 3, 1)), - palette = cbPalette, - wchar = "w" -) -hplot -``` - -The event count of each hypothesis at each analysis is shown below. - -| Population | Number of Events at IA | Number of Events at FA | -|:---------------------:|:----------------------:|:----------------------:| -| Population 1 | 100 | 200 | -| Population 2 | 110 | 220 | -| Population 1 $\cap$ 2 | 80 | 160 | -| Overall Population | 225 | 450 | - -Table: Number of events at each analysis for each population in Example 1. -IA: interim analysis. FA: final analysis. - -The correlation matrix among test statistics is as follows. - -| $i,k$ | 1,1 | 2,1 | 3,1 | 1,2 | 2,2 | 3,2 | -|:---:|:---:|:---:|:---:|:---:|:---:|:---:| -| 1,1 | 1 | $\frac{80}{\sqrt{100\cdot 110}}$ | $\frac{100}{\sqrt{100 \cdot 225}}$ | $\frac{100}{\sqrt{100\cdot 200}}$ | $\frac{80}{\sqrt{100\cdot 220}}$ | $\frac{100}{\sqrt{100 \cdot 450}}$ | -| 2,1 | 0.76 | 1 | $\frac{110}{\sqrt{110 \cdot 225}}$ | $\frac{80}{\sqrt{110\cdot 200}}$ | $\frac{110}{\sqrt{110\cdot 220}}$ | $\frac{110}{\sqrt{110 \cdot 450}}$ | -| 3,1 | 0.67 | 0.70 | 1 | $\frac{100}{\sqrt{225 \cdot 200}}$ | $\frac{110}{\sqrt{225 \cdot 220}}$ | $\frac{225}{\sqrt{225 \cdot 450}}$ | -| 1,2 | 0.71 | 0.54 | 0.47 | 1 | $\frac{160}{\sqrt{200 \cdot 220}}$ | $\frac{200}{\sqrt{200 \cdot 450}}$ | -| 2,2 | 0.54 | 0.71 | 0.49 | 0.76 | 1 | $\frac{220}{\sqrt{220 \cdot 450}}$ | -| 3,2 | 0.47 | 0.49 | 0.71 | 0.67 | 0.70 | 1 | - -Table: Correlation Matrix of Test Statistics for Example 1. -Identical numeric values (lower triangular) and formulas (upper triangular) shown. - -## Example 2: Common Control, Two Analyses - -Following illustrates the second example in which correlation comes from common control arm. This is also example 2 in @anderson2022unified. - -```{r, out.width="80%", echo = FALSE} -cbPalette <- c( - "#999999", "#E69F00", "#56B4E9", "#009E73", - "#F0E442", "#0072B2", "#D55E00", "#CC79A7" -) -nameHypotheses <- c( - "H1: Experimental 1 vs Control", - "H2: Experimental 2 vs Control", - "H3: Experimental 3 vs Control" -) -m <- matrix(c( - 0, 0.5, 0.5, - 0.5, 0, 0.5, - 0.5, 0.5, 0 -), nrow = 3, byrow = TRUE) -alphaHypotheses <- c(1 / 3, 1 / 3, 1 / 3) - -hplot <- hGraph(3, - alphaHypotheses = alphaHypotheses, m = m, - nameHypotheses = nameHypotheses, trhw = .2, trhh = .1, - digits = 3, trdigits = 4, size = 5, halfWid = 1.2, halfHgt = 0.5, - offset = 0.2, trprop = 0.35, - fill = as.factor(c(2, 3, 1)), - palette = cbPalette[1:3], - wchar = "w" -) -hplot -``` - -| Treatment Arm | Number of Events at IA | Number of Events at FA | -|:--------------:|:----------------------:|:----------------------:| -| Experimental 1 | 70 | 135 | -| Experimental 2 | 75 | 150 | -| Experimental 3 | 80 | 165 | -| Control | 85 | 170 | - -Table: Number of events at each analysis for each treatment arm in Example 2. -IA: interim analysis. FA: final analysis. - -| $i,k$ | 1,1 | 2,1 | 3,1 | 1,2 | 2,2 | 3,2 | -|:---:|:---:|:---:|:---:|:---:|:---:|:---:| -| 1,1 | 1 | $\frac{85}{\sqrt{155\cdot 160}}$ | $\frac{85}{\sqrt{155 \cdot 165}}$ | $\frac{155}{\sqrt{155\cdot 305}}$ | $\frac{85}{\sqrt{155\cdot 320}}$ | $\frac{85}{\sqrt{155 \cdot 335}}$ | -| 2,1 | 0.54 | 1 | $\frac{85}{\sqrt{160 \cdot 165}}$ | $\frac{85}{\sqrt{160 \cdot 305}}$ | $\frac{160}{\sqrt{160\cdot 320}}$ | $\frac{85}{\sqrt{160 \cdot 335}}$ | -| 3,1 | 0.53 | 0.52 | 1 | $\frac{85}{\sqrt{165 \cdot 305}}$ | $\frac{85}{\sqrt{165\cdot 320}}$ | $\frac{165}{\sqrt{165 \cdot 335}}$ | -| 1,2 | 0.71 | 0.38 | 0.38 | 1 | $\frac{170}{\sqrt{305\cdot 320}}$ | $\frac{170}{\sqrt{305 \cdot 335}}$ | -| 2,2 | 0.38 | 0.71 | 0.37 | 0.54 | 1 | $\frac{170}{\sqrt{320 \cdot 335}}$ | -| 3,2 | 0.37 | 0.37 | 0.70 | 0.53 | 0.52 | 1 | - -Table: Correlation Matrix for Example 2. -Identical numeric values (lower triangular) and formulas (upper triangular) shown. - -## Hypotheses Set - -These 2 examples each has 7 intersection hypotheses and the corresponding weighting strategies are illustrated below. - -| $H_J$ | $w_1(J)$ | $w_2(J)$ | $w_3(J)$ | -|:-----------------------:|:--------:|:--------:|:--------:| -| $H_1 \cap H_2 \cap H_3$ | 0.3 | 0.3 | 0.4 | -| $H_1 \cap H_2$ | 0.5 | 0.5 | - | -| $H_1 \cap H_3$ | 0.3 | - | 0.7 | -| $H_2 \cap H_3$ | - | 0.3 | 0.7 | -| $H_1$ | 1 | - | - | -| $H_2$ | - | 1 | - | -| $H_3$ | - | - | 1 | - -Table: Weighting strategy of Example 1. - -| $H_J$ | $w_1(J)$ | $w_2(J)$ | $w_3(J)$ | -|:-----------------------:|:--------:|:--------:|:--------:| -| $H_1 \cap H_2 \cap H_3$ | 1/3 | 1/3 | 1/3 | -| $H_1 \cap H_2$ | 1/2 | 1/2 | - | -| $H_1 \cap H_3$ | 1/2 | - | 1/2 | -| $H_2 \cap H_3$ | - | 1/2 | 1/2 | -| $H_1$ | 1 | - | - | -| $H_2$ | - | 1 | - | -| $H_3$ | - | - | 1 | - -Table: Weighting strategy of Example 2. - -## $\alpha$ Spending: 3 approaches - -The WPGSD approach uses all known correlations between tests in the study. This relaxes bounds and allows increased power or smaller sample size. Three spending approaches have been proposed: - -- Fixed spending (Fleming-Harrington-O'Brien (FHO) approach). Specify $0 < \alpha_1(J) < \alpha_2(J) < \ldots < \alpha_K(J) = \alpha(J) \leq \alpha$ for all $J\subseteq I$, where $\alpha(J)$ is the total alpha for intersection hypothesis $H_J$ according to the graphical approach. - -- $\alpha$-spending approach 1. We choose a spending function family $f(t,\alpha)$ and set $\alpha_k(J)=f(t_k(J),\alpha(J))$ for $1\le k\le K$ for all intersection hypotheses $J\subseteq I$. - -- $\alpha$-spending approach 2. For each elementary hypothesis $i$ ($i$ = 1, 2, \ldots, $m$), specify the $\alpha$-spending function family $f_i(t,\gamma)$ where $\gamma$ is the $\alpha$ level for the hypothesis and $f_i(t_{ik},\gamma)$ determines how much $\alpha$ to spend up to analysis $k$ for hypothesis $i$ when level $\gamma$ is allocated to the hypothesis. Then $\alpha_k(J) = \sum_{i \in J} f_i(t_{ik}, w_i(J)\alpha)$. - -## Bounds Computation: Parametric Test, Fixed Design (For Example, Two Populations, One Analysis) - -- Assume ($Z_1,Z_2$) bivariate normal with known correlation - -- Find $\alpha$-inflation factor $c_J$ such that - $$ \alpha = P[\cup_{i \in J} \{p_i \leq c_Jw_{J,i}\alpha \}] = P[\cup_{i \in J} \{Z_i \geq \Phi^{-1}(1-c_Jw_{J,i}\alpha \}]$$ - -- Basic algorithm code in @bretz2011graphical - -### Bounds Computation: WPGSD - Fixed spending and $\alpha$ spending approach 1 {.smaller} - -- Assume for $j < k$ that bounds $c_{ij} (J), i \in J, j < k$, have already been set and remain unchanged. - -- At analysis $k$, compute the correlation matrix of $Z_{ij}$, $i \in J$, $j = 1, \ldots, k$. - - i Initialize $\alpha_{k}^{*}(J) = \alpha_{k}(J) - \alpha_{k-1}(J)$. - - ii Set $b_{ik} = \Phi^{-1}(1 - w_{i}(J)\alpha_{k}^{*} (J))$, $i\in J$. - - iii Compute type I error rate up to analysis $k$ - $$ 1 - Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} \cap_{i \in J, j < k} \{ Z_{ij} < c_{ij}(J) \} ). $$ - - iv Update $\alpha_{k}^{*}(J)$ using root-finding with steps ii - iii until the type I error rate through analysis $k$ is controlled at $\alpha_{k}(J)$ for $H_J$. That is, - $$ 1 - Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} \cap_{i \in J, j < k} \{ Z_{ij} < c_{ij}(J) \} ) = \alpha_{k}. $$ - - v Set $c_{ik}(J) = b_{ik}$ from the previous step. The corresponding nominal $p$-value boundary is $p_{ik}(J)= 1-\Phi(c_{ik}(J)) = w_i(J)\alpha_k^*(J)$. - -- Note: interim bound does not depend on future analyses. Solution only requires root finding for a single $\alpha_{k}^{*}(J)$ at a time, $k = 1, \ldots, K$. Requires multivariate normal computation from mvtnorm R package Genz et al. (2020). - -### Bounds Computation: WPGSD - $\alpha$ spending approach 2 {.smaller} - -- Assume for $j < k$ that bounds $c_{ij} (J), i \in J, j < k$, have already been set and remain unchanged. - -- At analysis $k$, compute the correlation matrix of $Z_{ij}$, $i \in J$, $j = 1, \ldots, k$. - - i Determine what the nominal $p$-value boundary would be for each elementary hypothesis in $J$ for a weighted Bonferroni test in a group sequential design as described in @maurer2013multiple. Let these nominal $p$-value boundaries be $\alpha^\prime_{ik}(J)$. - - ii Choose an inflation factor $\xi_{k}(J) > 1$ and set $$b_{ik} = \Phi^{-1}(1 - \xi_k(J) \alpha^\prime_{ik}(J)).$$ - - iii Update $\xi_k(J)$ until this type I error rate up to analysis $k$ is controlled at $\alpha_{k}(J)$ for $H_J$. That is, - $$ 1 - Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} \cap_{i \in J, j < k} \{ Z_{ij} < c_{ij}(J) \} ) = \alpha_{k}(J).$$ - - iv After the appropriate $\xi_k(J)$ has been derived, the nominal $p$-value boundaries are $p_{ik}(J)=\xi_k(J) \alpha^\prime_{ik}(J)$, and $b_{ik}$ is computed as in step ii, we set $c_{ik}(J) = b_{ik}$. - -- Note: interim bound does not depend on future analyses. Solution only requires root finding for a single $\xi_k(J)$ at a time, $k = 1, \ldots, K$. Requires multivariate normal computation from the mvtnorm R package Genz et al. (2020). - -## Implementation of Example 1 with Overlapping Populations - -We first define the transition matrix and weights as shown above in Section 2.5. Next we set up the event count table as follows: - -- Analysis: Analysis number (1 for interim, 2 for final). -- Event: Event counts. -- H1, H2: Hypotheses intersected. - * (1, 1) represents counts for hypothesis 1 - * (1, 2) for counts for the intersection of hypotheses 1 and 2 - -```{r} -event <- tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 100, - 2, 2, 1, 110, - 3, 3, 1, 225, - 1, 2, 1, 80, - 1, 3, 1, 100, - 2, 3, 1, 110, - 1, 1, 2, 200, - 2, 2, 2, 220, - 3, 3, 2, 450, - 1, 2, 2, 160, - 1, 3, 2, 200, - 2, 3, 2, 220 -) -event %>% - gt() %>% - tab_header(title = "Event Count") -``` - -```{r} -# Alternatively, one can manually enter paths for analysis datasets, -# example below uses an example dataset assuming currently we are at IA1. -paths <- system.file("extdata/", package = "wpgsd") - -### Generate event count table from ADSL and ADTTE datasets -# Selection criteria for each hypothesis -h_select <- tribble( - ~Hypothesis, ~Crit, - 1, "PARAMCD=='OS' & TRT01P %in% c('Xanomeline High Dose', 'Placebo')", - 2, "PARAMCD=='OS' & TRT01P %in% c('Xanomeline Low Dose', 'Placebo')" -) - -event2 <- generate_event_table(paths, h_select, - adsl_name = "adsl", adtte_name = "adtte", - key_var = "USUBJID", cnsr_var = "CNSR" -)$event - -event2 %>% - gt() %>% - tab_header(title = "Event Count - Computed from SAS Datasets Example") -``` - -Then we compute correlation matrix using the event count table and `generate_corr()`. We see that the correlations not accounted for by the Bonferroni approach are substantial and, thus, might expect a non-trivial impact on bounds for hypothesis tests. - -```{r} -## Generate correlation from events -corr <- generate_corr(event) - -corr %>% - as_tibble() %>% - gt() %>% - fmt_number(columns = everything(), decimals = 2) %>% - tab_header(title = "Correlation Matrix") -``` - -Bonferroni and WPGSD bounds can then be computed via `generate_bounds()`. In this example, we useHSD(-4) as $\alpha$-spending for all hypotheses. Of note, `generate_bounds()` input type specifies boundary type. - -- 0 = Bonferroni. Separate alpha spending for each hypotheses. -- 1 = Fixed alpha spending for all hypotheses. Method 3a in the manuscript. -- 2 = Overall alpha spending for all hypotheses. Method 3b in the manuscript. -- 3 = Separate alpha spending for each hypotheses. Method 3c in the manuscript. - -Compute Bonferroni bounds. - -```{r} -# Bonferroni bounds -bound_Bonf <- generate_bounds( - type = 0, k = 2, w = w, m = m, - corr = corr, alpha = 0.025, - sf = list(sfHSD, sfHSD, sfHSD), - sfparm = list(-4, -4, -4), - t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1)) -) - -bound_Bonf %>% - gt() %>% - fmt_number(columns = 3:5, decimals = 4) %>% - tab_header(title = "Bonferroni bounds") -``` - -Compute WPGSD Bounds using $\alpha$-spending approach 1 with HSD(-4) spending. Here spending time was defined as minimum of the 3 observed information fractions. - -```{r} -set.seed(1234) -# WPGSD bounds, spending approach 1 -bound_WPGSD <- generate_bounds( - type = 2, k = 2, w = w, m = m, - corr = corr, alpha = 0.025, - sf = sfHSD, - sfparm = -4, - t = c(min(100 / 200, 110 / 220, 225 / 450), 1) -) - -bound_WPGSD %>% - gt() %>% - fmt_number(columns = 3:5, decimals = 4) %>% - tab_header(title = "WPGSD bounds") -``` - -Below shows the comparison between the Bonferroni and WPGSD bounds. Nominal level at final analysis by using the WPGSD method increased by up to 1.3× over those obtained via the Bonferroni approach. - -```{r, echo=FALSE} -# Combine and back-calculate xi -bounds <- left_join(bound_Bonf, bound_WPGSD, - by = c("Hypotheses", "Analysis"), - suffix = c(".B", ".W") -) - -bounds <- bounds %>% - rowwise() %>% - mutate(xi = sum(H1.W, H2.W, H3.W, na.rm = TRUE) / - sum(H1.B, H2.B, H3.B, na.rm = TRUE)) - -# Reorder for output -bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2) -bounds <- bounds %>% - arrange(Analysis, order) %>% - select(-order) - -# Bonferroni and WPGSD Bounds (Table 6 in the manuscript) -bounds %>% - gt() %>% - fmt_number(columns = 3:9, decimals = 4) %>% - tab_header(title = "Bonferroni and WPGSD Bounds") -``` - -Closed testing procedure can then be performed using `closed_test()`. - -```{r} -## Observed p-values. -## The tibble must contain columns Analysis, H1, H2 etc for all hypotheses -p_obs <- tribble( - ~Analysis, ~H1, ~H2, ~H3, - 1, 0.01, 0.0004, 0.03, - 2, 0.05, 0.002, 0.015 -) - -## Closed testing ## -test_result <- closed_test(bound_WPGSD, p_obs) - -p_obs %>% - gt() %>% - fmt_number(columns = 2:4, decimals = 8, drop_trailing_zeros = TRUE) %>% - tab_header("Observed Nominal p-Values") -``` - -```{r} -test_result %>% - gt() %>% - tab_header(title = "Closed Testing Results") -``` - -## Implementation of Example 2 with Common Control - -Similarly, codes below reproduce the result of Example 2 of @anderson2022unified, which uses spending method 3c specified in the paper. - -```{r} -set.seed(1234) - -# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ex2 BH ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~# -# Transition matrix in Figure A2 -m <- matrix(c( - 0, 0.5, 0.5, - 0.5, 0, 0.5, - 0.5, 0.5, 0 -), nrow = 3, byrow = TRUE) -# Initial weights -w <- c(1 / 3, 1 / 3, 1 / 3) - -# Event count of intersection of paired hypotheses - Table 2 -event <- tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160, - 3, 3, 1, 165, - 1, 2, 1, 85, - 1, 3, 1, 85, - 2, 3, 1, 85, - 1, 1, 2, 305, - 2, 2, 2, 320, - 3, 3, 2, 335, - 1, 2, 2, 170, - 1, 3, 2, 170, - 2, 3, 2, 170 -) - -event %>% - gt() %>% - tab_header(title = "Event Count") -``` - -```{r} -# Generate correlation from events -corr <- generate_corr(event) - -# Correlation matrix in Table 4 -corr %>% - as_tibble() %>% - gt() %>% - fmt_number(columns = everything(), decimals = 2) %>% - tab_header(title = "Correlation Matrix") -``` - -```{r} -# WPGSD bounds, spending method 3c -bound_WPGSD <- generate_bounds( - type = 3, k = 2, w = w, m = m, corr = corr, alpha = 0.025, - sf = list(sfLDOF, sfLDOF, sfLDOF), - sfparm = list(0, 0, 0), - t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1)) -) - -# Bonferroni bounds -bound_Bonf <- generate_bounds( - type = 0, k = 2, w = w, m = m, corr = corr, alpha = 0.025, - sf = list(sfLDOF, sfLDOF, sfLDOF), - sfparm = list(0, 0, 0), - t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1)) -) - -bounds <- left_join(bound_Bonf, bound_WPGSD, - by = c("Hypotheses", "Analysis"), - suffix = c(".B", ".W") -) - -# Reorder for output -bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2) -bounds <- bounds %>% - arrange(Analysis, order) %>% - select(-order) - -# Table A6 -bounds %>% - gt() %>% - fmt_number(columns = 3:9, decimals = 4) %>% - tab_header(title = "Bonferroni and WPGSD Bounds") -``` - -## Power Considerations - -The above illustrates the use of the WPGSD approach to compute bounds at the analysis stage. At the design stage, one can take one of the following 2 options: 1) The trial can be first designed as if the testing would be done with a weighted Bonferroni with conservative sample size estimate. At the analysis stage, the correlation can be taken into consideration with the WPGSD approach for bound calculation; or 2) To adjust the sample size downward using the WPGSD approach at the design stage, one can power the study by taking the minimum $p$-value bound for a given individual hypothesis from the WPGSD table (with assumed correlation structure). For example, for $H_2$ of example 1, this is $\hbox{min}(0.0011,0.0017,0.0010,0.0030)=0.0010$ for $k=1$ and $\hbox{min}(0.0092,0.0144,0.0081,0.0238)=0.0081$ for $k=2$. Then the $H_2$ bounds of 0.0010 ($k=1$) and 0.0081 ($k=2$) can be used to power $H_2$. R function for the 2nd option is in development. - -# Conclusions - -The WPGSD approach provides an unification of previous work on parametric testing in group sequential design. It enabled more complex scenarios and requires attention to consonance and intersection hypotheses. Although detailed closed testing is required, this should not be a deterrent. The approach accommodates various spending approaches and provides more relaxed bounds -and improved power compared to the Bonferroni approach. - -# References diff --git a/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/wpgsd.html b/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/wpgsd.html deleted file mode 100644 index 7d0095d..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/wpgsd.html +++ /dev/null @@ -1,7846 +0,0 @@ - - - - - - - - - - - - - - -Quickstart guide - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- - - -
-
-
-
-
- -
- - - - - - - -
library(wpgsd)
-library(gsDesign)
-library(gMCPLite)
-library(haven)
-library(dplyr)
-library(tidyr)
-library(reshape2)
-library(gt)
-
-

1 Background

-

The weighted parametric group sequential design (WPGSD) (Anderson et al. (2022)) approach allows one to -take advantage of the known correlation structure in constructing -efficacy bounds to control family-wise error rate (FWER) for a group -sequential design. Here correlation may be due to common observations in -nested populations, due to common observations in overlapping -populations, or due to common observations in the control arm. This -document illustrates the use of the R package wpgsd to implement this -approach.

-
-
-

2 Methods and -Examples

-
-

2.1 Closed Testing and -Parametric Tests

-

We aim to control the familywise error rate (FWER) at level \(\alpha\). Let \(J -\subseteq I\). The intersection hypothesis \(H_J\) assumes the null hypothesis for all -individual hypotheses \(H_i\) with -\(i \in J\). Closed testing principle -is as follows: if for all sets \(J \subseteq -I\) with \(j \in J\), \(H_J\) can be rejected at level \(\alpha\), then \(H_j\) can be rejected. Weighted parametric -tests can be used for this: Bretz et al. -(2011), Xi et al. (2017) for fixed -designs or Maurer and Bretz (2013) for -group sequential.

-
-
-

2.2 Consonance

-

A closed procedure is called consonant if the rejection of the -complete intersection null hypothesis \(H_I\) further implies that at least one -elementary hypothesis \(H_i, i \in I\), -is rejected. Consonance is a desirable property leading to short-cut -procedures that give the same rejection decisions as the original closed -procedure but with fewer operations. For WPGSD, consonance does not -always hold and in general the closed-testing procedure is required.

-
-
-

2.3 Group Sequential -Design Notations and Assumptions

-
    -
  • A set \(I\) of hypotheses for \(i \in I\).
  • -
  • \(K\) group sequential analyses, -\(k = 1, \ldots, K\)
  • -
  • Single endpoint -
      -
    • Not required, and can be generalized
    • -
  • -
  • Assume tests \(Z_{ik}\), \(i \in I\), \(1 -\leq k \leq K\) where a large \(Z_{ik}\) is used to reject \(H_i\)
  • -
-
-
-

2.4 Correlation -Structure

-
    -
  • Notation -
      -
    • Events for individual hypothesis \(H_i\),\(i \in -I\) at analysis k denoted by \(n_{ik}\).
    • -
    • Assume the same endpoint for all hypotheses (can be relaxed)
    • -
    • For binary or continuous outcomes \(n_{ik}\) represents sample size
    • -
    • \(Z_{ik}\) is standardized normal -test for treatment effect for individual hypothesis \(H_i\) at analysis \(k\)
    • -
    • Denote \(n_{i\wedge i^\prime,k\wedge -k^\prime}\) as the number of observations (or events) included in -both \(Z_{ik}\) and \(Z_{i^\prime k^\prime}\), \(i\in I\), \(1\le -k\le K\).
    • -
  • -
  • Key result \[ \hbox{Corr}(Z_{ik}, -Z_{i^\prime k^\prime }) = \frac{n_{i\wedge i^\prime ,k\wedge k^\prime -}}{\sqrt{n_{ik}n_{i^\prime k^\prime }}} \]
  • -
  • Proof builds on standard group sequential theory (Chen et al. (2021))
  • -
-
-
-

2.5 Example 1: -Overlapping Populations, Two Analyses

-

Following illustrates the first example, which has overlapping -populations (e.g. due to biomarker) and is also example 1 in Anderson et al. (2022).

-
-Ex1: Populations -

-Ex1: Populations -

-
-

The multiplicity strategy is defined as follows.

-
# Transition matrix
-m <- matrix(c(
-  0, 0, 1,
-  0, 0, 1,
-  0.5, 0.5, 0
-), nrow = 3, byrow = TRUE)
-# Weight matrix
-w <- c(0.3, 0.3, 0.4)
-
-# Multiplicity graph
-cbPalette <- c("#999999", "#E69F00", "#56B4E9")
-
-nameHypotheses <- c(
-  "H1: Population 1",
-  "H2: Population 2",
-  "H3: Overall Population"
-)
-
-hplot <- hGraph(3,
-  alphaHypotheses = w,
-  m = m,
-  nameHypotheses = nameHypotheses,
-  trhw = .2, trhh = .1,
-  digits = 5, trdigits = 3, size = 5, halfWid = 1,
-  halfHgt = 0.5, offset = 0.2, trprop = 0.4,
-  fill = as.factor(c(2, 3, 1)),
-  palette = cbPalette,
-  wchar = "w"
-)
-hplot
-

-

The event count of each hypothesis at each analysis is shown -below.

- - ----- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Number of events at each analysis for each population in -Example 1. IA: interim analysis. FA: final analysis.
PopulationNumber of Events at IANumber of Events at FA
Population 1100200
Population 2110220
Population 1 \(\cap\) 280160
Overall Population225450
-

The correlation matrix among test statistics is as follows.

- - --------- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Correlation Matrix of Test Statistics for Example 1. Identical -numeric values (lower triangular) and formulas (upper triangular) -shown.
\(i,k\)1,12,13,11,22,23,2
1,11\(\frac{80}{\sqrt{100\cdot -110}}\)\(\frac{100}{\sqrt{100 -\cdot 225}}\)\(\frac{100}{\sqrt{100\cdot -200}}\)\(\frac{80}{\sqrt{100\cdot -220}}\)\(\frac{100}{\sqrt{100 -\cdot 450}}\)
2,10.761\(\frac{110}{\sqrt{110 -\cdot 225}}\)\(\frac{80}{\sqrt{110\cdot -200}}\)\(\frac{110}{\sqrt{110\cdot -220}}\)\(\frac{110}{\sqrt{110 -\cdot 450}}\)
3,10.670.701\(\frac{100}{\sqrt{225 -\cdot 200}}\)\(\frac{110}{\sqrt{225 -\cdot 220}}\)\(\frac{225}{\sqrt{225 -\cdot 450}}\)
1,20.710.540.471\(\frac{160}{\sqrt{200 -\cdot 220}}\)\(\frac{200}{\sqrt{200 -\cdot 450}}\)
2,20.540.710.490.761\(\frac{220}{\sqrt{220 -\cdot 450}}\)
3,20.470.490.710.670.701
-
-
-

2.6 Example 2: Common -Control, Two Analyses

-

Following illustrates the second example in which correlation comes -from common control arm. This is also example 2 in Anderson et al. (2022).

-

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Number of events at each analysis for each treatment arm in -Example 2. IA: interim analysis. FA: final analysis.
Treatment ArmNumber of Events at IANumber of Events at FA
Experimental 170135
Experimental 275150
Experimental 380165
Control85170
- - --------- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Correlation Matrix for Example 2. Identical numeric values -(lower triangular) and formulas (upper triangular) shown.
\(i,k\)1,12,13,11,22,23,2
1,11\(\frac{85}{\sqrt{155\cdot -160}}\)\(\frac{85}{\sqrt{155 \cdot -165}}\)\(\frac{155}{\sqrt{155\cdot -305}}\)\(\frac{85}{\sqrt{155\cdot -320}}\)\(\frac{85}{\sqrt{155 \cdot -335}}\)
2,10.541\(\frac{85}{\sqrt{160 \cdot -165}}\)\(\frac{85}{\sqrt{160 \cdot -305}}\)\(\frac{160}{\sqrt{160\cdot -320}}\)\(\frac{85}{\sqrt{160 \cdot -335}}\)
3,10.530.521\(\frac{85}{\sqrt{165 \cdot -305}}\)\(\frac{85}{\sqrt{165\cdot -320}}\)\(\frac{165}{\sqrt{165 -\cdot 335}}\)
1,20.710.380.381\(\frac{170}{\sqrt{305\cdot -320}}\)\(\frac{170}{\sqrt{305 -\cdot 335}}\)
2,20.380.710.370.541\(\frac{170}{\sqrt{320 -\cdot 335}}\)
3,20.370.370.700.530.521
-
-
-

2.7 Hypotheses Set

-

These 2 examples each has 7 intersection hypotheses and the -corresponding weighting strategies are illustrated below.

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Weighting strategy of Example 1.
\(H_J\)\(w_1(J)\)\(w_2(J)\)\(w_3(J)\)
\(H_1 \cap H_2 \cap -H_3\)0.30.30.4
\(H_1 \cap -H_2\)0.50.5-
\(H_1 \cap -H_3\)0.3-0.7
\(H_2 \cap -H_3\)-0.30.7
\(H_1\)1--
\(H_2\)-1-
\(H_3\)--1
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Weighting strategy of Example 2.
\(H_J\)\(w_1(J)\)\(w_2(J)\)\(w_3(J)\)
\(H_1 \cap H_2 \cap -H_3\)1/31/31/3
\(H_1 \cap -H_2\)1/21/2-
\(H_1 \cap -H_3\)1/2-1/2
\(H_2 \cap -H_3\)-1/21/2
\(H_1\)1--
\(H_2\)-1-
\(H_3\)--1
-
-
-

2.8 \(\alpha\) Spending: 3 approaches

-

The WPGSD approach uses all known correlations between tests in the -study. This relaxes bounds and allows increased power or smaller sample -size. Three spending approaches have been proposed:

-
    -
  • Fixed spending (Fleming-Harrington-O’Brien (FHO) approach). -Specify \(0 < \alpha_1(J) < \alpha_2(J) -< \ldots < \alpha_K(J) = \alpha(J) \leq \alpha\) for all -\(J\subseteq I\), where \(\alpha(J)\) is the total alpha for -intersection hypothesis \(H_J\) -according to the graphical approach.

  • -
  • \(\alpha\)-spending approach 1. -We choose a spending function family \(f(t,\alpha)\) and set \(\alpha_k(J)=f(t_k(J),\alpha(J))\) for \(1\le k\le K\) for all intersection -hypotheses \(J\subseteq I\).

  • -
  • \(\alpha\)-spending approach 2. -For each elementary hypothesis \(i\) -(\(i\) = 1, 2, , \(m\)), specify the \(\alpha\)-spending function family \(f_i(t,\gamma)\) where \(\gamma\) is the \(\alpha\) level for the hypothesis and \(f_i(t_{ik},\gamma)\) determines how much -\(\alpha\) to spend up to analysis -\(k\) for hypothesis \(i\) when level \(\gamma\) is allocated to the hypothesis. -Then \(\alpha_k(J) = \sum_{i \in J} -f_i(t_{ik}, w_i(J)\alpha)\).

  • -
-
-
-

2.9 Bounds Computation: -Parametric Test, Fixed Design (For Example, Two Populations, One -Analysis)

-
    -
  • Assume (\(Z_1,Z_2\)) bivariate -normal with known correlation

  • -
  • Find \(\alpha\)-inflation factor -\(c_J\) such that \[ \alpha = P[\cup_{i \in J} \{p_i \leq -c_Jw_{J,i}\alpha \}] = P[\cup_{i \in J} \{Z_i \geq -\Phi^{-1}(1-c_Jw_{J,i}\alpha \}]\]

  • -
  • Basic algorithm code in Bretz et al. -(2011)

  • -
-
-

2.9.1 -Bounds Computation: WPGSD - Fixed spending and \(\alpha\) spending approach 1

-
    -
  • Assume for \(j < k\) that -bounds \(c_{ij} (J), i \in J, j < -k\), have already been set and remain unchanged.

  • -
  • At analysis \(k\), compute the -correlation matrix of \(Z_{ij}\), \(i \in J\), \(j = -1, \ldots, k\).

    -

    i Initialize \(\alpha_{k}^{*}(J) = -\alpha_{k}(J) - \alpha_{k-1}(J)\).

    -

    ii Set \(b_{ik} = \Phi^{-1}(1 - -w_{i}(J)\alpha_{k}^{*} (J))\), \(i\in -J\).

    -

    iii Compute type I error rate up to analysis \(k\) \[ 1 - -Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} \cap_{i \in J, j < k} \{ -Z_{ij} < c_{ij}(J) \} ). \]

    -

    iv Update \(\alpha_{k}^{*}(J)\) -using root-finding with steps ii - iii until the type I error rate -through analysis \(k\) is controlled at -\(\alpha_{k}(J)\) for \(H_J\). That is, \[ 1 - Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} -\cap_{i \in J, j < k} \{ Z_{ij} < c_{ij}(J) \} ) = \alpha_{k}. -\]

    -

    v Set \(c_{ik}(J) = b_{ik}\) from -the previous step. The corresponding nominal \(p\)-value boundary is \(p_{ik}(J)= 1-\Phi(c_{ik}(J)) -= w_i(J)\alpha_k^*(J)\).

  • -
  • Note: interim bound does not depend on future analyses. Solution -only requires root finding for a single \(\alpha_{k}^{*}(J)\) at a time, \(k = 1, \ldots, K\). Requires multivariate -normal computation from mvtnorm R package Genz et al. (2020).

  • -
-
-
-

2.9.2 -Bounds Computation: WPGSD - \(\alpha\) -spending approach 2

-
    -
  • Assume for \(j < k\) that -bounds \(c_{ij} (J), i \in J, j < -k\), have already been set and remain unchanged.

  • -
  • At analysis \(k\), compute the -correlation matrix of \(Z_{ij}\), \(i \in J\), \(j = -1, \ldots, k\).

    -

    i Determine what the nominal \(p\)-value boundary would be for each -elementary hypothesis in \(J\) for a -weighted Bonferroni test in a group sequential design as described in -Maurer and Bretz (2013). Let these nominal -\(p\)-value boundaries be \(\alpha^\prime_{ik}(J)\).

    -

    ii Choose an inflation factor \(\xi_{k}(J) -> 1\) and set \[b_{ik} = -\Phi^{-1}(1 - \xi_k(J) \alpha^\prime_{ik}(J)).\]

    -

    iii Update \(\xi_k(J)\) until this -type I error rate up to analysis \(k\) -is controlled at \(\alpha_{k}(J)\) for -\(H_J\). That is, \[ 1 - Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} -\cap_{i \in J, j < k} \{ Z_{ij} < c_{ij}(J) \} ) = -\alpha_{k}(J).\]

    -

    iv After the appropriate \(\xi_k(J)\) has been derived, the nominal -\(p\)-value boundaries are \(p_{ik}(J)=\xi_k(J) \alpha^\prime_{ik}(J)\), -and \(b_{ik}\) is computed as in step -ii, we set \(c_{ik}(J) = -b_{ik}\).

  • -
  • Note: interim bound does not depend on future analyses. Solution -only requires root finding for a single \(\xi_k(J)\) at a time, \(k = 1, \ldots, K\). Requires multivariate -normal computation from the mvtnorm R package Genz et -al. (2020).

  • -
-
-
-
-

2.10 Implementation of -Example 1 with Overlapping Populations

-

We first define the transition matrix and weights as shown above in -Section 2.5. Next we set up the event count table as follows:

-
    -
  • Analysis: Analysis number (1 for interim, 2 for final).
  • -
  • Event: Event counts.
  • -
  • H1, H2: Hypotheses intersected. -
      -
    • (1, 1) represents counts for hypothesis 1
    • -
    • (1, 2) for counts for the intersection of hypotheses 1 and 2
    • -
  • -
-
event <- tribble(
-  ~H1, ~H2, ~Analysis, ~Event,
-  1, 1, 1, 100,
-  2, 2, 1, 110,
-  3, 3, 1, 225,
-  1, 2, 1, 80,
-  1, 3, 1, 100,
-  2, 3, 1, 110,
-  1, 1, 2, 200,
-  2, 2, 2, 220,
-  3, 3, 2, 450,
-  1, 2, 2, 160,
-  1, 3, 2, 200,
-  2, 3, 2, 220
-)
-event %>%
-  gt() %>%
-  tab_header(title = "Event Count")
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Event Count
H1H2AnalysisEvent
111100
221110
331225
12180
131100
231110
112200
222220
332450
122160
132200
232220
-
-
# Alternatively, one can manually enter paths for analysis datasets,
-# example below uses an example dataset assuming currently we are at IA1.
-paths <- system.file("extdata/", package = "wpgsd")
-
-### Generate event count table from ADSL and ADTTE datasets
-# Selection criteria for each hypothesis
-h_select <- tribble(
-  ~Hypothesis, ~Crit,
-  1, "PARAMCD=='OS' & TRT01P %in% c('Xanomeline High Dose', 'Placebo')",
-  2, "PARAMCD=='OS' & TRT01P %in% c('Xanomeline Low Dose', 'Placebo')"
-)
-
-event2 <- generate_event_table(paths, h_select,
-  adsl_name = "adsl", adtte_name = "adtte",
-  key_var = "USUBJID", cnsr_var = "CNSR"
-)$event
-
-event2 %>%
-  gt() %>%
-  tab_header(title = "Event Count - Computed from SAS Datasets Example")
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Event Count - Computed from SAS Datasets Example
H1H2AnalysisEvent
11166
22159
12145
-
-

Then we compute correlation matrix using the event count table and -generate_corr(). We see that the correlations not accounted -for by the Bonferroni approach are substantial and, thus, might expect a -non-trivial impact on bounds for hypothesis tests.

-
## Generate correlation from events
-corr <- generate_corr(event)
-
-corr %>%
-  as_tibble() %>%
-  gt() %>%
-  fmt_number(columns = everything(), decimals = 2) %>%
-  tab_header(title = "Correlation Matrix")
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Correlation Matrix
H1_A1H2_A1H3_A1H1_A2H2_A2H3_A2
1.000.760.670.710.540.47
0.761.000.700.540.710.49
0.670.701.000.470.490.71
0.710.540.471.000.760.67
0.540.710.490.761.000.70
0.470.490.710.670.701.00
-
-

Bonferroni and WPGSD bounds can then be computed via -generate_bounds(). In this example, we useHSD(-4) as \(\alpha\)-spending for all hypotheses. Of -note, generate_bounds() input type specifies boundary -type.

-
    -
  • 0 = Bonferroni. Separate alpha spending for each hypotheses.
  • -
  • 1 = Fixed alpha spending for all hypotheses. Method 3a in the -manuscript.
  • -
  • 2 = Overall alpha spending for all hypotheses. Method 3b in the -manuscript.
  • -
  • 3 = Separate alpha spending for each hypotheses. Method 3c in the -manuscript.
  • -
-

Compute Bonferroni bounds.

-
# Bonferroni bounds
-bound_Bonf <- generate_bounds(
-  type = 0, k = 2, w = w, m = m,
-  corr = corr, alpha = 0.025,
-  sf = list(sfHSD, sfHSD, sfHSD),
-  sfparm = list(-4, -4, -4),
-  t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1))
-)
-
-bound_Bonf %>%
-  gt() %>%
-  fmt_number(columns = 3:5, decimals = 4) %>%
-  tab_header(title = "Bonferroni bounds")
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Bonferroni bounds
AnalysisHypothesesH1H2H3
1H10.0030NANA
1H1, H20.00150.0015NA
1H1, H2, H30.00090.00090.0012
1H1, H30.0013NA0.0016
1H2NA0.0030NA
1H2, H3NA0.00130.0016
1H3NANA0.0030
2H10.0238NANA
2H1, H20.01180.0118NA
2H1, H2, H30.00700.00700.0094
2H1, H30.0106NA0.0130
2H2NA0.0238NA
2H2, H3NA0.01060.0130
2H3NANA0.0238
-
-

Compute WPGSD Bounds using \(\alpha\)-spending approach 1 with HSD(-4) -spending. Here spending time was defined as minimum of the 3 observed -information fractions.

-
set.seed(1234)
-# WPGSD bounds, spending approach 1
-bound_WPGSD <- generate_bounds(
-  type = 2, k = 2, w = w, m = m,
-  corr = corr, alpha = 0.025,
-  sf = sfHSD,
-  sfparm = -4,
-  t = c(min(100 / 200, 110 / 220, 225 / 450), 1)
-)
-
-bound_WPGSD %>%
-  gt() %>%
-  fmt_number(columns = 3:5, decimals = 4) %>%
-  tab_header(title = "WPGSD bounds")
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
WPGSD bounds
AnalysisHypothesesH1H2H3
1H10.0030NANA
1H1, H20.00170.0017NA
1H1, H2, H30.00110.00110.0014
1H1, H30.0014NA0.0018
1H2NA0.0030NA
1H2, H3NA0.00150.0018
1H3NANA0.0030
2H10.0238NANA
2H1, H20.01440.0144NA
2H1, H2, H30.00920.00920.0123
2H1, H30.0122NA0.0149
2H2NA0.0238NA
2H2, H3NA0.01240.0152
2H3NANA0.0238
-
-

Below shows the comparison between the Bonferroni and WPGSD bounds. -Nominal level at final analysis by using the WPGSD method increased by -up to 1.3× over those obtained via the Bonferroni approach.

-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Bonferroni and WPGSD Bounds
AnalysisHypothesesH1.BH2.BH3.BH1.WH2.WH3.Wxi
1H1, H2, H30.00090.00090.00120.00110.00110.00141.1770
1H1, H20.00150.0015NA0.00170.0017NA1.1363
1H1, H30.0013NA0.00160.0014NA0.00181.0810
1H2, H3NA0.00130.0016NA0.00150.00181.0962
1H10.0030NANA0.0030NANA1.0000
1H2NA0.0030NANA0.0030NA1.0000
1H3NANA0.0030NANA0.00301.0000
2H1, H2, H30.00700.00700.00940.00920.00920.01231.3092
2H1, H20.01180.0118NA0.01440.0144NA1.2250
2H1, H30.0106NA0.01300.0122NA0.01491.1532
2H2, H3NA0.01060.0130NA0.01240.01521.1735
2H10.0238NANA0.0238NANA1.0000
2H2NA0.0238NANA0.0238NA1.0000
2H3NANA0.0238NANA0.02381.0000
-
-

Closed testing procedure can then be performed using -closed_test().

-
## Observed p-values.
-## The tibble must contain columns Analysis, H1, H2 etc for all hypotheses
-p_obs <- tribble(
-  ~Analysis, ~H1, ~H2, ~H3,
-  1, 0.01, 0.0004, 0.03,
-  2, 0.05, 0.002, 0.015
-)
-
-## Closed testing ##
-test_result <- closed_test(bound_WPGSD, p_obs)
-
-p_obs %>%
-  gt() %>%
-  fmt_number(columns = 2:4, decimals = 8, drop_trailing_zeros = TRUE) %>%
-  tab_header("Observed Nominal p-Values")
-
- - - - - - - - - - - - - - - - - - - - - - - - - - -
Observed Nominal p-Values
AnalysisH1H2H3
10.010.00040.03
20.050.0020.015
-
-
test_result %>%
-  gt() %>%
-  tab_header(title = "Closed Testing Results")
-
- - - - - - - - - - - - - - - - - - - - - - - - - - -
Closed Testing Results
H1H2H3Analysis
FailSuccessFailAnalysis 1
FailSuccessFailAnalysis 2
-
-
-
-

2.11 Implementation of -Example 2 with Common Control

-

Similarly, codes below reproduce the result of Example 2 of Anderson et al. (2022), which uses spending -method 3c specified in the paper.

-
set.seed(1234)
-
-# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ex2 BH ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~#
-# Transition matrix in Figure A2
-m <- matrix(c(
-  0, 0.5, 0.5,
-  0.5, 0, 0.5,
-  0.5, 0.5, 0
-), nrow = 3, byrow = TRUE)
-# Initial weights
-w <- c(1 / 3, 1 / 3, 1 / 3)
-
-# Event count of intersection of paired hypotheses - Table 2
-event <- tribble(
-  ~H1, ~H2, ~Analysis, ~Event,
-  1, 1, 1, 155,
-  2, 2, 1, 160,
-  3, 3, 1, 165,
-  1, 2, 1, 85,
-  1, 3, 1, 85,
-  2, 3, 1, 85,
-  1, 1, 2, 305,
-  2, 2, 2, 320,
-  3, 3, 2, 335,
-  1, 2, 2, 170,
-  1, 3, 2, 170,
-  2, 3, 2, 170
-)
-
-event %>%
-  gt() %>%
-  tab_header(title = "Event Count")
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Event Count
H1H2AnalysisEvent
111155
221160
331165
12185
13185
23185
112305
222320
332335
122170
132170
232170
-
-
# Generate correlation from events
-corr <- generate_corr(event)
-
-# Correlation matrix in Table 4
-corr %>%
-  as_tibble() %>%
-  gt() %>%
-  fmt_number(columns = everything(), decimals = 2) %>%
-  tab_header(title = "Correlation Matrix")
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Correlation Matrix
H1_A1H2_A1H3_A1H1_A2H2_A2H3_A2
1.000.540.530.710.380.37
0.541.000.520.380.710.37
0.530.521.000.380.370.70
0.710.380.381.000.540.53
0.380.710.370.541.000.52
0.370.370.700.530.521.00
-
-
# WPGSD bounds, spending method 3c
-bound_WPGSD <- generate_bounds(
-  type = 3, k = 2, w = w, m = m, corr = corr, alpha = 0.025,
-  sf = list(sfLDOF, sfLDOF, sfLDOF),
-  sfparm = list(0, 0, 0),
-  t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1))
-)
-
-# Bonferroni bounds
-bound_Bonf <- generate_bounds(
-  type = 0, k = 2, w = w, m = m, corr = corr, alpha = 0.025,
-  sf = list(sfLDOF, sfLDOF, sfLDOF),
-  sfparm = list(0, 0, 0),
-  t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1))
-)
-
-bounds <- left_join(bound_Bonf, bound_WPGSD,
-  by = c("Hypotheses", "Analysis"),
-  suffix = c(".B", ".W")
-)
-
-# Reorder for output
-bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2)
-bounds <- bounds %>%
-  arrange(Analysis, order) %>%
-  select(-order)
-
-# Table A6
-bounds %>%
-  gt() %>%
-  fmt_number(columns = 3:9, decimals = 4) %>%
-  tab_header(title = "Bonferroni and WPGSD Bounds")
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Bonferroni and WPGSD Bounds
AnalysisHypothesesH1.BH2.BH3.BH1.WH2.WH3.Wxi
1H1, H2, H30.00020.00020.00020.00020.00020.00021.0421
1H1, H20.00050.0004NA0.00050.0004NA1.0266
1H1, H30.0005NA0.00040.0005NA0.00041.0247
1H2, H3NA0.00040.0004NA0.00040.00041.0230
1H10.0017NANA0.0017NANA1.0000
1H2NA0.0015NANA0.0015NA1.0000
1H3NANA0.0014NANA0.00141.0000
2H1, H2, H30.00830.00830.00830.00950.00950.00951.1493
2H1, H20.01230.0124NA0.01350.0135NA1.0942
2H1, H30.0123NA0.01240.0135NA0.01351.0898
2H2, H3NA0.01240.0124NA0.01340.01341.0855
2H10.0245NANA0.0245NANA1.0000
2H2NA0.0245NANA0.0245NA1.0000
2H3NANA0.0245NANA0.02451.0000
-
-
-
-

2.12 Power -Considerations

-

The above illustrates the use of the WPGSD approach to compute bounds -at the analysis stage. At the design stage, one can take one of the -following 2 options: 1) The trial can be first designed as if the -testing would be done with a weighted Bonferroni with conservative -sample size estimate. At the analysis stage, the correlation can be -taken into consideration with the WPGSD approach for bound calculation; -or 2) To adjust the sample size downward using the WPGSD approach at the -design stage, one can power the study by taking the minimum \(p\)-value bound for a given individual -hypothesis from the WPGSD table (with assumed correlation structure). -For example, for \(H_2\) of example 1, -this is \(\hbox{min}(0.0011,0.0017,0.0010,0.0030)=0.0010\) -for \(k=1\) and \(\hbox{min}(0.0092,0.0144,0.0081,0.0238)=0.0081\) -for \(k=2\). Then the \(H_2\) bounds of 0.0010 (\(k=1\)) and 0.0081 (\(k=2\)) can be used to power \(H_2\). R function for the 2nd option is in -development.

-
-
-
-

3 Conclusions

-

The WPGSD approach provides an unification of previous work on -parametric testing in group sequential design. It enabled more complex -scenarios and requires attention to consonance and intersection -hypotheses. Although detailed closed testing is required, this should -not be a deterrent. The approach accommodates various spending -approaches and provides more relaxed bounds and improved power compared -to the Bonferroni approach.

-
-
-

References

-
-
-Anderson, Keaven M, Zifang Guo, Jing Zhao, and Linda Z Sun. 2022. -“A Unified Framework for Weighted Parametric Group Sequential -Design.” Biometrical Journal 64 (7): 1219–39. -
-
-Bretz, Frank, Martin Posch, Ekkehard Glimm, Florian Klinglmueller, Willi -Maurer, and Kornelius Rohmeyer. 2011. “Graphical Approaches for -Multiple Comparison Procedures Using Weighted Bonferroni, Simes, or -Parametric Tests.” Biometrical Journal 53 (6): 894–913. -
-
-Chen, Ting-Yu, Jing Zhao, Linda Sun, and Keaven M Anderson. 2021. -“Multiplicity for a Group Sequential Trial with Biomarker -Subpopulations.” Contemporary Clinical Trials 101: -106249. -
-
-Maurer, Willi, and Frank Bretz. 2013. “Multiple Testing in Group -Sequential Trials Using Graphical Approaches.” Statistics in -Biopharmaceutical Research 5 (4): 311–20. -
-
-Xi, Dong, Ekkehard Glimm, Willi Maurer, and Frank Bretz. 2017. “A -Unified Framework for Weighted Parametric Multiple Test -Procedures.” Biometrical Journal 59 (5): 918–31. -
-
-
- - - -
-
- -
- - - - - - - - - - - - - - - - - diff --git a/wpgsd.Rcheck/vign_test/wpgsd/inst/extdata/adsl.sas7bdat b/wpgsd.Rcheck/vign_test/wpgsd/inst/extdata/adsl.sas7bdat deleted file mode 100644 index cb0d0a88730a1b0b74c03c1bd00192df92319586..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 139264 zcmeIb3A`OweI|Ik;t)YQ!32vXTohv@kl=1_17ps!-g}nt)8hA@7qJ-0(vzhiBt?<| zcalkkP6O#U-E^SSs5>MIFf_xEKt^;1nkAJqO&|#Hl1XqvCk_yY5IPV{SP}yB{kN)9 z_nx{>u6wIz<~R4+_m!&dcFy_gzc0tR{PBBV{@J}}ulS+QeE63xb3gF=t-G&$>g7Mw zac+aVz_s#s#r}0g;o|b_a${lp;{4p~%Ixy|N~7#i_)z48K2M*;OGkh5*Z=!$a4f!? z-f_8ebO;|a&u+GwtsPAqyEslR9zJ^KtHU>p|28QFkXT2 z3XE4^yaMAD7_Y#11;#5dUV-rnj8|a10^=1JufTW(#w##hf$<8AS75vX;}!V-%?e!V zF2!6wyG|y&@uK3yQ@ws=@v{5&C34~8^kI5jAcw_^<@jzrx9gYd`8D?adVY_*-FZE( zb@<*texDy}y|4KCn=e5606)GfAOC*uJZYL2y9=F8*ZrWLKS4f**W~pl={Ze<-v6UL z=TFmf%9x-lB;`UURBp4V4A8*n`+82dHI4rgy-)4+$Ml>(zUTZYJ?BsFIp3n^c0aXxUZ2tP zN9*rz?K$7k^ZuK9&R?qMbf41rU#;gqtmpr#=l#E==QiIr_q>jeWe+8t@7sHvd$M~J zzj~D(H#0ABuB*pu^!l6=vfrlHckA_A^?a|MAJX&VdVIAW6DREE_4>Xy==Z%zU;h=o z{&vin9`DrSyY+ML)Azq$-=FIBkL&RsJ$_cd=Rrq!JNG3$eoc?x*4NzyGM>xyc=-kL z{wwv^(BsAnWPO@?K7E0(ORwkK^tfB!cdH)v>h(kV{^NT6)p|YA^VjR~4f;MFH2?W0 z1?zprpK;alwCr8WD>u#U**@oPTE6MJ7viV~x4eC29;bY~eyQbVmv*?7rIluDx6|WJ zInL_&ET1pWt?>E09_Maaa&GqK>*w%QZtG1u=5{U5yV>jcNncC<#&IVdZ(5q&I#17? zc<=K3t!{p0+s^G<@$cD%g+*N3zOur{`2{)Ox@*VoXL2j zIxge=H*d$PwB}Zp7M54$R<^pOh54Oy#Pyvw?U>&w=Xn3tx%sWT=5Sn^pIzQMw_^t~ zJaAWI`+?P?rw$)Hyn5oMqlbUu&eg{9owxt^>i$!~ z3$z}67aIqUooJjog!j|e$agItKDAo>-0ow?j;tPN@C(SdcCo6=O#D1|J0rP zjx@@?VvX1ND;)9y=jZleHW=W-;S(oMHRfM^{MgAmPpmdh9m~JE@V>=;rEha{cb?d1 z6V3;=@xZ>jPHvig-^s>tS(8m}>z%K-^9Vlq%GLfCXYW{b zy1w{l!-CK0?(y=`&a2nuPm>=+RdLjboB84!>8^dtoI#UJ#|-O_p#&r z(?DtA$i6#p{~tXCK(?$L+rl&Gd&B&}gNOI;+u!%et;b$*{K)F5)e|RaHE&s6eR*TL z_rsC*v?hDsgt0~5*X~B%H+T4e+?;yf&K*9v{}}G`qqxDdoAw2umHhgF#sPZqSYvkn z1=;;RcX;&x-sY~`cXIW};iIb!5N~7S%kOy3D{gCV!gXE$!pjCkc5&P4;X4kUYHZy9 zicQ(ITlCt?@7T0wb)PKF{DC|7^Id{*1^3^sqbFBS(b8eCs~AUkFX^Sm#vPd5p_7|* zJa##ItBooA-kT4fJbViDXtcewdT{l`>QUSj%cu68IE8!i)ar9q4!>fR?g?GT{5|tW z4+QU^GmLNrACs@$h(n{*Zh%S5?>m8edu8>+E1tb6{QZ3GdD72OY{3?YH|;xmVBd)Y zhyOV^1KtSQJIwS$UxV>1VIgp15)bP68s~`LHCB$D+IM6yKH*pf(fBv{pT6gXTDeRj^6L>dz%>!JujFpWXGPD$EV{J`2WZXJlj1RBTfIA4A=LJIw`sC zORl?;>*-@lzQ5$UFS+hYuBVSF`TmmYzT~Er!KyFsPQje{Pdwdf7Otm zcNbqZ)bD@kqT%lUk6$z#|9S64Rwk*Wa|KY!*T3o}*w{Wo8v>O;lff73-O z7At=K^+V48_>k-Wl8c7pf42^~{?}YomH*3K*SKgn{&#WZ-~Zf&g#3dSR@EQg$De=y zg+C?}sd)dqq4Mv`&mO}t^XG<7*2kE^n%7v zzyHn)*6ZijK3v4Hv60#TYyaT*9pe=kufTW(#w##hf$<8AS75vX;}saMz<345D==Px z|JSX+BlUm0nd3*la_MmXo1eOLIRDl0OEpZp_Ih3*p4P3DIJtZK;x43lHd|Y!@WgR~ zp7=NZM{?l))!UC1zA$#p-Z1DjdXL|Fzo%nzT#hb1$meve@JM#~YbGb`($`+FXMT2R z`Ic?SQMGHO$FIF$VcYiQ-LuFfZR}cVEY7ZM-?@w4y@wz8$A37D$NCxHp4f6tr^#oB zZ}%O3+~Dc0&NV&#O&-2iu0K5QuYG=t^M;by`+d9F>TbbmHQVy9Dg2Ax@7zXDe`$V{ zoVqxVq(-_>d{|E1f#PL1r9jWIXZU@pVPJCWA_mF z>?p-&=gysb_PB%mxE3qkX*$QSEFTaY9=GCU9Gm%=-gS=`G?z1c-0$2+__Vh)r?)gG zz$=kEx!Rb2CDJd07p8Pbbjf3>;`mGh zpJ~D8)_q5hy+YC$w;>~uGfHFE_&5BDAM_f%Cs{9a;}?{El7s$J=kPeP?D;!x{G=Sy z8~x>Kl~%2pB+1Qtu*>E%IHV%d4Vnlum8+J!RP*4<@c3-(tGdq^6r3sp1}0e z+0vZa(wZ?!YIS9#LO(RWO7tVQ41JZyQbqCUfPOkkKf!u09(xtT<6_rjY&V4XWbe1v z_;|D8vq$l9a-TY5M-N>WgwX}Tv*wK@eD7v~I z8LyOGDvyxAr8kw~(*-`=dg#Zi+)3Y}_&j(}_{WUUPjZ*ik6#`FpM^E(M>y7V6(2_H zCHsYr7k4Q>8~B)>x=-lpq|fk4jv79YIxWTr%#JuEJ%oN}eii6vB9uQQ!eaVCcdFIw zPSqoS{MSY9B;S^!bIQWCVy?l-P~o5jK7uRQ!0Pnc)ReikL}j+H01c3_v(4h z-`xLT`2+se-qIrd0RQT2Y0ty$rCF^kU&>F3GH-x8r?q>l4A{H}Wxw_7v%Nxjhz^f#d&NTR0V zqw)vyt3W?j1@x0%7pI?=Jo@-sCQpXJC;bDZn@<`2Tvf#9!9>oXYt&3X4^8=N+N8m= z{QuZ~;bRZ)(D6+2G5xpq3jf_Rm*JEAzUgn!+NMB1(Bx*ew5IS?cwFx3ugCl<>2ES5 z`icZg6{DXP>>oU9!spKg7Y`mmgK&w`jp+y7|0LJlF#K(R{+8?489uCEpH(^d0iz$a zV}9c^g3n!hGJM>hDL$k{n)|PgM=i`Jg()=pm)74vsS4NjgzIOa~q$@DM{%^IW zasR9R60_%H*KBZuUZeLU&@Jhh{;bK568qo1a2We?4gHHb(nAw^v#~bz^J+((yOGD| zRB!he+^6>CLU#ZA8%=&dKUVu6oT?x{XnqysM|l5xELD_0b(*bKr&*K!wNvr=NyP{H zG2zw!sEI$p`d9zVX_N1a*5s<-@W8T{u?T;1-!b`-Q45__tD_< zXu&0YoZ{oQir(`^o33I{h<@&$)vA@>=!JtTX#X?0Em|d(^H8?8~Pc zJ~J6U6fBUzD?acKR>0?~fPT_VCHPE3KbThiAh0Dz!r#n4lm3I*FSBxg-mUzt{WdT2 ztcQNYKO>UH^aIo1SPq>u|EBOaw@>|>SHCcmKgr)l{WBdIx9~Uj-AeXLK|d(*&xm?W z!8QCpa(u24y7A9f`f=i~&HT>~9v6ISq94IW=*RHkGxKl0d$-;n!rzh?nSQV4yw|(%(qU#{YuPxBlyTKlSCn}G1Cv?HzJkx=y;lZ^gHg6>zi-R@%dUnKY|bWH#Jx*^pjMhpD@0b zsw-FqJN`S;6&Pgy&$L?z%k}Z6(cJ&PBlmss6}|s6`%>@!9siZ@JG7LlG5%8IPb@dS zaJ&3&YVjA5)9KwRKOWke-T%o4)qa83xUK$u_`g6&^icVZ`Bjkbh4|P<;`U3s*@4r# zCjBe@s^H?EV)|E!{U7xoU$;2B^#;nhm|a-fzIAqIV|K?p|3j9>{`zwJMeIxQ&sctj zeC&Yg874oT>G}Gi>c@){89pg|k789qekeZ31W@@d_|W_+;1k-H36?4*KR`V#JZqw# z&nf+US?MP+eN^e^i|>?maW(136kpyW9^+P^j5??J8D|&t_hp^kUt9b?xBuN|m44tq zX8#N+uoFIUQZ2jDG5jk1_omH2X!+>alY*KIYD-{c?YvKjZ(==%n?nC4g+Qb9)0qK2Gkx?k68j~Y7hDpHU!KvtmCiEbm26b|-wkEI^ykjdy^!V4 zi2O1Ai_Z|hWIgOVx9~WeyIRK6`i$_sbGK#u%^|QTRzIjFi(j@{^b;n3(rWR`Q2+8+ zswh5F6Rq}Ce|&5t_;~nkX%@*LIlAN}s+S5ruJyb8x=VIO{4*wQ8ryfyZHM?FNwhe- ze8X%52`bxf*3`i({ebw`9?G8)`_lYpOg|4Fkl*!c=USe{Pni6Z8x1gdrQ!qqjo0UKf={w_6!f!J{w9sUCC1;FeqdiR*SmVr^Q)G3 z^|5>P{@I@6bG_jMtxe+t(Bum70h(V0{UF3A-ByCn4CK#De}2^mYk=%htRJF&=1F#nSR!r{m-~8s2}f)+$WY_n;tXzX=nH(@GXh{2CK3w|H|oS z1CO8PS0TO}>euAriO~;2+6b@p+dm`WZ|RQ-E@@ZsF@A!4Ku3?So|R*iznyRX^IG`u zFCnuk$bW|Y&p5r-?icmXd`k0cPv`nU@-+3&Agb1;{7v|0kV&KV{{|jE&2LD25?v}8 z?D+3US73ns-)T*?@a&Txqv1~n_5OdO-v6ccfBpKg#s7I>FIWFp=AZ0(y6!jLFY>MP zRDX@SApL%mABc}h{2%v!(f&^{zY6jr)Q=sOD$1YQ-Bzbvll*Y^s(txAwJ*!?8Onb= zfIo43x#*vfvjfFAo#prauEsA<&t~$&AvX+M2`=MiX8%J4E7&gy=2roqP=2KMl*o@R z!vEcx?EmyjiVI>GbbmT0d32e7{|&$7`Es&7q8|@0KLY=8V)0Af{s`ldnoO_}}D4xAw_)%bFzAB%iXH&}joKtG#Rz7zdu{y$X$$l%qlgZWj;{}1vn zu~bofCZSPG))c=?o~-i6{F_eVxEcNUQ=aEplYUI}V>iL`!~ErQz4c9MC!VzYjJ!T0 zeWK}KQ(MRtO!+g&Z&Lr+&b5l^3P5e>d)>{`srByjIQ%rRsJmG@+Yj%XsUgQ_`oF3OZ_?y^Q(kUUVrAWR8jhY zf2L#pnV3I0c1^~{n|1Wn-vP)Uo}? zj$mhmW3-otRiIrRh{Uq|+79BMc#8cK!y9Ft+7=*)y%7>igEZ|K+zVzRdC+`ImhEZx%V`oakT4D?Taw=?e$5``^JQ zAo4xW?;}s8e5>%a1oNvPKiWZld0Bp6w>{IsvmXD9L+p>{k$`^b=#qIkT7A-0Z`JcU z`TZG@lPVZ-0EXBKMC`z5PxZf_`ppa zlkeRwB0k-k>N676yV4sJpECV8sndVPh;+?v-k^1Fsw+(#y{rjWwZ?*-O^ks@q#@{slV);$c{PI!R zFU-l-QAR)A^^6wuFTv?Wo|oD5+&k63|DD`^aZTlKu>aeW;B;`Fp+2LaAJhCQ;PY%9 z5)T1O700IweER*Hqlv$$|IG53U840F_p9IPzx=PVK12Cu*6MG<)A!_YF|Oo}tAFO8 zjzjea8sy)!AIReWtiK_C$;YhzO!b2$wO{Ve>Bj~7L7pGjX~`GM=V*Qv z_*;lif~AV$Gd0<2PNDvc@CoQ=B>c^({Bh_}#q&WNneX3oOLG3V8vjS!xt9Jw9RHV< zwEQNPKW|g{^D*4S1~iRF7KfBVC;GQYGYe30K{4(Nh@ee#gpCttDgv}7DRH9zCrb25C=kE#8S zt_(~+RGg97KZ0wD7*7R!Lj5{#K}HKUevEVl%ItrVA2YcBXY~G$$%@!D8{DAR=slF1 zO-G;Ak8S63x>k5Z^UKdSep%|DgnN?WFU*n7n*UgSSM$p=|Chvt(p3HXE|BkE%=ItM zA4B{F_Wz80kLq7YZe859ywX_N)mYfIxVY<0d$o-|{mUE#zN{eBbHi z_odHBvPtE~L(k3llZW6H{|xSCs*eRe=pR$?&(QoT$oGPMiKU9-)0#mA0Q@sO@_i)o z!+%5YNi4q)`LVJdDnHh}U(V~HAB11>{)~nAGV=cgpX+rz;y-qeSN-_XpgtCb6M_m= zEz7@<->3GA`rWGK_iYaR`wmML#RvJzEy`c6gMJ)(OA#K_Bb1KL2|tj32Y-jE|1bA% z3V#zMEWeNKe&k=uaoNi#6rU%U{*~7^`D@Mo&+vhKH~si>{ya6e8W4Zk{+#*7&SR$< zJ62BxbEc$rNjap8=?mie7g`RY{!;CiKtCP{{g7_SKmL5f$NY&(KWF}D^j{K<+?WaD z^2=7|ej|_1^7#EJ!)H3(Rd|8u1vEo#=k3^^PX{LdS8Nc>G$su(`7{!xEclYU@&Tl#dxr>s8%^rhDfm=BeDMz6phl&;jKQGGBLZ`U5!*6<;2R4-gW3EPsa2;6D?syBPoX zr>wp_$j|r?<3lNdnSOx$nHJ5<_+pCs+6w&bnE^gNR$oi_Orid4swVv{y-exmv3e}a z->ipz)cz5QDd^W0A9zUlti=Z&E%%d4^8PdF#m3(zGW~ios}EHD;D;;mw@`meY^enI z@!wIdzySNdJ%jqb8P$&i{c9xrDV^5){x&_P%D3OR>}h_<*FMHa=Mayop}#NLFJ}LT z%8o<+GV5Vkeyr+IZ#Vg#*C&zVP_!=MO86JzW1s}J|Fv#&wbK1>Ayr-qELBv#&wxM8 zD1VCiTVmJf3+XZFHGac6wJ+5V;IjB7zncH4&Auf0&XS^I!jy5DH2JaMWe_6Y6VzXd zweyUuK7)GT0u{&)Sp8c655BJUrGAc#_eWm8Y$^v0A^l|BzU*|6U*4&UezY%Ea=Xco z7mD9@aY@$YBflZXX#Vo3^kbU7!)6u5_!#4aKJxsc)-U_3@0D{O_|I-+`T^Ad6|Ij& zC5`%L#9mHO{4&74++C927xu?Wuv9Vn=|H~Y*{6Sv#J;4Y9h!e?`Tu7ue_7Y%3EJNz zNtXAJ&zfJtf5`I7ug~>k_{Ky(rmBD8Z}4xn_WW&4|0{Dt|K z?VpkDZ=&|gGi{u?{qO!l`5RmP%<1S~Dt|=(O1@Z0KMwOR6D(B}AM|JFQh$aX|K>>W zvHWHK8sl$w$bGw6?%S-tsf*eF=Znuk`vtc{(SDKp&`&e8UsfXYgMB)hP3%9@gnfw=n(oN;w=c{6n5ZAxxjDhd`u}}R^Ji+p zhx{{YU!vnrUQFZ?%MUdFv(S&f%lv0sGXCcN+U$R1WoUc=o=(j_)A$W?1S;5<;gAw6 zRUiE@J~O}v^wWdSNaT;#qUl8YXgYVT+_#p$x%;%<$FcgE^QE6s{)Y4!(yxVnOqpeA zw7<8$R{YQDYfL}L^D_$d({CEojsxa&F@ou>>KPjO#icTe8m0{j@2uF_?MxV$Oy#mnjTXB%witDNfwR2foih; zGuHoH>>t`6qyj!+{6A~aYb!E7j&23Y?0@1zI((jcoyada0?)e*XvZ&H|do8|Wv?U!VxQvAh+ z#7l&wit?v6_GfIvzN|xjxMvAIk8=G>@L~S6-sA_5BQ^cY z^z=55BmIx2e+B-Tje-55@&le4)sHo=1ND~` z$oQ+}_l37if?GI>&lL8Tni=xHkJjKmwiZ%X+82s@@H7mELwbw!9srqKJGPqlztv%{ju`?nJH{9 z@z212ru{Pze`)gPwQkKL{!#&-Fr_Dr zuO|IK0?Zi-e&!q=e&$U_*-(D%AfT+Gy0*PTbX{{Cx7H~ zB!4RS&k7+wEL9XA#BW*@zv+=bBjImJN9pH)(ocFw*F)*&^Bfb`toKWzuaMd74H8~ek53`7=LPG0~tK);ZN?r3od@0@uxd@9kTvd zw!d#QetEwB?78|4g3$@BY-{WAN`QK8PfB81;|3@SgqlefvyYUCTM(;_qKZCzg@o_Kp_SwR*rv5(SKNkDNoK-A8 z4(tBdS6lo={QF7Q>c?hs`5xq7vj3R%W2?_l|1suQK|eN?gO-BY*hldJdqWG&KKdDr ze`bT?@@&IL*8}pL@p+T#$H_4I*IND=p&#?_n}3sk-|IMRf71h&-xS1`!~Ny7{<4|n z|BL-kdQ1iVxUhc)mMV%5`v0}5|6d*SlcL^~*1y?1AFx2 zk@-jMC%cc4O!UN=gX8v~8j5$6-{xTo4{pE#z$p6gpX-{6?M748lzpz(E{zaW=XkL~V zMSXTE;1k*}Ds zLjIZZH~CzG`Bk8wP``FriJlujM!f<9?0<28seT-@M`G7(e1l%2_oS*9r=W5E%o(#U z`7HmF3?n}V-2d$VD*BHL{AsV!q009Jw!Uc7n=<}HfnT}*QGcoaNyJ5p{(a1^l6{${ zv?XQo9s84ZXn)c=^y37%r3`}Am+vjXr#AV4^fApJ3z@aU{tP@WZ}nqpCpJv~3hc{2 zH~Sy_N#g&s|B}Z4#c$vcAFF^*7+>~Ss+j!ff`IU>2_N16k77)`9u^mqll*TojQ@B5 z{cwICQ%ttMkLX?M-(P3)L+zJ8vHoRw{a6z2|EKuCere0#RX;}ZWCi;rjF0&e|4bMC z|M9E|AM6dn^Y}MC~ ztDpHw(SAvvVgBcQ{|xHwC;9<({TKb1D2czv^a{+cLVuvJK7+PNkJ8Ts^2;ZXUtS0O znBDKqKa<|Z_nXWu_?rx~zg#K(fV<`WXG|EI{V%^>j1MI5zE{TQx8?lpDMmlADzpA_ z)_+#*%c}mFK!3x}#PDgMzZ{-5;WHU9)MlNJ<3FQcfin9aa;iOz_{%inFFp7FX#D%gEv4D` zS1P#a9io5EEc5l`b?5l#hLi8-(?1rO?Ljgs{rcBP@JXOl03PRWRD9emlE3^FwHqcsDERo8 z{W6OB$LweewW5)eP9yA@gzQ!`)5co%Ji>%|1y;yBHvRKhgaZFh5fNh z^e=3Q0({^ekpISmNPb+7Cf{H3 zF+Gp%Up^{)M82DU-~2Otyx-_Y{45TeSn@bsPCw*$6#9XGlj<`hzpsc7=2roqkiSu= zH-=9K#wDIL$saTwg6m=1NCbRlj@rydluL6JT1R^oLwgew|XHcP06FyzRCE2F< zq$^sNr}wS(H%*4Yr__D{JSFkvt+&g40Xx$1L-m87GW(xIgXjmoZTP@`(f9y70Ui0= z22V$tUj=;3ppP~OB zUckT>N{#LLru~bofrm+9t6!QP;(63Y2 z&b$oEiVyZN5pS02wQuCJ0i7h2 z@|zSNv1n|62EIS6{(0T4ijUBN``=B!&h4M{QOe(_>zVe?pnu6c)c<_h!2FD|{=l6; ze;fDzlLf8i?*RM1gZfK6`}osH{QK0KjV6?!2RI$6Zwno={POAF@qFrP@lS^SV|0uc z`(N}f%U?GBq<*=-(EUjtz9p0Iw1)?z2Iv16(8HSeR=on&h1+pyOtWXb?eSu_$f!lmzpxqj?X+bdEXR%ModS&aX4^YKUC|Ib7kjW(qeg5Le* zkY~_DemR~~%}MN!6^m8IuF)6LW6*2#I`v(rqkEMez1f$1HTbjJUo)vLDH1Y!=4Y3d zhnDY(k7yL8j51obKf@l&&yfA){m+_zKgiEO?*hgLBxLnt@Shd(Gd$*3LI1KL(K;kp zsyIG~kCA>%_>5Yc!96HoTqpPKN!7o8^=*1RX8)hBeOYe5h<{(?yDf&{Bd8gF zQ#I^{C0d4Dm7l8Q&-HKl9No>rwqP*IIvu?YaEP^8e9Qj^dXriHv?k z|MKwbRKTYj>R(u@K75d80M`sXrhbU#1^CcwE<~9{Zp0vHUYj zR$=)A|1;B1*57n9k0br(mYR@WKA38Xv&^rfOfR-Lton{0a4g1WVONKhu=o1o=bz10ls}I*>o3 zr62VJl*X5lcV0*SneaE!-z>k0*Z*_9`!lu~rv&?J@#|kfJ&(oL0{>=CKjuFZ`l;wY zEA(%IiW|iT`TtGI|E~j|jciP3i78N_@BKll`PNr??_jm z%>F0-1pN!odhUPn9nnPmr0U06e!1FpANa5QxBqvgtbdH& z|6jNMBzgafG|-Rr{-^zYTQo0=OVj)+*e|AX&=)0GswjV&hW<4T{fqchOkT&X(HGKV z&};mLKT^JgIr4dFeMbHG7=Pk%SpMa^cgwgmkJ7)y_V*3)`|h*+f5>-=zkoSGz8C5< z9OhR6pRhk^`hP|AW6)0v`}^Qo4?fg;mDVHcFYo4cJ?Lui7^*&_oPI=ph(=}cOQsvt zU-GZ-U6P~bRi}?u{cBy2zl`2dK!vNuEWZ!^<=ZlPu`k^%746GBrH4`kWAuaerr7@v z{+T-Hhl)aI9{#aLKjuG^*=2wIF#YAq@e%$e_!R7atB*Zt{<969#^SFu|4iOLBl$C< z9~hQdenzps3C*tp{e=53Q5*X>KA@i|rJq1Q9!dPgtN$#0k>ZoyD*hSEi+J*fd0ku- zpAq=a*uJEd&-c$@`gxnx|64ybt%JGQ@-Kt>*wDVz`b!YgqZQ7<2{wIE-JCejKBpb_@1@3-&*e(8%#o{UAY&9pjLw ze{)&=n~#3GULOXZwd@zs-wORruzx0BU05#Qll=OpDa(D)nl1M+WjCYsTY z#+SjID&Q092Odim#is*&I(6Z*N%$IVuHyJn7GJI) z=k?^jaDJcF_nH5g9JC|} zmMY4hP(RkD`ms9fmsIomk}Q9$#C~zH{v;#NkMsTv2Q5Fz&pNefNm0(mf({tM*PR; zi_co}L-a4R|3&Z8{WG%u|7{uHpQ(Rl-CTx``)7s^vLz(G%qkeqNBue!L#u#K*dL49 zJjL;u0zT?L3-sfW#9vbI2AYSz)bO!c@YLo9|zsRGYe?h)8fBS&ZkK{M` zEw(>)9>4T|WBd(S%UWL!Nw4%H^)uw0te_v;kZ6DjmMVr%2lfk|_3$?j-atQ|T7A=l zCH+lmivI`x=Y!#5IM>_1O!Tkx4)vd5w*ZTe`LI8u_QwK$Ytg*S|4j3%KtHAu@;70r zqWHjm>C|SwsQ)Yp{AbMfH|u@-q)&Pt+)(j>wfLLp$EF|f@7<&K$%9s(A^a_Qi^j*k zlJ{p!&_fqeN36=M|4dOorukLCC)5w3{bwM5I$d~Yx~jj$Y?atGo+JJYdX3-nSIXbe zgM!aX<P$aC)JE$wpeZOm8~F1n=2t=fg#G2x3rqN07yY%m{r>0C=m$?xe0C`PG!E%{ zsDAL`kIH#EjQ?x^KCB&xrPC{am`<+VspC=mAMqQWM>d%`%Zz@NhW z*d*3}iR1_TGkEslGaC7Ef$}FX$8bIwKJF*=dJLcQmG7ncm->$xiL;g;Yx14B){OOE z*7(@PmVcSY$I|ba{erHH8vjQov*IKEV^^&{iJGKYeL0D#sD3;J`C;+Pm_8M|CTo2j z`q$GHpY4iIRzG9kpvUO`8RttsrTD;n$?{{f{mTp=M(vFn2eQ64zi9ZpFtcA07#2c5 zGjPm^e+HJO%6IX*rI_FH%1v{78Y}ZlJGSqfU74S2T(_sOynENqiM*;`m|*v1_uXYxB1hz4Ph4{>4f^50>~h z>xut^zmfM$G=V~V8TGL=F3L;fqvfAXTm4zSKVxBk;4Ht~{AWTxG`~vpljk=jSgJTa z$PaA7z9f7`?cemjEBwOiJ{r!I_5Z)24*Os8GgyDi=!f-!2ULH{`u|H_wZHEk)$0QN z;3MjvLH~cQKa)z%mf$M+86GvB73imsKZB);;se@+Ra*}}?m@vPc}y?;sC~IZ^J`uG z`I|;R;!V3kjFVTt2|`V0gJdg*60 z`nC3NO0~|`xgP!Cb?V=&EB+bi2PS`5KSBJH?|*OlTbIw1GpfH`o#$`*&*%P4ix0qm zHYxO@_CMxV0iV$RN#UlGuN?m!`3jWT|0Lg$eu-z_{XY`@%U`d23H4PnsXcmBzHsG# zmh)s7`*M(eoW;iyyZ>35Wc|y`AF+YQ;SqlkZQ%JCe{%Dzf5GcTyDo|SlG~ROAEV~h z734=)KjyGhQT~Mf|4r)uUx)tXUn02ppI3ZJ>-&bWUk2Hiq<@KgxA+UM|9-6>dth1a z58Xe;{Rhim&g;t^_J$Qy)c(hznbjw${)PEf;7@kTV2sXTsiOFxe{7Tb$M)!7qmdt4 zf0V}bEO{xUC0`a(IXd{6(K%8!R~``@GSo7gYNzohsw zCC_B_rf7J0~QTY3^;&j=2^?FVEG2gXB+^|G&P# z?2oH{>`XttQtp$3Rv#Gfw};LDOoeC6>9GHd_0Q1!8R*9q=qJqocUY)&ktXFg{2%R&eK)#jhc_iuK{ z%@S0gwP}76BAH4*8+iO4^Q(Z*bWp!ctze?~V1I@-?ax5}$9!e6YdmB88T1;z=Wm66 zDEW=g_wJJ;p9Ftuvo9$=z(_n~$}FG3zGOXNdAE+I&Bx@X{`f%pWuqTN1+w}xi!V!j zfabS2yY+^~u7$?@!ov2gvs+1Vw8!GU{V#7EJJ^^%c<}K4ef#gS>xKA0EdLDlPkVZT zo;C5e?+QNt2NfUWVaVWAKlsr9Cg;)k=g{#r&3_h;jPW^aBt7OojMOX#YE1D#LDk9N`KKu>U*o@8ekye@fQteQ$n%Qvd!i z{VxXD|HLLl|0>-7Tg^Xd@qdxi?qBrtC)#^m!QC&YCL_fseME?qv9m+4KMRA#bM&tjM--o{0nS6(1OXx@Q zFWG=HFEP>j@ekOKYv zvtO8gu>TV4VOf4`lgH_vVE)Zue=O9_iTr`%Ozao(Z?iy<2E~vi)aF{^+7*2akSk z(@i_Q%ya+Q5!f$GKa9x1LVVfwmrs_x{HW5;U#k6*k~dWMZ~6k$57%dCe_-;@6!$l& z7QYPlH}P1i7(U&07x_)-uhrv!9*uv~{Ab@5oLpJ|%$odXL_gL)qfktQ{)~)E!~AE0 zkH5(3&+_~X7y8ene{)d3c{zWN$NVbzXH2D}p`_pJ#|L~Axijehhxh=tIBA9bfkz{M z7KE>5anLe++|9MnkKiNvo6(QOZ}^zyZ>s;fVex@{{|suZEcyZBpJe}QB$V-WiVt+~ z3iyQmGn_7!eC_z}NLQf5{+IiI68HaP-~B%l{*-D{$JG4C(7!~!3g1q)n*CCje?PPT z*W3MX@|};^r%V=F?tlNw7XN>SzedD|^YF2Xe1{0p`Xoqt6?SU>KedwnwK0(I)C#Fr zelR{9zC;kFhd+%3ANMTPyE=MIy!iJwE8l+qugm(RF?@#3FAwwk7R}gZzJ&f|f{*2A zh<`u*p!N6NoXK~$$@DLZiZN2upRp~tYX5TdXRN@V3h`xx5aaj&nl?81A$(%~`q(uY z+uHv9Jm#scl z@JYU@_RH0IetGg}qaS2ls{RH3R)~+KFg_~KPiX(Al)~B5KZE%j>d%^}KkMahBf-b^ z&onvYlIs;G#pe&-rsp-~pD{k7e}y+I)n~9D-~sbLEB*Ym@waDY{4ELX7mbfW5^4V> zjsHW3u7FQrNRj$w#%B`w%ag?1YT$3F)|a~N7Nd8TB)T{#Z1>3jEDN7PJltmMTg=Q@{t^|9k0YH2Q({ zYtud_uA%W|v%5e4QO_Xxn&=1hXL~e1(DVbw2l+GnyU8{=>b@TS3XA^-`^%wr0r*JP zKgl1YX+RQn`19s(s@9(|jNi~!S8;p@nws>3bV}&PudbmVxS0NSzW$j3@`wF1f`l2{ zCVz_f2!Hc?jK5uz(T@-6n{0n=WNH-qGhlud=qHpv36?635AthKzsd9y)74_vEq{AcHdk28EkFEIHt=VdN}k2_-gE!W>t)SwF0AX|d;YuNwD1W@`> zTrs~2_!vpk5WFsx3}^gzq$@DU{-1{aHLdzr>|T#uv%w8|jo#y*DEB@2$mKKU-3$|04Te@e%u<=2t;K zHkL^%;IULue9(UhZqb_buY1LwPO$j^4Fa{QYB#7|m+c=@k9-gP$A*u|4?dnV|BT3i z^h%9ip3e0zhmFO64>`|de{BAj$q%i+{G&?tOQ;{G*a9tz&jdDToapx9GZOnUy;bQZ zt8cp2GfcL>&+gNDK8$|6qjdjF!ACr0mj5rmul}bQeE?# z(Eo2nzDM_Gs8-)ZMy&PENU&5g(Xh5zr5L(!rx3kQ2#Udl&pK+znlt>ME*ePX#Wh@FU9=8YW7Q*AM3GH zaeSa3V1J-m?0>rVXukR8+;?bvU|FueN#i&02h^9}BuJREiqBBL$*4WNjmP1%50ihY z#cy)^#r<(kKNi0MJ{lhox}*73uwTOXK!T-;;nVIQzr0hE|2eUJO|AYciw~%OGpqk! z9Hu`*sr-@t8FYs@M2>{nTYP|V`pPYekLquq*7)+-JU_#me!yM-nUcu9EYc6=R{@`H zAb&iTDvD1R^%>Y7xEA`MO;vbtjwzo5KD;iLS9C<_C#qkcFMlh~ZxVbMkz)P~@;8}& z9=D?S2p#ylG(PZ9o?lD3r^4Uz_zm)B3jUb{^Q(kU-rpqER!X#70ws&&RIW@CLm`@3FchvooE)&D&=S$D!oMp!+}9zpOv0$c+O+hewL{fBId^f64p* zQQ%6r61tK~e2gqjl^^2INMRgS(7!eZ@qdpJrzn4de;?J$ef()8`f;*D_)^v%8(u=e zMdiode=X-j#g|L%|2<;ANPULoXE1-X`q*Ck^0!t0N;(La<%x6QdvB>xI zsEsq%j~xOdK!xKkoS#83W%;nP8LIXr9PZYv#lXcp>*`MJe(+^NTlhwys{lC=JraxFI z|3BOxE5*;m@tFWVYG20mvDh_R*g>!Hd%h`jAp~kZUe=Fbv5fH@({^w4_|2&fTjr&u< zhxVxE`6R`C5tA=|Lax`ke}+grtDj-HgZvrcZ`QwA^aKCDSbQMQuT4Y$jONe4|E&6( z;)?lIurI^<402_~@j?G)?BCpL|Bpn!_MZ}bD7lyM@wdy-{Lkk;BIij>`T;utME+36 zQt}!zT9#k?TC;z&{{OcvJ`m&wqBo}LZyf(8? zCc#q0@adv?CZ2uxj6}YtUs8OYp!9P_`^RekzvM~hbbW@2j}5|y=ttxSdBjM5@R`;B zJBz1^97vvcuZ+j%@k`3V20oA)v}>&V3;LJ(&s4r+eii74k_;>mnqaB=@Igclo(Fm& zNH)_9>-$E75BlO^ft)w}%RNu#pX`?7XaA!dqx&@U~E{&I{@%pQqd<1yjS zpx5X2NBo;6@nwH(){pmF{h89Su5+@}`ZMJDO_X~fT#X#h@~^yq`34?8^=Gd@KLvbB z=%?F(cc#;i&q(+i)jm2rXmesZI?Xr9^n(Wz&zIdW`AwzxuzzNc=x-01|BQdn_BVOB zSU=<6Wd6^a;2ZAYkfvN{xjuoOh4yrF_?akzsYjw9fpti`4jk`h1w`IFFF9# zmI*${FDLy#^2-bQHO;RAe+%4|-G6{pw$@_@q7fJlgPy^`ALk z`BO?iAwJpuXN(W}|MBsp`On1uci%AmI`=>On=HOYS!aw7WpWnkn`nL&@Coy0vQ$c1 zukmBFD^OY`>h= z`2XE6^s>@TJ|+)Xf07_S2|3uf>tRwhW&aphGSH7zeu)0%Fuw}-e<BrgvfUL0JbceBp7bm;T70`v0NvQTfilobAuRXTG=p@-umS{=eMAM+bRk z@`GYWB0s1rsr(D|8H$hQFQfm&u<{*C6~$+2rq!B4{utpCvqxgrc#ilp=rwwe_0338 zLr>=p{WJL3_h`{78DR|I8$IpdV-QUG)sJLw1>b&-Y(WVB2S?Xnr~L zuY&xb`Bk8wuzoB7#4&u@P2~5X`BFXfvrciDG5)6b_+`c^dCVsTFPztxAIp-wWBkqZ zFY($Ke-l3CFI9Zj<@rqs8dn?rTo9!nL&r;Gi| z@$BPoBe5^3w=Vs7dO-0>Udrd0{r|=H%lT0BGsu3S_&+}qiw`jUSpUB>%Q_y>57H@( zU(V$H%iLU!kM(cP>oX)i;834YK|cuN%hckn4<{d* zR8f2o|7=qHlkgd}e}Y~#E5^>}^l`RdmL=!f&qXavp~GhuEwY5SiW zJ{vr}C;1(-|MUF7BQk3KJvK~dpuR3A9ESePkUV|`uF%T;uR>f|3PuBnF)H< zbpKy0_rK)< z|2rf`ihZg3%fo(|$@X6o`f-?F1$@H(u}Lid68x>(o}gzv^keu|L?GJ?f%}V<-*!-K~KTH1c9>MKous=g6f3$uEabuM~S9rR^(toIw{~z{0&qTG} zvE#!CSD?)PCpm@oWq8(e|5MR4O(VHYMJ^m?vZURP36p z@!I+^?MFfHO}?V?9sV;q?|TfjzwZG4#^@CJ8`F>V$LiR9qIB?cX1_c+qaTMku>REq zKAK;SNM=*!pr6D1D(GLva_OrQ{7fHzV| zf2;yN4=?+0ozovy`(;la|M$0;{2>v<@+XMD2tG8w3iwD!)&Cge|FUiSZ_)veWC_Y{Aw{Bhh?P9^jqenZ>r_{b2Mt>{!Z%Y15 zQ9s}_i{IRB@f*P>ol`#SW^(xx_Gb|L1(s$}KcM+lpr1m0AeJhM&m{88Cy^Z3Lq8+Q z&q&p8mhGSERUa_=`QC2}ZmzESK++Ewk%Okc$$fA2GfVpWlK=1iu=8Zo5>$OZeEt(*ZfTn`-i#V`oRB;J&pt)cxBW-gZ$bS&CB|3()=peKVg4H zr%NSYJN`S;6)3a+N&lLG{FqVs5y*Q$sY5LdndOiIw#D3vB zebM+6pFLUQ|C?8IJj$PbRP)Ck2>M?J{jn_n68iC^&#qxh@B{a@%Whoy?~Cn#Tt zztki@lADD;B|j%e*XW6l{R`V4dl>tFE%`3`m&KP^|AK$NXkQ9G>B}sBN!&~w0GI=7 z#nd%c>XWFGY*X+Ny@2LdLB5CfzsJwS@tFob$j>185wj&@*JNyK+n3b4h~JACEgzGT z{Qr9T|7rd||FX0GJ}m7&X8o~x^2`6d`DcRq%g}$E?Vn-#vFg>BUj=+7!uT?lDvA%n zW37pP`92!{_Eo{hBfclAv`3F>cVGFR<-8{QCFqZJ*7EIL+B}ZrOSb=C z9v{o=W060j^)rz4nm?m?9T3hH_*-cIdn{EPA1GiG@Nf3$Un9ZC{F)v)rj8zE{LK$j zzq}TIV~*A-ID4JtH<|xg=8@+I7H%0VRU9AC&ty&Xlia8B=K`gly@rqSw-2a(;Og-|2lZ#? z3?D}8f&FSn7UTc!7tO!T>5vzNcg-IxEZ(?28n_48C1Gd{>aBa^sT>otT87e{Jaohfx->PK)g!p8vM!t9a zca$qI!2WNyQQz0D>HhcVC&BZuK0j_w?79!!DA%ukhaCMd{HZ+tBKALXq|*iYu}SZL zXYpl?UmjBVvDnV+%k=9e-{Ifa{g)^b!}D^Q*M#{EsUK78jTnDw&mjMQM(xW{`)7zB z(>y$4v~+Zd`9oB`FaDNXcf;8K<@iYdCE-t&zszT^Rr&rEy-%#Z+^c_PPwt;_P>eGD zOXWL7nt49T*QkGS1$;vPOj@FUb`Ti37yHHJJJXNF$1?w>+L!J#!hiSd&G1QYH~ovU zS%43i+f25<+|@Gv*HywNq#uW+isFO)XF9b1OfCAC^)*5K)zJg?C9lub%Y2?3Imbs= zPyaIYp9z06W1GDJ$Unnq@F?bIxW}0M$^A19yjkc6Tut#o{BlMthov zRTLle$LdgjtUB=1asL0y?pE3b>{3d@ezY6jv>~HE~`!gVZ(`}*t9~%JHf=`ORpEQqTTIt6f z7W!FG`g!uF`E}=pi7yY(4>-R`?91Nx0FBEb?~RYT|DXFtWdEj%jecNQs(+?0zX|iJ zKtJ8U|D0f{V)TRb4D@GE`4fu;#IDJl&LcjsP4T%?@kvYK1GV}$d9;biACX44i~XPN z-*gq@lzzwJYdQV61(QEOMfY!_owj8Sguf-2Uj=-^_>IF-#qmLDV7K3YHWK^ay+ClG z`cs*Y_CH%(mh%sPQm+rg-`1iZ@jsjW!_uwcUFH{ ztNf5VoibV|nU3%O@9x$3nBD)+=5Z!}Z}KC*|J~M{Kbd}vMcY+<(bbcKYdP|0Tj_3IcwrpMFMykJG%F^oc$6(-3@;yA+?H{AUC7<2=8-WAcOV zkB7~EG5t&QW6EEq#d66t89vG1n14p)JDkUm?}h%pG`|Y;Q;;8&qTU<71U@jG=qdCQ z)3svPcn3W4k5aqj@)&-{S1n8ydS78uJSa+qcec#qVa1#eMr<-Z*x!F@Nyj;r;ve z-(@d^{jm}(RScgFlw&;W!6z}h|0cyJ+yBpoXvdoRXEHuaF=wrQhJW$6*8i_F|C!K_ zzs>aHT^aop$A=zB%NAuP&zY6$-L!uP*C_X4{Li@6MMe@3{! zTyjYqpKf;&_6wXdb?9%&Rf3COQhZ!b{NMC9_-p$61C6wQ#-at=SzADSK%zR=D;{cx z{JG^f<@#IlG{Xn+<&1us1^JU;eih_Tfqt-5ee{Dq9nDG9H%$T`xM-$F9lx=w})yexho3T=iC-pG$YwLO0zlo>->jzL1;D0XUKc^2=@^2RW&!1A&(TyJ?Ux70FAN&cMW6`tk{vV0` zlJ&m;{qm&Fs9t(zSd`H~*+G!Z)^0>_JnV(%+9!Y;WlkZvnCG(#J?eF_IlkaNB z&zSzTnBD&g5?6&k;l@|~g!-4Z3{^k(luGiw5WkG|Um|=uu>a8jfcaC*9*JGEg&g!6 zy~jUVa7m{WpR)RYKaBiX%f1x*KQ!jt@l}x@=tClNQTZ{U_?*uB%Xv871s}vOrGAV$ z$rSyQm|q3?9_}CGuv9Vm(V74OO&~v(dK9N+#y{L`vyG@W&fAU zcgerx-$)D})4y20pEUoO$Pe<*h}_TnGbCR&`T;6h-v{~Ll93DjP>$51|V2e`|?LUsR4y7x=(`R)_uKpP;yyAFa&(PlnPD z2H*qrO(Hf~{if(|y3c*Ke|g)}A|=Pwzj->Z&j{^HbQ;l}8b*>o(+uMO4oelIpH3V3 zfo%c@{|EFl8vR=9&youjC+KOsK9?@@dbltAwj7h1;y3Kyl2wX?$C^7=FKr19r9e}?>o75H00zmC=jM?aAXUDVCZD&_ugWGm{ zw$XUn%ma3XQ7RHYA`yvz_>oBbFcLo_{=g4Vj8p<7B3KlK@CYIi11umS9tJ`Z5+}d4~52BAB z`GJQYsRBF(6A;9*o@;oXTIy}=yyTQAE(-(-1PTNS1PTNS1PTNS1PTNS1PTNS z1PTNS1PTNS1PTNS1PTNS1PTNS1PTNS1PTNS1PTNS1PTPcI}msj9>p8|;+xIg9(&#J zT`Q&^879LWo{T?a%TJgBpMAibziP`f{oeN&!Yh1@YYy~rhv~vx#-F!R=yNIbd#^WD z-FEJz&~K&C=ThkR4yCl8Lcf(lpG%?NV;o2NpF+QtLZ3^a-)Jo)y6@t?G-Wy1L1oxr6o`UtE4rHMxZ>))9mrBo9~ z1M7ccf|Tcz6ORSfzozT2PrN6vzNvP3f>pr#`M34`KR3Z9%)7qfzcRrp?p?p8`Oi$e z<3RUcns{4a{Ue(H(O~=x+k5cNK>nuMt8g&=`%_vfrjL8Z{Ji#C*5@#tT-qU+1a@se z@hkk$7`Tcq4y5n5; z_?qks)&E)N`WKz@pW^Eho~itA^EH`vy8aAb+xz=H=lYMF>n}Lhf5q4Iyr{jqd`%$K{(Wxm6)vX>>yK~qP2Xi-OvDl&wp6QqvGM$316qsiCZ6D8>*ATG@k{+|lm5=G z;>u2QUWV2Be3Sl`v2v^V9JE*4twtN@+~jlP;;O!0L0X;usO(C8wf>Af&tuz{>PxM5 zeYK61>i9Rm+*)m3T5dO*t@+mKeB%NZ#`C2*wuR?b69v6hUszbeHn41?-N16&JJ((= zEne$xZ1=ABx|`;@)!Xh45V8Eljowf0bW5$BD?ib_x;^|Gu3d%tS{GLO{q^p(5`Hb6 z-R$q&Ea5%VZ=>|mvE?TLRy$X_^gEr2((1khxE8fJi?l`ud(gjLTIg+VZI_xa-Ry7e zY<5fA{Zf0g+u6Q>{T(U0)JZL>`_b6h>}>b?8`SQ$ZKZVVTIc1hCs)=x8ynd9z1H!b zu5Ryi*7r#6HT8L=v)Q@P-R^Fd8r`j{o4uRFfbiJptiQa~+bUh^tnYO3e)zuHy&L*2 znm>hiP`a?$TkCC<^vz!HZ(4Zi{<(bI4wXUre0O83zX@RKV--W_ZLAGs@=@>f%$~z=F#=H?DNC-B#y%cl+hiO8@50x&dopy|V`JH9W8x z_&)j=IKGa@z-8*!H?mE+o>IbXcchqgCe9Dm9@(?=b8%T9@c#sX2lcvo#leqodM#7v zB86^)D7PK;kZIVZ%M`jup+gE?y(PJQLoGfF1PTNS1PTNS1PTNS1PTNS1PTNS1pechnL=SDCW*TJ;}qt!1^Dbd^bZFhTqRk@-($K|Mf}A zPHzYIe@@qLOulzd1pfDL69(z|#$s!JWpU|3yBtl^w)zwJc_J!TDNza_SH;xH6EkIQ zOMLJg=9~E<;dJ*j<%eL>JkJa5hb$HjAs_6OrIcp9(OOzv zXf9LU8;{R_<0H?nb~{`BjVKL?+O#eyE{anz4)DPKNGwn_@gIL8=q$fs&H(QhnEJii zz0xOgd?eBAkK-b7R#1(Y~uLPm8&!ljbYH-P7Y~hin@eRUc(pRoC;932d2qH^LEV86k1f*a_A0 zv=dr8;C%)Gd6ALW?dFBV?wUp-<``QhUnJ7(L^Kl-)DVV*m@^274=@sNcu+ge_10e0 zCUd}I#x%_qm2zA=Q4&sz1}z zU-S)NkF-pve>3($d_VVVH#hCTmWlNUN2K{_N19Ajsx@K&;#p7a&|Xxr1y@fp5~bXb zz?P|>BOH_jax+Tk5z znrPd4Q7aRQVZ7+qIG%X? ze%T4-a`Z=n0L}SG9RKfOK0BrPyD{9pBOK$e|AjICra6OL%*{)!2*!&O zL^N$|vkJ?E2qSf}&e8`*b3@{oMgo|lI%7Hd+U7JpjAl*b0*=2PFRmAlFcODtzjDh7 z$uk-W%Tc_`a?HviRU%`X!B-}Y`Rj&8!g5q^vmAY8BF#=zW;qdbDJVNO!~OX%pVgH?B;v7t2IGIpV?E|5yP-%p z(QIrnE3-x>!h8q3Vtj`DZ}uJeN3$+R@Rf-)B&t>R9V^4*|M4uQ;;fjwVxQ2{dC3GO zDDbAia#YtXM_(k;w4=&)!j*|Jk>Cu7vg7~T*9VcvGOov#H4-kz%q(V&vt!DUiG3q0 z6V3iDYsKI38Iwy%HX(^d_eIHjzdWI0j`G!*qi0<2Xa~Ns8RwX47}u9Mi|)h|`yydt z%&(aK$gkRdHF85@K@fDxa{MpL(KoV6MZ(4t?O{8yFA_#3F0i(4@>z89iZL&D3=+&y zSdQM>;n;~inW%6kBxsHae%K(OB5S|q24x~kJAs2yl8Kn(`z=RbnQ$Vj7>TID(RNTK zL>xE$iDzKZt|iSeCeieL;m4SEf-U9mcK!9f7D;0cUp82aH?vl#wY>BYTh>6i9Fdrf^i_Bz zL}0$2^Mm4uwGS`kC4KOMMnaBo^hF}gB2{XUhFbbsB;%zXV+5YENSqy%i7ZDrz|kyo zlvT?yGbE7~cv#cF|X)V%9UNWKBUo%JeXXfaw9cli$dXijIKt5z2}dSQ>apHQ z9P8P5!q-lic;X!f0re;&0j0cT0$Zl%4@i1UQrk(IWX;us^rV?KcQ4aO6hj`hq+2+L8%9DT=nX-HINcqN3R z9ph!k#6K8IDZZDVQ2t{*m!tRiKTSKTHIqB`jxkMS#j9+^6O6=eZlhjonaqT8IU>!^ zcQ~WoSUalIX8iB2m>N$e)I4iPi;=))l5&DcG`cU3JR!DB6-GEB%@2uGnXua7n-elI zCeJb1nIBrGn{?MnG`cSjB(PlRn2w zP3ahJiq_%qT<@~yIvf+jJ!lY6ybb{1Ol}s5*Jd$CY5n3sk)WM1)8%PIqRP41pjmIb zLIdJ8Awz4uv(yf#3A|~vVT?UTk7NV=WWuq{F%p$BuM-NJ&8l#}ew?)R5i5V>uGc>|s?eMh|+Dq9d1njqSjAmthNG9aDP$V2Xv4_MAuX+#C4)q4pA2G%K z!c543Z_ZLXuw_z?5span(+($w8$g0%xF96p&p88PSF>UcD`~zaiAMKD$GCGioJDsz zdTU1-647*|`y+zpdIe|4gk2|;pPj&#siPwtk>)28j>U{+q7rdr6@-NRcg~K*an8^x zx=gd^6^%s9F`o7IMIucmDplh6u33h$zmzLAy5 zgs{a_HMW?$d5?O9%P})MQRTJX@|mC*^B*}AV%M0W*H5yJNi^lN8k=2Aj zKuuaCN`pvbYB4`xWP&+@UES)91bYaqm*0^%{*S#>b=u5kxoa-=l|F+xuWVL}j5&_~ zlXNbLX76}RJ;auE4VNPl{q!)+HrIHB6E@dt*Zs?zj0DDT1JP`j(uXY*5+fYFk#O{I zR*!IIafDNjhyeoYxk}CCW_d@Y_z)wJyO&ZfN9y`P-U$&SQ8~$3>Y$7y{HyU&GM?+r zd%fNWM{gt??TC@UMc*V5073hD%FA~FX{QwfYu2%*54*4uw%8%SPi|KMic>KKRu8nVOrY;bima1pbYFCg8ExYl3o30n#_woB zS~fBf*}dMr7SqfzeV!w$KV!=Y)!e-3ltu!Wqp+FN?2wq^nH66*ko-iHbdMWnTBOHB^aAZQi9W&Bz z$K;s{XRJ3~c1$TFql)Kp;C601lCWjMZG9=#7GR; zi7exK^v|Rnqa1zLjyb*~Mj|?CkO-UW6{lDh>>Lv;O| zV-6Hq#oAF#dE3^$v);ywe#h7eyDJ~^^Brs_6myjP<^liJF=^USE3?IPqV0W=FusF# za!EduNgIf)GPRiOJ1nPo&$q8k+?Vmc`7g*rtKK8M);prL-aK=meAiqU>HCb4K56$G zquodv*Co;L`RHTJv7WU^E=O$RKzg``M76B@NBNuz5YZ8{fXs1>i>qWg<)Mkmn2%cEy2>U=STY znMl;JGMI@lzj&sELe(IRB^N-}EbmFUb2}`qc>kuE&M_8~vY6 z|7PRy^|-Q;dN|#@=RzA3%4TOte3cySdreuM38e!BdV(7Dhr>Vzq^hW{c6sGj zS65e4Q@gypR8>_~QBhG=R=zsAl9H0FtgMWTjFgm=xVX54goKEQh=PKGqN1XZkdVB* zynuiJ2L}f)FYnEpH|6ByfVeOg7M829Y;0`&{QP2KVq9EYJUl$CtgLM8>}x-^aIaqi z(V;^#(^Wm4pzr`yElnU6b8&IOlpOv0@87fYbE3%L^_^|CTN;X{Mw`34`OR-mfB!;1 zdo;N?ud1spXKk)zgc5VIlX0+-bh*Rhe-DK51Dx%cBZ7c{dllX7eveBYb+pcZTf0i9 zm7OyB^^1g?ql}rcYG$(3Z3}*Hx8k==5mirK^}qj0SOwf10AF{&&Vo8As;0MxNloe9 zUi0|i>CBV~VY2&+!zAhCOL)hAE8ygn#aAC#x zGa6_k4fF;-PwgHaTI6Q}=7zF%*2*Y-`=SR5>S`&kUIacZy{@H3?dEXJ#;jqm|LEi= z{LXD*R|ko-_|6YwALhQgmle=D+tOPZ)7e`xn4*53p2Cu2cv4~kYZJi18t`yJ+E~gO zqvC5SnH7*!_ne@jLV&)OQ%N2W41hx(#vXtoODrLEpE7&sDlkq0;B;RfFJs5^0#X#w_ZIg zK(MKy8Swkp$zQ5%qRn&ilcPT;KX(^SpVFV*!VC+nxxo3^FLCDD=h(8WdM z^?5XL3NcPhnlcVB!8A9hOtS7#)-~phKew+Wc^UmMX!k+;!<@vd`FYme%Xo}Y9Zz?} z(y7wk<-@VW08{O*F@J>8uqWKiWMiglbqe~!=|S9_vxbWv+~0USyob=%QjGUk ziYiXfTlhpBR(-0Nc!axwh5sZs;=SRTP#&PZBfRc5vC@FN7fsbbA3qFP=%qhiqr3!Se zJkbt<+u=}nPoyz(``QDwaMTSb0r@eeKLA#l32Q7pe&OFQF{M&HkB0Pv7x_BH9tK4A z&{iu#+(EhynSlmU4+4tM-Em}^7w^!{e51h#C0zH$!s!ph!N z(zpsXT&l_@_*xQPy`7UxM*6oG99}c`aC66eSB|l>?%X#gdQ#J%MQ*yLI(?2}UgM8Z zHN%9j)MSJLu0g(@K_GA3F`aPc-su8TXuV>FE9oxlkK_jwX|@;`Hh2kNHmk<9HN)Rr zHC^R=BV|17cJ2=9Y(lMUS07bvKgmH8Rc4+Q0NTrL9|zj2gr_O0b0(^34;jfxQTAeJU>odn%BeA!4+&xPQ@ZV@fqzR>UKB+_}`8TX!aH}~* zDMF_-goJ4t(b5y~IwDbzgsCLJD#}(ow90rBA1ZZ`9VE4wwje@9=UC9>L(y&vb;R4f z7uuT3pD0O`kRXDH*m$Jl?&$3>fxZJ|%`?pn+kE$!iTDZ^G*H`FVxUo75=*Rw<8|x* zRZeL9^DS#K(Bb_d{#q=*iYmY5md=RC|In%I%dMR$K{4%c_fXR65sHuh+|A+rOD<(P zc3w7G?3sdo6DtElTX(~XRcl)auOHINn=D&uZDbR1a7V-v-#S64%NaJKrCps*Im^@w&e~8Qho2uOuG>ZQvbHR(_#9gY z{gL1fG4ZS*ZjL<_USng{l!&br!Uv>~LpPv`;+f|q*qF@8w3_E0;$-5C2Q@u%>R_ro zucU%j8_8w)l{quC;ug#gh%6HVkyO?(o+bZ88H^rzS~FR+I#D@jFPVT1q~E0r5mk{mfdDNg`6&w6~oRH80Os{V2B zM>a$o2~|~i5Y`-@{40`#)8$9;FF}%#03{}P{@yz`+1M7YkPpfD41)tFeqPpWO0CtfkCv$< zUB2bvjiDbK`^{vg{bpHgAa+Dvnhb@03-qI3we7qu=y^$ZE3d~ff2zmV7w4r(s#gpc zB>ObqwJik=CIS>(SVXA)BT*#pfe_mu>P zb>bS#rYbDx4GBJBdV^xL=uHQc{-W@HI%+9za`eTdjN4Iu%zHeDaX^8jE{h6!!eVjk zFtT|8#Yumu$|t2kmYVD$gshtq^d0GBcD{wX)ehe9e;X{!4o3=7{=HAV3u(rc5^71D zX*WNJlW+PodPh2PdhN;t<#xLE0qbG2cHyK{5oz+3)_gM!(VS^q?g}7@`rB!SgajpH zFdqIbv!`%kW)&NxI<7WuL|s?8v@S(TCWy zjSG&*(4&y?9XFHySX_WzRbQeu$!wWRegDQGSQn|ArO{`*dY5lp703!Hpu(~gm9q}`@W*a>+*qMu)$XiCyui(YD?y7 zGm>EBP_HFwDAwtlF7Y)V;pHkf`Hi09t9$#NBzBeO_2qDXvUKnwIXv?8ZcPQgUdT4^ z7xmdSy8LHDXV&rplcvpGtGwWXqz;mYZ}D&;BF^AC+=M}vj{a3 zR9Q>2{o-qyRUcHuF~9CW$V6W(bHg7ZEZ&QSz^#*jZmiA$%AW|d#agDXFiKN%)e zGe4T@Nu9gvnv_F3JrUB)B(|t^BL}+tQ2M!@kKm4&fu*|hGNJ)l_h6al-QHsualwRA zN{{t5Z9g^Wb6@EKL~^*9ohEGI_AJZS&!&yZ0SQ?wg~h2q%p} z+m`Q?Z_{6bX};uY(M=M!+{8)SH$qmx(9v7J!y_{7j}uCkMd$fSbW3h=;+qeX6yx^E z{Ht71US!JEZ|XHMCdIZ8{T_@)XpPb0bSC~H8&V6Z!3)*@Uqx6y#kQT?-}xQ(5pGE_ zjPU&cAj9dlUVey)I$6n&=srIgXzyM`{$6~kN@Cc0Ib!7ybFkoc_5Sw`JI`xJ$DETb zD_z_xC-OUAi@CfwOpEYSpJ-|BpgG>HM3r2eKzb89_(3E{wRk!O09( z*{<`GB< zRgs63_ZRkhUyqO_R_t{gxtDi~w1@mKi~W1v6O~H52ys3g`Op>iNp1U0OE5JxPX!9C(y&wo*M`qMj+*#R?2L z?q~fm^U49@NaQnYc>`@T3U0U!Z5LB@AY7e&H|V8(d#E4@Ww*LPG(Lsmgu<;sKvx#> zV5&#-dTd<=uCi+3qKW&7p;iI9(P|8=R;VM;*Y^WuNZWP z+n?PuJ{e&zfM06ZY+sHj6g)!I38Ztd()J+0REU1kIXX`0_F*)`10eyuiV9jeQwy|N zb(*rVrTwiJohgp4#&m`$Um^r`{k0#;q-1GcWmxJYI>x83TGWQs3dYcu&O9UxcyYR?W7Ap5X zyRv}8gQw6BE>7(W->PeQZVB%WtqFpMzqHRFQCZ}XE9A)VhFdI7-!$7l6z`WVe0AKG zpi}3#155v?Qf=B}wC{flo&DmvNPCY!z!IY!&94+||1;h12@dVfkGEJyWu+HL3q39z z_6cLbViDn|+uPeC-Cg_;SI-@Kx%&LI_xiRGuc8%{&P&#J$?WG_hL~-46-Gb@&q`l* zcHG5UeNZ-*g5B%Q)(i$YZu+|mmn<+0x-~dN>Z9XLtUJyT2ieJg+mqjxiegI@-!kug z6*d(tyL0_?j%j~Mf3FP2{yi``%+T=allYVV-d7=0LCcc9z#U3opzutj)bPm3tSsj6 zu4Iu)OjT3QAit{`Vd@DpSh@SritAw*!z1Lku>HLm?y-O;Fd>jUjIz%eF31V;}8CqL&p z8dOiDimX~PmOKK{H&Dl!awV=bQ2Zd(P^a{^?F(d$<0N9HPzn#ue)o`I7ct1_^&F$2 zL6gt=;F5k{%hZv|WcvCbySRYU6mN9wOBFSrbxl6_XPFnO z+t+K=RI~4a zUqBnu2@(jbPxM6D?ltpac81Eagn_z#@QXN70wy-KrG+gx{^)VvTBOScZ1Yy>%m5a5 zt5fL2Ehqlk7+GDNYxuP9x=QN8z{xo_Yop$)37PXFZwAO+=v4up)MIA?oO##(zs z_+C9dui!)3nnU=pGgWv4x9osM-;E;h$vAch8Oha1R*@YLnURBMrGY>4!pwS4m*-CN zV3YDBixEC$Lbm2FhTIA%rUsFgQa<#d{w#4O2+Sae5{dXN1HULXb9$bM@NpO*>OhO)1d-C?Kpkum+aa{mU z>9;Ows&|^(f%Mwk4^&gr32n6v^V_iu+P3#r3-J;cXN+*vvLxX?%F&Oma9}3~`9cpl z!WN(^stU*DbDPp{B-;@2;}9M3pQvSS0sOeF@xX@n`*A3nx~Ss#S?&&jXXsJNCfy0m z2R~R6i~F#dFNBaIV?53TI^{*RdPhkT7Mdlu9X~?AfvuDx;{Rjdm&&3aLa?N+d~A zNku5xl6@b`%zMxIKhO8x>%GQE{p$DYU*4I|eV%jAz3<)cx!>)4Pp>}x2c-?at!LVu zHEY!}3?pKrVMKL7fq&0pipS*f01_}o8b-)lm+IAv}#tNOQC#oCu$mVG(pti+~9 zR*2jvkE`rGyW9-NGhDWlm3XF%b^K-5@dvTIWPY(0_<`)pDRToY>n$Vkv2x1RQ)1P7 zn=G#WXjb^$)47hT?5?+tzusYPLat$!Rd&~Vvr0}dvcgBoIY?5;<-Nn*>ap`ERD&XnEtvQ7J3qRzAd4Y}(x=kIC)j4!z@ zF0^m-SvQyUS>ag{9txF5>) zG5O0`;iFOQ9FvsoW3tLwt%qILa^YTSx?E+iyUY!=tS8&_A5%Tn7I;jvQSWI!2*0T> z>v-MeOL051f<|+J$5r;a%UO}rjFzu2lXYBWuej@MmgMOOGIlKnhM*}ivH zIjes&d{VZ`IhhTEvakhk>=75%&qk)FkU6y+kD)rXAv&z=J zv&#N`oc)1tzej_yT~G67*hdrDme*aDeS~#2@MrDADqH)o%UQ*@8ZBoxlXa{zi-uRq zvzAG@d9yRy54YcK))#mqc#S+wo8brbtj5M&<}sqx#wv!#Rrb2eS&8lEpScnKG8&sR z^EEqakMv%H`*fFm0OnR2GIT`09%(}c_UqHVa%82Ry>1)W zZ{XmxN?s;Vy)^mE2i}raNEG{IHV>OueaBT+syFX5bV&OigFAHVKd4`iGEEz#;XktmRz3euXX8`it)S`!j;c|5dyJJ=c(-G1M+ zj+okGx*SsnOf9*(mw>-eOu?8apq6I&lF>kH1rzJJ5jF`d^REmhr(D8ShJb&jKFw8* za+RZ9^l6E<-K9A+=$_Hi<2wp)&6jX!W%SJ|yT;EfIGi)GduJG95}q3Qj) zjp)IajOP+^Wu^Yz2H!qxP+FNxtI#wPuhxLHem#Z`?J>BE{hBqoxlDTPnspo0ytzzM zT(Qg=T*qFs=fD9&vAp$wJ9`Y^1BF$rO$_NXvIiE_ty8n6{LrfHIdE`~UV{e?8_*rg z%J!5${G_9^O?%US{T}|nd7XU>fBm7fznD(;@{8$YJ6udB+p^%3tzkDLW$-~}NC7YKYq%)p)u*!uTQrjX(Qy*-mlw$Uc>M)O)Jx5K>DyD z+|sSxhV)49-e+)++t}`;^&2`EmH7n@zc|r%*pQ)pdX7lD4eeA9u6pah;pzPccJGna z6Fa52!iu~24Na?Evq3$(qIZuzy?PH#t6!T!1=kRfFkm{c~ z^BJZPukuujtJ1Q8zpC3Tt|=O!VbrykXY{h_8(eO2W*du}K5jA9V*a%_ZE-7+ z^bMoUPuBcZmMUnpf54i*j$bVN-FS(`opLO`Sxh5_(e*=XzFR$;vuwW3X8Sz4+2_&C z-fp*N?Bz3UUTE{D7WW9TxX-&be`fI@DxvrrddlKq`~u@|qu zTKuR8;D#~rHfw(35S#7#XFFN*lTTRu0woRny+8vW{-!=_@eF%@Mg?nr)<+h<(az?Z zZMKj1jeG3*M{R!5=D9Z8*YS-t_WX}F@3(k?eLWUZn!w-UM2nZ!v-p!cEM7&a2Y+iG zw)kuNK7UifnqP1KZqr-V{7*R+Z?&JJZCTd*FP2(q>@H-@@4M3CgA*-27H{!Md;a9h z*1XR;K94a&<~_zcHm|VR5&=ENPJ8~i#hzfBDHY*8@|3f=uFWki4%ujNCqiKk13wY>Wbo9*rQ>2J;Vx99uY`x_8r)!$(~N1kCrt@%4^SbVqjJbAL` zSo8N=&#!09J=XlV0Tw@IJ)fQ@toFw<;Z3XlnVT$r_5qupv3aJ=3vK??=I?F(#pWD~ zp9`_MsLkbVu4l9LUV5H;)t+Bu@$@RP+aTJMeL#eLTNOD$}++857Do9y|$Hrw}UN~ASECE4aGHaD`ljm@2G?rZZ% zo5$Nc+2%PmFSdEL&6{lAYjdu}QzLCowz-PUjcjgXb0?eo+C0+c@itGkd5+DCZC-8j zCY$%#oNMv4NSl*wu3~c|o7>pj$>zQ`kF&AAp&kF+`2<|;Nfvbl}Toow!F^GKV=+dSFkIW{l0d9}@( zY~E{guEjGVZBDkiip`B|Zew#NoBP^4(&q6tPqulE&5LbbZSy9Z_u8Cm@ytk@lWneI zb0eGE*xbqHzBZ4vdA!Y&ZJuNEVw+dnyvgRhHs@OWYNXA{HdnE^k0)i!Uk zd9Tg67SD>bIoakaHaD`ljm@2G?rZZ%o5$Nc+2%PmFSdEL&6{lAYjdu}vmpj$>zQ`kFQhz^2{{~>uN^Ad8c$EUKcb~H{$g9rW!`9E@-N06w(DvwTu{D&{W%q)&)&< zj3`~uRM&{q`KNkDgyxhTIMXxtxS;#Vy7S#n))#a?Sy#~gWL-h`lXV5%Pu3N5KUtUm zesbP@PnGvnJWfo1FE~%|5y75}7%g@}s?_!qsA5z& zF0bAw_*yt#o6$ybU7^4!NtZXyHzn(G#`&fcUDi0?R6>_A&Nr3RrHz87RGnrNG?mh& zjDn^#ooW;`1TbWd5w`bQ!@`g8c=b6nszcC!+F&mceDzl?1O893nVL@FT%pd_{C@X<~iBu7VE>&KKNF zRKBn@TwR?mc)eh@;4Hy!i0Y)b6fU(cBiK&xF2NasYl-S~a4N35t|EB7AgpbunJ4%o zu5x}+Bz%VJiOBy}=YNykZ*cy%HvijN(kQLnQwgJtcBT}gtj@kj_pCFL@uumKf=iO| zW~uO#B%PH)94ELY1+SJ$FiE;Y3F32tn@ix`(y1khw+hZIiML95_K9mjr%qFjNq1EuyYH5 z`Gv&%!lYa1%rBg}g;=++dok}jLhFHbAsXw2M3oa(2e(1D5F9VKmZ((m+7QI_ErK(N zYLBNDWHwz}aD?D8qRNe_2_a9n7kpmuXNrTmQVrrAg6|X6$%yKZA9ZWNiGrIbY3kDH z#J++Hi0XJ)HHfD=OYn(m=e9MTXN}6b=s8m*UCgLdKt0#BmKD7Ge80Q!Z_eFbLBH|W zoxT2r>%;Li3!JNUozA`A|MdH+<11=CyQrb-g2#e8g1dl6fE$Bf1Q!D@t)TUhVus!Z z{<5f{LQNEAVL?T#Fb3S({$W3GBg{VmE((4d>m9}qzXPuU=YU^BeG-=656%SN0=^a8 z5Ihc?0Dcqe?ZNurf|p^3o|7m%hXtuvVF0)#I1AhdoC1CV%Xx(FfIkOs0#CyagY!_h z3oDezidTZ$g3EyiRnY2G5DL#>g?0GFGVpBhZt!T-^V)O-Hv*@FZ^I9ALr{3c{sDId z7oGkIj6JAuUX<2Yp*nt10^AYv2eHCv@W|fju=H#w`6cs$=6O%`SP>rs_?KS+>ZjS^kDk{Ac0SYCAFKcO?d1`zyNa0l{{(r3%jsmJ znoclk>u96C4l^3-AfqXwK(oUPUC5{jO({(*W0j4fVveN=mF7>HH8YHG-M|RdjSxAS zX?S%L!=tmk%fx>1Pup&s-mh{`96h*q*NskquJ7BI2h++ItZS%tG-#+V?qPnu-E8BbiaTRO7={aPdOQCdf{Sm4_CFYe8<1CYs?xX#X45UW z4JzhExeq~z5y5OQRtVGeMQ5dcNbquae$;Cz6^&wA9qmce zr+Tl17%LBVrEy+Oj}imo_m#y&c>G4%vdhN^oCM|UzI&d|M4a|d3R@N7d%!^{S{vB9a zAC5#ju9}&VxIZfL=P0`3#z&)FS2gmYai5g;^BB7M`WHewuTqYZ^o&?|6IESB(jUj6 z_19O&eg2SSsMGtL)*O?;$LS4SB2bT~epVGuh)jD|WGAI~6&A6_F< zdyFO&LA>{1t|69YV9mPt6+asMi14FAp@knEeth^L;s=QzCVr&&v7*VH&J=#Y=!D@1 zjfxJPJC0K*aAyC^dzR~|&@p?~+ImJ_@hitJJ`{`x)0cYNYuh96bo%11es)s~9#LP) zfaSh8Jg2_Y!7Ei^JgjDHpU)HV2$&70<|N^6DlBW0GFp~~U$GUFaORRIsP8G6ToN_gy4(;uqf2{hv-tEzaeRfk>ac(hfqc{T8S zs+Paj#G`5kKWNs%L#|4FS_ea^N+B7l_W@?pr6z@S!wr7;qCmUBt7UGuDI^lFnfcuf-e`Q3%q`a=V?$MZSMLssD~-T|4p-(ox+6(=Y_~Nmfr%SNBgE1OkHWBe#o!iS$y z8yz85z)cLkSPX&*#}Ne1kWmT${CjBLS}Q0M!aX(LOTrsKK*&42;-O1JDA)Ur%)K>< z-Zh{4^8OkW7R?RWl_(sVYloNS^WjsAJA^PS!QA~|X?~A=>iu>eex%Lsx`gnfZSJ@u znjdlV;Qg@_*v$jO!uf$WclHPtA${ZZd>Ga8bPDEX-V=o=lB-{DrmUepsYC(XJUImI zAf)aUQ+HC&7w|rrIW$sw!Yk;@NEZlb$-zu~Gn4jz5o$+~EFH|-0;+SP0KSZg= zj2iq)HM~G(Snn-W_z?-dWeZ(=X6V4Z75I^f8FRd>*1jY|CCw5jv5^a}DtzxP^A z4V80Ers2C!o4pztx=WDO_dr8vm>aCsL=SFM!ZzHpnRwOo{BW(`hB`19PVs(F2M_z9}4Pa}SRzbW(^ z>I9?ns7^4phMGHLWN3gZj_(`&&Q!$t72?;3uQ@GB{6f)+!iKY?v zg=iY_YedtC|B{+U+*i;vLOz0~@p85YT86n|3yHR|HdeHapNfmNaio%H8)lm{vDtp z?+~;YhCL*RrGT%v2({tSE{!8hEMTH_ge?0nue~|GdYjGzvM0Q}V8yzPTXya}l#{D+ za}Mv@wQcj7kKUR#@%}q*Xj(2R!8jFOv(vpVytn=s91TY{y#Mr|wiQDoA!yWwf8nRM zMqN>oEm`jV4N-KaDD@&wT&d5bCey&fy8vRm_~{Dly{PR0|u?;Hf@rN+Csk+=6n7`nbM0 z8D1|h+DhItiK49>8yX^xh3}hFT~@OYVT3mE*Z{A%5mumMH_S38?+Oy%!J2B~J2=^o z0*zW&Omvprttr;1$Ad*>`6NkHmR~R7`=ES7`D&<~ln{^}6w10!y`fZUPF4&9>APq! zRbK>!a~r3tMHptrqg&x+xEG2^#v?nRDXk5OHGJMyb56k^lvfLSNy3015c)H=7*v?c z7b-N)--p5!R_>`2FaY^7N*HFbaYqoF{Rr%4v3DQBb=VY98YZ-dauT5}Wx~3a_+)NT zt)GNGQgIRVku6cMAGg_vXh_w(s$quQbpr8}lVFW5`vKxEw-a8TcLmVlA&qB^PVDJ63=b`|N1MCE%8a~Ag8#a=>N*{zh@8MXuU=P*Z+3pHKntTG9%?gMu#{N zN!ek|ApO-7YXE!VFaUt|L`ruwCeheLM>ZYXlxR^=TAM`(~c`^-~>F z=uh=+d8KDrI#YccpU4V>9(0_+ND;S^{mkG;{B;p$9dD3s6vzxvLU!^{aPO=ZFFRJ}ZyJ_w51zq;aF-8mcB5!(M zF^s@0Kk*1d3(V+#8%3G$cG|#LByT4x7O9zN6AV0HumKH(^ls$WC>V$2Sje3iB*)X? z#2>k1kLUt+#~e8t2JJeIhC$acwFkEc#L+YyFNoy{p+|(C5o#gSK&W}}ceE~9u}M~3 zQg%?_Y^?r{|3B}IIlp%bC4Zm!aql7x;c4{cz1KCCx}SM!Rx`F1=K6tgbWxZmrqrX^ zSuKU793e+*I(S9+|Djtjg@3iF1ASU*Wn-G|)LRwltT6K?L`$^Mj`pGg%quA#i(`Yl z)B)7TsS;>(=my#@)ypxW2>jGQB8+l-(U7U04`JYf`Xo`*fgN=vs_5iZ;==GDpa_vZ z!|8WZPk3maR5OA^CzvVGLu#rgl4AWN@n+~J`GCT3i$_)8Zm9=tMLjrHQ~Vk`Q^c>a zHaf`A>l>oiMG&F~yX|hEb^l;^AI6`C@^HF7Ohx71L1|k8Y)3aAfF`lfgHrLguSso zRuy*fHNj|5^r$9=sdH=c2CHvE8)FyxUTi#nf6hNTAJNRnc29rw_xaX$I{jN#2P?qJ z3A7^fdzF7;Kvw?A3D$BmgShff{O-9Y27Kk8tXsm{VofxK<)5;HM;n1-4;5L$ea%_U zf6Y1XzUD0Fzvi5GuD8SauQ}(f>#m1MCWGdJaeQj@76$0)xq>4FTL~8B^P_k0+pFIe z%oe;tFojQ&-c9G7UL-h1@Cw01euwooey{cGf=Fsem}iV@CCshf;EULD2Ly7 z{fXeCg4YYC@rg6{NFee8!Mg>U3r6Kp9Qcy(B;f`^Dxbd{m}X-dfT=E~U|x%}`%L@$ zPy72$JAJ6F$Ye?f?ulNTf+hxuxhF~!`6tSt`KPn{IWY^aUjuTu$REIqjZFB{} zn*=8aeo9n1K@@p(b-~*NpA%d|RJmb{f7+Y62p{209z;Tlsp z!9~!a6btKs9{}GDZUdfC1R-?_+x!V@u17^NEO-HYCAb^-A#iyxI)v(9v859b!}M%a zGz8xcz7w1dUVtrm_G66$9@NZ3O*Qafa363T@T*uO=m_?;1KV1JinO?MBoKFdI9;==4w>|#0rt&%M27Tks#IRfUWc9|ddS%4n=6N7}oXceq4;G4`m2w4g zA=HQ9E0~{SP#=ab;rTck%Omh*%+FD%kHXinAdZHF5{cz81#krFWAVkb*f^`*4_xQK zb@o5k|J3JMwjLO%Q7;(m)>%jLIRHGu$g}j(_zXwjN$nr)8@9WYGQqz3}=QH+3g&rg67HoL* zV}ctPxqJ!@iE!}Q8pe;Fg`p_JT1imC|=%Litm+% zS1vsKL@2`@B2QutS+(EcoNiY}`vw|DADMX$GZhV^l+0|$r*8`s+wVfyBBbL>_Z;RP zmbu}Wy9#rc$lNE`e=c-j6?{0Dx@x=+KV2Gv_Mfx56IQ+pb6sR^Cg!R`B`&6dsNM!0 zz`8pS7W_G9bz>}@jJZ)V_aJwJxw@pcVO;X znR^Fw6(S5@p=FlMt%YMOLa>Aj1Z$Tre zYh&309Ol!U$;M0{%(Ujr7nmuDnXqHf+>;cxzZRG24IDuaEEyAP7+u&2(CWEk_28jv z-#xK&pflxnw9#1SOzxy>`4e(E{Vkl%g$$B%CU@s^8vLAz;RNo9W?W~Y(aD({vCv_+ zcz8Z_z%Bj<&i~@R|47sG1N*P((hL{Tw+p^Q#2ZFapuSvig5V~;9J(x{OLTw1_lW9b zB&~(|3c=?Ex6^5<)7fQF4;TDIx-a_TC4buug42m=pH~vKH4q#txR&-tEnOV7m8Wfi zba%`Nrv*~C5qwr~8($_}T~e)$5d4&=%)&HM>du0*#b9|PgfZ3{kqf{HfalU;~v4)qIRexQ8Ic8z9Xu}$w*Nt z+6zu0sy$xOCK@@KMSc@r3{(J1;Pnf@jzCP6z$rUiP#skYXStt$Pn~4|@c)MU%U_p& z{;yic*>2zp1g-!ij?K`c>mq$mgbBSmHw=PV9n`FauyzZ03V1xYA9xYC5qK9?G^4O$ zQB-U|MHYA_cqn)Xcn0`VFcT!9BbW-ygDMZzTh~U#TyQt=Nbp2(EATRKVemn$#}q@Q zF#j6(O7IMWC<~D}D`5#DeF+ZNayKM}ez>=VQfVUKD=8ip#)BSTG*k z4tyF>M(`BR<-=AC>Q0lpZX z1;i}>KS|(qaUMy2Ein>da7;8s7l-BYaJU-ml9n69af?{NVwRi4a=W_Aj*FJ=T(>*c zaqs5mDz!O-3jd=D(}A0UC% zcQDIW&PAaLP4eJjs7TC#J$WgN_YWf)Ef)#yRFM;?>42I^;K}HQSV_UTxd9gc#fV!| zMX=;XENPD=;RmtgQ7m~Lyb^pF*2qB*7Zt)Kl~D5v_y+LJ;BnyM;CG>vu7l%rEBG0> zSj|u@=!^vw!Sv3y#e#!aVIX)pcmnuY@EkC+^?m}r6#OGN4SXEhYfv5vF{s!AE(87q zTnjuGdsz&B%l0Jtx>8+a)ATJQ+)W#CcZOTf%8+!*{2xIXw%aBcA8Ha~3F zGx0I=5NCs%f$s)i4!#q79hm8cnV+~Tcp&&1a5lIlm?xG2egj+yyaHSV{4+h|a6YSG z9~8!&s40ylUx1r~7l8YMCxf2@4+ry?*VAu(7#FpUL94yfZNhJ*XIQUgsi%FBlY7_` zzg3>8Q!OpZZ;@w;eZNKCZ;iLC@_vgv^XEI(ct87tbu0_L+d1x(-OgL5oZngQ%%2;y zb9N9<;QTN4`>zKV!5g3=ekGwbfwM}5BGG0=v`58=UlhaJpd0g@&~p;;HmH*5Hd`L8 zVR5_`Ds(?dU(a_$zncV~l}a&5_J|dmWT=WJl4W?Z3{nw))co9jux{OKDU+{Io-7-E! zMH!i*hv0OvV{=13&Qf^WI1_?E8_93VJB@NGd@w6G2=V{B>I>Nvha`Vk$UB7KdH|Ir!ff?ai- z0Wq9GGTeh_I0I`qgKfCA4)=&^)<|krFsnNNH-F%5{-9ecJEA}M^W0$DM)`tm{XwAT z2Hj>#OB*=Nl%wiR@&4>l)5?; zO43u=Yg)IdXN0keq^Gk#g}yNZ5o5}iK+>NwzpK7muvUG9im81bl754|uk`@I8VwLD zrVe^Z`fc{k(02-6+7NG*GGj>kd%j|NnqXhSj7EqRLrf$||0rSq^908Tb`-4A7y)A# zmWrgeu#13REcmS8V8JUh&xzGb$AMcB-t0XFSuPgIEq-^MD!!Tr+tA33msTv#W_ZY-MN|EIh&lkuvQ)@ z|9FV(T*JxfLcp#L&bA!RzfaCz=ve>Ac{}S~Xq$oa|6kpIT}(!xyk77*!5<_IZIX;( zd7a=G!Fhr|F+Ht{Qj(=ML&n7HB6zppGlFjkelEB}GTD0aB$I6f^AYQK!DPWQf>i|T z2xbV@609azLC{)1in55#l}-OD_@&@{!Dj^r3$_(3M^xS%Irx==PYd26m_~6%Z<76T~L{%hDa%a6OcpXuN?2!apphlr3cAaqKeuf9Y(GS(~Q7!qO&YL(9#DT$&8#o%FB_|{tV~ern5iyF*wKNjuN8| z>W&DbuF1$R>XpN=*G{knzkf^S%g5@c(sY4zS+&+>xut|c$ z1Um{g7pyK=POzk4vY-`1W-VdK2o;-3V~_61xG;69nS_BI z%aG8ogXs+SQhOUobl0g)wAiT89_a@1VTyG3IC#CJx|t~*H_RhLL!@u(53OjDSIaJy zyqwEhFvX3z^7>#&$ob2t;>>R2%YC&4ve)Fd>*t?$tXToh-)Z zufSiKKqj!Qf^@(@-T&w30#>KLJxS2Td<^;JA!}ePf7}CO92gJ4hQyin0%<-7f zqei*S@x;+f=XmWLZyr5-j>pgO06Jbl$5ZHd4#|!;(d}V$zQz82Lzd>~?pNekXdKRO zsmb3GIF=(f2hQIb6wQfyx%lqCD!hW3z*W>o%&@N_7PF_J3SY#Yh$?h3yC|yYHS9y8 ziv7qgAF2!n=S@T|_0!^->P6Fmevy7H6}E~#FjeY^ILbQHxS(g#rKaL{ipQ-L?GAc2 zopUPbh`8ziJHc@#Gi23SG!G40Z#gr9%LJU`*2tF!!tzbzpW$hOu)>6Tz1bYfLjMa{} zj9xUyv*vi*950;XnRC2#jt9^2=s6xfvg7%4Jb`4#J4kkaGaV1&AL-S{t5}c*<=Cj) z?6z0A%Z}}e95{a~P0q!7|KX%MQA#{kZ}LLu%jw)w8$-qUHJqr9CyI;gNuoNPDvq?5 zh{{(%9Bs3SO4SfY+)Sd%OBF}m6GU|^PCR%ci0aocW-`-V1y|BBqpOMoZ~{>s2xop{ zeUsoa`g3#{@f(g1T+45&t|Unyvjx}l>#M7C2u3|d@N0gbb&~Xryj5_n^pHFv<1^}J z(l>Iv;8#R+#}U(2Yr%&ER}j_daIsxA6TDaO9l>1`8+388X0;W(SMV*t?G!L{5ix9C zD%eMGqTu_2TZu|Vh{da>;0@(3XjRHDRh={MP6@_xzBFHdc0TB=NK=2*sU^w%=kr#- zN&oNN5v>>6_8w@oBy7>=ON z&ItZ&1fB$uEhGn_jO!87xCD`mstA^3V@Z2(Gw|bBBm6Yh_{s`;RAxMuFb~jG;FjPC zSR>*T*7yc%EaNr`W68Z(at*jK_$lt?7}od}YrM-fiekx7EV&L`8~hB`@E)*_<4sf) z#{#AZVmNDM@Fe_l7nU>E&o2~_F;|hu?CO3Bo;6{w+9v!JZ!-KR*dJWci32VqjyBbSw#*%2>lId8o7)$o?qz7UN6DyVFZ?RwlR`?qHFy>QG z&l|zLdiP?%+gLCazdX(ZZeK|omuH7BMH~jQ!O7%g&Lg`s?D+$)tn7#G41N9pF6O** zL{VnPbHq`)MIDipo>EIJy=eEGgsa^f)B8xw7ncjTi7EQ#GO1tqG2#`H$ZrZd%OU~r zK9X)Gng1pVZu2s2U>!*nI7aY08RE9Qhh;XuLVA-E%|m`Tz-C3)fd z9R3!EAfw=R7U%Umj)kkDPRNkB*K#O9D+yG%_<#M0{^*kO#}2#8RQ9ZS%Oc`lcE0lO z`wf#BI5Eu3b>LW7=q&TcLOU5t$WA5`hy8KYbiO$j7&_$~D-8W~jwOb!JIfjqxC*=y zfvaF$1^qU%`qW2;pTfx48=iwCLA&9i)ooDw60$}ibCSLqjHF5GR5TXULdAQiV9uc1 z!C!(?QJ(@{hxy*%2fzp()(v1Ii8_T}{>n{WgPO@$G7a1gOT2rrn zNnT>*Pb^ykzHYr%5}e#CSfwQ1SiPR_tsWy-GnHvmev-5);|1%NqT75shFdz5TP2fY zR^b$6=&C2h#hxhxSpDK5>4}o9MMloWS~8f`L~+h%%8*t&Ju;f^M7r%YMp$tIU964{ zR?v&n>A^DfTAd=?WtxATbwNdzU4Q=lg%}#673lSNxtAjyX*qN)7y=#wE)QOg`V9z5@fAVE zI8<~6Hv-Q?LOkytEXj#L%}c1c5_}c-B`k?NfhBvqsF{zN#^Bq)s#NIYyt1D4a z84HGkhl8ttSD}70eyNgB@fa$4gPVfi$1j8SV@Yl-YFfn{`<3sli-4_cQfIq|*Jv*_lym-_+jhZgt=HR!nM2`Gq6l$iR<~ndY@M~BSb`-xk z!XuxB8Xo!e;3-%VeG*F!1fzymFbmujJPAt@@|<&e4>gxy39s!_T#}0=JCQzCzl)ki zU|xsEup}N!^i~`_7u3aqZs2jwg3Va42o=@s1@}7(HiTdlw@Y050`&&B&X8YkaC8W_ z{@~UfSa$0VEW33Gmfd;;%LVBYj!xl(MU(TV32;KF^AC~xTf^kaP`QCKzBul&2TyYi zOw5n|CNwh7en2{Pv;KrPsG5295vz%U)=%(t!M&oTRT2HHuizYNY1oD+Yqdm88z%TZ zl{Hu%L}zOz+S*vbRn*y3tWQ+8t3+vgN^rgCY{{at-6Hsk;7(E8s)^z@RPX~)-y%@Dy_@BwfKN#9;H5$}NBAer9rnMc{m{a&It%qx16 zBy)UT@cJZ%39F(cDwMzpf>$Qv)lj}zl9o*LdYtHFmx)ex8cFM+lPwpWY_wog>SQV> zR8+IYqLd96L~?wjraTxV8rodZ&3Xxz77cB)=w{CfwigX8FIF_PPbK^1Xu*b}ryU3q zJ#CigXoL?EI=Dof zPZ5t)2S%K$T=WKnKkGyBTMZN}Epg}HinnX5U`EA2s<*QYU~XerpzJpc{+qAG-DJg zK%Jj~IE<8``zIA5Q6VEcxYpnDJ5_uE6wd4RQ<*Hg$cv*j3ynP$gd;X1h8_sPQJV>O z?+L?^o9Ry-kHFEJakqUIjWh7Y-!%U;lrAGLsLse0zIdEWUP8-}?;S0QQ_79YxaEPj zwkG4u4hMxr6)IMydZWv48Z>tDqVJAo2bV@VLI{iwJBl@aL`^#^nGR+INgphTI*LLK zWO&0*)KMgI)1RQ?J#bB=d>ag&4z7w2>y%t9*olg#Q85J-rB0)8Ei%hZK_a;mQ3%Ga z%b`lUgDikiIzq?TLP=Fj^qBF0wGXS*SgwiolhoPBknF(l-@@zfIpGIx@`n z(1>3UEqE5jI)KjmG6r0O*YO!o3Vn>@O5*KSz5%Ip9Uf^_itfTKRns_n!$OSSkc6RT z?}T3vO60bN>Iz;Z*jw;E!O4Q}2!1KJO9r_LLJmckw2H9{h^{QyNU)t? zXF+6y#M04%)<9U(rMy6JsUYIwu+Dda2<}69w;)`*QE&$MFt|SW2)Hg7=`Llxli+mBp9WU}`@j`t z>*ZYgD=Fn7;zV-Ls^T7_o!=$AeVS+N?o#+qC;){U{G5yq`u@6jT?guk=`I?kJDTli>T^2L)09O0 zgZdR?Js8%{5dKm|DG9}=-IYlXnB0K2SazOdoEB}gd?VSq$P*d740{b6)9<-X^|iV4 z;cC1~d0!7HZQ#zSZ|=+XEJJu>Q>_v=HPNO~a&so`sY>3^7`IgwTiXbCRux*(5SLhm z&TN4DYkIO(2JW%C>S#UOW>tB8UEFCEIh8hA)%hsRw<>KZExD#=&A+ zY)XK+`e~n}45<16?Ir4p@2EnW-fr8OAixY8@C#D|m|?f?U_JmdwEG5j|2I8XuApVs z%$RKeZA zb}#H^Q{eM98uu;xG5JdNdixk2qtI+TM%l(_QE=F=oE?|w7-FAzZj^o38Pvlgpskp; zW7?Bx1LvvHCS4b{>iW1aXCB8;LtYKO5_}c-8qiWr%Qzo6YM!l^@i=@%;tY4{Ao9-a0WWlpV)?$L94c!Pdn0%|lIs*x}oEXx1&o*qb{~eV$zp zDWK!EZ_l*r8>VCdPdESO&zEn(e;Y;qbIG4F9 ze6gKgKQ3=jbeE45-ypNpy_=aq!o2)F#VA9w%H$LLmYPMz9^(hpEc*CKkIoKhChrel zEPi9z;g7#!t_i+J6!!QoF%v!WK=6H{pM^nn47#KLg@JnX$?*N6lIC>9U_(J8Dc?6I z@2E8zQJnaI=nHauL-Z4|E#mvgiPtMbK1kv6elkBPr@-<453X-YQ^RL|cw-oohMW5z zuS^ZW{N(yzCSfpl3@^--3+9Q*<(Xi?G-uaj>T9*IG21}(ZXJI4)f-ir>cBK#PGJHA zGiP)p1G&s!x**;wNvlt*GdRr5dn}p(WopNj%&nxR#WFZeZI?lmP4#3b-%j;;D&2l+ ze=CN~DK(03s+tzU@rKohu^iS|eOrQWt@^1H-GA!mH2M?OwlaK!)%FtfUaD_n>2y>} z!{~ohvpsyL^=P6}ZRw*_hsx4jslJKiTdtobD%FxXIMt50a6FNE1_dO2c^FV_3Jb-9 zsqYCjoRm%hE+|nhkb3iPyaL(zl0H!k zbPtS@zw90;ADCs=6P4FYZ$%1zYb`Y!~7)>o(ACO*n z-wM7bI7M)bU?0IN1se)h6f8niL89*KL(;YHC&AT%9}2!L_?qC0f=>!QBzTYD5W#_h z{RDdp_7LnQc#B{s7g{yeQfp1?SJoD+tyx>P_G0bP+Pifm)=^nU_@QjsI&$kQa7Om& z;R?yQYU{kMYhYau>)Ke?$+~8^e(r94PTA@5cOiCn7yKub3pyX?oZVc|dIi<}6VBOv zj0K&8`@EfULF*M%=ic@|p|xj!P$au3eFc?B)C}c zBf;f@D+N~ze&s@|##(BvY5mIDg0(ek%hq13Jx-M^SVv+Vm34&H(OO4torQHq*4bHS znk2ssk#nyEA~>kKc5HlznoW-jy!k3p*yJ19Xx4u?Dlu`c6ac02jTeh zd-*e{GtZYlzn4FoIy+|2{O(Ndag+VIy-JEhk=^+GdA(A^!706Pa-Vz9We7$_K?ue;z|NHR|(!Fh4*M2V{vttG8@Qu*h zBu)B6!Dd7iv`MtT^eVreUx(?btS_|pu*_CytaOtPrY61?*B3PT>IsJoVV$T+=z;{f4A&J-r5>=v4GO@oWc(deVkIs>N>@x*hOIG&aJraxb zq+mVTe)R@P$3B9nN}7_1{X@Z9Bp-X!ammE~N@2+`SyvpmR`0&r@aQ>uUroevIC>=Y zD<`ozeGS#%XmEx~s3J~ZYe)sF0kER7tf3ezQNU_ItWUeuPuR*HVKqcn!^B3)ns_s; zOcm}3M0b9tM0g;a2GpI@w=ld9{?1fRhbOw$osLj+x6|>(DK&8Z@G4#0_g}xt{){U0 zNH~&e)j_Cj1d>*Pr-7H&MpoW~Om!Yx%g~ocp>GfP1@OyMlJ-Sm06K3CL$`=QP8;yE z;Bgp4)B7t5-(!5urc7;~Zs>{NK^TtHvjc^XFpg(KcNNIi}_-F8I7$X5g zfvUqH7(e0R!dkZkZvj7rSGo>HWZniIhe7vhVXXL{z@srvd>tey{|Y<~=^IipY{O6B z{%A*Pb4)?-L+GoMmw=|`M+i>0pa*$v2#IfkA41lM zg%>jPP3WN29=rfN13k9lPs2fZBs3bSz~Gx~2VPwA4-ZOewSAVrL#Mqn`P)b)r?=Wo zvfDcBj_h>WTW5d?vcElMHhq6)E~hs(*%`Eg>^JVC9`xpb~?-zERdr$tS-hVV1JFOfs6GVS)D9K@DI0HRilEc)NC^nSHE~=*!jm~Scy6^?EDWh>cl9) zax&`tY8jJakc>TV7MHQ-Ka`OxZspkX>Qt-@LH~w~Y|%l6pg$ZgL(sn@BVRO^A?SB{ zWeEC5WMqt*GWPuUGGxX`8GBxplCkGMks&pD%c%3Yg=N(Fw`ItU>t($8qY*OR{8Slf zzJ-i5ztbxt&5xI{I;zXC^6MI-d$n5`{4-^zQ+Ig@sdJRc3n`L*x$KWAk>^t+FQi0L znRF|Xf%E?}_uT#4f9n006r0r`H*|&Ea37SuI40#};?;$ysA?}5?JW4-UQh)Kx?qKD zE;x-}e1`?hb6N=tZUNtm1+iSP4ht5bqN2Uv9`}N`?O${PBM=J01b)GNye>K?QmI13 z2}e3oNIcU8+ltN^azM1r7X({~&Ka~@w9TgkGezh0Y!hvBykJdgKzf5Ho1+BFQ#aCI zh^{$Ubj=h~w9I9KJw?|{$Q3Q~9l@JK*Nn;$E%PgZR99jev!v7 z23aDJqehbbq7(I0iWQcaVcD1bqDXn$9!0gXti&2yDW|O1NXAF<;+?Bba(s5D*|TE$ zXhYyDVs&J;R7!Ui3wM4F#!)&sIhap_`8fRXlvXUIm4hP^QFG3@lLO~}G2VY&Lq?#x zTX1D8o&r_GB z7_SGC9g}niXoppy9lip-kHhjEKw&-9#7m(bA{JXu0FMR#4Bm*>ygJmwnotk3!4HDh zf`5dTm5z25-Rtf<=AM66--bybW67W8ei0A@yMB!RV7v6Eo3lT?h5> zDe!BED*e@qaSFqZKv8TC1+gs@#L3_nkuh<92+VOo$j+}@qrGef4e@15Q&fk;(57xj z+u9zja6L4(Nb}6Z+3I*CY=N7R*0CcL#OhEG-vr+W{qSTV*bveAU3Y;jG@T(QBtAsCDg=0=@_vFqZDB9MxBks z9!bb$t2aPP>{kOQl{gW6b0s-2GMWOlU=od3mr|BGt1%Oh&wWKjd#Re~i1 zHYSpOOEkbP)Bs`E5k+u`D1!Y&5mY5a5nL^b;0VD=q6e-QJ@5g+x}paDENbARf(=9& z+~E;raH1%KO+*>oWhsNth%$I7l|i*PNOZ#IL>p{IZBXsV76d+(FNCtE;xj`pfXcLC0r&dVNX#Ba}z`*Tp%i8M^Oon zM2Jc_RaC;}q7v@#ib^M(8;_ZI<&HXCT$LtbavEp#viXom-S=wx-`(I^FF<=3DTp~)p`3D zjk+u*1ReBp)z1sYbt)eTBgiS=wq;XCbU(n4&eE~{UwEmy|3K{KRj4h8-P+PMqLgF-iPeoUv zzu}|mRiIX>E!R|o7G?f2AS@kXpt)-xMx>6^=H`A8wQ%I-M^}35u>0kKXR2pF*7Erl zUKiHD@a28jw>Zuwo@e6(AGp~a#r0d|{1IO6d3UszyX?1Got=`&ZM=8NPVj`o?uam! z{g$z_4f>1@`@NB2?(=razje;;W$yFMUv{6fyBs+Gv+uieJ)C>)X6L>;{NK6%`WlJU zx>T@+V5(q*#BLpysI3ix9|_J7d_-`t;0=P82$m(P5TAs0Z53Q9_>$n=f}I30BnT`+ z#pun@hr|Z|so-S6fr2dslX%heK{3jIBKVx(ZGtt3D)@vL=vN9NVj%^?4+~ZzD$ijt z)-MzsCYT|H`=Fy@vVT`_xL^aK3WnJWX0SH|ZzaN@BnJF11@9MZAjW*}UNPfO7HlEL z{GdHz#(zf84jkJlX8b1vYf0eP8nNQ{f_2W$SNMB#9lDJ+`O9wOj=StO06AqRZopwD zrodr$%mK@8gOd}ZKz3pm+`^#~=irWgaEx9~jD%wx3!Hybd|;c30q*xa1NrZ{d)|G| z-DT&VyV<$#4mI&WRc^o zS$I~ltn#A80(6<+1A;4v7?Ve=Mb`+vDEJHGcyvuC)&S)-Onjrui1lf>;8z^sPnQ$h z)F`6**(0W_mV&Pl)u{xrZw)4@pM%8yb)Dd64FA*(#7OowyVmKtVnbWRP*B}KOl%)k zKPTGWi2(m!vK3(J_X_5pcLy4{%T6@A!|rHzmfaQpL zd{pp#!C#9rc)g?q5?m`dUhv~2#u-P_w_MUPpJ^Z;ULM|Y$i~> zZGSz)?4*Yps_-=Af_n>DRIfi&SL@m+lv;s|aSM=8HE1j{$f*hl!np~V9`!^dSIyjy z6my58P%5_>-8y<9bSLFU#PF;|kB`)!QK*bU+BWn7VYpAlBMA5T9^FLRnkZC7AkYXf zQmp7X=s&U&kwWpi5Gj<0(4i~Xy-ZJMc2*U?msuqBK%xrW%1o{L7RlG@T`vP$^p)O? zG1gcd&x&mf<7%Ag*Z7dwy&8z!%d=Z-TCWK96U-p0u+w75`a*EJ;8?*Pf|m(a5-cuQ zNHACoUx<>0`OE4JX(2*aQDc^+=`2jvOcqQRY$4cP(AvvuQeIz94#h{(a$FpZ7v=fo z#b|f9{8<6p?%?g;U$#08I=W3o$$FVzw{tqB{1#h1l^xyY&+~8Xi_3V7?x?T-v>Z5p z|Gnq6$bauSf1!K9<$u@x|6in|(=pHn$D-$7Tbm!Z`5TLsiiT=87BQZgHutxAs?BRH zR=FWi=EkD0U^$yFv$?m;<87X6^J<%aw)rR-L8Bp1`^ZT)SF^dP&6nBS&gN@uzR~6` zHutc(yUn-Qe1px-@2;@tTiA?z8nXY=Hph|S|1;5nNltLTeZXsNUSRVxHV?P?Mw@Gr zi(v!dRzYv(B`d1^5zOvr?m#(kT`rDiAdvF!@4W)~Q~o(=@thP51+lviio2ZuiT$lU zIR*F2@pt)kBs}-m+p$C!WOa6|&5o7Tv9Qy+p5LlY&$Z*lriYteZ%2^~oWEs6E9kyE zb?$raF8@33zqWGsA&(z&FCeEM(8}*;<@&So{#iKyt$cvU4T$UvOcaRR3=O4QPEWz7 z1eXf#mmWGLrH9V7f{zM*BE5BjPe^Z_+R{&_pWvJ9t)sjLq|;7q>8>+W@LlP&6LwrW z?X;0jJCmf-j%Sy2+R2cVEMo;X6=B|%4CzBRu_(LM1??tj%jyqXegzu6#dJSH4D#Ns zVvxT=%j+9})$FNnROTGYo6GxDLx{$nHkc`i| z{JIe53(~9ntZ6v2|lAbwVNza_|g3Y9V z&XHj0pEFl_=G-QjEd6u7mYz9d1glH`ob}Q(CtI+Rbji#@ zBKR@}b~~}%R~6g+O0m>;l@2+-hKa#`q?qTA$BTJ>f@EgMDRK#J)kBl5xH4!F2hpt{L>4haV zv5G$#g(p?d6l_jZo}VJ|!0Nk+D#gc4WO}|Jl5im>SJ3uwJh*x^5ozo=ppsrFcok6v z{lYQI^cWemu#_o-7A_LJl8E1P>_RH& zY^XV?;a7z2gvdj9&>zQCJ{u2vVb_>R9Ma7hGl_$}Ib$Yq5Gsyu#$n+aW8&yk=a5OazrelroM7Hu1 z(1FN-cdRsc&UjE{f0{gw+2eO6T50t-)Q{hZXr$-`ZNY0WSwng9opKf(P$VXt<$=z`553yaqfq4DTEKe+NTC@e*es zVE}jocuEKcoQJRQU`Q~M(xpMBg22-j!!LTaW9Dwmyc}fcOe7mnrC`WC9O}iW+L-$o zvQ^#{h7r6MGq+*JH{CEUPt)efSk4>`Gp1o?wt<(_Y#)9E<+d!VSFcIKP;|jkKK2fF zF_G`5uH(fUsn-V)M+D)`RAxz%Uc%Q@-x7=$R2`2Z=~wu+>XspRPt^`DNk1fGSyc{2 z^PyLBcq`p646m!oElkq$Wb~`6!}0d21GqG}AW!pE*7YLr^6Kwpz^pqXIeL~anWW$4 z8?A4M;<#Fe!%2EF2iek%qVZbmO)~n{Ju!H#l}bfY0|ocz5+pfzAAAe=N{rZbEDHWm z?^d`yr@;L=9NZM{&!VT0I^ib|{GYENm%_d9fY!yxUn&*e&(Dx`VF?_coxq)oAXMvD zk*MKCj9QtLi_8s~31>0~xC4&e0n4^95wrBavL-@!@01?XW{UKfULvu* z-PmLLL?QN=p3SJ>c7T1sO$_}M+WL%a9E+3K%@J_Oj^IWvNO*GuH*!J38-)W$fGbFN zW2lcKypexPfTJMi2yy;oejy^foll5k7>XmrIRj4Pe08>`S>SyC_4ikg7lTs`+DG)a zVwJi}M8cBDE>qReO9gKus@Rhv6V4I5LL|eGeIgS+C78ijK)q1}!+S(9OtS>TkHs3- zT?E6}lOht%5xjz^LiUMd_>^EhT2=IV5e$cmU|7Nw!SDmY&LSR0$-uPC$_gQ|xrm3J zZ6Y2%AXtIAjb0_vVPBCB6HbeCI9ITp$cVwaMLK*;usVA#=&wXX93UcMkz5fD-x9n^ zM8uH2A|g%@tjVU!{6-|iL4rkdDILxuTtx`pgZJn$Ox5@<#o6)~NB?!?v-$|?azdQY zE}~CjF!E1nv?M_o!_(tpFX}yb8a=4@x>#fWw`D^|E+jkq{k?LbBNLJxxzLdbt(;d3 zGUKq0mTYL{#A0474*Y1PUbb>(xn)I;6ln#WSp!)o;@lDg*XN8Z9k@RK$@7DppL>EM zkc$cOP%H2f@GFQ6E9%22qDLbjKK6pDbrNp7>rws?g zsK!SksUG?&7{=|`!(=aK?lX*!G1E|HHW^7+Pk$eTH(J%}k9uqg#V1x^)Ya2Pq1--={laJ@ z^cQ>;n9mDYy!M1au>1n)y~aSC>X8d<{`_v%w9)t&l40i$v)FXUUKv z%fw#tyK0m!4{`5P{G=zQxNQ8)aZCo-Nu(0si|bkVJJZJey-92SKkPk!UzfoA*?nIE z*W=%PJtEIZgA=IvUtWO=`9~SR<%D{;UHVSYmlFu)1cv1|p*iL=$8<)Yr(-h9@8fjL zV{Vg}6I)%uzkW9OYdj z&dG*KY*5q029F+WEXzxR zN?Mvimge75(8_BHqM35r-8uj7_jx{N=FBjA14RABzFxEMbI#0}XXecFJT)6zLAW^*e3c7&xc0>MgPRXkN54vHh@W zYAh1lh7O<_op`IEiYj&D-$N^@UMJpduAuqG61%@tPIW1fxRiCiiPhm!s$Ge{4Jn~& zo_K!_j}T4VQ(8z>FR}epu7!z*hjF-|tMfZ~99HPszJvk}!)UIy)(9uKy59L}73aY^ zyM8rE;SfmIi`O)8E$@2f@&*o@cD{Vm=fV>lr;{SIlsTN>BnmdtukO6sG9l3IC!;e45e)QQ}!LQnmDG2(V&qL%7iBK%JtX6vk~ zr;6yz7)WN481nu=s+oxp4K${~$J)Jv3C>MJ=w9QrG?2|W7dO)F$GLbY^#`0QhVh+A zUqvz6|3@RCqxVzbb}9)nM(~j6hiPN(PSON)jiQ@c@h?d)@IBg?^){&p{+&a&yP@kT ztUlB9b>)AT;_A+N8ke1a-Fu`;*ionXy5h^^kv?735g+-(n%M^u!wj!gNa6}44e?_FjMVCBc|?-kWh+t#)7#- z>{+=U6$=U2n_|VMD-58X zzhGC4s(h(Q)y27UxUaKl>-ChSq8*yErQ~^nfBoLUTkzLoRwC`L);?dIW zy3@Ixv{iJtBTmo%#-uFUS9FbLeW1NFX!^QGX}gI;r)4B6b^b&Le;Xl@60Mwb7A5^& z(n+CO^&TCWM;i)>P!q3E7uH!Ar8^NFsri78yl#_zL4A}C&84R1`^J0&VkeH5spL)zkH+9pE9`u7$A%qFb~d^5 z!yO^c`Liy7H3igz_Os zNqo!ClS?N4K89zJ?CNOO#k7!rKAerPtLqyfo^mMh@(C;vOZ=*qCo$^UeSL(7QFOgI zm)1XtI*Dhe@%=ur=`(!$PyBu&w**~JOjFry>-zf~lbyA$*OnHuo7T1G=ST4%%&un^ z6|hg%+41X>ZFa{x-~GWQpA)nlosTd3bbwR59lIaBYH~hz$~*q~i_4EK z;$XtAcc1w2k}nL;<4Ur#P21ok=Du;1)9DLcy@Q>ru99!=97h$VtK=Iy*stm;{>BcL z$aEE5y_H?6E_?2?+$Zlk_CAs*Mtxni*S^YrK&Lk47kdUfZPrq%-P}ZRQ^f-sxCvuT z9XFZW6Q=Wb%~-INh+Ru?fYzlNBn4~O67Nj&iacXJgBLw-m~a~bmpD5_Wb~T znvTe%rN8S8(`VYF3_Sg&zjnpwqwUT;V)iwwpQa$#OE3QJ_7zL!&z#cKP+3}#6EqY( zm|Id=KlJbkUpRZ|x9@oP*|*!w*<^cce>{7P)EB#slItw(?J!9lj&z*ldUfm}vo&&9 zhrML!NJ(dkbpUL!>@2hOO3jd~7xHSzU5Cll2C**4>ojFLP8^u>I!=5qVdshOE1Av{ z-*@=_!$C23PIcX7P&}2CvnMCa*~cA$Kk(zS~EQKA|1J%j@(QVl+TjmG>trq z|5y~d8APjzJ3pk2oWGG^WgJZpWj{h2Pt%6>3(~X9C#AH02d^tmfv1GAn&d8Dqm9Ue zzzoft{H67I`wAwRC6GS~|()`T>QF8a9%z^Fb-y_4JnAVVAo!LUM^HZVK`Ab0f zPg^U6|J2be1UmDCCZ|=Xac&ekoS%}Ko4)C7n((21s7fD7$tQzNT&EPU57jYG_)z~n zu9!n|FAgu^0NrnLO38M+x|S;JN+n+XbUAxcKaUAd>YY=nINZ0obO6TyUplUaTbW(g z`fIt>N!(Uh&q}BDBg9G!4^I>;G2C}#Bez$(e==$qw_mSaQFs{L-Q84@Waen#Y$JjH zZyh^y1rA+-g!8L-e zGZX3za){I!&#^-kTJXF|VTP`{Z~RB6Pu>|g<^F_8AHP$b^kW*nF^rCUcGbT_^hG)c zo_){GD1Dm_rE&fp|IVZDv`258{q^7dr-;7VF12*RnO|A^*PUhb9k*+CIJYofJ8I(R zPFvLW{ku24*4bu}Z2ALA~=f7?{t5#zVwCkDg%qX*bZd%Fplw1!fGo2*8 zA=e9%sU+zEan?_!l6a(_k~SjO9fj+rme^Cu<|VNU>-CPrUe zV9r2W_YR>DO2Yp@1E-|}4>eLeAdyE4UXvG7w^<~J#%~)=!M()nU59aA+rD`uSzn^| z&!eb*CuaPI{E^+1120-jV^bGXPJHIuG*rZGuG!* z&v=8zyDp-Ex6jc~*gM4N*r&r91qc(bm5ChD`y&hrHY7Tyh$PVhF=pX<;o*EscsMsH z!o&HIOb*?yisaBwb>ZB6Q(@=ESt61`oo9-q(9X{ZhvwBW!lC&?v28bw2!*Lt=d$#5H_V4i_&+C%;`FLO-H$`&7x>}k6zQEV_W6td~tYtIJ zu{@60O4BuOqB`4EK^v#h=%DrdW|;+M?mM2sS+vy_rL+5ZtjnjpO0DdvbjGz*@V`yk zsHcLjqzS-&PkNm_CH!ugC1wtjXp8#x8cx&wvFyVR`1R?M@3!dSeL9j|G|Ojae(v7( zIV{fKjT5b$Q01-|Cs8@_%t=!rH4Sg@9r)LERkrs$r>^~g-MUWy z=YIS)=af41PhI=R4$dQWgr|J%&k0T*bwrQ3^v;*~KC(Oa*u_75>}~#t`EB$O+mue~ zGmdt0s3Nq5Z|uYVI;SJ?(%MUp9PR9R_lcVqjHkrj?(t`S_2-YgxU=5bwc{VZ|MAk9 zWAk%-&*u&M%;^`jf8$4YJ^a-3|9JJy?f>1`ndsQ@-rH}!`j6)x|Ly7@eErJvrZ*3a za;cnh;_xnaWcbJBJ0IWa=#Ca?+plM%B>lSQc(s9}N?WcPFpT<1U9W#*4Bv`7U;Oql zw6LenDnN5-g)vTmwl!vNbkMt{lBlf z<;pXf3Szz&j-PY!Rp0#4+6Omsg?anEogEYk-0|M_t*<`+)FbzAIaIXXD%up%}KRquNp=RyLLUkxQ^a2m*3Gb?#b7l6RiAWSJEr1#IMoY5xTHDHm+KDR5(Z{?tW*}9oL*P zM9ZPO)y}Se|K+}0+Gib+UqtnEYv<1Qw!it>Kes&l*!_2`{Myp$Nzf$I8+}F)d#N)9I6k8>cgS>aHtM=>wtGV^Zr27 z^0gg${O?`^^>Z}1G4-I?9dms?`KA%kwKF%-ZLV272s_EfwmwC2no}lFM zD$h0-?!G?c*$#WQ$%_=_5yYQG|M?t#|2k|Fe6_so&>ykJvz^b|^ieB`sXt})JE@)I zmzSSKS<@t*Gq$V%zYpF9{t{dd{!vi;OTHHs`PxQtNO^5DxE1V>d|h6A<@GrB8$emU z^7<6)&jc5ME#Pu+CAb<~2W|v6gImE4$v1*v9Bcraz$xHNZ~@o?E(ceFtHE{PMsPE@ z73`4wcMyz&4PX;E1)K>k09(N2;7V{cxDMP1ZU(o49g=Sb!8q6eHi1*XncxDj1zZlU z1XqLWz>VN$a4Xm$`Bo5&gAHI4I0c*uE&yA=<={$iHMkDk2yOK#DGq@G(klYpo<6r~W1Wo~Gf(yVFa5=aVTn(-RH-ekNtzd`b z+d(i6Hh@jw6mTZE0Bix5gDb(+;5u+4xEb6Ec1Ugyf^o0`Yyzi%Gr0hfa-!PVe8a3i=G+zNI`z83`J zU<23$P620v3&0j|Ik*yB4Xy(>f}6puV29*?gJ2wN0Gq%m;7o7<*a9vGSAwg-b>K#D zGq@G(kbFM~#=!=#37i7X1Q&oU;Bs&!xEfpsZUi@jTfq*=4}xGEYyg|UDd0?S0oVdA z2Umit!FAw9a5K0S?2z0M1mj=>*aS`iXMzjB7H~PZ5?l?g12=-3!L4A2%fiRW^gOm zA-OvU#=!=#37i7X1Q&oU;Bs&!xEfpsZUi@jTfq*=JwY%IHh@jw6mTZE0Bix5gDb(+ z;5u+4xEb6Ec1U&v!8q6eHi1*XncxDj1zZlU1XqLWz>VN$a4Xm$*%<`mU<23$P60oV z>?#0{1Fryo1->SkV4sBg--!}%FgOmx`H30WKL@-V{3>`8cnA1f@CopF@J(>HBuR<* zPa!dc`8cnA1f@CopF@J(>HpelSak|p^{us;Ko*Gu(%2m3z- z?*ab+{!5ZZM)04i90%fjMP6@Jk=I*QQI1N>4e;yLbHK~NuYxy$cYwbIp8%f+-voC{ zYJRW;91M;Fj{|3b=YW@kUj=Uh?*M-bJ^?-tz6tJ@G+vQ3|0`*;qfFn^f3;*_u4FI< zejUX7gzDseXa;yLi0c{p8uotx{to;=GCUYO75pZM-z$vI85t^%M<#(^1o8PImtcPx z_#N=4;630U!2bun27VwJHNXO}4jc_m0>3Dk%W(v{UilHpB90%>e(7|{^7kYMY?Q3K zM{@(HNDf~mdDsN-Uda(0ccAk|;P{9|*k20X0Nw(w1)q}~ ziStL|{E-*p`0d~elB4jwM&Wg%PQ>xq;39A-cmsF~xE6c}dF0odlbkUSoC(5SW_%0#KLLLYJ_^FlPQm%7;QUiySEt~0r|guk zpDEi7b>^3_e-^k{a&`-d?>~Db_E&@Jz>VN$a4Xm$d0G&RgAHI4I0eM_I^%S?f9B66 z=fUpJ`HtK_H!6AlW0Du+I$SnN?k~appcU7BDeSwgO+MegO!CUfAg=pW$H@JwmV*z2 zuYkC|S8HO62bh|hlw-sd{J|8=;&*WvnJhwFRYb@IIHz6bscybpXF{2TZNxKr{g z7FYxh1jmAt!7qVlfs4WG!0$L-R@Cd; zaKF9%GxGS)V0U-mes%}!?asU9^Q$L-xG$~7^J^3G_+1gO0vrb7yt_`s{%mj&xD>nr zyaikfJ_J4mz65Ru6OzA-fEC~{Z~}NDI2&99E(LD@ZvoeW4}nif{%V8duW?=O9U=FB zTP?YMzT^hfzeoQf_aDc7Y!lkMr(g$9kCo3qje79(m#~j|@bqHrqaHl{J?#GsybpXF z{2TZNxKr{O3oHT$f@8tS;FrL&z{TKo;P=3vf%k!rgMS0x0C!6M)dGvaf#6thGWaF% zEO0S+o#eAyC7%mOJ|6)qz+vD7@I-JnxCmSd-T>YLt_2?gp8{V3w}T1E7b0KD(=g#*30K#9RnTa13}XcrrK-ycE0^{4RJqcrW-E_#F5;xI^-F6D$Pl!7<>m z;K|@T$v1Jod~*r*uLo}i?*tzJp9Eh3-vakYz7+sV!6D$0;PK!o;Cyfics+PCcqjM( z_$2rO_!hWFa%%uA1&4q~g2#iWfb+p6;Pv3m;GN(D;FI7BlG|Sbw}T1EcOqZ~I1HQs zo(Rqc7lBK`8^Bw@wctbGQ{YSBb}%9NZUn3Vhk+Bo6T#WwB5)~q19%I#7JLYN3VaFN z4kjf369Fs0Vc-PtM9KH3fpfqM!K=U@dMXupS%(9t)lf&I2z6uLZvg z-VWXiJ_bGqz7Fn?>@>kbupS&ENkb+0Pj!w5PXXtHOTg>Fo54H52f!!67r?i`J%XAq z0G5J7z$3xq!BfEb;1ck9@MiE%@B#2i@CEQKaE~O7{^LJQDFugsM}o(Lr-1XpCE)eo z&ETDq`daWI@G0;ma66cgG$LRHI1HQso(Rqc7lBK`8^Bw@wctbGQ{YSBb}%7nM!*Vi z7&rku5u6P!0+)g}fVY5a!H2-7z?Z=7U_#Q0fEAK~YH%bt5u66j0WSov0&fIw1@8tQ z0iOY12H%qms$ecy4UPmSg44h`;Dz8-;Emv|;N9RO;4|RM;CqrG70d;z!I9uZa2hxV zyb!z!yiqdxUGR4BUhpySIq-FGhh&Zk7J~KQ81Pu|WN;pMDR?dTUGR4BUhpySIq-FG zhh)qI3&DDD40tSfGB^*s6ucJvE_l0SF0N1h&*Xm5_aw{ildPX5Ib@yWP#M3`hRQgb zHuN7j{toC!4wLaDZCEAtWjse4b~N@s3!Vm^2eyG<2Y(3O1wIV^8T<$M4(Lb@kAjup zaPVmGv*06=BXC^~KT+`(H|K zdQ|dR8Q0gh)iFYIBw9Kg#2eHyCtKz zV~w;+;}_4%<9Cgd{N-mQey9ToW@(;Mr{b33ArC(?K;RU(> zSOCQR?XmgTUjeQH*MPF!G9KH6{VkwuAB@L3<^JO#uncSj$AeSBS>Qsj66l96}Sdm4{idtfZM=M$&Def z3~U6)gHyp-;6kt!Tmh~E*MRH6P2d)A8`vqiDFl{*jo^52DmV*V2)2SNz*XQHa6PyQ z+yZU`J0<@V0?WWga6C8_oCPifTfr6JDsT%mRn7H}KbDfx5=ECU1y_Kpz%}4{a1*!% z+y-_^J`)1Vz(#O9I2D`)E(BY_72qmx4Y(fM1a1Mhft`|n4S{7~BRC$M3eEx-g00{R za22=)Tn}ynw}9KgPRVCOU>Vp5jt8fLv%rO5E4Tt&1+D?tgPXuD;5M*RlGYF6KjZ(E zfsNpJa4I+pTnM&;E5KFY8gMV1eSq~ z;COHd*| zAF6+c>fgbvZ<%Ess(**-UuK;+nEO4|KeNTBE3}Y;Ld!QRw0yHdiz_I!#+gD3Ehx0$ z22D{|snFsJN|~>kh5*zmw4RDWi!vy*v=^;aIz-9yH7K;q6D?*sRLSuTQ)rQ6g_iZA z^?^nxv?#R_^o^n+1c%dFLZiilmiJOe7W5sZD84p-vy%S&2A`=M;fpH6eMQPZ`qY*5DU0aSM5#pEH$kE0(yfehYXe#RpCZ>O5p}RKNG((jR|Cof)lu4f?dh+Hwkwu8 zR*9;^)9o+E*RTBsx^u8Cv!%C1GwQx?15NNVp6*JA(;cai?nJe8_bKxYrpbRs(4A!* z-7(t28Rw`Qe2Q|E&##R3Od`5ZPdc* z2rZxDP;la?{lFj9OErR}M54E5|4{3#^clZZ_|09P)S(x)7u37bSxTi zXq(`5-96J`s&CS!oI_()bR?Nx` z<%RPd>>IRi=SB0)0xhCP^&BHc7c0-7pIeY-d1|{#zmhswD^N#iLG>t2QEB}mjeZxc zRxj0t>rw3p-PGvrOux-Qz1AqzhZ|A-2*cEmHsWRt{YFK`NHb&@)@V~R;#Q40$SO2P zS|PK*uCp|=#*SOV>>MlKUu|1fjX!P=^XJ$lfpWiP*9VII(O^{|;;#yp1ayBxFfULR zDh~PsgF*#CCr}zL4h4e)!}%dKSQ;q|heHD+d0{P77R`^)PEI_U8_~j*IeF1wBtKS| zLsvXf6N}~eqw(C_STx6p#_|etqcJn5Ixm_VipBF|d2~f%`2~6TkvuE6rXZ3Z%JW_i zs?kcNT1oZ4i0Xb+8LL`Ko7$`z+Bh|$9i~!kRx7kBwO%V$hiWl(wB{GrOwo_h0{Y=v zuHLAX>a|qQ%d{bSzNQ$5=^-s(4ATuQ*J#vBjat3hDAP5w-pHpPx|V8wKK(cJGPByy ztxB`h2+{vsBcJ{U42P~>1zlIaU22t@G5VitI{so}!1Vizh^iSQ7FcSakQlatfdYS_ zZCZK60;=+PfqXw#ET(DepK2R!^hi`}S%DC?jA(?m zqM<;Ls=C-xgBDl&NF*E#DX}oNwU8g%fv`?jn~#U-_i^$np~Z}$dWlh|4=~E< zy4M*6dXWBy^*s7-=v;?&y2f$3?iFSpUH1wzn7r;bUEw&HTB(&s*PX97-68}vGly76 z*S&xku>yjol`F45UEKn@?h!%0?tH!T{UN~+U3b3Pd34=_Vk;-0;cDA~v}>e&T&|Hu z^)YS)>3^P)NB{X6l@c|h|JNw(8yb6m!+Nz?8K&k?t7FT)q3RPB7}7?n`PvY1$Ewvz zspZL~Rwtk~QLDoiXzOFB?HNWbOTAX5S5V7Ss5w*zBAQJWXlXh0zu2hPtBeX=rC+~L z50LFe^<4UI>812vqhG&_zGa1(Z{*Vdu#xszt#*alIEC6frGWac<>~;XPAyS}sxi@z z9nUQ!eO66tQiIwkHBW1xma>N0!ZK1)uS~_AFD<6;aZVCP^-|Zw0gZ* z8>Z)I7JWini_(8bD>Me_X{Gzy6eoiA)at4wTAeyTD;M|o!?Xys&nA^_=;O4scMi5In%bmL8&19UMx|7(RjSo8YU}fr z5o(xPenY&oqfJn4ZA^MUJ>0G+>QU6=AFagHp-Qn@uT-fOqHlkg8c~i=%`AQU4We(K z_8I!wug}_tj%-Nx4V32I`_Q3`bF}8(`_O@mbByNR`_OjAIaYJ;eP}b|9DjRSADUwi zd&Lp-_VjBIY!~s0%$Pu$AE9QP6K?PQ8u&8KiMA)NLB{WT@cXtOwLg)qZ>? z^X4^EVXZrP=fVZE2KgqmIxSRKtAqZfLA_HeKUfecq+45#9-|I?o|$hIgbD*i3iW^a z2zBkLM`{;_i_Bszhnj6VqUTfBpE@r&#fcJn5%rh$@sXRXa(u>YL^V3vbYZp~uDzCM&Fj5fC zSMy4XatcEQW`03&tSDUQFNl`p7l(_2g-*eMl5labNGq%?4VMIqjiR!6q%>G!6_=Jp z;=xjXNlAI6EExBfIweIF(ehxKKdzJ(RYod;<^D1?URV{a3{?2bwX(ti(W*eDzd|c7 zs*Vf@RN0k!MR85IIxxVl(kplW_1>FWXMd_bw>DfuKGFc{ojAMpy!?lsFJCl$Vz@3; z>#wn^wEDXX|_mp`}6t8!8POG6n{IX7ZRco6~6@d$+YA|aA6`1@{ z>!`rwP8AiH`h}@L{K9i4QGxs_{<-H&paR`fW{;%;-JKa#RA6f-Rf>zLz*d_alpwh) zA#xveatMR87s|1tNZX3=Zp5sT`rUSm~To?}X!Vld*EiT6^=j5^D6%%b{i)?0O^ zIA)4-wF+mDNfpfW9Mvj2R<+MPZkSHbn4V{-ht4(i{*_DTOltH#X;N(uC7){WKBZRY zIXm~fLKXG0Ig?waq1f68@J6l z;V?clDpig)=t!r7-}~ECCuGgHHuyTJuE&~uTCzq{4l7xsCs88Ht;BPiD3j&xoK{U~ zEVhXDEBJiMU%BT`4f{sA+mk3CwQLVJ{g<8JW>UrH^635*rSg&$n#xO7=w>RQ|ca`)ZiXgY6mzwJ6?J0S1a47 zba~XN8=Ne2tVv~#aINs9!;L}XoIP9r@|&BM&Y`*{?a9BvmpEg@Q9dPQC!>A-q@Bcv z`eLqaOt1HqxZ9H}d{y#{C6~;fKndaG>4PW(oI0ISyzVK}X{E?zZCu_dL#e!!oltp6 zJ1L>^T-%sN<++BdfaV{5iOds?39Y2PTC;%U$P zNsHvO{e?=>BBc#$)V`%!Ge7mb*dkL$EYZGsk8u0uwr1RNdM%RAv*K!+Me?zfMY=7V zCM+`5>RA;!ERv7O7ETu}oHRW5s9u?vJdCTq_pn~2q>RY>q*<*Guv4Zq#QU69okKpx zE05jzwewFpdN4o3?VDMv)fAJbA&(zU$7KVj)>d)<@BWq7o`2E^998ND$zx=tjlxWw z`r+ivyznns2w+PMXd+;q6C#twmL4=<(czFIEILfDHbOSG!(mOdoqPu{!m?LNarlTO z?2_*Q6xmGLb0F%VPs;7B8nu&qltWAQP=hfiMsQ)Vat4gjV zELyg)v2uAp3+wN4nesVPhXT@XOv5ua;?{@G%8Z2 zD_dxz(h=6@8Z;j@s$2^k?XgU5UyT7)(hf%^t&{u3Ms+m98s$6cH5_1gi%b_bDL;T# zTjA`WE-2aN%t?dM$f|W5WstTnOIGTKiFf@8-6gm@XCMU{_&y+Po&yc9aG*grZxNqw z5Bu%sP9H};e9}iF6_(pn(gcIjiD!rHn4}ZWK3>v^r=4oy#IudFk0+dXY4FFBrie=+ zb6hlc8kNEgB)Q&a&xlefZUcEt%5^8lEa|$lou*v(vu9MMTz5J@<+{(Ar1~n1DqW!% zeX;JR{}d^r|F&LC{}o*!6R$A*^uLf2pA}}rD53wRVUmH<9{n$*uv4iOF-!~DDaoDt)^ zPB1{5VvCX!lmp}JStJ<1mKoH^)#OZCBoxFAfbK@Z==mK~;eK-NjIzb(R)-@789f_z zC~8Jj;d*kD9*p{vHvm0qqEj7=`Ezs_F`uR6DCkymBhCp!w-X)6wLA^FnrjFbRo))V zJY5*Lydn7WHDU0w$qp1y3IZlCkLU%8XlPwG)+|)W{G{p1n}8!+($tYeQPOU?&9+M@ z>oY*wvfI{cB?{VI*Hbl0m1JAY$LN+GSIN?(-I}5ZvrH2<&&S;N(>y(Ec}!1huDSo< zwyP4JX`~P9$Q7ZJ1OfLh^`Y>uE(C zGM)fT%tmx4ltXd~w4K3NFh}*Yom!6LX*)@0lH3dAIx)jzN)*`kw4GL->S;Rz`HH9Q z^cQIPPFm|}6gX*yLs{lzY=@1_DRiwt8k<_=_IK<}jqZi81L>WbrH-fF zl>K8TqusR2l#F)MDtF3MVMVUBaj8zZmb4?+29=6bWJbQ$tWqkyl{7~irWR=f)k>|B zBt%8(a4o8irMfafb5vbFQVZ!LwS0XD359C38fw%V^gKKoKT^k38Rj0O@6)sTQF zuA5YG^Yk#KbAx&TZR^x&A7GeNT}zAz{f`-R`AABkiKaj`0#tcR%v|~(GgYd>rIz0e z2r6bSG2b$%>K2leA|x6E!%{>eP(aEcZVbY9j;P88)qHLMa!Jv{J;I>h5V!o?faVX2 ztw_KW%|K4j3dlwv7PQa^_=AdQ1h|<{f;O6gKuAk910nXyxQYkDX0jPj!)mf2@JFPF z#;;N$X0jo$qMB$3WX)DQ4S}9xCu_4mM){TGo)XhN{XipE^)v+jJjK%xQ0>ig(wYK2 zU-sE#LtqtHVF`#%b)+DR^d?gRqEOB7N^eR?0-}gpUXY|W+=*}{Aey+5G=jn+g%PxZ)B&zCh3jbasn*A;cXV*$U3A6 z@eOYWL#pTya96?`nKP1iJ1wjv?{?{tIU{+uv!iPAZpU!|`p~FJCdIj3KS9R1rC+dj z9KidVv0&Gg^K>WVU`bC;LJpSnWC}SH`aQD=IW+n``y%9Ug#GvI2Nu~y9zT$UR4G5u z6xN^a2l6l7ogWwr#)Kcp9$}^*$PL`S`hnhSP4;n+1u6U12`{BPaNj%OIl_K=>VyY` z4S74^eqlqo0iQqZ`e+-{Br_yh-4Dr3X4h&cC9AV_t?G;ty}PcJO;=)HyH;u6%-GN` z$xe4I?$O$TY;V&(p|zoRVGv0x55)aFt=xbwIdEWq?n7zs8S-^&XQNfW;tIdg&WZSX zuY2i2m2}}wKLt_U4q%962z8Y9-i1e@jB_YAZ+QkVWECC-n$tf&rEz(nRFA?VJL4S6 zfb}|n!OS>^qWrxMV9+zp32x}|8t`y2lKrNC9}05xd<{N^(_Li~B9Yd@xrUWOAKruY z6;2Bagg(SaZ~B)`(#U+2j}9t7+oP|aDciZ8W4PBWBev2*hWm0T>$M;Itj3|JUUb7U zp_93swpvLILP>Pm5+!tqD4|CQGPlXA1gUnFAg!GD_9#J)_bNdqd6Xb?)0809QVDWp zTT5Gb!?F&c;z+4L&YnFsr2;v7dZnuZxtOwX(e6|r%_$WKou5*H(D_0I!dek3taVR% zXhx=C%>fF@6cAiJ;jm=jMuvzS(kZxsR~f2t1I7*s6+|TWJ81!4vo@a0?~I{0l@s+6-8@dx>fyei z8{qY*6fT-Sp<9(g+@n&M?olaBmMR6x;VikNEl9~5F74bepFpL#!QIJJn!D}MC@h#W zE~QbR%bn6FQ1aBHQJCh@C`^*QQ zs+CkM&@NZXoMbf6%@nBRN-~b&=K9nM)f3s1N7c%X3%}H~cR*03^t+q68;f7o4Hv4E ze|N)m@)wpdL90fg1ibuZ=O;6Ge3n8P_|z}%#upt*!BZwrrr_PM<6vh;GGR#3LW6Sf zZds#ABtS`cnIWW$DJzTa^Cjj_@Fw90^(zT4@_KtG;gRHvr;_mJo<<4yWt3v{CFYDv zCE+RJk0iWI?Dd+2=fs{T2|pc4c&Z}lN%(m)sJvFi6L#~8L@0jk5sCOo@W+xX8JP|w zC084|9$b<4!GCkaN0X*c;rzoe|K)PZpm z)5p1qX;A}vPE02gT{MM&dmnT&)6}?7qHC|r^fhf(`?5AJ51Hv>l9_3)fjwuYlPNDM z&%F~SQ`4dq%aWS5+FLoPOVOQPlDck?y0@gRD@yD>sT<65GLpI`*?^nVkx5-COXSdC zPf1;WkxofnR|3WF;Z5qYW!c4jPwL75Hrr13NnJOHz3)j~B_mbSm!z(@4ohQ5PwJ+U zMk1+8I@@lOx}IcFw@KY(f+#(yOI^wTQ2mrPVKz<^ptIU?dTTfDV zZd2BzuIR3%Cv`<%u)WP7qu>I??RI)4E3=c8-IL#SrP)H1;mz;P9_z{PPEY1{MVBo- zzYA%$(cY>c{JD1?H768K%cIJmXe7jWQ4W;$J&ziW8fke{Dd**od$v5Pw7~t#qjJ{O zPr+50M`c+A+gRW7s4QV}TPr24i3y^q}IJZh?^Y}FbyoJW(!rCf^X{_` zP?eW<7HAg2_b(rja(6D8pVi$F#^`l-rpA4>ZoA|0cBudD)xE>pApvlkMrOw4k?#G} z!&4s5f;m||9+LT{dpwh=Jh$EPI6Tw?-`n9~l`xgpdT=wfNMmHr)JkE){$y%Hu|OX) zwIqP>Xq-N7d0Ot|xys`7JS{i1R=j_CTGx~5DNoBDXv(6M%00JSb=H*ONz>Zf51xNg zKmFiLmxY_rlppMROTrKKXdJzMu=I|y_`&k6H5hEDS?KlS9=-l_k0U%eDc5HmvDXnE z$8m5>j~Gv6P6xKFP^Ya>nrW8ZZ5mR z^!GEDU1Wzo@wsfNe(YZ^TV^sp%3O9Tdcm&bzC|yb3@y`s$1gG>QZhEe@r$e;9zX33 zV5Gb}zB42P7#;~So3}TBk@7PUz(`4v*^TTyfbsS-_ukz8WimP0EJvCtpfGyx0EQcZ zNR1*m_cYHag5%s#1la-@ZTzM)d1yjPek`LD2s5Oj6!T_yh6)^$94e3{O5slUaiCQP zG0IC9TK!cWutw$omg*oq)RS^s12n2LH6Ez1p&se7`f0r9fe7`aoYjL8>N$=ZY&j~x zRWJ4)>ehaYhTOp`MPbD&AVb6ZrH#g^sBoK{KzVORW#K9_SP2z`H}3vPrFbbKt!{ zQGeztV&PM)8-~~C9QQvq?@_P@<>J) zrWx3HbW?YdR_^emeH#)^@$6+0^{~BWFY}7n`qwO0>Xlh%FXP!FyKfeK=`)*=49q*T zS$}1kBWMOvIkQ=Jx8=0!Kti?sy@RB^U#Piviy#k;{y{?}kKsq-~wAQNt zk3@=T<&n5U?`;NQ5<{k)LmB>F1$cpsb4*`SfEQDS?lp_D5a8Jv=TI7|X8|6~yiT&% zw9iH{^=#K5ZANqw38$SyaXr2UH1loRjOasX9{Q0q*F4W3&%*1pb0~hm*T7G+Lc8C` z6-n|;YiX}#(I@4Z(;jr}!xZFwBHsJM6bpV5-rFPY%PJh)-{<#G7Wt!m?56U2c)&*X zOTb9)@v%CeW+!pOl1X6{jh}9dwlCv}L^3r@G-#ThYNZJqygC9`7eo31dR7EMkM=pS z341AHq_U-3WsI0nFsT;sC}WPtoDEVf;8DiRZIV+8hMSjBiBT#sQyU|+E!}Bjri*C> zlX3x%Hf9p0ZIE&Sk2YrZSUGJ&xVhEU7`cKzqcY)&-lPyiB#?U>m7f$;xY04IMo$}+ zpNgC5HAP8rR4P@S8kFCSenY0G<)HjjV%nqMpp-NX%I|!wE!-?4*lN3PHx0^PeC~{x zE8q|UjP3*+lTrc>${=SGaL5F-N5C;v^&Pb=L0aBmGbuKyJf2K%-WQ^-enaRly3=no zr^e?~205F4Lnfd-`i;p{UTdP|aw@O&BM~Ub#Hm%Tr=>GFgw!X2!V_!1wRmQ8di~<; zsgYgA%XN|ldMC95u9P=jppX)KrUVKpp=UP&1#h<0D^M6K1qzfQrE4tfk>2hTdhAJF zfx?7rdTdcY;vPNrbdNw`a#D`Xc~P%GVURm9UrU>x>JgX62H)%zD2&S{$rkma#3RX` z<`F1NOe(TDG3pg4)VcHWT}0)zrbbuqYtBAUp!Pbp+ACq(x3Se9Mb18T2jsEULc5-- zZP{}6?gT;dM60?N?Yg%Xx;NtZ-Wft~(q3i;lj3z`1ieZ7#=%0o-tqEdtG_`%u&l&p zyRYlgg(rK&>sfR5B5SvI&faZZS-dWqwoA@EEk^4>x#FAST=hDg-)2!A=HeF3{hUX= zo;_#J`MfMSd$ib`vls0e%|;ZZ;#}>`F-iIQMdwm+t@}HK`{1R$Q(9+#p*w`zO{w*F z2)8%wZI{wG{Cy)(t3J*B-fvTc<1cC&2U z>SWjL)B95`l6GRZlWxDc=d^dSb61y|JNzEz?AuX+ zNgHr;;-YWZopOJAWpesF?)4hYtvU&zd1$RB)Fs&its;Yyuj!3ov@vIHaoEWeFscAV?rJVTHRb=zTc<#intkLdE zYC4rP$Vo-|KMH|M=+7tw@03_lB-(Ro+Mn!%r+3FvnQ2c)oSU;AGt+7P z|7?R04oeoteSWX6Wx($~%`CZ#+r>efq7 zOY@Nql*)sjH3?%7q@U#Rvu2N_@>~xx%mEi>zKZx zr)dvZBf9tWcWm2o`n&xfDG`eC$aJYP5MWOCBeYnhcK?i|JvUgq~Dq^ZDtM z-(`-I@E4n&$?tj}C()mjxSlr9%^fF^5@z={`JI%D8kIeblkkeMxeb+*-=+NC)Ho!M zo1GM8v$^)-X1n5S?sbY`5@}AB*Ujb*Z_3SP$4U&7(0sDNq{T2ZhDk^-+2dtT9qcP~ zdy0K@vf~~nd%B#zo|a-z$ZWa1^idMhOZIr#lc_wnne3yJUE*=FrzPjFSA4DAPkHyz z>k6dUyZ=Kq4vemVJIy>)!=1;n|5M)WJyc`gbOo7_kglRCkG`9YKQ-r_>xcF}=bbxN zBc<-9Y@lb(yY53F#z1%EX+OtmAQY0#D@+fCxN2@TbTL*VP0`JzAAnE@O~}V%HQsw} z9T}c9c3Q=@W9j7=&7F`8g>Wpx8wweOq3PK|A#Hs6B^NB1JuVs9;LwCOvQdY@=2Ekr z9@*&sBrp}UYF^*x*W+nwKbraV4#235{);}`8K}JT>mB?Ekn0eq&#vb$(X!00_c4e7 z{pgx=PT&|%s{Q5gxZ}=VkfG1!fmz-Nken*o9qub;FYrzo-D3pEo7?0`{0^?NMiW!9 zWt+mUCuI$5J@WnOQ~2ct0^LsG*ORh_ebf(Y3cr1e|FH0`zr!Bn^n2-3_;nZmF+C&S zvrXamVa0#EHLZ=-i#`xjM;!XYJE%fXjDPb;5&27(NG{8*^VN~qs?U`5wOw$j6V;N4F} z*q!LQC+8^biqfi#eO1K;w8QsW@3VJRT(*9zL)WjT=?nL#=gPw^`Z6Ig= zL+_jR4b1j5ePD@Nr|h*ts=99zA@Um2*(SQ>HKx52-KKpWyIpbA3Ek=s`+9dBuhDY1 z7|P?lyQY;zE2Zv>=CnqOr|Ts{eVE8oX-+>Ul6{KIw9l8Jm!#*?b$uE8qm-a;oMQMU zD5N!vHmASVx51|=O+H&0;|nPxeL2c7U%oQLSELN|#g!T#uUI=kDfiVVaj|OaAf?dP zpyc^jA2?iz`bH>WAHVed;xm@An6yWvnn28Dkq}&eNiflA32I89x*C6m&)Zw z9%&u-M5jR#B1cr~vl^D%uK487qJnq2YY`e2=3Pg=ts zbbvi+1P|zQyXZ51NDtg&K2};p`b?kb&y$=`C8<{unvlKqN~{TKi~5!&XGBQ}j#$-^ zMQ}u6dpe<&CSpumXvfvExM}`uS{9Mkk0J_5EkGwtd?_ZNNUBjrrKVy$&YgjxuWA-v zYbTqUh1S?@3)9cZ1-esEB=sm%pqpekCOHR1AN4G}Y)@7_%LVhPz}D2niEb7-y8=VY z7>sOH(Zq?}PdwmNLb$Oejw|;*@qqi&xa!XC6d2XXEU%kXb_EznCT9^~Y=8FtRaefX zuPsB&>IPrp%p$rI?v84uI5pdPUS@}Ew9RlQfA{kDf#K1l>FqR?wyi( z&0gL6Ago3wPft(DOWnIk6`PBr)sD|Q>!cFs-evaAlaZh1$;k5x_Oh;1@{i|9OzLau zuq>TCJv}2YW$)&O)}H1d8w=X;OQ*Qe&-y)gVPM?&>egE*@l4pL(o7qlH zh?LB1Q?kt!y?I6cav~(LnwvMd<`wxPv&|xZ6E@@bNs<3#H?uAJj(caeT_rS&{F8mp z($qAB$GIy1?t0BMB88d)S~ZypWa;L_WG0p`#w^^P2BZ0Pb~%3cD(!91>LSa3q*Tb1umsO>3$VB zH>E76s>Vo#l*!1E3aLDGW_Nz?JauZgmRTe7)EUBRwoe+Vkm*u%KT^RhGmCfE`N|)E z@lC3uvh@nm#P_t2Dvwl1_VcqicT#BG?NEhkcc_BUhI*X4<1ti${RHa!FQYCY4^^1P zLlu(U{A|9R&{=mkR$+RjJ61txLp{FTB#c#HH-XA)?KzVk7Lz8)#qhjyRCJd~H?bg7 z=3;nmCY`n3nTz4=dnP?h>#fVh@K__NM6Bf0Gwxz|-b}j8X7#=pp45qcQZnh>KBtyH za9y+g8%dGXkH2JQmK9OO1cJioG90Gv{dn%KVgkW5l{Q;&?|!`NufdOZWuwB6Pxg%E z0tmt{qbe@VIP9Z=6vue{__nwEElVvMVV9}#?v|2Bwc443IM{QQOG%{93Cv4Lq~_Xo2N!w< zaiqz+xyjZBqy}-gb}GBn$w3^hy}IE(F^D5+x9)gaZ(POoWm9n#*Ne>(S8@GTvIlAP z(bPf`Q^)%3WK1L@q|(N(!{Cd_^g6dQn;8cgq!()YBO$3ULw%UO=fF!yG%>Y)`ihkM zKQyCn5)#=2cejW|_DGP_g4(%$&+4=v_RtJhiJiWLg>;9VVl`thqgtYQEYG`y#fK3I z$~H8^ows*v=J-Yt3G#$yQrgh&BSFYqi7f6AEngj}h14T8om8EcK30qB!?hxPpw|Cc zpZc!LDI~RX#59Gj(=;PQQa@Agv&fEFwxHkQB|dtzwZ~m4*!RSi)>egzk$j z=fK8xEb2f9#lpP)96h+T5^h#t30RHw9h`#qB|t6JI#GC zPs>=*Uh@oylPlVLV;SC`dWf2@j8MbMIMq;( zl6LL1^!0=*)GEchuK7`_B5JjvjZ^y~M9#jhx!)M7TUjT8tTm$hF$rXeW%O~@>$LA| z_!L7Or-aoJVyZ}}N56H_||)lo{W+NhMOwaNfeC=5~y#iX4)&87J4G##U&9i{rU z(Ly%M6U0_&73x5(NFAo-sG~K%%JN1-AD5ivw@k0rYV}gBLC>RAzZ>t#l@UTc)5Pije0J(gLr{E%4 zYKqUPYE7!6@Vzpk9j4}ML#VS^r&efH;!5+Ub@U-xo@(lYw5S@=>$RZT=9LE;$CBL_ zl8iWyK1WRPs}cGvA({fzujHtflBeqQ`>IM2P5R2$@nb8eJ6JNmkE@*SV12H>$l-R9 zZ0@6c?4a^LqzCRLpJIux~O8ks01wX5nU*S!S_=rW9=9IktR0u|VXNZK3vMZCs!f zmDTl6Xu+A`EJ6!pmRV@AqlNQRG|Lth*xE%`lnQKBDRYpDW9~ir-L5dpb*x=0Gmo4O z@rnebv+7MI%J;)cg{d`*SZBab(L{imKaz}S@`o-$$!rRd zKq{xn!{7h=_Xp`($X{G*rs3~PE}C~te?%b^Du2Q&&Cnj|cB#47a0>{7G%eLQpHR;5#+dsY@t z=Ei@#Z2o661MT~s8_(ZM^2!y~O^ti9bls-LlUcdU)OeHA$*YRD1yKDAS_zL-tJS>l z9;e1d>dccGKOVYgDS`E*#^*MPmG|7#TW_iH_A4&Gkme;@M$?6{?sf;d#;vJ0_(|*&mJq+-jjE$UUTDg|DI0;wrT~OB0A7HWOue9CC^E&?#iG^KO zcFT z+4ba*r&jm|BvVg)Od*?8-?_ZmV^S$(N&#m}AbZOem_SUdi zOnL9A_1vs%fO4w)H?`jXg{*8Uzr*J0l;~82U8OI#PD<&AoRyu*3$dn>I-CJcWo6yu zsH?#0H7o0;OuYh0Z&ucw+6QX)jJ#4Gv$9fVNp(!xk-ypJ#8VTQPxoYICnqzr+!6PR z-3L|rDpT6wR6qXQ)3WvBMW})XRWUYQuT}%bKt=Tb2u|8QF&xz07Jz<{^>u36q=bghoq*Uvx&8-p2 zDi@jscBv=V9HyLd_FQwJt@e2ih}?kf_e1^IU9Oo8HX4cq1DF-l4Cx7L)7w^EJ_Lm9qu~u<)K$>Lvp90)-^RR?=~k;|NlYn_c8odh^Qu z;zUsucO+9bpPCV;F%|X2v-}AZ=2vr|z8}Pujgzu89ais;in> zDj*eIFf#l!t7_Mue)XLtryb*V9o-;+MG=CX9j?dj>X&5ym{tmKU3bqNz^o}q8*eJD z-yKB2MmdTmq~&N(dVGM7Y4t;$UBU&MGiiu9C>0$bw=T6#fC^&{x62^}$00f(z58y5 z5LCNE2!tEwi4IJ`5CZAOd7=aJn#4i@*O2FTH0d3wICkeb7$K}u`1YOw1T!$19-HVn zGb-Hy1Q*keH#RT{0|=xOmx>LXbJ|#}6R`N=qgySyTjuFeQagt9Le@O$4h4j&3|@D$ zm?qgPH)BQ-Rf&M1lW~`s8a0$9R`j4`I$i27TZC(cj#fAG>bgJ zJgu}DabW&I+S4L3?;oJ|u%m_$n*?%skCISAZW5p~12mnr1N9?MgdK=k;uhe~=RGZE zKyk(U7IObKoz44Bt}0?Nyh4LbN3=WzHv)OYOs=}Xf)blvTa$*(f zg_f97jP2XvAE$_|R=$SUO{XK`zQ9w%TeOn8S)vrXeQlnc-lEYAYKe^C@tJ(gjBBM1 z?gD(aNk`2xJuXKyNVTLXj_PHqn3qyoy-6xaqrxcHFjpquM=1O!j_PQlSz9TO8glK0 z(Xdp5+Gy_d8+3xs@fU zk90aZUwdNhjYrF7KHBcA9n5Y7;ts-n=j5q~a^*%*Yw#%hhW& zOD&>IsIHb%HaDRf1N1V@G%EFCEo4+sYBZN-o{4J3lnf1O3W<+tE+NgPB>;+aU5k)G z7V3_cZx)its@(oka@)2F%zRo?lSKO@Q?~ScE00W8*A1KM9c?*!h?HM3Gh)PuIb_I& zKW67xQPVU?HDO1o1=kEGkmIL80JLq9>MKIV8=xU~5i-`WWtw`Bw?lS_Oguo_A=(bo zoSJGV91PK3(6%i*6r$~*KVZ`+hcN8~gJMsyEP4^|`AK1>(0uazGSYg`{DBtj@#%ir zQ*D(DF%b5PecNx-o}c#YpdB#$S`L3K`Z!`=@%!oH^2el)6tn_HjK7GDeJ!Bm@>k>| z7WD(HpcAliZE?h+BcvS->UlODvFI|;SEkn}K_%a&V-{Z`ag21|bc8P0PS~QOCcTz^Bpm(!?0t8j9L16M zc9`9_?>#-`oP~%2gaQJCFd%}+Ip>^2&VmO|1lcCp1_RCkY;v@*$zYotLYnMDoqclP0Q>aEN^hpSs(M1#ud2GI3R&}Ms`A+cXA|_b16_|D zUB&r?9`7(ZZ*g7^)R?w%KH>8g{p}!ysf*WRRD%9=-VU|suLr4d30e~0Vi6OQ7Kcfk z0P?BDLUAN$F`!X{9VTtUZPvFDmBA~C`pe_7Mh_}G+A@{l7B?i}sZMQ{+pxKD1huK5 z35b0Rlm447jne}r1uVya6!c32|Gz8PnHyB^sXu?h@<(8EkJ;E?rzorDUdmU|fR zFq5+$8az-_d(^w9@4NA8*u05O*vWuO@6rhoItcQe+@Ie0#S=GOdG5iRLs>{q!#%M- z0s=Mn)MF~6<821pU^B%CZLtvnTUc}_s&N9#^gz?0hnNK077X%44L43(=!cpeWIF8t zY^&(RZqg2Hq8?T|drZX8}2PB#E~Und6t*Q+i8EY~`!@VRSARpY-7%=&~5YpRNwRIlML!~a`AeHF*LrcgT< z#2pTHKAlSd@(KTi%jmA+ucWRz68x3mFAaA)!C$Cj@BdOrv6S%Nw$tJ-i+1dk!OQ_r z<8Rk#2U`By0`kM(3U+_^TVpohmY|OY+k*8ps^77o<6L%LH_;-`TtA56&pu5@7s!vC(*`}zjq@} z*W#tH$j?4~!FK8DY47O^=KIyt^Uhs(>Vi%D>gjpso^|peEA#5NY4>d-C2A}LBk9=2(^NP5z-hs{kFNl!XvU;1E~gWsp0 zykNg^{sUrU)i`21@atcI^g>Ega>jzbWJ@I6LjNP@BiUl_ z(zB4i;Dn>*p*#P5>hTA!hVF<@qT$pN4n_A~Y(P!Hk^r|kWUS7e(nA~L#um=Gp&Hg0 z^}}9K##uE?;o1x5XtkBkDKBE#@a@)^z;{W3TF$Bw%Kh=pm%n}WnFnvP@;DYn4Qiwt zQFm{@`SM*?oxayc#*-v9a*%s_+0UN&)|IF2u^z_G{^36@To=ud^I)2k{XVR4`+kk< zFM-QH09HTf-|sPo|ApTQSYH9_e=m&pOD}u%QI&L)Ui?Jomg%AYOXuD%-F7D2sSo4t zFV$oJ1D*Fl{@#TA|ApTQox4Kk_Nz1Tozmac{(o8LE`ps~_WLmE!S{1af2kh(Z|J-a z^7mhm|G)5Cp>zLEo$~kUqhkpCY4R_NRnI`>1ZbI*mH`p@?JXVam} zyPng48}aY2(P94%o%cchehvBW@o$CBU7>T|cb)r>rbEwx-hVHDvHtnL`1fC{!+r(5 z_d)*t4f5Z^-wK_(Lg&8kI`_TQU;l`_-fum7D(uV;)98*&X0e8t^WEsblwN~`x)fFhrbm%cZJS<-*xUkqW(M^ zdjGxp{VjSf)>;4PfB!A|>tCVwKFHrsA^$!4t3L_JbmYF<&RGXJ z8P7fa*n@YQH=$Zt4LOPBV0sU-4ZrRCbPcbJ=7VFvmoViZ# z+h?72{NelTu+do1<700*mF==tCfbQ{I=Zt1&k{m*~?`e(1Nb&dBERe1 z4=-+>e>Tbu@RjVf?HpTKJG+vO$|^YM!qHZ}h5_ zTH0;$^vYXcd;;A%JE!7$`qajizV3&6n+s2-iUV}@J8wDDRMyU}9x`!o3g4tLkeS}3 z$&i_Lt3swf*k+@VkePOy0GVKXB;9TUncZF{vTnY$uKROyDQ@4de)i+nUR~S0CHLyb zui;jyS60FC+jMW=_#xjq^YR3A=ezyJzfc#toA#xV>BFEqY;i7mDS6SoFwp&(+5O^; zAB4`yOZLU&1^s+2erm+WGL3y9dEP!p5A;oXw&8&Zm3=;W&Mr~UI{zSrBzZy3+h@%) ziU%aUiIH8BJZqn^PdA_P{IkvpPTQySla>cWos%V&J10-sC+!m&!wih2FP*iI>&N&d z>3neUyY#GQWpBT!ObbtW{+zDL)bwTO8d4d@2mJPrsSFF<<{{hRfV5j}^-7W+^vtNd zbMn#q?>KjKpE;}2*ZE-YyEGSOWs?Qs!ULW+6XMeMpbl|-z>@{yLbr{O?QlTatqO7J zK{v!LIAqUl)*tD`xp(p8eme_KiC&IhzVQR|D$={j!N2~P9@tc#Lcjer-W$ueUA;6e z%&Iqj5MB-QBC^VP9zT?m^lsP}24v)+Z-QH%Jnx=MxCzhy$NmiyiUf~eFIoEg-~Ib9 ze)0ou2`@nU^!(!|{?yyzi6+mer%mDM(@T*&ZJtumJ4a7HJZJR;4Mm>5yg>3!n8yvj zpK;#=?}UA<@#ym`FYZm}?W5)qd9M<@ZSn>seAa$neb4awW}iy<&7$7+5&M1nJ@Z|~ zZ>RLn&fD+Wht)%-(BFKI&fAB~gN+BCEO4^lHE6L9ng`7NVLT)uP}m3T{pLP(uZm<7 zFQTyb+xyJD_8xxUJMKd+igQjo_K@8-pRxGu^GWq@H>WG9te(C914!X}?Z5Ky${7DH zZ#Snlt}?_Q>@;ueRHV2F-Bwz&q8CFQp21{y%^9um3UwYVXf)(p&!`RF!&eb@x_t=^uXg?>~S26@Y}| zb83lub~5SCKm6Bke)0NiFTZTkCQUl(nK8uVe}4O`fBn%buNZFCOh~N?FXa%K0KfYA zPhO+YG};HIBcPb_rZQV$dL(A-0#hq}+*t9>8KeGIr5aLM{;nqBuep8EzG!9XLJ zw2yvJKcK-!qmR1VeMhr4G0+3l$1op*KI(qWee~VxJL=ocYZl9W48}u!bgqxS%Y93; zJ|RBlVS_%#_tEzdAN_50m-?3aX7f%c9a17$Cj(*BNpmNSPU=o|hxUC$ooFbB&_{!j zMjw5Ly4~GoAx!!h?qisbzDuWl)NT4!71WaNV<1cVXy(IxZc#V0>OvoLkGY%r80JHL z^zEUKzNvX5^qBRX40kf$lur6Kb*ly=eUrLT-Qcd*Q7`i?>1A%$G^AU!@1?I-*O55l zM19Pi2I8oX<~|ynsE_)F`a0{!Y9I2;&4DiKTX@n@`);!enT!|qoq6IB`|L2cqp~Vg z=Gmt%IB@3;2Mnb80q386+6jm4x#h%>WHMfO?it4)w&xbBOsou|7NGtP>vybzGVxHe zCm*%n_UjE?yYkjz*x1J%vioLJV7{&1SL>_vRr`9~Sybrj4A=#`Z?O^?jAx&I;!y|g zy4CuS2>o};v4`%x?VK)1q=Vy*+<)gy$3r4@JK@OvciLnnNF+6R%)xtXHM<6h;b7JP zNbDt3bl)96IuR0A@e-YTdk)mvAAbF#XCJ!#E1zB4{deP!zj@=O$L_!L+H1c0l`nnq z^PjtVRri~B-u%_;FFtnfZMWQf;|Z8 zZ{PLJJMXw1J#M<;`s==)5??ja{Y&Gm|N8YCuRim=2kyV`-h1x;&bROS7WKUK=9_N3 z{dHaxrDcEo&wqRUm1iFL-uJ%y@Iwz~1m7frTW-4XhU+5f zSAC|#Evmis?jL{m>!1GM`6r)v{IN$LedPO~EFqPF%dlA36|V92?|=JmZ@l*0GfzMD z)RRR07^sQ-p`7G9Nittm7%MLP%FkT>(sN6eJp1f3&piD!Q+weu?r7k5-ofPlQu)4p z?&_;PbH%4)>PWaByT4Jmrzttzc77tbRaad8DG^Pwg&J4R!oyvo`}|Emc)oAfGC3}u zM*rzg(!h(8$8|$C zQPa?iV{ak91mufp+$5Usxlq%E%h36y@t2+_$E^qX#}{AdiTR1ib$e=g;ctK%;T!K? z8$Wm=znI7`Ajw30&)u!m^v-0|cxma{ap&>cGWo}lge@iJCl<-(H?D>J$^!W!kxUN^ zmo0Y*fefDFBZ+R`KB{#MspY;!)VOqhZRpk!`9dBxNxu0e5se2PWD7OF@O*bu%@;GIZPV($IY6OQ+m@p8SlMI2G-w<%N@{Cih*)ap@pO zO20GDI1QtwJ9hnbe9u@kJu$j#EIXs7OUHfZJJ)w^FOi>q+Nn8W-0`n|gu=}o`1m74C{>8G6n@)J1WqDI-!3(j4LkjsVV!M8kQ=jj?D zm$xpYS~ExNHLqH)EIsG+;}6??lc9a)sY;(l(a*C^KM5g|v(G#Qp6IsI(47pfQ%^YR zfL%69(EZfokJx|54F~(~sEhgY=Lfhyz58E3dFI~hF7G}0#N!jU$o!)5=D+>$$-BRC z#iDcZCZ2KHDJPwH{D1u9xrc85@+V0*UWk_rPx;K#ahpy!?rOn1JVQ)ey!uFSdHSg* zpLoJ?grj)1h~NUemAz--tsqXvW&}vH2~K$4%;{JmxEL?;1$dS$8k~+lZUG}Iy(Ot= za5~}mV~=5|ObJ9Z#Mk%u2jBN9e*zcYeEXhgyY(+C8(ea9RHfRTF(6zS1VaEZ+I5%Qc?gDpz4q9Bw_SEl`{RoJc?j5b z=bZu{I*(fZe&_nXf@;zIAq*kJQs{r;8(*Eg_G`$7JG0{QRJ zkK-UK3c!E3@{kYgUHmRB&(4CGLkqKeV%1Ss)=bx#x;jyCr?>ZAT7sQLk#WELh(3r0 z$qH?q`?zj8_VLw<%LAU1_)4G%D}xS66!wx5q;Aq`u07mA(OI^}ch) ziANr=%jQ@o2rJ3FPQVwl!$#8}F1r?p;{#qC<8=bxZ6d^_-Kr3m9&|$-)}6e=D%?Y+h5ZuAUzL$Y6EKyn=k;#f4|&7sn~T>|FJ$RqjPB1@KM%CB`#T>a#$o2slp;G zap|Y{nRacw*j+&3O}s;g(aQDo^kH<>D7+a~#5ug_AK=uHl~HN8+5`%3@&m+*IEOcV zx5;Z){=7I{16sGzoYmE*AFlLuZR`V_cqjL#mFwy06RATc4*ZHZ2RQvxoD7+1w<=`% z1FVR1fYW!I0GSAI`eh)OW&KnZvfVSZ z$RkfQJbPN4#6nQ|oU;W^TAZXeF8}OlVNyL|_$)1^<`*}0v_P6IZdxqJIKP-4mQ!Vk zlomH>fk)2fmprjJ6D_^VLZvK)S}gp?GK_s9;bjjxFH4^0AyrrkrG-sd@Kg`*dt2XV zaRa(&cB+UbvGS8QZ~mOl%F5{r+BLW`o(@i-tt{h5SB9snlv5{D;nA?OW3@^(J?L4d zvQ)OaOzyKwD}D8idK+h)c+~7v5sha(Dlgr5awWBQF-p`Rq;RMRZ;u z%)iO>24b1<>6mwTlWAQ{JxJp#zR9$BZy%7wKawg-^kM1VVqq`834qquEG_9{$*XbC zqbY@K1CT|1S`4#y6DPyl1L7rpbGN0Hy>zw+FIw!kyy#`Io=4JYRJ1`rc$x25EQeVv zhc)l?I|Qi7VqwnmN*Og-S}Eh95j$zISVObChGuRzxADZRZLs(qnuUk$J2Rb4UAD4D zI#E$X1V(~~2$UBYn|7;>tqhfe1F)HFB{C9xw<%;KWZMa5R+b&U_cpV;`l`z+eYFjG z-=TT9|86tW`BaC%bgGVpz;q6x?#S4*TNMK3U@z=GgTS=gL^2by?F0~bz^#r!u)| z2GcxMw<;{Vhc=QVv)kNmZ!@==Tinf>)deYqFuyJ6sLkGNZpzdJ$s&&CR(p$~mK)6t zj>n$oNNpBv=6Zdd@){$@k=x95<{SF!x`d~>-dtzDVZLszRo9R_i;;*t3!X$rZRQ&D zHT6};<1{y09!0uh&OY zC!mB+=vG^~QV$1nN3TUyf4p-vdEH6_CUsv&qtchGpDLvBuy=#y0C}l8szV+fh~)rz zq1#52AusJ#g}iXE{z%A68Bc&bnA2WfsycoMTQ@TucqeV%f0@*3HaOV2C8|fiIJiWC z(Y8EP{$Zv+|4B}Tk=FRrbFjVJnhknMlU&X+@5Pi_4eDuKV*ipY>Aa#U+70T7;6PM2uW=6ZXb z`$phdu5y~!LZb#fR;FCBeYwiD8gA9T)m&~qtv{twT4@zpeFe3ePnl2Z%UEmc#^MHaF!t~V9bKuc zmFn9Gb#nW>j-Ec4_V5SiZd7H29FS=_iQGQlZ3?-4SSgfm9_;kW+Z^KBW_C|s*ZNp0 zZ1gsutFeJU#LOTtRk&jzFjdmiATa3VnN zT?5JzyZ1$%zK$LCYo)4~4NEwFUY&A4DtSd=_kQ?lB4|?c(ui`SvL~g^#iWuK965f? zW%BVwU?af;gr%N)TY_WdMrGVRGbynfHjP!pMrH8(iYBGPru}S-cV<$WXwyEO%``GL zw3hmVydATRNvYuZWxQ$Yf8>Luyz?3v+de6hQmT-f53&l+v4OS}ok*@-xV*iOv2`jo^n-cg`YExR)efnC>Hf$y@ zZ&T{8iRD|S-&uoy#aqRxCbl_^slMdAW!z2|t1qaOHrTOweX2gEQax@{ZL3NDvmQ5} zRafiO2F}xxmM2}TuGBev$Y`lmLsP3OaIGbpI@87K)0vjnz>iqVo69vcwfbbhfL1MU zKBYftE>o9=F$+RyAVkpe<}!V$xkO!@=d3*jn9Izi`Vw=oxk!CNXbD{eKMXh<(3*?& zMdlOc(Y=gum1T>U@owRn(b5io zgA_2YtFjWn%zvsjlp-j>FBwbUAO*~uQt1u{b4RaHu_;bYo>_TEzEkTPutBA-vaEO6 z!jtip(9CF^h`&M#mth zP#DR0(aF(=NU>w0Us(w!d{kcIA_f7J0DcjC4Qqiv!Y%becRQy9fryk(OKd)QZW({1 z7K2)VFMI$3SEV(W2~a9^O4L)P)G0AfQuL$sB__$R@cORUf<9T5IsOF$2BR3$_zSO3Ebr!6ITj%v18&QrzYcU zBG^y>VeLUU1|RsocC!za)M%ks|*g!`5JK5==-D}dj^M^;gaA`Gn_Tfxzy9=`3v0XbImyh zp4G+uz@h0iXPdJc3qQedTI5gk8trDGIkR!b$09g3i!|Vr+RfRT+szr~^u}oyMsO?g ziN6LtwVTt-sf|<4=j$UlHh^PlC;r;En^Vlm&6D`@V(~<-K~Bx)Bz>Yf!Flm9d+poJ ziRJ`-ygJT#_Bs`BPSK#Jc5}Qr&Kz4=K=uFvjlor=Kx68v*60(uJ>T|&Yt{VAOb?d4HWb7)UOm3hv=B_y2Emy~f1_)0FJ zzDS&02{@KvAY8t-4xu0v5GKO)GItQ}TpMRFpcBw>Ij$hEX}OM|xuiX=3NDG08#|#z z)DsuC=wb?{3g$&)_K;RYyx_i;;i&)~Sp%l83{3;v32l)xfn@+Y9U-|nLo*TwC>1Cq zoX>DNa26mXpfn5g!VE?=!*GC6jaGAvIa)`Ybp*1YMXNc=9H~+WHz#Tj!9q)|`UrEl zia2YQOPs0Ipw%3v4^^d{rPUm24$%jz0%z@Msnr~84$=pz63*sO&8_A@dw|+s@fBrq z1FbpG9ANf0`>B07kRY|(Dp`b-K77x)d_Ivz*oPHDn6x*hH9`uM1dzDz1_aJWPU%zh ze2i53TZR|)pnNDFBxJi+*bVcJV@yFVCGC%C4U%S#n~H*@+0t0p)q*qzem|M)cZr=n z3X{snL{6Zg55sAXjOFlc5fTO58h1X_vVSH9BMOuTw=!P0BBzW3r38E##Kw?_kJ(EC zrD0j#+^i5N%{Js@?qNWh5GW06Yk5#K*Eg^8%U$jKL&dv%im;af4Mj==?9pm}d8D)m zdjVwhR~!ST>=PiavZimY32{e_SZO(&25|dJVx_tS82_?ZX>bqwi+8RDhRug7H$X6Alo5!0|< zCu?r4Kt&PLV#GB-RU9!5Yj(wmXdE#W=UB#977?Y0DbWZ1=3_;`qKK(u7q!*J6xbmb zQJ>{FVjIR6BCauL=`$T7x`BUiVKWzyz(t?#;NrH2L;@~-s>?-mW4I+3lb}nV?7WMd z@y}dL0WW=G(SgliQNT+dU&fpK&j4NkzJl`_0GGT=f<*uy`<}7y8hlTIMSWBlwQwfS zRRC9jPZKOgP#!qPu&53buQ<;+1}}9;4CR5A0M{HQ(54P5<1DQjplJ?N2ap+Hj?obu z=V8(9SH_uW1vJgRZl8Em0gf$0s@d1wmtOj&Vzgj zNYX`j)&D6ZPt>}*ikc>CCwSup}k@~WNN16d_s|TpQsC;BrmOleH z2Y}UIP>9TCkYDCoy3gvizNL6^?kc*TB5e$00FrbevwX?0c{zt?^X_B7P(i`wr=s|5 z0Po-f3J5kYi&jZ#KTBvPj1mlNUQ&qPW)K@7uyN7n{4#1F&mcBHRO91U`-Rl7=$Jul zSQHFV+ANBjMOlN#7NWG|8%u<^6#_$)wp|pLqO2iG+a6-gxe}#qyhWG}RBpN|;rhqS7dB%s)hN2}0FL_&nc7 zfysL;MsW#5voLKICC;EwV6-euOZ-Eamb^fuXjg#R0Mi0n@K29Y zM>_U>i~KVm)Ev<~oTJEM17z%DC$xEJWCUc~gO5s}*gTkH%;heu;9m1U26`HM%shrv z7d-3K|BYJ>K*;52bp(EvAxiJ#+R_Su>AhTJ2IOJY>}>&IY7Yg!TLvw#Y75|}c7uV@ zFRV6pIj8{U#Mv}Ccnb`!g?`epi&oCP*i%6i%Y$Tm!@8y$Ce(ry2MMcmUvMwo%SLmRzMwhb=-@s1m8=8 z7vuHk)Mxe8>MD0-;6>O=PBlrSt)S9N(>5V&1X7=IS7ep}MQ}AnPwSW(TQ@^5M1QYP zmp4DnKrSA-Fe8tYx@l&n5j0hot554sxfIZa8SMj=UiwPur9Z8Jx#}{$^&A!^&zXRm zcu6mWlzlIKsk%h=g^GVoAztaldrBcuV_&GcRAa}Gx=8U}DB>k3PZB9yOTE-(ntN&N z98w=we&-U|0$PIDYzt`gQt&sam&OhvwOB=7vjnqgCo1vEdTHzO~5{S9gx) zFnaKoNg{c()Jvzm6nV>M%ecZWDdI&wt@P61MZFXN-7TbR%=Rh~FIxQ7i>McQ-qcGk zRA;&~=o)E9l<<-z;?RryZw2tzXQ_f z`n=Ffe0l0cpvPf;hklW6p0?vOb`<^b^`b3=M*?xjysCpJzv54~ikl`I`g(3p5p zFMTrg((rIqwERn9X9*pLK3e*~gI3WJGc6GlAM)?@NzzACA9&e{4G@YUhyg>gXq}j3 zQ6G&y`e=2O;-zRYBFG3Jl+X9kN9iNg5sH_iB@8ZojORoCuk_J}tHUIqEnYtbv;>`SQZY987&Qg4m7yj^jXg2)|1o33N*zy}#a1?;C>M5-8Uk5zydbz(soK zee~YS`~BL-3@9p~;VJ9=4R}xwy_eckMZtE78)yJKfw%O~0DZSRT~B7pP!Hl^z{BjN z_tfy?^=@ugF*;}*5z!znBq8(I^&aHU6TPAK z9n}tH?Z&s89rX@+d$(OiFNTW&>yK(Sl7b;5ZDhKbjm<~(Mry8QIx&UFtRb${W;fDv&4zBP*yN!$i#D^7L7Uk?eT1&l zZZ1ZTv{~O~Kcd$c6UuB#<`8i-b1kUsN6h+Wy~do)ys2b1w!Y17U_N5eX6ER1HB;qV zELzOEcDBO^sl|ey(Af1Xx0qRKrcSw8aHAHxu90rfgg2&SO%VroU#!5batGOj#J8k z{FtMWeNSj96CF#&Rm;HB>kibJaK3cPNp(~iu?(Ej@bPtv?A(>h*g<|IW#1#glzEUP zr^L8vbk~?#GVx*Pa^r*?)JGhi(bBM)Sne4_(>>?w7TLKgr?G?luq*J@4(u@X$wg{? zdR&)W%;X}RE}ZULfj%2OW$?nVMKnJydR{3pgwtK;`zF%EjSu3H(2IvHg85<7Wy^I# zG+j8QFf3C0(S!UTKWGum_l$3v5JNO25#%?<%f?F+Q6G2!E;ysT@B&XPR}ImWf{^aI zP}3{N)VOsd9NEY|0W*w^NEm+4(GBN|=BxGtr&x$put-8rG&a}T~?vNRQJ$Y+U`Br~yyrh((G(+kV8 z`M&SBFAGP)H{2}Ew2FdHr>oOmpvT3xOs-l6POm#%w@{1lJ$6T4I9xATxI(K=Md0b= zS57*SE?TZyMAH+ehejh$hYsppc7_!i(<<1P>V((me)G6-&-}o1)W~fIYLM>)I~M^l zmMgRh`v%pq&(lRSu?(D^H{CTFIqo{BN%&4X?#MTbFPJtZ67h4#E@&mjz+-A2I>>j} zUT#*PRWN21B3Uodu=$3|J(J6(drq>6nuPDL{r218-NenJ&5nTE%1ZbLU(7ibk3wlG>>ryHJ%#$`vcA$+@Sx7}vzL87A%164!fLfZZB3HtPWBK{)C=1zh|jn+;O_)o_Oo6=5NU+ zJxu5@Vj)$ue*-%-en!s+NZsy;#qFwg`Q^?#@vY(;O?P_!mLhlFrkiZ+-2+9YKZeU@drJ9+Q1Zp% z8Rbbg+4!S)ky)m0p;SAoofJ%Iwf(Q?-5^@JTE1L}1?@*S+K*+znShZ_qt!gxj8bj) zYoX);Z?XAio6QTPbLR$;IwI6wq}onx`zsl)ztqjyYMxPfMYmVkt8!vuD?FhX)G$zK!r}{ z1QMN^r#AhajCG^A8*aG41|L~}{q@${mE0Q)6tPdp(>zd}4m8lIP1MG3iogvw_y`lu zSyy{;8p9-ULZ)$jF`4?Pf(`zAl1FrN=B&H!Y<7k;J2OJ2`L<|3N|GjIYC{DR{7)Ds z)6JR%7l~XP&BBOEvoMWoD^jWT)p}}T$AQoq4}D^=!8biQ0u7a zjkV{q9HG&h1{#v1aUY0A6zG8JAj{DAY8OpuJnAF(#6rahEm5q;c)kUr!JH)fx`hz%Cm2OMl^?_1Cy=>aW3H zt)W&|%$*!F;;ub+jXO)Dq24--hI+4N*og~$HAbQ_l6+syob_sIRmFS_^UeBd9yRf$ zQE29?S5>PRIBRh6aL)r*jS*-bLFma`SJ5jgcKI}1G?5>AYR^++ti)5Ttfx9$6}fqO zw!ujC48uG%?y-jS&=WkT>Xn3}fon$`4P+C?te<9%dL=c*!3Cs#CfCp4YBVHk8YA(W zq9$j(40AIqHT2R`6?*B(YLWsk1DR%R1DVvzq`b7}r6;M0F70KaUIr4Sm!3?$)CA7) zUEKtwQ8uY8NQ#d~_u=nR_ zJiuVUk{8S8*$(pOH{sC)Hd+5oHjdfH=RX>W&7I%Kj|P{UKR>sOJpgO&hA2OGjJHVysNlELB6ueTm^4_8Y#$^D_#$yN{pMY{X*>#mE_!acA7 z|MljqJ9{>B!Odi|Ld4SfS+ihp2=s%yu;KGFXX13$UD%-i%o#I?3lB15L+967hYSd^ z9~hAVbi^L#r%z{$XYM>2VngTGUK^JbcW3rEzt&oGn(qy`gzj{HO+HOr=%Q#e#AdBE z*PNCL_1&4xn$xDO!PWtFr@_!@xceGwtS%T%Txjsj2HjU*eYF75q5E3I2Ip7hu>>xG z&1$Qyx(YK-xrFYkuCg)#HZkY1gUcGLQ}oTl^Og3}Wx z@(5*!QTK@xCt%=ZrzebWb9($ZzE01Cbu;v-8n4C?qA1qbiZpgOJGOXMQ{S=6#?Yt< z1E{YS4rBEg()jT?JywlTqZOloW}X_EtoA?4@4d=;{*TJ%Z^?T8I8 z{(JQEar_Tgw(<`;d;CDRxN>3NK-XJ28~?gWlkd_1WRpUsjoFL;L|@o)`fE-n74mFw zI;oIngR=;SJR74!Iw_>gu5mgkra=O1&LZr)O`nT z#YYwrpp-qf1f^e*|0H`8@=2cUbMGvnTFfmEj=t8;r;iP3Q8-EKE7g}Ne^>SeH+?Cl zd;*j#E0}zR780Nob2Zv06emEDZ0F%yGs?3_2~e`L@po*L0HrnAtpAWY{eC;n)o4*P zmS42`+wyrmO@0)-_islR7rYN84mb^{f1_3&;S1hVnfKcGGz}=~A9ET|-)#z|0nHK? z<7;~=e{45GCh@oB`+Q1#zfStH)FCi^^~Q1@Q2$O%fxxs|6$1UiHXDuNJfObYM9Kr2 zB`k(ODt{~j<>ep+uulBYIT2_)N9`*}1X_HL+)JZNrat8XEuH$3Hb9bnrs{*uAbyYHtO4A<+%hbG6qO4Q2B7O_+^LsCQqx{!;72eorN@w zL3uN-%H)_or(Rhln`(n3O`{~)I!1*!DYwtjSe$f}W>-I8{O8AkAp4X!pQACJbu?4r z42?GTIg`1YK0a=jpkGBFAKM4Q=S(!~=yN8AkB{@*cs}|MkEFP^y+7pKpf9Szr%c!u zopQ@QFt&axbolf*aLa!hmCw;=vCTSsUTkkQx0stLM`QSUD}3T)d2=;wiMBUdj3Uo5 ze3Wdk!5MkFB98eFoGdm{mwk6^L1(U`ZOZyu)+xyYiNd)XYeH~{ZW%mQU%TP`7@O@_m zRWP&8Y4JiaB2J4Ja2f*BZdC}B1Iqr&Y4HM1lU11JW7duySH(ap!90n0$zJZ2;HLeL!)M&ps^p372x z$11~ozcs;u%zw&^*AAp9GhWPv=D2`#S!TR|(armzVA_E+2LGrCE<$vc7_X>!C@Gyw z6XTUB3)fE)SnU(zWvVAu7K#(&iGsU4en;Kd`j^ z!wQSfFG60tAWS~ru+TpAK_lhGv;G4Rk``+p(lH8o@kG~UJmU``74qU)(9tI$fhW<0 zECkJKxKY#{5oQXAzNRo=Ykc)Kukb8dg*5w$BIL!hJlN1`zb>>PcaLPnvtF^~+c+U> zs`N_Q=(7b@h}33FKaNDk@`A*W<~8KUDa(o%GVjPI46JO;eT$cRy}C}6hLo$l1t)1h zWiqK)vD}7}Ulc62@s%N&@|{}g3ySrERZKU?OB0<;l)?zfge)ph_e9ZS7X_-}5tXGOwU0F(eI8>d^S8|-nX=84Fljdj zkEq;kGn_}Q+-_4ok6M}8hFsxo%(i?QwY=_BNTb#+5vjQc3aG8wX1+sd)biZ2M5L5P zt-aaizDb5AebZiMwxM!Ve`eeLkyBPMvUDzqTC6rni>aHH|JJ=+ZBi1o{>(OqBx*6w zyxK%{1ekQ8q)eIC1d`klRB>6BGa!}7%$f z|60fcs*poXzJI4r)8hPV^r0Ai|BX+;S`x&BkIf7|{o>EaJS}~SCYTl9I1Kt*o8Kf+uuP1i_=t^g)%00bu5IjjW911Fkwcks=7e)TanSYU*Dt+qQ-sah-&FOtBgl#KpXHhxGOc7@qWCoC#S%*wM;L@XznRc5;T;0&4Ly-e3^E=6g|VDZ1Uc8m%3Rm2iJQh6wFFQYhRj8SBD>z79I$wFkR!-)%$NodzDaV20yfZ(3dsS6OB`&l$09~?%>o+m?aFhGig z%`}&%EP@rO{KjK1A7mf(AH1j=|h8c?G`_#jxt-Y_{WfTEO z?0tzRl$-mF`yPKhNN$Y|ARNN*lLr}luenG2cmlPwn)}EX-H*BNd=Rk=WXv~_sub{3 zZthb&p&YWv{#Lg+KvR2b-`%1y^7i(=@t!~oF&T`|N8#nLMQK>{^~f*NkF}4FuG9EM z5w^%=SJ#TalF7>(`|4}KyC{bk#hJ|dGxZx^y4gDd?I6Z|A^WVm+-P^7)2X9iQxKtV zs{;VJtMd*>1~H-P13n37=Os8G87*Z}A%h>Ef*0Va2rzml$Q_6X)i|9{k$FO!E`|lkE05)A-m`d|~AnrtzV&K@p+PMCe(T>(gA&IRA2d zJ|0jmWO<qMGc{-=dTyh z2g{OdTKPm~v3#?LK6}n`UE_0X9$$IhPx>s{;6oTnWEMWI7XG?7pX(Z*VB_QK@L6@n zKTa5ikFWWIYVGBlv-H9&m$p8IvZSaJ3CpJfk$ts_ArzJiZsHiK#p^-1Hn}puA7B-I z^-7X2cPJQ9b9nF6ww z7tEDHy7@&jiO8cuXTjwQ5jMDdTu4{kw<1cadsLecn}ve}q-k;N2y+R!%(q?Jbue?6 z{+0$Bx2}VU+obMnS7(V*lQeFBfStY|spyEIFz~%Jx;TNTM6WE8qfkq`XuQ5jwT-cn zGo^0Oe#M|X9tM{ub?gEPhU%RZerkT57Zloic8zQ9=qJoZzMZ<WKd4{7PJa%bZNGkz2MufAn z1fMX#VwQy(=|h%NT>@!CmQ!5<=|WPUu&rMQLqYIVr&-AgeqD*jSn%sSmS$L(WeoF) zKHBCx3;Dzp{DYZ^# zwqyrWo;K#JkB`%Qs?(`Dh9G(|uePMjR6MGXM8xOhJ|@l_rg&78h9u@}@O@-R^Qlgx zE7BNqobfEQQsNMf3;3+oQj|I$_UAQ{KiPhTh*Ec! zBO)crl+>NHdQ=WwNCTFxNR>esg){T3PUai&;*k2X^XpvsG836^rV!91-#4s^xB7KR z7Z$aad5lOC)(`N}5|O$}w^=|+fv+T>nFlX*dEVR107yWD@_WUeYBAhNc{wSd8NA$b zcTxF(X2=LiIl;1^B)MzqBFCAF&zL0jB>GkuQ+*B~7+_9DBb*VH)Hfd{?;M6oOmf%p9Q(?++*m&eWlK&N>H_ zlz9rD-WPyUADPcRtqyDtl;$9FpgF+pkLzvW94Eqb`%)&bI5BA4YW6kzxV@z{&WB|V zu=|_+sMYLk_R8Q{q?)*GPqRmsN6Q?LwOOBq3VEUq&gg95Np!p0-OR3P7suC}~W?TPI-L2ZhWXV57I_Q4HT?! z3I)^2yKUzjs%vTd?U((UUuz4n;%zm)ax1S2mO-q5j{6d2`!p#~#vm)8Lt)o;L0N{J z<#>l#$koa^WE7AkFe)#Y9)n<(C^LAD0-%|1=%R>g-unw{exYD`oKri%tHdlNAtrIo z{JZ>`Ur2;W0NEOiC4dSEFx$hQ@+*RQ@QZyz( zinNxmDP|sGqxTXI-R+^Tan?m1I?JF{K&Wx%$8(Y3GWctpzL=rAKTol7>IFW{WqSy0 zoJ^@JgSSZewgm(wouv4KjT8I&$|A8b3^tEX9aTxUO>SM@VQe1T55$V+);uN+^Ty0$ zm$7-2_eR@8Ve<%&qj@Y086yepnul==nUY|(^BS9noFooudo*;OxIG%W)a7i4hOPxk zr5uw5&Js51ecjQmwIc|H19IuTT>-)4R;uHm_H?if@_3m~IgRu=unl6wOi|clVq@2X zBRrMXfVEN~LisVZVy%&EkU9L0k(TO1Ak(DBXv-K)C~TR|A{(RGUTw!VL5knR(}GSi zH6j-yT5O8lq2ffy@aR0Q#~iKC?`XGD^WAP1m>+WtX{qgevt?t8U3{CxNV3e2)MhEs z3C2M!8AmhU`W%gFUTj4WwzgZj)VH{(EyhXl3l*ZT?U0wEs8piK^y7!R>tdcU_L}R- z55-m@;A?w76qW=PB^3THJYkNoxfLjKL637e-s~Kl_x*X=@&@50zXa(%c z1E@lq`LeBONI=~_G)ss?tvZ!US)sE!N#5f;J@z<@6__Z1s{0Mia^~fe^C(;NIFaAE z1!VIcCo(c0-yUPhhf@boChPt@PNZ~$KiUps4SY(qPiSrDak{;-fN>cT+CB4>0e=Z$ z34P4&g4_Xpi#Vuv&HT|Kx)Ro@oij`?E9szir0cNa8?!v}V>8rhZXY?hWl#v0d#`eE zCE(KAC}tYUJ>|f48@sjJic(99Yn+EyyEP>`);YM&L!sWnARROTxdnX2&`R*BHghqM zLsm$fY>^Sn&O?%FhE`Oo*xDi)bAVPm&uofZVJSaqA%0Xr!gA7N_fewBbCWs|7Wu^- zw*+pXf`p_vZfrO|;wH(IL-J$f;Mzh)M!d45$O)1xH`j;wJS)nUOgWK}vP5qwb}4rT4;$}#&pAf+d@kr?&%8g+89a2 z-HhriwevS~b(Zpo*QU-=naA0@C|#^<=W;eb4!{&hZ0B<}7pKdWd8aeme$%{wAv5gm zDf2m-=lKQ8Jnn^PE-gt)w6=ejQ=+wmjG6Rew3VW@{crv;$bjp(%0ec;75~&3j-$Or z{<678kVu{8a?#{sJePbzb&6Zg=ATevsSIH=9F!7EWf-f|MM^5M)E~-{(}@}Y%kepp z|9?3yCvyKU$KzCoho#ka4k!Gt<@lSZ--)V7)-zYJyJif#jB>Br$TTeV_rhKXuR$KmHPj3sxovH8xx(sm9f z3K$enHbzCYX{-C1AsGriVC;gIMN~wdP?S*+^vz=|ftj1DVFA$SGHz0Qz#_Y4kyi$P z&5wY9;JOtT&H9>Qya=#VTfof;ARej_5WXg;Ie;XdrTChlegV}&klF=_uTVf|lUYa+ z>d#B%f&`Td5>zfoDAlCLZsHxzCNq+CT#DSn!_K6$$#k{0!T2%`md_?@o3&JqgGJwD z?PRTFP0M2l^cLr;YbMhwYsB^d6<1A&Vu4os z)z7d6D8?)JPK!08S#fPM;DtWTof;|xWs-|4kP={RAArSXos%fQ+TV5^^4uE7pW`E} z?Y+Xrv1fCLwLibGam>QyY}(OBH;y`k5idjAR^N~+0JRUnQj9gO{Uf+kL@g?5-wqEY zT1h4C`|}N@q!{*MfK0 z*!|FyGx>S>_$#eR>X!H_`IQ-P=_uyg>L2QzG{;xl`G;_#Qj{%=ltTIU>mEw=9$FnO zMoJ0r^wzFz^pyYwImY2SmPcO+pr{^EI|os3PH>mTc?%Amn%6G!N~q!rG1(ZpkYqZA zyCQVikD9j5p`Pp52@SmR*wxrz%TgG$8zx8|P0ne#ci3F76b8vXM6TzYpJ_J`03(>m zJCg*C0zSz4ox)uJM}aD2W99-rc@QK3YOJ%Nhr7UqK#(9zPp1+=c@QKBvui6zv~%(x zNWeyLN#H8<0ql@Z+e2$IBZI(Xnpq>6B@k#mELNu_YuMGbhgE^f1m~)&C#yLRssx|O zwCWlO&Q(`+tHiX)>ebbfRjbHEY8Yk%ZFSXTmFmjKC(X3NuZn)j%GIf6CE+HNRh+4= zWTsf~uYy0((V6NLJ2?htx18-VTr_Su?iCdFa-1s!@|NRTL0K=yv4Ufi?q$tyXbGwu zKtu3a_+leo$iq_Ha$G8GcZoLPltBne(zV%BDqCeJke3B6^Wnv?h)1Ex{#_~*g-ad5 zatKifP4@3nDTF5bcc~~e*}qHWI5gSc5}r##lda%HN*fT;;#B1}%CspCA3Pt#?fP}7 z;=p8?Kb0>GAGi_}glJ%M$7pS@%%O7q#4YXiDDmK9sO1h73NrZ6WI2XNXtE5K#AOM? z6sIX(zq4DaEgWM{JBO;dSxek9^Qa7BljIK)1h&Q*)g~0{3@t5QP+NZrwGtS7N|e=EPIW-~>ew3UDMom6_HGM+6EQ5S38}KxwYV$WufV zwQ7u70X_68+M`y6GSyYg%FZJXAymK=JC#HvIZR1bG9K9i64h2prs#-DaHl%irF`T} zZE|%|hD^07)ycI<)rlEW(Q$2Jb%OQCMg40NYZI#D4UjDKuTAI}pNum=HtAoRP#a$x zmyFd@LVr5$7;DF9PhT6~F|IbYV~iP{L&CNjD1#1d9=+TT0-8rI_ltm%O66uj-nS^N zR8BfLTjJ@bQhC@Z;aK_i=Ux2mh023>@%I%f7wR~%0(!UC-`p=eB72g8-30yzO{ zU0sN$1sB84&cb*>pNkvNn7L7DoXsMh7S_Uw4u--A%Nz`~w$u_WIv6NS!;Vf-r(49+ ziiki8*R7%9jI_EKYIRp|QACC7)l7+#VOQ1b6d@sjW8hlUKdE3_a51VYCsW-@+Pf?P z5J-_Xrc5h90=XG#GC4Z|5=33ANtVw9SA-O{nrPs_gfpVD)dcO&WJ(^z5j+fJYQ8aU zD!Vk9qVE{zB47|j?{dJ&pE_0b(Dwcr?5 zsCNgB>m!>ZJc@LTu8-;%*)c*frqEG+WPL<3T&G>@BkIG=Fyjg9BRYrIhqFB6) zSZ!#GL~%eTDD$u^PZl+5zagO0-$I4kv$Zw9P>}_S%9riqa89dLjetikoRbgr*qzl* zVS7P&SjHioQ?7_5RFV~BE;FgkwyvL@0G7(a@%ly4qz>hjb6#InH_7;8VbsY;Z1>|pfAm2(_&PcNjeJnhz2ziRYWBk)J$+GpP)g_ zc+%*Z)~$^<<4BulI=41Xk4*}uwHlM88dXedH#%WcT}(zo?d zc4XCSTT!5TM3ptO=-T=SH=GRiaMUrJ{wB3c>N6Rp(v~`usUE6XLzCL=9M(D1`hN6x zbx0L7a=vSb9^8@s-8tB?V(uE+Ii!1VGRQD(*O0Ek-Gkh~Drn{Jj)9%rqkB;IK;5JL z+3tazJ+TVcJ|d7soJDPjy%iz?`5jQf6*t(d6o)5@em~R=@0*G_W|~7H0>$l5VH1(r zys_C%UbO}LGt)%|(Os%(pWptJX%GqtP_TgF5@Gjnv|T9;78I>T`%zS^Y}x#j=@G*= zVZ8MzSZ8{J{Gx0)PkKkSS$nlq3=sN@YRkv{MVmOUzYMHAvN*jlAlA;kppJZSBe>@tc8a8Nw8^+b=Lh+(>V8&+f~cxjFvU+2+nH&x;YNvcyAZRDOiizyP5CSkOtCE1UgarbnXeYap^;Th~uP7`aIxRT) zwJFJDF&K3~8q6fdhI53~>Ihfdi86Dzsit z4^DP>qpfGapl;h`@z+3*cXxH+%)su!UAoiwzdAc}S~0b6GMy5%K&GKYqhxWuGM_P< z*Wxp_+Bd;xEb0NVOvGo*>j$wb%6vw#EMlKAwr`SIZl?A=W2Q~SkJG8oShP;aXKd92 z$#lm)W6%S^zDcO8Xz3mdyJl?P1T9dVMjm5EEsIUb8sae)t(yczNJ+C~)M9BEc#K7D zQC-!Rc#O0JMIIw9d<9)Wv)8a46WcbyU(DM!)hW%%IYKcy)TE?E5vYk4rVOokWrm8H zU{X^im?|!H7_;dw4r5Rt;_|6TfsnaU8|w<@4LOVynao_oWVDOS8!|==TtwDRtn@xb`3Q{#1tYEr)!9c zOq|+a!wNzafgV&%6-4Ktda4qVfhzrbz`!ImaB4kuRtcmC8Uu!;e|HS1LMezUaNS-0 zua0iRDudKQ-7AG!mtuu6uzO%v2P=$0T}h{7g)z9RyR(B8#*j``cc2>7HKem%uS10l z!SEFSKdf##x^O(K-qm4n8N=#BV1o^-kLWP98vox_ip$(-t*+Eh_3ZrppSk zOgmcPMX;Y+0Lp92)Rom>Id3r`EGAxXEeP7Fznr&gAzZ`3dRb?d6=gn40h<(>3K?Rt-)@2+3Fgro}XjrzV}FV2(}Q44Q~? zj$kr#GqQ8ZO3f*$pFt>19TNoa-Q+Nf38(2?6*%oCi4el~1d}hpIUw~!@;1VROn|Kk zrb=VNsyHY8$a`S?p3od0%~CoA2p{jpg_$g8s^hDv%RxPAI8IWRLyl{R<|pZ#tYXgA z5X~2tgB%GuuAz!%a606;HcE{QZU?y}wNW*8I|R~en4yVxJ8GC|6w@)O+d)Si!__bc z7#FanJUhDqZ*fg?T~s$M;*sQ>jOI!j)&HVb*Nf5=I8K^S}noxh>o7x5FCxDb>i=lwWMnB|EOA5 zbqM|)TJ6LG8B;a*cWgCDhS$bbyOSRLJ2Z)Bx75z2s@P@?s+|ppLRD-tRl_}|s@PN` z6`CJg7DFGyeGGO@n5d5)-yDajhjlfu30;Vd@oWrNQMC|bx!qt%%rFbXVx(P<4ei#q z6FofeiPCPyqQomtVrsXbH&ck-aJzvoP32w{PiJYjXg6rr6AXNB@JET*<|xc|3vx?4 zI=II;TBX0w^$g~LS@lnFjFjO67WlWi-nUDA#?f3Aviwx>3t#%BHybW z{_X~|?v8p5 z#84^_T2ocs1tB~jTkV4Q9t^Fcn$W;-SzXnExFEVbm2}FbRc&JGeAy5@sDo}8tPHwU zxRtg;ZnUyPpk{_7iS5QC8Jcw1DjwIcq}w_?%;9*1(9d`wy73x}u-a7V?Ez!QZ&%%n zz+2gE2IGAmWV+yL4mW+(O)B9>rK4#!!*>MCXiSdAuyN@bnr3>q9u|6NuF9;3si8ta zQ;pk)I_98xdZ9mFd@cu#c0=@l6gQZrbT~Fc)L`jt&}#7FHwQ6sIMhHEA~oD-=#{3` z2!EspIzG}v%wPkgY4i-^HaXHg)KC64J_{e?FZ&}F-mE&~HGL2H7CNVG{;6$YXTXXK}?{J*WzQMH=j z-+EQ!ZLH(ns@FQJCaL1zYGUzkN8<4Ak>IXGS-i-Ju@?VUt-`+;RMKVZn99{;pjF1; zeKN-3-zsiP-QWUE9k;5ATVu%Gf>!wFn&0tNC_kq>jUWl6C zABNxGQfK?5kM_EMmS3^%^^Z^s`~CR+3*>x|zaK(Ae%|c+aM$bZK{=>JXP$8Q-doQ? zmE2HpkE`TLGVl3wdZZc@*U#(XYEa1R%~d$KN^Ypav2vxa2eqEgIPu5>cG-M7D&U4< zdRzfFl(|9y4=Gm;L$8-~Q@nKMsYQxSFzlb+wR!TS{{J zLQbe)mlowrUZ(1{R7#^zHA7K(+p-FI<^_IS-Kb4+!MP}JN>?Ry!%>{XXEN{N;w0f7 zad}gJ@hgw=#Ywn$Fc&9b8Wazv;v^w2`jqLFtaLEygmm>O)F$ahZIZK2Lyc3qc&Z+3 zs5nWejm5=D!mZ>Qr~V#Ify}g9m5Y-w4eAF|agw*gt%S_8L-BCPtb3WLP4bQ}bV>z; zU!&qAS!IwUDo*0_oI5IXTD)~soTN2{I@LK9W-STSxzK5mOQ;lrLZ{8P1;kOD4^R?n9#3B^hBJVKce^C-VLoxO|SrHOC(927*0_eHf03q6Nt5NH3NhoqoT>5gX?P3`|*23sqRD4{nmGYt5@b{jvnaA?tp50%C_Dh8HsAJe0J-$l4nvAf`mdl11Mln{VU( zC!T1Rg4o<=9?NqISq<&I>K^wfB}Fc;C0+RrPl%3%i2mm18b zN%E?pQiH`eeoV=`PL&4vJug;vlW60QSZ)SHx>yLHCUE9V}KvvX%TyX~Vosx_D|$%@*i7+qQ6 z392>NuCy!F8qD(vrCsfVt+fWNFTbwuH;=bVE2{2Q>C`CJcD47IbYc{Xuj{nZpna&d zIFs^~25Dm2`|W-C0!&hA&^{2dc4uWGEE024r9sQ7L$mZ|_FI&))80X;xm%Np+B*#= z8`HPCf}~LU&)#Nkm0E-L?)HgAov$?*q)`I1I1yRpdR7M2jTgH`DEStkkxIVtjNWtG zIUSW%(}~|TP)fc@=}|8E<|qEtiIqWVx7sR|j&Lw{G*x`_j3>{jH0M~9jYnK#<6d_L zD!v7HB%_Mw^v+w(gvfO2*CCP)r1~gVeDhO(GDN1`st_3t)*nd)-#p_95INI$k!o$3p|^^JA(3QtwO3$?=6hRz+#uax>LQkGJw=it5>98X%QfUG72g{rlaO+Z+Ueg=%`A~Ec=*#G|wT+{Oi7N zmRMhGG+%^Nqt;t_5mNhIhgxs#uu*Egh2;D(HmV0QxuLR6s0fp<^_EZ0PZ@_Z1(2WS z+GiXtQ5kpJG~;llG)Mu^)Z^Om-z}>TXTMDqX(Z!tQE7zQ@d_D-%asNx0IBt6@6FUk zK9fGxdV@;y3Lu{37RtfgoT;I_+Ca-q#^)T)bIhv8Q?0j{W2`nPC!#{Fx1grHH1M=H znCs1T<{MJ$t-qXz>T9l`jEFMMiWrg((^xaU=2~-&`I;mhrfP3x*%q@r`1xvYWtkC? ztKN?|=A0!6)}O6h%}UbFUHmSz-3haUYMaxeD{H3y#Dq?AA-p=AKBO`}?bbCq)Y~F+ ziR*3oZd1sGNNZ!-bt+5A*WYG#PhWj$rO(doeHXg!$k{=$&FqH2)T0;+fvF!k4Fc0{ zbqJILGMBh0m)DsS$%#k{V;TsAlLCvW+Y5B>LLI$1J7_F2Ox8@b9ebLN+z79;d|gca z^7x|WOkSqyU8S}Xm+xxTpQI@jm+x98K1xyZ+2@wR!;v6D(ZfiVxM#`v%U0U8mYIl`a#S|~1+*C3TQ|+#DQ>mpet%o(v;>}#cgF;RCE$$k0pWabR8;__v2dFif@^G+jkT)Wa;l6H-ib?hm1o0?OLvtg!_yyQ%+MPwe&_tNPde?>h@m zUU0~s+sq)h7%?K)(*^=FaDYG@_*#w-m}1Ce2u!rLYHUx^P(kf zpEoI|mb#D0bIX=c@VN*m3DmQOk6mU++fp-HKPA<#T7f{SU$p{(;_6qyWR87f#LP;A zOjP|UX=6wuA^`uo6$CWbzA87Pov(e>YDSv}H9}A20j6T@s{kfss=9j-I%{i2OW>&t z0;Kj;9!@eNnrdIQH=^Cc!Mu+>?|=;&{&hPeT1sEFGocmy>-Gg7%`NU`4fDDTQ$+t$ z=_@kx+v$H4D(T0FHrG+{s|=@NOd%s$e_cnI(yIRTHAR0uZ$hiDwucllk)`-mJ5Zsj z9qNmUp(B{ctp+p|ziJ08l04k?Tl|WOP`Tw4zcN?4l4Pp+)Z*pIRAcq;T8dv~z#?h7 zIhU&LH=A7Z65rfDom`YlRey$Z(G_!mn@>c!R6|m@VlCuQ{Hh#YC?k$ei(loFt>#m| zN%1SH;6czP=}?Pl<+60D`r>x!P_uNZdHz|257Qgcsp^ln&)5^vsp`d&vnNY0m*vip zbgKO)m{X_yfAZct(2}ak_dh#Sop5vC?!Mi(a|F7ffd(2-Kt%*aB}b8HKv0yRK$9*s zG&x7fIf@`4IfGzAK|r14gy)-|Z{EC__hz0W1A6ZMt+m%)wfC;tb?$H8Fa7cUxcBxs zb{fw+1Q%(aCQHt-i5)=3Ta#kJ1bt)hMn05cKsA~R=jKh?5ucM z4m&Fz^ux}!9n{7ZsGFWzEVCl&@`-s>XXkk)79XVzGpZPOy68 z>rE(OAr&jGUSTE5d|%gkFZGy!qeT%-Nu_*5^{`&zVbg;xNnET@mMd1Nwti(jO%LlO z?-L0-=Vek@E>^wu0#9O#>{XdWriZ$7@(x#LuhU5YV^N{KD!$}&s7BS(eK}`VE0Wei zQq3&oy;yqH9ckwU=5q??l?G#l&Z`cLPauMmut zc3vSED=m%k8uXHB-6dg?;51p4%d$(64=#g0U{l^)Jg@P*Aksz1h$c)4y;B&g;Dj~7zJGx@4JMP#j6NqGPl*b)gWsg>Q z)Uj3egkDj{R@t)yId*K7Q#8!Oj;*p_eMr|yoZBu*+ta(iVqv54YTH%phtc?=we-wE zPTuPxeP{E&1CuO6qMWE2=O|tlg`=z#5R)sm z`bGJI1j)mj7Gfzxk7k~$jN-&aJu6F&(mO}_bXp2=_0v2lo#@44=xTbd+!%`?N}hyr zBi%4jU9knpdz2(Ez4!v<#E)noe=VSZwc;v7NID~xbfa?*+5b%4*AtI-s zN9sCx7IuB@(bx4%IYsmFln}zmj-ZIG!C40DWePrT&$i>fCu}@2OPKEoD~tUixlsn) zSGgx_TK=#lIroIEs-J|d*nJgoRoD|Y-7yyXsB%x(`nG_+Cv08Qal%#kp0M0YilL9{ zps9MossnrBs`P>C09CYL!H9v zs=s|N)I9m5f4*%0#N!h7kyKBRDDxN|ZEXKgKXFk`Jt|;JNrR5e!aRX3rFNe#ptyS`!7PT-Lm9j14fcuYEC|RXb;ULJeB!cz2>Sz6to~Wu;)6> zRkl5?fgZq=350zieK&OkScQkBN?jWD{?%r?G%{(f+E49U23S?QKX&&z?6C64A?gGA zKibcu4pN`1qCOO~A47gsegDUhU#0g|`>4IuUV2Y_pWaP% z+-x@~~M^DX;S-*EAebUIV#BPwy$Og6yIssIm8ySA->3*3-~?%F85t z9tBxIo%fWNaE^dC=+JxF1Cm-X94jrwF&wL`#Ox5|dEPIFWm6AB23S5^SHupBDFBe_NW@{`F~>^Cv=USt#9^gX zmc1w9uzGn5<=GhvI_dx{8$6{;jEEGklO92V+e zcmFS0Hyv_EV)tqGWzSougJJ*Vst(G%q*Laqx~jd@o-*p69BZr9&jN>)*1^fofbgP; zMnTtBK-HeUCnz>h#%(EaMJbf7fpT3>`tC0K?4v=H<1zKF+!qviShzQmYcHaDLD zmsL=l3HLxv;X=h3re}Q@U7R@0SRE~ok9x+MBu+8lQtNdVU8p$OB&)n$wbV)CL<4s^ z)z^6yxHNEqZrPLf9#Xb&SrRm_N1Ydy2`Za*Nwa=Q5@=UbxKF6JPT@U4nIh*2Djra_ zP!YkQ!6#ykN6mx%2H;{)(=YQvD=A`J=e273#j@6x6;T{fUFD1wQ5@E*&WoPY9HOT1 zoaXbGAN2B^(1}0cIT`l`pqL|{=9d)U&K9ck>Ry3|_is-i3 zSS_Vp@e@#!P1kJMDT>I0##%`gO;K~}j#nCCbrA1(P2aks)`?;b6Kln(S}N6Id#_Vc zEw=YcCDvk7F)iS$l&$nxt^|$Y+le;IK3#*yE*DJf)MDuNBMg3G1v5_VSJ0 zM5u6zI{g>T~N>JMa@yqdO1i( zJ?mv59rdi2hctl}mlc!T8bQx`c}Rwyv96JJ$-}i%8ENaV@m6%F-sw#RJ<|t@0|eZU zR93}M-Nb$(sf(nU8f;s4pCfv5FZJG#0rYl}K@}F&4M+7_6e7=3>IPn`r-@|bSyeH~ zqZw;Haevy%Fshh$c2tM0H<8_)_byd^Su;ufWKj>U+DQ3vRZ`5*`2hf;)eCJEQH!b#?77Xn3ZQ4P z%Kg97z@A#*Q>W|ys}1ZK&;ux*|6dx|ml?{Tj+3U5mXfMSrwX(}2T^?rXC_al|KZ`) zl2-@WmqEmy!j(b1PI@xGG6!lfr6cnfTsH{gs;@8!tQzmP)7nj1vX zzmPupwZMcUgZgGKM<$QNt-Tfk<(F`4T>XsoMScOdmX`rTBBwkYx7OczqYe{?;?`cP zfZ|};BF)H_Othf8}h@e!{}iCSf?BNN++nz|=)5+r!F(A|+q(;kt>r95ErYJ^<)vc$tw*3;;NoZ zt&*UcJg&zh0aF3|B14<9&6ufxfH)d8hNU1N4k-`}Z9=dLLQfbF$L}Zfn=S$35RrsX zOjALvAb!CtLmmVIKMRoD@_d;`#4$1ju?mEUi;+utfr#@|Xqc+N^|u9y=lr|ESEr(HJ^UpJr?z5R;# znt|0Y(gSyYsPjX<1}Ba-YwOg6@3s_QF(-LFiK9NRd0`EY-BvZ~_{-fyk9$h=XT@h2%9jrQW>;D+t8*;q zoyvX%r>>Ksd0;UmYQK4O9e zHm=ICV-ed+s~TlB(K{d-5BE>iLUupwSj2}+O@$9Db6ClvTA^0~@+`ta`55=*DLvWN zY7ImAbb--g&tf7dU#J6W3sZv?%~ng$wiJF(KqW66gCn`xR9aVsTHv+B#&XaMe$Fca zBKf#(h)Te&MLHy38N3CMku5UN3}gWzloVq;#%@v35kzH~4ZIF{Ef5iqkF`KLAYTmL zQcI1~kr2J5Es~Gli3F`CkUvy~yM;);5b&HYZUO>nWB8tn^OkI3VxRsSkM0e>g zR*~xRc*@kf`+c!gMXKcLK_1UhIgG5bs3DOS_=t_MPVOmP4JnXXXW)rTZx@#z&5u?@!KRJN|R z7Isai9H()W!)z6=toUqQZE1>HlwXN)*}99~(!JP-!d#F?^=Ez!VTf zA8yS&RZZ4y${z+?vBbXvLufunSWCbGx-};o7cQW4z|{o;kwdPUB^EGKwK?7fgqj!= zQGjlbi6B4&18k-QR2#9J5r7Ctl!%flr|W`}ilDa(IKoTq{p)+g!$A};Zo zPf1&-PbHfeI(!MgdWRJl`W}g<*vZ)APcJ9yk3%@GO*Q4mqz!rH#bink4U{L+g$ulu z%G538h2Y5E=80L6l}Pbx9g7+a!<$*&Y_$|Z_0 zjF~NXxw;(4AK;ojTGn<7(N)Ca5g&w0vxn2Ay4n6DWA+M`*3vd^Y9UC6V{*Ab7kZ;yx~{PiJ>t6;wN4>t?WYjcQ$U;mH* z&KKeB`+>36EI6-n03eT+8rcEF7ZYD)f7@|hJ3x{|HZ059vP_fCHW17CId5yT<#L%Ul|3=nkdq!-CbK+y|D1ty&>0JH7F2M3F6KIc^wV44WAEagmSV)^xig;sNP zDQA-7x|B1C!o+gGFtc=&Gc{-FC}Tns%dbVSETAl-j7iMMql^j7E`^rPjC?u;7RrSH zq3N~|N8U`6MgG(`+MK3?oJox|gPe(8kKv&?EG=%jGp!$jff&k)U;;eJf+?>CMFEiR z8_XP*c5qM+wBcPCF8T+g3oAnd0AmCgEe4MMe%yxeXuvDFpwidZZ$rvRpXg}2Z5a5H zeefC>0N8*?o1fOn+Wq$LKsy6CEh3_aEHJv+YTCa;ttcQxla(ePP7%4Kh^!6q;Hmh7 zB{80qIQh8vBQ`ho`SKLb05`2_MBXGV51JbljO@!wYGVOMS6!k2oOD{`6U!4&YTA%Z zRA^8nSQ|f~Y4YY9sKVNWGOw3`EsM+z(V-Dl%?5}U8Kf<5#gZ;6vfo@}DoYbkR;oz6 zt_VE2ns5fHlDOw{B^avE<>YguouOXb(bZrI;mb&Bwum0LkmhN(`&rl>n?JwhN=xW+ zT4T~aq9Rm#ET5^0If__zb~Oxg7t^z1mLeEBFJ>(KdlbiG_X4cXVvcrTPRT&<(burY z=^GKl%|hhc!-RoH2(%uO))C=+?HkIAIhqY3PMT(;gxQQDKR5^kS$NLPMkn#je(fZF zu)pI3J_mj$&D4RuwnMqAj&w7%uhVuY_ilT@{%f?;Y%8;D>=@O7On=aK+FgBnFiZ>&&eiL~<})+n*ql;%hiu1>KCUlm^O%|&9NEpU6>Fqz+`Q1Oj-3zvEouKwZw=ac z0Ki%Mx4$_GGhwvZZ)b(bHT)e1Ix>hoP>=iJ_pDsQ@A>Tx>m`}eL-4x~hFuC!>!sPa4(E}o#AVE$!YUMAa~iUzxGvQM7&v85{)z)|cPTcj zxmgsOTfj-qO0gNUr#Lp7*}4>)brhK~cM9WjHkL(kSMg6lDd?8!%F%%0eQwT9Y7WR{RUkrf*N z)^=tyEsV%&pyOh5A7oDyxd(0bLPju~>PUhlstJ80zGUiXi z_UhAZ^m)^O#GSdTkn^XOy#@z?r;IUsW~&c=kG1lqwvPsz;5u6~n{6ALRW9u{*_V&N z6*(<$!|!pRDdV-Mvgz=x_7F-WvxK+fb*02e# z4dBZc5vp&fS;Qxxt-JU%FsO>?ln=CAbQ&Bmg?w{E#41x6UXco}6F*;>A zYWF}s1ixqGO?YN*j>?@w4P$;jkaghqj7-5Z^RjWc3Jj3gmjIu=1J}inmhgK_FUS_? zS=n+3>YHezT2K>fDgplZ{X4T<7Q8yM2XByNJJVEToV zxH~Yd5SSK-3QuDc6`IB^K&DdyHUy&5cGI}oC)`&!)Yo#;I0HyJeT671G?7KyxUa4a z!h&Df2td-&5{Wem{hP5agLHSr5XVZkrU@Z4QDO*_ZSGv{Coij%hF7Ouq*{`dken8Y1+WQXM=xUq-Q{( zaS*;RsdD(;QJVk=eVLxE=IKQ++cr{zdNY8dPc$BdII_7KkQ)KCevz673%|>NG{3Rz zs4b;b6XN;!D=emg8t8M=pl?7G(?IpN+%&)dN#}T|UqXN+kp?g6&LRd#nh4F#fIW*t zoy?t0-5#`Ov9F!mvpU)yw&xJI@%HavOW40NTK)E1Qh*$54K%00S)9@A*l8dkK;pUW z&=Rh4|i5k@_RiEBMX_y8^u2C(yN)5~93gV(#Aji}OatLmD zXsI>Qz>UWz%Uo^z!Ef1Qv*0(*ocZ}s)`owNWdeRLfHLwDm^s7n zX<(wl?-4EF8JamWvki-xvr4y%nKNH6R5SI4cIGr;<~&lGIpb<+F>@4ru9Kt|TgX1K zQjUrxa*miQ7mMj~h3J>7MFuyoe-M2pz6KXUIGzDlViT^yB_Pu|$TrC|U4<(k9QS7{ z;GAoa>;bhA_+1ogz7G2};BEA`l$Kk9)@-6i>~%OFZb2+xhug}`9^WQ%q&V-h}0 zHxV7E&PX|tb)#d+2El(0oC_&uLMa%`!jH>qJi_PU@m2F?X<)IjN2#s;Tjr(^F2){7#pr7{de{= znYBBt|KIxOxE)S2|2zNudIw|vzxeqT?B{>w=a=xlseayt*ZfC*-htPu&sj;i)9&& zj?><@j7Eo|9k*{Vf9n4Gzy8w}=J%8D|Nfu<>;Lh$fAPy-zWeUR<~>5Q!y^PzBV!RZ z|HE&8^Q-*b{2l$aJ=_7HiP4b&vYT1G7THY{lU>#fSeTf@*jtzwW9%)mo5^BJJxpv( z)563UV-EoBgLmI<&P3x+jfnwdi5+(o0lS&gYk}QFliYDN?5;qUv@J@ELA@5(?Vyv3 zV0XpKa*GmUj6Ljb|6RA4<#uO2pp!r(G5GX<{cHKl0M|_*dnAdKIrIP$1CG6W2Xi1T zt{YG(`1GG49ui4k2z^A77>^J>kC+l={y+!um%qZVg5N?d+Ql0m{O&*f)vv1?vNsgq zPQn*6-OKz~y1j<|+>zEzxD$HT6Th+_+ON7})|+)eWX5mIUWS0T;ft_|cpLZi&$mQo z_q{F~b9fu%!8I-32H%6!QA=cYFI&8-@rU*2oN@AT78?h|nKgqGa}Izj_{l%zpF`yiBN@a2)MO?dqAv)AovP zb=P;{Y6N;NM=l##>6+YSO{cNUU*RJ}&n3*brRTa!cj=z71ZqJJW^h7Rb4Lxd!B1id*KLW#P4rQOc2XW5BpVa&GGS986s0gw4&}z!flJ z_H*^K_d#wjYWb;wyeDEy#MoSqX^OGAe2pW0FpU=%j$;vD;dm7h$D#^p5)n2x?4qrb zTtvj?BE_P5mD}sErbD*`Xl^*R@1G4<^K;=<9(U+2Q!IRc?hu+Avkdi9-6vlSI(O?* zPi;KTbboH5Sk(3BCW=K}e{M^$K)^+{AE<`**7DgZ7?FE-LesFPb!~HQ`5ilL^AFa4 zaL(!9`r6_9tme74X3zpmS%ECT)XmRLr#I#lFKfn|Vb0;X*Q<$OIylk% zFnF8~PW#~0ZyoccgLYfZvu$<11(>>tJjVh|-3(m`J1kz7!w%^I%8vz@vixAy;knna zL)4*uw?p#*BwPReAO7=do<v|(`epSJPBMg;mPUc+al)h^rYt?;nL6^d zau8Dr2jxi#{dQj=apRG24$({zkBg|4f83$hIEbmXE%S8=Nlg$_otTjt+Uz65G#<^j z#1{|M&2I(Ga>aw9v?re7`nw7m{~^RwKhXnJ`ndkS-xrP;_WPwK`|*hC0q*xJ0b#14 zU9m@B$G90pnCc$wezD1ZT?2k~ySj~3{dB$EK87TN-oT*sus$eS?-3>1fQB7Ri~%{KiP}vgR^Ri`;IurA4}zErQf`rxg?J z9U2q*-+k_}X#it}{S^_b4f}%!4#sSOk(_$K{)(67us?pV&6ov7x|hv|{e5J)+g}l$ ze$B{8%VJjVZdgt{5E&VVy8CF1c?V6WEu=2pUPfUMZ}8J4)KJvTgov` zTRxSx(KT*Ej*$YHRs!N~JQl|g{U`vY;BeDeElsV}M&DOpQ(nQB~$eh7IcoXe@8+-GfzLWaGMgetj3B?^f&oz(uS^ zW0NA(&u^o#bkTX!k;eQYi1*EE%(M?I40s_LOZT$HXe^8Lw7F@6OD}^HeJ3|2 zA^dK2+8?-#1v@Na{T$d~LHb<@JLJH^z)Kt7ZzZ~?lx79CZ+9yj`VExu$@%E@9lD%nu4&HLICNEV# zqgo9dko;xta!|@4(eR}VXZBMOAQFAxw>hChB*tM|{1D|J4*Y28)aw$m)pFp+_=$+b zcnl8PDnKO0wh$4CC@PiEk5RaIHV)c^NKEIYlh4^2N*v57og_wLW`lX`I`uQ+X%mF` za?tja#Io~L7!_+1Q~7;a<2;f7WE>?iotTP}iw#*#XfNv%Q=ka;NK3_cL=fkz@!AxS z#4uiaQWHWFbq^2)q~fK-G)@wck(f$Mse`q=gBXc^fBIew%w*1Z`-H44B?F#iJl83Z{kpojKunW+p-5Ek^609-|9L>q7T>5Zxdvz z7m0!yiPT?IT`OJ3Yl84f=;Y}ciFG83kdc@sQG|@dGzAfRZTITMO_W4)m7Jo-DD~Qw zt_Nw@Wz=^@!(Q9?$$E7e#a`R>{ob&Ps61UluWfl@?=GYA6f1;{XV?GH7G+ik>jtW^ z(kotHV+lNP?q(EAHBRxC&S^|9Ue;XP=ywnH*m3rXhAv*V2nr`q2?B#NaB5?s@$6}T zv^AO4!I}Z=&kG*x4<0yo1N$okZxQUTcv%kna}Rdiehl_kylg(~4+=qGaA<$#k5=TM zPJ@4Oy+Hlayt|T(2o*@=J4@gR=Wa-Y6x3;09|M7#o^&?i&3-rFf5P>rP}iW|QH+zQ zr~VOYNNHyyY>}p1y0O(vSEPvrPW(tEdBF;bG~ud)cOM3dG}Y3Leog&A)%Y6mim*i? z8iOSgEe5Dkjjs_e%4G4z7HMkM4fON!IaOn9^s|%ClpIf3b5Ti=#Hyuy(zsGeaZ4ic-mPxFDFbuKI+7JwpoEJK*im>&xHl|kv=RSF_D2*6f z8);#PWNoM_dlQz9ShZM}P}9sE-ion(iOo&A-*%{JrqIK1WTYsP;&H!iX$ca(XEs6< zxwAF*+fH}m#y+3E-?mKBmDKsZ-*z2ci3x~ly(Gpi6A;OirS*&mh`reozUy|qp82lZ z@_ZsJdcq<1Fy*e>@;p4gbk}U|x-IQ?q(ex@fAC%4sOz>orx#m-x^7E&Kk*}^>o}^` z%A%(zcHNe4d%A13Iv%@j!!2+n!bIFxbn+W^b3NcteSPv6OP~n%u1=6epE&IGHu+UR zQ1pgOG>*b_q2u*_k^QMi*}FNZCVB#9}EUG>78H3Usnu7t}viKN40aWA#L9XI@90tlC5MnyN8}-B*7e zEN6uF5Q=Lx=1{yO3)2{{jH?$-&6=coK|Zf)-Jz`k#y*p^Nxg}lENH;h4&d1Tlo^I;#DwkGT6BxWuB*~@ z@bkS>Xe*eVVdU+vwq6?=Tw^%YdM^;F|PTTg%_0smI- z-Jyjj^Rg_~#o{8Uddbu*^6MAH3#!&9nwmv^{T$rJQfm{jW}2?1+S^-dZK8a_6pLnl z35;b&K+QBQm$<%U9z{`R@h#(a1#GFaiBMOpEb~*P604EoyC!iX4_7MngWc~u^%NV( zl)RbyRZpAPYoTA=BYM4chI_7te1ZAO8}*?mqTPqVZB2XHwmYU zREv#ks_53bH{92wriu>Hd|L)}+>}Q&Mb$J-_f^-JtE-xe`b9NW)V?aEkQdi@2`oh^ z^fgr^`AuHhv#5$@3owPw^ zcu;CK961mvvK6UPKh8 zZKyYD;+qEKvR+KF9k@8&fQ_t|Q)~z>jx`f0L6z`+ZWxZu&U;BJ$`dr0ox&$VgIQ;B z!?7j27qP%7G0;-L7hx<0?GHQzJ z@w|vCi1Lfd|gaf@@>r;bPz1*$OB{~VFIVTW@bR_)EKdIcTM?FTtP@2?!oDeQeKiw@^0 z=&$~CW7jZiz?IE9Q)xh1>+W`ykILHHPShjfd!)H(OWA$s+2qZ2s9Fjf8Qi`xV|>4p!(Xq^}Eqs zd*!=M)Gg8(&Uhiy3!sFLL1vT}IsG=fq*yF~rY$9S>M1NG+*}jfw^uE`%4G31wv>=W zOkpWK?6A&KhOoo5E^_fTU7EF)67F}2CAX}KxV86UBW>+zDW`z`f}+@hvFx$Th>MU@ zEHd`cT352{p|lRcbpBM95}+6fo%K4Uz=AR45X-G~I>?YiE(gc;QZkkVImBc4<4cFB zN1a4HBFJHHbBU0{c>JmsBIMBPJnDE{kVS*pJ?do8(%u%cd*q2HB1p>Xc&N3cKH{78 zT1)yP>}TtR1rf)VwYIE?q9zmi3no@iEUM5o(?dfIEV%}q>l!YADwWkNQ z1(B+@rzb6D%v2e27%MJ`Sh+#H*INV&`UdqVjIr7(=ygnx!*ug{1>KHA$f35)C=tt^(WL$9&xCPCaE6eG5Ik% zc)Lm4p7NgjON>LmBODGJENe^CMaH3qCeymoZ63KGVg693v?NjBzauXi7H?6$AWs0r zk8fo6k|=MNu&v&ULe=g<<0T_%05)w2tK^04;9yoLQd0OQd|c)gB8s5y*=t$ zagD5zQ}&_aDp}lC%4?Y{rzAe2RH5aqRKLYlL2(%ib=_*ExWwOa6iXskJHBo0To&=wkb&zP@!e-oUXD8TcPC@RxgR(0*bSFYn=fVP@yHVaA-fh{gWt5J;WA8 z2`ZMbI@^o0C@qDtm+^#prmfIY-8dzOAZJsUP7sqREGLLb521BJnY5c+zqQQ5q{w;^ zWC~;bq9juo>!@2u&GPc?M-Hp3L}6rc_X5boEv(S8c$Ni_Ig3PL>}58Er7+gjZ;@L_ z6vkd=lPQe#hSEe7MsH(LT1n!1Qy5VI%Y0z%-igww(BCDAS}cDu!C(yKPwYjuS$#h3 zHN_qw4Wg1{B7$-Sm`$l-*1s0A*l8WFgq8!AdAsK<# z1PYEi4R9e0qfP)^^friLtg;WVYq3Z$4yYx0nQ@?lw&5X$G45v^GY+VsI73{*l%U3! z`kQEA;kD#h{WdJhR<@QGBu(Tk%OzVZ${JUb4FxT{u?KEto#KBjsEdR>swq# zH}~-V!^K3DIjYLy&A9b$605SkZtjs#!6XD_y_-b1FCi#FGFbp zN~J8c%^OO2AaN+mWmwWvRK{uRHLo4lyW!eYP6`~Rq-PVWm-_t0D1~#S^m)IfxuKus+TLGP}W;Yrci2!`C$Ph zuLq_Q1hozTBzIKKQ+ns7pxZ>@E=!=Y6v}WcPuU;}rQXSt z)jYeHI38&LkN}QHitnL;LWvv?&+8y+C5c^`;h8i5w4)9q_IEiQ`d)10abq#V^*t@klX%h(zg80MzC@CQ&jTKr9bMzjp~0 zotZ4|s!h8(>58P}+hp;7DI!-l#sAa*R|iGXDO_DKvaGr5lx448mQb{NFD24@Wsmz! zNzm%br`90_a$A-=T0}%Kls)ds0kN9mt{foIPjOd{I$F2|#&Xfr3y~=9%8@loh@vQ% zR$U!>KJ`UW+#j3fD9aj1ec2 zhvY}4E#_)x-eMgxJ6P3C+B&tpsjZai?U2}+QZ)q0s1GSub**X<5j#`Hj)|RK1qnun zdQl~IG7m~d#LifaLaa@wMU1s!Mbm|rC}4KRV=yTSu{Plt%!LvbYvV^?1~M``St&j2 zCf^uZ7bhVe#Oy2+?HFvsU?~RH#9$kScBleu6C!K0Wp?sA3C95)=o1(ZnSyvEur_6= z2Ld~@62b#e2^D}xsH+D4-ve78{C|eDj2BuDae`UbOJ`6?#BrursDrAeyQPHh|0FFD z-%xIJnY>F=eO(-bwkX_pc@YinX`I6Jh@;Tbsc+SL9&x0a!t#hORqKbb;}Ks--~Y)s ztEeNy;l1jISRpirV*Rk!0-8CPw4~nen1j?5ekZL$K04Pet&!J}rTSpm>4<&I6y#^I z7u=T9)9Xy`;iRNa5=0>-DYGLT2er=Zh)>Jt?ijoQCNv<(K~2jH)!3&i`Trw?r!-nT98A3qIVPygqn6cKu0c0grUkHAy5_|)RZom?POAA zutZ28)U?}~+_qwzm{o=x)H=HZz~mac10Aj5V6ke+t?=T0Ip*mt_ zq;0_siRql*L~bIE@sybxs9MoFPx?-Ls#^8R`K7B`)vxo&gTztwF&?W&@<33no;knR zA5<&2g`%3DclZ55Q4b5Z`m8^$S|#)TD3X`gbL1YfSY7g?QXY;WQb5(JF34lvZ$3j_ zB304CEWIwoV}(h6%2-E`%K9XgX)Z5U7I{aCX~2Y9@vK|sx_KJN#oQ=9iA zdo~^4F)*6#Rc+p{fIXXv?ifmuJwsk`+U! zk0f6(*$!%=rU5=T!crCYitkC0b@1sO1t4$S1*=d;(;xLi)w@Q`?eAoXBQNR4G#COMq(%hvCy$ zB%S6!`mGj4V)7{_m|PO^F;ABg*nA$5etpbC(yxC#rmvYJ{rdD(kIO}I0_#b?9QP#9 zvEn3_sDT_MiS)~_MiyWmkbaQ>7*hk=GeXjD2dII0z>s8WAkno$(r@2r+me16KUby( zhNNFp5Cr>&RYVPpS-%9JV`?A*=7{x6#BEd1P4oUR?i%N>)5%wNr#)-^wSt8?S-Y5s zCR!!aFLJApZq}w>atBd+gR0(M)+{CJ?c|4jOezPG?zW#OZh|c@0m^L@#7Yb?ahip} z#MCS$>NRB#P2q$lecD;;EyQXOIBpInIPsPB(B+VX`H!e!j0>>PJc5QW!TFQg1QtLO z`4^D85`^(=rCA}9jB&A%NiHK2Q@Nah#Y|<+z?i8V=U+OJeKAuxjw+LjSH{7}hMpRv zaybDLfK-k>b#s9Tkjflh7^&<7Olw|u?o#mPp{H&VQkmb>oQE-^36|SuVa;(i;1o}? z0I7^7nUKmpy2!E6PPfMO1SGF8eeaJmWS zuHuO+mzav<%B{bOXMDa`EmD;{0!V@tV!B=+N{%ZBGPQ|{XqX)+$ENl(7af+L?3hh3 zo7!g+VmvEl6P``YGdPQK2|#bpr>H;^7#$YB5~nP(sUc!Gztx^;W;6r-aLA_a%*ZU8 z8s9}UYB?$c8gXaTv#I+=fhFo*g>zMov4&4pP2Iy{*!NI`{(A^}10~Xy)={TdihXw`!-Ay8x^=Zd~?gw-?i69`69Sa)K z-A)AU-_efe^H$N_A)j|iv7SD;sB+mh7ny}wCB};dx)S5Xd{tb!TqQH}r1Oye;-nPLU(OikMJc6g z&N0E|j9FVgZi={1muEKHfNO2K*pBRZHOmx_=@OM=2Dbalxi!|EIgc_#7w?;p%!T!} zY=#V?e`f}O%k3*U;%7m;Z$c`^7j56DvJ`W^P(^Vu_f2b-Am(`y?>ocoBHG6g^Q?&W z&B1mN?HOW@7i()EFXFxF?{o1UA?9=`5BDR&94}WynA4?92y?t#F^i*1xxdqLVCfKH z-nJ2c7!c+}pH~%x`H)3QhY0ik6%aEa%wrJq5{ocL5VJ>^*MXSB3!Q9%4|$j?#33&W zt{5bMXZCvG>jN`|F!R@Ad6f9enawENai&1wt~tX5S56yp1yKY)40xC;_>k8g)y1{b zfm|VX*9!(P%oX@LYLAE_Z|EDzhE);#`iC)B;DFa0Vn;AA1a#yg__ZNdpbEs`pae`i zg}jc%w9|FMnD(K8PQP$h5n|e#F6gxZ(@s}P?m`|y+VL7fNIU)=?I?h><8@Mnw6`sg zd?13fkF~O9X0IL(X~%#kb7e8!2x%X0jyOoWf-UoN=^*Wc5bzMvK0lxBAni*t?I7(r zDDQN=B%7ld(%uh1a)z|8)T1hdv=bbgA?=&0A-Hd8EC$@WncsnLpgFx2%zQm++#{;2 zn`yGh2|J^$X*!twdL$3NK{MPgW`A>71mC6{(nT!j47G~+uLq6$Hv2)qbm8f;fwr6f z0|TOPbXkAy=Knx{znlLW1dQf?e_tPbhxnbLfYG^Bv_ zJmThOmH_i(t)b>HJWGK2@umjAJbtfmNbnm0^W)7q0GLM{I|AnCgW3{cUc)m`I)v|U z6n+pezcd>R0Q0l6WtsrB0rQLWJT)7T;|!RWdaaTccFutLd1{elzSVKa>@7CWnYy%$XwgHX+{jyK{^27H7}UK(k*LbEe~FOx`EmnIG(HyE&sf z!ku}Hw=`?I?Ex2gTkWZwiPjcpbL$QTRQQ_rY_sas|KVL0p*$XQQ1B z!tar+3D3;V=I0BunQ%t59)vT}r*rr{YU9e>Y_Xo6tuo=cZ3#Tv@8e)m*(; zP1h?F#+A&TnXIbyHY`EsF{DK`W;-Av?iB3m0BEnW*VvW@fr>=CbpRl1`#*3;~@Fi$T6 zFSL;wfLpNeT6hdh@MdaIZm4F$Jw@~7Y_&{|s7>s(Anl&Dy%tu=QL#kMvDdYKN z?xmb)pB{~g=OD93BJ4R>C5OdwIScBt3&oh+Kn%%EMN>}nJr%ucqVb$mVhh;^MXph? zRE~?eaJ@89(q1{7OwOE*yGNGFpcenXly5B<3mC>wiQ`pYtd}1 z5v|6SqSII{`Wu^x!Nw{v+}K!5Ypf8{8ykw5jb&nXW3iaqSSaQ<=7~j(aj~>9Q*786 z6)PJUQ6m9!60LR!b`e1+k_NOBT8f`e+x~rXWR83oHKFKaYvm3Jll1ro^bRbyKg(J8s?N0KslK>`PeTV zu=Aomc(@oJu08I^&wX;sQFsWbly#?{c+3%dZ$CH=4@ZG7b~+4l@TV6ohKGId;?8+7J5P&J`@Vy6qynpk?2VXn>sDpNzInjEiVUFA3wEyRSwgq19iQhQth~tr$ zd&1YgaKNXw8iWsY{0hLRoOtY44%zEt^Wg&>zZf2#bnH=w?)~x2-~$~GES6Kg`SmXy z^x19t;R78H+}u;X1%vFj^L+R~$M?aDPd?#mUp(NG8^Q-V9*8V!Pdx7E!}i{x10U#1 z08IPHbo+tc*}<5%r}+5=Y!83lg2&~bH{rSBXItR${^6f~_jhluHt&D%KYsU{cYpe- ze75`C^KY&&|M;ih|HI$>@~1C9@!0ntf8xm}pL+V4XP$lT=Znp6yZ`fdfBDvH&pi5_ z2fzE!!{7VfBah+>o_O*pe8tb_n7{h>fBelae(=)?g>IychO zKOZ&kzV~1L;?38deBg%bzJ2|TH{E>eZMXZ^+kqc>6bH7u{&}Byuu?Jr(>_?Am2CeB)S&ieDt zzwn|6{o2>Raoh>tJn^Kpr=E6(JAez^N4WZ09N?yS z06trAx*mP($gdpzwPU_WYo&`GJFv6F=f(LLc9l$B4 zoj&0|0iFUpiO~_Q4c*dFV3G7us1MoSx@h18Vcouks`;UkYz}6!nLG&5$a^?~4z3*^70Q())q1MHm1tCOd-t7`NQ|d3yl%6v8Kfs|Zd(G=TjY z>F@ik^Jc|7fbe{lD0bGXR0QN$%1JDQ;xDntyTz&a#6kATjiI|M!ra31W5a6|03KYao`1;GIJB*LYPUjqz49|FG#I0pMM z@PfEpUU6pQ*?srJ&j4Q|T!fI~UMMdT7oW4& z-uu8wz_W-`p*RA29)m-`6H$zSL*Q2mV_dZ7UVFnSz_VCCfc+3|1a}a22zmbN7woa; zUT_Mc0q9DgBXEbnBfz&|zYh2ua=kcLocHSPd+Z6PfW8Dif-l>z0p=6V2RI9OJ+6gs z6TVLSF>r`=XWKDe-);9j;1m=C(6>qq~x830kxGxdE z1iF&!0l<8+N5F^RjsXwC4k6Eaecfjg1K_t%96>n3NhjN5z=Jqlo*^d0nXi2s27pr- zeggU$aR8i9$9$bffa~$ZlW++9959AFU7TSZzgoNgeMr8KI%JRSH*+ZV13t4xXN`>@ zbw1^|BMJ1yC=@u!1#+eS}xo@-2~wWqzm_V}+JvHz~yY(})ggZA1PiWrTJ zAhkXI=)?Bid376h2oEqR-fjDF*dbvE587>qMX*Ervcvb?Ws4kkNDub=%nq|G7zxtv zFMocIk1T{8?*FMRmD{0tzx&?5{5N0}Zf5>4`Tqa>r{DedZ~pw9cl6sE0W|3k|Kq>@ z=fD25?CsVs79l9s z`MUU_`jPr^_LF%(l|T7CJoVDcFTe82tFQjx2NE_a*qHx#>?iq;|M2_^FTVJa-6&s` zuu;9Pf7txd(2qMm`uz`|d;a+s+-CWTcojf`uVt^#{h@ySy=R|u+vH2)W%&wFb$`%& zZTjo&*Tgdd6ZPli3jhjyNxrOJ$zE;$p!Hh+57evTY1}HF6R=gnR{e7J%B)vgulxy< zbZIvM8~p|78U0f0<^EUtURE!?k176BPus2XIr+SPA$xK5OU)Pm?FC4|i*3M$cuqgx zdST$j&I|ha4{VzKgnUvwC7)K$sAse1WQ;J^Zlz zo_GYhRl`R8c>cubldUJR$HjNWL-JwqJ*WyjsvgU}KmK?V`a=H^lh^Ochs47Qw&+J& zkM)1Q^H}~U?DzrT;65l}n}TimBhw#kJ(7LzgNN_CA5vcV9SNJ%L)pXQ-)las9}@Qh z*XVu$&jVuNyRC=%9_~DpL)Yg&Vsdz|gl*~p^_~2|(eJh%%)bLe-zDyr_ej{H?#~{W z{hj=Q{Qf`P2PqJc9AJaGSKrqU!wuZuyf3>~+%E4BcPiMT?`hsUcwhV8{2t(;-zsmz zEzr36uKe!Nds=trcd0x7Xj2(r;NGt8$nG4wt9fU32QZIr5;x0Rpgr?#`t~_@9%CF3>(3b!D}KdVOwo-t_ZZ=Vj;W_4=Id+3VIpx5jhw^)t?GuFuZVXX|y7 zXPpV{8Q0}!&pfAjcD7ERrO%w4I73e8GqbbC)-}({&eRk7jK=9Upo$&VPo8ten)UA$ z4D?kVf!=B?x4{$8tvhZy+*nY+-ulKGWA=eXpf6|)6)#(|L8Ikf_L()!RgL%7yRbaC zreS7J^uO4c5IdYUdFr>;oc7+@~hTQ(o9aizXn3$d;ju}5Hf%H?kb3u@BjXv|I2TG z^DFhPerI{{@Xyt|h+AEN;gw!1?GxEA#9L$b$$!E(@srtG>dm3z&A;|fBh0R4F?av? z_ka5r@$=cw#2fFKKmFlfAX@+VyUllUVA17{ItTc3WWK)Bd^-nXYwnnHh!{6N)^9iM z>vGGRBkZ{Rk^Du|zAghQYi9YY$e?SznM2GEpV6<&*Rr2Cqvwb{r+${dkr(fz=k%-c z6$8)a05Qk$=-KR54eXl?p3B{HM9|UDwO_s{e%u5S55Ceri!2=Td=AfMrDrt|!sY8Z zJWHbjFdbftbR7MxcqWHuGuT)7tbRs6t>D?rKAXKj^d0-`Q|ih5<;;$dIr6xETEnv% zp{_4wFJ^9Jd^J6fefiB}*$bK7WBj~+41liBXU}EN()0RB;H0}g{`wL5Jq^!iFb+Mh zAy#YX)33j0VXkhAhIfQpuo1s`P(GExF;%x9{f3^`FqVEq!C3eX?lx>-tjz62+aATV z1$zwx#PzWZ-lM;VTQr3BkRmSc#v{|kX!-#K?|~?OkGdNHuDC_p{m>TQ=wAarz;1#= zvv1-}+_<=V>w|dM58y%2HVt83K~SfDisohs+jMf9x>?_Z@500I@6xw=D7Xe8QFqb4 z2&uy@g%xx{%wSJQ6sT^&mcRf;xC0v?hvVV9xLvTY@6)&V5%sra&`Ma`s&COZWAkGT z@E`v^$$b%Fn+AxE4z?lajZv(C+JpD$Vt=#^J3)e2K)*w2w`u70@0$}-3t`tV3XVlr zwgq$>*ro$;4mGJFC>;pLxwt>=`ZMyjsI@Rimv3224XW^cMGGnrvG9F%Ob{S!4UEly zLE4JORa{PA zQ^&%8_I52wsLcpA67ik*v9VO+7?jz$g+4ADZ_FrUw7IA;;2r=leWONJylm0tjrUIm zJM-x^dSdYX#@s^e7Q_2N?2faVn8W*>@&N!H-e0_IKD_@}`x<56PYU%9zx~axk*SJ$ zW8RwKB`$MMW^c(i2i((t_nTj7t9+uptP}Y5)Q{dkJ4uB5mmP!Ob$#+Wh|5`k{$CP z0`0=lcngY~soetZ<9_%o-^U~KqcILngS@GlE$Uu%4;YW)2>g3+3+jrv(-fkpzk_?y zAbqqAl}b3|YHAy53m6$VcK<$9BvLri9q8*@j9K1>+F~4XHMI@f-%nl-2UE8Zg{OPn z-KAZIl7(^x?#oJD2)GGlNjfp+_l4U~CPLO~c^me<2dZpE2ECj?*ZYDc=R5I-{qjTk zjNS(_XnP|DvKzh6^-ZiwB(ua(UL^RUh!~QDfNZ=KGGu&^u6}wrPqJMula@YsUd;!J0ZY%b6F+u(H7KyT=R@~KyftHAA3o1;arq3mN{~R@E6Wi`pcS>rr%D^N<$8mO z1Dz=AnktN$jC9REj|L3tZ53Vf*33K-E1Tbf8bQiNdnc75+lDG73#xdy1q~ea;eg_PTg-410Z^PhVJJgTgbTEmT_Fn*3WK=L1nw_i>jy_bbJJcksxP` ztBIQvldwqZmprZ}?9NXugrQ6b;^1*LcvPV%Nhcj1SK~YLlM`ci$G95jH48!W{!Tc# zqoZO`3gu2%xs%0v$;Wv?vyFZ)pkrpai(MWz`sHJ0Ul|G-ii13fk2xi1668*PD?F;O z{Vi=~5cH8N;U?3yAwxno?7j9enh4vPoj zYSMxxEu&O|+|e4^hEjp~;p#aWqupSSiKB`q^+lSjO~_((ZSk zu`bZ>35%cP^-#ZLG#-^jSt~)m0G3KXRMccvN>VR*AC@`2Dk~^}vZuq6r3BPC7h3&@ z-qVS@@HqUKWwjK58pon)IHvc4>h{Uof{H7bG}-WBNwa&)gCLmR@~Og`QNdH)Y;Kaa zR7xfj-y2INtX^3I$`YLrMO&9;8BR!|GoZZ3GNH{Ba_LK{>UtTJBC9}~GO{KGv>_iR zUDtd_4Zs!3s5nYK4A#i3Fo{AgNv6F^qY@|sZAfaluuAV`VG@Bi3%|GnmyEK(V++S8uLgIJgBxR% zO)pdpp=?le?_mjb{<0z^90^@eUR}DvOx!ncV&6+2C-!KzhfA;!5Sr?(uL7 zNl~5+J)f7V?y(d0^Es?*Q7jF`YVzwvwKP=8P^~7v1}>O9V{br?Y?`1+VHIHw3L$L&VthZrn^58{ZJLtZMS05Mxu; zS=6=O7#mbQvA-#4sX91r-z@fpHr9oqMdibhQB7I-;)bBKHE!(bF*d2joMkb|7#sZw2B3yngbDOLR$Y`Oala^*Da*QxDro>W&Q(@c!q7K@7Ymd; zR!I~rW0yElm3dh*7D>2K1>CZ-5*hnca&WSuyu7}LVg@&XSZPJ2r^U%w1m#U$=|fRw znUgmdSKFnn9)PNDBJU=@ZGvKJRY2i(k!vA`ND3&g0g9_3izt;;*{hO7iYq028a^s? zl%e?I8lkuxKC2Z_?>A*2Wa=_;DSX;OKvNPaF0P7iD3Ktq7kZD(;u}jOh}0CcagabD z;E_iTovar~c@BP}G+LG935uY_x@YKQeR&nc1)MC4K9zO7^t#nQC>DD+S`|hRt_!{B zd)bSe-TB^c`qFGDilOAE)(+)~@OfQHI2ze$5(*-Z?2E6mP%M%p7Soj2k{Z%`z0_94 zklyP@4uzJq5S?tD&Jsufw^m0El@LB}P+r9qP2NgMC%-Je$sU;ssAX3uzbH!@OHS5% zMtOuhwmdRASykwfJWLiIxvH?(XH^^`zgDlX=r_gZalgIVW{c19))f2`P z{o{ACMtWBnV|2W8RQsXhl$D;bURzO@xMyriS=F8ZfwLH$l(Ld8O@6iz?6eRfM<*?< zC|jPRlaSV3^{2RJY#jzw!biZvOf_zlmZPJcc(O$5U659wb`l>4tDO{9y%Vz5xM?i5 zfYqPGMz18S8d@O|Nk=24&TjF-s-Sryl63T^(qwUL8(T+#)7y1FybJ7yM~hpyd6JI) zm@d)VY}?p$??we}W8;C4Xh5CT$|xP*yHRc#W(eZ`I{hT0Xs(yGCQBNbQZl$nvaq$Z z%2}?BnrrGblJB80SEWX#yKkuaX|9MhlJ(Ui#3wH+L{iq=W;1z7ppt2uIeAg!QByv1 z@`At|r?qbKyy#Y)SVpP1I=S8|B`-C4tLd%Yf$gL%s7xPo60z zOi=d)4R>{4>2wK=ra0Xc_vh4Uo;cMM_vlphlq#iSt#RYm>z+8tIHSzUS2ddATL=#7 zZ8Q-agjL=;T}8Ks;2<*6^+r>C!+_DQ*H+Xiaf~^wm%5_LF+2!ua8+H=u`xWT-e?L7 z59;MJ2_DqTW)eK8m&-I39z@DqR#$Rt1P@~DM69mVr<~zI-ep#NWZ{f!6fn~4xcj+2 zP#$2QHeG&a=rHAerYDd>?VH92g${FaucDk=7FT8MV0Vv0AQ?~<>xx^o)h3S*N-3fI ztaO%_B%4O{wvX{azDUe^N8C726p(tgPugaxPgZTK*Fxd&LAW<>T)lcx>*JKVq8d`` z_$*5IcSl z3V6B4G4X?{!ixP%i60bqL8S)k<=)4vt4MwD{GhluYTWxc>}*QCkE5%Pw!`Myy@xvY&p0*vh$6$=7`R)P6r)Cu4lQ` z-c`E3UIU2>ZoVncW(}-!e^^YdI!j+{#fl^rQ^R5}-PjX5vF_JTch%Ii2gFsy?$=JW z<rU%^pgKy}QgB)W$&U&2y}`{t>X@<*6qQPQ**KwOpN zwbGOil!pQmu%{1{2ZO5j^nnOh@*2pMR$S3!*$@t{RMs*tD)n$Bc7kQNQmBJu%_OW^ zhAWd{ofSn#9*VA(_Zey+Ry`T5RObc3F!i*8gjPxkAPIcDt)LblUswUtx6wSL2Cc)IZ7cByexbySz-Hc7A=w|<>*SW@S*7V z_TM}TwFPIqQniu4w(Y;mjr_6Gux(9Vku8KPrJ5HjX#Y*J7lM=+uH^d^I~sTdSK{8q z9w!(Fi>{nTV&FbA)xF?B}-g>D~l1@CIMx~u-sX-O;~nhQ{@Yq;Ubx_Wk)Y4 z6;pMPDawv%K>^7C35*Miz9fkS!u0!CFyy}B@l*vPEIOtK2}GjwMSY80C$S)i)Ynjv7B(VjMbVt(*&@p zvJ82Q6vC=>t!ok=Rn9f(pdwj>`&!Q=w-+__NVR>ooh)jb#Ym2uCqKkquBsajRh9Bg zjH)V2hYjyw)mX`VB{JJeY$<~0L+JoqUqFiqg`>Oqb_J>`mJVqDm!$aVO+}L8ho~y- zkze&ph^mTR7ZD|(5oJYutY-=sG@dBodgO=NgB|PR9{J4fmPL>Jkln2usw&hTL{(K0 zewjs8vF;GUFWni?;A+B#-XR>!nnz}m=&s?aW_KxNUgpR$J5Cp?F}Zqe8c3IY@AQ404)(sexXJN zymOd5+(!De4!8oDjr6^ikjxY}X{gVe=yu1db&#JkUrDP3M`bLM`DL%z0FZSMl_FW$ zI&}9rqUTK-YVYn|hn1{FIcy6T@6+}{?k2zxEfiVeK4Q4s%14K8Mb?v2l+`; zTRp=#D|QyP&X>MPLw`aPvQw>gNq~dZ+Xv&|U}^hcKBH^xgDBu&sd^XG{DO5P{V`mX zqM$23Z0!11+CB)V>80%h!olj?gV`}90vM>Fw`sBGn70Z9LZ>mI2w+I^Z~&glLHv5XN8t4Pc2FPe@=1 zdNnnM2S^yd9J~B`NEp!pVy;AcMhFSR9`XnY^K^iaEYTU&(?ZFi1ie00Hv3msAUO2W z!nY6FKIP?_4VLZ0s!TOmhPp-1R9V>j#p_n@_3j3$GU<>@6%SJ^J)|;a^=Z>%@m}vL zJ|${HE>>mCE)td{cp0ReE32I`XXnKXydA&?LiGu(%9ImjUcA>IpWLywV1sc=*qh=~ zYxnx20?IOeN1WjnQL-je*4qmx%jo)Cxn|v-i!y2Sny4w(WLt{_l8u(_Vq6T;^HpQxrAA#c>0@`r#!~E40g#QOB>~xdv~10jb1^E1(Gr1d{Ca|_5o9IIna%7pW`(0A0oi=8 zWXuX8e2}OpEs%{FQ)wU@hDyY8gpd_vM|mI{22}{10hYr8T3fNAr1}s?GAmhfM7XsoqvV{+G`4#MV?Ds8)&f8dF(N zWdgO>QUN=XvPr@a+fKuWzLykc}rzkQ-^5y93`Sl0`^XxnC+ts*Q6eFlT`;Oy~ zn59ZNo`TUhX0>KD$5fQyA^R@GM#>pkgntUzcbyr{>CGU$^Y|d*-G%hKKEMYlzz1?3gNibx?wZ}vd9NJ^enQ|_1W68y_-(wV} zoURKR98P-X2x6Mj9Bl?^ikikuK}FX&-qjv!Ov%2X>(QjjCage&4& z(WGat)!+bg1c!jg)P`^|2!ETFYlR_Uu&?EqO~kdrkicB4X&vMU65+~ot*RWskZU!w zMI6Dgmgic9;RFcsNtrcZ2~sjESILA?0P)?#Bx~x~#%85T3atQBkm5805Gf(GdP515 zu3S_HPIEBn{B$zQ(2&GP*?gICwjdT;u|z-!D9bI{f_N(Ci{&C+kz0TcRpeGJkQIif znlFlC49_Y#&jjTe5>+$?ejegH6LVst(3)e$^OESYEudM|oK15QB^FbE0Fp(5i?+be zzZTd6dSwfQ6lX|C?Tp!rof+D)7kxcNjH-a%7qS=oMl;J^GXZ4WjJb{vrxQEWQ{x)59057=}&w~)L@G{)iolf5$mv#PrC{Tc6ABSleA zP|Tyu^Niwz#;7sIDQX-MjRPVA0v8I=E72&?&|-%)v1y6MHnfO9K^35x+N9HI+a$)M z(}|s!#N>6-X=A4~5$e4ETI+xAJ+}%pN%!~CFD>6k{qDKLIeV|O_C9Ovwf5dsuI{|3 z?GBsuNxQ4Z4r$Wr>hkHt4r%hf?2s1kyqMOV(z@@E=IRbWaAHwx@mhjRLsaqT~7_cR%%@g zOEDw8ZYc<2M#}Rf9zYbG#qQswV|x;WG$YFz8@7a9o*Y5Hpv#lP?;CV^a)=pO`Q&i> z_=)h4JUJqmk!FU*yNLT0&y7@5Q1RTrR(loCjo6HgpBu6-xj4n5mE}Ds<*6Y?WLd*= z4YCJi`N>hX*Yct6mD4R0r#GZJz1EuWvXM5t=4wTIpRJ9!_<2~_g2g)k!G}p7+o_Mwc zWq^I=dX@IXlN~5+PrM5K@7_B?x5~Pf!Pb^umthpKO3GG>^lM==2FR&P*6Rg*+=OmP z4~gyARJY1biQD9=%Tu;IJk_pvH~SQ921*=5# zNpvmW;Pr?SHVXErRgJWbxKs5(Vuw?&E?w#;vvu)S-Boo#ZF0BGRH>g#)#S?kq`ne8 zN>`^#{iNwwO||T`X*yP0C3|g(9?4#t)=S!6o1#BrlbDX>b6M539=YURn>p<%Yq8g+ z?IziMuT2yi517imHk&f_*owIqv`Y5cY)+?A^13EfgTJ!ZrtBu!2mfWSP1(WF_S*FD zPXE#lhC{+EcQACZkD=|gX*(F&UYp}eI~dAto5>vv)4_D^V3^ds7k!c7My+_z1&HF3;fjkrA-Xl}*CGK@l7nE$!s=9P(H{w)n zRC+#E*G4sdsV~XksTlVkZgo_;^I1F>BDt8!9 z#P|t`C!^f^c<<1LoQJ(b<^GoU4vqA__sj;Foc1AAndI)FO_?B_()(WCJyiM-Hx=kz zm)%2~({o%+&wgnKBNIz5zRroduY64r0gCV z?-&{H9vbf$xyw%@Wu&}gr0gCV?-=P~;!jcwtc6N%ovQN^_rt9XOLrk#n=Q3CzsBYL zs6u}pmfBoUonxD;s`g4d3I|nbwz{e+yDPO-KKgTOb@_Z1Z4>Fwt<`06_#$Lqmkacs z^vH$TYL$IeHe{Qt)jN0~pZvOXjIQ&YypSEZlIrd_4kG@$RCs!zy8!|OoUu&<}6*nzXXh>J# zZ*w|AdlfCoq_AZ-+G`cwYf1(9+k*Dmgj#39TKugGGkB+W7~%DRunD#HgId%&htm!X zdtmSRA!xHL;UMnvIxg`1lvn`TW`_lR{NygLDc$k6yvyq#zooRxYtEnI#k;)5d!@=Q zugSeqvCFI1QK3maQ2HL&1HBJ)+{54gDIa^Fw?N0M@w!JC;%~F+cq2+0Vh{8o(D4vu z?->jZ`vs!o4dG~*USn0q#|2gXaY0XH_x6KnJH&4YM*HQRWT*L=ik)PeFj8bY$xino z==p7)?It_QYjoq?WP2bLjXSyql{>oTP>NdY-#r96G%)NR^bUsyb#TA4C`;OR@wZm@ z?;aTR_hSvpVoc5rR{Fjt8Wiu}-OnHFi3U~s6HEKkPV+Kuyg%&#Z$M&y+UaiOwWgk_ zkYl`ObxknAm%H>d_N<=hS9_!UMo;dN>{;EzAA=FiDY|F%ZJzCDD|=SQJK8pSqugq5 zqKh4EGrz4k`vADnA}iV1Ipa@LS*^s*&J(?AS7aqSJ2xZuI+hi7cFrBHI72INY$5 z+`-r>ca&4@PQ;G3t=?}dzn@)&opL8)_uEm};Z}C$l^uC|xMQ50I|V!6wg!hQzn?xH zyYb2{zvHn}?g+O@%hcN)jvaQ#VfS2YhT^uSqRQWdb5JJP6*w-F?ED*-Ddo0iXI6gS zpLL8f$?m`?Q+`h6_nkwKlk7e$^%#vEdu5m5{_en%tXQt<<12oba%W&)U+jfk+HJVB z^Ke3-|NP3 zb^`pqv@aSqCBx2Y@fo}o?rm7Ma@BLE9sB3DDVprBhXP<@HSFzXCy@Q!mSaiF+rF}L z!O?#&yRyX4?)x)o~_$)uKFB`*&6mbHq0J8Y+Z}tYvPhPxKc&)uu-+r$uAoma_ z@ILHbk1YKg|L!KoNso?yExXz2uXRhmi=^=QIZ6-tUwM`Me&IEG0<6jTVefkP2H*L5 z%`}M3?wkDB6i>=t`n6u2KliS27hxs?ejYk6_Bp;Jal5W;gU6q$*!9YKY42)xAyQZI z+m!QNfAGnAr)BfJv)>mN*nX%*mNI*nyH{W~!&O*nWubpf#(60>J}#%$QVMF9gP26l za-T(1mwQ)W@s+FmtD}WE=bwAbDqSkBp8iTJ$e(#1a&b9iL0#!ym3RKd?Kj^9BE>V2 zpki7xk;(@#neGzzQtv~UtcD*|J3kIbo(ch?;U#|{zqsH6??Ozh(_i@bg@0MC^Mm|k zDUmc&Jw2-b{&S@&a)ApjywJPI!}pPkdTI2bdgn)tbEPbHZWUJI>mE)oU-wa<9?nnP z{wI~b%Tx2q-g(~n@?{@i?&Z}rhArr z2lFKGoxaY0q{p0kYWxN74EMd5iGCK+!rm90)8f2QGwl@n)H@y1CC>2hDW=Gs?Y^(S z^M>1J-YNR2cba#)hfk5kfZq;ue(MiD@#IrZ@lJIY$VW(DI3sxPVCSvu*pp5^*~9zZ z0wkxNj?A$$hB}Aqr=4_?hqsXkwg9;drw?=9a+~L#cp|c9PsaT6Q^N%#oWtR;6Xts- z`X~7(hxq*{=WuS^2`6~-k&SRtc=BlHNW-+_{S$)u;fd}^W1Pco-`Vs0<3qeL&N-YK zHfL@yFFf8oVS;nGY8++@%nj#Fat`;LGJAGvjyrdek@disuS;Ygrq%_Fk864c7*1f&ym# z7Q!`s)~45lgi<+?mv(f79W zig0Cp&8fxVO~H-94M)(+1vh4Hs$QJEDRpCbLvVfY;m+$m z99*Bdq4vh?4JjOkn3x(Z3a(3kxX1OG52vmRuMHLj*941F*EU?2y*6AFUK1<~uJ#wE zu4!D9xh93z!Bqj;cX)O0h3TtPSA|!~O7-p);g!u-rLPRH2z6Q9=(6zgepjR~4=)Qp z6kO_E5`3r%t+nQ|)Q3`705G^1jpmZd+I7hceOVfum;UInsh-g*7cPoEclAk+nb+;eju$evgA zf%LiI`$ME-duM0f-{aiu`_t!y$RP~Rip~t**ZZ8z`%-uvA~n!EtL5y>S*bHaO}>fV zn>#aiR@Is5_l9SL?+H(LPfMNA^S#+K(s&&r5*PEMVaI#E&z(zavH?QgV+`RPM)Et@3IdE=fPHJ`v0dRMQ zH@nxI{Ot6slt$nN&dSV8Bha0i);V=XpP9KC>FH_Y^!Zb=(^E6*re~(5r=}1{>o+Ys zH8UkOIW@_h=ufGiT0JF$*D1u$qvKj8XD4MQrY5AuA8~t*Ynqgsn3<3spBm?mb)6%A z-|;mQYbIpIr^lrcBln%o^x)p(b2vy#T+HdL8QEi8er#q;8o>n2B5{tm4Wp~ZR*lJy zP9K*Z<&Mlaok4RjrhatxxXh^ZNN+^W>C6nQKQ1>aGcr9Q7+!@_46PcKADJDIMtr&& z4YB8l%*d({+2QG7siC#_d7ofJ_3-Sl%+U0ZdZ#lxpmtbxXci;A4NhnEpsJy{A(_FM zK|S%qhQZk(xxv{%nSs5WPPm+d^MkSjGXr|#M}5OV`GMI1nf`rH!s-@pVAX&u0t9`X zPOpbIAm2ZS@!J;XNZ6}?RZAA*c?0m9K2`m47$8m>+R42zZ2eN3Cunp1JnTC0c6(CD zY(5W7z56fYMLPX!Jv9Az_F;JjVR^A@4_!e#_b@qsFrNG2p<6iG@8X#s9=eF5{Z8f% z23L5Omp==RGM@y`PMzX@w9h1|8P7|d;2s=hrisiYaX%>K3@VmtDNla)(fWP#EH;lZ zILbVd=zJf&j(MeFP`z)wPX+Co12X%>W`OH$ND<`4jxvz5@uDz9+~hSe^Smpw2VMk zS8kEt#F>Z56zS;H0ISP%|3vZ?{Zk@*5+rgGB^le2r;)9QIVm#PJxF98#`%TF{loi` z`xvi!R?aT;PQb%F@qTg+N#{KDm6nDSbeTlr&z0p`Bne3-msBPfBKf%VeklPP$w1+3 ze^!M4RK9P^yCkQJpf|+(;ryEgdSE^$<#Ds!3AvZk%8pB0s^$N-d%G&&hWsLm|RSEg`=fPb87VAau5x zmK2tzmsq+G2E8y5rF$lXi_ToGWJyioSeu3tjgt35bmeh!wd5(dItiuxo<)7V5iYVL zQj8bJk>Fr>I4*@~u|$>Q42M9cpd{asDePXwcPtVd;USQ!$bvvTE^(Y5BH0R2Y5GYT z5j)Epigfyk^!WBpdSGfm)ZZJP8YbVdsGj6NxLuCZEfF3I<RNu75 zk2B132%9CE93M#@k{!iS9ly7HmSKKG202I>J&IGKqtcPYangwYWHsVrvEu;opDZFi zaU>bTXr&{G7$hGjl~V%aj;}m5&(@1RR%Z(1=_spWm8Wl`!>Q~g`$)a}8 z#M2_NW~6*(t7zFgx+7;?$SEo1emI^cBK;;jDD6@0SIJL;(>?U4-Fsolv9@`BUHj+c zED`BZ%Zr4RbHk-u^GP)?aaDBWcF zU76qK9<{TTjLNPHU|E+KPVStv`Sh3s`6dy0d4)OcruIi zfzp3^$UCd-fvr~!#`vY_edT1$)M&R$?`!>_t2t-M?@8b2Y0jCQ&w5|!FN0FfS^S=) zU}G3wd)3NGd%kAnSkEhyN2K?YY_s^C6na1D4?72!642te(u1QxAug91QGQ3}_4!@i zNe{%RHoqgCuO&aYOgAgPlj+~tqCKm8CC;_!>{sfHE&U7~B)aeTW9crFN148<=5i{9 zq(313&Mw%JAp)eDSu&?|rPv1qWI!a(Yuc2AQ)DXzE*Le-BOL(`sE@WU`Lg>}C$u9iZ zJ(!Q#9yY12t0if3MEv(+qy;u%Z2498ZqgeZIsN=@eOPRjNe?1Z>bmw+(uYY;;pvpR zWKR`;BE1e~cW|bP%sNT-ZqkcH$LPbPzwkJtuCm{YbHpQ^QP;JvvMh1*14rq@Y!-<- z2R808dNF^tr>0@o-b(r(EaHIjCVMOEm%^F;47lSJ`RUfXNxr!|&F|KaS-0X(jVk)F zWSVP~m{S)UlQv7(n-pI)nawVF|fCuxB; zqfWZExJPnzMqS*ONorTr99Hyg=)Wow!_s}iiry?l&Plm9%k+-t(^=n!M0F(2#tCB5 zE6Ho?%ka7}N+by-6KADo%k^{{ypjQlm^lyDy!$pY+oHLi+GFK;D`nTvpA%bF<$l2|jc|77Ec%k&I|hHIhYq8%V~7nI z1bdyvd` zbZ@Y|%I`^+5svH}QF1=bOp+OC;RttloQ5xH^X5W^!@DOYOY8TTm}~}5JjYhnM(dhz zFNw*qI~uQJ5R?*=<9;MPC>ZE=OSlgQL@=)GJJxF;@1%eHo7jRu#tE&R*oKkR8eThSwYniob8^q2<)%*qyZ0Vq+?4>mL8;>np|5gsce>#Y^iLLGAOBR)>~LATRAmZ(z42_$pO=|%BjgA)3ds! zvPoicQzqH-Bo~sZY-)bVf2n*5yAvbzYq~a98Pf69`A81*ShI-uB=7oscE@56s#{|X zF^cY@S$1u#SdteDNy#dRl_qn?-Y*2H=p=%8k7@5WjjVoC=TN35qbb$$q={49r9EV; z!_t%nw<^ack)*iGr=s&@5yv5fE`r!xlCmO+CgOv3*b8?wKCn}_Y0wLWfjZxlhsJ1XD(0f6+5W1=Z*RV ziD@*_^9Jyq%8DjdP}wHR^bVWCgi2A#YdR?)D z%2rXX!B6zM=^i0XR%@=7WF)wMaK^v6>ye5CYS z&zskje$%u#rN6d15C18iq~+&R)WaN-`c2m&%=@z`h?3MVS{NtwH{=2&^~(f{WKw?v zY#+?B(lqUwOfspzDU(VEnzmg|>X)9^PkEZIE=m2(NO;cTZ#m)FlKQKmZw-lr=blI} z4g*W-50PZtSW0-7r2aVJS(5tWgy%S^UlN{^+Ucn-l)Ip)$xG-)R#$zHPvb5q#4|YA z1^JCZ!Y0l&M*0knpU9YBS<($m`NlK2>^;kx4{=9@d2PDpLwwi6`mm${RrOI_rqlyv z>Y~!~xT?;t^-KLxzBXOzfx;Toiz?htzcjrgRh?n~Q&Sz4p2w-Gko}KMS&;iKQx>fE zu_+63-{m=MI+4re;{Hc9qDL;B&1?TtgDDF(rK$9%jxSm-*lh;O@&m`wqG;v-&=H-;;Sja7kQlU0l znPbtMuH_ty5TEolRh92iwWN_nTj>XWhPic-t4dw;Jb1cRN z^?q`WMV!6A3;jhhd%urAtdzZvITr4bikp_F!sn}H@W>?R>)??*aHaDzxz<*B==@CO zF&UMTlg`gnKAo#p$<^jUs(gTX*LAqL`D{uh*^sSM`IS4rc;0oDD!z4oO*-$oSEezY z)43`hIzN$TE)~!AXvVy24>E1h*&h8d@7iX2r0`C2*peC)#bw&wAmg*g1!~AJp#}S92(u5mfJpT! z3>zSW>M#$D>KXd@+Yg<<(69lTln(OvD>F`pV!m!X<3#4`#xqXF1vRA^Cw+opetj_3 zFV8rcg5E7T1)yVHe;4( zsCPCBVfd!fVIBU~VxDLVT8N9+{jmhX5VVjw)FK;X@V7p2@lKzhe>f1MF(ZQ-%%O4p zwA9O&79z7mlk;2BIt$6>w;YGK)L_3~X?{!IpIn;XGR4bb#VMQL63->!{1(JAl6P1% zt{2J>U^e3rXk1Dp9t;Wl2BL92!{dS~ltwge9A-0)4jO#XxOg^WRWQjnjhpVLz43l6 z#s!+-hYav!K4Uy*#?|>nHfQEIuV-n_Oalf8^WJ0^b7qhmn=F-wYt~>1jz)h_(BjAU zGlv+j2mSUuxu5Zjy%v9vC-+lk?4|TdkvrW>muA}x^!iuKwsA4XXI{nCCizufEX}_D z5U;@>?TIu4J)4IW#d5C9XdCAB!K$Q#T$$0vnK`+Y6=!O7-|_-?l2_$QJ!KA9UvCJ; z*hjln-Xs@uz^YbPe18J$x{+QlSIXGO8|Kzyo!Bfkc|sX$)>eEI()q6)*Tl14j&pmK zX5uusqaB;|GP@$jxHTVP9*)d;iRa-Abo)EWc{ncS`pm2RP4uU=JHf#`oM2_;_tS5=fiuaia->8<+`djEjM_>fNzU)}890JejqX-}hzS&Qv$+NO@#_lg!zP%Y#{+xqX%2cRNrXncF0De55=w zx2dOloKxjaa!{VCj*9QgjHW?uiO9uTBN?anHr?N`>pwP6~dGybj`w+60nCUr zjJIl<7V*kzY54gyG%;*JrMjvVynMWcAC(tW3hCun<&HRTWz^hg$i0^&wf^nx5liONjrywTpo5w&ulJ(lxH^-^P@)w$PeC-TI;YlN`jp{9_|>;^gpAYbl>XIL}7 zj6h&**biUH;z5SwWjDa1Y=C^VZ|DYtaE=~$o(;hlGI*jvbzGVBDd-i9#HWqHarld8 zoey=v<4qoJn8;V>kH_B{e~ z6|(q%akSTwQvgMon#7dO!@ocwDBgD$S(_aGS9xPc80F zeLmEs2V`6(rN<3e087m52AJ7trHspnu^2Bs(3s8Z(gTgz1}w|dh&$oy(gQM;*~Vq^ zcu%G>`^rqWr3VI-%xs&=oLqWf7)*#7WJbmlnd4CzdsvT$i5(zXXVaL62F(=@>rf}i zmZvcf^!s;xRO5z6?mVy4ap!s-q(0jV@OP${a%OmGyqbt7ToxRGr(7Ov!IQ4q>4|x; zH8{#)E^M;T6AN3s6S1&Gm^Er)i!E7R*+?vGcwMltMTB7{s}^N-rfgw1LW9F}h)>Ha z8|74Vu3Ff#vXQDb=2MG>?W;xUVfBWtD;t@GJrwp%HAI;2V(-{|>hXc!#omeMQy<&j z`F-XHdtR%%rb0@2tyyx78!RxM&Z4&Q8aK^Y6`>AwYtWY47po$OFD9!Zw7|o!!s~`^ zYur@9qN_=)iqIz<7TBr?V}q3M!J@0Ku(5g|U9D_mP4%-CHdZfxWXZ;QiuP4(yTr4Z zX}kE9wu`Nol0!**mDVE|f}W!uwkA3!{FU_xhG4yv0pWna)=L?eSdU;VG7QAIPp+3z zUXLKQ-iG*nz1Vsa=RUUHrh3_u_151Tn6%!){S|ki5g97++8yH(4Jf$|z|k6z_^9#P z9q~EoCN#=%wD`({LSz{F@c^Udt*yp)$7Lv`hhcwDjeNX74eZ`-uy zAS}h$GK*(Zi)EJVIbd(mK8)=#u@4jWm|JO&wdUek?qVOtmRW2c!ZP!_SY{cS|1PD7 z=f5ZCbi+Oj->fW8DxUi;<%#FM$K}D?_jH%J@4-qpRhs)QYcYNSm)io2Y`0WT1;_49N(y`q-MP9Y-ER7V^1tMe<)dlv?PB z{7$;41`KD&d8EsdPDjq0>_4QfgIM@W<4F zKjyXH?f>4@{r^e&mwpz}i+BIOD}(<>I^d@f$}9hOoZ#n<6F%waKX19?crV#&cQ*3A zuD93DR&Wnrp9Ox9uSbAm?REA$j+4I(uU-64pSbvzs~6rPpQP|V!2byU2g&Q>*Ws_@ zWbj|!m#-tmOkV@e;Kb{GiPyQr>w$^a`NZq0#OvzB>sq{)>&5@lcp=x8^AF=|z!@s9 zBm4u0BwqKF*ZBWW_+S1Pe(xLQgHrY7dywe&2Pm_j{Tcad;|{4WYP>_rC+tH?Iry)1 zE=aG*ZcVD`8T~NT^gQ`8`AbsDjPLiBx(e<3sovvxd^~wJc^SEwY$ZQNK1@DIK0`uX z@GsTxTH^qoZ}7j^@z5(tz4=aR=z1Q1oct?t7x{Ve>*No~Um1saWDjyMIf*=xd_Q?5 zc?-Fo{5bhnZlZ;}{-~`M4dAZ6lvE zj{mN4GVjl1(;KW{Ywu5KBu!sZQ>OCx6!JWBA-Rk!k`I!fCijqEB3~qbO#a$9H6$C! zVdPZu6!JWBA-Rk!k`I!fCijqEB40F4-(s9??Ibn(1v{SeIpYbZ7*A|8p7NM+!B5FI zjqmx1@hoZc(A%?`$Ppy(%UKI}d;z(LTtRLiA0i(k+sNn0m&jMiH;iYe$tH3HIh|ZU zUO+A)SCAXXhsejsHskyL!uSCgH~5!2?^*I6jTg-|UTl3<>f%>;{JQZH-+1W`H@=Qo5v%`8RTi?h2*uy z+qM}Cqe%9zYkp+Mx8G`9|9SH3EKjm~k<#a#gbU)>E|84gB z`#(bdIr$lKpK;R z5BVkXMe@hwuZ^Dy$wuSD+l`NynUvZ-#g4bLeSPLaJO1k#5jr<7t=j3O| zedL$PZ<9YI-!wjvAs;tBIm!4G+xb)T?RfVxV;i4CZHsx_N>Y#89_I0r+^m=j;!^_*uSxfc$&%pUIz-hmBvV zBKwhJ$T{SD$xFx^jDP!<@$c?5e)WFi-_JBY|98e0cz<5t{ds}+=LO!Muk-$Vy|;b; z>m$h-! zH$%wDXKOkQ-_H@a5au7L@oKK!(Y#d|k{ny6ktH`CsmY0kJ?<2)^ zhC@8~3#8q*^e}SdkL~@Dzc!8vNz>=_DAUjMDAVWks8jg4>2rG2LLM(8i{yjkr^!9! zm&g~%ACtc}9v700_=f1-XHIho2I=O(nfLuhbAUBW?k&lsWEr_P0&)?# zg4{qpL_S8gko2I=O(nfLuhbAUBW?k&lsWrcjb>SL*ejmA&+(8~BzeawK`~`W$cuh6gLXIWp zl4p{ak~flT$ot5xkI7#f|1u;S$zkMF@)Ytsav`~lERqkBpEiD)&zn#4dGk2= zS-$_IjpwDG?6B`YY2$h6C%?<%e20$&ZqsB%dHV z$gh&$CI6Lt%lK5D>`RU&XOm};7n9eMtI3a&pCq3kJIJq+-!<;#^Jg!gKkeip@^i1* z_df5E_2eLOA~~Nthol~VehH6nCm$fUkx!AIBVQnYK)z=Df=kwugUE^GeDWOf3UUc~ zJNW>)jeLsy9QgwI1M)TF7hSTR9Ax~;5R%WKuaPg1-<)ore{%tO0lA1=L2e))BB{UM zY~%5BK^`Q(Mt+a{1$o5y(`vGX981n6&m=D;ZzR`{_mNx49mZcgNj_tIjr=wF z<`?Y!H@`u?LcVU~_*0tWPic-nrGG>H{mn`I-nryen{yokJxTuI(deu8|Q z+)sXm{0{ju@;AonEZK(~Mb0$#m`$Ex>_s+{EoSFrS}wECTNab8;{i|KEs z<$1pUGWkm~GWM?}2aw~*?u!LZiJuVHi1;JcT@u zTu3e>i{yjkr^!9!m&g~%ACtc}P7KLLau_+4JcT@uTu3e>i{yjkr^!9!myFY%BVRJk zBIl9w&Cbcp|5y8b{#(Wq^JHIgG)a9vk@|b$#eDyIay9u;@{{BfWC!_G^1I}}l5ZJL z%9DM`(d2CM4Dw>~dU7@SQSy`I6J!VZRr0&!zmjhmPtF@puO?fJ@A;nbEb<()gEHs5 zX79h>?4Zp1>v?Q;Q0Dy;c|4yyhrEJZLf%e3KyD+SB0opIK>mPy&3LX$){}$CiR66p z9P$cs33)sD0J)8Piu@e;0{H{-HRA_dvfg-613848Y`m1be7YT9ZuU>+@(Xxu_D|;W z6+GTRK14o7wvo?~FOjd3Zy2vglTG9Zayq$yyntLpt{^v%50Q_NZRB(0OXREM8^$Zs zWD_}poK7wvFCZ5g7hOlLB=0s}Pu^s9Pv$1Gdonkf-IKZLpndPAuaVT(n|{ILBgVzm zWD7Z#oJ*cbUP|6bt|9Luw~{-^gXGu9?~%VCj~H*RCR@m{23fat(POxs}{O z9yBg{hJ2oU*|?G{n7xxJn7xx(PhM=tpZu2b z;SU?PZ6Y5bpC-RReuI34eBJn0KG{GHAt#e3k>`?EkxR)t$W7!URs_gV4)`S;{MlRqa98xK^G{m3!o9P+*7CFBic zfxMUe3-Yt%0rKz3eav%9+ z^4sK3$v2HJWsKip`}$|g$IE=L&fb5S{n-x>+VLyXNXwVXymCH|uOXL{cafXPM@h^7 z%e*?#izUy?h?XUTsg z|AqW_qnU3`=CwK=4>bPjlg9t-XMAIp@y(^ix2SJNF1O<&H&RWkMzi;_O&_u2ravb?L+&HLOn#gEDfyCb#*v$hqd!9axp5rjH__TvcH&-pf8yVg-y(lP{-<$LitI%W zC#R98lIN4xkju%t$j#)V zZ1N29V)A-&wef@Y9L;{no_pELTJ8PIsfSltzmr|~XZHR=vqQ2ADd&Y>ayftI1o*JIOyIx0AccFOuIRe?357PK4@IImE2=oGtAh^``gO<+sgaf%KO{O``gO< zyDn|NTh~O6Ag7ZH$P36tyB>4>aJoz&DOENM(R7(yZ$CJmCXOowai^*2Vekza8C$AxwlXsDu$w$e(VfDY6$ioSa6UN}f;h_m6+yj-S|1 zvVA|n_WZ=p`2KH@^tbd@;Y)Qc{lk9@^NxM`4#dzO8ogREw=}2@K5gd zwTGO}XCB2~7`v7@t%-wT@}SUK8)4FKYih02`RtB4PUoJ&Y^SqhGyWXfKHE9+?9LnU zvh7a%Ij{xC&pdt+UhZ0gKl|^+pMzWF%_pwJ%iSySr+p*-9NH$o+;I(FzT@dG#+QzM zx>a(zOQ+}gPHR_R93}N@C}Ibb_Kl6jVN%DY z;t;K6?;^H6*;8mP4wQ@aEB2R*^)L3*iw!9Dm5U83_K}MXDK^Q)E*@IMJ{h}~3@`SS zi;XPykc%Bxtka8)E@GpN-K)kHtEK+qi+Q= ~%2HmQg`JNB%ZQcTIkrWFH~#Pp&k zSG#Fu(N$>_ajm&UNTZmPM!}>}FliJhje<#|VA3d18U>R^!K6_zX%r|8Op+666igZg zlSYBkC=7O@J$(x%jDiWHKw%V27zGnXfx;-5FbXD&f(fHQVH8Xl1rtWWgi)X{3MPz# z38O$^6ex^>38NswC_os6*3>gj6wPtG2n%dSSf)F|+O!eYvW})Wxd?03Mp#QX!n(B) zmhFzPhHZp3up_K(9bxh92y5#`SR*^a`nnO;yp6DSc7!#wBdm8FVNKi!YvV>(CpW@+ zxe?aQjj)Dpg!ObItgRbif$j+F?nYRDH^Q2?k?+ioTxTw3u&>264!7Oex(8d>9N2<= zTQ+t~g&I71QRp1$*mek;n(Vq6wY`4Fv$z%e?t&O@--}I94sOLJESnFE5Ounw!8!8i z_Ghqd%I=j-PUq5{gG5Uq>bv)~i0)vcl`RMRi25uX^i zXkhy`;Ey%+$1lapWK&10TiBX?1`}2i)hL#$Q7l)ZSguB~RE=V}8pU!oilu54OVucr zt5GahqsVG#D>}4YTM>FKZAEQ&YAZUhMOu;cT@#Af=VsT<+KTpV&{lMCtG1$N9=~*Y z5#ryyQX3Kau_8o=MkJL(^G{T+P_A5|T)9HIa)nam3gyZb%9SgWDpx2~u28OApll$1u9pN$`!P7h3gz2 z4MG}2Hk#~IN8_RVV^sN@qG3+oXb_aWzbgB%sOcz5js>INLCGP)sMUMciFP0Fbl$Tc zf3_Z)=N!56@n`2boon~tcw+~SzrRi1{qPQX_x8Pbck=-pL$z_dbSIAQ-Y0J!#G98r zDsL{|h2!%1u6UdCt&{U@lB?MHZrFk2kCe`Lsh)4y(ayKV%7?E@p`+_s{bwDk3{FD2kQVb^>K#k z)ta2)#m;qm(K8iM_nyuuy;=`vbg}b>9q6NqkN~T(bwgSMl)14#$}*AI>YPOo}C$6jUY!lSzRxDVR*G?PLm+Nr5tv z76X|`bAe2>sX!*uP9PI$B#;R{6q%rPs7wkblY+@at_GPDC=UHPn>2vaeAXM_Hsr=jdZ5%i3(8jT0AD+CTdfGOidfGOY?b5b!&wf0HrNft| zAs0JN+Qy2fwQX!{$1_<}Pnt&8ix%{va&K`_^v`-xxwp7zp;Ip^_ZAn`dy9+8y;bGY zi%Lfix<|5Z0C zb;9qw?co0k*=0KAsb6xY+SbGNI-uUqqvH4MT8uw!Mf{;{rq0wYINpC>>CGpu#>?Gh zXUa~u2ya%LPMoPHZ;*HID*g2FOXR03@Ta}o`Nlh~ap?}j)e}#vZM}M02R5sxb?DKX z)YICvSUjz$EeA&n<;)kyi#>9&I$FDKQAcb4ed1{0!yd(v`0$CV)zR9$N*%5CP2y-l z41J2QUZ35uNFA-V_3CIH*sP8gt~H?8tTj+itL-lFv~a><#YVZ>CF*JIUZFN(`+Z^~ z;=?h;8oip@h`U#fFILn@yd~5~yd~5~yd|lTcuS~}cuQ@?EW9PDQh`+xZwXZrZwXa` zwNi0KDsnD7|-Z{FZGFM|q?|1LuV<;IaX-=jB`hX$l|aOC2hT1RVot)rz^H9oji)fi(N zs>Zul>3~7|CK)imty4XQ;;SC-U9WoFu~`QUFf>swiVTNb6}jzBRpbL(bi@Gl(h-AQ zOH`5f->ZszaH}dZuBIafyH}|mw{KECKD1r+7*|t0-n(A)xMQ>WI#86+qR6|FG`QWj`x^+o4VebISTU%Vlyz9_v^UzEPBDDIHdUj_-J{^Aay z{^Aay{&0t+{xU`&^%r*t^)Fcc3r8Cp=-NU9$a3*cU0umFOUwQJE?dYc2e~Qcv3OM?4;r`*hz~xX~BxB zMz@_+?Qot|OmjP{*y?sxwWoPjv9#>0VsqPB3pgu`*qJbBr$%s8FuXDz{my6@z$4+A z4#RLv*iC57-RxU&)M53Sfh!*7O=|Vtsvf2|r!;WY!>lxLuT^`wRXjrVB{4#S-`n}t z#~y2RNo#JMcx&tSs<*bOL%lUvqT;Q|xBH2^wqYMekHia9Zw+NoZ|&Bd>aE?qA45rE z|BAB)Q}mfS@z$0jQ4gz|}{te%sVPlqv3J~5S1KJm!ZbF%UkI<_@?EOh_v}aiCsz~AmTm~`RIa9~y|F`8 z8&?z6maEmsNW{9ms@t17RJU<8)$JR0sBV8`A38~K8CA7WH&yLri0NS@;-38wNU6#@}e6+e&ykq!w0kseANK@*7fV-Sc8Rj4PZ0@1+( z2thM7zZsPky;zUlz>=BJ$*yYa0U&d%82WCVnsc41{%zsEKI z-{x}X*P7P>t5W>xuHnr`HN2@YkGtSG(63fMxNCTGAwEAwc(cFL8eiw|q3uPn*Kj3u zE86Z9w*vNQsyGEE=%W{@TY(slxE1^E61M_ZtuBtmhmT*PZpH4E>K?am6!*CE(6*k% z;bP7$RIg%BLEYny&Eg)TQhkd9^kV8&wB6aim@G-5z>?my#4%60z`660z`6 z5?J_Bk^)O27CuTMUM)%j17Au~U`b%$M|*mUQ;UMYsg;5hSP-%AQIJAw{*dFAqHk!v z7zefJn^@S`S+*2?6IT>l-jaDpAx59=fEb^>F9;@X| zjUOk5Jnq1oI)VbpU!?JO_ikmK5;!!xPdx^f*_#;t9P$f*Rx}@xSqJ3 zBZ`PJKD+Y@rqn{5c?(Tj8lW!KFbtloE*xSmj*$;GrPvAUkSZ&TN^eWSRZ zxY(@XVFx-4&vW-`hyu}rgeYX}1)>lwg(yTzAqvq_5rt?eL?K!VQHYj86r!af3ei%C zLbMd3(6JYYLflY@LflY@LevzZkg*pLg}9**g{Ub+0XI}cp+heag}9**g}9**1>8^( zMS-FaHx#0fp%;ikhh88G@j@XA@j@XAc%dSS0!1NSC`2J%C`17-R76oQQ4~xRg;uZC zDUaE_Q$tCHsk@HZU~A`6m|9#>Z2gRYfrY7)V>Ylb;7?6Pz`(-P;)({&EQYCZd+_Po zwx#lDb^Bn!QYQdrHss*?;ss(L#s1_X9Yy%LFTE+reVG#pd_@xY8v~NlT+jnQNu~9oN@5Y>@)?Orl6;hm;+9uAqbpC93PxUoGzS3y&{}OqZc@hI88VW zTqrvY0yuLb5BDd)eS$Zo{%{ueFAo_YXoUdKxTwx)4WLJxQQ!4@%T?QUs8qE*co)ti zj64pG52#=9FuRBPpYYI)iD zRLaXm%5V$hr*giJ$oX#AQ97Rrd7YdOHXJ^(lE~>+NJ$X*nd3x0#T0x0ucp;K*afhK-4>dK-61-K*UvoK*ZpNK-9B=K;&u=h&Un; zh{S6l5cP>55OG={5Q(-zAmY$KAbK?jL=+wZ5$6X2QIj14k@GaQ*`6>j%^tsH30KO?FcUsXFQUR9LPt}1${ zR~1cEHN|yRO*eI@ny%X`YATvIPBIp@9#S>k*sf~2;%QY=G)`61EeBOi@7b?v+N~_o z)tLmew_{o4{##i@1+*-p1garc7EuD#5G{);0m>pupc zT;RX9;GQ<)o;Drheu_VQjQd$N&uMkwH*SEFx@!pr{*X~5R?8L~x7~?j82LCpv>nGC zoAGB)LEhZ4P~O~zvvjI za+Q4PiL2vZ?!Qldd5fOzV))>Kvt?j@f64VZC9sr*OHEux$r9AKZ zNlgi@%24>S>Wh{{AVv>=m$$pjXo$OPdFm5F3LLM8>132aS~ z2?8IY0Rsyr6Sz+z6IiDz6N#BXCIyoT{4S9R>{^wHBxFJ+1(OMEVUYR_2@G$MNdbWn$OPJ3k_md&d9XR=s9h*_m83FeF%B;_qog=W z7FZqZ4oQ8KFh?VLSFtxGHBwR}`=NIgdsI><2WczptMNritsIHoRUAICWhJ~a9=)qL zgp!geshQKzyNVqwDVwv=yUs=Lin1YX*>PHPjuUCSTB!};(o*ZVS6au-`exT=dV{os zQZwDXS{sM9D{ZFIuDUkUwo)@iqy;}`Gwme>C`KEl742ThR&=ShqJvwt745%wIvgRC zL>dw9$VHQ-6&={3t*GrzYehS6uvWBPTT#bmYelQI6~XDTR-t?2Pf zv=trPYOUz578wWFwOAUF#Dw}tD>|@QTT$EkUPY9)fYL&}QCd^)OJ|9CqqL&lC@sux zDJ`^HODpP)(n7t_rY5Ls^3yt)$eVp-zcr$&BwDe`?K~Ah}cP_Udr{rVbs>$7556^KaOp!}%NbVH`ys`8t{pcST3@m+jKg z{CoC81Y!cqV7{2ygCwtT#nU>Pzp)(+RUY~>m@hU!vjnQv?bXrzO&vO#kBiA@zSN~b zB2^pq!J!nhSx56>i|AuwqB>)!qWEU0q8P$DK5tbN8$-wEwTf~z8J=eq#lS`tWoz43Pgvk)Hwn9r>09TQ?fau{&iF>Wz ztAT;d2Q)AM|7wafl%+ehq1?R>PZiNaX(w`%#!8am@~5?-Y;4CPNc2$JiG+fNOOoN* zJ=#za2>1Iv1?YqL>=rusVzXrlBpZ zvnVF&tcr;`i(;bAqL`?&D5f+V)>*tbZ8=(JbtqA1b@@SQob13Bjg#RfX$WN35)FauzgOdA2e)dR z3>VW7$nI4d0%_kQArPEzFuYZGUDs#`WX~E6fpl!v5D0GONI1H3Gc^X%cBjNZQ2B9i zisfc%3}n|59sS;auZ(`<9!-TiEdxI~`n`LV#z5LPA>+z9w0%y|WKm4YLKR13Au$lh zLi7f*5WRscL~leE(3@yam8cCwA#NW;0VhyJAt4ZmLIQOVg#_wE6cPe~C?o^|QHb#k zQAngtL?Iy%h(baj5QUiS5Cxo66@`RAAPNbAKok-J5mCUuRZ&O`1foC;L_`5!K}8`k z5QsuzAP|N46%Yly3>Ae8=R*_{1A!>ukU$g#6GZ_bhj(ZJ;v&KZM5q7uu|hnn)b*5^ zdU!&qOPUOUh|7wkC0I%pJ`k4{sTHu4ECeDhuZuw4TAU?Tag7{Gs4vk1yUmNk$dkmk zAhZIT45TS63DHW5=it5C6GIh63CrL3FOX832^75J(J|dqX2T_Q2@E|QUJN}D1h8} z6ac|5DL}yr02O@ukkvcgFPm8jVRlOdY)y4Ko!{R!=k3B3$)J#gD1 z8Hh>5n0}8y%v?;6=qyS#ibpU53x3nuJsOUJ1*vh6t;hvMIO?AL5(mM^YgVFBaQ-w7 zviYFKK{o7@I0))h2hUAHRT>A`)S+>Zb$c}q0Qb`m<5(Sln7?K)MGf9YN<{Kui*HJ`I4VB*c$|B-E|c_=ieDd`^jfm?R36 zgc#-;|4>P&)ecGM)pU4UB_Zyh20%;_ay1Qrs3gQ(ha@ymqr=-O2?^9dv6k*sNuZPZ zU1EY_>59esyGB05l1@fG#L_-iF z%jqnK7U7ZMTN)rdYG_fVaZ8s_rN&U;KWP*Zb0HA^gM>BwxAl;!{l<1x`{hro+M|4` z_FE3B+TXoj)&ACg3x+3;}^SES^VOOD>Z&`aI3~I z_TQTm%Xilj4PU@^)9}TCEgHUPyVJrKJ8!h`#dZl_B(EY70bE5Q0=SBphPaAG1aK9J z2;eFb5x`Z%ro>ewARt$ffB>!{0Rdb^0|Gm5w1B{N2?*#_{-DA7Dny+86P)Pd7+pVl zWXwkJyF|ux1piST!Pm&x9XeS5_K~snqejLcBr#U;*M{&lGPc(uZNK|nMoAE5MMdzx z7=2s@{`VAg;2(yM4*Vb5rUU=&8+G7+_eu`@U!nv52e<0L|Gv8>h~Kd5W*PUFJisv$ zK09Co|7~}0;D3=0{2$tG1OJV+iwyinZA}tA zL)At5r1Cu^eAcm9)o<^5RX-@Ys^6jQs($U8RQ-0ZGWC1nN>#suTUGt`-|NGTKD=v* zY9GwEgh&byNukr(GgpEOA`uBLKq3-cfJDR=ghVX3aLHr|E-~uEf!81e$HMjtYNbszElLZ%6S#SXoNdy-l5e+WfqQM1`hz1w7Sa6}J!7~vF znu>}<+6qJ>Z3QBcwjv^twgQnzTY*TVtw1E&Rv;2-D-ema6^I0OK18BTrBWona|i>Y zWWRIl3`2CK5Qa2IafE)?*jcMAVSp|vN(7AK&I&S+=$D1WByxT5okC(GNIl;UcPB+f})65mm0$s$6mrRjzHST)2oR7cQd8g^P%C;UcPBca0L? z1{W#dB7gARf~T&Lp2VsZH|%Jwl{6)Mph1q!2QBIQaFBx`Tn|A2TXo^v-^DiiqpZk zN9PJtAMcjKTkt+`tkbJX;jPXqpU?~hs|n({5~$LFeAGq<@|W$>f&6>+W9&=D$z>d0 z#*8P)1eUdXbRd6YhYsXp%vc8UC5$s#LSF0k>PY^k4jsuy9d#uCh8;SRzhNIzi7gWb z1NkVM4&*P}r33l*>_?bdt|sI7;^y?02`np~)`9$u?TBg1hcb>Y7poU9YTaHP$luhV z1No4E4CIRpa^iq(*oOfH35)4KKCTvuHr%>Xwc(!q7+okH*>X^nK?PFet%X3umV!Vu zUrI;$RUqPGKp6ikQtRUmRT z9pyKHh`*$x{3;N+nhf$&AmaQ$AYyPrAo8Jv$0!iF7z82_J00aWfvDF5fr!TifrzR@ zAnJ}mAYztkfJ_BaP=ORoAca=<1dIgD)fF`2i5ik>^}B`uB!x>>(2$faiJM7^S3G@1 zLIC0j9V-Md6$uWqf=1j1#leylG@!XrtE3%>o_Con2JZrICT0jGnnY=aV8x6>S!d%9 zh^lGgL0klFK$5_Tbiu8Mr2UASGhLkM);-#QHg#wN!tIa-B>Fi)LSgIoVjxZQQyUOm zcWpqo?$ic!_dXC9o+mXc~SCjT5p`#WVAXvLc8_>oMZ9s5| zqydSs-?g}+Jt(edk7zfGD{io=w-#4@WKnMxS0Y^~u4s=0u|$fh-dbF7I#67RJ&AU+ zxZ*maxN8EEZRq4T>wxM%CMjtA3CacbzJpc(lh-Jn@8+u_y7Axy~HvcDlsOkz=3kHvIe;^IGO$ATUvh!|nG;_ymRVC0>OqYxrdMDh;2sZ<6o{ zsw1l$iV>~hleYC5J~^;i!zZYghEH}a*6>N&T@pUQ`FbIN2#(<;8a~;*Lc=HR_euB! zmSGDL_~c?5KH0rm!zb;VBz%I4$ts6(F&(;YyF-SqVa|_|=m{>SL)W_&>(F)ET{3iy zi^=+Iaxopc-hG=6UANySL)W;Ntj~t?U9CgcyH`u}qa*)so z_)U zOppWo4wZw%P9O(~oj?xaqd*Qwhf+C+kqJ47$q6|~=tSfo1L%;0n5U3~ctVf^OjnhI zjG#jfV%S0s;zL0WFnU!EGJ*~{z#@hm3bK5KtLbr=^r-1_=t(twE{+;@jhRT=9kPLt zU1IaABrQ)?H3o=`ilLe@2$YZ0biZWGMA8A1F%t+h8JbMQ{xmRh z4KzCuptU9?4MCT)Nrn>tu;pxUreq7np#P&6wPxozS}fD|C$3a|-@Qupy?vAF`=RZs z@9_NoFMDs+B-NE|Yi`kqPJnu)`d+CfrBvUgy65@_GLU5^hNP1x0Rcitz!n}tu|Z(q zR(8V7AL5=cE6n0@4dZeu%5e`5Z{e-#SL9p$iMoK-H^$mK!o$O(140ns4?83x-1k~@ z>^a@%9AmDv?C;}8?C?CzB#cK1fXN)2OKsVRPEcds0kyEjJ=3vGyW&*n&QSPYTF zVu&0TL*%d+B8QbBa##$J!(xcUJ{cmh4@2azmBbE}KC(oT50=Pbu>^<3k~mmG1Ws4-y1kNR)ziGPQ^}jp zD|;w;>sScX)$x~GcR0HGx3f6OjV7jNUqh3TpuN}7ycRL1M00X^fXs88S|P0*=m?^w zvCN}1nkwU$amzfUS?kqJL>^txTore_7gtyXl+LBIGMR>#CKB7{Gs>_7; zaMOhM@d**$XbVrN+lkRkco!Phc?QO<^Dx>A>Xf3`FyWo2+@kn8Tz*xx7?qlhh-HLR zdK%ztM9B6@{(}*r7N9b)5l+4^!X&iUJlP0kY8c_f%@U1`P%$KlCK%yL$r6o?P(CQG zI~d{7%yrucRVf(Z(J&%TjZh{it~(gv>dHot^LL6XstHsZWDBm;Hl+5UUgC;s4b>dk zvJ%xI*|HL)ifUKNmX#=#Bq`bQKk&rgZ=u!Ck{>B``N*6SS9%Gd%EG%>$MIGQjqI)I z5;C@gy{Nr*scNw$xl(9IsQhKzLM3jqQcZ2Rja@ijw+kOG+l6r(E0rU`gHKfL!TXE$ zV4Tz*Txi;Zf19ue?>KJ{#+&THL*()lA_L==Y^c&L*(mR)>d)8h!9SPn!5D4DW+XW9 ziK-p=hoT*rLfDE;p=rhD*n|}u*G&)+uA|^3RHvxO8npq4tL+)2m9;kt))*>BtTFI~ZjGTe>cs`MA!`h!gF$0Bx6K+ubHs}aswW@T z_5{T}))+`4tT8l(tua&vgT^qnt5ajB7pyUqV`~gBw$>P0r>!y6^41ti2U3jzRcP95 zm0L4gW!lU(e%$GY`G01sten{@)B0{b#Z&H<+y0|I&e!{hyqy(&yP$zg!oC4?7_O)eL@ELAD^B zEYSL0D_wqsv;_hj$C73xfsyipG*UNyd2KS8Zr8aWZMwcN<(I7PWlbHnqzb~s(NDBP zKykMO1R~?h4^{m&f`U-_HB}J4wSv$Z4GO|gP!JATL7+km3c_hC2(?pI5K2EvN|TxP z^X7>Byj^)-9Z$vY<{2WX+yNp=oIyl| zpAb_k!raEM3j)%hJxI2$a04evD|UmatDYgu?G5t4^M&)L<3axuFP`8rS9fvA&vsGyG#i7dQ*;b*6o|eSZ zwn)~wyz@i-K53tpDpt$er%OKtpFX?wLk{6!9oA{7S^Uw3{7>QW@<$Hkh-O&&#~ZSW zf_^C^F6IBf(A|WZQD|7rAbYZ!@%@<9jN|l0v3tQV{bGn2BpMbo_R~X^_Li~nf%>ah zfKQ6DGV4Pl*P|(ow9lg?NCX~5DZV9wFp5%gO9UQ8ge{{ud$&U1QIy*AY?X{iAV^11 zUW8=ghObZ6`-LrWFBV_9L)OTzOkG5~N z={$*6cE3e#I!_kHI~OUmwf~ze>9pn(Nop!GNk`RpgCYR>Rs?pQw<7QxJvwYXppG2` z0c^7%pne_%0d@DVX@Pou*u#KlOqHVA&VqpYf)E7A;3Wu1_@SoJXjTM<*a`qefYF{* zBEI9i6@lL-_!`t`76eGHAC?pTP_z@CsIp>Iqsa$Vi%?HVcC!;|uYzd zU{K_eQXNuIqVWgF*3VfTASbx`RQ{Xn^7r8&H&S1Byli6paQb zmfiqG(i@;Cmj)F5Q6ZCpqQM+92E|D^prkuP5HtcMHYn^%f2pUqp@r|-&_D}ovOVdu zg*Eeu8`?lY8!2S*sFtp5VU6NZ8!)J1?iG(=PkL6PsVSjJJmMfk!F0`7jxjSdW)1Q_^<*4R#y;FUp<;N*O-B{K}LSflDGt);Tk zDim5_{#gx{&OfWr(t0hOzpJ_3roL6%h55ViWB#rK4_K>V{^}89{-I?2TGV&D{Jc_N zrmvOjYA#EsFXo%+D|u%6?53_|DMYt-BG8TmnZ%-<3bbQ^$ZU0CWy?}TW^18&r^KQi z5IQ9m?U10I5=3Te=LA&%&U~#qb_j)&>rQ&_SeM5~r)@FEzprh_x&yqk^CUMp`iu?m zdL9fXN2gw)E)@aTY02fvulCjk1&@@uGhbSvEbg{KIdRn9+8nV$NxWI1Ed69}t>x{l z&C@!EO+IIDEgiDA)(iGlm1inV#&+0SE5F)X8_`)+M;^&R@7fxvMEtpQdiXrK0!)#r;4tzotA7WgH|XT!&WGXCQCM|V6Q|f zXAK6;r&Es=Fzoq&VVM#zBvS&0$|Ar}kpvi_X4>kNfq)^`2Mm{2r|(m>B`{ok9kS~K zMpl@mV950WLq!~5Sf&IFmw3Ca`T#~&{-t2JI6Pq02QcLOfT6ZI2D9n|7%DOWLmhT1 zIa4rPkPcd=1PoWJfRPoi27{Uw&xmtTYXM^Ae33MlSgA@KV*-DOR=- z(=WE$qbC0JGx7h&{C;!0o!fAAfqRx+1C{<5TZOWqhrOSY%cRVzq=xF2dejsMPfo&X zo_wTbo?OeMSt$N9i>6U}$X%@TXh}6nj}}<77sC%Mw`OYwawzlUg{FD(V=PBU=^0WN_%Y4#UiD{*v@E7N_%Xjt0JYt*v@55N_%Y4 z#U`c0*v@P`cKa^xMUZV|H=nMe<=VX0arIVb`-`8VqIJcFX{V@^Qe>XjTpl2E>HHP$qA+#9)ZS01Q`jR!a!1ovi)zOv>?AwR+ez?ZJ4w1@BKcnW0FolboQ!d}mp<*l zxMN-%5nWe>bPXqJsYht!b7c|yn6aIKedWkb7_@Z2 zg2Gn}(y>Nr)}6TEyVndvp0<|>OdNer8weM_6UR^Pw(BjWUJX(&wMhM%lKkJAV{4Fxjkb;TkFC9o}{;y2)D|aP%tDan|4ZfAvD$PAhnu|ch(XLuCQyC02{}>yP zb(*cj3A5EagV}EW!fYj3nC;H6UsERkTQm8Xto%2)mv%nr%rH>UD2JIg$S*&!|c%2d9x)L?d&!KP+Q7sG7n zVwFMbVkGC8*~-9_i76vf8(Fq{++ulqwXdnh>a_xSvupzAm|FM>vV}@xZlBTg*x&~-Ig>RBI>-F^f+DriavL(rVt=AdbgIB2RTAJ>^| z#XVBS@bN8U!+P123iTBr7`Pp z34i5}e#e{+C zn!`XvhYVD7V4$J{105Y0s7kCg>gd2ggsygZlY&F`xzqIY`WX9Wh&gk)zq%|%1&9)u zPqtc!`={SOll$AjaP(e?P$d**Ux*NR)~N+WG@0S{K{uIid#`Y+4u|WuPvq2ZpmhhZ zB2p%-AdtUWLD9*^9I&XMa%&f~Lz#!7yFP zSmyS_bVc-<+xK*p9x`3!rkXD4oTjT(lIbc(5w)LASBapxeNUI1)YEk{nvR?e)75Au z_rr9Ra57zWwJ}|dW^O-BH}-U6Pd64%uMLZ}0amsMK?k>Ft6#DMlora<>+D!nXv#m$ z)3YZda(&d6zj$pJ^$lP3Q?5Y?FzFiIlGzNgS;d6dG0vcuZCb_KsO8 z_-%sCOr>{OD8Nh|=Zv9t`x8~4<~-7p*Gov!0bz`0x6jw@_KYUCzw(dsmvlfFquK9= z>h^m^v)}JHZ@>R-!lyYGns$3~U%UMeMZ5ips!wwsY02v~nhpppsnyl2cwU zP!fZ}K}veWfD#)N>s>lgH-Ms&#=1rT#lEW}bpt5!T?-ol6m0|mC{ot|MWqd(xYE&i z&H)saL4cx2k#3fPqR{|FqdB+&C=e3{MWZ>o42o+pKv9{Z^|FJ_m$~?jr~_w z$a>D%U%!}U@b6vB%oy)xOGX=L5S)N*ns0G~57!O5&n;|mg9x#3?<;JD#y-q+teG$` z9kjf|QH{tuWE(mQh6Ljq6Xum8mUrp}okOb3&V+e!mk9HA<$i6J-5AzUFiK*~mlyY% zFRz~RDWuJj$2cKqa$Ifqz_{k78CR+d!Z zB5qm(dxL5QR`$feBvX_nKL3+}S!_*4;B-8bRCFTHY?6vLhgO=ONh*9=u*LpGcBJ5O zq+4rw1<7JJqqCOx4NSld+T3pPe$y7X&^gU+1B^0rg$r`Y@!YDHYkud!rO++)e4deQ=)_H)-(=I6FqGASLjWKtWFWWs1V z4M-kp$z=S9B@^u$k4k`tz7zJ8-zCkYUHLHEZ{9ntZ;@nD+>2x)KsXd=5|FSF$u4`Q z_9Y2`sC$elS~bxgCIJw6ruH{U0g-2F_mcpKJX1TPq=3jX0Ysh&AgYN4h<9BF5LL_o zBE=9uq!U*mLVg3yNM*8IHgT(T3j_%m@0-*4c`C>@?Mrb{g%Kg45t<*4ea^3I$

TQS?kl z+2HA>`oxZ1MMo+gHMq~3R8^v;1h0)cnvcYmo zN9v7VVxL%wqbPc&qX|TqfNEWcT{QtNKv!Q@O(60F7$IT;+&#*^te${M$O>LH0o0c{ z0qq`D5~m4p(YlVc(*!h@k~mKQ51y6Y{?v;Ly8BZvR*JbnJ~?syvY5)g?q8O z@OeBgWUkQkMtX&u_4dyIzu7V!+O!W?_uKiI@_swnh~{^jz5OVlT`CL}C`}R4C=Z8a zpuEn*7LPBeP5_CNUsb!ZjB-nsF@8ywfyb--YNjK@IK3ppV5Jj=foNZbQHf<3Cl*yE zfH8f9mI2MlGRke{S9q4H6Tq01Usb!xugWdvSFmJu5T-FHznbYNzdGGyegzNV-ep>j z@~cYB{0f%CvleMNU&n?Kj;8!-x~;<&3k&QVOVd?;RqZmrD!2L+57>FU#F6pL$GKn>tSWl*lEVe7ij`Yn<3Q?uUbz;QqLb-EhOpWl001Ffz<~n!|xLbG?*A~ zBmrD&_Gyr+Ool%WqKR#jxvuQ}_~v>xTy;c`iq$;o{4nKavM| zy(yC4a(T1vhh-Cp0xL1T5SI$~t}&9DYU(V8v5Ra&#IQ(_R3%mzMf!**70n zY#GSl9c%>T`S43nfsE#(N00gFv12}b=89xAA4MgKWHcW>Wq#L&`RMWLyH@kzX#B1X z^U+L zL#wIO{ePU&fA@~3QuqF&@bf+2#h%XJ4L_%F%8Z~N!Z1HTe}-u2(6QV;(S zKi`A@AN&`8^upMW4)HhWo{!^zP*=kLpXSd`PT=2E3Z*8!&bOnzt$qfiKGXMertfDo zGhcttr}}=zx~%oru?=$k+Ec)HO?F3fU9%H>&9RoyZ+2}^k=j^Joi7_YusntZ#-ZeHI5l4jc1K>#=7yU z@tX0v@kYS^ZOFLCxYxMPxZildIBFa-P8!b|=ZtmZRpT||b>oeI|ND?}k8y9n|05gl z|FVAnZ@>Oe_J`O1={{p}eZbeF#xdih@vL#qST|lZUNc@d-U#^r4jK0t_Zs&Z_Ztrw zM~!2~N#j}LoUv}aYP@E=ZoCoj{~I#yG43_)GwwIq&U%?}{r0GF%s6R08}R0kaCa)a zZ}&a*aDC5J<2B=Ti-O?*8y{c>TjG##Li4 z;78KNj4^8*HjWr`#=J2ymW;E;d1Gu`Hm(>~jlF;$O&c@DY`~B03HWi#nHdS!nVd0i zjEp7Yta08L8<&kM##Li4;3v|?j4>PVlTpA=j~H{tyfOKG$=9>Sd1Gu`Hm(>~jlF=M zNgFf9tZ~>lV$2!y#>jXz;OF)R{N-8WyfHQ|8&{00#$LeBr;Qn7);Me&G3JbUV`MBD zXN~g#zu>?7QXH;?Qr+L$qBjl%)I83p{7|L!qg zKUNB_KQ?QeH^#v#A#F#VYjghfroHfoHrbtO>!((Yy@3Bh+L$qB zjl;$fW6qcl_&4m2`~5lgYkvLLqVW4)D;Z~v^Tyb?Y+Ny}8hZi%X4;rBW{tzf5o6An zH%7*ian?9*jE&3272~S07w}(78#Bg{fWPj)|J%86{kQYR$XGJY8t08y1OA3T|G)3o zzwi5fe>wdA`zyv(V=v&pk~U_HS>v#A#F#VYjghfroHfoHW8<=M#kgwh1^mslF=Nac zhm9k~oH1{Vj3wi2z<<@hKd>CG|89aSzFsx<0zPg0?R2>Q?Tj&N95#*^bH=b_^&58 z?CTL@F5qZ_d0$7yl5y5JZ;Xx0#uekLu@~@1X=BEiH4Ym`j5%Z87#T~(S>wDhHZB`i zjH||8z~|D&j4^8*HjWr`#=J2ymID6$1ZRCcZ;S)Jkl?bfSB$I1UciHCW5$>@4jV^| zIb+@!8B4}ljtHxfy7t_X!F>4$)ju>;syfHGCjI+jhV{BYDt{7JXjwRR& z*N4-_Ou!=vW_>+u95LpMd1GWO8E1|2#@M)QTrsX1djXH8jTvLsIBXm-=8Sn`WGoqH zjq}FXxNKZ8t{Qs*kEM+nW7arq90^!RFz4&MF$(xbf+b(i8t09%aoM$k+Ec)HO>b- zonY+iW#dY~GYPKxx)-pVHfD@j$k+Ec)HO?Djj2FCF87d-WVH~jVs1gV=v%L+L$qBjl;$fW6qcl z`0phc`MPAB4fr1$k+Ec)HO?Dj<8r|NFu@gHuNr#+=ZzQA;rc?xm^BU?M~pdR z-WVB6##!UMF*Yt6SB$I1Ucf&}8#BhNao9Lw%o+2>$XGJY8t09%aoM$XE*4NpRNJ^Ts&ff0E#`uUCw##$LexG;Pcn zv&LcLh%sl(8zW=MIBT3Y#>QpiigDH03;3U+50Th%sl(8zW=MIBT3Y#>QpiigDH03;18AjTvLsIBXm- z=8Sn`WGoqHjq}FXxNKZ8t{Qs*|EshyW6TjCo^Z zEE#8w^8r^9jD5XqTnYH!C%EeCUcmn$ZOj<6#$n@#F=xyhBV)-pYn(U6#%1G*an;xh z_&=tN8DrKsY#cG>jCo^ZEE#8w^Tyb?Y+Ny}8hZi%r*y#oIl+vtv&P|o|2V-BU+0W@ zV`MBDXN~j5*tl$5F|HbW0aw$;j4^8*HjWr`#=J2ymW;E;d1Gu`Hm(>~jlF<>mNsUL zS>v#A#F#VY1OA^0M!qf?X9NC|1m}Gn8<&kM##Li4;Qy00W{g?muyMqgGvlV$2!y#>iMQ&Kl>9v2oeBVq7)$0^XB0W{g?muyMqgGvjtHxfyhttN4F>4$) zju>;syfHGCjI+jhV{BYDt{7L1y@2VoF=Nachm9k~oH1{VjHQ6@PjJ@P^Ts&fo&=YD zy<%K7_5yw=ZOj<6#$n@#F=xyhBV)-pYn(U6#%1G*an;xh_~EoMW6Tj2F zCF87d-WVH~jVs30fWMevFI;~-ZOjDxWP({=4;x2}Ib+@!8B4}ljtHxfy zPo<3+W7arq95LpMd1GWO8E1|2#@M)QTrsX1djUV4HfD@jU zlCNit^Tyb?Y+Ny}8hZi1ls0CJS>v#A#F#VYjghfroHfoHW8<=M#kgwh1^jZ_m@#IJ z!^RO~&X_kw#*%T?I3Mt<3C6x&Hm(Hx#z??#t{Qs*_oa;)W7arq^xy5v`8scmj3wi& zao!jkmyIjNRbwyUx6;OpF>4$)ju>;syfHGCjI+jhV{BYDt{7L1y?~F^13sQMW{g?m zuyG{dcm2L6^5Ob>2}Zsy8E1|2#@M)QTrsX1djX$J8#BhNao9Lw%o+2>$XGJY8t09% zaoM;)p*T#-FPG5fg$4_<6h%F<9_1-yG9Ise@c>f!naSB=+;fIrL!{Cjc0XZ`xKH^TM5F=X6h+-uxt+;2Q! z95s#^Cyi%~bH=*ys_~lfy75N9QD6V~K)C)l_Zjyalh;RmJ!YIVo;A)H>&C0bYsTxw z8v%c3$hgP2*SIg>?^ylT8=yl%V^@P#4c9^+o) zKI4Al0pqA~%s3hFMgRRFUmv;}UO#lrc-?p-;LAfs|J}=beZ9}P-*~_{Y8*3820ZNV zg;%V%SN!@bXT$GbnKRanSB=+<*Nryr4$87GZrjdRAj@v8Bf z@w)Lwz#~HekL?Ti+FoOFz2DadjHAXejFZN*#yMl%c-45#c-?p-;2T56J;uGpea8L91IAI~m~k@TPT-Kxdb?V& z-Y+LBA#L(DLuLYpgiqSU;R^|0h^YPlZ`Zj~edcyo-ob8);G$KS>A4{`is z9KVm_4{`i4jz7oo&vE=Uj(>^cU*q_<*7(npaXb>ob8);G$KS>A4{`is9KVm_4{`i4 zjz7oo&vE>>Y8)@eaV?GyK+~-^B54Yy9`cIIhO=avay<_%M!-;`lg@PvZD2j?d%x zB91TP_&Sci#qmuX-?qm8Sd8Op952UlEshW4_$ZE#fC0jj*}AmPz&+@syNF9!8WwE3Saw@T(V z$(U`qSpa5>Jy=^C1z@(=#E%;VTtfTlR&(@X1zQk!Y(e0$<+i_rjgfnJoNQTO=e5ka zJ^c>ycl#c;+hFlN;txHAJbDXx>@MuFWeL7>^ZskMi0|E!N1H`__YQlsBE|Rbh(~Ku zdmQg9@`;!bS0ZC zyv?bBoqF>Ad)mrkvIw2LjJ>o|FE73Fd-Tk*{jlD0L+#|f^eRl_J3ou>{Cs(xy@BsL zueI0QA%7KdjxBG>YwqXnn7@ec`+0oddF?&pKJlj!=bs?XR}tsf8>+kxAH#L{sQbbn z!FBip#Q7n_`Let2mk{UJ5(lyVEn@vUkG-K_g*C+bea8CCrnh-0dtgfz_Gi>v5pm;* z?OPGSFC}HbFW46NG`3_p8{n5+?Adi6?Q`IlP|R+$@ku8?9mX|cr}6S7*sU&J4)n1T z#+&XC3-#Ml^%e{4!pkkD_5N+fM~Wv8IzKL>BQx$#wipq8C@V%RcKcUE`B-)3W`|4A zC+?xr1e;vROJWY-{5Dx=V-|<%NwB>+uRYq94~dI-gsB@ z%h$NK>&m-R>)z(Ib$`&ay>`Gv$FZHt33QU}g^x88ajUBv*s_p28Pvwt)Osk;xl;7I zDQGCY^0AJuPjNPq`>CON&*+mW^rr5WQ?*anyI$^D4jg|TG`^g9rMNETNotPR(xs#3 zsJZS`nFDBPZM=G8E14=6kmHoXX5uyLmNsdlwUo(8Yus>$8}HORxaIF`x#e#o zeoR=CugmhLe!kW!bL@5-x_p~fx#;}9c@L%U<@n_`?t|`N%VqA=RPym6>^HfUZ`Ay< zi0^{v!CK$z#xJzb1%DiQkCqkJb#ku^9E^ z3pjIM#CPm zP9min@pC&|?*7BPwAN=6E}VW460fclKJ!R;a;0d@gPITb`tgUTqmi6?Q--?Y4_7&L zt(k3Og1HSpvd2Od4>uO#218Bxg*%W+&Qt4q+xU2HBNW(SEqGQqwQBTo45MxSFdGztpVz5^-bg-Btn4kwPlH` z19ePAvD)w4XjSyyrhe!C@}l>O-}gO#?l<0Cd7yZ*==ERPxUQHA>V1SuZ(v;Xw(HLqb_mCi<9<>4&l4^q=e_}Uc<@r`(LNrEl)OmJ=Y1VkU3^cf zJoysxnB(h>dFH6Ugtd~;DDgeeI-us{I-cq2vrcYcouJJv<-kUEYsgVY1AH2FXRQWm zey-!FuX>5MN$AcC8)dwWL#yH1aO%!Ee%A4}id-kx>h0_Ig8j#FU7Wxw5Y~|9I9A(# z6`9IY$W#uTPY2DPv!d&1{Zexx*DrG|x9FE#$K8n&xqeylvE)Rqh!CBM+{5+DT%3*g49e;X&GOpg-B>>7amkr)XL)#GJh|KFGgq5qv}>qK>4`NK*8RSJ zKipU5_~jb%06p=`!aC|oH*5K24z*hBH9%ci>wlg2MQryOYPBS9u6bGe;u~le>@`4L zx$Pce9P8C=Zk2A@*lsnvHivT``xH=b*1BUSUSsy0@%9-i%OrcQd0EHXHvv9H-idm1 z+x^)%^yX!kjkmr&Cu4^_=h409&G}S!tKkr)#^Wdafoo&FQIKa|9=x zE_yEe47HTHV(J&HMYTCyLywxR`KGBJhO4HgO;QeOnzrQ_t5a=E7|Wi7!5_ z`h^bY)nz}W^mErK&NZKV@u~6RfO%2#WA1Uqd@CEi`h29;^E9*WhF91( zRB8hB^|+ezG%elH1y-SE&Z5%(Ix-Qcv}Edh<==l zH}XRhoaocZ0K3JUIyKq_5RhoJIZkCC*>0TLm_KuTx$+JiR_Om@{oOB$&oo!E zKRN3k>vTxXXIx{<_1tD1AqrwoR$dMMz3wn&3Np^0{~0^zb1+N}IBs^GnK) znwvZLWzO`*9IuVq-&0*m^9uXJOWwBPyd~$~+iMaHM)S&d(8?wMSn=jH5HOd{89^D5T|QUC1OUOn;?`|yiqtaU!kPv>#n z;+iVvxV6rgi!t~y6pLGW@lN7vU%Y-7cHPFC8J^^hHj-h@5hGVObHxlZtm&0n>g2d` zX4ro0^B;KsJi&TH+24o^J4`?J`471NV}3fvt=uz6^3$4IS(_<+@_C;$Og~Ne za@cs#<~w{0zt4R(lw8;^o=sR}M}5fc^?S>6`^~V87Yb_|o`m zpYz;))3}W<_fYTJZ+v9)*&PoL1p^G3CTcbvA`UjbZ0~`T$&VY07>^$C7%;vxzLcDD z-}A|%#;}H@ooQoYJ6#YX?!_IUK_S!8($h<8ebY;_Mb(J??%t2#+SyI#+Sp!c!Qj;@ul&l z@ul(Q=&_LTZU230d}(}Xd^t#78@6K`Um9N;Um9QbpGA!CM$e|km&TXIm&3+*gPgDN zrSYZlrSawHv5@g?|9xtFX?$sXIY?d`wqqM#8ebY;8ejIGMU3x8&!)zg#+SyI!^U`n zoUiev@ul&l@#W~TknwH*eQJDZd}(|+NM0MZV;f%@Um9N;U-q9xjPFLzrpA}Xm&TXF z#(0CAukoevrSYZl<>;}H@ooQoYJ52`zC7(d@%%aKR{dx0q(ARY_>1nC|J;4#zi>zV zW%q%<>JIs9ZpB}BOa6vi@VDHY|HjSw@7%P%<0k!GH{tKOF<(q?xKI1Yi3e=t0R0J{a)Ex>L8b_=jufZYP@ z7GSpkyVd#=b}Ri^Y_TSpE7)Tv?0GQlu~hhg@9UVm>nGf8KjpslGx)yFx|@F9eeDuesoh@nD}SYk_^_t3Hw_BV9-P zb)54h+P@5lK%DbG4~W2k2n>ioob%5FL?Bpz*YH(b!#@s)z<>zEHT-Bm1O`N4Km_6% zz8nyN0TCDwfw+dx1Vms!1mYS#9uR?n5s2$S`_J^cE7BkRclEdz23$kLmkhYH?%u=m zv;2bjwD<+{DJEQFe)$MzhNk=?pZhDE89K3YWv5B_#O77rTQsm&W1fN^8}pR#G3M2g zkE{5i9~all_?p1=wpTt*<7*$hzO*am-!rGCb~WA{G2UDW9#P%?|A2p)eg&>v!+l^c zTuH*Zg!{mhu+HK>PzdXkKhs87A3<|S32OzKLrPe)&>V!YCZIXA2!Re<0OrQA|y$8)%277bZ+yEZY(-uuknR>h0>49E!|jianbzW zYd@cH=RW7oxd)LK@8G^jbjVxC8{EM8MRdrk$Qw|H6kfcD`)*O>$cv|O{{IxUETn*w z$WfiZ`GtxcdGQGH2BOH3fr^81#K>@WaJMF!>MdjyZs6N4n(Ea6t3p#1hP#NnU{RUK zaHnxKp~^%$IEgIL34GhBGLhkqAgdrM6B$kuKRuW#$vF?E#7_^3rdsF0B`7DNscPaM zgTjO>#LNSmQ7<-9l+OrBRrg$kq?FGH5goEFLYAPDhz_YKe+)Vtt_SeiZh5fZe3_e% z=AgqkPf32WDF=Ot^Hd`anq7Bx{C0kU{i{4_Q+|Q{tGu_?^)w%s`~v$Ivn}12{4#~> z*EBL2%zNkjavaw$$$RVj7tO~yF22S$TWT!Gdp3tTWYtPLR164TRJnA`xH?AQiz=6% zV_Y30@I_S{!5A^#e9yeOAbKPD@jHC~m?;!~WHy(1Y|_VNoR?F6Jdf`mGrGc$#r}M! zgyX(LL^E3`9LG!{bK|^9U&dK4<+$^RXl4tAlZWMQS9^TXkMmpla4x<+#PyeTpS&;1#n%PsH$(j1J^Kna zDQh};ucA3r`wBKOzHC~@x_lq`3*jE}A!{5{J}mn440xP5Q|fKxG}bSsoQ7+rnnyQI zWz`|`;?z0GsjNB_PG!|$s&lgHP*gJV7c-qHSFq|(_={DCk-x@~6}LGhoZ8h+%Ddet zob`Ilh*M1^g|l8yD4g|rshY}qJ<-a@U(B#Jidu7i?z!`#X`V(P)!c%x4jH@C$bR~d*V+$r7$@Vad_WGy<^9#JpV z_Y}gZIKLe1bu%+haV}wPqv(yAC%Jk=^hQ}dl5!j~oy=Fu>JiCT%jyy4tA*oO+bBAk ztRA7#BCAIVn@y=PcCZc35UgSB#N=FMA=;^|vPh|o*-hraWtD~Gz-5&MbKpX4tYH+@ zOjcP?t&&w1Ix4!+J=YXkRI3x!#;wV~(?KBFDh>=F9U6x;#kyGPZZfeFkUe9Mm7kzbSJvC&t%t{LpJnKIbdI{9 ztd$XcQYz=t)yT}t3Qw~3QFKA6oD-gu$~oal);<=ab(F|;%!G>8DphOg>RDz(h3ilzF9OAY7KFRV-L)h{XM(=V(`P5qK`J}VlTFRx=+R5VUwZH3J# zuBOl0sfPR+A*_DwH9}JIXN0i&HI0yz{8`t?e0d%DqplIY1Cy`3YyW@XzvTF6;C~-- zzRcN=IZLh2Xue^enqC=F^9_3G-gUcp?7*_NKnK1ZS_H;o_mIbzKx_2e8Mr}1-uk6kh!dnCc;xa!|-91rY~BzmvD zU()=V#>2kj%SEo2>9uc9-KyDQf4l=c+H23Bx-KZ_S)%OFjh*Z4um_!dCb53O=GA-W zqn5o?By=PCx=7fAemIy{H!@fKo0f{beRix1kX7<2XR1Cvm`RRz_Wj>SoHw=o$%O2a zDcWTl`z)`!KK#Ax*(iEnoBo3LFUDH=O3gFu+sHL6%va`kSn~{fgo z-qag-m@pau-B*Pu=>76`=#%Ex-9EyM3a;{#bRfF!6(+eWLOtjOv!qb z^f;aRPs+NTz3mfJj6q|wdG*{YDB7#W!=1W!$_k~u?H0s&rF7q?-azwVxZXAC6WOQ! zKCpo1myvsX!1y!gKh1LN_s-f;=5Bjtl7&sT58tPaXV~+c^`)%$OZA_wJcG|wOt$iu z^5&Y;G!68`!PlH1=c{y;1YC<}~(X z=Nca7%QdHIe%A5E9{a2>?HX_N>C%?|tmBRSxa59~@wSK0?PwqNtY_^g?=NT{oL{=v zi_TETll3`i{~yVL%lhpm{eL6}F6&~_{y%jqR|}g(wMGcGh(xD*2T6`y)|@x#9V9t+ zS?!Yc4$_@rSU1_t``zvWa=nAPbqkHXgJz3^eROC9ojOEydFJwYYM+LWod=AN~r)MG1cZEoEifa8_*f7G2c&%mDLdKu| zkJB@QrCMUkr`$J)YoF-H6Xm`U+%tl`KiKz!`$TY$h|+Fj4?6If?$4r{dm<`@n3{1>mJ^j{?bCYkJoBAJD{x|-Q&W--Vv{&W-&;>v#9B82>l^{(FpnAAi4y@d|(ce}onTI{*Lx diff --git a/wpgsd.Rcheck/vign_test/wpgsd/man/find_astar.Rd b/wpgsd.Rcheck/vign_test/wpgsd/man/find_astar.Rd deleted file mode 100644 index 0a922b5..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/man/find_astar.Rd +++ /dev/null @@ -1,78 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/find_astar.R -\name{find_astar} -\alias{find_astar} -\title{Utility function for root-finding to compute crossing probabilities -with the overall alpha spending approach} -\usage{ -find_astar( - a, - alpha_prev = NULL, - astar, - w, - sig, - maxpts = 50000, - abseps = 1e-05, - ... -) -} -\arguments{ -\item{a}{Cumulative overall alpha spending up to current analysis.} - -\item{alpha_prev}{alpha boundary at previous interim analyses using -the WPGSD approach.} - -\item{astar}{Total nominal alpha level at current analysis from -the WPGSD approach.} - -\item{w}{Vector of alpha weights at current analysis.} - -\item{sig}{Correlation matrix of previous and current analyses test statistics.} - -\item{maxpts}{GenzBretz function maximum number of function values as integer.} - -\item{abseps}{GenzBretz function absolute error tolerance.} - -\item{...}{Additional arguments.} -} -\value{ -Difference. Should be 0 with \code{a} and \code{astar} identified. -} -\description{ -Utility function for root-finding to compute crossing probabilities -with the overall alpha spending approach -} -\examples{ -# Input event count of intersection of paired hypotheses - Table 2 -my_event <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160, - 3, 3, 1, 165, - 1, 2, 1, 85, - 1, 3, 1, 85, - 2, 3, 1, 85, - 1, 1, 2, 305, - 2, 2, 2, 320, - 3, 3, 2, 335, - 1, 2, 2, 170, - 1, 3, 2, 170, - 2, 3, 2, 170 -) - -# Generate correlation from events -my_corr <- generate_corr(my_event) - -# Find the inflation factor for H1, H2 at analysis 1 -find_astar( - a = 0.0008708433, - alpha_prev = NULL, - aprime = c(0.0004588644, 0.0004119789), - astar = 1, - w = c(0.5, 0.5), - sig = my_corr[ - colnames(my_corr) \%in\% c("H1_A1", "H2_A1"), - colnames(my_corr) \%in\% c("H1_A1", "H2_A1") - ] -) -} diff --git a/wpgsd.Rcheck/vign_test/wpgsd/man/find_xi.Rd b/wpgsd.Rcheck/vign_test/wpgsd/man/find_xi.Rd deleted file mode 100644 index 0e33534..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/man/find_xi.Rd +++ /dev/null @@ -1,75 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/find_xi.R -\name{find_xi} -\alias{find_xi} -\title{Utility function for root-finding to compute inflation factor xi -with the separate alpha spending approach} -\usage{ -find_xi( - a, - alpha_prev = NULL, - aprime, - xi, - sig, - maxpts = 50000, - abseps = 1e-05, - ... -) -} -\arguments{ -\item{a}{Sum of cumulative alpha spending from the Bonferroni approach.} - -\item{alpha_prev}{alpha boundary at previous interim analyses using the MTP approach.} - -\item{aprime}{Nominal alpha boundary from the Bonferroni approach.} - -\item{xi}{Inflation factor.} - -\item{sig}{Correlation matrix of previous and current analyses test statistics.} - -\item{maxpts}{GenzBretz function maximum number of function values as integer.} - -\item{abseps}{GenzBretz function absolute error tolerance.} - -\item{...}{Additional arguments.} -} -\value{ -Difference. Should be 0 with \code{xi} identified. -} -\description{ -Utility function for root-finding to compute inflation factor xi -with the separate alpha spending approach -} -\examples{ -# Input event count of intersection of paired hypotheses - Table 2 -my_event <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160, - 3, 3, 1, 165, - 1, 2, 1, 85, - 1, 3, 1, 85, - 2, 3, 1, 85, - 1, 1, 2, 305, - 2, 2, 2, 320, - 3, 3, 2, 335, - 1, 2, 2, 170, - 1, 3, 2, 170, - 2, 3, 2, 170 -) - -# Generate correlation from events -my_corr <- generate_corr(my_event) - -# Find the inflation factor for H1, H2 at analysis 1 -find_xi( - a = 0.0008708433, - alpha_prev = NULL, - aprime = c(0.0004588644, 0.0004119789), - xi = 1, - sig = my_corr[ - colnames(my_corr) \%in\% c("H1_A1", "H2_A1"), - colnames(my_corr) \%in\% c("H1_A1", "H2_A1") - ] -) -} diff --git a/wpgsd.Rcheck/vign_test/wpgsd/man/generate_bounds.Rd b/wpgsd.Rcheck/vign_test/wpgsd/man/generate_bounds.Rd deleted file mode 100644 index 53c1660..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/man/generate_bounds.Rd +++ /dev/null @@ -1,135 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/generate_bounds.R -\name{generate_bounds} -\alias{generate_bounds} -\title{Compute p-value boundaries of the parametric MTP method with overall -alpha spending for all hypotheses} -\usage{ -generate_bounds( - type = 1, - k = 2, - w = w, - m = m, - corr = corr, - alpha = 0.025, - cum_alpha = NULL, - maxpts = 50000, - abseps = 1e-05, - tol = 1e-10, - sf = gsDesign::sfHSD, - sfparm = -4, - t = c(0.5, 1), - ... -) -} -\arguments{ -\item{type}{Boundary type. -\itemize{ -\item \code{0} = Bonferroni. Separate alpha spending for each hypotheses. -\item \code{1} = Fixed alpha spending for all hypotheses. Method 3a in the manuscript. -\item \code{2} = Overall alpha spending for all hypotheses. Method 3b in the manuscript. -\item \code{3} = Separate alpha spending for each hypotheses. Method 3c in the manuscript. -}} - -\item{k}{Number of analyses up to the current analysis.} - -\item{w}{Initial weights.} - -\item{m}{Transition matrix.} - -\item{corr}{Correlation matrix of all test statistics up to the -current analysis. dim = k * length(w).} - -\item{alpha}{Overall alpha.} - -\item{cum_alpha}{Cumulative alpha spent at each analysis. -Only required for \code{type = 1}.} - -\item{maxpts}{GenzBretz function maximum number of function values -as integer.} - -\item{abseps}{GenzBretz function absolute error tolerance.} - -\item{tol}{Find root tolerance.} - -\item{sf}{A list of alpha spending functions to spend alpha for -each hypotheses. -\itemize{ -\item If \code{type = 0} or \code{3} then length equals to number of hypotheses. -\item If \code{type = 1} then \code{sf} is not needed. -\item If \code{type = 2} then only the first component is used. -}} - -\item{sfparm}{A list of parameters to be supplied to sfs. -\itemize{ -\item If \code{type = 0} or \code{3} then length equals to number of hypotheses. -\item If \code{type = 1} then \code{sfparm} is not needed. -\item If \code{type = 2} then only the first component is used. -}} - -\item{t}{A list of information fraction used for alpha spending, -may be different from the actual information fraction. -Each component corresponds to a hypothesis. -\itemize{ -\item If \code{type = 0} or \code{3} then length equals to number of hypotheses. -\item If \code{type = 1} then \code{t} is not needed. -\item If \code{type = 2} then only the first component is used. -}} - -\item{...}{Additional arguments.} -} -\value{ -A tibble with \code{k * (2^(n_hypotheses - 1))} rows of -p-value boundaries. Inflation factor is also provided if \code{type = 3}. -} -\description{ -Compute p-value boundaries of the parametric MTP method with overall -alpha spending for all hypotheses -} -\examples{ -# Build the transition matrix -m <- matrix(c( - 0, 0.5, 0.5, - 0.5, 0, 0.5, - 0.5, 0.5, 0 -), nrow = 3, byrow = TRUE) - -# Initialize weights -w <- c(1 / 3, 1 / 3, 1 / 3) - -# Input information fraction -IF_IA <- c(155 / 305, 160 / 320, 165 / 335) - -# Input event count of intersection of paired hypotheses - Table 2 -event <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160, - 3, 3, 1, 165, - 1, 2, 1, 85, - 1, 3, 1, 85, - 2, 3, 1, 85, - 1, 1, 2, 305, - 2, 2, 2, 320, - 3, 3, 2, 335, - 1, 2, 2, 170, - 1, 3, 2, 170, - 2, 3, 2, 170 -) - -# Generate correlation from events -gs_corr <- generate_corr(event) - -# Generate bounds -generate_bounds( - type = 3, - k = 2, - w = w, - m = m, - corr = gs_corr, - alpha = 0.025, - sf = list(gsDesign::sfLDOF, gsDesign::sfLDOF, gsDesign::sfLDOF), - sfparm = list(0, 0, 0), - t = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[3], 1)) -) -} diff --git a/wpgsd.Rcheck/vign_test/wpgsd/man/generate_corr.Rd b/wpgsd.Rcheck/vign_test/wpgsd/man/generate_corr.Rd deleted file mode 100644 index 4a139c9..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/man/generate_corr.Rd +++ /dev/null @@ -1,50 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/generate_corr.R -\name{generate_corr} -\alias{generate_corr} -\title{Generate correlation matrix based on event counts} -\usage{ -generate_corr(event) -} -\arguments{ -\item{event}{Event count of each hypothesis at each analysis, including -event count of the intersection of hypotheses. -It contains 4 columns: \code{H1}, \code{H2}, \code{Analysis}, \code{Event}. -\code{H1} needs to be listed as 1, 2, 3, etc. as numbers.} -} -\value{ -A correlation matrix. -} -\description{ -Generate correlation matrix based on event counts -} -\examples{ -# Build the transition matrix -m <- matrix(c( - 0, 0.5, 0.5, - 0.5, 0, 0.5, - 0.5, 0.5, 0 -), nrow = 3, byrow = TRUE) -# initialize weights -w <- c(1 / 3, 1 / 3, 1 / 3) - -# Input event count of intersection of paired hypotheses - Table 2 -event <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160, - 3, 3, 1, 165, - 1, 2, 1, 85, - 1, 3, 1, 85, - 2, 3, 1, 85, - 1, 1, 2, 305, - 2, 2, 2, 320, - 3, 3, 2, 335, - 1, 2, 2, 170, - 1, 3, 2, 170, - 2, 3, 2, 170 -) - -# Generate correlation from events -gs_corr <- generate_corr(event) -} diff --git a/wpgsd.Rcheck/vign_test/wpgsd/man/generate_event_table.Rd b/wpgsd.Rcheck/vign_test/wpgsd/man/generate_event_table.Rd deleted file mode 100644 index 3b355c4..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/man/generate_event_table.Rd +++ /dev/null @@ -1,58 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/generate_event_table.R -\name{generate_event_table} -\alias{generate_event_table} -\title{Generate table of event counts from ADSL and ADTTE datasets} -\usage{ -generate_event_table(paths, h_select, adsl_name, adtte_name, key_var, cnsr_var) -} -\arguments{ -\item{paths}{A vector of paths for analysis datasets. -Length should be equal to the number of analyses completed.} - -\item{h_select}{Selection criterion for each hypothesis. -Should be a tibble containing 2 columns: \code{Hypothesis} and \code{Crit}.} - -\item{adsl_name}{SAS dataset name for subject-level analysis data. -Usually it is \code{"adsl"}.} - -\item{adtte_name}{SAS dataset name for time-to-event analysis data. -Usually it is \code{"adtte"}.} - -\item{key_var}{Key variable to join the \code{adsl} and \code{adtte} datasets. -For example, \code{"USUBJID"} or \code{"SUBJID"}.} - -\item{cnsr_var}{Variable to indicate censoring (\code{1} = censor; \code{0} = event). -For example, \code{"CNSR"}.} -} -\value{ -A list with two components: -\itemize{ -\item \code{event}: an event count table as input for \code{\link[=generate_bounds]{generate_bounds()}}. -\item \code{dsets}: analysis datasets of each hypothesis. -} -} -\description{ -Generate table of event counts from ADSL and ADTTE datasets -} -\examples{ -library(dplyr) - -paths <- system.file("extdata/", package = "wpgsd") - -# Selection criteria for each hypothesis -h_select <- tibble::tribble( - ~Hypothesis, ~Crit, - 1, "PARAMCD == 'OS' & TRT01P \%in\% c('Xanomeline High Dose', 'Placebo')", - 2, "PARAMCD == 'OS' & TRT01P \%in\% c('Xanomeline Low Dose', 'Placebo')" -) - -event <- generate_event_table(paths, h_select, - adsl_name = "adsl", adtte_name = "adtte", - key_var = "USUBJID", cnsr_var = "CNSR" -)$event - -event \%>\% - gt::gt() \%>\% - gt::tab_header(title = "Event Count - Computed from SAS Datasets Example") -} diff --git a/wpgsd.Rcheck/vign_test/wpgsd/man/tidyeval.Rd b/wpgsd.Rcheck/vign_test/wpgsd/man/tidyeval.Rd deleted file mode 100644 index f773abf..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/man/tidyeval.Rd +++ /dev/null @@ -1,98 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils-tidy-eval.R -\name{tidyeval} -\alias{tidyeval} -\alias{enquo} -\alias{enquos} -\alias{.data} -\alias{:=} -\alias{as_name} -\alias{as_label} -\title{Tidy eval helpers} -\description{ -This page lists the tidy eval tools reexported in this package from -rlang. To learn about using tidy eval in scripts and packages at a -high level, see the \href{https://dplyr.tidyverse.org/articles/programming.html}{dplyr programming vignette} -and the \href{https://ggplot2.tidyverse.org/articles/ggplot2-in-packages.html}{ggplot2 in packages vignette}. -The \href{https://adv-r.hadley.nz/metaprogramming.html}{Metaprogramming section} of \href{https://adv-r.hadley.nz}{Advanced R} may also be useful for a deeper dive. -\itemize{ -\item The tidy eval operators \verb{\{\{}, \verb{!!}, and \verb{!!!} are syntactic -constructs which are specially interpreted by tidy eval functions. -You will mostly need \verb{\{\{}, as \verb{!!} and \verb{!!!} are more advanced -operators which you should not have to use in simple cases. - -The curly-curly operator \verb{\{\{} allows you to tunnel data-variables -passed from function arguments inside other tidy eval functions. -\verb{\{\{} is designed for individual arguments. To pass multiple -arguments contained in dots, use \code{...} in the normal way. - -\if{html}{\out{

}} -\item \code{\link[=enquo]{enquo()}} and \code{\link[=enquos]{enquos()}} delay the execution of one or several -function arguments. The former returns a single expression, the -latter returns a list of expressions. Once defused, expressions -will no longer evaluate on their own. They must be injected back -into an evaluation context with \verb{!!} (for a single expression) and -\verb{!!!} (for a list of expressions). - -\if{html}{\out{
}}\preformatted{my_function <- function(data, var, ...) \{ - # Defuse - var <- enquo(var) - dots <- enquos(...) - - # Inject - data \%>\% - group_by(!!!dots) \%>\% - summarise(mean = mean(!!var)) -\} -}\if{html}{\out{
}} - -In this simple case, the code is equivalent to the usage of \verb{\{\{} -and \code{...} above. Defusing with \code{enquo()} or \code{enquos()} is only -needed in more complex cases, for instance if you need to inspect -or modify the expressions in some way. -\item The \code{.data} pronoun is an object that represents the current -slice of data. If you have a variable name in a string, use the -\code{.data} pronoun to subset that variable with \code{[[}. - -\if{html}{\out{
}}\preformatted{my_var <- "disp" -mtcars \%>\% summarise(mean = mean(.data[[my_var]])) -}\if{html}{\out{
}} -\item Another tidy eval operator is \verb{:=}. It makes it possible to use -glue and curly-curly syntax on the LHS of \code{=}. For technical -reasons, the R language doesn't support complex expressions on -the left of \code{=}, so we use \verb{:=} as a workaround. - -\if{html}{\out{
}}\preformatted{my_function <- function(data, var, suffix = "foo") \{ - # Use `\{\{` to tunnel function arguments and the usual glue - # operator `\{` to interpolate plain strings. - data \%>\% - summarise("\{\{ var \}\}_mean_\{suffix\}" := mean(\{\{ var \}\})) -\} -}\if{html}{\out{
}} -\item Many tidy eval functions like \code{dplyr::mutate()} or -\code{dplyr::summarise()} give an automatic name to unnamed inputs. If -you need to create the same sort of automatic names by yourself, -use \code{as_label()}. For instance, the glue-tunnelling syntax above -can be reproduced manually with: - -\if{html}{\out{
}}\preformatted{my_function <- function(data, var, suffix = "foo") \{ - var <- enquo(var) - prefix <- as_label(var) - data \%>\% - summarise("\{prefix\}_mean_\{suffix\}" := mean(!!var)) -\} -}\if{html}{\out{
}} - -Expressions defused with \code{enquo()} (or tunnelled with \verb{\{\{}) need -not be simple column names, they can be arbitrarily complex. -\code{as_label()} handles those cases gracefully. If your code assumes -a simple column name, use \code{as_name()} instead. This is safer -because it throws an error if the input is not a name as expected. -} -} -\keyword{internal} diff --git a/wpgsd.Rcheck/vign_test/wpgsd/man/wpgsd-package.Rd b/wpgsd.Rcheck/vign_test/wpgsd/man/wpgsd-package.Rd deleted file mode 100644 index bc49567..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/man/wpgsd-package.Rd +++ /dev/null @@ -1,41 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wpgsd-package.R -\docType{package} -\name{wpgsd-package} -\alias{wpgsd} -\alias{wpgsd-package} -\title{wpgsd: Weighted Parametric Group Sequential Design} -\description{ -\if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} - -Adjusted inference for weighted parametric group sequential design. Weighted parametric group sequential design (WPGSD) by Anderson et al. (2022) \doi{10.1002/bimj.202100085} allows one to take advantage of the known correlation structure in constructing efficacy bounds to control family-wise error rate (FWER) for a group sequential design. Here, correlation may be due to common observations in nested populations, due to common observations in overlapping populations, or due to common observations in the control arm. -} -\seealso{ -Useful links: -\itemize{ - \item \url{https://merck.github.io/wpgsd/} - \item \url{https://github.com/Merck/wpgsd} - \item Report bugs at \url{https://github.com/Merck/wpgsd/issues} -} - -} -\author{ -\strong{Maintainer}: Yujie Zhao \email{yujie.zhao@merck.com} - -Authors: -\itemize{ - \item Keaven Anderson \email{keaven_anderson@merck.com} - \item Zifang Guo \email{zifang.guo@merck.com} - \item Jing Zhao \email{jing_zhaox@merck.com} - \item Linda Sun \email{linda_sun@merck.com} - \item Yi Cui \email{yi.cui@merck.com} - \item Larry Leon \email{larry.leon2@merck.com} -} - -Other contributors: -\itemize{ - \item Merck Sharp & Dohme Corp [copyright holder] -} - -} -\keyword{internal} diff --git a/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat.R b/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat.R deleted file mode 100644 index 39921f0..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat.R +++ /dev/null @@ -1,4 +0,0 @@ -library(testthat) -library(wpgsd) - -test_check("wpgsd") diff --git a/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/helper-generate_corr_new.R b/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/helper-generate_corr_new.R deleted file mode 100644 index d378ff3..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/helper-generate_corr_new.R +++ /dev/null @@ -1,126 +0,0 @@ -# Helper functions used by test-independent-generate_corr_new.R - -#' Generate correlation matrix based on event counts -#' -#' @param event Event count of each hypothesis at each analysis, including -#' event count of the intersection of hypotheses. -#' It contains 4 columns: `H1`, `H2`, `Analysis`, `Event`. -#' `H1` needs to be listed as 1, 2, 3, etc. as numbers. -#' -#' @return A correlation matrix. -#' -#' @importFrom dplyr filter select %>% -#' -#' @export -#' -#' @examples -#' # Build the transition matrix -#' m <- matrix(c( -#' 0, 0.5, 0.5, -#' 0.5, 0, 0.5, -#' 0.5, 0.5, 0 -#' ), nrow = 3, byrow = TRUE) -#' # initialize weights -#' w <- c(1 / 3, 1 / 3, 1 / 3) -#' -#' # Input event count of intersection of paired hypotheses - Table 2 -#' event <- tibble::tribble( -#' ~H1, ~H2, ~Analysis, ~Event, -#' 1, 1, 1, 155, -#' 2, 2, 1, 160, -#' 3, 3, 1, 165, -#' 1, 2, 1, 85, -#' 1, 3, 1, 85, -#' 2, 3, 1, 85, -#' 1, 1, 2, 305, -#' 2, 2, 2, 320, -#' 3, 3, 2, 335, -#' 1, 2, 2, 170, -#' 1, 3, 2, 170, -#' 2, 3, 2, 170 -#' ) -#' -#' # Generate correlation from events -#' gs_corr <- generate_corr_new(event) -generate_corr_new <- function(event) { - elem <- event %>% subset(H1 == H2) - inter <- event %>% subset(H1 != H2) - n_hypotheses <- max(as.numeric(elem$H1)) - n_analyses <- max(elem$Analysis) - - # Diagonal - D <- diag(elem$Event) - - # Within hypothesis across analyses - if (n_analyses > 1) { - for (i in 1:n_hypotheses) { - for (j in 1:(n_analyses - 1)) { - count <- D[(j - 1) * n_hypotheses + i, (j - 1) * n_hypotheses + i] - for (k in (j + 1):n_analyses) { - D[(j - 1) * n_hypotheses + i, (k - 1) * n_hypotheses + i] <- count - D[(k - 1) * n_hypotheses + i, (j - 1) * n_hypotheses + i] <- count - } - } - } - } - - # Between hypotheses and analyses - for (i in 1:(n_hypotheses - 1)) { - for (j in c((i + 1):n_hypotheses)) { - for (k in 1:n_analyses) { - count1 <- as.numeric(event %>% - subset(((H1 == i & H2 == j) | (H1 == j & H2 == i)) & Analysis == k) %>% - select(Event))[1] - for (l in (k:n_analyses)) { - D[n_hypotheses * (l - 1) + i, n_hypotheses * (k - 1) + j] <- count1 - D[n_hypotheses * (l - 1) + j, n_hypotheses * (k - 1) + i] <- count1 - D[n_hypotheses * (k - 1) + j, n_hypotheses * (l - 1) + i] <- count1 - D[n_hypotheses * (k - 1) + i, n_hypotheses * (l - 1) + j] <- count1 - } - } - } - } - - corr_mat <- d_corr(D) - - col_names <- NULL - for (k in 1:n_analyses) { - for (i in 1:n_hypotheses) { - name_tmp <- paste("H", i, "_A", k, sep = "") - col_names <- c(col_names, name_tmp) - } - } - - colnames(corr_mat) <- col_names - - return(corr_mat) -} - -test_generate_corr_new <- function() { - a1 <- 80 - b1 <- 100 - ab1 <- 60 - a2 <- 120 - b2 <- 150 - ab2 <- 80 - - event <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, a1, - 2, 2, 1, b1, - 1, 2, 1, ab1, - 1, 1, 2, a2, - 2, 2, 2, b2, - 1, 2, 2, ab2 - ) - - list( - "a1" = a1, - "b1" = b1, - "ab1" = ab1, - "a2" = a2, - "b2" = b2, - "ab2" = ab2, - "event" = event - ) -} diff --git a/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-developer-generate_event_commoncontrol_addhypo.R b/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-developer-generate_event_commoncontrol_addhypo.R deleted file mode 100644 index 9c2a339..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-developer-generate_event_commoncontrol_addhypo.R +++ /dev/null @@ -1,23 +0,0 @@ -test_that("Generate event table returns the expected sorted data", { - expected_data <- tibble( - one_hypothesis = as.integer(c(1, 1, 1, 2, 2, 3, 1, 1, 1, 2, 2, 3)), - another_hypothesis = as.integer(c(1, 2, 3, 2, 3, 3, 1, 2, 3, 2, 3, 3)), - analysis = as.integer(c(1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2)), - common_events = c(155, 85, 70, 160, 75, 165, 305, 170, 135, 320, 150, 335) - ) - - event <- data.frame( - Population = c("Experimental 1", "Experimental 2", "Experimental 3", "Control"), - IA = c(70, 75, 80, 85), - FA = c(135, 150, 165, 170) - ) - - hypothesis <- list( - H1 = "Experimental 1 vs. Control", - H2 = "Experimental 2 vs. Control", - H3 = "Experimental 1 vs. Experimental 2" - ) - - result_table <- generate_event_table_cc(event, hypothesis) - expect_identical(result_table, expected_data) -}) diff --git a/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-developer-generate_event_population_addhypo.R b/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-developer-generate_event_population_addhypo.R deleted file mode 100644 index c611242..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-developer-generate_event_population_addhypo.R +++ /dev/null @@ -1,23 +0,0 @@ -test_that("Generate event table ol returns the expected sorted data", { - expected_data <- tibble( - one_hypothesis = as.integer(c(1, 1, 1, 2, 2, 3, 1, 1, 1, 2, 2, 3)), - another_hypothesis = as.integer(c(1, 2, 3, 2, 3, 3, 1, 2, 3, 2, 3, 3)), - analysis = as.integer(c(1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2)), - common_events = c(100, 80, 100, 110, 110, 225, 200, 160, 200, 220, 220, 450) - ) - - event <- data.frame( - Population = c("Population 1", "Population 2", "Population 1 Intersection 2", "Overall population"), - IA = c(100, 110, 80, 225), - FA = c(200, 220, 160, 450) - ) - - hypothesis <- list( - H1 = "Efficacy in Population 1", - H2 = "Efficacy in Population 2", - H3 = "Efficacy in Overall population" - ) - - result_table <- generate_event_table_ol(event, hypothesis) - expect_identical(result_table, expected_data) -}) diff --git a/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-independent-closed_test.R b/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-independent-closed_test.R deleted file mode 100644 index ef088a0..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-independent-closed_test.R +++ /dev/null @@ -1,25 +0,0 @@ -test_that("closed_test reject hypothesis as expected", { - p_obs <- dplyr::bind_rows( - tibble::tibble(Analysis = 1, H1 = 0.001, H2 = 0.001), - tibble::tibble(Analysis = 2, H1 = 0.001, H2 = 0.001) - ) - - bound <- tibble::tribble( - ~Analysis, ~Hypotheses, ~H1, ~H2, - 1, "H1", 0.02, NA, - 1, "H1, H2", 0.0001, 0.00001, - 1, "H2", NA, 0.003, - 2, "H1", 0.02, NA, - 2, "H1, H2", 0.02, 0.00001, - 2, "H2", NA, 0.003 - ) - - closed_test <- closed_test(bound, p_obs) - closed_test_a1 <- closed_test %>% dplyr::filter(Analysis == "Analysis 1") - closed_test_a2 <- closed_test %>% dplyr::filter(Analysis == "Analysis 2") - - expect_equal(closed_test_a1$H1, "Fail") - expect_equal(closed_test_a1$H2, "Fail") - expect_equal(closed_test_a2$H1, "Success") - expect_equal(closed_test_a2$H2, "Success") -}) diff --git a/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-independent-generate_bounds.R b/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-independent-generate_bounds.R deleted file mode 100644 index 67d474b..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-independent-generate_bounds.R +++ /dev/null @@ -1,580 +0,0 @@ -test_that("BH bounds replicate tables A3 and A4", { - # Example 1 BH weighting results in Table A3 and A4 - set.seed(1234) - - # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ex1 BH ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~# - # Transition matrix in Figure A1 - m <- matrix(c( - 0, 3 / 7, 4 / 7, - 3 / 7, 0, 4 / 7, - 1 / 2, 1 / 2, 0 - ), nrow = 3, byrow = TRUE) - # Initial weights - w <- c(0.3, 0.3, 0.4) - - # Event count of intersection of paired hypotheses - Table 1 - event <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 100, - 2, 2, 1, 110, - 3, 3, 1, 225, - 1, 2, 1, 80, - 1, 3, 1, 100, - 2, 3, 1, 110, - 1, 1, 2, 200, - 2, 2, 2, 220, - 3, 3, 2, 450, - 1, 2, 2, 160, - 1, 3, 2, 200, - 2, 3, 2, 220 - ) - event - - # Generate correlation from events - corr <- generate_corr(event) - corr # correlation matrix in Table 3 - - # WPGSD bounds, spending method 3b - bound_WPGSD <- generate_bounds( - type = 2, k = 2, w = w, m = m, corr = corr, alpha = 0.025, - sf = gsDesign::sfHSD, - sfparm = -4, - t = c(min(100 / 200, 110 / 220, 225 / 450), 1) - ) - - # Bonferroni bounds - bound_Bonf <- generate_bounds( - type = 0, k = 2, w = w, m = m, corr = corr, alpha = 0.025, - sf = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - sfparm = list(-4, -4, -4), - t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1)) - ) - - # Combine and back-calculate xi - bounds <- dplyr::left_join( - bound_Bonf, - bound_WPGSD, - by = c("Hypotheses", "Analysis"), - suffix = c(".B", ".W") - ) - bounds <- bounds %>% - dplyr::rowwise() %>% - dplyr::mutate(xi = sum(H1.W, H2.W, H3.W, na.rm = TRUE) / - sum(H1.B, H2.B, H3.B, na.rm = TRUE)) - # Reorder for output - bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2) - bounds <- bounds %>% dplyr::arrange(Analysis, order) - - # Z-statistics boundary, Table A4 - zbounds <- bounds %>% - dplyr::mutate( - zH1.B = -qnorm(H1.B), - zH2.B = -qnorm(H2.B), - zH3.B = -qnorm(H3.B), - zH1.W = -qnorm(H1.W), - zH2.W = -qnorm(H2.W), - zH3.W = -qnorm(H3.W) - ) %>% - select(Analysis, Hypotheses, zH1.B, zH2.B, zH3.B, zH1.W, zH2.W, zH3.W) - - - # Table A3 - # Test H1 - # From publication Weighted Bonferroni - A3_result1 <- c( - 0.0009, 0.0015, 0.0013, NA, - 0.003, NA, NA, 0.007, 0.0118, - 0.0101, NA, 0.0238, NA, NA - ) - - A3_result1_test <- round(bounds$H1.B, 4) - - expect_equal(A3_result1_test, A3_result1) - - # WPGSD - - wA3_result1 <- c( - 0.0011, 0.0017, 0.0014, NA, - 0.003, NA, NA, 0.0092, 0.0144, - 0.0116, NA, 0.0238, NA, NA - ) - - wA3_result1_test <- round(bounds$H1.W, 4) - - expect_equal(wA3_result1_test, wA3_result1) - - - # Table A4 - # Test H1 - # From publication Weighted Bonferroni - A4_result1 <- c( - 3.12, 2.97, 3.02, NA, 2.75, NA, NA, - 2.46, 2.26, 2.32, NA, 1.98, NA, NA - ) - - A4_result1_test <- round(zbounds$zH1.B, 2) - - expect_equal(A4_result1_test, A4_result1) - - # WPGSD - wA4_result1 <- c( - 3.08, 2.93, 2.99, NA, 2.75, NA, NA, - 2.36, 2.19, 2.27, NA, 1.98, NA, NA - ) - - wA4_result1_test <- round(zbounds$zH1.W, 2) - - expect_equal(wA4_result1_test, wA4_result1) - - - ######################## - # Next, reproduce H2? - ######################## - - A3_result2 <- c( - 0.0009, 0.0015, NA, 0.0013, NA, - 0.003, NA, 0.007, 0.0118, NA, 0.0101, NA, 0.0238, NA - ) - - A3_result2_test <- round(bounds$H2.B, 4) - - expect_equal(A3_result2_test, A3_result2) - - # WPGSD - - wA3_result2 <- c( - 0.0011, 0.0017, NA, 0.0014, NA, - 0.003, NA, 0.0092, 0.0144, - NA, 0.0118, NA, 0.0238, NA - ) - - wA3_result2_test <- round(bounds$H2.W, 4) - - expect_equal(wA3_result2_test, wA3_result2) - - # A4 - - A4_result2 <- c( - 3.12, 2.97, NA, 3.02, NA, 2.75, NA, 2.46, 2.26, NA, 2.32, - NA, 1.98, NA - ) - - A4_result2_test <- round(zbounds$zH2.B, 2) - - expect_equal(A4_result2_test, A4_result2) - - # WPGSD - wA4_result2 <- c( - 3.08, 2.93, NA, 2.99, NA, 2.75, NA, 2.36, 2.19, - NA, 2.26, NA, 1.98, NA - ) - - wA4_result2_test <- round(zbounds$zH2.W, 2) - - expect_equal(wA4_result2_test, wA4_result2) - - - ######################## - # Next, reproduce H3? - ######################## - - A3_result3 <- c( - 0.0012, NA, 0.0017, 0.0017, NA, NA, 0.003, 0.0094, NA, - 0.0135, 0.0135, NA, NA, 0.0238 - ) - - A3_result3_test <- round(bounds$H3.B, 4) - - expect_equal(A3_result3_test, A3_result3) - - # WPGSD - - wA3_result3 <- c( - 0.0014, NA, 0.0018, 0.0019, NA, NA, 0.003, 0.0123, NA, - 0.0155, 0.0158, NA, NA, 0.0238 - ) - - wA3_result3_test <- round(bounds$H3.W, 4) - - expect_equal(wA3_result3_test, wA3_result3) - - # A4 - - A4_result3 <- c(3.04, NA, 2.93, 2.93, NA, NA, 2.75, 2.35, NA, 2.21, 2.21, NA, NA, 1.98) - - A4_result3_test <- round(zbounds$zH3.B, 2) - - expect_equal(A4_result3_test, A4_result3) - - # WPGSD - wA4_result3 <- c(2.99, NA, 2.9, 2.9, NA, NA, 2.75, 2.25, NA, 2.16, 2.15, NA, NA, 1.98) - - wA4_result3_test <- round(zbounds$zH3.W, 2) - - expect_equal(wA4_result3_test, wA4_result3) -}) - -test_that("BH bounds replicate tables A6 and A7", { - # From wpgsd github: - # Example 2 BH weighting results in Table A6 and A7 - set.seed(1234) - - # Transition matrix in Figure A2 - m <- matrix(c( - 0, 0.5, 0.5, - 0.5, 0, 0.5, - 0.5, 0.5, 0 - ), nrow = 3, byrow = TRUE) - # Initial weights - w <- c(1 / 3, 1 / 3, 1 / 3) - - # Event count of intersection of paired hypotheses - Table 2 - event <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160, - 3, 3, 1, 165, - 1, 2, 1, 85, - 1, 3, 1, 85, - 2, 3, 1, 85, - 1, 1, 2, 305, - 2, 2, 2, 320, - 3, 3, 2, 335, - 1, 2, 2, 170, - 1, 3, 2, 170, - 2, 3, 2, 170 - ) - event - - # Generate correlation from events - corr <- generate_corr(event) - corr # correlation matrix in Table 4 - - # WPGSD bounds, spending method 3c - bound_WPGSD <- generate_bounds( - type = 3, k = 2, w = w, m = m, corr = corr, alpha = 0.025, - sf = list(gsDesign::sfLDOF, gsDesign::sfLDOF, gsDesign::sfLDOF), - sfparm = list(0, 0, 0), - t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1)) - ) - - # Bonferroni bounds - bound_Bonf <- generate_bounds( - type = 0, k = 2, w = w, m = m, corr = corr, alpha = 0.025, - sf = list(gsDesign::sfLDOF, gsDesign::sfLDOF, gsDesign::sfLDOF), - sfparm = list(0, 0, 0), - t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1)) - ) - - bounds <- dplyr::left_join( - bound_Bonf, - bound_WPGSD, - by = c("Hypotheses", "Analysis"), - suffix = c(".B", ".W") - ) - - # Reorder for output - bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2) - bounds <- bounds %>% arrange(Analysis, order) - - # Table A6 - bounds - - bounds <- bounds %>% arrange(Analysis, order) - - # Z-statistics boundary, Table A7 - zbounds <- bounds %>% - mutate( - zH1.B = -qnorm(H1.B), - zH2.B = -qnorm(H2.B), - zH3.B = -qnorm(H3.B), - zH1.W = -qnorm(H1.W), - zH2.W = -qnorm(H2.W), - zH3.W = -qnorm(H3.W) - ) %>% - select(Analysis, Hypotheses, zH1.B, zH2.B, zH3.B, zH1.W, zH2.W, zH3.W) - - - # Table A6 - # Test H1 - # From publication Weighted Bonferroni - A6_result1 <- c( - 0.00021488, - 0.000458864, - 0.000458864, - NA, - 0.001665671, - NA, - NA, - 0.008259394, - 0.0123448, - 0.0123448, - NA, - 0.024455472, - NA, - NA - ) - - A6_result1_test <- round(bounds$H1.B, 4) - - expect_equal(A6_result1_test, round(A6_result1, 4)) - - # H2 - - A6_result2 <- c( - 0.000190676, - 0.000411979, - NA, - 0.000411979, - NA, - 0.001525323, - NA, - 0.0082675, - 0.012360191, - NA, - 0.012360191, - NA, - 0.024499778, - NA - ) - - A6_result2_test <- round(bounds$H2.B, 4) - - expect_equal(A6_result2_test, round(A6_result2, 4)) - - # H3 - - A6_result3 <- c( - 0.000170445, - NA, - 0.000372343, - 0.000372343, - NA, - NA, - 0.001404398, - 0.008274305, - NA, - 0.012373258, - 0.012373258, - NA, - NA, - 0.024538108 - ) - - A6_result3_test <- round(bounds$H3.B, 4) - - expect_equal(A6_result3_test, round(A6_result3, 4)) - - ######## - # WPGSD - ######## - - wA6_result1 <- c( - 0.000224701, - 0.000471076, - 0.000470177, - NA, - 0.001665671, - NA, - NA, - 0.009491524, - 0.013508544, - 0.013452942, - NA, - 0.024455472, - NA, - NA - ) - - wA6_result1_test <- round(bounds$H1.W, 4) - - expect_equal(wA6_result1_test, round(wA6_result1, 4)) - - - - wA6_result2 <- c( - 0.00019939, - 0.000422943, - NA, - 0.000421453, - NA, - 0.001525323, - NA, - 0.00950084, - 0.013525386, - NA, - 0.01341849, - NA, - 0.024499778, - NA - ) - - wA6_result2_test <- round(bounds$H2.W, 4) - - expect_equal(wA6_result2_test, round(wA6_result2, 4)) - - - wA6_result3 <- c( - 0.000178234, - NA, - 0.000381523, - 0.000380905, - NA, - NA, - 0.001404398, - 0.00950866, - NA, - 0.013483955, - 0.013432676, - NA, - NA, - 0.024538108 - ) - - wA6_result3_test <- round(bounds$H3.W, 4) - - expect_equal(wA6_result3_test, round(wA6_result3, 4)) - - - # Z-statistics - - - # Table A7 - A7_result1 <- c( - 3.521099809, - 3.314604451, - 3.314604451, - NA, - 2.93538486, - NA, - NA, - 2.397246926, - 2.246225001, - 2.246225001, - NA, - 1.969367163, - NA, - NA - ) - - A7_result1_test <- round(zbounds$zH1.B, 4) - - expect_equal(A7_result1_test, round(A7_result1, 4)) - - - A7_result2 <- c( - 3.552662921, - 3.34461863, - NA, - 3.34461863, - NA, - 2.962588043, - NA, - 2.396887486, - 2.245744429, - NA, - 2.245744429, - NA, - 1.968595527, - NA - ) - - A7_result2_test <- round(zbounds$zH2.B, 4) - - expect_equal(A7_result2_test, round(A7_result2, 4)) - - - - A7_result3 <- c( - 3.582064348, - NA, - 3.372575697, - 3.372575697, - NA, - NA, - 2.987923795, - 2.396585993, - NA, - 2.24533684, - 2.24533684, - NA, - NA, - 1.967928919 - ) - - A7_result3_test <- round(zbounds$zH3.B, 4) - - expect_equal(A7_result3_test, round(A7_result3, 4)) - - - - - - # Table A7 - wA7_result1 <- c( - 3.509232997, - 3.307254785, - 3.307789645, - NA, - 2.93538486, - NA, - NA, - 2.345863682, - 2.21127083, - 2.212880514, - NA, - 1.969367163, - NA, - NA - ) - - wA7_result1_test <- round(zbounds$zH1.W, 4) - - expect_equal(wA7_result1_test, round(wA7_result1, 4)) - - - wA7_result2 <- c( - 3.540889382, - 3.337326516, - NA, - 3.338307071, - NA, - 2.962588043, - NA, - 2.345498009, - 2.210784367, - NA, - 2.213880806, - NA, - 1.968595527, - NA - ) - - - wA7_result2_test <- round(zbounds$zH2.W, 4) - - expect_equal(wA7_result2_test, round(wA7_result2, 4)) - - - - wA7_result3 <- c( - 3.570376445, - NA, - 3.365863239, - 3.366309865, - NA, - NA, - 2.987923795, - 2.345191286, - NA, - 2.21198197, - 2.213468666, - NA, - NA, - 1.967928919 - ) - - wA7_result3_test <- round(zbounds$zH3.W, 4) - - expect_equal(wA7_result3_test, round(wA7_result3, 4)) -}) diff --git a/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-independent-generate_corr.R b/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-independent-generate_corr.R deleted file mode 100644 index a1699f5..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-independent-generate_corr.R +++ /dev/null @@ -1,31 +0,0 @@ -test_that("2 endpoints 2 analysis correlation as expected", { - a1 <- 80 - b1 <- 100 - ab1 <- 60 - a2 <- 120 - b2 <- 150 - ab2 <- 80 - - event <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, a1, - 2, 2, 1, b1, - 1, 2, 1, ab1, - 1, 1, 2, a2, - 2, 2, 2, b2, - 1, 2, 2, ab2 - ) - - corr <- generate_corr(event) - corr_test <- matrix( - c( - 1, ab1 / sqrt(a1 * b1), a1 / sqrt(a1 * a2), ab1 / sqrt(a1 * b2), - ab1 / sqrt(a1 * b1), 1, ab1 / sqrt(a2 * b1), b1 / sqrt(b1 * b2), - a1 / sqrt(a1 * a2), ab1 / sqrt(a2 * b1), 1, ab2 / sqrt(a2 * b2), - ab1 / sqrt(a1 * b2), b1 / sqrt(b1 * b2), ab2 / sqrt(a2 * b2), 1 - ), - nrow = 4, byrow = TRUE - ) - - expect_equal(matrix(corr %>% as.numeric(), nrow = 4, byrow = TRUE), corr_test) -}) diff --git a/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-independent-generate_corr_new.R b/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-independent-generate_corr_new.R deleted file mode 100644 index aae7943..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-independent-generate_corr_new.R +++ /dev/null @@ -1,62 +0,0 @@ -test_that("2 endpoints 2 analysis correlation as expected", { - res <- test_generate_corr_new() - a1 <- res$a1 - b1 <- res$b1 - ab1 <- res$ab1 - a2 <- res$a2 - b2 <- res$b2 - ab2 <- res$ab2 - event <- res$event - - corr <- generate_corr_new(event) - corr_test <- matrix( - c( - 1, ab1 / sqrt(a1 * b1), a1 / sqrt(a1 * a2), ab1 / sqrt(a1 * b2), - ab1 / sqrt(a1 * b1), 1, ab1 / sqrt(a2 * b1), b1 / sqrt(b1 * b2), - a1 / sqrt(a1 * a2), ab1 / sqrt(a2 * b1), 1, ab2 / sqrt(a2 * b2), - ab1 / sqrt(a1 * b2), b1 / sqrt(b1 * b2), ab2 / sqrt(a2 * b2), 1 - ), - nrow = 4, byrow = TRUE - ) - - expect_equal(matrix(corr %>% as.numeric(), nrow = 4, byrow = TRUE), corr_test) -}) - -# This is a 2 hypothesis, 3 analysis example -test_that("2 hypotheses 3 analysis correlation as expected", { - event <- tibble::tribble( - ~Analysis, ~H1, ~H2, ~Event, - 1, 1, 1, 147, - 1, 2, 2, 167, - 1, 1, 2, 88, - 2, 1, 1, 278, - 2, 2, 2, 289, - 2, 1, 2, 158, - 3, 1, 1, 342, - 3, 2, 2, 350, - 3, 1, 2, 192 - ) - corr <- generate_corr_new(event) - n_hypotheses <- 2 - n_analyses <- 3 - corr_test <- diag(1, n_hypotheses * n_analyses) - for (k in 1:n_analyses) { - for (l in k:n_analyses) { - for (i in 1:(n_hypotheses)) { - countkii <- as.numeric((event %>% filter(H1 == i & H2 == i & Analysis == k))$Event) - for (j in i:n_hypotheses) { - countkjj <- as.numeric((event %>% filter(H1 == j & H2 == j & Analysis == k))$Event) - countljj <- as.numeric((event %>% filter(H1 == j & H2 == j & Analysis == l))$Event) - countlii <- as.numeric((event %>% filter(H1 == i & H2 == i & Analysis == l))$Event) - countkij <- as.numeric((event %>% filter(H1 == i & H2 == j & Analysis == k))$Event) - corr_test[(k - 1) * n_hypotheses + i, (l - 1) * n_hypotheses + j] <- countkij / sqrt(countkii * countljj) - corr_test[(k - 1) * n_hypotheses + j, (l - 1) * n_hypotheses + i] <- countkij / sqrt(countkjj * countlii) - corr_test[(l - 1) * n_hypotheses + i, (k - 1) * n_hypotheses + j] <- countkij / sqrt(countlii * countkjj) - corr_test[(l - 1) * n_hypotheses + j, (k - 1) * n_hypotheses + i] <- countkij / sqrt(countljj * countkii) - } - } - } - } - - expect_equal(matrix(corr %>% as.numeric(), nrow = 6, byrow = TRUE), corr_test) -}) diff --git a/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-s7-event-table.R b/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-s7-event-table.R deleted file mode 100644 index ceca45c..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-s7-event-table.R +++ /dev/null @@ -1,171 +0,0 @@ -test_that("EventTable can be created with valid data", { - # Create valid event data - event_data <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160, - 1, 2, 1, 85, - 1, 1, 2, 305, - 2, 2, 2, 320, - 1, 2, 2, 170 - ) - - # Create EventTable - event_table <- EventTable(data = event_data) - - # Check that object was created successfully - expect_true(S7::S7_inherits(event_table, EventTable)) - expect_equal(event_table@n_hypotheses, 2L) - expect_equal(event_table@n_analyses, 2L) - expect_equal(nrow(event_table@data), 6) -}) - -test_that("EventTable validates required columns", { - # Missing Event column - invalid_data1 <- tibble::tibble( - H1 = c(1, 2), - H2 = c(1, 2), - Analysis = c(1, 1) - ) - - expect_error( - EventTable(data = invalid_data1), - "EventTable requires columns: Event" - ) - - # Missing H1 column - invalid_data2 <- tibble::tibble( - H2 = c(1, 2), - Analysis = c(1, 1), - Event = c(100, 200) - ) - - expect_error( - EventTable(data = invalid_data2), - "EventTable requires columns: H1" - ) -}) - -test_that("EventTable validates data types and values", { - # Non-numeric H1 - invalid_data1 <- tibble::tibble( - H1 = c("A", "B"), - H2 = c(1, 2), - Analysis = c(1, 1), - Event = c(100, 200) - ) - - expect_error( - EventTable(data = invalid_data1), - "@data\\$H1 and @data\\$H2 must be numeric" - ) - - # Negative hypothesis index - invalid_data2 <- tibble::tibble( - H1 = c(-1, 2), - H2 = c(1, 2), - Analysis = c(1, 1), - Event = c(100, 200) - ) - - expect_error( - EventTable(data = invalid_data2), - "Hypothesis indices \\(H1, H2\\) must be positive integers" - ) - - # Negative event count - invalid_data3 <- tibble::tibble( - H1 = c(1, 2), - H2 = c(1, 2), - Analysis = c(1, 1), - Event = c(-100, 200) - ) - - expect_error( - EventTable(data = invalid_data3), - "Event counts must be non-negative" - ) -}) - -test_that("EventTable print method works", { - event_data <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160 - ) - - event_table <- EventTable(data = event_data) - - # Test the show method (which S7 uses for printing) - expect_output(show(event_table), "EventTable with 2 rows") - expect_output(show(event_table), "Hypotheses: 2") - expect_output(show(event_table), "Analyses: 1") -}) - -test_that("subset_event_table works correctly", { - event_data <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160, - 1, 2, 1, 85, - 1, 1, 2, 305, - 2, 2, 2, 320, - 1, 2, 2, 170 - ) - - event_table <- EventTable(data = event_data) - - # Subset by analysis - subset_a1 <- subset_event_table(event_table, analysis = 1) - expect_equal(subset_a1@n_analyses, 1L) - expect_equal(nrow(subset_a1@data), 3) - - # Subset by hypotheses - subset_h1 <- subset_event_table(event_table, hypotheses = c(1)) - expect_equal(nrow(subset_h1@data), 2) # Only H1-H1 pairs - - # Error for non-EventTable input - expect_error( - subset_event_table(data.frame(), analysis = 1), - "x must be an EventTable object" - ) -}) - -test_that("as_event_table conversion works", { - event_data <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160 - ) - - # Convert tibble to EventTable - event_table <- as_event_table(event_data) - expect_true(S7::S7_inherits(event_table, EventTable)) - - # Should return same object if already EventTable - event_table2 <- as_event_table(event_table) - expect_identical(event_table, event_table2) -}) - -test_that("validate_event_table_data works", { - # Valid data should pass - valid_data <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160 - ) - - expect_true(validate_event_table_data(valid_data)) - - # Invalid data should fail - invalid_data <- tibble::tribble( - ~H1, ~H2, ~Analysis, # Missing Event column - 1, 1, 1, - 2, 2, 1 - ) - - expect_error( - validate_event_table_data(invalid_data), - "Missing required columns: Event" - ) -}) diff --git a/wpgsd.Rcheck/vign_test/wpgsd/vignettes/.build.timestamp b/wpgsd.Rcheck/vign_test/wpgsd/vignettes/.build.timestamp deleted file mode 100644 index e69de29..0000000 diff --git a/wpgsd.Rcheck/vign_test/wpgsd/vignettes/adj-seq-p.R b/wpgsd.Rcheck/vign_test/wpgsd/vignettes/adj-seq-p.R deleted file mode 100644 index d7b1892..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/vignettes/adj-seq-p.R +++ /dev/null @@ -1,384 +0,0 @@ -## ----message = FALSE, warning = FALSE----------------------------------------- -library(wpgsd) -library(gsDesign) -library(tibble) -library(gt) -library(dplyr) - -## ----------------------------------------------------------------------------- -event_tbl <- tribble( - ~population, ~analysis, ~event, - "A positive", 1, 100, - "B positive", 1, 110, - "AB positive", 1, 80, - "overall", 1, 225, - "A positive", 2, 200, - "B positive", 2, 220, - "AB positive", 2, 160, - "overall", 2, 450, -) - -## ----------------------------------------------------------------------------- -obs_tbl <- tribble( - ~hypothesis, ~analysis, ~obs_p, - "H1", 1, 0.02, - "H2", 1, 0.01, - "H3", 1, 0.012, - "H1", 2, 0.015, - "H2", 2, 0.012, - "H3", 2, 0.010 -) %>% - mutate(obs_Z = -qnorm(obs_p)) - -obs_tbl %>% - gt() %>% - tab_header(title = "Nominal p-values") - -p_obs_IA <- (obs_tbl %>% filter(analysis == 1))$obs_p -p_obs_FA <- (obs_tbl %>% filter(analysis == 2))$obs_p - -## ----------------------------------------------------------------------------- -IF_IA <- c( - ((event_tbl %>% filter(analysis == 1, population == "A positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "A positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event), - ((event_tbl %>% filter(analysis == 1, population == "B positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "B positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event), - ((event_tbl %>% filter(analysis == 1, population == "AB positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "AB positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event) -) - -IF_IA - -## ----------------------------------------------------------------------------- -# Transition matrix in Figure A1 -m <- matrix(c( - 0, 3 / 7, 4 / 7, - 3 / 7, 0, 4 / 7, - 0.5, 0.5, 0 -), nrow = 3, byrow = TRUE) -# Initial weights -w <- c(0.3, 0.3, 0.4) - -## ----------------------------------------------------------------------------- -name_hypotheses <- c("H1: Biomarker A positive", "H2: Biomarker B positive", "H3: Overall Population") - -hplot <- gMCPLite::hGraph( - 3, - alphaHypotheses = w, m = m, - nameHypotheses = name_hypotheses, trhw = .2, trhh = .1, - digits = 5, trdigits = 3, size = 5, halfWid = 1, halfHgt = 0.5, - offset = 0.2, trprop = 0.4, - fill = as.factor(c(2, 3, 1)), - palette = c("#BDBDBD", "#E0E0E0", "#EEEEEE"), - wchar = "w" -) -hplot - -## ----------------------------------------------------------------------------- -# Event count of intersection of paired hypotheses - Table 2 -# H1, H2: Hypotheses intersected. -# (1, 1) represents counts for hypothesis 1 -# (1, 2) for counts for the intersection of hypotheses 1 and 2 -event <- tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, event_tbl %>% filter(analysis == 1, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 2, 1, event_tbl %>% filter(analysis == 1, population == "B positive") %>% select(event) %>% as.numeric(), - 3, 3, 1, event_tbl %>% filter(analysis == 1, population == "overall") %>% select(event) %>% as.numeric(), - 1, 2, 1, event_tbl %>% filter(analysis == 1, population == "AB positive") %>% select(event) %>% as.numeric(), - 1, 3, 1, event_tbl %>% filter(analysis == 1, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 3, 1, event_tbl %>% filter(analysis == 1, population == "B positive") %>% select(event) %>% as.numeric(), - 1, 1, 2, event_tbl %>% filter(analysis == 2, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 2, 2, event_tbl %>% filter(analysis == 2, population == "B positive") %>% select(event) %>% as.numeric(), - 3, 3, 2, event_tbl %>% filter(analysis == 2, population == "overall") %>% select(event) %>% as.numeric(), - 1, 2, 2, event_tbl %>% filter(analysis == 2, population == "AB positive") %>% select(event) %>% as.numeric(), - 1, 3, 2, event_tbl %>% filter(analysis == 2, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 3, 2, event_tbl %>% filter(analysis == 2, population == "B positive") %>% select(event) %>% as.numeric() -) -event - -# Generate correlation from events -gs_corr <- wpgsd::generate_corr(event) -gs_corr %>% round(2) - -## ----wpgsdSeqIA, message=FALSE------------------------------------------------ -seq_p_IA_H123 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H1, H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H12 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H1, H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H13 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H1, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H23 <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H1 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H1", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H2 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H3 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -## ----weightedBonferroniSeqIA, message=FALSE----------------------------------- -seq_p_IA_H123_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H1, H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -seq_p_IA_H12_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H1, H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H13_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H1, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -seq_p_IA_H23_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -seq_p_IA_H1_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H1", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -seq_p_IA_H2_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -seq_p_IA_H3_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - diff --git a/wpgsd.Rcheck/vign_test/wpgsd/vignettes/adj-seq-p.Rmd b/wpgsd.Rcheck/vign_test/wpgsd/vignettes/adj-seq-p.Rmd deleted file mode 100644 index df94c1c..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/vignettes/adj-seq-p.Rmd +++ /dev/null @@ -1,810 +0,0 @@ ---- -title: "Adjusted sequential p-values" -author: "Yujie Zhao, Qi Liu, Linda Sun, Keaven Anderson" -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{Adjusted sequential p-values} ---- - -```{r, message = FALSE, warning = FALSE} -library(wpgsd) -library(gsDesign) -library(tibble) -library(gt) -library(dplyr) -``` - -# Example overview - -In a 2-arm controlled clinical trial example with one primary endpoint, there are 3 patient populations defined by the status of two biomarkers A and B: - -- biomarker A positive, -- biomarker B positive, -- overall population. - -The 3 primary elementary hypotheses are: - -- $H_1$: the experimental treatment is superior to the control in the biomarker A positive population; -- \item $H_2$: the experimental treatment is superior to the control in the biomarker B positive population; -- \item $H_3$: the experimental treatment is superior to the control in the overall population. - -Assume an interim analysis and a final analysis are planned for the study and the number of events are listed as - -```{r} -event_tbl <- tribble( - ~population, ~analysis, ~event, - "A positive", 1, 100, - "B positive", 1, 110, - "AB positive", 1, 80, - "overall", 1, 225, - "A positive", 2, 200, - "B positive", 2, 220, - "AB positive", 2, 160, - "overall", 2, 450, -) -``` - -The observed p-values are - -```{r} -obs_tbl <- tribble( - ~hypothesis, ~analysis, ~obs_p, - "H1", 1, 0.02, - "H2", 1, 0.01, - "H3", 1, 0.012, - "H1", 2, 0.015, - "H2", 2, 0.012, - "H3", 2, 0.010 -) %>% - mutate(obs_Z = -qnorm(obs_p)) - -obs_tbl %>% - gt() %>% - tab_header(title = "Nominal p-values") - -p_obs_IA <- (obs_tbl %>% filter(analysis == 1))$obs_p -p_obs_FA <- (obs_tbl %>% filter(analysis == 2))$obs_p -``` - -The information fraction of $H_1, H_2, H_3$ at IA is - -```{r} -IF_IA <- c( - ((event_tbl %>% filter(analysis == 1, population == "A positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "A positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event), - ((event_tbl %>% filter(analysis == 1, population == "B positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "B positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event), - ((event_tbl %>% filter(analysis == 1, population == "AB positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "AB positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event) -) - -IF_IA -``` - -We assign the initial weights of $H_1, H_2, H_3$ as$\left(w_1(I), w_2(I), w_3(I) \right) = (0.3, 0.3, 0.4).$ And its multiplicity strategy is visualized in below. If $H_1$ is rejected, then $3/7$ local significance level $\alpha_1$ will be propagated to $H_2$, and $4/7$ will go to $H_3$. If $H_3$ is rejected, then half of $\alpha_3$ goes to $H_1$, and half goes to $H_2$. - -```{r} -# Transition matrix in Figure A1 -m <- matrix(c( - 0, 3 / 7, 4 / 7, - 3 / 7, 0, 4 / 7, - 0.5, 0.5, 0 -), nrow = 3, byrow = TRUE) -# Initial weights -w <- c(0.3, 0.3, 0.4) -``` - -```{r} -name_hypotheses <- c("H1: Biomarker A positive", "H2: Biomarker B positive", "H3: Overall Population") - -hplot <- gMCPLite::hGraph( - 3, - alphaHypotheses = w, m = m, - nameHypotheses = name_hypotheses, trhw = .2, trhh = .1, - digits = 5, trdigits = 3, size = 5, halfWid = 1, halfHgt = 0.5, - offset = 0.2, trprop = 0.4, - fill = as.factor(c(2, 3, 1)), - palette = c("#BDBDBD", "#E0E0E0", "#EEEEEE"), - wchar = "w" -) -hplot -``` - -The correlation of the 6 statistisc (2 analysis $\times$ 3 hypothesis) are - -```{r} -# Event count of intersection of paired hypotheses - Table 2 -# H1, H2: Hypotheses intersected. -# (1, 1) represents counts for hypothesis 1 -# (1, 2) for counts for the intersection of hypotheses 1 and 2 -event <- tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, event_tbl %>% filter(analysis == 1, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 2, 1, event_tbl %>% filter(analysis == 1, population == "B positive") %>% select(event) %>% as.numeric(), - 3, 3, 1, event_tbl %>% filter(analysis == 1, population == "overall") %>% select(event) %>% as.numeric(), - 1, 2, 1, event_tbl %>% filter(analysis == 1, population == "AB positive") %>% select(event) %>% as.numeric(), - 1, 3, 1, event_tbl %>% filter(analysis == 1, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 3, 1, event_tbl %>% filter(analysis == 1, population == "B positive") %>% select(event) %>% as.numeric(), - 1, 1, 2, event_tbl %>% filter(analysis == 2, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 2, 2, event_tbl %>% filter(analysis == 2, population == "B positive") %>% select(event) %>% as.numeric(), - 3, 3, 2, event_tbl %>% filter(analysis == 2, population == "overall") %>% select(event) %>% as.numeric(), - 1, 2, 2, event_tbl %>% filter(analysis == 2, population == "AB positive") %>% select(event) %>% as.numeric(), - 1, 3, 2, event_tbl %>% filter(analysis == 2, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 3, 2, event_tbl %>% filter(analysis == 2, population == "B positive") %>% select(event) %>% as.numeric() -) -event - -# Generate correlation from events -gs_corr <- wpgsd::generate_corr(event) -gs_corr %>% round(2) -``` - -# Sequential p-value - -## IA - -```{r, wpgsdSeqIA, message=FALSE} -seq_p_IA_H123 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H1, H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H12 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H1, H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H13 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H1, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H23 <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H1 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H1", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H2 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H3 <- calc_seq_p( - test_analysis = 1, - test_hypothesis = "H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) -``` - -```{r, weightedBonferroniSeqIA, message=FALSE} -seq_p_IA_H123_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H1, H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -seq_p_IA_H12_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H1, H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_IA_H13_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H1, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -seq_p_IA_H23_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -seq_p_IA_H1_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H1", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -seq_p_IA_H2_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) - -seq_p_IA_H3_B <- calc_seq_p( - test_analysis = 1, # stage of interest - test_hypothesis = "H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.3) -) -``` - -## FA - -```{r, wpgsdSeqFA, message=FALSE} -seq_p_FA_H123 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1, H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.15) -) - -seq_p_FA_H12 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1, H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.15) -) - -seq_p_FA_H13 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.15) -) - -seq_p_FA_H23 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.15) -) - -seq_p_FA_H1 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H2 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H3 <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 2, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = gsDesign::sfHSD, - spending_fun_par = -4, - info_frac = c(min(IF_IA), 1), - interval = c(1e-4, 0.2) -) -``` - -```{r, weightedBonferroniSeqFA, message=FALSE} -seq_p_FA_H123_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1, H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H12_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1, H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H13_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H23_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H2, H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H1_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H1", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H2_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H2", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) - -seq_p_FA_H3_B <- calc_seq_p( - test_analysis = 2, # stage of interest - test_hypothesis = "H3", - p_obs = tibble( - analysis = 1:2, - H1 = c(p_obs_IA[1], p_obs_FA[1]), - H2 = c(p_obs_IA[2], p_obs_FA[2]), - H3 = c(p_obs_IA[3], p_obs_FA[3]) - ), # observed p-value - alpha_spending_type = 0, - n_analysis = 2, - initial_weight = w, - transition_mat = m, - z_corr = gs_corr, - spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD), - spending_fun_par = list(-4, -4, -4), - info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)), - interval = c(1e-4, 0.2) -) -``` - -# Adjusted-Sequential p-value - -## IA - -```{r, wpgsdAdjSeqIA} -adj_seq_IA_H1 <- max(seq_p_IA_H123, seq_p_IA_H12, seq_p_IA_H13, seq_p_IA_H1) -adj_seq_IA_H2 <- max(seq_p_IA_H123, seq_p_IA_H12, seq_p_IA_H23, seq_p_IA_H2) -adj_seq_IA_H3 <- max(seq_p_IA_H123, seq_p_IA_H13, seq_p_IA_H23, seq_p_IA_H3) - -cat("The adjusted-sequential p-value of H1, H2, H3 in IA via WPGSD is", adj_seq_IA_H1, adj_seq_IA_H2, adj_seq_IA_H3, "\n") -``` - -```{r, weightedBonferroniAdjSeqIA} -adj_seq_IA_H1_B <- max(seq_p_IA_H123_B, seq_p_IA_H12_B, seq_p_IA_H13_B, seq_p_IA_H1_B) -adj_seq_IA_H2_B <- max(seq_p_IA_H123_B, seq_p_IA_H12_B, seq_p_IA_H23_B, seq_p_IA_H2_B) -adj_seq_IA_H3_B <- max(seq_p_IA_H123_B, seq_p_IA_H13_B, seq_p_IA_H23_B, seq_p_IA_H3_B) - -cat("The adjusted-sequential p-value of H1, H2, H3 in FA via weighted Bonferroni is", adj_seq_IA_H1_B, adj_seq_IA_H2_B, adj_seq_IA_H3_B, "\n") -``` - -## FA - -### WPGSD -```{r, wpgsdAdjSeqFA} -adj_seq_FA_H1 <- max(seq_p_FA_H123, seq_p_FA_H12, seq_p_FA_H13, seq_p_FA_H1) -adj_seq_FA_H2 <- max(seq_p_FA_H123, seq_p_FA_H12, seq_p_FA_H23, seq_p_FA_H2) -adj_seq_FA_H3 <- max(seq_p_FA_H123, seq_p_FA_H13, seq_p_FA_H23, seq_p_FA_H3) - -cat("The adjusted-sequential p-value of H1, H2, H3 in FA via WPGSD is", adj_seq_FA_H1, adj_seq_FA_H2, adj_seq_FA_H3, "\n") -``` - -```{r, weightedBonferroniAdjSeqFA} -adj_seq_FA_H1_B <- max(seq_p_FA_H123_B, seq_p_FA_H12_B, seq_p_FA_H13_B, seq_p_FA_H1_B) -adj_seq_FA_H2_B <- max(seq_p_FA_H123_B, seq_p_FA_H12_B, seq_p_FA_H23_B, seq_p_FA_H2_B) -adj_seq_FA_H3_B <- max(seq_p_FA_H123_B, seq_p_FA_H13_B, seq_p_FA_H23_B, seq_p_FA_H3_B) - -cat("The adjusted-sequential p-value of H1, H2, H3 in FA via weighted Bonferroni is", adj_seq_FA_H1_B, adj_seq_FA_H2_B, adj_seq_FA_H3_B, "\n") -``` - -# Summary - -```{r} -ans <- tribble( - ~Analysis, ~Hypothesis, ~`Sequential p-values of WPGSD`, ~`Sequential p-values of Weighted Bonferroni`, ~`Adjusted-sequential p-values of WPGSD`, ~`Adjusted-sequential p-values of Weighted Bonferroni`, - "IA", "H123", seq_p_IA_H123, seq_p_IA_H123_B, NA, NA, - "IA", "H12", seq_p_IA_H12, seq_p_IA_H12_B, NA, NA, - "IA", "H13", seq_p_IA_H13, seq_p_IA_H13_B, NA, NA, - "IA", "H23", seq_p_IA_H23, seq_p_IA_H23_B, NA, NA, - "IA", "H1", seq_p_IA_H1, seq_p_IA_H1_B, adj_seq_IA_H1, adj_seq_IA_H1_B, - "IA", "H2", seq_p_IA_H2, seq_p_IA_H2_B, adj_seq_IA_H2, adj_seq_IA_H2_B, - "IA", "H3", seq_p_IA_H3, seq_p_IA_H3_B, adj_seq_IA_H3, adj_seq_IA_H3_B, - "FA", "H123", seq_p_FA_H123, seq_p_FA_H123_B, NA, NA, - "FA", "H12", seq_p_FA_H12, seq_p_FA_H12_B, NA, NA, - "FA", "H13", seq_p_FA_H13, seq_p_FA_H13_B, NA, NA, - "FA", "H23", seq_p_FA_H23, seq_p_FA_H23_B, NA, NA, - "FA", "H1", seq_p_FA_H1, seq_p_FA_H1_B, adj_seq_FA_H1, adj_seq_FA_H1_B, - "FA", "H2", seq_p_FA_H2, seq_p_FA_H2_B, adj_seq_FA_H2, adj_seq_FA_H2_B, - "FA", "H3", seq_p_FA_H3, seq_p_FA_H3_B, adj_seq_FA_H3, adj_seq_FA_H3_B -) - -ans %>% - select( - Analysis, Hypothesis, - `Sequential p-values of Weighted Bonferroni`, `Adjusted-sequential p-values of Weighted Bonferroni`, - `Sequential p-values of WPGSD`, `Adjusted-sequential p-values of WPGSD` - ) %>% - gt() %>% - tab_spanner( - label = "Weighted Bonferroni", - columns = c(`Sequential p-values of Weighted Bonferroni`, `Adjusted-sequential p-values of Weighted Bonferroni`) - ) %>% - tab_spanner( - label = "WPGSD", - columns = c(`Sequential p-values of WPGSD`, `Adjusted-sequential p-values of WPGSD`) - ) %>% - tab_style_body( - columns = where(is.numeric), - style = cell_fill(color = "pink"), - fn = function(x) x <= 0.025 - ) %>% - fmt_number(columns = 3:6, decimals = 4) %>% - tab_header( - title = "(Adjusted-) sequential p-values", - subtitle = "Multiple populations" - ) # %>% as_latex() -``` diff --git a/wpgsd.Rcheck/vign_test/wpgsd/vignettes/adj-seq-p_files/figure-html/unnamed-chunk-6-1.png b/wpgsd.Rcheck/vign_test/wpgsd/vignettes/adj-seq-p_files/figure-html/unnamed-chunk-6-1.png deleted file mode 100644 index 378c2b864a0d1b5ecc0fc1c68baae83fcc0c2da7..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 111496 zcmeFZg;!P4yET01mJ|@Ar9m2`58bJhbc29&NlQp0UBWpu3P?&Gx+J68BKv(MUVJu&Bep1n3(80=p^VM5C}_7R#F`VLIQ(82ra0{z?oBv z(PTB@5a3I{yfI#S{B`;d0KcD zlJBf*qsx`u>m3~eF0DR8SUy9n%+ZNViF9zJD{aj)dk2(V^ONT_7Y~*@-&JMcLVpKO z6~F4GUN#5aKkcm0_eT`F`H41Za*5UO}&TjYJm zY$(bG&G}nI6z9X)Xd#}$5=QDisUF^7 z0zF(?g?hX8C2xOl7=A%_^;Q3ZxsFW^T3lvgE&FgmLtdt2%@o=frDet2eH?mOyH02U z@3YTpX)Q20#GhvoF2=GSv2u*7Ss>D(^))kD{LYZIhMb^I#(GpZcQIQpK~W|3yY0`gCIx|67# z%}(lu$2{R^)FFHku!v1}v95bdvy{cE!A^MyAI{X^)Syjo;^cb+0iX9;5e?FskcJ88 zEteOTB=1;Ve$I?#I1N6u8E#CL8E){s#k@!HMey61)vV#!;qKQ&_o=tn?T|SURyGsK zW7V)VuFT2S;nBQ?r|1Lu)Oj?ZS|aP-u3q$r#@X~-#8J@st<0~AEDbnAoFI-1{y+5> zUpg5&89GupLuB5Kc^+`v?3d=0qpw>htIa{g-%ha#F_;Alx3#yKDX45d4GBUsX8YjA zSA-u$q~CztU1o1qSlZg;>tp&=kQ@`2pd^rEfk7TPgP?;C!t2TSN`#Yjp&pdNy2=c32dcljg)%@6t z#Rx+;R(-twmMe`1pkk4Hk8^bo`VNx?_*dhB?X6lWB!fj1J7>Bc?`h{jQ{IgR4>xxo zd`=L?7C^Po2ZRS&4~$OJi9P@zUYTplStu!in1IiyAh=J~AVlC39PmQ|{D464Q22jm zkibxcf1eRr9{*U4+pY!zfkASTVsAX)b~Dg!gZG@@DD53*tApca?e2KUa4#Fqi7JaRM_~ zIOxw<>*qh<=W-r!&fMUy6c$v#3quX{|9>8lQ~}f7Wr|F3|IaIcFC)UM`+uYU{~LuB zjuG5_KJm?nniBs1bpT^L`QI`A+dThkkN-PX{?{J=YmfiMk3Ucy$r`}lU2Vpcf*J~@ zMa=X$pI%M1%tZ6^&9J*&x38YIz?eK&XdY00m@VzT*>(5EoTdH$pzax7nFx3yZcayc z-f7$KqMp29W3cA*2LT)|PC$x30h9yxjxd0O8ceggRRDS7SDd~)l8|^VXm99k`}%Nb zXvzM3+EQgb#WY&Z&vQ0i9eGUxQ4;*$M~Ga@%pJ?k6;0`pXM4Y2jm?z^{2km5+Z3lA z>CFpZE-NZV)jDjYmfg)MOj)Rr6mSIbT$Tg7*L=RT6vdL<4yq{@jIv6pBnK3`-vo63 zdtl%u-)N1xuvj=g%HEXhKdgFzA6f`DnUjSh>X=MWW2oMH35PQcH3P}tqlXMo>aQ4}Va#T@ou{0DA8g;t&R_Ol>aHWZE- z&P*A#k*b%eP{UIXu>d5;yW`8i$4UtfT@#PuKOQ3 zYK^!_u{domKQQ$nelKpA8ho=rkbR`yJ3L&U+`D&)^BLa7dp}QpgdLuNL(S#*q61$g zNc6QgFH2FcaxkLRtw*2QMB~Rdy~F5B%+|O#fNTC7Ryc6iD1>e3wDddqySA#liHYH8 z9&1*%QoZ(P*i21u@=ZSwb3t}{C0eb0)L;o@ch}c0*XBBtssbwtAPluq9P{74MMqps z7y7jL|HdRXgg?brY_*nGt~`9cpk8EVjvLA@B!`V9(&+ICI5T4aMf!>mOKL1^s*6B zcfgX-H)NVu*VN#g&W4i8X!C;QgVW&G^of%G!-lUz)0`4QVkG~E)1dTcT`J>6Nz-(-wR}CJT7;`N9!vY90_-f=)K4Blxa+`=mgKZ9gy{pVMMFl z6!iq!a5WNfy#KZ$PQX1XbhqQA@7}>MIkcq^2gUh{jCR z3vgf;vyhs1Z*XI5jeP2MJP0dOoAFzUm`~f7^?$kBR0WJaSl--O!bT~tYEK&;_eOqr zLMvhd?lXLqYYof?DPPQVB7@7KAGLSzTun7>RvFZ%>YUD}pvLoI#(?>a??30#!@(N+ z>*Moa%`-aKGY0SMX?yEoKW7YRx|(kRvpopE*GIE%@d&0r5_~i`J{t7)i+$5o+rrq_ z*X{i$_%TCl|Gh|JYR;$&cnXUCJ{3Y1_) za)L~4_ljIK8eBNs%_vY#6N9)C<2Pg#`&*Z)f6@=^j5;KGNSNsnBnPD72O9rA7^CD< znJPXvf%?=(AFTVReRo0~N;yJT@l^mW>7{AeJV;=CEijQ)JMehoKL<1nF?1~^m|hwu z|MZRb1Km91nsox2$Bt@UU(9iat^0f)$nN5fB5Y*TUu=or=lb-pK!;dnxtcNFRMH>U zkVWE`_?x4EuFdst4F7Qe`$r(xaMscD=>60^q8F9kB*~N zf@rk}tfyG&eeZ0-|P5C|C)x47HQf<^F0zrHml)zr`__4e{`nlUapP*o&&bR0^7k*e{Ua`>|Le z-7{t;j+qfW>r_DcMwx_XeI~lIAR!a0p1(I7H9;1{mx4s3$F5@(fb>yUF-(q`@n5U} zSZ^e+LI4TB5S8ZBl)?=N1@)>%z95ihhR=aWP*EanszOOn?%_Oz{z^@KqdMN4|w!7zl6*euGxKO{t%as@u8x9r0SY+2Ba*-@GJ0d)>?2wF67*VPuA~FD$n@~huZxNc> z{`u(T*Atnn-%*+BQ4ai! z!G0}zt6@Y;xB&+1->2- zj>@FOXnn^~VeF2{q`|G;cvJSd8kAPa*HRz|1%?L>NW=5MZ+(1IbLJbJ1!)sOOz z$p%#hhFed!Z-QcucgVTUhpijxq7SVvV#Os z|8gzZ6>$@Lab1~0ES^N8TZb{iAN5oPB*kzCpOB>V; z$AB)32I12g<9_2u{AMa7&!_+=An#tZ3d5_}nD;usiYHC{QWf{e#sM>^Lqn}RU6q9LZYsnIOxqZtLGDRPYP{EoOuM;1XCDbrH`# zT-7u3$J%%LFkq0{$&NGc#Q>DJn}cRUuKJoq-=a`pF zrV5Ix@f?~tv}N=MI0A6#{f#>!pK-Mz%Fq}Pm>WK(m^_VtRtG>tZ4iR2JYzdOaX`xL zCt+q%5kO*uj%6L(>E{dn>J7>a&;&H%WqqOE%IJ~R-|4la;DC>MiuV~r|AXdRh^oE= zq7Szfs7l>j$GUkSvMb$J<)GRM_R5Ai9XhAsKNS3v8jK0;Br+80CxN&|Rs-&M1n?FH zycYI00!ZQ~kRkMV+qc0~dJHIBMuZd+CFiiE#tf2!<%DXPFy9%K=`OO`S4 z9|cGZmykg$Y4kkc>_5|ny2ICYj>@!18E{?$OiXs<^)oVxL8L$hBC<@YcK!%kP+$1k z#zn&BpVSeBS+5`VRG<6})oVbhsr-T)LJ`XN<8EBI1jy?GWu^5D_j#)r-)It`btAJE zeaF|_aSl6Zx`_ke)fTpdx;C zZzdimZPbspxE#%wvJN6XAuU-3ggW;}(EFoPTy9-&n)fm)sertq*E=JRY`6iYn<{jF zxpHP9sr8750faz&1S$ymz1ytX>?$h!GdXx*azX%EhoA7nU&!kK>rE!X(@IGu^&Gg!rGdts_=2M)0yh;#WJHQ01H?;JhEZu$qz*v#WGwCr;A{RU0 zcGdWg;wq5ZC7OTTN-#W@p_u@R)vN?mHH!Q7JKu2z3zl>=&i^3ZQ$*rDeea{rHNu7P zh7$4cM?;>V;;h7bg18&JPWGdmUH}D$GJHS5AOzN#=JNpPp~Jh@45YOJ5Pz6yyu3UdUXQP-+bbr@z)~Ogq-64$HTv9 z!4H6bAe2=Nl~0obBG%$}%;I+R_@AQSF=)XjXhv}IwnNsV`8=YPy;*<5UKY1y`=q>^ z{PnBi*m|4ZV&J-2K)dQWv?4v_EHZv7hCUQBhch>K(0DN))D!)mo8`!WkQl;M>pEiQ z8(&BN3F9!tvhx=&2s!>GV~&h}9YVfhD(8o16r;}-;AZ?u`wI7gX!zQtgs>l6@h2<; zaax}Ge$7i7u{xl{asB?+EZy7q7^;7nq-7HipgHO{(s*YJ5{zIQ7z(%5e#1f2>ix|@ zDF;#gUkwaSMSLuIp@`;mvi}(9R2)>wUMvFfKJGD49xZ?L0VO;Z9s9-?XXIp$YqYp) zR9U#U_&4;K9@N@C|I#{=BA}B{mqo`cR;sJih$;5(glG{riJ-R$>fa<>GS50gRt$$q2!EdGKy-3}l%6r&OoHYxy0lv&@6Bij%dY{wDxT5I6CKt~Ya9 z_k21kzVAK;7r=?KM%!aw!-P6N1Zj>esrx4(R#;78+N4|oS_DnYT zU>$WHed+V&FKVE}Gl+6Tf7a4|>XMlMI23n$%VX8Y0)SRHhQR794bmn~0RBO|=wFKf z6|@mtI4uKV*1uxQAJjYeiTr~se%3dEKk? z0AOIvZr&_4=bOD6W~gUyWa1yMM^eM->4#zn9KcSZP0kZ7|7L{}r1J`>#Je(x~|3n{7m^IhKaq3iXfC*HLfo|HLz8 z06oN;)AMralf>@e$AV4vzc(PnZIQ6e3MP!htIGCziDZRjWIYGH_1^wkz$B|L_t&eD z7(hwV$6E7c`987_ON0LrTqpxUm9U)K|IkM$m>f>1Q}tsnnMjPf-%T!PFGhD==dnfx zfHz--j(YDeqc|WEZvm`48}S$3jBZhd&ZkV%u#Ilt7s&%)L;((-{AF#xDFn1FvTX9IB!Yj95^zLyxS10}cZ&Ou9ELF9B54Tq9K;yK zyaFcHv>Cw-Ag218SQ&D;{o0l2>`yzd{;VDjHwEl3{X|~%*Ar2=2;WDSx5(nPP?}ty zZlTQ^|Fik#r^islr<0Bo^cFp(gK*ufD$R^A2cS@RtM(2WWNmr;wIv#2D22~XNevx( z7U#d=e&T|!!W@GVAT;hf3C54tSrNc3%W$R8F@ExA0i&!k^bNwnZM*y%;gJs61%>cm z$fe2o+dpJ|BA@B+kFx$gf6;V7%Un`5l9Hs{Nx}!O?i)Qzrs4Sq=MCUr=PSysL;UVP zaB(1OCBwV;r-$<117cU1;KUgeDxmQ=Qe~l=x{f_Lf zdO;+5e-sn1#5pN$zSMdDto^lXAG@{N~`)2*# zL6NI1?!R-lg;z`oh*LtaosO)MdAwno^y1fo%(x^_T6$j*Hpl#eeTL1LJ z*FE9*CyZpTN%;TSx$qF2tmD~SM`q5*#4>S@OootwI4G<}SHKnJKiYFKJqPK6OcAZ5KQljhtPe0qLN8qAjW zQxUe~DX{@Fn`*y#1|c;+P%h$zt{Fd*%-R%crCHN($^t z`x@jPivdBRX5Z`9(Yfd@(n6vSGW=^dxFqDxfUt9W^46(`_U79{24WRw7&z6ntiOuR zylNH8CEt1#ikQe94_es&#kT-UO(i|j(|7*G1GHBzg>4niIifFt)j;~c@N*G(0!+8L z(-`H7O>RL~MgL)o^m7c*@8YUkOVY&~(07|Qj~7^x<3b~dzj=y#jRJ^d)xrIYiv>Tw zHVRIF1L*qLn!U9ro43)bQt#Ne-Ok({s!CNY?wGksj8$m|xbF}wLX%IW0T`V3K&l}m z{~X0T!yvZxsm%8$)u+=G^|;%sK|f`Y%T{c+0m0=^nm8=pDda_mDW=cW)Nd@mLCO$b4w0xM$}Fvj(8T}+>9DMHFAInlbWg^j3@sj@0z0|5fAVU5sOS_4S3)qG*+TMu)QeJb6 z>&-8FU#@A7l_=+Uv8@lwVf1tW-Z?p~MDZy*#B_*nBC&ah$(jO~tFjJguDPn-`K!t1 zdmbIXyE8BOB%#vknRh+u3%Bd5fKU7?0QI_>sWOc%a=GZxe*$^9UHw+{y;s;ku#aZQ z;=H|ZcJ24qBgL(%s!FE=sCd~sQp#ye@RM6TMec&^z(dAqziva*lRu9YJ`tz(xR;rpLA36t zbwNfx&a=d!0TlxC(`S}nVvB3$KlF@i8D{t$hVGd!Dt%9+aT`t02SlMJ4tUEte9)Na z63Az)@JZqGDVjPUljs;kdoZp{Zit#MJ00dqeb0)FEz37{VmFw-*HTaWJ>11lHtxGt zz#pVSm93cI#`iw#W8NW%Zx`3Cr!D?G_F=JX} zM6ZWeEBaoN&Le&D&I4qRV31}@=VRCV(XFCzO;@$l6I6Z=Hw*EsHFHiMkDp@vOm4ni zLo-mXZC$ZDKk$1HG>f5~e+vY>^6|D-bA2?+g|`y&g9w0KpY8)@-UzRZqG8cN>xE(I zfd%tYMEcw?j3-y}-hrqT)Qr;L#zOcnsvq!F3gqI+ABAzxhR8)-*8q3jg6|FOf%k?W z{cvYEVV{cP&;yVTbhYQVD-;i?-L0OJ`tDe4g)HtKa~|{86Ez_#H(?C|j1n`H@CZ0Y zV|##krDOv>KdF7^bJ4JX)$Df|NCEUKK(m)))Pqfp3d_zb3sNKDgVt^KbW>oo`qL2w zJ}SZ9z&{Ej4V)2A&JhC&^tJGm|DsA~N>fGXxTI*M3vn5d>jBg=sYznIrQVVn@+qF~ z*a)dh*d&p0sY#X}SVt8-Yw8ZLLmG|&Mi%Dkv(g%F_e-M2O{okVlkjA+`0)c{+`{bl z*vtnxA2PBZXL8)D!(9U7-k$js9c~Zrm_YmcvF($gc1e7Lri}hYeVU3J^NGMFl>LM5 zw3NIovH1|t@1@T(n?>!vk4uKVVBl}$;_nc=GWDrxax;b#6Kj?8V!c%;s@%5Bx!?6tC7^`SAN_PB*{;HRz) zy|>X4Gv*>U=J^^Zy7RFe@a6*`IT5%{(60@AfwcbXc|D0Po19G^7`}^z3W)be0RLAk49=8|Ns=NUW`}H;~;*f-2Qd^JmwxtYpXu5cm zD{=}#r%0HPe_M6OvT*j@opz_VQrQxJB0-6eCAH~xjZFn;B)^rVhR;z3yLycs7;&8p zLZ2h!#q9%i^)KTfbE5ADN;rD$?m(3kq@7A<@4Z5LlV&_JVBZ@TYh)3~M`fY*v@HT| z@}?qqnoli`2n(#3Q`b*KK!}=9w0YK$2)R|uuScwL+Sf=`mr8XgFfxI|CxD`6V8%mk zSLw+vxMz7IX$cw4C(bG$WZTVkdsu-o@ukBmJ{vmC8<}2ddMs;7k1XDm1X^I5!`i`X zI`YkTE}iP{8?`YwNgH@?63DB+NpY#2r~O@%s>;#(;ajoIP|~`tewB~%Y+>;|oE=8* zo6{MoUd8$CU5cUatd)MMmYyLRHFrL1jcOLcY&UgFzGGJgXT@n{^C~_ys?+9iAdq@G-#!L!`K_Pdm@#K$k$1yX_PkRPAwj7Iyrr-DL45u$Rb0->Sz(LmlW zrKZZ(lE)&iN5$`Yv@Dny>UGdqGb`wM2K@fo;cN3!2xJa5p%vgxs;%wstTyl_B({W;<%)d5gQqNiGGKZ?Q^0bYpi9JiCE!JH|jd5kV+$NT2yYp%T0y$)Hi1}*T z$5N>%-cNS#@!jAkTx*IkK1pX#WUZ6+$&tL_ydy8Z&>(GmajIF~*^c3Z0DIL+sQDK{ z`~LIUIAj!#)DlyWy~TH>_=;^oSDVLz9g8Q)2GsJ-$cx{I7}_S)qnY;r20Yc5x>RSeXt-TlgaN znp!*dJ40^fhUlo2?`#Zj-U_n1dd^rE1UI1z@-29u;PhpR4AnH>?FI4T+40d$XX_uJ z+`h(-;LQXIb2Mk|l%e$;>;&3VN9(?F*!hf2U^&_z`4kRaK(%X)h+gU1vnu<~8c9`q zQrm7bo;tJMK4xv~`xIyX_Z#+pH?xP`4G|kw!A~_&U1RS}*n9#xGfDeIeGr!MPj2S{ zX|r^%-dtF^8q*|jx38h4Kdziw)$euA$dx66Q+l~J4Fi-zyIZEhyrZnaTkScBLmS%C zt9vr1pHw|25v&te89&-!^g(Bp0jQY|#c)NO+k#jA%mSfIO@2CS&wuQx`&-O$h|m$v zvaNj1vd@pLIO-z(6f@w|$I3T!b|ssQ$Ube6ZfEPdsbGNa{YJ@S$s8>Tt&fjO&jJlU z_&GoV8B^K!ul7rPP*pE|F54-TMNU!&6|FvBu2{=X@mQNV-FJ(emqX2tyVaf?%d}&d zFY`4WMIFY98AoLEl8;lz-0J&Ytu0;WrqXlE1Ks7rx#1;U`$nE6>^=z*5}?>RM3gGd z8#Lq4q$8nZ7&BUw(R|dTFM!6cpXCUnAfG*&$^b`JtYrTTcb1xL;C5k7blR$PSKp0$ z^Ns!`jnc;jzh!(#%9!fK*7@6fF%o_lsUoflIc(<{0vbEd4!TH{IWyQNBR8wX2&?y9 z!jVClH!a02nR7o!PfgQVNp$uE#l~cxx0~z*AW~&T?zU7^zSWHJ6qP3HImtQQ9(8X_ zOcz^11|Z|+hEE8hZmG)Qg_&7N^oR^Rj0>{FH$FXcYe0*ao1#QJ3oj!tPtaeGgAB0s z>hn06%>24j+DNEZE=Wh_N6@q>`JrirL!?%H@tU)E+{z{Aa8dXOr~qqhI7IpYWDqvndk|+B?KpHU|Z*lhH$ItE@2Mz+` z=4cD!^+-8z^E8dRQ@(jvlyNWuqp}@p)j8 zMgBG0YOLstv>t@_O%k+2_^<`RIq?|C9_Ka+<5b??E~7*H=knSR-a85A(ISJhZ_pI; z3f2Wtqs3A0ChFLyD3+``@nH%!XJKj)^bX-2|4p+;zygpML)BvQ9ow~L+O4yD#YLoL}H(@|_^CPgLH+YFkrfiaj@7fC7H zzA3G710~o~1Dk>wdJi1Soia53UDpwYw3KuB; z30W^wl};LBjEfOPYTrY0aM7$Hd^U#Gt0KLtTALR&)gB?uBd?4vf|(HJB`FbwjY~mt zc?f5A8ii~fOY}jh7RqUd@H3V_$Wek4$6(4UH8oDkoToanFO@%d6<^6DX=8>E|B@rMlI2Gj9pB?d%WV^&J=Pp96b9Vl`ddzJW zXgTrs%p^JuC1>p^kw)Ajd$PBx6CQjcbDtaLHGj#7@AJ$?>k5IiW6_0$g9`O0?k1i;7x%N|=zfQS%a(Jt~=2^%5aC@FO_#}RALYfNP zwvqf45(8XXNP;izbfi;9Mt<1M-(|$O*^-F~ual=f<-Z8Vy=Fp;kP7O8qlo}ECM;fy zo2Cm$Blv%a2zE#tH<})N(u-FV;jrx6l{CxHU`;$5gc*bh>2}4*}TT zl$hVu=x?6hWIpAG@cOdtc`H;xoOkD7w006U5U1yMjrr(z>@(Of8%3*_Y%sB8ib^Xp zO}TVI$@(nmZnr}#OhEO;uypG?E|q?2q8!ATn<@ocb;bEa?S>`eKz1BE^Y-ja`#_yV z#~3TFp%7`ShT-ZQ)(s@{5(<_s_(Wes1-2@QI&y36yS#^hV;*0>n-guzmhcm`Y}HKH zNqxR7eaQvu2-fOQY?V7KK6_MgPew1zTCVG0AX_d1d5bBuyK{KOImKK5o+J zL_QH+-Zl*BzJ{8IkDfGN`Da(LxAM>svOM`JGvVJ=5qp!tJ3|JU9kk!aKYO9%D4qeG zAMzKo!i0Kw0G&RrC3SOAL2lJw=t&q$7V#Eh0eGR;;u1(}Xctcmq*&PK381+YLZvW@ zT|xh+3y- zal)!_5D(EyuSOTEg_=^#`yxT>kA4V_n_;wGU>skyzT2~Weh224IdT5BsE=#&lsnktM5(u zeX)RwM(&^${Y$*_NjrkFNg;NownC-bPvaD9I?@|H1(>vW6wzXeKRkQbsjWVyvt|4c zx>}_duHf@~YZ9aY9q|MZEFk(FBKCi>j@Z#4C zqXQP{ou zh(9Q-py;El{JBIdpbP*S2kc~P>`>Xrf55MDnhiIg0`*WyY&e>;2d1`($ypW-Kjh^^ zP-pSHp!_Gl(yI_LZ(p9hqGVlU*cDYQ)JLg+x%5)?%{fKi+QQ`*dLVhN?LE&N=kn5 zipu_KY4|OAj6h+(8(<8saf?5&{~Y4kSC&by{rv-A`TRA0B*>$#!1$NLdjqj1{7F70IRq(vAo?|~I zYhLtuo3i4yBS&KA**#k~KOQ2-v%6w_Gn#alz{pD09940xj3557_%g0`?h2WaW=R9p z6;aBU?4%6A{21Ix2-Nh;nXr-3FX^pO@vPG{Q-VZqEzjnzqny!^ zWBJJ`_znsc%g#&{f|U936!%IW?DLE@_%xo)R->p!NKcL=;x}slieP(mdGLX+tYFN5 z=nO}q124}?~!NczD;`!BkcR^txoR=mi^xPS_=+ma>kI%&iBRL?5!AaIvD2q zEhgr}b`Cdx;+H-Ti^&mQoek>n0^ZGwlHf^k71@e&FWwBLN2ge5iYT>deinIrU{;zvA1k*ZHGP!HE*TAr()SyNYD< zvAtp;HJK6E&hkoQT$+29R;1R^+z?y!jr^UFKRQh;%aTqfd}_cd-JIY9S*y~5Zsj#6 z6w|VT9p8_9Hbi4#@9jCuTi=uwI29+?R{cZM+_FGpBH1OMw#Zz&EVh**=N{Q~1@lsz`%VUBBupU0M9E)%m+hz%s_x!fO z#ua^Z5+h&veAHE}%-o8S)tD!CR+4Guo;&Z4|%Yhbz`nDw36)@EHtLq^a4xjPYZ)+;{}IeV-ZQ*9V~ zPVwAyCE!(KvG)d}_2@t=bBKM|8Mf64XYKDjuP*mKh2iRoho++vsVzwI2F&OF`mPuN zqsn8syWZ`-Yv*NOVtLn{SpbWM4)T1!sK|(Gbdw$U3A}hqt7$WQl+8j9ux1t(Bu%I_ zg8ck-{JC;5{xeM<`a$B$EU%u*ruAB0xu)uDsTUsBBcBgs92O#(-C|v?tyQ1O)u44l z3A*$f(%G|>Bgu+2a70ofk+TkuDSo`)DqCn)bil8{&40f!lG=XURV?Epa8&m^eT~$!e zD?daBw&Sdm$>p>J!P28Co7CdxzmtIJ3P_-$OlmAgGlSNJBrHIY&jV_hXZ^~~RW&RRs<0u2kJ_*rh}E4Pta-{sCxnzJ_;Hd*&ji=k6?)tSBl?LlXgag#QX^#IIB6r8#O>*Z^3t6z27U2vjW9b`0J?5nxLV3jYMYzvjgWPPi@iESJA^tllRbu4c9G zQQ%Slo^T31-=V~4`QmEJHp}Q085&x{?`Mub`<9vhxLv|noRc81DXN3Vy4^&tg~ByPjCp=idy-d*{m{he zo#k%EOM9`u$s%RVBRS^R=zA$p`jwTIQsi|eDThyZhrCUl=2Fz(p9>< zG7Os;Pa5fQBT#q4^?g*fsp{9`>DGz}k8j-Vttve zA~{1H0#!Pu){&k_g^)3HzB=x_m9p&yHiYu|pBNdJhWE$GzR42`FFq4h_8N9|&npzs z+-tLhD)zsd0f@q6+9DpEzUz%b_#d&Bd^;zqjm0Ex~c8 z*wG-p>~>8$w*%~^_2NNf?}yLk?49Fmr(va5Ad27n<{gjG!+}9(%MC%W$5T3MsaU-# zdvN9lbMrNDd9X}iuqVxzR$w#OLAeBwpzL_CZJ)(Oe-lKKi{i>50U!#-U^1 zct)p$+|vY<4}F2G&!C&G(5?Zpnmht%NHc)x0O&c_rzzL^sPiHlxuL>%1aQYQw##kkR(Xy}{ZtxLbzrG$t)AfK4M2G5Cbu z>*(Ni(wblvEsuk^R+J!RCsFlkjn}b49uWv6ggP&It*tA_6GQ&}F93b_->$7~K|bEZ zYIw;S$d#Ll4c`~Kz%dllXXOLmeBBDu6+4XLIUE+A{cZ-fG0^L#L!YOb-Y&<%>&7*=2D@_c|w6c5#CYg zz+9kBn?AvAPb!1{CGnCn&a!K_S zf6A-ON>RqN0K49w&loT)q`ib)lvkX@hc6vD_A(X(Rhx{SK$1nTQ5c90={Qkiq#3RDZy%feo}L58Il5nAj>t9AY$epT%* zd`Fxhrh{P0@Jeig0aZ%_uvmN;eyEe3|A%6p`IE0*)7sbUqs_F#c#gv*%ysQ zr0$7P^Hf?onr}U|ypP*4&ls>+%`(@@ztg@y%&&xs`ct6|lI+=UH_D~m2;OWL9;`+M z&}{3^=AEId3SdZ;0Po`Ie0%Bl9HDIT3DhqY3R+vyU8ULxUSvg2&jocpH5wGY*oAg~ zMC~J=3$8?Dmaxxw;}-a-HktPuhGDV)Cb6^redw@cJIk+kZ3{F4jkP-ju1f<<2kh0R zxF$!Gb>vtu>dNE zdxSyktQYLzi!%&c&tA2YGL-l&9^l?N5g1ARt}Ri_seNAc-ZF8T^xTZB-EF3($$ruF z{k50+nRDO>DWAKus|?(L5#!m+brlh?yHsX4MJwNUH^)c9kND+k42)y5Z-m9Nu12SP zTzJ-a+&$AXQ{qP*0RlIJXwfAq=E@Rjjg3+HYG-rM-FdNVsqLa^AF5*#ZMMn^@bEYN zLC32442}NHWnk><1zZb69+fLO&E=TPhqA<2je{qWA8KFaU_S1+mN;fWf80d&hR@zF z<`uC`HZ>4Bi;4-Y<+oU~NNu_rpAV`$Vr&QTSkRQk<(RunQ-pofh z#5q0O`9^cMk@8xogvrEpzi&8?izYv6m^g|*F{Jis4nf{)MVX{0SY+@5_aWAl~7P1Oyz0t%`UmT}R@E)O4MX%kcNy3F6haIwcTdK-Nr8!v+)ngTLFOlly z+8do1YLnb&Z0vZY4r1-0FGq~<{Y;Z2VYZklAG3k!;>^3(c9_cP)eMOm8KoS$poaTg zW6WRUm(~>Di|Lor&;T1f{qvcf2ev3sHnd0|C<>Gq`O3sh9RXvKsuyLDFF#76%Zt) zOBxgqkQ`d18|g+sVFU!}mQLyXpTW=f_pE0v7Hcugz4ydE`|NYhe!p&;VBg@T0a$Qm zCt^ZmUKw(>?8Dp)Ip=KV=(^c=Qr$BgY)%GVc^Tbraby+3fNwvD961|c!B6KbC~O`s z&-^>NAtq3GcS7Qml-4odj2nydNCjEQT?<`;BFZNwrpz6$2C??0HIa$Ts?qOqYnsMR zh4#6>M_Ber$Yk-5^6c0JMc2ACdyFBacem{%j%-b4GC+!_rE9|ez_0{yDE6+g;-1ol zTuNAy#R<#sXlv6?Pt2|r;bq|&5j>G3qQvOiTRjDV{dDZ%{G=1yjks@#InBMV{o2T8 zj|P=DLK&l1HyMJIK1i1iV3U{pmUA`=a3c1}NzwQG9$ncSds*@#tRl{>`F0BOzN|kv zVfY)3+b8@R4;E7PFV{vTO)Dh-DuV$?h&K`y5DylRePOX5cpky$_d6r?L@*ujXIlyu zzGkMi`;p2t%nl~p6H>TN8f!nszsM>6nfX=H`pP)=I!E z9G($(x$8FfSe|b#YQOjClg8koEbDZ%caQVH9DU( z+jCl@Ns9aBWpcMID^O{k(+gGO1KGU=1%% zBA3u@-iNefbi)dtIo!6Lyo`+z(N$xK#34{Q?G<$NJc=7P-5ZNJ5%~cBj76%MfYki{ z^1FGHrDIZ^mC-w}ElNvEB=1wJ&>scbd!7dQ@>YlwK8fsyzr(OXXk~r3H{LO~&f}l@ z2aHR5r!J#zU)y@zveRd0;@UVahnyCVDXYVmnqG1zr^e*UU94D8kp%ueI)C>zm9|Km zs*Y!wH4V;*_#2;*fQh3vb%GY>U|nA$FIt}DAK6b$r5HqM>olu z`*BJ>`vj(%IfhMApp!C7eUd2de?=c3W=wzmT9Q!(8H z-My(3Y1kRdXm{ve`<6AaBs18gdB2ia$>h-SR>NU#L$2ldT7J^9Af^j^f$KZW#MNNW z{y_%HO&HggGTBx`M?}kYKTKBT{0v%-y(A7PRiz)GFG1S+>c7p3G}GNmbDd!OZnzy7 zX^~cQc{F+akw(<;&s7KpRb_W(t1_vAEI4wN9zPi$^cnRLGGDX)#Vi|XXpJ3((YGT> zc2|s(!#ZA?_6!*!I=(pLStvVM4)V+~UmBlBMRZ_S7NHMw9@$LI%~;ZS4UE6tDBc>$ zU-N2%RXvg+xU!Kb3a=D*$?g+7)a z)g~KA=RBs9$oDRHkwvL^cQHx`|) z{h9bYpK8N{<}u6an2YL)Q7z2VD~jXUr}rj2sw^B+gr%iB=?o14StOL|XVRR9X8y<% z;8-Gq*_74rl*}JoU;JfNP59Qz)cvSD{&ET#Qo&=@*t05}9P-G^4)b&4PrUgzXZW;# zZs8*(o$m;Q{*67n;{YLb_`NVoTO(;Q`efF-E>}du?sWPErTg$u?XuOm(}K^2#bo@C z0OALd>?@^dwb3rvD~A(5D+D~+G9S$cN10;Cdnp?ohst+Hx_S}WJolg^iJk^0@pmYB z(mybBe*gY9+7GGUXQmrtNli-_-y^W_y5CZc+>MI!h3fcHaX8%iV}MKw@f#hRH}`LE z{mnLAiqYbue!i3#jTt3e#J7qytfb%}8v@(Vyv|Z^w1!j^a)#upp+}7Osliq5m!EEm zCkQm2zD|+3m&;vr_T=+fl|lZnpCxM=#k%O4h1pBe#MgMb+_&zzn|@}zIMP0<48*;E zJT7W0?&d5JmeKbxFWTHd#k-rjL%92P=&S{;vhi%Rl z<1EM-}daOWMq zOx1-((cF^yG(D>`9z2_&F)897tt@uLWC#|0MRP8kYyCbSdz+XyF?Mu;?u|iii!+YC zVLK7LwJpjGgKs_eg-4OD%ZSRjk zo4$-@&&@R$6*9^4ihq5|D^E9CIg>X2EF#HQKP+o1uPsK?p1Mb9fkH_4Acl~XxB9zs z93>}??G*QA2)R5fKD7k(s9&~p+)8YxO%vNNd*4;gbFJ1hslD=zlN{3eSFJ;xWQeHri`k~A5&w?%o8u)e@NE0gGG#?NC0l(pv5es48}R^yK*VI?HZFwZ;-QTGS);1RNI)3P<}@0O^u zy&c`qvp^S2ODZDizDNUVk`YPbllu@+5B(Tkq7^R03B{0l8*_4vHK&)bNNq0(;hgY; z(!f7ao}HedHEjsTV%w*$uWuI#GeTw*eGtD_68+(op@)+jCi!YI(|N|`TQr!+S43O` zw6h2YpT8;6<#zV9@gDl#==-uKXkmgMvvqVYz@^|9AE0enyMwgf z8%?n7S++ah4UxQyN3VL^;h8Rtb^tply=lJ1`QxS?@6tCO>HS%bQyX7)8igl{(CmtF z#iQ<+T*S_k&IQLT_(}CguFhBZG2abub{|Uhc@whC1h&CUD>!X6@sMcUd_`e>8XRJy zP69*~AccsE>Z{dryjq_kYA-40qSlJ|7S|}g#Ij=?&iHbHM)S5N+J4Dx-Lg$zEVV=M=exoSzNMGoqz!sk)d zg%3TQt2ntP2TA&!D=%8t#Z{En2Y=RM9Vq)Hg*dNjouur??cfbk==!*0=CVnC9e^L; z_Ypk(#WDLOdLA$~cmsNbh`mxW${nGP(y}DZ}e1%nJ*s zzROEiS#)phjw!RU&8;G|@~fv~24WVFl-!fzFO6l#C2jiD!>&=mHS7t6Q`h3zRO{aW zQsNHh*N}0^(7#WYj(OH=25%i_90||v3v5_6w|M>CGF}^0dkO>sZI41c73+#P+g`8O zIe0!r5+et1%YD99O(Gv-osbAT>M-vrDqWP{H&XP@_f{C6WUu_e?!}=Jqf~8htLE@e zZNZdty$z3fux#M1We%{-bLX;^3+ks=1EA+@-C7^5qk1Q)dCqRJ_=p zIwSEr;;hbIYpU}{UDe4<9l(1@+LjEcne&EwWD-1;O;*=8Q6y0@N|!C-S7Bdd z5_i%hq{4l7H6Eq&iF=PUtMwOMSjZ%Uv(G@|2VN&*z)NzizQ(A$n%T^~s)xrmnnU|V zIk$<5j>^+z*usM`(p<#U#*kD89quJVl zwL|qxuW}VoXkt=|EULV{u#gn=&k1(Si)70aI=MXK&u&$@lzqv^!%O(!dnR&eSS`4< zy{`%=1alad=o2;lgE-e&yKJO8WV4U2h_+h@=j9*vtU~qd#CxdXX>*K?{=AW$O+exW zX>?fNGO|t3!?|wtF3O2sUq^sr7vdmjD-CVoensgA*J+a){K96PD>L^HFmapFOd4Xq z36rdPX>D9!%2h6MT5ap86=CgGKkw7lqD4oEr z_gx_?;~r{8uI?wla5OoIzGJjd_PMhXF^&Zd2)EcBJtu3%d;Zg4UzvHKjoi@yBn*6e zF^&tFA}()K!1i0emE@8UQybpQUZtuOl?Wovh-lxH7h-KEE19K5jC}6bwI1?6p#7EOoBW{XUI!6*fu5!xD~Jl=zJf zuu7^Mztdwi?oi2) zmk)hOh^a7ufIYh1Sor#M1gtWp%>K=s(aBL%DA_x94f~d%$>mxCJY1$ItTkA}k zdCbmf%gE|~m&nnf@Gl6)8fsaQJMlpAE`B_)J|FSl;@C4il(W8(J8!{E zj_b#mFO=jESU^D>p*h6+ufwe`3S9Q6wQeT&4&6xIKr$3QpfAW*<}BJ-=%{d64?|&A9L>> zjtCn+`Op5|$p8taY+F&pW7Rppj8F&SmFve|AAdgb0my~kg^2qS)SsSk|JTA&Flt3a zG50P2(3G&V|L^vi_aM|Fk^2L@J$ILxzr>5eO6u3YJYW8(w|z0H>;cn!oBXPF+O=ll zY&kE*J~`E~`*!gP9oqku?UMLChK=u(bHaaB4VCHu>OsS4{A6AW1t*{j)^mg8a^9#p zZ)_S|$V>t*3FG+~|9_Xf!TSCn|E@&x8{zmkAFLvf2+;c`{coy|I!(lzJdKQWBgZas z3oQzAng6OShcJOw4$cg$`He7sshwF{|F1ZjY@jZ7c1w>jTmgFl#|-0(vhT={_urJ+ zQ~(!Yrk?}~Qk4pDM3HC`R5LdJvb0IaW4zx)S5%J~{=Xt3C7^crQOp=N=j-*#{|b&| zfC7oOUWBq(V^)nZ{fg3{(B!MM4DC8MO&j_D6$!Mi5~3If={nIQRDr{;^S>fVfUfVi z{zCSDoq+0P)5q9VE_BaukXps%eYO9!0~s9v#X%m4{txr=&ms&_UCj0MC;JTn0~k|P z7#Jva^^@%X2thXn20mUQeGe7L7}VeT^{URoMeGUHzwvVyjGsTPKelyKStf@RpepUTTw-+F{GCWGQ<~+{!Vti9Cz%SL3maDVp zdtHr#=@@LOl6cbxfS@=s} zm=j>sZPiTHkA9tYo#Z<0(`$|e1c5i&nFXb&GYL%|^@#^_?^5jR**umxo_!KOK+0nG zm7v%k{9V@R9xM+w%Q|B3`|L%`pH!hI0vLp5G@uiR+qwOA1<(%`Ky~nTy1qQt5Pe7R z4QLTl?s^~mq?e2%czve?q}4B3-uE>4T>*rUEY_)x?Rbai&NcTBgtBBPR{jU#^ zA^=J@u}(g%jH~&APWWyF`u`XxksSUE+-WfnkMw~kEhMPrHop~&3=To*bCz1s3GeC& zupeq(58RqIjC)a{JXrrCP~xxjZq?4FH=-m18~VWs%y5D7-*Tr0 za?L=A$qbs;T7;~WK0Xyrr?(kVI74rCun}}%zQs4|4tf( z$oZPsCW`;E5e%rWZ|<&af+OZ$YsvHR0iohhsoStCu-I{qUxy3(9#v*AgWPw0*0nbS z4_M(OTCL#Vc(nJ~_1V}!v$US3f(dA$;8*kIf!RZi) zg6gXR6$7$8|eI z6P*tt4e*p0>_iDTiT?5rpwGgm7Ttin^Zg9q8s9dW-V(v2D2nnxO5ak`^l`$owJ>`N zX2*B>IXS^%;%ToyGRDLdTTx7X2`3<;?hgEEIt9oGE17FFTszJ++m^-!^3o)CZS0m+ z+T8)`R-8qwS;;xi>Ry(VpyLA+MS`Rxk4X-359(fx#I!A}a-wi=7&oAioh;1-oGL+> zji#w_pbCAOWa-6H_=N=6{tM*$1C*{V1)oew!cp5)aF4RLf1~bj2Q3qmnwX9UqM)PM z%BB-lws95F9|e^uz!uj2n<&9itU(5sXMKZ8zpFA~P{1qF@Y#>c2#R;Vbsq?t3kvKj ze+czLaXE>OQ1Zrto`VYFm(7G;bLjI8`#@+YTsP(>b{(t2jUDp72PL=v6f%5UD6?a` zEB*cu9i~k}(l6FiCYWE22~^*mS2_VqW2PrC07C}wmK#a4X*umN;qC;(#W#gJcJW4U z*K%{Mh%E4A;(7EH^keIMTZ7zH5w+mx0u#fwfKtz#fkzH%H|Ae$2oVJ;Tm14bYbeT; z!rX2Lp@t98l1>ahZ^NL(!w)C)UX?Wqz===^czTAClM-B{7tG~TjJL^NbZ@Xf{2F;f8Tj>i@M<=Z>Dr?7StB2I`!7N#oH82@a zj7S7KwDU(*ujLGo7h0RVb1P$`85G?p8VQT#(@-BT@8@n{0y|H$0UJwTw5B+9cB(Bo zqUa(hXv#Z>j?N}h-&5$&ptmZ%9Cq8CaK-jdljo@5ddznFi?bix0=1%~p^kbe?B+M4mItqzaMA zI=Nws95~2fX|@#m2Uf%O#6SI-4kF?KsU2_j!Bi`;M!`BV@KYOxN&ouS6FnF8W960s zh1!ZCWscwzL}TssVW}_keUDz1shNesPAY&$D5T_$s%vp075!b8O-XDXoQ!-RyqC6W zKTA+#?18z4?9t6hNKfcs_JclllnUuL(j$d%&H;kxDgjn|B%pK5DmAu|TtXXr+IMVS2HKHqk=;vVXa@;TiC~wGE6m>)iiR~`9hSO0Zc8AV%oqUm&7 z^nAdv<;J*m2F=9!MV_zJ_dn9Gj!3{wxu3@5Ub<*b+aFZ+URx-nWGAHk1?hvuNdETcq?ZJS zsene2rZRUF9bu6$M{yDD*2wta@?f}wUbT~+*k6m@k1rUz6N}%hWP6Dwmvr)z2-@;z zS|X~C6>J$m9+ANB@zoQsTSXfh49w3?s!>SHl|~cYGCYPqT%*~jVdD9q8d@d|dX@9;zojcObM(PJmPtmPuPDD1L z@TX1#4^~u@m1-ZEcr;&wxX_uv7?4p!Hw-vX0hU+;3N|)H@M=X0% zPc|F(Qxf9Ofqr^^-MZI~J{MAn28!K1OP5!Fgj;U2^dZorFnnt_mUBPW#6ScWbQtT( z_+P%}?Bul^%D-b@NB{km235GeW+chG_8^GI6ff6ks$EPX9t+=xc)*ua4PD^!C~Sz; zrhpLdD&Pc3tqFCA#W8V#h@j0b%>j4E&^+LX{eW;cl-G=>Fy*}@sra3J%(_hxE_nnt z%xm%s_GtkJVX>Yc9|MZw8KiYqZy!*?0X2Xnabo3Spujt#ou9EKwXe*W7sa&en(gc6 z-?1rPU9)V&??tFDpqOR1?YeMsBc&nfT=z}b{??B*4eTfzv)bR;6SlK5N&tu22J7V> zcW!Sn5HM5{Wn&owCfPm#;dxmZ?|k3~%O;B+;I7r^kw2De*iIiyOvulLv8Jz*)ulv~ z&&H&f-ES95KdHgemGctoC&S!7A^32=S!?#BTUeXiQdLwT|6VT3sFIiOiNe$Iq@n51Zz$=;L6mNT@lO>jeT(5w0PvQCLhEcQ3IOe|yjugmquqVv;s?Q_Xzw-jXiSx7a{7ku6FL7tap5;>evgoN0J+8^LZ z=$>PbIlei5)W3+@Pw$Mjl%)MDjsfqJ6HC`m6|h%*z0>OQTC**!i_>9sikGxBj8?kZ z&Q>LwALDcFf~r`}q|m}q5m?7h6X2eETNK%t;4&8l${}Q+@C}eFHibZ-7-FJ&S@VG} zDQTFa(A>&wa+#p{X|9F~7G8PG8;d`($RaHoPTzRhFmQ54;3)S3_!3{|NKVPQbX%6~ z5=~E03+?5qVxV>;fymx$h3Ir=oE0B)eEHH#Fre^DPJ&FO>7|WK;<4e}n$Zi|y+!*u zlWL*z#{+K7m6K)@l4y{2DoyK%cg$3C+5km&#^9$%=JZ2wY>8b86^zVDTT;$n#^s}R znYIoo+_t?8M5#X87++|%m36dSd(2LD0(Ij_7(;slSr_X?V#!@Ql^QGTbOsYxJKQk@?OGk><(+)w)= z@D(6nSYBBPjf?BmN8E3&d*el%7&Fl3UBY9LUAsgdtxjz4q99i^Br`rY+XnJYOibCt zO!qBq;Xxqng=w#zrW1oEK7G3c|BMPrdQrz%h&oZQ=2R|TM4=Yk)4$)TRB8mgVV50YX9oO5jWQc1^>1@(rpKIt9ElY8j)I(U=?+Pm6B|ojHEF4X0 zVQ1xG1p%#4cZ^vcGDM_^=U%v4%R>{^-(M+3KQuFL9pl$Wb1dxj&}O9iUY(}pBw_EP zHt$zzb>$ERFsgAuOJZ&V)H-t?6{@LH?1Dhyq1S9uyd{X=ak=djXSLE4wx)!IsA2DmLCneW}JuB=EVnXv}GnVaUo=f zfO;BWLivNfY~n>Bvp!qO9)SYB0S?lgL4%XqgD@{Ri{WAE+?{t&fo)p%E-QinrftRD z>2K!m6V*R>^PEnMHB+?Pj_-l>oJUE18clvK)`*%PL@)To$*l2v=s^qTcO0_ia5-4A zjNe-&)_yC-md%R(Sb>*vMfLX0r+<{jyVV$hq1=(JbKv~C6iYh5+&x}7C?RI{R8sO{ z)k!?gA^k9>Mb|6UE$X1>u;D73_7Z;DM(9Iy@{?E4{~`UYq&gXHbOm|fW?F+I-fjdd zb(WDxuZ0OF8@M7iSEg_1eDu2W`;~wL7%KGM!~NxH+J4Sf*^|0UJii%uxRJWS%$mVKF)ullrc2eDlj= z_MMQDzG|gL&pm%8mg{9X-An7@!-z=TC~4r5ScMp#f|h0*S6EWtr>m2Aw3StoCCFNE6(p)G?-!>F(81WqT|#2N3c}so14}$D~;8H7YH$ZtC@5XJ2eEmwkBSdroD|6 z8dagwtr|(W0~Xv@8EE{ODMsMw1()a!yK^x;3=h>n9P!Lqs1)os0pyxZ%&;r%frCs| zrH}hE!}-}3Eh-<>aR~iVVLqbPC{>bWw4>tLWuX7=`Vu|Z^5@@HAzT}ZYKkO7Y>y(T z2Hx~Kg}itId#B)MK(N&%AM$x8BSEl&aL&2L9VCU3IrIzk7qzAHPaG)L(<`$ z+PhJIY0#*K*|?>z<8-DBTb08J^YGM_7>q;zSf5!Wg8z1(=y!9nbb(Kgve=>9J1 zYzzxJ@-fRULE*XnCmRgNjAb5YPBB1QJm2B*;~{N4BwSVL+;Td*H3Kvj+dE5zoakW{ z4?A~@7>kGkO(YH|!nMc{cN`iW_rZRX77Xy~641PjoQ-0y!6CwdFK0XTebJ~@In9Gg zU8sP)W`c}@=;7m?Glv(^Mof>c{x~=xPQYyZ_+`b~=kD@Yxm% zd;`ga*Wy3=(wv4BZUC~cq(b&REm>REXaQ%N=#K?h)T!-aO1qC4&eFe1Iwa)K-k=o+ z_#q9G{n*6cCCZ6=b23xggZ1v4#J6JjmceU<@ZwZ5$*f2W8@Dd#$Xjkdjy68&{~kC* z;xCQ0tNN%^@DqXzK}TCmuCA+LL$mpG!9*5q^EKx?NTz z2^NkX@CnDL7z?IC)p8{ZPBoTKSr*&YuANbPL8R(svQ=dM3dD5p93-RW# z-bRpP?~wf9oBlj0PVwnfcaJeEGBz0n_kRry1dB0ER14x7|`pSMu_-kon? zn>KM1?2gtv?Z+f(#i`na{KllvF`(v!3L#}`ywB5TRfAqogsaxSI}zy+Iw5iWezw9j zA7XjgTfNwpTQ}`+8j-l?=;$dS(L6RA)cv;|rh;e1t8WQ1LBRH7>g9+wj9M0L?D%B- zh3cOd1EDO^%3mQ#UoGfKV>ol~eoixnGSyUb8ICd7b^P+Ze#o94BKlch#~y^n*z<~D z>oF0Q3-5F1e6Mzr@atEB93;Y}3VQ}359Cnp&}3sPlN)n#|erGsOx zKjooKqp)sg^qG(=-k-6xqpBOUWLj3;gXSM3y3oeAQ|r&S8(2}Ott3gmDAZygKzrm& zEDgPy0V+r`=ds!&lGV*gxHSaM7!i3D$k&Had+{ArN+@r57JBDi_E#+BK@=6Y=$zO{ z$B*x?7^7re3r`y%MV0_dXmNMs9#&ehUeo#$vxiq9%mY9tL+-GBTARVe7hM_=@Qd2k z1H0#xN*DcBB1Cizz{*~KyT==@iHFbeTBv23ARY;+Q`#3 z<=tdqZ|Pf)!%p6S?P!-(IlkYowz$Yt>sqtP4r!K5hG-9d+s9EH#!3Vx>g#7ySxQA| zvQwxB@0&qh;LMo}{VG2sLKp|fGU_&t#N7dhg;%rHX}wdNQ{>8nsC|9J9z~`VB-}sf zkT7X3r0q7Q<*swqRt$2*bf{MUHF^u+@GSgzczxuJuFm3>NI7vSzrZ!?v66OGrEc^W z`wqv6^tImuXcES~`80wCftX+%?ouXs1P7#9$H{xJn~CxSPe}jMuU{tv-(rPoQ~lfm zg$p&}ojSE;6Q22;K1ZF*ZHzoK_h%3g;N+>N#kZ<)kGP~HC_0(NeRk50tye~{6BNZJ z>1BayIS6*1pLdxT7}fyuVtM*Y8}@<~S-RnA(tWzU1!5s->}0ppqp(&w*y_~PrnMw4 zjiTsweumH6)z;y?8_3w~U+1OMlD!b8ay=9xy5p;XiNuJnN=qX1-ru1he}(2IufLj) zG<6r$_^}=(g)z`vRykJ}--E)}ET8BQdKwF+`5ljzi69OLUkyE$5#y@-&Nu&j0_pBe z*Em}wIbSTP9>$btBb!qnN?iog2^8q52kP>d`WwxPkO^Y9o#N!WKPkX z@!1F4HFsaY!kdg%{l z+LZqeUo_JFXeWS0bn5^SNPzPRWLjMN?dpw6@@!~u;J4WAVhNvsjX_CNBC4I+$@J;G z?(0MDjiJxND>P00;<+>X_6A-yhG$ij8fjm7aZ+28sN*Yu+Z5MlE~?sh9aF?kt3oPg_<*bvgC z_dz7sIQFMKF+AAs8a`}Oj)}Xi|FWpOJLsh;mn}tv*W4%ngd_x3REj&ywY``8a<}qH ztXn|!3ikG;6>py-iV8S0|LNQ&$$iX2a@g{ZQl%@=($sU{$<@p1<3gpTVXr^Y+ zA#T`vJ!+b-y7#W_GPw5q_=DLdM~&T#Cw~o-^lR;i`hv|aGSO>ruH&&H(m2@{*)yZ0 z&%uC1hn!*T1(`ogo%tdQUP$n|fzr?>lZdXqH4~g}vop^v`t9#o1~9_<<<<)*i#i*b zSHS-H0ptq0#hH6xrg2d~40FqS)d2QYRb@mNzX{k5bn`i`2?%fw>ef6t8Hg`8}#B8vWbAmS`GJ z8?j8ogL{qnzH^hER``8;F4Zn;v&d#?n`=^BQI+4oUeDcJ7k~XK4WSw=J;o9{9MKV* z?+~R7)dj259gKd1$yaeh6AoZ+i~!ns8Sf~^yRYp>u}D@VwLwM9k@S#elmr?%VTe8t z0(!M{k3XL@oo3(f!EMNr=Abb|6PdFgv{edcnMX-7K;$8o&wslMNE?5#g>2DvBUvT( z!qg)fYF57X`=Y?n{5AY9#eDOqY7X=l)Ga8=JLMS&;FTubGMhO%>JOM7%=w{+MiFmj@~@hEGR;yFHL@M0TOm!m<7Hf-W-wR50l&X00oyHI{vEX)(2a{K5h zfnL{^qA&h*g6cb^W(cxp2Bgi1CMpmsiB0#JiQV(uEPoEto0CluWnfa6*j7?mNH9Mz z1I0PIg?fogn!hEW(FrdQ>EG43o&#?=(*Un-h#6P|FD1}!2U{%QMO>FJJ($Q^(8D2y z@5!U?q>%Ma!En;QbjTqDpplQW8pT1-&yur7p5~)C;aVi~18104tjNWDD;2nkG-6#& zuCQEL#wZbmx~9eEMdPP7o1NU^5-oLo2qGb+i2g3lgGegW0n`MG`LUN<&lZQZvH zm>!*x!?!@}^2by(daC4%S(e7Ir85&s4`V%4iwt2SxjRTk0PHemNSF9?0@@+bGPB)_ z`(SNfwRLd&`?vOd-l9XhnsJsko_6zVi^$y`$t&K@rOsjeS~si0WBw8pc)Irv2q?aD z&iI^fk%~8iG!=<8{m8onVw+{p0jHSoJV_WWVgxnaw#nb?;(JGqdb`QDKxV&oY>YxO z4F$P=Q7lCEP|;4)heT-AEt5Jt1niI(+f&3iBwUIOb^`arfFJU`#59&zS50WoQDSlV z+A?`)o0I0g5Y`J0!>8GLfE&)(O=PJ%L_upcCV%}EGRK<+Sqr^D_DpV7@jNH-_vedT zY3KM@zbN(vt*0A=^~u+3#|uTb#2|Q<9~86uNjVQMuO`{k$8yxVJXpk9^>(ns z($A~pfgCmFW=8Tk#PT07*SN2JXm=hAa5waGi&_8q4%Wj>qYtbX!j3B|tbJCni{*bz zNbGGw`V`P0Fg{96G&z;HSK}4Te}#8Bp}a&$QN#y`=5*a)our>0ew5KjB#B+}Qm(t2 z?{VMQF}iU~es1n~5H{)5Fg4u=#}4|P%lf=Q`!9{h&8gx-4l`2*2RpN~0)3BX39E#@ z`0%M18k(*mGg%Z#pnD{{R`fiF58WQNlATO>e8s(+NB4&$s#fud6eB(P!NCwnYl>SA zSUwBkT|78(za{m=!P|gJf{a>9TZIP;w64gZ!GVB263_P)VY1<$h4acd}kyN(VeCDRd?V-&@t- zRbvM_-3teobc^;odjx)8qLXnX-yYbYPB>Ika4i$67Mt?2HdvEEMGg{#V(P&eG(X4a z!+dFG@Y;qJTmC0@LMk$J=}_u&n%ktI*2W|Sn_j-f)_c|rPeeFfjGMh43>&u(-5z0_ z#~3X!-pDI^IT5B{fO=`vwxU~Lpel9o9(d`)??K7y%`4wg0gtGo$E{&OQdF?2N_b0* z*(&z>`!v61_m^uV%u(AhD*}C+>z}@ruGQ-d3w*2^b5T@X5vZ`aV z=RkOO@kg1`K`Y$8BG=&5G?`hAW3D z)nPLB{4*^CxqFnAH^6S%eiFNTL@X!^zDZ&rb*@`>w0U(*r!#jvtS-AP=pvjfyK`L0 z?u7?#Bt_Q?b9T&jkyOH>^FxD%F(T5cs@X`eQU5~ox4~WA!EGCCEZ~C*IQZDNy%Cb{ zV`QLJL=|BdqbemkApl8j%mgEmo&z}~LLgfpJjyR247=m)Ou4O{c|sOj)vNIMByYuH zVsJMeoYiw_-Ho$%<;`Zrq!1+h;Cr503NUp`RkyGJW&>0K3OEr_0#yU#ZG(@mxDZ=d zbnjQ8$h)5k=q)8Vagt~)Y>lK#GNWOw^Y!;&wnt*6DH>F)@&f0E++fKB3 z$@Acwr))wE2Nl}}p%^$!o;tR)s0V99Cu{5~qwWajJx;OZMBPYg217t3z$N$ZHq|F| z2=Y-B{O-=w*I^9l!$<#0V){%lf85}IEC6UQE@cfW%$!?kM!3^}Mtr0R!H@l2W+odj zn*M?jRliO{sX#`ui{}PKt9_(sQ6>5PYK&5XB#$Y@m{45;fmM(oquX$NDA*sv3u|}9 zZ;C;JW%Ii8>~Le8pAP#hmIc+2(l|D+<<^FBv3)T8RM7;`9$OYvOI5SL#iTG{sx_#x z2jJS&Hw0wVf1|%?Sf-ZN65|FVqWFjCu`Q*x^x(#2l2B?gtvuD+0U76kiGhPeXg?rB zSIzQbQryp)Q(b(IDBlmFu2o`3*mC{)^2B1vI`-)P4^-7bDOGu+V3vb^MM3WOP&HM9 z6rUF0$0QxyGrA^4!yg!3E}~og@}%(9biE5CQSRuU{m~)VxIS{|S=AoPt#Yo1f(C)n zA&3z;0Waj>|BMoXAyK_3#-y+RPkJYhJw& zOdVxFeZ0wxkS3X+vh9hc@oefQy?Imt{d-AYpV}GLb4X`i3$|Z(_xQ&wu_g}PqENFi zvKu2H!i3nlKCXW8WP9^nCjV!2&?H185DaNy`>Ai;1@vo#U;I%$rY$9{@dHnXD4y&N zC{(%Qk;*toAK`jh6G=noO-z6qNJ|t*X9^5Sav1Y}Myw?@OITw+oxEo|0EPwx7W)`{ zpd1fxdz-<#{S1l#uN`u%Z#AfR9yZA)LC~ecbkom~u)dER*1(xAEwCuekOhLLGks}I z;ClM%@1GxGhTiK@;1jy{vXH2=k$0bSe&Z6MMKyip(27WZDJo7W>bQ;;E)O0CB}2Z= z07oQ#AK9OyeJ{dR`8WBL>CugI`USyZ5AKXZCSwU@xYj+^^GcZ9WB>eozb z6PWYR^Jvq7!i(UhpfG4x1f}q$%{wZ#W++T*abqX3q@n5MSV=Vy@dy4yG~?Vt+4ln0 zQAidLHLZ87!Chf#);rWy-VR8{4X^0|5|097->AM{E@x9-_yN5C>d2C zHhRR)Eu5g(8xPUW4F1Sf{>bO*L8#XvH~J3ECPx7)rurzxHSAf7k2ls!#g8bX93h44 zm89A>X}CJ7HZ|vWp&E?}CP3}n@eaQRG$+sF5Yd~Pb0I#Y8{!n&{LI?KAljdWK@s#j zbfs@ogdJS7rCr)&Z!96S$uF<+af#7*I2jwsc{>|1s;|)eu^?QZa(^PuqNV6CVsoy(0a#szi|^h&-d8)H=4!o|Br}n9QI5d|o>fLJL8S z-$xh5bBN<2jpqNH5-D&T%dApCC>7u$071ewc%JA{K1ik*3|5D_-g}~e<{v}?e_B(N zvOPc$js45+F$Ky8u|c9Re?8KS!umH1VXUpr$8)bNKJY`3`tVzt??y3=8(fQvflG1z z`CqNlL9KwFy!W3$G6ncyD#D5Cz0Z&2K6AUs0h=OGmg+aP9bp}wCjBxw^dtezMl`xp z>}M4vhV)qR(?s`=`Q50N{RVTEUIdk*G5ODk!dPzlZ2NaP%i^uzB>a?>{*@5GKk z`wY$8q{z_Wok5x91tX%32sK#jg8EuReT_&?L(yy)j!jrx#^Nb4WL(PsRq}W3ze;l3 zKe{n*ET$AN>{c5f=eL-i4i4Re5n(9<_f*v&hRzs360Ok;2HoO4_X6Nz9sQAZlQkG7 z6c{K=34CloJy*FxADTVI{y(&X_20=eBaxk9he!;3< zdz|hstG)DgGK+iBq~UpUM+OW5oX66d7_z9YmihvM6@SVT)hB_EUkF2xWb1aut3}UR zW-w$voyE$~Xy_0>a)cDmXSe3(RT7=3?mfdyj=8C;y3|GhJ5gVS!J57Zuv8{WmqCy0UBNnGfO+<*EEh&Ue1C5=+tfKn>57(HRcnBz><=o&?3p zqT(q5W8&y=oAv&Bmkrg1o;Z{fD8pTCS4g3@)pILe{%3OF!&PkfNrCMi&bt>!RH&&P zs{!TflN%JgNlx%Q9lC0KU{V$vX*{{MXAufP>xyoEHyx7%b2ihdd1XL(@*F>d=MWFL z1Juyg{TJZ5$i!8L*iu5nxDclKlqVx@7$nf!Ada>on-@>>+di|Os{0v*W9jzISs)cO z*W&3A#10I{>&0zOXvW@V*lwa4 zn!trOSu!;{+85$X!~5~oelo*ck754tL`eCly!u2=gV+L2wx5dvBq$$9w+TIyKwP4e zVf|XwM2&qS6$pm7;EyKFOc|Jj1$IWOB{7=X+(3lhuO_v)DqT3G*xouupFG_uMpa&Z zK>EbgBTAwF93c@_K3WP(aOJbl2!0Smv> zc)J`e@UW*4H8ZVN9e)kusrNTt0+h%Rc5o?G*?rKFrxZ5qFhb_fgBm-O2hXvKc#a>R zY$%{A7*8bld^jg)m4!V_3XV~ws}V-RY=qQ_DViqjv(M80=P8zy{nX-|y1G(;HONTK z-eSnFQ*7*{hn{mup*gp#otRod4Y7=~rK=rd?-_6i@H3}_RSEX0dWmpXTEo{1b=1HG z5lbp`CQoVNVY*gk?|4rYj=v4I4K}B@B9bwXAuCr|A{`B)sS(ig8P~lHsg@%2)fCn>*}y9 z2-{}@cBTofaB)AJI@dQ=i@yPQGYwzu?9ODst0{gQ#9K zULwc)#R#lbTT#ki{r+kJ8XVhS9}7fA!F-lEq?$a=8>7Yc$&CS-6N0f|;P$d=Ho7|s zPgFkdjqRSETH1JK_-_d!RRzO(r=Sw+MTAxAhbix_GgX};rZd$ssn=`B4@LA&RALWt zJLEsYkg2wZZ$OzJ^=PTV_=q*%>qu){!dH8zr&Qm&@RSJP!Q!Aybr<-cQOL z<+uXUX9%SSJ2!it7YIU-&)0gHY$Tw$2VDvR1@)f+Cv`ED~|6A0d`8Q#Z;r$vin88%u zWGkyB9;746@e^*>iNW!UC3*w{p<5VIWrP=u@}n1Dfa^rfPCcq2N{XG>P!AHMd?e-W z$cQWVi~Y{tkQ;{&27)Q@8py{UJ3W(nrazJeOP2PR`)?VcS18hb#c0$@$8oRl*K#^` z;j4{Cv*A0o53f>d)3{If|H%68aIW9Cecn+RP&=Km9yZ=T@Z|YN)gkzayIW9d`U=;E~vIpPt*&mHm@LQH4 zQ^V);h}Gh4AW!$H2j-t9Hf`hgxk&$0^(E75HR{~X&2Euvg%}S=u71nv+j-Y=`}VFS zEGq2u&Dpgb8h*pmAg&T|21Y9t*EX<<<(Z<+Q1d^mr9QtE*r}~+>5Yc&tQ3C>w&C>V zBT2(1kECpaB`vF7uU+@S?D-zHMNH!qgC>(=jhT)|r(c}sU2^Y$H=V^jC&AKjMe3ZE zb?LsD2b+(S<@;~v?^M4z@k@8rI{!RMaO(FN`EPOx8rE~)uC6ug*QGS)x@MY{24@#p z4Bn{N@#pbMQa+e%QD0S6WdkQ~kW?vacgI0{Hf`+VdhY_h>TsjiP85Ddw~0qCNN3>GH3o^s23AM+ zz2!4T52m5RWd67#-;x;qoMRcU+?mhEuU?7E&|~~_0NKYCO;P{W<+|E?489kx-s&2? z(i8}K=9iz>YCm4d4~-etfxX$?8pCqb>fiaMaSGQ`qYk^A$XmV~Kc`>8$$hWp#jxYQ zS9fyQ)5jFO%U!flo{KUm@Fct{S~YjFQ4_&NyTohx z&7`||^lW!k=f>BTv{S6vL94|}aZ$P2Rt?^S(R4$MBrB7B)mT4b-2di*EBH186X+LfZhFeWbz`yAxzk_j<`+ zQ^&|8NinS{kpAPFj)7w;7mQyrv@#)<=IV;w$^AGTL<@n)8tz*o) zJ+k6Xya=z%0PHH+m7LGc28tRb;Iic2F}deb^Xv*qQ0(bN^(J0DNvZ|YgCCs^l6$qJ z99pT*jdEYkK(KlV2J&mZamtBEOz=Eii zU*DY@WI46i#{Ji1*t(LSycvy;-^CF4XFaKG_l{D%KBe3FXS(>;>lt-hH0G^IoBYPp5G0-_i5LEZaFg=-j0%iNd?hNE4A$=Rf^J*v$Y{ls5$K0t-U&8 zZqIHC=p<8ej#l2OH*b+}wik?jteMXLtKfCISsk177gKb6CD=BkzS-s6c?wr>H5Tl7 z+cl4JfGKJicqJ@M;XAse9=59%OwG5tSv6JFCTr8;S65hV`&)~X42|ylt&wXq$~|Z- zyt$vNoonT`kIx<(``57E?%aOTTkls?D`SmGi|gf*q8OgmnzO)kOyP83ZAX|T_Z2a_ zc~LW3EDkI4>{)p!GAPV^Wa7YiW8Kj71ZvQZ(~d?npG39VLTiWIw>Df1kvUimXe)haI$ zK@uA)C^3yl`n^oY9j6=K&v1iSjFou zajRS2ViEEmc<-)|x$@R)z-v)X(e=EOtIj3dd|EP8@*_0wVM>Cyf9tc)Xw23Z;M`={l^r`;4Q)OM=3zj7B@tn+JTU4XblQfC=nsYb#{TI7N zUvlK|2H!Y#4!q`6m)DObIi7a|6C$c`=^4!$kEM_~`o^If`2z|@&wYfMjh^YXLDdC#_bcnwDy z`MX}#=b_$xXB;G=`A%QXY&3W*bV|#24!7Czyu2{uK9=AzISp~H$7j)+WMm!AM;}eO z{i$wMX~a@=CZU*wjfo*Rz*HS)tx&(Ba++|en< zRai=qajs7t)!}x=-@H;b7UcF_$06;OkOlN3wIz22W?VaOz5&#kIZOC0S`zbdW43Ug zo}L&o8ZZz`M{xQ5>}kl5@p`&W5p0dB0@}J^@_UN68Tg-5#*@Se;iV`db`wue7){ z+1}C{J~VhCBJ7Z4&XM1k8t7mx|5NUW(QNtY(RSSAcs2VjeWT>#2hu*llGcr$W6i&IR2pa)xbQm~=(jljs{R*d${6>| z4C{Kpg79S#g3R#+iA|)=j1mi!#C;wFOWXIF8TAb9&!flZV+z9Q z^mk^e1>umuxL(Xyz?ESJeWhP`wOB5@SGP%uL@3@_b2!t^NZLx2 zpB`j2=|H;7gkiXhYg?`8VAKp}h3{bjgTNbUj4<3axJytql#vAcYonER4VO)>BgUN^XF+0QNxehxARaMEjocWT*Hs1 znfd)*|LA|Gdf#7!SGckH(N@E(WUt2q)R3K>a*bP!RR!)kibbrH|LQfDKV_O|kg;X! z)~#bf{mfWTenEnmsyOr(V1sRCm!asnj)>(C>r{*WRLR*mS{Gk4p)4GBDmZlrz34Hy zx-%a(zxWJ@ZD$~VCZEwME%(R^<5||maV7DKgmgni!cM1N^Ek4FDJp_`imv8Z{U%4A55kY# zUWG6JIbevf^L7T)|1Fib0e9@EX`L8XB6%QxY%t57-Y=rRch)>~c}Ab+(2{>BV~k?Z zYw;!POz$OwKBLH8%Ec^b{+F9|R7CWUEM-_vGST%dKn-_2?&JvgpP*nH+Zze{wRhLV z-@jjywXNV?WNt05WU^^7#kx5sgN;{WW78(xmS1k445_+bpC5VAYh0tV0BPB#-M&r# z-*fL!47_$Yu2!*i|84u}(Yu5Rx8;=JZ;?TJR1D1c9aoQU+4G7VC~60IAK!wTar_h} zH_BaWZ+CjF{1~=#=+dSelTx?!`gVmU?@p9Qf?;-QQ~orD52}vs7S84*+G5UK9^Q4y z$N%&Fa{5*7A1F=dvx;dqy7OW(z64m+C0L^DyvW&4DQmHL4&lroY?t%J&HkbIfA(3y z3_^fI;thU73*!zx`e%lc8J<807wDmNrD1g@eyuuSLJd(4L!ZCskDng{W1AlEPe$Jr z__OV!o_b4V-7@^)32E?fp4)(4)HVH(aF1S@>cwk?O2>~^e|%J_%MRIrtgfkPsv=?2 zpabXURvGugiu4@An`7;>uOhXJ- z%P_X+YEjEVHoVBV(Ow?jm;d@C9fgfgDjfkNH`KMK5%(ywMXX5u6J30`xE^gk=?hoz z$)ul*tji^A&nvSWj&SX3i3yTZK^IkUhDGK2&y@E>9=-Miac#v3T`me!n|cweok-v( zN(8}R8J5*=xl>QRThjG8TlExI#T7^F+b>glru+AYprqI%{~zDKk_{kMnwh1SyaAt5ZNUi045IJdGso_=(-=8_}% z`{2?HL96Dw4H}`3j2`AaRP;$b{jssgXTgjia+YXQ>gk*RCuaE{^BMT@uIa%h-7oLb zE2Cpx-M`2U=zXaNR4jK@l96n++FHT``l}%_+>e*GWThyJvah5o%~}{&Ka8~8ghSXJ z7VMJr<)v+iSJ~cSM%Z%{WYKMJ_?7^B6mtg)*&Y9`=mYl8dFRqB_p6HG1eK@+iuQyJ zuJA6xh0rJ9Zt(f2FYeI`TNa(lI#m*n<~1|T-}nKnJ|%Q<(n2C>cQUPNKk!OgwHX^^ zIXoHZ`zoK7IbisJ0YBzfjPh@7W!CmNOb*cg5N7jdP5A>DBtp#J-xEqgx9<5=%Scrn z2ggyv*qsU83c5VDPHngvW5yfrKq@s)w;Miz;h<&@9?%#Cn^MGUg zcWijV-b)K{A~Qy(VD9hwTBEV@@(Ss6WV_k!FjBD>%uZSl*;&2I65*l=bt3q{TE;tY zV%%81z;-TW_hsjiE2?7o4@Rg9dT$+iepnwTnTXO!QJF37AIaPYZ&e|WKhZ~NIcYI0 z+MxNkJNPV2qK(K-_qM3Bo|ct38H?{?m%Wiuu5hw*vzLCP*5OAgBnF;iM{ZoSd(RCZ z+T}-6PF!IvA!z5&aQ;|J8W}_JB|xLUQ4XCabuVp?)!)FF-cOigWC^!`M*m@L8k0|w zyg@6tpG@@4f8vgmZ2pC_W^c37sUbeN(5zc6SmM3p931pR=7Uks7WF^?Yg=y0R?*gL zVsMqJ!m1aq^QMQTZ{2}jyWeu}PC7A4u+5eT+;IxB;ti1!<^NYSG%#EIr($dPTgcWz z|H(eaz6bB<7$mCdST9(WYD%RnrVH8vqF0Y(wA$5r3+Wl2ZjGqCrnu_N<&O}Lv!!f4 zCtL9By}&_fjI*kV)1DQdq@=kGoR|w;@Gp8tdP}toNNMeEe{`}N6GKYJmzPCujF3Dm z>(brv3qvTD2D^BH#{_puf?JSB;LCO1-rQS`ZZo24@VI?^xOM*qs!z3sZ0Xk&XQ!xoeMGziGAF>S%Bvjc73B7!}c# zCx@XNuQH^jv=B(c#RtQ2stwXDzCFu6^Fu*ZRh88vfV1ENAXqx2#vB)N9r!4AyWsf{ zi$4_#(*ctR-B^v6&RvHC2S^Qxv*0+)x=zu=6h~teq{756mYvoMmlAh$D9~qRh>%TtR1qBTrYQBC z*zvwEXJ@7^Elc(`Yq#*dT?O;0b#OLKR?*pu=qxh4!xo`I7S}{4;v5uQrZ~dcGFmQk zt-!nP;WORX+aHhS7Aq#P@y=A0%&W8zF_ldLu433k@@rx>*UG{enWwvE0sEsJr*Eh~ z+E)BCA!t`i)dG61gAZw$6-e7RNi~k7AfX7^mJI89mxejamLLvB#zR~avqD-~4#)Xq z9HZ=?h)EF^vRvkGp;5!VV$b=k(jf77^s6q6e~aJGvKd=9>&1C%dQ$>TE@aE+_kdnaC-ZoU zs^Vo$!ioq;hIWggdY;H+w&{ah3*`8xt?^h@*d$8;*|N#rK*oGG^m?`zrU zuM>|*BIVZKntVj&TUUL)hbw|_nDskca%l#Hp*}8ENk=w#CN}ul&2OjhU_SD%m=QI!}AIk*h$5@|ydyDxc)sg1#Lh!C&K9$#-gCCXvruWHn z^Bspe(2|*gNj`Ow%Hoa^;#Ubkj(UnTt=H|`2({PlzzGnZp|6jac%J_8)^EQMmENzv zqEXklif7H%z4Imj{NWl7H{9=Ti#aPv#aCB3UUTkglyv4@d-b8axP2bqjKQR`_*oig z6=6wc))5)qWeb0ZaDV6X7r}L5I?rICC=HP=|L|bbkFp8PZ4?ZCNNVb!W|K~fQN%R{ zUG{96mECHyDWbqDRr2!H-F4{=wkSp9m5 zcZh~50_Ndl)4i_KsN5Qn7yX&FB1nqNK5KsDRc~`{B1{ML4;AYE#02(*KIjf;F`3JC z`1UHss08@iBKrvvSoXd$K;~SGz`C^6{|f=6{xAZuom-?WhYfT%0%__3yB&!yXOg31 zTzYx^wBT{N+7Eko!%(?=cq4y0IScrAg3Bu=@8^7rXY+pmMjwN&mZ*MT{;tpxYI>w) zjNd)8mJVNeT4-}7O!_Pz75l8neXQ3OY>&&bwO-RH`S=-eh;86t`F6V{o9shnY+D_p z{=eAfznjwNGY#D7#P-ZMKgUvJH_Tm(p_0`K@d&LkD|Zs@lfM>VK4#LMt_NEa-!fwF zrSsRx)`j_L`s|XYVil>URb?>+$?&aeplAkYr33#5A!V^3F%^@^XoXAmUtN;1Oh{#% z2EoOxNx2=EV)kXYy8%}q`x6B2?~OCVnOq&WgM#?pI@$Fi6C=|qPZJg37`W_66DFA$ z&I+dlm;totTa`id+?Pwrdq{(&QAu}7;NHXi<dHq_ zkMyd79{^omQ_hYzC;>}k+g5TnX(H!|W|7PxFHQ?-3ezbe|GpPS6SJQ>4?ZU0Lr2{d zj+Mi)8mo`NQ)4}exM9g-a{kP-?XT1G5oQJ!lq07llRR)^`BvWQU0N&tEZ_l6+#bnX z2c{tKiBxdS4(Zb$ANm>7x1|SCv2oO;?*}x#v{j{Z5?l8e%b>?&%3$$qZehg*993a0 zaPVFAFT&>xk()H( zV0EibPhaxP$8!L0WKZW(>Tz4LY{IKqSS zmw}sI&QJHjoP88mhe9LU8@@<#Ls@26*KTjSoZoIjgI3{F4X zO8nP}dNqHp+4Z1>t*nSeec;yASf4$}3?~*u;nc&42GLnerQ~z$-~kBDW-VXuO})Vy z>iA)k3+7A8GOGWq(sKhVzEp15KVXyYTW%s#eufX8$Hu4aHVt~vQM9?Q8SYZzQzdiV zv`fQ3Rk2QwHrW#aWGsruq3#nesb;*3S|~Ob(=(aN31rbQg{_wmPEA>7B4r6Q==mgG zen6N?-(%dEa#Hcg#cuOYkB(#Cu_Pb(x1}wZ2#)=_Q-^Pj<&i;H+ztv@50>m}tx^?} zY?e4&r52oW@}1d$#$#d@WN#g1FI<2JQtFQkz%|@B_I?-EwGkviexEis3P;79h8+fr9<-Y4T_5|{2-3l^N&z{L5|> zJVA+Q9{G#R$wPM0Gs;OW)3!v#62ox=pN3`m77OUPgRE}gm26?P{a;99-$QR}ngv?p zNDAtMDikrR3sg2}`;k+eqcC#M#q$L+nCk~xy-(dhQS&KhxDrbawGw^e!E-I=er3lx zT{Y6p$tt#!x%DHLi3S;BV0iroWb^j_N7|M$i~e{S+7>xBS^xvf-7buN1RvUtFxI zc}bBR8EYg2{ic2vEO#sG;x)TJ-{9WdUN+Y^H(QR;!<*+M5wjgIQqrLOvE0n9Ca8Y% zAoVXw9A`ZbC3O@?D(l9BE&5dp7q4KSQxQ7HhD0>Yw(D5BMe)Kg<(97!z+O*<@tNEo zwjru2Z*joaXu_P99|q${y#~21JvMlR@|W-9(urq(mAQaN%(-DCX=VF%iFD2yZ?HM6}xLzYOO%`(nro%zvSI5%ToBy>;i z&y!9GN3gBSZ~X<#*>1vjdTga}lNWud_ixlN;XY<1?9;@!UG2 z?xYU&HdlhT=ybkw((oJW?$0UzC(k7ZQs463ot!d!emF6|$G@|B2_6_$;g40K?{Rt--*22V*5WY}@7i*9 z_g@5>ObMR&zV%?F-@5#jyu}ZLbF!`9-n2{K+@B!WhxR-P=e-s(V>)CP#RDN1I_}$;UD8cflO@oe7%%T>)r}^>uLFFUYq%NLXsF2+9!6>)j#nF^k z+%-|koYpOQ=lZYc(9-5>e4P7PXDxYAlZrXC-BmPz0o`aX>b&7gXNv#I8u>%|_{;!#;vc?RuFg zQ^v{B9&2pQ+|6wmks(p)Ht+j8pa|~6Y1Mn;$w|go6B8H6+&ixWZ*lnFEbhA;QxGU- z(h@KXVJHc3QvlOSE##;L?Ae7bmtLvHCsp3cTT4SZ^Pn~^d8v33aApqrph1HmRA{bFR z2I35|u806|M@ycb?O{ab{pE3+g@S2-_30}VMG$;&$y{P;=6c)Ex)JDCW2KG(I zT7-G@`|AvuY`zvW=Q#cT?zNB4(yC_b{JF`&xryvjwj)^+OkPEgRS{||xkbgm{E+yu z`E*&y)A~YxSp7W-HOb;-JO4|{Zs!$FfrZCO_kAm~0#!g>H9+L&jycS>vR!*&{P;G; zyPN0pm$FDjysmIHms>RULqj^J%%+|6J>yATJYt(#6N0wRL!}PXVLE^Qz5|7vIr!=t zKnOHXfZ*>&2lakos?U@CS0{_x1#a(rgx91@&p|T>SoA6bO`$!yq3dZ9VZ&Q}_N65aX2Wom?!a%+y)dvj*O}G!KU1c0|#(M55u3<){DXJIe@3%^(>S_f~ z7MhMwGLvnOuL!6gy!Q!5xC*rSOftW;PkKPDh5@)DK(zG>TyVs0QZpzlK%N8N<|9hs zpSnPs`_b-msYVXPjH2bxP=Z~2Ux1p{`^cX*OgUnFE;=7Ms8>1WL3HLfT6-c8u@4}* z0r+@z>xY{yPn`e{v;OO=GY=To2Xl^-jrbiS@OG|)SFiac9S2{>rnW=>D@toF? zID4fvw!D}K((I2AHj6CYufSG=Rnm3xCfBC#kKNjX%)2ptZRXd(+fPLuFzUDgynff< z45*aEKLlP};C|mfXEL=2uS`0P|)4@NpNC2e!0 z)kakQVutkXky1;CbqKiR+X=0*;ucq_ns$|1z`Fgu3`bVT(B3?X6LsP3OPu6EJL%Ou z(N7n%xfKT@1*1TAWxXnCKy@B$$1@I3d?Oe%f12GMU$u~7jpwj-$R5v}w4IoVuFfY- z9-+p?7@E)53U2g{#Ni?w*vwdPd<0$)g0N z9-)GY>%sP0`oEW;XCQKsb7xHo!Fr7vs18N*`d=}`o%?=RyM8VB!!v9Zivt?c%yUCB zt~af>A|8I$4f+W6cD2r zv!AuEOtx>gZbcBS)PQdvy@Vq%68JDhxP;uHYhE;`r{7)7WT80TS^GTq6G5LOZd}}S z&2T<0Go^TEazxrOiNJ(XYE_@K`a7@ig<8<;i-xjA* zH~?#u#iWN4WL)g`cE-?LB!D_&wwDLydE^o`q!=@i-8B7ei&l=4C7*B&UXIh_Z>z6&9aXefAd?3jHb$*^Hn-(nJjsQl>$j~L{E72e)vp%(4e zbuz4K)pY-OBL;}`W38(SDFV7NJR;-1=AH)SE&8dii3qMoS^gJ$20Z;CbGDt~-`Qth zLSMQ^AF2HLCrmB3JYsm};7*Z;Q5h9#_e(flg7Dv7sx+U7UlWXR{>vuhO?F5NgFzP^ zCWhu_G*es{W}rn9!WQHmQSpwvLPSjj>F__o_VRvHSfXS6cmmQnBBf3VGH!Ojy#UaT zKN_wJ_93J47ailzrX9*tn*jrltuZDT{UY~HB9(!;bGU+{<&w8y@)yxD5S&Me+&w^a zp%;0BDvMR3ndTSlyKqH;r$-YU$Iq$2Q$4t+^_t0Port#Vv%emAHOv)m#idei=rvE9K+{&@h66Ul}jfc)L_w|aSOy8%N^0M0T!Qs@u}o4 z5n5iq4j~Dml>uFv_AoIfn|Ql0HUAU6F}6q+ILhe%7rpt*D2=Atd|Ta>`L->a9+tRx z?mX6ykapM>%=2Mq7O3OL*F`m0L-u6Mf~u8RZET4yR4LOUIz0+kf1OEf<&(F1dDi~hdf$wjUTJLM@dY^<_2tFTKe?{dB0C;qC^u*R)_-%=?O#T=7!=wia zk1^MLPr!{>1TCuZ`0LUQ1JDkcki9J&>TnVJ^uy@{j!XkiKicW`rlvBXs49Z~(;j?( zV3&Y?TEU(sQgV8TO)H z`S0+XsONVI;@kwpH>d}nx-YD$kt0>bPj-S&4OfMqoNaQP6DZ4LV5)RD*DEB}Eq+{l zX;E&~jxves+T0r<;o=?mNa4BgY9RSnM_CDX-C37tO|sEJYx)^7H?yu*DSl95@Nn)A z5liuBr~(bJlDZ$f-_in`Aa2tDy^9Wtvwl?uKN`p5po_e(E%DE2|I1X=s;KhGVHV7~ z=j-57qv1}Jp3QSaYS_2Ip@@D_)UholvR9!Zi=WC+OX^IA#RJ~O4&D)5FOoe%z5o15 z`uwjAV0dZ&)vi&iQnj(;PHSu|$EP2_AU_t#OQu~e<-T-g1A#aEVx(Am`pz8R6~Go6 zo;gjXJ_nsg>il>=aYJZEP<<#;Ry7;@YCJ7Tuk}9@$92JNU^k}#6N~~dFx^6WM(%EB zxP^1=jsjyMa71K24fC@b(S&Q4HDmW4o~vA_gntMC{{7(!E#_eD zr$IvVXtbZXzkb_!&wYOQQuJizV>bvgr)7N7cIhY*5#uVZ1);vr(%GQ)$W%8*jXCQ; zDq(-I9yydo>KVxAqScsqT?~a_RWqezYnZp$EsOmJ#Vi%Bn?0PbL0<_MZBY8w#c4%$ z>P~vU?>j-!%!utE^@YhP%51Y1dpht`5|`h1xCeRhpQMCo_6VO2rt@IeXWw2&WJ)DC z7d;V?_hqtAi8$bNHbLU)HqOOpE|Oe=3htnT5I^m^7?ig0F?w3l&<^f6;16;=>a4W^ zpA(2XkgAnD9msv8&N{vO><;IZ(LQiGKBF6PCZ+wBSzqVsLZ>JU!r51BYb3Ts1*zyupuR=CMDw)}V zkF|@^xG@Ft*30AnEe!ky-KkIW${h{nwtL!Cdh=3V?Oh1bq`{_lgVo!yGc=x_eGR>W zw{NUi9MPftul2#SDLT4zCozq?VWw%LgF1KQS!acz!az1 zgeZSU&6|QqHz>V-65zL4LRxOVA)TG+K25bIjZn{ZQck?Fff?@jGh>~)gCRmm=#t7n z%e9#c5WDbcSxcC``2B6jnMzc&T#7Rl?HzLjp*Q=brGQ|f>_MvN=cGEGP5 z6n?Uc^Fk-quH=e$(xUXbSXVikG1M#5@h+QvDfy2Q;s=z)4@#W8JWu7Wz!Nwl!{dbT zIMc}!x{(TO!rS3P@&HYv&8$Tguq44b&;c{KCj|CP3;!W<`86n{`$AsefH+ScU-X%0 z8dW?YXB4hIT+=W0Ol|UQHI;lnW`@rUo0xaq#V8JRBdWncL3|~=hS4hAAaS7;=q}=4 zvQ-YvB4qr&gHWbzQyrAN)mII)XpizIVeTIno?J@F!bPxQYv%lC@9W+k$dztET#zA9-57xg3aLt#oI+8QnrJC*?j)x6db5f&xxOb zNpV2pu^|sv-yGCUxrN{mV&=V(^jS!V|Ji76WTU+(k0Wk=Q^Eki95=qKal#qFm=@i# zpt&ZZvtRTFD&0mD?d<<6=eIDxQ)NmFzjK}b>-HxAjnn?k3fP9!gLb?*eIA)JdDMOQ zI*kFjMvUN(w23#AWE2eItt3N|v(*qEU7?GbII;3)<};)(I6ph>HTSzF*cwpnYnR+^ zGROpbm7NkilL81HI086p2UO1Vbj9FwxVM?R#oMca5}XIb_sxfa>zja3w@>*Q5WMeLPoD5%g$D9&rnFw)hr+1FxBecykxiK| zwgRSeJEBAhF}paQhL#<{R{K7>T9V|iZe0A3MlhT*A(*}OHGWJ1aL_VVm64f9HvEv-K%uM?$bvG9G@|Ls2`=HQ7Zd}TQUw8n0BB}1R{ zUOj^2=HCy82h)&uf^mLh4;@4!gR28@r!^epF=D_AY08Z}XvVOzq{|>S8sLg2A(Z~1 z(!3WVUZkIxwsG8k2Ag2^Oy;x-)KA?2fek(6&Y>QVKW9!i|FNdLjxuDS)zC~DVD*X{ z?unCc#pwfmtP!!GBd`{Jk7^4oaCR$0*waTh>MkVfw7>_VQ7usUt|L_- z;i~;iuk9V!q)*sgQKQBTBi;5EZ1o3D5tVoX2DR{XpeNGuz|(t_Gvp>anl+CqF2hB4 zNGIYP3^y?=*UpE|Hg?EvZ5@gR&2JVv zVAr1=P`qgEICemHh0eY|@3aiuj^T{5H9?DG(aMq30NA*G#yAu&3ne(UdS%zmPSl@& zeCwD(WI*LxIg4zbytMK_|#H8mZERUh!SvRPA!ImFHu&C}7TpBVJX!$g@Sv zHMDhmcJU?lA)so%)RHBYf-;xZo zgQ4l4@()F{@^OpWMfgRDJv_}r_Qk=yt=O)q#7-ZI>p?{bYJcj#nKtc=>9RJ0+zO8? zyNI6+R9$ll1@;hSu?*h5)- zC;B0N&$~AH{V#*=dvG~Sg*N#^$w#`y?LSfUyNu~!q(ZZ=613@?=ULxrFV7nPe$y6~ zPSJV<_JE?Z4?N!!eMD)456ojZes|Dp_bXTuqKcQmf2XX>A2klb*f&nERr=+Tr1it! z8#erXD~Q*5o~j?oCKs-NRxS(nv3US#xjIpoS$i7==Vqu-$q#guUjbW;pyT{zaPonr zE(Du_?IQrs2KW2>jJ!%ebrApUyOP3&+57Wkw_q5ePgIu5vFhO3>yMv#P!RTN&H|8}L=wPc9#S*wtdwsLg8pZ>_3*k!Y5lOUAO3!i&Lj?*j z>fp#L_(f0sZGQ<4dJ^TgUh?Fnd05ShN9aa|Thd@P`bN^hHcTy>e3}7E^<3zs4pwp> zLmjl+zyV}D67nj=F0Z0hg3C0hh?~F8h*_@w0B!YL?Cyp95kV_p0(6$K_Vu+>o3AEx z2np9YEV-3@N1~9Ykd&aj1)4QJ$R(8`Tp;O}O2&fdq<1B_1kcZUih?Webb>*~hjpOV zWyqxUXep(l#IKmWm*X8-(LSyoRuB_S5*nu#H3=L+@6ix}(lA+`AUc{< zjS%fB1R(lReo3;@ym^T!r3fmk1^y@N`4g#)HD6D_RMj|QB)?MrrGRoV!AOyRA|j z4xccbCB{de2Xl=C%Xz%CT{N%sw)yigLj1+X;ngR|DJRV5^P?$G@4G>S>V{Js zeq5g&r$2lqy(`Po2VTwFC&|%a(AnRL9hs~tKT{+55~>0ur}7#Lw^hgDp;DV}MC>U; z3pD$?MlA_i=*}bUma2~(@$GzevXGGxB<&ZH5n35QCzC{^YQ+ti$^XogO~5xR{$gAH zbP6DKDvI2R5fbd7iG84P!JHe^lEJx@oK6T@fuhpuFBR-_neEbMyKph<@-1}ptkFRRiK!E)ypl2yieHlJiw_#C z2{*HfIf#R6l4W+nLSf*dQuG2?~&QCTTyo zy;}B*Uowfjw^3_~bTrCsL$)f@1A)ujdILr6S9*^*OXhY2<Fg}uz5Z5=)^_yyDrjS15fUXf1=Amk?MxhTQnE)8w`32v6z7BKC@)Kym{Rlf z%BOJFU&0yGgi^(*NMHJVzP?zz-G2CXVWs3YWjX(BbT_(3=ow~(BQmJ@n~vKTOvKDF zve76-QeWp55qo4|BF20<@Nu-Gf3`$}^gxJ?$B&UK78&Hz{`*d5a_}EyV2M$ZwcJ44 zEz2p5T-2_6q%z9ik7F_($&KiAQ&X_M8lHo=FkET+zBbN3-3*@YQ7}c9qohd3B>T1e zA`Grk<70DImR^lvfqgV*R+RF6HF=fB;S|iXqkpjPA?<`*-+tp{WR+Z5w&3 z|4KVrj$8Vn5C*xd0ce$-lns%WHz{;noVC`z=Iur7P>1l{opF%~fICxnS=Z8v10@Ce zS&Hz<7gZbZ7fj_DND#?|Hrgzlq3YiDAb+Oh_MLe#*1w8^Ru@QTWv#em{KQbcw-?`X zG2`yO$)u-T4x(BS)S~El#}@S|32hG^KYfhlqAq42^Ld3-9ykaQk2W!MoC~vDP%YiJb-6>q*B#5dxks z@23gYNG^ptdKxp*<^}8dAL~sWrNEJs4p-HX6A^>Og zs)xRj@L%+#VyjOD{BF+8gp;cD4{whtRP1y=$L8NQj7+Drg~??0?Bx0s_Ytdq(1*Rm zkT_Xm{21~j9NUzt6)u4mNU!?^d%ht(K3E1$^TNMcs$c@J!sVV_B7~4*5QfOj^I0g+ z@H@*<>P)1T#e!a@;8)L-r-O=^?hUbv*%`)kE4;<7F26*l-t1f z7(d1zcU`(af4g(-mf}RpmNcXgGT-1x)WuSS-c%SS-lVc5C4eXok;25yTgXMySn5k<7NCT z8!$6D0U!r74;_QNmXCBM^I^a4beY_k;aooG=@inyAYcBwm~=p+5&6XJ7W5JwnSx!o zd63CUj24eE(8zX0oZo`{C^p8W0N#BPF?Wa$1C{Zc^iSKkh!yTlVlyee0OWjqd}u=} znNDH;fCTG`d8_a?>5&;|dnstpZYG)~pR7v)DlQQrORmLrZ zDD@|dwhtG#8{Fo^Z<{od;}gfm_y-R1gQ3NE(ci3A7s)Bnpz4lu4a32f{k(}725x_R zu!%D#XQBQR5L=VFE3IqdzSSv$7>)5n&(kQh;m;Tb)C0rG*>_X9YDJLC*iUipD3uki z9+Ak=>-tRk@QKg6Lcu5aMvqXlzX8}^2Yzc_?I<0(vLqot3V@phy zNFkmXbSeHWd>FDojLrbPYt=dn8ls^-M0x0&*!;6S%_u;|H-{4%@F1)&U7WTU)+$Ff;VW;3Bxnb8p zItv}=O@6eQiU0y_tJQ``cD7(50{rb=xZQi^SoO4B;fxC$OnW6#mw2urlH&77mw>Qs z$M@y5#u`@y8u^W8V>ZE;7*5{p+49z>+(V>RVNiceWpuVOaF_VZsX&em&x zI6Kqlbqt|Fe5M4PPqWS<6VH)DF)xN_9Bt883b^60V`~)5c}L>)IcYUF){-flI@^Ef zIxjgiOqbPLp}!_0N}=19#_XTBc@93w>lG+c+6p9IewMw`qSt*7+2 zN2-S-DyElUcZ>d^XZ74iBKw9P74Caj(H^(VOfVje1^N$S1x{A zbT3ksWKZ{Vr#gM}?027LBP*X^ip(>Q-+t09N}1X^W_{)3q0%!(<<<-q>D3Sit!Z7x zqXg;^4O0KIOKNk<$*Vuh!@sIOKf<4`5w=UeAe@JMEIsau4L&WU>tVBUPW^W-G|0K= z=CLByC!7nu_QmL9ei7($@GJV7y&m6M)HuC_((>>FE zNjms+do$YOr1TrVMj181N8Y=~xZwOb&|D5L^@-t(OE65_{C3lX+;hvp2D4W;N&dS> z7ASG%cQm|P!BR^EX`c)KeJ849U)q30U?>%O+la{0vk#C^ZP0zic3Lj-(58$^Reem~ zH@;(-DV~Xu1~cVQ1DjC9o(4vKNeurz1xfK^sKi~XMKU-J+1*#@wHgwM2F@uFIrQv- z?Q-6&&(U5}hlqb4BR~i_3QcM>F1QVMtJ3X5(8wzL_7PtK0;r+;KGvbx!%qITeEe6)p{y?D`3X+@)>p)73y`S|&;4RNJVFGnM7e7xDx9KAM_Xb;yAe2( zxsfkh*doRh7T$%BY=K_DG&D3fqN*o#bKR5ui*)<-`Ro?2+F4=jHRD{E(7gmswr_Pq zH69Xd#?}Gz+jww8gdbgo-t~L8$1)D6w5a^}J1T{p4XabBCAgHJl{X-Rjk=UYEUQ=9 zPT#*}iT>FOX`|e`Z=G+RI??U5Gh~5ZRn6oR1KD15{JkU<4!IJk`hiDcVSIc)%c%kY zpbMg)l440?wtRUvwfLC*usPx602zYv{eI2ExOM$t^O}HFy7xTsqlX9@c2jfc@Sj6< zEs$F5#;ul3OYqk>L+4}6eB1_W?Kj@aXjL9qL*uzO=?I?T3s5dq#r!DwT!0iC>8y$_ zW3nq;v&!H7>HPlPl8FTCbHpj(Q0%@bT3-G!u0OP@NqH04j(fCQnrICHOFY14AK!#n!`w9_NqSX z6%r$4%(c5r`Ps3|q%b&%W{<^!gd<~2ydGCCNYp2ns<(Iakdltfm}+*=^O!%i?}d?F zCng^(C&y+xM;3a@y5T?DX4^Uh@cyWP$x8RyDV4ij$E|j`yU0#=I*SE>pOyVod$KJ! zJjk;j(>BhMaU2nrF7y>J{=F%GiY~9&?eh)KQ@E(gL_U)~VozdGBigEyy;ff7*M$f0 zY?r%YnQ6tX%doILGULdD)&5*?=N$5M)=xvns$o*r8PVx|EWl8v-NI|t$JY3jl`7Ne zg)9Z)tnrj`{2k&HbcW<#e*b>7-Dr-BM$waff1ZIWq5ADogAg5Moamv)<24&6qpjQ{ z1EFp7t~Q%oG2spvDDJ6g99|Q*Ld^2A#$jdW2`F-3KJwD*qA*Kn`7lKL@-pm4lTCfr z3RZuWw`J;>nfX}!ZvV_f;+{j#;+LEl5IMDz&p}q8EeLw}@u~jmTf>qr- zaxV^gt%EaEtDEzbnEwQD%kaptY1k2u?H4NVWeoDzO04083HzG`o9Ui4MB$cB z>nPVN#upUCY8r$l=XjQG#s$YWC2T%d*sO>%nT5u*;nlHW^Qfd3s50!+zL{R;aiqDr zi|iRn=te>m-&4uSEoZW5kIiWRiT=ambrpkZnucGkDxV(gQ31nczgE7Z6=ogrwOzrF z;R(G^A+&T_EzM>)unY&?5V`fvBIA>uD|U5>BLdgG8_S<1jqc`994~r)q75oSv#-;Q zVSqzhyPCqUiQdPDtp^KaeV44Z+7-<=fmuP@)cSQb^-z2~zEA+Fr}EbOM_fjtiZ>VD zPCNZ^`R}zx=DVG=hpsl?-+AUlrR6k8u>g#_4iY=*EKs~C0H-e~L*04Cac1x#ZR@fV z?Rvov8F3YS#iH##IN>UDvok%Dmo8pxLx3IiFxj&aKG%t8)pzU-8e@x=tV&Kh0sq0; z#C6vFZV1I@6LeiX-HQ%I6xNVF>d>m+fx*qov{No-ua&p6s|^p}W$@Gr!q6!$F=N97v8^LV1L-1Ywc&UnhWyTX zy}dt3Aw9;Ox|oU{co3jerH)8Dr9kc=O2E%&kY`peU;Z~U`sIR zgj(8xADEEdzT2J_;-88}SfA_+G=ylKf_xy{DeW;4kQ4I@l%Kj7yu&Mw+e^w0Xa9OE z{%ho8Q3an6M)$^X)(yMPlw6NquxEDseOJQ8z5d8C5H0nb$ z#V;s%g2%2dUHcFfT9a&=b@K3D-D+aC!x%=RwvoUW6$iy7Jcc`t@2QfkLqZYEIhM3g zFC$dW12;QXzs!hI3(~2PewvDkaZ0a4Qmtp{yrbdTJ?{%ar_?#>`J8?fLZDLkZETWN z61+9S)AMsVYnQ49+nP>at;$W`7DVt;Yr_xi`e|Ihs#dJ`gn?7N%ZyB-5Qf-2H4#)e zJgmBx?OtbKM$VAOf$BDa=a(+EvUwYHc|lxiIe+|-xVgqA)JqMXMzJkj<+?LFwhd3#9zM3zqn7O+ zEMq4{(GxrNsr*w(Z>5d)%>Fv_Q!1gvtTV0aO&902=ZFFUuWkoOhuu>?4vR|3tb|QX zYkuEi<=cwn4v(?2#C_eggH9hJxGicD%Ft%?9%C_2-jT~uw^q2@n=b1$d)}k85}lO| zg`u6d`>?7UrFG{%i`mxgvTj@itmC=NkW84L7LF+Xe`LLPJk|gIKF+a~lA=&ilp-S| zBAikhc9e){nT0}R9%(2P8ggW$kjf}TMzjaV$f{&CUPcOu$m)AN&Y}0`_WS+wzTJAi z%5k30$KyV(`*mISLP#=bZm(Lt-O}BevwJBI4ga_-t$dysoD+(ItCZgky!%ZasjUHx2Y*)p?sjON5(`gX?l$#G^j&=oEmHh*ct z^D2jV6+X%&m(d`LuT#Ax8V;uQLwAP3@X(8Vd1t}x>EF5)gNmG^C->dWE_xW+%X_y> za>k{7nKbRdhAEw`=ZddTW+8?8F2$^TPh2 z+va1Ln&@=r+$ky~y5|04>NF%>9U?%eJ zOIH5sflSc z{O7xZc_?`|N|#sh&UxKWba%u#(Cb_wch9WF>sDy~FiJmFfSjc7ef*0No&9#ahQ__< zP_=}zs>qsORMX4H?$GX?j(%qI0 z!5_o`k~6qxSojJYxPlVM@NCmu%=Ke1Iu27bsx??9L7D^k@>lZ(V zF5|}+o<%2hB;H4y=^uvBZa1)>C3LI^i zl&(aO@an@3j4Z@Spi1tfXr>yahr9j(*k0*1vTMgH2J3gySkVu0;~U`chBJzmr@4La ztlrf0;K8;ofx)}g8_Mu){P_L5T=)53Q+MA}e6GFSeoSLL1HiZ{5bYJpK_txhj;+fDCp#~>tr$i@;J;hl z_CpeZdxyHY1EPg{0aXVhog*(C-~9yia-YHlbC4z^TZAIN&=&vsEA z<;daxXa_^p3=q#EdInO(y*2$Y-8G5@e{MN&fWqvtB}?K1i&Rj-kvNYLXl8G@t&Ry{iQ`*7_SNU;rwxBcyJ`*&0W({#(; zA$I3n;UAq45FS1bi%KvLkaP}gqH4SQti8TG;+wnN*L-+kp8*in10Zsy*qK6K_oVWz zFX%X%eEf6+Mso68n~V`MTt=@ye#>KIL@WacJ;^4QRLs`-w_Ds9HT6RlZT@}QwT8{$ zs=dZxV9dWEwgBsr?h=g)=jNd_h&kS%^Y}jYRDy7)CRYrKrTsoLed9uK_<8L|2my{- z?oC05z9wF>yQ-gV^cE@xQp?yhQCGQqfTpZVf_Xlv?R*5!MDeo$f}BERUjbbzPUYO9{7@ zp5sYa2HFA6S_%jAT_=am^jf|3A0QchlIC-_>72J;$dz|f5NkG<^M^$_TCRp3p*LcNS{3d!mGRVkIS=N}bdg@k*;go&W)+E{6ELtGK}XZK*NoKGyYsm+tAO)ZCubG0YtWNV4KzKA4M zn*l(-miJu6nWT9)%*fMiCugZYna15d(7})+p}3UvjwRp&F8&_fLx*Wu^4H3^I*VKD z88C_5{BQtS;+(NcQ+FQ}PwM)lWEz+-duSSZr|3(u4u|bx86dM}4;ejKwfSb=PglvK zVvWM?%-21mTh1__XfK}<*JL6WOTayA23T=;nFnx(95(N=olAJRvkLrzhaffQ&((iF zVL4JQg9sIkQa;$>Tzb}*w2s*oIX{zXRfKS0+8#r zK%Qi1s^ko(oh5Fs(l@0$?tU3^=*c_gYZmPHK?I$gJSj>R^0gnNfMB3nT<%(cwJz(a zRRYzUa}VJmyINyoQ0n{sCjyMOoa8TFrmSDT9y2oex&olPTcO4+xu4`Uy*|SRSVq0~ zm3k)BCAcXB*g}}GUQ>#=)JDg^`zzKwK6srIJeB=vk9JFR7ac^;SkO8^&ID&fIi{%! z1O*n&cB@R+x@69L$hb;>fg+CnRdG0pFGFkM>rza(-ZY8(R~nc2!+X)tjaj8bjk^bc zM$zX$_`U^0h2G6K_LHw({*()>)#WfDysx+r3gn4{*Cv**U=e(iSag091NW3yko!8u z)fzZ#>;K`?qrkBPAhWf$IZO0@B3#_Yhjre&@}1ZQQG@BMTUta)VOSQZhvZJS*8R5& zeYRLBe<5@48_rtcfDrJLxw_cq;n8K4^&4j& ztH_RTT$zMQTWP-yAcInoM7!Da$4h9`@)-zsReQz?!35uql8L6yPHqPd3sor0bGS`t z3x~s9W-e%5=JEL%-|KkwY@0^`@4XJ8l-!g*1f{nyc2T*FYh8iCv2@V* zNYI*Xr^%|kaT!SJw~_U0$8U)D|7a<;^pbZ8mgkwh_!4Rf`ls$5z(*a~dP7}>I3>$~ zS}Fw+yT%frgNuL6j%3yg8;QNdQHd(%H!fUn5AN7ojI8RmU*B-*02sYOihI_n=PkTy zbn@iMEvRq~q6XroPN14tcy&Ppp7^+RJ2Lxr)U9&|>qCsMDy=_p;>5ULC92#YZBs?D zh3uw^eha+FQx2md{LLxvC(L0QZH&{)WgoVz8is=T7ll#G!|b1Ihqi`Rh;in;0iWZ) zudgpQ?%qQ#O4*zRDh?5g#_Oq0fTqSB4$YjN3Z^Jfxt;1W3z?gV%GZZry8j|k=Zf;d zZNFx?B3Lgv6nz^Wgfak*l?97LdN5F3PX^NC`t6|8#bB1_fA%uCDP|;1mxEQ`N?r(+GVHcv1CRr$>G`3-I0)hV zr0TkC@e05;mGsv6ihEQ8>(rF(d_Qqz_sA?_603L(5qEexJRR%FGqmLIvUtAntWeye zK-ka0NYyX*lZDHGK z1Mtj22u>SUGGA2Eyh8NjS0m5k(MxGAivN7A99{nbuocomP+`Pp^i}2SPnEqJ?eOph z8HI!uK`md;EmwIFjYQ82>=u7{j}*UkH>Z((FV@bxum{OdsE z^fbUylz_v$It_LSYm@DEeVZR^O$t%Xr!*$GM5C$m<#69p*A^IM{@I?>Ymuq#Y>Nu8 zU|rU1+?Jr3f4o}v+MHXcK!{SzViKdtS4i^-&SBQ%@bPfL7C;d@ST2mi93xG5!aozW z$*c!k8ZhyV#`hQJO)$#=4CcR9+=~@2`$gE5sipsIts!VW8~g5dtPj47e-t+i_ruHJ zY&3Ujc<9^1YdS`9J;nT?LyH@fqj9Hi5h13BX)=)bWBtD{nOri`ot(cjQ-#~BgSNv< zKP3N3!H{S+Gi>nsh5}%6_vIfXj_K5PoeBtD+@RY8ml+n(2z?O?@rJSZdFZ*djJK3=Y#bwQzEO=2!Q)}Umj+D zVio__idYk}&_s-{?E0x(c^-J#hJQ!T@4!Z^$o`;{;Fup8Ek&c5@a+=swCXX1g1(`( zosrJ{Sudd>j?$>vq8TbV==WAfb!HK(3Xvos_Un2TLvje_b9q_Yf;MZ|)O6Qsf1grM z`2L@#bYyUwDyvF0FAsix9{#Atdo&Dm7=?bc0dGicI?sz^@x)m8=W8@>Isn7U2=>FN z=y+08_@;Ve-#g?%1u75DAPBO zzDa#UB)MQSxV)Z9G3*Q8pg3HHG7AA|k>FLZ)X?Ho)n8j?Ad>s5n1f-;WPr0#6y{2@ zeN)~h%e<-{8`?2qi~>?~^|r}1jV0)8JyJx!&0MC0N$J`7iiv*?APwKg9K+OcEm5PC z7*HK&boKUG@4=1F*m38Ik9SSA-whRx4UX>sepq{Pvrld4affQ@8^h$xBQmbwUBE8z z>UpGi)50FH{f{3%ex%YdKujk57JPB2d8&Sd0{0Tj@5eQ?~Cq4^}| zBo@}K2Dt2z&oEDsgi+f@@*DPRvQOOCSASENqANboS>5LyIG8@GJAy4iG8%UhE`P%v4Y|cvnWSsy6*o^_RK?*^ssAuN|Hh4D>Xy$pQezhoGXX}X zn8#vuHygv-pRoRse4~%Z9JiWZI}>=8D!H73n0p1I(+>pz7R<8j%G}C2%ZDh0Ew&Ca z&$Q3zqRfecaa8{nA&ZBF(A>h(#lKi>Qm?Fw{I#Nrj}-8;g1*gUPgqGMDF)}+5|qNx zHy2ZqnBVPf$#Kt>W+^A5HP8&r6kjt_n1}20v$OltG<61E1^+Eh7Pnof;ZgorB!d(( zVf1peIbV^bIzAJB(kjl#4=pyrwjm%(ZUcS(NAqB(I|_^M!&ALa`wv{D(h0s=Vg!t! zL*+P9^!qAzM;X0?cp3>uXJ$X=l!}t# zCLoNo&rq^7zo%xopA{pIl4nNO3!ftP#2sGNYaW{zJdJBYtJD10#P-)kM*p=VX{_;T zC+cZUcf%RXPn^Z;v}PYT07eYlUgcxockx(X-)10*CO{dHq9=3aB25c0E*#1_nK#ke zex(1?(XN^$b(I%QbeywIzIzpiSeGfNBv%ORI*67hM!{CIM}8_zj9fzWOY*bvBJY4& zE)<5c;wtT0FK+;<&K}k5S-k6r^RICQ9v$Dsv;R>&EeN^#9cAwXGF83O**9%19 ze0LQk(SK&AZi!x+(v!KJd4~l1cd$=pKekL-I6=aTU=-r1!NllL-&)6TwJ2tx@KM{=U~NiKmv5`R^KlIaaulEo{?rmu7qIcCWz6Yz$;azaIF0r z6()75m|Gp=Ae|OKkuhzatob!+pU~O5%C4Hlc%}T8#*1jHiK9Yjg#BJ^h*w1knwx=5(PTK;C?v3k;pWZzu%GMZ6isG%?0)83&0r}A8 zBc%bIi{y-J>yE!Y5N}uH^;#)lxW$JkT&c^C1bi3s=!NaSGaCDKr25(#B^mPN$6Mxg z1!g)Uiv3%j(h#$&DBP5c&)kk1R@aCJeiOdkZqDja;)u=>(%UY*5`@+3Zs^Yns2%p- z@pSgF+q%9(8H)YF?djoxPc75q#&N9*bQ=wWPb973VfBkT=vC@pN=UXaFJ_^P60Qol z>3@h3#eFCa{bkl3eMklJn~Dl5trg4}dPas%@5dv@wJcCHgvjJT2p6aBo+#>zqG2m%%;AaS z1PzO<7;gi}hRd0#?&`lJv+R?#pO`q@(uM;3^%eQ}p(~a=oY36=eZB+Cxj^i+aDI zgxu7$Hx>Wfm5WFi{I?aly8h1kurtfXIXEsw>rqe9rJ_Id;&8VtOCtAC@A>^(wSAnh zhjW*Ei3OAeO?+&fEk=qC#DuN*n#SL@v#!`?PD0A49r~Pi6O$y)udqJrj()_s?S|%# z?V&2xa7SB7g!q@Ps~B^BT%K&#%gMu2oLTC(Z82@y3xMjr#YeBnTWO-S1TN)oVSKA% z$mnXrfI-^$+Pk(hj1gw^pctYZWdB_*s(=e3$V-97HX37utJlA!%_8KalY9NWBE+O~ zl=B8-yAgVi=jp04`;&eT_7>F~5I%pOD!PIo8z0JYz0?&7>)gD5?^N0Mjv^LC+>y|@ zUOn`Tgn9h%14*6b`4nWK%OFs^g8J<%ruq&O4S4s359YXF0=8SytLDvQROqf53)lIY zimcit*y9(FdIC?p0w9%Di z#4|Iscg)64(eBYIF<$K>pHFs=p*z0`UlkqoS(*{F0{)YUlxlAGs&%R0=DY?$&`EZ9 zcx695!!Bhb->=lm4*diHcMv%2cpziyl2=2M-L5SEp+heI{5SE1Xcv{W(?3?}(0BtA^Tfe4ocW*PP=!0GE{MSiK-4KS@av zFU{}EpM$pS6_iVN3raL4K|tg<4r3le1}^`l5Dp&A8vY&3Z~si+9*XUK^5!us&6n3^ z^iTgxEBs7dUE3GT>@A7ObqqSs4_g*$9W&&fy*T3BQwsc8E+M$lcfPnFp$HK5Na3d2 ztc-h`reOIN*K%wCxcFA|dO!ZvI2RB`Cw^uq6B;>rSH{;gl%3y7AO9NtH|T4msEYpY zzBYHf;~@&B%$EV=(a*V0RjYwg^@ssDX;L9jEWdMAi(P51uj-jJ)g_ieUOF@^Q^`7; zmCI)r%_zA7d{QXN^J&>!&7ld@pK9`fh*<;hhAF(hgHGPIV3?t#hQ=;c6}xbUZ$0x* zPJMmKdi1uE>khtPexf8iccN9D-!3?dv{(VwtJx7#Nt||NuP)Q#Q=k*R2GMT1jw`ey zD#?_%Kh^{ctBnYp%7h`30BQsimG?6*Z4_Y6(^h}YeM(A?eBoA}#Shfh5LQfo<3wgj z=&S+&>WNdpOv+(~_CWqqME_W;>ILIPM%z}coqF-xBopl-Pd{d+sF9Pjtj8I3{U2@b zA9%fV?a{AMAk4hRtG zs+cv{7X#d78{{xdE3{aVvsR41EvW`EPFH*_wvl-Vgz9DwFS%~u>xz-Sas*CgmGf!W zjXjy~hem57FMn)vB^&b!3-;foO@1bl#R^pYQe?pvQNC@*q^A1VxkeZbZKHt1av2^M z+qP^83!Feny6VQ}3s*2xjbGV-EkJqI&%YAyiTlVyD_X2!lR!x}iz)Jn=GIZ;urt7P z&CubIL)R3%$}5ck95R?EN{sy4PfxYt|^ z9R6)wouJhuM@jxx53^nZRN$RWbYaHC?XoTu-^~DhnD#qyI=0hqn{PoqEB*tU z{&yiFV|q{#m*1d}F>Q13yIFmW%a4Hpbcysl!<+tV$D?)7Q!RY}46@@2Zs{w?R1X5~ zOX-PfEj%J6yW@zF22m-8ISjbedV?0MDACK`I+ZtfA((UY99OYsg`;%}HGsNbUzUsQ zKGVysi=OVn@Yz|IAZUjmqrP`vN}qJIO?LIRURK0z+A=YLkLoy_L_VcMt%()4y28(Gg&lv}t1U+BOh{q6?(WY&DwDC5}Y zHFs+^FMc>Ich2}u5+Q@hTU!A75>EBw_>+RMt%0d&lu^wcOU2qs|LJh9;L-P2fns~& zC#%+^(V98;1pPUfK~_fe0oS?$Id5_1VX+NtA+NYL@KBL17j{2K;JROpk@0h#^KaI7 zu{n`BJ>VOM(c(tWZ}ls4=a{2;Fxo+80BEdo54_N`Pd84Gg>|rsrE^-T!^i1~4)rA4 zioYVvqlPQHnbYgczLq~$6<{H4RNn(y2(6QALw50>oXE2qk}mWv-{KcY29dc>h;aWt zwF0G$m<1zhNoWZ~Tn>?@u7PBc{cBj)tegEcRlCN}k8!Ku4buDfvi+IWzD$WSmJ@J& z=K5AH$}BW7ckNPa2ErbV___&Im}4WIc-5qWDfpXv;XN}e?8;oI6QHqehtqQNu8bRI zMX#$B-d1J-XrL#Y^ZszhEo>0f{<97z%y2|KDMfBKcL29h*cu~!ueEjfc4uZvkFS1u zSDw$rjk*WO0b}L6^M3$EFu@b4Aud^o40j&);0ZP%&s2%t&BF=0U)w`ErYfj_d zyggFzoXAYt)|kCku%j(;$pC;mAB=#^D?V= z6E4-lH1^GMBN;D=$DjD7T|E`u7LO5xp8E!_6`*vTe{rdc&*_+D*UC)5XP0VvX6t9K z$wG}_$=fyPd8fnC!5_zv62W4T$^OE3pfS;e^2@UI*d^7mQzOIg)5 z@5*?@A|4n5pI$op5lu$BXb92I3hWM18w>T|DRRrcLdFs3=bt7-j${U{Och@YZ*XcW ziia@8@xLlNxyvS7MspInC9LBlY?DQQUFS%on@PN&e{^P9;xC>p0fpOB)8zYGelbi zH{~8f&4phR>hm~7kGvtpvT@}n#sp-Xyq^NU$2oh3ljlNcq3pW6r|2~pnOADGs?U^7 z;#yq>SGgj<28_i1bdJ%|-qEbMU)G4Rq;BPNn$1lnqL^!ML~tBvuun822JQ&6HMBcoHgO|BVt(t~E-W-TP`>x ze!Hxe+8TN;G568J+Opl)7xFi`f-<1OxYQJJT%NvO7pOhW%f5z{RyS@!VQz7$keLL^ zWw=x?n)Khgn$8Uihnzn zPR`M%`a~^;Q`m$Rq9IgPa+o0?1O-wsB+D&}0w{PY0&u;;o)RZbkCFbpwfX)Sv$?do z=BT2xANKCWY;kqnJ@0MD@a%iFbkPR*Ygb20Z9X@t?tb`08hax$juo+q_vg?OIN9;$ za?c|_%1~%>vZR@eyvvQa!Kunf&^HJ52~TnVO7b#5!L=#$Snu`HUjDtr{cckv!tX;p zXow^-YkPY8c50yvi3L9`%($=q?skEhPNo(;P0qhzBYu8oOUSV!AQF9rsBraD9q?Wt zSz1xUyFih$XGyZ%maf5JFe|UFG7&IN+j{Xu34Yl#R$5kCxBr$JC+TSG2R0UAf1e`8 zifV_QqINXRX(-Fip8$lhXRvSo#DELPt|{xczX_($mt-3}aC(iz;l!;yHO$~#ifM+} zJpo7NKfR8O9hpkxu6K%A(GoX%W+_Wx&m1K;+wUf|GA!?lj@5I$s!gFcgOxN0aGhYA__bwNoOhsatVG zvt?%m>@dD}KVU!mIC)M#g?(bo=KW>e zVQZ|O&A8eS@#j@z!SA7;Q(!5l%`)JAJ7Vey=|QsHn^Kf@jbwVaMfxKywsWoY>q6Zc zo%@RRq-Js4?g`ep)#YVoD^oqX$r~|oHkkjDc9NKbD<60z*sSLh{~+-Ki-1C<@j2<2 zIJ|JJH9XF^`Y)+I1vIboF-(qi8ZD^mi|?Pyk{Qm~XL}>w{n^cDm`}fLR&|vHHK{|) zmdB!rFLmRp9XWyMu!SDH(0(IqOtMk;&w?zl&D@|C_6Edqpx}?vw zWRC7elBww2enc49hO699ajj2S>-oZl9Mx9}kqr;QHl&ZK?XI_eD!)^B^e5v}y3Z`} zHHMf4etRk9;DkG09?IplH5S8x4>D?cdsP1W_cGN`xR`lFNk+=n`TZvoBpbC(a^eq8F+{dR3bL|gqBtX)2c2RPMec(Ikcb2GIjA!m5IjQgOt zP_l%SyRvmf?~;Ne(?pv|jPO_dm1QRWk$frue#VHG;OtB#HiZQUq@{Ivy|X4TUFRvkCAt(ZxgQp7k6gJ+ zc6fb}nh=U)rA9ak&2N`+{Kxj-;o5WjKjAvp1f4>xmf+n?@KI0Wrk`+5Idrn=lx{Q- zsrRM+1%JrOPQKD#0VA$uz)JrB5wCoS>BOvH`tTfHBqFm>ESX9Y;OCEF4R;8zGj2sy zX;b6aV}Pi5GD%``JWo`d8D!0o@e*QE_b?x9wjlBM+!eoMsJCS|Do78zGPoSc!2>}l zsR@i^gy5rXYGUu|yL(1u20Jzt-63u$j3K0h7?7M=eX@g+JF)%Cwd(l=30*^KUx<4D zUW{}7KqG7mNMrBBO#kHCYQiTim*7(UVyn`YFKv=&qbij+{Y+}-hs~eZ&0RU542KIBn9XWc}LPF+yAllyXfcDxT%& zUGuZWA;y2L(D2>3C1V_cG>t*xuwPT=ZW)xXvFQBb{Z$3&a+V5XL9-SsB(L8u;0K-W zYnyd2Upo%lkd3)|D|tCn%JG~Rhdn(OP&vCkchx}Si_LU-P5W}TT0@I%gIvsEIwTqaXfBTa{Jg0f`*SdU&>9s! z!b1s?>_-7I@_5C94F@P7*2fZYk^#n8^Or9WdmqS@L?94^jKT9ixQs7}^*hE@fGK=`jVmTXt29f4P(j^yZ`1j;Iag2Z zi$!{q`98%c`Q2-}-{+?DNxMcpM8}4yiT<&T=e6b4Mrbs*Jcqy|U#fcDpzdgeNWSjo zq;1*+EW<*zirb?fc%{+O&p8yjrWF(RXL!(S{ppZ)mAt`+i+q@^^vEq*)^!m-0TavF zdK{dDfg5aNt3Gs=Flo_@EF--ss#rp?NkyMtBiTMoX#|SA@K%=dN6=M^x7wZ=NR8cd zzs~QOXhWwzkq9`* zBY~zMk>V=j`Z__Ypo{(n;~D_fQW)o@i1u3h4R$Rd=0=_Z+ow<^_NC|$sEbvfGVxVv zc@ig9w<hTSG6g0%`}x^zSIZG}`?Chgf*nTb8`%f6-NRrzlGfC6Eo+qGvFGF38A%1;hXpxy4yWU5ZSo zWtFuN$L=_l#|_<(7huw>a1e-n*SkMQm@PEYp)W*^Uyi|?G;eXxhg)ZgHs)P42jypoDrXQt8Bv7U%jqNi?Xd^$4O6A}t6n^=h z7fXl%Dpk=*i2bin&5%rUp7Z`}y$r1wUGTmp)wU>#N4j;T)wSh2ITSk-PQwb|Tys)w z9k&|&dp9BQwmJQN$wMHaHz>DH<~NSdn?rHr!41 zvW&^%PO+O)q`hGPR95CjG*RYk_R_n zqF@GBeu7PkXb1IV7TknkR?yfX(FKr&bY=BnvFhpu2;t1Ijo^ocdHq;6ZBn}h(~9PO z;4wger2G#(lx!D67S1|ylc`P(S-?MzS}Y}a1@AL`V$STq*kG%!h+vEaAP3T|?V;OW z_i$p>Acz?t4b4;O1tI@6dJ>SQB{i~xEGcmD|^EjMs$9E3SW8xb;T*Si18O>Gq@$(DU z9sm(F2F`903(vZHS(P;f5*o^)yWT3%#Gy^UvwIn3u@DM_b6*+pmV*^5<#C*^;DQ~$ zr5;lI9ToI)U^Z%@Mlb_{5Xo{oV2=f%j+dtI0Y;OHsp(rumJcbPQ^W8j?U+hCnTf!6 zmBX=r@d9VmHiW^Il5Op!7mZTfFIh(QEUk~1*geb&!WcF8ExOsZ?vmNR2N5yf!s)EI z6Qdca5ocEqCM|$QQz7NVk<=;CeMC9f&O*y2)7fhP<|ltirWp@|^YYO76VN;dc|D%^ z8!nsy)@1TQcp@s?6JsvO6~E{6>S!w|_Kri;=cveG4%ZE5$n)n9U&&%tnUd`i_?U?= zYn2HjhK*fOglu{F%201p)vm8h!YI`Di2KA1S26pXw2RQ?8xobc1jqh)yoI}{>RLs| zf2Cy%!S(f?N~7(^nGF+VG>4n64nbsC#1O_R3mGV9ML=W7Ix<{?SF zY!&PVq9EMD77CJ{@u?=;%>1uY3NB!-9$D*M^vhpzk~NC((z7(ot^+x}@wy@SIu|0J z6coYhUx0vt-FXVp$}miC6Jsl70gC0DxuA-!<=I@o8oe5jNgH+ou@%=9edz-*f}vXB zo@8X1?Kii~F~4X0EB}6$O`DL~(sq9ec<-|>MrK*naq1=np2ws(2OEX1XLbCGjTdnI zhBfM@0Nb}Pwp(eMOpAV(>v$nTTzwW{Z@q|gZB)sl*VsQrKZQx@Qo$MuykK(FdF8Nf zvSi|SGy9KEgYDjN?6z*@vPC~H^-da3B~A8WUJP-ytMaDik8@x(FL4t{O@{`A$3hDi zt^zo);pKW_IH`wn(B1l$Wp-i!PWh|{`VG9kW#yn}5vD+jt5A>TC88q-br4w&I&E3R zK~;fy3O2hCUYCw86PWI_KT3i0=6}t3>d#Wd)FEScLDt$wUfnTh1Gq%b5J&BmKuA?G zSJ@Pr5~PVq*eTgfRo_?Fo=&dNoN=#_Ba3u{Y(R|KSCG;(ckXx|YcnFsRC%1VmM4Z% ztV8gTX|+kBaexw>lr9E(_pRETCGzUp+Fa!Smsva2_4)bu?zMS>cfv==CSiEZ*{T_|+~g?{Cr|C#^oLjv>^WEAl-`Zgh(d;6(CygnQFn4<0*EJOs~zYQGBpL+;zDhhxUJ1JjVpA#x}(1&{{RcHgIO&vCN1@31O14WZW{_OdHf4}Y)#oGjYDbf&H;CkDs| z?VeB^^yj<=h0SwJHlLWzwYfNY_9ZaPLGCel75l`*Uk&{sQ~6Inzn$ zQhWN;KnX-D*qnbmc65qc(w;~NOwxOwoa_iiZEA|Ck{7@}h4~P2obiGmZawM(TS8Su z8T|6UAErwvtFw0unVbu_#+Htq52Ugju%^B6Ohp(e6G ziEwk>wW)7p6@rc+Zit#MEbz>k$|CBhvW8`zT1{w#3 z-I*TYFCS2jIGuhd!qAX_nbz743D*0NY+s8Uo|v0{ko9R1RFJX$!-hYVmuM#AC&E?M zRq=w>qG3qgFyYNd;ipWlPzoINg1bhz=m%Iul4|hh%e{V#t9L7p_Jpsp^`oj(Pq*pq zR(SaXcXcyaLm+!jI15Wd0HX2|GJ_}#2Dip3FVmdGUjlF0`|$Uw+W^`BLF61}3@EfC z25}C*5`J}7$G;#5w*MEk;o;><*4HqVEdh+=kVAKV1lRgnMcXM>j3ho%nX27mLhNx+ z@hu2Jqqq$=lZ>AjjS!jgD{%I3n$Jq;K5{11{`-fU*DyoCM>#UW!T~^0j02!lmh~s2 zV`ptfAE)lW`m`UGai-Oyb(*aE`GDvOm+dL>?U+C!I0(4(_gc`cqoBKRhIlAr1pTGZ zym?=lS8_HV=Ehd4;%4E!I$6b0=6LN;2#-T^oE8lbZ!5L~Bpi{Akf?}e12;B z-k4(7d@f(i10f-y4b&jT<7QOL-4gK zaF&0Fcs-55bh8-}1<=?XsuSe_px@~(a?26%vwom>{^k79yP{v|TeDKpVWx=w%Q8^X zQj%MLt?HUux9;%e#;2!enuQXye6FA^|G;c6;CsIWGtSk*NkCJ$XD#evJ}-4XNRG^k zeEQr9$kLasbkz)IydzX-vdr83p2H=G%A1BFO___C@wT6B!&SLE!qlcC{4~uV`*_LZ zKmHty-A!=l!g|E7zfhtSO}apxz;MLa>0*0(yHe-zP+B&xlgJ;?qz!$@_z#lo;mcWL z2Xxi;mw@SctZj3|f+cjTf9b7H2ywu+I<%E}%p@fN!$$)jel2xje0V?FuiE>;e}fJz zoJWj3N?`q$b_(FjR!lAy9g4g?2kHpacPWnp?>$_&U~aCRNZeA9<(>r&IYqZW|%J5;`%&ZZ1B~#@4Hwj zlip92%;Bm^)RsfGj>chF5C%wT8vs^{`14P-)mK;RVeR#zx@}-19)zVfDOJzxPW9v5 zrKjpLZx%d^T`4P6Q zf~}c}jwB6+KKN-lfk2Udr@T)_-lwa(E6@Y){D<;X8RF?qu^SFV@+_X(ecE|vZLm9E zkhNG{|0)KYKO+iH*cM{oX(6|iBwU4}=D%jqv} z_vE!33mkE6GTrR{498;PoAI-wcQl}l3}F{(9m{)pebV{uO_JMj^2pC^ zl>v@BmdK~gdVb|1H3_fvvgOjtoO-JI@eLA#MxC{2klw3xgJ;T2I``)BPCO6e?)Uy8 zB}bE}xcyL@5`z0t0j7TC`dCKUvC;c-_uTv1HBP4Y9s21Mb^aJgq0&=iV&ZgV? z=$#N6V&Pjzk0&f#?EcITU0KBk{)_=}ViT)LaWpzl?Bjx-*pz?Wl%ww z2_k_)7~%=h*MJt(R&G3(OF@xvPdym{f3bMY+6to|Q%Mb&RQ;TtvQyp8+7R%H3=m9= zI6zGo7I@Wyn&}~ThL!3U1r*5o`w%^qvGT`4(4&~<7LfM0boVB8{R-6DOb#*;ANs$a z!QgC)@R%-cM-oYo?e8$iRLm1%x-EL^h-U~8WB?0ddKA&%fkp*ldLqJ|D`ArQ@EX!p zw?Zhhm;MHGs;jo`Eww?(`PbuGF=x4VCNr*`KIdN|Xu|?{>HqT)QvKLa_Xa-CF6W81 z84|pU%LQ+V7r7-LmSFd<`LfLG@t2s}E}QZzIfKJx4!h0fIoiGX=hR`Kn+{oadq@>7iY@7k5^fx>Zr z-NuxSXEAkHZMG#<{n^wJYO%u!>z==quMxDYJLBjk>2K7&_=B8RrMfYb zb)d+M9hCMPX-il)@!Fi4jJ`(W8fefiV~3;$ev}w{3m-|(5A<=+eq_8R-U{tY*#(|i z8OTG3V5`aoB@tDnNG*3aN42%;7cHE;Dzz<)=?@SgAFwxV&eR9Y-9nhiFs^c=a!4au zGErS-&55l|hR=)E8i9*$)5fdDT|zT{+!(R{PFMXfipJgU$GxfenBcJ=>gKr)erJCB zB(J^AD)F(c95XcUxvGq*Y;}{&8WhM1Bj?X3$Or-;6Mv&Om?O``y06;i!mlRPIESDeU(4I94i=ZU}hjZNqs7Cr*JU_@wuESn;pi2kLAkFHzV@R7aal)kv7qMB@sGot-L$%#Q3z4*okyD2a7%09UUdroK<* zw+ANkI(gWtuc>>B&6uw-z)zmpBJ~BmK)TcN0=Nz&Y8*+~Ji7kI^gD^bC3m!$W{+Rs zg-N9;@x-kAjYIbpF?D#0E+w@V;rtb;>=iCjW#7*-d+%6u#I^3Sc< z1vFgoIW3%9RZ9MKGP(p|>aS&Hspg!EE5@=d}_mrQ~p`3Z{cEVQ(Dn5CuxgD^1274hsCnqaZD4 zt`C5)&ABNnfg{s2wQL475f$irE0w(UR9fCee7;L_ION*#;0jo%)~YxD_gzRq^fz&( z6ssVjlGP;_`EJhxG^HMYs~rD~dpmJz5VOMQf0b=f{d?|=mOf6eFUl?Dh85V@A_tcH zQ1NQNI-07vKSD~H!RYg7?rWKf=Swn@2B-U&eTssey=BXOH<)s;$_ZZI_;T#L#3XSY zQ%;wax$E8r(p9_nq}dHQg2D6_)LxY|MAvh@tB4A_OiU{Dh&~~bZ-+68`9rq@4}eVM zre&*Sn%&_i7y_}O4*fZ$oer5k;kv?*RhdYvdOB4y1D8(e;j`Y9ez0fo&^b@CC^w3* zlhD*?*k6(G$Wn9pJ)gbh)?J*B-yWpEJdyO^v+N7Es;f!{(x#gUjnn!qYRe<2{QK z524DC@LeQPq~8vFb?+4}QIyn9jq=kEZrl>_{;$q%eWr?mMtc@Mzxq(v0kbZ}QGnra z&G<&6f_Ih*nL=6zlJ_=nEf+eSlAYK@Gv|@ znx`Sges}iCzBgq_iZ@twC6!1+YVzfE$B)*%A&@me^l|@7 zv-!QS5&e)w+JyVtn`hsj{b>2}^Nfi}+~iHM3v%9&rW@+PDfa|i$Z``>!2X~2kXH`C zQkn?q{(B?*>nAw)(m+WC0{LDlF!u^CIs~VE+M(tLj00a`Wp?}5US{KjeR7BNp=jQg z`!hPL#o&l>GPJ-ccH5jtLk9Ny%ZD#+5#KWs0ZQ~Cqs%@&&uhx7p_6kl7D^M_`W7nq zI7E2E)LxTXu{{2EJV|SQ=+=@{!obOX8xEXrB4#o z^gV4tE*L7>yn$s1Bj^EkRvb!#f{cKvIf|oL%1$Zh>&BJVn+SNoh=hL;X9Ue{i^#%- zht6YEzXDL6{)_b?QBi_?{QUQKll^Tdw_pGBCF30_Kmj{3_D5Nh_0^v6-X#|XblqQ8 zn4ec(Y6ffveiEa6*Z(u~cIX>W_0f8bBu~ELkKwC=dd< z)GIiW7&(HGE(?alK;-!`55;0o4v1-m)GaW3EIEM9|qDH*x@vPr0mE-aeY{< z#_;><{Vz1|ccy#4Ch*vYK5W)|$qLpU#>7J*2E*<;vXgkD%6hb0PA`5CLNYhRCh{N; zAjiOX6xr!A^fqyi!LqB^b5U7Izi-maB`x2LwKD=iDMT;x}xvw?&oe+>SjZ!UADt6uoxT?64eI{Ltgm3DJJ2Fm6H_ z8M4}UcH~hoe^UM?IM>en4ov8MMX>KJ167v#nGLfm1WvvFsXx=wxiD^&2Lng7Wdya( zP0XJYdt=%PaH@TY4pTJUIJ6CrW7~x|_DPv!@$*)XtMNGmskfWS$Z1^0eOJiu$NnCb zsW~!L(gQqG?y6jeo2(b|QHHn@_^W?~y6+XPW?%8?*_cd=(g^!f_;gZYPtnd>ubVl6 zpgJk4L<1pIs#xN?+ioINx2WK(qAS9 zI%hfQ4`Cq45X6vv75&Kcr?BH;4fIVR0K8i;Df|yxOw@$P;1xs78=rH^F-(_6WKR>e z4fjTUKC58MP_IbM_iy+?R~_V7^xPvp^C`Er88;gvT<$oLlROP$u%R>`*P2FSgdixW zrF|rLTp4%K{sA=N(ML?lV45WVx+i3OmcMJ!p_tn(E6Co<+Q{d5NPs4)uZ)iDv@fTz zA07C*wJywI7l6*5sx@1tdREDHGSUp}Fsn6V1k zD}K;kpc4#aVcX6f1{h@-uF22JCpitX;1s*1PPH@@tuie~qp8+rBn2FtMj3{Qu7Z1Y@|D+>JVHW zQo*I_`GG&kML*wR=f77JQiG?b=jt&H1P%OdcCR2Ze`&OT^Bm6j`r0VkXO`X0wkC5r zaA~{(_3FDs*e58TU{R8mN&Fz;i2nV`F^>Fbl+;^Ml6?QvGoKgqB=la>FQ4}oN~cL} zR%62!0>F1pOjeR3*H=W#<*20jJO$isR zrT$&i{bFBZ@MgDeD%+YAc9Why8OF^AlUn>#{wcNwoEcF>M{=GqX9XF~+vV7=AO|(5 z^3$f7chHe>%bsd}u}IVNFv_U=`=0X`1lHMXXb}r-b5q1IVrdwuD^KQ6yg9~AaA#aawamYuSTg`8H_J~p#*r)e=dUOJ| zB~YcnDE=hYRGmhfCJ!1o+4lmAW7RXbJu7Vrb24_Nn_qxeJ>d5n61JDRJVZqs!VxJ0Ffe_&+ev-q) zjyrq;H!*_!=vQ$kmj7gH;cd9H5T&)^kBne1gIG}~^di~|T83{U2Pj-@lx-W^2Rhc^bfZzrx!v3pQ3R zBS3I&qU2e9H?lcpY4ZC-ZNEXKSeF-rXkIs#t(z`l$Ooc|iJqA>ou=p9!rm3QI=);8 zcY&>t&!3BUN}-!w1rApC210w2Cz4iQj`$ErpQ8-|@7O+D zbyx)an>O-pB(hk_0v#4hg)PLNLWGzYIA5I&msmO6fKs0rsn{7ncsC*OA8xv1Fz4f= zz-HW4A6}=0dEj0)b#0Hg^qfSRQ>lZ5ZGHUY_6zbWiM*^4%|)K zWm~6fn0r)=*T1h!*Q~@?^A#pG*W)F8m1H5xkIaXOvn zu!F!u z-WFu$yo{*miHmmyw#y%MpC@v8?BViJN>O9_{9Sc(r@a7#50F|MckXGxR>2ASG*6Y2 zVn&-;Lk;*A!D<&kjw1LUDXBe&VU(VVI&byev&|{8Op}L8E219;KofNzviV!BZ@g#m zk=gOAAdqe2+tc-`cIIPeUM$&u>gTF_LrstVzZ(T{yOTv~Az8&qqFn@;M}M!pGh1hb z3Q0#qL@0%5oe7F8(%V|<+Gy8cdCrj&msy6mzeNJ{-sKgl1c#+y-hMYQuJs6zAQ7eSh#P&z7{_XVr-keR+zu!gL&QTLnyBE9SPxC(YV_d7kBy9yb zQ-}A6jErgjX^Ag>TG_bLrz5DUC%^KrXYblRt?+?L&#H%&km`23rOX_JZb~Cx{oj21 z6`4S<9p2JSwqPTGX9(AzvVVG}INoWAw0zh`szQDTKbtoi!j`YF53pYl;PP;8V^(!> z$Mr#-K4?uI{gdmmw=%4s{8qA`ES-f(L0_+hg~eBqjby|q*1ND}_xM0;S>E6A zPTg75xB}}1r(+hgGmbZdQwJt@T=8|0v;h%L1CtpkKJ(>Ayun;5I*;*6D==z@QROL@ zH&jg)J8`7moI66+HIO`~5rQ>CRli$&>99UZP ztiC0JZos#q=lzVJ#a=b*Idu)XrGqz%R?+vB%e|p3$2#gM%%6>NSy+ zvOh#2R~&fQBu@Fc?o0gvE?}p7!4mTphVMWFV{_bivFZN1<%r!zPuq6njgDYgykBvz z?rVzmknNqaI}1I^*^kwmZC>_gmIYaiLw<8JArzab=|*;}dUnfwYF}&VVeoLX8e?LF zC`Y&cjcTF4Ib5OWmB1;J?L!uGH@Aa!e-G@` zwgj^mzp#>OZl~<5sr1E05e8Yq`iNZC6s{VgLBS%t1S}AIn{XVW{X<|h9?AM_dY^OP z*DtI@ard^4}Em`HHEJ3tAcKHDebSLrpWQMuxAB5663U-{%eZw{1#vVK* ztc!t$cj}v6hUnH>R6c8J>KL+!ldkH#ui)d+@ZbQL8j%HV!AX%{XI%4oyLAmV2Uz|@ zzwiT_n6^wB-Kxdd{V?2LGZc@!T;#KB&z{7xYCQ17z~5Hp4!PUl3`w@9ZpGi6qUvxi z1-_2{vTg& z9TjEUy@A5WC=8%T3W{LUAQB=1BZwlQbf$TMVIS6_-<2s78 zROpbe=}&KFakc8PHtireSbPbb4QaezkinBksHw7UOE#^=lFugIgrCyj{cA!jS< zA%s}w-)hXsITyH77|sH6YzG`M7jeXauOEhUrj+VYSa+a|^}p2f>JJ4DB_+Lx=!A&Z zz0aE`PA|OS-{;{BM_yja6{DS(HyY^}vhg#Vf$x@>1#+G+2wB@ndk}NIL4;=lJKt#?;zINkVBTZ#s@OCulY1@l(|aNR z%ZA>kK7ecLuAlo-*1-5MTW+t!M<)eGZ)+_Fe&35%qN>y`vs)m(?WNV+Ns-qPhwO3t z9XC);x?AKG*Pku?N}4CW%J{4JqN1+MiZ$!)-H?Y>gocEytlJ(p!G4mQDa%cB1!j^M z7?b`UJif=K59X@TLT7)b8^}Tcdvz)__zQ=W4btAQYV{3}d;G0qE+k;;E1d6!Zg;R{8{o3fZSy( zEDj>vC^(5P zP`?l0Aob4dSB5w+(d>ZqYnZ3qF#Vd;qNc;`V7dHTH~|$Fe6h8bG}u6`uQvHa%Sq9g z=;SrGLGx;oE%E6v$b;VaE&sR5wNU21iHfh?cY+YrA=e??(%Zp}Pj*=_D;k+wZm!OE zXEe%1AJBzoxSCNgNm`o zBFt!H8qtog|KixTg0fC&)ho_(mxUNIYh}MD80jv-goR7tHy%~kToCZuTRt}`v)v8L z<=50)1PZa6X^RQEz*<+QnfUKh{Q)#IVz0$C!Tk+3a^g2Zw5%2&xRzj zIz#YT59O^Yy!S`lM`rvWjB~DpeEI8XBpZdwnc3-O$dZYPE5)wHI#qihX)DfL8UFVy zr>c%BL{pG#`8b0eaEOz6(D^w9mzWP9WD7afp&hQ_J;*gUlwGqox6|08VSl7khn~6L z*75hCVAE*UaQvQH2Iqrw^MyUdc3TS1d{K=+c)lCTdj@*sUlTe1DQf8y9syYKM|I>d z>FPric?VuH%d4x2#pcj+r!c89C$m_ocVy(;jx!dh+;EUtar?OcGTnyq-#yoXy6D`l zrL*cn<$ZGV{(tM4n-N};tRc}=2x#%_=)7@9*ztW-4N4Ng@MIVKsqmcwfuEt6a#?h% z2^QUFqgfA|*B<6yCr?x`k9BMu&&Hkr{V| zb1>3v{*mwco@3d6zZ`qs1zw~-+e5u;>k;LhQK*h>+WT6vsmLQ0IK#AWptOXaz960F3R>i6AJ_8cEP{Zb* z(9-FWdYDZ`;y zyQ{qnjABXwo71?%l1hW=gOH|O>TKsS27sF*@7+C3qjLp0LHV<<>jZsPmDZl38j zFIF!N-=PNXoNb+uw%Vun6=VN_5#fxG*Zlt7d#0Og`WY!9ZDDTidkXPs{?Vz**$>pt zzh7LwbnrxNxetuIokV8Sy0nbX)|J5+MY9j3K`?>>N!~{6*@ev&K1_UY{fX%1RSNOn zVe;!+X|Iyu(a}fmQzTjw0aqDBx|f|C=twwMrX&9xWGB5x+$6G(qMDu&rl7;%J`EHw zqqC!6t7l$AcyoZjXJb_`G1(Q{1F$p*Bhm$sSh_hZ=yS#OGQU2IM?TjoD+ZaKlB-eI zRj_&LK#pgi0lTPpKyon^|LQ8n;EZFc6w;e{R0_67-$9*ihQz8A>F=zh{q;qf+`r0l z@Jw7Sak2i6tYWo{G=sd-Wi#T8We}2KNpyY|a!Q7PZU5MzA!2*eSaASh4QU5bZa8&G<$vF(Hq>`9PT-&BwB*nxu> zRDD$(ck>7(#gdIdn}ir=0ZB#1N0-!z+x3{U7`vK%IOs;L1w9)6AEIWG@7_%hG~474 zzI`QZJM}GLsSk2^Z~s~Fi=P5_!-jZ+Tq#_j@%A5cnNt-p zrEjPBz0+oZVh)KQL6XyFb^b!OF$J!4SGQD-YX6GaS~zu3!Xe(SJLiOb6GU0(`lcqA zQCPzkNbc%mR6v0hUGRbgD6>B)(jj1T(o$xAy$VW6pt@Ml$7Se<*O$uY}7@f;0;tx$P>t$G%>f{A$tEs&xtcSD>k=S`axoFe? zAbn1+eJMZM<((pFM`1Z7kSgkz!p?UNCXjIrfYxQ$0RB{Ydk(vDqFugj@-WePLXMdZ z6gqE9rmAu1KSz15{Skwia4uzVQab}xYo*iBV=5np1ReF!ori{_ii{br%b-^wh>{yb zflFbWXeyB~hq@-c8vpj>1-b5ej5F^UWCZ;3ZTz<%KYw2LiJ|>>U$!Vw@3ok&*-aDM zt`Mtzq{G)-c?jx(Lb-iXZT*#ad{szw7Z~l$CS}g-B+`JnBu_E2`W$ zq)^%`vvFrR8c4A{Ft}VTW!drXHibyoD4Z|1V5ww42@O=<>E9sMKtPW7K)dLM2D+I` zKRDHl=FRZ)#Rt}i(c+lD%=yK9KIBMK-Lx$=t#}(9lOaBJ!S+NQrS{EiosiR!T&m+n zH9N#y&fr@h2061yQ6xipWg)ymHXVGe%_Hy`!u?!Nlcr}Gg+OkNQdCqwUIQnk!+Nk^O1D_VlVG6#lP;Xd{*kwbA2ZJtHH{%w&4r~!)GyAgHd+Tz6e|J2E5ET;S8|M$Bm zP=LqQbr3cs5N=&ui-9jy7ms(l->zl<}=(9Yy2kI9L{-o5*tAKF~d zEj8pRb%*oMd3$rYRGd&U!^u6hax>^(fp`Sz|Nnd>*Gf9|IV-AwDY=Q(1yc!*b*MLg znjCl$hcV=Ns~*VYmQ`)X-g?a`AV-24gE6dne{S)?kMe5M6jWUG=EYt$$_QpArf}i3 z#mLablvu$7U_Ua0>c<@R0h7@Vppvj3jzdiX3J~H2A1RSW?f?7K<~ff4(T4c|O3h}Y zZN$9=&~=k{%Qsu)F+8_iU2TQVIGfabM(VxUChDM(;bFbWYXUS>f_!}UG+0D#5A=yN zrPd8q-|t81^;AIon}p|XznL-zwRkZ%71Y0@LC>Mry98A`;1mS^9b~7PtHXhGaF zg+Nnp2!>^6Yh0D6Ew6;gAqE0CmXK73hpet~sPF;9H`VyW!i;p4+s2=0M4lUH%VJwk zb8+<~tHrVV#nFOVI>2lhG+K_~F_7x#0jII}Y2)Db*7DU0HNO@m6Sv$fp!Xxdwf2Ep z(DhMYn*X;!2)zkG@Be>p2;2PvLPQSGgo@4quC6Q03jzN;1)?lOSe-R(8E zPgIvW?_{&}9mxqXPu+3q?47GZA>bob)MNpGno+ifUPlCj<}eUR3I;c)UF;14_51JC z&X)4e`dXxxw&F(Sze&EOswT29*3SDp7+8g-&J29S#yg~e|X%$)6iIg8-^^=nT zNYhH;;hs^$wo==>XJOo}6CgKxLUH|m+`z0m`pOL*^J|)yg@Y!%;U>;lXvW<6K;;ae zcagOyjd4w%Xy@dvedkRPto|U+Ouq)Ml{d5K1CR}@BQ!$)g}4VQ@RhovDW`S{4@Ig- z$3_VR9VuBpgaEOycXY-#wTg9lW3pgJH;riqYmi@~wM^m+<|F4Xiyw+*K4A?)a*uY* zREmD^6}d&xDL-MX=$>TM8m7wHz6p3gJqQ*hELXnur%%r^Y8Vv@l+M|`^F)R`64kH5 zU5p*3q9rmw$#8X)V9@go4zip235Jlv7{3Smg)(8S<7L`4llO5~1=BP>b5WYhVlP}q z%a{8m8;72bc#2QX5f_a&qCUq>m+H`W_j5Opc_z!32YB0!yt?r;EdX*Bx7~IAmy-)2 zzNWu4-l^<-0d8{Ida0SR`92Tlo?EBho_EWk{;8SzGDe_d*2JQMJ2};DFVmR${@6Mm z2d@%zo@{x}#rxs0Y}zK>>QFRmIOpn=`6gFT&MHDHW(oknJoo_3k{|z_q;&3(p1$+B zC_@(BIBF513iw9PIXrJ z0G(E%mD{}I>ri=pO-=K)@^inQp80-G@D{Ub>&2al28C2Kv%yw~MG~?PLj;A~7p!_A zw^qTaSX8P+ook2jJTsMQpP?nI#WTceSlv?@OiSUQiFNec{iu-_n>wk+Gd>BKOIR*jb%ef$XRI+`X|O_MasGTnf4` zijZ;S&b@E3B0bb&rslqfb!!{QXhxyS)lEa5{_i_;!Co){omo7>_7Y}CRK-b4%OfUNJn!Qs#|P{zZENxjY$1jqX9>`Q!^MhExWxxIn~#{TF|(x3yy%{ z)Micky1nh!%*@{1dI9<`(&7kyhWyUolopcb$Wb1=#CaAzT~mwhrvJC)!8Dm(WDo%v!^)JGf80JT^QkB3D%g_ODXCR57SKL-_Hv zFG5&TeUrV*YD4P0Su9BiDjDt@#EXWfk}f-KF$$D^hS9tWtP%bm*$ZU2SqyTdWeCjB zh9P|4KL>WIHabe6KsRTfr|Kahm)Hkrk!8HLjZU+MTp!fWjApbYL0D&M@Luk;c<4^9 zHuYc8rVLx8Azpf!SB zu8&FeW|FpD=d3eYO0+KuLRSm(7bw>B-qq3Afm?Cj>9HLIFWwN|aNUz)lEGdJgKG0U z(kBB>uVd$jOGw_s8I7nG4YjS{rDuTu?q7i)2X?-(DnDGg{pYWSojYOF1#Lk?v{Ww? zeV=ESIB9w*IaM=#{bFisYX#2aWoHM6{;p^Gg(5A}WFSm62PocUC;i|@rsiPhjK0jO zBy9%*!KR(5Iop-?d8g+)sGL&moys^!IMz{Q!ro5~vJ#SIrWP9EPy&QJ6w^xE`540cdWC{URvx$+>jGyb9oiS+ zwiwcSAcL?3Fco^=laoYRN-#IV`Yp0WVt!7tTH;~UvOF2?0g8=23u^`0aXQp>R9U}} z`IJa#x`+Uwc`-8O#8$cK9&%cnWoA)*a75cXDnUs1Rj|BYcqvm&tw105q2qkd&S}mH zxmLuFJylc0{XrR61)cs4`DYMj=w9D!L0W7052y$h&6=M~lnwRuX|wA^J5kpGxvag6 zi94}|z!sz6sLcmudoN&YRk4?bt?$ADGQaQ3tZWT%suRp7gZwX&RweP-PB4&#g~I(Y zfoQcw@qsTJEV6*F9^nPqA%%3!2Hpzla7`sF?`Ic4{UIo5XSlnPIDwSrS@6yQ$jKwj zd?v&3Pyr#d78%j;7DlVu!HgnBr&(lp0cS4-hML-lGY=wGcgMY+9o}y{fP?xf*a5<5 z2VZOfC0Cb($C9mhpV0+XBw)cjPd`7DxJU&+*CLw#T;Pg9swA=;b6Sc3LOm|>)pm-3 z*5$$J#-Eq=Zwobhfj>H$P1O1~>K#n(I>R4*aVIJ014=_gY18XyV!StnmRB|)kX`U# z&4gC=<73G52gtw+^I^_OquvgC04sn*t%pep9K=)i@qS$}X;Fzj->sdlyWi2@2-!I} zS485G4HlZZ-rnA2t%rz02UuOmN3PxXJdub6((z`4y+PRDVlYqb(wHRtWymqS#0B6p zjWa8y0zq0r$8pDZFb8pQEjZ8JgG?#{vOFsacD$pbC)D3rPt(p4=2)oiC#Mb65kq1D zuY*Jrf!P*BhIyVj5ClhA?)T1h>5vHj!&^F!M4Dn*I0Qo&!F-REfVkl3sD6)* zmYV&AFH5PG_K!;R5e}4ROlHKmhYO}eRz9r@EJJ$*{flP^i{vL2;*zo zSk4-F&NCZiMWk5&mjWzOelni}OAfi6B|{nRJ3`S9XhS-jDCYce5~S^lB@1aHECMpr z5qf0&6T(9Ptd=QOyM<5-;{qtHq?rqv@r@neJ%H^* z%n1x5Bbt4&kJ0CxC&&Ch=3>Wq*#aXX!5Cz+t5qu#Nub1;jVl zE!doQOGEs41wc04gRJgIw1eMz4LEVb+#ZE_LR`x+Fom5cFyRPJ*WLa5^$Dj#_I)e_ zL)$7}a&2ARq8f=E<_vZXx!I-&N#Z6|RUAT&K5F(`1J{Ua)}D|dz}!mgCnRWU29>V=QXyd`PRt!8J>*0Uh(%(-LulRurBGJ=p55)+#`a9m2 z`K)@!C@9Gsa(sv*it(N}D4cXb_lX=`!zSODb}q>Xm%L&YPm&PUF*l!&L56R@n#E62 zOAuc-6%JXjP?ah>J|ImY!*b@s0@9dJnj-#C7vyMA3`^&NBSS1PG4d5u1@=^t6%jOXrAv+b>S72L3cxqS^8wFJe-On!uAj3-} zBXtKf90_)SjpjkJ8tTE%vJvrVmWTG3z5q$i_W}!>$`}S2jn?{$B#mX*9_3#Tude;g43j@4>XJkVNaVur=*1BY!t&%F|q=m>rY7rAJ0Q>VG;VfP6 zOlKXKQDpLs2B)6-AY{Hbvgj7`AstAJ0T|LiO-)U{q){}KF?bnj<-XGKjtmo0G92EkG?J?*FSt-z4p6m@6WEd> zn=PeCC3#{4%6=q0?tmO!weZy^;*-&7!;&`h63!#kft+n9=q{dVXnOt4p+%mh8}8XC z6kJ-efM%2Ty&Y89g#?bk%t5g4oq|Gq%X{(?^ft-?k6Qv|EdsRLLjJ#n*n+%=hDPs^ zM~ALMD`e@prMn#Y05G1rVOYclULjU&5hykJl~5`tR#BahK+ScIUP9=<&aEoqQ>u66 zGrNDNQ0?XFTKg=sb-KFy#KP(hQ*oX=#5Y9v9)FlW(S^&dk zU=2?7dV``3{Ng|`dJyge=xh$0)a{5Tsw5azPXU6`XcZHRUO@=0N`mFT_XO12AW}RP z8K@qdzn%#DNShg=vu89{#}p!t{n#urY#6w-57vc;poMYjz~R`-se(pGhj`f&Ap>|{ zu6Gs7S%ZJ3ViGJ06#u8Z5`;7cHpqJjZa3t+h-)5CLvCR;&Vk2#vTy{W&L{OftRMZJu7#nQKnhndAK z6VJs;$TmT%kKMn{=IVD)QLV^r0<+v~C&kRz)EOFwH6+qd%*My|-4hzxpQCuS!qqYK zh!0jG`l2S|#d4sdB0WpzDvHlsy;i12V zjkm7K6!vRb6=>w^?H-JjZ*(_#k7U{aYoWMvbPbIF20nr=FiW7bRB@Y_&niT~x`-!P zuwXN(K{H+(A`w0{49&b8=;=4kd_vfH?0zxlQm~_7SUWy)v|Vu-bFl*O66X#*%hef` z&;BD@)VpQ!v8_O(vVr%YipYKa>c6Bn+qD12icY~(bwsj(7_0vvz_Oc^oLJ>coX0 zthhYE^JM$ycJE66jJGAoh!TBt!|}@l9$6eT^VhOpElzZ^iiVS~yuBiA&|%x(l4r5@l?bu*E!dPda)Vy3({OuHGc8sc*|rew6oN z4N8*lYlgh773M~zKmZ9#c3e^}#K@8A{KW*XOPJUL+y{S?-S2}XK zz0adAnJ;UMquUt#nv6d%^ztf}`%<5oymp6K3&4V(CF1Y-T_D6kW6K|1N+7!L&3#;w1GU5}&YOu>NM!da>N z^V)f<3qlgyj=D9^7Sk6JsvsEI0biRhcdvzk5A3;VHmOrmf^Ig4zXM648_91YKd=R4 zxd|+Gw^(B3HW)&OX7r#uQ)X=(W@;EtOVc^sSztImMiqLFj7so#~uehowH{{d~bAeftuERe1?4c(}|~ z?UQ`9AlU0sPLL=k#N-iPR0J*F0E@n+)Cn#@f^Vy3okz3G~~sUfRjg@ zZ2xydM`N{M0W~!t&No^q53N%*{HitEHTvak0s;e#VnR1lV%L}`Uq1|B{-jpbP91DL zt$+@!<7HEvQsKpuIhIMNYbBwiBcA6$d8Zj_eZME31Kk%SF>+v;fyQw6ApV5TE}yBG62jcqW~djf@B z7QZdb!x7P|rDGI2TYn$kzmO|?x}dXx-7E?ZO8Li9Mk$--oIFN>|ZE-XwR z`f!v=&5})lDzrY_qK1OoRDKpOD+k8)MPDWq=g! z>7}wwXT&aT0CRt7SIV?0^VYkHKl6w9s*CN)fBCHU4l1fp;hV~sn?cy{!sUr%7Ctxe zld76FKF5yG*^O{LIB;(-+dyW@0g*N--L1_TpI#`}NBoA?4Ew>dOCYzCI%rQ;!$)Uf znaj{Gd$cZ#-3-nWmeukGimeXUM32#-(dY1%RSfXzmEK;+QQmhC-J{(ycx=t6WhPE% z;ry>nuc4@GOKFL-s#q~rpKB*e?b=8{-vP+y{eN&b??xg#u9=D}&=Rb_S#3HWad?l7 z1SnhXLhSfh$P9|^n58IRK%0iFrVL#aGT<$+gHpN-{iyu&P1#SzCLI;RNA5d{d}Qk=NFC(!RwHU102WI)Ck&C(ZU z;2)wcVCs;3bNbDI%Mfl)#E6@+X4#Jg$RM3k+i$+IQ2+B zrkUG7(*mFX1l}ncvW^vduvsL18R5+~tX95jw+6$~_pJE3-;4fw6A@sym)|z3_gQmc zwFr_nL%b{W2d3W$KVhPyy?LON;k3_KxD{pDh~6{)oKBPpLaUKXShBvV?6v!Y>W3`} z#n1DtgAc_AJ#*`O_DVBY%v&3)H&~`tGH5PrESylh!{sw8^>siy*azrLi9`Pgy3UNI zlp8@O4-uimDzwbvzB(?ZhQ$<#Yoeztvd1`P>-70-%$SX`h9ZQ6%Q$YYIAv!B*ne*9 zJRo_#G^M`oU_sOK^K*|mJTW+pXbx+(PYbb3AX$47i=x=y34oHbIs?c$MRJT1+VyQ{NmVR-1B50 z=@u38V-t(4-^=T{54=%R8ZIUdWTAyMH z=?jEQ82hMp+uiT9HgI%3$um9!BEhkdWX+qm^#XO>oVcjfE)58+2zl>UjiR|_F|>PE z*tm;rN3J%#bx`pteSebe6ZHM>#>Estt~wqlJn#5CayL2Z=F=3i7;PTYI>-vz94eL(#ih+; zqQC)X3*xQ_{%ZlwgoZ)93ibm3ZL7OI_H2%EP(g&gn8o(p6SrHQAT zbnYpv_waesWb^J_>s3kqX(6W!;lq4jM?^J!vTwkyuwOB%bw)XsEO~km%3}4-&%H1w z#3rQ%{9{jB1l=rou<95RG-cZP0*&bH|v{??ad_A&4KaZ0hF-gXrn0qv|2~mo6us* zSR1A{ZNVObzW6G2;Q--UzZ1@A%bCa=Y&qE&Fx0K#|L!S#%CuA+k@t;T7T=$6=1OHQ z;^uwT>QO0fl2n-GPLGy=g0r-Sr)^-p&Rt9U-T0#S@3fdMyq%tt`CQ~720iQOOBUHY zk26QpObc?tn9`N=@Tzyvb`}QO$2D{|J7=Cw|3a75twr)kW*?Qe)0Ql6x^N(gb9Qb2 z>n62x(J{;)tU(^$x%eQfx+!RxhQT;8mSN39-=ructTr;XSA(C3H@|~623y@{**N0v zIDrrSd}i@^hw@@^*}C^hEvZslkmA@kF!nuRPT>9|Fu*(KBh^8ex8SshkBG%d4M-D%DS~H(-^rZQ^+v z6L;@?C1fc>H})+Spynb@6~M7tS^Teh||99ujtYAX3q1(bRE;nvUeiJI(18>I zUf$C!hL64;Z7F*MMNYU$RF3Km7Ph%-+NN?%ONjYfmS*s6P_`^D-wQNB56e82NE^#hNYtT9#RhT;;Skj>Z$9BdnW(w+Rp@w@0(-7h>) ztHJ9(u+}^?UVm6>c_?_JSv+Dlspt5=y*S+De%(^%j9UYFhJtk`+m2qV8*2M`j_s1+ z3m?usxqarEE#GR!UH2Xk!naxfMrfl`P;)1soI+Df^dhUZAZgay>;mynpLHFZVk!ad z`{7^WvpO8M75SVk^-w8YP-i0WN^iF=tg4go^~M;I)qBEz@(5#Pgu{Q~Jh)%Ar(cH53?W*nmFknxjJz`TS4xnOq^u`Ib z=@%Xx6iu3v3clxgmgKe6;^m zU^Jxws7e?>L~XBop7*!Nic~+<5IhL+v$#om{kY-NQwKuS`k9OjmF&RZ&CdXzToUdP zktR|Uuntm-dK&N4D9qD6N>2AJt4ltVu){<0ycP|!%-;9DlBL?+uk)6H$vKJ``AN6i zGR|WTlhy+fFF){BWAk13mPA=wwH|CbGTyt^J|F16txQ8kCXjOF;ss5o2LH{jCUvpA za52*Nd!>!qjKb8A&t9@A23MjIgXh*ra?YMnIkUhMt^PeR}fC zQ=#wJ3_X8CU33P0gGVETY7y4#dSKmHdBk8YaE^zy8EAa1DYpPGP-ev&Q$;Taxn=1u zoIE=dH*zgqLFg}7LnES_4#d0#7@p~sY~?z)EsT-j04AAy#uoXnb^Mz2JGGBn=@>_u z$-vC*Qgz&<&*p>)ll2_1);1cd|V# zOfnZ59v(1WV6!Q}?<=P4I8P3OHf^?ofsv?Nm=)vE%F=V3rzdzaFNSN>mUW-KqKmAt5HQfuZbdZT916OlQp z6E5~}xQ9!5ik{hqNO1YTok>nw6jRh&L0Xk7_59w;rGu+DHuQ~YsCJ6xV|WfKv4$bK znn3}6&-mrfy!vJvh`w?ARr-%Gr2JsN`*Hskf9PLOU+8BT%B_gXnAxgbngLw$28d4H zp>sP$JXZh>P1f8!LB8kEkPZip=}G;KFO@4v&w#KUuNk~>+h_gl=KA1v&|9k1hqp7q z2T46G50O6a)z*9TP?)xa}h1Y2dWLaSXpk!+dp=C3;mt|mITq~14DC*^XJyqt#XCcO@%x_2m)a<>xAE9>#D{Ap-Xast3y>$WO^Sk%C zAWL+HVi&x-`gz*f_+Kvob{-*&Esy=tsGm?#7R%S1+jy=XVS2GVP!$_SNcliCtZB(d zmF7He9|8QaiND}?d&-bb84Y&EQ{Fgq3M8Kfg$DvMbyRid4YtO0DjjZOd~F)9sXWBL z+r$W@H2^8&%uFCTZElck%RMv*wN3OkbCMS&(#AY1-!Hd%^T=FY^K{o6i#WBsTnPrus}<1d*cw#(+r#L=XVfIP zRADyQIeG(3$vS}5k}V#(L_}|c)gcse4<|Sf>ep;)u2x=aa#bk?v?`;k+9muJE*;wi z!Fn>U!Xg>34EcS@jMsA4hmlZ$^_GRZSlR#7M`y~pQrh$V7Rm_rqyX%w6Zlc z$XzX9{HlQJtaan8r^|(7a_IG-$#Brt~6~>j!dvUTGyZK8JLi=V)XQa1h(2FuH=OZuz)@I!3 z!}Yuv?5#CQ+AE!kGa#Q&Tz}#frD&z{iDNo@%Dg~m%cMNLMb^NUH7^`Ks9$m3K>4D@?~z}WT4ZIOZC zps3JwJimY97ns@@Ck!R&xJ}+!?(&)`xtN9F90X$t=WnM!>q75~!RRK)Fw^>Bc(XGI zV#2x$A25BCcsE&DxwV)@m3t+h@>$Movm#IVfuE)+~r0U)3sLH!Cr&o=aA?*niTc zhtOcA6Tq>_Y&O*{-4T7#L28IflUw}II(3G}i(h3bN~Fx7#zWL3a-^+I$gSbR0YjWr zK7X?QR2^F@o&Dx66S;y={zSe@8Jbx!u5yploRfZ6Cb+vNo$;^?szrTyQVI8!Is3=R0F~iTl=YNm4s|JvI;QBk*yZmJy3WA+v1?U{#wDZ zctrKJuisAy=8k${cZf6=TqL5$zba#VjsO|KzaShGdv@DW?<8@`;}k?n)29n)I@B~U<$R0|z;sKR45|o7`y;Qf(5{L`I^{9w# z4c=2b_vJ^XhgWm0TOg=bIA36=E}l9|qKXMnb1@{w#~%+XRTzX#QiDQ<;UQ&ECKDQs zX0@j+d|u*vXIXA|8zIjhULrN5NW7e{41f!qSF$E-SJ0fI@ZHPb ztWFaPMPi?j6I4(DP-~653y|ojVSwk2d~c2487@ZR&>RBx@GtxwLi?Rl7%qNnKKT!c zH9-8Si&}_>DAe!;$<8s}1R~i*ggW|BhV0%BC6jQs4kmb@ENbVT+}^0)Jf*UaSUge9 znpC;+?9kLm6ix>PP9TFla+lK~KKK8NTt#|@U?+r5`K?5()s*;>UY>yWp+}lqyu);$ ze1MEAQsAIzAiNI+gut68V}$+8N8HD8fw%BQ%xyCSPXauHN}2ZiKm~Zp=ey z3{xW0n}cOIBM6Hqn2kK+fdTZb+cd9c5O42+GFmdyN5Q~cqFvn;>qhvg6b2ya$&d3Sk*GnkM^y{$jnaUkr=TxKsT2DGZW2MMOTK2aDWq|GxLIU{M_XP{B79ZhV^zvs;de(f2@iQ>zv+?q;PaFb zxT*iB)OVb^TuQjT z|MUHWLs1xOD~rCDFJGqH$~?Qo$wGlhvJsgN@b>fDW@5d?_s|?Lz0B?u;sg$s8Ae_p zMxR8W`DMhZY6`dpDifQ7Wf3DFuXT%dao^j(x>R>CJsQug8Q zQG>_yk^aKpB&8w;x8!e%{C>Ek0gnO&0( z`Cj6~I!%P>j3l;T3$j#sTlq%}uTEwj&`1Oyy5OxTzMsPLjsN`lbD=+&L~Nr|hy5+L zW@^PuSPTDHZ$ngwr}7d=eBDb6;J@#MLsZ?m@mfQ*TZ3rl8{xcAT6Z9Xln$9gDBWB> z;qfcWXEO~*FFf7t>KrK6{Z=qx?Cr>jW8x&{Bjp1Hh|hFVG(@MkU{-Se0vOE_^{p?m z^eCMg4wAN2sm|sl(AC6h&T5=OTB(q2zly0&lz&;~Cb21g>aLvJU(t;yKWrwY(1w&w z^zltX*E=~AR{l6<&YQ6E(^;C&<1u+akKmL-Are`zU0)NIg!h#J{Ln4$J8{rlO`JD& z1N_AfQqlqY@5VkbbFcNoWgdi^4RP#bhCPogCj$xsH}Fk!mHQ$*h}AP4!q9u?aa@EL z4H;0d0~!v*k=QNKpstqd=$jWOM@{_X=$@K!2bzY zo!we4z*Y!HWie9Z=wT}jNM{?}N*0-;@7xu_Q(=cr5qQVnoMBXoD<@odW(+vl= zgu+|U0$(g-u;WrHg@Gnwpk;A+V!ZF{knhDXowXHc8d*ZM;V=X9V1fx$A7u>;s+$Kt z$O-{tZNZ8lKg06CNs%ZUdXBL4bJX!b9r6z5=9R?8IqFv#kQ>Q;uE+RZh2dCj)_=g7 zK=2INxtre(Y`ZtqvK|VMMn)7A*y`mQA;8Jnya!Lc1EeM1QJ_(MRcX|53DJF$jUlv= zl05ZMM3;z&tUaFRNCS*AsaPHpxSui(3z2qXuvnb)t^`!s@W*B?b$lG3%;F^?_`s$k6#|)l;iA% zK>3Pa(Tfnx^!S@W{@vPq0fRE59|QYi(Ocg?-u@2Te{-tqSr=Kdu)uw}#`~RFhQ;3z zvif%LNRP5p3*DwE)o!u-pKlaGkTo7}2G{{ltjd?Lc7e`n3|>`4I@inR>jer=V7 zV0;fdcbQ4z`SkO?FvCccn!iv&d}?^d>hTjOH*@q00%ncqPq^0cQ>5(Wa*HJ7_UO)*{J#JU)c%XrHp0i)6acg z#fV+sg|E|2Q=r>nPw$ax&4|0O+ke%wF) z>&^j~hwx;m&xjLV(wCDskRR&9n4{d3uX&;0)?V&1ec5 z(={iP=r?K~x=GYh4$3x;8!A+Y*=#vH}g9+sv61{3x)*Cf1k)$$DVwqWHcs zI0_~K0dQoE#fWVI%V*2_FK{bQ^KUR^5!`xBRfPjtvKPk4_6ciQc8Z-5sL9bTs?gpZ^z5$%UPKp`^xaLYiRxP8fR zA0dn|^xh#PUu5JH-xC7sQChFrkn(^A0@)+7WM<~?vX^-<-);$Dnb1_CO$n$({S8YP zTas8CgeZs`C-$``g*LZpfvKp$xHcFGW~k2I1f|*5I%8gjLPzqpe~cIyxlYXRyj=j( z<;CUtUe%#C>gaKOi=Xsl{MVk%|DkK1nFfL2v~W%9T^W)~7q$RNdj2I_-;d(a1|l;* z0ZaRdQn*#jEq(#Gl3s_)-S|LdU6sfzGRMp?=U?feWp$t|?DRQsyJsQWgneDsYCi}K zi36aYsNE~|yf|LAw3?|e-&GA}j@SXwdb%9y3Eo`V0or>}I=cD&uZBd&QFQ~2O-;|w z?b;-Ns9O-g(ptjr11zgitkvk+c39{X~rVCt;=4A3o4PY$ZHJS_S42 zX+m!vz7BtVM~C8@#fi$fI^H1Jv}zlx(g0?KaS-|RE^ReOzN;%~6WJTFJ`bRvXaiMh ztX7;T$IX&@plc!dgL9!)uV|&E-n_51YbA?N`&+~&M^Ri4H<063{+@{^t)mpI2!L1N zIeB98Snz4`&CH2q@u*fE^Yq+461Vy|W&G_ANykNA^AKyQFY&&90`IAd%yXprBuh{c zg{{2cEn0x|?2ORkHy+hkueb@lYOUYheo%zN>SO>)eBe+t7)@;jZ@JpFj87r#S|3HP zmcBAZD9iDK<3-7PfZnVWe!nx1xT(%Oa*@?bLsCNYqe>2^Hno92 z?8c!?>q#=3U$Oe!laJBvYNaCvcu=-MlJ z6vlXIqO%Fy{%X`S_U=A+|I|-*os$V+4_V8^jC%L5-wQstdxpPx0Vro(VA;?g&;d~7 zowOdLhh?9sk);A|oXH25CZ;}Dz!2|mjC4zNaIloA81MhWN^YU5b5puE^3Pe44;7vb zc6J)>vjHJ*isfzw^KkK|Sn-+bB1~gWiRh4LhoFg)Tq-R0D-`(XZ<&=_Vy_r~ZJTwO z*}@DNg5UBIkh8iFZsJ}Wu1fL9K_DpgLsw-I#)&RFyUBCDL`4M1Q_t^A(8N1HDv%Y) zqC=?3Ifp1jw)H_**No-7fvQ7kG`I5Vvl<1m*YfHMop2`SM5~@L5@Ga)@$!fpR78dD zV;%iMdpl^fyk9q~4s(?~6c_;7k_m9V*DO(zAv^`0LMryzluT%Rhk^xR2T)$Thz%_C zgbqgmXk#8Pysz2IH?qs z;KsWp=8x^)5r(D$9FVu>-$uj%d;vFU$P*&TMseeqvA}#lr^A_r;z)1-b`kw%*Z=$n zfY9T0h!`a7y*U<24+m==68^r00rJRPkQEp}@)y_X=1v@! zfMr8!0rGGI!joUrF@@w3sVaIwNOo`k7?I&Givw9s(U2whKQS2BP!V?~T`~+pY#v|z zYft=h9XMuaTu?>Jk!XFcsEBz-a4ZEk`e;g$g=73BctO@XW7Tl#C`ghEV60Mve=P~F zvw|7NU@{xlKCsF~!c}&|L2(N^!c2TT1uXSZgbN6jx-6FP29EL|wfjVC(sLM~#vO~g zM`Bhl00g5_Dd9q(c0bOpf-PwWG6gXh)Je(P>;!ks8G+LOtspl5LQ`fHGIyfG9o8S- z$W6-VUc!35XkZEkP)lIFdFdc-0Qpk;>8%FJimAOjAjgm`PfR1;)&n_sva`{(~ zF&-f?PJ)>KiD}cH|EIkx4QeXO!buEc5_LMPt~61k1r&`aD9unD+U)U9cqp-B$5iV zOenyDavM;5Z2*0&Y|?c`QUN?a?EXHz%eJv&&LG!bAo`o({_XGZQ97!0foy!FYA&KY z)HA^EijP16f{wsvu6rSnK+Nf1g!V|32i!Xt3Namoa~zT9a4;#*f&Q2Yghoz)Bs=f| z&NULeXILYwPreggVBpqhXK6Xuj-!yGZzD9ix%=D}G@t+zFSV<%i7mF8iUvSDQrA0< zpu0~^jThlzac)xIUs@=;fXN|79(-i|LP3Zmga?J#LV}Ay3lXfwjG?~kb}1+E&+*H6 zkd&|(8$cAj0kdx+1<%m71ul@n@+aU&J^EpCz$7S4PID5E@T>kGUf`O{8=&i|+Hda# z#DHdLeG>xYvgj1h^?bAj1ACQdyVyZtn!h-Zsu%0Ko%621z79%quto-v#VDR4Hnfih}Kj}(D1xUVbX zir33myQnHup9-|J9~4GD3asT60FaF2T~s&mIDd*PNI&z*A*bj~1^?4LJ{q<@vmOKWZ3d5PAdvO0e@)b~Ahz7gPXW zTUrMh`9AxCfp0cK)Ho2*ZO(D+K&(ZOtfT;FxWu0(Iu-QPchClbVC&jsoQeR*I*~e| zM8#l+f`R_)?4FJP0P0SRil%(v91R*4gPBoQ6V(u^WUCIUMzs%@+|Dh&YBg;P^g7oMM1ut>9lkvm`CrFp+&K7WnN0%07QD|RMh!2D7( z4gp41T1wfz^LBaR;x1zOh6a^ygC$=?!Ob~T;w73=b zi{PgO$kJ@6cg`N4Q%FGLq(*XJ*_%O7&^ln@&&rUkoq~ptlF5c#HY~TboBfLv^himF zWP=_!Oq}(xPy&J&Yyf;yUvPVr9Yh^83p-2}Qow0>T=(wAGdR(-Lp90`_p!KGJ2F|q z)W!129a0}t(M&=~XYhg2Lk)~@^*&^iBl#!6$MVm+G(++85N%u5+MF)HZ5>mY2b1N; z3Ms_&E^F9>Qei<1-KM)>C}8IDfJj>bysg1OnuO>xFBR>o82l@NAV`BK1_UqHNtWf- zN`bwr4TN+e^T;@bw?qRa6PgnOd2$+^^Ss@YdlMB>qQxK*hXZNUA>5(>pET9l+S-NL zJSUcO1@20kFP##iQMt{=Gc4hC(nq%W%sh4*jEDkb0ea1(L+a%gLld_OTTlM6t`Z{) zNv0l{8ssi$jjjgrRZyMR5#l!lmYDV`1|E4wKTTfYh6@QY)M2saQ~ z=!>A=LpJdfidW~t1BSh#K`DfRi^{Xs?*Kp3*12c8FgREL{OWybSZ3AiWm(hHX1|(S zo*D3*ZQZ`mYNWJ&^Do0K(ts7Fjcnnsc{i**?`G7F)y{3G9k2D;@mC6!#$;h!EQL$T zlVrYKig6*~8?{TlIyg3Nt>Nyz+?<@Q&s+Ueyw$6H>uX0%%*+m@3Wbu~wi0hPTb%C^ zs0^i1k*5@j?JOR;qA@RDE9c}pySTWN#Ad+8+CSmn$yv9^j^*A@Ggb}j%hwqamO8?~ zN0pD>=90#bXqoBY&+%Fo@7kxzk2`-cCpULKeU~P+U>j?(+Fo{0T3Xr~LCx!pCPnP! z_`S5L<7D!H)`|&8f`@uhUcm5Re@sb9d7m`GtUHxM->pggO@KWR`_~TEZs@P5sOSz` za%H!?y)9puY<2_`JZlzG9BgZH72>IPFm&s(ymJVFjGmd&vTwFZ%_~N7k&(}O4JiMfO{X}A7 z;`-g%<316;0b~>xL^>v@nO<8yg*UzleoN*Fr-=?zss} zU2mFt`M2}EWhV#dcy+u`1`X?P3wBV&E7zf9x4dnNH{5o!SAq$yuDCTdxThy6NqB$F zrJBNN;5x$vMB+)9Ozttu6qDt6Z?T@~IUdp1SKnyxeUkdot?|wKvabG-P41x)ULJj& z&!2zxj8EzrD~&fGXDMWk9sU-C9y;!HQSr>~mGR5~>WwB+V96zJz#`kYPsjIq8x8;b zzPn`8XJNNQ=5;7!O^S|q1au?0|;%1`SW)P{*!R)mPS^alyR8iF*Ylm<0K@{yzS3;KVKb9hA zt^2bMVG_d1b@3MzqiOSKOFTR Dn059? diff --git a/wpgsd.Rcheck/vign_test/wpgsd/vignettes/corr_calculation.Rmd b/wpgsd.Rcheck/vign_test/wpgsd/vignettes/corr_calculation.Rmd deleted file mode 100644 index df67ae9..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/vignettes/corr_calculation.Rmd +++ /dev/null @@ -1,180 +0,0 @@ ---- -title: "Correlated test statistics" -author: "Chenguang Zhang, Yujie Zhao" -output: - rmarkdown::html_document: - toc: true - toc_float: true - toc_depth: 2 - number_sections: true - highlight: "textmate" - css: "custom.css" - code_fold: hide -vignette: > - %\VignetteEngine{knitr::rmarkdown} - %\VignetteIndexEntry{Correlated test statistics} -bibliography: wpgsd.bib ---- - -The weighted parametric group sequential design (WPGSD) (@anderson2022unified) approach allows one to take advantage of the known correlation structure in constructing efficacy bounds to control family-wise error rate (FWER) for a group sequential design. Here correlation may be due to common observations in nested populations, due to common observations in overlapping populations, or due to common observations in the control arm. - -# Methodologies to calculate correlations - -Suppose that in a group sequential trial there are $m$ elementary null hypotheses $H_i$, $i \in I={1,...,m}$, and there are $K$ analyses. Let $k$ be the index for the interim analyses and final analyses, $k=1,2,...K$. For any nonempty set $J \subseteq I$, we denote the intersection hypothesis $H_J=\cap_{j \in J}H_j$. We note that $H_I$ is the global null hypothesis. - -We assume the plan is for all hypotheses to be tested at each of the $k$ planned analyses if the trial continues to the end for all hypotheses. We further assume that the distribution of the $m \times K$ tests of $m$ individual hypotheses at all $k$ analyses is multivariate normal with a completely known correlation matrix. - -Let $Z_{ik}$ be the standardized normal test statistic for hypothesis $i \in I$, analysis $1 \le k \le K$. Let $n_{ik}$ be the number of events collected cumulatively through stage $k$ for hypothesis $i$. Then $n_{i \wedge i',k \wedge k'}$ is the number of events included in both $Z_{ik}$ and $i$, $i' \in I$, $1 \le k$, $k' \le K$. The key of the parametric tests to utilize the correlation among the test statistics. The correlation between $Z_{ik}$ and $Z_{i'k'}$ is -$$Corr(Z_{ik},Z_{i'k'})=\frac{n_{i \wedge i',k \wedge k'}}{\sqrt{n_{ik}*n_{i'k'}}}$$. - -# Examples - -We borrow an example from a paper by Anderson et al. (@anderson2022unified), demonstrated in Section 2 - Motivating Examples, we use Example 1 as the basis here. The setting will be: - -In a two-arm controlled clinical trial with one primary endpoint, there are three patient populations defined by the status of two biomarkers, A and B: - -* Biomarker A positive, the population 1, -* Biomarker B positive, the population 2, -* Overall population. - -The 3 primary elementary hypotheses are: - -* **H1**: the experimental treatment is superior to the control in the population 1 -* **H2**: the experimental treatment is superior to the control in the population 2 -* **H3**: the experimental treatment is superior to the control in the overall population - -Assume an interim analysis and a final analysis are planned for the study. The number of events are listed as -```{r,message=FALSE} -library(dplyr) -library(tibble) -library(gt) -``` - -```{r} -event_tb <- tribble( - ~Population, ~"Number of Event in IA", ~"Number of Event in FA", - "Population 1", 100, 200, - "Population 2", 110, 220, - "Overlap of Population 1 and 2", 80, 160, - "Overall Population", 225, 450 -) -event_tb %>% - gt() %>% - tab_header(title = "Number of events at each population") -``` - -## Correlation of different populations within the same analysis -Let's consider a simple situation, we want to compare the population 1 and population 2 in only interim analyses. Then $k=1$, and to compare $H_{1}$ and $H_{2}$, the $i$ will be $i=1$ and $i=2$. -The correlation matrix will be -$$Corr(Z_{11},Z_{21})=\frac{n_{1 \wedge 2,1 \wedge 1}}{\sqrt{n_{11}*n_{21}}}$$ -The number of events are listed as -```{r} -event_tbl <- tribble( - ~Population, ~"Number of Event in IA", - "Population 1", 100, - "Population 2", 110, - "Overlap in population 1 and 2", 80 -) -event_tbl %>% - gt() %>% - tab_header(title = "Number of events at each population in example 1") -``` -The the corrleation could be simply calculated as -$$Corr(Z_{11},Z_{21})=\frac{80}{\sqrt{100*110}}=0.76$$ -```{r} -Corr1 <- 80 / sqrt(100 * 110) -round(Corr1, 2) -``` - -## Correlation of different analyses within the same population -Let's consider another simple situation, we want to compare single population, for example, the population 1, but in different analyses, interim and final analyses. Then $i=1$, and to compare IA and FA, the $k$ will be $k=1$ and $k=2$. -The correlation matrix will be -$$Corr(Z_{11},Z_{12})=\frac{n_{1 \wedge 1,1 \wedge 2}}{\sqrt{n_{11}*n_{12}}}$$ -The number of events are listed as -```{r} -event_tb2 <- tribble( - ~Population, ~"Number of Event in IA", ~"Number of Event in FA", - "Population 1", 100, 200 -) -event_tb2 %>% - gt() %>% - tab_header(title = "Number of events at each analyses in example 2") -``` -The the corrleation could be simply calculated as -$$\text{Corr}(Z_{11},Z_{12})=\frac{100}{\sqrt{100*200}}=0.71$$ -The 100 in the numerator is the overlap number of events of interim analysis and final analysis in population 1. -```{r} -Corr1 <- 100 / sqrt(100 * 200) -round(Corr1, 2) -``` - -## Correlation of different analyses and different population -Let's consider the situation that we want to compare population 1 in interim analyses and population 2 in final analyses. Then for different population, $i=1$ and $i=2$, and to compare IA and FA, the $k$ will be $k=1$ and $k=2$. -The correlation matrix will be -$$\text{Corr}(Z_{11},Z_{22})=\frac{n_{1 \wedge 1,2 \wedge 2}}{\sqrt{n_{11}*n_{22}}}$$ -The number of events are listed as -```{r} -event_tb3 <- tribble( - ~Population, ~"Number of Event in IA", ~"Number of Event in FA", - "Population 1", 100, 200, - "Population 2", 110, 220, - "Overlap in population 1 and 2", 80, 160 -) -event_tb3 %>% - gt() %>% - tab_header(title = "Number of events at each population & analyses in example 3") -``` - -The correlation could be simply calculated as -$$\text{Corr}(Z_{11},Z_{22})=\frac{80}{\sqrt{100*220}}=0.54$$ -The 80 in the numerator is the overlap number of events of population 1 in interim analysis and population 2 in final analysis. -```{r} -Corr1 <- 80 / sqrt(100 * 220) -round(Corr1, 2) -``` - -# Generate the correlation matrix by `generate_corr()` -Now we know how to calculate the correlation values under different situations, and the `generate_corr()` function was built based on this logic. We can directly calculate the results for each cross situation via the function. - -First, we need a event table including the information of the study. - -- `H1` refers to one hypothesis, selected depending on the interest, while `H2` refers to the other hypothesis, both of which are listed for multiplicity testing. For example, `H1` means the experimental treatment is superior to the control in the population 1/experimental arm 1; `H2` means the experimental treatment is superior to the control in the population 2/experimental arm 2; -- `Analysis` means different analysis stages, for example, 1 means the interim analysis, and 2 means the final analysis; -- `Event` is the common events overlap by `H1` and `H2`. - -For example: `H1=1`, `H2=1`, `Analysis=1`, `Event=100 `indicates that in the first population, there are 100 cases where the experimental treatment is superior to the control in the interim analysis. - -Another example: `H1=1`, `H2=2`, `Analysis=2`, `Event=160` indicates that the number of overlapping cases where the experimental treatment is superior to the control in population 1 and 2 in the final analysis is 160. - -To be noticed, the column names in this function are fixed to be `H1`, `H2`, `Analysis`, `Event`. -```{r, message=FALSE} -library(wpgsd) -# The event table -event <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 100, - 2, 2, 1, 110, - 3, 3, 1, 225, - 1, 2, 1, 80, - 1, 3, 1, 100, - 2, 3, 1, 110, - 1, 1, 2, 200, - 2, 2, 2, 220, - 3, 3, 2, 450, - 1, 2, 2, 160, - 1, 3, 2, 200, - 2, 3, 2, 220 -) - -event %>% - gt() %>% - tab_header(title = "Number of events at each population & analyses") -``` - -Then we input the above event table to the function of `generate_corr()`, and get the correlation matrix as follow. -```{r} -generate_corr(event) -``` - -# References - diff --git a/wpgsd.Rcheck/vign_test/wpgsd/vignettes/custom.css b/wpgsd.Rcheck/vign_test/wpgsd/vignettes/custom.css deleted file mode 100644 index 3054002..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/vignettes/custom.css +++ /dev/null @@ -1,122 +0,0 @@ -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/wpgsd.Rcheck/vign_test/wpgsd/vignettes/figures/ex1-pop.png b/wpgsd.Rcheck/vign_test/wpgsd/vignettes/figures/ex1-pop.png deleted file mode 100644 index d335b8fb0d94588efe0360e9629cd19652b15668..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 25014 zcmd?R^;gtS{4f66WvQh*1r!A&S4t2hq@|=&SU|cKkdj)u1XLuXLrPk@7Z6aoI~I`c z2C2L6`}yAAzW=~I_ng_YuX)xy=P}QjdG5^XY~&j?1tKUt6aWAsB}G|H0Ki2803-(w z3q!FuglJ>F@DYjzZU8{s`QHcB<6QU-0KiY)sA$Wr7aEC{5( zzu&s<@BRJ#;Nala*4EwK-RbG+?(Xj5;^O%D`0DEF*x1<3&5hm9fup0N+uPge>1o^g zwZp^1`T2PQV$#dYOKMWA<@|>m8yjdedUkf!vElDR_Jf|Dp0%~Lg!b9V$;smGamy++ zH8u6w*;!wI|5Q3-_b2+^-d>wJbZG0sQt|V}GP#qJlV87n<^GzSuhbaosWva0zPh^d zZ(geE8C@>q0)apS{eN2j3=bzWjEsz2UtgznOpkOG&sCe+R!?NRQ(atK*j0@T{%P*) z9m2x_5B7G>)Y=hJGw$#2H~bzMZ~NTSH}J7-{)x0E)f3+M_;{<@Rm1GxN`X1m)z!U) z($n>>oSd8`{xoT6X=Cl*o;}9#s;qA*(l-4urXdDxY;5G!vT>lKbSVo9i;$`3O2L!L%F3Yf9}}%n zB_$HPfsT3T8Pir+_; z_X44(-*?jgeKB#wJv>oK_+q7K9&mcw@<}}a1dv?(sl$XO?SF+7{$G(of-nUD;rv(r zhw=Y1?|(q~|HtM39-e-3=iRLPLeW8LKK`7r>X^gtu=1RT|K=`-%DYKoGe>KeFSq;x z=63!VjRjPWmIrQeJzX?DAqJQ&(I**|lgaWIis`rT*c*3i7)&F5Qk zEW#WAoi_+x;*l6OP&DU!%Poa8OFw_R^xZ(vveq|xci*+Cbuni+X~8J1@9BU>qOf1x zg%%blEL8OUDqKuf%kiYBM&R|Hv!(YBR|z3e`fiPes$?QC;R)Bi5u&gD1#fNL0q1dL zR9_v-&NDoiZ^&K^N!8PatCZ;L9i|Pf*s6-QSp^(Wn3#OsgP<35sZCe?0S?{t?C!8? zb3!m--LTN=_tamjSzJF4gkrm0_|>{qH!g4?wEjJ<>IK`n))Tj5)S1OaUA70>LU^#7 z-^=5~?Si|8X01c??r9JiAJ-2A5ZYFcI;Gskl6My_Ps@5=yk>YJk6adQn%mhIe?8Cj z3`{tLrYDyElIiZL_C#Vs2^ON)mW~H28LA~9YVM>QM1gV5^2mk8xF_e}meN)KI5 z>nJ@FR8wO`Rs8;Z@zv1Iq;vHB2Yyma9WUIU-rID|{-sGl;Ish`gx1Pv(Tbxt*V?+| zqKK*IC+)n+E2No3Z2|Y2MeA+ECxax6FEVfEIEp+{PCt6+kXJkLK13ZJW_xn1E(H39->7Cx#ds>F180M3(#a)Lye| z?1WH*2_>0*!e^rdE)3$!h&nOj)l)rZzq@wVS&?pr!O_5#cgX4dn1yeHzv6KWaB{k* znqIwC(H^<7q#>^bXcN43WEE4({g@^S|_^5zlc;bslFod2w za#zI%S=AN~%DA4Z4SYzCZ)etih5VKpuVbBI`Er)$2_*U3v~VD<^05kUC9Vex%Gb+R z#;8?%Cm+Glfd^xzT&gV;Ux;Eq*Q6@NV?~Kew6d9AHW#U2cyZCreu7sWlJSR?!uYJH zd9l`POY6%!*Y}%5V9>f+3M!E6a;CimHI_>TcPfoG*NZ_X@mBg^G@rZ0^y)d69EP^I zdD{Ms2E*w2kG1rssPuf1P%<+@l`7lX`BHA~U2gCf-Wq*uFbF#y$s)noL&xew#4QU9#Vu42tuFOI`bpcw^CB4aHavTVuhUQYJ>h>UjRVL5( z2@fN0a`X5Mo7V7Av$PR43;d01wNxJ!>J!B>t1i71ilw0S<3I36By&GI2#gcAq`Zr% z!N?ZB3(=FpZt5-_?~&MK@NvdnHyRm8zY%PpBm=fX0OP&m&Mf%}eF#tP?KtURQf5JU znTg|rI>%iUm+4q|yKIO{WKl4oxmJcI$_&to_Q%BqxC||*^Vf-|ty|a`F^f~bgDZgy zgwWv{3@~&ck!A>ogNi)@(hH*HbjL|f2w{BJvV^rb*5jZ9K}$?CwA5`b{g0)-Tvm2G zeSk;Hh7>Z)0DbAnTre#$!K3|>c5QBogot^?$Pt2MH23;YWKyFKRCwq?SPgu@$3Qy9 zkI07x*R6kBf%w00T_Fge(r>@E(off56+@nsRvQSR%f_cjR^*?*J4PQ}0X;4of~fc^5B)4^NpEyZX}` zjx^gX;Sq3!z})+}1yVwgW+jaLm|E#gHpZLI`m8-Dyf^y^0jN_%*gxr9-w%L0NAAHP zgskt5Xc*dnVKb{Mnu2!^;j~0^*J&Qu0LXvWxr+Z0oL0D4d8b4eV5w@Y?)?{mG>d?_ zL4a9J!FVM++Azr5Az+xIF^3FB7}!P8m;pk|oU3jAeuaW5iXgCnM;#yxXgJ;5qab@I zAiIH#<%SRjEBbqGHGz@p{8h^IACb$-H;=EdkrHEQ>_Lp;aKN$H&?7K#%dd`MW|yZg zVSh0NE?w#SonT-b%p(gC4y1pO4^Sc6QSQfKg-3J<3$y_+{ksx`EHyYRZW@i^0%*ZL z3?=1ww5K-<4>88g^4i4$3@piDg$(71w#{JVL;f}u8H_Y9wK}o>0{}kFh^WHE@I(It zEgu}@h<46Jkt{15aaG%&@=5$>!rX_amJaC?&c)QuxR0aOoJ*SUXz#9_KW8s3yO`02 zJ(c|CENR<(#oRWrowusJ)vSB-D?y;n$To8(bw#l?^Q)P|pSV}ebY}epb1M}xk>~zJ zckJ-A1RMEavcqwir4t19e4<4X+wrS!8OYN7gOLyK3|er`?8g}8s2#qKJ-yPDd+JlFzBK7q(~9{oFk{QtmvZk2rTv<9{A3~P0n2Uy~YQ&lIhd}20JYu1h^z# z_{0?<$BKHBA@g^$cp`)S2TYYvR`gTL7=h>Ad}z0ag?%{*EoFJKJffP!H{4|i)AO1O zb#aXk(HOO!sZK&{5c{_lAzgDw|0Lf>ITZFXwt~8|^{ZmCvRQH(FT#X0``RzzCZVxx z@PoJrhcaK=sb1!8UU&qL0}jTuxqp_s986%|8s-n*cHNCQw{F5|c%q_Ca!>!})o(iX zL%4rON^(8&)x-1pV8)FPQm2@6xb2ojt)1t(-6zODj+BTbGF3j?-L0q#ye2)IPw?8t z2FZ}D>(v@0ksWFuI>s+u)Z<;&-WH8xnexgI@ctl)+dRo!7>laz%^2 zKpyQC50z}sT@$<2$MZ5bSR0N>#-AqdlnK-`kumD91L<{*{n#!{aJ3uGL-4%VxRziy z;cQv|+3;g{Z&F7J71vtgV3}HK&y`v{tv=P31`=CZD@u3MolZk^gdQS`>U8oXR}7muUru49G#e?oa7p~JI)n<(Skc)X;pb!Zne-+ zHhnKFa5r^GzGnxI7mGsHEbD?7RzRSgoZs(9O$r*{Q0nY)N_MbXTdh4W76NAo-i}@} z_K;V|xdi$QW$P@&Zz<{8AS_-Zts^kwbqyFegCn+nK?4j)Yak(c zQbhK%S-aI-PnV}>MCjm$V=;qAR1#0xs};U8&*U$f%Bg@qO3 zX+d`Wku-LA+wB~G3nB*((~2Q#mV3ah3~H)F-UgEdTci*y83-^mYQ1` zH+<*ElWMJhHs@W7BYrxq?>x;S`JH$Qi36&))cAW_HeR!e-&L&VDDQ zJqv8Tf|bB|B7bTF)GQ(aJgM;c^X#0anlz{zs{pgu{oT1hn*N30O}Ef#u5RaYQA=Xb z2*fpgrE8>Zl$iQ7>_?}kN!*ug+mc#7#JMfVb0Iprq-@KiLGCbU{3Baq=h#dugppA1 zDQ1qZXnjNxuz{Hba5-o(s~p8?DhH@8z9;$)+xSS>i0@`3`^S{US7qf_-WS@BYo&Gc z`u`Fn<(=wb`v&Y4qzt+JwC0)M%D+zceT{Ohe+}Bn{p6e+g0#p&6Y07@(p0ENoVg** zdHvdXFVQ9LXCIjMJ9I3Pk|x&7%kld>_8hwBmQN{$zdA5!u~(TFA5~DLeBV<>6@^#z7*n6}>ZG!lK(Bqlj6IZ6;CY$W{^K?X-rOm#xScV>JN$pu#c3HjmMH5% z*(z>y^DERpM9mY-8ipsb2+b#rL5}bdzCk_dgdM--J2N>wX%yb7Ns#K% z(6Bq6fYvkB({-?58^`bLbiu7%3!n8ev?oA(3rH&@jPsCZ7@y9A$Y8#uXWK~A@xOSN zCcNP$-dGhMUN2h|8~?OIw06I!EggN||>3dkggc4~HzCHFH; zb4kLr5MZ^{A$7%QqAb5POE(9H0wJ_0n`1tltgKg_O`pv?{}qS2*XpfIT?NZx%^MHr zIrmC^KFWUsud;t$%iUsmvXxooM9PctZKQeoo9;V0*JvGlR3G{#V0}8#`nC&eH%ZRf z!pmq=)kQTt#xp-Ie1M>$eDbn&72R{v28i=DS4w-ry(kU@R@--z@D8cMn{=l?kCCE( zDo7(ON9fRE5+G{D=Lgpb0;sD1Kg*kmu7mCN-z59(ZwFVUdK+ThKw8=~cVZ*f0a?fld6=Mc%X7W<3c z%%Mr%yOd6XmqSVW?5oZmn@{P`E2>;emv*lmzquC!KJpR_l4n;iZIVNpRsTWfsJ4&| zW`yP=lpf>$PRHbMx88#UQ7D)@p)pak^_l`6UUQ-A_VhI)JZ_^cH0g5QTerHsn+kO9 z<$vWmMf!Q5AW2!nwI`N_nV`*JIq|3~rS+v`{%y_J#(NcL1^Z<_V*37^PGQ~Imv1Ou z|GmKV#Fav`Dr;nqA5o|JQ}zC(hSzg=$jy zmYVBFdaf4z7nYih#?E%p3$sKLyJu5zHA0=&;pOEw^9K^16NCYG6&^3<7fZH2Fbi(Q z?f9JStS>ZSl+!8IW9)+$Gf%=j4l@ZR#QZP(>+^S3ms29cjkY;h(hX`O*ieI8@F}H2 z^wk+(Ao#WIeijyFnk>eIR}yoMlbU4x1+U`P>lhD0i~jZ)yo(yO<`pA_OZ5cVfE{vi z5+#BGEbAXW-Z~FKwSVGuc|}O!Sy>5sROE0mNVBm63rgylGpjobiaPq|ITS+6u`DsC zMGohxA*tAV41Cpoj#|`*O#iIW+x5W))&_(t>7xOo9G8eb0-%ilS1BCaKVS+VUNNg< zQ^4b`Grf;#0M2%;cF450W3xL5;2fWq7s9JhYGihi21%{Gm|;l)QUev@0Cbqw<47Pi zEBL?XZY!}(T#(f{9gvnBZe`C6?%x#vU?i%@yc9pHJpsTMcT$D|Z4~L@dISI`!;on! zqLzLMEY!u2Ocft4sP!9)G>HgE4!q6AKUAeQtwH<&kOqeOALWo-Z+*LR+W`0@CMX+< zyA=#5RM18PrsWw^Od#aekDV<7kkt_tAOh!*vcN-JS;yhj%K|7)Eb-5nK_?2Bxq<@R zU>h-#*=5o5uyLy>lVcekooDe1J$ERJT9#MP6dF4+*9Jy-)`XKkPL|EN+5aM07IR*r|keNiH#q?CC#`c7$iXM5-cb? z`@aJi`R|i1;F6ypH5Y(%0s!e!`vtR-HUnvOZ7G}xFidQ=?)uMCK4ot z=VyX|bGISEY9ny}sQ~c1T}Vu;@iD5z9|y1{B!ye{dy8g*q?i^(!6jiXCVmh=^Vl48MOWwK@n7fKNLjnva6}9pt&VtsrSby;0Do`kMlm`0~E_drI2eUA#-g2%gaz_2p0p|M9m0zBh80VGX;=X zFXr$o#B*fQDuJx1Yz|Ojmq=XzNb2FlDny@HHLV25N@N3b2Zm7(Y6EXnm9aq7{#QEe z8&82kg_b=1AK1xjdO#N2TB7+=YBY*_g99kE6_!GFoqdlLpaisarlgT_UHf{!QwXP=*7Zk_~uV`M2*@-(BPqn|AtH{6g|%nsS#3;m|SXX^6k(tL{I4)BQ2 z3yr)owz9mod7iGuM*dlmgOZ*hH6vqjyXc41(B$dq^t3()Wuz>5knD6vnwd*>EYt89wDX= zG7V#S$gQ8-V$MAS!Ulq8L-Bd)GCjr&?Q4debPNgxD)rS24BnNCvFIEiP`crj=j_Y&-V6Q zj=hehW+-mjCD|Eyd(g(770zJrvU_$|r0bqbNKgU4LXqD4M)8==%CVv;UL}M(-AH)m zG&yl4xBn){$U2!uy(*RJXQL%<_Z4LiEmfatLeJ-MJOpkW^Pd-e;^ppo412nNO02oR z6GaJ}@X}Ef9519B2Y9Jl%@*qO9X*=LO52{rtKjgu4)R?dDBWdy#2@3yMNbj_=nt!< zOd3hK_Ub~^dcl-}9)9J=6wDd!{Yt*pz_;A*uFEZqE3zNN3i`)SSH4QDEYufN`#Z`q zTG<)0wLp@40yJE_J*$t;wHtm<>dWpE^YLATj zBFMD(_S+}BfH-(RvuXN!9dG6L$#P>kJN7Inhqgd|YF7oNKT~?&8Z?y|h=&L=m&bnw zAheIqblA$qQ^vzO=b5OJPK{g@nb5c>dPwTQ+2YM2V)RIKYuwdq zc;MoLv#+yA6TLNzo3i0~*B4RLi0+_-w932D&(FSmXlg&y82pSIuBBxb)>6krcx_>P z7G$%>hEntDKaYP^?HT&inu4?0!a7t-OGQ-6%(7pC4Rua1Y}&JtCeTzpHC|b9CNTQ1 zJ}E($O;=>!T7LEjjEh&XcU!vN>^A(xzb(lo#dP_N>)g)?gJ+VfCR`=u-3IAvh1&qA zR*&`89Wg3OXI`3+P+aw>i7uY~yO!3G#-yP^!wdT___pi>^NPs5@$Q{C#%J+!W}`Ft z__kwV9nbDruuPlSz9-H68vO>2qk#V_J}+@&doY{x@tio+v-O}1fe;mMl&0Ndf(kG@ zN-CME>&peWv|wAMKk&(wd3WJK@co;+$D!@AbfT38Tn9@fz%iDuuawa=C85|=@ z7cC4{3DAMXE4vNpjfWa2Sn4YDbo|nr4mHp!iOokrA<1`!&MO=pcGlT3Pjq?b$4elEvWSXyB=B`78?cnJFcj?SMY3}oJ) z4c%9IK7XlW@|Lk%*_E7-5e-m<&|*_$;j1~s&Q+jWBt-5pId-6+8WYPDF&1oyFMjmyI zUW(-_zUnwh>~QB$h4&c1qczTGAOi_j8)(FuuGREZ&<`(D+C!n(?b$ zwTfRAHNY>hQ*8Hjr@Y3mbLL{PV7IT`EPkY5P+xzByGj5u|9DSsNjv`B?}{otwCW%; zn~S*Y(+T4|$B84@=@Y)GcJOEG^U|qSM#iajJxFe|d+!TkPHIb2C$7;yIFabUy79v=!|IkI-lD)+g>%&MSoh*LPd+Dy1WS z1FLv?vovHXd@!lnn%C*AfD5J5T(|mMDGnNqtWv6LtH`xD=%*fwVEI4q0+1ap9s!*h z4IesdV{F8Ik4h$J&);Fsk5u}O@l7$|AHrmgz$R6|hq#y}Q-_p~Qvw6$YYT^8J*&q%$2;_dQ|LQ7I#xKAB9^(##&f0tk_Qbq zQy++^qxRFkgn#a(I_!_)E7+K>^3yvq9|~^0x!a@XrhLFh={M&en_=+nAvy#1)4JdD z7MG*M@Yt1s8wtO$7mC_Bt1gQvy(Zt-;h;@FVv_}-69zu7vl4f7p={6UXDMACjZIDL z=B?DN(sORFyz>(BboNhqX`kohqJLh!KNko!i4X^SmYuuApo_j?+fI^g|`KCM>T zhK(O?L(WE)+2jvk6n^q-jrRGx6o{#5p!CehWv?M*k`G(&bEL^6;eMhVm>Ol5>}J?@ zbb4*xq{ERZnO%**9LXQR(JZ==80L0tkM$O}$?^8JZo3T*?%%H)Um7i9kxgcPzY9jO zjlSr8(WCt6>CFw@56gB3@0(-k_9Q*JG|uzStbHZb{%FK~^cx%cZ6&Cf;1((ozB)Ko zSIY4QA-=D5xZh84==Aa5Ymc!5w|{v{x3RKX2vpHy=wgfpxHizj`JbQae_pw9F;c3u zpJ~iX#CAZ$9kIga_--{}9A2i$DQs{e_`d;dU#HN}AS_OOzRP$O(h3|zK!k~$ibR{E zoIIm4qcVd?G*SpD8Q8EC;nr4q_y!@1eceJhio>gfVna#}TKpsG={%ltdQ&mMxV70& zdKjy6DJ;>Uqs+d#RkxcL-{RO~UX4gQh9CCmv%tBse9(>TG#xG_^XxR@W1oUq>sr2^ zk_qEq%1o9Z7eB`|Ngf*r_WB|a>d^@X5pR;@&o>6_W zF@4kPC%2z;z`}vm$|o0LyE@J52Oh2jR1sQ6aA0n-7~Qn(E^NthD& zE_$prJizQo{#O@6DWwgzJ+>ao7VK||JjWT8Z19g6>^NGv)+JZL#{H#@_$;?MM48nm zb0!KuyE5P++a3lL1WjZUaK8%32j0@_>166;_La*B7>W$esa=r}Q&fPfcdK@*#0CFm z;|`4zg6_M6_?Gz`79;Ata}&tjH@(CU-!2s)0yUnzE3`4o0V`YZDP?N=Af|` z;xw&Mp0|FJuRkgye!&t=XD^gCJwAZ=uAp~uUGYaEx+g1t$`JUm;cH(H40?IdXJpLn z%s1N;(p3t)?Xb^+Qu32-1oba>7%o@;*`ITu&yxJ#1_i4|j8~IVihO6UGafJ#UqPRjkJGu70 zgPGjVX%1#@82S8a25NcR-4TDI0>3Yhq=6Gr{J!rle^V&IKD|eYmh?Tv-X+7?;@aXe z;Qnp?07gKE-JH^T;~PBK;iCTUHC>~yxTZ*=I%a?>Lk`rS4L_XAyh|OCX1~W#36ZScx%%PpcwV|U&=tKLeU2}4 z>~90@sSk}uR~JN-t(U!|b8_@&M9$K=5G~-rf6(B|s>>=4>X7U{%O}Ce=WZE$qDR(8 z);RJXVedybJ`3;AAe!RcZho&S9IXsVRu!~-74?4qaBb*)!P^$3n+Y<8nNHFi4xv|Q zL_;x$l3E@}XF5q}cuxQkq=0Qr>hSd*SdA|5{NF37d-{7JQU?}&(nfxebsETD$$HWm z2Fv+8f~s;S5LqQJG2Q$aK$jf2>hffH=xpl;b{c}<^zDo24bz=+TH0`8o{j4klM(|| z@eRS9B^-t*D$(Ued*5N-^TTNCwb{0*4(acM0_bQ7jd|@Spk7}B+S>>Tad?yd7-EYH zJiaHyDE)qw)HnP-56mQVPjLO5mUcZ**{WI-q`vl|d*gj~8yt>9+^wAsRy!x`OuUU> z_WIpM_>n~9iv!=ORRTCe)jcfk>Ul;$OB)Pmj-ebzH7v@flxm=MieiVa+m1xmZ%uK! zW7F!tZEyIryaE-ZNWbW5JM!v{30{^Ap^jBBO_hc6ptS`Q8B9kF>aP#f`+uV@X)oIP z1S18t(vdwB50<*hFS!}{yj&3C4>2pFZ>zOL>k2@V-N`|ypO)W3-72o7zbdBJB zYBRtHL!N~Zl0Y2MUVptGc$Gc^F%P-g)NQH&1VQ>i`pcpwpOIopgZ((YNIW>cdG54mKRg)3CL`W(#c-7E@ti8jRanif&fvPNFSaqP}yPwpcI=(d# z7$yTmj#w}x4^;;etZ6opgEH0lK_wtY5_QrP9Qio$*Zf4{x{=6u?JQLw6$rD1kD=^_ zUu7Ea4OSgkTt24o1Lj~b2|b{)>c_j=kX z{ZxueN`}mktdTd7ll1U)klP1U>myx+q7>IF8S;NxCBJA8VM%zU=!zh$NteGXvSIFw z_RHAfDd?|dBL*V-l^O1g(*$)CH`Q@rG>7K5;it)%^~fRhG>Y@piGeup`2Acf?OT)p z>scHS@W*=j5HFjN`dl$69ACjIh`_7tPEx6D)S#IRj?XR1{o8D>*BAksYQwRY0V{(E zT=nVP^p|w*PbBD!QR&<2n>ZLi28}wni1pB3+;i(7B?W7C$Q z3`BJ>w7lP72|HZesJZrK@Gg{aPNea#4IC8L1a$r$E3g|K971Ay5*hIesAZcJ3@r(=dDSuox=zL^QK&HM%iiYbqF8e=NjkdSoDC0yEwcU#>!= z)kWpXg49!_gXkVdn0=Ft>VNkJG?m`oC~a-^i6tylCOonDuE>;-6a7O#pGK}iwgN-+ zd{z>#so#a~Rk|G@SGUQ{*dtr<3&WV;QjmdqRc#AY;=Ev*lnO@)mw1i0kbV&Ojx1gb zt}!Ff70>vRN-uaG%&HRy<_o1f40#Br6oTA@&A&ofABkw4l;6rKg31e}WU%S&hV6zc z4I(+v=Mhjr?W}B^Qk)0kI19ua=v>ZW4o<96Fb^(~=%$1|0SEdAGuAnI1ypc6>nP)g zDYgXT8&qyB0!2++C|!V-9cU7f$AWrgubg9z(Y1OaXbI`3W_%--zHLc@f~=2G7`ym9%gxEU%N8c}as$iboE&r(TFNhZYqDDO>_ zaT6!#>LFiC^`=}a^?3pjwGgfGb^E=kr$%7~`e%~Rw zHQ+{el^d=P4toNJ{f6MM(gX?(Li}?Wk<2pGFxq#Z;Pywbci>{@xCE?gj=U7nbU>pL60i3n034xeC>9%4ajxunybrZB*2w8s={nW1{xNo=eWj|8>9mCE+g4@X-X_%b?`9sCE>1rv z#n%@d>sNZu$KpJC{k}+J<~`l1Ko@XhykvCb%?St-vf@;J@fpnm`Jz~a7*O)_9#K0e zgGrd3lAm#1l@9^X6s!NViA9`~B}jMtSCmHW!htR$YO|PG!*W=#AB{W0_ZTbrNX+i* z6c|2L`WPTF-aN+wnlirQ!2f8F@yA4KNazuwoVR?qB)nRHRh;2HAXAe~1rUGTy&TK0C(vTA_F_z~;Pos>-%8szxRh3y3dPZC zAHpL**%xaG>@NR^RI3pLSKJgv%uLNnoM&?2pbI|X`04>P$|uDsE;N93?MRVP>3_Za zgj3@F2tkf~K-pqm)q|I}@e^3wrnBveAi+X$eeBI=2TST;8g~ji-LeNCnpEFa^CJbs z6!Bv;j@EzwFc2%JowaFd6mUshuN6n`ZR^zORyF!eH|~y@t26UG>-OsfRv0# zloBA%M^c$@d;E?c3uQ#~$o!Pw>)5L0S&V%WbWeVv|9L*PHxOr?G>~Q>xm(v~4y^l- z38q&q=$mQ(+EsRBzK+9;h1i>L3r9fSpw$`^uxlAmErjyIVU!OU`o;dli*I&3q>ehB zhck|w<|EZU^_@V4pHXz)%YmvH=!^GDnlWo2fdwf)Uj8|0En&|THe>+ET|}4?wV}QF zA;!vxCW!Ux-zF{`^xIc=<1Yx?LT(Z39!o8=4#nvN@5anzXWSTIv)P?ESg6o!I%S_1 z&s7gR|F-5m=)8m%<*n9s|{0fzOIXf%KOa@Y*mVo~soEl$jrt>B2M$ zsLBXE=X1BQC#%B;Og;Z>Ip84o@E=mwh+k}sL~@n}Sv3XzGuEzDc(cYbfOpvj2)^WU zc?_cE@ffVgC$lp|M+ubogAYaTo;lty7(1Iau6QupZ;6fExW}grS^?9h*2Fxf`L3a} z)zFkZ?CsIa<+faqHGcAQPS2m18x|1CzBZ{GA2r=D0rI7mLp>lV!}aKvc=_u7FcAhA zl?j}fck_C)w0;J`8WV*)B_}27`Ga_sfqs|H^A=dyYbWK24lK{agvYFK)JzzdcHjYt z$Ukm;AQ$hFIr-h6O%mwfc-cco!W$z;V~vj# zHK~8AQjPMNaW%5q)JZ3s;boxW2<@tV4xmVWnG{0MHbh=?c~)zbt3NF*WCcqccQ>UN zQ8q=Mn!lC}jZ<*@-8#?j-yU#($Trv;I|T?6IH;;GMu9_oY^^w>SV3f^5IRG7pjQZI z{YIp>L};79cC3<&UkwjqqE56s{(YbF3DVny@@8q|?$J-V>_e9ubz@-+LQ5bdGahnj z@?7m^V-dt%6qFIpQARG%KqG=wp8ioeLxp>YE!~^G8G!}QVDKR2Rq$@5*#cb-A*+b6 zVV084p9H^ZNUO6_*L5cP({B9(oR*)RWQ!n2z8?y;U+?4r>)sl8otEl*&0OEJsp%3_ zaS!JJG_HAoHZIDa3Gu96g=UGl{q}hSE$EWd?kAX$093Dxm$N}8I|HmYn#Bvr6#4^j z0Ko|`;s2%R0vS7f`Dyo2$AU64Rt7Nr@=b!r3}9|7XEgugT}y~E=7YW)AT`|YuhpCw)O4Z1b4NhJ_>?_;% z`d9!KQVwujPYetQHp#ES!9(?EpJN-Iv%Q5X>(bBo<7i_G*K$OJ>L5qK07mSt& zA%d6DFd=i5tluZsFMSy{=*ntnaR#1yrlZ|J){N5f?qJbT z36Yx?1fhKSpkFgYlbY+fggG(TzyN)JfiT0!mw8POwm*t#x7d(`a)Ikp0eCAzp}Me) zTFBgg2u1-+6D^Lo&__V*UKb4AzjY4g*w^afPLrB`Oad?Xh7qSJjE)py(d4@i##X=v z2mu^G8LK`zGL_F<)6OHl2Jwm*Zg!N`)4=ch$ zQ)DY>U4TDka$p_diW}4*4(Ep4+;wCjy0*QFO54KOGv9s}wt)rDX zqFQvVeq)A@<>lk=^0kv9paEEKGSjMj2G9cBP;^=ZUhx`Dqs?Q54}wTH_Dfjf)Cs<+QFC&e0da%Z?B0)#l5jDdzd7jtYQLt{`7Aa$$M#=}vcafaVPzp!5hzrv?X_wHj3c*iy_Hm=@~dAdHM_ zaaUWFRorT#MBVCJ5-_5!xv-`ijBQ%zJ5N?8VgC)|JAhk=^GyU6a0A=TV*=Rnvn&AW zjG*&Abq|MURD%E8)@uz;8zWoL^bwcfhP65AXGle)s&o&~pB%*W478h+InNwjlyzki zfu--NokjTsxHOyA`=KUHandjRuw#2zbA1mpk-33P`d>{OV695pc?Ao24$ z9Qvp-H(sm?iqsn(^ds(^yav42Pk}mpKz@$Q>@uTQO_~NlmPm@URKOOtKOnfnx}?- zx%cnW(rC_KAm0HnBKWJ2I<~C71D`C2`z2?^gKR^X)X+J{Zk(>n;1VSBCn>Q-FjH;MH0a;H3ciFJ6(Nj&mPbG235H z2mGK#X4?3$OK6dyOd8cAp9G!TOV1HTQ2$ZSfB`C46R$bt{ELj zp^&^&lmjy5#0fj*b8V<;jgonE33JWEb$&Q>Jf}x#V{eRo7stf1Je*GY#?`d^H-;cleBdNV2Zy!Vq#wdVPL{Kgkmzcw(*Oid%XWLw<%8W zbQxKt_48TKA1uURHx|03Pz$#_j>;6P_OLl8Clo|Wp=yCymn*G+dje#B%B>I;VEWVZ zyXgbeDkGEc2L^niN5Dpp7cd`ZzG%@bp=%tH(9`sFhZgBF@*aX&CCvd7GwqOFF~7`z zrkE71?zDx9dHy+a#7e>X3vhm_F)3Vo+8Df*H81jBT1@+OuI|T;`EBl|$)6t?AK_h$)Jo=;hgo`Cw@ zFhd=-_vvdDW?x1`*Stlrc&<3eWCC#9u8Q^j-!t^gxk+dI#PD1R24_($zCj{>_rAi{ z@+XZII`tky&)o=tBsUY9_p0C3<)5A8t;#;E(y)!kY@iPz=)7F8&okIw!~ge_C7TVo z$J%V}MjQIiR?+L_hF(8UYKeKQ4t{a4>1qFYoqA2M96WO!f)sTsp+mii)*O1ls03s@ zd;YqS0$B$ox-mQ>OT-^{Hs=}18#=nPq()--@-2#<2Pmjj;5Fk#9F@k3nBalDwhE;l za_7I)B1C0w`f#;sP@ul`8))zN4Y6su+z%}_w8;B8y3A`JJlW&lu?asfZqWaN|M7KA zd*7x~5WV`?-(QbSvVt@<#p$ zl4t4AMx_pZ3G+^T%ekTb{lBfywR^X6FP*|y!XE%9?cz7wvg*{G$_baNx~S(Tq%Y4))<0oo5EQse?b`c!gBb7QD^8ezKlhq zwxh*RNss1Qg4L^R&y9fA8JO?E))ZH1-Rcy9(UkM$dYjnPrNX^eg_+k*@KWO4Z|94! zIuoxL=r?|SrxPsp5nQOzHdt6R zGz1y{OQ}h;O}@CpagjOB(qsO|A+j7 ziyhun{w(CP6NDRg=-F^^D6;r056>nH8x=3^^G{BIgxYZB!?&G1v{8&=|ySPohADJ>T;L_BcY>24eyZ z718h!`N4rU={(X$S*w7t^iXJXsK_Z4T0epim%j@e`ip*vlaI`{qxFw`7$PqX@}!Fm zuXG=l5Q&@Cz653daT#@Ob*7*^r0xSXL=OGk^#3?hD1{}Xc%UZz24&mnrbzhcSp-Bo ztG$aFR zw13~jY#dc0`a-GTVCehJB+81li%*5pTERG+!{}`A+m^adKRD4rTgi+))*t+a#eYkY z2o7W2mN|T;M5q|V;x~y*cY(CC%szYf8Hv2&w1d`no;u6*9DZXIhjIfxS!cAc^zCa| z>@=YV3D11D{R`qh82sEE*hY@{SK&Bwb@7*b~St?$npbT{g0RW6I2y@yd?-~3`kpavANg; zoV{do-mNmasM}gBfp%f;mrko9h80;~-mA?Hp4|Qf@Be&2Yl2NZ-_`zDGslb|k%>K~ z;ELA(#4OB2$M!i{7EFxlXZdCoUxKvg_Oj8(E5#+q76oLmXDr44Sm%@>eMG@n3UD;g z57JLCF#|D}cD0k~A5kZ>!f-Lvv=AZ23F^Z{6dA1u7z-CpjLLB!qeeKa;Sn+h24Z1k zREgy*L3IcSPAm!qO2&fep=xLS_Q}yq&kOFC`r%z5T285r z!YfFCz9DLzJy1p@40wAY4*<-}|NSq(&|i^G`OUxW)HW}1`U@^p#;FmLz9C+eN}ud6 zd2J5~zc9_IC95A8xPUyr#l5*Cz~B_=8A#FH!-zbawvcS{j3lUUY4?qg_h1zib;@pj zcl7c_{OXFw$)A?&x5lW-p*ub$f=iV+HxWJ!T=@I^9_j0b7QP<@^&|eDXywc)@oA;a zA%B=+j={Vl5u*@4{Zlj01O5M1&UZyM83pV92@oPpLhncyL5LDckSa~2iG^N5ks?w; zlWyorl_o(tD2P<0_W%M4p(DLYRayY4QcgT)owe>d>pa|t`*zpb5A)B=KeP9qz4yG# zd@ZsSf}HOULz*x){mR(wB?)BNV5Ay3(_nBlQ~gKrg&=Y?MK;ml_B93BiiJRA#jLW$ zj`Xz!!K+|9?zh)AJFLl>nuKV)QSyb~F_@7^Io02m$J(we$G5ig0qUJj*j3~62U8df zr)Y->2c!V117o|c^avxRDrG`TcoX?RKaA;pIxm9EAqOyzW9)O@*tXd5t)Mw zIl(mR4Nr2Mcu?Gu>$Hcwh^Rpv1@0#MsZA z%^^Os=YB^sv)=|$xvuWLPgk9Lejm3bEFH|=7&kbI5=KxP5tyirDqV(sKFua$Y|7KW z4ZTw1W2y-5xRx0j^u@=uN?@TWdvI5(;+kBq5(%Oym@h8TXAVmYp*|sw7lG{OQ)8<@ z-PD!6zgX`;ET@Uf>sA*v$qlA9s&T6X6-V4Ol4PjJmnxwxa0nj@%}hopsThl8xh3PA zeuO+x0X6z2ERt=$X9z32vMZi!6*T(jqF>z~%yqx&g5WhB8zFo zJZ%v5R`1y-V3&7agWiXhCBD$8y1u|_c#Fz|1&cFmt|U`%7oF42Zh4nj+qIr*1}jux0#q=5Xq7yu2u7cz!amK!hZ|z zerIQL+w8z$h<+F5ZHJj}Qr7iZD*XyKK)^@t9W%$tXpgHDkZnHa7TEu1Uwpsywx{Ye zc-x(2#4Wot`S~)g^_p6t#$|-m5;zVSuP+}Ld_aZorD9ytIxFtZ>DJDS9wU=mx>aJe zD69S`v^L?!s^xRR?wU|B`hyr>P@#kvN$+1=2xK)7b+(c0n|;yuzK?R^7ffbzI(BHe zE<#>0qcvXwDHczBSJcTi_nBnEUJtUVFEWQHwCaZceIG ztAP0a2E;{BvPqw}ASY!_TaA5{>3JaED(| z#$37sW!V^cm#_;(j~KpNabJ(c`Cptl3_81)b%W{@z%K6WOK^3GDvnu%%1F@4hjZUC zR~Hv|K2+omc!Wwv0V|%JG%m9tQpDdSHc&J&p}Bv5*6k&vj6{zwaGa?d8{&N39IOaq?NAeQI##HnU6c zcU z>71}$R~%2DTi3_6Xe3-$8KEX}e$SuF{Z^nJcOot72gk*3^Kq;9e@Rw}b(z!1J9{3k zyEZ!@?hvCuw%Kyk3HH`~ofZ3mLm<92IeVop;0={oH%*Bw<-~3WPEDIr&Cz`(mpOV# zeAZBkCCY+~!}OIxv(dX|qgu4stf8kRYmUGvBRtSZ96J#`wETOpmMh=fTaTjBDG}c| z5&XnW6m|5s;%)s)&JRWCh+zJ>)`sqRdD~fLgvJ0kjxzv6#s8fv1TEfe84>^f*Q*vX zxjCFPjt8p(@3#E7vYWb?FTmE7Nhx!<4-@4MslT!+h+PtYe0i9s1Y;5+7j~A zWtgUPoF*`IN!;ykv8Ldb1rGgcVByIfghU&jl(O%_{fsf={KLr!qY4bPe_iF4hiKRE z9a77sV@ftNyTjU7&sA}^YHIfcnyi1bOy{o1?6}=Q6qo;5=Rh4ift7ASvAln7bYbr$ zF7=pmDTI6-;Oa{>k9LfP9+Mfjgs0GJB5ZCYs2;Flhi@9BO(9$@ujwjM zRfu~iA@-7o$8348mO&l{YOSGf2rbVWeFEpxG$Zpkp)|WNNNhoXgEH?%?c^;#AsEjI zk2X@Yw5^Db2JWTy&JVw*fPu=bBd+En=rw+IB|ai#dYE0@HTN&ap55%$R>cW8EcRaS zV3{=vnKhcvwftzg!{{&6JH!rySKix!L?aoPJ>&|GD2$rgNE0J4HZ8&B`2i{jiZQ2G zEzv>2V{58IZ{neKRIveEPHq`#{C0_h;!T>Zp;Zdy$~LOFr<3@j&tuwj6igYK4G}@P z-e&5pPQ!FCH(#k;vEeC-me(Pyly(H>o?oeL^VN>CVVHV|dfRoDbMWawASgo#?tntsemS(@W;oPKK9+zxYpu7p*Dw9;!HP5<}HCDuFBBs`-{V`}IM#QalUN68#U? zYlG`io%IV}%U6$C&cAqfTrVP4m5R&1w(|wLrdRY;M}_rmdbD`oEI@84)v5BPz77w5 z^+lBF{j-s-Z)MVUMmo+@2-8+&aiLxM{^&9M;{zim!d(Al##-&huSxW#(Ap`n3ml(6 zn8muM^g-sG;sebfvYt2dzn%+&m;4kS4A+n~9kOD#8aEzksC$W${f_XP&|N-~|;=nWpQ2^@a9k$ToMeY)b& zDpCKK6dP*v9HLU&hZ@UTsV}ZPaKeE^OG!8u)k=&F^L#T@vf^9A8|nI{B%B7ACJab@ zR+&F1#-vXg=IuDLi42v3rJB920yM2Ir1-GGhfsAvEl3OgUQQpKOM_jLjuhuP=Z+=Rn`fOZEPAu>rVWE z!nfi!?H~c&Af%6E_D5bEN4Omum3+ZJ-khxUp3@A-0R%GekIAktY}01< zBg@s6vFSKkl(_R()<;}BE=8{;o z(Z)Uh41U1qv-C=0U{0${1iX2WWF&Y0SM!K+lC8d@KHzb`93c$7*#@-Tts`=0{&V;#s z4x~x%`Lq79{o*7s6XUK)?1rYv9T$u0*2})KN6n_-!Xqy}@4)j~pFC(q`P?mX8r-jnfoD|(8~rDR z?Hh_FlBrgbCL>;Jq}j|=?^|~mK!^S`+QFf+Z+{T^;zuXwr9Y+fn;*@D+NWlvtY?uQ z5A4zBj4UV$jvOY_b~cyOmaPW-+Y0sFl?2UGCj*ReIE`#OK1}kJtN+{i7%08v-&6lQ zs2iMYmEV8>v(uBQdb&3G^RG^raU6}~KA!Y8mXBiFu)>e<_ zRHph<)R9NCdtOzae@D7Bt6lTybTrXU&6BR&u;#_~g(4f{ z$eqfQ3x|oszxn3L9{rvZpJ-g?bbCynmK%mVIXSpZ?1W2AxL(u|uN%1&o4wy7wqq$f zlZlU{zWmtHM!mvlX9z>xRAr6+Srf@_xKx1VDYM*=)s@4o}GyRR6eOhGPP+7%`lZzr7sAkuV`rCJg zR_i4(J?fqe=>ER_VC=J9_S)AU?l%neZ12~a)cEXg3+`vkigmxE=J|UfLPApV46XhF zebc+3Gk!@|B3quuBla|~^R-K*A{RAVxKwM;fXPf|Ro&XxV;6~;qHX>Lr2QBFzUSkJ z-FHN<--ChikEY>^xbNszVz1OxC`)DS0 z`E4;XV%+v;_B{L+&J0@f+;8RvB7;9Zt7|E!yU1N3-K#yotY}8B+VlLPAEEHb zTp~oG#QJe%5y${Wqe6l~8}LN|8}Y6Z0LCg0($(`7C{7}ShyYldMO7Fo&Kd-O?PhjG zl1T9Sq5wR?x4S%s23~Fr!ti+OY$bmN8JIpNCBgVmnnnT9NftKCV9fK+#PEWD9I`e7 z*CsEBsqHrBZ9kAwS;s4098nhtc}h4erv@3^xzz;+?j_IYlNueyE- zY-|9++rcnFl(NEPm9GuR5fI^;uR!9S1*YrM0H>1{#4O>d6;0&{4E9=&wy+tqpi)-p z!-1TX<$7M6!GzJ%DiVx>fiwfChD`hs7$a8V>z@cH7NeOcfvO7gN2C*C`g5IN%-~Jc z(!Mv%pjC5G0BRnf0YkBG-97|e({7ZK{`Q*~?JK}t1}zcr^P6J)ASI*CrT|sURG^Do&qPHSKv21@V*@3mzdhE413oTRuUlvrvV~ptQ^CO8l-NUNuw3}ftQ7#b znrZ%!35<{B2cT>(;-Lgl>BPh{V$U*j;*2~mu5$L?l=<=i1eh_IS=okxR^dzlX>5lf zsgIc4RcgTH>oJj;bp#*d*%$=iJHI8wEn%p!ToC4mJy^6)ATWmm+cjYM8)z zin#qq2rwUAd7_00b*t~}3rMQC~}sm#4gyPY{-##$yICh7(q zBviTUOSo-gg<0JP_bZGaE-$mM;5A)b64R3QfisihC`6LWME2oG>Ni)K1u^%1LyToF z$qAId^3F2y;uxG;z3Cqh0;~ov#2H|m7+ZG>w+#~eOvz*}1*UQwML0NC4 zOirJWbkxR}@YMi%H`{)+>#?)cs0p-!<<$P3ZLU#MjU(sTi^zQP0t!JaCC=+Vs6kl> z=Fngs_bo$=J+71=5Bjs1F@4I2N^h&q1$=Irwu13j zH)0n7pUl{Q^rb>Tq)^0oadES^tUyx%j4>y*c1zj_f@*L3R3)$R?JQBq<2_49i6G)#v3t&WDsIaF&NUnOtnb;HqOG-=x6B>&v@NDFpm4y2XFpefV zl!6oYXavoI|8JBlf)SbjD6X=;T6N}y@tS(_ za#E}i(pglEMA6buOtAETK%9kq^m~Kn({V_3_I>|gUznL$R1Q6t>Y;LX_L$3E7zfbH%HBChp@Vwxmf3C z10$E-6&hbq7GL_i$^i-5)N8i{+vND$Isn*Fw;yYqzI{@P<0I#6Owwv>Mm2bhz1z%Q}VN2j-^1~Qe2)A&PLVb zy~1s-f%q1ysX=z` zalY2iL#?!$5W+a^M;qzX@P$)Iss4RTTA3Es_dN;3J|VmX&5zTb>sjGvN%mN7AkLIs z=L!1(3i>Rvj1+s~3{CA)ST}T>HpHYA2Ch}#Uw2-tUq4jm0oir2w>w1-4R*KhPt}wI zD(rSzB)m;Mw<&MR@!`&pusC_cE9Dg)KUqPm*=5R(yi@}jr*GSS+zSQvB_a`fb_lsn zsi>=6ETq^MRf6pVg1O~*EGLprLvaipI|6;n{0#EMR2~_>&2cs<1v7QLTnM-ChOSG zj1FWs`e;$+h?-noYPWB1;wv-AjxNsXvA<+A%xElO=L#=Q8~^D_^b|1Q_Cswwn3@z@ zBwG?1>ueQKyV!VTtc;b17|1|VAA7t#i?UA^chvmpa{j1cksO^#6b0RzO@V(>NriRlw;s0Qls?KXkiR3 z%4gh)lW8tt)oNt!y;~;~6rrabu@vyAn0#K}b#LOI0dXTq^T#GhtNSATPe&)W)G&*U zPQyAZlWeQ`>CO5RMra~1ZZNAwq+Lgo;s&+zAuo>5H0hS&Jj=FvDOzj%bSxU^(Bc?r z`k0yQ-Ci%YH#$xNL-|x6GN`5%irPD-tF?WV#P%JKyBRSVgwe%dT>qSEz`w}^k+#ADb9wti)Rw>5L>O>sQ!=vzD z!_6Pivo~(+MEA9@yaGBHstO5Q))GH?27GoFsX70tC5q|1uzcrj;B>FBcw4K_++(+# z9u&bUW42UrTVUJ2-86jn$FCbiP+-UMujiiQOyXdwroPwHUd*cLs!`cVv$phPvkj8- zWT1#6!A{>Q;Vp)jFJIKosMh}yBVzFyOgB~g6nAo$Zy%O6#4h2l;Ru1ny^`A@pC;)V7>mh*3RT^iH-|bBe zJ8Z6n(@QJ9{_{hndlh#i`yU1a9R$As^KMt={%tj`U%9_Kn`tu9=hvY`v6AHiz5L{x{mW(*FQFCkpq>mGdr`{jMGh96;gz4Gf5cH~ - %\VignetteEngine{knitr::rmarkdown} - %\VignetteIndexEntry{Procedure to compute p-value boundaries by weighted Bonferroni} ---- - -```{r, message = FALSE, warning = FALSE} -library(tibble) -library(gt) -library(gsDesign) -library(dplyr) -library(wpgsd) -``` - -# Example overview - -In a 2-arm controlled clinical trial example with one primary endpoint, -there are 3 patient populations defined by the status of two biomarkers A and B: - -- biomarker A positive, -- biomarker B positive, -- overall population. - -The 3 primary elementary hypotheses are: - -- $H_1$: the experimental treatment is superior to the control in the biomarker A positive population; -- $H_2$: the experimental treatment is superior to the control in the biomarker B positive population; -- $H_3$: the experimental treatment is superior to the control in the overall population. - -Assume an interim analysis and a final analysis are planned for the study and the number of events are listed as - -```{r} -k <- 2 # Number of total analysis -n_hypotheses <- 3 # Number of hypotheses -``` - -## Observed p-values - -```{r} -obs_tbl <- tribble( - ~hypothesis, ~analysis, ~obs_p, - "H1", 1, 0.02, - "H2", 1, 0.01, - "H3", 1, 0.006, - "H1", 2, 0.015, - "H2", 2, 0.012, - "H3", 2, 0.004 -) %>% - mutate(obs_Z = -qnorm(obs_p)) - -obs_tbl %>% - gt() %>% - tab_header(title = "Nominal p-values") - -p_obs_IA <- (obs_tbl %>% filter(analysis == 1))$obs_p -p_obs_FA <- (obs_tbl %>% filter(analysis == 2))$obs_p -``` - -## Information fraction - -```{r} -alpha <- 0.025 -event_tbl <- tribble( - ~population, ~analysis, ~event, - "A positive", 1, 80, - "B positive", 1, 88, - "AB positive", 1, 64, - "overall", 1, 180, - "A positive", 2, 160, - "B positive", 2, 176, - "AB positive", 2, 128, - "overall", 2, 360, -) -``` - -The information fraction of $H_1$, $H_2$, $H_3$ at IA is - -```{r} -IF_IA <- c( - ((event_tbl %>% filter(analysis == 1, population == "A positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "A positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event), - ((event_tbl %>% filter(analysis == 1, population == "B positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "B positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event), - ((event_tbl %>% filter(analysis == 1, population == "AB positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) / - ((event_tbl %>% filter(analysis == 2, population == "AB positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event) -) - -IF_IA -``` - -## Initial weight and transition matrix - -We assign the initial weights of $H_1$, $H_2$, $H_3$ as -$\left(w_1(I), w_2(I), w_3(I) \right) = (0.3, 0.3, 0.4).$ -And its multiplicity strategy is visualized in below. -If $H_1$ is rejected, then $3/7$ local significance level $\alpha_1$ will be -propagated to $H_2$, and $4/7$ will go to $H_3$. If $H_3$ is rejected, -then half of $\alpha_3$ goes to $H_1$, and half goes to $H_2$. - -```{r} -m <- matrix(c( # Transition matrix - 0, 3 / 7, 4 / 7, - 3 / 7, 0, 4 / 7, - 1 / 2, 1 / 2, 0 -), nrow = 3, byrow = TRUE) - -w <- c(0.3, 0.3, 0.4) # Initial weights -``` - -```{r} -name_hypotheses <- c( - "H1: Biomarker A positive", - "H2: Biomarker B positive", - "H3: Overall Population" -) - -hplot <- gMCPLite::hGraph( - 3, - alphaHypotheses = w, m = m, - nameHypotheses = name_hypotheses, trhw = .2, trhh = .1, - digits = 5, trdigits = 3, size = 5, halfWid = 1, halfHgt = 0.5, - offset = 0.2, trprop = 0.4, - fill = as.factor(c(2, 3, 1)), - palette = c("#BDBDBD", "#E0E0E0", "#EEEEEE"), - wchar = "w" -) -hplot -``` - -```{r} -# Get weights for all intersection hypotheses -graph <- gMCPLite::matrix2graph(m) -graph <- gMCPLite::setWeights(graph, w) -``` - -```{r} -# Set up hypothetical p-values (0 or 1) to obtain all combinations -pvals <- NULL -for (i in 1:n_hypotheses) { - if (i == 1) { - pvals <- data.frame(x = c(0, 1)) - names(pvals) <- paste("pval_H", i, sep = "") - } else { - tmp <- data.frame(x = c(0, 1)) - names(tmp) <- paste("pval_H", i, sep = "") - pvals <- merge(pvals, tmp) - } -} -# Get the weights for each intersection hypothesis -inter_weight <- NULL # Create an empty table to store the weight of interaction hypotheses -for (i in seq_len(nrow(pvals))) { # Each row in `pvals` is 1 possible interaction hypothesis - pval_tmp <- as.numeric(pvals[i, ]) - graph_tmp <- gMCPLite::gMCP(graph = graph, pvalues = pval_tmp, alpha = alpha) - weight_tmp <- gMCPLite::getWeights(graph_tmp) - inter_weight <- dplyr::bind_rows(inter_weight, weight_tmp) -} - -inter_weight <- replace(inter_weight, pvals == 0, NA) # Replace the empty hypothesis as NA -inter_weight <- inter_weight[-1, ] # Delete the first row since it is empty set - -inter_weight %>% - gt() %>% - tab_header("Weight of all possible interaction hypothesis") -``` - -## Correlations - -The correlation of the 6 statistic (2 analyses $\times$ 3 hypotheses) are - -```{r} -# Event count of intersection of paired hypotheses - Table 2 -# H1, H2: Hypotheses intersected. -# (1, 1) represents counts for hypothesis 1 -# (1, 2) for counts for the intersection of hypotheses 1 and 2 -event <- tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, event_tbl %>% filter(analysis == 1, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 2, 1, event_tbl %>% filter(analysis == 1, population == "B positive") %>% select(event) %>% as.numeric(), - 3, 3, 1, event_tbl %>% filter(analysis == 1, population == "overall") %>% select(event) %>% as.numeric(), - 1, 2, 1, event_tbl %>% filter(analysis == 1, population == "AB positive") %>% select(event) %>% as.numeric(), - 1, 3, 1, event_tbl %>% filter(analysis == 1, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 3, 1, event_tbl %>% filter(analysis == 1, population == "B positive") %>% select(event) %>% as.numeric(), - 1, 1, 2, event_tbl %>% filter(analysis == 2, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 2, 2, event_tbl %>% filter(analysis == 2, population == "B positive") %>% select(event) %>% as.numeric(), - 3, 3, 2, event_tbl %>% filter(analysis == 2, population == "overall") %>% select(event) %>% as.numeric(), - 1, 2, 2, event_tbl %>% filter(analysis == 2, population == "AB positive") %>% select(event) %>% as.numeric(), - 1, 3, 2, event_tbl %>% filter(analysis == 2, population == "A positive") %>% select(event) %>% as.numeric(), - 2, 3, 2, event_tbl %>% filter(analysis == 2, population == "B positive") %>% select(event) %>% as.numeric() -) -event - -# Generate correlation from events -corr <- wpgsd::generate_corr(event) -corr %>% round(2) -``` - -# Boundary calculation - -## Boundary of $H_1$ - -For the elementary hypothesis $H_1$, its weight is 1, namely, - -```{r} -w_H1 <- 1 - -# Index to select from the correlation matrix -indx <- grep("H1", colnames(corr)) -corr_H1 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H1 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[1], - n.I = corr_H1[, ncol(corr_H1)]^2, - alpha = alpha * w_H1[1], - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H1", - `H1 p-value boundary` = pval_H1, - `H2 p-value boundary` = NA, - `H3 p-value boundary` = NA -) -ans %>% gt() -``` - -## Boundary of $H_2$ - -For the elementary hypothesis $H_2$, its weight is 1, namely, - -```{r} -w_H2 <- 1 - -# Index to select from the correlation matrix -indx <- grep("H2", colnames(corr)) -corr_H2 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H2 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[2], - n.I = corr_H2[, ncol(corr_H2)]^2, - alpha = alpha * w_H2[1], - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans_new <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H2", - `H1 p-value boundary` = NA, - `H2 p-value boundary` = pval_H2, - `H3 p-value boundary` = NA -) -ans_new %>% gt() -ans <- rbind(ans, ans_new) -``` - -## Boundary of $H_3$ - -For the elementary hypothesis $H_3$, its weight is 1, namely, - -```{r} -w_H3 <- 1 - -# Index to select from the correlation matrix -indx <- grep("H3", colnames(corr)) -corr_H3 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H3 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[3], - n.I = corr_H3[, ncol(corr_H3)]^2, - alpha = alpha * w_H3[1], - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans_new <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H3", - `H1 p-value boundary` = NA, - `H2 p-value boundary` = NA, - `H3 p-value boundary` = pval_H1 -) -ans_new %>% gt() -ans <- rbind(ans, ans_new) -``` - -## Boundary of $H_1 \cap H_2$ - -For the interaction hypothesis $H_1 \cap H_2$, its weight is - -```{r} -w_H12 <- inter_weight %>% filter(!is.na(H1), !is.na(H2), is.na(H3)) -w_H12 <- w_H12[(!is.na(w_H12))] # Remove NA from weight -w_H12 -``` - -And the boundary for $H_1$ and $H_2$ are - -```{r} -# -------------# -# H1 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H1", colnames(corr)) -corr_H1 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H1 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[1], - n.I = corr_H1[, ncol(corr_H1)]^2, - alpha = alpha * w_H12[1], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -# -------------# -# H2 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H2", colnames(corr)) -corr_H2 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H2 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[2], - n.I = corr_H2[, ncol(corr_H2)]^2, - alpha = alpha * w_H12[2], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans_new <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H1, H2", - `H1 p-value boundary` = pval_H1, - `H2 p-value boundary` = pval_H2, - `H3 p-value boundary` = NA -) -ans_new %>% gt() -ans <- rbind(ans, ans_new) -``` - -## Boundary of $H_1 \cap H_3$ - -For the interaction hypothesis $H_1 \cap H_2$, its weight is - -```{r} -w_H13 <- inter_weight %>% filter(!is.na(H1), is.na(H2), !is.na(H3)) -w_H13 <- w_H13[(!is.na(w_H13))] # Remove NA from weight -w_H13 -``` - -And the boundary for $H_1$ and $H_3$ are - -```{r} -# -------------# -# H1 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H1", colnames(corr)) -corr_H1 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H1 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[1], - n.I = corr_H1[, ncol(corr_H1)]^2, - alpha = alpha * w_H13[1], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -# -------------# -# H3 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H3", colnames(corr)) -corr_H3 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H3 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[3], - n.I = corr_H3[, ncol(corr_H3)]^2, - alpha = alpha * w_H13[2], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans_new <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H1, H3", - `H1 p-value boundary` = pval_H1, - `H2 p-value boundary` = NA, - `H3 p-value boundary` = pval_H3 -) -ans_new %>% gt() -ans <- rbind(ans, ans_new) -``` - -## Boundary of $H_2 \cap H_3$ - -For the interaction hypothesis $H_2 \cap H_3$, its weight is - -```{r} -w_H23 <- inter_weight %>% filter(is.na(H1), !is.na(H2), !is.na(H3)) -w_H23 <- w_H23[(!is.na(w_H23))] # Remove NA from weight -w_H23 -``` - -And the boundary for $H_2$ and $H_3$ are - -```{r} -# -------------# -# H2 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H2", colnames(corr)) -corr_H2 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H2 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[2], - n.I = corr_H2[, ncol(corr_H2)]^2, - alpha = alpha * w_H23[1], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -# -------------# -# H3 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H3", colnames(corr)) -corr_H3 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H3 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[3], - n.I = corr_H3[, ncol(corr_H3)]^2, - alpha = alpha * w_H23[2], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans_new <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H2, H3", - `H1 p-value boundary` = NA, - `H2 p-value boundary` = pval_H2, - `H3 p-value boundary` = pval_H3 -) -ans_new %>% gt() -ans <- rbind(ans, ans_new) -``` - -## Boundary of $H1 \cap H_2 \cap H_3$ - -For the interaction hypothesis $H_1 \cap H_2$, its weight is - -```{r} -w_H123 <- inter_weight %>% filter(!is.na(H1), !is.na(H2), !is.na(H3)) -w_H123 <- w_H123[(!is.na(w_H123))] # Remove NA from weight -w_H123 -``` - -And the boundary for $H_1$, $H_2$, and $H_3$ are - -```{r} -# -------------# -# H1 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H1", colnames(corr)) -corr_H1 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H1 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[1], - n.I = corr_H1[, ncol(corr_H1)]^2, - alpha = alpha * w_H123[1], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -# -------------# -# H2 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H2", colnames(corr)) -corr_H2 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H2 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[2], - n.I = corr_H2[, ncol(corr_H2)]^2, - alpha = alpha * w_H123[1], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -# -------------# -# H3 # -# -------------# -# Index to select from the correlation matrix -indx <- grep("H3", colnames(corr)) -corr_H3 <- corr[indx, indx] - -# Boundary for a single hypothesis across k for the intersection hypothesis -pval_H3 <- 1 - pnorm(gsDesign::gsDesign( - k = k, - test.type = 1, - usTime = IF_IA[3], - n.I = corr_H3[, ncol(corr_H3)]^2, - alpha = alpha * w_H123[3], # alpha is different since the weight is updated - sfu = sfHSD, - sfupar = -4 -)$upper$bound) - -ans_new <- tibble( - Analysis = 1:2, - `Interaction/Elementary hypotheses` = "H1, H2, H3", - `H1 p-value boundary` = pval_H1, - `H2 p-value boundary` = pval_H2, - `H3 p-value boundary` = pval_H3 -) -ans_new %>% gt() -ans <- rbind(ans, ans_new) -``` - -# Summary - -With the p-value boundaries, one can get the Z-statistics boundaries by `qnorm()`. - -```{r} -ans %>% - mutate( - `H1 Z-statistics boundary` = -qnorm(`H1 p-value boundary`), - `H1 Z-statistics boundary` = -qnorm(`H2 p-value boundary`), - `H1 Z-statistics boundary` = -qnorm(`H3 p-value boundary`) - ) %>% - arrange(Analysis, `Interaction/Elementary hypotheses`) %>% - gt() %>% - tab_header("p-values/Z-statistics boundaries of weighted Bonferroni") -``` - -# Implementation in wpgsd - -The above results can be computed in one function call in wpgsd by using -the `generate_bounds()` function as - -```{r} -generate_bounds( - type = 0, - k = 2, - w = w, - m = m, - corr = corr, - alpha = 0.025, - sf = list(sfHSD, sfHSD, sfHSD), - sfparm = list(-4, -4, -4), - t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1)) -) %>% gt() -``` diff --git a/wpgsd.Rcheck/vign_test/wpgsd/vignettes/wpgsd.Rmd b/wpgsd.Rcheck/vign_test/wpgsd/vignettes/wpgsd.Rmd deleted file mode 100644 index 4771094..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/vignettes/wpgsd.Rmd +++ /dev/null @@ -1,591 +0,0 @@ ---- -title: "Quickstart guide" -author: "Zifang Guo, Keaven Anderson, Jing Zhao, Linda Z. Sun" -output: - rmarkdown::html_document: - toc: true - toc_depth: 3 - toc_float: true - code_folding: hide - number_sections: true - highlight: "textmate" - css: "custom.css" -bibliography: wpgsd.bib -vignette: > - %\VignetteIndexEntry{Quickstart guide} - %\VignetteEncoding{UTF-8} - %\VignetteEngine{knitr::rmarkdown} -editor_options: - markdown: - wrap: 72 ---- - -```{r, include = FALSE} -knitr::opts_chunk$set( - collapse = TRUE, - comment = "#>", - error = TRUE, - fig.align = "center" -) -``` - -```{r, message=FALSE, warning=FALSE} -library(wpgsd) -library(gsDesign) -library(gMCPLite) -library(haven) -library(dplyr) -library(tidyr) -library(reshape2) -library(gt) -``` - -# Background - -The weighted parametric group sequential design (WPGSD) (@anderson2022unified) approach allows one to take advantage of the known correlation structure in constructing efficacy bounds to control family-wise error rate (FWER) for a group sequential design. Here correlation may be due to common observations in nested populations, due to common observations in overlapping populations, or due to common observations in the control arm. This document illustrates the use of the R package wpgsd to implement this approach. - -# Methods and Examples - -## Closed Testing and Parametric Tests - -We aim to control the familywise error rate (FWER) at level $\alpha$. Let $J \subseteq I$. The intersection hypothesis $H_J$ assumes the null hypothesis for all individual hypotheses $H_i$ with $i \in J$. Closed testing principle is as follows: if for all sets $J \subseteq I$ with $j \in J$, $H_J$ can be rejected at level $\alpha$, then $H_j$ can be rejected. Weighted parametric tests can be used for this: @bretz2011graphical, @xi2017unified for fixed designs or @maurer2013multiple for group sequential. - -## Consonance - -A closed procedure is called consonant if the rejection of the complete intersection null hypothesis $H_I$ further implies that at least one elementary hypothesis $H_i, i \in I$, is rejected. Consonance is a desirable property leading to short-cut procedures that give the same rejection decisions as the original closed procedure but with fewer operations. For WPGSD, consonance does not always hold and in general the closed-testing procedure is required. - -## Group Sequential Design Notations and Assumptions - -- A set $I$ of hypotheses for $i \in I$. -- $K$ group sequential analyses, $k = 1, \ldots, K$ -- Single endpoint - * Not required, and can be generalized -- Assume tests $Z_{ik}$, $i \in I$, $1 \leq k \leq K$ where a large $Z_{ik}$ is used to reject $H_i$ - -## Correlation Structure - -- Notation - * Events for individual hypothesis $H_i$,$i \in I$ at analysis k denoted by $n_{ik}$. - * Assume the same endpoint for all hypotheses (can be relaxed) - * For binary or continuous outcomes $n_{ik}$ represents sample size - * $Z_{ik}$ is standardized normal test for treatment effect for individual hypothesis $H_i$ at analysis $k$ - * Denote $n_{i\wedge i^\prime,k\wedge k^\prime}$ as the number of observations (or events) included in both $Z_{ik}$ and $Z_{i^\prime k^\prime}$, $i\in I$, $1\le k\le K$. -- Key result - $$ \hbox{Corr}(Z_{ik}, Z_{i^\prime k^\prime }) = \frac{n_{i\wedge i^\prime ,k\wedge k^\prime }}{\sqrt{n_{ik}n_{i^\prime k^\prime }}} $$ -- Proof builds on standard group sequential theory (@chen2021multiplicity) - -## Example 1: Overlapping Populations, Two Analyses - -Following illustrates the first example, which has overlapping populations (e.g. due to biomarker) and is also example 1 in @anderson2022unified. - -```{r, eval=FALSE, echo=FALSE} -library(ggplot2) -library(ggforce) - -ellipse_data <- data.frame( - id = c("H1: Population 1", "H2: Population 2", "H3: Overall Population"), - x = c(0, 1, 0.5), - y = c(0, 0, 0), - a = c(1, 1, 2), - b = c(0.5, 0.5, 1) -) - -ragg::agg_png( - "vignettes/figures/ex1-pop.png", - width = 1920, - height = 1920 / 1.618, - res = 96, - scaling = 2 -) -ggplot() + - geom_ellipse( - aes( - x0 = x, y0 = y, a = a, b = b, angle = 0, fill = id - ), - data = ellipse_data[ellipse_data$id == "H3: Overall Population", ], - color = NA, alpha = 0.5, show.legend = FALSE - ) + - geom_ellipse( - aes( - x0 = x, y0 = y, a = a, b = b, angle = 0, fill = id - ), - data = ellipse_data[ellipse_data$id != "H3: Overall Population", ], - color = NA, alpha = 0.85, show.legend = FALSE - ) + - geom_text(aes( - x = x, y = y, label = id, - hjust = ifelse(id == "H1: Population 1", 1.1, - ifelse(id == "H2: Population 2", -0.1, 0.5) - ), - vjust = ifelse(id == "H3: Overall Population", -9, 0.5) - ), data = ellipse_data, size = 6) + - scale_fill_manual(values = c("#E69F00", "#56B4E9", "#999999"), guide = "none") + - coord_fixed() + - theme_void() -dev.off() -``` - -```{r, echo=FALSE, out.width="90%", fig.cap="Ex1: Populations"} -knitr::include_graphics("figures/ex1-pop.png") -``` - -The multiplicity strategy is defined as follows. - -```{r, out.width="80%"} -# Transition matrix -m <- matrix(c( - 0, 0, 1, - 0, 0, 1, - 0.5, 0.5, 0 -), nrow = 3, byrow = TRUE) -# Weight matrix -w <- c(0.3, 0.3, 0.4) - -# Multiplicity graph -cbPalette <- c("#999999", "#E69F00", "#56B4E9") - -nameHypotheses <- c( - "H1: Population 1", - "H2: Population 2", - "H3: Overall Population" -) - -hplot <- hGraph(3, - alphaHypotheses = w, - m = m, - nameHypotheses = nameHypotheses, - trhw = .2, trhh = .1, - digits = 5, trdigits = 3, size = 5, halfWid = 1, - halfHgt = 0.5, offset = 0.2, trprop = 0.4, - fill = as.factor(c(2, 3, 1)), - palette = cbPalette, - wchar = "w" -) -hplot -``` - -The event count of each hypothesis at each analysis is shown below. - -| Population | Number of Events at IA | Number of Events at FA | -|:---------------------:|:----------------------:|:----------------------:| -| Population 1 | 100 | 200 | -| Population 2 | 110 | 220 | -| Population 1 $\cap$ 2 | 80 | 160 | -| Overall Population | 225 | 450 | - -Table: Number of events at each analysis for each population in Example 1. -IA: interim analysis. FA: final analysis. - -The correlation matrix among test statistics is as follows. - -| $i,k$ | 1,1 | 2,1 | 3,1 | 1,2 | 2,2 | 3,2 | -|:---:|:---:|:---:|:---:|:---:|:---:|:---:| -| 1,1 | 1 | $\frac{80}{\sqrt{100\cdot 110}}$ | $\frac{100}{\sqrt{100 \cdot 225}}$ | $\frac{100}{\sqrt{100\cdot 200}}$ | $\frac{80}{\sqrt{100\cdot 220}}$ | $\frac{100}{\sqrt{100 \cdot 450}}$ | -| 2,1 | 0.76 | 1 | $\frac{110}{\sqrt{110 \cdot 225}}$ | $\frac{80}{\sqrt{110\cdot 200}}$ | $\frac{110}{\sqrt{110\cdot 220}}$ | $\frac{110}{\sqrt{110 \cdot 450}}$ | -| 3,1 | 0.67 | 0.70 | 1 | $\frac{100}{\sqrt{225 \cdot 200}}$ | $\frac{110}{\sqrt{225 \cdot 220}}$ | $\frac{225}{\sqrt{225 \cdot 450}}$ | -| 1,2 | 0.71 | 0.54 | 0.47 | 1 | $\frac{160}{\sqrt{200 \cdot 220}}$ | $\frac{200}{\sqrt{200 \cdot 450}}$ | -| 2,2 | 0.54 | 0.71 | 0.49 | 0.76 | 1 | $\frac{220}{\sqrt{220 \cdot 450}}$ | -| 3,2 | 0.47 | 0.49 | 0.71 | 0.67 | 0.70 | 1 | - -Table: Correlation Matrix of Test Statistics for Example 1. -Identical numeric values (lower triangular) and formulas (upper triangular) shown. - -## Example 2: Common Control, Two Analyses - -Following illustrates the second example in which correlation comes from common control arm. This is also example 2 in @anderson2022unified. - -```{r, out.width="80%", echo = FALSE} -cbPalette <- c( - "#999999", "#E69F00", "#56B4E9", "#009E73", - "#F0E442", "#0072B2", "#D55E00", "#CC79A7" -) -nameHypotheses <- c( - "H1: Experimental 1 vs Control", - "H2: Experimental 2 vs Control", - "H3: Experimental 3 vs Control" -) -m <- matrix(c( - 0, 0.5, 0.5, - 0.5, 0, 0.5, - 0.5, 0.5, 0 -), nrow = 3, byrow = TRUE) -alphaHypotheses <- c(1 / 3, 1 / 3, 1 / 3) - -hplot <- hGraph(3, - alphaHypotheses = alphaHypotheses, m = m, - nameHypotheses = nameHypotheses, trhw = .2, trhh = .1, - digits = 3, trdigits = 4, size = 5, halfWid = 1.2, halfHgt = 0.5, - offset = 0.2, trprop = 0.35, - fill = as.factor(c(2, 3, 1)), - palette = cbPalette[1:3], - wchar = "w" -) -hplot -``` - -| Treatment Arm | Number of Events at IA | Number of Events at FA | -|:--------------:|:----------------------:|:----------------------:| -| Experimental 1 | 70 | 135 | -| Experimental 2 | 75 | 150 | -| Experimental 3 | 80 | 165 | -| Control | 85 | 170 | - -Table: Number of events at each analysis for each treatment arm in Example 2. -IA: interim analysis. FA: final analysis. - -| $i,k$ | 1,1 | 2,1 | 3,1 | 1,2 | 2,2 | 3,2 | -|:---:|:---:|:---:|:---:|:---:|:---:|:---:| -| 1,1 | 1 | $\frac{85}{\sqrt{155\cdot 160}}$ | $\frac{85}{\sqrt{155 \cdot 165}}$ | $\frac{155}{\sqrt{155\cdot 305}}$ | $\frac{85}{\sqrt{155\cdot 320}}$ | $\frac{85}{\sqrt{155 \cdot 335}}$ | -| 2,1 | 0.54 | 1 | $\frac{85}{\sqrt{160 \cdot 165}}$ | $\frac{85}{\sqrt{160 \cdot 305}}$ | $\frac{160}{\sqrt{160\cdot 320}}$ | $\frac{85}{\sqrt{160 \cdot 335}}$ | -| 3,1 | 0.53 | 0.52 | 1 | $\frac{85}{\sqrt{165 \cdot 305}}$ | $\frac{85}{\sqrt{165\cdot 320}}$ | $\frac{165}{\sqrt{165 \cdot 335}}$ | -| 1,2 | 0.71 | 0.38 | 0.38 | 1 | $\frac{170}{\sqrt{305\cdot 320}}$ | $\frac{170}{\sqrt{305 \cdot 335}}$ | -| 2,2 | 0.38 | 0.71 | 0.37 | 0.54 | 1 | $\frac{170}{\sqrt{320 \cdot 335}}$ | -| 3,2 | 0.37 | 0.37 | 0.70 | 0.53 | 0.52 | 1 | - -Table: Correlation Matrix for Example 2. -Identical numeric values (lower triangular) and formulas (upper triangular) shown. - -## Hypotheses Set - -These 2 examples each has 7 intersection hypotheses and the corresponding weighting strategies are illustrated below. - -| $H_J$ | $w_1(J)$ | $w_2(J)$ | $w_3(J)$ | -|:-----------------------:|:--------:|:--------:|:--------:| -| $H_1 \cap H_2 \cap H_3$ | 0.3 | 0.3 | 0.4 | -| $H_1 \cap H_2$ | 0.5 | 0.5 | - | -| $H_1 \cap H_3$ | 0.3 | - | 0.7 | -| $H_2 \cap H_3$ | - | 0.3 | 0.7 | -| $H_1$ | 1 | - | - | -| $H_2$ | - | 1 | - | -| $H_3$ | - | - | 1 | - -Table: Weighting strategy of Example 1. - -| $H_J$ | $w_1(J)$ | $w_2(J)$ | $w_3(J)$ | -|:-----------------------:|:--------:|:--------:|:--------:| -| $H_1 \cap H_2 \cap H_3$ | 1/3 | 1/3 | 1/3 | -| $H_1 \cap H_2$ | 1/2 | 1/2 | - | -| $H_1 \cap H_3$ | 1/2 | - | 1/2 | -| $H_2 \cap H_3$ | - | 1/2 | 1/2 | -| $H_1$ | 1 | - | - | -| $H_2$ | - | 1 | - | -| $H_3$ | - | - | 1 | - -Table: Weighting strategy of Example 2. - -## $\alpha$ Spending: 3 approaches - -The WPGSD approach uses all known correlations between tests in the study. This relaxes bounds and allows increased power or smaller sample size. Three spending approaches have been proposed: - -- Fixed spending (Fleming-Harrington-O'Brien (FHO) approach). Specify $0 < \alpha_1(J) < \alpha_2(J) < \ldots < \alpha_K(J) = \alpha(J) \leq \alpha$ for all $J\subseteq I$, where $\alpha(J)$ is the total alpha for intersection hypothesis $H_J$ according to the graphical approach. - -- $\alpha$-spending approach 1. We choose a spending function family $f(t,\alpha)$ and set $\alpha_k(J)=f(t_k(J),\alpha(J))$ for $1\le k\le K$ for all intersection hypotheses $J\subseteq I$. - -- $\alpha$-spending approach 2. For each elementary hypothesis $i$ ($i$ = 1, 2, \ldots, $m$), specify the $\alpha$-spending function family $f_i(t,\gamma)$ where $\gamma$ is the $\alpha$ level for the hypothesis and $f_i(t_{ik},\gamma)$ determines how much $\alpha$ to spend up to analysis $k$ for hypothesis $i$ when level $\gamma$ is allocated to the hypothesis. Then $\alpha_k(J) = \sum_{i \in J} f_i(t_{ik}, w_i(J)\alpha)$. - -## Bounds Computation: Parametric Test, Fixed Design (For Example, Two Populations, One Analysis) - -- Assume ($Z_1,Z_2$) bivariate normal with known correlation - -- Find $\alpha$-inflation factor $c_J$ such that - $$ \alpha = P[\cup_{i \in J} \{p_i \leq c_Jw_{J,i}\alpha \}] = P[\cup_{i \in J} \{Z_i \geq \Phi^{-1}(1-c_Jw_{J,i}\alpha \}]$$ - -- Basic algorithm code in @bretz2011graphical - -### Bounds Computation: WPGSD - Fixed spending and $\alpha$ spending approach 1 {.smaller} - -- Assume for $j < k$ that bounds $c_{ij} (J), i \in J, j < k$, have already been set and remain unchanged. - -- At analysis $k$, compute the correlation matrix of $Z_{ij}$, $i \in J$, $j = 1, \ldots, k$. - - i Initialize $\alpha_{k}^{*}(J) = \alpha_{k}(J) - \alpha_{k-1}(J)$. - - ii Set $b_{ik} = \Phi^{-1}(1 - w_{i}(J)\alpha_{k}^{*} (J))$, $i\in J$. - - iii Compute type I error rate up to analysis $k$ - $$ 1 - Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} \cap_{i \in J, j < k} \{ Z_{ij} < c_{ij}(J) \} ). $$ - - iv Update $\alpha_{k}^{*}(J)$ using root-finding with steps ii - iii until the type I error rate through analysis $k$ is controlled at $\alpha_{k}(J)$ for $H_J$. That is, - $$ 1 - Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} \cap_{i \in J, j < k} \{ Z_{ij} < c_{ij}(J) \} ) = \alpha_{k}. $$ - - v Set $c_{ik}(J) = b_{ik}$ from the previous step. The corresponding nominal $p$-value boundary is $p_{ik}(J)= 1-\Phi(c_{ik}(J)) = w_i(J)\alpha_k^*(J)$. - -- Note: interim bound does not depend on future analyses. Solution only requires root finding for a single $\alpha_{k}^{*}(J)$ at a time, $k = 1, \ldots, K$. Requires multivariate normal computation from mvtnorm R package Genz et al. (2020). - -### Bounds Computation: WPGSD - $\alpha$ spending approach 2 {.smaller} - -- Assume for $j < k$ that bounds $c_{ij} (J), i \in J, j < k$, have already been set and remain unchanged. - -- At analysis $k$, compute the correlation matrix of $Z_{ij}$, $i \in J$, $j = 1, \ldots, k$. - - i Determine what the nominal $p$-value boundary would be for each elementary hypothesis in $J$ for a weighted Bonferroni test in a group sequential design as described in @maurer2013multiple. Let these nominal $p$-value boundaries be $\alpha^\prime_{ik}(J)$. - - ii Choose an inflation factor $\xi_{k}(J) > 1$ and set $$b_{ik} = \Phi^{-1}(1 - \xi_k(J) \alpha^\prime_{ik}(J)).$$ - - iii Update $\xi_k(J)$ until this type I error rate up to analysis $k$ is controlled at $\alpha_{k}(J)$ for $H_J$. That is, - $$ 1 - Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} \cap_{i \in J, j < k} \{ Z_{ij} < c_{ij}(J) \} ) = \alpha_{k}(J).$$ - - iv After the appropriate $\xi_k(J)$ has been derived, the nominal $p$-value boundaries are $p_{ik}(J)=\xi_k(J) \alpha^\prime_{ik}(J)$, and $b_{ik}$ is computed as in step ii, we set $c_{ik}(J) = b_{ik}$. - -- Note: interim bound does not depend on future analyses. Solution only requires root finding for a single $\xi_k(J)$ at a time, $k = 1, \ldots, K$. Requires multivariate normal computation from the mvtnorm R package Genz et al. (2020). - -## Implementation of Example 1 with Overlapping Populations - -We first define the transition matrix and weights as shown above in Section 2.5. Next we set up the event count table as follows: - -- Analysis: Analysis number (1 for interim, 2 for final). -- Event: Event counts. -- H1, H2: Hypotheses intersected. - * (1, 1) represents counts for hypothesis 1 - * (1, 2) for counts for the intersection of hypotheses 1 and 2 - -```{r} -event <- tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 100, - 2, 2, 1, 110, - 3, 3, 1, 225, - 1, 2, 1, 80, - 1, 3, 1, 100, - 2, 3, 1, 110, - 1, 1, 2, 200, - 2, 2, 2, 220, - 3, 3, 2, 450, - 1, 2, 2, 160, - 1, 3, 2, 200, - 2, 3, 2, 220 -) -event %>% - gt() %>% - tab_header(title = "Event Count") -``` - -```{r} -# Alternatively, one can manually enter paths for analysis datasets, -# example below uses an example dataset assuming currently we are at IA1. -paths <- system.file("extdata/", package = "wpgsd") - -### Generate event count table from ADSL and ADTTE datasets -# Selection criteria for each hypothesis -h_select <- tribble( - ~Hypothesis, ~Crit, - 1, "PARAMCD=='OS' & TRT01P %in% c('Xanomeline High Dose', 'Placebo')", - 2, "PARAMCD=='OS' & TRT01P %in% c('Xanomeline Low Dose', 'Placebo')" -) - -event2 <- generate_event_table(paths, h_select, - adsl_name = "adsl", adtte_name = "adtte", - key_var = "USUBJID", cnsr_var = "CNSR" -)$event - -event2 %>% - gt() %>% - tab_header(title = "Event Count - Computed from SAS Datasets Example") -``` - -Then we compute correlation matrix using the event count table and `generate_corr()`. We see that the correlations not accounted for by the Bonferroni approach are substantial and, thus, might expect a non-trivial impact on bounds for hypothesis tests. - -```{r} -## Generate correlation from events -corr <- generate_corr(event) - -corr %>% - as_tibble() %>% - gt() %>% - fmt_number(columns = everything(), decimals = 2) %>% - tab_header(title = "Correlation Matrix") -``` - -Bonferroni and WPGSD bounds can then be computed via `generate_bounds()`. In this example, we useHSD(-4) as $\alpha$-spending for all hypotheses. Of note, `generate_bounds()` input type specifies boundary type. - -- 0 = Bonferroni. Separate alpha spending for each hypotheses. -- 1 = Fixed alpha spending for all hypotheses. Method 3a in the manuscript. -- 2 = Overall alpha spending for all hypotheses. Method 3b in the manuscript. -- 3 = Separate alpha spending for each hypotheses. Method 3c in the manuscript. - -Compute Bonferroni bounds. - -```{r} -# Bonferroni bounds -bound_Bonf <- generate_bounds( - type = 0, k = 2, w = w, m = m, - corr = corr, alpha = 0.025, - sf = list(sfHSD, sfHSD, sfHSD), - sfparm = list(-4, -4, -4), - t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1)) -) - -bound_Bonf %>% - gt() %>% - fmt_number(columns = 3:5, decimals = 4) %>% - tab_header(title = "Bonferroni bounds") -``` - -Compute WPGSD Bounds using $\alpha$-spending approach 1 with HSD(-4) spending. Here spending time was defined as minimum of the 3 observed information fractions. - -```{r} -set.seed(1234) -# WPGSD bounds, spending approach 1 -bound_WPGSD <- generate_bounds( - type = 2, k = 2, w = w, m = m, - corr = corr, alpha = 0.025, - sf = sfHSD, - sfparm = -4, - t = c(min(100 / 200, 110 / 220, 225 / 450), 1) -) - -bound_WPGSD %>% - gt() %>% - fmt_number(columns = 3:5, decimals = 4) %>% - tab_header(title = "WPGSD bounds") -``` - -Below shows the comparison between the Bonferroni and WPGSD bounds. Nominal level at final analysis by using the WPGSD method increased by up to 1.3× over those obtained via the Bonferroni approach. - -```{r, echo=FALSE} -# Combine and back-calculate xi -bounds <- left_join(bound_Bonf, bound_WPGSD, - by = c("Hypotheses", "Analysis"), - suffix = c(".B", ".W") -) - -bounds <- bounds %>% - rowwise() %>% - mutate(xi = sum(H1.W, H2.W, H3.W, na.rm = TRUE) / - sum(H1.B, H2.B, H3.B, na.rm = TRUE)) - -# Reorder for output -bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2) -bounds <- bounds %>% - arrange(Analysis, order) %>% - select(-order) - -# Bonferroni and WPGSD Bounds (Table 6 in the manuscript) -bounds %>% - gt() %>% - fmt_number(columns = 3:9, decimals = 4) %>% - tab_header(title = "Bonferroni and WPGSD Bounds") -``` - -Closed testing procedure can then be performed using `closed_test()`. - -```{r} -## Observed p-values. -## The tibble must contain columns Analysis, H1, H2 etc for all hypotheses -p_obs <- tribble( - ~Analysis, ~H1, ~H2, ~H3, - 1, 0.01, 0.0004, 0.03, - 2, 0.05, 0.002, 0.015 -) - -## Closed testing ## -test_result <- closed_test(bound_WPGSD, p_obs) - -p_obs %>% - gt() %>% - fmt_number(columns = 2:4, decimals = 8, drop_trailing_zeros = TRUE) %>% - tab_header("Observed Nominal p-Values") -``` - -```{r} -test_result %>% - gt() %>% - tab_header(title = "Closed Testing Results") -``` - -## Implementation of Example 2 with Common Control - -Similarly, codes below reproduce the result of Example 2 of @anderson2022unified, which uses spending method 3c specified in the paper. - -```{r} -set.seed(1234) - -# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ex2 BH ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~# -# Transition matrix in Figure A2 -m <- matrix(c( - 0, 0.5, 0.5, - 0.5, 0, 0.5, - 0.5, 0.5, 0 -), nrow = 3, byrow = TRUE) -# Initial weights -w <- c(1 / 3, 1 / 3, 1 / 3) - -# Event count of intersection of paired hypotheses - Table 2 -event <- tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160, - 3, 3, 1, 165, - 1, 2, 1, 85, - 1, 3, 1, 85, - 2, 3, 1, 85, - 1, 1, 2, 305, - 2, 2, 2, 320, - 3, 3, 2, 335, - 1, 2, 2, 170, - 1, 3, 2, 170, - 2, 3, 2, 170 -) - -event %>% - gt() %>% - tab_header(title = "Event Count") -``` - -```{r} -# Generate correlation from events -corr <- generate_corr(event) - -# Correlation matrix in Table 4 -corr %>% - as_tibble() %>% - gt() %>% - fmt_number(columns = everything(), decimals = 2) %>% - tab_header(title = "Correlation Matrix") -``` - -```{r} -# WPGSD bounds, spending method 3c -bound_WPGSD <- generate_bounds( - type = 3, k = 2, w = w, m = m, corr = corr, alpha = 0.025, - sf = list(sfLDOF, sfLDOF, sfLDOF), - sfparm = list(0, 0, 0), - t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1)) -) - -# Bonferroni bounds -bound_Bonf <- generate_bounds( - type = 0, k = 2, w = w, m = m, corr = corr, alpha = 0.025, - sf = list(sfLDOF, sfLDOF, sfLDOF), - sfparm = list(0, 0, 0), - t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1)) -) - -bounds <- left_join(bound_Bonf, bound_WPGSD, - by = c("Hypotheses", "Analysis"), - suffix = c(".B", ".W") -) - -# Reorder for output -bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2) -bounds <- bounds %>% - arrange(Analysis, order) %>% - select(-order) - -# Table A6 -bounds %>% - gt() %>% - fmt_number(columns = 3:9, decimals = 4) %>% - tab_header(title = "Bonferroni and WPGSD Bounds") -``` - -## Power Considerations - -The above illustrates the use of the WPGSD approach to compute bounds at the analysis stage. At the design stage, one can take one of the following 2 options: 1) The trial can be first designed as if the testing would be done with a weighted Bonferroni with conservative sample size estimate. At the analysis stage, the correlation can be taken into consideration with the WPGSD approach for bound calculation; or 2) To adjust the sample size downward using the WPGSD approach at the design stage, one can power the study by taking the minimum $p$-value bound for a given individual hypothesis from the WPGSD table (with assumed correlation structure). For example, for $H_2$ of example 1, this is $\hbox{min}(0.0011,0.0017,0.0010,0.0030)=0.0010$ for $k=1$ and $\hbox{min}(0.0092,0.0144,0.0081,0.0238)=0.0081$ for $k=2$. Then the $H_2$ bounds of 0.0010 ($k=1$) and 0.0081 ($k=2$) can be used to power $H_2$. R function for the 2nd option is in development. - -# Conclusions - -The WPGSD approach provides an unification of previous work on parametric testing in group sequential design. It enabled more complex scenarios and requires attention to consonance and intersection hypotheses. Although detailed closed testing is required, this should not be a deterrent. The approach accommodates various spending approaches and provides more relaxed bounds -and improved power compared to the Bonferroni approach. - -# References diff --git a/wpgsd.Rcheck/vign_test/wpgsd/vignettes/wpgsd.bib b/wpgsd.Rcheck/vign_test/wpgsd/vignettes/wpgsd.bib deleted file mode 100644 index 0285346..0000000 --- a/wpgsd.Rcheck/vign_test/wpgsd/vignettes/wpgsd.bib +++ /dev/null @@ -1,53 +0,0 @@ -@article{anderson2022unified, - 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}, - volume = {64}, - number = {7}, - pages = {1219--1239}, - year = {2022}, - publisher = {Wiley Online Library} -} - -@article{bretz2011graphical, - title = {Graphical approaches for multiple comparison procedures using weighted Bonferroni, Simes, or parametric tests}, - author = {Bretz, Frank and Posch, Martin and Glimm, Ekkehard and Klinglmueller, Florian and Maurer, Willi and Rohmeyer, Kornelius}, - journal = {Biometrical Journal}, - volume = {53}, - number = {6}, - pages = {894--913}, - year = {2011}, - publisher = {Wiley Online Library} -} - -@article{chen2021multiplicity, - title = {Multiplicity for a group sequential trial with biomarker subpopulations}, - author = {Chen, Ting-Yu and Zhao, Jing and Sun, Linda and Anderson, Keaven M}, - journal = {Contemporary Clinical Trials}, - volume = {101}, - pages = {106249}, - year = {2021}, - publisher = {Elsevier} -} - -@article{maurer2013multiple, - title = {Multiple testing in group sequential trials using graphical approaches}, - author = {Maurer, Willi and Bretz, Frank}, - journal = {Statistics in Biopharmaceutical Research}, - volume = {5}, - number = {4}, - pages = {311--320}, - year = {2013}, - publisher = {Taylor \& Francis} -} - -@article{xi2017unified, - title = {A unified framework for weighted parametric multiple test procedures}, - author = {Xi, Dong and Glimm, Ekkehard and Maurer, Willi and Bretz, Frank}, - journal = {Biometrical Journal}, - volume = {59}, - number = {5}, - pages = {918--931}, - year = {2017}, - publisher = {Wiley Online Library} -} \ No newline at end of file diff --git a/wpgsd.Rcheck/wpgsd-Ex.R b/wpgsd.Rcheck/wpgsd-Ex.R deleted file mode 100644 index 826a36c..0000000 --- a/wpgsd.Rcheck/wpgsd-Ex.R +++ /dev/null @@ -1,298 +0,0 @@ -pkgname <- "wpgsd" -source(file.path(R.home("share"), "R", "examples-header.R")) -options(warn = 1) -library('wpgsd') - -base::assign(".oldSearch", base::search(), pos = 'CheckExEnv') -base::assign(".old_wd", base::getwd(), pos = 'CheckExEnv') -cleanEx() -nameEx("calc_seq_p") -### * calc_seq_p - -flush(stderr()); flush(stdout()) - -### Name: calc_seq_p -### Title: Calculate sequential p-values for interaction/elementary -### hypothesis -### Aliases: calc_seq_p - -### ** Examples - - - - -cleanEx() -nameEx("closed_test") -### * closed_test - -flush(stderr()); flush(stdout()) - -### Name: closed_test -### Title: Perform closed testing procedure -### Aliases: closed_test - -### ** Examples - -p_obs <- dplyr::bind_rows( - tibble::tibble(Analysis = 1, H1 = 0.001, H2 = 0.001), - tibble::tibble(Analysis = 2, H1 = 0.001, H2 = 0.001) -) -bound <- tibble::tribble( - ~Analysis, ~Hypotheses, ~H1, ~H2, - 1, "H1", 0.02, NA, - 1, "H1, H2", 0.0001, 0.00001, - 1, "H2", NA, 0.003, - 2, "H1", 0.02, NA, - 2, "H1, H2", 0.02, 0.00001, - 2, "H2", NA, 0.003 -) - -closed_test <- closed_test(bound, p_obs) - - - -cleanEx() -nameEx("find_astar") -### * find_astar - -flush(stderr()); flush(stdout()) - -### Name: find_astar -### Title: Utility function for root-finding to compute crossing -### probabilities with the overall alpha spending approach -### Aliases: find_astar - -### ** Examples - -# Input event count of intersection of paired hypotheses - Table 2 -my_event <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160, - 3, 3, 1, 165, - 1, 2, 1, 85, - 1, 3, 1, 85, - 2, 3, 1, 85, - 1, 1, 2, 305, - 2, 2, 2, 320, - 3, 3, 2, 335, - 1, 2, 2, 170, - 1, 3, 2, 170, - 2, 3, 2, 170 -) - -# Generate correlation from events -my_corr <- generate_corr(my_event) - -# Find the inflation factor for H1, H2 at analysis 1 -find_astar( - a = 0.0008708433, - alpha_prev = NULL, - aprime = c(0.0004588644, 0.0004119789), - astar = 1, - w = c(0.5, 0.5), - sig = my_corr[ - colnames(my_corr) %in% c("H1_A1", "H2_A1"), - colnames(my_corr) %in% c("H1_A1", "H2_A1") - ] -) - - - -cleanEx() -nameEx("find_xi") -### * find_xi - -flush(stderr()); flush(stdout()) - -### Name: find_xi -### Title: Utility function for root-finding to compute inflation factor xi -### with the separate alpha spending approach -### Aliases: find_xi - -### ** Examples - -# Input event count of intersection of paired hypotheses - Table 2 -my_event <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160, - 3, 3, 1, 165, - 1, 2, 1, 85, - 1, 3, 1, 85, - 2, 3, 1, 85, - 1, 1, 2, 305, - 2, 2, 2, 320, - 3, 3, 2, 335, - 1, 2, 2, 170, - 1, 3, 2, 170, - 2, 3, 2, 170 -) - -# Generate correlation from events -my_corr <- generate_corr(my_event) - -# Find the inflation factor for H1, H2 at analysis 1 -find_xi( - a = 0.0008708433, - alpha_prev = NULL, - aprime = c(0.0004588644, 0.0004119789), - xi = 1, - sig = my_corr[ - colnames(my_corr) %in% c("H1_A1", "H2_A1"), - colnames(my_corr) %in% c("H1_A1", "H2_A1") - ] -) - - - -cleanEx() -nameEx("generate_bounds") -### * generate_bounds - -flush(stderr()); flush(stdout()) - -### Name: generate_bounds -### Title: Compute p-value boundaries of the parametric MTP method with -### overall alpha spending for all hypotheses -### Aliases: generate_bounds - -### ** Examples - -# Build the transition matrix -m <- matrix(c( - 0, 0.5, 0.5, - 0.5, 0, 0.5, - 0.5, 0.5, 0 -), nrow = 3, byrow = TRUE) - -# Initialize weights -w <- c(1 / 3, 1 / 3, 1 / 3) - -# Input information fraction -IF_IA <- c(155 / 305, 160 / 320, 165 / 335) - -# Input event count of intersection of paired hypotheses - Table 2 -event <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160, - 3, 3, 1, 165, - 1, 2, 1, 85, - 1, 3, 1, 85, - 2, 3, 1, 85, - 1, 1, 2, 305, - 2, 2, 2, 320, - 3, 3, 2, 335, - 1, 2, 2, 170, - 1, 3, 2, 170, - 2, 3, 2, 170 -) - -# Generate correlation from events -gs_corr <- generate_corr(event) - -# Generate bounds -generate_bounds( - type = 3, - k = 2, - w = w, - m = m, - corr = gs_corr, - alpha = 0.025, - sf = list(gsDesign::sfLDOF, gsDesign::sfLDOF, gsDesign::sfLDOF), - sfparm = list(0, 0, 0), - t = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[3], 1)) -) - - - -cleanEx() -nameEx("generate_corr") -### * generate_corr - -flush(stderr()); flush(stdout()) - -### Name: generate_corr -### Title: Generate correlation matrix based on event counts -### Aliases: generate_corr - -### ** Examples - -# Build the transition matrix -m <- matrix(c( - 0, 0.5, 0.5, - 0.5, 0, 0.5, - 0.5, 0.5, 0 -), nrow = 3, byrow = TRUE) -# initialize weights -w <- c(1 / 3, 1 / 3, 1 / 3) - -# Input event count of intersection of paired hypotheses - Table 2 -event <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, 155, - 2, 2, 1, 160, - 3, 3, 1, 165, - 1, 2, 1, 85, - 1, 3, 1, 85, - 2, 3, 1, 85, - 1, 1, 2, 305, - 2, 2, 2, 320, - 3, 3, 2, 335, - 1, 2, 2, 170, - 1, 3, 2, 170, - 2, 3, 2, 170 -) - -# Generate correlation from events -gs_corr <- generate_corr(event) - - - -cleanEx() -nameEx("generate_event_table") -### * generate_event_table - -flush(stderr()); flush(stdout()) - -### Name: generate_event_table -### Title: Generate table of event counts from ADSL and ADTTE datasets -### Aliases: generate_event_table - -### ** Examples - -library(dplyr) - -paths <- system.file("extdata/", package = "wpgsd") - -# Selection criteria for each hypothesis -h_select <- tibble::tribble( - ~Hypothesis, ~Crit, - 1, "PARAMCD == 'OS' & TRT01P %in% c('Xanomeline High Dose', 'Placebo')", - 2, "PARAMCD == 'OS' & TRT01P %in% c('Xanomeline Low Dose', 'Placebo')" -) - -event <- generate_event_table(paths, h_select, - adsl_name = "adsl", adtte_name = "adtte", - key_var = "USUBJID", cnsr_var = "CNSR" -)$event - -event %>% - gt::gt() %>% - gt::tab_header(title = "Event Count - Computed from SAS Datasets Example") - - - -### *

!^Rwk8Xnf-Z$1GiOo;UCBO;aTyc z=W#!CFICE{oN=g<`0E?Ie_oF>nsRr+$gciOsWo7#90JVYrolWuVKBcR0~(iomQD%{ zOD6;4mQG0K@6q|AWR})W@^wpShs&1GNR};~jI=DB=pf?frLR3I1&xf-(n+Cd>Ezgi zq!W_QXSAg{IhLi9AvTUiIvE(ZbV7b@=|meYvsOymFS7ylk8H;5{irWlInh?lC?_YX zBE=~(-_a45)SM>8waGKe$*~EO;;0%QX%p;pGr<%LrPTO|!H_H1PYi~tNc#ziIbbMH zw{&7KoWui$WedPi9&Am|U^q#(bYd`+K}$LbU^uPznwhmUztS8w?F5RzHAYiO2hk84L|(RzH9dcY!fS2&h9;YqykXXKS~* zl@n=Wv^UbSf97lU&;1wdpL{^sKZl$4 z&*N45=e{xfCo`~r78>@?U&bxkFpsz8pv=S$ny=eI50~wr%*U#YKM2zqNq4cn<{6n3 z@ya~U2&dDG^nqq42{V!x+ethl`GK7z%t&5rdCfC&zZ^3%tzs|nj8sY5OTvugbpVyl zh;|%p(=gxKy!oClv@*wj&L~-~LBqL~?g6>qsp`z!os9)ko4$zrGD{z&1F7_})zXKy zBtQe0IGQ9ZZq$J+op12!`~zzL=UaR0s%-7P-w?;s-k`!j+0HZ`f77KX$2r)nCFbia zte{$m#5KzXaa7O68?Zkd=^JHfW@`^g~#-9IditX+9Ic|=x<>{mMeyx9JF!4lc{ z5wrcIRA&2Iqh|YSLuUI+2Ls!GZkySD?F<1KUOo9>!s7Gd9+CY@yzZ4k))+S1Ul|N+ z|JcsJ_Ot&4Zc;A&el&lOyqz`~d&zLLe+M-ob}xkKRur_ywwfB% z+&HJ8wt9dqb2v-ne@v|->nT8o?H1<|py$|B)8UyOZ1%W@Oc+w}qRkQH9qg2_3WsFh z1Z^~~Z4^lMwX4E9{>UB+=|%<8lw0h;5Oy(8yl8g@d51P@por7n4X8)elYex;>~X;0 zIu01^`ha&-21CG%dF7Z&$0v0BlJ<*WX0c|5-)ggiFtcnQgmh-|TkVn%W=4&IpRt8P zn3?^S{T0H@?6=x{AGn@>5yGOE?ocekBt#)w;Gqc|^GyK*wljCXw2xd0JeY8=+ zYq2?MFLUF3f_5;Oq#6A7+J!6c$d#|d zf|984Gu*FBxN3jzP6VabFj11HO!$-NoABQ^X2SnO^-a=sG7|CqvVj93mBgFy&(~g| zM~du1e7~wdPLI_3a1;JRbrb$%s3QC|ho>ZT9T|U;dVyOo1uw=yxURY>htzHUz6b}OqArJvfZh2ZA&ZMVw+>~?~N z-BQ)CTcb%ZQ-y=w%I(bQ+ir~}N>gw^TKg z`nKCz0i?d{jz!`tRqtF*p;Rwh0FxcXG#iPp5CqpkbhcIV6q&6s%qQ; zbfU_sCGtAa)zU}~GGzE}G(@AC2qK=@Ux+93u96>wIcbFL4 zM7g4Mkzk@~Y)n*CV4_@6p^}=YV#Bdw6J1YZqU&p&R2EE><2zV_i7L$< zg*sm(sA$sm3zC?#L&+8r3BP-Zv((Dbrd-r6B1L%N#4PJDMEr%9U8&{a`03u!X*YcB ze{GJxbjTu4y&#c?^kiMq@p>q5y`B?c{CZK~yk6oAuScBG>p43J${em?1?ps2rXo#6 zX9wk0e@^z#1RDj22NEOd-_AX<^vkf$Y5KNv`YKfir*Q<%2A`(9I;e}QI^U|KUpcMosv?*Ts9>fQh;$* zN=k>Ul+=c#lmMj83{o;?rKIw!wX#OxF$pCgXQ8C{orRK#qY_HU7Ij{W5VTNI`pH5` z?UaNP2Ge;h+;6*ulF}gyCG~=Y5(d+GEgH<6cjZ@c-aMptrIWC7#hiC>w>j^LqvE_7 z>@SIig7Ov|X!VnDSiw6JbQ0i@lK_XD1URJN2@dHbz#*LkIM7K1N1VbTodh_flK=-g ziQwSeAj2V@1US%1nBilRNd$)~BjAus0vyOBf`h|j42NVA;E+rL9LOYs176*5NG1Ue z$t1vmOd>cqJjQT{vuPoneWl^rPLicFOMB90~4v zZoA#JbkOcv8?w8$MsZh$!d*2h2NAQ9*Dx!24YQKhFe`bDW+ks-R`MEVC2>u&QuV{E z{+R|V||-?e)ebHxje61 z7@OmnuZQvN-fM16E65_sOBb}87LPg8jc|aTgmCA%LbDUX9jB%&Uh$!gWDV<6P+*eF z%$!0(5{G4$p}J+3+_+^HiV({zBQ47;`I=-F^7f5VSun&Z%W%^w%kipI7Bc<^Nz_yT zSY;_Rtg;;8FjiC+278PmNoAX9?0nra%i*$R7T8?V*dr~|*gEr->T5rT+&;j%lCu|0 zV-Gh?V;|>0TLa z;VN=0sRYB7n^{t^;VM`#-1UnU6&tRN@GxAZ4u-q(!Eoh+R#a@b>lO@m9b>lKhAY>z zq!J9*XlBc8xN=eq_lgy>|T1pHvcD-9YQE8?91++((5=|wX+J8U^s1i|?W>Qbynnjwt zu0>Zwlh>%=3H)!m7KCU+mm)Cn0DkL5Twc~kIl;fD7IAf~dHHY6+}f5_Y*GHyu`4|_n~&i(D}dCpU&XgOTAw=;@0MIB81lr%s)`~ISxopQ&{ zUTE6cf19wg?>KK~XEZzeP~FZxFmBBTTV9v9Gn&0U&pFBzWIvbf?Tlv4W+XWKiK;Xk z6upnp6d^sZH#JQ@glY02yK^v29&3TnrrC!u%|2v*wrTQMOmnefh0vy{lCeT)(_H3Q zA+%{~6qNYG^+bQ1Y7TwK%nh>!@xcccDM8a z4=jOzfh7>4b!XR<~Q4;P^zO2_W%ttUpRo(=6YY zG@-*<10+7k^*bpOhD6c?kVu*U5=j$+M9DdjNSXi=Noqi1X#z+jO#q3c2_W(2(|fE; z2ofn1Kq5&ENE|Uh;)r1z>i`K6(=O{kGewgF21FDvAfkW)5eE#2C}2QD0RtlNB|-#2 z&4?&q8X;h&Au_KdqB>6vaq0+Ls3dYNfhg|AOVn0I?E3RXboGDsTv;~HYE8%u-kk7e zc|J$$N*mLW!)RkVfLM?D-1bh-ubv8?zt^76W3lJ!VB>q?jb7($>n~#64nd3C*=snq zH{8x%!|gh}hTGX|_S$Q7J9&)`2gYkE$)95GwmIz+y2lSi>mDbnk#?wK;Y#8+B&-7P8$`KUFbHo@vS7i$Z%`tEUZ4?TCBRCA zwW(azh_7Q|yf|hPn^>tI;eSf5`ne2~pP#Ce|`zz~2U`jsrdFR5%`+)V#a z-Aq5Fp_%?2=gssVn?Od^12NGLz9#yAD4OU$QRS;j0)lvc$x6@DKZmU*`tvmeY7Hiy zUqa6lQp$4UCi;i!Ci)pnM87J*!ql`EKNG%(R|qBy6QqQ^{xl z_0(LU$$!(SX*4^qr{>X^no3Jh+Yrs_MdAfAK}udE-e4hKbfasP+>I8J*0iFlm&Oog zDuYzq>DedV>udI2`aG{}gh2vZx9 z2*Y4HibV;lS?%)A7GdfIi!e0syh#N{SaYnF)`Hb&EwY-t%T|ju$7*RUSS_tZR+H%4YSHFc4Q(!~ zN$+emhYPi%-m)UwSwh;~19`WJpuCrl_WL09f~3NS03Ypt;G_L9KH8s{CaLgk#fG6% zl8RDlmTl6CJyTLqcaoOO10{P%;F}>*f{y7(3H#3Rm#{8x_Wc@5Ae^sae|3D}(m)Mj?oeXTG%9Sln$tpEzniZ;n`Ogypc< zSUO-oujTFMt<&~%Lc@MuitXq1g8jTTYCk75?B|t1`*~y7Vk4GVy(#XtpHCdKpEpPB z=L}}`rgXq=Ud!9fTc_>j3}*GF99zBNb07h%PZL|GD3*0{XRMPuW1Y1_tdn+#bdy=@wVjhVUl5TW9U_DKS~QJwN6x}{UATARaOm8ZSAK(LW%bC+l1(Frp00PX2ng1 z57n*x42)a*VL|spYT99fro;23_9Xg;%a1GXXEf8{N_k0bPE!<3z&nCAABmDXFe2~&1< zW7)=2R_eo)J(^V;Pg$c$wFy&pW1UqSPg%*iQN|5aM)uNMl;w8nEy{wG4Xf2mOtl(r zo^OX8@w)XEW!Kqim0WZ+VlMbV_mlo@BJ&)|DgJkw9Kye+RQ98wc4Owu$EB%*;)d#vX;;~Z7rdex0X;k5VVAI+pHxt zN311OPd=)0skmEGf)b>Mq$Mxf95Z#jQNvVDj5vS|EQUN=5OZzkePqY-^~AMGylw=x(rz$F#pV7 z%ztylQd!0GSIMDnu570*l_Z_(VwC2oD=1^})g_i~G^bLhb6rfgoHohgue-$N!UGs4 zg(^s8odj(;{vtu4 zQLvy;IbuP9$8ABOHEJoXHe^AebT9}C=eAi;XpUG)tDgLms`26;yFb?1{Tst}|H@!+ z|FNCH{YUNo^@82M9NYbQ+;;!gX}f3bK=!m5h z3~M>+cg$9#sc7$9Qq--VT~FkRY{*um%^G9q z6%=rp`YkkxvKz2Ag5Y7--g_c7^&FpI13&2=)+e~R^@;sO>k}vF0b|c@eIieyN+m@(Bz;26=^E8p1GJhUP^j^YB8zH=7AQPy!s-AID`~+JKp0k) zjwJvO8`3=b(!#JxIxGQrSeG=C0McQVB3c9Ru+G4&0eDy?mslIC`cT)G@+eg$s!o(& zWeZ^D^8Ld!Ey4b)g=wSyDDq$B$?K{V)b9lQukI(x2#O1{ z|LToGHakYA6gzaQZwm6CBFNXLW?PJeKR1o(sX^kpT(we<8U*mgEgUKm1m<|GC zFni??J3ru+3?{D>06Gbb(b%w6g^0b9#NS@Ik3A*u%Hvf+U!&P6N#dom?!N#Y$rK)O zz$3I`k;WSjxuX<^6c4$hB?sf7KZ1v4HSmx(T5>QRt}nntwYnt-<00R-;t=rAU{)N| zbH?`G#>282c&Nq!4=EYop}{1WrFdvC@Q~0Y!7RnY#f{D^3wWp&akvCLR2Mm1jE6>Z zv=|SSIN%ZIRh{h4=#kXoh=v25W@cK(w3A$#c@+I^x^EmLP&w(ur9e`&S|)W$EJ zYMJ(R6yG4;fqAvjU*|iNZ(HPg8WKuuc}vvk8u<2Qb#)5ll|Xvfz+4mdtHwBt{|r5+8pv^tF>Dk3$@0dL@^@@ziv7hQ1O{RMea$2DKUwjStOXAplvyFdLpd{3K*wq&!H ze^rFgQ^UYM-37bdHW zhRKrOc(Nj^nXIxOCaYYC$&wj)vLdUQtnwx%EAd5>6MOHIeRWD4ITE>$VTg_y} zRx??pYD|{I&68!BwN|014&Z~IKIYZ*Gl!K}e6~%KO!zpPRWjjoYjPEe>JvVy_=bI{ zofDIHQD@fASWNN_54~gSx!DvvIZ01}aY_-iLUO+AerI+~DS~p>RIpsQyXt=F_J~L( zyK<|czcXvDlnzQutPM#^7d=PHe@$!joJ+v&2Bh;#BNwGSY*K&UXUL$npBo{meN6sEVUttESRQ4g7Ca=EV6({Lh+2qB0Q2# zJml!$Ax8%fIlAzWql1SW9Xup53J-a@@Q|m2hddoTq%sN*$ui&}PX`ZqI(W#_g@-&H zJml%%Ax{SndAjhBr-O$)9XzDV2oJfs@Q^T5Nvtyhh;&8)B4GwVB+LMaY99cR%qT!4 z%m9dl830k$1R&H<21LpXfW!hMHXyW@d>-`JQqtuDHj`kN88ZKg9k61!Gt(mdZh! zKj$n&K0mf2{|q+?7?buoSx`A1|Mo^ui(=Uyj<{pO9hIWNo2##l?Ev%S+||5! zp<&+q7%g)1GNN{%6OVUW4x7`_9} zUCOO&asKP)e17nJu_n2EWZb$4k8p(^F!_-maK7#be7Nifj9nH+Mp}Np`I?{a{tJG- z*yrav-1PH3P7fK+_xrJjrPMJm3nPVwg^>Z;&k#l^RG-k+78I^lM)Gw_b%)EA>L_i|ZxFrr?%wA(OiK1_QNq0{p< zzL}CAFLVOJ=Lc>GAaMZ1o(3RzngNkUXg@R{?qISwVnF0+5=ZbfyI}xCUJW3sv+afk z#AUI?5d)&a!Qw~i-W5d)$E2S8l!SR64RDuyJE1V9`pUhiT+RA);Z34nMs08#d< z`(hISZL$MUiCNJw9t0EDu3Fi)~xjI-W8j>`*X?<$9EV0R<6R`RjK&l z`0nx^Kb&xPd5<5C?;dyFy$5W)7Q>~mZG@4Xue#{}eMvF89Fgcyk_1gBfs^{ZcaQ5l zaei_llPhyN7sSlicPqChifn+H{N{+5{C4Fd^}7|lX_j)lceN&_UNDhAe#AsR`JjpX z)~Jd6+K`F-(!oIFpW9|4zd2$ezk2dTHRKidh{q=@{PJ1tn$;LKkzW}MME=;$K;(~_ z$gdXyk$=cUKE!q)@=u${ujNhTmwpOF{@JZ2@|z>pu_{M5XxEJ5cjEE2)?(y?koQz(eR2L&_u$%o2JfdK;FFo?ki24%6pAO>GBXhj1sh`|R2 zG5Ek>1|Jy2-~)roLSRtp3=9zXhCy-|FeuFi22=RJAUUixY6>41OyM6gg)bOP;h#2z z4-87}fx#3$Fp&5&SfKEaZctSK45(p-K@>hPsDc0nErbyaqVQXzmcs%J-Q>L%wrA%v z%}3sAlLWXmZzngOY}QTQt1Qm;b)1yV*1(~xgAOhol=#&lM0snty*(ANZecg(RXir* zqFdNK`&AY!6AqT1D++a56_10co?KDL?Y3{y#1bYZA&i-Igbxq;L&wiv>0qjY96ya= z$4_N2#Lt-5l&M~OUE9vp3l5-i>;PiE4xrX)2T(2V04g0w1L!LUP;NG0{+HUu8(X|o|)WFYbeF+jovjhn%2h2~(fo90seyuIAbWmtmIv_W)UnwrrSHi{goxL-CrPn6atji%bF-X^nweH)IqB95;DleT>*RJm3Be%mAs|l*lQ4<*7YJ$%3L`D0JQ$0CU zR%d)7CSaGv1f2kiil*~GH_O$eCCJs-YC^8&Sjg8M3s|XGkexb+j5OZCFjRLiFq(s5 z$9V_Cu?d<(G@4_9a@Dc$L(#EtqDs@RMpGzAYSTev*zZ`#*VrIPe^e-FFr7ojV2*{M zx?=$>6bnK_2a$mXrz<2^*shRR0Fq=nB(7Yj3*nKUA7!tWJkjQ<3 z#O@0ua$g{k`#Qb?Bo@GQ*ja!?b*2L>K%&tcV1`7aIlclUs$U&nhD4(&yi!P{wgHLa z7D)6*g;xrR26KEF64zLYuM`rgZ9ozml30*%9Mh#4N{)7MRH2#4XxhawlhNjjMD603 z3EA24Xqk|m9mOB>y(c4|M#@?g)2Si%$L-> z#p_t-@X*xVE^{~0?8V)t*(Z*QX6K9eZYR!Xx0+@z9kAF_%S-GbgVMn=e4~GDmc0~P z>`^*FXNi&ve?9MfD4CqH1`&77Aj&)$M0qHKI4xxmWvL7zk%mE(!7_*vS`ES%d%JXB z_AMXA2r0nMhd4N>9Zj*p${jnU6*Y!rt5GDasAWs7Te+2oH9laHDgfrZTiO}%?|9|B zTiR(2mT$NCE$#G9Z@8x=U9)T(s40)_A`$J&seV{6pUksRO8 zvGS{*W1|p6yE9)}Eh&EI=QwfH&#^gT(T)y9t0kqMtd`VHNiAVgk1D_9saP#39kN3l3HGB z34`gV7Y$~$q;$w?NxdMoguy;0=N1%6fFhZErh-D=1{Cr(ppdr#g}hBr$lHKI-Ubww z1c5?A2~a4F1PZwuP)HIK6cS2+LJ25PC>;d~Wv7Bd$tqANbp;9~vOuA{R!}I-1qvm- zKw(J`D5R4Bh3Z70P__&dN}dIUbP}LYY7G=hw1Gn9r=U<84iu_QfkG)dP>`?-ia0 zulSvPsB+Xk)Eu$m2G$m42)cyF%H6d?W9gtD3wPIJ;qH1Yy1O0=ch_U#?v}5(yW}hG zuE)aN^;o#O@)dWF!`)fD)El|k#U{Tk?$!_w85c`_&Rm_6oRQeQjkcPNbaVR^vtgU|jM5 z#$C)(AznW7%y&Mzx;fnL1tiz8rCq+ppfj}?wmQs9zufff_4d~Z^(Lx_5(%_Il>0W@Yf`QuWEyF ziZ2t`dA3VVH%~?op-?k{t$l|PMDjHe*g)}t4tAu(Gl8ugi^C4hlX%47VKoA$FdoYP z>=XeHrDWDajE8bL@URwPS~28t{F|a8xL>i zJc&n-5SU9m)V|)cExPKKL$qJG>b^`4Q6`#ga@Q?~X!qrm*S{+lv1L@J#-XKI-%I*c zEO(v(L>%*g=ZjPhgK}r9-YO}17H#npwtTvjTYp&M9;4frhnx20;}iDf@5k)R%)-80 zXxNv38Mn5_T%MORGaEZ|zHVneT(&dgToz+Sf-j$_+L!kiE$&gc*_R7V`|@uS_T?St z?aPd2UmjwMjVsB(_|!DzMVh9Hb*3qzz%J%#`h(9d=4q&?_<~sk ziOGDsSo5%uB=Gl3yP_p*{YB2gujV>A0C z`DXT8r_Jow@@Do+2LiKycB`5F=7^=SiKCBblk(zsBKAcLJfObIMqu_UzoyLox0c3Q zqrrQIg7+K@-g9nyr}tD(1@GBw?_u)tp2lzr2j#^PX#;{ID?9=m%6@@EH3|)6)&_t> znKE!FZw8J~-E4VXSv7E|^Z^cQ1Hd7PtTk$F05~X`+T|BQ3H7z50nku=1sbll4g_fc zG+c{~SQ-Eg)oGyNvJEs;#es%uI?xD&!nan)K*NzR6e8hZhy>8+hy>7ZBYf`ZE@-;})n{sDn@=cn^sTzYt~mpknn0z}jmJ-vrO#9-;@~qD zH+pfGchy|X;>Kq*M$)c)=JMNXzck863JlfectZJS2L^89z-Up&tCSsbV3ZDoz&N+f zfguI}PpF=JRkfGc0X5B@g)C6PJnX=z42HlM+Zh4_o`E^wjfuUHqm)%|X%bmg93~M; z=5OqdOv3f_klm3<*d3WfR(pp@WOaEu30LjIma3S9{gFvz6+V-gbOJT)Ez}9rw5#S_ z71f!-)U6y*IG(8T)P|cpMUoqy;{NH|P*G&?%lSI;DJXbV*z;}j9GRZ?BW>oDQ`=fy zyAsv@KP08o_^(dImC}F2)XNGE!Bk~psy<(%UsFuDn0i%)Z;GnVl}*(T)lJni2T}DZ zfL@Vqb!42qH`LT-svg@+)$bcKReyYfefl+;n0k%&q;#wO7fjXXYjk*OG%@um5gyix zm&0XK_4&G~dPWmfuc~>obgN&+&D9qg=ITl7%+-HCX0HDD1l!PPG*k8Dt)}Yt7fsdE z=Ex3lf+4v}xg#(rHPu>$6b2O}z@TCX7*wo?oljvFevo}28{*`9t{{Y8Zc-yV9;p5;7SP?RQ3Ub5@6Hw0S0Siz@T*5{JddsE)5LQ z$jr|h290KVKES|ef+4;l7-GW^-^E6j%2~5j7TF0)vvKpPm^xK5<;s~#mYuMaEpbsL zHWxQ9G9y#TL~?j{#x*Q5TYD*LOWUF(ndbTwF8mfZ;J02+)}f&7)EWa^f@ za47C?MQ)~oMr%RG>^@O6Y1;szDPMOqF-Jv{W~r0On5V<3&~P|$Z->*)^A4xqCfJKf zdX=Mzr{rkbUvxB`sIoDWLPNnMEOas%qdA)Lbw?AUDVn6t=wvcRb2tsv9ZrnqaN2R+ z;dE?*-J3L;qY3`R(ey)chE4K3hlXu(C5BD*Je@igY?7ZlHiAv@RokSZ3!5Z3IW&Sz z@;rxzZIYiWGE$o~nnS}jc{GJaYLiBDY}h9IxnsjNiRQp2jfPF;KpYyjY26oAp62sz zwLxYYaCUxJrUB3A-D+0W5=tpg68}0c^+XI(%XjV;*S%@gSNy$nfFC}QXfeCReaV}8 zuMIgMg201Y8fXk#8sMwj(ttWqo`T#yW@$iODv#-Vou-x0_MxwLb+jn$qrb%+B43-< zRrd=iqIzLMPnC9GhTS%;tHznocoMp5zBH{{++$i-EjOWa%k4PZV0BBHr8YyT44SoP zma%$Dm}S;t5@wmTpQN)CYp>>%v{fa{GW4;0EqYj8En$-65hSiUam15UlA(T>v^&PF zKVO<1W|B%z)Jc=Jm#NEU8|1JjN#^>9drRh`-w{(;P&-8;YZGGiW6eXquRlDaGbOk7 z^QgTaa+mK(9`Wp*>)CcYa2b3t@Y30N;Q834Ddw6DleixrDs$d1+nDGbJ_~7Q-w%7M z*(R5Vn`Up1Pl&zcn`kwSBx1zO-WD2WZ+{s#d&|e;2ENNRchk4|y6M})Wz)BO*qOc^ zX_>w~!2ydT3HytG;4@B51g5+SO;cXKO^EX1^IB(SYcx|{g@)T?x4MP}(F?$l0w2Ah_( zoqS~4PJe`&Gqar<4Ld!WX<6H;(L~DzJN?mVJA1IL>S)oD)NHASKJBzUZ`BvmbVM$1x|Lc}D!ipVn zuRLYljusZaQTR8BtpaPR)qUo^SST15a%Ht-QlJk{6y6bzOQHp$2vQBp;xox*z5$ z3AUr#T*aZxReozfx4DQDGS{wbKexF`5#;B3q?l_d#QKBHRYq@eIGC%^FgNZnx6AiC zmnqHX`|2R;^!>S%2Kjz=oK6Ra%(p?G=Z)?t49I&ro0-3+7U|%mf1&_F!PYNFD0nIh zTS&kw(=KhZy#Fn?;fu)Q1P+sSk*s?pZ6*o*6yh+|Xp%Nth{IGHidZ|EQbJ!wqLtfc zSl=7EHq_o7ryb|z>x4`~T)-*cU^aZYn$*my#R$WRk;cJKj!i8>pqpB3oi?>t%bQv(9Z0Fgt)>>WmjF5b#L?%I$HhB} zSrmc(w5pZ{4Ndg)RDMnU^;>i9txS?I zc!w1=>y!5w%ZpL8lw`HswO%mgK7PdR3TG;JZH=aI#DYUzB)}1xO17Bf1P*tc44QMN zItnD`s7X%XfOBt`-wd5AUz_6u4N>l(A&wI?+=_H|>r1L}v{^wwBMxX#4jBz`?x3NN z0gVtc-+9lO%euc}D)bLw+HO)pt_Hi1b z?BnOQ*~itE1anQE$)$vgW8vGi#~4*zr_i_tk2-RZYw$%9D?^|O-JFqZb;fA zfAD)%kn&zm1D;wA(M?vX|41d|nvY$=#|FDHJ+ZB+8@{=qLzdttd2W8{@o79zm>%e*D!w+q5s=4sX zA20Cle2pI?Eq+M`$1ii`N22z3xAql%*J<=aaELPd0g;HuChk|0kPhvGL&W$^;t=<7 zq#qUOiRuQm7Y#Sp!N?1QHR_)K@xtAzW%IRF>P#AGt)S4o3>YHhK_dZ;Tl$)ThEsLW zQ05LAs&PTXX+3DD1qn3do}i%$05t5Lpdt4J4Y?<1$UQ+L4rnOVe)V)cGRDp6Oi-Sc(V?uW~4@}0CV>A)kA z@VEX2J{+tJt0jEmfR94Qtd{X{T)EaaKI#Hgtsn5Q!sS}u_(=Y8tsn3)<>g}E_=qL| zpV;^y*s6)(R=>dK8rU$cO35~S*QW2wb414` z#1ZkTkM!lm>%Q)_X@@{q8EqH{ zE2HfLVP#-@TySf1L6w+nH3&hZjR#d?Y9B(CnE$DboZFY~)SuzmxcukYNU791mhfy` z{vUGruV>@(|Fp}0o{h?Xo{h_Yo{h?X?Q$5NO|}DK`fODGYk$P>Y*ha1*{J;2UW(z_ zsQlMHi|Mm*`Tw8VSDI&YhyIja+r8&NcSl$^MWK_kqz`ND;%p3|SiY2?rl zc1h>B464>8t*Vz%J-ZZjcVCO2{9Nc)=L@LBl}|5+s&T32$O$QTaJ6^K*nWprbhkn^ zyBsRNrJQ4rs&bK)*kUWUIbXknO7JFL(T>GeVvDWZ=6t=zzlj(2FS-)Lo*VZbjeip_ z?C)2V${eQ@;C@wk%j=*^T2ZQ^?pKxlYH9)1RKNNT)%Oxqm8^KxewfSSx~Wy=MQfM+ zpEpY))Ak*A@NyHCA>1|L|_NXemDy{Cy>!$zvA5?=&bVdJ|S!s1wUN`;Un&T2(*gvDv!roi! zcbel8UD)5RD*IJszp9+B&-S&-zE;`SDi`bn{i@R0yjDHl?8@p+o3wa!4>`65>;%v?=rZse`zW<-FF#W*x#=z`&DJXs_a*l9hLNAbgKSq z`?_Yos_fU3w*Ue+t){Z=cl7AXq4HbGIrgY3JFCBMsRozZ^$l~r#w+@!tNQzve=oO7 zHeBO{{nM+zZ~6CfyJW*PUfAESD*IJszpCt4mHn!6!P;EElAc~kUuRXx*`zwPbopLO z+yUG2%E|uExe-{p-q)5_PWFG!fxuE$Y|G)^J*vuUtjMmllACzCst zJ9}K%zqrb7JFj1km+b6uVgH?8RjwL{+W#W2ScX?_)j-0$m*vIWW9GgrFXm3ve6}nv zeg7@#sWjaT#jW`7{%%zL-Kegyg6`|o({<`Q0gpaw;(AnTc9)(T=#MfR0)5uxrXjGD zjKp%dcMsO22b<7~VffvD_jj0%CBCA+_hu7%F$}-^?=-h1zOcV1n}Dr1|M!~P5?|PV zhqER(ge|GVx-8f0MzAh*n49H#-3aEU4*RoQuVu>q+$h$n&mwVBRG&ravq*gwso#sU zKp*I{NPYh37C_*paVWO^jvjqEFg;5-#~v)wjb>{82K%#2uIO(|z|`oT%jClT8_(3} zp3CII{yUvTx?c9@3=Gn8zOI-3IRk^VoUiL;f6l-lE$6GxBK3Qb`YckPMOq+(a3}QI z^lhBGzv?z*k(y+23%>d*xUOU8lBVB#{XhF_x2_F=rguHL&Yw%k&@6|0_h6C4`22O5 zUSBcq>$sw?QpV@6{C7ECn*ViN*dG|5zw+PZcxnFEabf?R&LUke1GJ0$V>w^f%K+_y zMOx0+^)f)aV3C&d)n}3VEK;9E>a$3F7OCHhv_Kz#MOrZ9vKV$|xxCga()IHo{X1MA z0_q03PBx@}higM%IWRp-ImaF>(si&f*Tmp#h55Nfu4wD^u`t)f;AqTSw zPiO8vojU=aK8xhqTl@7~9}m*M!}TE0XOV6i0!zuzEQfpdV38Ke=xl-gS#H;t%z2J0 z`f?GB&K6#~+%DNS$A$e1XLPpk+U0i1zBw-JztdTyYh{79z#!cY*R`@hTVRlGhwEBd zpe-;+x5L$Ek@_rBpGE4kNPQNm-;1aS>a$3F z7OCHhv_Kz#MY?V#=0>nNH|ri|k$xYpq(92+2&fzAcVJBVqs&BLIWRp-ImaF>QXTeZ zxn2Ka&NtwS{sr?>Uxt_FeFHA+=Zx-Ucxm1@;KKepokdzK8}wIlm)q%DEF1J!7^K_j zS}Ys%R~V$*>FTpceHN+DBK29M1u_WzKApMybnXOv`Ye*`YVGMWJIB%g>rx}oXOV6i z0!zuzEQfpdV3BSB8?!J*C%1AWx-sm>!Wb0BOKuF?urS7g@#5c;m0-N~qAU8p!2;Y) z*J3OBzrh0BPS;{9`oF;f+)h`Y1?aN?eHNh40`yscelN)aeW1?*^y~jy0D+rU1KajH zdi3Q`sW0UmyIFwT-Csmp30KV3UQ~tncPh%;?OIHQ_;)JG+wEFRh4^SgSC##$ zvR_s9tI7pd6nBDl+P86T{hX}2P9}86US6S4_nr>@pEnNy)pd36?9l)DJ0q}^729&S z_qD=u26#Er)y0TU9QkQv8~V z@^-xzQYn5-MR~hk3#k;prlP!EuRFb}T>1Y-?Mt6UR|m#FkFMtF>bg=t-Qwpz&+E5G z^xFbE(q7p$dXazc8{^-{tNa*l^2@)S)r)?-ptsieF`{?=;~c+iAIYtauCrckUwV`~ zFta~IFD1)PnOM6PF}dKD$}!$!>r>l>o}ctoX$E9 zvyQ{8<8;<>m~|Xx9fw)R>8#^0Yi_7n$6?m7XB~Ui@eA$8uDdpTsr`rOkL^dISK1Fn zueBeDUT@zQz0tlmdb7PLdb@p3^lp27^j>>i^g(+~^ig|t^q2O^=#%ye#}LoEom+D$ zYRhGY>_~Q*9q0M?u?c<@G#{#b-!6%`tB%9nTaJs^-rR^aIn#fA4e;bt2@qr6s=B}`3KP& z{Hyt1v^LS~--*^I%>V7^o&*ctj5a0M@J6&bxq=mcitbCU9xlHYJs^jDC3-Nqf-QfH z9!{=c&5O|=m!eWhv#SSej=A)?H{w%ty{b{ta{g-HU`=e-0 z`-5n0`~7Hr``zfC_S?~>_M6e>_MfBs+OJ0sv|o!JY`+>k+|PPq&|ro^3xFJ=cE1;iiyzx&83GA#*2`+kG1sLAh*bMOW*EzeHDBXLfxYUAZ*2 z>o3vOO2UuEFu%Qcb_@So+{=&ZNq#g(^viSG_}|h&e$UymhEd$1>xX;X;PDa0Sj)Kzhq zL!8bb4s(dZ9O5vCIGsZr<`9QD#9cWH9OB%DcGPZv60K-|9Ia}9 z7~M_muW7#*t!t}~Ctn5#8JVQ*=LZ|6u!-=%Mx>qet2=MvoHvkF}qRp5Qa$ z`kLN91)%>3&znb8{Ei>JANMK#l0NS3{BO_4U732^XXH4=*}bRZc5`@7ZdEH zTmKI^mwf)7rcrhkM(-8QDgl% z*?{YxdMjBc@ZU++*!AB{?$%iEC#y8phsg?!^>K1JQqU#%J+OtYi6vxN0&K*CVT%K7 ziib*aui^pRhzH{q2iz17;HG#0H^qZ+ivwjj76;to6t_6w7T>SI zUX25AaSB`eyZ*T-&&wt6orbREQSI_8uCVHy< zRP+qr+|RZjkDhNo8okIj_e*?pzubN>dbNFj^e2+t*V~(;KesnVZ?!i>?~v@i+g=;J z-@ZHgu)Qk!m}K`a?Ykl#d3#=3WiGm8KM8Palmxam#E;TJl20BFzif`^m#6qq+^b)n z-ID#XlIWM;@k=6yU)Br!yK;no^Xz)vj%I;yyXr~3bI;`M8pC?$px!ygo%CUy-LL%f z)csELsxZ9+dh5Aq_iGn(t4Q?cqD1z8mSE$j$z8h5Uy_xw^CO~2mVTh1YL2|0td+Iz zChKMI+r*zNepBJt9QkvynNWQrxld-lM%>EqR}{we!pq6SGX5oET;{)^kZ+AXpFFOy zo=u+ASWolmplLs;4~yo=6UlS>VtXukL16rW?<|e=us&uQ!w)5|2$Bc*3=$~!@rfi@ zHtPebUf7hp8C@;^d=FoZ8g0G4DO;!4CGTmpHOU8zc3?H%sTyr%^07u+k$e(esh&(I zgEORNCs6i(77M93AQcCs2pc1%C<3WCAQcCs2sk69_yehUGqX=#j{{VMs-aTk0#zKK zBCHLSq8zB=0972I;se1@>GJ`o;s8|~pyH#%Q0bEesNw(>A3KJMPa#944<(?A15|v2 z8!COF163TLiUU-9_ZzA>KouLRcoM34_?Ww*PaTF-@YJ9mI6M`ml>5}EZ#sMx#t%@x zK15Qk@K%_sHdfdx{He4^NhRT*@6T^ifz@M?`Zyy^vqS2=cg zF|@<0bz0%Y@UJVrN(UTY7td~Wd^JZLUlT`PO8%gUD7-Y4=M-O!g5#_5tK&-(BEgGd zCKP)@@?s_=FJ?mWVogY1%!K5{Ob9P-m*0^SYd&&f<|8L&K5}B_BPZ5;rWqxXV~Jmqd?0Rzmx$XjedCvy+ksluUE-dU%BD;0++8?V7s2*lV%^M(EFsUb z_eSz8gvt-O)dNwm247C{HS%$h86sP*{NukaeJHkNVBBoWP~B_`#Dv+F9p}xq9GfuP zQfQiOfr>HP@HNa=2`=C0{q$0u>{&Ma0BYVp|5rdB~z-%(g(q zm~GiRX13+{gxQwirr8##7_%+=i)LF+RLK)Gn#mT336m{{%O+d$b(1YnF`^qq#jFzF zcx2q(QE1pZ#HS_(C7A>zHYnmd00nZ-pol*Klo(FUgiHWMYz?4@tpOCVHGpEa22jM- z0E+k%K+*jG#cU0rh(9qOV^GZ20E*cfK+$M`BL2jLOaLXmYEZ=1n2<3jW@`XNY>f#S zgQC&Q#{^I`n)w)mVzvfQ%+>&k*c!)!K`~oHJjhex++AM~$DdKNeX?NA<{>`9ua&d; zGhZDGqB&O&v~%m3n;6GVCS0`U{^^1GZ(_m$lvm!UKz$?%gDZrNR~&2ylqqpjmRe>QTk+tHpN zm*_+}KY3w=&3&l)U?r|1Iv>5al}Gak*Yd zVBvVrO6mrsMyo`_RR%@F@y@kS2}+|(!}0E<``s}Fn%+$+?RSen`%vB)?Uh?~RV5MgoR3;8|ICY~Q;Ynf(^^xNd-&xX_d7jFRZiY- zHt=S@-2uj^<@wP%{YiB7{MWe^pHYvehForr2wqheA~~r74R3A8@U}(`FD0DeE&ptm zvtBUENx8Qvc}<}1GR;{TG|kx$5d4Hq^Kxhdt59hqnU~-9W)hH8xj@8 z{GKCyRuyC_s{FI4C_wyU@_?S;DQQ!5fZdOB77B2~;dXA*Rkc3wsYam(?!!%foT&2Sha!^WrmJc+pud2> zMjuPkT@igK#duZpzVu_iM5;bwzF(pQiI*sY;U!Ap{Sq8UD*ML}kRL)szK>(&R=1+7 z|2)sgByfy3ROd&o%)d$V_}`HhKk_wx><`n^i>9WxZ;V$`e(=jegCEBx_%}rg9@Tlj z@gDcV_#-7EH2dHJuy0V@>pq zIyTltZzWi@f#M6;FWy7X2bOJ${v>4Yjb2qLem^3)?0bNA5iEQtdQmF=Bhm9N#r{CW zCp#aDp3!JeL{BAGbK_5u+iJ9@(c~HJ+2~P?_B_Wp@PuBZu+&3-2|1t9UXJe9Xs<^1 zYP3Jm03eb4^=P9;`*XBGqrFA$Ell60cR-`P8{MtZ-j7x(2mg@DS6F;Rzd;uovCxPE z8Y=nh5k|wwF=!~a1r24+prJe(G(;r`4LK2L$caEhtOIDct^y4eb)caH8Z=ykfris- z(9me05eGCp8fa)V(9me0A%6u86BnSN(Lh6^frdr{4QJ$_q0vA?qk)D;0}YP`8X65W zl<9+p8(Ba@qv0TvzR|<^)qe6$djkypMwog!0NVG$+}{s_|DbhvwXeJgyZ=0&*3#*p z;WPIsKE;)yOT&K@P45x3J*Du{`0q#ayBFKq(SR{na0EH(KE;k|))mcfrK8 zqFnTUN9|pRBW^>&1_-KL`9Vh>|Eop?kmASw3;dF2!vCsRrc&g`zA=7@XY#*=20xCB zKTJBATlJ{!n{eOI-jrM(sz-9NTzMrjCH?!Z02Y&qq!P?Fb<>f+%=k?JEQ4IFq)n_qshw{&0fZ6dhU!S zHjB~p+!@VY#%Ox(-L^r{5ARlD+(>8Q3)a_YAYwEQ%i?LikePsnogB+Qu>Ks!X195uN3}WF`X*q)adVqA1!7LUqoW+9Xh{b}+(R)bb z(JiDEXxOz93mOHB1(hQf3of1i)?z_x)M7zxNMb?93`D{+1Cj8|KqS0oAQGM#h=gYb zBx#y~IC#xK96U1+2hR-1?=%A_c+Wr_JTnjn&kV%DYX;)rnSnU?+K@PS&p>I5W!^}jx$6bf?&C*HyOYzH zc5jWEcCQVYb}t$l?0tSmGaElbgFLkL8VA% zJgPxuHl3z8A@KA%r^ z{nlwqPPP2o^8L~Q`#zsfZ@^{@#M~$LedI6PNB+Wn@RxS^L%EA?BX{98au;qRci}d2 z7u_c2HVcOMrIdc{=pVgiU8DWa+&y2Y6M2BIZTc|vHAf>d47rtoy?hDMh@{-ac6Yd_%y^|)~ zJ(k#b#tL7?G(d*2#KxO&_gLX;9KJn_B_h;(yT|hPKYY8!ihK1jc5~t?K6>g@_k7XL ztsH=m5#K#;&-m}dlrxj=*5L&_`u4ZEl~I%$^C=|zk#Upkg@#FX5-OAI`^HSNAFrBZ zA8wjtClxcvzW;(r_I!`LNZRafx9xJmY*x=D6Q1C#7K&YNUEHer&z&@{aiD zz47>jy>Yl{nF{x@H|{Um8&6cD=u?e`GYXSr3X|BFD9}DJF7q6Z*!)1%e5EW1{lGguXFxZDEzln5ggo6Wz~ze!xUd?w~OyX8RR1 zDJB}tQDaOTQeYy1%TZ%YG<&O50TYFkqsEwMG=fH$#JQE1_-vgiQgv$wDloFf;`y`# z6)x)Kzm|afl!ECqJ{*}_J9p2eG$5z?>h;-@E$#S4veaBlJ3^Sg5~Vj%FdQyB81i)o z19wv}sLp*~J@UVdI~ocNM+0u*XxKOAXgFSVGz>Q#4Y-A)VgH5B`^UaNHHYr+Pbcp0 z%8~oW;r?x5cHDnswCIP_7jF0vyp;u+HJ?ZAiwH5r-S7ny zNBI#{jI&$$-%^K60P93bp37cJs;hj@9X03z`8{(FWrKCXg!T+vcXfU(H#od-ICXPzBV6YEJ7&Vwl;?hqaC*25G+5!Pd zTS7o;1qev300Cv>AV7X@1W+s5rA>$x0zj!e0Fc-l0BIEffL0*@r~(Xtv4FJ+A z06?`60Fdb#0CCd*5a-sk$j!UeIrW-lP3h`EQ!iT9l&&7NtSMbJfqK|7PFppDdfe33 zn#mLDfm2(nY7Oh*$My)|lACpzrvl|j3DW7rBEHJk;J z;%>Wo^`u?BIbwy5!7PZB4%pRedAoY+v|XLS?CRy%u3j(L)mx)>bq2GmR|cifHHJ~> zY)}#mlIvoSWHuQjnGJ*Fx)>za#UQz^48nEW<;Uc?*dx!y9(k_pk>_HMJQsVUvdJFF zD%c~>#U6Ps_DE%uJ(5+hN1ls4@?7kZ=gJ;Dw_Sc$j*B^RT+ET<${aZ^<{+|RP8`fZ zJ>2MC$#r?L&dOmz%tIltYA`;kF%t3t>9-eWl$&C$#@xxC|iL}!@hYt>_@ZgFT} z{BBmQN+4Ln58n#raIF_3H$5LnNmNaas(s(R&+nOZ} zTdI^_l18x9^?)S}TN(#T<6x;rv!Y>3H5!(BG%WRKmNaasM#EB%W=X@AYBWh2!BUsl zmNaasM#EB#W=m7CLhE8PrB3T*wQe>OE3}@rQ>;*q-zipTabYG_Xwjh-A7)~O7A1Cy z668|3|Dq^i+Wi!WPWdvutU_FJs75fi;|VMPYbTe+bOnwo;SAefBEEzyBV|Kx)>)J%&T^|Pt0$9HFq(MX z5+w?RMDi0GqR^y>YW5}ux647$Nil|}q7by1W&@4x{<_H|tV(_$`Qc(^lL~4o7goi| z!nty@No|YB^E~hK0nG*okdnq8udOQa!PjVf?|aU7PWL(IdEfJ5wqo@v9hvv3C9!&# zbDH*zVPxOaZQ1w4qG&x>sc5}wSN2_Q$-ZB?MEfR1Cswc8m3>b&W#5NuvTuwgR&yChrz_^Rl73pa$Dy8+5*j+9wAb%+7+oc)g-A0J9#|S zD<;oDg33lk*hx_Og9y7IsM1}Tw*;k;im?lVGS`%OOHi_J5LE1&2s;T%8-<{>QJHrT z6loF#$aeriTFAR%E2ILbc>*{^?qV* z(AKvj=4k8v#N42*Z%53bw)s$DbFvan`r~PT;s3i#W>AyfX*K?Zb^55EjT*%_(R;u~ zq1sInVx2fyYZi8;Qks?6gQb&S=1QX4izE*ibbg+jV&aO}gT@yuY zLF0tT0}LkepgSk>pfxS>pnf!v2j@pc9$U8=^NU^a?ENnW_F0nsv9&KY2%dNY_z>?g;qak?2H6ls;+nu8n#kJF56;icB zWEJqFo_U0+gU!YHrC;Aw7inS|piiOwY6c|lT z(LE=pXqDv@^&`P4&Oa-s=v3tt&C+fz>8!m(pTKBOKfsM*@r<0JF)62jCgc>|Ih;p& zC4w#xT0<9LMx+bG-P8r6@CJ5}1Z994kuu1QKp70*p$u{(R0gRuD1%-FWzegj40#ol zL9c=`=v7b#QwAslP9e6_g>bf->M$QU=`$%Ai|88FVWugKh<7(5;{hx)qcm zw}LY0R!|1r3d&#_4`slsqzt+hltH(GGU!%NhTN(0)xF&)_z#nb%jBCxrMR-YxU$3SXKWlJB&;$icFYpi%h^bzsQ9A z1(6A-mP960IwBMBJuWiga7|>w6c(#sDOELa35ayWB^+N6mr!ntOF*7LF5zuVbQgQ< zOe~5_sKg=@kYk8UICN2D!s#WE37B+IlP)46(WDtxu-NZOGyGAtUz1jBq-wt=%~(d& zeob0o6(-G4MAd#xn)g$&KTMiYy^8&sv_gIs`#ounhDo!ctZILlG^qep`!#9CQKLxL{>v@Y$T%9!pLUjEE0TC8h9wa<8Bi&R*^%rO5f96geN1 z5(TAj_V6z%g(q^S5;l#??vge=JF#hlKFJI^Y16ZlPck!4I$I6W+v`4=npi75`jmar zpTVf%hnHyBhc3#nPcQYq8tGNC^n7(Y))D3GDZ38``m`3+I1P7TCgk!i3;iw zq0!1o{M647y^8CWI-_u33i2#m*GcL0FS`FRt{ZRQpEyuDx4)g1>+5#ajoTds_jt=( zdbNWhdKxE5^k6>shv+aTqNo07Q}w%kOhiv>nnVv`Ja$My5cXqL zzZ-9``i)tBl+i21R`t7fP}T3oNmjox*e65an^X0>{)&j6))^8#_$51}a4=QB89{HF zxdsO%JEm{$b&PLaJYqUj3M?vt5yOcIRZBurXO@;|*D7ToDb4 zf`e$t+KaNzrIWJGPE|A{Qf_fG^;cz`tuwOD&N*2pq?C2mkI6dQ6s&f18nROr4T-_T&D38NH`6*pZU)}-4W^CIfw-CaF>y1kX>v30 zo?m6YiNVOtG~O64N*TogWys*63>rL?L4&6Lm4!9DuY=XltF`sGDt~M86rL? z!E6u8ASFpEJD%oCvurj1kvvq&g|IVF_A3=_&=!bxQy{e&_iDI+SRZr;X= zwxcI^@}lkNN#=FT?-F{Fc^~sX(mq(y@<3tj?NqA_%RN_k^m0l+7xgn9B3_U5Ge|1E z`_aqTrCmUZ^n|y*oF<#|GPk}U%*T(~`tmwArC_bp9k4^=HN5qQZ}CsHm1f)feHOcl z3rKaafC_Ie_Lxeb1Hj8jEU@lRc?OmNGVMU-^g5CdBvP2hE-o2VVg;UuDGOF`F@eE? zF6A@M$-wh4*}>wkail)jZ;ffG4nBiy4zcZNq)DITXrExS1B|9RcqL{X9HV`PNg_tm zB$3)Y!5|Uwm?p`-jF_aj6KzA%BpGUAl3GKBNjj0j(nC!$WLa2Y6($*SFiNsh%Dc9)gk9mbedbrJI5Xc$ zwt|pd;YupTfZPhgn2@`)nYShEO5q+X#P}(UM)wv zmkN>+)Gbagk$r&;e32_8F`C#HrZdR+CXn190mNuuWd{R{Ci;b`5ZFZ~Mp$}=(L}#6 zZ36wmBr2qt8w!b_5E?2hTndqyiiDIxXr?3~VWzV1pb+LcWNAS0k%PP`g~&{`tx5`E zz66EHOra1t1r)-uWZ_bXMiU7sg>W>oG#E`59u&gS#L`G1bP6a$qlu-FLO2=}qS2rb zjV78#3JIAa*2)Eiggo-zkX62|6mvr%1KzY9SGkinZO2t|y<@Vmid-doDI^=KnAs&8 ztH9sfzm~%OO+0^mxNZ=Oc=EXZgD$pG@=@d0deqZxJ?e=?GHtiKM;a4JrT0){B&lwB z&#ePL`sB`8SVABr_%5?Flqk`AN5G=Gey6Is{?f^>aVLE3MV9p$>SVd#EUu`o z-*`iHeMBm%>v!i=*KZ?6M37WJrn)|29M$zZ=Tz5ko%sZJ>epXYSs#O`tlz1stlv2K zVYV`@9b{FXxyJ{&lrFBQtlv1HvOWe=S-(4{vVLn?W&QfmP}V;`sp=ecgeQ1Nr zkDv`jt`2W=?dn^s*P+E6kGZ6vv2&;}MhTHddfz!sefi7?+&_2Kk z71w?r%Y;&mC)jkf_5yu~%+GhYp0Zt$6D^*Q6M>776Lsh0M6GE#QT=FeqVvzniI^_I zY?`GnvJpk?CHfEy?wQYVy=OclCu&RvC%X88oQO%;CzX}Zi54O`5eAbJb&<|7pDD|U z>PLbToqtwN#6%DxL=b^VMRAyG#~=eNUotTNfDAN!$Pki~=VbbjL7B_6Odm4H^dUo% zJtn{mx z&uIBOyrF9OLHrO|E6PSKpW;V@^?R;VOWN!Y?uOZ^e$N$h$!?fIPHnJ$&uBI|nPRG<{5RtXWs}maXA01 z%INi@B6(WVYJ=aMWA8BrEh?igp7?07Z$z%0!HAJMI$%Ub;Ef`S)d=by)DCtG$!Hxz zGIqz12<1^QejoR~b4W%z7?SJ^h6Fog*DD5kD)DNI7Fu8lHZ(}hddjN20V^|(YPLJyzp?j`^^h!c*-r^cb=$ZtI3Z52jkTai5HXlolN!3Ge*o5)WebXUhNm8IERiO)Ln2L@XGof0ES`G6 zu|%5GkBT&DO_MaiSl>k-fD6xoGodz$ecD)G9T~JiOXSkYppEr)l|dV{L@v6tHke~_ zNoLRnEs@JLtqsQL&;~6L+CTtLZK&A;w4r67M@5@J8;Ja=jrA3yNNu1E=Eu+m(`9Od z*)z1kgrZR-Z9;W~?gGzDv#^F|9W@oYwa9e+J^9VQR^8d>yX6xpN zlz4MSGHeazn={T~F&nKIcCR0e#iO!xbH@F+IU9Z9=1K}QbELXF%dMYfVY97%mW9o> z5|)K$#1-zloLYMxibJ>sZESETm@uxjon*^KbX#&B{o2+2f_CquvEAvrcv_q82NS&gS5kFqED(_(I@2==@X2$mnX?#G|?wB z9nmMJ(c~Ma&W&CCG7q7Hd5J!$#H3F!+SkaQV6?CE{5n{G=o9u5N4xdH!nfId9iyqH z&c5TJGyA$iA}9oggU1mCg^+0wK^PRmz*zK&6vCic78ex4kXrN!86DfpU$wUwag>W>{CsGJUgF@sGqEDm{x&-Nypb)u)ws1)y91RN5 zXi$h;g1cPc5>N<7gF@sIPzXnZLe!OgT_Ia|$#z^My@bcZC0rzrjk_He$=2me445F0 zJ>hY5Y)hB0Cp@l>ZRyCK@EAL`r2~6%Um=Au*q{d@<=gCmJM-6w(f;^KA$^>7hFi+c z%IH-Bn(p|5Xgb_jG#z_*Am3z157-&|d%(^xfLJN z?c(cbtdfkSr>;k+v1nsrz`|I34tj(di%(sTFpNbT(-YKKv@t!wFcv=u`2_pN8c_0f z6jh&+)0f|Uo|Q023EpYm@($mJm?|9pqq9WbO4^zAZNtDml1;WKb2>ZBn2u1&TBno8H?UF?@ zzMYoP%!ot4?X7V;1Jg8YEajAH*Sn)9EBQz)^#xr8CVG^iNY4eXR+4ygw+1d8HbG~qf&UJYwq zND0)Bh!OyeBT9fR7En%S!-ZXZXk-M)pnW}Q&HyH<@rEb?L~f!4*vJ8~aBEtW0GmAE za|8^UD1i=IK!8bVo%sw8SgXHEMgT^DZV|{o*gOK1Km)BLK8wK)k`W+-_7Sz6sE871 zoDd~|!9)qLMFotiH7%p69}PxzepE))smiFDXC7id^x7fX6tj~d8dW?)qgrdIQR1x{ ziJ%b>3|##aG(v)b8eyc)o(n-ENk4|9J%hV71dWhjphlPvu(LzZNYeGe8X>^|jgVV| zM$|9jRq_kc2y+m2lL#77r-_3k7^D$qFL6Z-12jU0ff`|^!=4pEBlHVsL~F^Q5&8u* z!i8qg2peHQBXA38gnj{ykXvgM#jV|{5_~^}vv0_+4H6cpS*a5Q6NjA$3)IW7R^}5* zNVqT(l|$w8Trims7PoUm_M2y&fc1jH&;$-Gx&kKur>KkS!{)tc?U;OaeTFwL;^t4l zHQE)q#^MRN2GUfy23s<~5L(l6jr!5x8t0#tYjmn&%bKNMVJr69OY{sX`b%_;ct)<# zm<+CQ@ddd?cTTR+u6zcEA6%))Dz0`?&M*knu%cKi(19n z&rYEcJiAgWC-7jMOdUtU}G#oiwyx+p#2VqYufKH)x=++-=qIZ z3OdA{o3~Qsw6;=x2)ve3? z&tJet>znI`QQrlz_HN7kgp<1yuU4#47z`G?o6@%owHr(`d(l(*I0HrGLczD*caNQt7|k zLgLNQWHX52WithIeSpod2Lu>2Sd?rA3Sq-JX#__i>FGivQP2oOLT!+dMzs2gq?$Ft zdVC-Zs1aotV%4M(F5(hlAdQGk5MdyV(A=OAhM3TZ*aYzf(g@iE@dZI6ViTYdvI)=# zgG&(xK_g5!L>NdT3`<2A1dT9g6=5Kaa5QK{d4~K!8etM5QY~mC>PaJX7T8EsxHpx0 zrz``v)^oul7e3xC%fK!DECDdd+2n`VrdxP8br;kyE%}{0Cl55%X!I0(*2q)Xi2xiK z`w~1rQXyhoz(Zc{789N$)Bg5cy6dDcIrqPXpr^NCUJVtrS^JtX-lI%@1PJpMd zjRH6_xRE?%98DI$HM8Xc`p2^Y!^V_CI|QVSni4GwQ{uChrG_cdj%BHulI)n4>M7BV zgQ;>#vSXR5rbIiIscK5HW0|U^#L+M%j>airIm=pTOGqM?eax9Sa{1j(jMSj5uz&hr zIi~4--PFx1=aHY@rsdUxIN!l-NWh-`N=VPA6-AL6?6elZ~Z*yB(4nMo5&NM^a{Fw=e~Z5qw$;`jwbSi zXT*M-Gt{vt-E-^$#?eHcEWD;8qj}cs2RRjX0b>lN0(fImXGX^}JQjuVnhM~xm&Bel zOFA=}$J-8RFcrY-N5q~$9mSj7b59hdj$)rWXc4S_v@h^%7N`U9s?@>KJ=B5HJqF|1EK&zc_fQAf6Q~312?pcQEEG+p zd#Ho#3Dgl$9g)<51A9tuSHngyoH^; z*pK}sttljVf_%A& z+igwDcDr-3U6{LUckzU5m#4*o>Vk89i^hw=WV}3D7Eg-@&GPYryy5KVSv;Wtv?OOo zTjK0!OO2vz3DZ-xq!?AeF_genOZvq`UH_4%9M!vU>_R` z;L!sL*Bc~CU!yKjR9kkfyR$}JE!?>8cJHR|7mT%CNTEFX0QR1of(j^1@t;8$(I?Yw zkzW&wJjjP#=0u-VyP{9ZEz&2L2@moCuW?26$xKJw*Hn}A34$qh{Nge+ZF#D6NS`1m z{wUZJw6$W#FKSNg$#k3S34$n|aSHPs%N_Cm4+9_;4^)wX0pRCsR$bCm4(! zzc`qx+LaEg+8FE`JYpq(fgQg%n5x>-ZC1507?1JcV619ayM6kIpbt?Ek4M%AV|?*- z(g(sm>4Q<5_&Vu>ZN7MvkM+S!LhOn3!Qhfd`B)#wL8uQV3D8Fr^r3tk`ru$BPl7%) zn8*|91Gx?L!NGWvkM+Tsh&+)#I2ap)SsxsXmG__z4#tCgtPc*x%6rg<24m&@7Jc-Y zezK2iCx($-!}_@shNH*r1w1}EIfJ*Z8AJ4vmjzObW< z4YI)Mt+%zyBE{X=WpzKLFUTNaE=z@7m6S$Mf63xDMjEu7Cq{NPMS7CzOKg^yj7 zg@f#qg;!!(_^BoFgP7XqXyPzbnfP>DCO)w!f)G;_aZ~Ne#LF$2_$!xa;v7xH%}hro zKGl?ok6o0BW6Ct~zB$ue#Nlbqv?W@h=S;(u6>82*k9nRH2})U^=1f}>g%{>5W5S$i zOfo~wS$VPuAkCSUD>KxbHJS(@&6#Oc={w`b`GD08Wm-d&JU8wWdeH|U#JL4{l{?7ouHfZ`*-35k#B zo)aI@DvOV(9|?TKTR#vV(W#1$XqNUMV*oQkIs$>h)9)uA5zmN^XiSQaK;9-kqB|!( zqFoUmQ9mX=0)vT<=$;eF)hZW@*f+}arjlu`EwDQsqUIm{5;+0PiktvuMNR;-5+{IJ zkrTkIxZeh|V)I|j3Y36mMNR;-A}4@ZkrUvo$O&Lpt zLF>%tkypY>$Q}=FL0@G0oABH8MV5y|tDznY9wc@1JUDx(0=!1xs*ipTa`ty( z{3hR5#QSLG-8q?gYg%SrKN`&Z{IfE19x{w)$|HyIClUVyW`IAT8Q@Q72KW=10se$$ zz_WP6pP+p8)V5ms^k%9Cb#=`4-BT;%7eQDc?Gj;ed_jaoxh=v1gOIS`Fz5|HIzx;_ zB^G0Ws;?M}v5R6XPB+C^%yh(9pm;CFV*HXAi*gG*8{;$)76_zBSQHjXK%y&e7@Y-P zkpmhX0gXl%b%4=H9bj})2Vw`p=!}iT4rp}7O=1Va=%fzBmT7cGTq4UfI@j=#f@BcG zE(bep85k_)GYRE-Kkk$vomd!xLFr5w#Ey6}h{|AGr`Gv0M1Z*7e)reg@2bR)L7_(s zvcc!Q10&(W56eQT0K$+epg7of&U{W>L8T+E078i?I9wA~FxAA@ARn@*0!&6!!SMxA z1!eS2#(o-zNUDHUdo<`~4j8zCSX==fszj@M+PQ%&q` zLL}|ciB~AmDjaFjWC`OZwj$M?Eo^HxUd6qENFv5gr zqvMyL5gZP#r%O^TXhgXwG{PucRE0F6pcxur_9v=B8lmBdsR$aOnTx5AM#N)~sjxUGfR^ zk*80{>?<9aJ$$17UVI$5ml84Ai|)lNP1F{wiS|PO!o6rsxEG(V4954mg0&z|XwBkQ zlvJYW_bMs*3%k#QH&Zt+zlGvpI7;Xg$^rd-=R}H>@nV;K=McQ($Dj4dM9*W4a5B*h z#zahu>oB{MkKrUDPx$THi{xaMPKn6sR7GSVU==4*KO#=1RVF8cxwH8fXD?2s9+8tl zY^{S?x^ry)#iT`)OktL4d zIX3^|U@B|ZkBO3LS9CB-caF`!IGD=XjY*wUAJ6b$77nJecI`z`GD{~P!>L0X(vot4 zv?SvoE#g5=K$HulCFKHX89PE+M3Rygl*?NEQ7|qPmU$b5MF=WkNw`2*5H1uJ;i`ls z;R0bvxIkEjwh$J9u7oAw0%1wGKv)LF5Edb_gk_N&!jf=-un`srL0AOW5|%}B2#X>) z2IHwM5|%}B2us2R!bXLMP+s1|Co-VK$GV!~kxya3iBEDh!{eSU2Bd7`mGCJHSo`@D zd~Knx(gvS`Zz^p@Vf~zea6g{{C7LFb&27n%Y~>NRpAq?ves^``Vm=ot1Rp8o|ARMMrGX#k*vF2k#%?HWZke)S$AVn z)*a7?aKvCDZE7#cx|=0gcc&`C5y$n2w5cDFb+^j0?(R8RHwKe+FGRBLc7=o^Y=p-S z(MH7C!0n6B83;!TNm@0Y5syeA$srY6wZIhLE&s3JI%T zTlhGQ8Zy$TAtQ~NGSa9aBaIp|l0~G9WPTtcjT$o2s39Ya8o&I3m>43?3--ZX1W`euoBH+TB&-Fnk>#9{n1&XJhBf zEV!FDmzdz>FR)=4*XxVBsl?=N5Yq9u7Dk~DAqssPF|f#+a+~B0!a*L_!r)!xO|>iX zW~!;aOeGD2E$KX;#gZ}P5e*~BxS5@uzbqNUQx?F3WEu^UX*BULl8mGA_#sQi zxC@eTG#$_)$uydtSs$OmrCIEYM?NJvg@t|bxMPdaCp&p@FG_L>3;W`6FADjTUqXS9 zeeqcSPEKJ-_!LIH$zGJ?6c$t)Z%-Hw8u=}BCQ9*mkoXwi*eQlbi0gNBzq{z$_>;@v zSvrLW3*6CF?aHjDnlkIdHJLS{R8f+Zj;#94C0TX;f~*?0DXX4t%c>_9MM;9Z+e5R4 zNHXhkTV{QHL7XH66Jt~D%B-iFGV8-NnKeceV^itKs^46aRp&3rsxg|Zdb%yEo>&wo ziCptnXx11_j7_;MQu6qMNJ)$)#-`d8V>8txV*~399=2BATxZU&7OT#Xkn&WxgUHB|OcSClk?pMg2&4ny)Nh!YjRm@ElEsFX1_w3_l3Z z)Ix?Y;gwcGc#S6NN5XS7F_1xc$|mYZ!qYVegvV!fzl(5%@twLzKjlal;Sm7axd@xx zal6*7lp~|hzp%t4VTlsfD8c0QpHoCI;B#cqPYvJm$aXi*kwGkg>;A4%B0e0d@X$m`GbAB^Up@0x_OFX)#0WGd10!(pc`*XrIWYq5 ziWq@~NQ?j?95Djjb7BNqWibNvBY_ck>jz>4I#n?O&CGoEV+=7N8VdUojg@_f#v}`(v9eFmSlNeYtn5QHW@iwMm3@lF%05J6Wgnt3uY+hT z>{B!r_Hkwt$*~|BgE{6b$zGVdE!s0zO7_Csanb&vD@eFe+o@?!-cPhAk4+yNZ@{v^ zYrwMlO8KNg(RYC6CX?nqvHB~w+F(Pw*bd^wz;MO79q63Rw+qaGZdb*fcGz~tWndWD zj2RXyJvdRsyq_rcQY;~G3tC(ei_myOECQx47NI*Q7NIr$O)QVZ^9inTepIf}IVaa> zoyl@xW&IU;2A|It*p;qRm1{Ikeh&RCzyZ-SDAuRB1ud?~H5w=68W>Ej(VdfPw5H`6 z^`pTx&X3A9I#szw^UMcXpQs(8XV8$}SA_k4^ zLdjqvqTErCn^XwoW+DQ)Nrg~uQX!BVISY7_Z!&{{+;SVpO}ByEbQ{Rc+y`>QYa}<_ z268j`huqAXAUE7ba?@`hH~j{3({Cs@{RVQ=Zy-1Q26D@9AUFL6a?@`hH@01d@wN16iI+Pi6l6_Ad;Zm7D<3GjwAsK=AYz_f{Dez62xK&5Cw@P$X^gk@aB?O zf=Wj$0n#Y31miWa1XE3XgmE;H1Q<;u!SMx=1m(6!0u;7=9(#1d3uu>=^6 zEP=!*;y@XR!Ke*lFsf2zKZwDYOO<_zp@58)eT%{9FqHNwhC)Y`_9X`E{wnQD3}rDY z?Mn=f1~E7q#83dK%D%*4DyGVQ5JR~W#9-YYVlc5%Xwk_GCPh-k@#?}#{4+@K-52o9q4?qZzH6tN_Lu*Mc$RR2n zIRvr|ImF?b9Ac^oE}S=%Kfui7562he59PM}0p3D?pqb&sTzZQfV!ADdfY@?~`~^A0 zn@e(tN=FU>Z;?Zc*W?gWO|bSHP5yw<+(8b9Nlvn@ zDB*B!=X$I!BwNr}ci4_C8+1L^HIgl8x3Jb|rM-qv>cSxYJft(bkMrw$gLC1jEsc}- zr=JnJi&Ij5*lC<3v4a`#R2N1dB6jMpir8tL(Wx$- zbL>xsSYuSB@A@$jJFRJ*>e8KKe=-IlDt$NJVCft4;;AlRAzo1FyLM2e@5V`%zA+e2 zb>Uzteb-+VvC}&9x#BIeBq4)YGXB6U8I53;3{E&p5;B-2Ll?}FfedEJxQ4T2n1fj| z=)o)*0%4Ynh&W3INSGzVCCn1RlV-`{HD;;M>LiQToF(Hf&XQpmX33xovy8YGV}nRx zOv2bCAyOE#^b;v?ZZvTTL<(H`79s^+yuLAoF;d|kd|t~Mkig*a>Ika7!-Ov8X)=9B zQ1x+lTiFqr#ZDiy$P=ylZuc(ECK|<^ZgW6Z;eM1g5}N_<(59gZ+B8%_n}#ZA(^Lg*8mgd8Llq<$ zsS5HjPz7xos-R6n6=WHy3i2^f1#KFtpiM&+v}vk>HVswKrlAVjG*m&GrYdODPz7xo zsvyfqRgjQ@Dwvc&6--f}3bKq;1qm6bg6RxY!Q=+2K&m5Ekdc8ZmLvLr)UNlNPN$$9UhYvQZ!6nn8aX>)BQJb6&wx%(xe0Z zSa|e%Dg8q18Ga@948JTw&G;p$wN6#M6MsqG3BQcOFQJKk9tdy8u4vf6-}{e-lV)ia)SjPIT3f+~M zg>J;mJn)5~*={Z>!neCB-Q_kb-3T;z;tRt%Rl2KP@i*lb`5VMMJn)49p$gqI9q~7( zmvrFE*hO|MNC7qyPmIV%W~&bC{5#BTPsO=0v+_LX3QP;)*B4 zNJX@ZCd43&2d;QR4AEG8#%MZlMH7nFCxpk(_I3;&NR}{|=qF1U=O<(dm+bVDC0tt9 zPnIx8i@U~`vybNZ5C>L+txL;onFYWajzr>1mUys5a z?uTc4yZhO!zxO9wN z+0a(#{^P0LT=|AsZrM#TIol1~7mg5mlKc279ofO@CE3Bt7i9-{FtUS6EIZirXXL4* zE&Ula%p-mz{rCXKEEf8hksU}lsMK?x52{^$G}^?ht(#@B5q zoS!M+Sl;lO=#1{1=!{nX>*NBubK(NR>+6f^AH}-i6bd=@O{?fp*m>`GsHIc9-5vGi z+t>=V9S^mBJ5vgU2T~NI2tib^N5cpPtDUL}_RZ3Fu+JOvuwIWy@0ooJbK@Bm>>HCR z*n@3R!M;1Ef_=N9g8f3If<1yw73{m`RIqQARj{ugQNbR3n+o>K`VfgOo%*FBbFCLy zug73d|Dy8685QgslPcI_Fcs{XTO!_VS5&ZP-l+udM=IDeD`oaqewgc+n6V}atn*pK z*h|Q6nMJ;+XO94vR90NEIwGorb$qCU0V~wO@D=Jn2uF1=wxv24>Ovh1e4!53@u?2h z@u3a|$xsJE=CuX3i(}~h1(xxl4P}gFmGPmCkWT*K(@Az2w4u!NMON{p4dtaXD&s>N zN?M_fB!>;!Nb*~2BguY)Hj>OZNtB&82W=>)eo^cfv_bZ3T^sl~e?oCF<70-fjF;I) zn(^~i?AT7leXbZ}!pkLAcT?P__hI`HN~lkvY>{G`vK4)`4I4&kSd8quX2a0acz24K z9Nk7)opU_c2{XQs^vG?_BOP>h7!oA3R0p#|ub~lrh5h81S0c4)Aj@Q;b&y^|X6Ki= zDU2B@ld=JF+`==wMz)R+e_heD8Lo(xBb>8+LsG9=@FM`KWCz_|}H0 z-1*@w@1j=!+5!eGw_(YMcJVJt*BE+Yy$xKL${p0|Z~k~*Rr%K!Rh8$eK~&}O=c>w& zT~t;6bW>INnU1RR$k0@kAHSrke7S{2jjVaAD39DuMft*_it^KK73EQ~XHlMc;a-N_ zr<}MS05o0cMsHi>k^` zBhN(IiRr5%KBlo6pfh-&guhT?nH{XPPG89XyC@*EOVy~jSl%cFbMR_TMDF>7h zNf}YFjOfW7tMUw|@3bn4|@f-H0vxr1bpv(OzZ3!MeB&{^aUK^8iT{6VtthH{4>3!R0}W#X>wm`m_@ zdKih_L3U}-j#L{9{n_4{%(YrI?A{K0xv|y>yO`Jac_S3$wr|iP+ystQQrr^GjsoYORW+R( z#zBj4`}p7hJm;QY@+wke02ZmaGdhg0zHK^;z|a#Ta2*zRSbGE(sk#3;j1Uzb`5qo+ z(#Vc{3GD9{zJ!f~lZ_`ZG&HgAVsdwUq|Z*rmfYnDL7Q&J2WF0L%LgVhBs?&@6C0#c zH!nO_xbHZQkgyzBYsO=N7T31n2%gq9aV6AVkC2_|3A1Y%ZdA}mb&v1kxzf@vEx!7PrNAPoXdFcfYSNrO-o z>#H9THbWH*qM-`J)Ko>-3qL9vgj?f-D!gkxr~-!q-Q2+)`dJXVLq7|Gk6M(QGg?AL z`jCwTxU`DVFg{Wh9WzR1w2YuaYZ{roF^fYSp{y=pK@d71`i7z6voP?4cq;txIi?RE z*)l$+m`M1uY$v|?KYqE8?xu7%*%R(3d#WE3uhyC-uLi}-pm1LqRO5sUDz1oE17|E= zt#(ib)i^1GVyOa|I!K!0O%0+2g2=GBZVrR+QDG21Dh!gO=FHSFh!Xb`dQ=!h=??}` zl7CQ-3WFpCfG|iD20@;)y+)ZIZ^0|2yV$b}*YE48w$Y+(j0@56JqVp@%a8g;p@BAu zA9f$WU$QNkwrgKu^_^Rlu}EtQTe;CiQX{>+2V<=#45NI?6KO#Z6Rt7X$xuwT2eo2o3VUtLZ8LT-%u5%h| z+0bcX>>|#&5hW%Pq!NooJB3wn2=XwikFse61``P~jg?Nn#C8&*(J-1w5UvA4Hdbzt z1i`cAfh^#=u%ZwP3}>*O3M2^E>0$BV*hTjBqVys`DlthAJYF8i!qL95zU|w)z|jd| z0(-&{{6ZHheoMRS+K8x)C}@KlGRS}gZHSK(hbL{2EPyr`HOiKPHfVlgK%@;OXFT ziUTk}Bp5P4rpqwE!h%>h*sNGMrq<}7!9*Jd$g~><2%8Z3!lWGb#}pm*$AlgB2b+-n z>ErPPQhSfj=Z5ilYLhrGSjk>?nF!<4CiTcQzN|!~m&T`+=#guDal~SAG(PAujvopJ zc;aDvj)o`RH-6uSxWQ+%9Yf`3l>Xk&AK9}LnUjz}3GVd%zhuAHDjHUc2hP~Jb+d!2 z&l{A|G%6GQgwVfRNMAwQNXEy%K)NEHAziW7-~l(>NkF!OH%ybRXk(2N=!(S?qAS2u zX@3FNLm{1OO^dFm9}RTH`DaO2bo%elxEJ?l6x_hlY!84KSp#t85C$LvfB_IsBl>yn z!DN+D7=R1_1|a8!WRMI%7=Wv7xbL577~@Z_#$jK8!KL@>)%iz2Dc$!J=@RJUU2|c5 zo2YoZ_m~Ugei-l_e9)V=*A(uXpddvE@&x-DqZv9f7(UHk`oe<4zpAH+&gvOkiwb-aWhw|Z*SNgv0=~sGVg}vZPRiBWPoyl^P_SCtaT&R)jIPSPXw;N zLLZ<-e1luMI#oGAddm4wh(I7>Cxyad1ZU#)hTAr^c=% z38%@Y#;bYytTI--&Ul2m#&6%jXb@>rP|~L{#@1WF}40@bp94T?dH=zDWJbupE#=SbKM-8 zbaPD;iu({s#eFUT!yXo{e@fPeVQ0P8iy?63YAMiVTsxJlE%Q<{XNJAF^mOX@v<6 zw4z0Aq6wrG8lh+c#Mo@+WvzrYWava8t$2Z%*PC(m8MVR`Ogur*N?54|+DuyEXrc*% zR+!p}CXiN?i9svM%%Bw}YS0QsqgIr~K`SH?M4L$~yrH}#XoVz#yhK`&50N&rR_H@= z6KW+2TEUS@p(hy^lqEgM2KTcJGG~K~0~fNfe+E;#?HC8TBp1kWp&V-{gZo+5nX@5m zC3|=xxa1v>!|%jTKaB;$>m$fZ*t7#)Qt8M`K)=dM#%uDDspdW|o~zOvx&=|b|7N-QtIXP>;}<%{x?(^%Mf>kRlQh8ggA%Ob-JU_hJ!>sOco zpSKJW&l@w~vPH~*<|^VU%s}Rf8PHs1k(zIma9H0*$RvFj&wbdP)c<;K;Wcst2x#srZu$*t<@`-lc(jW|pC_Rd?q7pF zAUN6S*q%AnZlBv28P~`|P-jF|f>-;Rzy%^|%Z6NiyvBQYKP-$qS3tY{TZHN193X0< zQ{@3bsOvr}mZW}EEJU> zAVw0RNop^NCTW&PlVCKSp~BHblhlujCTUIU5EUNo_+gDEnq=WMmbLLfc!&y>`6a|W zRHy3NjY-zEF&a-%;b^LB*Ip7)(kziE!Du{0g`=siT|Y{qq&1CGRHzS}0o3O)<@p%28mFfy@m&O+T&UVK4h3G@N7g!%~0$Da{d z0(~IBM!-+9g!<4?rqBn;66k|u3G~5JTX^84^+B=(`alJq`e6G9>I1Qv^uZE5^Z~Yn z`p_|#&a6gge+l4uY@e&fiL}J3BFww7A9oLgXj>`PnN)5Q)}q;0yV7r zLf-*CKY3xpx3(mCOYpitB;NkWuD<(i_Ej*8KY5|B`+F(PK}HQnkWnw9K{y^_8|}iu z{UQF&(5hjYwCc6Sr^)@rGvfYWnd1Ixhh)^vl8m}jl~Kbo#nsf0%BI=Q9M7you=tKUTOb*kf$zi%A z=r~;+%8KdI<}h8@9HtwE=^~%J)r7X=+jcUces%~U2l7ZfKAah}mP-8;{}%Ocq<`^J z;enfMunaTFlSIKcC4Ri6XBMsl>4CK!_|C(d@CBH>xaAQ*?@0?Td7zu*y3O!Po~=>PcRryMd4tdPJL8~nb?zZ zTgTZSU*M@I98JaRYFF&ZR8yy-9Io+H6!vpd@w(E{arSR6=~R^b1@_qDXewS$<8an{ zIojjsF^#NmLlul)!JJ4H3O+=gNEM7kMZ*PEFsc!CB2_S`fhrV|i#m}i7yywv393*u z3{@~#B6Si}!E}%vx2y`5#>t!nRVWIEDijrqI*}?k8V_5sDmWFWf}`oM6{$k&&s0a3 zDma=BTahX>n(F9M1xJG_qFYn}`zMdc^L~`}+nIiyW^JPTK!CA0~fZ!yLu zZIYb#!&N^l$@9FQe%gfR{V;mtrV-L6Jntu=P1e?qr?R*6t`?r&mXzY*KK7QIO*Wjh zkMSI26uA(q|90}=&CXibg&C1(l)+D+H9Y7-7>4LVcEHA_yK+kg|H>sAJjpJxg)``# z4YrVne!}1n<5W@@JbXlK4G#zfTX+h`g?@55om2PREZ$l7U3fi=tdBMwkcJLSQu=v^)mG?*AZiNL|g z@C6aVajl66efGBHYtl{T?;#zLs4_ zNj&tQzJa1u?GRslYlC*0#5F=E{ENs0RkqN;?lr!8;r6r>%e?E{%gxJwSlInkN`s4E zXibY>s2>gd!ue;#FR-&V3hK>LhQ~G54v}8qR6d&YH6-Xe0~+DqgY`sc~QKjz88Kjx{z zKjz88KbvBQd8%RdA=dphPZs{!PCLv~g@4Qwg@4VHv=}>ahk3H{&v~-)k9o54k9o54 zk9n%{k9o54&vxHoo{{Fs!he`2^Ms^t)nM_SO|g@$EiB%%tMKi}vrWbO-4n=sQFQqU z9``$IVz?Dy78tI+o``weexoO%NCL1jcu~7!0!i?yta0FWfiU9{Nt+2X*xmZkGB+=u zFWiH$_5O(>WC^{c!5Oj7bkcSjWqo#`et?fg^Z`3myO}fT1NN^*S)bjkQPyW~Yqf#S zi9TTGYn1huPJRJdIOri#Xk={ma;FS?X2W*aK^vqIIw;7-yXdbC+hMnD*m(VzY#dU{ z#yeGUXst6JLX`mYkW3u(kW8FCykmWkJo%ES|uL{LfSMIBT^8Vw|tm=1QW4k`iD!G_k>2#F4MyAB#5(ZNpG)(D9X z_Q?(!Q4j4G$)ZUk^d@%L4jQ31Q6uywXoTLx-rPYW^d@SA-UN-%o1hW3_+NcGEBY&w3gn2^N_A=5});jPyCEpgdtjkJnP$zuzS7maEf%qOhE#xIGED7Txa8q=| zVe|t)OD%4O|2A(ZHUhH|8}S-8&WE-FU?Vi8B2FaLlo*|HN+b%z1!zhP;jL-Ji$p)DI zjRRYi@wpG4sSTG(u9xv2PT?>mm>8)vM8kM6?_lQ_6Epm!NVtE9!Z*ec8-2b zTWNlYpOP@C*B9|Q&@7?EQo*}mmZ-fTQRQmcw|)SBfBE7E_|fuZ?v@XqH8evq`RCC8 z5)VS1EPsSA%kfJvaPjmsBo@2|5Wz_mI%P2}A$VgTp$VhH3$f#u8GO`;) zkdYlw{0*}%qqsWD$VF*E#$qBP4oA90My4`iBqXB}U2$ZRky)@933dhmMTTmD7zxS9 zBm*+i>L8<%YY`HXF-m0A8aB%)(jv%6-Xh2dleUZ++%l5E2r{zcgTFJ@Wt2l%Mmp7f z_@Y5e9zRB$ul^KDt52wbLO;r`c>4JIi%o_;CdZb_U{CjOx3UnDt$Jdhrki(!jg0ZsBb#O;CaNY+DDrA79`p3j9`6 zy{p<)fp@B@W3R_+JVb$QZB*}?>8QYadP#>UynK-5s%#cKdQ!Z`4 zDM?s3<&g-Mgdg>)&q@-q);tlxl5i}Rz3_3Z6A>hdMpM~Kl5jMhh+s+d-JrUcB;ja0 z4BL`$G)V$0;$GXNy2>zwO|4j6O^!B5c4_eRkN)Z^!<+uMB3=lj;_~4Y(*B zcB!i7mJ~!^r>iX~11+ppkrWSWi%wTC34GRXR7nT#w`GT)ySg8Vw98~$V8@W7*gL); zo&qC_r>J&i$5Tz&@pw&kj4yWa6qSz5_)UD{euV{9nK6t}W?YG7#uJO;DInj6XvZ*p z*>SloJ3hW3q5`9-Zd>ijj;ETkY7d@?3_{wU<}`q%@yk1u&jb1+Xz0Du5SXU1ZIH`0!J+HL0}g6ATSGj5SZ~Z1V(*N z0<*vefmz^#z$)-TU=;WyFe`izm=!(<%yKyej!@x)z^w2=U{?4buqu2Im=!(<%yKyd z#_}Tyi~^qoW`z#|v%=SyWQ8vXoOFz0tjm~}$3bkhx_YpZ$0a&kW5G4?jIkMObII9#_Pz?@4(GrD*)W_B$}Yjk@M?>X@F2ic@7g;rrXXG=DN%;(_!Sb2zoP4HTkP}0rnZheBw-jaP3XLtZrWTMhm)e7hj=

- - - -
-
-
-
-
- -
- - - - - - - -

The weighted parametric group sequential design (WPGSD) (Anderson et al. (2022)) approach allows one to -take advantage of the known correlation structure in constructing -efficacy bounds to control family-wise error rate (FWER) for a group -sequential design. Here correlation may be due to common observations in -nested populations, due to common observations in overlapping -populations, or due to common observations in the control arm.

-
-

1 Methodologies to -calculate correlations

-

Suppose that in a group sequential trial there are \(m\) elementary null hypotheses \(H_i\), \(i \in -I={1,...,m}\), and there are \(K\) analyses. Let \(k\) be the index for the interim analyses -and final analyses, \(k=1,2,...K\). For -any nonempty set \(J \subseteq I\), we -denote the intersection hypothesis \(H_J=\cap_{j \in J}H_j\). We note that \(H_I\) is the global null hypothesis.

-

We assume the plan is for all hypotheses to be tested at each of the -\(k\) planned analyses if the trial -continues to the end for all hypotheses. We further assume that the -distribution of the \(m \times K\) -tests of \(m\) individual hypotheses at -all \(k\) analyses is multivariate -normal with a completely known correlation matrix.

-

Let \(Z_{ik}\) be the standardized -normal test statistic for hypothesis \(i \in -I\), analysis \(1 \le k \le K\). -Let \(n_{ik}\) be the number of events -collected cumulatively through stage \(k\) for hypothesis \(i\). Then \(n_{i -\wedge i',k \wedge k'}\) is the number of events included -in both \(Z_{ik}\) and \(i\), \(i' \in -I\), \(1 \le k\), \(k' \le K\). The key of the parametric -tests to utilize the correlation among the test statistics. The -correlation between \(Z_{ik}\) and -\(Z_{i'k'}\) is \[Corr(Z_{ik},Z_{i'k'})=\frac{n_{i \wedge -i',k \wedge k'}}{\sqrt{n_{ik}*n_{i'k'}}}\].

-
-
-

2 Examples

-

We borrow an example from a paper by Anderson et al. (Anderson et al. (2022)), demonstrated in Section -2 - Motivating Examples, we use Example 1 as the basis here. The setting -will be:

-

In a two-arm controlled clinical trial with one primary endpoint, -there are three patient populations defined by the status of two -biomarkers, A and B:

-
    -
  • Biomarker A positive, the population 1,
  • -
  • Biomarker B positive, the population 2,
  • -
  • Overall population.
  • -
-

The 3 primary elementary hypotheses are:

-
    -
  • H1: the experimental treatment is superior to the -control in the population 1
  • -
  • H2: the experimental treatment is superior to the -control in the population 2
  • -
  • H3: the experimental treatment is superior to the -control in the overall population
  • -
-

Assume an interim analysis and a final analysis are planned for the -study. The number of events are listed as

-
library(dplyr)
-library(tibble)
-library(gt)
-
event_tb <- tribble(
-  ~Population, ~"Number of Event in IA", ~"Number of Event in FA",
-  "Population 1", 100, 200,
-  "Population 2", 110, 220,
-  "Overlap of Population 1 and 2", 80, 160,
-  "Overall Population", 225, 450
-)
-event_tb %>%
-  gt() %>%
-  tab_header(title = "Number of events at each population")
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Number of events at each population
PopulationNumber of Event in IANumber of Event in FA
Population 1100200
Population 2110220
Overlap of Population 1 and 280160
Overall Population225450
-
-
-

2.1 Correlation of -different populations within the same analysis

-

Let’s consider a simple situation, we want to compare the population -1 and population 2 in only interim analyses. Then \(k=1\), and to compare \(H_{1}\) and \(H_{2}\), the \(i\) will be \(i=1\) and \(i=2\). The correlation matrix will be \[Corr(Z_{11},Z_{21})=\frac{n_{1 \wedge 2,1 \wedge -1}}{\sqrt{n_{11}*n_{21}}}\] The number of events are listed -as

-
event_tbl <- tribble(
-  ~Population, ~"Number of Event in IA",
-  "Population 1", 100,
-  "Population 2", 110,
-  "Overlap in population 1 and 2", 80
-)
-event_tbl %>%
-  gt() %>%
-  tab_header(title = "Number of events at each population in example 1")
-
- - - - - - - - - - - - - - - - - - - - - - -
Number of events at each population in example 1
PopulationNumber of Event in IA
Population 1100
Population 2110
Overlap in population 1 and 280
-
-

The the corrleation could be simply calculated as \[Corr(Z_{11},Z_{21})=\frac{80}{\sqrt{100*110}}=0.76\]

-
Corr1 <- 80 / sqrt(100 * 110)
-round(Corr1, 2)
-
## [1] 0.76
-
-
-

2.2 Correlation of -different analyses within the same population

-

Let’s consider another simple situation, we want to compare single -population, for example, the population 1, but in different analyses, -interim and final analyses. Then \(i=1\), and to compare IA and FA, the \(k\) will be \(k=1\) and \(k=2\). The correlation matrix will be \[Corr(Z_{11},Z_{12})=\frac{n_{1 \wedge 1,1 \wedge -2}}{\sqrt{n_{11}*n_{12}}}\] The number of events are listed -as

-
event_tb2 <- tribble(
-  ~Population, ~"Number of Event in IA", ~"Number of Event in FA",
-  "Population 1", 100, 200
-)
-event_tb2 %>%
-  gt() %>%
-  tab_header(title = "Number of events at each analyses in example 2")
-
- - - - - - - - - - - - - - - - - - - - -
Number of events at each analyses in example 2
PopulationNumber of Event in IANumber of Event in FA
Population 1100200
-
-

The the corrleation could be simply calculated as \[\text{Corr}(Z_{11},Z_{12})=\frac{100}{\sqrt{100*200}}=0.71\] -The 100 in the numerator is the overlap number of events of interim -analysis and final analysis in population 1.

-
Corr1 <- 100 / sqrt(100 * 200)
-round(Corr1, 2)
-
## [1] 0.71
-
-
-

2.3 Correlation of -different analyses and different population

-

Let’s consider the situation that we want to compare population 1 in -interim analyses and population 2 in final analyses. Then for different -population, \(i=1\) and \(i=2\), and to compare IA and FA, the \(k\) will be \(k=1\) and \(k=2\). The correlation matrix will be \[\text{Corr}(Z_{11},Z_{22})=\frac{n_{1 \wedge 1,2 -\wedge 2}}{\sqrt{n_{11}*n_{22}}}\] The number of events are -listed as

-
event_tb3 <- tribble(
-  ~Population, ~"Number of Event in IA", ~"Number of Event in FA",
-  "Population 1", 100, 200,
-  "Population 2", 110, 220,
-  "Overlap in population 1 and 2", 80, 160
-)
-event_tb3 %>%
-  gt() %>%
-  tab_header(title = "Number of events at each population & analyses in example 3")
-
- - - - - - - - - - - - - - - - - - - - - - - - - - -
Number of events at each population & analyses in example 3
PopulationNumber of Event in IANumber of Event in FA
Population 1100200
Population 2110220
Overlap in population 1 and 280160
-
-

The correlation could be simply calculated as \[\text{Corr}(Z_{11},Z_{22})=\frac{80}{\sqrt{100*220}}=0.54\] -The 80 in the numerator is the overlap number of events of population 1 -in interim analysis and population 2 in final analysis.

-
Corr1 <- 80 / sqrt(100 * 220)
-round(Corr1, 2)
-
## [1] 0.54
-
-
-
-

3 Generate the -correlation matrix by generate_corr()

-

Now we know how to calculate the correlation values under different -situations, and the generate_corr() function was built -based on this logic. We can directly calculate the results for each -cross situation via the function.

-

First, we need a event table including the information of the -study.

-
    -
  • H1 refers to one hypothesis, selected depending on the -interest, while H2 refers to the other hypothesis, both of -which are listed for multiplicity testing. For example, H1 -means the experimental treatment is superior to the control in the -population 1/experimental arm 1; H2 means the experimental -treatment is superior to the control in the population 2/experimental -arm 2;
  • -
  • Analysis means different analysis stages, for example, -1 means the interim analysis, and 2 means the final analysis;
  • -
  • Event is the common events overlap by H1 -and H2.
  • -
-

For example: H1=1, H2=1, -Analysis=1, Event=100indicates that in the -first population, there are 100 cases where the experimental treatment -is superior to the control in the interim analysis.

-

Another example: H1=1, H2=2, -Analysis=2, Event=160 indicates that the -number of overlapping cases where the experimental treatment is superior -to the control in population 1 and 2 in the final analysis is 160.

-

To be noticed, the column names in this function are fixed to be -H1, H2, Analysis, -Event.

-
library(wpgsd)
-# The event table
-event <- tibble::tribble(
-  ~H1, ~H2, ~Analysis, ~Event,
-  1, 1, 1, 100,
-  2, 2, 1, 110,
-  3, 3, 1, 225,
-  1, 2, 1, 80,
-  1, 3, 1, 100,
-  2, 3, 1, 110,
-  1, 1, 2, 200,
-  2, 2, 2, 220,
-  3, 3, 2, 450,
-  1, 2, 2, 160,
-  1, 3, 2, 200,
-  2, 3, 2, 220
-)
-
-event %>%
-  gt() %>%
-  tab_header(title = "Number of events at each population & analyses")
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Number of events at each population & analyses
H1H2AnalysisEvent
111100
221110
331225
12180
131100
231110
112200
222220
332450
122160
132200
232220
-
-

Then we input the above event table to the function of -generate_corr(), and get the correlation matrix as -follow.

-
generate_corr(event)
-
##          H1_A1     H2_A1     H3_A1     H1_A2     H2_A2     H3_A2
-## [1,] 1.0000000 0.7627701 0.6666667 0.7071068 0.5393599 0.4714045
-## [2,] 0.7627701 1.0000000 0.6992059 0.5393599 0.7071068 0.4944132
-## [3,] 0.6666667 0.6992059 1.0000000 0.4714045 0.4944132 0.7071068
-## [4,] 0.7071068 0.5393599 0.4714045 1.0000000 0.7627701 0.6666667
-## [5,] 0.5393599 0.7071068 0.4944132 0.7627701 1.0000000 0.6992059
-## [6,] 0.4714045 0.4944132 0.7071068 0.6666667 0.6992059 1.0000000
-
-
-

References

-
-
-Anderson, Keaven M, Zifang Guo, Jing Zhao, and Linda Z Sun. 2022. -“A Unified Framework for Weighted Parametric Group Sequential -Design.” Biometrical Journal 64 (7): 1219–39. -
-
-
- - - -
-
- -

!^Rwk8Xnf-Z$1GiOo;UCBO;aTyc z=W#!CFICE{oN=g<`0E?Ie_oF>nsRr+$gciOsWo7#90JVYrolWuVKBcR0~(iomQD%{ zOD6;4mQG0K@6q|AWR})W@^wpShs&1GNR};~jI=DB=pf?frLR3I1&xf-(n+Cd>Ezgi zq!W_QXSAg{IhLi9AvTUiIvE(ZbV7b@=|meYvsOymFS7ylk8H;5{irWlInh?lC?_YX zBE=~(-_a45)SM>8waGKe$*~EO;;0%QX%p;pGr<%LrPTO|!H_H1PYi~tNc#ziIbbMH zw{&7KoWui$WedPi9&Am|U^q#(bYd`+K}$LbU^uPznwhmUztS8w?F5RzHAYiO2hk84L|(RzH9dcY!fS2&h9;YqykXXKS~* zl@n=Wv^UbSf97lU&;1wdpL{^sKZl$4 z&*N45=e{xfCo`~r78>@?U&bxkFpsz8pv=S$ny=eI50~wr%*U#YKM2zqNq4cn<{6n3 z@ya~U2&dDG^nqq42{V!x+ethl`GK7z%t&5rdCfC&zZ^3%tzs|nj8sY5OTvugbpVyl zh;|%p(=gxKy!oClv@*wj&L~-~LBqL~?g6>qsp`z!os9)ko4$zrGD{z&1F7_})zXKy zBtQe0IGQ9ZZq$J+op12!`~zzL=UaR0s%-7P-w?;s-k`!j+0HZ`f77KX$2r)nCFbia zte{$m#5KzXaa7O68?Zkd=^JHfW@`^g~#-9IditX+9Ic|=x<>{mMeyx9JF!4lc{ z5wrcIRA&2Iqh|YSLuUI+2Ls!GZkySD?F<1KUOo9>!s7Gd9+CY@yzZ4k))+S1Ul|N+ z|JcsJ_Ot&4Zc;A&el&lOyqz`~d&zLLe+M-ob}xkKRur_ywwfB% z+&HJ8wt9dqb2v-ne@v|->nT8o?H1<|py$|B)8UyOZ1%W@Oc+w}qRkQH9qg2_3WsFh z1Z^~~Z4^lMwX4E9{>UB+=|%<8lw0h;5Oy(8yl8g@d51P@por7n4X8)elYex;>~X;0 zIu01^`ha&-21CG%dF7Z&$0v0BlJ<*WX0c|5-)ggiFtcnQgmh-|TkVn%W=4&IpRt8P zn3?^S{T0H@?6=x{AGn@>5yGOE?ocekBt#)w;Gqc|^GyK*wljCXw2xd0JeY8=+ zYq2?MFLUF3f_5;Oq#6A7+J!6c$d#|d zf|984Gu*FBxN3jzP6VabFj11HO!$-NoABQ^X2SnO^-a=sG7|CqvVj93mBgFy&(~g| zM~du1e7~wdPLI_3a1;JRbrb$%s3QC|ho>ZT9T|U;dVyOo1uw=yxURY>htzHUz6b}OqArJvfZh2ZA&ZMVw+>~?~N z-BQ)CTcb%ZQ-y=w%I(bQ+ir~}N>gw^TKg z`nKCz0i?d{jz!`tRqtF*p;Rwh0FxcXG#iPp5CqpkbhcIV6q&6s%qQ; zbfU_sCGtAa)zU}~GGzE}G(@AC2qK=@Ux+93u96>wIcbFL4 zM7g4Mkzk@~Y)n*CV4_@6p^}=YV#Bdw6J1YZqU&p&R2EE><2zV_i7L$< zg*sm(sA$sm3zC?#L&+8r3BP-Zv((Dbrd-r6B1L%N#4PJDMEr%9U8&{a`03u!X*YcB ze{GJxbjTu4y&#c?^kiMq@p>q5y`B?c{CZK~yk6oAuScBG>p43J${em?1?ps2rXo#6 zX9wk0e@^z#1RDj22NEOd-_AX<^vkf$Y5KNv`YKfir*Q<%2A`(9I;e}QI^U|KUpcMosv?*Ts9>fQh;$* zN=k>Ul+=c#lmMj83{o;?rKIw!wX#OxF$pCgXQ8C{orRK#qY_HU7Ij{W5VTNI`pH5` z?UaNP2Ge;h+;6*ulF}gyCG~=Y5(d+GEgH<6cjZ@c-aMptrIWC7#hiC>w>j^LqvE_7 z>@SIig7Ov|X!VnDSiw6JbQ0i@lK_XD1URJN2@dHbz#*LkIM7K1N1VbTodh_flK=-g ziQwSeAj2V@1US%1nBilRNd$)~BjAus0vyOBf`h|j42NVA;E+rL9LOYs176*5NG1Ue z$t1vmOd>cqJjQT{vuPoneWl^rPLicFOMB90~4v zZoA#JbkOcv8?w8$MsZh$!d*2h2NAQ9*Dx!24YQKhFe`bDW+ks-R`MEVC2>u&QuV{E z{+R|V||-?e)ebHxje61 z7@OmnuZQvN-fM16E65_sOBb}87LPg8jc|aTgmCA%LbDUX9jB%&Uh$!gWDV<6P+*eF z%$!0(5{G4$p}J+3+_+^HiV({zBQ47;`I=-F^7f5VSun&Z%W%^w%kipI7Bc<^Nz_yT zSY;_Rtg;;8FjiC+278PmNoAX9?0nra%i*$R7T8?V*dr~|*gEr->T5rT+&;j%lCu|0 zV-Gh?V;|>0TLa z;VN=0sRYB7n^{t^;VM`#-1UnU6&tRN@GxAZ4u-q(!Eoh+R#a@b>lO@m9b>lKhAY>z zq!J9*XlBc8xN=eq_lgy>|T1pHvcD-9YQE8?91++((5=|wX+J8U^s1i|?W>Qbynnjwt zu0>Zwlh>%=3H)!m7KCU+mm)Cn0DkL5Twc~kIl;fD7IAf~dHHY6+}f5_Y*GHyu`4|_n~&i(D}dCpU&XgOTAw=;@0MIB81lr%s)`~ISxopQ&{ zUTE6cf19wg?>KK~XEZzeP~FZxFmBBTTV9v9Gn&0U&pFBzWIvbf?Tlv4W+XWKiK;Xk z6upnp6d^sZH#JQ@glY02yK^v29&3TnrrC!u%|2v*wrTQMOmnefh0vy{lCeT)(_H3Q zA+%{~6qNYG^+bQ1Y7TwK%nh>!@xcccDM8a z4=jOzfh7>4b!XR<~Q4;P^zO2_W%ttUpRo(=6YY zG@-*<10+7k^*bpOhD6c?kVu*U5=j$+M9DdjNSXi=Noqi1X#z+jO#q3c2_W(2(|fE; z2ofn1Kq5&ENE|Uh;)r1z>i`K6(=O{kGewgF21FDvAfkW)5eE#2C}2QD0RtlNB|-#2 z&4?&q8X;h&Au_KdqB>6vaq0+Ls3dYNfhg|AOVn0I?E3RXboGDsTv;~HYE8%u-kk7e zc|J$$N*mLW!)RkVfLM?D-1bh-ubv8?zt^76W3lJ!VB>q?jb7($>n~#64nd3C*=snq zH{8x%!|gh}hTGX|_S$Q7J9&)`2gYkE$)95GwmIz+y2lSi>mDbnk#?wK;Y#8+B&-7P8$`KUFbHo@vS7i$Z%`tEUZ4?TCBRCA zwW(azh_7Q|yf|hPn^>tI;eSf5`ne2~pP#Ce|`zz~2U`jsrdFR5%`+)V#a z-Aq5Fp_%?2=gssVn?Od^12NGLz9#yAD4OU$QRS;j0)lvc$x6@DKZmU*`tvmeY7Hiy zUqa6lQp$4UCi;i!Ci)pnM87J*!ql`EKNG%(R|qBy6QqQ^{xl z_0(LU$$!(SX*4^qr{>X^no3Jh+Yrs_MdAfAK}udE-e4hKbfasP+>I8J*0iFlm&Oog zDuYzq>DedV>udI2`aG{}gh2vZx9 z2*Y4HibV;lS?%)A7GdfIi!e0syh#N{SaYnF)`Hb&EwY-t%T|ju$7*RUSS_tZR+H%4YSHFc4Q(!~ zN$+emhYPi%-m)UwSwh;~19`WJpuCrl_WL09f~3NS03Ypt;G_L9KH8s{CaLgk#fG6% zl8RDlmTl6CJyTLqcaoOO10{P%;F}>*f{y7(3H#3Rm#{8x_Wc@5Ae^sae|3D}(m)Mj?oeXTG%9Sln$tpEzniZ;n`Ogypc< zSUO-oujTFMt<&~%Lc@MuitXq1g8jTTYCk75?B|t1`*~y7Vk4GVy(#XtpHCdKpEpPB z=L}}`rgXq=Ud!9fTc_>j3}*GF99zBNb07h%PZL|GD3*0{XRMPuW1Y1_tdn+#bdy=@wVjhVUl5TW9U_DKS~QJwN6x}{UATARaOm8ZSAK(LW%bC+l1(Frp00PX2ng1 z57n*x42)a*VL|spYT99fro;23_9Xg;%a1GXXEf8{N_k0bPE!<3z&nCAABmDXFe2~&1< zW7)=2R_eo)J(^V;Pg$c$wFy&pW1UqSPg%*iQN|5aM)uNMl;w8nEy{wG4Xf2mOtl(r zo^OX8@w)XEW!Kqim0WZ+VlMbV_mlo@BJ&)|DgJkw9Kye+RQ98wc4Owu$EB%*;)d#vX;;~Z7rdex0X;k5VVAI+pHxt zN311OPd=)0skmEGf)b>Mq$Mxf95Z#jQNvVDj5vS|EQUN=5OZzkePqY-^~AMGylw=x(rz$F#pV7 z%ztylQd!0GSIMDnu570*l_Z_(VwC2oD=1^})g_i~G^bLhb6rfgoHohgue-$N!UGs4 zg(^s8odj(;{vtu4 zQLvy;IbuP9$8ABOHEJoXHe^AebT9}C=eAi;XpUG)tDgLms`26;yFb?1{Tst}|H@!+ z|FNCH{YUNo^@82M9NYbQ+;;!gX}f3bK=!m5h z3~M>+cg$9#sc7$9Qq--VT~FkRY{*um%^G9q z6%=rp`YkkxvKz2Ag5Y7--g_c7^&FpI13&2=)+e~R^@;sO>k}vF0b|c@eIieyN+m@(Bz;26=^E8p1GJhUP^j^YB8zH=7AQPy!s-AID`~+JKp0k) zjwJvO8`3=b(!#JxIxGQrSeG=C0McQVB3c9Ru+G4&0eDy?mslIC`cT)G@+eg$s!o(& zWeZ^D^8Ld!Ey4b)g=wSyDDq$B$?K{V)b9lQukI(x2#O1{ z|LToGHakYA6gzaQZwm6CBFNXLW?PJeKR1o(sX^kpT(we<8U*mgEgUKm1m<|GC zFni??J3ru+3?{D>06Gbb(b%w6g^0b9#NS@Ik3A*u%Hvf+U!&P6N#dom?!N#Y$rK)O zz$3I`k;WSjxuX<^6c4$hB?sf7KZ1v4HSmx(T5>QRt}nntwYnt-<00R-;t=rAU{)N| zbH?`G#>282c&Nq!4=EYop}{1WrFdvC@Q~0Y!7RnY#f{D^3wWp&akvCLR2Mm1jE6>Z zv=|SSIN%ZIRh{h4=#kXoh=v25W@cK(w3A$#c@+I^x^EmLP&w(ur9e`&S|)W$EJ zYMJ(R6yG4;fqAvjU*|iNZ(HPg8WKuuc}vvk8u<2Qb#)5ll|Xvfz+4mdtHwBt{|r5+8pv^tF>Dk3$@0dL@^@@ziv7hQ1O{RMea$2DKUwjStOXAplvyFdLpd{3K*wq&!H ze^rFgQ^UYM-37bdHW zhRKrOc(Nj^nXIxOCaYYC$&wj)vLdUQtnwx%EAd5>6MOHIeRWD4ITE>$VTg_y} zRx??pYD|{I&68!BwN|014&Z~IKIYZ*Gl!K}e6~%KO!zpPRWjjoYjPEe>JvVy_=bI{ zofDIHQD@fASWNN_54~gSx!DvvIZ01}aY_-iLUO+AerI+~DS~p>RIpsQyXt=F_J~L( zyK<|czcXvDlnzQutPM#^7d=PHe@$!joJ+v&2Bh;#BNwGSY*K&UXUL$npBo{meN6sEVUttESRQ4g7Ca=EV6({Lh+2qB0Q2# zJml!$Ax8%fIlAzWql1SW9Xup53J-a@@Q|m2hddoTq%sN*$ui&}PX`ZqI(W#_g@-&H zJml%%Ax{SndAjhBr-O$)9XzDV2oJfs@Q^T5Nvtyhh;&8)B4GwVB+LMaY99cR%qT!4 z%m9dl830k$1R&H<21LpXfW!hMHXyW@d>-`JQqtuDHj`kN88ZKg9k61!Gt(mdZh! zKj$n&K0mf2{|q+?7?buoSx`A1|Mo^ui(=Uyj<{pO9hIWNo2##l?Ev%S+||5! zp<&+q7%g)1GNN{%6OVUW4x7`_9} zUCOO&asKP)e17nJu_n2EWZb$4k8p(^F!_-maK7#be7Nifj9nH+Mp}Np`I?{a{tJG- z*yrav-1PH3P7fK+_xrJjrPMJm3nPVwg^>Z;&k#l^RG-k+78I^lM)Gw_b%)EA>L_i|ZxFrr?%wA(OiK1_QNq0{p< zzL}CAFLVOJ=Lc>GAaMZ1o(3RzngNkUXg@R{?qISwVnF0+5=ZbfyI}xCUJW3sv+afk z#AUI?5d)&a!Qw~i-W5d)$E2S8l!SR64RDuyJE1V9`pUhiT+RA);Z34nMs08#d< z`(hISZL$MUiCNJw9t0EDu3Fi)~xjI-W8j>`*X?<$9EV0R<6R`RjK&l z`0nx^Kb&xPd5<5C?;dyFy$5W)7Q>~mZG@4Xue#{}eMvF89Fgcyk_1gBfs^{ZcaQ5l zaei_llPhyN7sSlicPqChifn+H{N{+5{C4Fd^}7|lX_j)lceN&_UNDhAe#AsR`JjpX z)~Jd6+K`F-(!oIFpW9|4zd2$ezk2dTHRKidh{q=@{PJ1tn$;LKkzW}MME=;$K;(~_ z$gdXyk$=cUKE!q)@=u${ujNhTmwpOF{@JZ2@|z>pu_{M5XxEJ5cjEE2)?(y?koQz(eR2L&_u$%o2JfdK;FFo?ki24%6pAO>GBXhj1sh`|R2 zG5Ek>1|Jy2-~)roLSRtp3=9zXhCy-|FeuFi22=RJAUUixY6>41OyM6gg)bOP;h#2z z4-87}fx#3$Fp&5&SfKEaZctSK45(p-K@>hPsDc0nErbyaqVQXzmcs%J-Q>L%wrA%v z%}3sAlLWXmZzngOY}QTQt1Qm;b)1yV*1(~xgAOhol=#&lM0snty*(ANZecg(RXir* zqFdNK`&AY!6AqT1D++a56_10co?KDL?Y3{y#1bYZA&i-Igbxq;L&wiv>0qjY96ya= z$4_N2#Lt-5l&M~OUE9vp3l5-i>;PiE4xrX)2T(2V04g0w1L!LUP;NG0{+HUu8(X|o|)WFYbeF+jovjhn%2h2~(fo90seyuIAbWmtmIv_W)UnwrrSHi{goxL-CrPn6atji%bF-X^nweH)IqB95;DleT>*RJm3Be%mAs|l*lQ4<*7YJ$%3L`D0JQ$0CU zR%d)7CSaGv1f2kiil*~GH_O$eCCJs-YC^8&Sjg8M3s|XGkexb+j5OZCFjRLiFq(s5 z$9V_Cu?d<(G@4_9a@Dc$L(#EtqDs@RMpGzAYSTev*zZ`#*VrIPe^e-FFr7ojV2*{M zx?=$>6bnK_2a$mXrz<2^*shRR0Fq=nB(7Yj3*nKUA7!tWJkjQ<3 z#O@0ua$g{k`#Qb?Bo@GQ*ja!?b*2L>K%&tcV1`7aIlclUs$U&nhD4(&yi!P{wgHLa z7D)6*g;xrR26KEF64zLYuM`rgZ9ozml30*%9Mh#4N{)7MRH2#4XxhawlhNjjMD603 z3EA24Xqk|m9mOB>y(c4|M#@?g)2Si%$L-> z#p_t-@X*xVE^{~0?8V)t*(Z*QX6K9eZYR!Xx0+@z9kAF_%S-GbgVMn=e4~GDmc0~P z>`^*FXNi&ve?9MfD4CqH1`&77Aj&)$M0qHKI4xxmWvL7zk%mE(!7_*vS`ES%d%JXB z_AMXA2r0nMhd4N>9Zj*p${jnU6*Y!rt5GDasAWs7Te+2oH9laHDgfrZTiO}%?|9|B zTiR(2mT$NCE$#G9Z@8x=U9)T(s40)_A`$J&seV{6pUksRO8 zvGS{*W1|p6yE9)}Eh&EI=QwfH&#^gT(T)y9t0kqMtd`VHNiAVgk1D_9saP#39kN3l3HGB z34`gV7Y$~$q;$w?NxdMoguy;0=N1%6fFhZErh-D=1{Cr(ppdr#g}hBr$lHKI-Ubww z1c5?A2~a4F1PZwuP)HIK6cS2+LJ25PC>;d~Wv7Bd$tqANbp;9~vOuA{R!}I-1qvm- zKw(J`D5R4Bh3Z70P__&dN}dIUbP}LYY7G=hw1Gn9r=U<84iu_QfkG)dP>`?-ia0 zulSvPsB+Xk)Eu$m2G$m42)cyF%H6d?W9gtD3wPIJ;qH1Yy1O0=ch_U#?v}5(yW}hG zuE)aN^;o#O@)dWF!`)fD)El|k#U{Tk?$!_w85c`_&Rm_6oRQeQjkcPNbaVR^vtgU|jM5 z#$C)(AznW7%y&Mzx;fnL1tiz8rCq+ppfj}?wmQs9zufff_4d~Z^(Lx_5(%_Il>0W@Yf`QuWEyF ziZ2t`dA3VVH%~?op-?k{t$l|PMDjHe*g)}t4tAu(Gl8ugi^C4hlX%47VKoA$FdoYP z>=XeHrDWDajE8bL@URwPS~28t{F|a8xL>i zJc&n-5SU9m)V|)cExPKKL$qJG>b^`4Q6`#ga@Q?~X!qrm*S{+lv1L@J#-XKI-%I*c zEO(v(L>%*g=ZjPhgK}r9-YO}17H#npwtTvjTYp&M9;4frhnx20;}iDf@5k)R%)-80 zXxNv38Mn5_T%MORGaEZ|zHVneT(&dgToz+Sf-j$_+L!kiE$&gc*_R7V`|@uS_T?St z?aPd2UmjwMjVsB(_|!DzMVh9Hb*3qzz%J%#`h(9d=4q&?_<~sk ziOGDsSo5%uB=Gl3yP_p*{YB2gujV>A0C z`DXT8r_Jow@@Do+2LiKycB`5F=7^=SiKCBblk(zsBKAcLJfObIMqu_UzoyLox0c3Q zqrrQIg7+K@-g9nyr}tD(1@GBw?_u)tp2lzr2j#^PX#;{ID?9=m%6@@EH3|)6)&_t> znKE!FZw8J~-E4VXSv7E|^Z^cQ1Hd7PtTk$F05~X`+T|BQ3H7z50nku=1sbll4g_fc zG+c{~SQ-Eg)oGyNvJEs;#es%uI?xD&!nan)K*NzR6e8hZhy>8+hy>7ZBYf`ZE@-;})n{sDn@=cn^sTzYt~mpknn0z}jmJ-vrO#9-;@~qD zH+pfGchy|X;>Kq*M$)c)=JMNXzck863JlfectZJS2L^89z-Up&tCSsbV3ZDoz&N+f zfguI}PpF=JRkfGc0X5B@g)C6PJnX=z42HlM+Zh4_o`E^wjfuUHqm)%|X%bmg93~M; z=5OqdOv3f_klm3<*d3WfR(pp@WOaEu30LjIma3S9{gFvz6+V-gbOJT)Ez}9rw5#S_ z71f!-)U6y*IG(8T)P|cpMUoqy;{NH|P*G&?%lSI;DJXbV*z;}j9GRZ?BW>oDQ`=fy zyAsv@KP08o_^(dImC}F2)XNGE!Bk~psy<(%UsFuDn0i%)Z;GnVl}*(T)lJni2T}DZ zfL@Vqb!42qH`LT-svg@+)$bcKReyYfefl+;n0k%&q;#wO7fjXXYjk*OG%@um5gyix zm&0XK_4&G~dPWmfuc~>obgN&+&D9qg=ITl7%+-HCX0HDD1l!PPG*k8Dt)}Yt7fsdE z=Ex3lf+4v}xg#(rHPu>$6b2O}z@TCX7*wo?oljvFevo}28{*`9t{{Y8Zc-yV9;p5;7SP?RQ3Ub5@6Hw0S0Siz@T*5{JddsE)5LQ z$jr|h290KVKES|ef+4;l7-GW^-^E6j%2~5j7TF0)vvKpPm^xK5<;s~#mYuMaEpbsL zHWxQ9G9y#TL~?j{#x*Q5TYD*LOWUF(ndbTwF8mfZ;J02+)}f&7)EWa^f@ za47C?MQ)~oMr%RG>^@O6Y1;szDPMOqF-Jv{W~r0On5V<3&~P|$Z->*)^A4xqCfJKf zdX=Mzr{rkbUvxB`sIoDWLPNnMEOas%qdA)Lbw?AUDVn6t=wvcRb2tsv9ZrnqaN2R+ z;dE?*-J3L;qY3`R(ey)chE4K3hlXu(C5BD*Je@igY?7ZlHiAv@RokSZ3!5Z3IW&Sz z@;rxzZIYiWGE$o~nnS}jc{GJaYLiBDY}h9IxnsjNiRQp2jfPF;KpYyjY26oAp62sz zwLxYYaCUxJrUB3A-D+0W5=tpg68}0c^+XI(%XjV;*S%@gSNy$nfFC}QXfeCReaV}8 zuMIgMg201Y8fXk#8sMwj(ttWqo`T#yW@$iODv#-Vou-x0_MxwLb+jn$qrb%+B43-< zRrd=iqIzLMPnC9GhTS%;tHznocoMp5zBH{{++$i-EjOWa%k4PZV0BBHr8YyT44SoP zma%$Dm}S;t5@wmTpQN)CYp>>%v{fa{GW4;0EqYj8En$-65hSiUam15UlA(T>v^&PF zKVO<1W|B%z)Jc=Jm#NEU8|1JjN#^>9drRh`-w{(;P&-8;YZGGiW6eXquRlDaGbOk7 z^QgTaa+mK(9`Wp*>)CcYa2b3t@Y30N;Q834Ddw6DleixrDs$d1+nDGbJ_~7Q-w%7M z*(R5Vn`Up1Pl&zcn`kwSBx1zO-WD2WZ+{s#d&|e;2ENNRchk4|y6M})Wz)BO*qOc^ zX_>w~!2ydT3HytG;4@B51g5+SO;cXKO^EX1^IB(SYcx|{g@)T?x4MP}(F?$l0w2Ah_( zoqS~4PJe`&Gqar<4Ld!WX<6H;(L~DzJN?mVJA1IL>S)oD)NHASKJBzUZ`BvmbVM$1x|Lc}D!ipVn zuRLYljusZaQTR8BtpaPR)qUo^SST15a%Ht-QlJk{6y6bzOQHp$2vQBp;xox*z5$ z3AUr#T*aZxReozfx4DQDGS{wbKexF`5#;B3q?l_d#QKBHRYq@eIGC%^FgNZnx6AiC zmnqHX`|2R;^!>S%2Kjz=oK6Ra%(p?G=Z)?t49I&ro0-3+7U|%mf1&_F!PYNFD0nIh zTS&kw(=KhZy#Fn?;fu)Q1P+sSk*s?pZ6*o*6yh+|Xp%Nth{IGHidZ|EQbJ!wqLtfc zSl=7EHq_o7ryb|z>x4`~T)-*cU^aZYn$*my#R$WRk;cJKj!i8>pqpB3oi?>t%bQv(9Z0Fgt)>>WmjF5b#L?%I$HhB} zSrmc(w5pZ{4Ndg)RDMnU^;>i9txS?I zc!w1=>y!5w%ZpL8lw`HswO%mgK7PdR3TG;JZH=aI#DYUzB)}1xO17Bf1P*tc44QMN zItnD`s7X%XfOBt`-wd5AUz_6u4N>l(A&wI?+=_H|>r1L}v{^wwBMxX#4jBz`?x3NN z0gVtc-+9lO%euc}D)bLw+HO)pt_Hi1b z?BnOQ*~itE1anQE$)$vgW8vGi#~4*zr_i_tk2-RZYw$%9D?^|O-JFqZb;fA zfAD)%kn&zm1D;wA(M?vX|41d|nvY$=#|FDHJ+ZB+8@{=qLzdttd2W8{@o79zm>%e*D!w+q5s=4sX zA20Cle2pI?Eq+M`$1ii`N22z3xAql%*J<=aaELPd0g;HuChk|0kPhvGL&W$^;t=<7 zq#qUOiRuQm7Y#Sp!N?1QHR_)K@xtAzW%IRF>P#AGt)S4o3>YHhK_dZ;Tl$)ThEsLW zQ05LAs&PTXX+3DD1qn3do}i%$05t5Lpdt4J4Y?<1$UQ+L4rnOVe)V)cGRDp6Oi-Sc(V?uW~4@}0CV>A)kA z@VEX2J{+tJt0jEmfR94Qtd{X{T)EaaKI#Hgtsn5Q!sS}u_(=Y8tsn3)<>g}E_=qL| zpV;^y*s6)(R=>dK8rU$cO35~S*QW2wb414` z#1ZkTkM!lm>%Q)_X@@{q8EqH{ zE2HfLVP#-@TySf1L6w+nH3&hZjR#d?Y9B(CnE$DboZFY~)SuzmxcukYNU791mhfy` z{vUGruV>@(|Fp}0o{h?Xo{h_Yo{h?X?Q$5NO|}DK`fODGYk$P>Y*ha1*{J;2UW(z_ zsQlMHi|Mm*`Tw8VSDI&YhyIja+r8&NcSl$^MWK_kqz`ND;%p3|SiY2?rl zc1h>B464>8t*Vz%J-ZZjcVCO2{9Nc)=L@LBl}|5+s&T32$O$QTaJ6^K*nWprbhkn^ zyBsRNrJQ4rs&bK)*kUWUIbXknO7JFL(T>GeVvDWZ=6t=zzlj(2FS-)Lo*VZbjeip_ z?C)2V${eQ@;C@wk%j=*^T2ZQ^?pKxlYH9)1RKNNT)%Oxqm8^KxewfSSx~Wy=MQfM+ zpEpY))Ak*A@NyHCA>1|L|_NXemDy{Cy>!$zvA5?=&bVdJ|S!s1wUN`;Un&T2(*gvDv!roi! zcbel8UD)5RD*IJszp9+B&-S&-zE;`SDi`bn{i@R0yjDHl?8@p+o3wa!4>`65>;%v?=rZse`zW<-FF#W*x#=z`&DJXs_a*l9hLNAbgKSq z`?_Yos_fU3w*Ue+t){Z=cl7AXq4HbGIrgY3JFCBMsRozZ^$l~r#w+@!tNQzve=oO7 zHeBO{{nM+zZ~6CfyJW*PUfAESD*IJszpCt4mHn!6!P;EElAc~kUuRXx*`zwPbopLO z+yUG2%E|uExe-{p-q)5_PWFG!fxuE$Y|G)^J*vuUtjMmllACzCst zJ9}K%zqrb7JFj1km+b6uVgH?8RjwL{+W#W2ScX?_)j-0$m*vIWW9GgrFXm3ve6}nv zeg7@#sWjaT#jW`7{%%zL-Kegyg6`|o({<`Q0gpaw;(AnTc9)(T=#MfR0)5uxrXjGD zjKp%dcMsO22b<7~VffvD_jj0%CBCA+_hu7%F$}-^?=-h1zOcV1n}Dr1|M!~P5?|PV zhqER(ge|GVx-8f0MzAh*n49H#-3aEU4*RoQuVu>q+$h$n&mwVBRG&ravq*gwso#sU zKp*I{NPYh37C_*paVWO^jvjqEFg;5-#~v)wjb>{82K%#2uIO(|z|`oT%jClT8_(3} zp3CII{yUvTx?c9@3=Gn8zOI-3IRk^VoUiL;f6l-lE$6GxBK3Qb`YckPMOq+(a3}QI z^lhBGzv?z*k(y+23%>d*xUOU8lBVB#{XhF_x2_F=rguHL&Yw%k&@6|0_h6C4`22O5 zUSBcq>$sw?QpV@6{C7ECn*ViN*dG|5zw+PZcxnFEabf?R&LUke1GJ0$V>w^f%K+_y zMOx0+^)f)aV3C&d)n}3VEK;9E>a$3F7OCHhv_Kz#MOrZ9vKV$|xxCga()IHo{X1MA z0_q03PBx@}higM%IWRp-ImaF>(si&f*Tmp#h55Nfu4wD^u`t)f;AqTSw zPiO8vojU=aK8xhqTl@7~9}m*M!}TE0XOV6i0!zuzEQfpdV38Ke=xl-gS#H;t%z2J0 z`f?GB&K6#~+%DNS$A$e1XLPpk+U0i1zBw-JztdTyYh{79z#!cY*R`@hTVRlGhwEBd zpe-;+x5L$Ek@_rBpGE4kNPQNm-;1aS>a$3F z7OCHhv_Kz#MY?V#=0>nNH|ri|k$xYpq(92+2&fzAcVJBVqs&BLIWRp-ImaF>QXTeZ zxn2Ka&NtwS{sr?>Uxt_FeFHA+=Zx-Ucxm1@;KKepokdzK8}wIlm)q%DEF1J!7^K_j zS}Ys%R~V$*>FTpceHN+DBK29M1u_WzKApMybnXOv`Ye*`YVGMWJIB%g>rx}oXOV6i z0!zuzEQfpdV3BSB8?!J*C%1AWx-sm>!Wb0BOKuF?urS7g@#5c;m0-N~qAU8p!2;Y) z*J3OBzrh0BPS;{9`oF;f+)h`Y1?aN?eHNh40`yscelN)aeW1?*^y~jy0D+rU1KajH zdi3Q`sW0UmyIFwT-Csmp30KV3UQ~tncPh%;?OIHQ_;)JG+wEFRh4^SgSC##$ zvR_s9tI7pd6nBDl+P86T{hX}2P9}86US6S4_nr>@pEnNy)pd36?9l)DJ0q}^729&S z_qD=u26#Er)y0TU9QkQv8~V z@^-xzQYn5-MR~hk3#k;prlP!EuRFb}T>1Y-?Mt6UR|m#FkFMtF>bg=t-Qwpz&+E5G z^xFbE(q7p$dXazc8{^-{tNa*l^2@)S)r)?-ptsieF`{?=;~c+iAIYtauCrckUwV`~ zFta~IFD1)PnOM6PF}dKD$}!$!>r>l>o}ctoX$E9 zvyQ{8<8;<>m~|Xx9fw)R>8#^0Yi_7n$6?m7XB~Ui@eA$8uDdpTsr`rOkL^dISK1Fn zueBeDUT@zQz0tlmdb7PLdb@p3^lp27^j>>i^g(+~^ig|t^q2O^=#%ye#}LoEom+D$ zYRhGY>_~Q*9q0M?u?c<@G#{#b-!6%`tB%9nTaJs^-rR^aIn#fA4e;bt2@qr6s=B}`3KP& z{Hyt1v^LS~--*^I%>V7^o&*ctj5a0M@J6&bxq=mcitbCU9xlHYJs^jDC3-Nqf-QfH z9!{=c&5O|=m!eWhv#SSej=A)?H{w%ty{b{ta{g-HU`=e-0 z`-5n0`~7Hr``zfC_S?~>_M6e>_MfBs+OJ0sv|o!JY`+>k+|PPq&|ro^3xFJ=cE1;iiyzx&83GA#*2`+kG1sLAh*bMOW*EzeHDBXLfxYUAZ*2 z>o3vOO2UuEFu%Qcb_@So+{=&ZNq#g(^viSG_}|h&e$UymhEd$1>xX;X;PDa0Sj)Kzhq zL!8bb4s(dZ9O5vCIGsZr<`9QD#9cWH9OB%DcGPZv60K-|9Ia}9 z7~M_muW7#*t!t}~Ctn5#8JVQ*=LZ|6u!-=%Mx>qet2=MvoHvkF}qRp5Qa$ z`kLN91)%>3&znb8{Ei>JANMK#l0NS3{BO_4U732^XXH4=*}bRZc5`@7ZdEH zTmKI^mwf)7rcrhkM(-8QDgl% z*?{YxdMjBc@ZU++*!AB{?$%iEC#y8phsg?!^>K1JQqU#%J+OtYi6vxN0&K*CVT%K7 ziib*aui^pRhzH{q2iz17;HG#0H^qZ+ivwjj76;to6t_6w7T>SI zUX25AaSB`eyZ*T-&&wt6orbREQSI_8uCVHy< zRP+qr+|RZjkDhNo8okIj_e*?pzubN>dbNFj^e2+t*V~(;KesnVZ?!i>?~v@i+g=;J z-@ZHgu)Qk!m}K`a?Ykl#d3#=3WiGm8KM8Palmxam#E;TJl20BFzif`^m#6qq+^b)n z-ID#XlIWM;@k=6yU)Br!yK;no^Xz)vj%I;yyXr~3bI;`M8pC?$px!ygo%CUy-LL%f z)csELsxZ9+dh5Aq_iGn(t4Q?cqD1z8mSE$j$z8h5Uy_xw^CO~2mVTh1YL2|0td+Iz zChKMI+r*zNepBJt9QkvynNWQrxld-lM%>EqR}{we!pq6SGX5oET;{)^kZ+AXpFFOy zo=u+ASWolmplLs;4~yo=6UlS>VtXukL16rW?<|e=us&uQ!w)5|2$Bc*3=$~!@rfi@ zHtPebUf7hp8C@;^d=FoZ8g0G4DO;!4CGTmpHOU8zc3?H%sTyr%^07u+k$e(esh&(I zgEORNCs6i(77M93AQcCs2pc1%C<3WCAQcCs2sk69_yehUGqX=#j{{VMs-aTk0#zKK zBCHLSq8zB=0972I;se1@>GJ`o;s8|~pyH#%Q0bEesNw(>A3KJMPa#944<(?A15|v2 z8!COF163TLiUU-9_ZzA>KouLRcoM34_?Ww*PaTF-@YJ9mI6M`ml>5}EZ#sMx#t%@x zK15Qk@K%_sHdfdx{He4^NhRT*@6T^ifz@M?`Zyy^vqS2=cg zF|@<0bz0%Y@UJVrN(UTY7td~Wd^JZLUlT`PO8%gUD7-Y4=M-O!g5#_5tK&-(BEgGd zCKP)@@?s_=FJ?mWVogY1%!K5{Ob9P-m*0^SYd&&f<|8L&K5}B_BPZ5;rWqxXV~Jmqd?0Rzmx$XjedCvy+ksluUE-dU%BD;0++8?V7s2*lV%^M(EFsUb z_eSz8gvt-O)dNwm247C{HS%$h86sP*{NukaeJHkNVBBoWP~B_`#Dv+F9p}xq9GfuP zQfQiOfr>HP@HNa=2`=C0{q$0u>{&Ma0BYVp|5rdB~z-%(g(q zm~GiRX13+{gxQwirr8##7_%+=i)LF+RLK)Gn#mT336m{{%O+d$b(1YnF`^qq#jFzF zcx2q(QE1pZ#HS_(C7A>zHYnmd00nZ-pol*Klo(FUgiHWMYz?4@tpOCVHGpEa22jM- z0E+k%K+*jG#cU0rh(9qOV^GZ20E*cfK+$M`BL2jLOaLXmYEZ=1n2<3jW@`XNY>f#S zgQC&Q#{^I`n)w)mVzvfQ%+>&k*c!)!K`~oHJjhex++AM~$DdKNeX?NA<{>`9ua&d; zGhZDGqB&O&v~%m3n;6GVCS0`U{^^1GZ(_m$lvm!UKz$?%gDZrNR~&2ylqqpjmRe>QTk+tHpN zm*_+}KY3w=&3&l)U?r|1Iv>5al}Gak*Yd zVBvVrO6mrsMyo`_RR%@F@y@kS2}+|(!}0E<``s}Fn%+$+?RSen`%vB)?Uh?~RV5MgoR3;8|ICY~Q;Ynf(^^xNd-&xX_d7jFRZiY- zHt=S@-2uj^<@wP%{YiB7{MWe^pHYvehForr2wqheA~~r74R3A8@U}(`FD0DeE&ptm zvtBUENx8Qvc}<}1GR;{TG|kx$5d4Hq^Kxhdt59hqnU~-9W)hH8xj@8 z{GKCyRuyC_s{FI4C_wyU@_?S;DQQ!5fZdOB77B2~;dXA*Rkc3wsYam(?!!%foT&2Sha!^WrmJc+pud2> zMjuPkT@igK#duZpzVu_iM5;bwzF(pQiI*sY;U!Ap{Sq8UD*ML}kRL)szK>(&R=1+7 z|2)sgByfy3ROd&o%)d$V_}`HhKk_wx><`n^i>9WxZ;V$`e(=jegCEBx_%}rg9@Tlj z@gDcV_#-7EH2dHJuy0V@>pq zIyTltZzWi@f#M6;FWy7X2bOJ${v>4Yjb2qLem^3)?0bNA5iEQtdQmF=Bhm9N#r{CW zCp#aDp3!JeL{BAGbK_5u+iJ9@(c~HJ+2~P?_B_Wp@PuBZu+&3-2|1t9UXJe9Xs<^1 zYP3Jm03eb4^=P9;`*XBGqrFA$Ell60cR-`P8{MtZ-j7x(2mg@DS6F;Rzd;uovCxPE z8Y=nh5k|wwF=!~a1r24+prJe(G(;r`4LK2L$caEhtOIDct^y4eb)caH8Z=ykfris- z(9me05eGCp8fa)V(9me0A%6u86BnSN(Lh6^frdr{4QJ$_q0vA?qk)D;0}YP`8X65W zl<9+p8(Ba@qv0TvzR|<^)qe6$djkypMwog!0NVG$+}{s_|DbhvwXeJgyZ=0&*3#*p z;WPIsKE;)yOT&K@P45x3J*Du{`0q#ayBFKq(SR{na0EH(KE;k|))mcfrK8 zqFnTUN9|pRBW^>&1_-KL`9Vh>|Eop?kmASw3;dF2!vCsRrc&g`zA=7@XY#*=20xCB zKTJBATlJ{!n{eOI-jrM(sz-9NTzMrjCH?!Z02Y&qq!P?Fb<>f+%=k?JEQ4IFq)n_qshw{&0fZ6dhU!S zHjB~p+!@VY#%Ox(-L^r{5ARlD+(>8Q3)a_YAYwEQ%i?LikePsnogB+Qu>Ks!X195uN3}WF`X*q)adVqA1!7LUqoW+9Xh{b}+(R)bb z(JiDEXxOz93mOHB1(hQf3of1i)?z_x)M7zxNMb?93`D{+1Cj8|KqS0oAQGM#h=gYb zBx#y~IC#xK96U1+2hR-1?=%A_c+Wr_JTnjn&kV%DYX;)rnSnU?+K@PS&p>I5W!^}jx$6bf?&C*HyOYzH zc5jWEcCQVYb}t$l?0tSmGaElbgFLkL8VA% zJgPxuHl3z8A@KA%r^ z{nlwqPPP2o^8L~Q`#zsfZ@^{@#M~$LedI6PNB+Wn@RxS^L%EA?BX{98au;qRci}d2 z7u_c2HVcOMrIdc{=pVgiU8DWa+&y2Y6M2BIZTc|vHAf>d47rtoy?hDMh@{-ac6Yd_%y^|)~ zJ(k#b#tL7?G(d*2#KxO&_gLX;9KJn_B_h;(yT|hPKYY8!ihK1jc5~t?K6>g@_k7XL ztsH=m5#K#;&-m}dlrxj=*5L&_`u4ZEl~I%$^C=|zk#Upkg@#FX5-OAI`^HSNAFrBZ zA8wjtClxcvzW;(r_I!`LNZRafx9xJmY*x=D6Q1C#7K&YNUEHer&z&@{aiD zz47>jy>Yl{nF{x@H|{Um8&6cD=u?e`GYXSr3X|BFD9}DJF7q6Z*!)1%e5EW1{lGguXFxZDEzln5ggo6Wz~ze!xUd?w~OyX8RR1 zDJB}tQDaOTQeYy1%TZ%YG<&O50TYFkqsEwMG=fH$#JQE1_-vgiQgv$wDloFf;`y`# z6)x)Kzm|afl!ECqJ{*}_J9p2eG$5z?>h;-@E$#S4veaBlJ3^Sg5~Vj%FdQyB81i)o z19wv}sLp*~J@UVdI~ocNM+0u*XxKOAXgFSVGz>Q#4Y-A)VgH5B`^UaNHHYr+Pbcp0 z%8~oW;r?x5cHDnswCIP_7jF0vyp;u+HJ?ZAiwH5r-S7ny zNBI#{jI&$$-%^K60P93bp37cJs;hj@9X03z`8{(FWrKCXg!T+vcXfU(H#od-ICXPzBV6YEJ7&Vwl;?hqaC*25G+5!Pd zTS7o;1qev300Cv>AV7X@1W+s5rA>$x0zj!e0Fc-l0BIEffL0*@r~(Xtv4FJ+A z06?`60Fdb#0CCd*5a-sk$j!UeIrW-lP3h`EQ!iT9l&&7NtSMbJfqK|7PFppDdfe33 zn#mLDfm2(nY7Oh*$My)|lACpzrvl|j3DW7rBEHJk;J z;%>Wo^`u?BIbwy5!7PZB4%pRedAoY+v|XLS?CRy%u3j(L)mx)>bq2GmR|cifHHJ~> zY)}#mlIvoSWHuQjnGJ*Fx)>za#UQz^48nEW<;Uc?*dx!y9(k_pk>_HMJQsVUvdJFF zD%c~>#U6Ps_DE%uJ(5+hN1ls4@?7kZ=gJ;Dw_Sc$j*B^RT+ET<${aZ^<{+|RP8`fZ zJ>2MC$#r?L&dOmz%tIltYA`;kF%t3t>9-eWl$&C$#@xxC|iL}!@hYt>_@ZgFT} z{BBmQN+4Ln58n#raIF_3H$5LnNmNaas(s(R&+nOZ} zTdI^_l18x9^?)S}TN(#T<6x;rv!Y>3H5!(BG%WRKmNaasM#EB%W=X@AYBWh2!BUsl zmNaasM#EB#W=m7CLhE8PrB3T*wQe>OE3}@rQ>;*q-zipTabYG_Xwjh-A7)~O7A1Cy z668|3|Dq^i+Wi!WPWdvutU_FJs75fi;|VMPYbTe+bOnwo;SAefBEEzyBV|Kx)>)J%&T^|Pt0$9HFq(MX z5+w?RMDi0GqR^y>YW5}ux647$Nil|}q7by1W&@4x{<_H|tV(_$`Qc(^lL~4o7goi| z!nty@No|YB^E~hK0nG*okdnq8udOQa!PjVf?|aU7PWL(IdEfJ5wqo@v9hvv3C9!&# zbDH*zVPxOaZQ1w4qG&x>sc5}wSN2_Q$-ZB?MEfR1Cswc8m3>b&W#5NuvTuwgR&yChrz_^Rl73pa$Dy8+5*j+9wAb%+7+oc)g-A0J9#|S zD<;oDg33lk*hx_Og9y7IsM1}Tw*;k;im?lVGS`%OOHi_J5LE1&2s;T%8-<{>QJHrT z6loF#$aeriTFAR%E2ILbc>*{^?qV* z(AKvj=4k8v#N42*Z%53bw)s$DbFvan`r~PT;s3i#W>AyfX*K?Zb^55EjT*%_(R;u~ zq1sInVx2fyYZi8;Qks?6gQb&S=1QX4izE*ibbg+jV&aO}gT@yuY zLF0tT0}LkepgSk>pfxS>pnf!v2j@pc9$U8=^NU^a?ENnW_F0nsv9&KY2%dNY_z>?g;qak?2H6ls;+nu8n#kJF56;icB zWEJqFo_U0+gU!YHrC;Aw7inS|piiOwY6c|lT z(LE=pXqDv@^&`P4&Oa-s=v3tt&C+fz>8!m(pTKBOKfsM*@r<0JF)62jCgc>|Ih;p& zC4w#xT0<9LMx+bG-P8r6@CJ5}1Z994kuu1QKp70*p$u{(R0gRuD1%-FWzegj40#ol zL9c=`=v7b#QwAslP9e6_g>bf->M$QU=`$%Ai|88FVWugKh<7(5;{hx)qcm zw}LY0R!|1r3d&#_4`slsqzt+hltH(GGU!%NhTN(0)xF&)_z#nb%jBCxrMR-YxU$3SXKWlJB&;$icFYpi%h^bzsQ9A z1(6A-mP960IwBMBJuWiga7|>w6c(#sDOELa35ayWB^+N6mr!ntOF*7LF5zuVbQgQ< zOe~5_sKg=@kYk8UICN2D!s#WE37B+IlP)46(WDtxu-NZOGyGAtUz1jBq-wt=%~(d& zeob0o6(-G4MAd#xn)g$&KTMiYy^8&sv_gIs`#ounhDo!ctZILlG^qep`!#9CQKLxL{>v@Y$T%9!pLUjEE0TC8h9wa<8Bi&R*^%rO5f96geN1 z5(TAj_V6z%g(q^S5;l#??vge=JF#hlKFJI^Y16ZlPck!4I$I6W+v`4=npi75`jmar zpTVf%hnHyBhc3#nPcQYq8tGNC^n7(Y))D3GDZ38``m`3+I1P7TCgk!i3;iw zq0!1o{M647y^8CWI-_u33i2#m*GcL0FS`FRt{ZRQpEyuDx4)g1>+5#ajoTds_jt=( zdbNWhdKxE5^k6>shv+aTqNo07Q}w%kOhiv>nnVv`Ja$My5cXqL zzZ-9``i)tBl+i21R`t7fP}T3oNmjox*e65an^X0>{)&j6))^8#_$51}a4=QB89{HF zxdsO%JEm{$b&PLaJYqUj3M?vt5yOcIRZBurXO@;|*D7ToDb4 zf`e$t+KaNzrIWJGPE|A{Qf_fG^;cz`tuwOD&N*2pq?C2mkI6dQ6s&f18nROr4T-_T&D38NH`6*pZU)}-4W^CIfw-CaF>y1kX>v30 zo?m6YiNVOtG~O64N*TogWys*63>rL?L4&6Lm4!9DuY=XltF`sGDt~M86rL? z!E6u8ASFpEJD%oCvurj1kvvq&g|IVF_A3=_&=!bxQy{e&_iDI+SRZr;X= zwxcI^@}lkNN#=FT?-F{Fc^~sX(mq(y@<3tj?NqA_%RN_k^m0l+7xgn9B3_U5Ge|1E z`_aqTrCmUZ^n|y*oF<#|GPk}U%*T(~`tmwArC_bp9k4^=HN5qQZ}CsHm1f)feHOcl z3rKaafC_Ie_Lxeb1Hj8jEU@lRc?OmNGVMU-^g5CdBvP2hE-o2VVg;UuDGOF`F@eE? zF6A@M$-wh4*}>wkail)jZ;ffG4nBiy4zcZNq)DITXrExS1B|9RcqL{X9HV`PNg_tm zB$3)Y!5|Uwm?p`-jF_aj6KzA%BpGUAl3GKBNjj0j(nC!$WLa2Y6($*SFiNsh%Dc9)gk9mbedbrJI5Xc$ zwt|pd;YupTfZPhgn2@`)nYShEO5q+X#P}(UM)wv zmkN>+)Gbagk$r&;e32_8F`C#HrZdR+CXn190mNuuWd{R{Ci;b`5ZFZ~Mp$}=(L}#6 zZ36wmBr2qt8w!b_5E?2hTndqyiiDIxXr?3~VWzV1pb+LcWNAS0k%PP`g~&{`tx5`E zz66EHOra1t1r)-uWZ_bXMiU7sg>W>oG#E`59u&gS#L`G1bP6a$qlu-FLO2=}qS2rb zjV78#3JIAa*2)Eiggo-zkX62|6mvr%1KzY9SGkinZO2t|y<@Vmid-doDI^=KnAs&8 ztH9sfzm~%OO+0^mxNZ=Oc=EXZgD$pG@=@d0deqZxJ?e=?GHtiKM;a4JrT0){B&lwB z&#ePL`sB`8SVABr_%5?Flqk`AN5G=Gey6Is{?f^>aVLE3MV9p$>SVd#EUu`o z-*`iHeMBm%>v!i=*KZ?6M37WJrn)|29M$zZ=Tz5ko%sZJ>epXYSs#O`tlz1stlv2K zVYV`@9b{FXxyJ{&lrFBQtlv1HvOWe=S-(4{vVLn?W&QfmP}V;`sp=ecgeQ1Nr zkDv`jt`2W=?dn^s*P+E6kGZ6vv2&;}MhTHddfz!sefi7?+&_2Kk z71w?r%Y;&mC)jkf_5yu~%+GhYp0Zt$6D^*Q6M>776Lsh0M6GE#QT=FeqVvzniI^_I zY?`GnvJpk?CHfEy?wQYVy=OclCu&RvC%X88oQO%;CzX}Zi54O`5eAbJb&<|7pDD|U z>PLbToqtwN#6%DxL=b^VMRAyG#~=eNUotTNfDAN!$Pki~=VbbjL7B_6Odm4H^dUo% zJtn{mx z&uIBOyrF9OLHrO|E6PSKpW;V@^?R;VOWN!Y?uOZ^e$N$h$!?fIPHnJ$&uBI|nPRG<{5RtXWs}maXA01 z%INi@B6(WVYJ=aMWA8BrEh?igp7?07Z$z%0!HAJMI$%Ub;Ef`S)d=by)DCtG$!Hxz zGIqz12<1^QejoR~b4W%z7?SJ^h6Fog*DD5kD)DNI7Fu8lHZ(}hddjN20V^|(YPLJyzp?j`^^h!c*-r^cb=$ZtI3Z52jkTai5HXlolN!3Ge*o5)WebXUhNm8IERiO)Ln2L@XGof0ES`G6 zu|%5GkBT&DO_MaiSl>k-fD6xoGodz$ecD)G9T~JiOXSkYppEr)l|dV{L@v6tHke~_ zNoLRnEs@JLtqsQL&;~6L+CTtLZK&A;w4r67M@5@J8;Ja=jrA3yNNu1E=Eu+m(`9Od z*)z1kgrZR-Z9;W~?gGzDv#^F|9W@oYwa9e+J^9VQR^8d>yX6xpN zlz4MSGHeazn={T~F&nKIcCR0e#iO!xbH@F+IU9Z9=1K}QbELXF%dMYfVY97%mW9o> z5|)K$#1-zloLYMxibJ>sZESETm@uxjon*^KbX#&B{o2+2f_CquvEAvrcv_q82NS&gS5kFqED(_(I@2==@X2$mnX?#G|?wB z9nmMJ(c~Ma&W&CCG7q7Hd5J!$#H3F!+SkaQV6?CE{5n{G=o9u5N4xdH!nfId9iyqH z&c5TJGyA$iA}9oggU1mCg^+0wK^PRmz*zK&6vCic78ex4kXrN!86DfpU$wUwag>W>{CsGJUgF@sGqEDm{x&-Nypb)u)ws1)y91RN5 zXi$h;g1cPc5>N<7gF@sIPzXnZLe!OgT_Ia|$#z^My@bcZC0rzrjk_He$=2me445F0 zJ>hY5Y)hB0Cp@l>ZRyCK@EAL`r2~6%Um=Au*q{d@<=gCmJM-6w(f;^KA$^>7hFi+c z%IH-Bn(p|5Xgb_jG#z_*Am3z157-&|d%(^xfLJN z?c(cbtdfkSr>;k+v1nsrz`|I34tj(di%(sTFpNbT(-YKKv@t!wFcv=u`2_pN8c_0f z6jh&+)0f|Uo|Q023EpYm@($mJm?|9pqq9WbO4^zAZNtDml1;WKb2>ZBn2u1&TBno8H?UF?@ zzMYoP%!ot4?X7V;1Jg8YEajAH*Sn)9EBQz)^#xr8CVG^iNY4eXR+4ygw+1d8HbG~qf&UJYwq zND0)Bh!OyeBT9fR7En%S!-ZXZXk-M)pnW}Q&HyH<@rEb?L~f!4*vJ8~aBEtW0GmAE za|8^UD1i=IK!8bVo%sw8SgXHEMgT^DZV|{o*gOK1Km)BLK8wK)k`W+-_7Sz6sE871 zoDd~|!9)qLMFotiH7%p69}PxzepE))smiFDXC7id^x7fX6tj~d8dW?)qgrdIQR1x{ ziJ%b>3|##aG(v)b8eyc)o(n-ENk4|9J%hV71dWhjphlPvu(LzZNYeGe8X>^|jgVV| zM$|9jRq_kc2y+m2lL#77r-_3k7^D$qFL6Z-12jU0ff`|^!=4pEBlHVsL~F^Q5&8u* z!i8qg2peHQBXA38gnj{ykXvgM#jV|{5_~^}vv0_+4H6cpS*a5Q6NjA$3)IW7R^}5* zNVqT(l|$w8Trims7PoUm_M2y&fc1jH&;$-Gx&kKur>KkS!{)tc?U;OaeTFwL;^t4l zHQE)q#^MRN2GUfy23s<~5L(l6jr!5x8t0#tYjmn&%bKNMVJr69OY{sX`b%_;ct)<# zm<+CQ@ddd?cTTR+u6zcEA6%))Dz0`?&M*knu%cKi(19n z&rYEcJiAgWC-7jMOdUtU}G#oiwyx+p#2VqYufKH)x=++-=qIZ z3OdA{o3~Qsw6;=x2)ve3? z&tJet>znI`QQrlz_HN7kgp<1yuU4#47z`G?o6@%owHr(`d(l(*I0HrGLczD*caNQt7|k zLgLNQWHX52WithIeSpod2Lu>2Sd?rA3Sq-JX#__i>FGivQP2oOLT!+dMzs2gq?$Ft zdVC-Zs1aotV%4M(F5(hlAdQGk5MdyV(A=OAhM3TZ*aYzf(g@iE@dZI6ViTYdvI)=# zgG&(xK_g5!L>NdT3`<2A1dT9g6=5Kaa5QK{d4~K!8etM5QY~mC>PaJX7T8EsxHpx0 zrz``v)^oul7e3xC%fK!DECDdd+2n`VrdxP8br;kyE%}{0Cl55%X!I0(*2q)Xi2xiK z`w~1rQXyhoz(Zc{789N$)Bg5cy6dDcIrqPXpr^NCUJVtrS^JtX-lI%@1PJpMd zjRH6_xRE?%98DI$HM8Xc`p2^Y!^V_CI|QVSni4GwQ{uChrG_cdj%BHulI)n4>M7BV zgQ;>#vSXR5rbIiIscK5HW0|U^#L+M%j>airIm=pTOGqM?eax9Sa{1j(jMSj5uz&hr zIi~4--PFx1=aHY@rsdUxIN!l-NWh-`N=VPA6-AL6?6elZ~Z*yB(4nMo5&NM^a{Fw=e~Z5qw$;`jwbSi zXT*M-Gt{vt-E-^$#?eHcEWD;8qj}cs2RRjX0b>lN0(fImXGX^}JQjuVnhM~xm&Bel zOFA=}$J-8RFcrY-N5q~$9mSj7b59hdj$)rWXc4S_v@h^%7N`U9s?@>KJ=B5HJqF|1EK&zc_fQAf6Q~312?pcQEEG+p zd#Ho#3Dgl$9g)<51A9tuSHngyoH^; z*pK}sttljVf_%A& z+igwDcDr-3U6{LUckzU5m#4*o>Vk89i^hw=WV}3D7Eg-@&GPYryy5KVSv;Wtv?OOo zTjK0!OO2vz3DZ-xq!?AeF_genOZvq`UH_4%9M!vU>_R` z;L!sL*Bc~CU!yKjR9kkfyR$}JE!?>8cJHR|7mT%CNTEFX0QR1of(j^1@t;8$(I?Yw zkzW&wJjjP#=0u-VyP{9ZEz&2L2@moCuW?26$xKJw*Hn}A34$qh{Nge+ZF#D6NS`1m z{wUZJw6$W#FKSNg$#k3S34$n|aSHPs%N_Cm4+9_;4^)wX0pRCsR$bCm4(! zzc`qx+LaEg+8FE`JYpq(fgQg%n5x>-ZC1507?1JcV619ayM6kIpbt?Ek4M%AV|?*- z(g(sm>4Q<5_&Vu>ZN7MvkM+S!LhOn3!Qhfd`B)#wL8uQV3D8Fr^r3tk`ru$BPl7%) zn8*|91Gx?L!NGWvkM+Tsh&+)#I2ap)SsxsXmG__z4#tCgtPc*x%6rg<24m&@7Jc-Y zezK2iCx($-!}_@shNH*r1w1}EIfJ*Z8AJ4vmjzObW< z4YI)Mt+%zyBE{X=WpzKLFUTNaE=z@7m6S$Mf63xDMjEu7Cq{NPMS7CzOKg^yj7 zg@f#qg;!!(_^BoFgP7XqXyPzbnfP>DCO)w!f)G;_aZ~Ne#LF$2_$!xa;v7xH%}hro zKGl?ok6o0BW6Ct~zB$ue#Nlbqv?W@h=S;(u6>82*k9nRH2})U^=1f}>g%{>5W5S$i zOfo~wS$VPuAkCSUD>KxbHJS(@&6#Oc={w`b`GD08Wm-d&JU8wWdeH|U#JL4{l{?7ouHfZ`*-35k#B zo)aI@DvOV(9|?TKTR#vV(W#1$XqNUMV*oQkIs$>h)9)uA5zmN^XiSQaK;9-kqB|!( zqFoUmQ9mX=0)vT<=$;eF)hZW@*f+}arjlu`EwDQsqUIm{5;+0PiktvuMNR;-5+{IJ zkrTkIxZeh|V)I|j3Y36mMNR;-A}4@ZkrUvo$O&Lpt zLF>%tkypY>$Q}=FL0@G0oABH8MV5y|tDznY9wc@1JUDx(0=!1xs*ipTa`ty( z{3hR5#QSLG-8q?gYg%SrKN`&Z{IfE19x{w)$|HyIClUVyW`IAT8Q@Q72KW=10se$$ zz_WP6pP+p8)V5ms^k%9Cb#=`4-BT;%7eQDc?Gj;ed_jaoxh=v1gOIS`Fz5|HIzx;_ zB^G0Ws;?M}v5R6XPB+C^%yh(9pm;CFV*HXAi*gG*8{;$)76_zBSQHjXK%y&e7@Y-P zkpmhX0gXl%b%4=H9bj})2Vw`p=!}iT4rp}7O=1Va=%fzBmT7cGTq4UfI@j=#f@BcG zE(bep85k_)GYRE-Kkk$vomd!xLFr5w#Ey6}h{|AGr`Gv0M1Z*7e)reg@2bR)L7_(s zvcc!Q10&(W56eQT0K$+epg7of&U{W>L8T+E078i?I9wA~FxAA@ARn@*0!&6!!SMxA z1!eS2#(o-zNUDHUdo<`~4j8zCSX==fszj@M+PQ%&q` zLL}|ciB~AmDjaFjWC`OZwj$M?Eo^HxUd6qENFv5gr zqvMyL5gZP#r%O^TXhgXwG{PucRE0F6pcxur_9v=B8lmBdsR$aOnTx5AM#N)~sjxUGfR^ zk*80{>?<9aJ$$17UVI$5ml84Ai|)lNP1F{wiS|PO!o6rsxEG(V4954mg0&z|XwBkQ zlvJYW_bMs*3%k#QH&Zt+zlGvpI7;Xg$^rd-=R}H>@nV;K=McQ($Dj4dM9*W4a5B*h z#zahu>oB{MkKrUDPx$THi{xaMPKn6sR7GSVU==4*KO#=1RVF8cxwH8fXD?2s9+8tl zY^{S?x^ry)#iT`)OktL4d zIX3^|U@B|ZkBO3LS9CB-caF`!IGD=XjY*wUAJ6b$77nJecI`z`GD{~P!>L0X(vot4 zv?SvoE#g5=K$HulCFKHX89PE+M3Rygl*?NEQ7|qPmU$b5MF=WkNw`2*5H1uJ;i`ls z;R0bvxIkEjwh$J9u7oAw0%1wGKv)LF5Edb_gk_N&!jf=-un`srL0AOW5|%}B2#X>) z2IHwM5|%}B2us2R!bXLMP+s1|Co-VK$GV!~kxya3iBEDh!{eSU2Bd7`mGCJHSo`@D zd~Knx(gvS`Zz^p@Vf~zea6g{{C7LFb&27n%Y~>NRpAq?ves^``Vm=ot1Rp8o|ARMMrGX#k*vF2k#%?HWZke)S$AVn z)*a7?aKvCDZE7#cx|=0gcc&`C5y$n2w5cDFb+^j0?(R8RHwKe+FGRBLc7=o^Y=p-S z(MH7C!0n6B83;!TNm@0Y5syeA$srY6wZIhLE&s3JI%T zTlhGQ8Zy$TAtQ~NGSa9aBaIp|l0~G9WPTtcjT$o2s39Ya8o&I3m>43?3--ZX1W`euoBH+TB&-Fnk>#9{n1&XJhBf zEV!FDmzdz>FR)=4*XxVBsl?=N5Yq9u7Dk~DAqssPF|f#+a+~B0!a*L_!r)!xO|>iX zW~!;aOeGD2E$KX;#gZ}P5e*~BxS5@uzbqNUQx?F3WEu^UX*BULl8mGA_#sQi zxC@eTG#$_)$uydtSs$OmrCIEYM?NJvg@t|bxMPdaCp&p@FG_L>3;W`6FADjTUqXS9 zeeqcSPEKJ-_!LIH$zGJ?6c$t)Z%-Hw8u=}BCQ9*mkoXwi*eQlbi0gNBzq{z$_>;@v zSvrLW3*6CF?aHjDnlkIdHJLS{R8f+Zj;#94C0TX;f~*?0DXX4t%c>_9MM;9Z+e5R4 zNHXhkTV{QHL7XH66Jt~D%B-iFGV8-NnKeceV^itKs^46aRp&3rsxg|Zdb%yEo>&wo ziCptnXx11_j7_;MQu6qMNJ)$)#-`d8V>8txV*~399=2BATxZU&7OT#Xkn&WxgUHB|OcSClk?pMg2&4ny)Nh!YjRm@ElEsFX1_w3_l3Z z)Ix?Y;gwcGc#S6NN5XS7F_1xc$|mYZ!qYVegvV!fzl(5%@twLzKjlal;Sm7axd@xx zal6*7lp~|hzp%t4VTlsfD8c0QpHoCI;B#cqPYvJm$aXi*kwGkg>;A4%B0e0d@X$m`GbAB^Up@0x_OFX)#0WGd10!(pc`*XrIWYq5 ziWq@~NQ?j?95Djjb7BNqWibNvBY_ck>jz>4I#n?O&CGoEV+=7N8VdUojg@_f#v}`(v9eFmSlNeYtn5QHW@iwMm3@lF%05J6Wgnt3uY+hT z>{B!r_Hkwt$*~|BgE{6b$zGVdE!s0zO7_Csanb&vD@eFe+o@?!-cPhAk4+yNZ@{v^ zYrwMlO8KNg(RYC6CX?nqvHB~w+F(Pw*bd^wz;MO79q63Rw+qaGZdb*fcGz~tWndWD zj2RXyJvdRsyq_rcQY;~G3tC(ei_myOECQx47NI*Q7NIr$O)QVZ^9inTepIf}IVaa> zoyl@xW&IU;2A|It*p;qRm1{Ikeh&RCzyZ-SDAuRB1ud?~H5w=68W>Ej(VdfPw5H`6 z^`pTx&X3A9I#szw^UMcXpQs(8XV8$}SA_k4^ zLdjqvqTErCn^XwoW+DQ)Nrg~uQX!BVISY7_Z!&{{+;SVpO}ByEbQ{Rc+y`>QYa}<_ z268j`huqAXAUE7ba?@`hH~j{3({Cs@{RVQ=Zy-1Q26D@9AUFL6a?@`hH@01d@wN16iI+Pi6l6_Ad;Zm7D<3GjwAsK=AYz_f{Dez62xK&5Cw@P$X^gk@aB?O zf=Wj$0n#Y31miWa1XE3XgmE;H1Q<;u!SMx=1m(6!0u;7=9(#1d3uu>=^6 zEP=!*;y@XR!Ke*lFsf2zKZwDYOO<_zp@58)eT%{9FqHNwhC)Y`_9X`E{wnQD3}rDY z?Mn=f1~E7q#83dK%D%*4DyGVQ5JR~W#9-YYVlc5%Xwk_GCPh-k@#?}#{4+@K-52o9q4?qZzH6tN_Lu*Mc$RR2n zIRvr|ImF?b9Ac^oE}S=%Kfui7562he59PM}0p3D?pqb&sTzZQfV!ADdfY@?~`~^A0 zn@e(tN=FU>Z;?Zc*W?gWO|bSHP5yw<+(8b9Nlvn@ zDB*B!=X$I!BwNr}ci4_C8+1L^HIgl8x3Jb|rM-qv>cSxYJft(bkMrw$gLC1jEsc}- zr=JnJi&Ij5*lC<3v4a`#R2N1dB6jMpir8tL(Wx$- zbL>xsSYuSB@A@$jJFRJ*>e8KKe=-IlDt$NJVCft4;;AlRAzo1FyLM2e@5V`%zA+e2 zb>Uzteb-+VvC}&9x#BIeBq4)YGXB6U8I53;3{E&p5;B-2Ll?}FfedEJxQ4T2n1fj| z=)o)*0%4Ynh&W3INSGzVCCn1RlV-`{HD;;M>LiQToF(Hf&XQpmX33xovy8YGV}nRx zOv2bCAyOE#^b;v?ZZvTTL<(H`79s^+yuLAoF;d|kd|t~Mkig*a>Ika7!-Ov8X)=9B zQ1x+lTiFqr#ZDiy$P=ylZuc(ECK|<^ZgW6Z;eM1g5}N_<(59gZ+B8%_n}#ZA(^Lg*8mgd8Llq<$ zsS5HjPz7xos-R6n6=WHy3i2^f1#KFtpiM&+v}vk>HVswKrlAVjG*m&GrYdODPz7xo zsvyfqRgjQ@Dwvc&6--f}3bKq;1qm6bg6RxY!Q=+2K&m5Ekdc8ZmLvLr)UNlNPN$$9UhYvQZ!6nn8aX>)BQJb6&wx%(xe0Z zSa|e%Dg8q18Ga@948JTw&G;p$wN6#M6MsqG3BQcOFQJKk9tdy8u4vf6-}{e-lV)ia)SjPIT3f+~M zg>J;mJn)5~*={Z>!neCB-Q_kb-3T;z;tRt%Rl2KP@i*lb`5VMMJn)49p$gqI9q~7( zmvrFE*hO|MNC7qyPmIV%W~&bC{5#BTPsO=0v+_LX3QP;)*B4 zNJX@ZCd43&2d;QR4AEG8#%MZlMH7nFCxpk(_I3;&NR}{|=qF1U=O<(dm+bVDC0tt9 zPnIx8i@U~`vybNZ5C>L+txL;onFYWajzr>1mUys5a z?uTc4yZhO!zxO9wN z+0a(#{^P0LT=|AsZrM#TIol1~7mg5mlKc279ofO@CE3Bt7i9-{FtUS6EIZirXXL4* zE&Ula%p-mz{rCXKEEf8hksU}lsMK?x52{^$G}^?ht(#@B5q zoS!M+Sl;lO=#1{1=!{nX>*NBubK(NR>+6f^AH}-i6bd=@O{?fp*m>`GsHIc9-5vGi z+t>=V9S^mBJ5vgU2T~NI2tib^N5cpPtDUL}_RZ3Fu+JOvuwIWy@0ooJbK@Bm>>HCR z*n@3R!M;1Ef_=N9g8f3If<1yw73{m`RIqQARj{ugQNbR3n+o>K`VfgOo%*FBbFCLy zug73d|Dy8685QgslPcI_Fcs{XTO!_VS5&ZP-l+udM=IDeD`oaqewgc+n6V}atn*pK z*h|Q6nMJ;+XO94vR90NEIwGorb$qCU0V~wO@D=Jn2uF1=wxv24>Ovh1e4!53@u?2h z@u3a|$xsJE=CuX3i(}~h1(xxl4P}gFmGPmCkWT*K(@Az2w4u!NMON{p4dtaXD&s>N zN?M_fB!>;!Nb*~2BguY)Hj>OZNtB&82W=>)eo^cfv_bZ3T^sl~e?oCF<70-fjF;I) zn(^~i?AT7leXbZ}!pkLAcT?P__hI`HN~lkvY>{G`vK4)`4I4&kSd8quX2a0acz24K z9Nk7)opU_c2{XQs^vG?_BOP>h7!oA3R0p#|ub~lrh5h81S0c4)Aj@Q;b&y^|X6Ki= zDU2B@ld=JF+`==wMz)R+e_heD8Lo(xBb>8+LsG9=@FM`KWCz_|}H0 z-1*@w@1j=!+5!eGw_(YMcJVJt*BE+Yy$xKL${p0|Z~k~*Rr%K!Rh8$eK~&}O=c>w& zT~t;6bW>INnU1RR$k0@kAHSrke7S{2jjVaAD39DuMft*_it^KK73EQ~XHlMc;a-N_ zr<}MS05o0cMsHi>k^` zBhN(IiRr5%KBlo6pfh-&guhT?nH{XPPG89XyC@*EOVy~jSl%cFbMR_TMDF>7h zNf}YFjOfW7tMUw|@3bn4|@f-H0vxr1bpv(OzZ3!MeB&{^aUK^8iT{6VtthH{4>3!R0}W#X>wm`m_@ zdKih_L3U}-j#L{9{n_4{%(YrI?A{K0xv|y>yO`Jac_S3$wr|iP+ystQQrr^GjsoYORW+R( z#zBj4`}p7hJm;QY@+wke02ZmaGdhg0zHK^;z|a#Ta2*zRSbGE(sk#3;j1Uzb`5qo+ z(#Vc{3GD9{zJ!f~lZ_`ZG&HgAVsdwUq|Z*rmfYnDL7Q&J2WF0L%LgVhBs?&@6C0#c zH!nO_xbHZQkgyzBYsO=N7T31n2%gq9aV6AVkC2_|3A1Y%ZdA}mb&v1kxzf@vEx!7PrNAPoXdFcfYSNrO-o z>#H9THbWH*qM-`J)Ko>-3qL9vgj?f-D!gkxr~-!q-Q2+)`dJXVLq7|Gk6M(QGg?AL z`jCwTxU`DVFg{Wh9WzR1w2YuaYZ{roF^fYSp{y=pK@d71`i7z6voP?4cq;txIi?RE z*)l$+m`M1uY$v|?KYqE8?xu7%*%R(3d#WE3uhyC-uLi}-pm1LqRO5sUDz1oE17|E= zt#(ib)i^1GVyOa|I!K!0O%0+2g2=GBZVrR+QDG21Dh!gO=FHSFh!Xb`dQ=!h=??}` zl7CQ-3WFpCfG|iD20@;)y+)ZIZ^0|2yV$b}*YE48w$Y+(j0@56JqVp@%a8g;p@BAu zA9f$WU$QNkwrgKu^_^Rlu}EtQTe;CiQX{>+2V<=#45NI?6KO#Z6Rt7X$xuwT2eo2o3VUtLZ8LT-%u5%h| z+0bcX>>|#&5hW%Pq!NooJB3wn2=XwikFse61``P~jg?Nn#C8&*(J-1w5UvA4Hdbzt z1i`cAfh^#=u%ZwP3}>*O3M2^E>0$BV*hTjBqVys`DlthAJYF8i!qL95zU|w)z|jd| z0(-&{{6ZHheoMRS+K8x)C}@KlGRS}gZHSK(hbL{2EPyr`HOiKPHfVlgK%@;OXFT ziUTk}Bp5P4rpqwE!h%>h*sNGMrq<}7!9*Jd$g~><2%8Z3!lWGb#}pm*$AlgB2b+-n z>ErPPQhSfj=Z5ilYLhrGSjk>?nF!<4CiTcQzN|!~m&T`+=#guDal~SAG(PAujvopJ zc;aDvj)o`RH-6uSxWQ+%9Yf`3l>Xk&AK9}LnUjz}3GVd%zhuAHDjHUc2hP~Jb+d!2 z&l{A|G%6GQgwVfRNMAwQNXEy%K)NEHAziW7-~l(>NkF!OH%ybRXk(2N=!(S?qAS2u zX@3FNLm{1OO^dFm9}RTH`DaO2bo%elxEJ?l6x_hlY!84KSp#t85C$LvfB_IsBl>yn z!DN+D7=R1_1|a8!WRMI%7=Wv7xbL577~@Z_#$jK8!KL@>)%iz2Dc$!J=@RJUU2|c5 zo2YoZ_m~Ugei-l_e9)V=*A(uXpddvE@&x-DqZv9f7(UHk`oe<4zpAH+&gvOkiwb-aWhw|Z*SNgv0=~sGVg}vZPRiBWPoyl^P_SCtaT&R)jIPSPXw;N zLLZ<-e1luMI#oGAddm4wh(I7>Cxyad1ZU#)hTAr^c=% z38%@Y#;bYytTI--&Ul2m#&6%jXb@>rP|~L{#@1WF}40@bp94T?dH=zDWJbupE#=SbKM-8 zbaPD;iu({s#eFUT!yXo{e@fPeVQ0P8iy?63YAMiVTsxJlE%Q<{XNJAF^mOX@v<6 zw4z0Aq6wrG8lh+c#Mo@+WvzrYWava8t$2Z%*PC(m8MVR`Ogur*N?54|+DuyEXrc*% zR+!p}CXiN?i9svM%%Bw}YS0QsqgIr~K`SH?M4L$~yrH}#XoVz#yhK`&50N&rR_H@= z6KW+2TEUS@p(hy^lqEgM2KTcJGG~K~0~fNfe+E;#?HC8TBp1kWp&V-{gZo+5nX@5m zC3|=xxa1v>!|%jTKaB;$>m$fZ*t7#)Qt8M`K)=dM#%uDDspdW|o~zOvx&=|b|7N-QtIXP>;}<%{x?(^%Mf>kRlQh8ggA%Ob-JU_hJ!>sOco zpSKJW&l@w~vPH~*<|^VU%s}Rf8PHs1k(zIma9H0*$RvFj&wbdP)c<;K;Wcst2x#srZu$*t<@`-lc(jW|pC_Rd?q7pF zAUN6S*q%AnZlBv28P~`|P-jF|f>-;Rzy%^|%Z6NiyvBQYKP-$qS3tY{TZHN193X0< zQ{@3bsOvr}mZW}EEJU> zAVw0RNop^NCTW&PlVCKSp~BHblhlujCTUIU5EUNo_+gDEnq=WMmbLLfc!&y>`6a|W zRHy3NjY-zEF&a-%;b^LB*Ip7)(kziE!Du{0g`=siT|Y{qq&1CGRHzS}0o3O)<@p%28mFfy@m&O+T&UVK4h3G@N7g!%~0$Da{d z0(~IBM!-+9g!<4?rqBn;66k|u3G~5JTX^84^+B=(`alJq`e6G9>I1Qv^uZE5^Z~Yn z`p_|#&a6gge+l4uY@e&fiL}J3BFww7A9oLgXj>`PnN)5Q)}q;0yV7r zLf-*CKY3xpx3(mCOYpitB;NkWuD<(i_Ej*8KY5|B`+F(PK}HQnkWnw9K{y^_8|}iu z{UQF&(5hjYwCc6Sr^)@rGvfYWnd1Ixhh)^vl8m}jl~Kbo#nsf0%BI=Q9M7you=tKUTOb*kf$zi%A z=r~;+%8KdI<}h8@9HtwE=^~%J)r7X=+jcUces%~U2l7ZfKAah}mP-8;{}%Ocq<`^J z;enfMunaTFlSIKcC4Ri6XBMsl>4CK!_|C(d@CBH>xaAQ*?@0?Td7zu*y3O!Po~=>PcRryMd4tdPJL8~nb?zZ zTgTZSU*M@I98JaRYFF&ZR8yy-9Io+H6!vpd@w(E{arSR6=~R^b1@_qDXewS$<8an{ zIojjsF^#NmLlul)!JJ4H3O+=gNEM7kMZ*PEFsc!CB2_S`fhrV|i#m}i7yywv393*u z3{@~#B6Si}!E}%vx2y`5#>t!nRVWIEDijrqI*}?k8V_5sDmWFWf}`oM6{$k&&s0a3 zDma=BTahX>n(F9M1xJG_qFYn}`zMdc^L~`}+nIiyW^JPTK!CA0~fZ!yLu zZIYb#!&N^l$@9FQe%gfR{V;mtrV-L6Jntu=P1e?qr?R*6t`?r&mXzY*KK7QIO*Wjh zkMSI26uA(q|90}=&CXibg&C1(l)+D+H9Y7-7>4LVcEHA_yK+kg|H>sAJjpJxg)``# z4YrVne!}1n<5W@@JbXlK4G#zfTX+h`g?@55om2PREZ$l7U3fi=tdBMwkcJLSQu=v^)mG?*AZiNL|g z@C6aVajl66efGBHYtl{T?;#zLs4_ zNj&tQzJa1u?GRslYlC*0#5F=E{ENs0RkqN;?lr!8;r6r>%e?E{%gxJwSlInkN`s4E zXibY>s2>gd!ue;#FR-&V3hK>LhQ~G54v}8qR6d&YH6-Xe0~+DqgY`sc~QKjz88Kjx{z zKjz88KbvBQd8%RdA=dphPZs{!PCLv~g@4Qwg@4VHv=}>ahk3H{&v~-)k9o54k9o54 zk9n%{k9o54&vxHoo{{Fs!he`2^Ms^t)nM_SO|g@$EiB%%tMKi}vrWbO-4n=sQFQqU z9``$IVz?Dy78tI+o``weexoO%NCL1jcu~7!0!i?yta0FWfiU9{Nt+2X*xmZkGB+=u zFWiH$_5O(>WC^{c!5Oj7bkcSjWqo#`et?fg^Z`3myO}fT1NN^*S)bjkQPyW~Yqf#S zi9TTGYn1huPJRJdIOri#Xk={ma;FS?X2W*aK^vqIIw;7-yXdbC+hMnD*m(VzY#dU{ z#yeGUXst6JLX`mYkW3u(kW8FCykmWkJo%ES|uL{LfSMIBT^8Vw|tm=1QW4k`iD!G_k>2#F4MyAB#5(ZNpG)(D9X z_Q?(!Q4j4G$)ZUk^d@%L4jQ31Q6uywXoTLx-rPYW^d@SA-UN-%o1hW3_+NcGEBY&w3gn2^N_A=5});jPyCEpgdtjkJnP$zuzS7maEf%qOhE#xIGED7Txa8q=| zVe|t)OD%4O|2A(ZHUhH|8}S-8&WE-FU?Vi8B2FaLlo*|HN+b%z1!zhP;jL-Ji$p)DI zjRRYi@wpG4sSTG(u9xv2PT?>mm>8)vM8kM6?_lQ_6Epm!NVtE9!Z*ec8-2b zTWNlYpOP@C*B9|Q&@7?EQo*}mmZ-fTQRQmcw|)SBfBE7E_|fuZ?v@XqH8evq`RCC8 z5)VS1EPsSA%kfJvaPjmsBo@2|5Wz_mI%P2}A$VgTp$VhH3$f#u8GO`;) zkdYlw{0*}%qqsWD$VF*E#$qBP4oA90My4`iBqXB}U2$ZRky)@933dhmMTTmD7zxS9 zBm*+i>L8<%YY`HXF-m0A8aB%)(jv%6-Xh2dleUZ++%l5E2r{zcgTFJ@Wt2l%Mmp7f z_@Y5e9zRB$ul^KDt52wbLO;r`c>4JIi%o_;CdZb_U{CjOx3UnDt$Jdhrki(!jg0ZsBb#O;CaNY+DDrA79`p3j9`6 zy{p<)fp@B@W3R_+JVb$QZB*}?>8QYadP#>UynK-5s%#cKdQ!Z`4 zDM?s3<&g-Mgdg>)&q@-q);tlxl5i}Rz3_3Z6A>hdMpM~Kl5jMhh+s+d-JrUcB;ja0 z4BL`$G)V$0;$GXNy2>zwO|4j6O^!B5c4_eRkN)Z^!<+uMB3=lj;_~4Y(*B zcB!i7mJ~!^r>iX~11+ppkrWSWi%wTC34GRXR7nT#w`GT)ySg8Vw98~$V8@W7*gL); zo&qC_r>J&i$5Tz&@pw&kj4yWa6qSz5_)UD{euV{9nK6t}W?YG7#uJO;DInj6XvZ*p z*>SloJ3hW3q5`9-Zd>ijj;ETkY7d@?3_{wU<}`q%@yk1u&jb1+Xz0Du5SXU1ZIH`0!J+HL0}g6ATSGj5SZ~Z1V(*N z0<*vefmz^#z$)-TU=;WyFe`izm=!(<%yKyej!@x)z^w2=U{?4buqu2Im=!(<%yKyd z#_}Tyi~^qoW`z#|v%=SyWQ8vXoOFz0tjm~}$3bkhx_YpZ$0a&kW5G4?jIkMObII9#_Pz?@4(GrD*)W_B$}Yjk@M?>X@F2ic@7g;rrXXG=DN%;(_!Sb2zoP4HTkP}0rnZheBw-jaP3XLtZrWTMhm)e7hj=