1445: Add cmh_sato method to estimate_proportion_diff()

.lintr

@@ -2,5 +2,6 @@ linters: linters_with_defaults(
   line_length_linter = line_length_linter(120),
   cyclocomp_linter = NULL,
   object_usage_linter = NULL,
-  object_length_linter = NULL
+  object_length_linter = NULL,
+  pipe_consistency_linter = NULL
   )

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.9000)
 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 `cmh_sato` method to `estimate_proportion_diff()` for Cochran-Mantel-Haenszel proportion difference confidence interval using Sato variance estimator.
 
 ### 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.R

@@ -8,6 +8,19 @@
 #' constructing the confidence interval of the proportion difference. A stratification variable can be supplied via the
 #' `strata` element of the `variables` argument.
 #'
+#' @details The possible methods are:
+#'
+#' - `"waldcc"`: Wald confidence interval with continuity correction \insertCite{Agresti1998}{tern}.
+#' - `"wald"`: Wald confidence interval without continuity correction \insertCite{Agresti1998}{tern}.
+#' - `"cmh"`: Cochran-Mantel-Haenszel (CMH) confidence interval \insertCite{MantelHaenszel1959}{tern}.
+#' - `"cmh_sato"`: CMH confidence interval with Sato variance estimator \insertCite{Sato1989}{tern}.
+#' - `"ha"`: Anderson-Hauck confidence interval \insertCite{HauckAnderson1986}{tern}.
+#' - `"newcombe"`: Newcombe confidence interval without continuity correction \insertCite{Newcombe1998}{tern}.
+#' - `"newcombecc"`: Newcombe confidence interval with continuity correction \insertCite{Newcombe1998}{tern}.
+#' - `"strat_newcombe"`: Stratified Newcombe confidence interval without continuity
+#'     correction \insertCite{Yan2010-jt}{tern}.
+#' - `"strat_newcombecc"`: Stratified Newcombe confidence interval with continuity
+#'     correction \insertCite{Yan2010-jt}{tern}.
 #'
 #' @inheritParams prop_diff_strat_nc
 #' @inheritParams argument_convention
@@ -18,6 +31,9 @@
 #'
 #' @seealso [d_proportion_diff()]
 #'
+#' @references
+#'   \insertAllCited{}
+#'
 #' @name prop_diff
 #' @order 1
 NULL
@@ -28,8 +44,8 @@ NULL
 #' @return
 #' * `s_proportion_diff()` returns a named list of elements `diff` and `diff_ci`.
 #'
-#' @note When performing an unstratified analysis, methods `"cmh"`, `"strat_newcombe"`, and `"strat_newcombecc"` are
-#'   not permitted.
+#' @note When performing an unstratified analysis, methods `"cmh"`, `"cmh_sato"`, `"strat_newcombe"`,
+#'   and `"strat_newcombecc"` are not permitted.
 #'
 #' @examples
 #' s_proportion_diff(
