Kami akan melakukan uji Multinomial Logistic Regression pada kasus prediksi nilai akhir siswa, yang dimana targetnya merupakan nilai akhir siswa yang memiliki 3 label, yaitu Low, Medium, dan High. Untuk melakukan Multinomial Logistic Regression, dilakukan langkah-langkah sebagai berikut.
Pertama memasukkan dataset yang akan digunakan untuk Multinomial Logistic Regression. Dataset yang kami gunakan berupa data dari pelajar SMA di Portugis. Data berupa nilai akhir siswa, demografi, fitur sosial dan sekolah yang dikumpulkan melalui dokumen sekolah dan kuesioner. Target pada dataset ini adalah “G3” yang mendefinisikan nilai akhir siswa pada pelajaran matematika.
df_student <- read.csv("C:\\Users\\lenovo\\Documents\\Semester 4\\Multivariat\\Week 11\\Tugas Week 11\\student-mat.csv", header = TRUE)Setelah dataset telah didefinisikan, maka selanjutnya akan mengubah format variabel-variabel yang kurang sesuai.
Di bawah ini kami membuat variabel target baru bernama “perform” yang isi nya merupakan data dari variabel target “G3” tetapi dengan mengubah datanya menjadi 3 label dengan parameter Low : < 10, Medium : 10 sampai 15, High : > 15.
library(tidyverse)
# Membuat variabel target 'perform'
df_student <- df_student %>%
mutate(
perform = case_when(
G3 < 10 ~ "Low",
G3 >= 10 & G3 < 15 ~ "Medium",
G3 >= 15 ~ "High"
),
perform = factor(perform, levels = c("Low", "Medium", "High"))
)Sedangkan di bawah ini mengubah variabel kategori yang telah di encoding, menjadi label yang seharusnya untuk mempermudah interpretasi kedepannya, dan mengubah tipe data factor pada variabel kategori.
# Mengubah variabel prediktor kategori
df_student <- df_student %>%
mutate(
sex = factor(sex, labels = c("Female", "Male")),
Medu = factor(Medu,
levels = c(0, 1, 2, 3, 4),
labels = c("none", "primary education", "5th to 9th grade", "secondary education", "higher education")),
Fedu = factor(Fedu,
levels = c(0, 1, 2, 3, 4),
labels = c("none", "primary education", "5th to 9th grade", "secondary education", "higher education")),
traveltime = factor(traveltime,
levels = c(1, 2, 3, 4),
labels = c("<15 min", "15 to 30 min", "30 min to 1 hour", ">1 hour")),
studytime = factor(studytime,
levels = c(1, 2, 3, 4),
labels = c("<2 hours", "2 to 5 hours", "5 to 10 hours", ">10 hours")),
school = as.factor(school),
address = as.factor(address),
famsize = as.factor(famsize),
Pstatus = as.factor(Pstatus),
Mjob = as.factor(Mjob),
Fjob = as.factor(Fjob),
reason = as.factor(reason),
guardian = as.factor(guardian),
schoolsup = as.factor(schoolsup),
famsup = as.factor(famsup),
paid = as.factor(paid),
activities = as.factor(activities),
nursery = as.factor(nursery),
higher = as.factor(higher),
internet = as.factor(internet),
romantic = as.factor(romantic)
)Untuk memeriksa apakah isi dataset sudah sesuai apa belum, dilakukan pemeriksaan struktur internal datasetnya untuk mendapat ringkasan singkat.
str(df_student)## 'data.frame': 395 obs. of 34 variables:
## $ school : Factor w/ 2 levels "GP","MS": 1 1 1 1 1 1 1 1 1 1 ...
## $ sex : Factor w/ 2 levels "Female","Male": 1 1 1 1 1 2 2 1 2 2 ...
## $ age : int 18 17 15 15 16 16 16 17 15 15 ...
## $ address : Factor w/ 2 levels "R","U": 2 2 2 2 2 2 2 2 2 2 ...
## $ famsize : Factor w/ 2 levels "GT3","LE3": 1 1 2 1 1 2 2 1 2 1 ...
## $ Pstatus : Factor w/ 2 levels "A","T": 1 2 2 2 2 2 2 1 1 2 ...
## $ Medu : Factor w/ 5 levels "none","primary education",..: 5 2 2 5 4 5 3 5 4 4 ...
## $ Fedu : Factor w/ 5 levels "none","primary education",..: 5 2 2 3 4 4 3 5 3 5 ...
## $ Mjob : Factor w/ 5 levels "at_home","health",..: 1 1 1 2 3 4 3 3 4 3 ...
## $ Fjob : Factor w/ 5 levels "at_home","health",..: 5 3 3 4 3 3 3 5 3 3 ...
## $ reason : Factor w/ 4 levels "course","home",..: 1 1 3 2 2 4 2 2 2 2 ...
## $ guardian : Factor w/ 3 levels "father","mother",..: 2 1 2 2 1 2 2 2 2 2 ...
## $ traveltime: Factor w/ 4 levels "<15 min","15 to 30 min",..: 2 1 1 1 1 1 1 2 1 1 ...
## $ studytime : Factor w/ 4 levels "<2 hours","2 to 5 hours",..: 2 2 2 3 2 2 2 2 2 2 ...
## $ failures : int 0 0 3 0 0 0 0 0 0 0 ...
## $ schoolsup : Factor w/ 2 levels "no","yes": 2 1 2 1 1 1 1 2 1 1 ...
## $ famsup : Factor w/ 2 levels "no","yes": 1 2 1 2 2 2 1 2 2 2 ...
## $ paid : Factor w/ 2 levels "no","yes": 1 1 2 2 2 2 1 1 2 2 ...
## $ activities: Factor w/ 2 levels "no","yes": 1 1 1 2 1 2 1 1 1 2 ...
## $ nursery : Factor w/ 2 levels "no","yes": 2 1 2 2 2 2 2 2 2 2 ...
## $ higher : Factor w/ 2 levels "no","yes": 2 2 2 2 2 2 2 2 2 2 ...
## $ internet : Factor w/ 2 levels "no","yes": 1 2 2 2 1 2 2 1 2 2 ...
## $ romantic : Factor w/ 2 levels "no","yes": 1 1 1 2 1 1 1 1 1 1 ...
## $ famrel : int 4 5 4 3 4 5 4 4 4 5 ...
## $ freetime : int 3 3 3 2 3 4 4 1 2 5 ...
## $ goout : int 4 3 2 2 2 2 4 4 2 1 ...
## $ Dalc : int 1 1 2 1 1 1 1 1 1 1 ...
## $ Walc : int 1 1 3 1 2 2 1 1 1 1 ...
## $ health : int 3 3 3 5 5 5 3 1 1 5 ...
## $ absences : int 6 4 10 2 4 10 0 6 0 0 ...
## $ G1 : int 5 5 7 15 6 15 12 6 16 14 ...
## $ G2 : int 6 5 8 14 10 15 12 5 18 15 ...
## $ G3 : int 6 6 10 15 10 15 11 6 19 15 ...
## $ perform : Factor w/ 3 levels "Low","Medium",..: 1 1 2 3 2 3 2 1 3 3 ...Saat dataset sudah sesuai dengan format semestinya, maka dataset siap digunakan untuk tahap selanjutnya.
Akan dibuat model dengan menggunakan 1 fitur input saja, fitur yang dipilih adalah “failures” yang merupakan data seberapa banyak siswa mengalami tidak lulus kelas.
library("nnet")
library("broom")
library("kableExtra")
fit_basic <- multinom(perform ~ failures, data = df_student)## # weights: 9 (4 variable)
## initial value 433.951854
## iter 10 value 380.178691
## final value 380.178316
## convergedtidy(fit_basic, conf.int = TRUE) %>%
kable() %>%
kable_styling("basic", full_width = FALSE)| y.level | term | estimate | std.error | statistic | p.value | conf.low | conf.high |
|---|---|---|---|---|---|---|---|
| Medium | (Intercept) | 0.716801 | 0.1329440 | 5.3917508 | 0.0000001 | 0.4562355 | 0.9773665 |
| Medium | failures | -0.824127 | 0.1691524 | -4.8720978 | 0.0000011 | -1.1556596 | -0.4925944 |
| High | (Intercept) | -0.122444 | 0.1621150 | -0.7552912 | 0.4500743 | -0.4401835 | 0.1952955 |
| High | failures | -2.125985 | 0.5708310 | -3.7243692 | 0.0001958 | -3.2447937 | -1.0071772 |
Dari output diatas, bisa dilihat bahwa fitur “failures” sangat signifikan terhadap variabel target dikarenkan p valuenya lebih kecil dari 0.05. Setiap kenaikan nilai pada “failures” maka akan menurunkan kemungkinan nilai akhir ada dikategori Medium atau High. Jadi variabel “failures” sangat kuat untuk memprediksi nilai akhir siswa.
Pada multinomial dengan banyak prediktor, kami memutuskan untuk menggunakan sebanyak 7 variabel prediktor. Variabel prediktor itu dipilih berdasarkan pemikiran teori dan domain knowledge, dan juga telah diuji dengan teknik backward elimination. Variabel prediktor yang akhirnya dipilih untuk model adalah failures, absences, schoolsup, higher, internet, goout, Walc.
#---Multinomial with Multiple IVs---
fit_full <- multinom(perform ~ failures + absences + schoolsup + higher + internet + goout + Walc, data = df_student)## # weights: 27 (16 variable)
## initial value 433.951854
## iter 10 value 370.705217
## iter 20 value 354.467250
## iter 30 value 354.304644
## final value 354.303105
## convergedDengan output seperti di atas, maka dapat diketahui bahwa model telah dilatih dengan baik dengan mencapai konvergen pada itertasi ke 30. Dengan ini, model telah didapatkan dan bisa dilakukan interpretasi.
Dari model yang didapat, bisa dilakukan interpretasi berupa Relative Log Odds, Relative Risk Ratios, dan Marginal Effect. Interpretasi model bisa dilihat di bawah ini.
tidy(fit_full, conf.int = TRUE) %>%
kable() %>%
kable_styling("basic", full_width = FALSE)| y.level | term | estimate | std.error | statistic | p.value | conf.low | conf.high |
|---|---|---|---|---|---|---|---|
| Medium | (Intercept) | 0.8750318 | 0.6963039 | 1.2566809 | 0.2088692 | -0.4896988 | 2.2397623 |
| Medium | failures | -0.7987574 | 0.1785734 | -4.4729917 | 0.0000077 | -1.1487549 | -0.4487599 |
| Medium | absences | -0.0150385 | 0.0141108 | -1.0657460 | 0.2865385 | -0.0426951 | 0.0126181 |
| Medium | schoolsupyes | -0.3843477 | 0.3340177 | -1.1506805 | 0.2498637 | -1.0390104 | 0.2703150 |
| Medium | higheryes | 0.6172363 | 0.5451931 | 1.1321426 | 0.2575745 | -0.4513225 | 1.6857950 |
| Medium | internetyes | 0.1848392 | 0.3147557 | 0.5872467 | 0.5570380 | -0.4320706 | 0.8017490 |
| Medium | goout | -0.4304326 | 0.1245431 | -3.4560951 | 0.0005481 | -0.6745326 | -0.1863327 |
| Medium | Walc | 0.2691445 | 0.1084266 | 2.4822745 | 0.0130547 | 0.0566323 | 0.4816567 |
| High | (Intercept) | -9.6248872 | 0.3472874 | -27.7144756 | 0.0000000 | -10.3055580 | -8.9442165 |
| High | failures | -1.7840256 | 0.5528209 | -3.2271314 | 0.0012504 | -2.8675345 | -0.7005166 |
| High | absences | -0.0574029 | 0.0299378 | -1.9174048 | 0.0551865 | -0.1160800 | 0.0012741 |
| High | schoolsupyes | -2.2412549 | 0.7746950 | -2.8930805 | 0.0038148 | -3.7596292 | -0.7228807 |
| High | higheryes | 10.3465626 | 0.3473097 | 29.7905941 | 0.0000000 | 9.6658480 | 11.0272771 |
| High | internetyes | 1.3570798 | 0.5453162 | 2.4886110 | 0.0128243 | 0.2882797 | 2.4258799 |
| High | goout | -0.4596645 | 0.1683972 | -2.7296440 | 0.0063403 | -0.7897170 | -0.1296120 |
| High | Walc | -0.0545841 | 0.1519295 | -0.3592722 | 0.7193915 | -0.3523605 | 0.2431924 |
Dengan output seperti di atas, maka dapat diinterpretasikan sebagai berikut :
Kategori : Medium, Setiap kenaikan satu nilai pada failures maka akan menurunkan log odds sebesar 0.7987574 bahwa seorang siswa akan memiliki nilai akhir di kategori Medium dibandingkan Low.
Kategori : High, Setiap kenaikan satu nilai pada failures maka akan menurunkan log odds sebesar 1.7840256 bahwa seorang siswa akan memiliki nilai akhir di kategori High dibandingkan Low.
Ini berarti semakin sering siswa tidak lulus kelas, maka semakin kecil peluang dia untuk mendapatkan nilai akhir dengan kategori Medium dan High.
Kategori : Medium, Setiap kenaikan satu nilai pada absence maka akan menurunkan log odds sebesar 0.01503849 bahwa seorang siswa akan memiliki nilai akhir di kategori Medium dibandingkan Low.
Kategori : High, Setiap kenaikan satu nilai pada absence maka akan menurunkan log odds sebesar 0.05740292 bahwa seorang siswa akan memiliki nilai akhir di kategori High dibandingkan Low.
Ini berarti semakin banyak siswa tidak menghadiri kelas, maka semakin kecil peluang dia untuk mendapatkan nilai akhir dengan kategori Medium dan High.
Kategori : Medium, Siswa yang mendapatkan school support (schoolsup = yes) memiliki penurunan log odds sebesar 0.3843477 bahwa seorang siswa akan memiliki nilai akhir di kategori Medium dibandingkan Low.
Kategori : High, Siswa yang mendapatkan school support (schoolsup = yes) memiliki penurunan log odds sebesar 2.2412549 bahwa seorang siswa akan memiliki nilai akhir di kategori High dibandingkan Low.
Berarti school support sering diperuntukan untuk siswa yang kurang berprestasi pada bidang akademik, sehingga semakin kecil dia akan mendapatkan nilai akhir dengan kategori Medium dan High.
Kategori : Medium, Siswa yang ingin mengincar pendidikan lebih tinggi (higher = yes) memiliki peningkatan log odds sebesar 0.6172363 bahwa seorang siswa akan memiliki nilai akhir di kategori Medium dibandingkan Low.
Kategori : High, Siswa yang ingin mengincar pendidikan lebih tinggi (higher = yes) memiliki peningkatan log odds sebesar 10.3465626 bahwa seorang siswa akan memiliki nilai akhir di kategori high dibandingkan low.
Berarti siswa yang mengincar pendidikan lebih tinggi akan lebih termotivasi untuk mendapatkan nilai tinggi, sehingga semakin besar dia akan mendapatkan nilai akhir dengan kategori Medium dan High.
Kategori : Medium, Siswa yang memiliki akses internet di rumah (internet = yes) memiliki peningkatan log odds sebesar 0.1848392 bahwa seorang siswa akan memiliki nilai akhir di kategori Medium dibandingkan Low.
Kategori : High, Siswa yang memiliki akses internet di rumah (internet = yes) memiliki peningkatan log odds sebesar 1.3570798 bahwa seorang siswa akan memiliki nilai akhir di kategori High dibandingkan Low.
Berarti siswa yang memiliki akses internet akan lebih mudah untuk mendapatkan akses lebih ke pembelajaran, sehingga semakin besar dia akan mendapatkan nilai akhir dengan kategori Medium dan High.
Kategori : Medium, Setiap kenaikan satu nilai pada goout maka akan menurunkan log odds sebesar 0.4304326 bahwa seorang siswa akan memiliki nilai akhir di kategori Medium dibandingkan Low.
Kategori : High, Setiap kenaikan satu nilai pada goout maka akan menurunkan log odds sebesar 0.4596645 bahwa seorang siswa akan memiliki nilai akhir di kategori High dibandingkan Low.
Ini berarti semakin banyak siswa menghabiskan waktunya untuk bermain dengan teman, maka semakin kecil peluang dia untuk mendapatkan nilai akhir dengan kategori Medium dan High.
Kategori : Medium, Setiap kenaikan satu nilai pada Walc maka akan meningkatkan log odds sebesar 0.26914452 bahwa seorang siswa akan memiliki nilai akhir di kategori Medium dibandingkan Low. Ini berarti semakin banyak siswa mengkonsumsi alkohol pada akhir minggu, maka semakin besar peluang dia untuk mendapatkan nilai akhir dengan kategori Medium.
Kategori : High, Setiap kenaikan satu nilai pada Walc maka akan menurunkan log odds sebesar 0.05458406 bahwa seorang siswa akan memiliki nilai akhir di kategori High dibandingkan Low. Ini berarti semakin banyak siswa mengkonsumsi alkohol pada akhir minggu, maka semakin kecil peluang dia untuk mendapatkan nilai akhir dengan kategori High.
RRR membantu untuk memahami kekuatan dan arah pengaruh prediktor terhadap probabilitas memilih kategori tertentu dari variabel target multinomial.
Higher dan internet merupakan dua faktor yang paling dominan dalam meningkatkan peluang siswa untuk mencapai performa akademik yang tinggi. Sebaliknya, faktor sepert failures, absences, dan schoolsup menjadi indikator yang justru berkaitan dengan rendahnya performa.
tidy(fit_full, conf.int = TRUE, exponentiate = TRUE) %>%
kable() %>%
kable_styling("basic", full_width = FALSE)| y.level | term | estimate | std.error | statistic | p.value | conf.low | conf.high |
|---|---|---|---|---|---|---|---|
| Medium | (Intercept) | 2.398951e+00 | 0.6963039 | 1.2566809 | 0.2088692 | 6.128110e-01 | 9.391099e+00 |
| Medium | failures | 4.498876e-01 | 0.1785734 | -4.4729917 | 0.0000077 | 3.170313e-01 | 6.384193e-01 |
| Medium | absences | 9.850740e-01 | 0.0141108 | -1.0657460 | 0.2865385 | 9.582035e-01 | 1.012698e+00 |
| Medium | schoolsupyes | 6.808946e-01 | 0.3340177 | -1.1506805 | 0.2498637 | 3.538046e-01 | 1.310377e+00 |
| Medium | higheryes | 1.853798e+00 | 0.5451931 | 1.1321426 | 0.2575745 | 6.367855e-01 | 5.396740e+00 |
| Medium | internetyes | 1.203025e+00 | 0.3147557 | 0.5872467 | 0.5570380 | 6.491636e-01 | 2.229437e+00 |
| Medium | goout | 6.502277e-01 | 0.1245431 | -3.4560951 | 0.0005481 | 5.093945e-01 | 8.299974e-01 |
| Medium | Walc | 1.308844e+00 | 0.1084266 | 2.4822745 | 0.0130547 | 1.058267e+00 | 1.618754e+00 |
| High | (Intercept) | 6.610000e-05 | 0.3472874 | -27.7144756 | 0.0000000 | 3.340000e-05 | 1.305000e-04 |
| High | failures | 1.679606e-01 | 0.5528209 | -3.2271314 | 0.0012504 | 5.683890e-02 | 4.963288e-01 |
| High | absences | 9.442135e-01 | 0.0299378 | -1.9174048 | 0.0551865 | 8.904040e-01 | 1.001275e+00 |
| High | schoolsupyes | 1.063250e-01 | 0.7746950 | -2.8930805 | 0.0038148 | 2.329240e-02 | 4.853521e-01 |
| High | higheryes | 3.114978e+04 | 0.3473097 | 29.7905941 | 0.0000000 | 1.576974e+04 | 6.152981e+04 |
| High | internetyes | 3.884832e+00 | 0.5453162 | 2.4886110 | 0.0128243 | 1.334131e+00 | 1.131218e+01 |
| High | goout | 6.314955e-01 | 0.1683972 | -2.7296440 | 0.0063403 | 4.539733e-01 | 8.784362e-01 |
| High | Walc | 9.468789e-01 | 0.1519295 | -0.3592722 | 0.7193915 | 7.030266e-01 | 1.275314e+00 |
Variabel failures punya dampak negatif yang kuat dan signifikan terhadap performa siswa. Variabel goout juga berdampak negatif, terutama menurunkan peluang medium performa dan menaikkan risiko low performa.
library("marginaleffects")
mfx_study <- avg_comparisons(fit_full, variables = "failures", type = "probs")
mfx_study##
## Group Estimate Std. Error z Pr(>|z|) S 2.5 % 97.5 %
## Low 0.2000 0.0355 5.63 <0.001 25.7 0.130 0.26958
## Medium -0.0796 0.0380 -2.10 0.0361 4.8 -0.154 -0.00514
## High -0.1203 0.0324 -3.72 <0.001 12.3 -0.184 -0.05690
##
## Term: failures
## Type: probs
## Comparison: +1Pada efek variabel failures probabilitas siswa masuk ke low performa naik 20%, probabilitas medium performa turun 7,96%, sedangkan high performa turun 12%. Dimana semakin sering siswa mengalami kegagalan, maka makin besar kemungkinan untuk mereka masuk ke dalam kategori low performa dan semakin kecil juga peluang mereka masuk pada high performa.
mfx_fail <- avg_comparisons(fit_full, variables = "goout", type = "probs")
mfx_fail##
## Group Estimate Std. Error z Pr(>|z|) S 2.5 % 97.5 %
## Low 0.085 0.0230 3.69 < 0.001 12.1 0.0399 0.1302
## Medium -0.062 0.0234 -2.65 0.00817 6.9 -0.1080 -0.0161
## High -0.023 0.0170 -1.35 0.17599 2.5 -0.0564 0.0103
##
## Term: goout
## Type: probs
## Comparison: +1Pada efek variabel goout probabilitas low performa naik 8,5%, probabilitas medium performa turun 6,2%, dan probabilitas high performa juga menurun namun tidak signifikan. Sehingga semakin sering siswa keluar rumah, kemungkinan performanya menurun ke low performa, namun dampak pada high performa juga tidak terlalu signifikan.
Kami akan melakukan uji Ordinal Logistic Regression pada kasus prediksi kualitas anggur merah dari anggur Portugis “Vinho Verde”, ang telah dikategorikan menjadi tiga tingkat: Low, Medium, dan High.
Tujuannya adalah untuk memahami bagaimana variabel-variabel kimiawi seperti kadar asam, gula, pH, dan lainnya berkontribusi dalam membedakan tingkat kandungan alkohol pada anggur. Metode ini dipilih karena variabel target (alcohol_group) bersifat ordinal, di mana terdapat urutan yang jelas antar kategorinya namun jaraknya tidak diasumsikan sama. Untuk melakukan Ordinal Logistic Regression, dilakukan langkah-langkah sebagai berikut.
Pertama memasukkan dataset yang akan digunakan untuk analisis Ordinal Logistic Regression. Dataset yang kami gunakan merupakan data kualitas anggur merah dari Portugal, khususnya jenis Vinho Verde. Data ini berisi informasi kimia dan fisik dari sampel anggur, seperti kadar alkohol, keasaman, pH, gula, serta fitur lain yang dikumpulkan melalui pengukuran laboratorium. Target pada dataset ini adalah variabel ‘alcohol_group’, yang merupakan hasil kategorisasi dari kadar alkohol menjadi tiga tingkat: Low, Medium, dan High.
data <- read.csv("C:\\Users\\lenovo\\Documents\\Semester 4\\Multivariat\\Week 11\\Tugas Week 11\\winequality-red.csv", header = TRUE)Setelah dataset telah didefinisikan, maka selanjutnya dilakukan pemeriksaan terhadap struktur internal dataset untuk memperoleh gambaran singkat mengenai tipe dan isi data.
str(data)## 'data.frame': 1599 obs. of 12 variables:
## $ fixed.acidity : num 7.4 7.8 7.8 11.2 7.4 7.4 7.9 7.3 7.8 7.5 ...
## $ volatile.acidity : num 0.7 0.88 0.76 0.28 0.7 0.66 0.6 0.65 0.58 0.5 ...
## $ citric.acid : num 0 0 0.04 0.56 0 0 0.06 0 0.02 0.36 ...
## $ residual.sugar : num 1.9 2.6 2.3 1.9 1.9 1.8 1.6 1.2 2 6.1 ...
## $ chlorides : num 0.076 0.098 0.092 0.075 0.076 0.075 0.069 0.065 0.073 0.071 ...
## $ free.sulfur.dioxide : num 11 25 15 17 11 13 15 15 9 17 ...
## $ total.sulfur.dioxide: num 34 67 54 60 34 40 59 21 18 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.3 3.39 3.36 3.35 ...
## $ sulphates : num 0.56 0.68 0.65 0.58 0.56 0.56 0.46 0.47 0.57 0.8 ...
## $ alcohol : num 9.4 9.8 9.8 9.8 9.4 9.4 9.4 10 9.5 10.5 ...
## $ quality : int 5 5 5 6 5 5 5 7 7 5 ...Selain itu, diperlukan juga ringkasan statistik deskriptif untuk setiap kolom agar dapat memahami karakteristik data dan distribusinya secara lebih mendalam.
summary(data)## fixed.acidity volatile.acidity citric.acid residual.sugar
## Min. : 4.60 Min. :0.1200 Min. :0.000 Min. : 0.900
## 1st Qu.: 7.10 1st Qu.:0.3900 1st Qu.:0.090 1st Qu.: 1.900
## Median : 7.90 Median :0.5200 Median :0.260 Median : 2.200
## Mean : 8.32 Mean :0.5278 Mean :0.271 Mean : 2.539
## 3rd Qu.: 9.20 3rd Qu.:0.6400 3rd Qu.:0.420 3rd Qu.: 2.600
## Max. :15.90 Max. :1.5800 Max. :1.000 Max. :15.500
## chlorides free.sulfur.dioxide total.sulfur.dioxide density
## Min. :0.01200 Min. : 1.00 Min. : 6.00 Min. :0.9901
## 1st Qu.:0.07000 1st Qu.: 7.00 1st Qu.: 22.00 1st Qu.:0.9956
## Median :0.07900 Median :14.00 Median : 38.00 Median :0.9968
## Mean :0.08747 Mean :15.87 Mean : 46.47 Mean :0.9967
## 3rd Qu.:0.09000 3rd Qu.:21.00 3rd Qu.: 62.00 3rd Qu.:0.9978
## Max. :0.61100 Max. :72.00 Max. :289.00 Max. :1.0037
## pH sulphates alcohol quality
## Min. :2.740 Min. :0.3300 Min. : 8.40 Min. :3.000
## 1st Qu.:3.210 1st Qu.:0.5500 1st Qu.: 9.50 1st Qu.:5.000
## Median :3.310 Median :0.6200 Median :10.20 Median :6.000
## Mean :3.311 Mean :0.6581 Mean :10.42 Mean :5.636
## 3rd Qu.:3.400 3rd Qu.:0.7300 3rd Qu.:11.10 3rd Qu.:6.000
## Max. :4.010 Max. :2.0000 Max. :14.90 Max. :8.000Dataset ini berisi data kimia dan fisik dari sampel wine, dengan tujuan utama untuk memahami faktor-faktor yang mempengaruhi kualitas wine. Secara umum, keasaman tetap (fixed acidity) memiliki rata-rata sebesar 8.32, menunjukkan bahwa sebagian besar wine memiliki tingkat keasaman sedang hingga tinggi. Keasaman volatil (volatile acidity), yang dapat memberikan aroma tidak sedap jika terlalu tinggi, memiliki nilai rata-rata 0.528, mengindikasikan bahwa sebagian besar wine berada dalam batas yang wajar. Kandungan asam sitrat (citric acid) cukup bervariasi, dengan nilai median sebesar 0.26, namun ada juga beberapa wine yang tidak mengandung asam sitrat sama sekali. Gula sisa (residual sugar) umumnya rendah, dengan rata-rata sebesar 2.54, meskipun terdapat beberapa sampel dengan kadar gula yang sangat tinggi hingga 15.5, yang kemungkinan merupakan wine manis.
Kandungan klorida (chlorides), yang mencerminkan kadar garam, memiliki rata-rata yang rendah (0.087), namun ada outlier dengan nilai sangat tinggi (0.611) yang perlu diperhatikan. Variabel free sulfur dioxide dan total sulfur dioxide menunjukkan bahwa sebagian besar wine memiliki kadar sulfur yang wajar, meskipun terdapat beberapa nilai ekstrim yang cukup tinggi, terutama pada total sulfur dioxide yang mencapai 289. pH wine berkisar antara 2.74 hingga 4.01, dengan rata-rata 3.31, menunjukkan bahwa mayoritas wine bersifat cukup asam.
Karakteristik fisik lainnya seperti densitas (density) memiliki rentang yang sempit dan nilai rata-rata 0.9967, mengindikasikan konsistensi antar sampel. Kandungan sulfat (sulphates), yang berperan sebagai pengawet dan agen antimikroba, memiliki rata-rata 0.658, menunjukkan tingkat kestabilan wine yang moderat. Kadar alkohol dalam wine bervariasi cukup luas, dari 8.4% hingga 14.9%, dengan rata-rata 10.42%, yang umumnya berkorelasi positif terhadap kualitas wine.
Akhirnya, variabel target yaitu kualitas (quality) memiliki rentang nilai antara 3 hingga 8 dari skala 10, dengan median 6 dan rata-rata 5.636. Ini menunjukkan bahwa mayoritas wine dalam dataset ini tergolong dalam kualitas sedang, dengan sedikit pergeseran distribusi ke arah nilai yang lebih rendah. Secara keseluruhan, dataset ini menunjukkan variasi yang cukup besar dalam karakteristik wine, yang memungkinkan analisis lebih lanjut untuk menentukan faktor-faktor yang paling berpengaruh terhadap kualitas wine.
Selanjutnya, dilakukan transformasi pada variabel ‘alcohol’ menjadi variabel ordinal baru bernama ‘alcohol_group’. Variabel ini dikategorikan menjadi tiga kelompok: Low untuk kadar alkohol ≤ 10, Medium untuk kadar alkohol antara 10 dan 11.5, serta High untuk kadar alkohol > 11.5.
data$alcohol_group <- cut(data$alcohol,
breaks = c(-Inf, 10, 11.5, Inf),
labels = c("Low", "Medium", "High"),
ordered_result = TRUE)
table(data$alcohol_group)##
## Low Medium High
## 747 602 250Sebagian besar wine dalam dataset ini memiliki kandungan alkohol yang tergolong rendah hingga sedang. Sebanyak 747 dari 1,599 wine termasuk dalam kategori Low, sedangkan Medium mencakup sekitar 602 wine. Hanya sekitar 250 wine yang memiliki kadar alkohol tinggi.
Hal ini menunjukkan bahwa wine dengan kadar alkohol tinggi relatif jarang dalam dataset ini. Karena alkohol sering berkorelasi positif dengan persepsi kualitas wine, proporsi yang rendah dari kelompok ‘High’ dapat memengaruhi distribusi kualitas secara keseluruhan, hal tersebut mungkin menjelaskan kenapa rata-rata kualitas cenderung sedang.
Kemudian membagi dataset menjadi dua bagian, data latih (training set) dan data uji (testing set). Pembagian data seperti ini merupakan praktik umum dalam machine learning untuk memastikan bahwa model yang dibangun tidak hanya bekerja baik pada data yang digunakan untuk pelatihan, tetapi juga dapat menggeneralisasi dengan baik terhadap data baru.
set.seed(123)
train_index <- sample(1:nrow(data), size = 0.8 * nrow(data))
train_data <- data[train_index, ]
test_data <- data[-train_index, ]Sebanyak 80% dari total data dipilih secara acak untuk dimasukkan ke dalam data latih, yang akan digunakan untuk membangun atau melatih model prediktif. Sementara itu, 20% sisanya digunakan sebagai data uji, yang berfungsi untuk menguji dan mengevaluasi kinerja model pada data yang belum pernah dilihat sebelumnya.
Melakukan pemodelan terhadap variabel ‘alcohol_group’, yang dikategorikan menjadi Low, Medium, dan High menggunakan regresi logistik ordinal. Model dibangun berdasarkan data latih (train_data), dimana variabel ‘quality’ dan ‘alcohol’ secara eksplisit dikeluarkan dari model untuk menghindari bias dan data leakage.
library(MASS)
model <- polr(alcohol_group ~ . - quality - alcohol, data = train_data, Hess = TRUE)
summary(model)## Call:
## polr(formula = alcohol_group ~ . - quality - alcohol, data = train_data,
## Hess = TRUE)
##
## Coefficients:
## Value Std. Error t value
## fixed.acidity 1.647e+00 0.070683 23.3070
## volatile.acidity 4.409e-01 0.495418 0.8900
## citric.acid 2.576e+00 0.628049 4.1022
## residual.sugar 9.364e-01 0.055824 16.7738
## chlorides -5.515e+00 2.066696 -2.6683
## free.sulfur.dioxide 1.849e-03 0.009241 0.2001
## total.sulfur.dioxide -1.214e-02 0.003347 -3.6260
## density -1.850e+03 1.310973 -1411.0765
## pH 1.172e+01 0.683961 17.1386
## sulphates 3.900e+00 0.468185 8.3307
##
## Intercepts:
## Value Std. Error t value
## Low|Medium -1787.0588 1.3566 -1317.3551
## Medium|High -1783.0763 1.3713 -1300.2561
##
## Residual Deviance: 1510.029
## AIC: 1534.029Hasilnya menunjukkan bahwa sebagian besar variabel memiliki pengaruh signifikan terhadap kategori kadar alkohol, yang terlihat dari nilai t value yang tinggi dan secara umum lebih besar dari 2 (atau lebih kecil dari -2). Beberapa variabel yang memiliki pengaruh positif dan signifikan terhadap kemungkinan wine masuk ke kategori alkohol lebih tinggi adalah:
Artinya, semakin tinggi nilai-nilai ini, semakin besar kemungkinan wine tergolong ke dalam kategori Medium atau High alcohol.
Sebaliknya, variabel ‘chlorides’ dan ‘total.sulfur.dioxide’ memiliki koefisien negatif dan signifikan, yang menunjukkan bahwa kadar klorida dan total sulfur dioksida yang lebih tinggi justru mengarah ke wine dengan kadar alkohol yang lebih rendah. Variabel ‘density’ juga sangat signifikan dengan koefisien negatif yang ekstrem (t ≈ -1411), menunjukkan bahwa densitas sangat berkorelasi negatif dengan kadar alkohol, hal ini masuk akal karena semakin tinggi kadar alkohol, semakin rendah densitasnya. Sementara itu, variabel seperti ‘volatile.acidity’ dan ‘free.sulfur.dioxide’ memiliki nilai t yang rendah dan tidak signifikan, sehingga kemungkinan besar tidak berkontribusi secara signifikan terhadap prediksi kategori alkohol.
library(caret)
pred <- predict(model, newdata = test_data)
confusionMatrix(pred, test_data$alcohol_group)## Confusion Matrix and Statistics
##
## Reference
## Prediction Low Medium High
## Low 139 34 1
## Medium 21 76 14
## High 1 11 23
##
## Overall Statistics
##
## Accuracy : 0.7438
## 95% CI : (0.6922, 0.7907)
## No Information Rate : 0.5031
## P-Value [Acc > NIR] : <2e-16
##
## Kappa : 0.5599
##
## Mcnemar's Test P-Value : 0.3296
##
## Statistics by Class:
##
## Class: Low Class: Medium Class: High
## Sensitivity 0.8634 0.6281 0.60526
## Specificity 0.7799 0.8241 0.95745
## Pos Pred Value 0.7989 0.6847 0.65714
## Neg Pred Value 0.8493 0.7847 0.94737
## Prevalence 0.5031 0.3781 0.11875
## Detection Rate 0.4344 0.2375 0.07187
## Detection Prevalence 0.5437 0.3469 0.10938
## Balanced Accuracy 0.8216 0.7261 0.78135Model regresi logistik ordinal yang dibangun untuk memprediksi kategori kadar alkohol wine menunjukkan performa yang cukup baik, dengan akurasi keseluruhan sebesar 74,4%. Ini berarti sekitar tiga perempat dari prediksi yang dihasilkan pada data uji sesuai dengan nilai aktual. Nilai Kappa sebesar 0.56 menunjukkan tingkat kesepakatan yang sedang hingga baik antara prediksi dan nilai sebenarnya, setelah memperhitungkan kesepakatan yang terjadi secara kebetulan. Model juga memiliki nilai p-value < 2e-16 terhadap No Information Rate, yang berarti model secara statistik jauh lebih baik daripada tebakan acak berdasarkan distribusi mayoritas kelas.
Secara spesifik, model sangat baik dalam mengklasifikasikan wine ke kategori Low alcohol, dengan sensitivitas 86.3% dan spesifisitas 77.9%, artinya model sangat mampu mengenali wine berkadar alkohol rendah. Untuk kategori Medium, performanya cukup baik (sensitivitas 62.8%, spesifisitas 82.4%), namun dengan beberapa kesalahan klasifikasi ke kategori Low atau High. Kategori High alcohol adalah yang paling sulit diklasifikasi, dengan sensitivitas 60.5%, meskipun spesifisitasnya tinggi (95.7%), artinya model jarang salah mengklasifikasikan data lain sebagai High.
Kesalahan prediksi paling umum terjadi antara kelas Medium dan Low, yang memang secara alami berdekatan. Sementara itu, meskipun kelas High hanya mencakup sekitar 12% data (prevalensi rendah), model masih dapat mengenalinya dengan performa yang cukup baik. Secara keseluruhan, model ini cukup andal untuk memprediksi kadar alkohol wine berdasarkan karakteristik kimianya.