Analisis de Componentes Principales (PCA)

El software R dispone de varias funciones de diferentes paquetes para calcular PCA

library("FactoMineR")

## Warning: package 'FactoMineR' was built under R version 4.1.1

library("factoextra")

## Warning: package 'factoextra' was built under R version 4.1.1

## Loading required package: ggplot2

## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa

Utilizaremos los conjuntos de datos de demostración decathlon2 del paquete +factoextra. Los datos utilizados aquí describen el rendimiento de los atletas durante dos eventos deportivos (Desctar y OlympicG). Contiene 27 individuos (atletas) descritos por 13 variables.

data(decathlon2)
head(decathlon2)

##           X100m Long.jump Shot.put High.jump X400m X110m.hurdle Discus
## SEBRLE    11.04      7.58    14.83      2.07 49.81        14.69  43.75
## CLAY      10.76      7.40    14.26      1.86 49.37        14.05  50.72
## BERNARD   11.02      7.23    14.25      1.92 48.93        14.99  40.87
## YURKOV    11.34      7.09    15.19      2.10 50.42        15.31  46.26
## ZSIVOCZKY 11.13      7.30    13.48      2.01 48.62        14.17  45.67
## McMULLEN  10.83      7.31    13.76      2.13 49.91        14.38  44.41
##           Pole.vault Javeline X1500m Rank Points Competition
## SEBRLE          5.02    63.19  291.7    1   8217    Decastar
## CLAY            4.92    60.15  301.5    2   8122    Decastar
## BERNARD         5.32    62.77  280.1    4   8067    Decastar
## YURKOV          4.72    63.44  276.4    5   8036    Decastar
## ZSIVOCZKY       4.42    55.37  268.0    7   8004    Decastar
## McMULLEN        4.42    56.37  285.1    8   7995    Decastar

Comenzamos por obtener un subconjunto de los individuos activos y las variables activas para el análisis de componentes principales

decathlon2.active <- decathlon2[1:23, 1:10]
head(decathlon2.active[, 1:6], 4)

##         X100m Long.jump Shot.put High.jump X400m X110m.hurdle
## SEBRLE  11.04      7.58    14.83      2.07 49.81        14.69
## CLAY    10.76      7.40    14.26      1.86 49.37        14.05
## BERNARD 11.02      7.23    14.25      1.92 48.93        14.99
## YURKOV  11.34      7.09    15.19      2.10 50.42        15.31

En el análisis de componentes principales, las variables se suelen escalar (es decir, estandarizar). Esto es especialmente recomendable cuando las variables se miden en diferentes escalas (por ejemplo: kilogramos, kilómetros, centímetros,…); de lo contrario, los resultados del PCA obtenidos se verán muy afectados. El objetivo es que las variables sean comparables. Por lo general, las variables se escalan para que tengan i) desviación estándar uno y ii) media cero.

library("FactoMineR")
res.pca <- PCA(decathlon2.active, graph = FALSE)

print(res.pca)

## **Results for the Principal Component Analysis (PCA)**
## The analysis was performed on 23 individuals, described by 10 variables
## *The results are available in the following objects:
## 
##    name               description                          
## 1  "$eig"             "eigenvalues"                        
## 2  "$var"             "results for the variables"          
## 3  "$var$coord"       "coord. for the variables"           
## 4  "$var$cor"         "correlations variables - dimensions"
## 5  "$var$cos2"        "cos2 for the variables"             
## 6  "$var$contrib"     "contributions of the variables"     
## 7  "$ind"             "results for the individuals"        
## 8  "$ind$coord"       "coord. for the individuals"         
## 9  "$ind$cos2"        "cos2 for the individuals"           
## 10 "$ind$contrib"     "contributions of the individuals"   
## 11 "$call"            "summary statistics"                 
## 12 "$call$centre"     "mean of the variables"              
## 13 "$call$ecart.type" "standard error of the variables"    
## 14 "$call$row.w"      "weights for the individuals"        
## 15 "$call$col.w"      "weights for the variables"

Visualizacion e interpretacion

