Nama Anggota

  1. Raden Roro Azahra Tzitziliani Foulin (23031554003)
  2. Fardaniyah Hazhiratul Dzauq (23031554045)
  3. Novanna Zahrah Zahrani (23031554141)
  4. Salsa Rahma Aulia (23031554219)

Import Library

library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ ggplot2   3.5.2     ✔ tibble    3.2.1
## ✔ lubridate 1.9.4     ✔ tidyr     1.3.1
## ✔ purrr     1.0.4     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(ggplot2)
library(MASS)
## 
## Attaching package: 'MASS'
## 
## The following object is masked from 'package:dplyr':
## 
##     select
library(nnet)

Kasus Multinomial Logistic Regression: Cardiotocographic (CTG)

Import Dataset

cardiotocographic <- read.csv("C:\\Users\\Bhy\\Downloads\\Cardiotocographic.csv")

Pre-Processing Data Cardiotocographic

cardiotocographic$class <- factor(cardiotocographic$NSP, labels = c("Normal", "Suspect", "Pathologic"))

Mengubah kolom NSP menjadi faktor (kategori) baru bernama class dengan label yang lebih mudah dibaca, yaitu: 0 menjadi “Normal”,
1 menjadi “Suspect”, dan
2 menjadi “Pathologic”.

Visualisasi Distribusi Kelas: Cardiotocographic

ggplot(cardiotocographic, aes(x = class)) +
  geom_bar(fill = "salmon") +
  theme_minimal() +
  ggtitle("Distribusi Kelas - CTG (Cardiotocographic)")

Distribusi dari data tersebut tidak seimbang. Bisa dilihat dari jumlah distribusi pada kelas ‘Normal’ yang mendominasi dengan jumlah lebih dari 1500 dan sisa kelas yang memiliki jumlah kurang dari 500.

Modeling

model_multinomial <- multinom(class ~ ., data = cardiotocographic)
## # weights:  72 (46 variable)
## initial  value 2335.649726 
## iter  10 value 1240.551829
## iter  20 value 884.561630
## iter  30 value 261.445924
## iter  40 value 13.919604
## iter  50 value 0.096143
## iter  60 value 0.006683
## iter  70 value 0.000311
## final  value 0.000000 
## converged
summary(model_multinomial)
## Call:
## multinom(formula = class ~ ., data = cardiotocographic)
## 
## Coefficients:
##            (Intercept)        LB        AC        FM        UC        DL
## Suspect      -428.0527 -24.64791 -1330.696 -73.17357 -243.0302 123.32752
## Pathologic  -3770.1151 -26.15376  1007.659 383.44195  171.4962  22.21851
##                     DS        DP      ASTV     MSTV     ALTV       MLTV
## Suspect    -2.79034782  18.15037 -6.638853 177.0461 4.028948  -7.246139
## Pathologic  0.03745161 -45.41306  2.862657 273.4340 5.038268 -21.949973
##                 Width       Min       Max      Nmax     Nzeros     Mode
## Suspect    -0.8878535 -6.493904 -7.381758 -56.92288 63.1810334 16.92836
## Pathologic  0.3956608 -2.289190 -1.893529 -58.39520 -0.7228085 11.58160
##                  Mean    Median  Variance  Tendency      NSP
## Suspect     -1.164375  2.038813 -4.387792 -67.90565 2519.566
## Pathologic -15.059167 13.029277 -4.792659  18.82356 3545.487
## 
## Std. Errors:
##            (Intercept)       LB           AC           FM      UC       DL
## Suspect       1709.334 225632.1 6.942352e-29 2.692796e-73 19.2601 2.407513
## Pathologic    1709.334 225632.1 1.458815e-58 2.691224e-73 19.2601 2.407513
##                      DS          DP    ASTV     MSTV          ALTV     MLTV
## Suspect    1.204573e-66 2.91763e-58 54698.7 2222.134  1.421794e-26 24272.55
## Pathologic 1.204573e-66 2.91763e-58 54698.7 2222.134 6.710692e-107 24272.55
##               Width      Min      Max     Nmax   Nzeros     Mode     Mean
## Suspect    153840.1 102560.1 256400.1 3418.668 5128.003 169224.1 199992.1
## Pathologic 153840.1 102560.1 256400.1 3418.668 5128.003 169224.1 199992.1
##              Median Variance Tendency      NSP
## Suspect    213666.8 104269.4 1709.334 5128.003
## Pathologic 213666.8 104269.4 1709.334 5128.003
## 
## Residual Deviance: 0 
## AIC: 88

Output dari model multinomial menunjukkan koefisien regresi untuk dua katogori relatif terhadap kategori referensi (Normal). Koefisien ini menunjukkan pengaruh tiap variabel prediktor terhadap log odds. Contohnya pada variabel ‘ASTV’ dengan koefisien ‘suspect’ sebesar -6.638853 yang menunjukkan bahwa peningkatan nilai ASTV dapat menurunkan kemungkinan seorang pasien termasuk ke dalam kelas “suspect’ dibandingkan kelas ‘Normal’. contoh lain pada variabel yang sama dengan koefisien ‘Pathologic’ sebesar 2.862657 menunjukkan peningkatan nilai ASTV justru meningkatkan kemungkinan pasien masuk ke kelas ‘Pathologic’.

Evaluasi Model

pred_multinomial <- predict(model_multinomial, newdata = cardiotocographic)
conf_matrix_multinomial <- table(Predicted = pred_multinomial, Actual = cardiotocographic$class)
conf_matrix_multinomial
##             Actual
## Predicted    Normal Suspect Pathologic
##   Normal       1655       0          0
##   Suspect         0     295          0
##   Pathologic      0       0        176
conf_multinomial <- as.data.frame(conf_matrix_multinomial)
ggplot(conf_multinomial, aes(x = Actual, y = Predicted, fill = Freq)) +
  geom_tile(color = "white") +
  geom_text(aes(label = Freq), color = "white", size = 5) +
  scale_fill_gradient(low = "skyblue", high = "darkblue") +
  ggtitle("Confusion Matrix - Multinomial Logistic Regression") +
  theme_minimal()

