Case 03: Test-and-learn

Which customers do we send the offer to, and which version do we send, for the best return?

Disclaimer. This notebook uses public data. The results are for illustration only. The data is not the data of an employer or a client. The margin and the contact cost are assumptions. The assumption register in the appendix gives the source of each assumption.

# Purpose: Load the libraries and the chart style. Set the seed, the paths, the assumptions (as-01, as-02, as-04),
#          the test parameters and the format helpers.
# Input:   chart_style.R, the path of the raw data file.
# Output:  `N` (numbers for the text), `SEED`, `DATA_DIR`, `RAW_FILE`, `MARGIN`, `COST`, `CAMPAIGN`, `ALPHA`,
#          `POWER`, helpers `usd()`, `pct()`, `num()`, `ci_txt()`, `fmt_p()`, chart style `CS`.

library(knitr)
library(rpart)  # Recommended package. It comes with each R installation.
source("chart_style.R")  # One chart style for all notebooks (deck style guide): CS, cs_setup(), cs_title()

# Fixed seed: each run gives the same bootstrap samples, folds and placebo tests.
SEED <- 42
set.seed(SEED)

# Paths are relative to this notebook (cases/03-test-and-learn/).
DATA_DIR <- file.path("..", "..", "data")  # The raw data is not in the repository. See the README.
RAW_FILE <- file.path(DATA_DIR, "raw", "Kevin_Hillstrom_MineThatData_E-MailAnalytics_DataMiningChallenge_2008.03.20.csv")
# Stop early with a clear message if the data file is missing.
if (!file.exists(RAW_FILE)) stop("Download the Hillstrom data to ", RAW_FILE, ". See the README.")

# Assumptions (assumption register in the appendix) and test parameters.
MARGIN <- 0.30      # as-01: contribution margin on incremental spend
COST <- 0.10        # as-02: full cost of one email, $
CAMPAIGN <- 1e5     # as-04: customers in one campaign, for the dollar values
ALPHA <- 0.05       # Significance level of each test
POWER <- 0.80       # Power for the test design (Step 3c)

# Format helpers for the text and the tables. Each returns text.
usd <- function(x, d = 2) ifelse(x < 0, paste0("-$", formatC(-x, format = "f", digits = d, big.mark = ",")),
                                 paste0("$", formatC(x, format = "f", digits = d, big.mark = ",")))
pct <- function(x, d = 1) paste0(formatC(100 * x, format = "f", digits = d), "%")
num <- function(x, d = 0) formatC(x, format = "f", digits = d, big.mark = ",")
ci_txt <- function(lo, hi, f = usd) paste0("[", f(lo), ", ", f(hi), "]")
fmt_p <- function(p) ifelse(p < 0.001, "< 0.001", formatC(p, format = "f", digits = 3))


N <- list()  # Numbers for the text after each chunk.
# Assumption values that the text of Step 0 uses.
N$as_margin <- pct(MARGIN, 0)
N$as_cost <- usd(COST)
N$as_campaign <- num(CAMPAIGN)
N$as_alpha <- pct(ALPHA, 0)
N$as_power <- pct(POWER, 0)
N$as_breakeven <- usd(COST / MARGIN)  # Breakeven effect: the uplift on spend at which margin x uplift = contact cost

How to read this notebook.

• The notebook hides the code. Click Show code to see the code of a step.
• A blue block is a decision. A green block is a business note. A grey block (Technical note) gives detail for data scientists. A business reader can skip it.
• The appendix holds the decision log, the assumptions, the glossary and the data dictionary.

Step 0. What and why

This step gives the business problem, the question for leadership and the method that answers it with a randomized test. Each later step answers one part of the question.

Purpose. This step answers: what must the campaign do for the business, and how does a test give a reliable answer? It supports this decision: the email version, the customers that get it, and the holdout after the launch.

0a. The business problem

Situation. A retailer sent an email to its customers who bought in the last year. The data source put each customer at random into one of three groups: the men’s email, the women’s email or no email. Then it measured visits, conversions and spend for two weeks. In this case, the email is a proxy for a card offer to card customers (as-05).

Complication. Each email has a contact cost: the cost to send, the creative work, and the future value that we lose when a customer unsubscribes (as-02). Most customers buy nothing in the test window, so the spend data is noisy. The mean effect can hide customers where the email loses money. Leadership asks two questions: “Which version do we send?” and “Do we send it to all customers?”

Question. Which email version do we send, and to which customers, for the most incremental profit?

Resolution. Measure the effect of each email on spend with the randomized test, and select the version. Then examine if the effect changes by segment, and if a targeting rule beats “send to all”. A decision layer changes the effect into dollars with the margin (as-01) and the contact cost (as-02). A holdout after the launch confirms the result.

Decision that this notebook supports. The email version, the customers that get it, and the size of the holdout after the launch.

Success metric. The incremental profit for each customer in the campaign: the incremental margin minus the contact cost. At the base assumptions, the margin is 30% and the contact cost is $0.10. Thus an email pays for itself if it adds more than $0.33 of spend (the breakeven effect).

0b. Method and data strategy

A technical reader asks one question first. Why does a difference of two group means give the causal effect of the email?

The answer is the random assignment. The data source, not the customer and not a model, selected the group of each customer. Thus, before the email, the three groups are the same on average. This is true for the features that we see and for the features that we do not see.

After the email, the only systematic difference between the groups is the email. Then a difference of means measures the effect of the email, with no model of customer behavior. Step 2d checks this condition with the data.

From the effect to a policy. The test gives one effect for each email. The business needs a policy: a version and a list of customers. We go from the effect to the policy in five moves. Each move uses the result of the move before it:

1. Effect. Does the email change spend, and is the test large enough to show the effect that matters? (Step 3, Step 4a)
2. Version. Which email gives the larger effect, also inside each product history? (Step 4b)
3. Segments. Does the effect of the selected email change by segment, after a correction for many tests? (Step 4c)
4. Uplift. Can a model or a simple rule rank the customers by their uplift? (Step 4d, Step 5)
5. Decision layer. At the margin and the contact cost, which rule selects the customers? How do we confirm it after the launch? (Step 6, Step 7)

If the effect is not real, the other moves have no base. If no segment and no model finds a reliable difference, the simple policy “send to all” stays.

The champion comes from the data. The dollar assumptions are ours. Cases 01 and 02 must build their champion, because their data has no real policy. This case does not need to.

Question	Answer
What is the champion here?	“No email”: the control group of the test. The data source chose these customers at random, so they show what customers do with no email.
What does the data give?	A real randomized test: three groups, with visits, conversions and spend for two weeks. Each effect in this notebook is a difference between real groups.
What does the data not give?	The margin on extra spend (as-01), the full contact cost of one email (as-02), the effect after two weeks (as-03) and a bank customer (as-05).
Which assumptions do we add?	A margin of 30% (as-01), a contact cost of $0.10 (as-02) and a campaign of 100,000 customers (as-04). They change the effect into dollars.
How can they be wrong?	A higher contact cost or a lower margin can make “send to all” lose money. Then a targeting rule becomes better.
How do we test them?	Step 7a gives the profit at contact costs from $0.05 to $0.30, and Step 7c at margins of 20%, 30% and 40%. Step 7a gives the contact costs at which the decision changes.
What does not depend on them?	The effect of each email, the choice of the version and the order of customers by history. These results use only the test data.

Why “send to all” is the default. A targeting rule must earn its place. We set the rules of the evaluation framework before the rerun of this version (Step 3a). An ML uplift model replaces a simple rank by history only if it is clearly better in repeated tests. A targeting rule replaces “send to all” only if the interval of its gain is above zero at the base contact cost.

The proxy (as-05). The data is an email test of a retailer, not a test of a bank. A card issuer has the same decision for a card offer: which offer, to which customers, at which contact cost. The size of each effect is different for a card offer, and the margin and the contact cost are different too. The method stays the same. Part 2 applies it to a pricing test and a collections test of case 01.

The limits of the method.

• The test window is two weeks (as-03). We do not know the long-term effect: more future purchases, or fatigue and unsubscribes.
• The data has no unsubscribes and no costs. The margin (as-01) and the contact cost (as-02) are assumptions. Step 7c repeats the result for other values.
• Few customers buy in the test window. Thus each segment effect has a wide interval, and a model with many features can fit noise.
• The segments and the uplift method come from the same test. Cross-fitted estimates decrease the risk of a result that is too good, but a new test must confirm a targeting rule.
• The data comes from one retailer in 2008. The dollar values are for this retailer.

Technical note. The method has these parts. Each later step gives the code.

• Randomization check. For each pre-test feature \(x\), the standardized difference is \((\bar{x}_{\text{email}} - \bar{x}_{\text{control}}) / s_x\). A chi-square test compares the group sizes with an equal split (the sample-ratio check). Step 3a gives the limit of each check.
• Average effect. The effect is \(\hat{\tau} = \bar{y}_1 - \bar{y}_0\), with the Welch standard error \(\sqrt{s_1^2/n_1 + s_0^2/n_0}\). A bootstrap, CUPED and a regression adjustment check the same effect (Step 4a).
• Power. For \(n\) customers in each group, the MDE is about \((z_{1-\alpha/2} + z_{1-\beta}) \, s \sqrt{2/n}\). The notebook uses a significance level of 5% and a power of 80% (Step 3c).
• Segments. An interaction F-test for each feature first. Then the effect of each segment, with the Holm correction (Step 4c).
• Uplift. A five-fold cross-fit gives each customer an uplift from a model that did not see that customer. The Qini area compares the order of each method with a random order, in repeated cross-fits (Step 4d).
• Decision layer. The breakeven effect is contact cost / margin. The breakeven rule sends the email if \(\text{margin} \times \widehat{\text{uplift}} > \text{contact cost}\). For each customer in the campaign, the profit of a selection is \(p \, (m \, \hat{\tau}_S - c)\). Here \(p\) is the share of customers in the selection, \(m\) the margin and \(c\) the contact cost (Step 7a).

0c. How the notebook answers the question

Each step answers one part of the question:

• Step 1. Which data gives a randomized test of an offer, and what does it contain?
• Step 2. Is the data clean, are the groups the same before the email, and what does a customer spend without an email?
• Step 3. Which rules must the result pass, how does the test split the customers, and which metric decides?
• Step 4. How large is the effect of each email? Which version do we send? Does the effect change by segment? Which method ranks the customers by uplift?
• Step 5. What is the cross-fitted uplift of each customer, by history quartile?
• Step 6. Does the recommended policy pass each rule of the evaluation framework?
• Step 7. Which customers get the email, what is it worth in dollars, and how do we confirm it after the launch?
• Part 2. How does the same method design a pricing test and a collections test for case 01?

Business note. The question is a trade between the incremental margin of each email and its contact cost. A randomized test gives the effect without a model, so the core result is a measured fact, not a model estimate. A targeting rule must beat this simple result before we use it. Step 1 shows the data that gives this test.

Step 1. Get data

Step 0 set the question and the method: measure the effect of each email with a randomized test, then build a policy in five moves. This step answers: which data gives this test, and what does it contain?

Purpose. This step gets the data and its meaning. It supports this decision: if the data can answer the business question.

1a. Why this data

The data is the MineThatData email test of Kevin Hillstrom (2008). Source: the MineThatData blog, file Kevin_Hillstrom_MineThatData_E-MailAnalytics_DataMiningChallenge_2008.03.20.csv. The data is a fair proxy for a card offer, for five reasons:

• A real randomized test. The retailer put each customer at random into a group. Thus a difference of means gives the causal effect (Step 0b).
• A choice like a card offer. The test has two versions of one campaign and a control group with no contact. A card issuer has the same choice: which offer, or no offer.
• Outcomes in dollars. Spend gives the dollars that the decision layer needs. Visit and conversion help to explain the spend result.
• Pre-test features. History, recency, product history, channel and area type describe each customer before the email. Thus we can examine segments and uplift.
• A public source. Each reader can get the same file and repeat each result.

The data cannot show these things:

What the data does not show	Why it matters	What the notebook does
Bank customers and a card offer	The size of each effect is different for a card offer.	The email is a proxy (as-05). The method stays the same. Part 2 applies it to two tests of case 01.
Unsubscribes and the cost of an email	The contact cost decides if targeting beats “send to all”.	The contact cost is an assumption (as-02). Step 7c repeats the result for other costs. Step 7d watches the unsubscribe rate.
The margin of each purchase	The profit needs the margin.	The margin is an assumption (as-01). Step 7c repeats the result for other margins.
The long-term effect	The test window is two weeks (as-03).	A holdout after the launch (Step 7d).
Spend above a maximum value	The data source cut the largest spend values.	Step 2 examines the effect of this cap.

1b. Key variables

The table gives all columns of the file. The treatment is segment, and the primary outcome is spend (Step 3c). Appendix A also gives the coded features that Step 1c and Step 2 make.

Column	Meaning in plain words	Type	Use
segment → arm	The test group of the customer: “Mens E-Mail”, “Womens E-Mail” or “No E-Mail”.	Text → category	Treatment
spend	The dollars that the customer spent in the two weeks after the email.	**Number (\()** | **Primary outcome** | | `visit` | 1 = the customer visited the website in the two weeks after the email. | 1/0 | Secondary outcome | | `conversion` | 1 = the customer bought something in the two weeks after the email. | 1/0 | Secondary outcome | | `history` | The dollars that the customer spent in the last year, before the test. | Number (\))	Pre-test feature. Rank by history (Step 4d).
history_segment	The same history in buckets, for example “1) $0 - $100”.	Text → category	Pre-test feature (hseg). Segment effects (Step 4c).
recency	The number of months since the last purchase.	Number	Pre-test feature
mens	1 = the customer bought men’s products in the last year.	1/0	Pre-test feature. Product history (buyer).
womens	1 = the customer bought women’s products in the last year.	1/0	Pre-test feature. Product history (buyer).
newbie	1 = a new customer in the last year.	1/0	Pre-test feature
channel	The channels where the customer bought in the last year: Phone, Web or Multichannel.	Category	Pre-test feature
zip_code	The area type of the address: Urban, Suburban or Rural. The file writes “Surburban”.	Category	Pre-test feature (zip)

The email cannot change a pre-test feature, so a pre-test feature is fair input for a segment or an uplift model. An outcome is never a feature. Step 2d also uses the pre-test features to check that the groups are the same before the email.

1c. Load the data and look at it

The file is small, so the code reads it in one step with base R. The load also makes the coded columns that the later steps use:

• arm: the test group, with the control group first. Thus each effect is “email minus control”.
• buyer: the product history. It is “mens only”, “womens only” or “both”, from mens and womens.
• hseg: the history bucket, without the number at the start of the label.
• zip and channel: the area type and the channel as categories.
• lhist: the log of history. It decreases the effect of the largest histories in a regression.

# Purpose: Read the Hillstrom file and make the coded columns that Steps 2-7 use.
# Input:   RAW_FILE (setup chunk).
# Output:  `d` (one row for each customer, with `arm`, `buyer`, `hseg`, `zip`, `channel`, `lhist`),
#          `RAW_COLS` (the column names of the raw file), numbers for the text (`N`).

d <- read.csv(RAW_FILE, stringsAsFactors = FALSE)
RAW_COLS <- names(d)  # The 12 columns of the raw file, before the coded columns

# Test group. The control group is the first level, so each effect is "email minus control".
d$arm <- factor(d$segment, levels = c("No E-Mail", "Mens E-Mail", "Womens E-Mail"),
                labels = c("control", "mens", "womens"))
# Product history: men's products, women's products, or both, in the last year
d$buyer <- factor(ifelse(d$mens == 1 & d$womens == 1, "both", ifelse(d$mens == 1, "mens only", "womens only")),
                  levels = c("mens only", "womens only", "both"))
# History bucket: remove the number at the start ("1) "). The sort of the raw labels keeps the dollar order.
d$hseg <- factor(sub("^\\d\\) ", "", d$history_segment), levels = sub("^\\d\\) ", "", sort(unique(d$history_segment))))
d$zip <- factor(d$zip_code)
d$channel <- factor(d$channel)
d$lhist <- log(d$history)  # History is always more than $0, so the log is defined

N$rows <- num(nrow(d))
N$n_arm <- num(min(table(d$arm)))
N$spend_zero <- pct(mean(d$spend == 0))
N$spend_max <- usd(max(d$spend), 0)
N$conv_spend_ok <- all((d$spend > 0) == (d$conversion == 1))  # Spend > $0 if and only if a conversion

The next chunk shows the initial state of the data before any change: the size, the groups, the outcomes and the spend cap.

# Purpose: Show the initial state of the data before any change: size, groups, outcomes and the spend cap.
# Input:   `d`, `RAW_COLS` (load-data chunk).
# Output:  Numbers for the text (`N`), table of the initial state.

n_grp <- table(d$arm)
N$s1_raw_cols <- num(length(RAW_COLS))
N$s1_cols <- num(ncol(d))
N$s1_n_ctrl <- num(n_grp[["control"]])
N$s1_n_mens <- num(n_grp[["mens"]])
N$s1_n_womens <- num(n_grp[["womens"]])
N$s1_missing <- num(sum(is.na(d[RAW_COLS])))
N$s1_buyers <- num(sum(d$conversion == 1))
N$s1_conv <- pct(mean(d$conversion), 2)
N$s1_visit <- pct(mean(d$visit), 1)
N$s1_cap_n <- num(sum(d$spend == max(d$spend)))  # Customers at the largest spend value

kable(data.frame(
  Fact = c("Rows (customers)", "Columns: raw file / after the load",
           "Customers in each group: no email / men's email / women's email", "Missing values (raw columns)",
           "Share with $0 spend in the test window", "Visit rate, all groups", "Conversion rate, all groups",
           "Buyers (conversion = 1)", "Largest spend (the spend cap)", "Customers at the spend cap",
           "Spend > $0 if and only if a conversion"),
  Value = c(N$rows, paste(N$s1_raw_cols, "/", N$s1_cols),
            paste(N$s1_n_ctrl, "/", N$s1_n_mens, "/", N$s1_n_womens), N$s1_missing,
            N$spend_zero, N$s1_visit, N$s1_conv, N$s1_buyers, N$spend_max, N$s1_cap_n,
            ifelse(N$conv_spend_ok, "Yes", "No"))),
  row.names = FALSE, align = "lr")

Fact	Value
Rows (customers)	64,000
Columns: raw file / after the load	12 / 17
Customers in each group: no email / men’s email / women’s email	21,306 / 21,307 / 21,387
Missing values (raw columns)	0
Share with $0 spend in the test window	99.1%
Visit rate, all groups	14.7%
Conversion rate, all groups	0.90%
Buyers (conversion = 1)	578
Largest spend (the spend cap)	$499
Customers at the spend cap	12
Spend > $0 if and only if a conversion	Yes

The data has 64,000 customers and 12 columns. The load adds the coded columns, so d has 17 columns. The raw file has 0 missing values. The three groups have 21,306, 21,307 and 21,387 customers. These sizes are near to an equal split, and Step 2d tests this with the sample-ratio check.

Of all customers, 99.1% spend $0 in the test window. Only 578 customers buy something: a conversion rate of 0.90%. The visit rate is 14.7%. Thus spend is mostly zeros with a long right tail. Step 3 shows why this shape makes the test need many customers.

The largest spend is $499, and 12 customers have exactly this value. Thus the data source probably cut the spend at this value. Step 2 examines the effect of this cap. Each customer with spend more than $0 has a conversion, and each conversion has spend. Thus the two outcomes agree.

Business note. The data is a real randomized test with outcomes in dollars, so it can answer the business question. It cannot show bank customers, the contact cost or the long-term effect, and the notebook says where each limit matters. Step 2 checks the data and the randomization, and it measures what a customer spends without an email.

Step 2. Clean and prepare data

Step 1 showed that the Hillstrom file can answer the business question. It has one row for each customer, the test group of the customer and three outcomes over two weeks. But a test result is valid only if the groups were the same before the email. The spend data also has a cap and many customers with $0.

This step answers three questions. Which rows, columns and values can the analysis use? Do the groups differ only by the email? What do customers do without an email?

Purpose. This step makes sure that the test data can give a causal effect. It supports this decision: use the test result for the campaign decision, or run a new test.

The data preparation follows one tree with three levels. Each level has one split axis. Each axis divides all cases into groups that do not overlap and that together cover all cases (MECE).

Level	Split axis	Groups	What this data needs	Section
Rows	Is the record a valid customer of the test?	Not valid · valid	Six technical checks. The test selected the customers, so each valid row is in scope.	2a
Columns	When does the value exist, against the time of the email?	Before the email (pre-test feature) · the test group · after the email (outcome)	An outcome never goes into a model as a feature. The pre-test features show if the groups are the same (2d).	2b
Values	Why is a value extreme, coded or empty?	Extreme value from a cap · two outcomes that must agree · coded values · empty cells	The spend cap. Spend against conversion. Five coded features. A check for missing values.	2c

Then Step 2d checks the random assignment: the evidence for branch 1 (validity) of the framework. Step 2e measures the baseline: what the control group does without an email.

2a. Rows: which customers can the analysis use?

The data source put each customer at random into one of three groups. Thus the analysis must keep all valid rows: a removed row can make the groups different. The code checks six conditions. A record is not valid if its test group is not one of the three groups, or if an outcome is not 0 or 1. It is also not valid if the spend is less than $0 or the history is $0 or less. The last check is a recency outside 1–12 months.

The data has no customer ID. Thus the code cannot find a customer who is in the file two times.

# Purpose: Check that each row is a valid customer of the test (Step 2a).
# Input:   `d` (from the load chunk of Step 1).
# Output:  Table `row_checks` (rows that fail each check). N values for the text.

# Each check gives TRUE for a row that is not valid.
row_checks <- list(
  `Test group not one of the three groups` = is.na(d$arm),
  `Visit not 0 or 1` = !d$visit %in% c(0, 1),
  `Conversion not 0 or 1` = !d$conversion %in% c(0, 1),
  `Spend less than $0` = d$spend < 0,
  `History of $0 or less` = d$history <= 0,
  `Recency outside 1-12 months` = !d$recency %in% 1:12
)
invalid <- Reduce(`|`, row_checks)
N$n_rows_raw <- num(nrow(d))
N$n_invalid <- num(sum(invalid))
# A random test keeps all valid rows. The code stops if a row fails, so that a later step cannot hide it.
if (any(invalid)) stop(sum(invalid), " rows fail a technical check. Examine them before you continue.")
kable(data.frame(Check = names(row_checks), `Rows that fail` = num(sapply(row_checks, sum)),
                 check.names = FALSE), row.names = FALSE, align = "lr")

Check	Rows that fail
Test group not one of the three groups	0
Visit not 0 or 1	0
Conversion not 0 or 1	0
Spend less than $0	0
History of $0 or less	0
Recency outside 1-12 months	0

0 of the 64,000 rows fail a check. The file is clean at the row level, and each row is in scope.

2b. Columns: which values exist before the email?

A test compares groups that were the same before the treatment. Thus the split axis for a column is its time against the email. A column that exists before the email describes the customer. A column that exists after the email is an outcome: the email can change it. An outcome never goes into a model as a feature. Otherwise the model learns the result of the email from the result itself.

# Purpose: Give each raw column its role: pre-test feature, test group or outcome (Step 2b).
# Input:   `d`.
# Output:  `COL_ROLE` (named vector, raw column -> role; Appendix A uses it). Table of the roles.

COL_ROLE <- c(recency = "Pre-test feature", history_segment = "Pre-test feature", history = "Pre-test feature",
              mens = "Pre-test feature", womens = "Pre-test feature", zip_code = "Pre-test feature",
              newbie = "Pre-test feature", channel = "Pre-test feature", segment = "Test group",
              visit = "Outcome", conversion = "Outcome", spend = "Outcome")
# Check: the roles cover each raw column one time.
stopifnot(setequal(names(COL_ROLE), c("recency", "history_segment", "history", "mens", "womens", "zip_code",
                                      "newbie", "channel", "segment", "visit", "conversion", "spend")),
          all(names(COL_ROLE) %in% names(d)))
role_tab <- data.frame(Role = c("Pre-test feature", "Test group", "Outcome"),
                       Time = c("Before the email", "At the email", "In the two weeks after the email"),
                       Use = c("Balance check (2d), segments (4c), uplift models (4d)",
                               "The treatment: no email, men's email or women's email",
                               "Metrics of the test. Never a feature."))
role_tab$Columns <- sapply(role_tab$Role, function(r) paste(names(COL_ROLE)[COL_ROLE == r], collapse = ", "))
N$n_pre <- sum(COL_ROLE == "Pre-test feature")
N$n_out <- sum(COL_ROLE == "Outcome")
N$n_raw_cols <- length(COL_ROLE)
kable(role_tab[, c("Role", "Columns", "Time", "Use")], row.names = FALSE)

Role	Columns	Time	Use
Pre-test feature	recency, history_segment, history, mens, womens, zip_code, newbie, channel	Before the email	Balance check (2d), segments (4c), uplift models (4d)
Test group	segment	At the email	The treatment: no email, men’s email or women’s email
Outcome	visit, conversion, spend	In the two weeks after the email	Metrics of the test. Never a feature.

The file has 8 pre-test features, one test group and 3 outcomes. The email can change the outcomes, but it cannot change the pre-test features. Thus a difference of a pre-test feature between the groups can come only from the random assignment. Step 2d uses this fact for the balance check.

