PRACTICA
Pinta Luis
2024-06-13
BASE DE DATOS
library(readr)
est <- read.csv("student-por.csv",sep = ";")Se ha importado una base de datos que contiene información sobre 649 estudiantes interesados en ingresar a la universidad. Esta base de datos incluye 33 variables que detallan diversas características y factores relevantes de los estudiantes.
NOMBRE DE LAS VARIABLES DE LA BASE DE DATOS
names(est)## [1] "school" "sex" "age" "address" "famsize"
## [6] "Pstatus" "Medu" "Fedu" "Mjob" "Fjob"
## [11] "reason" "guardian" "traveltime" "studytime" "failures"
## [16] "schoolsup" "famsup" "paid" "activities" "nursery"
## [21] "higher" "internet" "romantic" "famrel" "freetime"
## [26] "goout" "Dalc" "Walc" "health" "absences"
## [31] "G1" "G2" "G3"Estas variables proporcionan una visión integral de los factores académicos, socioeconómicos y personales que pueden influir en el rendimiento y las decisiones educativas de los estudiantes.
VARIABLES DE SELECCIÓN
est1 <- est[, c("sex", "age", "Medu", "Fedu", "studytime", "absences", "G1", "G2", "G3", "higher")]sex: Sexo del estudiante (por ejemplo, masculino o femenino).
age: Edad del estudiante.
Medu: Nivel de educación de la madre.
Fedu: Nivel de educación del padre.
studytime: Tiempo dedicado al estudio por semana.
absences: Número de ausencias escolares.
G1: Calificación del primer periodo.
G2: Calificación del segundo periodo.
G3: Calificación final.
higher: Desea seguir estudios superiores (sí o no).
Estas variables proporcionan una visión integral de los factores académicos, socioeconómicos y personales que pueden influir en el rendimiento y las decisiones educativas de los estudiantes.
CAMBIAR EL TIPO DE CLASE LAS VARIABLES CATEGÓRICAS A FACTOR
Variable Sex
est1$sex <- factor(est1$sex )
levels(est1$sex ) <- c("F","M")
class(est1$sex )## [1] "factor"Variable Higher
est1$higher <- factor(est1$higher)
levels(est1$higher) <- c("no","yes")
class(est1$higher)## [1] "factor"MATRIZ TRANSFORMADA Y COMPLETA DE LAS CONVERSIONES Y NUMÉRICAS
classes <- sapply(est1, class)
for (i in 1: ncol (est1))
if (classes[i]== "integer")
est1[[i]]=as.numeric(est1[[i]])
classes <- sapply(est1, class)
classes## sex age Medu Fedu studytime absences G1 G2
## "factor" "numeric" "numeric" "numeric" "numeric" "numeric" "numeric" "numeric"
## G3 higher
## "numeric" "factor"Se creó una nueva matriz de datos que incluye todas las conversiones realizadas en las variables. Específicamente, se transformaron 2 variables categóricas al tipo “factor”, mientras que las variables numéricas se mantuvieron como “numéricas”.
ANÁLISIS DESCRIPTIVO
est11 <- est[, c("age", "Medu", "Fedu", "studytime", "absences", "G1", "G2", "G3")]summary(est11)## age Medu Fedu studytime
## Min. :15.00 Min. :0.000 Min. :0.000 Min. :1.000
## 1st Qu.:16.00 1st Qu.:2.000 1st Qu.:1.000 1st Qu.:1.000
## Median :17.00 Median :2.000 Median :2.000 Median :2.000
## Mean :16.74 Mean :2.515 Mean :2.307 Mean :1.931
## 3rd Qu.:18.00 3rd Qu.:4.000 3rd Qu.:3.000 3rd Qu.:2.000
## Max. :22.00 Max. :4.000 Max. :4.000 Max. :4.000
## absences G1 G2 G3
## Min. : 0.000 Min. : 0.0 Min. : 0.00 Min. : 0.00
## 1st Qu.: 0.000 1st Qu.:10.0 1st Qu.:10.00 1st Qu.:10.00
## Median : 2.000 Median :11.0 Median :11.00 Median :12.00
## Mean : 3.659 Mean :11.4 Mean :11.57 Mean :11.91
## 3rd Qu.: 6.000 3rd Qu.:13.0 3rd Qu.:13.00 3rd Qu.:14.00
## Max. :32.000 Max. :19.0 Max. :19.00 Max. :19.00age: La edad de los estudiantes varía entre 15 y 22 años. El promedio de edad es aproximadamente 16.74 = 17 años.
Medu: Nivel de educación de la madre. Varía de 0 a 4, con un promedio de aproximadamente 2.52. Esto sugiere que en promedio, las madres tienen una educación secundaria baja a media.
Fedu: Nivel de educación del padre. Varía de 0 a 4, con un promedio de aproximadamente 2.31. Similar a Medu, indica un nivel educativo secundario bajo a medio para los padres.
studytime: Tiempo semanal dedicado al estudio. Varía de 1 a 4, con un promedio de aproximadamente 1.93 horas. Esto indica que en promedio, los estudiantes dedican alrededor de 2 horas semanales al estudio.
absences: Número de ausencias escolares. Varía de 0 a 32, con un promedio de aproximadamente 3.66 ausencias. Esto sugiere que, en promedio, los estudiantes tienen alrededor de 4 ausencias escolares.
G1, G2, G3: Calificaciones en los periodos 1, 2 y la calificación final, respectivamente. Las calificaciones varían de 0 a 19. El promedio muestra una ligera mejora en las calificaciones a medida que avanza el año escolar, con G1 promediando aproximadamente 11.4, G2 11.57, y G3 11.91.
VARIABLES FICTICIAS
Escalamiento de númericas
numeric_columns <- sapply(est1, is.numeric)
est1[, numeric_columns] <- scale(est1[, numeric_columns])
# head(diabetes)x = model.matrix(higher~., data = est1)
head(x)## (Intercept) sexM age Medu Fedu studytime absences
## 1 1 0 1.0309000 1.3092058 1.539528 0.08358848 0.07337677
## 2 1 0 0.2099747 -1.3350097 -1.187916 0.08358848 -0.35758724
## 3 1 0 -1.4318759 -1.3350097 -1.187916 0.08358848 0.50434077
## 4 1 0 -1.4318759 1.3092058 -0.278768 1.28912007 -0.78855124
## 5 1 0 -0.6109506 0.4278007 0.630380 0.08358848 -0.78855124
## 6 1 1 -0.6109506 1.3092058 0.630380 0.08358848 0.50434077
## G1 G2 G3
## 1 -4.1522676 -0.1956687 -0.28044124
## 2 -0.8738957 -0.1956687 -0.28044124
## 3 0.2188949 0.4907582 0.02909339
## 4 0.9474220 0.8339717 0.64816266
## 5 -0.1453687 0.4907582 0.33862803
## 6 0.2188949 0.1475448 0.33862803Observará que las variables numéricas reescaladas contienen los mismos valores iniciales. Cada una de las variables nominales ha sido convertida en variables binarias.
DIVISIÓN
tr = round(nrow(est1)*0.7)
set.seed(0605490028)
muestra=sample.int(nrow(est1), tr)
Train = est1[muestra,]
val = est1[-muestra,]Ahora disponemos de un conjunto de entrenamiento Train y un conjunto d evalidación Val”.
KERNEL SIGMOIDAL
# Ajustar un modelo SVM con kernel sigmoidal
library(e1071)
fitsvm4 <- svm(higher ~ ., data = Train, kernel = "sigmoid")
summary(fitsvm4)##
## Call:
## svm(formula = higher ~ ., data = Train, kernel = "sigmoid")
##
##
## Parameters:
## SVM-Type: C-classification
## SVM-Kernel: sigmoid
## cost: 1
## coef.0: 0
##
## Number of Support Vectors: 93
##
## ( 48 45 )
##
##
## Number of Classes: 2
##
## Levels:
## no yeslibrary(caret)## Loading required package: ggplot2## Loading required package: latticepredictedSVM4<- predict(fitsvm4, newdata = val)
matrizSVM4 <- confusionMatrix(val$higher, predictedSVM4)
print(matrizSVM4)## Confusion Matrix and Statistics
##
## Reference
## Prediction no yes
## no 3 15
## yes 10 167
##
## Accuracy : 0.8718
## 95% CI : (0.8166, 0.9153)
## No Information Rate : 0.9333
## P-Value [Acc > NIR] : 0.9994
##
## Kappa : 0.1259
##
## Mcnemar's Test P-Value : 0.4237
##
## Sensitivity : 0.23077
## Specificity : 0.91758
## Pos Pred Value : 0.16667
## Neg Pred Value : 0.94350
## Prevalence : 0.06667
## Detection Rate : 0.01538
## Detection Prevalence : 0.09231
## Balanced Accuracy : 0.57418
##
## 'Positive' Class : no
## Verdaderos Positivos (TP): 167 (predicciones correctas de “yes” estudiantes que si van a ir a la eduacación superior)
Verdaderos Negativos (TN): 3 (predicciones correctas de “no” estudiantes que no van a ir a la eduacación superior)
Accuracy: La precisión general del modelo es del 87.18%, lo que indica la proporción de predicciones correctas sobre el total de predicciones.
Intervalo de Confianza (95% CI): El intervalo de confianza para la precisión está entre 81.66% y 91.53%.
Kappa: El coeficiente kappa es 0.1259, que mide la concordancia del modelo más allá de la concordancia debida al azar. Un valor cercano a cero indica una concordancia mínima.
Sensibilidad (Recall) y Especificidad:
Sensibilidad (Recall) para la clase “no” es 0.23, lo que indica que el modelo identifica correctamente el 23% de los casos reales de “no” (sensibilidad baja).
Especificidad para la clase “yes” es 0.92, lo que indica que el modelo identifica correctamente el 92% de los casos reales de “yes” (alta especificidad).
Valor Predictivo Positivo y Valor Predictivo Negativo:
Valor Predictivo Positivo (PPV) para la clase “no” es 0.17, lo que indica que el 17% de las predicciones positivas son realmente “no”.
Valor Predictivo Negativo (NPV) para la clase “yes” es 0.94, lo que indica que el 94% de las predicciones negativas son realmente “yes”.
Prevalencia y Detección:
Prevalencia de la clase “no” en el conjunto de datos es 6.67%.
Tasa de detección (Detection Rate) para la clase “no” es 1.54%, lo que indica la proporción de casos reales de “no” que el modelo detecta correctamente.
Prevalencia de la detección (Detection Prevalence) para la clase “no” es 9.23%.
Exactitud Equilibrada (Balanced Accuracy): Es 0.57, que es el promedio de sensibilidad y especificidad, indicando un desempeño moderado del modelo en general.
Conclusión:
El modelo muestra una precisión general del 87.18%, pero con una sensibilidad baja para la clase “no” (desea seguir estudios superiores), lo que indica que tiene dificultades para identificar correctamente los casos donde los estudiantes no desean seguir estudios superiores. La especificidad es alta para la clase “yes” (desea seguir estudios superiores), lo que indica que el modelo es bueno para predecir estos casos.
El valor de kappa sugiere una concordancia mínima, lo que podría indicar que el modelo podría beneficiarse de ajustes o mejoras para mejorar su rendimiento general.
Curva Roc para el Modelo SVM con kernel Sigmoidal
fitsvm4 <- svm(higher ~ ., data = Train, kernel = "sigmoid", probability = TRUE)
predictedSVM4 <- predict(fitsvm4, newdata = val, probability = TRUE)
test_prob4 <- attr(predictedSVM4, "probabilities")[, "yes"]
library(pROC)## Type 'citation("pROC")' for a citation.##
## Attaching package: 'pROC'## The following objects are masked from 'package:stats':
##
## cov, smooth, vartest_roc4 <- roc(val$higher ~ test_prob4, plot = TRUE, print.auc = TRUE, col = "purple", main = "Curva ROC para el Modelo SVM con Kernel Sigmoidal")## Setting levels: control = no, case = yes## Setting direction: controls < cases
Interpretación
Un AUC (Área Bajo la Curva) de 0.77 para el modelo SVM con kernel sigmoidal es un excelente resultado, lo que indica que el modelo tiene una alta capacidad para distinguir entre estudiantes que desean ir o no a la universidad.
RAMDOM FOREST
library(randomForest)## randomForest 4.7-1.1## Type rfNews() to see new features/changes/bug fixes.##
## Attaching package: 'randomForest'## The following object is masked from 'package:ggplot2':
##
## marginfitRF <- randomForest(higher~., data = Train, ntree=500)
# summary(fitRF)Este modelo de bosque aleatorio se ajustó con 500 árboles (ntree=500) y contiene detalles sobre las predicciones, la importancia de las variables, las tasas de error y otras métricas relacionadas con el rendimiento del modelo.
predictedRF <- predict(fitRF, val)
matrizRF1 <- confusionMatrix(val$higher, predictedRF)
matrizRF1## Confusion Matrix and Statistics
##
## Reference
## Prediction no yes
## no 5 13
## yes 4 173
##
## Accuracy : 0.9128
## 95% CI : (0.8641, 0.9484)
## No Information Rate : 0.9538
## P-Value [Acc > NIR] : 0.99570
##
## Kappa : 0.3291
##
## Mcnemar's Test P-Value : 0.05235
##
## Sensitivity : 0.55556
## Specificity : 0.93011
## Pos Pred Value : 0.27778
## Neg Pred Value : 0.97740
## Prevalence : 0.04615
## Detection Rate : 0.02564
## Detection Prevalence : 0.09231
## Balanced Accuracy : 0.74283
##
## 'Positive' Class : no
## Verdaderos Positivos (TP): 173 (predicciones correctas de “yes”)
Verdaderos Negativos (TN): 5 (predicciones correctas de “no”)
Conclusión:
El modelo de Random Forest muestra una precisión general del 91.28%, lo cual es superior al modelo SVM que evaluamos previamente. La sensibilidad para la clase “no” ha mejorado significativamente, pero aún es modesta en comparación con la especificidad para la clase “yes”, que es alta. El coeficiente kappa indica una mejora en la concordancia del modelo en comparación con el SVM.
En resumen, el modelo de Random Forest parece ser más efectivo que el SVM para predecir si un estudiante desea seguir estudios superiores, con mejoras en la sensibilidad y la precisión general.
importance(fitRF)## MeanDecreaseGini
## sex 3.218849
## age 11.827174
## Medu 7.353019
## Fedu 5.368551
## studytime 7.132468
## absences 14.106955
## G1 14.480615
## G2 12.204150
## G3 12.221636varImpPlot(fitRF, col = "blue")