PREGUNTA 11

Un estudio quiere establecer un modelo que permita calcular la probabilidad de obtener una matrícula de honor al final del bachillerato en función de la nota que se ha obtenido en matemáticas. La variable matrícula está codificada como 0 si no se tiene matrícula y 1 si se tiene.

 a)   Genere la ecuación logística. Interprete los odds. Grafique el modelo.

b)   Realice la prueba estadística para saber si hay diferencia de los residuos del modelo y el modelo nulo.

c)    A un nivel de confianza es del 95%, ¿cuál es el intervalo de confianza?

d)   compare de clasificación predicha y observaciones.

matricula <- as.factor(c(0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0,
1, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0,
0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0,
1, 0, 0, 0, 0, 1, 0, 1, 0, 0, 1, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0,
0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 1, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 1, 0, 1,
1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 1, 0, 1, 1, 1, 1, 0, 0, 1,
0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1)) 
matematicas <- c(41, 53, 54, 47, 57, 51,
42, 45, 54, 52, 51, 51, 71, 57, 50, 43, 51, 60, 62, 57, 35, 75, 45, 57, 45, 46,
66, 57, 49, 49, 57, 64, 63, 57, 50, 58, 75, 68, 44, 40, 41, 62, 57, 43, 48, 63,
39, 70, 63, 59, 61, 38, 61, 49, 73, 44, 42, 39, 55, 52, 45, 61, 39, 41, 50, 40,
60, 47, 59, 49, 46, 58, 71, 58, 46, 43, 54, 56, 46, 54, 57, 54, 71, 48, 40, 64,
51, 39, 40, 61, 66, 49, 65, 52, 46, 61, 72, 71, 40, 69, 64, 56, 49, 54, 53, 66,
67, 40, 46, 69, 40, 41, 57, 58, 57, 37, 55, 62, 64, 40, 50, 46, 53, 52, 45, 56,
45, 54, 56, 41, 54, 72, 56, 47, 49, 60, 54, 55, 33, 49, 43, 50, 52, 48, 58, 43,
41, 43, 46, 44, 43, 61, 40, 49, 56, 61, 50, 51, 42, 67, 53, 50, 51, 72, 48, 40,
53, 39, 63, 51, 45, 39, 42, 62, 44, 65, 63, 54, 45, 60, 49, 48, 57, 55, 66, 64,
55, 42, 56, 53, 41, 42, 53, 42, 60, 52, 38, 57, 58, 65) 
datos<-data.frame(matricula, matematicas)
head(datos,4)
##   matricula matematicas
## 1         0          41
## 2         0          53
## 3         0          54
## 4         0          47
library(ggplot2) 
## Warning: package 'ggplot2' was built under R version 4.2.2
table(datos$matricula)
## 
##   0   1 
## 151  49
ggplot(data = datos, aes(x = matricula, y = matematicas, color = matricula)) + geom_boxplot(outlier.shape = NA) + geom_jitter(width = 0.1) + theme_bw() + theme(legend.position = "null")

Parece existir una diferencia entre la nota de las personas con matrícula y sin matrícula.

modelo<-glm(matricula~matematicas,data=datos, family = "binomial")
summary(modelo)
## 
## Call:
## glm(formula = matricula ~ matematicas, family = "binomial", data = datos)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.0332  -0.6785  -0.3506  -0.1565   2.6143  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept) -9.79394    1.48174  -6.610 3.85e-11 ***
## matematicas  0.15634    0.02561   6.105 1.03e-09 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 222.71  on 199  degrees of freedom
## Residual deviance: 167.07  on 198  degrees of freedom
## AIC: 171.07
## 
## Number of Fisher Scoring iterations: 5

HIPÓTESIS DE PRUEBA H0: No hay efecto significativo de la variable matemáticas en la probabilidad de la matrícula ( coeficiente de la variable matemáticas es cero). H1: Hay efecto significativo de la variable matemáticas en la probabilidad de la matrícula PVALOR=0.000<0.05. Se rechaza Ho.

