Ordinal Logistic Regression (OLR) dengan PCA pada Prediksi Performa Siswa
Sheila Edistya Salsabilla (23031554056), Dewi Isarotul Azizah (23031554069), Fatimah Azzaroh Assegaf (23031554202)
Mata Kuliah: Analisis Multivariat
Dosen Pengampu: Ike Fitriyaningsih, M.Si.
2025-05-25
Analisis ini menggunakan kombinasi Principal Component Analysis (PCA) dan Ordinal Logistic Regression (OLR) untuk mengklasifikasikan nilai akhir siswa (G3) ke dalam kategori A–F. Data yang digunakan adalah student_performance.csv.
Install dan Load Package
if (!require("MASS")) install.packages("MASS")## Loading required package: MASSif (!require("caret")) install.packages("caret")## Loading required package: caret## Loading required package: ggplot2## Loading required package: latticeif (!require("tidyverse")) install.packages("tidyverse")## Loading required package: 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
## ✔ lubridate 1.9.4 ✔ tibble 3.2.1
## ✔ purrr 1.0.4 ✔ tidyr 1.3.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ✖ purrr::lift() masks caret::lift()
## ✖ dplyr::select() masks MASS::select()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorsif (!require("Metrics")) install.packages("Metrics")## Loading required package: Metrics
##
## Attaching package: 'Metrics'
##
## The following objects are masked from 'package:caret':
##
## precision, recalllibrary(MASS)
library(caret)
library(tidyverse)
library(Metrics)Menginstal dan memuat library yang dibutuhkan untuk modeling, pra-pemrosesan data, dan evaluasi performa model.
Baca Data
df <- read.csv("d:/Documents/student_performance.csv")
head(df)## school sex age address famsize Pstatus Medu Fedu Mjob Fjob reason
## 1 GP F 18 U GT3 A 4 4 at_home teacher course
## 2 GP F 17 U GT3 T 1 1 at_home other course
## 3 GP F 15 U LE3 T 1 1 at_home other other
## 4 GP F 15 U GT3 T 4 2 health services home
## 5 GP F 16 U GT3 T 3 3 other other home
## 6 GP M 16 U LE3 T 4 3 services other reputation
## guardian traveltime studytime failures schoolsup famsup paid activities
## 1 mother 2 2 0 yes no no no
## 2 father 1 2 0 no yes no no
## 3 mother 1 2 0 yes no no no
## 4 mother 1 3 0 no yes no yes
## 5 father 1 2 0 no yes no no
## 6 mother 1 2 0 no yes no yes
## nursery higher internet romantic famrel freetime goout Dalc Walc health
## 1 yes yes no no 4 3 4 1 1 3
## 2 no yes yes no 5 3 3 1 1 3
## 3 yes yes yes no 4 3 2 2 3 3
## 4 yes yes yes yes 3 2 2 1 1 5
## 5 yes yes no no 4 3 2 1 2 5
## 6 yes yes yes no 5 4 2 1 2 5
## absences G1 G2 G3
## 1 4 0 11 11
## 2 2 9 11 11
## 3 6 12 13 12
## 4 0 14 14 14
## 5 0 11 13 13
## 6 6 12 12 13Dataset yang digunakan berisi informasi mengenai siswa sekolah menengah di Portugal dan performa akademis mereka, khususnya dalam pelajaran Matematika. Setiap baris mewakili satu siswa, dengan berbagai fitur demografis, sosial, dan akademik yang dapat memengaruhi nilai akhir (G3).
Pre-processing
df$G3_kategori <- cut(
df$G3,
breaks = c(-1, 9, 11, 13, 15, 21),
labels = c("F", "D", "C", "B", "A"),
ordered_result = TRUE,
include.lowest = TRUE
)
df$G3_kategori <- factor(df$G3_kategori, ordered = TRUE)
df[sapply(df, is.character)] <- lapply(df[sapply(df, is.character)], as.factor)
cat("Distribusi kategori G3:\n")## Distribusi kategori G3:print(table(df$G3_kategori))##
## F D C B A
## 100 201 154 112 82cat("\nStruktur data setelah konversi karakter ke faktor:\n")##
## Struktur data setelah konversi karakter ke faktor:str(df[, sapply(df, is.factor)])## 'data.frame': 649 obs. of 18 variables:
## $ school : Factor w/ 2 levels "GP","MS": 1 1 1 1 1 1 1 1 1 1 ...
## $ sex : Factor w/ 2 levels "F","M": 1 1 1 1 1 2 2 1 2 2 ...
## $ 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 ...
## $ 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 ...
## $ 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 1 1 1 1 1 1 1 1 ...
## $ 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 ...
## $ G3_kategori: Ord.factor w/ 5 levels "F"<"D"<"C"<"B"<..: 2 2 3 4 3 3 3 3 5 3 ...Nilai akhir siswa (G3) dikonversi menjadi kategori G3_kategori dengan label A (nilai sangat tinggi) hingga F (nilai sangat rendah) menggunakan fungsi cut, untuk memudahkan analisis klasifikasi. Selanjutnya, seluruh kolom bertipe karakter dikonversi menjadi faktor agar dapat diperlakukan sebagai variabel kategorikal dalam proses pemodelan. Distribusi kategori menunjukkan mayoritas siswa berada pada kategori D dan C.
Split Data Menjadi Data Latih dan Uji
set.seed(123)
train_index <- createDataPartition(df$G3_kategori, p = 0.8, list = FALSE)
train_data <- df[train_index, ]
test_data <- df[-train_index, ]
cat("Jumlah data train:", nrow(train_data), "\n")## Jumlah data train: 521cat("Jumlah data test:", nrow(test_data), "\n")## Jumlah data test: 128prop.table(table(train_data$G3_kategori))##
## F D C B A
## 0.1535509 0.3090211 0.2380038 0.1727447 0.1266795prop.table(table(test_data$G3_kategori))##
## F D C B A
## 0.156250 0.312500 0.234375 0.171875 0.125000Data dibagi menjadi 80% data latih (521 siswa) dan 20% data uji (128 siswa) secara acak namun tetap mempertahankan proporsi distribusi kategori nilai akhir (G3_kategori). Proporsi tiap kategori seperti F, D, C, B, dan A pada data latih dan uji tetap seimbang, sehingga model dapat dilatih dan diuji secara adil tanpa bias terhadap kategori tertentu.
PCA Eksploratif untuk Analisis Variansi
numeric_features <- train_data %>%
select(where(is.numeric)) %>%
select(-c(G3, G1, G2))
pca_result <- prcomp(train_data[, names(numeric_features)], center = TRUE, scale. = TRUE)
cat("=== Ringkasan PCA Eksploratif ===\n")## === Ringkasan PCA Eksploratif ===print(summary(pca_result))## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 1.5044 1.3883 1.1456 1.06568 1.04091 0.96549 0.93794
## Proportion of Variance 0.1741 0.1483 0.1009 0.08736 0.08335 0.07171 0.06767
## Cumulative Proportion 0.1741 0.3224 0.4233 0.51066 0.59401 0.66572 0.73339
## PC8 PC9 PC10 PC11 PC12 PC13
## Standard deviation 0.90878 0.87294 0.80207 0.74444 0.6054 0.56037
## Proportion of Variance 0.06353 0.05862 0.04949 0.04263 0.0282 0.02415
## Cumulative Proportion 0.79692 0.85553 0.90502 0.94765 0.9758 1.00000plot(pca_result, type = "l", main = "Scree Plot PCA")
PCA dilakukan pada fitur numerik non-target untuk mengeksplorasi seberapa besar variansi yang dapat dijelaskan oleh komponen utama. Plot Scree dan ringkasan PCA menunjukkan bahwa komponen utama pertama (PC1) hingga ketiga (PC3) menyumbang sekitar 42% variasi data, dan hingga komponen ketujuh (PC7) mencakup sekitar 73% variasi total. Sepuluh komponen utama pertama secara keseluruhan telah menjelaskan lebih dari 90% variansi. Grafik scree menampilkan penurunan tajam dari PC1 ke PC3 lalu melandai, yang mengindikasikan bahwa sebagian besar informasi dapat direpresentasikan dengan 3–7 komponen utama. PCA ini membantu mereduksi dimensi data numerik sebelum masuk ke tahap modeling.
PCA untuk Modelling
preProc <- preProcess(train_data[, names(numeric_features)],
method = c("center", "scale", "pca"),
pcaComp = 10)
train_pca <- predict(preProc, train_data[, names(numeric_features)])
test_pca <- predict(preProc, test_data[, names(numeric_features)])
train_pca$G3_kategori <- train_data$G3_kategori
test_pca$G3_kategori <- test_data$G3_kategoriKode ini melakukan preprocessing data numerik pada train_data dan test_data dengan menggunakan metode standarisasi (center dan scale) lalu mengaplikasikan Principal Component Analysis (PCA) untuk mereduksi dimensi menjadi 10 komponen utama. Setelah model PCA dibuat dengan fungsi preProcess, data latih dan data uji diproyeksikan ke ruang PCA tersebut menggunakan predict. Kemudian, variabel target G3_kategori ditambahkan kembali ke data hasil transformasi agar siap digunakan untuk modelling selanjutnya.
Latih Model OLR dengan PCA
olr_pca_model <- polr(G3_kategori ~ ., data = train_pca, Hess = TRUE)
olr_pca_preds <- predict(olr_pca_model, newdata = test_pca)Melatih model Ordinal Logistic Regression (OLR) menggunakan komponen PCA sebagai prediktor.
Evaluasi Model
cat("\n=== Evaluasi OLR dengan PCA ===\n")##
## === Evaluasi OLR dengan PCA ===olr_cm <- confusionMatrix(olr_pca_preds, test_pca$G3_kategori)
print(olr_cm)## Confusion Matrix and Statistics
##
## Reference
## Prediction F D C B A
## F 4 2 0 0 0
## D 12 22 13 10 4
## C 4 14 12 8 5
## B 0 1 2 4 3
## A 0 1 3 0 4
##
## Overall Statistics
##
## Accuracy : 0.3594
## 95% CI : (0.2765, 0.4489)
## No Information Rate : 0.3125
## P-Value [Acc > NIR] : 0.1473
##
## Kappa : 0.1387
##
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: F Class: D Class: C Class: B Class: A
## Sensitivity 0.20000 0.5500 0.40000 0.18182 0.25000
## Specificity 0.98148 0.5568 0.68367 0.94340 0.96429
## Pos Pred Value 0.66667 0.3607 0.27907 0.40000 0.50000
## Neg Pred Value 0.86885 0.7313 0.78824 0.84746 0.90000
## Prevalence 0.15625 0.3125 0.23438 0.17188 0.12500
## Detection Rate 0.03125 0.1719 0.09375 0.03125 0.03125
## Detection Prevalence 0.04688 0.4766 0.33594 0.07812 0.06250
## Balanced Accuracy 0.59074 0.5534 0.54184 0.56261 0.60714ordinal_scores <- setNames(0:4, c("F", "D", "C", "B", "A"))
olr_true <- as.numeric(recode(as.character(test_pca$G3_kategori), !!!ordinal_scores))
olr_pred <- as.numeric(recode(as.character(olr_pca_preds), !!!ordinal_scores))
olr_mae <- mae(olr_true, olr_pred)
cat("OLR Mean Absolute Error (MAE):", olr_mae, "\n")## OLR Mean Absolute Error (MAE): 0.8984375Kode ini melakukan evaluasi model Ordinal Logistic Regression (OLR) yang diprediksi menggunakan data hasil transformasi PCA. Pertama, dibuat confusion matrix dengan fungsi confusionMatrix() untuk membandingkan prediksi model (olr_pca_preds) terhadap label asli (test_pca$G3_kategori), sehingga dapat dilihat performa klasifikasi dari segi akurasi dan statistik lainnya. Akurasi model tercatat sebesar 35.94%, sedikit lebih baik dari tebakan acak (No Information Rate/NIR sebesar 31.25%).
Selanjutnya, kategori kelas yang awalnya berupa huruf (F, D, C, B, A) diubah menjadi skor numerik 0 sampai 4 menggunakan recode(). Dari skor ini dihitung Mean Absolute Error (MAE) sebesar 0.898, yang menunjukkan rata-rata kesalahan prediksi ordinal kurang dari 1 kategori, artinya model cukup akurat dalam memprediksi urutan kelas.
Analisis lebih detail dari confusion matrix menunjukkan model lebih kuat mengenali kategori “D”, tetapi cenderung bingung membedakan kelas yang berdekatan seperti “C” dan “B”. Dengan demikian, meskipun model sudah mampu menangkap pola ordinal, ada kesulitan dalam membedakan kelas yang tingkatannya berdekatan.
Kesimpulan
Pendekatan kombinasi PCA dan Ordinal Logistic Regression mampu menangkap pola ordinal pada data nilai akhir siswa dengan performa yang sedikit lebih baik dibanding tebakan acak. Meskipun akurasi keseluruhan masih terbatas di sekitar 36%, model menunjukkan kemampuan yang cukup baik dalam memprediksi urutan kategori nilai dengan rata-rata kesalahan (MAE) kurang dari 1 tingkat kelas. Namun, model masih perlu perbaikan untuk membedakan kelas-kelas yang berdekatan agar prediksi lebih akurat dan konsisten.