Ejercicio P2
MONICA MOLINA MARTINEZ-MM18046
2022-10-27
Ejercicio 2. Una empresa especializada en el diseño de automóviles de turismo desea estudiar cuales son los deseos del publico 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 las caracterÃstica es muy importante , 4 si es importante, 3 si tiene regular importancia, un 2 si es poco importante y 1 si no es importante.
Realiza un análisis factorial que permita extraer unos factores adecuados a los datos que resuman correctamente la información que contienen. Proponga una solución adecuada de la cantidad de factores a retener y justifique su respuesta, sobre la base de las pruebas de validación de análisis factorial, estudiadas en clase e indique las variables que se agruparÃan en cada factor
Carga de datos
load("C:/Users/MOLINA/OneDrive/Escritorio/ARCHIVOS DE R/6-2.RData")
colnames(X6_2)<-c("precio","financiacion","consumo","combustible","seguridad","confort","capacidad","prestaciones","modernidad","aerodinamica")
X6_2## precio financiacion consumo combustible seguridad confort capacidad
## 1 4 1 4 3 3 2 4
## 2 5 5 4 4 3 3 4
## 3 2 1 3 1 4 2 1
## 4 1 1 1 1 4 4 2
## 5 1 1 2 1 5 5 4
## 6 5 5 5 5 3 3 4
## 7 4 5 4 4 2 2 5
## 8 3 2 3 1 4 4 2
## 9 4 4 4 3 4 4 3
## 10 5 5 5 5 2 2 3
## 11 2 2 2 1 5 4 4
## 12 4 4 5 5 4 5 5
## 13 3 2 2 1 4 5 4
## 14 5 5 4 4 5 4 4
## 15 4 3 3 1 4 4 5
## 16 5 5 4 4 4 5 4
## 17 4 4 5 2 4 5 5
## 18 5 5 4 4 2 2 1
## 19 3 3 2 2 4 4 5
## 20 5 5 4 4 4 5 4
## prestaciones modernidad aerodinamica
## 1 4 4 4
## 2 1 1 3
## 3 5 4 5
## 4 5 5 4
## 5 3 3 2
## 6 2 2 1
## 7 1 1 1
## 8 5 5 5
## 9 1 1 1
## 10 2 2 2
## 11 3 4 3
## 12 2 1 2
## 13 4 3 3
## 14 1 2 2
## 15 3 4 4
## 16 2 1 1
## 17 4 4 2
## 18 2 2 3
## 19 4 5 4
## 20 3 2 1Normalizacion
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(tidyr)
norm_directa<-function(x){(x-min(x))/(max(x)-min(x))}
norm_inversa<-function(x){(max(x)-x)/(max(x)-min(x))}
## Eliminando valores nulos
X6_2 %>% replace_na(list(V1=0,V2B=0,V3F=0,V4=0,V5=0,V6=0,V7=0,V8=0,V9=0,V10=0))->X6_2
## Seleccionando variables con correlación positiva con desarrollo de economias
X6_2 %>%
select("precio","financiacion","consumo","combustible","seguridad","confort","capacidad","prestaciones","modernidad","aerodinamica") %>%
apply(MARGIN = 2,FUN = norm_directa) %>% as.data.frame()->var_corr_positiva
## Seleccionando variables con correlación negativa con desarrollo de economias
X6_2 %>%
select("consumo","confort") %>%
apply(MARGIN = 2,FUN = norm_inversa) %>% as.data.frame()->var_corr_negativa
## Juntando y reordenando las variables
var_corr_positiva %>%
bind_cols(var_corr_negativa) %>%
select("precio","financiacion","combustible","seguridad","capacidad","prestaciones","modernidad","aerodinamica")->data_X6_2_normalizados## New names:
## • `consumo` -> `consumo...3`
## • `confort` -> `confort...6`
## • `consumo` -> `consumo...11`
## • `confort` -> `confort...12`head(data_X6_2_normalizados)## precio financiacion combustible seguridad capacidad prestaciones modernidad
## 1 0.75 0 0.50 0.3333333 0.75 0.75 0.75
## 2 1.00 1 0.75 0.3333333 0.75 0.00 0.00
## 3 0.25 0 0.00 0.6666667 0.00 1.00 0.75
## 4 0.00 0 0.00 0.6666667 0.25 1.00 1.00
## 5 0.00 0 0.00 1.0000000 0.75 0.50 0.50
## 6 1.00 1 1.00 0.3333333 0.75 0.25 0.25
## aerodinamica
## 1 0.75
## 2 0.50
## 3 1.00
## 4 0.75
## 5 0.25
## 6 0.00Matriz de Covarianza
cov(X6_2)## precio financiacion consumo combustible seguridad
## precio 1.8000000 1.9157895 1.3157895 1.7263158 -0.6210526
## financiacion 1.9157895 2.6736842 1.4210526 2.1368421 -0.6631579
## consumo 1.3157895 1.4210526 1.4210526 1.5263158 -0.5263158
## combustible 1.7263158 2.1368421 1.5263158 2.4842105 -0.8000000
## seguridad -0.6210526 -0.6631579 -0.5263158 -0.8000000 0.8526316
## confort -0.3052632 -0.1368421 -0.3157895 -0.4842105 0.8000000
## capacidad 0.3631579 0.5157895 0.2894737 0.3473684 0.2052632
## prestaciones -1.2052632 -1.7789474 -0.9210526 -1.6105263 0.3736842
## modernidad -1.2736842 -1.8105263 -1.1052632 -1.8315789 0.4631579
## aerodinamica -0.9000000 -1.5368421 -0.8684211 -1.3894737 0.1526316
## confort capacidad prestaciones modernidad aerodinamica
## precio -0.30526316 0.3631579 -1.2052632 -1.27368421 -0.9000000
## financiacion -0.13684211 0.5157895 -1.7789474 -1.81052632 -1.5368421
## consumo -0.31578947 0.2894737 -0.9210526 -1.10526316 -0.8684211
## combustible -0.48421053 0.3473684 -1.6105263 -1.83157895 -1.3894737
## seguridad 0.80000000 0.2052632 0.3736842 0.46315789 0.1526316
## confort 1.37894737 0.6263158 0.2157895 0.09473684 -0.3736842
## capacidad 0.62631579 1.6078947 -0.5289474 -0.33684211 -0.7078947
## prestaciones 0.21578947 -0.5289474 1.9236842 1.81052632 1.3657895
## modernidad 0.09473684 -0.3368421 1.8105263 2.16842105 1.5578947
## aerodinamica -0.37368421 -0.7078947 1.3657895 1.55789474 1.8184211Matriz Rx
## Matriz de correlación
library(PerformanceAnalytics)## Loading required package: xts## Loading required package: zoo##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric##
## Attaching package: 'xts'## The following objects are masked from 'package:dplyr':
##
## first, last##
## Attaching package: 'PerformanceAnalytics'## The following object is masked from 'package:graphics':
##
## legendchart.Correlation(as.matrix(X6_2),histogram = TRUE,pch=12)## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
Pruebas KMO y Barlett
#KMO
library(rela)
KMO<-paf(as.matrix(data_X6_2_normalizados))$KMO
print(KMO)## [1] 0.78211#Prueba de Barlett
library(psych)
options(scipen = 99999)
Barlett<-cortest.bartlett(data_X6_2_normalizados)## R was not square, finding R from dataprint(Barlett)## $chisq
## [1] 119.55
##
## $p.value
## [1] 0.00000000000027825
##
## $df
## [1] 28Dado que al pasar la prueba KMO > 0.5 y el pvalue < 0.05, se concluye que se puede proceder al análisis factorial, porque existe multicolinealidad (correlacion entre variables) en los valores de la matriz de información.
library(FactoMineR)
library(factoextra)## Loading required package: ggplot2##
## Attaching package: 'ggplot2'## The following objects are masked from 'package:psych':
##
## %+%, alpha## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBalibrary(kableExtra)##
## Attaching package: 'kableExtra'## The following object is masked from 'package:dplyr':
##
## group_rowsRx<-cor(data_X6_2_normalizados)
PC<-princomp(x = data_X6_2_normalizados,cor = TRUE,fix_sign = FALSE)
variables_pca<-get_pca_var(PC)
factoextra::get_eig(PC) %>% kable(caption="Resumen PCA",
align = "c",
digits = 2) %>%
kable_material_dark(html_font = "sans-serif") %>%
kable_styling(bootstrap_options = c("hover"))| eigenvalue | variance.percent | cumulative.variance.percent | |
|---|---|---|---|
| Dim.1 | 5.01 | 62.67 | 62.67 |
| Dim.2 | 1.34 | 16.70 | 79.37 |
| Dim.3 | 0.67 | 8.38 | 87.75 |
| Dim.4 | 0.40 | 4.96 | 92.71 |
| Dim.5 | 0.26 | 3.20 | 95.91 |
| Dim.6 | 0.17 | 2.11 | 98.02 |
| Dim.7 | 0.10 | 1.26 | 99.28 |
| Dim.8 | 0.06 | 0.72 | 100.00 |
Grafico de sidementacion
fviz_eig(PC,
choice = "eigenvalue",
barcolor = "yellow",
barfill = "yellow",
addlabels = TRUE,
)+labs(title = "Gráfico de Sedimentación",subtitle = "Usando princomp, con Autovalores")+
xlab(label = "Componentes")+
ylab(label = "Autovalores")+geom_hline(yintercept = 1)
Analisis Factorial
## Cuantos valores deben retenerse
library(corrplot)## corrplot 0.92 loaded#Modelo de 2 Factores (Rotada)
numero_de_factores<-2
modelo_2_factores<-princomp( x = X6_2,
nfactors = numero_de_factores,
covar = FALSE,
rotate = "varimax")## Warning: In princomp.default(x = X6_2, nfactors = numero_de_factores, covar = FALSE,
## rotate = "varimax") :
## extra arguments 'nfactors', 'covar', 'rotate' will be disregardedprint(modelo_2_factores)## Call:
## princomp(x = X6_2, nfactors = numero_de_factores, covar = FALSE,
## rotate = "varimax")
##
## Standard deviations:
## Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7 Comp.8 Comp.9 Comp.10
## 3.30154 1.64066 1.09816 0.90043 0.74820 0.62514 0.51803 0.46996 0.34776 0.23037
##
## 10 variables and 20 observations.#Gráfico de aglomeración de las variables en los factores
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 = "circle",
addCoef.col="black",
number.cex = 0.75)