Conclusión: Con un nivel de signifcacióndel 5%, eee para rechazar Ho, es decir, Hay efecto significativo de la variable matemáticas en la probabilidad de la matrícula.

Prueba de normalidad

residuos <- residuals(modelo, type = "deviance")
shapiro.test(residuos)
## 
##  Shapiro-Wilk normality test
## 
## data:  residuos
## W = 0.87402, p-value = 7.408e-12

H0: Los residuos siguen una distribución normal H1: Los residuos no siguen una distribución normal PVALOR=0.000<0.05. Se rechaza Ho. Los residuos no siguen una distribución normal

Hallar los odd

#El coeficiente estimado para la intersección es el valor esperado del logaritmo de odds de que un estudiante obtenga matrícula teniendo un 0 en en matemáticas. Como es de esperar, los odds son muy bajos
exp(-9.793394)
## [1] 5.581913e-05

lo que se corresponde con una probabilidad de obtener matrícula de 0.00

Acorde al modelo, el logaritmo de los odds de que un estudiante tenga matrícula está positivamente relacionado con la puntuación obtenida en matemáticas (coeficiente de regresión = 0.1563404). Interpretación coeficiente de regresión :

Esto significa que, por cada unidad que se incrementa la variable matemáticas, se espera que el logaritmo de odds de la variable matrícula se incremente en promedio 0.1563404 unidades.

exp(0.1563404)
## [1] 1.169224

se obtiene que, por cada unidad que se incrementa la variable matemáticas, los odds de obtener matrícula se incremente en promedio 1.169 unidades. No hay que confundir esto último con que la probabilidad de matrícula se incremente un 1.169 %.

confint(object=modelo,level = 0.95)
## Waiting for profiling to be done...
##                   2.5 %     97.5 %
## (Intercept) -12.9375208 -7.0938806
## matematicas   0.1093783  0.2103937

Gráfico del modelo

datos$matricula<-as.character(datos$matricula)
datos$matricula<-as.numeric(datos$matricula)
plot(matricula~matematicas, datos, col="darkblue", main="modelo regresión logística", ylab="P(Matrícula=1, matematicas)", xlab="matemáticas", pch="I")

matricula<-as.character(datos$matricula)
datos$matricula<-as.numeric(datos$matricula)
# Se crea un vector con nuevos valores interpolados en el rango de observaciones. 
nuevos_puntos <- seq(from = min(datos$matematicas), to = max(datos$matematicas), by = 0.5) 

predicciones <- predict(modelo, data.frame(matematicas = nuevos_puntos), se.fit = TRUE) 
# Mediante la función logit se transforman los log_ODDs a probabilidades. 
predicciones_logit <- exp(predicciones$fit) / (1 + exp(predicciones$fit)) # Se calcula el límite inferior y superior del IC del 95% sustrayendo e # incrementando el logODDs de cada predicción 1.95*SE. Una vez calculados los 
# logODDs del intervalo se transforman en probabilidades con la función logit. 


limite_inferior <- predicciones$fit - 1.96 * predicciones$se.fit

limite_inferior_logit <- exp(limite_inferior) / (1 + exp(limite_inferior)) 

limite_superior <- predicciones$fit + 1.96 * predicciones$se.fit

limite_superior_logit <- exp(limite_superior) / (1 + exp(limite_superior)) 
# Se crea un data frame con los nuevos puntos y sus predicciones
datos_curva <- data.frame(matematicas = nuevos_puntos, probabilidad_matricula = predicciones_logit, limite_inferior_logit = limite_inferior_logit, limite_superior_logit =limite_superior_logit)
ggplot(datos, aes(x = matematicas, y = matricula)) + geom_point(aes(color = as.factor(matricula)), shape = "I", size = 3) + geom_line(data = datos_curva, aes(y = probabilidad_matricula), color = "firebrick") + geom_line(data = datos_curva, aes(y = limite_inferior_logit), linetype = "dashed") + geom_line(data = datos_curva, aes(y = limite_superior_logit), linetype = "dashed") + theme_bw() + labs(title = "Modelo regresión logística matrícula ~ nota matemáticas", y = "P(matrícula = 1 | matemáticas)", y = "matemáticas") + theme(legend.position = "null") + theme(plot.title = element_text(hjust = 0.5))

