PARCIAL 2 MAE 2022-EJERCICIO 2

• CARGA DE LA DATA

load("C:/Users/Familia/Desktop/METODOS UNIDAD 2 (INDICADOR SINTETICO)/6-2.RData")

library(readr)
library(dplyr)
library(kableExtra)

#NOMBRES DE VARIABLES

colnames(X6_2)<-c("precio","financiacion","consumo","combustible","seguridad","confort","capacidad","prestaciones","modernidad","aerodinamica")

X6_2 %>% 
  kable(caption ="Matriz de información:" ,align = "c",digits = 6) %>% 
  kable_material(html_font = "sans-serif")

Matriz de información:

precio	financiacion	consumo	combustible	seguridad	confort	capacidad	prestaciones	modernidad	aerodinamica
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
4	5	4	4	2	2	5	1	1	1
3	2	3	1	4	4	2	5	5	5
4	4	4	3	4	4	3	1	1	1
5	5	5	5	2	2	3	2	2	2
2	2	2	1	5	4	4	3	4	3
4	4	5	5	4	5	5	2	1	2
3	2	2	1	4	5	4	4	3	3
5	5	4	4	5	4	4	1	2	2
4	3	3	1	4	4	5	3	4	4
5	5	4	4	4	5	4	2	1	1
4	4	5	2	4	5	5	4	4	2
5	5	4	4	2	2	1	2	2	3
3	3	2	2	4	4	5	4	5	4
5	5	4	4	4	5	4	3	2	1

• Cálculo de V(X):

cov(X6_2) %>% 
  kable(caption="Cálculo de V(X) Parcial 2 MAE",
        align = "c",
        digits = 2) %>% 
  kable_material(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))

Cálculo de V(X) Parcial 2 MAE

	precio	financiacion	consumo	combustible	seguridad	confort	capacidad	prestaciones	modernidad	aerodinamica
precio	1.80	1.92	1.32	1.73	-0.62	-0.31	0.36	-1.21	-1.27	-0.90
financiacion	1.92	2.67	1.42	2.14	-0.66	-0.14	0.52	-1.78	-1.81	-1.54
consumo	1.32	1.42	1.42	1.53	-0.53	-0.32	0.29	-0.92	-1.11	-0.87
combustible	1.73	2.14	1.53	2.48	-0.80	-0.48	0.35	-1.61	-1.83	-1.39
seguridad	-0.62	-0.66	-0.53	-0.80	0.85	0.80	0.21	0.37	0.46	0.15
confort	-0.31	-0.14	-0.32	-0.48	0.80	1.38	0.63	0.22	0.09	-0.37
capacidad	0.36	0.52	0.29	0.35	0.21	0.63	1.61	-0.53	-0.34	-0.71
prestaciones	-1.21	-1.78	-0.92	-1.61	0.37	0.22	-0.53	1.92	1.81	1.37
modernidad	-1.27	-1.81	-1.11	-1.83	0.46	0.09	-0.34	1.81	2.17	1.56
aerodinamica	-0.90	-1.54	-0.87	-1.39	0.15	-0.37	-0.71	1.37	1.56	1.82

• Cálculo de R(X):

library(dplyr)
library(kableExtra)
cor(X6_2) %>% 
  kable(caption="Cálculo de R(X) Parcial 2 MAE",
        align = "c",
        digits = 2) %>% 
  kable_material(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))

Cálculo de R(X) Parcial 2 MAE

	precio	financiacion	consumo	combustible	seguridad	confort	capacidad	prestaciones	modernidad	aerodinamica
precio	1.00	0.87	0.82	0.82	-0.50	-0.19	0.21	-0.65	-0.64	-0.50
financiacion	0.87	1.00	0.73	0.83	-0.44	-0.07	0.25	-0.78	-0.75	-0.70
consumo	0.82	0.73	1.00	0.81	-0.48	-0.23	0.19	-0.56	-0.63	-0.54
combustible	0.82	0.83	0.81	1.00	-0.55	-0.26	0.17	-0.74	-0.79	-0.65
seguridad	-0.50	-0.44	-0.48	-0.55	1.00	0.74	0.18	0.29	0.34	0.12
confort	-0.19	-0.07	-0.23	-0.26	0.74	1.00	0.42	0.13	0.05	-0.24
capacidad	0.21	0.25	0.19	0.17	0.18	0.42	1.00	-0.30	-0.18	-0.41
prestaciones	-0.65	-0.78	-0.56	-0.74	0.29	0.13	-0.30	1.00	0.89	0.73
modernidad	-0.64	-0.75	-0.63	-0.79	0.34	0.05	-0.18	0.89	1.00	0.78
aerodinamica	-0.50	-0.70	-0.54	-0.65	0.12	-0.24	-0.41	0.73	0.78	1.00

• Version Grafica de R(X):

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

library(corrplot)
library(grDevices)
library(Hmisc)
matriz_R<-rcorr(as.matrix(X6_2))
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))

• ANALISIS FACTORIAL

library(factoextra)
library(stargazer)
library(ggplot2)
options(scipen = 99999)
PC_parcial<-princomp(x = X6_2,cor = TRUE,fix_sign = FALSE)
factoextra::get_eig(PC_parcial) %>% 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

• Grafico de Sedimentacion

fviz_eig(PC_parcial,
         choice = "eigenvalue",
         barcolor = "yellow",
         barfill = "skyblue",
         addlabels = TRUE, 
       )+labs(title = "Gráfico de Sedimentación",subtitle = "Usando princomp, con Autovalores")+
  xlab(label = "Componentes")+
  ylab(label = "Autovalores")+geom_hline(yintercept = 1)

