OBJECTIVE

Pada kesempatan kali ini, kita akan mencoba melakukan prediksi target variabel Channel yang terdapat dalam dataset wholesale.csv. Kita ingin mengetahui bagaimana pengaruhnya, dan variabel-variabel apa saja yang mempengaruhi target variabel, serta membandingkan model manakah yang lebih baik digunakan untuk memprediksi. Adapun Algoritma yang akan saya gunakan yaitu menggunakan Logistics Regression dan K-Nearest Neighbor yang termasuk dalam supervised learning.

LIBRARY & SETUP

library(tidyverse)
library(gtools)
library(caret)
library(data.table)


theme_set(theme_minimal() +
            theme(legend.position = "top"))

options(scipen = 999)

DATA IMPORT

Dataset yang digunakan untuk analisis kali ini menggunakan data wholesale.csv.

wholesale <- read.csv("data_input/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 ...

Berikut ini gambaran sedikit pada data yang digunakan.

head(wholesale)

DATA MANIPULATION

Karena kita ingin membuat model Logistics Regression dan K-NN, maka tipe data pada kolom Channel kita ubah menjadi factor.

wholesale <- wholesale %>% 
  mutate(Channel = ifelse(Channel == 1, "Yes", "No")) %>% 
  mutate(Channel = factor(Channel),
         Region = factor(Region))
str(wholesale)
## 'data.frame':    440 obs. of  8 variables:
##  $ Channel         : Factor w/ 2 levels "No","Yes": 1 1 1 2 1 1 1 1 2 1 ...
##  $ Region          : Factor w/ 3 levels "1","2","3": 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 ...
head(wholesale)

Selanjutnya yaitu melakukan pengecekan terhadap missing value. Missing value perlu kita cek terlebih dahulu agar tidak mengganggu dalam melakukan pemodelan nantinya.

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

LOGISTICS REGRESSION

Pre-Processing Data

Sebelum melakukan pemodelan, kita perlu melihat terlebih dahulu proporsi dari target variabel yang kita miliki pada kolom Channel.

prop.table(table(wholesale$Channel))
## 
##        No       Yes 
## 0.3227273 0.6772727
table(wholesale$Channel)
## 
##  No Yes 
## 142 298

Splitting Train-Test

Langkah selanjutnya yaitu melakukan splitting train test data. Tujuannya yaitu pada data train akan kita gunakan untuk modeling, sedangkan data test akan kita gunakan sebagai penguji model yang sudah kita buat jika dihadapkan dengan unseen data. Selain itu hal ini dapat digunakan untuk melihat kemampuan model yang kita buat dalam menghadapi unseen data.

RNGkind(sample.kind = "Rounding")
## Warning in RNGkind(sample.kind = "Rounding"): non-uniform 'Rounding' sampler
## used
set.seed(123)
row_data <- nrow(wholesale)
index <- sample(row_data, row_data*0.8)

data_train <- wholesale[index, ]
data_test <- wholesale[-index, ]

Modelling

Melakukan pemodelan menggunakan Logistics Regression. Pemodelan menggunakan fungsi glm() dalam pembuatan model. Variabel yang digunakan adalah beberapa variabel yang kita anggap mempengaruhi target variabel, dimana variabel Channel menjadi variabel responnya. Ingat data yang digunakan adalah data_train.

# Model Regresi Logistik
logistics_wholesale <- glm(Channel ~ ., data_train, family = "binomial") 
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
summary(logistics_wholesale)
## 
## Call:
## glm(formula = Channel ~ ., family = "binomial", data = data_train)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -3.07494  -0.02701   0.18364   0.28313   2.88413  
## 
## Coefficients:
##                     Estimate  Std. Error z value      Pr(>|z|)    
## (Intercept)       4.49500858  0.77219973   5.821 0.00000000585 ***
## Region2          -1.94660904  0.93436562  -2.083        0.0372 *  
## Region3          -0.88752027  0.66240115  -1.340        0.1803    
## Fresh             0.00000260  0.00002006   0.130        0.8969    
## Milk             -0.00009831  0.00006606  -1.488        0.1367    
## Grocery          -0.00010086  0.00007043  -1.432        0.1522    
## Frozen            0.00020044  0.00011301   1.774        0.0761 .  
## Detergents_Paper -0.00086326  0.00016251  -5.312 0.00000010834 ***
## Delicassen        0.00013314  0.00013655   0.975        0.3295    
## ---
## 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: 148.52  on 343  degrees of freedom
## AIC: 166.52
## 
## Number of Fisher Scoring iterations: 7

Model Fitting

Pada pemodelan yang pertama, masih banyak variabel prediktor yang tidak signifikan terhadap target variabel, oleh karena itu kita akan coba melakukan model fitting menggunakan metode stepwise.

# menggunakan stepwise mencari AIC terendah
logistics_wholesale2 <- step(logistics_wholesale, direction = "both", trace = 0)
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
summary(logistics_wholesale2)
## 
## Call:
## glm(formula = Channel ~ Region + Milk + Frozen + Detergents_Paper, 
##     family = "binomial", data = data_train)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -3.1271  -0.0209   0.1800   0.2946   2.9785  
## 
## Coefficients:
##                     Estimate  Std. Error z value           Pr(>|z|)    
## (Intercept)       4.39061635  0.76612983   5.731 0.0000000099896894 ***
## Region2          -2.09903788  0.93069494  -2.255             0.0241 *  
## Region3          -0.93212074  0.64667767  -1.441             0.1495    
## Milk             -0.00013603  0.00005547  -2.452             0.0142 *  
## Frozen            0.00026344  0.00010367   2.541             0.0110 *  
## Detergents_Paper -0.00099003  0.00013093  -7.562 0.0000000000000398 ***
## ---
## 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: 151.22  on 346  degrees of freedom
## AIC: 163.22
## 
## Number of Fisher Scoring iterations: 7

Prediksi

Dengan menggunakan logistics_wholesale2 hasil dari stepwise, kita akan coba prediksi menggunakan data_test yang sudah kita miliki.

# Hasil berupa peluang
pred_test <- predict(logistics_wholesale2, data_test, type = "response")
head(pred_test)
##          3          5          6          7         14         17 
## 0.35732078 0.88023647 0.67554726 0.51027358 0.03876338 0.10261651
head(data_test)

Dari peluang yang dihasilkan kita bisa mendapatkan label atau kategori dari setiap prediksi. Umumnya kita menggunakan threshold jika peluang > 0.5 maka dianggap yes dan jika dibawah 0.5 maka dianggap no. Jangan lupa sesuaikan tipe data dari hasil prediksi dengan tipe data dari target variabel di data test (factor).

# Ubah peluang menjadi kategori
pred_class <- ifelse(pred_test > 0.5, "Yes", "No") %>% 
  as.factor()

head(pred_class)
##   3   5   6   7  14  17 
##  No Yes Yes Yes  No  No 
## Levels: No Yes

Model Performance

Untuk mengevaluasi sebuah model klasifikasi, kita bisa menggunakan sebuah matrix yang disebut dengan Confusion Matrix.

table("Prediction" = pred_class, "Reference" = data_test$Channel)
##           Reference
## Prediction No Yes
##        No  23   3
##        Yes  8  54
# confusionMatrix(hasil prediksi, data aktual)
confusionMatrix(pred_class, data_test$Channel, positive = "Yes")
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction No Yes
##        No  23   3
##        Yes  8  54
##                                           
##                Accuracy : 0.875           
##                  95% CI : (0.7873, 0.9359)
##     No Information Rate : 0.6477          
##     P-Value [Acc > NIR] : 0.000001329     
##                                           
##                   Kappa : 0.7156          
##                                           
##  Mcnemar's Test P-Value : 0.2278          
##                                           
##             Sensitivity : 0.9474          
##             Specificity : 0.7419          
##          Pos Pred Value : 0.8710          
##          Neg Pred Value : 0.8846          
##              Prevalence : 0.6477          
##          Detection Rate : 0.6136          
##    Detection Prevalence : 0.7045          
##       Balanced Accuracy : 0.8447          
##                                           
##        'Positive' Class : Yes             
##

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.

Recall <- round((54)/(3+54),2)
Specificity <- round((23)/(23+8),2)
Accuracy <- round((54+23)/(23+3+8+54),2)
Precision <- round((54)/(54+8),2)

performance_logistics <- cbind.data.frame(Accuracy, Recall, Precision, Specificity)
performance_logistics

K-NEAREST NEIGHBOUR

Data Pre-Processing

str(wholesale)
## 'data.frame':    440 obs. of  8 variables:
##  $ Channel         : Factor w/ 2 levels "No","Yes": 1 1 1 2 1 1 1 1 2 1 ...
##  $ Region          : Factor w/ 3 levels "1","2","3": 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 ...

Kita buang variabel yang tidak dibutuhkan, yakni variabel Region dan ubah variabel Channel menjadi factor.

df_wholesale <- wholesale %>% 
  select(-Region) %>% 
  mutate(Channel = as.factor(Channel))

Cross-Validation

Kita bagi data menjadi data train dan data test dengan data train sebanyak 80% dari total data.

RNGkind(sample.kind = "Rounding")
## Warning in RNGkind(sample.kind = "Rounding"): non-uniform 'Rounding' sampler
## used
set.seed(123)
row_data <- nrow(df_wholesale)
index <- sample(row_data, row_data*0.8)

data_train <- df_wholesale[index, ]
data_test <- df_wholesale[-index, ]

Scaling Data

Ingat bahwa pengukuran jarak pada K-Nearest Neighbour sangat bergantung pada skala pengukuran pada fitur input. Apabila terdapat variabel yang memiliki range nilai yang berbeda jauh dapat menyebabkan masalah pada model klasifikasi kita, oleh karena itu mari lakukan normalisasi untuk membuat skala ulang pada setiap fitur agar memiliki range nilai yang standar.

Untuk melakukan normalisasi fitur pada data_train, kita gunakan fungsi scale(). Sementara itu pada data_test, lakukan normalisasi setiap fitur dengan menggunakan atribut center dan scale pada data train_x.

# scale train_x data
train_x <- data_train %>%
  select(-c(Channel)) %>% # buang target variabel
  scale() #lakukan scaling kesemua predictor

# Menyimpan target variabel
train_y <- data_train$Channel
# scale test_x data
test_x <- data_test %>% 
  select(-c(Channel)) %>% 
  scale(center = attr(train_x, "scaled:center"), # rata-rata
        scale = attr(train_x, "scaled:scale") # standar deviasi
        ) # lakukan scaling  dengan informasi dari data train

# Menyimpan target variabel
test_y <- data_test$Channel

Model Fitting and Evaluation

Menentukan nilai K menggunakan akar kuadrat dari data train

k_choose <- sqrt(nrow(train_x)) %>% 
  round()
k_choose
## [1] 19

Dengan K-NN, kita punya pilihan apakah ingin menyimpan informasi jarak antar data pada model K-NN atau langsung memberikan prediksi. Untuk kali ini ita menggunakan cara yang kedua yaitu langsung memberikan prediksi.

pred_knn <- knn3Train(train = train_x, # variabel prediktor data train
                      cl = train_y, # variabel target data train (diagnosis)
                      test = test_x, # prediktor data test yang ingin diprediksi
                      k = k_choose # jumlah k yang dipake
                      ) %>% 
  as.factor()

head(pred_knn)
## [1] Yes Yes Yes Yes No  No 
## Levels: No Yes

Model Performance

Untuk mengukur performa model dengan menggunakan Confusion Matrix.

confusionMatrix(pred_knn, test_y)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction No Yes
##        No  22   3
##        Yes  9  54
##                                           
##                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.7097          
##             Specificity : 0.9474          
##          Pos Pred Value : 0.8800          
##          Neg Pred Value : 0.8571          
##              Prevalence : 0.3523          
##          Detection Rate : 0.2500          
##    Detection Prevalence : 0.2841          
##       Balanced Accuracy : 0.8285          
##                                           
##        'Positive' Class : No              
## 
Recall <- round(0.7097,2)
Specificity <- round(0.9474,2)
Accuracy <- round(0.8636,2)
Precision <- round(0.8800,2)

performance_knn <- cbind.data.frame(Accuracy, Recall, Precision, Specificity)
performance_knn

LOGISTICS REGRESSION VS K-NEAREST NEIGHBOUR

performance_logistics
performance_knn

KESIMPULAN

Kesimpulan yang dapat diperoleh dari model di atas adalah bahwa kedua model memiliki performa yang kurang lebih sama. Karena jika kita lihat berdasarkan nilai performa dari Accuracy dan Recall maka yang terbaik adalah Regresi Logistik, sedangkan jika kita lihat berdasarkan nilai Precision dan Specificity maka model K-NN yang paling baik.