Telecom Churn
2023 — A model that predicts how likely a customer is to churn
01 Problem
Winning a new subscriber costs a telecom far more than keeping one. A model that names the customers who are about to leave lets the retention team call them first, while there is still something to save.
The goal is a classifier that flags likely churners from what the company already knows about each customer, such as their contract, tenure, charges, and services.
02 Cleaning
The IBM Telco dataset holds 7,043 customers with no duplicated rows. Eleven customers who joined this month have no total charges yet and are removed, the customer ID is dropped since it identifies a row rather than describing it, and every text column becomes a factor.
churn <- read.csv("datasets/Telco Customer Churn.csv")
churn <- churn %>%
filter(complete.cases(.)) %>%
select(-customerID) %>%
mutate_if(is.character, as.factor) %>%
mutate(SeniorCitizen = as.factor(SeniorCitizen))03 Imbalance
Only 27% of customers churned. A model could score 73% accuracy by predicting that nobody ever leaves, which is why accuracy is not the metric that matters here.
04 Selection
Total charges correlates 0.83 with tenure and 0.65 with monthly charges, since it is roughly one multiplied by the other. It is dropped so the model does not split its trust between copies of the same signal.
churn %>% ggcorr(label = T)
churn <- churn %>% select(-TotalCharges)05 Split
The customers are split 85/15, stratified by churn, into 5,978 for training and 1,054 for testing. The test set keeps the real churn rate.
Only after the split are the churners in the training data upsampled, to 8,778 balanced rows. Upsampling first would copy the same customers into both sets, and the model would be graded on rows it has already memorized.
set.seed(1)
indices <- createDataPartition(y = churn$Churn,
p = 0.85,
list = F)
train_data <- churn[indices, ]
test_data <- churn[-indices, ]
up_train <- upSample(x = train_data %>% select(-Churn),
y = train_data$Churn,
yname = "Churn")06 Random forest
Human decisions rarely follow a single rule, so the model is a random forest of 505 trees that vote together.
On the test set it reaches 80% accuracy, but catches only 68% of the customers who actually left. Sensitivity is the metric to raise, because a churner nobody calls is lost revenue.
model_rf <- randomForest(formula = Churn ~ .,
data = up_train,
ntree = 505,
importance = T)
pred_rf <- predict(model_rf, X_test)
confusionMatrix(pred_rf, y_test, positive = "Yes")07 Tuning
The forest is tuned with 5-fold cross validation repeated 3 times. Upsampling happens inside each fold, so a validation fold never contains a copy of a training row, and the candidates are ranked by AUC instead of accuracy. Leaves of at least 25 customers keep the trees from memorizing individual duplicated churners, and 4 features per split wins.
ctrl <- trainControl(
method = "repeatedcv",
number = 5,
repeats = 3,
sampling = "up",
classProbs = TRUE,
summaryFunction = twoClassSummary
)
set.seed(1)
model_rf_tuned <- train(
Churn ~ .,
data = train_data,
method = "rf",
metric = "ROC",
tuneGrid = data.frame(mtry = c(2, 3, 4, 6)),
nodesize = 25,
trControl = ctrl
)08 Evaluation
Sensitivity rises from 68% to 76%, as the tuned model catches 213 of the 280 churners in the test set.
It pays with a specificity of 78%, and that is the right trade for this business, because a retention offer sent to a loyal customer costs far less than a churner nobody called.
pred_rf_tuned <- predict(model_rf_tuned, X_test)
confusionMatrix(pred_rf_tuned, y_test, positive = "Yes")09 ROC
The AUC of 0.847 is the probability that the model ranks a random churner above a random loyal customer. That ranking is what a retention team works from, because it lets them call the riskiest customers first and go down the list as far as the budget allows.
pred_rf_tuned_raw <- predict(model_rf_tuned, X_test, type = "prob")
roc_rf_tuned <- pROC::roc(response = y_test,
predictor = pred_rf_tuned_raw[, "Yes"],
levels = c("No", "Yes"),
direction = "<")
pROC::auc(roc_rf_tuned)10 Drivers
Tenure is by far the strongest signal, followed by a two-year contract, monthly charges, fiber optic internet, and paying by electronic check.
varImp(model_rf_tuned)$importance %>%
arrange(desc(Overall)) %>%
head(10)Telecom Churn
Catches 76% of churners — AUC 0.85