├── .github ├── .gitignore ├── workflows │ ├── pr-document.yaml │ ├── R-CMD-check.yaml │ └── pkgdown.yaml ├── ISSUE_TEMPLATE │ ├── 01_bug_report.yml │ └── 02_feature_request.yml └── pull_request_template.md ├── .Renviron ├── vignettes ├── .gitignore ├── generate-closure_power_benchmarks_holm.csv ├── generate-closure_power_benchmarks_fixed_sequence.csv └── generate-closure_gw_benchmarks.csv ├── R ├── graphicalMCP-package.R ├── edge_pairs.R ├── plot.updated_graph.R ├── power_tests.R ├── print.initial_graph.R ├── print.updated_graph.R ├── as_graph.R └── graph_rejection_orderings.R ├── misc ├── build_vignettes.R ├── table_1.png ├── parents_pattern.xlsx ├── vignettes │ ├── images │ │ ├── table_1.png │ │ └── six-graph.png │ ├── data │ │ ├── power_results.rds │ │ ├── power_timing.rds │ │ ├── df_benchmarks_gw.rds │ │ ├── df_benchmarks_seqtest.rds │ │ ├── test-power-2011_t1-target.rds │ │ ├── df_benchmarks_power_closure.rds │ │ └── df_benchmarks_power_shortcut.rds │ ├── cache │ │ └── cache_deb16b0206d94157c3e9c6b0da524951.rds │ ├── performance_files │ │ └── figure-html │ │ │ ├── df-benchmarks-gw-1.png │ │ │ ├── df-benchmarks-power-1.png │ │ │ ├── df-benchmarks-seqtest-1.png │ │ │ ├── gg-benchmarks-memory-1.png │ │ │ ├── gg-benchmarks-runtime-1.png │ │ │ ├── df-benchmarks-power-closure-1.png │ │ │ └── df-benchmarks-power-shortcut-1.png │ ├── log │ │ ├── pwr_short.log │ │ └── pwr_clos.log │ ├── performance_cache │ │ └── html │ │ │ ├── example_0e06d83ca7a13195eb90408aa42fe0c4.rds │ │ │ ├── example_33c6e639d4d1301d42282dbdfb87e8f7.rds │ │ │ ├── example_a6db43c58f9295d061e7cd4282090f4f.rds │ │ │ └── example_deb16b0206d94157c3e9c6b0da524951.rds │ └── testing-power-basics.R ├── papers │ ├── graphicalMCP-papers.zip │ ├── SiM_Optimal_weighted_Bonferroni_tests_and_their_graphical_extensions.pdf │ ├── Biometrical J - 2017 - Xi - A unified framework for weighted parametric multiple test procedures.pdf │ ├── Statistics in Medicine - 2016 - Lu - Graphical approaches using a Bonferroni mixture of weighted Simes tests.pdf │ ├── Statistics in Medicine - 2008 - Bretz - A graphical approach to sequentially rejective multiple test procedures.pdf │ ├── Statistics in Medicine - 2019 - Xi - Symmetric graphs for equally weighted tests with application to the Hochberg.pdf │ ├── Statistics in Medicine - 2011 - Bretz - Test and power considerations for multiple endpoint analyses using sequentially.pdf │ ├── Biometrical J - 2011 - Bretz - Graphical approaches for multiple comparison procedures using weighted Bonferroni Simes or.pdf │ └── desktop.ini ├── file-dump │ └── test_graph_shortcut_comments.docx ├── check-p.R ├── read_log.R ├── Table_1_weighting_scheme.R ├── xi_2017_3.R ├── plot_networkd3_2.R ├── README.txt ├── plot_networkd3.R ├── calcWeight.cpp ├── background_misc.R ├── parametric_3.1.R ├── power-outline.md ├── plot_igraph_complex.R ├── temp.Rmd ├── generate_weights_performance_comparison.R ├── test_input_brainstorm.R ├── test_update.R ├── plot_ggraph.R ├── check_generate_weights.R ├── examples.R ├── functions │ ├── fun_common_c.R │ ├── fun_separate_c.R │ └── fun_miscellaneous.R ├── renderer.R ├── plot_igraph.R ├── gMCP_examples.R ├── Table_4_5_local_significance_level.R ├── Table_2_adjusted_p_value.R ├── bonferroni_sequential.cpp ├── abstract.md ├── Table_3_simulation.R └── power-pseudocode.Rmd ├── man ├── figures │ ├── logo.png │ ├── README-create-graph-1.png │ ├── README-plot-graph-1.png │ ├── README-update-graph-1.png │ └── README-plot-updated-graph-1.png ├── edge_pairs.Rd ├── graphicalMCP-package.Rd ├── print.initial_graph.Rd ├── print.graph_report.Rd ├── graph_test_fast.Rd ├── print.updated_graph.Rd ├── print.power_report.Rd ├── as_graph.Rd ├── graph_rejection_orderings.Rd ├── graph_generate_weights.Rd ├── input_val.Rd ├── plot.updated_graph.Rd ├── test_values.Rd ├── graph_update.Rd ├── adjust_weights_parametric_util.Rd ├── adjust_p.Rd ├── graph_test_shortcut.Rd └── graph_create.Rd ├── pkgdown └── favicon │ ├── favicon.ico │ ├── favicon-16x16.png │ ├── favicon-32x32.png │ ├── apple-touch-icon.png │ ├── apple-touch-icon-60x60.png │ ├── apple-touch-icon-76x76.png │ ├── apple-touch-icon-120x120.png │ ├── apple-touch-icon-152x152.png │ └── apple-touch-icon-180x180.png ├── tests ├── testthat │ ├── Rplots.pdf │ ├── test-edge_pairs.R │ ├── test-as_graph.R │ ├── test-print.initial_graph.R │ ├── test-print.updated_graph.R │ ├── test-plot.initial_graph.R │ ├── test-plot.updated_graph.R │ ├── _snaps │ │ └── print.initial_graph.md │ ├── test-adjust_weights.R │ ├── test-graph_generate_weights.R │ ├── test-print.power_report.R │ ├── test-graph_update.R │ ├── test-power_tests.R │ ├── test-print.graph_report.R │ └── test-graph_calculate_power.R └── testthat.R ├── CRAN-SUBMISSION ├── inst ├── hex-graphicalMCP_square-white.png ├── CITATION └── WORDLIST ├── .gitignore ├── graphicalMCP.Rproj ├── .Rbuildignore ├── NEWS.md ├── NAMESPACE ├── man-roxygen └── references.R ├── DESCRIPTION ├── cran-comments.md ├── _pkgdown.yml ├── README.md └── README.Rmd /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.Renviron: -------------------------------------------------------------------------------- 1 | _R_CHECK_SYSTEM_CLOCK_=0 2 | -------------------------------------------------------------------------------- /vignettes/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | *.R 3 | -------------------------------------------------------------------------------- /R/graphicalMCP-package.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | "_PACKAGE" 3 | -------------------------------------------------------------------------------- /misc/build_vignettes.R: -------------------------------------------------------------------------------- 1 | usethis::use_package("tibble", "Suggests") 2 | -------------------------------------------------------------------------------- /misc/table_1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/misc/table_1.png -------------------------------------------------------------------------------- /man/figures/logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/man/figures/logo.png -------------------------------------------------------------------------------- /misc/parents_pattern.xlsx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/misc/parents_pattern.xlsx -------------------------------------------------------------------------------- /pkgdown/favicon/favicon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/pkgdown/favicon/favicon.ico -------------------------------------------------------------------------------- /tests/testthat/Rplots.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/tests/testthat/Rplots.pdf -------------------------------------------------------------------------------- /CRAN-SUBMISSION: -------------------------------------------------------------------------------- 1 | Version: 0.2.8 2 | Date: 2025-05-07 03:10:43 UTC 3 | SHA: 86213d2cf7bf8a29ac608260f2fd935e7fc2fd7d 4 | -------------------------------------------------------------------------------- /misc/vignettes/images/table_1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/misc/vignettes/images/table_1.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon-16x16.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/pkgdown/favicon/favicon-16x16.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon-32x32.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/pkgdown/favicon/favicon-32x32.png -------------------------------------------------------------------------------- /man/figures/README-create-graph-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/man/figures/README-create-graph-1.png -------------------------------------------------------------------------------- /man/figures/README-plot-graph-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/man/figures/README-plot-graph-1.png -------------------------------------------------------------------------------- /man/figures/README-update-graph-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/man/figures/README-update-graph-1.png -------------------------------------------------------------------------------- /misc/papers/graphicalMCP-papers.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/misc/papers/graphicalMCP-papers.zip -------------------------------------------------------------------------------- /misc/vignettes/data/power_results.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/misc/vignettes/data/power_results.rds -------------------------------------------------------------------------------- /misc/vignettes/data/power_timing.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/misc/vignettes/data/power_timing.rds -------------------------------------------------------------------------------- /misc/vignettes/images/six-graph.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/misc/vignettes/images/six-graph.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/pkgdown/favicon/apple-touch-icon.png -------------------------------------------------------------------------------- /inst/hex-graphicalMCP_square-white.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/inst/hex-graphicalMCP_square-white.png -------------------------------------------------------------------------------- /misc/vignettes/data/df_benchmarks_gw.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/misc/vignettes/data/df_benchmarks_gw.rds -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-60x60.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/pkgdown/favicon/apple-touch-icon-60x60.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-76x76.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/pkgdown/favicon/apple-touch-icon-76x76.png -------------------------------------------------------------------------------- /man/figures/README-plot-updated-graph-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/man/figures/README-plot-updated-graph-1.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-120x120.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/pkgdown/favicon/apple-touch-icon-120x120.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-152x152.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/pkgdown/favicon/apple-touch-icon-152x152.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-180x180.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/pkgdown/favicon/apple-touch-icon-180x180.png -------------------------------------------------------------------------------- /misc/vignettes/data/df_benchmarks_seqtest.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/misc/vignettes/data/df_benchmarks_seqtest.rds -------------------------------------------------------------------------------- /misc/file-dump/test_graph_shortcut_comments.docx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/misc/file-dump/test_graph_shortcut_comments.docx -------------------------------------------------------------------------------- /misc/vignettes/data/test-power-2011_t1-target.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/misc/vignettes/data/test-power-2011_t1-target.rds -------------------------------------------------------------------------------- /tests/testthat/test-edge_pairs.R: -------------------------------------------------------------------------------- 1 | test_that("multiplication works", { 2 | expect_equal(edge_pairs(simple_successive_2()), list("H2|H1", "H1|H2")) 3 | }) 4 | -------------------------------------------------------------------------------- /misc/vignettes/data/df_benchmarks_power_closure.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/misc/vignettes/data/df_benchmarks_power_closure.rds -------------------------------------------------------------------------------- /misc/vignettes/data/df_benchmarks_power_shortcut.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/misc/vignettes/data/df_benchmarks_power_shortcut.rds -------------------------------------------------------------------------------- /misc/vignettes/cache/cache_deb16b0206d94157c3e9c6b0da524951.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/misc/vignettes/cache/cache_deb16b0206d94157c3e9c6b0da524951.rds -------------------------------------------------------------------------------- /misc/vignettes/performance_files/figure-html/df-benchmarks-gw-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/misc/vignettes/performance_files/figure-html/df-benchmarks-gw-1.png -------------------------------------------------------------------------------- /misc/vignettes/performance_files/figure-html/df-benchmarks-power-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/misc/vignettes/performance_files/figure-html/df-benchmarks-power-1.png -------------------------------------------------------------------------------- /misc/vignettes/performance_files/figure-html/df-benchmarks-seqtest-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/misc/vignettes/performance_files/figure-html/df-benchmarks-seqtest-1.png -------------------------------------------------------------------------------- /misc/vignettes/performance_files/figure-html/gg-benchmarks-memory-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/misc/vignettes/performance_files/figure-html/gg-benchmarks-memory-1.png -------------------------------------------------------------------------------- /misc/vignettes/performance_files/figure-html/gg-benchmarks-runtime-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/misc/vignettes/performance_files/figure-html/gg-benchmarks-runtime-1.png -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | /docs/ 6 | /perf-tests/log 7 | /cache 8 | *.html 9 | inst/doc 10 | /doc/ 11 | /Meta/ 12 | *~$*docx 13 | *~$*xlsx 14 | *~$*pptx 15 | -------------------------------------------------------------------------------- /misc/vignettes/log/pwr_short.log: -------------------------------------------------------------------------------- 1 | 4 | 2023-07-30 19:29:53 2 | 8 | 2023-07-30 19:30:03 3 | 12 | 2023-07-30 19:30:19 4 | 16 | 2023-07-30 19:30:47 5 | 20 | 2023-07-30 19:32:02 6 | 2023-07-30 19:43:11 7 | -------------------------------------------------------------------------------- /misc/vignettes/performance_files/figure-html/df-benchmarks-power-closure-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/misc/vignettes/performance_files/figure-html/df-benchmarks-power-closure-1.png -------------------------------------------------------------------------------- /misc/vignettes/performance_files/figure-html/df-benchmarks-power-shortcut-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/misc/vignettes/performance_files/figure-html/df-benchmarks-power-shortcut-1.png -------------------------------------------------------------------------------- /misc/vignettes/performance_cache/html/example_0e06d83ca7a13195eb90408aa42fe0c4.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/misc/vignettes/performance_cache/html/example_0e06d83ca7a13195eb90408aa42fe0c4.rds -------------------------------------------------------------------------------- /misc/vignettes/performance_cache/html/example_33c6e639d4d1301d42282dbdfb87e8f7.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/misc/vignettes/performance_cache/html/example_33c6e639d4d1301d42282dbdfb87e8f7.rds -------------------------------------------------------------------------------- /misc/vignettes/performance_cache/html/example_a6db43c58f9295d061e7cd4282090f4f.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/misc/vignettes/performance_cache/html/example_a6db43c58f9295d061e7cd4282090f4f.rds -------------------------------------------------------------------------------- /misc/vignettes/performance_cache/html/example_deb16b0206d94157c3e9c6b0da524951.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/misc/vignettes/performance_cache/html/example_deb16b0206d94157c3e9c6b0da524951.rds -------------------------------------------------------------------------------- /misc/papers/SiM_Optimal_weighted_Bonferroni_tests_and_their_graphical_extensions.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/misc/papers/SiM_Optimal_weighted_Bonferroni_tests_and_their_graphical_extensions.pdf -------------------------------------------------------------------------------- /misc/vignettes/log/pwr_clos.log: -------------------------------------------------------------------------------- 1 | 2 | 2023-07-30 22:10:35 2 | 4 | 2023-07-30 22:14:13 3 | 6 | 2023-07-30 23:01:25 4 | 8 | 2023-07-30 23:09:32 5 | 10 | 2023-07-30 23:18:00 6 | 12 | 2023-07-30 23:28:02 7 | 14 | 2023-07-30 23:47:25 8 | 2023-07-31 00:56:00 9 | -------------------------------------------------------------------------------- /misc/papers/Biometrical J - 2017 - Xi - A unified framework for weighted parametric multiple test procedures.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/misc/papers/Biometrical J - 2017 - Xi - A unified framework for weighted parametric multiple test procedures.pdf -------------------------------------------------------------------------------- /misc/papers/Statistics in Medicine - 2016 - Lu - Graphical approaches using a Bonferroni mixture of weighted Simes tests.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/misc/papers/Statistics in Medicine - 2016 - Lu - Graphical approaches using a Bonferroni mixture of weighted Simes tests.pdf -------------------------------------------------------------------------------- /misc/papers/Statistics in Medicine - 2008 - Bretz - A graphical approach to sequentially rejective multiple test procedures.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/misc/papers/Statistics in Medicine - 2008 - Bretz - A graphical approach to sequentially rejective multiple test procedures.pdf -------------------------------------------------------------------------------- /misc/papers/Statistics in Medicine - 2019 - Xi - Symmetric graphs for equally weighted tests with application to the Hochberg.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/misc/papers/Statistics in Medicine - 2019 - Xi - Symmetric graphs for equally weighted tests with application to the Hochberg.pdf -------------------------------------------------------------------------------- /misc/papers/Statistics in Medicine - 2011 - Bretz - Test and power considerations for multiple endpoint analyses using sequentially.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/misc/papers/Statistics in Medicine - 2011 - Bretz - Test and power considerations for multiple endpoint analyses using sequentially.pdf -------------------------------------------------------------------------------- /misc/papers/Biometrical J - 2011 - Bretz - Graphical approaches for multiple comparison procedures using weighted Bonferroni Simes or.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/openpharma/graphicalMCP/HEAD/misc/papers/Biometrical J - 2011 - Bretz - Graphical approaches for multiple comparison procedures using weighted Bonferroni Simes or.pdf -------------------------------------------------------------------------------- /misc/check-p.R: -------------------------------------------------------------------------------- 1 | i <- 1 2 | 3 | while (TRUE) { 4 | cat(i, "\n") 5 | p_sim <- stats::pnorm( 6 | mvtnorm::rmvnorm(1e6, rep(0, 15), sigma = matrix(1, 15, 15)), 7 | lower.tail = FALSE 8 | ) 9 | 10 | if (length(p_sim) != length(unique(p_sim))) { 11 | stop("found a duplicate") 12 | } 13 | i <- i + 1 14 | 15 | } 16 | -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | citHeader("To cite graphicalMCP in publications use:") 2 | 3 | bibentry( 4 | "manual", 5 | title = "{graphicalMCP}: Graphical multiple comparison procedures", 6 | author = as.person("Dong Xi and Ethan Brockmann"), 7 | edition = "version 0.2.6", 8 | year = 2024, 9 | url = "https://CRAN.R-project.org/package=graphicalMCP" 10 | ) 11 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | # This file is part of the standard setup for testthat. 2 | # It is recommended that you do not modify it. 3 | # 4 | # Where should you do additional test configuration? 5 | # Learn more about the roles of various files in: 6 | # * https://r-pkgs.org/tests.html 7 | # * https://testthat.r-lib.org/reference/test_package.html#special-files 8 | 9 | library(testthat) 10 | library(graphicalMCP) 11 | 12 | test_check("graphicalMCP") 13 | -------------------------------------------------------------------------------- /tests/testthat/test-as_graph.R: -------------------------------------------------------------------------------- 1 | if (requireNamespace("gMCP", quietly = TRUE)) { 2 | test_that("round-trip graph coercion - gMCP", { 3 | g <- random_graph(11) 4 | 5 | expect_equal(g, as_initial_graph(as_graphMCP(g))) 6 | }) 7 | } 8 | 9 | if (requireNamespace("igraph", quietly = TRUE)) { 10 | test_that("round-trip graph coercion - igraph", { 11 | g <- random_graph(11) 12 | 13 | expect_equal(g, as_initial_graph(as_igraph(g))) 14 | }) 15 | } 16 | -------------------------------------------------------------------------------- /tests/testthat/test-print.initial_graph.R: -------------------------------------------------------------------------------- 1 | test_that("snapshot print method", { 2 | expect_snapshot(graph_create(c(.5, .5), matrix(c(0, 1, 1, 0), nrow = 2))) 3 | expect_snapshot( 4 | graph_update(graph_create(1, matrix(0, nrow = 1)), TRUE)$updated_graph 5 | ) 6 | }) 7 | 8 | test_that("print default title with no title attribute", { 9 | no_attr <- graph_create(c(.5, .5), matrix(c(0, 1, 1, 0), nrow = 2)) 10 | attr(no_attr, "title") <- NULL 11 | 12 | expect_snapshot(no_attr) 13 | }) 14 | -------------------------------------------------------------------------------- /misc/read_log.R: -------------------------------------------------------------------------------- 1 | library(vroom) 2 | library(vctrs) 3 | library(purrr) 4 | library(ggplot2) 5 | library(rlang) 6 | 7 | marks_list <- 8 | fs::dir_ls( 9 | "./perf-tests/log/", 10 | regexp = "bh.*_no-gmcp_2023-01-31.*" 11 | ) |> 12 | map(\(x) vroom(x, "\t", col_types = "ncnnnnnnnnllll")) 13 | 14 | marks <- vec_rbind(!!!marks_list) 15 | 16 | marks 17 | 18 | gg_marks <- ggplot(marks) + 19 | geom_point(aes(size, median, colour = expression)) 20 | 21 | gg_marks 22 | 23 | gg_marks + scale_y_log10() 24 | -------------------------------------------------------------------------------- /tests/testthat/test-print.updated_graph.R: -------------------------------------------------------------------------------- 1 | hypotheses <- c(0.5, 0.5, 0, 0) 2 | transitions <- rbind( 3 | c(0, 0, 1, 0), 4 | c(0, 0, 0, 1), 5 | c(0, 1, 0, 0), 6 | c(1, 0, 0, 0) 7 | ) 8 | names <- c("H1", "H2", "H3", "H4") 9 | g <- graph_create(hypotheses, transitions, names) 10 | 11 | test_that("snapshot print method", { 12 | expect_snapshot(graph_update(g, integer(0))) 13 | 14 | expect_snapshot(graph_update(g, c(FALSE, FALSE, FALSE, TRUE))) 15 | expect_snapshot(graph_update(g, c(1, 2, 4))) 16 | }) 17 | -------------------------------------------------------------------------------- /graphicalMCP.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --preclean --no-multiarch --with-keep.source 21 | PackageRoxygenize: rd,collate,namespace,vignette 22 | -------------------------------------------------------------------------------- /tests/testthat/test-plot.initial_graph.R: -------------------------------------------------------------------------------- 1 | test_that("plotting throws no error", { 2 | graph <- graph_create( 3 | c(pi / 10, 1 - pi / 10, 0, 0), 4 | rbind( 5 | c(0, .5, .5, 0), 6 | c(.5, 0, 0, .5), 7 | c(1e-5, 1 - 1e-5, 0, 0), 8 | c(1 - 1e-5, 1e-5, 0, 0) 9 | ) 10 | ) 11 | 12 | expect_no_error( 13 | plot( 14 | graph, 15 | edge_curves = c("pairs" = .05, "H1|H3" = .25), 16 | precision = 6, 17 | vertex.size = 35, 18 | eps = 1e-4, 19 | background_color = "green", 20 | margins = 1:4 / 5 21 | ) 22 | ) 23 | }) 24 | -------------------------------------------------------------------------------- /tests/testthat/test-plot.updated_graph.R: -------------------------------------------------------------------------------- 1 | test_that("plotting throws no error", { 2 | graph <- graph_create( 3 | c(pi / 10, 1 - pi / 10, 0, 0), 4 | rbind( 5 | c(0, .5, .5, 0), 6 | c(.5, 0, 0, .5), 7 | c(1e-5, 1 - 1e-5, 0, 0), 8 | c(1 - 1e-5, 1e-5, 0, 0) 9 | ) 10 | ) 11 | 12 | expect_no_error( 13 | plot( 14 | graph_update(graph, c(1, 4)), 15 | edge_curves = c("pairs" = .05, "H1|H3" = .25), 16 | precision = 6, 17 | vertex.size = 35, 18 | eps = 1e-4, 19 | background_color = "green", 20 | margins = 1:4 / 5 21 | ) 22 | ) 23 | }) 24 | -------------------------------------------------------------------------------- /misc/Table_1_weighting_scheme.R: -------------------------------------------------------------------------------- 1 | # Generate the weighting scheme for Table 1 2 | 3 | # make sure the current working directory is the folder code/ 4 | # now source the function definitions: 5 | source("functions/fun_miscellaneous.R") 6 | 7 | # Generate the weighting scheme 8 | w <- c(0.4, 0.4, 0.2, 0, 0, 0) 9 | g <- rbind(c(0, 0, 0, 1, 0, 0), 10 | c(0, 0, 0, 0, 1, 0), 11 | c(0, 0, 0, 0, 0, 1), 12 | c(0, 0.5, 0.5, 0, 0, 0), 13 | c(0.5, 0, 0.5, 0, 0, 0), 14 | c(0.5, 0.5, 0, 0, 0, 0)) 15 | table_1_result <- generateWeights(w = w, g = g) 16 | 17 | # Display the weighting scheme 18 | table_1_result -------------------------------------------------------------------------------- /misc/papers/desktop.ini: -------------------------------------------------------------------------------- 1 | [LocalizedFileNames] 2 | SiM_Optimal_weighted_Bonferroni_tests_and_their_graphical_extensions.pdf=@SiM_Optimal_weighted_Bonferroni_tests_and_their_graphical_extensions.pdf,0 3 | Statistics in Medicine - 2019 - Xi - Symmetric graphs for equally weighted tests with application to the Hochberg (1).pdf=@Statistics in Medicine - 2019 - Xi - Symmetric graphs for equally weighted tests with application to the Hochberg (1).pdf,0 4 | Statistics in Medicine - 2011 - Bretz - Test and power considerations for multiple endpoint analyses using sequentially (1).pdf=@Statistics in Medicine - 2011 - Bretz - Test and power considerations for multiple endpoint analyses using sequentially (1).pdf,0 5 | -------------------------------------------------------------------------------- /man/edge_pairs.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/edge_pairs.R 3 | \name{edge_pairs} 4 | \alias{edge_pairs} 5 | \title{Find pairs of vertices that are connected in both directions} 6 | \usage{ 7 | edge_pairs(graph) 8 | } 9 | \arguments{ 10 | \item{graph}{An initial graph as returned by \code{\link[=graph_create]{graph_create()}}.} 11 | } 12 | \value{ 13 | A list of vertex pairs which are connected in both directions. NULL 14 | if no such pairs are found. 15 | } 16 | \description{ 17 | For an initial graph, find pairs of hypotheses that are connected in both 18 | directions. This is used to plot graphs using \code{\link[=plot.initial_graph]{plot.initial_graph()}}. 19 | } 20 | \keyword{internal} 21 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^README\.Rmd$ 4 | ^LICENSE\.md$ 5 | ^LICENSE$ 6 | ^misc$ 7 | ^cache$ 8 | ^docs$ 9 | ^_pkgdown\.yml$ 10 | ^pkgdown$ 11 | ^\.github$ 12 | ^doc$ 13 | ^Meta$ 14 | ^src/calcWeight.cpp$ 15 | ^vignettes/comparisons_power_parametric.csv$ 16 | ^vignettes/comparisons_power_shortcut.csv$ 17 | ^vignettes/generate-closure_gw_benchmarks.csv$ 18 | ^vignettes/generate-closure_power_benchmarks_fixed_sequence.csv$ 19 | ^vignettes/generate-closure_power_benchmarks_holm.csv$ 20 | ^vignettes/comparisons.Rmd$ 21 | ^vignettes/generate-closure.Rmd$ 22 | ^vignettes/knitted$ 23 | ^vignettes/.*files$ 24 | ^vignettes/.*\.html$ 25 | ^vignettes/.*\.R$ 26 | ^codemeta\.json$ 27 | ^man-roxygen$ 28 | ^cran-comments\.md$ 29 | ^CRAN-SUBMISSION$ 30 | ^CRAN-RELEASE$ 31 | -------------------------------------------------------------------------------- /misc/xi_2017_3.R: -------------------------------------------------------------------------------- 1 | library(gMCP) 2 | 3 | fs::dir_ls("./perf-tests/functions") |> purrr::walk(source) 4 | 5 | w <- c(.4, .4, .2, 0, 0, 0) 6 | m <- rbind( 7 | c( 0, 0, 0, 1, 0, 0), 8 | c( 0, 0, 0, 0, 1, 0), 9 | c( 0, 0, 0, 0, 0, 1), 10 | c( 0, .5, .5, 0, 0, 0), 11 | c(.5, 0, .5, 0, 0, 0), 12 | c(.5, .5, 0, 0, 0, 0) 13 | ) 14 | 15 | g <- graph_create(w, m) 16 | G <- as_graphMCP(g) 17 | 18 | alpha <- .025 19 | 20 | rho <- matrix(NA_real_, nrow = 6, ncol = 6) 21 | rho[1:3, 1:3] <- .5 22 | diag(rho) <- 1 23 | 24 | p_vals <- c(.9, 1.1, .9, 1.3, 1.6, .4) 25 | 26 | g_234 <- graph_update(g, c(F, T, T, T, F, F)) 27 | 28 | gMCP(G, p_vals, "parametric", rho, alpha) 29 | graph_test_closure(g, p_vals, 2.5, rho, 30 | tests = list(parametric = list(1:6))) 31 | -------------------------------------------------------------------------------- /misc/plot_networkd3_2.R: -------------------------------------------------------------------------------- 1 | library(tibble) 2 | library(networkD3) 3 | library(htmlwidgets) 4 | 5 | nodes <- 6 | tribble( 7 | ~name, ~group, 8 | "a", 1, 9 | "b", 1, 10 | "c", 1, 11 | "d", 1 12 | ) 13 | 14 | links <- 15 | tribble( 16 | ~source, ~target, ~value, 17 | 0, 1, 1, 18 | 0, 2, 20, 19 | 0, 3, 100, 20 | ) 21 | 22 | fn <- forceNetwork(Links = links, Nodes = nodes, Source = "source", 23 | Target = "target", Value = "value", NodeID = "name", 24 | Group = "group", opacity = 1, opacityNoHover = 1) 25 | 26 | link_value_js <- ' 27 | function(el) { 28 | d3.select(el) 29 | .selectAll(".link") 30 | .append("title") 31 | .text(d => d.value); 32 | } 33 | ' 34 | 35 | onRender(fn, link_value_js) 36 | -------------------------------------------------------------------------------- /misc/README.txt: -------------------------------------------------------------------------------- 1 | # Supplementary materials of code sumission for 2 | # A unified framework for weighted parametric multiple test procedures 3 | # by Dong Xi, Ekkehard Glimm, Willi Maurer, and Frank Bretz 4 | # Contact Dong Xi at dong.xi@novartis.com for questions related to the code 5 | 6 | # This submission contains 7 | # 1 folder functions of 3 files: fun_miscellaneous.R, fun_common_c.R and fun_separate_c.R 8 | ## They are functions to generate results and simulations in the paper 9 | # 4 files: Table_1_weighting_scheme.R, Table_2_adjusted_p_value.R, Table_3_simulation.R and Table_4_5_local_significance_level.R 10 | ## They are for the results in Table 1 to Table 5. 11 | 12 | # To reproduce the results in the paper, go to each file for a particular table 13 | # First load the functions in the folder functions 14 | # Then follow the instruction in the file -------------------------------------------------------------------------------- /misc/plot_networkd3.R: -------------------------------------------------------------------------------- 1 | net <- 2 | list( 3 | links = structure( 4 | list( 5 | source = c(3, 2, 0, 1), 6 | target = c(0, 7 | 1, 2, 3), 8 | value = c(1, 1, 1, 1) 9 | ), 10 | class = "data.frame", 11 | row.names = c(NA,-4L) 12 | ), 13 | nodes = structure( 14 | list( 15 | name = c("H1", "H2", "H3", "H4"), 16 | group = c(1, 1, 1, 1) 17 | ), 18 | row.names = c(NA,-4L), 19 | class = "data.frame" 20 | ) 21 | ) 22 | 23 | fn <- forceNetwork( 24 | net$links, 25 | net$nodes, 26 | Source = "source", 27 | Target = "target", 28 | Value = "value", 29 | NodeID = "name", 30 | Group = "group", 31 | opacity = 1 32 | ) 33 | 34 | link_value_js <- ' 35 | function(el) { 36 | d3.select(el) 37 | .selectAll(".link") 38 | .append("title") 39 | .text(d => d.value); 40 | } 41 | ' 42 | 43 | htmlwidgets::onRender(fn, link_value_js) 44 | -------------------------------------------------------------------------------- /R/edge_pairs.R: -------------------------------------------------------------------------------- 1 | #' Find pairs of vertices that are connected in both directions 2 | #' 3 | #' @description 4 | #' For an initial graph, find pairs of hypotheses that are connected in both 5 | #' directions. This is used to plot graphs using [plot.initial_graph()]. 6 | #' 7 | #' @inheritParams graph_update 8 | #' 9 | #' @return A list of vertex pairs which are connected in both directions. NULL 10 | #' if no such pairs are found. 11 | #' 12 | #' @rdname edge_pairs 13 | #' 14 | #' @keywords internal 15 | #' 16 | edge_pairs <- function(graph) { 17 | g_names <- names(graph$hypotheses) 18 | 19 | pair_indices <- graph$transitions > 0 & t(graph$transitions) > 0 20 | 21 | pair_nums <- which(pair_indices, arr.ind = TRUE, useNames = FALSE) 22 | 23 | if (nrow(pair_nums) > 0) { 24 | apply( 25 | pair_nums, 26 | 1, 27 | function(row) paste(g_names[[row[[1]]]], g_names[[row[[2]]]], sep = "|"), 28 | simplify = FALSE 29 | ) 30 | } else { 31 | NULL 32 | } 33 | } 34 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/print.initial_graph.md: -------------------------------------------------------------------------------- 1 | # snapshot print method 2 | 3 | Code 4 | graph_create(c(0.5, 0.5), matrix(c(0, 1, 1, 0), nrow = 2)) 5 | Output 6 | Initial graph 7 | 8 | --- Hypothesis weights --- 9 | H1: 0.5 10 | H2: 0.5 11 | 12 | --- Transition weights --- 13 | H1 H2 14 | H1 0 1 15 | H2 1 0 16 | 17 | --- 18 | 19 | Code 20 | graph_update(graph_create(1, matrix(0, nrow = 1)), TRUE)$updated_graph 21 | Output 22 | Updated graph 23 | 24 | --- Hypothesis weights --- 25 | H1: NA 26 | 27 | --- Transition weights --- 28 | H1 29 | H1 NA 30 | 31 | # print default title with no title attribute 32 | 33 | Code 34 | no_attr 35 | Output 36 | Initial graph 37 | 38 | --- Hypothesis weights --- 39 | H1: 0.5 40 | H2: 0.5 41 | 42 | --- Transition weights --- 43 | H1 H2 44 | H1 0 1 45 | H2 1 0 46 | 47 | -------------------------------------------------------------------------------- /misc/calcWeight.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | using namespace Rcpp; 3 | 4 | // [[Rcpp::export]] 5 | List calcWeightCpp(NumericVector w, NumericMatrix g, IntegerVector h) { 6 | NumericVector wCpp = clone(w); 7 | NumericMatrix gCpp = clone(g); 8 | int n_rej = sum(h == 0); 9 | if (n_rej > 0) { 10 | IntegerVector zero(wCpp.size()); 11 | IntegerVector loc = seq(0, wCpp.size() - 1); 12 | IntegerVector rej = loc[h == 0]; 13 | for (int i = 0; i < n_rej; ++i) { 14 | int ind = rej[i]; 15 | NumericMatrix g1(wCpp.size(), wCpp.size()); 16 | for (int j = 0; j < wCpp.size(); ++j) { 17 | wCpp[j] = wCpp[j] + wCpp[ind] * gCpp(ind, j); 18 | NumericVector temp = (gCpp(j, _) + gCpp(j, ind) * gCpp(ind, _)) / (1 - gCpp(j, ind) * gCpp(ind, j)); 19 | temp[j] = 0; 20 | temp[is_nan(temp)] = 0; 21 | g1(j, _) = temp; 22 | } 23 | wCpp[ind] = 0; 24 | gCpp = g1; 25 | gCpp(ind, _) = zero; 26 | gCpp(_, ind) = zero; 27 | } 28 | } 29 | return List::create(wCpp, gCpp); 30 | } 31 | -------------------------------------------------------------------------------- /vignettes/generate-closure_power_benchmarks_holm.csv: -------------------------------------------------------------------------------- 1 | "num_hyps","char_expression","median" 2 | 4,"gMCP (C)",0.0238305000000008 3 | 4,"graphicalMCP conventional (R)",7.1016341 4 | 4,"graphicalMCP parent-child (R)",0.133238600000002 5 | 6,"gMCP (C)",0.0250533000000015 6 | 6,"graphicalMCP conventional (R)",12.3999523 7 | 6,"graphicalMCP parent-child (R)",0.1700523 8 | 8,"gMCP (C)",0.0441957999999998 9 | 8,"graphicalMCP conventional (R)",21.4898488 10 | 8,"graphicalMCP parent-child (R)",0.196084400000002 11 | 10,"gMCP (C)",0.0517875500000011 12 | 10,"graphicalMCP conventional (R)",37.5187789 13 | 10,"graphicalMCP parent-child (R)",0.2433665 14 | 12,"gMCP (C)",0.0567057000000002 15 | 12,"graphicalMCP conventional (R)",60.0837836 16 | 12,"graphicalMCP parent-child (R)",0.3502963 17 | 14,"gMCP (C)",0.0733688000000008 18 | 14,"graphicalMCP conventional (R)",97.3078827 19 | 14,"graphicalMCP parent-child (R)",0.927549600000001 20 | 16,"gMCP (C)",0.0826242999999991 21 | 16,"graphicalMCP conventional (R)",142.9901201 22 | 16,"graphicalMCP parent-child (R)",3.0425396 23 | -------------------------------------------------------------------------------- /vignettes/generate-closure_power_benchmarks_fixed_sequence.csv: -------------------------------------------------------------------------------- 1 | "num_hyps","char_expression","median" 2 | 4,"gMCP (C)",0.0123915999999999 3 | 4,"graphicalMCP conventional (R)",7.0805804 4 | 4,"graphicalMCP parent-child (R)",0.205015700000001 5 | 6,"gMCP (C)",0.017566350000001 6 | 6,"graphicalMCP conventional (R)",11.7704711 7 | 6,"graphicalMCP parent-child (R)",0.249111000000001 8 | 8,"gMCP (C)",0.0263445500000001 9 | 8,"graphicalMCP conventional (R)",21.098003 10 | 8,"graphicalMCP parent-child (R)",0.2950958 11 | 10,"gMCP (C)",0.035941600000001 12 | 10,"graphicalMCP conventional (R)",35.9541604 13 | 10,"graphicalMCP parent-child (R)",0.372164600000001 14 | 12,"gMCP (C)",0.04286645 15 | 12,"graphicalMCP conventional (R)",59.3684306 16 | 12,"graphicalMCP parent-child (R)",0.533061799999999 17 | 14,"gMCP (C)",0.0509640999999998 18 | 14,"graphicalMCP conventional (R)",101.297461 19 | 14,"graphicalMCP parent-child (R)",1.6125263 20 | 16,"gMCP (C)",0.0984497500000012 21 | 16,"graphicalMCP conventional (R)",159.1617946 22 | 16,"graphicalMCP parent-child (R)",5.0523306 23 | -------------------------------------------------------------------------------- /.github/workflows/pr-document.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | pull_request: 3 | branches: [dev] 4 | 5 | name: document 6 | 7 | jobs: 8 | document: 9 | runs-on: ubuntu-latest 10 | env: 11 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 12 | 13 | steps: 14 | - uses: actions/checkout@v2 15 | with: 16 | ref: ${{ github.event.pull_request.head.ref }} 17 | 18 | - uses: r-lib/actions/setup-r@v2 19 | with: 20 | use-public-rspm: true 21 | 22 | - name: install packages & document 23 | shell: Rscript {0} 24 | run: | 25 | install.packages(c("devtools", "decor", "igraph")) 26 | devtools::install(dependencies=TRUE) 27 | devtools::document() 28 | 29 | - name: Commit and push changes 30 | run: | 31 | git config --local user.name "$GITHUB_ACTOR" 32 | git config --local user.email "$GITHUB_ACTOR@users.noreply.github.com" 33 | git add man/\* NAMESPACE DESCRIPTION 34 | git commit -m "Update documentation" || echo "No changes to commit" 35 | git pull --ff-only 36 | git push origin 37 | -------------------------------------------------------------------------------- /inst/WORDLIST: -------------------------------------------------------------------------------- 1 | Alosh 2 | Bhore 3 | Biometrical 4 | Biometrie 5 | Biometrika 6 | Biopharmaceutical 7 | Bonferroni 8 | Brannath 9 | Bretz 10 | Childress 11 | Csardi 12 | Dmitrienko 13 | Dunnett 14 | Ekkehard 15 | FWER 16 | Genz 17 | Github 18 | Glimm 19 | Hochberg 20 | Holm 21 | Hommel 22 | Horvat 23 | Hothorn 24 | Huque 25 | Industrie 26 | Keaven 27 | Klinglmueller 28 | Krishen 29 | Lehmacher 30 | MCP 31 | MCPs 32 | MTP 33 | Maurer 34 | Nepusz 35 | Noom 36 | Posch 37 | Rbuildignore 38 | Rcpp 39 | Resubmission 40 | Rohmeyer 41 | Roumaya 42 | Simes 43 | Springer 44 | stagewise 45 | Traag 46 | Unadjusted 47 | Vectorization 48 | Verlag 49 | Westfall 50 | Wiens 51 | Willi 52 | XXXX 53 | Xiao 54 | Yu 55 | Zanini 56 | al 57 | bimj 58 | bonferroni 59 | chemisch 60 | cran 61 | der 62 | doi 63 | equi 64 | et 65 | familywise 66 | frac 67 | funder 68 | gMCP 69 | gMCPLite 70 | gatekeeping 71 | igraph 72 | ij 73 | ldots 74 | leq 75 | lrstat 76 | nd 77 | noncentrality 78 | openpharma 79 | pharmazeutischen 80 | pre 81 | preclinical 82 | priori 83 | rJava 84 | rejective 85 | repo 86 | rightarrow 87 | th 88 | unadjusted 89 | unpooled 90 | util 91 | varepsilon 92 | Šidák 93 | -------------------------------------------------------------------------------- /misc/background_misc.R: -------------------------------------------------------------------------------- 1 | devtools::check(quiet = FALSE, vignettes = FALSE) 2 | # devtools::load_all("..") 3 | # 4 | # test_m <- function(m, test_groups = list(seq_len(m)), test_types = "b", verbose = FALSE, critical = FALSE) { 5 | # w <- sample(1:m, replace = TRUE) 6 | # w <- w / sum(w) 7 | # g <- replicate(m, sample(1:m, replace = TRUE), simplify = TRUE) 8 | # diag(g) <- 0 9 | # g <- g / rowSums(g) 10 | # graph2 <- graph_create(w, g) 11 | # 12 | # p <- runif(m, .0001, .05) 13 | # sim_corr <- diag(m) 14 | # 15 | # bench::mark( 16 | # graph_test_closure( 17 | # graph2, 18 | # p = p, 19 | # alpha = .05, 20 | # test_corr = sim_corr, 21 | # test_groups = groups, 22 | # test_types = test_types, 23 | # verbose = verbose, 24 | # critical = critical 25 | # ), 26 | # min_iterations = 5 27 | # ) 28 | # } 29 | # 30 | # my_press <- bench::press( 31 | # test_types = c("b", "s", "p"), 32 | # m = 4:10, 33 | # verbose = c(TRUE, FALSE), 34 | # critical = c(TRUE, FALSE), 35 | # {test_m(m, test_types = test_types, verbose = verbose, critical = critical)} 36 | # ) 37 | # 38 | # vroom::vroom_write(x = my_press, file = "./data/my_press.csv", delim = ",") 39 | -------------------------------------------------------------------------------- /misc/parametric_3.1.R: -------------------------------------------------------------------------------- 1 | myfct <- function(x, a, w, sig) { 2 | 1 - 3 | a - 4 | mvtnorm::pmvnorm(lower = -Inf, upper = qnorm(1 - x * w * a), sigma = sig) 5 | } 6 | 7 | library(gMCP) 8 | 9 | Gm <- matrix(0, nrow = 4, ncol = 4) 10 | Gm[1, 3] <- Gm[2, 4] <- Gm[3, 2] <- Gm[4, 1] <- 1 11 | Gm 12 | 13 | w <- c(1/2, 1/2, 0, 0) 14 | 15 | Cm <- matrix(NA,nr=4,nc=4) 16 | diag(Cm) <- 1 17 | Cm1 <- Cm 18 | Cm[1,2] <- Cm[2,1] <- Cm[3,4] <- Cm[4,3] <- 1/2 19 | Cm2 <- Cm 20 | 21 | p <- 1-pnorm(c(2.24,2.24,2.24,2.3)) 22 | G <- matrix2graph(Gm,w) 23 | g <- as_graph(G) 24 | 25 | alpha <- .05 26 | 27 | gMCP(G, p) 28 | graph_test_closure(g, alpha = .05, p_values = p) 29 | 30 | gMCP(G, p, test_corr=Cm2, test="parametric") 31 | graph_test_closure(g, alpha = .05, p_values = p, test_corr = Cm2, 32 | tests = list(parametric = list(1:4))) 33 | 34 | # cJ exploration 35 | gw <- graph_generate_weights(g) 36 | gw_weights <- gw[, 5:8] 37 | 38 | cJ <- vector("numeric", nrow(gw_weights)) 39 | 40 | for (i in seq_len(nrow(gw))) { 41 | cJ[[i]] <- uniroot( 42 | myfct, 43 | lower = 1, 44 | upper = 9, 45 | a = .025, 46 | w = gw_weights[i, ], 47 | sig = Cm1 48 | )$root 49 | } 50 | 51 | cbind(gw, cJ) 52 | -------------------------------------------------------------------------------- /misc/power-outline.md: -------------------------------------------------------------------------------- 1 | # Power outline 2 | 3 | - Sanitize input: Map single letters to test names, convert size-one groups to Bonferroni, put success function in a list 4 | - Validate input 5 | - Simulate p-values (Convert marginal power to non-centrality parameter) 6 | - If all Bonferroni... 7 | - Run power with shortcut testing 8 | - Otherwise... 9 | - Bonferroni critical values - just the weights of the closure for the Bonferroni hypotheses 10 | - Parametric critical values - calculated once with `calculate_critical_parametric()` 11 | - This uses the c-value calculation method _on each parametric group_ 12 | - _Simes critical values are not calculated here_ 13 | - Weights and simulated p-values for the Simes hypotheses are separated out 14 | - Simes hypothesis numbers get a custom re-assignment which is their relative position within all Simes hypotheses 15 | - Loop over simulations 16 | - Simes critical values - calculated for each simulation with `calculate_critical_simes()` 17 | - Output includes critical values for missing hypotheses - these get removed 18 | - Combine all critical values back together, replace NA or incorrect values with 0, and test 19 | - Summarize results, including applying success functions 20 | 21 | -------------------------------------------------------------------------------- /vignettes/generate-closure_gw_benchmarks.csv: -------------------------------------------------------------------------------- 1 | "num_hyps","char_expression","median" 2 | 4,"gMCP",1.38159999999998 3 | 4,"graphicalMCP simple",0.8127 4 | 4,"graphicalMCP recursive",0.301899999999966 5 | 4,"graphicalMCP parent-child",0.259899999999869 6 | 4,"lrstat",0.0148000000002035 7 | 6,"gMCP",8.54784999999991 8 | 6,"graphicalMCP simple",4.06910000000016 9 | 6,"graphicalMCP recursive",1.30850000000005 10 | 6,"graphicalMCP parent-child",1.24550000000023 11 | 6,"lrstat",0.0590999999998676 12 | 8,"gMCP",53.3681999999999 13 | 8,"graphicalMCP simple",24.7686500000001 14 | 8,"graphicalMCP recursive",5.29030000000019 15 | 8,"graphicalMCP parent-child",4.68369999999996 16 | 8,"lrstat",0.308300000000372 17 | 10,"gMCP",283.3824 18 | 10,"graphicalMCP simple",208.6334 19 | 10,"graphicalMCP recursive",43.5381 20 | 10,"graphicalMCP parent-child",31.6932000000001 21 | 12,"gMCP",2609.1675 22 | 12,"graphicalMCP simple",1138.9188 23 | 12,"graphicalMCP recursive",121.456 24 | 12,"graphicalMCP parent-child",120.07 25 | 12,"lrstat",10.0675000000002 26 | 14,"gMCP",10749.7594 27 | 14,"graphicalMCP simple",5238.8871 28 | 14,"graphicalMCP recursive",613.2587 29 | 14,"graphicalMCP parent-child",635.0258 30 | 16,"gMCP",60536.2942 31 | 16,"graphicalMCP simple",29817.7005 32 | 16,"graphicalMCP recursive",3166.2913 33 | 16,"graphicalMCP parent-child",2579.0905 34 | 16,"lrstat",480.7511 35 | -------------------------------------------------------------------------------- /tests/testthat/test-adjust_weights.R: -------------------------------------------------------------------------------- 1 | alpha <- 0.025 2 | num_hyps <- 4 3 | g <- random_graph(num_hyps) 4 | groups <- sample(1:num_hyps) 5 | test_groups <- list(groups[1:(num_hyps / 2)], groups[(num_hyps / 2 + 1):num_hyps]) 6 | test_corr_temp <- matrix(0.5, num_hyps / 2, num_hyps / 2) 7 | diag(test_corr_temp) <- 1 8 | test_corr <- list(test_corr_temp, test_corr_temp) 9 | new_corr <- matrix(NA, num_hyps, num_hyps) 10 | for (group_num in seq_along(test_groups)) { 11 | new_corr[test_groups[[group_num]], test_groups[[group_num]]] <- 12 | test_corr[[group_num]] 13 | } 14 | diag(new_corr) <- 1 15 | weighting_strategy <- graph_generate_weights(g) 16 | matrix_intersections <- weighting_strategy[, seq_len(num_hyps)] 17 | matrix_weights <- weighting_strategy[, -seq_len(num_hyps)] 18 | 19 | test_that("parametric", { 20 | set.seed(1234) 21 | list_corr <- adjust_weights_parametric( 22 | matrix_weights = matrix_weights, 23 | matrix_intersections = matrix_intersections, 24 | test_corr = test_corr, 25 | alpha = alpha, 26 | test_groups = test_groups 27 | ) 28 | 29 | set.seed(1234) 30 | single_corr <- adjust_weights_parametric_util( 31 | matrix_weights, 32 | matrix_intersections, 33 | new_corr, 34 | alpha, 35 | test_groups 36 | ) 37 | single_corr <- single_corr[, colnames(matrix_weights), drop = FALSE] 38 | expect_equal(list_corr, single_corr) 39 | }) 40 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # graphicalMCP 0.1.0 2 | 3 | * First release 4 | 5 | # graphicalMCP 0.1.1 6 | 7 | * Added compilation of vignettes (#73) 8 | * Removed duplicated columns of "*" in test values (#75) 9 | 10 | # graphicalMCP 0.1.2 11 | 12 | * Updated function documentation 13 | * Updated references 14 | 15 | # graphicalMCP 0.2.0 16 | 17 | * Corrected typos 18 | * Updated function documentation for CRAN release 19 | 20 | # graphicalMCP 0.2.1 21 | 22 | * Corrected typos 23 | * First CRAN release 24 | 25 | # graphicalMCP 0.2.2 26 | 27 | * Updated citations 28 | * Resubmission for first CRAN release 29 | 30 | # graphicalMCP 0.2.3 31 | 32 | * Included cran-comments.ms in .Rbuildignore 33 | * Resubmission for first CRAN release 34 | 35 | # graphicalMCP 0.2.4 36 | 37 | * Updated documentation according to issue #84 38 | * Resubmission for first CRAN release 39 | 40 | # graphicalMCP 0.2.5 41 | 42 | * Updated adjust_weights_parametric_util.Rd 43 | * Resubmission for first CRAN release 44 | 45 | # graphicalMCP 0.2.6 46 | 47 | * Github repo transferred to openpharma 48 | * Submission for CRAN release 49 | 50 | # graphicalMCP 0.2.7 51 | 52 | * Added Hochberg-based procedures 53 | * Added internal validations 54 | * Expanded example graphs 55 | * Updated vignettes 56 | * Submission for CRAN release 57 | 58 | # graphicalMCP 0.2.8 59 | 60 | * Corrected urls for references 61 | * Submission for CRAN release 62 | -------------------------------------------------------------------------------- /man/graphicalMCP-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/graphicalMCP-package.R 3 | \docType{package} 4 | \name{graphicalMCP-package} 5 | \alias{graphicalMCP} 6 | \alias{graphicalMCP-package} 7 | \title{graphicalMCP: Graphical Multiple Comparison Procedures} 8 | \description{ 9 | \if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} 10 | 11 | Multiple comparison procedures (MCPs) control the familywise error rate in clinical trials. Graphical MCPs include many commonly used procedures as special cases; see Bretz et al. (2011) \doi{10.1002/bimj.201000239}, Lu (2016) \doi{10.1002/sim.6985}, and Xi et al. (2017) \doi{10.1002/bimj.201600233}. This package is a low-dependency implementation of graphical MCPs which allow mixed types of tests. It also includes power simulations and visualization of graphical MCPs. 12 | } 13 | \seealso{ 14 | Useful links: 15 | \itemize{ 16 | \item \url{https://github.com/openpharma/graphicalMCP} 17 | \item Report bugs at \url{https://github.com/openpharma/graphicalMCP/issues} 18 | } 19 | 20 | } 21 | \author{ 22 | \strong{Maintainer}: Dong Xi \email{dong.xi1@gilead.com} 23 | 24 | Authors: 25 | \itemize{ 26 | \item Ethan Brockmann \email{ethan.brockmann@atorusresearch.com} 27 | } 28 | 29 | Other contributors: 30 | \itemize{ 31 | \item Gilead Sciences, Inc. [copyright holder, funder] 32 | } 33 | 34 | } 35 | \keyword{internal} 36 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/01_bug_report.yml: -------------------------------------------------------------------------------- 1 | name: Bug Report 2 | description: Something is not working correctly or is not working at all! 3 | title: "Bug: " 4 | labels: ["bug", "programming"] 5 | body: 6 | - type: markdown 7 | attributes: 8 | value: | 9 | **Example:** Bug: graph_calculate_power() errors on certain input 10 | - type: textarea 11 | id: what-happened 12 | attributes: 13 | label: What happened? 14 | description: Also tell us what were you expecting to happen before the bug? 15 | placeholder: "A bug happened!" 16 | validations: 17 | required: true 18 | - type: textarea 19 | id: session-info 20 | attributes: 21 | label: Session Information 22 | description: Use `sessionInfo()` in the R console to gather all the details of your environment when the bug happened. 23 | placeholder: "Place the console output here" 24 | validations: 25 | required: false 26 | - type: textarea 27 | id: logs 28 | attributes: 29 | label: Reproducible Example 30 | description: We love code that can reproduce the bug. Check out [reprex](https://reprex.tidyverse.org/articles/reprex-dos-and-donts.html) 31 | placeholder: "Please give us as many details as you can! The faster we can recreate the bug, the faster we can get a fix in the works. Warning, Error Messages and Screenshots are also great." 32 | validations: 33 | required: false 34 | -------------------------------------------------------------------------------- /misc/plot_igraph_complex.R: -------------------------------------------------------------------------------- 1 | library(igraph) 2 | devtools::load_all() 3 | 4 | eps <- .0001 5 | 6 | # ex 1 ------------------------------------------------------------------------- 7 | g1 <- two_doses_two_primary_two_secondary() 8 | 9 | igraph <- as_igraph(g1) 10 | 11 | group_layout <- rbind(c(.15, .5), c(0, 0), c(.3, 0)) 12 | 13 | complex_layout <- rbind( 14 | t(t(group_layout) + c(0, 0)), 15 | t(t(group_layout) + c(.5, 0)) 16 | ) 17 | 18 | plot( 19 | g1, 20 | precision = 2, 21 | layout = complex_layout, 22 | edge_curves = c("pairs" = 1), 23 | vertex.size = 15, 24 | edge.label.cex = 1.2, 25 | edge.arrow.size = 1 26 | ) 27 | 28 | # ex 2 ------------------------------------------------------------------------- 29 | g2 <- three_doses_two_primary_two_secondary() 30 | 31 | igraph <- as_igraph(g2) 32 | 33 | group_layout2 <- rbind(c(.3, .5), c(0, 0), c(.6, 0)) 34 | 35 | complex_layout2 <- rbind( 36 | t(t(group_layout2) + c(-1, 0)), 37 | t(t(group_layout2) + c(0, 0)), 38 | t(t(group_layout2) + c(1, 0)) 39 | ) 40 | 41 | complex_layout2[, 1] <- complex_layout2[, 1] / max(abs(complex_layout2[, 1])) 42 | complex_layout2[, 2] <- complex_layout2[, 2] / max(abs(complex_layout2[, 2])) 43 | 44 | plot( 45 | g2, 46 | precision = 2, 47 | layout = complex_layout2, 48 | edge_curves = c("pairs" = 1, 49 | "H3|H7" = .05, 50 | "H9|H1" = .05), 51 | vertex.size = 15, 52 | edge.label.cex = 1.2, 53 | edge.arrow.size = 1 54 | ) 55 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: [push, pull_request] 4 | 5 | name: R-CMD-check 6 | 7 | jobs: 8 | R-CMD-check: 9 | runs-on: ${{ matrix.config.os }} 10 | 11 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 12 | 13 | strategy: 14 | fail-fast: false 15 | matrix: 16 | config: 17 | - {os: macos-latest, r: 'release'} 18 | - {os: windows-latest, r: 'release'} 19 | - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} 20 | - {os: ubuntu-latest, r: 'release'} 21 | - {os: ubuntu-latest, r: 'oldrel-1'} 22 | 23 | env: 24 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 25 | R_KEEP_PKG_SOURCE: yes 26 | 27 | steps: 28 | - uses: actions/checkout@v3 29 | 30 | - uses: r-lib/actions/setup-pandoc@v2 31 | 32 | - uses: r-lib/actions/setup-r@v2 33 | with: 34 | r-version: ${{ matrix.config.r }} 35 | http-user-agent: ${{ matrix.config.http-user-agent }} 36 | use-public-rspm: true 37 | 38 | - uses: r-lib/actions/setup-r-dependencies@v2 39 | with: 40 | extra-packages: any::rcmdcheck 41 | needs: check 42 | 43 | - uses: r-lib/actions/check-r-package@v2 44 | with: 45 | upload-snapshots: true 46 | -------------------------------------------------------------------------------- /tests/testthat/test-graph_generate_weights.R: -------------------------------------------------------------------------------- 1 | hypotheses <- c(0.5, 0.5, 0, 0) 2 | transitions <- rbind( 3 | c(0, 0, 1, 0), 4 | c(0, 0, 0, 1), 5 | c(0, 1, 0, 0), 6 | c(1, 0, 0, 0) 7 | ) 8 | names <- c("H1", "H2", "H3", "H4") 9 | g <- graph_create(hypotheses, transitions, names) 10 | gw4 <- graph_generate_weights(g) 11 | gw4_gmcp <- gMCP::generateWeights(g$transitions, g$hypotheses) 12 | 13 | bh10 <- bonferroni_holm(10) 14 | gw10 <- graph_generate_weights(bh10) 15 | gw10_gmcp <- gMCP::generateWeights(bh10$transitions, bh10$hypotheses) 16 | 17 | # 2.1 from the gMCP vignette 18 | m <- rbind( 19 | H11 = c(0, 0.5, 0, 0.5, 0, 0), 20 | H21 = c(1 / 3, 0, 1 / 3, 0, 1 / 3, 0), 21 | H31 = c(0, 0.5, 0, 0, 0, 0.5), 22 | H12 = c(0, 1, 0, 0, 0, 0), 23 | H22 = c(0.5, 0, 0.5, 0, 0, 0), 24 | H32 = c(0, 1, 0, 0, 0, 0) 25 | ) 26 | w <- c(1 / 3, 1 / 3, 1 / 3, 0, 0, 0) 27 | gmcp_graph <- gMCP::matrix2graph(m) 28 | gmcp_graph@weights <- structure(w, names = rownames(m)) 29 | gw_11_gmcp <- gMCP::generateWeights(gmcp_graph) 30 | 31 | graph <- graph_create(w, m) 32 | gw_11 <- graph_generate_weights(graph) 33 | 34 | test_that("compare to gMCP", { 35 | # The `[nrow():1,]` piece reverses row order to match gmcp ordering 36 | expect_true(all.equal(unname(gw4[seq(nrow(gw4), 1), ]), unname(gw4_gmcp))) 37 | expect_true(all.equal(unname(gw10[seq(nrow(gw10), 1), ]), unname(gw10_gmcp))) 38 | expect_true( 39 | all.equal(unname(gw_11[seq(nrow(gw_11), 1), ]), unname(gw_11_gmcp)) 40 | ) 41 | }) 42 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [dev, main, release] 6 | pull_request: 7 | branches: [dev, main, release] 8 | release: 9 | types: [published] 10 | workflow_dispatch: 11 | 12 | name: pkgdown 13 | 14 | jobs: 15 | pkgdown: 16 | runs-on: ubuntu-latest 17 | # Only restrict concurrency for non-PR jobs 18 | concurrency: 19 | group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} 20 | env: 21 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 22 | steps: 23 | - uses: actions/checkout@v3 24 | 25 | - uses: r-lib/actions/setup-pandoc@v2 26 | 27 | - uses: r-lib/actions/setup-r@v2 28 | with: 29 | use-public-rspm: true 30 | 31 | - uses: r-lib/actions/setup-r-dependencies@v2 32 | with: 33 | extra-packages: any::pkgdown, local::. 34 | needs: website 35 | 36 | - name: Build site 37 | run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE) 38 | shell: Rscript {0} 39 | 40 | - name: Deploy to GitHub pages 🚀 41 | if: github.event_name != 'pull_request' 42 | uses: JamesIves/github-pages-deploy-action@v4.4.1 43 | with: 44 | clean: false 45 | branch: gh-pages 46 | folder: docs 47 | -------------------------------------------------------------------------------- /misc/temp.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Untitled" 3 | output: html_document 4 | date: "2023-08-30" 5 | --- 6 | 7 | ```{r setup, include=FALSE, message=FALSE, warning=FALSE} 8 | knitr::opts_chunk$set(echo = TRUE) 9 | 10 | library(graphicalMCP) 11 | ``` 12 | 13 | ## R Markdown 14 | 15 | This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see . 16 | 17 | When you click the **Knit** button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this: 18 | 19 | ```{r cars} 20 | knitr::kable(head(cars)) 21 | ``` 22 | 23 | ## Including Plots 24 | 25 | You can also embed plots, for example: 26 | 27 | ```{r plot-1, echo=FALSE, fig.dim=c(4, 4)} 28 | plot(simple_successive_2(), layout = "grid") 29 | ``` 30 | 31 | ```{r plot-2, echo=FALSE, fig.dim=c(4, 4)} 32 | plot(graph_update(simple_successive_2(), c(T, F, T, T)), layout = "grid", precision = 4) 33 | ``` 34 | 35 | ```{r plot-3, echo=FALSE, fig.dim=c(4, 4)} 36 | plot(graph_update(simple_successive_2(), c(T, F, T, F)), layout = "grid") 37 | ``` 38 | 39 | ```{r plot-4, echo=FALSE, fig.dim=c(4, 4)} 40 | plot(graph_update(simple_successive_2(), c(F, F, T, F)), layout = "grid") 41 | ``` 42 | 43 | Note that the `echo = FALSE` parameter was added to the code chunk to prevent printing of the R code that generated the plot. 44 | -------------------------------------------------------------------------------- /misc/generate_weights_performance_comparison.R: -------------------------------------------------------------------------------- 1 | devtools::load_all() 2 | library(bench) 3 | library(gMCP) 4 | library(vroom) 5 | 6 | bench_gen_wgt <- function(sizes = 2:8, gmcp = FALSE, min = 5) { 7 | purrr::walk( 8 | sizes, 9 | function(size) { 10 | bh <- bonferroni_holm(size) 11 | 12 | if (gmcp) { 13 | vroom_write(print(dplyr::mutate( 14 | mark( 15 | generateWeights(bh$t, bh$h), 16 | graph_generate_weights(bh), 17 | graph_generate_weights_recursive(bh), 18 | # graph_generate_weights_recursive_vec(bh), 19 | check = FALSE, 20 | min_iterations = min, 21 | time_unit = "ms" 22 | ), 23 | size = size, 24 | mem_alloc = as.integer(mem_alloc), 25 | .before = expression 26 | )), paste0("./perf-tests/log/bh", size, "_gmcp_", Sys.time(), ".tsv")) 27 | } else { 28 | vroom_write(print(dplyr::mutate( 29 | mark( 30 | graph_generate_weights(bh), 31 | graph_generate_weights_recursive(bh), 32 | # graph_generate_weights_recursive_vec(bh), 33 | check = FALSE, 34 | min_iterations = min, 35 | time_unit = "ms" 36 | ), 37 | size = size, 38 | mem_alloc = as.integer(mem_alloc), 39 | .before = expression 40 | )), paste0("./perf-tests/log/bh", size, "_no-gmcp_", Sys.time(), ".tsv")) 41 | } 42 | } 43 | ) 44 | } 45 | 46 | bench_gen_wgt(sizes = 2:16) 47 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(as_graphMCP,initial_graph) 4 | S3method(as_igraph,initial_graph) 5 | S3method(as_initial_graph,graphMCP) 6 | S3method(as_initial_graph,igraph) 7 | S3method(plot,initial_graph) 8 | S3method(plot,updated_graph) 9 | S3method(print,graph_report) 10 | S3method(print,initial_graph) 11 | S3method(print,power_report) 12 | S3method(print,updated_graph) 13 | export(adjust_p_bonferroni) 14 | export(adjust_p_hochberg) 15 | export(adjust_p_parametric) 16 | export(adjust_p_simes) 17 | export(adjust_weights_hochberg) 18 | export(adjust_weights_parametric) 19 | export(adjust_weights_simes) 20 | export(as_graphMCP) 21 | export(as_igraph) 22 | export(as_initial_graph) 23 | export(bonferroni) 24 | export(bonferroni_holm) 25 | export(bonferroni_holm_weighted) 26 | export(bonferroni_weighted) 27 | export(dunnett_closure_weighted) 28 | export(dunnett_single_step) 29 | export(dunnett_single_step_weighted) 30 | export(fallback) 31 | export(fallback_improved_1) 32 | export(fallback_improved_2) 33 | export(fixed_sequence) 34 | export(graph_calculate_power) 35 | export(graph_create) 36 | export(graph_generate_weights) 37 | export(graph_rejection_orderings) 38 | export(graph_test_closure) 39 | export(graph_test_shortcut) 40 | export(graph_update) 41 | export(hochberg) 42 | export(hommel) 43 | export(huque_etal) 44 | export(random_graph) 45 | export(sidak) 46 | export(simple_successive_1) 47 | export(simple_successive_2) 48 | export(three_doses_two_primary_two_secondary) 49 | export(two_doses_two_primary_two_secondary) 50 | -------------------------------------------------------------------------------- /misc/test_input_brainstorm.R: -------------------------------------------------------------------------------- 1 | # test input ideas 2 | 3 | g <- bonferroni_holm(10) 4 | 5 | test_corr <- diag(10) 6 | 7 | # Option 1, nested lists 8 | graph_test_closure( 9 | g, 10 | p_values = .05 / 1:10, 11 | alpha = .05, 12 | tests = list( 13 | bonferroni = list(1:3), 14 | parametric = list(c(4, 6, 8), 9:10), 15 | simes = list(c(5, 7)) 16 | ), 17 | test_corr = test_corr 18 | ) 19 | 20 | # Option 2, named parameters 21 | graph_test_closure( 22 | g, 23 | p_values = .05 / 1:10, 24 | alpha = .05, 25 | bonferroni = list(1:3), 26 | parametric = list(c(4, 6, 8), 9:10), 27 | simes = list(c(5, 7)), 28 | test_corr = test_corr 29 | ) 30 | 31 | # Option 3, the three dots 32 | graph_test_closure( 33 | g, 34 | p_values = .05 / 1:10, 35 | alpha = .05, 36 | bonferroni = 1:3, 37 | parametric = c(4, 6, 8), 38 | parametric = 9:10, 39 | simes = list(5, 7), # Lists could get "un-listed" if necessary 40 | test_corr = test_corr 41 | ) 42 | 43 | # Option 4, positional 44 | graph_test_closure( 45 | g, 46 | p_values = .05 / 1:10, 47 | alpha = .05, 48 | tests = "b1b1b1p1s1p1s1p1p2p2", 49 | test_corr = test_corr 50 | ) 51 | 52 | graph_test_closure( 53 | g, 54 | p_values = .05 / 1:10, 55 | alpha = .05, 56 | tests = c("b1", "b1", "b1", "p1", "s1", "p1", "s1", "p1", "p2", "p2"), 57 | test_corr = test_corr 58 | ) 59 | 60 | # Option 5, separate 61 | graph_test_closure( 62 | g, 63 | p_values = .05 / 1:10, 64 | alpha = .05, 65 | test_groups = list(1:3, c(4, 6, 8), c(5, 7), 9:10), 66 | tests = c("b", "p", "s", "p"), 67 | test_corr = test_corr 68 | ) 69 | 70 | 71 | 72 | 73 | 74 | -------------------------------------------------------------------------------- /man-roxygen/references.R: -------------------------------------------------------------------------------- 1 | #' @references 2 | #' 3 | #' Bretz, F., Maurer, W., Brannath, W., and Posch, M. (2009). A graphical 4 | #' approach to sequentially rejective multiple test procedures. Statistics in 5 | #' Medicine, 28(4), 586–604. 6 | #' 7 | #' Bretz, F., Maurer, W., and Hommel, G. (2011). Test and power considerations 8 | #' for multiple endpoint analyses using sequentially rejective graphical 9 | #' procedures. Statistics in Medicine, 30(13), 1489–1501. 10 | #' 11 | #' 12 | #' Bretz, F., Posch, M., Glimm, E., Klinglmueller, F., Maurer, W., and Rohmeyer, 13 | #' K. (2011). Graphical approaches for multiple comparison procedures using 14 | #' weighted Bonferroni, Simes, or parametric tests. Biometrical Journal, 53(6), 15 | #' 894–913. 16 | #' 17 | #' Lu, K. (2016). Graphical approaches using a Bonferroni mixture of weighted 18 | #' Simes tests. Statistics in Medicine, 35(22), 4041–4055. 19 | #' 20 | #' 21 | #' Xi, D., Glimm, E., Maurer, W., and Bretz, F. (2017). A unified framework for 22 | #' weighted parametric multiple test procedures. Biometrical Journal, 59(5), 23 | #' 918–931. 24 | #' 25 | #' Xi, D., and Bretz, F. (2019). Symmetric graphs for equally weighted tests, 26 | #' with application to the Hochberg procedure. Statistics in Medicine, 38(27), 27 | #' 5268–5282. 28 | #' 29 | #' Rohmeyer K, Klinglmueller F (2020). _gMCP: Graph Based Multiple Test 30 | #' Procedures_. R package version 0.8-15, 31 | #' . 32 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Type: Package 2 | Package: graphicalMCP 3 | Title: Graphical Multiple Comparison Procedures 4 | Version: 0.2.8 5 | Authors@R: c( 6 | person("Dong", "Xi", , "dong.xi1@gilead.com", role = c("aut", "cre")), 7 | person("Ethan", "Brockmann", , "ethan.brockmann@atorusresearch.com", role = "aut"), 8 | person("Gilead Sciences, Inc.", role = c("cph", "fnd")) 9 | ) 10 | Description: Multiple comparison procedures (MCPs) control the familywise error 11 | rate in clinical trials. Graphical MCPs include many commonly used 12 | procedures as special cases; see Bretz et al. (2011) 13 | , Lu (2016) , and Xi et 14 | al. (2017) . This package is a low-dependency 15 | implementation of graphical MCPs which allow mixed types of tests. It also 16 | includes power simulations and visualization of graphical MCPs. 17 | License: Apache License (>= 2) 18 | URL: https://github.com/openpharma/graphicalMCP 19 | BugReports: https://github.com/openpharma/graphicalMCP/issues 20 | Depends: 21 | R (>= 4.1.0) 22 | Imports: 23 | matrixStats, 24 | mvtnorm 25 | Suggests: 26 | bench, 27 | dplyr, 28 | forcats, 29 | ggplot2, 30 | gMCP, 31 | gt, 32 | here, 33 | htmltools, 34 | igraph, 35 | knitr, 36 | lrstat, 37 | prompt, 38 | rmarkdown, 39 | scales, 40 | testthat (>= 3.0.0), 41 | tibble, 42 | tictoc, 43 | tidyr, 44 | xfun 45 | VignetteBuilder: 46 | knitr 47 | Config/testthat/edition: 3 48 | Encoding: UTF-8 49 | LazyData: true 50 | Roxygen: list(markdown = TRUE) 51 | RoxygenNote: 7.3.2 52 | Language: en-US 53 | -------------------------------------------------------------------------------- /misc/test_update.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | mtp.weights <- function(h,g,w){ 4 | ## recursively compute weights for a given graph and intersection hypothesis 5 | if(sum(h)==length(h)){ 6 | return(w) 7 | } else { 8 | j <- which(h==0)[1] 9 | h[j] <- 1 10 | wu <- mtp.weights(h,g,w) 11 | gu <- mtp.edges(h,g,w) 12 | guj <- gu[j,] 13 | wt <- wu+wu[j]*guj 14 | wt[j] <- 0 15 | return(wt) 16 | } 17 | } 18 | 19 | mtp.edges <- function(h,g,w){ 20 | ## recursively compute the edges for the graph of a given intersection hypothesis 21 | if(sum(h)==length(h)){ 22 | return(g) 23 | } else { 24 | j <- which(h==0)[1] 25 | h[j] <- 1 26 | gu <- mtp.edges(h,g,w) 27 | gj <- gu[,j]%*%t(gu[j,]) 28 | gt <- ((gu+gj)/(1-matrix(rep(diag(gj),nrow(gj)),nrow=nrow(gj)))) 29 | gt[j,] <- 0 30 | gt[,j] <- 0 31 | diag(gt) <- 0 32 | gt[is.nan(gt)] <- 0 33 | return(gt) 34 | } 35 | } 36 | 37 | set.seed(1234) 38 | m <- 10 39 | nsim <- 1e3 40 | diff_weight <- diff_transition <- NULL 41 | 42 | for (i in 1:nsim) { 43 | w <- sample(1:m, replace = T) 44 | w <- w / sum(w) 45 | g <- replicate(m, sample(1:m, replace = T), simplify = T) 46 | diag(g) <- 0 47 | g <- g / rowSums(g) 48 | h <- sample(c(0, 1), m, replace = T) 49 | 50 | # gMCP 51 | gmcp_weight <- mtp.weights(h,g,w) 52 | gmcp_transition <- mtp.edges(h,g,w) 53 | 54 | # graphicalMCP 55 | graph <- graph_create(w, g) 56 | graphicalmcp_weight <- graph_update(graph, h)$updated_graph$hypotheses 57 | graphicalmcp_transition <- graph_update(graph, h)$updated_graph$transitions 58 | 59 | diff_weight <- c(diff_weight, max(abs(gmcp_weight - graphicalmcp_weight))) 60 | diff_transition <- c(diff_transition, max(abs(gmcp_transition - graphicalmcp_transition))) 61 | } 62 | all.equal(0, max(diff_weight)) 63 | all.equal(0, max(diff_transition)) 64 | -------------------------------------------------------------------------------- /R/plot.updated_graph.R: -------------------------------------------------------------------------------- 1 | #' S3 plot method for the class `updated_graph` 2 | #' 3 | #' @description 4 | #' Plotting an updated graph is a *very* light wrapper around 5 | #' [plot.initial_graph()], only changing the default vertex color to use gray 6 | #' for deleted hypotheses. 7 | #' 8 | #' @param x An object of class `updated_graph` to plot. 9 | #' @inheritDotParams plot.initial_graph 10 | #' 11 | #' @return An object x of class `updated_graph`, after plotting the updated 12 | #' graph. 13 | #' 14 | #' @seealso 15 | #' [plot.initial_graph()] for the plot method for the initial graph. 16 | #' 17 | #' @rdname plot.updated_graph 18 | #' 19 | #' @export 20 | #' 21 | #' @references 22 | #' Bretz, F., Posch, M., Glimm, E., Klinglmueller, F., Maurer, W., and 23 | #' Rohmeyer, K. (2011). Graphical approaches for multiple comparison 24 | #' procedures using weighted Bonferroni, Simes, or parametric tests. 25 | #' \emph{Biometrical Journal}, 53(6), 894-913. 26 | #' 27 | #' @examples 28 | #' # A graphical multiple comparison procedure with two primary hypotheses (H1 29 | #' # and H2) and two secondary hypotheses (H3 and H4) 30 | #' # See Figure 1 in Bretz et al. (2011). 31 | #' hypotheses <- c(0.5, 0.5, 0, 0) 32 | #' transitions <- rbind( 33 | #' c(0, 0, 1, 0), 34 | #' c(0, 0, 0, 1), 35 | #' c(0, 1, 0, 0), 36 | #' c(1, 0, 0, 0) 37 | #' ) 38 | #' g <- graph_create(hypotheses, transitions) 39 | #' 40 | #' # Delete the second and third hypotheses in the "unordered mode" 41 | #' plot( 42 | #' graph_update( 43 | #' g, 44 | #' c(FALSE, TRUE, TRUE, FALSE) 45 | #' ), 46 | #' layout = "grid" 47 | #' ) 48 | plot.updated_graph <- function(x, ...) { 49 | v_colors <- rep("#6baed6", length(x$updated_graph$hypotheses)) 50 | v_colors[x$deleted] <- "#cccccc" 51 | 52 | plot(x$updated_graph, vertex.color = v_colors, ...) 53 | 54 | invisible(x) 55 | } 56 | -------------------------------------------------------------------------------- /misc/plot_ggraph.R: -------------------------------------------------------------------------------- 1 | library(ggraph) 2 | library(tidygraph) 3 | 4 | data <- readRDS("StormGraph.RDS") 5 | 6 | hypotheses <- c(0.5, 0.5, 0, 0) 7 | transitions <- rbind(c(0, 0, 1, 0), 8 | c(0, 0, 0, 1), 9 | c(0, 1, 0, 0), 10 | c(1, 0, 0, 0)) 11 | g <- graph_create(hypotheses, transitions) 12 | g 13 | 14 | df_nodes <- data.frame(name = names(g$hypotheses), weight = g$hypotheses) 15 | df_edges <- expand.grid(from = names(g$hypotheses), to = names(g$hypotheses)) 16 | df_edges$weight <- c(transitions) 17 | df_edges <- df_edges[df_edges$weight != 0, ] 18 | 19 | g_graph <- tbl_graph(df_nodes, df_edges) 20 | 21 | ggraph(g_graph, layout = matrix(c(1, 10, 1, 10, 10, 10, 1, 1), nrow = 4)) + 22 | geom_edge_link(aes(label = weight), arrow = arrow(length = unit(.1, "inches"), type = "closed")) + 23 | geom_node_circle(aes(r = .1)) + coord_fixed() + 24 | geom_node_text(aes(label = name), repel = TRUE) 25 | 26 | graph <- as_tbl_graph(highschool) %>% 27 | mutate(Popularity = centrality_degree(mode = 'in')) 28 | 29 | # broken 30 | # ggraph(graph, layout = 'kk') + 31 | # geom_edge_fan(aes(alpha = after_stat(index)), show.legend = FALSE) + 32 | # geom_node_point(aes(size = Popularity)) + 33 | # facet_edges(~year) + 34 | # theme_graph(foreground = 'steelblue', fg_text_colour = 'white') 35 | 36 | graph <- as_tbl_graph( 37 | data.frame( 38 | from = sample(5, 20, TRUE), 39 | to = sample(5, 20, TRUE), 40 | weight = runif(20) 41 | ) 42 | ) 43 | 44 | ggraph(graph, layout = 'fr', weights = exp(weight)) + 45 | geom_edge_link() + 46 | geom_node_point() 47 | 48 | graph <- create_notable('zachary') 49 | 50 | ggraph(graph, layout = 'fr') + 51 | geom_edge_link() + 52 | geom_node_point(aes(size = centrality_pagerank())) + 53 | theme(legend.position = 'bottom') 54 | -------------------------------------------------------------------------------- /misc/check_generate_weights.R: -------------------------------------------------------------------------------- 1 | library(Rcpp) 2 | sourceCpp("C:/Users/dxi1/OneDrive - Gilead Sciences/Initiative/graphicalMCP/calcWeight.cpp") 3 | 4 | ############################ Rcpp ######################################### 5 | generateWeights2 <- function (w, g) { 6 | n <- length(w) 7 | intersect <- expand.grid(rep(list(0:1), n))[-1, ] 8 | weighting <- apply(intersect, 1, function(x) { 9 | list(int = x, w = calcWeightCpp(w, g, x)[[1]]) 10 | }) 11 | m <- as.matrix(as.data.frame(lapply(weighting, function(i) c(i$int, i$w)))) 12 | colnames(m) <- NULL 13 | t(m) 14 | } 15 | 16 | ############################ Check ############################################# 17 | library(microbenchmark) 18 | library(gMCP) 19 | 20 | set.seed(1234) 21 | # Randomly generate a graph 22 | m <- 10 23 | w <- sample(1:m, replace = T) 24 | w <- w / sum(w) 25 | g <- replicate(m, sample(1:m, replace = T), simplify = T) 26 | diag(g) <- 0 27 | g <- g / rowSums(g) 28 | graph <- new("graphMCP", m = g, weights = w) 29 | graph2 <- graph_create(w, g) 30 | sum(abs(generateWeights(graph) - graph_generate_weights(graph2))) 31 | # [1] 9.57498e-14 32 | index <- generateWeights2(w, g)[, 1:m] 33 | index$sort_order <- apply(index, 1, paste0, collapse = "") 34 | weighting <- generateWeights2(w, g)[order(index$sort_order), ] 35 | sum(abs(generateWeights(graph) - weighting)) 36 | # [1] 9.57498e-14 37 | microbenchmark(generateWeights(graph), graph_generate_weights(graph2), generateWeights2(w, g), times = 100) 38 | # Unit: milliseconds 39 | # expr min lq mean median uq max neval cld 40 | # generateWeights(graph) 271.3074 351.05725 381.27900 366.52960 405.13855 573.3192 100 c 41 | # graph_generate_weights(graph2) 19.6396 25.02335 27.43096 26.45735 30.01245 44.6063 100 a 42 | # generateWeights2(w, g) 46.9391 61.18770 66.57833 65.35435 70.96360 178.6717 100 b 43 | 44 | -------------------------------------------------------------------------------- /misc/examples.R: -------------------------------------------------------------------------------- 1 | # Calculate weight for index h 2 | # Less time than gMCP::mtp.weights and gMCP:mtp.edges 3 | # It would be great to further improve efficiency 4 | calcWeight <- function(w, g, h){ 5 | if (sum(h == 0) > 0) { 6 | for (i in 1:sum(h == 0)) { 7 | rej <- which(h == 0)[i] 8 | g1 <- array(0, dim = c(length(w), length(w))) 9 | for (j in 1:length(w)){ 10 | w[j] <- w[j] + w[rej] * g[rej, j] 11 | g1[j, ] <- (g[j, ] + g[j, rej] * g[rej, ]) / (1 - g[j, rej] * g[rej, j]) 12 | g1[j, j] <- 0 13 | g1[j, is.nan(g1[j, ])] <- 0 14 | } 15 | w[rej] <- 0 16 | g <- g1 17 | g[rej, ] <- 0 18 | g[, rej] <- 0 19 | } 20 | } 21 | return(list(w, g)) 22 | } 23 | 24 | # Vectorized 25 | calcWeight <- function (h, g, w) 26 | { 27 | m <- length(h) 28 | index <- 1L:m 29 | Jc <- index[h == 0] 30 | for (j in Jc) { 31 | index <- index[index != j] 32 | Jc <- Jc[Jc != j] 33 | w[index] <- w[index] + w[j] * g[j, index] 34 | w[j] <- 0 35 | gg1 <- g[, j] %o% g[j, ] 36 | gg2 <- (g[, j] * g[j, ]) %o% rep(1L, m) 37 | g1 <- (g + gg1)/(1 - gg2) 38 | g1[j, ] <- 0 39 | g1[, j] <- 0 40 | diag(g1) <- 0 41 | g1[gg2 >= 1] <- 0 42 | g <- g1 43 | } 44 | return(w) 45 | } 46 | 47 | delete_nodes_vec <- function (h, g, w) 48 | { 49 | m <- length(h) 50 | index <- 1L:m 51 | Jc <- index[h == 0] 52 | for (j in Jc) { 53 | index <- index[index != j] 54 | Jc <- Jc[Jc != j] 55 | w[index] <- w[index] + w[j] * g[j, index] 56 | w[j] <- 0 57 | gg1 <- g[, j] %o% g[j, ] 58 | gg2 <- (g[, j] * g[j, ]) %o% rep(1L, m) 59 | g1 <- (g + gg1)/(1 - gg2) 60 | g1[j, ] <- 0 61 | g1[, j] <- 0 62 | diag(g1) <- 0 63 | g1[gg2 >= 1] <- 0 64 | g <- g1 65 | } 66 | return(structure(list(hypotheses = w, transitions = g), class = "initial_graph")) 67 | } 68 | -------------------------------------------------------------------------------- /man/print.initial_graph.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/print.initial_graph.R 3 | \name{print.initial_graph} 4 | \alias{print.initial_graph} 5 | \title{S3 print method for the class \code{initial_graph}} 6 | \usage{ 7 | \method{print}{initial_graph}(x, ..., precision = 4, indent = 0) 8 | } 9 | \arguments{ 10 | \item{x}{An object of class \code{initial_graph} to print.} 11 | 12 | \item{...}{Other values passed on to other methods (currently unused).} 13 | 14 | \item{precision}{An integer scalar indicating the number of decimal places 15 | to to display.} 16 | 17 | \item{indent}{An integer scalar indicating how many spaces to indent results.} 18 | } 19 | \value{ 20 | An object x of class \code{initial_graph}, after printing the initial 21 | graph. 22 | } 23 | \description{ 24 | A printed \code{initial_graph} displays a header stating "Initial graph", 25 | hypothesis weights, and transition weights. 26 | } 27 | \examples{ 28 | # A graphical multiple comparison procedure with two primary hypotheses (H1 29 | # and H2) and two secondary hypotheses (H3 and H4) 30 | # See Figure 1 in Bretz et al. (2011). 31 | hypotheses <- c(0.5, 0.5, 0, 0) 32 | transitions <- rbind( 33 | c(0, 0, 1, 0), 34 | c(0, 0, 0, 1), 35 | c(0, 1, 0, 0), 36 | c(1, 0, 0, 0) 37 | ) 38 | hyp_names <- c("H11", "H12", "H21", "H22") 39 | g <- graph_create(hypotheses, transitions, hyp_names) 40 | g 41 | } 42 | \references{ 43 | Bretz, F., Posch, M., Glimm, E., Klinglmueller, F., Maurer, W., and 44 | Rohmeyer, K. (2011). Graphical approaches for multiple comparison 45 | procedures using weighted Bonferroni, Simes, or parametric tests. 46 | \emph{Biometrical Journal}, 53(6), 894-913. 47 | } 48 | \seealso{ 49 | \code{\link[=print.updated_graph]{print.updated_graph()}} for the print method for the updated graph after 50 | hypotheses being deleted from the initial graph. 51 | } 52 | -------------------------------------------------------------------------------- /misc/functions/fun_common_c.R: -------------------------------------------------------------------------------- 1 | # Functions to calculate the critical value and the p-value 2 | # for an intersection hypothesis using common c 3 | # Section 4.3 equation (5) 4 | 5 | ## Input parameters 6 | # alpha = significance level 7 | # p = a vector of unadjusted p-values 8 | # w = a vector of local weights 9 | # cr = correlation matrix among test statistics 10 | 11 | # make sure the current working directory is the folder code/ 12 | # now source the function definitions: 13 | source("./perf-tests/functions/fun_miscellaneous.R") 14 | 15 | # Function to find the common critical value c for an intersection hypothesis 16 | # x is to be solved 17 | common_c_function <- function(x, w, cr, alpha){ 18 | require(mvtnorm) 19 | I <- which(w>0) 20 | subw <- w[I] 21 | subcr <- cr[I, I] 22 | subsets <- subset_function(subcr) 23 | nsubsets <- length(subsets) 24 | y <- 0 25 | for (i in 1:nsubsets){ 26 | ind <- subsets[[i]] 27 | z <- qnorm(pmin(x * subw[ind] * alpha, 1), lower.tail=FALSE) 28 | y1 <- ifelse(length(z)==1, pnorm(z, lower.tail=FALSE), 29 | 1-pmvnorm(upper=z, test_corr=subcr[ind, ind])) 30 | y <- y + y1 31 | } 32 | return(y - alpha * sum(w)) 33 | } 34 | 35 | # p-value function for an intersection hypothesis using a common c 36 | # a is the p-value to be solved 37 | p_common_c_function <- function(a, p, w, cr){ 38 | require(mvtnorm) 39 | I <- which(w > 0) 40 | subw <- w[I] 41 | subcr <- cr[I, I] 42 | subp <- p[I] 43 | subsets <- subset_function(subcr) 44 | nsubsets <- length(subsets) 45 | c_common <- ifelse(length(nsubsets) == 1 && length(subsets[[1]]) == 1, 1, 46 | uniroot(common_c_function, lower = 0.1, 47 | upper = 1 / min(subw), 48 | w = w, cr = cr, alpha = a)$root) 49 | wP <- w * c_common * a 50 | return(min(p[wP > 0] - wP[wP > 0])) 51 | } 52 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/02_feature_request.yml: -------------------------------------------------------------------------------- 1 | name: Feature Request 2 | description: Enchancement to graphicalMCP functionality 3 | title: "Feature Request: " 4 | labels: ["enhancement", "programming"] 5 | body: 6 | - type: markdown 7 | attributes: 8 | value: | 9 | Thanks for taking the time to fill out this feature request! We love keeping graphicalMCP fresh! 10 | - type: textarea 11 | id: feature 12 | attributes: 13 | label: Feature Idea 14 | description: Tell us your idea in as few words as possible 15 | placeholder: "`graph_test_closure` should support such and such test" 16 | validations: 17 | required: true 18 | - type: textarea 19 | id: input 20 | attributes: 21 | label: Relevant Input 22 | description: Can you provide what the inputs should look like? 23 | placeholder: "What should the input look like? REMINDER: No patient level data or company sensitive information should be shared via this open public issue" 24 | validations: 25 | required: false 26 | - type: textarea 27 | id: output 28 | attributes: 29 | label: Relevant Output 30 | description: Can you provide what the final output should look like? 31 | placeholder: "What should the output look like? REMINDER: No patient level data or company sensitive information should be shared via this open public issue" 32 | validations: 33 | required: false 34 | - type: textarea 35 | id: code 36 | attributes: 37 | label: Reproducible Example/Pseudo Code 38 | description: Can you provide a working example or a sketch of how the code should work? 39 | placeholder: "We love example code, and it will speed up the process! REMINDER: No patient level data or company sensitive information should be shared via this open public issue" 40 | validations: 41 | required: false 42 | -------------------------------------------------------------------------------- /man/print.graph_report.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/print.graph_report.R 3 | \name{print.graph_report} 4 | \alias{print.graph_report} 5 | \title{S3 print method for the class \code{graph_report}} 6 | \usage{ 7 | \method{print}{graph_report}(x, ..., precision = 4, indent = 2, rows = 10) 8 | } 9 | \arguments{ 10 | \item{x}{An object of class \code{graph_report} to print.} 11 | 12 | \item{...}{Other values passed on to other methods (currently unused)} 13 | 14 | \item{precision}{An integer scalar indicating the number of decimal places 15 | to to display.} 16 | 17 | \item{indent}{An integer scalar indicating how many spaces to indent results.} 18 | 19 | \item{rows}{An integer scalar indicating how many rows of detailed test 20 | results to print.} 21 | } 22 | \value{ 23 | An object x of class \code{graph_report}, after printing the report of 24 | conducting a graphical multiple comparison procedure. 25 | } 26 | \description{ 27 | A printed \code{graph_report} displays the initial graph, p-values and 28 | significance levels, rejection decisions, and optional detailed test results. 29 | } 30 | \examples{ 31 | # A graphical multiple comparison procedure with two primary hypotheses (H1 32 | # and H2) and two secondary hypotheses (H3 and H4) 33 | # See Figure 1 in Bretz et al. (2011). 34 | hypotheses <- c(0.5, 0.5, 0, 0) 35 | transitions <- rbind( 36 | c(0, 0, 1, 0), 37 | c(0, 0, 0, 1), 38 | c(0, 1, 0, 0), 39 | c(1, 0, 0, 0) 40 | ) 41 | g <- graph_create(hypotheses, transitions) 42 | 43 | p <- c(0.018, 0.01, 0.105, 0.006) 44 | alpha <- 0.025 45 | graph_test_shortcut(g, p, alpha) 46 | } 47 | \references{ 48 | Bretz, F., Posch, M., Glimm, E., Klinglmueller, F., Maurer, W., and 49 | Rohmeyer, K. (2011). Graphical approaches for multiple comparison 50 | procedures using weighted Bonferroni, Simes, or parametric tests. 51 | \emph{Biometrical Journal}, 53(6), 894-913. 52 | } 53 | -------------------------------------------------------------------------------- /misc/functions/fun_separate_c.R: -------------------------------------------------------------------------------- 1 | # Functions to calculate the critical value and the p-value 2 | # for an intersection hypothesis using separate c's 3 | # Section 4.3 equation (7) 4 | 5 | # Input parameters 6 | # alpha = overall significance level 7 | # p = a vector of unadjusted p-values 8 | # w = a vector of local weights 9 | # cr = correlation matrix among test statistics 10 | 11 | # make sure the current working directory is the folder code/ 12 | # now source the function definitions: 13 | source("./perf-tests/functions/fun_miscellaneous.R") 14 | 15 | # Function to find the separate critical value c's for all subsets 16 | # in an intersection hypothesis 17 | # separate_c_function <- function(w, cr, alpha){ 18 | # require(mvtnorm) 19 | # I <- which(w>0) 20 | # subw <- w[I] 21 | # subcr <- cr[I, I] 22 | # subsets <- subset_function(subcr) 23 | # nsubsets <- length(subsets) 24 | # wP <- w 25 | # c <- rep(0,nsubsets) 26 | # for (i in 1:nsubsets){ 27 | # ind <- subsets[[i]] 28 | # c[i] <- ifelse(length(ind)==1, 1, 29 | # uniroot(c_function, lower = 0.9, upper = 1/min(subw), 30 | # w = subw[ind], cr = subcr[ind, ind], 31 | # alpha = alpha)$root) 32 | # wP[I[ind]] <- subw[ind] * c[i] 33 | # } 34 | # return(list(c, wP)) 35 | # } 36 | 37 | # p-value function for an intersection hypothesis using separate c's 38 | p_separate_c_function <- function(p, w, cr){ 39 | require(mvtnorm) 40 | I <- which(w > 0) 41 | subw <- w[I] 42 | subcr <- cr[I, I] 43 | subp <- p[I] 44 | subsets <- subset_function(subcr) 45 | nsubsets <- length(subsets) 46 | pJ <- subp 47 | for (i in 1:nsubsets){ 48 | ind <- subsets[[i]] 49 | if (length(ind) != 1){ 50 | q <- min(subp[ind] / subw[ind]) 51 | q <- q * subw[ind] 52 | pJ[ind] <- 1 / sum(subw[ind]) * 53 | (1 - pmvnorm(upper = qnorm(q, lower.tail = F), test_corr = subcr[ind, ind])) 54 | } else { 55 | pJ[ind] <- subp[ind] / subw[ind] 56 | } 57 | } 58 | return(min(pJ)) 59 | } 60 | -------------------------------------------------------------------------------- /misc/renderer.R: -------------------------------------------------------------------------------- 1 | rmarkdown::render( 2 | here::here("vignettes/testing-basics.Rmd"), 3 | output_file = here::here( 4 | paste0( 5 | "vignettes/knitted/testing-basics-m", 6 | 3, 7 | "-nsim", 8 | 100000, 9 | "-", 10 | stringr::str_replace_all(Sys.Date(), "-", "") 11 | ) 12 | ), 13 | params = list(m = 3) 14 | ) 15 | 16 | rmarkdown::render( 17 | here::here("vignettes/testing-basics.Rmd"), 18 | output_file = here::here( 19 | paste0( 20 | "vignettes/knitted/testing-basics-m", 21 | 4, 22 | "-nsim", 23 | 100000, 24 | "-", 25 | stringr::str_replace_all(Sys.Date(), "-", "") 26 | ) 27 | ), 28 | params = list(m = 4) 29 | ) 30 | 31 | rmarkdown::render( 32 | here::here("vignettes/testing-basics.Rmd"), 33 | output_file = here::here( 34 | paste0( 35 | "vignettes/knitted/testing-basics-m", 36 | 5, 37 | "-nsim", 38 | 100000, 39 | "-", 40 | stringr::str_replace_all(Sys.Date(), "-", "") 41 | ) 42 | ), 43 | params = list(m = 5) 44 | ) 45 | 46 | 47 | rmarkdown::render( 48 | here::here("vignettes/testing-basics.Rmd"), 49 | output_file = here::here( 50 | paste0( 51 | "vignettes/knitted/testing-basics-m", 52 | 6, 53 | "-nsim", 54 | 100000, 55 | "-", 56 | stringr::str_replace_all(Sys.Date(), "-", "") 57 | ) 58 | ), 59 | params = list(m = 6) 60 | ) 61 | 62 | rmarkdown::render( 63 | here::here("vignettes/testing-basics.Rmd"), 64 | output_file = here::here( 65 | paste0( 66 | "vignettes/knitted/testing-basics-m", 67 | 7, 68 | "-nsim", 69 | 100000, 70 | "-", 71 | stringr::str_replace_all(Sys.Date(), "-", "") 72 | ) 73 | ), 74 | params = list(m = 7) 75 | ) 76 | 77 | rmarkdown::render( 78 | here::here("vignettes/testing-basics.Rmd"), 79 | output_file = here::here( 80 | paste0( 81 | "vignettes/knitted/testing-basics-m", 82 | 8, 83 | "-nsim", 84 | 100000, 85 | "-", 86 | stringr::str_replace_all(Sys.Date(), "-", "") 87 | ) 88 | ), 89 | params = list(m = 8) 90 | ) 91 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | # Version 0.2.8 2 | 3 | - This is the eighth submission to CRAN. 4 | - Corrected urls of references 5 | 6 | ## R CMD check results 7 | 8 | 0 errors | 0 warnings | 0 notes 9 | 10 | # Version 0.2.7 11 | 12 | - This is the seventh submission to CRAN. 13 | - Added Hochberg tests 14 | - Added interval validation 15 | 16 | ## R CMD check results 17 | 18 | 0 errors | 0 warnings | 0 notes 19 | 20 | # Version 0.2.6 21 | 22 | - This is the sixth submission to CRAN. 23 | + Updated links since the repository has been moved to openpharma 24 | 25 | ## R CMD check results 26 | 27 | 0 errors | 0 warnings | 0 notes 28 | 29 | # Version 0.2.5 30 | 31 | - This is the fifth submission to CRAN. 32 | + Updated adjust_weights_parametric_util.Rd 33 | + There is one note regarding the spelling of "al", "et", "Bretz", "MCPs" and 34 | "familywise". This is to confirm that they are correct. 35 | 36 | ## R CMD check results 37 | 38 | 0 errors | 0 warnings | 0 notes 39 | 40 | # Version 0.2.4 41 | 42 | - This is the fourth submission to CRAN. 43 | + Updated documentation according to issue #84 44 | + There is one note regarding the spelling of "MCPs" and "familywise". This is 45 | to confirm that they are correct. 46 | 47 | ## R CMD check results 48 | 49 | 0 errors | 0 warnings | 0 notes 50 | 51 | # Version 0.2.3 52 | 53 | - This is the third submission to CRAN. 54 | + Included cran-comments.md in .Rbuildignore. 55 | + There is one note regarding the spelling of "MCPs" and "familywise". This is 56 | to confirm that they are correct. 57 | 58 | ## R CMD check results 59 | 60 | 0 errors | 0 warnings | 0 notes 61 | 62 | # Version 0.2.2 63 | 64 | - This is the second submission to CRAN. 65 | + Updated citations to correct three notes. 66 | + Reduced the number of simulations in the example for `graph_calculate_power` 67 | to correct one note regarding long run time. 68 | 69 | ## R CMD check results 70 | 71 | 0 errors | 0 warnings | 0 notes 72 | 73 | # Version 0.2.1 74 | 75 | - This is a new release and the first submission to CRAN. 76 | 77 | ## R CMD check results 78 | 79 | 0 errors | 0 warnings | 0 notes 80 | 81 | -------------------------------------------------------------------------------- /misc/plot_igraph.R: -------------------------------------------------------------------------------- 1 | library(igraph) 2 | 3 | hab <- huque_etal() 4 | wd <- fallback_improved_1(rep(1 / 3, 3)) 5 | bh <- bonferroni_holm(rep(1 / 9, 9)) 6 | gex <- simple_successive_1(names = c("Non-inferiority Low", 7 | "Non-inferiority High", 8 | "Superiority Low", 9 | "Superiority High")) 10 | g <- hab 11 | 12 | names_cross <- rev(expand.grid( 13 | end = names(g$hypotheses), 14 | start = names(g$hypotheses), 15 | stringsAsFactors = FALSE 16 | )) 17 | # names_cross <- names_cross[order(names_cross$start), ] 18 | 19 | edge_rows <- apply( 20 | names_cross, 21 | 1, 22 | \(row) g$transitions[row[[1]], row[[2]]] 23 | ) != 0 24 | 25 | df_edges <- names_cross[edge_rows, ] 26 | 27 | igraph <- make_directed_graph(t(df_edges)) 28 | 29 | vert_labels <- paste( 30 | names(V(igraph)), 31 | round(g$hypotheses[names(V(igraph))], 4), 32 | sep = "\n" 33 | ) 34 | edge_labels <- round(diag(g$transitions[df_edges$start, df_edges$end]), 4) 35 | 36 | t(df_edges) |> 37 | make_directed_graph() |> 38 | plot( 39 | # gex 40 | # layout = rbind( 41 | # c(1, 2), 42 | # c(1, 1), 43 | # c(2, 2), 44 | # c(2, 1) 45 | # ), 46 | # bh 47 | # layout = layout_in_circle, 48 | # wd 49 | layout = rbind(c(-1, 0), c(0, 0), c(1, 0), c(2, 0)), 50 | vertex.size = 30, 51 | vertex.label = vert_labels, 52 | vertex.color = "#a069c4", 53 | vertex.label.color = "black", 54 | # vertex.label.dist = 4, 55 | vertex.label.degree = c(pi/4, pi/4, -pi/4, -pi/4), 56 | edge.color = rep(c("black", "purple"), 6), 57 | edge.label = paste0("\n ", edge_labels ), 58 | edge.label = edge_labels, 59 | edge.label.color = rep(c("black", "purple"), 6), 60 | # wd 61 | edge.curved = rep(-1, 6) 62 | # edge.curved = c(-0.5, -0.5, -1, -1.5, -1.5, -2.5) 63 | # edge.width = 5, 64 | # edge.label.y = .5, 65 | # edge.arrow.size = 2, 66 | # edge.arrow.width = 5 67 | ) 68 | 69 | -------------------------------------------------------------------------------- /man/graph_test_fast.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/power_tests.R 3 | \name{graph_test_closure_fast} 4 | \alias{graph_test_closure_fast} 5 | \alias{graph_test_shortcut_fast} 6 | \title{Perform graphical multiple comparison procedures efficiently for power 7 | calculation} 8 | \usage{ 9 | graph_test_closure_fast(p, alpha, adjusted_weights, matrix_intersections) 10 | 11 | graph_test_shortcut_fast(p, alpha, adjusted_weights) 12 | } 13 | \arguments{ 14 | \item{p}{A numeric vector of one-sided p-values (unadjusted, raw), whose 15 | values should be between 0 & 1. The length should match the number of 16 | hypotheses in \code{graph}.} 17 | 18 | \item{alpha}{A numeric value of the one-sided overall significance level, 19 | which should be between 0 & 1. The default is 0.025 for one-sided 20 | hypothesis testing. Note that only one-sided tests are supported.} 21 | 22 | \item{adjusted_weights}{The adjusted hypothesis weights, which are the 23 | second half of columns from \code{\link[=graph_generate_weights]{graph_generate_weights()}} output, adjusted by 24 | the appropriate test types (Bonferroni, Simes, or parametric).} 25 | 26 | \item{matrix_intersections}{A matrix of hypothesis indicators in a weighting 27 | strategy, which are the first half the \code{\link[=graph_generate_weights]{graph_generate_weights()}} output.} 28 | } 29 | \value{ 30 | A logical or integer vector indicating whether each hypothesis can 31 | be rejected or not. 32 | } 33 | \description{ 34 | These functions performs similarly to \code{\link[=graph_test_closure]{graph_test_closure()}} or 35 | \code{\link[=graph_test_shortcut]{graph_test_shortcut()}} but are optimized for efficiently calculating power. 36 | For example, generating weights and calculating adjusted weights can be done 37 | only once. Vectorization has been applied where possible. 38 | } 39 | \seealso{ 40 | \itemize{ 41 | \item \code{\link[=graph_test_closure]{graph_test_closure()}} for closed graphical multiple comparison 42 | procedures. 43 | \item \code{\link[=graph_test_shortcut]{graph_test_shortcut()}} for shortcut graphical multiple comparison 44 | procedures. 45 | } 46 | } 47 | \keyword{internal} 48 | -------------------------------------------------------------------------------- /man/print.updated_graph.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/print.updated_graph.R 3 | \name{print.updated_graph} 4 | \alias{print.updated_graph} 5 | \title{S3 print method for the class \code{updated_graph}} 6 | \usage{ 7 | \method{print}{updated_graph}(x, ..., precision = 6, indent = 2) 8 | } 9 | \arguments{ 10 | \item{x}{An object of the class \code{updated_graph} to print.} 11 | 12 | \item{...}{Other values passed on to other methods (currently unused).} 13 | 14 | \item{precision}{An integer scalar indicating the number of decimal places 15 | to to display.} 16 | 17 | \item{indent}{An integer scalar indicating how many spaces to indent results.} 18 | } 19 | \value{ 20 | An object x of the class \code{updated_graph}, after printing the updated 21 | graph. 22 | } 23 | \description{ 24 | A printed \code{updated_graph} displays the initial graph, the (final) updated 25 | graph, and the sequence of intermediate updated graphs after hypotheses are 26 | deleted (if available). 27 | } 28 | \examples{ 29 | # A graphical multiple comparison procedure with two primary hypotheses (H1 30 | # and H2) and two secondary hypotheses (H3 and H4) 31 | # See Figure 1 in Bretz et al. (2011). 32 | hypotheses <- c(0.5, 0.5, 0, 0) 33 | transitions <- rbind( 34 | c(0, 0, 1, 0), 35 | c(0, 0, 0, 1), 36 | c(0, 1, 0, 0), 37 | c(1, 0, 0, 0) 38 | ) 39 | g <- graph_create(hypotheses, transitions) 40 | 41 | # Delete the second and third hypotheses in the "unordered mode" 42 | graph_update(g, delete = c(FALSE, TRUE, TRUE, FALSE)) 43 | 44 | # Equivalent way in the "ordered mode" to obtain the updated graph after 45 | # deleting the second and third hypotheses 46 | # Additional intermediate updated graphs are also provided 47 | graph_update(g, delete = 2:3) 48 | } 49 | \references{ 50 | Bretz, F., Posch, M., Glimm, E., Klinglmueller, F., Maurer, W., and 51 | Rohmeyer, K. (2011a). Graphical approaches for multiple comparison 52 | procedures using weighted Bonferroni, Simes, or parametric tests. 53 | \emph{Biometrical Journal}, 53(6), 894-913. 54 | } 55 | \seealso{ 56 | \code{\link[=print.initial_graph]{print.initial_graph()}} for the print method for the initial graph. 57 | } 58 | -------------------------------------------------------------------------------- /tests/testthat/test-print.power_report.R: -------------------------------------------------------------------------------- 1 | test_that("printing Bonferroni power - sequential", { 2 | g <- huque_etal() 3 | 4 | set.seed(51223) 5 | expect_snapshot(graph_calculate_power(g, sim_n = 5, verbose = TRUE)) 6 | 7 | set.seed(51223) 8 | expect_snapshot(print(graph_calculate_power(g, sim_n = 100), 9 | indent = 6, precision = 3 10 | )) 11 | }) 12 | 13 | test_that("printing Simes power", { 14 | g <- simple_successive_1() 15 | 16 | set.seed(51223) 17 | expect_snapshot(graph_calculate_power(g, test_types = "s", sim_n = 100)) 18 | 19 | set.seed(51223) 20 | expect_snapshot( 21 | print(graph_calculate_power(g, test_types = "s", sim_n = 100), 22 | indent = 6, 23 | precision = 3 24 | ) 25 | ) 26 | }) 27 | 28 | test_that("printing parametric power", { 29 | g <- fixed_sequence(4) 30 | 31 | set.seed(51223) 32 | expect_snapshot( 33 | graph_calculate_power(g, 34 | test_types = "p", sim_n = 100, 35 | test_corr = list(diag(4)) 36 | ) 37 | ) 38 | 39 | set.seed(51223) 40 | expect_snapshot( 41 | print( 42 | graph_calculate_power(g, 43 | test_types = "p", 44 | sim_n = 100, 45 | test_corr = list(diag(4)) 46 | ), 47 | indent = 6, 48 | precision = 3 49 | ) 50 | ) 51 | }) 52 | 53 | test_that("printing blended power", { 54 | g <- bonferroni_holm(6) 55 | 56 | t_corr <- matrix(pi / 4, nrow = 6, ncol = 6) 57 | diag(t_corr) <- 1 58 | 59 | s_corr <- matrix(pi / 4, nrow = 6, ncol = 6) 60 | diag(s_corr) <- 1 61 | 62 | set.seed(51223) 63 | expect_snapshot( 64 | print( 65 | graph_calculate_power( 66 | graph = g, 67 | alpha = 0.0254871, 68 | power_marginal = pi / seq(.3, 2.8, by = .5) / 11, 69 | test_groups = list(4:3, c(6, 1), c(2, 5)), 70 | test_types = c("b", "s", "p"), 71 | test_corr = list(NA, NA, t_corr[c(2, 5), c(2, 5)]), 72 | sim_n = 1328, 73 | sim_corr = s_corr, 74 | sim_success = list( 75 | function(.) .[1] || .[5] || .[6], 76 | function(.) .[2] && (.[5] || .[6]) 77 | ), 78 | verbose = TRUE 79 | ), 80 | indent = 0, 81 | precision = 10 82 | ) 83 | ) 84 | }) 85 | -------------------------------------------------------------------------------- /.github/pull_request_template.md: -------------------------------------------------------------------------------- 1 | ### Thank you for your Pull Request! 2 | 3 | We have developed a Pull Request template to aid you and our reviewers. Completing the below tasks helps to ensure our reviewers can maximize their time on your code as well as making sure the graphicalMCP codebase remains robust and consistent. 4 | 5 | ### Changes Description 6 | 7 | _(descriptions of changes)_ 8 | 9 | ### Task List 10 | 11 | This is a list of tasks that can be done by contributors to make reviewing faster and more straightforward. If you're unsure how to do any or all of these, please make your contributions anyway. We are happy to work with you on any of them! However, know that your contributions may be more likely to be accepted, or be accepted more quickly, the more of these you can accomplish. They are roughly sorted in descending order of helpfulness. 12 | 13 | - [ ] Fill out **Changes Description** above 14 | - [ ] Update relevant unit tests or write new unit tests 15 | - [ ] Create/update relevant roxygen headers and examples 16 | - [ ] Run `pkgdown::build_site()` and check that all affected examples are displayed correctly and that all new/updated functions occur on the "Reference" page 17 | - [ ] Update NEWS.md with a brief summary of changes made - Note the related issue number(s) at the end like (#000) 18 | - [ ] Make sure that the package versions in the NEWS.md and DESCRIPTION file are the same 19 | - [ ] Place Closes # into the beginning of your Pull Request Title (Use Edit button in top-right if you need to update) 20 | - [ ] Format code according to the [tidyverse style guide](https://style.tidyverse.org/) (Run `styler::style_pkg()`) 21 | - [ ] Run `devtools::document()` so all `.Rd` files in the `man` folder and the `NAMESPACE` file in the project root are updated appropriately 22 | - [ ] Run `codemetar::write_codemeta()` to update codemeta.json 23 | - [ ] Address any updates needed for vignettes and/or templates 24 | - [ ] Link the issue Development Panel so that the related issue closes after successful merging 25 | - [ ] Fix merge conflicts 26 | - [ ] Pat yourself on the back for a job well done! Here's a random cat gif for your hard work :) 27 | 28 | 29 | -------------------------------------------------------------------------------- /tests/testthat/test-graph_update.R: -------------------------------------------------------------------------------- 1 | hypotheses <- c(0.5, 0.5, 0, 0) 2 | transitions <- rbind( 3 | c(0, 0, 1, 0), 4 | c(0, 0, 0, 1), 5 | c(0, 1, 0, 0), 6 | c(1, 0, 0, 0) 7 | ) 8 | names <- c("H1", "H2", "H3", "H4") 9 | g <- graph_create(hypotheses, transitions, names) 10 | 11 | m6 <- matrix(1 / 5, nrow = 6, ncol = 6) 12 | diag(m6) <- 0 13 | bh6 <- graph_create(rep(1 / 6, 6), m6) 14 | 15 | test_that("basic updating & structure", { 16 | expect_s3_class(graph_update(g, c(FALSE, FALSE, TRUE, TRUE)), "updated_graph") 17 | expect_equal(graph_update(g, c(FALSE, FALSE, FALSE, TRUE))$initial_graph, g) 18 | expect_equal(graph_update(g, c(1, 2, 3, 4))$initial_graph, g) 19 | expect_length(graph_update(g, c(FALSE, FALSE, TRUE, TRUE)), 4) 20 | expect_length(graph_update(g, 1:2), 4) 21 | expect_equal( 22 | attr(graph_update(g, c(FALSE, FALSE, TRUE, TRUE))$updated_graph, "title"), 23 | "Updated graph" 24 | ) 25 | expect_equal( 26 | attr(graph_update(g, c(FALSE, FALSE, TRUE, TRUE))$updated_graph, "deleted"), 27 | 3:4 28 | ) 29 | }) 30 | 31 | test_that("invalid input", { 32 | expect_error(graph_update(g, c(FALSE, TRUE, TRUE))) 33 | expect_error(graph_update(g, c(0, 1, 1, "1"))) 34 | expect_error(graph_update(g, c(0, 1, 1, 1))) 35 | expect_error(graph_update(g, c(1, 2, 3, 3))) 36 | expect_error(graph_update(g, c(1, 2, 3, 5))) 37 | }) 38 | 39 | test_that("generate floating point differences", { 40 | expect_s3_class( 41 | updated_1 <- graph_update( 42 | bh6, 43 | c(FALSE, FALSE, FALSE, TRUE, TRUE, TRUE) 44 | )$updated_graph, 45 | "initial_graph" 46 | ) 47 | expect_s3_class( 48 | updated_2 <- graph_update( 49 | updated_1, 50 | c(FALSE, FALSE, TRUE, TRUE, TRUE, TRUE) 51 | )$updated_graph, 52 | "initial_graph" 53 | ) 54 | expect_s3_class( 55 | updated_3 <- graph_update( 56 | updated_2, 57 | c(FALSE, TRUE, TRUE, TRUE, TRUE, TRUE) 58 | )$updated_graph, 59 | "initial_graph" 60 | ) 61 | expect_false( 62 | all( 63 | vapply( 64 | rowSums(updated_1$transitions), 65 | function(x) x == 1 || x == 0, 66 | logical(1) 67 | ) 68 | ) 69 | ) 70 | expect_false( 71 | all( 72 | vapply( 73 | rowSums(updated_2$transitions), 74 | function(x) x == 1 || x == 0, 75 | logical(1) 76 | ) 77 | ) 78 | ) 79 | expect_false(all(updated_3$hypotheses == 1 | updated_2$hypotheses == 0)) 80 | }) 81 | -------------------------------------------------------------------------------- /misc/gMCP_examples.R: -------------------------------------------------------------------------------- 1 | library(gMCP) 2 | 3 | hypotheses <- c("ni_lo" = 0.5, ni_hi = 0.5, su_lo = 0, su_hi = 0) 4 | transitions <- rbind( 5 | c(0, 0, 1, 0), 6 | c(0, 0, 0, 1), 7 | c(0, 1, 0, 0), 8 | c(1, 0, 0, 0) 9 | ) 10 | g <- graph_create(hypotheses, transitions) 11 | G <- matrix2graph(transitions, hypotheses) 12 | 13 | bh4 <- bonferroni_holm(4) 14 | BH4 <- matrix2graph(bh4$transitions, bh4$hypotheses) 15 | 16 | p_vals <- c(.001, .02, .05, .1) 17 | p_vals2 <- c(.001, .02, .05, .05) 18 | corr1 <- rbind( 19 | c(1, NA, NA, NA), 20 | c(NA, 1, NA, NA), 21 | c(NA, NA, 1, NA), 22 | c(NA, NA, NA, 1) 23 | ) 24 | corr2 <- rbind( 25 | c(1, .5, NA, NA), 26 | c(.5, 1, NA, NA), 27 | c(NA, NA, 1, .5), 28 | c(NA, NA, .5, 1) 29 | ) 30 | corr2_ <- rbind( 31 | c(1, .5, 0, 0), 32 | c(.5, 1, 0, 0), 33 | c(0, 0, 1, .5), 34 | c(0, 0, .5, 1) 35 | ) 36 | dimnames(corr1) <- dimnames(corr2) <- list(names(hypotheses), names(hypotheses)) 37 | alpha <- .025 38 | 39 | p <- 1-pnorm(c(2.24,2.24,2.24,2.3)) 40 | 41 | # Bonferroni 42 | gMCP(G, p) 43 | graph_test_closure(g, p) 44 | 45 | # parametric 46 | gMCP(G, p, test_corr = corr2, test = "parametric") 47 | graph_test_closure(g, p, test_corr = corr2_, alpha = .05, 48 | tests = list(parametric = list(1:4))) 49 | 50 | 51 | # Simes 52 | gMCP(G, p, test = "Simes") 53 | graph_test_closure(g, p, alpha = .05, tests = list(simes = list(1:4))) 54 | graph_test_closure(g, p, alpha = .05, tests = list(simes = list(1, 2, 3, 4))) 55 | 56 | gMCP(BH4, .051 / 1:4, test = "Simes") 57 | graph_test_closure(bh4, .051 / 1:4, alpha = .05, tests = list(simes = list(1:4))) 58 | 59 | graph_test_closure(bh4, .051 / 1:4, tests = list(bonferroni = list(1:4))) 60 | # Simes reduces to Bonferroni if all groups are separated 61 | graph_test_closure(bh4, .051 / 1:4, tests = list(simes = list(1, 2, 3, 4))) 62 | graph_test_closure(bh4, .051 / 1:4, tests = list(simes = list(1:4))) 63 | 64 | # Simes gets more powerful when p-values are equal 65 | graph_test_closure(bh4, rep(.049, 4), tests = list(simes = list(1:4))) 66 | graph_test_closure(bh4, rep(.049, 4), tests = list(bonferroni = list(1:4))) 67 | 68 | graph_test_closure(g, p_vals, tests = list(simes = list(1:4))) 69 | # T/T/F/F 70 | # 71 | # But making p for 3/4 equal actually adds to the weight that both of them are 72 | # getting, making them both pass 73 | graph_test_closure(g, p_vals2, tests = list(simes = list(1:4))) 74 | graph_test_closure(g, c(.001, .02, .049, .051), tests = list(simes = list(1:4))) 75 | graph_test_closure(g, c(.001, .02, .051, .049), tests = list(simes = list(1:4))) 76 | 77 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | url: https://openpharma.github.io/graphicalMCP/ 2 | 3 | template: 4 | bootstrap: 5 5 | 6 | reference: 7 | - title: Creating an initial graph 8 | - desc: Functions for creating a graphical multiple comparison procedure 9 | - contents: 10 | - graph_create 11 | - print.initial_graph 12 | - plot.initial_graph 13 | - as_initial_graph 14 | - as_graphMCP 15 | - as_igraph 16 | - title: Updating a graph 17 | - desc: Functions for updating a graphical multiple comparison procedure after deleting hypotheses 18 | - contents: 19 | - graph_update 20 | - print.updated_graph 21 | - plot.updated_graph 22 | - title: Calculating hypothesis weights in a closure 23 | - desc: Function for generating the weighting strategy 24 | - contents: 25 | - graph_generate_weights 26 | - title: Testing a graphical multiple comparison procedure 27 | - desc: Functions for performing a graphical multiple comparison procedure 28 | - contents: 29 | - graph_test_closure 30 | - graph_test_shortcut 31 | - print.graph_report 32 | - graph_rejection_orderings 33 | - adjust_p_bonferroni 34 | - adjust_p_parametric 35 | - adjust_p_simes 36 | - adjust_p_hochberg 37 | - adjust_weights_parametric 38 | - adjust_weights_simes 39 | - adjust_weights_hochberg 40 | - title: Power simulation 41 | - desc: Functions for performing power simulations 42 | - contents: 43 | - graph_calculate_power 44 | - print.power_report 45 | - title: Example graphs 46 | - desc: Functions for creating example graphical multiple comparison procedures 47 | - contents: 48 | - bonferroni 49 | - bonferroni_weighted 50 | - bonferroni_holm 51 | - bonferroni_holm_weighted 52 | - dunnett_single_step 53 | - dunnett_single_step_weighted 54 | - dunnett_closure_weighted 55 | - fallback 56 | - fallback_improved_1 57 | - fallback_improved_2 58 | - fixed_sequence 59 | - hochberg 60 | - hommel 61 | - huque_etal 62 | - random_graph 63 | - sidak 64 | - simple_successive_1 65 | - simple_successive_2 66 | - two_doses_two_primary_two_secondary 67 | - three_doses_two_primary_two_secondary 68 | 69 | navbar: 70 | structure: 71 | left: [intro, glossary, reference, articles, tutorials, news] 72 | components: 73 | glossary: 74 | text: Glossary 75 | href: articles/glossary.html 76 | reference: 77 | text: Function reference 78 | href: reference/index.html 79 | 80 | articles: 81 | - title: Vignettes 82 | navbar: ~ 83 | contents: 84 | - shortcut-testing 85 | - closed-testing 86 | - graph-examples 87 | - internal-validation 88 | - comparisons 89 | - generate-closure 90 | 91 | - title: Glossary 92 | contents: 93 | - glossary 94 | -------------------------------------------------------------------------------- /man/print.power_report.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/print.power_report.R 3 | \name{print.power_report} 4 | \alias{print.power_report} 5 | \title{S3 print method for the class \code{power_report}} 6 | \usage{ 7 | \method{print}{power_report}(x, ..., precision = 4, indent = 2, rows = 10) 8 | } 9 | \arguments{ 10 | \item{x}{An object of the class \code{power_report} to print} 11 | 12 | \item{...}{Other values passed on to other methods (currently unused)} 13 | 14 | \item{precision}{An integer scalar indicating the number of decimal places 15 | to to display.} 16 | 17 | \item{indent}{An integer scalar indicating how many spaces to indent results.} 18 | 19 | \item{rows}{An integer scalar indicating how many rows of detailed test 20 | results to print.} 21 | } 22 | \value{ 23 | An object x of the class \code{power_report}, after printing the report of 24 | conducting power simulations based on a graphical multiple comparison 25 | procedure. 26 | } 27 | \description{ 28 | A printed \code{power_report} displays the initial graph, testing and simulation 29 | options, power outputs, and optional detailed simulations and test results. 30 | } 31 | \examples{ 32 | # A graphical multiple comparison procedure with two primary hypotheses (H1 33 | # and H2) and two secondary hypotheses (H3 and H4) 34 | # See Figure 4 in Bretz et al. (2011). 35 | alpha <- 0.025 36 | hypotheses <- c(0.5, 0.5, 0, 0) 37 | delta <- 0.5 38 | transitions <- rbind( 39 | c(0, delta, 1 - delta, 0), 40 | c(delta, 0, 0, 1 - delta), 41 | c(0, 1, 0, 0), 42 | c(1, 0, 0, 0) 43 | ) 44 | g <- graph_create(hypotheses, transitions) 45 | 46 | marginal_power <- c(0.8, 0.8, 0.7, 0.9) 47 | corr1 <- matrix(0.5, nrow = 2, ncol = 2) 48 | diag(corr1) <- 1 49 | corr <- rbind( 50 | cbind(corr1, 0.5 * corr1), 51 | cbind(0.5 * corr1, corr1) 52 | ) 53 | success_fns <- list( 54 | # Probability to reject both H1 and H2 55 | `H1andH2` = function(x) x[1] & x[2], 56 | # Probability to reject both (H1 and H3) or (H2 and H4) 57 | `(H1andH3)or(H2andH4)` = function(x) (x[1] & x[3]) | (x[2] & x[4]) 58 | ) 59 | set.seed(1234) 60 | # Bonferroni tests 61 | power_output <- graph_calculate_power( 62 | g, 63 | alpha, 64 | sim_corr = corr, 65 | sim_n = 1e5, 66 | power_marginal = marginal_power, 67 | sim_success = success_fns 68 | ) 69 | } 70 | \references{ 71 | Bretz, F., Posch, M., Glimm, E., Klinglmueller, F., Maurer, W., and 72 | Rohmeyer, K. (2011a). Graphical approaches for multiple comparison 73 | procedures using weighted Bonferroni, Simes, or parametric tests. 74 | \emph{Biometrical Journal}, 53(6), 894-913. 75 | 76 | Bretz, F., Maurer, W., and Hommel, G. (2011b). Test and power 77 | considerations for multiple endpoint analyses using sequentially rejective 78 | graphical procedures. \emph{Statistics in Medicine}, 30(13), 1489-1501. 79 | } 80 | -------------------------------------------------------------------------------- /man/as_graph.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/as_graph.R 3 | \name{as_initial_graph} 4 | \alias{as_initial_graph} 5 | \alias{as_initial_graph.graphMCP} 6 | \alias{as_initial_graph.igraph} 7 | \alias{as_graphMCP} 8 | \alias{as_graphMCP.initial_graph} 9 | \alias{as_igraph} 10 | \alias{as_igraph.initial_graph} 11 | \title{Convert between graphicalMCP, gMCP, and igraph graph classes} 12 | \usage{ 13 | as_initial_graph(graph) 14 | 15 | \method{as_initial_graph}{graphMCP}(graph) 16 | 17 | \method{as_initial_graph}{igraph}(graph) 18 | 19 | as_graphMCP(graph) 20 | 21 | \method{as_graphMCP}{initial_graph}(graph) 22 | 23 | as_igraph(graph) 24 | 25 | \method{as_igraph}{initial_graph}(graph) 26 | } 27 | \arguments{ 28 | \item{graph}{An \code{initial_graph} object from the \code{graphicalMCP} package, a 29 | \code{graphMCP} object from the \code{gMCP} package, or an \code{igraph} object from the 30 | \code{igraph} package, depending on the conversion type.} 31 | } 32 | \value{ 33 | \itemize{ 34 | \item \code{as_graphMCP()} returns a \code{graphMCP} object for the \code{gMCP} package. 35 | \item \code{as_igraph()} returns an \code{igraph} object for the \code{igraph} package. 36 | \item \code{as_initial_graph()} returns an \code{initial_graph} object for the 37 | \code{graphicalMCP} package. 38 | } 39 | } 40 | \description{ 41 | Graph objects have different structures and attributes in 42 | \code{graphicalMCP}, \code{gMCP}, and \code{igraph} R packages. These functions convert 43 | between different classes to increase compatibility. 44 | 45 | Note that \code{igraph} and \code{gMCP} have additional attributes for vertices, edges, 46 | or a graph itself. These conversion functions only handle attributes related 47 | to hypothesis names, hypothesis weights and transition weights. Other 48 | attributes will be dropped when converting. 49 | } 50 | \examples{ 51 | g_graphicalMCP <- random_graph(5) 52 | 53 | if (requireNamespace("gMCP", quietly = TRUE)) { 54 | g_gMCP <- as_graphMCP(g_graphicalMCP) 55 | 56 | all.equal(g_graphicalMCP, as_initial_graph(g_gMCP)) 57 | } 58 | 59 | if (requireNamespace("igraph", quietly = TRUE)) { 60 | g_igraph <- as_igraph(g_graphicalMCP) 61 | 62 | all.equal(g_graphicalMCP, as_initial_graph(g_igraph)) 63 | } 64 | } 65 | \references{ 66 | Csardi, G., Nepusz, T., Traag, V., Horvat, S., Zanini, F., Noom, 67 | D., and Mueller, K. (2024). \emph{igraph}: Network analysis and visualization 68 | in R. R package version 2.0.3. 69 | \url{https://CRAN.R-project.org/package=igraph}. 70 | 71 | Rohmeyer, K., and Klinglmueller, K. (2024). \emph{gMCP}: Graph based multiple 72 | test procedures. R package version 0.8-17. 73 | \url{https://cran.r-project.org/package=gMCP}. 74 | } 75 | \seealso{ 76 | \code{\link[=graph_create]{graph_create()}} for the initial graph used in the \code{graphicalMCP} 77 | package. 78 | } 79 | -------------------------------------------------------------------------------- /misc/Table_4_5_local_significance_level.R: -------------------------------------------------------------------------------- 1 | # Generate local significance levels for Table 4 and 5 2 | 3 | # make sure the current working directory is the folder code/ 4 | # now source the function definitions: 5 | source("functions/fun_miscellaneous.R") 6 | source("functions/fun_separate_c.R") 7 | source("functions/fun_common_c.R") 8 | 9 | # Input parameters 10 | # alpha = overall significance level 11 | # w = a vector of local weights 12 | # g = a matrix of transition weights 13 | # cr = correlation matrix among test statistics 14 | 15 | # Table 4 and 5 16 | # Note the same set of information is allocated to Table 4 and 5 17 | # for limited space 18 | library(mvtnorm) 19 | 20 | # Overall significance level 21 | alpha <- 0.025 22 | # Generate the weighting scheme 23 | w <- c(0.4, 0.4, 0.2, 0, 0, 0) 24 | g <- rbind(c(0, 0, 0, 1, 0, 0), 25 | c(0, 0, 0, 0, 1, 0), 26 | c(0, 0, 0, 0, 0, 1), 27 | c(0, 0.5, 0.5, 0, 0, 0), 28 | c(0.5, 0, 0.5, 0, 0, 0), 29 | c(0.5, 0.5, 0, 0, 0, 0)) 30 | index <- generateWeights(w = w, g = g)[, 1:length(w)] 31 | weight <- generateWeights(w = w, g = g)[, (length(w) + 1):(2 * length(w))] 32 | # Correlation matrix 33 | cr <- matrix(c(1, 0.5, 0.5, NA, NA, NA, 34 | 0.5, 1, 0.5, NA, NA, NA, 35 | 0.5, 0.5, 1, NA, NA, NA, 36 | NA, NA, NA, 1, NA, NA, 37 | NA, NA, NA, NA, 1, NA, 38 | NA, NA, NA, NA, NA, 1), 39 | nrow = length(w)) 40 | # set seed 41 | set.seed(123456) 42 | 43 | # (A) Bonferroni test 44 | level_A <- alpha * weight 45 | level_A <- round(level_A * 100, 2) 46 | cbind(index, level_A) 47 | 48 | # (B) parametric test using a common c as in equation (5) 49 | # Calculate local significance levels for every intersection hypothesis 50 | c_intersection <- rep(NA, nrow(weight)) 51 | for (i in 1:nrow(weight)){ 52 | ww <- weight[i, ] 53 | c_intersection[i] <- uniroot(common_c_function, lower = 0.9, 54 | upper = 1 / min(ww[ww > 0]), 55 | w = ww, cr = cr, alpha = alpha)$root 56 | } 57 | level_B <- alpha * c_intersection * weight 58 | level_B <- round(level_B * 100, 2) 59 | cbind(index, level_B) 60 | 61 | ## (C) parametric test using separate c's as in equation (7) 62 | # Calculate local significance levels for every intersection hypothesis 63 | local_weight_intersection <- matrix(NA, ncol = ncol(weight), 64 | nrow = nrow(weight)) 65 | for (i in 1:nrow(weight)){ 66 | local_weight_intersection[i, ] <- separate_c_function(w = weight[i, ], 67 | cr = cr, 68 | alpha = alpha)[[2]] 69 | } 70 | level_C <- alpha * local_weight_intersection 71 | level_C <- round(level_C * 100, 2) 72 | cbind(index, level_C) 73 | 74 | -------------------------------------------------------------------------------- /misc/Table_2_adjusted_p_value.R: -------------------------------------------------------------------------------- 1 | # Generate adjusted p-values for Table 2 2 | 3 | # make sure the current working directory is the folder code/ 4 | # now source the function definitions: 5 | source("./perf-tests/functions/fun_miscellaneous.R") 6 | source("./perf-tests/functions/fun_separate_c.R") 7 | source("./perf-tests/functions/fun_common_c.R") 8 | 9 | # Table 2 10 | library(mvtnorm) 11 | 12 | # Generate the weighting scheme 13 | w <- c(0.4, 0.4, 0.2, 0, 0, 0) 14 | g <- rbind(c(0, 0, 0, 1, 0, 0), 15 | c(0, 0, 0, 0, 1, 0), 16 | c(0, 0, 0, 0, 0, 1), 17 | c(0, 0.5, 0.5, 0, 0, 0), 18 | c(0.5, 0, 0.5, 0, 0, 0), 19 | c(0.5, 0.5, 0, 0, 0, 0)) 20 | index <- generateWeights(w = w, g = g)[, 1:length(w)] 21 | weight <- generateWeights(w = w, g = g)[, (length(w) + 1):(2 * length(w))] 22 | # Correlation matrix 23 | cr <- matrix(c(1, 0.5, 0.5, NA, NA, NA, 24 | 0.5, 1, 0.5, NA, NA, NA, 25 | 0.5, 0.5, 1, NA, NA, NA, 26 | NA, NA, NA, 1, NA, NA, 27 | NA, NA, NA, NA, 1, NA, 28 | NA, NA, NA, NA, NA, 1), 29 | nrow = length(w)) 30 | # Unadjusted p-values 31 | p <- c(0.009, 0.011, 0.009, 0.013, 0.016, 0.004) 32 | # Set seed 33 | set.seed(123456) 34 | 35 | # (A) Bonferroni test 36 | # The correlation matrix has NA for all off-diagonal entries 37 | cr_bonf <- matrix(rep(NA, length(w) * length(w)), nrow = length(w)) 38 | diag(cr_bonf) <- 1 39 | # Calculate p-value for every intersection hypothesis 40 | p_intersection <- rep(NA, nrow(weight)) 41 | for (i in 1:nrow(weight)){ 42 | p_intersection[i] <- p_separate_c_function(p, weight[i, ], cr_bonf) 43 | } 44 | # Adjusted p-values for (A) Bonferroni test 45 | adjp_A <- rep(NA, length(w)) 46 | for (i in 1:length(w)){ 47 | adjp_A[i] <- max(p_intersection[index[, i] > 0]) 48 | } 49 | ceiling(adjp_A * 10000) / 100 50 | 51 | ## (B) parametric test using a common c as in equation (5) 52 | # Calculate p-value for every intersection hypothesis 53 | p_intersection <- rep(NA, nrow(weight)) 54 | for (i in 1:nrow(weight)){ 55 | p_intersection[i] <- uniroot(p_common_c_function, lower = 0.0001, 56 | upper = 0.2, 57 | p = p, w = weight[i, ], cr = cr)$root 58 | } 59 | # Adjusted p-values for (B) parametric test using equation (5) 60 | adjp_B <- rep(NA, length(w)) 61 | for (i in 1:length(w)){ 62 | adjp_B[i] <- max(p_intersection[index[, i] > 0]) 63 | } 64 | ceiling(adjp_B * 10000) / 100 65 | 66 | 67 | ## (C) parametric test using separate c's as in equation (7) 68 | # Calculate p-value for every intersection hypothesis 69 | p_intersection <- rep(NA, nrow(weight)) 70 | for (i in 1:nrow(weight)){ 71 | p_intersection[i] <- p_separate_c_function(p, weight[i, ], cr) 72 | } 73 | # Adjusted p-values for (B) parametric test using equation (5) 74 | adjp_C <- rep(NA, length(w)) 75 | for (i in 1:length(w)){ 76 | adjp_C[i] <- max(p_intersection[index[, i] > 0]) 77 | } 78 | ceiling(adjp_C * 10000) / 100 79 | 80 | 81 | -------------------------------------------------------------------------------- /tests/testthat/test-power_tests.R: -------------------------------------------------------------------------------- 1 | test_that("vectorized testing matches standard testing (single-group)", { 2 | m <- 6 3 | rando <- random_graph(m) 4 | hyp_names <- names(rando$hypotheses) 5 | 6 | p <- pnorm(rnorm(m, 2), lower.tail = FALSE) 7 | gw <- graph_generate_weights(rando) 8 | gw_h <- gw[, seq_len(m)] 9 | gw_weights <- gw[, seq_len(m) + m] 10 | 11 | groups1 <- list(seq_len(m)) 12 | 13 | gw_compact_simes <- adjust_weights_simes( 14 | gw_weights, 15 | p, 16 | groups1 17 | ) 18 | 19 | gw_compact_parametric <- adjust_weights_parametric_util( 20 | gw_weights, 21 | gw_h, 22 | diag(m), 23 | 0.025, 24 | list(seq_len(m)) 25 | ) 26 | 27 | expect_equal( 28 | graphicalMCP:::graph_test_closure_fast(p, 0.025, gw_weights, gw_h), 29 | graph_test_closure(rando, p)$outputs$rejected, 30 | ignore_attr = TRUE 31 | ) 32 | 33 | expect_equal( 34 | graphicalMCP:::graph_test_closure_fast( 35 | p, 36 | 0.025, 37 | gw_compact_simes[, hyp_names], 38 | gw_h 39 | ), 40 | graph_test_closure(rando, p, test_types = "s")$outputs$rejected, 41 | ignore_attr = TRUE 42 | ) 43 | 44 | expect_equal( 45 | graphicalMCP:::graph_test_closure_fast( 46 | p, 47 | 0.025, 48 | gw_compact_parametric, 49 | gw_h 50 | ), 51 | graph_test_closure( 52 | rando, 53 | p, 54 | test_types = "p", 55 | test_corr = list(diag(m)) 56 | )$outputs$rejected, 57 | ignore_attr = TRUE 58 | ) 59 | }) 60 | 61 | test_that("vectorized testing matches standard testing (multi-group)", { 62 | m <- 6 63 | rando <- random_graph(m) 64 | hyp_names <- names(rando$hypotheses) 65 | 66 | p <- pnorm(rnorm(m, 2), lower.tail = FALSE) 67 | gw <- graph_generate_weights(rando) 68 | gw_h <- gw[, seq_len(m)] 69 | gw_weights <- gw[, seq_len(m) + m] 70 | 71 | bonf_groups <- list(2:1) 72 | simes_groups <- list(3:4) 73 | simes_groups_reduce <- list(1:2) 74 | para_groups <- list(5:m) 75 | 76 | adjusted_weights_simes <- adjust_weights_simes( 77 | gw_weights[, unlist(simes_groups)], 78 | p[unlist(simes_groups)], 79 | simes_groups_reduce 80 | ) 81 | 82 | adjusted_weights_parametric <- adjust_weights_parametric_util( 83 | gw_weights, 84 | gw_h, 85 | diag(m), 86 | 0.05, 87 | para_groups 88 | ) 89 | 90 | gw_weights <- gw_weights[, unlist(bonf_groups)] 91 | 92 | expect_equal( 93 | graphicalMCP:::graph_test_closure_fast( 94 | p, 95 | 0.025, 96 | cbind( 97 | gw_weights, 98 | adjusted_weights_simes, 99 | adjusted_weights_parametric 100 | )[, hyp_names], 101 | gw_h 102 | ), 103 | graph_test_closure( 104 | rando, 105 | p, 106 | test_groups = list(1:2, 4:3, 5:m), 107 | test_types = c("b", "s", "p"), 108 | test_corr = list(NA, NA, diag(m - 4)) 109 | )$outputs$rejected, 110 | ignore_attr = TRUE 111 | ) 112 | }) 113 | -------------------------------------------------------------------------------- /man/graph_rejection_orderings.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/graph_rejection_orderings.R 3 | \name{graph_rejection_orderings} 4 | \alias{graph_rejection_orderings} 5 | \title{Find alternate rejection orderings (sequences) for shortcut tests} 6 | \usage{ 7 | graph_rejection_orderings(shortcut_test_result) 8 | } 9 | \arguments{ 10 | \item{shortcut_test_result}{A \code{graph_report} object as returned by 11 | \code{\link[=graph_test_shortcut]{graph_test_shortcut()}}.} 12 | } 13 | \value{ 14 | A modified \code{graph_report} object containing all valid orderings of 15 | rejections of hypotheses 16 | } 17 | \description{ 18 | When multiple hypotheses are rejected by using \code{\link[=graph_test_shortcut]{graph_test_shortcut()}}, 19 | there may be multiple orderings or sequences in which hypotheses are rejected 20 | one by one. The default order in \code{\link[=graph_test_shortcut]{graph_test_shortcut()}} is based on the 21 | adjusted p-values, from the smallest to the largest. This function 22 | \code{\link[=graph_rejection_orderings]{graph_rejection_orderings()}} provides all possible and valid orders 23 | (or sequences) of rejections. Although the order of rejection does not affect 24 | the final rejection decisions Bretz et al. (2009), different sequences could 25 | offer different ways to explain the step-by-step process of shortcut 26 | graphical multiple comparison procedures. 27 | } 28 | \examples{ 29 | # A graphical multiple comparison procedure with two primary hypotheses (H1 30 | # and H2) and two secondary hypotheses (H3 and H4) 31 | # See Figure 4 in Bretz et al. (2011). 32 | hypotheses <- c(0.5, 0.5, 0, 0) 33 | delta <- 0.5 34 | transitions <- rbind( 35 | c(0, delta, 1 - delta, 0), 36 | c(delta, 0, 0, 1 - delta), 37 | c(0, 1, 0, 0), 38 | c(1, 0, 0, 0) 39 | ) 40 | g <- graph_create(hypotheses, transitions) 41 | 42 | p <- c(0.018, 0.01, 0.105, 0.006) 43 | alpha <- 0.025 44 | 45 | shortcut_testing <- graph_test_shortcut(g, p, alpha, verbose = TRUE) 46 | 47 | # Reject H1, H2, and H4 48 | shortcut_testing$outputs$rejected 49 | 50 | # Default order of rejections: H2, H1, H4 51 | shortcut_testing$details$del_seq 52 | 53 | # There is another valid sequence of rejection: H2, H4, H1 54 | graph_rejection_orderings(shortcut_testing)$valid_orderings 55 | 56 | # Finally, intermediate updated graphs can be obtained by providing the order 57 | # of rejections into `[graph_update()]` 58 | graph_update(g, delete = c(2, 4, 1)) 59 | } 60 | \references{ 61 | Bretz, F., Maurer, W., Brannath, W., and Posch, M. (2009). A graphical 62 | approach to sequentially rejective multiple test procedures. 63 | \emph{Statistics in Medicine}, 28(4), 586-604. 64 | 65 | Bretz, F., Posch, M., Glimm, E., Klinglmueller, F., Maurer, W., and 66 | Rohmeyer, K. (2011). Graphical approaches for multiple comparison 67 | procedures using weighted Bonferroni, Simes, or parametric tests. 68 | \emph{Biometrical Journal}, 53(6), 894-913. 69 | } 70 | \seealso{ 71 | \code{\link[=graph_test_shortcut]{graph_test_shortcut()}} for shortcut graphical multiple comparison 72 | procedures. 73 | } 74 | -------------------------------------------------------------------------------- /misc/bonferroni_sequential.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | using namespace cpp11; 4 | 5 | [[cpp11::register]] 6 | doubles test_graph_shortcut_cpp(doubles hyps, doubles trns, doubles p, double alpha) { 7 | writable::doubles hypotheses = hyps; 8 | writable::doubles transitions = trns; 9 | 10 | double adj_p_global_max = 0; 11 | double adj_p_subgraph_min; 12 | int min_index = 0; 13 | int graph_size = hypotheses.size(); 14 | writable::doubles adj_p_subgraph(graph_size); 15 | writable::doubles adjusted_p(graph_size); 16 | writable::integers rejected(graph_size); 17 | 18 | for (int i = 0; i < graph_size; i++) { 19 | // initialize sub-graph p at 1 20 | adj_p_subgraph_min = 1.0; 21 | 22 | // loop through the graph, replacing the min each time a smaller is found 23 | // also store the index 24 | for (int j = 0; j < graph_size; j++) { 25 | adj_p_subgraph[j] = p[j] / hypotheses[j]; 26 | 27 | if ((hypotheses[j] > 0) & ((p[j] / hypotheses[j]) < adj_p_subgraph_min)) { 28 | min_index = j; 29 | adj_p_subgraph_min = p[j] / hypotheses[j]; 30 | } 31 | } 32 | 33 | // update the global max if this sub-graph's min is larger than prior 34 | if (adj_p_subgraph_min > adj_p_global_max) { 35 | adj_p_global_max = adj_p_subgraph_min; 36 | } 37 | 38 | // hypothesis at min_index gets largest adj-p seen so far 39 | adjusted_p[min_index] = adj_p_global_max; 40 | rejected[min_index] = (adj_p_global_max <= alpha); 41 | 42 | // update hypotheses & transitions ----------------------------------------- 43 | 44 | // init storage for new graph elts 45 | writable::doubles new_weights(graph_size); 46 | writable::doubles new_transitions(graph_size); 47 | 48 | // calculate new weights & transitions 49 | for (int hyp_num = 0; hyp_num < graph_size; ++hyp_num) { 50 | if (hyp_num == min_index) { 51 | new_weights[hyp_num] = 0; 52 | } else { 53 | new_weights[hyp_num] = 54 | hypotheses[hyp_num] + 55 | hypotheses[min_index] * transitions[hyp_num * graph_size + min_index]; 56 | } 57 | for (int end_num = 0; end_num < graph_size; ++end_num) { 58 | if (hyp_num == end_num || hyp_num == min_index || end_num == min_index) { 59 | new_transitions[end_num * graph_size + hyp_num] = 0; 60 | } else { 61 | double numerator = 62 | transitions[end_num * graph_size + hyp_num] + 63 | transitions[min_index * graph_size + hyp_num] * 64 | transitions[end_num * graph_size + min_index]; 65 | double denominator = 66 | 1 - transitions[min_index * graph_size + hyp_num] * 67 | transitions[hyp_num * graph_size + min_index]; 68 | 69 | new_transitions[end_num * graph_size + hyp_num] = 70 | numerator / denominator; 71 | } 72 | } 73 | } 74 | 75 | hypotheses = new_weights; 76 | transitions = new_transitions; 77 | // update hypotheses & transitions end ------------------------------------- 78 | } 79 | 80 | return adjusted_p; 81 | } 82 | -------------------------------------------------------------------------------- /tests/testthat/test-print.graph_report.R: -------------------------------------------------------------------------------- 1 | test_that("printing Bonferroni/Simes closure test", { 2 | par_gate <- simple_successive_1() 3 | 4 | expect_snapshot(graph_test_closure(par_gate, rep(.01, 4), test_types = "s")) 5 | 6 | expect_snapshot(graph_test_closure(par_gate, rep(.01, 4), verbose = TRUE)) 7 | 8 | expect_snapshot(graph_test_closure(par_gate, rep(.01, 4), test_values = TRUE)) 9 | }) 10 | 11 | test_that("printing parametric closure test", { 12 | par_gate <- simple_successive_1() 13 | 14 | expect_snapshot( 15 | graph_test_closure( 16 | par_gate, 17 | rep(.01, 4), 18 | test_types = "p", 19 | test_corr = list(diag(4)) 20 | ) 21 | ) 22 | 23 | expect_snapshot( 24 | graph_test_closure( 25 | par_gate, 26 | rep(.01, 4), 27 | test_groups = list(1:2, 3:4), 28 | test_types = c("p", "s"), 29 | test_corr = list(diag(2), NA), 30 | test_values = TRUE, 31 | verbose = TRUE 32 | ) 33 | ) 34 | 35 | expect_snapshot( 36 | graph_test_closure( 37 | par_gate, 38 | rep(.01, 4), 39 | test_groups = list(1:2, 3:4), 40 | test_types = c("p", "p"), 41 | test_corr = list(diag(2), diag(2)), 42 | test_values = TRUE, 43 | verbose = TRUE 44 | ) 45 | ) 46 | }) 47 | 48 | test_that("printing Bonferroni sequential results", { 49 | expect_snapshot(graph_test_shortcut(simple_successive_1(), rep(.01, 4))) 50 | 51 | expect_snapshot( 52 | graph_test_shortcut(simple_successive_1(), rep(.01, 4), verbose = TRUE) 53 | ) 54 | }) 55 | 56 | test_that("add alternate orderings", { 57 | test_res <- 58 | graph_test_shortcut(simple_successive_1(), rep(.01, 4), verbose = TRUE) 59 | 60 | test_res_alt <- graph_rejection_orderings(test_res) 61 | 62 | expect_snapshot(test_res_alt) 63 | }) 64 | 65 | test_that("additional printing options for graph report", { 66 | par_gate <- simple_successive_1() 67 | 68 | expect_snapshot( 69 | print( 70 | graph_test_closure( 71 | par_gate, 72 | rep(.01, 4), 73 | verbose = TRUE, 74 | test_values = TRUE 75 | ), 76 | precison = 4, 77 | indent = 4 78 | ) 79 | ) 80 | 81 | expect_snapshot( 82 | print( 83 | graph_test_shortcut( 84 | simple_successive_1(), 85 | rep(.01, 4), 86 | verbose = TRUE, 87 | test_values = TRUE 88 | ), 89 | precision = 7, 90 | indent = 9 91 | ) 92 | ) 93 | 94 | expect_snapshot( 95 | print( 96 | graph_test_shortcut( 97 | two_doses_two_primary_two_secondary(), 98 | 5:0 / 200, 99 | verbose = TRUE, 100 | test_values = TRUE 101 | ) 102 | ) 103 | ) 104 | 105 | expect_snapshot( 106 | print( 107 | graph_rejection_orderings( 108 | graph_test_shortcut( 109 | two_doses_two_primary_two_secondary(), 110 | 6:1 / 400, 111 | verbose = TRUE, 112 | test_values = TRUE 113 | ) 114 | ) 115 | ) 116 | ) 117 | }) 118 | -------------------------------------------------------------------------------- /R/power_tests.R: -------------------------------------------------------------------------------- 1 | #' Perform graphical multiple comparison procedures efficiently for power 2 | #' calculation 3 | #' 4 | #' @description 5 | #' These functions performs similarly to [graph_test_closure()] or 6 | #' [graph_test_shortcut()] but are optimized for efficiently calculating power. 7 | #' For example, generating weights and calculating adjusted weights can be done 8 | #' only once. Vectorization has been applied where possible. 9 | #' 10 | #' @param p A numeric vector of one-sided p-values (unadjusted, raw), whose 11 | #' values should be between 0 & 1. The length should match the number of 12 | #' hypotheses in `graph`. 13 | #' @param alpha A numeric value of the one-sided overall significance level, 14 | #' which should be between 0 & 1. The default is 0.025 for one-sided 15 | #' hypothesis testing. Note that only one-sided tests are supported. 16 | #' @param adjusted_weights The adjusted hypothesis weights, which are the 17 | #' second half of columns from [graph_generate_weights()] output, adjusted by 18 | #' the appropriate test types (Bonferroni, Simes, or parametric). 19 | #' @param matrix_intersections A matrix of hypothesis indicators in a weighting 20 | #' strategy, which are the first half the [graph_generate_weights()] output. 21 | #' 22 | #' @return A logical or integer vector indicating whether each hypothesis can 23 | #' be rejected or not. 24 | #' 25 | #' @seealso 26 | #' * [graph_test_closure()] for closed graphical multiple comparison 27 | #' procedures. 28 | #' * [graph_test_shortcut()] for shortcut graphical multiple comparison 29 | #' procedures. 30 | #' 31 | #' @rdname graph_test_fast 32 | #' 33 | #' @keywords internal 34 | #' 35 | graph_test_closure_fast <- function(p, 36 | alpha, 37 | adjusted_weights, 38 | matrix_intersections) { 39 | rej_hyps <- t(p <= alpha * t(adjusted_weights)) 40 | 41 | # "+ 0" converts to integer from logical 42 | matrixStats::colSums2( 43 | matrix_intersections * matrixStats::rowMaxs(rej_hyps + 0) 44 | ) == 2^(ncol(adjusted_weights) - 1) 45 | } 46 | 47 | #' @rdname graph_test_fast 48 | #' @keywords internal 49 | graph_test_shortcut_fast <- function(p, alpha, adjusted_weights) { 50 | num_hyps <- ncol(adjusted_weights) 51 | # There is a mapping from current rejected hypotheses to corresponding row of 52 | # the closure weights matrix by treating the rejected vector as a binary 53 | # number. This line creates a vector of binary place values. 54 | binary_slots <- 2^(num_hyps:1 - 1) 55 | nrow_critical <- nrow(adjusted_weights) 56 | 57 | rejected <- vector("logical", num_hyps) 58 | 59 | while (!all(rejected)) { 60 | # The actual mapping to intersection number is to treat the rejected vector 61 | # as a binary number, then count that many lines up from the bottom of the 62 | # weights matrix, then go down one line 63 | intersection_num <- 64 | nrow_critical - sum(binary_slots * !rejected) + 1 65 | rejected_step <- 66 | p <= adjusted_weights[intersection_num, , drop = TRUE] * alpha 67 | 68 | if (!any(rejected_step)) { 69 | break 70 | } else { 71 | rejected <- rejected | rejected_step 72 | } 73 | } 74 | 75 | rejected 76 | } 77 | -------------------------------------------------------------------------------- /misc/abstract.md: -------------------------------------------------------------------------------- 1 | # Versatile and efficient graphical multiple comparison procedures with {graphicalMCP} 2 | 3 | Multiple comparison procedures (MCPs) are widely used in confirmatory clinical trials to control the probability of making false positive claims. Graphical approaches provide a flexible framework to accommodate commonly-used MCPs and to create more powerful procedures. To allow both flexibility and efficiency, we've created graphicalMCP, an R-native package that is lightweight, performant, and educational. Using an extensible approach to allow different test types in different parts of a graph, the package covers all existing R packages that use graphical approaches. Using vectorization and shortcuts, it greatly reduces simulation times compared to other similar packages, without using more efficient languages such as C++, which allows better compatibility with different computing environments. It also has the capability to draw graphical MCPs using nodes and directed edges, giving users great visualization along with full quantitative details. 4 | 5 | Prior versions: 6 | 7 | # Introducing graphicalMCP: A package & primer for the graphical approach to multiple comparison procedures using R 8 | 9 | Multiple comparison procedures provide a method to compare several groups with a control in a single experiment, while controlling the family-wise error rate. The graphical approach to MCPs divides them into separate weighting and testing strategies, where the weighting is (mostly) agnostic to the test chosen. This system allows classic approaches like Bonferroni to be used, while also being flexible enough to enable full customization for how the significance level can be divided among hypotheses. This customization may improve power, and an accompanying visualization of the graph aids in communication about the study design. The graphicalMCP R package is a lightweight, R-native implementation of this graphical approach, built to easily generalize to many classes of tests while still being efficient. Furthermore, the code itself is written descriptively to serve as a knowledge source for the core methods in this field. Written as a partnership between Gilead and Atorus Research. 10 | 11 | # Running 100,000 clinical trials in under 5 seconds 12 | 13 | Multiple comparison procedures (MCPs) control the family-wise error rate in clinical trials that have multiple endpoints, but standard procedures like Bonferroni or fixed sequence can be unnecessarily conservative. Meanwhile, procedures with more complexity are difficult to implement and communicate. Gilead and Atorus have brought to R the full graphical approach to MCPs, allowing clinical teams to maximize how their significance level is spent across endpoints, while also providing visualizations to communicate about these procedures, both simple and complex. 14 | 15 | graphicalMCP is an R-native package that is lightweight, performant, and educational. Using an extensible approach from the start, it supports any valid weighting strategy and a wide variety of tests. It can also run power simulations of 100,000 Monte Carlo trial simulations in a matter of seconds locally. These simulations, plus graph analytics and full test calculation details, allow graphicalMCP to give clinical teams total insight into a trial's design and assessment. 16 | 17 | -------------------------------------------------------------------------------- /R/print.initial_graph.R: -------------------------------------------------------------------------------- 1 | #' S3 print method for the class `initial_graph` 2 | #' 3 | #' @description 4 | #' A printed `initial_graph` displays a header stating "Initial graph", 5 | #' hypothesis weights, and transition weights. 6 | #' 7 | #' @param x An object of class `initial_graph` to print. 8 | #' @param ... Other values passed on to other methods (currently unused). 9 | #' @param precision An integer scalar indicating the number of decimal places 10 | #' to to display. 11 | #' @param indent An integer scalar indicating how many spaces to indent results. 12 | #' 13 | #' @return An object x of class `initial_graph`, after printing the initial 14 | #' graph. 15 | #' 16 | #' @seealso 17 | #' [print.updated_graph()] for the print method for the updated graph after 18 | #' hypotheses being deleted from the initial graph. 19 | #' 20 | #' @rdname print.initial_graph 21 | #' 22 | #' @export 23 | #' 24 | #' @references 25 | #' Bretz, F., Posch, M., Glimm, E., Klinglmueller, F., Maurer, W., and 26 | #' Rohmeyer, K. (2011). Graphical approaches for multiple comparison 27 | #' procedures using weighted Bonferroni, Simes, or parametric tests. 28 | #' \emph{Biometrical Journal}, 53(6), 894-913. 29 | #' 30 | #' @examples 31 | #' # A graphical multiple comparison procedure with two primary hypotheses (H1 32 | #' # and H2) and two secondary hypotheses (H3 and H4) 33 | #' # See Figure 1 in Bretz et al. (2011). 34 | #' hypotheses <- c(0.5, 0.5, 0, 0) 35 | #' transitions <- rbind( 36 | #' c(0, 0, 1, 0), 37 | #' c(0, 0, 0, 1), 38 | #' c(0, 1, 0, 0), 39 | #' c(1, 0, 0, 0) 40 | #' ) 41 | #' hyp_names <- c("H11", "H12", "H21", "H22") 42 | #' g <- graph_create(hypotheses, transitions, hyp_names) 43 | #' g 44 | print.initial_graph <- function(x, 45 | ..., 46 | precision = 4, 47 | indent = 0) { 48 | x$hypotheses[attr(x, "deleted")] <- 49 | x$transitions[attr(x, "deleted"), ] <- 50 | x$transitions[, attr(x, "deleted")] <- 51 | NA 52 | 53 | if (is.null(attr(x, "title"))) attr(x, "title") <- "Initial graph" 54 | 55 | pad <- paste(rep(" ", indent), collapse = "") 56 | pad_less_1 <- paste(rep(" ", max(indent - 1, 0)), collapse = "") 57 | 58 | cat(paste0(pad, attr(x, "title"), "\n\n")) 59 | 60 | cat(paste0(pad, "--- Hypothesis weights ---\n")) 61 | 62 | hypotheses_text <- paste( 63 | pad, 64 | formatC( 65 | names(x$hypotheses), 66 | width = max(nchar(names(x$hypotheses))) 67 | ), 68 | ": ", 69 | format(x$hypotheses, digits = precision), 70 | sep = "", 71 | collapse = "\n" 72 | ) 73 | 74 | cat(hypotheses_text, "", sep = "\n") 75 | 76 | cat(paste0(pad, "--- Transition weights ---\n")) 77 | 78 | transitions <- format( 79 | x$transitions, 80 | digits = precision, 81 | scientific = FALSE 82 | ) 83 | 84 | colname_pad <- format("", width = max(nchar(rownames(transitions)))) 85 | label <- paste0(pad_less_1, colname_pad) 86 | df_trn <- data.frame( 87 | paste0(pad_less_1, rownames(transitions)), 88 | transitions, 89 | check.names = FALSE 90 | ) 91 | names(df_trn)[[1]] <- label 92 | 93 | transitions_text <- data.frame(df_trn, check.names = FALSE) 94 | 95 | print(transitions_text, row.names = FALSE) 96 | 97 | invisible(x) 98 | } 99 | -------------------------------------------------------------------------------- /man/graph_generate_weights.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/graph_generate_weights.R 3 | \name{graph_generate_weights} 4 | \alias{graph_generate_weights} 5 | \title{Generate the weighting strategy based on a graphical multiple comparison 6 | procedure} 7 | \usage{ 8 | graph_generate_weights(graph) 9 | } 10 | \arguments{ 11 | \item{graph}{An initial graph as returned by \code{\link[=graph_create]{graph_create()}}.} 12 | } 13 | \value{ 14 | A numeric matrix of all intersection hypotheses and their hypothesis 15 | weights. For a graphical multiple comparison procedure with \eqn{m} hypotheses, 16 | the number of rows is \eqn{2^{m}-1}, each of which corresponds to an intersection 17 | hypothesis. The number of columns is \eqn{2\cdot m}. The first \eqn{m} columns 18 | indicate which individual hypotheses are included in a given intersection 19 | hypothesis and the second half of columns provide hypothesis weights for each 20 | individual hypothesis for a given intersection hypothesis. 21 | } 22 | \description{ 23 | A graphical multiple comparison procedure defines a closed test procedure, 24 | which tests each intersection hypothesis and reject an individual hypothesis 25 | if all intersection hypotheses involving it have been rejected. An 26 | intersection hypothesis represents the parameter space where individual null 27 | hypotheses involved are true simultaneously. 28 | 29 | The closure based on a graph consists of all updated graphs (corresponding 30 | to intersection hypotheses) after all combinations of hypotheses are deleted. 31 | For a graphical multiple comparison procedure with \eqn{m} hypotheses, there 32 | are \eqn{2^{m}-1} updated graphs (intersection hypotheses), including the 33 | initial graph (the overall intersection hypothesis). The weighting strategy 34 | of this graph consists of hypothesis weights from all \eqn{2^{m}-1} updated 35 | graphs (intersection hypotheses). The algorithm to derive the weighting 36 | strategy is based on Algorithm 1 in Bretz et al. (2011). 37 | } 38 | \section{Performance}{ 39 | 40 | Generation of intersection hypotheses is closely related to the power set 41 | of a given set of indices. As the number of hypotheses increases, the memory 42 | and time usage can grow quickly (e.g., at a rate of \eqn{O(2^n)}). There are also 43 | multiple ways to implement Algorithm 1 in Bretz et al. (2011). See 44 | \code{vignette("generate-closure")} for more information about generating 45 | intersection hypotheses and comparisons of different approaches to calculate 46 | weighting strategies. 47 | } 48 | 49 | \examples{ 50 | # A graphical multiple comparison procedure with two primary hypotheses (H1 51 | # and H2) and two secondary hypotheses (H3 and H4) 52 | # See Figure 1 in Bretz et al. (2011). 53 | hypotheses <- c(0.5, 0.5, 0, 0) 54 | transitions <- rbind( 55 | c(0, 0, 1, 0), 56 | c(0, 0, 0, 1), 57 | c(0, 1, 0, 0), 58 | c(1, 0, 0, 0) 59 | ) 60 | g <- graph_create(hypotheses, transitions) 61 | 62 | graph_generate_weights(g) 63 | } 64 | \references{ 65 | Bretz, F., Posch, M., Glimm, E., Klinglmueller, F., Maurer, W., and 66 | Rohmeyer, K. (2011). Graphical approaches for multiple comparison 67 | procedures using weighted Bonferroni, Simes, or parametric tests. 68 | \emph{Biometrical Journal}, 53(6), 894-913. 69 | } 70 | \seealso{ 71 | \code{\link[=graph_test_closure]{graph_test_closure()}} for graphical multiple comparison procedures using 72 | the closed test. 73 | } 74 | -------------------------------------------------------------------------------- /man/input_val.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/test_power_input_val.R 3 | \name{test_input_val} 4 | \alias{test_input_val} 5 | \alias{power_input_val} 6 | \title{Validate inputs for testing and power simulations} 7 | \usage{ 8 | test_input_val( 9 | graph, 10 | p, 11 | alpha, 12 | test_groups = list(seq_along(graph$hypotheses)), 13 | test_types = c("bonferroni"), 14 | test_corr, 15 | verbose, 16 | test_values 17 | ) 18 | 19 | power_input_val(graph, sim_n, power_marginal, test_corr, success) 20 | } 21 | \arguments{ 22 | \item{graph}{An initial graph as returned by \code{\link[=graph_create]{graph_create()}}.} 23 | 24 | \item{p}{A numeric vector of p-values (unadjusted, raw), whose values should 25 | be between 0 & 1. The length should match the number of hypotheses in 26 | \code{graph}.} 27 | 28 | \item{alpha}{A numeric value of the overall significance level, which should 29 | be between 0 & 1. The default is 0.025 for one-sided hypothesis testing 30 | problems; another common choice is 0.05 for two-sided hypothesis testing 31 | problems. Note when parametric tests are used, only one-sided tests are 32 | supported.} 33 | 34 | \item{test_groups}{A list of numeric vectors specifying hypotheses to test 35 | together. Grouping is needed to correctly perform Simes and parametric 36 | tests.} 37 | 38 | \item{test_types}{A character vector of test types to apply to each test 39 | group. This is needed to correctly perform Simes and parametric 40 | tests. The length should match the number of elements in \code{test_groups}.} 41 | 42 | \item{test_corr}{(Optional) A list of numeric correlation matrices. Each 43 | entry in the list should correspond to each test group. For a test group 44 | using Bonferroni or Simes tests, its corresponding entry in \code{test_corr} 45 | should be \code{NA}. For a test group using parametric tests, its 46 | corresponding entry in \code{test_corr} should be a numeric correlation matrix 47 | specifying the correlation between test statistics for hypotheses in this 48 | test group. The length should match the number of elements in 49 | \code{test_groups}.} 50 | 51 | \item{verbose}{A logical scalar specifying whether the details of the 52 | adjusted p-value calculations should be included in results. When 53 | \code{verbose = TRUE}, adjusted p-values are provided for each intersection 54 | hypothesis. The default is \code{verbose = FALSE}.} 55 | 56 | \item{test_values}{A logical scalar specifying whether adjusted significance 57 | levels should be provided for each hypothesis. When \code{test_values = TRUE}, 58 | it provides an equivalent way of performing graphical multiple comparison 59 | procedures by comparing each p-value with its significance level. If the 60 | p-value of a hypothesis is less than or equal to its significance level, 61 | the hypothesis is rejected. The default is \code{test_values = FALSE}.} 62 | 63 | \item{sim_n}{An integer scalar specifying the number of simulations. The 64 | default is 1e5.} 65 | 66 | \item{power_marginal}{A numeric vector of marginal power values to use when 67 | simulating p-values. See Details for more on the simulation process.} 68 | 69 | \item{success}{A list of user-defined functions to specify the success 70 | criteria. Functions must take one simulation's logical vector of results as 71 | an input, and return a length-one logical vector. For instance, if 72 | "success" means rejecting hypotheses 1 and 2, use \code{sim_success = list("1 and 2" = function(x) x[1] && x[2])}. If the list is not named, the function 73 | body will be used as the name. Lambda functions also work starting with R 74 | 4.1, e.g. \verb{sim_success = list(\\(x) x[3] || x[4])}.} 75 | } 76 | \value{ 77 | Returns \code{graph} invisibly 78 | } 79 | \description{ 80 | Validate inputs for testing and power simulations 81 | } 82 | \keyword{internal} 83 | -------------------------------------------------------------------------------- /misc/Table_3_simulation.R: -------------------------------------------------------------------------------- 1 | # Generate simulation results for Table 3 2 | 3 | # make sure the current working directory is the folder code/ 4 | # now source the function definitions: 5 | source("./perf-tests/functions/fun_miscellaneous.R") 6 | source("./perf-tests/functions/fun_separate_c.R") 7 | 8 | # Input parameters 9 | # alpha = overall significance level 10 | # w = a vector of local weights 11 | # ncp = a vector of non-centrality parameter 12 | # rho = correlation between test statistics 13 | # nsim = number of simulations 14 | # Note: the processing time is above 2 hours for EACH CASE 15 | # To reduce the processing time, reduce nsim 16 | 17 | library(mvtnorm) 18 | # Overall significance level 19 | alpha <- 0.025 20 | # Local weight 21 | w <- c(0.4, 0.4, 0.2) 22 | # Number of simulations 23 | nsim <- 10^6 24 | 25 | # Function to conduct simulation studies in Table 3 26 | simulation <- function(alpha, w, ncp, rho, nsim){ 27 | require(mvtnorm) 28 | # Correlation matrix 29 | cr <- rbind(c(1, rho, rho), 30 | c(rho, 1, rho), 31 | c(rho, rho, 1)) 32 | # Generate unadjusted p-values 33 | data <- rmvnorm(nsim, mean = ncp, sigma = cr) 34 | data <- 1 - pnorm(data) 35 | 36 | # Adjusted p-values for (A) Bonferroni and (B) single-step parametric tests 37 | adj_A <- NULL 38 | adj_B <- NULL 39 | for (i in 1:nrow(data)){ 40 | adj_A <- rbind(adj_A, pmin(data[i, ] / w, 1)) 41 | adj_B <- rbind(adj_B, p_single_step_function(p = data[i, ], w = w, cr = cr)) 42 | } 43 | 44 | # pi for individual hypotheses 45 | pi_A <- colMeans(adj_A <= alpha) 46 | pi_B <- colMeans(adj_B <= alpha) 47 | 48 | # pi for any hypothesis 49 | pi_any_A <- mean(apply(adj_A, 1, function(x) min(x) <= alpha)) 50 | pi_any_B <- mean(apply(adj_B, 1, function(x) min(x) <= alpha)) 51 | 52 | # A: weighted Bonferroni 53 | result_A <- round(100 * c(pi_A, pi_any_A),2) 54 | 55 | # B: weighted single-step parametric 56 | result_B <- round(100 * c(pi_B, pi_any_B),2) 57 | 58 | return(rbind(result_A,result_B)) 59 | } 60 | 61 | 62 | # Case 1 63 | # Non-centrality parameter 64 | ncp <- c(3.4, 3.4, 3.4) 65 | # Correlation 66 | rho <- 0 67 | # Set seed 68 | set.seed(123456) 69 | simulation(alpha, w, ncp, rho, nsim) 70 | 71 | # Case 2 72 | # Non-centrality parameter 73 | ncp <- c(3.4, 3.4, 3.4) 74 | # Correlation 75 | rho <- 0.5 76 | # Set seed 77 | set.seed(123456) 78 | simulation(alpha, w, ncp, rho, nsim) 79 | 80 | # Case 3 81 | # Non-centrality parameter 82 | ncp <- c(3.4, 3.4, 3.4) 83 | # Correlation 84 | rho <- 0.9 85 | # Set seed 86 | set.seed(123456) 87 | simulation(alpha, w, ncp, rho, nsim) 88 | 89 | # Case 4 90 | # Non-centrality parameter 91 | ncp <- c(3.4, 3.4, 0) 92 | # Correlation 93 | rho <- 0 94 | # Set seed 95 | set.seed(123456) 96 | simulation(alpha, w, ncp, rho, nsim) 97 | 98 | # Case 5 99 | # Non-centrality parameter 100 | ncp <- c(3.4, 3.4, 0) 101 | # Correlation 102 | rho <- 0.5 103 | # Set seed 104 | set.seed(123456) 105 | simulation(alpha, w, ncp, rho, nsim) 106 | 107 | # Case 6 108 | # Non-centrality parameter 109 | ncp <- c(3.4, 3.4, 0) 110 | # Correlation 111 | rho <- 0.9 112 | # Set seed 113 | set.seed(123456) 114 | simulation(alpha, w, ncp, rho, nsim) 115 | 116 | # Case 7 117 | # Non-centrality parameter 118 | ncp <- c(0, 0, 0) 119 | # Correlation 120 | rho <- 0 121 | # Set seed 122 | set.seed(123456) 123 | simulation(alpha, w, ncp, rho, nsim) 124 | 125 | # Case 8 126 | # Non-centrality parameter 127 | ncp <- c(0, 0, 0) 128 | # Correlation 129 | rho <- 0.5 130 | # Set seed 131 | set.seed(123456) 132 | simulation(alpha, w, ncp, rho, nsim) 133 | 134 | # Case 9 135 | # Non-centrality parameter 136 | ncp <- c(0, 0, 0) 137 | # Correlation 138 | rho <- 0.9 139 | # Set seed 140 | set.seed(123456) 141 | simulation(alpha, w, ncp, rho, nsim) 142 | 143 | -------------------------------------------------------------------------------- /man/plot.updated_graph.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot.updated_graph.R 3 | \name{plot.updated_graph} 4 | \alias{plot.updated_graph} 5 | \title{S3 plot method for the class \code{updated_graph}} 6 | \usage{ 7 | \method{plot}{updated_graph}(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{An object of class \code{updated_graph} to plot.} 11 | 12 | \item{...}{ 13 | Arguments passed on to \code{\link[=plot.initial_graph]{plot.initial_graph}} 14 | \describe{ 15 | \item{\code{v_palette}}{A character vector of length two specifying the colors for 16 | retained and deleted hypotheses. More extensive color customization must be 17 | done with \code{vertex.color}.} 18 | \item{\code{layout}}{An igraph layout specification (See \code{?igraph.plotting}), or 19 | \code{"grid"}, which lays out hypotheses left-to-right and top-to-bottom. \code{nrow} 20 | and \code{ncol} control the grid shape.} 21 | \item{\code{nrow}}{An integer scalar specifying the number of rows in the vertex 22 | grid. If row and column counts are not specified, vertices will be laid out 23 | as close to a square as possible.} 24 | \item{\code{ncol}}{An integer scalar specifying the number of columns in the vertex 25 | grid. If row and column counts are not specified, vertices will be laid out 26 | as close to a square as possible.} 27 | \item{\code{edge_curves}}{A named numeric vector specifying the curvature of 28 | specific edges. Edge pairs (Where two vertices share an edge in each 29 | possible direction) are detected automatically and get 0.25 curvature. 30 | Adjust edges by adding an entry with name \verb{"vertex1|vertex2}, and adjust 31 | default edge pairs curvature by adding an entry with name \code{"pairs"} - 32 | \code{edge_curves = c("pairs" = 0.5, "H1|H3" = 0.25, "H3|H4" = 0.75)}.} 33 | \item{\code{precision}}{An integer scalar indicating the number of decimal places to 34 | display.} 35 | \item{\code{eps}}{A numeric scalar. The transition weight of \code{eps} will be displayed 36 | as \eqn{\epsilon}, which indicates edges with infinitesimally small 37 | weights. See Bretz et al. (2009) for more details.} 38 | \item{\code{background_color}}{A character scalar specifying a background color for 39 | the whole plotting area. Passed directly to \code{\link[graphics:par]{graphics::par()}} (\code{bg}).} 40 | \item{\code{margins}}{A length 4 numeric vector specifying the margins for the plot. 41 | Defaults to all 1, since igraph plots tend to have large margins. It is 42 | passed directly to \code{\link[graphics:par]{graphics::par()}} (\code{mar}).} 43 | }} 44 | } 45 | \value{ 46 | An object x of class \code{updated_graph}, after plotting the updated 47 | graph. 48 | } 49 | \description{ 50 | Plotting an updated graph is a \emph{very} light wrapper around 51 | \code{\link[=plot.initial_graph]{plot.initial_graph()}}, only changing the default vertex color to use gray 52 | for deleted hypotheses. 53 | } 54 | \examples{ 55 | # A graphical multiple comparison procedure with two primary hypotheses (H1 56 | # and H2) and two secondary hypotheses (H3 and H4) 57 | # See Figure 1 in Bretz et al. (2011). 58 | hypotheses <- c(0.5, 0.5, 0, 0) 59 | transitions <- rbind( 60 | c(0, 0, 1, 0), 61 | c(0, 0, 0, 1), 62 | c(0, 1, 0, 0), 63 | c(1, 0, 0, 0) 64 | ) 65 | g <- graph_create(hypotheses, transitions) 66 | 67 | # Delete the second and third hypotheses in the "unordered mode" 68 | plot( 69 | graph_update( 70 | g, 71 | c(FALSE, TRUE, TRUE, FALSE) 72 | ), 73 | layout = "grid" 74 | ) 75 | } 76 | \references{ 77 | Bretz, F., Posch, M., Glimm, E., Klinglmueller, F., Maurer, W., and 78 | Rohmeyer, K. (2011). Graphical approaches for multiple comparison 79 | procedures using weighted Bonferroni, Simes, or parametric tests. 80 | \emph{Biometrical Journal}, 53(6), 894-913. 81 | } 82 | \seealso{ 83 | \code{\link[=plot.initial_graph]{plot.initial_graph()}} for the plot method for the initial graph. 84 | } 85 | -------------------------------------------------------------------------------- /misc/vignettes/testing-power-basics.R: -------------------------------------------------------------------------------- 1 | params <- 2 | list(m = 5L, sims = 100000L) 3 | 4 | ## ---- include = FALSE--------------------------------------------------------- 5 | knitr::opts_chunk$set( 6 | collapse = TRUE, 7 | comment = "#>", 8 | cache.lazy = FALSE 9 | ) 10 | 11 | ## ----setup-------------------------------------------------------------------- 12 | library(gt) 13 | library(gMCP) 14 | library(graphicalMCP) 15 | 16 | ## ----create-graph-1----------------------------------------------------------- 17 | ss_graph <- simple_successive_2(c("A1", "B1", "A2", "B2")) 18 | 19 | pvals <- c(.024, .01, .026, .027) 20 | 21 | ss_graph 22 | 23 | ## ----bonferroni-mix-1--------------------------------------------------------- 24 | graph_test_closure(ss_graph, p = pvals, alpha = .05) 25 | 26 | ## ----simes-all-1-------------------------------------------------------------- 27 | graph_test_closure(ss_graph, p = pvals, alpha = .05, test_types = "s") 28 | 29 | ## ----parametric-1------------------------------------------------------------- 30 | corr1 <- matrix(nrow = 4, ncol = 4) 31 | corr1[3:4, 3:4] <- .5 32 | diag(corr1) <- 1 33 | 34 | graph_test_closure(ss_graph, 35 | p = pvals, 36 | alpha = .05, 37 | test_groups = list(1:2, 3:4), 38 | test_types = c("b", "p"), 39 | test_corr = corr1 40 | ) 41 | 42 | ## ----verbose------------------------------------------------------------------ 43 | graph_test_closure( 44 | ss_graph, 45 | p = pvals, 46 | alpha = .05, 47 | test_corr = corr1, 48 | test_groups = list(1:2, 3:4), 49 | test_types = c("s", "p"), 50 | verbose = TRUE 51 | ) 52 | 53 | ## ----critical----------------------------------------------------------------- 54 | graph_test_closure( 55 | ss_graph, 56 | p = pvals, 57 | alpha = .05, 58 | test_corr = corr1, 59 | test_groups = list(1:2, 3:4), 60 | test_types = c("s", "p"), 61 | verbose = TRUE, 62 | critical = TRUE 63 | ) 64 | 65 | ## ----sequential--------------------------------------------------------------- 66 | graph_test_shortcut(ss_graph, p = pvals, alpha = .05, critical = TRUE) 67 | 68 | ## ----print-indent------------------------------------------------------------- 69 | set.seed(3123) 70 | # Randomly generate a graph 71 | m <- 5 72 | w <- sample(1:m, replace = TRUE) 73 | w <- w / sum(w) 74 | g <- replicate(m, sample(1:m, replace = TRUE), simplify = TRUE) 75 | diag(g) <- 0 76 | g <- g / rowSums(g) 77 | graph <- new("graphMCP", m = g, weights = w) 78 | graph2 <- graph_create(w, g) 79 | 80 | p <- runif(m, .0001, .05) 81 | sim_corr <- diag(m) 82 | 83 | mix_test <- graph_test_closure( 84 | graph2, 85 | p = p, 86 | alpha = .05, 87 | test_corr = sim_corr, 88 | test_groups = list(1, 2:3, 4:5), 89 | test_types = c("b", "s", "p"), 90 | verbose = TRUE, 91 | critical = TRUE 92 | ) 93 | 94 | print(mix_test) 95 | 96 | print(mix_test, indent = 6, precision = 10) 97 | 98 | ## ----power-bonf--------------------------------------------------------------- 99 | graph_calculate_power(ss_graph, sim_n = 1e5) 100 | 101 | ## ----power-mix---------------------------------------------------------------- 102 | corr2 <- matrix(.5, nrow = 4, ncol = 4) 103 | diag(corr2) <- 1 104 | 105 | graph_calculate_power( 106 | ss_graph, 107 | test_groups = list(1:4), 108 | test_types = c("p"), 109 | test_corr = corr2, 110 | sim_n = 1e5 111 | ) 112 | 113 | ## ----power-sims--------------------------------------------------------------- 114 | s_corr1 <- rbind( 115 | c(1, .5, .5, .25), 116 | c(.5, 1, .25, .5), 117 | c(.5, .25, 1, .5), 118 | c(.25, .5, .5, 1) 119 | ) 120 | 121 | graph_calculate_power( 122 | ss_graph, 123 | test_groups = list(1:4), 124 | test_types = c("p"), 125 | test_corr = corr2, 126 | power_marginal = c(1, 1, 3, 3), 127 | sim_corr = s_corr1, 128 | sim_success = function(.) .[1] || .[2], 129 | sim_seed = 52423, # Set a seed if you need consistent p-values 130 | sim_n = 1e5 131 | ) 132 | 133 | -------------------------------------------------------------------------------- /R/print.updated_graph.R: -------------------------------------------------------------------------------- 1 | #' S3 print method for the class `updated_graph` 2 | #' 3 | #' @description 4 | #' A printed `updated_graph` displays the initial graph, the (final) updated 5 | #' graph, and the sequence of intermediate updated graphs after hypotheses are 6 | #' deleted (if available). 7 | #' 8 | #' @param x An object of the class `updated_graph` to print. 9 | #' @param ... Other values passed on to other methods (currently unused). 10 | #' @param precision An integer scalar indicating the number of decimal places 11 | #' to to display. 12 | #' @param indent An integer scalar indicating how many spaces to indent results. 13 | #' 14 | #' @return An object x of the class `updated_graph`, after printing the updated 15 | #' graph. 16 | #' 17 | #' @seealso 18 | #' [print.initial_graph()] for the print method for the initial graph. 19 | #' 20 | #' @rdname print.updated_graph 21 | #' 22 | #' @export 23 | #' 24 | #' @references 25 | #' Bretz, F., Posch, M., Glimm, E., Klinglmueller, F., Maurer, W., and 26 | #' Rohmeyer, K. (2011a). Graphical approaches for multiple comparison 27 | #' procedures using weighted Bonferroni, Simes, or parametric tests. 28 | #' \emph{Biometrical Journal}, 53(6), 894-913. 29 | #' 30 | #' @examples 31 | #' # A graphical multiple comparison procedure with two primary hypotheses (H1 32 | #' # and H2) and two secondary hypotheses (H3 and H4) 33 | #' # See Figure 1 in Bretz et al. (2011). 34 | #' hypotheses <- c(0.5, 0.5, 0, 0) 35 | #' transitions <- rbind( 36 | #' c(0, 0, 1, 0), 37 | #' c(0, 0, 0, 1), 38 | #' c(0, 1, 0, 0), 39 | #' c(1, 0, 0, 0) 40 | #' ) 41 | #' g <- graph_create(hypotheses, transitions) 42 | #' 43 | #' # Delete the second and third hypotheses in the "unordered mode" 44 | #' graph_update(g, delete = c(FALSE, TRUE, TRUE, FALSE)) 45 | #' 46 | #' # Equivalent way in the "ordered mode" to obtain the updated graph after 47 | #' # deleting the second and third hypotheses 48 | #' # Additional intermediate updated graphs are also provided 49 | #' graph_update(g, delete = 2:3) 50 | print.updated_graph <- function(x, ..., precision = 6, indent = 2) { 51 | # Initial graph and updated graph 52 | section_break("Initial and final graphs") 53 | cat("\n") 54 | 55 | print(x$initial_graph, ...) 56 | 57 | cat("\n") 58 | 59 | if (length(x$deleted) == 0) { 60 | title <- "Updated graph after deleting no hypotheses" 61 | } else if (length(x$deleted) == 1) { 62 | title <- paste("Updated graph after deleting hypothesis", x$deleted) 63 | } else { 64 | title <- paste( 65 | "Updated graph after deleting hypotheses", 66 | paste(x$deleted, collapse = ", ") 67 | ) 68 | } 69 | 70 | attr(x$updated_graph, "title") <- title 71 | 72 | print(x$updated_graph, ...) 73 | 74 | # Graph sequence 75 | if (!is.null(x$intermediate_graphs)) { 76 | graph_seq <- x$intermediate_graphs 77 | del_seq <- x$deleted 78 | 79 | cat("\n") 80 | section_break("Deletion sequence ($intermediate_graphs)") 81 | cat("\n") 82 | for (i in seq_along(graph_seq) - 1) { 83 | if (i == 0) { 84 | print(graph_seq[[i + 1]], precision = precision, indent = indent) 85 | } else { 86 | attr(graph_seq[[i + 1]], "title") <- paste0( 87 | "Step ", i, ": Updated graph after removing ", 88 | if (i == 1) "hypothesis " else "hypotheses ", 89 | paste0(del_seq[seq_len(i)], collapse = ", ") 90 | ) 91 | 92 | print( 93 | graph_seq[[i + 1]], 94 | precision = precision, 95 | indent = indent * (i + 1) 96 | ) 97 | } 98 | cat("\n") 99 | } 100 | 101 | attr(graph_seq[[length(graph_seq)]], "title") <- 102 | "Final updated graph after removing deleted hypotheses" 103 | 104 | print( 105 | graph_seq[[length(graph_seq)]], 106 | precision = precision, 107 | indent = indent 108 | ) 109 | cat("\n") 110 | } 111 | 112 | invisible(x) 113 | } 114 | -------------------------------------------------------------------------------- /man/test_values.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/test_values.R 3 | \name{test_values_bonferroni} 4 | \alias{test_values_bonferroni} 5 | \alias{test_values_parametric} 6 | \alias{test_values_simes} 7 | \alias{test_values_hochberg} 8 | \title{Organize outputs for testing an intersection hypothesis} 9 | \usage{ 10 | test_values_bonferroni(p, hypotheses, alpha, intersection = NA) 11 | 12 | test_values_parametric(p, hypotheses, alpha, intersection = NA, test_corr) 13 | 14 | test_values_simes(p, hypotheses, alpha, intersection = NA) 15 | 16 | test_values_hochberg(p, hypotheses, alpha, intersection = NA) 17 | } 18 | \arguments{ 19 | \item{p}{A numeric vector of p-values (unadjusted, raw), whose values should 20 | be between 0 & 1. The length should match the number of hypotheses in 21 | \code{graph}.} 22 | 23 | \item{hypotheses}{A numeric vector of hypothesis weights in a graphical 24 | multiple comparison procedure. Must be a vector of values between 0 & 1 25 | (inclusive). The length should match the row and column lengths of 26 | \code{transitions}. The sum of hypothesis weights should not exceed 1.} 27 | 28 | \item{alpha}{A numeric value of the overall significance level, which should 29 | be between 0 & 1. The default is 0.025 for one-sided hypothesis testing 30 | problems; another common choice is 0.05 for two-sided hypothesis testing 31 | problems. Note when parametric tests are used, only one-sided tests are 32 | supported.} 33 | 34 | \item{intersection}{(optional) A numeric scalar used to name the 35 | intersection hypothesis in a weighting strategy.} 36 | 37 | \item{test_corr}{(Optional) A list of numeric correlation matrices. Each 38 | entry in the list should correspond to each test group. For a test group 39 | using Bonferroni or Simes tests, its corresponding entry in \code{test_corr} 40 | should be \code{NA}. For a test group using parametric tests, its 41 | corresponding entry in \code{test_corr} should be a numeric correlation matrix 42 | specifying the correlation between test statistics for hypotheses in this 43 | test group. The length should match the number of elements in 44 | \code{test_groups}.} 45 | } 46 | \value{ 47 | A data frame with rows corresponding to individual hypotheses 48 | involved in the intersection hypothesis with hypothesis weights 49 | \code{hypotheses}. There are following columns: 50 | \itemize{ 51 | \item \code{Intersection} - Name of this intersection hypothesis, 52 | \item \code{Hypothesis} - Name of an individual hypothesis, 53 | \item \code{Test} - Test type for an individual hypothesis, 54 | \item \code{p} - (Unadjusted or raw) p-values for a individual hypothesis, 55 | \item \code{c_value}- C value for parametric tests, 56 | \item \code{Weight} - Hypothesis weight for an individual hypothesis, 57 | \item \code{Alpha} - Overall significance level \eqn{\alpha}, 58 | \item \code{Inequality_holds} - Indicator to show if the p-value is less than or 59 | equal to its significance level. 60 | \itemize{ 61 | \item For Bonferroni and Simes tests, the significance level is the 62 | hypothesis weight times \eqn{\alpha}. 63 | \item For parametric tests, the significance level is the c value times 64 | the hypothesis weight times \eqn{\alpha}. 65 | } 66 | } 67 | } 68 | \description{ 69 | An intersection hypothesis can be tested by a mixture of test types including 70 | Bonferroni, parametric and Simes tests. This function organize outputs of 71 | testing and prepare them for \code{graph_report}. 72 | } 73 | \references{ 74 | Bretz, F., Maurer, W., Brannath, W., and Posch, M. (2009). A graphical 75 | approach to sequentially rejective multiple test procedures. 76 | \emph{Statistics in Medicine}, 28(4), 586-604. 77 | 78 | Lu, K. (2016). Graphical approaches using a Bonferroni mixture of weighted 79 | Simes tests. \emph{Statistics in Medicine}, 35(22), 4041-4055. 80 | 81 | Xi, D., Glimm, E., Maurer, W., and Bretz, F. (2017). A unified framework 82 | for weighted parametric multiple test procedures. 83 | \emph{Biometrical Journal}, 59(5), 918-931. 84 | } 85 | \keyword{internal} 86 | -------------------------------------------------------------------------------- /misc/power-pseudocode.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Power pseudocode" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{power-pseudocode} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r, include = FALSE} 11 | knitr::opts_chunk$set( 12 | collapse = TRUE, 13 | comment = "#>" 14 | ) 15 | ``` 16 | 17 | The following describes the different part of power simulations at a high level 18 | 19 | ```{power} 20 | 21 | 1. convert gamma graph to initial graph 22 | 23 | 2. process & check test inputs 24 | 25 | 3. generate p-values from the MVTN distribution 26 | 27 | 4. if only testing Bonferroni 28 | 29 | a. use sequential testing in C++ 30 | 31 | 5. otherwise 32 | 33 | a. generate weights 34 | 35 | b. subset columns of generated weights by 36 | 37 | i. Bonferroni groups - no further processing 38 | 39 | ii. parametric groups - calculate critical values 40 | 41 | iii. Simes groups - calculate critical values inside loop 42 | 43 | c. for each simulated p-vector 44 | 45 | i. if there are Simes groups, calculate critical values for them 46 | 47 | A. details below 48 | 49 | ii. combine Bonferroni/parametric/Simes critical values together 50 | 51 | iii. test combined critical values matrix with a single vectorized function 52 | 53 | A. details below 54 | 55 | 6. return relevant summary stats 56 | 57 | ``` 58 | 59 | ```{critical-simes} 60 | 1. input is generated weights, p-values, and groups specification 61 | 62 | 2. non-vectorized version 63 | 64 | a. for each group 65 | 66 | i. order gen weights according to p-vector 67 | 68 | ii. for each row 69 | 70 | A. replace weight with cumulative sum of (ordered) weights 71 | 72 | iii. insert new weights into list of weights 73 | 74 | b. column bind list of new weights together 75 | 76 | c. re-order weights in original, unsorted order (possibly not necessary?) 77 | 78 | 3. vectorized version (matrixStats) 79 | 80 | a. save locations of NA values (to replace later) 81 | 82 | b. replace NA values with 0 for matrixStats::rowCumsums() 83 | 84 | c. for each group of weights 85 | 86 | i. calculate matrixStats::rowCumsums() on group weight subset, ordered by p-vector 87 | 88 | A. the zeroes in for NA values won't affect other weights, and the NA locations will be replaced 89 | 90 | B. now I'm realizing that the case with two identical p-values will be slightly wrong - only the second hypothesis with get the correct weight; while this will not impact the global rejection decision, it will slightly impact the power 91 | 92 | C. But I think it still works, because will sampling from a distribution ever result in two identical p-values? I know it can happen in real results, but it seems unlikely when sampling 93 | 94 | d. columnn bind list of new weights together 95 | 96 | e. re-order weights in original, unsorted order (necessary for restoring NAs) 97 | 98 | f. replace NA values at previous locations 99 | ``` 100 | 101 | ```{fast-test} 102 | 1. input is p-vector, alpha level, and a set of critical values 103 | 104 | 2. all intersections can be calculated in a vectorized one-liner: transpose critical values, multiply by alpha, compare to p, and transpose back 105 | 106 | 3. get row maxes to check intersection passing, multiply by h-vectors to split by hypothesis in/out, then sum columns to check how often a hypothesis passes - compare to max passes of (rows in closure) / 2 107 | 108 | 4. the big difference in base R vs matrixStats is that matrixStats has an optimized `rowMaxs()` function, whereas base R requires a hacky conversion to data.frame method. matrixStats also has a function `colSums2()`, which is faster than `base::colSums()` 109 | 110 | ``` 111 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 | 120 | 121 | 122 | 123 | 124 | 125 | 126 | 127 | -------------------------------------------------------------------------------- /man/graph_update.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/graph_update.R 3 | \name{graph_update} 4 | \alias{graph_update} 5 | \title{Obtain an updated graph by updating an initial graphical after deleting 6 | hypotheses} 7 | \usage{ 8 | graph_update(graph, delete) 9 | } 10 | \arguments{ 11 | \item{graph}{An initial graph as returned by \code{\link[=graph_create]{graph_create()}}.} 12 | 13 | \item{delete}{A logical or integer vector, denoting which hypotheses to 14 | delete. A logical vector results in the "unordered mode", which means that 15 | hypotheses corresponding to \code{TRUE} in \code{delete} will be deleted. The 16 | sequence of deletion will follow the sequence of \code{TRUE}'s in \code{delete}. In 17 | this case, the length of the logical vector must match the number of 18 | hypotheses in \code{graph}. An integer vector results in the "ordered mode", 19 | which means that \code{delete} specifies the sequence in which hypotheses 20 | should be deleted by indicating the location of deleted hypotheses, e.g., 21 | 1st, 2nd, etc. In this case, the integer vector can have any length, but 22 | must only contain valid hypothesis numbers (greater than 0, and less than 23 | or equal to he number of hypotheses in \code{graph}).} 24 | } 25 | \value{ 26 | An S3 object of class \code{updated_graph} with a list of 4 elements: 27 | \itemize{ 28 | \item \code{initial_graph}: The initial graph object. 29 | \item \code{updated_graph}: The updated graph object with specified hypotheses 30 | deleted. 31 | \item \code{deleted}: A numeric vector indicating which hypotheses were deleted. 32 | \item \code{intermediate_graphs}: When using the ordered mode, a list of 33 | intermediate updated graphs after each hypothesis is deleted according 34 | to the sequence specified by \code{delete}. 35 | } 36 | } 37 | \description{ 38 | After a hypothesis is deleted, an initial graph will be updated. The deleted 39 | hypothesis will have the hypothesis weight of 0 and the transition weight of 40 | 0. Remaining hypotheses will have updated hypothesis weights and transition 41 | weights according to Algorithm 1 of Bretz et al. (2009). 42 | } 43 | \section{Sequence of deletion}{ 44 | 45 | When there are multiple hypotheses to be deleted from a graph, there are many 46 | sequences of deletion in which an initial graph is updated to an updated 47 | graph. If the interest is in the updated graph after all hypotheses specified 48 | by \code{delete} are deleted, this updated graph is the same no matter which 49 | sequence of deletion is used. This property has been proved by Bretz et al. 50 | (2009). If the interest is in the intermediate updated graph after each 51 | hypothesis is deleted according to the sequence specified by \code{delete}, an 52 | integer vector of \code{delete} should be specified and these detailed outputs 53 | will be provided. 54 | } 55 | 56 | \examples{ 57 | # A graphical multiple comparison procedure with two primary hypotheses (H1 58 | # and H2) and two secondary hypotheses (H3 and H4) 59 | # See Figure 1 in Bretz et al. (2011). 60 | hypotheses <- c(0.5, 0.5, 0, 0) 61 | transitions <- rbind( 62 | c(0, 0, 1, 0), 63 | c(0, 0, 0, 1), 64 | c(0, 1, 0, 0), 65 | c(1, 0, 0, 0) 66 | ) 67 | g <- graph_create(hypotheses, transitions) 68 | 69 | # Delete the second and third hypotheses in the "unordered mode" 70 | graph_update(g, delete = c(FALSE, TRUE, TRUE, FALSE)) 71 | 72 | # Equivalent way in the "ordered mode" to obtain the updated graph after 73 | # deleting the second and third hypotheses 74 | # Additional intermediate updated graphs are also provided 75 | graph_update(g, delete = 2:3) 76 | } 77 | \references{ 78 | Bretz, F., Maurer, W., Brannath, W., and Posch, M. (2009). A graphical 79 | approach to sequentially rejective multiple test procedures. 80 | \emph{Statistics in Medicine}, 28(4), 586-604. 81 | 82 | Bretz, F., Posch, M., Glimm, E., Klinglmueller, F., Maurer, W., and 83 | Rohmeyer, K. (2011). Graphical approaches for multiple comparison 84 | procedures using weighted Bonferroni, Simes, or parametric tests. 85 | \emph{Biometrical Journal}, 53(6), 894-913. 86 | } 87 | \seealso{ 88 | \itemize{ 89 | \item \code{\link[=graph_create]{graph_create()}} for the initial graph. 90 | \item \code{\link[=graph_rejection_orderings]{graph_rejection_orderings()}} for possible sequences of rejections for a 91 | graphical multiple comparison procedure using shortcut testing. 92 | } 93 | } 94 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | [![Project Status: Active – The project has reached a stable, usable 6 | state and is being actively 7 | developed.](https://www.repostatus.org/badges/latest/active.svg)](https://www.repostatus.org/#active) 8 | [![CRAN 9 | status](https://www.r-pkg.org/badges/version/graphicalMCP)](https://cran.r-project.org/package=graphicalMCP) 10 | [![CRAN monthly 11 | downloads](https://cranlogs.r-pkg.org/badges/graphicalMCP)](https://cranlogs.r-pkg.org/badges/graphicalMCP) 12 | [![CRAN total 13 | downloads](https://cranlogs.r-pkg.org/badges/grand-total/graphicalMCP)](https://cranlogs.r-pkg.org/badges/grand-total/graphicalMCP) 14 | 15 | 16 | 17 | 18 | # graphicalMCP 19 | 20 | # Introduction 21 | 22 | Graphical approaches for multiple comparison procedures (MCPs) are a 23 | general framework to control the family-wise error rate strongly at a 24 | pre-specified significance level $0<\alpha<1$. This approach includes 25 | many commonly used MCPs as special cases and is transparent in 26 | visualizing MCPs for better communications. `graphicalMCP` is designed 27 | to design and analyze graphical MCPs in a flexible, informative and 28 | efficient way. 29 | 30 | # Installation 31 | 32 | ### Release 33 | 34 | You can install the current release version from *CRAN* with: 35 | 36 | ``` r 37 | install.packages("graphicalMCP") 38 | ``` 39 | 40 | ### Development 41 | 42 | You can install the current development version from *GitHub* with: 43 | 44 | ``` r 45 | # install.packages("pak") 46 | pak::pak("openpharma/graphicalMCP") 47 | ``` 48 | 49 | # Documentation 50 | 51 | - For basic usage instructions, see `vignette("graphicalMCP")` 52 | - To become familiar with graphical MCP terminologies, see 53 | `vignette("glossary")` 54 | - To learn examples of how to use `graphicalMCP`, 55 | - see `vignette("shortcut-testing")` for sequentially rejective 56 | graphical multiple comparison procedures based on Bonferroni 57 | tests 58 | - see `vignette("closed-testing")` for graphical multiple 59 | comparison procedures based on the closure principle using 60 | Bonferroni, Hochberg, parametric and Simes tests 61 | - see `vignette("graph-examples")` for common multiple comparison 62 | procedures illustrated using `graphicalMCP` 63 | - see `vignette("internal-validation")` for internal validation 64 | via power simulations for methods used in `graphicalMCP` 65 | - see `vignette("generate-closure")` for rationales to generate 66 | the closure and the weighting strategy of a graph 67 | - see `vignette("comparisons")` for comparisons to other R 68 | packages 69 | - To view vignettes in R after properly installing `graphicalMCP`, we 70 | can build vignettes by `devtools::install(build_vignettes = TRUE)`, 71 | and then use `browseVignettes("graphicalMCP")` to view the full list 72 | of vignettes 73 | 74 | # Related work 75 | 76 | - Graphical MCPs - [gMCP](https://cran.r-project.org/package=gMCP) 77 | - Lighter version of `gMCP` which removes the rJava dependency - 78 | [gMCPLite](https://cran.r-project.org/package=gMCPLite) 79 | - Graphical MCPs with Simes tests - 80 | [lrstat](https://cran.r-project.org/package=lrstat) 81 | 82 | Built upon these packages, we hope to implement graphical MCPs in a more 83 | general framework, with fewer dependencies and simpler S3 classes, and 84 | without losing computational efficiency. 85 | 86 | # Acknowledgments 87 | 88 | Along with the authors and contributors, thanks to the following people 89 | for their suggestions and inspirations on the package: 90 | 91 | Frank Bretz, Willi Maurer, Ekkehard Glimm, Nan Chen, Jeremy Wildfire, 92 | Spencer Childress, Colleen McLaughlin, Matt Roumaya, Chelsea Dickens, 93 | Nan Xiao, Keaven Anderson, and Ron Yu 94 | 95 | We owe a debt of gratitude to the authors of 96 | [gMCP](https://cran.r-project.org/package=gMCP) for their pioneering 97 | work, without which this package would not be nearly as extensive as it 98 | is. 99 | -------------------------------------------------------------------------------- /man/adjust_weights_parametric_util.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/adjust_weights_parametric_util.R 3 | \name{c_value_function} 4 | \alias{c_value_function} 5 | \alias{solve_c_parametric} 6 | \alias{adjust_weights_parametric_util} 7 | \title{Calculate adjusted hypothesis weights for parametric tests} 8 | \usage{ 9 | c_value_function( 10 | x, 11 | hypotheses, 12 | test_corr, 13 | alpha, 14 | maxpts = 25000, 15 | abseps = 1e-06, 16 | releps = 0 17 | ) 18 | 19 | solve_c_parametric( 20 | hypotheses, 21 | test_corr, 22 | alpha, 23 | maxpts = 25000, 24 | abseps = 1e-06, 25 | releps = 0 26 | ) 27 | 28 | adjust_weights_parametric_util( 29 | matrix_weights, 30 | matrix_intersections, 31 | test_corr, 32 | alpha, 33 | test_groups, 34 | maxpts = 25000, 35 | abseps = 1e-06, 36 | releps = 0 37 | ) 38 | } 39 | \arguments{ 40 | \item{x}{The root to solve for with \code{stats::uniroot()}.} 41 | 42 | \item{hypotheses}{A numeric vector of hypothesis weights. Must be a vector of 43 | values between 0 & 1 (inclusive). The sum of hypothesis weights should not 44 | exceed 1.} 45 | 46 | \item{test_corr}{(Optional) A numeric matrix of correlations between test 47 | statistics, which is needed to perform parametric tests using 48 | \code{\link[=adjust_weights_parametric]{adjust_weights_parametric()}}. The number of rows and columns of 49 | this correlation matrix should match the length of \code{p}.} 50 | 51 | \item{alpha}{(Optional) A numeric value of the overall significance level, 52 | which should be between 0 & 1. The default is 0.025 for one-sided 53 | hypothesis testing problems; another common choice is 0.05 for two-sided 54 | hypothesis testing problems. Note when parametric tests are used, only 55 | one-sided tests are supported.} 56 | 57 | \item{maxpts}{(Optional) An integer scalar for the maximum number of function 58 | values, which is needed to perform parametric tests using the 59 | \code{mvtnorm::GenzBretz} algorithm. The default is 25000.} 60 | 61 | \item{abseps}{(Optional) A numeric scalar for the absolute error tolerance, 62 | which is needed to perform parametric tests using the \code{mvtnorm::GenzBretz} 63 | algorithm. The default is 1e-6.} 64 | 65 | \item{releps}{(Optional) A numeric scalar for the relative error tolerance 66 | as double, which is needed to perform parametric tests using the 67 | \code{mvtnorm::GenzBretz} algorithm. The default is 0.} 68 | } 69 | \value{ 70 | \itemize{ 71 | \item \code{c_value_function()} returns the difference between 72 | \eqn{\alpha} and the Type I error of the parametric test with the \eqn{c} 73 | value of \code{x}, adjusted for the correlation between test statistics using 74 | parametric tests based on equation (6) of Xi et al. (2017). 75 | \item \code{solve_c_parametric()} returns the c value adjusted for the 76 | correlation between test statistics using parametric tests based on 77 | equation (6) of Xi et al. (2017). 78 | } 79 | } 80 | \description{ 81 | An intersection hypothesis can be rejected if its p-values are less than or 82 | equal to their adjusted significance levels, which are their adjusted 83 | hypothesis weights times \eqn{\alpha}. For Bonferroni tests, their adjusted 84 | hypothesis weights are their hypothesis weights of the intersection 85 | hypothesis. Additional adjustment is needed for parametric tests: 86 | \itemize{ 87 | \item Parametric tests for \code{\link[=adjust_weights_parametric]{adjust_weights_parametric()}}, 88 | \itemize{ 89 | \item Note that one-sided tests are required for parametric tests. 90 | } 91 | } 92 | } 93 | \references{ 94 | Xi, D., Glimm, E., Maurer, W., and Bretz, F. (2017). A unified framework 95 | for weighted parametric multiple test procedures. 96 | \emph{Biometrical Journal}, 59(5), 918-931. 97 | } 98 | \seealso{ 99 | \code{\link[=adjust_weights_parametric]{adjust_weights_parametric()}} for adjusted hypothesis weights using 100 | parametric tests. 101 | } 102 | \keyword{This} 103 | \keyword{`adjust_weights_parametric()`} 104 | \keyword{`test_corr`} 105 | \keyword{a} 106 | \keyword{allows} 107 | \keyword{be} 108 | \keyword{correlation} 109 | \keyword{different} 110 | \keyword{from} 111 | \keyword{function} 112 | \keyword{internal} 113 | \keyword{is} 114 | \keyword{list} 115 | \keyword{matrices.} 116 | \keyword{matrix.} 117 | \keyword{of} 118 | \keyword{only} 119 | \keyword{single} 120 | \keyword{to} 121 | \keyword{which} 122 | -------------------------------------------------------------------------------- /misc/functions/fun_miscellaneous.R: -------------------------------------------------------------------------------- 1 | # Miscellaneous functions to 2 | # 1. Generate the weighting scheme based on functions in gMCP R package 3 | # 2. Identify subsets of hypotheses where the parametric assumption is known 4 | # based on the correlation matrix 5 | # 3. Calculate the critical value when joint distribution is fully known 6 | # in Section 4.1 equation (1) 7 | # 4. Calculate the p-value when joint distribution is fully known 8 | # in Section 4.1 equation (2) 9 | # 5. Calculate the adjusted p-values for the single-step procedure, whic is 10 | # a weighted version of Dunnett test in Section 5 11 | 12 | # 1 13 | # Function to generate the weighting scheme based on functions in gMCP R package 14 | # Input parameters 15 | # w = a vector of local weights 16 | # g = a matrix of transition weights 17 | generateWeights <- function (w, g){ 18 | permutations <- function(n) { 19 | # Function to generate index matrix for all intersection hypotheses 20 | outer((1:(2^n)) - 1, (n:1) - 1, FUN = function(x, y) {(x%/%2^y)%%2}) 21 | } 22 | mtp.edges <- function(h, g, w){ 23 | if(sum(h)==length(h)){ 24 | return(g) 25 | } else { 26 | j <- which(h==0)[1] 27 | h[j] <- 1 28 | gu <- mtp.edges(h, g, w) 29 | gj <- gu[,j]%*%t(gu[j, ]) 30 | gt <- ((gu+gj)/(1-matrix(rep(diag(gj), nrow(gj)), nrow=nrow(gj)))) 31 | gt[j, ] <- 0 32 | gt[, j] <- 0 33 | diag(gt) <- 0 34 | gt[is.nan(gt)] <- 0 35 | return(gt) 36 | } 37 | } 38 | mtp.weights <- function(h, g, w){ 39 | if(sum(h)==length(h)){ 40 | return(w) 41 | } else { 42 | j <- which(h==0)[1] 43 | h[j] <- 1 44 | wu <- mtp.weights(h, g, w) 45 | gu <- mtp.edges(h, g, w) 46 | guj <- gu[j, ] 47 | wt <- wu + wu[j] * guj 48 | wt[j] <- 0 49 | return(wt) 50 | } 51 | } 52 | n <- length(w) 53 | intersect <- (permutations(n))[-1, ] 54 | g <- apply(intersect, 1, function(i) list(int = i, w = mtp.weights(i, g, w))) 55 | m <- as.matrix(as.data.frame(lapply(g, function(i) c(i$int, i$w)))) 56 | colnames(m) <- NULL 57 | rownames(m) <- c(paste("I", 1:n, sep=""), paste("W", 1:n, sep="")) 58 | t(m)[nrow(t(m)):1, ] 59 | } 60 | 61 | 62 | # 2 63 | # Function to identify subsets of hypotheses 64 | # where the parametric assumption is known 65 | # based on the correlation matrix, as in Section 4.3 66 | # Input parameters 67 | # x = a correlation matrix 68 | subset_function <- function(x){ 69 | subset <- !is.na(x) 70 | id <- !duplicated(subset) 71 | subsets <- vector("list", sum(id)) 72 | for (i in 1:sum(id)){ 73 | if (!is.null(nrow(x))){ 74 | subsets[[i]] <- (1:nrow(x))[which(subset[which(id)[i], ])] 75 | } else { 76 | subsets[[i]] <- 1 77 | } 78 | } 79 | return(subsets) 80 | } 81 | 82 | 83 | # 3 84 | # Function to calculate the critical value 85 | # when joint distribution is fully known in Section 4.1 equation (1) 86 | # x is the critical value to be solved 87 | # Note: cr in this function should be a normal correlation matrix without NA 88 | c_function <- function(x, w, cr, alpha){ 89 | require(mvtnorm) 90 | I <- which(w > 0) 91 | z<-qnorm(x * w[I] * alpha, lower.tail=FALSE) 92 | y <- ifelse(length(z)==1, pnorm(z, lower.tail=FALSE), 93 | 1 - pmvnorm(lower=-Inf, upper=z, test_corr=cr[I, I])) 94 | return(y - alpha * sum(w)) 95 | } 96 | 97 | 98 | # 4 99 | # Function to calculate the p-value when joint distribution fully known 100 | # in Section 4.1 equation (2) 101 | # Note: cr in this function should be a normal correlation matrix without NA 102 | p_function <- function(p, w, cr){ 103 | require(mvtnorm) 104 | I <- which(w > 0) 105 | q <- min(p[I] / w[I]) 106 | q <- q * w[I] 107 | z <- qnorm(q, lower.tail=FALSE) 108 | 1 / sum(w) * (1 - pmvnorm(lower=-Inf, upper = z, test_corr = cr[I, I])) 109 | } 110 | 111 | 112 | # 5 113 | # Function to calculate the adjusted p-values for the single-step procedure 114 | # A weighted version of Dunnett test as in Section 5 115 | # Note: cr in this function should be a correlation matrix without NA 116 | # Note: w in this function should not contain 0 117 | p_single_step_function <- function(p, w, cr){ 118 | require(mvtnorm) 119 | adjp <- p/w 120 | for(i in 1:length(p)){ 121 | q <- pmin(adjp[i]*w, 1) 122 | z <- qnorm(q, lower.tail=FALSE) 123 | adjp[i] <- 1-pmvnorm(lower=-Inf, upper=z, test_corr=cr) 124 | } 125 | return(adjp) 126 | } 127 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | bibliography: "`r system.file('references.bib', package='graphicalMCP')`" 4 | --- 5 | 6 | 7 | 8 | ```{r, include = FALSE} 9 | knitr::opts_chunk$set( 10 | results = "hide", 11 | collapse = TRUE, 12 | comment = "#>", 13 | fig.path = "man/figures/README-", 14 | fig.align = "center" 15 | ) 16 | ``` 17 | 18 | 19 | 20 | [![Project Status: Active – The project has reached a stable, usable state and is being actively developed.](https://www.repostatus.org/badges/latest/active.svg)](https://www.repostatus.org/#active) 21 | [![CRAN status](https://www.r-pkg.org/badges/version/graphicalMCP)](https://cran.r-project.org/package=graphicalMCP) 22 | [![CRAN monthly downloads](https://cranlogs.r-pkg.org/badges/graphicalMCP)](https://cranlogs.r-pkg.org/badges/graphicalMCP) 23 | [![CRAN total downloads](https://cranlogs.r-pkg.org/badges/grand-total/graphicalMCP)](https://cranlogs.r-pkg.org/badges/grand-total/graphicalMCP) 24 | 25 | 26 | 27 | 28 | # graphicalMCP 29 | 30 | # Introduction 31 | 32 | Graphical approaches for multiple comparison procedures (MCPs) are a general framework to control the family-wise error rate strongly at a pre-specified significance level $0<\alpha<1$. This approach includes many commonly used MCPs as special cases and is transparent in visualizing MCPs for better communications. `graphicalMCP` is designed to design and analyze graphical MCPs in a flexible, informative and efficient way. 33 | 34 | # Installation 35 | 36 | ### Release 37 | 38 | You can install the current release version from *CRAN* with: 39 | 40 | ```{r cran-installation, eval = FALSE} 41 | install.packages("graphicalMCP") 42 | ``` 43 | 44 | ### Development 45 | 46 | You can install the current development version from *GitHub* with: 47 | 48 | ```{r github-installation, eval = FALSE} 49 | # install.packages("pak") 50 | pak::pak("openpharma/graphicalMCP") 51 | ``` 52 | 53 | # Documentation 54 | 55 | - For basic usage instructions, see `vignette("graphicalMCP")` 56 | - To become familiar with graphical MCP terminologies, see `vignette("glossary")` 57 | - To learn examples of how to use `graphicalMCP`, 58 | - see `vignette("shortcut-testing")` for sequentially rejective graphical multiple comparison procedures based on Bonferroni tests 59 | - see `vignette("closed-testing")` for graphical multiple comparison procedures based on the closure principle using Bonferroni, Hochberg, parametric and Simes tests 60 | - see `vignette("graph-examples")` for common multiple comparison procedures illustrated using `graphicalMCP` 61 | - see `vignette("internal-validation")` for internal validation via power simulations for methods used in `graphicalMCP` 62 | - see `vignette("generate-closure")` for rationales to generate the closure and the weighting strategy of a graph 63 | - see `vignette("comparisons")` for comparisons to other R packages 64 | - To view vignettes in R after properly installing `graphicalMCP`, we can build vignettes by `devtools::install(build_vignettes = TRUE)`, and then use `browseVignettes("graphicalMCP")` to view the full list of vignettes 65 | 66 | # Related work 67 | 68 | - Graphical MCPs - [gMCP](https://cran.r-project.org/package=gMCP) 69 | - Lighter version of `gMCP` which removes the rJava dependency - [gMCPLite](https://cran.r-project.org/package=gMCPLite) 70 | - Graphical MCPs with Simes tests - [lrstat](https://cran.r-project.org/package=lrstat) 71 | 72 | Built upon these packages, we hope to implement graphical MCPs in a more general framework, with fewer dependencies and simpler S3 classes, and without losing computational efficiency. 73 | 74 | # Acknowledgments 75 | 76 | Along with the authors and contributors, thanks to the following people for their suggestions and inspirations on the package: 77 | 78 | Frank Bretz, Willi Maurer, Ekkehard Glimm, Nan Chen, Jeremy Wildfire, Spencer Childress, Colleen McLaughlin, Matt Roumaya, Chelsea Dickens, Nan Xiao, Keaven Anderson, and Ron Yu 79 | 80 | We owe a debt of gratitude to the authors of [gMCP](https://cran.r-project.org/package=gMCP) for their pioneering work, without which this package would not be nearly as extensive as it is. 81 | -------------------------------------------------------------------------------- /man/adjust_p.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/adjust_p.R 3 | \name{adjust_p_bonferroni} 4 | \alias{adjust_p_bonferroni} 5 | \alias{adjust_p_parametric} 6 | \alias{adjust_p_simes} 7 | \alias{adjust_p_hochberg} 8 | \title{Calculate adjusted p-values} 9 | \usage{ 10 | adjust_p_bonferroni(p, hypotheses) 11 | 12 | adjust_p_parametric( 13 | p, 14 | hypotheses, 15 | test_corr = NULL, 16 | maxpts = 25000, 17 | abseps = 1e-06, 18 | releps = 0 19 | ) 20 | 21 | adjust_p_simes(p, hypotheses) 22 | 23 | adjust_p_hochberg(p, hypotheses) 24 | } 25 | \arguments{ 26 | \item{p}{A numeric vector of p-values (unadjusted, raw), whose values should 27 | be between 0 & 1. The length should match the length of \code{hypotheses}.} 28 | 29 | \item{hypotheses}{A numeric vector of hypothesis weights. Must be a vector of 30 | values between 0 & 1 (inclusive). The length should match the length of 31 | \code{p}. The sum of hypothesis weights should not exceed 1.} 32 | 33 | \item{test_corr}{(Optional) A numeric matrix of correlations between test 34 | statistics, which is needed to perform parametric tests using 35 | \code{\link[=adjust_p_parametric]{adjust_p_parametric()}}. The number of rows and columns of 36 | this correlation matrix should match the length of \code{p}.} 37 | 38 | \item{maxpts}{(Optional) An integer scalar for the maximum number of function 39 | values, which is needed to perform parametric tests using the 40 | \code{mvtnorm::GenzBretz} algorithm. The default is 25000.} 41 | 42 | \item{abseps}{(Optional) A numeric scalar for the absolute error tolerance, 43 | which is needed to perform parametric tests using the \code{mvtnorm::GenzBretz} 44 | algorithm. The default is 1e-6.} 45 | 46 | \item{releps}{(Optional) A numeric scalar for the relative error tolerance 47 | as double, which is needed to perform parametric tests using the 48 | \code{mvtnorm::GenzBretz} algorithm. The default is 0.} 49 | } 50 | \value{ 51 | A single adjusted p-value for the intersection hypothesis. 52 | } 53 | \description{ 54 | For an intersection hypothesis, an adjusted p-value is the smallest 55 | significance level at which the intersection hypothesis can be rejected. 56 | The intersection hypothesis can be rejected if its adjusted p-value is less 57 | than or equal to \eqn{\alpha}. Currently, there are three test types 58 | supported: 59 | \itemize{ 60 | \item Bonferroni tests for \code{\link[=adjust_p_bonferroni]{adjust_p_bonferroni()}}, 61 | \item Parametric tests for \code{\link[=adjust_p_parametric]{adjust_p_parametric()}}, 62 | \itemize{ 63 | \item Note that one-sided tests are required for parametric tests. 64 | } 65 | \item Simes tests for \code{\link[=adjust_p_simes]{adjust_p_simes()}}, 66 | \item Hochberg tests for \code{\link[=adjust_p_hochberg]{adjust_p_hochberg()}}. 67 | } 68 | } 69 | \examples{ 70 | hypotheses <- c(H1 = 0.5, H2 = 0.25, H3 = 0.25) 71 | p <- c(0.019, 0.025, 0.05) 72 | adjust_p_bonferroni(p, hypotheses) 73 | set.seed(1234) 74 | hypotheses <- c(H1 = 0.5, H2 = 0.25, H3 = 0.25) 75 | p <- c(0.019, 0.025, 0.05) 76 | # Using the `mvtnorm::GenzBretz` algorithm 77 | corr <- matrix(0.5, nrow = 3, ncol = 3) 78 | diag(corr) <- 1 79 | adjust_p_parametric(p, hypotheses, corr) 80 | hypotheses <- c(H1 = 0.5, H2 = 0.25, H3 = 0.25) 81 | p <- c(0.019, 0.025, 0.05) 82 | adjust_p_simes(p, hypotheses) 83 | hypotheses <- c(H1 = .25, H2 = .25, H3 = 0.25, H4 = 0.25) 84 | p <- c(0.019, 0.025, 0.05, .05) 85 | adjust_p_hochberg(p, hypotheses) 86 | } 87 | \references{ 88 | Bretz, F., Maurer, W., Brannath, W., and Posch, M. (2009). A graphical 89 | approach to sequentially rejective multiple test procedures. 90 | \emph{Statistics in Medicine}, 28(4), 586-604. 91 | 92 | Lu, K. (2016). Graphical approaches using a Bonferroni mixture of weighted 93 | Simes tests. \emph{Statistics in Medicine}, 35(22), 4041-4055. 94 | 95 | Xi, D., Glimm, E., Maurer, W., and Bretz, F. (2017). A unified framework 96 | for weighted parametric multiple test procedures. 97 | \emph{Biometrical Journal}, 59(5), 918-931. 98 | 99 | Xi, D., and Bretz, F. (2019). Symmetric graphs for equally weighted tests, 100 | with application to the Hochberg procedure. \emph{Statistics in Medicine}, 101 | 38(27), 5268-5282. 102 | } 103 | \seealso{ 104 | \code{\link[=adjust_weights_parametric]{adjust_weights_parametric()}} for adjusted hypothesis weights using 105 | parametric tests, \code{\link[=adjust_weights_simes]{adjust_weights_simes()}} for adjusted hypothesis weights 106 | using Simes tests, \code{\link[=adjust_weights_hochberg]{adjust_weights_hochberg()}} for adjusted hypothesis 107 | weights using Hochberg tests. 108 | } 109 | -------------------------------------------------------------------------------- /R/as_graph.R: -------------------------------------------------------------------------------- 1 | #' Convert between graphicalMCP, gMCP, and igraph graph classes 2 | #' 3 | #' @description 4 | #' Graph objects have different structures and attributes in 5 | #' `graphicalMCP`, `gMCP`, and `igraph` R packages. These functions convert 6 | #' between different classes to increase compatibility. 7 | #' 8 | #' Note that `igraph` and `gMCP` have additional attributes for vertices, edges, 9 | #' or a graph itself. These conversion functions only handle attributes related 10 | #' to hypothesis names, hypothesis weights and transition weights. Other 11 | #' attributes will be dropped when converting. 12 | #' 13 | #' @param graph An `initial_graph` object from the `graphicalMCP` package, a 14 | #' `graphMCP` object from the `gMCP` package, or an `igraph` object from the 15 | #' `igraph` package, depending on the conversion type. 16 | #' 17 | #' @return 18 | #' * `as_graphMCP()` returns a `graphMCP` object for the `gMCP` package. 19 | #' * `as_igraph()` returns an `igraph` object for the `igraph` package. 20 | #' * `as_initial_graph()` returns an `initial_graph` object for the 21 | #' `graphicalMCP` package. 22 | #' 23 | #' @seealso [graph_create()] for the initial graph used in the `graphicalMCP` 24 | #' package. 25 | #' 26 | #' @rdname as_graph 27 | #' 28 | #' @export 29 | #' 30 | #' @references Csardi, G., Nepusz, T., Traag, V., Horvat, S., Zanini, F., Noom, 31 | #' D., and Mueller, K. (2024). \emph{igraph}: Network analysis and visualization 32 | #' in R. R package version 2.0.3. 33 | #' \url{https://CRAN.R-project.org/package=igraph}. 34 | #' 35 | #' Rohmeyer, K., and Klinglmueller, K. (2024). \emph{gMCP}: Graph based multiple 36 | #' test procedures. R package version 0.8-17. 37 | #' \url{https://cran.r-project.org/package=gMCP}. 38 | #' 39 | #' @examples 40 | #' g_graphicalMCP <- random_graph(5) 41 | #' 42 | #' if (requireNamespace("gMCP", quietly = TRUE)) { 43 | #' g_gMCP <- as_graphMCP(g_graphicalMCP) 44 | #' 45 | #' all.equal(g_graphicalMCP, as_initial_graph(g_gMCP)) 46 | #' } 47 | #' 48 | #' if (requireNamespace("igraph", quietly = TRUE)) { 49 | #' g_igraph <- as_igraph(g_graphicalMCP) 50 | #' 51 | #' all.equal(g_graphicalMCP, as_initial_graph(g_igraph)) 52 | #' } 53 | as_initial_graph <- function(graph) { 54 | UseMethod("as_initial_graph", graph) 55 | } 56 | 57 | #' @rdname as_graph 58 | #' @export 59 | as_initial_graph.graphMCP <- function(graph) { 60 | graph_create(graph@weights, graph@m) 61 | } 62 | 63 | #' @rdname as_graph 64 | #' @export 65 | as_initial_graph.igraph <- function(graph) { 66 | hypotheses <- igraph::vertex_attr(graph, "weight") 67 | names(hypotheses) <- igraph::vertex_attr(graph, "name") 68 | 69 | transitions <- matrix(0, length(hypotheses), length(hypotheses)) 70 | dimnames(transitions) <- rep(list(names(hypotheses)), 2) 71 | 72 | for (tail in seq_along(hypotheses)) { 73 | transitions[tail, ] <- graph[tail] 74 | } 75 | 76 | graph_create(hypotheses, transitions) 77 | } 78 | 79 | #' @rdname as_graph 80 | #' @export 81 | as_graphMCP <- function(graph) { 82 | UseMethod("as_graphMCP", graph) 83 | } 84 | 85 | #' @rdname as_graph 86 | #' @export 87 | as_graphMCP.initial_graph <- function(graph) { 88 | if (!requireNamespace("gMCP", quietly = TRUE)) { 89 | stop("Please install.packages('gMCP') before converting to a gMCP graph") 90 | } else { 91 | gMCP::matrix2graph(graph$transitions, graph$hypotheses) 92 | } 93 | } 94 | 95 | #' @rdname as_graph 96 | #' @export 97 | as_igraph <- function(graph) { 98 | UseMethod("as_igraph", graph) 99 | } 100 | 101 | #' @rdname as_graph 102 | #' @export 103 | as_igraph.initial_graph <- function(graph) { 104 | if (!requireNamespace("igraph", quietly = TRUE)) { 105 | stop("Please install.packages('igraph') before converting to an igraph") 106 | } else { 107 | num_hyps <- length(graph$hypotheses) 108 | hyp_names <- names(graph$hypotheses) 109 | 110 | empty_igraph <- igraph::make_empty_graph() 111 | 112 | vertex_igraph <- igraph::add_vertices( 113 | empty_igraph, 114 | num_hyps, 115 | name = hyp_names, 116 | weight = graph$hypotheses 117 | ) 118 | 119 | matrix_edge_tails <- matrix(rep(hyp_names, num_hyps), nrow = num_hyps) 120 | matrix_edge_heads <- 121 | matrix(rep(hyp_names, num_hyps), nrow = num_hyps, byrow = TRUE) 122 | 123 | edge_tails <- matrix_edge_tails[graph$transitions != 0] 124 | edge_heads <- matrix_edge_heads[graph$transitions != 0] 125 | 126 | vector_edges <- as.vector(rbind(edge_tails, edge_heads)) 127 | 128 | complete_igraph <- igraph::add_edges( 129 | vertex_igraph, 130 | vector_edges, 131 | weight = graph$transitions[graph$transitions != 0] 132 | ) 133 | 134 | complete_igraph 135 | } 136 | } 137 | -------------------------------------------------------------------------------- /tests/testthat/test-graph_calculate_power.R: -------------------------------------------------------------------------------- 1 | test_that("improper inputs throw errors", { 2 | rando <- random_graph(3) 3 | 4 | expect_no_error(graph_calculate_power(rando)) 5 | 6 | expect_error(graph_calculate_power(rando, sim_n = 100.5)) 7 | 8 | expect_error(graph_calculate_power(rando, power_marginal = c("1", 1, 1))) 9 | expect_error(graph_calculate_power(rando, sim_corr = matrix("1", 3, 3))) 10 | 11 | expect_error(graph_calculate_power(rando, power_marginal = c(1, 1))) 12 | expect_error(graph_calculate_power(rando, sim_corr = matrix(1, 2, 2))) 13 | 14 | expect_error(graph_calculate_power(rando, sim_corr = matrix(NA, 3, 3))) 15 | corr_inval <- matrix(c(1, 0, .5, 0, 1, 0, 0, 0, 1), nrow = 3, byrow = TRUE) 16 | expect_error(graph_calculate_power(rando, sim_corr = corr_inval)) 17 | 18 | expect_error(graph_calculate_power(rando, sim_success = "non-function")) 19 | 20 | expect_error( 21 | graph_calculate_power( 22 | rando, 23 | test_groups = list(f1 = 1:2, f2 = 3), 24 | test_types = c(f2 = "b", f1 = "s"), 25 | test_corr = list(f3 = NA, f1 = NA) 26 | ) 27 | ) 28 | 29 | expect_no_error( 30 | graph_calculate_power( 31 | rando, 32 | test_groups = list(f1 = 1:2, f2 = 3), 33 | test_types = c(f2 = "b", f1 = "s"), 34 | test_corr = list(f2 = NA, f1 = NA) 35 | ) 36 | ) 37 | }) 38 | 39 | test_that("power results are identical under a given seed", { 40 | rando <- random_graph(2) 41 | 42 | set.seed(42823) 43 | bonf_1 <- graph_calculate_power(rando, sim_n = 1e5) 44 | 45 | set.seed(42823) 46 | bonf_2 <- graph_calculate_power(rando, sim_n = 1e5) 47 | 48 | expect_equal(bonf_1, bonf_2) 49 | 50 | set.seed(42824) 51 | simes_1 <- graph_calculate_power(rando, test_types = "s", sim_n = 1e5) 52 | 53 | set.seed(42824) 54 | simes_2 <- graph_calculate_power(rando, test_types = "s", sim_n = 1e5) 55 | 56 | expect_equal(simes_1, simes_2) 57 | 58 | set.seed(42825) 59 | para_1 <- graph_calculate_power( 60 | rando, 61 | test_types = "p", 62 | test_corr = list(diag(2)), 63 | sim_n = 1e4 64 | ) 65 | 66 | set.seed(42825) 67 | para_2 <- graph_calculate_power( 68 | rando, 69 | test_types = "p", 70 | test_corr = list(diag(2)), 71 | sim_n = 1e4 72 | ) 73 | 74 | expect_equal(para_1, para_2) 75 | }) 76 | 77 | test_that("size one groups are turned into Bonferroni", { 78 | g <- fallback(rep(1 / 3, 3)) 79 | 80 | set.seed(42823) 81 | expect_equal( 82 | graph_calculate_power( 83 | graph = g, 84 | alpha = 0.05, 85 | test_groups = list(1, 2, 3), 86 | test_types = c("s", "p", "p"), 87 | sim_n = 1e5 88 | )$inputs$test_types, 89 | c("bonferroni", "bonferroni", "bonferroni"), 90 | ignore_attr = TRUE 91 | ) 92 | }) 93 | 94 | test_that("multi-group/multi-test type runs without error", { 95 | expect_no_error( 96 | graph_calculate_power( 97 | graph = random_graph(4), 98 | test_groups = list(c(4, 1), 2:3), 99 | test_types = "s" 100 | ) 101 | ) 102 | 103 | expect_no_error( 104 | graph_calculate_power( 105 | graph = random_graph(4), 106 | test_groups = list(c(3, 1), c(2, 4)), 107 | test_types = "p", 108 | test_corr = list(diag(2), diag(2)) 109 | ) 110 | ) 111 | }) 112 | 113 | test_that("medium graph runs without error", { 114 | # random positive definite matrix - not sure if the diag override can break 115 | # this, but it's at least better than my last try 116 | t_corr <- matrix(abs(stats::rWishart(1, 9, diag(9))), 9, 9) 117 | t_corr <- t_corr / max(t_corr) 118 | diag(t_corr) <- 1 119 | t_corr_para <- t_corr[c(1, 4, 7), c(1, 4, 7)] 120 | 121 | expect_no_error( 122 | graph_calculate_power( 123 | graph = bonferroni(9), 124 | alpha = 0.025, 125 | test_groups = list(c(1, 4, 7), 2:3, 5:6, 8:9), 126 | test_types = c("p", "s", "s", "s"), 127 | test_corr = list(t_corr_para, NA, NA, NA), 128 | sim_n = 1e4, 129 | power_marginal = runif(9, min = 0, max = 1), 130 | sim_corr = diag(9), 131 | sim_success = function(.) .[1] || .[4] || .[7] 132 | ) 133 | ) 134 | }) 135 | 136 | test_that("verbose output", { 137 | t_corr <- matrix(abs(stats::rWishart(1, 9, diag(9))), 9, 9) 138 | t_corr <- t_corr / max(t_corr) 139 | diag(t_corr) <- 1 140 | t_corr_para <- t_corr[c(1, 4, 7), c(1, 4, 7)] 141 | 142 | expect_equal( 143 | names( 144 | graph_calculate_power( 145 | graph = fallback_improved_1(rep(1 / 3, 3)), 146 | alpha = 0.025, 147 | sim_n = 1e4, 148 | power_marginal = runif(3, min = 0, max = 1), 149 | verbose = TRUE 150 | )$details 151 | ), 152 | c("p_sim", "test_results") 153 | ) 154 | }) 155 | -------------------------------------------------------------------------------- /R/graph_rejection_orderings.R: -------------------------------------------------------------------------------- 1 | #' Find alternate rejection orderings (sequences) for shortcut tests 2 | #' 3 | #' @description 4 | #' When multiple hypotheses are rejected by using [graph_test_shortcut()], 5 | #' there may be multiple orderings or sequences in which hypotheses are rejected 6 | #' one by one. The default order in [graph_test_shortcut()] is based on the 7 | #' adjusted p-values, from the smallest to the largest. This function 8 | #' [graph_rejection_orderings()] provides all possible and valid orders 9 | #' (or sequences) of rejections. Although the order of rejection does not affect 10 | #' the final rejection decisions Bretz et al. (2009), different sequences could 11 | #' offer different ways to explain the step-by-step process of shortcut 12 | #' graphical multiple comparison procedures. 13 | #' 14 | #' @param shortcut_test_result A `graph_report` object as returned by 15 | #' [graph_test_shortcut()]. 16 | #' 17 | #' @return A modified `graph_report` object containing all valid orderings of 18 | #' rejections of hypotheses 19 | #' 20 | #' @seealso 21 | #' [graph_test_shortcut()] for shortcut graphical multiple comparison 22 | #' procedures. 23 | #' 24 | #' @rdname graph_rejection_orderings 25 | #' 26 | #' @export 27 | #' 28 | #' @references 29 | #' Bretz, F., Maurer, W., Brannath, W., and Posch, M. (2009). A graphical 30 | #' approach to sequentially rejective multiple test procedures. 31 | #' \emph{Statistics in Medicine}, 28(4), 586-604. 32 | #' 33 | #' Bretz, F., Posch, M., Glimm, E., Klinglmueller, F., Maurer, W., and 34 | #' Rohmeyer, K. (2011). Graphical approaches for multiple comparison 35 | #' procedures using weighted Bonferroni, Simes, or parametric tests. 36 | #' \emph{Biometrical Journal}, 53(6), 894-913. 37 | #' 38 | #' @examples 39 | #' # A graphical multiple comparison procedure with two primary hypotheses (H1 40 | #' # and H2) and two secondary hypotheses (H3 and H4) 41 | #' # See Figure 4 in Bretz et al. (2011). 42 | #' hypotheses <- c(0.5, 0.5, 0, 0) 43 | #' delta <- 0.5 44 | #' transitions <- rbind( 45 | #' c(0, delta, 1 - delta, 0), 46 | #' c(delta, 0, 0, 1 - delta), 47 | #' c(0, 1, 0, 0), 48 | #' c(1, 0, 0, 0) 49 | #' ) 50 | #' g <- graph_create(hypotheses, transitions) 51 | #' 52 | #' p <- c(0.018, 0.01, 0.105, 0.006) 53 | #' alpha <- 0.025 54 | #' 55 | #' shortcut_testing <- graph_test_shortcut(g, p, alpha, verbose = TRUE) 56 | #' 57 | #' # Reject H1, H2, and H4 58 | #' shortcut_testing$outputs$rejected 59 | #' 60 | #' # Default order of rejections: H2, H1, H4 61 | #' shortcut_testing$details$del_seq 62 | #' 63 | #' # There is another valid sequence of rejection: H2, H4, H1 64 | #' graph_rejection_orderings(shortcut_testing)$valid_orderings 65 | #' 66 | #' # Finally, intermediate updated graphs can be obtained by providing the order 67 | #' # of rejections into `[graph_update()]` 68 | #' graph_update(g, delete = c(2, 4, 1)) 69 | graph_rejection_orderings <- function(shortcut_test_result) { 70 | # Extract basic testing values ----------------------------------------------- 71 | graph <- shortcut_test_result$inputs$graph 72 | p <- shortcut_test_result$inputs$p 73 | alpha <- shortcut_test_result$inputs$alpha 74 | 75 | hyp_names <- names(graph$hypotheses) 76 | 77 | # Permute rejected hypotheses ------------------------------------------------ 78 | rejected <- which(shortcut_test_result$outputs$rejected) 79 | 80 | list_possible_orderings <- apply( 81 | rev(expand.grid(rep(list(rejected), length(rejected)))), 82 | 1, 83 | function(row) { 84 | if (length(unique(row)) == length(row)) { 85 | structure(row, names = hyp_names[row]) 86 | } else { 87 | NULL 88 | } 89 | } 90 | ) 91 | list_possible_orderings <- Filter(Negate(is.null), list_possible_orderings) 92 | 93 | # Find which permutations are valid rejection orderings ---------------------- 94 | orderings_valid <- vector("logical", length(list_possible_orderings)) 95 | 96 | for (hyp_ordering_num in seq_along(list_possible_orderings)) { 97 | hyp_ordering <- list_possible_orderings[[hyp_ordering_num]] 98 | intermediate_graph <- graph 99 | 100 | for (hyp_num in hyp_ordering) { 101 | if (p[[hyp_num]] <= intermediate_graph$hypotheses[[hyp_num]] * alpha) { 102 | intermediate_graph <- 103 | graph_update(intermediate_graph, hyp_num)$updated_graph 104 | } else { 105 | orderings_valid[[hyp_ordering_num]] <- FALSE 106 | break 107 | } 108 | 109 | orderings_valid[[hyp_ordering_num]] <- TRUE 110 | } 111 | } 112 | 113 | structure( 114 | c( 115 | shortcut_test_result, 116 | list(valid_orderings = list_possible_orderings[orderings_valid]) 117 | ), 118 | class = "graph_report" 119 | ) 120 | } 121 | -------------------------------------------------------------------------------- /man/graph_test_shortcut.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/graph_test_shortcut.R 3 | \name{graph_test_shortcut} 4 | \alias{graph_test_shortcut} 5 | \title{Perform shortcut (sequentially rejective) graphical multiple comparison 6 | procedures} 7 | \usage{ 8 | graph_test_shortcut( 9 | graph, 10 | p, 11 | alpha = 0.025, 12 | verbose = FALSE, 13 | test_values = FALSE 14 | ) 15 | } 16 | \arguments{ 17 | \item{graph}{An initial graph as returned by \code{\link[=graph_create]{graph_create()}}.} 18 | 19 | \item{p}{A numeric vector of p-values (unadjusted, raw), whose values should 20 | be between 0 & 1. The length should match the number of hypotheses in 21 | \code{graph}.} 22 | 23 | \item{alpha}{A numeric scalar of the overall significance level, which should 24 | be between 0 & 1. The default is 0.025 for one-sided hypothesis testing 25 | problems; another common choice is 0.05 for two-sided hypothesis testing 26 | problems.} 27 | 28 | \item{verbose}{A logical scalar specifying whether the details of 29 | intermediate update graphs should be included in results. When 30 | \code{verbose = TRUE}, intermediate update graphs are provided after deleting 31 | each hypothesis, which has been rejected. The default is \code{verbose = FALSE}.} 32 | 33 | \item{test_values}{A logical scalar specifying whether adjusted significance 34 | levels should be provided for each hypothesis. When \code{test_values = TRUE}, 35 | it provides an equivalent way of performing graphical multiple comparison 36 | procedures by comparing each p-value with its significance level. If the 37 | p-value of a hypothesis is less than or equal to its significance level, 38 | the hypothesis is rejected. The order of rejection is based on the order 39 | of adjusted p-values from the smallest to the largest. The default is 40 | \code{test_values = FALSE}.} 41 | } 42 | \value{ 43 | An S3 object of class \code{graph_report} with a list of 4 elements: 44 | \itemize{ 45 | \item \code{inputs} - Input parameters, which is a list of: 46 | \itemize{ 47 | \item \code{graph} - Initial graph, 48 | *\code{p} - (Unadjusted or raw) p-values, 49 | \item \code{alpha} - Overall significance level, 50 | \item \code{test_groups} - Groups of hypotheses for different types of tests, 51 | which are the list of all hypotheses for \code{\link[=graph_test_shortcut]{graph_test_shortcut()}}, 52 | \item \code{test_types} - Different types of tests, which are "bonferroni" for 53 | \code{\link[=graph_test_shortcut]{graph_test_shortcut()}}. 54 | } 55 | \item Output parameters \code{outputs}, which is a list of: 56 | \itemize{ 57 | \item \code{adjusted_p} - Adjusted p-values, 58 | \item \code{rejected} - Rejected hypotheses, 59 | \item \code{graph} - Updated graph after deleting all rejected hypotheses. 60 | } 61 | \item \code{details} - Verbose outputs with intermediate updated graphs, if 62 | \code{verbose = TRUE}. 63 | \item \code{test_values} - Adjusted significance levels, if \code{test_values = TRUE}. 64 | } 65 | } 66 | \description{ 67 | Shortcut graphical multiple comparison procedures are sequentially rejective 68 | procedure based on Bretz et al. (2009). With $m$ hypotheses, there are at 69 | most $m$ steps to obtain all rejection decisions. These procedure are 70 | equivalent to closed graphical multiple comparison procedures using 71 | Bonferroni tests for intersection hypotheses, but shortcut procedures are 72 | faster to perform. See \code{vignette("shortcut-testing")} for more illustration 73 | of shortcut procedures and interpretation of their outputs. 74 | } 75 | \examples{ 76 | # A graphical multiple comparison procedure with two primary hypotheses (H1 77 | # and H2) and two secondary hypotheses (H3 and H4) 78 | # See Figure 1 in Bretz et al. (2011). 79 | hypotheses <- c(0.5, 0.5, 0, 0) 80 | transitions <- rbind( 81 | c(0, 0, 1, 0), 82 | c(0, 0, 0, 1), 83 | c(0, 1, 0, 0), 84 | c(1, 0, 0, 0) 85 | ) 86 | g <- graph_create(hypotheses, transitions) 87 | 88 | p <- c(0.018, 0.01, 0.105, 0.006) 89 | alpha <- 0.025 90 | graph_test_shortcut(g, p, alpha) 91 | } 92 | \references{ 93 | Bretz, F., Maurer, W., Brannath, W., and Posch, M. (2009). A graphical 94 | approach to sequentially rejective multiple test procedures. 95 | \emph{Statistics in Medicine}, 28(4), 586-604. 96 | 97 | Bretz, F., Posch, M., Glimm, E., Klinglmueller, F., Maurer, W., and 98 | Rohmeyer, K. (2011). Graphical approaches for multiple comparison 99 | procedures using weighted Bonferroni, Simes, or parametric tests. 100 | \emph{Biometrical Journal}, 53(6), 894-913. 101 | } 102 | \seealso{ 103 | \itemize{ 104 | \item \code{\link[=graph_test_closure]{graph_test_closure()}} for graphical multiple comparison procedures using 105 | the closed test, 106 | \item \code{\link[=graph_rejection_orderings]{graph_rejection_orderings()}} for all possible rejection orderings. 107 | } 108 | } 109 | -------------------------------------------------------------------------------- /man/graph_create.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/graph_create.R 3 | \name{graph_create} 4 | \alias{graph_create} 5 | \title{Create the initial graph for a multiple comparison procedure} 6 | \usage{ 7 | graph_create(hypotheses, transitions, hyp_names = NULL) 8 | } 9 | \arguments{ 10 | \item{hypotheses}{A numeric vector of hypothesis weights in a graphical 11 | multiple comparison procedure. Must be a vector of values between 0 & 1 12 | (inclusive). The length should match the row and column lengths of 13 | \code{transitions}. The sum of hypothesis weights should not exceed 1.} 14 | 15 | \item{transitions}{A numeric matrix of transition weights between hypotheses 16 | in a graphical multiple comparison procedure. Must be a square matrix of 17 | values between 0 & 1 (inclusive). The row and column lengths should match 18 | the length of \code{hypotheses}. Each row (Transition weights leaving a 19 | hypothesis) can sum to no more than 1. The diagonal entries (Transition 20 | weights from a hypothesis to itself) must be all 0s.} 21 | 22 | \item{hyp_names}{(Optional) A character vector of hypothesis names. If not 23 | provided, names from \code{hypotheses} and \code{transitions} will be used. If names 24 | are not specified, hypotheses will be named sequentially as H1, H2, .......} 25 | } 26 | \value{ 27 | An S3 object of class \code{initial_graph} with a list of 2 elements: 28 | \itemize{ 29 | \item Hypothesis weights \code{hypotheses}. 30 | \item Transition weights \code{transitions}. 31 | } 32 | } 33 | \description{ 34 | A graphical multiple comparison procedure is represented by 1) a vector of 35 | initial hypothesis weights \code{hypotheses}, and 2) a matrix of initial 36 | transition weights \code{transitions}. This function creates the initial graph 37 | object using hypothesis weights and transition weights. 38 | } 39 | \section{Validation of inputs}{ 40 | 41 | Inputs are also validated to make sure of the validity of the graph: 42 | \itemize{ 43 | \item Hypothesis weights \code{hypotheses} are numeric. 44 | \item Transition weights \code{transitions} are numeric. 45 | \item Length of \code{hypotheses} and dimensions of \code{transitions} match. 46 | \item Hypothesis weights \code{hypotheses} must be non-negative and sum to no more 47 | than 1. 48 | \item Transition weights \code{transitions}: 49 | \itemize{ 50 | \item Values must be non-negative. 51 | \item Rows must sum to no more than 1. 52 | \item Diagonal entries must be all 0. 53 | } 54 | \item Hypothesis names \code{hyp_names} override names in \code{hypotheses} or 55 | \code{transitions}. 56 | } 57 | } 58 | 59 | \examples{ 60 | # A graphical multiple comparison procedure with two primary hypotheses (H1 61 | # and H2) and two secondary hypotheses (H3 and H4) 62 | # See Figure 1 in Bretz et al. (2011). 63 | hypotheses <- c(0.5, 0.5, 0, 0) 64 | transitions <- rbind( 65 | c(0, 0, 1, 0), 66 | c(0, 0, 0, 1), 67 | c(0, 1, 0, 0), 68 | c(1, 0, 0, 0) 69 | ) 70 | hyp_names <- c("H11", "H12", "H21", "H22") 71 | g <- graph_create(hypotheses, transitions, hyp_names) 72 | g 73 | 74 | # Explicit names override names in `hypotheses` (with a warning) 75 | hypotheses <- c(h1 = 0.5, h2 = 0.5, h3 = 0, h4 = 0) 76 | transitions <- rbind( 77 | c(0, 0, 1, 0), 78 | c(0, 0, 0, 1), 79 | c(0, 1, 0, 0), 80 | c(1, 0, 0, 0) 81 | ) 82 | g <- graph_create(hypotheses, transitions, hyp_names) 83 | g 84 | 85 | # Use names in `transitions` 86 | hypotheses <- c(0.5, 0.5, 0, 0) 87 | transitions <- rbind( 88 | H1 = c(0, 0, 1, 0), 89 | H2 = c(0, 0, 0, 1), 90 | H3 = c(0, 1, 0, 0), 91 | H4 = c(1, 0, 0, 0) 92 | ) 93 | g <- graph_create(hypotheses, transitions) 94 | g 95 | 96 | # Unmatched names in `hypotheses` and `transitions` (with an error) 97 | hypotheses <- c(h1 = 0.5, h2 = 0.5, h3 = 0, h4 = 0) 98 | transitions <- rbind( 99 | H1 = c(0, 0, 1, 0), 100 | H2 = c(0, 0, 0, 1), 101 | H3 = c(0, 1, 0, 0), 102 | H4 = c(1, 0, 0, 0) 103 | ) 104 | try( 105 | g <- graph_create(hypotheses, transitions) 106 | ) 107 | 108 | # When names are not specified, hypotheses are numbered sequentially as 109 | # H1, H2, ... 110 | hypotheses <- c(0.5, 0.5, 0, 0) 111 | transitions <- rbind( 112 | c(0, 0, 1, 0), 113 | c(0, 0, 0, 1), 114 | c(0, 1, 0, 0), 115 | c(1, 0, 0, 0) 116 | ) 117 | g <- graph_create(hypotheses, transitions) 118 | g 119 | } 120 | \references{ 121 | Bretz, F., Maurer, W., Brannath, W., and Posch, M. (2009). A graphical 122 | approach to sequentially rejective multiple test procedures. 123 | \emph{Statistics in Medicine}, 28(4), 586-604. 124 | 125 | Bretz, F., Posch, M., Glimm, E., Klinglmueller, F., Maurer, W., and 126 | Rohmeyer, K. (2011). Graphical approaches for multiple comparison 127 | procedures using weighted Bonferroni, Simes, or parametric tests. 128 | \emph{Biometrical Journal}, 53(6), 894-913. 129 | } 130 | \seealso{ 131 | \code{\link[=graph_update]{graph_update()}} for the updated graph after hypotheses being deleted 132 | from the initial graph. 133 | } 134 | --------------------------------------------------------------------------------