Proportion Tests & Confidence Intervals — Did the Rate Really Differ?

suppressPackageStartupMessages(library(DT))
suppressPackageStartupMessages(library(htmlwidgets))
suppressPackageStartupMessages(library(arrow))
suppressPackageStartupMessages(library(knitr))
suppressPackageStartupMessages(library(rmarkdown))
suppressPackageStartupMessages(library(dplyr))
suppressPackageStartupMessages(library(tidyr))
suppressPackageStartupMessages(library(ggplot2))
suppressPackageStartupMessages(library(stringr))
suppressPackageStartupMessages(library(lubridate))
suppressPackageStartupMessages(library(broom))
suppressPackageStartupMessages(library(Matrix))
suppressPackageStartupMessages(library(cluster))
suppressPackageStartupMessages(library(data.table))

compute_shared <- function(df, params, col_map = list()) {
  # === SHARED EXPORTS ===
  #   initial_rows/final_rows/rows_removed/n_na_rows  $ row accounting
  #   outcome_h / group_h   $ humanized user names for the mapped columns
  #   l1 / l2               $ the two group levels (factor order)
  #   success_label / failure_label  $ outcome levels (original casing)
  #   success_flagged / success_note $ how the success level was chosen
  #   n1/n2, x1/x2, p1/p2   $ per-group n, successes, proportions
  #   w1 / w2               $ Wilson 95% CIs per group (low/high)
  #   d / d_low / d_high    $ absolute difference (l1 - l2) + Newcombe 95% CI
  #   rel_change / rel_ok   $ relative change of l2 vs l1 (only when p1 > 0)
  #   min_cell / z_valid    $ smallest cell count; z-test validity guard
  #   z_stat/p_z, chi_stat/chi_df/p_chi, p_fisher/fisher_or  $ the tests
  #   p_primary / test_used / significant / verdict_label    $ the verdict
  #   dropped_groups_df     $ groups dropped for n < 3
  #   rates_df / test_df / group_summary_df / methods_df  $ card datasets
  #   metrics / json_output
  # === /SHARED EXPORTS ===

initial_rows <- nrow(df)
  outcome_h <- humanize_semantic("outcome", col_map)
  group_h   <- humanize_semantic("group", col_map)
  if (!("outcome" %in% names(df)) || !("group" %in% names(df))) {
    stop(sprintf("Proportion testing needs both &#x27;%s' (the binary outcome) and '%s' (the two groups) mapped.",
                 outcome_h, group_h))
  }

o_raw <- as.character(df$outcome)
  g_raw <- as.character(df$group)
  o_norm <- tolower(trimws(o_raw))
  g_clean <- trimws(g_raw)
  keep <- !is.na(o_raw) & o_norm != "" & o_norm != "na" &
          !is.na(g_raw) & g_clean != ""
  n_na_rows <- sum(!keep)
  o_raw  <- o_raw[keep];  o_norm <- o_norm[keep]
  g_clean <- g_clean[keep]
  if (length(o_norm) == 0) {
    stop(sprintf("No rows with usable values in both &#x27;%s' and '%s' remained after cleaning.",
                 outcome_h, group_h))
  }

lev_norm <- sort(unique(o_norm))
  if (length(lev_norm) != 2) {
    stop(sprintf("The outcome column &#x27;%s' must be binary (exactly 2 distinct values such as 0/1, yes/no, TRUE/FALSE); it has %d distinct value(s): %s. Pick a two-valued column.",
                 outcome_h, length(lev_norm),
                 paste(head(lev_norm, 6), collapse = ", ")))
  }

disp <- sapply(lev_norm, function(l) trimws(o_raw[match(l, o_norm)]))
  positive_tokens <- c("1", "true", "t", "yes", "y", "converted", "success",
                       "succeeded", "won", "pass", "passed", "clicked",
                       "purchased", "retained")
  negative_tokens <- c("0", "false", "f", "no", "n", "not converted",
                       "not_converted", "non-converted", "failure", "failed",
                       "lost", "fail", "none")
  in_pos <- lev_norm %in% positive_tokens
  in_neg <- lev_norm %in% negative_tokens
  success_flagged <- FALSE
  if (sum(in_pos) == 1) {
    success_norm <- lev_norm[in_pos]
    success_note <- sprintf("&#x27;%s' is a recognized affirmative value (like 1/TRUE/yes), so it was treated as the success level.",
                            disp[in_pos])
  } else if (sum(in_neg) == 1) {
    success_norm <- lev_norm[!in_neg]
    success_note <- sprintf("&#x27;%s' is a recognized negative value (like 0/FALSE/no), so the other level, '%s', was treated as the success level.",
                            disp[in_neg], disp[!in_neg])
  } else {

cnt <- table(o_norm)[lev_norm]
    success_norm <- lev_norm[which.min(as.integer(cnt))]
    success_flagged <- TRUE
    success_note <- sprintf("Neither &#x27;%s' nor '%s' is a standard yes/no token, so the RARER level, '%s', was assumed to be the event of interest (the success level). If the other level is the one you care about, note that every rate below is simply 100%% minus the reported one.",
                            disp[1], disp[2], disp[lev_norm == success_norm])
  }
  success_label <- unname(disp[lev_norm == success_norm])
  failure_label <- unname(disp[lev_norm != success_norm])
  y <- as.integer(o_norm == success_norm)

tab <- table(g_clean)
  small <- names(tab)[tab < 3]
  dropped_groups_df <- data.frame(group = character(0), n = integer(0),
                                  stringsAsFactors = FALSE)
  if (length(small) > 0) {
    dropped_groups_df <- data.frame(group = small, n = as.integer(tab[small]),
                                    stringsAsFactors = FALSE)
    sel <- !(g_clean %in% small)
    g_clean <- g_clean[sel]
    y <- y[sel]
  }
  gf <- factor(g_clean)
  k  <- nlevels(gf)
  if (k < 2) {
    stop(sprintf("Comparing proportions needs exactly 2 groups in &#x27;%s' with 3 or more rows each; only %d usable group(s) remained after cleaning. Check that '%s' really splits the data into two groups.",
                 group_h, k, group_h))
  }
  if (k > 2) {
    stop(sprintf("This tool compares exactly two groups, but &#x27;%s' has %d usable levels (%s). Filter the data to two groups, or use a many-group categorical test instead.",
                 group_h, k, paste(levels(gf), collapse = ", ")))
  }
  final_rows <- length(y)
  rows_removed <- initial_rows - final_rows
  if (final_rows < 10) {
    stop(sprintf("Only %d usable rows remained — at least 10 are needed to compare &#x27;%s' rates across '%s'.",
                 final_rows, outcome_h, group_h))
  }
  if (sum(y) == 0 || sum(y) == final_rows) {
    stop(sprintf("Every usable row has the same &#x27;%s' outcome ('%s') — with no variation, no rate difference can be tested.",
                 outcome_h, if (sum(y) == 0) failure_label else success_label))
  }

l1 <- levels(gf)[1]; l2 <- levels(gf)[2]
  y1 <- y[gf == l1]; y2 <- y[gf == l2]
  n1 <- length(y1); n2 <- length(y2)
  x1 <- sum(y1); x2 <- sum(y2)
  p1 <- x1 / n1; p2 <- x2 / n2
  w1 <- wilson_ci(x1, n1)
  w2 <- wilson_ci(x2, n2)

d <- p1 - p2
  d_low  <- d - sqrt((p1 - w1["low"])^2  + (w2["high"] - p2)^2)
  d_high <- d + sqrt((w1["high"] - p1)^2 + (p2 - w2["low"])^2)
  d_low <- unname(max(-1, d_low)); d_high <- unname(min(1, d_high))

rel_ok <- p1 > 0
  rel_change <- if (rel_ok) (p2 - p1) / p1 else NA_real_

cells <- c(x1, n1 - x1, x2, n2 - x2)
  min_cell <- min(cells)
  z_valid <- min_cell >= 5

  p_pool <- (x1 + x2) / (n1 + n2)
  se0 <- sqrt(p_pool * (1 - p_pool) * (1 / n1 + 1 / n2))
  z_stat <- if (se0 > 0) d / se0 else NA_real_
  p_z <- if (!is.na(z_stat)) 2 * stats::pnorm(-abs(z_stat)) else NA_real_

  ct <- tryCatch(
    suppressWarnings(stats::prop.test(c(x1, x2), c(n1, n2), correct = TRUE)),
    error = function(e) NULL)
  chi_stat <- if (!is.null(ct)) unname(ct$statistic) else NA_real_
  chi_df   <- if (!is.null(ct)) unname(ct$parameter) else NA_real_
  p_chi    <- if (!is.null(ct)) ct$p.value else NA_real_

  p_fisher <- NA_real_; fisher_or <- NA_real_
  if (!z_valid) {
    ft <- stats::fisher.test(matrix(c(x1, n1 - x1, x2, n2 - x2),
                                    nrow = 2, byrow = TRUE))
    p_fisher <- ft$p.value
    fisher_or <- unname(ft$estimate)
  }

  if (z_valid) {
    p_primary <- p_z
    test_used <- "two-sample proportion z-test"
  } else {
    p_primary <- p_fisher
    test_used <- "Fisher&#x27;s exact test"
  }
  significant <- !is.na(p_primary) && p_primary < 0.05
  verdict_label <- if (significant) "Significant difference" else "No significant difference"

abs_pp <- abs(d) * 100
  magnitude_word <- if (abs_pp < 1) "small" else if (abs_pp < 5) "modest" else "sizeable"
  practical_note <- if (significant) {
    paste0(
      "Statistical significance measures detectability, not importance: the observed gap is ",
      fmt_num(abs_pp, 1), " percentage points",
      if (rel_ok) paste0(" (a relative change of ", fmt_pct(abs(rel_change)),
                         if (rel_change >= 0) " higher" else " lower",
                         " for ", l2, " vs ", l1, ")") else "",
      " — a ", magnitude_word, " gap in absolute terms. Whether a ",
      fmt_num(abs_pp, 1), "-point shift in ", outcome_h,
      " matters is a business judgment about stakes and volume, not a statistical one."
    )
  } else {
    paste0(
      "No significant difference is NOT proof the rates are equal — it means the data ",
      "cannot distinguish the observed gap of ", fmt_num(abs_pp, 1),
      " percentage points from sampling noise. The Newcombe 95% interval on the difference(",
      fmt_num(d_low * 100, 2), " to ", fmt_num(d_high * 100, 2),
      " percentage points) shows the range of true differences still compatible with this data."
    )
  }

  cross_check_note <- if (!is.na(p_z) && !is.na(p_chi)) {
    agree <- (p_z < 0.05) == (p_chi < 0.05)
    if (agree) {
      paste0("The continuity-corrected chi-square cross-check agrees with the z-test verdict(p = ",
             fmt_p(p_chi), " vs p = ", fmt_p(p_z), ").")
    } else {
      paste0("Caution: the continuity-corrected chi-square(p = ", fmt_p(p_chi),
             ") and the z-test(p = ", fmt_p(p_z),
             ") land on opposite sides of the 0.05 line — the evidence is borderline and should not be over-read.")
    }
  } else ""

metrics <- list(
    `Observations` = final_rows,
    `Rate` = paste0(l1, " ", fmt_pct(p1), " vs ", l2, " ", fmt_pct(p2)),
    `Difference(pp)` = round(d * 100, 2),
    `P-value` = fmt_p(p_primary),
    `Verdict` = verdict_label,
    `Test Used` = test_used
  )

  json_output <- list(
    answer = paste0(
      "Comparison of ", success_label, " rates in ", outcome_h, " between the two ",
      group_h, " groups(", format(final_rows, big.mark = ","), " rows): ",
      l1, " ", fmt_pct(p1), " (Wilson 95% CI ", fmt_pct(w1["low"]), " to ",
      fmt_pct(w1["high"]), ", n=", format(n1, big.mark = ","), ") vs ",
      l2, " ", fmt_pct(p2), " (", fmt_pct(w2["low"]), " to ", fmt_pct(w2["high"]),
      ", n=", format(n2, big.mark = ","), "). Absolute difference ",
      fmt_num(d * 100, 2), " percentage points(Newcombe 95% CI ",
      fmt_num(d_low * 100, 2), " to ", fmt_num(d_high * 100, 2),
      " percentage points). Verdict by the ", test_used, ": ",
      if (significant) "the rates differ beyond chance" else
        "no statistically significant difference was detected",
      " (p = ", fmt_p(p_primary), ").",
      if (success_flagged) paste0(" Note: ", success_note) else ""
    ),
    cards = lapply(
      c("tldr", "overview", "preprocessing", "rates_chart",
        "test_table", "group_summary", "methods"),
      function(cid) list(id = cid, metrics = metrics)
    )
  )

  list(
    initial_rows = initial_rows, final_rows = final_rows,
    rows_removed = rows_removed, n_na_rows = n_na_rows,
    outcome_h = outcome_h, group_h = group_h,
    l1 = l1, l2 = l2,
    success_label = success_label, failure_label = failure_label,
    success_flagged = success_flagged, success_note = success_note,
    n1 = n1, n2 = n2, x1 = x1, x2 = x2, p1 = p1, p2 = p2,
    w1 = w1, w2 = w2,
    d = d, d_low = d_low, d_high = d_high,
    rel_change = rel_change, rel_ok = rel_ok,
    min_cell = min_cell, z_valid = z_valid,
    z_stat = z_stat, p_z = p_z,
    chi_stat = chi_stat, chi_df = chi_df, p_chi = p_chi,
    p_fisher = p_fisher, fisher_or = fisher_or,
    p_primary = p_primary, test_used = test_used,
    significant = significant, verdict_label = verdict_label,
    practical_note = practical_note, cross_check_note = cross_check_note,
    dropped_groups_df = dropped_groups_df,
    rates_df = rates_df, test_df = test_df,
    group_summary_df = group_summary_df, methods_df = methods_df,
    metrics = metrics, json_output = json_output
  )
}