Clasificador Bayesiano

Este trabajo se enfoca en analizar y predecir el rendimiento académico de estudiantes de matemáticas utilizando una base de datos de escuelas en Portugal. El objetivo es aplicar el modelo Naive Bayes para clasificar a los estudiantes como “Aprueba” o “No aprueba”, utilizando variables académicas, familiares, personales y sociales. Se realizará un análisis de los datos, transformándolos adecuadamente, y luego se entrenará y evaluará el modelo mediante validación cruzada. Finalmente, se evaluará la precisión del modelo utilizando métricas como exactitud, Kappa, sensibilidad y especificidad, con el fin de comprender qué factores influyen más en el rendimiento académico de los estudiantes.

1. Preparacion inicial y limpieza de datos

data <- read.csv("Student-mat.csv")

Variables Predictoras y variables respuesta:

Variable Predictoria: G3(Calificaccion final)

Variables Respuesta:

Informacion academica

G1: Calificación en el primer período.
G2: Calificación en el segundo período.
studytime: Tiempo de estudio semanal del estudiante.
failures: Número de fracasos previos (si los hubo).
reason: Motivo principal para elegir la escuela (por ejemplo, proximidad, amigos, etc.).
guardian: Tutor del estudiante (madre, padre u otros).

Informacion familiar

Medu: Nivel educativo de la madre.
Fedu: Nivel educativo del padre.
Mjob: Profesión de la madre.
Fjob: Profesión del padre.
Pstatus: Estado de la relación de los padres (si están juntos o separados).
famsize: Tamaño de la familia.
paid: Si el estudiante recibe clases particulares (sí/no).
activities: Si el estudiante participa en actividades extracurriculares (sí/no).
nursery: Si el estudiante asistió a la guardería (sí/no).
higher: Si el estudiante tiene la intención de continuar estudios superiores (sí/no).
internet: Si el estudiante tiene acceso a internet en casa (sí/no).
romantic: Si el estudiante tiene una relación romántica (sí/no).

Informacion personal

sex: Género del estudiante.
age: Edad del estudiante.
health: Estado de salud del estudiante.

Informacion social

school: Nombre de la escuela (puede reflejar un aspecto social relacionado con la ubicación o tipo de institución).
address: Tipo de dirección (urbana o rural).
freetime: Tiempo libre del estudiante.
goout: Frecuencia de salir con amigos.
Dalc: Consumo de alcohol en días laborales.
Walc: Consumo de alcohol en fines de semana.
absences: Número de ausencias del estudiante.

Todas las variables en la base de datos pueden tener un impacto significativo en el rendimiento académico de los estudiantes, ya que factores como el nivel de estrés, ansiedad, distracción o las condiciones de vida juegan un papel crucial en sus calificaciones. Por ejemplo, el entorno familiar, como el nivel educativo de los padres o el apoyo familiar, puede influir en la motivación y el tiempo de estudio del estudiante. Además, las variables relacionadas con el bienestar personal, como la salud o el consumo de alcohol, pueden afectar la capacidad de concentración y el desempeño académico. Asimismo, factores sociales, como el tiempo libre y las relaciones interpersonales, pueden influir en el equilibrio entre la vida personal y académica, lo que también tiene un impacto en las calificaciones. Por lo tanto, es importante considerar todas estas variables de manera integral, ya que cada una puede influir en el rendimiento de los estudiantes de distintas formas.

Convertimos la variable preditoria en categorica:

data$G3 <- ifelse(data$G3 >10,"Aprueba","No aprueba")

Convertimos la variable predictoria a factor:

data$G3 <- as.factor(data$G3)

Identidifcamos valores faltantes:

colSums(is.na(data))

##     school        sex        age    address    famsize    Pstatus       Medu 
##          0          0          0          0          0          0          0 
##       Fedu       Mjob       Fjob     reason   guardian traveltime  studytime 
##          0          0          0          0          0          0          0 
##   failures  schoolsup     famsup       paid activities    nursery     higher 
##          0          0          0          0          0          0          0 
##   internet   romantic     famrel   freetime      goout       Dalc       Walc 
##          0          0          0          0          0          0          0 
##     health   absences         G1         G2         G3 
##          0          0          0          0          0

Registros Duplicados:

sum(duplicated(data))

## [1] 0

Errores Tipograficos:

sapply(data, function(x) if(is.character(x) | is.factor(x)) unique(x))

