9
$\begingroup$

As we know,the region is very convenient in Mathematica.And we can convert a MeshRegion into graph like this

SeedRandom[7]
pts = RandomReal[1, {5, 2}];
voronoi = VoronoiMesh[pts]

Mathematica graphics

gvoronoi = 
 AdjacencyGraph[voronoi["AdjacencyMatrix"], 
  VertexCoordinates -> MeshCoordinates[voronoi]]

Mathematica graphics

But the question is how to convert the graph name as gvoronoi back into voronoi?I can convert it into a 1-dimension region like this

DiscretizeGraphics[
 Graphics@GraphicsComplex[GraphEmbedding[gvoronoi], 
   Line[List @@@ EdgeRules@gvoronoi]]]

Mathematica graphics

But we target is convert it back into a exact voronoi.How to do this?

$\endgroup$
10
$\begingroup$

Below you'll find the method I wrote myself, but it is terribly slow compared to this one, adapted from halmir's code here, so I will give the fast version first and post my own code below. See halmir's post for an explanation,

ClearAll@graphToMesh
graphToMesh[graph_?PlanarGraphQ] := 
 Module[{nextCandidate, m, orderings, pAdj, rightF, s, t, initial, 
   face, emb, faces},
  emb = GraphEmbedding[graph];
  nextCandidate[ss_, tt_, adj_] := Module[{length, pos},
    length = Length[adj];
    pos = Mod[Position[adj, ss][[1, 1]] + 1, length, 1];
    {tt, adj[[pos]]}];
  m = AdjacencyMatrix[graph];
  Do[pAdj[v] = 
    SortBy[Pick[VertexList[graph], m[[v]], 1], 
     ArcTan @@ (emb[[v]] - emb[[#]]) &], {v, VertexList[graph]}];
  rightF[_] := False;
  faces = Reap[Table[If[! rightF[e], s = e[[1]];
       t = e[[2]];
       initial = s;
       face = {s};
       While[t =!= initial, 
        rightF[UndirectedEdge[s, t]] = True;
        {s, t} = nextCandidate[s, t, pAdj[t]];
        face = Join[face, {s}];];
       Sow[face];],
      {e, EdgeList[graph]}]][[2, 1]];
  faces = Most[SortBy[faces, Area[Polygon[emb[[#]]]] &]];
  MeshRegion[emb, Polygon[faces]]
  ]

Applied to the original graph,

graphToMesh[gvoronoi]

enter image description here

These examples all run pretty quickly,

{#, graphToMesh[#]} & /@ {HararyGraph[4, 8, 
   GraphLayout -> "PlanarLayout"], GraphData[{"Antiprism", 13}], 
  GraphData["ZamfirescuGraph48"]}

enter image description here

Old, slower answer based on RegionIntersection

The previous answer I had posted seemed to work for any mesh region created from a VoronoiMesh but would fail for other types of graphs. This method is slower but more robust. It seeks to the minimal basis of non-overlapping regions in a graph, using the function graphToFaces described here

graphToFaces[graph_?PlanarGraphQ] := Module[{graphpoints, cycles, polygons, n},
  graphpoints = GraphEmbedding[graph];
  cycles = 
   Polygon[graphpoints[[#]]] & /@ 
    FindCycle[graph, Infinity, All][[All, All, 2]];
  cycles = SortBy[cycles, Area];
  polygons = {cycles[[1]]};
  n = 2;
  While[Length@polygons < Length@FindFundamentalCycles@graph && 
    n <= Length@cycles,
   If[
    And @@ (Area[RegionIntersection[cycles[[n]], #]] === 0 & /@ 
       polygons),
    AppendTo[polygons, cycles[[n]]]
    ];
   n++
   ];
  First /@ (polygons /. Thread[graphpoints -> Range@Length@graphpoints])
  ]

graphToMesh[graph_?PlanarGraphQ] := 
 MeshRegion[GraphEmbedding[graph], Polygon[graphToFaces[graph]]]

Here it is applied to six random Voronoi mesh objects,

Table[pts = RandomReal[1, {5, 2}];
 voronoi = VoronoiMesh[pts];
 gvoronoi = 
  AdjacencyGraph[voronoi["AdjacencyMatrix"], 
   VertexCoordinates -> MeshCoordinates[voronoi]];
 {voronoi, graphToMesh[gvoronoi]}, {6}]

enter image description here

In each result above, the output is identical to the input mesh.

| improve this answer | |
$\endgroup$
  • $\begingroup$ Sad to hear that.I'm in 10.4.:) $\endgroup$ – yode Apr 8 '16 at 15:16
  • $\begingroup$ And have you seen my this post? $\endgroup$ – yode Apr 8 '16 at 15:31
  • $\begingroup$ I did see that post, from what I saw it isn't actually a bug. What I posted above solves the question here from what I can tell. It takes the graph and outputs the polygons you want. Why the MeshRegion fails is beyond me. $\endgroup$ – Jason B. Apr 8 '16 at 15:59
  • $\begingroup$ @yode, I don't have version 10.4 at home, but I think the edit I just made will fix it for version 10.4. Try it and let me know. $\endgroup$ – Jason B. Apr 8 '16 at 17:46
  • $\begingroup$ @JasonB, that is working for me and I have 10.4 +1 $\endgroup$ – bobbym Apr 9 '16 at 2:08

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.