Regresion Logistica
Dermin y Marybel
2026-04-18
Regresión Logistica
El corazón de la regresión logística es la Función Sigmoide (o curva logística). Es una función en forma de “S” que transforma el resultado infinito de una ecuación lineal en una probabilidad válida.La fórmula de la probabilidad \(P\) de que ocurra el evento (\(Y=1\)) dados ciertos predictores (\(X\)) es:
La probabilidad condicional de que el evento de riesgo ocurra (\(Y=1\)) dado un factor predictivo (\(X\)), se modela matemáticamente como:
\[P(Y=1|X) = \frac{1}{1 + e^{-(\beta_0 + \beta_1 X_1)}}\] \(P(Y=1|X)\): Es la probabilidad resultante (el valor entre 0 y 1).
\(1\) (en el numerador): Es el “techo” de la función. Garantiza que la curva nunca supere el 100%.
\(e\): Es el Número de Euler (\(\approx 2.71828\)), la base de los logaritmos naturales, usado para modelar tasas de crecimiento.
\((\beta_0 + \beta_1 X_1 + \dots)\): Esta es tu vieja conocida, la ecuación de la línea recta. Actúa como el exponente (con signo negativo).
Mecánica de la fórmula: Si la ecuación lineal da un número positivo muy grande, \(e^{-\text{grande}}\) se vuelve casi \(0\). La fórmula queda \(\frac{1}{1+0} = 1\) (Alta probabilidad).
Si la ecuación lineal da un número negativo muy grande, \(e^{-(-\text{grande})}\) tiende a infinito. La fórmula queda \(\frac{1}{1+\infty} = 0\) (Baja probabilidad).
El Enlace “Logit” (Cómo lo calcula el software)Para que programas como R puedan estimar los coeficientes (\(\beta\)), necesitan trabajar con relaciones lineales. Para ello, aplican álgebra para despejar la ecuación anterior, transformando la probabilidad en lo que se conoce como la Función Logit.Primero, se calculan las Ventajas (Odds), que es la razón entre la probabilidad de que el evento ocurra y la probabilidad de que no ocurra:\[\text{Odds} = \frac{P}{1 - P}\]Luego, se le aplica el logaritmo natural (\(\ln\)) a estas ventajas.
Esta transformación nos devuelve nuestra ecuación lineal clásica:\[\ln\left(\frac{P}{1-P}\right) = \beta_0 + \beta_1 X_1 + \beta_2 X_2 + \dots\]Es decir, en la regresión logística, no predecimos la probabilidad directamente mediante una suma, sino que predecimos el logaritmo de las ventajas de que el evento suceda.
Interpretación Práctica (Odds Ratios) Dado que a los seres humanos nos cuesta interpretar “logaritmos de ventajas”, cuando obtenemos los coeficientes (\(\beta\)) de nuestro modelo, les aplicamos la función exponencial (\(e^\beta\)) para obtener los Odds Ratios (OR).
Si el OR es \(> 1\): El predictor es un factor de riesgo. (Ej. Fumar aumenta el riesgo de cáncer).
Si el OR es \(< 1\): El predictor es un factor protector. (Ej. Como vimos en tu modelo perinatal, más días de gestación disminuyen el riesgo de bajo peso).
Si el OR es \(= 1\): El predictor no tiene efecto sobre el evento.
Para poder estimar los parámetros \(\beta\) mediante máxima verosimilitud, la ecuación se transforma a su forma lineal conocida como el Enlace Logit (logaritmo de las ventajas u odds):
\[\ln\left(\frac{P}{1-P}\right) = \beta_0 + \beta_1 X_1\]
Variable Dependiente (\(Y\)): Es dicotómica o binaria. Solo tiene dos valores posibles (ej. \(1\) = Sí/Éxito/Enfermo, \(0\) = No/Fracaso/Sano).
Resultado del Modelo: No escupe un simple “1” o “0”, sino una probabilidad en porcentaje (ej. Existe un 85% de probabilidad de que el paciente desarrolle la enfermedad).
** PREPARACIÓN Y DEPURACIÓN DE DATOS**
El objetivo del estudio es predecir la probabilidad de que un neonato nazca con Bajo Peso (menor a 88 onzas) utilizando la duración de la gestación como variable predictora
# Cargar la base de datos
rdlogis <- read.csv("C:/modelosderegresion/Rendimiento.csv", header=TRUE, sep = ",")
head(rdlogis)## Hours_Studied Attendance Parental_Involvement Access_to_Resources
## 1 23 84 Low High
## 2 19 64 Low Medium
## 3 24 98 Medium Medium
## 4 29 89 Low Medium
## 5 19 92 Medium Medium
## 6 19 88 Medium Medium
## Extracurricular_Activities Sleep_Hours Previous_Scores Motivation_Level
## 1 No 7 73 Low
## 2 No 8 59 Low
## 3 Yes 7 91 Medium
## 4 Yes 8 98 Medium
## 5 Yes 6 65 Medium
## 6 Yes 8 89 Medium
## Internet_Access Tutoring_Sessions Family_Income Teacher_Quality School_Type
## 1 Yes 0 Low Medium Public
## 2 Yes 2 Medium Medium Public
## 3 Yes 2 Medium Medium Public
## 4 Yes 1 Medium Medium Public
## 5 Yes 3 Medium High Public
## 6 Yes 3 Medium Medium Public
## Peer_Influence Physical_Activity Learning_Disabilities
## 1 Positive 3 No
## 2 Negative 4 No
## 3 Neutral 4 No
## 4 Negative 4 No
## 5 Neutral 4 No
## 6 Positive 3 No
## Parental_Education_Level Distance_from_Home Gender Exam_Score
## 1 High School Near Male 67
## 2 College Moderate Female 61
## 3 Postgraduate Near Male 74
## 4 High School Moderate Male 71
## 5 College Near Female 70
## 6 Postgraduate Near Male 71# 2. Tratamiento de Valores Centinela (999) e Imputación por Media
rdlogis$Hours_Studied[rdlogis$Hours_Studied == 999] <- NA
media_Hours_Studied <- mean(rdlogis$Hours_Studied, na.rm = TRUE)
rdlogis$Hours_Studied[is.na(rdlogis$Hours_Studied)] <- media_Hours_Studied
rdlogis$Hours_Studied <- as.numeric(rdlogis$Hours_Studied)
# 3. Creación de la Variable Dicotómica (Variable de Respuesta Y)
# 1 = Riesgo (reprobación: < 65 puntos), 0 = Aprobado
rdlogis$Exam_Score <- ifelse(rdlogis$Exam_Score < 65, 1, 0) #Exam_Score es asumida como baja puntuación
# Distribución de la variable de interés
table(Riesgo = rdlogis$Exam_Score)## Riesgo
## 0 1
## 5155 1452ESTIMACIÓN DEL MODELO LOGÍSTICO
Se utiliza la función glm() especificando la familia binomial para aplicar la transformación logit.
# Ajuste del modelo: Probabilidad de bajo peso en función de la gestación
modelo_riesgoreproba <- glm(Exam_Score ~ Hours_Studied, data = rdlogis, family = "binomial")
# Resumen de estimadores
summary(modelo_riesgoreproba)##
## Call:
## glm(formula = Exam_Score ~ Hours_Studied, family = "binomial",
## data = rdlogis)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.867575 0.113123 16.51 <2e-16 ***
## Hours_Studied -0.169496 0.006253 -27.11 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 6958.7 on 6606 degrees of freedom
## Residual deviance: 6035.9 on 6605 degrees of freedom
## AIC: 6039.9
##
## Number of Fisher Scoring iterations: 5La Ecuación del Modelo (El Modelo Matemático)A partir de la columna Estimate, podemos construir la ecuación real.
Recuerda que la regresión logística primero calcula el logaritmo de las ventajas (Log-Odds) de que el bebé nazca con bajo peso.
La ecuación lineal (Logit) es:
\[\ln\left(\frac{P}{1-P}\right) = 1.867 - 0.1695 \cdot (\text{Horas_estudio})\] Y la ecuación real de probabilidad (la Función Sigmoide) queda así: \[P(\text{Bajo_rendimiento}) = \frac{1}{1 + e^{-(1.867 - 0.1695 \cdot \text{Horas_estudio})}}\]
- ¿Qué significan los coeficientes?El Intercepto (\(1.867\)): Es el valor matemático cuando la gestación es \(0\). En la vida real, un bebé no puede tener 0 días de gestación, por lo que este número es solo el “ancla” matemática para que la curva en S se posicione correctamente en el gráfico.La Pendiente o Gestación (\(-0.1695\)):
Este es el dato vital. El signo negativo indica que la relación es inversa: a medida que aumentan las horas de estudio, disminuye el riesgo de reprobación (los log-odds).
Significancia (***): El \(p\text{-value}\) es \(< 2e-16\). Es decir, la probabilidad de que esta relación sea una coincidencia es prácticamente cero. Las horas de estudio es un predictor definitivo del bajo rendimiento.
Interpretación de los Coeficientes (Odds Ratios)
Debido a que los coeficientes originales de glm están en escala logarítmica, aplicamos la función exponencial para convertirlos en Odds Ratios (OR), facilitando su interpretación.
# Cálculo de Odds Ratios e Intervalos de Confianza (95%)
or_resultados <- exp(cbind(OR = coef(modelo_riesgoreproba), confint(modelo_riesgoreproba)))## Waiting for profiling to be done...round(or_resultados, 3)## OR 2.5 % 97.5 %
## (Intercept) 6.473 5.192 8.090
## Hours_Studied 0.844 0.834 0.854Análisis: El Odds Ratio para la Horas de estudio es significativamente menor a 1 (0.844). Esto indica un efecto protector: por cada hora de estudio adicional a la jornada escolar, que dedique un estudiante, las probabilidades (odds) de tener una baja nota disminuyen. significativamente.
EVALUACIÓN DEL PODER PREDICTIVO
Para evaluar qué tan bueno es nuestro modelo tomando decisiones, generamos predicciones de probabilidad y las comparamos con los datos reales usando una Matriz de Confusión
# 4. EVALUACIÓN DEL PODER PREDICTIVO
# 1. Generar probabilidades predichas para cada paciente
probabilidades <- predict(modelo_riesgoreproba, type = "response")
# 2. Convertir probabilidad en clasificación binaria (Punto de corte: 0.5 o 50%)
predicciones <- ifelse(probabilidades > 0.5, 1, 0)
# 3. Matriz de Confusión (CORREGIDA)
# Usamos modelo_riesgo$y para obtener exactamente los 1223 datos reales que uso el modelo
matriz_confusion <- table(Prediccion = predicciones, Real = modelo_riesgoreproba$y)
print(matriz_confusion)## Real
## Prediccion 0 1
## 0 4919 1177
## 1 236 275# 4. Cálculo de Precisión Global (Accuracy)
precision <- sum(diag(matriz_confusion)) / sum(matriz_confusion)
cat("La precisión global del modelo es:", round(precision * 100, 2), "%\n")## La precisión global del modelo es: 78.61 %# --- EXTRACCIÓN DE CUADRANTES PARA MÉTRICAS CLÍNICAS ---
# En R, la tabla se lee: tabla[Fila, Columna]
TN <- matriz_confusion[1, 1] # Verdadero Negativo (Real 0, Pred 0)
FN <- matriz_confusion[1, 2] # Falso Negativo (Real 1, Pred 0)
FP <- matriz_confusion[2, 1] # Falso Positivo (Real 0, Pred 1)
TP <- matriz_confusion[2, 2] # Verdadero Positivo (Real 1, Pred 1)
library(ggplot2)## Warning: package 'ggplot2' was built under R version 4.5.2# 1. Se toma la matriz de confusión real que calculamos en el paso anterior
# (Asumiendo que ya corriste el código donde creaste 'matriz_confusion')
datos_reales <- as.data.frame(as.table(matriz_confusion))
colnames(datos_reales) <- c("Predicho", "Real", "Frecuencia")
# 2. Aseguramos que los niveles estén en el orden correcto (0=Aprobado, 1=Riesgo)
datos_reales$Predicho <- factor(ifelse(datos_reales$Predicho == 1, "Riesgo (1)", "Aprobado (0)"),
levels = c("Aprobado (0)", "Riesgo (1)"))
datos_reales$Real <- factor(ifelse(datos_reales$Real == 1, "Riesgo (1)", "Aprobado (0)"),
levels = c("Riesgo (1)", "Aprobado (0)")) # Invertido para el eje Y
# 3. Generamos el gráfico
ggplot(datos_reales, aes(x = Predicho, y = Real, fill = Frecuencia)) +
geom_tile(color = "black", linewidth = 1) +
geom_text(aes(label = Frecuencia), size = 8, fontface = "bold") +
scale_fill_gradient(low = "white", high = "#E74C3C") + # Usamos rojo para denotar riesgo
labs(title = "Matriz de Confusión: Modelo de Riesgo Reprobación",
subtitle = "Evaluación empírica sobre n = 6607 estudiantes",
x = "Predicción del Algoritmo",
y = "Realidad académica (Observada)") +
theme_minimal() +
theme(axis.text = element_text(size = 12, face = "bold"),
title = element_text(size = 14, face = "bold"),
legend.position = "none")
Verdaderos Negativos (4919): El modelo predijo que el estudiante Aprobaria el examen (nota mayor a 65) y, efectivamente, aprobaron ¡Excelente!
Falsos Positivos (236): El modelo predijo reprobación, pero el estudiante Aprobó.
Verdaderos Positivos (275): El modelo predijo que el estudiante reprobaba y el predijo la reprobación.
Falsos Negativos (1177): El modelo predijo Aprobado, pero en realidad reprobaron la asignatura.
Metricas de Desempeño Derivada
Sensibilidad (Recall): Capacidad de detectar los casos positivos reales.
\[ \text{Sensibilidad} = \frac{TP}{TP + FN} \]
Especificidad: Capacidad de identificar correctamente los casos negativos.
\[ \text{Especificidad} = \frac{TN}{TN + FP} \]
Precisión Global (Accuracy): Proporción total de aciertos sobre el total de casos.
\[ \text{Accuracy} = \frac{TP + TN}{TP + TN + FP + FN} \]
4. Aplicación: Evaluación de nuestro Modelo
Se procede a evaluar el modelo empírico de riesgo de reprobación
(modelo_riesgoreproba), estableciendo un umbral de decisión
del 50% \((0.5)\).
# --- EXTRACCIÓN DE CUADRANTES PARA MÉTRICAS CLÍNICAS ---
# En R, la tabla se lee: tabla[Fila, Columna]
TN <- matriz_confusion[1, 1] # Verdadero Negativo (Real 0, Pred 0)
FN <- matriz_confusion[1, 2] # Falso Negativo (Real 1, Pred 0)
FP <- matriz_confusion[2, 1] # Falso Positivo (Real 0, Pred 1)
TP <- matriz_confusion[2, 2] # Verdadero Positivo (Real 1, Pred 1)
sensibilidad <- TP / (TP + FN)
especificidad <- TN / (TN + FP)
precision <- (TP + TN) / (TP + TN + FP + FN)
cat("Precision Global (Accuracy):", round(precision * 100, 2), "%\n")## Precision Global (Accuracy): 78.61 %cat("Sensibilidad (Exito en detectar riesgo):", round(sensibilidad * 100, 2), "%\n")## Sensibilidad (Exito en detectar riesgo): 18.94 %cat("Especificidad (Exito en descartar sanos):", round(especificidad * 100, 2), "%\n")## Especificidad (Exito en descartar sanos): 95.42 %Nuestro modelo solo tiene una predicisión del 78.6% por eso muestra que el algoritmo se equivocó 1177 veces fallando en detectar el riesgo. Sin embargo esto es coherente porque el rendimiento de un estudiante, más alla de aprobar una asignatura, depende de otros facres asociados al estudiantes pero tambien al contexto, el currículo y los padres de familia o cuidadores. Sin embargo, llama la atención el porcentaje bajo en la sencibilidad, es decir, en detectar a los estudiantes en riesgo de reprobación.
Modelo de Regresión Logística Múltiple
\[\ln\left(\frac{P}{1-P}\right) = \beta_0 + \beta_1 X_1 + \beta_2 X_2 + \beta_3 X_3\] \[P(Y=1|X) = \frac{1}{1 + e^{-(\beta_0 + \beta_1 X_1 + \beta_2 X_2 + \beta_3 X_3)}}\]
# Cargar la base de datos
rdlogis <- read.csv("C:/modelosderegresion/Rendimiento.csv", header=TRUE, sep = ",")
head(rdlogis)## Hours_Studied Attendance Parental_Involvement Access_to_Resources
## 1 23 84 Low High
## 2 19 64 Low Medium
## 3 24 98 Medium Medium
## 4 29 89 Low Medium
## 5 19 92 Medium Medium
## 6 19 88 Medium Medium
## Extracurricular_Activities Sleep_Hours Previous_Scores Motivation_Level
## 1 No 7 73 Low
## 2 No 8 59 Low
## 3 Yes 7 91 Medium
## 4 Yes 8 98 Medium
## 5 Yes 6 65 Medium
## 6 Yes 8 89 Medium
## Internet_Access Tutoring_Sessions Family_Income Teacher_Quality School_Type
## 1 Yes 0 Low Medium Public
## 2 Yes 2 Medium Medium Public
## 3 Yes 2 Medium Medium Public
## 4 Yes 1 Medium Medium Public
## 5 Yes 3 Medium High Public
## 6 Yes 3 Medium Medium Public
## Peer_Influence Physical_Activity Learning_Disabilities
## 1 Positive 3 No
## 2 Negative 4 No
## 3 Neutral 4 No
## 4 Negative 4 No
## 5 Neutral 4 No
## 6 Positive 3 No
## Parental_Education_Level Distance_from_Home Gender Exam_Score
## 1 High School Near Male 67
## 2 College Moderate Female 61
## 3 Postgraduate Near Male 74
## 4 High School Moderate Male 71
## 5 College Near Female 70
## 6 Postgraduate Near Male 71# 2. Tratamiento de Valores Centinela (999) e Imputación por Media
rdlogis$Hours_Studied[rdlogis$Hours_Studied == 999] <- NA
media_Hours_Studied <- mean(rdlogis$Hours_Studied, na.rm = TRUE)
rdlogis$Hours_Studied[is.na(rdlogis$Hours_Studied)] <- media_Hours_Studied
rdlogis$Hours_Studied <- as.numeric(rdlogis$Hours_Studied)
rdlogis$Tutoring_Sessions[rdlogis$Tutoring_Sessions == 999] <- NA
media_Tutoring_Sessions <- mean(rdlogis$Tutoring_Sessions, na.rm = TRUE)
rdlogis$Tutoring_Sessions[is.na(rdlogis$Tutoring_Sessions)] <- media_Tutoring_Sessions
rdlogis$Tutoring_Sessions <- as.numeric(rdlogis$Tutoring_Sessions)
# Extraemos estrictamente las variables dependientes que se quieren asociar al mmdelo, en este caso: las horas de estudio, las sesiones de tutoria, el acceso a internet y la participación en actividades extracurriculares.
datos_completos_lgmul<- subset(rdlogis, select = c(Exam_Score, Hours_Studied, Tutoring_Sessions, Internet_Access, Extracurricular_Activities))
# Eliminamos cualquier fila con datos faltantes (NAs)
datos_completos_lgmul <- na.omit(datos_completos_lgmul)
# 3. Creación de la Variable Dicotómica (Variable de Respuesta Y)
# 1 = Riesgo (reprobación: < 65 puntos), 0 = Aprobado
datos_completos_lgmul$Exam_Score <- ifelse(datos_completos_lgmul$Exam_Score < 65, 1, 0)
# Usamos las variables dicotomicas para que el modelo asuma un nivel basal de referencia
modelo_definitivolg <- glm(Exam_Score ~ Hours_Studied + Tutoring_Sessions + factor(Internet_Access) + factor(Extracurricular_Activities),
data = datos_completos_lgmul,
family = binomial(link = "logit"))
summary(modelo_definitivolg)##
## Call:
## glm(formula = Exam_Score ~ Hours_Studied + Tutoring_Sessions +
## factor(Internet_Access) + factor(Extracurricular_Activities),
## family = binomial(link = "logit"), data = datos_completos_lgmul)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 3.11752 0.17451 17.864 < 2e-16 ***
## Hours_Studied -0.17675 0.00643 -27.488 < 2e-16 ***
## Tutoring_Sessions -0.34762 0.02936 -11.841 < 2e-16 ***
## factor(Internet_Access)Yes -0.44937 0.11619 -3.867 0.00011 ***
## factor(Extracurricular_Activities)Yes -0.39625 0.06598 -6.005 1.91e-09 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 6958.7 on 6606 degrees of freedom
## Residual deviance: 5834.0 on 6602 degrees of freedom
## AIC: 5844
##
## Number of Fisher Scoring iterations: 5# Distribución de la variable de interés
table(Riesgo = datos_completos_lgmul$Exam_Score)## Riesgo
## 0 1
## 5155 1452La ecuación real de probabilidad (la Función Sigmoide múltiple) queda así: \[P(\text{Bajo_rendimiento}) = \frac{1}{1 + e^{-(3.11752 - 0.17675 \cdot \text{Horas_estudio} - 0.34762 \cdot \text{Tutoring_Sessions} - 0.44937 \cdot \text{Internet_Accesss} - 0.39625 \cdot \text{Extracurricular})}}\] Nuevamente el signo negativo indica que la relación es inversa: a medida que aumentan las horas de estudio, las sesiones de tutoria y además tiene acceso a internet y participa en actividades extracurriculares, disminuye el riesgo de reprobación (los log-odds).
Significancia (***): El \(p\text{-value}\) es \(<0\) en todos los variables analizadas: \(< 2e-16\), \(< 1.9e-9\) y \(< 0.0001\). Es decir, la probabilidad de que esta relación sea una coincidencia es prácticamente cero. En conclusión, Las horas de estudio, las sesiones de tutoria y no tener acceso a internet y no participa en actividades extracurriculares son un predictor definitivo del bajo rendimiento.
Interpretación de los Coeficientes (Odds Ratios)
Debido a que los coeficientes originales de glm están en escala logarítmica, aplicamos la función exponencial para convertirlos en Odds Ratios (OR), facilitando su interpretación.
# Cálculo de Odds Ratios e Intervalos de Confianza (95%)
or_resultadoslg <- exp(cbind(OR = coef(modelo_definitivolg), confint(modelo_definitivolg)))## Waiting for profiling to be done...round(or_resultadoslg, 3)## OR 2.5 % 97.5 %
## (Intercept) 22.590 16.071 31.860
## Hours_Studied 0.838 0.827 0.849
## Tutoring_Sessions 0.706 0.667 0.748
## factor(Internet_Access)Yes 0.638 0.509 0.803
## factor(Extracurricular_Activities)Yes 0.673 0.591 0.766Análisis: El Odds Ratio para la Horas de estudio es significativamente menor a 1 (0.844), al igual que las sesiones de tutoria (0.748), el acceso a internet(0.803) y la participación en actividades extracurriculares (0.766). Esto indica un efecto protector: por cada hora de estudio o sesiones de tutoria adicional que dedique un estudiante, las posibilidades de acceso a internet o participación en otras actividades, las probabilidades (odds) de tener una baja nota disminuyen. significativamente.
EVALUACIÓN DEL PODER PREDICTIVO
Para evaluar qué tan bueno es nuestro modelo tomando decisiones, generamos predicciones de probabilidad y las comparamos con los datos reales usando una Matriz de Confusión
# 4. EVALUACIÓN DEL PODER PREDICTIVO DEL MODELO DE REGRESIÓN LOGISTICA MÚLTIPLE
# 1. Generar probabilidades predichas para cada paciente
probabilidadesmul <- predict(modelo_definitivolg, type = "response")
# 2. Convertir probabilidad en clasificación binaria (Punto de corte: 0.5 o 50%)
prediccionesmul <- ifelse(probabilidadesmul > 0.5, 1, 0)
# 3. Matriz de Confusión (CORREGIDA)
# Usamos modelo_riesgo$y para obtener exactamente los 1223 datos reales que uso el modelo
matriz_confusionlg0.5 <- table(Prediccion = prediccionesmul, Real = modelo_definitivolg$y)
print(matriz_confusionlg0.5)## Real
## Prediccion 0 1
## 0 4910 1120
## 1 245 332# 4. Cálculo de Precisión Global (Accuracy)
precisionmul <- sum(diag(matriz_confusionlg0.5)) / sum(matriz_confusionlg0.5)
cat("La precisión global del modelo es:", round(precision * 100, 2), "%\n")## La precisión global del modelo es: 78.61 %Hasta el momento se puede observar diferencias importantes entre el modelo logístico simple y el modelo logístico multiple. Por una parte, la precisión global en modelo logístico simple es 78.61% frente 79.34% en el modelos múltiple. Por otra parte, esta mejora tambien se confirma en el AIC. En el primer caso es 6039.9 mientras que en el múltiple es 5844.
# --- EXTRACCIÓN DE CUADRANTES PARA MÉTRICAS ---
# En R, la tabla se lee: tabla[Fila, Columna]
TN_mul0.5 <- matriz_confusionlg0.5[1, 1] # Verdadero Negativo (Real 0, Pred 0)
FN_mul0.5 <- matriz_confusionlg0.5[1, 2] # Falso Negativo (Real 1, Pred 0)
FP_mul0.5 <- matriz_confusionlg0.5[2, 1] # Falso Positivo (Real 0, Pred 1)
TP_mul0.5 <- matriz_confusionlg0.5[2, 2] # Verdadero Positivo (Real 1, Pred 1)
library(ggplot2)
# 1. Se toma la matriz de confusión real que calculamos en el paso anterior
# (Asumiendo que ya corriste el código donde creaste 'matriz_confusion')
datos_reales_mul <- as.data.frame(as.table(matriz_confusionlg0.5))
colnames(datos_reales_mul) <- c("Predicho", "Real", "Frecuencia")
# 2. Aseguramos que los niveles estén en el orden correcto (0=Aprobado, 1=Riesgo)
datos_reales_mul$Predicho <- factor(ifelse(datos_reales_mul$Predicho == 1, "Riesgo (1)", "Aprobado (0)"),
levels = c("Aprobado (0)", "Riesgo (1)"))
datos_reales_mul$Real <- factor(ifelse(datos_reales_mul$Real == 1, "Riesgo (1)", "Aprobado (0)"),
levels = c("Riesgo (1)", "Aprobado (0)")) # Invertido para el eje Y
# 3. Generamos el gráfico
ggplot(datos_reales_mul, aes(x = Predicho, y = Real, fill = Frecuencia)) +
geom_tile(color = "black", linewidth = 1) +
geom_text(aes(label = Frecuencia), size = 8, fontface = "bold") +
scale_fill_gradient(low = "white", high = "#E74C3C") + # Usamos rojo para denotar riesgo
labs(title = "Matriz de Confusión: Modelo de Riesgo Reprobación",
subtitle = "Evaluación empírica sobre n = 6607 estudiantes",
x = "Predicción del Algoritmo",
y = "Realidad académica (Observada)") +
theme_minimal() +
theme(axis.text = element_text(size = 12, face = "bold"),
title = element_text(size = 14, face = "bold"),
legend.position = "none")
ANÁLISIS MATRIZ DE CONFUSUÓN
Verdaderos Negativos (4910): El modelo predijo que el estudiante Aprobaria el examen (nota mayor a 65) y, efectivamente, aprobaron ¡Excelente!
Falsos Positivos (245): El modelo predijo reprobación, pero el estudiante Aprobó.
Verdaderos Positivos (332): El modelo predijo que el estudiante reprobaba y el efectivamente reprobaron.
Falsos Negativos (1120): El modelo predijo Aprobado, pero en realidad reprobaron la asignatura.
En terminós del problema de invesgación orientado a predecir estudiantes que reprobarian, los Los falsos negativos son de particular interes porque el número de posibles errores es muy alto. 1120 estudiantes son presentados por el modelo como aprobados cuando en realidad reprobarian, esto quiere decir que se pierde la posibilidad de acompañar a 1120 estudiantes que al reprobar podrian desertar del sistema escolar. Este hecho es preocupante a nivel laboral, social y educativo. A continuación confirmamos con las métricas derivadas el poder del modelo
# --- EXTRACCIÓN DE CUADRANTES PARA MÉTRICAS CLÍNICAS ---
# En R, la tabla se lee: tabla[Fila, Columna]
TN_mul0.5 <- matriz_confusionlg0.5[1, 1] # Verdadero Negativo (Real 0, Pred 0)
FN_mul0.5 <- matriz_confusionlg0.5[1, 2] # Falso Negativo (Real 1, Pred 0)
FP_mul0.5 <- matriz_confusionlg0.5[2, 1] # Falso Positivo (Real 0, Pred 1)
TP_mul0.5 <- matriz_confusionlg0.5[2, 2] # Verdadero Positivo (Real 1, Pred 1)
sensibilidad_0.5 <- TP_mul0.5 / (TP_mul0.5 + FN_mul0.5)
especificidad_0.5 <- TN_mul0.5 / (TN_mul0.5 + FP_mul0.5)
precision_0.5 <- (TP_mul0.5 + TN_mul0.5) / (TP_mul0.5 + TN_mul0.5 + FP_mul0.5 + FN_mul0.5)
cat("Precision Global (Accuracy):", round(precision_0.5 * 100, 2), "%\n")## Precision Global (Accuracy): 79.34 %cat("Sensibilidad (Exito en detectar riesgo):", round(sensibilidad_0.5 * 100, 2), "%\n")## Sensibilidad (Exito en detectar riesgo): 22.87 %cat("Especificidad (Exito en descartar sanos):", round(especificidad_0.5 * 100, 2), "%\n")## Especificidad (Exito en descartar sanos): 95.25 %Como se venia diciendo, La precisión global del 79.34 % y Especificidad (Exito en descartar sanos): 95.25 % son muy buenos para el modelo logistico múltiple, pero como nuestro enfoque es identificar a tiempo para prevenir reprobación y deserción, la Sensibilidad (Exito en detectar riesgo) del 22.87 % resulta baja. Por esta razón se calculará el área bajo la curva ROC (AUC) para evaluar la capacidad discriminante del modelo logístico. Este indicador resume el desempeño clasificatorio del modelo para todos los puntos de corte posibles, siendo menos sensible al desbalance de clases que la precisión global.
library(pROC)## Warning: package 'pROC' was built under R version 4.5.3## Type 'citation("pROC")' for a citation.##
## Adjuntando el paquete: 'pROC'## The following objects are masked from 'package:stats':
##
## cov, smooth, varprob <- predict(modelo_definitivolg, type="response")
roc_obj <- roc(datos_completos_lgmul$Exam_Score, prob)## Setting levels: control = 0, case = 1## Setting direction: controls < casesplot(roc_obj, print.auc=TRUE)
auc(roc_obj)## Area under the curve: 0.7729En este caso particular, con corte 0.50 la sensibilidad fue baja, la AUC = 0.7729 mostró que el modelo sí ordena razonablemente bien los niveles de riesgo. Esto sugiere que el problema no era el modelo en sí, sino el umbral de clasificación utilizado. Por lo cual, se buscará un corte más adecuado.
coords(roc_obj, "best", ret=c("threshold","sensitivity","specificity","accuracy"))## threshold sensitivity specificity accuracy
## threshold 0.2044439 0.7334711 0.6741028 0.68715En sintesis el problema no se encuentra en el modelo precisamente, si no en el punto de corte para discriminar, en este caso se sugiere cambiar de 0.5 a 0.2044. Esto aumentaria la sencibilidad aunque podría disminuir Precision Global.
EVALUACIÓN DEL PODER PREDICTIVO con punto de corte en 0.20
Para evaluar qué tan bueno es nuestro modelo tomando decisiones, generamos predicciones de probabilidad y las comparamos con los datos reales usando una Matriz de Confusión
# 4. EVALUACIÓN DEL PODER PREDICTIVO DEL MODELO
# 1. Probabilidades predichas
probabilidadesmul0.2 <- predict(modelo_definitivolg, type = "response")
# 2. Clasificación con nuevo punto de corte
prediccionesmul0.2 <- ifelse(probabilidadesmul0.2 > 0.2044, 1, 0)
# 3. Matriz de confusión
matriz_confusionlg0.2 <- table(
Prediccion = prediccionesmul0.2,
Real = modelo_definitivolg$y
)
print(matriz_confusionlg0.2)## Real
## Prediccion 0 1
## 0 3475 387
## 1 1680 1065# 4. Accuracy
precisionmul0.2 <- sum(diag(matriz_confusionlg0.2)) / sum(matriz_confusionlg0.2)
cat("La precisión global del modelo es:",
round(precisionmul0.2 * 100, 2), "%\n")## La precisión global del modelo es: 68.71 %# --- EXTRACCIÓN DE CUADRANTES PARA MÉTRICAS CLÍNICAS ---
# En R, la tabla se lee: tabla[Fila, Columna]
TN_mul0.2 <- matriz_confusionlg0.2[1, 1] # Verdadero Negativo (Real 0, Pred 0)
FN_mul0.2 <- matriz_confusionlg0.2[1, 2] # Falso Negativo (Real 1, Pred 0)
FP_mul0.2 <- matriz_confusionlg0.2[2, 1] # Falso Positivo (Real 0, Pred 1)
TP_mul0.2 <- matriz_confusionlg0.2[2, 2] # Verdadero Positivo (Real 1, Pred 1)
sensibilidad_0.2 <- TP_mul0.2 / (TP_mul0.2 + FN_mul0.2)
especificidad_0.2 <- TN_mul0.2 / (TN_mul0.2 + FP_mul0.2)
precision_0.2 <- (TP_mul0.2 + TN_mul0.2) / (TP_mul0.2 + TN_mul0.2 + FP_mul0.2 + FN_mul0.2)
cat("Precision Global (Accuracy):", round(precision_0.2 * 100, 2), "%\n")## Precision Global (Accuracy): 68.71 %cat("Sensibilidad (Exito en detectar riesgo):", round(sensibilidad_0.2 * 100, 2), "%\n")## Sensibilidad (Exito en detectar riesgo): 73.35 %cat("Especificidad (Exito en descartar sanos):", round(especificidad_0.2 * 100, 2), "%\n")## Especificidad (Exito en descartar sanos): 67.41 %# --- EXTRACCIÓN DE CUADRANTES PARA MÉTRICAS ---
# 1. Se toma la matriz de confusión real que calculamos en el paso anterior
# (Asumiendo que ya corriste el código donde creaste 'matriz_confusion')
datos_reales_mul0.2 <- as.data.frame(as.table(matriz_confusionlg0.2))
colnames(datos_reales_mul0.2) <- c("Predicho", "Real", "Frecuencia")
# 2. Aseguramos que los niveles estén en el orden correcto (0=Aprobado, 1=Riesgo)
datos_reales_mul0.2$Predicho <- factor(ifelse(datos_reales_mul0.2$Predicho == 1, "Riesgo (1)", "Aprobado (0)"),
levels = c("Aprobado (0)", "Riesgo (1)"))
datos_reales_mul0.2$Real <- factor(ifelse(datos_reales_mul0.2$Real == 1, "Riesgo (1)", "Aprobado (0)"),
levels = c("Riesgo (1)", "Aprobado (0)")) # Invertido para el eje Y
# 3. Generamos el gráfico
ggplot(datos_reales_mul0.2, aes(x = Predicho, y = Real, fill = Frecuencia)) +
geom_tile(color = "black", linewidth = 1) +
geom_text(aes(label = Frecuencia), size = 8, fontface = "bold") +
scale_fill_gradient(low = "white", high = "#E74C3C") + # Usamos rojo para denotar riesgo
labs(title = "Matriz de Confusión: Modelo de Riesgo Reprobación",
subtitle = "Evaluación empírica sobre n = 6607 estudiantes",
x = "Predicción del Algoritmo",
y = "Realidad académica (Observada)") +
theme_minimal() +
theme(axis.text = element_text(size = 12, face = "bold"),
title = element_text(size = 14, face = "bold"),
legend.position = "none")
### Análisis del poder predictivo cambiando punto de corte
La reducción del punto de corte de 0.50 a 0.2044 incrementó la sensibilidad del modelo de 22.87% a 73.35%, mejorando sustancialmente la detección de estudiantes en riesgo de reprobación. Aunque la precisión global descendió, el nuevo umbral resulta más pertinente para fines los preventivos más coherentes con la acción educativa. Aunque Precision Global (Accuracy) bajó a 68.71 %.
Analisis Global
En conclusión el modelo logistico múltiple resulta más adecuado que el modelo logístico simple y mucho más que los modelos de regresión lineales, simple o múltiple. Sin embargo, se debe analizar con expertos si el modelo de regresión logístico múltiple es más adecuado con el punto de corte en 0.5 o en 0.2044. De manera a priorí y en relación con el proposito de la investigación, podemos decir que resulta mpas conveniente identificar más casos de riesgo de reprobación para activar planes de acción y evitar la deserción. Por eso el modelo con corte en 0.2044 puede ser adecuado, principalmente porque Falsos Negativos los predichos como Aprobado, pero que en realidad reprobaron la asignatura bajaron 1120 a 387.
En Cualquier caso, los modelos de regresión logística múltiple analizados hasta el momento solo alcanzan un porcentaje cercano al 80%, indicando que hay otras variables que influyen en el rendimiento académico. Una de nuestras hiposis es que los factores familiares aumentaria la presición del modelo. Ya que la participación del padre de familia y el estilo de crianza puede influir directamente en las variables asignadas al estudiante.
Considerar variables asociadas a factores familiares implica ampliar la base de datos, por lo cual actualmente se estan diseñando y validando nuevos instrumentos para complementar la base de datos. Esta actividad de completar la base de datos también se confirma si aplicamos la regla de Eventos por Variable.