Incrementality
Compares each contacted group with a randomly held-out group on a conversion, and says how many conversions the campaign caused, not just how many it was credited with, with a range, the extra spend per 1,000 contacts, and how big a holdout needs to be.
RUN DATE · 24 October 2026
DATA · 50,083 rows
Randomized incrementality (v2) analysis
- SummaryCredited, would have happened anyway, and caused, for the best contacted group.
- Credit versus causeCredited, would-have-happened-anyway and caused conversions for each contacted group.
- Lift over the holdoutEach contacted group minus the holdout, with its interval.
- Conversion by groupEach group's conversion rate with its interval.
- Credited, anyway, causedThe credit-versus-cause figures for each contacted group.
- Every comparisonEach contacted group against the holdout with its interval, relative lift and adjusted p-value.
- Extra spend per 1,000Extra spend per customer and per 1,000 contacted, against the holdout.
- Holdout sizeRows per group against the rows 80% power needs, and the smallest lift the test could detect.
- 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.
Data: Dean Karlan and John A. List (2007), Does Price Matter in Charitable Giving?, Harvard Dataverse, doi:10.7910/DVN/27853, CC0
What the campaign caused
Caused bar is far shorter than credited
For Match offer, the caused bar is far shorter than the credited bar, so crediting everyone who converted overstates the campaign.
Compare the Caused by the campaign bar with Credited to the campaign for Match offer; the anyway bar sits close to credited.
Caused bar is far shorter than credited
The would-have-converted-anyway bar for Match offer is only a little below the credited bar, which leaves a small caused remainder. Crediting everyone who converted after contact therefore overstates the campaign's effect by a wide margin. Caused is an estimate carried by the lift's uncertainty, so check its range on the caused table.
Compare the Caused by the campaign bar with Credited to the campaign for Match offer; the anyway bar sits close to credited.
Match offer sits above the holdout
The Match offer vs Control interval sits entirely above zero, so Match offer converts more than the holdout, though the gap is small.
Look at the Match offer vs Control interval: both ends sit right of zero, with the lower end fairly close to it.
Match offer sits above the holdout
The whole interval lies on the positive side of zero, so the higher conversion of Match offer is distinguishable from Control. The effect is small in percentage points, and the lower end of the interval is near zero, so the true gap could be modest. The test was powered a little short of what the observed lift needs, which is a reason to treat the size with some caution.
Look at the Match offer vs Control interval: both ends sit right of zero, with the lower end fairly close to it.
Who converted
Match offer converts above Control
Match offer has the higher gave rate and its interval does not overlap Control's, consistent with a real but modest difference.
Compare the Match offer interval with the Control interval: Match offer's lower end stays above Control's upper end.
Match offer converts above Control
Match offer is the highest group on gave rate, and its interval does not overlap the Control interval. Neither interval includes zero, as expected for rates. The lift card is what decides whether the difference is real, and it agrees on direction. The gap between the two groups is small on the rate scale.
Compare the Match offer interval with the Control interval: Match offer's lower end stays above Control's upper end.
Credit versus cause
Campaign caused only a small part of credited
Match offer vs Control: the campaign caused only a small part of credited conversions, with a wide range around that estimate.
The range for caused is wide relative to the estimate, though its lower end stays above zero.
Campaign caused only a small part of credited
Credited conversions are dominated by those that would have happened anyway, leaving a modest caused count. Caused is the lift times the group's size, so it inherits the lift's uncertainty: the range is wide, yet it stays above zero. Read the caused figure as an estimate, not an exact count, and read credited as an overstatement of the campaign's effect.
The range for caused is wide relative to the estimate, though its lower end stays above zero.
The numbers
Match offer is a significant winner
Match offer vs Control is significant after adjustment, with lift above zero, so Match offer converts more than the holdout.
The adjusted p-value is clear but the lift is small in points, and the interval's lower end sits near zero.
Match offer is a significant winner
The significant column says yes and the whole lift interval sits above zero, so Match offer counts as a winner against Control. Clear is not the same as large: the lift in points is small, though relative to Control's rate it is a noticeable step up. The test was a little short of the rows it needs for this lift, so the size may be exaggerated.
The adjusted p-value is clear but the lift is small in points, and the interval's lower end sits near zero.
Extra spend
Extra spend is not clearly above zero
Match offer vs Control shows higher average spend, but the interval crosses zero, so extra spend is not clearly distinguishable from none.
The point estimate is positive but the interval crosses zero and the p-value is above the usual cutoff.
Extra spend is not clearly above zero
For contacted customers, Match offer brings in more spend than Control on average, but the interval includes zero and the p-value is above the usual cutoff. The spend check is violated because a few very large amounts can decide the difference, so this estimate is fragile. Spend is per customer contacted, not per giver; compare a capped spend before relying on it.
The point estimate is positive but the interval crosses zero and the p-value is above the usual cutoff.
How big a holdout needs to be
Test had just enough rows for observed lift
The contacted group has about enough rows for the lift seen, but the observed lift sits just under the smallest reliably detectable.
The smallest lift the test could reliably detect sits just above the lift observed, so the lift found is right at the edge of detectable.
Test had just enough rows for observed lift
The contacted group is larger than the rows needed for the observed lift, but the holdout is smaller than that need, which is why power is strained rather than comfortable. The observed lift falls just short of the smallest lift the test could reliably detect. A real lift found this close to the limit may be exaggerated, so read the size of the lift cautiously and look at the interval on the lift card.
The smallest lift the test could reliably detect sits just above the lift observed, so the lift found is right at the edge of detectable.
Assumptions and method
Checks: one violated, one strained, three hold
Violated: spend not dominated by extremes; strained: test powered for the best observed lift.
Holding: holdout is a real group, enough conversions in every group, rows complete.
Checks: one violated, one strained, three hold
Test powered for the best observed lift is strained: a test short of the rows it needs misses real lift and exaggerates the lift it finds. Spend not dominated by extremes is violated: a few very large purchases can decide the spend difference; compare a capped spend if so. The other three hold.
Holding: holdout is a real group, enough conversions in every group, rows complete.
Each contacted group against the holdout 'Control' (named like a holdout) over 50083 rows in 2 groups; gave read as a 0/1 flag, success = 1; lift is the difference in conversion rates with a 95% interval (Wilson for rates, Newcombe for the difference), p-values from a two-proportion z-test Holm-adjusted across 1 comparison at alpha 0.05; caused conversions are the lift times the contacted group's size, with the interval scaled the same way, and would-have-converted-anyway is the holdout's rate times that size; extra spend is the difference in mean amount (Welch interval), per customer and per 1,000 contacted; rows per group needed for 80% power at the observed lift.
50083 of 50083 rows · group → gave
caveatResults assume random assignment, which the data cannot confirm; power is strained and spend is distorted by extremes.
Match offer was compared with the holdout Control on the gave flag, with no rows excluded. Caused is the lift times group size, so it is an estimate with a range, not an exact count. The checks flag power as strained and spend as violated by extreme values, so the conversion lift is firmer than the spend gain. Random assignment, no overlap between groups and an equal outcome window are assumed, not tested; if the contacted group was chosen, the lift also reflects that choice.
The code behind this report
The code that produced every figure in this report, exactly as it ran. Fingerprint 1ac35fa11e06ad64. The same code on the same data gives the same report.
`standard_randomized_incrementality_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()
question <- (inputs$userContext %||% list())$objective %||%
"How much of this result did the campaign cause, beyond what would have happened anyway?"
#' ## Column mapping
#' One row per person or account: `group` (who was contacted and who was held out), `outcome` (did the row convert: a 0/1
#' flag or a two-level yes/no column) and, optionally, `value` (what the customer spent, a number, 0 for no purchase),
#' which adds the extra spend per 1,000 customers contacted.
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)
}
group_name <- human("group"); outcome_name <- human("outcome"); value_name <- human("value")
for (sem in c("group", "outcome"))
if (!(sem %in% names(df))) stop(sprintf("column_mapping must map '%s' (%s was not found).", sem, human(sem)))
has_value <- "value" %in% names(df)
n_in <- nrow(df)
#' ## The columns this tool did not look at, read from the raw rows (init narrows `df` to the mapped columns)
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
#' `alpha`: the level every comparison is judged at, after the Holm adjustment (0.01, 0.05 or 0.10); the intervals are
#' at 1 - alpha. `control`: the held-out group to compare against; blank picks a group named like a holdout (control,
#' holdout, no e-mail, no send, baseline, untreated), else the largest group.
alpha <- suppressWarnings(as.numeric(params$alpha %||% 0.05))
if (is.na(alpha) || !(alpha %in% c(0.01, 0.05, 0.10))) stop("module_parameters$alpha must be 0.01, 0.05 or 0.10")
conf <- 1 - alpha; z <- stats::qnorm(1 - alpha / 2); conf_pct <- round(100 * conf)
control_param <- trimws(as.character(params$control %||% ""))
#' ## Data preparation
#' Rows with a blank group or outcome are excluded and counted. At most four groups are compared (the largest); a group
#' with fewer than 5 rows is dropped and named. The outcome must be a conversion: logical, only 0 and 1, or exactly
#' two text values (success is the one that reads like a success, else the alphabetically last). A numeric outcome
#' with other values is refused, because "caused" counts people, not dollars; the amount goes in the value column.
g_all <- trimws(as.character(df$group)); o_raw <- df$outcome; o_chr <- trimws(as.character(o_raw))
keep <- !is.na(g_all) & g_all != "" & !is.na(o_chr) & o_chr != "" & !(tolower(o_chr) %in% c("na", "n/a", "null", "nan"))
n_missing <- sum(!keep)
val_raw <- if (has_value) df$value[keep] else NULL
g <- g_all[keep]; o_chr <- o_chr[keep]; o_raw <- o_raw[keep]
success_how <- ""; n_uncoercible <- 0L
if (is.logical(o_raw)) {
y <- as.numeric(o_raw); success_how <- "a TRUE/FALSE column, success = TRUE"
} else {
conv <- suppressWarnings(as.numeric(o_chr))
if (sum(!is.na(conv)) >= 0.95 * length(o_chr)) {
bad <- is.na(conv); n_uncoercible <- sum(bad)
g <- g[!bad]; conv <- conv[!bad]; if (has_value) val_raw <- val_raw[!bad]
if (!all(conv %in% c(0, 1))) stop(sprintf("%s has values other than 0 and 1. Incrementality counts rows that converted: map a 0/1 flag or a yes/no column as the outcome, and put the amount spent in the value column.", outcome_name))
y <- conv; success_how <- "a 0/1 flag, success = 1"
} else {
lv <- sort(unique(o_chr))
if (length(lv) != 2) stop(sprintf("%s has %d distinct text values; map a 0/1 conversion flag or a column with exactly two values (yes/no).", outcome_name, length(lv)))
kw <- c("yes", "y", "true", "1", "converted", "success", "clicked", "purchased", "bought", "retained", "signed up", "won", "visited")
hit <- lv[tolower(lv) %in% kw]
success <- if (length(hit)) hit[1] else lv[2]
success_how <- sprintf("two values ('%s', '%s'), success = '%s'%s", lv[1], lv[2], success, if (length(hit)) "" else " (the alphabetically last; neither reads like a success)")
y <- as.numeric(o_chr == success)
}
}
tab <- sort(table(g), decreasing = TRUE)
top <- names(tab)[seq_len(min(4L, length(tab)))]
small <- top[as.integer(tab[top]) < 5]
kept <- setdiff(top, small); dropped_groups <- c(setdiff(names(tab), top), small)
sel <- g %in% kept; n_dropped_rows <- sum(!sel)
g <- g[sel]; y <- y[sel]; if (has_value) val_raw <- val_raw[sel]
if (length(kept) < 2) stop(sprintf("After cleaning, %s has %d group(s) with 5 or more rows; a holdout comparison needs the contacted group and a held-out group.", group_name, length(kept)))
if (all(y == 1) || all(y == 0)) stop(sprintf("%s is the same for every usable row; there is nothing to compare.", outcome_name))
n <- length(y); if (n < 20) stop(sprintf("Only %d usable rows; an incrementality comparison needs at least 20.", n))
#' ## The value column, when mapped: a number per customer, blanks left out of the spend figures only
value <- NULL; value_note <- NULL; n_value_blank <- 0L
if (has_value) {
vn <- suppressWarnings(as.numeric(as.character(val_raw)))
nonblank <- !is.na(val_raw) & trimws(as.character(val_raw)) != ""
if (sum(!is.na(vn)) >= 0.95 * max(1, sum(nonblank)) && sum(!is.na(vn)) >= 0.5 * n) {
value <- vn; n_value_blank <- sum(is.na(vn))
if (isTRUE(stats::var(value, na.rm = TRUE) == 0)) { value <- NULL; value_note <- sprintf("%s has no variation, so there is no spend to compare", value_name) }
} else value_note <- sprintf("%s could not be read as a number for 95%% of the rows that have one (or is blank for half the file), so spend is not reported", value_name)
} else value_note <- "no value column was mapped, so extra spend is not reported"
has_spend <- !is.null(value)
#' ## The control: named, else a group named like a holdout, else the largest
named <- kept[tolower(kept) %in% tolower(control_param)]
kw_ctrl <- kept[grepl("(^|[^a-z])(control|holdout|hold-out|hold out|baseline|untreated|suppressed|no[ -]?(e-?mail|send|contact|message|treatment|campaign|offer|ad|ads|sms|push))([^a-z]|$)", tolower(kept))]
control <- if (nzchar(control_param) && length(named)) named[1] else if (length(kw_ctrl)) kw_ctrl[1] else kept[1]
control_how <- if (nzchar(control_param) && length(named)) "as requested" else if (nzchar(control_param)) sprintf("'%s' was requested but is not a group, so the group named like a holdout, else the largest, was used", control_param) else if (length(kw_ctrl)) "named like a holdout" else "the largest group, because no group is named like a holdout"
treatments <- setdiff(kept, control)
order_g <- c(control, treatments)
#' ## Conversion per group: Wilson interval
wilson <- function(x, m) { ph <- x / m; den <- 1 + z^2 / m; ctr <- (ph + z^2 / (2 * m)) / den
half <- z * sqrt(ph * (1 - ph) / m + z^2 / (4 * m^2)) / den; c(ctr - half, ctr + half) }
gs <- lapply(order_g, function(k) {
yy <- y[g == k]; m <- length(yy); x <- sum(yy); ci <- wilson(x, m)
list(n = m, x = x, est = x / m, lo = ci[1], hi = ci[2])
})
names(gs) <- order_g
outcome_df <- data.frame(group = order_g, rate_pct = tidy(100 * sapply(gs, `[[`, "est")),
ci_low = tidy(100 * sapply(gs, `[[`, "lo")), ci_high = tidy(100 * sapply(gs, `[[`, "hi")), stringsAsFactors = FALSE)
#' ## Each contacted group against the holdout
#' Lift is the contacted rate minus the holdout rate, with a Newcombe interval. Credit is every converter in the
#' contacted group; what would have happened anyway is the holdout's rate times the contacted group's size; the
#' difference is what the campaign caused, and its range is the lift interval times that size.
cg <- gs[[control]]
comp <- lapply(treatments, function(k) {
tg <- gs[[k]]
d <- tg$est - cg$est
lo <- d - sqrt((tg$est - tg$lo)^2 + (cg$hi - cg$est)^2); hi <- d + sqrt((tg$hi - tg$est)^2 + (cg$est - cg$lo)^2)
p <- tryCatch(suppressWarnings(stats::prop.test(c(tg$x, cg$x), c(tg$n, cg$n), correct = FALSE)$p.value), error = function(e) NA_real_)
rel <- if (cg$x > 0 && tg$x > 0) { se <- sqrt((1 - tg$est) / tg$x + (1 - cg$est) / cg$x); r <- tg$est / cg$est
c(r - 1, r * exp(-z * se) - 1, r * exp(z * se) - 1) } else rep(NA_real_, 3)
need <- tryCatch(if (abs(d) > 0) ceiling(stats::power.prop.test(p1 = cg$est, p2 = tg$est, sig.level = alpha, power = 0.8)$n) else NA_real_, error = function(e) NA_real_)
mde <- tryCatch(stats::power.prop.test(n = min(tg$n, cg$n), p1 = cg$est, sig.level = alpha, power = 0.8)$p2 - cg$est, error = function(e) NA_real_)
anyway <- tg$n * cg$est
sp <- NULL
if (has_spend) {
a <- value[g == k]; b <- value[g == control]; a <- a[!is.na(a)]; b <- b[!is.na(b)]
tt <- if (length(a) >= 2 && length(b) >= 2) tryCatch(stats::t.test(a, b, conf.level = conf), error = function(e) NULL) else NULL
if (!is.null(tt)) sp <- list(d = unname(mean(a) - mean(b)), lo = tt$conf.int[1], hi = tt$conf.int[2], p = tt$p.value,
rel = if (mean(b) != 0) unname(mean(a) / mean(b) - 1) else NA_real_)
}
list(group = k, d = d, lo = lo, hi = hi, p = p, rel = 100 * rel, need = need, mde = mde, nmin = min(tg$n, cg$n),
credited = tg$x, anyway = anyway, caused = tg$x - anyway, caused_lo = lo * tg$n, caused_hi = hi * tg$n, size = tg$n, spend = sp)
})
p_raw <- sapply(comp, `[[`, "p"); p_holm <- stats::p.adjust(p_raw, method = "holm")
sig <- !is.na(p_holm) & p_holm < alpha
labels_c <- paste(treatments, "vs", control)
lift_df <- data.frame(comparison = labels_c, lift_points = tidy(100 * sapply(comp, `[[`, "d")),
low = tidy(100 * sapply(comp, `[[`, "lo")), high = tidy(100 * sapply(comp, `[[`, "hi")), stringsAsFactors = FALSE)
results_df <- data.frame(
comparison = labels_c, rate_pct = tidy(100 * sapply(treatments, function(k) gs[[k]]$est)),
lift_points = tidy(100 * sapply(comp, `[[`, "d")),
interval = paste(as.character(tidy(100 * sapply(comp, `[[`, "lo"))), "to", as.character(tidy(100 * sapply(comp, `[[`, "hi")))),
relative_pct = tidy(sapply(comp, function(r) r$rel[1])), p_holm = p_text(p_holm),
significant = ifelse(sig, "yes", "no"), stringsAsFactors = FALSE)
caused_df <- data.frame(
comparison = labels_c, credited = as.integer(sapply(comp, `[[`, "credited")),
would_anyway = round(sapply(comp, `[[`, "anyway")), caused = round(sapply(comp, `[[`, "caused")),
caused_range = paste(round(sapply(comp, `[[`, "caused_lo")), "to", round(sapply(comp, `[[`, "caused_hi"))),
caused_share_pct = round(100 * sapply(comp, function(r) r$caused / r$credited)), stringsAsFactors = FALSE)
credit_df <- do.call(rbind, lapply(comp, function(r) data.frame(
group = r$group, buyers = round(c(r$credited, r$anyway, r$caused)),
series = c("Credited to the campaign", "Would have converted anyway", "Caused by the campaign"), stringsAsFactors = FALSE)))
power_df <- data.frame(
comparison = labels_c, group_rows = as.integer(sapply(comp, `[[`, "size")),
holdout_rows = as.integer(cg$n),
needed_per_group = sapply(comp, function(r) if (is.na(r$need)) NA_real_ else r$need),
detectable_points = tidy(100 * sapply(comp, `[[`, "mde")), observed_points = tidy(100 * sapply(comp, `[[`, "d")), stringsAsFactors = FALSE)
best <- which.max(sapply(comp, `[[`, "d"))
#' ## Extra spend per customer and per 1,000 contacted (Welch), when a value column was mapped
spend_df <- NULL
if (has_spend) {
ok <- !sapply(comp, function(r) is.null(r$spend))
if (any(ok)) {
cs <- comp[ok]
spend_df <- data.frame(
comparison = labels_c[ok], per_customer = tidy(sapply(cs, function(r) r$spend$d)),
per_1000 = tidy(1000 * sapply(cs, function(r) r$spend$d)),
interval_per_1000 = paste(as.character(tidy(1000 * sapply(cs, function(r) r$spend$lo))), "to", as.character(tidy(1000 * sapply(cs, function(r) r$spend$hi)))),
relative_pct = tidy(100 * sapply(cs, function(r) r$spend$rel)),
p_value = p_text(sapply(cs, function(r) r$spend$p)), stringsAsFactors = FALSE)
} else value_note <- sprintf("%s has too few numbers in a group to compare spend", value_name)
}
#' ## Assumption checks
counts <- sapply(gs, `[[`, "n")
min_events <- min(sapply(gs, function(k) min(k$x, k$n - k$x)))
pw <- comp[[best]]; power_ratio <- if (is.na(pw$need)) NA_real_ else pw$nmin / pw$need
hold_share <- cg$n / sum(counts)
miss_share <- (n_missing + n_uncoercible) / n_in
skew <- if (has_spend) { v <- value[!is.na(value)]; s <- stats::sd(v); if (s == 0) 0 else abs(mean((v - mean(v))^3) / s^3) } else NA_real_
checks_df <- data.frame(
check = c("Holdout is a real group", "Enough conversions in every group", "Test powered for the best observed lift",
"Spend not dominated by extremes", "Rows complete"),
statistic = c(sprintf("holdout holds %s of the contacted and held-out rows", paste0(round(100 * hold_share), "%")),
sprintf("fewest converters or non-converters in a group: %d", as.integer(min_events)),
if (is.na(power_ratio)) "no lift to power" else sprintf("%s of the rows 80%% power needs", paste0(round(100 * power_ratio), "%")),
if (has_spend) sprintf("skewness of spend: %s", format(round(skew, 1))) else "no spend column",
sprintf("%d of %d rows excluded", as.integer(n_missing + n_uncoercible), n_in)),
p_value = c("", "", "", "", ""),
verdict = c(if (cg$n >= 100) "holds" else if (cg$n >= 30) "strained" else "violated",
if (min_events >= 10) "holds" else if (min_events >= 5) "strained" else "violated",
if (is.na(power_ratio)) "strained" else if (power_ratio >= 1) "holds" else if (power_ratio >= 0.5) "strained" else "violated",
if (!has_spend || skew <= 2) "holds" else if (skew <= 5) "strained" else "violated",
if (miss_share <= 0.05) "holds" else if (miss_share <= 0.15) "strained" else "violated"),
note = c("a tiny holdout makes the baseline, and so everything called caused, rest on a handful of people",
"few converters make the rate difference and its interval unreliable",
"a test short of the rows it needs misses real lift and exaggerates the lift it finds",
"a few very large purchases can decide the spend difference; compare a capped spend if so",
"rows missing a group or an outcome are left out; if they are not random, the comparison is biased"),
stringsAsFactors = FALSE)
#' ## Method, assumptions, answer
excluded <- c(if (n_missing > 0) sprintf("%d row%s missing a group or outcome", n_missing, if (n_missing > 1) "s" else ""),
if (n_uncoercible > 0) sprintf("%d outcome value%s not read as a number", n_uncoercible, if (n_uncoercible > 1) "s" else ""),
if (n_value_blank > 0) sprintf("%d blank or unreadable value%s left out of the spend figures only", n_value_blank, if (n_value_blank > 1) "s" else ""),
if (length(dropped_groups)) sprintf("group%s dropped (fewer than 5 rows, or beyond the four largest): %s", if (length(dropped_groups) > 1) "s" else "", paste(dropped_groups, collapse = ", ")))
method <- paste0(
"Each contacted group against the holdout '", control, "' (", control_how, ") over ", n, " rows in ", length(order_g),
" groups; ", outcome_name, " read as ", success_how, "; lift is the difference in conversion rates with a ", conf_pct,
"% interval (Wilson for rates, Newcombe for the difference), p-values from a two-proportion z-test Holm-adjusted across ",
length(treatments), " comparison", if (length(treatments) > 1) "s" else "", " at alpha ", format(alpha),
"; caused conversions are the lift times the contacted group's size, with the interval scaled the same way, and would-have-converted-anyway is the holdout's rate times that size",
if (has_spend && !is.null(spend_df)) paste0("; extra spend is the difference in mean ", value_name, " (Welch interval), per customer and per 1,000 contacted") else "",
"; rows per group needed for 80% power at the observed lift",
if (length(excluded)) paste0("; excluded: ", paste(excluded, collapse = "; ")) else "",
if (!is.null(value_note) && !has_spend) paste0("; ", value_note) else "",
if (length(ignored_cols)) paste0("; not used: ", paste(utils::head(ignored_cols, 12), collapse = ", "), " (not mapped)") else "", ".")
assumptions <- list(
"Rows were assigned to the contacted group or the holdout at random; if the contacted group was chosen (the likeliest responders, opted-in), the lift measures the choice as well as the campaign.",
"Each row is counted once, in one group; a person or account seen in two groups breaks the comparison.",
"The outcome window was the same for every group and long enough for the response to show.",
"Caused counts are an estimate with a range, not an exact number: the range comes from the lift interval.",
"Several contacted groups share one Holm adjustment, which controls the chance of any false win across them.")
answer <- list(control = control, alpha = alpha, best_group = treatments[best],
best_lift_points = tidy(100 * comp[[best]]$d), best_relative_pct = tidy(comp[[best]]$rel[1]),
best_p_holm = p_text(p_holm[best]), credited = comp[[best]]$credited, would_anyway = round(comp[[best]]$anyway),
caused = round(comp[[best]]$caused), caused_low = round(comp[[best]]$caused_lo), caused_high = round(comp[[best]]$caused_hi),
significant_vs_control = sum(sig), n = n)
results <- list()
#' The verdict and the headline are NOT places of a library tool (LAT-3130): the last mile writes them.
sm <- list(groups = length(order_g), rows = n, holdout_rate_pct = tidy(100 * cg$est),
best_rate_pct = tidy(100 * gs[[treatments[best]]]$est), best_lift_points = tidy(100 * comp[[best]]$d),
credited = comp[[best]]$credited, would_anyway = round(comp[[best]]$anyway), caused = round(comp[[best]]$caused),
significant_vs_control = sum(sig))
results$summary_metrics <- place_metric(sm, lead = "caused", place = "summary_metrics")
results$credit_vs_cause <- place_comparison(credit_df, category = "group", value = "buyers", series = "series", place = "credit_vs_cause")
results$lift_interval <- place_interval(lift_df, term = "comparison", value = "lift_points", low = "low", high = "high", place = "lift_interval")
results$group_outcomes <- place_comparison(outcome_df, category = "group", value = "rate_pct", low = "ci_low", high = "ci_high", place = "group_outcomes")
results$caused_table <- place_table(caused_df, place = "caused_table")
results$results_table <- place_table(results_df, place = "results_table")
if (!is.null(spend_df)) {
results$spend_table <- place_table(spend_df, place = "spend_table")
} else {
results$spend_table <- place_dropped(value_note %||% "no spend to report", place = "spend_table")
}
results$holdout_size <- place_table(power_df, place = "holdout_size")
results$assumption_checks <- place_table(checks_df, place = "assumption_checks")
results$test_method <- list(kind = "metric", values = list(
method = method, n_in = n_in, n_used = n, excluded = as.list(excluded), assumptions = assumptions,
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, results = results, objects = objects,
json_output = list(answer = answer, method = method, n = n))
}