Regresión Logística para predicciones de alumnos que aparecen en cuadro de honor (SI/NO) y su calificación en Matemáticas

Objetivo

• Determinar un modelo de regresión logística que permita realizar predicciones para encontrar la probabilidad de que un alumno aparezca en el cuadro de honor con la calificación de matemáticas registrada.

Descripción

• Se genera una función sigmoide y se ysa para entender la probabilidad de que un alumno obtenga una calificación de matemáticas tal que permita predecir la probabilidad de que aparezca en el cuadro de honor la matrícula igual a 1.
• Se visualiza un diagrama de caja en relación a la calificación de matemáticas y los que NO aparecen y SI aparecen en el cuadro de honor en la columna matrícula.
• Se identifican los coeficientes del modelo y se interpretan resultados.

Las librerías

library(ggplot2)
library(vcd)

## Warning: package 'vcd' was built under R version 3.6.3

## Loading required package: grid

library(knitr)

Los datos

• Se generan datos, en el vector matricula se determinan valores 0 si NO aparecen en el cuadro de honor y 1 si SI aparece.
• Se generan calificaciones de una asignatura de matemáticas.
• Se integra un conjunto de datos en un data.frame llamado datos.
• Se visualizan los primeros y últimos 10 registros de datos.
• Se determina el valor de n la cantidad de observaciones de los datos.

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, 10)

##    matricula matematicas
## 1          0          41
## 2          0          53
## 3          0          54
## 4          0          47
## 5          0          57
## 6          0          51
## 7          0          42
## 8          0          45
## 9          0          54
## 10         0          52

tail(datos)

##     matricula matematicas
## 195         1          60
## 196         0          52
## 197         0          38
## 198         0          57
## 199         1          58
## 200         1          65

n <- nrow(datos)
n

## [1] 200

Tabla de Frecuencias

• Hay 151 casos de que NO aparecen en el cuadro de honor.
• Existen 49 casos de SI aparecen en el cuadro de honor.

Tabla de casos de Honor y No Honor.

• Matrícula = 0
• Matrícula = 1

table(datos$matricula)

## 
##   0   1 
## 151  49

Graficando los datos

• Crear boxplot de la relación que existe entre calificación de matemáticas y los que NO aparecen (matrícula = 0) y SI aparecen (matrícula = 1) en el cuadro de honor.
• ¿Qué significa la gráfica?
• A mayor calificación de matemáticas es más probable que aparezcan en cuadro de honor o matrícula = 1.

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")

Generar el modelo de regresión logística

• La fórmula que utiliza el modelo de regresión logística es matricula en función de la calificación de matemáticas.
• El coeficiente estimado para la intersección es el valor esperado del logaritmo que en un estudiante obtenga matrícula teniendo una cierta calificación de matemáticas.
• exp(-9.793942) = 5.579e-5
• Lo que corresponde con una probabilidad de obtener matrícula de 5.579e-5 cuando la calificación de matemáticas es 0.
• Sin embargo, para cada valor de calificación de matemáticas, el valor de la probabilidad de predicción aumenta. Probabilidad:

.

# Generar el modelo de regresión logística
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

Gráfica de la función sigmoide de matrícula con relación a matemáticas

• Codificación 0,1 es la variable respuesta

datos$matriucla <- as.character(datos$matricula)
datos$matricula <- as.numeric(datos$matricula)

plot(matricula ~ matematicas, datos, col = "darkblue",
     main = "Modelo de regresión logística",
     ylab = "P(matricula=1|matematicas)",
     xlab = "matemáticas", pch = "I")

# type = "response" devuelve las predicciones en forma de probabilidad en lugar de en log_ODDs
curve(predict(modelo, data.frame(matematicas = x), type = "response"), col = "firebrick", lwd = 2.5, add = TRUE)

Codificar a valores 0 y 1 los valores ajustados del modelo ‘modelo$fitted.values’

• Por desición del analista, se recodifican las probabilidades con una variable en R llamada predicciones_modelo, poniendo 0 cuando la probabilidad es menor o igual a 0.5 y 1 cuando la probabilidad es mayor a 0.5
• Se agrega una nueva columna a los datos originales que sería la predicción conforme al modelo.

predicciones_modelo <- ifelse(modelo$fitted.values > 0.5, 1, 0)
datos$predicciones <- (as.vector(predicciones_modelo))

