Pada latihan kali ini kita akan memprediksi klasifikasi kategori Channel berupa Horeca (hotel, restaurant, cafe) atau retail/eceran, berdasarkan data pengeluaran dalam satuan moneter (m.u.) untuk berbagai kategori produk selama satu tahun menggunakan metode logistic regression dan K-Nearest Neighbour. Latihan ini menggunakan R studio dan library yang digunakan adalah sebagai berikut:
library(dplyr) # piping
library(gtools) # untuk menghitung peluang dan log of odds
library(caret) # untuk menggunakan confusion matrix
library(class) # untuk menggunakan pemodelan K-nn
library(car) # uji VIF (Variance Inflation Factor)wholesale <- read.csv("data_input/wholesale.csv", stringsAsFactors = T)
head(wholesale)str(wholesale)#> 'data.frame': 440 obs. of 8 variables:
#> $ Channel : int 2 2 2 1 2 2 2 2 1 2 ...
#> $ Region : int 3 3 3 3 3 3 3 3 3 3 ...
#> $ Fresh : int 12669 7057 6353 13265 22615 9413 12126 7579 5963 6006 ...
#> $ Milk : int 9656 9810 8808 1196 5410 8259 3199 4956 3648 11093 ...
#> $ Grocery : int 7561 9568 7684 4221 7198 5126 6975 9426 6192 18881 ...
#> $ Frozen : int 214 1762 2405 6404 3915 666 480 1669 425 1159 ...
#> $ Detergents_Paper: int 2674 3293 3516 507 1777 1795 3140 3321 1716 7425 ...
#> $ Delicassen : int 1338 1776 7844 1788 5185 1451 545 2566 750 2098 ...Channel : customers Channel - Horeca
(Hotel/Restaurant/Cafe) or Retail channel (Nominal) Region
: customers Region Lisnon, Oporto or Other (Nominal) Fresh
: annual spending (m.u.) on fresh products (Continuous)
Milk : annual spending (m.u.) on milk products (Continuous)
Grocery : annual spending (m.u.)on grocery products
(Continuous) Frozen : annual spending (m.u.)on frozen
products (Continuous) Detergents_Paper : annual spending
(m.u.) on detergents and paper products (Continuous)
Delicassen : annual spending (m.u.)on and delicatessen
products (Continuous);
wholesale <- wholesale %>%
mutate(Channel = ifelse(Channel ==1, "Horeca", "Retail"),
Region = case_when(Region == 1 ~ "Lisbon",
Region == 2 ~ "Oporto",
Region == 3 ~ "Others"))
head(wholesale)anyNA(wholesale)#> [1] FALSETidak terdapat missing value pada data frame
wholesale
Setelah menambahkan keterangan untuk Channel dan Region, maka kita dapat merubah tipe data menjadi faktor.
wholesale <- wholesale %>%
mutate_at(vars(Channel, Region), as.factor)
head(wholesale)Kita akan mengecek proporsi data Channel pada data frame
wholesale
prop.table(table(wholesale$Channel))#>
#> Horeca Retail
#> 0.6772727 0.3227273Proporsi data Channel masih balance (imbalance ketika lebih besar dari 70:30)
summary(wholesale)#> Channel Region Fresh Milk Grocery
#> Horeca:298 Lisbon: 77 Min. : 3 Min. : 55 Min. : 3
#> Retail:142 Oporto: 47 1st Qu.: 3128 1st Qu.: 1533 1st Qu.: 2153
#> Others:316 Median : 8504 Median : 3627 Median : 4756
#> Mean : 12000 Mean : 5796 Mean : 7951
#> 3rd Qu.: 16934 3rd Qu.: 7190 3rd Qu.:10656
#> Max. :112151 Max. :73498 Max. :92780
#> Frozen Detergents_Paper Delicassen
#> Min. : 25.0 Min. : 3.0 Min. : 3.0
#> 1st Qu.: 742.2 1st Qu.: 256.8 1st Qu.: 408.2
#> Median : 1526.0 Median : 816.5 Median : 965.5
#> Mean : 3071.9 Mean : 2881.5 Mean : 1524.9
#> 3rd Qu.: 3554.2 3rd Qu.: 3922.0 3rd Qu.: 1820.2
#> Max. :60869.0 Max. :40827.0 Max. :47943.0Berdasarkan data di atas, range pengeluaran terbilang cukup luas, hal ini diperkirakan terdapat dua kategori yaitu retail (pengeluaran skala kecil) dan horeca (pengeluaran skala besar). Maka dari itu outliers akan dibiarkan.
Membagi data menjadi data train dan data test menjadi 80:20
# mengunci nilai random
RNGkind(sample.kind = "Rounding")
set.seed(417)
# index sampling
index <- sample(nrow(wholesale), nrow(wholesale)*0.8)
# splitting
wholesale_train <- wholesale[index,]
wholesale_test <- wholesale[-index,]Setelah membagi wholesale menjadi data train dan data
test, selanjutnya kita akan kembali mengecek proporsi data train.
# re-check class imbalance
prop.table(table(wholesale_train$Channel))#>
#> Horeca Retail
#> 0.6619318 0.3380682Proporsi data train Channel masih balance (imbalance ketika lebih besar dari 70:30)
Modeling kali ini menggunakan logistic regression yaitu regresi yang
akan mengklasifikasikan kecenderungan dari data target. Berikut adalah
pemodelan menggunakan glm() dengan family =
binomial.
# model base
model_wholesale <- glm(formula = Channel ~ .,
data = wholesale_train,
family = "binomial")
summary(model_wholesale)#>
#> Call:
#> glm(formula = Channel ~ ., family = "binomial", data = wholesale_train)
#>
#> Coefficients:
#> Estimate Std. Error z value Pr(>|z|)
#> (Intercept) -4.850531628 0.842040049 -5.760 0.00000000839 ***
#> RegionOporto 2.343961699 0.934792133 2.507 0.0122 *
#> RegionOthers 1.220529494 0.688128295 1.774 0.0761 .
#> Fresh 0.000008738 0.000019657 0.445 0.6567
#> Milk 0.000122508 0.000066645 1.838 0.0660 .
#> Grocery 0.000073819 0.000063796 1.157 0.2472
#> Frozen -0.000250712 0.000118975 -2.107 0.0351 *
#> Detergents_Paper 0.000905596 0.000158130 5.727 0.00000001023 ***
#> Delicassen -0.000017941 0.000113436 -0.158 0.8743
#> ---
#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#>
#> (Dispersion parameter for binomial family taken to be 1)
#>
#> Null deviance: 450.38 on 351 degrees of freedom
#> Residual deviance: 160.94 on 343 degrees of freedom
#> AIC: 178.94
#>
#> Number of Fisher Scoring iterations: 7Berdasarkan data di atas, terdapat beberapa kategori data yang mempengaruhi data target, dan adapula yang tidak mempengaruhi data target.
Untuk membandingkan model, maka kita akan membuat model lain
menggunakan stepwise regression dengan direction
backward.
# stepwise
model_step <- step(object = model_wholesale, direction = "backward", trace = T)#> Start: AIC=178.94
#> Channel ~ Region + Fresh + Milk + Grocery + Frozen + Detergents_Paper +
#> Delicassen
#>
#> Df Deviance AIC
#> - Delicassen 1 160.97 176.97
#> - Fresh 1 161.14 177.14
#> - Grocery 1 162.36 178.36
#> <none> 160.94 178.94
#> - Milk 1 164.27 180.27
#> - Region 2 167.73 181.73
#> - Frozen 1 168.64 184.64
#> - Detergents_Paper 1 201.05 217.05
#>
#> Step: AIC=176.97
#> Channel ~ Region + Fresh + Milk + Grocery + Frozen + Detergents_Paper
#>
#> Df Deviance AIC
#> - Fresh 1 161.15 175.15
#> - Grocery 1 162.38 176.38
#> <none> 160.97 176.97
#> - Milk 1 164.29 178.29
#> - Region 2 167.75 179.75
#> - Frozen 1 170.54 184.54
#> - Detergents_Paper 1 201.36 215.36
#>
#> Step: AIC=175.15
#> Channel ~ Region + Milk + Grocery + Frozen + Detergents_Paper
#>
#> Df Deviance AIC
#> - Grocery 1 162.61 174.61
#> <none> 161.15 175.15
#> - Milk 1 164.81 176.81
#> - Region 2 168.13 178.13
#> - Frozen 1 171.02 183.02
#> - Detergents_Paper 1 202.19 214.19
#>
#> Step: AIC=174.61
#> Channel ~ Region + Milk + Frozen + Detergents_Paper
#>
#> Df Deviance AIC
#> <none> 162.61 174.61
#> - Region 2 169.76 177.76
#> - Milk 1 170.12 180.12
#> - Frozen 1 172.61 182.61
#> - Detergents_Paper 1 270.64 280.64summary(model_step)#>
#> Call:
#> glm(formula = Channel ~ Region + Milk + Frozen + Detergents_Paper,
#> family = "binomial", data = wholesale_train)
#>
#> Coefficients:
#> Estimate Std. Error z value Pr(>|z|)
#> (Intercept) -4.67600806 0.81559546 -5.733 0.0000000098527510 ***
#> RegionOporto 2.40958740 0.93858292 2.567 0.01025 *
#> RegionOthers 1.26785245 0.67698418 1.873 0.06110 .
#> Milk 0.00015586 0.00005812 2.682 0.00732 **
#> Frozen -0.00024601 0.00010346 -2.378 0.01741 *
#> Detergents_Paper 0.00099538 0.00013231 7.523 0.0000000000000534 ***
#> ---
#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#>
#> (Dispersion parameter for binomial family taken to be 1)
#>
#> Null deviance: 450.38 on 351 degrees of freedom
#> Residual deviance: 162.61 on 346 degrees of freedom
#> AIC: 174.61
#>
#> Number of Fisher Scoring iterations: 7Kini kita memiliki dua jenis model, maka kita akan membandingkan kedua AIC. AIC mengestimasi jumlah informasi yang hilang dari suatu model. Model terbaik adalah yang memiliki AIC terkecil.
# bandingkan AIC
model_step$aic#> [1] 174.6121model_wholesale$aic#> [1] 178.9402Selanjutnya kita akan membandingkan deviance atau error pada model. Semakin kecil nilai deviance, semakin baik model tersebut.
# bandingkan deviance
model_step$deviance#> [1] 162.6121model_wholesale$deviance#> [1] 160.9402model_step$call#> glm(formula = Channel ~ Region + Milk + Frozen + Detergents_Paper,
#> family = "binomial", data = wholesale_train)Berdasarkan hasil perbandingan nilai AIC dan deviance di atas, maka
dipilihlah model_step dikarenakan nilai AIC yang lebih
kecil meskipun nilai deviance terbilang lebih tinggi dibandingkan nilai
deviance model_wholesale.
Kita akan melakukan prediksi menggunakan model step yang telah
dipilih. Kita akan menggunakan tipe link untuk menghasilkan
prediksi log of odds dan response untuk menghasilkan
prediksi probability.
Prediksi log of odds Channel:
# log of odds
pred_LOD_wholesale <- predict(object = model_step,
newdata = wholesale_test,
type = 'link')Prediksi probability Channel:
# probability
pred_prob_wholesale <- predict(object = model_step,
newdata = wholesale_test,
type = 'response')Mengubah peluang menjadi label prediksi
# ifelse(kondisi, benar, salah)
wholesale_pred_Label <- ifelse(pred_prob_wholesale > 0.5, "Retail", "Horeca")Untuk mengevaluasi model klasifikasi akan menggunakan confusion matrix sebagai berikut.
# confusion matrix
confusionMatrix(data = as.factor(wholesale_pred_Label),
reference = wholesale_test$Channel)#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction Horeca Retail
#> Horeca 64 3
#> Retail 1 20
#>
#> Accuracy : 0.9545
#> 95% CI : (0.8877, 0.9875)
#> No Information Rate : 0.7386
#> P-Value [Acc > NIR] : 0.0000001108
#>
#> Kappa : 0.8789
#>
#> Mcnemar's Test P-Value : 0.6171
#>
#> Sensitivity : 0.9846
#> Specificity : 0.8696
#> Pos Pred Value : 0.9552
#> Neg Pred Value : 0.9524
#> Prevalence : 0.7386
#> Detection Rate : 0.7273
#> Detection Prevalence : 0.7614
#> Balanced Accuracy : 0.9271
#>
#> 'Positive' Class : Horeca
#> Berdasarkan hasil confusion matrix di atas, maka interpretasi modelnya dapat dijabarkan sebagai berikut:
FN : diprediksi Retail, padahal Horace - Resiko: perkiraan pengeluaran retail tinggi, padahal pengeluaran tinggi adalah wholesale karena Horeca
FP : diprediksi Horeca, padahal Retail. - Resiko: perkiraan pengeluaran Horeca rendah padahal pengeluaran rendah adalah retail.
Risiko yang concerning adalah jika terjadi kejadian FN, dikarenakan untuk menghindari perkiraan bahwa pengeluaran tinggi diakibatkan oleh retail yang mana retail pada umumnya adalah pengeluaran kecil atau eceran, sehingga kita akan mengambil metriks evaluasi Recall/Sensitivity
Berdasarkan model evaluasi di atas, dapat dilihat akurasi dari model sebesar 0.9545 dengan level Sensitivity sebsar 0.9846
Untuk k-NN, kita akan memisahkan antara prediktor dan label (target variabelnya).
# prediktor data train
wholesale_train_x <- wholesale_train %>% select_if(is.numeric)
# target data train
wholesale_train_y <- wholesale_train[,"Channel"]
# prediktor data test
wholesale_test_x <- wholesale_test %>% select_if(is.numeric)
# target data test
wholesale_test_y <- wholesale_test[,"Channel"]Kemudian kita akan melakukan scaling data untuk mensejajarkan range data antar variabel numerik
# scaling data
# train
wholesale_train_xs <- scale(x = wholesale_train_x) # data prediktor untuk data train
# test
wholesale_test_xs <- scale(x = wholesale_test_x,
center = attr(wholesale_train_xs, "scaled:center"), #nilai rata2 data
scale = attr(wholesale_train_xs,"scaled:scale")) #nilai data trainSelanjutnya kita akan menghitung nilai k
nrow(wholesale)#> [1] 440nrow(wholesale_train)#> [1] 352# find optimum k
sqrt(nrow(wholesale_train))#> [1] 18.76166Berdasarkan jumlah data dan perhitungan nilai k, maka nilai K yang dipilih adalah 19.
pred_knn <- knn(train = wholesale_train_xs, # prediktor data train
test = wholesale_test_xs, # prediktor data test
cl = wholesale_train_y, # label dari data train
k = 19)
head(pred_knn)#> [1] Horeca Horeca Retail Horeca Horeca Horeca
#> Levels: Horeca RetailUntuk melakukan evaluasi model, kita akan melihat hasil confusion matrix
confusionMatrix(pred_knn, wholesale_test_y)#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction Horeca Retail
#> Horeca 60 3
#> Retail 5 20
#>
#> Accuracy : 0.9091
#> 95% CI : (0.8287, 0.9599)
#> No Information Rate : 0.7386
#> P-Value [Acc > NIR] : 0.00005688
#>
#> Kappa : 0.771
#>
#> Mcnemar's Test P-Value : 0.7237
#>
#> Sensitivity : 0.9231
#> Specificity : 0.8696
#> Pos Pred Value : 0.9524
#> Neg Pred Value : 0.8000
#> Prevalence : 0.7386
#> Detection Rate : 0.6818
#> Detection Prevalence : 0.7159
#> Balanced Accuracy : 0.8963
#>
#> 'Positive' Class : Horeca
#> Berdasarkan hasil confusion matrix di atas, didapat bahwa nilai akurasi sebesar 0.9091 dan nilai recall/sensitivitynya sebesar 0.9231.
Berdasarkan kedua jenis metode pemodelan klasifikasi didapat: Logistic Regression : - Accuracy : 0.9545 - Sensitivity : 0.9846 K-Nearest Neighbour : - Accuracy : 0.9091 - Sensitivity : 0.9231
Dapat disimpulkan bahwa model yang dapat memperkirakan model tes lebih baik adalah model logistic regression.
Berdasarkan percobaan machine learning dengan kedua metode di atas,
dapat disimpulkan kedua metode dapat menghasilkan akurasi yang cukup
tinggi. K-nn cenderung memiliki performa yang lebih baik pada umumnya,
namun lebih baik apabila data prediktornya adalah binary, sementara
logistic regression tetap dapat dilakukan apabila terdapat tipe data
numerikal pada prediktor. Berhubung pada data wholesale
kali ini cenderung memiliki lebih banyak tipe data numerikal, maka dari
itu metode logistic regression memiliki hasil yang lebih baik
dibandingkan metode K-Nearest Neighbour.