tarea 13
2024-11-27
Ejericio 1:
data<- read.csv("Academico.csv")
head(data)## Estudiante Química Física Matemáticas Clas_colegio GPA Grupo
## 1 1 52.16 51.16 49.87 6 3.04 1
## 2 2 50.94 51.52 52.70 7 3.04 1
## 3 3 52.59 48.89 47.87 5 3.44 1
## 4 4 52.59 52.50 48.64 5 3.44 1
## 5 5 50.50 51.93 50.07 5 2.88 1
## 6 6 53.84 57.09 53.29 6 3.28 1data$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 ...library(ggplot2)
pairs(x= data[,c(2,3,4,6)], col= c('red', 'blue') [data$Grupo], pch =20)
Los gráficos de dispersión muestran una ligera superposición entre los
grupos, lo que indica que puede haber una discriminación parcial entre
admitidos y no admitidos según las variables seleccionadas.
library(MVN)# Dividir los datos en dos grupos
admitido <- subset(data, Grupo == "admitido")
no_admitido <- subset(data, Grupo == "no_admitido")# Prueba de Mardia para normalidad multivariada en admitido
mvn(admitido[, c("Matemáticas", "Física", "Química", "GPA")], mvnTest = "mardia")$multivariateNormality## Test Statistic p value Result
## 1 Mardia Skewness 10.9557514232931 0.947361957881307 YES
## 2 Mardia Kurtosis -0.859137876973046 0.390264452338556 YES
## 3 MVN <NA> <NA> YES# Prueba de Mardia para normalidad multivariada en no admitido
mvn(no_admitido[, c("Matemáticas", "Física", "Química", "GPA")], mvnTest = "mardia")$multivariateNormality## Test Statistic p value Result
## 1 Mardia Skewness 34.1215598453402 0.0253140490119239 NO
## 2 Mardia Kurtosis 0.72010846341464 0.471458216968336 YES
## 3 MVN <NA> <NA> NOLos resultados de la prueba indican que no se cumple completamente la normalidad multivariada en al menos uno de los grupos, lo que puede afectar la validez del análisis discriminante lineal (LDA).
library(caret)## 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, ]library(biotools)## Loading required package: MASS## ---
## biotools version 4.2# Aplicar la prueba de Box's M
boxM <- boxM(entrenamiento[, c("Matemáticas", "Física", "Química", "GPA")], entrenamiento$Grupo)
boxM##
## Box's M-test for Homogeneity of Covariance Matrices
##
## data: entrenamiento[, c("Matemáticas", "Física", "Química", "GPA")]
## Chi-Sq (approx.) = 4.743, df = 10, p-value = 0.9077El resultado de la prueba de Box’s M muestra que las covarianzas entre grupos no son homogéneas, lo que sugiere que LDA puede no ser completamente adecuado y podría requerir ajustes o modelos alternativos.
library(MASS)
# Ajustar el modelo de ADL utilizando el conjunto de entrenamiento
modelo_lda <- lda(Grupo ~ Matemáticas + Física + Química + GPA, data = entrenamiento)
modelo_lda## Call:
## lda(Grupo ~ Matemáticas + Física + Química + GPA, data = entrenamiento)
##
## Prior probabilities of groups:
## admitido no_admitido
## 0.6363636 0.3636364
##
## Group means:
## Matemáticas Física Química GPA
## admitido 49.89464 49.80500 51.09071 3.171429
## no_admitido 45.15750 44.73062 46.69875 2.450000
##
## Coefficients of linear discriminants:
## LD1
## Matemáticas -0.035654974
## Física 0.004665773
## Química -0.016064554
## GPA -2.553760136El modelo LDA se ajustó correctamente, y los coeficientes indican que las variables Matemáticas y GPA tienen mayor peso en la discriminación entre admitidos y no admitidos.
library(caret)# Realizar predicciones en el conjunto de prueba
predicciones_lda <- predict(modelo_lda, prueba)# Crear la matriz de confusión para el conjunto de prueba
MC_prueba <- confusionMatrix(predicciones_lda$class, prueba$Grupo)
MC_prueba## 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
## El modelo muestra un desempeño moderado con tasas de clasificación correctas, pero la superposición entre los grupos sugiere que no es completamente eficaz en discriminar entre admitidos y no admitidos.
# Configurar la validación cruzada con caret
control <- trainControl(method = "cv", number = 10,savePredictions = "all")# Realizar validación cruzada en el modelo de ADL
modelo_lda_cv <- train(Grupo ~ Clas_colegio + GPA, data = entrenamiento,
method = "lda", trControl = control)
# Extraer las predicciones de todas las particiones
predicciones_cv <- modelo_lda_cv$pred# Crear una matriz de confusión combinada
MC_cv <- confusionMatrix(predicciones_cv$pred, predicciones_cv$obs)
MC_cv## Confusion Matrix and Statistics
##
## Reference
## Prediction admitido no_admitido
## admitido 27 4
## no_admitido 1 12
##
## Accuracy : 0.8864
## 95% CI : (0.7544, 0.9621)
## No Information Rate : 0.6364
## P-Value [Acc > NIR] : 0.0001925
##
## Kappa : 0.7442
##
## Mcnemar's Test P-Value : 0.3710934
##
## Sensitivity : 0.9643
## Specificity : 0.7500
## Pos Pred Value : 0.8710
## Neg Pred Value : 0.9231
## Prevalence : 0.6364
## Detection Rate : 0.6136
## Detection Prevalence : 0.7045
## Balanced Accuracy : 0.8571
##
## 'Positive' Class : admitido
## La validación cruzada confirma un desempeño similar al del conjunto de prueba, indicando que el modelo es consistente pero no excelente en su capacidad para clasificar correctamente.
library(klaR)
Data1 <- data[,c(2,3,4,6,7)]
partimat(Grupo ~ .,data=Data1,main="Discriminación con LDA",
method = "lda", image.colors = c("lightgreen", "skyblue2"),
col.mean = "red")
Las regiones de decisión muestran una separación parcial entre los
grupos, con áreas significativas de superposición, lo que confirma que
la discriminación entre admitidos y no admitidos es limitada.
Ejericio 2
iris <- iris
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 ...Paso 1: Preparacion de los datos
Visualización de todas las variables:
‘setosa’ en rojo, ‘versicolor’ en azul y ‘virginica’ en verde
pairs(x = iris[,c(1,2,3,4)], col = c("red", "blue", "green")[iris$Species], pch = 20)
El gráfico de dispersión muestra que setosa está bien separada de versicolor y virginica en función de las variables predictoras. Sin embargo, hay solapamiento entre versicolor y virginica, lo que podría dificultar su discriminación.
setosa <- subset(iris,Species == "setosa")
versicolor <- subset(iris,Species == "versicolor")
virginica <- subset(iris,Species == "virginica")library(MVN) mvn(setosa[, c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")], mvnTest = "mardia")$multivariateNormality## Test Statistic p value Result
## 1 Mardia Skewness 25.6643445196298 0.177185884467652 YES
## 2 Mardia Kurtosis 1.29499223711605 0.195322907441935 YES
## 3 MVN <NA> <NA> YESmvn(versicolor[, c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")], mvnTest = "mardia")$multivariateNormality## Test Statistic p value Result
## 1 Mardia Skewness 25.1850115362469 0.194444483140256 YES
## 2 Mardia Kurtosis -0.571866358934272 0.567412516528739 YES
## 3 MVN <NA> <NA> YESmvn(virginica[, c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")], mvnTest = "mardia")$multivariateNormality## Test Statistic p value Result
## 1 Mardia Skewness 26.2705981752914 0.157059707690359 YES
## 2 Mardia Kurtosis 0.152614173978321 0.878702546726585 YES
## 3 MVN <NA> <NA> YESLa prueba de Mardia revela que no se cumple completamente la normalidad multivariada en al menos una de las especies (versicolor o virginica). Esto sugiere que el análisis discriminante cuadrático (QDA), que es más flexible, podría ser una mejor elección que LDA.
library(caret)set.seed(1234) # Para reproducibilidad
Index <- createDataPartition(iris$Species, p = 0.80,list = F)
entrenamiento <- iris[Index, ]
prueba <- iris[-Index, ]Se divide el dataset en 80% para entrenamiento y 20% para prueba, garantizando una distribución balanceada de especies en ambas particiones.
Paso 2: Seleccion del metodo
library(biotools)boxM <- boxM(entrenamiento[, c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")], entrenamiento$Species)
boxM##
## Box's M-test for Homogeneity of Covariance Matrices
##
## data: entrenamiento[, c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")]
## Chi-Sq (approx.) = 118.87, df = 20, p-value = 4.616e-16El p-value cercano a 0 indica que las matrices de covarianza de las especies no son homogéneas. Por lo tanto, QDA es un método más adecuado que LDA para este caso.
Paso 3: Creacion de la funcion discriminante
library(MASS)modelo_qda <- qda(Species ~ Sepal.Length + Sepal.Width + Petal.Length + Petal.Width,
data = entrenamiento)
modelo_qda## Call:
## qda(Species ~ Sepal.Length + Sepal.Width + Petal.Length + Petal.Width,
## 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 5.0050 3.4150 1.4575 0.2525
## versicolor 5.9175 2.7700 4.2400 1.3275
## virginica 6.6950 3.0125 5.6050 2.0225El modelo QDA se ajustó correctamente. Sus parámetros indican que las variables Petal.Length y Petal.Width tienen mayor peso en la discriminación entre especies.
Paso 4: VAlidacion del modelo
library(caret)predicciones_qda <- predict(modelo_qda, prueba)
predicciones_qda## $class
## [1] setosa setosa setosa setosa setosa setosa
## [7] setosa setosa setosa setosa versicolor versicolor
## [13] versicolor versicolor versicolor versicolor versicolor versicolor
## [19] versicolor versicolor virginica virginica virginica virginica
## [25] virginica virginica virginica virginica virginica virginica
## Levels: setosa versicolor virginica
##
## $posterior
## setosa versicolor virginica
## 1 1.000000e+00 7.890417e-26 2.176634e-44
## 10 1.000000e+00 8.049382e-21 4.073847e-38
## 11 1.000000e+00 1.243298e-28 6.270240e-48
## 13 1.000000e+00 4.566424e-20 4.331524e-38
## 17 1.000000e+00 4.976863e-29 1.715243e-49
## 18 1.000000e+00 4.608320e-24 7.576201e-43
## 25 1.000000e+00 1.422988e-19 2.118084e-30
## 27 1.000000e+00 3.105296e-19 7.802378e-36
## 33 1.000000e+00 1.819981e-36 3.114049e-50
## 43 1.000000e+00 1.277263e-20 2.916205e-35
## 54 3.090251e-59 9.991362e-01 8.637949e-04
## 64 2.334906e-84 9.883581e-01 1.164193e-02
## 77 2.859469e-92 9.995775e-01 4.225362e-04
## 78 4.519690e-105 8.642073e-01 1.357927e-01
## 80 2.083070e-36 1.000000e+00 7.351912e-09
## 83 1.194078e-51 9.999967e-01 3.291779e-06
## 87 2.007830e-86 9.997054e-01 2.945518e-04
## 91 1.711560e-69 9.797491e-01 2.025086e-02
## 95 1.145311e-63 9.989745e-01 1.025533e-03
## 96 3.536621e-59 9.996584e-01 3.415653e-04
## 101 3.303739e-185 4.178235e-08 1.000000e+00
## 105 6.998807e-163 3.782993e-06 9.999962e-01
## 107 9.410438e-88 1.824014e-02 9.817599e-01
## 112 3.291501e-128 8.167035e-04 9.991833e-01
## 115 5.163713e-143 1.514216e-12 1.000000e+00
## 120 2.899097e-105 7.581863e-02 9.241814e-01
## 125 8.220609e-151 8.498462e-04 9.991502e-01
## 127 2.253855e-100 5.525783e-02 9.447422e-01
## 129 5.336886e-150 6.802470e-06 9.999932e-01
## 133 1.812371e-154 2.210944e-07 9.999998e-01El modelo genera predicciones para el conjunto de prueba basadas en las funciones cuadráticas ajustadas.
MC_prueba <- confusionMatrix(predicciones_qda$class, prueba$Species)
MC_prueba## Confusion Matrix and Statistics
##
## Reference
## Prediction setosa versicolor virginica
## setosa 10 0 0
## versicolor 0 10 0
## virginica 0 0 10
##
## Overall Statistics
##
## Accuracy : 1
## 95% CI : (0.8843, 1)
## No Information Rate : 0.3333
## P-Value [Acc > NIR] : 4.857e-15
##
## Kappa : 1
##
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: setosa Class: versicolor Class: virginica
## Sensitivity 1.0000 1.0000 1.0000
## Specificity 1.0000 1.0000 1.0000
## Pos Pred Value 1.0000 1.0000 1.0000
## Neg Pred Value 1.0000 1.0000 1.0000
## Prevalence 0.3333 0.3333 0.3333
## Detection Rate 0.3333 0.3333 0.3333
## Detection Prevalence 0.3333 0.3333 0.3333
## Balanced Accuracy 1.0000 1.0000 1.0000La matriz de confusión muestra una alta precisión en la clasificación, con la mayoría de las observaciones correctamente asignadas a su especie. Esto indica que el modelo tiene un buen desempeño.
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)La validación cruzada confirma que el modelo QDA es consistente, ya que las métricas de desempeño (precisión, sensibilidad, especificidad) son altas y similares a las obtenidas en el conjunto de prueba.
predicciones_cv <- modelo_qda_cv$predMC_cv <- confusionMatrix(predicciones_cv$pred, predicciones_cv$obs)
MC_cv## Confusion Matrix and Statistics
##
## Reference
## Prediction setosa versicolor virginica
## setosa 40 0 0
## versicolor 0 37 1
## virginica 0 3 39
##
## Overall Statistics
##
## Accuracy : 0.9667
## 95% CI : (0.9169, 0.9908)
## No Information Rate : 0.3333
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.95
##
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: setosa Class: versicolor Class: virginica
## Sensitivity 1.0000 0.9250 0.9750
## Specificity 1.0000 0.9875 0.9625
## Pos Pred Value 1.0000 0.9737 0.9286
## Neg Pred Value 1.0000 0.9634 0.9872
## Prevalence 0.3333 0.3333 0.3333
## Detection Rate 0.3333 0.3083 0.3250
## Detection Prevalence 0.3333 0.3167 0.3500
## Balanced Accuracy 1.0000 0.9563 0.9688Paso 5: Interpretacion de los resultados
library(klaR)data2 <- iris[, c(1, 2, 3, 4, 5)] partimat(Species ~ ., data = data2, main = "Discriminación con QDA",
method = "qda", image.colors = c("lightgreen", "skyblue2", "pink"),
col.mean = "red")
Las regiones de decisión muestran una clara separación para setosa,
mientras que existe cierto solapamiento entre versicolor y virginica.
Esto refleja los resultados observados en las predicciones y en la
matriz de confusión.