Email             :
Instagram     : https://www.instagram.com/dsciencelabs
RPubs            : https://rpubs.com/dsciencelabs/
Github           : https://github.com/dsciencelabs/
Telegram       : @dsciencelabs
Department  : Business Statistics
Address         : ARA Center, Matana University Tower
                         Jl. CBD Barat Kav, RT.1, Curug Sangereng, Kelapa Dua, Tangerang, Banten 15810.



1 Latar Belakang

Anggur adalah minuman beralkohol yang dibuat dari anggur yang difermentasi dan terkenal dengan efek memabukkan dan kelezatannya. Varietas anggur yang berbeda dan galur ragi menghasilkan jenis anggur yang berbeda. Proses biokimia yang terjadi selama fermentasi menghasilkan alkohol dan zat yang memperkaya rasa anggur dan menentukan kualitas anggur.

Dalam produksi skala industri, penting bagi produsen wine untuk dapat mengklasifikasikan dengan tepat dan cepat apakah wine mereka dianggap berkualitas tinggi atau tidak. Proses ini bertujuan untuk mempermudah kategorisasi produk dan kendali mutu. Pendekatan organoleptik tradisional dinilai tidak praktis dalam skala masif. Oleh karena itu, gagasan untuk memprediksi kualitas anggur berdasarkan sifat kimianya dianggap sebagai gagasan yang layak dipertimbangkan. Dengan menggunakan alat saat ini untuk deteksi bahan kimia dan pembelajaran mesin, model prediksi dapat dibuat dan membantu produsen wine mengklasifikasikan wine dengan lebih efisien dan meningkatkan produktivitas mereka.

Melalui artikel ini, saya akan menganalisis ulang data wine kami dan membangun model prediksi lain menggunakan beberapa algoritma klasifikasi, dengan harapan ada hal (temuan baru) untuk perbaikan berkelanjutan. Algoritma yang akan digunakan adalah Regresi Logistik, k-NN, Naive Bayes, Decision Tree, dan Random Forest. Saya juga akan membahas konsep utama dan hal-hal penting terkait dengan masing-masing model tersebut.

Dataset yang akan digunakan diperoleh dari UCI Machine Learning Repository yang berisi karakteristik fisikokimia dari varian warna merah putih wine Portugis “Vinho Verde”.

2 Persiapan Data

2.1 Packages

library(tidyverse)  # manipulasi dan visualisasi data
library(plyr)       # untuk membagi struktur data besar menjadi bagian-bagian yang homogen
library(dplyr)      # secara otomatis mengubah kode dplyr menjadi SQL
library(DT)         # tampilan data dalam tabel
library(inspectdf)  # eksplorasi analisa data
library(stats)      # ringkasan statistik
library(rstatix)    # menyediakan analisis statistik
library(inspectdf)  # memeriksa proporsi variabel kategori
library(GGally)     # memeriksa korelasi antar variabel
library(ggplot2)    # memvisualisasikan data
library(gridExtra)  # menampilkan beberapa grafik secara bersamaan
library(ggpubr)     # membuat plot siap publikasi dengan mudah
library(class)      # paket untuk penggunaan algoritma KNN
library(car)        # memeriksa multikolinearitas
library(tidymodels) # membangun model yang rapi
library(caret)      # melakukan validasi silang
library(recipes)    # melakukan preprocessing variabel dan matriks desain untuk pemodelan

2.2 Import Data

Dataset wine diperoleh dari UCI Machine Learning Repository atau Kaggle, yang berisi karakteristik fisikokimia dari varian warna merah dan putih dari bahasa Portugis “Vinho Verde”.

