Visualizing subgraphs while specifying the locations of vertexes

Question

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?

Answer 1

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"]]

Further reading: metaballs.

Answer 2

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

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

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