10
$\begingroup$

I would like to visualize separate connected components of a graph defined by data points lying in the two-dimensional plane by surrounding each connected component subgraph by a bounding curve. I can almost render such a figure using CommunityGraphPlot[], except that the vertexes do not remain in their two-dimensional location as I desire.

data = RandomReal[{0, 1}, {30, 2}];

myadjacencymatrix = 
  Table[If[i != j && Norm[data[[i]] - data[[j]]] < .2, 1, 0], {i, 30}, {j, 30}];

mygraph = AdjacencyGraph[myadjacencymatrix, VertexCoordinates -> data];

My attempt at a "trick" is to find the subgraphs by ConnectedComponents[] and call them cliques, so they can be used in CommunityGraphPlot[].

mycliques = ConnectedComponents[mygraph];

CommunityGraphPlot[mygraph, mycliques, CommunityRegionStyle -> Opacity[0.1]]

The resulting plot shows the topological relations of the vertexes and bounding curves I need, but the vertexes are no longer in their specified original two-dimensional positions. I've tried VertexCoordinates -> data, but that doesn't work.

Perhaps one could set a Property of a vertex to be its spatial location to ensure each is rendered in its proper two-dimensional location, but I do not see how to do that.

One can use HighlightGraph[mygraph, mycliques] but that merely shows the links, not a bounding curve. Is rendering a bounding curve impossible in the general case because some subgraphs might require a concave bounding curve, when only convex bounding curves can be drawn?

Any suggestions?

$\endgroup$
  • $\begingroup$ Hi! Perhaps it's time you start accepting answers to your questions (and may be voting a little more). Links below $\endgroup$ – Dr. belisarius Nov 19 '14 at 22:27
  • $\begingroup$ I suggest the following: 1) As you receive help, try to give it too, by answering questions in your area of expertise. 2) Read the faq! 3) When you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge. Also, please remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign! $\endgroup$ – Dr. belisarius Nov 19 '14 at 22:27
15
$\begingroup$

This seems to work pretty well:

r = 0.2/3;
regions = RegionPlot[
   Evaluate@Table[
     Length@clique PDF[SmoothKernelDistribution[data[[clique]], r], {x, y}] > 1/(4 π r^2),
     {clique, mycliques}], 
   {x, -2 r, 1 + 2 r}, {y, -2 r, 1 + 2 r}, Frame -> False];
Show[regions, Graph[mygraph, GraphStyle -> "BasicBlack"]]

enter image description here

Further reading: metaballs.

| improve this answer | |
$\endgroup$
8
$\begingroup$

Update 2: Generating blobs using GraphComputation`GraphCommunitiesPlotDump`generateBlobs:

ClearAll[blobF, fC]
fC[pts_, size_: .04] := Module[{}, CommunityGraphPlot[Graph@{}, {}];
 GraphComputation`GraphCommunitiesPlotDump`generateBlobs[Automatic, {pts}, size][[2, 1]]]

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

Example:

SeedRandom[1]
data = RandomReal[{0, 1}, {30, 2}];
myadjacencymatrix = Table[If[i != j && Norm[data[[i]] - data[[j]]] < .2, 1, 0], 
 {i, 30}, {j, 30}];
mygraph = AdjacencyGraph[myadjacencymatrix, VertexCoordinates -> data];
mycliques = ConnectedComponents[mygraph];

mygraph2 = SetProperty[mygraph, {ImagePadding -> 15, VertexLabels -> "Name",
  Epilog -> blobF[mygraph, {Cyan, Green, Blue, Orange, Red}, mycliques, .02] }];
Row[Panel /@ {mygraph, mygraph2}]

enter image description here

Original answer:

Graphics`Mesh`MeshInit[];
cC = #[[ConvexHull[#]]]&/@ (PropertyValue[{mygraph, #}, VertexCoordinates] & /@ 
   # & /@ mycliques);

g2 = Graphics[{Opacity[.25], {Hue[RandomReal[]], Polygon[#]} & /@ cC}];

mygraph2 = Show[g2, HighlightGraph[mygraph, Subgraph[mygraph, #] & /@ mycliques]];

Row[{Panel@mygraph, Panel@mygraph2}, Spacer[15]]

enter image description here

Update: Use Scale to make the polygons larger:

g2b = Graphics[{Opacity[.3], {Hue[RandomReal[]], Scale[Polygon[#], 1.2]} & /@ cC}];
mygraph2b = Show[g2b, HighlightGraph[mygraph, Subgraph[mygraph, #] & /@ mycliques]];
Row[{Panel@mygraph, Panel@mygraph2b}, Spacer[15]]

enter image description here

| improve this answer | |
$\endgroup$
  • $\begingroup$ ConvexHull is undefined for me... What is GraphicsMeshMeshInit? $\endgroup$ – user5601 Nov 20 '14 at 18:27

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.