En este ejercicio utilizaremos datos reales recopilados de estudiantes de educación secundaria en dos escuelas de Portugal. El objetivo es predecir si un estudiante aprobará o no el curso de matemáticas, utilizando información relacionada con información académica, familiar, personal y social.
Base de datos:
library(readr)
data <- read_csv("Student-mat.csv")sum(is.na(data))## [1] 0Observamos que la base de datos no tiene valores faltantes. Ahora elegiremos las variables y las convertiremos según sea necesario para nuestro análisis.
Elegimos las siguientes variables según las siguientes categorías:
Seleccionamos estas variables porque representan distintos aspectos que influyen en el rendimiento académico. Las variables académicas reflejan directamente el desempeño y compromiso del estudiante con sus estudios. Las variables familiares consideran el entorno en el que vive y el nivel educativo de sus padres. Las personales permiten observar diferencias por edad y sexo, y las sociales nos ayudan a entender cómo el acceso a recursos o la participación en actividades pueden impactar en los resultados escolares.
Nuestra variable respuesta: Mayor a 10 es que aprueban si es menor o igual a 10 reprueban
data$G3_cat <- ifelse(data$G3 > 10, "Aprueban", "Reprueban")
data$G3_cat <- as.factor(data$G3_cat)Ahora convertiremos el resto de nuestras variables en las categorías correspodientes.
library(dplyr)
data$G1_cat <- ifelse(data$G1 > 10, "Aprueban G1", "Reprueban G1")
data$G2_cat <- ifelse(data$G2 > 10, "Aprueban G2", "Reprueban G2")
data$absences_cat <- cut(data$absences,
breaks = c(-1, 5, 10, Inf),
labels = c("Bajas", "Moderadas", "Altas"))
data <- data %>%
mutate_at(vars(sex, address, age, schoolsup, activities, internet, G1_cat, G2_cat), as.factor) %>%
mutate_at(vars(Medu, Fedu, studytime, absences_cat, failures), ~factor(., levels = sort(unique(.)), ordered = TRUE))
str(data)## tibble [395 × 37] (S3: tbl_df/tbl/data.frame)
## $ school : chr [1:395] "GP" "GP" "GP" "GP" ...
## $ sex : Factor w/ 2 levels "F","M": 1 1 1 1 1 2 2 1 2 2 ...
## $ age : Factor w/ 8 levels "15","16","17",..: 4 3 1 1 2 2 2 3 1 1 ...
## $ address : Factor w/ 2 levels "R","U": 2 2 2 2 2 2 2 2 2 2 ...
## $ famsize : chr [1:395] "GT3" "GT3" "LE3" "GT3" ...
## $ Pstatus : chr [1:395] "A" "T" "T" "T" ...
## $ Medu : Ord.factor w/ 5 levels "0"<"1"<"2"<"3"<..: 5 2 2 5 4 5 3 5 4 4 ...
## $ Fedu : Ord.factor w/ 5 levels "0"<"1"<"2"<"3"<..: 5 2 2 3 4 4 3 5 3 5 ...
## $ Mjob : chr [1:395] "at_home" "at_home" "at_home" "health" ...
## $ Fjob : chr [1:395] "teacher" "other" "other" "services" ...
## $ reason : chr [1:395] "course" "course" "other" "home" ...
## $ guardian : chr [1:395] "mother" "father" "mother" "mother" ...
## $ traveltime : num [1:395] 2 1 1 1 1 1 1 2 1 1 ...
## $ studytime : Ord.factor w/ 4 levels "1"<"2"<"3"<"4": 2 2 2 3 2 2 2 2 2 2 ...
## $ failures : Ord.factor w/ 4 levels "0"<"1"<"2"<"3": 1 1 4 1 1 1 1 1 1 1 ...
## $ schoolsup : Factor w/ 2 levels "no","yes": 2 1 2 1 1 1 1 2 1 1 ...
## $ famsup : chr [1:395] "no" "yes" "no" "yes" ...
## $ paid : chr [1:395] "no" "no" "yes" "yes" ...
## $ activities : Factor w/ 2 levels "no","yes": 1 1 1 2 1 2 1 1 1 2 ...
## $ nursery : chr [1:395] "yes" "no" "yes" "yes" ...
## $ higher : chr [1:395] "yes" "yes" "yes" "yes" ...
## $ internet : Factor w/ 2 levels "no","yes": 1 2 2 2 1 2 2 1 2 2 ...
## $ romantic : chr [1:395] "no" "no" "no" "yes" ...
## $ famrel : num [1:395] 4 5 4 3 4 5 4 4 4 5 ...
## $ freetime : num [1:395] 3 3 3 2 3 4 4 1 2 5 ...
## $ goout : num [1:395] 4 3 2 2 2 2 4 4 2 1 ...
## $ Dalc : num [1:395] 1 1 2 1 1 1 1 1 1 1 ...
## $ Walc : num [1:395] 1 1 3 1 2 2 1 1 1 1 ...
## $ health : num [1:395] 3 3 3 5 5 5 3 1 1 5 ...
## $ absences : num [1:395] 6 4 10 2 4 10 0 6 0 0 ...
## $ G1 : num [1:395] 5 5 7 15 6 15 12 6 16 14 ...
## $ G2 : num [1:395] 6 5 8 14 10 15 12 5 18 15 ...
## $ G3 : num [1:395] 6 6 10 15 10 15 11 6 19 15 ...
## $ G3_cat : Factor w/ 2 levels "Aprueban","Reprueban": 2 2 2 1 2 1 1 2 1 1 ...
## $ G1_cat : Factor w/ 2 levels "Aprueban G1",..: 2 2 2 1 2 1 1 2 1 1 ...
## $ G2_cat : Factor w/ 2 levels "Aprueban G2",..: 2 2 2 1 2 1 1 2 1 1 ...
## $ absences_cat: Ord.factor w/ 3 levels "Bajas"<"Moderadas"<..: 2 1 2 1 1 2 1 2 1 1 ...Nueva base:
newdata <- data[, c("sex", "age", "address", "Medu", "Fedu", "studytime", "schoolsup","failures", "activities", "internet", "absences_cat","G1_cat", "G2_cat", "G3_cat")]Con un muestreo aleatorio, separamos el conjunto de entrenamiento y el de prueba. Elegimos 7 grupos, 6 de entrenamiento y 1 de prueba. Esto dado a que luego de practicarlo con diferentes parámetros, con este conseguimos el mejor modelo.
set.seed(2025)
library(caret)
# Crear los folds para validación cruzada
folds <- createFolds(newdata$G3_cat, k = 7)
# Dividir en conjunto de entrenamiento y prueba
entrenamiento <- newdata[-folds[[7]], ]
prueba <- newdata[folds[[7]], ] Separamos las etiquetas de nuestro conjunto de entrenamiento y prueba.
entrenamiento_labels <- newdata$G3_cat[-folds[[7]]]
prueba_labels <- newdata$G3_cat[folds[[7]]]Aplicamos el Clasificador Bayesiano a nuestros datos de entrenamiento.
library(e1071)
# Entrenar el modelo Naive Bayes con el conjunto de entrenamiento
modelo <- naiveBayes(G3_cat ~ ., newdata)
modelo##
## Naive Bayes Classifier for Discrete Predictors
##
## Call:
## naiveBayes.default(x = X, y = Y, laplace = laplace)
##
## A-priori probabilities:
## Y
## Aprueban Reprueban
## 0.5291139 0.4708861
##
## Conditional probabilities:
## sex
## Y F M
## Aprueban 0.4928230 0.5071770
## Reprueban 0.5645161 0.4354839
##
## age
## Y 15 16 17 18 19
## Aprueban 0.244019139 0.291866029 0.239234450 0.167464115 0.047846890
## Reprueban 0.166666667 0.231182796 0.258064516 0.252688172 0.075268817
## age
## Y 20 21 22
## Aprueban 0.009569378 0.000000000 0.000000000
## Reprueban 0.005376344 0.005376344 0.005376344
##
## address
## Y R U
## Aprueban 0.1818182 0.8181818
## Reprueban 0.2688172 0.7311828
##
## Medu
## Y 0 1 2 3 4
## Aprueban 0.009569378 0.100478469 0.253588517 0.234449761 0.401913876
## Reprueban 0.005376344 0.204301075 0.268817204 0.268817204 0.252688172
##
## Fedu
## Y 0 1 2 3 4
## Aprueban 0.004784689 0.148325359 0.301435407 0.234449761 0.311004785
## Reprueban 0.005376344 0.274193548 0.279569892 0.274193548 0.166666667
##
## studytime
## Y 1 2 3 4
## Aprueban 0.24401914 0.47846890 0.19617225 0.08133971
## Reprueban 0.29032258 0.52688172 0.12903226 0.05376344
##
## schoolsup
## Y no yes
## Aprueban 0.9138756 0.0861244
## Reprueban 0.8225806 0.1774194
##
## failures
## Y 0 1 2 3
## Aprueban 0.904306220 0.086124402 0.009569378 0.000000000
## Reprueban 0.661290323 0.172043011 0.080645161 0.086021505
##
## activities
## Y no yes
## Aprueban 0.4880383 0.5119617
## Reprueban 0.4946237 0.5053763
##
## internet
## Y no yes
## Aprueban 0.1339713 0.8660287
## Reprueban 0.2043011 0.7956989
##
## absences_cat
## Y Bajas Moderadas Altas
## Aprueban 0.6459330 0.2057416 0.1483254
## Reprueban 0.6129032 0.1989247 0.1881720
##
## G1_cat
## Y Aprueban G1 Reprueban G1
## Aprueban 0.8660287 0.1339713
## Reprueban 0.1129032 0.8870968
##
## G2_cat
## Y Aprueban G2 Reprueban G2
## Aprueban 0.92344498 0.07655502
## Reprueban 0.05376344 0.94623656Calculamos la predicción del modelo.
pred <- predict(modelo,prueba[,-14])
table(pred,prueba_labels)## prueba_labels
## pred Aprueban Reprueban
## Aprueban 27 2
## Reprueban 2 24Luego de aplicar nuestro Clasificador Bayesiano podemos observar el modelo logró predecir correctamente y tuvo un buen desempeño en la clasificación de los estudiantes, cometiendo solo 4 errores (2 falsos positivos y 2 falsos negativos).
A través de las probabilidades A - priori se muestra que el 53% de los estudiantes aprueban y un 47% reprueban la materia. Además, en las Probabilidades Condicionales se muestran para cada variable las probabilidades de un valor de esa variable, dado que el estudiante aprueba o reprueba.
Por ejemplo, con la variable sex observamos que de los estudiantes que aprueban, el 49.3% son mujeres y el 50.7% hombres. Otra variable que resalta es address, dado que nos muestra que de los estudiantes que reprueban el 27% viven en zonas rurales y el 73% viven en zonas urbanas. Sin embargo, de los que aprueban el 18% viven en zonas rurales y el 82% viven en zonas urbanas. Mientras que Medu nos muestra que la educación de la madre influye entre si los estudiantes aprueban o no aprueban. Entre los que aprueban, el grupo más grande 40.2% tiene madres con educación superior (nivel 4). Por otro lado, los estudiantes que aprobaron tienen una alta proporción sin cursos repetidos (90.4%). En cambio, los que reprobaron solo el 66.1% no repitió cursos, mientras que un 17.2% repitió uno, 8.1% repitió dos y 8.6% repitió tres. Por último, para la variable G1 (nota del primer semestre),los estudiantes que aprobaron tienen una alta probabilidad de obtener buenas calificaciones (86.6% aprobaron en G1), mientras que solo el 13.4% reprobó. En contraste, los estudiantes que reprobaron tienen una probabilidad mayor de haber reprobado G1 (88.7%) y solo el 11.3% aprobó.
confusionMatrix(pred,prueba_labels)## Confusion Matrix and Statistics
##
## Reference
## Prediction Aprueban Reprueban
## Aprueban 27 2
## Reprueban 2 24
##
## Accuracy : 0.9273
## 95% CI : (0.8241, 0.9798)
## No Information Rate : 0.5273
## P-Value [Acc > NIR] : 1.239e-10
##
## Kappa : 0.8541
##
## Mcnemar's Test P-Value : 1
##
## Sensitivity : 0.9310
## Specificity : 0.9231
## Pos Pred Value : 0.9310
## Neg Pred Value : 0.9231
## Prevalence : 0.5273
## Detection Rate : 0.4909
## Detection Prevalence : 0.5273
## Balanced Accuracy : 0.9271
##
## 'Positive' Class : Aprueban
## El clasificador Bayesiano obtuvo una precisión (accuracy) del 92.7%, lo que demuestra un buen desempeño general. El valor Kappa (0.85) indica un alto nivel de concordancia entre las predicciones y los valores reales. Además, el modelo logró una sensibilidad del 93.1% y una especificidad del 92.3%, lo que sugiere que el clasificador distingue adecuadamente entre ambas clases.
Aplicaremos la validacion cruzada para analizar que la tasa de aciertos conseguida no dependa de la partición utilizada.
set.seed(2025)
train_control <- trainControl(method="cv",number=20,savePredictions = TRUE)
NBC_cv <- train(G3_cat ~ ., data = cbind(prueba, G3_cat = prueba_labels),
method = "naive_bayes", trControl = train_control)
# Resultados de validación cruzada
NBC_cv## Naive Bayes
##
## 55 samples
## 13 predictors
## 2 classes: 'Aprueban', 'Reprueban'
##
## No pre-processing
## Resampling: Cross-Validated (20 fold)
## Summary of sample sizes: 51, 53, 52, 52, 52, 52, ...
## Resampling results across tuning parameters:
##
## usekernel Accuracy Kappa
## FALSE 0.8250000 0.64
## TRUE 0.8041667 0.61
##
## Tuning parameter 'laplace' was held constant at a value of 0
## Tuning
## parameter 'adjust' was held constant at a value of 1
## Accuracy was used to select the optimal model using the largest value.
## The final values used for the model were laplace = 0, usekernel = FALSE
## and adjust = 1.Se aplicó validación cruzada con 20 particiones para evaluar la estabilidad del clasificador Naive Bayes. El modelo obtuvo la mejor precisión (82.5%) y un valor de Kappa de 0.64, lo que indica un buen nivel de acuerdo entre las predicciones y los valores reales. Estos resultados confirman que el modelo es estable y mantiene un buen rendimiento sin depender de una sola partición de los datos.
# Matriz de confusión usando las predicciones guardadas por caret
confusionMatrix(NBC_cv$pred$pred, NBC_cv$pred$obs)## Confusion Matrix and Statistics
##
## Reference
## Prediction Aprueban Reprueban
## Aprueban 49 12
## Reprueban 9 40
##
## Accuracy : 0.8091
## 95% CI : (0.7231, 0.8778)
## No Information Rate : 0.5273
## P-Value [Acc > NIR] : 6.774e-10
##
## Kappa : 0.6159
##
## Mcnemar's Test P-Value : 0.6625
##
## Sensitivity : 0.8448
## Specificity : 0.7692
## Pos Pred Value : 0.8033
## Neg Pred Value : 0.8163
## Prevalence : 0.5273
## Detection Rate : 0.4455
## Detection Prevalence : 0.5545
## Balanced Accuracy : 0.8070
##
## 'Positive' Class : Aprueban
## La matriz de confusión generada con las predicciones de la validación cruzada muestra que el modelo clasificó correctamente a 49 estudiantes que aprueban y 40 que reprueban, mientras que cometió 21 errores de clasificación. El modelo logró una precisión (accuracy) del 80.91%, con un Kappa de 0.6159, lo que indica un nivel de acuerdo moderado entre las predicciones y los valores reales. Además, presentó una sensibilidad de 84.48% y una especificidad de 76.92%, lo cual refleja un buen equilibrio en el rendimiento del modelo.
En resumen: Puntos claves:
Matriz de confusión:El modelo clasificó correctamente a 49 estudiantes que aprueban y a 40 que reprueban. Sin embargo, cometió errores al clasificar a 12 estudiantes como aprobados cuando en realidad reprobaron, y a 9 como reprobados cuando sí aprobaron.
Exactitud: La tasa de aciertos del modelo fue de 80.91%, lo que indica que en general el modelo realiza buenas predicciones.
Índice Kappa: El valor del índice Kappa fue de 0.6159, lo que representa un acuerdo moderado entre las predicciones del modelo y las observaciones reales, considerando lo que podría esperarse por azar.