2c. Values: the spend cap, the outcomes, the coded features and empty cells

The split axis for a value is the reason that it needs attention. A value can be extreme, two outcomes can disagree, a raw value can need a code, or a cell can be empty. The code checks each group.

# Purpose: Check the values of Step 2c: the spend cap, the agreement of the outcomes, the coded features
#          and the empty cells.
# Input:   `d` (with the coded features of the load chunk).
# Output:  Table `value_checks`. Table `coded`. N values for the text.

# Extreme value: the largest spend repeats. We read this as a cap of the data source.
spend_max <- max(d$spend)
at_cap <- d$spend == spend_max
N$cap <- usd(spend_max, 0)
N$n_cap <- num(sum(at_cap))
N$n_buyers <- num(sum(d$spend > 0))
N$cap_usd_share <- pct(sum(d$spend[at_cap]) / sum(d$spend))
N$spend_2nd <- usd(max(d$spend[!at_cap]), 2)
N$buyer_median <- usd(median(d$spend[d$spend > 0]), 0)

# Outcomes that must agree: spend > $0 if and only if conversion = 1. A conversion needs a visit.
n_spend_noconv <- sum((d$spend > 0) != (d$conversion == 1))
n_conv_novisit <- sum(d$conversion == 1 & d$visit == 0)
# Coded values: the history bucket must hold the history in dollars. Parse "$100 - $200" and "$1,000 +".
h_txt <- sub("^\\d\\) ", "", d$history_segment)  # Remove the bucket number "1) " to "7) "
bounds <- lapply(regmatches(h_txt, gregexpr("[0-9][0-9,]*", h_txt)), function(x) as.numeric(gsub(",", "", x)))
h_lo <- sapply(bounds, `[`, 1)
h_hi <- sapply(bounds, function(b) if (length(b) > 1) b[2] else Inf)  # "$1,000 +" has no upper bound
n_hseg_bad <- sum(d$history < h_lo | d$history >= h_hi)
# Each customer bought men's products, women's products or both. "Neither" must not exist.
n_no_product <- sum(d$mens == 0 & d$womens == 0)
# Empty cells in all raw columns.
n_na <- sum(is.na(d[, names(COL_ROLE)]))

value_checks <- data.frame(
  Group = c("Extreme value", "Outcomes that must agree", "Outcomes that must agree",
            "Coded values", "Coded values", "Empty cells"),
  Check = c(paste0("Buyers with spend at the largest value (", N$cap, ")"),
            "Spend > $0 without a conversion, or a conversion with $0",
            "Conversion without a visit",
            "History outside its history bucket",
            "Customer with neither men's nor women's products",
            paste("Empty cells in the", length(COL_ROLE), "raw columns")),
  Rows = num(c(sum(at_cap), n_spend_noconv, n_conv_novisit, n_hseg_bad, n_no_product, n_na)))
N$n_spend_noconv <- num(n_spend_noconv)
N$n_conv_novisit <- num(n_conv_novisit)
N$n_hseg_bad <- num(n_hseg_bad)
N$n_no_product <- num(n_no_product)
N$n_na <- num(n_na)
kable(value_checks, row.names = FALSE, align = "llr")

Group	Check	Rows
Extreme value	Buyers with spend at the largest value ($499)	12
Outcomes that must agree	Spend > $0 without a conversion, or a conversion with $0	0
Outcomes that must agree	Conversion without a visit	0
Coded values	History outside its history bucket	0
Coded values	Customer with neither men’s nor women’s products	0
Empty cells	Empty cells in the 12 raw columns	0

What we do with each group:

Group	Example in this data	What we do
Extreme value from a cap	12 of the 578 buyers have exactly $499. The next largest spend is $482.31. These buyers hold 8.9% of all spend dollars.	Keep the value. The cap is the same in each group, so it does not change the comparison. The effect is an effect on spend up to the cap.
Two outcomes that must agree	0 rows have spend without a conversion, or a conversion without spend. 0 rows have a conversion without a visit.	No change is necessary. Visit, conversion and spend tell one consistent story for each customer.
Coded values	0 customers have a history outside their history bucket. 0 customers have neither men’s nor women’s products.	Use the coded features of the table below.
Empty cells	0 empty cells in the 12 raw columns.	No imputation is necessary.

Why we do not cap the spend again. The median buyer spends $81, so the cap affects only a few large orders. A second cap at a lower value (winsorization) makes the variance smaller. But it also changes the outcome that the profit calculation uses. The cap of the data source is the same in all three groups, so the comparison stays fair.

The load chunk of Step 1 makes five coded features from the raw columns. The table shows each one with its levels.

# Purpose: Show the coded features of the load chunk and check that each one has a value for each row.
# Input:   `d`.
# Output:  Table `coded`. N values for the text.

coded <- data.frame(
  Feature = c("arm", "buyer", "hseg", "zip", "channel", "lhist"),
  Source = c("segment", "mens, womens", "history_segment", "zip_code", "channel", "history"),
  Rule = c("Test group: control, mens, womens",
           "Product history: men's only, women's only, or both",
           "History bucket without the number prefix, in the order of the dollars",
           "Area type as a factor",
           "Purchase channel as a factor",
           "Natural log of the history, for the models with a straight line"))
coded$Levels <- sapply(coded$Feature, function(f) {
  x <- d[[f]]
  if (is.factor(x)) paste0(nlevels(x), ": ", paste(levels(x), collapse = ", "))
  else paste0("from ", formatC(min(x), format = "f", digits = 2), " to ", formatC(max(x), format = "f", digits = 2))
})
# Check: each coded feature has a value for each row.
stopifnot(!anyNA(d[, coded$Feature]))
N$lhist_lo <- formatC(min(d$lhist), format = "f", digits = 2)
N$hist_min <- usd(min(d$history))
kable(coded, row.names = FALSE)

Feature	Source	Rule	Levels
arm	segment	Test group: control, mens, womens	3: control, mens, womens
buyer	mens, womens	Product history: men’s only, women’s only, or both	3: mens only, womens only, both
hseg	history_segment	History bucket without the number prefix, in the order of the dollars	7: $0 - $100, $100 - $200, $200 - $350, $350 - $500, $500 - $750, $750 - $1,000, $1,000 +
zip	zip_code	Area type as a factor	3: Rural, Surburban, Urban
channel	channel	Purchase channel as a factor	3: Multichannel, Phone, Web
lhist	history	Natural log of the history, for the models with a straight line	from 3.40 to 8.12

The smallest history is $29.99, so the log of the history (lhist) has no empty value. buyer has three levels that do not overlap, because no customer has neither product type.

2d. Randomization check: do the groups differ only by the email?

This check gives the evidence for branch 1 (validity) of the framework in Step 3a. If the groups are different before the email, a difference of the outcomes can come from the customers and not from the email. The check has two parts:

• Balance. The standardized difference of each pre-test feature between each email group and the control group. The rule is: each absolute value is less than 0.05.
• Sample ratio. The number of customers in the three groups against an equal split. The rule is: the chi-square p-value is more than 0.01. A smaller p-value shows a problem in the assignment, for example lost rows in one group.

Technical note. Let x be a feature, a an email group and c the control group. The standardized difference is (mean(x in a) − mean(x in c)) / sd(x in all rows). It does not depend on the sample size, unlike a p-value. The code makes one column for each level of zip_code and channel (model.matrix). The sample ratio check is a chi-square goodness-of-fit test of the three group sizes against equal shares.

# Purpose: Check the random assignment: the evidence of branch 1 (validity).
# Input:   `d`.
# Output:  `feat` (pre-test features, one column for each level), `bal` (balance table),
#          N$smd_max, N$srm_p and the rule results.

feat <- data.frame(model.matrix(~ recency + history + mens + womens + newbie + zip + channel - 1, d))
smd <- function(a) sapply(feat, function(x) (mean(x[d$arm == a]) - mean(x[d$arm == "control"])) / sd(x))
bal <- data.frame(Feature = names(feat),
                  `Mean, control` = sapply(feat, function(x) mean(x[d$arm == "control"])),
                  `Std. difference, men's` = smd("mens"),
                  `Std. difference, women's` = smd("womens"), check.names = FALSE)
smd_max <- max(abs(bal[, 3:4]))
srm_p <- chisq.test(table(d$arm))$p.value  # Equal shares are the default of chisq.test
N$smd_max <- formatC(smd_max, format = "f", digits = 3)
N$srm_p <- formatC(srm_p, format = "f", digits = 2)
N$smd_feature <- bal$Feature[which.max(pmax(abs(bal[, 3]), abs(bal[, 4])))]
# The rules of branch 1, set before the rerun.
N$smd_pass <- smd_max < 0.05
N$srm_pass <- srm_p > 0.01
N$valid_txt <- if (N$smd_pass && N$srm_pass) "passes both rules" else "fails a rule"
kable(bal, digits = 3, row.names = FALSE)

Feature	Mean, control	Std. difference, men’s	Std. difference, women’s
recency	5.750	0.007	0.005
history	240.883	0.008	0.006
mens	0.553	-0.005	-0.009
womens	0.548	0.008	0.005
newbie	0.502	-0.001	0.003
zipRural	0.147	0.014	0.004
zipSurburban	0.452	-0.012	-0.001
zipUrban	0.401	0.002	-0.002
channelPhone	0.438	-0.008	0.009
channelWeb	0.440	0.011	-0.005

The largest absolute standardized difference is 0.014 (zipRural). The rule needs less than 0.05. The group sizes agree with an equal split: the chi-square p-value is 0.90, and the rule needs more than 0.01. Thus the validity branch passes both rules. A difference of the mean outcomes between the groups gives the causal effect of the email.

2e. Baseline: what does the control group do without an email?

The groups are the same before the email. Thus the control group shows what all customers do without an email. Each effect in this notebook is a difference against this baseline. The baseline also shows why spend is a noisy metric.

The code measures four values for the control group. They are the visit rate, the conversion rate, the mean spend and the share with $0 spend.

# Purpose: Measure the outcomes of the control group without an email: the baseline of Step 2e.
# Input:   `d`, `CAMPAIGN` (as-04).
# Output:  `base0` (one row of baseline values). Table. N values for the text and the chart.

c0 <- d[d$arm == "control", ]
base0 <- data.frame(
  customers = nrow(c0), visit = mean(c0$visit), conversion = mean(c0$conversion),
  spend = mean(c0$spend), zero = mean(c0$spend == 0), buyer_spend = mean(c0$spend[c0$conversion == 1]))
N$base_n <- num(base0$customers)
N$base_visit <- pct(base0$visit, 1)
N$base_conv <- pct(base0$conversion, 2)
N$base_spend <- usd(base0$spend)
N$base_zero <- pct(base0$zero, 1)
N$base_buyer_spend <- usd(base0$buyer_spend, 0)
N$base_spend_100k <- usd(CAMPAIGN * base0$spend, 0)
N$base_cv <- formatC(sd(c0$spend) / mean(c0$spend), format = "f", digits = 0)
kable(data.frame(Customers = N$base_n, Visit = N$base_visit, Conversion = N$base_conv,
                 `Mean spend` = N$base_spend, `Share with $0 spend` = N$base_zero,
                 `Mean spend of a buyer` = N$base_buyer_spend, check.names = FALSE),
      row.names = FALSE, align = "rrrrrr")

Customers	Visit	Conversion	Mean spend	Share with $0 spend	Mean spend of a buyer
21,306	10.6%	0.57%	$0.65	99.4%	$114

rm(c0)

# Purpose: Show the baseline that each email must beat: the share of control customers at each stage.
# Input:   `base0`, `N`, `CS` and the functions of chart_style.R.
# Output:  Bar chart.

if (!exists("CS")) source("chart_style.R")  # The setup chunk sources it. This line keeps a part test alive.
stage <- c("All customers", "Visit the website", "Buy (spend > $0)")
share <- c(1, base0$visit, base0$conversion)
cs_setup(mar = c(2, 9.5, 0.6, 5))
yy <- rev(seq_along(share))
# Bars: the share of customers at each stage. The stage with the spend in blue (the one point).
plot(NA, xlim = c(0, 1), ylim = c(0.5, length(share) + 0.5), axes = FALSE, xlab = "", ylab = "")
rect(0, yy - 0.32, share, yy + 0.32, col = c(CS$gray, CS$navy, CS$blue), border = NA)
axis(2, at = yy, labels = stage, tick = FALSE, col.axis = CS$ink)
# Direct labels at the end of each bar instead of an x-axis.
text(share, yy, paste0(" ", mapply(pct, share, c(0, 1, 2))), adj = c(0, 0.5), xpd = NA,
     col = c(CS$muted, CS$navy, CS$blue), font = 2, cex = 0.85)
cs_title(paste0("Without an email, only ", N$base_conv, " of customers buy in two weeks"),
         paste0("Control group, ", N$base_n, " customers. Mean spend ", N$base_spend,
                " for each customer; ", N$base_buyer_spend, " for each buyer"))

How to read: each bar is the share of the 21,306 control customers who reach a stage in the two weeks of the test. The control group got no email.

So what: 99.4% of the customers without an email spend $0, and the mean spend is only $0.65. The few buyers spend $114 each, so a small number of orders sets the mean. The standard deviation of the spend is about 18 times its mean. Thus the spend effect of an email has a wide confidence interval, and the test needs many customers (Step 3c).

Business note. The test file has 64,000 valid customers, no empty cells and one consistent outcome for each customer. The random assignment works: the largest standardized difference is 0.014, and the sample ratio p-value is 0.90. Without an email, a campaign of 100,000 customers gives about $65,279 of spend in two weeks. Each email must add to this baseline more than its cost. Step 3 now fixes the rules of the test and checks that the test is large enough to find such an effect.

Step 3. Split data: the test design

Step 2 gave clean data for 64,000 customers in three groups, and it showed that the groups look the same before the test. It also showed that 99.1% of the customers spend $0 in the two weeks. Before we measure an effect, we must agree on two things. What does “the email works” mean, and is the test large enough to show it?

Purpose. This step fixes the rules of the test, the use of the data and the primary metric. It supports this decision: use the test result for the campaign, or run a larger test first.

Steps 3 to 7 use the same small set of tools, for example the power, the bootstrap and the Qini curve. The code keeps them in the file case03_helpers.R, so that the story stays short. The appendix shows the full file. The next cell loads the tools and the rules of the evaluation framework.

# Purpose: Load the helper functions that Steps 3–7 use, and record the rules of section 3a.
# Input:   case03_helpers.R, chart_style.R, the constants of the setup chunk.
# Output:  The functions of case03_helpers.R, `CS` and the chart functions, `RULES`.

source("chart_style.R")    # Chart style (deck style guide). A second source is safe.
source("case03_helpers.R")

# The rules of the evaluation framework (section 3a). We set them before the rerun.
RULES <- list(
  b1_smd = 0.05,          # Branch 1: largest absolute standardized difference less than 0.05
  b1_srm_p = 0.01,        # Branch 1: p-value of the sample-ratio check more than 0.01
  b3_adj_dev = 0.10,      # Branch 3: each adjusted effect within 10% of the unadjusted effect
  b5_model_gain = 0.20,   # Branch 5: an ML uplift model needs a 20% higher mean Qini area ...
  b5_model_pos = 9,       # ... and a Qini area more than 0 in 9 or more of the repeats
  b5_policy_level = 0.90  # Branch 5: the 90% interval of the gain of a targeting rule must be above 0
)

3a. What the test must measure

A test has many metrics. A reader can ask: “Why these metrics, and why not others?” Thus we start from the question that each metric answers.

The framework splits the risks of a campaign decision in two groups. The first group is statistical: the test can be wrong in its design, too small to show the effect, or right only with one method. The second group is business: the effect can be real but make no money. Or a smaller list of customers can make more money than “send to all”. Each failure belongs to one branch only. A policy that passes all five branches is ready for the rollout.

We set these rules before the rerun of this version, and we do not change them after a result. If a result fails a rule, the notebook reports the failure and what it means for the decision.

Branch	Question	Metric	Rule
1. Validity	Do the groups differ only by the email?	Largest absolute standardized difference of the pre-test features; sample-ratio chi-square p-value	Less than 0.05; p-value more than 0.01
2. Effect	Does the men’s email change spend, and is the test large enough?	Welch 95% CI of the spend effect; customers in each group vs. customers needed for 80% power at the observed effect	The CI excludes 0; the test has at least the customers needed
3. Robustness	Does the effect hold with other methods?	Bootstrap 95% CI; effect with CUPED and with regression adjustment	The bootstrap CI excludes 0; each adjusted effect is within 10% of the unadjusted effect
4. Business value	Does the recommended policy make money?	Incremental profit for 100,000 customers at the base margin and contact cost (as-01, as-02), with the 95% CI of the effect	Profit more than 0, and the lower end of its 95% CI more than 0
5. Targeting	Does a targeting rule or an uplift model beat “send to all”?	Gain of each targeting rule vs. send-to-all with its 90% bootstrap interval at the base cost. Qini area of the ML uplift models vs. rank by history.	Model rule: an ML uplift model replaces “rank by history” only if two conditions are true. Its mean Qini area is 20% or more higher. Its Qini area is more than 0 in at least 9 of 10 repeats. Policy rule: a targeting rule replaces “send to all” only if the 90% interval of its gain is above 0 at the base cost. The recommended policy passes if it follows these two rules.

The notebook uses each branch in these sections:

• Branch 1: Step 2d (the randomization check), Step 3b and Step 6a.
• Branch 2: Step 3c (the primary metric and the power), Step 4a and Step 6b.
• Branch 3: Step 4a (the bootstrap, CUPED and the regression adjustment) and Step 6c.
• Branch 4: Step 4a (the profit of each email), Step 6d and Step 7b.
• Branch 5: Step 4d (the uplift method), Step 5, Step 6e and Step 7a.

Branches 2 and 4 are different. An effect can be real but too small to pay for the email. The CI of branch 2 says that the effect is more than $0. The rule of branch 4 says that the effect is more than the breakeven effect. Thus the notebook checks both.

Technical note. How each metric works:

• Standardized difference. For each pre-test feature: (mean in the email group − mean in the control group) / standard deviation in all customers. It does not depend on the unit or on the sample size. A value less than 0.05 is a small difference.
• Sample-ratio check. A chi-square test of the group sizes against the planned split (one third in each group). A small p-value shows a problem in the assignment, for example a group that lost customers.
• Welch 95% CI. Effect = mean of the email group − mean of the control group. The standard error is √(s₁²/n₁ + s₀²/n₀), and the CI is the effect ± t × standard error. The Welch test does not need equal variances in the two groups.
• Power and MDE. For n customers in each group and a standard deviation σ, MDE ≈ (z₀.₉₇₅ + z₀.₈₀) × σ × √(2/n) at 5% significance and 80% power. The code uses the exact t-test version (power.t.test). The inverse gives the customers needed for an effect: n ≈ 2 × σ² × (z₀.₉₇₅ + z₀.₈₀)² / effect².
• Qini area. Rank the customers by the predicted uplift. Take the top share g of the list. The Qini curve gives (mean spend of the email group − mean spend of the control group, in the top g) × g. A random order gives a straight line from 0 to the effect of “send to all”. The Qini area is the mean distance between the curve and this line, at g = 5%, 10%, …, 100%. A higher area means a better order. An area of 0 or less means no better than a random order.

3b. How we split the data

A model project splits the data into a training set and a test set. A randomized test needs a different split. The question here is not “Does a model predict well?”. The question is “What does the email cause?”. Thus the data has two uses, and each use needs its own split:

Use	Question	Split	Who makes it
Effect (Steps 4a–4c)	What does the email cause, on average and in each segment?	Random assignment into three groups: no email, men’s email, women’s email	The data source, before the test
Uplift (Steps 4d and 5)	Which customers get the most from the email?	5-fold cross-fit inside the men’s email and the control group	This notebook

Random assignment. The data source put each customer at random into one of the three groups. The control group then shows what the email groups do without an email. Thus a difference of means gives the causal effect, and no model must learn from the data. Branch 1 checks that the random assignment worked.

Cross-fit for the uplift. An uplift model learns from the same customers that it then puts in order. A model that scores the customers of its own training data finds noise and calls it uplift. Then the Qini curve looks good, but the order fails on new customers.

The fix is a cross-fit: cut the customers into five folds at random. For each fold, the model learns from the other four folds and gives an uplift to the customers of this fold. Thus each customer gets an uplift from a model that did not see that customer. We repeat this with 10 different random folds, because one cut of the folds can give a lucky result.

A single hold-out set (for example 70/30) is a simpler option. But less than 1% of the customers buy, so a test set of 30% has few buyers, and its Qini curve is noisy. With a cross-fit, each customer is in the test data one time. Rank by history needs no cross-fit, because it learns nothing from the test data.

Parameters: one third of the customers in each group (the planned split of the data source), 5 folds and 10 repeats for the uplift.

# Purpose: Show the two splits of section 3b and the evidence of branch 1 (validity).
# Input:   `d` (with `arm`), `feat` (pre-test features, Step 2d), `SEED`, `RULES`.
# Output:  Table of the groups; N values of branch 1 (`d3_smd`, `d3_srm_p`, `d3_b1`) and of the folds.

# Random assignment: group sizes against the planned split of one third each.
grp <- table(d$arm)
smd_all <- sapply(c("mens", "womens"), function(a) sapply(feat, std_diff, arm = d$arm, a = a))
b1_smd <- max(abs(smd_all))
b1_srm <- srm_p(d$arm)
N$d3_smd <- formatC(b1_smd, format = "f", digits = 3)
N$d3_srm_p <- formatC(b1_srm, format = "f", digits = 2)
N$d3_b1 <- if (b1_smd < RULES$b1_smd && b1_srm > RULES$b1_srm_p) "passes" else "fails"

# Cross-fit: five folds of the men's email + control customers. Each fold is one fifth of them.
n_mc <- sum(d$arm != "womens")
N$d3_n_mc <- num(n_mc)
N$d3_n_fold <- num(n_mc / 5)
N$d3_buy_fold <- num(sum(d$conversion[d$arm != "womens"]) / 5)

kable(data.frame(
  Group = c("No email (control)", "Men's email", "Women's email"),
  Customers = num(as.vector(grp)),
  `Share of customers` = pct(as.vector(grp) / sum(grp), 2),
  `Planned share` = pct(rep(1 / 3, 3), 2),
  `Largest standardized difference against control` = c("", formatC(apply(abs(smd_all), 2, max), format = "f", digits = 3)),
  check.names = FALSE), row.names = FALSE, align = "lrrrr")

Group	Customers	Share of customers	Planned share	Largest standardized difference against control
No email (control)	21,306	33.29%	33.33%
Men’s email	21,307	33.29%	33.33%	0.014
Women’s email	21,387	33.42%	33.33%	0.009

How to read: each row is one group. The last column gives the largest standardized difference of the pre-test features against the control group.

So what: the shares agree with the planned split (p-value 0.90), and the largest standardized difference is 0.014. Branch 1 passes, so a difference of means gives the effect of the email.

For the uplift, the men’s email and the control group have 42,613 customers. Each fold has about 8,523 customers and about 78 buyers. This low number of buyers is the main limit of the uplift models in Step 4d.

3c. The primary metric and the power

Which metric decides the test?

Why this question matters. The primary metric decides if the email “works”. A metric that is easy to move but far from the money can approve an email that loses money. A metric that is close to the money but noisy can miss a profitable email. The test must also be large enough for the metric: if not, an effect of zero and a small effect look the same.

Ways to do it. The split axis is the place of the metric on the path from the email to the profit. The four places are a visit, a purchase, the dollars of the purchase, and the value after the test window. These four places cover all metrics of an email test, and each metric belongs to one of them.

Place on the path	Metric	Advantage	Main risk	Status
Engagement	Email open or click; website visit	Many customers act, so the test has the most power.	An email can increase visits without more spend. The data has no opens or clicks.	Visit: possible. Test it. Opens and clicks: screened out (not in the data).
Purchase	Conversion (the customer buys)	Closer to the money than a visit.	Less than 1% of customers buy, so the test has less power. It ignores the size of each purchase.	Possible. Test it.
Dollars	Spend in the two weeks	Gives dollars. The profit is margin × spend − contact cost, so the profit needs spend.	Most customers spend $0 and a few spend a lot, so the noise is large.	Possible. Test it.
After the window	Spend over 12 months, or the customer lifetime value	Shows a long effect or fatigue.	The data stops after two weeks (as-03).	Screened out (not in the data)

Evidence. For each metric, the code calculates the MDE of this test at 5% significance and 80% power. It compares the MDE with the observed effect of each email. It also gives the customers in each group that the test needs to find each observed effect (branch 2).

# Purpose: Compare the power of visit, conversion and spend for this test (dec-01, branch 2).
# Input:   `d`, `ALPHA`, `POWER`, mde_metric() (case03_helpers.R).
# Output:  `n_arm` (customers in the smallest group), `mde` (matrix: one column for each metric),
#          N values of the MDE and of the customers needed.

n_arm <- min(table(d$arm))
mde <- sapply(c(visit = "visit", conversion = "conversion", spend = "spend"),
              function(y) mde_metric(d[[y]], d$arm, n_arm))
