Customer Segmentation
Credit Card Usage Behavior
Ronny - COHORT Kappa
July 4, 2022
1 Library
library(tidyverse)
library(dplyr)
library(Hmisc)
# Machine Learning - Clustering
library(cluster)
library(factoextra)
# Visualization
library(Rtsne)
#html
library(htmltools)2 Read Data
credit_usage <- read.csv("data/creditcard_usage_behavior.csv", stringsAsFactors = T)
head(credit_usage)Deskripsi singkat:
CLIENTNUM: Unique ID ClientCustomer_Age: Umur customerGender: gender customerEducation_Level: Tingkat pendidikanMarital_Status: Status PernikahanIncome_Category: Range pendapatanMonths_Inactive_12_mon: Selama 12 bulan terakhir sempat tidak menggunakan kartu kredit berapa lama (Tidak aktif berapa lama dalam setahun)Credit_Limit: Limmit dari creditcardTotal_Trans_Amt: Jumlah amount transaksi yang dilakukan selama 12 bulan terakhirTotal_Trans_Ct: Total transaksi yang dilakukan selama 12 bulan terakhir
3 Cleansing
Pada tahap awal, tipe data string sudah secara otomatis diubah menjadi faktor dengan menggunakan perintah “stringAsFactors = T”, CLIENTNUM perlu diubah menjadi rownames, kemudian tipe data pada kolom lain sudah sesuai semua.
credit_usage <- credit_usage %>% tibble::column_to_rownames(var = "CLIENTNUM")
#Melihat sekilas kondisi data
glimpse(credit_usage)#> Rows: 10,127
#> Columns: 9
#> $ Customer_Age <int> 45, 49, 51, 40, 40, 44, 51, 32, 37, 48, 42, 65,~
#> $ Gender <fct> M, F, M, F, M, M, M, M, M, M, M, M, M, M, F, M,~
#> $ Education_Level <fct> High School, Graduate, Graduate, High School, U~
#> $ Marital_Status <fct> Married, Single, Married, Unknown, Married, Mar~
#> $ Income_Category <fct> $60K - $80K, Less than $40K, $80K - $120K, Less~
#> $ Months_Inactive_12_mon <int> 1, 1, 1, 4, 1, 1, 1, 2, 2, 3, 3, 2, 6, 1, 2, 1,~
#> $ Credit_Limit <dbl> 12691.0, 8256.0, 3418.0, 3313.0, 4716.0, 4010.0~
#> $ Total_Trans_Amt <int> 1144, 1291, 1887, 1171, 816, 1088, 1330, 1538, ~
#> $ Total_Trans_Ct <int> 42, 33, 20, 20, 28, 24, 31, 36, 24, 32, 42, 26,~anyNA(credit_usage)#> [1] FALSE#Tidak ada NA
credit_usage %>% is.na() %>% colSums()#> Customer_Age Gender Education_Level
#> 0 0 0
#> Marital_Status Income_Category Months_Inactive_12_mon
#> 0 0 0
#> Credit_Limit Total_Trans_Amt Total_Trans_Ct
#> 0 0 0#Konfirmasi tidak ada NA4 Exploratory Data Analytic
credit_usage %>% summary()#> Customer_Age Gender Education_Level Marital_Status
#> Min. :26.00 F:5358 College :1013 Divorced: 748
#> 1st Qu.:41.00 M:4769 Doctorate : 451 Married :4687
#> Median :46.00 Graduate :3128 Single :3943
#> Mean :46.33 High School :2013 Unknown : 749
#> 3rd Qu.:52.00 Post-Graduate: 516
#> Max. :73.00 Uneducated :1487
#> Unknown :1519
#> Income_Category Months_Inactive_12_mon Credit_Limit Total_Trans_Amt
#> $120K + : 727 Min. :0.000 Min. : 1438 Min. : 510
#> $40K - $60K :1790 1st Qu.:2.000 1st Qu.: 2555 1st Qu.: 2156
#> $60K - $80K :1402 Median :2.000 Median : 4549 Median : 3899
#> $80K - $120K :1535 Mean :2.341 Mean : 8632 Mean : 4404
#> Less than $40K:3561 3rd Qu.:3.000 3rd Qu.:11068 3rd Qu.: 4741
#> Unknown :1112 Max. :6.000 Max. :34516 Max. :18484
#>
#> Total_Trans_Ct
#> Min. : 10.00
#> 1st Qu.: 45.00
#> Median : 67.00
#> Mean : 64.86
#> 3rd Qu.: 81.00
#> Max. :139.00
#> Insight:
Median umur customer berada pada umur 46 tahun, dengan yang termuda adalah 26, tertua adalah 73 tahun
Dari jenis kelamin, perempuan lebih banyak daripada pria
Level pendidikan Graduate menduduki peringkat tertinggi, disusul highschool dan seterusnya Uneducated, Unknown dan College, hanya sebagian kecil pada level Doctorate dan Post-Graduate
Sudah menikah dan single menduduki peringkat satu dan dua tertinggi disusul Divorced dan Unknown
Income category less than $40k menduduki peringkat tertinggi
Median bulan tidak aktif berada pada 2 bulan dengan tertingginya adalah 6 bulan tidak aktif
Median limit credit card berada pada 4549, terkecil 1438 dan tertinggi 34516
Median total transaksi berada pada angka 3899, terendah 510 dan tertinggi adalah 18484
Median jumlah transaksi berada pada angka 67 kali, dengan 10 sebagai terendah, dan 139 sebagai yang tertinggi
Check outlier data dengan menggunakan Boxplot
Outlier Customer Age
Outlier Inactive Months
Outlier Credit Limit
Outlier Total Trans Amt
Outlier Total Trans Count
#Customer Age
boxplot_credit_usage_1 <- boxplot(credit_usage$Customer_Age)
#Inactive Months
boxplot_credit_usage_2 <- boxplot(credit_usage$Months_Inactive_12_mon)
#Credit Limit
boxplot_credit_usage_3 <- boxplot(credit_usage$Credit_Limit)
#Total Trans Amt
boxplot_credit_usage_4 <- boxplot(credit_usage$Total_Trans_Amt)
#Total Trans Count
boxplot_credit_usage_5 <- boxplot(credit_usage$Total_Trans_Ct)
Periksa Outlier
boxplot_credit_usage_5$out#> [1] 139 138Visualisasi Histogram pada kolom faktor
credit_usage %>%
select(is.factor) %>%
hist.data.frame()
Insight: Jenis kelamin Female, Level pendidikan Graduate, Status pernikahan Single dan Married serta jumlah pendapatan Less than $40K mendominasi banyaknya data credit
Visualisasi Histogram pada kolom numerik
credit_usage %>%
select(is.numeric) %>%
hist.data.frame()
Dari hasil pemeriksaan outlier menggunakan boxplot diketahui bahwa:
Outlier umur tersebar normal
Outlier inactive12mon dapat membentuk cluster tersendiri sehingga tidak dihilangkan
Outlier tidak terbentuk karena persebaran data terlihat normal pada credit limit, total trans. amount dan total trans. count
Sehingga ditarik kesimpulan, tidak ada data outlier yang akan ditake-out. :)
5 Filtrasi
Mengambil 1000 data random untuk dijadikan sampling (karena beban komputasi yang tinggi apabila tidak dibatasi jumlah data ujinya)
user_limit <- sample_n(credit_usage, 1000)#Implementasi Partitioning Around Medoids > Gower Distance
credit_usage_gd <- daisy(x = user_limit,
metric = "gower")Uji pasangan data yang paling identik
example <- as.matrix(credit_usage_gd)
credit_usage[which(example == min(example[example != min(example)]),
arr.ind = TRUE)[1, ], ]5.1 Menentukan jumlah Cluster
5.1.1 1. Elbow Method, dengan menghitung Within Cluster Sum of Square (WSS)
Penentuan Nilai K
# Please type your code
# set.seed(123)
#
# fviz_nbclust(x = example,
# FUNcluster = pam,
# method = "wss",
# k.max = 5)knitr::include_graphics("assets/elbow-method.PNG")
Secara subjektik nilai K yang penurunannya tidak terlalu landai itu berada pada nilai K = 4.
5.1.2 2. Metode Silhouette
# set.seed(123)
#
# fviz_nbclust(x = example,
# FUNcluster = pam,
# method = "silhouette",
# k.max = 5) +
# labs(subtitle = "Silhouette Method")knitr::include_graphics("assets/silhouette.PNG")
5.1.3 3. Metode Gap Statistic
# set.seed(123)
#
# fviz_nbclust(x = example,
# FUNcluster = pam,
# method = "gap_stat",
# k.max = 5,) +
# labs(subtitle = "Gap Statistic Method")knitr::include_graphics("assets/gap-statistic.PNG")
Kesimpulan:
- Elbow Mehtod: K = 4
- Shilloete Method: K = 2
- Gap statistic Method: K = 4
2 dari 3 metode itu menyarankan untuk memilik K = 4
6 Pembuatan Cluster
# Please type your code
pam_fit <- pam(x = credit_usage_gd,
k = 4)Medoids yang terbentuk
# Please type your code
user_limit[pam_fit$medoids, ]7 Interpretasi
##Metode Visualisasi
# Please type your code
#TSNE Methods
set.seed(123)
tsnse_obj <- Rtsne(X = credit_usage_gd,
is_distance = TRUE)
tsnse_dataframe <- tsnse_obj$Y %>%
data.frame() %>%
setNames(c("X", "Y")) %>%
mutate(cluster = factor(pam_fit$clustering))ggplot(data = tsnse_dataframe, mapping = aes(x = X, y = Y)) +
geom_point(mapping = aes(color = cluster))
##Metode Deskriptif
# Please type your code
pam_result <-
user_limit %>%
mutate(cluster = pam_fit$clustering) %>%
group_by(cluster) %>%
do(the_summary = summary(.))pam_result$the_summary[[1]]#> Customer_Age Gender Education_Level Marital_Status
#> Min. :27.00 F:290 College : 26 Divorced: 24
#> 1st Qu.:41.00 M: 3 Doctorate : 15 Married :219
#> Median :47.00 Graduate :128 Single : 33
#> Mean :46.49 High School : 30 Unknown : 17
#> 3rd Qu.:51.00 Post-Graduate: 11
#> Max. :65.00 Uneducated : 43
#> Unknown : 40
#> Income_Category Months_Inactive_12_mon Credit_Limit Total_Trans_Amt
#> $120K + : 0 Min. :1.000 Min. : 1438 Min. : 510
#> $40K - $60K : 59 1st Qu.:1.000 1st Qu.: 2151 1st Qu.: 2461
#> $60K - $80K : 0 Median :2.000 Median : 3028 Median : 4201
#> $80K - $120K : 0 Mean :2.137 Mean : 4928 Mean : 4453
#> Less than $40K:169 3rd Qu.:3.000 3rd Qu.: 5547 3rd Qu.: 4741
#> Unknown : 65 Max. :6.000 Max. :34516 Max. :16207
#>
#> Total_Trans_Ct cluster
#> Min. : 19.00 Min. :1
#> 1st Qu.: 50.00 1st Qu.:1
#> Median : 71.00 Median :1
#> Mean : 67.31 Mean :1
#> 3rd Qu.: 82.00 3rd Qu.:1
#> Max. :138.00 Max. :1
#> pam_result$the_summary[[2]]#> Customer_Age Gender Education_Level Marital_Status
#> Min. :26.0 F: 0 College :17 Divorced: 16
#> 1st Qu.:40.0 M:196 Doctorate : 8 Married : 35
#> Median :46.0 Graduate :34 Single :136
#> Mean :46.2 High School :65 Unknown : 9
#> 3rd Qu.:52.0 Post-Graduate:13
#> Max. :65.0 Uneducated :33
#> Unknown :26
#> Income_Category Months_Inactive_12_mon Credit_Limit Total_Trans_Amt
#> $120K + :41 Min. :1.000 Min. : 1438 Min. : 744
#> $40K - $60K :28 1st Qu.:2.000 1st Qu.: 4647 1st Qu.: 2508
#> $60K - $80K :90 Median :2.000 Median :11507 Median : 4043
#> $80K - $120K :30 Mean :2.224 Mean :14124 Mean : 5245
#> Less than $40K: 4 3rd Qu.:3.000 3rd Qu.:21847 3rd Qu.: 6297
#> Unknown : 3 Max. :6.000 Max. :34516 Max. :16695
#>
#> Total_Trans_Ct cluster
#> Min. : 18.00 Min. :2
#> 1st Qu.: 56.50 1st Qu.:2
#> Median : 70.50 Median :2
#> Mean : 70.03 Mean :2
#> 3rd Qu.: 84.25 3rd Qu.:2
#> Max. :132.00 Max. :2
#> pam_result$the_summary[[3]]#> Customer_Age Gender Education_Level Marital_Status
#> Min. :26.00 F: 0 College : 33 Divorced: 28
#> 1st Qu.:41.00 M:277 Doctorate : 14 Married :186
#> Median :47.00 Graduate :125 Single : 38
#> Mean :46.12 High School : 26 Unknown : 25
#> 3rd Qu.:51.00 Post-Graduate: 10
#> Max. :65.00 Uneducated : 26
#> Unknown : 43
#> Income_Category Months_Inactive_12_mon Credit_Limit Total_Trans_Amt
#> $120K + : 39 Min. :0.000 Min. : 1438 Min. : 678
#> $40K - $60K : 44 1st Qu.:2.000 1st Qu.: 3870 1st Qu.: 1825
#> $60K - $80K : 48 Median :2.000 Median : 8249 Median : 3127
#> $80K - $120K :137 Mean :2.419 Mean :12984 Mean : 3850
#> Less than $40K: 7 3rd Qu.:3.000 3rd Qu.:21114 3rd Qu.: 4442
#> Unknown : 2 Max. :6.000 Max. :34516 Max. :16579
#>
#> Total_Trans_Ct cluster
#> Min. : 11.00 Min. :3
#> 1st Qu.: 40.00 1st Qu.:3
#> Median : 56.00 Median :3
#> Mean : 58.44 Mean :3
#> 3rd Qu.: 75.00 3rd Qu.:3
#> Max. :130.00 Max. :3
#> pam_result$the_summary[[4]]#> Customer_Age Gender Education_Level Marital_Status
#> Min. :26.0 F:230 College :24 Divorced: 18
#> 1st Qu.:41.0 M: 4 Doctorate :11 Married : 24
#> Median :47.0 Graduate :24 Single :176
#> Mean :46.7 High School :93 Unknown : 16
#> 3rd Qu.:53.0 Post-Graduate:12
#> Max. :65.0 Uneducated :27
#> Unknown :43
#> Income_Category Months_Inactive_12_mon Credit_Limit Total_Trans_Amt
#> $120K + : 0 Min. :0.000 Min. : 1438 Min. : 673
#> $40K - $60K : 35 1st Qu.:2.000 1st Qu.: 2175 1st Qu.: 2598
#> $60K - $80K : 0 Median :3.000 Median : 2958 Median : 4116
#> $80K - $120K : 0 Mean :2.697 Mean : 4855 Mean : 4234
#> Less than $40K:153 3rd Qu.:3.000 3rd Qu.: 5838 3rd Qu.: 4693
#> Unknown : 46 Max. :6.000 Max. :34516 Max. :15867
#>
#> Total_Trans_Ct cluster
#> Min. : 18.00 Min. :4
#> 1st Qu.: 50.25 1st Qu.:4
#> Median : 69.00 Median :4
#> Mean : 66.26 Mean :4
#> 3rd Qu.: 79.00 3rd Qu.:4
#> Max. :111.00 Max. :4
#> 8 Cluster Results
knitr::include_graphics("assets/Cluster Results.PNG")
9 Saran Bisnis
Fokuskan produk2 khusus laki-laki pada cluster 1 dan 3, produk khusus perempuan pada cluster 2 dan 4
Laki-laki (Cluster 1 dan 3) memiliki kategori income dan limit kredit yang lebih tinggi dibanding perempuan, sarankan produk dengan harga yang relatif lebih tinggi ATAU perbanyak ragam produk yang memiliki harga yang lebih murah. (Produk mahal: Mesin kopi, Produk murah: Pods Kopi dengan berbagai macam rasa dan bundling namun dengan berbagai macam merek, agar customer bingung dan kemudian diharapkan membeli semua)
Perempuan terlihat lebih tinggi pada total amount transaksi meskipun dengan level income Less than $40K (Cluster 2 dan 4), dapat dibuatkan promo barang2 kebutuhan dasar dengan harga relatif murah serta perbanyak ragam produknya