wine <- read.csv("data_input/winequality.csv", sep = ",")
glimpse(wine)                                 
## Rows: 6,497
## Columns: 13
## $ type                 <chr> "white", "white", "white", "white", "white", "...
## $ fixed.acidity        <dbl> 7.0, 6.3, 8.1, 7.2, 7.2, 8.1, 6.2, 7.0, 6.3, 8...
## $ volatile.acidity     <dbl> 0.27, 0.30, 0.28, 0.23, 0.23, 0.28, 0.32, 0.27...
## $ citric.acid          <dbl> 0.36, 0.34, 0.40, 0.32, 0.32, 0.40, 0.16, 0.36...
## $ residual.sugar       <dbl> 20.70, 1.60, 6.90, 8.50, 8.50, 6.90, 7.00, 20....
## $ chlorides            <dbl> 0.045, 0.049, 0.050, 0.058, 0.058, 0.050, 0.04...
## $ free.sulfur.dioxide  <dbl> 45, 14, 30, 47, 47, 30, 30, 45, 14, 28, 11, 17...
## $ total.sulfur.dioxide <dbl> 170, 132, 97, 186, 186, 97, 136, 170, 132, 129...
## $ density              <dbl> 1.0010, 0.9940, 0.9951, 0.9956, 0.9956, 0.9951...
## $ pH                   <dbl> 3.00, 3.30, 3.26, 3.19, 3.19, 3.26, 3.18, 3.00...
## $ sulphates            <dbl> 0.45, 0.49, 0.44, 0.40, 0.40, 0.44, 0.47, 0.45...
## $ alcohol              <dbl> 8.8, 9.5, 10.1, 9.9, 9.9, 10.1, 9.6, 8.8, 9.5,...
## $ quality              <int> 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 5, 5, 5, 7, 5, 7...
wine$type <- as.factor(wine$type)        # tetapkan wine$type sebagai faktor

Deskripsi kolom:

  • type: varian anggur (merah / putih)
  • fixed acidity: sebagian besar asam terlibat dengan anggur
  • volatile acidity: jumlah asam asetat dalam anggur
  • citric acid: ditemukan dalam jumlah kecil
  • residual sugar: jumlah gula yang tersisa setelah fermentasi / produksi anggur
  • chlorides: jumlah garam dalam anggur
  • free sulfur dioxide: bentuk bebas S02, mencegah pertumbuhan mikroba dan oksidasi anggur
  • total sulfur dioxide: jumlah S02 yang bebas dan terikat
  • density: Kepadatan air tergantung pada persen alkohol dan kadar gula
  • pH: menjelaskan seberapa asam atau basa anggur pada skala 0-14 (sangat asam: 0, sangat basa: 14); kebanyakan anggur berada di antara 3-4 pada skala pH
  • sulphates: antimikroba dan antioksidan
  • alcohol: persentase kandungan alkohol dalam anggur
  • quality: variabel target (berdasarkan data sensorik, skor antara 0 dan 10)

2.3 Identifikasi Data

Dalam projek ini saya ingin membuat model untuk memprediksi kualitas anggur putih saja. Dimana kualitas dengan skor 1-6 diangagap Poor-Normal = Biasa sedangkan skor kualitas 7-10 dianggap Excellent = Luar Biasa. Oleh karena itu, terlebih dahulu dilakukan filter data anggur putih dan menghapus variabel type untuk analisis data yang lebih bersih.

white <- wine %>% 
  filter(type == "white") %>%
  select(-type)
head(white)
##   fixed.acidity volatile.acidity citric.acid residual.sugar chlorides
## 1           7.0             0.27        0.36           20.7     0.045
## 2           6.3             0.30        0.34            1.6     0.049
## 3           8.1             0.28        0.40            6.9     0.050
## 4           7.2             0.23        0.32            8.5     0.058
## 5           7.2             0.23        0.32            8.5     0.058
## 6           8.1             0.28        0.40            6.9     0.050
##   free.sulfur.dioxide total.sulfur.dioxide density   pH sulphates alcohol
## 1                  45                  170  1.0010 3.00      0.45     8.8
## 2                  14                  132  0.9940 3.30      0.49     9.5
## 3                  30                   97  0.9951 3.26      0.44    10.1
## 4                  47                  186  0.9956 3.19      0.40     9.9
## 5                  47                  186  0.9956 3.19      0.40     9.9
## 6                  30                   97  0.9951 3.26      0.44    10.1
##   quality
## 1       6
## 2       6
## 3       6
## 4       6
## 5       6
## 6       6

