Klasifikasi Konsumen

Pendahuluan

Kita selaku tim data dari distributor grosir perlu mengklasifikasikan seorang konsumen baru dengan cepat dan tepat. Dengan kita mengetahui kelompok mana seorang konsumen akan mempermudah kita dalam memberikan promosi, melakukan segmentasi, meningkatkan rasa kedekatan personal dan masih banyak lagi. Melalui manfaat-manfaaat tersebut akan menghasilkan peningkatan penjualan maupun profit. Namun, pada realitasnya sering kali kita sulit menemukan pola, bagaimana membedakan satu kelompok kelas dengan lainnya terutama ketika informasi yang akan diamati sudah lebih dari satu kolom. Oleh karena itu, projek Machine Learning ini dibuat untuk mencoba menyelesaikan kesulitan tersebut dengan efektif (karena memiliki ukuran kualitas yang jelas) dan efisien (karena dengan bantuan komputasi bukan manual). Projek ini menggunakan dataset dari Kaggle.

Persiapan dan Wrangling Data

Pustaka

library(dplyr)
library(ggplot2)
library(plotly)
library(glue)
library(gtools)
library(caret)
library(class)

Membaca Dataset

whole <- read.csv("data_input/wholesale.csv")
whole

Deskripsi kolom :

Kelas Target :

Channel : Termasuk pada saluran mana, 1 : Horeca (Hotel/Restoran/Cafe) atau 2 : Retail.

Prediktor

Regions : Wilayah bagian mana, 1 : Linson; 2 : Oporto; 3 : lainnya.
Fresh : Pengeluaran tahunan untuk produk segar.
Milk : Pengeluaran tahunan untuk produk susu.
Grocery : Pengeluaran tahunan untuk produk sehari-hari.
Frozen : Pengeluaran tahunan untuk produk beku.
Detergent_Paper : Pengeluaran tahunan untuk Deterjen dan Kertas
Delicassen : Pengeluaran tahunan untuk produk makanan.

Mengecek Nilai Hilang

anyNA(whole)

#> [1] FALSE

Tidak terdapat nilai hilang sehingga dapat lanjut ke tahap selanjutnya.

Mengecek Duplikasi Data

anyDuplicated(whole)

#> [1] 0

Tidak terdapat data yang terduplikasi sehingga dapat lanjut ke tahap selanjutnya.

Menyesuaikan Tipe Data

Melihat nilai unik kolom Channel dan Region.

lapply(X = whole[, 1:2],
       FUN = unique)

#> $Channel
#> [1] 2 1
#> 
#> $Region
#> [1] 3 1 2

Untuk data yang memiliki nilai berulang atau bersifat kategorikal dapat kita ubah menjadi factor().

whole_cl <- whole %>% 
  mutate(Channel = as.factor(Channel),
         Region = as.factor(Region))

Melihat struktur data :

glimpse(whole_cl)

#> Rows: 440
#> Columns: 8
#> $ Channel          <fct> 2, 2, 2, 1, 2, 2, 2, 2, 1, 2, 2, 2, 2, 2, 2, 1, 2, 1,…
#> $ Region           <fct> 3, 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, 5…
#> $ Milk             <int> 9656, 9810, 8808, 1196, 5410, 8259, 3199, 4956, 3648,…
#> $ Grocery          <int> 7561, 9568, 7684, 4221, 7198, 5126, 6975, 9426, 6192,…
#> $ Frozen           <int> 214, 1762, 2405, 6404, 3915, 666, 480, 1669, 425, 115…
#> $ Detergents_Paper <int> 2674, 3293, 3516, 507, 1777, 1795, 3140, 3321, 1716, …
#> $ Delicassen       <int> 1338, 1776, 7844, 1788, 5185, 1451, 545, 2566, 750, 2…

Kita memiliki 440 baris dengan 8 kolom.
Terdapat 2 kolom yang bertipe factor yaitu Channel dan Region
Terdapat 6 kolom yang bertipe integer (angka) yaitu Region, Fresh, Milk, Grocery, Frozen, Detergents_Paper dan Delicassen.

Eksplorasi Data Analisis

Ringkasan Data

summary(whole_cl)

#>  Channel Region      Fresh             Milk          Grocery     
#>  1:298   1: 77   Min.   :     3   Min.   :   55   Min.   :    3  
#>  2:142   2: 47   1st Qu.:  3128   1st Qu.: 1533   1st Qu.: 2153  
#>          3: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.0

