Incrementality
Compares each contacted group with a randomly held-out group on a conversion, and says how many customers 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 · 22 October 2026
DATA · 64,000 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 customers 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.
What the campaign caused
Caused bars sit well below credited
In both groups the caused bar is shorter than the credited bar, clearly so for Womens E-Mail, so credit overstates what the campaign added.
Compare the caused bar with the credited bar within each group, starting with Womens E-Mail where the gap is widest.
Caused bars sit well below credited
Mens E-Mail has the most credited customers and the most caused, and its caused bar is a little longer than the would-have-bought-anyway bar. For Womens E-Mail the caused bar is well under the anyway bar, so most of its credited customers would have bought anyway. The anyway bar is the same for both groups because it uses the one holdout rate. Caused is an estimate, so check its range on the caused table.
Compare the caused bar with the credited bar within each group, starting with Womens E-Mail where the gap is widest.
Both groups convert above the holdout
Womens E-Mail vs Control and Mens E-Mail vs Control both sit entirely above zero, with Mens E-Mail the larger lift.
Check that both intervals sit right of zero, and that the Mens E-Mail vs Control interval sits further right.
Both groups convert above the holdout
Neither interval crosses zero, so both contacted groups convert more than Control. The two intervals do not overlap, which goes with Mens E-Mail having a bigger lift than Womens E-Mail. Womens E-Mail vs Control has its lower bound closer to zero, so its effect is clear but smaller. This rests on groups having been assigned at random.
Check that both intervals sit right of zero, and that the Mens E-Mail vs Control interval sits further right.
Who converted
Mens E-Mail converts highest, Control lowest
Mens E-Mail has the highest conversion rate, then Womens E-Mail, then Control, and no interval overlaps another.
Look at the Control interval first, then see that Womens E-Mail and Mens E-Mail both sit entirely above it.
Mens E-Mail converts highest, Control lowest
Mens E-Mail's interval does not overlap Control's, and it also does not overlap Womens E-Mail's. Womens E-Mail's interval does not overlap Control's either. So the ordering of the three rates is clear. The lift card is what decides whether the differences are real, and it agrees.
Look at the Control interval first, then see that Womens E-Mail and Mens E-Mail both sit entirely above it.
Credit versus cause
Mens E-Mail caused a larger share
Mens E-Mail caused a larger share of its credited customers than Womens E-Mail, though both counts are estimates with ranges.
Womens E-Mail has the lower caused share, so more of its credit would have happened anyway.
Mens E-Mail caused a larger share
For Mens E-Mail vs Control, a little over half of credited customers were caused, and its range stays well above zero. For Womens E-Mail vs Control, a bit over a third were caused, with a range that reaches lower. Caused is the lift times group size, so it carries the lift's uncertainty and should not be read as exact. The ranges for the two groups do not overlap.
Womens E-Mail has the lower caused share, so more of its credit would have happened anyway.
The numbers
Both groups are significant winners
Both comparisons are significant with lift above zero, and Mens E-Mail vs Control is clearly the stronger result.
Mens E-Mail vs Control has the larger lift and a p-value below the reporting floor, which is not the same as zero.
Both groups are significant winners
Both rows say yes in the significant column, and both lift intervals sit above zero after the Holm adjustment. Mens E-Mail vs Control has the higher conversion rate, the larger lift and the larger relative lift. Womens E-Mail vs Control is clear but smaller. The difference holds only if customers were assigned at random.
Mens E-Mail vs Control has the larger lift and a p-value below the reporting floor, which is not the same as zero.
Extra spend
Both emails go with higher spend than holdout
Both emails go with more spend per customer contacted than the holdout, Mens E-Mail by more, though extreme purchases limit trust.
The Mens E-Mail interval sits higher but overlaps the Womens E-Mail one, so the gap between the two emails is less certain.
Both emails go with higher spend than holdout
Both comparisons sit above the holdout in spend per customer and for a large batch of contacts, and neither interval reaches zero. The p-values are small, and Mens E-Mail is ahead on both the absolute and relative gap. The spend skew check is violated, so a few very large purchases could be deciding these differences. Compare a capped spend next, and remember spend is per customer contacted, not per buyer.
The Mens E-Mail interval sits higher but overlaps the Womens E-Mail one, so the gap between the two emails is less certain.
How big a holdout needs to be
Both comparisons had more than enough rows
The test had ample rows for the lift it saw in both comparisons, so the observed lifts are not a small-sample artefact.
The smaller lift needs more rows, yet both groups still exceed their need and both lifts beat the smallest detectable lift.
Both comparisons had more than enough rows
Both contacted groups and the holdout are well above the rows 80% power needs. Womens E-Mail vs Control needs more rows because its lift is smaller, but it is still covered. Each observed lift is larger than the smallest lift the test could reliably detect, so the test could see these effects. Size is not the weak point here; look at the spend skew in the assumption checks instead.
The smaller lift needs more rows, yet both groups still exceed their need and both lifts beat the smallest detectable lift.
Assumptions and method
Checks: one violated, four hold
Violated: spend not dominated by extremes.
Holding: holdout is a real group, enough conversions in every group, test powered for the best observed lift, rows complete.
Checks: one violated, four hold
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 four hold.
Holding: holdout is a real group, enough conversions in every group, test powered for the best observed lift, rows complete.
Each contacted group against the holdout 'Control' (named like a holdout) over 64000 rows in 3 groups; converted 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 2 comparisons at alpha 0.05; caused customers are the lift times the contacted group's size, with the interval scaled the same way, and would-have-bought-anyway is the holdout's rate times that size; extra spend is the difference in mean spend (Welch interval), per customer and per 1,000 contacted; rows per group needed for 80% power at the observed lift.
64000 of 64000 rows · group → converted
caveatRandom assignment is assumed, not tested; the spend extremes check was violated, while the other checks held.
Each contacted group was compared with the Control holdout, with no rows excluded, and caused counts are estimates scaled from the lift interval. Random assignment, one group per customer and a common outcome window are assumed, not tested. The spend check was violated, so a few very large purchases could decide the extra spend result; compare a capped spend before leaning on it. The conversion comparisons are less exposed to this.
The code behind this report
The code that produced every figure in this report, exactly as it ran. Fingerprint 86c1fd686114c3c2. 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 customer: `group` (who was contacted and who was held out), `outcome` (did the customer 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 customers who 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 bought 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 customers are the lift times the contacted group's size, with the interval scaled the same way, and would-have-bought-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(
"Customers were assigned to the contacted group or the holdout at random; if the contacted group was chosen (best customers, opted-in), the lift measures the choice as well as the campaign.",
"Each customer is counted once, in one group; a customer 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))
}