Отчет
Гребенников Никита
2023-08-31
Аналитический отчет
library(dplyr)
library(readr)
clients_database <- read_csv("C:\\Users\\Админ\\Downloads\\clientum.csv")
clients_database1 = subset(clients_database, select = - c(...1))
str(clients_database1)## tibble [10,127 × 21] (S3: tbl_df/tbl/data.frame)
## $ CLIENTNUM : num [1:10127] 7.69e+08 8.19e+08 7.14e+08 7.70e+08 7.09e+08 ...
## $ Attrition_Flag : chr [1:10127] "Existing Customer" "Existing Customer" "Existing Customer" "Existing Customer" ...
## $ Customer_Age : num [1:10127] 45 49 51 40 40 44 51 32 37 48 ...
## $ Gender : chr [1:10127] "M" "F" "M" "F" ...
## $ Dependent_count : num [1:10127] 3 5 3 4 3 2 4 0 3 2 ...
## $ Education_Level : chr [1:10127] "High School" "Graduate" "Graduate" "High School" ...
## $ Marital_Status : chr [1:10127] "Married" "Single" "Married" "Unknown" ...
## $ Income_Category : chr [1:10127] "$60K - $80K" "Less than $40K" "$80K - $120K" "Less than $40K" ...
## $ Card_Category : chr [1:10127] "Blue" "Blue" "Blue" "Blue" ...
## $ Months_on_book : num [1:10127] 39 44 36 34 21 36 46 27 36 36 ...
## $ Total_Relationship_Count: num [1:10127] 5 6 4 3 5 3 6 2 5 6 ...
## $ Months_Inactive_12_mon : num [1:10127] 1 1 1 4 1 1 1 2 2 3 ...
## $ Contacts_Count_12_mon : num [1:10127] 3 2 0 1 0 2 3 2 0 3 ...
## $ Credit_Limit : num [1:10127] 12691 8256 3418 3313 4716 ...
## $ Total_Revolving_Bal : num [1:10127] 777 864 0 2517 0 ...
## $ Avg_Open_To_Buy : num [1:10127] 11914 7392 3418 796 4716 ...
## $ Total_Amt_Chng_Q4_Q1 : num [1:10127] 1.33 1.54 2.59 1.4 2.17 ...
## $ Total_Trans_Amt : num [1:10127] 1144 1291 1887 1171 816 ...
## $ Total_Trans_Ct : num [1:10127] 42 33 20 20 28 24 31 36 24 32 ...
## $ Total_Ct_Chng_Q4_Q1 : num [1:10127] 1.62 3.71 2.33 2.33 2.5 ...
## $ Avg_Utilization_Ratio : num [1:10127] 0.061 0.105 0 0.76 0 0.311 0.066 0.048 0.113 0.144 ...head(clients_database1)## # A tibble: 6 × 21
## CLIENTNUM Attrition_Flag Customer_Age Gender Dependent_count Education_Level
## <dbl> <chr> <dbl> <chr> <dbl> <chr>
## 1 768805383 Existing Custom… 45 M 3 High School
## 2 818770008 Existing Custom… 49 F 5 Graduate
## 3 713982108 Existing Custom… 51 M 3 Graduate
## 4 769911858 Existing Custom… 40 F 4 High School
## 5 709106358 Existing Custom… 40 M 3 Uneducated
## 6 713061558 Existing Custom… 44 M 2 Graduate
## # ℹ 15 more variables: Marital_Status <chr>, Income_Category <chr>,
## # Card_Category <chr>, Months_on_book <dbl>, Total_Relationship_Count <dbl>,
## # Months_Inactive_12_mon <dbl>, Contacts_Count_12_mon <dbl>,
## # Credit_Limit <dbl>, Total_Revolving_Bal <dbl>, Avg_Open_To_Buy <dbl>,
## # Total_Amt_Chng_Q4_Q1 <dbl>, Total_Trans_Amt <dbl>, Total_Trans_Ct <dbl>,
## # Total_Ct_Chng_Q4_Q1 <dbl>, Avg_Utilization_Ratio <dbl>Структура матрицы с данными состоит из 21 переменной, 10127 наблюдений. 6 переменных- категориальные, остальные 15 - числовые.
Обработка данных
Проверка на NA и повторения
sum(is.na(clients_database1)) ## [1] 0sum(duplicated(clients_database1)==TRUE)## [1] 0В данных отсутствовали какие-либо пропущенные значения переменных (NA), а также повторяющиеся наблюдения.
Преобразование в .numeric
clients_database1$Gender <- as.factor(clients_database1$Gender)
clients_database1$Gender <- as.numeric(clients_database1$Gender)
clients_database1$Gender <- clients_database1$Gender - 1
clients_database1$Education_Level <- as.factor(clients_database1$Education_Level)
clients_database1$Education_Level <- as.numeric(clients_database1$Education_Level)
clients_database1$Education_Level <- clients_database1$Education_Level - 1
clients_database1$Attrition_Flag <- as.factor(clients_database1$Attrition_Flag)
clients_database1$Attrition_Flag <- as.numeric(clients_database1$Attrition_Flag)
clients_database1$Attrition_Flag <- clients_database1$Attrition_Flag - 1
clients_database1$Marital_Status <- as.factor(clients_database1$Marital_Status)
clients_database1$Marital_Status <- as.numeric(clients_database1$Marital_Status)
clients_database1$Marital_Status <- clients_database1$Marital_Status - 1
clients_database1$Income_Category <- as.factor(clients_database1$Income_Category)
clients_database1$Income_Category <- as.numeric(clients_database1$Income_Category)
clients_database1$Income_Category <- clients_database1$Income_Category - 1
clients_database1$Card_Category <- as.factor(clients_database1$Card_Category)
clients_database1$Card_Category <- as.numeric(clients_database1$Card_Category)
clients_database1$Card_Category <- clients_database1$Card_Category - 1Категориальные данные для дальнейшего удобства анализа была преобразованы в числовые.
Проверка на выбросы
library(ggplot2)
library(gridExtra)
box1 <-ggplot(clients_database1) +
aes(y = Customer_Age) +
geom_boxplot(fill = "lightblue", color = "blue") +
ggtitle("Выбросы в возрастных данных") +
ylab("Возраст") +
xlab(NULL)+
theme(plot.title = element_text (hjust = 0.5 )) +
theme(plot.title = element_text(size = 7)) +
theme(axis.text.x= element_text(size =5),
axis.text.y= element_text(size =5)) +
theme(axis.title.x = element_text(size = 6),
axis.title.y = element_text(size = 6))
box2 <-ggplot(clients_database1) +
aes(y = Avg_Open_To_Buy) +
geom_boxplot(fill = "lightblue", color = "blue") +
ggtitle("Выбросы в доступности денег к покупкам") +
ylab("Доступность денег к покупке") +
xlab(NULL)+
theme(plot.title = element_text (hjust = 0.5 )) +
theme(plot.title = element_text(size = 7)) +
theme(axis.text.x= element_text(size =5),
axis.text.y= element_text(size =5)) +
theme(axis.title.x = element_text(size = 6),
axis.title.y = element_text(size = 6))
box3 <-ggplot(clients_database1) +
aes(y = Credit_Limit) +
geom_boxplot(fill = "lightblue", color = "blue") +
ggtitle("Выбросы в лимитах по кредитным лимитам") +
ylab("Кредитный лимит") +
xlab(NULL)+
theme(plot.title = element_text (hjust = 0.5 )) +
theme(plot.title = element_text(size = 7)) +
theme(axis.text.x= element_text(size =5),
axis.text.y= element_text(size =5)) +
theme(axis.title.x = element_text(size = 6),
axis.title.y = element_text(size = 6))
box4 <-ggplot(clients_database1) +
aes(y = Total_Revolving_Bal) +
geom_boxplot(fill = "lightblue", color = "blue") +
ggtitle("Выбросы в суммах невыплаченных кредитов") +
ylab("Невыплаченный кредит") +
xlab(NULL)+
theme(plot.title = element_text (hjust = 0.5 )) +
theme(plot.title = element_text(size = 7)) +
theme(axis.text.x= element_text(size =5),
axis.text.y= element_text(size =5)) +
theme(axis.title.x = element_text(size = 6),
axis.title.y = element_text(size = 6))
box5 <-ggplot(clients_database1) +
aes(y = Total_Trans_Amt) +
geom_boxplot(fill = "lightblue", color = "blue") +
ggtitle("Выбросы в суммах транзакций (12 мес.)") +
ylab("Сумма транзакции") +
xlab(NULL)+
theme(plot.title = element_text (hjust = 0.5 )) +
theme(plot.title = element_text(size = 7)) +
theme(axis.text.x= element_text(size =5),
axis.text.y= element_text(size =5)) +
theme(axis.title.x = element_text(size = 6),
axis.title.y = element_text(size = 6))
box6 <-ggplot(clients_database1) +
aes(y = Total_Trans_Ct) +
geom_boxplot(fill = "lightblue", color = "blue") +
ggtitle("Выбросы в суммах транзакций") +
ylab("Сумма транзакции") +
xlab(NULL)+
theme(plot.title = element_text (hjust = 0.5 )) +
theme(plot.title = element_text(size = 7)) +
theme(axis.text.x= element_text(size =5),
axis.text.y= element_text(size =5)) +
theme(axis.title.x = element_text(size = 6),
axis.title.y = element_text(size = 6))
box7 <-ggplot(clients_database1) +
aes(y = Total_Ct_Chng_Q4_Q1) +
geom_boxplot(fill = "lightblue", color = "blue") +
ggtitle("Выбросы в суммах транзакций (4Q:1Q)") +
ylab("Отношение") +
xlab(NULL)+
theme(plot.title = element_text (hjust = 0.5 )) +
theme(plot.title = element_text(size = 7)) +
theme(axis.text.x= element_text(size =5),
axis.text.y= element_text(size =5)) +
theme(axis.title.x = element_text(size = 6),
axis.title.y = element_text(size = 6))
box8 <-ggplot(clients_database1) +
aes(y = Avg_Utilization_Ratio) +
geom_boxplot(fill = "lightblue", color = "blue") +
ggtitle("Выбросы в среднем использовании карты (потраченные/доступные") +
ylab("Отношение") +
xlab(NULL)+
theme(plot.title = element_text (hjust = 0.5 )) +
theme(plot.title = element_text(size = 7)) +
theme(axis.text.x= element_text(size =5),
axis.text.y= element_text(size =5)) +
theme(axis.title.x = element_text(size = 6),
axis.title.y = element_text(size = 6))
grid.arrange(box1, box2, box3, box4, box5, box6, box7, box8, ncol=2)
Были проанализированы выбросы в переменных датасета. Так, с помощью боксплотов можно заметить различные результаты. В некоторых переменных, таких как: “Credit_Limit”, “Avg_Open_To_Buy”, “Total_Trans_Amt”, “Total_Ct_Chng_Q4_Q1”, можно обнаружить большое количество выбросов, что выглядит как плотная линия, состоящая из множества точек-выбросов. В другие же, как “Customer_Age” и “Total_Trans_Ct” обнаруживается меньшее количество выбросов, изображенных в виде точек. И наконец, присутствуют переменные без выбросов, как “Total_Revolving_Bal” и “Avg_Utilization_Ratio”.
Описательная статистика
library(psych)
describe(clients_database1)## vars n mean sd median
## CLIENTNUM 1 10127 739177606.33 36903783.45 717926358.00
## Attrition_Flag 2 10127 0.84 0.37 1.00
## Customer_Age 3 10127 46.33 8.02 46.00
## Gender 4 10127 0.47 0.50 0.00
## Dependent_count 5 10127 2.35 1.30 2.00
## Education_Level 6 10127 3.10 1.83 3.00
## Marital_Status 7 10127 1.46 0.74 1.00
## Income_Category 8 10127 2.86 1.50 3.00
## Card_Category 9 10127 0.18 0.69 0.00
## Months_on_book 10 10127 35.93 7.99 36.00
## Total_Relationship_Count 11 10127 3.81 1.55 4.00
## Months_Inactive_12_mon 12 10127 2.34 1.01 2.00
## Contacts_Count_12_mon 13 10127 2.46 1.11 2.00
## Credit_Limit 14 10127 8631.95 9088.78 4549.00
## Total_Revolving_Bal 15 10127 1162.81 814.99 1276.00
## Avg_Open_To_Buy 16 10127 7469.14 9090.69 3474.00
## Total_Amt_Chng_Q4_Q1 17 10127 0.76 0.22 0.74
## Total_Trans_Amt 18 10127 4404.09 3397.13 3899.00
## Total_Trans_Ct 19 10127 64.86 23.47 67.00
## Total_Ct_Chng_Q4_Q1 20 10127 0.71 0.24 0.70
## Avg_Utilization_Ratio 21 10127 0.27 0.28 0.18
## trimmed mad min max
## CLIENTNUM 733606202.47 9411100.02 708082083.0 828343083.00
## Attrition_Flag 0.92 0.00 0.0 1.00
## Customer_Age 46.35 8.90 26.0 73.00
## Gender 0.46 0.00 0.0 1.00
## Dependent_count 2.37 1.48 0.0 5.00
## Education_Level 3.12 1.48 0.0 6.00
## Marital_Status 1.45 1.48 0.0 3.00
## Income_Category 2.92 1.48 0.0 5.00
## Card_Category 0.00 0.00 0.0 3.00
## Months_on_book 35.99 5.93 13.0 56.00
## Total_Relationship_Count 3.88 1.48 1.0 6.00
## Months_Inactive_12_mon 2.29 1.48 0.0 6.00
## Contacts_Count_12_mon 2.46 1.48 0.0 6.00
## Credit_Limit 6685.09 3844.38 1438.3 34516.00
## Total_Revolving_Bal 1148.50 876.22 0.0 2517.00
## Avg_Open_To_Buy 5514.94 3951.13 3.0 34516.00
## Total_Amt_Chng_Q4_Q1 0.74 0.17 0.0 3.40
## Total_Trans_Amt 3707.92 1939.24 510.0 18484.00
## Total_Trans_Ct 64.30 25.20 10.0 139.00
## Total_Ct_Chng_Q4_Q1 0.70 0.18 0.0 3.71
## Avg_Utilization_Ratio 0.24 0.26 0.0 1.00
## range skew kurtosis se
## CLIENTNUM 1.20261e+08 1.00 -0.62 366716.53
## Attrition_Flag 1.00000e+00 -1.85 1.41 0.00
## Customer_Age 4.70000e+01 -0.03 -0.29 0.08
## Gender 1.00000e+00 0.12 -1.99 0.00
## Dependent_count 5.00000e+00 -0.02 -0.68 0.01
## Education_Level 6.00000e+00 0.15 -0.96 0.02
## Marital_Status 3.00000e+00 0.13 -0.28 0.01
## Income_Category 5.00000e+00 -0.39 -1.07 0.01
## Card_Category 3.00000e+00 3.73 12.15 0.01
## Months_on_book 4.30000e+01 -0.11 0.40 0.08
## Total_Relationship_Count 5.00000e+00 -0.16 -1.01 0.02
## Months_Inactive_12_mon 6.00000e+00 0.63 1.10 0.01
## Contacts_Count_12_mon 6.00000e+00 0.01 0.00 0.01
## Credit_Limit 3.30777e+04 1.67 1.81 90.32
## Total_Revolving_Bal 2.51700e+03 -0.15 -1.15 8.10
## Avg_Open_To_Buy 3.45130e+04 1.66 1.80 90.34
## Total_Amt_Chng_Q4_Q1 3.40000e+00 1.73 9.99 0.00
## Total_Trans_Amt 1.79740e+04 2.04 3.89 33.76
## Total_Trans_Ct 1.29000e+02 0.15 -0.37 0.23
## Total_Ct_Chng_Q4_Q1 3.71000e+00 2.06 15.68 0.00
## Avg_Utilization_Ratio 1.00000e+00 0.72 -0.80 0.00В данном пункте была использована описательная статистика для всех переменных. Так были рассмотрены: количество наблюдений, среднее, усеченное среднее, среднеквадратично отклонение, среднее абсолютное отклонение, медиана, min и max, стандартная ошибка, размах, ассиметрия и эксцесс.
Анализ на нормальное распределение данных
Гистограммы
hist1 <-ggplot(clients_database1, aes(x = Customer_Age)) +
geom_histogram(binwidth = 1, fill = "blue", color = "white", alpha = 0.7) +
ggtitle("Распределение возраста клиентов") +
xlab("Возраст") +
ylab("Частота")+
theme(plot.title = element_text (hjust = 0.5 )) +
theme(plot.title = element_text(size = 7)) +
theme(axis.text.x= element_text(size =5),
axis.text.y= element_text(size =5)) +
theme(axis.title.x = element_text(size = 6),
axis.title.y = element_text(size = 6))
hist2 <-ggplot(clients_database1, aes(x = Avg_Open_To_Buy)) +
geom_histogram(binwidth = 500, fill = "blue", color = "white", alpha = 0.7) +
ggtitle("Распределение доступности денег к покупкам") +
xlab("Доступность денег к покупке") +
ylab("Частота")+
theme(plot.title = element_text (hjust = 0.5 )) +
theme(plot.title = element_text(size = 7)) +
theme(axis.text.x= element_text(size =5),
axis.text.y= element_text(size =5)) +
theme(axis.title.x = element_text(size = 6),
axis.title.y = element_text(size = 6))
hist3 <-ggplot(clients_database1, aes(x = Credit_Limit)) +
geom_histogram(binwidth = 500, fill = "blue", color = "white", alpha = 0.7) +
ggtitle("Распределение кредитного лимита клиентов") +
xlab("Кредитный лимит") +
ylab("Частота")+
theme(plot.title = element_text (hjust = 0.5 )) +
theme(plot.title = element_text(size = 7)) +
theme(axis.text.x= element_text(size =5),
axis.text.y= element_text(size =5)) +
theme(axis.title.x = element_text(size = 6),
axis.title.y = element_text(size = 6))
hist4 <-ggplot(clients_database1, aes(x = Total_Revolving_Bal)) +
geom_histogram(binwidth = 50, fill = "blue", color = "white", alpha = 0.7) +
ggtitle("Распределение по сумме невыплаченного кредита") +
xlab("Сумма невыплаченного кредита") +
ylab("Частота")+
theme(plot.title = element_text (hjust = 0.5 )) +
theme(plot.title = element_text(size = 7)) +
theme(axis.text.x= element_text(size =5),
axis.text.y= element_text(size =5)) +
theme(axis.title.x = element_text(size = 6),
axis.title.y = element_text(size = 6))
hist5 <-ggplot(clients_database1, aes(x = Total_Trans_Amt)) +
geom_histogram(binwidth = 700, fill = "blue", color = "white", alpha = 0.7) +
ggtitle("Распределение по сумме транзакций (12 мес.)") +
xlab("Сумма транзакций") +
ylab("Частота")+
theme(plot.title = element_text (hjust = 0.5 )) +
theme(plot.title = element_text(size = 7)) +
theme(axis.text.x= element_text(size =5),
axis.text.y= element_text(size =5)) +
theme(axis.title.x = element_text(size = 6),
axis.title.y = element_text(size = 6))
hist6 <-ggplot(clients_database1, aes(x = Total_Trans_Ct)) +
geom_histogram(binwidth = 5, fill = "blue", color = "white", alpha = 0.7) +
ggtitle("Распределение по сумме транзакций") +
xlab("Сумма транзакций") +
ylab("Частота")+
theme(plot.title = element_text (hjust = 0.5 )) +
theme(plot.title = element_text(size = 7)) +
theme(axis.text.x= element_text(size =5),
axis.text.y= element_text(size =5)) +
theme(axis.title.x = element_text(size = 6),
axis.title.y = element_text(size = 6))
hist7 <-ggplot(clients_database1, aes(x = Total_Ct_Chng_Q4_Q1)) +
geom_histogram(binwidth = 0.05, fill = "blue", color = "white", alpha = 0.7) +
ggtitle("Распределение по сумме транзакций (4Q:1Q)") +
xlab("Отношение") +
ylab("Частота")+
theme(plot.title = element_text (hjust = 0.5 )) +
theme(plot.title = element_text(size = 7)) +
theme(axis.text.x= element_text(size =5),
axis.text.y= element_text(size =5)) +
theme(axis.title.x = element_text(size = 6),
axis.title.y = element_text(size = 6))
hist8 <-ggplot(clients_database1, aes(x = Avg_Utilization_Ratio)) +
geom_histogram(binwidth = 0.05, fill = "blue", color = "white", alpha = 0.7) +
ggtitle("Среднее использование карты (потраченные/доступные)") +
xlab("Отношение") +
ylab("Частота")+
theme(plot.title = element_text (hjust = 0.5 )) +
theme(plot.title = element_text(size = 7)) +
theme(axis.text.x= element_text(size =5),
axis.text.y= element_text(size =5)) +
theme(axis.title.x = element_text(size = 6),
axis.title.y = element_text(size = 6))
grid.arrange(hist1, hist2, hist3, hist4,hist5,hist6, hist7, hist8, ncol=2)
Были построены и рассмотрены гистограммы некоторых наблюдений. На гистограммах, приведенных выше, можно заметить абсолютно разные распределения. Так, например,“Total_Ct_Chng_Q4_Q1”, предположительно, соответствует нормальному распределению. Гистограмма “Customer_Age” также напоминает вид нормального распределения, но тем же временем имеет некоторые сходства с гребенчатым. “Credit_Limit”, возможно, можно отнести к усеченному виду распределения, в то время как гистограмма “Avg_Open_To_Buy”, похожая на “Credit_Limit”, скорее всего, относится к усеченному распределению. Остальные гистограммы можно отнести к распределению типа плато, с пиком на краю и т.д.
QQ-plot
qqnorm(clients_database1$Customer_Age, main = "Q-Q график (Customer_age)",xlab = "Теоретические квантили", ylab = "Фактические квантили", col = "lightblue"); qqline(clients_database1$Customer_Age)
qqnorm(clients_database1$Months_on_book, main = "Q-Q график (Months_on_book)",xlab = "Теоретические квантили", ylab = "Фактические квантили", col = "lightblue"); qqline(clients_database1$Months_on_book) 
qqnorm(clients_database1$Credit_Limit, main = "Q-Q график (Credit_Limit)",xlab = "Теоретические квантили", ylab = "Фактические квантили", col = "lightblue"); qqline(clients_database1$Credit_Limit)
qqnorm(clients_database1$Total_Revolving_Bal, main = "Q-Q график (Total_Revolving_Bal)",xlab = "Теоретические квантили", ylab = "Фактические квантили", col = "lightblue"); qqline(clients_database1$Total_Revolving_Bal) 
qqnorm(clients_database1$Avg_Open_To_Buy, main = "Q-Q график (Avg_Open_To_Buy)",xlab = "Теоретические квантили", ylab = "Фактические квантили", col = "lightblue"); qqline(clients_database1$Avg_Open_To_Buy) 
qqnorm(clients_database1$Total_Trans_Amt, main = "Q-Q график (Total_Trans_Amt)",xlab = "Теоретические квантили", ylab = "Фактические квантили", col = "lightblue"); qqline(clients_database1$Total_Trans_Amt)
qqnorm(clients_database1$Total_Trans_Ct, main = "Q-Q график (Total_Trans_Ct)",xlab = "Теоретические квантили", ylab = "Фактические квантили", col = "lightblue"); qqline(clients_database1$Total_Trans_Ct) 
qqnorm(clients_database1$Total_Ct_Chng_Q4_Q1, main = "Q-Q график (Total_Ct_Chng_Q4_Q1)",xlab = "Теоретические квантили", ylab = "Фактические квантили", col = "lightblue"); qqline(clients_database1$Total_Ct_Chng_Q4_Q1) 
qqnorm(clients_database1$Avg_Utilization_Ratio, main = "Q-Q график (Avg_Utilization_Ratio)",xlab = "Теоретические квантили", ylab = "Фактические квантили", col = "lightblue"); qqline(clients_database1$Avg_Utilization_Ratio) 
Также, для проверки на нормальность распределения данных, были построены графики типа QQ-plot. Так, наложив линию тренда нормального распределения, можно заметить, что абсолютно все точки наблюдений, предположительно, не соответствуют нормальному распределению. Отдаленно, нормальное распределение напоминает переменная “Customer_Age”, хотя на хвостах по обе сторны имеются отелонения от прямой линии. Аналогично и “Total_Ct_Chng_Q4_Q1”: с самого начала наблюдения соответствуют нормальному распределению, а в хвосте- очевидное отклонение. Остальные же переменные абсолютно не соответствуют нормальному распределению.
Тест Колмогорова-Смирнова
ks.test(clients_database1$Customer_Age, "pnorm")##
## Asymptotic one-sample Kolmogorov-Smirnov test
##
## data: clients_database1$Customer_Age
## D = 1, p-value < 2.2e-16
## alternative hypothesis: two-sidedks.test(clients_database1$Months_on_book, "pnorm")##
## Asymptotic one-sample Kolmogorov-Smirnov test
##
## data: clients_database1$Months_on_book
## D = 1, p-value < 2.2e-16
## alternative hypothesis: two-sidedks.test(clients_database1$Credit_Limit, "pnorm")##
## Asymptotic one-sample Kolmogorov-Smirnov test
##
## data: clients_database1$Credit_Limit
## D = 1, p-value < 2.2e-16
## alternative hypothesis: two-sidedks.test(clients_database1$Total_Revolving_Bal, "pnorm")##
## Asymptotic one-sample Kolmogorov-Smirnov test
##
## data: clients_database1$Total_Revolving_Bal
## D = 0.7561, p-value < 2.2e-16
## alternative hypothesis: two-sidedks.test(clients_database1$Avg_Open_To_Buy, "pnorm")##
## Asymptotic one-sample Kolmogorov-Smirnov test
##
## data: clients_database1$Avg_Open_To_Buy
## D = 0.9999, p-value < 2.2e-16
## alternative hypothesis: two-sidedks.test(clients_database1$Total_Trans_Amt, "pnorm")##
## Asymptotic one-sample Kolmogorov-Smirnov test
##
## data: clients_database1$Total_Trans_Amt
## D = 1, p-value < 2.2e-16
## alternative hypothesis: two-sidedks.test(clients_database1$Total_Trans_Ct, "pnorm")##
## Asymptotic one-sample Kolmogorov-Smirnov test
##
## data: clients_database1$Total_Trans_Ct
## D = 1, p-value < 2.2e-16
## alternative hypothesis: two-sidedks.test(clients_database1$Total_Ct_Chng_Q4_Q1, "pnorm")##
## Asymptotic one-sample Kolmogorov-Smirnov test
##
## data: clients_database1$Total_Ct_Chng_Q4_Q1
## D = 0.59814, p-value < 2.2e-16
## alternative hypothesis: two-sidedks.test(clients_database1$Avg_Utilization_Ratio, "pnorm")##
## Asymptotic one-sample Kolmogorov-Smirnov test
##
## data: clients_database1$Avg_Utilization_Ratio
## D = 0.5, p-value < 2.2e-16
## alternative hypothesis: two-sidedИ, наконец, мы провели тест Калмогорова-Смирнова, где H0 соответствует нормальному распределению, H1- ненормальному. По данным теста, в котором p-value всех переменных < 0.05, то можно сделать вывод, что все данные не сооветствуют нормальному распределению.
Корреляционый анализ и корреляционная матрица
cor_clients_database1 <-cor(clients_database1)
round(cor_clients_database1, 2)## CLIENTNUM Attrition_Flag Customer_Age Gender
## CLIENTNUM 1.00 0.05 0.01 0.02
## Attrition_Flag 0.05 1.00 -0.02 0.04
## Customer_Age 0.01 -0.02 1.00 -0.02
## Gender 0.02 0.04 -0.02 1.00
## Dependent_count 0.01 -0.02 -0.12 0.00
## Education_Level 0.00 -0.01 0.00 0.00
## Marital_Status 0.00 -0.02 -0.01 0.00
## Income_Category -0.03 -0.02 -0.01 -0.54
## Card_Category 0.01 0.01 -0.02 0.08
## Months_on_book 0.13 -0.01 0.79 -0.01
## Total_Relationship_Count 0.01 0.15 -0.01 0.00
## Months_Inactive_12_mon 0.01 -0.15 0.05 -0.01
## Contacts_Count_12_mon 0.01 -0.20 -0.02 0.04
## Credit_Limit 0.01 0.02 0.00 0.42
## Total_Revolving_Bal 0.00 0.26 0.01 0.03
## Avg_Open_To_Buy 0.01 0.00 0.00 0.42
## Total_Amt_Chng_Q4_Q1 0.02 0.13 -0.06 0.03
## Total_Trans_Amt -0.02 0.17 -0.05 0.02
## Total_Trans_Ct 0.00 0.37 -0.07 -0.07
## Total_Ct_Chng_Q4_Q1 0.01 0.29 -0.01 -0.01
## Avg_Utilization_Ratio 0.00 0.18 0.01 -0.26
## Dependent_count Education_Level Marital_Status
## CLIENTNUM 0.01 0.00 0.00
## Attrition_Flag -0.02 -0.01 -0.02
## Customer_Age -0.12 0.00 -0.01
## Gender 0.00 0.00 0.00
## Dependent_count 1.00 0.00 0.00
## Education_Level 0.00 1.00 0.01
## Marital_Status 0.00 0.01 1.00
## Income_Category -0.04 -0.01 0.01
## Card_Category 0.02 -0.01 0.04
## Months_on_book -0.10 0.00 -0.01
## Total_Relationship_Count -0.04 0.01 -0.02
## Months_Inactive_12_mon -0.01 -0.01 0.00
## Contacts_Count_12_mon -0.04 0.01 0.00
## Credit_Limit 0.07 0.00 0.03
## Total_Revolving_Bal 0.00 0.01 -0.03
## Avg_Open_To_Buy 0.07 0.00 0.03
## Total_Amt_Chng_Q4_Q1 -0.04 0.01 -0.04
## Total_Trans_Amt 0.03 0.02 0.04
## Total_Trans_Ct 0.05 0.00 0.08
## Total_Ct_Chng_Q4_Q1 0.01 0.01 0.00
## Avg_Utilization_Ratio -0.04 0.01 -0.03
## Income_Category Card_Category Months_on_book
## CLIENTNUM -0.03 0.01 0.13
## Attrition_Flag -0.02 0.01 -0.01
## Customer_Age -0.01 -0.02 0.79
## Gender -0.54 0.08 -0.01
## Dependent_count -0.04 0.02 -0.10
## Education_Level -0.01 -0.01 0.00
## Marital_Status 0.01 0.04 -0.01
## Income_Category 1.00 -0.05 -0.02
## Card_Category -0.05 1.00 -0.01
## Months_on_book -0.02 -0.01 1.00
## Total_Relationship_Count 0.01 -0.07 -0.01
## Months_Inactive_12_mon 0.02 -0.02 0.07
## Contacts_Count_12_mon -0.02 0.00 -0.01
## Credit_Limit -0.23 0.48 0.01
## Total_Revolving_Bal -0.03 0.02 0.01
## Avg_Open_To_Buy -0.22 0.48 0.01
## Total_Amt_Chng_Q4_Q1 0.00 0.00 -0.05
## Total_Trans_Amt -0.01 0.18 -0.04
## Total_Trans_Ct 0.03 0.12 -0.05
## Total_Ct_Chng_Q4_Q1 0.01 0.00 -0.01
## Avg_Utilization_Ratio 0.12 -0.21 -0.01
## Total_Relationship_Count Months_Inactive_12_mon
## CLIENTNUM 0.01 0.01
## Attrition_Flag 0.15 -0.15
## Customer_Age -0.01 0.05
## Gender 0.00 -0.01
## Dependent_count -0.04 -0.01
## Education_Level 0.01 -0.01
## Marital_Status -0.02 0.00
## Income_Category 0.01 0.02
## Card_Category -0.07 -0.02
## Months_on_book -0.01 0.07
## Total_Relationship_Count 1.00 0.00
## Months_Inactive_12_mon 0.00 1.00
## Contacts_Count_12_mon 0.06 0.03
## Credit_Limit -0.07 -0.02
## Total_Revolving_Bal 0.01 -0.04
## Avg_Open_To_Buy -0.07 -0.02
## Total_Amt_Chng_Q4_Q1 0.05 -0.03
## Total_Trans_Amt -0.35 -0.04
## Total_Trans_Ct -0.24 -0.04
## Total_Ct_Chng_Q4_Q1 0.04 -0.04
## Avg_Utilization_Ratio 0.07 -0.01
## Contacts_Count_12_mon Credit_Limit Total_Revolving_Bal
## CLIENTNUM 0.01 0.01 0.00
## Attrition_Flag -0.20 0.02 0.26
## Customer_Age -0.02 0.00 0.01
## Gender 0.04 0.42 0.03
## Dependent_count -0.04 0.07 0.00
## Education_Level 0.01 0.00 0.01
## Marital_Status 0.00 0.03 -0.03
## Income_Category -0.02 -0.23 -0.03
## Card_Category 0.00 0.48 0.02
## Months_on_book -0.01 0.01 0.01
## Total_Relationship_Count 0.06 -0.07 0.01
## Months_Inactive_12_mon 0.03 -0.02 -0.04
## Contacts_Count_12_mon 1.00 0.02 -0.05
## Credit_Limit 0.02 1.00 0.04
## Total_Revolving_Bal -0.05 0.04 1.00
## Avg_Open_To_Buy 0.03 1.00 -0.05
## Total_Amt_Chng_Q4_Q1 -0.02 0.01 0.06
## Total_Trans_Amt -0.11 0.17 0.06
## Total_Trans_Ct -0.15 0.08 0.06
## Total_Ct_Chng_Q4_Q1 -0.09 0.00 0.09
## Avg_Utilization_Ratio -0.06 -0.48 0.62
## Avg_Open_To_Buy Total_Amt_Chng_Q4_Q1 Total_Trans_Amt
## CLIENTNUM 0.01 0.02 -0.02
## Attrition_Flag 0.00 0.13 0.17
## Customer_Age 0.00 -0.06 -0.05
## Gender 0.42 0.03 0.02
## Dependent_count 0.07 -0.04 0.03
## Education_Level 0.00 0.01 0.02
## Marital_Status 0.03 -0.04 0.04
## Income_Category -0.22 0.00 -0.01
## Card_Category 0.48 0.00 0.18
## Months_on_book 0.01 -0.05 -0.04
## Total_Relationship_Count -0.07 0.05 -0.35
## Months_Inactive_12_mon -0.02 -0.03 -0.04
## Contacts_Count_12_mon 0.03 -0.02 -0.11
## Credit_Limit 1.00 0.01 0.17
## Total_Revolving_Bal -0.05 0.06 0.06
## Avg_Open_To_Buy 1.00 0.01 0.17
## Total_Amt_Chng_Q4_Q1 0.01 1.00 0.04
## Total_Trans_Amt 0.17 0.04 1.00
## Total_Trans_Ct 0.07 0.01 0.81
## Total_Ct_Chng_Q4_Q1 -0.01 0.38 0.09
## Avg_Utilization_Ratio -0.54 0.04 -0.08
## Total_Trans_Ct Total_Ct_Chng_Q4_Q1
## CLIENTNUM 0.00 0.01
## Attrition_Flag 0.37 0.29
## Customer_Age -0.07 -0.01
## Gender -0.07 -0.01
## Dependent_count 0.05 0.01
## Education_Level 0.00 0.01
## Marital_Status 0.08 0.00
## Income_Category 0.03 0.01
## Card_Category 0.12 0.00
## Months_on_book -0.05 -0.01
## Total_Relationship_Count -0.24 0.04
## Months_Inactive_12_mon -0.04 -0.04
## Contacts_Count_12_mon -0.15 -0.09
## Credit_Limit 0.08 0.00
## Total_Revolving_Bal 0.06 0.09
## Avg_Open_To_Buy 0.07 -0.01
## Total_Amt_Chng_Q4_Q1 0.01 0.38
## Total_Trans_Amt 0.81 0.09
## Total_Trans_Ct 1.00 0.11
## Total_Ct_Chng_Q4_Q1 0.11 1.00
## Avg_Utilization_Ratio 0.00 0.07
## Avg_Utilization_Ratio
## CLIENTNUM 0.00
## Attrition_Flag 0.18
## Customer_Age 0.01
## Gender -0.26
## Dependent_count -0.04
## Education_Level 0.01
## Marital_Status -0.03
## Income_Category 0.12
## Card_Category -0.21
## Months_on_book -0.01
## Total_Relationship_Count 0.07
## Months_Inactive_12_mon -0.01
## Contacts_Count_12_mon -0.06
## Credit_Limit -0.48
## Total_Revolving_Bal 0.62
## Avg_Open_To_Buy -0.54
## Total_Amt_Chng_Q4_Q1 0.04
## Total_Trans_Amt -0.08
## Total_Trans_Ct 0.00
## Total_Ct_Chng_Q4_Q1 0.07
## Avg_Utilization_Ratio 1.00library(corrplot)
corrplot(cor_clients_database1, method = "color",tl.cex = 0.7)
На основе корреляционного теста и построенной выше корреляционной матрицы можно проследить степень взаимосвязи или же тесноты между всеми переменными. Вместо категориальных переменных были использованы их числовые значения, которые начинаются с 0. Альтернативой может быть замена категориальных переменных на dummies (фиктивные переменные). Так, рассмотрев визуальный вариант в виде матрицы,значения на главной диагонали который равны 1. Можно увидеть следующее:
1) Между "Credit_Limit" и "Avg_Open_To_Buy" присутствует высокая степень
положительной корреляции (связь между кредитным лимитом и средней суммы
денег для покупок) и равня 1.
2) Высокая степень положительной взаимосвязи, равная 0.81, сущетсвует
между "Total_Trans_Amt" и "Total_Trans_Ct" (Сумма транзакций за 12 мес.
и общая сумма транзакций).
3) Присутсвует нормальная положительная взаимосвязь
"Avg_Utilization_Ratio" (Среднее использование карты (потраченные/
доступные деньги)) и "Total_Revolving_Bal" (Невыплаченная сумма кредита)
(0,62) и нормальная отрицательная взаимосвязь "Avg_Utilization_Ratio" и
"Avg_Open_To_Buy" (средняя сумма денег для покупок) (-0.54).
4) Также можно отметить нормальную отрицательную связь между полом
клиента и категорией дохода ("Gender" и "Income_Category"), равную -0.54
и относительно высокую положительную связь между периодом обслуживания
клиентов и возрастом клиентов ("Months_On_Book" и "Customer_Age), равную
0.79.
5) Все остальные степени связи между переменными слабо значимы либо же -
вообще незначимы.Кластеризация
Определение кол-ва кластеров (K Means Clustering)
library(factoextra)
library(cluster)
client_database3 = subset(clients_database1, select = - c(CLIENTNUM))
fviz_nbclust(client_database3 ,FUNcluster = kmeans,method = "silhouette") +
ggtitle("Оптимальное кол-во кластеров") +
xlab("Количество кластеров (k)") +
ylab("Cредняя ширина силуэта")
В данном анализе была проведена кластеризация и выделены группы наблюдений переменных с похожими чертами. Для начала нужно провести масштабирование (scale), чтобы все переменные имели среднее значение 0 и стандартное отклонение 1 для последующего применения K-means clustering. Затем проводится определение оптимального количества класетров. В научной литературе существует несколько способовсделать это. Самые известные: метод “локтя” и метод “силуэта”. Также данные методы являются очень популярными в среде “R”. Так, было определено оптимальное количество посредством именно метода “силуэта”. На графике, приведенном выше, можно заметить, что оптимальное количество равно двум.
Кластеризация
set.seed(123)
kmeans_result <- kmeans(client_database3, centers = 2)
clients_database1$cluster <- kmeans_result$cluster
fviz_cluster(kmeans_result, data = client_database3, repel = FALSE, geom = "point", show.clust.cent = TRUE,
ellipse.type = "convex", ggtheme = theme_minimal(),
main = "Factor map") +
ggtitle("График кластеров")+
theme(plot.title = element_text (hjust = 0.5 ))
На данном этапе была проведена, непосредственно, сама кластеризация методом k-средних (k-means), который является наиболее популярных методов. Так, на графике кластеров можно заметить 2 кластера, синий и красный, внутри которых находится большое количество значений и наблюдений. Также есть место пересечения кластеров, значения в котором являются общими для обоих кластеров, т.е. имеется взаимосвязь наблюдений переменных между двумя группами. Скорее всего, данные точки на персечении кластеров - категориальные переменные, т.е.: “Attrition_Flag”, “Gender”, “Education_Level”, “Income_Category”, “Marital_Status” и “Card_Category”.
Профилирование кластеров
profiles <- clients_database1 %>%
group_by(cluster) %>%
summarise(
AvgCustomerAge = mean(Customer_Age, na.rm = TRUE),
AvgDependentcount = mean(Dependent_count, na.rm = TRUE),
AvgMonthsonbook = mean(Months_on_book, na.rm = TRUE),
AvgTotalRelationshipCount = mean(Total_Relationship_Count, na.rm = TRUE),
AvgMonthsInactive12mon = mean(Months_Inactive_12_mon, na.rm = TRUE),
AvgContactsCount12mon = mean(Contacts_Count_12_mon, na.rm = TRUE),
AvgCreditLimit = mean(Credit_Limit, na.rm = TRUE),
AvgTotalRevolvingBal = mean(Total_Revolving_Bal, na.rm = TRUE),
AvgTotalAmtChngQ4Q1 = mean(Total_Amt_Chng_Q4_Q1, na.rm = TRUE),
AvgTotalTransAmt = mean(Total_Trans_Amt, na.rm = TRUE),
AvgTotalTransCt = mean(Total_Trans_Ct, na.rm = TRUE),
AvgTotalCtChngQ4Q1 = mean(Total_Ct_Chng_Q4_Q1, na.rm = TRUE),
AvgAvgUtilizationRatio = mean(Avg_Utilization_Ratio, na.rm = TRUE)
)
print(profiles)## # A tibble: 2 × 14
## cluster AvgCustomerAge AvgDependentcount AvgMonthsonbook
## <int> <dbl> <dbl> <dbl>
## 1 1 46.3 2.52 36.0
## 2 2 46.3 2.31 35.9
## # ℹ 10 more variables: AvgTotalRelationshipCount <dbl>,
## # AvgMonthsInactive12mon <dbl>, AvgContactsCount12mon <dbl>,
## # AvgCreditLimit <dbl>, AvgTotalRevolvingBal <dbl>,
## # AvgTotalAmtChngQ4Q1 <dbl>, AvgTotalTransAmt <dbl>, AvgTotalTransCt <dbl>,
## # AvgTotalCtChngQ4Q1 <dbl>, AvgAvgUtilizationRatio <dbl>Затем было проведено профилирование кластеров, чтобы определить по какому все-таки принципу совокупность значений переменных была разделена на 2 данные группы. Так, были расчитаны средние по двум кластерам, и на основе этого, можно предположить, что они были разделены по “Credit_Limit”, т.е. кредитным лимитам, т.к. между средними двух кластеров по данной переменной наблюдается наибольшее различие: 23488.303 и 4663.197.
Визуализация перемнных для каждого кластера
ai1 <-ggplot(clients_database1, aes(x = Customer_Age, fill = as.factor(cluster))) +
geom_histogram(position = "identity", alpha = 0.5, bins = 30) +
scale_fill_manual(values = c("red", "lightblue")) +
ggtitle("Распределение возраста клиентов по кластерам") +
xlab("Возраст клиента") +
ylab("Кол-во") +
theme(plot.title = element_text (hjust = 0.5 )) +
theme(plot.title = element_text(size = 5)) +
theme(axis.text.x= element_text(size =3),
axis.text.y= element_text(size =3)) +
theme(axis.title.x = element_text(size = 5),
axis.title.y = element_text(size = 5))
ai2 <-ggplot(clients_database1, aes(x = Avg_Open_To_Buy, fill = as.factor(cluster))) +
geom_histogram(position = "identity", alpha = 0.5, bins = 30) +
scale_fill_manual(values = c("red", "lightblue")) +
ggtitle("Распределение доступности денег к покупкам по кластерам") +
xlab("Деньги к покупке") +
ylab("Кол-во") +
theme(plot.title = element_text (hjust = 0.5 )) +
theme(plot.title = element_text(size = 5)) +
theme(axis.text.x= element_text(size =3),
axis.text.y= element_text(size =3)) +
theme(axis.title.x = element_text(size = 5),
axis.title.y = element_text(size = 5))
ai3 <-ggplot(clients_database1, aes(x = Credit_Limit, fill = as.factor(cluster))) +
geom_histogram(position = "identity", alpha = 0.5, bins = 30) +
scale_fill_manual(values = c("red", "lightblue")) +
ggtitle("Распределение кредитного лимита клиентов банка по кластерам") +
xlab("Кредитный лимит клиента") +
ylab("Кол-во") +
theme(plot.title = element_text (hjust = 0.5 )) +
theme(plot.title = element_text(size = 5)) +
theme(axis.text.x= element_text(size =3),
axis.text.y= element_text(size =3)) +
theme(axis.title.x = element_text(size = 5),
axis.title.y = element_text(size = 5))
ai4 <-ggplot(clients_database1, aes(x = Total_Revolving_Bal, fill = as.factor(cluster))) +
geom_histogram(position = "identity", alpha = 0.5, bins = 30) +
scale_fill_manual(values = c("red", "lightblue")) +
ggtitle("Распределение сумм невыплченных кредитов") +
xlab("Невыплаченные кредиты") +
ylab("Кол-во") +
theme(plot.title = element_text (hjust = 0.5 )) +
theme(plot.title = element_text(size = 5)) +
theme(axis.text.x= element_text(size =3),
axis.text.y= element_text(size =3)) +
theme(axis.title.x = element_text(size = 5),
axis.title.y = element_text(size = 5))
grid.arrange(ai1, ai2, ai3, ai4, ncol=2)
На графиках распределения значений перемнных для каждого кластера,
можно заметить, что значения
некоторых переменных обоих кластеров, к примеру, возраста клиентов и
сумм невыплаченных кредитов полностью совпадают (значения кластера 1
находится внутри значений кластера 2). В то же время, значения доступных
денег к покупкам и кредитных лимитов (предположительно по ним произошло
деление по кластерам) лишь частично пересекаются и имеют общее
распределение.
Линейная регрессия для каждого кластера
clients_database4 = subset(clients_database1, select = - c(CLIENTNUM))
models <- list()
summaries <- list()
for (i in unique(clients_database4$cluster)){
cluster_data <- clients_database4[clients_database4$cluster == i, ]
intercept_only <- lm(Credit_Limit ~ 1, data=cluster_data)
all <- lm(Credit_Limit ~ ., data=cluster_data)
model <- step(intercept_only, direction='forward', scope= formula (all), trace=0)
models[[i]] <- model
summaries[[i]] <- summary(model)
}
summaries[[1]]##
## Call:
## lm(formula = Credit_Limit ~ Avg_Open_To_Buy + Total_Revolving_Bal +
## Total_Amt_Chng_Q4_Q1 + Total_Ct_Chng_Q4_Q1 + Total_Relationship_Count +
## Months_on_book + Dependent_count, data = cluster_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -7.480e-11 -1.000e-11 -8.000e-13 7.300e-12 3.589e-09
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.108e-11 1.753e-11 6.320e-01 0.5276
## Avg_Open_To_Buy 1.000e+00 2.979e-16 3.357e+15 < 2e-16 ***
## Total_Revolving_Bal 1.000e+00 2.571e-15 3.889e+14 < 2e-16 ***
## Total_Amt_Chng_Q4_Q1 6.665e-11 1.006e-11 6.622e+00 4.68e-11 ***
## Total_Ct_Chng_Q4_Q1 -2.224e-11 9.710e-12 -2.290e+00 0.0221 *
## Total_Relationship_Count 2.270e-12 1.301e-12 1.744e+00 0.0813 .
## Months_on_book 5.300e-13 2.942e-13 1.801e+00 0.0718 .
## Dependent_count 2.416e-12 1.660e-12 1.456e+00 0.1457
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.679e-11 on 1759 degrees of freedom
## Multiple R-squared: 1, Adjusted R-squared: 1
## F-statistic: 1.646e+30 on 7 and 1759 DF, p-value: < 2.2e-16summaries[[2]]##
## Call:
## lm(formula = Credit_Limit ~ Avg_Open_To_Buy + Total_Revolving_Bal +
## Total_Ct_Chng_Q4_Q1 + Total_Trans_Ct, data = cluster_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.674e-10 -2.400e-12 0.000e+00 2.000e-12 3.686e-09
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.730e-12 2.108e-12 2.718e+00 0.00658 **
## Avg_Open_To_Buy 1.000e+00 1.394e-16 7.174e+15 < 2e-16 ***
## Total_Revolving_Bal 1.000e+00 6.071e-16 1.647e+15 < 2e-16 ***
## Total_Ct_Chng_Q4_Q1 1.750e-11 2.060e-12 8.494e+00 < 2e-16 ***
## Total_Trans_Ct -5.144e-14 2.175e-14 -2.365e+00 0.01805 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4.466e-11 on 8355 degrees of freedom
## Multiple R-squared: 1, Adjusted R-squared: 1
## F-statistic: 1.297e+31 on 4 and 8355 DF, p-value: < 2.2e-16models[[1]]$anova## Step Df Deviance Resid. Df Resid. Dev AIC
## 1 NA NA 1766 8.681352e+10 31295.55
## 2 + Avg_Open_To_Buy -1 8.566528e+10 1765 1.148233e+09 23654.33
## 3 + Total_Revolving_Bal -1 1.148233e+09 1764 1.362807e-17 -81826.31
## 4 + Total_Amt_Chng_Q4_Q1 -1 2.775166e-19 1763 1.335055e-17 -81860.67
## 5 + Total_Ct_Chng_Q4_Q1 -1 3.782020e-20 1762 1.331273e-17 -81863.68
## 6 + Total_Relationship_Count -1 2.516062e-20 1761 1.328757e-17 -81865.02
## 7 + Months_on_book -1 2.094875e-20 1760 1.326662e-17 -81865.81
## 8 + Dependent_count -1 1.596009e-20 1759 1.325066e-17 -81865.94models[[2]]$anova## Step Df Deviance Resid. Df Resid. Dev AIC
## 1 NA NA 8359 1.035204e+11 136536.0
## 2 + Avg_Open_To_Buy -1 9.805516e+10 8358 5.465243e+09 111948.3
## 3 + Total_Revolving_Bal -1 5.465243e+09 8357 1.681285e-17 -398394.8
## 4 + Total_Ct_Chng_Q4_Q1 -1 1.362035e-19 8356 1.667664e-17 -398460.8
## 5 + Total_Trans_Ct -1 1.115750e-20 8355 1.666548e-17 -398464.4models[[1]]$coefficients## (Intercept) Avg_Open_To_Buy Total_Revolving_Bal
## 1.107776e-11 1.000000e+00 1.000000e+00
## Total_Amt_Chng_Q4_Q1 Total_Ct_Chng_Q4_Q1 Total_Relationship_Count
## 6.664730e-11 -2.223541e-11 2.269846e-12
## Months_on_book Dependent_count
## 5.299864e-13 2.415812e-12models[[2]]$coefficients## (Intercept) Avg_Open_To_Buy Total_Revolving_Bal Total_Ct_Chng_Q4_Q1
## 5.729537e-12 1.000000e+00 1.000000e+00 1.749931e-11
## Total_Trans_Ct
## -5.144460e-14library(car)
library(lmtest)
vif(models[[1]])## Avg_Open_To_Buy Total_Revolving_Bal Total_Amt_Chng_Q4_Q1
## 1.016956 1.008635 1.146168
## Total_Ct_Chng_Q4_Q1 Total_Relationship_Count Months_on_book
## 1.158612 1.019979 1.016647
## Dependent_count
## 1.015563vif(models[[2]])## Avg_Open_To_Buy Total_Revolving_Bal Total_Ct_Chng_Q4_Q1 Total_Trans_Ct
## 1.020494 1.030524 1.024497 1.018535bptest(models[[1]], data = clients_database4)##
## studentized Breusch-Pagan test
##
## data: models[[1]]
## BP = 45.661, df = 7, p-value = 1.017e-07bptest(models[[2]], data = clients_database4)##
## studentized Breusch-Pagan test
##
## data: models[[2]]
## BP = 51.583, df = 4, p-value = 1.686e-10Также на основе данных кластеров, можно построить модель регрессии, например - линейной. Так, для этой цели был использован метод пошаговой регрессии. Цель пошаговой регрессии состоит в построении регрессионной модели, включающей все переменные-предикторы, которые статистически значимы и связаны с зависимой переменной.Также, стоит отметить, что был применен метод подбора, начиная - с одной константы, заканчивая- набором всех переменных. Т.е. от наименьшего - к большему. Команда “trace=0” скрывает подбор разных вариаций модели, и по итогу отображается только одна - самая наилучшая, оцененная с наименьшим критерием “AIC”. Так, можно заметить, что для первого кластера были выбраны следующие переменные, включая константу: “Avg_Open_To_Buy”, “Total_Revolving_Bal”, “Total_Amt_Chng_Q4_Q1”, “Total_Ct_Chng_Q4_Q1”, “Total_Relationship_Count”, “Months_on_book” и “Dependent_count”. Для второго, включая константу: “Avg_Open_To_Buy”, “Total_Revolving_Bal”, “Total_Ct_Chng_Q4_Q1”, “Total_Trans_Ct”. Все коэффициенты для обоих кластеров указаны выше. P-value всех переменных указывает на то, что они все статистически значимые как в 1 кластере, так и во втором (в R принцип отличается от других статистических программ. Здесь звездочки между различными p-value указывают на диапазон, в котором переменная является значимой, например: *** - [0, 0,001], ** - (0,001, 0,01] и т.п). Аналогично и с F-statistica, p-value которой меньше 0.05, что означает, что уравнение, в целом, значимо. Множественные коэффициенты детерминации равны 1, может и с небольшой погрешностью, и значат, что присутствует сильная линейная зависимость. Значения коэффициентов VIF находятся близко 1, и, скорее всего, мультиколлинеарность между регрессорвами отстутствует. Тест Бреуша-Пагана на гомоскедастичность кластеров указывает на то, что как и в первой, так и во второй модели прсутствует гетероскедастичность (p-value моделей < 0.05). Так данную проблему можно решить с помощью различных методов, как нпример - обобщенный метод МНК. Также, в модель можно добавить dummies, т.е. преобразовать категориальные переменные - в бинарные. Все, конечно, зависит от конкретных поставленных целей.
Визуализация
Одиночные категориальные факторы
library(gridExtra)
clients_database.2 <- read_csv("C:\\Users\\Админ\\Downloads\\clientum.csv")
clients_database2 = subset(clients_database.2, select = - c(...1))
gga<-ggplot(clients_database2, aes(x = Attrition_Flag)) +
geom_bar(color="black",fill = "lightblue") +
ggtitle("Актуальные/ушедшие клиенты")+
labs(x = "Актуальный статус",
y = "Кол-во")+
theme(plot.title = element_text (hjust = 0.5 ))
ggb<-ggplot(clients_database2, aes(x = Gender)) +
geom_bar(color="black",fill = "lightblue") +
ggtitle("Пол клиентов")+
labs(x = "Пол",
y = "Кол-во")+
theme(plot.title = element_text (hjust = 0.5 ))
ggc<-ggplot(clients_database2, aes(x = Education_Level)) +
geom_bar(color="black",fill = "lightblue") +
ggtitle("Уровень образования клиентов")+
labs(x = "Уровень образования",
y = "Кол-во")+
theme(plot.title = element_text (hjust = 0.5 ))+
theme(axis.text = element_text(size = 5))
ggd<-ggplot(clients_database2, aes(x = Income_Category)) +
geom_bar(color="black",fill = "lightblue") +
ggtitle("Уровень дохода клиентов")+
labs(x = "Уровень дохода",
y = "Кол-во")+
theme(plot.title = element_text (hjust = 0.5 ))+
theme(axis.text = element_text(size = 5))
ggf<-ggplot(clients_database2, aes(x = Marital_Status)) +
geom_bar(color="black",fill = "lightblue") +
ggtitle("Брачный статус клиентов")+
labs(x = "Брачный статус",
y = "Кол-во")+
theme(plot.title = element_text (hjust = 0.5 ))
ggg<-ggplot(clients_database2, aes(x = Card_Category)) +
geom_bar(color="black",fill = "lightblue") +
ggtitle("Категория карты клиентов")+
labs(x = "Категория карты",
y = "Кол-во")+
theme(plot.title = element_text (hjust = 0.5 ))
grid.arrange(gga, ggb, ggc, ggd, ggf, ggg, ncol=2)
table(clients_database2$Attrition_Flag) ##
## Attrited Customer Existing Customer
## 1627 8500table(clients_database2$Gender)##
## F M
## 5358 4769table(clients_database2$Education_Level)##
## College Doctorate Graduate High School Post-Graduate
## 1013 451 3128 2013 516
## Uneducated Unknown
## 1487 1519table(clients_database2$Income_Category)##
## $120K + $40K - $60K $60K - $80K $80K - $120K Less than $40K
## 727 1790 1402 1535 3561
## Unknown
## 1112table(clients_database2$Marital_Status)##
## Divorced Married Single Unknown
## 748 4687 3943 749table(clients_database2$Card_Category)##
## Blue Gold Platinum Silver
## 9436 116 20 555 1) На первом графике заметно, что большинство клиентов являются
актуальными клиентами, которых в данный обслуживает банк, таковых -
8500. Ушедших - 1627.
2) Относительно пола, клиенты мужского и женского - практически равны,
тем не менее, клиенты жеского пола превалируют над мужчинами. Так, всего
в банке за все время обслуживалось 5358 женщин и 4769 мужчин.
3) По уровню образования доминирует группа- "выпускники" (3128). Затем
идут те, кто закончил среднюю школу (2013). Необразованные и клиенты c
неопределенным уровнем обраования практически равны (1487 и 1519).
Наименьшее число клиентов- со степенями докторов наук. Таковых - всего
лишь 451 клиент.
4) Большинство клиентов получает годовой уровень дохода ниже чем $40 тыс.
(3561 клиент). За ними по убыванию следуют клиенты, получающие $40-60
тыс. Таковых- 1790. Клиенты, получающие $60-80 тыс. и $80-120 тыс.
практически равны (1402 и 1535). И меньше всего клиентов с доходом
$120 тыс. (727 человек).
5) Клиентов, находящихся в браке, за все время было больше других групп
(4687). Меньше всего лиентов, которые разведены (748), правда, их на 1
человека меньше, чем клиентов с неизвестным статусом брака.
6) Большинство клиентов банка, которые когда-либо обслуживавшиеся в нем,
были держателями обычных синих карт. Таковых- 9436 человек. И наименьшая
группа- владельцы платиновых карт - 20 человек.Совместные категориальные факторы
ggh <-ggplot(data = clients_database2,
aes(x = Attrition_Flag,
fill = Gender)) +
geom_bar(position = position_dodge(preserve = "single"))+
labs(x = "Текущий статус клиента",
y = "Кол-во", title = "Текущий статус обслуживания относительно пола")+
theme(plot.title = element_text (hjust = 0.5 )) +
theme(plot.title = element_text(size = 5)) +
theme(axis.text.x= element_text(size =3),
axis.text.y= element_text(size =3)) +
theme(axis.title.x = element_text(size = 5),
axis.title.y = element_text(size = 5))
ggi <- ggplot(data = clients_database2,
aes(x = Education_Level,
fill = Gender)) +
geom_bar(position = position_dodge(preserve = "single"))+
labs(x = "Образование",
y = "Кол-во", title = "Уровень образования клиентов относительно пола")+
theme(plot.title = element_text (hjust = 0.5 )) +
theme(plot.title = element_text(size = 5)) +
theme(axis.text.x= element_text(size =3),
axis.text.y= element_text(size =3)) +
theme(axis.title.x = element_text(size = 5),
axis.title.y = element_text(size = 5))
ggj <- ggplot(data = clients_database2,
aes(x = Customer_Age,
fill = Gender)) +
geom_bar(position = position_dodge(preserve = "single"))+
labs(x = "Возраст",
y = "Кол-во", title = "Возраст клиента относительно пола")+
theme(plot.title = element_text (hjust = 0.5 )) +
theme(plot.title = element_text(size = 5)) +
theme(axis.text.x= element_text(size =3),
axis.text.y= element_text(size =3)) +
theme(axis.title.x = element_text(size = 5),
axis.title.y = element_text(size = 5))
ggk <-ggplot(data = clients_database2,
aes(x = Marital_Status,
fill = Gender)) +
geom_bar(position = position_dodge(preserve = "single"))+
labs(x = "Брачный статус",
y = "Кол-во", title = "Брачный статус клиентов относительно пола")+
theme(plot.title = element_text (hjust = 0.5 )) +
theme(plot.title = element_text(size = 5)) +
theme(axis.text.x= element_text(size =3),
axis.text.y= element_text(size =3)) +
theme(axis.title.x = element_text(size = 5),
axis.title.y = element_text(size = 5))
ggl <-ggplot(data = clients_database2,
aes(x = Income_Category,
fill = Gender)) +
geom_bar(position = position_dodge(preserve = "single"))+
labs(x = "Доход",
y = "Кол-во", title = "Доходы клиентов относительно пола")+
theme(plot.title = element_text (hjust = 0.5 )) +
theme(plot.title = element_text(size = 5)) +
theme(axis.text.x= element_text(size =3),
axis.text.y= element_text(size =3)) +
theme(axis.title.x = element_text(size = 5),
axis.title.y = element_text(size = 5))
ggm <-ggplot(data = clients_database2,
aes(x = Card_Category,
fill = Gender)) +
geom_bar(position = position_dodge(preserve = "single"))+
labs(x = "Вид карты",
y = "Кол-во", title = "Вид карты относительно пола")+
theme(plot.title = element_text (hjust = 0.5 )) +
theme(plot.title = element_text(size = 5)) +
theme(axis.text.x= element_text(size =3),
axis.text.y= element_text(size =3)) +
theme(axis.title.x = element_text(size = 5),
axis.title.y = element_text(size = 5))
grid.arrange(ggh, ggi, ggj, ggk, ggl, ggm, ncol = 2)
clients_database2%>%filter(Gender=="F")%>%count(Attrition_Flag)## # A tibble: 2 × 2
## Attrition_Flag n
## <chr> <int>
## 1 Attrited Customer 930
## 2 Existing Customer 4428clients_database2%>%filter(Gender=="M")%>%count(Attrition_Flag)## # A tibble: 2 × 2
## Attrition_Flag n
## <chr> <int>
## 1 Attrited Customer 697
## 2 Existing Customer 4072clients_database2%>%filter(Gender=="F")%>%count(Education_Level)## # A tibble: 7 × 2
## Education_Level n
## <chr> <int>
## 1 College 532
## 2 Doctorate 257
## 3 Graduate 1670
## 4 High School 1028
## 5 Post-Graduate 263
## 6 Uneducated 796
## 7 Unknown 812clients_database2%>%filter(Gender=="M")%>%count(Education_Level)## # A tibble: 7 × 2
## Education_Level n
## <chr> <int>
## 1 College 481
## 2 Doctorate 194
## 3 Graduate 1458
## 4 High School 985
## 5 Post-Graduate 253
## 6 Uneducated 691
## 7 Unknown 707clients_database2%>%filter(Gender=="F")%>%count(Customer_Age)## # A tibble: 42 × 2
## Customer_Age n
## <dbl> <int>
## 1 26 39
## 2 27 19
## 3 28 13
## 4 29 22
## 5 30 33
## 6 31 45
## 7 32 45
## 8 33 72
## 9 34 78
## 10 35 105
## # ℹ 32 more rowsclients_database2%>%filter(Gender=="F")%>%count(mean(Customer_Age))## # A tibble: 1 × 2
## `mean(Customer_Age)` n
## <dbl> <int>
## 1 46.5 5358clients_database2%>%filter(Gender=="M")%>%count(Customer_Age)## # A tibble: 44 × 2
## Customer_Age n
## <dbl> <int>
## 1 26 39
## 2 27 13
## 3 28 16
## 4 29 34
## 5 30 37
## 6 31 46
## 7 32 61
## 8 33 55
## 9 34 68
## 10 35 79
## # ℹ 34 more rowsclients_database2%>%filter(Gender=="M")%>%count(mean(Customer_Age))## # A tibble: 1 × 2
## `mean(Customer_Age)` n
## <dbl> <int>
## 1 46.2 4769clients_database2%>%filter(Gender=="F")%>%count(Marital_Status)## # A tibble: 4 × 2
## Marital_Status n
## <chr> <int>
## 1 Divorced 402
## 2 Married 2451
## 3 Single 2125
## 4 Unknown 380clients_database2%>%filter(Gender=="M")%>%count(Marital_Status)## # A tibble: 4 × 2
## Marital_Status n
## <chr> <int>
## 1 Divorced 346
## 2 Married 2236
## 3 Single 1818
## 4 Unknown 369clients_database2%>%filter(Gender=="F")%>%count(Income_Category)## # A tibble: 3 × 2
## Income_Category n
## <chr> <int>
## 1 $40K - $60K 1014
## 2 Less than $40K 3284
## 3 Unknown 1060clients_database2%>%filter(Gender=="M")%>%count(Income_Category)## # A tibble: 6 × 2
## Income_Category n
## <chr> <int>
## 1 $120K + 727
## 2 $40K - $60K 776
## 3 $60K - $80K 1402
## 4 $80K - $120K 1535
## 5 Less than $40K 277
## 6 Unknown 52clients_database2%>%filter(Gender=="F")%>%count(Card_Category)## # A tibble: 4 × 2
## Card_Category n
## <chr> <int>
## 1 Blue 5101
## 2 Gold 38
## 3 Platinum 9
## 4 Silver 210clients_database2%>%filter(Gender=="M")%>%count(Card_Category)## # A tibble: 4 × 2
## Card_Category n
## <chr> <int>
## 1 Blue 4335
## 2 Gold 78
## 3 Platinum 11
## 4 Silver 345ggn <-ggplot(data = clients_database2,
aes(x = Attrition_Flag,
fill = Income_Category)) +
geom_bar(position = position_dodge(preserve = "single"))+
labs(x = "Текущий статус клиента",
y = "Кол-во", title = "Текущий статус обслуживания относительно уровня дохода") +
theme(plot.title = element_text (hjust = 0.5 )) +
theme(plot.title = element_text(size = 6)) +
theme(axis.text.x= element_text(size =5),
axis.text.y= element_text(size =5)) +
theme(axis.title.x = element_text(size = 6),
axis.title.y = element_text(size = 6))
ggp <- ggplot(data = clients_database2,
aes(x = Education_Level,
fill = Income_Category)) +
geom_bar(position = position_dodge(preserve = "single"))+
labs(x = "Образование",
y = "Кол-во", title = "Уровень образования клиентов относительно уровня дохода")+
theme(plot.title = element_text (hjust = 0.5 )) +
theme(plot.title = element_text(size = 6)) +
theme(axis.text.x= element_text(size =3),
axis.text.y= element_text(size =3)) +
theme(axis.title.x = element_text(size = 6),
axis.title.y = element_text(size = 6))
ggq <-ggplot(data = clients_database2,
aes(x = Marital_Status,
fill = Income_Category)) +
geom_bar(position = position_dodge(preserve = "single"))+
labs(x = "Брачный статус",
y = "Кол-во", title = "Брачный статус клиентов относительно уровня дохода")+
theme(plot.title = element_text (hjust = 0.5 )) +
theme(plot.title = element_text(size = 6)) +
theme(axis.text.x= element_text(size =5),
axis.text.y= element_text(size =5)) +
theme(axis.title.x = element_text(size = 6),
axis.title.y = element_text(size = 6))
ggr <-ggplot(data = clients_database2,
aes(x = Card_Category,
fill = Income_Category)) +
geom_bar(position = position_dodge(preserve = "single"))+
labs(x = "Вид карты",
y = "Кол-во", title = "Вид карты относительно уровня дохода")+
theme(plot.title = element_text (hjust = 0.5 )) +
theme(plot.title = element_text(size = 6)) +
theme(axis.text.x= element_text(size =5),
axis.text.y= element_text(size =5)) +
theme(axis.title.x = element_text(size = 6),
axis.title.y = element_text(size = 6))
grid.arrange(ggn, ggp, ggq, ggr, ncol = 2)
clients_database2%>%filter(Income_Category=="Less than $40K")%>%count(Attrition_Flag)## # A tibble: 2 × 2
## Attrition_Flag n
## <chr> <int>
## 1 Attrited Customer 612
## 2 Existing Customer 2949clients_database2%>%filter(Income_Category=="$40K - $60K")%>%count(Attrition_Flag)## # A tibble: 2 × 2
## Attrition_Flag n
## <chr> <int>
## 1 Attrited Customer 271
## 2 Existing Customer 1519clients_database2%>%filter(Income_Category=="$60K - $80K")%>%count(Attrition_Flag)## # A tibble: 2 × 2
## Attrition_Flag n
## <chr> <int>
## 1 Attrited Customer 189
## 2 Existing Customer 1213clients_database2%>%filter(Income_Category=="$80K - $120K")%>%count(Attrition_Flag)## # A tibble: 2 × 2
## Attrition_Flag n
## <chr> <int>
## 1 Attrited Customer 242
## 2 Existing Customer 1293clients_database2%>%filter(Income_Category=="$120K +")%>%count(Attrition_Flag)## # A tibble: 2 × 2
## Attrition_Flag n
## <chr> <int>
## 1 Attrited Customer 126
## 2 Existing Customer 601clients_database2%>%filter(Income_Category=="Unknown")%>%count(Attrition_Flag)## # A tibble: 2 × 2
## Attrition_Flag n
## <chr> <int>
## 1 Attrited Customer 187
## 2 Existing Customer 925clients_database2%>%filter(Income_Category=="Less than $40K")%>%count(Education_Level)## # A tibble: 7 × 2
## Education_Level n
## <chr> <int>
## 1 College 345
## 2 Doctorate 158
## 3 Graduate 1139
## 4 High School 671
## 5 Post-Graduate 170
## 6 Uneducated 522
## 7 Unknown 556clients_database2%>%filter(Income_Category=="$40K - $60K")%>%count(Education_Level)## # A tibble: 7 × 2
## Education_Level n
## <chr> <int>
## 1 College 183
## 2 Doctorate 70
## 3 Graduate 553
## 4 High School 355
## 5 Post-Graduate 111
## 6 Uneducated 249
## 7 Unknown 269clients_database2%>%filter(Income_Category=="$60K - $80K")%>%count(Education_Level)## # A tibble: 7 × 2
## Education_Level n
## <chr> <int>
## 1 College 132
## 2 Doctorate 59
## 3 Graduate 422
## 4 High School 307
## 5 Post-Graduate 77
## 6 Uneducated 195
## 7 Unknown 210clients_database2%>%filter(Income_Category=="$80K - $120K")%>%count(Education_Level)## # A tibble: 7 × 2
## Education_Level n
## <chr> <int>
## 1 College 175
## 2 Doctorate 57
## 3 Graduate 478
## 4 High School 308
## 5 Post-Graduate 81
## 6 Uneducated 217
## 7 Unknown 219clients_database2%>%filter(Income_Category=="$120K +")%>%count(Education_Level)## # A tibble: 7 × 2
## Education_Level n
## <chr> <int>
## 1 College 70
## 2 Doctorate 37
## 3 Graduate 204
## 4 High School 147
## 5 Post-Graduate 30
## 6 Uneducated 119
## 7 Unknown 120clients_database2%>%filter(Income_Category=="Unknown")%>%count(Education_Level)## # A tibble: 7 × 2
## Education_Level n
## <chr> <int>
## 1 College 108
## 2 Doctorate 70
## 3 Graduate 332
## 4 High School 225
## 5 Post-Graduate 47
## 6 Uneducated 185
## 7 Unknown 145clients_database2%>%filter(Income_Category=="Less than $40K")%>%count(Marital_Status)## # A tibble: 4 × 2
## Marital_Status n
## <chr> <int>
## 1 Divorced 254
## 2 Married 1628
## 3 Single 1429
## 4 Unknown 250clients_database2%>%filter(Income_Category=="$40K - $60K")%>%count(Marital_Status)## # A tibble: 4 × 2
## Marital_Status n
## <chr> <int>
## 1 Divorced 138
## 2 Married 816
## 3 Single 704
## 4 Unknown 132clients_database2%>%filter(Income_Category=="$60K - $80K")%>%count(Marital_Status)## # A tibble: 4 × 2
## Marital_Status n
## <chr> <int>
## 1 Divorced 108
## 2 Married 661
## 3 Single 531
## 4 Unknown 102clients_database2%>%filter(Income_Category=="$80K - $120K")%>%count(Marital_Status)## # A tibble: 4 × 2
## Marital_Status n
## <chr> <int>
## 1 Divorced 103
## 2 Married 735
## 3 Single 561
## 4 Unknown 136clients_database2%>%filter(Income_Category=="$120K +")%>%count(Marital_Status)## # A tibble: 4 × 2
## Marital_Status n
## <chr> <int>
## 1 Divorced 52
## 2 Married 354
## 3 Single 274
## 4 Unknown 47clients_database2%>%filter(Income_Category=="Unknown")%>%count(Marital_Status)## # A tibble: 4 × 2
## Marital_Status n
## <chr> <int>
## 1 Divorced 93
## 2 Married 493
## 3 Single 444
## 4 Unknown 82clients_database2%>%filter(Income_Category=="Less than $40K")%>%count(Card_Category)## # A tibble: 4 × 2
## Card_Category n
## <chr> <int>
## 1 Blue 3403
## 2 Gold 24
## 3 Platinum 4
## 4 Silver 130clients_database2%>%filter(Income_Category=="$40K - $60K")%>%count(Card_Category)## # A tibble: 4 × 2
## Card_Category n
## <chr> <int>
## 1 Blue 1675
## 2 Gold 15
## 3 Platinum 1
## 4 Silver 99clients_database2%>%filter(Income_Category=="$60K - $80K")%>%count(Card_Category)## # A tibble: 4 × 2
## Card_Category n
## <chr> <int>
## 1 Blue 1273
## 2 Gold 29
## 3 Platinum 4
## 4 Silver 96clients_database2%>%filter(Income_Category=="$80K - $120K")%>%count(Card_Category)## # A tibble: 4 × 2
## Card_Category n
## <chr> <int>
## 1 Blue 1395
## 2 Gold 21
## 3 Platinum 2
## 4 Silver 117clients_database2%>%filter(Income_Category=="$120K +")%>%count(Card_Category)## # A tibble: 4 × 2
## Card_Category n
## <chr> <int>
## 1 Blue 645
## 2 Gold 18
## 3 Platinum 4
## 4 Silver 60clients_database2%>%filter(Income_Category=="Unknown")%>%count(Card_Category)## # A tibble: 4 × 2
## Card_Category n
## <chr> <int>
## 1 Blue 1045
## 2 Gold 9
## 3 Platinum 5
## 4 Silver 531 таблица графиков и их данные (по полу):
1) Как видно на первом графике первой таблицы (текущий статус
обслуживания относительно пола), количество женщин и мужчин среди
ушедших и актуальных клиентов риблизительно равно. Ушедшие клиенты:
930(Ж) и 697(М); актуальные клиенты: 4428 (Ж) и 4072 (М)
2) Женщины и мужчины имеют практически одинаковый уровень
образования. Колледж: 532(Ж) и 481(М); Докторская степень: 257(Ж) и
194(М); бакалавры: 1670(Ж) и 1458(М); старшая школа: 1028(Ж) и 985(М);
кандидаты аук: 263(Ж) и 253(М); необразованные: 796(Ж) и 691(М);
неизвестно: 812(Ж) и 707(М). Тем не менее, женщины лидируют ввиду того,
что кол-во клиентов женского пола больше, чем мужского (5358 женщин и
4769 мужчин).
3) Относительно возраста, клиенты мужского и женского пола также
практически равны друг с другом. Так, самый распространенный возраст
среди клиентов-женщин - 44 года (277 человек), среди клиентов-мужчин -
46 лет (249 человек). Средний возраст женщин - 46.5; мужчин - 46.2.
4) Брачный статус и категории кредитных карт, используемых обеими
группами соответствует тенденции прошлых выводов. Так, самая
распространенная категория по статусу брака - "женат(а): 2451(Ж) и
2236(М);самая малочисленная категория у женской группы - "неизвестный
статус" - 380 человек; у мужчин - "разведены" - 346 человек. Относительно
категорий кредитных карт: самая многочисленная категория "синия" -
5101(Ж) и 4335(М); самая малочисленная категория "платиновая" - 9(Ж) и
11(М).
5) Главные отличия можно увидеть на 5 графике. Так, в женской группе
полностью отстуствуют клиенты, получающие "$60K - $80K", "$80K - $120K"
и "$120K +". Самая многочисленная категория в данной группе -
"Less than $40K" - 3284 человека. Число людей из группы, подпадающих
под категории "$40K - $60K" и "Unknown" - практически одинаково (1014 и
1060 - соответственно). Мужская же группа, подпадает под все категории.
Самая многочисленная - "$80K - $120K" (1535 человек); самая
малочисленная - "Unknown" (52 человека).
2 таблица графиков и их данные (по уровню доходов):
1) Во 2 таблице графиков, сгруппированной по уровню доходов, можно
заметить, что клиенты со степенями докторов наук и кандидатов имеют
самый низкий показатель в категории доходов в абсолютных показателях
"ниже $40 тыс." (158 и 170 человек - соответственно). Самая
многочисленная группа, имеющая доход "$120K +" в абсолютных показателях -
бакалавры (204).
2) Касаемо статуса брака и уровня доходов, нужно отметить, что
большинство клиентов, состоящие во всех категориях брака имеют доход -
"Less than $40K": 254 - в разводе, 1628 - в браке, 1429 - холосты и
250 - со статусом "неизвестно". Наименьшее число клиентов по всем
категориям брака получают "$120K +": 52 - в разводе, 354 - в браке,
274 - холосты и 47 - со статусом "неизвестно".
3) На последнем графике едва ли существует между уровнем доходов
клиентов и категориями кредитных карт. Так, 4 платиновые карты имеют
группы "$120K +", "$60K - $80K", "Less than $40K", 1 платиновая карта -
в группе "$40K - $60K", 2 - в "$80K - $120K" и 5 - в "Unknown".
Аналонгичная тенденция прослеживается с серебрянными и золотыми картами.