Componentes Principales
MATRIZ DE INFORMACIÓN
library(readr)
library(kableExtra)
load("C:/Users/Guardado/Documents/métodos clases/Carlos Alberto Guardado Angel - 6-2.RData")
#mat_X<-read_table2(mat,col_names = FALSE)
X6_2 %>% head() %>%
kable(caption = "Matriz de información", align = "c", digits = 6) %>%
kable_material(html_font = "sans-serif")| V1 | V2 | V3 | V4 | V5 | V6 | V7 | V8 | V9 | V10 |
|---|---|---|---|---|---|---|---|---|---|
| 4 | 1 | 4 | 3 | 3 | 2 | 4 | 4 | 4 | 4 |
| 5 | 5 | 4 | 4 | 3 | 3 | 4 | 1 | 1 | 3 |
| 2 | 1 | 3 | 1 | 4 | 2 | 1 | 5 | 4 | 5 |
| 1 | 1 | 1 | 1 | 4 | 4 | 2 | 5 | 5 | 4 |
| 1 | 1 | 2 | 1 | 5 | 5 | 4 | 3 | 3 | 2 |
| 5 | 5 | 5 | 5 | 3 | 3 | 4 | 2 | 2 | 1 |
a) Calcula la matriz de varianza covarianza para la batería de indicadores:
1. De forma “manual”
library(dplyr)
library(kableExtra)
centrado<-function(x){
x-mean(x)
}
Xcentrada<-apply(X = X6_2,MARGIN = 2,centrado)
Xcentrada %>% head() %>%
kable(caption ="Matriz de Variables centradas:",
align = "c",
digits = 2) %>%
kable_material(html_font = "sans-serif")| V1 | V2 | V3 | V4 | V5 | V6 | V7 | V8 | V9 | V10 |
|---|---|---|---|---|---|---|---|---|---|
| 0.3 | -2.4 | 0.5 | 0.2 | -0.7 | -1.7 | 0.35 | 1.15 | 1.2 | 1.35 |
| 1.3 | 1.6 | 0.5 | 1.2 | -0.7 | -0.7 | 0.35 | -1.85 | -1.8 | 0.35 |
| -1.7 | -2.4 | -0.5 | -1.8 | 0.3 | -1.7 | -2.65 | 2.15 | 1.2 | 2.35 |
| -2.7 | -2.4 | -2.5 | -1.8 | 0.3 | 0.3 | -1.65 | 2.15 | 2.2 | 1.35 |
| -2.7 | -2.4 | -1.5 | -1.8 | 1.3 | 1.3 | 0.35 | 0.15 | 0.2 | -0.65 |
| 1.3 | 1.6 | 1.5 | 2.2 | -0.7 | -0.7 | 0.35 | -0.85 | -0.8 | -1.65 |
n_obs<-nrow(X6_2)
mat_V<-t(Xcentrada)%*%Xcentrada/(n_obs-1)
mat_V %>% kable(caption ="Cálculo de V(X) forma manual:" ,
align = "c",
digits = 2) %>%
kable_material(html_font = "sans-serif") %>%
kable_styling(bootstrap_options = c("striped", "hover"))| V1 | V2 | V3 | V4 | V5 | V6 | V7 | V8 | V9 | V10 | |
|---|---|---|---|---|---|---|---|---|---|---|
| V1 | 1.80 | 1.92 | 1.32 | 1.73 | -0.62 | -0.31 | 0.36 | -1.21 | -1.27 | -0.90 |
| V2 | 1.92 | 2.67 | 1.42 | 2.14 | -0.66 | -0.14 | 0.52 | -1.78 | -1.81 | -1.54 |
| V3 | 1.32 | 1.42 | 1.42 | 1.53 | -0.53 | -0.32 | 0.29 | -0.92 | -1.11 | -0.87 |
| V4 | 1.73 | 2.14 | 1.53 | 2.48 | -0.80 | -0.48 | 0.35 | -1.61 | -1.83 | -1.39 |
| V5 | -0.62 | -0.66 | -0.53 | -0.80 | 0.85 | 0.80 | 0.21 | 0.37 | 0.46 | 0.15 |
| V6 | -0.31 | -0.14 | -0.32 | -0.48 | 0.80 | 1.38 | 0.63 | 0.22 | 0.09 | -0.37 |
| V7 | 0.36 | 0.52 | 0.29 | 0.35 | 0.21 | 0.63 | 1.61 | -0.53 | -0.34 | -0.71 |
| V8 | -1.21 | -1.78 | -0.92 | -1.61 | 0.37 | 0.22 | -0.53 | 1.92 | 1.81 | 1.37 |
| V9 | -1.27 | -1.81 | -1.11 | -1.83 | 0.46 | 0.09 | -0.34 | 1.81 | 2.17 | 1.56 |
| V10 | -0.90 | -1.54 | -0.87 | -1.39 | 0.15 | -0.37 | -0.71 | 1.37 | 1.56 | 1.82 |
2. Usando el comando cov de R base
library(dplyr)
library(kableExtra)
cov(X6_2) %>%
kable(caption="Cálculo de V(X) a través de R base",
align = "c",
digits = 2) %>%
kable_material(html_font = "sans-serif") %>%
kable_styling(bootstrap_options = c("striped", "hover"))| V1 | V2 | V3 | V4 | V5 | V6 | V7 | V8 | V9 | V10 | |
|---|---|---|---|---|---|---|---|---|---|---|
| V1 | 1.80 | 1.92 | 1.32 | 1.73 | -0.62 | -0.31 | 0.36 | -1.21 | -1.27 | -0.90 |
| V2 | 1.92 | 2.67 | 1.42 | 2.14 | -0.66 | -0.14 | 0.52 | -1.78 | -1.81 | -1.54 |
| V3 | 1.32 | 1.42 | 1.42 | 1.53 | -0.53 | -0.32 | 0.29 | -0.92 | -1.11 | -0.87 |
| V4 | 1.73 | 2.14 | 1.53 | 2.48 | -0.80 | -0.48 | 0.35 | -1.61 | -1.83 | -1.39 |
| V5 | -0.62 | -0.66 | -0.53 | -0.80 | 0.85 | 0.80 | 0.21 | 0.37 | 0.46 | 0.15 |
| V6 | -0.31 | -0.14 | -0.32 | -0.48 | 0.80 | 1.38 | 0.63 | 0.22 | 0.09 | -0.37 |
| V7 | 0.36 | 0.52 | 0.29 | 0.35 | 0.21 | 0.63 | 1.61 | -0.53 | -0.34 | -0.71 |
| V8 | -1.21 | -1.78 | -0.92 | -1.61 | 0.37 | 0.22 | -0.53 | 1.92 | 1.81 | 1.37 |
| V9 | -1.27 | -1.81 | -1.11 | -1.83 | 0.46 | 0.09 | -0.34 | 1.81 | 2.17 | 1.56 |
| V10 | -0.90 | -1.54 | -0.87 | -1.39 | 0.15 | -0.37 | -0.71 | 1.37 | 1.56 | 1.82 |
b) Calcula la matriz de correlación para la batería de indicadores:
1. De forma “manual”
ZX<-scale(x = X6_2,center =TRUE)
ZX %>% head() %>%
kable(caption ="Matriz de Variables Estandarizadas:",
align = "c",
digits = 2) %>%
kable_material(html_font = "sans-serif")| V1 | V2 | V3 | V4 | V5 | V6 | V7 | V8 | V9 | V10 |
|---|---|---|---|---|---|---|---|---|---|
| 0.22 | -1.47 | 0.42 | 0.13 | -0.76 | -1.45 | 0.28 | 0.83 | 0.81 | 1.00 |
| 0.97 | 0.98 | 0.42 | 0.76 | -0.76 | -0.60 | 0.28 | -1.33 | -1.22 | 0.26 |
| -1.27 | -1.47 | -0.42 | -1.14 | 0.32 | -1.45 | -2.09 | 1.55 | 0.81 | 1.74 |
| -2.01 | -1.47 | -2.10 | -1.14 | 0.32 | 0.26 | -1.30 | 1.55 | 1.49 | 1.00 |
| -2.01 | -1.47 | -1.26 | -1.14 | 1.41 | 1.11 | 0.28 | 0.11 | 0.14 | -0.48 |
| 0.97 | 0.98 | 1.26 | 1.40 | -0.76 | -0.60 | 0.28 | -0.61 | -0.54 | -1.22 |
n_obs<-nrow(X6_2)
mat_R<-t(ZX)%*%ZX/(n_obs-1)
mat_R %>% kable(caption ="Cálculo de R(X) forma manual:" ,
align = "c",
digits = 2) %>%
kable_material(html_font = "sans-serif") %>%
kable_styling(bootstrap_options = c("striped", "hover"))| V1 | V2 | V3 | V4 | V5 | V6 | V7 | V8 | V9 | V10 | |
|---|---|---|---|---|---|---|---|---|---|---|
| V1 | 1.00 | 0.87 | 0.82 | 0.82 | -0.50 | -0.19 | 0.21 | -0.65 | -0.64 | -0.50 |
| V2 | 0.87 | 1.00 | 0.73 | 0.83 | -0.44 | -0.07 | 0.25 | -0.78 | -0.75 | -0.70 |
| V3 | 0.82 | 0.73 | 1.00 | 0.81 | -0.48 | -0.23 | 0.19 | -0.56 | -0.63 | -0.54 |
| V4 | 0.82 | 0.83 | 0.81 | 1.00 | -0.55 | -0.26 | 0.17 | -0.74 | -0.79 | -0.65 |
| V5 | -0.50 | -0.44 | -0.48 | -0.55 | 1.00 | 0.74 | 0.18 | 0.29 | 0.34 | 0.12 |
| V6 | -0.19 | -0.07 | -0.23 | -0.26 | 0.74 | 1.00 | 0.42 | 0.13 | 0.05 | -0.24 |
| V7 | 0.21 | 0.25 | 0.19 | 0.17 | 0.18 | 0.42 | 1.00 | -0.30 | -0.18 | -0.41 |
| V8 | -0.65 | -0.78 | -0.56 | -0.74 | 0.29 | 0.13 | -0.30 | 1.00 | 0.89 | 0.73 |
| V9 | -0.64 | -0.75 | -0.63 | -0.79 | 0.34 | 0.05 | -0.18 | 0.89 | 1.00 | 0.78 |
| V10 | -0.50 | -0.70 | -0.54 | -0.65 | 0.12 | -0.24 | -0.41 | 0.73 | 0.78 | 1.00 |
2. Usando el comando cor de R base
library(dplyr)
library(kableExtra)
cor(X6_2) %>%
kable(caption="Cálculo de R(X) a través de R base",
align = "c",
digits = 2) %>%
kable_material(html_font = "sans-serif") %>%
kable_styling(bootstrap_options = c("striped", "hover"))| V1 | V2 | V3 | V4 | V5 | V6 | V7 | V8 | V9 | V10 | |
|---|---|---|---|---|---|---|---|---|---|---|
| V1 | 1.00 | 0.87 | 0.82 | 0.82 | -0.50 | -0.19 | 0.21 | -0.65 | -0.64 | -0.50 |
| V2 | 0.87 | 1.00 | 0.73 | 0.83 | -0.44 | -0.07 | 0.25 | -0.78 | -0.75 | -0.70 |
| V3 | 0.82 | 0.73 | 1.00 | 0.81 | -0.48 | -0.23 | 0.19 | -0.56 | -0.63 | -0.54 |
| V4 | 0.82 | 0.83 | 0.81 | 1.00 | -0.55 | -0.26 | 0.17 | -0.74 | -0.79 | -0.65 |
| V5 | -0.50 | -0.44 | -0.48 | -0.55 | 1.00 | 0.74 | 0.18 | 0.29 | 0.34 | 0.12 |
| V6 | -0.19 | -0.07 | -0.23 | -0.26 | 0.74 | 1.00 | 0.42 | 0.13 | 0.05 | -0.24 |
| V7 | 0.21 | 0.25 | 0.19 | 0.17 | 0.18 | 0.42 | 1.00 | -0.30 | -0.18 | -0.41 |
| V8 | -0.65 | -0.78 | -0.56 | -0.74 | 0.29 | 0.13 | -0.30 | 1.00 | 0.89 | 0.73 |
| V9 | -0.64 | -0.75 | -0.63 | -0.79 | 0.34 | 0.05 | -0.18 | 0.89 | 1.00 | 0.78 |
| V10 | -0.50 | -0.70 | -0.54 | -0.65 | 0.12 | -0.24 | -0.41 | 0.73 | 0.78 | 1.00 |
3. Presenta la matriz de correlación de forma gráfica (las dos versiones propuestas en clase)
Usando el paquete PerformanceAnalytics
c) Realiza un análisis de componentes principales, y con base en los criterios vistos en clase:
library(dplyr)
library(factoextra)
library(kableExtra)
library(stargazer)
library(ggplot2)
options(scipen = 99999)
PC<-princomp(x = X6_2,cor = TRUE,fix_sign = FALSE)
factoextra::get_eig(PC) %>% kable(caption="Resumen de PCA",
align = "c",
digits = 2) %>%
kable_material(html_font = "sans-serif") %>%
kable_styling(bootstrap_options = c("hover"))| eigenvalue | variance.percent | cumulative.variance.percent | |
|---|---|---|---|
| Dim.1 | 5.70 | 57.01 | 57.01 |
| Dim.2 | 2.07 | 20.69 | 77.70 |
| Dim.3 | 0.72 | 7.20 | 84.91 |
| Dim.4 | 0.55 | 5.48 | 90.39 |
| Dim.5 | 0.32 | 3.16 | 93.54 |
| Dim.6 | 0.27 | 2.71 | 96.25 |
| Dim.7 | 0.15 | 1.46 | 97.72 |
| Dim.8 | 0.13 | 1.28 | 99.00 |
| Dim.9 | 0.07 | 0.68 | 99.68 |
| Dim.10 | 0.03 | 0.32 | 100.00 |
fviz_eig(PC,
choice = "eigenvalue",
barcolor = "red",
barfill = "red",
addlabels = TRUE,
)+labs(title = "Gráfico de Sedimentación",subtitle = "Usando princomp, con Autovalores")+
xlab(label = "Componentes")+
ylab(label = "Autovalores")+geom_hline(yintercept = 1)fviz_eig(PC,
choice = "variance",
barcolor = "green",
barfill = "green",
addlabels = TRUE,
)+labs(title = "Gráfico de Sedimentación",
subtitle = "Usando princomp, con %Varianza Explicada")+
xlab(label = "Componentes")+
ylab(label = "%Varianza")a. ¿Cuántas Componentes habría que retener?
-Según el criterio de porcentaje acumulado de la varianza o de los 3/4 o del 75% se deben retener 2 componentes ya que las dos componentes explican más del 75% de la información original o de la varianza
-Según el criterio de la raíz latente solo se deben retener aquellos componentes cuyo autovalor sea superior a uno o que sea al menos 1, por tanto, según este criterio debemos de retener 2 componentes, ya que los autovalores de dichos componentes son mayores a 1.
-Según el criterio de elbow debemos de retener tres componentes, ya que el tercer componente se da el codo, además desde ese punto cambia el comportamiento de la curva.