1 Penjelasan

Data wholesale adalah data pembelian produk di Portugal oleh horeca atau retail. Kolom yang dimiliki oleh data ini adalah sebagai berikut:

  • Channel: Customer channel (Horeca = 1, or Retail = 2)
  • Region: 1 = Lisbon, 2 = Porto, 3 = other
  • Fresh: Annual spending on fresh products
  • Milk: Annual spending on milk products
  • Grocery: Annual spending on grocery products
  • Frozen: Annual spending on frozen products
  • Detergents_Paper: Annual spending on detergents and paper products
  • Delicassen: = Annual spending on delicatessen products

Pada proses kali ini, kita akan menggunakan kolom Channel sebagai target variable.

2 Explorasi Data

2.1 Persiapan Data

# Install Package
library(dplyr)
library(gtools)
library(ggplot2)
library(caret)
library(class)
library(MASS)
# membuka data sekaligus melihat struktur data
wholesale <- read.csv("wholesale.csv")
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 ...

2.2 Mengubah Tipe Data

Kolom Channel dan kolom Region dapat diubah menjadi factor

wholesale <- wholesale %>% 
  mutate(Channel = as.factor(Channel),
         Region = as.factor(Region))
         
glimpse(wholesale)
#> 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…

2.3 Mengecek apakah terdapat missing value

colSums(is.na(wholesale))
#>          Channel           Region            Fresh             Milk 
#>                0                0                0                0 
#>          Grocery           Frozen Detergents_Paper       Delicassen 
#>                0                0                0                0

Sebelum membagi data ke data_train dan data_test, kita harus mengecek proporsi data variabel target

prop.table(table(wholesale$Channel))
#> 
#>         1         2 
#> 0.6772727 0.3227273

Jika dilihat dari proporsi kedua kelas, data sudah cukup seimbang sehingga kita tidak membutuhkan pre-processing data tambahan

2.4 Splitting Data Train dan Data Test

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

index <- sample(nrow(wholesale), nrow(wholesale)*0.7)

wholesale_train <- wholesale[index,]
wholesale_test <- wholesale[-index,]

3 Modelling

model1 <- glm(formula = Channel~., family = "binomial", data = wholesale_train)

summary(model1)
#> 
#> Call:
#> glm(formula = Channel ~ ., family = "binomial", data = wholesale_train)
#> 
#> Deviance Residuals: 
#>      Min        1Q    Median        3Q       Max  
#> -2.64899  -0.33263  -0.23379   0.04368   3.04111  
#> 
#> Coefficients:
#>                      Estimate   Std. Error z value     Pr(>|z|)    
#> (Intercept)      -4.598107180  0.822437450  -5.591 0.0000000226 ***
#> Region2           1.398910622  1.000689342   1.398       0.1621    
#> Region3           1.167979567  0.726054496   1.609       0.1077    
#> Fresh             0.000003259  0.000018617   0.175       0.8610    
#> Milk              0.000051594  0.000065395   0.789       0.4301    
#> Grocery           0.000120031  0.000063656   1.886       0.0593 .  
#> Frozen           -0.000156483  0.000113681  -1.377       0.1687    
#> Detergents_Paper  0.000755933  0.000146962   5.144 0.0000002693 ***
#> Delicassen       -0.000082977  0.000120881  -0.686       0.4924    
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 380.59  on 307  degrees of freedom
#> Residual deviance: 144.23  on 299  degrees of freedom
#> AIC: 162.23
#> 
#> Number of Fisher Scoring iterations: 7

Hanya terdapat 1 prediktor yang berkorelasi signifikan dengan variabel target yaitu variabel Detergents_Paper, kita akan coba melakukan model fitting menggunakan metode stepwise.

model2 <- stepAIC(model1, direction = "backward")
#> Start:  AIC=162.23
#> Channel ~ Region + Fresh + Milk + Grocery + Frozen + Detergents_Paper + 
#>     Delicassen
#> 
#>                    Df Deviance    AIC
#> - Fresh             1   144.26 160.26
#> - Delicassen        1   144.70 160.70
#> - Milk              1   144.83 160.83
#> - Region            2   147.47 161.47
#> <none>                  144.22 162.22
#> - Frozen            1   146.59 162.59
#> - Grocery           1   148.09 164.09
#> - Detergents_Paper  1   174.86 190.86
#> 
#> Step:  AIC=160.26
#> Channel ~ Region + Milk + Grocery + Frozen + Detergents_Paper + 
#>     Delicassen
#> 
#>                    Df Deviance    AIC
#> - Delicassen        1   144.71 158.71
#> - Milk              1   144.94 158.94
#> - Region            2   147.57 159.57
#> <none>                  144.26 160.26
#> - Frozen            1   146.83 160.83
#> - Grocery           1   148.11 162.11
#> - Detergents_Paper  1   175.63 189.63
#> 
#> Step:  AIC=158.71
#> Channel ~ Region + Milk + Grocery + Frozen + Detergents_Paper
#> 
#>                    Df Deviance    AIC
#> - Milk              1   145.32 157.32
#> - Region            2   147.92 157.92
#> <none>                  144.71 158.71
#> - Grocery           1   148.16 160.16
#> - Frozen            1   148.29 160.29
#> - Detergents_Paper  1   176.97 188.97
#> 
#> Step:  AIC=157.32
#> Channel ~ Region + Grocery + Frozen + Detergents_Paper
#> 
#>                    Df Deviance    AIC
#> - Region            2   148.44 156.44
#> <none>                  145.32 157.32
#> - Frozen            1   148.34 158.34
#> - Grocery           1   151.79 161.79
#> - Detergents_Paper  1   178.56 188.56
#> 
#> Step:  AIC=156.44
#> Channel ~ Grocery + Frozen + Detergents_Paper
#> 
#>                    Df Deviance    AIC
#> <none>                  148.44 156.44
#> - Frozen            1   151.86 157.86
#> - Grocery           1   155.59 161.59
#> - Detergents_Paper  1   182.83 188.83

