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, un4 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.

Importacion de Datos

load("C:/Users/Walter Alemán/Desktop/UES VI/MAE/TAREA N7/6-2.RData")
library(dplyr)
library(kableExtra)

MAT_X<-X6_2
MAT_X %>% 
  head() %>% 
  kable(caption = "Matriz de informacion",
        align = "c",
        digits = 2) %>%
  kable_material(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hove"))

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 1:

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

1.1 De forma “manual”

library(dplyr)

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

XCENT<-apply(X=MAT_X, MARGIN = 2, CENTR_1)
XCENT %>% 
  head() %>% 
  kable(caption = "Matriz de Variables Centradas",
        align = "c",
        digits = 2) %>% 
  kable_material(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hove"))

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_O<-nrow(MAT_X)
MAT_V<-t(XCENT) %*% XCENT/(NV_O-1) 
MAT_V %>% 
  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", "hove"))

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

1.2 Usando el comando cov de R base

cov(MAT_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 2:

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

2.1 De forma “manual”

ZX<-scale(x = MAT_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", "hove"))

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(MAT_X)
MAT_R<-t(ZX) %*% ZX/(N_OBS-1)
MAT_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.2 Usando el comando cor de R base

cor(MAT_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

2.3 Presenta la matriz de correlación de forma gráfica (las dos versiones

propuestas en clase)

2.3.1 PerformanceAnalytics

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

2.3.2 Corrplot

library(corrplot)
library(Hmisc)

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

Literal 3:

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

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

Criterio de Raíz Latente: En el criterio de la Raiz latente conservamos aquellos compnentes que sean por lo menos uno o mayores a uno. Tomando como base la tabla 1 especificamente la tabla “eigenvalue” observamos que solo dos dimensiones cumplen este criterio la cuales son la dimension 1 (5,7) y dimension 2 (2,07), por lo tanto solo esas dos de deben retener.

Criterio del 75%: En este criterio debemos de conservar al menos un total del 75%, al entender esto y ubircarnos en la TABLA 1, solo notamos que dos diamensiones (dimension 1 y dimension 2) son las que cumplen este criterio (el cual es de 77.70%), por ende solo se tomaran en cuenta las dimensiones 1 y 2

Criterio de Elbow (Codo): Se basa en graficar la variación explicada (Grafico de Sedimentacion (Grafico 1))por cada número de clusters y elegir el punto donde la curva forma un “codo” o un cambio abrupto, 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.

Conclusion: 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.

3.2 Incluye las tablas y gráficos vistos en clase

3.2.1 Calculo manual de los componentes

Rx<-MAT_X %>% 
  as.matrix() %>% 
  rcorr() 

  Rx$r %>% 
  kable(caption="Matriz R(x)",
        align = "c",
        digits = 2) %>% 
  kable_material(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))

Matriz R(x)
	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

  Rx$P %>% 
  kable(caption="p-values de R(x)",
        align = "c",
        digits = 2) %>% 
  kable_material(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))

p-values de R(x)
	V1	V2	V3	V4	V5	V6	V7	V8	V9	V10
V1	NA	0.00	0.00	0.00	0.02	0.41	0.37	0.00	0.00	0.03
V2	0.00	NA	0.00	0.00	0.05	0.77	0.29	0.00	0.00	0.00
V3	0.00	0.00	NA	0.00	0.03	0.34	0.42	0.01	0.00	0.01
V4	0.00	0.00	0.00	NA	0.01	0.27	0.46	0.00	0.00	0.00
V5	0.02	0.05	0.03	0.01	NA	0.00	0.46	0.21	0.14	0.61
V6	0.41	0.77	0.34	0.27	0.00	NA	0.06	0.58	0.82	0.32
V7	0.37	0.29	0.42	0.46	0.46	0.06	NA	0.20	0.45	0.07
V8	0.00	0.00	0.01	0.00	0.21	0.58	0.20	NA	0.00	0.00
V9	0.00	0.00	0.00	0.00	0.14	0.82	0.45	0.00	NA	0.00
V10	0.03	0.00	0.01	0.00	0.61	0.32	0.07	0.00	0.00	NA

library(stargazer)

DESCOM<-eigen(Rx$r)

t(DESCOM$values) %>% 
  kable(caption="Autovalores de R(x)",
        align = "c",
        digits = 2) %>% 
  kable_classic_2(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))

Autovalores de R(x)
5.7	2.07	0.72	0.55	0.32	0.27	0.15	0.13	0.07	0.03

DESCOM$vectors %>% 
  kable(caption="Autovectores de R(x)",
        align = "c",
        digits = 2) %>% 
  kable_classic_2(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))

Autovectores de R(x)
-0.37	-0.07	-0.31	-0.34	0.38	-0.13	0.05	0.14	0.67	-0.10
-0.39	0.04	-0.04	-0.19	0.28	-0.47	-0.33	-0.06	-0.48	0.41
-0.35	-0.08	-0.32	-0.36	-0.31	0.56	-0.11	0.34	-0.32	-0.09
-0.39	-0.08	-0.02	-0.09	-0.14	0.12	0.26	-0.85	-0.03	-0.11
0.22	0.50	0.18	-0.30	0.34	0.50	-0.26	-0.23	0.12	0.27
0.08	0.63	0.00	-0.40	-0.13	-0.33	0.38	0.09	-0.18	-0.36
-0.12	0.47	-0.63	0.57	0.04	0.07	0.08	-0.02	0.00	0.16
0.36	-0.11	-0.33	-0.34	-0.47	-0.17	0.10	-0.10	0.19	0.58
0.37	-0.10	-0.43	-0.10	0.03	-0.14	-0.56	-0.28	-0.08	-0.49
0.32	-0.32	-0.27	-0.11	0.56	0.15	0.51	-0.01	-0.35	0.04

3.2.2 Resumen de PCA (TABLA 1)

library(factoextra)
library(ggplot2)

options(scipen = 99999)
PC<-princomp(x = MAT_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 = "red",
         barfill = "red",
         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 = "green",
         barfill = "green",
         addlabels = TRUE,
         )+labs(title = "Grafico de Sedimentacion (Grafico 2)",
                subtitle = "Usando princomp, con %Varianza Explicada")+
  xlab(label = "Componentes")+
  ylab(label = "%Varianza")

Guía de trabajo de Componentes Principales_AT21006

Walter Orlando Alemán Turcios

2023-10-26