Finding face vertices from the face adjacency graph

Question

I have a question about face adjacency graphs.

Suppose that I have an adjacency matrix

M = {{0, 1, 0, 0, 1, 1, 0, 0}, 
     {1, 0, 1, 0, 0, 0, 0, 1},  
     {0, 1, 0, 1, 0, 0, 1, 0}, 
     {0, 0, 1, 0, 1, 0, 1, 0}, 
     {1, 0, 0, 1, 0, 1, 0, 0}, 
     {1, 0, 0, 0, 1, 0, 0, 1}, 
     {0, 0, 1, 1, 0, 0, 0, 1}, 
     {0, 1, 0, 0, 0, 1, 1, 0}}

that is known to be a planar graph. So I use the command GraphPlot[M] and give vertex labeling. The result is

There are 5 faces in the figure (exclude the outer face). The set of vertices of the faces is {{1,6,8,2}, {1,6,5},{4,5,6,8,7},{3,4,7},{2,3,7,8}}.

I don't know how to find this list of vertices automatically if I enter any adjacency matrix (I'm sure that all picked matrices are planar graphs due to PlanarGraph[M])

Answer 1

As Sjoerd noted, version 9 includes a layout algorithm that will avoid edge crossings if the graph is planar. This is the most difficult part of the task, but once you have the planar embedding, it is relatively easy to find the faces.

You can start by finding counterclockwise orderings of vertices around any vertex. Let g be the planar graph, then

emb = GraphEmbedding[g, "PlanarEmbedding"]
m = AdjacencyMatrix[g]

orderings = Table[
  SortBy[
   Pick[VertexList[g], m[[v]], 1],     (* all neigbours of v *)
   ArcTan @@ (emb[[v]] - emb[[#]]) &
  ],
  {v, VertexList[g]}
 ]

Based on this information you can walk the vertices belonging to each face, you just need to make sure you never make a turn greater than 180 degrees.

I don't have time to finish implementing this. I hope this information was helpful and you'll be able to program it.

Answer 2

As Szaboics mentioned, you could use ordering (PlanarEmbedding) to find faces.

g = AdjacencyGraph[M, GraphLayout -> "PlanarEmbedding", 
             VertexLabels -> "Name", ImagePadding -> 5]

The following function will find next vertex of the face based on the given planar embedding:

nextCandidate[s_, t_, adj_] :=
   Block[{ length, pos},
      length = Length[adj];
      pos = Mod[Position[adj, s][[1, 1]] + 1, length, 1];
      {t, adj[[pos]]}
    ];

The main function to get all faces:

FindFace[g_?PlanarGraphQ] :=
   Block[{emb},
      emb = GraphEmbedding[g, "PlanarEmbedding"];
      FindFace[g, emb]
   ];

FindFace[g_?PlanarGraphQ, emb_] :=
   Block[{m, orderings, pAdj, rightF, s, t, initial, face},
       m = AdjacencyMatrix[g];
       Table[pAdj[v] = 
           SortBy[Pick[VertexList[g], m[[v]], 1], 
           ArcTan @@ (emb[[v]] - emb[[#]]) &], {v, VertexList[g]}];
       rightF[_] := False;
       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[g]}]][[2, 1]]
     ]

For example,

In[162]:= faces = FindFace[g]
Out[162]= {{1, 2, 8, 6}, {1, 5, 4, 3, 2}, {1, 6, 5}, {2, 3, 7, 8}, {3,
     4, 7}, {4, 5, 6, 8, 7}}

coord = GraphEmbedding[g]; 
Graphics[{EdgeForm[Directive[Black, Thick]], 
 Thread[{ColorData[3, "ColorList"][[;; Length[faces]]], 
           Polygon[coord[[#]]] & /@ faces}]}]

You could use the precomputed coordinates if you want like:

g = GridGraph[{3, 3}]

In[166]:= FindFace[g, GraphEmbedding[g]]
Out[166]= {{1, 2, 5, 4}, {1, 4, 7, 8, 9, 6, 3, 2}, {2, 3, 6, 5}, {4, 
     5, 8, 7}, {5, 6, 9, 8}}

Note that this function will find all faces including the external face.

Hope this help you to start this.