Data Mining
BANL 6625-01 · Fall 2026
Joyston Fernandes · ID 00846746
October 19, 2026
library(tidyverse)
library(caret)
library(pROC)
library(pwr)
# Helpers for formatting numbers inside the text.
# Dollar signs are escaped so Pandoc does not read them as LaTeX math.
usd <- function(x, digits = 0) paste0("\\$", formatC(x, format = "f", digits = digits, big.mark = ","))
pct <- function(x, digits = 1) paste0(formatC(100 * x, format = "f", digits = digits), "%")
num <- function(x) format(x, big.mark = ",")
pfmt <- function(p) ifelse(p < 0.001, "< 0.001", paste("=", signif(p, 3)))
theme_set(theme_minimal(base_size = 12))Part 1 — Which Churn Model Should Lakeside Use?
Task 1 · Data and baseline
Rows: 1,000
Columns: 4
$ customer_id <chr> "C0001", "C0002", "C0003", "C0004", "C0005", "C0006", "C00…
$ churned <dbl> 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 1, 1, 1, 0, 1, 0, 0…
$ prob_A <dbl> 0.028, 0.164, 0.012, 0.315, 0.255, 0.017, 0.133, 0.070, 0.…
$ prob_B <dbl> 0.035, 0.012, 0.021, 0.359, 0.221, 0.024, 0.055, 0.056, 0.…(a) Churn rate and number of churners
n_customers <- nrow(churn)
n_churners <- sum(churn$churned == 1)
churn_rate <- mean(churn$churned == 1)
knitr::kable(tibble(Customers = num(n_customers),
Churners = num(n_churners),
`Churn rate` = pct(churn_rate)),
align = "c")| Customers | Churners | Churn rate |
|---|---|---|
| 1,000 | 120 | 12.0% |
(b) Accuracy of a “nobody churns” model
Predicting 0 for every customer is correct for every customer who stayed.
[1] 0.88churn %>%
pivot_longer(c(prob_A, prob_B), names_to = "model", values_to = "prob") %>%
mutate(model = recode(model, prob_A = "Model A", prob_B = "Model B")) %>%
ggplot(aes(x = prob, fill = factor(churned))) +
geom_density(alpha = 0.5, colour = NA) +
facet_wrap(~ model) +
scale_fill_manual(values = c("0" = "steelblue", "1" = "firebrick"),
labels = c("0" = "Stayed", "1" = "Churned")) +
labs(title = "Predicted churn probability by actual outcome",
x = "Predicted probability of churn", y = "Density",
fill = "Actual outcome") +
theme(legend.position = "top", plot.title = element_text(face = "bold"))
The churn rate is 12.0% (120 of 1,000 customers), so a model that predicts nobody churns is already 88.0% accurate. In the plot, Model A separates the two groups more clearly: its churner curve sits further to the right of the stayer curve, while Model B’s two curves overlap much more and both sit close to zero.
Task 2 · Confusion matrices at the 0.5 cutoff
actual <- factor(churn$churned, levels = c(0, 1))
pred_A <- factor(ifelse(churn$prob_A >= 0.5, 1, 0), levels = c(0, 1))
cm_A <- confusionMatrix(pred_A, actual, positive = "1")
cm_AConfusion Matrix and Statistics
Reference
Prediction 0 1
0 851 96
1 29 24
Accuracy : 0.875
95% CI : (0.8529, 0.8949)
No Information Rate : 0.88
P-Value [Acc > NIR] : 0.7068
Kappa : 0.2201
Mcnemar's Test P-Value : 3.565e-09
Sensitivity : 0.2000
Specificity : 0.9670
Pos Pred Value : 0.4528
Neg Pred Value : 0.8986
Prevalence : 0.1200
Detection Rate : 0.0240
Detection Prevalence : 0.0530
Balanced Accuracy : 0.5835
'Positive' Class : 1
pred_B <- factor(ifelse(churn$prob_B >= 0.5, 1, 0), levels = c(0, 1))
cm_B <- confusionMatrix(pred_B, actual, positive = "1")
cm_BConfusion Matrix and Statistics
Reference
Prediction 0 1
0 875 114
1 5 6
Accuracy : 0.881
95% CI : (0.8593, 0.9004)
No Information Rate : 0.88
P-Value [Acc > NIR] : 0.4855
Kappa : 0.0729
Mcnemar's Test P-Value : <2e-16
Sensitivity : 0.0500
Specificity : 0.9943
Pos Pred Value : 0.5455
Neg Pred Value : 0.8847
Prevalence : 0.1200
Detection Rate : 0.0060
Detection Prevalence : 0.0110
Balanced Accuracy : 0.5222
'Positive' Class : 1
cm_row <- function(cm, name) {
t <- cm$table # rows = Prediction, cols = Reference
tibble(Model = name,
TP = t["1", "1"],
FP = t["1", "0"],
FN = t["0", "1"],
TN = t["0", "0"],
Accuracy = unname(round(cm$overall["Accuracy"], 3)),
Precision = unname(round(cm$byClass["Precision"], 3)),
Recall = unname(round(cm$byClass["Recall"], 3)),
Specificity = unname(round(cm$byClass["Specificity"], 3)))
}
cm_table <- bind_rows(cm_row(cm_A, "Model A"), cm_row(cm_B, "Model B"))
knitr::kable(cm_table, align = "lcccccccc",
caption = "Confusion-matrix summary at the 0.5 cutoff")| Model | TP | FP | FN | TN | Accuracy | Precision | Recall | Specificity |
|---|---|---|---|---|---|---|---|---|
| Model A | 24 | 29 | 96 | 851 | 0.875 | 0.453 | 0.20 | 0.967 |
| Model B | 6 | 5 | 114 | 875 | 0.881 | 0.545 | 0.05 | 0.994 |
(a) Model B has the slightly higher accuracy (0.881 vs. 0.875), but Model A catches far more churners: 24 true positives (recall 0.2) versus only 6 for Model B (recall 0.05).
(b) Both accuracies (0.875 and 0.881) are barely above the 0.88 accuracy of predicting that nobody churns. Because only 12% of customers churn, accuracy is dominated by the large “stayed” class, so a model can score high accuracy while missing almost every churner. Accuracy is therefore a misleading way to compare these models — Model B “wins” on accuracy mostly by flagging almost no one, which is close to useless for retention.
(c)
- False positive: Lakeside sends a $20 credit to a customer who was not going to cancel anyway, wasting the credit.
- False negative: Lakeside fails to contact a customer who then cancels, losing that subscriber’s future profit (about $150).
Task 3 · ROC curves and AUC
roc_A <- roc(churn$churned, churn$prob_A, levels = c(0, 1), direction = "<")
roc_B <- roc(churn$churned, churn$prob_B, levels = c(0, 1), direction = "<")
auc_A <- as.numeric(auc(roc_A))
auc_B <- as.numeric(auc(roc_B))
c(AUC_A = round(auc_A, 3), AUC_B = round(auc_B, 3))AUC_A AUC_B
0.788 0.726 plot(roc_A, legacy.axes = TRUE, col = "firebrick", lwd = 2,
main = "ROC curves: Model A vs. Model B")
plot(roc_B, add = TRUE, col = "steelblue", lwd = 2)
legend("bottomright",
legend = c(sprintf("Model A (AUC = %.3f)", auc_A),
sprintf("Model B (AUC = %.3f)", auc_B)),
col = c("firebrick", "steelblue"), lwd = 2, bty = "n")
(a) Model A ranks customers better: its AUC is 0.788 versus 0.726, and its ROC curve lies above the other model’s across most thresholds.
(b) “If we pick one random churner and one random customer who stayed, Model A gives the churner the higher score about 79% of the time.”
(c) AUC measures how well a model ranks churners above stayers across all possible cutoffs; it says nothing about whether the probabilities are high in absolute terms. Model A’s scores are mostly below 0.5 — even for churners — because only 12% of customers churn, so very few customers cross the 0.5 line. The ranking is good, but 0.5 is simply the wrong cutoff for a rare outcome; moving the cutoff down lets the good ranking turn into many more caught churners.
Task 4 · Choosing the cutoff with business costs
Model A has the higher AUC, so it is used here. Each contact costs $20; each missed churner costs $150.
cost_at <- function(cutoff, prob) {
contacted <- sum(prob >= cutoff)
missed <- sum(prob < cutoff & churn$churned == 1)
20 * contacted + 150 * missed
}
cost_none <- 150 * n_churners # contact no one: every churner is missed
cutoffs <- c(0.5, 0.3, 0.2, 0.1)
cost_table <- tibble(
Strategy = c("Contact no one", paste("Cutoff", cutoffs)),
cutoff = c(NA, cutoffs),
Contacted = c(0, sapply(cutoffs, function(c) sum(churn$prob_A >= c))),
`Missed churners` = c(n_churners,
sapply(cutoffs, function(c) sum(churn$prob_A < c & churn$churned == 1))),
total_cost = c(cost_none, sapply(cutoffs, cost_at, prob = churn$prob_A))
)
cost_table %>%
mutate(`Total cost` = paste0("$", num(total_cost))) %>%
select(Strategy, Contacted, `Missed churners`, `Total cost`) %>%
knitr::kable(align = "lccr", caption = "Total cost by strategy (Model A)")| Strategy | Contacted | Missed churners | Total cost |
|---|---|---|---|
| Contact no one | 0 | 120 | $18,000 |
| Cutoff 0.5 | 53 | 96 | $15,460 |
| Cutoff 0.3 | 146 | 67 | $12,970 |
| Cutoff 0.2 | 247 | 49 | $12,290 |
| Cutoff 0.1 | 436 | 20 | $11,720 |
best <- cost_table %>% slice_min(total_cost, n = 1, with_ties = FALSE)
cost_05 <- cost_at(0.5, churn$prob_A)
save_vs05 <- cost_05 - best$total_cost
save_vs0 <- cost_none - best$total_cost
breakeven <- 20 / 150
cost_be <- cost_at(breakeven, churn$prob_A)
c(best_cost = best$total_cost, saving_vs_0.5 = save_vs05,
saving_vs_none = save_vs0, breakeven_cutoff = round(breakeven, 4),
cost_at_breakeven = cost_be) best_cost saving_vs_0.5 saving_vs_none breakeven_cutoff
1.172e+04 3.740e+03 6.280e+03 1.333e-01
cost_at_breakeven
1.184e+04 (a) The Cutoff 0.1 gives the lowest total cost, $11,720. That saves $3,740 compared with the 0.5 cutoff ($15,460) and $6,280 compared with contacting no one ($18,000) on these 1,000 customers.
(b) The break-even rule says contact when p × $150 > $20, i.e. p > 20/150 ≈ 0.133. Our best tested cutoff, 0.1, is close to this value (the cost at exactly 0.133 is $11,840). The cutoff should be low because the two errors are very unequal: a wasted credit costs only $20, but a missed churner costs $150 — 7.5 times more. It is worth contacting a customer even when there is only about a 13% chance they will churn, so we should accept many more false positives to avoid false negatives.
Part 2 — Does the New Sign-Up Page Work?
Task 5 · The A/B test
Rows: 12,000
Columns: 6
$ visitor_id <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17…
$ group <chr> "treatment", "control", "control", "control", "control", …
$ page_version <chr> "Photo menu", "Text menu", "Text menu", "Text menu", "Tex…
$ signed_up <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, …
$ first_order <dbl> 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.0…
$ day <dbl> 4, 2, 13, 5, 5, 14, 12, 11, 10, 6, 3, 2, 1, 3, 11, 2, 12,…| group | page_version | n |
|---|---|---|
| control | Text menu | 6033 |
| treatment | Photo menu | 5967 |
(a) Summary by group
ab_summary <- signup %>%
group_by(group) %>%
summarise(visitors = n(),
signups = sum(signed_up),
signup_rate = mean(signed_up),
rev_per_visitor = mean(first_order))
ab_summary %>%
transmute(Group = str_to_title(group),
Visitors = num(visitors),
`Sign-ups` = num(signups),
`Sign-up rate` = pct(signup_rate, 2),
`Revenue / visitor` = paste0("$", formatC(rev_per_visitor, format = "f", digits = 2))) %>%
knitr::kable(align = "lcccc", caption = "A/B test results by group")| Group | Visitors | Sign-ups | Sign-up rate | Revenue / visitor |
|---|---|---|---|---|
| Control | 6,033 | 495 | 8.20% | $7.16 |
| Treatment | 5,967 | 584 | 9.79% | $8.30 |
ctrl <- filter(ab_summary, group == "control")
trt <- filter(ab_summary, group == "treatment")
abs_lift_pp <- (trt$signup_rate - ctrl$signup_rate) * 100
rel_lift_pct <- (trt$signup_rate / ctrl$signup_rate - 1) * 100
c(absolute_lift_pp = round(abs_lift_pp, 2), relative_lift_pct = round(rel_lift_pct, 1)) absolute_lift_pp relative_lift_pct
1.58 19.30 The photo-menu page converted 9.79% of visitors versus 8.20% for the text menu: an absolute lift of 1.58 percentage points and a relative lift of 19.3%. Revenue per visitor rose from $7.16 to $8.30.
(b) Hypotheses
- H₀: ptreatment = pcontrol — the photo-menu page has the same sign-up rate as the text-menu page.
- H₁: ptreatment ≠ pcontrol — the sign-up rates differ.
(c) Two-proportion test
conversions <- c(treatment = trt$signups, control = ctrl$signups)
visitors <- c(treatment = trt$visitors, control = ctrl$visitors)
pt <- prop.test(conversions, visitors, correct = FALSE)
pt
2-sample test for equality of proportions without continuity correction
data: conversions out of visitors
X-squared = 9.1782, df = 1, p-value = 0.002449
alternative hypothesis: two.sided
95 percent confidence interval:
0.00558577 0.02606002
sample estimates:
prop 1 prop 2
0.09787163 0.08204873 The p-value is 0.00245, below α = 0.05, so we reject H₀: the sign-up rates differ. The 95% confidence interval for treatment minus control is 0.56 to 2.61 percentage points. It lies entirely above 0, which agrees with the test and says the photo page raises sign-ups.
(d) Revenue per visitor
treatment_rev <- signup$first_order[signup$group == "treatment"]
control_rev <- signup$first_order[signup$group == "control"]
tt <- t.test(treatment_rev, control_rev)
tt
Welch Two Sample t-test
data: treatment_rev and control_rev
t = 2.4658, df = 11952, p-value = 0.01369
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
0.2341942 2.0501282
sample estimates:
mean of x mean of y
8.301039 7.158878 Yes. Revenue per visitor is $1.14 higher for the photo page (p = 0.0137), with a 95% CI of $0.23 to $2.05 per visitor, so the difference is statistically significant at α = 0.05.
(e) Type I error in business terms
A Type I error would mean concluding the photo-menu page increases sign-ups when it really does not. Lakeside would spend money building and rolling out the new page (and stop testing other ideas) for a lift that was only random noise.
Task 6 · Power and the recommendation
(a) Sample size for a 0.5-point lift
p_ctrl <- ctrl$signup_rate
p_target <- p_ctrl + 0.005
h <- ES.h(p_target, p_ctrl)
pw <- pwr.2p.test(h = h, sig.level = 0.05, power = 0.80)
pw
Difference of proportion power calculation for binomial distribution (arcsine transformation)
h = 0.01797396
n = 48590.24
sig.level = 0.05
power = 0.8
alternative = two.sided
NOTE: same sample sizesn_per_group <- ceiling(pw$n)
weeks <- n_per_group / 3000
months <- weeks / 4.33
c(n_per_group = n_per_group, weeks = round(weeks, 1), months = round(months, 1))n_per_group weeks months
48591.0 16.2 3.7 Detecting a lift from 8.20% to 8.70% is a tiny effect (h = 0.018), so the test needs about 48,591 visitors per group. At about 3,000 visitors per group per week, that is 16.2 weeks — roughly 17 weeks (about 4 months).
(b) Recommendation for the VP of Marketing
Recommendations
I recommend two actions: use Model A with a 0.1 cutoff to identify customers likely to cancel, and launch the new photo-menu page to increase sign-ups.
For customer churn, Model A is the better choice because its AUC is 0.788, compared with 0.726 for Model B. At the 0.5 cutoff, Model A catches only 24 of the 120 customers who churn.
Since contacting a customer costs $20 and missing a churner costs an estimated $150 in lost future profit, Lakeside should use a lower cutoff to identify more at-risk customers. The cost analysis shows that the 0.1 cutoff produces the lowest total cost among the options tested, at $11,720. This saves $3,740 compared with the 0.5 cutoff and $6,280 compared with contacting no customers. The break-even point is approximately 13% churn risk ($20 ÷ $150), which supports using a lower cutoff. Lakeside should contact customers whose predicted churn probability is at least 10% and monitor whether these efforts reduce cancellations.
For the sign-up page, I recommend launching the new photo-menu design because the results show a meaningful improvement. The sign-up rate increased from 8.20% in the control group to 9.79% in the treatment group, an increase of about 1.6 percentage points, or a 19.3% relative improvement. The result is statistically significant (p = 0.00245), meaning the improvement is unlikely to be due to random chance alone. Revenue per visitor also increased by $1.14, and this difference was statistically significant (p = 0.0137), with a 95% confidence interval of $0.23 to $2.05 per visitor. These results support launching the photo-menu page because it improved both sign-ups and revenue per visitor.
However, Lakeside should be careful when planning future experiments. Our power analysis shows that detecting a smaller improvement of just 0.5 percentage points would require approximately 48,591 visitors per group, or 97,182 visitors in total. At about 3,000 visitors per group per week, this would take about four months per test. Therefore, future experiments should prioritize substantial design changes with the potential to produce larger improvements.
Lakeside should continue measuring customer retention, outreach costs, sign-ups, and revenue to confirm that these decisions deliver lasting business benefits.
AI Tool Disclosure
I used Claude (Anthropic, Opus 5.5) as an assistant on this exam. The analysis code and written answers were my own work. Claude helped in the following ways:
- Formatting and code clean-up: improved the report’s layout and styling, fixed how dollar amounts display, and made the written answers pull numbers directly from the R results.
- Troubleshooting: explained a Windows security error that blocked R packages from loading.
- Task 6(b): suggested a structure for the recommendation and proofread my drafts. I wrote the recommendation myself and revised it based on the feedback.
https://claude.ai/share/b73ad38f-f925-4e68-8f09-a4c18744da04