Group Comparison

The code that produced every figure in this report, exactly as it ran. Fingerprint 92f53d27727c5cfa. The same code on the same data gives the same report.

`standard_group_comparison_v2` <- function(pf) {
  `%||%` <- function(a, b) if (!is.null(a)) a else b
  compact <- function(l) l[!vapply(l, function(x) is.null(x) || (length(x) == 1 && is.na(x)), logical(1))]
  #' Readable figures (LAT-3181, as LAT-3180): whole numbers from a thousand up, one decimal from a hundred, two from
  #' one, three significant figures below one. A cell carries what the value needs, not what R prints.
  tidy <- function(x) {
    x <- as.numeric(x)
    ifelse(is.na(x), NA_real_,
      ifelse(abs(x) >= 1000, round(x, 0),
        ifelse(abs(x) >= 100, round(x, 1),
          ifelse(abs(x) >= 1, round(x, 2), signif(x, 3)))))
  }
  #' A p-value of exactly 0 is double-precision UNDERFLOW, not certainty, and "p = 0"
  #' reached a customer's sentence verbatim (LAT-3105 review). Report the limit instead.
  P_FLOOR <- 2e-16
  p_out <- function(p) { p <- as.numeric(p); ifelse(is.na(p), NA_real_, ifelse(p < P_FLOOR, P_FLOOR, signif(p, 4))) }
  p_text <- function(p) if (is.na(p)) "could not be computed" else if (p < P_FLOOR) "< 2e-16" else paste0("= ", format(signif(p, 3)))
  #' P-VALUES BELOW 0.0001 LEAVE AS A FLOOR (LAT-3181). The results serialize at four decimal digits, which rounds a p of
  #' 1.4e-05 to 0 and 6e-05 up to 0.0001; a table printed "p-value 0". 1e-12 survives the serializer and the mapper shows
  #' any p under 0.0001 as "<0.0001", which is what the reader should see. Table and tile cells only; the answer keeps p.
  p_cell <- function(p) { p <- as.numeric(p); ifelse(is.na(p), NA_real_, ifelse(p < 1e-4, 1e-12, signif(p, 3))) }
  #' How many pairwise rows the TABLE shows. The significant-pair COUNT is over every
  #' pair tested, never over this slice.
  PAIRWISE_SHOWN <- 15L
  inputs <- pf$taskList$inputs
  params <- inputs$module_parameters %||% list()
  # THE QUESTION this tool answers: the customer's objective, verbatim, when given.
  question <- (inputs$userContext %||% list())$objective %||%
    "Does the outcome differ between the groups, by how much, and which groups differ?"

  #' ## Column mapping
  #' The customer maps one numeric `outcome` and one `group` column. Every other
  #' column of the file is excluded by construction and named as such in the
  #' method: a comparison of one outcome across groups uses nothing else.
  col_map <- inputs$column_mapping %||% list()
  raw <- inputs$dataset
  raw_names <- if (is.data.frame(raw)) names(raw) else if (is.list(raw) && length(raw)) names(raw[[1]]) else character(0)
  unmapped <- setdiff(raw_names, as.character(unlist(col_map)))
  df <- renderObject.taskFunction.init(inputs, col_map)   # df has SEMANTIC names
  human <- function(sem) {
    v <- col_map[[sem]]
    if (is.null(v) || !nzchar(as.character(v))) sem else as.character(v)
  }
  outcome_name <- human("outcome"); group_name <- human("group")

  #' ## Parameters
  #' `max_groups`: the number of largest groups kept before the rest are folded
  #' into "Other" (default 8, between 2 and 12).
  max_groups <- suppressWarnings(as.integer(params$max_groups %||% 8L))
  if (is.na(max_groups) || max_groups < 2 || max_groups > 12) stop("module_parameters$max_groups must be an integer between 2 and 12")

  #' ## Data preparation
  #' The outcome must be numeric (95% rule); rows with no outcome are dropped.
  #' Blank groups become "Missing"; groups with fewer than 3 rows are dropped
  #' and named; beyond `max_groups` levels the smallest are folded into "Other".
  n_in <- nrow(df)
  if (!"outcome" %in% names(df)) stop("column_mapping must map an 'outcome' column (the numeric value to compare)")
  if (!"group" %in% names(df)) stop("column_mapping must map a 'group' column (which group each row belongs to)")
  v <- df$outcome
  if (!is.numeric(v)) {
    ch <- as.character(v); non_blank <- !is.na(ch) & trimws(ch) != ""
    conv <- suppressWarnings(as.numeric(ch))
    if (sum(non_blank) == 0 || sum(!is.na(conv[non_blank])) < 0.95 * sum(non_blank))
      stop(sprintf("The outcome column '%s' is not numeric: fewer than 95%% of its values parse as numbers. Pick a numeric column to compare.", outcome_name))
    v <- conv
  }
  g <- as.character(df$group); g[is.na(g) | trimws(g) == ""] <- "Missing"
  keep <- !is.na(v); n_na_outcome <- sum(!keep)
  y <- as.numeric(v[keep]); g <- g[keep]
  if (length(y) == 0) stop(sprintf("No rows with a usable numeric value in '%s' remained after cleaning.", outcome_name))

  dropped_groups <- character(0)
  tab <- table(g); small <- names(tab)[tab < 3]
  if (length(small)) { dropped_groups <- paste0(small, " (n = ", as.integer(tab[small]), ")"); sel <- !(g %in% small); y <- y[sel]; g <- g[sel] }
  lumped <- character(0)
  tab <- sort(table(g), decreasing = TRUE)
  if (length(tab) > max_groups) { lumped <- setdiff(names(tab), names(tab)[seq_len(max_groups)]); g[g %in% lumped] <- "Other" }
  tab <- table(g); small2 <- names(tab)[tab < 3]
  if (length(small2)) { dropped_groups <- c(dropped_groups, paste0(small2, " (n = ", as.integer(tab[small2]), ")")); sel <- !(g %in% small2); y <- y[sel]; g <- g[sel] }
  gf <- factor(g); k <- nlevels(gf); n_used <- length(y)
  if (k < 2) stop(sprintf("Group comparison needs at least 2 groups in '%s' with 3 or more rows each; only %d usable group(s) remained after cleaning.", group_name, k))
  if (n_used < 10) stop(sprintf("Only %d usable rows remained; at least 10 are needed to compare groups.", n_used))
  if (isTRUE(var(y) == 0)) stop(sprintf("The outcome '%s' has no variation at all; there is nothing to compare.", outcome_name))
  levels_ <- levels(gf)

  #' ## Per-group summary with 95% confidence intervals on the mean
  summary_df <- do.call(rbind, lapply(levels_, function(l) {
    x <- y[gf == l]; n <- length(x); m <- mean(x); s <- sd(x)
    half <- if (!is.na(s) && s > 0 && n > 1) qt(0.975, n - 1) * s / sqrt(n) else 0
    data.frame(group = l, n = n, mean = tidy(m), sd = tidy(if (is.na(s)) 0 else s), median = tidy(median(x)),
               ci_low = tidy(m - half), ci_high = tidy(m + half), stringsAsFactors = FALSE)
  }))
  rownames(summary_df) <- NULL
  means_df <- summary_df[, c("group", "mean", "ci_low", "ci_high")]
  top_group <- summary_df$group[which.max(summary_df$mean)]
  bottom_group <- summary_df$group[which.min(summary_df$mean)]

  #' ## Assumption diagnostics
  #' Shapiro-Wilk on the one-way residuals and the share of residuals beyond 3 IQR
  #' decide whether the rank-based test leads. shapiro.test refuses above 5 000 values,
  #' so beyond that the test runs on a seeded sample of 5 000 and SAYS SO: the row used
  #' to vanish silently while the report promised the reader could see whether normality
  #' held (LAT-3105 review).
  dat <- data.frame(y = y, gf = gf)
  fit <- aov(y ~ gf, data = dat); res <- residuals(fit)
  shapiro_p <- NA_real_; shapiro_n <- 0L; shapiro_sampled <- FALSE
  if (n_used >= 3) {
    rs <- res
    if (length(rs) > 5000) { set.seed(42); rs <- rs[sort(sample.int(length(rs), 5000))]; shapiro_sampled <- TRUE }
    shapiro_n <- length(rs)
    shapiro_p <- tryCatch(shapiro.test(rs)$p.value, error = function(e) NA_real_)
  }
  shapiro_label <- if (shapiro_sampled) sprintf("Shapiro-Wilk normality of residuals (%s sampled of %s)", format(shapiro_n, big.mark = ","), format(n_used, big.mark = ",")) else "Shapiro-Wilk normality of residuals"
  iqr <- IQR(res); qs <- quantile(res, c(0.25, 0.75), names = FALSE)
  out_frac <- if (is.na(iqr) || iqr == 0) 0 else mean(res < qs[1] - 3 * iqr | res > qs[2] + 3 * iqr)
  nonparam_preferred <- (!is.na(shapiro_p) && shapiro_p < 0.01) || out_frac > 0.01

  #' ## The test battery
  #' Two groups: Welch t (primary), Student t, Mann-Whitney U, Cohen's d, and
  #' the Welch interval on the difference. Three or more: one-way ANOVA, Welch
  #' ANOVA, Kruskal-Wallis, eta squared, and Tukey HSD across all pairs (the table
  #' shows the largest by absolute difference; the counts cover every pair). The
  #' rank-based test leads when the residuals are clearly non-normal or heavy
  #' with outliers.
  tests <- list()
  add_test <- function(test, statistic, p_value, effect_size, effect_measure) {
    tests[[length(tests) + 1]] <<- data.frame(test = test, statistic = round(statistic, 2), p_value = p_cell(p_value),
      effect_size = signif(effect_size, 3), effect_measure = effect_measure, stringsAsFactors = FALSE)
  }
  pairwise_df <- NULL; n_pairs_tested <- 0L; n_sig_pairs <- 0L
  effect_size <- NA_real_; effect_label <- ""; primary_test <- NA_character_; primary_p <- NA_real_
  if (k == 2) {
    l1 <- levels_[1]; l2 <- levels_[2]; x1 <- y[gf == l1]; x2 <- y[gf == l2]
    n1 <- length(x1); n2 <- length(x2); s1 <- sd(x1); s2 <- sd(x2)
    sp <- sqrt(((n1 - 1) * s1^2 + (n2 - 1) * s2^2) / (n1 + n2 - 2))
    cohens_d <- if (!is.na(sp) && sp > 0) (mean(x1) - mean(x2)) / sp else NA_real_
    welch <- tryCatch(t.test(x1, x2), error = function(e) NULL)
    student <- tryCatch(t.test(x1, x2, var.equal = TRUE), error = function(e) NULL)
    mw <- tryCatch(suppressWarnings(wilcox.test(x1, x2)), error = function(e) NULL)
    rank_biserial <- if (!is.null(mw)) 2 * unname(mw$statistic) / (n1 * n2) - 1 else NA_real_
    if (!is.null(welch)) add_test("Welch t-test (unequal variances)", unname(welch$statistic), welch$p.value, cohens_d, "Cohen's d")
    if (!is.null(student)) add_test("Student t-test (equal variances)", unname(student$statistic), student$p.value, cohens_d, "Cohen's d")
    if (!is.null(mw)) add_test("Mann-Whitney U", unname(mw$statistic), mw$p.value, rank_biserial, "rank-biserial r")
    if (!is.na(shapiro_p)) add_test(shapiro_label, NA_real_, shapiro_p, NA_real_, "")
    else add_test("Shapiro-Wilk normality of residuals: could not be computed", NA_real_, NA_real_, NA_real_, "")
    dmean <- mean(x1) - mean(x2)
    ci <- if (!is.null(welch)) as.numeric(welch$conf.int) else if (!is.null(student)) as.numeric(student$conf.int) else c(dmean, dmean)
    pw_p <- if (!is.null(welch)) welch$p.value else if (!is.null(student)) student$p.value else NA_real_
    pairwise_df <- data.frame(comparison = paste0(l1, " - ", l2), difference = tidy(dmean), ci_low = tidy(ci[1]),
                              ci_high = tidy(ci[2]), adj_p = p_cell(pw_p), stringsAsFactors = FALSE)
    n_pairs_tested <- 1L
    n_sig_pairs <- sum(!is.na(pairwise_df$adj_p) & pairwise_df$adj_p < 0.05)
    effect_size <- cohens_d; effect_label <- "Cohen's d"
    if (nonparam_preferred && !is.null(mw)) { primary_test <- "Mann-Whitney U"; primary_p <- mw$p.value }
    else if (!is.null(welch)) { primary_test <- "Welch t-test"; primary_p <- welch$p.value }
    else if (!is.null(student)) { primary_test <- "Student t-test"; primary_p <- student$p.value }
    else if (!is.null(mw)) { primary_test <- "Mann-Whitney U"; primary_p <- mw$p.value }
    else stop(sprintf("No comparison test could be computed for '%s' between the two %s groups (the data may be essentially constant).", outcome_name, group_name))
  } else {
    a_tab <- summary(fit)[[1]]; ss_b <- a_tab[["Sum Sq"]][1]; ss_w <- a_tab[["Sum Sq"]][2]
    eta2 <- if (!is.na(ss_b) && !is.na(ss_w) && (ss_b + ss_w) > 0) ss_b / (ss_b + ss_w) else NA_real_
    f_stat <- a_tab[["F value"]][1]; anova_p <- a_tab[["Pr(>F)"]][1]
    welch_a <- tryCatch(oneway.test(y ~ gf, data = dat), error = function(e) NULL)
    kw <- tryCatch(kruskal.test(y ~ gf, data = dat), error = function(e) NULL)
    if (!is.na(anova_p)) add_test("One-way ANOVA", f_stat, anova_p, eta2, "eta squared")
    if (!is.null(welch_a)) add_test("Welch ANOVA (unequal variances)", unname(welch_a$statistic), welch_a$p.value, eta2, "eta squared")
    if (!is.null(kw)) add_test("Kruskal-Wallis", unname(kw$statistic), kw$p.value, NA_real_, "")
    if (!is.na(shapiro_p)) add_test(shapiro_label, NA_real_, shapiro_p, NA_real_, "")
    else add_test("Shapiro-Wilk normality of residuals: could not be computed", NA_real_, NA_real_, NA_real_, "")
    tk <- tryCatch(TukeyHSD(fit)$gf, error = function(e) NULL)
    if (!is.null(tk) && nrow(tk) > 0) {
      # TukeyHSD labels a pair "B-A"; relabel from the known levels so a hyphen inside a
      # group name cannot be mistaken for the separator, and the two branches read alike.
      pair_label <- function(rn) {
        for (a in levels_) for (b in levels_) if (a != b && rn == paste0(b, "-", a)) return(paste0(b, " - ", a))
        rn
      }
      pairwise_all <- data.frame(comparison = vapply(rownames(tk), pair_label, character(1), USE.NAMES = FALSE),
                                difference = tidy(as.numeric(tk[, "diff"])),
                                ci_low = tidy(as.numeric(tk[, "lwr"])), ci_high = tidy(as.numeric(tk[, "upr"])),
                                adj_p = p_cell(as.numeric(tk[, "p adj"])), stringsAsFactors = FALSE)
      pairwise_all <- pairwise_all[!is.na(pairwise_all$difference), , drop = FALSE]
      pairwise_all <- pairwise_all[order(-abs(pairwise_all$difference)), , drop = FALSE]
      rownames(pairwise_all) <- NULL
      #' COUNT OVER EVERY PAIR, THEN TRUNCATE THE TABLE. Counting the truncated frame made
      #' n_significant_pairs incapable of exceeding PAIRWISE_SHOWN (measured at 12 groups:
      #' it reported 15 where 59 pairs differ) and that number leads the verdict card.
      n_pairs_tested <- nrow(pairwise_all)
      n_sig_pairs <- sum(!is.na(pairwise_all$adj_p) & pairwise_all$adj_p < 0.05)
      pairwise_df <- head(pairwise_all, PAIRWISE_SHOWN)
      rownames(pairwise_df) <- NULL
    }
    effect_size <- eta2; effect_label <- "eta squared"
    if (nonparam_preferred && !is.null(kw)) { primary_test <- "Kruskal-Wallis"; primary_p <- kw$p.value }
    else if (!is.null(welch_a) && !is.na(welch_a$p.value)) { primary_test <- "Welch ANOVA"; primary_p <- welch_a$p.value }
    else if (!is.na(anova_p)) { primary_test <- "One-way ANOVA"; primary_p <- anova_p }
    else if (!is.null(kw)) { primary_test <- "Kruskal-Wallis"; primary_p <- kw$p.value }
    else stop(sprintf("No comparison test could be computed for '%s' across the %s groups (the data may be essentially constant).", outcome_name, group_name))
  }
  tests_df <- do.call(rbind, tests); rownames(tests_df) <- NULL
  largest_pair <- if (!is.null(pairwise_df) && nrow(pairwise_df)) pairwise_df$comparison[1] else NA_character_
  largest_difference <- if (!is.null(pairwise_df) && nrow(pairwise_df)) pairwise_df$difference[1] else NA_real_

  #' ## The spread: the customer's own outcome by group, sampled to 2 000 rows
  set.seed(42)
  sidx <- if (n_used > 2000) sort(sample.int(n_used, 2000)) else seq_len(n_used)
  spread_df <- data.frame(round(y[sidx], 4), as.character(gf[sidx]), stringsAsFactors = FALSE)
  names(spread_df) <- c(outcome_name, group_name)

  #' ## Method text and the answer
  excluded <- character(0); why <- character(0)
  if (length(unmapped)) { excluded <- unmapped }
  method <- paste0(
    if (k == 2) "Welch t-test, Student t-test and Mann-Whitney U with Cohen's d"
    else sprintf("one-way ANOVA, Welch ANOVA and Kruskal-Wallis with eta squared and Tukey HSD across all %d pairs", n_pairs_tested),
    " comparing ", outcome_name, " across ", k, " groups of ", group_name, " (", paste(levels_, collapse = ", "), "): ",
    n_used, " rows used of ", n_in, " in (", n_na_outcome, " dropped for a missing outcome",
    if (length(dropped_groups)) paste0("; groups dropped for fewer than 3 rows: ", paste(dropped_groups, collapse = ", ")) else "",
    if (length(lumped)) paste0("; ", length(lumped), " smallest groups folded into Other beyond max_groups = ", max_groups) else "",
    ")",
    # LAT-3181: one reason for every unmapped column, said once (it was repeated per column, three times on one card)
    if (length(excluded)) paste0("; not used: ", paste(excluded, collapse = ", "), " (a comparison of one outcome across groups uses no other column)") else "",
    "; primary test ", primary_test, if (nonparam_preferred) " (rank-based, because the residuals are clearly non-normal or heavy with outliers)" else "",
    "; 95% confidence intervals on each group mean (t) and on each pairwise difference (",
    if (k == 2) "Welch" else "Tukey HSD, family-wise adjusted", "); p-values are two-sided",
    if (k > 2) "; pairwise p-values are Tukey-adjusted" else "",
    # With no testable pair the counts are both zero, and "0 of 0 pairwise comparisons
    # differ" is a sentence about nothing. Say what happened instead; the pairwise place
    # carries the same fact as its dropped reason.
    if (n_pairs_tested > 0) sprintf("; %d of %d pairwise comparisons differ at p < 0.05", n_sig_pairs, n_pairs_tested)
    else "; no pairwise comparison could be computed, so the result rests on the overall test alone",
    if (n_pairs_tested > PAIRWISE_SHOWN) sprintf(", and the pairwise table lists the %d largest by absolute difference while that count covers all %d", PAIRWISE_SHOWN, n_pairs_tested) else "",
    if (shapiro_sampled) sprintf("; the normality test ran on %s residuals sampled from %s", format(shapiro_n, big.mark = ","), format(n_used, big.mark = ",")) else "",
    "; a p-value below 2e-16 is reported as < 2e-16, the limit of double precision", ".")
  assumptions <- list(
    "Rows are independent observations; repeated measurements of the same unit belong in a paired or repeated-measures design instead.",
    "The t-tests and ANOVA assume roughly normal residuals within groups; the rank-based results are the check when that fails.",
    "A difference between groups is not caused by the grouping; the groups may differ in other ways too.",
    "Groups with fewer than 3 rows were dropped and the smallest beyond max_groups were folded into Other, so a small group's difference is not tested on its own.",
    if (n_pairs_tested > 0)
      sprintf("%d of %d pairwise comparisons differ at p < 0.05%s.", n_sig_pairs, n_pairs_tested,
              if (n_pairs_tested > PAIRWISE_SHOWN) sprintf(" The table shows only the %d largest by absolute difference", PAIRWISE_SHOWN) else "")
    else "No pairwise comparison could be computed for these groups, so which specific groups differ is not established here; the overall test above is what the result rests on.")
  direction <- paste0(top_group, " highest, ", bottom_group, " lowest")
  statement <- sprintf("%s differs across %s: %s averages %s and %s averages %s; the largest pairwise difference is %s (%s, 95%% interval %s to %s); %s p %s, %s = %s.",
    outcome_name, group_name, top_group, format(summary_df$mean[summary_df$group == top_group], big.mark = ","),
    bottom_group, format(summary_df$mean[summary_df$group == bottom_group], big.mark = ","),
    if (is.na(largest_pair)) "not available" else largest_pair,
    if (is.na(largest_difference)) "NA" else format(largest_difference, big.mark = ","),
    if (is.null(pairwise_df) || !nrow(pairwise_df)) "NA" else format(pairwise_df$ci_low[1], big.mark = ","),
    if (is.null(pairwise_df) || !nrow(pairwise_df)) "NA" else format(pairwise_df$ci_high[1], big.mark = ","),
    primary_test, p_text(primary_p), effect_label, format(round(effect_size, 3)))
  answer <- compact(list(effect_size = round(effect_size, 4), effect_label = effect_label, primary_test = primary_test,
                         p_value = p_out(primary_p), n_groups = k, top_group = top_group, bottom_group = bottom_group,
                         largest_pair = largest_pair, largest_difference = largest_difference,
                         n_significant_pairs = n_sig_pairs, n_pairs_tested = n_pairs_tested, n = n_used))

  # ── Results: one entry per place ─────────────────────────────────────────────
  #' ## Summary metrics and assumption checks (LAT-3138): the figures that summarise the
  #' whole analysis as one metrics row, and one verdict per assumption of the method,
  #' each with the statistic behind it. holds / strained / violated are rules of thumb a
  #' reader can re-derive from the statistic shown beside them. Base R throughout.
  verdict_p <- function(p, soft = 0.05, hard = 0.001) if (is.na(p)) "unknown" else if (p >= soft) "holds" else if (p >= hard) "strained" else "violated"
  fmt_p <- function(p) if (is.na(p)) "" else if (p < 1e-4) "<0.0001" else as.character(signif(p, 3))
  summary_vals <- list(effect_size = signif(effect_size, 3), p_value = p_cell(primary_p), n_groups = k, largest_difference = largest_difference,
                       n_significant_pairs = n_sig_pairs, n_pairs_tested = n_pairs_tested, n = n_used)
  bart_p <- tryCatch(bartlett.test(y ~ gf, data = dat)$p.value, error = function(e) NA_real_)
  min_g <- min(summary_df$n); size_ratio <- max(summary_df$n) / max(1, min_g)
  checks_df <- data.frame(
    check = c("Residuals are normal", "Equal spread across groups", "Enough rows per group", "Balanced group sizes", "Few extreme residuals"),
    statistic = c(if (is.na(shapiro_p)) "Shapiro-Wilk not run" else "Shapiro-Wilk on the one-way residuals",
                  "Bartlett's test of equal variance",
                  paste0("smallest group n = ", min_g),
                  paste0("largest / smallest group = ", round(size_ratio, 1)),
                  paste0(round(100 * out_frac, 1), "% of residuals beyond 3 IQR")),
    p_value = c(fmt_p(shapiro_p), fmt_p(bart_p), "", "", ""),
    verdict = c(if (is.na(shapiro_p)) "unknown" else if (shapiro_p >= 0.05) "holds" else if (shapiro_p >= 0.001) "strained" else "violated",
                verdict_p(bart_p),
                if (min_g >= 20) "holds" else if (min_g >= 5) "strained" else "violated",
                if (size_ratio <= 3) "holds" else if (size_ratio <= 10) "strained" else "violated",
                if (out_frac < 0.01) "holds" else if (out_frac < 0.05) "strained" else "violated"),
    note = c("when it fails the rank-based test leads, which this tool already arranges",
             "Welch's versions do not need equal spread; the plain ANOVA and t-test do",
             "a small group has a wide interval on its mean",
             "very unequal sizes make the pooled tests sensitive to the large group",
             "a few extreme rows can drive a mean difference"),
    stringsAsFactors = FALSE)

  results <- list()
  #' The verdict and the headline are NOT places of a library tool (LAT-3130): a
  #' library tool supplies data objects; the answer is written by the last mile,
  #' which is the first stage that reads the objects together.
  #' ## summary_metrics: the whole analysis at a glance (LAT-3138)
  results$summary_metrics <- place_metric(summary_vals, lead = "effect_size", place = "summary_metrics")
  #' ## assumption_checks: a verdict per assumption (a `checks` place, table-shaped)
  results$assumption_checks <- place_table(checks_df, place = "assumption_checks")
  #' ## group_means: each group's mean with its 95% interval, as bars with error bars
  results$group_means <- place_comparison(means_df, category = "group", value = "mean", low = "ci_low", high = "ci_high", place = "group_means")
  #' ## group_spread: the CUSTOMER's outcome column split by the CUSTOMER's group column
  results$group_spread <- place_distribution(spread_df, x = outcome_name, series = group_name, draws = "dataset", place = "group_spread")
  #' ## pairwise_interval: every pairwise difference between its bounds.
  #' A CONDITIONAL PLACE IS WRITTEN EITHER WAY (LAT-3102). An absent entry is a refusal the
  #' mapper logs at ERROR on every run, and it cannot tell a place the tool meant to skip
  #' from one it died before writing. The reason is what the reader sees instead of the card.
  if (!is.null(pairwise_df) && nrow(pairwise_df)) {
    results$pairwise_interval <- place_interval(pairwise_df, term = "comparison", value = "difference", low = "ci_low", high = "ci_high", place = "pairwise_interval")
  } else {
    results$pairwise_interval <- place_dropped(sprintf(
      "no pairwise comparison could be computed across the %d groups of %s, so there is no per-pair difference to show; the overall test above still stands",
      k, group_name), place = "pairwise_interval")
  }
  #' ## test_results: every test with its statistic, p and effect size
  results$test_results <- place_table(tests_df, place = "test_results")
  #' ## group_summary: n, mean, sd, median and the interval per group
  results$group_summary <- place_table(summary_df, place = "group_summary")
  #' ## comparison_method: how it was done
  results$comparison_method <- list(kind = "metric", values = list(
    method = method, n_in = n_in, n_used = n_used, excluded = as.list(unname(excluded)), assumptions = assumptions,
    # LAT-3181: the method card's "rows · x → y" line reads these; unset, it printed a bare arrow
    x_column = group_name, y_column = outcome_name),
    value_order = list("n_used", "n_in"))

  objects <- list()   # filled by the object layer, not here
  list(answer = answer, method = method, n = n_used, results = results, objects = objects,
       json_output = list(answer = answer, method = method, n = n_used))
}