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.1 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.1
## ✔ purrr 1.0.2
## ── 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(caret)
## Warning: package 'caret' was built under R version 4.4.2
## Loading required package: lattice
##
## Attaching package: 'caret'
##
## The following object is masked from 'package:purrr':
##
## lift
library(ggplot2)
library(MASS)
##
## Attaching package: 'MASS'
##
## The following object is masked from 'package:dplyr':
##
## select
library(rsample)
## Warning: package 'rsample' was built under R version 4.4.2
library(Metrics)
## Warning: package 'Metrics' was built under R version 4.4.2
##
## Attaching package: 'Metrics'
##
## The following objects are masked from 'package:caret':
##
## precision, recall
data <- read.csv("C:/Users/Delia/Downloads/Bootcamp STK/Dataset.csv")
head(data)
## Student.ID Date Class.Time Attendance.Status Stress.Level..GSR.
## 1 1 2024-12-01 9:00-15:00 Late 0.92
## 2 1 2024-12-02 8:00-16:00 Late 1.17
## 3 1 2024-12-03 11:00-14:00 Late 4.56
## 4 1 2024-12-04 11:00-16:00 Late 3.07
## 5 1 2024-12-05 9:00-13:00 Absent 3.93
## 6 1 2024-12-06 8:00-14:00 Present 4.96
## Sleep.Hours Anxiety.Level Mood.Score Risk.Level
## 1 7.6 6 6 Low
## 2 6.0 6 2 Medium
## 3 6.3 4 8 High
## 4 9.0 2 10 Low
## 5 7.4 9 4 High
## 6 6.6 5 9 High
### Mengonversi Risk Level menjadi numerik
data$risk.level <- as.numeric(factor(data$Risk.Level, levels = c("Low", "Medium", "High")))
### Mengonversi Attendance Status menjadi numerik
data$Attendance.Status <- as.numeric(factor(data$Attendance.Status, levels = c("Absent", "Late", "Present")))
head(data)
## Student.ID Date Class.Time Attendance.Status Stress.Level..GSR.
## 1 1 2024-12-01 9:00-15:00 2 0.92
## 2 1 2024-12-02 8:00-16:00 2 1.17
## 3 1 2024-12-03 11:00-14:00 2 4.56
## 4 1 2024-12-04 11:00-16:00 2 3.07
## 5 1 2024-12-05 9:00-13:00 1 3.93
## 6 1 2024-12-06 8:00-14:00 3 4.96
## Sleep.Hours Anxiety.Level Mood.Score Risk.Level risk.level
## 1 7.6 6 6 Low 1
## 2 6.0 6 2 Medium 2
## 3 6.3 4 8 High 3
## 4 9.0 2 10 Low 1
## 5 7.4 9 4 High 3
## 6 6.6 5 9 High 3
set.seed(123)
data.split <- initial_split(data, prop = 0.8)
train.data <- training(data.split)
test.data <- testing(data.split)
### Regresi Linear Sederhana (Menggunakan 1 prediktor utama)
model.sederhana <- lm(risk.level ~ Stress.Level..GSR., data = train.data)
model.sederhana
##
## Call:
## lm(formula = risk.level ~ Stress.Level..GSR., data = train.data)
##
## Coefficients:
## (Intercept) Stress.Level..GSR.
## 1.5487 0.2888
### Regresi Linear Berganda (Menggunakan beberapa prediktor)
model.berganda <- lm(risk.level ~ Stress.Level..GSR. + Sleep.Hours + Anxiety.Level + Mood.Score + Attendance.Status, data = train.data)
model.berganda
##
## Call:
## lm(formula = risk.level ~ Stress.Level..GSR. + Sleep.Hours +
## Anxiety.Level + Mood.Score + Attendance.Status, data = train.data)
##
## Coefficients:
## (Intercept) Stress.Level..GSR. Sleep.Hours Anxiety.Level
## 2.446390 0.289772 0.005741 0.042535
## Mood.Score Attendance.Status
## -0.035056 -0.493294
### Regresi Polinomial (Derajat 2 pada Stress Level)
model.poly <- lm(risk.level ~ Stress.Level..GSR. + I(Stress.Level..GSR.^2), data = train.data)
model.poly
##
## Call:
## lm(formula = risk.level ~ Stress.Level..GSR. + I(Stress.Level..GSR.^2),
## data = train.data)
##
## Coefficients:
## (Intercept) Stress.Level..GSR. I(Stress.Level..GSR.^2)
## 2.1958 -0.3167 0.1100
calculate_metrics <- function(model, test.data) {
predictions <- predict(model, newdata = test.data)
r2 <- cor(predictions, test.data$risk.level)^2
rmse.val <- rmse(test.data$risk.level, predictions)
return(c(R2 = r2, RMSE = rmse.val))
}
metrics.sederhana <- calculate_metrics(model.sederhana, test.data)
metrics.berganda <- calculate_metrics(model.berganda, test.data)
metrics.poly <- calculate_metrics(model.poly, test.data)
### tabel perbandingan
comparison.table <- rbind(
"Model Sederhana"= metrics.sederhana,
"Model Berganda"= metrics.berganda,
"Model Polinomial"= metrics.poly)
cat("Perbandingan Model:\n")
## Perbandingan Model:
print(round(comparison.table, 4))
## R2 RMSE
## Model Sederhana 0.2257 0.7296
## Model Berganda 0.5148 0.5777
## Model Polinomial 0.2744 0.7064
metrics.df <- data.frame(
Model = c("Sederhana", "Berganda", "Polinomial"),
R2 = c(metrics.sederhana["R2"], metrics.berganda["R2"], metrics.poly["R2"]),
RMSE = c(metrics.sederhana["RMSE"], metrics.berganda["RMSE"], metrics.poly["RMSE"])
)
print(metrics.df)
## Model R2 RMSE
## 1 Sederhana 0.2257387 0.7296106
## 2 Berganda 0.5148448 0.5776815
## 3 Polinomial 0.2744335 0.7063597
par(mfrow = c(1,1))
barplot(metrics.df$R2, names.arg = metrics.df$Model, col = "blue", main = "Perbandingan R-squared")
barplot(metrics.df$RMSE, names.arg = metrics.df$Model, col = "red", main = "Perbandingan RMSE")
interpretasi : Grafik diatas menunjukkan perbandingan R-squared dan RMSE
untuk model Sederhana, Berganda, dan Polinomial. Model Berganda
memiliki nilai R-squared tertinggi, menunjukkan bahwa model ini
lebih baik dalam menjelaskan variasi data dibandingkan model lainnya.
Namun, model Sederhana dan Polinomial memiliki R-squared yang lebih
rendah, mengindikasikan bahwa keduanya kurang mampu menangkap pola dalam
data. Dari sisi RMSE, model Berganda memiliki nilai
terendah, menandakan bahwa prediksinya lebih akurat dibandingkan
model lainnya, sementara model Sederhana dan Polinomial memiliki RMSE
yang lebih tinggi dan hampir setara, menunjukkan tingkat kesalahan
prediksi yang lebih besar.
best.r2 <- which.max(comparison.table[,1])
best.rmse <- which.min(comparison.table[,2])
cat("\nBerdasarkan R-squared tertinggi:")
##
## Berdasarkan R-squared tertinggi:
cat("\nModel terbaik adalah:",rownames(comparison.table) [best.r2])
##
## Model terbaik adalah: Model Berganda
cat("\nNilai R-squared:",round(comparison.table[best.r2,1],4))
##
## Nilai R-squared: 0.5148
cat("\n\nBerdasarkan RMSE terendah:")
##
##
## Berdasarkan RMSE terendah:
cat("\nModel terbaik adalah:", rownames(comparison.table)
[best.rmse])
##
## Model terbaik adalah: Model Berganda
cat("\nNilai RMSE:", round(comparison.table[best.rmse,2], 4))
##
## Nilai RMSE: 0.5777
best.model <- ifelse(metrics.sederhana["R2"] > metrics.berganda["R2"] & metrics.sederhana["R2"] > metrics.poly["R2"],
"Sederhana",
ifelse(metrics.berganda["R2"] > metrics.poly["R2"], "Berganda", "Polinomial"))
best.model.fit <- switch(best.model,
"Sederhana" = model.sederhana,
"Berganda" = model.berganda,
"Polinomial" = model.poly)
test.data$predictions <- predict(best.model.fit, newdata = test.data)
ggplot(test.data, aes(x = risk.level, y = predictions)) +
geom_point(color = "blue") +
geom_abline(slope = 1, intercept = 0, color = "red", linetype = "dashed") +
ggtitle(paste("Prediksi vs Aktual untuk Model", best.model))
interpretasi : Grafik menunjukkan perbandingan antara nilai aktual
(risk.level) dan prediksi (predictions) dari Model Berganda. Titik-titik
biru mewakili hasil prediksi terhadap nilai aktual, sedangkan garis
merah putus-putus merupakan garis referensi ideal di mana prediksi sama
dengan nilai aktual. Terlihat bahwa meskipun terdapat pola peningkatan
prediksi seiring meningkatnya risk.level, banyak prediksi yang tersebar
dan tidak tepat berada di garis ideal, menunjukkan bahwa model masih
memiliki kesalahan dalam memprediksi beberapa nilai. Penyebaran yang
cukup besar pada setiap tingkat risiko mengindikasikan bahwa model
mungkin mengalami kesalahan prediksi yang cukup signifikan atau adanya
variasi yang belum sepenuhnya dijelaskan oleh model.
cat("Model terbaik adalah:", best.model, "\n")
## Model terbaik adalah: Berganda
cat("R-squared:", max(metrics.df$R2), "\n")
## R-squared: 0.5148448
cat("RMSE:", min(metrics.df$RMSE), "\n")
## RMSE: 0.5776815
Berdasarkan hasil analisis data kehadiran, tingkat stres, jam tidur, tingkat kecemasan, skor suasana hati, dan tingkat risiko, model Regresi Berganda dipilih sebagai model terbaik dengan R-squared sebesar 0.5148 dan RMSE sebesar 0.5777. Nilai R-squared menunjukkan bahwa model ini mampu menjelaskan sekitar 51.48% variasi dalam data, yang lebih baik dibandingkan model lainnya. Selain itu, nilai RMSE yang lebih rendah mengindikasikan bahwa model memiliki tingkat kesalahan prediksi yang lebih kecil dibandingkan model sederhana dan polinomial. Meskipun model belum sepenuhnya akurat, ia tetap memberikan hasil yang cukup baik dalam memprediksi Risk Level berdasarkan variabel-variabel yang digunakan.