Autovalores/Varianza

library("factoextra")
eig.val <- get_eigenvalue(res.pca)
eig.val

##        eigenvalue variance.percent cumulative.variance.percent
## Dim.1   4.1242133        41.242133                    41.24213
## Dim.2   1.8385309        18.385309                    59.62744
## Dim.3   1.2391403        12.391403                    72.01885
## Dim.4   0.8194402         8.194402                    80.21325
## Dim.5   0.7015528         7.015528                    87.22878
## Dim.6   0.4228828         4.228828                    91.45760
## Dim.7   0.3025817         3.025817                    94.48342
## Dim.8   0.2744700         2.744700                    97.22812
## Dim.9   0.1552169         1.552169                    98.78029
## Dim.10  0.1219710         1.219710                   100.00000

fviz_eig(res.pca, addlabels = TRUE, ylim = c(0, 50))

Grafica de variables

Resultados

var <- get_pca_var(res.pca)
var

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

head(var$coord)

##                   Dim.1       Dim.2      Dim.3       Dim.4      Dim.5
## X100m        -0.8506257 -0.17939806  0.3015564  0.03357320 -0.1944440
## Long.jump     0.7941806  0.28085695 -0.1905465 -0.11538956  0.2331567
## Shot.put      0.7339127  0.08540412  0.5175978  0.12846837 -0.2488129
## High.jump     0.6100840 -0.46521415  0.3300852  0.14455012  0.4027002
## X400m        -0.7016034  0.29017826  0.2835329  0.43082552  0.1039085
## X110m.hurdle -0.7641252 -0.02474081  0.4488873 -0.01689589  0.2242200

Cos2: calidad en el mapa de factores

head(var$cos2)

##                  Dim.1        Dim.2      Dim.3        Dim.4      Dim.5
## X100m        0.7235641 0.0321836641 0.09093628 0.0011271597 0.03780845
## Long.jump    0.6307229 0.0788806285 0.03630798 0.0133147506 0.05436203
## Shot.put     0.5386279 0.0072938636 0.26790749 0.0165041211 0.06190783
## High.jump    0.3722025 0.2164242070 0.10895622 0.0208947375 0.16216747
## X400m        0.4922473 0.0842034209 0.08039091 0.1856106269 0.01079698
## X110m.hurdle 0.5838873 0.0006121077 0.20149984 0.0002854712 0.05027463

Contribuciones a los componentes principales

head(var$contrib)

##                  Dim.1      Dim.2     Dim.3       Dim.4     Dim.5
## X100m        17.544293  1.7505098  7.338659  0.13755240  5.389252
## Long.jump    15.293168  4.2904162  2.930094  1.62485936  7.748815
## Shot.put     13.060137  0.3967224 21.620432  2.01407269  8.824401
## High.jump     9.024811 11.7715838  8.792888  2.54987951 23.115504
## X400m        11.935544  4.5799296  6.487636 22.65090599  1.539012
## X110m.hurdle 14.157544  0.0332933 16.261261  0.03483735  7.166193

Circulo de correlacion

Coordenadas de las variables

head(var$coord, 4)

##                Dim.1       Dim.2      Dim.3      Dim.4      Dim.5
## X100m     -0.8506257 -0.17939806  0.3015564  0.0335732 -0.1944440
## Long.jump  0.7941806  0.28085695 -0.1905465 -0.1153896  0.2331567
## Shot.put   0.7339127  0.08540412  0.5175978  0.1284684 -0.2488129
## High.jump  0.6100840 -0.46521415  0.3300852  0.1445501  0.4027002

fviz_pca_var(res.pca, col.var = "pink")

Calidad de representación

head(var$cos2, 4)

##               Dim.1       Dim.2      Dim.3      Dim.4      Dim.5
## X100m     0.7235641 0.032183664 0.09093628 0.00112716 0.03780845
## Long.jump 0.6307229 0.078880629 0.03630798 0.01331475 0.05436203
## Shot.put  0.5386279 0.007293864 0.26790749 0.01650412 0.06190783
## High.jump 0.3722025 0.216424207 0.10895622 0.02089474 0.16216747

