Árbol de Decisión - Simulación Abandono Escolar
[Tu Nombre]
2025-03-28
- 1 1 Base simulada para análisis
- 2 2 Árbol de decisión - Simulación Abandono en Media Superior
- 3 3 Regresión logística
- 4 4 Gráficos de caja por variables explicativas y facetas por subgrupos
- 5 5 Gráficos de caja y dispersión por subgrupos
- 6 6 Gráficos de caja y dispersión complementarios
- 7 7 Histograma de edad según abandono
- 8 8 Probabilidades predichas por el modelo logístico
- 9 9 Clasificación basada en umbral de probabilidad
- 10 10 Comparación con diferentes umbrales de clasificación
- 11 11 Curva de precisión según umbral
- 12 12 Matriz de correlación visual (Heatmap)
- 13 13 Conclusión del modelo
1 1 Base simulada para análisis
# Crear base simulada
set.seed(123)
base_simulada <- tibble(
genero = sample(c("Masculino", "Femenino"), 300, replace = TRUE),
edad = sample(15:19, 300, replace = TRUE),
apoyo_familiar = sample(c("Bajo", "Medio", "Alto"), 300, replace = TRUE, prob = c(0.4, 0.4, 0.2)),
calificaciones = sample(c("Bajo", "Medio", "Alto"), 300, replace = TRUE, prob = c(0.4, 0.4, 0.2)),
tecnologia_acceso = sample(c("Sí", "No"), 300, replace = TRUE, prob = c(0.7, 0.3)),
situacion_economica = sample(c("Baja", "Media", "Alta"), 300, replace = TRUE, prob = c(0.5, 0.4, 0.1)),
nivel_socioeconomico = sample(c("Bajo", "Medio", "Alto"), 300, replace = TRUE, prob = c(0.6, 0.3, 0.1)),
horas_estudio = sample(c("2 horas", "3 horas", "5 horas"), 300, replace = TRUE, prob = c(0.4, 0.4, 0.2)),
estado_civil = sample(c("Soltero/a", "Casado/a", "Unión libre"), 300, replace = TRUE, prob = c(0.6, 0.25, 0.15)),
asignaturas_reprobadas = sample(c("Ninguna", "Una", "Dos o más"), 300, replace = TRUE, prob = c(0.3, 0.4, 0.3)),
cantidad_reprobadas = sample(0:5, 300, replace = TRUE, prob = c(0.3, 0.2, 0.2, 0.15, 0.1, 0.05)),
abandono = sample(c("Sí", "No"), 300, replace = TRUE, prob = c(0.35, 0.65))
)
# Asegurar variables categóricas como factores
base_simulada <- base_simulada %>% mutate(across(-cantidad_reprobadas, as.factor))2 2 Árbol de decisión - Simulación Abandono en Media Superior
# Crear árbol de decisión
arbol_modelo <- rpart(abandono ~ ., data = base_simulada, method = "class")
rpart.plot(arbol_modelo, type = 4, extra = 104, under = TRUE, cex = 0.9)
3 3 Regresión logística
# Preparar base para regresión (convertir abandono a binaria y asegurar variables numéricas)
base_logit <- base_simulada %>%
mutate(
abandono_bin = ifelse(abandono == "Sí", 1, 0),
edad = as.numeric(as.character(edad)),
cantidad_reprobadas = as.numeric(as.character(cantidad_reprobadas))
)
# Verificar nombres de variables y valores faltantes
print(names(base_logit))## [1] "genero" "edad" "apoyo_familiar"
## [4] "calificaciones" "tecnologia_acceso" "situacion_economica"
## [7] "nivel_socioeconomico" "horas_estudio" "estado_civil"
## [10] "asignaturas_reprobadas" "cantidad_reprobadas" "abandono"
## [13] "abandono_bin"print(colSums(is.na(base_logit)))## genero edad apoyo_familiar
## 0 0 0
## calificaciones tecnologia_acceso situacion_economica
## 0 0 0
## nivel_socioeconomico horas_estudio estado_civil
## 0 0 0
## asignaturas_reprobadas cantidad_reprobadas abandono
## 0 0 0
## abandono_bin
## 0# Eliminar filas con valores faltantes
base_logit <- na.omit(base_logit)
# Ajustar modelo
modelo_logit <- glm(abandono_bin ~ genero + edad + apoyo_familiar + calificaciones +
tecnologia_acceso + situacion_economica + nivel_socioeconomico +
horas_estudio + estado_civil + asignaturas_reprobadas + cantidad_reprobadas,
data = base_logit, family = binomial)
summary(modelo_logit)##
## Call:
## glm(formula = abandono_bin ~ genero + edad + apoyo_familiar +
## calificaciones + tecnologia_acceso + situacion_economica +
## nivel_socioeconomico + horas_estudio + estado_civil + asignaturas_reprobadas +
## cantidad_reprobadas, family = binomial, data = base_logit)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.08755 1.68097 -0.647 0.5176
## generoMasculino 0.46181 0.25355 1.821 0.0685 .
## edad -0.01989 0.09211 -0.216 0.8290
## apoyo_familiarBajo 0.05560 0.37076 0.150 0.8808
## apoyo_familiarMedio 0.56626 0.37078 1.527 0.1267
## calificacionesBajo -0.39538 0.35644 -1.109 0.2673
## calificacionesMedio -0.32048 0.35087 -0.913 0.3610
## tecnologia_accesoSí 0.21568 0.27497 0.784 0.4328
## situacion_economicaBaja 0.25557 0.43307 0.590 0.5551
## situacion_economicaMedia -0.13664 0.42786 -0.319 0.7494
## nivel_socioeconomicoBajo 0.30376 0.40843 0.744 0.4570
## nivel_socioeconomicoMedio 0.01479 0.44532 0.033 0.9735
## horas_estudio3 horas 0.18221 0.28044 0.650 0.5159
## horas_estudio5 horas -0.30113 0.37171 -0.810 0.4179
## estado_civilSoltero/a -0.43738 0.29577 -1.479 0.1392
## estado_civilUnión libre 0.21405 0.39409 0.543 0.5870
## asignaturas_reprobadasNinguna 0.23210 0.33727 0.688 0.4913
## asignaturas_reprobadasUna 0.31550 0.31768 0.993 0.3207
## cantidad_reprobadas 0.17406 0.08859 1.965 0.0494 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 396.42 on 299 degrees of freedom
## Residual deviance: 373.11 on 281 degrees of freedom
## AIC: 411.11
##
## Number of Fisher Scoring iterations: 44 4 Gráficos de caja por variables explicativas y facetas por subgrupos
# Gráfico de caja: cantidad de reprobadas por apoyo familiar
ggplot(base_logit, aes(x = apoyo_familiar, y = cantidad_reprobadas, fill = abandono)) +
geom_boxplot() +
theme_minimal() +
labs(title = "Asignaturas reprobadas por apoyo familiar", y = "Cantidad reprobadas")
# Gráfico de caja: edad por nivel socioeconómico
ggplot(base_logit, aes(x = nivel_socioeconomico, y = edad, fill = abandono)) +
geom_boxplot() +
theme_minimal() +
labs(title = "Edad por nivel socioeconómico", y = "Edad")
# Gráfico de caja: edad por calificaciones
ggplot(base_logit, aes(x = calificaciones, y = edad, fill = abandono)) +
geom_boxplot() +
theme_minimal() +
labs(title = "Edad por nivel de calificaciones", y = "Edad")
5 5 Gráficos de caja y dispersión por subgrupos
# Gráfico de caja: edad por apoyo familiar y género
ggplot(base_logit, aes(x = apoyo_familiar, y = edad, fill = abandono)) +
geom_boxplot() +
facet_wrap(~genero) +
theme_minimal() +
labs(title = "Edad por apoyo familiar según género", y = "Edad")
# Gráfico de caja: cantidad de reprobadas por estado civil y género
ggplot(base_logit, aes(x = estado_civil, y = cantidad_reprobadas, fill = abandono)) +
geom_boxplot() +
facet_wrap(~genero) +
theme_minimal() +
labs(title = "Asignaturas reprobadas por estado civil según género", y = "Cantidad reprobadas")
# Gráfico de caja: edad por horas de estudio y abandono
ggplot(base_logit, aes(x = horas_estudio, y = edad, fill = abandono)) +
geom_boxplot() +
facet_wrap(~abandono) +
theme_minimal() +
labs(title = "Edad según horas de estudio y abandono", y = "Edad")
6 6 Gráficos de caja y dispersión complementarios
# Gráfico de caja: edad vs abandono
ggplot(base_logit, aes(x = abandono, y = edad, fill = abandono)) +
geom_boxplot() +
theme_minimal() +
labs(title = "Distribución de edad según abandono")
# Gráfico de dispersión: edad vs cantidad reprobadas
ggplot(base_logit, aes(x = edad, y = cantidad_reprobadas, color = abandono)) +
geom_jitter(width = 0.2, height = 0.2, alpha = 0.6) +
theme_minimal() +
labs(title = "Dispersión entre edad y cantidad de asignaturas reprobadas")
7 7 Histograma de edad según abandono
ggplot(base_logit, aes(x = edad, fill = abandono)) +
geom_histogram(position = "dodge", bins = 5) +
theme_minimal() +
labs(title = "Histograma de edad según abandono")
8 8 Probabilidades predichas por el modelo logístico
# Agregar columna de probabilidades
base_logit$probabilidad_abandono <- predict(modelo_logit, type = "response")
# Mostrar primeras filas
head(base_logit[, c("abandono", "probabilidad_abandono")])## # A tibble: 6 × 2
## abandono probabilidad_abandono
## <fct> <dbl>
## 1 No 0.309
## 2 Sí 0.610
## 3 No 0.497
## 4 No 0.200
## 5 No 0.605
## 6 No 0.246# Gráfico de densidad de probabilidades por grupo
ggplot(base_logit, aes(x = probabilidad_abandono, fill = abandono)) +
geom_density(alpha = 0.6) +
theme_minimal() +
labs(title = "Distribución de probabilidades predichas de abandono",
x = "Probabilidad predicha", y = "Densidad")
9 9 Clasificación basada en umbral de probabilidad
# Clasificar abandono predicho según umbral 0.5
base_logit$prediccion_abandono <- ifelse(base_logit$probabilidad_abandono >= 0.5, "Sí", "No")
# Matriz de confusión
matriz_confusion <- table(Predicho = base_logit$prediccion_abandono, Real = base_logit$abandono)
matriz_confusion## Real
## Predicho No Sí
## No 166 78
## Sí 22 34# Precisión del modelo
precision <- mean(base_logit$prediccion_abandono == base_logit$abandono)
paste("Precisión del modelo: ", round(precision * 100, 2), "%")## [1] "Precisión del modelo: 66.67 %"10 10 Comparación con diferentes umbrales de clasificación
# Función para generar matriz de confusión y precisión por umbral
analizar_umbral <- function(umbral) {
pred <- ifelse(base_logit$probabilidad_abandono >= umbral, "Sí", "No")
matriz <- table(Predicho = pred, Real = base_logit$abandono)
precision <- mean(pred == base_logit$abandono)
list(umbral = umbral, matriz = matriz, precision = round(precision * 100, 2))
}
# Resultados para umbrales 0.4, 0.5 y 0.6
res_04 <- analizar_umbral(0.4)
res_05 <- analizar_umbral(0.5)
res_06 <- analizar_umbral(0.6)
# Mostrar resultados
res_04$matriz## Real
## Predicho No Sí
## No 132 55
## Sí 56 57paste("Precisión con umbral 0.4:", res_04$precision, "%")## [1] "Precisión con umbral 0.4: 63 %"res_05$matriz## Real
## Predicho No Sí
## No 166 78
## Sí 22 34paste("Precisión con umbral 0.5:", res_05$precision, "%")## [1] "Precisión con umbral 0.5: 66.67 %"res_06$matriz## Real
## Predicho No Sí
## No 177 102
## Sí 11 10paste("Precisión con umbral 0.6:", res_06$precision, "%")## [1] "Precisión con umbral 0.6: 62.33 %"11 11 Curva de precisión según umbral
# Crear secuencia de umbrales
umbrales <- seq(0.1, 0.9, by = 0.05)
# Calcular precisión para cada umbral
resultados <- tibble(
umbral = umbrales,
precision = map_dbl(umbrales, ~ mean(ifelse(base_logit$probabilidad_abandono >= .x, "Sí", "No") == base_logit$abandono))
)
# Graficar curva
ggplot(resultados, aes(x = umbral, y = precision)) +
geom_line(color = "blue", size = 1.2) +
geom_point(color = "darkred") +
theme_minimal() +
labs(title = "Curva de precisión según el umbral de clasificación",
x = "Umbral de probabilidad",
y = "Precisión del modelo")
12 12 Matriz de correlación visual (Heatmap)
# Seleccionar variables numéricas
vars_cor <- base_logit %>%
select(edad, cantidad_reprobadas, abandono_bin, probabilidad_abandono)
# Calcular matriz de correlación
cor_matrix <- round(cor(vars_cor), 2)
# Convertir a formato largo para ggplot
cor_data <- as.data.frame(as.table(cor_matrix)) %>%
rename(Var1 = Var1, Var2 = Var2, Correlación = Freq)
# Gráfico heatmap
ggplot(cor_data, aes(Var1, Var2, fill = Correlación)) +
geom_tile(color = "white") +
geom_text(aes(label = Correlación), color = "black", size = 4) +
scale_fill_gradient2(low = "blue", high = "red", mid = "white", midpoint = 0) +
theme_minimal() +
labs(title = "Matriz de correlación entre variables numéricas")
13 13 Conclusión del modelo
El árbol de decisión nos ayuda a visualizar cómo diferentes factores se relacionan con el abandono escolar.
La regresión logística permite identificar la magnitud del efecto de cada variable.
Los gráficos de caja, dispersión e histogramas permiten reforzar visualmente los patrones.
Este enfoque mixto de análisis categórico e inferencial proporciona una comprensión más completa del fenómeno de abandono escolar.