Ejercicio 1.

Utilizando la base de datos “Academico”, se llevo a cabo un analisis discriminante con objetivo de clasificar como “Admitido” o “No Admitido” a estudiantes, analizando variables como GPA y sus calificaciones en ciertas materias.

Datos

Academico <- read.csv("C:/Users/Nieves M/Documents/ESTA55503/Datos-Tareas/Academico.csv")
str(Academico)
## '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 ...

Limpiar datos

#Remover acentos de nombres de columnas
library(stringi)
colnames(Academico) <- stri_trans_general(colnames(Academico), "Latin-ASCII")

Transformacion de variables categoricas

#Variable "Grupo"
Academico$Grupo <- factor(Academico$Grupo, labels = c("Admitido","No Admitido"))

#Variable "Estudiante"
Academico$Estudiante <- factor(Academico$Estudiante)

#Variable "Clas_colegio"
Academico$Clas_colegio <- factor(Academico$Clas_colegio)

#Verificar
str(Academico)
## 'data.frame':    54 obs. of  7 variables:
##  $ Estudiante  : Factor w/ 54 levels "1","2","3","4",..: 1 2 3 4 5 6 7 8 9 10 ...
##  $ Quimica     : num  52.2 50.9 52.6 52.6 50.5 ...
##  $ Fisica      : num  51.2 51.5 48.9 52.5 51.9 ...
##  $ Matematicas : num  49.9 52.7 47.9 48.6 50.1 ...
##  $ Clas_colegio: Factor w/ 6 levels "2","3","4","5",..: 5 6 4 4 4 5 6 6 5 4 ...
##  $ 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 ...

Visualizacion de los datos

pairs(Academico[,c("Quimica", "Fisica", "Matematicas", "GPA")],col=c("blue","green3")[Academico$Grupo], pch=20)

El grafico muestra la relacion entre las variables, teniendo el color azul como los admitidos, donde existe una relacion positiva en la variable GPA y Matematicas, al igual que Quimica y Fisica.

#Grafica de dispersion
library(ggplot2)
ggplot(Academico, aes(x = GPA, y = Matematicas, color = Grupo)) + 
  geom_point(size = 3) + 
  labs(title = "Relacion entre GPA, Matematicas y Grupo") + 
  theme_minimal()

Se hizo el grafico relacionando GPA y Matematicas, donde se nota que los admitidos tienden a tener un GPA mayor a 3 y resultados superiores de 50 en matematicas.

Division de datos en entrenamiento y prueba

library(caret)
set.seed(801)
#Conjunto de entrenamineto de 75% y de prueba 25%.
Index <- createDataPartition(Academico$Grupo, p=0.75, list=F)
entrenamiento <- Academico[Index,]
prueba <- Academico[-Index,]

Prueba de homogeneidad de matrices de covarianza.

#Prueba Box`s M
library(biotools)
boxM2 <- boxM(entrenamiento[,c("Quimica", "Fisica", "Matematicas", "GPA")], entrenamiento$Grupo)
boxM2
## 
##  Box's M-test for Homogeneity of Covariance Matrices
## 
## data:  entrenamiento[, c("Quimica", "Fisica", "Matematicas", "GPA")]
## Chi-Sq (approx.) = 6.7683, df = 10, p-value = 0.7471

Se obtuvo un p-valor de 0.7471, mayor a 0.05 por lo que sugiere que no hay diferencias significativas en las matrices, por ende no se rechaza la hipotesis nula y se porcede a aplicar el Analisis Discriminante Lineal(LDA).

Funcion discriminante

library(MASS)
#Modelo LDA
modelo_lda <- lda(Grupo ~ Quimica + Fisica + Matematicas + GPA, data = entrenamiento)
modelo_lda
## Call:
## lda(Grupo ~ Quimica + Fisica + Matematicas + GPA, data = entrenamiento)
## 
## Prior probabilities of groups:
##    Admitido No Admitido 
##   0.6341463   0.3658537 
## 
## Group means:
##              Quimica   Fisica Matematicas      GPA
## Admitido    51.05538 49.72731    49.39038 3.178462
## No Admitido 46.81133 45.35200    45.60600 2.437333
## 
## Coefficients of linear discriminants:
##                     LD1
## Quimica     -0.04056402
## Fisica      -0.01985684
## Matematicas  0.02284393
## GPA         -2.59044554