Mostrando el conjunto de datos

• Columna 1 es la matrícula
• Columna 2 es la calificación de matemáticas
• Columna 3 es la predicción hecha por el modelo

kable(datos)

matricula	matematicas	matriucla	predicciones
1	41	0	0
1	53	0	0
1	54	0	0
1	47	0	0
1	57	0	0
1	51	0	0
1	42	0	0
1	45	0	0
1	54	0	0
1	52	0	0
1	51	0	0
2	51	1	0
1	71	0	1
2	57	1	0
1	50	0	0
1	43	0	0
1	51	0	0
1	60	0	0
2	62	1	0
1	57	0	0
1	35	0	0
2	75	1	1
1	45	0	0
1	57	0	0
1	45	0	0
1	46	0	0
2	66	1	1
1	57	0	0
1	49	0	0
1	49	0	0
1	57	0	0
1	64	0	1
2	63	1	1
1	57	0	0
1	50	0	0
2	58	1	0
1	75	0	1
2	68	1	1
1	44	0	0
1	40	0	0
1	41	0	0
1	62	0	0
1	57	0	0
1	43	0	0
2	48	1	0
1	63	0	1
1	39	0	0
1	70	0	1
1	63	0	1
1	59	0	0
2	61	1	0
1	38	0	0
1	61	0	0
1	49	0	0
2	73	1	1
1	44	0	0
1	42	0	0
1	39	0	0
1	55	0	0
1	52	0	0
1	45	0	0
2	61	1	0
1	39	0	0
1	41	0	0
1	50	0	0
1	40	0	0
1	60	0	0
1	47	0	0
1	59	0	0
1	49	0	0
1	46	0	0
1	58	0	0
2	71	1	1
1	58	0	0
1	46	0	0
1	43	0	0
2	54	1	0
1	56	0	0
1	46	0	0
1	54	0	0
1	57	0	0
1	54	0	0
1	71	0	1
2	48	1	0
1	40	0	0
2	64	1	1
1	51	0	0
1	39	0	0
1	40	0	0
1	61	0	0
2	66	1	1
1	49	0	0
2	65	1	1
1	52	0	0
1	46	0	0
2	61	1	0
2	72	1	1
2	71	1	1
1	40	0	0
2	69	1	1
1	64	0	1
1	56	0	0
1	49	0	0
1	54	0	0
1	53	0	0
1	66	0	1
2	67	1	1
1	40	0	0
1	46	0	0
2	69	1	1
1	40	0	0
1	41	0	0
1	57	0	0
2	58	1	0
2	57	1	0
1	37	0	0
1	55	0	0
2	62	1	0
1	64	0	1
1	40	0	0
1	50	0	0
1	46	0	0
1	53	0	0
1	52	0	0
2	45	1	0
1	56	0	0
1	45	0	0
1	54	0	0
1	56	0	0
1	41	0	0
1	54	0	0
2	72	1	1
2	56	1	0
1	47	0	0
1	49	0	0
2	60	1	0
1	54	0	0
1	55	0	0
1	33	0	0
1	49	0	0
1	43	0	0
1	50	0	0
1	52	0	0
1	48	0	0
1	58	0	0
1	43	0	0
2	41	1	0
1	43	0	0
1	46	0	0
1	44	0	0
1	43	0	0
1	61	0	0
1	40	0	0
1	49	0	0
2	56	1	0
1	61	0	0
1	50	0	0
1	51	0	0
1	42	0	0
2	67	1	1
2	53	1	0
1	50	0	0
2	51	1	0
2	72	1	1
1	48	0	0
1	40	0	0
1	53	0	0
1	39	0	0
2	63	1	1
1	51	0	0
1	45	0	0
1	39	0	0
1	42	0	0
1	62	0	0
1	44	0	0
1	65	0	1
2	63	1	1
1	54	0	0
1	45	0	0
2	60	1	0
2	49	1	0
1	48	0	0
2	57	1	0
2	55	1	0
2	66	1	1
2	64	1	1
1	55	0	0
1	42	0	0
2	56	1	0
1	53	0	0
1	41	0	0
1	42	0	0
1	53	0	0
1	42	0	0
2	60	1	0
1	52	0	0
1	38	0	0
1	57	0	0
2	58	1	0
2	65	1	1

