# 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)
# Data Wrangling
library(tidyverse)
library(Hmisc)
# Machine Learning - Clustering
library(cluster)
library(factoextra)
# Visualization
library(Rtsne)
Data yang akan kita gunakan adalah data historikal behavior dari para pengguna kartu kredit disebuah bank dan nantinya kita akan kelompolan untuk membuat segmentasi user.
credit_card <-
read.csv("data/creditcard_usage_behavior.csv")
head(credit_card)
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 lamaCredit_Limit: Limmit dari creditcardTotal_Trans_Amt: Jumlah amount transaksi yang dilakukan
selama 12 bulan terakhirTotal_Trans_Ct: Total transaksi yang dilakukan selama
12 bulan terakhirRole Play Bisnis Question
Kita selaku tim Data, diminta tolong oleh tim marketing untuk membuat segmentasi pengguna kartu kredit dari keseluruhan yang terdaftar untuk mengamati behavior para pengguna selama 12 bulan terakhir karena tim marketing merasa khawatir jika promo dan fitur yang ditawarkan secara general atau sama rata antar setiap pengguna, akan menjadi tidak tepat sasaran dan sia-sia. Harapan dari tim marketing dengan adanya segmentasi pengguna, promo dan fitur yang dipersiapkan akan membantu meningkatkan penggunaan kartu kredit.
Wrangling 1: Kita akan membuat CLIENTNUM menjadi Rowname
Wrangling 2: Apakah terdapat kolom yang belum sesuai tipe datanya?
# Please run the code down below
credit_card %>%
glimpse()
#> 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,…
Diubah menjadi factor:
unique(credit_card$Income_Category)
#> [1] "$60K - $80K" "Less than $40K" "$80K - $120K" "$40K - $60K"
#> [5] "$120K +" "Unknown"
# Please run the code down below
credit_card_clean <-
credit_card %>%
column_to_rownames(var = "CLIENTNUM") %>% # menjadikan kolom ke rownames
mutate_if(is.character, as.factor) # mengganti semua tipe data numerik ke factor
credit_card_clean %>%
glimpse()
#> 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,…
Karena data yang melebihi 10.000 observasi dan saya rasa terlalu besar untuk di jalankan pada saat penentuan nilai k. Maka saya kan mengurangi data menjadi 1000 observasi saja
credit_card_cleaner <- credit_card_clean[1:1000,]
tail(credit_card_cleaner)
Pada tahapan ini, kita akan mencoba untuk lebih mengenali data yang kita miliki.
EDA 1: cek missing value
# Please run the code down below
credit_card_cleaner %>%
anyNA()
#> [1] FALSE
Tidak terdapat missing value kita dapat lanjut ke EDA 2
EDA 2: Melakukan 5 number summary
# Please run the code down below
credit_card_cleaner %>%
summary()
#> Customer_Age Gender Education_Level Marital_Status
#> Min. :26.00 F:378 College : 97 Divorced: 67
#> 1st Qu.:43.00 M:622 Doctorate : 43 Married :578
#> Median :48.00 Graduate :298 Single :296
#> Mean :48.54 High School :212 Unknown : 59
#> 3rd Qu.:54.00 Post-Graduate: 56
#> Max. :73.00 Uneducated :148
#> Unknown :146
#> Income_Category Months_Inactive_12_mon Credit_Limit Total_Trans_Amt
#> $120K + : 92 Min. :0.000 Min. : 1438 Min. : 510
#> $40K - $60K :176 1st Qu.:1.750 1st Qu.: 3020 1st Qu.:1210
#> $60K - $80K :198 Median :2.000 Median : 6243 Median :1419
#> $80K - $120K :202 Mean :2.264 Mean :10024 Mean :1468
#> Less than $40K:255 3rd Qu.:3.000 3rd Qu.:14251 3rd Qu.:1679
#> Unknown : 77 Max. :6.000 Max. :34516 Max. :4311
#>
#> Total_Trans_Ct
#> Min. :10.00
#> 1st Qu.:26.00
#> Median :33.00
#> Mean :34.48
#> 3rd Qu.:41.00
#> Max. :78.00
#>
Insight: - Kebanyakan pengguna credit card memiliki gelar
Graduate
Rata-rata Income Category less than $40k
Mayoritas Marital_Status nya Married
Kebanyakan pengguna sangat aktif dalam mengunakan credit card dalam 12 bulan terakhir
Untuk tipe data yang bertipe numerik kita dapat melakukan visualisasi
untuk melihat jumlah observasi dengan plot histogram. Kita menggunakan
fungsi hist.data.frame() dari library(Hmisc)
untuk membuatnya satu visualisasi.
credit_card_cleaner %>%
select_if(is.numeric) %>%
hist.data.frame()
credit_card_cleaner %>%
select(is.factor) %>%
hist.data.frame()
Insight : - Kebanyakan pengguna berumur 53 tahun
Perbedaan Gender Male dan Female sekitar 200 orang
Credit_limit tertinggi ada diangka 20.000
Dapat kita lihat dari data kita ada lebih dari 1000 baris dari setiap observasi yang memiliki nilai berbeda. Nantinya setiap kelompok harus terdiri dari data - data uang identik, untuk kita harus menghitung jarak antar observasi apakah saling berdekatan atau tidak.
Metode untuk menghitung jarak yang digunakan adalah metode
Gower Distance. Kita akan menggunakan fungsi
daisy() yang terdapat pada library(cluster). Pada
fungsi tersebut nantinya akan ada 2 parameter yang bisa diisi,
yaitu:
x: Data frame yang ingin digunakanmetric: Metode apa yang ingin digunakan, karena kita
akan menggunakan metode Gower Distance, kita bisa isi dengan
“gower”.credit_card_gd <- daisy(x = credit_card_cleaner,
metric = "gower")
Sekarang apakah metode Gower Distance dapat menempatkan data berdasarkan kemiripannya? Untuk itu kita dapat membuat pasangan yang paling mirip dan berbeda dengan menggunakan fungsi berikut.
example <- as.matrix(credit_card_gd)
credit_card_cleaner[which(example == min(example[example != min(example)]),
arr.ind = TRUE)[1, ], ]
credit_card_cleaner[which(example == max(example[example != max(example)]),
arr.ind = TRUE)[1, ], ]
Setelah kita melakukan penghitungan jarak antar observasi, kita akan memanfaatkan informasi tersebut untuk menentukan berapakah kelompok yang paling optimal yang akan dipakai. Hasil dari jumlah kelompok nantinya akan digunakan untuk menentukan berapa banyak segmentasi pengguna yang bisa dibuat berdasarkan data historis.
Dalam menentukan jumlah kelompok yang paling optimum, kita
menggunakan metode Elbow Method. Metode tersebut dapat kita
gunakan dengan fungsi fviz_nbclust() dari
library(factoextra). Pada fungsi tersebut nantinya akan ada
3 parameter yang bisa diisi
Penentual Nilai K
# Please type your code
set.seed(100)
fviz_nbclust(x = as.matrix(credit_card_gd),
FUNcluster = pam,
method = "wss",
k.max = 5)
Penentuan nilai K akan berdasarkan nilai WCSSnya. Kita bisa memilih
jumlah kelompok yang nilai WCSSnya paling kecil, akan tetapi setiap
penambahan kelompok nilai WCSSnya akan semakin mengecil. Dengan kata
lain kita bisa memilih nilai K yang penurunnya tidak terlalu
signifikan.
Dapat kita lihat dari grafik diatas nilai K yang penurunannya tidak terlalu landai itu berada pada nilai K = 3.
Sekarang kita mengelompokan semua data customer ke kelompok yang
sudah ditentukan dengan menggunakan fungsi pam().
# Please type your code
pam_fit <- pam(x = credit_card_gd,
k = 3)
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.
# Please type your code
credit_card_cleaner[pam_fit$medoids, ]
Dari tabel di atas kita hanya bisa mendapatkan gambaran awal mengenai 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.
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.
# Please type your code
set.seed(123)
tsnse_obj <- Rtsne(X = credit_card_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))
Dari hasil plot di atas, kita bisa melihat bahwa setiap observasi sudah cukup berhasil terbagi menjadi beberapa kelompok walaupun memang masih ada beberapa observasi yang tumpang tindih atau berdekatan pada sebuah kelompok yang didominasi oleh kelompok yang berlawanan. Catatan : Cluster merah masih terlalu tersebar
Tujuan melakukan statistik deskriptif adalah untuk memahami karakteristik masing-masing kelompok, dan dalam kasus ini untuk mengetahui karakteristik untuk setiap segmentasi kustomer.
# Please type your code
pam_result <-
credit_card_cleaner %>%
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: 24 College : 27 Divorced: 20
#> 1st Qu.:42.00 M:251 Doctorate : 14 Married : 62
#> Median :47.00 Graduate : 29 Single :170
#> Mean :47.42 High School :101 Unknown : 23
#> 3rd Qu.:53.00 Post-Graduate: 16
#> Max. :63.00 Uneducated : 48
#> Unknown : 40
#> Income_Category Months_Inactive_12_mon Credit_Limit Total_Trans_Amt
#> $120K + : 42 Min. :0.000 Min. : 1438 Min. : 530
#> $40K - $60K : 49 1st Qu.:1.000 1st Qu.: 4402 1st Qu.:1216
#> $60K - $80K :129 Median :2.000 Median : 9599 Median :1379
#> $80K - $120K : 33 Mean :2.011 Mean :12534 Mean :1459
#> Less than $40K: 10 3rd Qu.:3.000 3rd Qu.:18919 3rd Qu.:1626
#> Unknown : 12 Max. :5.000 Max. :34516 Max. :3663
#>
#> Total_Trans_Ct cluster
#> Min. :10.00 Min. :1
#> 1st Qu.:26.00 1st Qu.:1
#> Median :33.00 Median :1
#> Mean :35.01 Mean :1
#> 3rd Qu.:41.00 3rd Qu.:1
#> Max. :78.00 Max. :1
#>
#>
#> [[2]]
#> Customer_Age Gender Education_Level Marital_Status
#> Min. :26.00 F:354 College : 38 Divorced: 35
#> 1st Qu.:43.00 M: 16 Doctorate : 16 Married :244
#> Median :49.00 Graduate :124 Single : 82
#> Mean :49.17 High School : 65 Unknown : 9
#> 3rd Qu.:55.00 Post-Graduate: 23
#> Max. :70.00 Uneducated : 52
#> Unknown : 52
#> Income_Category Months_Inactive_12_mon Credit_Limit Total_Trans_Amt
#> $120K + : 0 Min. :0.000 Min. : 1438 Min. : 510
#> $40K - $60K : 69 1st Qu.:1.000 1st Qu.: 2425 1st Qu.:1181
#> $60K - $80K : 0 Median :2.000 Median : 3328 Median :1409
#> $80K - $120K : 0 Mean :2.186 Mean : 5362 Mean :1459
#> Less than $40K:239 3rd Qu.:3.000 3rd Qu.: 6250 3rd Qu.:1664
#> Unknown : 62 Max. :6.000 Max. :34516 Max. :4311
#>
#> Total_Trans_Ct cluster
#> Min. :12.00 Min. :2
#> 1st Qu.:27.00 1st Qu.:2
#> Median :33.00 Median :2
#> Mean :34.25 Mean :2
#> 3rd Qu.:40.00 3rd Qu.:2
#> Max. :78.00 Max. :2
#>
#>
#> [[3]]
#> Customer_Age Gender Education_Level Marital_Status
#> Min. :26.00 F: 0 College : 32 Divorced: 12
#> 1st Qu.:44.00 M:355 Doctorate : 13 Married :272
#> Median :48.00 Graduate :145 Single : 44
#> Mean :48.74 High School : 46 Unknown : 27
#> 3rd Qu.:54.00 Post-Graduate: 17
#> Max. :73.00 Uneducated : 48
#> Unknown : 54
#> Income_Category Months_Inactive_12_mon Credit_Limit Total_Trans_Amt
#> $120K + : 50 Min. :1.000 Min. : 1438 Min. : 596
#> $40K - $60K : 58 1st Qu.:2.000 1st Qu.: 4068 1st Qu.:1222
#> $60K - $80K : 69 Median :3.000 Median : 9959 Median :1465
#> $80K - $120K :169 Mean :2.541 Mean :12939 Mean :1485
#> Less than $40K: 6 3rd Qu.:3.000 3rd Qu.:19391 3rd Qu.:1728
#> Unknown : 3 Max. :6.000 Max. :34516 Max. :3981
#>
#> Total_Trans_Ct cluster
#> Min. :10.00 Min. :3
#> 1st Qu.:26.00 1st Qu.:3
#> Median :33.00 Median :3
#> Mean :34.31 Mean :3
#> 3rd Qu.:40.00 3rd Qu.:3
#> Max. :74.00 Max. :3
#>
Profiling Insight:
Pada tahapan ini kita akan mencoba untuk melihat karakteristik customer dari setiap kelompok yang dibuat, sekaligus kita akan mencoba untuk menentukan plan bisnis apa yang bisa kita coba sarankan kepada tim marketing berdasarkan karakteristik pengguna credit card.
pam_result$the_summary[[1]]
#> Customer_Age Gender Education_Level Marital_Status
#> Min. :26.00 F: 24 College : 27 Divorced: 20
#> 1st Qu.:42.00 M:251 Doctorate : 14 Married : 62
#> Median :47.00 Graduate : 29 Single :170
#> Mean :47.42 High School :101 Unknown : 23
#> 3rd Qu.:53.00 Post-Graduate: 16
#> Max. :63.00 Uneducated : 48
#> Unknown : 40
#> Income_Category Months_Inactive_12_mon Credit_Limit Total_Trans_Amt
#> $120K + : 42 Min. :0.000 Min. : 1438 Min. : 530
#> $40K - $60K : 49 1st Qu.:1.000 1st Qu.: 4402 1st Qu.:1216
#> $60K - $80K :129 Median :2.000 Median : 9599 Median :1379
#> $80K - $120K : 33 Mean :2.011 Mean :12534 Mean :1459
#> Less than $40K: 10 3rd Qu.:3.000 3rd Qu.:18919 3rd Qu.:1626
#> Unknown : 12 Max. :5.000 Max. :34516 Max. :3663
#>
#> Total_Trans_Ct cluster
#> Min. :10.00 Min. :1
#> 1st Qu.:26.00 1st Qu.:1
#> Median :33.00 Median :1
#> Mean :35.01 Mean :1
#> 3rd Qu.:41.00 3rd Qu.:1
#> Max. :78.00 Max. :1
#>
Cluster 1 - Mayoritas Gendernya adalah Male
Education level pengguna kebanyakan High School dan tentu saja Marital statusnya single
Penghasilan di cluster 1 menengah sekitar 60-80 ribu
Credit Limit cukup tinggi sekitar 12534
Total jumlah transaksi sekitar 1459 dan ada sekitar 33-35 transaksi dalam 12 bulan terakhir
pam_result$the_summary[[2]]
#> Customer_Age Gender Education_Level Marital_Status
#> Min. :26.00 F:354 College : 38 Divorced: 35
#> 1st Qu.:43.00 M: 16 Doctorate : 16 Married :244
#> Median :49.00 Graduate :124 Single : 82
#> Mean :49.17 High School : 65 Unknown : 9
#> 3rd Qu.:55.00 Post-Graduate: 23
#> Max. :70.00 Uneducated : 52
#> Unknown : 52
#> Income_Category Months_Inactive_12_mon Credit_Limit Total_Trans_Amt
#> $120K + : 0 Min. :0.000 Min. : 1438 Min. : 510
#> $40K - $60K : 69 1st Qu.:1.000 1st Qu.: 2425 1st Qu.:1181
#> $60K - $80K : 0 Median :2.000 Median : 3328 Median :1409
#> $80K - $120K : 0 Mean :2.186 Mean : 5362 Mean :1459
#> Less than $40K:239 3rd Qu.:3.000 3rd Qu.: 6250 3rd Qu.:1664
#> Unknown : 62 Max. :6.000 Max. :34516 Max. :4311
#>
#> Total_Trans_Ct cluster
#> Min. :12.00 Min. :2
#> 1st Qu.:27.00 1st Qu.:2
#> Median :33.00 Median :2
#> Mean :34.25 Mean :2
#> 3rd Qu.:40.00 3rd Qu.:2
#> Max. :78.00 Max. :2
#>
Cluster 2 - Mayoritas Gendernya adalah Female
Education level pengguna kebanyakan Graduate dan Marital statusnya Married
Penghasilan relatif rendah kurang dari 40 ribu
Credit Limit rendah sekitar 5362
Total jumlah transaksi sekitar 1459 dan ada sekitar 33-34 transaksi dalam 12 bulan terakhir
pam_result$the_summary[[3]]
#> Customer_Age Gender Education_Level Marital_Status
#> Min. :26.00 F: 0 College : 32 Divorced: 12
#> 1st Qu.:44.00 M:355 Doctorate : 13 Married :272
#> Median :48.00 Graduate :145 Single : 44
#> Mean :48.74 High School : 46 Unknown : 27
#> 3rd Qu.:54.00 Post-Graduate: 17
#> Max. :73.00 Uneducated : 48
#> Unknown : 54
#> Income_Category Months_Inactive_12_mon Credit_Limit Total_Trans_Amt
#> $120K + : 50 Min. :1.000 Min. : 1438 Min. : 596
#> $40K - $60K : 58 1st Qu.:2.000 1st Qu.: 4068 1st Qu.:1222
#> $60K - $80K : 69 Median :3.000 Median : 9959 Median :1465
#> $80K - $120K :169 Mean :2.541 Mean :12939 Mean :1485
#> Less than $40K: 6 3rd Qu.:3.000 3rd Qu.:19391 3rd Qu.:1728
#> Unknown : 3 Max. :6.000 Max. :34516 Max. :3981
#>
#> Total_Trans_Ct cluster
#> Min. :10.00 Min. :3
#> 1st Qu.:26.00 1st Qu.:3
#> Median :33.00 Median :3
#> Mean :34.31 Mean :3
#> 3rd Qu.:40.00 3rd Qu.:3
#> Max. :74.00 Max. :3
#>
Cluster 3 - Pada cluster ini semua Gender nya adalah Male
Education level pengguna kebanyakan Graduate dan Marital statusnya Married sama seperti di Cluster 2
Penghasilan paling tinggi sekitar 80-120 ribu
Credit Limit tinggi sekitar 12939
Total jumlah transaksi sekitar 1485 dan ada sekitar 33-34 transaksi dalam 12 bulan terakhir
CLuster 3 adalah cluster tertinggi Inactive dalam 12 bulan terakhir
Saran Bisnis :
Cluster 3 adalah cluster dengan income tertinggi namun tingkat
transaksinya cenderung sama dengan Cluster lain yg income nya dibawah.
Selain itu tingkat Inactive nya tertinggi dibanding cluster lain. Oleh
karena itu kita perlu meningkatkan Credit Limit karena ada
kemungkinan pengguna di Cluster ini akan membeli barang-barang
mewah
Cluster 1 mayoritas pengguna nya adalah High School
dengan income category menengah, kita dapat memberikan
diskon & voucher belanja untuk produk
perlengkapan sekolah serta barang-barang elektronik seperti handphone
dan laptop yang saat ini sangat digemari.
Team marketing dapat menawarkan fitur poin dan
cashback untuk Cluster 2 karena tingkat pembelian yang
tinggi namun income yang rendah sehingga menjaga agar tetap menggunakan
kartu kredit.
Menawarkan fitur Airmiles pada Cluster 3, karena
Income yang tinggi kemungkinan melakukan transaksi tiket pesawat juga
tinggi untuk liburan ataupun perjalanan bisnis