LOGIT MULTIPLE 25/02/2024
2024-02-25
ENUNCIADO 1
Un estudio considera que existe relación entre el hecho de que un estudiante asista a clases de repaso de lectura (sí = 1, no = 0), la nota que obtiene en un examen de lectura estándar (realizado antes de iniciar las clases de repaso) y el sexo (hombre = 1, mujer = 0). Se quiere generar un modelo en el que a partir de las variables puntuación del examen y sexo, prediga la probabilidad de que el estudiante tenga que asistir a clases de repaso.
datos <- data.frame(sexo = c("hombre", "hombre", "mujer", "mujer", "mujer", "hombre",
"mujer", "hombre", "mujer", "mujer", "hombre", "hombre",
"hombre", "hombre", "mujer", "mujer", "hombre", "mujer",
"hombre", "mujer", "hombre", "mujer", "mujer", "hombre",
"hombre", "mujer", "mujer", "mujer", "hombre", "hombre",
"hombre", "mujer", "hombre", "mujer", "hombre", "mujer",
"mujer", "mujer", "mujer", "mujer", "hombre", "mujer",
"hombre", "mujer", "mujer", "mujer", "mujer", "hombre",
"mujer", "hombre", "mujer", "hombre", "mujer", "mujer",
"hombre", "hombre", "hombre", "hombre", "hombre", "hombre",
"hombre", "hombre", "hombre", "mujer", "hombre", "hombre",
"hombre", "hombre", "mujer", "hombre", "mujer", "hombre",
"hombre", "hombre", "mujer", "hombre", "mujer", "mujer",
"hombre", "mujer", "mujer", "mujer", "hombre", "hombre",
"hombre", "hombre", "hombre", "mujer", "mujer", "mujer",
"mujer", "hombre", "mujer", "mujer", "mujer", "mujer",
"mujer", "mujer", "mujer", "mujer","mujer", "mujer",
"hombre", "mujer", "hombre", "hombre", "mujer", "mujer",
"mujer", "hombre","mujer", "hombre", "mujer", "mujer",
"mujer", "hombre", "mujer", "hombre", "mujer", "hombre",
"mujer", "hombre", "mujer", "mujer", "mujer", "mujer",
"mujer", "mujer", "mujer", "mujer", "hombre", "mujer",
"hombre", "hombre", "hombre", "hombre", "hombre", "hombre",
"hombre", "mujer","mujer", "mujer", "hombre", "hombre",
"mujer", "mujer", "hombre", "mujer", "hombre", "hombre",
"hombre", "mujer", "mujer", "mujer", "mujer", "hombre",
"hombre", "mujer", "hombre", "hombre", "mujer", "hombre",
"hombre", "hombre", "hombre", "mujer", "hombre", "hombre",
"mujer", "mujer", "hombre", "hombre", "hombre", "hombre",
"hombre", "mujer", "mujer", "mujer", "mujer", "hombre",
"hombre", "hombre", "mujer", "hombre", "mujer", "hombre",
"hombre", "hombre", "mujer"),
examen_lectura = c(91, 77.5, 52.5, 54, 53.5, 62, 59, 51.5,
61.5, 56.5, 47.5, 75, 47.5, 53.5, 50, 50,
49, 59, 60, 60, 60.5, 50, 101, 60, 60,
83.5, 61, 75, 84, 56.5, 56.5, 45, 60.5,
77.5, 62.5, 70, 69, 62, 107.5, 54.5, 92.5,
94.5, 65, 80, 45, 45, 66, 66, 57.5, 42.5,
60, 64, 65, 47.5, 57.5, 55, 55, 76.5,
51.5, 59.5, 59.5, 59.5, 55, 70, 66.5,
84.5, 57.5, 125, 70.5, 79, 56, 75, 57.5,
56, 67.5, 114.5, 70, 67, 60.5, 95, 65.5,
85, 55, 63.5, 61.5, 60, 52.5, 65, 87.5,
62.5, 66.5, 67, 117.5, 47.5, 67.5, 67.5,
77, 73.5, 73.5, 68.5, 55, 92, 55, 55, 60,
120.5, 56, 84.5, 60, 85, 93, 60, 65, 58.5,
85, 67, 67.5, 65, 60, 47.5, 79, 80, 57.5,
64.5, 65, 60, 85, 60, 58, 61.5, 60, 65,
93.5, 52.5, 42.5, 75, 48.5, 64, 66, 82.5,
52.5, 45.5, 57.5, 65, 46, 75, 100, 77.5,
51.5, 62.5, 44.5, 51, 56, 58.5, 69, 65,
60, 65, 65, 40, 55, 52.5, 54.5, 74, 55,
60.5, 50, 48, 51, 55, 93.5, 61, 52.5,
57.5, 60, 71, 65, 60, 55, 60, 77, 52.5,
95, 50, 47.5, 50, 47, 71, 65),
clases_repaso = c("0", "0", "0", "0", "0", "0", "0", "0",
"0", "0", "0", "0", "0", "0", "0", "0",
"0", "0", "0", "0", "0", "0", "0", "0",
"0", "0", "0", "0", "0", "0", "0", "0",
"0", "0", "0", "0", "0", "0", "0", "0",
"0", "0", "0", "0", "0", "0", "0", "0",
"0", "0", "0", "0", "0", "0", "0", "0",
"0", "0", "0", "0", "0", "0", "0", "0",
"0", "0", "0", "0", "0", "0", "0", "0",
"0", "0", "0", "0", "0", "0", "0", "0",
"0", "0", "0", "0", "0", "0", "0", "0",
"0", "0", "0", "0", "0", "0", "0", "0",
"0", "0", "0", "0", "0", "0", "0", "0",
"0", "0", "0", "0", "0", "0", "0", "0",
"0", "0", "0", "0", "0", "0", "0", "0",
"0", "0", "0", "0", "0", "0", "0", "0",
"0", "0", "1", "1", "1", "1", "1", "1",
"1", "1", "1", "1", "1", "1", "1", "1",
"1", "1", "1", "1", "1", "1", "1", "1",
"1", "1", "1", "1", "1", "1", "1", "1",
"1", "1", "1", "1", "1", "1", "1", "1",
"1", "1", "1", "1", "1", "1", "1", "1",
"1", "1", "1", "1", "1", "1", "1", "1",
"1", "1", "1", "1", "1"))
datos$sexo <- as.factor(datos$sexo)
datos$clases_repaso <- as.factor(datos$clases_repaso)# librerias
# -------------
library(ggplot2)#Tablas de datos
tabla <- table(datos$clases_repaso, datos$sexo,
dnn = c("clases de repaso", "sexo"))
addmargins(tabla)## sexo
## clases de repaso hombre mujer Sum
## 0 57 73 130
## 1 36 23 59
## Sum 93 96 189Un total de 130 personas no recibieron clases de repaso. De este total, 57 personas fueron hombres y 73 fueron mujeres.
Un total de 59 personas sí recibieron clases de repaso. De este total, 36 personas fueron hombres y 23 fueron mujeres.
De la muestra tenemos 93 hombres, de los cuales 57 no acuideron a clases de repaos y 36 sí las recibieron.
De la muestra tenemos 96 hombres, de los cuales 73 no acuideron a clases de repaos y 23 sí las recibieron.
En total, se encuestaron a 189 personas (130+59 = 93 + 96 = 57 + 73 + 36 + 23 = 189 = N)
# Tabla de frecuencias relativas bidimensionales
#-------------------------------------------
relativas <- prop.table(tabla)*100
addmargins(relativas)## sexo
## clases de repaso hombre mujer Sum
## 0 30.15873 38.62434 68.78307
## 1 19.04762 12.16931 31.21693
## Sum 49.20635 50.79365 100.00000# Plot
#------------------------
ggplot(data = datos, aes(x = clases_repaso, y = examen_lectura, colour = sexo))+
geom_boxplot()+
theme_bw()+
theme(legend.position = "bottom")
* El grupo de hombres presenta la misma media del examen de lectura
habiendo acudido a clases de repaso o no (aprox: 60).
- El grupo de mujeres presenta la misma media del examen de lectura habiendo acudido a clases de repaso o no (aprox: 60-65).
Los hombres y mujeres que no acuden a clases de repaso muestran una media similar, puesto que los diagramas de caja comparten valores.
Los hombres y mujeres que sí acuden a clases de repaso muestran una media similar, puesto que los diagramas de caja comparten valores.
# Resumen descriptivo
#--------------------
library(skimr)
skim(datos)| Name | datos |
| Number of rows | 189 |
| Number of columns | 3 |
| _______________________ | |
| Column type frequency: | |
| factor | 2 |
| numeric | 1 |
| ________________________ | |
| Group variables | None |
Variable type: factor
| skim_variable | n_missing | complete_rate | ordered | n_unique | top_counts |
|---|---|---|---|---|---|
| sexo | 0 | 1 | FALSE | 2 | muj: 96, hom: 93 |
| clases_repaso | 0 | 1 | FALSE | 2 | 0: 130, 1: 59 |
Variable type: numeric
| skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
|---|---|---|---|---|---|---|---|---|---|---|
| examen_lectura | 0 | 1 | 64.9 | 15.29 | 40 | 55 | 60.5 | 70 | 125 | ▆▇▂▁▁ |
Modelo de regresión logística
modelo_glm <- glm(clases_repaso ~ examen_lectura+sexo+examen_lectura*sexo, data = datos, family = "binomial")
summary(modelo_glm)##
## Call:
## glm(formula = clases_repaso ~ examen_lectura + sexo + examen_lectura *
## sexo, family = "binomial", data = datos)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.016518 0.988258 1.029 0.304
## examen_lectura -0.023469 0.015568 -1.507 0.132
## sexomujer -0.224009 1.597278 -0.140 0.888
## examen_lectura:sexomujer -0.006767 0.025013 -0.271 0.787
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 234.67 on 188 degrees of freedom
## Residual deviance: 224.57 on 185 degrees of freedom
## AIC: 232.57
##
## Number of Fisher Scoring iterations: 4No son relevantes, al ser los p-valores superiores a 0.05.
modelo_glm <- glm(clases_repaso ~ examen_lectura+sexo, data = datos, family = "binomial")
summary(modelo_glm)##
## Call:
## glm(formula = clases_repaso ~ examen_lectura + sexo, family = "binomial",
## data = datos)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.18365 0.78559 1.507 0.1319
## examen_lectura -0.02617 0.01223 -2.139 0.0324 *
## sexomujer -0.64749 0.32484 -1.993 0.0462 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 234.67 on 188 degrees of freedom
## Residual deviance: 224.64 on 186 degrees of freedom
## AIC: 230.64
##
## Number of Fisher Scoring iterations: 4Ahora sí son relevantes, al ser los p-valores inferiores a 0.05.
Examen lectura(-0.02) (-). Se estima que un aumento en la nota del examen de lectura provocaría una disminución de la probabilidad “acudir a clases de repaso”.
Efecto diferenciador (-0.64) (-). Se estima que una mujer tiene menor probabilidad que un hombre en acudir a las clases de repaso si mantienen las mismas características sociodemográficas y económicas.
# Intervalos de confianza
#--------------------------
confint(modelo_glm)## Waiting for profiling to be done...## 2.5 % 97.5 %
## (Intercept) -0.2973940 2.799267537
## examen_lectura -0.0518029 -0.003536647
## sexomujer -1.2931216 -0.015658932Examen lectura [-; -]. Cualquier valor dentro del intervalo muestra un valor negativo, indicando que el coeficiente poblacional será negativo para una confianza del 95%. Esto implica que aumentos unitarios de la nota de lectura dan lugar a una menor probabilidad de acudir a las clases de repaso.
Sexo [-; -] Todos los valores del intervalo indican que una mujer tiene una menor probabilidad que un hombre de las mismas características de acudir a clases de repaso.
# Intervalos de confianza basados en el error estándar
#----------------------------------------------------
confint.default(modelo_glm)## 2.5 % 97.5 %
## (Intercept) -0.35608462 2.723378445
## examen_lectura -0.05015001 -0.002192983
## sexomujer -1.28416605 -0.010807125Examen lectura [-; -]. Cualquier valor dentro del intervalo muestra un valor negativo, indicando que el coeficiente poblacional será negativo para una confianza del 95%. Esto implica que aumentos unitarios de la nota de lectura dan lugar a una menor probabilidad de acudir a las clases de repaso.
Sexo [-; -] Todos los valores del intervalo indican que una mujer tiene una menor probabilidad que un hombre de las mismas características de acudir a clases de repaso.
Representación gráfica
str(datos)## 'data.frame': 189 obs. of 3 variables:
## $ sexo : Factor w/ 2 levels "hombre","mujer": 1 1 2 2 2 1 2 1 2 2 ...
## $ examen_lectura: num 91 77.5 52.5 54 53.5 62 59 51.5 61.5 56.5 ...
## $ clases_repaso : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...library(ggplot2)
#Pasar a numerica
datos$clases_repaso <- as.numeric(as.character(datos$clases_repaso))
#Nuevos valores para simular la curva de probabilidades
#A.- cuantiitativa
nuevos_valores_examen <- seq(from = min(datos$examen_lectura),
to = max(datos$examen_lectura), by = 0.5) #1000
#B.- cualitativa
sexo <- as.factor(rep(x = "hombre", length(nuevos_valores_examen))) #1000
#Predicciones
predicciones <- predict(object = modelo_glm,
newdata=data.frame(examen_lectura=nuevos_valores_examen,
sexo = sexo),
type = "response")
#Datos curva HOMBRES
datos_curva_hombre <- data.frame(examen_lectura = nuevos_valores_examen,
sexo = sexo,
clases_repaso = predicciones)
#Mujeres
nuevos_valores_examen <- seq(from = min(datos$examen_lectura),
to = max(datos$examen_lectura), by = 0.5)
sexo <- as.factor(rep("mujer", length(nuevos_valores_examen)))
predicciones <- predict(object = modelo_glm,
newdata=data.frame(examen_lectura=nuevos_valores_examen,
sexo = sexo),
type = "response")
datos_curva_mujer <- data.frame(examen_lectura = nuevos_valores_examen,
sexo = sexo, clases_repaso = predicciones)
# Se unifican los dos dataframe.
datos_curva <- rbind(datos_curva_hombre, datos_curva_mujer)ggplot(data = datos, aes(x=examen_lectura, y=as.numeric(clases_repaso), color = sexo)) +
geom_point() +
geom_line(data = datos_curva, aes(y = clases_repaso)) +
geom_line(data = datos_curva, aes(y = clases_repaso)) +
theme_bw() +
labs(title = "Probabilidades diferenciadas por sexo") +
theme(plot.title = element_text(size = 10))
Se observa que para los hombres y las mujeres, a medida que aumenta la
nota del examen de lectura del examen, disminuye la probabilidad de
acudir a clases de repaos. No obstante, las probabilidades de los
hombres siempre son mayores que las probabilidades de la mujer para
cualquier dato de la nota del examen de lectura. Esto implica que un
hombre tiene más probabilidades que una mujer de acudir a las clases de
repaso.
Evaluación del modelo
R2 de Mac Fadden
L1 <- modelo_glm$deviance
print(L1)## [1] 224.6386L0 <- modelo_glm$null.deviance
print(L0)## [1] 234.672R2 <- 1-L1/L0
print(R2*100)## [1] 4.275494R2 = 4,27%
Al incluir las variables nota del examen de lectura y sexo, se mejora el logaritmo d ela función de verosimilitud en un 4.27% respecto al modelo sin variables (modelo nulo).
Razón de verosimilitudes
# Diferencia de residuos
dif_residuos <- modelo_glm$null.deviance - modelo_glm$deviance
# Grados de libertad
df <- modelo_glm$df.null - modelo_glm$df.residual
#p-value
p_value <- pchisq(q = dif_residuos, df = df, lower.tail = FALSE)paste("Diferencia de residuos:", round(dif_residuos, 4))## [1] "Diferencia de residuos: 10.0334"paste("Grados de libertad:", round(df, 4))## [1] "Grados de libertad: 2"paste("P valor:", round(p_value, 4))## [1] "P valor: 0.0066"El p valor es 0.0066 < 0.05. Tenemos evidencia suficiente para rechazar la hipótesis nula, es decir, que la regresión es conjuntamente significativa.
Matriz de confusón
# Predicciones
#-------------------------
predicciones <- ifelse(test = modelo_glm$fitted.values > 0.5, yes = 1, no =0)matriz_confusion <- table(modelo_glm$model$clases_repaso, predicciones,
dnn = c("observaciones", "predicciones"))
matriz_confusion## predicciones
## observaciones 0 1
## 0 129 1
## 1 56 3Fiabilidad <- (129+3)/(129+1+56+3)
Fiabilidad*100## [1] 69.84127El modelo permite clasificar correctamente el 69,84% de los datos.
library(vcd)## Loading required package: gridlibrary(mosaic)## Registered S3 method overwritten by 'mosaic':
## method from
## fortify.SpatialPolygonsDataFrame ggplot2##
## The 'mosaic' package masks several functions from core packages in order to add
## additional features. The original behavior of these functions should not be affected by this.##
## Attaching package: 'mosaic'## The following objects are masked from 'package:dplyr':
##
## count, do, tally## The following object is masked from 'package:Matrix':
##
## mean## The following object is masked from 'package:vcd':
##
## mplot## The following object is masked from 'package:skimr':
##
## n_missing## The following object is masked from 'package:ggplot2':
##
## stat## The following objects are masked from 'package:stats':
##
## binom.test, cor, cor.test, cov, fivenum, IQR, median, prop.test,
## quantile, sd, t.test, var## The following objects are masked from 'package:base':
##
## max, mean, min, prod, range, sample, summosaic(matriz_confusion, shade = T, colorize = T,
gp = gpar(fill = matrix(c("green", "red", "red", "green"), 2, 2)))
Matriz de confusón
# Predicciones
#-------------------------
predicciones <- ifelse(test = modelo_glm$fitted.values > 0.45, yes = 1, no =0)matriz_confusion <- table(modelo_glm$model$clases_repaso, predicciones,
dnn = c("observaciones", "predicciones"))
matriz_confusion## predicciones
## observaciones 0 1
## 0 122 8
## 1 45 14Fiabilidad <- (122+14)/(122+8+45+14)
Fiabilidad*100## [1] 71.95767El modelo permite clasificar correctamente el 71,95% de los datos.
mosaic(matriz_confusion, shade = T, colorize = T,
gp = gpar(fill = matrix(c("green", "red", "red", "green"), 2, 2)))
Conclusiones
El modelo logístico creado para predecir la probabilidad de que un alumno tenga que asistir a clases de repaso a partir de la nota obtenida en un examen de lectura y el sexo del alumno es en conjunto significativo acorde al Likelihood ratio (p-value = 0.0066). El p-value de ambos predictores es significativo (examen_lectura = 0.0324, sexo1 = 0.0462). El ratio de error obtenido empleando las observaciones con las que se ha entrenado el modelo muestra un porcentaje de falsos negativos muy alto.
Info de la sesión
sesion_info <- devtools::session_info()
dplyr::select(
tibble::as_tibble(sesion_info$packages),
c(package, loadedversion, source)
)## # A tibble: 85 × 3
## package loadedversion source
## <chr> <chr> <chr>
## 1 base64enc 0.1-3 CRAN (R 4.3.1)
## 2 bslib 0.5.1 CRAN (R 4.3.2)
## 3 cachem 1.0.8 CRAN (R 4.3.2)
## 4 callr 3.7.3 CRAN (R 4.3.2)
## 5 cli 3.6.1 CRAN (R 4.3.2)
## 6 colorspace 2.1-0 CRAN (R 4.3.2)
## 7 crayon 1.5.2 CRAN (R 4.3.2)
## 8 devtools 2.4.5 CRAN (R 4.3.2)
## 9 digest 0.6.33 CRAN (R 4.3.2)
## 10 dplyr 1.1.3 CRAN (R 4.3.2)
## # ℹ 75 more rows