El clustering K-means (MacQueen, 1967) es el algoritmo de aprendizaje automático no supervisado más utilizado para particionar un conjunto de datos dado en un conjunto de k grupos (es decir, k clusters), donde k representa el número de grupos preespecificado por el analista. Clasifica objetos en múltiples grupos (es decir, clusters), de manera que los objetos dentro del mismo cluster sean lo más similares posible (es decir, alta similitud intra-cluster), mientras que los objetos de diferentes clusters sean lo más diferentes posible (es decir, baja similitud inter-cluster). En el clustering K-means, cada cluster está representado por su centro (es decir, centroide), que corresponde a la media de los puntos asignados al cluster.
# Cargar las librerías necesarias
library(factoextra)
## Warning: package 'factoextra' was built under R version 4.3.3
## Loading required package: ggplot2
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
# Cargar el conjunto de datos USArrests
data("USArrests")
# Escalar los datos
df <- scale(USArrests)
# Mostrar las primeras 3 filas de los datos escalados
head(df, n = 3)
## Murder Assault UrbanPop Rape
## Alabama 1.24256408 0.7828393 -0.5209066 -0.003416473
## Alaska 0.50786248 1.1068225 -1.2117642 2.484202941
## Arizona 0.07163341 1.4788032 0.9989801 1.042878388
# Calcular el número óptimo de clusters usando el método del codo
# Usar fviz_nbclust después de ejecutar kmeans
kmeans_results <- kmeans(df, centers = 5, iter.max = 10, nstart = 1)
# Visualizar el número óptimo de clusters utilizando el método del codo
fviz_nbclust(df, kmeans, method = "wss") + geom_vline(xintercept = 4, linetype = 2)
# Compute k-means with k = 4
set.seed(123)
km.res <- kmeans(df, 4, nstart = 25)
# Print the results
print(km.res)
## K-means clustering with 4 clusters of sizes 8, 13, 16, 13
##
## Cluster means:
## Murder Assault UrbanPop Rape
## 1 1.4118898 0.8743346 -0.8145211 0.01927104
## 2 -0.9615407 -1.1066010 -0.9301069 -0.96676331
## 3 -0.4894375 -0.3826001 0.5758298 -0.26165379
## 4 0.6950701 1.0394414 0.7226370 1.27693964
##
## Clustering vector:
## Alabama Alaska Arizona Arkansas California
## 1 4 4 1 4
## Colorado Connecticut Delaware Florida Georgia
## 4 3 3 4 1
## Hawaii Idaho Illinois Indiana Iowa
## 3 2 4 3 2
## Kansas Kentucky Louisiana Maine Maryland
## 3 2 1 2 4
## Massachusetts Michigan Minnesota Mississippi Missouri
## 3 4 2 1 4
## Montana Nebraska Nevada New Hampshire New Jersey
## 2 2 4 2 3
## New Mexico New York North Carolina North Dakota Ohio
## 4 4 1 2 3
## Oklahoma Oregon Pennsylvania Rhode Island South Carolina
## 3 3 3 3 1
## South Dakota Tennessee Texas Utah Vermont
## 2 1 4 3 2
## Virginia Washington West Virginia Wisconsin Wyoming
## 3 3 2 2 3
##
## Within cluster sum of squares by cluster:
## [1] 8.316061 11.952463 16.212213 19.922437
## (between_SS / total_SS = 71.2 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault"
aggregate(USArrests, by=list(cluster=km.res$cluster), mean)
## cluster Murder Assault UrbanPop Rape
## 1 1 13.93750 243.62500 53.75000 21.41250
## 2 2 3.60000 78.53846 52.07692 12.17692
## 3 3 5.65625 138.87500 73.87500 18.78125
## 4 4 10.81538 257.38462 76.00000 33.19231
dd <- cbind(USArrests, cluster = km.res$cluster)
head(dd)
## Murder Assault UrbanPop Rape cluster
## Alabama 13.2 236 58 21.2 1
## Alaska 10.0 263 48 44.5 4
## Arizona 8.1 294 80 31.0 4
## Arkansas 8.8 190 50 19.5 1
## California 9.0 276 91 40.6 4
## Colorado 7.9 204 78 38.7 4
# Cluster number for each of the observations
km.res$cluster
## Alabama Alaska Arizona Arkansas California
## 1 4 4 1 4
## Colorado Connecticut Delaware Florida Georgia
## 4 3 3 4 1
## Hawaii Idaho Illinois Indiana Iowa
## 3 2 4 3 2
## Kansas Kentucky Louisiana Maine Maryland
## 3 2 1 2 4
## Massachusetts Michigan Minnesota Mississippi Missouri
## 3 4 2 1 4
## Montana Nebraska Nevada New Hampshire New Jersey
## 2 2 4 2 3
## New Mexico New York North Carolina North Dakota Ohio
## 4 4 1 2 3
## Oklahoma Oregon Pennsylvania Rhode Island South Carolina
## 3 3 3 3 1
## South Dakota Tennessee Texas Utah Vermont
## 2 1 4 3 2
## Virginia Washington West Virginia Wisconsin Wyoming
## 3 3 2 2 3
head(km.res$cluster, 4)
## Alabama Alaska Arizona Arkansas
## 1 4 4 1
# Cluster size
km.res$size
## [1] 8 13 16 13
# Cluster means
km.res$centers
## Murder Assault UrbanPop Rape
## 1 1.4118898 0.8743346 -0.8145211 0.01927104
## 2 -0.9615407 -1.1066010 -0.9301069 -0.96676331
## 3 -0.4894375 -0.3826001 0.5758298 -0.26165379
## 4 0.6950701 1.0394414 0.7226370 1.27693964
fviz_cluster(km.res, data = df,
palette = c("#2E9FDF", "#00AFBB", "#E7B800", "#FC4E07"),
ellipse.type = "euclid", # Concentration ellipse
star.plot = TRUE, # Add segments from centroids to items
repel = TRUE, # Avoid label overplotting (slow)
ggtheme = theme_minimal())
El algoritmo k-medoids es un enfoque de clustering relacionado con el clustering k-means (capítulo 4) para dividir un conjunto de datos en k grupos o clusters. En el clustering k-medoids, cada cluster está representado por uno de los puntos de datos en el cluster. Estos puntos son llamados medoides del cluster. El término “medoide” se refiere a un objeto dentro de un cluster para el cual la disimilaridad promedio entre él y todos los otros miembros del cluster es mínima. Corresponde al punto más centralmente ubicado en el cluster. Estos objetos (uno por cluster) pueden ser considerados como un ejemplo representativo de los miembros de ese cluster, lo cual puede ser útil en algunas situaciones. Recuerda que, en el clustering k-means, el centro de un cluster dado se calcula como el valor medio de todos los puntos de datos en el cluster. K-medoids es una alternativa robusta al clustering k-means. Esto significa que el algoritmo es menos sensible al ruido y a los valores atípicos, en comparación con k-means, porque utiliza medoides como centros de cluster en lugar de medias (utilizadas en k-means). El algoritmo k-medoids requiere que el usuario especifique k, el número de clusters a generar (como en el clustering k-means). Un enfoque útil para determinar el número óptimo de clusters es el método de la silueta, descrito en las siguientes secciones. El método de clustering k-medoids más común es el algoritmo PAM (Partitioning Around Medoids, Kaufman & Rousseeuw, 1990).
library(cluster)
## Warning: package 'cluster' was built under R version 4.3.3
library(factoextra)
data("USArrests") # Cargar el conjunto de datos
df <- scale(USArrests) # Escalar los datos
head(df, n = 3) # Ver las primeras 3 filas de los datos
## Murder Assault UrbanPop Rape
## Alabama 1.24256408 0.7828393 -0.5209066 -0.003416473
## Alaska 0.50786248 1.1068225 -1.2117642 2.484202941
## Arizona 0.07163341 1.4788032 0.9989801 1.042878388
# Ejemplo de uso de PAM para clustering
# Supongamos que queremos dividir los datos en 3 clusters
k <- 3
pam_result <- pam(df, k, metric = "euclidean", stand = FALSE)
# Visualizar los resultados del clustering
fviz_cluster(pam_result, data = df)
fviz_nbclust (df, pam, method= "silhouette")+
theme_classic()
pam.res <- pam(df, 2)
print (pam.res)
## Medoids:
## ID Murder Assault UrbanPop Rape
## New Mexico 31 0.8292944 1.3708088 0.3081225 1.1603196
## Nebraska 27 -0.8008247 -0.8250772 -0.2445636 -0.5052109
## Clustering vector:
## Alabama Alaska Arizona Arkansas California
## 1 1 1 2 1
## Colorado Connecticut Delaware Florida Georgia
## 1 2 2 1 1
## Hawaii Idaho Illinois Indiana Iowa
## 2 2 1 2 2
## Kansas Kentucky Louisiana Maine Maryland
## 2 2 1 2 1
## Massachusetts Michigan Minnesota Mississippi Missouri
## 2 1 2 1 1
## Montana Nebraska Nevada New Hampshire New Jersey
## 2 2 1 2 2
## New Mexico New York North Carolina North Dakota Ohio
## 1 1 1 2 2
## Oklahoma Oregon Pennsylvania Rhode Island South Carolina
## 2 2 2 2 1
## South Dakota Tennessee Texas Utah Vermont
## 2 1 1 2 2
## Virginia Washington West Virginia Wisconsin Wyoming
## 2 2 2 2 2
## Objective function:
## build swap
## 1.441358 1.368969
##
## Available components:
## [1] "medoids" "id.med" "clustering" "objective" "isolation"
## [6] "clusinfo" "silinfo" "diss" "call" "data"
dd <- cbind(USArrests, cluster= pam.res$cluster)
head(dd, n = 3 )
## Murder Assault UrbanPop Rape cluster
## Alabama 13.2 236 58 21.2 1
## Alaska 10.0 263 48 44.5 1
## Arizona 8.1 294 80 31.0 1
# Cluster medoids: New Mexico, Nebraska
pam.res$medoids
## Murder Assault UrbanPop Rape
## New Mexico 0.8292944 1.3708088 0.3081225 1.1603196
## Nebraska -0.8008247 -0.8250772 -0.2445636 -0.5052109
# Cluster numbers
head(pam.res$clustering)
## Alabama Alaska Arizona Arkansas California Colorado
## 1 1 1 2 1 1
fviz_cluster (pam.res,
palette = c ( "#00AFBB" , "#FC4E07" ), # color palette
ellipse.type= "t" , # Concentration ellipse
repel= TRUE , # Avoid label overplotting (slow)
ggtheme = theme_classic ())
En lugar de encontrar medoides para todo el conjunto de datos, CLARA considera una muestra pequeña del conjunto de datos con un tamaño fijo (tamaño de muestra) y aplica el algoritmo PAM (Capítulo 5) para generar un conjunto óptimo de medoides para la muestra. La calidad de los medoides resultantes se mide por la disimilaridad promedio entre cada objeto en todo el conjunto de datos y el medoide de su cluster, definido como la función de costo. CLARA repite los procesos de muestreo y clustering un número predefinido de veces para minimizar el sesgo de muestreo. Los resultados finales de clustering corresponden al conjunto de medoides con el costo mínimo. El algoritmo CLARA se resume en la siguiente sección.
library(cluster)
library(factoextra)
set.seed(1234)
# Generar 500 objetos, divididos en 2 clusters.
df <- rbind(cbind(rnorm(200, 0, 8), rnorm(200, 0, 8)),
cbind(rnorm(300, 50, 8), rnorm(300, 50, 8)))
# Especificar nombres de columnas y filas
colnames(df) <- c("x", "y")
rownames(df) <- paste0("S", 1:nrow(df))
# Vista previa de los datos
head(df, n = 6)
## x y
## S1 -9.656526 3.881815
## S2 2.219434 5.574150
## S3 8.675529 1.484111
## S4 -18.765582 5.605868
## S5 3.432998 2.493448
## S6 4.048447 6.083699
# Calcular el número óptimo de clusters utilizando el método de la silueta
fviz_nbclust(df, clara, method = "silhouette") + theme_classic()
# Calcular CLARA
clara.res <- clara(df, 2, samples = 50, pamLike = TRUE)
# Imprimir componentes de clara.res
print(clara.res)
## Call: clara(x = df, k = 2, samples = 50, pamLike = TRUE)
## Medoids:
## x y
## S121 -1.531137 1.145057
## S455 48.357304 50.233499
## Objective function: 9.87862
## Clustering vector: Named int [1:500] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 ...
## - attr(*, "names")= chr [1:500] "S1" "S2" "S3" "S4" "S5" "S6" "S7" ...
## Cluster sizes: 200 300
## Best sample:
## [1] S37 S49 S54 S63 S68 S71 S76 S80 S82 S101 S103 S108 S109 S118 S121
## [16] S128 S132 S138 S144 S162 S203 S210 S216 S231 S234 S249 S260 S261 S286 S299
## [31] S304 S305 S312 S315 S322 S350 S403 S450 S454 S455 S456 S465 S488 S497
##
## Available components:
## [1] "sample" "medoids" "i.med" "clustering" "objective"
## [6] "clusinfo" "diss" "call" "silinfo" "data"
# Combinar los datos con los clusters asignados
dd <- cbind(df, cluster = clara.res$clustering)
head(dd, n = 4)
## x y cluster
## S1 -9.656526 3.881815 1
## S2 2.219434 5.574150 1
## S3 8.675529 1.484111 1
## S4 -18.765582 5.605868 1
# Medoides
clara.res$medoids
## x y
## S121 -1.531137 1.145057
## S455 48.357304 50.233499
# Resultado del clustering
head(clara.res$clustering, 10)
## S1 S2 S3 S4 S5 S6 S7 S8 S9 S10
## 1 1 1 1 1 1 1 1 1 1
# Visualizar los resultados del clustering
fviz_cluster(clara.res,
palette = c("#00AFBB", "#FC4E07"), # paleta de colores
ellipse.type = "t", # elipse de concentración
geom = "point", pointsize = 1,
ggtheme = theme_classic())
El clustering aglomerativo es el tipo más común de clustering jerárquico utilizado para agrupar objetos en clusters basados en su similitud. También se conoce como AGNES (Agglomerative Nesting). El algoritmo comienza tratando cada objeto como un cluster único. Luego, los pares de clusters se fusionan sucesivamente hasta que todos los clusters se han fusionado en un único cluster grande que contiene todos los objetos. El resultado es una representación basada en árboles de los objetos, llamada dendrograma.
# Cargar los datos
data("USArrests")
# Estandarizar los datos
df <- scale(USArrests)
# Mostrar las primeras 6 filas
head(df, n = 6)
## Murder Assault UrbanPop Rape
## Alabama 1.24256408 0.7828393 -0.5209066 -0.003416473
## Alaska 0.50786248 1.1068225 -1.2117642 2.484202941
## Arizona 0.07163341 1.4788032 0.9989801 1.042878388
## Arkansas 0.23234938 0.2308680 -1.0735927 -0.184916602
## California 0.27826823 1.2628144 1.7589234 2.067820292
## Colorado 0.02571456 0.3988593 0.8608085 1.864967207
# Calcular la matriz de disimilaridad
res.dist <- dist(df, method = "euclidean")
# Mostrar la matriz de disimilaridad para las primeras 6 filas
as.matrix(res.dist)[1:6, 1:6]
## Alabama Alaska Arizona Arkansas California Colorado
## Alabama 0.000000 2.703754 2.293520 1.289810 3.263110 2.651067
## Alaska 2.703754 0.000000 2.700643 2.826039 3.012541 2.326519
## Arizona 2.293520 2.700643 0.000000 2.717758 1.310484 1.365031
## Arkansas 1.289810 2.826039 2.717758 0.000000 3.763641 2.831051
## California 3.263110 3.012541 1.310484 3.763641 0.000000 1.287619
## Colorado 2.651067 2.326519 1.365031 2.831051 1.287619 0.000000
# Realizar el clustering jerárquico
res.hc <- hclust(d = res.dist, method = "ward.D2")
# Visualizar el dendrograma
library("factoextra")
fviz_dend(res.hc, cex = 0.5)
## Warning: The `<scale>` argument of `guides()` cannot be `FALSE`. Use "none" instead as
## of ggplot2 3.3.4.
## ℹ The deprecated feature was likely used in the factoextra package.
## Please report the issue at <https://github.com/kassambara/factoextra/issues>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
# Calcular la distancia cofenética
res.coph <- cophenetic(res.hc)
# Correlación entre la distancia original y la distancia cofenética
cor(res.dist, res.coph)
## [1] 0.6975266
# Realizar otro clustering jerárquico con otro método
res.hc2 <- hclust(res.dist, method = "average")
cor(res.dist, cophenetic(res.hc2))
## [1] 0.7180382
# Dividir el árbol en 4 grupos
grp <- cutree(res.hc, k = 4)
head(grp, n = 4)
## Alabama Alaska Arizona Arkansas
## 1 2 2 3
# Número de miembros en cada cluster
table(grp)
## grp
## 1 2 3 4
## 7 12 19 12
# Obtener los nombres de los miembros del cluster 1
rownames(df)[grp == 1]
## [1] "Alabama" "Georgia" "Louisiana" "Mississippi"
## [5] "North Carolina" "South Carolina" "Tennessee"
# Visualizar el dendrograma con rectángulos alrededor de los grupos
fviz_dend(res.hc, k = 4, cex = 0.5,
k_colors = c("#2E9FDF", "#00AFBB", "#E7B800", "#FC4E07"),
color_labels_by_k = TRUE, rect = TRUE)
# Visualizar los clusters
fviz_cluster(list(data = df, cluster = grp),
palette = c("#2E9FDF", "#00AFBB", "#E7B800", "#FC4E07"),
ellipse.type = "convex",
repel = TRUE,
show.clust.cent = FALSE,
ggtheme = theme_minimal())
# Clustering jerárquico con diferentes métodos
library("cluster")
# Agglomerative Nesting (Hierarchical Clustering)
res.agnes <- agnes(x = df, # matriz de datos
stand = TRUE, # estandarizar los datos
metric = "euclidean", # métrica para la matriz de distancia
method = "ward") # método de enlace
# Divisive ANAlysis Clustering
res.diana <- diana(x = df, # matriz de datos
stand = TRUE, # estandarizar los datos
metric = "euclidean") # métrica para la matriz de distancia
# Visualizar el dendrograma de Agglomerative Nesting
fviz_dend(res.agnes, cex = 0.6, k = 4)
Después de mostrar cómo calcular el clustering jerárquico (Capítulo 7), aquí describimos cómo comparar dos dendrogramas usando el paquete dendextend de R. El paquete dendextend proporciona varias funciones para comparar dendrogramas. Aquí, nos enfocaremos en dos funciones:
tanglegram() para la comparación visual de dos dendrogramas y cor.dendlist() para calcular una matriz de correlación entre dendrogramas.
library(dendextend)
## Warning: package 'dendextend' was built under R version 4.3.3
##
## ---------------------
## Welcome to dendextend version 1.17.1
## Type citation('dendextend') for how to cite the package.
##
## Type browseVignettes(package = 'dendextend') for the package vignette.
## The github page is: https://github.com/talgalili/dendextend/
##
## Suggestions and bug-reports can be submitted at: https://github.com/talgalili/dendextend/issues
## You may ask questions at stackoverflow, use the r and dendextend tags:
## https://stackoverflow.com/questions/tagged/dendextend
##
## To suppress this message use: suppressPackageStartupMessages(library(dendextend))
## ---------------------
##
## Attaching package: 'dendextend'
## The following object is masked from 'package:stats':
##
## cutree
# Estandarizar los datos
df <- scale(USArrests)
# Subconjunto conteniendo 10 filas
set.seed(123)
ss <- sample(1:50, 10)
df <- df[ss,]
# Calcular la matriz de distancia
res.dist <- dist(df, method = "euclidean")
# Calcular 2 agrupamientos jerárquicos
hcl <- hclust(res.dist, method = "average")
hc2 <- hclust(res.dist, method = "ward.D2")
# Crear dos dendrogramas
dend1 <- as.dendrogram(hcl)
dend2 <- as.dendrogram(hc2)
# Crear una lista para almacenar los dendrogramas
dend_list <- dendlist(dend1, dend2)
# Comparación visual de los dendrogramas
tanglegram(dend1, dend2,
highlight_distinct_edges = FALSE, # Desactivar líneas discontinuas
common_subtrees_color_lines = FALSE, # Desactivar colores de líneas
common_subtrees_color_branches = TRUE, # Colorear ramas comunes
main = paste("entanglement =", round(entanglement(dend_list), 2)))
# Matriz de correlación cofenética
cor_cophenetic(dend1, dend2)
## [1] 0.9925544
# Matriz de correlación de Baker
cor_bakers_gamma(dend1, dend2)
## [1] 0.9895528
# Crear múltiples dendrogramas encadenando
dend1 <- df %>% dist() %>% hclust("complete") %>% as.dendrogram()
dend2 <- df %>% dist() %>% hclust("single") %>% as.dendrogram()
dend3 <- df %>% dist() %>% hclust("average") %>% as.dendrogram()
dend4 <- df %>% dist() %>% hclust("centroid") %>% as.dendrogram()
# Calcular matriz de correlación
dend_list <- dendlist("Complete" = dend1, "Single" = dend2,
"Average" = dend3, "Centroid" = dend4)
cors <- cor.dendlist(dend_list)
# Imprimir matriz de correlación
round(cors, 2)
## Complete Single Average Centroid
## Complete 1.00 0.46 0.45 0.30
## Single 0.46 1.00 0.23 0.17
## Average 0.45 0.23 1.00 0.31
## Centroid 0.30 0.17 0.31 1.00
# Visualizar la matriz de correlación
library(corrplot)
## Warning: package 'corrplot' was built under R version 4.3.3
## corrplot 0.92 loaded
corrplot(cors, method = "pie", type = "lower")
Como se describe en los capítulos anteriores, un dendrograma es una representación basada en árboles de datos creada utilizando métodos de clustering jerárquico (Capítulo 7). En este artículo, proporcionamos código en R para visualizar y personalizar dendrogramas. Además, mostramos cómo guardar y hacer zoom en un dendrograma grande.
# Cargar librerías
library(cluster)
library(factoextra)
library(dendextend)
# Cargar datos
data(USArrests)
# Estandarizar los datos y calcular distancias
df <- scale(USArrests)
dist_res <- dist(df, method = "euclidean")
# Realizar el clustering jerárquico
hc <- hclust(dist_res, method = "ward.D2")
# Visualizar el dendrograma
fviz_dend(hc, cex = 0.5)
fviz_dend(hc, cex = 0.5,
main = "Dendrogram - ward.D2",
xlab = "Objects", ylab = "Distance", sub = "1111")
fviz_dend(hc, cex = 0.5, horiz = TRUE)
# Dividir el dendrograma en 4 grupos y personalizar los colores
fviz_dend(hc, k = 4,
cex = 0.5,
k_colors = c("#2E9FDF", "#00AFBB", "#E7B800", "#FC4E07"),
color_labels_by_k = TRUE,
rect = TRUE,
rect_border = "#000000", # Proporcionar un solo color para el borde
fill = "#2E9FDF") # Proporcionar un solo color de relleno
# Otros métodos de visualización
fviz_dend(hc, k = 4, cex = 0.5, k_colors = c("#2E9FDF", "#00AFBB", "#E7B800", "#FC4E07"),
ggtheme = theme_gray())
fviz_dend(hc, k = 4, cex = 0.5, k_colors = "jco")
fviz_dend(hc, k = 4, cex = 0.4, horiz = TRUE, k_colors = "jco",
rect = TRUE, rect_border = "jco", rect_fill = TRUE)
fviz_dend(hc, cex = 0.5, k = 4, k_colors = "jco", type = "circular")
fviz_dend(hc, k = 4, k_colors = "jco", type = "phylogenic", repel = TRUE)
# Cortar el dendrograma en una altura específica
dend_plot <- fviz_dend(hc, k = 4, cex = 0.5, k_colors = "jco")
dend_data <- attr(dend_plot, "dendrogram")
dend_cuts <- cut(dend_data, h = 10)
fviz_dend(dend_cuts$upper)
## Warning in min(-diff(our_dend_heights)): no non-missing arguments to min;
## returning Inf
# Guardar el dendrograma como PDF
pdf("dendrogram.pdf", width = 30, height = 15)
p <- fviz_dend(hc, k = 4, cex = 1, k_colors = "jco")
print(p)
dev.off()
## png
## 2
# Crear un dendrograma personalizado
mycols <- c("#2E9FDF", "#00AFBB", "#E7B800", "#FC4E07")
dend <- as.dendrogram(hc) %>%
set("branches_lwd", 1) %>%
set("branches_k_color", mycols, k = 4) %>%
set("labels_colors", mycols, k = 4) %>%
set("labels_cex", 0.5)
fviz_dend(dend)
Un mapa de calor es otra forma de visualizar el clustering jerárquico. También se le llama imagen a color falso, donde los valores de los datos se transforman en una escala de colores. Los mapas de calor nos permiten visualizar simultáneamente los grupos de muestras y características. Primero se realiza el clustering jerárquico tanto de las filas como de las columnas de la matriz de datos. Las columnas/filas de la matriz de datos se reordenan según el resultado del clustering jerárquico, colocando observaciones similares cerca unas de otras. Los bloques de valores ‘altos’ y ‘bajos’ son adyacentes en la matriz de datos. Finalmente, se aplica un esquema de colores para la visualización y se muestra la matriz de datos. Visualizar la matriz de datos de esta manera puede ayudar a encontrar las variables que parecen ser características para cada grupo de muestras.
# Cargar paquetes necesarios
library(cluster)
library(factoextra)
library(dendextend)
library(gplots)
## Warning: package 'gplots' was built under R version 4.3.3
##
## Attaching package: 'gplots'
## The following object is masked from 'package:stats':
##
## lowess
library(pheatmap)
## Warning: package 'pheatmap' was built under R version 4.3.3
library(ComplexHeatmap)
## Loading required package: grid
## ========================================
## ComplexHeatmap version 2.18.0
## Bioconductor page: http://bioconductor.org/packages/ComplexHeatmap/
## Github page: https://github.com/jokergoo/ComplexHeatmap
## Documentation: http://jokergoo.github.io/ComplexHeatmap-reference
##
## If you use it in published research, please cite either one:
## - Gu, Z. Complex Heatmap Visualization. iMeta 2022.
## - Gu, Z. Complex heatmaps reveal patterns and correlations in multidimensional
## genomic data. Bioinformatics 2016.
##
##
## The new InteractiveComplexHeatmap package can directly export static
## complex heatmaps into an interactive Shiny app with zero effort. Have a try!
##
## This message can be suppressed by:
## suppressPackageStartupMessages(library(ComplexHeatmap))
## ========================================
## ! pheatmap() has been masked by ComplexHeatmap::pheatmap(). Most of the arguments
## in the original pheatmap() are identically supported in the new function. You
## can still use the original function by explicitly calling pheatmap::pheatmap().
##
## Attaching package: 'ComplexHeatmap'
## The following object is masked from 'package:pheatmap':
##
## pheatmap
library(circlize)
## Warning: package 'circlize' was built under R version 4.3.3
## ========================================
## circlize version 0.4.16
## CRAN page: https://cran.r-project.org/package=circlize
## Github page: https://github.com/jokergoo/circlize
## Documentation: https://jokergoo.github.io/circlize_book/book/
##
## If you use it in published research, please cite:
## Gu, Z. circlize implements and enhances circular visualization
## in R. Bioinformatics 2014.
##
## This message can be suppressed by:
## suppressPackageStartupMessages(library(circlize))
## ========================================
# Normalización de datos
df <- scale(mtcars)
# Visualización de heatmap con la paleta de colores personalizada
heatmap(df, scale = "none", col = colorRampPalette(c("red", "white", "blue"))(256))
# Visualización de heatmap con gplots
heatmap.2(df, scale = "none", col = bluered(100),
trace = "none", density.info = "none")
# Visualización de heatmap con pheatmap
pheatmap(df, cutree_rows = 4)
# Clustering jerárquico de filas y columnas
Rowv <- mtcars %>% scale %>% dist %>% hclust %>% as.dendrogram %>%
set("branches_k_color", k = 3) %>% set("branches_lwd", 1.2) %>%
ladderize
Colv <- mtcars %>% scale %>% t %>% dist %>% hclust %>% as.dendrogram %>%
set("branches_k_color", k = 2, value = c("orange", "blue")) %>%
set("branches_lwd", 1.2) %>%
ladderize
# Visualización de heatmap con dendextend
heatmap.2(scale(mtcars), scale = "none", col = bluered(100),
Rowv = Rowv, Colv = Colv,
trace = "none", density.info = "none")
# Visualización de heatmap con ComplexHeatmap
Heatmap(df,
name = "mtcars", # Título de la leyenda
column_title = "Variables", row_title = "Samples",
row_names_gp = gpar(fontsize = 7) # Tamaño del texto para los nombres de las filas
)
# Visualización de heatmap circular con circlize
mycols <- colorRamp2(breaks = c(-2, 0, 2),
colors = c("green", "white", "red"))
Heatmap(df, name = "mtcars", col = mycols)
# Anotación del heatmap con dendextend
row_dend <- hclust(dist(df)) # Clustering de filas
col_dend <- hclust(dist(t(df))) # Clustering de columnas
Heatmap(df, name = "mtcars",
row_names_gp = gpar(fontsize = 6.5),
cluster_rows = color_branches(row_dend, k = 4),
cluster_columns = color_branches(col_dend, k = 2))
# Divide en 2 grupos
set.seed(2)
Heatmap(df, name = "mtcars", k = 2)
El análisis de componentes principales (PCA) nos permite resumir y visualizar la información en un conjunto de datos que contiene individuos/observaciones descritos por múltiples variables cuantitativas intercorrelacionadas. Cada variable podría considerarse como una dimensión diferente. Si tienes más de 3 variables en tus conjuntos de datos, podría ser muy difícil visualizar un hiperespacio multidimensional.
El análisis de componentes principales se utiliza para extraer la información importante de una tabla de datos multivariados y expresar esta información como un conjunto de pocas variables nuevas llamadas componentes principales. Estas nuevas variables corresponden a una combinación lineal de las originales. El número de componentes principales es menor o igual al número de variables originales.
La información en un conjunto de datos dado corresponde a la variación total que contiene. El objetivo de PCA es identificar direcciones (o componentes principales) a lo largo de las cuales la variación en los datos es máxima.
En otras palabras, PCA reduce la dimensionalidad de un conjunto de datos multivariado a dos o tres componentes principales, que se pueden visualizar gráficamente, con una pérdida mínima de información.
# Cargar librerías necesarias
library(FactoMineR)
## Warning: package 'FactoMineR' was built under R version 4.3.3
library(factoextra)
library(corrplot)
# Cargar y preparar datos
data(decathlon2)
decathlon2.active <- decathlon2[1:23, 1:10]
# Ver las primeras filas de los datos activos
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
# Realizar PCA
res.pca <- PCA(decathlon2.active, graph=FALSE)
# Imprimir resultados del PCA
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"
# Obtener y mostrar valores propios
eig.val <- get_eigenvalue(res.pca)
print(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
# Visualizar la varianza explicada
fviz_eig(res.pca, addlabels=TRUE, ylim=c(0, 50))
# Obtener variables del PCA
var <- get_pca_var(res.pca)
# Coordenadas, calidad en el mapa factorial y contribuciones
print(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
print(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
print(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
# Visualizar variables en el mapa factorial
fviz_pca_var(res.pca, col.var="black")
# Mostrar cos2 y contribuciones
print(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
print(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
# Visualización de cos2 con corrplot
corrplot(var$cos2, is.corr=FALSE)
# Cos2 total de las variables en Dim.1 y Dim.2
fviz_cos2(res.pca, choice="var", axes=1:2)
# Color por valores de cos2
fviz_pca_var(res.pca, col.var="cos2",
gradient.cols=c("#00AFBB", "#E7B800", "#FC4E07"),
repel=TRUE)
# Cambiar la transparencia por valores de cos2
fviz_pca_var(res.pca, alpha.var="cos2")
# Visualización de contribuciones
fviz_contrib(res.pca, choice="var", axes=1, top=10)
fviz_contrib(res.pca, choice="var", axes=2, top=10)
fviz_contrib(res.pca, choice="var", axes=1:2, top=10)
# Color por contribución
fviz_pca_var(res.pca, col.var="contrib",
gradient.cols=c("#00AFBB", "#E7B800", "#FC4E07"))
# Cambiar la transparencia por contribuciones
fviz_pca_var(res.pca, alpha.var="contrib")
# Crear una variable continua aleatoria de longitud 10
set.seed(123)
my.cont.var <- rnorm(10)
# Colorear variables por la variable continua
fviz_pca_var(res.pca, col.var=my.cont.var,
gradient.cols=c("blue", "yellow", "red"),
legend.title="Cont.Var")
# Crear un grupo de variables usando kmeans
set.seed(123)
res.km <- kmeans(var$coord, centers=3, nstart=25)
grp <- as.factor(res.km$cluster)
# Color por grupos
fviz_pca_var(res.pca, col.var=grp,
palette=c("#0073C2FF", "#EFC000FF", "#868686FF"),
legend.title="Cluster")
# Descripción de dimensiones
res.desc <- dimdesc(res.pca, axes=c(1, 2), proba=0.05)
print(res.desc$Dim.1)
##
## Link between the variable and the continuous variables (R-square)
## =================================================================================
## 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
print(res.desc$Dim.2)
##
## Link between the variable and the continuous variables (R-square)
## =================================================================================
## correlation p.value
## Pole.vault 0.8074511 3.205016e-06
## X1500m 0.7844802 9.384747e-06
## High.jump -0.4652142 2.529390e-02
# Obtener individuos del PCA
ind <- get_pca_ind(res.pca)
# Coordenadas, calidad y contribuciones de los individuos
print(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
print(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
print(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
# Visualización de individuos
fviz_pca_ind(res.pca)
# Color por cos2
fviz_pca_ind(res.pca, col.ind="cos2",
gradient.cols=c("#00AFBB", "#E7B800", "#FC4E07"),
repel=TRUE)
# Tamaño de puntos por cos2
fviz_pca_ind(res.pca, pointsize="cos2",
pointshape=21, fill="#E7B800",
repel=TRUE)
# Color y tamaño de puntos por cos2
fviz_pca_ind(res.pca, col.ind="cos2", pointsize="cos2",
gradient.cols=c("#00AFBB", "#E7B800", "#FC4E07"),
repel=TRUE)
# Cos2 total de los individuos
fviz_cos2(res.pca, choice="ind")
# Contribución total en PC1 y PC2
fviz_contrib(res.pca, choice="ind", axes=1:2)
# Crear una variable continua aleatoria de longitud 23
set.seed(123)
my.cont.var <- rnorm(23)
# Colorear individuos por la variable continua
fviz_pca_ind(res.pca, col.ind=my.cont.var,
gradient.cols=c("blue", "yellow", "red"),
legend.title="Cont.Var")
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
# The variabLe Species (index= 5) is removed
# before PCA anaiysis
iris.pca<- PCA (iris[,-5], graph= FALSE)
fviz_pca_ind (iris.pca,
geom.ind = "point" , # show points oniy (nbut not "text")
col.ind= iris$Species, # coior by groups
palette = c ( "#00AFBB" , "#E7B800" , "#FC4E07" ),
addEllipses = TRUE , # Concentration eLLipses
legend.title= "Groups")
# Add confidence ellipses
fviz_pca_ind (iris.pca, geom.ind= "point" , col.ind= iris$Species,
palette = c ( "#00AFBB" , "#E7B800" , "#FC4E07" ),
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")
# Variables on dimensions 2 and 3
fviz_pca_var (res.pca, axes= c (2 , 3))
# Individuals on dimensions 2 and 3
fviz_pca_ind (res.pca, axes= c (2 , 3))
# Show variable points and text labels
fviz_pca_var (res.pca, geom.var= c ( "point" , "text" ))
# Show individuals text labels only
fviz_pca_ind (res.pca, geom.ind= "text" )
# Change the size of arrows an labels
fviz_pca_var(res.pca, arrowsize = 1, labelsize = 5,
repel= TRUE)
# Change points size, shape and fill color
# Change labelsize
fviz_pca_ind (res.pca,
pointsize= 3 , pointshape = 21 , fill = "lightblue",
labelsize = 5 , repel= TRUE)
# Add confidence ellipses
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")
# Convex hull
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")
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)
fviz_pca_var (res.pca, axes.linetype = "blank" )
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")
fviz_pca_biplot (res.pca, repel= TRUE ,
col.var= "#2E9FDF" , # Vari ab Les co Lor
col.ind= "#696969") # IndividuaLs coLor
fviz_pca_biplot (iris.pca,
col.ind= iris$Species, palette= "jco" ,
addEllipses = TRUE , label= "var" ,
col.var= "black" , repel= TRUE ,
legend.title= "Species" )
fviz_pca_biplot (iris.pca,
# Fi LL individuaLs by groups
geom.ind= "point" ,
pointshape = 21 ,
pointsize = 2.5 ,
fill.ind= iris$Species,
col.ind= "black" ,
# CoLor variabLe by groups
col.var= factor (c ( "sepal" , "sepal" , "petal" , "petal" )),
legend.title=list (fill = "Species" , color= "Clusters" ),
repel= TRUE)+
ggpubr::fill_palette ( "jco" )+
ggpubr:: color_palette("npg" )
fviz_pca_biplot (iris.pca,
# Individuals
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" ))
res.pca<- PCA (decathlon2, ind.sup= 24 : 27 ,
quanti.sup = 11 : 12 , quali.sup = 13 , graph=FALSE)
fviz_pca_var (res.pca)
# Change color of variables
fviz_pca_var (res.pca,
col.var = "black" , # Active variab Les
col.quanti.sup = "red")# Suppl. quantitative variables
#Hide active variables on the plot,
# show only supplementary variables
fviz_pca_var (res.pca, invisible= "var" )
# Hide supplementary variables
fviz_pca_var (res.pca, invisible= "quanti.sup" )
p <- fviz_pca_var (res.pca, invisible ="quanti.sup" )
# Add supplementary active variables
fviz_add(p, res.pca$quanti.sup$coord,
geom = c ( "arrow" , "text" ),
color= "red" )
p <- fviz_pca_ind (res.pca, col.ind.sup= "blue" , repel= TRUE)
p <- fviz_add (p, res.pca$quali.sup$coord, color= "red" )
p
res.pca$quali
## $coord
## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
## Decastar -1.343451 0.1218097 -0.03789524 0.1808357 0.1343364
## OlympicG 1.231497 -0.1116589 0.03473730 -0.1657661 -0.1231417
##
## $cos2
## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
## Decastar 0.9051233 0.007440939 0.0007201669 0.01639956 0.009050062
## OlympicG 0.9051233 0.007440939 0.0007201669 0.01639956 0.009050062
##
## $v.test
## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
## Decastar -2.970766 0.4034256 -0.1528767 0.8971036 0.7202457
## OlympicG 2.970766 -0.4034256 0.1528767 -0.8971036 -0.7202457
##
## $dist
## Decastar OlympicG
## 1.412108 1.294433
##
## $eta2
## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
## Competition 0.4011568 0.00739783 0.001062332 0.03658159 0.02357972
fviz_pca_ind (res.pca, habillage = 13 ,
addEllipses =TRUE , ellipse.type = "confidencce",
palette = "jco", repel = TRUE)
# VisuaLize variabLe with cos2 >= 0.6
fviz_pca_var (res.pca, select.var= list (cos2 = 0.6))
# Top 5 active variabLes with the highest cos2
fviz_pca_var (res.pca, select.var= list (cos2 = 5))
# SeLect by names
name<- list (name = c ( "Long.jump" , "High.jump" , "X100m" ))
fviz_pca_var (res.pca, select.var= name)
# top 5 contributing individuais and variabLe
fviz_pca_biplot (res.pca, select.ind= list (contrib = 5),
select.var= list (contrib = 5),
ggtheme = theme_minimal ())
#Scree pLot
scree.plot<- fviz_eig (res.pca)
# PLot of individuais
ind.plot<- fviz_pca_ind (res.pca)
# PLot of variabLes
var.plot<- fviz_pca_var (res.pca)
pdf ( "PCA.pdf" ) # Create a new pdf device
print (scree.plot)
print (ind.plot)
print (var.plot)
dev.off () # CLose the pdf device
## png
## 2
# Print scree pLot to a png fiLe
png ("pca-scree-plot.png11" )
print (scree.plot)
dev.off ()
## png
## 2
# Print individuaLs pLot to a png fiLe
png ( "pca-variables.png11" )
print (var.plot)
dev.off ()
## png
## 2
# Print variabLes pLot to a png fiLe
png ( "pca-individuals.png" )
print (ind.plot)
dev.off ()
## png
## 2
library (ggpubr)
## Warning: package 'ggpubr' was built under R version 4.3.3
##
## Attaching package: 'ggpubr'
## The following object is masked from 'package:dendextend':
##
## rotate
ggexport (plotlist = list (scree.plot, ind.plot, var.plot),
filename= "PCA.pdf" )
## file saved to PCA.pdf
ggexport (plotlist = list (scree.plot, ind.plot, var.plot),
nrow = 2 , ncol = 2 ,
filename= "PCA.pdf" )
## file saved to PCA.pdf
ggexport (plotlist = list (scree.plot, ind.plot, var.plot),
filename= "PCA.png" )
## [1] "PCA%03d.png"
## file saved to PCA%03d.png
# Export into a TXT Ji Le
write.infile (res.pca, "pca.txt" , sep= "\t" )
# Export into a CSV Ji Le
write.infile (res.pca, "pca.csv" , sep = ";" )
res.pca<- prcomp (iris[, - 5], scale. = TRUE)
res.pca<- princomp (iris[, - 5], cor = TRUE)
library ( "ade4" )
## Warning: package 'ade4' was built under R version 4.3.3
##
## Attaching package: 'ade4'
## The following object is masked from 'package:FactoMineR':
##
## reconst
res.pca<- dudi.pca (iris[, - 5], scannf = FALSE , nf = 5)
library ("ExPosition" )
## Loading required package: prettyGraphs
res.pca<- epPCA (iris[, - 5], graph= FALSE)
fviz_eig (res.pca) # Scree plot
fviz_pca_ind (res.pca) # Graph of individuals
fviz_pca_var (res.pca) # Graph of variables
El análisis de correspondencias (CA) es una extensión del análisis de componentes principales (Capítulo 3) adecuado para explorar relaciones entre variables cualitativas (o datos categóricos). Al igual que el análisis de componentes principales, proporciona una solución para resumir y visualizar conjuntos de datos en gráficos bidimensionales.
Aquí, describimos el análisis de correspondencias simples, que se utiliza para analizar frecuencias formadas por dos datos categóricos, una tabla de datos conocida como tabla de contingencia. Proporciona puntuaciones factoriales (coordenadas) para los puntos de fila y columna de la tabla de contingencia. Estas coordenadas se utilizan para visualizar gráficamente la asociación entre los elementos de fila y columna en la tabla de contingencia.
Al analizar una tabla de contingencia bidimensional, una pregunta típica es si ciertos elementos de las filas están asociados con algunos elementos de las columnas. El análisis de correspondencias es un enfoque geométrico para visualizar las filas y columnas de una tabla de contingencia bidimensional como puntos en un espacio de baja dimensión, de manera que las posiciones de los puntos de fila y columna sean consistentes con sus asociaciones en la tabla. El objetivo es tener una vista global de los datos que sea útil para la interpretación.
En el capítulo actual, mostraremos cómo calcular e interpretar el análisis de correspondencias utilizando dos paquetes de R: i) FactoMineR para el análisis y ii) factoextra para la visualización de datos. Además, mostraremos cómo revelar las variables más importantes que explican las variaciones en un conjunto de datos. Continuaremos explicando cómo aplicar el análisis de correspondencias utilizando filas y columnas suplementarias. Esto es importante si se desea hacer predicciones con CA. Las últimas secciones de esta guía también describen cómo filtrar los resultados de CA para conservar solo las variables que más contribuyen. Finalmente, veremos cómo tratar con valores atípicos.
library("FactoMineR")
library("factoextra")
data(housetasks)
# head(housetasks)
library("gplots")
# 1. convert the data as a table
dt <- as.table(as.matrix(housetasks))
# 2. Graph
balloonplot(t(dt), main ="housetasks", xlab ="", ylab="",
label = FALSE, show.margins = FALSE)
chisq <- chisq.test(housetasks)
chisq
##
## Pearson's Chi-squared test
##
## data: housetasks
## X-squared = 1944.5, df = 36, p-value < 2.2e-16
library("FactoMineR")
res.ca <- CA(housetasks, graph = FALSE)
print(res.ca)
## **Results of the Correspondence Analysis (CA)**
## The row variable has 13 categories; the column variable has 4 categories
## The chi square of independence between the two variables is equal to 1944.456 (p-value = 0 ).
## *The results are available in the following objects:
##
## name description
## 1 "$eig" "eigenvalues"
## 2 "$col" "results for the columns"
## 3 "$col$coord" "coord. for the columns"
## 4 "$col$cos2" "cos2 for the columns"
## 5 "$col$contrib" "contributions of the columns"
## 6 "$row" "results for the rows"
## 7 "$row$coord" "coord. for the rows"
## 8 "$row$cos2" "cos2 for the rows"
## 9 "$row$contrib" "contributions of the rows"
## 10 "$call" "summary called parameters"
## 11 "$call$marge.col" "weights of the columns"
## 12 "$call$marge.row" "weights of the rows"
# Chi-square statistics
chi2 <- 1944.456
# Degree of freedom
df <- (nrow(housetasks) - 1) * (ncol(housetasks) - 1)
# P-value
pval <- pchisq(chi2, df = df, lower.tail = FALSE)
pval
## [1] 0
library("factoextra")
eig.val <- get_eigenvalue(res.ca)
eig.val
## eigenvalue variance.percent cumulative.variance.percent
## Dim.1 0.5428893 48.69222 48.69222
## Dim.2 0.4450028 39.91269 88.60491
## Dim.3 0.1270484 11.39509 100.00000
fviz_screeplot
## function (...)
## {
## fviz_eig(...)
## }
## <bytecode: 0x00000289fd1d61f8>
## <environment: namespace:factoextra>
fviz_screeplot(res.ca) +
geom_hline(yintercept=33.33, linetype=2, color="red")
# repel= TRUE to avoid text overlapping (slow if many point)
fviz_ca_biplot(res.ca, repel = TRUE)
row <- get_ca_row(res.ca)
row
## Correspondence Analysis - Results for rows
## ===================================================
## Name Description
## 1 "$coord" "Coordinates for the rows"
## 2 "$cos2" "Cos2 for the rows"
## 3 "$contrib" "contributions of the rows"
## 4 "$inertia" "Inertia of the rows"
# Coordinates
head(row$coord)
## Dim 1 Dim 2 Dim 3
## Laundry -0.9918368 0.4953220 -0.31672897
## Main_meal -0.8755855 0.4901092 -0.16406487
## Dinner -0.6925740 0.3081043 -0.20741377
## Breakfeast -0.5086002 0.4528038 0.22040453
## Tidying -0.3938084 -0.4343444 -0.09421375
## Dishes -0.1889641 -0.4419662 0.26694926
# Cos2: quality on the factore map
head(row$cos2)
## Dim 1 Dim 2 Dim 3
## Laundry 0.7399874 0.1845521 0.07546047
## Main_meal 0.7416028 0.2323593 0.02603787
## Dinner 0.7766401 0.1537032 0.06965666
## Breakfeast 0.5049433 0.4002300 0.09482670
## Tidying 0.4398124 0.5350151 0.02517249
## Dishes 0.1181178 0.6461525 0.23572969
# Contributions to the principal components
head(row$contrib)
## Dim 1 Dim 2 Dim 3
## Laundry 18.2867003 5.563891 7.968424
## Main_meal 12.3888433 4.735523 1.858689
## Dinner 5.4713982 1.321022 2.096926
## Breakfeast 3.8249284 3.698613 3.069399
## Tidying 1.9983518 2.965644 0.488734
## Dishes 0.4261663 2.844117 3.634294
head(row$coord)
## Dim 1 Dim 2 Dim 3
## Laundry -0.9918368 0.4953220 -0.31672897
## Main_meal -0.8755855 0.4901092 -0.16406487
## Dinner -0.6925740 0.3081043 -0.20741377
## Breakfeast -0.5086002 0.4528038 0.22040453
## Tidying -0.3938084 -0.4343444 -0.09421375
## Dishes -0.1889641 -0.4419662 0.26694926
fviz_ca_row(res.ca, repel = TRUE)
fviz_ca_row(res.ca, col.row="steelblue", shape.row = 15)
head(row$cos2, 4)
## Dim 1 Dim 2 Dim 3
## Laundry 0.7399874 0.1845521 0.07546047
## Main_meal 0.7416028 0.2323593 0.02603787
## Dinner 0.7766401 0.1537032 0.06965666
## Breakfeast 0.5049433 0.4002300 0.09482670
# Color by cos2 values: quality on the factor map
fviz_ca_row(res.ca, col.row = "cos2",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE)
# Change the transparency by cos2 values
fviz_ca_row(res.ca, alpha.row="cos2")
library("corrplot")
corrplot(row$cos2, is.corr=FALSE)
# Cos2 of rows on Dim.1 and Dim.2
fviz_cos2(res.ca, choice = "row", axes = 1:2)
head(row$contrib)
## Dim 1 Dim 2 Dim 3
## Laundry 18.2867003 5.563891 7.968424
## Main_meal 12.3888433 4.735523 1.858689
## Dinner 5.4713982 1.321022 2.096926
## Breakfeast 3.8249284 3.698613 3.069399
## Tidying 1.9983518 2.965644 0.488734
## Dishes 0.4261663 2.844117 3.634294
library("corrplot")
corrplot(row$contrib, is.corr=FALSE)
# Contributions of rows to dimension 1
fviz_contrib(res.ca, choice = "row", axes = 1, top = 10)
# Contributions of rows to dimension 2
fviz_contrib(res.ca, choice = "row", axes = 2, top = 10)
# Total contribution to dimension 1 and 2
fviz_contrib(res.ca, choice = "row", axes = 1:2, top = 10)
fviz_ca_row(res.ca, col.row = "contrib",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE)
# Change the transparency by contrib values
fviz_ca_row(res.ca, alpha.row="contrib",
repel = TRUE)
col <- get_ca_col(res.ca)
col
## Correspondence Analysis - Results for columns
## ===================================================
## Name Description
## 1 "$coord" "Coordinates for the columns"
## 2 "$cos2" "Cos2 for the columns"
## 3 "$contrib" "contributions of the columns"
## 4 "$inertia" "Inertia of the columns"
# Coordinates of column points
head(col$coord)
## Dim 1 Dim 2 Dim 3
## Wife -0.83762154 0.3652207 -0.19991139
## Alternating -0.06218462 0.2915938 0.84858939
## Husband 1.16091847 0.6019199 -0.18885924
## Jointly 0.14942609 -1.0265791 -0.04644302
# Quality of representation
head(col$cos2)
## Dim 1 Dim 2 Dim 3
## Wife 0.801875947 0.1524482 0.045675847
## Alternating 0.004779897 0.1051016 0.890118521
## Husband 0.772026244 0.2075420 0.020431728
## Jointly 0.020705858 0.9772939 0.002000236
# Contributions
head(col$contrib)
## Dim 1 Dim 2 Dim 3
## Wife 44.462018 10.312237 10.8220753
## Alternating 0.103739 2.782794 82.5492464
## Husband 54.233879 17.786612 6.1331792
## Jointly 1.200364 69.118357 0.4954991
fviz_ca_col(res.ca)
fviz_ca_col(res.ca, col.col = "cos2",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE)
fviz_cos2(res.ca, choice = "col", axes = 1:2)
fviz_contrib(res.ca, choice = "col", axes = 1:2)
fviz_ca_biplot(res.ca, repel = TRUE)
fviz_ca_biplot(res.ca,
map ="rowprincipal", arrow = c(TRUE, TRUE),
repel = TRUE)
fviz_ca_biplot(res.ca, map ="colgreen", arrow = c(TRUE, FALSE),
repel = TRUE)
# Dimension description
res.desc <- dimdesc(res.ca, axes = c(1,2))
# Description of dimension 1 by row points
head(res.desc[[1]]$row, 4)
## coord
## Laundry -0.9918368
## Main_meal -0.8755855
## Dinner -0.6925740
## Breakfeast -0.5086002
# Description of dimension 1 by column points
head(res.desc[[1]]$col, 4)
## coord
## Wife -0.83762154
## Alternating -0.06218462
## Jointly 0.14942609
## Husband 1.16091847
# Description of dimension 2 by row points
res.desc[[2]]$row
## coord
## Holidays -1.4350066
## Finances -0.6178684
## Insurance -0.4737832
## Dishes -0.4419662
## Tidying -0.4343444
## Shopping -0.4033171
## Official 0.2536132
## Dinner 0.3081043
## Breakfeast 0.4528038
## Main_meal 0.4901092
## Laundry 0.4953220
## Driving 0.6534143
## Repairs 0.8642647
# Description of dimension 1 by column points
res.desc[[2]]$col
## coord
## Jointly -1.0265791
## Alternating 0.2915938
## Wife 0.3652207
## Husband 0.6019199
data(children)
# head(children)
res.ca <- CA (children, row.sup = 15:18, col.sup = 6:8,
graph = FALSE)
fviz_ca_biplot(res.ca, repel = TRUE)
fviz_ca_biplot(res.ca, repel = TRUE,
invisible = c("row.sup", "col.sup"))
res.ca$row.sup
## $coord
## Dim 1 Dim 2 Dim 3 Dim 4
## comfort 0.2096705 0.7031677 0.07111168 0.3071354
## disagreement 0.1462777 0.1190106 0.17108916 -0.3132169
## world 0.5233045 0.1429707 0.08399269 -0.1063597
## to_live 0.3083067 0.5020193 0.52093397 0.2557357
##
## $cos2
## Dim 1 Dim 2 Dim 3 Dim 4
## comfort 0.06892759 0.77524032 0.007928672 0.14790342
## disagreement 0.13132177 0.08692632 0.179649183 0.60210272
## world 0.87587685 0.06537746 0.022564054 0.03618163
## to_live 0.13899699 0.36853645 0.396830367 0.09563620
fviz_ca_row(res.ca, repel = TRUE)
res.ca$col.sup
## $coord
## Dim 1 Dim 2 Dim 3 Dim 4
## thirty 0.10541339 -0.05969594 -0.10322613 0.06977996
## fifty -0.01706444 0.04907657 -0.01568923 -0.01306117
## more_fifty -0.17706810 -0.04813788 0.10077299 -0.08517528
##
## $cos2
## Dim 1 Dim 2 Dim 3 Dim 4
## thirty 0.1375601 0.04411543 0.131910759 0.060278490
## fifty 0.0108695 0.08990298 0.009188167 0.006367804
## more_fifty 0.2860989 0.02114509 0.092666735 0.066200714
fviz_ca_col(res.ca, repel = TRUE)
# Visualize rows with cos2 >= 0.8
fviz_ca_row(res.ca, select.row = list(cos2 = 0.8))
# Top 5 active rows and 5 suppl. rows with the highest cos2
fviz_ca_row(res.ca, select.row = list(cos2 = 5))
# Select by names
name <- list(name = c("employment", "fear", "future"))
fviz_ca_row(res.ca, select.row = name)
# Top 5 contributing rows and columns
fviz_ca_biplot(res.ca, select.row = list(contrib = 5),
select.col = list(contrib = 5)) +
theme_minimal()
# Scree plot
scree.plot <- fviz_eig(res.ca)
# Biplot of row and column variables
biplot.ca <- fviz_ca_biplot(res.ca)
library(ggpubr)
ggexport(plotlist = list(scree.plot, biplot.ca),
filename = "CA.pdf")
## file saved to CA.pdf
# Export into a TXT file
write.infile(res.ca, "ca.txt", sep = "\t")
# Export into a CSV file
write.infile(res.ca, "ca.csv", sep = ";")
library("ade4")
res.ca <- dudi.coa(housetasks, scannf = FALSE, nf = 5)
library(ca)
## Warning: package 'ca' was built under R version 4.3.3
res.ca <- ca(housetasks)
library(MASS)
res.ca <- corresp(housetasks, nf = 3)
library("ExPosition")
res.ca <- epCA(housetasks, graph = FALSE)
fviz_eig(res.ca) # Scree plot
fviz_ca_biplot(res.ca) # Biplot of rows and columns
El análisis de correspondencias múltiples (MCA, por sus siglas en inglés) es una extensión del análisis de correspondencias simple (capítulo 4) para resumir y visualizar una tabla de datos que contiene más de dos variables categóricas. También puede verse como una generalización del análisis de componentes principales cuando las variables a analizar son categóricas en lugar de cuantitativas (Abdi y Williams, 2010).
El MCA se utiliza generalmente para analizar un conjunto de datos de encuestas. El objetivo es identificar:
Un grupo de individuos con perfiles similares en sus respuestas a las preguntas. Las asociaciones entre categorías de variables. Anteriormente, describimos cómo calcular e interpretar el análisis de correspondencias simple (capítulo 4). En el capítulo actual, demostramos cómo calcular y visualizar el análisis de correspondencias múltiples en el software R usando FactoMineR (para el análisis) y factoextra (para la visualización de datos). Además, mostraremos cómo revelar las variables más importantes que más contribuyen a explicar las variaciones en el conjunto de datos. Continuaremos explicando cómo predecir los resultados para individuos y variables suplementarios. Finalmente, demostraremos cómo filtrar los resultados del MCA para mantener solo las variables más contributivas.
# Cargar las bibliotecas necesarias
library("FactoMineR")
library("factoextra")
library("corrplot")
library("ggpubr")
library("ade4")
library("ExPosition")
# Cargar los datos y mostrar las primeras filas
data(poison)
head(poison[, 1:7], 3)
## Age Time Sick Sex Nausea Vomiting Abdominals
## 1 9 22 Sick_y F Nausea_y Vomit_n Abdo_y
## 2 5 0 Sick_n F Nausea_n Vomit_n Abdo_n
## 3 6 16 Sick_y F Nausea_n Vomit_y Abdo_y
# Seleccionar las variables activas
poison.active <- poison[1:55, 5:15]
summary(poison.active[, 1:4])
## Nausea Vomiting Abdominals Fever
## Nausea_n:43 Vomit_n:33 Abdo_n:18 Fever_n:20
## Nausea_y:12 Vomit_y:22 Abdo_y:37 Fever_y:35
# Graficar las primeras cuatro variables
for (i in 1:4) {
plot(poison.active[, i], main = colnames(poison.active)[i],
ylab = "Count", col = "steelblue", las = 2)
}
# Realizar el análisis de correspondencias múltiples
res.mca <- MCA(poison.active, graph = FALSE)
print(res.mca)
## **Results of the Multiple Correspondence Analysis (MCA)**
## The analysis was performed on 55 individuals, described by 11 variables
## *The results are available in the following objects:
##
## name description
## 1 "$eig" "eigenvalues"
## 2 "$var" "results for the variables"
## 3 "$var$coord" "coord. of the categories"
## 4 "$var$cos2" "cos2 for the categories"
## 5 "$var$contrib" "contributions of the categories"
## 6 "$var$v.test" "v-test for the categories"
## 7 "$var$eta2" "coord. of variables"
## 8 "$ind" "results for the individuals"
## 9 "$ind$coord" "coord. for the individuals"
## 10 "$ind$cos2" "cos2 for the individuals"
## 11 "$ind$contrib" "contributions of the individuals"
## 12 "$call" "intermediate results"
## 13 "$call$marge.col" "weights of columns"
## 14 "$call$marge.li" "weights of rows"
# Obtener los valores propios
eig.val <- get_eigenvalue(res.mca)
head(eig.val)
## eigenvalue variance.percent cumulative.variance.percent
## Dim.1 0.33523140 33.523140 33.52314
## Dim.2 0.12913979 12.913979 46.43712
## Dim.3 0.10734849 10.734849 57.17197
## Dim.4 0.09587950 9.587950 66.75992
## Dim.5 0.07883277 7.883277 74.64319
## Dim.6 0.07108981 7.108981 81.75217
# Graficar el scree plot
fviz_screeplot(res.mca, addlabels = TRUE, ylim = c(0, 45))
# Graficar el biplot del MCA
fviz_mca_biplot(res.mca,
repel = TRUE, # Evitar superposición de texto
ggtheme = theme_minimal())
# Obtener las variables del MCA
var <- get_mca_var(res.mca)
head(var$coord)
## Dim 1 Dim 2 Dim 3 Dim 4 Dim 5
## Nausea_n 0.2673909 0.12139029 -0.265583253 0.03376130 0.07370500
## Nausea_y -0.9581506 -0.43498187 0.951673323 -0.12097801 -0.26410958
## Vomit_n 0.4790279 -0.40919465 0.084492799 0.27361142 0.05245250
## Vomit_y -0.7185419 0.61379197 -0.126739198 -0.41041713 -0.07867876
## Abdo_n 1.3180221 -0.03574501 -0.005094243 -0.15360951 -0.06986987
## Abdo_y -0.6411999 0.01738946 0.002478280 0.07472895 0.03399075
head(var$cos2)
## Dim 1 Dim 2 Dim 3 Dim 4 Dim 5
## Nausea_n 0.2562007 0.0528025759 2.527485e-01 0.004084375 0.019466197
## Nausea_y 0.2562007 0.0528025759 2.527485e-01 0.004084375 0.019466197
## Vomit_n 0.3442016 0.2511603912 1.070855e-02 0.112294813 0.004126898
## Vomit_y 0.3442016 0.2511603912 1.070855e-02 0.112294813 0.004126898
## Abdo_n 0.8451157 0.0006215864 1.262496e-05 0.011479077 0.002374929
## Abdo_y 0.8451157 0.0006215864 1.262496e-05 0.011479077 0.002374929
head(var$contrib)
## Dim 1 Dim 2 Dim 3 Dim 4 Dim 5
## Nausea_n 1.515869 0.81100008 4.670018e+00 0.08449397 0.48977906
## Nausea_y 5.431862 2.90608363 1.673423e+01 0.30277007 1.75504164
## Vomit_n 3.733667 7.07226253 3.627455e-01 4.25893721 0.19036376
## Vomit_y 5.600500 10.60839380 5.441183e-01 6.38840581 0.28554563
## Abdo_n 15.417637 0.02943661 7.192511e-04 0.73219636 0.18424268
## Abdo_y 7.500472 0.01432051 3.499060e-04 0.35620363 0.08963157
# Graficar las variables del MCA
fviz_mca_var(res.mca, choice = "mca.cor",
repel = TRUE, # Evitar superposición de texto
ggtheme = theme_minimal())
head(round(var$coord, 2), 4)
## Dim 1 Dim 2 Dim 3 Dim 4 Dim 5
## Nausea_n 0.27 0.12 -0.27 0.03 0.07
## Nausea_y -0.96 -0.43 0.95 -0.12 -0.26
## Vomit_n 0.48 -0.41 0.08 0.27 0.05
## Vomit_y -0.72 0.61 -0.13 -0.41 -0.08
fviz_mca_var(res.mca,
repel = TRUE, # Evitar superposición de texto
ggtheme = theme_minimal())
fviz_mca_var(res.mca, col.var = "black", shape.var = 15,
repel = TRUE)
# Colorear por valores de cos2 (calidad en el mapa factorial)
fviz_mca_var(res.mca, col.var = "cos2",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE, # Evitar superposición de texto
ggtheme = theme_minimal())
# Cambiar la transparencia según valores de cos2
fviz_mca_var(res.mca, alpha.var = "cos2",
repel = TRUE,
ggtheme = theme_minimal())
# Graficar el mapa de correlación de cos2
corrplot(var$cos2, is.corr = FALSE)
# Graficar cos2 de las categorías de variables en Dim.1 y Dim.2
fviz_cos2(res.mca, choice = "var", axes = 1:2)
head(round(var$contrib, 2), 4)
## Dim 1 Dim 2 Dim 3 Dim 4 Dim 5
## Nausea_n 1.52 0.81 4.67 0.08 0.49
## Nausea_y 5.43 2.91 16.73 0.30 1.76
## Vomit_n 3.73 7.07 0.36 4.26 0.19
## Vomit_y 5.60 10.61 0.54 6.39 0.29
# Graficar las contribuciones de las filas a la dimensión 1
fviz_contrib(res.mca, choice = "var", axes = 1, top = 15)
# Graficar las contribuciones de las filas a la dimensión 2
fviz_contrib(res.mca, choice = "var", axes = 2, top = 15)
# Graficar la contribución total a la dimensión 1 y 2
fviz_contrib(res.mca, choice = "var", axes = 1:2, top = 15)
# Graficar las variables del MCA coloreadas por contribución
fviz_mca_var(res.mca, col.var = "contrib",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE, # Evitar superposición de texto
ggtheme = theme_minimal())
# Cambiar la transparencia según los valores de contribución
fviz_mca_var(res.mca, alpha.var = "contrib",
repel = TRUE,
ggtheme = theme_minimal())
# Obtener los individuos del MCA
ind <- get_mca_ind(res.mca)
head(ind$coord)
## Dim 1 Dim 2 Dim 3 Dim 4 Dim 5
## 1 -0.4525811 -0.26415072 0.17151614 0.01369348 -0.11696806
## 2 0.8361700 -0.03193457 -0.07208249 -0.08550351 0.51978710
## 3 -0.4481892 0.13538726 -0.22484048 -0.14170168 -0.05004753
## 4 0.8803694 -0.08536230 -0.02052044 -0.07275873 -0.22935022
## 5 -0.4481892 0.13538726 -0.22484048 -0.14170168 -0.05004753
## 6 -0.3594324 -0.43604390 -1.20932223 1.72464616 0.04348157
head(ind$cos2)
## Dim 1 Dim 2 Dim 3 Dim 4 Dim 5
## 1 0.34652591 0.1180447167 0.0497683175 0.0003172275 0.0231460846
## 2 0.55589562 0.0008108236 0.0041310808 0.0058126211 0.2148103098
## 3 0.54813888 0.0500176790 0.1379484860 0.0547920948 0.0068349171
## 4 0.74773962 0.0070299584 0.0004062504 0.0051072923 0.0507479873
## 5 0.54813888 0.0500176790 0.1379484860 0.0547920948 0.0068349171
## 6 0.02485357 0.0365775483 0.2813443706 0.5722083217 0.0003637178
head(ind$contrib)
## Dim 1 Dim 2 Dim 3 Dim 4 Dim 5
## 1 1.110927 0.98238297 0.498254685 0.003555817 0.31554778
## 2 3.792117 0.01435818 0.088003703 0.138637089 6.23134138
## 3 1.089470 0.25806722 0.856229950 0.380768961 0.05776914
## 4 4.203611 0.10259105 0.007132055 0.100387990 1.21319013
## 5 1.089470 0.25806722 0.856229950 0.380768961 0.05776914
## 6 0.700692 2.67693398 24.769968729 56.404214518 0.04360547
# Graficar los individuos del MCA coloreados por cos2
fviz_mca_ind(res.mca, col.ind = "cos2",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE, # Evitar superposición de texto
ggtheme = theme_minimal())
# Graficar cos2 de los individuos
fviz_cos2(res.mca, choice = "ind", axes = 1:2, top = 20)
# Graficar la contribución de los individuos a las dimensiones
fviz_contrib(res.mca, choice = "ind", axes = 1:2, top = 20)
# Graficar los individuos coloreados por la variable "Vomiting"
fviz_mca_ind(res.mca,
label = "none", # Ocultar etiquetas de individuos
habillage = "Vomiting", # Colorear por grupos
palette = c("#00AFBB", "#E7B800"),
addEllipses = TRUE, ellipse.type = "confidence",
ggtheme = theme_minimal())
# Colorear individuos por una variable de agrupamiento externa
fviz_mca_ind(res.mca, habillage = poison$Vomiting, addEllipses = TRUE)
# Graficar elipses para ciertas variables
fviz_ellipses(res.mca, c("Vomiting", "Fever"), geom = "point")
## Warning: `gather_()` was deprecated in tidyr 1.2.0.
## ℹ Please use `gather()` instead.
## ℹ The deprecated feature was likely used in the factoextra package.
## Please report the issue at <https://github.com/kassambara/factoextra/issues>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
fviz_ellipses(res.mca, 1:4, geom = "point")
# Describir las dimensiones del MCA
res.desc <- dimdesc(res.mca, axes = c(1, 2))
res.desc[[1]] # Descripción de la dimensión 1
##
## Link between the variable and the categorical variable (1-way anova)
## =============================================
## R2 p.value
## Abdominals 0.8451157 4.055640e-23
## Diarrhae 0.7994680 3.910776e-20
## Fever 0.7846788 2.600566e-19
## Mayo 0.3829749 4.756234e-07
## Vomiting 0.3442016 2.510738e-06
## Nausea 0.2562007 8.062777e-05
## Cheese 0.1944181 7.534834e-04
##
## Link between variable and the categories of the categorical variables
## ================================================================
## Estimate p.value
## Abdominals=Abdo_n 0.5671866 4.055640e-23
## Diarrhae=Diarrhea_n 0.5380920 3.910776e-20
## Fever=Fever_n 0.5330918 2.600566e-19
## Mayo=Mayo_n 0.4644981 4.756234e-07
## Vomiting=Vomit_n 0.3466915 2.510738e-06
## Nausea=Nausea_n 0.3547892 8.062777e-05
## Cheese=Cheese_n 0.3830043 7.534834e-04
## Cheese=Cheese_y -0.3830043 7.534834e-04
## Nausea=Nausea_y -0.3547892 8.062777e-05
## Vomiting=Vomit_y -0.3466915 2.510738e-06
## Mayo=Mayo_y -0.4644981 4.756234e-07
## Fever=Fever_y -0.5330918 2.600566e-19
## Diarrhae=Diarrhea_y -0.5380920 3.910776e-20
## Abdominals=Abdo_y -0.5671866 4.055640e-23
res.desc[[2]] # Descripción de la dimensión 2
##
## Link between the variable and the categorical variable (1-way anova)
## =============================================
## R2 p.value
## Courgette 0.4464145 2.500166e-08
## Potato 0.3957543 2.690662e-07
## Vomiting 0.2511604 9.728027e-05
## Icecream 0.1409011 4.743927e-03
##
## Link between variable and the categories of the categorical variables
## ================================================================
## Estimate p.value
## Courgette=Courg_n 0.4176013 2.500166e-08
## Potato=Potato_y 0.4977523 2.690662e-07
## Vomiting=Vomit_y 0.1838104 9.728027e-05
## Icecream=Icecream_n 0.2597197 4.743927e-03
## Icecream=Icecream_y -0.2597197 4.743927e-03
## Vomiting=Vomit_n -0.1838104 9.728027e-05
## Potato=Potato_n -0.4977523 2.690662e-07
## Courgette=Courg_y -0.4176013 2.500166e-08
# MCA con variables y individuos suplementarios
res.mca <- MCA(poison, ind.sup = 53:55,
quanti.sup = 1:2, quali.sup = 3:4, graph = FALSE)
# Variables cualitativas suplementarias
res.mca$quali.sup
## $coord
## Dim 1 Dim 2 Dim 3 Dim 4 Dim 5
## Sick_n 1.41809140 0.0020394048 0.13199139 -0.016036841 -0.08354663
## Sick_y -0.63026284 -0.0009064021 -0.05866284 0.007127485 0.03713184
## F -0.03108147 0.1123143957 0.05033124 -0.055927173 -0.06832928
## M 0.03356798 -0.1212995474 -0.05435774 0.060401347 0.07379562
##
## $cos2
## Dim 1 Dim 2 Dim 3 Dim 4 Dim 5
## Sick_n 0.893770319 1.848521e-06 0.007742990 0.0001143023 0.003102240
## Sick_y 0.893770319 1.848521e-06 0.007742990 0.0001143023 0.003102240
## F 0.001043342 1.362369e-02 0.002735892 0.0033780765 0.005042401
## M 0.001043342 1.362369e-02 0.002735892 0.0033780765 0.005042401
##
## $v.test
## Dim 1 Dim 2 Dim 3 Dim 4 Dim 5
## Sick_n 6.7514655 0.009709509 0.6284047 -0.07635063 -0.3977615
## Sick_y -6.7514655 -0.009709509 -0.6284047 0.07635063 0.3977615
## F -0.2306739 0.833551410 0.3735378 -0.41506855 -0.5071119
## M 0.2306739 -0.833551410 -0.3735378 0.41506855 0.5071119
##
## $eta2
## Dim 1 Dim 2 Dim 3 Dim 4 Dim 5
## Sick 0.893770319 1.848521e-06 0.007742990 0.0001143023 0.003102240
## Sex 0.001043342 1.362369e-02 0.002735892 0.0033780765 0.005042401
# Variables cuantitativas suplementarias
res.mca$quanti
## $coord
## Dim 1 Dim 2 Dim 3 Dim 4 Dim 5
## Age 0.003934896 -0.00741340 -0.26494536 0.20015501 0.02928483
## Time -0.838158507 -0.08330586 -0.08718851 -0.08421599 -0.02316931
# Individuos suplementarios
res.mca$ind.sup
## $coord
## Dim 1 Dim 2 Dim 3 Dim 4 Dim 5
## 53 1.0835684 0.5172478 0.5794063 0.5390903 0.4553650
## 54 -0.1249473 0.1417271 -0.1765234 -0.1526587 -0.2779565
## 55 -0.4315948 0.1270468 -0.2071580 -0.1186804 -0.1891760
##
## $cos2
## Dim 1 Dim 2 Dim 3 Dim 4 Dim 5
## 53 0.36304957 0.08272764 0.10380536 0.08986204 0.06411692
## 54 0.03157652 0.04062716 0.06302535 0.04713607 0.15626590
## 55 0.50232519 0.04352713 0.11572730 0.03798314 0.09650827
# Graficar el biplot de individuos y categorías de variables
fviz_mca_biplot(res.mca, repel = TRUE, ggtheme = theme_minimal())
# Graficar categorías de variables con cos2 >= 0.4
fviz_mca_var(res.mca, select.var = list(cos2 = 0.4))
# Graficar las 10 variables activas con mayor cos2
fviz_mca_var(res.mca, select.var = list(cos2 = 10))
# Seleccionar y graficar por nombres
name <- list(name = c("Fever_n", "Abdo_y", "Diarrhea_n", "Fever_Y", "Vomit_y", "Vomit_n"))
fviz_mca_var(res.mca, select.var = name)
# Graficar los 5 individuos y categorías de variables más contribuyentes
fviz_mca_biplot(res.mca, select.ind = list(contrib = 5),
select.var = list(contrib = 5), ggtheme = theme_minimal())
# Graficar el scree plot
scree.plot <- fviz_eig(res.mca)
# Graficar el biplot de filas y columnas
biplot.mca <- fviz_mca_biplot(res.mca)
# Exportar gráficos a PDF
ggexport(plotlist = list(scree.plot, biplot.mca), filename = "MCA.pdf")
## file saved to MCA.pdf
# Exportar resultados a archivos TXT y CSV
write.infile(res.mca, "mca.txt", sep = "\t")
write.infile(res.mca, "mca.csv", sep = ";")
# Realizar el análisis de correspondencias múltiples con ade4
res.mca <- dudi.acm(poison.active, scannf = FALSE, nf = 5)
# Realizar el análisis de correspondencias múltiples con ExPosition
res.mca <- epMCA(poison.active, graph = FALSE, correction = "bg")
# Graficar el scree plot
fviz_eig(res.mca)
# Graficar el biplot de filas y columnas
fviz_mca_biplot(res.mca)
library("FactoMineR")
library("factoextra")
library("FactoMineR")
data(wine)
df <- wine[,c(1,2, 16, 22, 29, 28, 30,31)]
head(df[, 1:7], 4)
## Label Soil Plante Acidity Harmony Intensity Overall.quality
## 2EL Saumur Env1 2.000 2.107 3.143 2.857 3.393
## 1CHA Saumur Env1 2.000 2.107 2.964 2.893 3.214
## 1FON Bourgueuil Env1 1.750 2.179 3.143 3.074 3.536
## 1VAU Chinon Env2 2.304 3.179 2.038 2.462 2.464
str(df)
## 'data.frame': 21 obs. of 8 variables:
## $ Label : Factor w/ 3 levels "Saumur","Bourgueuil",..: 1 1 2 3 1 2 2 1 3 1 ...
## $ Soil : Factor w/ 4 levels "Reference","Env1",..: 2 2 2 3 1 1 1 2 2 3 ...
## $ Plante : num 2 2 1.75 2.3 1.76 ...
## $ Acidity : num 2.11 2.11 2.18 3.18 2.57 ...
## $ Harmony : num 3.14 2.96 3.14 2.04 3.64 ...
## $ Intensity : num 2.86 2.89 3.07 2.46 3.64 ...
## $ Overall.quality: num 3.39 3.21 3.54 2.46 3.74 ...
## $ Typical : num 3.25 3.04 3.18 2.25 3.44 ...
library(FactoMineR)
res.famd <- FAMD(df, graph = FALSE)
print(res.famd)
## *The results are available in the following objects:
##
## name description
## 1 "$eig" "eigenvalues and inertia"
## 2 "$var" "Results for the variables"
## 3 "$ind" "results for the individuals"
## 4 "$quali.var" "Results for the qualitative variables"
## 5 "$quanti.var" "Results for the quantitative variables"
library("factoextra")
eig.val <- get_eigenvalue(res.famd)
head(eig.val)
## eigenvalue variance.percent cumulative.variance.percent
## Dim.1 4.8315174 43.922886 43.92289
## Dim.2 1.8568797 16.880724 60.80361
## Dim.3 1.5824794 14.386176 75.18979
## Dim.4 1.1491200 10.446546 85.63633
## Dim.5 0.6518053 5.925503 91.56183
fviz_screeplot(res.famd)
var <- get_famd_var(res.famd)
var
## FAMD results for variables
## ===================================================
## Name Description
## 1 "$coord" "Coordinates"
## 2 "$cos2" "Cos2, quality of representation"
## 3 "$contrib" "Contributions"
# Coordinates of variables
head(var$coord)
## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
## Plante 0.7344160 0.060551966 0.105902048 0.004011299 0.0010340559
## Acidity 0.1732738 0.491118153 0.126394029 0.115376784 0.0045862935
## Harmony 0.8943968 0.023628146 0.040124469 0.003653813 0.0086624633
## Intensity 0.6991811 0.134639254 0.065382234 0.023214984 0.0064730431
## Overall.quality 0.9115699 0.005246728 0.009336677 0.005445276 0.0007961880
## Typical 0.7808611 0.027094327 0.001549791 0.083446627 0.0005912942
# Cos2: quality of representation on the factore map
head(var$cos2)
## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
## Plante 0.53936692 3.666541e-03 1.121524e-02 1.609052e-05 1.069272e-06
## Acidity 0.03002381 2.411970e-01 1.597545e-02 1.331180e-02 2.103409e-05
## Harmony 0.79994566 5.582893e-04 1.609973e-03 1.335035e-05 7.503827e-05
## Intensity 0.48885427 1.812773e-02 4.274836e-03 5.389355e-04 4.190029e-05
## Overall.quality 0.83095973 2.752815e-05 8.717353e-05 2.965103e-05 6.339153e-07
## Typical 0.60974400 7.341026e-04 2.401853e-06 6.963340e-03 3.496288e-07
# Contributions to the dimensions
head(var$contrib)
## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
## Plante 15.200526 3.2609526 6.69215972 0.3490757 0.15864490
## Acidity 3.586323 26.4485720 7.98708850 10.0404466 0.70362936
## Harmony 18.511716 1.2724651 2.53554453 0.3179662 1.32899551
## Intensity 14.471254 7.2508336 4.13163258 2.0202401 0.99309457
## Overall.quality 18.867156 0.2825562 0.59000304 0.4738648 0.12215119
## Typical 16.161818 1.4591321 0.09793437 7.2617850 0.09071638
# Plot of variables
fviz_famd_var(res.famd, repel = TRUE)
# Contribution to the first dimension
fviz_contrib(res.famd, "var", axes = 1)
# Contribution to the second dimension
fviz_contrib(res.famd, "var", axes = 2)
quanti.var <- get_famd_var(res.famd, "quanti.var")
quanti.var
## FAMD results for quantitative variables
## ===================================================
## Name Description
## 1 "$coord" "Coordinates"
## 2 "$cos2" "Cos2, quality of representation"
## 3 "$contrib" "Contributions"
fviz_famd_var(res.famd, "quanti.var", repel = TRUE,
col.var = "black")
fviz_famd_var(res.famd, "quanti.var", col.var = "contrib",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE)
# Color by cos2 values: quality on the factor map
fviz_famd_var(res.famd, "quanti.var", col.var = "cos2",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE)
quali.var <- get_famd_var(res.famd, "quali.var")
quali.var
## FAMD results for qualitative variable categories
## ===================================================
## Name Description
## 1 "$coord" "Coordinates"
## 2 "$cos2" "Cos2, quality of representation"
## 3 "$contrib" "Contributions"
fviz_famd_var(res.famd, "quali.var", col.var = "contrib",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07")
)
ind <- get_famd_ind(res.famd)
ind
## FAMD results for individuals
## ===================================================
## Name Description
## 1 "$coord" "Coordinates"
## 2 "$cos2" "Cos2, quality of representation"
## 3 "$contrib" "Contributions"
fviz_famd_ind(res.famd, col.ind = "cos2",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE)
fviz_mfa_ind(res.famd,
habillage = "Label", # color by groups
palette = c("#00AFBB", "#E7B800", "#FC4E07"),
addEllipses = TRUE, ellipse.type = "confidence",
repel = TRUE # Avoid text overlapping
)
fviz_ellipses(res.famd, c("Label", "Soil"), repel = TRUE)
fviz_ellipses(res.famd, 1:2, geom = "point")
El análisis de factores múltiples (MFA) (Páginas, 2002) es un método de análisis de datos multivariado para resumir y visualizar una tabla de datos compleja en la que los individuos son descritos por varios conjuntos de variables (cuantitativas y/o cualitativas) estructuradas en grupos. Toma en cuenta la contribución de todos los grupos activos de variables para definir la distancia entre los individuos.
El número de variables en cada grupo puede diferir y la naturaleza de las variables (cualitativas o cuantitativas) puede variar de un grupo a otro, pero las variables deben ser de la misma naturaleza dentro de un grupo dado (Abdi y Williams, 2010).
El MFA puede considerarse como un análisis factorial general. En términos generales, el núcleo del MFA se basa en:
Análisis de componentes principales (PCA) (Capítulo 3) cuando las variables son cuantitativas. Análisis de correspondencias múltiples (MCA) (Capítulo 5) cuando las variables son cualitativas. Este análisis global, en el que se consideran simultáneamente múltiples conjuntos de variables, requiere equilibrar las influencias de cada conjunto de variables. Por lo tanto, en el MFA, las variables se ponderan durante el análisis. Las variables en el mismo grupo se normalizan utilizando el mismo valor de ponderación, que puede variar de un grupo a otro. Técnicamente, el MFA asigna a cada variable del grupo j, un peso igual al inverso del primer valor propio del análisis (PCA o MCA según el tipo de variable) del grupo j.
El análisis de factores múltiples puede usarse en una variedad de campos (Páginas, 2002), donde las variables están organizadas en grupos:
Análisis de encuestas, donde un individuo es una persona; una variable es una pregunta. Las preguntas están organizadas por temas (grupos de preguntas). Análisis sensorial, donde un individuo es un producto alimenticio. Un primer conjunto de variables incluye variables sensoriales (dulzura, amargor, etc.); un segundo conjunto incluye variables químicas (pH, tasa de glucosa, etc.). Ecología, donde un individuo es un lugar de observación. Un primer conjunto de variables describe las características del suelo; un segundo conjunto describe la flora. Series temporales, donde se observan varios individuos en diferentes fechas. En esta situación, hay comúnmente dos formas de definir grupos de variables: Generalmente, las variables observadas al mismo tiempo (fecha) se agrupan. Cuando las variables son las mismas de una fecha a otra, cada conjunto puede agrupar las diferentes fechas para una variable. En el capítulo actual, mostramos cómo calcular y visualizar el análisis de factores múltiples en el software R utilizando FactoMineR (para el análisis) y factoextra (para la visualización de datos). Además, mostraremos cómo revelar las variables más importantes que más contribuyen a explicar las variaciones en el conjunto de datos.
library("FactoMineR")
library("factoextra")
library("FactoMineR")
data(wine)
colnames(wine)
## [1] "Label" "Soil"
## [3] "Odor.Intensity.before.shaking" "Aroma.quality.before.shaking"
## [5] "Fruity.before.shaking" "Flower.before.shaking"
## [7] "Spice.before.shaking" "Visual.intensity"
## [9] "Nuance" "Surface.feeling"
## [11] "Odor.Intensity" "Quality.of.odour"
## [13] "Fruity" "Flower"
## [15] "Spice" "Plante"
## [17] "Phenolic" "Aroma.intensity"
## [19] "Aroma.persistency" "Aroma.quality"
## [21] "Attack.intensity" "Acidity"
## [23] "Astringency" "Alcohol"
## [25] "Balance" "Smooth"
## [27] "Bitterness" "Intensity"
## [29] "Harmony" "Overall.quality"
## [31] "Typical"
library(FactoMineR)
data(wine)
res.mfa <- MFA(wine,
group = c(2, 5, 3, 10, 9, 2),
type = c("n", "s", "s", "s", "s", "s"),
name.group = c("origin","odor","visual",
"odor.after.shaking", "taste","overall"),
num.group.sup = c(1, 6),
graph = FALSE)
print(res.mfa)
## **Results of the Multiple Factor Analysis (MFA)**
## The analysis was performed on 21 individuals, described by 31 variables
## *Results are available in the following objects :
##
## name description
## 1 "$eig" "eigenvalues"
## 2 "$separate.analyses" "separate analyses for each group of variables"
## 3 "$group" "results for all the groups"
## 4 "$partial.axes" "results for the partial axes"
## 5 "$inertia.ratio" "inertia ratio"
## 6 "$ind" "results for the individuals"
## 7 "$quanti.var" "results for the quantitative variables"
## 8 "$quanti.var.sup" "results for the quantitative supplementary variables"
## 9 "$quali.var.sup" "results for the categorical supplementary variables"
## 10 "$summary.quanti" "summary for the quantitative variables"
## 11 "$summary.quali" "summary for the categorical variables"
## 12 "$global.pca" "results for the global PCA"
library("factoextra")
eig.val <- get_eigenvalue(res.mfa)
head(eig.val)
## eigenvalue variance.percent cumulative.variance.percent
## Dim.1 3.4619504 49.378382 49.37838
## Dim.2 1.3667683 19.494446 68.87283
## Dim.3 0.6154291 8.777969 77.65080
## Dim.4 0.3721997 5.308747 82.95954
## Dim.5 0.2703825 3.856511 86.81605
## Dim.6 0.2024033 2.886912 89.70297
fviz_screeplot(res.mfa)
group <- get_mfa_var(res.mfa, "group")
group
## Multiple Factor Analysis results for variable groups
## ===================================================
## Name Description
## 1 "$coord" "Coordinates"
## 2 "$cos2" "Cos2, quality of representation"
## 3 "$contrib" "Contributions"
## 4 "$correlation" "Correlation between groups and principal dimensions"
# Coordinates of groups
head(group$coord)
## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
## odor 0.7820738 0.61977283 0.37353451 0.17260092 0.08553276
## visual 0.8546846 0.04014481 0.01438360 0.04550736 0.02966750
## odor.after.shaking 0.9247734 0.46892047 0.18009116 0.10139051 0.11589439
## taste 0.9004187 0.23793016 0.04741982 0.05270088 0.03928784
# Cos2: quality of representation on the factore map
head(group$cos2)
## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
## odor 0.3799491 0.238613517 0.0866745169 0.018506155 0.0045445922
## visual 0.7284016 0.001607007 0.0002062976 0.002065011 0.0008776492
## odor.after.shaking 0.6245535 0.160582210 0.0236855692 0.007507471 0.0098089810
## taste 0.7222292 0.050429542 0.0020031144 0.002474125 0.0013749986
# Contributions to the dimensions
head(group$contrib)
## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
## odor 22.59055 45.345861 60.694972 46.37321 31.63399
## visual 24.68795 2.937207 2.337166 12.22660 10.97242
## odor.after.shaking 26.71250 34.308703 29.262699 27.24089 42.86313
## taste 26.00900 17.408230 7.705163 14.15930 14.53047
fviz_mfa_var(res.mfa, "group")
# Contribution to the first dimension
fviz_contrib(res.mfa, "group", axes = 1)
# Contribution to the second dimension
fviz_contrib(res.mfa, "group", axes = 2)
quanti.var <- get_mfa_var(res.mfa, "quanti.var")
quanti.var
## Multiple Factor Analysis results for quantitative variables
## ===================================================
## Name Description
## 1 "$coord" "Coordinates"
## 2 "$cos2" "Cos2, quality of representation"
## 3 "$contrib" "Contributions"
# Coordinates
head(quanti.var$coord)
## Dim.1 Dim.2 Dim.3 Dim.4
## Odor.Intensity.before.shaking 0.5908036 0.66723783 -0.02326175 0.3287015
## Aroma.quality.before.shaking 0.8352510 -0.07539908 -0.35417877 0.1414425
## Fruity.before.shaking 0.7160259 -0.15069626 -0.53748761 0.2517063
## Flower.before.shaking 0.4387181 -0.40937751 0.63731284 0.4029075
## Spice.before.shaking 0.0380525 0.86501993 0.12795122 -0.1822298
## Visual.intensity 0.8811873 0.23833245 0.14099033 -0.2128871
## Dim.5
## Odor.Intensity.before.shaking 0.05786231
## Aroma.quality.before.shaking 0.04992114
## Fruity.before.shaking 0.18981578
## Flower.before.shaking 0.12200773
## Spice.before.shaking 0.36741971
## Visual.intensity -0.17676282
# Cos2: quality on the factore map
head(quanti.var$cos2)
## Dim.1 Dim.2 Dim.3 Dim.4
## Odor.Intensity.before.shaking 0.349048863 0.445206325 0.000541109 0.10804466
## Aroma.quality.before.shaking 0.697644264 0.005685021 0.125442602 0.02000597
## Fruity.before.shaking 0.512693037 0.022709361 0.288892928 0.06335608
## Flower.before.shaking 0.192473567 0.167589944 0.406167661 0.16233443
## Spice.before.shaking 0.001447992 0.748259477 0.016371514 0.03320769
## Visual.intensity 0.776491025 0.056802358 0.019878273 0.04532093
## Dim.5
## Odor.Intensity.before.shaking 0.003348047
## Aroma.quality.before.shaking 0.002492121
## Fruity.before.shaking 0.036030029
## Flower.before.shaking 0.014885886
## Spice.before.shaking 0.134997242
## Visual.intensity 0.031245096
# Contributions to the dimensions
head(quanti.var$contrib)
## Dim.1 Dim.2 Dim.3 Dim.4
## Odor.Intensity.before.shaking 4.49733206 14.5296787 0.03921898 12.948424
## Aroma.quality.before.shaking 8.98882147 0.1855354 9.09194110 2.397581
## Fruity.before.shaking 6.60581103 0.7411389 20.93864000 7.592798
## Flower.before.shaking 2.47993227 5.4694372 29.43858302 19.454686
## Spice.before.shaking 0.01865671 24.4200703 1.18658923 3.979718
## Visual.intensity 7.91221841 1.4660681 1.13941864 4.295418
## Dim.5
## Odor.Intensity.before.shaking 0.5523351
## Aroma.quality.before.shaking 0.4111309
## Fruity.before.shaking 5.9439566
## Flower.before.shaking 2.4557588
## Spice.before.shaking 22.2708049
## Visual.intensity 4.0764862
fviz_mfa_var(res.mfa, "quanti.var", palette = "jco",
col.var.sup = "violet", repel = TRUE)
fviz_mfa_var(res.mfa, "quanti.var", palette = "jco",
col.var.sup = "violet", repel = TRUE,
geom = c("point", "text"), legend = "bottom")
# Contributions to dimension 1
fviz_contrib(res.mfa, choice = "quanti.var", axes = 1, top = 20,
palette = "jco")
# Contributions to dimension 2
fviz_contrib(res.mfa, choice = "quanti.var", axes = 2, top = 20,
palette = "jco")
fviz_mfa_var(res.mfa, "quanti.var", col.var = "contrib",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
col.var.sup = "violet", repel = TRUE,
geom = c("point", "text"))
# Color by cos2 values: quality on the factor map
fviz_mfa_var(res.mfa, col.var = "cos2",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
col.var.sup = "violet", repel = TRUE)
fviz_cos2(res.mfa, choice = "quanti.var", axes = 1)
ind <- get_mfa_ind(res.mfa)
ind
## Multiple Factor Analysis results for individuals
## ===================================================
## Name Description
## 1 "$coord" "Coordinates"
## 2 "$cos2" "Cos2, quality of representation"
## 3 "$contrib" "Contributions"
## 4 "$coord.partiel" "Partial coordinates"
## 5 "$within.inertia" "Within inertia"
## 6 "$within.partial.inertia" "Within partial inertia"
fviz_mfa_ind(res.mfa, col.ind = "cos2",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE)
fviz_mfa_ind(res.mfa,
habillage = "Label", # color by groups
palette = c("#00AFBB", "#E7B800", "#FC4E07"),
addEllipses = TRUE, ellipse.type = "confidence",
repel = TRUE # Avoid text overlapping
)
fviz_ellipses(res.mfa, c("Label", "Soil"), repel = TRUE)
fviz_ellipses(res.mfa, 1:2, geom = "point")
fviz_mfa_ind(res.mfa, partial = "all")
fviz_mfa_ind(res.mfa, partial = c("1DAM", "1VAU", "2ING"))
fviz_mfa_axes(res.mfa)
La agrupación (clustering) es uno de los métodos importantes de minería de datos para descubrir conocimiento en conjuntos de datos multivariados. El objetivo es identificar grupos (es decir, clusters) de objetos similares dentro de un conjunto de datos de interés. Para aprender más sobre la agrupación, puedes leer nuestro libro titulado “Guía Práctica para el Análisis de Clústeres en R” (https://goo.gl/DmJ5y5).
Brevemente, las dos estrategias de agrupación más comunes son:
Agrupación jerárquica, utilizada para identificar grupos de observaciones similares en un conjunto de datos. Agrupación por partición, como el algoritmo k-means, utilizado para dividir un conjunto de datos en varios grupos. El enfoque HCPC (Agrupación Jerárquica sobre Componentes Principales) nos permite combinar los tres métodos estándar utilizados en los análisis de datos multivariados (Husson et al., 2010):
Métodos de componentes principales (PCA, CA, MCA, FAMD, MFA), Agrupación jerárquica y Agrupación por partición, particularmente el método k-means.
library(factoextra)
library(FactoMineR)
library(FactoMineR)
# Compute PCA with ncp = 3
res.pca <- PCA(USArrests, ncp = 3, graph = FALSE)
# Compute hierarchical clustering on principal components
res.hcpc <- HCPC(res.pca, graph = FALSE)
fviz_dend(res.hcpc,
cex = 0.7, # Label size
palette = "jco", # Color palette see ?ggpubr::ggpar
rect = TRUE, rect_fill = TRUE, # Add rectangle around groups
rect_border = "jco", # Rectangle color
labels_track_height = 0.8 # Augment the room for labels
)
fviz_cluster(res.hcpc,
repel = TRUE, # Avoid label overlapping
show.clust.cent = TRUE, # Show cluster centers
palette = "jco", # Color palette see ?ggpubr::ggpar
ggtheme = theme_minimal(),
main = "Factor map"
)
# Principal components + tree
plot(res.hcpc, choice = "3D.map")
head(res.hcpc$data.clust, 10)
## Murder Assault UrbanPop Rape clust
## Alabama 13.2 236 58 21.2 3
## Alaska 10.0 263 48 44.5 4
## Arizona 8.1 294 80 31.0 4
## Arkansas 8.8 190 50 19.5 3
## California 9.0 276 91 40.6 4
## Colorado 7.9 204 78 38.7 4
## Connecticut 3.3 110 77 11.1 2
## Delaware 5.9 238 72 15.8 2
## Florida 15.4 335 80 31.9 4
## Georgia 17.4 211 60 25.8 3
res.hcpc$desc.var$quanti
## $`1`
## v.test Mean in category Overall mean sd in category Overall sd
## UrbanPop -3.898420 52.07692 65.540 9.691087 14.329285
## Murder -4.030171 3.60000 7.788 2.269870 4.311735
## Rape -4.052061 12.17692 21.232 3.130779 9.272248
## Assault -4.638172 78.53846 170.760 24.700095 82.500075
## p.value
## UrbanPop 9.682222e-05
## Murder 5.573624e-05
## Rape 5.076842e-05
## Assault 3.515038e-06
##
## $`2`
## v.test Mean in category Overall mean sd in category Overall sd
## UrbanPop 2.793185 73.87500 65.540 8.652131 14.329285
## Murder -2.374121 5.65625 7.788 1.594902 4.311735
## p.value
## UrbanPop 0.005219187
## Murder 0.017590794
##
## $`3`
## v.test Mean in category Overall mean sd in category Overall sd
## Murder 4.357187 13.9375 7.788 2.433587 4.311735
## Assault 2.698255 243.6250 170.760 46.540137 82.500075
## UrbanPop -2.513667 53.7500 65.540 7.529110 14.329285
## p.value
## Murder 1.317449e-05
## Assault 6.970399e-03
## UrbanPop 1.194833e-02
##
## $`4`
## v.test Mean in category Overall mean sd in category Overall sd
## Rape 5.352124 33.19231 21.232 6.996643 9.272248
## Assault 4.356682 257.38462 170.760 41.850537 82.500075
## UrbanPop 3.028838 76.00000 65.540 10.347798 14.329285
## Murder 2.913295 10.81538 7.788 2.001863 4.311735
## p.value
## Rape 8.692769e-08
## Assault 1.320491e-05
## UrbanPop 2.454964e-03
## Murder 3.576369e-03
res.hcpc$desc.axes$quanti
## $`1`
## v.test Mean in category Overall mean sd in category Overall sd
## Dim.1 -5.175764 -1.964502 -5.828671e-16 0.6192556 1.574878
## p.value
## Dim.1 2.269806e-07
##
## $`2`
## v.test Mean in category Overall mean sd in category Overall sd
## Dim.2 3.585635 0.7428712 -4.951595e-16 0.6137936 0.9948694
## p.value
## Dim.2 0.0003362596
##
## $`3`
## v.test Mean in category Overall mean sd in category Overall sd
## Dim.1 2.058338 1.0610731 -5.828671e-16 0.5146613 1.5748783
## Dim.3 2.028887 0.3965588 -4.163336e-18 0.3714503 0.5971291
## Dim.2 -4.536594 -1.4773302 -4.951595e-16 0.5750284 0.9948694
## p.value
## Dim.1 3.955769e-02
## Dim.3 4.246985e-02
## Dim.2 5.717010e-06
##
## $`4`
## v.test Mean in category Overall mean sd in category Overall sd
## Dim.1 4.986474 1.892656 -5.828671e-16 0.6126035 1.574878
## p.value
## Dim.1 6.149115e-07
res.hcpc$desc.ind$para
## Cluster: 1
## Idaho South Dakota Maine Iowa New Hampshire
## 0.3674381 0.4993032 0.5012072 0.5533105 0.5891145
## ------------------------------------------------------------
## Cluster: 2
## Ohio Oklahoma Pennsylvania Kansas Indiana
## 0.2796100 0.5047549 0.5088363 0.6039091 0.7100820
## ------------------------------------------------------------
## Cluster: 3
## Alabama South Carolina Georgia Tennessee Louisiana
## 0.3553460 0.5335189 0.6136865 0.8522640 0.8780872
## ------------------------------------------------------------
## Cluster: 4
## Michigan Arizona New Mexico Maryland Texas
## 0.3246254 0.4532480 0.5176322 0.9013514 0.9239792
# Loading data
library(FactoMineR)
data(tea)
# Performing MCA
res.mca <- MCA(tea,
ncp = 20, # Number of components kept
quanti.sup = 19, # Quantitative supplementary variables
quali.sup = c(20:36), # Qualitative supplementary variables
graph=FALSE)
res.hcpc <- HCPC (res.mca, graph = FALSE, max = 3)
# Dendrogram
fviz_dend(res.hcpc, show_labels = FALSE)
# Individuals facor map
fviz_cluster(res.hcpc, geom = "point", main = "Factor map")
# Description by variables
res.hcpc$desc.var$test.chi2
## p.value df
## where 8.465616e-79 4
## how 3.144675e-47 4
## price 1.862462e-28 10
## tearoom 9.624188e-19 2
## pub 8.539893e-10 2
## friends 6.137618e-08 2
## resto 3.537876e-07 2
## How 3.616532e-06 6
## Tea 1.778330e-03 4
## sex 1.789593e-03 2
## frequency 1.973274e-03 6
## work 3.052988e-03 2
## tea.time 3.679599e-03 2
## lunch 1.052478e-02 2
## dinner 2.234313e-02 2
## always 3.600913e-02 2
## sugar 3.685785e-02 2
## sophisticated 4.077297e-02 2
# Description by variable categories
res.hcpc$desc.var$category
## $`1`
## Cla/Mod Mod/Cla Global p.value
## where=chain store 85.937500 93.750000 64.000000 2.094419e-40
## how=tea bag 84.117647 81.250000 56.666667 1.478564e-25
## tearoom=Not.tearoom 70.661157 97.159091 80.666667 1.082077e-18
## price=p_branded 83.157895 44.886364 31.666667 1.631861e-09
## pub=Not.pub 67.088608 90.340909 79.000000 1.249296e-08
## friends=Not.friends 76.923077 45.454545 34.666667 2.177180e-06
## resto=Not.resto 64.705882 81.250000 73.666667 4.546462e-04
## price=p_private label 90.476190 10.795455 7.000000 1.343844e-03
## tea.time=Not.tea time 67.938931 50.568182 43.666667 4.174032e-03
## How=alone 64.102564 71.022727 65.000000 9.868387e-03
## work=Not.work 63.380282 76.704545 71.000000 1.036429e-02
## sugar=sugar 66.206897 54.545455 48.333333 1.066744e-02
## always=Not.always 63.959391 71.590909 65.666667 1.079912e-02
## price=p_unknown 91.666667 6.250000 4.000000 1.559798e-02
## frequency=1 to 2/week 75.000000 18.750000 14.666667 1.649092e-02
## frequency=1/day 68.421053 36.931818 31.666667 1.958790e-02
## age_Q=15-24 68.478261 35.795455 30.666667 2.179803e-02
## price=p_cheap 100.000000 3.977273 2.333333 2.274539e-02
## lunch=Not.lunch 61.328125 89.204545 85.333333 2.681490e-02
## SPC=senior 42.857143 8.522727 11.666667 4.813710e-02
## lunch=lunch 43.181818 10.795455 14.666667 2.681490e-02
## always=always 48.543689 28.409091 34.333333 1.079912e-02
## sugar=No.sugar 51.612903 45.454545 51.666667 1.066744e-02
## work=work 47.126437 23.295455 29.000000 1.036429e-02
## tea.time=tea time 51.479290 49.431818 56.333333 4.174032e-03
## How=lemon 30.303030 5.681818 11.000000 5.943089e-04
## resto=resto 41.772152 18.750000 26.333333 4.546462e-04
## How=other 0.000000 0.000000 3.000000 2.952904e-04
## price=p_variable 44.642857 28.409091 37.333333 1.595638e-04
## frequency=+2/day 45.669291 32.954545 42.333333 9.872288e-05
## friends=friends 48.979592 54.545455 65.333333 2.177180e-06
## how=unpackaged 19.444444 3.977273 12.000000 4.328211e-07
## pub=pub 26.984127 9.659091 21.000000 1.249296e-08
## where=tea shop 6.666667 1.136364 10.000000 4.770573e-10
## price=p_upscale 18.867925 5.681818 17.666667 9.472539e-11
## how=tea bag+unpackaged 27.659574 14.772727 31.333333 1.927326e-13
## tearoom=tearoom 8.620690 2.840909 19.333333 1.082077e-18
## where=chain store+tea shop 11.538462 5.113636 26.000000 1.133459e-23
## v.test
## where=chain store 13.307475
## how=tea bag 10.449142
## tearoom=Not.tearoom 8.826287
## price=p_branded 6.030764
## pub=Not.pub 5.692859
## friends=Not.friends 4.736242
## resto=Not.resto 3.506146
## price=p_private label 3.206448
## tea.time=Not.tea time 2.864701
## How=alone 2.580407
## work=Not.work 2.563432
## sugar=sugar 2.553408
## always=Not.always 2.549133
## price=p_unknown 2.418189
## frequency=1 to 2/week 2.397866
## frequency=1/day 2.334149
## age_Q=15-24 2.293869
## price=p_cheap 2.277684
## lunch=Not.lunch 2.214202
## SPC=senior -1.976156
## lunch=lunch -2.214202
## always=always -2.549133
## sugar=No.sugar -2.553408
## work=work -2.563432
## tea.time=tea time -2.864701
## How=lemon -3.434198
## resto=resto -3.506146
## How=other -3.619397
## price=p_variable -3.775692
## frequency=+2/day -3.893709
## friends=friends -4.736242
## how=unpackaged -5.053925
## pub=pub -5.692859
## where=tea shop -6.226471
## price=p_upscale -6.475138
## how=tea bag+unpackaged -7.353743
## tearoom=tearoom -8.826287
## where=chain store+tea shop -10.029275
##
## $`2`
## Cla/Mod Mod/Cla Global p.value
## where=tea shop 90.000000 84.375 10.00000 3.703402e-30
## how=unpackaged 66.666667 75.000 12.00000 5.346850e-20
## price=p_upscale 49.056604 81.250 17.66667 2.392655e-17
## Tea=green 27.272727 28.125 11.00000 4.436713e-03
## sophisticated=sophisticated 13.488372 90.625 71.66667 8.080918e-03
## sex=M 16.393443 62.500 40.66667 9.511848e-03
## resto=Not.resto 13.122172 90.625 73.66667 1.587879e-02
## dinner=dinner 28.571429 18.750 7.00000 1.874042e-02
## escape.exoticism=Not.escape-exoticism 14.556962 71.875 52.66667 2.177458e-02
## how=tea bag+unpackaged 5.319149 15.625 31.33333 3.876799e-02
## escape.exoticism=escape-exoticism 6.338028 28.125 47.33333 2.177458e-02
## dinner=Not.dinner 9.318996 81.250 93.00000 1.874042e-02
## resto=resto 3.797468 9.375 26.33333 1.587879e-02
## Tea=Earl Grey 7.253886 43.750 64.33333 1.314753e-02
## sex=F 6.741573 37.500 59.33333 9.511848e-03
## sophisticated=Not.sophisticated 3.529412 9.375 28.33333 8.080918e-03
## where=chain store+tea shop 2.564103 6.250 26.00000 3.794134e-03
## price=p_variable 3.571429 12.500 37.33333 1.349384e-03
## age_Q=15-24 2.173913 6.250 30.66667 6.100227e-04
## price=p_branded 2.105263 6.250 31.66667 4.024289e-04
## how=tea bag 1.764706 9.375 56.66667 5.537403e-09
## where=chain store 1.562500 9.375 64.00000 1.664577e-11
## v.test
## where=tea shop 11.410559
## how=unpackaged 9.156781
## price=p_upscale 8.472945
## Tea=green 2.845318
## sophisticated=sophisticated 2.648670
## sex=M 2.593088
## resto=Not.resto 2.411690
## dinner=dinner 2.350655
## escape.exoticism=Not.escape-exoticism 2.294277
## how=tea bag+unpackaged -2.066641
## escape.exoticism=escape-exoticism -2.294277
## dinner=Not.dinner -2.350655
## resto=resto -2.411690
## Tea=Earl Grey -2.479748
## sex=F -2.593088
## sophisticated=Not.sophisticated -2.648670
## where=chain store+tea shop -2.894789
## price=p_variable -3.205264
## age_Q=15-24 -3.427119
## price=p_branded -3.538486
## how=tea bag -5.830161
## where=chain store -6.732775
##
## $`3`
## Cla/Mod Mod/Cla Global p.value
## where=chain store+tea shop 85.897436 72.826087 26.00000 5.730651e-34
## how=tea bag+unpackaged 67.021277 68.478261 31.33333 1.382641e-19
## tearoom=tearoom 77.586207 48.913043 19.33333 1.252051e-16
## pub=pub 63.492063 43.478261 21.00000 1.126679e-09
## friends=friends 41.836735 89.130435 65.33333 1.429181e-09
## price=p_variable 51.785714 63.043478 37.33333 1.572243e-09
## resto=resto 54.430380 46.739130 26.33333 2.406386e-07
## How=other 100.000000 9.782609 3.00000 1.807938e-05
## frequency=+2/day 41.732283 57.608696 42.33333 4.237330e-04
## tea.time=tea time 38.461538 70.652174 56.33333 8.453564e-04
## work=work 44.827586 42.391304 29.00000 9.079377e-04
## sex=F 37.078652 71.739130 59.33333 3.494245e-03
## lunch=lunch 50.000000 23.913043 14.66667 3.917102e-03
## How=lemon 51.515152 18.478261 11.00000 8.747530e-03
## sugar=No.sugar 36.129032 60.869565 51.66667 3.484061e-02
## home=home 31.615120 100.000000 97.00000 3.506563e-02
## home=Not.home 0.000000 0.000000 3.00000 3.506563e-02
## sugar=sugar 24.827586 39.130435 48.33333 3.484061e-02
## price=p_private label 9.523810 2.173913 7.00000 2.370629e-02
## how=unpackaged 13.888889 5.434783 12.00000 1.645107e-02
## How=alone 25.128205 53.260870 65.00000 5.300881e-03
## lunch=Not.lunch 27.343750 76.086957 85.33333 3.917102e-03
## sex=M 21.311475 28.260870 40.66667 3.494245e-03
## Tea=green 9.090909 3.260870 11.00000 2.545816e-03
## frequency=1 to 2/week 11.363636 5.434783 14.66667 1.604219e-03
## work=Not.work 24.882629 57.608696 71.00000 9.079377e-04
## tea.time=Not.tea time 20.610687 29.347826 43.66667 8.453564e-04
## where=tea shop 3.333333 1.086957 10.00000 1.466234e-04
## price=p_branded 14.736842 15.217391 31.66667 2.746948e-05
## resto=Not.resto 22.171946 53.260870 73.66667 2.406386e-07
## friends=Not.friends 9.615385 10.869565 34.66667 1.429181e-09
## pub=Not.pub 21.940928 56.521739 79.00000 1.126679e-09
## how=tea bag 14.117647 26.086957 56.66667 1.082059e-12
## tearoom=Not.tearoom 19.421488 51.086957 80.66667 1.252051e-16
## where=chain store 12.500000 26.086957 64.00000 1.711522e-19
## v.test
## where=chain store+tea shop 12.150084
## how=tea bag+unpackaged 9.053653
## tearoom=tearoom 8.278053
## pub=pub 6.090345
## friends=friends 6.052158
## price=p_variable 6.036775
## resto=resto 5.164845
## How=other 4.287379
## frequency=+2/day 3.524844
## tea.time=tea time 3.337500
## work=work 3.317602
## sex=F 2.920541
## lunch=lunch 2.884762
## How=lemon 2.621767
## sugar=No.sugar 2.110206
## home=home 2.107600
## home=Not.home -2.107600
## sugar=sugar -2.110206
## price=p_private label -2.261856
## how=unpackaged -2.398752
## How=alone -2.788157
## lunch=Not.lunch -2.884762
## sex=M -2.920541
## Tea=green -3.017842
## frequency=1 to 2/week -3.155139
## work=Not.work -3.317602
## tea.time=Not.tea time -3.337500
## where=tea shop -3.796720
## price=p_branded -4.193490
## resto=Not.resto -5.164845
## friends=Not.friends -6.052158
## pub=Not.pub -6.090345
## how=tea bag -7.119644
## tearoom=Not.tearoom -8.278053
## where=chain store -9.030332
res.hcpc$desc.axes
##
## Link between the cluster variable and the quantitative variables
## ================================================================
## Eta2 P-value
## Dim.2 0.66509105 2.828937e-71
## Dim.1 0.63497903 1.009707e-65
## Dim.4 0.11231020 2.073924e-08
## Dim.14 0.03141943 8.732913e-03
## Dim.6 0.02358138 2.890373e-02
##
## Description of each cluster by quantitative variables
## =====================================================
## $`1`
## v.test Mean in category Overall mean sd in category Overall sd
## Dim.6 2.647552 0.03433626 1.608233e-17 0.2655618 0.2671712
## Dim.2 -7.796641 -0.13194656 5.612264e-17 0.1813156 0.3486355
## Dim.1 -12.409741 -0.23196088 1.299886e-17 0.2143767 0.3850642
## p.value
## Dim.6 8.107689e-03
## Dim.2 6.357699e-15
## Dim.1 2.314001e-35
##
## $`2`
## v.test Mean in category Overall mean sd in category Overall sd
## Dim.2 13.918285 0.81210870 5.612264e-17 0.2340345 0.3486355
## Dim.4 4.350620 0.20342610 -2.717589e-17 0.3700048 0.2793822
## Dim.14 2.909073 0.10749165 2.015604e-17 0.2161509 0.2207818
## Dim.13 2.341566 0.08930402 -4.333917e-18 0.1606616 0.2278809
## Dim.3 2.208179 0.11087544 1.000213e-17 0.2449710 0.3000159
## Dim.11 -2.234447 -0.08934293 -1.678345e-17 0.2066708 0.2389094
## p.value
## Dim.2 4.905356e-44
## Dim.4 1.357531e-05
## Dim.14 3.625025e-03
## Dim.13 1.920305e-02
## Dim.3 2.723180e-02
## Dim.11 2.545367e-02
##
## $`3`
## v.test Mean in category Overall mean sd in category Overall sd
## Dim.1 13.485906 0.45155993 1.299886e-17 0.2516544 0.3850642
## Dim.6 -2.221728 -0.05161581 1.608233e-17 0.2488566 0.2671712
## Dim.4 -4.725270 -0.11479621 -2.717589e-17 0.2924881 0.2793822
## p.value
## Dim.1 1.893256e-41
## Dim.6 2.630166e-02
## Dim.4 2.298093e-06
res.hcpc$desc.ind$para
## Cluster: 1
## 285 152 166 143 71
## 0.5884476 0.6242123 0.6242123 0.6244176 0.6478185
## ------------------------------------------------------------
## Cluster: 2
## 31 95 53 182 202
## 0.6620553 0.7442013 0.7610437 0.7948663 0.8154826
## ------------------------------------------------------------
## Cluster: 3
## 172 33 233 18 67
## 0.7380497 0.7407711 0.7503006 0.7572188 0.7701598