Executive Summary
What contacting the top of the Model Score ranking actually captures
The short answer
The top decile holds 30.0% of all 150 responders—a 3.00x lift over the 10.00% base rate. Extending to 20% depth captures 50.0% (lift 2.50x), and to 30% captures 64.7% (lift 2.16x).
The detail
Ranked by Model Score, the best-scoring 10% of 1,500 rows holds 30.0% of responders, which is very strong separation. A perfect score at this depth would reach 10.00x; this score captures 30.0% of that available lift. The top 20% holds 50.0% of responders (lift 2.50x) and the top 30% holds 64.7% (lift 2.16x). No contact cost or value per response was supplied, so no profit-maximizing depth is computed. Contacting the top 10% breaks even once a response is worth 3.33 times a contact. All figures are measured on the rows the scores were supplied for.
What this can't tell you
If the model was fitted on these same rows, a fresh campaign should expect to capture less than 30.0% at 10% depth. The data carries no marker indicating whether the scores are in-sample or out-of-sample.
Analysis Overview
Gains and lift from ranking 1,500 rows by Model Score.
The short answer
Contacting only the top decile (best-scoring 10%) captures 30.0% of all responders—a 3.00x lift over random selection. This is strong separation, reaching about 30% of the theoretical maximum available at that depth.
The detail
The population is 1,500 rows with 150 'Yes' outcomes (10.00% base rate). Ranked by Model Score, the top 10% holds 30.0% of all responders, compared to the 10.00% that random targeting would deliver. The ceiling for any score at this depth is 10.00x; this score achieves 30.0% of that ceiling. Lift is cumulative gain divided by slice size: 30.0% / 10.0% = 3.00x.
What this can't tell you
The analysis cannot determine whether the Model Score was fitted on these same 1,500 rows. If in-sample, the 3.00x lift is optimistic; a fresh campaign should expect to capture less than 30.0%. If the scores are out-of-sample, this is an estimate of next-campaign performance, subject to sampling uncertainty across 150 responders.
Data Quality
Which rows were ranked, how the responder class was defined, and how ties were treated.
The short answer
All 1,500 rows carried usable outcomes and numeric scores; none were dropped. The 150 'Yes' responses (10.00% base rate) were ranked by Model Score and split into 10 equal buckets of 150 rows each. No tied scores required splitting at bucket boundaries.
The detail
Initial load: 1,500 rows. Rows removed: 0. All rows retained a valid outcome ('Yes' or 'No') and a numeric Model Score. 'Yes' was treated as the responding class (150 responders) against 'No' (1,350 non-responders). Rows were sorted by Model Score, with higher values interpreted as more likely to respond, then divided into 10 deciles of 150 rows each (10% of 1,500). Every row carried a distinct score, so no boundary splits were needed.
What this can't tell you
The data does not record whether the Model Score values were generated by a model already fitted to these outcomes. This analysis measures gains on the same rows the scores were supplied for, which can overstate performance if in-sample fitting occurred.
Cumulative Gains Curve
Share of all responders captured against the share of the list contacted, ranked by Model Score.
The short answer
The gains curve rises steeply above the random-targeting diagonal early, reaching 30.0% of responders at 10% population depth, then flattens progressively. The vertical gap between the curve and the diagonal at any depth is the extra value the ranking delivers there.
The detail
At each population share on the horizontal axis, the curve shows the share of all 150 responders captured by that point. The diagonal represents random targeting (x% contacted = x% of responders found). This curve reaches 30.0% of responders at 10%, 50.0% at 20%, 64.7% at 30%, and 82.7% at 50% depth. The curve flattens progressively after 10%, indicating diminishing marginal returns; where it approaches the diagonal, further contacts add little value.
What this can't tell you
The curve is measured on the same rows used to generate the Model Score, so it may overstate performance on a fresh population if the score was fitted in-sample.
Cumulative Lift Curve
How many times better than random targeting each contact depth performs.
The short answer
Contacting the top 10% of the population captures about 30% of all responders. The ranking delivers a 3.00x lift at that depth—meaning you get three times as many responses per contact as you would from random targeting—so the decile is highly efficient relative to the population base rate.
The detail
At 10% population depth, cumulative lift is 3.00x. Since the baseline response rate is 10.00%, a 3.00x lift means the top decile concentrates 30% of total responders (3.00 × 10% = 30%). The curve shows lift remains stable across the first decile, ranging from 2.667 to 3.111, with the value at exactly 10% population contact at 3.00. This tight band between 0.5% and 10% depth indicates the score ranks consistently at the top.
What this can't tell you
The curve does not reveal why the ranking performs at this level—only that it does. The analysis assumes the lift curve is stable across future deployments with similar populations and response mechanisms.
Decile Table
Responders, response rate, lift and cumulative gain in each decile of the Model Score ranking.
| Bucket | Population PCT | Contacted | Responders | Response Rate PCT | Lift | Cumulative Gain PCT | Cumulative Lift |
|---|---|---|---|---|---|---|---|
| Decile 1 | 10 | 150 | 45 | 30 | 3 | 30 | 3 |
| Decile 2 | 20 | 300 | 30 | 20 | 2 | 50 | 2.5 |
| Decile 3 | 30 | 450 | 22 | 14.67 | 1.467 | 64.67 | 2.156 |
| Decile 4 | 40 | 600 | 15 | 10 | 1 | 74.67 | 1.867 |
| Decile 5 | 50 | 750 | 12 | 8 | 0.8 | 82.67 | 1.653 |
| Decile 6 | 60 | 900 | 9 | 6 | 0.6 | 88.67 | 1.478 |
| Decile 7 | 70 | 1050 | 7 | 4.67 | 0.467 | 93.33 | 1.333 |
| Decile 8 | 80 | 1200 | 5 | 3.33 | 0.333 | 96.67 | 1.208 |
| Decile 9 | 90 | 1350 | 3 | 2 | 0.2 | 98.67 | 1.096 |
| Decile 10 | 100 | 1500 | 2 | 1.33 | 0.133 | 100 | 1 |
The short answer
The top decile responds at 30.00% (45 responders in 150 contacts), a lift of 3.00x. Lift decays monotonically: the second decile is 2.00x, the third is 1.467x, and by the fourth decile (40% depth) it has fallen to 1.00x. Only 3 of 10 deciles beat random targeting.
The detail
Decile 1 (top 10%): 45 responders, 30.00% response rate, lift 3.00x, cumulative gain 30.0%. Decile 2: 30 responders, 20.00% response rate, lift 2.00x, cumulative gain 50.0%. Decile 3: 22 responders, 14.67% response rate, lift 1.467x, cumulative gain 64.67%. Decile 4: 15 responders, 10.00% response rate, lift 1.00x, cumulative gain 74.67%. Deciles 5–10 all fall below the 10.00% base rate. Lift falls monotonically without reversals, indicating a well-ordered ranking.
What this can't tell you
The table is computed on the same rows the scores were supplied for, so it may overstate performance on a new population if the model was fitted in-sample.
Targeting Economics
What each contact depth costs to justify, and the profit at it when the economics are supplied.
| Depth | Contacted | Responders | Response Rate | Breakeven Value To Cost | Net Profit |
|---|---|---|---|---|---|
| Top 10.0% | 150 | 45.0 | 30.00% | 3.33 | n/a |
| Top 20.0% | 300 | 75.0 | 25.00% | 4.00 | n/a |
| Top 30.0% | 450 | 97.0 | 21.56% | 4.64 | n/a |
| Top 40.0% | 600 | 112.0 | 18.67% | 5.36 | n/a |
| Top 50.0% | 750 | 124.0 | 16.53% | 6.05 | n/a |
| Top 60.0% | 900 | 133.0 | 14.78% | 6.77 | n/a |
| Top 70.0% | 1,050 | 140.0 | 13.33% | 7.50 | n/a |
| Top 80.0% | 1,200 | 145.0 | 12.08% | 8.28 | n/a |
| Top 90.0% | 1,350 | 148.0 | 10.96% | 9.12 | n/a |
| Top 100.0% | 1,500 | 150.0 | 10.00% | 10.00 | n/a |
The short answer
Contacting the top 10% breaks even once a response is worth 3.33 times a contact cost. That ratio rises to 4.00x at 20% depth and 10.00x at full depth, because extending the contact list adds progressively lower-responding rows.
The detail
No contact cost or value per response was supplied, so no profit figures are computed. The break-even value-to-cost ratio at each depth is computed regardless. Top 10.0%: 3.33. Top 20.0%: 4.00. Top 30.0%: 4.64. Top 40.0%: 5.36. Top 50.0%: 6.05. Top 60.0%: 6.77. Top 70.0%: 7.50. Top 80.0%: 8.28. Top 90.0%: 9.12. Top 100.0%: 10.00. Read down this column and stop where the ratio exceeds what a response is actually worth to you.
What this can't tell you
No profit-maximizing depth can be identified without supplying a contact cost and value per response. The break-even ratios are measured on the same rows the scores were supplied for, so they may be optimistic if the model was fitted in-sample.
Method & Disclosure
How the ranking, the buckets, the ties and the economics were computed, and what the numbers do not establish.
| Item | Detail |
|---|---|
| Ranking | Rows are sorted by Model Score from highest to lowest; higher is assumed to mean more likely to be 'Yes'. |
| Gains | Cumulative gain at depth d is the share of all 150 'Yes' rows found within the best-scoring d of the population. |
| Lift | Cumulative lift at depth d is that gain divided by d — how many times better than contacting the same share of the list at random. Random targeting sits at lift 1.00 and a perfect score would reach 10.00x at 10% depth given this base rate of 10.00%. |
| Decile split | 1,500 usable rows give ten buckets of 10% each. |
| Ties | Every one of the 1,500 rows carries a distinct Model Score value, so no bucket boundary had to be split. |
| Economics | No contact cost and value per response were supplied, so no profit figure is computed. The break-even column instead gives the value-to-cost ratio at which each depth would just wash its face. |
| Where these numbers come from | The gains are measured on the same 1,500 rows the Model Score values were supplied for. Nothing in the data records whether those scores were produced by a model that had already seen these outcomes, so this analysis cannot tell you which case you are in. If the model was fitted on these rows, the 3.00x top-decile lift is an in-sample figure and a fresh campaign should be expected to capture less; if the scores are genuinely out-of-sample, it is an estimate of what the next campaign captures, carrying the usual sampling uncertainty of 150 responders. |
The short answer
Rows are sorted by Model Score and split into 10 equal deciles. Cumulative gain is the share of all 150 responders captured at each depth; cumulative lift is that gain divided by the population share. No model is fitted here and no significance test is run.
The detail
Ranking: 1,500 rows sorted by Model Score, highest first. Gains: cumulative gain at depth d is the share of all 150 'Yes' rows found in the best-scoring d% of the population. Lift: cumulative gain divided by d, showing how many times better than random targeting. Decile split: 1,500 rows divided into 10 buckets of 150 each (10% each). Ties: every row carries a distinct Model Score, so no boundary splits were needed. Economics: no contact cost or value per response was supplied, so only break-even ratios are computed.
What this can't tell you
The data does not record whether the Model Score was fitted on these same 1,500 rows. If in-sample, the 3.00x top-decile lift is an optimistic estimate; a fresh campaign should expect to capture less. Lift describes association, not the causal effect of contacting anyone.
Methodology
Statistical methodology and diagnostics for Lift & Gains — Targeting Value
Statistical Method
Standard-library analysis: cumulative gains and lift for campaign targeting decisions. Map the actual yes/no outcome and any ranking score — a model's propensity, a RFM rank, a hand-built priority number — and get the answer to "if I only contact the top N%, how much of the total value do I capture?". Delivers the cumulative gains curve against the random-targeting diagonal, the cumulative lift curve, a decile or ventile table with response rate and lift in each bucket, the top-decile lift as the headline number, the break-even value-to-cost ratio at every depth, and — when a contact cost and a value per response are supplied — the profit-maximizing contact depth.
- A higher score means more likely to be in the responding class
- The outcome is genuinely binary; any additional values are pooled as non-responding
- Each row is one contactable unit, so contacting the top N% of rows is a decision you can actually make
- The rows analysed are representative of the population the next campaign will draw from
- Gains measured on the rows a model was fitted on overstate what a fresh campaign captures, and nothing in the data records whether the scores are out-of-sample
- The profit-maximizing depth is chosen on the same outcomes it is evaluated against, so the profit at it is the most favourable reading of this data rather than a forecast
- Lift describes association between the ranking and the outcome, not the effect of contacting anyone — it cannot tell you whether contacting a row caused the response
- When bucket boundaries fall inside a run of tied scores the responders are shared out proportionally, which is the expected result of a random tie-break rather than any single ordering
Analysis Code
Complete R source code for this analysis
Lift & Gains — Targeting Value
Answers the campaign question "if I only contact the top N%, how much of the total value do I capture?". Takes a model score (or any ranking score) plus the actual binary outcome, sorts the population from best score to worst, and reports the cumulative gains curve, the lift curve, a decile/ventile table, and the profit-maximizing contact depth when the economics are supplied.
Why This Method?
A classifier's AUC tells you how well a score ranks; it does not tell you what a campaign captures. Gains and lift convert the same score into the operational number a targeting decision needs: contact the top N percent and you reach this share of all responders, this many times better than contacting N percent at random.
What This Analysis Covers
- The cumulative gains curve against the random-targeting diagonal
- The cumulative lift curve against the lift = 1 baseline
- A decile (or ventile / quintile) table: population share, responders,
response rate, within-bucket lift, cumulative gain, cumulative lift
- Targeting economics: the break-even value-to-cost ratio at every depth,
and — when a contact cost and a value per response are supplied — the profit-maximizing depth
- An explicit statement that the gains are measured on the rows the scores
were supplied for, and what that means if the model was fitted on them
Standard Library
Platform standard-library module (LAT-1441): runs on ANY dataset via the semantic mapping {actual, score} — the same mapping as the ROC analysis, so the two tools accept the same column choices. All narrative is derived from the user's own column names and computed values.
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))Round before banding: an exact 3.0 arrives as 2.9999999999999996 out of floating-point division and must not fall into the band below.
lift <- round(lift, 3)
if (lift < 1.1) "no better than random targeting"
else if (lift < 1.5) "marginal"
else if (lift < 2) "modest"
else if (lift < 3) "strong"
else "very strong"
}Step 1: Row accounting + semantic column discovery
initial_rows <- nrow(df)
if (!"actual" %in% names(df)) {
stop("column_mapping must map an 'actual' column (the true yes/no outcome).")
}
if (!"score" %in% names(df)) {
stop("column_mapping must map a 'score' column (the ranking score, higher = better).")
}
actual_name <- humanize_semantic("actual", col_map)
score_name <- humanize_semantic("score", col_map)Step 2: Choose the positive class + binarize the outcome
Same rule as the ROC module so the two tools agree on which class is "positive" for an identical column mapping.
v_raw <- df$actual
if (is.logical(v_raw)) {
keep_a <- !is.na(v_raw)
df <- df[keep_a, , drop = FALSE]
y <- as.integer(df$actual)
positive_label <- "TRUE"
negative_label <- "FALSE"
positive_rule <- "the boolean TRUE value"
} else {
vc <- trimws(as.character(v_raw))
keep_a <- !is.na(v_raw) & !is.na(vc) & vc != ""
df <- df[keep_a, , drop = FALSE]
vc <- vc[keep_a]
lv <- sort(unique(vc))
if (length(lv) < 2) {
stop(sprintf(
paste0("The outcome column('%s') has only one value ('%s') — a lift and gains ",
"analysis needs both responders and non-responders present."),
actual_name, if (length(lv) == 1) lv[1] else "empty"))
}
pat <- paste0("^(1|yes|true|positive|pos|responder|responded|response|",
"convert|converted|conversion|purchase|purchased|buyer|bought|",
"subscribed|churn|churned|fraud|default|defaulted|disease)$")
hits <- lv[grepl(pat, tolower(lv))]
if (length(hits) >= 1) {
positive_label <- hits[length(hits)]
positive_rule <- "it matched a conventional positive label"
} else {
positive_label <- lv[length(lv)]
positive_rule <- "no conventional positive label was found, so the alphabetically-last class was used"
}
neg_levels <- setdiff(lv, positive_label)
negative_label <- if (length(neg_levels) == 1) neg_levels[1]
else paste0("not ", positive_label)
if (length(lv) > 2) {
positive_rule <- paste0(positive_rule,
"; the outcome had more than two values, so everything else was pooled as non-responding")
}
y <- as.integer(vc == positive_label)
}Step 3: Coerce the score to numeric under the 95% rule
sc_raw <- df$score
if (is.numeric(sc_raw)) {
sc <- as.numeric(sc_raw)
coercion_rate <- 1
} else {
chr <- trimws(as.character(sc_raw))
nonblank <- !is.na(chr) & chr != ""
conv <- suppressWarnings(as.numeric(chr))
n_nonblank <- sum(nonblank)
coercion_rate <- if (n_nonblank > 0) sum(!is.na(conv) & nonblank) / n_nonblank else 0
if (coercion_rate < 0.95) {
stop(sprintf(
paste0("The score column('%s') could not be read as a number — only %s of its ",
"non-blank values converted. A lift and gains analysis needs a numeric ",
"ranking score where a higher value means more likely to respond."),
score_name, fpct(coercion_rate)))
}
sc <- conv
}
keep_s <- !is.na(sc) & !is.na(y)
sc <- sc[keep_s]
y <- y[keep_s]
final_rows <- length(y)
rows_removed <- initial_rows - final_rowsStep 4: Guards — enough rows, both classes, a score that ranks
if (final_rows < 50) {
stop(sprintf(
paste0("Only %d rows have both a usable outcome('%s') and a numeric score ('%s') — ",
"at least 50 are needed before the ranked list can be split into buckets."),
final_rows, actual_name, score_name))
}
n_responders <- sum(y == 1L)
n_non <- sum(y == 0L)
if (n_responders < 10 || n_non < 10) {
stop(sprintf(
paste0("A lift and gains analysis needs at least 10 of each outcome, but '%s' has ",
"%d '%s' and %d '%s' rows."),
actual_name, n_responders, positive_label, n_non, negative_label))
}
if (length(unique(sc)) < 2) {
stop(sprintf(
paste0("The score column('%s') holds a single value for every row, so it cannot ",
"rank anyone above anyone else — there is no top N%% to target."),
score_name))
}
n_total <- final_rows
base_rate <- n_responders / n_totalStep 5: Aggregate to unique score LEVELS (descending)
Working at the level of tied score values rather than of rows makes every number below independent of the arbitrary order of tied rows.
ord <- order(sc, decreasing = TRUE)
s_o <- sc[ord]
y_o <- y[ord]
run_end <- which(c(diff(s_o) != 0, TRUE))
cum_n <- run_end # rows covered through each level
cum_r <- cumsum(y_o)[run_end] # responders covered through each level
lev_n <- diff(c(0, cum_n))
lev_r <- diff(c(0, cum_r))Expected responders captured when contacting exactly k best-scored rows. Inside a run of tied scores the responders are shared out in proportion to how much of the run is contacted — the expected value under a random tie-break, and the only order-independent answer available.
gain_at_k <- function(k) {
k <- pmin(pmax(k, 0), n_total)
stats::approx(x = c(0, cum_n), y = c(0, cum_r), xout = k, rule = 2)$y
}
gain_pct_at <- function(d) gain_at_k(d * n_total) / n_responders
lift_at <- function(d) {
g <- gain_pct_at(d)
out <- rep(NA_real_, length(d))
ok <- d > 0
out[ok] <- g[ok] / d[ok]
out
}Step 6: Tie diagnostics — how much the tie rule had to do
n_levels <- length(lev_n)
max_tie <- max(lev_n)
pct_rows_tied <- sum(lev_n[lev_n > 1]) / n_totalStep 7: Bucket resolution — deciles unless the data says otherwise
n_buckets <- if (n_total >= 2000) 20L else if (n_total >= 100) 10L else 5L
bucket_word <- switch(as.character(n_buckets),
"20" = "ventile", "10" = "decile", "5" = "quintile")
bucket_title <- switch(as.character(n_buckets),
"20" = "Ventile", "10" = "Decile", "5" = "Quintile")
bucket_reason <- if (n_buckets == 20L) {
paste0(format(n_total, big.mark = ","),
" usable rows give twenty buckets of 5% each")
} else if (n_buckets == 10L) {
paste0(format(n_total, big.mark = ","),
" usable rows give ten buckets of 10% each")
} else {
paste0("only ", format(n_total, big.mark = ","),
" usable rows, so the split is five buckets of 20% each")
}
bk <- (seq_len(n_buckets)) * n_total / n_bucketsWhich bucket boundaries land strictly inside a run of tied scores?
b_idx <- vapply(bk, function(b) which(cum_n >= b - 1e-9)[1], integer(1))
at_level_end <- abs(cum_n[b_idx] - bk) < 1e-9
boundaries_in_tie <- sum((!at_level_end) & (lev_n[b_idx] > 1))Step 8: The bucket table
cum_resp <- gain_at_k(bk)
bucket_resp <- diff(c(0, cum_resp))
bucket_rows <- diff(c(0, bk))
bucket_rate <- bucket_resp / bucket_rows
bucket_lift <- bucket_rate / base_rate
cum_gain <- cum_resp / n_responders
depth_seq <- seq_len(n_buckets) / n_buckets
cum_lift <- cum_gain / depth_seq
bucket_table_df <- data.frame(
bucket = paste(bucket_title, seq_len(n_buckets)),
population_pct = round(100 * depth_seq, 2),
contacted = round(bk),
responders = round(bucket_resp, 1),
response_rate_pct = round(100 * bucket_rate, 2),
lift = round(bucket_lift, 3),
cumulative_gain_pct = round(100 * cum_gain, 2),
cumulative_lift = round(cum_lift, 3),
stringsAsFactors = FALSE
)Step 9: Curve datasets on a fixed depth grid (<= 201 points each)
grid <- seq(0, 1, by = 0.005)
gains_curve_df <- data.frame(
population_pct = round(100 * grid, 2),
cumulative_gain_pct = round(100 * gain_pct_at(grid), 3),
stringsAsFactors = FALSE
)
grid2 <- grid[grid > 0]
lift_curve_df <- data.frame(
population_pct = round(100 * grid2, 2),
cumulative_lift = round(lift_at(grid2), 3),
stringsAsFactors = FALSE
)Step 10: Headline depths + the attainable ceiling
gain_10 <- gain_pct_at(0.10)
gain_20 <- gain_pct_at(0.20)
gain_30 <- gain_pct_at(0.30)
gain_50 <- gain_pct_at(0.50)
top_decile_lift <- gain_10 / 0.10
lift_20 <- gain_20 / 0.20
lift_30 <- gain_30 / 0.30A perfect score puts every responder first, so at depth d the most gain anyone could capture is min(1, d / base_rate) and the most lift is min(1/d, 1/base_rate).
max_top_decile_lift <- min(1 / 0.10, 1 / base_rate)
ceiling_ratio <- top_decile_lift / max_top_decile_lift
band <- lift_band(top_decile_lift)A score sitting on its own ceiling is the signature of a label that leaked into the score, or of a score read back off the same rows it was fitted on — flagged as a condition, never asserted as a fact.
near_ceiling <- is.finite(ceiling_ratio) && ceiling_ratio >= 0.95Step 11: Targeting economics
Always computable: the value-to-cost ratio at which contacting to a depth breaks even, which is one divided by the response rate achieved to it.
econ_contacted <- bk
econ_resp <- cum_resp
econ_rate <- econ_resp / econ_contacted
breakeven_ratio <- ifelse(econ_resp > 0, econ_contacted / econ_resp, NA_real_)
contact_cost <- param_positive(params, c("contact_cost", "cost_per_contact",
"cost", "contact_cost_per_person"))
value_per_response <- param_positive(params, c("value_per_response",
"revenue_per_response",
"value_per_conversion",
"value", "margin_per_response"))
economics_on <- !is.na(contact_cost) && !is.na(value_per_response)
opt_depth <- NA_real_; opt_profit <- NA_real_; opt_contacts <- NA_real_
opt_resp <- NA_real_; profit_all <- NA_real_; profit_positive <- NA
econ_profit <- rep(NA_real_, n_buckets)
if (economics_on) {
econ_profit <- value_per_response * econ_resp - contact_cost * econ_contacted
fg <- seq(0.005, 1, by = 0.005)
fg_profit <- value_per_response * gain_at_k(fg * n_total) -
contact_cost * (fg * n_total)
ok_idx <- which(!is.na(fg_profit) & is.finite(fg_profit))
if (length(ok_idx) > 0) {
best <- ok_idx[which.max(fg_profit[ok_idx])]
opt_depth <- fg[best]
opt_profit <- fg_profit[best]
opt_contacts <- opt_depth * n_total
opt_resp <- gain_at_k(opt_contacts)
}
profit_all <- value_per_response * n_responders - contact_cost * n_total
profit_positive <- is.finite(opt_profit) && opt_profit > 0
}
targeting_economics_df <- data.frame(
depth = paste0("Top ", fnum(100 * depth_seq, 1), "%"),
contacted = fint(econ_contacted),
responders = fnum(econ_resp, 1),
response_rate = fpct(econ_rate, 2),
breakeven_value_to_cost = fnum(breakeven_ratio, 2),
net_profit = if (economics_on) fnum(econ_profit, 2) else rep("n/a", n_buckets),
stringsAsFactors = FALSE
)Step 12: Methods and disclosure table
tie_detail <- if (max_tie <= 1) {
paste0("Every one of the ", format(n_total, big.mark = ","), " rows carries a distinct ",
score_name, " value, so no bucket boundary had to be split.")
} else {
paste0(format(n_total, big.mark = ","), " rows share ", format(n_levels, big.mark = ","),
" distinct ", score_name, " values; ", fpct(pct_rows_tied),
" of rows sit on a value they share with at least one other row and the ",
"largest tied group holds ", format(max_tie, big.mark = ","), " rows. ",
if (boundaries_in_tie > 0)
paste0(boundaries_in_tie, " of the ", n_buckets, " ", bucket_word,
" boundaries fall inside a tied group, so the responders in that group ",
"were shared out in proportion to how much of it is contacted — the ",
"expected result of breaking those ties at random, rather than one ",
"arbitrary ordering. That is why some responder counts are not whole numbers.")
else
paste0("No ", bucket_word, " boundary falls inside a tied group, so the counts ",
"are exact whole numbers and no tie-breaking was needed."))
}
provenance_detail <- paste0(
"The gains are measured on the same ", format(n_total, big.mark = ","),
" rows the ", score_name, " values were supplied for. Nothing in the data records ",
"whether those scores were produced by a model that had already seen these outcomes, ",
"so this analysis cannot tell you which case you are in. If the model was fitted on ",
"these rows, the ", fnum(top_decile_lift, 2), "x top-decile lift is an in-sample figure ",
"and a fresh campaign should be expected to capture less; if the scores are genuinely ",
"out-of-sample, it is an estimate of what the next campaign captures, carrying the ",
"usual sampling uncertainty of ", format(n_responders, big.mark = ","), " responders."
)
methods_details_df <- data.frame(
item = c("Ranking", "Gains", "Lift", paste0(bucket_title, " split"),
"Ties", "Economics", "Where these numbers come from"),
detail = c(
paste0("Rows are sorted by ", score_name,
" from highest to lowest; higher is assumed to mean more likely to be '",
positive_label, "'."),
paste0("Cumulative gain at depth d is the share of all ",
format(n_responders, big.mark = ","), " '", positive_label,
"' rows found within the best-scoring d of the population."),
paste0("Cumulative lift at depth d is that gain divided by d — how many times ",
"better than contacting the same share of the list at random. Random ",
"targeting sits at lift 1.00 and a perfect score would reach ",
fnum(max_top_decile_lift, 2), "x at 10% depth given this base rate of ",
fpct(base_rate, 2), "."),
paste0(bucket_reason, "."),
tie_detail,
if (economics_on)
paste0("Profit at depth d is ", fnum(value_per_response, 2),
" per response times the responders reached, minus ", fnum(contact_cost, 2),
" per contact times the contacts made. The depth reported as best was chosen ",
"on these same rows, so the profit at it is the most favourable reading of ",
"this data rather than a forecast.")
else
paste0("No contact cost and value per response were supplied, so no profit figure ",
"is computed. The break-even column instead gives the value-to-cost ratio at ",
"which each depth would just wash its face."),
provenance_detail
),
stringsAsFactors = FALSE
)Step 13: KPI metrics + machine channels
metrics <- list(
`Observations` = n_total,
`Responders` = n_responders,
`Base Rate` = round(base_rate, 4),
`Top Decile Lift` = round(top_decile_lift, 3),
`Gain at 10%` = round(gain_10, 4),
`Gain at 20%` = round(gain_20, 4)
)
lift_summary <- list(
n_total = n_total, n_responders = n_responders, base_rate = base_rate,
top_decile_lift = top_decile_lift,
gain_10 = gain_10, gain_20 = gain_20, gain_30 = gain_30, gain_50 = gain_50,
lift_20 = lift_20, lift_30 = lift_30,
max_top_decile_lift = max_top_decile_lift, ceiling_ratio = ceiling_ratio,
near_ceiling = near_ceiling, band = band,
n_buckets = n_buckets, bucket_word = bucket_word,
n_levels = n_levels, max_tie = max_tie, pct_rows_tied = pct_rows_tied,
boundaries_in_tie = boundaries_in_tie,
economics_on = economics_on, contact_cost = contact_cost,
value_per_response = value_per_response,
opt_depth = opt_depth, opt_profit = opt_profit, opt_contacts = opt_contacts,
opt_resp = opt_resp, profit_all = profit_all,
breakeven_10 = breakeven_ratio[1],
positive_label = positive_label, negative_label = negative_label,
bucket_resp = bucket_resp, cum_resp = cum_resp
)
json_output <- list(
answer = paste0(
"Ranking ", format(n_total, big.mark = ","), " rows by ", score_name,
" and counting '", positive_label, "' outcomes in ", actual_name,
": the best-scoring 10% of the list holds ", fpct(gain_10),
" of all ", format(n_responders, big.mark = ","),
" responders, a lift of ", fnum(top_decile_lift, 2),
"x over the ", fpct(base_rate, 2), " base rate. The top 20% holds ",
fpct(gain_20), " and the top 30% holds ", fpct(gain_30), ". ",
if (economics_on && isTRUE(profit_positive))
paste0("At the supplied economics, profit peaks at a contact depth of ",
fpct(opt_depth), ".")
else if (economics_on)
paste0("At the supplied economics no contact depth turns a profit on this data.")
else
paste0("Contacting the top 10% pays for itself once a response is worth at least ",
fnum(breakeven_ratio[1], 2), " times a contact."),
" These gains are measured on the rows the scores were supplied for, so if the model ",
"was fitted on them they overstate what a fresh campaign captures."
),
cards = lapply(
c("tldr", "overview", "preprocessing", "gains_curve", "lift_curve",
"bucket_table", "targeting_economics", "methods"),
function(cid) list(id = cid, metrics = metrics)
)
)
list(
initial_rows = initial_rows, final_rows = final_rows, rows_removed = rows_removed,
actual_name = actual_name, score_name = score_name,
positive_label = positive_label, negative_label = negative_label,
positive_rule = positive_rule,
n_total = n_total, n_responders = n_responders, n_non = n_non,
base_rate = base_rate,
n_buckets = n_buckets, bucket_word = bucket_word, bucket_title = bucket_title,
bucket_reason = bucket_reason,
n_levels = n_levels, max_tie = max_tie, pct_rows_tied = pct_rows_tied,
boundaries_in_tie = boundaries_in_tie,
top_decile_lift = top_decile_lift, band = band,
gain_10 = gain_10, gain_20 = gain_20, gain_30 = gain_30, gain_50 = gain_50,
lift_20 = lift_20, lift_30 = lift_30,
max_top_decile_lift = max_top_decile_lift, ceiling_ratio = ceiling_ratio,
near_ceiling = near_ceiling,
best_bucket_lift = bucket_lift[1], worst_bucket_lift = bucket_lift[n_buckets],
breakeven = breakeven_ratio,
economics_on = economics_on, contact_cost = contact_cost,
value_per_response = value_per_response,
opt_depth = opt_depth, opt_profit = opt_profit, opt_contacts = opt_contacts,
opt_resp = opt_resp, profit_all = profit_all, profit_positive = profit_positive,
provenance_detail = provenance_detail, tie_detail = tie_detail,
gains_curve_df = gains_curve_df, lift_curve_df = lift_curve_df,
bucket_table_df = bucket_table_df,
targeting_economics_df = targeting_economics_df,
methods_details_df = methods_details_df,
lift_summary = lift_summary, metrics = metrics, json_output = json_output
)
}