LBB Customer Segmentation
Muhammad Yusuf Ibrahim
September 6, 2022
# clear-up the environment
rm(list = ls())
# chunk options
knitr::opts_chunk$set(
message = FALSE,
warning = FALSE,
fig.align = "center",
comment = "#>"
)
# scientific notation
options(scipen = 9999)1 Library
# Data Wrangling
library(tidyverse)
library(Hmisc)
# Machine Learning - Clustering
library(cluster)
library(factoextra)
# Visualization
library(Rtsne)2 Import Data
Data yang akan digunakan pada learning by building kali ini,
merupakan data behavior dari pelanggan kartu kredit pada sebuah
bank. Pada data creditcard_usage_behavior.csv akan kita
lakukan clustering menggunakan metode PAM berdasarkan
variabel-variabel yang terdapat pada dataset tersebut.
cc <- read.csv('data/creditcard_usage_behavior.csv')
head(cc)Untuk melihat struktur pada data cc kita menggunakan
fungsi glimpse()
glimpse(cc)#> Rows: 10,127
#> Columns: 10
#> $ CLIENTNUM <int> 768805383, 818770008, 713982108, 769911858, 709…
#> $ Customer_Age <int> 45, 49, 51, 40, 40, 44, 51, 32, 37, 48, 42, 65,…
#> $ Gender <chr> "M", "F", "M", "F", "M", "M", "M", "M", "M", "M…
#> $ Education_Level <chr> "High School", "Graduate", "Graduate", "High Sc…
#> $ Marital_Status <chr> "Married", "Single", "Married", "Unknown", "Mar…
#> $ Income_Category <chr> "$60K - $80K", "Less than $40K", "$80K - $120K"…
#> $ 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,…Berikut merupakan deskripsi singkat dari setiap kolom pada data
cc:
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 lamaCredit_Limit: Limit dari creditcardTotal_Trans_Amt: Jumlah amount transaksi yang dilakukan selama 12 bulan terakhirTotal_Trans_Ct: Total transaksi yang dilakukan selama 12 bulan terakhir
Selanjutnya kita akan melakukan tahap data wrangling untuk mempersiapkan data yang akan digunakan untuk modelling.
3 Data Wrangling
Jika kita lihat pada deskripsi kolom, ada beberapa hal yang perlu
kita lakukan sebelum menggunakan data cc ini untuk
dilakukan clustering. Seperti pada kolom CLIENTNUM hanya
memberikan informasi nomor id customer yang tidak diperlukan dalam
melakukan clustering, sehingga kita perlu menghilangkan kolom tersebut
menggunakan fungsi select(). Sedangkan pada kolom
Gender, Education_Level,
Marital_Status dan Income_Category masih
memiliki tipe data chr yang seharus nya kita ubah menjadi
tipe data fct, untuk merubah tipe data tersebut kita dapat
menggunakan fungsi mutate_if().
cc <- cc %>%
select(-CLIENTNUM) %>%
mutate_if(is.character, as.factor) Kita dapat menggunakan fungsi glimpse() kembali untuk
melihat apakah sudah terjadi perubahan pada data cc.
glimpse(cc)#> 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,…Tidak lupa juga kita harus mengecek apakah data kita memiliki missing
value atau tidak menggunakan kombinasi fungsi is.na() dan
colSums().
colSums(is.na(cc))#> 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 0Dari hasil pengecekan tersebut data cc tidak memiliki
missing values, sehingga kita dapat melanjutkan ke tahap
selanjutnya.
4 EDA
Pada tahap ini kita akan mencari insight-insight terhadap data
cc, untuk memulainya kita bisa melihat dari nilai-nilai
deskriptif statistik yang bisa kita dapatkan menggunakan fungsi
summary()
summary(cc)#> 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
#> Dari hasil di atas, insight yang di dapat adalah:
- Rata-rata umur customer berada pada umur 46 tahun
- Proporsi gender dari customer cukup balance
- Mayoritas tingkat pendidikan customer berada di kategori graduate
- Mayoritas pendapatan customer kurang dari $40.000
Selanjutnya kita akan melihat apakah terdapat outlier pada kolom
Customer_Age menggunakan fungsi boxplot().
boxplot_age <- boxplot(cc$Customer_Age)
boxplot_age$out#> [1] 73 70Dapat dilihat pada kolom Customer_Age terdapat dua
outlier, yaitu data yang berumur 73 dan 70 tahun. Tetapi saya tidak akan
melakukan treatment khusus dikarenakan menurut saya umur tersebut masih
memungkin sebagai data asli.
5 Modelling
Dikarenakan jumlah data cc memiliki 10,127 baris, kita
akan menggunakan hanya 1000 baris. Maka dari itu kita akan membuat data
baru yang akan digunakan untuk clustering. Untuk mengambil 1000 baris
tersebut kita akan melakukannya secara random.
RNGkind(sample.kind = 'Rounding')
set.seed(121)
index <- sample(x = nrow(cc), size = 1000)
cc_final <- cc[index,]5.1 Perhitungan Gower Distance
Untuk melakukan perhitungan Gower Distance kita akan
menggunakan fungsi daisy() dengan parameter
metric = 'gower'.
cc_gd <- daisy(x = cc_final, metric = "gower")5.2 Penentuan Jumlah Cluster
Dalam penentuan jumlah cluster kita akan menggunakan dua metode,
yaitu Elbow Method dan Silhoutte
Method. Pada elbow method akan memvariasikan jumlah
kelompok dengan menghitung Within Cluster Sum of Square (WSS). WSS
adalah akan menghasilkan jumlah kuadrat jarak antara setiap observasi
terhadap titik Medoids untuk setiap kemungkinan jumlah kelompok.
Sedangkan pada Silhoutte Method akan menghitung seberapa mirip
sebuah observasi dengan kelompoknya sendiri jika dibandingkan dengan
nilai kelompok lainnya. Untuk melakukan kedua metode tersebut kita akan
menggunakan fungsi fviz_nbclust().
# set.seed(101)
#
# elbow <-fviz_nbclust(x = as.matrix(cc_gd),
# FUNcluster = pam,
# method = "wss",
# k.max = 5)
# ggsave('elbow.png')
knitr::include_graphics("elbow.png")
Jika dilihat dari hasil penentuan jumlah cluster menggunakan Elbow Method, titik landai berada di nilai K = 2.
# set.seed(101)
#
# silhouette_method <- fviz_nbclust(x = as.matrix(cc_gd),
# FUNcluster = pam,
# method = "silhouette",
# k.max = 5) +
# labs(subtitle = "Silhouette Method")
#
# ggsave('silhouette_method.png')
knitr::include_graphics("silhouette_method.png")
Sedangkan pada hasil Silhoutte Method menunjukan bahwa nilai K = 2
Maka jumlah cluster yang akan digunakan adalah berjumlah 2 berdasarkan hasil dari kedua metode tersebut.
5.3 Pembuatan CLuster
Pada tahap terakhir ini, kita akan melakukan clustering menggunakan
fungsi pam() dengan nilai K = 2.
pam_fit <- pam(x = cc_gd,
k = 2)Fungsi di atas akan membantu kita untuk mengelompokan keseluruhan observasi data ke beberapa kelompok berdasarkan kemiripan setiap observasi terhadap titik pusat atau medoids. Supaya kita bisa mendapatkan intuisi awal bagaimana karakteristik customer untuk setiap kelompoknya, kita bisa melihat dari tabel di bawah ini.
cc_final[pam_fit$medoids, ]Seperti yang sudah disampaikan, dengan melihat tabel di atas kita hanya bisa mendapatkan intuisi awal bagaimana karakteristik dari masing-masing kelompok yang dibuat. Supaya kita dapat melakukan interpretasi lebih detail dan melihat apakah pengelompokan yang kita lakukan sudah dapat memisahkan setiap observasi data dengan baik, kita bisa memanfaatkan metode statistik deskriptif dan visualisasi.
6 Interpretation
6.1 Metode Visualisasi
Jika dengan menggunakan metode statistik deskriptif kita bisa memahami karakteristik dari masing-masing kelompok, metode visualisasi dapat membantu kita untuk menilai bagaimana hasil pengelompokan. Metode visualisasi yang akan digunakan adalah metode t-SNE, metode ini merupakan salah satu cara untuk memvisualisasikan data yang tidak hanya memiliki nilai numerik saja melainkan nilai kategorikal juga.
set.seed(101)
tsnse_obj <- Rtsne(X = cc_gd,
is_distance = TRUE)
tsnse_dataframe <- tsnse_obj$Y %>%
data.frame() %>%
setNames(c("X", "Y")) %>%
mutate(cluster = factor(pam_fit$clustering))tsnse_dataframe %>% head()ggplot(data = tsnse_dataframe, mapping = aes(x = X, y = Y)) +
geom_point(mapping = aes(color = cluster))
Jika dilihat dari hasil plot diatas, bahwa sudah terbagi menjadi dua cluster yang cukup walaupun masih ada beberapa data yang masih tumpang tindih antara cluster.
6.2 Metode Deskriptif
Tujuan melakukan statistik deskriptif adalah untuk memahami karakteristik masing-masing kelompok, dan dalam kasus ini untuk mengetahui karakteristik untuk setiap pengguna kartu kredit.
# Please type your code
pam_result <-
cc_final %>%
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. :26.00 F: 0 College : 41 Divorced: 33
#> 1st Qu.:41.00 M:449 Doctorate : 19 Married :204
#> Median :46.00 Graduate :136 Single :172
#> Mean :46.28 High School : 95 Unknown : 40
#> 3rd Qu.:51.00 Post-Graduate: 28
#> Max. :65.00 Uneducated : 59
#> Unknown : 71
#> Income_Category Months_Inactive_12_mon Credit_Limit Total_Trans_Amt
#> $120K + : 71 Min. :0.00 Min. : 1438 Min. : 706
#> $40K - $60K : 79 1st Qu.:2.00 1st Qu.: 4162 1st Qu.: 1968
#> $60K - $80K :149 Median :2.00 Median : 8989 Median : 3536
#> $80K - $120K :136 Mean :2.35 Mean :13244 Mean : 4510
#> Less than $40K: 6 3rd Qu.:3.00 3rd Qu.:20056 3rd Qu.: 4734
#> Unknown : 8 Max. :6.00 Max. :34516 Max. :16606
#>
#> Total_Trans_Ct cluster
#> Min. : 15.00 Min. :1
#> 1st Qu.: 44.00 1st Qu.:1
#> Median : 65.00 Median :1
#> Mean : 63.48 Mean :1
#> 3rd Qu.: 79.00 3rd Qu.:1
#> Max. :131.00 Max. :1
#> pam_result$the_summary[[2]]#> Customer_Age Gender Education_Level Marital_Status
#> Min. :26.00 F:531 College : 45 Divorced: 53
#> 1st Qu.:41.00 M: 20 Doctorate : 22 Married :267
#> Median :46.00 Graduate :173 Single :198
#> Mean :46.12 High School : 98 Unknown : 33
#> 3rd Qu.:52.00 Post-Graduate: 43
#> Max. :65.00 Uneducated : 71
#> Unknown : 99
#> Income_Category Months_Inactive_12_mon Credit_Limit Total_Trans_Amt
#> $120K + : 0 Min. :0.000 Min. : 1438 Min. : 739
#> $40K - $60K : 98 1st Qu.:2.000 1st Qu.: 2021 1st Qu.: 2452
#> $60K - $80K : 0 Median :2.000 Median : 2873 Median : 4120
#> $80K - $120K : 0 Mean :2.319 Mean : 4641 Mean : 4171
#> Less than $40K:344 3rd Qu.:3.000 3rd Qu.: 4916 3rd Qu.: 4716
#> Unknown :109 Max. :6.000 Max. :34516 Max. :16908
#>
#> Total_Trans_Ct cluster
#> Min. : 16.00 Min. :2
#> 1st Qu.: 48.00 1st Qu.:2
#> Median : 70.00 Median :2
#> Mean : 66.17 Mean :2
#> 3rd Qu.: 80.50 3rd Qu.:2
#> Max. :138.00 Max. :2
#> Profil insight atau karakteristik yang bisa dapatkan adalah sebagai berikut:
Cluster 1
- Gender pada cluster ini semuanya ada laki-laki
- Pendapatan pada cluster ini mayoritas berada di
$60K - $80Kdan$80K - $120K
Cluster 2
- Gender pad a cluster ini mayoritas adalah perempuan
- Pendapatan mayoritas berada di
Less than $40K
Untuk parameter lain menurut penulis memiliki nilai yang tidak terlalu jauh dari kedua parameter diatas.