Berikutnya dilakukan pemeriksaan data yang hilang (missing values):

# summary(white)                         # dapat juga dilakukan dengen melihat ringkasan statistik
anyNA(white)                             # memeriksa ada atau tidak missing values
## [1] TRUE
data.frame(cbind(missing = colSums(is.na(white)), 
      prop = round(prop.table(colSums(is.na(white))),2)))
##                      missing prop
## fixed.acidity              8 0.27
## volatile.acidity           7 0.23
## citric.acid                2 0.07
## residual.sugar             2 0.07
## chlorides                  2 0.07
## free.sulfur.dioxide        0 0.00
## total.sulfur.dioxide       0 0.00
## density                    0 0.00
## pH                         7 0.23
## sulphates                  2 0.07
## alcohol                    0 0.00
## quality                    0 0.00

Data yang hilang ini harus dihapuskan atau perlu untuk dilakukan verifikasi pengunpulan data yang hilang tersebut. Untuk mengendalikan data yang hilang ini dapat dilakukan pengisian dengan nilai rata-rata pada masing masing variabel (dalam kasus ini akan digunakan median karena data tidak terdistribusi secara normal). Oleh karena itu, berikutnya dilakukan pemeriksaan distribusi data variabel numerik.

white %>%               # filter data numerik saja
inspect_num() %>%
show_plot()

Dari hasil pengamatan, terlihat bahwa beberapa variabel tidak berdistrubusi normal. Sehingga dilakukan penginputan nilai median pada setiap data yang hilang (missing values).

prevalues <- preProcess(white, method=c("medianImpute"))
white <- predict(prevalues, white)
summary(white)
##  fixed.acidity    volatile.acidity  citric.acid     residual.sugar  
##  Min.   : 3.800   Min.   :0.0800   Min.   :0.0000   Min.   : 0.600  
##  1st Qu.: 6.300   1st Qu.:0.2100   1st Qu.:0.2700   1st Qu.: 1.700  
##  Median : 6.800   Median :0.2600   Median :0.3200   Median : 5.200  
##  Mean   : 6.855   Mean   :0.2782   Mean   :0.3342   Mean   : 6.393  
##  3rd Qu.: 7.300   3rd Qu.:0.3200   3rd Qu.:0.3900   3rd Qu.: 9.900  
##  Max.   :14.200   Max.   :1.1000   Max.   :1.6600   Max.   :65.800  
##    chlorides       free.sulfur.dioxide total.sulfur.dioxide    density      
##  Min.   :0.00900   Min.   :  2.00      Min.   :  9.0        Min.   :0.9871  
##  1st Qu.:0.03600   1st Qu.: 23.00      1st Qu.:108.0        1st Qu.:0.9917  
##  Median :0.04300   Median : 34.00      Median :134.0        Median :0.9937  
##  Mean   :0.04578   Mean   : 35.31      Mean   :138.4        Mean   :0.9940  
##  3rd Qu.:0.05000   3rd Qu.: 46.00      3rd Qu.:167.0        3rd Qu.:0.9961  
##  Max.   :0.34600   Max.   :289.00      Max.   :440.0        Max.   :1.0390  
##        pH          sulphates         alcohol         quality     
##  Min.   :2.720   Min.   :0.2200   Min.   : 8.00   Min.   :3.000  
##  1st Qu.:3.090   1st Qu.:0.4100   1st Qu.: 9.50   1st Qu.:5.000  
##  Median :3.180   Median :0.4700   Median :10.40   Median :6.000  
##  Mean   :3.188   Mean   :0.4898   Mean   :10.51   Mean   :5.878  
##  3rd Qu.:3.280   3rd Qu.:0.5500   3rd Qu.:11.40   3rd Qu.:6.000  
##  Max.   :3.820   Max.   :1.0800   Max.   :14.20   Max.   :9.000

Untuk memastikan apakah missing value tersebut sudah digantikan dengan nilai mediannya, silahkan lakukan pemerikasaan ulang ke proses pemeriksaan missing values diatas.