Evaluar el modelo

• ¿Qué tan exacto es el modelo para predecir?
• La exactitud es la cantidad de predicciones positivas que son correctas, en este caso se determina la exactitud con los valores ajustados del modelo. ### Generando una matriz de confusión
• Se crea la matriz de confusión.
• Con el vector datos$matricula original 0 o 1.
• Y con el vector ajustados del modelo 0 o 1.
• De los 200 datos originales, de la matriz de confunsión interesa por lo pronto lo siguiente:
• • ¿Cuántos valores en matrícula son 0 originalmente y cuántos fueron ajustados con valor 0 correctamente? Falsos Positivos
• • ¿Cuántos valores en matrícula son 1 originalmente y cuántos fueron ajustados con valor 1 correctamente? Verdaderos Positivos
• • De los 200 datos, hay 151 casos con valores igual a 0 en matrícula, con el modelo de regresión logística se obtuvieron 140 casos ajustados y acertados correctamente y se falló en 11.
• • De los 200 datos, hay 149 casos con valores igual a 1 en matrícula, con el modelo de regresión logística se obtuvieron 22 casos ajustados y acertados correctamente y se falló en 22.
• ¿Qué significa?

matriz_confusion <- table(datos$matricula, datos$predicciones, dnn = c("matrícula original", "predicciones"))
matriz_confusion

##                   predicciones
## matrícula original   0   1
##                  1 140  11
##                  2  27  22

Interpretación de la matriz de confusión

• La exactitud.
• El modelo es capaz de clasificar y predecir correctamente (140 + 22)/200 = 0.81(81%) de las observaciones.

cat ("Total de casos ", n)

## Total de casos  200

cat ("Total de aciertos = ", (matriz_confusion[1,1] + matriz_confusion[2,2]) / n)

## Total de aciertos =  0.81

Predicciones con el modelo de regresión logística

Predicciones usando la fórmula

Probabilidad

• ¿Cuál es la predicción de un alumno para cuando tiene valor de matemáticas 33?
• ¿Cuál es la predicción de un alumno para cuando tiene valor de matemáticas 50?
• ¿Cuál es la predicción de un alumno para cuando tiene valor de matemáticas 60?
• ¿Cuál es la predicción de un alumno para cuando tiene valor de matemáticas 70?
• Verificar las predicciones para las calificaciones de 33, 50, 60 y 70 cuando se generan por la función predict().

nuevos_valores <- c(33, 50, 60, 70)
prediccion_manual <- exp (−9.793942 + 0.15634 * nuevos_valores) / (1 + exp (−9.793942 + 0.15634 * nuevos_valores))
prediccion_manual

## [1] 0.009615451 0.121645200 0.398063121 0.759484979

Nuevos valores a predecir

• Los nuevos puntos son nuevas calificaciones a partir de 33 y con incrementos de 0.5 hasta llegar 75.
• Los nuevos puntos pudiera entenderse como datos de validación o prueba para ser aplicados en el modelo y generar la predicción.

nuevos_puntos <- seq(from = min(datos$matematicas), to = max(datos$matematicas),by = 0.5)

nuevos_puntos

##  [1] 33.0 33.5 34.0 34.5 35.0 35.5 36.0 36.5 37.0 37.5 38.0 38.5 39.0 39.5 40.0
## [16] 40.5 41.0 41.5 42.0 42.5 43.0 43.5 44.0 44.5 45.0 45.5 46.0 46.5 47.0 47.5
## [31] 48.0 48.5 49.0 49.5 50.0 50.5 51.0 51.5 52.0 52.5 53.0 53.5 54.0 54.5 55.0
## [46] 55.5 56.0 56.5 57.0 57.5 58.0 58.5 59.0 59.5 60.0 60.5 61.0 61.5 62.0 62.5
## [61] 63.0 63.5 64.0 64.5 65.0 65.5 66.0 66.5 67.0 67.5 68.0 68.5 69.0 69.5 70.0
## [76] 70.5 71.0 71.5 72.0 72.5 73.0 73.5 74.0 74.5 75.0

Predicciones de los nuevos puntos

• Como si fuera un conjunto de datos de validación

predicciones <- predict(modelo, data.frame(matematicas = nuevos_puntos), se.fit = TRUE)
predicciones

