# Cargar las librerías necesarias
library(tidyverse) # Para manipulación y visualización de datos
library(MASS) # Para la regresión logística ordinal
library(readr) # Para leer datos desde archivos CSV
library(knitr) # Para formatear tablasRegresión Logística Ordinal
1 - Regresión Logística Ordinal
La regresión logística ordinal es una herramienta para examinar la relación entre variables predictivas y la probabilidad de que un resultado ordinal caiga en una categoría particular o superior.
1.1 - Principios básicos de la regresión logística ordinal
- Categorías ordenadas: La variable dependiente tiene categorías ordenadas.
- Modelo Logit acumulativo: Relaciona las probabilidades logarítmicas de estar en una categoría o superior con variables predictivas.
- Cuotas proporcionales: Evaluar el supuesto de probabilidades proporcionales.
- Selección de modelo: Elegir variables predictivas adecuadas.
1.2 - Regresión Logística Ordinal en R Studio
1.2.1 - Base de Datos
La base de datos trata sobre el rendimiento académico de los estudiantes, contiene información de 998 estudiantes (cada fila representa a un estudiante), y para cada uno de esos estudiantes, tiene 13 características, considerando diferentes factores que pueden influir en su desempeño en matemáticas. Estos factores incluyen características demográficas como género, etnia, y el nivel educativo de los padres, además de elementos contextuales como el tipo de almuerzo que reciben, si han completado un curso de preparación para exámenes, y si participan en actividades extracurriculares.
También se tienen en cuenta aspectos como las horas de estudio, el acceso a recursos educativos y tecnológicos, la motivación del estudiante, el tipo de institución educativa (pública o privada), y si cuentan con acceso a tutoría. Todos estos factores se analizan para entender mejor cómo influyen en el rendimiento académico de los estudiantes, en particular en matemáticas.
| Variable | Categoría | Qué es? |
|---|---|---|
| gender | Variable categórica con categorías female y male | Género: female (femenino) o male (masculino) |
| race_ethnicity | Variable categórica con categorías group A, group B, group C, group D, group E | Etnia: grupos A, B, C, D, E |
| parental_level_of_education | Variable categórica con categorías associate’s degree, bachelor’s degree, high school, master’s degree, some college, some high school | Nivel educativo de los padres: associate’s degree (título de asociado), bachelor’s degree (licenciatura), high school (secundaria), master’s degree (máster), some college (algunos estudios universitarios), some high school (algunos estudios de secundaria) |
| lunch | Variable categórica con categorías free/reduced y standard | Tipo de almuerzo: free/reduced (gratuito/reducido), standard (estándar) |
| test_preparation_course | Variable categórica con categorías none y completed | Curso de preparación para exámenes: none (ninguno), completed (completado) |
| math_score | Variable ordinal con categorías Bajo Rendimiento, Rendimiento medio, Rendimiento alto | Puntaje en matemáticas: Bajo Rendimiento, Rendimiento medio, Rendimiento alto |
| study_hours | Variable continua (número de horas) | Horas de estudio |
| extracurricular | Variable categórica con categorías No y Si | Actividades extracurriculares: No o Si |
| resources_access | Variable categórica con categorías Bajo, Medio, Alto | Acceso a recursos: Bajo, Medio, Alto |
| institution_type | Variable categórica con categorías Privada y Publica | Tipo de institución: Privada o Publica |
| student_motivation | Variable categórica con categorías Baja, Media, Alta | Motivación del estudiante: Baja, Media, Alta |
| tutoring_access | Variable categórica con categorías No y Si | Acceso a tutoría: No o Si |
| tech_resources | Variable categórica con categorías Bajo, Medio, Alto | Recursos tecnológicos: Bajo, Medio, Alto |
1.2.2 - Carga de los Datos y Exploración Preliminar
Primero, cargamos las librerías necesarias para manejar y analizar los datos.
Cargamos los datos desde un archivo CSV, especificando que el delimitador es el punto y coma (;) y eliminamos los espacios en blanco al principio y al final de las entradas.
# Cargar el conjunto de datos desde el directorio
Student_Data <- read_delim("datos_actualizados.csv",
delim = ";", escape_double = FALSE, trim_ws = TRUE)1.3 - Análisis Exploratorio de Datos (EDA)
Realizamos un Análisis Exploratorio ya que es una manera de asegurarnos de que estamos usando buenos datos y tomando decisiones informadas desde el principio.
1.3.1 - Exploramos la Estructura de los Datos
# Resumen descriptivo de las variables numéricas
summary(Student_Data) gender race_ethnicity parental_level_of_education
Length:999 Length:999 Length:999
Class :character Class :character Class :character
Mode :character Mode :character Mode :character
lunch test_preparation_course math_score study_hours
Length:999 Length:999 Length:999 Min. : 1.000
Class :character Class :character Class :character 1st Qu.: 3.000
Mode :character Mode :character Mode :character Median : 6.000
Mean : 5.505
3rd Qu.: 8.000
Max. :10.000
extracurricular resources_access institution_type student_motivation
Length:999 Length:999 Length:999 Length:999
Class :character Class :character Class :character Class :character
Mode :character Mode :character Mode :character Mode :character
tutoring_access tech_resources
Length:999 Length:999
Class :character Class :character
Mode :character Mode :character
head(Student_Data)# A tibble: 6 × 13
gender race_ethnicity parental_level_of_education lunch test_preparation_cou…¹
<chr> <chr> <chr> <chr> <chr>
1 female group B bachelor's degree stan… none
2 female group C some college stan… completed
3 female group B master's degree stan… none
4 male group A associate's degree free… none
5 male group C some college stan… none
6 female group B associate's degree stan… none
# ℹ abbreviated name: ¹test_preparation_course
# ℹ 8 more variables: math_score <chr>, study_hours <dbl>,
# extracurricular <chr>, resources_access <chr>, institution_type <chr>,
# student_motivation <chr>, tutoring_access <chr>, tech_resources <chr>unique(Student_Data)# A tibble: 998 × 13
gender race_ethnicity parental_level_of_educat…¹ lunch test_preparation_cou…²
<chr> <chr> <chr> <chr> <chr>
1 female group B bachelor's degree stan… none
2 female group C some college stan… completed
3 female group B master's degree stan… none
4 male group A associate's degree free… none
5 male group C some college stan… none
6 female group B associate's degree stan… none
7 female group B some college stan… completed
8 male group B some college free… none
9 male group D high school free… completed
10 female group B high school free… none
# ℹ 988 more rows
# ℹ abbreviated names: ¹parental_level_of_education, ²test_preparation_course
# ℹ 8 more variables: math_score <chr>, study_hours <dbl>,
# extracurricular <chr>, resources_access <chr>, institution_type <chr>,
# student_motivation <chr>, tutoring_access <chr>, tech_resources <chr>1.3.2 - Revisamos las Variables
La selección de variables para convertirlas en factores u ordinales depende de su relevancia para el análisis y el modelo que se está construyendo.
Para comenzar vamos a convertir nuestra variable dependiente, que es math_score en un factor ordinal con niveles específicos que reflejen el rendimiento en matemáticas.
# Convertir la variable 'math_score' a un factor ordinal
Student_Data$math_score <- factor(Student_Data$math_score,
levels = c("Bajo Rendimiento", "Rendimiento medio", "Rendimiento alto"),
ordered = TRUE)# Verificar los niveles de la variable 'math_score'
levels(Student_Data$math_score)[1] "Bajo Rendimiento" "Rendimiento medio" "Rendimiento alto" # Resumen de la variable 'math_score'
table(Student_Data$math_score)
Bajo Rendimiento Rendimiento medio Rendimiento alto
338 485 176 Probablemente el desvalance notoriamente existente, puede darnos problemas entorno a la categoria Rendimiento alto.
Convertimos las demas variables a tipos que el modelo necesite, asegurando que las otras variables estén en el formato correcto (numéricas o categóricas).
# Asegurar que las variables numéricas sean de tipo numérico
Student_Data <- Student_Data %>%
mutate(
study_hours = as.numeric(study_hours)
)
# Convertir variables categóricas a factores
Student_Data <- Student_Data %>%
mutate(
gender = factor(gender),
race_ethnicity = factor(race_ethnicity),
parental_level_of_education = factor(parental_level_of_education),
lunch = factor(lunch),
test_preparation_course = factor(test_preparation_course),
institution_type = factor(institution_type),
student_motivation = factor(student_motivation),
tutoring_access = factor(tutoring_access),
tech_resources = factor(tech_resources),
extracurricular = factor(extracurricular),
resources_access = factor(resources_access, levels = c("Bajo", "Medio", "Alto")) # Convertir a factor con niveles definidos)
)1.4 - Ajuste del Modelo de Regresión Logística Ordinal
Ajustamos el modelo1 de regresión logística ordinal usando todas las variables. Esto nos ayudará a ver cómo cada variable contribuye al rendimiento en matemáticas.
# Ajustar el modelo de regresión logística ordinal
modelo1 <- polr(math_score ~ gender + race_ethnicity + parental_level_of_education + lunch + test_preparation_course + study_hours + extracurricular + resources_access + institution_type + student_motivation+ tutoring_access + tech_resources, data = Student_Data, Hess = TRUE)
# Resumen del primer modelo
summary(modelo1)Call:
polr(formula = math_score ~ gender + race_ethnicity + parental_level_of_education +
lunch + test_preparation_course + study_hours + extracurricular +
resources_access + institution_type + student_motivation +
tutoring_access + tech_resources, data = Student_Data, Hess = TRUE)
Coefficients:
Value Std. Error t value
gendermale 0.679404 0.12757 5.32557
race_ethnicitygroup B 0.457521 0.26216 1.74518
race_ethnicitygroup C 0.552410 0.24502 2.25450
race_ethnicitygroup D 0.790258 0.24906 3.17298
race_ethnicitygroup E 1.585667 0.27959 5.67131
parental_level_of_educationbachelor's degree 0.293064 0.22553 1.29945
parental_level_of_educationhigh school -0.622972 0.19979 -3.11819
parental_level_of_educationmaster's degree 0.447737 0.29147 1.53615
parental_level_of_educationsome college -0.039996 0.18822 -0.21250
parental_level_of_educationsome high school -0.395631 0.20183 -1.96020
lunchstandard 1.363764 0.13757 9.91297
test_preparation_coursenone -0.628179 0.13262 -4.73668
study_hours 0.008998 0.02255 0.39903
extracurricularSi -0.016189 0.12625 -0.12823
resources_accessMedio 0.158258 0.15657 1.01076
resources_accessAlto 0.083685 0.15249 0.54878
institution_typePublica 0.223477 0.12657 1.76570
student_motivationBaja 0.010740 0.15364 0.06990
student_motivationMedia 0.001926 0.15477 0.01245
tutoring_accessSi -0.144960 0.12636 -1.14721
tech_resourcesBajo -0.389254 0.15548 -2.50362
tech_resourcesMedio -0.326339 0.15525 -2.10203
Intercepts:
Value Std. Error t value
Bajo Rendimiento|Rendimiento medio 0.4570 0.3636 1.2569
Rendimiento medio|Rendimiento alto 3.1107 0.3781 8.2263
Residual Deviance: 1811.756
AIC: 1859.756 Coeficientes del Modelo1
Los coeficientes indican el efecto de cada variable en las probabilidades de que un estudiante esté en un nivel superior de rendimiento en matemáticas.
gendermale (Coeficiente: 0.6794): Los estudiantes masculinos tienen una mayor probabilidad de estar en un nivel superior de rendimiento en matemáticas en comparación con las estudiantes femeninas.
race_ethnicity: Los grupos de etnicidad tienen un impacto significativo en el rendimiento en matemáticas. A medida que se avanza a través de los grupos de etnicidad (de B a E), la probabilidad de estar en un nivel superior de rendimiento aumenta, con el grupo E mostrando el efecto más fuerte. Estos resultados sugieren que la etnicidad puede ser un factor importante en el rendimiento académico.
parental_level_of_education: El nivel educativo de los padres tiene un impacto mixto en el rendimiento en matemáticas. Tener un padre con una educación secundaria alta o con algo de secundaria tiene un efecto negativo. En contraste, tener un padre con un título de licenciatura o maestría puede tener un efecto positivo, pero los resultados no siempre son significativos. Esto sugiere que la educación parental puede influir en el rendimiento, pero el efecto no es consistente a través de todos los niveles educativos.
resources_access: El acceso a recursos educativos, tanto de nivel medio como alto, muestra un efecto positivo en el rendimiento en matemáticas, pero estos efectos no son estadísticamente significativos. Esto podría indicar que el impacto de los recursos educativos en el rendimiento en matemáticas no es tan fuerte o puede estar enmascarado por otras variables.
lunchstandard (Coeficiente: 1.3638): Los estudiantes que reciben almuerzo estándar tienen una mayor probabilidad de mejor rendimiento comparado con los que reciben almuerzo gratuito.
test_preparation_coursenone (Coeficiente: -0.6282): No tomar un curso de preparación para exámenes está asociado con una menor probabilidad de mejor rendimiento.
study_hours (Coeficiente: 0.0090): Cada hora adicional de estudio tiene un leve aumento en la probabilidad de mejor rendimiento.
extracurricular (Coeficiente: -0.0162): Participar en actividades extracurriculares no tiene un impacto significativo en el rendimiento.
institution_type: El tipo de institución (pública vs. privada) tiene un pequeño efecto positivo en el rendimiento en matemáticas, y aunque el efecto es marginalmente significativo, puede ser relevante para entender las diferencias en el rendimiento entre tipos de instituciones.
student_motivation: La motivación estudiantil, ya sea baja o media, no tiene un efecto significativo en el rendimiento en matemáticas. Esto podría indicar que otros factores pueden tener un impacto más fuerte en el rendimiento, o que la motivación no se mide de manera suficientemente precisa en este modelo.
tutoring_access: El acceso a tutoría no tiene un impacto significativo en el rendimiento en matemáticas según el modelo. Puede que la tutoría no sea un factor crucial o que la calidad y frecuencia de la tutoría varíen entre los estudiantes.
tech_resources: El acceso a recursos tecnológicos bajos o medios tiene un impacto negativo significativo en el rendimiento en matemáticas. Esto podría indicar que la falta de tecnología adecuada afecta de manera importante la capacidad de los estudiantes para tener un buen rendimiento.
Extraemos los coeficientes del modelo y calculamos los valores p para determinar qué variables son estadísticamente significativas.
# Obtener coeficientes del primer modelo
coeficientes1 <- summary(modelo1)$coefficients
# Crear dataframe con variables, t_value y p_value del primer modelo
resultados1 <- data.frame(
Variable = rownames(coeficientes1),
t_value = coeficientes1[, "t value"],
p_value = 2 * pt(abs(coeficientes1[, "t value"]), df = modelo1$df.residual, lower.tail = FALSE)
)
# Añadir columna de significancia
resultados1$Significativa <- ifelse(resultados1$p_value < 0.05, "Sí", "No")
kable(resultados1, caption = "Resultados del Primer Modelo de Regresión Logística Ordinal")| Variable | t_value | p_value | Significativa | |
|---|---|---|---|---|
| gendermale | gendermale | 5.3255738 | 0.0000001 | Sí |
| race_ethnicitygroup B | race_ethnicitygroup B | 1.7451799 | 0.0812686 | No |
| race_ethnicitygroup C | race_ethnicitygroup C | 2.2545032 | 0.0243858 | Sí |
| race_ethnicitygroup D | race_ethnicitygroup D | 3.1729752 | 0.0015561 | Sí |
| race_ethnicitygroup E | race_ethnicitygroup E | 5.6713079 | 0.0000000 | Sí |
| parental_level_of_educationbachelor’s degree | parental_level_of_educationbachelor’s degree | 1.2994453 | 0.1940983 | No |
| parental_level_of_educationhigh school | parental_level_of_educationhigh school | -3.1181924 | 0.0018730 | Sí |
| parental_level_of_educationmaster’s degree | parental_level_of_educationmaster’s degree | 1.5361453 | 0.1248272 | No |
| parental_level_of_educationsome college | parental_level_of_educationsome college | -0.2124966 | 0.8317641 | No |
| parental_level_of_educationsome high school | parental_level_of_educationsome high school | -1.9601956 | 0.0502574 | No |
| lunchstandard | lunchstandard | 9.9129712 | 0.0000000 | Sí |
| test_preparation_coursenone | test_preparation_coursenone | -4.7366768 | 0.0000025 | Sí |
| study_hours | study_hours | 0.3990250 | 0.6899621 | No |
| extracurricularSi | extracurricularSi | -0.1282303 | 0.8979931 | No |
| resources_accessMedio | resources_accessMedio | 1.0107610 | 0.3123816 | No |
| resources_accessAlto | resources_accessAlto | 0.5487809 | 0.5832814 | No |
| institution_typePublica | institution_typePublica | 1.7656955 | 0.0777599 | No |
| student_motivationBaja | student_motivationBaja | 0.0698990 | 0.9442884 | No |
| student_motivationMedia | student_motivationMedia | 0.0124468 | 0.9900717 | No |
| tutoring_accessSi | tutoring_accessSi | -1.1472136 | 0.2515748 | No |
| tech_resourcesBajo | tech_resourcesBajo | -2.5036179 | 0.0124556 | Sí |
| tech_resourcesMedio | tech_resourcesMedio | -2.1020322 | 0.0358065 | Sí |
| Bajo Rendimiento|Rendimiento medio | Bajo Rendimiento|Rendimiento medio | 1.2569309 | 0.2090797 | No |
| Rendimiento medio|Rendimiento alto | Rendimiento medio|Rendimiento alto | 8.2262708 | 0.0000000 | Sí |
Calculamos la precisión del modelo (proporción de predicciones correctas). Esto nos indica qué tan bien el modelo está funcionando.
# Predicción del primer modelo ajustado
prediccion1 <- predict(modelo1, newdata = Student_Data, type = "class")
# Crear matriz de confusión del primer modelo
tabla_conf_ajust1 <- table(Predicción = prediccion1, Realidad = Student_Data$math_score)
tabla_conf_ajust1 Realidad
Predicción Bajo Rendimiento Rendimiento medio Rendimiento alto
Bajo Rendimiento 145 104 6
Rendimiento medio 192 362 147
Rendimiento alto 1 19 23
El modelo parece estar teniendo dificultades para predecir la categoría “Rendimiento Alto”, ya que no hay ninguna predicción correcta en esta categoría. Esto podría indicar que el modelo no está capturando bien las características que permiten a los estudiantes alcanzar un alto rendimiento.
Además hay confusión entre “Bajo Rendimiento” y “Rendimiento Medio”, así como entre “Rendimiento Medio” y “Rendimiento Alto”. Estos errores indican que el modelo puede estar clasificando incorrectamente a estudiantes en niveles de rendimiento cercanos entre sí.
Esto sugiere que podría ser necesario ajustar el modelo o explorar otras variables para mejorar la precisión de las predicciones.
Calculamos las prediciones para una visión general del desempeño del modelo
# Calcular precisión del primer modelo
precision1 <- sum(diag(tabla_conf_ajust1)) / sum(tabla_conf_ajust1)
paste("Precisión ajustada del primer modelo:", round(precision1 * 100, 2), "%")[1] "Precisión ajustada del primer modelo: 53.05 %"Una precisión del 53.05% indica que el modelo está funcionando ligeramente mejor que el azar (en un modelo de clasificación de tres categorías, el azar tendría una precisión del 33.33% si todas las categorías fueran igualmente probables).
Esta precisión sugiere que hay espacio para mejorar el modelo, ya sea ajustando parámetros, añadiendo más variables, o utilizando técnicas adicionales para mejorar el rendimiento.
1.4.1 - Modificación Del Modelo
Para ajustar el modelo, eliminamos variables para ver cómo afecta esto a la precisión y la significancia, esto tomando encuenta las que tengan el p-value mas grande.
1.4.1.1 - Primera Eliminación
Para mejorar AIC y la capacidad predictiva del modelo, lo mejor sería eliminar las variables que tienen p-values más altos, ya que estas variables son menos significativas.
- resources_accessAlto: p-value = 0.5832814
- resources_accessMedio: p-value = 0.3123816
Por lo que eliminamos resources_access
# Ajustar el modelo de regresión logística ordinal
modelo2 <- polr(math_score ~ gender + race_ethnicity + parental_level_of_education + lunch + test_preparation_course + study_hours + extracurricular+ institution_type + student_motivation+ tutoring_access + tech_resources,
data = Student_Data, Hess = TRUE)
# Resumen del modelo
summary(modelo2)Call:
polr(formula = math_score ~ gender + race_ethnicity + parental_level_of_education +
lunch + test_preparation_course + study_hours + extracurricular +
institution_type + student_motivation + tutoring_access +
tech_resources, data = Student_Data, Hess = TRUE)
Coefficients:
Value Std. Error t value
gendermale 0.6758490 0.12748 5.301477
race_ethnicitygroup B 0.4477796 0.26180 1.710369
race_ethnicitygroup C 0.5431889 0.24467 2.220127
race_ethnicitygroup D 0.7778087 0.24854 3.129541
race_ethnicitygroup E 1.5802565 0.27909 5.662113
parental_level_of_educationbachelor's degree 0.3033531 0.22514 1.347381
parental_level_of_educationhigh school -0.6207563 0.19959 -3.110132
parental_level_of_educationmaster's degree 0.4579771 0.29161 1.570507
parental_level_of_educationsome college -0.0459167 0.18809 -0.244120
parental_level_of_educationsome high school -0.3999005 0.20165 -1.983149
lunchstandard 1.3614429 0.13753 9.898905
test_preparation_coursenone -0.6290461 0.13247 -4.748512
study_hours 0.0094944 0.02254 0.421272
extracurricularSi -0.0091066 0.12602 -0.072264
institution_typePublica 0.2235088 0.12649 1.766983
student_motivationBaja 0.0078109 0.15358 0.050858
student_motivationMedia 0.0007926 0.15474 0.005122
tutoring_accessSi -0.1492045 0.12613 -1.182923
tech_resourcesBajo -0.3848346 0.15536 -2.477026
tech_resourcesMedio -0.3267354 0.15521 -2.105183
Intercepts:
Value Std. Error t value
Bajo Rendimiento|Rendimiento medio 0.3684 0.3512 1.0491
Rendimiento medio|Rendimiento alto 3.0197 0.3655 8.2630
Residual Deviance: 1812.78
AIC: 1856.78 El AIC ha mejorado ligeramente a 1856.78, lo que sugiere que este modelo podría ser ligeramente mejor que el primero.
# Obtener coeficientes del primer modelo
coeficientes2 <- summary(modelo2)$coefficients
# Crear dataframe con variables, t_value y p_value del primer modelo
resultados2 <- data.frame(
Variable = rownames(coeficientes2),
t_value = coeficientes2[, "t value"],
p_value = 2 * pt(abs(coeficientes2[, "t value"]), df = modelo2$df.residual, lower.tail = FALSE)
)
# Añadir columna de significancia
resultados2$Significativa <- ifelse(resultados2$p_value < 0.05, "Sí", "No")
kable(resultados2, caption = "Resultados del segundo Modelo de Regresión Logística Ordinal")| Variable | t_value | p_value | Significativa | |
|---|---|---|---|---|
| gendermale | gendermale | 5.3014769 | 0.0000001 | Sí |
| race_ethnicitygroup B | race_ethnicitygroup B | 1.7103692 | 0.0875151 | No |
| race_ethnicitygroup C | race_ethnicitygroup C | 2.2201273 | 0.0266390 | Sí |
| race_ethnicitygroup D | race_ethnicitygroup D | 3.1295409 | 0.0018027 | Sí |
| race_ethnicitygroup E | race_ethnicitygroup E | 5.6621134 | 0.0000000 | Sí |
| parental_level_of_educationbachelor’s degree | parental_level_of_educationbachelor’s degree | 1.3473811 | 0.1781699 | No |
| parental_level_of_educationhigh school | parental_level_of_educationhigh school | -3.1101317 | 0.0019242 | Sí |
| parental_level_of_educationmaster’s degree | parental_level_of_educationmaster’s degree | 1.5705071 | 0.1166210 | No |
| parental_level_of_educationsome college | parental_level_of_educationsome college | -0.2441202 | 0.8071890 | No |
| parental_level_of_educationsome high school | parental_level_of_educationsome high school | -1.9831493 | 0.0476304 | Sí |
| lunchstandard | lunchstandard | 9.8989054 | 0.0000000 | Sí |
| test_preparation_coursenone | test_preparation_coursenone | -4.7485118 | 0.0000024 | Sí |
| study_hours | study_hours | 0.4212718 | 0.6736493 | No |
| extracurricularSi | extracurricularSi | -0.0722637 | 0.9424069 | No |
| institution_typePublica | institution_typePublica | 1.7669829 | 0.0775433 | No |
| student_motivationBaja | student_motivationBaja | 0.0508576 | 0.9594494 | No |
| student_motivationMedia | student_motivationMedia | 0.0051221 | 0.9959142 | No |
| tutoring_accessSi | tutoring_accessSi | -1.1829233 | 0.2371273 | No |
| tech_resourcesBajo | tech_resourcesBajo | -2.4770259 | 0.0134165 | Sí |
| tech_resourcesMedio | tech_resourcesMedio | -2.1051831 | 0.0355302 | Sí |
| Bajo Rendimiento|Rendimiento medio | Bajo Rendimiento|Rendimiento medio | 1.0490794 | 0.2944010 | No |
| Rendimiento medio|Rendimiento alto | Rendimiento medio|Rendimiento alto | 8.2629974 | 0.0000000 | Sí |
# Predicción del modelo ajustado
prediccion2 <- predict(modelo2, newdata = Student_Data, type = "class")
# Crear matriz de confusión
tabla_conf_ajust2 <- table(Predicción = prediccion2, Realidad = Student_Data$math_score)
tabla_conf_ajust2 Realidad
Predicción Bajo Rendimiento Rendimiento medio Rendimiento alto
Bajo Rendimiento 143 104 8
Rendimiento medio 194 366 145
Rendimiento alto 1 15 23El modelo predice el “Bajo Rendimiento” correctamente 143 veces, “Rendimiento medio” correctamente 366 veces, y “Rendimiento alto” 23 veces. Sin embargo, confunde “Rendimiento medio” con “Bajo Rendimiento” en 194 casos y “Rendimiento alto” con “Rendimiento medio” en 145 casos.
# Calcular precisión
precision2 <- sum(diag(tabla_conf_ajust2)) / sum(tabla_conf_ajust2)
paste("Precisión ajustada:", round(precision2 * 100, 2), "%")[1] "Precisión ajustada: 53.25 %"La precisión ajustada es de 53.25%, una mejora muy pequeña respecto al primer modelo, dado que ambos modelos parecen tener una precisión relativamente baja, esto sugiere que podría ser necesario seguir ajustando el modelo o explorar otras variables o interacciones para mejorar su capacidad predictiva.
1.4.1.2 - Segunda Eliminación
En este caso, las dos variables con los p-values más altos que no son significativas son:
- student_motivationMedia con un p-value de 0.9959
- student_motivationBaja con un p-value de 0.9594
# Ajustar el modelo de regresión logística ordinal
modelo3 <- polr(math_score ~ race_ethnicity + parental_level_of_education + lunch + test_preparation_course + study_hours + extracurricular+ institution_type + tutoring_access + tech_resources,
data = Student_Data, Hess = TRUE)
# Resumen del modelo
summary(modelo3)Call:
polr(formula = math_score ~ race_ethnicity + parental_level_of_education +
lunch + test_preparation_course + study_hours + extracurricular +
institution_type + tutoring_access + tech_resources, data = Student_Data,
Hess = TRUE)
Coefficients:
Value Std. Error t value
race_ethnicitygroup B 0.326077 0.25888 1.25956
race_ethnicitygroup C 0.415750 0.24165 1.72044
race_ethnicitygroup D 0.691213 0.24610 2.80870
race_ethnicitygroup E 1.471001 0.27651 5.31997
parental_level_of_educationbachelor's degree 0.285181 0.22378 1.27438
parental_level_of_educationhigh school -0.583241 0.19828 -2.94147
parental_level_of_educationmaster's degree 0.407453 0.29208 1.39502
parental_level_of_educationsome college -0.059277 0.18700 -0.31698
parental_level_of_educationsome high school -0.387711 0.20059 -1.93289
lunchstandard 1.349171 0.13644 9.88818
test_preparation_coursenone -0.624134 0.13167 -4.74012
study_hours 0.009608 0.02238 0.42939
extracurricularSi -0.003941 0.12525 -0.03147
institution_typePublica 0.225214 0.12540 1.79599
tutoring_accessSi -0.136155 0.12526 -1.08700
tech_resourcesBajo -0.341412 0.15402 -2.21672
tech_resourcesMedio -0.305456 0.15429 -1.97979
Intercepts:
Value Std. Error t value
Bajo Rendimiento|Rendimiento medio -0.0144 0.3340 -0.0432
Rendimiento medio|Rendimiento alto 2.5778 0.3451 7.4699
Residual Deviance: 1841.408
AIC: 1879.408 El AIC de 1879.408 es ligeramente más alto que en el modelo anterior, lo que sugiere que este modelo es un poco menos ajustado, y sigue siendo mejor el modelo2.
# Obtener coeficientes del primer modelo
coeficientes3 <- summary(modelo3)$coefficients
# Crear dataframe con variables, t_value y p_value del primer modelo
resultados3 <- data.frame(
Variable = rownames(coeficientes3),
t_value = coeficientes3[, "t value"],
p_value = 2 * pt(abs(coeficientes3[, "t value"]), df = modelo3$df.residual, lower.tail = FALSE)
)
# Añadir columna de significancia
resultados3$Significativa <- ifelse(resultados3$p_value < 0.05, "Sí", "No")
kable(resultados3, caption = "Resultados del Tercer Modelo de Regresión Logística Ordinal")| Variable | t_value | p_value | Significativa | |
|---|---|---|---|---|
| race_ethnicitygroup B | race_ethnicitygroup B | 1.2595600 | 0.2081280 | No |
| race_ethnicitygroup C | race_ethnicitygroup C | 1.7204373 | 0.0856687 | No |
| race_ethnicitygroup D | race_ethnicitygroup D | 2.8087032 | 0.0050730 | Sí |
| race_ethnicitygroup E | race_ethnicitygroup E | 5.3199665 | 0.0000001 | Sí |
| parental_level_of_educationbachelor’s degree | parental_level_of_educationbachelor’s degree | 1.2743841 | 0.2028294 | No |
| parental_level_of_educationhigh school | parental_level_of_educationhigh school | -2.9414717 | 0.0033434 | Sí |
| parental_level_of_educationmaster’s degree | parental_level_of_educationmaster’s degree | 1.3950249 | 0.1633244 | No |
| parental_level_of_educationsome college | parental_level_of_educationsome college | -0.3169842 | 0.7513231 | No |
| parental_level_of_educationsome high school | parental_level_of_educationsome high school | -1.9328941 | 0.0535371 | No |
| lunchstandard | lunchstandard | 9.8881780 | 0.0000000 | Sí |
| test_preparation_coursenone | test_preparation_coursenone | -4.7401167 | 0.0000025 | Sí |
| study_hours | study_hours | 0.4293851 | 0.6677374 | No |
| extracurricularSi | extracurricularSi | -0.0314674 | 0.9749032 | No |
| institution_typePublica | institution_typePublica | 1.7959850 | 0.0728048 | No |
| tutoring_accessSi | tutoring_accessSi | -1.0869955 | 0.2773061 | No |
| tech_resourcesBajo | tech_resourcesBajo | -2.2167189 | 0.0268712 | Sí |
| tech_resourcesMedio | tech_resourcesMedio | -1.9797921 | 0.0480063 | Sí |
| Bajo Rendimiento|Rendimiento medio | Bajo Rendimiento|Rendimiento medio | -0.0431933 | 0.9655563 | No |
| Rendimiento medio|Rendimiento alto | Rendimiento medio|Rendimiento alto | 7.4698722 | 0.0000000 | Sí |
# Predicción del modelo ajustado
prediccion3 <- predict(modelo3, newdata = Student_Data, type = "class")
# Crear matriz de confusión
tabla_conf_ajust3 <- table(Predicción = prediccion3, Realidad = Student_Data$math_score)
tabla_conf_ajust3 Realidad
Predicción Bajo Rendimiento Rendimiento medio Rendimiento alto
Bajo Rendimiento 144 101 6
Rendimiento medio 194 366 154
Rendimiento alto 0 18 16# Calcular precisión
precision3 <- sum(diag(tabla_conf_ajust3)) / sum(tabla_conf_ajust3)
paste("Precisión ajustada:", round(precision3 * 100, 2), "%")[1] "Precisión ajustada: 52.65 %"Aunque este modelo tiene una precisión ajustada ligeramente inferior (52.65%) y un AIC más alto, la eliminación de algunas variables parece haber mantenido un desempeño razonable.
Sin embargo, podría ser necesario considerar más ajustes o exploraciones adicionales para mejorar el rendimiento predictivo.
1.4.1.3 - Tercera Eliminación
- study_hours (p-value = 0.6677374)
- extracurricularSi (p-value = 0.9749032)
Estas dos variables tienen los p-values más altos y no son significativas en el modelo, lo que sugiere que no aportan mucho a la predicción del rendimiento en matemáticas por ello las eliminamos.
# Ajustar el modelo de regresión logística ordinal
modelo4 <- polr(math_score ~ race_ethnicity + parental_level_of_education + lunch + test_preparation_course + institution_type + tutoring_access + tech_resources, data = Student_Data, Hess = TRUE)
# Resumen del modelo
summary(modelo4)Call:
polr(formula = math_score ~ race_ethnicity + parental_level_of_education +
lunch + test_preparation_course + institution_type + tutoring_access +
tech_resources, data = Student_Data, Hess = TRUE)
Coefficients:
Value Std. Error t value
race_ethnicitygroup B 0.33002 0.2587 1.2757
race_ethnicitygroup C 0.41943 0.2414 1.7375
race_ethnicitygroup D 0.69317 0.2461 2.8172
race_ethnicitygroup E 1.47072 0.2760 5.3279
parental_level_of_educationbachelor's degree 0.28306 0.2235 1.2667
parental_level_of_educationhigh school -0.58250 0.1983 -2.9381
parental_level_of_educationmaster's degree 0.40668 0.2918 1.3937
parental_level_of_educationsome college -0.06172 0.1869 -0.3302
parental_level_of_educationsome high school -0.39154 0.2003 -1.9544
lunchstandard 1.34640 0.1362 9.8820
test_preparation_coursenone -0.62461 0.1316 -4.7452
institution_typePublica 0.22437 0.1253 1.7899
tutoring_accessSi -0.13688 0.1252 -1.0930
tech_resourcesBajo -0.34428 0.1537 -2.2400
tech_resourcesMedio -0.30773 0.1541 -1.9963
Intercepts:
Value Std. Error t value
Bajo Rendimiento|Rendimiento medio -0.0690 0.3032 -0.2275
Rendimiento medio|Rendimiento alto 2.5227 0.3148 8.0143
Residual Deviance: 1841.593
AIC: 1875.593 El AIC es 1875.593, lo que indica que es un modelo ligeramente más ajustado que el modelo3.
# Obtener coeficientes del primer modelo
coeficientes4 <- summary(modelo4)$coefficients
# Crear dataframe con variables, t_value y p_value del primer modelo
resultados4 <- data.frame(
Variable = rownames(coeficientes4),
t_value = coeficientes4[, "t value"],
p_value = 2 * pt(abs(coeficientes4[, "t value"]), df = modelo4$df.residual, lower.tail = FALSE)
)
# Añadir columna de significancia
resultados4$Significativa <- ifelse(resultados4$p_value < 0.05, "Sí", "No")
kable(resultados4, caption = "Resultados del Cuarto Modelo de Regresión Logística Ordinal")| Variable | t_value | p_value | Significativa | |
|---|---|---|---|---|
| race_ethnicitygroup B | race_ethnicitygroup B | 1.2757088 | 0.2023601 | No |
| race_ethnicitygroup C | race_ethnicitygroup C | 1.7375482 | 0.0826040 | No |
| race_ethnicitygroup D | race_ethnicitygroup D | 2.8171744 | 0.0049420 | Sí |
| race_ethnicitygroup E | race_ethnicitygroup E | 5.3279107 | 0.0000001 | Sí |
| parental_level_of_educationbachelor’s degree | parental_level_of_educationbachelor’s degree | 1.2667313 | 0.2055518 | No |
| parental_level_of_educationhigh school | parental_level_of_educationhigh school | -2.9380544 | 0.0033800 | Sí |
| parental_level_of_educationmaster’s degree | parental_level_of_educationmaster’s degree | 1.3937142 | 0.1637193 | No |
| parental_level_of_educationsome college | parental_level_of_educationsome college | -0.3301592 | 0.7413501 | No |
| parental_level_of_educationsome high school | parental_level_of_educationsome high school | -1.9544280 | 0.0509341 | No |
| lunchstandard | lunchstandard | 9.8819753 | 0.0000000 | Sí |
| test_preparation_coursenone | test_preparation_coursenone | -4.7452232 | 0.0000024 | Sí |
| institution_typePublica | institution_typePublica | 1.7899417 | 0.0737713 | No |
| tutoring_accessSi | tutoring_accessSi | -1.0930073 | 0.2746587 | No |
| tech_resourcesBajo | tech_resourcesBajo | -2.2400452 | 0.0253110 | Sí |
| tech_resourcesMedio | tech_resourcesMedio | -1.9963057 | 0.0461764 | Sí |
| Bajo Rendimiento|Rendimiento medio | Bajo Rendimiento|Rendimiento medio | -0.2275253 | 0.8200626 | No |
| Rendimiento medio|Rendimiento alto | Rendimiento medio|Rendimiento alto | 8.0142676 | 0.0000000 | Sí |
# Predicción del modelo ajustado
prediccion4 <- predict(modelo4, newdata = Student_Data, type = "class")
# Crear matriz de confusión
tabla_conf_ajust4 <- table(Predicción = prediccion4, Realidad = Student_Data$math_score)
tabla_conf_ajust4 Realidad
Predicción Bajo Rendimiento Rendimiento medio Rendimiento alto
Bajo Rendimiento 142 101 7
Rendimiento medio 196 368 153
Rendimiento alto 0 16 16# Calcular precisión
precision4 <- sum(diag(tabla_conf_ajust4)) / sum(tabla_conf_ajust4)
paste("Precisión ajustada:", round(precision4 * 100, 2), "%")[1] "Precisión ajustada: 52.65 %"La precisión ajustada del modelo es 52.65%, lo que es igual a la del modelo3, esto sugiere que la eliminación adicional de variables no ha mejorado ni empeorado significativamente la capacidad predictiva del modelo.
1.4.1.4 - Cuarta Eliminación
Eliminamos la variable:
* parental_level_of_education
# Ajustar el modelo de regresión logística ordinal
modelo5 <- polr(formula = math_score ~ race_ethnicity + lunch + test_preparation_course +
institution_type + tutoring_access + tech_resources,
data = Student_Data, Hess = TRUE)
# Resumen del modelo
summary(modelo5)Call:
polr(formula = math_score ~ race_ethnicity + lunch + test_preparation_course +
institution_type + tutoring_access + tech_resources, data = Student_Data,
Hess = TRUE)
Coefficients:
Value Std. Error t value
race_ethnicitygroup B 0.3196 0.2569 1.244
race_ethnicitygroup C 0.4685 0.2389 1.961
race_ethnicitygroup D 0.7486 0.2437 3.072
race_ethnicitygroup E 1.5400 0.2732 5.636
lunchstandard 1.3068 0.1350 9.679
test_preparation_coursenone -0.6307 0.1302 -4.842
institution_typePublica 0.2197 0.1243 1.767
tutoring_accessSi -0.1530 0.1243 -1.231
tech_resourcesBajo -0.3313 0.1526 -2.171
tech_resourcesMedio -0.2866 0.1511 -1.896
Intercepts:
Value Std. Error t value
Bajo Rendimiento|Rendimiento medio 0.0995 0.2709 0.3673
Rendimiento medio|Rendimiento alto 2.6424 0.2850 9.2722
Residual Deviance: 1865.565
AIC: 1889.565 El AIC para el modelo es 1889.565. Este valor indica que el modelo tiene una capacidad de ajuste ligeramente peor en comparación con el Modelo4.
# Obtener coeficientes del primer modelo
coeficientes5 <- summary(modelo5)$coefficients
# Crear dataframe con variables, t_value y p_value del primer modelo
resultados5 <- data.frame(
Variable = rownames(coeficientes5),
t_value = coeficientes5[, "t value"],
p_value = 2 * pt(abs(coeficientes5[, "t value"]), df = modelo5$df.residual, lower.tail = FALSE)
)
# Añadir columna de significancia
resultados5$Significativa <- ifelse(resultados5$p_value < 0.05, "Sí", "No")
kable(resultados5, caption = "Resultados del Quinto Modelo de Regresión Logística Ordinal")| Variable | t_value | p_value | Significativa | |
|---|---|---|---|---|
| race_ethnicitygroup B | race_ethnicitygroup B | 1.2438160 | 0.2138626 | No |
| race_ethnicitygroup C | race_ethnicitygroup C | 1.9605772 | 0.0502093 | No |
| race_ethnicitygroup D | race_ethnicitygroup D | 3.0716043 | 0.0021875 | Sí |
| race_ethnicitygroup E | race_ethnicitygroup E | 5.6360722 | 0.0000000 | Sí |
| lunchstandard | lunchstandard | 9.6794893 | 0.0000000 | Sí |
| test_preparation_coursenone | test_preparation_coursenone | -4.8424785 | 0.0000015 | Sí |
| institution_typePublica | institution_typePublica | 1.7669385 | 0.0775475 | No |
| tutoring_accessSi | tutoring_accessSi | -1.2312771 | 0.2185126 | No |
| tech_resourcesBajo | tech_resourcesBajo | -2.1713413 | 0.0301430 | Sí |
| tech_resourcesMedio | tech_resourcesMedio | -1.8961833 | 0.0582276 | No |
| Bajo Rendimiento|Rendimiento medio | Bajo Rendimiento|Rendimiento medio | 0.3673244 | 0.7134558 | No |
| Rendimiento medio|Rendimiento alto | Rendimiento medio|Rendimiento alto | 9.2722245 | 0.0000000 | Sí |
# Predicción del modelo ajustado
prediccion5 <- predict(modelo5, newdata = Student_Data, type = "class")
# Crear matriz de confusión
tabla_conf_ajust5 <- table(Predicción = prediccion5, Realidad = Student_Data$math_score)
tabla_conf_ajust5 Realidad
Predicción Bajo Rendimiento Rendimiento medio Rendimiento alto
Bajo Rendimiento 143 100 7
Rendimiento medio 194 375 153
Rendimiento alto 1 10 16# Calcular precisión
precision5 <- sum(diag(tabla_conf_ajust5)) / sum(tabla_conf_ajust5)
paste("Precisión ajustada:", round(precision5 * 100, 2), "%")[1] "Precisión ajustada: 53.45 %"La precisión ajustada del modelo es 53.45%, lo que muestra una ligera mejora respecto a los demas Modelos, sugiriendo que la simplificación adicional de variables ha tenido un pequeño impacto positivo en la capacidad predictiva del modelo.
1.4.1.5 - Quinta Eliminación
Eliminamos la variable:
* tutoring_access
# Ajustar el modelo de regresión logística ordinal
modelo6 <- polr(formula = math_score ~ race_ethnicity + lunch + test_preparation_course +
institution_type + tech_resources,
data = Student_Data, Hess = TRUE)
# Resumen del modelo
summary(modelo6)Call:
polr(formula = math_score ~ race_ethnicity + lunch + test_preparation_course +
institution_type + tech_resources, data = Student_Data, Hess = TRUE)
Coefficients:
Value Std. Error t value
race_ethnicitygroup B 0.2981 0.2562 1.164
race_ethnicitygroup C 0.4520 0.2384 1.896
race_ethnicitygroup D 0.7292 0.2430 3.001
race_ethnicitygroup E 1.5145 0.2723 5.561
lunchstandard 1.3047 0.1349 9.672
test_preparation_coursenone -0.6198 0.1299 -4.773
institution_typePublica 0.2219 0.1243 1.785
tech_resourcesBajo -0.3309 0.1525 -2.170
tech_resourcesMedio -0.2900 0.1511 -1.919
Intercepts:
Value Std. Error t value
Bajo Rendimiento|Rendimiento medio 0.1677 0.2652 0.6326
Rendimiento medio|Rendimiento alto 2.7076 0.2802 9.6631
Residual Deviance: 1867.082
AIC: 1889.082 # Obtener coeficientes del primer modelo
coeficientes6 <- summary(modelo6)$coefficients
# Crear dataframe con variables, t_value y p_value del primer modelo
resultados6 <- data.frame(
Variable = rownames(coeficientes6),
t_value = coeficientes6[, "t value"],
p_value = 2 * pt(abs(coeficientes6[, "t value"]), df = modelo6$df.residual, lower.tail = FALSE)
)
# Añadir columna de significancia
resultados6$Significativa <- ifelse(resultados6$p_value < 0.05, "Sí", "No")
kable(resultados6, caption = "Resultados del Sexto Modelo de Regresión Logística Ordinal")| Variable | t_value | p_value | Significativa | |
|---|---|---|---|---|
| race_ethnicitygroup B | race_ethnicitygroup B | 1.1638213 | 0.2447774 | No |
| race_ethnicitygroup C | race_ethnicitygroup C | 1.8956468 | 0.0582984 | No |
| race_ethnicitygroup D | race_ethnicitygroup D | 3.0006055 | 0.0027621 | Sí |
| race_ethnicitygroup E | race_ethnicitygroup E | 5.5611462 | 0.0000000 | Sí |
| lunchstandard | lunchstandard | 9.6720223 | 0.0000000 | Sí |
| test_preparation_coursenone | test_preparation_coursenone | -4.7726888 | 0.0000021 | Sí |
| institution_typePublica | institution_typePublica | 1.7853404 | 0.0745128 | No |
| tech_resourcesBajo | tech_resourcesBajo | -2.1704007 | 0.0302141 | Sí |
| tech_resourcesMedio | tech_resourcesMedio | -1.9193523 | 0.0552275 | No |
| Bajo Rendimiento|Rendimiento medio | Bajo Rendimiento|Rendimiento medio | 0.6325566 | 0.5271696 | No |
| Rendimiento medio|Rendimiento alto | Rendimiento medio|Rendimiento alto | 9.6631218 | 0.0000000 | Sí |
# Predicción del modelo ajustado
prediccion6 <- predict(modelo6, newdata = Student_Data, type = "class")
# Crear matriz de confusión
tabla_conf_ajust6 <- table(Predicción = prediccion6, Realidad = Student_Data$math_score)
tabla_conf_ajust6 Realidad
Predicción Bajo Rendimiento Rendimiento medio Rendimiento alto
Bajo Rendimiento 137 101 8
Rendimiento medio 201 376 158
Rendimiento alto 0 8 10# Calcular precisión
precision6 <- sum(diag(tabla_conf_ajust6)) / sum(tabla_conf_ajust6)
paste("Precisión ajustada:", round(precision6 * 100, 2), "%")[1] "Precisión ajustada: 52.35 %"La precisión de este modelo es la más baja entre todos los modelos, indicando que su capacidad para clasificar correctamente es menor.
1.4.1.6 - Sexta Eliminación
Eliminamos la variable:
* race_ethnicity
# Ajustar el modelo de regresión logística ordinal
modelo7 <- polr(formula = math_score ~ + lunch + test_preparation_course + institution_type + tech_resources,
data = Student_Data, Hess = TRUE)
# Resumen del modelo
summary(modelo7)Call:
polr(formula = math_score ~ +lunch + test_preparation_course +
institution_type + tech_resources, data = Student_Data, Hess = TRUE)
Coefficients:
Value Std. Error t value
lunchstandard 1.3243 0.1335 9.916
test_preparation_coursenone -0.6329 0.1287 -4.918
institution_typePublica 0.2035 0.1229 1.656
tech_resourcesBajo -0.3378 0.1513 -2.233
tech_resourcesMedio -0.3240 0.1497 -2.164
Intercepts:
Value Std. Error t value
Bajo Rendimiento|Rendimiento medio -0.4241 0.1677 -2.5291
Rendimiento medio|Rendimiento alto 2.0239 0.1800 11.2442
Residual Deviance: 1912.441
AIC: 1926.441 El AIC del modelo es 1926.441, que es más alto en comparación con los modelos anteriores. Esto sugiere que el modelo podría estar sobreajustado a las pocas variables que quedan.
# Obtener coeficientes del primer modelo
coeficientes7 <- summary(modelo7)$coefficients
# Crear dataframe con variables, t_value y p_value del primer modelo
resultados7 <- data.frame(
Variable = rownames(coeficientes7),
t_value = coeficientes7[, "t value"],
p_value = 2 * pt(abs(coeficientes7[, "t value"]), df = modelo7$df.residual, lower.tail = FALSE)
)
# Añadir columna de significancia
resultados7$Significativa <- ifelse(resultados7$p_value < 0.05, "Sí", "No")
kable(resultados7, caption = "Resultados del Septimo Modelo de Regresión Logística Ordinal")| Variable | t_value | p_value | Significativa | |
|---|---|---|---|---|
| lunchstandard | lunchstandard | 9.916287 | 0.0000000 | Sí |
| test_preparation_coursenone | test_preparation_coursenone | -4.917954 | 0.0000010 | Sí |
| institution_typePublica | institution_typePublica | 1.656349 | 0.0979673 | No |
| tech_resourcesBajo | tech_resourcesBajo | -2.233105 | 0.0257644 | Sí |
| tech_resourcesMedio | tech_resourcesMedio | -2.163795 | 0.0307182 | Sí |
| Bajo Rendimiento|Rendimiento medio | Bajo Rendimiento|Rendimiento medio | -2.529120 | 0.0115889 | Sí |
| Rendimiento medio|Rendimiento alto | Rendimiento medio|Rendimiento alto | 11.244239 | 0.0000000 | Sí |
# Predicción del modelo ajustado
prediccion7 <- predict(modelo7, newdata = Student_Data, type = "class")
# Crear matriz de confusión
tabla_conf_ajust7 <- table(Predicción = prediccion7, Realidad = Student_Data$math_score)
tabla_conf_ajust7 Realidad
Predicción Bajo Rendimiento Rendimiento medio Rendimiento alto
Bajo Rendimiento 139 108 11
Rendimiento medio 199 377 165
Rendimiento alto 0 0 0# Calcular precisión
precision7 <- sum(diag(tabla_conf_ajust7)) / sum(tabla_conf_ajust7)
paste("Precisión ajustada:", round(precision7 * 100, 2), "%")[1] "Precisión ajustada: 51.65 %"La precisión ajustada es 51.65%, que muestra una disminución en comparación con los demás modelos. Esto indica una ligera reducción en la capacidad predictiva del modelo.
1.4.1.7 - Septima Eliminación
Eliminamos la variable:
* institution_type
# Ajustar el modelo de regresión logística ordinal
modelo8 <- polr(formula = math_score ~ lunch + test_preparation_course
+ tech_resources,
data = Student_Data, Hess = TRUE)
# Resumen del modelo
summary(modelo8)Call:
polr(formula = math_score ~ lunch + test_preparation_course +
tech_resources, data = Student_Data, Hess = TRUE)
Coefficients:
Value Std. Error t value
lunchstandard 1.3148 0.1332 9.868
test_preparation_coursenone -0.6232 0.1285 -4.851
tech_resourcesBajo -0.3345 0.1512 -2.212
tech_resourcesMedio -0.3154 0.1496 -2.109
Intercepts:
Value Std. Error t value
Bajo Rendimiento|Rendimiento medio -0.5235 0.1565 -3.3444
Rendimiento medio|Rendimiento alto 1.9189 0.1677 11.4405
Residual Deviance: 1915.189
AIC: 1927.189 El AIC del modelo es 1927.189, que es un poco más alto en comparación con el Modelo 7 (1926.441). Esto sugiere que el modelo podría estar sobreajustado. Y en cuestion de AIC el Modelo2 tiene el más bajo.
# Obtener coeficientes del primer modelo
coeficientes8 <- summary(modelo8)$coefficients
# Crear dataframe con variables, t_value y p_value del primer modelo
resultados8 <- data.frame(
Variable = rownames(coeficientes8),
t_value = coeficientes8[, "t value"],
p_value = 2 * pt(abs(coeficientes8[, "t value"]), df = modelo8$df.residual, lower.tail = FALSE)
)
# Añadir columna de significancia
resultados8$Significativa <- ifelse(resultados8$p_value < 0.05, "Sí", "No")
kable(resultados8, caption = "Resultados del Octavo Modelo de Regresión Logística Ordinal")| Variable | t_value | p_value | Significativa | |
|---|---|---|---|---|
| lunchstandard | lunchstandard | 9.868016 | 0.0000000 | Sí |
| test_preparation_coursenone | test_preparation_coursenone | -4.850617 | 0.0000014 | Sí |
| tech_resourcesBajo | tech_resourcesBajo | -2.211552 | 0.0272247 | Sí |
| tech_resourcesMedio | tech_resourcesMedio | -2.108926 | 0.0352008 | Sí |
| Bajo Rendimiento|Rendimiento medio | Bajo Rendimiento|Rendimiento medio | -3.344439 | 0.0008553 | Sí |
| Rendimiento medio|Rendimiento alto | Rendimiento medio|Rendimiento alto | 11.440454 | 0.0000000 | Sí |
# Predicción del modelo ajustado
prediccion8 <- predict(modelo8, newdata = Student_Data, type = "class")
# Crear matriz de confusión
tabla_conf_ajust8 <- table(Predicción = prediccion8, Realidad = Student_Data$math_score)
tabla_conf_ajust8 Realidad
Predicción Bajo Rendimiento Rendimiento medio Rendimiento alto
Bajo Rendimiento 146 107 12
Rendimiento medio 192 378 164
Rendimiento alto 0 0 0# Calcular precisión
precision8 <- sum(diag(tabla_conf_ajust8)) / sum(tabla_conf_ajust8)
paste("Precisión ajustada:", round(precision8 * 100, 2), "%")[1] "Precisión ajustada: 52.45 %"La precisión ajustada es 52.45%, una ligera mejora en comparación con el Modelo 7 (51.65%), indicando que la capacidad predictiva ha mejorado ligeramente, pero aún es inferior a los modelos con mayor precisión.
1.4.2 Comparaciones
# Extraer el AIC de cada modelo
aic_modelo1 <- AIC(modelo1)
aic_modelo2 <- AIC(modelo2)
aic_modelo3 <- AIC(modelo3)
aic_modelo4 <- AIC(modelo4)
aic_modelo5 <- AIC(modelo5)
aic_modelo6 <- AIC(modelo6)
aic_modelo7 <- AIC(modelo7)
aic_modelo8 <- AIC(modelo8)
# Crear un dataframe para almacenar los AIC
resultados_aic <- data.frame(
Modelo = c("Modelo1", "Modelo2", "Modelo3", "Modelo4", "Modelo5", "Modelo6", "Modelo7", "Modelo8"),
AIC = c(aic_modelo1, aic_modelo2, aic_modelo3, aic_modelo4, aic_modelo5, aic_modelo6, aic_modelo7, aic_modelo8)
)
# Ver los resultados
resultados_aic Modelo AIC
1 Modelo1 1859.756
2 Modelo2 1856.780
3 Modelo3 1879.408
4 Modelo4 1875.593
5 Modelo5 1889.565
6 Modelo6 1889.082
7 Modelo7 1926.441
8 Modelo8 1927.189Podemos observar que el mejor AIC lo tiene el Modelo2, seguido del Modelo1, cabe de mencionar que el Modelo8 si bien tiene un AIC mas grande, todas sus variables son significativas.
# Crear un dataframe para almacenar las precisiones
resultados <- data.frame(
Modelo = c("Modelo1", "Modelo2", "Modelo3", "Modelo4", "Modelo5", "Modelo6", "Modelo7", "Modelo8"),
Precisión = c(precision1, precision2, precision3, precision4, precision5, precision6, precision7, precision8)
)
# Ver los resultados
resultados Modelo Precisión
1 Modelo1 0.5305305
2 Modelo2 0.5325325
3 Modelo3 0.5265265
4 Modelo4 0.5265265
5 Modelo5 0.5345345
6 Modelo6 0.5235235
7 Modelo7 0.5165165
8 Modelo8 0.5245245Mejor Precisión: El Modelo2 (53.25%) y El Modelo5 (53.45%) tienen las mejores precisiones, siendo los más efectivos en la clasificación de rendimiento en matemáticas.
Peor Precisión: El Modelo7 (51.65%) muestra la menor precisión, sugiriendo que puede ser el menos efectivo para el objetivo de predicción.
1.4.3 Sugerencias
La precisión relativamente baja indica que el modelo actual puede no estar capturando toda la complejidad de los datos. Problemas como la multicolinealidad, el desequilibrio en las clases y la sensibilidad a outliers también pueden estar afectando el rendimiento, por ello se sugiere:
- Crear nuevas variables y aplicar transformaciones si es necesario.
- Balancear las clases si hay desequilibrio.
- Eliminar variables no significativas y evaluar interacciones entre variables.