accuracy_multinomial <- sum(diag(conf_matrix_multinomial)) / sum(conf_matrix_multinomial)
cat("Akurasi model multinomial:", round(accuracy_multinomial * 100, 2), "%\n")
## Akurasi model multinomial: 100 %

Kasus Ordinal Logistic Regression: Wine Quality

Import Dataset

wine_q <- read.csv("C:\\Users\\Bhy\\Downloads\\WineQT.csv")

Pre-Processing Data

wine_q$quality <- factor(wine_q$quality, ordered = TRUE)
wine_scaled <- wine_q %>% mutate(across(-quality, scale))

Distribusi Kelas

ggplot(wine_q, aes(x = quality)) +
  geom_bar(fill = "lavender") +
  theme_minimal() +
  ggtitle("Distribusi Kualitas Wine")

Grafik tersebut menunjukkan distribusi frekuensi kualitas wine (quality) dengan rentang tiga sampai delapan. Mayoritas data berada pada kelas lima dan enam dengan masing-masing memiliki lebih dari 450 obesrvasi, dengan kelas yang lain menjadi kelas yang minoritas dengan jumlah yang sedikit. Dengan distribusi yang tidak seimbang ini bisa jadi memengaruhi hasil akurasi di akhir nanti.

Modeling

model_ordinal <- polr(quality ~ ., data = wine_scaled, Hess = TRUE)
summary(model_ordinal)
## Call:
## polr(formula = quality ~ ., data = wine_scaled, Hess = TRUE)
## 
## Coefficients:
##                         Value Std. Error t value
## fixed.acidity         0.19150    0.17232  1.1113
## volatile.acidity     -0.65670    0.08589 -7.6461
## citric.acid          -0.13431    0.10800 -1.2436
## residual.sugar        0.10014    0.08112  1.2344
## chlorides            -0.20962    0.07730 -2.7117
## free.sulfur.dioxide   0.09073    0.08488  1.0689
## total.sulfur.dioxide -0.33253    0.09324 -3.5663
## density              -0.13357    0.15687 -0.8515
## pH                   -0.14401    0.11205 -1.2852
## sulphates             0.47383    0.07363  6.4349
## alcohol               0.94791    0.11177  8.4806
## Id                   -0.04727    0.06818 -0.6934
## 
## Intercepts:
##     Value    Std. Error t value 
## 3|4  -6.1629   0.4177   -14.7548
## 4|5  -4.2174   0.1800   -23.4252
## 5|6  -0.3644   0.0724    -5.0305
## 6|7   2.5600   0.1133    22.5989
## 7|8   5.4112   0.2728    19.8322
## 
## Residual Deviance: 2163.299 
## AIC: 2197.299

Model di atas ini berguna untuk memprediksi kualitas wine dari data ordinal berdasarkan dengan semua variabel prediktor. Nilai koefisien yang positif dapat meningkatkan kemungkinan observasi pada kelas kualitas lebih tinggi. Sedangkan koefisien negatif dapat meningkatkan kemungkinan berada pada kelas yang lebih rendah. Contoh pada ‘alcohol’ memiliki koefisien sebesar 0,94791 dengan t value sebesar 8,48 menunjukkan bahwa kadar alkohol yang lebih tinggi dapat meningkatkan kualitas wine. Contoh lain pada ‘volatile.acidity’ memiliki koefisien sebesar -0.65670 dengan t value -7,6461 menunjukkan bahwa semakin tinggi keasaman volatil cenderung akan menurunkan kualitas wine.

Intercept bertujuan untuk fungsi logit kumulatif guna membentuk batas antar kategori ordinal. Angka-angka yang muncul menunjukkan batas pemisah antara kelas kualitas.

Evaluasi Model

pred_ordinal <- predict(model_ordinal, newdata = wine_scaled)
conf_matrix_ordinal <- table(Predicted = pred_ordinal, Actual = wine_scaled$quality)
conf_matrix_ordinal
##          Actual
## Predicted   3   4   5   6   7   8
##         3   0   0   0   0   0   0
##         4   0   0   0   0   0   0
##         5   6  22 361 147   4   0
##         6   0  11 120 290  95   9
##         7   0   0   1  25  44   7
##         8   0   0   1   0   0   0
conf_df_ordinal <- as.data.frame(conf_matrix_ordinal)
ggplot(conf_df_ordinal, aes(x = Actual, y = Predicted, fill = Freq)) +
  geom_tile(color = "white") +
  geom_text(aes(label = Freq), color = "white", size = 5) +
  scale_fill_gradient(low = "lightgreen", high = "darkgreen") +
  ggtitle("Confusion Matrix - Ordinal Logistic Regression") +
  theme_minimal()

accuracy_ordinal <- sum(diag(conf_matrix_ordinal)) / sum(conf_matrix_ordinal)
cat("Akurasi model ordinal:", round(accuracy_ordinal * 100, 2), "%\n")
## Akurasi model ordinal: 60.8 %

Nilai akurasi tidak terlalu tinggi dengan akurasi sebesar 60,8%, hal ini bisa terjadi karena distribusi kualitas yang kurang seimbang dan belum adanya pre processing pada data tersebut.

Dari model di atas bisa ditangkap bahwa ‘alcohol’ , ‘volatile.acidity’ dan ‘sulphates’ adalah prediktor yang signifikan.