Paired Comparison (McNemar, Paired t)
Shows whether the same subjects changed between two measurements: a paired t-test and Wilcoxon signed-rank for numeric before and after values, or McNemar's test for two yes/no verdicts on the same cases, with the change, its range and the pairs that moved.
RUN DATE · 15 September 2026
DATA · 120 rows
Did our employees' assessment scores change after the training program, and by how much?
- SummaryHow many pairs, and how much they changed.
- The change with its rangeThe change between the two measurements with its likely range.
- Which way the pairs movedHow many pairs went each way.
- Every pairEach subject's first measurement against its second.
- The table of pairsHow many subjects had each combination of the two verdicts.
- The testsEach test of the change with its p-value and what it answers.
- The pairs that changed mostThe subjects with the largest changes, or those whose verdict changed.
- What the results rely onEach condition the comparison depends on, and whether it holds.
- How it was doneThe method, the data used, and what to keep in mind.
What changed
Assessment scores rise after training program
Scores rose clearly after training, with mean and median change both well above zero.
The mean and median change rows both sit entirely above zero, with intervals that do not overlap it.
Assessment scores rise after training program
Both the mean change and the median change point upward, with their intervals entirely clear of zero. The mean and median estimates agree in direction and magnitude, showing consistent improvement across employees. All five assumption checks hold, so the interval is reliable and the rise is not attributable to outliers or incomplete data.
The mean and median change rows both sit entirely above zero, with intervals that do not overlap it.
Assessment scores increased for most employees
Scores rose for most employees and fell for fewer, showing clear upward movement after training.
The Increased bar stands taller than Decreased, showing which direction dominated the pairs.
Assessment scores increased for most employees
The Increased category holds substantially more pairs than Decreased, indicating a clear directional shift upward in scores after the program. The Decreased bar is notably smaller, and unchanged pairs are minimal, so the movement is not mixed. All assumption checks hold, confirming the pattern is reliable. The tests card will show whether this upward movement exceeds what chance alone would produce.
The Increased bar stands taller than Decreased, showing which direction dominated the pairs.
How the pairs moved
Most employees improved, some declined sharply
Most scores rose after training, but improvement varied widely and some employees scored lower.
Points above the diagonal show gains; most cluster there but several sit well below it.
Most employees improved, some declined sharply
The majority of points sit above the diagonal, indicating that most employees scored higher after training than before. However, the scatter is loose, with some employees showing substantial gains while others declined noticeably, particularly a few who fell well below the diagonal. The pattern holds across the score range without a systematic difference between low and high starting values. This mixed but predominantly upward movement means the training lifted performance overall, yet the wide variation suggests it worked very differently for different employees.
Points above the diagonal show gains; most cluster there but several sit well below it.
not shown for this data
the two measurements are numeric, so there is no yes/no table of pairs; the scatter shows every pair
The numbers
Assessment scores rose after training program
Scores rose clearly after training, confirmed across all three statistical tests with p-values below significance threshold.
The sign test shows upward movement in most pairs, though its p-value is notably larger than the parametric tests because it disregards how much each score changed.
Assessment scores rose after training program
The paired t-test and Wilcoxon signed-rank test both show p-values well below the threshold, indicating the mean change in scores differs from zero. The sign test also confirms more pairs moved upward than downward, though its p-value is larger by design because it ignores the magnitude of changes. All assumption checks hold, so the evidence for improvement is clear and reliable.
The sign test shows upward movement in most pairs, though its p-value is notably larger than the parametric tests because it disregards how much each score changed.
The numbers
Largest gains cluster at top, one score fell
Most improved subjects gained substantially; one employee's score fell sharply while others rose.
E056 is the only subject whose score fell; all others in this table rose, breaking the uniform upward pattern.
Largest gains cluster at top, one score fell
E007 and E021 led with the largest gains, followed by a cluster of employees with strong increases. E056 stands out as the only subject whose score fell notably, moving opposite to the prevailing direction. The gains across most subjects are clear and consistent, with no single pair dominating the overall pattern.
E056 is the only subject whose score fell; all others in this table rose, breaking the uniform upward pattern.
Assumptions and method
All five checks hold
All five assumption checks hold, so nothing here limits how far the results can be trusted.
Holding: enough pairs, changes roughly normal, no single pair dominates, few unchanged pairs, pairs complete.
All five checks hold
The checks that hold: enough pairs, changes roughly normal, no single pair dominates, few unchanged pairs, pairs complete.
Holding: enough pairs, changes roughly normal, no single pair dominates, few unchanged pairs, pairs complete.
Paired comparison of 118 subjects measured as Score Before and then Score After; change is Score After minus Score Before; paired t-test with a 95% interval for the mean change, Wilcoxon signed-rank with a Hodges-Lehmann median change and its interval, and a sign test; the headline is the paired t-test; effect size is Cohen's dz (mean change over the standard deviation of the changes); excluded: 2 rows missing a value; not used: Passed After, Passed Before, Team (not mapped).
118 of 120 rows · Score Before → Score After
caveatWithout a comparison group, the change cannot be attributed to training alone; time or practice could explain it.
The analysis paired each employee's Score Before with their Score After, excluding two rows with missing values, and ran a paired t-test as the headline test alongside Wilcoxon and sign tests. All five assumption checks held, confirming the pairs were independent, complete, and the changes roughly normal. However, the method cannot isolate the training program's effect from other factors like time passage, repeated practice, or regression to the mean that could produce the same change without training.
The code behind this report
The code that produced every figure in this report, exactly as it ran. Fingerprint 463a6f4260918463. The same code on the same data gives the same report.
`standard_paired_comparison_v2` <- function(pf) {
`%||%` <- function(a, b) if (!is.null(a)) a else b
#' Readable figures (LAT-3180, LAT-3181): 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)))))
}
#' P-values below 0.0001 leave as text (LAT-3181): the four-decimal serializer rounds 1.4e-05 to 0.
p_text <- function(p) vapply(p, function(q) if (is.na(q)) "" else if (q < 1e-4) "<0.0001" else format(signif(q, 3)), character(1))
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 %||%
"Did the same subjects change between the two measurements, and by how much?"
#' ## Column mapping
#' One row per subject measured twice: `first` (before, or the first rater's verdict) and `second` (after, or the
#' second verdict), and optionally `subject` (who was measured). Semantic names inside; headers live in `col_map`.
col_map <- inputs$column_mapping %||% list()
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)
}
first_name <- human("first"); second_name <- human("second")
for (sem in c("first", "second"))
if (!(sem %in% names(df))) stop(sprintf("column_mapping must map '%s' (%s was not found).", sem, human(sem)))
has_subject <- "subject" %in% names(df)
n_in <- nrow(df)
raw_names <- local({
ds <- inputs$dataset %||% inputs$df
if (is.data.frame(ds)) return(names(ds))
if (is.list(ds) && length(ds) > 0) {
rows <- ds[seq_len(min(length(ds), 50))]
nm <- unique(unlist(lapply(rows, function(r) if (is.list(r)) names(r) else NULL)))
if (length(nm)) return(nm)
if (!is.null(names(ds)) && all(nzchar(names(ds)))) return(names(ds))
}
character(0)
})
mapped_actual <- unique(as.character(unlist(col_map)))
ignored_cols <- setdiff(raw_names, unique(c(mapped_actual, make.names(mapped_actual))))
#' ## Parameters
#' `outcome`: auto (the default), numeric or binary. Auto reads two columns with exactly two distinct values between
#' them (yes/no, pass/fail, 0/1) as binary, and numeric columns with more values as numeric. `positive_level`: which of
#' the two binary values counts as the positive one; blank picks one that reads like yes, pass or true.
outcome_param <- tolower(as.character(params$outcome %||% "auto"))
if (!(outcome_param %in% c("auto", "numeric", "binary"))) stop("module_parameters$outcome must be auto, numeric or binary")
positive_param <- trimws(as.character(params$positive_level %||% ""))
alpha <- 0.05
#' ## Data preparation
#' Values are trimmed; a pair missing either value is excluded and counted. Binary labels that differ only in case
#' (Yes, yes, YES) are one value and the merge is counted.
norm_txt <- function(v) { x <- trimws(as.character(v)); x[is.na(x) | x == "" | tolower(x) %in% c("na", "n/a", "null", "nan")] <- NA; x }
f_raw <- norm_txt(df$first); s_raw <- norm_txt(df$second)
subj_all <- if (has_subject) { l <- trimws(as.character(df$subject)); l[is.na(l) | l == ""] <- paste0("Row ", which(is.na(l) | l == "")); l } else paste0("Row ", seq_len(n_in))
both <- !is.na(f_raw) & !is.na(s_raw)
n_missing <- sum(!both)
f_raw <- f_raw[both]; s_raw <- s_raw[both]; subj <- subj_all[both]
n <- length(f_raw)
num_f <- suppressWarnings(as.numeric(f_raw)); num_s <- suppressWarnings(as.numeric(s_raw))
numeric_ok <- n > 0 && mean(!is.na(num_f)) >= 0.95 && mean(!is.na(num_s)) >= 0.95
folded <- unique(tolower(c(f_raw, s_raw)))
binary_ok <- length(folded) == 2
mode <- if (outcome_param == "numeric") "numeric" else if (outcome_param == "binary") "binary" else if (binary_ok) "binary" else if (numeric_ok) "numeric" else NA
if (is.na(mode)) stop(sprintf("%s and %s are neither numeric nor two values between them (found %d distinct values such as %s). Map two numeric measurements, or two columns holding the same yes/no style verdict.",
first_name, second_name, length(folded), paste(utils::head(folded, 5), collapse = ", ")))
if (mode == "numeric" && !numeric_ok) stop(sprintf("outcome is numeric but fewer than 95%% of %s or %s read as numbers.", first_name, second_name))
if (mode == "binary" && !binary_ok) stop(sprintf("outcome is binary but %s and %s hold %d distinct values between them; McNemar's test needs exactly two (more than two needs the Stuart-Maxwell test).", first_name, second_name, length(folded)))
results <- list()
#' The verdict and the headline are NOT places of a library tool (LAT-3130): the last mile writes them.
if (mode == "numeric") {
keep <- !is.na(num_f) & !is.na(num_s)
n_unreadable <- sum(!keep)
b <- num_f[keep]; a <- num_s[keep]; subj <- subj[keep]; n <- length(b)
if (n < 6) stop(sprintf("Only %d complete pairs of %s and %s; a paired comparison needs at least 6.", n, first_name, second_name))
d <- a - b
tt <- tryCatch(stats::t.test(a, b, paired = TRUE, conf.level = 1 - alpha), error = function(e) NULL)
ww <- tryCatch(suppressWarnings(stats::wilcox.test(a, b, paired = TRUE, conf.int = TRUE, conf.level = 1 - alpha, exact = FALSE)), error = function(e) NULL)
nz <- d[d != 0]
sign_p <- if (length(nz)) stats::binom.test(sum(nz > 0), length(nz), 0.5)$p.value else NA_real_
sd_d <- stats::sd(d); dz <- if (isTRUE(sd_d > 0)) mean(d) / sd_d else NA_real_
shapiro_p <- if (n >= 3 && n <= 5000 && isTRUE(sd_d > 0)) tryCatch(stats::shapiro.test(d)$p.value, error = function(e) NA_real_) else NA_real_
t_p <- if (!is.null(tt)) tt$p.value else NA_real_; w_p <- if (!is.null(ww)) ww$p.value else NA_real_
headline <- if (!is.na(shapiro_p) && shapiro_p < 0.05 && n < 30) "Wilcoxon signed-rank" else "paired t-test"
n_up <- sum(d > 0); n_down <- sum(d < 0); n_flat <- sum(d == 0)
results$summary_metrics <- place_metric(list(pairs = n, mean_change = tidy(mean(d)), median_change = tidy(stats::median(d)),
increased_pct = round(100 * n_up / n, 1), decreased_pct = round(100 * n_down / n, 1), effect_size_dz = if (is.na(dz)) NA_real_ else round(dz, 2)),
lead = "mean_change", place = "summary_metrics")
interval_df <- data.frame(measure = c("Mean change (paired t)", "Median change (Hodges-Lehmann)"),
estimate = tidy(c(mean(d), if (!is.null(ww)) unname(ww$estimate) else NA_real_)),
low = tidy(c(if (!is.null(tt)) tt$conf.int[1] else NA_real_, if (!is.null(ww)) ww$conf.int[1] else NA_real_)),
high = tidy(c(if (!is.null(tt)) tt$conf.int[2] else NA_real_, if (!is.null(ww)) ww$conf.int[2] else NA_real_)), stringsAsFactors = FALSE)
interval_df <- interval_df[!is.na(interval_df$estimate), , drop = FALSE]
results$change_interval <- place_interval(interval_df, term = "measure", value = "estimate", low = "low", high = "high", place = "change_interval")
dir_df <- data.frame(direction = c("Increased", "Decreased", "No change"), pairs = as.integer(c(n_up, n_down, n_flat)), stringsAsFactors = FALSE)
results$change_direction <- place_comparison(dir_df, category = "direction", value = "pairs", place = "change_direction")
set.seed(42)
idx <- if (n > 1000) sort(sample(n, 1000)) else seq_len(n)
sc_df <- data.frame(first = tidy(b[idx]), second = tidy(a[idx]), stringsAsFactors = FALSE)
results$paired_scatter <- place_relationship(sc_df, x = "first", y = "second", place = "paired_scatter")
results$paired_table <- place_dropped("the two measurements are numeric, so there is no yes/no table of pairs; the scatter shows every pair", place = "paired_table")
tests_df <- data.frame(
test = c("Paired t-test", "Wilcoxon signed-rank", "Sign test"),
statistic = tidy(c(if (!is.null(tt)) unname(tt$statistic) else NA_real_, if (!is.null(ww)) unname(ww$statistic) else NA_real_, sum(nz > 0))),
p_value = p_text(c(t_p, w_p, sign_p)),
reading = c("whether the mean change differs from zero", "whether changes lean one way, using ranks (no normality needed)",
sprintf("whether more pairs went up than down, ignoring size (the statistic is the pairs that went up, of %d that changed)", length(nz))), stringsAsFactors = FALSE)
results$tests_table <- place_table(tests_df, place = "tests_table")
o <- order(-abs(d))[seq_len(min(12, n))]
ch_df <- data.frame(subject = subj[o], first = tidy(b[o]), second = tidy(a[o]), change = tidy(d[o]), stringsAsFactors = FALSE)
results$changed_subjects <- place_table(ch_df, place = "changed_subjects")
big <- if (isTRUE(sd_d > 0)) max(abs(d - mean(d))) / sd_d else 0
checks_df <- data.frame(
check = c("Enough pairs", "Changes roughly normal", "No single pair dominates", "Few unchanged pairs", "Pairs complete"),
statistic = c(sprintf("%d complete pairs", n), "Shapiro-Wilk on the changes", sprintf("largest change %s standard deviations from the mean change", format(round(big, 1))),
sprintf("%s%% of pairs unchanged", format(round(100 * n_flat / n, 1))), sprintf("%d of %d rows excluded", as.integer(n_missing + n_unreadable), n_in)),
p_value = c("", p_text(shapiro_p), "", "", ""),
verdict = c(if (n >= 30) "holds" else if (n >= 10) "strained" else "violated",
if (is.na(shapiro_p) || shapiro_p >= 0.05) "holds" else if (n >= 30) "strained" else "violated",
if (big <= 4) "holds" else if (big <= 6) "strained" else "violated",
if (n_flat / n <= 0.2) "holds" else if (n_flat / n <= 0.5) "strained" else "violated",
if ((n_missing + n_unreadable) / n_in <= 0.05) "holds" else if ((n_missing + n_unreadable) / n_in <= 0.15) "strained" else "violated"),
note = c("few pairs leave the mean change with a wide interval",
"the paired t-test assumes roughly normal changes in small samples; the Wilcoxon result does not",
"one extreme pair can move the mean change on its own; the median change resists it",
"many unchanged pairs make rank and sign tests lose information",
"pairs missing a value are left out; if they differ from the rest, the change is biased"),
stringsAsFactors = FALSE)
method <- paste0("Paired comparison of ", n, " subjects measured as ", first_name, " and then ", second_name,
"; change is ", second_name, " minus ", first_name, "; paired t-test with a 95% interval for the mean change, Wilcoxon signed-rank with a Hodges-Lehmann median change and its interval, and a sign test; the headline is the ", headline,
if (headline == "Wilcoxon signed-rank") " because the changes are not normal in a small sample" else "",
"; effect size is Cohen's dz (mean change over the standard deviation of the changes)")
answer <- list(outcome = "numeric", headline_test = headline, mean_change = tidy(mean(d)), median_change = tidy(stats::median(d)),
p_value = p_text(if (headline == "paired t-test") t_p else w_p), dz = if (is.na(dz)) NULL else round(dz, 2), n = n)
excluded <- c(if (n_missing > 0) sprintf("%d row%s missing a value", n_missing, if (n_missing > 1) "s" else ""),
if (n_unreadable > 0) sprintf("%d pair%s not read as numbers", n_unreadable, if (n_unreadable > 1) "s" else ""))
assumptions <- list(
"Each row is the same subject measured twice, in the same units; different subjects in the two columns break the pairing.",
"Pairs are independent of each other.",
"A change between two measurements is not by itself caused by whatever happened between them: without a comparison group it could be time, practice or regression to the mean.",
"The paired t-test assumes roughly normal changes when there are few pairs; the Wilcoxon signed-rank test does not.")
} else {
fold <- function(x) tolower(x)
levs <- sort(unique(fold(c(f_raw, s_raw))))
disp <- c(f_raw, s_raw); names(disp) <- fold(disp); disp <- disp[!duplicated(names(disp))]
n_recased <- length(unique(c(f_raw, s_raw))) - length(levs)
kw <- c("yes", "y", "true", "1", "pass", "passed", "positive", "approve", "approved", "success", "present", "detected", "converted", "correct")
pos <- if (nzchar(positive_param) && fold(positive_param) %in% levs) fold(positive_param) else { hit <- levs[levs %in% kw]; if (length(hit)) hit[1] else levs[1] }
neg <- setdiff(levs, pos)
P <- disp[[pos]]; N <- disp[[neg]]
fp <- fold(f_raw) == pos; sp <- fold(s_raw) == pos
both_pos <- sum(fp & sp); both_neg <- sum(!fp & !sp); b_ <- sum(fp & !sp); c_ <- sum(!fp & sp); m <- b_ + c_
if (n < 10) stop(sprintf("Only %d complete pairs of %s and %s; McNemar's test needs at least 10.", n, first_name, second_name))
r1 <- (both_pos + b_) / n; r2 <- (both_pos + c_) / n
chi2 <- if (m > 0) (b_ - c_)^2 / m else NA_real_
p_chi <- if (m > 0) stats::pchisq(chi2, 1, lower.tail = FALSE) else NA_real_
chi_cc <- if (m > 0) max(0, abs(b_ - c_) - 1)^2 / m else NA_real_
p_cc <- if (m > 0) stats::pchisq(chi_cc, 1, lower.tail = FALSE) else NA_real_
exact_p <- if (m > 0) min(1, 2 * stats::pbinom(min(b_, c_), m, 0.5)) else NA_real_
mid_p <- if (m > 0) max(0, exact_p - stats::dbinom(min(b_, c_), m, 0.5)) else NA_real_
headline <- if (m < 25) "mid-p exact McNemar" else "McNemar chi-square (uncorrected)"
z <- stats::qnorm(0.975)
diff_pts <- 100 * (c_ - b_) / n
se <- sqrt(max(0, (b_ + c_) - (c_ - b_)^2 / n)) / n
agree <- (both_pos + both_neg) / n
pe <- r1 * r2 + (1 - r1) * (1 - r2)
kappa <- if (isTRUE(all.equal(pe, 1))) NA_real_ else (agree - pe) / (1 - pe)
results$summary_metrics <- place_metric(list(pairs = n, first_rate_pct = round(100 * r1, 1), second_rate_pct = round(100 * r2, 1),
rate_change_points = tidy(diff_pts), discordant_pairs = as.integer(m), agreement_pct = round(100 * agree, 1)),
lead = "rate_change_points", place = "summary_metrics")
interval_df <- data.frame(measure = sprintf("Change in '%s' rate (points)", P), estimate = tidy(diff_pts),
low = tidy(diff_pts - 100 * z * se), high = tidy(diff_pts + 100 * z * se), stringsAsFactors = FALSE)
results$change_interval <- place_interval(interval_df, term = "measure", value = "estimate", low = "low", high = "high", place = "change_interval")
dir_df <- data.frame(direction = c(sprintf("%s to %s", N, P), sprintf("%s to %s", P, N), sprintf("Stayed %s", P), sprintf("Stayed %s", N)),
pairs = as.integer(c(c_, b_, both_pos, both_neg)), stringsAsFactors = FALSE)
results$change_direction <- place_comparison(dir_df, category = "direction", value = "pairs", place = "change_direction")
results$paired_scatter <- place_dropped("the two measurements are yes/no verdicts, so there is no scatter of values; the table of pairs shows every combination", place = "paired_scatter")
tab_df <- data.frame(first = rep(c(P, N), each = 2), second = rep(c(P, N), times = 2),
pairs = as.integer(c(both_pos, b_, c_, both_neg)), stringsAsFactors = FALSE)
results$paired_table <- place_matrix(tab_df, x = "second", y = "first", z = "pairs", place = "paired_table")
tests_df <- data.frame(
test = c("McNemar chi-square (uncorrected)", "McNemar chi-square (continuity corrected)", "Exact binomial", "Mid-p exact"),
statistic = tidy(c(chi2, chi_cc, min(b_, c_), min(b_, c_))),
p_value = p_text(c(p_chi, p_cc, exact_p, mid_p)),
reading = c("whether the pairs that changed lean one way; recommended when there are 25 or more changed pairs",
"the same with Edwards' correction, which R reports by default and which is conservative",
"exact test on the changed pairs alone; conservative",
"exact test less half the probability of the observed split; recommended with fewer than 25 changed pairs"), stringsAsFactors = FALSE)
results$tests_table <- place_table(tests_df, place = "tests_table")
#' Both directions, up to twenty of each (LAT-3195): fifteen rows of one direction let run 2 write that every changed
#' subject went the same way with 6 of 24 going the other
chg <- c(utils::head(which(!fp & sp), 20), utils::head(which(fp & !sp), 20))
ch_df <- data.frame(subject = subj[chg], first = f_raw[chg], second = s_raw[chg],
change = ifelse(sp[chg], sprintf("%s to %s", N, P), sprintf("%s to %s", P, N)), stringsAsFactors = FALSE)
if (length(chg)) {
results$changed_subjects <- place_table(ch_df, place = "changed_subjects")
} else {
results$changed_subjects <- place_dropped("no subject changed between the two verdicts, so there is no changed pair to list", place = "changed_subjects")
}
checks_df <- data.frame(
check = c("Test suits the changed pairs", "Enough pairs", "Labels consistent", "Pairs complete", "Some pairs changed"),
statistic = c(sprintf("%d changed pairs; headline %s", as.integer(m), headline), sprintf("%d complete pairs", n),
sprintf("%d label%s differing only in case merged", n_recased, if (n_recased == 1) "" else "s"),
sprintf("%d of %d rows excluded", n_missing, n_in), sprintf("agreement %s%%", format(round(100 * agree, 1)))),
p_value = "",
verdict = c(if (m >= 10) "holds" else if (m > 0) "strained" else "violated",
if (n >= 50) "holds" else if (n >= 20) "strained" else "violated",
if (n_recased == 0) "holds" else "strained",
if (n_missing / n_in <= 0.05) "holds" else if (n_missing / n_in <= 0.15) "strained" else "violated",
if (m > 0) "holds" else "violated"),
note = c("below 25 changed pairs the chi-square approximation is unreliable, so the mid-p exact test is the headline; below 10 the test has little power to find a change",
"few pairs leave the change in rate with a wide interval",
"labels that differ only in case (such as yes and Yes) were read as the same value; confirm they mean the same thing. This is how the file was typed, not a doubt about the change",
"pairs missing a verdict are left out; if they differ from the rest, the change is biased",
"with no changed pairs the two rates are identical and the test does not apply"),
stringsAsFactors = FALSE)
method <- paste0("McNemar's test on ", n, " subjects with a verdict in both ", first_name, " and ", second_name, " ('", P, "' against '", N, "'",
if (nzchar(positive_param) && fold(positive_param) %in% levs) ", positive as requested" else if (pos %in% kw) ", positive read from the label" else ", positive taken as the first value alphabetically",
"); only the pairs that changed enter the test; uncorrected chi-square, Edwards continuity-corrected chi-square, exact binomial and mid-p are reported, and the headline is the ", headline,
"; the change in the '", P, "' rate has a 95% Wald interval for paired proportions; agreement and Cohen's kappa are context, not the test")
answer <- list(outcome = "binary", headline_test = headline, positive_level = P, first_rate_pct = round(100 * r1, 1), second_rate_pct = round(100 * r2, 1),
rate_change_points = tidy(diff_pts), discordant = list(first_positive_only = b_, second_positive_only = c_),
p_value = p_text(if (m < 25) mid_p else p_chi), kappa = if (is.na(kappa)) NULL else round(kappa, 3), n = n)
excluded <- c(if (n_missing > 0) sprintf("%d row%s missing a verdict", n_missing, if (n_missing > 1) "s" else ""),
if (n_recased > 0) sprintf("%d label%s differing only in case merged", n_recased, if (n_recased > 1) "s" else ""))
assumptions <- list(
"Each row is the same subject judged twice (before and after, or by two sources); unrelated subjects in the two columns break the pairing.",
"Pairs are independent of each other.",
"McNemar's test asks whether the two rates differ; how often the verdicts agree is a different question (kappa).",
"A change between two occasions is not by itself caused by what happened between them without a comparison group.")
}
results$assumption_checks <- place_table(checks_df, place = "assumption_checks")
method <- paste0(method,
if (length(excluded)) paste0("; excluded: ", paste(excluded, collapse = "; ")) else "",
if (length(ignored_cols)) paste0("; not used: ", paste(utils::head(ignored_cols, 12), collapse = ", "), " (not mapped)") else "", ".")
results$paired_method <- list(kind = "metric", values = list(
method = method, n_in = n_in, n_used = n, excluded = as.list(excluded), assumptions = assumptions,
x_column = first_name, y_column = second_name),
value_order = list("n_used", "n_in"))
objects <- list() # filled by the object layer, not here
list(answer = answer, method = method, n = n, results = results, objects = objects,
json_output = list(answer = answer, method = method, n = n))
}