## $school
## [1] "GP" "MS"
## 
## $sex
## [1] "F" "M"
## 
## $age
## NULL
## 
## $address
## [1] "U" "R"
## 
## $famsize
## [1] "GT3" "LE3"
## 
## $Pstatus
## [1] "A" "T"
## 
## $Medu
## NULL
## 
## $Fedu
## NULL
## 
## $Mjob
## [1] "at_home"  "health"   "other"    "services" "teacher" 
## 
## $Fjob
## [1] "teacher"  "other"    "services" "health"   "at_home" 
## 
## $reason
## [1] "course"     "other"      "home"       "reputation"
## 
## $guardian
## [1] "mother" "father" "other" 
## 
## $traveltime
## NULL
## 
## $studytime
## NULL
## 
## $failures
## NULL
## 
## $schoolsup
## [1] "yes" "no" 
## 
## $famsup
## [1] "no"  "yes"
## 
## $paid
## [1] "no"  "yes"
## 
## $activities
## [1] "no"  "yes"
## 
## $nursery
## [1] "yes" "no" 
## 
## $higher
## [1] "yes" "no" 
## 
## $internet
## [1] "no"  "yes"
## 
## $romantic
## [1] "no"  "yes"
## 
## $famrel
## NULL
## 
## $freetime
## NULL
## 
## $goout
## NULL
## 
## $Dalc
## NULL
## 
## $Walc
## NULL
## 
## $health
## NULL
## 
## $absences
## NULL
## 
## $G1
## NULL
## 
## $G2
## NULL
## 
## $G3
## [1] No aprueba Aprueba   
## Levels: Aprueba No aprueba

No hay datos faltantes, duplicados, ni errores ortograficos.

2. Dividir los datos en conjunto de entrenamiento y prueba

Dividimos los datos mediante un muestreo aleatorio y suponemos en 5 grupos:

set.seed(2025)
library(caret)

## Loading required package: ggplot2

## Loading required package: lattice

library(e1071)
library(naivebayes)

## naivebayes 1.0.0 loaded

## For more information please visit:

## https://majkamichal.github.io/naivebayes/

folds         <- createFolds(data$G3, k =5)
entrenamiento <- data[-folds[[5]],]
prueba        <- data[folds[[5]],]

Guardamos las etiquetas de los resultados de las observaciones en dos vectores por separado.

# Etiquetas
entrenamiento_labels <- data$G3[-folds[[5]]]
prueba_labels        <- data$G3[folds[[5]]]

3. Aplicar el Clasificador Bayesiano

modelo <- naiveBayes(G3 ~ ., data)

Calculamos la predicción del modelo:

pred <- predict(modelo,data[,-33],type="class")
tt   <- table(pred,data[,33])
tt

##             
## pred         Aprueba No aprueba
##   Aprueba        189         24
##   No aprueba      20        162

TA   <- (sum(diag(tt)))/sum(tt) # tasa de aciertos
paste("Tasa de aciertos: ",round(TA,4)*100, "%",sep="")

## [1] "Tasa de aciertos: 88.86%"

Revisamos los datos para determinar si es necesario hacer ajustes que mejoren las predicciones.

str(data)

## 'data.frame':    395 obs. of  33 variables:
##  $ school    : chr  "GP" "GP" "GP" "GP" ...
##  $ sex       : chr  "F" "F" "F" "F" ...
##  $ age       : int  18 17 15 15 16 16 16 17 15 15 ...
##  $ address   : chr  "U" "U" "U" "U" ...
##  $ famsize   : chr  "GT3" "GT3" "LE3" "GT3" ...
##  $ Pstatus   : chr  "A" "T" "T" "T" ...
##  $ Medu      : int  4 1 1 4 3 4 2 4 3 3 ...
##  $ Fedu      : int  4 1 1 2 3 3 2 4 2 4 ...
##  $ Mjob      : chr  "at_home" "at_home" "at_home" "health" ...
##  $ Fjob      : chr  "teacher" "other" "other" "services" ...
##  $ reason    : chr  "course" "course" "other" "home" ...
##  $ guardian  : chr  "mother" "father" "mother" "mother" ...
##  $ traveltime: int  2 1 1 1 1 1 1 2 1 1 ...
##  $ studytime : int  2 2 2 3 2 2 2 2 2 2 ...
##  $ failures  : int  0 0 3 0 0 0 0 0 0 0 ...
##  $ schoolsup : chr  "yes" "no" "yes" "no" ...
##  $ famsup    : chr  "no" "yes" "no" "yes" ...
##  $ paid      : chr  "no" "no" "yes" "yes" ...
##  $ activities: chr  "no" "no" "no" "yes" ...
##  $ nursery   : chr  "yes" "no" "yes" "yes" ...
##  $ higher    : chr  "yes" "yes" "yes" "yes" ...
##  $ internet  : chr  "no" "yes" "yes" "yes" ...
##  $ romantic  : chr  "no" "no" "no" "yes" ...
##  $ famrel    : int  4 5 4 3 4 5 4 4 4 5 ...
##  $ freetime  : int  3 3 3 2 3 4 4 1 2 5 ...
##  $ goout     : int  4 3 2 2 2 2 4 4 2 1 ...
##  $ Dalc      : int  1 1 2 1 1 1 1 1 1 1 ...
##  $ Walc      : int  1 1 3 1 2 2 1 1 1 1 ...
##  $ health    : int  3 3 3 5 5 5 3 1 1 5 ...
##  $ absences  : int  6 4 10 2 4 10 0 6 0 0 ...
##  $ G1        : int  5 5 7 15 6 15 12 6 16 14 ...
##  $ G2        : int  6 5 8 14 10 15 12 5 18 15 ...
##  $ G3        : Factor w/ 2 levels "Aprueba","No aprueba": 2 2 2 1 2 1 1 2 1 1 ...

