Проект SQL: анализ оттока клиентов немецкого департамента банка
Тетерина Екатерина, emteterina
03 March 2022
Анализ
Данные и логика анализа
Прежде чем приступить к детальному анализу, стоит обратить внимание на несколько важных показателей, которые представлены в данных.
library(DBI)
library(RMariaDB)
library(ggplot2)
library(dplyr)
library(tidymodels)
con <- dbConnect(RMariaDB::MariaDB(),
user='studentminor',
password='DataMinorHSE!2020',
dbname='bank',
host='34.88.193.134',
port = 3306)Посмотрим на отток клиентов.
20% клиентов перестали пользоваться услугами банка.
Exited = dbGetQuery(con, "SELECT Exited, COUNT(Exited) AS n FROM portfolio
GROUP BY Exited")
Exited %>% mutate(percent = round(n/sum(n)*100))Посмотрим сколько у банка активных клиентов.
Почти половина клиентов являются неактивными, что, несомненно, является проблемой для банка.
Кроме того, неактивность клиента может быть сигналом того, что скоро клиент уйдет.
active = dbGetQuery(con, "SELECT IsActiveMember, COUNT(IsActiveMember) AS n FROM portfolio
GROUP BY IsActiveMember")
active %>% mutate(percent = round(n/sum(n)*100))Посмотрим в какой стране самый большой отток.
Самый высокий отток клиентов в Германии, следом Франция, потом Испания.
Самый высокий уровень лояльности клиентов во Франции (хотя она же на 2-м место по оттоку клиентов, но это потому что во Франции вообще гораздо больше клиентов), потом Испания, потом Германия.
#dbGetQuery(con, "SELECT CountryId, Country FROM country")
exit_country = dbGetQuery(con, "SELECT Exited, profile.CountryId
FROM
(portfolio LEFT JOIN profile ON portfolio.CustomerId = profile.CustomerId)
")
exit_country = exit_country %>% mutate(Country = case_when(
CountryId == "country1" ~ "France",
CountryId == "country2" ~ "Spain",
TRUE ~ "Germany")) %>% select(Exited, Country)
#exit_country %>% filter(Country == "Spain") %>% group_by(Exited) %>% summarise(n = n()) %>% mutate(pct=n/sum(n))
exit_country_p = exit_country %>% group_by(Exited) %>% count(Country, sort=T)
exit_country_p %>% group_by(Country) %>% mutate(percent=round(n/sum(n)*100)) В качестве подгруппы выбраны данные по клиентам Германии поскольку в этой стране самый высокий уровень оттока клиентов, а также самый низкий уровень лояльности.
#CustomerId CountryId
germ = dbGetQuery(con, "SELECT Exited, IsActiveMember, HasCrCard, Gender,
Age, EstimatedSalary, CreditScore, Tenure, Balance, NumOfProducts
FROM
(portfolio INNER JOIN profile ON portfolio.CustomerId = profile.CustomerId)
WHERE profile.CountryId = 'country3'
")
# 1- ушел, 0 - остался
dbDisconnect(con)germ$Exited <- ifelse(germ$Exited == 1, "yes", "no") #1=yes
germ$Exited = as.factor(germ$Exited)
germ$Exited = relevel(germ$Exited, "yes", "no")
#levels(germ$Exited)
germ$IsActiveMember = as.factor(germ$IsActiveMember)
germ$HasCrCard = as.factor(germ$HasCrCard)
germ$Gender = as.factor(germ$Gender)
germ_scaled = germ
#scale
germ_scaled$Age = scale(germ_scaled$Age)
germ_scaled$EstimatedSalary = scale(germ_scaled$EstimatedSalary)
germ_scaled$CreditScore = scale(germ_scaled$CreditScore)
germ_scaled$Tenure = scale(germ_scaled$Tenure)
germ_scaled$Balance = scale(germ_scaled$Balance)
germ_scaled$NumOfProducts = scale(germ_scaled$NumOfProducts)Модель
Предскажем отток клиентов банка (переменная Exited) с помощью логистической регрессии, деревьев решений и случайного леса.
Логистическая регрессия
Для логистической регрессии были использованы только 3 переменных (возраст, пол и активность), поскольку остальные модель посчитала статистическими незначимыми.
library(tidymodels)
set.seed(444)
split = initial_split(germ_scaled, prop = 0.8)
train = training(split)
test = testing(split)
model1 = logistic_reg() %>%
fit(Exited ~ Age + IsActiveMember + Gender, data = train)
#summary(model1$fit)
train_pred = predict(model1, train)
test_pred = predict(model1, test)
#train metrics
# train %>%
# cbind(train_pred) %>%
# conf_mat(Exited, .pred_class) %>% summary()
#
# #test metrics
# test %>%
# cbind(test_pred) %>%
# conf_mat(Exited, .pred_class) %>% summary() Точность на тестовой выборке 0.75, что неплохо, но Sensitivity (показывает на сколько хорошо был предсказан интересующий нас класс) всего 0.39, что очень мало. Балансировка выборки с помощью SMOTE желаемого результата не дала (точность модели упала до 0.73), поэтому обратимся к модели другого типа - дереву решений.
caret::confusionMatrix(test_pred$.pred_class, test$Exited)## Confusion Matrix and Statistics
##
## Reference
## Prediction yes no
## yes 61 31
## no 96 314
##
## Accuracy : 0.747
## 95% CI : (0.7066, 0.7845)
## No Information Rate : 0.6873
## P-Value [Acc > NIR] : 0.001937
##
## Kappa : 0.3367
##
## Mcnemar's Test P-Value : 1.354e-08
##
## Sensitivity : 0.3885
## Specificity : 0.9101
## Pos Pred Value : 0.6630
## Neg Pred Value : 0.7659
## Prevalence : 0.3127
## Detection Rate : 0.1215
## Detection Prevalence : 0.1833
## Balanced Accuracy : 0.6493
##
## 'Positive' Class : yes
## Дерево решений
set.seed(444)
split1 = initial_split(germ, prop = 0.8)
train1 = training(split1)
test1 = testing(split1)
set.seed(444)
library(rpart.plot)
tree <- decision_tree(
mode = "classification") %>%
set_engine("rpart")
tree.wf <- workflow() %>%
add_formula(Exited ~.) %>%
add_model(tree) %>%
fit(train1)На тренировочной выборке точность достаточно хорошая (0.81) и Sensitivity выше, чем в логистической регрессии (0.56).
predtrain.tree = tree.wf %>%
predict(train1)
result_mat = train1 %>%
cbind(predtrain.tree) %>%
conf_mat(Exited, .pred_class)
#result_mat
result_mat %>% summary()#acc 0.81 sens 0.56На тестовой выборке показания метрик немного снижаются, но не сильно, поэтому все нормально.
predtest.tree = tree.wf %>%
predict(test1)
result_mat_test = test1 %>%
cbind(predtest.tree) %>%
conf_mat(Exited, .pred_class)
#result_mat_test
result_mat_test %>% summary()# acc 0.8 sens 0.53Посмотрим на важные переменные.
library(vip)
tree.wf %>%
extract_fit_parsnip() %>%
vip()
Посмотрим на само дерево.
options(scipen = 999)
rpart.plot(tree.wf$fit$fit$fit)
Yes - клиент уйдет и не заключит новый договор, No - останется.
Возраст, количество продуктов, которыми пользуется клиент (кредиты, карты, счета), и активность являются самыми важными переменными в предсказании оттока.
Портрет клиента, который скорее всего не заключит новый договор:
старше 43 лет;
неактивен (редко совершает действия);
имеет 1 продукт.
Random forest
Последняя модель, которую мы рассмотрим - случайный лес.
Построим 50 деревьев и посмотрим на точность.
rf_mod = rand_forest(mode = "classification", trees = 50) %>%
set_engine('randomForest')
wf_rf_mod = workflow() %>%
add_model(rf_mod) %>%
add_formula(Exited ~ .) %>%
fit(train1)
predtrain.rf = predict(wf_rf_mod, train1)
predtest.rf = predict(wf_rf_mod, test1)
# обучающая
accuracy_vec(train1$Exited, predtrain.rf$.pred_class)## [1] 0.9995017# тестовая
accuracy_vec(test1$Exited, predtest.rf$.pred_class)## [1] 0.8087649Модель сильно переобучена: на тренировочной выборке точность почти равна 1, а на тестовой падает до 0.81.
Поэтому наилучшей моделью является дерево решений, на его основе и будет проведена симуляция.
Симуляция
Как было уже сказано, важными переменными являются количество продуктов и активность, поэтому изменять мы будем именно их.
Первым делом попробуем изменить количество продуктов.
Предположим, что мы запустили рекламную кампанию, стимулирующую клиентов приобретать 2 продукта вместо 1, и в 10% случаев она была успешна.
test_sim = test1
set.seed(333)
test_sim$NumOfProducts[test_sim$NumOfProducts == 1] =
sample(c(1,2),
size = length(test_sim$NumOfProducts[test_sim$NumOfProducts == 1]),
replace = T, prob = c(0.9, 0.1))
predTest_sim = predict(tree.wf, test_sim)$.pred_class
ggplot(test_sim) + geom_bar(aes(x = Exited), alpha = 0.8) +
geom_bar(data = data.frame(predTest_sim), aes(x = predTest_sim), alpha = 0.8, fill = "#6AB187") +
scale_x_discrete(labels = c("Да", "Нет")) +
ggtitle("Соотношение ушедших и оставшихся клиентов\nпосле симуляции") +
xlab("Ушел ли клиент") +
ylab("") +
theme_minimal()
Из графика видно, что такая кампании снизила бы отток клиентов и, соответственно, увеличила количество тех, кто остался.
Посмотрим, что будет, если мы попробуем простимулировать клиентов быть более активными.
set.seed(333)
test_sim$IsActiveMember[test_sim$IsActiveMember == 0] =
sample(c(0,1),
size = length(test_sim$IsActiveMember[test_sim$IsActiveMember == 0]),
replace = T, prob = c(0.9, 0.1))
predTest_sim_active = predict(tree.wf, test_sim)$.pred_class
ggplot(test_sim) + geom_bar(aes(x = Exited), alpha = 0.8) +
geom_bar(data = data.frame(predTest_sim_active), aes(x = predTest_sim_active), alpha = 0.8, fill = "#6AB187") +
scale_x_discrete(labels = c("Да", "Нет")) +
ggtitle("Соотношение ушедших и оставшихся клиентов\nпосле симуляции") +
xlab("Ушел ли клиент") +
ylab("") +
theme_minimal()
Данная кампания, так же, как и предыдущая тоже помогла бы снизить отток клиентов.
Сравним, какая из кампаний будет более успешной.
Стимулирование приобретения большего количества продуктов:
num_before = test_sim$Exited %>% summary()
num_after = predTest_sim %>% summary()
num_before = as.data.frame(num_before)
num_after = as.data.frame(num_after)
library(kableExtra)
num_before %>%
kbl(col.names = c("Количество клиентов"), caption="Количесто ушедших клиентов до симуляции") %>%
kable_material(c("striped", "hover"))| Количество клиентов | |
|---|---|
| yes | 157 |
| no | 345 |
num_after %>%
kbl(col.names = c("Количество клиентов"), caption="Количесто ушедших клиентов после симуляции") %>%
kable_material(c("striped", "hover"))| Количество клиентов | |
|---|---|
| yes | 102 |
| no | 400 |
Стимулирование повышения активности:
active_before = test_sim$Exited %>% summary()
active_after = predTest_sim_active %>% summary()
active_before = as.data.frame(active_before)
active_after = as.data.frame(active_after)
active_before %>%
kbl(col.names = c("Количество клиентов"), caption="Количесто ушедших клиентов до симуляции") %>%
kable_material(c("striped", "hover"))| Количество клиентов | |
|---|---|
| yes | 157 |
| no | 345 |
active_after %>%
kbl(col.names = c("Количество клиентов"), caption="Количесто ушедших клиентов после симуляции") %>%
kable_material(c("striped", "hover"))| Количество клиентов | |
|---|---|
| yes | 100 |
| no | 402 |
Как видно из таблиц, кампания по стимулированию активности немного лучше, чем кампания по увеличению количества приобретаемых продуктов, но в целом обе работают хорошо.
Дэшборд
В дэшборде представлены основные выводы по анализу: точность модели, процент ушедших клиентов и визуализация симуляции, а также два интерактивных графика. Данный дэшборд будет полезен менеджерам и маркетологам.
Что есть в дэшборде:
Value boxes:
Точность модели (дерево решений) на тестовой выборке;
Общий процент ушедших клиентов;
Процент ушедших клиентов немецкого отдела банка.
Графики:
График распределения количества клиентов относительно количества продутов;
График, показывающий успешность кампании по повышению активности клиентов;
График распределение по возрасту оставшихся и ушедших клиентов.
Общие выводы
Поскольку немецкое отделение банка теряет больше всего клиентов в процентном соотношении по сравнению с отделами других стран, был проведен анализ именно этой подгруппы данных. Было построено три предсказательных модели, “дерево решений” обладало наилучшими показателями на тестовой выборке: точность = 0.8 и Sensitivity = 0.53. На основе этой модели была проведена симуляция возможных действий по снижению уровня оттока. Повышение активности клиентов окажет наиболее продуктивное влияние на снижение оттока.
Возможные стратегии для кампании:
Скидка на обеспечение второй карты или ее бесплатное обеспечение в течение 1-2 месяцев;
Персонализированные предложения по кредитам и вкладам активным клиентам или владельцам более 2-х продуктов;
Кэшбэк и другие бонусы активным клиентам или за выпуск дополнительной карты.