library("corrplot")

## corrplot 0.91 loaded

corrplot(var$cos2, is.corr=FALSE)

Total cos2 of variables in Dim.1 y Dim.2

fviz_cos2(res.pca, choice = "var", axes = 1:2)

Color by cos2 values: quality on the factor map

fviz_pca_var(res.pca, col.var = "cos2",

gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE )

Change the transparency by cos2 values

fviz_pca_var(res.pca, alpha.var = "cos2")

Contribuciones de variables a PCs

head(var$contrib, 4)

##               Dim.1      Dim.2     Dim.3     Dim.4     Dim.5
## X100m     17.544293  1.7505098  7.338659 0.1375524  5.389252
## Long.jump 15.293168  4.2904162  2.930094 1.6248594  7.748815
## Shot.put  13.060137  0.3967224 21.620432 2.0140727  8.824401
## High.jump  9.024811 11.7715838  8.792888 2.5498795 23.115504

library("corrplot")
corrplot(var$contrib, is.corr=FALSE)

Contributions of variables to PC1

fviz_contrib(res.pca, choice = "var", axes = 1, top = 10)

Contributions of variables to PC2

fviz_contrib(res.pca, choice = "var", axes = 2, top = 10)

La contribucion total a PC1 y PC2 es optenido mediante el siguiente codigo.

fviz_contrib(res.pca, choice = "var", axes = 1:2, top = 10)

Las variables mas importantes son subrayadas en correlacion con la siguiente funcion.