Para mejores prediciones cambiamos variables a factor ya que representan categotias discretas que no tiene un orden logico o numerico:

library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

data <- data %>%
  mutate(across(c(school, sex, address, famsize, Pstatus, Mjob, Fjob, reason, guardian,schoolsup, famsup, paid, activities, nursery, higher, internet, romantic), as.factor))

Calculamos de nuevo el modelo y su prediccion:

modelo1 <- naiveBayes(G3 ~ ., data = data)
modelo1

## 
## Naive Bayes Classifier for Discrete Predictors
## 
## Call:
## naiveBayes.default(x = X, y = Y, laplace = laplace)
## 
## A-priori probabilities:
## Y
##    Aprueba No aprueba 
##  0.5291139  0.4708861 
## 
## Conditional probabilities:
##             school
## Y                    GP         MS
##   Aprueba    0.90909091 0.09090909
##   No aprueba 0.85483871 0.14516129
## 
##             sex
## Y                    F         M
##   Aprueba    0.4928230 0.5071770
##   No aprueba 0.5645161 0.4354839
## 
##             age
## Y                [,1]     [,2]
##   Aprueba    16.51196 1.217303
##   No aprueba 16.90323 1.311607
## 
##             address
## Y                    R         U
##   Aprueba    0.1818182 0.8181818
##   No aprueba 0.2688172 0.7311828
## 
##             famsize
## Y                  GT3       LE3
##   Aprueba    0.6937799 0.3062201
##   No aprueba 0.7311828 0.2688172
## 
##             Pstatus
## Y                     A          T
##   Aprueba    0.11961722 0.88038278
##   No aprueba 0.08602151 0.91397849
## 
##             Medu
## Y               [,1]     [,2]
##   Aprueba    2.91866 1.068827
##   No aprueba 2.55914 1.095074
## 
##             Fedu
## Y                [,1]     [,2]
##   Aprueba    2.698565 1.078660
##   No aprueba 2.322581 1.067063
## 
##             Mjob
## Y               at_home     health      other   services    teacher
##   Aprueba    0.09569378 0.11483254 0.34449761 0.30143541 0.14354067
##   No aprueba 0.20967742 0.05376344 0.37096774 0.21505376 0.15053763
## 
##             Fjob
## Y               at_home     health      other   services    teacher
##   Aprueba    0.05263158 0.04784689 0.52631579 0.27751196 0.09569378
##   No aprueba 0.04838710 0.04301075 0.57526882 0.28494624 0.04838710
## 
##             reason
## Y                course       home      other reputation
##   Aprueba    0.34449761 0.26794258 0.09569378 0.29186603
##   No aprueba 0.39247312 0.28494624 0.08602151 0.23655914
## 
##             guardian
## Y                father     mother      other
##   Aprueba    0.23444976 0.70334928 0.06220096
##   No aprueba 0.22043011 0.67741935 0.10215054
## 
##             traveltime
## Y                [,1]      [,2]
##   Aprueba    1.358852 0.6205074
##   No aprueba 1.548387 0.7642856
## 
##             studytime
## Y                [,1]      [,2]
##   Aprueba    2.114833 0.8694716
##   No aprueba 1.946237 0.7968260
## 
##             failures
## Y                 [,1]      [,2]
##   Aprueba    0.1052632 0.3374410
##   No aprueba 0.5913978 0.9612667
## 
##             schoolsup
## Y                   no       yes
##   Aprueba    0.9138756 0.0861244
##   No aprueba 0.8225806 0.1774194
## 
##             famsup
## Y                   no       yes
##   Aprueba    0.4019139 0.5980861
##   No aprueba 0.3709677 0.6290323
## 
##             paid
## Y                   no       yes
##   Aprueba    0.5215311 0.4784689
##   No aprueba 0.5645161 0.4354839
## 
##             activities
## Y                   no       yes
##   Aprueba    0.4880383 0.5119617
##   No aprueba 0.4946237 0.5053763
## 
##             nursery
## Y                   no       yes
##   Aprueba    0.2153110 0.7846890
##   No aprueba 0.1935484 0.8064516
## 
##             higher
## Y                    no        yes
##   Aprueba    0.01913876 0.98086124
##   No aprueba 0.08602151 0.91397849
## 
##             internet
## Y                   no       yes
##   Aprueba    0.1339713 0.8660287
##   No aprueba 0.2043011 0.7956989
## 
##             romantic
## Y                   no       yes
##   Aprueba    0.6698565 0.3301435
##   No aprueba 0.6612903 0.3387097
## 
##             famrel
## Y                [,1]      [,2]
##   Aprueba    3.933014 0.9584197
##   No aprueba 3.956989 0.8241487
## 
##             freetime
## Y                [,1]      [,2]
##   Aprueba    3.234450 1.0178974
##   No aprueba 3.236559 0.9797722
## 
##             goout
## Y                [,1]     [,2]
##   Aprueba    2.947368 1.061614
##   No aprueba 3.290323 1.144488
## 
##             Dalc
## Y                [,1]      [,2]
##   Aprueba    1.421053 0.8958971
##   No aprueba 1.548387 0.8824552
## 
##             Walc
## Y                [,1]     [,2]
##   Aprueba    2.133971 1.221303
##   No aprueba 2.467742 1.340243
## 
##             health
## Y                [,1]     [,2]
##   Aprueba    3.540670 1.454278
##   No aprueba 3.569892 1.318458
## 
##             absences
## Y                [,1]     [,2]
##   Aprueba    5.282297 6.829075
##   No aprueba 6.188172 9.139878
## 
##             G1
## Y                 [,1]     [,2]
##   Aprueba    13.267943 2.470008
##   No aprueba  8.258065 1.803320
## 
##             G2
## Y                 [,1]     [,2]
##   Aprueba    13.397129 2.255376
##   No aprueba  7.698925 2.672320