Penjualan kita, didominasi Channel jenis 1 alias pembeli Horeca (Hotel/Restoran/Cafe).
Daerah (Region) yang memiliki jumlah observasi terbanyak pada jenis 1 alias daerah Linson, sisanya di jenis 2 dan lainnya
Transaksi pembelian Fresh tahunan di dominasi (75%) pada total transaksi sebesar 3 sampai 16,934 dengan tertinggi di angka 112,151
Transaksi pembelian Milk tahunan di dominasi (75%) pada total transaksi sebesar 55 sampai 7,190 dengan tertinggi di angka 73,498.
Transaksi pembelian Grocery tahunan di dominasi (75%) pada total transaksi sebesar 3 sampai 10,656 dengan tertinggi di angka 92,780
Transaksi pembelian Frozen tahunan di dominasi (75%) pada total transaksi sebesar 25 sampai 3,554.2 dengan tertinggi di angka 60,869
Transaksi pembelian Detergents_Paper tahunan di dominasi (75%) pada total transaksi sebesar 3 sampai 3,922 dengan tertinggi di angka 40,827
Transaksi pembelian Delicassen tahunan di dominasi (75%) pada total transaksi sebesar 3 sampai 1820.2 dengan tertinggi di angka 47,943

Visualisasi Perbandingan Kelas Target

whole_data <- as.data.frame(table(whole_cl$Channel))

