From 73c3260f17c6373f775ae257ed7e026a3fc6beab Mon Sep 17 00:00:00 2001 From: Nan Xiao Date: Sun, 25 Feb 2024 22:29:25 -0500 Subject: [PATCH] Make tests self-contained --- tests/testthat/helper-generate_corr_new.R | 126 +++++++++++++++ .../test-independent-generate_bounds.R | 1 - .../testthat/test-independent-generate_corr.R | 32 ++-- .../test-independent-generate_corr_new.R | 143 ++---------------- 4 files changed, 152 insertions(+), 150 deletions(-) create mode 100644 tests/testthat/helper-generate_corr_new.R diff --git a/tests/testthat/helper-generate_corr_new.R b/tests/testthat/helper-generate_corr_new.R new file mode 100644 index 0000000..d378ff3 --- /dev/null +++ b/tests/testthat/helper-generate_corr_new.R @@ -0,0 +1,126 @@ +# Helper functions used by test-independent-generate_corr_new.R + +#' Generate correlation matrix based on event counts +#' +#' @param event Event count of each hypothesis at each analysis, including +#' event count of the intersection of hypotheses. +#' It contains 4 columns: `H1`, `H2`, `Analysis`, `Event`. +#' `H1` needs to be listed as 1, 2, 3, etc. as numbers. +#' +#' @return A correlation matrix. +#' +#' @importFrom dplyr filter select %>% +#' +#' @export +#' +#' @examples +#' # Build the transition matrix +#' m <- matrix(c( +#' 0, 0.5, 0.5, +#' 0.5, 0, 0.5, +#' 0.5, 0.5, 0 +#' ), nrow = 3, byrow = TRUE) +#' # initialize weights +#' w <- c(1 / 3, 1 / 3, 1 / 3) +#' +#' # Input event count of intersection of paired hypotheses - Table 2 +#' event <- tibble::tribble( +#' ~H1, ~H2, ~Analysis, ~Event, +#' 1, 1, 1, 155, +#' 2, 2, 1, 160, +#' 3, 3, 1, 165, +#' 1, 2, 1, 85, +#' 1, 3, 1, 85, +#' 2, 3, 1, 85, +#' 1, 1, 2, 305, +#' 2, 2, 2, 320, +#' 3, 3, 2, 335, +#' 1, 2, 2, 170, +#' 1, 3, 2, 170, +#' 2, 3, 2, 170 +#' ) +#' +#' # Generate correlation from events +#' gs_corr <- generate_corr_new(event) +generate_corr_new <- function(event) { + elem <- event %>% subset(H1 == H2) + inter <- event %>% subset(H1 != H2) + n_hypotheses <- max(as.numeric(elem$H1)) + n_analyses <- max(elem$Analysis) + + # Diagonal + D <- diag(elem$Event) + + # Within hypothesis across analyses + if (n_analyses > 1) { + for (i in 1:n_hypotheses) { + for (j in 1:(n_analyses - 1)) { + count <- D[(j - 1) * n_hypotheses + i, (j - 1) * n_hypotheses + i] + for (k in (j + 1):n_analyses) { + D[(j - 1) * n_hypotheses + i, (k - 1) * n_hypotheses + i] <- count + D[(k - 1) * n_hypotheses + i, (j - 1) * n_hypotheses + i] <- count + } + } + } + } + + # Between hypotheses and analyses + for (i in 1:(n_hypotheses - 1)) { + for (j in c((i + 1):n_hypotheses)) { + for (k in 1:n_analyses) { + count1 <- as.numeric(event %>% + subset(((H1 == i & H2 == j) | (H1 == j & H2 == i)) & Analysis == k) %>% + select(Event))[1] + for (l in (k:n_analyses)) { + D[n_hypotheses * (l - 1) + i, n_hypotheses * (k - 1) + j] <- count1 + D[n_hypotheses * (l - 1) + j, n_hypotheses * (k - 1) + i] <- count1 + D[n_hypotheses * (k - 1) + j, n_hypotheses * (l - 1) + i] <- count1 + D[n_hypotheses * (k - 1) + i, n_hypotheses * (l - 1) + j] <- count1 + } + } + } + } + + corr_mat <- d_corr(D) + + col_names <- NULL + for (k in 1:n_analyses) { + for (i in 1:n_hypotheses) { + name_tmp <- paste("H", i, "_A", k, sep = "") + col_names <- c(col_names, name_tmp) + } + } + + colnames(corr_mat) <- col_names + + return(corr_mat) +} + +test_generate_corr_new <- function() { + a1 <- 80 + b1 <- 100 + ab1 <- 60 + a2 <- 120 + b2 <- 150 + ab2 <- 80 + + event <- tibble::tribble( + ~H1, ~H2, ~Analysis, ~Event, + 1, 1, 1, a1, + 2, 2, 1, b1, + 1, 2, 1, ab1, + 1, 1, 2, a2, + 2, 2, 2, b2, + 1, 2, 2, ab2 + ) + + list( + "a1" = a1, + "b1" = b1, + "ab1" = ab1, + "a2" = a2, + "b2" = b2, + "ab2" = ab2, + "event" = event + ) +} diff --git a/tests/testthat/test-independent-generate_bounds.R b/tests/testthat/test-independent-generate_bounds.R index d98ef3d..67d474b 100644 --- a/tests/testthat/test-independent-generate_bounds.R +++ b/tests/testthat/test-independent-generate_bounds.R @@ -214,7 +214,6 @@ test_that("BH bounds replicate tables A3 and A4", { expect_equal(wA4_result3_test, wA4_result3) }) - test_that("BH bounds replicate tables A6 and A7", { # From wpgsd github: # Example 2 BH weighting results in Table A6 and A7 diff --git a/tests/testthat/test-independent-generate_corr.R b/tests/testthat/test-independent-generate_corr.R index f0a636f..a1699f5 100644 --- a/tests/testthat/test-independent-generate_corr.R +++ b/tests/testthat/test-independent-generate_corr.R @@ -1,21 +1,21 @@ -a1 <- 80 -b1 <- 100 -ab1 <- 60 -a2 <- 120 -b2 <- 150 -ab2 <- 80 +test_that("2 endpoints 2 analysis correlation as expected", { + a1 <- 80 + b1 <- 100 + ab1 <- 60 + a2 <- 120 + b2 <- 150 + ab2 <- 80 -event <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, a1, - 2, 2, 1, b1, - 1, 2, 1, ab1, - 1, 1, 2, a2, - 2, 2, 2, b2, - 1, 2, 2, ab2 -) + event <- tibble::tribble( + ~H1, ~H2, ~Analysis, ~Event, + 1, 1, 1, a1, + 2, 2, 1, b1, + 1, 2, 1, ab1, + 1, 1, 2, a2, + 2, 2, 2, b2, + 1, 2, 2, ab2 + ) -test_that("2 endpoints 2 analysis correlation as expected", { corr <- generate_corr(event) corr_test <- matrix( c( diff --git a/tests/testthat/test-independent-generate_corr_new.R b/tests/testthat/test-independent-generate_corr_new.R index 5749448..aae7943 100644 --- a/tests/testthat/test-independent-generate_corr_new.R +++ b/tests/testthat/test-independent-generate_corr_new.R @@ -1,135 +1,13 @@ -# Copyright (c) 2023 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. -# All rights reserved. -# -# This file is part of the wpgsd program. -# -# wpgsd is free software: you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation, either version 3 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program. If not, see . - -#' Generate correlation matrix based on event counts -#' -#' @param event Event count of each hypothesis at each analysis, including -#' event count of the intersection of hypotheses. -#' It contains 4 columns: `H1`, `H2`, `Analysis`, `Event`. -#' `H1` needs to be listed as 1, 2, 3, etc. as numbers. -#' -#' @return A correlation matrix. -#' -#' @importFrom dplyr filter select %>% -#' -#' @export -#' -#' @examples -#' # Build the transition matrix -#' m <- matrix(c( -#' 0, 0.5, 0.5, -#' 0.5, 0, 0.5, -#' 0.5, 0.5, 0 -#' ), nrow = 3, byrow = TRUE) -#' # initialize weights -#' w <- c(1 / 3, 1 / 3, 1 / 3) -#' -#' # Input event count of intersection of paired hypotheses - Table 2 -#' event <- tibble::tribble( -#' ~H1, ~H2, ~Analysis, ~Event, -#' 1, 1, 1, 155, -#' 2, 2, 1, 160, -#' 3, 3, 1, 165, -#' 1, 2, 1, 85, -#' 1, 3, 1, 85, -#' 2, 3, 1, 85, -#' 1, 1, 2, 305, -#' 2, 2, 2, 320, -#' 3, 3, 2, 335, -#' 1, 2, 2, 170, -#' 1, 3, 2, 170, -#' 2, 3, 2, 170 -#' ) -#' -#' # Generate correlation from events -#' gs_corr <- generate_corr_new(event) -generate_corr_new <- function(event) { - elem <- event %>% subset(H1 == H2) - inter <- event %>% subset(H1 != H2) - n_hypotheses <- max(as.numeric(elem$H1)) - n_analyses <- max(elem$Analysis) - - # Diagonal - D <- diag(elem$Event) - - # Within hypothesis across analyses - if (n_analyses > 1) { - for (i in 1:n_hypotheses) { - for (j in 1:(n_analyses - 1)) { - count <- D[(j - 1) * n_hypotheses + i, (j - 1) * n_hypotheses + i] - for (k in (j + 1):n_analyses) { - D[(j - 1) * n_hypotheses + i, (k - 1) * n_hypotheses + i] <- count - D[(k - 1) * n_hypotheses + i, (j - 1) * n_hypotheses + i] <- count - } - } - } - } - - # Between hypotheses and analyses - for (i in 1:(n_hypotheses - 1)) { - for (j in c((i + 1):n_hypotheses)) { - for (k in 1:n_analyses) { - count1 <- as.numeric(event %>% - subset(((H1 == i & H2 == j) | (H1 == j & H2 == i)) & Analysis == k) %>% - select(Event))[1] - for (l in (k:n_analyses)) { - D[n_hypotheses * (l - 1) + i, n_hypotheses * (k - 1) + j] <- count1 - D[n_hypotheses * (l - 1) + j, n_hypotheses * (k - 1) + i] <- count1 - D[n_hypotheses * (k - 1) + j, n_hypotheses * (l - 1) + i] <- count1 - D[n_hypotheses * (k - 1) + i, n_hypotheses * (l - 1) + j] <- count1 - } - } - } - } - - corr_mat <- d_corr(D) - - col_names <- NULL - for (k in 1:n_analyses) { - for (i in 1:n_hypotheses) { - name_tmp <- paste("H", i, "_A", k, sep = "") - col_names <- c(col_names, name_tmp) - } - } - - colnames(corr_mat) <- col_names - - return(corr_mat) -} - -a1 <- 80 -b1 <- 100 -ab1 <- 60 -a2 <- 120 -b2 <- 150 -ab2 <- 80 - -event <- tibble::tribble( - ~H1, ~H2, ~Analysis, ~Event, - 1, 1, 1, a1, - 2, 2, 1, b1, - 1, 2, 1, ab1, - 1, 1, 2, a2, - 2, 2, 2, b2, - 1, 2, 2, ab2 -) - test_that("2 endpoints 2 analysis correlation as expected", { + res <- test_generate_corr_new() + a1 <- res$a1 + b1 <- res$b1 + ab1 <- res$ab1 + a2 <- res$a2 + b2 <- res$b2 + ab2 <- res$ab2 + event <- res$event + corr <- generate_corr_new(event) corr_test <- matrix( c( @@ -144,8 +22,7 @@ test_that("2 endpoints 2 analysis correlation as expected", { expect_equal(matrix(corr %>% as.numeric(), nrow = 4, byrow = TRUE), corr_test) }) - -# this is a 2 hypothesis, 3 analysis example +# This is a 2 hypothesis, 3 analysis example test_that("2 hypotheses 3 analysis correlation as expected", { event <- tibble::tribble( ~Analysis, ~H1, ~H2, ~Event,