Where do you set the churn-risk threshold? The ROC worked example

The business question

A B2B software company scores every account for churn risk each quarter. The model works. The open question is the one nobody’s dashboard answers: where do you draw the line?

Above the line, a customer success manager reaches out with a retention offer. Below it, nothing happens. Move the line down and you spend discounts on accounts that were never going to leave. Move it up and you lose accounts you could have saved.

The instinct is to pick the cutoff that classifies the most accounts correctly. That instinct is expensive, and this worked example measures exactly how expensive, because the two mistakes do not cost the same money:

a missed churn loses the account’s remaining annual value;
a false alarm spends a retention discount on an account that was staying anyway.

Accuracy treats those as interchangeable. Finance does not.

The data

One row per account, as a churn-scoring pipeline would emit it.

column	meaning
`account_id`	the account
`segment`	SMB / Mid-Market / Enterprise
`seats`	licensed seats
`mrr_usd`	monthly recurring revenue, US dollars
`churn_risk_score`	model output, 0–100, higher = more likely to churn
`churned_next_quarter`	1 = the account actually churned, 0 = it stayed

set.seed(20260824)

n <- 1200
segment <- sample(c("SMB", "Mid-Market", "Enterprise"), n, replace = TRUE,
                  prob = c(0.58, 0.30, 0.12))
seats <- ifelse(segment == "SMB",        sample(3:25,    n, replace = TRUE),
         ifelse(segment == "Mid-Market", sample(25:120,  n, replace = TRUE),
                                         sample(120:600, n, replace = TRUE)))
mrr_usd <- round(seats * runif(n, 28, 46), 2)

# latent risk -> actual churn; the score is a noisy read of the same latent risk
z          <- rnorm(n)
p_churn    <- plogis(-2.60 + 1.40 * z)
churned    <- rbinom(n, 1, p_churn)
score_raw  <- z + rnorm(n, 0, 0.35)
churn_risk_score <- round(100 * pnorm(score_raw))

accounts <- data.frame(
  account_id           = sprintf("ACC-%04d", seq_len(n)),
  segment              = segment,
  seats                = seats,
  mrr_usd              = mrr_usd,
  churn_risk_score     = churn_risk_score,
  churned_next_quarter = churned,
  stringsAsFactors     = FALSE
)
write.csv(accounts, "data.csv", row.names = FALSE)

data.frame(accounts = n, churned = sum(churned),
           churn_rate_pct = round(100 * mean(churned), 2))

##   accounts churned churn_rate_pct
## 1     1200     161          13.42

kable(head(accounts, 8), caption = "First eight rows as the scoring pipeline emits them")

First eight rows as the scoring pipeline emits them
account_id	segment	seats	mrr_usd	churn_risk_score	churned_next_quarter
ACC-0001	SMB	3	87.70	25	0
ACC-0002	Mid-Market	53	2045.00	91	0
ACC-0003	SMB	25	1094.24	69	0
ACC-0004	SMB	7	241.46	47	0
ACC-0005	Enterprise	572	23434.12	17	0
ACC-0006	SMB	4	165.49	46	0
ACC-0007	SMB	11	362.40	93	1
ACC-0008	Mid-Market	74	2635.77	44	0

Does the score work at all?

r <- roc(accounts$churned_next_quarter, accounts$churn_risk_score,
         quiet = TRUE, direction = "<")
auc_val <- as.numeric(auc(r))
auc_ci  <- as.numeric(ci.auc(r, method = "delong"))
c(AUC = round(auc_val, 4), ci_lo = round(auc_ci[1], 4), ci_hi = round(auc_ci[3], 4))

##    AUC  ci_lo  ci_hi 
## 0.8078 0.7730 0.8427

The AUC has a plain-English reading worth keeping: take one account that churned and one that did not, at random. The AUC is how often the churned one carries the higher risk score.

The cost model

Costs are per account and driven by its own revenue, so a mistake on an Enterprise account counts for more than the same mistake on a small one.