## $fit
##           1           2           3           4           5           6 
## -4.63471038 -4.55654020 -4.47837002 -4.40019984 -4.32202967 -4.24385949 
##           7           8           9          10          11          12 
## -4.16568931 -4.08751913 -4.00934896 -3.93117878 -3.85300860 -3.77483842 
##          13          14          15          16          17          18 
## -3.69666824 -3.61849807 -3.54032789 -3.46215771 -3.38398753 -3.30581736 
##          19          20          21          22          23          24 
## -3.22764718 -3.14947700 -3.07130682 -2.99313664 -2.91496647 -2.83679629 
##          25          26          27          28          29          30 
## -2.75862611 -2.68045593 -2.60228576 -2.52411558 -2.44594540 -2.36777522 
##          31          32          33          34          35          36 
## -2.28960504 -2.21143487 -2.13326469 -2.05509451 -1.97692433 -1.89875415 
##          37          38          39          40          41          42 
## -1.82058398 -1.74241380 -1.66424362 -1.58607344 -1.50790327 -1.42973309 
##          43          44          45          46          47          48 
## -1.35156291 -1.27339273 -1.19522255 -1.11705238 -1.03888220 -0.96071202 
##          49          50          51          52          53          54 
## -0.88254184 -0.80437167 -0.72620149 -0.64803131 -0.56986113 -0.49169095 
##          55          56          57          58          59          60 
## -0.41352078 -0.33535060 -0.25718042 -0.17901024 -0.10084007 -0.02266989 
##          61          62          63          64          65          66 
##  0.05550029  0.13367047  0.21184065  0.29001082  0.36818100  0.44635118 
##          67          68          69          70          71          72 
##  0.52452136  0.60269153  0.68086171  0.75903189  0.83720207  0.91537225 
##          73          74          75          76          77          78 
##  0.99354242  1.07171260  1.14988278  1.22805296  1.30622313  1.38439331 
##          79          80          81          82          83          84 
##  1.46256349  1.54073367  1.61890385  1.69707402  1.77524420  1.85341438 
##          85 
##  1.93158456 
## 
## $se.fit
##         1         2         3         4         5         6         7         8 
## 0.6532674 0.6410488 0.6288535 0.6166829 0.6045386 0.5924220 0.5803350 0.5682794 
##         9        10        11        12        13        14        15        16 
## 0.5562574 0.5442710 0.5323227 0.5204152 0.5085513 0.4967341 0.4849670 0.4732538 
##        17        18        19        20        21        22        23        24 
## 0.4615987 0.4500059 0.4384807 0.4270283 0.4156549 0.4043671 0.3931722 0.3820784 
##        25        26        27        28        29        30        31        32 
## 0.3710949 0.3602317 0.3494999 0.3389122 0.3284823 0.3182259 0.3081603 0.2983048 
##        33        34        35        36        37        38        39        40 
## 0.2886808 0.2793124 0.2702261 0.2614513 0.2530204 0.2449690 0.2373357 0.2301621 
##        41        42        43        44        45        46        47        48 
## 0.2234924 0.2173730 0.2118517 0.2069762 0.2027933 0.1993464 0.1966743 0.1948089 
##        49        50        51        52        53        54        55        56 
## 0.1937734 0.1935812 0.1942349 0.1957258 0.1980352 0.2011347 0.2049887 0.2095554 
##        57        58        59        60        61        62        63        64 
## 0.2147894 0.2206432 0.2270689 0.2340194 0.2414494 0.2493160 0.2575791 0.2662020 
##        65        66        67        68        69        70        71        72 
## 0.2751507 0.2843945 0.2939056 0.3036588 0.3136315 0.3238036 0.3341567 0.3446746 
##        73        74        75        76        77        78        79        80 
## 0.3553426 0.3661476 0.3770779 0.3881227 0.3992728 0.4105194 0.4218548 0.4332721 
##        81        82        83        84        85 
## 0.4447650 0.4563277 0.4679551 0.4796425 0.4913856 
## 
## $residual.scale
## [1] 1

Convertido a probabilidades las predicciones

predicciones_prob <- exp(predicciones$fit) / (1 + exp(predicciones$fit))
predicciones_prob

