Análisis de Deserción Estudiantil con Árbol de Decisión y Regresión Logística
Jorge Gamez
2025-03-21
true
📌 Introducción
Este análisis utiliza árboles de decisión y regresión logística para predecir la deserción estudiantil en función de los siguientes factores:
- Promedio anterior
- Porcentaje de asistencias
- Horas de estudio semanales
- Género
- Situación económica
Además, se comparan ambas metodologías mediante la curva ROC-AUC para evaluar su capacidad de clasificación.
📌 Cargar Datos y Librerías
# Configurar el mirror de CRAN
options(repos = c(CRAN = "https://cran.rstudio.com/"))
# Instalar y cargar librerías necesarias
install.packages("readxl")## package 'readxl' successfully unpacked and MD5 sums checked##
## The downloaded binary packages are in
## C:\Users\fisica\AppData\Local\Temp\Rtmpo9h6cg\downloaded_packagesinstall.packages("ggplot2")## package 'ggplot2' successfully unpacked and MD5 sums checked
##
## The downloaded binary packages are in
## C:\Users\fisica\AppData\Local\Temp\Rtmpo9h6cg\downloaded_packagesinstall.packages("rpart")## package 'rpart' successfully unpacked and MD5 sums checked##
## The downloaded binary packages are in
## C:\Users\fisica\AppData\Local\Temp\Rtmpo9h6cg\downloaded_packagesinstall.packages("rpart.plot")## package 'rpart.plot' successfully unpacked and MD5 sums checked
##
## The downloaded binary packages are in
## C:\Users\fisica\AppData\Local\Temp\Rtmpo9h6cg\downloaded_packagesinstall.packages("caret")## package 'caret' successfully unpacked and MD5 sums checked##
## The downloaded binary packages are in
## C:\Users\fisica\AppData\Local\Temp\Rtmpo9h6cg\downloaded_packagesinstall.packages("pROC")## package 'pROC' successfully unpacked and MD5 sums checked##
## The downloaded binary packages are in
## C:\Users\fisica\AppData\Local\Temp\Rtmpo9h6cg\downloaded_packageslibrary(readxl)
library(ggplot2)
library(rpart)
library(rpart.plot)
library(caret)
library(pROC)
# Cargar el archivo Excel
datos <- read_excel("C:/Users/fisica/Downloads/datos_rendimiento_desercion.xlsx", sheet = 1)
# Convertir variables categóricas a factor
datos$Deserción <- as.factor(datos$Deserción)
datos$Género <- as.factor(datos$Género)
datos$Situación_Económica <- as.factor(datos$Situación_Económica)
# Verificar nombres de columnas
colnames(datos)## [1] "ID_Estudiante" "Edad"
## [3] "Género" "Promedio_Anterior"
## [5] "Asistencias (%)" "Horas_Estudio_Semanal"
## [7] "Acceso_Tecnología" "Situación_Económica"
## [9] "Reprobaciones_Anteriores" "Deserción"# Dividir en 70% entrenamiento y 30% prueba
set.seed(123)
indices <- createDataPartition(datos$Deserción, p = 0.7, list = FALSE)
train <- datos[indices, ]
test <- datos[-indices, ]
# Verificar estructura
str(train)## tibble [351 × 10] (S3: tbl_df/tbl/data.frame)
## $ ID_Estudiante : num [1:351] 2 3 5 6 7 8 10 12 13 14 ...
## $ Edad : num [1:351] 18 22 21 24 17 21 19 22 22 17 ...
## $ Género : Factor w/ 3 levels "Femenino","Masculino",..: 1 2 1 2 1 2 3 2 2 3 ...
## $ Promedio_Anterior : num [1:351] 5.91 5.33 7.87 9.21 5.7 8.98 5.82 9.07 8.33 7.62 ...
## $ Asistencias (%) : num [1:351] 93 77 70 96 65 86 55 54 52 50 ...
## $ Horas_Estudio_Semanal : num [1:351] 12 3 6 11 9 6 6 9 9 3 ...
## $ Acceso_Tecnología : chr [1:351] "Sí" "Sí" "No" "Sí" ...
## $ Situación_Económica : Factor w/ 3 levels "Alta","Baja",..: 3 3 2 1 2 1 2 3 2 1 ...
## $ Reprobaciones_Anteriores: num [1:351] 0 0 3 0 2 4 0 0 2 3 ...
## $ Deserción : Factor w/ 2 levels "No","Sí": 1 1 1 1 2 2 1 1 1 1 ...str(test)## tibble [149 × 10] (S3: tbl_df/tbl/data.frame)
## $ ID_Estudiante : num [1:149] 1 4 9 11 15 18 20 21 22 23 ...
## $ Edad : num [1:149] 21 19 22 18 20 22 16 19 15 24 ...
## $ Género : Factor w/ 3 levels "Femenino","Masculino",..: 2 2 3 2 2 3 1 3 2 2 ...
## $ Promedio_Anterior : num [1:149] 9.69 8.71 6.01 5.82 6.79 9.08 6.88 7.31 6.51 8.74 ...
## $ Asistencias (%) : num [1:149] 66 78 69 68 87 84 74 73 61 67 ...
## $ Horas_Estudio_Semanal : num [1:149] 16 10 12 16 19 0 12 9 14 12 ...
## $ Acceso_Tecnología : chr [1:149] "Sí" "Sí" "Sí" "Sí" ...
## $ Situación_Económica : Factor w/ 3 levels "Alta","Baja",..: 1 2 3 3 3 1 1 2 3 3 ...
## $ Reprobaciones_Anteriores: num [1:149] 1 3 4 0 0 2 1 4 0 0 ...
## $ Deserción : Factor w/ 2 levels "No","Sí": 2 1 1 1 1 1 2 1 1 1 ...# Crear el modelo de árbol de decisión
modelo_arbol <- rpart(Deserción ~ Promedio_Anterior + `Asistencias (%)` + Horas_Estudio_Semanal + Género + Situación_Económica,
data = train,
method = "class",
control = rpart.control(minsplit = 10, cp = 0.01))
# Visualizar el árbol de decisión
rpart.plot(modelo_arbol, type = 3, extra = 104, fallen.leaves = TRUE)
# Hacer predicciones con el árbol de decisión
predicciones_arbol <- predict(modelo_arbol, test, type = "class")
# Agregar predicciones al conjunto de prueba
test$Predicciones_Arbol <- predicciones_arbol
# Evaluación del modelo con matriz de confusión
conf_matrix_arbol <- confusionMatrix(predicciones_arbol, test$Deserción)
print(conf_matrix_arbol)## Confusion Matrix and Statistics
##
## Reference
## Prediction No Sí
## No 85 28
## Sí 23 13
##
## Accuracy : 0.6577
## 95% CI : (0.5756, 0.7334)
## No Information Rate : 0.7248
## P-Value [Acc > NIR] : 0.9709
##
## Kappa : 0.1082
##
## Mcnemar's Test P-Value : 0.5754
##
## Sensitivity : 0.7870
## Specificity : 0.3171
## Pos Pred Value : 0.7522
## Neg Pred Value : 0.3611
## Prevalence : 0.7248
## Detection Rate : 0.5705
## Detection Prevalence : 0.7584
## Balanced Accuracy : 0.5521
##
## 'Positive' Class : No
## # Calcular métricas del árbol de decisión
accuracy_arbol <- conf_matrix_arbol$overall["Accuracy"]
sensitivity_arbol <- conf_matrix_arbol$byClass["Sensitivity"]
specificity_arbol <- conf_matrix_arbol$byClass["Specificity"]
cat("🔹 Árbol de Decisión: Accuracy =", accuracy_arbol, "\n")## 🔹 Árbol de Decisión: Accuracy = 0.6577181cat("🔹 Sensitivity =", sensitivity_arbol, "\n")## 🔹 Sensitivity = 0.787037cat("🔹 Specificity =", specificity_arbol, "\n")## 🔹 Specificity = 0.3170732# Crear modelo de regresión logística
modelo_logistico <- glm(Deserción ~ Promedio_Anterior + `Asistencias (%)` + Horas_Estudio_Semanal + Género + Situación_Económica,
data = train,
family = binomial())
# Hacer predicciones con la regresión logística
prob_logistica <- predict(modelo_logistico, test, type = "response")
test$Predicciones_Logistica <- ifelse(prob_logistica > 0.5, "Sí", "No")
test$Predicciones_Logistica <- as.factor(test$Predicciones_Logistica)
# Evaluación de la regresión logística
conf_matrix_logistica <- confusionMatrix(test$Predicciones_Logistica, test$Deserción)
print(conf_matrix_logistica)## Confusion Matrix and Statistics
##
## Reference
## Prediction No Sí
## No 108 41
## Sí 0 0
##
## Accuracy : 0.7248
## 95% CI : (0.6457, 0.7947)
## No Information Rate : 0.7248
## P-Value [Acc > NIR] : 0.5419
##
## Kappa : 0
##
## Mcnemar's Test P-Value : 4.185e-10
##
## Sensitivity : 1.0000
## Specificity : 0.0000
## Pos Pred Value : 0.7248
## Neg Pred Value : NaN
## Prevalence : 0.7248
## Detection Rate : 0.7248
## Detection Prevalence : 1.0000
## Balanced Accuracy : 0.5000
##
## 'Positive' Class : No
## # Calcular AUC-ROC para ambos modelos
roc_arbol <- roc(test$Deserción, as.numeric(predicciones_arbol))
roc_logistica <- roc(test$Deserción, prob_logistica)
# Graficar la curva ROC
ggplot() +
geom_line(aes(x = roc_arbol$specificities, y = roc_arbol$sensitivities, color = "Árbol de Decisión"), size = 1) +
geom_line(aes(x = roc_logistica$specificities, y = roc_logistica$sensitivities, color = "Regresión Logística"), size = 1) +
labs(title = "Curva ROC: Comparación Árbol de Decisión vs Regresión Logística",
x = "1 - Especificidad",
y = "Sensibilidad") +
theme_minimal() +
scale_color_manual(name = "Modelo", values = c("blue", "red"))
# Comparar valores de AUC-ROC
auc_arbol <- auc(roc_arbol)
auc_logistica <- auc(roc_logistica)
cat("🔹 AUC-ROC Árbol de Decisión =", auc_arbol, "\n")## 🔹 AUC-ROC Árbol de Decisión = 0.5520551cat("🔹 AUC-ROC Regresión Logística =", auc_logistica, "\n")## 🔹 AUC-ROC Regresión Logística = 0.5372629