Probabilidades a priori: Admitido: 63.41% No Admitido: 36.59%

Coeficientes: Grupo (-2.590): Tiene un mayor impacto en la clasificacion. Mientras que: Quimica (-0.040), Fisica(-0.019),Matematicas(0.022) tienen un peso menor.

Prediccion y evaluacion de modelo

#Predicciones de conjunto prueba
predicciones_lda <- predict(modelo_lda,prueba)

#Matriz de confunsion
MC_prueba <- confusionMatrix(predicciones_lda$class, prueba$Grupo)
MC_prueba
## Confusion Matrix and Statistics
## 
##              Reference
## Prediction    Admitido No Admitido
##   Admitido           8           2
##   No Admitido        0           3
##                                           
##                Accuracy : 0.8462          
##                  95% CI : (0.5455, 0.9808)
##     No Information Rate : 0.6154          
##     P-Value [Acc > NIR] : 0.07187         
##                                           
##                   Kappa : 0.6486          
##                                           
##  Mcnemar's Test P-Value : 0.47950         
##                                           
##             Sensitivity : 1.0000          
##             Specificity : 0.6000          
##          Pos Pred Value : 0.8000          
##          Neg Pred Value : 1.0000          
##              Prevalence : 0.6154          
##          Detection Rate : 0.6154          
##    Detection Prevalence : 0.7692          
##       Balanced Accuracy : 0.8000          
##                                           
##        'Positive' Class : Admitido        
##

Se obtuvo de las predicciones: Admitidos: 8 correctos, 2 falsos negativos. No Admitido: 3 correctos y ningun falso positivo; con una precision del 84.62%, por lo cual el modelo clasifico correctamente la gran parte de los casos en el conjunto de prueba.

Validacion cruzada

control <- trainControl(method = "cv", number = 10, savePredictions = "all")

modelo_lda_cv <- train(Grupo ~ Quimica + Fisica + Matematicas + GPA, data = entrenamiento, method = "lda", trControl = control) 

predicciones_cv <- modelo_lda_cv$pred

MC_cv <- confusionMatrix(predicciones_cv$pred, predicciones_cv$obs)
MC_cv
## Confusion Matrix and Statistics
## 
##              Reference
## Prediction    Admitido No Admitido
##   Admitido          23           4
##   No Admitido        3          11
##                                           
##                Accuracy : 0.8293          
##                  95% CI : (0.6794, 0.9285)
##     No Information Rate : 0.6341          
##     P-Value [Acc > NIR] : 0.005474        
##                                           
##                   Kappa : 0.6268          
##                                           
##  Mcnemar's Test P-Value : 1.000000        
##                                           
##             Sensitivity : 0.8846          
##             Specificity : 0.7333          
##          Pos Pred Value : 0.8519          
##          Neg Pred Value : 0.7857          
##              Prevalence : 0.6341          
##          Detection Rate : 0.5610          
##    Detection Prevalence : 0.6585          
##       Balanced Accuracy : 0.8090          
##                                           
##        'Positive' Class : Admitido        
##

Al implementar una validacion cruzada de 10 particiones se obtuvo una presicion de 82.93% del modelo. Donde en este caso de obtuvo las predicciones: Admitidos: 23 correctos, 4 falsos positivos No Admitido: 11 correctos, 3 falsos negativos; a pesar de la tendencia de clasificar erroneamente los No Admitidos como Admitidos, muestra un rendimiento consistente y estable.

Ejercicio 2.

Junto a los datos “iris” de la libreria MASS, se realizo un Analisis Discriminante con el objetivo de discriminar entre las especies: setosa, versicolor, virginica, basandose en varias variables.

Datos

library(MASS)
str(iris)
## '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 ...

Visualizacion de datos