mde <- rbind(mde, need = mde["need_w", ])  # Old row name: customers needed for the women's effect

N$mde_spend <- usd(mde["mde", "spend"])
N$eff_w_spend <- usd(mde["womens", "spend"])
N$eff_m_spend <- usd(mde["mens", "spend"])
N$need_w_spend <- num(mde["need_w", "spend"])
N$need_m_spend <- num(mde["need_m", "spend"])
N$need_ratio <- formatC(n_arm / mde["need_w", "spend"], format = "f", digits = 1)
N$need_ratio_m <- formatC(n_arm / mde["need_m", "spend"], format = "f", digits = 1)
N$d3_n_arm <- num(n_arm)
N$mde_conv <- pct(mde["mde", "conversion"], 2)
N$base_conv <- pct(mde["base", "conversion"], 2)
N$mde_conv_rel <- pct(mde["mde", "conversion"] / mde["base", "conversion"], 0)
N$mde_spend_rel <- pct(mde["mde", "spend"] / mde["base", "spend"], 0)
N$n_above_mde <- sum(mde[c("mens", "womens"), ] > rbind(mde["mde", ], mde["mde", ]))
N$d3_b2_power <- if (n_arm >= mde["need_m", "spend"]) "has" else "does not have"

f_metric <- function(x, y) if (y == "spend") usd(x, 3) else pct(x, 2)
kable(data.frame(
  Metric = c("Visit", "Conversion", "Spend"),
  `Control mean` = mapply(f_metric, mde["base", ], colnames(mde)),
  MDE = mapply(f_metric, mde["mde", ], colnames(mde)),
  `Effect, men's` = mapply(f_metric, mde["mens", ], colnames(mde)),
  `Effect, women's` = mapply(f_metric, mde["womens", ], colnames(mde)),
  `Customers needed, men's effect` = num(mde["need_m", ]),
  `Customers needed, women's effect` = num(mde["need_w", ]),
  check.names = FALSE), row.names = FALSE, align = "lrrrrrr")

Metric	Control mean	MDE	Effect, men’s	Effect, women’s	Customers needed, men’s effect	Customers needed, women’s effect
Visit	10.62%	0.96%	7.66%	4.52%	333	954
Conversion	0.57%	0.26%	0.68%	0.31%	3,032	14,505
Spend	$0.653	$0.408	$0.770	$0.424	5,987	19,696

How to read: the MDE is the smallest effect that this test finds in 80% of tests. An observed effect above the MDE is large enough for this test. The last two columns give the customers that each group needs to find the observed effect.

So what: of the 6 effects (2 emails × 3 metrics), 6 are larger than the MDE. For spend, the women’s effect is only a little above the MDE.

Decision. Spend is the primary metric. Visit and conversion are secondary metrics: they help to explain the spend result.

Why. Three reasons, from the most important:

1. The decision is about profit, and profit needs dollars. The profit of each email is margin × change in spend − contact cost. A visit or a conversion has no dollar value without a second assumption: the spend of each buyer.
2. The test is large enough for spend. The MDE of spend is $0.41. The men’s email gives $0.77, and the women’s email gives $0.42. To find the men’s effect, the test needs 5,987 customers in each group. It has 21,306, or 3.6 times this number. Thus the test has the customers that branch 2 needs.
3. The power is tight for the women’s email. To find the women’s effect, the test needs 19,696 customers in each group, so it has only 1.1 times this number. Thus a smaller effect than the women’s effect is not clear in this test.

Spend has the least power of the three metrics. For spend, the MDE is 63% of the control mean. For conversion, it is 45% of the control mean (0.26% on a base of 0.57%). We accept the lower power, because only spend gives the dollars.

What would change the decision. If a test has fewer customers, for example a test in one segment, spend does not have sufficient power. Then use conversion as the primary metric, and calculate the dollars with the mean spend of a buyer.

Business note. The data source made a fair split: the three groups look the same before the test. The primary metric is spend, because the campaign decision needs dollars. The test can find an effect of $0.41 for each customer, and the men’s email gives $0.77. Step 4 measures the effect of each email and checks it with other methods.

Step 4. Build models

Step 3 fixed the rules of the test and made spend the primary metric. The test can find an effect of $0.41 for each customer, and the first look gives $0.77 for the men’s email. That first look is only a difference of two means.

This step answers four questions in order. How large is the effect of each email, with which method (4a)? Which version do we send (4b)? Does the effect change by segment (4c)? Which method puts the customers in order of uplift (4d)?

Purpose. This step measures the effect of each email and builds the tools that select the version and the customers. It supports this decision: send an email or not, which version, and to which customers.

4a. Average effect

The average effect is the base of all later decisions. If the effect is not real, no version and no list of customers can make money. Two choices set the result: the method that compares the spend of two groups, and the use of the pre-test data.

Which method measures the change in mean spend?

Why this question matters. The profit of the campaign is margin × change in mean spend × customers − contact cost. Thus the method must give the change in mean spend in dollars, with an interval that we can trust. Spend has a long right tail: 99.1% of the customers spend $0, and a few spend up to $499. A method that is wrong for this shape can give a false interval.

Ways to do it. The split axis is what the method compares between the two groups: the mean, the rank of each customer, or a model of the outcome. These three groups cover the usual methods, and each method belongs to one of them.

What it compares	Method	Advantage	Main risk	Status
The mean	Welch t-test	Simple. All reviewers know it. Gives the change in dollars.	With a long tail and a small sample, the interval can be wrong.	Possible. Test it.
The mean	Bootstrap of the difference of means	Gives the change in dollars. Needs no normal distribution.	More computation. It needs a seed to repeat the result.	Possible. Test it.
The rank	Mann-Whitney test	Not sensitive to large values.	It tests if one group usually spends more. It gives no change in dollars.	Possible. Test it as a check.
A model of the outcome	Two-part model (conversion × spend of a buyer), Tobit model, or a model of log(spend)	Shows where the effect comes from.	In a randomized test, the two-part model gives the same mean with more parts. Tobit needs a normal distribution. A log cannot use $0 and changes the question.	Screened out

Evidence. The code calculates the three possible methods for the two emails. The bootstrap uses 2,000 samples with the seed of the setup chunk.

# Purpose: Compare the Welch t-test, the Mann-Whitney test and the bootstrap on the spend (dec-02, branch 3).
# Input:   `d`, `SEED`, welch() and boot_diff() (case03_helpers.R).
# Output:  Table `dec02`, `boot_ci` (bootstrap 95% CI of each email, numbers), N values of the bootstrap.

B <- 2000
y0 <- d$spend[d$arm == "control"]
boot_ci <- matrix(NA_real_, 2, 2, dimnames = list(c("mens", "womens"), c("lo", "hi")))
dec02 <- do.call(rbind, lapply(c("mens", "womens"), function(a) {
  y1 <- d$spend[d$arm == a]
  w <- welch(y1, y0)
  wt <- wilcox.test(y1, y0)
  bd <- boot_diff(y1, y0, B, SEED)
  boot_ci[a, ] <<- quantile(bd, c(0.025, 0.975))  # Keep the numbers for Step 6 (branch 3)
  data.frame(Email = rep(ifelse(a == "mens", "Men's", "Women's"), 3),
             Method = c("A. Welch t-test", "B. Mann-Whitney", "C. Bootstrap"),
             `Change in mean spend` = c(usd(w[["eff"]], 3), "not measured", usd(w[["eff"]], 3)),
             `95% CI` = c(ci_txt(w[["lo"]], w[["hi"]]), "not measured", ci_txt(boot_ci[a, 1], boot_ci[a, 2])),
             `p-value` = c(fmt_p(w[["p"]]), fmt_p(wt$p.value), fmt_p(2 * min(mean(bd <= 0), mean(bd >= 0)))),
             check.names = FALSE)
}))
N$boot_ci_m <- ci_txt(boot_ci["mens", 1], boot_ci["mens", 2])
N$boot_ci_w <- ci_txt(boot_ci["womens", 1], boot_ci["womens", 2])
N$n_arm_min <- num(min(table(d$arm)))
w_m <- welch(d$spend[d$arm == "mens"], y0)
N$welch_ci_m <- ci_txt(w_m[["lo"]], w_m[["hi"]])
kable(dec02, row.names = FALSE)

Email	Method	Change in mean spend	95% CI	p-value
Men’s	A. Welch t-test	$0.770	[$0.49, $1.05]	< 0.001
Men’s	B. Mann-Whitney	not measured	not measured	< 0.001
Men’s	C. Bootstrap	$0.770	[$0.48, $1.06]	< 0.001
Women’s	A. Welch t-test	$0.424	[$0.17, $0.68]	0.001
Women’s	B. Mann-Whitney	not measured	not measured	< 0.001
Women’s	C. Bootstrap	$0.424	[$0.17, $0.67]	0.002

How to read: each email has three rows, one for each method. The Mann-Whitney test gives only a p-value.

So what: the Welch t-test and the bootstrap give almost the same interval for each email.

Decision. The Welch t-test. The bootstrap is a check (branch 3).

Why. The business decision uses total dollars, so the method must measure the change in mean spend. For the men’s email, the Welch interval is [$0.49, $1.05], and the bootstrap interval is [$0.48, $1.06]. Each group has 21,306 or more customers, so the mean is close to a normal distribution, even with the long tail. The Welch t-test is simpler to explain and to repeat. The Mann-Whitney test gives no dollar value, so it cannot go into the profit calculation.

What would change the decision. If a group has fewer than about 5,000 customers, or the top 1% of customers give most of the spend, use the bootstrap.

Can the pre-test data make the interval smaller?

Why this question matters. A smaller interval gives a clearer decision with the same customers. In a later test, it can also give the same power with fewer customers, and thus a lower cost of the test. Each method that removes noise also adds a model that a reviewer must check.

Ways to do it. The split axis is how much pre-test data adjusts the outcome. The four groups are no data, one feature, all features in a linear model, and an ML prediction.

Pre-test data	Method	Advantage	Main risk	Status
None	Difference of means	Simple. No model.	The interval can be wider than necessary.	Possible. Test it.
One feature	CUPED with history	A standard method. It removes the part of the spend that history predicts.	It helps only if history predicts the spend in the test window.	Possible. Test it.
All features, linear	Regression adjustment (or post-stratification by segment, the same idea with cells)	Uses all the pre-test data.	More complex. A reviewer must check the model.	Possible. Test it.
All features, ML model	CUPAC: an ML prediction of the spend is the covariate	Can find curves and interactions.	A model to train and to approve. It helps only if the linear methods help.	Screened out if the linear methods give no gain

Evidence. The code adjusts each metric of each email with the possible methods. The table gives the effect and the width of the 95% CI against no adjustment. A width of 100% means no gain. The effects also give branch 3: each adjusted effect must be within 10% of the unadjusted effect.

# Purpose: Compare no adjustment, CUPED and the regression adjustment for each metric (dec-03, branch 3).
# Input:   `d`, cuped() (case03_helpers.R), `RULES`.
# Output:  Table `dec03`, `adj_eff` (the spend effects of the three options, numbers), N values.

dec03 <- do.call(rbind, lapply(c("visit", "conversion", "spend"), function(y) do.call(rbind, lapply(c("mens", "womens"), function(a) {
  s <- d[d$arm %in% c("control", a), ]
  s$t <- as.integer(s$arm == a)
  s$y_cuped <- cuped(s[[y]], s$history)
  fits <- list(A = lm(as.formula(paste(y, "~ t")), s),
               B = lm(y_cuped ~ t, s),
               C = lm(as.formula(paste(y, "~ t + lhist + recency + mens + womens + zip + newbie + channel")), s))
  se <- sapply(fits, function(f) summary(f)$coefficients["t", 2])
  data.frame(Metric = y, Email = ifelse(a == "mens", "Men's", "Women's"),
             `Effect, A` = coef(fits$A)["t"], `Effect, B` = coef(fits$B)["t"], `Effect, C` = coef(fits$C)["t"],
             `CI width B / A` = pct(se["B"] / se["A"]), `CI width C / A` = pct(se["C"] / se["A"]),
             r_hist = cor(s[[y]], s$history), gain = 1 - min(se) / se["A"], check.names = FALSE)
}))))
N$r_hist_spend <- formatC(max(dec03$r_hist[dec03$Metric == "spend"]), format = "f", digits = 3)
N$cuped_best <- pct(max(dec03$gain[dec03$Metric == "spend"]), 2)
N$cuped_visit <- pct(max(dec03$gain[dec03$Metric == "visit"]), 1)

# Branch 3: distance of each adjusted spend effect from the unadjusted effect.
adj_eff <- dec03[dec03$Metric == "spend", c("Email", "Effect, A", "Effect, B", "Effect, C")]
rownames(adj_eff) <- c("mens", "womens")
adj_dev <- abs(adj_eff[, c("Effect, B", "Effect, C")] / adj_eff[, "Effect, A"] - 1)
N$cuped_m <- usd(adj_eff["mens", "Effect, B"], 3)
N$reg_m <- usd(adj_eff["mens", "Effect, C"], 3)
N$ate_m_a <- usd(adj_eff["mens", "Effect, A"], 3)
N$adj_dev_m <- pct(max(adj_dev["mens", ]), 1)

dec03$r_hist <- NULL
dec03$gain <- NULL
kable(dec03, digits = 4, row.names = FALSE)

Metric	Email	Effect, A	Effect, B	Effect, C	CI width B / A	CI width C / A
visit	Men’s	0.0766	0.0764	0.0762	99.8%	98.6%
visit	Women’s	0.0452	0.0451	0.0454	99.8%	98.7%
conversion	Men’s	0.0068	0.0068	0.0068	100.0%	99.9%
conversion	Women’s	0.0031	0.0031	0.0031	100.0%	99.9%
spend	Men’s	0.7698	0.7674	0.7692	100.0%	100.0%
spend	Women’s	0.4244	0.4227	0.4268	100.0%	100.0%

How to read: option A has no adjustment, option B uses CUPED with history, and option C uses the regression adjustment. The last two columns give the width of the interval of B and C against A.

So what: the adjustments do not change the effects, and they make the interval of spend almost no smaller.

Decision. No adjustment. CUPED and the regression adjustment stay as a check (branch 3).

Why. The correlation of history with the spend in the test window is only 0.021. Thus CUPED and the regression make the interval of spend at most 0.04% smaller. For visits, the gain is at most 1.4%. The effects stay the same: for the men’s email, $0.770 with no adjustment, $0.767 with CUPED and $0.769 with the regression. The largest distance is 0.3%.

A simple method is better for the same result, and an ML adjustment cannot help when the linear methods find nothing.

What would change the decision. If the outcome repeats each month, CUPED can make the interval much smaller. For example, the monthly spend on a card is similar from one month to the next. In a card test, use CUPED with the spend of the three months before the test.

The effect of each email

The table gives the effect of each email on the three metrics, with the Welch t-test. The chart then compares the spend effect with the breakeven effect: contact cost / margin. If the effect is below the breakeven effect, the email loses money.

# Purpose: The effect of each email on visit, conversion and spend (Welch t-test, dec-02).
# Input:   `d`, `MARGIN`, `COST`, welch() and breakeven() (case03_helpers.R).
# Output:  `ate` (all effects), `ATE`, `ATE_LO`, `ATE_HI` (spend effect of each email and its 95% CI), N values.

ate <- do.call(rbind, lapply(c("visit", "conversion", "spend"), function(y) do.call(rbind, lapply(c("mens", "womens"), function(a) {
  y1 <- d[[y]][d$arm == a]; y0 <- d[[y]][d$arm == "control"]
  w <- welch(y1, y0)
  data.frame(metric = y, arm = a, eff = w[["eff"]], lo = w[["lo"]], hi = w[["hi"]],
             rel = w[["eff"]] / mean(y0), p = w[["p"]])
}))))
ATE <- setNames(ate$eff[ate$metric == "spend"], c("mens", "womens"))
ATE_LO <- setNames(ate$lo[ate$metric == "spend"], c("mens", "womens"))
ATE_HI <- setNames(ate$hi[ate$metric == "spend"], c("mens", "womens"))
N$ate_m <- usd(ATE["mens"]); N$ci_m <- ci_txt(ATE_LO["mens"], ATE_HI["mens"])
N$ate_w <- usd(ATE["womens"]); N$ci_w <- ci_txt(ATE_LO["womens"], ATE_HI["womens"])
N$rel_m <- pct(ate$rel[ate$metric == "spend" & ate$arm == "mens"], 0)
N$prof_m <- usd(MARGIN * ATE["mens"] - COST, 3)
N$prof_w <- usd(MARGIN * ATE["womens"] - COST, 3)
N$roi_m <- formatC(MARGIN * ATE["mens"] / COST, format = "f", digits = 1)
N$breakeven_eff <- usd(breakeven())
N$ate_lo_m <- usd(ATE_LO["mens"]); N$ate_lo_w <- usd(ATE_LO["womens"])
N$w_lo_vs_be <- if (ATE_LO["womens"] > breakeven()) "above" else "below"
N$m_lo_vs_be <- if (ATE_LO["mens"] > breakeven()) "above" else "below"
N$d4_b2_ci <- if (ATE_LO["mens"] > 0) "excludes" else "includes"

kable(data.frame(
  Metric = c("Visit", "Visit", "Conversion", "Conversion", "Spend", "Spend"),
  Email = rep(c("Men's", "Women's"), 3),
  Effect = ifelse(ate$metric == "spend", usd(ate$eff, 3), paste(formatC(100 * ate$eff, format = "f", digits = 2), "points")),
  `95% CI` = ifelse(ate$metric == "spend", ci_txt(ate$lo, ate$hi), paste0("[", formatC(100 * ate$lo, format = "f", digits = 2), ", ", formatC(100 * ate$hi, format = "f", digits = 2), "]")),
  `Change against control` = paste0("+", pct(ate$rel, 0)),
  `p-value` = fmt_p(ate$p), check.names = FALSE), row.names = FALSE, align = "llrrrr")

Metric	Email	Effect	95% CI	Change against control	p-value
Visit	Men’s	7.66 points	[7.00, 8.32]	+72%	< 0.001
Visit	Women’s	4.52 points	[3.89, 5.16]	+43%	< 0.001
Conversion	Men’s	0.68 points	[0.50, 0.86]	+119%	< 0.001
Conversion	Women’s	0.31 points	[0.15, 0.47]	+54%	< 0.001
Spend	Men’s	$0.770	[$0.49, $1.05]	+118%	< 0.001
Spend	Women’s	$0.424	[$0.17, $0.68]	+65%	0.001

# Purpose: Show the spend effect of each email against $0 and against the breakeven effect.
# Input:   `ATE`, `ATE_LO`, `ATE_HI`, breakeven(), `CS` and the chart functions (chart_style.R).
# Output:  Chart only.

yy <- c(mens = 2, womens = 1)
pcol <- c(mens = CS$blue, womens = CS$gray)
cs_setup(mar = c(3.6, 7.5, 0.6, 1.5))
plot(ATE, yy, xlim = c(0, max(ATE_HI) * 1.45), ylim = c(0.5, 2.6), pch = 19, cex = 1.4, col = pcol,
     yaxt = "n", xaxt = "n", xlab = "Change in mean spend for each customer, against no email", ylab = "")
segments(ATE_LO, yy, ATE_HI, yy, col = pcol, lwd = 3)
cs_dollar_axis(1)
axis(2, at = yy, labels = c("Men's email", "Women's email"), tick = FALSE, col.axis = CS$ink)
abline(v = breakeven(), lty = 2, col = CS$gray)
text(breakeven(), 2.55, paste0("Breakeven effect ", usd(breakeven())), pos = 4, cex = 0.75, col = CS$muted)
# Direct labels to the right of each interval: the effect and its 95% CI.
text(ATE_HI, yy, paste0(usd(ATE), "  ", ci_txt(ATE_LO, ATE_HI)), pos = 4, cex = 0.8, col = pcol, font = c(2, 1))
cs_title(paste0("The men's email adds ", N$ate_m, " of spend for each customer, ", N$roi_m, " times the breakeven"),
         "Change in mean spend in the two weeks after the email, with the Welch 95% CI")

How to read: each point is the change in mean spend of one email, against the control group. The line is the 95% CI. The dashed line is the breakeven effect at a 30% margin (as-01) and a $0.10 contact cost (as-02).

So what: the lower end of the men’s interval is $0.49, above the breakeven effect of $0.33. The lower end of the women’s interval is $0.17, below the breakeven effect.

Both emails increase visits, conversions and spend. The men’s email increases the mean spend by $0.77 for each customer (95% CI [$0.49, $1.05]), or 118% more than the control group. The Welch CI excludes $0, as branch 2 asks. The women’s email increases the mean spend by $0.42 (95% CI [$0.17, $0.68]).

At a 30% margin and a $0.10 contact cost, each men’s email gives $0.131 of profit. Each women’s email gives $0.027. The ROI of the men’s email is 2.3. Thus both emails make money on average, and the men’s email makes more. Section 4b examines if a mix of the two versions makes more than the men’s email alone.

4b. Email version

Section 4a showed that both emails increase spend. The men’s email adds $0.77 for each customer, and the women’s email adds $0.42. But the mean effect of a version mixes customers who buy men’s products, women’s products or both. The next question is: do we send one version to all customers, or the version that matches the products of each customer?

Which email version do we send?

Why this question matters. The version sets the size of the effect for each customer, and thus the profit of the campaign. A second version doubles the creative work and makes the campaign harder to run. It earns its place only if it adds spend for some customers.

Ways to do it. The split axis is: does the version depend on the customer? If not, one version goes to all customers. If yes, a known feature or a model selects the version. A fifth way sends both versions to the same customer. Each way then goes through one filter: can this test measure its effect?

Group	Option	Advantage	Main risk	Screen
One version for all	A. Men’s email to all customers	One email. Simple to run. The largest mean effect.	Customers who buy only women’s products can prefer the women’s email.	Test
One version for all	B. Women’s email to all customers	One email.	A smaller mean effect.	Test
Version by a known feature	C. Match the version to the product history	Each customer gets the products that they buy.	Two emails. It helps only if the women’s email is better for some customers.	Test
Version by a model	D. A model predicts the effect of each version for each customer and selects the larger one	Uses all features.	The choice depends on the difference of two noisy uplift estimates. Less than 1% of customers convert.	Screened out: Section 4d tests uplift models for one email. A model for the difference of two emails has more noise.
Both versions	E. Send both emails to the same customer	No choice is necessary.	Two contact costs. Fatigue.	Screened out: the test has no group with both emails, so the data cannot measure the effect.

Evidence. The table gives the spend effect of each version in each product history, with its Welch 95% CI. The last two columns compare the two versions directly. Then the code calculates the mean effect of option C. It adds the effect of the matched version in each product history, with the share of the customers as the weight.

# Purpose: Compare the two versions in each product history, and option C against option A (dec-04).
# Input:   `d`, `ATE` (Section 4a).
# Output:  Table `dec04`. `eff_c` (mean effect of option C). N values for the text.

dec04 <- do.call(rbind, lapply(levels(d$buyer), function(b) {
  s <- d[d$buyer == b, ]
  # Welch t-test of each email against the control group in this product history.
  r <- sapply(c("mens", "womens"), function(a) {
    tt <- t.test(s$spend[s$arm == a], s$spend[s$arm == "control"])
    c(-diff(tt$estimate), tt$conf.int)
  })
  # Direct comparison of the two versions.
  dw <- t.test(s$spend[s$arm == "mens"], s$spend[s$arm == "womens"])
  data.frame(`Product history` = b, Customers = num(nrow(s)),
             `Effect, men's` = usd(r[1, "mens"]), `95% CI, men's` = ci_txt(r[2, "mens"], r[3, "mens"]),
             `Effect, women's` = usd(r[1, "womens"]), `95% CI, women's` = ci_txt(r[2, "womens"], r[3, "womens"]),
             `Men's minus women's` = usd(-diff(dw$estimate)), `p-value` = fmt_p(dw$p.value),
             check.names = FALSE)
}))
kable(dec04, row.names = FALSE, align = "lrrrrrrr")

Product history	Customers	Effect, men’s	95% CI, men’s	Effect, women’s	95% CI, women’s	Men’s minus women’s	p-value
mens only	28,818	$0.68	[$0.25, $1.12]	$0.28	[-$0.12, $0.68]	$0.40	0.096
womens only	28,734	$0.62	[$0.27, $0.96]	$0.63	[$0.30, $0.97]	-$0.02	0.939
both	6,448	$1.82	[$0.49, $3.16]	$0.16	[-$0.81, $1.14]	$1.66	0.014

# Option C: men's email to "mens only" and "both", women's email to "womens only".
eff_c <- sum(sapply(levels(d$buyer), function(b) {
  a <- if (b == "womens only") "womens" else "mens"
  mean(d$buyer == b) * (mean(d$spend[d$buyer == b & d$arm == a]) - mean(d$spend[d$buyer == b & d$arm == "control"]))
}))
N$eff_c <- usd(eff_c, 3)
N$ate_m3 <- usd(ATE["mens"], 3)
N$eff_c_gain <- unname(usd(eff_c - ATE["mens"], 3))
N$eff_c_gain_100k <- unname(usd(CAMPAIGN * MARGIN * (eff_c - ATE["mens"]), 0))
N$w_only_m <- dec04$`Effect, men's`[dec04$`Product history` == "womens only"]
N$w_only_w <- dec04$`Effect, women's`[dec04$`Product history` == "womens only"]
N$m_only_w <- dec04$`Effect, women's`[dec04$`Product history` == "mens only"]
N$m_only_w_ci <- dec04$`95% CI, women's`[dec04$`Product history` == "mens only"]
N$both_m <- dec04$`Effect, men's`[dec04$`Product history` == "both"]
N$both_w <- dec04$`Effect, women's`[dec04$`Product history` == "both"]

