Análisis Factorial
Dr. Víctor Chung
26/11/2021
Ejemplo 1
Suponga que el investigador desea determinar qué beneficios buscan los consumidores al comprar un dentífrico. En centros comerciales se entrevistó a un muestra de 30 individuos. Se solicitó a los encuestados que utilizaran una escala de 7 puntos (1 = muy en desacuerdo, 7= muy de acuerdo), para expresar su grado de acuerdo o desacuerdo con los siguientes enunciados:
V1: Es importante comprar dentífricos que prevengan las caries. V2: Me gustan los dentífricos que dejan los dientes brillantes. V3: Un dentífrico tiene que fortalecer las encías. V4: Prefiero un dentífrico que refresque el aliento. V5: la prevención de las caries no es un beneficio importante ofrecido por los dentífricos. V6: La consideración más importante al comprar un dentífrico son los dientes bellos.
Packages
library("factoextra")## Loading required package: ggplot2## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBaDentrificos<-read.csv("Dentrificos.csv")
head(Dentrificos)## Prevencion Brillo Fortaleza Frescura No_Prevencion Belleza
## 1 7 3 6 4 2 4
## 2 1 3 2 4 5 4
## 3 6 2 7 4 1 3
## 4 4 5 4 6 2 5
## 5 1 2 2 3 6 2
## 6 6 3 6 4 2 4Análisis de Matriz de Correlación
correlacion<-cor(Dentrificos, method = "pearson")
correlacion## Prevencion Brillo Fortaleza Frescura No_Prevencion
## Prevencion 1.000000000 -0.05321785 0.87309020 -0.086162233 -0.857636627
## Brillo -0.053217850 1.00000000 -0.15502002 0.572212066 0.019745647
## Fortaleza 0.873090198 -0.15502002 1.00000000 -0.247787899 -0.777848036
## Frescura -0.086162233 0.57221207 -0.24778790 1.000000000 -0.006581882
## No_Prevencion -0.857636627 0.01974565 -0.77784804 -0.006581882 1.000000000
## Belleza 0.004168129 0.64046495 -0.01806881 0.640464946 -0.136402944
## Belleza
## Prevencion 0.004168129
## Brillo 0.640464946
## Fortaleza -0.018068814
## Frescura 0.640464946
## No_Prevencion -0.136402944
## Belleza 1.000000000library("corrplot")## corrplot 0.92 loadedcorrplot(correlacion, order="hclust")
KMO Test
library(psych)##
## Attaching package: 'psych'## The following objects are masked from 'package:ggplot2':
##
## %+%, alphaKMO(Dentrificos)## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = Dentrificos)
## Overall MSA = 0.66
## MSA for each item =
## Prevencion Brillo Fortaleza Frescura No_Prevencion
## 0.62 0.70 0.68 0.64 0.77
## Belleza
## 0.56Test de Esfericidad de Bartlett:
cortest.bartlett(Dentrificos)## R was not square, finding R from data## $chisq
## [1] 111.3138
##
## $p.value
## [1] 9.017094e-17
##
## $df
## [1] 15Número de Factores:
scree(Dentrificos, pc=FALSE)
fa.parallel(Dentrificos, fa='fa')
## Parallel analysis suggests that the number of factors = 2 and the number of components = NAExtracción de Factores:
extraccion <- factanal(Dentrificos, 2, rotation = 'varimax')
print(extraccion)##
## Call:
## factanal(x = Dentrificos, factors = 2, rotation = "varimax")
##
## Uniquenesses:
## Prevencion Brillo Fortaleza Frescura No_Prevencion
## 0.063 0.437 0.174 0.378 0.205
## Belleza
## 0.309
##
## Loadings:
## Factor1 Factor2
## Prevencion 0.968
## Brillo 0.749
## Fortaleza 0.898 -0.140
## Frescura 0.784
## No_Prevencion -0.887
## Belleza 0.830
##
## Factor1 Factor2
## SS loadings 2.542 1.892
## Proportion Var 0.424 0.315
## Cumulative Var 0.424 0.739
##
## Test of the hypothesis that 2 factors are sufficient.
## The chi square statistic is 5.21 on 4 degrees of freedom.
## The p-value is 0.266Cargas Factoriales
round(extraccion$loadings,3)##
## Loadings:
## Factor1 Factor2
## Prevencion 0.968
## Brillo 0.749
## Fortaleza 0.898 -0.140
## Frescura 0.784
## No_Prevencion -0.887
## Belleza 0.830
##
## Factor1 Factor2
## SS loadings 2.542 1.893
## Proportion Var 0.424 0.315
## Cumulative Var 0.424 0.739Uso de la función prcomp() para ACP
componentes<-prcomp(Dentrificos, scale. = TRUE)
names(componentes)## [1] "sdev" "rotation" "center" "scale" "x"sdev: Desviación estándar de los componentes principales
componentes$sdev## [1] 1.6526307 1.4893352 0.6645283 0.5841726 0.4273502 0.2919051# Valores Propios
vp <- (componentes$sdev)^2
# Varianzas en porcentajes
var_expli <- vp*100/sum(vp)
# Varianza aumulada
var_acum <- cumsum(var_expli)
acp.manual <- data.frame(Valor_propio=vp, Varianza_Explicada = var_expli,
Varianza_Acum = var_acum)
head(acp.manual)## Valor_propio Varianza_Explicada Varianza_Acum
## 1 2.73118833 45.519806 45.51981
## 2 2.21811927 36.968654 82.48846
## 3 0.44159791 7.359965 89.84843
## 4 0.34125765 5.687627 95.53605
## 5 0.18262823 3.043804 98.57986
## 6 0.08520861 1.420144 100.00000summary de procomp
summary(componentes)## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6
## Standard deviation 1.6526 1.4893 0.6645 0.58417 0.42735 0.2919
## Proportion of Variance 0.4552 0.3697 0.0736 0.05688 0.03044 0.0142
## Cumulative Proportion 0.4552 0.8249 0.8985 0.95536 0.98580 1.0000Usando el paquete factoextra
vp.dentrifico <- get_eigenvalue(componentes)
head(vp.dentrifico)## eigenvalue variance.percent cumulative.variance.percent
## Dim.1 2.73118833 45.519806 45.51981
## Dim.2 2.21811927 36.968654 82.48846
## Dim.3 0.44159791 7.359965 89.84843
## Dim.4 0.34125765 5.687627 95.53605
## Dim.5 0.18262823 3.043804 98.57986
## Dim.6 0.08520861 1.420144 100.00000Gráfico de los valores propios
barplot(acp.manual[, 2], names.arg=1:nrow(acp.manual),
main = "Varianzas",xlab = "Componentes Principales",
ylab = "Porcentaje de varianza", col ="steelblue")
barplot(acp.manual[, 2], names.arg=1:nrow(acp.manual),
main = "Varianzas",xlab = "Componentes Principales",
ylab = "Porcentaje de varianza", col ="steelblue")
# Adicin de linea que conecta los grfico.
lines(x = 1:nrow(acp.manual),acp.manual[, 2],
type="b", pch=19, col = "red")
Gráfico del porcentaje de varianzas usando factoextra
fviz_screeplot(componentes, ncp=6)
Gráfico de los valores propios usando factoextra
fviz_screeplot(componentes, ncp=6,choice="eigenvalue")
fviz_eig(componentes)
La función get pca var() - Resultados para Variables
variables <- get_pca_var(componentes)
variables## Principal Component Analysis Results for variables
## ===================================================
## Name Description
## 1 "$coord" "Coordinates for the variables"
## 2 "$cor" "Correlations between variables and dimensions"
## 3 "$cos2" "Cos2 for the variables"
## 4 "$contrib" "contributions of the variables"Coordenadas de las variables:
La correlación entre variables y componentes principales se utiliza como coordenadas. Se puede calcular de la siguiente manera: Correlación de las variables y los PCs = Cargas x Desv.estándar de la CP \[\rho_{jk} = \gamma_{k}*\sqrt{\lambda_j}\]
#Correlacion entre variables y componentes principales
func_corr_var <- function(cargas.var, desv.cp){
cargas.var*desv.cp
}# Correlacion/Coordenadas de las variables
cargas <- componentes$rotation
desv <- componentes$sdev
coord.var <- corr.var <- t(apply(cargas, 1, func_corr_var, desv))
head(coord.var[, 1:2])## PC1 PC2
## Prevencion -0.9283425 0.2532285
## Brillo 0.3005297 0.7952496
## Fortaleza -0.9361812 0.1308894
## Frescura 0.3415817 0.7889663
## No_Prevencion 0.8687553 -0.3507939
## Belleza 0.1766389 0.8711581variables$coord[,1:2]## Dim.1 Dim.2
## Prevencion -0.9283425 0.2532285
## Brillo 0.3005297 0.7952496
## Fortaleza -0.9361812 0.1308894
## Frescura 0.3415817 0.7889663
## No_Prevencion 0.8687553 -0.3507939
## Belleza 0.1766389 0.8711581biplot(componentes)
fviz_pca_biplot(componentes)
Grafico de las coordenadas variables usando factoextra
fviz_pca_var(componentes)
Cos2: calidad de la representación de variables en el mapa de factores
El cos2 de las variables se calcula como las coordenadas al cuadrado: var.cos2 = coord.var x coord.var \[var.cos2= \rho^2\]
var.cos2 <- coord.var^2
head(var.cos2[, 1:2])## PC1 PC2
## Prevencion 0.86181984 0.06412465
## Brillo 0.09031811 0.63242194
## Fortaleza 0.87643523 0.01713204
## Frescura 0.11667803 0.62246778
## No_Prevencion 0.75473582 0.12305634
## Belleza 0.03120132 0.75891652variables$cos2[,1:2] ## Dim.1 Dim.2
## Prevencion 0.86181984 0.06412465
## Brillo 0.09031811 0.63242194
## Fortaleza 0.87643523 0.01713204
## Frescura 0.11667803 0.62246778
## No_Prevencion 0.75473582 0.12305634
## Belleza 0.03120132 0.75891652#Grafico de calidad de la representación de las variables usando factoextra
fviz_pca_var(componentes, col.var="cos2")+
scale_color_gradient2(low="white",
mid="blue", high="red", midpoint=0.85) +
theme_minimal()
Contribución de las variables a los componentes principales
La contribución de una variable a un componente principal determinado es (en porcentaje):
(var :cos2 x 100)=(cos2 total del componente)
cos2.comp <- apply(var.cos2, 2, sum)
contrib <- function(var.cos2, cos2.comp){var.cos2*100/cos2.comp}
contrib.var <- t(apply(var.cos2,1, contrib, cos2.comp))
head(contrib.var[, 1:2])## PC1 PC2
## Prevencion 31.554757 2.8909470
## Brillo 3.306916 28.5116291
## Fortaleza 32.089886 0.7723678
## Frescura 4.272061 28.0628633
## No_Prevencion 27.633972 5.5477784
## Belleza 1.142408 34.2144144variables$contrib[,1:2]## Dim.1 Dim.2
## Prevencion 31.554757 2.8909470
## Brillo 3.306916 28.5116291
## Fortaleza 32.089886 0.7723678
## Frescura 4.272061 28.0628633
## No_Prevencion 27.633972 5.5477784
## Belleza 1.142408 34.2144144Grafico de las contribuciones de las variables usando factoextra
fviz_pca_var(componentes, col.var="contrib")+
scale_color_gradient2(low="white",
mid="blue", high="red", midpoint=16) +
theme_minimal()
Puntuaciones
head(componentes$x)## PC1 PC2 PC3 PC4 PC5 PC6
## [1,] -1.95304855 0.07101954 -0.4204652 0.04429731 0.25129712 0.5045730
## [2,] 1.67629433 -0.98519324 -0.4107514 -0.44926814 -0.24877831 -0.2970760
## [3,] -2.42977968 -0.65766708 -0.9622336 0.10432921 0.12430666 -0.3561819
## [4,] 0.09081904 1.69747385 -0.5154103 0.41242545 -0.30387782 -0.3437702
## [5,] 1.51539626 -2.72380315 -0.3789693 0.07454906 0.02467079 -0.2561995
## [6,] -1.66956158 -0.01478708 -0.4146078 -0.07904243 0.16489830 0.1247777