0.1 Introduction

Halo!

Pada classification II kali ini, kita akan membuat model algortima klasifikasi. Data yang digunakan adalah data yang mengenai telemarketing dari sebuah bank di Portugal. Dengan data ini, kita dapat memprediksi calon nasabah mana yang akan membeli product ketika di tawarkan oleh pihak bank melalui telepon.

##Data Preparation

0.1.1 Import Library

library(dplyr) # dplyr
library(e1071) # naive bayes
library(caret) # evaluasi & model aka confussion matrix
library(rsample) #splitting data
library(randomForest)# Random Forest
library(ROCR)# ROCR
library(partykit)# Decision Tree

0.1.2 Import Data

#import data
bank <- read.csv(file = "bank/bank.csv", sep = ";") #Menggunakan sep = ";" untuk memisahkan kolom


#Mengecheck data yang ada
glimpse(bank)
#> Rows: 4,521
#> Columns: 17
#> $ age       <int> 30, 33, 35, 30, 59, 35, 36, 39, 41, 43, 39, 43, 36, 20, 31, …
#> $ job       <chr> "unemployed", "services", "management", "management", "blue-…
#> $ marital   <chr> "married", "married", "single", "married", "married", "singl…
#> $ education <chr> "primary", "secondary", "tertiary", "tertiary", "secondary",…
#> $ default   <chr> "no", "no", "no", "no", "no", "no", "no", "no", "no", "no", …
#> $ balance   <int> 1787, 4789, 1350, 1476, 0, 747, 307, 147, 221, -88, 9374, 26…
#> $ housing   <chr> "no", "yes", "yes", "yes", "yes", "no", "yes", "yes", "yes",…
#> $ loan      <chr> "no", "yes", "no", "yes", "no", "no", "no", "no", "no", "yes…
#> $ contact   <chr> "cellular", "cellular", "cellular", "unknown", "unknown", "c…
#> $ day       <int> 19, 11, 16, 3, 5, 23, 14, 6, 14, 17, 20, 17, 13, 30, 29, 29,…
#> $ month     <chr> "oct", "may", "apr", "jun", "may", "feb", "may", "may", "may…
#> $ duration  <int> 79, 220, 185, 199, 226, 141, 341, 151, 57, 313, 273, 113, 32…
#> $ campaign  <int> 1, 1, 1, 4, 1, 2, 1, 2, 2, 1, 1, 2, 2, 1, 1, 2, 5, 1, 1, 1, …
#> $ pdays     <int> -1, 339, 330, -1, -1, 176, 330, -1, -1, 147, -1, -1, -1, -1,…
#> $ previous  <int> 0, 4, 1, 0, 0, 3, 2, 0, 0, 2, 0, 0, 0, 0, 1, 0, 0, 2, 0, 1, …
#> $ poutcome  <chr> "unknown", "failure", "failure", "unknown", "unknown", "fail…
#> $ y         <chr> "no", "no", "no", "no", "no", "no", "no", "no", "no", "no", …

Pada dataset ini tersedia keterangan mengenai masing - masing variabelnya, berikut mengenai masing - masing variabel tersebut :

• Age: Umur klien (variabel numerik)

• Job: Jenis pekerjaan klien (variabel kategorikal)

• Marital: Status perkawinan klien (variabel kategorikal)

