Ejercicio

Ejercicio: Una empresa especializada en el diseño de automóviles de turismo desea estudiar cuáles son los deseos del público que compra automóviles. Para ello diseña una encuesta con 10 preguntas donde se le pide a cada uno de los 20 encuestados que valore de 1 a 5 si una característica es o no muy importante. Los encuestados deberán contestar con un 5 si la característica es muy importante, un 4 si es importante, un 3 si tiene regular importancia, un 2 si es poco importante y un 1 si no es nada importante. Las 10 características (V1 a V10) a valorar son: precio, financiación, consumo, combustible, seguridad, confort, capacidad, prestaciones, modernidad y aerodinámica.

El fichero 6-2.RData recoge los datos: https://drive.google.com/file/d/1erKacIWnLWtctaHzP-WXRe4cIH_9yRFs/view?usp=sharing

Importación de Datos

library(dplyr)
library(kableExtra)
load("C:/Users/User/Desktop/Guia de trabajo componentes principales/Salvador Antonio Figueroa Gonzalez - 6-2 (1).RData")

matriz_x<-X6_2
matriz_x %>% 
  head() %>% 
  kable(caption="Matriz de Informacion",
        align = "c",
        digits = 2) %>% 
  kable_material(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))
Matriz de Informacion
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

Literal A

Calcula la matriz de varianza covarianza para la batería de indicadores:

1. De forma “manual”

centrado<-function(x){
  x-mean(x)
}

xcentrada<-apply(X=matriz_x, MARGIN = 2, centrado)
xcentrada %>% 
  head() %>% 
  kable(caption="Matriz de Variables centradas",
        align = "c",
        digits = 2) %>% 
  kable_material(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))
Matriz de Variables centradas
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 
nv_obs<-nrow(matriz_x)
matriz_V<-t(xcentrada)%*%xcentrada/(nv_obs-1)
matriz_V %>% 
  head() %>% 
  kable(caption="Calculo de V(x) de forma Manual",
        align = "c",
        digits = 2) %>% 
  kable_material(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))
Calculo de V(x) de forma Manual
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

2. Usando el comando cov de R base.

cov(matriz_x) %>% 
  kable(caption="Calculo de V(x) usando el comando cov de R base",
        align = "c",
        digits = 2) %>% 
  kable_material(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))
Calculo de V(x) usando el comando cov de R base
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

Literal B

Calcula la matriz de correlación para la batería de indicadores:

1. De forma “manual”

Zx<-scale(x=matriz_x, center = TRUE)
Zx %>% 
  head() %>% 
  kable(caption="Matriz de Variables Estandarizadas",
        align = "c",
        digits = 2) %>% 
  kable_material(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))
Matriz de Variables Estandarizadas
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 
nr_obs<-nrow(matriz_x)
matriz_R<-t(Zx)%*%Zx/(nr_obs-1)
matriz_R %>% 
  kable(caption="Calculo de R(x) de forma Manual",
        align = "c",
        digits = 2) %>% 
  kable_material(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))
Calculo de R(x) de forma Manual
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

cor(matriz_x) %>% 
  kable(caption="Calculo de R(x) usando el comando cor de R base",
        align = "c",
        digits = 2) %>% 
  kable_material(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))
Calculo de R(x) usando el comando cor de R base
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

library(PerformanceAnalytics)
chart.Correlation(as.matrix(matriz_x), histogram = TRUE, pch=12)

Usando el paquete corrplot

library(corrplot)
library(Hmisc)
Matriz_R<-rcorr(as.matrix(matriz_x))
corrplot(Matriz_R$r,
         p.mat = Matriz_R$r,
         type = "upper",
         tl.col = "black",
         tl.srt = 20,
         pch.col = "blue",
         insig = "p-value",
         sig.level = -1,
         col = terrain.colors(100) #(grDevices)
         )

Literal C

Realiza un análisis de componentes principales, y con base en los criterios vistos en clase:

a. ¿Cuántas Componentes habría que retener?

-Criterio del 75%: debemos de retener tantas dimensiones que expliquen al menos el 75%. Tomando de base la Tabla 1 de Resumen de PCA, hasta la dimensión 2 nos permite tener 77.70%, por lo tanto se debe de tomar la Dimensión 1 y Dimensión 2.

-Criterio de Raíz Latente: debemos de retener aquellos componentes que sean por lo menos uno o mayores a uno. Tomando de base la Tabla 1 de Resumen de PCA, la Dimensión 1 tiene un eigenvalue de 5.70 y la Dimensión 2 tiene un eigenvalue de 2.07, solo esas dos dimensiones tienen valores superiores a uno por lo tanto solo esas dos de deben retener.

-Criterio de Elbow: se tomara la cantidad de dimensiones exactamente donde ocurre el codo. Tomando de base el Grafico 1 de Sedimentación, el codo se da en la Dimensión 3 de 0.7, por lo tanto se debe de retener la Dimensión 1, Dimensión 2 y Dimensión 3.

-Con los 3 criterios podemos llegar a la conclusión que los componentes a retener serian 2 debido a que el criterio del 75% y el criterio de Raíz latente coinciden con retener la Dimensión 1 y Dimensión 2, mientras con el criterio de Elbow se debe de retener hasta la Dimensión 3.

b. Incluye las tablas y gráficos vistos en clase.

# Calculo usando R

library(factoextra)
library(ggplot2)
options(scipen = 99999)
PC<-princomp(x = matriz_x, cor = TRUE, fix_sign = FALSE)
factoextra::get_eig(PC) %>% 
  kable(caption="Resumen de PCA (Tabla 1)",
        align = "c",
        digits = 2) %>% 
  kable_material(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))
Resumen de PCA (Tabla 1)
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 = "blue",
         barfill = "blue",
         addlabels = TRUE,
         )+labs(title = "Grafico de Sedimentacion (Grafico 1)",
                subtitle = "Usando princomp, con Autovalores")+
  xlab(label = "Componentes")+
  ylab(label = "Autovalores")+
  geom_hline(yintercept = 1)

fviz_eig(PC,
         choice = "variance",
         barcolor = "orange",
         barfill = "orange",
         addlabels = TRUE,
         )+labs(title = "Grafico de Sedimentacion (Grafico 2)",
                subtitle = "Usando princomp, con %Varianza Explicada")+
  xlab(label = "Componentes")+
  ylab(label = "%Varianza")