From cedbf5cf4bd21ad731fe762c5303c55184898afc Mon Sep 17 00:00:00 2001 From: Wojtek Date: Thu, 27 Aug 2026 10:35:57 +0200 Subject: [PATCH 1/9] Add Mantel-Fleiss criterion function mantel_fleiss_crit() (No units tests yet). --- NAMESPACE | 1 + NEWS.md | 2 + R/prop_diff_test.R | 138 ++++++++++++++++++++++++++++++++++++++ man/mantel_fleiss_crit.Rd | 96 ++++++++++++++++++++++++++ 4 files changed, 237 insertions(+) create mode 100644 man/mantel_fleiss_crit.Rd diff --git a/NAMESPACE b/NAMESPACE index 0afd85824e..f7cd7b31b5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -248,6 +248,7 @@ export(labels_use_control) export(level_order) export(logistic_regression_cols) export(logistic_summary_by_flag) +export(mantel_fleiss_crit) export(month2day) export(or_clogit) export(or_glm) diff --git a/NEWS.md b/NEWS.md index e78982c4da..c22b73c0f7 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,8 @@ # tern 0.9.11.9000 ### Enhancements +* Added `mantel_fleiss_crit()` to check the Mantel-Fleiss criterion + for stratified 2 x 2 contingency tables.(#1512) * Updated `g_forest()` to support point estimates and confidence intervals stored in a single column. (#1499) * Added the `exclude_rows` argument to `g_forest()` to allow excluding selected diff --git a/R/prop_diff_test.R b/R/prop_diff_test.R index f36647379d..611db9ba9c 100644 --- a/R/prop_diff_test.R +++ b/R/prop_diff_test.R @@ -481,3 +481,141 @@ prop_fisher <- function(tbl, alternative = c("two.sided", "less", "greater")) { tbl <- tbl[, c("TRUE", "FALSE")] stats::fisher.test(tbl, alternative = alternative)$p.value } + +#' @title Check the Mantel-Fleiss Criterion +#' +#' @description `r lifecycle::badge("stable")` +#' +#' Computes the Mantel-Fleiss criterion for stratified 2 x 2 contingency tables +#' defined by a group variable, a binary response variable, and stratification +#' variable. +#' +#' @details +#' The Mantel-Fleiss statistic is calculated as +#' +#' \deqn{ +#' MF = \min\left( +#' [\sum_h m_{11h} - \sum_h (n_{11h})L],\ +#' [\sum_h (n{11h})U - \sum_h m{11h}] +#' \right). +#' } +#' +#' Here, \eqn{h} indexes the strata. For each stratum \eqn{h}, the expected +#' frequency of cell \eqn{(1, 1)} under the hypothesis of no association +#' between group and response is +#' +#' \deqn{ +#' m_{11h} = \frac{n_{1.h} n_{.1h}}{n_h}. +#' } +#' +#' The lower and upper bounds for \eqn{n_{11h}}, given the marginal totals, +#' are: +#' +#' \deqn{ +#' (n_{11h})L = \max(0, n{1.h} - n_{.2h}), +#' } +#' \deqn{ +#' (n_{11h})U = \min(n{.1h}, n_{1.h}). +#' } +#' +#' The Mantel-Fleiss criterion is satisfied when \eqn{MF \ge 5}. +#' +#' @param grp (`factor`)\cr +#' A factor assigning observations to one of two groups (e.g., reference +#' and treatment). It must have exactly two levels. +#' @param rsp (`logical`)\cr +#' A logical vector indicating whether each observation is a responder. +#' @param strata (`factor` or `NULL`)\cr +#' An optional factor defining the stratification variable. Each unique +#' stratum defines a separate 2 x 2 contingency table. If `NULL`, an +#' unstratified analysis is performed. +#' @param details (`logical(1)`)\cr +#' Whether to attach the calculated Mantel-Fleiss statistic and criterion +#' to the returned value as attributes. +#' +#' @return A logical value indicating whether the Mantel-Fleiss criterion +#' is satisfied. +#' If `details = TRUE`, the result has two additional attributes: +#' `value`, containing the calculated Mantel-Fleiss statistic, +#' and `criterion`, containing the criterion used for evaluation. +#' +#' @author WW +#' +#' @examples +#' set.seed(123) +#' n <- 40 +#' +#' grp <- factor(sample(c("Active", "Control"), n, replace = TRUE)) +#' rsp <- sample(c(TRUE, FALSE), n, replace = TRUE) +#' strata1 <- factor(sample(c("A", "B"), n, replace = TRUE)) +#' strata2 <- factor(sample(c("x", "y"), n, replace = TRUE)) +#' strata <- interaction(strata1, strata2) +#' +#' table(grp, rsp, strata) +#' +#' mantel_fleiss_crit(grp, rsp, strata) +#' mantel_fleiss_crit(grp, rsp, strata, details = TRUE) +#' +#' @references +#' Mantel, N., and Fleiss, J. L. (1980). +#' Minimum Expected Cell Size Requirements for the Mantel-Haenszel +#' One-Degree-of-Freedom Chi-Square Test and a Related Rapid Procedure. +#' \emph{American Journal of Epidemiology}, 112(1), 129--134 +#' +#' SAS Institute Inc. \emph{SAS/STAT User's Guide: The FREQ Procedure}. +#' +#' @export +mantel_fleiss_crit <- function(grp, rsp, strata = NULL, details = FALSE) { + checkmate::assert_logical(rsp, any.missing = FALSE) + checkmate::assert_factor(grp, len = length(rsp), any.missing = FALSE, n.levels = 2) + checkmate::assert_factor(strata, len = length(rsp), any.missing = FALSE, null.ok = TRUE) + checkmate::assert_flag(details) + + # 1. Pre-process data + + # Make rsp a factor to handle cases with only TRUE or only FALSE. + rsp <- factor(rsp, levels = c("TRUE", "FALSE")) + + # Use a dummy stratum for an unstratified analysis. + strata <- if (is.null(strata)) { + rep("DUMMY", length(rsp)) + } else { + # Drop strata with no observations. + droplevels(strata) + } + + # The order of dimensions is important: group x response x stratum. + tbl <- table(grp, rsp, strata) + + # 2. Calculate Mantel-Fleiss criterion + + # Add marginal totals over the group and response dimensions, + # retaining the stratum dimension. + tbl_mrgn <- stats::addmargins(tbl, margin = 1:2) + + n_1.h <- tbl_mrgn[1L, "Sum", ] # nolintr + n_.1h <- tbl_mrgn["Sum", 1L, ] # nolintr + n_.2h <- tbl_mrgn["Sum", 2L, ] # nolintr + n_h <- tbl_mrgn["Sum", "Sum", ] # nolintr + + # Expected value of n_11h under the hypothesis of no association + # between group and response within stratum h. + m_11h <- (n_1.h * n_.1h) / n_h + # Lower (L) and upper (U) bounds for n_11h given the marginal totals. + n_11h_L <- pmax(0L, n_1.h - n_.2h) # nolintr + n_11h_U <- pmin(n_.1h, n_1.h) # nolintr + + MF <- min( # nolintr + sum(m_11h) - sum(n_11h_L), + sum(n_11h_U) - sum(m_11h) + ) + + crit <- quote(MF >= 5) + is_satisfied <- eval(crit) + if (details) { + attr(is_satisfied, "value") <- MF + attr(is_satisfied, "criterion") <- deparse(crit) + } + + is_satisfied +} diff --git a/man/mantel_fleiss_crit.Rd b/man/mantel_fleiss_crit.Rd new file mode 100644 index 0000000000..92cc4ce2e1 --- /dev/null +++ b/man/mantel_fleiss_crit.Rd @@ -0,0 +1,96 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prop_diff_test.R +\name{mantel_fleiss_crit} +\alias{mantel_fleiss_crit} +\title{Check the Mantel-Fleiss Criterion} +\usage{ +mantel_fleiss_crit(grp, rsp, strata = NULL, details = FALSE) +} +\arguments{ +\item{grp}{(\code{factor})\cr +A factor assigning observations to one of two groups (e.g., reference +and treatment). It must have exactly two levels.} + +\item{rsp}{(\code{logical})\cr +A logical vector indicating whether each observation is a responder.} + +\item{strata}{(\code{factor} or \code{NULL})\cr +An optional factor defining the stratification variable. Each unique +stratum defines a separate 2 x 2 contingency table. If \code{NULL}, an +unstratified analysis is performed.} + +\item{details}{(\code{logical(1)})\cr +Whether to attach the calculated Mantel-Fleiss statistic and criterion +to the returned value as attributes.} +} +\value{ +A logical value indicating whether the Mantel-Fleiss criterion +is satisfied. +If \code{details = TRUE}, the result has two additional attributes: +\code{value}, containing the calculated Mantel-Fleiss statistic, +and \code{criterion}, containing the criterion used for evaluation. +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} + +Computes the Mantel-Fleiss criterion for stratified 2 x 2 contingency tables +defined by a group variable, a binary response variable, and stratification +variable. +} +\details{ +The Mantel-Fleiss statistic is calculated as + +\deqn{ +MF = \min\left( +[\sum_h m_{11h} - \sum_h (n_{11h})L],\ +[\sum_h (n{11h})U - \sum_h m{11h}] +\right). +} + +Here, \eqn{h} indexes the strata. For each stratum \eqn{h}, the expected +frequency of cell \eqn{(1, 1)} under the hypothesis of no association +between group and response is + +\deqn{ +m_{11h} = \frac{n_{1.h} n_{.1h}}{n_h}. +} + +The lower and upper bounds for \eqn{n_{11h}}, given the marginal totals, +are: + +\deqn{ +(n_{11h})L = \max(0, n{1.h} - n_{.2h}), +} +\deqn{ +(n_{11h})U = \min(n{.1h}, n_{1.h}). +} + +The Mantel-Fleiss criterion is satisfied when \eqn{MF \ge 5}. +} +\examples{ +set.seed(123) +n <- 40 + +grp <- factor(sample(c("Active", "Control"), n, replace = TRUE)) +rsp <- sample(c(TRUE, FALSE), n, replace = TRUE) +strata1 <- factor(sample(c("A", "B"), n, replace = TRUE)) +strata2 <- factor(sample(c("x", "y"), n, replace = TRUE)) +strata <- interaction(strata1, strata2) + +table(grp, rsp, strata) + +mantel_fleiss_crit(grp, rsp, strata) +mantel_fleiss_crit(grp, rsp, strata, details = TRUE) + +} +\references{ +Mantel, N., and Fleiss, J. L. (1980). +Minimum Expected Cell Size Requirements for the Mantel-Haenszel +One-Degree-of-Freedom Chi-Square Test and a Related Rapid Procedure. +\emph{American Journal of Epidemiology}, 112(1), 129--134 + +SAS Institute Inc. \emph{SAS/STAT User's Guide: The FREQ Procedure}. +} +\author{ +WW +} From 10fcc222a8b46256119ffe29e88533302a8754e7 Mon Sep 17 00:00:00 2001 From: Wojtek Date: Thu, 27 Aug 2026 10:40:21 +0200 Subject: [PATCH 2/9] WORDLIST update (Fleiss) --- inst/WORDLIST | 1 + 1 file changed, 1 insertion(+) diff --git a/inst/WORDLIST b/inst/WORDLIST index fd4ab057f3..0c77c4e15a 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -15,6 +15,7 @@ CMH CQ Clopper Coull +Fleiss Haenszel Hauck Hilferty From 54e011323c31f09369491715ff46bc589e2d7977 Mon Sep 17 00:00:00 2001 From: Wojtek Date: Thu, 27 Aug 2026 10:47:26 +0200 Subject: [PATCH 3/9] pkgdown update. --- R/prop_diff_test.R | 4 ++-- _pkgdown.yml | 1 + 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/R/prop_diff_test.R b/R/prop_diff_test.R index 611db9ba9c..ac14986f5a 100644 --- a/R/prop_diff_test.R +++ b/R/prop_diff_test.R @@ -584,11 +584,11 @@ mantel_fleiss_crit <- function(grp, rsp, strata = NULL, details = FALSE) { droplevels(strata) } + # 2. Calculate Mantel-Fleiss criterion + # The order of dimensions is important: group x response x stratum. tbl <- table(grp, rsp, strata) - # 2. Calculate Mantel-Fleiss criterion - # Add marginal totals over the group and response dimensions, # retaining the stratum dimension. tbl_mrgn <- stats::addmargins(tbl, margin = 1:2) diff --git a/_pkgdown.yml b/_pkgdown.yml index d6e0e13c6f..06ce089982 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -113,6 +113,7 @@ reference: - -h_xticks - -prop_diff - check_diff_prop_ci + - mantel_fleiss_crit - title: rtables Helper Functions desc: These functions help to work with the `rtables` package and may be From 301ddbfc8f5ca6532a59136b2def5f0132e28fce Mon Sep 17 00:00:00 2001 From: Wojtek Date: Thu, 27 Aug 2026 12:20:53 +0200 Subject: [PATCH 4/9] update mantel_fleiss_crit() after PR review and add basic unit tests. --- R/prop_diff_test.R | 12 +-- man/mantel_fleiss_crit.Rd | 2 - tests/testthat/test-mantel_fleiss_crit.R | 129 +++++++++++++++++++++++ 3 files changed, 134 insertions(+), 9 deletions(-) create mode 100644 tests/testthat/test-mantel_fleiss_crit.R diff --git a/R/prop_diff_test.R b/R/prop_diff_test.R index ac14986f5a..3c31c5c67d 100644 --- a/R/prop_diff_test.R +++ b/R/prop_diff_test.R @@ -562,8 +562,6 @@ prop_fisher <- function(tbl, alternative = c("two.sided", "less", "greater")) { #' One-Degree-of-Freedom Chi-Square Test and a Related Rapid Procedure. #' \emph{American Journal of Epidemiology}, 112(1), 129--134 #' -#' SAS Institute Inc. \emph{SAS/STAT User's Guide: The FREQ Procedure}. -#' #' @export mantel_fleiss_crit <- function(grp, rsp, strata = NULL, details = FALSE) { checkmate::assert_logical(rsp, any.missing = FALSE) @@ -601,13 +599,13 @@ mantel_fleiss_crit <- function(grp, rsp, strata = NULL, details = FALSE) { # Expected value of n_11h under the hypothesis of no association # between group and response within stratum h. m_11h <- (n_1.h * n_.1h) / n_h - # Lower (L) and upper (U) bounds for n_11h given the marginal totals. - n_11h_L <- pmax(0L, n_1.h - n_.2h) # nolintr - n_11h_U <- pmin(n_.1h, n_1.h) # nolintr + # Lower and upper bounds for n_11h given the marginal totals. + n_11h_lwr <- pmax(0L, n_1.h - n_.2h) + n_11h_upr <- pmin(n_.1h, n_1.h) MF <- min( # nolintr - sum(m_11h) - sum(n_11h_L), - sum(n_11h_U) - sum(m_11h) + sum(m_11h) - sum(n_11h_lwr), + sum(n_11h_upr) - sum(m_11h) ) crit <- quote(MF >= 5) diff --git a/man/mantel_fleiss_crit.Rd b/man/mantel_fleiss_crit.Rd index 92cc4ce2e1..b295995449 100644 --- a/man/mantel_fleiss_crit.Rd +++ b/man/mantel_fleiss_crit.Rd @@ -88,8 +88,6 @@ Mantel, N., and Fleiss, J. L. (1980). Minimum Expected Cell Size Requirements for the Mantel-Haenszel One-Degree-of-Freedom Chi-Square Test and a Related Rapid Procedure. \emph{American Journal of Epidemiology}, 112(1), 129--134 - -SAS Institute Inc. \emph{SAS/STAT User's Guide: The FREQ Procedure}. } \author{ WW diff --git a/tests/testthat/test-mantel_fleiss_crit.R b/tests/testthat/test-mantel_fleiss_crit.R new file mode 100644 index 0000000000..f1f183bc34 --- /dev/null +++ b/tests/testthat/test-mantel_fleiss_crit.R @@ -0,0 +1,129 @@ +test_that("mantel_fleiss_crit() works with multiple observations and strata", { + set.seed(123) + n <- 100 + grp <- factor(sample(c("Active", "Control"), n, replace = TRUE)) + rsp <- sample(c(TRUE, FALSE), n, replace = TRUE) + strata <- factor(sample(LETTERS[1:4], n, replace = TRUE)) + + expect_silent( + result <- mantel_fleiss_crit(grp, rsp, strata) + ) + expect_silent( + result_det <- mantel_fleiss_crit(grp, rsp, strata, TRUE) + ) + + expect_identical(result, TRUE) + expect_identical(result_det, result, ignore_attr = TRUE) + expect_equal( + attributes(result_det), + list(value = 20.16857, criterion = "MF >= 5"), + tolerance = 1e-6 + ) +}) + +test_that("mantel_fleiss_crit() works with small stratified data", { + set.seed(123) + n <- 20 + grp <- factor(sample(c("Active", "Control"), n, replace = TRUE)) + rsp <- sample(c(TRUE, FALSE), n, replace = TRUE) + strata <- factor(sample(LETTERS[1:4], n, replace = TRUE)) + + expect_silent( + result <- mantel_fleiss_crit(grp, rsp, strata) + ) + expect_silent( + result_det <- mantel_fleiss_crit(grp, rsp, strata, TRUE) + ) + + expect_identical(result, FALSE) + expect_identical(result_det, result, ignore_attr = TRUE) + expect_equal( + attributes(result_det), + list(value = 2.785714, criterion = "MF >= 5"), + tolerance = 1e-6 + ) +}) + +test_that("mantel_fleiss_crit() works without strata", { + set.seed(123) + n <- 20 + grp <- factor(sample(c("Active", "Control"), n, replace = TRUE)) + rsp <- sample(c(TRUE, FALSE), n, replace = TRUE) + + # No explicit strata. + expect_silent( + result <- mantel_fleiss_crit(grp, rsp) + ) + expect_silent( + result_det <- mantel_fleiss_crit(grp, rsp, details = TRUE) + ) + + # Explicit stratum. + expect_silent( + result_1stratum <- mantel_fleiss_crit(grp, rsp, factor(rep("A", n))) + ) + expect_silent( + result_1stratum_det <- mantel_fleiss_crit(grp, rsp, factor(rep("A", n)), TRUE) + ) + + expect_identical(result, result_1stratum) + expect_identical(result_det, result_1stratum_det) + + expect_identical(result, FALSE) + expect_identical(result_det, result, ignore_attr = TRUE) + expect_equal( + attributes(result_det), + list(value = 3.6, criterion = "MF >= 5"), + tolerance = 1e-6 + ) +}) + +test_that("mantel_fleiss_crit() ignores unused strata levels", { + set.seed(123) + n <- 40 + + grp <- factor(sample(c("Active", "Control"), n, replace = TRUE)) + rsp <- sample(c(TRUE, FALSE), n, replace = TRUE) + strata <- factor( + sample(LETTERS[1:3], n, replace = TRUE), + levels = LETTERS[1:4] + ) + + expect_silent( + result <- mantel_fleiss_crit(grp, rsp, strata) + ) + expect_silent( + result_det <- mantel_fleiss_crit(grp, rsp, strata, TRUE) + ) + + expect_identical(result, TRUE) + expect_identical(result_det, result, ignore_attr = TRUE) + expect_equal( + attributes(result_det), + list(value = 5.73951, criterion = "MF >= 5"), + tolerance = 1e-6 + ) +}) + +test_that("mantel_fleiss_crit() handles a stratum with observations in one cell only", { + grp <- factor(c("Act", "Act", "Cntrl", "Cntrl", "Act", "Act", "Act", "Act")) + rsp <- c(TRUE, FALSE, TRUE, FALSE, TRUE, TRUE, TRUE, TRUE) + strata <- factor(c(rep("A", 4), rep("B", 4))) + + result <- mantel_fleiss_crit(grp, rsp, strata, details = TRUE) + + expect_silent( + result <- mantel_fleiss_crit(grp, rsp, strata) + ) + expect_silent( + result_det <- mantel_fleiss_crit(grp, rsp, strata, TRUE) + ) + + expect_identical(result, FALSE) + expect_identical(result_det, result, ignore_attr = TRUE) + expect_equal( + attributes(result_det), + list(value = 1, criterion = "MF >= 5"), + tolerance = 1e-6 + ) +}) From 1de3a4640d73db214ba3bda8dc30916ba15e8ade Mon Sep 17 00:00:00 2001 From: Wojtek Date: Thu, 27 Aug 2026 12:57:29 +0200 Subject: [PATCH 5/9] Add complete set of unit tests for mantel_fleiss_crit(). --- tests/testthat/test-mantel_fleiss_crit.R | 86 +++++++++++++++++++++--- 1 file changed, 78 insertions(+), 8 deletions(-) diff --git a/tests/testthat/test-mantel_fleiss_crit.R b/tests/testthat/test-mantel_fleiss_crit.R index f1f183bc34..d3516b6ae6 100644 --- a/tests/testthat/test-mantel_fleiss_crit.R +++ b/tests/testthat/test-mantel_fleiss_crit.R @@ -110,14 +110,8 @@ test_that("mantel_fleiss_crit() handles a stratum with observations in one cell rsp <- c(TRUE, FALSE, TRUE, FALSE, TRUE, TRUE, TRUE, TRUE) strata <- factor(c(rep("A", 4), rep("B", 4))) - result <- mantel_fleiss_crit(grp, rsp, strata, details = TRUE) - - expect_silent( - result <- mantel_fleiss_crit(grp, rsp, strata) - ) - expect_silent( - result_det <- mantel_fleiss_crit(grp, rsp, strata, TRUE) - ) + result <- mantel_fleiss_crit(grp, rsp, strata) + result_det <- mantel_fleiss_crit(grp, rsp, strata, TRUE) expect_identical(result, FALSE) expect_identical(result_det, result, ignore_attr = TRUE) @@ -127,3 +121,79 @@ test_that("mantel_fleiss_crit() handles a stratum with observations in one cell tolerance = 1e-6 ) }) + +test_that("mantel_fleiss_crit() includes the MF = 5 boundary", { + grp <- factor(c(rep("Active", 10), rep("Control", 20))) + rsp <- c(rep(c(TRUE, FALSE), 5), rep(c(TRUE, FALSE), 10)) + + result <- mantel_fleiss_crit(grp, rsp, details = TRUE) + expect_identical(result, TRUE, ignore_attr = TRUE) + expect_identical(attributes(result), list(value = 5, criterion = "MF >= 5")) +}) + +test_that("mantel_fleiss_crit() handles only TRUE responses", { + grp <- factor(rep(c("Active", "Control"), each = 5)) + rsp <- rep(TRUE, 10) + strata <- factor(rep(c("A", "B"), each = 5)) + + result <- mantel_fleiss_crit(grp, rsp, strata) + result_det <- mantel_fleiss_crit(grp, rsp, strata, TRUE) + + expect_identical(result, FALSE) + expect_identical(result_det, result, ignore_attr = TRUE) + expect_identical(attributes(result_det), list(value = 0, criterion = "MF >= 5")) +}) + +test_that("mantel_fleiss_crit() handles only FALSE responses", { + grp <- factor(rep(c("Active", "Control"), each = 5)) + rsp <- rep(FALSE, 10) + strata <- factor(rep(c("A", "B"), each = 5)) + + result <- mantel_fleiss_crit(grp, rsp, strata) + result_det <- mantel_fleiss_crit(grp, rsp, strata, TRUE) + + expect_identical(result, FALSE) + expect_identical(result_det, result, ignore_attr = TRUE) + expect_identical(attributes(result_det), list(value = 0, criterion = "MF >= 5")) +}) + +test_that("mantel_fleiss_crit() works with observations from one group only", { + grp <- factor(rep("Active", 8), levels = c("Active", "Control")) + rsp <- c(TRUE, FALSE, TRUE, FALSE, TRUE, FALSE, TRUE, FALSE) + strata <- factor(rep(c("A", "B"), each = 4)) + + result <- mantel_fleiss_crit(grp, rsp, strata) + result_det <- mantel_fleiss_crit(grp, rsp, strata, TRUE) + + expect_identical(result, FALSE) + expect_identical(result_det, result, ignore_attr = TRUE) + expect_identical(attributes(result_det), list(value = 0, criterion = "MF >= 5")) +}) + +test_that("mantel_fleiss_crit() validates inputs", { + grp <- factor(c("G1", "G1", "G2", "G2")) + rsp <- c(TRUE, FALSE, TRUE, FALSE) + strata <- factor(c("A", "A", "B", "B")) + + # grp + expect_error(mantel_fleiss_crit(factor(rep("G1", 4)), rsp)) + expect_error(mantel_fleiss_crit(factor(grp, levels = c("G1", "G2", "X")), rsp)) + expect_error(mantel_fleiss_crit(as.character(grp), rsp)) + expect_error(mantel_fleiss_crit(as.numeric(grp), rsp)) + expect_error(mantel_fleiss_crit(c(grp[-1], NA), rsp)) + # rsp + expect_error(mantel_fleiss_crit(grp, as.character(rsp))) + expect_error(mantel_fleiss_crit(grp, as.numeric(rsp))) + expect_error(mantel_fleiss_crit(grp, c(rsp[-2], NA))) + # strata + expect_error(mantel_fleiss_crit(grp, rsp, as.character(strata))) + expect_error(mantel_fleiss_crit(grp, rsp, as.numeric(strata))) + expect_error(mantel_fleiss_crit(grp, rsp, c(strata[-3], NA))) + # details + expect_error(mantel_fleiss_crit(grp, rsp, strata, details = c(TRUE, FALSE))) + + # Different lengths. + expect_error(mantel_fleiss_crit(grp[-1], rsp)) + expect_error(mantel_fleiss_crit(grp, rsp[-1])) + expect_error(mantel_fleiss_crit(grp, rsp, strata[-2])) +}) From cc17869c9a710376a007787650034ad4c86e76f8 Mon Sep 17 00:00:00 2001 From: Wojtek Date: Thu, 27 Aug 2026 14:45:52 +0200 Subject: [PATCH 6/9] update mantel_fleiss_crit() after PR review. --- R/prop_diff_test.R | 56 ++++++++--------- man/mantel_fleiss_crit.Rd | 16 +++-- tests/testthat/test-mantel_fleiss_crit.R | 78 +++++++++--------------- 3 files changed, 62 insertions(+), 88 deletions(-) diff --git a/R/prop_diff_test.R b/R/prop_diff_test.R index 3c31c5c67d..354dabad17 100644 --- a/R/prop_diff_test.R +++ b/R/prop_diff_test.R @@ -529,15 +529,13 @@ prop_fisher <- function(tbl, alternative = c("two.sided", "less", "greater")) { #' An optional factor defining the stratification variable. Each unique #' stratum defines a separate 2 x 2 contingency table. If `NULL`, an #' unstratified analysis is performed. -#' @param details (`logical(1)`)\cr -#' Whether to attach the calculated Mantel-Fleiss statistic and criterion -#' to the returned value as attributes. +#' @param include_value (`logical(1)`)\cr +#' Whether to include the calculated Mantel-Fleiss statistic as an attribute +#' of the result. #' #' @return A logical value indicating whether the Mantel-Fleiss criterion -#' is satisfied. -#' If `details = TRUE`, the result has two additional attributes: -#' `value`, containing the calculated Mantel-Fleiss statistic, -#' and `criterion`, containing the criterion used for evaluation. +#' is satisfied. If `include_value = TRUE`, the result also contains a +#' `value` attribute with the calculated Mantel-Fleiss statistic. #' #' @author WW #' @@ -554,7 +552,7 @@ prop_fisher <- function(tbl, alternative = c("two.sided", "less", "greater")) { #' table(grp, rsp, strata) #' #' mantel_fleiss_crit(grp, rsp, strata) -#' mantel_fleiss_crit(grp, rsp, strata, details = TRUE) +#' mantel_fleiss_crit(grp, rsp, strata, include_value = TRUE) #' #' @references #' Mantel, N., and Fleiss, J. L. (1980). @@ -563,11 +561,11 @@ prop_fisher <- function(tbl, alternative = c("two.sided", "less", "greater")) { #' \emph{American Journal of Epidemiology}, 112(1), 129--134 #' #' @export -mantel_fleiss_crit <- function(grp, rsp, strata = NULL, details = FALSE) { +mantel_fleiss_crit <- function(grp, rsp, strata = NULL, include_value = FALSE) { checkmate::assert_logical(rsp, any.missing = FALSE) checkmate::assert_factor(grp, len = length(rsp), any.missing = FALSE, n.levels = 2) checkmate::assert_factor(strata, len = length(rsp), any.missing = FALSE, null.ok = TRUE) - checkmate::assert_flag(details) + checkmate::assert_flag(include_value) # 1. Pre-process data @@ -591,28 +589,26 @@ mantel_fleiss_crit <- function(grp, rsp, strata = NULL, details = FALSE) { # retaining the stratum dimension. tbl_mrgn <- stats::addmargins(tbl, margin = 1:2) - n_1.h <- tbl_mrgn[1L, "Sum", ] # nolintr - n_.1h <- tbl_mrgn["Sum", 1L, ] # nolintr - n_.2h <- tbl_mrgn["Sum", 2L, ] # nolintr - n_h <- tbl_mrgn["Sum", "Sum", ] # nolintr - - # Expected value of n_11h under the hypothesis of no association - # between group and response within stratum h. - m_11h <- (n_1.h * n_.1h) / n_h - # Lower and upper bounds for n_11h given the marginal totals. - n_11h_lwr <- pmax(0L, n_1.h - n_.2h) - n_11h_upr <- pmin(n_.1h, n_1.h) - - MF <- min( # nolintr - sum(m_11h) - sum(n_11h_lwr), - sum(n_11h_upr) - sum(m_11h) + n_1dot <- tbl_mrgn[1L, "Sum", ] + n_dot1 <- tbl_mrgn["Sum", 1L, ] + n_dot2 <- tbl_mrgn["Sum", 2L, ] + n <- tbl_mrgn["Sum", "Sum", ] + + # Expected value of n_11 under the hypothesis of no association + # between group and response within a given stratum. + m_11 <- (n_1dot * n_dot1) / n + # Lower and upper bounds for n_11 given the marginal totals. + n_11_lwr <- pmax(0L, n_1dot - n_dot2) + n_11_upr <- pmin(n_dot1, n_1dot) + + mf_value <- min( + sum(m_11) - sum(n_11_lwr), + sum(n_11_upr) - sum(m_11) ) - crit <- quote(MF >= 5) - is_satisfied <- eval(crit) - if (details) { - attr(is_satisfied, "value") <- MF - attr(is_satisfied, "criterion") <- deparse(crit) + is_satisfied <- mf_value >= 5 + if (include_value) { + attr(is_satisfied, "value") <- mf_value } is_satisfied diff --git a/man/mantel_fleiss_crit.Rd b/man/mantel_fleiss_crit.Rd index b295995449..b490c355e4 100644 --- a/man/mantel_fleiss_crit.Rd +++ b/man/mantel_fleiss_crit.Rd @@ -4,7 +4,7 @@ \alias{mantel_fleiss_crit} \title{Check the Mantel-Fleiss Criterion} \usage{ -mantel_fleiss_crit(grp, rsp, strata = NULL, details = FALSE) +mantel_fleiss_crit(grp, rsp, strata = NULL, include_value = FALSE) } \arguments{ \item{grp}{(\code{factor})\cr @@ -19,16 +19,14 @@ An optional factor defining the stratification variable. Each unique stratum defines a separate 2 x 2 contingency table. If \code{NULL}, an unstratified analysis is performed.} -\item{details}{(\code{logical(1)})\cr -Whether to attach the calculated Mantel-Fleiss statistic and criterion -to the returned value as attributes.} +\item{include_value}{(\code{logical(1)})\cr +Whether to include the calculated Mantel-Fleiss statistic as an attribute +of the result.} } \value{ A logical value indicating whether the Mantel-Fleiss criterion -is satisfied. -If \code{details = TRUE}, the result has two additional attributes: -\code{value}, containing the calculated Mantel-Fleiss statistic, -and \code{criterion}, containing the criterion used for evaluation. +is satisfied. If \code{include_value = TRUE}, the result also contains a +\code{value} attribute with the calculated Mantel-Fleiss statistic. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} @@ -80,7 +78,7 @@ strata <- interaction(strata1, strata2) table(grp, rsp, strata) mantel_fleiss_crit(grp, rsp, strata) -mantel_fleiss_crit(grp, rsp, strata, details = TRUE) +mantel_fleiss_crit(grp, rsp, strata, include_value = TRUE) } \references{ diff --git a/tests/testthat/test-mantel_fleiss_crit.R b/tests/testthat/test-mantel_fleiss_crit.R index d3516b6ae6..f644965ab3 100644 --- a/tests/testthat/test-mantel_fleiss_crit.R +++ b/tests/testthat/test-mantel_fleiss_crit.R @@ -9,16 +9,12 @@ test_that("mantel_fleiss_crit() works with multiple observations and strata", { result <- mantel_fleiss_crit(grp, rsp, strata) ) expect_silent( - result_det <- mantel_fleiss_crit(grp, rsp, strata, TRUE) + result_val <- mantel_fleiss_crit(grp, rsp, strata, TRUE) ) expect_identical(result, TRUE) - expect_identical(result_det, result, ignore_attr = TRUE) - expect_equal( - attributes(result_det), - list(value = 20.16857, criterion = "MF >= 5"), - tolerance = 1e-6 - ) + expect_identical(result_val, result, ignore_attr = TRUE) + expect_equal(attributes(result_val), list(value = 20.16857), tolerance = 1e-6) }) test_that("mantel_fleiss_crit() works with small stratified data", { @@ -32,16 +28,12 @@ test_that("mantel_fleiss_crit() works with small stratified data", { result <- mantel_fleiss_crit(grp, rsp, strata) ) expect_silent( - result_det <- mantel_fleiss_crit(grp, rsp, strata, TRUE) + result_val <- mantel_fleiss_crit(grp, rsp, strata, TRUE) ) expect_identical(result, FALSE) - expect_identical(result_det, result, ignore_attr = TRUE) - expect_equal( - attributes(result_det), - list(value = 2.785714, criterion = "MF >= 5"), - tolerance = 1e-6 - ) + expect_identical(result_val, result, ignore_attr = TRUE) + expect_equal(attributes(result_val), list(value = 2.785714), tolerance = 1e-6) }) test_that("mantel_fleiss_crit() works without strata", { @@ -55,7 +47,7 @@ test_that("mantel_fleiss_crit() works without strata", { result <- mantel_fleiss_crit(grp, rsp) ) expect_silent( - result_det <- mantel_fleiss_crit(grp, rsp, details = TRUE) + result_val <- mantel_fleiss_crit(grp, rsp, include_value = TRUE) ) # Explicit stratum. @@ -67,15 +59,11 @@ test_that("mantel_fleiss_crit() works without strata", { ) expect_identical(result, result_1stratum) - expect_identical(result_det, result_1stratum_det) + expect_identical(result_val, result_1stratum_det) expect_identical(result, FALSE) - expect_identical(result_det, result, ignore_attr = TRUE) - expect_equal( - attributes(result_det), - list(value = 3.6, criterion = "MF >= 5"), - tolerance = 1e-6 - ) + expect_identical(result_val, result, ignore_attr = TRUE) + expect_equal(attributes(result_val), list(value = 3.6), tolerance = 1e-6) }) test_that("mantel_fleiss_crit() ignores unused strata levels", { @@ -93,16 +81,12 @@ test_that("mantel_fleiss_crit() ignores unused strata levels", { result <- mantel_fleiss_crit(grp, rsp, strata) ) expect_silent( - result_det <- mantel_fleiss_crit(grp, rsp, strata, TRUE) + result_val <- mantel_fleiss_crit(grp, rsp, strata, TRUE) ) expect_identical(result, TRUE) - expect_identical(result_det, result, ignore_attr = TRUE) - expect_equal( - attributes(result_det), - list(value = 5.73951, criterion = "MF >= 5"), - tolerance = 1e-6 - ) + expect_identical(result_val, result, ignore_attr = TRUE) + expect_equal(attributes(result_val), list(value = 5.73951), tolerance = 1e-6) }) test_that("mantel_fleiss_crit() handles a stratum with observations in one cell only", { @@ -111,24 +95,20 @@ test_that("mantel_fleiss_crit() handles a stratum with observations in one cell strata <- factor(c(rep("A", 4), rep("B", 4))) result <- mantel_fleiss_crit(grp, rsp, strata) - result_det <- mantel_fleiss_crit(grp, rsp, strata, TRUE) + result_val <- mantel_fleiss_crit(grp, rsp, strata, TRUE) expect_identical(result, FALSE) - expect_identical(result_det, result, ignore_attr = TRUE) - expect_equal( - attributes(result_det), - list(value = 1, criterion = "MF >= 5"), - tolerance = 1e-6 - ) + expect_identical(result_val, result, ignore_attr = TRUE) + expect_equal(attributes(result_val), list(value = 1), tolerance = 1e-6) }) test_that("mantel_fleiss_crit() includes the MF = 5 boundary", { grp <- factor(c(rep("Active", 10), rep("Control", 20))) rsp <- c(rep(c(TRUE, FALSE), 5), rep(c(TRUE, FALSE), 10)) - result <- mantel_fleiss_crit(grp, rsp, details = TRUE) + result <- mantel_fleiss_crit(grp, rsp, include_value = TRUE) expect_identical(result, TRUE, ignore_attr = TRUE) - expect_identical(attributes(result), list(value = 5, criterion = "MF >= 5")) + expect_identical(attributes(result), list(value = 5)) }) test_that("mantel_fleiss_crit() handles only TRUE responses", { @@ -137,11 +117,11 @@ test_that("mantel_fleiss_crit() handles only TRUE responses", { strata <- factor(rep(c("A", "B"), each = 5)) result <- mantel_fleiss_crit(grp, rsp, strata) - result_det <- mantel_fleiss_crit(grp, rsp, strata, TRUE) + result_val <- mantel_fleiss_crit(grp, rsp, strata, TRUE) expect_identical(result, FALSE) - expect_identical(result_det, result, ignore_attr = TRUE) - expect_identical(attributes(result_det), list(value = 0, criterion = "MF >= 5")) + expect_identical(result_val, result, ignore_attr = TRUE) + expect_identical(attributes(result_val), list(value = 0)) }) test_that("mantel_fleiss_crit() handles only FALSE responses", { @@ -150,11 +130,11 @@ test_that("mantel_fleiss_crit() handles only FALSE responses", { strata <- factor(rep(c("A", "B"), each = 5)) result <- mantel_fleiss_crit(grp, rsp, strata) - result_det <- mantel_fleiss_crit(grp, rsp, strata, TRUE) + result_val <- mantel_fleiss_crit(grp, rsp, strata, TRUE) expect_identical(result, FALSE) - expect_identical(result_det, result, ignore_attr = TRUE) - expect_identical(attributes(result_det), list(value = 0, criterion = "MF >= 5")) + expect_identical(result_val, result, ignore_attr = TRUE) + expect_identical(attributes(result_val), list(value = 0)) }) test_that("mantel_fleiss_crit() works with observations from one group only", { @@ -163,11 +143,11 @@ test_that("mantel_fleiss_crit() works with observations from one group only", { strata <- factor(rep(c("A", "B"), each = 4)) result <- mantel_fleiss_crit(grp, rsp, strata) - result_det <- mantel_fleiss_crit(grp, rsp, strata, TRUE) + result_val <- mantel_fleiss_crit(grp, rsp, strata, TRUE) expect_identical(result, FALSE) - expect_identical(result_det, result, ignore_attr = TRUE) - expect_identical(attributes(result_det), list(value = 0, criterion = "MF >= 5")) + expect_identical(result_val, result, ignore_attr = TRUE) + expect_identical(attributes(result_val), list(value = 0)) }) test_that("mantel_fleiss_crit() validates inputs", { @@ -189,8 +169,8 @@ test_that("mantel_fleiss_crit() validates inputs", { expect_error(mantel_fleiss_crit(grp, rsp, as.character(strata))) expect_error(mantel_fleiss_crit(grp, rsp, as.numeric(strata))) expect_error(mantel_fleiss_crit(grp, rsp, c(strata[-3], NA))) - # details - expect_error(mantel_fleiss_crit(grp, rsp, strata, details = c(TRUE, FALSE))) + # result_val + expect_error(mantel_fleiss_crit(grp, rsp, strata, c(TRUE, FALSE))) # Different lengths. expect_error(mantel_fleiss_crit(grp[-1], rsp)) From 11899690bff4df42af6bf7ef88ea2c250f09bab5 Mon Sep 17 00:00:00 2001 From: Wojtek Date: Thu, 27 Aug 2026 14:47:54 +0200 Subject: [PATCH 7/9] cosmetic update of one unit test for mantel_fleiss_crit() --- tests/testthat/test-mantel_fleiss_crit.R | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-mantel_fleiss_crit.R b/tests/testthat/test-mantel_fleiss_crit.R index f644965ab3..01c3fdb032 100644 --- a/tests/testthat/test-mantel_fleiss_crit.R +++ b/tests/testthat/test-mantel_fleiss_crit.R @@ -51,15 +51,16 @@ test_that("mantel_fleiss_crit() works without strata", { ) # Explicit stratum. + strata <- factor(rep("A", n)) expect_silent( - result_1stratum <- mantel_fleiss_crit(grp, rsp, factor(rep("A", n))) + result_1stratum <- mantel_fleiss_crit(grp, rsp, strata) ) expect_silent( - result_1stratum_det <- mantel_fleiss_crit(grp, rsp, factor(rep("A", n)), TRUE) + result_1stratum_val <- mantel_fleiss_crit(grp, rsp, strata, TRUE) ) expect_identical(result, result_1stratum) - expect_identical(result_val, result_1stratum_det) + expect_identical(result_val, result_1stratum_val) expect_identical(result, FALSE) expect_identical(result_val, result, ignore_attr = TRUE) From b2065592d2d558c7ba54332bcd8f2d32e0d648a9 Mon Sep 17 00:00:00 2001 From: Wojtek Date: Thu, 27 Aug 2026 22:01:58 +0200 Subject: [PATCH 8/9] Change UI for mantel_fleiss_crit() + update unit tests. --- R/prop_diff_test.R | 77 ++++------ man/mantel_fleiss_crit.Rd | 48 +++--- tests/testthat/test-mantel_fleiss_crit.R | 186 +++++++++++------------ 3 files changed, 142 insertions(+), 169 deletions(-) diff --git a/R/prop_diff_test.R b/R/prop_diff_test.R index 354dabad17..fca598231c 100644 --- a/R/prop_diff_test.R +++ b/R/prop_diff_test.R @@ -486,23 +486,22 @@ prop_fisher <- function(tbl, alternative = c("two.sided", "less", "greater")) { #' #' @description `r lifecycle::badge("stable")` #' -#' Computes the Mantel-Fleiss criterion for stratified 2 x 2 contingency tables -#' defined by a group variable, a binary response variable, and stratification -#' variable. +#' Checks the Mantel-Fleiss criterion for stratified 2 x 2 contingency tables. +#' Strata with all cell counts equal to zero are ignored. #' #' @details #' The Mantel-Fleiss statistic is calculated as #' #' \deqn{ #' MF = \min\left( -#' [\sum_h m_{11h} - \sum_h (n_{11h})L],\ -#' [\sum_h (n{11h})U - \sum_h m{11h}] -#' \right). +#' [\sum_h m_{11h} - \sum_h {(n_{11h})}_L],\ +#' [\sum_h {(n_{11h})}_U - \sum_h m_{11h}] +#' \right), #' } #' -#' Here, \eqn{h} indexes the strata. For each stratum \eqn{h}, the expected -#' frequency of cell \eqn{(1, 1)} under the hypothesis of no association -#' between group and response is +#' where \eqn{h} indexes the strata. For each stratum \eqn{h}, the expected +#' frequency of cell \eqn{(1, 1)} in table \eqn{h}, under the hypothesis of no +#' association between group and response, is #' #' \deqn{ #' m_{11h} = \frac{n_{1.h} n_{.1h}}{n_h}. @@ -512,23 +511,21 @@ prop_fisher <- function(tbl, alternative = c("two.sided", "less", "greater")) { #' are: #' #' \deqn{ -#' (n_{11h})L = \max(0, n{1.h} - n_{.2h}), +#' {(n_{11h})}_L = \max(0, n_{1.h} - n_{.2h}), #' } #' \deqn{ -#' (n_{11h})U = \min(n{.1h}, n_{1.h}). +#' {(n_{11h})}_U = \min(n_{.1h}, n_{1.h}). #' } #' #' The Mantel-Fleiss criterion is satisfied when \eqn{MF \ge 5}. #' -#' @param grp (`factor`)\cr -#' A factor assigning observations to one of two groups (e.g., reference -#' and treatment). It must have exactly two levels. -#' @param rsp (`logical`)\cr -#' A logical vector indicating whether each observation is a responder. -#' @param strata (`factor` or `NULL`)\cr -#' An optional factor defining the stratification variable. Each unique -#' stratum defines a separate 2 x 2 contingency table. If `NULL`, an -#' unstratified analysis is performed. +#' @param tbl (`array`)\cr +#' A three-dimensional contingency table containing the counts for each +#' combination of group, response, and stratum. The first two dimensions +#' must correspond to the two variables defining the 2 x 2 contingency +#' table (group and response), in either order. The third dimension must +#' correspond to the strata. The first two dimensions must each have exactly +#' two levels. All cell values must be finite, non-missing integer counts. #' @param include_value (`logical(1)`)\cr #' Whether to include the calculated Mantel-Fleiss statistic as an attribute #' of the result. @@ -549,10 +546,11 @@ prop_fisher <- function(tbl, alternative = c("two.sided", "less", "greater")) { #' strata2 <- factor(sample(c("x", "y"), n, replace = TRUE)) #' strata <- interaction(strata1, strata2) #' -#' table(grp, rsp, strata) +#' tbl <- table(grp, rsp, strata) +#' tbl #' -#' mantel_fleiss_crit(grp, rsp, strata) -#' mantel_fleiss_crit(grp, rsp, strata, include_value = TRUE) +#' mantel_fleiss_crit(tbl) +#' mantel_fleiss_crit(tbl, include_value = TRUE) #' #' @references #' Mantel, N., and Fleiss, J. L. (1980). @@ -561,29 +559,16 @@ prop_fisher <- function(tbl, alternative = c("two.sided", "less", "greater")) { #' \emph{American Journal of Epidemiology}, 112(1), 129--134 #' #' @export -mantel_fleiss_crit <- function(grp, rsp, strata = NULL, include_value = FALSE) { - checkmate::assert_logical(rsp, any.missing = FALSE) - checkmate::assert_factor(grp, len = length(rsp), any.missing = FALSE, n.levels = 2) - checkmate::assert_factor(strata, len = length(rsp), any.missing = FALSE, null.ok = TRUE) +mantel_fleiss_crit <- function(tbl, include_value = FALSE) { + checkmate::assert_array(tbl, mode = "integerish", any.missing = FALSE, d = 3L) + checkmate::assert_true(all(tbl >= 0L)) + checkmate::assert_true(all(is.finite(tbl))) + checkmate::assert_true(nrow(tbl) == 2L) + checkmate::assert_true(ncol(tbl) == 2L) checkmate::assert_flag(include_value) - # 1. Pre-process data - - # Make rsp a factor to handle cases with only TRUE or only FALSE. - rsp <- factor(rsp, levels = c("TRUE", "FALSE")) - - # Use a dummy stratum for an unstratified analysis. - strata <- if (is.null(strata)) { - rep("DUMMY", length(rsp)) - } else { - # Drop strata with no observations. - droplevels(strata) - } - - # 2. Calculate Mantel-Fleiss criterion - - # The order of dimensions is important: group x response x stratum. - tbl <- table(grp, rsp, strata) + # Drop strata with no observations. + tbl <- tbl[, , apply(tbl, 3L, sum) > 0, drop = FALSE] # Add marginal totals over the group and response dimensions, # retaining the stratum dimension. @@ -595,9 +580,9 @@ mantel_fleiss_crit <- function(grp, rsp, strata = NULL, include_value = FALSE) { n <- tbl_mrgn["Sum", "Sum", ] # Expected value of n_11 under the hypothesis of no association - # between group and response within a given stratum. + # between group and response (within a given stratum). m_11 <- (n_1dot * n_dot1) / n - # Lower and upper bounds for n_11 given the marginal totals. + # Lower and upper bounds for n_11 given the marginal totals (within a given stratum). n_11_lwr <- pmax(0L, n_1dot - n_dot2) n_11_upr <- pmin(n_dot1, n_1dot) diff --git a/man/mantel_fleiss_crit.Rd b/man/mantel_fleiss_crit.Rd index b490c355e4..228ae15380 100644 --- a/man/mantel_fleiss_crit.Rd +++ b/man/mantel_fleiss_crit.Rd @@ -4,20 +4,16 @@ \alias{mantel_fleiss_crit} \title{Check the Mantel-Fleiss Criterion} \usage{ -mantel_fleiss_crit(grp, rsp, strata = NULL, include_value = FALSE) +mantel_fleiss_crit(tbl, include_value = FALSE) } \arguments{ -\item{grp}{(\code{factor})\cr -A factor assigning observations to one of two groups (e.g., reference -and treatment). It must have exactly two levels.} - -\item{rsp}{(\code{logical})\cr -A logical vector indicating whether each observation is a responder.} - -\item{strata}{(\code{factor} or \code{NULL})\cr -An optional factor defining the stratification variable. Each unique -stratum defines a separate 2 x 2 contingency table. If \code{NULL}, an -unstratified analysis is performed.} +\item{tbl}{(\code{array})\cr +A three-dimensional contingency table containing the counts for each +combination of group, response, and stratum. The first two dimensions +must correspond to the two variables defining the 2 x 2 contingency +table (group and response), in either order. The third dimension must +correspond to the strata. The first two dimensions must each have exactly +two levels. All cell values must be finite, non-missing integer counts.} \item{include_value}{(\code{logical(1)})\cr Whether to include the calculated Mantel-Fleiss statistic as an attribute @@ -31,23 +27,22 @@ is satisfied. If \code{include_value = TRUE}, the result also contains a \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -Computes the Mantel-Fleiss criterion for stratified 2 x 2 contingency tables -defined by a group variable, a binary response variable, and stratification -variable. +Checks the Mantel-Fleiss criterion for stratified 2 x 2 contingency tables. +Strata with all cell counts equal to zero are ignored. } \details{ The Mantel-Fleiss statistic is calculated as \deqn{ MF = \min\left( -[\sum_h m_{11h} - \sum_h (n_{11h})L],\ -[\sum_h (n{11h})U - \sum_h m{11h}] -\right). +[\sum_h m_{11h} - \sum_h {(n_{11h})}_L],\ +[\sum_h {(n_{11h})}_U - \sum_h m_{11h}] +\right), } -Here, \eqn{h} indexes the strata. For each stratum \eqn{h}, the expected -frequency of cell \eqn{(1, 1)} under the hypothesis of no association -between group and response is +where \eqn{h} indexes the strata. For each stratum \eqn{h}, the expected +frequency of cell \eqn{(1, 1)} in table \eqn{h}, under the hypothesis of no +association between group and response, is \deqn{ m_{11h} = \frac{n_{1.h} n_{.1h}}{n_h}. @@ -57,10 +52,10 @@ The lower and upper bounds for \eqn{n_{11h}}, given the marginal totals, are: \deqn{ -(n_{11h})L = \max(0, n{1.h} - n_{.2h}), +{(n_{11h})}_L = \max(0, n_{1.h} - n_{.2h}), } \deqn{ -(n_{11h})U = \min(n{.1h}, n_{1.h}). +{(n_{11h})}_U = \min(n_{.1h}, n_{1.h}). } The Mantel-Fleiss criterion is satisfied when \eqn{MF \ge 5}. @@ -75,10 +70,11 @@ strata1 <- factor(sample(c("A", "B"), n, replace = TRUE)) strata2 <- factor(sample(c("x", "y"), n, replace = TRUE)) strata <- interaction(strata1, strata2) -table(grp, rsp, strata) +tbl <- table(grp, rsp, strata) +tbl -mantel_fleiss_crit(grp, rsp, strata) -mantel_fleiss_crit(grp, rsp, strata, include_value = TRUE) +mantel_fleiss_crit(tbl) +mantel_fleiss_crit(tbl, include_value = TRUE) } \references{ diff --git a/tests/testthat/test-mantel_fleiss_crit.R b/tests/testthat/test-mantel_fleiss_crit.R index 01c3fdb032..ec4a81443e 100644 --- a/tests/testthat/test-mantel_fleiss_crit.R +++ b/tests/testthat/test-mantel_fleiss_crit.R @@ -1,15 +1,14 @@ test_that("mantel_fleiss_crit() works with multiple observations and strata", { - set.seed(123) - n <- 100 - grp <- factor(sample(c("Active", "Control"), n, replace = TRUE)) - rsp <- sample(c(TRUE, FALSE), n, replace = TRUE) - strata <- factor(sample(LETTERS[1:4], n, replace = TRUE)) + tbl <- array( + c(9L, 8L, 6L, 9L, 6L, 5L, 8L, 5L, 5L, 5L, 5L, 4L, 11L, 5L, 7L, 2L), + dim = c(2L, 2L, 4L) + ) expect_silent( - result <- mantel_fleiss_crit(grp, rsp, strata) + result <- mantel_fleiss_crit(tbl) ) expect_silent( - result_val <- mantel_fleiss_crit(grp, rsp, strata, TRUE) + result_val <- mantel_fleiss_crit(tbl, TRUE) ) expect_identical(result, TRUE) @@ -17,18 +16,18 @@ test_that("mantel_fleiss_crit() works with multiple observations and strata", { expect_equal(attributes(result_val), list(value = 20.16857), tolerance = 1e-6) }) -test_that("mantel_fleiss_crit() works with small stratified data", { - set.seed(123) - n <- 20 - grp <- factor(sample(c("Active", "Control"), n, replace = TRUE)) - rsp <- sample(c(TRUE, FALSE), n, replace = TRUE) - strata <- factor(sample(LETTERS[1:4], n, replace = TRUE)) +test_that("mantel_fleiss_crit() works with small stratified data and dimnames", { + tbl <- array( + c(2L, 2L, 1L, 2L, 0L, 1L, 2L, 1L, 1L, 1L, 3L, 1L, 1L, 0L, 1L, 1L), + dim = c(2L, 2L, 4L), + dimnames = list(grp = c("Gr1", "Gr2"), rsp = c("T", "F"), strata = LETTERS[1:4]) + ) expect_silent( - result <- mantel_fleiss_crit(grp, rsp, strata) + result <- mantel_fleiss_crit(tbl) ) expect_silent( - result_val <- mantel_fleiss_crit(grp, rsp, strata, TRUE) + result_val <- mantel_fleiss_crit(tbl, TRUE) ) expect_identical(result, FALSE) @@ -36,67 +35,59 @@ test_that("mantel_fleiss_crit() works with small stratified data", { expect_equal(attributes(result_val), list(value = 2.785714), tolerance = 1e-6) }) -test_that("mantel_fleiss_crit() works without strata", { - set.seed(123) - n <- 20 - grp <- factor(sample(c("Active", "Control"), n, replace = TRUE)) - rsp <- sample(c(TRUE, FALSE), n, replace = TRUE) +test_that("mantel_fleiss_crit() works with 1 stratum", { + tbl <- array(c(4L, 4L, 7L, 5L), dim = c(2L, 2L, 1L)) - # No explicit strata. expect_silent( - result <- mantel_fleiss_crit(grp, rsp) + result <- mantel_fleiss_crit(tbl) ) expect_silent( - result_val <- mantel_fleiss_crit(grp, rsp, include_value = TRUE) + result_val <- mantel_fleiss_crit(tbl, TRUE) + ) + + expect_identical(result, FALSE) + expect_identical(result_val, result, ignore_attr = TRUE) + expect_equal(attributes(result_val), list(value = 3.6), tolerance = 1e-6) +}) + +test_that("mantel_fleiss_crit() ignores unobserved strata levels", { + tbl <- array( + c(1L, 4L, 3L, 3L, 5L, 0L, 7L, 4L, 0L, 0L, 0L, 0L, 3L, 1L, 0L, 6L), + dim = c(2L, 2L, 4L) ) - # Explicit stratum. - strata <- factor(rep("A", n)) expect_silent( - result_1stratum <- mantel_fleiss_crit(grp, rsp, strata) + result <- mantel_fleiss_crit(tbl) ) expect_silent( - result_1stratum_val <- mantel_fleiss_crit(grp, rsp, strata, TRUE) + result_val <- mantel_fleiss_crit(tbl, TRUE) ) - expect_identical(result, result_1stratum) - expect_identical(result_val, result_1stratum_val) - - expect_identical(result, FALSE) + expect_identical(result, TRUE) expect_identical(result_val, result, ignore_attr = TRUE) - expect_equal(attributes(result_val), list(value = 3.6), tolerance = 1e-6) + expect_equal(attributes(result_val), list(value = 5.231818), tolerance = 1e-6) }) -test_that("mantel_fleiss_crit() ignores unused strata levels", { - set.seed(123) - n <- 40 - - grp <- factor(sample(c("Active", "Control"), n, replace = TRUE)) - rsp <- sample(c(TRUE, FALSE), n, replace = TRUE) - strata <- factor( - sample(LETTERS[1:3], n, replace = TRUE), - levels = LETTERS[1:4] - ) +test_that("mantel_fleiss_crit() works with all cell counts equal to zero", { + tbl <- array(rep(0L, 16L), dim = c(2L, 2L, 4L)) expect_silent( - result <- mantel_fleiss_crit(grp, rsp, strata) + result <- mantel_fleiss_crit(tbl) ) expect_silent( - result_val <- mantel_fleiss_crit(grp, rsp, strata, TRUE) + result_val <- mantel_fleiss_crit(tbl, TRUE) ) - expect_identical(result, TRUE) + expect_identical(result, FALSE) expect_identical(result_val, result, ignore_attr = TRUE) - expect_equal(attributes(result_val), list(value = 5.73951), tolerance = 1e-6) + expect_equal(attributes(result_val), list(value = 0), tolerance = 1e-6) }) test_that("mantel_fleiss_crit() handles a stratum with observations in one cell only", { - grp <- factor(c("Act", "Act", "Cntrl", "Cntrl", "Act", "Act", "Act", "Act")) - rsp <- c(TRUE, FALSE, TRUE, FALSE, TRUE, TRUE, TRUE, TRUE) - strata <- factor(c(rep("A", 4), rep("B", 4))) + tbl <- array(c(1L, 1L, 1L, 1L, 0L, 4L, 0L, 0L), dim = c(2L, 2L, 2L)) - result <- mantel_fleiss_crit(grp, rsp, strata) - result_val <- mantel_fleiss_crit(grp, rsp, strata, TRUE) + result <- mantel_fleiss_crit(tbl) + result_val <- mantel_fleiss_crit(tbl, TRUE) expect_identical(result, FALSE) expect_identical(result_val, result, ignore_attr = TRUE) @@ -104,47 +95,52 @@ test_that("mantel_fleiss_crit() handles a stratum with observations in one cell }) test_that("mantel_fleiss_crit() includes the MF = 5 boundary", { - grp <- factor(c(rep("Active", 10), rep("Control", 20))) - rsp <- c(rep(c(TRUE, FALSE), 5), rep(c(TRUE, FALSE), 10)) + tbl <- array(c(5L, 5L, 10L, 10L), dim = c(2L, 2L, 1L)) + + result <- mantel_fleiss_crit(tbl, include_value = TRUE) - result <- mantel_fleiss_crit(grp, rsp, include_value = TRUE) expect_identical(result, TRUE, ignore_attr = TRUE) expect_identical(attributes(result), list(value = 5)) }) -test_that("mantel_fleiss_crit() handles only TRUE responses", { - grp <- factor(rep(c("Active", "Control"), each = 5)) - rsp <- rep(TRUE, 10) - strata <- factor(rep(c("A", "B"), each = 5)) +test_that("mantel_fleiss_crit() handles data with no non-responses", { + tbl <- array(c(2L, 4L, 0L, 0L), dim = c(2L, 2L, 2L)) + + result <- mantel_fleiss_crit(tbl) + result_val <- mantel_fleiss_crit(tbl, TRUE) + + expect_identical(result, FALSE) + expect_identical(result_val, result, ignore_attr = TRUE) + expect_identical(attributes(result_val), list(value = 0)) +}) + +test_that("mantel_fleiss_crit() handles data with no responses", { + tbl <- array(c(0L, 0L, 4L, 0L), dim = c(2L, 2L, 2L)) - result <- mantel_fleiss_crit(grp, rsp, strata) - result_val <- mantel_fleiss_crit(grp, rsp, strata, TRUE) + result <- mantel_fleiss_crit(tbl) + result_val <- mantel_fleiss_crit(tbl, TRUE) expect_identical(result, FALSE) expect_identical(result_val, result, ignore_attr = TRUE) expect_identical(attributes(result_val), list(value = 0)) }) -test_that("mantel_fleiss_crit() handles only FALSE responses", { - grp <- factor(rep(c("Active", "Control"), each = 5)) - rsp <- rep(FALSE, 10) - strata <- factor(rep(c("A", "B"), each = 5)) +test_that("mantel_fleiss_crit() works with observations from one group only (Gr1)", { + tbl <- array(c(46L, 0L, 4L, 0L), dim = c(2L, 2L, 2L)) - result <- mantel_fleiss_crit(grp, rsp, strata) - result_val <- mantel_fleiss_crit(grp, rsp, strata, TRUE) + result <- mantel_fleiss_crit(tbl) + result_val <- mantel_fleiss_crit(tbl, TRUE) expect_identical(result, FALSE) expect_identical(result_val, result, ignore_attr = TRUE) expect_identical(attributes(result_val), list(value = 0)) }) -test_that("mantel_fleiss_crit() works with observations from one group only", { - grp <- factor(rep("Active", 8), levels = c("Active", "Control")) - rsp <- c(TRUE, FALSE, TRUE, FALSE, TRUE, FALSE, TRUE, FALSE) - strata <- factor(rep(c("A", "B"), each = 4)) +test_that("mantel_fleiss_crit() works with observations from one group only (Gr2)", { + tbl <- array(c(0L, 30L, 0L, 3L), dim = c(2L, 2L, 2L)) - result <- mantel_fleiss_crit(grp, rsp, strata) - result_val <- mantel_fleiss_crit(grp, rsp, strata, TRUE) + result <- mantel_fleiss_crit(tbl) + result_val <- mantel_fleiss_crit(tbl, TRUE) expect_identical(result, FALSE) expect_identical(result_val, result, ignore_attr = TRUE) @@ -152,29 +148,25 @@ test_that("mantel_fleiss_crit() works with observations from one group only", { }) test_that("mantel_fleiss_crit() validates inputs", { - grp <- factor(c("G1", "G1", "G2", "G2")) - rsp <- c(TRUE, FALSE, TRUE, FALSE) - strata <- factor(c("A", "A", "B", "B")) - - # grp - expect_error(mantel_fleiss_crit(factor(rep("G1", 4)), rsp)) - expect_error(mantel_fleiss_crit(factor(grp, levels = c("G1", "G2", "X")), rsp)) - expect_error(mantel_fleiss_crit(as.character(grp), rsp)) - expect_error(mantel_fleiss_crit(as.numeric(grp), rsp)) - expect_error(mantel_fleiss_crit(c(grp[-1], NA), rsp)) - # rsp - expect_error(mantel_fleiss_crit(grp, as.character(rsp))) - expect_error(mantel_fleiss_crit(grp, as.numeric(rsp))) - expect_error(mantel_fleiss_crit(grp, c(rsp[-2], NA))) - # strata - expect_error(mantel_fleiss_crit(grp, rsp, as.character(strata))) - expect_error(mantel_fleiss_crit(grp, rsp, as.numeric(strata))) - expect_error(mantel_fleiss_crit(grp, rsp, c(strata[-3], NA))) - # result_val - expect_error(mantel_fleiss_crit(grp, rsp, strata, c(TRUE, FALSE))) - - # Different lengths. - expect_error(mantel_fleiss_crit(grp[-1], rsp)) - expect_error(mantel_fleiss_crit(grp, rsp[-1])) - expect_error(mantel_fleiss_crit(grp, rsp, strata[-2])) + # tbl + expect_error(mantel_fleiss_crit(matrix(1L, nrow = 2, ncol = 2))) + expect_error(mantel_fleiss_crit(array(1L, dim = c(2L, 2L, 2L, 1L)))) + expect_error(mantel_fleiss_crit(array(1L, dim = c(3L, 2L, 2L)))) + expect_error(mantel_fleiss_crit(array(1L, dim = c(2L, 3L, 2L)))) + + # Missing / invalid values. + dim3d <- c(2L, 2L, 2L) + expect_error(mantel_fleiss_crit(array(NA_integer_, dim = dim3d))) + expect_error(mantel_fleiss_crit(array("1", dim = dim3d))) + expect_error(mantel_fleiss_crit(array(NA_real_, dim = dim3d))) + expect_error(mantel_fleiss_crit(array(NaN, dim = dim3d))) + expect_error(mantel_fleiss_crit(array(-1, dim = dim3d))) + expect_error(mantel_fleiss_crit(array(-1L, dim = dim3d))) + expect_error(mantel_fleiss_crit(array(Inf, dim = dim3d))) + + # include_value + tbl <- array(1L, dim = c(2L, 2L, 3L)) + expect_error(mantel_fleiss_crit(tbl, include_value = c(TRUE, FALSE))) + expect_error(mantel_fleiss_crit(tbl, include_value = 1L)) + expect_error(mantel_fleiss_crit(tbl, include_value = 1)) }) From 23f6a133973b1a002f6555d61e7096502af9df3b Mon Sep 17 00:00:00 2001 From: Wojtek Date: Thu, 27 Aug 2026 22:31:24 +0200 Subject: [PATCH 9/9] update mantel_fleiss_crit() to return NA when all counts are 0. --- R/prop_diff_test.R | 31 ++++++++++++++++++------ man/mantel_fleiss_crit.Rd | 19 ++++++++++----- tests/testthat/test-mantel_fleiss_crit.R | 6 ++--- 3 files changed, 40 insertions(+), 16 deletions(-) diff --git a/R/prop_diff_test.R b/R/prop_diff_test.R index fca598231c..1c680fd576 100644 --- a/R/prop_diff_test.R +++ b/R/prop_diff_test.R @@ -487,7 +487,6 @@ prop_fisher <- function(tbl, alternative = c("two.sided", "less", "greater")) { #' @description `r lifecycle::badge("stable")` #' #' Checks the Mantel-Fleiss criterion for stratified 2 x 2 contingency tables. -#' Strata with all cell counts equal to zero are ignored. #' #' @details #' The Mantel-Fleiss statistic is calculated as @@ -499,9 +498,9 @@ prop_fisher <- function(tbl, alternative = c("two.sided", "less", "greater")) { #' \right), #' } #' -#' where \eqn{h} indexes the strata. For each stratum \eqn{h}, the expected -#' frequency of cell \eqn{(1, 1)} in table \eqn{h}, under the hypothesis of no -#' association between group and response, is +#' where \eqn{h} indexes the non-empty strata. For each stratum \eqn{h}, the +#' expected frequency of cell \eqn{(1, 1)} in table \eqn{h}, under the +#' hypothesis of no association between group and response, is #' #' \deqn{ #' m_{11h} = \frac{n_{1.h} n_{.1h}}{n_h}. @@ -519,6 +518,12 @@ prop_fisher <- function(tbl, alternative = c("two.sided", "less", "greater")) { #' #' The Mantel-Fleiss criterion is satisfied when \eqn{MF \ge 5}. #' +#' Strata with all cell counts equal to zero are excluded from the +#' calculation. If all strata contain zero observations, there are no +#' non-empty strata over which to calculate the Mantel-Fleiss statistic, and +#' the statistic is therefore undefined. In this case, the function returns +#' `NA`. +#' #' @param tbl (`array`)\cr #' A three-dimensional contingency table containing the counts for each #' combination of group, response, and stratum. The first two dimensions @@ -531,8 +536,10 @@ prop_fisher <- function(tbl, alternative = c("two.sided", "less", "greater")) { #' of the result. #' #' @return A logical value indicating whether the Mantel-Fleiss criterion -#' is satisfied. If `include_value = TRUE`, the result also contains a -#' `value` attribute with the calculated Mantel-Fleiss statistic. +#' is satisfied. If `include_value = TRUE`, the result also contains a +#' value attribute with the calculated Mantel-Fleiss statistic. If there +#' are no non-empty strata, the result is `NA` and the value attribute is +#' `NA_real_`. #' #' @author WW #' @@ -556,7 +563,7 @@ prop_fisher <- function(tbl, alternative = c("two.sided", "less", "greater")) { #' Mantel, N., and Fleiss, J. L. (1980). #' Minimum Expected Cell Size Requirements for the Mantel-Haenszel #' One-Degree-of-Freedom Chi-Square Test and a Related Rapid Procedure. -#' \emph{American Journal of Epidemiology}, 112(1), 129--134 +#' \emph{American Journal of Epidemiology}, 112(1), 129--134. #' #' @export mantel_fleiss_crit <- function(tbl, include_value = FALSE) { @@ -574,6 +581,16 @@ mantel_fleiss_crit <- function(tbl, include_value = FALSE) { # retaining the stratum dimension. tbl_mrgn <- stats::addmargins(tbl, margin = 1:2) + # If there are no non-empty strata, the Mantel-Fleiss criterion is undefined + # because there are no strata over which to calculate it. + if (dim(tbl)[3L] == 0L) { + is_satisfied <- NA + if (include_value) { + attr(is_satisfied, "value") <- NA_real_ + } + return(is_satisfied) + } + n_1dot <- tbl_mrgn[1L, "Sum", ] n_dot1 <- tbl_mrgn["Sum", 1L, ] n_dot2 <- tbl_mrgn["Sum", 2L, ] diff --git a/man/mantel_fleiss_crit.Rd b/man/mantel_fleiss_crit.Rd index 228ae15380..819035cb0b 100644 --- a/man/mantel_fleiss_crit.Rd +++ b/man/mantel_fleiss_crit.Rd @@ -22,13 +22,14 @@ of the result.} \value{ A logical value indicating whether the Mantel-Fleiss criterion is satisfied. If \code{include_value = TRUE}, the result also contains a -\code{value} attribute with the calculated Mantel-Fleiss statistic. +value attribute with the calculated Mantel-Fleiss statistic. If there +are no non-empty strata, the result is \code{NA} and the value attribute is +\code{NA_real_}. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} Checks the Mantel-Fleiss criterion for stratified 2 x 2 contingency tables. -Strata with all cell counts equal to zero are ignored. } \details{ The Mantel-Fleiss statistic is calculated as @@ -40,9 +41,9 @@ MF = \min\left( \right), } -where \eqn{h} indexes the strata. For each stratum \eqn{h}, the expected -frequency of cell \eqn{(1, 1)} in table \eqn{h}, under the hypothesis of no -association between group and response, is +where \eqn{h} indexes the non-empty strata. For each stratum \eqn{h}, the +expected frequency of cell \eqn{(1, 1)} in table \eqn{h}, under the +hypothesis of no association between group and response, is \deqn{ m_{11h} = \frac{n_{1.h} n_{.1h}}{n_h}. @@ -59,6 +60,12 @@ are: } The Mantel-Fleiss criterion is satisfied when \eqn{MF \ge 5}. + +Strata with all cell counts equal to zero are excluded from the +calculation. If all strata contain zero observations, there are no +non-empty strata over which to calculate the Mantel-Fleiss statistic, and +the statistic is therefore undefined. In this case, the function returns +\code{NA}. } \examples{ set.seed(123) @@ -81,7 +88,7 @@ mantel_fleiss_crit(tbl, include_value = TRUE) Mantel, N., and Fleiss, J. L. (1980). Minimum Expected Cell Size Requirements for the Mantel-Haenszel One-Degree-of-Freedom Chi-Square Test and a Related Rapid Procedure. -\emph{American Journal of Epidemiology}, 112(1), 129--134 +\emph{American Journal of Epidemiology}, 112(1), 129--134. } \author{ WW diff --git a/tests/testthat/test-mantel_fleiss_crit.R b/tests/testthat/test-mantel_fleiss_crit.R index ec4a81443e..60b1e0fa87 100644 --- a/tests/testthat/test-mantel_fleiss_crit.R +++ b/tests/testthat/test-mantel_fleiss_crit.R @@ -68,7 +68,7 @@ test_that("mantel_fleiss_crit() ignores unobserved strata levels", { expect_equal(attributes(result_val), list(value = 5.231818), tolerance = 1e-6) }) -test_that("mantel_fleiss_crit() works with all cell counts equal to zero", { +test_that("mantel_fleiss_crit() returns NA when all cell counts equal zero", { tbl <- array(rep(0L, 16L), dim = c(2L, 2L, 4L)) expect_silent( @@ -78,9 +78,9 @@ test_that("mantel_fleiss_crit() works with all cell counts equal to zero", { result_val <- mantel_fleiss_crit(tbl, TRUE) ) - expect_identical(result, FALSE) + expect_identical(result, NA) expect_identical(result_val, result, ignore_attr = TRUE) - expect_equal(attributes(result_val), list(value = 0), tolerance = 1e-6) + expect_identical(attributes(result_val), list(value = NA_real_)) }) test_that("mantel_fleiss_crit() handles a stratum with observations in one cell only", {