# Marking communities in a weighted adjacency graph based on a threshold

There are a few questions that are close to what I seek, most notably this one, but none quite right.

I want to exploit Mathematica's CommunityGraph style in which a boundary is drawn around a "community" in an undirected graph. However, I want to define automatically or by hand a threshold distance (edge weight) for community membership. Here's a minimal example:

testMat = {
{\[Infinity], 1, 1, 10, 11},
{1, \[Infinity], 1, 11, 10},
{1, 1, \[Infinity], 9, 10},
{10, 11, 9, \[Infinity], 1},
{11, 10, 10, 1, \[Infinity]}};

GraphLayout -> {"SpringElectricalEmbedding", "EdgeWeighted" -> True}]


Clearly there are two "communities" or clusters here. (Technically, in graph theory there is just one community... I'm defining a community based on distances.)

I can find the clusters by ClusterComponents based on the VertexCoordinates, but I don't know how to use the internal drawing procedures to encircle and highlight the clusters. In my large actual graph, the layout shape of each cluster is not circular, indeed it may not be convex.

I'd also like to retain the straight edges, which indicate edge weight or distance. CommunityGraphPlot isn't quite right because it breaks the edge structure (which I must retain), as you can see here:

The ideal functionality would be an option for HighlightGraph, which encircles a subgraph, but Mathematica does not support that functionality.

For an input graph g, we can use NearestNeighborGraph with GraphEmbedding[g] as the vertex list and {All, thresholddistance} as the second argument and find the ConnectedComponents to get vertex clusters.

To generate convex blobs enclosing vertex clusters can use the function fC from this answer and use the blobs as Prolog in Graph.

ClearAll[fC, nnG, addCommunityBlobs]

fC[coords_, size_: .015] := Module[{}, CommunityGraphPlot[Graph[{}], {}];
FilledCurve @ BSplineCurve[
GraphComputationGraphCommunitiesPlotDumpgenerateBlobs[# &,
{coords}, size][[2, 1]], SplineClosed -> True]]

nnG[g_, t_] := NearestNeighborGraph[GraphEmbedding @ g, {All, t}]

addCommunityBlobs[g_, opts : OptionsPattern[]] := Graph[g, opts,
VertexLabels -> "Index", ImagePadding -> 15,
Prolog -> MapIndexed[{Opacity[.3, ColorData[97]@#2[[1]]], fC @ #} &,
ConnectedComponents @ g]]


Example:

wag = WeightedAdjacencyGraph[testMat,
GraphLayout -> {"SpringElectricalEmbedding", "EdgeWeighted" -> True}];


• Oh perfect. Absolutely perfect. Thanks so very much! ($\checkmark$) May 22 '21 at 15:00