Interpretasi Ordinal Logistic Regression Pada data Balance Scale

Install jika belum terpasang

# Load library
library(MASS)

## Warning: package 'MASS' was built under R version 4.4.3

library(ggplot2)

## Warning: package 'ggplot2' was built under R version 4.4.2

library(tidyr)

## Warning: package 'tidyr' was built under R version 4.4.2

Baca data

mydata <- as.data.frame(read.csv("C:/Users/shoba/OneDrive/Dokumen/Annas/TUGAS KULIAH/SEMESTER 4/ANALISIS MULTIVARIAT/TUGAS MULTINOMIAL & ORDINAL LOGISTIC REGRESSION/balance_scale.csv"))

# Ubah kolom class menjadi faktor ordinal
mydata$class <- factor(mydata$class, ordered = TRUE, levels = c("L", "B", "R"))

Model ordinal logistic regression

model <- polr(class ~ right.distance + right.weight + left.distance + left.weight, data = mydata, Hess = TRUE)

Menampilkan hasil dari ordinal logistic regression

# Prediksi kelas pada data asli
predicted_class <- predict(model, newdata = mydata)

# Bandingkan dengan kelas asli
conf_matrix <- table(Predicted = predicted_class, Actual = mydata$class)

# Tampilkan confusion matrix
print(conf_matrix)

##          Actual
## Predicted   L   B   R
##         L 264   2   4
##         B  20  45  20
##         R   4   2 264

summary(model)

## Call:
## polr(formula = class ~ right.distance + right.weight + left.distance + 
##     left.weight, data = mydata, Hess = TRUE)
## 
## Coefficients:
##                 Value Std. Error t value
## right.distance  3.459     0.3225   10.73
## right.weight    3.459     0.3225   10.73
## left.distance  -3.459     0.3225  -10.73
## left.weight    -3.459     0.3225  -10.73
## 
## Intercepts:
##     Value    Std. Error t value 
## L|B  -0.9226   0.6302    -1.4640
## B|R   0.9229   0.6302     1.4645
## 
## Residual Deviance: 292.2212 
## AIC: 304.2212

Menghitung Akurasi

# Hitung akurasi
accuracy <- sum(diag(conf_matrix)) / sum(conf_matrix)
cat("Akurasi model:", round(accuracy * 100, 2), "%\n")

## Akurasi model: 91.68 %

Plot

Buat data grid untuk prediksi berdasarkan left.distance

new_data <- data.frame(
  left.distance = seq(min(mydata$left.distance), max(mydata$left.distance), length.out = 100),
  right.distance = mean(mydata$right.distance),
  right.weight = mean(mydata$right.weight),
  left.weight = mean(mydata$left.weight)
)

# Prediksi probabilitas
probs <- predict(model, newdata = new_data, type = "probs")

# Gabungkan hasil dengan data
plot_data <- cbind(new_data, probs)

# Ubah format ke long format untuk ggplot
plot_long <- pivot_longer(plot_data, cols = c("L", "B", "R"),
                          names_to = "class", values_to = "probability")

# Plot
# Menampilkan Pengaruh dari Left Distance
ggplot(plot_long, aes(x = left.distance, y = probability, color = class)) +
  geom_line(size = 1.2) +
  labs(
    title = "Prediksi Probabilitas Kelas Berdasarkan left.distance",
    x = "Left Distance",
    y = "Predicted Probability",
    color = "Kelas"
  ) +
  theme_minimal()

## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

Plot

Menampilkan Pengaruh dari Right Distance

Buat data grid untuk prediksi berdasarkan Right Distance

new_data <- data.frame(
  left.distance = mean(mydata$left.distance),
  right.distance = seq(min(mydata$right.distance), max(mydata$right.distance), length.out = 100),
  right.weight = mean(mydata$right.weight),
  left.weight = mean(mydata$left.weight)
)


# Prediksi probabilitas
probs <- predict(model, newdata = new_data, type = "probs")

# Gabungkan hasil dengan data
plot_data <- cbind(new_data, probs)

# Ubah format ke long format untuk ggplot
plot_long <- pivot_longer(plot_data, cols = c("L", "B", "R"),
                          names_to = "class", values_to = "probability")

ggplot(plot_long, aes(x = right.distance, y = probability, color = class)) +
  geom_line(size = 1.2) +
  labs(
    title = "Prediksi Probabilitas Kelas Berdasarkan right.distance",
    x = "Right Distance",
    y = "Predicted Probability",
    color = "Kelas"
  ) +
  theme_minimal()

1. Penjelasan Data

Nama Dataset: Balance Scale Data Set
Sumber: UCI Machine Learning Repository
Tentang: Keputusan apakah seimbang atau tidak ditentukan oleh berat (weight)
dan jarak (distance) di masing-masing sisi.

Isi Data:

• Fitur Prediktor:
  • left.weight  : Berat di sisi kiri
    
  • left.distance : Jarak berat di sisi kiri dari pusat
    
  • right.weight : Berat di sisi kanan
    
  • right.distance: Jarak berat di sisi kanan dari pusat
• Fitur Target:
  • class : Status keseimbangan
    • L = miring kiri
      
    • B = seimbang
      
    • R = miring kanan

2. Kesimpulan

• right.distance dan right.weight mempunyai koefisien positif
  ➔ Semakin besar jarak/berat kanan, semakin besar peluang untuk miring ke kanan (R).

• left.distance dan left.weight mempunyai koefisien negatif
  ➔ Semakin besar jarak/berat kiri, semakin besar peluang untuk miring ke kiri (L).

• Nilai t-value yang besar (positif atau negatif) menunjukkan bahwa prediktor tersebut berkontribusi signifikan terhadap model.
  Dalam praktik umum, nilai t-value > 2 atau < -2 dianggap signifikan pada tingkat kepercayaan 95%.
  Nilai ±10.73 jauh melebihi ambang ini, memperkuat kesimpulan bahwa variabel tersebut penting.

• Cutpoints adalah ambang batas untuk berpindah antar kategori ordinal:

  • L|B: batas antara miring kiri dan seimbang.
  • B|R: batas antara seimbang dan miring kanan.

• Simetri cutpoints menunjukkan bahwa ketiga kategori memiliki distribusi yang relatif seimbang dalam data,
  sehingga model tidak berat sebelah dalam memprediksi salah satu kelas.

• Karena model ini bersifat ordinal, bukan nominal, arah urutan kelas sangat penting.
  Maka, perubahan prediktor memengaruhi probabilitas berpindah ke kategori yang lebih tinggi atau lebih rendah secara teratur, bukan acak.

• Akurasi model sangat tinggi, mencapai 91,68%,
  yang menandakan bahwa model ini mampu memprediksi dengan benar 91,68% dari data yang ada.