7
$\begingroup$

I have a Graph, and I want to group some of its vertices into communities. CommunityGraphPlot uses force directed layout and its doesn't look like the original graph after I apply CommunityGraphPlot. I don't want the vertices of same community to come close so that the community border line can be drawn easily. I want the vertices to stay in their position as it was in the graph. Just drawing even some rectangles or any other shape over them will be fine for me.

CompleteGraph[8, VertexLabels -> "Name"]

Beautiful

CommunityGraphPlot[
 CompleteGraph[8, 
  VertexLabels -> "Name"], {{1, 2, 3}, {4, 5}, {4, 8}}]

Just breaks the beauty

Given that complete graph above, CommunityGraphPlot just breaks its beauty, It doesn't even look like once its was a complete graph. However with these set of vertices it could have draw regions easily while keeping the vertices in their position.

$\endgroup$
  • $\begingroup$ It doesn't even look like a kite or fish. I don't know what this beast is. But if it was not a community plot. I wouldn't believe so easily that it was actually a Complete Graph. $\endgroup$ – Neel Basu Jan 10 '18 at 20:29
  • $\begingroup$ What if communities are 'evenly' distributed and making their outlines leads to an unreadable graph? $\endgroup$ – Kuba Jan 10 '18 at 20:31
  • $\begingroup$ In that case we would say that it is unreadable in this way. We cant retain the original look and feel, So let us try a force layout. Reasonable compromise. $\endgroup$ – Neel Basu Jan 10 '18 at 20:32
  • $\begingroup$ If you all you want is to drawn regions, then I suggest doing that manually and not using CommunityGraphPlot at all. $\endgroup$ – Szabolcs Jan 10 '18 at 21:08
7
$\begingroup$

If you want to draw blob like CommunityGraphPlot:

iBlobs[style_, pts_, size_] :=
 Block[{epts},
  epts = Flatten[Tuples[CoordinateBounds[#, size]] & /@ pts, 1];
  {style, 
   FilledCurve@
    BSplineCurve[MeshPrimitives[ConvexHullMesh[epts], 1][[All, 1, 1]],
      SplineClosed -> True]}
  ]

{cliques, style} = {{{1, 2, 3}, {4, 5}, {4, 8}}, {Red, Green, Blue}};
vcoord = GraphEmbedding[g];

bsize = .08 Differences[MinMax[vcoord]][[1]];

bstyle = Directive[Opacity[.3], EdgeForm[#], #] & /@ style;

cpoints = vcoord[[VertexIndex[g, #] & /@ #]] & /@ cliques;

HighlightGraph[g, cliques, 
 Epilog -> 
  Activate[Thread[Inactive[iBlobs][bstyle, cpoints, bsize]]], 
 ImagePadding -> 20]

enter image description here

$\endgroup$
  • $\begingroup$ Does it require the graph to be a complete graph ? $\endgroup$ – Neel Basu Jan 11 '18 at 6:17
  • $\begingroup$ I am getting errors like Part::partd: Part specification MeshPrimitives[ConvexHullMesh[{{{-0.16,-1.16},{0.16,-1.16}},{{0.16,-1.16},{0.16,-0.84}},{{0.16,-0.84},{0.16,1.16}},{{0.16,1.16},{-0.16,1.16}},{{-0.16,1.16},{-0.16,0.84}},{{-0.16,0.84},{-0.16,-1.16}}}],1][[All,1,1]] is longer than depth of object. $\endgroup$ – Neel Basu Jan 11 '18 at 11:15
  • $\begingroup$ ups.. there is a typo. I fixed it. $\endgroup$ – halmir Jan 11 '18 at 12:08
  • $\begingroup$ Yes it is working with Complete Graphs now. I hope this does not require the graph to be Complete. My actual graph is not a complete graph. So is it supposed to work there ? $\endgroup$ – Neel Basu Jan 11 '18 at 13:10
  • $\begingroup$ Thanks it worked with my actual graph too. I made some minor tweaks with bsize (changed 0.08 to 0.01). $\endgroup$ – Neel Basu Jan 11 '18 at 13:28
5
$\begingroup$

Update: Using GraphComputation`GraphCommunitiesPlotDump`generateBlobs, ... well, to generate blobs:

ClearAll[blobF, fC]
fC[coords_, size_: .04] := Module[{}, CommunityGraphPlot[Graph[{}], {}]; 
  FilledCurve @ BSplineCurve[GraphComputation`GraphCommunitiesPlotDump`generateBlobs[# &, 
    {coords}, size][[2, 1]], SplineClosed -> True]]


blobF[g_, cols_, coms_, size_: .04] := Thread[{cols, EdgeForm[{Gray, Thin}], Opacity[.25],
    fC[PropertyValue[{g, #}, VertexCoordinates] & /@ #, size] & /@ coms}];

{cliques,  colors} = {{{1, 2, 3}, {4, 5}, {6, 7, 8}}, {Red, Green , Blue}};
cg = CompleteGraph[8];
SetProperty[cg, {Epilog -> blobF[cg, colors, cliques], 
  VertexLabels -> "Name", ImagePadding -> 15}]

enter image description here

SeedRandom[1]
Row[{#, SetProperty[#, {Epilog -> blobF[#, colors, cliques], ImagePadding -> 15}]} &@
  RandomGraph[{20, 15}, ImageSize -> 300, VertexLabels -> "Name"]] 

enter image description here

Original answer:

{cliques,  colors} = {{{1, 2, 3}, {4, 5}, {6, 7, 8}}, {Red, Green , Blue}};
lines = Thread[{colors, CapForm["Round"], JoinForm["Round"], 
  Opacity[.5], AbsoluteThickness[20], 
  Line[PropertyValue[{cg, #}, VertexCoordinates] & /@ #] & /@ cliques}];

SetProperty[CompleteGraph[8], {Epilog -> lines, VertexLabels -> "Name", 
  ImagePadding -> 15}]

enter image description here

Or highlight Subgraphs:

cg = CompleteGraph[8];
Fold[HighlightGraph[##] &, cg, (Style[Subgraph[cg, #[[1]]], #[[2]], 
   CapForm["Round"], JoinForm["Round"], AbsoluteThickness[20]] & /@ 
 Transpose[{cliques, colors}])]

enter image description here

$\endgroup$
  • $\begingroup$ I have tried your updated code but it looks different, the hulls don't fit in the vertices i.imgur.com/Wrs8Wzb.png $\endgroup$ – Neel Basu Jan 11 '18 at 11:21
  • $\begingroup$ @NeelBasu, it turns out we need to invoke CommunityGraphPlot before using GraphComputation`GraphCommunitiesPlotDump`generateBlobs for it to load. So using CommunityGraphPlot[Graph[{}], {}] before it works. I modified the definition of fC to get this line in. $\endgroup$ – kglr Jan 11 '18 at 13:14

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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