Tarea 13
Yeliany Colón Rodríguez
2024-11-21
Ejercicio 1
Admitidos: Se tiene la base de datos denominada Academico. Esta base de datos fue creada para discriminar la admisión de estudiantes a la Escuela Graduada de Negocios. Se hicieron tres pruebas (Economía, Finanzas y Matemáticas), y se cuenta con la puntuación de la universidad de procedencia y su GPA. La codificación de los grupos es (1) admitido y (2) no admitido. Realice un análisis de discriminante para evaluar si la función discriminante que se está aplicando es adecuada.
data <- read.csv("Academico.csv")
str(data)## 'data.frame': 54 obs. of 7 variables:
## $ Estudiante : int 1 2 3 4 5 6 7 8 9 10 ...
## $ Química : num 52.2 50.9 52.6 52.6 50.5 ...
## $ Física : num 51.2 51.5 48.9 52.5 51.9 ...
## $ Matemáticas : num 49.9 52.7 47.9 48.6 50.1 ...
## $ Clas_colegio: int 6 7 5 5 5 6 7 7 6 5 ...
## $ GPA : num 3.04 3.04 3.44 3.44 2.88 3.28 3.76 2.8 3.28 3.36 ...
## $ Grupo : int 1 1 1 1 1 1 1 1 1 1 ...Paso 1:
Preparación de los datos:
Debemos convertir la variable “Grupo” en una variable categórica. Esto se puede hacer de la siguiente manera:
data$Grupo <- factor(data$Grupo,levels=c(1,2),labels=c("admitido","no_admitido"))
str(data)## 'data.frame': 54 obs. of 7 variables:
## $ Estudiante : int 1 2 3 4 5 6 7 8 9 10 ...
## $ Química : num 52.2 50.9 52.6 52.6 50.5 ...
## $ Física : num 51.2 51.5 48.9 52.5 51.9 ...
## $ Matemáticas : num 49.9 52.7 47.9 48.6 50.1 ...
## $ Clas_colegio: int 6 7 5 5 5 6 7 7 6 5 ...
## $ GPA : num 3.04 3.04 3.44 3.44 2.88 3.28 3.76 2.8 3.28 3.36 ...
## $ Grupo : Factor w/ 2 levels "admitido","no_admitido": 1 1 1 1 1 1 1 1 1 1 ...Visualización:
Para obtener una visión general de cómo se distribuyen los datos, generaremos un gráfico de dispersión de estudiante frente al GPA.
library(ggplot2)
ggplot(data) + aes(x=Estudiante,y=GPA,color=Grupo) +
geom_point() +
theme_bw() 
En el gráfico podemos notar que el grupo de los admitidos se puede diferenciar de los no admitidos fácilmente. Además, podemos observar que entre 25 a 30 estudiantes fueron admitidos y estos tienen el GPA entre 2.60 en adelante. Mientras que el grupo de los no admitidos consta de entre 25 a 30 estudiantes y la mayoría tiene un GPA entre 2.4 a 3.5.
Prueba de normalidad multivariada:
library(MVN)
# Dividir los datos en dos grupos
admitido <- subset(data, Grupo == "admitido")
no_admitido <- subset(data, Grupo == "no_admitido")Luego de dividir los grupos, aplicamos la prueba de normalidad para cada uno.
# Prueba de Mardia para normalidad multivariada para los admitidos
mvn(admitido[, c("GPA", "Estudiante")], mvnTest = "mardia")$multivariateNormality## Test Statistic p value Result
## 1 Mardia Skewness 1.25931057988339 0.868240285471482 YES
## 2 Mardia Kurtosis -1.86979657167907 0.0615120726365772 YES
## 3 MVN <NA> <NA> YES# Prueba de Mardia para normalidad multivariada en los no admitidos
mvn(no_admitido[, c("GPA", "Estudiante")], mvnTest = "mardia")$multivariateNormality## Test Statistic p value Result
## 1 Mardia Skewness 19.985141073708 0.000502783500015266 NO
## 2 Mardia Kurtosis 2.32623220315815 0.0200061665832625 NO
## 3 MVN <NA> <NA> NOPodemos notar que cuando aplicamos la prueba Mardia, el grupo
“admitido” cumple con la normal multivariada. Mientras que el grupo de
los “no_admitido” no cumple con la prueba de la normal multivariada.
Conjuntos de entrenamiento y prueba. Elegimos un 80% entrenamiento y 20% prueba
library(caret)## Warning: package 'caret' was built under R version 4.4.2## Loading required package: lattice# División de los datos: 80% entrenamiento y 20% prueba
set.seed(1234) # Para reproducibilidad
Index <- createDataPartition(data$Grupo, p = 0.8, list = F)
entrenamiento <- data[Index, ]
prueba <- data[-Index, ]Paso 2:
Selección del método:
Aplicamos la prueba de Box’s M para evaluar la homogeneidad de las matrices de covarianza.
library(biotools)## Warning: package 'biotools' was built under R version 4.4.2## Loading required package: MASS## ---
## biotools version 4.2# Aplicar la prueba de Box's M
boxM <- boxM(entrenamiento[, c("GPA", "Estudiante")], entrenamiento$Grupo)
boxM##
## Box's M-test for Homogeneity of Covariance Matrices
##
## data: entrenamiento[, c("GPA", "Estudiante")]
## Chi-Sq (approx.) = 8.4017, df = 3, p-value = 0.0384Como el p−value = 0.0384 < 0.05, el método elegido sería QDA.
Paso 3:
Creación de la función discriminante:
Dado que el QDA es el método adecuado, ajustaremos un modelo cuadrático.
# Ajustar el modelo de ADQ utilizando el conjunto de entrenamiento
modelo_qda <- qda(Grupo ~ GPA + Estudiante, data = entrenamiento)
modelo_qda## Call:
## qda(Grupo ~ GPA + Estudiante, data = entrenamiento)
##
## Prior probabilities of groups:
## admitido no_admitido
## 0.6363636 0.3636364
##
## Group means:
## GPA Estudiante
## admitido 3.171429 17.28571
## no_admitido 2.450000 43.81250Como podemos observar las variables presentan diferencias importantes que ayudarán en la discriminación.
Paso 4:
Validación de modelo:
Evaluaremos el rendimiento del modelo en el conjunto de prueba, comparando las predicciones del modelo con los valores reales mediante una matriz de confusión.
# Realizar predicciones en el conjunto de prueba
predicciones_qda <- predict(modelo_qda,prueba)
library(caret)
# Crear la matriz de confusión usando las predicciones en el conjunto de prueba
MC2 <- confusionMatrix(predicciones_qda$class, prueba$Grupo)
MC2## Confusion Matrix and Statistics
##
## Reference
## Prediction admitido no_admitido
## admitido 6 0
## no_admitido 0 4
##
## Accuracy : 1
## 95% CI : (0.6915, 1)
## No Information Rate : 0.6
## P-Value [Acc > NIR] : 0.006047
##
## Kappa : 1
##
## Mcnemar's Test P-Value : NA
##
## Sensitivity : 1.0
## Specificity : 1.0
## Pos Pred Value : 1.0
## Neg Pred Value : 1.0
## Prevalence : 0.6
## Detection Rate : 0.6
## Detection Prevalence : 0.6
## Balanced Accuracy : 1.0
##
## 'Positive' Class : admitido
## Ahora utilizaremos la validación cruzada para evaluar la capacidad del modelo para generalizarse a datos nuevos.
# Configurar la validación cruzada con caret
control <- trainControl(method = "cv", number = 10, savePredictions = "all")
# Entrenar el modelo de ADQ con validación cruzada
modelo_qda_cv <- train(Grupo ~ GPA + Estudiante,
data = entrenamiento, method = "qda", trControl = control)
# Extraer las predicciones de todas las particiones
predicciones2_cv <- modelo_qda_cv$pred
# Crear una matriz de confusión combinada
MC2_cv <- confusionMatrix(predicciones2_cv$pred, predicciones2_cv$obs)
MC2_cv## Confusion Matrix and Statistics
##
## Reference
## Prediction admitido no_admitido
## admitido 28 1
## no_admitido 0 15
##
## Accuracy : 0.9773
## 95% CI : (0.8798, 0.9994)
## No Information Rate : 0.6364
## P-Value [Acc > NIR] : 6.031e-08
##
## Kappa : 0.9502
##
## Mcnemar's Test P-Value : 1
##
## Sensitivity : 1.0000
## Specificity : 0.9375
## Pos Pred Value : 0.9655
## Neg Pred Value : 1.0000
## Prevalence : 0.6364
## Detection Rate : 0.6364
## Detection Prevalence : 0.6591
## Balanced Accuracy : 0.9688
##
## 'Positive' Class : admitido
## Paso 5:
Interpretación de los resultados:
Visualización de las discriminaciones entre cada par de variables.
library(klaR)## Warning: package 'klaR' was built under R version 4.4.2partimat(Grupo ~ GPA+Estudiante,data,main="Discriminación con QDA",
method = "qda", image.colors = c("lightgreen", "skyblue2"),
col.mean = "red")
Dejándonos llevar por el gráfico podemos concluir que el modelo QDA separa los grupos “admitidos” y ” no admitidos” de manera clara y correctamente en el espacio de predicción.
Ejercicio 2
Iris: Aplique la técnica de análisis de discriminante a la base de datos iris de R y compruebe si es sencillo discriminar cada especie.
Cargar los datos de iris
data2 <- iris
str(data2)## 'data.frame': 150 obs. of 5 variables:
## $ Sepal.Length: num 5.1 4.9 4.7 4.6 5 5.4 4.6 5 4.4 4.9 ...
## $ Sepal.Width : num 3.5 3 3.2 3.1 3.6 3.9 3.4 3.4 2.9 3.1 ...
## $ Petal.Length: num 1.4 1.4 1.3 1.5 1.4 1.7 1.4 1.5 1.4 1.5 ...
## $ Petal.Width : num 0.2 0.2 0.2 0.2 0.2 0.4 0.3 0.2 0.2 0.1 ...
## $ Species : Factor w/ 3 levels "setosa","versicolor",..: 1 1 1 1 1 1 1 1 1 1 ...Como R reconoce la variable categórica, no es necesario hacer ningún ajuste en las variables.
Gráfica
pairs(x = data2[,-5], col = c("blue", "green3")[iris$Species],
pch = 20)
En este gráfico de pares podemos observar que las variables tienen patrones altos y claros de separación, lo cual indica que son buenas candidatas para contribuir de manera efectiva a la clasificación entre los grupos.
División del conjunto en entrenamiento y prueba. Elegimos un 75% entrenamiento y 25% prueba
library(caret)
# División de los datos: 75% entrenamiento y 25% prueba
set.seed(1234) # Para reproducibilidad
Index <- createDataPartition(data2$Species, p = 0.75, list = F)
entrenamiento <- data2[Index, ]
prueba <- data2[-Index, ]Paso 2
Selección del método:
Aplicamos la prueba de Box’s M para evaluar la homogeneidad de las matrices de covarianza.
library(biotools)
# Aplicar la prueba de Box's M
boxM2 <- boxM(entrenamiento[,-5], entrenamiento$Species)
boxM2##
## Box's M-test for Homogeneity of Covariance Matrices
##
## data: entrenamiento[, -5]
## Chi-Sq (approx.) = 103.12, df = 20, p-value = 3.466e-13Como el p−value ≈ 0, el método elegido sería QDA.
Paso 3:
Creación de la función discriminante:
Dado que el QDA es el método adecuado, ajustaremos un modelo cuadrático.
# Ajustar el modelo de QDA utilizando el conjunto de entrenamiento
modelo_qda <- qda(Species ~ ., data = entrenamiento)
modelo_qda## Call:
## qda(Species ~ ., data = entrenamiento)
##
## Prior probabilities of groups:
## setosa versicolor virginica
## 0.3333333 0.3333333 0.3333333
##
## Group means:
## Sepal.Length Sepal.Width Petal.Length Petal.Width
## setosa 4.986842 3.410526 1.457895 0.2526316
## versicolor 5.894737 2.757895 4.231579 1.3263158
## virginica 6.692105 3.023684 5.613158 2.0500000Como podemos observar la mayoría de las variables presentan diferencias importantes que ayudarán en la discriminación.
Paso 4:
Validación de modelo:
Evaluaremos el rendimiento del modelo en el conjunto de prueba, comparando las predicciones del modelo con los valores reales mediante una matriz de confusión.
# Realizar predicciones en el conjunto de prueba
predicciones_qda <- predict(modelo_qda,prueba)
library(caret)
# Crear la matriz de confusión usando las predicciones en el conjunto de prueba
MC2 <- confusionMatrix(predicciones_qda$class, prueba$Species)
MC2## Confusion Matrix and Statistics
##
## Reference
## Prediction setosa versicolor virginica
## setosa 12 0 0
## versicolor 0 12 1
## virginica 0 0 11
##
## Overall Statistics
##
## Accuracy : 0.9722
## 95% CI : (0.8547, 0.9993)
## No Information Rate : 0.3333
## P-Value [Acc > NIR] : 4.864e-16
##
## Kappa : 0.9583
##
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: setosa Class: versicolor Class: virginica
## Sensitivity 1.0000 1.0000 0.9167
## Specificity 1.0000 0.9583 1.0000
## Pos Pred Value 1.0000 0.9231 1.0000
## Neg Pred Value 1.0000 1.0000 0.9600
## Prevalence 0.3333 0.3333 0.3333
## Detection Rate 0.3333 0.3333 0.3056
## Detection Prevalence 0.3333 0.3611 0.3056
## Balanced Accuracy 1.0000 0.9792 0.9583Ahora utilizaremos la validación cruzada para evaluar la capacidad del modelo para generalizarse a datos nuevos.
# Configurar la validación cruzada con caret
control <- trainControl(method = "cv", number = 10, savePredictions = "all")
# Entrenar el modelo de ADQ con validación cruzada
modelo_qda_cv <- train(Species ~ Sepal.Length + Sepal.Width + Petal.Length + Petal.Width,
data = entrenamiento, method = "qda", trControl = control)
# Extraer las predicciones de todas las particiones
predicciones2_cv <- modelo_qda_cv$pred
# Crear una matriz de confusión combinada
MC2_cv <- confusionMatrix(predicciones2_cv$pred, predicciones2_cv$obs)
MC2_cv## Confusion Matrix and Statistics
##
## Reference
## Prediction setosa versicolor virginica
## setosa 38 0 0
## versicolor 0 36 0
## virginica 0 2 38
##
## Overall Statistics
##
## Accuracy : 0.9825
## 95% CI : (0.9381, 0.9979)
## No Information Rate : 0.3333
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.9737
##
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: setosa Class: versicolor Class: virginica
## Sensitivity 1.0000 0.9474 1.0000
## Specificity 1.0000 1.0000 0.9737
## Pos Pred Value 1.0000 1.0000 0.9500
## Neg Pred Value 1.0000 0.9744 1.0000
## Prevalence 0.3333 0.3333 0.3333
## Detection Rate 0.3333 0.3158 0.3333
## Detection Prevalence 0.3333 0.3158 0.3509
## Balanced Accuracy 1.0000 0.9737 0.9868Paso 5:
Interpretación de los resultados:
Visualización de las discriminaciones entre cada par de variables.
library(klaR)
partimat(Species ~ .,data2, main="Discriminación",
method = "qda", image.colors = c("lightgreen", "skyblue2","pink"),
col.mean = "red")
Dejándonos llevar por el gráfico podemos concluir que el modelo QDA no separa los grupos de manera clara en el espacio de predicción. Esto lo podemos observar entre las variables “virginica” y “versicolor” que se interponen entre sí. Mientras que la variable “setosa” parece estar mejor diferenciada respecto a los otros dos, lo que indica que estas observaciones son más fáciles de clasificar correctamente.
¡Espero esté orgulloso de mis R Markdown!