Prediksi Pelanggan Melakukan Pembelian Deposito
Menggunakan Algoritma Logistic Regression dan k-Nearest Neighbour
Iswan Putera
28 September, 2021
1 Overview
Logistic Regression adalah algoritma klasifikasi Machine Learning yang digunakan untuk memprediksi probabilitas variabel dependen kategoris. Dalam regresi logistik, variabel dependen adalah variabel biner yang berisi data berkode 1 (ya, berhasil, dst) atau 0 (tidak, gagal, dst).
k-NN (k Nearest Neighbour) adalah sebuah metode untuk melakukan klasifikasi terhadap objek berdasarkan data pembelajaran yang jaraknya paling dekat dengan objek tersebut.
1.1 Objective
Pada kesempatan kali ini, saya akan mencoba melakukan prediksi terhadap pelanggan sebuah bank apakah akan melakukan langganan produk deposito berjangka atau tidak dengan menggunakan algoritma Logistict Regression dan k-Nearest Neighbour (k-NN) yang termasuk dalam supervised learning
2 Pre Proccessing
2.1 Load Library
library(dplyr)
library(gtools)
library(gmodels)
library(ggplot2)
library(tidyr)
library(GGally)
library(caret)
library(class) # package untuk fungsi `knn()`
library(data.table)2.2 Import Data
Dataset yang digunakan diambil dari UCI Machine Learning repository yang merupakan data kampanye marketing dari sebuah bank di Portugis. Tujuan klasifikasi adalah memprediksi apakah klien akan berlangganan (1/0) ke deposito berjangka (variable y)
Download dataset disini
bank <- read.csv("data_input/banking.csv")
glimpse(bank)## Rows: 41,188
## Columns: 21
## $ age <int> 44, 53, 28, 39, 55, 30, 37, 39, 36, 27, 34, 41, 55, 33,~
## $ job <chr> "blue-collar", "technician", "management", "services", ~
## $ marital <chr> "married", "married", "single", "married", "married", "~
## $ education <chr> "basic.4y", "unknown", "university.degree", "high.schoo~
## $ default <chr> "unknown", "no", "no", "no", "no", "no", "no", "no", "n~
## $ housing <chr> "yes", "no", "yes", "no", "yes", "yes", "yes", "yes", "~
## $ loan <chr> "no", "no", "no", "no", "no", "no", "no", "no", "no", "~
## $ contact <chr> "cellular", "cellular", "cellular", "cellular", "cellul~
## $ month <chr> "aug", "nov", "jun", "apr", "aug", "jul", "may", "may",~
## $ day_of_week <chr> "thu", "fri", "thu", "fri", "fri", "tue", "thu", "fri",~
## $ duration <int> 210, 138, 339, 185, 137, 68, 204, 191, 174, 191, 62, 78~
## $ campaign <int> 1, 1, 3, 2, 1, 8, 1, 1, 1, 2, 2, 1, 3, 5, 1, 2, 2, 1, 1~
## $ pdays <int> 999, 999, 6, 999, 3, 999, 999, 999, 3, 999, 999, 999, 9~
## $ previous <int> 0, 0, 2, 0, 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0~
## $ poutcome <chr> "nonexistent", "nonexistent", "success", "nonexistent",~
## $ emp_var_rate <dbl> 1.4, -0.1, -1.7, -1.8, -2.9, 1.4, -1.8, -1.8, -2.9, -1.~
## $ cons_price_idx <dbl> 93.444, 93.200, 94.055, 93.075, 92.201, 93.918, 92.893,~
## $ cons_conf_idx <dbl> -36.1, -42.0, -39.8, -47.1, -31.4, -42.7, -46.2, -46.2,~
## $ euribor3m <dbl> 4.963, 4.021, 0.729, 1.405, 0.869, 4.961, 1.327, 1.313,~
## $ nr_employed <dbl> 5228.1, 5195.8, 4991.6, 5099.1, 5076.2, 5228.1, 5099.1,~
## $ y <int> 0, 0, 1, 0, 1, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 1, 1, 0~Dataset menyediakan informasi nasabah bank. Ini mencakup 41.188 baris dan 21 kolom.
Keterangan :
age: data Umurjob: data pekerjaan (blue-collar, technician, management, services, retired, admin., housemaid, unemployed, entrepreneur, self-employed, unknown, student)marital: data status perkawinai (married, single, divorced, unknown)education: tingkat pendidikan (basic.4y, unknown, university.degree, high.school, basic.9y, professional.course, basic.6y, illiterate)default: memiliki kredit atau tidak (unknown, no, yes)housing: memiliki pinjaman perumahan (yes, no, unknown)loan: meliliki pinjaman pribadi (no, yes, unknown)contact: tipe alat komunikasi (cellular, telephone)month: bulan terakhir dihubungiday_of_week: hari terakhir dihubungiduration: durasi kontrak terakhir (menit):campaign:jumlah kontak yang dilakukan selama kampanye ini dan untuk pelanggan yang samapdays: jumlah hari yang berlalu setelah klien terakhir dihubungi dari kampanye sebelumnyaprevious: jumlah kontak yang dilakukan sebelum kampanye ini dan untuk pelanggan yang samapoutcome: hasil dari kampanye pemasaran sebelumnya (nonexistent, success, failure)emp.var.rate: tingkat variasi pekerjaancons.price.idx: Indeks Harga Konsumencons.conf.idx: indeks kepercayaan konsumeneuribor3m: tarif dalam euro per 3 bulannr.employed: jumlah tenaga kerja
Variable Prediksi (target tang diinginkan)
y: apakah klien sudah berlangganan deposito berjangka? (biner: “1”, berarti “Yes”, “0” berarti “No”) Berikut ini gambaran sedikit pada data yang digunakan.
rmarkdown::paged_table(head(bank))2.3 Data Wrangling
2.3.1 Penyesuain Tipe Data
Pada beberapa variable yang digunakan terdapat ketidaksesuaian tipe data, untuk itu kita perlu melakukan perubahan tipe data pada beberapa variable yang ada. Dan disini kita pilih kolom-kolom data yang kita anggap berkorelasi saja dengan hasil yang akan kita prediksi
bank_clean <- bank %>%
mutate_if(is.character, as.factor) %>%
mutate(y = as.factor(y),
#age = as.factor(age),
campaign = as.factor(campaign),
previous = as.factor(previous)) %>%
select(-contact,-day_of_week,-duration,-campaign,-pdays,-previous,-poutcome,-emp_var_rate,-euribor3m,-nr_employed,-month)
# tampilkan tipe data
glimpse(bank_clean)## Rows: 41,188
## Columns: 10
## $ age <int> 44, 53, 28, 39, 55, 30, 37, 39, 36, 27, 34, 41, 55, 33,~
## $ job <fct> blue-collar, technician, management, services, retired,~
## $ marital <fct> married, married, single, married, married, divorced, m~
## $ education <fct> basic.4y, unknown, university.degree, high.school, basi~
## $ default <fct> unknown, no, no, no, no, no, no, no, no, no, no, no, no~
## $ housing <fct> yes, no, yes, no, yes, yes, yes, yes, no, yes, no, yes,~
## $ loan <fct> no, no, no, no, no, no, no, no, no, no, no, no, no, no,~
## $ cons_price_idx <dbl> 93.444, 93.200, 94.055, 93.075, 92.201, 93.918, 92.893,~
## $ cons_conf_idx <dbl> -36.1, -42.0, -39.8, -47.1, -31.4, -42.7, -46.2, -46.2,~
## $ y <fct> 0, 0, 1, 0, 1, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 1, 1, 0~2.3.2 Check Missing Value
Kemudian lakukan check missing value, hal ini diperlukan agar tidak mengganggu dalam melakukan pemodelan nantinya.
bank_clean %>%
is.na() %>%
colSums()## age job marital education default
## 0 0 0 0 0
## housing loan cons_price_idx cons_conf_idx y
## 0 0 0 0 0Dari hasil query diatas tidak terdapat kolom / variable yang terdapat NA
3 Fitting Model
3.1 Logistic Regression
3.1.1 Cross Validation
Membagi data untuk membuat model dengan proporsi 80:20 dimana 80% adalah data train dan 20% adalah data test
Data train akan kita gunakan untuk modeling, sedangkan data test akan kita gunakan sebagai penguji model yang kita buat jika dihadapkan dengan unseen data. Serta untuk melihat kemampuan model yang kita buat.
RNGkind(sample.kind = "Rounding")
set.seed(417)
dx <- sample(nrow(bank_clean), nrow(bank_clean)*0.8)
bank_train <- bank_clean[dx,]
bank_test <- bank_clean[-dx,]3.1.2 Check Proporsi Data
Sebelum melakukan pemodelan kita perlu melihat terlebih dahulu proporsi dari target variable yang kita miliki pada kolom y
#check proporsi data
prop.table(table(bank_train$y))##
## 0 1
## 0.8879514 0.1120486Jika dilihat proporsi kedua kelas No (0) 88.7% dan kelas Yes (1) 11.3% terlihat belum cukup seimbang, kita akan melakukan balancing proporsi data menggunakan library ROSE - Random Over Sampling, selengkapnya bisa dilihat ditautan ini ROSE Package
#balancing proporsi data
library(ROSE)
bank_balance <- ROSE(y ~ ., data = bank_train, seed = 1 )$data
prop.table(table(bank_balance$y))##
## 0 1
## 0.5032777 0.4967223Dilihat dari hasil package ROSE sudah terlihat proporsi yang seimbang 50.3% dan 49.6%, ini terlihat cukup bagus untuk melakukan pemodelan
3.1.3 Membuat Model LM
Melakukan modeling dengan menggunakan regresi logistik. Pemodelan mengunakan fungsi glm() dengan variable prediktor yang kita gunakan adalah beberapa variable yang kita anggap mempengaruhi signifikan terhadap target variable, dimana variable y akan menjadi variable response nya.
#model dengan data train asli tanpa balancing proporsi
model_asli <-glm(y ~ ., data = bank_train, family = "binomial")
summary(model_asli)##
## Call:
## glm(formula = y ~ ., family = "binomial", data = bank_train)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.3711 -0.5195 -0.4286 -0.3193 2.8436
##
## Coefficients: (1 not defined because of singularities)
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 48.915884 2.885702 16.951 < 0.0000000000000002
## age 0.011267 0.002186 5.154 0.000000254598525
## jobblue-collar -0.294719 0.070662 -4.171 0.000030347224767
## jobentrepreneur -0.445293 0.118383 -3.761 0.000169
## jobhousemaid -0.077716 0.127095 -0.611 0.540881
## jobmanagement -0.213650 0.076219 -2.803 0.005061
## jobretired 0.676466 0.091280 7.411 0.000000000000125
## jobself-employed -0.155492 0.104383 -1.490 0.136322
## jobservices -0.290759 0.078774 -3.691 0.000223
## jobstudent 1.078923 0.098419 10.963 < 0.0000000000000002
## jobtechnician -0.138215 0.062197 -2.222 0.026269
## jobunemployed 0.242558 0.108980 2.226 0.026034
## jobunknown 0.166472 0.201087 0.828 0.407750
## maritalmarried 0.115447 0.061491 1.877 0.060455
## maritalsingle 0.359600 0.069126 5.202 0.000000197039805
## maritalunknown 0.199075 0.373267 0.533 0.593804
## educationbasic.6y -0.125002 0.110008 -1.136 0.255831
## educationbasic.9y -0.183974 0.084246 -2.184 0.028979
## educationhigh.school -0.049078 0.080987 -0.606 0.544515
## educationilliterate 0.909008 0.626775 1.450 0.146977
## educationprofessional.course -0.008006 0.089666 -0.089 0.928853
## educationuniversity.degree 0.131666 0.080684 1.632 0.102709
## educationunknown 0.238968 0.105148 2.273 0.023045
## defaultunknown -0.844374 0.060894 -13.866 < 0.0000000000000002
## defaultyes -9.708259 113.646521 -0.085 0.931923
## housingunknown -0.002137 0.120693 -0.018 0.985873
## housingyes 0.006398 0.036644 0.175 0.861400
## loanunknown NA NA NA NA
## loanyes -0.069971 0.050835 -1.376 0.168692
## cons_price_idx -0.543012 0.030841 -17.607 < 0.0000000000000002
## cons_conf_idx 0.016827 0.003515 4.787 0.000001691454892
##
## (Intercept) ***
## age ***
## jobblue-collar ***
## jobentrepreneur ***
## jobhousemaid
## jobmanagement **
## jobretired ***
## jobself-employed
## jobservices ***
## jobstudent ***
## jobtechnician *
## jobunemployed *
## jobunknown
## maritalmarried .
## maritalsingle ***
## maritalunknown
## educationbasic.6y
## educationbasic.9y *
## educationhigh.school
## educationilliterate
## educationprofessional.course
## educationuniversity.degree
## educationunknown *
## defaultunknown ***
## defaultyes
## housingunknown
## housingyes
## loanunknown
## loanyes
## cons_price_idx ***
## cons_conf_idx ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 23116 on 32949 degrees of freedom
## Residual deviance: 21647 on 32920 degrees of freedom
## AIC: 21707
##
## Number of Fisher Scoring iterations: 10#model dengan semua predicktor dari data yang sudah di balancing proporsinya
model_all <- glm(y ~ ., data = bank_balance, family = "binomial")
summary(model_all)##
## Call:
## glm(formula = y ~ ., family = "binomial", data = bank_balance)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.3170 -1.1077 -0.5965 1.1004 2.0703
##
## Coefficients: (1 not defined because of singularities)
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 42.434458 1.721538 24.649 < 0.0000000000000002
## age 0.008832 0.001295 6.822 0.00000000000898660
## jobblue-collar -0.187734 0.044049 -4.262 0.00002026949263454
## jobentrepreneur -0.401237 0.071124 -5.641 0.00000001686981027
## jobhousemaid -0.105049 0.081151 -1.294 0.19550
## jobmanagement -0.232495 0.048622 -4.782 0.00000173861423955
## jobretired 0.826524 0.065292 12.659 < 0.0000000000000002
## jobself-employed -0.148715 0.067055 -2.218 0.02657
## jobservices -0.252192 0.047833 -5.272 0.00000013464378029
## jobstudent 1.056399 0.076774 13.760 < 0.0000000000000002
## jobtechnician -0.120952 0.040139 -3.013 0.00258
## jobunemployed 0.297267 0.074451 3.993 0.00006529239689337
## jobunknown 0.010108 0.130826 0.077 0.93841
## maritalmarried 0.096870 0.038601 2.510 0.01209
## maritalsingle 0.349303 0.043979 7.942 0.00000000000000198
## maritalunknown 0.230676 0.244144 0.945 0.34474
## educationbasic.6y -0.082670 0.068797 -1.202 0.22950
## educationbasic.9y -0.042689 0.053344 -0.800 0.42356
## educationhigh.school 0.079990 0.052449 1.525 0.12723
## educationilliterate 1.263355 0.528295 2.391 0.01679
## educationprofessional.course 0.134691 0.058078 2.319 0.02039
## educationuniversity.degree 0.310766 0.053097 5.853 0.00000000483279368
## educationunknown 0.328656 0.070811 4.641 0.00000346148505313
## defaultunknown -0.850281 0.034953 -24.327 < 0.0000000000000002
## housingunknown 0.000969 0.079227 0.012 0.99024
## housingyes -0.011981 0.023652 -0.507 0.61246
## loanunknown NA NA NA NA
## loanyes -0.094993 0.032417 -2.930 0.00339
## cons_price_idx -0.456616 0.018423 -24.785 < 0.0000000000000002
## cons_conf_idx 0.006382 0.002164 2.949 0.00318
##
## (Intercept) ***
## age ***
## jobblue-collar ***
## jobentrepreneur ***
## jobhousemaid
## jobmanagement ***
## jobretired ***
## jobself-employed *
## jobservices ***
## jobstudent ***
## jobtechnician **
## jobunemployed ***
## jobunknown
## maritalmarried *
## maritalsingle ***
## maritalunknown
## educationbasic.6y
## educationbasic.9y
## educationhigh.school
## educationilliterate *
## educationprofessional.course *
## educationuniversity.degree ***
## educationunknown ***
## defaultunknown ***
## housingunknown
## housingyes
## loanunknown
## loanyes **
## cons_price_idx ***
## cons_conf_idx **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 45677 on 32949 degrees of freedom
## Residual deviance: 42415 on 32921 degrees of freedom
## AIC: 42473
##
## Number of Fisher Scoring iterations: 4#model dengan prediktor pilihan dari data yang sudah dilakukan balancing proporsinya
model_custom <- glm(y ~ job + +age+ cons_price_idx + default +cons_price_idx,
data = bank_balance,
family = "binomial")
summary(model_custom)##
## Call:
## glm(formula = y ~ job + +age + cons_price_idx + default + cons_price_idx,
## family = "binomial", data = bank_balance)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.0473 -1.1285 -0.6118 1.1068 1.9792
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 44.350906 1.699851 26.091 < 0.0000000000000002 ***
## jobblue-collar -0.431004 0.035211 -12.241 < 0.0000000000000002 ***
## jobentrepreneur -0.470535 0.070290 -6.694 0.0000000000217 ***
## jobhousemaid -0.247553 0.077401 -3.198 0.00138 **
## jobmanagement -0.226521 0.047667 -4.752 0.0000020129860 ***
## jobretired 0.747266 0.062421 11.971 < 0.0000000000000002 ***
## jobself-employed -0.163791 0.066044 -2.480 0.01314 *
## jobservices -0.409449 0.044931 -9.113 < 0.0000000000000002 ***
## jobstudent 1.058883 0.073676 14.372 < 0.0000000000000002 ***
## jobtechnician -0.167760 0.035632 -4.708 0.0000025002851 ***
## jobunemployed 0.175630 0.072866 2.410 0.01594 *
## jobunknown 0.060744 0.126822 0.479 0.63196
## age 0.004092 0.001174 3.486 0.00049 ***
## cons_price_idx -0.473873 0.018174 -26.074 < 0.0000000000000002 ***
## defaultunknown -0.871512 0.034542 -25.230 < 0.0000000000000002 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 45677 on 32949 degrees of freedom
## Residual deviance: 42648 on 32935 degrees of freedom
## AIC: 42678
##
## Number of Fisher Scoring iterations: 43.1.4 Melakukan Prediksi
Untuk mengetahui performa model, kita perlu membuat prediksi dengan model tersebut dan melakukan uji statistik kemudian.
Data prediksi digabungkan dengan data test yang sudah kita sediakan di tahapan cross validation
#membuat prediksi
#model data asli
y_asli <- predict(model_asli, newdata = bank_test, type = "response")
#model custom data balancing
y_pred <- predict(model_custom, newdata = bank_test, type = "response")
#model all data balancing
all_pred <- predict(model_all, newdata = bank_test, type = "response")
bank_test <- bank_test %>%
mutate(pred_asli = y_asli,
pred_custom = y_pred,
pred_all = all_pred) %>%
select(y,pred_asli,pred_custom,pred_all)
rmarkdown::paged_table(head(bank_test,10))Visualisasikan sebaran data prediksi dengan ggplot
bank_test %>%
pivot_longer(cols = c(pred_asli,pred_custom,pred_all),
names_to = "model",
values_to = "pred") %>%
ggplot(aes(x = pred, col = model))+
geom_density(lwd=0.8, show.legend = F)+
facet_wrap(~ model, scales = "free", ncol = 1)+
labs(
title = "Histogram Data Prediksi by model"
)+
theme_minimal()
- Note :
- Dari visual histogram diatas, sebaran nilai prediksi dari model asli (proporsi data tidak balance) terlihat sebarannya tidak merata, bisa dikatakan hasil prediksi tidak bagus. Kita buktikan di evaluasi performa model dibawah ini.
3.1.5 Evaluasi Model
Untuk mengetahui performa dari model yang kita buat, kita perlu melakukan evaluasi model dengan menggunakan confusionMatrix(), namun sebelum nya kita kita perlu merubah hasil prediksi tersebut ke dalam bentuk faktor.
Confusion matrix dapat digunakan untuk mengukur performa dalam permasalahan klasifikasi biner maupun permasalahan klasifikasi multiclass. Klasifikasi biner hanya menghasilkan dua ouput kelas (label), seperti “Ya” atau “Tidak”, “0” atau “1” untuk setiap data input yang diberikan
#merubah kolom hasil prediksi ke factor
bank_test <- bank_test %>%
mutate(f_pred_asli = factor(ifelse(pred_asli > 0.5, "1","0")),
f_pred_custom = factor(ifelse(pred_custom > 0.5, "1","0")),
f_pred_all = factor(ifelse(pred_all > 0.5,"1","0"))
)
rmarkdown::paged_table(head(bank_test,10))Note :
- Jika probabilitas data test lebih dari 0.5, artinya
1(Yes) - klien akan berlangganan deposito berjangka - dan sebaliknya
#melakukan pengujian dengan confusionMatrix
cf_pred_asli <- confusionMatrix(data = as.factor(bank_test$f_pred_asli),
reference = as.factor(bank_test$y),
positive = "1")
cf_pred_custom <- confusionMatrix(data = as.factor(bank_test$f_pred_custom),
reference = as.factor(bank_test$y),
positive = "1")
cf_pred_all <- confusionMatrix(data = as.factor(bank_test$f_pred_all),
reference = as.factor(bank_test$y),
positive = "1")cf_pred_asli## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 7272 944
## 1 18 4
##
## Accuracy : 0.8832
## 95% CI : (0.8761, 0.8901)
## No Information Rate : 0.8849
## P-Value [Acc > NIR] : 0.6928
##
## Kappa : 0.003
##
## Mcnemar's Test P-Value : <0.0000000000000002
##
## Sensitivity : 0.0042194
## Specificity : 0.9975309
## Pos Pred Value : 0.1818182
## Neg Pred Value : 0.8851022
## Prevalence : 0.1150765
## Detection Rate : 0.0004856
## Detection Prevalence : 0.0026706
## Balanced Accuracy : 0.5008751
##
## 'Positive' Class : 1
## Note :
Re-call/Sensitivity= dari semua data aktual yang positif, model mampu memprediksi benar sebesar 0.42 % .Specificity= dari semua data aktual yang negatif, model mampu memprediksi benar sebesar 99.75 % .Accuracy= model mampu memprediksi dengan benar target Y sebesar 88.32 % .Precision= dari semua hasil prediksi, model mampu memprediksi benar kelas positif sebesar 18.18 %.
cf_pred_custom## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 4353 346
## 1 2937 602
##
## Accuracy : 0.6015
## 95% CI : (0.5908, 0.6121)
## No Information Rate : 0.8849
## P-Value [Acc > NIR] : 1
##
## Kappa : 0.1061
##
## Mcnemar's Test P-Value : <0.0000000000000002
##
## Sensitivity : 0.63502
## Specificity : 0.59712
## Pos Pred Value : 0.17010
## Neg Pred Value : 0.92637
## Prevalence : 0.11508
## Detection Rate : 0.07308
## Detection Prevalence : 0.42959
## Balanced Accuracy : 0.61607
##
## 'Positive' Class : 1
## Note :
Re-call/Sensitivity= dari semua data aktual yang positif, model mampu memprediksi benar sebesar 63.5 % .Specificity= dari semua data aktual yang negatif, model mampu memprediksi benar sebesar 59.71 % .Accuracy= model mampu memprediksi dengan benar target Y sebesar 60.15 % .Precision= dari semua hasil prediksi, model mampu memprediksi benar kelas positif sebesar 17.01 %.
cf_pred_all## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 4545 370
## 1 2745 578
##
## Accuracy : 0.6219
## 95% CI : (0.6113, 0.6324)
## No Information Rate : 0.8849
## P-Value [Acc > NIR] : 1
##
## Kappa : 0.1116
##
## Mcnemar's Test P-Value : <0.0000000000000002
##
## Sensitivity : 0.60970
## Specificity : 0.62346
## Pos Pred Value : 0.17394
## Neg Pred Value : 0.92472
## Prevalence : 0.11508
## Detection Rate : 0.07016
## Detection Prevalence : 0.40337
## Balanced Accuracy : 0.61658
##
## 'Positive' Class : 1
## Note :
Re-call/Sensitivity= dari semua data aktual yang positif, model mampu memprediksi benar sebesar 60.97 % .Specificity= dari semua data aktual yang negatif, model mampu memprediksi benar sebesar 62.35 % .Accuracy= model mampu memprediksi dengan benar target Y sebesar 62.19 % .Precision= dari semua hasil prediksi, model mampu memprediksi benar kelas positif sebesar 17.39 %.
3.1.6 Kesimpulan
#menggabungkan hasil evaluasi ketiga model dalam satu view
p <- rbind.data.frame(c(model="model_asli",
round(cf_pred_asli$byClass["Recall"]*100,2),
round(cf_pred_asli$byClass["Specificity"]*100,2),
round(cf_pred_asli$overall["Accuracy"]*100,2),
round(cf_pred_asli$byClass["Precision"]*100,2)),
c(model="model_custom",
round(cf_pred_custom$byClass["Recall"]*100,2),
round(cf_pred_custom$byClass["Specificity"]*100,2),
round(cf_pred_custom$overall["Accuracy"]*100,2),
round(cf_pred_custom$byClass["Precision"]*100,2)),
c(model="model_all",
round(cf_pred_all$byClass["Recall"]*100,2),
round(cf_pred_all$byClass["Specificity"]*100,2),
round(cf_pred_all$overall["Accuracy"]*100,2),
round(cf_pred_all$byClass["Precision"]*100,2))
)
colnames(p) <- c("Model","Recall","Specificity","Acuracy","Precision")
p## Model Recall Specificity Acuracy Precision
## 1 model_asli 0.42 99.75 88.32 18.18
## 2 model_custom 63.5 59.71 60.15 17.01
## 3 model_all 60.97 62.35 62.19 17.39Note :
Accuracymenggambarkan seberapa akurat model dapat mengklasifikasikan dengan benar, dengan kata lain, accuracy merupakan tingkat kedekatan nilai prediksi dengan nilai aktual (sebenarnya)Precisionmenggambarkan tingkat keakuratan antara data yang diminta dengan hasil prediksi yang diberikan oleh modelRecall atau Sensitivity (True Positive Rate)menggambarkan keberhasilan model dalam menemukan kembali sebuah informasi. Maka, recall merupakan rasio prediksi benar positif dibandingkan dengan keseluruhan data yang benar positifSpecificitymerupakan kebenaran memprediksi negatif dibandingkan dengan keseluruhan data negatif. Specificity menjawab pertanyaan “Berapa persen pelanggan yang benar diprediksi berlangganan dibandingkan dengan keseluruhan pelanggan yang sebenarnya berlangganan”
Dari 3 model Logistics Regression diatas, hasil evaluasi performa model belum ada yang signifikan untuk diterapkan. Untuk itu kita coba melakukan pemodelan lagi dengan algorima k-nearest neigbour
3.2 K-Nearest Neighbour
K-nearest neighbors atau knn adalah algoritma yang berfungsi untuk melakukan klasifikasi suatu data berdasarkan data pembelajaran (train data sets), yang diambil dari k tetangga terdekatnya (nearest neighbors). Dengan k merupakan banyaknya tetangga terdekat.
3.2.1 Seleksi Data
Pada metode k-NN data yang diperlukan untuk pemodelan hanya data yang bertipe numeric saja.
#subseting data yang hanya bertipe numeric
bank_knn <- bank %>%
select_if(is.numeric)
bank_knn$y <- factor(bank_knn$y, levels = c(1,0), labels = c("Yes","No"))
summary(bank_knn)## age duration campaign pdays
## Min. :17.00 Min. : 0.0 Min. : 1.000 Min. : 0.0
## 1st Qu.:32.00 1st Qu.: 102.0 1st Qu.: 1.000 1st Qu.:999.0
## Median :38.00 Median : 180.0 Median : 2.000 Median :999.0
## Mean :40.02 Mean : 258.3 Mean : 2.568 Mean :962.5
## 3rd Qu.:47.00 3rd Qu.: 319.0 3rd Qu.: 3.000 3rd Qu.:999.0
## Max. :98.00 Max. :4918.0 Max. :56.000 Max. :999.0
## previous emp_var_rate cons_price_idx cons_conf_idx
## Min. :0.000 Min. :-3.40000 Min. :92.20 Min. :-50.8
## 1st Qu.:0.000 1st Qu.:-1.80000 1st Qu.:93.08 1st Qu.:-42.7
## Median :0.000 Median : 1.10000 Median :93.75 Median :-41.8
## Mean :0.173 Mean : 0.08189 Mean :93.58 Mean :-40.5
## 3rd Qu.:0.000 3rd Qu.: 1.40000 3rd Qu.:93.99 3rd Qu.:-36.4
## Max. :7.000 Max. : 1.40000 Max. :94.77 Max. :-26.9
## euribor3m nr_employed y
## Min. :0.634 Min. :4964 Yes: 4640
## 1st Qu.:1.344 1st Qu.:5099 No :36548
## Median :4.857 Median :5191
## Mean :3.621 Mean :5167
## 3rd Qu.:4.961 3rd Qu.:5228
## Max. :5.045 Max. :52283.2.2 Cross Validation
Seperti pada pembuatan model - model lainnya, dataset perlu dilakukan spliting sebagai data train dan test. Disini kami akan split data sebanyak 80% untuk data train dan 20% untuk data test
RNGkind(sample.kind = "Rounding")
set.seed(417)
kidx <- sample(nrow(bank_knn), nrow(bank_knn)*0.8)
knn_train <- bank_knn[kidx,]
knn_test <- bank_knn[-kidx,]
#cek proporsi data
prop.table(table(knn_train$y))##
## Yes No
## 0.1120486 0.88795143.2.3 Scaling
knn_train_scale <- knn_train %>%
select_if(is.numeric) %>%
scale()
knn_test_scale <- knn_test %>%
select_if(is.numeric) %>%
scale(center = attr(knn_train_scale,"scaled:center"),
scale = attr(knn_train_scale,"scaled:scale"))3.2.4 Menentukan Nilai K
Dalam menentukan nilai k, bila jumlah klasifikasi kita genap maka sebaiknya kita gunakan nilai k ganjil, dan begitu pula sebaliknya bila jumlah klasifikasi kita ganjil maka sebaiknya gunakan nilai k genap, karena jika tidak begitu, ada kemungkinan kita tidak akan mendapatkan jawaban.
knn_train_y <- knn_train$y
knn_test_y <- knn_test$y
k_optimum <- sqrt(nrow(knn_train_scale))
k_optimum## [1] 181.5213Karena class yang kita prediksikan genap maka k-optimum kita pakai seperti hasil perhitungan tampa rounding yaitu 181
3.2.5 Membuat Model dan Prediksi
#k-optimum yang digunakan 181
knn_predict <- knn(train = knn_train_scale,
test = knn_test_scale,
cl = knn_train_y,
k = 181 )3.2.6 Evaluasi Model
Untuk membandingkan dengan model Logistic Regression yang sudah kita buat sebelumnya, k-nn juga akan dievaluasi dengan methode yang sama yaitu menggunakan confusionMatrix
#evaluasi dengan confusionMatrix
kkn_cfm <- confusionMatrix(data = knn_predict, reference = knn_test_y)
kkn_cfm## Confusion Matrix and Statistics
##
## Reference
## Prediction Yes No
## Yes 300 173
## No 648 7117
##
## Accuracy : 0.9003
## 95% CI : (0.8937, 0.9067)
## No Information Rate : 0.8849
## P-Value [Acc > NIR] : 0.000004239
##
## Kappa : 0.3743
##
## Mcnemar's Test P-Value : < 0.00000000000000022
##
## Sensitivity : 0.31646
## Specificity : 0.97627
## Pos Pred Value : 0.63425
## Neg Pred Value : 0.91655
## Prevalence : 0.11508
## Detection Rate : 0.03642
## Detection Prevalence : 0.05742
## Balanced Accuracy : 0.64636
##
## 'Positive' Class : Yes
## Note :
Re-call/Sensitivity= dari semua data aktual yang positif, model mampu memprediksi benar sebesar 31.65 % .Specificity= dari semua data aktual yang negatif, model mampu memprediksi benar sebesar 97.63 % .Accuracy= model mampu memprediksi dengan benar target Y sebesar 90.03 % .Precision= dari semua hasil prediksi, model mampu memprediksi benar kelas positif sebesar 63.42 %.
4 Kesimpulan
Dilihat dari hasil evaluasi model antara LM dan K-NN :
Re-call/Sensitivity:- LM (model_custom) : 63.5 %
- K-NN : 31.65 %
Specificity:- LM (model_custom) : 59.71 %
- K-NN : 97.63 %
Accuracy:- LM (model_custom) : 60.15 %
- K-NN : 90.03 %
Precision:- LM (model_custom) : 17.01 %
- K-NN : 63.42 %
Dari perbandingan di atas, model k-NN terlihat lebih baik digunakan untuk melakukan prediksi dengan dataset yang seperti ini, namun menurut saya ini masih belum maksimal dan masih bisa ditingkatkan lagi sehingga bisa menghasilkan nilai - nilai evaluasi model yang lebih signifikan.