knitr::opts_chunk$set( collapse = TRUE, comment = "#>", fig.path = "../man/figures/" )
library(muxViz) library(igraph) library(RColorBrewer) library(viridis) library(rgl)
set.seed(1) # Network setup Layers <- 3 Nodes <- 200 layerCouplingStrength <- 1 networkOfLayersType <- "categorical" isDirected <- F layer.colors <- brewer.pal(8, "Set2")
Setup Infomap, see setup Infomap vignette
pathInfomap <- "../src-exe/infomap-0.x/Infomap"
Generate an edge-colored network and layers with 4 modules
nodeTensor <- list() g.list <- list() plantedGroupsPerLayer <- 4 # matrix of the stochastic block model block.matrix <- matrix(0.1 / Nodes, plantedGroupsPerLayer, plantedGroupsPerLayer) diag(block.matrix) <- 2 * log(Nodes) / Nodes block.sizes <- rep(floor(Nodes / plantedGroupsPerLayer), plantedGroupsPerLayer) for (l in 1:Layers) { #Generate the layers g.list[[l]] <- sample_sbm(Nodes, pref.matrix=block.matrix, block.sizes=block.sizes) #Get the list of adjacency matrices which build the multiplex nodeTensor[[l]] <- get.adjacency(g.list[[l]]) }
Calculate a layout for consistent visualizations
lay <- layoutMultiplex(g.list, layout="fr", ggplot.format=F, box=T) # Show the multiplex network plot_multiplex3D(g.list, layer.layout=lay, layer.colors=layer.colors, layer.shift.x=0.5, layer.space=2, layer.labels="auto", layer.labels.cex=1.5, node.size.values="auto", node.size.scale=0.8, show.aggregate=T) # save the plot: snapshot3d("../man/figures/multi_sbm.png", fmt = "png", width = 1024, height = 1024)
knitr::include_graphics("../man/figures/multi_sbm.png")
Find modules without imposing hard partitions
commResult <- GetMultiplexCommunities_Infomap(g.list, bin.path=pathInfomap, isDirected=isDirected, seed=12345, includeSelfLinks=F, numTrials=100, twoLevel=T, preclusterMultiplex=F, addMissingPhysicalNodes=F, hardPartitions=F, verbose=T, addAggregateAnalysis=T, multilayerRelaxRate=0.5, multilayerJSRelaxRate=NA, outputPrefix="multimap_example")
Find modules by imposing hard partitions
commResult.hp <- GetMultiplexCommunities_Infomap(g.list, bin.path=pathInfomap, isDirected=isDirected, seed=12345, includeSelfLinks=F, numTrials=100, twoLevel=T, preclusterMultiplex=F, addMissingPhysicalNodes=F, hardPartitions=T, verbose=T, addAggregateAnalysis=T, multilayerRelaxRate=0.5, multilayerJSRelaxRate=NA, outputPrefix="multimap_example_hp")
Finally, process the results:
r commResult$msize.multi
r commResult.hp$msize.multi
r commResult$msize.aggr
Quantify difference between hard/non-hard partitions
VI <- igraph::compare(commResult$membership.multi$module, commResult.hp$membership.multi$module, method="vi") NMI <- igraph::compare(commResult$membership.multi$module, commResult.hp$membership.multi$module, method="nmi") ARI <- igraph::compare(commResult$membership.multi$module, commResult.hp$membership.multi$module, method="adjusted.rand")
r VI
bitsr NMI
r ARI
# make palettes according to identified modules pal.mux <- sample(viridis(commResult$modules.multi)) pal.aggr <- sample(viridis(commResult$modules.aggr)) png("../man/figures/multi_sbm_infomap_table.png", width = 1024, height = 728 / 2, res = 100) gplt <- plot_multimodules(commResult, module.colors = pal.mux, show.aggregate = T) dev.off() png("../man/figures/multi_sbm_infomap_hp_table.png", width = 1024, height = 728 / 2, res = 100) gplt.hp <- plot_multimodules(commResult.hp, module.colors = pal.mux, show.aggregate = T) dev.off()
knitr::include_graphics("../man/figures/multi_sbm_infomap_table.png") knitr::include_graphics("../man/figures/multi_sbm_infomap_hp_table.png")
Case with inter-layer connections and no hard partitions
# coloring state nodes node.colors.matrix <- matrix("#dadada", Nodes, Layers) for (l in 1:Layers) { dftmp <- commResult$membership.multi[commResult$membership.multi$layer==l,] idxs <- dftmp$node node.colors.matrix[idxs,l] <- pal.mux[dftmp$module] } # coloring physical nodes in the aggregate node.colors.aggr <- rep("#dadada", Nodes) node.colors.aggr[commResult$membership.aggr$node] <- pal.aggr[commResult$membership.aggr$module] plot_multiplex3D(g.list, layer.layout=lay, layer.colors=layer.colors, layer.shift.x=0.5, layer.space=2, layer.labels="auto", layer.labels.cex=1.5, node.size.values="auto", node.size.scale=0.8, node.colors=node.colors.matrix, edge.colors="#dadada", node.colors.aggr=node.colors.aggr, show.aggregate=T) snapshot3d("man/figures/multi_sbm_infomap.png", fmt = "png", width = 1024, height = 1024)
Case with hard partitions
# coloring state nodes node.colors.matrix <- matrix("#dadada", Nodes, Layers) for (l in 1:Layers) { dftmp <- commResult.hp$membership.multi[commResult.hp$membership.multi$layer==l,] idxs <- dftmp$node node.colors.matrix[idxs,l] <- pal.mux[dftmp$module] } # coloring physical nodes in the aggregate node.colors.aggr <- rep("#dadada", Nodes) node.colors.aggr[commResult.hp$membership.aggr$node] <- pal.aggr[commResult.hp$membership.aggr$module] plot_multiplex3D(g.list, layer.layout=lay, layer.colors=layer.colors, layer.shift.x=0.5, layer.space=2, layer.labels="auto", layer.labels.cex=1.5, node.size.values="auto", node.size.scale=0.8, node.colors=node.colors.matrix, edge.colors="#dadada", node.colors.aggr=node.colors.aggr, show.aggregate=T) snapshot3d("../man/figures/multi_sbm_infomap_hp.png", fmt="png", width = 1024, height = 1024)
knitr::include_graphics("../man/figures/multi_sbm_infomap_hp.png")
# Define the network of layers layerTensor <- BuildLayersTensor(Layers=Layers, OmegaParameter=layerCouplingStrength, MultisliceType=networkOfLayersType) layerLabels <- 1:Layers # Build the multilayer adjacency tensor M <- BuildSupraAdjacencyMatrixFromEdgeColoredMatrices(nodeTensor, layerTensor, Layers, Nodes) commResult2 <- GetMultilayerCommunities_Infomap( SupraAdjacencyMatrix = M, Layers = Layers, Nodes = Nodes, bin.path = pathInfomap, isDirected = isDirected, seed = 12345, includeSelfLinks = F, numTrials = 100, twoLevel = T, preclusterMultiplex = F, addMissingPhysicalNodes = F, hardPartitions = F, verbose = T, addAggregateAnalysis = T, outputPrefix = "multimap_example2" )
Case with inter-layer connections and no hard partitions
# coloring state nodes node.colors.matrix2 <- matrix("#dadada", Nodes, Layers) for(l in 1:Layers){ dftmp <- commResult2$membership.multi[commResult2$membership.multi$layer==l,] idxs <- dftmp$node node.colors.matrix2[idxs,l] <- pal.mux[dftmp$module] } # coloring physical nodes in the aggregate node.colors.aggr2 <- rep("#dadada", Nodes) node.colors.aggr2[commResult2$membership.aggr$node] <- pal.aggr[commResult2$membership.aggr$module] plot_multiplex3D(g.list, layer.layout=lay, layer.colors=layer.colors, layer.shift.x=0.5, layer.space=2, layer.labels="auto", layer.labels.cex=1.5, node.size.values="auto", node.size.scale=0.8, node.colors=node.colors.matrix2, edge.colors="#dadada", node.colors.aggr=node.colors.aggr2, show.aggregate=T) snapshot3d("../man/figures/multi_sbm_infomap2.png", fmt="png", width = 1024, height = 1024)
knitr::include_graphics("../man/figures/multi_sbm_infomap2.png")
Look at the size of all communities:
r commResult2$msize.multi
r commResult2$msize.aggr
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.