5

For one of the embedding of a planar graph, only one face is the exterior face which contain the point. In the example as below, the {1, 3, 4, 5, 3, 2} is such face. We know that it is not always the largest list, how to automatic remove such face does not depend on the area is difficult for me. ( The pink polygon is the largest polygon in this example )

Clear["Global`*"];
SeedRandom[123];
g = Graph[{1, 2, 3, 4, 5}, 
  UndirectedEdge @@@ {{1, 2}, {1, 3}, {2, 3}, {3, 4}, {4, 5}, {5, 3}},
   VertexLabels -> Automatic]
coords = GraphEmbedding[g];
faces = PlanarFaceList[g];
vertexs2coords = AssociationThread[VertexList[g] -> coords];
figs = Graphics /@ ({RandomColor[], Polygon@#} & /@ faces /. 
    vertexs2coords)
{Show[figs], Show[figs[[1]], figs[[3]]]}

enter image description here

enter image description here

cvgmt
  • 72,231
  • 4
  • 75
  • 133
herbertfederer
  • 1,180
  • 4
  • 13

1 Answers1

6
  • At first we use GraphEmbedding to extract the coordinates of the vertexs for the fixed embbeding.

  • To exclude the exterior face one possible way maybe use WindingCount.

Clear["Global`*"];
SeedRandom[123];
g = Graph[{1, 2, 3, 4, 5}, 
   UndirectedEdge @@@ {{1, 2}, {1, 3}, {2, 3}, {3, 4}, {4, 5}, {5, 
      3}}, VertexLabels -> Automatic];
coords = GraphEmbedding[g];
edges = EdgeList@g /. 
   UndirectedEdge[i_, j_] :> 
    UndirectedEdge[coords[[i]], coords[[j]]];
g = Graph[coords, edges, VertexCoordinates -> coords];
faces = PlanarFaceList[g];
faces = Select[faces, WindingCount[Line@#, Mean@#] == 1 &];
{RandomColor[], Polygon@#} & /@ faces // Graphics

enter image description here

  • We can test another graph PlanarGraph[HypercubeGraph[3]]. The final resul does not contain the largest square.
Clear["Global`*"];
SeedRandom[123];
g = PlanarGraph[HypercubeGraph[3]];
coords = GraphEmbedding[g];
edges = EdgeList@g /. 
   UndirectedEdge[i_, j_] :> 
    UndirectedEdge[coords[[i]], coords[[j]]];
g = Graph[coords, edges, VertexCoordinates -> coords];
faces = PlanarFaceList[g];
faces = Select[faces, WindingCount[Line@#, Mean@#] == 1 &];
GraphicsRow[{Show@g, 
  GraphicsRow[Graphics[{RandomColor[], Polygon@#}] & /@ faces]}]

enter image description here

cvgmt
  • 72,231
  • 4
  • 75
  • 133