3 Analisis Eksplorasi Data

Pertama-tama mari kita lakukan observasi pada proporsi variabel target \((Y)\) sebagai berikut:

white$quality <- as.factor(ifelse(white$quality>6, 1, 0))
white %>%
inspect_cat() %>%
show_plot()

Berdasarkan plot, ada proporsi yang tidak seimbang antara level dalam variabel target. Untuk menghindari hilangnya varians, akan digunakan upsampling (daripada downsampling) untuk menyeimbangkan proporsi.

set.seed(47)
white.d <- white
white.d <- downSample(x = white.d[,-12], y = white.d$quality, list = F, yname = "quality")
inspect_cat(white.d) %>%
show_plot()

Berikutnya, dilakukan obeservasi pada variabel prediktornya \((X_1, X_2, \cdots, X_n).\)

GGally::ggcorr(white.d[,-12], hjust = 1, layout.exp = 2, label = T, label_size = 2.9)

Berdasarkan plot di atas, terdapat beberapa variabel prediktor yang memiliki korelasi tinggi satu sama lain. Variabel-variabel tersebut adalah bebas free.sulfur.dioxide, total.sulfur.dioxide, density, alcohol, dan residual sugar. Ini memberi kita peringatan dini bahwa data ini mungkin saja tidak sesuai untuk beberapa model seperti Model Regresi Logistik dan Naive Bayes.

Saya juga memeriksa distribusi variabel numerik versus variabel kategorikal (dalam hal ini kualitas anggur). Jika ada variabel yang memiliki distribusi berbeda antara kualitas anggur yang berbeda, maka sangat mungkin untuk tidak menggunakannya dalam model. Ini karena variabel seperti itu dapat menghasilkan kondisi pemisahan yang sempurna. Sehingga dilakuakan pemeriksaan dengan menggunakan boxplot (“dilakukan juga normalisasi data untuk menyamakan skala”).

# fungsi normalisasi data
normalize <- function(x){
  return ( 
    (x - min(x))/(max(x) - min(x)) 
  )}

# menggunakan fungsi diatas untuk menormalisasikan data
white.n <- white.d
white.n[,-12] <- sapply(white.n[,-12], normalize)

# fungsi yang digunakan untuk menampilkan boxplot
cat_num <- function(data, x, y){
    ggplot(data, aes_string(x = y, y = x)) +
    geom_boxplot(aes_string(col = y), outlier.shape = 21, outlier.fill = NULL, show.legend = F) +
    theme_classic() + scale_color_brewer(palette = "Set1")}

# menerapkan fungsi box plot diatas
cat_num(white.n, "fixed.acidity", "quality")

cat_num(white.n, "volatile.acidity", "quality")

cat_num(white.n, "citric.acid", "quality")

cat_num(white.n, "residual.sugar", "quality")

cat_num(white.n, "chlorides", "quality")

cat_num(white.n, "free.sulfur.dioxide", "quality")

cat_num(white.n, "total.sulfur.dioxide", "quality")

cat_num(white.n, "density", "quality")

cat_num(white.n, "pH", "quality")

cat_num(white.n, "sulphates", "quality")

cat_num(white.n, "alcohol", "quality")

Dari boxplot alcohol, dan density memiliki distribusi data yang berbeda antara kualitas poor-normal dan excellent. Selain itu, variabel chlorides memiliki terlalu banyak pencilan yang dapat mempengaruhi kinerja model. Oleh karena itu, saya tidak menggunakan alcohol, density dan chlorides untuk pembuatan model regresi logistik.

4 Model Regresi Logistik

Selanjutnya, dilakukan pemisahan data train dan data testing.

# pemisahan data training dan data testing
set.seed(47)
train <- sample(nrow(white.n), nrow(white.n)*0.8) # making condition to sample 80% of wine.n data
wine.train <- white.n[train,]                     # consist of 80% of wine.n data
wine.test <- white.n[-train,]                     # consist of the remaining 20% data