Decision. Option A: send the men’s email to all customers.

Why. The men’s email increases spend in each product history. For the customers who buy only men’s products, the women’s email has no clear effect: $0.28, with a 95% CI of [-$0.12, $0.68]. For the customers who buy both product types, the men’s email gives $1.82 and the women’s email $0.16.

The women’s email works as well as the men’s email only for the customers who buy only women’s products: $0.63 against $0.62. Thus option C changes the version only where the two versions are equal. Option C gives a mean effect of $0.775, and option A gives $0.770. The difference of $0.005 adds only $152 of margin for 100,000 customers, but it needs a second email.

What would change the decision. If Marketing makes a new women’s email with a larger effect for women’s buyers, test option C again. The test then needs a group for each version in that product history.

4c. Segment effects

Section 4b selected the men’s email. From this section, the notebook uses only the men’s email and the control group. The mean effect can hide a segment where the email loses money. The next question is: does the effect of the men’s email change by segment, and how do we report it without false results?

How do we report the effect in each segment?

Why this question matters. Marketing wants to know where the email pays for itself. Five features give many segments. If we test each segment at 5%, some segments show an effect by chance. A false segment effect can stop the email for customers where it makes money, or send it where it loses money.

Ways to do it. The split axis is: how does the report control the false results? It can use no control, correct each p-value, first test if the effect changes at all, or make the segment estimates smaller toward the mean. Each way then goes through one filter: can a reviewer check it without a new model?

Group	Option	Advantage	Main risk	Screen
No control	A. Effect of each segment, p < 0.05	Simple.	With many segments, some segments show an effect by chance.	Test
Correct each p-value	B. Effect of each segment, with the Holm correction	Controls the probability of one or more false results.	Less power for each segment.	Test
Test the change first	C. Interaction test for each feature. Then option B for the features with an interaction.	Examines only the features where the effect really changes.	Two steps.	Test
Estimates toward the mean	D. A hierarchical model that pulls each segment effect toward the mean effect	Uses all segments together. Fewer extreme results.	It needs a prior and a model review. The result depends on the prior.	Screened out: Section 4d tests a model that finds the customers with a large uplift. Each customer gets an uplift from a model that did not see that customer.

Evidence. The first table gives the interaction test for each feature, with the Holm correction over the features. The last row tests a straight-line change of the effect with the history in dollars. The second table repeats options A and B on 50 placebo data sets. In each placebo data set, the code puts the treatment flag in a random order. Thus the true effect is zero in each segment, and each segment effect that a test finds is false.

Technical note. The interaction test for a feature v compares two linear models with an F-test: spend ~ t + v against spend ~ t × v. The second model gives one effect of the email for each level of v. A small p-value shows that the effect changes with v.

The Holm correction sorts the k p-values from small to large. It multiplies the j-th p-value by (k − j + 1) and keeps the order. It keeps the probability of one or more false results at 5% or less. The chart below uses a Bonferroni width for each interval: the Welch standard error times the normal quantile at 1 − 0.05 / (2k). This width is a safe bound for the Holm intervals.

# Purpose: Test if the effect changes by segment, and measure the false results of options A and B (dec-05).
# Input:   `d`, `SEED`, `ALPHA`.
# Output:  `m` (men's email and control, with `t`), `seg_vars`, `inter` (interaction p-values),
#          `placebo`. N values for the text.

m <- d[d$arm != "womens", ]
m$t <- as.integer(m$arm == "mens")  # 1 = men's email, 0 = control
seg_vars <- c(`History bucket` = "hseg", `Product history` = "buyer", `New customer` = "newbie",
              Channel = "channel", `Area type` = "zip")
# F-test of the interaction for each feature.
inter <- sapply(seg_vars, function(v) {
  f0 <- lm(as.formula(paste("spend ~ t + factor(", v, ")")), m)
  f1 <- lm(as.formula(paste("spend ~ t * factor(", v, ")")), m)
  anova(f0, f1)[2, "Pr(>F)"]
})
lin <- summary(lm(spend ~ t * history, m))$coefficients
inter <- c(inter, `History (straight line)` = lin["t:history", 4])
kable(data.frame(Feature = names(inter), `Interaction p-value` = fmt_p(inter),
                 `Holm p-value` = fmt_p(p.adjust(inter, "holm")), check.names = FALSE), row.names = FALSE)

Feature	Interaction p-value	Holm p-value
History bucket	0.426	1.000
Product history	0.049	0.294
New customer	0.188	0.754
Channel	0.346	1.000
Area type	0.977	1.000
History (straight line)	0.063	0.313

# Placebo: a random order of the treatment flag. Each segment effect that a test finds is false.
seg_tests <- function(dat) {
  unlist(lapply(seg_vars, function(v) sapply(split(dat, dat[[v]]), function(s) t.test(s$spend[s$t == 1], s$spend[s$t == 0])$p.value)))
}
n_seg <- length(seg_tests(m))
set.seed(SEED)
placebo <- replicate(50, {
  p <- m
  p$t <- sample(p$t)
  ps <- seg_tests(p)
  c(raw = sum(ps < ALPHA), holm = sum(p.adjust(ps, "holm") < ALPHA))
})
kable(data.frame(Option = c("A. p < 0.05", "B. Holm correction"),
                 `Mean number of false segment effects` = paste0(formatC(rowMeans(placebo), format = "f", digits = 2), " of ", n_seg),
                 `Placebo tests with one or more false results` = pct(rowMeans(placebo > 0), 0), check.names = FALSE), row.names = FALSE)

Option	Mean number of false segment effects	Placebo tests with one or more false results
A. p < 0.05	0.92 of 18	62%
B. Holm correction	0.02 of 18	2%

N$n_seg_tests <- n_seg
N$placebo_any <- pct(mean(placebo["raw", ] > 0), 0)
N$placebo_holm <- pct(mean(placebo["holm", ] > 0), 0)
N$n_inter <- sum(p.adjust(inter, "holm") < ALPHA)
N$min_raw <- names(inter)[which.min(inter)]
N$min_raw_p <- fmt_p(min(inter))
N$min_holm_p <- fmt_p(min(p.adjust(inter, "holm")))
N$lin_slope <- usd(100 * lin["t:history", 1])

Decision. Option C: the interaction test first, then the effect of each segment with the Holm correction. Report the segment effects as a description, not as a reason to target.

Why. The five features give 18 segments. The placebo data has no real effect, but option A finds one or more false segment effects in 62% of the runs.

With the Holm correction, this share is 2%. In this test, 0 features have an interaction after the Holm correction. The smallest raw p-value is 0.049 (Product history), and its Holm p-value is 0.294. Thus the data gives only weak evidence that the effect changes by segment.

The straight-line test points in one direction: each $100 of history adds about $0.11 to the effect. Section 4d uses this signal: it puts the customers in order by history.

What would change the decision. If the business names one or two segments before the test, test only these segments. Then the correction is not necessary.

The chart shows the effect of the men’s email in each history bucket and each product history. Each interval has the Holm-adjusted width of the technical note above. Two reference lines help to read it. The first is the mean effect of Section 4a. The second is the breakeven effect: the contact cost divided by the margin (as-01, as-02). Above the breakeven effect, the email pays for itself.

# Purpose: Show the segment effects of dec-05 against the mean effect and the breakeven effect.
# Input:   `m`, `ATE`, `ALPHA`, `COST` (as-02), `MARGIN` (as-01), `CS` and the functions of chart_style.R.
# Output:  `seg` (one row for each segment). Chart. N values for the text.

if (!exists("CS")) source("chart_style.R")  # The setup chunk sources it. This line keeps a part test alive.
seg <- do.call(rbind, lapply(c("hseg", "buyer"), function(v) do.call(rbind, lapply(levels(m[[v]]), function(lv) {
  s <- m[m[[v]] == lv, ]
  tt <- t.test(s$spend[s$t == 1], s$spend[s$t == 0])
  data.frame(var = v, level = lv, n = nrow(s), eff = -diff(tt$estimate), se = tt$stderr, p = tt$p.value)
}))))
k <- nrow(seg)
z <- qnorm(1 - ALPHA / (2 * k))  # Bonferroni width. It is a safe bound for the Holm intervals.
seg$lo <- seg$eff - z * seg$se
seg$hi <- seg$eff + z * seg$se
seg$p_holm <- p.adjust(seg$p, "holm")
be_seg <- COST / MARGIN
N$breakeven_eff <- usd(be_seg)
N$n_seg_above <- sum(seg$eff > be_seg)
N$k_seg <- k
N$n_seg_holm <- sum(seg$p_holm < ALPHA & seg$eff > 0)
N$n_seg_lo_above <- sum(seg$lo > be_seg)
# History of $350 or more against less: the pattern that Section 4d uses.
hi_h <- m$history >= 350
N$eff_hist_hi <- usd(mean(m$spend[hi_h & m$t == 1]) - mean(m$spend[hi_h & m$t == 0]))
N$eff_hist_lo <- usd(mean(m$spend[!hi_h & m$t == 1]) - mean(m$spend[!hi_h & m$t == 0]))

# Labels: the segment and its number of customers.
buyer_lab <- c(`mens only` = "Men's products only", `womens only` = "Women's products only", both = "Both product types")
lab <- ifelse(seg$var == "hseg", paste("History", seg$level), buyer_lab[seg$level])
lab <- paste0(lab, "  (", num(seg$n), ")")
yy <- rev(seq_len(k))
pcol <- ifelse(seg$p_holm < ALPHA, CS$blue, CS$gray)

cs_setup(mar = c(3.6, 13, 1.6, 1.5))
plot(NA, xlim = range(c(seg$lo, seg$hi, 0)), ylim = c(0.5, k + 0.5), axes = FALSE,
     xlab = "Change in mean spend for each customer ($)", ylab = "")
axis(1, at = axTicks(1), labels = usd(axTicks(1), 0))  # usd() writes a plain minus sign
axis(2, at = yy, labels = lab, tick = FALSE, col.axis = CS$ink, cex.axis = 0.8)
abline(v = 0, col = CS$light_gray)
abline(h = sum(seg$var == "buyer") + 0.5, col = CS$light_gray, lty = 3)  # Line between the two features
# Reference lines with direct labels at the top: the mean effect and the breakeven effect.
abline(v = ATE["mens"], col = CS$navy, lty = 2, lwd = 1.2)
abline(v = be_seg, col = CS$muted, lty = 3, lwd = 1.2)
text(ATE["mens"], k + 0.9, paste0(" Mean effect ", N$ate_m), adj = c(0, 0.5), xpd = NA, col = CS$navy, cex = 0.75)
text(be_seg, k + 0.9, paste0("Breakeven ", N$breakeven_eff, " "), adj = c(1, 0.5), xpd = NA, col = CS$muted, cex = 0.75)
# Intervals and point effects. Blue: Holm p < 0.05. Gray: the others.
segments(seg$lo, yy, seg$hi, yy, col = pcol, lwd = 2.5)
points(seg$eff, yy, pch = 19, col = pcol, cex = 1.1)
cs_title(paste0("The effect beats the ", N$breakeven_eff, " breakeven in ", N$n_seg_above, " of ",
                N$k_seg, " segments, with wide intervals"),
         "Spend effect of the men's email, Holm-adjusted 95% intervals. Blue: Holm p < 0.05; gray: the others")

How to read: each row is one segment, with its number of customers in brackets. The dot is the spend effect of the men’s email, and the line is its Holm-adjusted 95% interval. A blue line has a Holm p-value less than 0.05.

So what: the point effect is above the breakeven effect of $0.33 in 10 of 10 segments. But only 2 segments have a Holm p-value less than 0.05, and 0 intervals are fully above the breakeven effect. Thus one feature at a time cannot show a segment where the email loses money. The effect is $1.40 for customers with $350 or more of history and $0.59 for the others. Section 4d tests if an order by history, or a model, finds the customers with the largest uplift.

4d. Uplift method

Section 4c found only weak evidence that the effect changes with one feature at a time. A combination of features can still find customers with a larger uplift. If the contact cost is high, the order of the customers by uplift decides who gets the email. Thus the last question of Step 4 is: which method puts the customers in this order?

Which method puts the customers in order of uplift?

Why this question matters. A targeting rule sends the email to the top of a list. If the list has the wrong order, the rule removes customers who buy because of the email, and it keeps customers who do not. A complex model also needs a model review and a monthly check. Thus a model must give a clearly better order than a simple rule.

Ways to do it. The split axis is where the order comes from. It can come from one pre-test feature, a table of segments, a model of the outcome in each group, or a model of the uplift. These four groups cover the usual uplift methods, and each method belongs to one of them.

Where the order comes from	Method	Advantage	Main risk	Status
One pre-test feature	A. Rank by history (no model)	Simple. No model to approve. Customers who spent more in the past can buy more.	It ranks by the value of the customer, not directly by the uplift.	Possible. Test it as the baseline.
A table of segments	B. Segment table: history bucket × product history	Easy to read.	Each cell has few buyers, so each estimate is noisy.	Possible. Test it.
A model of the outcome in each group	C. T-learner: one logistic regression of the conversion in each group	Uses all features. A standard method.	The uplift is the difference of two noisy predictions.	Possible. Test it.
A model of the outcome in each group	S-learner or X-learner	The S-learner uses one model. The X-learner can help when the groups have different sizes.	Here the groups have the same size. A linear S-learner with no interaction gives the same uplift to all customers.	Screened out
A model of the uplift	D. Uplift tree on the transformed outcome	One model. The tree gives rules that a person can read.	The transformed outcome has a large variance for spend.	Possible. Test it.
A model of the uplift	Causal forest or uplift random forest	Strong on large data with many buyers.	Needs packages outside base R and rpart. With so few buyers, a forest of trees also fits noise.	Screened out

The rule before the evidence (branch 5). We set the model rule in section 3a, before the rerun. An ML uplift model (C or D) replaces rank by history only if two conditions are true. Its mean Qini area is 20% or more higher than the area of rank by history. Its Qini area is more than 0 in at least 9 of 10 repeats. The segment table also uses estimates from the test data, so we apply the same bar to it.

Technical note. Settings of the methods. Each method uses only the men’s email and the control group.

• Cross-fit. 5 folds, repeated 10 times with the seeds SEED + 1 to SEED + 10. Rank by history needs no folds, so its area is the same in each repeat.
• B. Segment table. For each cell of history bucket × product history in the training folds: mean spend of the email group − mean spend of the control group. A cell with no customers in the training folds gets an uplift of 0.
• C. T-learner. In each group, a logistic regression of the conversion on recency, log(history), product history, area type, new customer and channel. The uplift = (mean spend of a buyer × probability to buy) in the email group − the same in the control group.
• D. Uplift tree. The transformed outcome z = spend × (t − p) / (p × (1 − p)), with p the share of the email group. Its mean is the uplift. A regression tree on z (rpart) with at most 3 levels, at least 3,000 customers in each leaf and no cost-complexity limit (cp = 0).
• Qini area. At the top 5%, 10%, …, 100% of the list (section 3a). A tie in the score gets a random order.

Evidence. For each repeat, the code gives each customer a cross-fitted uplift from each method. It then draws the Qini curve of each method and calculates its Qini area. The table gives the area over the 10 repeats and applies the model rule.

# Purpose: Compare four uplift methods by the Qini area and apply the model rule of branch 5 (dec-06).
# Input:   `m` (men's email + control, Step 4c), `SEED`, `RULES`, uplift_oof(), qini(), qini_area()
#          (case03_helpers.R).
# Output:  `p_t`, `GRID`, `preds`, `curves`, `area` (one row for each repeat), `OPT6`, table, N values.

p_t <- mean(m$t)            # Share of the email group
GRID <- seq(0.05, 1, 0.05)  # Top shares of the list for the Qini curve

REPS <- 10
preds <- lapply(seq_len(REPS), function(r) uplift_oof(SEED + r))
curves <- lapply(preds, function(p) { set.seed(SEED); sapply(colnames(p), function(cn) qini(p[, cn], m$spend, m$t)) })
area <- t(sapply(curves, qini_area))
OPT6 <- c(A = "A. Rank by history", B = "B. Segment table", C = "C. T-learner", D = "D. Uplift tree")

# The model rule of branch 5, set before the evidence.
gain6 <- colMeans(area) / mean(area[, "A"]) - 1     # Mean Qini area against rank by history (relative)
pos6 <- colSums(area > 0)                           # Repeats with a Qini area more than 0
pass6 <- gain6 >= RULES$b5_model_gain & pos6 >= RULES$b5_model_pos
pass6["A"] <- NA                                    # The baseline
cand <- names(which(pass6[c("B", "C", "D")]))
chosen6 <- if (length(cand)) cand[which.max(colMeans(area)[cand])] else "A"

kable(data.frame(Option = OPT6,
                 `Mean Qini area` = usd(colMeans(area), 3),
                 `Lowest of 10 repeats` = usd(apply(area, 2, min), 3),
                 `Highest of 10 repeats` = usd(apply(area, 2, max), 3),
                 `Repeats with area > 0` = paste(pos6, "of", REPS),
                 `Mean area against A` = c("baseline", paste0(ifelse(gain6[-1] > 0, "+", ""), pct(gain6[-1], 0))),
                 `Model rule` = c("baseline", ifelse(pass6[-1], "passes", "fails")),
                 check.names = FALSE), row.names = FALSE, align = "lrrrrrl")

Option	Mean Qini area	Lowest of 10 repeats	Highest of 10 repeats	Repeats with area > 0	Mean area against A	Model rule
A. Rank by history	$0.083	$0.083	$0.083	10 of 10	baseline	baseline
B. Segment table	$0.068	$0.017	$0.136	10 of 10	-18%	fails
C. T-learner	-$0.029	-$0.076	$0.017	3 of 10	-135%	fails
D. Uplift tree	-$0.019	-$0.043	-$0.000	0 of 10	-123%	fails

best6 <- names(which.max(colMeans(area)))
N$best6 <- OPT6[best6]
N$chosen6 <- OPT6[chosen6]
N$b5_model <- if (chosen6 == "A") "keeps" else "replaces"
N$n_pass6 <- length(cand)
N$area_a <- usd(mean(area[, "A"]), 3)
N$area_b <- usd(mean(area[, "B"]), 3)
N$area_b_range <- ci_txt(min(area[, "B"]), max(area[, "B"]), function(x) usd(x, 3))
N$area_cd <- paste0(usd(mean(area[, "C"]), 3), " and ", usd(mean(area[, "D"]), 3))
N$gain_b <- pct(gain6[["B"]], 0); N$gain_c <- pct(gain6[["C"]], 0); N$gain_d <- pct(gain6[["D"]], 0)
N$pos_b <- pos6[["B"]]; N$pos_c <- pos6[["C"]]; N$pos_d <- pos6[["D"]]

# Purpose: Show the Qini curves of the first repeat against the line of a random order (dec-06).
# Input:   `curves`, `GRID`, `OPT6`, `CS` and the chart functions (chart_style.R).
# Output:  Chart only.

cv <- rbind(0, curves[[1]])
xs <- c(0, GRID) * 100
col6 <- c(A = CS$navy, B = CS$cyan, C = CS$gray, D = CS$gray)
lwd6 <- c(A = 2.8, B = 1.8, C = 1.5, D = 1.5)
cs_setup(mar = c(3.6, 5.4, 0.6, 1.5))
plot(xs, cv[, "A"], type = "n", ylim = range(0, cv), xlim = c(0, 100), xaxt = "n", yaxt = "n",
     xlab = "Share of customers that get the email, in the order of each method", ylab = "")
title(ylab = "Incremental spend for each customer", line = 3.6)  # More room for the dollar labels
axis(1, at = seq(0, 100, 20), labels = paste0(seq(0, 100, 20), "%"))
cs_dollar_axis(2)
lines(c(0, 100), c(0, cv[nrow(cv), "A"]), lty = 2, col = CS$light_gray, lwd = 1.5)
for (o in c("D", "C", "B", "A")) lines(xs, cv[, o], col = col6[o], lwd = lwd6[o])
# Direct labels in the empty space next to each curve: A and B above the curves, C and D below.
lab <- data.frame(o = c("A", "B", "C", "D"), x = c(25, 70, 65, 85),
                  ax = c(1.05, 0.5, 0.5, 0.5), ay = c(-0.6, -0.9, 1.8, 1.8))
for (j in seq_len(nrow(lab))) {
  o <- lab$o[j]; i <- which.min(abs(xs - lab$x[j]))
  text(xs[i], cv[i, o], OPT6[o], adj = c(lab$ax[j], lab$ay[j]), cex = 0.78,
       col = if (o == "A") CS$navy else if (o == "B") CS$cyan else CS$muted, font = if (o == "A") 2 else 1)
}
cs_title(paste0("Rank by history gives the largest Qini area: ", N$area_a, " for each customer"),
         "Qini curves of the first repeat of the 5-fold cross-fit; dashed line: random order")

How to read: each line starts at 0 and adds customers in the order of one method. The height is the incremental spend for each customer of the campaign. The dashed line is a random order. A curve above the dashed line puts the customers with a large uplift first.

So what: rank by history (navy) stays above the random order at each share. The T-learner and the uplift tree (gray) cross the random order, and their mean areas over 10 repeats are below 0.

Decision. Rank by history. The model rule keeps rank by history: 0 of the three methods with estimates passes the rule.

Why. Three reasons, from the most important:

1. No model passes the rule. The T-learner has a mean area -135% against rank by history, with an area more than 0 in 3 of 10 repeats. The uplift tree has -123%, with 0 of 10. The two models are not better than a random order (-$0.029 and -$0.019). Less than 1% of the customers buy, so the models with more features fit noise.
2. The segment table is not stable. Its mean area is $0.068 (-18% against rank by history), and it changes from repeat to repeat ([$0.017, $0.136]). One cut of the folds can make it look better or worse than history.
3. Rank by history is simple and stable. It has the largest mean area, $0.083. It needs no model, so Marketing can use it without a model review.

What would change the decision. If a test has many more buyers, an ML model can find a pattern that history cannot show. Repeat this comparison with each new test and the same rule. Keep rank by history as the baseline.

Business note. The men’s email increases the mean spend by $0.77 for each customer (95% CI [$0.49, $1.05]). This is 2.3 times the breakeven effect. The best order of the customers by uplift is the simplest one: rank by history. No ML model passes the rule of branch 5. Step 5 gives each customer an uplift from this order.

Step 5. Make predictions

Step 4 selected the men’s email and rank by history as the order of the customers. A targeting rule needs more than an order: it needs the uplift in dollars of each part of the list. Only then can we compare the uplift with the breakeven effect of $0.33. This step answers: what uplift does each customer get, and how sure are we?

Purpose. This step gives each customer an uplift on spend from the history quartile of the customer. It supports this decision: the list of customers for the email if the contact cost goes up (Step 7a).

The prediction for a customer is the uplift of the history quartile of that customer. We use quartiles, because each quartile has about one quarter of the customers and enough buyers for an interval. Smaller groups give intervals that are too wide for a decision.

The code gives two estimates for each quartile:

• The uplift of the quartile. The mean spend of the email group − the mean spend of the control group, with the Welch 95% CI. All customers of the quartile give this estimate.
• The cross-fitted uplift. Each customer gets the uplift of the quartile from the other four folds (5-fold cross-fit). Thus the estimate of a customer never uses that customer. Step 7a uses this estimate in the breakeven rule. The range of the cross-fitted uplift over the five folds shows how much the data of one fold moves the estimate.

# Purpose: The uplift on spend of each history quartile and the cross-fitted uplift of each customer (Step 5).
# Input:   `m`, `MARGIN`, `COST`, `SEED`, group_effect(), xfit_group() and breakeven() (case03_helpers.R).
# Output:  `qs` (quartile cuts), `m$hq` (history quartile), `uq` (uplift of each quartile with its 95% CI),
#          `uq_cf` (cross-fitted uplift of each customer), N values.

qs <- quantile(m$history, c(0.25, 0.50, 0.75))
m$hq <- cut(m$history, c(-Inf, qs, Inf), labels = c("Q1 (lowest)", "Q2", "Q3", "Q4 (highest)"))
uq <- group_effect(m, m$hq)
names(uq)[names(uq) == "level"] <- "q"
uq$lo_h <- as.vector(tapply(m$history, m$hq, min))
uq$hi_h <- as.vector(tapply(m$history, m$hq, max))
uq <- uq[, c("q", "n", "lo_h", "hi_h", "eff", "lo", "hi")]

# Cross-fitted uplift: the same folds as Step 7a (seed SEED + 1).
uq_cf <- xfit_group(m, m$hq, SEED + 1)
cf_mean <- tapply(uq_cf, m$hq, mean)
cf_fold <- tapply(seq_along(uq_cf), m$hq, function(i) range(uq_cf[i]))