plt <- 
ggplot(data = whole_data, aes(x = Var1, y = Freq, fill = Var1,
                              text = glue("Channel : {Var1}.
                                           Jumlah : {Freq}"))) + 
  geom_bar(stat = "identity") +
  labs(title = "Perbandingan Jumlah Konsumen Pada Setiap Channel",
              y = "Jumlah",
              x = "Channel") +
  theme_minimal()

ggplotly(plt, tooltip =  "text" )

Pada data penjualan ini di dominasi pembeli Channel 1 atau Horeca (Hotel/Restoran/Cafe).

Klasifikasi Dengan :

Logistic Regression

1. Membagi Dataset (Spliting Dataset)

Meskipun proporsi Channel 1 dan 2 tidak seimbang tetapi model yang dihasilkan relatif tetap baik. Selain itu, Data yang didapatkan adalah data yang memang terjadi dilapangan bukan estimasi dan lain sebagainya. Kemudian data yang dimiliki relatif sangat terbatas, tidak dapat ditambah. Jadi, saya memilih tidak menyeimbangkan proporsi kelas.

set.seed(100)

index <- sample(nrow(whole_cl), nrow(whole_cl)*0.8)

train_whole_lr <- whole_cl[index,]
test_whole_lr <- whole_cl[-index,]

2. Membangun Model

Menggunakan semua prediktor untuk membangun model yang dapat memprediksi Channel.

model_log <- glm(formula = Channel~., data = train_whole_lr, family = "binomial")
summary(model_log)

#> 
#> Call:
#> glm(formula = Channel ~ ., family = "binomial", data = train_whole_lr)
#> 
#> Deviance Residuals: 
#>      Min        1Q    Median        3Q       Max  
#> -2.83559  -0.33974  -0.21826   0.04344   3.03949  
#> 
#> Coefficients:
#>                      Estimate   Std. Error z value      Pr(>|z|)    
#> (Intercept)      -4.881423371  0.811669122  -6.014 0.00000000181 ***
#> Region2           2.211573645  0.899463690   2.459        0.0139 *  
#> Region3           1.364908002  0.695238969   1.963        0.0496 *  
#> Fresh             0.000008081  0.000018463   0.438        0.6616    
#> Milk              0.000069286  0.000064760   1.070        0.2847    
#> Grocery           0.000091866  0.000063612   1.444        0.1487    
#> Frozen           -0.000170469  0.000104227  -1.636        0.1019    
#> Detergents_Paper  0.000874939  0.000151556   5.773 0.00000000779 ***
#> Delicassen       -0.000077326  0.000113210  -0.683        0.4946    
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 441.86  on 351  degrees of freedom
#> Residual deviance: 164.80  on 343  degrees of freedom
#> AIC: 182.8
#> 
#> Number of Fisher Scoring iterations: 7

3. Menerapkan Stepwise Regression

A. Melakukan pemilihan beberapa prediktor yang signifikan.

step(model_log, direction = "backward", trace = FALSE)

#> 
#> Call:  glm(formula = Channel ~ Region + Grocery + Frozen + Detergents_Paper, 
#>     family = "binomial", data = train_whole_lr)
#> 
#> Coefficients:
#>      (Intercept)           Region2           Region3           Grocery  
#>       -4.7972652         2.1657774         1.3801611         0.0001175  
#>           Frozen  Detergents_Paper  
#>       -0.0001417         0.0008771  
#> 
#> Degrees of Freedom: 351 Total (i.e. Null);  346 Residual
#> Null Deviance:       441.9 
#> Residual Deviance: 166.6     AIC: 178.6

B. Menyimpan model hasil Stepwise Regression

model_back <-glm(formula = Channel ~ Region + Grocery + Frozen + Detergents_Paper, 
    family = "binomial", data = train_whole_lr)

C. Mengevaluasi Model Backward dengan Model Biasa (Logistic Regression)

dev_log <- model_log$deviance
dev_back <- model_back$deviance
aic_log <- model_log$aic
aic_back <- model_back$aic

data.frame(Metric = c("Residual deviance", "AIC"),
           Model_Logistic = c(dev_log, aic_log),
           Model_Backward = c(dev_back, aic_back))

Residual deviance: residual deviance menunjukkan error ketika model dengan seluruh prediktor.
Akaike Information Criterion (AIC) merepresentasikan banyaknya informasi yang hilang pada model, atau information loss.
Kita berusaha mencari nilai residual deviance & AIC terkecil.

Jadi Pada pertimbangan ini kita menggunakan model backward karena memiliki perbedaan sedikit pada Residual Deviance dan perbedaan banyak pada AIC dibandingkan Model Logistic.

D. Intrepretasi Model Backward :

summary(model_back)

#> 
#> Call:
#> glm(formula = Channel ~ Region + Grocery + Frozen + Detergents_Paper, 
#>     family = "binomial", data = train_whole_lr)
#> 
#> Deviance Residuals: 
#>     Min       1Q   Median       3Q      Max  
#> -2.8741  -0.3327  -0.2275   0.0516   2.9966  
#> 
#> Coefficients:
#>                     Estimate  Std. Error z value      Pr(>|z|)    
#> (Intercept)      -4.79726524  0.80457037  -5.963 0.00000000248 ***
#> Region2           2.16577742  0.88737031   2.441        0.0147 *  
#> Region3           1.38016112  0.70057202   1.970        0.0488 *  
#> Grocery           0.00011753  0.00005420   2.168        0.0301 *  
#> Frozen           -0.00014167  0.00007864  -1.802        0.0716 .  
#> Detergents_Paper  0.00087711  0.00014927   5.876 0.00000000420 ***
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 441.86  on 351  degrees of freedom
#> Residual deviance: 166.58  on 346  degrees of freedom
#> AIC: 178.58
#> 
#> Number of Fisher Scoring iterations: 7

Intercept : -4.79726524

# Ubah menjadi bentuk probabilitas
inv.logit(-4.79726524) * 100

#> [1] 0.8184741

Konsumen yang tinggal di Region 1 berpeluang 0.81% masuk Channel 2.

Region2 : 2.16577742

# Ubah menjadi bentuk probabilitas
inv.logit(2.165777424) * 100

#> [1] 89.71339

Konsumen yang tinggal di Region 2 cenderung lebih berpeluang 89.71 % masuk Channel 2 dibandingkan konsumen di Region 1.

Region3 : 1.38016112

# Ubah menjadi bentuk probabilitas
inv.logit(1.38016112) * 100

#> [1] 79.90169

Konsumen yang tinggal di Region 3 cenderung lebih berpeluang 79.90% masuk Channel 2 dibandingkan konsumen di Region 1.

Grocery : 0.00011753

# Ubah menjadi bentuk odds
exp(0.00011753)

#> [1] 1.000118

Kemungkinan konsumen termasuk Channel 2 adalah 1.000118 kali lebih baik dibandingkan konsumen dengan perbedaan 1 satuan nilai Grocery di bawahnya.

Frozen : -0.00014167

# Ubah menjadi bentuk odds
exp(-0.00014167)

#> [1] 0.9998583

Kemungkinan konsumen termasuk Channel 2 adalah 0.9998583 kali lebih baik dibandingkan konsumen dengan perbedaan 1 satuan nilai Frozen di bawahnya.

Detergents_Paper : 0.00087711

# Ubah menjadi bentuk odds
exp(0.00087711)

#> [1] 1.000877

Kemungkinan konsumen termasuk Channel 2 adalah 1.000877 kali lebih baik dibandingkan konsumen dengan perbedaan 1 satuan nilai Detergent_Paper di bawahnya.

4. Prediksi

A. Memprediksi data baru dan menghasilkan probabilitas.

test_whole_lr$pred <- predict(object = model_back, newdata = test_whole_lr, type = "response")

B. Mengubah nilai probabilatas menjadi nama kelas target.

test_whole_lr$label_pred <- ifelse(test_whole_lr$pred>0.5, "2", "1") %>% as.factor()

C. Melihat hasil prediksi

test_whole_lr %>% select(pred, label_pred, Channel)

5. Evaluasi Model

Confusion Matrix :

confusionMatrix(data = test_whole_lr$label_pred, reference = test_whole_lr$Channel, positive="1")

#> Confusion Matrix and Statistics
#> 
#>           Reference
#> Prediction  1  2
#>          1 57  5
#>          2  2 24
#>                                          
#>                Accuracy : 0.9205         
#>                  95% CI : (0.843, 0.9674)
#>     No Information Rate : 0.6705         
#>     P-Value [Acc > NIR] : 0.0000000278   
#>                                          
#>                   Kappa : 0.8151         
#>                                          
#>  Mcnemar's Test P-Value : 0.4497         
#>                                          
#>             Sensitivity : 0.9661         
#>             Specificity : 0.8276         
#>          Pos Pred Value : 0.9194         
#>          Neg Pred Value : 0.9231         
#>              Prevalence : 0.6705         
#>          Detection Rate : 0.6477         
#>    Detection Prevalence : 0.7045         
#>       Balanced Accuracy : 0.8968         
#>                                          
#>        'Positive' Class : 1              
#>

Pada umumnya kita mengevaluasi model menggunakan 5 ukuran:

Re-call/Sensitivity = dari semua data aktual yang Channel 1, seberapa mampu proporsi model memprediksi benar.
Specificity = dari semua data aktual yang Channel 2, seberapa mampu proporsi model memprediksi yang benar.
Accuracy = seberapa mampu model memprediksi dengan benar target kelas.
Precision = dari semua hasil prediksi, seberapa mampu model saya dapat memprediksi benar kelas Channel 1.
Negative Predict Value (Neg Pred Value) : dari semua hasil prediksi, seberapa mampu model saya dapat memprediksi benar kelas Channel 2.

Sebaiknya pada kasus ini, kita memperhatikan metrik Sensitivity dan Specificity bukan Accuracy karena terdapat ketidakseimbangan kelas.

Sensitivity : 0.9661
Specificity : 0.8276
Accuracy :0.9205
Pos Pred Value : 0.9194
Neg Pred Value : 0.9231

Secara keseluruhan model kita sudah baik karena memiliki nilai metrics di atas 82% semua.

K-Nearest Neighboor (KNN)

1. Membagi Dataset (Spliting Dataset)

set.seed(100)

index <- sample(nrow(whole_cl), nrow(whole_cl)*0.8)

train_whole_knn <- whole_cl[index,]
test_whole_knn <- whole_cl[-index,]

# prediktor data train
train_x <- train_whole_knn %>% select(-Channel) 

# target data train
train_y <- train_whole_knn %>% select(Channel) 

# prediktor data test
test_x <- test_whole_knn %>% select(-Channel)

# target data test
test_y <- test_whole_knn %>% select(Channel)

2. Memilih K Optimum

K optimum adalah akar dari jumlah data kita: sqrt(nrow(data))
K harus ganjil bila jumlah kelas target genap, dan k harus genap bila jumlah kelas target ganjil. Hal ini untuk menghindari seri ketika majority voting.

sqrt(nrow(train_x))

#> [1] 18.76166

Dibulatkan dan jumlah kelas 2 (genap) –> K = 19

3. Memprediksi Model Berdasarkan Data Latih

y_prediksi <- knn(train = train_x, #prediktor data train
    test = test_x, # prediktor data test
    cl = train_y$Channel, #target data train
    k = 19) # jumlah k yang digunakan untuk klasifikasi

Membandingkan bagaimana hasil prediksi dan nilai sebenarnya.

data.frame(prediksi = y_prediksi,
           aktual = test_y$Channel)

4. Evaluasi KNN

confusionMatrix(data=y_prediksi, reference=test_y$Channel, positive="1")

#> Confusion Matrix and Statistics
#> 
#>           Reference
#> Prediction  1  2
#>          1 56  2
#>          2  3 27
#>                                           
#>                Accuracy : 0.9432          
#>                  95% CI : (0.8724, 0.9813)
#>     No Information Rate : 0.6705          
#>     P-Value [Acc > NIR] : 0.0000000006694 
#>                                           
#>                   Kappa : 0.8725          
#>                                           
#>  Mcnemar's Test P-Value : 1               
#>                                           
#>             Sensitivity : 0.9492          
#>             Specificity : 0.9310          
#>          Pos Pred Value : 0.9655          
#>          Neg Pred Value : 0.9000          
#>              Prevalence : 0.6705          
#>          Detection Rate : 0.6364          
#>    Detection Prevalence : 0.6591          
#>       Balanced Accuracy : 0.9401          
#>                                           
#>        'Positive' Class : 1               
#>

Pada umumnya kita mengevaluasi model menggunakan 5 ukuran:

Re-call/Sensitivity = dari semua data aktual yang Channel 1, seberapa mampu proporsi model memprediksi benar.
Specificity = dari semua data aktual yang Channel 2, seberapa mampu proporsi model memprediksi yang benar.
Accuracy = seberapa mampu model memprediksi dengan benar target kelas.
Precision = dari semua hasil prediksi, seberapa mampu model saya dapat memprediksi benar kelas Channel 1.
Negative Predict Value (Neg Pred Value) : dari semua hasil prediksi, seberapa mampu model saya dapat memprediksi benar kelas Channel 2.

Sebaiknya pada kasus ini, kita memperhatikan metrik Sensitivity dan Specificity bukan Accuracy karena terdapat ketidakseimbangan kelas.

Sensitivity : 0.9492
Specificity : 0.9310
Accuracy : 0.9432
Pos Pred Value (Precision) : 0.9655
Neg Pred Value : 0.9000

Secara keseluruhan hasil KNN kita sudah lebih baik karena memiliki nilai metrik sama dengan bahkan lebih dari 90% semua.

Perbandingan Performa Logistic Regression dengan KNN

data.frame(
  Metrics = c("Sensitivity", "Specificity", "Accuracy", "Pos Pred Value", "Neg Pred Value"),
  Logistic_Regression = c(0.9661, 0.8276, 0.9205, 0.9194, 0.9231),
  K_Nearest_Neighboor_KNN = c(0.9492, 0.9310, 0.9432, 0.9655, 0.9000  )
)

Secara performa saya merasa dengan menggunakan K-Nearest Neighboor (KNN) lebih baik dibandingkan Logistic Regression. Hal ini disebabkan nilai Sensitivity dan Specificity nya relatif sangat tinggi. Artinya KNN relatif dapat mengklasifikasikan Channel 1 dan Channel 2 dengan sangat baik karena performa dalam membedakan kedua kelas di atas 93%.

Kesimpulan

Kita telah melalui berbagai proses dalam pembuatan Machine Learning yang dapat membedakan kelas konsumen (Horeca (Hotel/Restoran/Cafe) atau Retail). Pada proses tersebut, kita telah mencoba dua algoritma dalam membangun Machine Learning yaitu Logistic Regression dan K-Nearest Neighboor (KNN). Selain itu, kita telah mengevaluasi Machine Learning dan menghasilkan kesimpulan bahwa dengan algoritma K-Nearest Neighboor (KNN) memiliki performa relatif lebih baik dibandingkan Logistic Regression. Harapannya melalui projek ini dapat menjadi referensi dalam membangun Machine Learning untuk melakukan klasifikasi sehingga dapat menjadi dasar dalam mengambil keputusan secara efektif dan efisien. Sekian terima kasih banyak yang telah melihat projek ini. Saya juga menyukai masukan dan kolaborasi sehingga apabila ada masukan, saran, kritik atau untuk berkolaborasi dapat menghubungi lewat Linkedin.