Задача

В работе представлен анализ оттока клиентов банка и предложены рекомендации по уменьшению оттока.

Анализ

Данные и логика анализа

Для начала посмотрим какие таблицы в базе и что в них есть.

dbListTables(con)
## [1] "country"   "portfolio" "profile"
dbListFields(con, "country")
## [1] "Country"   "CountryId"
dbListFields(con, "portfolio")
## [1] "CustomerId"     "CreditScore"    "Tenure"         "Balance"       
## [5] "NumOfProducts"  "HasCrCard"      "IsActiveMember" "Exited"        
## [9] "CountryId"
dbListFields(con, "profile")
## [1] "CustomerId"      "Gender"          "Age"             "EstimatedSalary"
## [5] "CountryId"

Мне интересны следующие условия:

  1. В какой стране отток больше

  2. Среди клиентов какого возраста отток больше

Я хочу предсказать отток (Exited), остальные переменные в portfolio рассматриваются как предикторы (кроме CustomerId). Выберем страну и возраст целевой аудитории, в которых отток больше (Age, Country). В значениях переменных 1 - “Да”, 0 - “Нет”

Сколько всего ушло и осталось клиентов

dbGetQuery(con, "SELECT Exited, COUNT(*) AS num
  FROM portfolio
  GROUP BY Exited
  ORDER BY Exited, num DESC")
##   Exited  num
## 1      0 7963
## 2      1 2037

Сколько ушло и осталось клиентов в разных странах

countries = dbGetQuery(con, "SELECT Country, Exited, COUNT(Exited) AS n 
                       FROM country 
                       INNER JOIN profile USING(CountryId) 
                       INNER JOIN portfolio USING(CustomerId) 
                       GROUP BY Country, Exited
                       ORDER BY Country")
countries %>%
  mutate(Exited = ifelse(Exited == 1,"Ушло","Осталось")) %>%
  ggplot(aes(x = as.factor(Country), y = as.numeric(n), fill = as.factor(Exited))) + 
    geom_bar(position = 'dodge', stat='identity') +
    geom_text(aes(label = as.numeric(n)), position = position_dodge(width=0.9), vjust=-0.25) + 
    scale_fill_manual("legend", values = c("Ушло" = "#974343", "Осталось" = "#5886a5")) +
    theme_bw() +
    xlab("Страна") + ylab("Кол-во клиентов") + 
    ggtitle("Сколько ушло и осталось клиентов в разных странах") +
    guides(fill = guide_legend(title = "Статус"))

В Германии отток больше чем в других странах относительно общего числа клиентов в этой стране.

Посмотрим на отток в зависимости от возраста

ages_all <- dbGetQuery(con, "SELECT Age, Country, COUNT(Exited) AS n 
                       FROM profile
                       INNER JOIN portfolio USING(CustomerId)
                       INNER JOIN country ON profile.CountryId = country.CountryId
                       WHERE Exited = 1
                       GROUP BY Age, Country")

ggplot(ages_all, aes(x = Age, y = as.numeric(n))) + 
  geom_line(aes(col = Country)) +
  xlab("Возраст") + ylab(" ") +
  ggtitle("Отток в разных странах в зависимости от возраста") +
  scale_color_manual(
    name = "Страна",
    values = c("France" = "#3C798A", "Germany"  = "#974343", "Spain"  = "#DF9E5D"),
    labels = c("France" = "Франция", "Germany"  = "Германия", "Spain"  = "Испания")
    ) +
  theme_bw()

Люди какого возраста больше уходят от банка в Германии

ages = dbGetQuery(con, "SELECT Age, COUNT(Exited) AS n 
                       FROM profile
                       INNER JOIN portfolio USING(CustomerId)
                       INNER JOIN country ON profile.CountryId = country.CountryId
                       WHERE (Country = 'Germany' AND Exited = 1)
                       GROUP BY Age")
g_ages <- ggplot(ages, aes(x = Age, y = as.numeric(n))) + 
  geom_line(col="#313c79") +
  xlab("Возраст") + ylab(" ") +
  ggtitle("Отток в Германии в зависимости от возраста") +
  theme_bw()
ggplotly(g_ages)

Больше всего уходят клиенты среднего возраста. Для анализа возьмем 50% клиентов посередине, с 25% до 75%.

round(quantile(ages$Age))
##   0%  25%  50%  75% 100% 
##   19   32   46   60   74

Оставляем данные только по Германии и возраст 32-60.

data1 = dbGetQuery(con, "SELECT Exited, CreditScore, Tenure, Balance, NumOfProducts, HasCrCard, IsActiveMember, Age, Country 
                   FROM portfolio 
                   INNER JOIN profile USING(CustomerId) 
                   INNER JOIN country ON profile.CountryId = country.CountryId 
                   WHERE (Country = 'Germany' AND Age >= 32 AND Age <=60)")
#data1
dbDisconnect(con)

Модель

Для построения модели я выбрала decision tree. Убираем страну и возраст в данных, меняем в Exited 1 на “Ушел”, 0 на “Остался”, и меняем переменные в фактор кроме CreditScore и баланса.

data = data1 %>% select(-Country, -Age)

data <- data %>% mutate(Exited = ifelse(Exited == 1,"Ушел","Остался"))

data$Exited <- as.factor(data$Exited)
data$Tenure <- as.factor(data$Tenure)
data$NumOfProducts <- as.factor(data$NumOfProducts)
data$HasCrCard <- as.factor(data$HasCrCard)
data$IsActiveMember <- as.factor(data$IsActiveMember)

Сколько ушло и осталось клиентов в выбранной подгруппе

ggplot(data, aes(x = Exited, fill = Exited)) + 
  geom_bar() + 
  xlab("Ушел ли клиент") + ylab("Кол-во клиентов") + 
  geom_text(stat='count', aes(label = ..count..), vjust = -0.25) +
  scale_fill_manual("legend", values = c("Остался" = "#5886a5", "Ушел" = "#974343")) +
  theme_bw() +
  theme(legend.position="none")

Строим модель, предсказывающую уход клиентов. Делим данные на тестовую и обучающую выборки.

library(tidymodels)

set.seed(1234) 
split = initial_split(data, prop = 0.8) 
train = training(split) 
test = testing(split)

Проверка правильности процесса рандомизации

prop.table(table(train$Exited))
## 
##   Остался      Ушел 
## 0.6105121 0.3894879
prop.table(table(test$Exited))
## 
##   Остался      Ушел 
## 0.6612903 0.3387097

В обоих наборах данных число ушедших клиентов примерно одинаково - 34 и 39%.

Decision tree

library(parsnip)
library(rpart.plot)
library(workflows)

tree <- decision_tree(
  mode = "classification") %>%
  set_engine("rpart")

tree.wf <- workflow() %>% 
  add_model(tree) %>% 
  add_formula(Exited ~.) %>% 
  fit(data = train)

rpart.plot(tree.wf$fit$fit$fit, roundint=FALSE)

Прогноз и оценка модели

pred <-predict(tree.wf, test, type = 'class')
library(caret)
confusionMatrix(pred$.pred_class, test$Exited)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction Остался Ушел
##    Остался     204   49
##    Ушел         42   77
##                                           
##                Accuracy : 0.7554          
##                  95% CI : (0.7084, 0.7982)
##     No Information Rate : 0.6613          
##     P-Value [Acc > NIR] : 5.31e-05        
##                                           
##                   Kappa : 0.4464          
##                                           
##  Mcnemar's Test P-Value : 0.5294          
##                                           
##             Sensitivity : 0.8293          
##             Specificity : 0.6111          
##          Pos Pred Value : 0.8063          
##          Neg Pred Value : 0.6471          
##              Prevalence : 0.6613          
##          Detection Rate : 0.5484          
##    Detection Prevalence : 0.6801          
##       Balanced Accuracy : 0.7202          
##                                           
##        'Positive' Class : Остался         
##

  • Accuracy 76% показывает правильные прогнозы.

  • Sensitivity 83% показывает какая доля клиентов правильно определена как оставшиеся.

  • Specificity 61% показывает какая доля ушедших правильно определена как ушедшие.

  • Kappa определяет насколько хорошо предсказывает модель. Чем ниже значение, тем лучше модель.

Оценим важность признаков

library(vip)
tree.wf %>%
  extract_fit_parsnip() %>%
  vip()

Количество продуктов (NumOfProducts) - самый важный признак, посмотрим распределение оставшихся и ушедших в зависимости от количества продуктов.

ggplot(train) + 
  geom_bar(aes(x = NumOfProducts, fill = Exited), position = "fill") +
  xlab("Кол-во продуктов") +
  ylab("Распределение") +
  ggtitle("Распределение оставшихся и ушедших \nклиентов в обучающей выборке") +
  scale_fill_manual("legend", values = c("Ушел" = "#974343", "Остался" = "#5886a5"))  +
  guides(fill = guide_legend(title = "Статус"))

ggplot(test) + 
  geom_bar(aes(x = NumOfProducts, fill = Exited), position = "fill") +
  xlab("Кол-во продуктов") +
  ylab("Распределение") +
  ggtitle("Распределение оставшихся и ушедших \nклиентов в тестовой выборке") +
  scale_fill_manual("legend", values = c("Ушел" = "#974343", "Остался" = "#5886a5")) +
  guides(fill = guide_legend(title = "Статус"))

И посмотрим что с балансом.

ggplot(train) + 
  geom_histogram(aes(x = Balance, fill = Exited), position = "dodge", bins=20) +
  xlab("Баланс") +
  ylab("Кол-во клиентов") +
  ggtitle("Распределение оставшихся и ушедших \nклиентов в обучающей выборке") +
  scale_fill_manual("legend", values = c("Ушел" = "#974343", "Остался" = "#5886a5")) +
  guides(fill = guide_legend(title = "Статус"))

ggplot(test) + 
  geom_histogram(aes(x = Balance, fill = Exited), position = "dodge", bins=20) +
  xlab("Баланс") +
  ylab("Кол-во клиентов") +
  ggtitle("Распределение оставшихся и ушедших \nклиентов в обучающей выборке") +
  scale_fill_manual("legend", values = c("Ушел" = "#974343", "Остался" = "#5886a5")) +
  guides(fill = guide_legend(title = "Статус"))

  • Большой отток, если количество продуктов равно 3 или 4.

  • Больше и чаще уходят, если баланс между 100000 и 150000, но стоит отметить что и больше и чаще остаются если баланс примерно в том же диапазоне.

Какое сейчас предсказание оттока

ggplot(test, aes(x = Exited, fill = Exited)) + 
  geom_bar(width = 0.5)+
  geom_text(stat='count', aes(label = ..count..), vjust = -0.25) +
  scale_fill_manual("legend", values = c("Остался" = "#5886a5", "Ушел" = "#974343")) +
  xlab("Ушел ли клиент") +
  ylab("Кол-во клиентов") +
  theme(legend.position="none")

246 осталось и 126 ушло

Симуляция

Способ 1

Так как наибольший отток при количестве продуктов 3 и 4, можно попробовать установить лимит на количество продуктов, поставим максимум 2. Теперь у тех, у кого было 3 или 4 продукта, стоит 2, так как при количестве продуктов 2 отток был минимальным.

test2 = test

test2$NumOfProducts[test2$NumOfProducts == 3] <- 2
test2$NumOfProducts[test2$NumOfProducts == 4] <- 2

predTest = predict(tree.wf, test2)$.pred_class
g1 <- ggplot(data.frame(predTest)) + 
  geom_bar(aes(x = predTest), alpha = 0.5, fill = "#4F7EB2") +
  geom_bar(data = test, aes(x = Exited), alpha = 0.5) + 
  xlab("Ушел ли клиент") +
  ylab("Кол-во клиентов")
ggplotly(g1)

Теперь 267 осталось и 105 ушло. Лимит количества продуктов помог.

Способ 2

Попробуем еще изменить баланс, добавив кэшбэк 5% тем клиентам, у которых баланс больше 100000.

test3 = test
test3$Balance = ifelse(test3$Balance>100000, 
                              test3$Balance*1.05, 
                              test3$Balance)

predTest = predict(tree.wf, test3)$.pred_class
g2 <- ggplot(data.frame(predTest)) + 
  geom_bar(aes(x = predTest), alpha = 0.5, fill = "#4F7EB2") +
  geom_bar(data = test, aes(x = Exited), alpha = 0.5) + 
  xlab("Ушел ли клиент") +
  ylab("Кол-во клиентов")

ggplotly(g2)

262 осталось и 110 ушло. Результаты чуть хуже чем с лимитом продуктов, но все же отток уменьшился, введение кэшбэка помогло.

Соединим оба способа.

test4 = test
test4$NumOfProducts[test4$NumOfProducts == 3] <- 2
test4$NumOfProducts[test4$NumOfProducts == 4] <- 2
test4$Balance = ifelse(test4$Balance>100000, 
                              test4$Balance*1.05, 
                              test4$Balance)

predTest = predict(tree.wf, test4)$.pred_class
g3 <- ggplot(data.frame(predTest)) + 
  geom_bar(aes(x = predTest), alpha = 0.5, fill = "#4F7EB2") +
  geom_bar(data = test, aes(x = Exited), alpha = 0.5) + 
  xlab("Ушел ли клиент") +
  ylab("Кол-во клиентов")

ggplotly(g3)

Использование обоих способов дало лучшие результаты, осталось 276 и ушло 96.

Дэшборд

Дэшборд будет полезен сотрудникам банка, которые занимаются аналитикой и маркетинговыми кампаниями по Германии. В дэшборде представлены:

  1. Количество оставшихся и ушедших клиентов по всем странам

  2. Отток в Германии по возрасту

  3. Отток в зависимости от двух самых важных переменных (количество продуктов и баланс)

  4. Предсказание оттока после изменений

  5. Рекомендации

Общие выводы

Чтобы уменьшить отток клиентов в Германии, банку следует: