Overview
After a sharp stock-market drop, loyal bank customers were withdrawing large sums and closing their accounts. The bank wanted to identify who was likely to leave before a run on the bank could start.
Key results
45 vs 37average age of customers who left vs. those who stayed
$94Kaverage balance of men who left, vs. about $72K for customers who stayed
643–647average credit score of leavers, vs. 652 for customers who stayed
586departing customers the model correctly flagged
The question
Which customers are most likely to exit, and what do they have in common?
What I did
- Cleaned the data and converted categorical fields to numeric inputs
- Trained a neural network for categorical prediction of customer exits
- Evaluated predictions against what customers actually did
- Profiled customers who left vs. stayed by country, gender, age, balance, credit score and salary
What I found
Customers who left were older and held larger balances, a valuable but high-risk group for the bank. German customers carried notably higher balances than those in France and Spain. The model was too eager to predict churn: it flagged many customers who actually stayed. That taught me to check class balance and tune decision thresholds, which I applied in later classification projects.
The Code
The actual R I wrote for this project. Scroll inside the window to read it all.
install.packages("neuralnet")
install.packages("caret")
install.packages("dplyr")
install.packages("magrittr")
install.packages("mlbench")
install.packages("ggplot2")
install.packages("lattice")
install.packages("tidyverse")
library(neuralnet)
library(caret)
library(dplyr)
library(magrittr)
library(mlbench)
library(ggplot2)
library(lattice)
library(tidyverse)
bank <- read.csv("Desktop/BankCustomers.csv", header= TRUE, sep = ",", quote = '"')
bank
str(bank)
#clean up the data
bank <- na.omit(bank)
#transform all characters and integers into numeric
bank$Surname <- as.factor(bank$Surname)
bank$Geography <- as.factor(bank$Geography)
bank$Gender <- as.factor(bank$Gender)
bank$Exited <- as.factor(bank$Exited)
str(bank)
bank %<>% mutate_if(is.factor,as.numeric)
bank %<>% mutate_if(is.integer,as.numeric)
str(bank)
#normalize the data
normalize <- function(x){return((x-min(x))/(max(x)-min(x)))}
#now normalize every column so that everything is between 0 and 1
bank_nrm <- as.data.frame(lapply(bank,normalize))
summary(bank$Exited)
summary(bank_nrm$Exited)
########## train the model
#split data
sample <- sample(c(TRUE,FALSE), nrow(bank_nrm), replace = TRUE, prob = c(.7,.3))
banktrain <- bank_nrm[sample,]
banktest <- bank_nrm[!sample,]
#model
nn <- neuralnet(Exited ~ .,data = banktrain)
plot(nn)
########## evaluate
bankresults <- neuralnet::compute(nn, banktest)
predictedexited <- bankresults$net.result
predictedexited
cor(predictedexited,banktest$Exited)
########## improve model
nn <- neuralnet(Exited ~ .,data = banktrain, hidden = 5)
plot(nn)
bankresults <- neuralnet::compute(nn, banktest)
predictedexited <- bankresults$net.result
predictedexited
cor(predictedexited,banktest$Exited)
exited1 <- data.frame(actual = banktest$Exited, pred = predictedexited)
exited1
#unnormalize
unnormalize <- function(x){return((x*(max(bank$Exited))-
min(bank$Exited))+ min(bank$Exited))}
#add unnormalized prediction column to bank table
exited1$predNew <- unnormalize(exited1$pred)
#add new error column to bank table
exited1$error <- exited1$pred-exited1$actual
head(exited1)
######################## classificaltion/// categorical... run the file from the beggining without factoring
#####clean data
bank <- na.omit(bank)
#change characters into factors
bank$Surname <- as.factor(bank$Surname)
bank$Geography <- as.factor(bank$Geography)
bank$Gender <- as.factor(bank$Gender)
bank$Exited <- as.factor(bank$Exited)
str(bank)
#change input variables to numeric
bank$RowNumber <- as.numeric(bank$RowNumber)
bank$CustomerId <- as.numeric(bank$CustomerId)
bank$Surname <- as.numeric(bank$Surname)-1
bank$CreditScore <- as.numeric(bank$CreditScore)
bank$Geography <- as.numeric(bank$Geography)-1
bank$Gender <- as.numeric(bank$Gender)-1
bank$Age <- as.numeric(bank$Age)
bank$Tenure <- as.numeric(bank$Tenure)
bank$Balance <- as.numeric(bank$Balance)
bank$NumOfProducts <- as.numeric(bank$NumOfProducts)
bank$HasCrCard <- as.numeric(bank$HasCrCard)
bank$IsActiveMember <- as.numeric(bank$IsActiveMember)
bank$EstimatedSalary <- as.numeric(bank$EstimatedSalary)
#scale input variables
bank$RowNumber <- scale(bank$RowNumber)
bank$CustomerId <- scale(bank$CustomerId)
bank$Surname <- scale(bank$Surname)
bank$CreditScore <- scale(bank$CreditScore)
bank$Geography <- scale(bank$Geography)
bank$Gender <- scale(bank$Gender)
bank$Age <- scale(bank$Age)
bank$Tenure <- scale(bank$Tenure)
bank$Balance <- scale(bank$Balance)
bank$NumOfProducts <- scale(bank$NumOfProducts)
bank$HasCrCard <- scale(bank$HasCrCard)
bank$IsActiveMember <- scale(bank$IsActiveMember)
bank$EstimatedSalary <- scale(bank$EstimatedSalary)
########## train model
#split data
sample <- sample(c(TRUE,FALSE), nrow(bank), replace = TRUE, prob = c(.5,.5))
banktrain <- bank[sample,]
banktest <- bank[!sample,]
nn <- neuralnet(Exited ~.,banktrain, hidden = 5)
plot(nn)
#evaluate model
pred = neuralnet::compute(nn,banktest)
pred$net.result
win <- apply(pred$net.result,1,which.max)
predicted <- c('Yes', 'No')[win]
table(predicted,banktest$Exited)
summary(bank)