pairs(iris[,c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")],
      col=c("red", "green", "blue")[iris$Species], pch=20)

#Grafica de dispersion
library(ggplot2)
ggplot(iris, aes(x = Sepal.Length, y = Sepal.Width, color = Species)) + 
  geom_point(size = 3) + 
  labs(title = "Relacion entre Sepal.Length y Sepal.Width por especie") + 
  theme_minimal()

Division de datos en entrenamiento y prueba

library(caret)
set.seed(801)

#Division en entrenamiento (75%) y prueba (25%)
Index_iris <- createDataPartition(iris$Species, p = 0.75, list = F)
entrenamiento_iris <- iris[Index, ]
prueba_iris <- iris[-Index, ]

Prueba de homogeneidad de matrices de covarianza

library(biotools)
#Prueba Box`s M
boxM2 <- boxM(entrenamiento_iris[,c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")], entrenamiento_iris$Species)
boxM2
## 
##  Box's M-test for Homogeneity of Covariance Matrices
## 
## data:  entrenamiento_iris[, c("Sepal.Length", "Sepal.Width", "Petal.Length",     "Petal.Width")]
## Chi-Sq (approx.) = 43.412, df = 10, p-value = 4.197e-06

Debido a que el p-valor es menor que 0.05, se rechaza la hipotesis nula. A la matrices de covarianza no tener homogeneidad se utilizara el metodo de Analisis Discriminante Cuadratico(QDA).

Funcion discriminante

#Modelo QDA
modelo_qda <- qda(Species ~ Sepal.Length + Sepal.Width + Petal.Length + Petal.Width, data = entrenamiento_iris)
## Error in qda.default(x, grouping, ...): some group is too small for 'qda'
modelo_qda
## Error in eval(expr, envir, enclos): object 'modelo_qda' not found

Probabilidades priori: las variables setosa, versicolor y virginica: 0.3333, lo cual significa que las tres tienen la misma probabilidad de ocurrir. Mientras que las medias de grupos son distintas por lo que es posible discriminar entre las especies.

Prediccion y evaluacion de modelo

#Predicciones en conjunto de prueba
predicciones_qda <- predict(modelo_qda, prueba_iris)
## Error in eval(expr, envir, enclos): object 'modelo_qda' not found
#Matriz de confusion
MC_qda <- confusionMatrix(predicciones_qda$class, prueba$Species)
## Error in eval(expr, envir, enclos): object 'predicciones_qda' not found
MC_qda
## Error in eval(expr, envir, enclos): object 'MC_qda' not found

Con el modelo QDA no se obtuvo errores en la matriz de confusion.

Validacion cruzada

#Configuracion de validacion cruzada
control <- trainControl(method = "cv", number = 10, savePredictions = "all")

#Modelo QDA con validación cruzada
modelo_qda_cv <- train(Species ~ Sepal.Length + Sepal.Width + Petal.Length + Petal.Width, data = entrenamiento_iris, method = "qda", trControl = control)
## Error: One or more factor levels in the outcome has no data: 'virginica'
predicciones_cv <- modelo_qda_cv$pred
## Error in eval(expr, envir, enclos): object 'modelo_qda_cv' not found
#Matriz de confusion
MC_cv_qda <- confusionMatrix(predicciones_cv$pred, predicciones_cv$obs)
MC_cv_qda
## Confusion Matrix and Statistics
## 
##              Reference
## Prediction    Admitido No Admitido
##   Admitido          23           4
##   No Admitido        3          11
##                                           
##                Accuracy : 0.8293          
##                  95% CI : (0.6794, 0.9285)
##     No Information Rate : 0.6341          
##     P-Value [Acc > NIR] : 0.005474        
##                                           
##                   Kappa : 0.6268          
##                                           
##  Mcnemar's Test P-Value : 1.000000        
##                                           
##             Sensitivity : 0.8846          
##             Specificity : 0.7333          
##          Pos Pred Value : 0.8519          
##          Neg Pred Value : 0.7857          
##              Prevalence : 0.6341          
##          Detection Rate : 0.5610          
##    Detection Prevalence : 0.6585          
##       Balanced Accuracy : 0.8090          
##                                           
##        'Positive' Class : Admitido        
##

En este caso 1 observacion de versicolor estuvo mal clasificada, a pesar de eso, se obtiene una presicion de 96.5%