kable(data.frame(`History quartile` = uq$q, `History range` = paste(usd(uq$lo_h, 0), "to", usd(uq$hi_h, 0)),
                 Customers = num(uq$n), `Uplift on spend` = usd(uq$eff), `95% CI` = ci_txt(uq$lo, uq$hi),
                 `Cross-fitted uplift, mean` = usd(cf_mean),
                 `Cross-fitted uplift, range of 5 folds` = sapply(cf_fold, function(r) ci_txt(r[1], r[2])),
                 `Profit for each email at $0.10` = usd(MARGIN * uq$eff - COST), check.names = FALSE),
      row.names = FALSE, align = "llrrrrrr")

History quartile	History range	Customers	Uplift on spend	95% CI	Cross-fitted uplift, mean	Cross-fitted uplift, range of 5 folds	Profit for each email at $0.10
Q1 (lowest)	$30 to $64	10,654	$0.63	[$0.07, $1.19]	$0.63	[$0.26, $0.90]	$0.09
Q2	$65 to $157	10,653	$0.40	[-$0.03, $0.84]	$0.40	[$0.22, $0.54]	$0.02
Q3	$157 to $325	10,653	$0.65	[$0.09, $1.22]	$0.65	[$0.49, $0.85]	$0.10
Q4 (highest)	$325 to $3,346	10,653	$1.39	[$0.70, $2.08]	$1.39	[$0.99, $1.60]	$0.32

N$q4_eff <- usd(uq$eff[4]); N$q4_cut <- usd(qs[3], 0)
N$q4_ci <- ci_txt(uq$lo[4], uq$hi[4])
N$q13 <- paste(usd(min(uq$eff[1:3])), "to", usd(max(uq$eff[1:3])))
N$q_min_profit <- usd(min(MARGIN * uq$eff - COST), 3)
N$q_n <- num(min(uq$n))
N$n_q_above <- sum(uq$eff > breakeven())
N$n_q_lo_above <- sum(uq$lo > breakeven())
N$q_lo_min <- usd(min(uq$lo))
N$cf_range <- paste(usd(min(sapply(cf_fold, min))), "to", usd(max(sapply(cf_fold, max))))
N$q4_cf_range <- ci_txt(cf_fold[[4]][1], cf_fold[[4]][2])
N$q4_ratio <- formatC(uq$eff[4] / mean(uq$eff[1:3]), format = "f", digits = 1)
# Does the top quartile stay above the other quartiles in each fold?
q4_top <- cf_fold[[4]][1] > max(sapply(cf_fold[1:3], max))
N$q4_order <- if (q4_top) "stays on top in each fold" else "does not stay on top in each fold"

# Purpose: Show the uplift of each history quartile against the breakeven effect (Step 5).
# Input:   `uq`, breakeven(), `CS` and the chart functions (chart_style.R).
# Output:  Chart only.

xq <- seq_len(nrow(uq))
qcol <- ifelse(xq == 4, CS$blue, CS$navy)
cs_setup(mar = c(3.6, 5.4, 0.6, 7))
plot(xq, uq$eff, ylim = range(0, uq$lo, uq$hi), xlim = c(0.6, 4.4), pch = 19, cex = 1.3, col = qcol,
     xaxt = "n", yaxt = "n", xlab = "History quartile (spend in the 12 months before the test)", ylab = "")
title(ylab = "Uplift on spend for each customer", line = 3.6)  # More room for the dollar labels
segments(xq, uq$lo, xq, uq$hi, col = qcol, lwd = 3)
axis(1, at = xq, labels = paste0(uq$q, "\n", usd(uq$lo_h, 0), " to ", usd(uq$hi_h, 0)), padj = 0.5, cex.axis = 0.75)
cs_dollar_axis(2)
abline(h = 0, col = CS$light_gray)
abline(h = breakeven(), lty = 2, col = CS$gray)
cs_label_end(4.4, breakeven(), paste0("Breakeven ", usd(breakeven())), col = CS$muted)
text(xq, uq$eff, usd(uq$eff), pos = 4, offset = 0.7, cex = 0.8, col = qcol, font = ifelse(xq == 4, 2, 1))
cs_title(paste0("The top history quartile adds ", N$q4_eff, " of spend; the other quartiles ", N$q13),
         "Uplift of the men's email on spend for each customer, with the Welch 95% CI")

How to read: each point is the uplift of one history quartile, with its 95% CI. The dashed line is the breakeven effect at a $0.10 contact cost. A quartile above the line makes money with each email.

So what: the point estimate is above the breakeven effect in 4 of 4 quartiles. The interval is fully above it in only 1 of 4 quartiles, so the uplift of a quartile is not certain.

The uplift is $0.40 to $0.65 in the three lower quartiles. In the top quartile (history more than $325), it is $1.39 (95% CI [$0.70, $2.08]). At a contact cost of $0.10, each quartile is profitable, but the lowest profit is only $0.020 for each email.

The cross-fitted uplift of a customer goes from $0.22 to $1.60. In the top quartile, the range is [$0.99, $1.60]. Thus the estimate of a quartile moves with the fold, and the top quartile stays on top in each fold.

Business note. Each customer now has an uplift from the history quartile. The top quartile gives $1.39 for each customer, 2.5 times the mean of the other quartiles. Thus the top quartile is the first group to keep if the contact cost goes up. Step 6 checks the recommended policy against the five branches of section 3a. Step 7a then compares “send to all” with the rules that use this uplift.

Step 6. Evaluate

Steps 4 and 5 gave the evidence one piece at a time. The men’s email increases spend, it is the better version, and each history quartile is profitable at the base contact cost. Now we must judge the recommended policy as a whole: send the men’s email to all customers. This step uses the five branches of the evaluation framework of Step 3a, one at a time.

Purpose. This step answers: is the policy “men’s email to all customers” valid, large enough, robust, profitable and better than a targeting rule? It supports this decision: approve the policy for the launch with a holdout.

The table repeats the five rules of Step 3a. We set these rules before the rerun of this version, and we do not change them after a result. If a result fails a rule, this step reports the failure and what it means.

Branch	Question	Rule
1. Validity	Do the groups differ only by the email?	The largest absolute standardized difference is less than 0.05. The p-value of the sample-ratio check is more than 0.01.
2. Effect	Does the men’s email change spend, and is the test large enough?	The Welch 95% CI excludes 0. Each group has at least the customers for 80% power at the observed effect.
3. Robustness	Does the effect hold with other methods?	The bootstrap 95% CI excludes 0. The CUPED effect and the regression effect are each within 10% of the unadjusted effect.
4. Business value	Does the recommended policy make money?	The profit for 100,000 customers is more than 0, and the lower end of its 95% CI is more than 0.
5. Targeting	Does a targeting rule or an uplift model beat “send to all”?	The policy follows the model rule and the policy rule of Step 3a.

6a. Branch 1: validity

The question: do the three groups differ only by the email? The data source put each customer into a group at random. A random split gives groups that are equal on average, but a fault in the split can make them different. If the groups differ before the email, the difference of the means is not the effect of the email.

Two checks answer the question, because they find different faults:

• Standardized difference. It compares the mean of each pre-test feature in each email group with the control group. It finds a group with different customers.
• Sample-ratio check. It compares the number of customers in each group with an equal split. It finds a group that lost or gained customers.

Step 2d gives the full table of the standardized differences. This section applies the rule of Step 3a to it.

# Purpose: Measure branch 1 (validity) of the evaluation framework of Step 3a.
# Input:   `feat`, `d` (contract C2), `RULES` (Step 3a).
# Output:  `RULES` (if Step 3a did not make it), `e1_smd`, `e1_srm`, `b1_pass`, N$e1_*.

# The chart style of the notebook. The setup chunk loads it. This guard keeps the part usable alone.
if (!exists("CS")) source("chart_style.R")

# The rules of the evaluation framework: `RULES` of Step 3a. The fallback has the same values (the brief of
# round 2), for a run without the chunk of Step 3a. We set the rules before the rerun.
if (!exists("RULES")) {
  RULES <- list(
    b1_smd = 0.05,          # Branch 1: largest absolute standardized difference less than 0.05
    b1_srm_p = 0.01,        # Branch 1: p-value of the sample-ratio check more than 0.01
    b3_adj_dev = 0.10,      # Branch 3: each adjusted effect within 10% of the unadjusted effect
    b5_model_gain = 0.20,   # Branch 5: an ML uplift model needs a 20% higher mean Qini area ...
    b5_model_pos = 9,       # ... and a Qini area more than 0 in 9 or more of the repeats
    b5_policy_level = 0.90  # Branch 5: the 90% interval of the gain of a targeting rule must be above 0
  )
}

# Standardized difference of each pre-test feature: (mean of the email group - mean of control) / sd.
smd_arm <- function(a) sapply(feat, function(x) (mean(x[d$arm == a]) - mean(x[d$arm == "control"])) / sd(x))
smd_all <- cbind(mens = smd_arm("mens"), womens = smd_arm("womens"))
e1_smd <- max(abs(smd_all))
e1_smd_feat <- rownames(smd_all)[which.max(apply(abs(smd_all), 1, max))]
# Sample-ratio check: chi-square test of the group sizes against an equal split.
e1_srm <- chisq.test(table(d$arm))$p.value

b1_pass <- e1_smd < RULES$b1_smd && e1_srm > RULES$b1_srm_p
N$e1_smd <- formatC(e1_smd, format = "f", digits = 3)
N$e1_smd_feat <- e1_smd_feat
N$e1_srm <- formatC(e1_srm, format = "f", digits = 2)
N$e1_n_feat <- ncol(feat)
N$b1_verdict <- if (b1_pass) "The policy passes branch 1." else "The policy fails branch 1."

kable(data.frame(
  Check = c("Largest absolute standardized difference (both emails against control)", "Sample-ratio check: chi-square p-value"),
  Result = c(N$e1_smd, N$e1_srm),
  Rule = c("Less than 0.05", "More than 0.01"), check.names = FALSE), row.names = FALSE, align = "lrl")

Check	Result	Rule
Largest absolute standardized difference (both emails against control)	0.014	Less than 0.05
Sample-ratio check: chi-square p-value	0.90	More than 0.01

The largest standardized difference of the 10 pre-test features is 0.014 (zipRural), against the limit of 0.05. The p-value of the sample-ratio check is 0.90, against the limit of 0.01. The policy passes branch 1. Thus a difference of the means gives the causal effect of the email.

6b. Branch 2: effect

The question: does the men’s email change spend, and is the test large enough to trust the answer? A test with too few customers can find an effect by chance, and its estimate is often too large. Thus the rule has two parts:

• The Welch 95% CI of the spend effect excludes 0.
• Each group has at least the customers that a test needs for 80% power at the observed effect, at 5% significance.

# Purpose: Measure branch 2 (effect): the Welch CI and the size of the test at the observed effect.
# Input:   `d`, `ATE`, `ATE_LO`, `ATE_HI` (contract C3), `ALPHA`, `POWER`.
# Output:  `e2_need`, `e2_have`, `e2_power`, `b2_pass`, N$e2_*.

# Pooled standard deviation of spend in the three groups (the same as the power of Step 3c).
s_pool <- sqrt(mean(tapply(d$spend, d$arm, var)))
e2_have <- min(table(d$arm))
e2_need <- power.t.test(delta = ATE[["mens"]], sd = s_pool, sig.level = ALPHA, power = POWER)$n
# Power of this test at the observed effect.
e2_power <- power.t.test(n = e2_have, delta = ATE[["mens"]], sd = s_pool, sig.level = ALPHA)$power

b2_pass <- ATE_LO[["mens"]] > 0 && e2_have >= e2_need
N$e2_ci <- ci_txt(ATE_LO[["mens"]], ATE_HI[["mens"]])
N$e2_ate <- usd(ATE[["mens"]])
N$e2_need <- num(ceiling(e2_need))
N$e2_have <- num(e2_have)
N$e2_ratio <- formatC(e2_have / e2_need, format = "f", digits = 1)
N$e2_power <- pct(e2_power, 0)
N$b2_verdict <- if (b2_pass) "The policy passes branch 2." else "The policy fails branch 2."

kable(data.frame(
  Check = c("Spend effect of the men's email, Welch 95% CI", "Customers in the smallest group",
            "Customers for 80% power at the observed effect", "Power of this test at the observed effect"),
  Result = c(paste(N$e2_ate, N$e2_ci), N$e2_have, N$e2_need, N$e2_power),
  Rule = c("The CI excludes 0", "At least the customers for 80% power", "", ""), check.names = FALSE),
  row.names = FALSE, align = "lrl")

Check	Result	Rule
Spend effect of the men’s email, Welch 95% CI	$0.77 [$0.49, $1.05]	The CI excludes 0
Customers in the smallest group	21,306	At least the customers for 80% power
Customers for 80% power at the observed effect	5,988
Power of this test at the observed effect	100%

The men’s email increases the mean spend by $0.77 for each customer (95% CI [$0.49, $1.05]). The CI excludes 0. At this effect, a test needs 5,988 customers in each group for 80% power. The smallest group has 21,306, or 3.6 times this number, and the power is 100%. The policy passes branch 2.

6c. Branch 3: robustness

The question: does the effect hold if we use other methods? The Welch CI assumes that the mean of the spend has a normal distribution. Spend has a long right tail, so a reviewer can doubt this. The pre-test data can also change the estimate. Thus the rule uses three other methods:

• Bootstrap. It needs no normal distribution. The code repeats the bootstrap of Step 4a with the same seed and 2,000 samples, so the CI is the same.
• CUPED with history. It removes the part of the spend that history predicts.
• Regression adjustment. It adds all pre-test features to a linear regression.

The two adjusted effects come from the evidence of the variance-reduction decision in Step 4a.

# Purpose: Measure branch 3 (robustness): bootstrap CI, CUPED effect and regression effect of the men's email.
# Input:   `d`, `dec03` (contract C3), `SEED`, `ATE`.
# Output:  `e3_boot`, `e3_adj` (effects A, B and C), `b3_pass`, N$e3_*.

# Bootstrap: the same code and seed as dec-02, so the interval is the interval of Step 4a.
y1 <- d$spend[d$arm == "mens"]
y0 <- d$spend[d$arm == "control"]
set.seed(SEED)
bd <- replicate(2000, mean(y1[sample.int(length(y1), replace = TRUE)]) - mean(y0[sample.int(length(y0), replace = TRUE)]))
e3_boot <- quantile(bd, c(0.025, 0.975))

# Effects A (no adjustment), B (CUPED) and C (regression) for spend, men's email, from dec03.
# If dec03 has other column names, fit the three models again with the method of dec-03.
cols3 <- c("Metric", "Email", "Effect, A", "Effect, B", "Effect, C")
if (all(cols3 %in% names(dec03))) {
  r3 <- dec03[dec03$Metric == "spend" & dec03$Email == "Men's", ]
  e3_adj <- c(A = r3[["Effect, A"]], B = r3[["Effect, B"]], C = r3[["Effect, C"]])
} else {
  s3 <- d[d$arm %in% c("control", "mens"), ]
  s3$t <- as.integer(s3$arm == "mens")
  theta <- cov(s3$spend, s3$history) / var(s3$history)
  s3$y_cuped <- s3$spend - theta * (s3$history - mean(s3$history))
  e3_adj <- c(A = coef(lm(spend ~ t, s3))[["t"]], B = coef(lm(y_cuped ~ t, s3))[["t"]],
              C = coef(lm(spend ~ t + lhist + recency + mens + womens + zip + newbie + channel, s3))[["t"]])
}
e3_dev <- abs(e3_adj[c("B", "C")] / e3_adj[["A"]] - 1)  # Relative change against the unadjusted effect

b3_pass <- e3_boot[[1]] > 0 && all(e3_dev <= RULES$b3_adj_dev)
N$e3_boot <- ci_txt(e3_boot[[1]], e3_boot[[2]])
N$e3_cuped <- usd(e3_adj[["B"]], 3)
N$e3_reg <- usd(e3_adj[["C"]], 3)
N$e3_unadj <- usd(e3_adj[["A"]], 3)
N$e3_dev_max <- pct(max(e3_dev), 1)
N$b3_verdict <- if (b3_pass) "The policy passes branch 3." else "The policy fails branch 3."

kable(data.frame(
  Method = c("Welch t-test (no adjustment)", "Bootstrap, 2,000 samples", "CUPED with history", "Regression adjustment, all features"),
  `Effect on spend` = c(N$e3_unadj, N$e3_unadj, N$e3_cuped, N$e3_reg),
  `95% CI` = c(N$e2_ci, N$e3_boot, "", ""),
  `Change against no adjustment` = c("", "", pct(e3_dev[["B"]], 1), pct(e3_dev[["C"]], 1)),
  Rule = c("", "The CI excludes 0", "Within 10%", "Within 10%"), check.names = FALSE),
  row.names = FALSE, align = "lrrrl")

Method	Effect on spend	95% CI	Change against no adjustment	Rule
Welch t-test (no adjustment)	$0.770	[$0.49, $1.05]
Bootstrap, 2,000 samples	$0.770	[$0.48, $1.06]		The CI excludes 0
CUPED with history	$0.767		0.3%	Within 10%
Regression adjustment, all features	$0.769		0.1%	Within 10%

The bootstrap 95% CI is [$0.48, $1.06], almost the same as the Welch CI, and it excludes 0. The CUPED effect is $0.767, and the regression effect is $0.769. The unadjusted effect is $0.770. The largest change is 0.3%, against the limit of 10%. The policy passes branch 3.

6d. Branch 4: business value

The question: does the recommended policy make money, also at the low end of the effect? A positive effect is not sufficient. Each email has a contact cost, so the effect must be more than the breakeven effect. The rule uses the base margin of 30% (as-01) and the base contact cost of $0.10 (as-02), for one campaign of 100,000 customers (as-04).

Technical note. For a campaign of n customers, with margin m, contact cost c and spend effect u, the incremental profit is n × (m × u − c). The profit is a straight line in u. Thus the 95% CI of the profit comes directly from the Welch 95% CI of u. The breakeven effect is c / m.

# Purpose: Measure branch 4 (business value) at the base margin and contact cost (as-01, as-02, as-04).
# Input:   `ATE`, `ATE_LO`, `ATE_HI`, `MARGIN`, `COST`, `CAMPAIGN`.
# Output:  `e4_prof` (profit, lower end, upper end), `b4_pass`, N$e4_*.

# Profit = customers x (margin x effect - contact cost). The CI of the effect gives the CI of the profit.
e4_prof <- CAMPAIGN * (MARGIN * c(est = ATE[["mens"]], lo = ATE_LO[["mens"]], hi = ATE_HI[["mens"]]) - COST)
b4_pass <- e4_prof[["est"]] > 0 && e4_prof[["lo"]] > 0
N$e4_prof <- usd(e4_prof[["est"]], 0)
N$e4_ci <- ci_txt(e4_prof[["lo"]], e4_prof[["hi"]], function(x) usd(x, 0))
N$e4_be <- usd(COST / MARGIN)
N$e4_lo_eff <- usd(ATE_LO[["mens"]])
N$e4_cost <- usd(COST)
N$e4_margin <- pct(MARGIN, 0)
N$e4_campaign <- num(CAMPAIGN)
N$b4_verdict <- if (b4_pass) "The policy passes branch 4." else "The policy fails branch 4."

kable(data.frame(
  Check = c("Incremental profit for 100,000 customers", "95% CI of the profit", "Breakeven effect (contact cost / margin)",
            "Lower end of the 95% CI of the effect"),
  Result = c(N$e4_prof, N$e4_ci, N$e4_be, N$e4_lo_eff),
  Rule = c("More than 0", "Lower end more than 0", "", "More than the breakeven effect"), check.names = FALSE),
  row.names = FALSE, align = "lrl")

Check	Result	Rule
Incremental profit for 100,000 customers	$13,095	More than 0
95% CI of the profit	[$4,554, $21,635]	Lower end more than 0
Breakeven effect (contact cost / margin)	$0.33
Lower end of the 95% CI of the effect	$0.49	More than the breakeven effect

At a margin of 30% and a contact cost of $0.10, the men’s email to all gives $13,095 for 100,000 customers. The 95% CI of the profit is [$4,554, $21,635]. The lower end of the effect, $0.49, is above the breakeven effect of $0.33. The policy passes branch 4. The margin and the contact cost are assumptions, so Step 7c changes them.

6e. Branch 5: targeting

The question: can a smaller list of customers make more money than “send to all”? Step 5 showed that the top history quartile has the largest uplift. If the contact cost is high, an email to the low quartiles can lose money. The rule of Step 3a has two parts:

• Model rule. An ML uplift model replaces “rank by history” only if two conditions are true. Its mean Qini area is 20% or more higher, and its area is more than 0 in at least 9 of 10 repeats. The evidence comes from Step 4d.
• Policy rule. A targeting rule replaces “send to all” only if the 90% interval of its gain is above 0 at the base contact cost.

The recommended policy passes if it follows both rules. The policy rule compares two targeting rules with “send to all”:

• Top 25% by history. The email goes only to the top history quartile.
• Breakeven rule by history quartile. The email goes to a quartile only if the margin on its cross-fitted uplift is more than the contact cost.

The code calculates the profit of each rule for six contact costs, from $0.05 to $0.30. Branch 5 uses only the base cost. Step 7a uses the full table to select the targeting rule for other costs. Thus this table is also the evidence for that decision.

Technical note. The profit of a rule for each customer in the campaign is s × (m × û − c). Here s is the share of customers that the rule selects. The value û is the mean spend of the treated customers minus the mean spend of the control customers in that selection.

The breakeven rule uses the cross-fitted uplift of each history quartile, with 5 folds. Thus each customer gets an uplift from folds that do not contain that customer. The 90% interval of the gain comes from 500 bootstrap samples of the customers. Each rule and each cost use the same samples, so the code compares the rules on the same data.

# Purpose: Measure branch 5 (targeting): the model rule (Qini area, dec-06) and the policy rule (gain against
#          "send to all", 90% bootstrap interval). The table is also the evidence for dec-07 (Step 7a).
# Input:   `m` with `t`, `spend`, `hq` (contracts C4, C5), `area`, `MARGIN`, `COST`, `CAMPAIGN`, `SEED`.
# Output:  Contract C6: `policy_profit`, `u_q`, `all_sel`, `top_q`, `dec07`, `k100`. Also `boot_idx`,
#          `b5_model`, `b5_policy`, `b5_pass`, N$b5_*. Existing N names of dec-07 (a_base, cost_sig and others).

# Helper of case03_helpers.R. The definition below is the same, for a run without that file.
if (!exists("policy_profit")) {
  policy_profit <- function(sel, y, t, cost, margin = MARGIN) {
    # Profit for each customer in the campaign. Customers outside the selection get no email.
    share <- mean(sel)
    if (share == 0) return(0)
    eff <- mean(y[sel & t == 1]) - mean(y[sel & t == 0])
    share * (margin * eff - cost)
  }
}

# --- Model rule (dec-06 evidence): ML models against rank by history ---
# Columns of `area`: A rank by history, B segment table, C T-learner, D uplift tree (Step 4d).
area_mean <- colMeans(area)
b5_model <- data.frame(
  model = c("B", "C", "D"),
  gain = area_mean[c("B", "C", "D")] / area_mean[["A"]] - 1,
  pos = colSums(area[, c("B", "C", "D")] > 0))
b5_model$replaces <- b5_model$gain >= RULES$b5_model_gain & b5_model$pos >= RULES$b5_model_pos
ml_models <- c("C", "D")  # The T-learner and the uplift tree are the ML models. B is a table of means.
model_ok <- !any(b5_model$replaces[b5_model$model %in% ml_models])

# --- Policy rule: targeting rules against "send to all" ---
# Cross-fitted uplift of each history quartile (5 folds)
set.seed(SEED + 1)
fold <- sample(rep(1:5, length.out = nrow(m)))
u_q <- numeric(nrow(m))
for (k in 1:5) {
  tr <- m[fold != k, ]; te <- fold == k
  uu <- tapply(tr$spend[tr$t == 1], tr$hq[tr$t == 1], mean) - tapply(tr$spend[tr$t == 0], tr$hq[tr$t == 0], mean)
  u_q[te] <- uu[as.character(m$hq[te])]
}

COSTS <- c(0.05, 0.10, 0.15, 0.20, 0.25, 0.30)
all_sel <- rep(TRUE, nrow(m))
top_q <- m$hq == "Q4 (highest)"
# The same 500 bootstrap samples for each rule and each cost: the gains are paired.
set.seed(SEED)
boot_idx <- replicate(500, sample.int(nrow(m), replace = TRUE), simplify = FALSE)
boot_gain <- function(sel, cst) {
  # 90% bootstrap interval of the gain of a rule against "send to all", for each customer.
  g <- sapply(boot_idx, function(i) policy_profit(sel[i], m$spend[i], m$t[i], cst) - policy_profit(all_sel[i], m$spend[i], m$t[i], cst))
  quantile(g, c((1 - RULES$b5_policy_level) / 2, (1 + RULES$b5_policy_level) / 2))
}