Evaluación del modelo

A la hora de evaluar la validez y calidad de un modelo de regresión logística, se analiza tanto el modelo en su conjunto como los predictores que lo forman.

# Diferencia de residuos # En R, un objeto glm almacena la "deviance" del modelo, así como la "deviance" # del modelo nulo.
dif_residuos <- modelo$null.deviance - modelo$deviance 
# Grados libertad 
df <- modelo$df.null - modelo$df.residual 
df
## [1] 1
# p-value 4
p_value <- pchisq(q = dif_residuos,df = df, lower.tail = FALSE) 
p_value
## [1] 8.717591e-14
paste("Diferencia de residuos:", round(dif_residuos, 4))
## [1] "Diferencia de residuos: 55.6368"

HO: El modelo de regresión logística no proporciona ajuste significativamnete mejor que el modelo nulo. (La deviance entre el modelo ajustado y nulo es cero)

H1: El modelo de regresión logística proporciona un ajuste significativamente mejor que el modelo nulo, es decir, que la diferencia en la deviance entre el modelo ajustado y el modelo nulo es mayor que cero.

P_VALUR=0.000<0.05. Se Rechaza Ho. El modelo de regresión logística proporciona un ajuste significativamente mejor que el modelo nulo

Diferencia de residuos: 55.6368”

Interpretación: indica que el modelo ajustado explica mejor los datos que un modelo nulo que no tiene variables predictoras. Esto significa que la variable predictora (en este caso, la nota de matemáticas) es significativa para predecir la variable de respuesta (en este caso, la matrícula en el curso).

anova(modelo, test = "Chisq")
## Analysis of Deviance Table
## 
## Model: binomial, link: logit
## 
## Response: matricula
## 
## Terms added sequentially (first to last)
## 
## 
##             Df Deviance Resid. Df Resid. Dev  Pr(>Chi)    
## NULL                          199     222.71              
## matematicas  1   55.637       198     167.07 8.718e-14 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Comparación de clasificación predicha y observaciones

library(vcd) 
## Warning: package 'vcd' was built under R version 4.2.2
## Loading required package: grid
library(grid) 
predicciones<-ifelse(test=modelo$fitted.values>0.5, yes=1, no=0)


matriz_confusion <- table(modelo$model$matricula, predicciones,
 dnn = c("observaciones", "predicciones"))
matriz_confusion
##              predicciones
## observaciones   0   1
##             0 140  11
##             1  27  22

Interpretación:
De los 140 casos en que la verdadera clase fue “matrícula = 0”, el modelo predijo correctamente 140 de ellos como “matrícula = 0” (verdaderos negativos), pero predijo erróneamente 11 como “matrícula = 1” (falsos positivos).

mosaic(matriz_confusion, shade = T, colorize = T, gp = gpar(fill = matrix(c("green3", "red2", "red2", "green3"), 2, 2)))

# calcular especificidad
especificidad <- 140 / (140 + 11)
especificidad
## [1] 0.9271523

La especificidad se refiere a la capacidad del modelo para identificar correctamente a los casos negativos.

# Sensibilidad: 
 (sensibilidad <- matriz_confusion[2, 2]/sum(matriz_confusion[ , 2]))
## [1] 0.6666667
#[1] 0.6666667

# Especificidad:
 (especificidad <- matriz_confusion[1, 1]/sum(matriz_confusion[ , 1]))
## [1] 0.8383234
#[1] 0.8383234

Un valor de sensibilidad de 0.666 significa que el modelo puede detectar correctamente el 66.6 los casos positivos (aquellas personas que realmente tendrían matrícula). En otras palabras, la sensibilidad mide la capacidad del modelo para identificar correctamente a los verdaderos positivos.