#visualizado a travez del grafico de sedimentacion los factores que deberian retenerse tienen que ser 2 ya que en su conjunto contienen o explican el 77.70% de la varianza acumulada como se ve en el resumen de PCA,cumpliendo con el criterio que sea superior al 75%.

• Correlacion de las variables con los componentes.

library(dplyr)
library(factoextra)
library(kableExtra)
variables_pca_parcial<-get_pca_var(PC_parcial)
variables_pca_parcial$coord%>% 
  kable(caption="Correlación de X con las componentes, usando factoextra",
        align = "c",
        digits = 2) %>% 
  kable_material(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))

Correlación de X con las componentes, usando factoextra

	Dim.1	Dim.2	Dim.3	Dim.4	Dim.5	Dim.6	Dim.7	Dim.8	Dim.9	Dim.10
precio	-0.88	-0.10	-0.27	-0.25	0.21	-0.07	0.02	0.05	0.18	-0.02
financiacion	-0.92	0.06	-0.03	-0.14	0.16	-0.24	-0.13	-0.02	-0.13	0.07
consumo	-0.84	-0.12	-0.27	-0.27	-0.17	0.29	-0.04	0.12	-0.08	-0.02
combustible	-0.93	-0.11	-0.02	-0.06	-0.08	0.06	0.10	-0.30	-0.01	-0.02
seguridad	0.53	0.72	0.15	-0.22	0.19	0.26	-0.10	-0.08	0.03	0.05
confort	0.20	0.90	0.00	-0.29	-0.07	-0.17	0.15	0.03	-0.05	-0.06
capacidad	-0.28	0.67	-0.54	0.42	0.02	0.04	0.03	-0.01	0.00	0.03
prestaciones	0.86	-0.16	-0.28	-0.25	-0.26	-0.09	0.04	-0.04	0.05	0.10
modernidad	0.88	-0.14	-0.37	-0.07	0.02	-0.07	-0.21	-0.10	-0.02	-0.09
aerodinamica	0.77	-0.45	-0.23	-0.08	0.31	0.08	0.19	0.00	-0.09	0.01

• Representacion de las variables con los factores

library(corrplot)
corrplot(variables_pca_parcial$coord,is.corr = FALSE,method = "square",addCoef.col="black",number.cex = 0.75)

• Rotacion para el modelo de 2 factores (utilizando “Varimax”)

library(psych)
#Modelo de 2 Factores (Rotado)
numero_de_factores<-2
modelo_2factores_parcial<-principal(r = matriz_R$r,
                             nfactors = numero_de_factores,
                             covar = FALSE,
                             rotate = "varimax")
modelo_2factores_parcial

## Principal Components Analysis
## Call: principal(r = matriz_R$r, nfactors = numero_de_factores, rotate = "varimax", 
##     covar = FALSE)
## Standardized loadings (pattern matrix) based upon correlation matrix
##                RC1   RC2   h2   u2 com
## precio        0.87 -0.18 0.78 0.22 1.1
## financiacion  0.93 -0.02 0.86 0.14 1.0
## consumo       0.83 -0.19 0.72 0.28 1.1
## combustible   0.92 -0.20 0.88 0.12 1.1
## seguridad    -0.46  0.77 0.80 0.20 1.6
## confort      -0.11  0.91 0.85 0.15 1.0
## capacidad     0.34  0.64 0.53 0.47 1.5
## prestaciones -0.87 -0.07 0.77 0.23 1.0
## modernidad   -0.89 -0.05 0.79 0.21 1.0
## aerodinamica -0.80 -0.38 0.79 0.21 1.4
## 
##                        RC1  RC2
## SS loadings           5.67 2.10
## Proportion Var        0.57 0.21
## Cumulative Var        0.57 0.78
## Proportion Explained  0.73 0.27
## Cumulative Proportion 0.73 1.00
## 
## Mean item complexity =  1.2
## Test of the hypothesis that 2 components are sufficient.
## 
## The root mean square of the residuals (RMSR) is  0.07 
## 
## Fit based upon off diagonal values = 0.98

correlaciones_modelo<-variables_pca_parcial$coord
correlaciones_modelo_rotada<-varimax(
  correlaciones_modelo[,1:numero_de_factores])$loadings

corrplot(correlaciones_modelo_rotada[,1:numero_de_factores],
         is.corr = FALSE,
         method = "square",
         addCoef.col="purple",
         number.cex = 0.75)

#Al hacer uso de la rotacion “Varimax” las variables quedan representadas en los factores del siguiente modo:

#Factor 1[precio,financiacion,consumo,combustible,prestaciones,modernidad,aerodinamica]

#Factor 2[seguridad,confort,capacidad]

#Pese a que “capacidad” no cumple el criterio de representacion en ambos factores queda mejor representada en el factor 2.

• VERIFICACION DE SUPUESTOS

#Prueba de Barlett

library(psych)
options(scipen = 99999)
Barlett<-cortest.bartlett(X6_2)

print(Barlett)

## $chisq
## [1] 163.4656
## 
## $p.value
## [1] 0.000000000000002362835
## 
## $df
## [1] 45

#Prueba KMO

library(psych)
KMO<-KMO(X6_2)
print(KMO)

## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = X6_2)
## Overall MSA =  0.7
## MSA for each item = 
##       precio financiacion      consumo  combustible    seguridad      confort 
##         0.82         0.74         0.84         0.93         0.55         0.32 
##    capacidad prestaciones   modernidad aerodinamica 
##         0.37         0.62         0.68         0.84

library(rela)
KMO_total<-paf(as.matrix(X6_2))$KMO
print(KMO_total)

## [1] 0.70012

#Las pruebas de Bartlett y KMO hechas en nuestro modelo cumplen con los criterios de cada una, dando a entender que si existe multicolinealidad en los datos de la matriz de informacion.