Dengan menggunakan metode backward pada stepwise, kita memperoleh model sebagai berikut.

summary(model2)
#> 
#> Call:
#> glm(formula = Channel ~ Grocery + Frozen + Detergents_Paper, 
#>     family = "binomial", data = wholesale_train)
#> 
#> Deviance Residuals: 
#>      Min        1Q    Median        3Q       Max  
#> -2.63027  -0.32158  -0.24574   0.04771   3.04212  
#> 
#> Coefficients:
#>                     Estimate  Std. Error z value           Pr(>|z|)    
#> (Intercept)      -3.52819359  0.45956234  -7.677 0.0000000000000162 ***
#> Grocery           0.00013923  0.00005245   2.655            0.00794 ** 
#> Frozen           -0.00014883  0.00008398  -1.772            0.07635 .  
#> Detergents_Paper  0.00075059  0.00013658   5.496 0.0000000389275856 ***
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 380.59  on 307  degrees of freedom
#> Residual deviance: 148.44  on 304  degrees of freedom
#> AIC: 156.44
#> 
#> Number of Fisher Scoring iterations: 7

Degan menggunakan model2, kita sudah bisa memperkecil AIC dari 162.23 menjadi 156.44

4 Prediksi

Dengan menggunakan model2, kita akan prediksi menggunakan data test

wholesale_test$pred <- predict(model2, type = "response", newdata = wholesale_test)
# Melihat sebaran peluang prediksi data.
ggplot(wholesale_test, aes(x=pred)) +
  geom_density(lwd=1) +
  labs(title = "Distribusi Peluang Prediksi Data") +
  theme_minimal()

Pada grafik di atas, hasil prediksi lebih mengarah ke 1. Selanjutnya kita akan cek hasil prediksi dengan data aktual.

wholesale_test$pred <- factor(ifelse(wholesale_test$pred > 0.5, yes = 2, no = 1))
wholesale_test[1:10, c("pred", "Channel")]
#>    pred Channel
#> 1     1       2
#> 2     2       2
#> 7     1       2
#> 10    2       2
#> 18    1       1
#> 19    1       2
#> 21    1       2
#> 22    1       1
#> 23    1       1
#> 24    2       2

5 Model Evaluation

Melakukan evaluasi model dengan confusionMatrix

conf <- confusionMatrix(wholesale_test$pred, wholesale_test$Channel, positive = "1")
conf
#> Confusion Matrix and Statistics
#> 
#>           Reference
#> Prediction  1  2
#>          1 82 12
#>          2  3 35
#>                                          
#>                Accuracy : 0.8864         
#>                  95% CI : (0.8195, 0.935)
#>     No Information Rate : 0.6439         
#>     P-Value [Acc > NIR] : 0.0000000002248
#>                                          
#>                   Kappa : 0.7411         
#>                                          
#>  Mcnemar's Test P-Value : 0.03887        
#>                                          
#>             Sensitivity : 0.9647         
#>             Specificity : 0.7447         
#>          Pos Pred Value : 0.8723         
#>          Neg Pred Value : 0.9211         
#>              Prevalence : 0.6439         
#>          Detection Rate : 0.6212         
#>    Detection Prevalence : 0.7121         
#>       Balanced Accuracy : 0.8547         
#>                                          
#>        'Positive' Class : 1              
#>

6 Conclusion

  • Re-call/Sensitivity = dari semua data aktual yang positif, seberapa mampu proporsi model saya menebak benar.
  • Specificity = dari semua data aktual yang negatif, seberapa mampu proporsi model saya menebak yang benar.
  • Accuracy = seberapa mampu model saya menebak dengan benar target Y.
  • Precision = dari semua hasil prediksi, seberapa mampu model saya dapat menebak benar kelas positif.

Berdasarkan hasil confusionMatrix diatas, dapat kita ambil informasi bahwa kemampuan model dalam menebak target Y (horeca atau retail) sebesar 88,6%. Sedangkan dari keluruhan data aktual channel retail, model mampu menebak benar sebesar 74.47%. Dari keseluruhan data aktual horeca, model mampu menebak dengan benar sebesar 96.47%. Dari keseluruhan hasil prediksi yang mampu ditebak oleh model, model mampu menebak benar kelas positif sebesar 87,23%.