Laboratorio2
HP18033
2022-11-26
Indicaciones Generales: Presente en un reporte de Rmardown todas las operaciones que se indican en la tarea, debe incluir el archivo rmd, la correspondiente versión html y el informe publicado en una cuenta de Rpubs (incluir el enlace en los comentarios de entrega de las tareas, y en un archivo txt dentro de la entrega), incluyendo los nombres y apellidos de cada uno de los integrantes del grupo.
Tema de investigación del laboratorio: Análisis de Clúster (Conglomerados)
1. Explique en qué consiste el análisis de conglomerados.
Este análisis de conglomerados es un método de minería para datos multidimensionales muy importante cuando se tiene un tema de interés en una investigación y descubrir conocimientos con el propósito de identificar patrones y grupos de objetos con similitudes de un conjunto de datos que se tiene dicho interés, clasifica objetos en grupos menos homogéneos o con los más homogéneos con la base de variables que se consideraron esta clasificación también se conoce como taxonomía numérica. Un uso común para su aplicación es en la investigación del cáncer también en el marketing para analizar el mercado.
2. Elabore un cuadro comparativo, que incluya los siguientes elementos: (Lo indicado en rojo corresponde a los elementos a redactar, en la versión a ser entregada debe aparecer el texto negro normal)
knitr::include_graphics("cuadro2l.png")
3. Describa las técnicas disponibles para realizar el análisis de clúster, tanto jerárquicas como no jerárquicas, presentadas en el cuadro anterior, incluya una explicación de la librería y sintaxis para implementarla en R.
Vecino más cercano: Una vez que se conocen las distancias existentes entre cada dos individuos se observa cuáles son los individuos más próximos en cuanto a esta distancia o similaridad (qué dos individuos tienen menor distancia o mayor similaridad). Estos dos individuos forman un grupo que no vuelve a separarse durante el proceso.
Vecino mas lejano: Conocidas las distancias o similaridades existentes entre cada dos individuos se observa cuáles son los individuos más próximos en cuanto a esta distancia o similaridad (qué dos individuos tienen menor distancia o mayor similaridad). Estos dos individuos formarán un grupo que no vuelve a separarse durante el proceso.
Método de la mediana: es una variación de la agrupación de centroides, donde no se considera el número de individuos que forman cada uno de los agrupamientos. En el método anterior se calcula el centroide en función del número de individuos de cada conglomerado, de modo que cuando se une un gran conglomerado (por ejemplo 10 casos) con otro muy pequeño (por ejemplo 2 casos), este último apenas varía la situación del centroide inicial. En el método de la mediana no se considera el número de elementos de cada conglomerado, sino el número de conglomerados.
Método de Ward: Cuando se unen dos conglomerados, con independencia del método utilizado, la varianza aumenta. El método de Ward une los casos buscando minimizar la varianza dentro de cada grupo. Para ello se calcula, en primer lugar, la media de todas las variables en cada conglomerado. A continuación, se calcula la distancia entre cada caso y la media del conglomerado, sumando después las distancias entre todos los casos. Posteriormente se agrupan los conglomerados que generan menos aumentos en la suma de las distancias dentro de cada conglomerado. Este procedimiento crea grupos homogéneos y con tamaños similares.
Promedio entre grupos: La distancia entre los grupos es la media aritmética de las distancias existentes entre todos los componentes de cada grupo, considerados dos a dos. Se consiguen grupos con varianzas similares y pequeñas. Método del centroide: La distancia entre dos grupos es la distancia existente entre sus centros de gravedad (centroides). El proceso comienza calculando el centro de gravedad de cada conglomerado, para agrupar los conglomerados cuya distancia entre centroides sea mínima. Tras unir dos conglomerados se calculó el nuevo centro de gravedad y se procede de forma similar. Con este procedimiento se reduce la influencia de casos extremos.
Metodo de centroide: K-centroides representa una clase de algoritmos para hacer lo que se conoce como particionamiento de Cluster Analysis, estos métodos funcionan al tomar los registros en una base de datos y dividirlos (particionarlos) en los “mejores” grupos K basados en algunos criterios
Metodos no jerárquicos
K-Medias: comienza con una división del conjunto de los datos en (x) grupos configurados al azar y posteriormente busca mejorar esta primera clasificación reasignando los elementos al centroide del clúster más cercano, tratando de reducir la distancia media entre cada elemento de un grupo y su centroide.
Búsqueda de densidad: Los métodos que se encuentran en esta categoría, tienen su base en la suposición de que los puntos pertenecientes a cada cluster se extraen de una distribución de probabilidad particular. Los métodos de densidad proporcionan una aproximación tipológica y una aproximación probabilística
Nubes dinámicas los algoritmos de clasificación clásicos generan particiones en las que cada objeto de x es asignado a una única clase. Sin embargo, a veces los objetos no pueden ser asignados estrictamente a una clase pues están localizados ‘entre’ distintas clases.
un ejemplo de metodo de Linkage
library(cluster)
library(factoextra)## Loading required package: ggplot2## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBadata("USArrests")
dataframe1 <- scale(USArrests)
res_dist <- dist(dataframe1, method = "euclidean")
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.000000res_hcgraf <- hclust(d = res_dist, method = "ward.D2")
fviz_dend(res_hcgraf, 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 <]8;;https://github.com/kassambara/factoextra/issueshttps://github.com/kassambara/factoextra/issues]8;;>.
4. Del texto: Kassambara, A. (2017). Practical Guide to Cluster Analysis in R: Unsupervised Machine Learning (Multivariate Analysis) (1st ed.). STHDA. desarrolle los ejemplos presentados en los capítulos: 4,5,6,7,8,9.
Ejercicio del capitulo 4
library(ggplot2)
library(factoextra)
data("USArrests")
datfram <- scale(USArrests)
fviz_nbclust(datfram, kmeans, method = "wss") +
geom_vline(xintercept = 4, linetype = 2)
set.seed(123)
km.res <- kmeans(datfram, 4, nstart = 25)
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.19231dd <- 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 4km.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 3head(km.res$cluster, 4)## Alabama Alaska Arizona Arkansas
## 1 4 4 1km.res$size## [1] 8 13 16 13km.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.27693964fviz_cluster(
km.res,
data = datfram,
palette = c("#2E9FDF", "#00AFBB", "#E7B800", "#FC4E07"),
ellipse.type = "euclid",
star.plot = TRUE,
repel = TRUE,
ggtheme = theme_minimal()
)
#### Ejercicio del capitulo 5
library(cluster)
fviz_nbclust(datfram, pam, method = "silhouette") +
theme_classic()
pam.res <- pam(datfram, 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 1pam.res$medoids## Murder Assault UrbanPop Rape
## New Mexico 0.8292944 1.3708088 0.3081225 1.1603196
## Nebraska -0.8008247 -0.8250772 -0.2445636 -0.5052109head(pam.res$clustering)## Alabama Alaska Arizona Arkansas California Colorado
## 1 1 1 2 1 1Ejercicio del capitulo 6
fviz_nbclust(datfram, clara, method = "silhouette") +
theme_classic()
clara.res <- clara(datfram, 2, samples = 50, pamLike = TRUE)
print(clara.res)## Call: clara(x = datfram, k = 2, samples = 50, pamLike = TRUE)
## Medoids:
## Murder Assault UrbanPop Rape
## New Mexico 0.8292944 1.3708088 0.3081225 1.1603196
## Nebraska -0.8008247 -0.8250772 -0.2445636 -0.5052109
## Objective function: 1.368969
## Clustering vector: Named int [1:50] 1 1 1 2 1 1 2 2 1 1 2 2 1 2 2 2 2 1 ...
## - attr(*, "names")= chr [1:50] "Alabama" "Alaska" "Arizona" "Arkansas" "California" "Colorado" "Connecticut" ...
## Cluster sizes: 20 30
## Best sample:
## [1] Alabama Arizona California Colorado Connecticut
## [6] Delaware Georgia Idaho Illinois Iowa
## [11] Kansas Kentucky Louisiana Maine Maryland
## [16] Massachusetts Michigan Minnesota Mississippi Missouri
## [21] Montana Nebraska Nevada New Hampshire New Mexico
## [26] New York North Carolina North Dakota Ohio Oklahoma
## [31] Oregon Pennsylvania Rhode Island South Carolina South Dakota
## [36] Tennessee Texas Utah Vermont Virginia
## [41] Washington West Virginia Wisconsin Wyoming
##
## Available components:
## [1] "sample" "medoids" "i.med" "clustering" "objective"
## [6] "clusinfo" "diss" "call" "silinfo" "data"dd <- cbind(datfram, cluster = clara.res$cluster)
head(dd, n = 4)## Murder Assault UrbanPop Rape cluster
## Alabama 1.24256408 0.7828393 -0.5209066 -0.003416473 1
## Alaska 0.50786248 1.1068225 -1.2117642 2.484202941 1
## Arizona 0.07163341 1.4788032 0.9989801 1.042878388 1
## Arkansas 0.23234938 0.2308680 -1.0735927 -0.184916602 2clara.res$medoids## Murder Assault UrbanPop Rape
## New Mexico 0.8292944 1.3708088 0.3081225 1.1603196
## Nebraska -0.8008247 -0.8250772 -0.2445636 -0.5052109head(clara.res$clustering, 10)## Alabama Alaska Arizona Arkansas California Colorado
## 1 1 1 2 1 1
## Connecticut Delaware Florida Georgia
## 2 2 1 1fviz_cluster(
clara.res,
palette = c("#00AFBB", "#FC4E07"),
ellipse.type = "t",
geom = "point",
pointsize = 1,
ggtheme = theme_classic()
)
#### Ejercicio del capitulo 7
data("USArrests")
df <- scale(USArrests)
head(df, nrow = 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.864967207res.dist <- dist(df, method = "euclidean")
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.000000res.hc <- hclust(d = res.dist, method = "ward.D2")
fviz_dend(res.hc, cex = 0.5)
res.coph <- cophenetic(res.hc)
cor(res.dist, res.coph)## [1] 0.6975266res.hc2 <- hclust(res.dist, method = "average")
cor(res.dist, cophenetic(res.hc2))## [1] 0.7180382grp <- cutree(res.hc, k = 4)
head(grp, n = 4)## Alabama Alaska Arizona Arkansas
## 1 2 2 3table(grp)## grp
## 1 2 3 4
## 7 12 19 12rownames(df)[grp == 1]## [1] "Alabama" "Georgia" "Louisiana" "Mississippi"
## [5] "North Carolina" "South Carolina" "Tennessee"fviz_dend(
res.hc,
k = 4,
cex = 0.5,
k_colors = c("#2E9FDF", "#00AFBB", "#E7B800", "#FC4E07"),
color_labels_by_k = TRUE,
rect = TRUE
)
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()
)
res.agnes <-
agnes(
x = USArrests,
stand = TRUE,
metric = "euclidean",
method = "ward"
)
res.diana <-
diana(x = USArrests, stand = TRUE, metric = "euclidean")
fviz_dend(res.agnes, cex = 0.6, k = 4)
#### Ejercicio del capitulo 8
library(dendextend)##
## ---------------------
## Welcome to dendextend version 1.16.0
## 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':
##
## cutreeres.dist <- dist(df, method = "euclidean")
hc1 <- hclust(res.dist, method = "average")
hc2 <- hclust(res.dist, method = "ward.D2")
dend1 <- as.dendrogram (hc1)
dend2 <- as.dendrogram (hc2)
dend_list <- dendlist(dend1, dend2)
tanglegram(dend1, dend2)
tanglegram(
dend1,
dend2,
highlight_distinct_edges = FALSE,
common_subtrees_color_lines = FALSE,
common_subtrees_color_branches = TRUE,
main = paste("entanglement =", round(entanglement(dend_list), 2))
)
cor.dendlist(dend_list, method = "cophenetic")## [,1] [,2]
## [1,] 1.000000 0.843143
## [2,] 0.843143 1.000000cor.dendlist(dend_list, method = "baker")## [,1] [,2]
## [1,] 1.0000000 0.8400675
## [2,] 0.8400675 1.0000000cor_cophenetic(dend1, dend2)## [1] 0.843143cor_bakers_gamma(dend1, dend2)## [1] 0.8400675dend1 <- 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
dend_list <-
dendlist(
"Complete" = dend1,
"Single" = dend2,
"Average" = dend3,
"Centroid" = dend4
)
cors <- cor.dendlist(dend_list)
round(cors, 2)## Complete Single Average Centroid
## Complete 1.00 0.50 0.86 0.49
## Single 0.50 1.00 0.58 0.71
## Average 0.86 0.58 1.00 0.61
## Centroid 0.49 0.71 0.61 1.00library(corrplot)## corrplot 0.92 loadedcorrplot(cors, "pie", "lower")
Ejercicio del capitulo 9
data(USArrests)
dd <- dist(scale(USArrests), method = "euclidean")
hc <- hclust(dd, method = "ward.D2")
fviz_dend(hc, cex = 0.5)
fviz_dend(
hc,
cex = 0.5,
main = "Dendrogram - ward.D2",
xlab = "Objects",
ylab = "Distance",
sub = ""
)
fviz_dend(hc, cex = 0.5, horiz = TRUE)
fviz_dend(
hc,
k = 4,
cex = 0.5,
k_colors = c("#2E9FDF", "#00AFBB", "#E7B800", "#FC4E07"),
color_labels_by_k = TRUE,
ggtheme = theme_gray()
)
fviz_dend(hc,
cex = 0.5,
k = 4,
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"
)
require("igraph")## Loading required package: igraph##
## Attaching package: 'igraph'## The following objects are masked from 'package:stats':
##
## decompose, spectrum## The following object is masked from 'package:base':
##
## unionfviz_dend(
hc,
k = 4,
k_colors = "jco",
type = "phylogenic",
repel = TRUE
)
fviz_dend(
hc,
k = 4,
k_colors = "jco",
type = "phylogenic",
repel = TRUE,
phylo_layout = "layout.gem"
)
fviz_dend(hc, xlim = c(1, 20), ylim = c(1, 8))
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)): ningún argumento finito para min;
## retornando Inf
print(dend_plot)
fviz_dend(dend_cuts$lower[[1]], main = "Subtree 1")
fviz_dend(dend_cuts$lower[[2]], main = "Subtree 2")
fviz_dend(dend_cuts$lower[[2]], type = "circular")
data <- scale(USArrests)
dist.res <- dist(data)
hc <- hclust(dist.res, method = "ward.D2")
dend <- as.dendrogram(hc)
plot(dend)
dend <-
USArrests[1:5, ] %>% scale %>% dist %>% hclust(method = "ward.D2") %>% as.dendrogram
plot(dend)
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)
Bibliografia
https://www.ugr.es/~bioestad/_private/cpfund7.pdf
[Multivariate Analysis 1] Alboukadel Kassa … ine Learning (2017, STHDA) - libgen.lc.pdf