Parte 1 (pág 0-81)

Capítulo 4

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())

Capítulo 5

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 ())

Capítulo 6

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())

Capítulo 7

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)

Capítulo 8

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")

Capítulo 9

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)

Capítulo 10

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)

Parte 2 (pág 81-222)

Capítulo 3

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

Capítulo 4

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

Capítulo 5

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)

Capítulo 6

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")

Capítulo 7

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)

Capítulo 8

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