pause <- function() {} ### A modular graph has dense subgraphs mod <- make_full_graph(10) %du% make_full_graph(10) %du% make_full_graph(10) perfect <- c(rep(1, 10), rep(2, 10), rep(3, 10)) perfect pause() ### Plot it with community (=component) colors plot(mod, vertex.color = perfect, layout = layout_with_fr) pause() ### Modularity of the perfect division modularity(mod, perfect) pause() ### Modularity of the trivial partition, quite bad modularity(mod, rep(1, 30)) pause() ### Modularity of a good partition with two communities modularity(mod, c(rep(1, 10), rep(2, 20))) pause() ### A real little network, Zachary's karate club data karate <- make_graph("Zachary") karate$layout <- layout_with_kk(karate) pause() ### Greedy algorithm fc <- cluster_fast_greedy(karate) memb <- membership(fc) plot(karate, vertex.color = memb) pause() ### Greedy algorithm, easier plotting plot(fc, karate) pause() ### Spinglass algorithm, create a hierarchical network pref.mat <- matrix(0, 16, 16) pref.mat[1:4, 1:4] <- pref.mat[5:8, 5:8] <- pref.mat[9:12, 9:12] <- pref.mat[13:16, 13:16] <- 7.5 / 127 pref.mat[pref.mat == 0] <- 5 / (3 * 128) diag(pref.mat) <- diag(pref.mat) + 10 / 31 pause() ### Create the network with the given vertex preferences G <- sample_pref(128 * 4, types = 16, pref.matrix = pref.mat) pause() ### Run spinglass community detection with two gamma parameters sc1 <- cluster_spinglass(G, spins = 4, gamma = 1.0) sc2.2 <- cluster_spinglass(G, spins = 16, gamma = 2.2) pause() ### Plot the adjacency matrix, use the Matrix package if available if (require(Matrix)) { myimage <- function(...) image(Matrix(...)) } else { myimage <- image } A <- as_adj(G) myimage(A) pause() ### Ordering according to (big) communities ord1 <- order(membership(sc1)) myimage(A[ord1, ord1]) pause() ### Ordering according to (small) communities ord2.2 <- order(membership(sc2.2)) myimage(A[ord2.2, ord2.2]) pause() ### Consensus ordering ord <- order(membership(sc1), membership(sc2.2)) myimage(A[ord, ord]) pause() ### Comparision of algorithms communities <- list() pause() ### cluster_edge_betweenness ebc <- cluster_edge_betweenness(karate) communities$`Edge betweenness` <- ebc pause() ### cluster_fast_greedy fc <- cluster_fast_greedy(karate) communities$`Fast greedy` <- fc pause() ### cluster_leading_eigen lec <- cluster_leading_eigen(karate) communities$`Leading eigenvector` <- lec pause() ### cluster_spinglass sc <- cluster_spinglass(karate, spins = 10) communities$`Spinglass` <- sc pause() ### cluster_walktrap wt <- cluster_walktrap(karate) communities$`Walktrap` <- wt pause() ### cluster_label_prop labprop <- cluster_label_prop(karate) communities$`Label propagation` <- labprop pause() ### Plot everything layout(rbind(1:3, 4:6)) coords <- layout_with_kk(karate) lapply(seq_along(communities), function(x) { m <- modularity(communities[[x]]) par(mar = c(1, 1, 3, 1)) plot(communities[[x]], karate, layout = coords, main = paste( names(communities)[x], "\n", "Modularity:", round(m, 3) ) ) }) pause() ### Function to calculate clique communities clique.community <- function(graph, k) { clq <- cliques(graph, min = k, max = k) edges <- c() for (i in seq(along.with = clq)) { for (j in seq(along.with = clq)) { if (length(unique(c( clq[[i]], clq[[j]] ))) == k + 1) { edges <- c(edges, c(i, j)) } } } clq.graph <- simplify(graph(edges)) V(clq.graph)$name <- seq(length.out = vcount(clq.graph)) comps <- decompose(clq.graph) lapply(comps, function(x) { unique(unlist(clq[V(x)$name])) }) } pause() ### Apply it to a graph, this is the example graph from ## the original publication g <- graph_from_literal( A - B:F:C:E:D, B - A:D:C:E:F:G, C - A:B:F:E:D, D - A:B:C:F:E, E - D:A:C:B:F:V:W:U, F - H:B:A:C:D:E, G - B:J:K:L:H, H - F:G:I:J:K:L, I - J:L:H, J - I:G:H:L, K - G:H:L:M, L - H:G:I:J:K:M, M - K:L:Q:R:S:P:O:N, N - M:Q:R:P:S:O, O - N:M:P, P - Q:M:N:O:S, Q - M:N:P:V:U:W:R, R - M:N:V:W:Q, S - N:P:M:U:W:T, T - S:V:W:U, U - E:V:Q:S:W:T, V - E:U:W:T:R:Q, W - U:E:V:Q:R:S:T ) pause() ### Hand-made layout to make it look like the original in the paper lay <- c( 387.0763, 306.6947, 354.0305, 421.0153, 483.5344, 512.1145, 148.6107, 392.4351, 524.6183, 541.5878, 240.6031, 20, 65.54962, 228.0992, 61.9771, 152.1832, 334.3817, 371.8931, 421.9084, 265.6107, 106.6336, 57.51145, 605, 20, 124.8780, 273.6585, 160.2439, 241.9512, 132.1951, 123.6585, 343.1707, 465.1220, 317.561, 216.3415, 226.0976, 343.1707, 306.5854, 123.6585, 360.2439, 444.3902, 532.1951, 720, 571.2195, 639.5122, 505.3659, 644.3902 ) lay <- matrix(lay, ncol = 2) lay[, 2] <- max(lay[, 2]) - lay[, 2] pause() ### Take a look at it layout(1) plot(g, layout = lay, vertex.label = V(g)$name) pause() ### Calculate communities res <- clique.community(g, k = 4) pause() ### Paint them to different colors colbar <- rainbow(length(res) + 1) for (i in seq(along.with = res)) { V(g)[res[[i]]]$color <- colbar[i + 1] } pause() ### Paint the vertices in multiple communities to red V(g)[unlist(res)[duplicated(unlist(res))]]$color <- "red" pause() ### Plot with the new colors plot(g, layout = lay, vertex.label = V(g)$name)