Сегментация плохих заемщиков
Александр ЛЕВАКОВ
18 декабря 2016 г
Импорт и подготовка данных
library(ggplot2)
library(broom)
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(qcc)## Package 'qcc', version 2.6## Type 'citation("qcc")' for citing this R package in publications.library(readxl)
case <- read_excel("~/my-data/Test/case.xlsx")
str(case)## Classes 'tbl_df', 'tbl' and 'data.frame': 11383 obs. of 14 variables:
## $ Год : num 2015 2015 2015 2015 2015 ...
## $ Месяц : num 1 1 1 1 1 1 1 1 1 1 ...
## $ Сумма кредита : num 22249 28850 11644 28400 43574 ...
## $ Тип клиента : chr "Тип клиента I" "Тип клиента I" "Тип клиента I" "Тип клиента I" ...
## $ Вероятность дефолта : chr "A" "A" "A" "A" ...
## $ Заработная плата : chr "40000" "20000" "50000" "23000" ...
## $ Возраст (полных лет) на момент подачи заявки: num 30 37 48 43 29 23 35 23 44 47 ...
## $ Семейное положение : chr "Женат/Замужем" "Женат/Замужем" "Женат/Замужем" "Женат/Замужем" ...
## $ Образование : chr "Высшее" "Среднее, в том числе специальное" "Среднее, в том числе специальное" "Среднее, в том числе специальное" ...
## $ Пол : chr "М" "Ж" "М" "Ж" ...
## $ Количество детей : chr "2 ребенка" "1 ребенок" "Нет" "Нет" ...
## $ Срок кредита (месяцев) : num 6 10 11 6 12 10 3 6 13 12 ...
## $ Сумма товаров : num 25990 26227 10490 34400 35990 ...
## $ Сумма долга* : num 0 0 0 0 0 0 0 0 0 0 ...# Новые имена переменных
names(case)[1]<-"Year"
names(case)[2]<-"Month"
names(case)[3]<-"Credit"
names(case)[4]<-"Client"
names(case)[5]<-"Defolt"
names(case)[6]<-"Salary"
names(case)[7]<-"Old"
names(case)[8]<-"Family"
names(case)[9]<-"Education"
names(case)[10]<-"Sex"
names(case)[11]<-"Kids"
names(case)[12]<-"Credit_length"
names(case)[13]<-"Goods"
names(case)[14]<-"Debt"
#Очистка данных от пропущенных значений
case$Salary<-as.numeric(case$Salary)## Warning: в результате преобразования созданы NAcase<-na.omit(case)
filter(case, Year==2015, Debt >0, Defolt=="D") %>% count() #всего плохих за 2015 с ненулевой задолженностью## # A tibble: 1 <U+00D7> 1
## n
## <int>
## 1 98Отбор данных
Выбираем 2015 год при ненулевой задолженности. Записываем в файл.
case_filter<-filter(case, Year==2015, Debt > 0 , Defolt=="D") %>% group_by(Client) %>% arrange (Client, desc(Debt))
case_filter## Source: local data frame [98 x 14]
## Groups: Client [2]
##
## Year Month Credit Client Defolt Salary Old
## <dbl> <dbl> <dbl> <chr> <chr> <dbl> <dbl>
## 1 2015 1 29499.52 Тип клиента I D 25000 22
## 2 2015 1 31380.37 Тип клиента I D 37000 45
## 3 2015 1 30476.47 Тип клиента I D 35000 27
## 4 2015 2 33290.00 Тип клиента I D 35000 29
## 5 2015 3 36082.01 Тип клиента I D 25000 30
## 6 2015 1 29731.16 Тип клиента I D 47000 36
## 7 2015 2 29006.29 Тип клиента I D 31000 25
## 8 2015 3 24244.00 Тип клиента I D 25000 26
## 9 2015 4 36216.20 Тип клиента I D 27000 22
## 10 2015 3 23597.00 Тип клиента I D 25000 23
## # ... with 88 more rows, and 7 more variables: Family <chr>,
## # Education <chr>, Sex <chr>, Kids <chr>, Credit_length <dbl>,
## # Goods <dbl>, Debt <dbl>write.csv(case_filter,file = "case_filter.csv",fileEncoding = "UTF-8")Группа 1
Выбираем группу: Тип клиента I, вероятность дефолта “D”. Группируем по полу, семейному положению, количеству детей, образованию. Определяем сумму, максимальное, среднее и стандартное отклонение по задолженности в каждой группе. Определяем сумму задолженности, сумму кредита и отношение суммы задолженности к к сумме кредита в группе. Печатаем таблицу и диаграмму.
case_filter_1<-filter(case, Year==2015, Debt > 0, Client=="Тип клиента I", Defolt=="D") %>% group_by(Client, Defolt, Debt, Old) %>% arrange (desc(Defolt))
case_filter_1 %>% count()## Source: local data frame [54 x 5]
## Groups: Client, Defolt, Debt [?]
##
## Client Defolt Debt Old n
## <chr> <chr> <dbl> <dbl> <int>
## 1 Тип клиента I D 825.64 33 1
## 2 Тип клиента I D 900.44 46 1
## 3 Тип клиента I D 1264.52 24 1
## 4 Тип клиента I D 1288.35 36 1
## 5 Тип клиента I D 2398.58 22 1
## 6 Тип клиента I D 2480.28 27 1
## 7 Тип клиента I D 3354.40 26 1
## 8 Тип клиента I D 3358.10 30 1
## 9 Тип клиента I D 3512.04 34 1
## 10 Тип клиента I D 3786.38 24 1
## # ... with 44 more rowscase_1_sex<-filter(case_filter_1) %>% group_by(Sex) %>% summarise(sum=sum(Debt),max=max(Debt),mean=mean(Debt), sd=sd(Debt)) %>% arrange(desc(sum))
case_11_sex<-filter(case_filter_1) %>% group_by(Sex) %>% summarise(sum_Debt=sum(Debt),sum_Credit=sum(Credit), DC=sum_Debt/sum_Credit) %>% arrange(desc(DC))
case_1_sex## # A tibble: 2 <U+00D7> 5
## Sex sum max mean sd
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 М 376628.6 22852.92 10179.151 6573.325
## 2 Ж 152368.0 17658.54 8962.824 4989.141case_11_sex## # A tibble: 2 <U+00D7> 4
## Sex sum_Debt sum_Credit DC
## <chr> <dbl> <dbl> <dbl>
## 1 М 376628.6 834206.8 0.4514811
## 2 Ж 152368.0 361973.0 0.4209374with(case_1_sex, barplot(sum,names.arg=Sex, main="Суммарная задолженность в группе 1 - пол"))
with(case_11_sex, barplot(DC,names.arg=Sex, main="Суммарная задолженность к сумме кредита в группе 1 - пол"))
case_1_fam<-filter(case_filter_1) %>% group_by(Family) %>% summarise(sum=sum(Debt),max=max(Debt),mean=mean(Debt), sd=sd(Debt)) %>% arrange(desc(sum))
case_11_fam<-filter(case_filter_1) %>% group_by(Family) %>% summarise(sum_Debt=sum(Debt),sum_Credit=sum(Credit), DC=sum_Debt/sum_Credit) %>% arrange(desc(DC))
case_1_fam## # A tibble: 4 <U+00D7> 5
## Family sum max mean sd
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 Холост/Не замужем 328358.95 22852.92 9657.616 6297.265
## 2 Женат/Замужем 186727.95 20957.92 10373.775 6107.239
## 3 Разведен(а) 8612.73 8612.73 8612.730 NaN
## 4 Вдовец/Вдова 5296.95 5296.95 5296.950 NaNcase_11_fam## # A tibble: 4 <U+00D7> 4
## Family sum_Debt sum_Credit DC
## <chr> <dbl> <dbl> <dbl>
## 1 Женат/Замужем 186727.95 400881.01 0.4657940
## 2 Холост/Не замужем 328358.95 755705.03 0.4345068
## 3 Разведен(а) 8612.73 23107.76 0.3727202
## 4 Вдовец/Вдова 5296.95 16486.01 0.3212997with(case_1_fam, barplot(sum,names.arg=Family, main="Суммарная задолженность в группе 1 - семья"))
with(case_11_fam, barplot(DC,names.arg=Family, main="Суммарная задолженность к сумме кредита в группе 1 - семья"))
case_1<-case_1_fam$sum
names(case_1)<-case_1_fam$Family
pareto.chart(case_1,main = "Pareto sum - Family")
##
## Pareto chart analysis for case_1
## Frequency Cum.Freq. Percentage Cum.Percent.
## Холост/Не замужем 328358.95 328359.0 62.072036 62.07204
## Женат/Замужем 186727.95 515086.9 35.298517 97.37055
## Разведен(а) 8612.73 523699.6 1.628126 98.99868
## Вдовец/Вдова 5296.95 528996.6 1.001320 100.00000case_1_kid<-filter(case_filter_1) %>% group_by(Kids) %>% summarise(sum=sum(Debt),max=max(Debt),mean=mean(Debt), sd=sd(Debt)) %>% arrange(desc(sum))
case_11_kid<-filter(case_filter_1) %>% group_by(Kids) %>% summarise(sum_Debt=sum(Debt),sum_Credit=sum(Credit), DC=sum_Debt/sum_Credit) %>% arrange(desc(DC))
case_1_kid## # A tibble: 3 <U+00D7> 5
## Kids sum max mean sd
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 Нет 314447.61 22852.92 9826.488 5866.633
## 2 1 ребенок 178113.92 20957.92 11874.261 6913.319
## 3 2 ребенка 36435.05 7500.02 5205.007 1940.561case_11_kid## # A tibble: 3 <U+00D7> 4
## Kids sum_Debt sum_Credit DC
## <chr> <dbl> <dbl> <dbl>
## 1 1 ребенок 178113.92 360857.9 0.4935847
## 2 Нет 314447.61 701137.1 0.4484823
## 3 2 ребенка 36435.05 134184.8 0.2715288with(case_1_kid, barplot(sum,names.arg=Kids, main="Суммарная задолженность в группе 1 - дети"))
with(case_11_kid, barplot(DC,names.arg=Kids, main="Суммарная задолженность к сумме кредита в группе 1 - дети"))
case_1_k<-case_1_kid$sum
names(case_1_k)<-case_1_kid$Kids
pareto.chart(case_1_k,main = "Pareto sum - Kids")
##
## Pareto chart analysis for case_1_k
## Frequency Cum.Freq. Percentage Cum.Percent.
## Нет 314447.61 314447.6 59.442277 59.44228
## 1 ребенок 178113.92 492561.5 33.670146 93.11242
## 2 ребенка 36435.05 528996.6 6.887578 100.00000case_1_ed<-filter(case_filter_1) %>% group_by(Education) %>% summarise(sum=sum(Debt),max=max(Debt),mean=mean(Debt), sd=sd(Debt)) %>% arrange(desc(sum))
case_11_ed<-filter(case_filter_1) %>% group_by(Education) %>% summarise(sum_Debt=sum(Debt), sum_Credit=sum(Credit), DC=sum_Debt/sum_Credit) %>% arrange(desc(DC))
case_1_ed## # A tibble: 4 <U+00D7> 5
## Education sum max mean sd
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 Среднее, в том числе специальное 453838.54 22852.92 9656.139 6276.845
## 2 Высшее 37517.60 17658.54 12505.867 4618.938
## 3 Неполное высшее 21826.84 11948.37 7275.613 4345.997
## 4 Начальное или неполное среднее 15813.60 15813.60 15813.600 NaNcase_11_ed## # A tibble: 4 <U+00D7> 4
## Education sum_Debt sum_Credit DC
## <chr> <dbl> <dbl> <dbl>
## 1 Начальное или неполное среднее 15813.60 22979.72 0.6881546
## 2 Среднее, в том числе специальное 453838.54 1021740.78 0.4441817
## 3 Высшее 37517.60 88044.50 0.4261209
## 4 Неполное высшее 21826.84 63414.81 0.3441915with(case_1_ed, barplot(sum,names.arg=Education, main="Суммарная задолженность в группе 1 - образование"))
with(case_11_ed, barplot(DC,names.arg=Education, main="Суммарная задолженность к сумме кредита в группе 1 - образование"))
case_1_e<-case_1_ed$sum
names(case_1_e)<-case_1_ed$Education
pareto.chart(case_1_e,main = "Pareto sum - Education")
##
## Pareto chart analysis for case_1_e
## Frequency Cum.Freq. Percentage
## Среднее, в том числе специальное 453838.54 453838.5 85.792339
## Высшее 37517.60 491356.1 7.092220
## Неполное высшее 21826.84 513183.0 4.126083
## Начальное или неполное среднее 15813.60 528996.6 2.989358
##
## Pareto chart analysis for case_1_e
## Cum.Percent.
## Среднее, в том числе специальное 85.79234
## Высшее 92.88456
## Неполное высшее 97.01064
## Начальное или неполное среднее 100.00000write.csv(case_filter_1,file = "case_filter_1.csv",fileEncoding = "UTF-8")Группа 2
Выбираем группу: Тип клиента II, вероятность дефолта “D”. Группируем по полу, семейному положению, количеству детей, образованию. Определяем сумму, максимальное, среднее и стандартное отклонение по задолженности в каждой группе. Определяем сумму задолженности, сумму кредита и отношение суммы задолженности к к сумме кредита в группе. Печатаем таблицу и диаграмму.
case_filter_2<-filter(case, Year==2015, Debt > 0, Client=="Тип клиента II", Defolt=="D") %>% group_by(Client, Defolt, Debt, Old) %>% arrange (Client, desc(Defolt), desc(Debt))
case_filter_2 %>% count()## Source: local data frame [44 x 5]
## Groups: Client, Defolt, Debt [?]
##
## Client Defolt Debt Old n
## <chr> <chr> <dbl> <dbl> <int>
## 1 Тип клиента II D 871.06 22 1
## 2 Тип клиента II D 3099.81 27 1
## 3 Тип клиента II D 3304.51 20 1
## 4 Тип клиента II D 3538.35 23 1
## 5 Тип клиента II D 3760.81 20 1
## 6 Тип клиента II D 5132.39 25 1
## 7 Тип клиента II D 6113.18 28 1
## 8 Тип клиента II D 7353.45 24 1
## 9 Тип клиента II D 9323.90 25 1
## 10 Тип клиента II D 9440.66 24 1
## # ... with 34 more rowscase_2_sex<-filter(case_filter_2) %>% group_by(Sex) %>% summarise(sum=sum(Debt),max=max(Debt),mean=mean(Debt), sd=sd(Debt)) %>% arrange(desc(sum))
case_22_sex<-filter(case_filter_2) %>% group_by(Sex) %>% summarise(sum_Debt=sum(Debt), sum_Credit=sum(Credit), DC=sum_Debt/sum_Credit) %>% arrange(desc(DC))
case_2_sex## # A tibble: 2 <U+00D7> 5
## Sex sum max mean sd
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 М 472165.8 25348.81 15231.16 5353.004
## 2 Ж 181000.9 31765.12 13923.15 10299.724case_22_sex## # A tibble: 2 <U+00D7> 4
## Sex sum_Debt sum_Credit DC
## <chr> <dbl> <dbl> <dbl>
## 1 Ж 181000.9 275726.6 0.6564507
## 2 М 472165.8 830120.5 0.5687919with(case_2_sex, barplot(sum,names.arg=Sex, main="Суммарная задолженность в группе 2 - пол"))
with(case_22_sex, barplot(DC,names.arg=Sex, main="Суммарная задолженность к сумме кредита в группе 2 - пол"))
case_2_fam<-filter(case_filter_2) %>% group_by(Family) %>% summarise(sum=sum(Debt),max=max(Debt),mean=mean(Debt), sd=sd(Debt)) %>% arrange(desc(sum))
case_22_fam<-filter(case_filter_2) %>% group_by(Family) %>% summarise(sum_Debt=sum(Debt), sum_Credit=sum(Credit), DC=sum_Debt/sum_Credit) %>% arrange(desc(DC))
case_2_fam## # A tibble: 3 <U+00D7> 5
## Family sum max mean sd
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 Холост/Не замужем 317284.96 25348.81 13220.21 6711.033
## 2 Женат/Замужем 309606.67 31765.12 16295.09 6986.053
## 3 Разведен(а) 26275.14 26275.14 26275.14 NaNcase_22_fam## # A tibble: 3 <U+00D7> 4
## Family sum_Debt sum_Credit DC
## <chr> <dbl> <dbl> <dbl>
## 1 Разведен(а) 26275.14 34699.32 0.7572235
## 2 Женат/Замужем 309606.67 490167.01 0.6316351
## 3 Холост/Не замужем 317284.96 580980.82 0.5461195with(case_2_fam, barplot(sum,names.arg=Family, main="Суммарная задолженность в группе 2 - семья"))
with(case_22_fam, barplot(DC,names.arg=Family, main="Суммарная задолженность к сумме кредита в группе 2 - семья"))
case_2<-case_2_fam$sum
names(case_2)<-case_2_fam$Family
pareto.chart(case_2,main = "Pareto sum - Family")
##
## Pareto chart analysis for case_2
## Frequency Cum.Freq. Percentage Cum.Percent.
## Холост/Не замужем 317284.96 317285.0 48.576409 48.57641
## Женат/Замужем 309606.67 626891.6 47.400861 95.97727
## Разведен(а) 26275.14 653166.8 4.022731 100.00000case_2_kid<-filter(case_filter_2) %>% group_by(Kids) %>% summarise(sum=sum(Debt),max=max(Debt),mean=mean(Debt), sd=sd(Debt)) %>% arrange(desc(sum))
case_22_kid<-filter(case_filter_2) %>% group_by(Kids) %>% summarise(sum_Debt=sum(Debt), sum_Credit=sum(Credit), DC=sum_Debt/sum_Credit) %>% arrange(desc(DC))
case_2_kid## # A tibble: 4 <U+00D7> 5
## Kids sum max mean sd
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 Нет 381846.11 25348.81 13637.36 6811.126
## 2 1 ребенок 180199.44 26275.14 16381.77 6594.050
## 3 2 ребенка 49679.17 22110.62 16559.72 6012.667
## 4 3 ребенка 41442.05 31765.12 20721.03 15618.709case_22_kid## # A tibble: 4 <U+00D7> 4
## Kids sum_Debt sum_Credit DC
## <chr> <dbl> <dbl> <dbl>
## 1 3 ребенка 41442.05 57631.76 0.7190835
## 2 2 ребенка 49679.17 70020.90 0.7094906
## 3 1 ребенок 180199.44 299059.51 0.6025538
## 4 Нет 381846.11 679134.98 0.5622536with(case_2_kid, barplot(sum,names.arg=Kids, main="Суммарная задолженность в группе 2 - дети"))
with(case_22_kid, barplot(DC,names.arg=Kids, main="Суммарная задолженность к сумме кредита в группе 2 - дети"))
case_2_k<-case_2_kid$sum
names(case_2_k)<-case_2_kid$Kids
pareto.chart(case_2_k,main = "Pareto sum - Kids")
##
## Pareto chart analysis for case_2_k
## Frequency Cum.Freq. Percentage Cum.Percent.
## Нет 381846.11 381846.1 58.460737 58.46074
## 1 ребенок 180199.44 562045.6 27.588580 86.04932
## 2 ребенка 49679.17 611724.7 7.605894 93.65521
## 3 ребенка 41442.05 653166.8 6.344788 100.00000case_2_ed<-filter(case_filter_2) %>% group_by(Education) %>% summarise(sum=sum(Debt),max=max(Debt),mean=mean(Debt), sd=sd(Debt)) %>% arrange(desc(sum))
case_22_ed<-filter(case_filter_2) %>% group_by(Education) %>% summarise(sum_Debt=sum(Debt), sum_Credit=sum(Credit), DC=sum_Debt/sum_Credit) %>% arrange(desc(DC))
case_2_ed## # A tibble: 4 <U+00D7> 5
## Education sum max mean sd
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 Среднее, в том числе специальное 580866.59 31765.12 14894.015 7050.652
## 2 Начальное или неполное среднее 29246.32 17395.76 14623.160 3921.049
## 3 Высшее 25348.81 25348.81 25348.810 NaN
## 4 Неполное высшее 17705.05 14400.54 8852.525 7846.078case_22_ed## # A tibble: 4 <U+00D7> 4
## Education sum_Debt sum_Credit DC
## <chr> <dbl> <dbl> <dbl>
## 1 Высшее 25348.81 33007.2 0.7679782
## 2 Начальное или неполное среднее 29246.32 42122.1 0.6943225
## 3 Среднее, в том числе специальное 580866.59 987558.3 0.5881846
## 4 Неполное высшее 17705.05 43159.5 0.4102237with(case_2_ed, barplot(sum,names.arg=Education, main="Суммарная задолженность в группе 2 - образование"))
with(case_22_ed, barplot(DC,names.arg=Education, main="Суммарная задолженность к сумме кредита в группе 2 - образование"))
case_2_e<-case_2_ed$sum
names(case_2_e)<-case_2_ed$Education
pareto.chart(case_2_e,main = "Pareto sum - Education")
##
## Pareto chart analysis for case_2_e
## Frequency Cum.Freq. Percentage
## Среднее, в том числе специальное 580866.59 580866.6 88.930824
## Начальное или неполное среднее 29246.32 610112.9 4.477619
## Высшее 25348.81 635461.7 3.880909
## Неполное высшее 17705.05 653166.8 2.710648
##
## Pareto chart analysis for case_2_e
## Cum.Percent.
## Среднее, в том числе специальное 88.93082
## Начальное или неполное среднее 93.40844
## Высшее 97.28935
## Неполное высшее 100.00000write.csv(case_filter_2,file = "case_filter_2.csv",fileEncoding = "UTF-8")Кластеризация по методу К-средних
Разбиваем весь отфильтрованный срез 2015 года на 5 кластеров (групп) и строим в каждом кластере линейные регрессии.
case_slice<-with(case_filter, data.frame(Credit,Debt))
fit.k<-kmeans(case_slice[,1:2],5)
fit.k## K-means clustering with 5 clusters of sizes 11, 24, 20, 21, 22
##
## Cluster means:
## Credit Debt
## 1 32119.35 24052.966
## 2 32266.34 16139.940
## 3 23112.87 14686.356
## 4 22273.87 7057.857
## 5 11105.15 4012.729
##
## Clustering vector:
## [1] 1 1 1 2 2 2 2 3 2 3 2 3 3 3 2 3 2 2 3 3 3 4 2 4 2 4 4 4 5 5 4 4 4 4 5
## [36] 4 4 5 5 5 5 5 4 5 5 5 5 5 4 4 5 5 5 5 1 1 1 1 1 1 1 1 3 2 2 2 2 2 2 3
## [71] 2 2 2 2 3 3 2 3 3 3 3 2 3 3 3 4 4 4 2 4 5 5 4 4 5 4 5 5
##
## Within cluster sum of squares by cluster:
## [1] 215116044 373470450 228121763 539254017 357947436
## (between_SS / total_SS = 85.5 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss"
## [5] "tot.withinss" "betweenss" "size" "iter"
## [9] "ifault"fit.k$cluster <- as.factor(fit.k$cluster)
ggplot(case_slice, aes(Credit, Debt, color = fit.k$cluster)) + geom_point() + geom_smooth(method = lm)
Выводы
- Всего за 2015 год c ненулевой задолженностью в группе риска (D) 98 клиентов: 54 - Тип клиента I, 44 - Тип клиента II.
- В обеих группах клиентов следует обратить внимание на суммарную задолженность: мужчин, холостых или женатых, без детей или с одним ребенком, имеющих среднее, в том числе специальное образование.
- Сегментация по величине отношения суммы задолженности к сумме кредита дает совершенно другую картину в обеих группах.
- Парето диаграмма дает более наглядное представление о суммарной задолженности по каждой группе.
- Кластеризация по методу К-средних дает наглядное представление о группах риска, где задолженность растет быстрее кредита.