fviz_pca_var(res.pca, col.var = "contrib",

gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"))

Cambiar la transparencia para los valores mas importantes

fviz_pca_var(res.pca, alpha.var = "contrib")

Color por una variable continua personalizada

Crear un variable aleatoria de tamaño 10

set.seed(123)
my.cont.var <- rnorm(10)

Color para las variables continuas

fviz_pca_var(res.pca, col.var = my.cont.var,

gradient.cols = c("blue", "yellow", "red"),
legend.title = "Cont.Var")

Color por grupos

Crear variables agrupadas usando Kmeans
Crear un grupo de 3 variables

set.seed(123)
res.km <- kmeans(var$coord, centers = 3, nstart = 25)
grp <- as.factor(res.km$cluster)

Color de las variables por grupo.

fviz_pca_var(res.pca, col.var = grp,

palette = c("#0073C2FF", "#EFC000FF", "#868686FF"),
legend.title = "Cluster")

Descripcion de la dimension

res.desc <- dimdesc(res.pca, axes = c(1,2), proba = 0.05)

Description of dimension 1

res.desc$Dim.1

## $quanti
##              correlation      p.value
## Long.jump      0.7941806 6.059893e-06
## Discus         0.7432090 4.842563e-05
## Shot.put       0.7339127 6.723102e-05
## High.jump      0.6100840 1.993677e-03
## Javeline       0.4282266 4.149192e-02
## X400m         -0.7016034 1.910387e-04
## X110m.hurdle  -0.7641252 2.195812e-05
## X100m         -0.8506257 2.727129e-07
## 
## attr(,"class")
## [1] "condes" "list"

Drescipcion de la dimension 2

res.desc$Dim.2

## $quanti
##            correlation      p.value
## Pole.vault   0.8074511 3.205016e-06
## X1500m       0.7844802 9.384747e-06
## High.jump   -0.4652142 2.529390e-02
## 
## attr(,"class")
## [1] "condes" "list"

Gráfico de individuos

Resultados

ind <- get_pca_ind(res.pca)
ind

## Principal Component Analysis Results for individuals
##  ===================================================
##   Name       Description                       
## 1 "$coord"   "Coordinates for the individuals" 
## 2 "$cos2"    "Cos2 for the individuals"        
## 3 "$contrib" "contributions of the individuals"

Coordenadas de particulares

head(ind$coord)

##                Dim.1      Dim.2      Dim.3       Dim.4       Dim.5
## SEBRLE     0.1955047  1.5890567  0.6424912  0.08389652  1.16829387
## CLAY       0.8078795  2.4748137 -1.3873827  1.29838232 -0.82498206
## BERNARD   -1.3591340  1.6480950  0.2005584 -1.96409420  0.08419345
## YURKOV    -0.8889532 -0.4426067  2.5295843  0.71290837  0.40782264
## ZSIVOCZKY -0.1081216 -2.0688377 -1.3342591 -0.10152796 -0.20145217
## McMULLEN   0.1212195 -1.0139102 -0.8625170  1.34164291  1.62151286

Calidad de particulares

head(ind$cos2)

##                 Dim.1      Dim.2       Dim.3       Dim.4        Dim.5
## SEBRLE    0.007530179 0.49747323 0.081325232 0.001386688 0.2689026575
## CLAY      0.048701249 0.45701660 0.143628117 0.125791741 0.0507850580
## BERNARD   0.197199804 0.28996555 0.004294015 0.411819183 0.0007567259
## YURKOV    0.096109800 0.02382571 0.778230322 0.061812637 0.0202279796
## ZSIVOCZKY 0.001574385 0.57641944 0.239754152 0.001388216 0.0054654972
## McMULLEN  0.002175437 0.15219499 0.110137872 0.266486530 0.3892621478

Contribucion de particulares.

head(ind$contrib)

##                Dim.1      Dim.2      Dim.3       Dim.4       Dim.5
## SEBRLE    0.04029447  5.9714533  1.4483919  0.03734589  8.45894063
## CLAY      0.68805664 14.4839248  6.7537381  8.94458283  4.21794385
## BERNARD   1.94740183  6.4234107  0.1411345 20.46819433  0.04393073
## YURKOV    0.83308415  0.4632733 22.4517396  2.69663605  1.03075263
## ZSIVOCZKY 0.01232413 10.1217143  6.2464325  0.05469230  0.25151025
## McMULLEN  0.01549089  2.4310854  2.6102794  9.55055888 16.29493304

Graficos: Calidad y contribucion

fviz_pca_ind(res.pca)

fviz_pca_ind(res.pca, col.ind = "cos2",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE)

fviz_pca_ind(res.pca, pointsize = "cos2",
pointshape = 21, fill = "#E7B800",
repel = TRUE )

Note que los individuos que son similares son agrupados juntos

fviz_pca_ind(res.pca, col.ind = "cos2", pointsize = "cos2",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE )

Cambiando el tamaño del punto según el cos2 de los individuos correspondientes

fviz_pca_ind(res.pca, pointsize = "cos2",
pointshape = 21, fill = "#E7B800",
repel = TRUE)

*cambiando el tamaño y color de los puntos.

fviz_pca_ind(res.pca, col.ind = "cos2", pointsize = "cos2",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE)

Gráfico de barras de la calidad de la representación (cos2) de los individuos en el factor.

fviz_cos2(res.pca, choice = "ind")

Total contribucion en PC1 y PC2

fviz_contrib(res.pca, choice = "ind", axes = 1:2)

Color por una variable continua personalizada

Crear una variable continua de 23 de longitud.
La longitud como el numero de individuos activos en el PCA

set.seed(123)
my.cont.var <- rnorm(23)

fviz_pca_ind(res.pca, col.ind = my.cont.var,

gradient.cols = c("pink", "yellow", "purple"),
legend.title = "Cont.Var")

Color por grupos

A continuacion se colorearan losindividuos por grupo. Además, mostramos cómo agregar elipses de concentración y elipses de confianza por grupos. Para ello, utilizaremos los datos del iris como conjuntos de datos de demostración

head(iris, 3)

##   Sepal.Length Sepal.Width Petal.Length Petal.Width Species
## 1          5.1         3.5          1.4         0.2  setosa
## 2          4.9         3.0          1.4         0.2  setosa
## 3          4.7         3.2          1.3         0.2  setosa

iris.pca <- PCA(iris[,-5], graph = FALSE)

se utilizara el argumento ’habillage´ o ’col.ind´ para especificar el factor variable para colorear los individuos por grupos. Para añadir una elipse de concentración alrededor de cada grupo, especifique el argumento ’addEllipses=TRUE´

fviz_pca_ind(iris.pca,

geom.ind = "point", # show points only (nbut not "text")
col.ind = iris$Species, # color by groups
palette = c("#FF6666", "#3399FF", "#99FF99"),
addEllipses = TRUE, # Concentration ellipses
legend.title = "Groups"
)

Añadir elipses de confianza

fviz_pca_ind(iris.pca, geom.ind = "point", col.ind = iris$Species,

palette = c("#6666FF", "#CC0099", "#00CCCC"),
addEllipses = TRUE, ellipse.type = "confidence",
legend.title = "Groups"
)

fviz_pca_ind(iris.pca,

label = "none", # hide individual labels
habillage = iris$Species, # color by groups
addEllipses = TRUE, # Concentration ellipses
palette = "jco"
)

Personalizacion de las graficas.

Tenga en cuenta que ’fviz_pca_ind()´ y ’fviz_pca_var() y funciones relacionadas están envolviendo alrededor la función central ´’fviz() [in factoextra]. fviz() es una envoltura alrededor de la función ´’ggscat- ter() [in ggpubr]´. Por lo tanto, argumentos adicionales, que se pasarán a la función ’fviz()´ y ’ggscatter()´, puede especificarse en ’fviz_pca_ind()´ y ’fviz_pca_var()´.

Dimensiones

Para visualizar las variables en las dimensiones deseadas

fviz_pca_var(res.pca, axes = c(2, 3))

fviz_pca_ind(res.pca, axes = c(2, 3))

Elemntos de la grafica: Puntos, texto, flechas

geom.var: Se utiliza para especificar la geometria de los elementos que van a ser usados en las variables a graficar
usar ’geom.var´= “Point” para ver solo puntos
usar ’geom.var´= “text” para solo ver texto
Usar ’geom.var´= c(“point”, “text”) para usar texto y puntos
Usar ’geom.var´= c(“arrow”, “text”) para usar texto y flechas

fviz_pca_var(res.pca, geom.var = c("point", "text"))

geom.ind: Un texto que especifique la geometría que se utilizará para representar individuos.Los valores bajos son la combinación de c(“punto”, “texto”).

fviz_pca_ind(res.pca, geom.ind = "text")

Tamaño y forma de los elementos de la grafica

labelsize: tamaño de fuente para las etiquetas de texto
pointsize: tamaño de los puntos
arrowsize: tamaño de las flechas.
pointshape: la forma de los puntos.

fviz_pca_var(res.pca, arrowsize = 1, labelsize = 5,

repel = TRUE)

fviz_pca_ind(res.pca,

pointsize = 3, pointshape = 21, fill = "lightblue",
labelsize = 5, repel = TRUE)

Elipses

“convex”: trazar el casco convexo de un conjunto de puntos.
“confidence”: trazar elipses de confianza alrededor de los puntos medios del grupo como función
“t”: asume una distribución t multivariable.
“norm”: asume una distribución normal multivariable
“euclid”: dibuja un círculo con el radio igual al nivel, representando al euclidiano

fviz_pca_ind(iris.pca, geom.ind = "point",

col.ind = iris$Species, # color by groups
palette = c("#00AFBB", "#E7B800", "#FC4E07"),
addEllipses = TRUE, ellipse.type = "confidence",
legend.title = "Groups"
)

fviz_pca_ind(iris.pca, geom.ind = "point",

col.ind = iris$Species, # color by groups
palette = c("#00AFBB", "#E7B800", "#FC4E07"),
addEllipses = TRUE, ellipse.type = "convex",
legend.title = "Groups"
)

Puntos medios del grupo

fviz_pca_ind(iris.pca,

geom.ind = "point", # show points only (but not "text")
group.ind = iris$Species, # color by groups
legend.title = "Groups",
mean.point = FALSE)

Lineas del eje

El argumento axes.linetype se puede utilizar para especificar el tipo de línea de los ejes.

fviz_pca_var(res.pca, axes.linetype = "blank")

Parametros graficos

Los parametros graficos que pueden usarse con ggpar() incluyen: Temas, paletas de colores, posicion de la leyenda, posibles valores, temas, etc.

ind.p <- fviz_pca_ind(iris.pca, geom = "point", col.ind = iris$Species)
ggpubr::ggpar(ind.p,

title = "Principal Component Analysis",
subtitle = "Iris data set",
caption = "Source: factoextra",
xlab = "PC1", ylab = "PC2",
legend.title = "Species", legend.position = "top",
ggtheme = theme_gray(), palette = "jco"
)

Biplot

La funcion biplot solo puede ser útil cuando hay un número bajo de variables e individuos en el conjunto de datos; de lo contrario, la trama final sería ilegible. Tenga en cuenta también que, la coordenada de los individuos y las variables se nota construida en el mismo espacio. Por lo tanto, en biplot, debe centrarse principalmente en la dirección de variables pero no en sus posiciones absolutas en la trama.

fviz_pca_biplot(res.pca, repel = TRUE,

col.var = "#FF0000",
col.ind = "#696969" 
)

Usando la salida iris.pca, vamos a:
hacer una biplot de individuos y variables
cambiar el color de los individuos por grupos: col.ind = iris $ Species
mostrar solo las etiquetas de las variables: label = “var” o usar geom.ind = “point”

fviz_pca_biplot(iris.pca,

col.ind = iris$Species, palette = "jco",
addEllipses = TRUE, label = "var",
col.var = "black", repel = TRUE,
legend.title = "Species")

A continuacion vamos a usar un ejemplo para colorear tanto los individuos como variables por grupo. Esta forma de punto en particular se puede rellenar con un color usando el argumento fill.ind. El color de la línea de borde de puntos individuales se establece en “Black” utilizando col.ind. Para colorear variables por grupos, el argumento col.var será usó. Para personalizar los colores individuales y variables, usamos las funciones auxiliares fill_palette () y color_palette () [en el paquete ggpubr].

fviz_pca_biplot(iris.pca,

# relleno indivual por grupos
geom.ind = "point",
pointshape = 21,
pointsize = 2.5,
fill.ind = iris$Species,
col.ind = "black",
# Color de las variables por grupo.
col.var = factor(c("sepal", "sepal", "petal", "petal")),
legend.title = list(fill = "Species", color = "Clusters"),
repel = TRUE # Evite el trazado excesivo de etiquetas
)+

ggpubr::fill_palette("jco")+ # Color individual de relleno
ggpubr::color_palette("npg")

Ahora un ejemplo complejo es colorear individuos por grupos (color discreto) y variables. por sus contribuciones a los componentes principales (colores degradados). Además, vamos a cambie la transparencia de las variables por sus contribuciones usando el argumento alpha.var.

fviz_pca_biplot(iris.pca,
# Individuos
geom.ind = "point",
fill.ind = iris$Species, col.ind = "black",
pointshape = 21, pointsize = 2,
palette = "jco",
addEllipses = TRUE,
# Variables
alpha.var ="contrib", col.var = "contrib",
gradient.cols = "RdYlBu",
legend.title = list(fill = "Species", color = "Contrib",

alpha = "Contrib"))

Analisis de Componentes Principales (PCA) y k-means

Daniela Albor

11/11/2021

Introduccion

Analisis de Componentes Principales (PCA)

Visualizacion e interpretacion

Autovalores/Varianza

Grafica de variables

Resultados

Circulo de correlacion

Calidad de representación

Contribuciones de variables a PCs

Color por una variable continua personalizada

Color por grupos

Descripcion de la dimension

Gráfico de individuos

Resultados

Graficos: Calidad y contribucion

Color por una variable continua personalizada

Color por grupos

Personalizacion de las graficas.

Dimensiones

Elemntos de la grafica: Puntos, texto, flechas

Tamaño y forma de los elementos de la grafica

Elipses

Puntos medios del grupo

Lineas del eje

Parametros graficos

Biplot