Missed churn (FN) — the account leaves unattended: 12 × MRR lost.
Retention offer — two months of MRR, spent on anyone we flag.
Caught churner (TP) — we spend the offer, and it works only some of the time. At a save rate s, the expected cost is 2 × MRR + (1 − s) × 12 × MRR.
False alarm (FP) — offer spent on an account that was staying: 2 × MRR.
Correctly left alone (TN) — nothing.

The save rate is an assumption, not a measurement, so it is named and tested below.

SAVE_RATE <- 0.60

total_cost <- function(threshold, save_rate = SAVE_RATE, d = accounts) {
  flag <- d$churn_risk_score >= threshold
  y    <- d$churned_next_quarter == 1
  m    <- d$mrr_usd
  sum(m[flag &  y]) * 2 + sum(m[flag &  y]) * (1 - save_rate) * 12 +   # TP
  sum(m[flag & !y]) * 2 +                                             # FP
  sum(m[!flag &  y]) * 12                                             # FN
}

confusion <- function(threshold, d = accounts) {
  flag <- d$churn_risk_score >= threshold
  y    <- d$churned_next_quarter == 1
  c(TP = sum(flag & y), FP = sum(flag & !y),
    FN = sum(!flag & y), TN = sum(!flag & !y))
}

Sweep every candidate cutoff

grid <- 0:100
sweep <- do.call(rbind, lapply(grid, function(th) {
  cm  <- confusion(th)
  sens <- cm["TP"] / (cm["TP"] + cm["FN"])
  spec <- cm["TN"] / (cm["TN"] + cm["FP"])
  data.frame(threshold = th, TP = cm["TP"], FP = cm["FP"], FN = cm["FN"], TN = cm["TN"],
             sensitivity = sens, specificity = spec,
             accuracy = (cm["TP"] + cm["TN"]) / nrow(accounts),
             youden = sens + spec - 1,
             cost = total_cost(th))
}))
rownames(sweep) <- NULL

th_acc    <- sweep$threshold[which.max(sweep$accuracy)]
th_youden <- sweep$threshold[which.max(sweep$youden)]
th_cost   <- sweep$threshold[which.min(sweep$cost)]
c(accuracy_max_at = th_acc, youden_max_at = th_youden, cost_min_at = th_cost)

## accuracy_max_at   youden_max_at     cost_min_at 
##              98              61              90

cands <- sweep[sweep$threshold %in% sort(unique(c(th_acc, th_youden, th_cost))), ]
cands$label <- ifelse(cands$threshold == th_acc,    "accuracy-max",
               ifelse(cands$threshold == th_youden, "Youden J (what the tool reports)",
                                                    "cost-min"))
kable(data.frame(
  cutoff      = cands$threshold,
  label       = cands$label,
  flagged     = cands$TP + cands$FP,
  TP = cands$TP, FP = cands$FP, FN = cands$FN, TN = cands$TN,
  sensitivity = round(cands$sensitivity, 4),
  specificity = round(cands$specificity, 4),
  accuracy    = round(cands$accuracy, 4),
  cost_usd    = round(cands$cost, 0)
), row.names = FALSE, caption = "Three defensible cutoffs, and what each one costs")

Three defensible cutoffs, and what each one costs
cutoff	label	flagged	TP	FP	FN	TN	sensitivity	specificity	accuracy	cost_usd
61	Youden J (what the tool reports)	451	128	323	33	716	0.7950	0.6891	0.7033	5354965
90	cost-min	139	66	73	95	966	0.4099	0.9297	0.8600	4781400
98	accuracy-max	29	21	8	140	1031	0.1304	0.9923	0.8767	5204217

cost_at_acc  <- sweep$cost[sweep$threshold == th_acc]
cost_at_best <- sweep$cost[sweep$threshold == th_cost]
c(cost_accuracy_max = round(cost_at_acc, 0),
  cost_cost_min     = round(cost_at_best, 0),
  penalty_usd       = round(cost_at_acc - cost_at_best, 0),
  penalty_pct       = round(100 * (cost_at_acc - cost_at_best) / cost_at_best, 2))

