`
Ejercicio N°2 [20%]
Una empresa especializada en el diseño de automoviles de turismo desea estudiar cuales son los deseos del publico que compra automoviles. 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 caracteristica es o no muy importante. Los encuestados deberán contestar con un 5 si la caracteristica es muy importante, un 4 si es importante, un 3 si tiene regular importancia, un 2 si es poco importante y 1 si no es nada importante.
Las 10 caracteristicas (V1 a V10) a valorar son: precio, financiacion, consumo, combustible, seguridad, confort, capacidad, prestaciones, modernidad y aerodinamica. El fichero 6-2 recoge los datos a ser utilizados.
Realiza un análisis factorial que permita extraer unos factores adecuados a los datos que resuman correctamente la información que contienen. Proponga una solucion adecuada de la cantidad de factores a retener y justifique su respuesta, sobre la base de las pruebas de validación del análisis factorial, estudiadas en clase e indique las variables que se agruparían en cada factor.
#Cargamos la base de datos.
load("C:/Users/Usuario/Desktop/PARCIAL_2_MAE/6-2.RData")Matriz de Información
library(kableExtra)
library(dplyr)
library(magrittr)
mat_X<-X6_2
head(mat_X) %>%
kable(
col.names = c(
"precio",
"financiacion",
"consumo",
"combustible",
"seguridad",
"confort",
"capacidad",
"prestaciones",
"modernidad",
"aerodinamica"
),
align = "c",
digits = 2
) %>%
kable_classic(html_font = "Times New Roman",
font_size = 14) %>%
row_spec(0, bold = T) %>%
footnote(general_title = "Fuente:")| 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 |
library(PerformanceAnalytics)
chart.Correlation(as.matrix(mat_X),histogram = TRUE,pch=12)
## Prueba KMO
#KMO
library(rela)
KMO<-paf(as.matrix(mat_X))$KMO
print(KMO)## [1] 0.70012Prueba de Barlett
library(psych)
options(scipen = 99999)
Barlett<-cortest.bartlett(mat_X)
print(Barlett)## $chisq
## [1] 163.47
##
## $p.value
## [1] 0.0000000000000023628
##
## $df
## [1] 45Analisis Factorial
library(FactoMineR)
library(factoextra)
library(kableExtra)
Rx<-cor(mat_X)
PC<-princomp(x = mat_X,cor = TRUE,fix_sign = FALSE)
variables_pca<-get_pca_var(PC)
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 |
Gráfico de Sedimentación
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)
Rotación de la Solución
library(corrplot)
#Modelo de 3 Factores (Rotada)
numero_de_factores<-3
modelo_factores<-principal(r = Rx,
nfactors = numero_de_factores,
covar = FALSE,
rotate = "varimax")
modelo_factores## Principal Components Analysis
## Call: principal(r = Rx, nfactors = numero_de_factores, rotate = "varimax",
## covar = FALSE)
## Standardized loadings (pattern matrix) based upon correlation matrix
## RC1 RC2 RC3 h2 u2 com
## V1 0.63 -0.54 0.41 0.85 0.148 2.7
## V2 0.81 -0.34 0.31 0.86 0.142 1.7
## V3 0.59 -0.54 0.39 0.79 0.208 2.7
## V4 0.78 -0.48 0.22 0.88 0.117 1.9
## V5 -0.22 0.88 0.08 0.83 0.175 1.1
## V6 0.05 0.84 0.38 0.85 0.151 1.4
## V7 0.18 0.26 0.85 0.82 0.182 1.3
## V8 -0.91 0.13 -0.07 0.85 0.154 1.1
## V9 -0.95 0.12 0.00 0.92 0.075 1.0
## V10 -0.88 -0.15 -0.23 0.84 0.157 1.2
##
## RC1 RC2 RC3
## SS loadings 4.58 2.52 1.39
## Proportion Var 0.46 0.25 0.14
## Cumulative Var 0.46 0.71 0.85
## Proportion Explained 0.54 0.30 0.16
## Cumulative Proportion 0.54 0.84 1.00
##
## Mean item complexity = 1.6
## Test of the hypothesis that 3 components are sufficient.
##
## The root mean square of the residuals (RMSR) is 0.06
##
## Fit based upon off diagonal values = 0.99Variables incluidas en cada factor.
correlaciones_modelo<-variables_pca$coord
rotacion<-varimax(correlaciones_modelo[,1:numero_de_factores])
correlaciones_modelo_rotada<-rotacion$loadings
corrplot(correlaciones_modelo_rotada[,1:numero_de_factores],
is.corr = FALSE,
method = "square",
addCoef.col="black",
number.cex = 0.75)
La dimensión 1 está representada por las variables: V1, V2, V3
La dimensión 2 está representada por las variables: V5, V6 y V7
La dimensión 2 está representada por las variables:V4, V8, V9 y V10
library(kableExtra)
cargas<-rotacion$loadings[1:8,1:numero_de_factores]
ponderadores<-prop.table(apply(cargas^2,MARGIN = 2,sum))
t(ponderadores) %>% kable(caption="Ponderadores de los Factores Extraídos",
align = "c",
digits = 2) %>%
kable_material(html_font = "sans-serif") %>%
kable_styling(bootstrap_options = c("striped", "hover"))| Dim.1 | Dim.2 | Dim.3 |
|---|---|---|
| 0.43 | 0.37 | 0.2 |
contribuciones<-apply(cargas^2,MARGIN = 2,prop.table)
contribuciones %>% kable(caption="Contribución de las variables en los Factores",
align = "c",
digits = 2) %>%
kable_material(html_font = "sans-serif") %>%
kable_styling(bootstrap_options = c("striped", "hover"))| Dim.1 | Dim.2 | Dim.3 | |
|---|---|---|---|
| V1 | 0.14 | 0.12 | 0.13 |
| V2 | 0.22 | 0.05 | 0.07 |
| V3 | 0.12 | 0.12 | 0.12 |
| V4 | 0.21 | 0.09 | 0.03 |
| V5 | 0.02 | 0.31 | 0.00 |
| V6 | 0.00 | 0.28 | 0.11 |
| V7 | 0.01 | 0.03 | 0.54 |
| V8 | 0.28 | 0.01 | 0.00 |