• Education: Tingkat pendidikan klien (variabel kategorikal

• Default: Apakah klien memiliki kredit yang dalam keadaan default? (variabel biner)

• Balance: Rata-rata saldo tahunan klien dalam euro (variabel numerik)

• Housing: Apakah klien memiliki pinjaman rumah? (variabel biner)

• Loan: Apakah klien memiliki pinjaman pribadi? (variabel biner)

• Contact: Jenis komunikasi kontak terakhir (variabel kategorikal)

• Day: Hari terakhir kontak dalam bulan (variabel numerik)

• Month: Bulan terakhir kontak dalam tahun (variabel kategorikal)

• Duration: Durasi kontak terakhir dalam detik (variabel numerik)

• Campaign: Jumlah kontak yang dilakukan selama kampanye ini untuk klien (variabel numerik)

• Pdays: Jumlah hari yang telah berlalu setelah klien terakhir dihubungi dari kampanye sebelumnya (variabel numerik)

• Previous: Jumlah kontak yang dilakukan sebelum kampanye ini untuk klien (variabel numerik)

• Poutcome: Hasil kampanye pemasaran sebelumnya (variabel kategorikal)

• Y: Variabel target yang menunjukkan apakah klien telah berlangganan deposito jangka pendek (variabel biner)

Pada dataset yang kita miliki ada beberapa kolom yang perlu diubah tipe datanya, kita akan menggunakan fungsi mutate untuk mengubah tipe data tersebut.

bank <- bank %>%
  mutate(job = as.factor(job),
         marital = as.factor(marital),
         education = as.factor(education),
         default = as.factor(default),
         housing = as.factor(housing),
         loan = as.factor(loan),
         contact = as.factor(contact),
         month = as.factor(month),
         poutcome = as.factor(poutcome),
         subscribe = as.factor(y)) %>% 
  select(-c(y))

0.1.3 Checking Missing Value

#Menggunakan fungsi `colSums`
colSums(is.na(bank))
#>       age       job   marital education   default   balance   housing      loan 
#>         0         0         0         0         0         0         0         0 
#>   contact       day     month  duration  campaign     pdays  previous  poutcome 
#>         0         0         0         0         0         0         0         0 
#> subscribe 
#>         0

Setelah kita mengetahui bahwa data kita tidak ada Missing Value, selanjutnya kita mengecheck apakah data yang kita miliki balance atau tidak

prop.table(table(bank$subscribe))
#> 
#>      no     yes 
#> 0.88476 0.11524

Terlihat data kita imbalance, Artinya data mengacu pada situasi di mana jumlah observasi tidak sama untuk semua kelas dalam kumpulan data klasifikasi. Untuk menghindari hilangnya varians, kita akan menggunakan upsampling untuk menyeimbangkan proporsinya.

0.2 Cross Validation

Cross-validation aka (CV) merupakan metode statistik yang dapat digunakan untuk mengevaluasi kinerja model atau algoritma dimana datanya dipisahkan menjadi dua subset yaitu data proses pembelajaran dan data validasi/evaluasi. Dalam hal ini kita akan memisahkan data dengan proporsi 80% dataset untuk data pelatihan dan sisanya 20% kita gunakan sebagai data uji.

RNGkind(sample.kind = "Rounding")
set.seed(101)

split <- initial_split(data = bank, prop = 0.8, strata = subscribe)
bank_train <- training(split)
bank_test <- testing(split)

Check kembali proporsi yang ada

prop.table(table(bank_train$subscribe))
#> 
#>        no       yes 
#> 0.8849558 0.1150442

Sepertinya data kita masih tidak balance, dan perlu kita ubah agar menjadi balance

RNGkind(sample.kind = "Rounding")
set.seed(101)

#Menggunakan fungsi UpSample
bank_train_upsample <- upSample(x = bank_train %>%  select(-subscribe),
                         y = bank_train$subscribe,
                         yname = "subscribe")

Check kembali proporsi targer

prop.table(table(bank_train_upsample$subscribe))
#> 
#>  no yes 
#> 0.5 0.5

Sekarang data kita sudah balance!

0.3 Modeling

0.3.1 Naive Bayes

Kita akan membuat permodelan Naive Bayes, dimana Naive Bayes adalah Model Naive Bayes adalah salah satu model klasifikasi yang digunakan dalam pembelajaran mesin dan statistik. Model ini didasarkan pada teorema Bayes, dan itu adalah metode yang sederhana dan efisien untuk mengklasifikasikan data ke dalam kategori atau kelas yang berbeda.

#Menggunakan Fungsi naiveBayes
model_naive <- naiveBayes(subscribe ~ ., data = bank_train_upsample, laplace = 1)
naive_prediction <- predict(model_naive, bank_test)
naive_prediction_raw <- as.data.frame(predict(model_naive, bank_test, type = "raw"))

naive_prediction_raw <- naive_prediction_raw %>%
  mutate(no = round(no,4),
         yes = round(yes,4))
naive_matrix <- confusionMatrix(naive_prediction, bank_test$subscribe, positive = "yes")
table <- as.table(naive_matrix)
table <- as.data.frame(table)

table %>% ggplot(aes(x = Prediction, y = Reference, fill = Freq)) +
  geom_tile() +
  geom_text(aes(label = Freq), fontface = "bold", color = "white") +
  theme_minimal() +
  theme(legend.position = "none")

Confussion Matrix Tabel ini menjelaskan:

  • Akurasi: kemampuan memprediksi kedua kelas dengan benar dari total observasi.
  • Presisi : kemampuan memprediksi kelas positif secara tepat dari total kelas prediksi positif (positif palsu rendah).
  • Ingat: kemampuan memprediksi dengan tepat kelas positif dari total kelas positif aktual (negatif palsu rendah).
  • Spesifisitas: kemampuan memprediksi dengan tepat kelas negatif dari total kelas negatif aktual.

0.3.2 ROC

Selanjutnya kita akan menggunakan ROC untuk melihat hubungan

ROC adalah kurva yang menggambarkan hubungan antara True Positive Rate dengan False Positive Rate pada setiap threshold. Model yang baik idealnya memiliki True Positive Rate yang tinggi dan False Positive Rate yang rendah.

#Memanggil ROC
naive_roc <- data.frame(prediction = naive_prediction_raw[,2],
                        trueclass = as.numeric(bank_test$subscribe=="yes"))
tail(naive_roc)
naive_roc_pred <- prediction(naive_roc$prediction, naive_roc$trueclass) 

# Membuat ROC curve
plot(performance(naive_roc_pred, "tpr", "fpr"),
     main = "ROC")
abline(a = 0, b = 1)

Karena berbentuk visual, kurva ROC sulit untuk dibandingkan antar model. Oleh karena itu diperlukan AUC.

0.3.3 AUC

AUC (Area Under Curve) adalah area di bawah kurva ROC. Nilai-nilai AUC mengindikasikan sejauh mana keberhasilan model dalam memprediksi atau membedakan dua kelas yang berbeda.

Nilai AUC memiliki rentang antara 0 hingga 1. Jika nilai AUC mendekati 1, itu berarti model klasifikasi mampu memprediksi atau membedakan kedua kelas dengan baik. Namun, jika nilai AUC mendekati 0,5, itu menunjukkan bahwa model klasifikasi tidak cukup baik dalam memprediksi atau membedakan kedua kelas.

Ketika nilai AUC mendekati 1, itu berarti model klasifikasi dapat memprediksi atau membedakan kedua kelas dengan baik. Namun, ketika nilai AUC mendekati 0,5, itu menunjukkan bahwa model klasifikasi tidak mampu memprediksi atau membedakan kedua kelas dengan baik.

Mari kita lihat apakah model kita bagus atau tidak

auc <- performance(naive_roc_pred, measure = "auc")
auc <- auc@y.values[[1]]
auc
#> [1] 0.840381

Berdasarkan hasil kurva ROC dan nilai AUC, kita melihat bahwa kurva ROC menunjukkan pemisahan yang baik dengan skor AUC sebesar 0,8456519. Ini mengindikasikan bahwa kita memiliki peluang untuk meningkatkan model Naive Bayes ini. Dalam model Naive Bayes kita, akurasi, sensitivitas, dan spesifisitas sudah cukup baik, tetapi nilai positif prediksi kita masih rendah, yaitu sebesar 30%.

Dalam konteks kasus kita, berfokus pada kelas “Tidak,” yang berarti kita ingin menghindari menelepon orang yang diprediksi tidak ingin membeli produk atau layanan yang ditawarkan oleh pemasaran melalui telepon. Oleh karena itu, kita lebih berfokus pada parameter Sensitivitas, yang menunjukkan bahwa model Naive Bayes kita sudah memberikan hasil yang baik.

0.3.4 Decision Tree

Decision tree merupakan tree-based model yang cukup sederhana dengan performa yang robust/powerful untuk prediksi. Decision Tree menghasilkan visualisasi berupa pohon keputusan. Kita akan membuat model Decison Tree pada dataset yang ada

#Membuat Model Decision tree

model_tree <- ctree(subscribe ~.,
                    bank_train,
                    control = ctree_control(mincriterion=0.8,
                                             minsplit=0.3,
                                             minbucket=0.3))
model_tree
#> 
#> Model formula:
#> subscribe ~ age + job + marital + education + default + balance + 
#>     housing + loan + contact + day + month + duration + campaign + 
#>     pdays + previous + poutcome
#> 
#> Fitted party:
#> [1] root
#> |   [2] duration <= 631
#> |   |   [3] poutcome in failure, other, unknown
#> |   |   |   [4] duration <= 292
#> |   |   |   |   [5] month in apr, aug, dec, feb, jan, jul, jun, may, nov
#> |   |   |   |   |   [6] month in apr, feb
#> |   |   |   |   |   |   [7] day <= 9: no (n = 114, err = 0.9%)
#> |   |   |   |   |   |   [8] day > 9
#> |   |   |   |   |   |   |   [9] month in apr
#> |   |   |   |   |   |   |   |   [10] housing in no: no (n = 36, err = 27.8%)
#> |   |   |   |   |   |   |   |   [11] housing in yes: no (n = 91, err = 3.3%)
#> |   |   |   |   |   |   |   [12] month in feb: no (n = 19, err = 47.4%)
#> |   |   |   |   |   [13] month in aug, dec, jan, jul, jun, may, nov
#> |   |   |   |   |   |   [14] poutcome in failure, other
#> |   |   |   |   |   |   |   [15] month in aug, jun: no (n = 28, err = 25.0%)
#> |   |   |   |   |   |   |   [16] month in dec, jan, jul, may, nov
#> |   |   |   |   |   |   |   |   [17] job in admin., retired, student, unemployed, unknown: no (n = 66, err = 13.6%)
#> |   |   |   |   |   |   |   |   [18] job in blue-collar, entrepreneur, housemaid, management, self-employed, services, technician
#> |   |   |   |   |   |   |   |   |   [19] housing in no: no (n = 41, err = 4.9%)
#> |   |   |   |   |   |   |   |   |   [20] housing in yes: no (n = 148, err = 0.0%)
#> |   |   |   |   |   |   [21] poutcome in unknown
#> |   |   |   |   |   |   |   [22] duration <= 204
#> |   |   |   |   |   |   |   |   [23] age <= 34: no (n = 447, err = 1.8%)
#> |   |   |   |   |   |   |   |   [24] age > 34: no (n = 1020, err = 0.1%)
#> |   |   |   |   |   |   |   [25] duration > 204
#> |   |   |   |   |   |   |   |   [26] contact in cellular, telephone
#> |   |   |   |   |   |   |   |   |   [27] month in aug, dec, jan, jul, may, nov: no (n = 233, err = 4.3%)
#> |   |   |   |   |   |   |   |   |   [28] month in jun: yes (n = 10, err = 40.0%)
#> |   |   |   |   |   |   |   |   [29] contact in unknown
#> |   |   |   |   |   |   |   |   |   [30] month in jul, nov: no (n = 3, err = 33.3%)
#> |   |   |   |   |   |   |   |   |   [31] month in jun, may: no (n = 184, err = 0.0%)
#> |   |   |   |   [32] month in mar, oct, sep
#> |   |   |   |   |   [33] duration <= 140
#> |   |   |   |   |   |   [34] marital in divorced: yes (n = 2, err = 0.0%)
#> |   |   |   |   |   |   [35] marital in married, single: no (n = 54, err = 7.4%)
#> |   |   |   |   |   [36] duration > 140: no (n = 35, err = 40.0%)
#> |   |   |   [37] duration > 292
#> |   |   |   |   [38] month in apr, aug, feb, jan, jul, jun, may, nov, sep
#> |   |   |   |   |   [39] contact in cellular, telephone
#> |   |   |   |   |   |   [40] month in apr, aug, feb, jan, jul, may, nov: no (n = 428, err = 16.4%)
#> |   |   |   |   |   |   [41] month in jun, sep: yes (n = 28, err = 46.4%)
#> |   |   |   |   |   [42] contact in unknown
#> |   |   |   |   |   |   [43] duration <= 477: no (n = 140, err = 0.0%)
#> |   |   |   |   |   |   [44] duration > 477: no (n = 62, err = 17.7%)
#> |   |   |   |   [45] month in dec, mar, oct: yes (n = 24, err = 29.2%)
#> |   |   [46] poutcome in success
#> |   |   |   [47] duration <= 171
#> |   |   |   |   [48] housing in no: no (n = 15, err = 46.7%)
#> |   |   |   |   [49] housing in yes: no (n = 10, err = 0.0%)
#> |   |   |   [50] duration > 171: yes (n = 65, err = 18.5%)
#> |   [51] duration > 631
#> |   |   [52] contact in cellular: yes (n = 201, err = 43.8%)
#> |   |   [53] contact in telephone, unknown
#> |   |   |   [54] housing in no: yes (n = 38, err = 42.1%)
#> |   |   |   [55] housing in yes: no (n = 74, err = 28.4%)
#> 
#> Number of inner nodes:    27
#> Number of terminal nodes: 28
pred_tree <- predict(model_tree, bank_test)
table_tree <- table(pred_tree, bank_test$subscribe)
confusionMatrix(table_tree)
#> Confusion Matrix and Statistics
#> 
#>          
#> pred_tree  no yes
#>       no  764  61
#>       yes  36  44
#>                                           
#>                Accuracy : 0.8928          
#>                  95% CI : (0.8708, 0.9122)
#>     No Information Rate : 0.884           
#>     P-Value [Acc > NIR] : 0.21968         
#>                                           
#>                   Kappa : 0.4172          
#>                                           
#>  Mcnemar's Test P-Value : 0.01482         
#>                                           
#>             Sensitivity : 0.9550          
#>             Specificity : 0.4190          
#>          Pos Pred Value : 0.9261          
#>          Neg Pred Value : 0.5500          
#>              Prevalence : 0.8840          
#>          Detection Rate : 0.8442          
#>    Detection Prevalence : 0.9116          
#>       Balanced Accuracy : 0.6870          
#>                                           
#>        'Positive' Class : no              
#>

DENGAN MENGGUNAKAN DECISION TREE MENDAPARKAN ACCURACY 89%

0.3.5 Random Forest

bank2 <- bank
glimpse(bank2)
#> Rows: 4,521
#> Columns: 17
#> $ age       <int> 30, 33, 35, 30, 59, 35, 36, 39, 41, 43, 39, 43, 36, 20, 31, …
#> $ job       <fct> unemployed, services, management, management, blue-collar, m…
#> $ marital   <fct> married, married, single, married, married, single, married,…
#> $ education <fct> primary, secondary, tertiary, tertiary, secondary, tertiary,…
#> $ default   <fct> no, no, no, no, no, no, no, no, no, no, no, no, no, no, no, …
#> $ balance   <int> 1787, 4789, 1350, 1476, 0, 747, 307, 147, 221, -88, 9374, 26…
#> $ housing   <fct> no, yes, yes, yes, yes, no, yes, yes, yes, yes, yes, yes, no…
#> $ loan      <fct> no, yes, no, yes, no, no, no, no, no, yes, no, no, no, no, y…
#> $ contact   <fct> cellular, cellular, cellular, unknown, unknown, cellular, ce…
#> $ day       <int> 19, 11, 16, 3, 5, 23, 14, 6, 14, 17, 20, 17, 13, 30, 29, 29,…
#> $ month     <fct> oct, may, apr, jun, may, feb, may, may, may, apr, may, apr, …
#> $ duration  <int> 79, 220, 185, 199, 226, 141, 341, 151, 57, 313, 273, 113, 32…
#> $ campaign  <int> 1, 1, 1, 4, 1, 2, 1, 2, 2, 1, 1, 2, 2, 1, 1, 2, 5, 1, 1, 1, …
#> $ pdays     <int> -1, 339, 330, -1, -1, 176, 330, -1, -1, 147, -1, -1, -1, -1,…
#> $ previous  <int> 0, 4, 1, 0, 0, 3, 2, 0, 0, 2, 0, 0, 0, 0, 1, 0, 0, 2, 0, 1, …
#> $ poutcome  <fct> unknown, failure, failure, unknown, unknown, failure, other,…
#> $ subscribe <fct> no, no, no, no, no, no, no, no, no, no, no, no, no, yes, no,…
# feature selection menggunakan nearZeroVar
n0_var <- nearZeroVar(bank2)
bank2 <- bank2[,-n0_var]
head(bank2)
# cek kembali dimensi data
dim(bank2)
#> [1] 4521   15

0.3.5.1 Cross Validation

Splitting train test dengan proporsi 80%:20% untuk dapat digunakan

intrain <- sample(nrow(bank2), nrow(bank2)*0.8)
# splitting train test

bank2_train <- bank2[intrain, ]
bank2_test <- bank2[-intrain, ]
#Mengecheck kembali

bank2_train

Selanjutnya, kita akan melalakukan Model Fitting

set.seed(123)

ctrl <- trainControl(method = "repeatedcv",
                    number = 5, # k-fold
                    repeats = 3) # repetisi
bank2_forest <- train(subscribe ~ .,
                  data = bank2_train,
                  method = "rf", # random forest
                  trControl = ctrl)

saveRDS(bank2_forest, "bank2_forest_2.RDS") # simpan model
model_random <- readRDS("bank2_forest_2.RDS")
pred_random <- predict(model_random, bank2_test)
CM_random <- table(pred_random, bank2_test$subscribe)
confusionMatrix(CM_random)
#> Confusion Matrix and Statistics
#> 
#>            
#> pred_random  no yes
#>         no  770  66
#>         yes  28  41
#>                                           
#>                Accuracy : 0.8961          
#>                  95% CI : (0.8744, 0.9152)
#>     No Information Rate : 0.8818          
#>     P-Value [Acc > NIR] : 0.0974367       
#>                                           
#>                   Kappa : 0.4113          
#>                                           
#>  Mcnemar's Test P-Value : 0.0001355       
#>                                           
#>             Sensitivity : 0.9649          
#>             Specificity : 0.3832          
#>          Pos Pred Value : 0.9211          
#>          Neg Pred Value : 0.5942          
#>              Prevalence : 0.8818          
#>          Detection Rate : 0.8508          
#>    Detection Prevalence : 0.9238          
#>       Balanced Accuracy : 0.6740          
#>                                           
#>        'Positive' Class : no              
#>

Pada menggunakan Model Random Forest didapati hasil sebesar 89,7%

0.3.6 Interpretation

Meskipun random forest dilabel kan sebagai model yang tidak interpretable, setidaknya kita bisa melihat prediktor apa saja yang paling digunakan (penting) dalam pembuatan random forest menggunakan varImp():

varImp(model_random) %>% plot()

0.4 Conclusion

Pada pembuatan model klasifikasi dengan menggunakan Naive Baiyes, Decision Tree, dan Random Forest pada kasus telemarketing di bank portugal. Model yang memiliki Accuracy paling bagus menggunakan model Random Forest dengan sebesar 89,7%