## cost_accuracy_max     cost_cost_min       penalty_usd       penalty_pct 
##        5204217.00        4781400.00         422816.00              8.84

Is the answer robust to the save-rate assumption?

sens_tab <- do.call(rbind, lapply(c(0.40, 0.60, 0.80), function(s) {
  costs <- sapply(grid, total_cost, save_rate = s)
  data.frame(save_rate = s, cost_min_threshold = grid[which.min(costs)],
             cost_at_min = round(min(costs), 0),
             cost_at_accuracy_max = round(costs[grid == th_acc], 0),
             cost_at_youden = round(costs[grid == th_youden], 0),
             accuracy_penalty_pct = round(100 * (costs[grid == th_acc] - min(costs)) / min(costs), 2))
}))
kable(sens_tab, row.names = FALSE,
      caption = "The accuracy-max cutoff is never the cost-optimal one, at any save rate tested")

The accuracy-max cutoff is never the cost-optimal one, at any save rate tested
save_rate	cost_min_threshold	cost_at_min	cost_at_accuracy_max	cost_at_youden	accuracy_penalty_pct
0.4	94	5219451	5350800	6190254	2.52
0.6	90	4781400	5204217	5354965	8.84
0.8	80	4207276	5057633	4519675	20.21

The charts a practitioner reads

plot(r, legacy.axes = TRUE, col = "#F97316", lwd = 2.6,
     xlab = "false positive rate (1 - specificity)", ylab = "true positive rate (sensitivity)",
     main = sprintf("ROC — churn risk score (AUC %.3f)", auc_val))
pts <- sweep[sweep$threshold %in% c(th_acc, th_youden, th_cost), ]
points(1 - pts$specificity, pts$sensitivity, pch = 19, cex = 1.5,
       col = c("#5fa9dd", "#3fbf6f", "#d94141")[order(pts$threshold)])
text(1 - pts$specificity, pts$sensitivity,
     labels = sprintf(" %d", pts$threshold), adj = c(0, 1.6), cex = 0.9)
legend("bottomright", bty = "n", pch = 19,
       col = c("#d94141", "#3fbf6f", "#5fa9dd"),
       legend = c(sprintf("cost-min (%d)", th_cost),
                  sprintf("Youden J (%d)", th_youden),
                  sprintf("accuracy-max (%d)", th_acc)))

plot(sweep$threshold, sweep$cost / 1000, type = "l", lwd = 2.6, col = "#F97316",
     xlab = "cutoff (flag accounts scoring at or above)", ylab = "expected quarterly cost (US$ thousands)",
     main = "Cost by cutoff: the accurate cutoff sits on the expensive side of the curve")
abline(v = th_cost, col = "#d94141", lwd = 2, lty = 2)
abline(v = th_acc,  col = "#5fa9dd", lwd = 2, lty = 2)
text(th_cost, max(sweep$cost) / 1000, sprintf("cost-min %d", th_cost), pos = 4, col = "#d94141")
text(th_acc,  max(sweep$cost) / 1000 * 0.92, sprintf("accuracy-max %d", th_acc), pos = 4, col = "#5fa9dd")

What the lesson teaches

AUC answers “does the score rank?”, not “where is the line?” A good AUC is a licence to choose a threshold, not a threshold.
Accuracy silently assumes the two mistakes cost the same. They differ by 6× here, and the accuracy-max cutoff lands on the expensive side of the cost curve at every save rate tested.
Both cost-blind rules lose money, and they miss in opposite directions. Accuracy maximises by flagging almost nobody (churners are the minority, so “do nothing” scores well), and misses churns worth more than the offers it saved. Youden’s J — the optimum the tool reports — over-corrects the other way, flagging hundreds of accounts that were never going to leave. Youden is the right default when you have no cost model, and the wrong one the moment you do.
Write the cost model down. Two numbers (what a miss costs, what an offer costs) move the cutoff further than any modelling improvement.
Name the assumption and test it. The save rate is a guess; the sweep shows the conclusion survives across the plausible range.
The tool needs one row per account: the true outcome, and a numeric score where higher means more likely to churn.