##           1           2           3           4           5           6 
## 0.009615562 0.010389249 0.011224482 0.012126041 0.013099054 0.014149025 
##           7           8           9          10          11          12 
## 0.015281854 0.016503865 0.017821824 0.019242973 0.020775051 0.022426319 
##          13          14          15          16          17          18 
## 0.024205592 0.026122257 0.028186305 0.030408352 0.032799659 0.035372158 
##          19          20          21          22          23          24 
## 0.038138464 0.041111891 0.044306459 0.047736902 0.051418657 0.055367861 
##          25          26          27          28          29          30 
## 0.059601325 0.064136505 0.068991458 0.074184786 0.079735560 0.085663235 
##          31          32          33          34          35          36 
## 0.091987534 0.098728324 0.105905462 0.113538621 0.121647088 0.130249544 
##          37          38          39          40          41          42 
## 0.139363815 0.149006597 0.159193163 0.169937053 0.181249737 0.193140276 
##          43          44          45          46          47          48 
## 0.205614973 0.218677025 0.232326188 0.246558447 0.261365732 0.276735659 
##          49          50          51          52          53          54 
## 0.292651324 0.309091155 0.326028838 0.343433314 0.361268868 0.379495303 
##          55          56          57          58          59          60 
## 0.398068206 0.416939312 0.436056949 0.455366564 0.474811325 0.494332771 
##          61          62          63          64          65          66 
## 0.513871512 0.533367947 0.552762991 0.571998783 0.591019371 0.609771345 
##          67          68          69          70          71          72 
## 0.628204401 0.646271845 0.663930996 0.681143510 0.697875612 0.714098231 
##          73          74          75          76          77          78 
## 0.729787049 0.744922469 0.759489505 0.773477614 0.786880463 0.799695659 
##          79          80          81          82          83          84 
## 0.811924441 0.823571354 0.834643901 0.845152199 0.855108627 0.864527492 
##          85 
## 0.873424703

Crear un conjunto de datos con las predicciones de los nuevos valores

• Valor de matemáticas a predecir son los nuevos_puntos.
• Su predicción es el valor probabilístico conforme al valor de matemáticas.
• Verificar la probabilidad de la predicción para los valores de matemáticas = 33, 50, 60 y 70 que se obtuvieron conforme a la fórmula de predicción y probabilidad en el paso anterior

las.predicciones <- data.frame(nuevos_puntos, predicciones_prob)
colnames(las.predicciones) <- c('matematicas', 'prob.prediccion.matricula')
las.predicciones

##    matematicas prob.prediccion.matricula
## 1         33.0               0.009615562
## 2         33.5               0.010389249
## 3         34.0               0.011224482
## 4         34.5               0.012126041
## 5         35.0               0.013099054
## 6         35.5               0.014149025
## 7         36.0               0.015281854
## 8         36.5               0.016503865
## 9         37.0               0.017821824
## 10        37.5               0.019242973
## 11        38.0               0.020775051
## 12        38.5               0.022426319
## 13        39.0               0.024205592
## 14        39.5               0.026122257
## 15        40.0               0.028186305
## 16        40.5               0.030408352
## 17        41.0               0.032799659
## 18        41.5               0.035372158
## 19        42.0               0.038138464
## 20        42.5               0.041111891
## 21        43.0               0.044306459
## 22        43.5               0.047736902
## 23        44.0               0.051418657
## 24        44.5               0.055367861
## 25        45.0               0.059601325
## 26        45.5               0.064136505
## 27        46.0               0.068991458
## 28        46.5               0.074184786
## 29        47.0               0.079735560
## 30        47.5               0.085663235
## 31        48.0               0.091987534
## 32        48.5               0.098728324
## 33        49.0               0.105905462
## 34        49.5               0.113538621
## 35        50.0               0.121647088
## 36        50.5               0.130249544
## 37        51.0               0.139363815
## 38        51.5               0.149006597
## 39        52.0               0.159193163
## 40        52.5               0.169937053
## 41        53.0               0.181249737
## 42        53.5               0.193140276
## 43        54.0               0.205614973
## 44        54.5               0.218677025
## 45        55.0               0.232326188
## 46        55.5               0.246558447
## 47        56.0               0.261365732
## 48        56.5               0.276735659
## 49        57.0               0.292651324
## 50        57.5               0.309091155
## 51        58.0               0.326028838
## 52        58.5               0.343433314
## 53        59.0               0.361268868
## 54        59.5               0.379495303
## 55        60.0               0.398068206
## 56        60.5               0.416939312
## 57        61.0               0.436056949
## 58        61.5               0.455366564
## 59        62.0               0.474811325
## 60        62.5               0.494332771
## 61        63.0               0.513871512
## 62        63.5               0.533367947
## 63        64.0               0.552762991
## 64        64.5               0.571998783
## 65        65.0               0.591019371
## 66        65.5               0.609771345
## 67        66.0               0.628204401
## 68        66.5               0.646271845
## 69        67.0               0.663930996
## 70        67.5               0.681143510
## 71        68.0               0.697875612
## 72        68.5               0.714098231
## 73        69.0               0.729787049
## 74        69.5               0.744922469
## 75        70.0               0.759489505
## 76        70.5               0.773477614
## 77        71.0               0.786880463
## 78        71.5               0.799695659
## 79        72.0               0.811924441
## 80        72.5               0.823571354
## 81        73.0               0.834643901
## 82        73.5               0.845152199
## 83        74.0               0.855108627
## 84        74.5               0.864527492
## 85        75.0               0.873424703

