Analisis ini menggunakan kombinasi Principal Component Analysis (PCA) dan Linear Discriminant Analysis (LDA) untuk memprediksi dan mengklasifikasikan nilai akhir siswa (G3) ke dalam kategori ordinal A–F. Dataset yang digunakan adalah student_performance.csv, yang berisi data dari siswa SMA di Portugal.
if (!require("MASS")) install.packages("MASS")
## Loading required package: MASS
if (!require("caret")) install.packages("caret")
## Loading required package: caret
## Loading required package: ggplot2
## Loading required package: lattice
if (!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 errors
if (!require("Metrics")) install.packages("Metrics")
## Loading required package: Metrics
##
## Attaching package: 'Metrics'
##
## The following objects are masked from 'package:caret':
##
## precision, recall
library(MASS)
library(caret)
library(tidyverse)
library(Metrics)
Menginstal dan memuat library yang dibutuhkan untuk modeling, pra-pemrosesan data, visualisasi, dan evaluasi performa model.
df <- read.csv("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 13
Dataset yang digunakan merupakan data performa akademik siswa dari dua sekolah menengah di Portugal. Dataset ini terdiri dari 649 observasi dengan 33 variabel, yang mencakup:
Fitur demografis: usia, jenis kelamin, status tinggal, ukuran keluarga
Fitur sosial-ekonomi: pekerjaan dan pendidikan orang tua, dukungan keluarga, akses internet.
Fitur akademik: kehadiran, jam belajar, nilai G1 dan G2 (nilai awal), serta nilai akhir G3.
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 katagori G3")
## Distribusi katagori G3
print(table(df$G3_kategori))
##
## F D C B A
## 100 201 154 112 82
cat("\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 ...
Pada tahap pra-pemrosesan, nilai akhir siswa (G3) dikategorikan ke dalam lima kelas ordinal yaitu A (16–20), B (14–15), C (12–13), D (10–11), dan F (0–9) menggunakan fungsi cut(). Proses ini bertujuan untuk menyesuaikan data dengan pendekatan klasifikasi ordinal. Selain itu, seluruh variabel bertipe karakter diubah menjadi faktor agar dapat dikenali oleh model statistik. Distribusi kategori hasil transformasi ditampilkan, dan struktur data diperiksa untuk memastikan tipe data yang sesuai.
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 training:", nrow(train_data), "\n")
## Jumlah data training: 521
cat("Jumlah data testing :", nrow(test_data), "\n")
## Jumlah data testing : 128
cat("\nDistribusi kategori G3 pada training set:\n")
##
## Distribusi kategori G3 pada training set:
print(table(train_data$G3_kategori))
##
## F D C B A
## 80 161 124 90 66
cat("\nDistribusi kategori G3 pada testing set:\n")
##
## Distribusi kategori G3 pada testing set:
print(table(test_data$G3_kategori))
##
## F D C B A
## 20 40 30 22 16
prop.table(table(train_data$G3_kategori))
##
## F D C B A
## 0.1535509 0.3090211 0.2380038 0.1727447 0.1266795
prop.table(table(test_data$G3_kategori))
##
## F D C B A
## 0.156250 0.312500 0.234375 0.171875 0.125000
Kode ini digunakan untuk membagi dataset menjadi data latih (80%) dan data uji (20%) secara proporsional berdasarkan kategori nilai akhir siswa (G3_kategori). Fungsi createDataPartition() memastikan setiap kelas (A–F) tetap terwakili secara seimbang di kedua subset. Setelah pembagian, kode menampilkan jumlah data pada masing-masing subset, distribusi kelas secara absolut, dan juga proporsi tiap kelas. Hal ini dilakukan untuk memastikan bahwa pembagian data tidak menyebabkan ketimpangan distribusi kelas yang bisa mempengaruhi performa model.
numeric_features <- train_data %>%
select(where(is.numeric)) %>%
select(-G3)
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.7374 1.4044 1.15002 1.12660 1.05699 1.00526 0.96451
## Proportion of Variance 0.2012 0.1315 0.08817 0.08462 0.07448 0.06737 0.06202
## Cumulative Proportion 0.2012 0.3327 0.42089 0.50551 0.57999 0.64736 0.70938
## PC8 PC9 PC10 PC11 PC12 PC13 PC14
## Standard deviation 0.91958 0.88323 0.86271 0.79221 0.73902 0.60561 0.5599
## Proportion of Variance 0.05638 0.05201 0.04962 0.04184 0.03641 0.02445 0.0209
## Cumulative Proportion 0.76576 0.81776 0.86738 0.90922 0.94563 0.97008 0.9910
## PC15
## Standard deviation 0.36788
## Proportion of Variance 0.00902
## Cumulative Proportion 1.00000
plot(pca_result, type = "l", main = "Scree Plot PCA")
Gambar scree plot di atas menunjukkan hasil eksplorasi Principal Component Analysis (PCA) terhadap fitur numerik dalam data. Plot ini menggambarkan seberapa besar proporsi variansi yang dijelaskan oleh masing-masing komponen utama. Terlihat bahwa komponen pertama hingga ketiga menjelaskan variansi paling besar, sedangkan komponen berikutnya menunjukkan penurunan kontribusi yang signifikan dan cenderung stabil. Hal ini menunjukkan adanya “elbow” pada komponen ke-3 hingga ke-4. Meskipun demikian, hingga komponen ke-10 masih memberikan kontribusi positif terhadap total variansi. Oleh karena itu, pemilihan 10 komponen utama dinilai tepat karena telah mencakup lebih dari 90% variansi total, memungkinkan reduksi dimensi tanpa kehilangan informasi penting secara signifikan.
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_kategori
Kode ini bertujuan untuk melakukan preprocessing data numerik dengan menerapkan proses standarisasi (center dan scale) serta reduksi dimensi menggunakan Principal Component Analysis (PCA). Fungsi preProcess() digunakan untuk menyiapkan objek transformasi dengan 10 komponen utama (pcaComp = 10) yang mencakup lebih dari 90% total variansi data. Selanjutnya, data latih (train_data) dan data uji (test_data) ditransformasi menggunakan fungsi predict() berdasarkan komponen utama yang telah dibentuk. Setelah transformasi, variabel target G3_kategori ditambahkan kembali ke masing-masing dataset hasil PCA agar model klasifikasi bisa dilatih dan diuji menggunakan data yang telah direduksi. Langkah ini penting untuk memastikan bahwa fitur masukan lebih ringkas namun tetap informatif.
lda_model <- lda(G3_kategori ~ ., data = train_pca)
lda_preds <- predict(lda_model, test_pca)$class
Melatih model Linear Discriminant Analysis (LDA) menggunakan komponen PCA sebagai prediktor.
cat("\n=== Evaluasi LDA dengan PCA ===\n")
##
## === Evaluasi LDA dengan PCA ===
lda_cm <- confusionMatrix(lda_preds, test_pca$G3_kategori)
print(lda_cm)
## Confusion Matrix and Statistics
##
## Reference
## Prediction F D C B A
## F 14 3 0 0 0
## D 6 29 6 1 0
## C 0 8 20 6 1
## B 0 0 3 11 5
## A 0 0 1 4 10
##
## Overall Statistics
##
## Accuracy : 0.6562
## 95% CI : (0.5672, 0.7379)
## No Information Rate : 0.3125
## P-Value [Acc > NIR] : 1.458e-15
##
## Kappa : 0.555
##
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: F Class: D Class: C Class: B Class: A
## Sensitivity 0.7000 0.7250 0.6667 0.50000 0.62500
## Specificity 0.9722 0.8523 0.8469 0.92453 0.95536
## Pos Pred Value 0.8235 0.6905 0.5714 0.57895 0.66667
## Neg Pred Value 0.9459 0.8721 0.8925 0.89908 0.94690
## Prevalence 0.1562 0.3125 0.2344 0.17188 0.12500
## Detection Rate 0.1094 0.2266 0.1562 0.08594 0.07812
## Detection Prevalence 0.1328 0.3281 0.2734 0.14844 0.11719
## Balanced Accuracy 0.8361 0.7886 0.7568 0.71226 0.79018
ordinal_scores <- setNames(0:4, c("F", "D", "C", "B", "A"))
lda_true <- as.numeric(recode(as.character(test_pca$G3_kategori), !!!ordinal_scores))
lda_pred <- as.numeric(recode(as.character(lda_preds), !!!ordinal_scores))
lda_mae <- mae(lda_true, lda_pred)
cat("LDA Mean Absolute Error (MAE):", lda_mae, "\n")
## LDA Mean Absolute Error (MAE): 0.3671875
Evaluasi model Linear Discriminant Analysis (LDA) setelah penerapan Principal Component Analysis (PCA) menunjukkan hasil yang cukup baik. Berdasarkan confusion matrix, model mampu mengklasifikasikan data dengan tingkat akurasi sebesar 65,62%, yang berarti sekitar dua pertiga dari prediksi model sesuai dengan label sebenarnya. Nilai Kappa sebesar 0.555 menunjukkan adanya tingkat kesepakatan sedang hingga kuat antara hasil prediksi model dengan data aktual, mengindikasikan bahwa performa model tidak hanya dipengaruhi oleh distribusi kelas yang tidak seimbang. Selain itu, nilai Mean Absolute Error (MAE) yang diperoleh sebesar 0.367 memperlihatkan bahwa rata-rata kesalahan prediksi berada kurang dari satu tingkat dari kelas sebenarnya, yang tergolong cukup baik dalam konteks klasifikasi ordinal. Statistik sensitivitas dan spesifisitas per kelas juga menunjukkan bahwa LDA mampu menangani kelas minoritas seperti A dan F dengan cukup stabil. Hasil ini mengindikasikan bahwa penerapan PCA tidak hanya membantu menyederhanakan struktur fitur, tetapi juga mampu mempertahankan, bahkan sedikit meningkatkan, performa klasifikasi model LDA.
Linear Discriminant Analysis (LDA) dengan Principal Component Analysis (PCA) menunjukkan bahwa pendekatan ini efektif dalam mengklasifikasikan performa akademik siswa ke dalam kategori ordinal (A–F). Setelah dilakukan reduksi dimensi melalui PCA dengan 10 komponen utama yang secara kumulatif menjelaskan lebih dari 90% variansi data model LDA yang dibangun menunjukkan akurasi sebesar 65,62% dan nilai Kappa sebesar 0.555, yang mencerminkan tingkat kesesuaian prediksi yang cukup baik terhadap data aktual. Nilai MAE (Mean Absolute Error) sebesar 0.367 mengindikasikan bahwa prediksi rata-rata hanya meleset sekitar satu tingkat kelas dari label sebenarnya.
Selain itu, model menunjukkan sensitivitas dan spesifisitas yang cukup seimbang di semua kelas, termasuk pada kelas minoritas seperti A dan F, yang biasanya sulit diprediksi dengan baik. Hal ini menunjukkan bahwa penggunaan PCA tidak hanya menyederhanakan kompleksitas data, tetapi juga menjaga (dan bahkan sedikit meningkatkan) performa klasifikasi dibandingkan LDA tanpa PCA. Dengan demikian, LDA dengan PCA dapat menjadi pendekatan yang efisien untuk prediksi performa siswa, terutama ketika jumlah fitur numerik cukup banyak dan berkorelasi, karena PCA berhasil menangkap informasi utama dari data tanpa kehilangan akurasi model secara signifikan.