1444: add CMH with Wilson-Hilferty transformation

DESCRIPTION

@@ -29,7 +29,7 @@ URL: https://insightsengineering.github.io/tern/,
 BugReports: https://github.com/insightsengineering/tern/issues
 Depends:
     R (>= 4.4.0),
-    rtables (>= 0.6.13)
+    rtables (>= 0.6.14)
 Imports:
     broom (>= 1.0.8),
     car (>= 3.1-3),
@@ -38,7 +38,7 @@ Imports:
     dplyr (>= 1.0.0),
     emmeans (>= 1.10.4),
     forcats (>= 1.0.0),
-    formatters (>= 0.5.11),
+    formatters (>= 0.5.12),
     ggplot2 (>= 3.5.0),
     grid,
     gridExtra (>= 2.0.0),
@@ -67,6 +67,9 @@ Suggests:
     svglite (>= 2.1.2),
     testthat (>= 3.1.9),
     withr (>= 2.0.0)
+Remotes:
+    insightsengineering/formatters@main,
+    insightsengineering/rtables@main
 VignetteBuilder:
     knitr,
     rmarkdown

NEWS.md

@@ -2,6 +2,7 @@
 
 ### Enhancements
 * Added `alternative` argument to `test_proportion_diff()` to allow one-sided hypothesis testing.
+* Added `wh` (CMH with Wilson-Hilferty transformation) method to `test_proportion_diff()` for stratified proportion difference testing.
 
 ### Bug Fixes
 * Fixed bug in `tabulate_rsp_subgroups()` and `tabulate_survival_subgroups()` preventing risk difference column format specified via `control_riskdiff()` from being applied.

R/prop_diff_test.R

@@ -9,8 +9,8 @@
 #' supplied via the `strata` element of the `variables` argument.
 #'
 #' @inheritParams argument_convention
-#' @param method (`string`)\cr one of `chisq`, `cmh`, `fisher`, or `schouten`; specifies the test used
-#'   to calculate the p-value.
+#' @param method (`string`)\cr one of `chisq`, `cmh`, `cmh_wh`, `fisher`, or `schouten`;
+#'   specifies the test used to calculate the p-value.
 #' @param .stats (`character`)\cr statistics to select for the table.
 #'
 #'   Options are: ``r shQuote(get_stats("test_proportion_diff"), type = "sh")``
@@ -53,7 +53,7 @@
                                    .ref_group,
                                    .in_ref_col,
                                    variables = list(strata = NULL),
-                                   method = c("chisq", "schouten", "fisher", "cmh"),
+                                   method = c("chisq", "schouten", "fisher", "cmh", "cmh_wh"),
                                    alternative = c("two.sided", "less", "greater"),
                                    ...) {
   method <- match.arg(method)
@@ -71,7 +71,7 @@
       levels = c("ref", "Not-ref")
     )
 
-    if (!is.null(variables$strata) || method == "cmh") {
+    if (!is.null(variables$strata) || method %in% c("cmh", "cmh_wh")) {
       strata <- variables$strata
       checkmate::assert_false(is.null(strata))
       strata_vars <- stats::setNames(as.list(strata), strata)
@@ -82,14 +82,16 @@
 
     tbl <- switch(method,
       cmh = table(grp, rsp, strata),
+      cmh_wh = table(grp, rsp, strata),
       table(grp, rsp)
     )
 
     y$pval <- switch(method,
       chisq = prop_chisq(tbl, alternative = alternative),
       cmh = prop_cmh(tbl, alternative = alternative),
       fisher = prop_fisher(tbl, alternative = alternative),
-      schouten = prop_schouten(tbl, alternative = alternative)
+      schouten = prop_schouten(tbl, alternative = alternative),
+      cmh_wh = prop_cmh(tbl, alternative = alternative, transform = "wilson_hilferty")
     )
   }
 
@@ -116,6 +118,7 @@
     "schouten" = "Chi-Squared Test with Schouten Correction",
     "chisq" = "Chi-Squared Test",
     "cmh" = "Cochran-Mantel-Haenszel Test",
+    "cmh_wh" = "Cochran-Mantel-Haenszel Test with Wilson-Hilferty Transformation",
     "fisher" = "Fisher's Exact Test",
     stop(paste(method, "does not have a description"))
   )
