Mata Kuliah: Analisis Multivariat
Dosen Pengampu: Ike Fitriyaningsih, M.Si.
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, visualisasi, dan evaluasi performa model.
df <- read.csv("C:/Users/ASUS/Documents/UNESA SEMESTER 4/ANMUL/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 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)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: 521cat("Jumlah data testing :", nrow(test_data), "\n")## Jumlah data testing : 128cat("\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 66cat("\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 16prop.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.125000Kode 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.
lda_model <- lda(G3_kategori ~ . -G3, data = train_data)
lda_preds <- predict(lda_model, test_data)$classCode diatas menunjukan model LDA
cat("=== Confusion Matrix LDA ===\n")## === Confusion Matrix LDA ===lda_cm <- confusionMatrix(lda_preds, test_data$G3_kategori)
print(lda_cm)## Confusion Matrix and Statistics
##
## Reference
## Prediction F D C B A
## F 15 6 0 0 0
## D 5 24 6 1 0
## C 0 10 21 8 1
## B 0 0 3 10 5
## A 0 0 0 3 10
##
## Overall Statistics
##
## Accuracy : 0.625
## 95% CI : (0.5351, 0.709)
## No Information Rate : 0.3125
## P-Value [Acc > NIR] : 3.54e-13
##
## Kappa : 0.517
##
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: F Class: D Class: C Class: B Class: A
## Sensitivity 0.7500 0.6000 0.7000 0.45455 0.62500
## Specificity 0.9444 0.8636 0.8061 0.92453 0.97321
## Pos Pred Value 0.7143 0.6667 0.5250 0.55556 0.76923
## Neg Pred Value 0.9533 0.8261 0.8977 0.89091 0.94783
## Prevalence 0.1562 0.3125 0.2344 0.17188 0.12500
## Detection Rate 0.1172 0.1875 0.1641 0.07812 0.07812
## Detection Prevalence 0.1641 0.2812 0.3125 0.14062 0.10156
## Balanced Accuracy 0.8472 0.7318 0.7531 0.68954 0.79911# Konversi ke skor ordinal
ordinal_scores <- setNames(0:4, c("F", "D", "C", "B", "A"))
lda_true <- as.numeric(recode(as.character(test_data$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.390625Bagian ini mengubah label kategori (F, D, C, B, A) menjadi skor numerik ordinal (0 sampai 4). Setelah itu, dihitung Mean Absolute Error (MAE), yang menunjukkan rata-rata jarak kesalahan antara prediksi dan label aktual dalam skala ordinal. Degan nilai MAE 0.390625, maka artinya, secara rata-rata, prediksi LDA hanya meleset kurang dari setengah tingkat kategori dari nilai seharusnya. Ini menunjukkan bahwa model sangat baik dalam memahami urutan performa siswa, dan prediksi yang keliru pun umumnya tidak terlalu jauh dari label aslinya.
cat("\n=== Fitur Penting LDA ===\n")##
## === Fitur Penting LDA ===print(lda_model$scaling[order(abs(lda_model$scaling[,1]), decreasing = TRUE), , drop = FALSE])## LD1 LD2 LD3 LD4
## G2 0.501339372 0.10932578 0.108980293 -0.02254538
## sexM -0.338153303 -0.19476566 0.524473238 0.44367819
## G1 0.337740126 0.05963747 -0.065300307 0.14479709
## Mjobservices 0.322609694 -0.41092240 -0.788591058 -0.46336208
## activitiesyes 0.286403001 -0.27615111 -0.609704012 -0.04356003
## higheryes 0.260923116 -0.99503613 0.611611904 -0.21543873
## Fjobservices -0.259437967 0.61677700 -0.915248482 0.78869027
## Mjobteacher 0.255664164 -0.76165671 -0.001413548 -0.21599479
## Mjobhealth 0.254164883 0.37572323 -0.143217563 -0.65121335
## schoolsupyes -0.238480439 -0.59499599 -0.076349029 1.62624250
## Fjobother -0.226522865 0.11538383 -0.728019656 0.47124708
## Mjobother 0.217410824 -0.59242838 -0.912324096 0.10438909
## schoolMS -0.208386786 1.04326753 -0.644892622 0.28790646
## guardianother -0.208071727 -0.53651568 -0.366515759 0.10694484
## age 0.203606948 0.13822596 0.102364701 0.11641784
## guardianmother -0.173761777 0.41619610 -0.026956647 0.08469545
## PstatusT -0.164046560 0.12151996 -0.077199898 0.11965203
## failures -0.146219316 0.89098665 -0.436234471 0.15919219
## paidyes -0.130217942 -0.42973737 -1.405593667 0.32969447
## Fjobhealth 0.129174631 0.45548444 -1.457273878 2.02270021
## reasonother 0.113624021 0.09736365 0.205643967 -0.18548490
## famsizeLE3 -0.107959841 -0.24586405 0.121566677 0.25770755
## famrel 0.061916030 -0.04265702 -0.122704603 -0.02992442
## addressU 0.054532304 0.03042587 -0.023911764 -0.01260145
## reasonreputation 0.054332950 0.35424087 0.045164641 0.05659630
## Medu 0.051676573 0.21184361 0.012001053 0.01117473
## nurseryyes 0.047641664 0.04289217 -0.407578426 -0.85207403
## goout -0.046313071 0.05106301 0.156361850 0.31982786
## health -0.046287632 -0.01142074 0.202661778 0.19611415
## Fjobteacher 0.037696073 1.24666716 -1.266809303 0.72840824
## studytime -0.035560698 0.06442415 -0.086380908 -0.22323424
## freetime -0.030919812 0.14309936 0.136948312 -0.43297887
## absences -0.030151654 0.01928876 0.074719364 -0.04507213
## Walc 0.025532939 -0.07189400 -0.287805909 -0.10522333
## internetyes 0.022908002 0.07472966 -0.192453164 -0.27281129
## famsupyes -0.020597141 -0.10189915 -0.089922366 0.44104238
## Fedu -0.020488477 -0.24294283 -0.239412342 -0.12267782
## traveltime 0.018202677 0.11394832 0.429672289 -0.12205157
## romanticyes -0.016455145 -0.15102680 -0.293112674 0.05766945
## Dalc 0.012698161 0.24768817 0.332636141 0.28234393
## reasonhome -0.004531899 -0.07533781 -0.205442901 0.29093557Model LDA berhasil menunjukkan performa yang jauh lebih baik dari acak, dengan akurasi tinggi dan MAE yang rendah. Ini menunjukkan bahwa model tidak hanya mampu memisahkan kategori secara umum, tapi juga menghormati sifat ordinal dari kategori (dari F ke A). Meskipun masih terdapat kesalahan, terutama dalam membedakan kelas yang berdekatan seperti C dan B, performa model secara keseluruhan dapat dianggap sangat memuaskan.