Trabajo 2: Análisis de Componente Principales ACP
Cristian Andrés Mosquera Navarro – 2026177
16/8/2022
El datos aqui presentados corresponden a un ejemplo relacionado a los tiempos de actividades cotidianas.
Los datos corresponden a una subpoblación de hombres activos, conformando 27 individuos.
Se estudia la relación entre las actividades cotidianas y la frecuentación de diversos medios (prensa, radio, televisión, cine). Para hacerlo, se harán intervenir las características socioeconómicas (variables nominales) y los hábitos de frecuentación de los medios (variables numéricas continuas) como variables suplementarias.
A continuación se presenta la tabla de datos despues del proceso de organizar y nombras las filas y columnas
#Organizar los datos en una matriz
TablaDatos <- matrix(TablaDatos,byrow=27, ncol = 16)
#nombrar las columnas
colnames(TablaDatos)<-c("IDENT","SUEÑ","REPO","COMC","TRAR","LADO","VISI","JARD","DIVE","MUSI","LECT","COMP","PASE","APIE","AUTO","FRME")
#nombrar las filas
rownames(TablaDatos)<-c("1111","1115","1121","1122","1123","1124","1136","1133","1134","2111","2112","2117","2121","2122","2123","2124","2131","2132","2133","2134","3116","3117","3121","3122","3123","3136","3137")
TablaDatos## IDENT SUEÑ REPO COMC TRAR LADO VISI JARD DIVE MUSI LECT COMP PASE APIE
## 1111 463.8 23.8 107.3 4.9 300.0 21.3 51.0 82.3 10.0 1.2 0.0 41.3 6.9 7.1
## 1115 515.6 58.5 102.7 10.4 208.8 41.9 30.0 32.9 2.1 4.6 0.6 33.7 8.3 24.6
## 1121 463.3 34.2 84.8 17.1 298.3 18.1 37.8 55.8 18.4 5.9 2.6 30.7 5.9 8.8
## 1122 456.4 43.1 74.2 21.9 239.0 26.0 51.2 59.7 18.4 3.6 4.6 52.2 9.5 10.8
## 1123 478.0 44.2 76.7 15.2 212.3 22.3 42.0 43.7 18.4 2.3 6.4 48.3 14.7 15.5
## 1124 465.1 41.6 85.2 23.7 226.0 37.0 42.5 16.3 10.7 8.7 9.4 44.3 13.7 19.8
## 1136 458.4 47.4 94.7 15.1 314.3 25.3 39.1 42.4 16.9 0.9 16.7 34.5 4.6 6.4
## 1133 457.2 30.7 82.0 26.2 269.8 52.1 37.6 35.6 25.6 6.0 8.0 42.8 10.4 12.0
## 1134 465.2 40.2 78.6 31.1 268.6 36.3 21.6 4.0 19.4 6.0 14.9 46.9 10.7 21.9
## 2111 449.0 42.1 86.2 7.9 312.5 15.1 16.1 112.9 15.4 0.0 2.2 32.1 7.6 8.1
## 2112 450.2 63.1 86.7 9.8 249.6 40.4 55.6 83.3 3.0 2.2 0.0 45.0 9.4 10.4
## 2117 455.2 47.4 95.6 9.0 250.8 30.4 13.5 57.3 7.9 2.9 7.0 52.2 15.1 15.7
## 2121 461.9 39.3 90.3 8.5 323.5 14.9 21.7 81.1 15.4 1.2 5.3 26.0 3.8 7.4
## 2122 453.7 44.7 97.5 18.7 269.0 23.1 39.6 93.5 3.1 3.4 12.1 42.0 12.1 10.6
## 2123 433.1 49.8 91.7 12.6 283.7 22.4 21.0 62.9 13.1 6.2 7.3 38.1 11.6 11.7
## 2124 438.3 32.8 102.3 11.1 338.3 28.0 6.5 64.8 13.8 1.4 19.8 34.9 7.4 14.1
## 2131 457.7 44.0 87.9 6.9 313.0 24.4 23.2 63.8 9.2 0.6 11.8 30.0 7.3 7.5
## 2132 455.0 47.0 78.9 31.6 380.6 23.9 7.5 40.0 13.0 0.0 10.3 23.3 1.4 9.4
## 2133 467.3 37.5 86.9 21.9 264.0 40.8 27.6 33.4 11.9 1.6 10.8 45.3 6.7 10.7
## 2134 433.5 35.6 76.1 17.1 355.0 34.1 13.4 31.7 12.6 3.2 13.2 37.5 8.5 22.3
## 3116 473.0 51.5 99.3 6.3 356.3 21.2 27.6 82.1 8.6 0.0 1.5 35.7 13.4 7.1
## 3117 461.9 60.0 103.7 9.1 240.5 35.3 14.5 83.4 1.4 2.0 7.4 46.1 5.7 16.6
## 3121 453.4 45.6 86.2 7.8 358.7 12.9 18.5 54.4 4.2 0.0 4.9 34.3 3.3 10.3
## 3122 485.1 53.5 86.0 0.3 222.4 24.7 23.2 91.9 8.5 0.0 3.7 52.9 7.1 9.9
## 3123 456.7 43.2 94.6 12.1 265.3 30.5 23.7 61.1 9.1 2.3 11.6 50.1 17.6 13.2
## 3136 444.2 53.6 90.7 7.2 302.4 31.7 16.4 97.6 4.7 2.4 4.3 38.8 13.6 11.4
## 3137 438.4 50.7 81.0 11.2 306.6 19.3 23.8 10.5 13.6 0.0 18.4 67.6 8.3 18.6
## AUTO FRME
## 1111 52.1 135.8
## 1115 29.4 225.8
## 1121 56.7 135.8
## 1122 72.7 142.3
## 1123 72.8 167.7
## 1124 59.0 145.1
## 1136 61.5 103.4
## 1133 81.4 107.6
## 1134 48.3 82.4
## 2111 60.1 153.9
## 2112 61.9 145.4
## 2117 49.1 194.8
## 2121 59.6 130.8
## 2122 62.4 129.1
## 2123 47.6 168.6
## 2124 53.2 130.5
## 2131 69.7 108.3
## 2132 59.4 100.0
## 2133 72.8 135.2
## 2134 57.5 96.5
## 3116 40.6 107.7
## 3117 53.3 183.7
## 3121 48.7 143.1
## 3122 75.3 166.3
## 3123 46.3 185.3
## 3136 61.8 127.2
## 3137 63.1 143.3Cada fila corresponde a la identificación del individuo:
1er carácter es la edad del grupo (1=joven, 2=media, 3=viejo).
2do carácter es aquí siempre igual a 1 (puesto que se trata de una selección de hombres (activos)
3er nivel de educación (1=primaria, 2=secundaria, 3=superior)
4to tipo de aglomeración (1=comunas rurales, 2=ciudades medianas,3=ciudades grandes, 4=aglomeración parisina, 5,6,7=grupos mixtos).
Ahora, se determina los datos descriptivos de la tabla de datos:
resumen <- round( cbind(media, desv.estand, minimo, maximo), 2 )
resumen## media desv.estand minimo maximo
## IDENT 458.91 16.78 433.1 515.6
## SUEÑ 44.63 9.07 23.8 63.1
## REPO 89.18 9.07 74.2 107.3
## COMC 13.88 7.96 0.3 31.6
## TRAR 286.27 47.64 208.8 380.6
## LADO 27.90 9.46 12.9 52.1
## VISI 27.64 13.51 6.5 55.6
## JARD 58.46 27.89 4.0 112.9
## DIVE 11.42 6.06 1.4 25.6
## MUSI 2.54 2.36 0.0 8.7
## LECT 7.96 5.58 0.0 19.8
## COMP 40.99 9.65 23.3 67.6
## PASE 9.06 3.96 1.4 17.6
## APIE 12.66 5.10 6.4 24.6
## AUTO 58.38 11.50 29.4 81.4
## FRME 140.58 33.18 82.4 225.8Ahora se normalizara los datos, tomando la nube individuos, para determinar la matriz de correlación usando la expresión Z´NZ
Z <- scale(TablaDatos) # tabla normalizada
N <- diag(1/27, nrow = 27) # pesos
MatrizCorrelacion <- round(t(Z) %*% N %*% Z, 2)
MatrizCorrelacion## IDENT SUEÑ REPO COMC TRAR LADO VISI JARD DIVE MUSI LECT COMP
## IDENT 0.96 0.20 0.20 -0.08 -0.50 0.19 0.26 -0.08 -0.16 0.07 -0.42 -0.04
## SUEÑ 0.20 0.96 0.10 -0.29 -0.27 0.08 -0.08 0.18 -0.59 -0.17 -0.21 0.17
## REPO 0.20 0.10 0.96 -0.51 -0.02 -0.01 -0.06 0.41 -0.53 -0.15 -0.14 -0.16
## COMC -0.08 -0.29 -0.51 0.96 -0.01 0.38 0.10 -0.62 0.50 0.50 0.37 -0.03
## TRAR -0.50 -0.27 -0.02 -0.01 0.96 -0.44 -0.45 0.07 0.10 -0.45 0.23 -0.53
## LADO 0.19 0.08 -0.01 0.38 -0.44 0.96 0.15 -0.35 -0.01 0.48 0.08 0.22
## VISI 0.26 -0.08 -0.06 0.10 -0.45 0.15 0.96 -0.02 0.12 0.29 -0.34 0.23
## JARD -0.08 0.18 0.41 -0.62 0.07 -0.35 -0.02 0.96 -0.38 -0.40 -0.49 -0.23
## DIVE -0.16 -0.59 -0.53 0.50 0.10 -0.01 0.12 -0.38 0.96 0.24 0.26 -0.01
## MUSI 0.07 -0.17 -0.15 0.50 -0.45 0.48 0.29 -0.40 0.24 0.96 -0.01 0.08
## LECT -0.42 -0.21 -0.14 0.37 0.23 0.08 -0.34 -0.49 0.26 -0.01 0.96 0.18
## COMP -0.04 0.17 -0.16 -0.03 -0.53 0.22 0.23 -0.23 -0.01 0.08 0.18 0.96
## PASE 0.00 0.09 0.04 -0.02 -0.44 0.26 0.17 -0.01 -0.05 0.38 -0.02 0.46
## APIE 0.16 0.14 -0.13 0.27 -0.36 0.47 -0.17 -0.59 -0.09 0.46 0.26 0.36
## AUTO -0.18 -0.21 -0.53 0.20 -0.15 0.10 0.26 0.03 0.43 -0.08 0.14 0.22
## FRME 0.39 0.41 0.36 -0.42 -0.60 0.05 0.01 0.18 -0.43 0.07 -0.36 0.29
## PASE APIE AUTO FRME
## IDENT 0.00 0.16 -0.18 0.39
## SUEÑ 0.09 0.14 -0.21 0.41
## REPO 0.04 -0.13 -0.53 0.36
## COMC -0.02 0.27 0.20 -0.42
## TRAR -0.44 -0.36 -0.15 -0.60
## LADO 0.26 0.47 0.10 0.05
## VISI 0.17 -0.17 0.26 0.01
## JARD -0.01 -0.59 0.03 0.18
## DIVE -0.05 -0.09 0.43 -0.43
## MUSI 0.38 0.46 -0.08 0.07
## LECT -0.02 0.26 0.14 -0.36
## COMP 0.46 0.36 0.22 0.29
## PASE 0.96 0.29 -0.10 0.27
## APIE 0.29 0.96 -0.31 0.27
## AUTO -0.10 -0.31 0.96 -0.32
## FRME 0.27 0.27 -0.32 0.96La matriz de correlaciones nos arroja información sobre la relación existente entre las variables, con el ACP se permitira obtener una sinteis de las relaciones de dichas variables.
Se determina los valores propios y los porcentajes de varianza (inercia)
lambda <- round(eigen(MatrizCorrelacion)$values, 4) # valores propios
round(sum(lambda), 0) # inercia o varianza total## [1] 15lambda## [1] 3.7282 3.5178 1.9282 1.4562 1.0727 0.8033 0.7366 0.5762 0.4236 0.3598
## [11] 0.2365 0.2062 0.1496 0.1090 0.0363 0.0198La suma de valores propios es igual al número de variables o sea 16.
Teniendo la frecuencia absoluta y acumuladade los valores propios se tiene que:
FrecuenciAbsoluta <- round(prop.table(lambda), 2) # frecuencia absoluta de valores propios
FrecuenciAcumulada<- round(cumsum(FrecuenciAbsoluta), 2) # frecuencia acumulada de valores propios
distribucion <- as.data.frame( cbind(numero = 1:16, lambda, FrecuenciAbsoluta, FrecuenciAcumulada) )
distribucion## numero lambda FrecuenciAbsoluta FrecuenciAcumulada
## 1 1 3.7282 0.24 0.24
## 2 2 3.5178 0.23 0.47
## 3 3 1.9282 0.13 0.60
## 4 4 1.4562 0.09 0.69
## 5 5 1.0727 0.07 0.76
## 6 6 0.8033 0.05 0.81
## 7 7 0.7366 0.05 0.86
## 8 8 0.5762 0.04 0.90
## 9 9 0.4236 0.03 0.93
## 10 10 0.3598 0.02 0.95
## 11 11 0.2365 0.02 0.97
## 12 12 0.2062 0.01 0.98
## 13 13 0.1496 0.01 0.99
## 14 14 0.1090 0.01 1.00
## 15 15 0.0363 0.00 1.00
## 16 16 0.0198 0.00 1.00Se presenta a continuación los 16 primeros valores propios, el cual Se nota que el histograma, que existe una concentración neta de la nube en un subespacio de dos dimensiones, el plano factorial principal.
hist(FrecuenciAcumulada, freq = FALSE)
Ahora, se presenta los verctores propios y sus valors asociados
MatrizVectores <- eigen(MatrizCorrelacion)$vectors # matriz con vectores propios columna
Vectores <- round(MatrizVectores[, 1:5], 2) # vector propios asociados a los valores propios mas grandes
colnames(Vectores) <- c("u1", "u2", "u3", "u4", "u5")
Vectores## u1 u2 u3 u4 u5
## [1,] -0.12 -0.27 0.13 0.40 -0.37
## [2,] -0.24 -0.21 -0.12 -0.21 -0.45
## [3,] -0.34 -0.07 -0.16 0.18 0.36
## [4,] 0.43 -0.01 -0.05 0.22 -0.09
## [5,] -0.02 0.46 -0.24 0.06 0.07
## [6,] 0.20 -0.30 -0.06 0.11 -0.04
## [7,] 0.06 -0.17 0.52 0.14 0.10
## [8,] -0.38 0.12 0.25 -0.10 0.22
## [9,] 0.37 0.15 0.21 0.07 0.09
## [10,] 0.26 -0.28 0.01 0.30 0.32
## [11,] 0.28 0.12 -0.36 -0.30 0.05
## [12,] 0.10 -0.29 0.07 -0.56 0.01
## [13,] 0.04 -0.31 0.02 -0.25 0.53
## [14,] 0.18 -0.33 -0.40 -0.01 -0.10
## [15,] 0.21 0.11 0.45 -0.32 -0.21
## [16,] -0.26 -0.35 -0.03 -0.07 -0.03Ahora con los vectores calculados se determina las coordenadas de la nube de puntos individuos en los 5 ejes que mas variabilidad absorben
psi <- round(Z %*% Vectores, 2 )
psi <- as.data.frame(psi)
colnames(psi) <- c("coor1", "coor2", "coor3", "coor4", "coor5")
psi## coor1 coor2 coor3 coor4 coor5
## 1111 -1.94 0.89 1.78 1.36 1.82
## 1115 -2.35 -4.97 -1.84 3.01 -1.54
## 1121 0.71 0.99 1.35 2.02 0.51
## 1122 1.80 -0.66 2.63 -0.62 -0.37
## 1123 1.20 -1.81 1.93 -0.81 -0.53
## 1124 2.59 -2.93 -0.05 0.92 0.70
## 1136 0.60 1.93 0.22 0.29 -0.48
## 1133 4.13 -0.37 1.83 0.77 0.56
## 1134 4.19 -0.98 -1.67 0.82 -0.14
## 2111 -1.81 2.12 0.88 -0.26 0.23
## 2112 -1.45 -1.62 1.72 -0.57 -0.70
## 2117 -1.06 -2.11 -1.14 -1.16 0.95
## 2121 -1.17 2.54 0.61 1.04 -0.23
## 2122 -0.61 -0.20 0.47 -0.45 1.16
## 2123 -0.30 -0.33 -0.74 -0.10 1.48
## 2124 0.19 2.03 -2.28 -0.34 1.40
## 2131 -0.49 2.01 0.29 -0.27 -0.44
## 2132 1.24 3.45 -1.32 1.21 -2.04
## 2133 1.60 -0.13 0.52 0.00 -0.92
## 2134 2.52 1.29 -2.11 -0.31 0.15
## 3116 -2.61 0.98 -0.15 0.69 0.75
## 3117 -2.42 -1.76 -1.34 -0.52 -0.89
## 3121 -1.82 2.11 -0.96 0.23 -0.94
## 3122 -2.11 -0.90 1.79 -1.52 -1.79
## 3123 -0.59 -1.71 -0.88 -1.09 1.59
## 3136 -1.52 0.11 -0.15 -1.03 0.68
## 3137 1.51 0.04 -1.41 -3.31 -0.98Ahora se determina las contribuciones de cada individuo sobre cada eje y el calculo de los cosenos cuadrados
contrib1 <- ((1/27)/(lambda[1]) )* psi[, 1]*psi[, 1] *100
contrib2 <- ((1/27)/(lambda[2]) )* psi[, 2]*psi[, 2] *100
contrib3 <- ((1/27)/(lambda[3]) )* psi[, 3]*psi[, 3] *100
contrib4 <- ((1/27)/(lambda[4]) )* psi[, 4]*psi[, 4] *100
contrib5 <- ((1/27)/(lambda[5]) )* psi[, 5]*psi[, 5] *100
psicompleta <- Z %*% MatrizVectores
g <- apply(psicompleta, MARGIN = 2, FUN = mean)
cos1 <- c(); cos2 <- c(); cos3 <- c(); cos4 <- c(); cos5 <- c()
for(i in (1:27)){
cos1[i] <- (psicompleta[i, 1]*psicompleta[i, 1])/sum( (Z[i, ]-g)*(Z[i, ]-g) )
cos2[i] <- (psicompleta[i, 2]*psicompleta[i, 2])/sum( (Z[i, ]-g)*(Z[i, ]-g) )
cos3[i] <- (psicompleta[i, 3]*psicompleta[i, 3])/sum( (Z[i, ]-g)*(Z[i, ]-g) )
cos4[i] <- (psicompleta[i, 4]*psicompleta[i, 4])/sum( (Z[i, ]-g)*(Z[i, ]-g) )
cos5[i] <- (psicompleta[i, 5]*psicompleta[i, 5])/sum( (Z[i, ]-g)*(Z[i, ]-g) )
}
individuos <- cbind(psi, contrib1, contrib2, contrib3, contrib4, contrib5, cos1, cos2, cos3, cos4, cos5)
individuos <- round(individuos,2)
individuos # resultados individuos## coor1 coor2 coor3 coor4 coor5 contrib1 contrib2 contrib3 contrib4 contrib5
## 1111 -1.94 0.89 1.78 1.36 1.82 3.74 0.83 6.09 4.70 11.44
## 1115 -2.35 -4.97 -1.84 3.01 -1.54 5.49 26.01 6.50 23.04 8.19
## 1121 0.71 0.99 1.35 2.02 0.51 0.50 1.03 3.50 10.38 0.90
## 1122 1.80 -0.66 2.63 -0.62 -0.37 3.22 0.46 13.29 0.98 0.47
## 1123 1.20 -1.81 1.93 -0.81 -0.53 1.43 3.45 7.15 1.67 0.97
## 1124 2.59 -2.93 -0.05 0.92 0.70 6.66 9.04 0.00 2.15 1.69
## 1136 0.60 1.93 0.22 0.29 -0.48 0.36 3.92 0.09 0.21 0.80
## 1133 4.13 -0.37 1.83 0.77 0.56 16.94 0.14 6.43 1.51 1.08
## 1134 4.19 -0.98 -1.67 0.82 -0.14 17.44 1.01 5.36 1.71 0.07
## 2111 -1.81 2.12 0.88 -0.26 0.23 3.25 4.73 1.49 0.17 0.18
## 2112 -1.45 -1.62 1.72 -0.57 -0.70 2.09 2.76 5.68 0.83 1.69
## 2117 -1.06 -2.11 -1.14 -1.16 0.95 1.12 4.69 2.50 3.42 3.12
## 2121 -1.17 2.54 0.61 1.04 -0.23 1.36 6.79 0.71 2.75 0.18
## 2122 -0.61 -0.20 0.47 -0.45 1.16 0.37 0.04 0.42 0.52 4.65
## 2123 -0.30 -0.33 -0.74 -0.10 1.48 0.09 0.11 1.05 0.03 7.56
## 2124 0.19 2.03 -2.28 -0.34 1.40 0.04 4.34 9.99 0.29 6.77
## 2131 -0.49 2.01 0.29 -0.27 -0.44 0.24 4.25 0.16 0.19 0.67
## 2132 1.24 3.45 -1.32 1.21 -2.04 1.53 12.53 3.35 3.72 14.37
## 2133 1.60 -0.13 0.52 0.00 -0.92 2.54 0.02 0.52 0.00 2.92
## 2134 2.52 1.29 -2.11 -0.31 0.15 6.31 1.75 8.55 0.24 0.08
## 3116 -2.61 0.98 -0.15 0.69 0.75 6.77 1.01 0.04 1.21 1.94
## 3117 -2.42 -1.76 -1.34 -0.52 -0.89 5.82 3.26 3.45 0.69 2.73
## 3121 -1.82 2.11 -0.96 0.23 -0.94 3.29 4.69 1.77 0.13 3.05
## 3122 -2.11 -0.90 1.79 -1.52 -1.79 4.42 0.85 6.15 5.88 11.06
## 3123 -0.59 -1.71 -0.88 -1.09 1.59 0.35 3.08 1.49 3.02 8.73
## 3136 -1.52 0.11 -0.15 -1.03 0.68 2.30 0.01 0.04 2.70 1.60
## 3137 1.51 0.04 -1.41 -3.31 -0.98 2.27 0.00 3.82 27.87 3.32
## cos1 cos2 cos3 cos4 cos5
## 1111 0.20 0.04 0.16 0.10 0.17
## 1115 0.12 0.53 0.08 0.20 0.05
## 1121 0.05 0.09 0.18 0.40 0.02
## 1122 0.26 0.04 0.55 0.03 0.01
## 1123 0.11 0.23 0.27 0.05 0.02
## 1124 0.37 0.47 0.00 0.04 0.03
## 1136 0.03 0.36 0.00 0.01 0.02
## 1133 0.65 0.01 0.13 0.02 0.01
## 1134 0.72 0.04 0.11 0.03 0.00
## 2111 0.27 0.36 0.06 0.00 0.00
## 2112 0.12 0.16 0.18 0.02 0.03
## 2117 0.11 0.42 0.12 0.12 0.09
## 2121 0.13 0.61 0.04 0.10 0.01
## 2122 0.05 0.01 0.03 0.03 0.18
## 2123 0.01 0.01 0.07 0.00 0.28
## 2124 0.00 0.27 0.35 0.01 0.13
## 2131 0.04 0.56 0.01 0.01 0.03
## 2132 0.06 0.50 0.07 0.06 0.18
## 2133 0.34 0.00 0.04 0.00 0.12
## 2134 0.38 0.10 0.27 0.01 0.00
## 3116 0.44 0.07 0.00 0.03 0.04
## 3117 0.38 0.20 0.12 0.02 0.05
## 3121 0.26 0.36 0.08 0.00 0.07
## 3122 0.27 0.05 0.20 0.14 0.19
## 3123 0.04 0.29 0.08 0.12 0.26
## 3136 0.27 0.00 0.00 0.12 0.05
## 3137 0.11 0.00 0.09 0.53 0.04Ahora la nube de variables, correspnde a las coordenadas de las variables sobre los ejes 1 a 5.
v1 <- ( 1/sqrt(lambda[1]) ) * sqrt(N) %*% psi[, 1]
v2 <- ( 1/sqrt(lambda[2]) ) * sqrt(N) %*% psi[, 2]
v3 <- ( 1/sqrt(lambda[3]) ) * sqrt(N) %*% psi[, 3]
v4 <- ( 1/sqrt(lambda[4]) ) * sqrt(N) %*% psi[, 4]
v5 <- ( 1/sqrt(lambda[5]) ) * sqrt(N) %*% psi[, 5]
V <- cbind(v1, v2, v3, v4, v5)
phi <- as.data.frame( round( t(Z) %*% sqrt(N) %*% V, 2) ) # coordenadas de la nube de puntos columna en los 5 ejes que mas variabilidad absorben
colnames(phi) <- c("coor1", "coor2", "coor3", "coor4", "coor5")
V <- as.data.frame(V) # matriz con columnas v alfa
corr1 <- c(); corr2 <- c(); corr3 <- c(); corr4 <- c(); corr5 <- c()
for (i in (1:16)){
corr1[i] <- cor(Z[, i], psi[, 1])
corr2[i] <- cor(Z[, i], psi[, 2])
corr3[i] <- cor(Z[, i], psi[, 3])
corr4[i] <- cor(Z[, i], psi[, 4])
corr5[i] <- cor(Z[, i], psi[, 5])
}
variables <- cbind(phi, corr1, corr2, corr3, corr4, corr5, Vectores)
variables <- round(variables, 2)
variables## coor1 coor2 coor3 coor4 coor5 corr1 corr2 corr3 corr4 corr5 u1 u2
## IDENT -0.23 -0.51 0.18 0.48 -0.40 -0.23 -0.51 0.19 0.49 -0.40 -0.12 -0.27
## SUEÑ -0.46 -0.39 -0.16 -0.26 -0.47 -0.47 -0.40 -0.17 -0.26 -0.48 -0.24 -0.21
## REPO -0.66 -0.13 -0.22 0.21 0.38 -0.67 -0.13 -0.23 0.21 0.38 -0.34 -0.07
## COMC 0.83 -0.01 -0.07 0.27 -0.09 0.84 -0.01 -0.07 0.28 -0.09 0.43 -0.01
## TRAR -0.03 0.87 -0.33 0.08 0.08 -0.03 0.88 -0.34 0.08 0.08 -0.02 0.46
## LADO 0.38 -0.57 -0.08 0.14 -0.05 0.39 -0.58 -0.08 0.14 -0.05 0.20 -0.30
## VISI 0.12 -0.33 0.72 0.17 0.10 0.12 -0.33 0.73 0.17 0.10 0.06 -0.17
## JARD -0.74 0.23 0.35 -0.13 0.23 -0.76 0.23 0.36 -0.13 0.23 -0.38 0.12
## DIVE 0.71 0.29 0.29 0.09 0.10 0.73 0.29 0.29 0.09 0.10 0.37 0.15
## MUSI 0.51 -0.53 0.01 0.36 0.33 0.52 -0.53 0.01 0.37 0.34 0.26 -0.28
## LECT 0.54 0.22 -0.50 -0.36 0.05 0.55 0.22 -0.51 -0.37 0.05 0.28 0.12
## COMP 0.20 -0.54 0.10 -0.68 0.01 0.20 -0.55 0.10 -0.69 0.01 0.10 -0.29
## PASE 0.08 -0.58 0.03 -0.30 0.55 0.08 -0.58 0.03 -0.30 0.56 0.04 -0.31
## APIE 0.35 -0.62 -0.56 -0.01 -0.11 0.35 -0.63 -0.57 -0.01 -0.12 0.18 -0.33
## AUTO 0.41 0.21 0.62 -0.38 -0.21 0.42 0.21 0.64 -0.39 -0.22 0.21 0.11
## FRME -0.50 -0.66 -0.04 -0.08 -0.04 -0.51 -0.67 -0.04 -0.09 -0.04 -0.26 -0.35
## u3 u4 u5
## IDENT 0.13 0.40 -0.37
## SUEÑ -0.12 -0.21 -0.45
## REPO -0.16 0.18 0.36
## COMC -0.05 0.22 -0.09
## TRAR -0.24 0.06 0.07
## LADO -0.06 0.11 -0.04
## VISI 0.52 0.14 0.10
## JARD 0.25 -0.10 0.22
## DIVE 0.21 0.07 0.09
## MUSI 0.01 0.30 0.32
## LECT -0.36 -0.30 0.05
## COMP 0.07 -0.56 0.01
## PASE 0.02 -0.25 0.53
## APIE -0.40 -0.01 -0.10
## AUTO 0.45 -0.32 -0.21
## FRME -0.03 -0.07 -0.03Los graficos
#install.packages("FactoMineR")
library(FactoMineR)## Warning: replacing previous import 'lifecycle::last_warnings' by
## 'rlang::last_warnings' when loading 'tibble'## Warning: replacing previous import 'lifecycle::last_warnings' by
## 'rlang::last_warnings' when loading 'pillar'ACPTablaDatos <- PCA(TablaDatos, graph = FALSE)
g1 <- plot(ACPTablaDatos, choix = "ind") # grafico nube de individuos
g2 <- plot(ACPTablaDatos, choix = "var") # grafico nube de variables
#install.packages(("patchwork"))
library(patchwork)## Warning: package 'patchwork' was built under R version 4.1.3g <- g1 + g2
graficos <- g + plot_annotation(
title = "representacion de los 27 inviduos y 16
variables en el plano de los factores 1 y 2"
)
g