@@ -197,8 +200,8 @@
     .formats = .formats,
     .names = names(.labels),
     .stat_names = .stat_names,
     .labels = .labels %>% .unlist_keep_nulls(),
     .indent_mods = .indent_mods %>% .unlist_keep_nulls()
   )
 }
 
@@ -232,7 +235,7 @@
 test_proportion_diff <- function(lyt,
                                  vars,
                                  variables = list(strata = NULL),
-                                 method = c("chisq", "schouten", "fisher", "cmh"),
+                                 method = c("chisq", "schouten", "fisher", "cmh", "cmh_wh"),
                                  alternative = c("two.sided", "less", "greater"),
                                  var_labels = vars,
                                  na_str = default_na_str(),
@@ -312,25 +315,48 @@
   stats::prop.test(tbl, correct = FALSE, alternative = alternative)$p.value
 }
 
-#' @describeIn h_prop_diff_test Performs stratified Cochran-Mantel-Haenszel test. Internally calls
-#'   [stats::mantelhaen.test()]. Note that strata with less than two observations are automatically discarded.
+#' @describeIn h_prop_diff_test Performs stratified Cochran-Mantel-Haenszel test,
+#'   using [stats::mantelhaen.test()] internally.
+#'   Note that strata with less than two observations are automatically discarded.
 #'
 #' @param ary (`array`, 3 dimensions)\cr array with two groups in rows, the binary response
 #'   (`TRUE`/`FALSE`) in columns, and the strata in the third dimension.
+#' @param transform (`string`)\cr either `none` or `wilson_hilferty`; specifies whether to apply
+#'   the Wilson-Hilferty transformation of the chi-squared statistic.
 #'
 #' @keywords internal
-prop_cmh <- function(ary, alternative = c("two.sided", "less", "greater")) {
+prop_cmh <- function(ary,
+                     alternative = c("two.sided", "less", "greater"),
+                     transform = c("none", "wilson_hilferty")) {
   checkmate::assert_array(ary)
   checkmate::assert_integer(c(ncol(ary), nrow(ary)), lower = 2, upper = 2)
   checkmate::assert_integer(length(dim(ary)), lower = 3, upper = 3)
+  alternative <- match.arg(alternative)
+  transform <- match.arg(transform)
 
   strata_sizes <- apply(ary, MARGIN = 3, sum)
   if (any(strata_sizes < 5)) {
     warning("<5 data points in some strata. CMH test may be incorrect.")
     ary <- ary[, , strata_sizes > 1]
   }
 
-  stats::mantelhaen.test(ary, correct = FALSE, alternative = alternative)$p.value
+  cmh_res <- stats::mantelhaen.test(ary, correct = FALSE, alternative = alternative)
+
+  if (transform == "none") {
+    cmh_res$p.value
+  } else {
+    chisq_stat <- unname(cmh_res$statistic)
+    df <- unname(cmh_res$parameter)
+    num <- (chisq_stat / df)^(1 / 3) - (1 - 2 / (9 * df))
+    denom <- sqrt(2 / (9 * df))
+    wh_stat <- num / denom
+
+    if (alternative == "two.sided") {
+      2 * stats::pnorm(-abs(wh_stat))
+    } else {
+      stats::pnorm(wh_stat, lower.tail = (alternative == "greater"))
+    }
+  }
 }
 
 #' @describeIn h_prop_diff_test Performs the Chi-Squared test with Schouten correction.

inst/WORDLIST

@@ -17,6 +17,7 @@ Coull
 Forkers
 Haenszel
 Hauck
+Hilferty
 Hoffmann
 Jeffreys
 Kaplan