dec07 <- do.call(rbind, lapply(COSTS, function(cst) {
  sel_c <- MARGIN * u_q > cst
  ib <- boot_gain(top_q, cst); ic <- boot_gain(sel_c, cst)
  data.frame(cost = cst, a = policy_profit(all_sel, m$spend, m$t, cst), b = policy_profit(top_q, m$spend, m$t, cst),
             c = policy_profit(sel_c, m$spend, m$t, cst), share_c = mean(sel_c),
             b_lo = ib[[1]], b_hi = ib[[2]], c_lo = ic[[1]], c_hi = ic[[2]])
}))
k100 <- function(x) usd(CAMPAIGN * x, 0)  # Profit for each customer -> profit for one campaign
iv <- function(lo, hi) ci_txt(CAMPAIGN * lo, CAMPAIGN * hi, function(x) usd(x, 0))

# Branch 5 at the base contact cost (as-02)
base <- dec07[dec07$cost == COST, ]
b5_policy <- c(top = base$b_lo > 0, rule = base$c_lo > 0)  # TRUE: the rule replaces "send to all"
b5_pass <- model_ok && !any(b5_policy)

# Existing N names of the dec-07 evidence (the decision text of Step 7a and the summary use them)
N$a_base <- k100(base$a)
N$b_base <- k100(base$b)
N$c_share_base <- pct(base$share_c, 0)
N$c_base_gain <- k100(base$c - base$a)
sig_b <- dec07$cost[dec07$b_lo > 0]
N$has_sig <- length(sig_b) > 0
N$cost_sig <- if (N$has_sig) usd(min(sig_b)) else "more than $0.30"
N$b_gain_030 <- k100(dec07$b[dec07$cost == 0.30] - dec07$a[dec07$cost == 0.30])
N$c_vs_b_030 <- if (dec07$c[dec07$cost == 0.30] < dec07$b[dec07$cost == 0.30]) "less" else "more"
N$cost_zero_all <- usd(MARGIN * ATE[["mens"]])

# New N names of branch 5
fmt_gain <- function(g) paste0(ifelse(g >= 0, "+", ""), pct(g, 0))
N$b5_area_a <- usd(area_mean[["A"]], 3)
best_ml <- ml_models[which.max(area_mean[ml_models])]  # The ML model with the largest mean Qini area
N$b5_best_ml <- c(C = "the T-learner", D = "the uplift tree")[[best_ml]]
N$b5_best_ml_gain <- fmt_gain(b5_model$gain[b5_model$model == best_ml])
N$b5_best_ml_pos <- b5_model$pos[b5_model$model == best_ml]
N$b5_seg_gain <- fmt_gain(b5_model$gain[b5_model$model == "B"])
N$b5_seg_pos <- b5_model$pos[b5_model$model == "B"]
N$b5_top_iv <- iv(base$b_lo, base$b_hi)
N$b5_rule_iv <- iv(base$c_lo, base$c_hi)
N$b5_model_txt <- if (model_ok) "No ML model passes the model rule, so rank by history stays." else
  "An ML model passes the model rule, so it must replace rank by history."
N$b5_policy_txt <- if (!any(b5_policy)) "No targeting rule passes the policy rule at the base cost, so \"send to all\" stays." else
  "A targeting rule passes the policy rule at the base cost, so it must replace \"send to all\"."
N$b5_verdict <- if (b5_pass) "The policy passes branch 5." else "The policy fails branch 5."

# Table 1: the model rule
kable(data.frame(
  Option = c("B. Segment table", "C. T-learner", "D. Uplift tree"),
  `ML model` = c("No", "Yes", "Yes"),
  `Mean Qini area` = usd(area_mean[c("B", "C", "D")], 3),
  `Change against rank by history` = fmt_gain(b5_model$gain),
  `Repeats with area > 0` = paste(b5_model$pos, "of", nrow(area)),
  `Replaces rank by history` = ifelse(b5_model$replaces, "Yes", "No"), check.names = FALSE),
  row.names = FALSE, align = "llrrrl",
  caption = paste0("Model rule. Rank by history has a mean Qini area of ", N$b5_area_a, "."))

Model rule. Rank by history has a mean Qini area of $0.083.

Option	ML model	Mean Qini area	Change against rank by history	Repeats with area > 0	Replaces rank by history
B. Segment table	No	$0.068	-18%	10 of 10	No
C. T-learner	Yes	-$0.029	-135%	3 of 10	No
D. Uplift tree	Yes	-$0.019	-123%	0 of 10	No

# Table 2: the policy rule, for each contact cost (Step 7a uses the full table)
kable(data.frame(`Contact cost` = usd(dec07$cost),
                 `A. Send to all` = k100(dec07$a),
                 `B. Top 25%` = k100(dec07$b),
                 `B minus A, 90% interval` = iv(dec07$b_lo, dec07$b_hi),
                 `C. Breakeven rule` = k100(dec07$c),
                 `C sends to` = pct(dec07$share_c, 0),
                 `C minus A, 90% interval` = iv(dec07$c_lo, dec07$c_hi), check.names = FALSE),
      row.names = FALSE, align = "rrrrrrr",
      caption = "Policy rule. Profit for 100,000 customers. Branch 5 uses the row of the base contact cost ($0.10).")

Policy rule. Profit for 100,000 customers. Branch 5 uses the row of the base contact cost ($0.10).

Contact cost	A. Send to all	B. Top 25%	B minus A, 90% interval	C. Breakeven rule	C sends to	C minus A, 90% interval
$0.05	$18,095	$9,174	[-$15,000, -$3,730]	$18,095	100%	[$0, $0]
$0.10	$13,095	$7,924	[-$11,245, $11]	$9,210	90%	[-$6,383, -$1,621]
$0.15	$8,095	$6,674	[-$7,490, $3,752]	$4,126	70%	[-$7,495, -$462]
$0.20	$3,095	$5,424	[-$3,734, $7,493]	$191	50%	[-$7,925, $1,242]
$0.25	-$1,905	$4,174	[$21, $11,234]	$739	35%	[-$3,138, $7,770]
$0.30	-$6,905	$2,924	[$3,776, $14,975]	-$90	20%	[$470, $12,503]

Model rule. Rank by history has a mean Qini area of $0.083. The best ML model is the uplift tree, with a change of -123% against the limit of +20%. Its area is more than 0 in 0 of 10 repeats. No ML model passes the model rule, so rank by history stays. The segment table is not an ML model. For information, its change is -18%, with an area more than 0 in 10 of 10 repeats.

Policy rule. At the base contact cost, “send to all” gives $13,095 for 100,000 customers. The top 25% gives $7,924, and the 90% interval of its gain is [-$11,245, $11]. The breakeven rule sends to 90% of the customers, and the interval of its gain is [-$6,383, -$1,621]. No targeting rule passes the policy rule at the base cost, so “send to all” stays.

The policy passes branch 5. The result depends on the contact cost. The gain of the top 25% is above 0 with 90% confidence from a contact cost of $0.25. Step 7a uses this result for the targeting rule.

6f. Summary of the evaluation

The table collects one result for each branch, with the rule of Step 3a.

# Purpose: Collect the result of the recommended policy (men's email to all) for each branch (6a–6e).
# Input:   Results of sections 6a–6e.
# Output:  Table `evaluation`, N$n_pass, N$fail_list.

evaluation <- data.frame(
  Branch = c("1. Validity", "2. Effect", "3. Robustness", "4. Business value", "5. Targeting"),
  Metric = c("Largest absolute standardized difference; sample-ratio p-value",
             "Welch 95% CI of the spend effect; customers in each group / customers for 80% power",
             "Bootstrap 95% CI; largest change of the CUPED and the regression effect",
             "Profit for 100,000 customers, with its 95% CI",
             "Best ML model against rank by history (Qini area); 90% interval of the gain of the top 25% at $0.10"),
  Result = c(paste0(N$e1_smd, "; ", N$e1_srm),
             paste0(N$e2_ci, "; ", N$e2_have, " / ", N$e2_need),
             paste0(N$e3_boot, "; ", N$e3_dev_max),
             paste0(N$e4_prof, " ", N$e4_ci),
             paste0(N$b5_best_ml_gain, ", ", N$b5_best_ml_pos, " of 10; ", N$b5_top_iv)),
  Rule = c("Less than 0.05; more than 0.01",
           "Excludes 0; at least the customers for 80% power",
           "Excludes 0; within 10%",
           "More than 0; lower end more than 0",
           "+20% or more and 9 of 10; interval above 0 (then targeting replaces send to all)"),
  Pass = ifelse(c(b1_pass, b2_pass, b3_pass, b4_pass, b5_pass), "Yes", "No"))
failed <- tolower(sub("^\\d\\. ", "", evaluation$Branch[evaluation$Pass == "No"]))
N$n_pass <- sum(evaluation$Pass == "Yes")
N$fail_list <- if (length(failed)) paste(failed, collapse = ", ") else "none"
kable(evaluation, row.names = FALSE, align = "lllll")

Branch	Metric	Result	Rule	Pass
1. Validity	Largest absolute standardized difference; sample-ratio p-value	0.014; 0.90	Less than 0.05; more than 0.01	Yes
2. Effect	Welch 95% CI of the spend effect; customers in each group / customers for 80% power	[$0.49, $1.05]; 21,306 / 5,988	Excludes 0; at least the customers for 80% power	Yes
3. Robustness	Bootstrap 95% CI; largest change of the CUPED and the regression effect	[$0.48, $1.06]; 0.3%	Excludes 0; within 10%	Yes
4. Business value	Profit for 100,000 customers, with its 95% CI	$13,095 [$4,554, $21,635]	More than 0; lower end more than 0	Yes
5. Targeting	Best ML model against rank by history (Qini area); 90% interval of the gain of the top 25% at $0.10	-123%, 0 of 10; [-$11,245, $11]	+20% or more and 9 of 10; interval above 0 (then targeting replaces send to all)	Yes

The recommended policy passes 5 of the 5 branches. The branches that fail are: none.

Two results need attention, also when a branch passes:

• Power (branch 2). The test has 3.6 times the customers for 80% power at the effect of the men’s email. A test of one segment has fewer customers, so it cannot find an effect of this size.
• Contact cost (branches 4 and 5). Both results use the base contact cost of $0.10 (as-02). The data does not give this cost. At $0.25 or more, the top 25% by history beats “send to all”.

Business note. The men’s email to all customers passes 5 of the 5 branches of the evaluation framework. It gives $13,095 for each campaign of 100,000 customers (95% CI [$4,554, $21,635]). At the base contact cost, no targeting rule and no ML model beats “send to all”. The full contact cost decides the targeting rule, and the data does not give it. Step 7 changes this result into a policy for each contact cost, a dollar value and a rollout plan.

Step 7. Implementation

Step 6 showed that the men’s email to all customers passes 5 of the 5 branches of the evaluation framework. At the base contact cost, no targeting rule beats “send to all”. But the contact cost is an assumption (as-02), and the data does not give it. A result on test data is not yet a policy.

This step answers four questions. Which rule selects the customers at each contact cost? How much money does the policy make? Does the choice hold for other margins and costs? How do we confirm the result after the launch?

Purpose. This step changes the evaluation into a targeting rule, a dollar value and a rollout plan. It supports this decision: launch the men’s email to all customers with a holdout, and the contact cost at which the list becomes shorter.

7a. From result to policy

A test gives the effect of the email. A policy says which customers get the email. The breakeven rule links the two. It sends the email to a customer only if the incremental margin is more than the contact cost. At a margin of 30% and a contact cost of $0.10, the breakeven effect is $0.33 of spend for each customer.

Technical note. The breakeven rule sends the email to a customer if m × û(q) > c. Here m is the margin (as-01) and c is the contact cost (as-02). The value û(q) is the cross-fitted uplift of the history quartile q of the customer (Step 5). A rule with a fixed list, for example the top 25% by history, does not use c. Its profit falls more slowly with c, because it sends fewer emails.

Which rule selects the customers for the email?

Why this question matters. The contact cost decides if an email to a customer with a small uplift pays for itself. If the list is too long, the emails to customers with a small uplift lose money. If the list is too short, the policy loses the profit of customers who buy because of the email.

Ways to do it. A rule can select the customers with four kinds of information. Each kind adds information to the kind before it:

Information that the rule uses	Rule	Advantage	Main risk
None	A. Send to all customers. (No email to any customer is the other rule with no information.)	Simple. No estimate to trust. It gets all of the positive mean effect.	It sends to customers where the email can lose money. “No email” loses the profit of branch 4, so we screen it out.
A fixed share by history	B. Top 25% by history	Simple. A quarter of the contact cost. It keeps the quartile with the largest uplift.	The list does not change with the contact cost.
The uplift of each quartile and the contact cost	C. Breakeven rule by history quartile	It sends only where the margin is more than the cost. The list changes with the cost.	It depends on four noisy estimates and on the contact cost.
The uplift of each customer from an ML model	T-learner or uplift tree	It can find customers that history does not show.	No ML model beats rank by history (branch 5, Step 4d). We screen it out.

Evidence. The policy-rule table of Step 6e gives the profit of rules A, B and C for 100,000 customers at six contact costs. It also gives the 90% interval of the gain of B and C against A. The chart below shows the profit of each rule for each contact cost from $0 to $0.35. It also gives the contact cost at which rule B starts to give more than rule A.

# Purpose: Show the profit of each targeting rule against the contact cost (dec-07, as-02).
# Input:   `policy_profit`, `all_sel`, `top_q`, `u_q`, `m`, `MARGIN`, `COST`, `CAMPAIGN`, `N`, `CS`.
# Output:  Line chart, N$cost_cross (contact cost where the top 25% starts to beat "send to all").

cost_grid <- seq(0, 0.35, 0.01)
prof <- sapply(cost_grid, function(cst) c(all = policy_profit(all_sel, m$spend, m$t, cst),
                                          top = policy_profit(top_q, m$spend, m$t, cst),
                                          rule = policy_profit(MARGIN * u_q > cst, m$spend, m$t, cst)))
prof_k <- CAMPAIGN * prof / 1000  # $ thousand for one campaign

# Profit of a fixed list is a straight line in the cost: p(c) = p(0) - share x c. Thus the two lines cross at
# c = (p_all(0) - p_top(0)) / (1 - share of the top 25%).
cost_cross <- (policy_profit(all_sel, m$spend, m$t, 0) - policy_profit(top_q, m$spend, m$t, 0)) / (1 - mean(top_q))
N$cost_cross <- usd(cost_cross)

cs_setup(mar = c(3.6, 4.6, 0.6, 9.5))
plot(cost_grid, prof_k["all", ], type = "n", ylim = range(0, prof_k), xlim = c(0, 0.35),
     xlab = "Full contact cost of one email ($)", ylab = "Profit for 100,000 customers ($ thousand)")
abline(h = 0, col = CS$light_gray)
# The base contact cost (as-02) as a reference line
abline(v = COST, col = CS$gray, lty = 2)
text(COST, par("usr")[4], paste0(" Base cost ", usd(COST), " (as-02)"), adj = c(0, 1), cex = 0.75, col = CS$muted)
lines(cost_grid, prof_k["rule", ], col = CS$gray, lwd = 1.8)
lines(cost_grid, prof_k["top", ], col = CS$cyan, lwd = 2.2)
lines(cost_grid, prof_k["all", ], col = CS$navy, lwd = 2.5)
# The one point: the cost where the top 25% starts to give more than "send to all"
y_cross <- CAMPAIGN * policy_profit(top_q, m$spend, m$t, cost_cross) / 1000
points(cost_cross, y_cross, pch = 19, col = CS$blue, cex = 1.3)
text(cost_cross, y_cross, paste0("  Lines cross at ", N$cost_cross), adj = c(0, -0.8), cex = 0.8, col = CS$blue, font = 2)
# Direct labels at the line ends. Move labels apart if the ends are near each other.
n_end <- length(cost_grid)
ends <- prof_k[, n_end]
dy <- c(all = 0, top = 0, rule = 0)
if (abs(ends["top"] - ends["rule"]) < 0.06 * diff(range(prof_k))) dy[c("top", "rule")] <- if (ends["top"] >= ends["rule"]) c(0.7, -0.7) else c(-0.7, 0.7)
cs_label_end(0.35, ends["all"], "A. Send to all", col = CS$navy, bold = TRUE, dy = dy["all"])
cs_label_end(0.35, ends["top"], "B. Top 25% by history", col = CS$cyan, dy = dy["top"])
cs_label_end(0.35, ends["rule"], "C. Breakeven rule", col = CS$gray, dy = dy["rule"])
cs_title(paste0("Send to all earns the most until the contact cost passes ", N$cost_cross),
         "Profit for one campaign of 100,000 customers, men's email, margin 30% (as-01)")

How to read: each line is one rule. The x-axis is the full cost of one email, and the dashed line marks the base cost of $0.10. The blue point is the cost where the top 25% starts to give more than “send to all”.

So what: at the base cost, “send to all” gives the most profit, $13,095 for 100,000 customers. Above $0.17, the top 25% by history gives more, but the gain is reliable only from $0.25.

Decision. At the base contact cost of $0.10, rule A: send the men’s email to all customers. If the full contact cost is $0.25 or more, use rule B: send only to the top 25% by history.

Why. At $0.10, rule A gives $13,095 for 100,000 customers, and rule B gives $7,924. Each quartile is still profitable at this cost, so a shorter list loses money. Rule C gives -$3,885 against rule A, because the noise of the quartile estimates excludes some profitable customers.

Between $0.17 and $0.25, rule B gives more on the point estimate, but the 90% interval of its gain contains 0. From $0.25, the interval is above 0, so the policy rule of branch 5 lets rule B replace rule A. At $0.30, rule B gives $9,830 more than rule A, and rule C gives less than rule B.

What would change the decision. The contact cost decides the choice. If Marketing confirms a full cost of $0.25 or more, use rule B. A cost of this size is possible if the unsubscribe rate is high, or if the offer has a discount. If the contact cost is more than $0.23, “send to all” loses money. If a new test has many more buyers, compare the ML models again (Step 4d).

7b. Dollar impact

The dollar impact uses the decision of 7a at the base cost: the men’s email to all customers. The formula is: incremental profit = 100,000 × (0.30 × change in mean spend − $0.10). The table compares this policy with the women’s email to all and with no email.

# Purpose: Give the dollar impact of each version for one campaign (as-01, as-02, as-04).
# Input:   `ATE`, `ATE_LO`, `ATE_HI`, `MARGIN`, `COST`, `CAMPAIGN`.
# Output:  Contract C6: `d_m`, `d_w` (profit for each customer). Table `imp`, N$imp_*.

d_w <- MARGIN * ATE[["womens"]] - COST
d_m <- MARGIN * ATE[["mens"]] - COST
ci_prof <- function(a) ci_txt(CAMPAIGN * (MARGIN * ATE_LO[[a]] - COST), CAMPAIGN * (MARGIN * ATE_HI[[a]] - COST), function(x) usd(x, 0))
imp <- data.frame(
  Policy = c("No email", "Women's email to all", "Men's email to all (recommended)"),
  `Emails sent` = num(CAMPAIGN * c(0, 1, 1)),
  `Incremental spend` = usd(CAMPAIGN * c(0, ATE[["womens"]], ATE[["mens"]]), 0),
  `Incremental margin` = usd(CAMPAIGN * MARGIN * c(0, ATE[["womens"]], ATE[["mens"]]), 0),
  `Contact cost` = usd(CAMPAIGN * COST * c(0, 1, 1), 0),
  `Incremental profit` = usd(CAMPAIGN * c(0, d_w, d_m), 0),
  `95% CI of the profit` = c("", ci_prof("womens"), ci_prof("mens")),
  check.names = FALSE)
kable(imp, row.names = FALSE, align = "lrrrrrr")

Policy	Emails sent	Incremental spend	Incremental margin	Contact cost	Incremental profit	95% CI of the profit
No email	0	$0	$0	$0	$0
Women’s email to all	100,000	$42,441	$12,732	$10,000	$2,732	[-$4,931, $10,396]
Men’s email to all (recommended)	100,000	$76,983	$23,095	$10,000	$13,095	[$4,554, $21,635]

N$imp_m <- usd(CAMPAIGN * d_m, 0)
N$imp_diff <- usd(CAMPAIGN * (d_m - d_w), 0)
N$imp_m_lo <- usd(CAMPAIGN * (MARGIN * ATE_LO[["mens"]] - COST), 0)
N$imp_m_hi <- usd(CAMPAIGN * (MARGIN * ATE_HI[["mens"]] - COST), 0)
N$imp_roi <- formatC(MARGIN * ATE[["mens"]] / COST, format = "f", digits = 1)

The men’s email to all gives $13,095 for each campaign of 100,000 customers. The 95% CI of the effect gives a range of $4,554 to $21,635. Each $1 of contact cost gives 2.3 dollars of incremental margin. The men’s email gives $10,362 more than the women’s email. At the base cost, the version is the lever. The targeting rule adds money only at a high contact cost.

7c. Sensitivity check

The margin (as-01) and the contact cost (as-02) are assumptions. The check changes both and gives the profit of the two simple rules. The “Indicated choice” column uses a simple rule: the top 25% must give 25% more profit than “send to all”. This margin protects the choice against the noise of the estimate.

# Purpose: Show how the margin (as-01) and the contact cost (as-02) change the choice of dec-07.
# Input:   `policy_profit`, `all_sel`, `top_q`, `m`, `k100`.
# Output:  Contract C6: `grid` (profit and indicated choice for each combination). N$n_all, N$n_grid, N$n_top.

grid <- expand.grid(cost = c(0.05, 0.10, 0.20, 0.30), margin = c(0.20, 0.30, 0.40))
grid$all <- mapply(function(mg, cst) policy_profit(all_sel, m$spend, m$t, cst, mg), grid$margin, grid$cost)
grid$top <- mapply(function(mg, cst) policy_profit(top_q, m$spend, m$t, cst, mg), grid$margin, grid$cost)
# The top 25% must give 25% more than "send to all", as a protection against noise.
grid$choice <- ifelse(pmax(grid$all, grid$top) <= 0, "No email",
                      ifelse(grid$top - grid$all > 0.25 * abs(grid$all), "Top 25% by history", "Send to all"))
kable(data.frame(Margin = pct(grid$margin, 0), `Contact cost` = usd(grid$cost),
                 `Profit, send to all` = k100(grid$all), `Profit, top 25%` = k100(grid$top),
                 `Indicated choice` = grid$choice, check.names = FALSE),
      row.names = FALSE, align = "rrrrl")

Margin	Contact cost	Profit, send to all	Profit, top 25%	Indicated choice
20%	$0.05	$10,397	$5,699	Send to all
20%	$0.10	$5,397	$4,450	Send to all
20%	$0.20	-$4,603	$1,950	Top 25% by history
20%	$0.30	-$14,603	-$550	No email
30%	$0.05	$18,095	$9,174	Send to all
30%	$0.10	$13,095	$7,924	Send to all
30%	$0.20	$3,095	$5,424	Top 25% by history
30%	$0.30	-$6,905	$2,924	Top 25% by history
40%	$0.05	$25,793	$12,649	Send to all
40%	$0.10	$20,793	$11,399	Send to all
40%	$0.20	$10,793	$8,899	Send to all
40%	$0.30	$793	$6,399	Top 25% by history

N$n_all <- sum(grid$choice == "Send to all"); N$n_grid <- nrow(grid)
N$all_low_cost <- all(grid$choice[grid$cost <= COST] == "Send to all")
N$n_top <- sum(grid$choice == "Top 25% by history")
N$n_none <- sum(grid$choice == "No email")
N$low_cost_txt <- if (N$all_low_cost) "It is the choice in each combination with a contact cost of $0.10 or less." else
  "It is not the choice in each combination with a contact cost of $0.10 or less."

Assumption check. The contact cost (as-02) has the largest effect on the choice. “Send to all” is the choice in 7 of 12 combinations. It is the choice in each combination with a contact cost of $0.10 or less. The top 25% is the choice in 4 combinations, all with a high cost or a low margin. “No email” is the choice in 1 combinations. Confirm the full contact cost with Marketing before the launch.

7d. Rollout

The test result covers two weeks (as-03). After the launch, the effect can become smaller, and customers can unsubscribe. A holdout is a random group of customers that gets no email after the launch. It shows the effect of the email over time, with the same causal logic as the test.

Which share of customers do we keep as a holdout after the launch?

Why this question matters. Each customer in the holdout gets no email, so the holdout costs profit. A holdout that is too small cannot show if the email still pays for itself. Then a fall of the effect stays hidden, and the campaign can lose money for months.

Ways to do it. The size of the holdout is one number. Thus the options are points on one scale: none, small, medium and large.

Option	Advantage	Disadvantage
A. No holdout	No lost profit.	We cannot see if the effect becomes smaller or if customers unsubscribe. We screen it out.
B. 5% holdout	Small lost profit.	Less power.
C. 10% holdout	Good power to show that the email still pays for itself.	More lost profit.
D. 20% holdout	Most power.	Twice the lost profit of option C.

Evidence. The holdout must show that the email still pays for itself. Thus the test asks: is the effect more than the breakeven effect of $0.33? The table gives the power of this test for one campaign of 100,000 customers, with a one-sided test at 5%. The lost profit is the profit that the holdout customers do not give.

Technical note. Let s be the standard deviation of spend in the test, n the customers of the campaign and h the share of the holdout. The standard error of the effect is se = s × √(1 / (n(1 − h)) + 1 / (nh)). The power to show an effect above the breakeven effect b, if the true effect is u, is Φ((u − b) / se − z₀.₉₅).

