El agrupamiento (clustering o partitioning) se refiere a la segmentación de un conjunto de elementos en subconjuntos “naturales”.
Una partición \(\mathcal{C}=\{C_1,\ldots,C_K\}\) de un conjunto finito \(S\) se refiere a una descomposición de \(S\) en \(K\) subconjuntos \(C_1,\ldots,C_K\) de \(S\) disjuntos y no vacíos tales que \(\cup_{k=1}^K C_k = S\).
La partición de redes (network partitioning) también conocida como detección de comunidades (commuty detection), constituye una herramienta no supervisada para encontrar subconjuntos de vértices cohesionados respeto a los patrones relacionales subyacentes.
Los algoritmos de particionamiento de grafos buscan una partición \(\mathcal{C}=\{C_1,\ldots,C_K\}\) de conjunto de vértices \(V\) de un grafo \(G=(V,E)\) tal que los conjuntos de aristas conectando vértices de \(C_k\) con vértices de \(C_{\ell}\) con \(k\neq\ell\), sean relativamente pequeño en tamaño comparado con los conjuntos de aristas conectando vértices en \(C_k\).
Los métodos que se discuten a continuación son algorítmicos y no constituyen modelos estadísticos, y por lo tanto no permiten cuantificar la incertidumbre asociada con tanto con la detección de las comunidades como la formación de enlaces.
Estos métodos adoptan un enfoque computacional intensivo para explorar el espacio de todas las posibles particiones, modificando iterativamente las particiones candidatas.
Los métodos difieren principalmente en (i) la métrica para evaluar la calidad de las agrupaciones y (ii) los algoritmos para optimizar tal métrica de calidad.
En cada etapa del algoritmo, la partición actual se modifica de manera que minimice una función de perdida (medida de costo) específica mediante la acción menos costosa de fusión/división.
La función de perdida debe reflejar la noción de subconjunto “cohesivo” de vértices.
M. Newman and M. Girvan, “Finding and evaluating community structure in networks”, Physical Review E, vol. 69, no. 2, p. 26113, 2004..
Una función de perdida es la modularidad (modularity), que para una partición \(\mathcal{C}=\{C_1,\ldots,C_K\}\) se define como: \[ \textsf{mod}(\mathcal{C}) = \sum_{k=1}^K (f_{k,k} - f^*_{k,k})^2\,, \] donde:
Un valor “grande” de la modularidad indica que \(\mathcal{C}\) corresponde a una partición que difiere sustancialmente de lo esperado bajo el modelo de asignación de aristas bajo consideración.
cluster_fast_greedy
en igraph
.
El matriz de modularidad (modularity matrix) de un grafo \(G=(V,E)\) con matriz de adyacencia \(\mathbf{Y}\) corresponde a la matriz \(\mathbf{B} = \mathbf{Y} - \mathbf{P}\), donde \(\mathbf{P}\) contiene las probabilidades de interacción en una red aleatoria en la que los grados de todos los vértices son los mismos que en \(G\).
MEJ Newman: Finding community structure using the eigenvectors of matrices, Physical Review E 74 036104, 2006.
El método funciona calculando el vector propio de la matriz de modularidad para el valor propio positivo más grande y luego separando los vértices en dos comunidades según el signo del elemento correspondiente en el vector propio. Si todos los elementos del vector propio tienen el mismo signo, eso significa que la red no tiene una estructura comunitaria subyacente.
cluster_leading_eigen
en igraph
.
Algoritmo | Función en igraph |
Idea |
---|---|---|
Fast-greedy | cluster_fast_greedy |
Optimizar una métrica de modularidad |
Edge-betweenness | cluster_edge_betweenness |
Optimizar una métrica de aristas basada en caminos más cortos |
Leading eigenvector | cluster_leading_eigen |
Calcular el vector propio principal no negativo de la matriz de modularidad |
Louvain | cluster_louvain |
Optimizar una métrica de modularidad múltinivel |
Walktrap | cluster_walktrap |
Caminatas aleatorias cortas tienden a permanecer en la misma comunidad |
Label propagation | cluster_label_prop |
Etiquetar vértices con etiquetas únicas y actualizarlas por votación mayoritaria en la vecindad del vértice |
InfoMAP | cluster_infomap |
Optimizar la longitud esperada de una trayectoria de una caminata aleatoria |
Spinglass | cluster_spinglass |
Modelo spin-glass y simulated annealing |
Optimal | cluster_optimal |
Optimizar una métrica de modularidad |
En igraph
la modulariad de un grafo respecto a una partición mide qué tan buena es la división o qué tan separados están los diferentes tipos de vértices entre sí: \[
\textsf{mod}(\mathcal{C}) = \frac{1}{2m} \sum_{i,j:i\neq j} \left(y_{i,j} - \tfrac{1}{2m}d_id_j\right)\delta_{c_i,c_j}
\] donde:
Cuando se tiene conocimiento de alguna noción de pertenencia a una clase definida externamente, resulta interesante interesante comparar y contrastar las asignaciones resultantes con las que se derivan de la partición.
compare
en igraph
.
Comparación de dos particiones:
rand
: the Rand index (Rand 1971).adjusted.rand
: adjusted Rand index (Hubert and Arabie 1985).vi
: variation of information (VI) metric (Meila 2003).nmi
: normalized mutual information measure (Danon et al. 2005).split.join
: split-join distance (can Dongen 2000).Por ejemplo, el índice Rand tiene un valor entre 0 y 1, donde 0 indica que las dos agrupaciones de datos no coinciden en ningún par de puntos y 1 indica que las agrupaciones de datos son exactamente iguales: \[ \textsf{RI}(X,Y) = \frac{a+b}{a+b+c+d} \] donde:
Zachary, W. W. (1977). An information flow model for conflict and fission in small groups. Journal of anthropological research, 33(4), 452-473.
Los nodos representan a los miembros de un club de karate observado durante aproximadamente 2 años y los enlaces que conectan dos nodos indican interacciones sociales entre los dos miembros correspondientes.
# datos
suppressMessages(suppressWarnings(library(sand)))
data(karate)
# orden
vcount(karate)
## [1] 34
# tamaño
ecount(karate)
## [1] 78
# dirigida?
is_directed(karate)
## [1] FALSE
# ponderada?
is_weighted(karate)
## [1] TRUE
# aplicacion del algoritmo
kc <- igraph::cluster_fast_greedy(karate)
# estructura
str(kc)
## Class 'communities' hidden list of 6
## $ merges : num [1:33, 1:2] 26 7 17 14 3 4 8 1 30 25 ...
## $ modularity: num [1:34] -0.0511 -0.02356 -0.00362 0.02084 0.03786 ...
## $ membership: num [1:34] 2 2 2 2 3 3 3 2 1 1 ...
## $ names : chr [1:34] "Mr Hi" "Actor 2" "Actor 3" "Actor 4" ...
## $ algorithm : chr "fast greedy"
## $ vcount : int 34
# algoritmo
kc$algorithm
## [1] "fast greedy"
# algoritmo jerarquico?
is_hierarchical(kc)
## [1] TRUE
# asignaciones
kc$membership
## [1] 2 2 2 2 3 3 3 2 1 1 3 2 2 2 1 1 3 2 1 2 1 2 1 1 1 1 1 1 1 1 1 1 1 1
# tamaño de la particion
length(kc)
## [1] 3
length(table(kc$membership))
## [1] 3
# tamaños
sizes(kc)
## Community sizes
## 1 2 3
## 18 11 5
table(kc$membership)
##
## 1 2 3
## 18 11 5
# grafico
par(mfrow = c(1,2))
set.seed(1)
plot(x = kc, y = karate, vertex.size = 12,)
set.seed(1)
plot(x = kc, y = karate, mark.groups = NULL, edge.color = "darkgray", vertex.size = 12)
# grafico
par(mfrow = c(1,2))
set.seed(42)
plot(karate, layout = layout_with_kk(karate), vertex.size = 12, vertex.frame.color = "black", vertex.label.color = "black")
set.seed(42)
plot(karate, layout = layout_with_kk(karate), vertex.size = 12, vertex.frame.color = "black", vertex.label.color = "black", vertex.color = kc$membership)
# grafico
par(mfrow = c(1,2))
set.seed(42)
plot(karate, layout = layout_with_fr(karate), vertex.size = 12, vertex.frame.color = "black", vertex.label.color = "black")
set.seed(42)
plot(karate, layout = layout_with_fr(karate), vertex.size = 12, vertex.frame.color = "black", vertex.label.color = "black", vertex.color = kc$membership)
# funciones
get_adjacency_ordered <- function(xi, A)
{
xi2 <- xi[order(xi)]
indices <- order(xi)
d <- NULL
for (i in 1:(length(xi)-1)) if (xi2[i] != xi2[i+1]) d <- c(d, i)
list(A = A[indices,indices], d = d)
}
heat.plot0 <- function (mat, show.grid = FALSE, cex.axis, tick, labs, col.axis, ...)
{
JJ <- dim(mat)[1]
colorscale <- c("white", rev(heat.colors(100)))
if(missing(labs)) labs <- 1:JJ
if(missing(col.axis)) col.axis <- rep("black", JJ)
if(missing(cex.axis)) cex.axis <- 1
if(missing(tick)) tick <- TRUE
## adjacency matrix
image(seq(1, JJ), seq(1, JJ), mat, axes = FALSE, xlab = "", ylab = "", col = colorscale[seq(floor(100*min(mat)), floor(100*max(mat)))], ...)
for(j in 1:JJ){
axis(1, at = j, labels = labs[j], las = 2, cex.axis = cex.axis, tick, col.axis = col.axis[j], col.ticks = col.axis[j])
axis(2, at = j, labels = labs[j], las = 2, cex.axis = cex.axis, tick, col.axis = col.axis[j], col.ticks = col.axis[j])
}
box()
if(show.grid) grid(nx = JJ, ny = JJ)
}
# asignaciones
xi <- kc$membership
# asignaciones ordenadas
xi2 <- xi[order(xi)]
# matriz de adyacencia original
Y <- get.adjacency(graph = karate, sparse = F)
# matriz de adyacencia ordenada y lineas divisorias de acuerdo con las comunidades
tmp <- get_adjacency_ordered(xi = xi, A = Y)
A <- tmp$A
d <- tmp$d
# grafico
par(mfrow = c(1,2))
heat.plot0(mat = Y)
heat.plot0(mat = A, col.axis = c("darkgoldenrod3","deepskyblue3","forestgreen")[xi2])
abline(v = d+.5, h = d+.5)
plot_dendrogram(x = kc, mode = "phylo")
# algoritmos
kc_fast_greedy <- cluster_fast_greedy(karate)
kc_leading_eigen <- cluster_leading_eigen(karate)
kc_walktrap <- cluster_walktrap(karate)
kc_louvain <- cluster_louvain(karate)
kc_label_prop <- cluster_label_prop(karate)
kc_spinglass <- cluster_spinglass(karate)
kc_optimal <- cluster_optimal(karate)
kc_infomap <- cluster_infomap(karate)
# graficos
igraph_options(vertex.size = 10, vertex.frame.color = "black", vertex.label.color = "black", layout = layout_with_fr(karate))
par(mfrow = c(3,3))
set.seed(42)
plot(karate, vertex.label = NA, vertex.color = kc_fast_greedy$membership, main = paste0("fast greedy: ", "Mod = ", round(modularity(kc_fast_greedy), 4)))
set.seed(42)
plot(karate, vertex.label = NA, vertex.color = kc_leading_eigen$membership, main = paste0("leading eigen: ", "Mod = ", round(modularity(kc_leading_eigen), 4)))
set.seed(42)
plot(karate, vertex.label = NA, vertex.color = kc_walktrap$membership, main = paste0("walktrap: ", "Mod = ", round(modularity(kc_walktrap), 4)))
set.seed(42)
plot(karate, vertex.label = NA, vertex.color = kc_louvain$membership, main = paste0("louvain: ", "Mod = ", round(modularity(kc_louvain), 4)))
set.seed(42)
plot(karate, vertex.label = NA, vertex.color = kc_label_prop$membership, main = paste0("label prop: ", "Mod = ", round(modularity(kc_label_prop), 4)))
set.seed(42)
plot(karate, vertex.label = NA, vertex.color = kc_spinglass$membership, main = paste0("spinglass: ", "Mod = ", round(modularity(kc_spinglass), 4)))
set.seed(42)
plot(karate, vertex.label = NA, vertex.color = kc_optimal$membership, main = paste0("optimal: ", "Mod = ", round(modularity(kc_optimal), 4)))
set.seed(42)
plot(karate, vertex.label = NA, vertex.color = kc_infomap$membership, main = paste0("infomap: ", "Mod = ", round(modularity(kc_infomap), 4)))
Salter-Townshend, M. & McCormick, T. H. (2017), ‘Latent space models for multiview network data’, The Annals of Applied Statistics 11(3), 1217.
Relaciones sociales y familiares entre hogares en un aldea específica ubicada en la zona rural del sur de Karnataka, India. Para estos datos, \(y_{i,j} = 1\) si los hogares \(i\) y \(j\) tienen están relacionados familiarmente o asisten juntos al templo.
# datos
suppressMessages(suppressWarnings(library(igraph)))
load("C:/Users/Juan Camilo/Dropbox/UN/networks_2021_2/salter543_data.RData")
karna <- graph_from_adjacency_matrix(adjmatrix = Ycube, mode = "undirected")
# orden
vcount(karna)
## [1] 99
# tamaño
ecount(karna)
## [1] 473
# dirigida?
is_directed(karna)
## [1] FALSE
# ponderada?
is_weighted(karna)
## [1] FALSE
# aplicacion de algoritmos
kc_fast_greedy <- igraph::cluster_fast_greedy(karna)
kc_leading_eigen <- cluster_leading_eigen(karna)
# grafos
igraph_options(vertex.size = 5, vertex.frame.color = "black", vertex.label.color = "black", layout = layout_with_kk(karate))
par(mfrow = c(1,2))
set.seed(42)
plot(karna, vertex.label = NA, vertex.color = kc_fast_greedy$membership, main = paste0("fast greedy: ", "Mod = ", round(modularity(kc_fast_greedy), 4)))
set.seed(42)
plot(karna, vertex.label = NA, vertex.color = kc_leading_eigen$membership, main = paste0("leading eigen: ", "Mod = ", round(modularity(kc_leading_eigen), 4)))
# matrices de adyacencia
par(mfrow = c(1,2))
# fast greedy
xi <- kc_fast_greedy$membership
xi2 <- xi[order(xi)]
tmp <- get_adjacency_ordered(xi = xi, A = Ycube)
A <- tmp$A
d <- tmp$d
heat.plot0(mat = A, col.axis = RColorBrewer::brewer.pal(9,"Set1")[xi2], cex.axis = 0.4, main = paste0("fast greedy: ", "Mod = ", round(modularity(kc_fast_greedy), 4)))
abline(v = d+.5, h = d+.5)
# leading_eigen (primero reordenar etiquetas)
xi <- kc_leading_eigen$membership
tab <- table(xi)
lab_ord <- as.numeric(names(tab))[order(tab, decreasing = T)]
xi0 <- xi
for (k in 1:max(xi)) xi[xi0 == lab_ord[k]] <- k
xi2 <- xi[order(xi)]
tmp <- get_adjacency_ordered(xi = xi, A = Ycube)
A <- tmp$A
d <- tmp$d
heat.plot0(mat = A, col.axis = RColorBrewer::brewer.pal(9,"Set1")[xi2], cex.axis = 0.4, main = paste0("fast greedy: ", "Mod = ", round(modularity(kc_leading_eigen), 4)))
abline(v = d+.5, h = d+.5)
# atributos
data(karate)
fc <- as.numeric(as.factor(vertex_attr(graph = karate, name = "Faction")))
table(fc)
## fc
## 1 2
## 16 18
# aplicacion de algoritmos
kc_fast_greedy <- cluster_fast_greedy(karate)
kc_leading_eigen <- cluster_leading_eigen(karate)
# comparacion
compare(comm1 = fc, comm2 = kc_fast_greedy$membership, method = "rand")
## [1] 0.9019608
compare(comm1 = fc, comm2 = kc_leading_eigen$membership, method = "rand")
## [1] 0.7557932
# tablas cruzadas
table(fc, kc_fast_greedy$membership)
##
## fc 1 2 3
## 1 0 11 5
## 2 18 0 0
table(fc, kc_leading_eigen$membership)
##
## fc 1 2 3 4 5
## 1 10 0 5 1 0
## 2 0 12 0 0 6