3
$\begingroup$

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]}};

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

Graph

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:

Community Plot

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

$\endgroup$

1 Answer 1

4
$\begingroup$

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[ 
    GraphComputation`GraphCommunitiesPlotDump`generateBlobs[# &, 
      {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}];

Manipulate[addCommunityBlobs[graph[t], ImageSize -> Large],
 {{t, .126}, .12, .13, Appearance -> "Labeled"}, 
 Initialization :> {graph[t_] := nnG[wag, t]}]

enter image description here

$\endgroup$
1
  • 1
    $\begingroup$ Oh perfect. Absolutely perfect. Thanks so very much! ($\checkmark$) $\endgroup$ Commented May 22, 2021 at 15:00

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.