pred2     <- predict(modelo1,data[,-33],type="class")
tta       <- table(pred2,data[,33])
tta

##             
## pred2        Aprueba No aprueba
##   Aprueba        189         24
##   No aprueba      20        162

Verificamos de nuevo la tasa de aciertos:

TAa       <- (sum(diag(tta)))/sum(tta) # tasa de aciertos
paste("Tasa de aciertos: ",round(TAa,4)*100, "%",sep="")

## [1] "Tasa de aciertos: 88.86%"

A pesar de haber convertido las variables categóricas a factores, la tasa de aciertos del modelo no mostró cambios significativos. Esto puede ser atribuido a que el modelo Naive Bayes ya estaba manejando correctamente las relaciones entre las variables y la variable objetivo (aprobación o no del curso) antes de la conversión. Es posible que, aunque las variables fueron transformadas a factores para asegurar una correcta interpretación como categóricas, su impacto en la predicción no haya sido lo suficientemente grande como para alterar los resultados. Además, algunas de las variables utilizadas, como las calificaciones previas (G1 y G2) o el número de ausencias, tienen una influencia mucho más directa en la predicción de la aprobación del curso, por lo que las transformaciones a factores de otras variables no afectaron sustancialmente el rendimiento del modelo. Esto sugiere que el modelo ya estaba capturando eficazmente las relaciones entre las variables y la variable objetivo sin necesidad de ajustes adicionales.

prueba_labels <- data$G3
confusionMatrix(pred2,prueba_labels)

