Klasifikasi Menggunakan Regresi Logistik dan K-NN
Ichlasul Amal
January 18, 2021
1 Objektif
Pada artikel ini, dilakukan penerapan algoritma klasifikasi Regresi Logistik dan K-Nearest Neighbors (K-NN) di industri FMCG. Dataset yang digunakan berasal dari data pembelian tiap klien. Klasifikasi yang dilakukan adalah segmentasi klien yang terdiri dari dua kategori, yaitu Horeca (Hotel, Restaurant, Cafe) dan Retail.
2 Read data
wholesale <- read.csv("data_input/wholesale.csv")
head(wholesale)library(tidyverse)
glimpse(wholesale)#> Rows: 440
#> Columns: 8
#> $ Channel <int> 2, 2, 2, 1, 2, 2, 2, 2, 1, 2, 2, 2, 2, 2, 2, 1, 2,...
#> $ Region <int> 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,...
#> $ Fresh <int> 12669, 7057, 6353, 13265, 22615, 9413, 12126, 7579...
#> $ Milk <int> 9656, 9810, 8808, 1196, 5410, 8259, 3199, 4956, 36...
#> $ Grocery <int> 7561, 9568, 7684, 4221, 7198, 5126, 6975, 9426, 61...
#> $ Frozen <int> 214, 1762, 2405, 6404, 3915, 666, 480, 1669, 425, ...
#> $ Detergents_Paper <int> 2674, 3293, 3516, 507, 1777, 1795, 3140, 3321, 171...
#> $ Delicassen <int> 1338, 1776, 7844, 1788, 5185, 1451, 545, 2566, 750...Deskripsi dari tiap kolom sebagai berikut:
- Channel: horeca (1), retail (2)
- Region: lokasi toko; Lisbon (1), Oporto (2), Other regions (3)
- Fresh: jumlah pembelian produk segar
- Milk: jumlah pembelian produk susu
- Grocery: jumlah pembelian produk grocery
- Frozen: jumlah pembelian produk es/beku
- Detergents_Paper: jumlah pembelian produk detergent & kertas
- Delicassen: jumlah pembelian produk delicatessen (berkualitas tinggi)
3 Data wrangling
Tipe data masih ada yang belum tepat, yaitu variabel Channel yang seharusnya bertipe kategorik. Selain itu, variabel Region akan diremove karena tidak digunakan dalam analisis.
wholesale <- wholesale %>%
select(-Region) %>%
mutate(Channel = factor(Channel, levels = c(1, 2), labels = c("Horeca", "Retail")))
wholesale4 Analisis data eksplorasi
Sebelum masuk ke pemodelan, perlu dicek terlebih dahulu proporsi kategori pada variabel target, yaitu Channel
prop.table(table(wholesale$Channel))#>
#> Horeca Retail
#> 0.6772727 0.3227273Proporsi pada variabel target 68:32, proporsi ini sudah bisa dikatakan seimbang. Selanjutnya melakukan cek range pada variabel prediktor.
summary(wholesale)#> Channel Fresh Milk Grocery
#> Horeca:298 Min. : 3 Min. : 55 Min. : 3
#> Retail:142 1st Qu.: 3128 1st Qu.: 1533 1st Qu.: 2153
#> 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.0Range pada variabel prediktor di atas berbeda-beda, hal ini dapat mengakibatkan hasil yang kurang tepat dalam klasifikasi menggunakan K-NN, karena K-NN mengukur jarak antara pasangan sampel dan jarak ini juga dipengaruhi oleh unit pengukuran, sehingga variabel prediktor perlu untuk dilakukan scaling.
5 Regresi logistik
Algoritma pertama yang akan digunakan dalam analisis klasifikasi segmentasi kelas ini adalah Regresi Logistik.
5.1 Split data
Hal yang perlu dilakukan selanjutnya adalah membagi data menjadi data train dan data test. Data train digunakan untuk membangun model, sedangkan data test digunakan untuk menguji model yang sudah dibuat dan mengetahui kinerja model. Perbandingan untuk data train dan data test adalah 80:20.
RNGkind(sample.kind = "Rounding")
set.seed(123)
intrain <- sample(nrow(wholesale), nrow(wholesale)*0.8)
wholesale.train <- wholesale[intrain, ]
wholesale.test <- wholesale[-intrain, ]Cek proporsi variabel target pada data train
prop.table(table(wholesale.train$Channel))#>
#> Horeca Retail
#> 0.6846591 0.3153409Proporsi pada variabel target di data train 68:32, proporsi ini sudah bisa dikatakan seimbang, sehingga bisa dilanjutkan pada pemodelan.
5.2 Pemodelan
model_log <- glm(Channel ~ ., data = wholesale.train, family = "binomial")
summary(model_log)#>
#> Call:
#> glm(formula = Channel ~ ., family = "binomial", data = wholesale.train)
#>
#> Deviance Residuals:
#> Min 1Q Median 3Q Max
#> -2.8246 -0.2821 -0.2092 0.0294 3.4120
#>
#> Coefficients:
#> Estimate Std. Error z value Pr(>|z|)
#> (Intercept) -3.582555878 0.469090997 -7.637 0.0000000000000222 ***
#> Fresh 0.000003328 0.000019275 0.173 0.8629
#> Milk 0.000080702 0.000062604 1.289 0.1974
#> Grocery 0.000111739 0.000069227 1.614 0.1065
#> Frozen -0.000207831 0.000112602 -1.846 0.0649 .
#> Detergents_Paper 0.000840234 0.000157109 5.348 0.0000000888777256 ***
#> Delicassen -0.000157564 0.000138430 -1.138 0.2550
#> ---
#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#>
#> (Dispersion parameter for binomial family taken to be 1)
#>
#> Null deviance: 438.81 on 351 degrees of freedom
#> Residual deviance: 153.08 on 345 degrees of freedom
#> AIC: 167.08
#>
#> Number of Fisher Scoring iterations: 7Pada penggunaan semua variabel prediktor, disimpulkan masih lebih banyak variabel prediktor yang tidak signifikan terhadap variabel target. Dicoba melakukan pemodelan dengan metode step wise.
backward <- step(model_log, direction = "backward")#> Start: AIC=167.08
#> Channel ~ Fresh + Milk + Grocery + Frozen + Detergents_Paper +
#> Delicassen
#>
#> Df Deviance AIC
#> - Fresh 1 153.11 165.11
#> - Delicassen 1 154.50 166.50
#> - Milk 1 154.70 166.70
#> <none> 153.08 167.08
#> - Grocery 1 155.95 167.95
#> - Frozen 1 157.89 169.89
#> - Detergents_Paper 1 185.78 197.78
#>
#> Step: AIC=165.11
#> Channel ~ Milk + Grocery + Frozen + Detergents_Paper + Delicassen
#>
#> Df Deviance AIC
#> - Delicassen 1 154.51 164.51
#> - Milk 1 154.93 164.93
#> <none> 153.11 165.11
#> - Grocery 1 155.99 165.99
#> - Frozen 1 158.48 168.48
#> - Detergents_Paper 1 187.66 197.66
#>
#> Step: AIC=164.51
#> Channel ~ Milk + Grocery + Frozen + Detergents_Paper
#>
#> Df Deviance AIC
#> - Milk 1 156.38 164.38
#> - Grocery 1 156.47 164.47
#> <none> 154.51 164.51
#> - Frozen 1 163.50 171.50
#> - Detergents_Paper 1 193.56 201.56
#>
#> Step: AIC=164.38
#> Channel ~ Grocery + Frozen + Detergents_Paper
#>
#> Df Deviance AIC
#> <none> 156.38 164.38
#> - Grocery 1 161.69 167.69
#> - Frozen 1 163.52 169.52
#> - Detergents_Paper 1 195.83 201.83Menggunakan metode backward pada step wise, diperoleh model sebagai berikut:
summary(backward)#>
#> Call:
#> glm(formula = Channel ~ Grocery + Frozen + Detergents_Paper,
#> family = "binomial", data = wholesale.train)
#>
#> Deviance Residuals:
#> Min 1Q Median 3Q Max
#> -2.8312 -0.2966 -0.2235 0.0340 3.2083
#>
#> Coefficients:
#> Estimate Std. Error z value Pr(>|z|)
#> (Intercept) -3.52275722 0.45271104 -7.781 0.00000000000000717 ***
#> Grocery 0.00012741 0.00005518 2.309 0.0210 *
#> Frozen -0.00019479 0.00008521 -2.286 0.0223 *
#> Detergents_Paper 0.00085538 0.00014812 5.775 0.00000000770299487 ***
#> ---
#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#>
#> (Dispersion parameter for binomial family taken to be 1)
#>
#> Null deviance: 438.81 on 351 degrees of freedom
#> Residual deviance: 156.38 on 348 degrees of freedom
#> AIC: 164.38
#>
#> Number of Fisher Scoring iterations: 7Variabel prediktor yang ada di model backward telah signifikan berpengaruh terhadap variabel target.
5.3 Prediksi
Cek label untuk peluang yang mendekati 1
levels(wholesale.train$Channel)#> [1] "Horeca" "Retail"Selanjutnya melakukan prediksi menggunakan data test, dengan hasil adalah sebuah probabilitas
wholesale.test$log.Risk <- predict(backward, newdata = wholesale.test, type = "response")ggplot(wholesale.test, aes(x=log.Risk)) +
geom_density(lwd=0.5) +
labs(title = "Distribusi Peluang Data Prediksi") +
theme_light()
Pada grafik diatas, dapat diinterpretasikan bahwa hasil prediksi yang dilakukan lebih condong ke arah 0 yang artinya Horeca (Hotel, Restaurant, Cafe).
Kemudian ubah menjadi label, dengan peluang yang mendekati 1 adalah label "Retail".
wholesale.test$log.Label <- factor(ifelse(wholesale.test$log.Risk > 0.5, "Retail","Horeca"))
wholesale.test[1:10, c("log.Label", "Channel")]Variabel log.Label adalah hasil prediksi dan variabel Channel adalah targetnya.
6 K-Nearest Neighbors (KNN)
Algoritma selanjutnya yang digunakan adalah K-Nearest Neighbors.
6.1 Split data
Digunakan data yang sebelumnya telah dipisahkan menjadi data train dan test, kemudian data perlu dipisahkan antara variabel prediktor dan targetnya.
wholesale_train_x <- wholesale.train[,-1]
wholesale_test_x <- wholesale.test[,-c(1,8,9)]
wholesale_train_y <- wholesale.train[,1]
wholesale_test_y <- wholesale.test[,1]6.2 Scaling
Variabel prediktor dilakukan transformasi menggunakan z-score standarization.
wholesale_train_xs <- scale(x = wholesale_train_x)
wholesale_test_xs <- scale(x = wholesale_test_x,
center = attr(wholesale_train_xs, "scaled:center"),
scale = attr(wholesale_train_xs, "scaled:scale"))6.3 Klasifikasi
Sebelum ke klasifikasi, tentukan k yang optimal terlebih dahulu, dengan cara mencari akar dari banyak baris pada data train
round(sqrt(nrow(wholesale_train_xs)))#> [1] 19K yang dipilih adalah 19, selain karena hasil dari perhitungan k optimal, juga memenuhi syarat k harus ganjil, sebab banyak kategori variabel target adalah genap (2).
library(class)
knn.Label <- knn(train = wholesale_train_xs,
test = wholesale_test_xs,
cl = wholesale_train_y,
k = 19)
head(knn.Label)#> [1] Horeca Horeca Horeca Horeca Retail Retail
#> Levels: Horeca Retail7 Evaluasi model
7.1 Regresi Logistik
Lakukan evaluasi pada model Regresi Logistik
library(caret)
cm_log <- confusionMatrix(data = wholesale.test$log.Label,
reference = wholesale.test$Channel)
cm_log#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction Horeca Retail
#> Horeca 54 11
#> Retail 3 20
#>
#> Accuracy : 0.8409
#> 95% CI : (0.7475, 0.9102)
#> No Information Rate : 0.6477
#> P-Value [Acc > NIR] : 0.00004804
#>
#> Kappa : 0.6296
#>
#> Mcnemar's Test P-Value : 0.06137
#>
#> Sensitivity : 0.9474
#> Specificity : 0.6452
#> Pos Pred Value : 0.8308
#> Neg Pred Value : 0.8696
#> Prevalence : 0.6477
#> Detection Rate : 0.6136
#> Detection Prevalence : 0.7386
#> Balanced Accuracy : 0.7963
#>
#> 'Positive' Class : Horeca
#> - Re-call/Sensitivity = dari semua data aktual yang positif, seberapa mampu proporsi model menebak dengan benar kelas positif.
- Specificity = dari semua data aktual yang negatif, seberapa mampu proporsi model menebak dengan benar kelas negatif.
- Accuracy = seberapa mampu model menebak dengan benar variabel target Y.
- Precision = dari semua hasil prediksi yang positif, seberapa mampu model menebak dengan benar kelas positif.
eval_logit <- tibble(Accuracy = cm_log$overall[1],
Recall = cm_log$byClass[1],
Specificity = cm_log$byClass[2],
Precision = cm_log$byClass[3])
eval_logitDari hasil di atas, dapat kita ambil informasi bahwa kemampuan model dalam menebak target Y (Horeca dan Retail) sebesar 84.09%. Sedangkan dari keluruhan data aktual klien Horeca, model mampu menebak dengan benar sebesar 94.74%. Dari keseluruhan data aktual klien Retail, model mampu menebak dengan benar sebesar 64.52%. Dari keseluruhan hasil prediksi yang mampu ditebak oleh model, model mampu menebak benar segmen klien Horeca sebesar 83.08%.
7.1.1 Tuning cutoff
Dilakukan tuning cutoff untuk mengetahui threshold maksimum dari apa yang akan kita teliti.
performa <- function(cutoff, prob, ref, postarget, negtarget)
{
predict <- factor(ifelse(prob >= cutoff, postarget, negtarget))
conf <- confusionMatrix(predict , ref, positive = postarget)
acc <- conf$overall[1]
rec <- conf$byClass[1]
prec <- conf$byClass[3]
spec <- conf$byClass[2]
mat <- t(as.matrix(c(rec , acc , prec, spec)))
colnames(mat) <- c("recall", "accuracy", "precicion", "specificity")
return(mat)
}
co <- seq(0.01,0.80,length=100)
result <- matrix(0,100,4)
for(i in 1:100){
result[i,] = performa(cutoff = co[i],
prob = wholesale.test$log.Risk,
ref = wholesale.test$Channel,
postarget = "Horeca",
negtarget = "Retail")
}
tibble("Recall" = result[,1],
"Accuracy" = result[,2],
"Precision" = result[,3],
"Specificity" = result[,4],
"Cutoff" = co) %>%
gather(key = "performa", value = "value", 1:4) %>%
ggplot(aes(x = Cutoff, y = value, col = performa)) +
geom_line(lwd = 1.5) +
scale_color_manual(values = c("darkred","darkgreen","orange", "blue")) +
scale_y_continuous(breaks = seq(0,1,0.1), limits = c(0,1)) +
scale_x_continuous(breaks = seq(0,1,0.1)) +
labs(title = "Tradeoff model perfomance") +
theme_light() +
theme(legend.position = "top",
panel.grid.minor.y = element_blank(),
panel.grid.minor.x = element_blank())
Berdasarkan grafik Tradeoff model performance diatas, dapat diketahui bahwa dengan cutoff/threshold 0.5 kita memperoleh nilai specificity, accuracy dan precision yang cukup tinggi, namun nilai recall agak rendah. Semua kelas di variabel target dianggap penting, maka metrik yang akan digunakan adalah accuracy, sehingga cutoff/threshold yang dipakai tetap 0.5.
7.2 KNN
Lakukan evaluasi pada model K-Nearest Neighbors
cm_knn <- confusionMatrix(data = knn.Label,
reference = wholesale_test_y)
cm_knn#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction Horeca Retail
#> Horeca 54 9
#> Retail 3 22
#>
#> Accuracy : 0.8636
#> 95% CI : (0.7739, 0.9275)
#> No Information Rate : 0.6477
#> P-Value [Acc > NIR] : 0.000004804
#>
#> Kappa : 0.6874
#>
#> Mcnemar's Test P-Value : 0.1489
#>
#> Sensitivity : 0.9474
#> Specificity : 0.7097
#> Pos Pred Value : 0.8571
#> Neg Pred Value : 0.8800
#> Prevalence : 0.6477
#> Detection Rate : 0.6136
#> Detection Prevalence : 0.7159
#> Balanced Accuracy : 0.8285
#>
#> 'Positive' Class : Horeca
#> eval_knn <- tibble(Accuracy = cm_knn$overall[1],
Recall = cm_knn$byClass[1],
Specificity = cm_knn$byClass[2],
Precision = cm_knn$byClass[3])
eval_knnDari hasil di atas, dapat kita ambil informasi bahwa kemampuan model dalam menebak target Y (Horeca dan Retail) sebesar 86.36%. Sedangkan dari keluruhan data aktual klien Horeca, model mampu menebak dengan benar sebesar 94.74%. Dari keseluruhan data aktual klien Retail, model mampu menebak dengan benar sebesar 70.97%. Dari keseluruhan hasil prediksi yang mampu ditebak oleh model, model mampu menebak benar segmen klien Horeca sebesar 85.71%.
8 Simpulan
Dilihat dari kedua metode yaitu Regresi Logistik dan K-NN, kinerja model dalam memprediksi benar dari data aktual segmentasi klien sudah baik, dibuktikan dengan nilai Accuracy yang lebih dari 80% untuk kedua metode. Karena semua kelas dianggap penting, maka metrik yang digunakan untuk perbandingan kinerja model adalah Accuracy. Model dengan metode K-NN lebih baik dalam klasifikasi ini karena memiliki nilai Accuracy = 86.36% lebih besar dari pada menggunakan metode regresi logistik yang memiliki nilai Accuracy = 84.09%.