8
$\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.

Improve this question
$\endgroup$
4
  • $\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
    Commented Jan 10, 2018 at 20:29
  • $\begingroup$ What if communities are 'evenly' distributed and making their outlines leads to an unreadable graph? $\endgroup$
    – Kuba
    Commented Jan 10, 2018 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
    Commented Jan 10, 2018 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
    Commented Jan 10, 2018 at 21:08

2 Answers 2

Reset to default
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

Improve this answer
$\endgroup$
8
  • $\begingroup$ Does it require the graph to be a complete graph ? $\endgroup$
    – Neel Basu
    Commented Jan 11, 2018 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
    Commented Jan 11, 2018 at 11:15
  • $\begingroup$ ups.. there is a typo. I fixed it. $\endgroup$
    – halmir
    Commented Jan 11, 2018 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
    Commented Jan 11, 2018 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
    Commented Jan 11, 2018 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

Improve this answer
$\endgroup$
2
  • $\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
    Commented Jan 11, 2018 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
    Commented Jan 11, 2018 at 13:14

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.