## Confusion Matrix and Statistics
## 
##             Reference
## Prediction   Aprueba No aprueba
##   Aprueba        189         24
##   No aprueba      20        162
##                                           
##                Accuracy : 0.8886          
##                  95% CI : (0.8534, 0.9179)
##     No Information Rate : 0.5291          
##     P-Value [Acc > NIR] : <2e-16          
##                                           
##                   Kappa : 0.7762          
##                                           
##  Mcnemar's Test P-Value : 0.6511          
##                                           
##             Sensitivity : 0.9043          
##             Specificity : 0.8710          
##          Pos Pred Value : 0.8873          
##          Neg Pred Value : 0.8901          
##              Prevalence : 0.5291          
##          Detection Rate : 0.4785          
##    Detection Prevalence : 0.5392          
##       Balanced Accuracy : 0.8876          
##                                           
##        'Positive' Class : Aprueba         
##

4. Validar la estabilidad del modelo

Apliquemos validación cruzada para validar la estabilidad del modelo.

set.seed(2025)
train_control <- trainControl(method="cv",number=20,savePredictions = TRUE)

NBC_cv <- train(G3 ~ ., data=cbind(prueba, diagnosis=prueba_labels), 
                method = "naive_bayes", trControl = train_control)

## Warning in data.frame(..., check.names = FALSE): row names were found from a
## short variable and have been discarded
## Warning in data.frame(..., check.names = FALSE): row names were found from a
## short variable and have been discarded
## Warning in data.frame(..., check.names = FALSE): row names were found from a
## short variable and have been discarded

# Resultados de validación cruzada
NBC_cv

## Naive Bayes 
## 
## 395 samples
##  33 predictor
##   2 classes: 'Aprueba', 'No aprueba' 
## 
## No pre-processing
## Resampling: Cross-Validated (20 fold) 
## Summary of sample sizes: 375, 376, 376, 376, 376, 375, ... 
## Resampling results across tuning parameters:
## 
##   usekernel  Accuracy   Kappa    
##   FALSE      0.8562406  0.7047611
##    TRUE      0.9595927  0.9197081
## 
## 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 = TRUE
##  and adjust = 1.

# Matriz de confusión usando predicciones guardadas por caret
confusionMatrix(NBC_cv$pred$pred, NBC_cv$pred$obs)

## Confusion Matrix and Statistics
## 
##             Reference
## Prediction   Aprueba No aprueba
##   Aprueba        399         52
##   No aprueba      21        318
##                                           
##                Accuracy : 0.9076          
##                  95% CI : (0.8852, 0.9269)
##     No Information Rate : 0.5316          
##     P-Value [Acc > NIR] : < 2.2e-16       
##                                           
##                   Kappa : 0.8135          
##                                           
##  Mcnemar's Test P-Value : 0.000446        
##                                           
##             Sensitivity : 0.9500          
##             Specificity : 0.8595          
##          Pos Pred Value : 0.8847          
##          Neg Pred Value : 0.9381          
##              Prevalence : 0.5316          
##          Detection Rate : 0.5051          
##    Detection Prevalence : 0.5709          
##       Balanced Accuracy : 0.9047          
##                                           
##        'Positive' Class : Aprueba         
##

5. Interpretacion de resultados finales

**Matriz de confusión*: El modelo muestra un buen desempeño al clasificar correctamente a 399 estudiantes como “Aprueba” y 318 como “No aprueba”. Comete algunos errores, especialmente con los estudiantes que aprueban, donde predice incorrectamente como “No aprueba” en 52 casos.
Exactitud (Accuracy): La exactitud es 90.76%, lo que indica que el modelo acierta en el 91% de los casos. Esto es un buen rendimiento, superando la tasa de “No Information Rate” (53.16%).
Índice Kappa: El índice 0.8135 indica un desempeño excelente en comparación con las predicciones aleatorias. Valores mayores a 0.80 sugieren una buena calidad del modelo.
Sensibilidad y Especificidad: La sensibilidad es 95%, lo que significa que el modelo identifica correctamente a los estudiantes que aprueban. La especificidad es 85.95%, mostrando que también clasifica bien a los que no aprueban.

En este análisis, hemos evaluado el desempeño del modelo Naive Bayes mediante validación cruzada con 5 particiones (5-fold cross-validation) para asegurar su estabilidad y robustez. A través de la matriz de confusión y las métricas obtenidas, hemos comprobado que el modelo tiene un rendimiento sólido, con una alta tasa de aciertos y una excelente capacidad para distinguir entre estudiantes que aprueban y no aprueban el curso. La validación cruzada nos permitió obtener una estimación más precisa de su desempeño general, evidenciando que el modelo tiene una buena capacidad de generalización y no está sesgado hacia ninguna de las clases. Las métricas de exactitud, Kappa, sensibilidad y especificidad confirman la efectividad del modelo en la predicción del rendimiento académico de los estudiantes.