# Purpose: Compare the power and the lost profit of each holdout size (dec-08).
# Input:   `m`, `COST`, `MARGIN`, `CAMPAIGN`, `ALPHA`, `ATE`, `d_m`.
# Output:  Contract C6: `sd_spend`. N$pow_*, N$lost_*, N$hw_10, N$hold_pct.

sd_spend <- sqrt(mean(tapply(m$spend, m$t, var)))
be <- COST / MARGIN
hold <- c(0.05, 0.10, 0.20)
se_h <- sapply(hold, function(h) sd_spend * sqrt(1 / (CAMPAIGN * (1 - h)) + 1 / (CAMPAIGN * h)))
# One-sided test: is the effect more than the breakeven effect?
pow <- function(true_eff) pnorm((true_eff - be) / se_h - qnorm(1 - ALPHA))
kable(data.frame(Option = c("B. 5%", "C. 10%", "D. 20%"),
                 `Holdout customers` = num(CAMPAIGN * hold),
                 `Half-width of the 95% CI` = usd(qnorm(1 - ALPHA / 2) * se_h),
                 `Power if the effect stays at the test result` = pct(pow(ATE[["mens"]]), 0),
                 `Power if the effect falls by 20%` = pct(pow(0.8 * ATE[["mens"]]), 0),
                 `Lost profit for each campaign` = usd(CAMPAIGN * hold * d_m, 0), check.names = FALSE),
      row.names = FALSE, align = "lrrrrr")

Option	Holdout customers	Half-width of the 95% CI	Power if the effect stays at the test result	Power if the effect falls by 20%	Lost profit for each campaign
B. 5%	5,000	$0.43	64%	36%	$655
C. 10%	10,000	$0.31	87%	56%	$1,309
D. 20%	20,000	$0.23	98%	77%	$2,619

N$pow_10 <- pct(pow(ATE[["mens"]])[2], 0); N$pow_5 <- pct(pow(ATE[["mens"]])[1], 0); N$pow_20 <- pct(pow(ATE[["mens"]])[3], 0)
N$pow_10_fall <- pct(pow(0.8 * ATE[["mens"]])[2], 0)
N$lost_10 <- usd(CAMPAIGN * 0.10 * d_m, 0); N$lost_20 <- usd(CAMPAIGN * 0.20 * d_m, 0)
N$hw_10 <- usd(qnorm(1 - ALPHA / 2) * se_h[2])
N$hold_pct <- pct(hold[2], 0)  # The choice of dec-08 (option C)

Decision. Option C, a 10% holdout.

Why. If the effect stays at the test result, a 10% holdout shows that the email pays for itself with 87% power. A 5% holdout gives only 64%. A 20% holdout gives 98%, but it doubles the lost profit to $2,619. The lost profit of option C is $1,309 for each campaign. This is a small price to know if the email still makes money.

If the effect falls by 20%, the power of a 10% holdout is only 56% in one campaign. Thus the kill criteria below use two campaigns, not one.

What would change the decision. If a campaign has more than 200,000 customers, use 5%, because the holdout keeps the same number of customers. If the campaigns repeat each month, combine the holdouts of two or three campaigns.

Metrics and kill criteria

The holdout gives the primary metric for each campaign. The table gives the metrics, the limits and the action for each limit.

Metric	Type	Target or limit	Action
Incremental spend for each customer (email group minus holdout)	Primary	More than $0.33 (the breakeven effect at $0.10)	If it is less for two campaigns, stop “send to all”. Send only to the top 25% by history.
Conversion rate	Secondary	More than the holdout	If the spend effect falls but conversion stays, examine the order size.
Unsubscribe rate	Guardrail	Less than 0.5 points more than the holdout. Confirm with Marketing.	If it is more, update the contact cost (as-02). Then use the targeting rule of 7a again.
Complaints	Guardrail	No increase	Stop the campaign.

Business note. At the base contact cost, send the men’s email to all customers. It gives $13,095 for each campaign of 100,000 customers (range $4,554 to $21,635). If the full contact cost is $0.25 or more, send only to the top 25% by history. Keep a 10% holdout. It costs $1,309 for each campaign.

If the effect stays below $0.33 for two campaigns, stop “send to all”. Part 2 shows how other teams can use the same method.

Part 2: Use in other teams

Steps 0 to 7 used one randomized test to answer one marketing question. The method has four parts: a random split, a primary metric with sufficient power, the effect in dollars, and a holdout after the launch. Case 01 left two questions that historical data cannot answer, because each loan got only one price and one collection treatment. Part 2 shows how the same method answers them.

Purpose. This part shows how the method of this notebook applies to two open questions of case 01. It supports these decisions: the design of a pricing test, and the design of a collections test.

The two questions come from the revised case 01. The next chunk records its facts, so that the text and the power calculation use the same values.

# Purpose: Record the facts of the revised case 01 that Part 2 uses (Part 2: Pricing, Part 2: Recoveries).
# Input:   None. The values come from case 01 (2015 loans of Lending Club, prices of 2015).
# Output:  `rate_up` (points of interest rate for zero NPV, by grade), `pricing` (grades A–C), `rec01`, N$p2_*.

# Increase of the interest rate (points) that makes the NPV of the 2015 loans equal to zero, by grade
rate_up <- c(A = 0.3, B = 0.1, C = 1.0, D = 2.7, E = 6.0, F = 12.9, G = 19.7)
# Grades A–C: the pricing test of case 01 (an increase of 1 point or less)
pricing <- data.frame(grade = c("A", "B", "C"), bad = c(0.054, 0.119, 0.195), loans_2015 = c(70107, 91672, 77363))
pricing$rate_up <- rate_up[pricing$grade]
# Recoveries (Part 2: Recoveries of case 01)
rec01 <- list(rate = 0.110, top20_balance = 0.455, top20_gbm = 0.462)

N$p2_up_ac <- paste(paste0(names(rate_up)[1:3], " +", formatC(rate_up[1:3], format = "f", digits = 1)), collapse = ", ")
N$p2_up_max_ac <- formatC(max(rate_up[1:3]), format = "f", digits = 1)
N$p2_up_dg <- paste0(formatC(min(rate_up[4:7]), format = "f", digits = 1), " to ", formatC(max(rate_up[4:7]), format = "f", digits = 1))
N$p2_rec <- pct(rec01$rate)
N$p2_top_bal <- pct(rec01$top20_balance)
N$p2_top_gbm <- pct(rec01$top20_gbm)
N$p2_two_pts_a <- pct(0.02 / pricing$bad[1], 0)

Pricing test for grades A to C (case 01, Part 2: Pricing)

The question. Case 01 shows that the 2015 loans lost money in every grade at 2015 prices. The increase of the interest rate for an NPV of zero is small in grades A to C: A +0.3, B +0.1, C +1.0 points. In grades D to G, it is 2.7 to 19.7 points. The market may not accept such an increase, so a cutoff is the better tool for D to G. Thus case 01 recommends a pricing test for grades A to C only.

Why a test. A price increase can change two things that the NPV calculation keeps fixed: the default rate and the volume. The historical data cannot measure this effect, because the price depends on the risk. A borrower with a higher price is also a riskier borrower. A random test gives each applicant the old price or the new price by chance, so the difference comes from the price.

The primary metric. The default rate decides if the higher price pays for itself, so it is the primary metric. The take-up rate of the offer is the second metric, because a higher price can reduce the volume.

The detectable change. The test must find a change of the default rate that matters for the NPV. The price changes by 1.0 points or less, so the change of the default rate is probably small. A fixed change of 2 points is 37% of the grade A rate. A test for 2 points can miss a real effect in grade A. Thus we use a relative change: 10% of the 2015 default rate of each grade. Confirm the detectable change with Risk.

Technical note. The code uses power.prop.test with the default rate of the grade as p₁ and 1.1 × p₁ as p₂, at 5% significance (two-sided) and 80% power. The test has two groups of equal size: the old price and the new price. The months of volume are 2 × (loans in each group) / (loans in 2015 / 12). This value assumes that all new loans of the grade go into the test.

# Purpose: Size the pricing test of case 01 for grades A–C (method of Step 3c).
# Input:   `pricing`, `ALPHA`, `POWER`.
# Output:  Table `pricing` with the loans in each group and the months of volume, N$p2_*.

REL_CHANGE <- 0.10  # Detectable change: 10% of the default rate of the grade (relative)
loans_needed <- function(p, rel) ceiling(power.prop.test(p1 = p, p2 = p * (1 + rel), sig.level = ALPHA, power = POWER)$n)
pricing$delta <- pricing$bad * REL_CHANGE
pricing$n <- sapply(pricing$bad, loans_needed, rel = REL_CHANGE)
pricing$months <- 2 * pricing$n / (pricing$loans_2015 / 12)
# For comparison: a larger change of 20% needs about a quarter of the loans.
pricing$n20 <- sapply(pricing$bad, loans_needed, rel = 0.20)
pricing$months20 <- 2 * pricing$n20 / (pricing$loans_2015 / 12)

kable(data.frame(Grade = pricing$grade,
                 `Rate increase for zero NPV (points)` = formatC(pricing$rate_up, format = "f", digits = 1),
                 `Default rate 2015` = pct(pricing$bad),
                 `Detectable change (points)` = formatC(100 * pricing$delta, format = "f", digits = 2),
                 `Loans in each group` = num(pricing$n),
                 `Loans in 2015` = num(pricing$loans_2015),
                 `Months of volume for two groups` = formatC(pricing$months, format = "f", digits = 1),
                 `Months for a 20% change` = formatC(pricing$months20, format = "f", digits = 1), check.names = FALSE),
      row.names = FALSE, align = "lrrrrrrr")

Grade	Rate increase for zero NPV (points)	Default rate 2015	Detectable change (points)	Loans in each group	Loans in 2015	Months of volume for two groups	Months for a 20% change
A	0.3	5.4%	0.54	28,792	70,107	9.9	2.6
B	0.1	11.9%	1.19	12,120	91,672	3.2	0.8
C	1.0	19.5%	1.95	6,721	77,363	2.1	0.5

mo <- setNames(pricing$months, pricing$grade)
N$p2_months_a <- formatC(mo[["A"]], format = "f", digits = 1)
N$p2_months_b <- formatC(mo[["B"]], format = "f", digits = 1)
N$p2_months_c <- formatC(mo[["C"]], format = "f", digits = 1)
N$p2_months_a20 <- formatC(pricing$months20[pricing$grade == "A"], format = "f", digits = 1)
N$p2_n_a <- num(pricing$n[pricing$grade == "A"])
N$p2_delta_a <- formatC(100 * pricing$delta[pricing$grade == "A"], format = "f", digits = 2)

Grades B and C have sufficient volume for a test in 3.2 and 2.1 months. Grade A has the lowest default rate, so a 10% change is only 0.54 points. The test needs 28,792 loans in each group, or 9.9 months of volume. If Risk accepts a change of 20% for grade A, the test needs 2.6 months.

Two limits apply to the design:

• The lifetime default rate comes late. We know it only after 36 months. Thus the test must use an early metric, for example the default rate at 12 months on book. This rate is lower than the lifetime rate, so the test needs more loans than the table shows.
• One price change for each grade. A test of one increase in each grade gives one point on the price curve. To find the best price, a later test can use two or three increases.

Collections test (case 01, Part 2: Recoveries)

The question. Case 01 shows that the net recovery is about 11.0% of the principal in each segment. The top 20% of charged-off loans by balance holds 45.5% of the net recovery dollars, and a GBM holds 46.2%. Thus a model does not find better accounts than a rank by balance. The real lever is the choice between a sale of the debt and in-house collection. The data cannot measure this choice, because each loan got only one treatment.

The test design. The same method as this notebook applies. Each step of this notebook has a match in the collections test:

1. Random split. Put the charged-off loans at random into two groups: sale of the debt, and in-house collection. Use a sample-ratio check and the standardized differences of Step 6a.
2. Primary metric. The net dollars for each $1 of principal at the charge-off, after 12 months. For a sale, it is the sale price. For in-house collection, it is the net recovery minus the cost of the collection.
3. Effect and power. Use the Welch CI of Step 6b. The net recovery has a long right tail, like spend, so check the result with the bootstrap of Step 6c.
4. Targeting. Rank by balance is the baseline, as rank by history is the baseline in this notebook. If a model beats this baseline with the model rule of Step 6e, use the uplift method of Step 4d.
5. Holdout. After the decision, keep a random share of the loans with the other treatment, as in Step 7d.

Case 02 uses the same champion/challenger logic for the fraud policy: a random 10% of the transactions goes to the new policy.

Business note. The method of this notebook answers the two open questions of case 01. A pricing test for grades A to C needs about 2.1 months of grade C volume and 9.9 months of grade A volume. A collections test compares a sale of the debt with in-house collection, on loans with a random treatment. The conclusion collects the results of all steps.

Conclusion

The notebook started with two questions from leadership: do we send the email to all customers, and which version do we send? Steps 0 to 7 answered them with one randomized test. Part 2 then showed how other teams can use the same method.

The answer

Send the men’s email to all customers. It increases the mean spend by $0.77 for each customer (95% CI [$0.49, $1.05]). For each campaign of 100,000 customers, it gives $13,095 of incremental profit, with a range of $4,554 to $21,635. It gives $10,362 more than the women’s email.

The policy passes 5 of the 5 branches of the evaluation framework. The branches that fail are: none. At the base contact cost of $0.10, no targeting rule and no ML uplift model beats “send to all”. A shorter list pays only if the full contact cost is $0.25 or more.

Recommendation

1. Send the men’s email to all customers. At the base contact cost, it gives the most profit of all rules (Step 7a).
2. Confirm the full contact cost before the launch. If Marketing confirms a cost of $0.25 or more, send only to the top 25% by history (Step 7a). If the cost is more than $0.23, “send to all” loses money.
3. Keep a 10% holdout. It shows with 87% power that the email still pays for itself, and it costs $1,309 for each campaign (Step 7d).
4. Stop “send to all” if the effect falls. If the incremental spend stays below $0.33 for two campaigns, send only to the top 25% by history (Step 7d).
5. Use the same method for the open questions of case 01. A pricing test for grades A to C, and a test of a debt sale against in-house collection (Part 2).

What a reviewer should challenge

These limits can change the result most. Each one has a control.

Limitation	Effect on the result	Control, or what to do next
The contact cost of $0.10 is an assumption (as-02). The data does not give unsubscribes.	The contact cost decides if a targeting rule beats “send to all”.	The profit chart of Step 7a and the sensitivity check of Step 7c. Measure the unsubscribe rate as a guardrail and update the cost.
The margin of 30% is an assumption (as-01).	The profit changes with the margin. At a low margin and a high cost, the top 25% is the better rule.	The sensitivity check of Step 7c uses 20% and 40%. Finance confirms the margin.
The effect window is two weeks (as-03).	The long-term effect is not known. It can be larger or smaller.	Keep the 10% holdout for three months (Step 7d).
Less than 1% of customers convert.	Each segment effect has a wide interval. The ML uplift models fit noise.	Rank by history. Repeat the comparison with each new test, with the model rule of Step 3a.
The gain of the top 25% at the base cost is near the limit of the policy rule.	A small change of the data or of the cost can change the targeting rule.	The decision uses the 90% interval, not the point estimate. Confirm the cost before a high-cost campaign.
I examined the segment effects before I selected the uplift method, on the same data.	The gain of a targeting rule can be too high.	The cross-fitted uplift reduces this risk. A new test confirms the rule before a high-cost campaign.
The data is from one retailer in 2008 (as-05).	The size of each effect is different for a card offer.	The method stays the same. Repeat the analysis on the bank data.

Other limits have a small effect. The data source cut the spend at its largest value, so a few large orders can be larger in reality. The test has only one email version for each group, so it cannot show the best combination of versions.

Next steps

1. Business case deck (6–8 slides): the men’s email to all customers, the breakeven contact cost and the 10% holdout.
2. Confirm the contact cost (as-02) and the margin (as-01) with Marketing and Finance.
3. Design the pricing test for grades A to C with case 01 (Part 2: Pricing). Add it to the pricing one-pager.
4. Design the collections test (debt sale or in-house collection) with case 01 (Part 2: Recoveries). Add it to the collections one-pager.

Appendix A: data dictionary

The table gives each column of the Hillstrom file, then each feature that this notebook codes from them. The meaning of a raw column comes from the description of the MineThatData challenge (Hillstrom, 2008). The other parts of the table come from this notebook:

• Role. The time of the value against the email (Step 2b): a pre-test feature, the test group or an outcome. A coded feature has the role of its source.
• Type. The type of the value in R: a flag (0 or 1), a whole number, a number, a text or a category.
• Values. The code calculates this column from the data. A flag gives the share of 1. A number gives the range and the mean. A category gives each level with its number of customers.
• Use. The steps of this notebook that use the column.

The coded features t and hq exist only in the analysis set m (men’s email and control group, Section 4c). Their values come from m.

# Purpose: Build Appendix A: one row for each raw column and each coded feature, with values from the data.
# Input:   `d`, `m` (with `t` and `hq`), `COL_ROLE` (Step 2b).
# Output:  Table `dictionary`. N$n_dict_rows.

# Meaning of each column. Raw columns: the challenge description. Coded columns: the rule of the code.
MEANING <- c(
  recency = "Months since the last purchase of the customer, before the test.",
  history_segment = "History bucket: the dollars of the last 12 months in seven groups, with a number prefix.",
  history = "History: the dollars that the customer spent in the 12 months before the test.",
  mens = "1 if the customer bought men's products in the last 12 months.",
  womens = "1 if the customer bought women's products in the last 12 months.",
  zip_code = "Area type of the customer address. The data source writes \"Surburban\" for suburban.",
  newbie = "1 if the customer is a new customer in the last 12 months.",
  channel = "Channel of the purchases in the last 12 months. The load chunk changes the text into a factor.",
  segment = "Test group of the data source: no email, men's email or women's email.",
  visit = "1 if the customer visited the website in the two weeks after the email.",
  conversion = "1 if the customer bought something in the two weeks after the email.",
  spend = "Dollars that the customer spent in the two weeks after the email. The data source caps the value (Step 2c).",
  arm = "Test group as a factor, from segment: control, mens, womens.",
  buyer = "Product history, from mens and womens: men's only, women's only, or both.",
  hseg = "History bucket without the number prefix, from history_segment, in the order of the dollars.",
  zip = "Area type as a factor, from zip_code.",
  lhist = "Natural log of the history, from history.",
  t = "Treatment flag in m: 1 = men's email, 0 = control group.",
  hq = "History quartile in m: four groups with the same number of customers, from history."
)
USE <- c(
  recency = "Balance check (2d), regression adjustment (4a), uplift models (4d)",
  history_segment = "Source of hseg",
  history = "Balance check (2d), CUPED (4a), segment test (4c), order by history (4d, Step 5, Step 7)",
  mens = "Source of buyer. Balance check (2d), uplift models (4d)",
  womens = "Source of buyer. Balance check (2d), uplift models (4d)",
  zip_code = "Source of zip",
  newbie = "Balance check (2d), segment effects (4c), uplift models (4d)",
  channel = "Balance check (2d), segment effects (4c), uplift models (4d)",
  segment = "Source of arm",
  visit = "Secondary metric (3c), baseline (2e)",
  conversion = "Secondary metric (3c), baseline (2e), T-learner (4d)",
  spend = "Primary metric (3c). All effects and the profit (Steps 4-7)",
  arm = "The groups of each comparison",
  buyer = "Email version (4b), segment effects (4c), segment table (4d)",
  hseg = "Segment effects (4c), segment table (4d)",
  zip = "Balance check (2d), segment effects (4c), uplift models (4d)",
  lhist = "Regression adjustment (4a), T-learner (4d)",
  t = "Uplift models (4d), predictions (Step 5), policy profit (Step 7)",
  hq = "Uplift by history quartile (Step 5), targeting rule (Step 7)"
)
RAW <- names(COL_ROLE)
CODED <- c(arm = "segment", buyer = "mens, womens", hseg = "history_segment", zip = "zip_code",
           lhist = "history", t = "segment", hq = "history")

col_type <- function(x) {
  # Returns the type of a column in plain words.
  if (is.factor(x)) "Category"
  else if (is.character(x)) "Text"
  else if (all(x %in% c(0, 1))) "Flag (0 or 1)"
  else if (is.integer(x) || all(x == round(x))) "Whole number"
  else "Number"
}
col_values <- function(x) {
  # Returns the values of a column, calculated from the data.
  if (is.factor(x) || is.character(x)) {
    tb <- table(x)
    paste0(names(tb), ": ", num(as.vector(tb)), collapse = "; ")
  } else if (all(x %in% c(0, 1))) {
    paste0("Share of 1: ", pct(mean(x)))
  } else {
    dg <- if (all(x == round(x))) 0 else 2  # No decimals for whole numbers
    paste0("From ", num(min(x), dg), " to ", num(max(x), dg), "; mean ", num(mean(x), 2))
  }
}

rows <- c(RAW, names(CODED))
dictionary <- data.frame(
  Column = ifelse(rows %in% RAW, rows, paste0(rows, " (coded from ", CODED[rows], ")")),
  Meaning = MEANING[rows],
  Role = ifelse(rows %in% RAW, COL_ROLE[rows],
                ifelse(rows %in% c("arm", "t"), "Test group", "Pre-test feature")),
  Type = sapply(rows, function(r) col_type(if (r %in% c("t", "hq")) m[[r]] else d[[r]])),
  Values = sapply(rows, function(r) col_values(if (r %in% c("t", "hq")) m[[r]] else d[[r]])),
  Use = USE[rows], check.names = FALSE)
# Check: each row has a meaning and a use.
stopifnot(!anyNA(dictionary$Meaning), !anyNA(dictionary$Use))
N$n_dict_rows <- nrow(dictionary)
kable(dictionary, row.names = FALSE)

Column	Meaning	Role	Type	Values	Use
recency	Months since the last purchase of the customer, before the test.	Pre-test feature	Whole number	From 1 to 12; mean 5.76	Balance check (2d), regression adjustment (4a), uplift models (4d)
history_segment	History bucket: the dollars of the last 12 months in seven groups, with a number prefix.	Pre-test feature	Text	1) $0 - $100: 22,970; 2) $100 - $200: 14,254; 3) $200 - $350: 12,289; 4) $350 - $500: 6,409; 5) $500 - $750: 4,911; 6) $750 - $1,000: 1,859; 7) $1,000 +: 1,308	Source of hseg
history	History: the dollars that the customer spent in the 12 months before the test.	Pre-test feature	Number	From 29.99 to 3,345.93; mean 242.09	Balance check (2d), CUPED (4a), segment test (4c), order by history (4d, Step 5, Step 7)
mens	1 if the customer bought men’s products in the last 12 months.	Pre-test feature	Flag (0 or 1)	Share of 1: 55.1%	Source of buyer. Balance check (2d), uplift models (4d)
womens	1 if the customer bought women’s products in the last 12 months.	Pre-test feature	Flag (0 or 1)	Share of 1: 55.0%	Source of buyer. Balance check (2d), uplift models (4d)
zip_code	Area type of the customer address. The data source writes “Surburban” for suburban.	Pre-test feature	Text	Rural: 9,563; Surburban: 28,776; Urban: 25,661	Source of zip
newbie	1 if the customer is a new customer in the last 12 months.	Pre-test feature	Flag (0 or 1)	Share of 1: 50.2%	Balance check (2d), segment effects (4c), uplift models (4d)
channel	Channel of the purchases in the last 12 months. The load chunk changes the text into a factor.	Pre-test feature	Category	Multichannel: 7,762; Phone: 28,021; Web: 28,217	Balance check (2d), segment effects (4c), uplift models (4d)
segment	Test group of the data source: no email, men’s email or women’s email.	Test group	Text	Mens E-Mail: 21,307; No E-Mail: 21,306; Womens E-Mail: 21,387	Source of arm
visit	1 if the customer visited the website in the two weeks after the email.	Outcome	Flag (0 or 1)	Share of 1: 14.7%	Secondary metric (3c), baseline (2e)
conversion	1 if the customer bought something in the two weeks after the email.	Outcome	Flag (0 or 1)	Share of 1: 0.9%	Secondary metric (3c), baseline (2e), T-learner (4d)
spend	Dollars that the customer spent in the two weeks after the email. The data source caps the value (Step 2c).	Outcome	Number	From 0.00 to 499.00; mean 1.05	Primary metric (3c). All effects and the profit (Steps 4-7)
arm (coded from segment)	Test group as a factor, from segment: control, mens, womens.	Test group	Category	control: 21,306; mens: 21,307; womens: 21,387	The groups of each comparison
buyer (coded from mens, womens)	Product history, from mens and womens: men’s only, women’s only, or both.	Pre-test feature	Category	mens only: 28,818; womens only: 28,734; both: 6,448	Email version (4b), segment effects (4c), segment table (4d)
hseg (coded from history_segment)	History bucket without the number prefix, from history_segment, in the order of the dollars.	Pre-test feature	Category	$0 - $100: 22,970; $100 - $200: 14,254; $200 - $350: 12,289; $350 - $500: 6,409; $500 - $750: 4,911; $750 - $1,000: 1,859; $1,000 +: 1,308	Segment effects (4c), segment table (4d)
zip (coded from zip_code)	Area type as a factor, from zip_code.	Pre-test feature	Category	Rural: 9,563; Surburban: 28,776; Urban: 25,661	Balance check (2d), segment effects (4c), uplift models (4d)
lhist (coded from history)	Natural log of the history, from history.	Pre-test feature	Number	From 3.40 to 8.12; mean 5.00	Regression adjustment (4a), T-learner (4d)
t (coded from segment)	Treatment flag in m: 1 = men’s email, 0 = control group.	Test group	Flag (0 or 1)	Share of 1: 50.0%	Uplift models (4d), predictions (Step 5), policy profit (Step 7)
hq (coded from history)	History quartile in m: four groups with the same number of customers, from history.	Pre-test feature	Category	Q1 (lowest): 10,654; Q2: 10,653; Q3: 10,653; Q4 (highest): 10,653	Uplift by history quartile (Step 5), targeting rule (Step 7)

