# Boschloo's test in R with tied tables kept (exact2x2 1.7.0).
# exact2x2::boschloo() orders tables by Fisher's one-sided p and compares those p-values with exact equality.
# Two tables that tie by symmetry can differ in the last bits, so a tied table is dropped and the p-value is
# too small (0.033 instead of 0.041 for 8/10 vs 3/10). Ordering by the Fisher p rounded to 12 significant
# figures keeps the tie and reproduces SciPy's boschloo_exact (two-sided = twice the smaller one-sided p).
# Run: Rscript boschloo_tie_fix.R   (takes about a minute)
suppressMessages(library(exact2x2))
fisher_p <- function(X1, N1, X2, N2, alt) sapply(seq_along(X1), function(i) signif(exact2x2(
  matrix(c(X2[i], N2 - X2[i], X1[i], N1 - X1[i]), 2, 2), conf.int = FALSE, alternative = alt)$p.value, 12))
boschloo_ties <- function(x1, n1, x2, n2) {
  less <- uncondExact2x2(x1, n1, x2, n2, "oddsratio", alternative = "less", method = "user",
    Tfunc = function(X1, N1, X2, N2, delta0 = 1) fisher_p(X1, N1, X2, N2, "less"))$p.value
  greater <- uncondExact2x2(x1, n1, x2, n2, "oddsratio", alternative = "greater", method = "user",
    Tfunc = function(X1, N1, X2, N2, delta0 = 1) -fisher_p(X1, N1, X2, N2, "greater"))$p.value
  c(less = less, greater = greater, two.sided = min(1, 2 * less, 2 * greater))
}
print(signif(boschloo_ties(8, 10, 3, 10), 4))   # two.sided 0.0414, as SciPy (0.04139; add control = ucControl(nPgrid = 1000) for more digits)
print(signif(boschloo(8, 10, 3, 10)$p.value, 4)) # 0.03298: the tied table dropped