Gráfica de calificaciones a partir de 33 hasta 75

• Se parece a la gráfica de la función Sigmoide S
• A partir de una calificación de 63 en matemáticas, se predice con una nueva probabilidad mayor al 50%.

plot(las.predicciones)

Valores a predecir del ejercicio

• Vamos a predecir si alumnos con las calificaciones de 45, 55, 65, 75 y 85 son merecedores del cuadro de honor.
• • Usando el método manual:

nuevos_valores <- c(45, 55, 65, 75, 85)
prediccion_manual <- exp (−9.793942 + 0.15634 * nuevos_valores) / (1 + exp (−9.793942 + 0.15634 * nuevos_valores))
prediccion_manual

## [1] 0.05960043 0.23232272 0.59101381 0.87342177 0.97054397

• • Usando el otro método:

nuevos_puntos <- c(45, 55, 65, 75, 85)
predicciones <- predict(modelo, data.frame(matematicas = nuevos_puntos), se.fit = TRUE)
predicciones

## $fit
##         1         2         3         4         5 
## -2.758626 -1.195223  0.368181  1.931585  3.494988 
## 
## $se.fit
##         1         2         3         4         5 
## 0.3710949 0.2027933 0.2751507 0.4913856 0.7337444 
## 
## $residual.scale
## [1] 1

Interpretación personal

• El conjunto de datos que se nos proporciona contiene 200 registros de las calificaciones de alumnos en matemáticas y si esos alumnos están en el cuadro de honor o no.
• Observamos que hay 151 alumnos que NO están en el cuadro de honor. Mientras que hay 49 alumnos que SI están en el cuadro de honor.
• Cuando observé los datos traté de deducir(por lógica) que a partir de cierta calificación, era acreedor el alumno a estar en el cuadro de honor, sin embargo me equivoqué, había casos de alumnos con calificación de 45 y SI estaba en el cuadro de honor, mientras que otro alumno con calificación de 65 NO estaba en el cuadro de honor. Así que el modelo de predicción la tendría difícil.
• Los resultados de el modelo de predicción fueron:
• • De los 200 datos, hay 151 casos con valores igual a 0 en matrícula, con el modelo de regresión logística se obtuvieron 140 casos ajustados y acertados correctamente y se falló en 11.
• • De los 200 datos, había 149 casos con valores igual a 1 en matrícula, con el modelo de regresión logística se obtuvieron 22 casos ajustados y acertados correctamente y se falló en 22.
• • EL MODELO TIENE UN 81% DE EXACTITUD.
• Las calificaciones que se pidieron predecir en el ejercicio y sus resultados (por mi interpretación) fueron:
• • 45: Arrojó (0.05960043 y -2.758626, por lo que NO va al cuadro de honor.
• • 55: Arrojó (0.23232272 y -1.195223, por lo que NO va al cuadro de honor.
• • 65: Arrojó (0.59101381 y -0.368181, por lo que SI va al cuadro de honor.
• • 75: Arrojó (0.87342177 y 1.931585, por lo que SI va al cuadro de honor.
• • 85: Arrojó (0.97054397 y 3.494988, por lo que SI va al cuadro de honor.