Analisis pada modul ini bertujuan untuk mengeksplorasi data serta menerapkan metode regresi logistik ordinal dalam mengidentifikasi faktor-faktor yang memengaruhi tingkat adaptivitas mahasiswa dalam pembelajaran online. Pendekatan ini digunakan karena variabel dependen memiliki sifat berurutan, yaitu tingkat adaptivitas yang dikategorikan menjadi Low, Moderate, dan High.
Dataset yang digunakan adalah Students Adaptability Level in Online Education Dataset, yang memuat informasi mengenai karakteristik mahasiswa seperti gender, tingkat pendidikan, kondisi finansial, jenis institusi, jenis internet, tipe jaringan, serta perangkat yang digunakan. Data tersebut digunakan untuk memahami bagaimana faktor-faktor tersebut berpengaruh terhadap tingkat adaptivitas mahasiswa dalam proses pembelajaran daring.
Link Dataset: https://www.kaggle.com/datasets/mdmahmudulhasansuzan/students-adaptability-level-in-online-education
data <- read.csv("students_adaptability_level_online_education.csv")
head(data)
## Gender Age Education.Level Institution.Type IT.Student Location
## 1 Boy 21-25 University Non Government No Yes
## 2 Girl 21-25 University Non Government No Yes
## 3 Girl 16-20 College Government No Yes
## 4 Girl 11-15 School Non Government No Yes
## 5 Girl 16-20 School Non Government No Yes
## 6 Boy 11-15 School Non Government No Yes
## Load.shedding Financial.Condition Internet.Type Network.Type Class.Duration
## 1 Low Mid Wifi 4G 3-6
## 2 High Mid Mobile Data 4G 1-3
## 3 Low Mid Wifi 4G 1-3
## 4 Low Mid Mobile Data 4G 1-3
## 5 Low Poor Mobile Data 3G 0
## 6 Low Poor Mobile Data 3G 1-3
## Self.Lms Device Adaptivity.Level
## 1 No Tab Moderate
## 2 Yes Mobile Moderate
## 3 No Mobile Moderate
## 4 No Mobile Moderate
## 5 No Mobile Low
## 6 No Mobile Low
data$Adaptivity.Level <- factor(data$Adaptivity.Level,
levels = c("Low","Moderate","High"),
ordered = TRUE)
data$Gender <- factor(data$Gender)
data$Education.Level <- factor(data$Education.Level)
data$Institution.Type <- factor(data$Institution.Type)
data$Financial.Condition <- factor(data$Financial.Condition)
data$Internet.Type <- factor(data$Internet.Type)
data$Network.Type <- factor(data$Network.Type)
data$Device <- factor(data$Device)
data$Age <- NULL
data <- droplevels(data)
barplot(table(data$Adaptivity.Level),
main = "Distribusi Adaptivity Level",
col = "lightblue")
barplot(table(data$Adaptivity.Level, data$Gender),
beside = TRUE,
legend = TRUE,
col = c("skyblue", "orange", "green"),
main = "Adaptivity berdasarkan Gender")
barplot(table(data$Adaptivity.Level, data$Education.Level),
beside = TRUE,
col = c("#66c2a5", "#fc8d62", "#8da0cb"),
main = "Adaptivity berdasarkan Education Level")
legend("topright",
legend = levels(data$Adaptivity.Level),
fill = c("#66c2a5", "#fc8d62", "#8da0cb"))
model_lm <- lm(as.numeric(Adaptivity.Level) ~
Education.Level + Internet.Type + Device,
data = data)
vif(model_lm)
## GVIF Df GVIF^(1/(2*Df))
## Education.Level 1.326435 2 1.073177
## Internet.Type 1.282853 1 1.132631
## Device 1.466955 2 1.100536
model_ordinal <- polr(Adaptivity.Level ~
Gender + Education.Level +
Institution.Type + Financial.Condition +
Internet.Type + Network.Type + Device,
data = data,
Hess = TRUE)
summary(model_ordinal)
## Call:
## polr(formula = Adaptivity.Level ~ Gender + Education.Level +
## Institution.Type + Financial.Condition + Internet.Type +
## Network.Type + Device, data = data, Hess = TRUE)
##
## Coefficients:
## Value Std. Error t value
## GenderGirl -0.4115 0.1255 -3.2775
## Education.LevelSchool 0.2769 0.1887 1.4674
## Education.LevelUniversity 0.2153 0.1885 1.1421
## Institution.TypeNon Government 1.3864 0.1472 9.4169
## Financial.ConditionPoor -0.4795 0.1595 -3.0067
## Financial.ConditionRich 2.6251 0.2663 9.8593
## Internet.TypeWifi -0.3653 0.1503 -2.4297
## Network.Type3G 1.2709 0.6661 1.9079
## Network.Type4G 1.8205 0.6612 2.7533
## DeviceMobile -0.6012 0.2141 -2.8079
## DeviceTab 0.3629 0.4014 0.9039
##
## Intercepts:
## Value Std. Error t value
## Low|Moderate 1.4764 0.7276 2.0291
## Moderate|High 4.9023 0.7385 6.6385
##
## Residual Deviance: 1902.218
## AIC: 1928.218
ctable <- coef(summary(model_ordinal))
p_value <- pnorm(abs(ctable[, "t value"]), lower.tail = FALSE) * 2
cbind(ctable, p_value)
## Value Std. Error t value p_value
## GenderGirl -0.4114855 0.1255477 -3.2775230 1.047222e-03
## Education.LevelSchool 0.2768816 0.1886823 1.4674488 1.422540e-01
## Education.LevelUniversity 0.2152952 0.1885078 1.1421020 2.534116e-01
## Institution.TypeNon Government 1.3864173 0.1472260 9.4169343 4.644506e-21
## Financial.ConditionPoor -0.4794954 0.1594753 -3.0067058 2.640952e-03
## Financial.ConditionRich 2.6250574 0.2662520 9.8592980 6.248474e-23
## Internet.TypeWifi -0.3652931 0.1503434 -2.4297247 1.511030e-02
## Network.Type3G 1.2708973 0.6661090 1.9079420 5.639872e-02
## Network.Type4G 1.8205140 0.6611999 2.7533487 5.898902e-03
## DeviceMobile -0.6012173 0.2141127 -2.8079480 4.985827e-03
## DeviceTab 0.3628600 0.4014254 0.9039288 3.660332e-01
## Low|Moderate 1.4763843 0.7276136 2.0290775 4.245040e-02
## Moderate|High 4.9022849 0.7384592 6.6385315 3.168237e-11
exp(coef(model_ordinal))
## GenderGirl Education.LevelSchool
## 0.6626652 1.3190102
## Education.LevelUniversity Institution.TypeNon Government
## 1.2402279 4.0004918
## Financial.ConditionPoor Financial.ConditionRich
## 0.6190957 13.8053662
## Internet.TypeWifi Network.Type3G
## 0.6939932 3.5640492
## Network.Type4G DeviceMobile
## 6.1750313 0.5481440
## DeviceTab
## 1.4374346
pred <- predict(model_ordinal, type = "class")
conf_mat <- table(Prediksi = pred, Aktual = data$Adaptivity.Level)
conf_mat
## Aktual
## Prediksi Low Moderate High
## Low 260 135 18
## Moderate 217 471 60
## High 3 19 22
accuracy <- sum(diag(conf_mat)) / sum(conf_mat)
aper <- 1 - accuracy
cat("Akurasi model:", round(accuracy * 100, 2), "%\n")
## Akurasi model: 62.49 %
cat("APER model:", round(aper * 100, 2), "%")
## APER model: 37.51 %
cm <- as.data.frame(table(Prediksi = pred, Aktual = data$Adaptivity.Level))
ggplot(cm, aes(x = Prediksi, y = Aktual, fill = Freq)) +
geom_tile() +
geom_text(aes(label = Freq)) +
labs(title = "Heatmap Confusion Matrix")
df_pred <- data.frame(Prediksi = pred, Aktual = data$Adaptivity.Level)
ggplot(df_pred, aes(x = Prediksi, fill = Aktual)) +
geom_bar(position = "dodge") +
labs(title = "Prediksi vs Aktual")