Wine Class Classification
Daniel Lumban Gaol
24/04/2021
1. Librari and Setup
Pada metode klasifikasi menggunakan Regresi Logistik dan K-NN ini, sebelumnya Anda harus melakukan install.package() pada package readr, tidyverse, MASS, gtools, gmodels, class, caret, ggplot2 pada R Studio Anda. Apabila telah ter-install, maka lakukan pengaktifan package menggunakan library().
library(gtools)
library(GGally)
library(gmodels)
library(class)
library(caret)
library(dplyr)
library(rsample)2. Tujuan
Tujuan dari memprediksi data wine ini dari sifat fisiokimianya apakah yang membuat wine menjadi good atau not good berdasarkan qualitynya.
3. Logistic Regression
3.1 Import Data
wine <- read.csv("winequality-red.csv")
head(wine)#> fixed.acidity volatile.acidity citric.acid residual.sugar chlorides
#> 1 7.4 0.70 0.00 1.9 0.076
#> 2 7.8 0.88 0.00 2.6 0.098
#> 3 7.8 0.76 0.04 2.3 0.092
#> 4 11.2 0.28 0.56 1.9 0.075
#> 5 7.4 0.70 0.00 1.9 0.076
#> 6 7.4 0.66 0.00 1.8 0.075
#> free.sulfur.dioxide total.sulfur.dioxide density pH sulphates alcohol
#> 1 11 34 0.9978 3.51 0.56 9.4
#> 2 25 67 0.9968 3.20 0.68 9.8
#> 3 15 54 0.9970 3.26 0.65 9.8
#> 4 17 60 0.9980 3.16 0.58 9.8
#> 5 11 34 0.9978 3.51 0.56 9.4
#> 6 13 40 0.9978 3.51 0.56 9.4
#> quality
#> 1 5
#> 2 5
#> 3 5
#> 4 6
#> 5 5
#> 6 5Informasi Data :
fixed.acidity : Sebagian besar asam yang terlibat dengan anggur
volatile.acidity : jumlah asam asetat dalam anggur
citric.acid : asam sitrat
residual.sugar : jumlah gula yang tersisa setelah fermentasi dihentikan
chlorides : jumlah garam dalam anggur
free.sulfur.dioxide : sebagai gas terlarut
total.sulfur.dioxide : jumlah formulir SO2 yang bebas dan terikat
density : kepadatan air mendekati air tergantung pada persen kandungan alkohol dan gula
pH : menjelaskan seberapa asam atau basa anggur dalam skala dari 0 (sangat asam) hingga 14 (sangat basa)
sulphates : aditif anggur yang dapat berkontribusi pada tingkat gas sulfur dioksida (S02)
alcohol : Kadar Alkohol
3.2 Data Manipulation
pada kolom quality terdapat tingkat quality wine yang dibuat oleh si pembuat data, bahwa dimana 6 > Good, 6 < Not Good, maka kita buat kolom baru
wine$class <- ifelse(wine$quality <= 5 , "NotGood" , "Good")Melakukan cek tipe data
glimpse(wine)#> Rows: 1,599
#> Columns: 13
#> $ fixed.acidity <dbl> 7.4, 7.8, 7.8, 11.2, 7.4, 7.4, 7.9, 7.3, 7.8, 7.5~
#> $ volatile.acidity <dbl> 0.700, 0.880, 0.760, 0.280, 0.700, 0.660, 0.600, ~
#> $ citric.acid <dbl> 0.00, 0.00, 0.04, 0.56, 0.00, 0.00, 0.06, 0.00, 0~
#> $ residual.sugar <dbl> 1.9, 2.6, 2.3, 1.9, 1.9, 1.8, 1.6, 1.2, 2.0, 6.1,~
#> $ chlorides <dbl> 0.076, 0.098, 0.092, 0.075, 0.076, 0.075, 0.069, ~
#> $ free.sulfur.dioxide <dbl> 11, 25, 15, 17, 11, 13, 15, 15, 9, 17, 15, 17, 16~
#> $ total.sulfur.dioxide <dbl> 34, 67, 54, 60, 34, 40, 59, 21, 18, 102, 65, 102,~
#> $ density <dbl> 0.9978, 0.9968, 0.9970, 0.9980, 0.9978, 0.9978, 0~
#> $ pH <dbl> 3.51, 3.20, 3.26, 3.16, 3.51, 3.51, 3.30, 3.39, 3~
#> $ sulphates <dbl> 0.56, 0.68, 0.65, 0.58, 0.56, 0.56, 0.46, 0.47, 0~
#> $ alcohol <dbl> 9.4, 9.8, 9.8, 9.8, 9.4, 9.4, 9.4, 10.0, 9.5, 10.~
#> $ quality <int> 5, 5, 5, 6, 5, 5, 5, 7, 7, 5, 5, 5, 5, 5, 5, 5, 7~
#> $ class <chr> "NotGood", "NotGood", "NotGood", "Good", "NotGood~Menghapus kolom dan merubah tipe data
wine_clean <- wine %>%
mutate(class = as.factor(class)) %>%
select(-quality)
glimpse(wine_clean)#> Rows: 1,599
#> Columns: 12
#> $ fixed.acidity <dbl> 7.4, 7.8, 7.8, 11.2, 7.4, 7.4, 7.9, 7.3, 7.8, 7.5~
#> $ volatile.acidity <dbl> 0.700, 0.880, 0.760, 0.280, 0.700, 0.660, 0.600, ~
#> $ citric.acid <dbl> 0.00, 0.00, 0.04, 0.56, 0.00, 0.00, 0.06, 0.00, 0~
#> $ residual.sugar <dbl> 1.9, 2.6, 2.3, 1.9, 1.9, 1.8, 1.6, 1.2, 2.0, 6.1,~
#> $ chlorides <dbl> 0.076, 0.098, 0.092, 0.075, 0.076, 0.075, 0.069, ~
#> $ free.sulfur.dioxide <dbl> 11, 25, 15, 17, 11, 13, 15, 15, 9, 17, 15, 17, 16~
#> $ total.sulfur.dioxide <dbl> 34, 67, 54, 60, 34, 40, 59, 21, 18, 102, 65, 102,~
#> $ density <dbl> 0.9978, 0.9968, 0.9970, 0.9980, 0.9978, 0.9978, 0~
#> $ pH <dbl> 3.51, 3.20, 3.26, 3.16, 3.51, 3.51, 3.30, 3.39, 3~
#> $ sulphates <dbl> 0.56, 0.68, 0.65, 0.58, 0.56, 0.56, 0.46, 0.47, 0~
#> $ alcohol <dbl> 9.4, 9.8, 9.8, 9.8, 9.4, 9.4, 9.4, 10.0, 9.5, 10.~
#> $ class <fct> NotGood, NotGood, NotGood, Good, NotGood, NotGood~Melakukan Pengecekan terhadap missing value
colSums(is.na(wine_clean))#> fixed.acidity volatile.acidity citric.acid
#> 0 0 0
#> residual.sugar chlorides free.sulfur.dioxide
#> 0 0 0
#> total.sulfur.dioxide density pH
#> 0 0 0
#> sulphates alcohol class
#> 0 0 03.3 Exploratory Data Analysis
Membuat data training dan data testing dengan cara split Asumsi : 80% Data akan dibuat menjadi data train dan 20% menjadi data test
RNGkind(sample.kind = "Rounding")
set.seed(105)
intrain <- initial_split(data = wine_clean, prop = 0.8, strata = class)
wine.train <- training(intrain)
wine.test <- training(intrain)Proporsi data menggunakan 0.8/0.2
prop.table(table(wine.train$class))#>
#> Good NotGood
#> 0.5347385 0.4652615prop.table(table(wine.test$class))#>
#> Good NotGood
#> 0.5347385 0.4652615Membuat data menjadi balance dengan teknik upSample :
wine.up <- upSample(x = wine.train %>% select(-class),
y = wine.test$class,
yname = "class")
prop.table(table(wine.up$class))#>
#> Good NotGood
#> 0.5 0.5Melakukan pemodelan menggunakan regresi logistik. Pemodelan menggunakan fungsi glm dalam memodelkan menggunakan regresi logistik. Variabel yang digunakan adalah semua variabel, dimana variabel target menjadi variabel responnya.
model.wine <- glm(class ~ ., wine.up,family = "binomial")
summary(model.wine)#>
#> Call:
#> glm(formula = class ~ ., family = "binomial", data = wine.up)
#>
#> Deviance Residuals:
#> Min 1Q Median 3Q Max
#> -2.2972 -0.8362 -0.0158 0.8475 3.3631
#>
#> Coefficients:
#> Estimate Std. Error z value Pr(>|z|)
#> (Intercept) -71.043676 85.234651 -0.834 0.404559
#> fixed.acidity -0.162360 0.104959 -1.547 0.121892
#> volatile.acidity 2.919646 0.519284 5.622 0.000000018827142 ***
#> citric.acid 1.409508 0.598782 2.354 0.018575 *
#> residual.sugar -0.083355 0.056037 -1.488 0.136879
#> chlorides 4.000311 1.763209 2.269 0.023283 *
#> free.sulfur.dioxide -0.029415 0.008720 -3.373 0.000743 ***
#> total.sulfur.dioxide 0.018372 0.003169 5.798 0.000000006724568 ***
#> density 78.326857 87.018368 0.900 0.368057
#> pH 0.633340 0.753392 0.841 0.400543
#> sulphates -2.631372 0.444718 -5.917 0.000000003279847 ***
#> alcohol -0.820524 0.108046 -7.594 0.000000000000031 ***
#> ---
#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#>
#> (Dispersion parameter for binomial family taken to be 1)
#>
#> Null deviance: 1899.2 on 1369 degrees of freedom
#> Residual deviance: 1435.9 on 1358 degrees of freedom
#> AIC: 1459.9
#>
#> Number of Fisher Scoring iterations: 4Dari hasil diatas, prediktor yang memiliki korelasi kuat dengan target variabel (class) adalah volatile.acidity, citric.acid, chlorides, free.sulfur.dioxide, total.sulfur.dioxide, sulphates dan alcohol. Tetapi kita akan mencoba model fitting dengan menggunakan metode stepwise
model.wine2 <- step(model.wine, direction = "both")#> Start: AIC=1459.89
#> class ~ fixed.acidity + volatile.acidity + citric.acid + residual.sugar +
#> chlorides + free.sulfur.dioxide + total.sulfur.dioxide +
#> density + pH + sulphates + alcohol
#>
#> Df Deviance AIC
#> - pH 1 1436.6 1458.6
#> - density 1 1436.7 1458.7
#> <none> 1435.9 1459.9
#> - residual.sugar 1 1438.1 1460.1
#> - fixed.acidity 1 1438.3 1460.3
#> - chlorides 1 1441.3 1463.3
#> - citric.acid 1 1441.5 1463.5
#> - free.sulfur.dioxide 1 1447.4 1469.4
#> - volatile.acidity 1 1470.5 1492.5
#> - total.sulfur.dioxide 1 1472.6 1494.6
#> - sulphates 1 1475.7 1497.7
#> - alcohol 1 1497.6 1519.6
#>
#> Step: AIC=1458.59
#> class ~ fixed.acidity + volatile.acidity + citric.acid + residual.sugar +
#> chlorides + free.sulfur.dioxide + total.sulfur.dioxide +
#> density + sulphates + alcohol
#>
#> Df Deviance AIC
#> <none> 1436.6 1458.6
#> - density 1 1439.5 1459.5
#> + pH 1 1435.9 1459.9
#> - residual.sugar 1 1440.2 1460.2
#> - chlorides 1 1441.3 1461.3
#> - citric.acid 1 1442.4 1462.4
#> - fixed.acidity 1 1446.9 1466.9
#> - free.sulfur.dioxide 1 1447.5 1467.5
#> - volatile.acidity 1 1471.7 1491.7
#> - total.sulfur.dioxide 1 1472.8 1492.8
#> - sulphates 1 1479.4 1499.4
#> - alcohol 1 1512.0 1532.0summary(model.wine2)#>
#> Call:
#> glm(formula = class ~ fixed.acidity + volatile.acidity + citric.acid +
#> residual.sugar + chlorides + free.sulfur.dioxide + total.sulfur.dioxide +
#> density + sulphates + alcohol, family = "binomial", data = wine.up)
#>
#> Deviance Residuals:
#> Min 1Q Median 3Q Max
#> -2.2809 -0.8338 -0.0128 0.8384 3.4043
#>
#> Coefficients:
#> Estimate Std. Error z value Pr(>|z|)
#> (Intercept) -110.783469 70.935246 -1.562 0.11835
#> fixed.acidity -0.227354 0.071291 -3.189 0.00143 **
#> volatile.acidity 2.935458 0.518192 5.665 0.000000014719 ***
#> citric.acid 1.427596 0.597256 2.390 0.01684 *
#> residual.sugar -0.099524 0.052596 -1.892 0.05846 .
#> chlorides 3.642576 1.707723 2.133 0.03292 *
#> free.sulfur.dioxide -0.028284 0.008632 -3.277 0.00105 **
#> total.sulfur.dioxide 0.017819 0.003094 5.759 0.000000008479 ***
#> density 120.472457 71.142533 1.693 0.09038 .
#> sulphates -2.681732 0.437651 -6.128 0.000000000892 ***
#> alcohol -0.775480 0.093565 -8.288 < 0.0000000000000002 ***
#> ---
#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#>
#> (Dispersion parameter for binomial family taken to be 1)
#>
#> Null deviance: 1899.2 on 1369 degrees of freedom
#> Residual deviance: 1436.6 on 1359 degrees of freedom
#> AIC: 1458.6
#>
#> Number of Fisher Scoring iterations: 4Mencoba untuk menginterpretasikan salah satu prediktor numerik yaitu alcohol :
#alcohol
inv.logit(-0.775480)#> [1] 0.3152949Semakin tinggi kadar alcohol yang ada di quality wine, akan memiliki peluang 0.31/31% untuk wine tersebut NotGood
Klasifikasikan data wine.test berdasarkan prediksi dan simpan pada kolom baru bernama prediksi.
Prediksi:
wine.test$prediksi <- predict(object = model.wine2,
newdata = wine.test,
type = "response")Cek persebaran data
plot.wine <- density(wine.test$prediksi)
plot(plot.wine, main = "Density Wine Prediksi")
polygon(plot.wine, col="blue", border="black")
Dari density plot diatas data prediksi tidak berbentuk simetris, atau dapat dikatakan tidak terdistribusi normal, dan hasil prediksi lebih condong ke angka 1 atau “NotGood”
Hasil Prediksi
wine.test$pred.label <- ifelse(wine.test$prediksi < 0.5, "NotGood" , "Good" )
wine.test$pred.label <- as.factor(wine.test$pred.label)
str(wine.test)#> 'data.frame': 1281 obs. of 14 variables:
#> $ fixed.acidity : num 7.4 7.8 7.8 11.2 7.4 7.4 7.3 7.8 6.7 7.5 ...
#> $ volatile.acidity : num 0.7 0.88 0.76 0.28 0.7 0.66 0.65 0.58 0.58 0.5 ...
#> $ citric.acid : num 0 0 0.04 0.56 0 0 0 0.02 0.08 0.36 ...
#> $ residual.sugar : num 1.9 2.6 2.3 1.9 1.9 1.8 1.2 2 1.8 6.1 ...
#> $ chlorides : num 0.076 0.098 0.092 0.075 0.076 0.075 0.065 0.073 0.097 0.071 ...
#> $ free.sulfur.dioxide : num 11 25 15 17 11 13 15 9 15 17 ...
#> $ total.sulfur.dioxide: num 34 67 54 60 34 40 21 18 65 102 ...
#> $ density : num 0.998 0.997 0.997 0.998 0.998 ...
#> $ pH : num 3.51 3.2 3.26 3.16 3.51 3.51 3.39 3.36 3.28 3.35 ...
#> $ sulphates : num 0.56 0.68 0.65 0.58 0.56 0.56 0.47 0.57 0.54 0.8 ...
#> $ alcohol : num 9.4 9.8 9.8 9.8 9.4 9.4 10 9.5 9.2 10.5 ...
#> $ class : Factor w/ 2 levels "Good","NotGood": 2 2 2 1 2 2 1 1 2 2 ...
#> $ prediksi : num 0.8 0.782 0.758 0.51 0.8 ...
#> $ pred.label : Factor w/ 2 levels "Good","NotGood": 1 1 1 1 1 1 1 1 1 1 ...Melihat hasil prediksi
wine.test %>%
select(class,prediksi,pred.label) %>%
head()#> class prediksi pred.label
#> 1 NotGood 0.8001999 Good
#> 2 NotGood 0.7816065 Good
#> 3 NotGood 0.7583462 Good
#> 4 Good 0.5100959 Good
#> 5 NotGood 0.8001999 Good
#> 6 NotGood 0.7903084 Goodwine.conf <- confusionMatrix(wine.test$pred.label, wine.test$class, positive = "NotGood")
wine.conf#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction Good NotGood
#> Good 189 462
#> NotGood 496 134
#>
#> Accuracy : 0.2521
#> 95% CI : (0.2286, 0.2769)
#> No Information Rate : 0.5347
#> P-Value [Acc > NIR] : 1.0000
#>
#> Kappa : -0.4974
#>
#> Mcnemar's Test P-Value : 0.2863
#>
#> Sensitivity : 0.2248
#> Specificity : 0.2759
#> Pos Pred Value : 0.2127
#> Neg Pred Value : 0.2903
#> Prevalence : 0.4653
#> Detection Rate : 0.1046
#> Detection Prevalence : 0.4918
#> Balanced Accuracy : 0.2504
#>
#> 'Positive' Class : NotGood
#> 4 metrics performa model: Accuracy, Sensitivity/Recall, Precision/Pos pred Value, Specificity
Dari hasil prediksi diatas model yang dihasilkan hanya mendapatkan accuracy 25%, dibalik tingkat akurasi tersebut jika menjawab dari business question dimana memfokuskan terhadap quality dari wine tersebut. Maka bisa memainkan tingkat dari threshold/ambang batasnya, dimana kita bisa menaikan threshold dari 0.5 menjadi 0.8, untuk mendapatkan Sensitivity atau recall yang tinggi untuk mendapatkan quality yang baik dan memperkecil NotGood.
4. K-Nearest Neighbour
Untuk menjawab kelanjutan dari model sebelumnya, dimana tingkat accuracy masih rendah, pada tahap ini akan digunakan model K-NN untuk mengetahui apakah dengan model ini tingkat accuracy akan menjadi lebih baik terhadap quality wine tersebut
4.1 Cross Validation
wine.scale <- wine.up %>%
mutate(class = as.factor(class))Membuat data training dan data testing dari data wine.scale
RNGkind(sample.kind = "Rounding")
set.seed(105)
init <- initial_split(wine.up, prop = 0.8, strara = "class")
ws.train <- training(init)
ws.test <- testing(init)check class balance
prop.table(table(ws.train$class))#>
#> Good NotGood
#> 0.4977211 0.5022789prop.table(table(ws.test$class))#>
#> Good NotGood
#> 0.5091575 0.49084254.2 Data Training
Pada model k-NN, dipisahkan antara prediktor dan label (target variabelnya).
#Prediktor
ws.train.x <- ws.train %>%
select(-class)
ws.test.x <- ws.test %>%
select(-class)
#Target
ws.train.y <- ws.train %>%
select(class)
ws.test.y <- ws.test %>%
select(class)Scaling data
ws.train.xs <- ws.train.x %>%
select_if(is.numeric) %>%
scale()
ws.test.xs <- ws.test.x %>%
select_if(is.numeric) %>%
scale()4.3
mencari K yang optimum
sqrt(nrow(ws.train.x))#> [1] 33.12099wine.prediksi <- knn(train = ws.train.xs,
test = ws.test.xs,
cl = ws.train.y$class,
k = 33)
head(wine.prediksi)#> [1] NotGood NotGood NotGood Good Good Good
#> Levels: Good NotGoodconfusionMatrix(data = wine.prediksi,
reference = as.factor(ws.test.y$class),
positive = "NotGood")#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction Good NotGood
#> Good 107 30
#> NotGood 32 104
#>
#> Accuracy : 0.7729
#> 95% CI : (0.7185, 0.8212)
#> No Information Rate : 0.5092
#> P-Value [Acc > NIR] : <0.0000000000000002
#>
#> Kappa : 0.5458
#>
#> Mcnemar's Test P-Value : 0.8989
#>
#> Sensitivity : 0.7761
#> Specificity : 0.7698
#> Pos Pred Value : 0.7647
#> Neg Pred Value : 0.7810
#> Prevalence : 0.4908
#> Detection Rate : 0.3810
#> Detection Prevalence : 0.4982
#> Balanced Accuracy : 0.7730
#>
#> 'Positive' Class : NotGood
#> Berdasarkan hasil dari confusion matrix diatas, model yang dibuat untuk memprediksi (accuracy) wine Good/NotGood sebesar 77%. Berdasarkan data aktual dari NotGood model dapat menebak dengan tepat sebesar 77%, sedangkan dengan data aktual dari Good model berhasil memprediksi dengan benar sebesar 76%
5. Kesimpulan
Berdasarkan hasil prediksi yang diperoleh dari logistic regression dan K-NN, dapat disimpulkan bahwa dalam case ini kedua model tidak memiliki kemampuan yang sama dalam melakukan prediksi. Hal ini dikarenakan kedua model memiliki accuracy, sensitivity, specifivity dan pos pred value yang berbeda jauh, sehingga pada case ini model dengan K-NN adalah model yang lebih tepat dalam melakukan prediksi dengan accuracy 77%