@@ -60,16 +76,20 @@ s_proportion_diff <- function(df,
                               variables = list(strata = NULL),
                               conf_level = 0.95,
                               method = c(
-                                "waldcc", "wald", "cmh",
+                                "waldcc", "wald", "cmh", "cmh_sato",
                                 "ha", "newcombe", "newcombecc",
                                 "strat_newcombe", "strat_newcombecc"
                               ),
                               weights_method = "cmh",
                               ...) {
   method <- match.arg(method)
-  if (is.null(variables$strata) && checkmate::test_subset(method, c("cmh", "strat_newcombe", "strat_newcombecc"))) {
+  if (
+    is.null(variables$strata) &&
+      checkmate::test_subset(method, c("cmh", "cmh_sato", "strat_newcombe", "strat_newcombecc"))
+  ) {
     stop(paste(
-      "When performing an unstratified analysis, methods 'cmh', 'strat_newcombe', and 'strat_newcombecc' are not",
+      "When performing an unstratified analysis, methods",
+      "'cmh', 'cmh_sato', 'strat_newcombe', and 'strat_newcombecc' are not",
       "permitted. Please choose a different method."
     ))
   }
@@ -128,7 +148,8 @@ s_proportion_diff <- function(df,
         conf_level,
         correct = TRUE
       ),
-      "cmh" = prop_diff_cmh(rsp, grp, strata, conf_level)[c("diff", "diff_ci")]
+      "cmh" = prop_diff_cmh(rsp, grp, strata, conf_level, diff_se = "standard")[c("diff", "diff_ci")],
+      "cmh_sato" = prop_diff_cmh(rsp, grp, strata, conf_level, diff_se = "sato")[c("diff", "diff_ci")]
     )
 
     y$diff <- setNames(y$diff * 100, paste0("diff_", method))
@@ -266,7 +287,7 @@ estimate_proportion_diff <- function(lyt,
                                      variables = list(strata = NULL),
                                      conf_level = 0.95,
                                      method = c(
-                                       "waldcc", "wald", "cmh",
+                                       "waldcc", "wald", "cmh", "cmh_sato",
                                        "ha", "newcombe", "newcombecc",
                                        "strat_newcombe", "strat_newcombecc"
                                      ),
@@ -387,7 +408,7 @@ d_proportion_diff <- function(conf_level,
     label <- paste(
       label,
       ifelse(
-        method == "cmh",
+        method %in% c("cmh", "cmh_sato"),
         "for adjusted difference",
         "for difference"
       )
@@ -396,6 +417,7 @@ d_proportion_diff <- function(conf_level,
 
   method_part <- switch(method,
     "cmh" = "CMH, without correction",
+    "cmh_sato" = "CMH, Sato variance estimator",
     "waldcc" = "Wald, with correction",
     "wald" = "Wald, without correction",
     "ha" = "Anderson-Hauck",
@@ -422,6 +444,9 @@ d_proportion_diff <- function(conf_level,
 #'
 #' @seealso [prop_diff()] for implementation of these helper functions.
 #'
+#' @references
+#'   \insertAllCited{}
+#'
 #' @name h_prop_diff
 NULL
 
@@ -475,7 +500,7 @@ prop_diff_wald <- function(rsp,
   )
 }
 
-#' @describeIn h_prop_diff Anderson-Hauck confidence interval.
+#' @describeIn h_prop_diff Anderson-Hauck confidence interval \insertCite{HauckAnderson1986}{tern}.
 #'
 #' @examples
 #' # Anderson-Hauck confidence interval
@@ -513,7 +538,7 @@ prop_diff_ha <- function(rsp,
 }
 
 #' @describeIn h_prop_diff Newcombe confidence interval. It is based on
-#'   the Wilson score confidence interval for a single binomial proportion.
+#'   the Wilson score confidence interval for a single binomial proportion \insertCite{Newcombe1998}{tern}.
 #'
 #' @examples
 #' # Newcombe confidence interval
@@ -563,6 +588,8 @@ prop_diff_nc <- function(rsp,
 #'   test, use [stats::mantelhaen.test()].
 #'
 #' @param strata (`factor`)\cr variable with one level per stratum and same length as `rsp`.
+#' @param diff_se (`string`)\cr method to estimate the standard error for the difference, either
+#'   `standard` or `sato` \insertCite{Sato1989}{tern}.
 #'
 #' @examples
 #' # Cochran-Mantel-Haenszel confidence interval
@@ -581,14 +608,20 @@ prop_diff_nc <- function(rsp,
 #'   rsp = rsp, grp = grp, strata = interaction(strata_data),
 #'   conf_level = 0.90
 #' )
+#' prop_diff_cmh(
+#'   rsp = rsp, grp = grp, strata = interaction(strata_data),
+#'   conf_level = 0.90, diff_se = "sato"
+#' )
 #'
 #' @export
 prop_diff_cmh <- function(rsp,
                           grp,
                           strata,
-                          conf_level = 0.95) {
+                          conf_level = 0.95,
+                          diff_se = c("standard", "sato")) {
   grp <- as_factor_keep_attributes(grp)
   strata <- as_factor_keep_attributes(strata)
+  diff_se <- match.arg(diff_se)
   check_diff_prop_ci(
     rsp = rsp, grp = grp, conf_level = conf_level, strata = strata
   )
@@ -632,14 +665,25 @@ prop_diff_cmh <- function(rsp,
   estimate_ci <- list(ci1, ci2)
   names(estimate_ci) <- levels(grp)
   diff_est <- est2 - est1
-  se_diff <- sqrt(sum(((p1 * (1 - p1) / n1) + (p2 * (1 - p2) / n2)) * wt_normalized^2))
+
+  se_diff <- if (diff_se == "standard") {
+    sqrt(sum(((p1 * (1 - p1) / n1) + (p2 * (1 - p2) / n2)) * wt_normalized^2))
+  } else {
+    # Sato variance estimator.
+    p_terms <- (n2^2 * t_tbl[2, 1, ] - n1^2 * t_tbl[2, 2, ] + n1 * n2 * (n1 - n2) / 2) / (n1 + n2)^2
+    q_terms <- (t_tbl[2, 1, ] * (n2 - t_tbl[2, 2, ]) + t_tbl[2, 2, ] * (n1 - t_tbl[2, 1, ])) / (2 * (n1 + n2))
+    num <- diff_est * sum(p_terms) + sum(q_terms)
+    denom <- sum(wt)^2
+    sqrt(num / denom)
+  }
   diff_ci <- c(diff_est - z * se_diff, diff_est + z * se_diff)
 
   list(
     prop = estimate,
     prop_ci = estimate_ci,
     diff = diff_est,
     diff_ci = diff_ci,
+    se_diff = se_diff,
     weights = wt_normalized,
     n1 = n1,
     n2 = n2
@@ -656,9 +700,6 @@ prop_diff_cmh <- function(rsp,
 #' @param weights_method (`string`)\cr weights method. Can be either `"cmh"` or `"heuristic"`
 #'   and directs the way weights are estimated.
 #'
-#' @references
-#' \insertRef{Yan2010-jt}{tern}
-#'
 #' @examples
 #' # Stratified Newcombe confidence interval
 #'

inst/REFERENCES.bib

@@ -1,5 +1,16 @@
 % Encoding: UTF-8
 
+@article{Agresti1998,
+  author = {Agresti, Alan and Coull, Brent A.},
+  title = {Approximate is Better than "Exact" for Interval Estimation of Binomial Proportions},
+  journal = {The American Statistician},
+  volume = {52},
+  number = {2},
+  pages = {119--126},
+  year = {1998},
+  doi = {10.1080/00031305.1998.10480550}
+}
+
 @ARTICLE{Yan2010-jt,
   title     = "Stratified Wilson and Newcombe Confidence Intervals for Multiple
                Binomial Proportions",
@@ -71,3 +82,47 @@ @ARTICLE{bland1986statistical
   year      ="1986",
   language  = "en"
 }
+
+@article{HauckAnderson1986,
+ author = {Walter W. Hauck and Sharon Anderson},
+ journal = {The American Statistician},
+ number = {4},
+ pages = {318--322},
+ title = {A Comparison of Large-Sample Confidence Interval Methods for the Difference of Two Binomial Probabilities},
+ urldate = {2025-12-08},
+ volume = {40},
+ year = {1986},
+ doi = {10.2307/2684618}
+}
+
+@article{Newcombe1998,
+author = {Newcombe, Robert G.},
+title = {Interval estimation for the difference between independent proportions: comparison of eleven methods},
+journal = {Statistics in Medicine},
+volume = {17},
+number = {8},
+pages = {873-890},
+doi = {10.1002/(SICI)1097-0258(19980430)17:8<873::AID-SIM779>3.0.CO;2-I},
+year = {1998}
+}
+
+@article{MantelHaenszel1959,
+  title = {Statistical aspects of the analysis of data from retrospective studies of disease},
+  author = {Mantel, N. and Haenszel, W.},
+  journal = {Journal of the National Cancer Institute},
+  volume = {22},
+  number = {4},
+  pages = {719--748},
+  year = {1959}
+}
+
+@article{Sato1989,
+  title = {On the variance estimator for the Mantel-Haenszel Risk Difference},
+  author = {Sato, Tosiya and Greenland, Sander and Robins, James M.},
+  journal = {Biometrics},
+  volume = {45},
+  number = {4},
+  pages = {1323--1324},
+  year = {1989},
+  url = {http://www.jstor.org/stable/2531784}
+}

inst/WORDLIST

@@ -29,6 +29,7 @@ Pre
 Rua
 SMQ
 Sabanés
+Sato
 Satterthwaite
 Schouten
 TLG