Klasifikasi Menggunakan Naive Bayes, Decision Tree, dan Random Forest
Justinus Dedy Handyka Simanjuntak
4/10/2022
Introduction
Pada kesempatan kali ini saya akan membandingkan model yang paling optimal untuk memprediksi apakah nasabah akan berlangganan (beli) atau tidak pada produk (deposito bank berjangka). Data ini terkait dengan kampanye direct marketing dari lembaga perbankan Portugis. Direct marketing didasarkan pada panggilan telepon. Seringkali, untuk klien yang sama dibutuhkan lebih dari 1 kali penawaran(telpon).
Libarary
library(tidyverse)
library(dplyr)
library(ggplot2)
library(e1071)
library(caret)
library(ROCR)
library(GGally)
library(randomForest)
library(gridExtra)Read Data
Dataset yang digunakan berasal dari “Bank Marketing” UCI dataset”
bank <- read.csv("bank-additional.csv", sep = ";")
glimpse(bank)## Rows: 4,119
## Columns: 21
## $ age <int> 30, 39, 25, 38, 47, 32, 32, 41, 31, 35, 25, 36, 36, 47,~
## $ job <chr> "blue-collar", "services", "services", "services", "adm~
## $ marital <chr> "married", "single", "married", "married", "married", "~
## $ education <chr> "basic.9y", "high.school", "high.school", "basic.9y", "~
## $ default <chr> "no", "no", "no", "no", "no", "no", "no", "unknown", "n~
## $ housing <chr> "yes", "no", "yes", "unknown", "yes", "no", "yes", "yes~
## $ loan <chr> "no", "no", "no", "unknown", "no", "no", "no", "no", "n~
## $ contact <chr> "cellular", "telephone", "telephone", "telephone", "cel~
## $ month <chr> "may", "may", "jun", "jun", "nov", "sep", "sep", "nov",~
## $ day_of_week <chr> "fri", "fri", "wed", "fri", "mon", "thu", "mon", "mon",~
## $ duration <int> 487, 346, 227, 17, 58, 128, 290, 44, 68, 170, 301, 148,~
## $ campaign <int> 2, 4, 1, 3, 1, 3, 4, 2, 1, 1, 1, 1, 2, 2, 2, 2, 6, 4, 2~
## $ pdays <int> 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, ~
## $ previous <int> 0, 0, 0, 0, 0, 2, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0~
## $ poutcome <chr> "nonexistent", "nonexistent", "nonexistent", "nonexiste~
## $ emp.var.rate <dbl> -1.8, 1.1, 1.4, 1.4, -0.1, -1.1, -1.1, -0.1, -0.1, 1.1,~
## $ cons.price.idx <dbl> 92.893, 93.994, 94.465, 94.465, 93.200, 94.199, 94.199,~
## $ cons.conf.idx <dbl> -46.2, -36.4, -41.8, -41.8, -42.0, -37.5, -37.5, -42.0,~
## $ euribor3m <dbl> 1.313, 4.855, 4.962, 4.959, 4.191, 0.884, 0.879, 4.191,~
## $ nr.employed <dbl> 5099.1, 5191.0, 5228.1, 5228.1, 5195.8, 4963.6, 4963.6,~
## $ y <chr> "no", "no", "no", "no", "no", "no", "no", "no", "no", "~Deskripsi dari tiap kolom pada dataset sebagai berikut:
data klien bank:
*age (numeric)
*job: jenis pekerjaan (categorical: “admin.”,“blue-collar”,“entrepreneur”,“housemaid”,“management”,“retired”,“self-employed”,“services”,“student”,“technician”,“unemployed”,“unknown”)
*marital: status perkawinan (categorical: “divorced”,“married”,“single”,“unknown”; note: “divorced” means divorced or widowed)
*education (categorical: “basic.4y”, “basic.6y”, “basic.9y”, “high.school”, “illiterate”, “professional.course”, “university.degree”, “unknown”)
*default: memiliki kredit dalam default? (categorical: “no”,“yes”,“unknown”)
*housing: memiliki pinjaman perumahan? (categorical: “no”,“yes”,“unknown”)
*loan: memiliki pinjaman pribadi? (categorical: “no”,“yes”,“unknown”)
*terkait dengan kontak terakhir kampanye saat ini:
*contact: jenis komunikasi kontak (categorical: “cellular”,“telephone”)
*month: bulan kontak terakhir dalam setahun (categorical: “jan”, “feb”, “mar”, …, “nov”, “dec”)
*day_of_week: hari kontak terakhir dalam seminggu (categorical: “mon”,“tue”,“wed”,“thu”,“fri”)
*duration: durasi kontak terakhir, dalam detik (numerik) atribut lainnya:
*campaign: jumlah kontak yang dilakukan selama kampanye ini dan untuk klien ini (numeric, includes last contact)
*pdays: jumlah hari yang berlalu setelah klien terakhir dihubungi dari kampanye sebelumnya (numeric; 999 berarti klien sebelumnya tidak dihubungi)
*previous: jumlah kontak yang dilakukan sebelum kampanye ini dan untuk klien ini (numeric)
*poutcome: hasil dari kampanye pemasaran sebelumnya (categorical: “failure”,“nonexistent”,“success”)
*Atribut konteks sosial dan ekonomi
*emp.var.rate: tingkat variasi pekerjaan - indikator triwulanan (numeric)
*cons.price.idx: indeks harga konsumen - indikator bulanan (numeric)
*cons.conf.idx: indeks kepercayaan konsumen - indikator bulanan (numeric)
*euribor3m: euribor 3 bulan kurs - indikator harian (numeric)
*nr.employed: jumlah karyawan - indikator triwulanan (numeric)
*Variabel output (target yang diinginkan):
y: apakah klien berlangganan deposito berjangka? (binary: “yes”,“no”)
Data Wrangling
Cek apakah ada data yang belum sesuai dan cek missing value. Membuang variabel Duration karna tidak digunakan. Disini saya akan memfilter(menganalisa) berdasarkan job admin.
bank <- bank %>%
mutate_if(is.character, as.factor) %>%
select(-pdays)
head(bank)anyNA(bank)## [1] FALSEExploratory Data Analysis
Target Variable Proportion
GGally::ggcorr(bank, hjust = 1, layout.exp = 2, label = T, label_size = 2.9)## Warning in GGally::ggcorr(bank, hjust = 1, layout.exp = 2, label = T, label_size
## = 2.9): data in column(s) 'job', 'marital', 'education', 'default', 'housing',
## 'loan', 'contact', 'month', 'day_of_week', 'poutcome', 'y' are not numeric and
## were ignored
Beberapa variabel tidak bertipe numerik dan diabaikan kita perlu mengubah terlebih dahulu
bank_temp <- bank %>% mutate_if(is.factor, as.numeric)
glimpse(bank_temp)## Rows: 4,119
## Columns: 20
## $ age <int> 30, 39, 25, 38, 47, 32, 32, 41, 31, 35, 25, 36, 36, 47,~
## $ job <dbl> 2, 8, 8, 8, 1, 8, 1, 3, 8, 2, 8, 7, 1, 2, 1, 8, 1, 1, 3~
## $ marital <dbl> 2, 3, 2, 2, 2, 3, 3, 2, 1, 2, 3, 3, 2, 2, 3, 3, 1, 1, 2~
## $ education <dbl> 3, 4, 4, 3, 7, 7, 7, 7, 6, 3, 2, 1, 4, 1, 4, 7, 7, 7, 7~
## $ default <dbl> 1, 1, 1, 1, 1, 1, 1, 2, 1, 2, 2, 1, 1, 1, 1, 1, 1, 1, 2~
## $ housing <dbl> 3, 1, 3, 2, 3, 1, 3, 3, 1, 1, 3, 1, 1, 3, 1, 1, 1, 3, 3~
## $ loan <dbl> 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 3~
## $ contact <dbl> 1, 2, 2, 2, 1, 1, 1, 1, 1, 2, 1, 1, 2, 2, 1, 1, 1, 2, 1~
## $ month <dbl> 7, 7, 5, 5, 8, 10, 10, 8, 8, 7, 4, 4, 7, 5, 7, 4, 4, 4,~
## $ day_of_week <dbl> 1, 1, 5, 1, 2, 3, 2, 2, 4, 3, 3, 3, 5, 3, 1, 5, 5, 2, 2~
## $ duration <int> 487, 346, 227, 17, 58, 128, 290, 44, 68, 170, 301, 148,~
## $ campaign <int> 2, 4, 1, 3, 1, 3, 4, 2, 1, 1, 1, 1, 2, 2, 2, 2, 6, 4, 2~
## $ previous <int> 0, 0, 0, 0, 0, 2, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0~
## $ poutcome <dbl> 2, 2, 2, 2, 2, 1, 2, 2, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2~
## $ emp.var.rate <dbl> -1.8, 1.1, 1.4, 1.4, -0.1, -1.1, -1.1, -0.1, -0.1, 1.1,~
## $ cons.price.idx <dbl> 92.893, 93.994, 94.465, 94.465, 93.200, 94.199, 94.199,~
## $ cons.conf.idx <dbl> -46.2, -36.4, -41.8, -41.8, -42.0, -37.5, -37.5, -42.0,~
## $ euribor3m <dbl> 1.313, 4.855, 4.962, 4.959, 4.191, 0.884, 0.879, 4.191,~
## $ nr.employed <dbl> 5099.1, 5191.0, 5228.1, 5228.1, 5195.8, 4963.6, 4963.6,~
## $ y <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1~GGally::ggcorr(bank_temp, hjust = 1, layout.exp = 2, label = T, label_size = 3)
Cek class imbalance
prop.table(table(bank$y))##
## no yes
## 0.8905074 0.1094926terdapat class imbalance pada data bank, kita dapat mengatasinya dengan melakukan down sampling
set.seed(123)
bank_down <- downSample(x = bank%>% select(-y), # prediktor
y = bank$y, # target
yname = "y") # nama kolom targetprop.table(table(bank_down$y))##
## no yes
## 0.5 0.5Cross Validation
Melakukan splitting data menjadi :
*Data Train : digunakan untuk modeling
*Data Test : digunakan sebagai penguji model yang sudah dibuat
RNGkind(sample.kind = "Rounding")
set.seed(100)
index <- sample(nrow(bank_down), nrow(bank_down)*0.8)
data_train <- bank_down[index, ]
data_test <- bank_down[-index, ]prop.table(table(data_train$y))##
## no yes
## 0.4840499 0.5159501Naive Bayes
#Built Model
naive_model <- naiveBayes(y~.,data=data_train)
#Prediction
prediction <- predict(naive_model,data_test)
#Evaluasi Model
confusionMatrix(prediction,data_test$y, positive = "yes")## Confusion Matrix and Statistics
##
## Reference
## Prediction no yes
## no 78 16
## yes 24 63
##
## Accuracy : 0.779
## 95% CI : (0.7115, 0.8372)
## No Information Rate : 0.5635
## P-Value [Acc > NIR] : 1.098e-09
##
## Kappa : 0.5558
##
## Mcnemar's Test P-Value : 0.2684
##
## Sensitivity : 0.7975
## Specificity : 0.7647
## Pos Pred Value : 0.7241
## Neg Pred Value : 0.8298
## Prevalence : 0.4365
## Detection Rate : 0.3481
## Detection Prevalence : 0.4807
## Balanced Accuracy : 0.7811
##
## 'Positive' Class : yes
## Hasil confusionmatrix menunjukkan bahwa klasifikasi Naive Bayes memperkirakan 77 kasus pelanggan tidak berlangganan dengan benar dan 14 prediksi salah. Demikian pula, model memprediksi 65 kasus pelanggan berlangganan dengan benar dan 25 prediksi salah. Bagimana tingkat akurasinya?? Dapat kita lihat tingkat akurasi model sebesar 78.45%
Decision Tree
Uji dataset menggunakan klasifikasi Decision Tree.
library(partykit)## Loading required package: grid## Loading required package: libcoin## Loading required package: mvtnormd3_model <- ctree(y~ .,data_train)
plot(d3_model, type = "simple")
Kita bisa melihat banyaknya pembagian/daun (width) dan banyak lapisan/tingkatan (depth) nya. Dimana :
[1] adalah Root Node atau akar
[2], [11], [4], [12], [5], [13] dan [7] adalah Internal Nodes atau cabang. Cabang ini ditunjukkan dengan adanya panah yang mengarah ke mereka, dan ada panah yang mengarah dari mereka.
[3], [17], [10], [16], [6], [14], [15] dan [9] adalah Leaf Nodes atau daun. Daun ditunjukkan dengan panah yang mengarah ke mereka, namun tidak ada panah yang mengarah dari mereka.
width(d3_model)## [1] 9depth(d3_model)## [1] 4Melakukan Prediksi
pred_d3 <- predict(d3_model,data_test)Evaluasi Model
confusionMatrix(pred_d3, data_test$y, positive = "yes")## Confusion Matrix and Statistics
##
## Reference
## Prediction no yes
## no 87 16
## yes 15 63
##
## Accuracy : 0.8287
## 95% CI : (0.7658, 0.8806)
## No Information Rate : 0.5635
## P-Value [Acc > NIR] : 3.141e-14
##
## Kappa : 0.6513
##
## Mcnemar's Test P-Value : 1
##
## Sensitivity : 0.7975
## Specificity : 0.8529
## Pos Pred Value : 0.8077
## Neg Pred Value : 0.8447
## Prevalence : 0.4365
## Detection Rate : 0.3481
## Detection Prevalence : 0.4309
## Balanced Accuracy : 0.8252
##
## 'Positive' Class : yes
## Pada Model ini tingkat akurasi didapatkan 86.19% lebih tinggi dari model sebelumnya. Selanjutnya kita coba membuat model dengan menggunakan metode Random Forest, apakah model menjadi lebih baik atau sebaliknya.
Random Forest
Pembuatan model klasifikasi menggunakan Random Forest bisa lebih dioptimalkan dengan penerapan teknik evaluasi model yang disebut K-fold Cross Validation. Teknik ini akan membagi data sebanyak k bagian, dan setiap bagian akan menjadi data test secara bergantian, sehingga semua data punya kesempatan menjadi data test maupun data train. Sedangkan pada Cross validation biasa hanya membagi data menjadi data_train dan data_test secara tetap.
Dari data_train yang dibuat, misalkan kita akan membuat model random forest dengan K-fold Cross Validation (k=2) dan pembuatan set k-fold tersebut dilakukan 1 kali.
RNGkind(sample.kind = "Rounding")
set.seed(123)
ctrl <- trainControl(method="repeatedcv", number = 2, repeats = 1)
model_forest <- train(y ~ ., data = data_train, method = "rf", trControl = ctrl)
saveRDS(model_forest, "model_rforest.RDS")Kita dapat memanggil kembali model yang telah dibangun dengan menggunakan data train.
model_rforest <- readRDS("model_rforest.RDS")
model_rforest## Random Forest
##
## 721 samples
## 19 predictor
## 2 classes: 'no', 'yes'
##
## No pre-processing
## Resampling: Cross-Validated (2 fold, repeated 1 times)
## Summary of sample sizes: 360, 361
## Resampling results across tuning parameters:
##
## mtry Accuracy Kappa
## 2 0.7961180 0.5939225
## 27 0.8904047 0.7801864
## 52 0.8848607 0.7692839
##
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was mtry = 27.Dari summary model, diketahui bahwa jumlah variabel optimal yang dipertimbangkan untuk dipecah pada setiap simpul pohon adalah 26
library(randomForest)
model_rforest$finalModel##
## Call:
## randomForest(x = x, y = y, mtry = min(param$mtry, ncol(x)))
## Type of random forest: classification
## Number of trees: 500
## No. of variables tried at each split: 27
##
## OOB estimate of error rate: 10.68%
## Confusion matrix:
## no yes class.error
## no 301 48 0.13753582
## yes 29 343 0.07795699Dari hasil di atas, dapat memprediksi data tidak deposit(berlangganan) sebanyak 293 benar dan 56 salah, serta data deposit(berlangganan) sebesar 346 benar dan 26 salah.
Selanjutnya dilihat variabel-variabel yang penting dalam model Random Forest. Fungsi varImp() dapat digunakan untuk tujuan ini.
varImp(model_rforest)## rf variable importance
##
## only 20 most important variables shown (out of 52)
##
## Overall
## duration 100.000
## nr.employed 35.802
## euribor3m 24.923
## age 10.326
## cons.conf.idx 7.334
## emp.var.rate 7.250
## campaign 5.947
## cons.price.idx 5.019
## jobretired 2.586
## poutcomesuccess 2.137
## educationprofessional.course 2.112
## jobtechnician 1.944
## monthmar 1.839
## housingyes 1.772
## day_of_weekthu 1.536
## loanyes 1.408
## educationhigh.school 1.233
## day_of_weekwed 1.194
## monthmay 1.155
## day_of_weektue 1.133Dari hasil diatas dapat dilihat bahwa duration adalah variabel yang paling berpengaruh dari y(deposit atau tidak)
Melakukan predict dan evaluasi model
predict_forest <- predict(model_forest, data_test)
(conf_matrix_forest <- table(predict_forest, data_test$y))##
## predict_forest no yes
## no 90 14
## yes 12 65confusionMatrix(conf_matrix_forest, positive = "yes") ## Confusion Matrix and Statistics
##
##
## predict_forest no yes
## no 90 14
## yes 12 65
##
## Accuracy : 0.8564
## 95% CI : (0.7966, 0.904)
## No Information Rate : 0.5635
## P-Value [Acc > NIR] : <2e-16
##
## Kappa : 0.7072
##
## Mcnemar's Test P-Value : 0.8445
##
## Sensitivity : 0.8228
## Specificity : 0.8824
## Pos Pred Value : 0.8442
## Neg Pred Value : 0.8654
## Prevalence : 0.4365
## Detection Rate : 0.3591
## Detection Prevalence : 0.4254
## Balanced Accuracy : 0.8526
##
## 'Positive' Class : yes
## Didapatkan akurasi model Random Forest adalah 86.74% yang berati lebih baik sedikit dari model sebelumnya.
Conclusion
Duration adalah salah satu variabel yang paling berpengaruh untuk nasabah membeli produk.
Dalam mendapatkan performa terbaik untuk tiap-tiap model khususnya pada model Naive Bayes dan Decision Tree masih dapat ditingkatkan performanya dengan mengubah nilai cutoff yang paling sesuai dan memberikan persentase recall yang tinggi namun tidak terlalu merubah tingkat akurasi. Dalam analisa ini tentunya kita ingin meminimalisir False Positive
Dari ketiga model diatas Random Forest adalah model yang paling optimal dalam melakukan prediksi nasabah untuk membeli