wine.train.label <- white.n[train,12]             # taking `quality` label for train set
wine.test.label <- white.n[-train,12]             # taking `quality` label for test set

Saya membuat regresi logistik dengan pemilihan fitur otomatis menggunakan eliminasi mundur. Saya memilih model yang memiliki AIC terendah. AIC memperkirakan jumlah relatif informasi yang hilang oleh model tertentu. Semakin sedikit informasi yang hilang suatu model, semakin tinggi kualitas model tersebut.

log <- glm(formula = quality ~., wine.train, family = "binomial")
summary(log)
## 
## Call:
## glm(formula = quality ~ ., family = "binomial", data = wine.train)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.5320  -0.8968   0.3599   0.8936   2.4229  
## 
## Coefficients:
##                      Estimate Std. Error z value Pr(>|z|)    
## (Intercept)           0.03406    0.65893   0.052 0.958772    
## fixed.acidity         4.27311    1.28697   3.320 0.000899 ***
## volatile.acidity     -4.47060    0.60823  -7.350 1.98e-13 ***
## citric.acid          -2.08379    0.73635  -2.830 0.004656 ** 
## residual.sugar        6.39332    1.22403   5.223 1.76e-07 ***
## chlorides            -3.07843    1.44439  -2.131 0.033065 *  
## free.sulfur.dioxide   1.01968    0.70078   1.455 0.145652    
## total.sulfur.dioxide -0.27810    0.78619  -0.354 0.723539    
## density              -8.20873    2.01590  -4.072 4.66e-05 ***
## pH                    2.34877    0.60999   3.850 0.000118 ***
## sulphates             2.01447    0.45410   4.436 9.16e-06 ***
## alcohol               1.94694    0.98543   1.976 0.048187 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 2351.0  on 1695  degrees of freedom
## Residual deviance: 1869.3  on 1684  degrees of freedom
## AIC: 1893.3
## 
## Number of Fisher Scoring iterations: 5
step <- glm(formula = quality ~ fixed.acidity + volatile.acidity +citric.acid+ residual.sugar+chlorides+ density + pH+sulphates+alcohol , family = "binomial", data = wine.train)
summary(step)
## 
## Call:
## glm(formula = quality ~ fixed.acidity + volatile.acidity + citric.acid + 
##     residual.sugar + chlorides + density + pH + sulphates + alcohol, 
##     family = "binomial", data = wine.train)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.5410  -0.8998   0.3841   0.9013   2.4531  
## 
## Coefficients:
##                  Estimate Std. Error z value Pr(>|z|)    
## (Intercept)        0.2233     0.6471   0.345  0.73003    
## fixed.acidity      4.2962     1.2814   3.353  0.00080 ***
## volatile.acidity  -4.5497     0.5941  -7.658 1.89e-14 ***
## citric.acid       -2.0529     0.7354  -2.792  0.00525 ** 
## residual.sugar     6.6059     1.1996   5.507 3.65e-08 ***
## chlorides         -3.0219     1.4414  -2.097  0.03604 *  
## density           -8.4472     1.9540  -4.323 1.54e-05 ***
## pH                 2.4012     0.6082   3.948 7.87e-05 ***
## sulphates          2.0734     0.4516   4.591 4.40e-06 ***
## alcohol            1.8335     0.9771   1.876  0.06059 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 2351.0  on 1695  degrees of freedom
## Residual deviance: 1871.7  on 1686  degrees of freedom
## AIC: 1891.7
## 
## Number of Fisher Scoring iterations: 5
data.frame(coefficient = round(coef(step),4),
           odds_ratio = round(exp(coef(step)),4))
##                  coefficient odds_ratio
## (Intercept)           0.2233     1.2502
## fixed.acidity         4.2962    73.4171
## volatile.acidity     -4.5497     0.0106
## citric.acid          -2.0529     0.1284
## residual.sugar        6.6059   739.4552
## chlorides            -3.0219     0.0487
## density              -8.4472     0.0002
## pH                    2.4012    11.0369
## sulphates             2.0734     7.9516
## alcohol               1.8335     6.2559