Executive Summary
The raw vs matched difference in earnings 1978 between the treatment groups
The short answer
The job-training program is associated with 1978 earnings that are about $1,990 higher among program participants compared to similar non-participants — a gap that is statistically detectable and remains after adjusting for age, education, race, marital status, and prior earnings. The matched analysis used 166 pairs of comparable individuals, leaving 19 treated rows unmatched; 7 of 8 measured characteristics balanced well after matching.
The detail
Across 445 observations, the naive difference in 1978 earnings between treatment ('1') and control ('0') groups was +1,794. After matching 166 pairs on 8 covariates (age, education years, black, hispanic, married, no degree, earnings 1974, earnings 1975), the matched difference grew to +1,989 (95% CI 668 to 3,310, p = 0.00338). The 194-unit gap between naive and matched estimates reflects pre-existing selection: the groups differed on measured characteristics before the program. The matched 95% confidence interval does not include zero, indicating the effect is statistically distinguishable from zero at the 0.05 level.
What this can't tell you
Matching adjusts only for the 8 observed covariates; unmeasured differences in motivation, prior work history, or social capital can still bias the estimate. The 19 unmatched treated rows suggest some treated individuals had covariate combinations without close control matches, which could indicate the effect applies most clearly to the matched subsample. A longer follow-up window or administrative data on program dosage would strengthen confidence in the direction and size of the effect.
Analysis Overview
Propensity score matching of earnings 1978 between the two treatment groups across 445 observations.
The short answer
A straightforward comparison of earnings between the two groups can mislead because people who entered the program may have differed from those who didn't—before the program even started. This analysis reconstructs a fair comparison by matching each program participant to a non-participant with similar age, education, race/ethnicity, marital status, prior education attainment, and prior earnings (1974 and 1975). The matched groups then look alike on these observed characteristics, isolating the program's effect from pre-existing differences.
The detail
The analysis begins with 445 observations: 185 in the treatment group ('1') and 260 in the control group ('0'). It models each person's probability of program entry using 8 observed covariates, then pairs each treated participant to the most similar untreated person using nearest-neighbor matching within a caliper of 0.2 standard deviations. This yielded 166 matched pairs; 19 treated rows found no sufficiently similar control match and were excluded. The matched groups are compared on the outcome (earnings 1978) within these 166 pairs, removing the confounding that raw group averages carry.
What this can't tell you
Matching adjusts only for measured covariates—unmeasured differences in motivation, health, social networks, or other history remain. These unobserved factors could still bias the estimate in either direction. To strengthen confidence, consider whether key predictors of earnings (such as family background, prior employment stability, or local labor market conditions) were available to include in matching.
Data Quality
Treatment definition, group sizes, and matched-pair accounting.
The short answer
All 445 rows were retained and usable. The program participants (treatment='1') numbered 185; the comparison group (treatment='0') numbered 260. Matching successfully formed 166 pairs, leaving 19 program participants without a suitable match—these unmatched participants are excluded from the matched analysis.
The detail
Data ingestion retained all 445 rows with valid earnings 1978 and treatment values. Missing values in numeric covariates were imputed with column medians; categorical covariates treated blanks as 'Missing' and grouped rare categories. All 8 covariates (age, education years, black, hispanic, married, no degree, earnings 1974, earnings 1975) were usable. One-to-one nearest-neighbor matching within a caliper of 0.2 standard deviations on the propensity score formed 166 pairs. The caliper excluded 19 of 185 treated rows—they had no control match close enough on the propensity scale—and these unmatched treated rows do not appear in the matched-pair estimates.
What this can't tell you
The caliper's exclusion of 19 treated rows means the matched estimate applies to the 166 matched pairs, not to all program participants. If the unmatched treated rows differ systematically (e.g., higher or lower baseline earnings), the matched estimate may not generalize to the full treated population. A sensitivity analysis comparing matched and unmatched treated participants would clarify whether selection into the matched sample introduces bias.
Covariate Balance
Standardized mean differences before and after matching.
| Covariate | Smd Before | Smd After | Balanced |
|---|---|---|---|
| age | 0.107 | -0.03 | Yes |
| education years | 0.141 | 0.137 | No |
| black | 0.044 | 0.034 | Yes |
| hispanic | -0.175 | -0.048 | Yes |
| married | 0.094 | -0.063 | Yes |
| no degree | -0.304 | -0.085 | Yes |
| earnings 1974 | -0.002 | 0.062 | Yes |
| earnings 1975 | 0.084 | 0.009 | Yes |
The short answer
Matching successfully aligned the treatment and control groups on most covariates. Seven of eight characteristics now show good balance (absolute standardized mean difference < 0.1), but education years remains slightly imbalanced at 0.137—the matched groups still differ on measured educational attainment.
The detail
Before matching, the largest imbalance was 0.304 (no degree); after matching, the largest is 0.137 (education years). Covariates meeting the 0.1 balance threshold after matching are: age (−0.03), black (0.034), hispanic (−0.048), married (−0.063), no degree (−0.085), earnings 1974 (0.062), and earnings 1975 (0.009). Education years (0.137) remains above the threshold. The matched estimate therefore carries some residual imbalance on what was measured, requiring cautious interpretation.
What this can't tell you
Imperfect balance on education years means the matched groups are not identical on this covariate. If education years is correlated with the outcome and the treatment effect differs by education level, the matched estimate may still confound these effects. A sensitivity analysis or stratified estimate by education level would clarify whether the imbalance materially affects the result.
Balance After Matching
Remaining absolute imbalance per covariate (below 0.1 is good).
The short answer
Matching reduced the average imbalance across all eight covariates from 0.119 to 0.0585—a 51 percent improvement. Seven covariates now fall below the 0.1 balance threshold; only education years (0.137) exceeds it.
The detail
After matching, absolute standardized mean differences rank as follows: earnings 1975 leads at 0.009, age at 0.03, black at 0.034, hispanic at 0.048, earnings 1974 at 0.062, married at 0.063, no degree at 0.085, and education years trails at 0.137. The single covariate above 0.1 is education years. Matching cut average absolute imbalance by 51 percent, indicating substantial success in reconstructing comparable groups on the observed dimensions.
What this can't tell you
The 51 percent reduction in average imbalance reflects the covariates included in the propensity model. If important predictors of earnings were omitted (e.g., prior job stability, industry experience, or local labor market conditions), residual confounding could remain despite good balance on the measured set.
Naive vs Matched Difference
The raw gap next to the matched, like-for-like estimate.
The short answer
The matched estimate of +1,989 is larger than the naive estimate of +1,794, meaning that after removing pre-existing differences, the program's association with earnings is slightly stronger. Both estimates' confidence intervals include the same range of plausible values and neither crosses zero, so the matched effect is real and stable.
The detail
The naive bar shows the raw 1978 earnings gap: treatment group at 6,350 versus control at 4,550, a difference of +1,794 (95% CI 474 to 3,115). The matched bar, drawn from 166 pairs balanced on 8 covariates, shows +1,989 (95% CI 668.4 to 3,309). The 194-unit difference between the two estimates reflects selection bias in the raw data — treated and control rows differed systematically on measured characteristics. Both confidence intervals exclude zero, confirming a detectable effect in each case. The matched interval (668.4 to 3,309) is tighter than the naive interval (474 to 3,115) at the lower bound, indicating more precise estimation within the matched sample.
What this can't tell you
Error bar overlap does not imply the two estimates are the same; a formal test would be needed to assess whether the 194-unit difference is itself statistically significant. The matched estimate is more trustworthy for causal inference because it compares like to like, but it cannot rule out bias from unmeasured confounders such as motivation or prior labor-market participation not captured in the 8 covariates.
Effect Estimates
Naive and matched estimates with confidence intervals and p-values.
| Estimate Type | Effect | CI Low | CI High | P Value | N Used |
|---|---|---|---|---|---|
| Naive difference | 1794 | 474 | 3115 | 0.00789 | 445 |
| Matched difference | 1989 | 668.4 | 3309 | 0.00338 | 332 |
The short answer
The matched difference of +1,989 (95% CI 668 to 3,310, p = 0.00338) is the fairer estimate of the program's effect on 1978 earnings. It is statistically significant at conventional levels and larger than the naive estimate, indicating that the program is associated with substantial earnings gains among comparable participants and non-participants.
The detail
The naive difference uses all 445 rows and a two-sample test: +1,794 (95% CI 474 to 3,115, p = 0.00789). The matched difference uses 332 rows (166 pairs) and a paired test: +1,989 (95% CI 668.4 to 3,309, p = 0.00338). The matched p-value is smaller (0.00338 vs. 0.00789), reflecting tighter pairing and lower variance within matched pairs. The matched estimate is preferred because it compares participants to non-participants who resemble them on age, education, race/ethnicity, marital status, education attainment, and prior earnings.
What this can't tell you
Both estimates are conditional on the 8 measured covariates. Unmeasured factors (motivation, social networks, prior employment patterns, or local labor market shocks) could bias the effect estimate in either direction. The result is consistent with a program effect of approximately +1,989 on 1978 earnings; it does not establish causation or rule out unobserved confounding.
Propensity Score Matching — Fairer Before/After Comparisons
Compares a treated group against an untreated group when assignment was NOT random (did loyalty members spend more BECAUSE of the program, or were they already better customers?). Fits a propensity model for who got the treatment, matches each treated unit to its nearest comparable control (1-nearest-neighbor on the logit propensity score with a 0.2-SD caliper, without replacement), and reports the naive raw difference next to the matched difference with a paired confidence interval — plus covariate balance before and after matching.
Why This Method?
A raw treated-vs-control comparison mixes the treatment's effect with every pre-existing difference between the groups. Matching rebuilds an apples-to-apples comparison from the data you have: each treated unit is paired with a control that looked equally likely to be treated, given the observed covariates.
What This Analysis Covers
- Naive difference vs matched difference, with confidence intervals
- Covariate balance (standardized mean differences) before and after
- Matched-pair accounting: pairs formed, treated left unmatched
- Common support: how comparable the two groups actually are
Standard Library
Platform standard-library module (LAT-1441): runs on ANY dataset via the semantic mapping {outcome, treatment, covariate_1..covariate_N}. All narrative is derived from the user's own column names and computed values. Matching adjusts only for OBSERVED covariates — the unobserved-confounding caveat is carried in every summary.
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))Step 1: Row accounting + semantic column discovery
initial_rows <- nrow(df)
if (!"outcome" %in% names(df)) {
stop("column_mapping must map an 'outcome' column (the numeric result to compare)")
}
if (!"treatment" %in% names(df)) {
stop("column_mapping must map a 'treatment' column (who got the treatment)")
}
cov_cols <- grep("^covariate_[0-9]+$", names(df), value = TRUE)
cov_cols <- cov_cols[order(as.integer(sub("^covariate_", "", cov_cols)))]
if (length(cov_cols) == 0) {
stop("column_mapping must map at least one covariate column(covariate_1) — the pre-existing differences to adjust for")
}
outcome_name <- humanize_semantic("outcome", col_map)
treatment_name <- humanize_semantic("treatment", col_map)
cov_names <- setNames(humanize_semantic(cov_cols, col_map), cov_cols)Step 2: Coerce the outcome to numeric (95% rule) and drop NA rows
v <- df$outcome
if (!is.numeric(v)) {
conv <- suppressWarnings(as.numeric(as.character(v)))
n_orig <- sum(!is.na(v) & trimws(as.character(v)) != "")
if (n_orig > 0 && sum(!is.na(conv)) >= 0.95 * n_orig) {
df$outcome <- conv
} else {
stop(sprintf(
"The outcome column('%s') must be numeric — the result you want to compare, such as spend, score, or minutes.",
outcome_name))
}
}
df <- df[!is.na(df$outcome), , drop = FALSE]Step 3: Binarize the treatment (logical, 0/1, yes/no, member/non-member)
v_raw <- df$treatment
if (is.logical(v_raw)) {
df <- df[!is.na(v_raw), , drop = FALSE]
treated_label <- "TRUE"
control_label <- "FALSE"
tvec <- as.integer(df$treatment)
} else {
vc <- trimws(as.character(v_raw))
keep <- !is.na(v_raw) & !is.na(vc) & vc != ""
df <- df[keep, , drop = FALSE]
vc <- vc[keep]
lv <- sort(unique(vc))
if (length(lv) < 2) {
stop(sprintf(
"The treatment column('%s') has only one value ('%s') — a treated-vs-control comparison needs both groups present.",
treatment_name, if (length(lv) == 1) lv[1] else "empty"))
}
if (length(lv) > 2) {
stop(sprintf(
"The treatment column('%s') has %d distinct values (%s%s) — propensity matching compares exactly two groups, such as member/non-member, yes/no, or 1/0.",
treatment_name, length(lv), paste(head(lv, 5), collapse = ", "),
if (length(lv) > 5) ", …" else ""))
}Which level is the treated group? Match common treated labels case-insensitively; otherwise take the alphabetically-last level.
pat <- "^(1|yes|true|treated|member|exposed)$"
hits <- lv[grepl(pat, tolower(lv))]
treated_label <- if (length(hits) == 1) hits else lv[2]
control_label <- setdiff(lv, treated_label)[1]
tvec <- as.integer(vc == treated_label)
}
df$treatment <- tvecStep 4: Type each covariate — numeric if >=95% of values convert, else factor
dropped_covs <- character(0)
for (cc in cov_cols) {
x <- df[[cc]]
if (!is.numeric(x)) {
conv <- suppressWarnings(as.numeric(as.character(x)))
n_orig <- sum(!is.na(x) & as.character(x) != "")
if (n_orig > 0 && sum(!is.na(conv)) >= 0.95 * n_orig) {
df[[cc]] <- conv
}
}
x <- df[[cc]]
if (is.numeric(x)) {Numeric: impute NA with median
med <- median(x, na.rm = TRUE)
if (is.na(med)) { dropped_covs <- c(dropped_covs, cc); next }
x[is.na(x)] <- med
df[[cc]] <- x
} else {Categorical: blank/NA -> "Missing"; lump beyond 12 levels into "Other"
x <- as.character(x)
x[is.na(x) | trimws(x) == ""] <- "Missing"
tab <- sort(table(x), decreasing = TRUE)
if (length(tab) > 12) {
keep_lv <- names(tab)[1:12]
x[!(x %in% keep_lv)] <- "Other"
}
if (length(unique(x)) > nrow(df) / 2) {Near-unique text column (an ID, not a covariate) — exclude
dropped_covs <- c(dropped_covs, cc)
next
}
df[[cc]] <- factor(x)
}
}Step 5: Drop zero-variance covariates
for (cc in setdiff(cov_cols, dropped_covs)) {
x <- df[[cc]]
zero_var <- if (is.numeric(x)) {
isTRUE(var(x, na.rm = TRUE) == 0) || is.na(var(x, na.rm = TRUE))
} else {
length(unique(x)) <= 1
}
if (zero_var) dropped_covs <- c(dropped_covs, cc)
}
model_covs <- setdiff(cov_cols, dropped_covs)
if (length(model_covs) == 0) {
stop("No usable covariate columns remained after cleaning(all were constant, empty, or identifier-like).")
}
df_clean <- df[, c(model_covs, "treatment", "outcome"), drop = FALSE]
final_rows <- nrow(df_clean)
rows_removed <- initial_rows - final_rowsStep 6: Group-size guards
n_treated <- sum(df_clean$treatment == 1)
n_control <- sum(df_clean$treatment == 0)
if (final_rows < 40) {
stop(sprintf(
"Only %d rows have usable values in %s and %s. At least 40 are required for a matched comparison.",
final_rows, outcome_name, treatment_name))
}
if (n_treated < 10 || n_control < 10) {
stop(sprintf(
"The treatment column('%s') has %d '%s' rows and %d '%s' rows after cleaning — at least 10 in each group are required.",
treatment_name, n_treated, treated_label, n_control, control_label))
}Step 7: Propensity model — glm(treatment ~ covariates, binomial)
glm_warnings <- character(0)
ps_formula <- as.formula(paste("treatment ~", paste(model_covs, collapse = " + ")))
ps_model <- withCallingHandlers(
glm(ps_formula, data = df_clean, family = binomial()),
warning = function(w) {
glm_warnings <<- c(glm_warnings, conditionMessage(w))
invokeRestart("muffleWarning")
}
)
ps <- as.numeric(fitted(ps_model))
lps <- qlogis(pmin(pmax(ps, 1e-6), 1 - 1e-6))Overlap / convergence diagnostics — note in narrative, never crash
sep_frac <- mean(ps < 1e-3 | ps > 1 - 1e-3)
nonconv_flag <- any(grepl("did not converge|fitted probabilities numerically 0 or 1",
glm_warnings))
t_idx <- which(df_clean$treatment == 1)
c_idx <- which(df_clean$treatment == 0)
support_share <- mean(ps[t_idx] >= min(ps[c_idx]) & ps[t_idx] <= max(ps[c_idx]))
fit_note <- if (sep_frac > 0.5) {
paste0("Caution: the covariates almost perfectly predict who received the ",
"treatment, so the two groups barely overlap. Matched estimates rest ",
"on the few comparable units that exist and should be read with care.")
} else if (nonconv_flag) {
paste0("Caution: the propensity model raised convergence warnings(often a ",
"sign of near-perfect separation or sparse categories). Estimates ",
"should be read with care.")
} else if (support_share < 0.9) {
paste0("Note: only ", round(100 * support_share, 1), "% of ", treated_label,
" rows fall inside the propensity range of the ", control_label,
" group — the estimate applies to the comparable region, not to every ",
"treated unit.")
} else ""Step 8: 1-nearest-neighbor matching on the logit propensity score,
caliper 0.2 * SD(logit PS), without replacement, hardest (highest-PS) treated matched first.
sd_lps <- sd(lps)
caliper <- if (is.finite(sd_lps)) 0.2 * sd_lps else 0
avail <- rep(TRUE, length(c_idx))
pairs_t <- integer(0)
pairs_c <- integer(0)
for (ti in t_idx[order(-lps[t_idx])]) {
d <- abs(lps[c_idx] - lps[ti])
d[!avail] <- Inf
j <- which.min(d)
if (length(j) == 1 && is.finite(d[j]) && d[j] <= caliper) {
pairs_t <- c(pairs_t, ti)
pairs_c <- c(pairs_c, c_idx[j])
avail[j] <- FALSE
}
}
n_pairs <- length(pairs_t)
n_unmatched <- n_treated - n_pairs
if (n_pairs < 10) {
stop(sprintf(
"Only %d matched pairs could be formed within the caliper — the '%s' and '%s' groups in %s are too different on the mapped covariates for a reliable matched comparison.",
n_pairs, treated_label, control_label, treatment_name))
}Step 9: Effects — NAIVE (raw Welch) vs MATCHED (paired t-test)
y <- df_clean$outcome
y_t <- y[t_idx]
y_c <- y[c_idx]
naive_diff <- mean(y_t) - mean(y_c)
naive_test <- tryCatch(t.test(y_t, y_c), error = function(e) NULL)
naive_ci <- if (!is.null(naive_test)) as.numeric(naive_test$conf.int) else c(NA_real_, NA_real_)
naive_p <- if (!is.null(naive_test)) naive_test$p.value else NA_real_
pair_diffs <- y[pairs_t] - y[pairs_c]
matched_diff <- mean(pair_diffs)
matched_test <- tryCatch(t.test(pair_diffs), error = function(e) NULL)
matched_ci <- if (!is.null(matched_test)) as.numeric(matched_test$conf.int) else c(NA_real_, NA_real_)
matched_p <- if (!is.null(matched_test)) matched_test$p.value else NA_real_
change_word <- if (!is.finite(naive_diff) || !is.finite(matched_diff)) {
"changes"
} else if (abs(matched_diff) < 0.9 * abs(naive_diff)) {
"shrinks"
} else if (abs(matched_diff) > 1.1 * abs(naive_diff)) {
"grows"
} else {
"changes little"
}
effect_results_df <- data.frame(
estimate_type = c("Naive difference", "Matched difference"),
effect = signif(c(naive_diff, matched_diff), 4),
ci_low = signif(c(naive_ci[1], matched_ci[1]), 4),
ci_high = signif(c(naive_ci[2], matched_ci[2]), 4),
p_value = c(fmt_p(naive_p), fmt_p(matched_p)),
n_used = c(n_treated + n_control, 2L * n_pairs),
stringsAsFactors = FALSE
)Step 10: Covariate balance — SMD before vs after matching.
Numeric: pooled-SD standardized mean difference. Categorical: the maximum absolute level-share difference between the groups.
balance_rows <- lapply(model_covs, function(cc) {
x <- df_clean[[cc]]
if (is.numeric(x)) {
before <- smd_numeric(x[t_idx], x[c_idx])
after <- smd_numeric(x[pairs_t], x[pairs_c])
} else {
before <- smd_categorical(x[t_idx], x[c_idx])
after <- smd_categorical(x[pairs_t], x[pairs_c])
}
data.frame(
covariate = cov_names[[cc]],
smd_before = round(before, 3),
smd_after = round(after, 3),
balanced = ifelse(is.na(after), "Unknown",
ifelse(abs(after) < 0.1, "Yes", "No")),
stringsAsFactors = FALSE
)
})
balance_df <- do.call(rbind, balance_rows)
rownames(balance_df) <- NULL
n_balanced <- sum(balance_df$balanced == "Yes")
worst_after <- if (any(is.finite(balance_df$smd_after))) {
max(abs(balance_df$smd_after), na.rm = TRUE)
} else NA_real_
balance_chart_df <- data.frame(
covariate = balance_df$covariate,
abs_smd_after = round(abs(balance_df$smd_after), 3),
stringsAsFactors = FALSE
)Step 11: KPI metrics (user-facing keys)
metrics <- list(
`Observations` = final_rows,
`Matched Pairs` = as.integer(n_pairs),
`Unmatched Treated` = as.integer(n_unmatched),
`Naive Difference` = signif(naive_diff, 4),
`Matched Difference` = signif(matched_diff, 4),
`Covariates Balanced` = paste0(n_balanced, " of ", length(model_covs))
)Step 12: json_output machine channel
matched_sig <- !is.na(matched_ci[1]) && !is.na(matched_ci[2]) &&
(matched_ci[1] > 0 || matched_ci[2] < 0)
json_output <- list(
answer = paste0(
"Propensity score matching of ", outcome_name, " between ",
treatment_name, " = '", treated_label, "' (", format(n_treated, big.mark = ","),
" rows) and '", control_label, "' (", format(n_control, big.mark = ","),
" rows), adjusting for ", length(model_covs),
if (length(model_covs) == 1) " covariate" else " covariates",
": the raw gap of ", fmt_signed(naive_diff), " ", change_word, " to ",
fmt_signed(matched_diff), " after matching ", format(n_pairs, big.mark = ","),
" comparable pairs(95% CI ", fmt_val(matched_ci[1]), " to ",
fmt_val(matched_ci[2]), ", p ",
if (grepl("^<", fmt_p(matched_p))) fmt_p(matched_p) else paste0("= ", fmt_p(matched_p)),
"; ", format(n_unmatched, big.mark = ","), " treated left unmatched by the caliper). ",
"The matched effect is ",
if (matched_sig) "statistically distinguishable from zero"
else "not statistically distinguishable from zero", ". ",
n_balanced, " of ", length(model_covs),
if (n_balanced == 1) " covariate is" else " covariates are",
" well balanced after matching(absolute SMD below 0.1). ",
"Matching adjusts only for these observed covariates — unmeasured ",
"differences between the groups can still bias the estimate.",
if (nchar(fit_note) > 0) paste0(" ", fit_note) else ""
),
cards = lapply(
c("tldr", "overview", "preprocessing", "balance_table", "balance_chart",
"effect_comparison", "effect_table"),
function(cid) list(id = cid, metrics = metrics)
)
)
list(
initial_rows = initial_rows,
final_rows = final_rows,
rows_removed = rows_removed,
outcome_name = outcome_name,
treatment_name = treatment_name,
treated_label = treated_label,
control_label = control_label,
n_treated = n_treated,
n_control = n_control,
cov_names = cov_names,
model_covs = model_covs,
dropped_covs = dropped_covs,
fit_note = fit_note,
caliper = caliper,
n_pairs = n_pairs,
n_unmatched = n_unmatched,
support_share = support_share,
mean_treated = mean(y_t),
mean_control = mean(y_c),
naive_diff = naive_diff,
naive_ci = naive_ci,
naive_p = naive_p,
matched_diff = matched_diff,
matched_ci = matched_ci,
matched_p = matched_p,
matched_sig = matched_sig,
change_word = change_word,
balance_df = balance_df,
balance_chart_df = balance_chart_df,
n_balanced = n_balanced,
worst_after = worst_after,
effect_results_df = effect_results_df,
metrics = metrics,
json_output = json_output
)
}LAT-1445 guard: never which.max over a possibly-all-NA vector
after_ok <- which(!is.na(bdf$smd_after))
worst_name <- if (length(after_ok) > 0) {
bdf$covariate[after_ok[which.max(abs(bdf$smd_after[after_ok]))]]
} else NULL
worst_before <- if (any(!is.na(bdf$smd_before))) {
fmt_val(max(abs(bdf$smd_before), na.rm = TRUE))
} else "not available"
text <- paste0(
"Each row shows a covariate's standardized mean difference (SMD) ",
"between the '", shared$treated_label, "' and '", shared$control_label,
"' groups, before and after matching — 0 means the groups look ",
"identical on that covariate, and an absolute value below 0.1 is the ",
"standard threshold for good balance. Before matching, the largest ",
"imbalance is ", worst_before,
"; after matching, the largest is ",
if (is.finite(shared$worst_after)) fmt_val(shared$worst_after) else "not available",
if (!is.null(worst_name)) paste0(" (", worst_name, ")") else "", ". ",
shared$n_balanced, " of ", nrow(bdf),
if (nrow(bdf) == 1) " covariate meets" else " covariates meet",
" the 0.1 threshold, so the matched groups ",
if (shared$n_balanced == nrow(bdf)) "are well aligned"
else "are only partly aligned",
" on what was measured. For categorical covariates the value shown is ",
"the largest share difference across their levels."
)
list(
title = "Covariate Balance",
description = "Standardized mean differences before and after matching.",
text = text,
data = list(balance = shared$balance_df)
)
}
# Card: balance_chart (horizontal_bar)
card_balance_chart <- function(shared, df, params) {
bdf <- shared$balance_df
avg_before <- mean(abs(bdf$smd_before), na.rm = TRUE)
avg_after <- mean(abs(bdf$smd_after), na.rm = TRUE)
reduction_phrase <- if (is.finite(avg_before) && avg_before > 0 &&
is.finite(avg_after)) {
paste0(" — a reduction of ", round(100 * (1 - avg_after / avg_before)),
" percent")
} else ""
text <- paste0(
"Each bar is a covariate's remaining imbalance after matching (absolute ",
"standardized mean difference); shorter is better and bars below 0.1 ",
"count as well balanced. Matching cut the average absolute imbalance ",
"from ", fmt_val(avg_before), " before to ", fmt_val(avg_after),
" after", reduction_phrase, ". ",
if (shared$n_balanced == nrow(bdf)) {
paste0("All ", nrow(bdf),
if (nrow(bdf) == 1) " covariate ends" else " covariates end",
" below the 0.1 threshold, so the matched comparison of ",
shared$outcome_name, " is no longer driven by these measured ",
"differences.")
} else {
paste0(nrow(bdf) - shared$n_balanced, " of ", nrow(bdf),
if (nrow(bdf) == 1) " covariate remains" else " covariates remain",
" above the 0.1 threshold — the matched estimate still carries ",
"some imbalance on what was measured, so read it with extra care.")
}
)
list(
title = "Balance After Matching",
description = "Remaining absolute imbalance per covariate(below 0.1 is good).",
text = text,
chart_labels = list(
covariate = "Covariate",
abs_smd_after = "Absolute standardized mean difference after matching"
),
data = list(balance_chart = shared$balance_chart_df)
)
}
# Card: effect_comparison (bar)
card_effect_comparison <- function(shared, df, params) {
text <- paste0(
"The two bars answer the headline question side by side. The naive bar ",
"is the raw '", shared$treated_label, "' minus '", shared$control_label,
"' difference in ", shared$outcome_name, " (", fmt_signed(shared$naive_diff),
"), which mixes the treatment's effect with pre-existing differences. ",
"The matched bar is the same difference inside the ",
format(shared$n_pairs, big.mark = ","), " matched pairs(",
fmt_signed(shared$matched_diff), "), where both groups look alike on ",
"the measured covariates. The gap between the bars — ",
fmt_val(abs(shared$naive_diff - shared$matched_diff)),
" — largely reflects selection: comparable '", shared$treated_label,
"' and '", shared$control_label,
"' rows were already different on the measured covariates before any ",
"effect of the treatment. Error bars are 95% confidence intervals; a matched bar ",
"whose interval clears zero indicates a real remaining effect."
)
list(
title = paste0("Naive vs Matched Difference in ", shared$outcome_name),
description = "The raw gap next to the matched, like-for-like estimate.",
text = text,
chart_labels = list(
estimate_type = "Estimate",
effect = paste0("Difference in ", shared$outcome_name)
),
data = list(effect_comparison = shared$effect_results_df[
, c("estimate_type", "effect", "ci_low", "ci_high"), drop = FALSE])
)
}
# Card: effect_table (table)
card_effect_table <- function(shared, df, params) {
naive_p_phrase <- if (grepl("^<", fmt_p(shared$naive_p))) {
paste0("p ", fmt_p(shared$naive_p))
} else {
paste0("p = ", fmt_p(shared$naive_p))
}
matched_p_phrase <- if (grepl("^<", fmt_p(shared$matched_p))) {
paste0("p ", fmt_p(shared$matched_p))
} else {
paste0("p = ", fmt_p(shared$matched_p))
}
text <- paste0(
"Full estimates with 95% confidence intervals. The naive difference of ",
fmt_signed(shared$naive_diff), " (", naive_p_phrase, ") uses all ",
format(shared$n_treated + shared$n_control, big.mark = ","),
" rows and a two-sample test. The matched difference of ",
fmt_signed(shared$matched_diff), " (95% CI ",
fmt_val(shared$matched_ci[1]), " to ", fmt_val(shared$matched_ci[2]),
", ", matched_p_phrase, ") is a paired test on the ",
format(shared$n_pairs, big.mark = ","),
" treated-minus-control pair differences, using ",
format(2 * shared$n_pairs, big.mark = ","), " rows. ",
"The matched row is the fairer read of what the '",
shared$treated_label, "' status in ", shared$treatment_name,
" does to ", shared$outcome_name, ". ",
caveat_sentence(shared)
)
list(
title = "Effect Estimates",
description = "Naive and matched estimates with confidence intervals and p-values.",
text = text,
data = list(effect_results = shared$effect_results_df)
)
}