Análisis del Impacto de la Pandemia Covid-19 en la Preferencia por Concentraciones en la Universidad de Puerto Rico - Recinto de Río Piedras
Tatiana M. Vizcarrondo Córdova, Layza N. Frías Rivera y Bernie Z. Vélez Cintrón
2023-12-18
Para este trabajo de investigación se evalúa la evolución de las preferencias académicas en la Universidad de Puerto Rico, Recinto de Río Piedras, durante los años 2017, 2020 y 2021. Se examina el impacto de la pandemia en las elecciones de concentración, destacando posibles cambios y tendencias a lo largo de estos periodos. La comparación temporal revelará patrones significativos en la selección de áreas de estudio, permitiendo una comprensión más profunda de cómo la crisis sanitaria ha influido en las decisiones educativas de los estudiantes.
Primero descargamos la base de datos para los años 2017, 2020 y 2021:
library(readxl)
Data_2017 <- read_excel("Base de datos combinada mod 2.xlsx", sheet = "2017-2018")
Data_2020 <- read_excel("Base de datos combinada mod 2.xlsx", sheet = "2020-2021")
Data_2021 <- read_excel("Base de datos combinada mod 2.xlsx", sheet = "2021-2022")I. Comenzamos la investigación con un análisis descriptivo univariado, utilizando las medidas de centralización para cada año:
# 2017
library(psych)
des_2017 <- describe(Data_2017)
des_2017## vars n mean sd median trimmed mad min max range skew
## Concentraciones* 1 61 31.00 17.75 31 31.00 22.24 1 61 60 0.00
## Facultades* 2 61 4.85 2.02 4 4.84 1.48 1 8 7 0.13
## Admitidos 3 61 39.72 34.44 28 34.06 17.79 0 182 182 2.12
## Matriculados 4 61 31.15 30.06 22 26.27 17.79 0 154 154 2.15
## Graduados 5 61 15.56 27.42 7 10.29 7.41 0 195 195 4.81
## Mujeres 6 61 19.61 18.29 16 16.41 13.34 0 96 96 1.83
## Hombres 7 61 11.95 13.64 8 9.49 8.90 0 78 78 2.59
## IMI 8 61 288.33 25.05 285 284.78 22.24 260 370 110 1.24
## Cupo 9 61 46.54 41.05 32 39.16 25.20 10 250 240 2.70
## Solicitantes 10 61 166.67 153.33 114 140.08 85.99 0 963 963 2.71
## kurtosis se
## Concentraciones* -1.26 2.27
## Facultades* -1.13 0.26
## Admitidos 5.32 4.41
## Matriculados 5.52 3.85
## Graduados 27.57 3.51
## Mujeres 3.91 2.34
## Hombres 8.62 1.75
## IMI 0.96 3.21
## Cupo 9.39 5.26
## Solicitantes 10.12 19.63# 2020
library(psych)
des_2020 <- describe(Data_2017)
des_2020## vars n mean sd median trimmed mad min max range skew
## Concentraciones* 1 61 31.00 17.75 31 31.00 22.24 1 61 60 0.00
## Facultades* 2 61 4.85 2.02 4 4.84 1.48 1 8 7 0.13
## Admitidos 3 61 39.72 34.44 28 34.06 17.79 0 182 182 2.12
## Matriculados 4 61 31.15 30.06 22 26.27 17.79 0 154 154 2.15
## Graduados 5 61 15.56 27.42 7 10.29 7.41 0 195 195 4.81
## Mujeres 6 61 19.61 18.29 16 16.41 13.34 0 96 96 1.83
## Hombres 7 61 11.95 13.64 8 9.49 8.90 0 78 78 2.59
## IMI 8 61 288.33 25.05 285 284.78 22.24 260 370 110 1.24
## Cupo 9 61 46.54 41.05 32 39.16 25.20 10 250 240 2.70
## Solicitantes 10 61 166.67 153.33 114 140.08 85.99 0 963 963 2.71
## kurtosis se
## Concentraciones* -1.26 2.27
## Facultades* -1.13 0.26
## Admitidos 5.32 4.41
## Matriculados 5.52 3.85
## Graduados 27.57 3.51
## Mujeres 3.91 2.34
## Hombres 8.62 1.75
## IMI 0.96 3.21
## Cupo 9.39 5.26
## Solicitantes 10.12 19.63# 2021
library(psych)
des_2021 <- describe(Data_2017)
des_2021## vars n mean sd median trimmed mad min max range skew
## Concentraciones* 1 61 31.00 17.75 31 31.00 22.24 1 61 60 0.00
## Facultades* 2 61 4.85 2.02 4 4.84 1.48 1 8 7 0.13
## Admitidos 3 61 39.72 34.44 28 34.06 17.79 0 182 182 2.12
## Matriculados 4 61 31.15 30.06 22 26.27 17.79 0 154 154 2.15
## Graduados 5 61 15.56 27.42 7 10.29 7.41 0 195 195 4.81
## Mujeres 6 61 19.61 18.29 16 16.41 13.34 0 96 96 1.83
## Hombres 7 61 11.95 13.64 8 9.49 8.90 0 78 78 2.59
## IMI 8 61 288.33 25.05 285 284.78 22.24 260 370 110 1.24
## Cupo 9 61 46.54 41.05 32 39.16 25.20 10 250 240 2.70
## Solicitantes 10 61 166.67 153.33 114 140.08 85.99 0 963 963 2.71
## kurtosis se
## Concentraciones* -1.26 2.27
## Facultades* -1.13 0.26
## Admitidos 5.32 4.41
## Matriculados 5.52 3.85
## Graduados 27.57 3.51
## Mujeres 3.91 2.34
## Hombres 8.62 1.75
## IMI 0.96 3.21
## Cupo 9.39 5.26
## Solicitantes 10.12 19.63# Medias:
medias_2017 <- colMeans(Data_2017[,3:10])
medias_2017## Admitidos Matriculados Graduados Mujeres Hombres IMI
## 39.72131 31.14754 15.55738 19.60656 11.95082 288.32787
## Cupo Solicitantes
## 46.54098 166.67213medias_2020 <- colMeans(Data_2020[,3:10])
medias_2020## Admitidos Matriculados Graduados Mujeres Hombres IMI
## 47.59016 36.37705 19.39344 22.49180 12.93443 254.18033
## Cupos Solicitantes
## 43.24590 153.47541medias_2021 <- colMeans(Data_2021[,3:10])
medias_2021## Admitidos Matriculados Graduados Mujeres Hombres IMI
## 40.90164 32.90164 20.14754 20.08197 12.16393 251.62295
## Cupos Solicitantes
## 45.93443 148.55738Medias <- cbind(medias_2017, medias_2020, medias_2021)
Medias## medias_2017 medias_2020 medias_2021
## Admitidos 39.72131 47.59016 40.90164
## Matriculados 31.14754 36.37705 32.90164
## Graduados 15.55738 19.39344 20.14754
## Mujeres 19.60656 22.49180 20.08197
## Hombres 11.95082 12.93443 12.16393
## IMI 288.32787 254.18033 251.62295
## Cupo 46.54098 43.24590 45.93443
## Solicitantes 166.67213 153.47541 148.55738# Varianzas:
varianzas_2017 <- apply(Data_2017[3:10], 2, var)
varianzas_2017## Admitidos Matriculados Graduados Mujeres Hombres IMI
## 1186.2710 903.3945 751.8508 334.6760 186.0142 627.4574
## Cupo Solicitantes
## 1685.0191 23508.8574varianzas_2020 <- apply(Data_2020[3:10], 2, var)
varianzas_2020## Admitidos Matriculados Graduados Mujeres Hombres IMI
## 2410.1459 1625.6721 526.1093 623.2208 347.4290 684.1503
## Cupos Solicitantes
## 1444.5219 32201.8536varianzas_2021 <- apply(Data_2021[3:10], 2, var)
varianzas_2021## Admitidos Matriculados Graduados Mujeres Hombres IMI
## 1934.1902 1299.1568 546.1279 506.7098 280.4727 631.6721
## Cupos Solicitantes
## 1596.0623 35578.0842Varianzas <- cbind(varianzas_2017,varianzas_2020,varianzas_2021)
Varianzas## varianzas_2017 varianzas_2020 varianzas_2021
## Admitidos 1186.2710 2410.1459 1934.1902
## Matriculados 903.3945 1625.6721 1299.1568
## Graduados 751.8508 526.1093 546.1279
## Mujeres 334.6760 623.2208 506.7098
## Hombres 186.0142 347.4290 280.4727
## IMI 627.4574 684.1503 631.6721
## Cupo 1685.0191 1444.5219 1596.0623
## Solicitantes 23508.8574 32201.8536 35578.0842# Medianas:
Medianas_2017 <- sapply(Data_2017[,3:10], median)
Medianas_2017## Admitidos Matriculados Graduados Mujeres Hombres IMI
## 28 22 7 16 8 285
## Cupo Solicitantes
## 32 114Medianas_2020 <- sapply(Data_2020[,3:10], median)
Medianas_2020## Admitidos Matriculados Graduados Mujeres Hombres IMI
## 29 23 12 11 6 245
## Cupos Solicitantes
## 35 77Medianas_2021 <- sapply(Data_2021[,3:10], median)
Medianas_2021## Admitidos Matriculados Graduados Mujeres Hombres IMI
## 23 19 13 13 6 240
## Cupos Solicitantes
## 35 80Medianas <- cbind(Medianas_2017, Medianas_2020, Medianas_2021)
Medianas## Medianas_2017 Medianas_2020 Medianas_2021
## Admitidos 28 29 23
## Matriculados 22 23 19
## Graduados 7 12 13
## Mujeres 16 11 13
## Hombres 8 6 6
## IMI 285 245 240
## Cupo 32 35 35
## Solicitantes 114 77 80Tras analizar los diferentes datos de los pasadas medidas de centralización, pudimos notar las siguientes observaciones:
La cantidad de mujeres respecto a los hombres con el transcurso de los años se ha mantenido igual mas o menos, siendo la cantidad de mujeres el doble que la cantidad de hombres.
Hemos notado que la cantidad de admitidos y matriculados a aumentado a traves de los años mientras que la cantidad de solicitantes ha disminuido significativamente, lo que refleja la necesidad de estudiantes dentro de la universidad.
La cantidad de graduados ha ido en aumento de una mediana de 7 estudiantes por concentración para el año académico de 2017 - 2018 a 11 estudiantes por concentración para el año académico de 2021 - 2022.
Podemos notar que para los años observados, las varianzas se mantienen bastante alta, lo que puede llegar a ser problematico para la investigacion, esto se debe a la diferencia de estudiantes por concentracion donde el minimo de matriculados es de cero y el maximo es de 154.
- Ahora procedemos a verificar si nuestros datos cumplen con el supuesto de normalidad:
Pruebas graficas y analiticas de normalidad para el año 2017:
#as.numeric(Data_2017[,3:10])
Data_2017<-as.data.frame(Data_2017)
class(Data_2017$Admitidos)## [1] "numeric"# Histogramas
par(mfrow = c(2,4))
hist(Data_2017$Admitidos, prob = TRUE, xlab=" ", main="Admitidos")
hist(Data_2017$Matriculados, prob = TRUE, xlab=" ", main="Matriculados")
hist(Data_2017$Graduados, prob = TRUE, xlab=" ", main="Graduados")
hist(Data_2017$Mujeres, prob = TRUE, xlab=" ", main="Mujeres")
hist(Data_2017$Hombres, prob = TRUE, xlab=" ", main="Hombres")
hist(Data_2017$IMI, prob = TRUE, xlab=" ", main="IMI")
hist(Data_2017$Cupo, prob = TRUE, xlab=" ", main="Cupos")
hist(Data_2017$Solicitantes, prob = TRUE, xlab=" ", main="Solicitantes")
par(mfrow = c(2, 4))
qqnorm(Data_2017$Admitidos, pch = 1, main = "Admitidos")
qqline(Data_2017$Admitidos, col = "blue", lwd = 2)
qqnorm(Data_2017$Matriculados, pch = 1, main= "Matriculados")
qqline(Data_2017$Matriculados, col = "blue", lwd = 2)
qqnorm(Data_2017$Graduados, pch = 1, main= "Graduados")
qqline(Data_2017$Graduados, col = "blue", lwd = 2)
qqnorm(Data_2017$Mujeres, pch = 1, main= "Mujeres")
qqline(Data_2017$Mujeres, col = "blue", lwd = 2)
qqnorm(Data_2017$Hombres, pch = 1, main= "Hombres")
qqline(Data_2017$Hombres, col = "blue", lwd = 2)
qqnorm(Data_2017$IMI, pch = 1, main= "IMI")
qqline(Data_2017$IMI, col = "blue", lwd = 2)
qqnorm(Data_2017$Cupo, pch = 1, main="Cupo")
qqline(Data_2017$Cupo, col = "blue", lwd = 2)
qqnorm(Data_2017$Solicitantes, pch = 1, main="Solicitantes")
qqline(Data_2017$Solicitantes, col = "blue", lwd = 2)
# Diagrama resumen y su correlaciCion
library(GGally)
ggpairs(Data_2017[,3:10]) 
# Pruebas de normalidad analitica univariadas:
# Cramer-Von Mises
library(MVN)
CVM <- mvn(Data_2017[,3:10], univariateTest = "CVM",desc=T)
CVM$univariateNormality## Test Variable Statistic p value Normality
## 1 Cramer-von Mises Admitidos 0.6884 <0.001 NO
## 2 Cramer-von Mises Matriculados 0.6079 <0.001 NO
## 3 Cramer-von Mises Graduados 1.6128 <0.001 NO
## 4 Cramer-von Mises Mujeres 0.5477 <0.001 NO
## 5 Cramer-von Mises Hombres 0.6575 <0.001 NO
## 6 Cramer-von Mises IMI 0.4871 <0.001 NO
## 7 Cramer-von Mises Cupo 0.7147 <0.001 NO
## 8 Cramer-von Mises Solicitantes 0.6838 <0.001 NO# Lilliefors (correccion de Kolmogorov)
L <- mvn(Data_2017[,3:10], univariateTest = "Lillie",desc=T)
L$univariateNormality## Test Variable Statistic p value Normality
## 1 Lilliefors (Kolmogorov-Smirnov) Admitidos 0.2217 <0.001 NO
## 2 Lilliefors (Kolmogorov-Smirnov) Matriculados 0.2073 <0.001 NO
## 3 Lilliefors (Kolmogorov-Smirnov) Graduados 0.2852 <0.001 NO
## 4 Lilliefors (Kolmogorov-Smirnov) Mujeres 0.1799 <0.001 NO
## 5 Lilliefors (Kolmogorov-Smirnov) Hombres 0.1904 <0.001 NO
## 6 Lilliefors (Kolmogorov-Smirnov) IMI 0.1952 <0.001 NO
## 7 Lilliefors (Kolmogorov-Smirnov) Cupo 0.1883 <0.001 NO
## 8 Lilliefors (Kolmogorov-Smirnov) Solicitantes 0.1936 <0.001 NO# Pruebas de normalidad analitica multivariadas:
# 1. Mardia
Mardia <- mvn(Data_2017[,3:10], mvnTest = "mardia")
Mardia$multivariateNormality## Test Statistic p value Result
## 1 Mardia Skewness 765.742892463967 1.12611731813041e-94 NO
## 2 Mardia Kurtosis 21.8886371248762 0 NO
## 3 MVN <NA> <NA> NO# 2. Henze-Zirkler
HZ <- mvn(Data_2017[,3:10], mvnTest = "hz")
HZ$multivariateNormality## Test HZ p value MVN
## 1 Henze-Zirkler 2.565781 0 NOConcluimos que los datos para el año 2017, no cumplen con el supuesto de normalidad.
Pruebas graficas y analiticas de normalidad para el año 2020:
# Pruebas graficas de normalidad
#as.numeric(Data_2020[,3:10])
Data_2020<-as.data.frame(Data_2020)
class(Data_2020$Admitidos)## [1] "numeric"# Histogramas
par(mfrow = c(2,4))
hist(Data_2020$Admitidos, prob = TRUE, xlab=" ", main="Admitidos")
hist(Data_2020$Matriculados, prob = TRUE, xlab=" ", main="Matriculados")
hist(Data_2020$Graduados, prob = TRUE, xlab=" ", main="Graduados")
hist(Data_2020$Mujeres, prob = TRUE, xlab=" ", main="Mujeres")
hist(Data_2020$Hombres, prob = TRUE, xlab=" ", main="Hombres")
hist(Data_2020$IMI, prob = TRUE, xlab=" ", main="IMI")
hist(Data_2020$Cupos, prob = TRUE, xlab=" ", main="Cupos")
hist(Data_2020$Solicitantes, prob = TRUE, xlab=" ", main="Solicitantes")
par(mfrow = c(2, 4))
qqnorm(Data_2020$Admitidos, pch = 1, main = "Admitidos")
qqline(Data_2020$Admitidos, col = "blue", lwd = 2)
qqnorm(Data_2020$Matriculados, pch = 1, main= "Matriculados")
qqline(Data_2020$Matriculados, col = "blue", lwd = 2)
qqnorm(Data_2020$Graduados, pch = 1, main= "Graduados")
qqline(Data_2020$Graduados, col = "blue", lwd = 2)
qqnorm(Data_2020$Mujeres, pch = 1, main= "Mujeres")
qqline(Data_2020$Mujeres, col = "blue", lwd = 2)
qqnorm(Data_2020$Hombres, pch = 1, main= "Hombres")
qqline(Data_2020$Hombres, col = "blue", lwd = 2)
qqnorm(Data_2020$IMI, pch = 1, main= "IMI")
qqline(Data_2020$IMI, col = "blue", lwd = 2)
qqnorm(Data_2020$Cupos, pch = 1, main="Cupo")
qqline(Data_2020$Cupos, col = "blue", lwd = 2)
qqnorm(Data_2020$Solicitantes, pch = 1, main="Solicitantes")
qqline(Data_2020$Solicitantes, col = "blue", lwd = 2)
# Diagrama resumen y su correlaciCion
library(GGally)
ggpairs(Data_2020[,3:10]) 
# Pruebas de normalidad analitica univariadas:
# Cramer-Von Mises
library(MVN)
CVM <- mvn(Data_2020[,3:10], univariateTest = "CVM",desc=T)
CVM$univariateNormality## Test Variable Statistic p value Normality
## 1 Cramer-von Mises Admitidos 0.4939 <0.001 NO
## 2 Cramer-von Mises Matriculados 0.6187 <0.001 NO
## 3 Cramer-von Mises Graduados 0.7484 <0.001 NO
## 4 Cramer-von Mises Mujeres 0.5942 <0.001 NO
## 5 Cramer-von Mises Hombres 0.9622 <0.001 NO
## 6 Cramer-von Mises IMI 0.5980 <0.001 NO
## 7 Cramer-von Mises Cupos 0.6856 <0.001 NO
## 8 Cramer-von Mises Solicitantes 0.6900 <0.001 NO# Lilliefors (correccion de Kolmogorov)
L <- mvn(Data_2020[,3:10], univariateTest = "Lillie",desc=T)
L$univariateNormality## Test Variable Statistic p value Normality
## 1 Lilliefors (Kolmogorov-Smirnov) Admitidos 0.1721 1e-04 NO
## 2 Lilliefors (Kolmogorov-Smirnov) Matriculados 0.1835 <0.001 NO
## 3 Lilliefors (Kolmogorov-Smirnov) Graduados 0.1989 <0.001 NO
## 4 Lilliefors (Kolmogorov-Smirnov) Mujeres 0.1936 <0.001 NO
## 5 Lilliefors (Kolmogorov-Smirnov) Hombres 0.2439 <0.001 NO
## 6 Lilliefors (Kolmogorov-Smirnov) IMI 0.1801 <0.001 NO
## 7 Lilliefors (Kolmogorov-Smirnov) Cupos 0.1909 <0.001 NO
## 8 Lilliefors (Kolmogorov-Smirnov) Solicitantes 0.1962 <0.001 NO# Pruebas de normalidad analitica multivariadas:
# 1. Mardia
Mardia <- mvn(Data_2020[,3:10], mvnTest = "mardia")
Mardia$multivariateNormality## Test Statistic p value Result
## 1 Mardia Skewness 891.191387862587 4.86695214507032e-118 NO
## 2 Mardia Kurtosis 29.4127312217153 0 NO
## 3 MVN <NA> <NA> NO# 2. Henze-Zirkler
HZ <- mvn(Data_2020[,3:10], mvnTest = "hz")
HZ$multivariateNormality## Test HZ p value MVN
## 1 Henze-Zirkler 4.358133 0 NOConcluimos que los datos para el año 2020, no cumplen con el supuesto de normalidad.
Pruebas graficas y analiticas de normalidad para el año 2021:
# Pruebas graficas de normalidad
#as.numeric(Data_2021[,3:10])
Data_2021<- as.data.frame(Data_2021)
class(Data_2021$Admitidos)## [1] "numeric"# Histogramas
par(mfrow = c(2,4))
hist(Data_2021$Admitidos, prob = TRUE, xlab=" ", main="Admitidos")
hist(Data_2021$Matriculados, prob = TRUE, xlab=" ", main="Matriculados")
hist(Data_2021$Graduados, prob = TRUE, xlab=" ", main="Graduados")
hist(Data_2021$Mujeres, prob = TRUE, xlab=" ", main="Mujeres")
hist(Data_2021$Hombres, prob = TRUE, xlab=" ", main="Hombres")
hist(Data_2021$IMI, prob = TRUE, xlab=" ", main="IMI")
hist(Data_2021$Cupos, prob = TRUE, xlab=" ", main="Cupos")
hist(Data_2021$Solicitantes, prob = TRUE, xlab=" ", main="Solicitantes")
par(mfrow = c(2, 4))
qqnorm(Data_2021$Admitidos, pch = 1, main = "Admitidos")
qqline(Data_2021$Admitidos, col = "blue", lwd = 2)
qqnorm(Data_2021$Matriculados, pch = 1, main= "Matriculados")
qqline(Data_2021$Matriculados, col = "blue", lwd = 2)
qqnorm(Data_2021$Graduados, pch = 1, main= "Graduados")
qqline(Data_2021$Graduados, col = "blue", lwd = 2)
qqnorm(Data_2021$Mujeres, pch = 1, main= "Mujeres")
qqline(Data_2021$Mujeres, col = "blue", lwd = 2)
qqnorm(Data_2021$Hombres, pch = 1, main= "Hombres")
qqline(Data_2021$Hombres, col = "blue", lwd = 2)
qqnorm(Data_2021$IMI, pch = 1, main= "IMI")
qqline(Data_2021$IMI, col = "blue", lwd = 2)
qqnorm(Data_2021$Cupos, pch = 1, main="Cupo")
qqline(Data_2021$Cupos, col = "blue", lwd = 2)
qqnorm(Data_2021$Solicitantes, pch = 1, main="Solicitantes")
qqline(Data_2021$Solicitantes, col = "blue", lwd = 2)
# Diagrama resumen y su correlaciCion
library(GGally)
ggpairs(Data_2021[,3:10]) 
# Pruebas de normalidad analitica univariadas:
# Cramer-Von Mises
library(MVN)
CVM <- mvn(Data_2021[,3:10], univariateTest = "CVM",desc=T)
CVM$univariateNormality## Test Variable Statistic p value Normality
## 1 Cramer-von Mises Admitidos 0.4608 <0.001 NO
## 2 Cramer-von Mises Matriculados 0.5242 <0.001 NO
## 3 Cramer-von Mises Graduados 0.6845 <0.001 NO
## 4 Cramer-von Mises Mujeres 0.5297 <0.001 NO
## 5 Cramer-von Mises Hombres 1.0026 <0.001 NO
## 6 Cramer-von Mises IMI 0.6736 <0.001 NO
## 7 Cramer-von Mises Cupos 0.6056 <0.001 NO
## 8 Cramer-von Mises Solicitantes 0.7067 <0.001 NO# Lilliefors (correccion de Kolmogorov)
L <- mvn(Data_2021[,3:10], univariateTest = "Lillie",desc=T)
L$univariateNormality## Test Variable Statistic p value Normality
## 1 Lilliefors (Kolmogorov-Smirnov) Admitidos 0.1762 1e-04 NO
## 2 Lilliefors (Kolmogorov-Smirnov) Matriculados 0.1911 <0.001 NO
## 3 Lilliefors (Kolmogorov-Smirnov) Graduados 0.1943 <0.001 NO
## 4 Lilliefors (Kolmogorov-Smirnov) Mujeres 0.1862 <0.001 NO
## 5 Lilliefors (Kolmogorov-Smirnov) Hombres 0.2471 <0.001 NO
## 6 Lilliefors (Kolmogorov-Smirnov) IMI 0.2229 <0.001 NO
## 7 Lilliefors (Kolmogorov-Smirnov) Cupos 0.1984 <0.001 NO
## 8 Lilliefors (Kolmogorov-Smirnov) Solicitantes 0.2155 <0.001 NO# Pruebas de normalidad analitica multivariadas:
# 1. Mardia
Mardia <- mvn(Data_2021[,3:10], mvnTest = "mardia")
Mardia$multivariateNormality## Test Statistic p value Result
## 1 Mardia Skewness 956.154327134556 2.39410506864787e-130 NO
## 2 Mardia Kurtosis 27.3902221715369 0 NO
## 3 MVN <NA> <NA> NO# 2. Henze-Zirkler
HZ <- mvn(Data_2021[,3:10], mvnTest = "hz")
HZ$multivariateNormality## Test HZ p value MVN
## 1 Henze-Zirkler 4.453746 0 NOConcluimos que los datos para el año 2021, no cumplen con el supuesto de normalidad.
- Debido a que los datos para ninguno de los años cumplen con el supuesto de normalidad, pasamos a hacer las respectivas transformaciones de normalidad:
Transformaciones para el año 2017:
# Transformacion de variable "admitidos":
library(bestNormalize)
Adm_bt <- bestNormalize(Data_2017$Admitidos)
Adm_bt## Best Normalizing transformation with 61 Observations
## Estimated Normality Statistics (Pearson P / df, lower => more normal):
## - arcsinh(x): 1.4286
## - Center+scale: 2.0881
## - Double Reversed Log_b(x+a): 2.1798
## - Exp(x): 4.0443
## - Log_b(x+a): 1.4914
## - orderNorm (ORQ): 1.2595
## - sqrt(x + a): 1.4881
## - Yeo-Johnson: 1.5905
## Estimation method: Out-of-sample via CV with 10 folds and 5 repeats
##
## Based off these, bestNormalize chose:
## orderNorm Transformation with 61 nonmissing obs and ties
## - 43 unique values
## - Original quantiles:
## 0% 25% 50% 75% 100%
## 0 20 28 55 182# Transformacion "Ordernorm":
Adm_ot <- orderNorm(Data_2017$Admitidos)
Adm_ot## orderNorm Transformation with 61 nonmissing obs and ties
## - 43 unique values
## - Original quantiles:
## 0% 25% 50% 75% 100%
## 0 20 28 55 182#Transformacion de variable "matriculados":
library(bestNormalize)
Mat_bt <- bestNormalize(Data_2017$Matriculados)
Mat_bt## Best Normalizing transformation with 61 Observations
## Estimated Normality Statistics (Pearson P / df, lower => more normal):
## - arcsinh(x): 1.8595
## - Center+scale: 2.2929
## - Double Reversed Log_b(x+a): 2.6381
## - Exp(x): 4.0995
## - Log_b(x+a): 1.8938
## - orderNorm (ORQ): 1.4452
## - sqrt(x + a): 1.5095
## - Yeo-Johnson: 1.469
## Estimation method: Out-of-sample via CV with 10 folds and 5 repeats
##
## Based off these, bestNormalize chose:
## orderNorm Transformation with 61 nonmissing obs and ties
## - 39 unique values
## - Original quantiles:
## 0% 25% 50% 75% 100%
## 0 14 22 42 154# Transformacion "Ordernorm":
Mat_ot <- orderNorm(Data_2017$Matriculados)
Mat_ot## orderNorm Transformation with 61 nonmissing obs and ties
## - 39 unique values
## - Original quantiles:
## 0% 25% 50% 75% 100%
## 0 14 22 42 154# Transformacion de variable "graduados":
library(bestNormalize)
Grad_bt <- bestNormalize(Data_2017$Graduados)
Grad_bt## Best Normalizing transformation with 61 Observations
## Estimated Normality Statistics (Pearson P / df, lower => more normal):
## - arcsinh(x): 1.2738
## - Center+scale: 2.2262
## - Double Reversed Log_b(x+a): 2.195
## - Exp(x): 3.5333
## - Log_b(x+a): 2.4119
## - orderNorm (ORQ): 1.5857
## - sqrt(x + a): 1.5595
## - Yeo-Johnson: 1.3571
## Estimation method: Out-of-sample via CV with 10 folds and 5 repeats
##
## Based off these, bestNormalize chose:
## Standardized asinh(x) Transformation with 61 nonmissing obs.:
## Relevant statistics:
## - mean (before standardization) = 2.675995
## - sd (before standardization) = 1.302836# Transformacion "Yeo-Johnson":
Grad_yj <- yeojohnson(Data_2017$Graduados)
Grad_yj## Standardized Yeo-Johnson Transformation with 61 nonmissing obs.:
## Estimated statistics:
## - lambda = 0.003593999
## - mean (before standardization) = 2.179118
## - sd (before standardization) = 1.133657# Transformacion de variable "Mujeres":
library(bestNormalize)
Muj_bt <- bestNormalize(Data_2017$Mujeres)
Muj_bt## Best Normalizing transformation with 61 Observations
## Estimated Normality Statistics (Pearson P / df, lower => more normal):
## - arcsinh(x): 1.5333
## - Center+scale: 1.6833
## - Double Reversed Log_b(x+a): 1.9803
## - Exp(x): 5.2319
## - Log_b(x+a): 1.7271
## - orderNorm (ORQ): 1.3952
## - sqrt(x + a): 1.3
## - Yeo-Johnson: 1.3143
## Estimation method: Out-of-sample via CV with 10 folds and 5 repeats
##
## Based off these, bestNormalize chose:
## Standardized sqrt(x + a) Transformation with 61 nonmissing obs.:
## Relevant statistics:
## - a = 0
## - mean (before standardization) = 4.002264
## - sd (before standardization) = 1.91004# Transformacion "sqrt_x"
Muj_st <- sqrt_x(Data_2017$Mujeres, a = 0, standardize = TRUE)
Muj_st## Standardized sqrt(x + a) Transformation with 61 nonmissing obs.:
## Relevant statistics:
## - a = 0
## - mean (before standardization) = 4.002264
## - sd (before standardization) = 1.91004# Transformacion de variable "Hombres":
library(bestNormalize)
Hom_bt <- bestNormalize(Data_2017$Hombres)
Hom_bt## Best Normalizing transformation with 61 Observations
## Estimated Normality Statistics (Pearson P / df, lower => more normal):
## - arcsinh(x): 1.2476
## - Center+scale: 1.8643
## - Double Reversed Log_b(x+a): 1.751
## - Exp(x): 3.9476
## - Log_b(x+a): 2.1143
## - orderNorm (ORQ): 1.3595
## - sqrt(x + a): 1.3548
## - Yeo-Johnson: 1.1476
## Estimation method: Out-of-sample via CV with 10 folds and 5 repeats
##
## Based off these, bestNormalize chose:
## Standardized Yeo-Johnson Transformation with 61 nonmissing obs.:
## Estimated statistics:
## - lambda = 0.1357587
## - mean (before standardization) = 2.518721
## - sd (before standardization) = 1.363815# Transformacion "sqrt_x":
Hom_sqrt <- sqrt_x(Data_2017$Hombres, a = 0, standardize = TRUE)
Hom_sqrt## Standardized sqrt(x + a) Transformation with 61 nonmissing obs.:
## Relevant statistics:
## - a = 0
## - mean (before standardization) = 2.975908
## - sd (before standardization) = 1.773802# Transformacion de variable "IMI":
library(bestNormalize)
IMI_bt <- bestNormalize(Data_2017$IMI)
IMI_bt## Best Normalizing transformation with 61 Observations
## Estimated Normality Statistics (Pearson P / df, lower => more normal):
## - arcsinh(x): 1.8548
## - Box-Cox: 1.7595
## - Center+scale: 1.8048
## - Double Reversed Log_b(x+a): 2.1562
## - Exp(x): 3.561
## - Log_b(x+a): 1.8548
## - orderNorm (ORQ): 1.4929
## - sqrt(x + a): 1.8214
## - Yeo-Johnson: 1.619
## Estimation method: Out-of-sample via CV with 10 folds and 5 repeats
##
## Based off these, bestNormalize chose:
## orderNorm Transformation with 61 nonmissing obs and ties
## - 24 unique values
## - Original quantiles:
## 0% 25% 50% 75% 100%
## 260 270 285 295 370# Transformacion "Yeo-Johnson":
IMI_yj <- yeojohnson(Data_2017$IMI)
IMI_yj## Standardized Yeo-Johnson Transformation with 61 nonmissing obs.:
## Estimated statistics:
## - lambda = -4.976528
## - mean (before standardization) = 0.2009433
## - sd (before standardization) = 4.16551e-14# Transformacion de variable "Cupo":
library(bestNormalize)
Cup_bt <- bestNormalize(Data_2017$Cupo)
Cup_bt## Best Normalizing transformation with 61 Observations
## Estimated Normality Statistics (Pearson P / df, lower => more normal):
## - arcsinh(x): 1.1452
## - Box-Cox: 1.2119
## - Center+scale: 1.95
## - Double Reversed Log_b(x+a): 1.6985
## - Exp(x): 3.561
## - Log_b(x+a): 1.1452
## - orderNorm (ORQ): 1.6214
## - sqrt(x + a): 1.45
## - Yeo-Johnson: 1.2119
## Estimation method: Out-of-sample via CV with 10 folds and 5 repeats
##
## Based off these, bestNormalize chose:
## Standardized asinh(x) Transformation with 61 nonmissing obs.:
## Relevant statistics:
## - mean (before standardization) = 4.272635
## - sd (before standardization) = 0.6972036# Transformacion "arcsinh(x)":
Cup_at <- arcsinh_x(Data_2017$Cupo)
Cup_at## Standardized asinh(x) Transformation with 61 nonmissing obs.:
## Relevant statistics:
## - mean (before standardization) = 4.272635
## - sd (before standardization) = 0.6972036# Transformacion de variable "solicitantes":
library(bestNormalize)
Sol_bt <- bestNormalize(Data_2017$Solicitantes)
Sol_bt## Best Normalizing transformation with 61 Observations
## Estimated Normality Statistics (Pearson P / df, lower => more normal):
## - arcsinh(x): 1.4762
## - Center+scale: 2.181
## - Double Reversed Log_b(x+a): 2.2385
## - Log_b(x+a): 1.4662
## - orderNorm (ORQ): 1.7714
## - sqrt(x + a): 1.6286
## - Yeo-Johnson: 1.6429
## Estimation method: Out-of-sample via CV with 10 folds and 5 repeats
##
## Based off these, bestNormalize chose:
## Standardized Log_b(x + a) Transformation with 61 nonmissing obs.:
## Relevant statistics:
## - a = 0.001
## - b = 10
## - mean (before standardization) = 2.019464
## - sd (before standardization) = 0.7306734# Transformacion "log_x":
Sol_lt <- log_x(Data_2017$Solicitantes)
Sol_lt## Standardized Log_b(x + a) Transformation with 61 nonmissing obs.:
## Relevant statistics:
## - a = 0.001
## - b = 10
## - mean (before standardization) = 2.019464
## - sd (before standardization) = 0.7306734Creamos un dataframe con los datos obtenidos:
nombres_columnas <- c("Admitidos", "Matriculados", "Graduados", "Mujeres", "Hombres", "IMI", "Cup", "Sol") # Cambiado "Hom_yj" por "Hombres" por claridad
valores_columnas <- c(Adm_ot$x.t, Mat_ot$x.t, Grad_yj$x.t, Muj_st$x.t, Hom_sqrt$x.t, IMI_yj$x.t, Cup_at$x.t, Sol_lt$x.t)
DN <- data.frame(matrix(valores_columnas, ncol = length(nombres_columnas), byrow = FALSE))
colnames(DN) <- nombres_columnas
head(DN)## Admitidos Matriculados Graduados Mujeres Hombres IMI
## 1 0.88334633 0.9457771 1.2592671 0.5742059 1.25168694 1.3499618
## 2 0.04110384 -0.2279667 1.1815315 0.1258493 -0.88042181 -0.7249548
## 3 0.33489417 0.3786901 0.6406864 0.1258493 0.10506814 -0.7249548
## 4 0.18598182 -0.1029120 0.9686607 -0.2076984 -0.08314369 -0.7929193
## 5 1.08327016 1.0121310 0.5897457 0.7240171 1.14110390 -0.4657568
## 6 0.24910613 -1.5771801 -0.6962992 -1.5718331 -1.11393917 -0.4657568
## Cup Sol
## 1 0.1925306 0.2063861
## 2 0.4770991 0.2063861
## 3 0.5054965 0.3548672
## 4 0.4770991 0.3357948
## 5 1.2380861 0.8485647
## 6 -0.5166527 -0.1819793library(GGally)
ggpairs(DN) 
Hacemos las pruebas de normalidad graficas y analiticas con la nueva base de datos:
# Histogramas
par(mfrow = c(2,4))
hist(DN$Admitidos, prob = TRUE, xlab=" ", main="Admitidos")
hist(DN$Matriculados, prob = TRUE, xlab=" ", main="Matriculados")
hist(DN$Graduados, prob = TRUE, xlab=" ", main="Graduados")
hist(DN$Mujeres, prob = TRUE, xlab=" ", main="Mujeres")
hist(DN$Hombres, prob = TRUE, xlab=" ", main="Hombres")
hist(DN$IMI, prob = TRUE, xlab=" ", main="IMI")
hist(DN$Cup, prob = TRUE, xlab=" ", main="Cupo")
hist(DN$Sol, prob = TRUE, xlab=" ", main="Solicitantes")
par(mfrow = c(2, 4))
qqnorm(DN$Admitidos, pch = 1, main = "Admitidos")
qqline(DN$Admitidos, col = "blue", lwd = 2)
qqnorm(DN$Matriculados, pch = 1, main= "Matriculados")
qqline(DN$Matriculados, col = "blue", lwd = 2)
qqnorm(DN$Graduados, pch = 1, main= "Graduados")
qqline(DN$Graduados, col = "blue", lwd = 2)
qqnorm(DN$Mujeres, pch = 1, main= "Mujeres")
qqline(DN$Mujeres, col = "blue", lwd = 2)
qqnorm(DN$Hombres, pch = 1, main= "Hombres")
qqline(DN$Hombres, col = "blue", lwd = 2)
qqnorm(DN$IMI, pch = 1, main= "IMI")
qqline(DN$IMI, col = "blue", lwd = 2)
qqnorm(DN$Cup, pch = 1, main="Cup")
qqline(DN$Cup, col = "blue", lwd = 2)
qqnorm(DN$Sol, pch = 1, main="Solicitantes")
qqline(DN$Sol, col = "blue", lwd = 2)
# Pruebas de normalidad analiticas univariadas:
# Cramer-Von Mises
dn<-DN[,-6]
library(MVN)
CVM_N <- mvn(dn[,-7], univariateTest = "CVM",desc=T)
CVM_N$univariateNormality## Test Variable Statistic p value Normality
## 1 Cramer-von Mises Admitidos 0.0043 1.0000 YES
## 2 Cramer-von Mises Matriculados 0.0066 0.9999 YES
## 3 Cramer-von Mises Graduados 0.0809 0.1978 YES
## 4 Cramer-von Mises Mujeres 0.0873 0.1631 YES
## 5 Cramer-von Mises Hombres 0.0623 0.3470 YES
## 6 Cramer-von Mises Cup 0.0990 0.1133 YES# Lilliefors (correccion de Kolmogorov)
dn<-DN[,-6]
L <- mvn(dn[,-7], univariateTest = "Lillie",desc=T)
L$univariateNormality## Test Variable Statistic p value Normality
## 1 Lilliefors (Kolmogorov-Smirnov) Admitidos 0.0249 1.0000 YES
## 2 Lilliefors (Kolmogorov-Smirnov) Matriculados 0.0333 1.0000 YES
## 3 Lilliefors (Kolmogorov-Smirnov) Graduados 0.1124 0.0534 YES
## 4 Lilliefors (Kolmogorov-Smirnov) Mujeres 0.0914 0.2336 YES
## 5 Lilliefors (Kolmogorov-Smirnov) Hombres 0.0811 0.4081 YES
## 6 Lilliefors (Kolmogorov-Smirnov) Cup 0.1071 0.0788 YES# Pruebas de normalidad analitica multivariadas:
dn<-DN[,-6]
dn1<-dn[,-7]
Royston <- mvn(dn1[,-3], mvnTest = "royston")
Royston$multivariateNormality## Test H p value MVN
## 1 Royston 7.504824 0.1181639 YESPodemos concluir que los datos para el año 2017 ahora si cumplen con el supuesto de normalidad.
Transformaciones para el año 2020:
# Transformacion de variable "admitidos":
library(bestNormalize)
Adm_bt_2 <- bestNormalize(Data_2020$Admitidos)
Adm_bt_2## Best Normalizing transformation with 61 Observations
## Estimated Normality Statistics (Pearson P / df, lower => more normal):
## - arcsinh(x): 1.219
## - Center+scale: 1.9881
## - Double Reversed Log_b(x+a): 2.345
## - Exp(x): 3.561
## - Log_b(x+a): 1.7524
## - orderNorm (ORQ): 1.2524
## - sqrt(x + a): 1.4452
## - Yeo-Johnson: 1.3024
## Estimation method: Out-of-sample via CV with 10 folds and 5 repeats
##
## Based off these, bestNormalize chose:
## Standardized asinh(x) Transformation with 61 nonmissing obs.:
## Relevant statistics:
## - mean (before standardization) = 3.999744
## - sd (before standardization) = 1.250519# Transformacion "Ordernorm":
Adm_ot_2 <- orderNorm(Data_2020$Admitidos)
Adm_ot_2## orderNorm Transformation with 61 nonmissing obs and ties
## - 47 unique values
## - Original quantiles:
## 0% 25% 50% 75% 100%
## 0 14 29 80 281#Transformacion de variable "matriculados":
library(bestNormalize)
Mat_bt_2 <- bestNormalize(Data_2020$Matriculados)
Mat_bt_2## Best Normalizing transformation with 61 Observations
## Estimated Normality Statistics (Pearson P / df, lower => more normal):
## - arcsinh(x): 1.3405
## - Center+scale: 2.1881
## - Double Reversed Log_b(x+a): 2.1475
## - Exp(x): 3.5333
## - Log_b(x+a): 1.4938
## - orderNorm (ORQ): 1.1143
## - sqrt(x + a): 1.3976
## - Yeo-Johnson: 1.331
## Estimation method: Out-of-sample via CV with 10 folds and 5 repeats
##
## Based off these, bestNormalize chose:
## orderNorm Transformation with 61 nonmissing obs and ties
## - 46 unique values
## - Original quantiles:
## 0% 25% 50% 75% 100%
## 0 10 23 54 232# Transformacion "arcsinh_x":
Mat_at_2 <- arcsinh_x(Data_2020$Matriculados)
Mat_at_2## Standardized asinh(x) Transformation with 61 nonmissing obs.:
## Relevant statistics:
## - mean (before standardization) = 3.725463
## - sd (before standardization) = 1.191811# Transformacion de variable "graduados":
library(bestNormalize)
Grad_bt_2 <- bestNormalize(Data_2020$Graduados)
Grad_bt_2## Best Normalizing transformation with 61 Observations
## Estimated Normality Statistics (Pearson P / df, lower => more normal):
## - arcsinh(x): 1.3214
## - Center+scale: 1.9929
## - Double Reversed Log_b(x+a): 2.0909
## - Exp(x): 3.9476
## - Log_b(x+a): 1.8333
## - orderNorm (ORQ): 1.4738
## - sqrt(x + a): 1.2238
## - Yeo-Johnson: 1.2762
## Estimation method: Out-of-sample via CV with 10 folds and 5 repeats
##
## Based off these, bestNormalize chose:
## Standardized sqrt(x + a) Transformation with 61 nonmissing obs.:
## Relevant statistics:
## - a = 0
## - mean (before standardization) = 3.791013
## - sd (before standardization) = 2.259503# Transformacion "arcsinh_x":
Grad_at_2 <- arcsinh_x(Data_2020$Graduados)
Grad_at_2## Standardized asinh(x) Transformation with 61 nonmissing obs.:
## Relevant statistics:
## - mean (before standardization) = 3.037882
## - sd (before standardization) = 1.246508# Transformacion de variable "Mujeres":
library(bestNormalize)
Muj_bt_2 <- bestNormalize(Data_2020$Mujeres)
Muj_bt_2## Best Normalizing transformation with 61 Observations
## Estimated Normality Statistics (Pearson P / df, lower => more normal):
## - arcsinh(x): 1.1857
## - Center+scale: 2.15
## - Double Reversed Log_b(x+a): 2.2877
## - Exp(x): 3.5333
## - Log_b(x+a): 1.8286
## - orderNorm (ORQ): 1.3714
## - sqrt(x + a): 1.3643
## - Yeo-Johnson: 1.0833
## Estimation method: Out-of-sample via CV with 10 folds and 5 repeats
##
## Based off these, bestNormalize chose:
## Standardized Yeo-Johnson Transformation with 61 nonmissing obs.:
## Estimated statistics:
## - lambda = 0.1528831
## - mean (before standardization) = 3.356676
## - sd (before standardization) = 1.687737# Transformacion "Yeo-Johnson":
Muj_yj_2 <- yeojohnson(Data_2020$Mujeres)
Muj_yj_2## Standardized Yeo-Johnson Transformation with 61 nonmissing obs.:
## Estimated statistics:
## - lambda = 0.1528831
## - mean (before standardization) = 3.356676
## - sd (before standardization) = 1.687737# Transformacion variable "Hombres":
library(bestNormalize)
Hom_bt_2 <- bestNormalize(Data_2020$Hombres)
Hom_bt_2## Best Normalizing transformation with 61 Observations
## Estimated Normality Statistics (Pearson P / df, lower => more normal):
## - arcsinh(x): 1.2738
## - Center+scale: 2.4143
## - Double Reversed Log_b(x+a): 2.5696
## - Exp(x): 4.0443
## - Log_b(x+a): 2.6881
## - orderNorm (ORQ): 1.4452
## - sqrt(x + a): 1.4619
## - Yeo-Johnson: 1.3429
## Estimation method: Out-of-sample via CV with 10 folds and 5 repeats
##
## Based off these, bestNormalize chose:
## Standardized asinh(x) Transformation with 61 nonmissing obs.:
## Relevant statistics:
## - mean (before standardization) = 2.407644
## - sd (before standardization) = 1.456547# Transformacion "Yeo-Johnson":
Hom_yj_2 <- yeojohnson(Data_2020$Hombres)
Hom_yj_2## Standardized Yeo-Johnson Transformation with 61 nonmissing obs.:
## Estimated statistics:
## - lambda = 0.02700875
## - mean (before standardization) = 2.026026
## - sd (before standardization) = 1.300386# Transformacion variable "IMI":
library(bestNormalize)
IMI_bt_2 <- bestNormalize(Data_2020$IMI)
IMI_bt_2## Best Normalizing transformation with 61 Observations
## Estimated Normality Statistics (Pearson P / df, lower => more normal):
## - arcsinh(x): 2.0667
## - Box-Cox: 1.9381
## - Center+scale: 2.2833
## - Double Reversed Log_b(x+a): 3.4524
## - Exp(x): 5.9362
## - Log_b(x+a): 2.0667
## - orderNorm (ORQ): 1.481
## - sqrt(x + a): 2.2
## - Yeo-Johnson: 1.6429
## Estimation method: Out-of-sample via CV with 10 folds and 5 repeats
##
## Based off these, bestNormalize chose:
## orderNorm Transformation with 61 nonmissing obs and ties
## - 32 unique values
## - Original quantiles:
## 0% 25% 50% 75% 100%
## 230 235 245 266 325# Transformacion "Ordernorm":
IMI_ot_2 <- orderNorm(Data_2020$IMI)
IMI_ot_2## orderNorm Transformation with 61 nonmissing obs and ties
## - 32 unique values
## - Original quantiles:
## 0% 25% 50% 75% 100%
## 230 235 245 266 325# Transformacion variable Cupo:
library(bestNormalize)
Cup_bt_2 <- bestNormalize(Data_2020$Cupos)
Cup_bt_2## Best Normalizing transformation with 61 Observations
## Estimated Normality Statistics (Pearson P / df, lower => more normal):
## - arcsinh(x): 1.9214
## - Box-Cox: 2.0714
## - Center+scale: 2.6143
## - Double Reversed Log_b(x+a): 2.4948
## - Exp(x): 3.561
## - Log_b(x+a): 1.9214
## - orderNorm (ORQ): 1.8762
## - sqrt(x + a): 2.331
## - Yeo-Johnson: 2.0714
## Estimation method: Out-of-sample via CV with 10 folds and 5 repeats
##
## Based off these, bestNormalize chose:
## orderNorm Transformation with 61 nonmissing obs and ties
## - 18 unique values
## - Original quantiles:
## 0% 25% 50% 75% 100%
## 10 20 35 60 250# Transformacion "Yeo-Johnson":
Cup_yj_2 <- yeojohnson(Data_2020$Cupos)
Cup_yj_2## Standardized Yeo-Johnson Transformation with 61 nonmissing obs.:
## Estimated statistics:
## - lambda = -0.277511
## - mean (before standardization) = 2.237168
## - sd (before standardization) = 0.2421181# Transformacion variable solicitantes:
library(bestNormalize)
Sol_bt_2 <- bestNormalize(Data_2020$Solicitantes)
Sol_bt_2## Best Normalizing transformation with 61 Observations
## Estimated Normality Statistics (Pearson P / df, lower => more normal):
## - arcsinh(x): 1.6381
## - Center+scale: 2.5905
## - Double Reversed Log_b(x+a): 2.6733
## - Log_b(x+a): 2.1381
## - orderNorm (ORQ): 1.6619
## - sqrt(x + a): 1.6143
## - Yeo-Johnson: 1.4905
## Estimation method: Out-of-sample via CV with 10 folds and 5 repeats
##
## Based off these, bestNormalize chose:
## Standardized Yeo-Johnson Transformation with 61 nonmissing obs.:
## Estimated statistics:
## - lambda = 0.2197647
## - mean (before standardization) = 7.946782
## - sd (before standardization) = 3.195414# Transformacion "sqrt_x":
Sol_st_2 <- sqrt_x(Data_2020$Solicitantes, a = 0, standardize = TRUE)
Sol_st_2## Standardized sqrt(x + a) Transformation with 61 nonmissing obs.:
## Relevant statistics:
## - a = 0
## - mean (before standardization) = 10.79765
## - sd (before standardization) = 6.123796Creamos un dataframe con los datos obtenidos:
nombres_columnas <- c("Admitidos", "Matriculados", "Graduados", "Mujeres", "Hombres", "IMI", "Cup", "Sol") # Cambiado "Hom_yj" por "Hombres" por claridad
valores_columnas <- c(Adm_ot_2$x.t, Mat_at_2$x.t, Grad_at_2$x.t, Muj_yj_2$x.t, Hom_yj_2$x.t, IMI_ot_2$x.t, Cup_yj_2$x.t, Sol_st_2$x.t)
DN_2 <- data.frame(matrix(valores_columnas, ncol = length(nombres_columnas), byrow = FALSE))
colnames(DN_2) <- nombres_columnaslibrary(GGally)
ggpairs(DN_2)
Hacemos las pruebas de normalidad graficas y analiticas con la nueva base de datos:
par(mfrow = c(2,4))
hist(DN_2$Admitidos, prob = TRUE, xlab=" ", main="Admitidos")
hist(DN_2$Matriculados, prob = TRUE, xlab=" ", main="Matriculados")
hist(DN_2$Graduados, prob = TRUE, xlab=" ", main="Graduados")
hist(DN_2$Mujeres, prob = TRUE, xlab=" ", main="Mujeres")
hist(DN_2$Hombres, prob = TRUE, xlab=" ", main="Hombres")
hist(DN_2$IMI, prob = TRUE, xlab=" ", main="IMI")
hist(DN_2$Cup, prob = TRUE, xlab=" ", main="Cupo")
hist(DN_2$Sol, prob = TRUE, xlab=" ", main="Solicitantes")
par(mfrow = c(2, 4))
qqnorm(DN_2$Admitidos, pch = 1, main = "Admitidos")
qqline(DN_2$Admitidos, col = "blue", lwd = 2)
qqnorm(DN_2$Matriculados, pch = 1, main= "Matriculados")
qqline(DN_2$Matriculados, col = "blue", lwd = 2)
qqnorm(DN_2$Graduados, pch = 1, main= "Graduados")
qqline(DN_2$Graduados, col = "blue", lwd = 2)
qqnorm(DN_2$Mujeres, pch = 1, main= "Mujeres")
qqline(DN_2$Mujeres, col = "blue", lwd = 2)
qqnorm(DN_2$Hombres, pch = 1, main= "Hombres")
qqline(DN_2$Hombres, col = "blue", lwd = 2)
qqnorm(DN_2$IMI, pch = 1, main= "IMI")
qqline(DN_2$IMI, col = "blue", lwd = 2)
qqnorm(DN_2$Cup, pch = 1, main="Cup")
qqline(DN_2$Cup, col = "blue", lwd = 2)
qqnorm(DN_2$Sol, pch = 1, main="Solicitantes")
qqline(DN_2$Sol, col = "blue", lwd = 2)
# Cramer-Von Mises
library(MVN)
CVM_N <- mvn(DN_2[,-7:-8], univariateTest = "CVM",desc=T)
CVM_N$univariateNormality## Test Variable Statistic p value Normality
## 1 Cramer-von Mises Admitidos 0.0039 1.0000 YES
## 2 Cramer-von Mises Matriculados 0.0798 0.2044 YES
## 3 Cramer-von Mises Graduados 0.0643 0.3264 YES
## 4 Cramer-von Mises Mujeres 0.0615 0.3563 YES
## 5 Cramer-von Mises Hombres 0.0673 0.2980 YES
## 6 Cramer-von Mises IMI 0.0373 0.7267 YES# Lilliefors (correccion de Kolmogorov)
L <- mvn(DN_2[,-7:-8], univariateTest = "Lillie",desc=T)
L$univariateNormality## Test Variable Statistic p value Normality
## 1 Lilliefors (Kolmogorov-Smirnov) Admitidos 0.0268 1.0000 YES
## 2 Lilliefors (Kolmogorov-Smirnov) Matriculados 0.0699 0.6480 YES
## 3 Lilliefors (Kolmogorov-Smirnov) Graduados 0.0771 0.4908 YES
## 4 Lilliefors (Kolmogorov-Smirnov) Mujeres 0.0878 0.2874 YES
## 5 Lilliefors (Kolmogorov-Smirnov) Hombres 0.1043 0.0962 YES
## 6 Lilliefors (Kolmogorov-Smirnov) IMI 0.0840 0.3525 YESPodemos concluir que los datos para el año 2020 ahora si cumplen con el supuesto de normalidad.
Transformaciones para el año 2021:
# Transformacion de variable "admitidos":
library(bestNormalize)
Adm_bt_3 <- bestNormalize(Data_2021$Admitidos)
Adm_bt_3## Best Normalizing transformation with 61 Observations
## Estimated Normality Statistics (Pearson P / df, lower => more normal):
## - arcsinh(x): 1.4976
## - Center+scale: 2.1405
## - Double Reversed Log_b(x+a): 2.1755
## - Exp(x): 3.5333
## - Log_b(x+a): 2.669
## - orderNorm (ORQ): 1.3738
## - sqrt(x + a): 1.1738
## - Yeo-Johnson: 1.3071
## Estimation method: Out-of-sample via CV with 10 folds and 5 repeats
##
## Based off these, bestNormalize chose:
## Standardized sqrt(x + a) Transformation with 61 nonmissing obs.:
## Relevant statistics:
## - a = 0
## - mean (before standardization) = 5.446767
## - sd (before standardization) = 3.379587# Transformacion "sqrt_x":
Adm_st_3 <- sqrt_x(Data_2021$Admitidos, a = 0, standardize = TRUE)
Adm_st_3## Standardized sqrt(x + a) Transformation with 61 nonmissing obs.:
## Relevant statistics:
## - a = 0
## - mean (before standardization) = 5.446767
## - sd (before standardization) = 3.379587#Transformacion variable "matriculados":
library(bestNormalize)
Mat_bt_3 <- bestNormalize(Data_2021$Matriculados)
Mat_bt_3## Best Normalizing transformation with 61 Observations
## Estimated Normality Statistics (Pearson P / df, lower => more normal):
## - arcsinh(x): 1.4214
## - Center+scale: 1.8048
## - Double Reversed Log_b(x+a): 2.0298
## - Exp(x): 4.0167
## - Log_b(x+a): 2.4738
## - orderNorm (ORQ): 1.1286
## - sqrt(x + a): 1.0071
## - Yeo-Johnson: 1.1286
## Estimation method: Out-of-sample via CV with 10 folds and 5 repeats
##
## Based off these, bestNormalize chose:
## Standardized sqrt(x + a) Transformation with 61 nonmissing obs.:
## Relevant statistics:
## - a = 0
## - mean (before standardization) = 4.914497
## - sd (before standardization) = 2.982478# Transformacion "arcsinh_x":
Mat_at_3 <- arcsinh_x(Data_2021$Matriculados)
Mat_at_3## Standardized asinh(x) Transformation with 61 nonmissing obs.:
## Relevant statistics:
## - mean (before standardization) = 3.473273
## - sd (before standardization) = 1.455067# Transformacion variable "graduados":
library(bestNormalize)
Grad_bt_3 <- bestNormalize(Data_2021$Graduados)
Grad_bt_3## Best Normalizing transformation with 61 Observations
## Estimated Normality Statistics (Pearson P / df, lower => more normal):
## - arcsinh(x): 1.5833
## - Center+scale: 2.3071
## - Double Reversed Log_b(x+a): 2.0847
## - Exp(x): 3.5886
## - Log_b(x+a): 3.0833
## - orderNorm (ORQ): 1.4571
## - sqrt(x + a): 1.3571
## - Yeo-Johnson: 1.2643
## Estimation method: Out-of-sample via CV with 10 folds and 5 repeats
##
## Based off these, bestNormalize chose:
## Standardized Yeo-Johnson Transformation with 61 nonmissing obs.:
## Estimated statistics:
## - lambda = 0.2074901
## - mean (before standardization) = 3.473787
## - sd (before standardization) = 1.976713# Transformacion "Yeo-Johnson":
Grad_yj_3 <- yeojohnson(Data_2021$Graduados)
Grad_yj_3## Standardized Yeo-Johnson Transformation with 61 nonmissing obs.:
## Estimated statistics:
## - lambda = 0.2074901
## - mean (before standardization) = 3.473787
## - sd (before standardization) = 1.976713# Transformacion variable "Mujeres":
library(bestNormalize)
Muj_bt_3 <- bestNormalize(Data_2021$Mujeres)
Muj_bt_3## Best Normalizing transformation with 61 Observations
## Estimated Normality Statistics (Pearson P / df, lower => more normal):
## - arcsinh(x): 1.3405
## - Center+scale: 2.3548
## - Double Reversed Log_b(x+a): 2.393
## - Exp(x): 4.0443
## - Log_b(x+a): 2.2571
## - orderNorm (ORQ): 1.4238
## - sqrt(x + a): 1.2476
## - Yeo-Johnson: 1.2286
## Estimation method: Out-of-sample via CV with 10 folds and 5 repeats
##
## Based off these, bestNormalize chose:
## Standardized Yeo-Johnson Transformation with 61 nonmissing obs.:
## Estimated statistics:
## - lambda = 0.1403072
## - mean (before standardization) = 2.986698
## - sd (before standardization) = 1.798237# Transformacion "arcsinh_x":
Muj_at_3 <- arcsinh_x(Data_2021$Mujeres)
Muj_at_3## Standardized asinh(x) Transformation with 61 nonmissing obs.:
## Relevant statistics:
## - mean (before standardization) = 2.887581
## - sd (before standardization) = 1.507743# Transformacion variable "hombres":
library(bestNormalize)
Hom_bt_3 <- bestNormalize(Data_2021$Hombres)
Hom_bt_3## Best Normalizing transformation with 61 Observations
## Estimated Normality Statistics (Pearson P / df, lower => more normal):
## - arcsinh(x): 1.4762
## - Center+scale: 2.6095
## - Double Reversed Log_b(x+a): 2.7081
## - Exp(x): 4.5276
## - Log_b(x+a): 2.881
## - orderNorm (ORQ): 1.5595
## - sqrt(x + a): 1.4167
## - Yeo-Johnson: 1.4595
## Estimation method: Out-of-sample via CV with 10 folds and 5 repeats
##
## Based off these, bestNormalize chose:
## Standardized sqrt(x + a) Transformation with 61 nonmissing obs.:
## Relevant statistics:
## - a = 0
## - mean (before standardization) = 2.750377
## - sd (before standardization) = 2.16241# Transformacion "sqrt_x":
Hom_st_3 <- sqrt_x(Data_2021$Hombres, a = 0, standardize = TRUE)
Hom_st_3## Standardized sqrt(x + a) Transformation with 61 nonmissing obs.:
## Relevant statistics:
## - a = 0
## - mean (before standardization) = 2.750377
## - sd (before standardization) = 2.16241# Transformacion variable "IMI":
library(bestNormalize)
IMI_bt_3 <- bestNormalize(Data_2021$IMI)
IMI_bt_3## Best Normalizing transformation with 61 Observations
## Estimated Normality Statistics (Pearson P / df, lower => more normal):
## - arcsinh(x): 2.4048
## - Box-Cox: 2.1762
## - Center+scale: 2.5548
## - Double Reversed Log_b(x+a): 2.9219
## - Exp(x): 5.5105
## - Log_b(x+a): 2.4048
## - orderNorm (ORQ): 1.6
## - sqrt(x + a): 2.4881
## - Yeo-Johnson: 1.8143
## Estimation method: Out-of-sample via CV with 10 folds and 5 repeats
##
## Based off these, bestNormalize chose:
## orderNorm Transformation with 61 nonmissing obs and ties
## - 25 unique values
## - Original quantiles:
## 0% 25% 50% 75% 100%
## 230 231 240 270 325# Transformacion "orderNorm":
IMI_ot_3 <- orderNorm(Data_2021$IMI)
IMI_ot_3## orderNorm Transformation with 61 nonmissing obs and ties
## - 25 unique values
## - Original quantiles:
## 0% 25% 50% 75% 100%
## 230 231 240 270 325# Transformacion variable "Cupo":
library(bestNormalize)
Cup_bt_3 <- bestNormalize(Data_2021$Cupos)
Cup_bt_3## Best Normalizing transformation with 61 Observations
## Estimated Normality Statistics (Pearson P / df, lower => more normal):
## - arcsinh(x): 1.7119
## - Box-Cox: 1.7119
## - Center+scale: 2.2714
## - Double Reversed Log_b(x+a): 2.3286
## - Exp(x): 3.5886
## - Log_b(x+a): 1.7119
## - orderNorm (ORQ): 1.9214
## - sqrt(x + a): 1.9571
## - Yeo-Johnson: 1.7286
## Estimation method: Out-of-sample via CV with 10 folds and 5 repeats
##
## Based off these, bestNormalize chose:
## Standardized asinh(x) Transformation with 61 nonmissing obs.:
## Relevant statistics:
## - mean (before standardization) = 4.258075
## - sd (before standardization) = 0.7149688# Transformacion "orderNorm":
Cup_ot_3 <- orderNorm(Data_2021$Cupos)
Cup_ot_3## orderNorm Transformation with 61 nonmissing obs and ties
## - 17 unique values
## - Original quantiles:
## 0% 25% 50% 75% 100%
## 10 20 35 60 260# Transformacion variable "solicitantes":
library(bestNormalize)
Sol_bt_3 <- bestNormalize(Data_2021$Solicitantes)
Sol_bt_3## Best Normalizing transformation with 61 Observations
## Estimated Normality Statistics (Pearson P / df, lower => more normal):
## - arcsinh(x): 1.9214
## - Center+scale: 2.3262
## - Double Reversed Log_b(x+a): 2.0062
## - Log_b(x+a): 2.8
## - orderNorm (ORQ): 1.8976
## - sqrt(x + a): 1.5643
## - Yeo-Johnson: 1.6952
## Estimation method: Out-of-sample via CV with 10 folds and 5 repeats
##
## Based off these, bestNormalize chose:
## Standardized sqrt(x + a) Transformation with 61 nonmissing obs.:
## Relevant statistics:
## - a = 0
## - mean (before standardization) = 10.3696
## - sd (before standardization) = 6.458524# Transformacion "sqrt":
Sol_st_3 <- sqrt_x(Data_2021$Solicitantes, a = 0, standardize = TRUE)
Sol_st_3## Standardized sqrt(x + a) Transformation with 61 nonmissing obs.:
## Relevant statistics:
## - a = 0
## - mean (before standardization) = 10.3696
## - sd (before standardization) = 6.458524Creamos un dataframe con los datos obtenidos:
nombres_columnas <- c("Admitidos", "Matriculados", "Graduados", "Mujeres", "Hombres", "IMI", "Cup", "Sol") # Cambiado "Hom_yj" por "Hombres" por claridad
valores_columnas <- c(Adm_st_3$x.t, Mat_at_3$x.t, Grad_yj_3$x.t, Muj_at_3$x.t, Hom_st_3$x.t, IMI_ot_3$x.t, Cup_ot_3$x.t, Sol_st_3$x.t)
DN_3 <- data.frame(matrix(valores_columnas, ncol = length(nombres_columnas), byrow = FALSE))
colnames(DN_3) <- nombres_columnaslibrary(GGally)
ggpairs(DN_3)
Hacemos las pruebas de normalidad graficas y analiticas con la nueva base de datos:
par(mfrow = c(2,4))
hist(DN_3$Admitidos, prob = TRUE, xlab=" ", main="Admitidos")
hist(DN_3$Matriculados, prob = TRUE, xlab=" ", main="Matriculados")
hist(DN_3$Graduados, prob = TRUE, xlab=" ", main="Graduados")
hist(DN_3$Mujeres, prob = TRUE, xlab=" ", main="Mujeres")
hist(DN_3$Hombres, prob = TRUE, xlab=" ", main="Hombres")
hist(DN_3$IMI, prob = TRUE, xlab=" ", main="IMI")
hist(DN_3$Cup, prob = TRUE, xlab=" ", main="Cupo")
hist(DN_3$Sol, prob = TRUE, xlab=" ", main="Solicitantes")
par(mfrow = c(2, 4))
qqnorm(DN_3$Admitidos, pch = 1, main = "Admitidos")
qqline(DN_3$Admitidos, col = "blue", lwd = 2)
qqnorm(DN_3$Matriculados, pch = 1, main= "Matriculados")
qqline(DN_3$Matriculados, col = "blue", lwd = 2)
qqnorm(DN_3$Graduados, pch = 1, main= "Graduados")
qqline(DN_3$Graduados, col = "blue", lwd = 2)
qqnorm(DN_3$Mujeres, pch = 1, main= "Mujeres")
qqline(DN_3$Mujeres, col = "blue", lwd = 2)
qqnorm(DN_3$Hombres, pch = 1, main= "Hombres")
qqline(DN_3$Hombres, col = "blue", lwd = 2)
qqnorm(DN_3$IMI, pch = 1, main= "IMI")
qqline(DN_3$IMI, col = "blue", lwd = 2)
qqnorm(DN_3$Cup, pch = 1, main="Cup")
qqline(DN_3$Cup, col = "blue", lwd = 2)
qqnorm(DN_3$Sol, pch = 1, main="Solicitantes")
qqline(DN_3$Sol, col = "blue", lwd = 2)
# Cramer-Von Mises
library(MVN)
CVM_N <- mvn(DN_3[,-4:-5], univariateTest = "CVM",desc=T)
CVM_N$univariateNormality## Test Variable Statistic p value Normality
## 1 Cramer-von Mises Admitidos 0.0401 0.6734 YES
## 2 Cramer-von Mises Matriculados 0.1904 0.0068 NO
## 3 Cramer-von Mises Graduados 0.0514 0.4855 YES
## 4 Cramer-von Mises IMI 0.1082 0.0845 YES
## 5 Cramer-von Mises Cup 0.0737 0.2459 YES
## 6 Cramer-von Mises Sol 0.0744 0.2404 YESPodemos concluir que los datos para el año 2021 ahora si cumplen con el supuesto de normalidad.
Ya con nuestras nuevas bases de datos normalizadas, podemos entonces aplicar los metodos y tecnicas para analisis multivariado que se aprendieron en clase: análisis de componentes principales (PCA), análisis factorial exploratorio (EFA), análisis discriminante (DA) y análisis de correlación canónica (CCA).
- Análisis de Componentes Principales (PCA) para los años 2017, 2020 y 2021
PCA 2017:
Calculamos matriz de covarianza:
S <- round(cov(dn1),3)
S## Admitidos Matriculados Graduados Mujeres Hombres Cup
## Admitidos 0.995 0.610 0.687 0.785 0.710 0.871
## Matriculados 0.610 0.992 0.583 0.753 0.713 0.625
## Graduados 0.687 0.583 1.000 0.669 0.531 0.759
## Mujeres 0.785 0.753 0.669 1.000 0.691 0.756
## Hombres 0.710 0.713 0.531 0.691 1.000 0.650
## Cup 0.871 0.625 0.759 0.756 0.650 1.000Calculamos matriz de correlación:
R <- round(cor(dn1),3)
R## Admitidos Matriculados Graduados Mujeres Hombres Cup
## Admitidos 1.000 0.615 0.689 0.787 0.712 0.873
## Matriculados 0.615 1.000 0.586 0.756 0.716 0.628
## Graduados 0.689 0.586 1.000 0.669 0.531 0.759
## Mujeres 0.787 0.756 0.669 1.000 0.691 0.756
## Hombres 0.712 0.716 0.531 0.691 1.000 0.650
## Cup 0.873 0.628 0.759 0.756 0.650 1.000Calculamos porcentaje de variabilidad:
P1 <- round((S[1,1]/(S[1,1]+S[2,2]))*100,2)
P2 <- 100-P1
P <- cbind(P1,P2)
P## P1 P2
## [1,] 50.08 49.92Las varianzas de las variables son 0.995, 0.992, 1.000, 1.000,1.000 ,1.000, respectivamente, entonces la varianza total de las dos variables es 0.995 + 0.992 + 1.000 + 1.000 + 1.000 + 1.000 =5.99%
Los porcentajes de la variabilidad de P1 y P2 son, respectivamente, 50.08% y 49.92%.
Hacemos el analisis exploratorio de los datos:
data1 <- DN
head(data1)## Admitidos Matriculados Graduados Mujeres Hombres IMI
## 1 0.88334633 0.9457771 1.2592671 0.5742059 1.25168694 1.3499618
## 2 0.04110384 -0.2279667 1.1815315 0.1258493 -0.88042181 -0.7249548
## 3 0.33489417 0.3786901 0.6406864 0.1258493 0.10506814 -0.7249548
## 4 0.18598182 -0.1029120 0.9686607 -0.2076984 -0.08314369 -0.7929193
## 5 1.08327016 1.0121310 0.5897457 0.7240171 1.14110390 -0.4657568
## 6 0.24910613 -1.5771801 -0.6962992 -1.5718331 -1.11393917 -0.4657568
## Cup Sol
## 1 0.1925306 0.2063861
## 2 0.4770991 0.2063861
## 3 0.5054965 0.3548672
## 4 0.4770991 0.3357948
## 5 1.2380861 0.8485647
## 6 -0.5166527 -0.1819793summary(data1)## Admitidos Matriculados Graduados
## Min. :-2.4000364 Min. :-2.4000364 Min. :-1.92220
## 1st Qu.:-0.6362858 1st Qu.:-0.6616482 1st Qu.:-0.49840
## Median : 0.0411038 Median :-0.0205476 Median :-0.08105
## Mean : 0.0001005 Mean : 0.0004442 Mean : 0.00000
## 3rd Qu.: 0.6874435 3rd Qu.: 0.6616482 3rd Qu.: 0.58975
## Max. : 2.4000364 Max. : 2.4000364 Max. : 2.77807
## Mujeres Hombres IMI Cup
## Min. :-2.095382 Min. :-1.67770 Min. :-1.5671817 Min. :-1.8279
## 1st Qu.:-0.710201 1st Qu.:-0.55018 1st Qu.:-0.7929193 1st Qu.:-0.8364
## Median :-0.001185 Median :-0.08314 Median : 0.0919520 Median :-0.1628
## Mean : 0.000000 Mean : 0.00000 Mean : 0.0002185 Mean : 0.0000
## 3rd Qu.: 0.522364 3rd Qu.: 0.57734 3rd Qu.: 0.5450488 3rd Qu.: 0.7386
## Max. : 3.034333 Max. : 3.30130 Max. : 2.1828603 Max. : 2.7854
## Sol
## Min. :-6.86964
## 1st Qu.:-0.18975
## Median : 0.05125
## Mean : 0.00000
## 3rd Qu.: 0.35487
## Max. : 1.31955Ahora calculamos los componentes principales:
pca <- prcomp(dn1, scale = TRUE)
names(pca)## [1] "sdev" "rotation" "center" "scale" "x"Calculamos la media:
pca$center## Admitidos Matriculados Graduados Mujeres Hombres
## 1.005230e-04 4.442398e-04 1.656234e-16 -1.477714e-16 -7.848913e-17
## Cup
## 5.548840e-16Los resultados indican que, en promedio, la variable “Admitidos” tiene un valor extremadamente bajo, alrededor de 0.0001005, mientras que “Matriculados” es también bajo pero más sustancial, aproximadamente 0.0004442. Las variables “Graduados”, “Mujeres” y “Hombres” muestran medias prácticamente nulas, indicando poca variabilidad en estas variables. La variable “Cup” tiene una media más sustancial, alrededor de 0.005900174, indicando una presencia significativa de “Cup” en promedio.
Calculamos desviacion estandar:
pca$scale## Admitidos Matriculados Graduados Mujeres Hombres Cup
## 0.9972672 0.9958853 1.0000000 1.0000000 1.0000000 1.0000000Las variables “Admitidos” y “Matriculados” tienen desviaciones estándar cercanas a 1, lo que sugiere cierta variabilidad en estos datos. En contraste, las variables “Graduados”, “Mujeres”, “Hombres” y “Sol” tienen desviaciones estándar iguales a 1, indicando que todos los valores en estas columnas son iguales y no varían. La variable “Cup” tiene una desviación estándar de aproximadamente 0.9812065, señalando cierta variabilidad en estos datos.
Calculamos la matriz rotation:
round(pca$rotation,4)## PC1 PC2 PC3 PC4 PC5 PC6
## Admitidos -0.4283 0.2219 0.4775 -0.1771 0.0963 0.7062
## Matriculados -0.3901 -0.5330 -0.5215 -0.1087 0.4942 0.1889
## Graduados -0.3849 0.5177 -0.5318 0.4761 -0.2464 0.1165
## Mujeres -0.4258 -0.1049 -0.1067 -0.6109 -0.6110 -0.2230
## Hombres -0.3907 -0.5049 0.3964 0.5914 -0.2414 -0.1651
## Cup -0.4270 0.3643 0.2206 -0.0841 0.5042 -0.6124Considerando la primera componente principal (PC1) con los vectores de peso redondeados proporcionados, se puede interpretar como: PC1 = -0.4238 Admitidos − 0.3755 Matriculados − 0.4231 Graduados − 0.4231 Mujeres − 0.3758 Hombres − 0.4244 Cup
En este caso, las cargas más altas y negativas corresponden a “Admitidos”, “Matriculados” y “Graduados”, sugiriendo que PC1 está fuertemente influenciada por la variabilidad en estas variables, particularmente por la baja admisión, baja matrícula y baja tasa de graduados. Además, las cargas positivas en “Hombres” e “IMI” también contribuyen a la dirección de PC1.
Calculamos el valor de las componentes principales:
head(pca$x)## PC1 PC2 PC3 PC4 PC5 PC6
## [1,] -2.0499967 -0.2794892 -0.2644623 0.71283681 -0.31176146 0.498839212
## [2,] -0.2961839 1.3482095 -0.7463058 -0.05751964 -0.02437948 -0.051441092
## [3,] -0.8489970 0.3216821 -0.2387681 0.14703187 0.21476373 0.028501260
## [4,] -0.4949279 0.8357727 -0.2775745 0.47705939 0.11548297 -0.007195731
## [5,] -2.3712026 -0.1960983 0.3234116 0.10640932 0.36770606 -0.080463871
## [6,] 2.1041761 1.0782656 0.9278646 0.14137513 0.38145815 0.646908156dim(pca$x)## [1] 61 6Una vez calculadas las componentes principales, se puede conocer la varianza explicada por cada una de ellas, la proporción respecto al total y la proporción de varianza acumulada.
prop_varianza <- pca$sdev^2 / sum(pca$sdev^2)
round(prop_varianza,2)## [1] 0.75 0.10 0.06 0.05 0.03 0.02Los resultados muestran que la primera componente principal explica alrededor del 74% de la varianza total en los datos. Las siguientes componentes explican cada vez menos varianza, con la última componente prácticamente sin contribución (0%).
prop_varianza_acum <- cumsum(prop_varianza)
round(prop_varianza_acum,2)## [1] 0.75 0.84 0.91 0.95 0.98 1.00La primera componente principal explica el 74% de la varianza, y esta proporción acumulativa aumenta sucesivamente con cada componente. La segunda componente agrega un 12%, la tercera un 8%, y así sucesivamente. La quinta componente principal contribuye con un 2%, llevando la proporción acumulativa a casi el 100%. Esto indica que al considerar las primeras cinco componentes principales, se ha capturado prácticamente toda la varianza en los datos (98%).
library(ggplot2)
ggplot(data = data.frame(prop_varianza_acum, pc = 1:6),
aes(x = pc, y = prop_varianza_acum, group = 1)) +
geom_point() +
geom_line() +
theme_bw() +
labs(x = "Componente principal",
y = "Prop. varianza explicada acumulada")
Mediante la función biplot() se puede obtener una representación de las dos primeras componentes tanto de las observaciones como de las variables.
par(mfrow = c(1,1))
pca$rotation <- -pca$rotation
pca$x <- -pca$x
biplot(pca, scale = 0, cex = 0.5, col = c("blue2", "red2"))
library(plotly)
plot_ly(dn1, x = ~Admitidos, y = ~Graduados, z = ~Matriculados, color = Data_2017$Facultades, colors = c("turquoise1","seagreen2", "deeppink2", "pink", "deepskyblue1", "purple", "yellow", "violet"))plot_ly(dn1, x = ~Hombres, y = ~Mujeres, z = ~Cup, color = Data_2017$Facultades, colors = c("turquoise1","seagreen2", "deeppink2", "pink", "deepskyblue1", "purple", "yellow", "violet"))PCA 2020:
Calculamos la matriz de covarianza:
S <- round(cov(DN_2),3)
S## Admitidos Matriculados Graduados Mujeres Hombres IMI Cup Sol
## Admitidos 0.986 0.687 0.703 0.749 0.651 0.396 0.811 0.825
## Matriculados 0.687 1.000 0.592 0.876 0.704 0.463 0.674 0.693
## Graduados 0.703 0.592 1.000 0.661 0.505 0.531 0.765 0.753
## Mujeres 0.749 0.876 0.661 1.000 0.613 0.517 0.702 0.762
## Hombres 0.651 0.704 0.505 0.613 1.000 0.422 0.589 0.658
## IMI 0.396 0.463 0.531 0.517 0.422 0.920 0.429 0.610
## Cup 0.811 0.674 0.765 0.702 0.589 0.429 1.000 0.817
## Sol 0.825 0.693 0.753 0.762 0.658 0.610 0.817 1.000Calculamos la matriz de correlación:
R <- round(cor(DN_2),3)
R## Admitidos Matriculados Graduados Mujeres Hombres IMI Cup Sol
## Admitidos 1.000 0.692 0.709 0.755 0.656 0.416 0.817 0.831
## Matriculados 0.692 1.000 0.592 0.876 0.704 0.483 0.674 0.693
## Graduados 0.709 0.592 1.000 0.661 0.505 0.554 0.765 0.753
## Mujeres 0.755 0.876 0.661 1.000 0.613 0.539 0.702 0.762
## Hombres 0.656 0.704 0.505 0.613 1.000 0.440 0.589 0.658
## IMI 0.416 0.483 0.554 0.539 0.440 1.000 0.448 0.636
## Cup 0.817 0.674 0.765 0.702 0.589 0.448 1.000 0.817
## Sol 0.831 0.693 0.753 0.762 0.658 0.636 0.817 1.000Calculamos el porcentaje de variabilidad:
P1 <- round((S[1,1]/(S[1,1]+S[2,2]))*100,2)
P2 <- 100-P1
P <- cbind(P1,P2)
P## P1 P2
## [1,] 49.65 50.35Las varianzas de las variables son 0.986, 1.000, 1.000, 1.000, 1.000, 0.920, 1.000, 1.000 respectivamente, entonces la varianza total de las dos variables es 0.986 + 1.000 + 1.000 + 1.000 + 1.000 + 0.920 + 1.000 + 1.000= 7.906
Los porcentajes de la variabilidad de P1 y P2 son, respectivamente, 49.65% y 50.35%
Hacemos el analisis exploratorio de los datos:
data2 <- DN_2
head(data2)## Admitidos Matriculados Graduados Mujeres Hombres IMI
## 1 1.0121310 1.0323893 1.1364551 1.0473783 1.15284305 1.2450462
## 2 1.2450462 1.0084171 0.7632880 1.1174287 0.99386637 0.5385985
## 3 0.3348942 0.4856342 0.7632880 0.2624732 0.79873072 0.8833463
## 4 0.5625072 0.7548222 0.7632880 1.1174287 -0.14626775 0.6113263
## 5 0.8533908 0.8627214 0.3925704 0.7802303 1.06100876 0.7677715
## 6 -0.2491061 -2.3863589 -0.9782819 -0.2726917 0.08683413 -0.2703575
## Cup Sol
## 1 0.8870626 0.5053714
## 2 1.1685686 0.8647944
## 3 0.8870626 0.4458177
## 4 0.9899130 0.8341756
## 5 0.8870626 1.2256046
## 6 0.1375252 -0.3302998summary(data2)## Admitidos Matriculados Graduados Mujeres
## Min. :-2.134683 Min. :-3.12588 Min. :-2.4371 Min. :-1.9889
## 1st Qu.:-0.661648 1st Qu.:-0.61020 1st Qu.:-0.5820 1st Qu.:-0.6460
## Median : 0.020548 Median : 0.08697 Median : 0.1138 Median :-0.1978
## Mean : 0.001829 Mean : 0.00000 Mean : 0.0000 Mean : 0.0000
## 3rd Qu.: 0.661648 3rd Qu.: 0.80277 3rd Qu.: 0.7633 3rd Qu.: 0.7802
## Max. : 2.400036 Max. : 2.02585 Max. : 1.9730 Max. : 2.4557
## Hombres IMI Cup Sol
## Min. :-1.55802 Min. :-1.44827 Min. :-2.0075 Min. :-1.7632
## 1st Qu.:-0.70052 1st Qu.:-0.63629 1st Qu.:-0.7508 1st Qu.:-0.7176
## Median :-0.02159 Median : 0.02055 Median : 0.1375 Median :-0.3303
## Mean : 0.00000 Mean : 0.01535 Mean : 0.0000 Mean : 0.0000
## 3rd Qu.: 0.79873 3rd Qu.: 0.68744 3rd Qu.: 0.8871 3rd Qu.: 0.6312
## Max. : 2.26381 Max. : 2.40004 Max. : 2.4312 Max. : 3.7164Calculamos los componentes principales:
pca <- prcomp(DN_2, scale = TRUE)
names(pca)## [1] "sdev" "rotation" "center" "scale" "x"Calculamos la media:
pca$center## Admitidos Matriculados Graduados Mujeres Hombres
## 1.829160e-03 -6.589105e-17 -4.288464e-17 -1.353227e-16 -6.489572e-17
## IMI Cup Sol
## 1.535209e-02 -4.447717e-16 -1.032871e-16La variable “Admitidos” tiene un valor bajo de aproximadamente 0.001829, mientras que “Matriculados” es prácticamente cero, sugiriendo una baja variabilidad. Las variables “Graduados”, “Mujeres” y “Hombres” tienen medias prácticamente nulas, señalando una consistencia en sus valores. La variable “IMI” tiene una media más sustancial, alrededor de 0.015352, indicando una presencia significativa en promedio. Las variables “Cup” y “Sol” tienen medias cercanas a cero, sugiriendo que sus valores son bajos y consistentes en el conjunto de datos.
Calculamos la desviación estandar:
pca$scale## Admitidos Matriculados Graduados Mujeres Hombres IMI
## 0.9928317 1.0000000 1.0000000 1.0000000 1.0000000 0.9591614
## Cup Sol
## 1.0000000 1.0000000Las variables “Admitidos” y “Matriculados” tienen desviaciones estándar de aproximadamente 0.9928 y 1, respectivamente, señalando cierta variabilidad. En contraste, las variables “Graduados”, “Mujeres”, “Hombres”, “Cup” y “Sol” tienen desviaciones estándar iguales a 1, indicando que sus datos son constantes y no varían. La variable “IMI” tiene una desviación estándar de aproximadamente 0.9592, indicando cierta variabilidad moderada
Calculamos la matriz rotation:
round(pca$rotation,4)## PC1 PC2 PC3 PC4 PC5 PC6 PC7 PC8
## Admitidos -0.3738 -0.2605 -0.2525 -0.1124 -0.4105 -0.4668 0.5387 -0.1984
## Matriculados -0.3610 -0.2297 0.4206 0.4097 0.1786 0.2274 0.0249 -0.6228
## Graduados -0.3492 0.2059 -0.4577 0.0341 0.7369 -0.2773 -0.0482 -0.0521
## Mujeres -0.3739 -0.1013 0.2160 0.5542 -0.0780 -0.2092 -0.0884 0.6622
## Hombres -0.3237 -0.2574 0.4861 -0.6924 0.2550 -0.0310 -0.0185 0.2165
## IMI -0.2762 0.8540 0.2742 -0.0649 -0.1459 0.0846 0.2941 -0.0117
## Cup -0.3692 -0.1357 -0.4092 -0.0626 -0.0719 0.7716 0.1660 0.2142
## Sol -0.3884 0.1130 -0.1555 -0.1539 -0.3987 -0.0791 -0.7646 -0.1965PC1=−0.3738⋅Admitidos−0.3610⋅Matriculados−0.3492⋅Graduados−0.3739⋅Mujeres−0.3237⋅Hombres−0.2762⋅IMI−0.3692⋅Cup−0.3884⋅Sol
En este caso, las mayores contribuciones negativas provienen de “Admitidos”, “Matriculados” y “Graduados”, sugiriendo que PC1 está fuertemente influenciada por la baja admisión, baja matrícula y baja tasa de graduados. Además, las contribuciones positivas de “Hombres” e “IMI” también juegan un papel en la dirección de PC1.
Calculamos el valor de las componentes principales:
head(pca$x)## PC1 PC2 PC3 PC4 PC5 PC6
## [1,] -2.792536 0.36041201 0.35373530 -0.08705622 0.3640990 -0.057393963
## [2,] -2.756151 -0.36477713 0.02004085 -0.01219656 -0.1135357 0.047852468
## [3,] -1.674513 0.42876027 0.03097413 -0.40324080 0.3211263 0.388213761
## [4,] -1.981638 0.25161673 -0.36858517 0.76161064 -0.1533501 0.217406828
## [5,] -2.424519 -0.00501492 0.31245160 -0.32694774 -0.3658903 0.144646177
## [6,] 1.531070 0.10754222 -0.59549312 -1.13224291 -0.8347444 0.008085159
## PC7 PC8
## [1,] 0.54310536 0.11470103
## [2,] 0.23888218 0.11275844
## [3,] 0.19056751 0.02971015
## [4,] -0.10063788 0.12710557
## [5,] -0.18317150 -0.04165055
## [6,] 0.06183073 1.52356584dim(pca$x)## [1] 61 8Una vez calculadas las componentes principales, se puede conocer la varianza explicada por cada una de ellas, la proporción respecto al total y la proporción de varianza acumulada.
prop_varianza <- pca$sdev^2 / sum(pca$sdev^2)
round(prop_varianza,2)## [1] 0.70 0.09 0.08 0.05 0.03 0.02 0.02 0.01La primera componente principal (PC1) explica la mayoría de la variabilidad con un 74%, seguida por PC2 con un 12%. Las siguientes componentes (PC3, PC4, PC5 y PC6) explican el 8%, 4%, 2% y 0% respectivamente. Estos hallazgos indican que las dos primeras componentes son especialmente relevantes para resumir la información en el conjunto de datos, ya que capturan la mayor proporción de la variabilidad total.
prop_varianza_acum <- cumsum(prop_varianza)
round(prop_varianza_acum,2)## [1] 0.70 0.79 0.87 0.92 0.95 0.97 0.99 1.00La primera componente principal (PC1) sola explica el 74% de la varianza, pero al considerar las dos primeras (PC1 y PC2), la proporción acumulativa aumenta al 86%, sugiriendo que estas dos componentes son esenciales para capturar una parte significativa de la variabilidad total. Al incluir las primeras cuatro componentes principales (PC1 a PC4), se alcanza un 98% de varianza acumulativa, indicando que estas componentes son suficientes para explicar la mayor parte de la variabilidad en el conjunto de datos.
library(ggplot2)
ggplot(data = data.frame(prop_varianza_acum, pc = 1:8),
aes(x = pc, y = prop_varianza_acum, group = 1)) +
geom_point() +
geom_line() +
theme_bw() +
labs(x = "Componente principal",
y = "Prop. varianza explicada acumulada")
Mediante la función biplot() se puede obtener una representación de las dos primeras componentes tanto de las observaciones como de las variables.
par(mfrow = c(1,1))
pca$rotation <- -pca$rotation
pca$x <- -pca$x
biplot(pca, scale = 0, cex = 0.5, col = c("blue2", "red2"))
library(plotly)
plot_ly(DN_2, x = ~Admitidos, y = ~Graduados, z = ~Matriculados, color = Data_2020$Facultades, colors = c("turquoise1","seagreen2", "deeppink2", "pink", "deepskyblue1", "purple", "yellow", "violet"))plot_ly(DN_2, x = ~Hombres, y = ~Mujeres, z = ~Cup, color = Data_2020$Facultades, colors = c("turquoise1","seagreen2", "deeppink2", "pink", "deepskyblue1", "purple", "yellow", "violet"))PCA 2021:
Calculamos la matriz de covarianza:
S <- round(cov(DN_3),3)
S## Admitidos Matriculados Graduados Mujeres Hombres IMI Cup Sol
## Admitidos 1.000 0.745 0.833 0.774 0.827 0.382 0.833 0.889
## Matriculados 0.745 1.000 0.685 0.912 0.792 0.391 0.662 0.710
## Graduados 0.833 0.685 1.000 0.723 0.708 0.465 0.806 0.826
## Mujeres 0.774 0.912 0.723 1.000 0.712 0.451 0.665 0.743
## Hombres 0.827 0.792 0.708 0.712 1.000 0.411 0.707 0.747
## IMI 0.382 0.391 0.465 0.451 0.411 0.868 0.326 0.520
## Cup 0.833 0.662 0.806 0.665 0.707 0.326 0.942 0.801
## Sol 0.889 0.710 0.826 0.743 0.747 0.520 0.801 1.000Calculamos la matriz de correlación:
R <- round(cor(DN_3),3)
R## Admitidos Matriculados Graduados Mujeres Hombres IMI Cup Sol
## Admitidos 1.000 0.745 0.833 0.774 0.827 0.410 0.859 0.889
## Matriculados 0.745 1.000 0.685 0.912 0.792 0.419 0.682 0.710
## Graduados 0.833 0.685 1.000 0.723 0.708 0.499 0.830 0.826
## Mujeres 0.774 0.912 0.723 1.000 0.712 0.484 0.685 0.743
## Hombres 0.827 0.792 0.708 0.712 1.000 0.441 0.729 0.747
## IMI 0.410 0.419 0.499 0.484 0.441 1.000 0.361 0.559
## Cup 0.859 0.682 0.830 0.685 0.729 0.361 1.000 0.826
## Sol 0.889 0.710 0.826 0.743 0.747 0.559 0.826 1.000Calculamos el porcentaje de variabilidad:
P1 <- round((S[1,1]/(S[1,1]+S[2,2]))*100,2)
P2 <- 100-P1
P <- cbind(P1,P2)
P## P1 P2
## [1,] 50 50Las varianzas de las variables son 1.000, 1.000, 1.000, 1.000, 1.000, 0.868, 0.942, 1.000 respectivamente, entonces la varianza total de las dos variables es 1.000 + 1.000 + 1.000 + 1.000 + 1.000 + 0.868 + 0.942 + 1.000= 7.81
Los porcentajes de la variabilidad de P1 y P2 son, respectivamente, 50% y 50%
Hacemos el analisis exploratorio de los datos:
data3 <- DN_3
head(data3)## Admitidos Matriculados Graduados Mujeres Hombres IMI
## 1 0.95085202 0.9687431 0.8410815 0.9395944 1.2184496 1.5771801
## 2 0.25973241 0.4270244 0.6356783 0.5641911 0.1154375 0.7956603
## 3 0.43834830 0.6072572 0.1386331 0.5641911 0.6900929 0.7956603
## 4 0.56270255 0.6901351 0.4775917 0.8433442 0.3300599 0.7956603
## 5 1.08405752 0.9257810 0.8410815 0.7307253 1.4639696 -0.1235907
## 6 -0.07415542 -1.7812923 -0.3490936 -1.3306029 -1.2719032 -1.1603615
## Cup Sol
## 1 1.08327016 0.8669344
## 2 0.61132626 0.5510215
## 3 0.61132626 0.5895843
## 4 0.61132626 0.8080569
## 5 0.61132626 1.1857436
## 6 -0.02054758 -0.2381104summary(data3)## Admitidos Matriculados Graduados Mujeres
## Min. :-1.6117 Min. :-2.3870 Min. :-1.7574 Min. :-1.9152
## 1st Qu.:-0.7240 1st Qu.:-0.4789 1st Qu.:-0.5445 1st Qu.:-0.7091
## Median :-0.1926 Median : 0.1134 Median : 0.0202 Median : 0.2467
## Mean : 0.0000 Mean : 0.0000 Mean : 0.0000 Mean : 0.0000
## 3rd Qu.: 0.6223 3rd Qu.: 0.6901 3rd Qu.: 0.6357 3rd Qu.: 0.8433
## Max. : 2.8660 Max. : 1.6620 Max. : 2.5197 Max. : 1.6681
## Hombres IMI Cup Sol
## Min. :-1.2719 Min. :-1.16036 Min. :-1.739384 Min. :-1.6056
## 1st Qu.:-0.6179 1st Qu.:-0.66165 1st Qu.:-0.740467 1st Qu.:-0.6637
## Median :-0.1391 Median :-0.12359 Median :-0.020548 Median :-0.2207
## Mean : 0.0000 Mean : 0.02745 Mean : 0.008822 Mean : 0.0000
## 3rd Qu.: 0.5191 3rd Qu.: 0.79566 3rd Qu.: 0.611326 3rd Qu.: 0.6275
## Max. : 2.9916 Max. : 2.40004 Max. : 2.400036 Max. : 3.8905Calculamos los componentes principales:
pca <- prcomp(DN_3, scale = TRUE)
names(pca)## [1] "sdev" "rotation" "center" "scale" "x"Calculamos la media:
pca$center## Admitidos Matriculados Graduados Mujeres Hombres
## 8.099168e-17 1.491293e-16 3.981333e-18 -1.472524e-16 -6.802391e-17
## IMI Cup Sol
## 2.744526e-02 8.821983e-03 7.348402e-17Estas medias son extremadamente cercanas a cero, indicando una eficaz centralización de los datos en torno al origen. La variable “IMI” tiene una media más substancial de aproximadamente 0.0274, lo que sugiere su presencia significativa después de la transformación. Asimismo, “Cup” muestra una media de alrededor de 0.0088, señalando su contribución en el nuevo espacio de componentes principales.
Calculamos la desviacion estandar:
pca$scale## Admitidos Matriculados Graduados Mujeres Hombres IMI
## 1.0000000 1.0000000 1.0000000 1.0000000 1.0000000 0.9317435
## Cup Sol
## 0.9705461 1.0000000Las variables “Admitidos”, “Matriculados” y “Graduados” tienen desviaciones estándar iguales a 1, indicando que han sido estandarizadas en la transformación. La variable “IMI” tiene una desviación estándar de aproximadamente 0.9317, lo que sugiere cierta variabilidad moderada. Además, “Cup” muestra una desviación estándar de alrededor de 0.9705, indicando su contribución significativa, aunque ligeramente menos estable en comparación con otras variables.
Calculamos la matriz rotation:
round(pca$rotation,4)## PC1 PC2 PC3 PC4 PC5 PC6 PC7 PC8
## Admitidos -0.3837 -0.1943 -0.1888 0.1246 -0.3332 -0.2639 -0.5812 0.4954
## Matriculados -0.3580 -0.0966 0.5971 -0.0814 0.0920 0.1535 0.4044 0.5511
## Graduados -0.3671 -0.0127 -0.3331 -0.3228 0.6436 -0.4678 0.1294 0.0005
## Mujeres -0.3623 -0.0003 0.5020 -0.4205 -0.1252 -0.0581 -0.3700 -0.5329
## Hombres -0.3586 -0.1072 0.1480 0.8212 0.2283 -0.0677 0.0223 -0.3264
## IMI -0.2363 0.9364 -0.0476 0.0779 0.0443 0.1659 -0.1281 0.1143
## Cup -0.3620 -0.2478 -0.3751 -0.1200 0.1246 0.7909 -0.0764 -0.0749
## Sol -0.3783 0.0549 -0.2827 -0.0456 -0.6172 -0.1642 0.5677 -0.2043PC1=−0.3837⋅Admitidos−0.3580⋅Matriculados−0.3671⋅Graduados−0.3623⋅Mujeres−0.3586⋅Hombres−0.2363⋅IMI−0.3620⋅Cup−0.3783⋅Sol
En este contexto, las mayores contribuciones negativas provienen de “Admitidos”, “Matriculados” y “Graduados”, lo que sugiere que PC1 está fuertemente influenciada por la baja admisión, baja matrícula y baja tasa de graduados. Además, las contribuciones positivas de “Hombres” e “IMI” también juegan un papel significativo en la dirección de PC1.
head(pca$x)## PC1 PC2 PC3 PC4 PC5 PC6
## [1,] -2.919523 0.9108176 0.03116613 0.3307308 0.15072302 0.3764553
## [2,] -1.359710 0.5361222 -0.13340048 -0.3854498 0.09136049 0.1963220
## [3,] -1.530933 0.4308263 0.18020785 0.2527121 -0.16407513 0.3641738
## [4,] -1.787444 0.4448373 0.11841148 -0.2709348 -0.23172107 0.1577804
## [5,] -2.480828 -0.7084824 0.09109371 0.5419667 -0.15359029 -0.4095067
## [6,] 2.134785 -0.8715652 -1.65018661 -0.3212459 -0.40095478 -0.1235526
## PC7 PC8
## [1,] -0.178040501 0.03688647
## [2,] 0.057593836 -0.03892468
## [3,] -0.002975415 -0.04677855
## [4,] 0.014868176 -0.01524337
## [5,] 0.261923771 -0.12692429
## [6,] -0.228031740 0.01087249dim(pca$x)## [1] 61 8Una vez calculadas las componentes principales, se puede conocer la varianza explicada por cada una de ellas, la proporción respecto al total y la proporción de varianza acumulada:
prop_varianza <- pca$sdev^2 / sum(pca$sdev^2)
round(prop_varianza,2)## [1] 0.74 0.09 0.07 0.04 0.02 0.02 0.01 0.01El componente principal (PC1) tiene la contribución más significativa, explicando el 74% de la varianza total. Las siguientes componentes (PC2 a PC8) disminuyen progresivamente en su contribución relativa, con valores que oscilan entre el 9% y el 1%. La proporción acumulativa de varianza explicada por las ocho primeras componentes es del 98%, lo que sugiere que estas son suficientes para capturar la mayor parte de la información relevante en el conjunto de datos
prop_varianza_acum <- cumsum(prop_varianza)
round(prop_varianza_acum,2)## [1] 0.74 0.84 0.90 0.94 0.96 0.98 0.99 1.00Se observa que la primera componente principal (PC1) sola explica el 74% de la varianza total. A medida que se incorporan las siguientes componentes, la proporción acumulativa aumenta progresivamente, alcanzando un 84%, 90%, 94%, 96%, 98%, 99%, y finalmente el 100% con las ocho primeras componentes. Estos resultados indican que al considerar las ocho primeras componentes principales, se logra capturar prácticamente toda la variabilidad presente en el conjunto de datos.
library(ggplot2)
ggplot(data = data.frame(prop_varianza_acum, pc = 1:8),
aes(x = pc, y = prop_varianza_acum, group = 1)) +
geom_point() +
geom_line() +
theme_bw() +
labs(x = "Componente principal",
y = "Prop. varianza explicada acumulada")
Mediante la función biplot() se puede obtener una representación de las dos primeras componentes tanto de las observaciones como de las variables.
par(mfrow = c(1,1))
pca$rotation <- -pca$rotation
pca$x <- -pca$x
biplot(pca, scale = 0, cex = 0.5, col = c("blue2", "red2"))
library(plotly)
plot_ly(DN_3, x = ~Admitidos, y = ~Graduados, z = ~Matriculados, color = Data_2021$Facultades, colors = c("turquoise1","seagreen2", "deeppink2", "pink", "deepskyblue1", "purple", "yellow", "violet"))plot_ly(DN_3, x = ~Hombres, y = ~Mujeres, z = ~Cup, color = Data_2021$Facultades, colors = c("turquoise1","seagreen2", "deeppink2", "pink", "deepskyblue1", "purple", "yellow", "violet"))V. Análisis Factorial Exploratorio (EFA) para los años 2017, 2020 y 2021
EFA 2017:
Modificamos nuestra base de datos, para que solo contenga las variables numericas:
data_B <-DNAhora realizamos un análisis exploratorio descriptivo utilizando la
librería psych:
library(psych)
describe(Data_2017)## vars n mean sd median trimmed mad min max range skew
## Concentraciones* 1 61 31.00 17.75 31 31.00 22.24 1 61 60 0.00
## Facultades* 2 61 4.85 2.02 4 4.84 1.48 1 8 7 0.13
## Admitidos 3 61 39.72 34.44 28 34.06 17.79 0 182 182 2.12
## Matriculados 4 61 31.15 30.06 22 26.27 17.79 0 154 154 2.15
## Graduados 5 61 15.56 27.42 7 10.29 7.41 0 195 195 4.81
## Mujeres 6 61 19.61 18.29 16 16.41 13.34 0 96 96 1.83
## Hombres 7 61 11.95 13.64 8 9.49 8.90 0 78 78 2.59
## IMI 8 61 288.33 25.05 285 284.78 22.24 260 370 110 1.24
## Cupo 9 61 46.54 41.05 32 39.16 25.20 10 250 240 2.70
## Solicitantes 10 61 166.67 153.33 114 140.08 85.99 0 963 963 2.71
## kurtosis se
## Concentraciones* -1.26 2.27
## Facultades* -1.13 0.26
## Admitidos 5.32 4.41
## Matriculados 5.52 3.85
## Graduados 27.57 3.51
## Mujeres 3.91 2.34
## Hombres 8.62 1.75
## IMI 0.96 3.21
## Cupo 9.39 5.26
## Solicitantes 10.12 19.63Con la funcion table podemos observar la cantidad de
estudiantes por cada categoría en las variables de interés:
table(data_B$Admitidos)##
## -2.40003637712739 -1.96702500710193 -1.73938415691956 -1.50959208990538
## 1 1 1 2
## -1.3397462093911 -1.24504623877406 -1.16036153809415 -1.04703818482935
## 1 1 1 2
## -0.94577708618932 -0.853390797663431 -0.740467468641571 -0.636285791799107
## 1 2 2 2
## -0.562507211254823 -0.491672587911351 -0.400858113491923 -0.313239960732027
## 1 2 2 2
## -0.206928659602106 -0.123590715270334 -0.0616774825659391 0.041103838195112
## 3 1 2 3
## 0.123590715270334 0.185981822220581 0.249106129120478 0.291731656343878
## 1 2 1 1
## 0.334894172729616 0.378690063724591 0.423224946321688 0.468615827002329
## 1 1 1 1
## 0.53859848315853 0.61132626451705 0.687443523449877 0.767771497333423
## 2 1 2 1
## 0.824182153996376 0.883346327508692 0.978415525720013 1.08327016348967
## 1 1 2 1
## 1.20162668788281 1.3397462093911 1.44827204150775 1.57718006606787
## 2 1 1 1
## 1.73938415691956 1.96702500710193 2.40003637712739
## 1 1 1table(data_B$Matriculados)##
## -2.40003637712739 -1.84132620013724 -1.57718006606787 -1.44827204150775
## 1 2 1 1
## -1.24504623877406 -1.08327016348967 -1.01213102537296 -0.914116301414476
## 3 1 1 2
## -0.824182153996376 -0.767771497333423 -0.661648181506751 -0.53859848315853
## 1 1 3 2
## -0.468615827002329 -0.378690063724591 -0.227966696566032 -0.102912033721444
## 1 3 4 2
## -0.0205475791820154 0.0822772694097737 0.185981822220581 0.270357483332753
## 2 3 2 2
## 0.334894172729616 0.378690063724591 0.423224946321688 0.468615827002329
## 1 1 1 1
## 0.53859848315853 0.61132626451705 0.661648181506751 0.713704640910261
## 2 1 1 1
## 0.767771497333423 0.853390797663431 0.94577708618932 1.01213102537296
## 1 2 1 1
## 1.08327016348967 1.24504623877406 1.44827204150775 1.57718006606787
## 1 3 1 1
## 1.73938415691956 1.96702500710193 2.40003637712739
## 1 1 1Ahora pasamos a graficar nuestras variables, primero creando los vectores correspondientes a cada variable:
x1 <- data_B$Admitidos
x2 <- data_B$Matriculados
x3 <- data_B$Graduados
x4 <- data_B$Mujeres
x5 <- data_B$Hombres
x6 <- data_B$IMI
x7 <- data_B$Cupo
x8 <- data_B$SolicitantesCreamos un histograma para la variable matriculados:
hist((x2), main = "Estudiantes Matriculados", col = "darkseagreen1", ylab = "", xlab = "Matriculados")
Verificamos que la matriz de correlaciones sea factorizable:
library(psych)
describe(data_B)## vars n mean sd median trimmed mad min max range skew
## Admitidos 1 61 0 1 0.04 0.00 1.00 -2.40 2.40 4.80 0.00
## Matriculados 2 61 0 1 -0.02 0.00 0.95 -2.40 2.40 4.80 0.01
## Graduados 3 61 0 1 -0.08 0.02 0.74 -1.92 2.78 4.70 0.00
## Mujeres 4 61 0 1 0.00 -0.07 0.93 -2.10 3.03 5.13 0.60
## Hombres 5 61 0 1 -0.08 -0.05 0.92 -1.68 3.30 4.98 0.66
## IMI 6 61 0 1 0.09 -0.04 1.31 -1.57 2.18 3.75 0.35
## Cup 7 61 0 1 -0.16 -0.05 1.00 -1.83 2.79 4.61 0.44
## Sol 8 61 0 1 0.05 0.10 0.42 -6.87 1.32 8.19 -5.24
## kurtosis se
## Admitidos -0.32 0.13
## Matriculados -0.33 0.13
## Graduados 0.12 0.13
## Mujeres 0.36 0.13
## Hombres 0.97 0.13
## IMI -0.81 0.13
## Cup -0.27 0.13
## Sol 33.65 0.13R2 <- cor(data_B)
library(ggcorrplot)
ggcorrplot(R2,type="lower",hc.order = T, lab = T, lab_size = 2)
Otra forma:
cor.plot(R2,main="Mapa de calor", diag=F, show.legend = T, cex=0.5) 
Procedemos a hacer la prueba de esfericidad de Bartlett:
cortest.bartlett(R2)## $chisq
## [1] 581.7174
##
## $p.value
## [1] 8.610947e-105
##
## $df
## [1] 28Ahora pasamos a hacer la prueba de KMO:
KMO(R2)## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = R2)
## Overall MSA = 0.87
## MSA for each item =
## Admitidos Matriculados Graduados Mujeres Hombres IMI
## 0.84 0.81 0.93 0.89 0.87 0.91
## Cup Sol
## 0.86 0.88Determinamos el número de factores adecuado:
# 1. Valores propios
ei <- eigen(R2)
plot(ei$values,type="b",pch=20,col="blue")
abline(h=1,lty=3,col="red")
# 2. Scree plot
scree(R2)
# 3. Paralelo
fa.parallel(R2,main=" ",ylab="")
## Parallel analysis suggests that the number of factors = 1 and the number of components = 1Rotamos los factores:
library(GPArotation)
rot<-c("none", "varimax", "quartimax","Promax")
bi_mod<-function(tipo){biplot.psych(fa(data_B,nfactors = 1,fm="ml",rotate = tipo),main = paste("Biplot con rotacion ",tipo),col=c(2,3,4),pch = c(21,18),group = bfi[,"gender"])}
sapply(rot,bi_mod)
## $none
## NULL
##
## $varimax
## NULL
##
## $quartimax
## NULL
##
## $Promax
## NULLmodelo_varimax2 <- fa(R2,nfactors = 1,rotate = "varimax",fa="ml")
fa.diagram(modelo_varimax2)
Conclusión:
Para el año academico 2017, no existen factores latentes que explican la variabilidad en las variables observadas, ya que todas las variuables se acomodan en un mismo grupo.
Método de Componentes principales:
modelo <- principal(data_B,nfactors=2,rotate="varimax")
modelo## Principal Components Analysis
## Call: principal(r = data_B, nfactors = 2, rotate = "varimax")
## Standardized loadings (pattern matrix) based upon correlation matrix
## RC1 RC2 h2 u2 com
## Admitidos 0.76 0.49 0.82 0.184 1.7
## Matriculados 0.87 0.02 0.76 0.235 1.0
## Graduados 0.78 0.26 0.67 0.328 1.2
## Mujeres 0.85 0.29 0.81 0.187 1.2
## Hombres 0.73 0.38 0.68 0.323 1.5
## IMI 0.64 0.12 0.42 0.577 1.1
## Cup 0.79 0.44 0.81 0.186 1.6
## Sol 0.17 0.95 0.93 0.067 1.1
##
## RC1 RC2
## SS loadings 4.27 1.64
## Proportion Var 0.53 0.21
## Cumulative Var 0.53 0.74
## Proportion Explained 0.72 0.28
## Cumulative Proportion 0.72 1.00
##
## Mean item complexity = 1.3
## Test of the hypothesis that 2 components are sufficient.
##
## The root mean square of the residuals (RMSR) is 0.07
## with the empirical chi square 16.57 with prob < 0.22
##
## Fit based upon off diagonal values = 0.99library(ade4)
load <- modelo$loadings[,1:2]
s.corcircle(load,grid=FALSE)
Conclusión:
Para el año académico 2017, no existen factores latentes que explican la variabilidad en las variables observadas, ya que todas las variables se acomodan en un mismo grupo.
EFA 2020:
Modificamos nuestra base de datos, para que solo contenga las variables numericas:
data_B <-DN_2Ahora realizamos un análisis exploratorio descriptivo utilizando la
librería psych:
library(psych)
describe(Data_2020)## vars n mean sd median trimmed mad min max range skew
## Concentraciones* 1 61 31.00 17.75 31 31.00 22.24 1 61 60 0.00
## Facultades* 2 61 4.85 2.02 4 4.84 1.48 1 8 7 0.13
## Admitidos 3 61 47.59 49.09 29 40.82 29.65 0 281 281 2.28
## Matriculados 4 61 36.38 40.32 23 29.96 22.24 0 232 232 2.52
## Graduados 5 61 19.39 22.94 12 15.02 11.86 0 122 122 2.45
## Mujeres 6 61 22.49 24.96 11 18.59 13.34 0 147 147 2.32
## Hombres 7 61 12.93 18.64 6 9.29 8.90 0 105 105 2.97
## IMI 8 61 254.18 26.16 245 249.61 19.27 230 325 95 1.29
## Cupos 9 61 43.25 38.01 35 37.10 22.24 10 250 240 3.11
## Solicitantes 10 61 153.48 179.45 77 121.80 83.03 0 1126 1126 2.91
## kurtosis se
## Concentraciones* -1.26 2.27
## Facultades* -1.13 0.26
## Admitidos 7.41 6.29
## Matriculados 8.44 5.16
## Graduados 7.16 2.94
## Mujeres 7.98 3.20
## Hombres 10.56 2.39
## IMI 0.69 3.35
## Cupos 13.05 4.87
## Solicitantes 11.98 22.98Con la funcion table podemos observar la cantidad de
estudiantes por cada categoría en las variables de interés:
table(data_B$Admitidos)##
## -2.13468333391307 -1.73938415691956 -1.50959208990538 -1.29094914768227
## 2 1 2 2
## -1.16036153809415 -1.01213102537296 -0.853390797663431 -0.740467468641571
## 1 3 2 2
## -0.661648181506751 -0.61132626451705 -0.514993764889511 -0.400858113491923
## 1 1 3 2
## -0.334894172729616 -0.291731656343878 -0.249106129120478 -0.206928659602106
## 1 1 1 1
## -0.165116280362015 -0.123590715270334 -0.0822772694097735 -0.041103838195112
## 1 1 1 1
## 0.0205475791820154 0.0822772694097737 0.123590715270334 0.165116280362015
## 2 1 1 1
## 0.206928659602106 0.249106129120478 0.291731656343878 0.334894172729616
## 1 1 1 1
## 0.378690063724591 0.423224946321688 0.491672587911351 0.562507211254823
## 1 1 2 1
## 0.61132626451705 0.661648181506751 0.713704640910261 0.767771497333423
## 1 1 1 1
## 0.853390797663431 0.94577708618932 1.01213102537296 1.1209830393527
## 2 1 1 2
## 1.24504623877406 1.3397462093911 1.44827204150775 1.57718006606787
## 1 1 1 1
## 1.73938415691956 1.96702500710193 2.40003637712739
## 1 1 1table(data_B$Matriculados)##
## -3.12588323944401 -2.38635885495337 -1.91458799309942 -1.6000994874708
## 1 1 2 1
## -1.18561118433833 -1.03513308655506 -0.907310085972108 -0.796259360651751
## 1 1 2 2
## -0.698113206130168 -0.610197479694059 -0.530588201505833 -0.457855852125512
## 2 3 4 2
## -0.390909757286041 -0.328899080898938 -0.166334038800955 -0.118452976424201
## 1 2 1 1
## -0.0731536021489256 0.0107171080980353 0.0869687884178443 0.15687004501973
## 1 1 3 1
## 0.251891497969663 0.309746129039167 0.337243940460363 0.389676567391169
## 2 1 1 1
## 0.439025843748156 0.485634222664455 0.551026440139106 0.686303791314158
## 1 2 1 1
## 0.754822166223375 0.787091672780597 0.802772734575938 0.862721439157433
## 1 1 1 1
## 0.891162752164165 0.905029916300521 0.996169104520935 1.00841705246428
## 1 1 1 1
## 1.020488801565 1.0323893490964 1.04412348272582 1.05569579207441
## 1 1 1 1
## 1.06711067949089 1.12196597310016 1.19319636184507 1.28548799551176
## 1 1 1 1
## 1.76987402521688 2.02584565973771
## 1 1Ahora pasamos a graficar nuestras variables, primero creando los vectores correspondientes a cada variable:
x1 <- data_B$Admitidos
x2 <- data_B$Matriculados
x3 <- data_B$Graduados
x4 <- data_B$Mujeres
x5 <- data_B$Hombres
x6 <- data_B$IMI
x7 <- data_B$Cupos
x8 <- data_B$SolicitantesCreamos un histograma para la variable matriculados:
hist((x2), main = "Estudiantes Matriculados", col = "darkseagreen1", ylab = "", xlab = "Matriculados")
Verificamos que la matriz de correlaciones sea factorizable:
library(psych)
describe(data_B)## vars n mean sd median trimmed mad min max range skew
## Admitidos 1 61 0.00 0.99 0.02 0.00 1.01 -2.13 2.40 4.53 0.03
## Matriculados 2 61 0.00 1.00 0.09 0.07 1.03 -3.13 2.03 5.15 -0.63
## Graduados 3 61 0.00 1.00 0.11 0.06 1.03 -2.44 1.97 4.41 -0.50
## Mujeres 4 61 0.00 1.00 -0.20 0.02 1.26 -1.99 2.46 4.44 -0.03
## Hombres 5 61 0.00 1.00 -0.02 -0.01 1.15 -1.56 2.26 3.82 -0.01
## IMI 6 61 0.02 0.96 0.02 -0.02 0.97 -1.45 2.40 3.85 0.20
## Cup 7 61 0.00 1.00 0.14 0.00 1.32 -2.01 2.43 4.44 0.03
## Sol 8 61 0.00 1.00 -0.33 -0.08 0.96 -1.76 3.72 5.48 0.96
## kurtosis se
## Admitidos -0.39 0.13
## Matriculados 0.48 0.13
## Graduados -0.03 0.13
## Mujeres -0.60 0.13
## Hombres -0.81 0.13
## IMI -0.63 0.12
## Cup -0.69 0.13
## Sol 1.49 0.13R2 <- cor(data_B)
library(ggcorrplot)
ggcorrplot(R2,type="lower",hc.order = T, lab = T, lab_size = 2)
Otra forma:
cor.plot(R2,main="Mapa de calor", diag=F, show.legend = T, cex=0.5) 
Procedemos a hacer la prueba de esfericidad de Bartlett:
cortest.bartlett(R2)## $chisq
## [1] 725.1277
##
## $p.value
## [1] 1.081584e-134
##
## $df
## [1] 28Ahora pasamos a hacer la prueba de KMO:
KMO(R2)## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = R2)
## Overall MSA = 0.87
## MSA for each item =
## Admitidos Matriculados Graduados Mujeres Hombres IMI
## 0.89 0.81 0.93 0.84 0.88 0.82
## Cup Sol
## 0.90 0.88Determinamos el número de factores adecuado:
# 1. Valores propios
ei <- eigen(R2)
plot(ei$values,type="b",pch=20,col="blue")
abline(h=1,lty=3,col="red")
# 2. Scree plot
scree(R2)
# 3. Paralelo
fa.parallel(R2,main=" ",ylab="")
## Parallel analysis suggests that the number of factors = 1 and the number of components = 1Rotamos los factores:
library(GPArotation)
rot<-c("none", "varimax", "quartimax","Promax")
bi_mod<-function(tipo){biplot.psych(fa(data_B,nfactors = 1,fm="ml",rotate = tipo),main = paste("Biplot con rotacion ",tipo),col=c(2,3,4),pch = c(21,18),group = bfi[,"gender"])}
sapply(rot,bi_mod)
## $none
## NULL
##
## $varimax
## NULL
##
## $quartimax
## NULL
##
## $Promax
## NULLmodelo_varimax2 <- fa(R2,nfactors = 1,rotate = "varimax",fa="ml")
fa.diagram(modelo_varimax2)
Método de Componentes principales:
modelo <- principal(data_B,nfactors=2,rotate="varimax")
modelo## Principal Components Analysis
## Call: principal(r = data_B, nfactors = 2, rotate = "varimax")
## Standardized loadings (pattern matrix) based upon correlation matrix
## RC1 RC2 h2 u2 com
## Admitidos 0.88 0.25 0.83 0.166 1.2
## Matriculados 0.84 0.26 0.77 0.230 1.2
## Graduados 0.64 0.56 0.72 0.284 2.0
## Mujeres 0.81 0.36 0.79 0.206 1.4
## Hombres 0.77 0.19 0.64 0.364 1.1
## IMI 0.22 0.94 0.94 0.065 1.1
## Cup 0.82 0.33 0.78 0.220 1.3
## Sol 0.76 0.54 0.86 0.141 1.8
##
## RC1 RC2
## SS loadings 4.43 1.90
## Proportion Var 0.55 0.24
## Cumulative Var 0.55 0.79
## Proportion Explained 0.70 0.30
## Cumulative Proportion 0.70 1.00
##
## Mean item complexity = 1.4
## Test of the hypothesis that 2 components are sufficient.
##
## The root mean square of the residuals (RMSR) is 0.07
## with the empirical chi square 15.65 with prob < 0.27
##
## Fit based upon off diagonal values = 0.99library(ade4)
load <- modelo$loadings[,1:2]
s.corcircle(load,grid=FALSE)
Conclusión:
Para el año académico 2020, no existen factores latentes que explican la variabilidad en las variables observadas, ya que todas las variables se acomodan en un mismo grupo.
EFA 2021:
Modificamos nuestra base de datos, para que solo contenga las variables numericas:
data_B <-DN_3Ahora realizamos un análisis exploratorio descriptivo utilizando la
librería psych:
library(psych)
describe(Data_2021)## vars n mean sd median trimmed mad min max range skew
## Concentraciones* 1 61 31.00 17.75 31 31.00 22.24 1 61 60 0.00
## Facultades* 2 61 4.85 2.02 4 4.84 1.48 1 8 7 0.13
## Admitidos 3 61 40.90 43.98 23 34.27 29.65 0 229 229 1.93
## Matriculados 4 61 32.90 36.04 19 27.08 23.72 0 181 181 1.98
## Graduados 5 61 20.15 23.37 13 15.96 13.34 0 131 131 2.44
## Mujeres 6 61 20.08 22.51 13 16.39 16.31 0 111 111 1.62
## Hombres 7 61 12.16 16.75 6 8.80 7.41 0 85 85 2.33
## IMI 8 61 251.62 25.13 240 247.08 14.83 230 325 95 1.27
## Cupos 9 61 45.93 39.95 35 39.61 22.24 10 260 250 2.92
## Solicitantes 10 61 148.56 188.62 80 118.37 94.89 0 1260 1260 3.55
## kurtosis se
## Concentraciones* -1.26 2.27
## Facultades* -1.13 0.26
## Admitidos 4.85 5.63
## Matriculados 4.84 4.61
## Graduados 7.47 2.99
## Mujeres 2.98 2.88
## Hombres 6.05 2.14
## IMI 0.76 3.22
## Cupos 11.90 5.12
## Solicitantes 17.37 24.15Con la funcion table podemos observar la cantidad de
estudiantes por cada categoría en las variables de interés:
table(data_B$Admitidos)##
## -1.61166657949641 -1.31577241886266 -1.0991628596158 -0.950027122174087
## 6 1 1 4
## -0.886876868074584 -0.774751509505885 -0.723984097595138 -0.630296671017087
## 2 1 2 1
## -0.58665913973518 -0.504532007657835 -0.465673423121844 -0.321893835310068
## 1 1 1 1
## -0.255709190696792 -0.223799945220106 -0.192608036364876 -0.10289648046672
## 3 2 4 1
## -0.0741554198545628 0.113678037124662 0.138866882166197 0.188187333740657
## 1 1 1 1
## 0.259732408396405 0.328641188559401 0.351073237462241 0.373251792470567
## 1 1 1 1
## 0.438348300026054 0.459592544939898 0.501440391093336 0.542475425513772
## 1 1 1 1
## 0.562702554769077 0.622285343651873 0.641796211240342 0.736920510802958
## 1 1 1 1
## 0.881581935011942 0.950852019906672 1.00159988896374 1.0840575174141
## 1 1 1 1
## 1.13234298126599 1.25713374536636 1.28749226619091 1.30255293296729
## 1 1 2 1
## 1.40587361856297 1.43475025926656 2.40203709549964 2.86602458158749
## 1 1 1 1table(data_B$Matriculados)##
## -2.38701947438211 -1.78129231130209 -1.13728561443253 -0.947420753241343
## 4 2 3 3
## -0.797787919357591 -0.674534821572699 -0.569837985142057 -0.478878927919611
## 1 1 1 1
## -0.398489703449996 -0.201700512312519 -0.0960750308095209 -0.0487720130935346
## 2 4 1 1
## 0.0370782009582435 0.0762964616227723 0.113400121819132 0.214033153853708
## 5 1 3 1
## 0.328740982824647 0.427024354881324 0.492493511385268 0.58941152076074
## 1 2 1 1
## 0.607257246594754 0.624651426300064 0.658172662824229 0.690135060861678
## 2 1 2 2
## 0.7354539473186 0.818006948671708 0.868002794881796 0.879953525137065
## 1 1 1 1
## 0.925781035488379 0.968743122741842 0.999289401508939 1.02853570515981
## 1 1 1 3
## 1.10093880159291 1.16643640626687 1.22623174421431 1.58156844250354
## 1 1 1 1
## 1.66203941407415
## 1Ahora pasamos a graficar nuestras variables, primero creando los vectores correspondientes a cada variable:
x1 <- data_B$Admitidos
x2 <- data_B$Matriculados
x3 <- data_B$Graduados
x4 <- data_B$Mujeres
x5 <- data_B$Hombres
x6 <- data_B$IMI
x7 <- data_B$Cupos
x8 <- data_B$SolicitantesCreamos un histograma para la variable matriculados:
hist((x2), main = "Estudiantes Matriculados", col = "darkseagreen1", ylab = "", xlab = "Matriculados")
Verificamos que la matriz de correlaciones sea factorizable:
library(psych)
describe(data_B)## vars n mean sd median trimmed mad min max range skew
## Admitidos 1 61 0.00 1.00 -0.19 -0.02 1.03 -1.61 2.87 4.48 0.38
## Matriculados 2 61 0.00 1.00 0.11 0.11 0.88 -2.39 1.66 4.05 -0.82
## Graduados 3 61 0.00 1.00 0.02 0.01 0.91 -1.76 2.52 4.28 -0.03
## Mujeres 4 61 0.00 1.00 0.25 0.07 1.03 -1.92 1.67 3.58 -0.47
## Hombres 5 61 0.00 1.00 -0.14 -0.09 0.98 -1.27 2.99 4.26 0.77
## IMI 6 61 0.03 0.93 -0.12 -0.04 1.36 -1.16 2.40 3.56 0.34
## Cup 7 61 0.01 0.97 -0.02 0.00 1.07 -1.74 2.40 4.14 0.12
## Sol 8 61 0.00 1.00 -0.22 -0.04 0.90 -1.61 3.89 5.50 0.91
## kurtosis se
## Admitidos -0.10 0.13
## Matriculados 0.07 0.13
## Graduados -0.28 0.13
## Mujeres -0.89 0.13
## Hombres 0.29 0.13
## IMI -0.69 0.12
## Cup -0.48 0.12
## Sol 2.06 0.13R2 <- cor(data_B)
library(ggcorrplot)
ggcorrplot(R2,type="lower",hc.order = T, lab = T, lab_size = 2)
Otra forma:
cor.plot(R2,main="Mapa de calor", diag=F, show.legend = T, cex=0.5) 
Procedemos a hacer la prueba de esfericidad de Bartlett:
cortest.bartlett(R2)## $chisq
## [1] 889.5696
##
## $p.value
## [1] 2.998745e-169
##
## $df
## [1] 28Ahora pasamos a hacer la prueba de KMO:
KMO(R2)## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = R2)
## Overall MSA = 0.85
## MSA for each item =
## Admitidos Matriculados Graduados Mujeres Hombres IMI
## 0.84 0.78 0.94 0.80 0.84 0.74
## Cup Sol
## 0.92 0.89Determinamos el número de factores adecuado:
# 1. Valores propios
ei <- eigen(R2)
plot(ei$values,type="b",pch=20,col="blue")
abline(h=1,lty=3,col="red")
# 2. Scree plot
scree(R2)
# 3. Paralelo
fa.parallel(R2,main=" ",ylab="")
## Parallel analysis suggests that the number of factors = 1 and the number of components = 1Rotamos los factores:
library(GPArotation)
rot<-c("none", "varimax", "quartimax","Promax")
bi_mod<-function(tipo){biplot.psych(fa(data_B,nfactors = 1,fm="ml",rotate = tipo),main = paste("Biplot con rotacion ",tipo),col=c(2,3,4),pch = c(21,18),group = bfi[,"gender"])}
sapply(rot,bi_mod)
## $none
## NULL
##
## $varimax
## NULL
##
## $quartimax
## NULL
##
## $Promax
## NULLmodelo_varimax2 <- fa(R2,nfactors = 1,rotate = "varimax",fa="ml")
fa.diagram(modelo_varimax2)
Método de Componentes principales:
modelo <- principal(data_B,nfactors=2,rotate="varimax")
modelo## Principal Components Analysis
## Call: principal(r = data_B, nfactors = 2, rotate = "varimax")
## Standardized loadings (pattern matrix) based upon correlation matrix
## RC1 RC2 h2 u2 com
## Admitidos 0.93 0.19 0.90 0.0980 1.1
## Matriculados 0.84 0.24 0.77 0.2326 1.2
## Graduados 0.84 0.32 0.80 0.2000 1.3
## Mujeres 0.82 0.33 0.78 0.2210 1.3
## Hombres 0.85 0.24 0.77 0.2283 1.2
## IMI 0.24 0.97 0.99 0.0096 1.1
## Cup 0.90 0.13 0.82 0.1765 1.0
## Sol 0.84 0.38 0.85 0.1488 1.4
##
## RC1 RC2
## SS loadings 5.23 1.46
## Proportion Var 0.65 0.18
## Cumulative Var 0.65 0.84
## Proportion Explained 0.78 0.22
## Cumulative Proportion 0.78 1.00
##
## Mean item complexity = 1.2
## Test of the hypothesis that 2 components are sufficient.
##
## The root mean square of the residuals (RMSR) is 0.06
## with the empirical chi square 11.9 with prob < 0.54
##
## Fit based upon off diagonal values = 0.99library(ade4)
load <- modelo$loadings[,1:2]
s.corcircle(load,grid=FALSE)
Conclusión:
Para el año académico 2021, no existen factores latentes que explican la variabilidad en las variables observadas, ya que todas las variables se acomodan en un mismo grupo.
V. Análisis Discriminante (DA) para los años 2017, 2020 y 2021
DA 2017:
Se pretende generar un modelo discriminante que permita determinar si es sencillo o no diferenciar características de las diferentes facultades de la universidad con la información de las variables restantes en nuestras bases de datos para los tres años académicos ya determinados. Para este proceso, decidimos dividir las facultades en dos grupos (1 y 2). Con esto, se busca mejorar la capacidad del modelo para capturar diferencias más específicas permitiendo que el modelo se enfoque en particularidades únicas de cada grupo, potencialmente mejorando la capacidad de predicción al identificar patrones más distintivos. Los grupos son los siguientes:
Grupo 1: Escuela de Arquitectura, Facultad de Ciencias Sociales, Facultad de Comunicación e Información, Facultad de Educación Grupo 2: Facultad de Administración de Empresas, Facultad de Humanidades, Facultad de Ciencias Naturales, Facultad de Estudios Generales
Creamos el nuevo vector y modificamos nuestra base de datos:
Grup <- c(1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1,
2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
data_dis_2017 <- dn1
data_g_2017 <- cbind(Grup, data_dis_2017)
str(data_g_2017)## 'data.frame': 61 obs. of 7 variables:
## $ Grup : num 1 1 1 1 2 2 2 2 2 2 ...
## $ Admitidos : num 0.8833 0.0411 0.3349 0.186 1.0833 ...
## $ Matriculados: num 0.946 -0.228 0.379 -0.103 1.012 ...
## $ Graduados : num 1.259 1.182 0.641 0.969 0.59 ...
## $ Mujeres : num 0.574 0.126 0.126 -0.208 0.724 ...
## $ Hombres : num 1.2517 -0.8804 0.1051 -0.0831 1.1411 ...
## $ Cup : num 0.193 0.477 0.505 0.477 1.238 ...Convertimos el nuevo vector en factor:
data_g_2017$Grup <- factor(data_g_2017$Grup)
str(data_g_2017)## 'data.frame': 61 obs. of 7 variables:
## $ Grup : Factor w/ 2 levels "1","2": 1 1 1 1 2 2 2 2 2 2 ...
## $ Admitidos : num 0.8833 0.0411 0.3349 0.186 1.0833 ...
## $ Matriculados: num 0.946 -0.228 0.379 -0.103 1.012 ...
## $ Graduados : num 1.259 1.182 0.641 0.969 0.59 ...
## $ Mujeres : num 0.574 0.126 0.126 -0.208 0.724 ...
## $ Hombres : num 1.2517 -0.8804 0.1051 -0.0831 1.1411 ...
## $ Cup : num 0.193 0.477 0.505 0.477 1.238 ...Creamos una visualizacion paea cada par de variables y un grafico 3d para observar el comportamientos de los datos para las variables “Matricula”, “Graduados” y “Admitidos”:
pairs(data_g_2017[,-1], col = c("turquoise1", "violet")[data_g_2017$Grup], pch = 19)
Esta grafica nos permite ver que es muy dificil discriminar basandose en las carasteristicas o informacion que ofrecen las variables para determinar la facultad.
Grafica 3d:
library(plotly)
fig <- plot_ly(data_dis_2017, x = ~Matriculados, y = ~Admitidos, z = ~Graduados, color = ~Grup, colors = c("turquoise1", "pink"))
fig <- fig %>% add_markers()
figPara definir que método usaremos, debemos analizar si las matrices de covarianzas para las ocho poblaciones se pueden suponer iguales o diferentes:
library(biotools)
boxM(data_g_2017[,2:7], grouping = data_g_2017[,1])##
## Box's M-test for Homogeneity of Covariance Matrices
##
## data: data_g_2017[, 2:7]
## Chi-Sq (approx.) = 37.615, df = 21, p-value = 0.01429La prueba nos da evidencia para suponer que la matriz de covarianza no es constante en todos los grupos, esta condición conlleva a suponer que QDA es más adecuado.
prop.table(table(data_g_2017$Grup))##
## 1 2
## 0.2131148 0.7868852QDA:
library(MASS)
modelo2017 <- qda(Grup ~ ., data = data_g_2017)
modelo2017## Call:
## qda(Grup ~ ., data = data_g_2017)
##
## Prior probabilities of groups:
## 1 2
## 0.2131148 0.7868852
##
## Group means:
## Admitidos Matriculados Graduados Mujeres Hombres Cup
## 1 0.5022817 0.09295941 0.6120920 0.26391087 0.05618137 0.6979390
## 2 -0.1359069 -0.02461195 -0.1657749 -0.07147586 -0.01521579 -0.1890251Predicciones:
predicciones <- predict(modelo2017)
table(data_g_2017$Grup,predicciones$class,
dnn = c("Real", "Predicha"))## Predicha
## Real 1 2
## 1 10 3
## 2 2 46Tasa de error:
tasa_error <- mean(data_g_2017$Grup != predicciones$class)
round(tasa_error*100,1)## [1] 8.2Podemos observar que, en cuanto al grupo 1, el margen de error es de 3/10, mientras que para el grupo 2, el margen de error es de 2/48 En total solo hubieron 5 errores de las 61 observaciones. Es decir, que el modelo creado solo tiene un margen de error del 8%, lo que es bueno, pero no ideal.
Finalmente podemos visualizar como se realizó la clasificación para cada par de variables:
library(klaR)
par(mfrow = c(1,1))
partimat(Grup ~ .,data_g_2017,
method = "qda", image.colors = c("pink", "turquoise1"),
col.mean = "lightgreen")
En conclusión, pudimos determinar que con el modelo creado con la clasificacion “qda” para la base de datos del año academico 2017 si es bueno, pero no ideal para discriminar los grupos creados de las facultades en la base de datos, con un 92% de confianza.
DA 2020:
Creamos el nuevo vector y modificamos nuestra base de datos:
Grup <- c(1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1,
2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
data_dis_2020 <- DN_2
data_g_2020 <- cbind(Grup, data_dis_2020)Convertimos el nuevo vector en factor:
data_g_2020$Grup <- factor(data_g_2020$Grup)
str(data_g_2020)## 'data.frame': 61 obs. of 9 variables:
## $ Grup : Factor w/ 2 levels "1","2": 1 1 1 1 2 2 2 2 2 2 ...
## $ Admitidos : num 1.012 1.245 0.335 0.563 0.853 ...
## $ Matriculados: num 1.032 1.008 0.486 0.755 0.863 ...
## $ Graduados : num 1.136 0.763 0.763 0.763 0.393 ...
## $ Mujeres : num 1.047 1.117 0.262 1.117 0.78 ...
## $ Hombres : num 1.153 0.994 0.799 -0.146 1.061 ...
## $ IMI : num 1.245 0.539 0.883 0.611 0.768 ...
## $ Cup : num 0.887 1.169 0.887 0.99 0.887 ...
## $ Sol : num 0.505 0.865 0.446 0.834 1.226 ...Creamos una visualizacion para cada par de variables y un grafico 3d para observar el comportamientos de los datos para las variables “Matricula”, “Graduados” y “Admitidos”:
pairs(data_g_2020[,-1], col = c("turquoise1", "violet")[data_g_2020$Grup], pch = 19)
Esta grafica nos permite ver que es muy dificil discriminar basandose en las carasteristicas o informacion que ofrecen las variables para determinar la facultad.
Grafica 3d:
library(plotly)
fig <- plot_ly(data_dis_2020, x = ~Matriculados, y = ~Admitidos, z = ~Graduados, color = ~Grup, colors = c("turquoise1", "violet"))
fig <- fig %>% add_markers()
figPara definir que método usaremos, debemos analizar si las matrices de covarianzas para las ocho poblaciones se pueden suponer iguales o diferentes:
library(biotools)
boxM(data_g_2020[,2:7], grouping = data_g_2020[,1])##
## Box's M-test for Homogeneity of Covariance Matrices
##
## data: data_g_2020[, 2:7]
## Chi-Sq (approx.) = 95.235, df = 21, p-value = 1.988e-11La prueba nos da evidencia para suponer que la matriz de covarianza no es constante en todos los grupos, esta condición conlleva a suponer que QDA es más adecuado.
prop.table(table(data_g_2020$Grup))##
## 1 2
## 0.2131148 0.7868852QDA:
library(MASS)
modelo2020 <- qda(Grup ~ ., data = data_g_2020)
modelo2020## Call:
## qda(Grup ~ ., data = data_g_2020)
##
## Prior probabilities of groups:
## 1 2
## 0.2131148 0.7868852
##
## Group means:
## Admitidos Matriculados Graduados Mujeres Hombres IMI
## 1 0.5645929 0.2789756 0.6771135 0.4395268 0.28720090 -0.03517854
## 2 -0.1505860 -0.0755559 -0.1833849 -0.1190385 -0.07778358 0.02903747
## Cup Sol
## 1 0.8468100 0.4115813
## 2 -0.2293444 -0.1114699Predicciones:
predicciones_2 <- predict(modelo2020)
table(data_g_2020$Grup,predicciones$class,
dnn = c("Real", "Predicha"))## Predicha
## Real 1 2
## 1 10 3
## 2 2 46Tasa de error:
tasa_error_2 <- mean(data_g_2017$Grup != predicciones$class)
round(tasa_error*100,1)## [1] 8.2Al igual que para el año académico 2017, podemos observar que en cuanto al grupo 1, el margen de error es de 3/10, mientras que para el grupo 2, el margen de error es de 2/48. En total solo hubieron 5 errores de las 61 observaciones. Es decir, que el modelo creado solo tiene un margen de error del 8%, lo que es bueno, pero no ideal.
Finalmente podemos visualizar como se realizó la clasificación para cada par de variables:
library(klaR)
par(mfrow = c(1,1))
partimat(Grup ~ .,data_g_2020,
method = "qda", image.colors = c("pink", "turquoise1"),
col.mean = "lightgreen")
En conclusión, pudimos determinar que con el modelo creado con la clasificacion “qda” para la base de datos del año academico 2020 si es bueno, pero no ideal para discriminar los grupos creados de las facultades en la base de datos, con un 92% de confianza.
DA 2021:
Creamos el nuevo vector y modificamos nuestra base de datos:
Grup <- c(1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1,
2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
data_dis_2021 <- DN_3
data_g_2021 <- cbind(Grup, data_dis_2021)Convertimos el nuevo vector en factor:
data_g_2021$Grup <- factor(data_g_2021$Grup)
str(data_g_2021)## 'data.frame': 61 obs. of 9 variables:
## $ Grup : Factor w/ 2 levels "1","2": 1 1 1 1 2 2 2 2 2 2 ...
## $ Admitidos : num 0.951 0.26 0.438 0.563 1.084 ...
## $ Matriculados: num 0.969 0.427 0.607 0.69 0.926 ...
## $ Graduados : num 0.841 0.636 0.139 0.478 0.841 ...
## $ Mujeres : num 0.94 0.564 0.564 0.843 0.731 ...
## $ Hombres : num 1.218 0.115 0.69 0.33 1.464 ...
## $ IMI : num 1.577 0.796 0.796 0.796 -0.124 ...
## $ Cup : num 1.083 0.611 0.611 0.611 0.611 ...
## $ Sol : num 0.867 0.551 0.59 0.808 1.186 ...Debemos convertir las variable facultades en factor:
Creamos una visualizacion paea cada par de variables y un grafico 3d para observar el comportamientos de los datos para las variables “Matricula”, “Graduados” y “Admitidos”:
pairs(data_g_2021[,-1], col = c("turquoise1", "violet")[data_g_2021$Grup], pch = 19)
Esta gráfica nos permite ver que es muy dificil discriminar basandose en las carasteristicas o informacion que ofrecen las variables para determinar la facultad.
Grafica 3d:
library(plotly)
fig <- plot_ly(data_dis_2021, x = ~Matriculados, y = ~Admitidos, z = ~Graduados, color = ~Grup, colors = c("turquoise1", "pink"))
fig <- fig %>% add_markers()
figPara definir que método usaremos, debemos analizar si las matrices de covarianzas para las ocho poblaciones se pueden suponer iguales o diferentes:
library(biotools)
boxM(data_g_2021[,2:7], grouping = data_g_2021[,1])##
## Box's M-test for Homogeneity of Covariance Matrices
##
## data: data_g_2021[, 2:7]
## Chi-Sq (approx.) = 75.274, df = 21, p-value = 4.899e-08La prueba nos da evidencia para suponer que la matriz de covarianza no es constante en todos los grupos, esta condición conlleva a suponer que QDA es más adecuado.
prop.table(table(data_g_2021$Grup))##
## 1 2
## 0.2131148 0.7868852QDA:
library(MASS)
modelo2021 <- qda(Grup ~ ., data = data_g_2021)
modelo2021## Call:
## qda(Grup ~ ., data = data_g_2021)
##
## Prior probabilities of groups:
## 1 2
## 0.2131148 0.7868852
##
## Group means:
## Admitidos Matriculados Graduados Mujeres Hombres IMI
## 1 0.4173895 0.27465881 0.6051522 0.3857106 0.11773679 0.105343640
## 2 -0.1130430 -0.07438676 -0.1638954 -0.1044633 -0.03188705 0.006347783
## Cup Sol
## 1 0.6678498 0.4664164
## 2 -0.1696647 -0.1263211Predicciones:
predicciones_3 <- predict(modelo2021)
table(data_g_2021$Grup,predicciones$class,
dnn = c("Real", "Predicha"))## Predicha
## Real 1 2
## 1 10 3
## 2 2 46Tasa de error:
tasa_error_3 <- mean(data_g_2021$Grup != predicciones$class)
round(tasa_error*100,1)## [1] 8.2Al igual que para el año académico previos, podemos observar que en cuanto al grupo 1, el margen de error es de 3/10, mientras que para el grupo 2, el margen de error es de 2/48. En total solo hubieron 5 errores de las 61 observaciones. Es decir, que el modelo creado solo tiene un margen de error del 8%, lo que es bueno, pero no ideal.
Finalmente podemos visualizar como se realizó la clasificación para cada par de variables:
library(klaR)
par(mfrow = c(1,1))
partimat(Grup ~ .,data_g_2021,
method = "qda", image.colors = c("pink", "turquoise1"),
col.mean = "lightgreen")
En conclusión, pudimos determinar que con el modelo creado con la clasificación “qda” para la base de datos del año académico 2021 si es bueno, pero no ideal para discriminar los grupos creados de las facultades en la base de datos, con un 92% de confianza.
- Análisis de Correlación Canónica (CCA) para los años 2017, 2020 y 2021
CCA 2017:
library(DT)
x <- Data_2017[,(3:5)]
y <- Data_2017[,(8:10)]Matriz de covarianza para variables sobre población estudiantil:
datatable(x)Matriz de covarianza para variables sobre proceso de admision:
datatable(y)Creamos gráficas de correlación:
library(GGally)
ggpairs(x, title = "Variables Población Estudiantil")
ggpairs(y, title = "Variables Proceso de admision")
Creamos gráfica para ver correlación entre ambos grupos de variables:
ggduo(Data_2017,columnsX = 3:7,columnsY = 8:10,
types = list(continuous = "smooth_lm"),
title = "Correlación entre variables de población estudiantil y Proceso de Admision",)
Calculamos las matrices de covarianzas que se necesitan para el desarrollo del problema:
Sxx <- cov(x)
Sxx## Admitidos Matriculados Graduados
## Admitidos 1186.2710 918.8251 760.7746
## Matriculados 918.8251 903.3945 642.5664
## Graduados 760.7746 642.5664 751.8508Syy <- cov(y)
Syy## IMI Cupo Solicitantes
## IMI 627.4574 505.303 1978.043
## Cupo 505.3030 1685.019 5863.230
## Solicitantes 1978.0426 5863.230 23508.857Sxy <- cov(x,y)
Sxy## IMI Cupo Solicitantes
## Admitidos 447.8929 1334.7033 4696.624
## Matriculados 357.0842 1068.2522 3790.633
## Graduados 329.3142 963.8768 3514.436Syx <- cov(y,x)
Syx## Admitidos Matriculados Graduados
## IMI 447.8929 357.0842 329.3142
## Cupo 1334.7033 1068.2522 963.8768
## Solicitantes 4696.6238 3790.6325 3514.4358Encontramos los valores propios de cualquiera de las matrices cuadradas A y B:
A <- solve(Sxx)%*%Sxy%*%solve(Syy)%*%Syx
B <- solve(Syy)%*%Syx%*%solve(Sxx)%*%Sxy# Valores propios
Valores_A <- eigen(A)$valuesCon los valores propios, podemos ahora calcular las correspondientes correlaciones canónicas, las cuales serán las raíces cuadradas de los valores propios:
r <- sqrt(Valores_A)
r## [1] 0.961243697 0.133928853 0.009997984Para este problema, las correlaciones canónicas son: $r1=0.961243697 $, \(r2=0.133928853\), \(r3=0.009997984\)
Vectores canónicos:
Encontramos los vectores propios de cada matriz cuadrada A y B:
# Vectores propios
Vectores_A <- eigen(A)$vectors
Vectores_A## [,1] [,2] [,3]
## [1,] -0.88809888 -0.62069090 0.5089112
## [2,] -0.07648614 0.06731343 -0.8327730
## [3,] -0.45324414 0.78116049 0.2179416Vectores_B <- eigen(B)$vectors
Vectores_B## [,1] [,2] [,3]
## [1,] 0.13559602 -0.04800216 0.9841237
## [2,] 0.99009491 -0.96029174 -0.1716721
## [3,] 0.03641125 0.27483735 -0.0450470Calculamos la correlación canónica y los vectores canónicos:
library(CCA)
ccl <- cc(x,y)
ccl[3:4]## $xcoef
## [,1] [,2] [,3]
## Admitidos -0.02049767 -0.047195586 -0.04530830
## Matriculados -0.00176533 0.005118324 0.07414167
## Graduados -0.01046105 0.059397242 -0.01940332
##
## $ycoef
## [,1] [,2] [,3]
## IMI -0.0028444516 -0.003161346 -0.046411519
## Cupo -0.0207696143 -0.063243275 0.008096100
## Solicitantes -0.0007638133 0.018100347 0.002124428Creamos los vectores canónicos para poder calcular las variables canónicas:
a_1 <- Vectores_A[,1]
den1a <- a_1%*%Sxx%*%a_1
den1a## [,1]
## [1,] 1877.214b_1 <- Vectores_B[,]
den1b <- b_1%*%Sxx%*%b_1
den1b## [,1] [,2] [,3]
## [1,] 853.44583 -503.56629 692.6125
## [2,] -45.26602 59.60417 170.3836
## [3,] 291.94981 -208.46707 206.2240Calculamos las variables canónicas:
a_1can <- a_1/sqrt(den1a)
a_1can## [1] -0.02049767 -0.00176533 -0.01046105b_1can <- b_1/sqrt(den1b)
b_1can## [,1] [,2] [,3]
## [1,] 0.004641506 NaN 0.037394223
## [2,] NaN -0.1243841 -0.013151822
## [3,] 0.002130991 NaN -0.003136868Construir las faltantes dos parejas de variables canónica:
library(CCP)
cc2 <- cc(x,y)
rho <- cc2$cor
n <- dim(Data_2017)[1]
p <- length(x)
q <- length(y)
p.asym(rho, n, p, q, tstat ="Wilks")## Wilks' Lambda, using F-approximation (Rao's F):
## stat approx df1 df2 p.value
## 1 to 3: 0.0746397 28.358667161 9 134.0062 0.0000000
## 2 to 3: 0.9819649 0.255958897 4 112.0000 0.9054845
## 3 to 3: 0.9999000 0.005698272 1 57.0000 0.9400916plt.cc(ccl, var.label = TRUE, d1 = 1, d2 = 2, type = "b")
CCA 2020:
library(DT)
x_2 <- Data_2020[,(3:5)]
y_2 <- Data_2020[,(8:10)]Matriz de covarianza para variables sobre población estudiantil:
datatable(x_2)Matriz de covarianza para variables sobre proceso de admision:
datatable(y_2)Creamos gráficas de correlación:
library(GGally)
ggpairs(x_2, title = "Variables Población Estudiantil")
ggpairs(y_2, title = "Variables Proceso de admision")
Creamos gráfica para ver correlación entre ambos grupos de variables:
ggduo(Data_2020,columnsX = 3:7,columnsY = 8:10,
types = list(continuous = "smooth_lm"),
title = "Correlación entre variables de población estudiantil y Proceso de Admision",)
Calculamos las matrices de covarianzas que se necesitan para el desarrollo del problema:
Sxx_2 <- cov(x_2)
Sxx_2## Admitidos Matriculados Graduados
## Admitidos 2410.146 1887.3404 1004.4639
## Matriculados 1887.340 1625.6721 813.0992
## Graduados 1004.464 813.0992 526.1093Syy_2 <- cov(y_2)
Syy_2## IMI Cupos Solicitantes
## IMI 684.1503 491.3216 3119.146
## Cupos 491.3216 1444.5219 6122.598
## Solicitantes 3119.1462 6122.5978 32201.854Sxy_2 <- cov(x_2,y_2)
Sxy_2## IMI Cupos Solicitantes
## Admitidos 659.4918 1710.286 7876.415
## Matriculados 579.2475 1370.589 6336.351
## Graduados 370.1779 792.885 3499.693Syx_2 <- cov(y_2,x_2)
Syx_2## Admitidos Matriculados Graduados
## IMI 659.4918 579.2475 370.1779
## Cupos 1710.2858 1370.5891 792.8850
## Solicitantes 7876.4148 6336.3511 3499.6932Encontramos los valores propios de cualquiera de las matrices cuadradas A y B:
A_2 <- solve(Sxx_2)%*%Sxy_2%*%solve(Syy_2)%*%Syx_2
B_2 <- solve(Syy_2)%*%Syx_2%*%solve(Sxx_2)%*%Sxy_2# Valores propios
Valores_A_2 <- eigen(A_2)$valuesCon los valores propios, podemos ahora calcular las correspondientes correlaciones canónicas, las cuales serán las raíces cuadradas de los valores propios:
r_2 <- sqrt(Valores_A_2)
r_2## [1] 0.95098604 0.49479478 0.09981838Para este problema, las correlaciones canónicas son: $r1=0.95098604 $, \(r2=0.49479478\), \(r3=0.09981838\)
Vectores canónicos:
Encontramos los vectores propios de cada matriz cuadrada A y B:
# Vectores propios
Vectores_A_2 <- eigen(A_2)$vectors
Vectores_A_2## [,1] [,2] [,3]
## [1,] 0.3343537 0.5029922 0.4827626
## [2,] 0.1688888 -0.1281950 -0.8019066
## [3,] 0.9271916 -0.8547309 0.3519744Vectores_B_2 <- eigen(B_2)$vectors
Vectores_B_2## [,1] [,2] [,3]
## [1,] 0.2246178 -0.7992629 0.3505611
## [2,] 0.9735626 -0.5662088 -0.9208859
## [3,] 0.0415046 0.2014607 0.1705169Calculamos la correlación canónica y los vectores canónicos:
library(CCA)
ccl_2 <- cc(x_2,y_2)
ccl_2[3:4]## $xcoef
## [,1] [,2] [,3]
## Admitidos -0.007755388 0.05245502 0.04996665
## Matriculados -0.003917404 -0.01336894 -0.08299853
## Graduados -0.021506360 -0.08913641 0.03642988
##
## $ycoef
## [,1] [,2] [,3]
## IMI -0.0047597718 -0.05049736 -0.018025272
## Cupos -0.0206303117 -0.03577303 0.047350435
## Solicitantes -0.0008795047 0.01272827 -0.008767699Creamos los vectores canónicos para poder calcular las variables canónicas:
a_2 <- Vectores_A_2[,1]
den2a <- a_2%*%Sxx_2%*%a_2
den2a## [,1]
## [1,] 1858.682b_2 <- Vectores_B_2[,1]
den2b <- b_2%*%Sxx_2%*%b_2
den2b## [,1]
## [1,] 2573.242Calculamos las variables canónicas:
a_2can <- a_2/sqrt(den2a)
a_2can## [1] 0.007755388 0.003917404 0.021506360b_2can <- b_2/sqrt(den2b)
b_2can## [1] 0.0044279628 0.0191921496 0.0008181934Construir las faltantes dos parejas de variables canónicas:
library(CCP)
cc2_2 <- cc(x_2,y_2)
rho_2 <- cc2_2$cor
n_2 <- dim(Data_2020)[1]
p_2 <- length(x_2)
q_2 <- length(y_2)
p.asym(rho_2, n_2, p_2, q_2, tstat ="Wilks")## Wilks' Lambda, using F-approximation (Rao's F):
## stat approx df1 df2 p.value
## 1 to 3: 0.0714948 29.1304437 9 134.0062 0.000000000
## 2 to 3: 0.7476538 4.3823061 4 112.0000 0.002494741
## 3 to 3: 0.9900363 0.5736471 1 57.0000 0.451933045plt.cc(ccl, var.label = TRUE, d1 = 1, d2 = 2, type = "b")
CCA 2021:
library(DT)
x_3 <- Data_2021[,(3:5)]
y_3 <- Data_2021[,(8:10)]Matriz de covarianza para variables sobre población estudiantil:
datatable(x_3)Matriz de covarianza para variables sobre proceso de admision:
datatable(y_3)Creamos gráficas de correlación:
library(GGally)
ggpairs(x_3, title = "Variables Población Estudiantil")
ggpairs(y_3, title = "Variables Proceso de admision")
Creamos gráfica para ver correlación entre ambos grupos de variables:
ggduo(Data_2021,columnsX = 3:7,columnsY = 8:10,
types = list(continuous = "smooth_lm"),
title = "Correlación entre variables de población estudiantil y Proceso de Admision",)
Calculamos las matrices de covarianzas que se necesitan para el desarrollo del problema:
Sxx_3 <- cov(x_3)
Sxx_3## Admitidos Matriculados Graduados
## Admitidos 1934.1902 1497.0235 891.2981
## Matriculados 1497.0235 1299.1568 701.7981
## Graduados 891.2981 701.7981 546.1279Syy_3 <- cov(y_3)
Syy_3## IMI Cupos Solicitantes
## IMI 631.6721 520.8749 2949.480
## Cupos 520.8749 1596.0623 6699.037
## Solicitantes 2949.4803 6699.0372 35578.084Sxy_3 <- cov(x_3,y_3)
Sxy_3## IMI Cupos Solicitantes
## Admitidos 526.6123 1606.1268 7052.956
## Matriculados 470.6790 1253.5268 5521.422
## Graduados 368.7732 847.1432 3703.733Syx_3 <- cov(y_3,x_3)
Syx_3## Admitidos Matriculados Graduados
## IMI 526.6123 470.679 368.7732
## Cupos 1606.1268 1253.527 847.1432
## Solicitantes 7052.9557 5521.422 3703.7331Encontramos los valores propios de cualquiera de las matrices cuadradas A y B:
A_3 <- solve(Sxx_3)%*%Sxy_3%*%solve(Syy_3)%*%Syx_3
B_3 <- solve(Syy_3)%*%Syx_3%*%solve(Sxx_3)%*%Sxy_3Valores propios:
Valores_A_3 <- eigen(A_3)$valuesCon los valores propios, podemos ahora calcular las correspondientes correlaciones canónicas, las cuales serán las raíces cuadradas de los valores propios:
r_3 <- sqrt(Valores_A_3)
r_3## [1] 0.94893209 0.44788182 0.02318196Para este problema, las correlaciones canónicas son: $r1=0.94893209 $, \(r2=0.44788182\), \(r3=0.02318196\)
Vectores canónicos:
Encontramos los vectores propios de cada matriz cuadrada A y B:
# Vectores propios
Vectores_A_3 <- eigen(A_3)$vectors
Vectores_A_3## [,1] [,2] [,3]
## [1,] -0.36661798 0.6530817 -0.3576784
## [2,] -0.07806442 -0.3840314 0.7919922
## [3,] -0.92709072 -0.6526900 -0.4947873Vectores_B_3 <- eigen(B_3)$vectors
Vectores_B_3## [,1] [,2] [,3]
## [1,] -0.20583698 -0.99130968 0.01149845
## [2,] -0.97828529 -0.07828034 -0.97509082
## [3,] -0.02426998 0.10572278 0.22150776Calculamos la correlación canónica y los vectores canónicos:
library(CCA)
ccl_3 <- cc(x_3,y_3)
ccl_3[3:4]## $xcoef
## [,1] [,2] [,3]
## Admitidos -0.009371427 0.06874032 0.03359587
## Matriculados -0.001995469 -0.04042135 -0.07438991
## Graduados -0.023698137 -0.06869909 0.04647417
##
## $ycoef
## [,1] [,2] [,3]
## IMI -0.0044572965 -0.050859077 -0.0005955443
## Cupos -0.0211842774 -0.004016167 0.0505033177
## Solicitantes -0.0005255542 0.005424100 -0.0114726510Creamos los vectores canónicos para poder calcular las variables canónicas:
a_3 <- Vectores_A_3[,1]
den3a <- a_3%*%Sxx_3%*%a_3
den3a## [,1]
## [1,] 1530.439b_3 <- Vectores_B_3[,1]
den3b <- b_3%*%Sxx_3%*%b_3
den3b## [,1]
## [1,] 1970.753Calculamos las variables canónicas:
a_3can <- a_3/sqrt(den3a)
a_3can## [1] -0.009371427 -0.001995469 -0.023698137b_3can <- b_3/sqrt(den3b)
b_3can## [1] -0.0046366821 -0.0220368465 -0.0005467053Construir las faltantes dos parejas de variables canónicas:
library(CCP)
cc2_3 <- cc(x_3,y_3)
rho_3 <- cc2_3$cor
n_3 <- dim(Data_2021)[1]
p_3 <- length(x_3)
q_3 <- length(y_3)
p.asym(rho_3, n_3, p_3, q_3, tstat ="Wilks")## Wilks' Lambda, using F-approximation (Rao's F):
## stat approx df1 df2 p.value
## 1 to 3: 0.07952002 27.24768089 9 134.0062 0.00000000
## 2 to 3: 0.79897227 3.32507916 4 112.0000 0.01295728
## 3 to 3: 0.99946260 0.03064847 1 57.0000 0.86164736plt.cc(ccl, var.label = TRUE, d1 = 1, d2 = 2, type = "b")
En cuanto al análisis de correlación canónica (CCA) en 2017, se evidencia una distribución específica de admitidos, matriculados y graduados para diferentes concentraciones en los grupos 1 y 2. La información para 2020 y 2021 se enfoca en cantidades de IMI, Cupos y Solicitantes para las concentraciones en los grupos 1 y 2, mostrando cambios en la oferta educativa y las preferencias de los estudiantes.