UNIVERSIDAD DE EL SALVADOR
FACULTAD DE CIENCIAS ECONÓMICAS
ESCUELA DE ECONOMÍA
CICLO II-2024
ANALISIS DE CLUSTER
METODOS PARA EL ANALISIS ECONOMICO
DOCENTE:
CARLOS ADEMIR PÉREZ ALAS
PRESENTADO POR:
| INTEGRANTES | CARNET | PORCENTAJE |
|---|---|---|
| LOPEZ RIVAS, ROXANA BEATRIZ | LR12002 | 100% |
| CORTEZ CARRILLO, KARLA XIOMARA | CC19020 | 100% |
| LEON REYES, CESIA YASMIN | LR21033 | 100% |
| ZOMETA MORAN, KIMBERLY YAMILETH | ZM21018 | 100% |
El análisis de conglomerados es una técnica que agrupa objetos o individuos con características similares. Cada grupo se llama “conglomerado” o “clúster” y reúne elementos que comparten características, mientras que los elementos en diferentes conglomerados son distintos entre sí. En otras palabras, el análisis de conglomerados nos ayuda a organizar un conjunto de datos en grupos homogéneos en función de sus características. Esta técnica es útil para clasificar datos en distintos campos, como en biología, donde se agrupan especies con características parecidas, o en negocios, donde se agrupa a clientes según patrones de compra. También es especialmente valioso en áreas como la psiquiatría, donde existen diversas maneras de clasificar condiciones, pero no siempre hay un acuerdo claro sobre cómo hacerlo.
Un método relacionado es el análisis discriminante, pero hay una diferencia clave: el análisis discriminante se usa cuando ya se conoce la categoría o clase a la que pertenece cada elemento y se busca entender la relación entre las características y esa clase. En cambio, el análisis de conglomerados no parte de una clasificación conocida, sino que intenta descubrir grupos ocultos basándose únicamente en las características de los datos.
|
Análisis de Clubster |
Tecnicas disponibles |
Ventajas |
Desventajas |
|
Jerárquico: Es un método de agrupación que combina datos similares en pasos sucesivos, comenzando con cada dato en su propio grupo y uniéndose progresivamente hasta formar un solo conglomerado. Este enfoque aglomerativo organiza los datos en una estructura jerárquica visualizada mediante un dendrograma. |
|
|
|
|
No Jerarquico: Asignar objetos a conglomerados especificando previamente el número de grupos a formar. Se inicia eligiendo un centro o "semilla" para cada conglomerado y asignando los objetos cercanos. Este proceso se repite hasta que todos los objetos están asignados. Es conocido como aglomeración de K-medias y puede usar distintas técnicas para seleccionar las semillas y asignar los objetos. |
|
1)Menor sensibilidad a los atípicos
2)Menos influenciados por la medida de distancia utilizada
3)Mayor flexibilidad frente a variables irrelevantes
4)Resultados más estables con semillas especificadas
|
|
Fuente: Elaboración propia
Referencia: (Kassambara 2017)
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.
Agrupa elementos en función de la menor distancia entre objetos de diferentes clústeres, resultando en clústeres alargados y menos compactos.
Sintaxis:
res.dist <- dist(data, method = “euclidean”)
res.hc <- hclust(d = res.dist, method = “single”)
plot(res.hc)
Se enfoca en la distancia máxima entre elementos de diferentes clústeres, lo que tiende a formar grupos más compactos.
Sintaxis:
res.hc <- hclust(d = res.dist, method = “complete”)
plot(res.hc)
Calcula la distancia promedio entre todos los elementos de dos clústeres, proporcionando un balance entre los métodos de encadenamiento simple y completo.
Sintaxis:
res.hc <- hclust(d = res.dist, method = “average”)
plot(res.hc)
Minimiza la varianza total dentro de los clústeres en cada paso de fusión, resultando en grupos más homogéneos.
Sintaxis:
res.hc <- hclust(d = res.dist, method = “ward.D2”)
plot(res.hc)
Agrupa elementos basándose en la distancia entre los centroides de los clústeres.
Sintaxis:
res.hc <- hclust(d = res.dist, method = “centroid”)
plot(res.hc)
Asigna cada punto de datos al clúster con el centroide más cercano, minimizando la variación interna de los clústeres.
Sintaxis:
res.km <- kmeans(data, centers = 3, nstart = 25)
library(factoextra)
fviz_cluster(res.km, data = data)
Similar a k-means, pero usa medoids en lugar de centroides, lo que lo hace más robusto frente a valores atípicos.
Sintaxis:
library(cluster)
res.pam <- pam(data, k = 3)
fviz_cluster(res.pam, data = data)
Una extensión de PAM para manejar grandes conjuntos de datos mediante la selección de muestras.
Sintaxis:
library(cluster)
res.clara <- clara(data, k = 3)
fviz_cluster(res.clara, data = data)
Algoritmo basado en redes neuronales que proyecta datos de alta dimensionalidad en un espacio de menor dimensión, permitiendo una visualización intuitiva de los clústeres.
Sintaxis:
library(kohonen)
data_matrix <- as.matrix(data)
som_grid <- somgrid(xdim = 5, ydim = 5, topo = “hexagonal”)
som_model <- som(data_matrix, grid = som_grid)
plot(som_model, type = “codes”)
## 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
library(factoextra)
fviz_nbclust(df, kmeans, method = "wss") +
geom_vline(xintercept = 4, linetype = 2)## 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"
## 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
## 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
## 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
## Alabama Alaska Arizona Arkansas
## 1 4 4 1
## [1] 8 13 16 13
## 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("#BC8F8F", "#DEB887", "#B8860B", "#8B4513"),
ellipse.type = "euclid",
star.plot = TRUE,
repel = TRUE,
ggtheme = theme_minimal()
)## 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
## 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"
## 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
## Murder Assault UrbanPop Rape
## New Mexico 0.8292944 1.3708088 0.3081225 1.1603196
## Nebraska -0.8008247 -0.8250772 -0.2445636 -0.5052109
## Alabama Alaska Arizona Arkansas California Colorado
## 1 1 1 2 1 1
# Preparación de datos
set.seed(1234)
# Generar 500 objetos, divididos en 2 grupos
df <- rbind(cbind(rnorm(200,0,8), rnorm(200,0,8)),
cbind(rnorm(300,50,8), rnorm(300,50,8)))
# especificación de columnas y filas
colnames(df) <- c("x", "y")
rownames(df) <- paste0("S", 1:nrow(df))
# Previsualización de los datos
head(df, nrow = 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
library(cluster)
library(factoextra)
fviz_nbclust(df, clara, method = "silhouette")+
theme_classic()## 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"
## 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
## x y
## S121 -1.531137 1.145057
## S455 48.357304 50.233499
## S1 S2 S3 S4 S5 S6 S7 S8 S9 S10
## 1 1 1 1 1 1 1 1 1 1
## 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
## 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
# Calcular la distancia cofenética
res.coph <- cophenetic(res.hc)
# Correlación entre la distancia cofenética y la distancia original
cor(res.dist, res.coph)## [1] 0.6975266
## [1] 0.7180382
## Alabama Alaska Arizona Arkansas
## 1 2 2 3
## grp
## 1 2 3 4
## 7 12 19 12
## [1] "Alabama" "Georgia" "Louisiana" "Mississippi"
## [5] "North Carolina" "South Carolina" "Tennessee"
# Cortar los 4 cluster por color
fviz_dend(res.hc, k=4,
cex = 0.5,
k_colors = c("#00008D", "#00AFBB", "#DC143C", "#FF7F50"),
color_labels_by_k = T,
rect = T
)fviz_cluster(list(data = df, cluster = grp),
palette = c("#00008D", "#00AFBB", "#DC143C", "#FF7F50"),
ellipse.type = "convex",
repel = T,
show.clust.cent = F, ggtheme = theme_minimal())# Preparación de datos
df <- scale(USArrests)
#Subconjunto que contenga 10 fila
set.seed(123)
ss <- sample(1:50, 10)
df <- df[ss,]library(dendextend)
# Calcular la matriz de distancia
res.dist <- dist(df, method = "euclidean")
# Calcular 2 Cluster jerarquicos
hc1 <- hclust(res.dist, method = "average")
hc2 <- hclust(res.dist, method = "ward.D2")
# Crear 2 dendrogramas
dend1 <- as.dendrogram (hc1)
dend2 <- as.dendrogram(hc2)
# Crear un lista para contener dendrogramas
dend_list <- dendlist(dend1, dend2)# Personalización de tanglegram
tanglegram(dend1, dend2,
highlight_distinct_edges = F,
common_subtrees_color_lines = F,
common_subtrees_color_branches = T,
main = paste("entanglement =", round(entanglement(dend_list), 2))
)## [,1] [,2]
## [1,] 1.0000000 0.9925544
## [2,] 0.9925544 1.0000000
## [,1] [,2]
## [1,] 1.0000000 0.9895528
## [2,] 0.9895528 1.0000000
## [1] 0.9925544
## [1] 0.9895528
También es posible comparar simultáneamente varios dendrogramas. Un operador de encadenamiento %>% se utiliza para ejecutar varias funciones al mismo tiempo. Es útil para simplificar la código:
# Creación multiples dendrogramas por encadenamiento
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 la matriz de correlación
dend_list <- dendlist("complete" = dend1, "single" = dend2, "average" = dend3, "centroid" = dend4)
cors <- cor.dendlist(dend_list)
print(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
# Visualizacion de la matriz de correlación usando paquete corrplot
library(corrplot)
corrplot(cors, "pie", "lower")data("USArrests")
# Calcular la distancia y agrupamiento jerarquico
dd <- dist(scale(USArrests), method = "euclidean")
hc <- hclust(dd, method = "ward.D2")library(factoextra)
fviz_dend(hc, cex = 0.5,
main = "Dendrograma - ward.D2",
xlab = "Objetos", ylab = "Distancia", sub = "")colorear las ramas por grupos y añadir rectángulos alrededor de cada cluster
fviz_dend( hc, k = 4,
cex = 0.5,
k_colors = c("#1E90FF", "#9932CC", "#E9967A", "#228B22"),
color_labels_by_k = TRUE,
rect = TRUE, rect_border = "jco", rect_fill = T)# Cambiar el tema de la trama
fviz_dend(hc, k = 4,
cex = 0.5,
k_colors = c("#1E90FF", "#9932CC", "#E9967A", "#228B22"),
color_labels_by_k = T,
ggtheme = theme_gray()
)# Formato Horizontal
fviz_dend(hc, k = 4, cex = 0.4, horiz = T, k_colors = "aaas",
rect = T, rect_border = "aaas", rect_fill = T)# Arbol filogenico usando igraph
require("igraph")
fviz_dend(hc, k = 4, k_colors = "aaas",
type = "phylogenic", repel = T)library(factoextra)
require("igraph")
fviz_dend(hc, k = 4, k_colors = "aaas",
type = "phylogenic", repel = T,
phylo_layout = "layout.gem")dend_plot <- fviz_dend(hc, k = 4,
cex = 0.5,
k_colors = "jco"
)
dend_data <- attr(dend_plot, "dendrogram")
# Cortamos en h =10 el endrograma
dend_cuts <- cut(dend_data, h = 10)
# Visualizar la vercion cortada de 2 ramas
fviz_dend(dend_cuts$upper)pdf("endograma.pdf", width = 30, height = 15)
p <- fviz_dend(hc, k = 4, cex = 1, k_colors = "jco")
print(p)
dev.off()## png
## 2
# codigo estandar
data <- scale (USArrests)
dist.res <- dist(data)
hc <- hclust(dist.res, method = "ward.D2")
dend <- as.dendrogram(hc)
plot(dend)# Usando mmetodo de encadenamiento
library(dendextend)
dend <- USArrests [1: 5,] %>%
scale %>%
dist %>%
hclust(method = "ward.D2") %>%
as.dendrogram
plot(dend)library(dendextend)
mycols <- c("#1E90FF", "#9932CC", "#E9967A", "#228B22")
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)