Reader guides: decisions, assumptions and glossary

This appendix holds the reference material of the notebook. Click a title to open it.

NoteHow to read this notebook

• Read the text to follow the logic. Click Show code to see the code for a step.
• The notebook follows the steps of a model project, from Step 0 to Step 7. Part 2 applies the same method to two questions of case 01.
• Each step starts with a gray block. This block says what the step before showed, and the question of this step.
• A blue block records a decision. It starts with a question. Then it gives the possible methods, the evidence, the decision and the reason.
• A gray-blue block (Technical note) gives the method in detail for a data scientist. A business reader can skip it.
• A green block is a business note. It gives the result of a step for a manager.
• Appendix A gives the meaning of each column in the data.
• The business case deck gives the recommendation for leadership: decks/03-test-and-learn.pdf.

Each team can read only the part that it needs.

Part	Question	Team
Step 0	What is the business problem?	All
Steps 1–3	Did the randomization work? Is the test large enough to find the effect that matters?	Marketing, all test owners
Step 4	Does the email increase spend? Which version do we send? Does the effect change by segment?	Marketing
Steps 5–6	Which customers have the largest uplift? Is the policy good enough for the launch?	Marketing, model risk
Step 7	Which customers get the email? What is the dollar value? How do we confirm the result after the launch?	Marketing, Finance, CX and operations
Part 2	How does the method apply to a pricing test and a collections test?	Product and pricing, collections

NoteDecision log

The decision blocks in the text show only the question. This log gives each decision an ID for a model risk review. Click the question to go to the decision.

ID	Question	Decision	Step
dec-01	Which metric decides the test?	Spend. Visit and conversion are secondary metrics.	3c
dec-02	Which method measures the change in mean spend?	Welch t-test. The bootstrap is a check.	4a
dec-03	Can the pre-test data make the interval smaller?	No adjustment. History does not predict the spend in the test window.	4a
dec-04	Which email version do we send?	The men’s email to all customers.	4b
dec-05	How do we report the effect in each segment?	Interaction test first. Then the effect of each segment with the Holm correction. The evidence for different effects is weak.	4c
dec-06	Which method puts the customers in order of uplift?	Rank by history. The rule before the evidence: an ML model replaces it only if its Qini area is 20% or more higher.	4d
dec-07	Which rule selects the customers for the email?	Send to all at the base contact cost. Send only to the top 25% by history if the contact cost is high.	7a
dec-08	Which share of customers do we keep as a holdout after the launch?	10%	7d

NoteAssumption register

ID	Assumption	Value	Source	Effect if the value is wrong
as-01	Contribution margin on incremental spend	30%	Assumption: gross margin of an apparel retailer, minus the cost of delivery and returns. Confirm with Finance.	Large. The profit of each email goes up or down with the margin. The sensitivity check of Step 7c uses 20% and 40%.
as-02	Full cost of one email	$0.10	Assumption: the cost to send, plus the cost of creative work, plus the future value that we lose when a customer unsubscribes. The data does not give unsubscribes. Confirm with Marketing.	Large. This value decides if targeting is better than “send to all”. Step 7a gives the contact cost at which the targeting rule changes.
as-03	Effect window	Two weeks after the email	The test design of the dataset	The long-term effect is not known. It can be larger (more future purchases) or smaller (fatigue).
as-04	Size of one campaign	100,000 customers	Assumption, for the dollar values	No effect on the decision. The dollar values scale with the number of customers.
as-05	Proxy	An email from a retailer to its customers is a proxy for a card offer to card customers	The public data has no bank test	The size of each effect is different for a bank. The method stays the same.

NoteGlossary

The words in this table are technical names. The notebook uses each name only with the meaning below.

Technical name	Meaning in this notebook
A/B test	A test that puts customers into groups at random. Each group gets a different treatment.
Randomized test	A test where the data source, not the customer, selects the group of each customer at random. Thus a difference of means gives the causal effect. Same meaning as “A/B test”.
Treatment	The action that the test examines. In this case, the men’s email or the women’s email.
Control group	The customers that get no email.
Holdout	The customers that get no email after the launch. They show the effect of the email over time.
Proxy	Data from a similar decision that takes the place of the real data. Here, the email of a retailer takes the place of a card offer (as-05).
Visit	The customer visited the website in the two weeks after the email.
Conversion	The customer bought something in the two weeks after the email.
Spend	The dollars that the customer spent in the two weeks after the email.
Spend cap	The largest spend value in the data. The data source cut the larger values to this value.
History	The dollars that the customer spent in the 12 months before the test.
Standardized difference	The difference of the means of a pre-test feature in two groups, divided by the standard deviation of the feature. It shows if the groups are the same before the test.
Sample-ratio check	A chi-square test of the group sizes against the planned split. A small p-value shows a problem in the assignment.
Average treatment effect (ATE)	The mean outcome of a treatment group minus the mean outcome of the control group.
Significance level	The probability of a false result “effect found” when the effect is zero. This notebook uses 5%.
Power	The probability that the test finds an effect of a given size. This notebook uses 80%.
MDE	Minimum detectable effect. The smallest effect that the test can find with the selected power and significance level.
Confidence interval (CI)	A range that contains the true effect in 95% of tests.
Welch t-test	A t-test that does not need equal variances in the two groups.
Bootstrap	A method that samples the data again many times, with replacement, to estimate the uncertainty of a result.
CUPED	Controlled experiment with pre-experiment data. A method that removes the part of the outcome that the pre-test data predicts.
Regression adjustment	A linear regression of the outcome on the treatment and the customer features.
Uplift	The change of an outcome that a treatment causes for a customer.
Segment effect	The ATE in one group of customers, for example the customers with more than $500 of history.
Interaction test	An F-test that compares a model with one effect for all customers against a model with one effect for each segment.
Holm correction	A correction of the p-values when we test many segments. It keeps the probability of one or more false results at 5%.
Cross-fit	A method that estimates the uplift of each customer with a model that did not see that customer. “Cross-fitted” has the same meaning.
Two-part model	A model of spend in two parts: the probability of a purchase, and the spend of a buyer.
Tobit model	A regression model for an outcome with many values at zero.
CUPAC	A version of CUPED that uses the prediction of an ML model as the pre-test covariate.
S-learner	An uplift model with one model for all customers. The treatment is one of its features.
X-learner	An uplift model in two stages. It uses the T-learner and then corrects the uplift in each group.
Causal forest	A random forest that estimates the uplift of each customer directly.
T-learner	An uplift model with two models: one for the treatment group and one for the control group. The uplift is the difference of the two predictions.
Transformed outcome	An outcome that has the same mean as the uplift. A normal regression model on it gives an uplift model.
ML uplift model	An uplift model that learns from many features: here the T-learner and the uplift tree.
Qini curve	The incremental spend from the top x% of customers, in the order of the predicted uplift.
Qini area	The mean distance between the Qini curve of a model and the line of a random order. Higher is better.
Rank by history	A targeting rule with no model: it sends the email first to the customers with the largest history.
Send to all	The policy that sends the email to each customer in the campaign.
Targeting rule	A rule that sends the email only to some customers, for example the top 25% by history.
Incremental margin	The contribution margin multiplied by the incremental spend.
Contact cost	The full cost of one email. See as-02.
Breakeven effect	The uplift on spend at which the incremental margin equals the contact cost: contact cost / margin.
Breakeven rule	A rule that sends the email to a customer if the incremental margin is more than the contact cost.
Decision layer	The step that changes the effect into a policy and a dollar value, with the margin and the contact cost.
ROI	Incremental margin divided by the total contact cost.
Evaluation framework	The five branches (validity, effect, robustness, business value, targeting) with the rules that the result must pass (Step 3a).
Model rule	The rule of branch 5 for the uplift method. An ML uplift model replaces rank by history only if its Qini area is 20% or more higher.
Policy rule	The rule of branch 5 for the list of customers. A targeting rule replaces “send to all” only if the 90% interval of its gain is above 0.
Guardrail metric	A metric that must not become worse, for example the unsubscribe rate.
Kill criteria	The results that stop a rollout.
Champion/challenger test	A test that sends a random share of the cases to a new policy and the rest to the current policy.
Business note	A short result of a step for a manager.
Technical note	Detail of a method for a data scientist. A business reader can skip it.

Appendix B: reproducibility

The notebook uses only base R, knitr and rpart. rpart comes with each R installation. The setup chunk sets the seed, so each run gives the same bootstrap samples and the same folds.

# Purpose: Print the versions of R and of the packages, and the seed, for reproducibility.
# Input:   `SEED` (setup chunk).
# Output:  Text.

cat("Seed:", SEED, "\n\n")

Seed: 42 

sessionInfo()

R version 4.3.3 (2024-02-29)
Platform: x86_64-pc-linux-gnu (64-bit)
Running under: Ubuntu 24.04.5 LTS

Matrix products: default
BLAS:   /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.12.0 
LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.12.0

locale:
 [1] LC_CTYPE=C.UTF-8    LC_NUMERIC=C        LC_TIME=C          
 [4] LC_COLLATE=C        LC_MONETARY=C       LC_MESSAGES=C      
 [7] LC_PAPER=C          LC_NAME=C           LC_ADDRESS=C       
[10] LC_TELEPHONE=C      LC_MEASUREMENT=C    LC_IDENTIFICATION=C

time zone: America/Detroit
tzcode source: system (glibc)

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] rpart_4.1.23 knitr_1.45  

loaded via a namespace (and not attached):
 [1] htmlwidgets_1.6.4 compiler_4.3.3    fastmap_1.1.1     cli_3.6.2        
 [5] tools_4.3.3       htmltools_0.5.7   yaml_2.3.8        rmarkdown_2.25   
 [9] jsonlite_1.8.8    xfun_0.41         digest_0.6.34     rlang_1.1.3      
[13] evaluate_0.23    

Appendix C: functions used in the analysis

Steps 3 to 7 use the functions in the file case03_helpers.R. They give the checks of the test design, the effect with its CI, the power and the bootstrap. They also give CUPED, the profit of a policy, the uplift models and the Qini curve. The charts use the functions in chart_style.R. A reviewer can read the full source of both files below, without a separate file.

# Purpose: Show the source of the two helper files in the notebook (Appendix C).
# Input:   Files case03_helpers.R and chart_style.R (next to this notebook).
# Output:  The source of each file as an R code block, or a note if the file does not exist.

fence <- strrep("`", 3)  # A literal fence here would end the chunk in the .qmd file
for (f in c("case03_helpers.R", "chart_style.R")) {
  cat("\n**File `", f, "`**\n\n", sep = "")
  if (file.exists(f)) {
    cat(fence, "r\n", paste(readLines(f, warn = FALSE), collapse = "\n"), "\n", fence, "\n", sep = "")
  } else {
    cat("*The file `", f, "` does not exist. The functions are in the chunks of the steps.*\n", sep = "")
  }
}

File case03_helpers.R

# Helper functions for case 03, Steps 3 to 7 (base R and rpart only).
#
# Purpose: One place for the tools of the evaluation framework (Step 3a): the checks of the test design,
#          the effect with its confidence interval, the power, the bootstrap, CUPED, the profit of a
#          policy, the uplift models with cross-fitting and the Qini curve.
# Input:   The notebook sources this file after the setup chunk. If an argument is not given, a function
#          uses the constants of the setup chunk (SEED, ALPHA, POWER, MARGIN, COST) and, for the uplift,
#          the data `m` (men's email + control, Step 4c) and `GRID` (Step 4d). R finds these names when
#          the function runs, so the notebook can define them after this file.
# Output:  Functions only. The file makes no data and prints nothing.
#
# The format helpers usd(), pct(), num(), ci_txt() and fmt_p() stay in the setup chunk for now.

# --- Branch 1 of the evaluation framework: validity ---

std_diff <- function(x, arm, a, ref = "control") {
  # Purpose: standardized difference of one pre-test feature between group `a` and the reference group.
  # Input:   x (numeric vector), arm (group of each customer), a and ref (group names).
  # Output:  (mean in a − mean in ref) / standard deviation of x in all customers.
  (mean(x[arm == a]) - mean(x[arm == ref])) / sd(x)
}

srm_p <- function(arm, p = NULL) {
  # Purpose: sample-ratio check. Do the group sizes agree with the planned split?
  # Input:   arm (group of each customer), p (planned share of each group; NULL = equal shares).
  # Output:  the p-value of the chi-square test of the counts against the planned shares.
  tab <- table(arm)
  if (is.null(p)) p <- rep(1 / length(tab), length(tab))
  chisq.test(tab, p = p)$p.value
}

# --- Branch 2: effect and power ---

welch <- function(y1, y0, level = 1 - ALPHA) {
  # Purpose: difference of means with the Welch t-test.
  # Input:   y1 (outcome of the treatment group), y0 (outcome of the control group).
  # Output:  named vector: eff (mean y1 − mean y0), lo and hi (confidence interval), p (p-value),
  #          se (standard error of the difference).
  tt <- t.test(y1, y0, conf.level = level)
  c(eff = unname(-diff(tt$estimate)), lo = tt$conf.int[1], hi = tt$conf.int[2], p = tt$p.value,
    se = unname(tt$stderr))
}

n_needed <- function(delta, sd, alpha = ALPHA, power = POWER) {
  # Purpose: customers in each group that a two-sample t-test needs to find an effect `delta`.
  # Output:  number of customers in each group (not rounded).
  power.t.test(delta = delta, sd = sd, sig.level = alpha, power = power)$n
}

mde_metric <- function(y, arm, n, alpha = ALPHA, power = POWER) {
  # Purpose: power and MDE of one metric for a test with `n` customers in each group (dec-01).
  # Input:   y (outcome of each customer), arm (factor: control, mens, womens), n (customers in each group).
  # Output:  named vector: base (control mean), sd (pooled standard deviation), mde, mens and womens
  #          (observed effects), need_m and need_w (customers in each group for 80% power at each
  #          observed effect).
  s <- sqrt(mean(tapply(y, arm, var)))  # Pooled standard deviation of the three groups
  mde <- power.t.test(n = n, sd = s, sig.level = alpha, power = power)$delta
  base <- mean(y[arm == "control"])
  eff <- sapply(c("mens", "womens"), function(a) mean(y[arm == a]) - base)
  c(base = base, sd = s, mde = mde, mens = eff[["mens"]], womens = eff[["womens"]],
    need_m = n_needed(eff[["mens"]], s, alpha, power), need_w = n_needed(eff[["womens"]], s, alpha, power))
}

# --- Branch 3: robustness ---

boot_diff <- function(y1, y0, B = 2000, seed = SEED) {
  # Purpose: bootstrap of the difference of means. Each sample draws each group again, with replacement.
  # Output:  vector of B bootstrap differences (mean y1 − mean y0).
  set.seed(seed)
  replicate(B, mean(y1[sample.int(length(y1), replace = TRUE)]) - mean(y0[sample.int(length(y0), replace = TRUE)]))
}

cuped <- function(y, x) {
  # Purpose: CUPED. Remove the part of the outcome y that the pre-test value x predicts.
  # Output:  adjusted outcome with the same mean as y.
  theta <- cov(y, x) / var(x)
  y - theta * (x - mean(x))
}

# --- Branch 4: business value ---

breakeven <- function(cost = COST, margin = MARGIN) {
  # Purpose: breakeven effect: the uplift on spend at which the incremental margin equals the contact cost.
  cost / margin
}

policy_profit <- function(sel, y, t, cost, margin = MARGIN) {
  # Purpose: profit for each customer in the campaign of a policy that emails only the selection.
  # Input:   sel (TRUE = gets the email), y (spend), t (1 = men's email, 0 = control), cost (contact cost).
  # Output:  share selected × (margin × uplift in the selection − cost). Customers outside the
  #          selection get no email, so they add no profit and no cost.
  share <- mean(sel)
  if (share == 0) return(0)
  eff <- mean(y[sel & t == 1]) - mean(y[sel & t == 0])
  share * (margin * eff - cost)
}

# --- Branch 5: targeting ---

uplift_oof <- function(seed, K = 5, dat = m,
                       f_conv = conversion ~ recency + lhist + mens + womens + zip + newbie + channel) {
  # Purpose: cross-fitted uplift on spend of each customer, for the four methods of dec-06.
  #          Each customer gets the uplift from a model that did not see that customer.
  # Input:   seed (sets the folds), K (number of folds), dat (men's email + control, with t = 1 for the email).
  # Output:  matrix with one row for each customer and one column for each method:
  #          A (history, no model), B (segment table), C (T-learner), D (uplift tree).
  set.seed(seed)
  p_t <- mean(dat$t)
  fold <- sample(rep(seq_len(K), length.out = nrow(dat)))
  pred <- matrix(NA_real_, nrow(dat), 4, dimnames = list(NULL, c("A", "B", "C", "D")))
  pred[, "A"] <- dat$history
  for (k in seq_len(K)) {
    tr <- dat[fold != k, ]; te <- fold == k
    # B. Segment table: mean spend of the email group minus mean spend of the control group in each cell
    cell_tr <- interaction(tr$hseg, tr$buyer); cell_te <- interaction(dat$hseg[te], dat$buyer[te])
    u <- tapply(tr$spend[tr$t == 1], cell_tr[tr$t == 1], mean) - tapply(tr$spend[tr$t == 0], cell_tr[tr$t == 0], mean)
    pred[te, "B"] <- u[as.character(cell_te)]
    # C. T-learner: conversion model in each group × mean spend of a buyer in each group
    g1 <- glm(f_conv, binomial, tr[tr$t == 1, ]); g0 <- glm(f_conv, binomial, tr[tr$t == 0, ])
    a1 <- mean(tr$spend[tr$t == 1 & tr$conversion == 1]); a0 <- mean(tr$spend[tr$t == 0 & tr$conversion == 1])
    pred[te, "C"] <- a1 * predict(g1, dat[te, ], type = "response") - a0 * predict(g0, dat[te, ], type = "response")
    # D. Tree on the transformed outcome: its mean in a leaf is the uplift of the leaf
    tr$z <- tr$spend * (tr$t - p_t) / (p_t * (1 - p_t))
    tree <- rpart(z ~ recency + history + mens + womens + zip + newbie + channel, tr,
                  control = rpart.control(cp = 0, minbucket = 3000, maxdepth = 3))
    pred[te, "D"] <- predict(tree, dat[te, ])
  }
  pred[is.na(pred)] <- 0  # A cell without customers in the training folds
  pred
}

qini <- function(score, y, t, grid = GRID) {
  # Purpose: Qini curve. Rank the customers by score (highest first) and take the top share g.
  # Output:  for each share g in grid: (mean y of the email group − mean y of the control group in the
  #          top g) × g. This is the incremental spend for each customer of the campaign.
  o <- order(-score, runif(length(score)))  # Random order for ties
  y <- y[o]; t <- t[o]; n <- length(y)
  sapply(grid, function(g) {
    i <- seq_len(ceiling(g * n))
    (sum(y[i][t[i] == 1]) / sum(t[i]) - sum(y[i][t[i] == 0]) / sum(1 - t[i])) * length(i) / n
  })
}

qini_area <- function(cv, grid = GRID) {
  # Purpose: Qini area of each column of a matrix of Qini curves.
  # Output:  mean distance between each curve and the line of a random order (from 0 to the last point).
  colMeans(cv - outer(grid, cv[length(grid), ]))
}

group_effect <- function(dat, g) {
  # Purpose: uplift on spend in each level of the grouping g, with the Welch 95% CI.
  # Input:   dat (with spend and t), g (factor with one value for each row of dat).
  # Output:  data frame: level, customers, eff, lo, hi.
  do.call(rbind, lapply(levels(g), function(l) {
    s <- dat[g == l, ]
    w <- welch(s$spend[s$t == 1], s$spend[s$t == 0])
    data.frame(level = l, n = nrow(s), eff = w[["eff"]], lo = w[["lo"]], hi = w[["hi"]])
  }))
}

xfit_group <- function(dat, g, seed, K = 5) {
  # Purpose: cross-fitted uplift on spend of each customer when the uplift depends only on a group g
  #          (for example the history quartile). Each customer gets the uplift of the group from the
  #          other K − 1 folds, so the estimate never uses that customer.
  # Input:   dat (with spend and t), g (factor with one value for each row of dat), seed (sets the folds).
  # Output:  vector with the cross-fitted uplift of each customer, and the attribute "fold".
  set.seed(seed)
  fold <- sample(rep(seq_len(K), length.out = nrow(dat)))
  u <- numeric(nrow(dat))
  for (k in seq_len(K)) {
    tr <- dat[fold != k, ]; gt <- g[fold != k]; te <- fold == k
    uu <- tapply(tr$spend[tr$t == 1], gt[tr$t == 1], mean) - tapply(tr$spend[tr$t == 0], gt[tr$t == 0], mean)
    u[te] <- uu[as.character(g[te])]
  }
  attr(u, "fold") <- fold
  u
}

File chart_style.R

# One chart style for the R notebook. It follows the deck style guide (project doc claude/deck-style-guide.md)
# and matches chart_style.py of cases 01 and 02.
#
# Rules:
# - One message per chart. The figure title is an action title: a full sentence with a number.
# - CS$navy for the main series, CS$blue for the one point, CS$gray for context, CS$cyan for a second series
#   only, CS$negative (red) only for losses.
# - No box, no gridlines, no legend box when a direct label at the line end works.
#
# Use a straight apostrophe (') in titles: the PNG device cannot draw the curly one in the serif font.
#
# Use (base R graphics only):
#   cs_setup()                                   # once per chart, before plot()
#   plot(x, y, type = "l", col = CS$navy, lwd = 2.5, ...)
#   cs_label_end(x_last, y_last, "Men's email", col = CS$navy, bold = TRUE)
#   cs_title("The men's email adds $0.77 of spend for each customer", "Mean spend, two weeks after the email")

CS <- list(
  navy = "#051C2C", blue = "#2251FF", cyan = "#0091D5", gray = "#8C8C8C",
  light_gray = "#D0D0D0", negative = "#C8102E", ink = "#1A1A1A", muted = "#6B6B6B"
)

cs_setup <- function(mar = c(3.6, 4.6, 0.6, 7), title_lines = 2) {
  # Purpose: set the margins and the colors of the axes. The outer top margin holds the action title.
  # mar[4] (right) leaves room for direct labels at the line ends.
  par(mar = mar, oma = c(0, 0, 1.2 * title_lines + 0.6, 0), bty = "l", las = 1,
      col.axis = CS$muted, col.lab = CS$ink, fg = CS$gray, family = "sans",
      cex.axis = 0.85, cex.lab = 0.9, mgp = c(2.2, 0.6, 0), tcl = -0.3)
  invisible(NULL)
}

cs_title <- function(title, subtitle = NULL) {
  # Purpose: write the action title (serif, bold) and an optional muted subtitle above the plot, left aligned.
  has_sub <- !is.null(subtitle)
  mtext(title, side = 3, outer = TRUE, line = if (has_sub) 1.3 else 0.3, adj = 0,
        font = 2, family = "serif", cex = 1.15, col = CS$ink)
  if (has_sub) mtext(subtitle, side = 3, outer = TRUE, line = 0.1, adj = 0, cex = 0.82, col = CS$muted)
  invisible(NULL)
}

cs_label_end <- function(x, y, label, col = CS$navy, bold = FALSE, dy = 0, cex = 0.8) {
  # Purpose: a direct label at the end of a line (use it instead of a legend). dy moves the label up (+) or down (-)
  # in lines of text, so labels of lines that end near each other do not overlap.
  usr <- par("usr")
  ystep <- dy * strheight("M", cex = cex) * 1.4
  text(x, y + ystep, paste0(" ", label), adj = c(0, 0.5), xpd = NA, col = col, font = if (bold) 2 else 1, cex = cex)
  invisible(usr)
}

cs_percent_axis <- function(side = 2, at = NULL, digits = 0) {
  # Purpose: an axis with percent labels for values on the 0–1 scale.
  if (is.null(at)) at <- axTicks(side)
  axis(side, at = at, labels = paste0(formatC(100 * at, format = "f", digits = digits), "%"))
}

cs_dollar_axis <- function(side = 2, at = NULL, digits = 2) {
  # Purpose: an axis with dollar labels.
  if (is.null(at)) at <- axTicks(side)
  axis(side, at = at, labels = ifelse(at < 0, paste0("-$", formatC(-at, format = "f", digits = digits)),
                                      paste0("$", formatC(at, format = "f", digits = digits))))
}