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.

Realizar un análisis de Componentes Principales, una solución adecuada de la cantidad de Componentes a retener y justifique su respuesta.

Carga de datos

# El fichero 6-2.RData recoge los datos: https://drive.google.com/file/d/1erKacIWnLWtctaHzP-WXRe4cIH_9yRFs/view?usp=sharing
library(dplyr)
library(kableExtra)
load("C:/Users/erick/OneDrive/Escritorio/RESPALDO/UES/Ciclo II - 2023/MAE118/tarea_7_RF21001/RF21001- 6-2.RData") 
X6_2 %>% head() %>% 
  kable(caption ="Matriz de información:" ,align = "c",digits = 6) %>% 
  kable_material(html_font = "sans-serif")

Matriz de información:
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) Matriz de varianza-covarianza

1. Manual

library(dplyr)
library(kableExtra)
#Cálculo de matriz de excesos
centrado<-function(x){
  x-mean(x)
}
Xcentrada<-apply(X6_2,MARGIN = 2,centrado)
Xcentrada %>% head() %>% 
  kable(caption ="Matriz de Variables centradas:",
        align = "c",
        digits = 2) %>% 
  kable_material(html_font = "sans-serif")

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

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"))

Cálculo de V(X) 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
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. Con 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"))

Cálculo de V(X) a través 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

b) Matriz de correlación

1. Manual

Zx<-scale(X6_2,center =TRUE) #"scale" divide cada columna entre la desv. estándar, y con el comando "center" le decimos que le reste la media 
Zx %>% head() %>% 
  kable(caption ="Matriz de Variables Estandarizadas:",
        align = "c",
        digits = 2) %>% 
  kable_material(html_font = "sans-serif")

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

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"))

Cálculo de R(X) 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. Con 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"))

Cálculo de R(X) a través 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. R(x) gráfica

Primera versión

library(PerformanceAnalytics)
chart.Correlation(as.matrix(X6_2),histogram = TRUE,pch=18)

Segunda versión

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

c) Análisis de componentes principales

¿Cuántas componentes habría que retener?

Según el criterio del porcentaje acumulado de la varianza o criterio de los 3/4 debemos retener 2 componentes, debido a que estas explican el 77.10% de la varianza de los datos originales.
Según el criterio de la raíz latente debemos retener 2 componentes ya que ambas componentes poseen un autovalor superior a 1.
Según el criterio de “elbow” debemos retener 3 componentes, ya que es en la tercera componente donde se observa el punto de inflexión en la trayectoria de la gráfica.

Siguiendo el principio de parsimonia lo más adecuado sería retener 2 componentes para mantener el modelo lo más simplificado posible.

Tablas y gráficos

# Calculamos autovectores y autovectores a partir de R(x) (descomposición)
library(dplyr)
library(factoextra)
library(kableExtra)
library(stargazer)
library(ggplot2)
options(scipen = 99999)
PC<-princomp(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"))

Resumen de PCA
	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 = "black",
         barfill = "red",
         addlabels = TRUE, 
       )+labs(title = "Grafico de Sedimentacion",subtitle = "Usando componentes principales, con Autovalores")+
  xlab(label = "Componentes")+
  ylab(label = "Autovalores")+geom_hline(yintercept = 1)

Tarea 7 - Componentes Principales

ROJAS FLORES, ERICK RODOLFO - RF21001

Carga de datos

a) Matriz de varianza-covarianza

1. Manual

2. Con R base

b) Matriz de correlación

1. Manual

2. Con R base

3. R(x) gráfica

c) Análisis de componentes principales

¿Cuántas componentes habría que retener?

Tablas y gráficos

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

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

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