Planar Embedding

Author

Eric W. Weisstein
December 18, 2020

This notebook downloaded from http://mathworld.wolfram.com/notebooks/GraphTheory/PlanarEmbedding.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/PlanarEmbedding.html.

©2020 Wolfram Research, Inc. except for portions noted otherwise

Missing planar embeddings in GraphData

TextGrid[Sort[GraphData[#,{"V","#","Graph"}]&/@Select[GraphData["Planar"],FreeQ[GraphData[#,"EmbeddingClasses"],"Planar"]&]],Dividers->All]

RoundIfClose[x_?NumericQ]:=Module[{r=Round[x]},If[Abs[r-x]<10^-4,r,x]]
RoundIfClose[x_List]:=Module[{res=RoundIfClose/@x},
If[!FreeQ[res,_?ExactNumberQ]&&!FreeQ[res,_?InexactNumberQ],N[res],res];
res
]

{"Antelope", {7, 8}}

GraphData[{"Antelope",{7,8}},"Graph","Planar"]

TutteEmbedding[GraphData[{"Antelope",{7,8}}]]

GraphPlot[PlanarGraph[GraphData[{"Antelope",{7,8}}]]]

g=Graph[GraphData[{"Antelope",{7,8}},"VertexList"],GraphData[{"Antelope",{7,8}},"EdgeList"],GraphLayout->"TutteEmbedding",Axes->True,VertexLabels->Automatic]

Graph[GraphData[{"Antelope",{7,8}},"EdgeList"],GraphLayout->"PlanarEmbedding"]

Construction

p=Position[emb=GraphEmbedding[g],_?(#[[1]]≥0&&#[[2]]<-.8&)]//Flatten

VertexDegree[g][[p]]

VertexDelete[g,Complement[VertexList[g],p],VertexCoordinates->emb[[p]]]

VertexDelete[g,Complement[VertexList[g],p]]

v=CirclePoints[{1,-π/2},24];

v[[1]]=Mean[v[[{2,24}]]];

dx=First[Subtract@@v[[{2,1}]]]

v1=Join[v,(v[[1]]+# dx)&/@{{2,0},{3,0},{3,-1},{3,-2},{3,-3},{0,-3},{-3,-3},{-3,-2},{-3,-1},{-3,0},{-2,0}}];

dx2=First[v1[[28]]-v1[[31]]]/4//FullSimplify

v2=Join[v1,Table[v1[[32]]+i{dx2,0},{i,3}],{v1[[26]]+dx{1,0},v1[[30]]+dx{0,-1},v1[[34]]+dx{-1,0}}];

dy=v2[[40,2]]-v2[[39,2]]

v3=Join[v2,Table[v2[[39]]+{0,i dy/3},{i,3}],Table[v2[[41]]+{0,i dy/3},{i,3}]];

v[[9]]-v[[17]]

v[[11]]-v[[15]]

v4=Join[v3,{{0,0}},Table[v[[17]]+{Sqrt[3]i/8,0},{i,7}],Table[v[[15]]+{i/4,0},{i,3}]];

e=Join[Partition[Range[24],2,1,1],Partition[Range[25,35],2,1],{{2,25},{24,35}},Partition[{32,36,37,38,28},2,1],Partition[{26,39,42,43,44,40,47,46,45,41,34},2,1],Partition[{19,48,7},2,1],Partition[{17,49,50,51,52,53,54,55,9},2,1],Partition[{15,56,57,58,11},2,1],{{41,46},{43,39}}];

g=IndexGraph@VertexDelete[Graph[Range[Length[v4]],UndirectedEdge@@@e,VertexCoordinates->v4,VertexLabels->"Name"],{45,42}]

RecognizeGraph[g]

emb=GraphEmbedding[g];

newg=Graph[Range[56],EdgeList[g],VertexCoordinates->ReplacePart[emb,{44->Mean[emb[[{41,45}]]],42->Mean[emb[[{39,43}]]]}]]

r=RecognizeGraph[newg]

g=newg;

{"Cubic", {56, 2}}

GraphData[{"Cubic",{56,2}},"Graph","Planar"]

TutteEmbedding[GraphData[{"Cubic",{56,2}}]]

GraphPlot[PlanarGraph[GraphData[{"Cubic",{56,2}},"EdgeList"]]]

g=Graph[GraphData[{"Cubic",{56,2}},"VertexList"],GraphData[{"Cubic",{56,2}},"EdgeList"],GraphLayout->"TutteEmbedding",Axes->True,VertexLabels->Automatic]

Graph[GraphData[{"Cubic",{56,2}},"EdgeList"],GraphLayout->"PlanarEmbedding"]

Construction

GraphPlot[PlanarGraph[GraphData[{"Cubic",{56,2}}]]]

v=Flatten[Table[{-i,-j},{i,2},{j,9}],1];

v1=Join[v,{{-3,-1},{-3,-7},{-4,-7},{-5,-7},{-3,-8},{-3,-9},{-4,-8},{-4,-9},{-4,-7-1/2},{-5,-7-1/2}}];

e=Join[Partition[Join[Range[9,1,-1],Range[10,16]],2,1],{{16,20},{20,21},{21,22},{17,23},{8,17},{23,25},{25,26},{24,26},{24,18},{9,18},{10,19},{17,18},{23,24},{25,27},{21,27},{27,28},{26,28},{22,28},{19,20},{22,19},{2,11},{3,12},{4,13},{5,14},{6,15},{7,16}}];

Graph[Range[Length[v1]],UndirectedEdge@@@e,VertexCoordinates->v1,VertexLabels->"Name"]

v2={#+1/2,#2}&@@@v1;

Length[v2]

g=Graph[Range[2Length[v2]],UndirectedEdge@@@Join[e,e+28,{{1,29},{9,37}}],VertexCoordinates->Join[v2,{-#1,#2}&@@@v2],VertexLabels->"Name"]

RecognizeGraph[g]

g=GraphData[{"Cubic",{56,2}},"Graph","Labeled"]

v=GraphEmbedding[g];

v2=Which[#[[2]]==v[[40,2]],#-{0,1/2},
#[[2]]<v[[1,2]],#-{0,1},
True,#]&/@v

g=Graph[VertexList[g],EdgeList[g],VertexCoordinates->v2]

"McGregorGraph"

GraphData["McGregorGraph","Graph","All"]

GraphPlot[PlanarGraph[GraphData["McGregorGraph"]]]

TutteEmbedding[GraphData["McGregorGraph"]]

g=Graph[GraphData["McGregorGraph","VertexList"],GraphData["McGregorGraph","EdgeList"],GraphLayout->"TutteEmbedding",Axes->True,VertexLabels->Automatic]

Graph[GraphData["McGregorGraph","EdgeList"],GraphLayout->"PlanarEmbedding"]

Construction

GraphData["McGregorGraph","Graphics"]

{"SelfComplementary", {8, 1}}

g=GraphData[{"SelfComplementary",{8,1}},"#"]

GraphData[g,"AllImages"]

Default

res=System`Graph[GraphData[g,"EdgeList"]]

IsomorphicGraphQ[res,GraphData[g]]

emb={g,RoundIfClose@ToCommonEdges[res,GraphData[g]]}

SetProperty[GraphData[g],VertexCoordinates->Thread[Range[GraphData[g,"V"]]->emb[[2]]]]

Planar

res=System`Graph[GraphData[g,"EdgeList"],GraphLayout->"PlanarEmbedding"]

IsomorphicGraphQ[res,GraphData[g]]

emb={g,RoundIfClose@ToCommonEdges[res,GraphData[g]]}

SetProperty[GraphData[g],VertexCoordinates->Thread[Range[GraphData[g,"V"]]->emb[[2]]]]

Tutte

res=System`Graph[GraphData[g,"EdgeList"],GraphLayout->"TutteEmbedding"]

IsomorphicGraphQ[res,GraphData[g]]

emb={g,RotationMatrix[0].#&/@ToCommonEdges[res,GraphData[g]]//Chop[#,10^-4]&//N}

SetProperty[GraphData[g],VertexCoordinates->Thread[Range[GraphData[g,"V"]]->emb[[2]]]]

{"SelfComplementary", {8, 3}}

g=GraphData[{"SelfComplementary",{8,3}},"#"]

GraphData[g,"AllImages"]

Default

res=System`Graph[GraphData[g,"EdgeList"]]

IsomorphicGraphQ[res,GraphData[g]]

emb={g,RoundIfClose@ToCommonEdges[res,GraphData[g]]}

SetProperty[GraphData[g],VertexCoordinates->Thread[Range[GraphData[g,"V"]]->emb[[2]]]]

Planar

res=System`Graph[GraphData[g,"EdgeList"],GraphLayout->"PlanarEmbedding"]

IsomorphicGraphQ[res,GraphData[g]]

emb={g,RoundIfClose@ToCommonEdges[res,GraphData[g]]}

SetProperty[GraphData[g],VertexCoordinates->Thread[Range[GraphData[g,"V"]]->emb[[2]]]]

Tutte

res=System`Graph[GraphData[g,"EdgeList"],GraphLayout->"TutteEmbedding"]

IsomorphicGraphQ[res,GraphData[g]]

emb={g,RotationMatrix[0].#&/@ToCommonEdges[res,GraphData[g]]//Chop[#,10^-4]&//N}

SetProperty[GraphData[g],VertexCoordinates->Thread[Range[GraphData[g,"V"]]->emb[[2]]]]

{"SelfComplementary", {8, 4}}

g=GraphData[{"SelfComplementary",{8,4}},"#"]

GraphData[g,"AllImages"]

Default

res=System`Graph[GraphData[g,"EdgeList"]]

IsomorphicGraphQ[res,GraphData[g]]

emb={g,RoundIfClose@ToCommonEdges[res,GraphData[g]]}

SetProperty[GraphData[g],VertexCoordinates->Thread[Range[GraphData[g,"V"]]->emb[[2]]]]

Planar

res=System`Graph[GraphData[g,"EdgeList"],GraphLayout->"PlanarEmbedding"]

IsomorphicGraphQ[res,GraphData[g]]

emb={g,RoundIfClose@ToCommonEdges[res,GraphData[g]]}

SetProperty[GraphData[g],VertexCoordinates->Thread[Range[GraphData[g,"V"]]->emb[[2]]]]

Tutte

res=System`Graph[GraphData[g,"EdgeList"],GraphLayout->"TutteEmbedding"]

IsomorphicGraphQ[res,GraphData[g]]

emb={g,RotationMatrix[0].#&/@ToCommonEdges[res,GraphData[g]]//Chop[#,10^-4]&//N}

SetProperty[GraphData[g],VertexCoordinates->Thread[Range[GraphData[g,"V"]]->emb[[2]]]]

{"SelfComplementary", {8, 5}}

g=GraphData[{"SelfComplementary",{8,5}},"#"]

GraphData[g,"AllImages"]

Default

res=System`Graph[GraphData[g,"EdgeList"]]

IsomorphicGraphQ[res,GraphData[g]]

emb={g,RoundIfClose@ToCommonEdges[res,GraphData[g]]}

SetProperty[GraphData[g],VertexCoordinates->Thread[Range[GraphData[g,"V"]]->emb[[2]]]]

Planar

res=System`Graph[GraphData[g,"EdgeList"],GraphLayout->"PlanarEmbedding"]

IsomorphicGraphQ[res,GraphData[g]]

emb={g,RoundIfClose@ToCommonEdges[res,GraphData[g]]}

SetProperty[GraphData[g],VertexCoordinates->Thread[Range[GraphData[g,"V"]]->emb[[2]]]]

Tutte

res=System`Graph[GraphData[g,"EdgeList"],GraphLayout->"TutteEmbedding"]

IsomorphicGraphQ[res,GraphData[g]]

emb={g,RotationMatrix[0].#&/@ToCommonEdges[res,GraphData[g]]//Chop[#,10^-4]&//N}

SetProperty[GraphData[g],VertexCoordinates->Thread[Range[GraphData[g,"V"]]->emb[[2]]]]

{"SelfComplementary", {8, 6}}

g=GraphData[{"SelfComplementary",{8,6}},"#"]

GraphData[g,"AllImages"]

Default

res=System`Graph[GraphData[g,"EdgeList"]]

IsomorphicGraphQ[res,GraphData[g]]

emb={g,RoundIfClose@ToCommonEdges[res,GraphData[g]]}

SetProperty[GraphData[g],VertexCoordinates->Thread[Range[GraphData[g,"V"]]->emb[[2]]]]

Planar

res=System`Graph[GraphData[g,"EdgeList"],GraphLayout->"PlanarEmbedding"]

IsomorphicGraphQ[res,GraphData[g]]

emb={g,RoundIfClose@ToCommonEdges[res,GraphData[g]]}

SetProperty[GraphData[g],VertexCoordinates->Thread[Range[GraphData[g,"V"]]->emb[[2]]]]

Tutte

res=System`Graph[GraphData[g,"EdgeList"],GraphLayout->"TutteEmbedding"]

IsomorphicGraphQ[res,GraphData[g]]

emb={g,RotationMatrix[0].#&/@ToCommonEdges[res,GraphData[g]]//Chop[#,10^-4]&//N}

SetProperty[GraphData[g],VertexCoordinates->Thread[Range[GraphData[g,"V"]]->emb[[2]]]]

{"SelfComplementary", {8, 7}}

g=GraphData[{"SelfComplementary",{8,7}},"#"]

GraphData[g,"AllImages"]

Default

res=System`Graph[GraphData[g,"EdgeList"]]

IsomorphicGraphQ[res,GraphData[g]]

emb={g,RoundIfClose@ToCommonEdges[res,GraphData[g]]}

SetProperty[GraphData[g],VertexCoordinates->Thread[Range[GraphData[g,"V"]]->emb[[2]]]]

Planar

res=System`Graph[GraphData[g,"EdgeList"],GraphLayout->"PlanarEmbedding"]

IsomorphicGraphQ[res,GraphData[g]]

emb={g,RoundIfClose@ToCommonEdges[res,GraphData[g]]}

SetProperty[GraphData[g],VertexCoordinates->Thread[Range[GraphData[g,"V"]]->emb[[2]]]]

Tutte

res=System`Graph[GraphData[g,"EdgeList"],GraphLayout->"TutteEmbedding"]

IsomorphicGraphQ[res,GraphData[g]]

emb={g,RotationMatrix[0].#&/@ToCommonEdges[res,GraphData[g]]//Chop[#,10^-4]&//N}

SetProperty[GraphData[g],VertexCoordinates->Thread[Range[GraphData[g,"V"]]->emb[[2]]]]

{"SelfComplementary", {8, 8}}

g=GraphData[{"SelfComplementary",{8,8}},"#"]

GraphData[g,"AllImages"]

Default

res=System`Graph[GraphData[g,"EdgeList"]]

IsomorphicGraphQ[res,GraphData[g]]

emb={g,RoundIfClose@ToCommonEdges[res,GraphData[g]]}

SetProperty[GraphData[g],VertexCoordinates->Thread[Range[GraphData[g,"V"]]->emb[[2]]]]

Planar

res=System`Graph[GraphData[g,"EdgeList"],GraphLayout->"PlanarEmbedding"]

IsomorphicGraphQ[res,GraphData[g]]

emb={g,RoundIfClose@ToCommonEdges[res,GraphData[g]]}

SetProperty[GraphData[g],VertexCoordinates->Thread[Range[GraphData[g,"V"]]->emb[[2]]]]

Tutte

res=System`Graph[GraphData[g,"EdgeList"],GraphLayout->"TutteEmbedding"]

IsomorphicGraphQ[res,GraphData[g]]

emb={g,RotationMatrix[0].#&/@ToCommonEdges[res,GraphData[g]]//Chop[#,10^-4]&//N}

SetProperty[GraphData[g],VertexCoordinates->Thread[Range[GraphData[g,"V"]]->emb[[2]]]]

{"Bishop", {3, 3}}

g=GraphData[{"Bishop",{3,3}},"#"]

GraphData[g,"AllImages"]

Default

res=System`Graph[GraphData[g,"EdgeList"]]

IsomorphicGraphQ[res,GraphData[g]]

emb={g,RoundIfClose@ToCommonEdges[res,GraphData[g]]}

SetProperty[GraphData[g],VertexCoordinates->Thread[Range[GraphData[g,"V"]]->emb[[2]]]]

Planar

res=System`Graph[GraphData[g,"EdgeList"],GraphLayout->"PlanarEmbedding"]

IsomorphicGraphQ[res,GraphData[g]]

emb={g,RoundIfClose@ToCommonEdges[res,GraphData[g]]}

SetProperty[GraphData[g],VertexCoordinates->Thread[Range[GraphData[g,"V"]]->emb[[2]]]]

Tutte

res=System`Graph[GraphData[g,"EdgeList"],GraphLayout->"TutteEmbedding"]

IsomorphicGraphQ[res,GraphData[g]]

emb={g,RotationMatrix[0].#&/@ToCommonEdges[res,GraphData[g]]//Chop[#,10^-4]&//N}

SetProperty[GraphData[g],VertexCoordinates->Thread[Range[GraphData[g,"V"]]->emb[[2]]]]

{"BlackBishop", {3, 6}}

g=GraphData[{"BlackBishop",{3,6}},"#"]

GraphData[g,"AllImages"]

Default

res=System`Graph[GraphData[g,"EdgeList"]]

IsomorphicGraphQ[res,GraphData[g]]

emb={g,RoundIfClose@ToCommonEdges[res,GraphData[g]]}

SetProperty[GraphData[g],VertexCoordinates->Thread[Range[GraphData[g,"V"]]->emb[[2]]]]

Planar

res=System`Graph[GraphData[g,"EdgeList"],GraphLayout->"PlanarEmbedding"]

IsomorphicGraphQ[res,GraphData[g]]

emb={g,RoundIfClose@ToCommonEdges[res,GraphData[g]]}

SetProperty[GraphData[g],VertexCoordinates->Thread[Range[GraphData[g,"V"]]->emb[[2]]]]

Tutte

res=System`Graph[GraphData[g,"EdgeList"],GraphLayout->"TutteEmbedding"]

IsomorphicGraphQ[res,GraphData[g]]

emb={g,RotationMatrix[0].#&/@ToCommonEdges[res,GraphData[g]]//Chop[#,10^-4]&//N}

SetProperty[GraphData[g],VertexCoordinates->Thread[Range[GraphData[g,"V"]]->emb[[2]]]]

{"WhiteBishop", {3, 7}}

g=GraphData[{"WhiteBishop",{3,7}},"#"]

GraphData[g,"AllImages"]

Default

res=System`Graph[GraphData[g,"EdgeList"]]

IsomorphicGraphQ[res,GraphData[g]]

emb={g,RoundIfClose@ToCommonEdges[res,GraphData[g]]}

SetProperty[GraphData[g],VertexCoordinates->Thread[Range[GraphData[g,"V"]]->emb[[2]]]]

Planar

res=System`Graph[GraphData[g,"EdgeList"],GraphLayout->"PlanarEmbedding"]

IsomorphicGraphQ[res,GraphData[g]]

emb={g,RoundIfClose@ToCommonEdges[res,GraphData[g]]}

SetProperty[GraphData[g],VertexCoordinates->Thread[Range[GraphData[g,"V"]]->emb[[2]]]]

Tutte

res=System`Graph[GraphData[g,"EdgeList"],GraphLayout->"TutteEmbedding"]

IsomorphicGraphQ[res,GraphData[g]]

emb={g,RotationMatrix[0].#&/@ToCommonEdges[res,GraphData[g]]//Chop[#,10^-4]&//N}

SetProperty[GraphData[g],VertexCoordinates->Thread[Range[GraphData[g,"V"]]->emb[[2]]]]

{"BlackBishop", {3, 7}}

g=GraphData[{"BlackBishop",{3,7}},"#"]

GraphData[g,"AllImages"]

Default

res=System`Graph[GraphData[g,"EdgeList"]]

IsomorphicGraphQ[res,GraphData[g]]

emb={g,RoundIfClose@ToCommonEdges[res,GraphData[g]]}

SetProperty[GraphData[g],VertexCoordinates->Thread[Range[GraphData[g,"V"]]->emb[[2]]]]

Planar

res=System`Graph[GraphData[g,"EdgeList"],GraphLayout->"PlanarEmbedding"]

IsomorphicGraphQ[res,GraphData[g]]

emb={g,RoundIfClose@ToCommonEdges[res,GraphData[g]]}

SetProperty[GraphData[g],VertexCoordinates->Thread[Range[GraphData[g,"V"]]->emb[[2]]]]

Tutte

res=System`Graph[GraphData[g,"EdgeList"],GraphLayout->"TutteEmbedding"]

IsomorphicGraphQ[res,GraphData[g]]

emb={g,RotationMatrix[0].#&/@ToCommonEdges[res,GraphData[g]]//Chop[#,10^-4]&//N}

SetProperty[GraphData[g],VertexCoordinates->Thread[Range[GraphData[g,"V"]]->emb[[2]]]]

{"Bishop", {3, 4}}

g=GraphData[{"Bishop",{3,4}},"#"]

GraphData[g,"AllImages"]

GraphData[g,"ConnectedComponentGraphNames"]

GraphData[{"BlackBishop",{3,4}},"Images"]

Default

res=System`Graph[GraphData[g,"EdgeList"]]

IsomorphicGraphQ[res,GraphData[g]]

emb={g,RoundIfClose@ToCommonEdges[res,GraphData[g]]}

SetProperty[GraphData[g],VertexCoordinates->Thread[Range[GraphData[g,"V"]]->emb[[2]]]]

Planar

res=System`Graph[GraphData[g,"EdgeList"],GraphLayout->"PlanarEmbedding"]

IsomorphicGraphQ[res,GraphData[g]]

emb={g,RoundIfClose@ToCommonEdges[res,GraphData[g]]}

SetProperty[GraphData[g],VertexCoordinates->Thread[Range[GraphData[g,"V"]]->emb[[2]]]]

Tutte

res=System`Graph[GraphData[g,"EdgeList"],GraphLayout->"TutteEmbedding"]

IsomorphicGraphQ[res,GraphData[g]]

emb={g,RotationMatrix[0].#&/@ToCommonEdges[res,GraphData[g]]//Chop[#,10^-4]&//N}

SetProperty[GraphData[g],VertexCoordinates->Thread[Range[GraphData[g,"V"]]->emb[[2]]]]

Test for planarity of embeddings

<<MathWorld`Graphs`

Mismatch

DeleteCases[
Monitor[Function[g,{
gr=g,
MemberQ[#,"Planar"]&/@GraphData[g,"EmbeddingClasses"],PlanarGraphEmbeddingQ/@GraphData[g,"Graph","All"]
}]/@GraphData[;;19],gr],
{_,x_,x_}]//Timing

DeleteCases[
Monitor[Function[g,{
gr=g,
MemberQ[#,"Planar"]&/@GraphData[g,"EmbeddingClasses"],PlanarGraphEmbeddingQ/@GraphData[g,"Graph","All"]
}]/@DeleteCases[
GraphData[20],
(* crashes *)
{"CompleteKPartite",{5,5,5,5}}|{"CompleteKPartite",{4,4,4,4,4}}
],gr],
{_,x_,x_}]//Timing

crashes on GraphData[{"CompleteKPartite", {5, 5, 5, 5}}, "Graph", "All"][[1]]:
https://mail-archive.wolfram.com/archive/t-discretemath/2020/Dec00/0006.html

Indicated as Planar but not

Monitor[Select[Function[g,{gr=g,PlanarGraphEmbeddingQ/@GraphData[g,"Graph","Planar"]}]/@GraphData["Planar"],!And@@#[[2]]&],gr]//Timing

Tutte embeddings

Prototype

Tutte algorithm or the barycentric method. 
A good reference: http://arxiv.org/pdf/1201.3011v1.pdf (page 5)

Clear[tutte];
tutte[coords_,interior_,adj_]:=
Block[{v,neighbors},
v=coords;
neighbors=adj;
Scan[(v[[#]] = Mean[v[[neighbors[[#]]]]])&, interior];
v
]

Clear[TutteEmbedding];
TutteEmbedding[g_]:=
Block[{res,h,coords,hull,interior,exterior,adj,mesh},
(* planar layout to get the external face *)
h=AdjacencyGraph[AdjacencyMatrix[g],GraphLayout->"PlanarEmbedding",VertexLabels->"Name"];
coords=GraphEmbedding[h];
mesh=ConvexHullMesh[coords];
hull=MeshCoordinates[mesh];
hull= hull[[MeshCells[mesh,1][[All,1,1]]]];
(* barycentric method *)
interior=Flatten[Position[coords,Alternatives @@ Complement[coords,hull]]];
exterior=Flatten[Position[coords,#,1,1]&/@ hull];
adj=AdjacencyList[h,#]&/@ VertexList[g];
   coords[[interior]]={0.,0.};
  coords[[exterior]]=Table[{Cos[2.Pi i/(Length[exterior])],Sin[2.Pi i/(Length[exterior])]},{i,0,Length[exterior]-1}]; 
Graph[VertexList[g],EdgeList[g],VertexCoordinates->FixedPoint[tutte[#,interior,adj]&,coords]]
]

AdjacencyGraph[AdjacencyMatrix[g],GraphLayout->"TutteEmbedding"]}

Example 1

g = ;

EdgeList[g]

RecognizeGraph[System`Graph[{1\[UndirectedEdge]2,1\[UndirectedEdge]3,1\[UndirectedEdge]7,1\[UndirectedEdge]8,1\[UndirectedEdge]9,1\[UndirectedEdge]15,1\[UndirectedEdge]16,2\[UndirectedEdge]3,2\[UndirectedEdge]4,2\[UndirectedEdge]5,2\[UndirectedEdge]6,2\[UndirectedEdge]16,3\[UndirectedEdge]4,3\[UndirectedEdge]7,3\[UndirectedEdge]10,4\[UndirectedEdge]5,4\[UndirectedEdge]10,4\[UndirectedEdge]11,4\[UndirectedEdge]12,4\[UndirectedEdge]13,5\[UndirectedEdge]6,5\[UndirectedEdge]11,6\[UndirectedEdge]11,6\[UndirectedEdge]14,6\[UndirectedEdge]16,7\[UndirectedEdge]8,7\[UndirectedEdge]10,8\[UndirectedEdge]9,8\[UndirectedEdge]10,9\[UndirectedEdge]10,9\[UndirectedEdge]15,10\[UndirectedEdge]13,10\[UndirectedEdge]15,11\[UndirectedEdge]12,11\[UndirectedEdge]14,12\[UndirectedEdge]13,12\[UndirectedEdge]14,13\[UndirectedEdge]14,13\[UndirectedEdge]15,13\[UndirectedEdge]16,14\[UndirectedEdge]16,15\[UndirectedEdge]16}]]

{AdjacencyGraph[AdjacencyMatrix[g],GraphLayout-> "PlanarEmbedding"],
AdjacencyGraph[AdjacencyMatrix[g],GraphLayout->"TutteEmbedding"]}

Example 2

g=;

EdgeList[g]

RecognizeGraph[System`Graph[{1\[UndirectedEdge]2,1\[UndirectedEdge]3,1\[UndirectedEdge]5,1\[UndirectedEdge]7,2\[UndirectedEdge]3,2\[UndirectedEdge]4,2\[UndirectedEdge]7,3\[UndirectedEdge]4,3\[UndirectedEdge]5,4\[UndirectedEdge]5,4\[UndirectedEdge]6,4\[UndirectedEdge]7,5\[UndirectedEdge]6,5\[UndirectedEdge]7,6\[UndirectedEdge]7}]]

{AdjacencyGraph[AdjacencyMatrix[g],GraphLayout-> "PlanarEmbedding"],
AdjacencyGraph[AdjacencyMatrix[g],GraphLayout->"TutteEmbedding"]}

Example 3

g=;

EdgeList[g]

RecognizeGraph[System`Graph[{1\[UndirectedEdge]2,1\[UndirectedEdge]3,1\[UndirectedEdge]14,2\[UndirectedEdge]3,2\[UndirectedEdge]5,3\[UndirectedEdge]4,3\[UndirectedEdge]6,3\[UndirectedEdge]13,4\[UndirectedEdge]7,4\[UndirectedEdge]8,5\[UndirectedEdge]6,5\[UndirectedEdge]9,6\[UndirectedEdge]10,7\[UndirectedEdge]8,7\[UndirectedEdge]11,8\[UndirectedEdge]11,8\[UndirectedEdge]12,9\[UndirectedEdge]10,9\[UndirectedEdge]14,10\[UndirectedEdge]11,11\[UndirectedEdge]12,12\[UndirectedEdge]13,13\[UndirectedEdge]14}]]

{AdjacencyGraph[AdjacencyMatrix[g],GraphLayout-> "PlanarEmbedding"],
AdjacencyGraph[AdjacencyMatrix[g],[AdjacencyMatrix[g],GraphLayout->"TutteEmbedding"]]}

Orthogonal flow planar embedding

<<MeganNaminski`OrthogonalFlow`

TetrahedralGraph

{GraphData["TetrahedralGraph"],OrthogonalFlowPlanarEmbedding@GraphData["TetrahedralGraph"]}

PropertyValue[OrthogonalFlowPlanarEmbedding@GraphData["TetrahedralGraph"],EdgeShapeFunction]

Example1

testedges = {v1\[UndirectedEdge]v2,v1\[UndirectedEdge]v3,v2\[UndirectedEdge]v3,v2\[UndirectedEdge]v4,v3\[UndirectedEdge]v4, v4\[UndirectedEdge]v5,v5\[UndirectedEdge]v6, v5\[UndirectedEdge]v7, v6\[UndirectedEdge]v7, v6\[UndirectedEdge]v8, v6\[UndirectedEdge]v9, v8\[UndirectedEdge]v9, v1\[UndirectedEdge]v10, v10\[UndirectedEdge]v11, v1\[UndirectedEdge]v12, v2\[UndirectedEdge]v13, v7\[UndirectedEdge]v14, v14\[UndirectedEdge]v15, v14\[UndirectedEdge]v16, v15\[UndirectedEdge]v17, v17\[UndirectedEdge]v16};
coords = {{0,1},{1,1},{0,0},{1,0}, {2,0}, {2,1},{3,0}, {3,1}, {3,2}, {-1,0}, {-2,0}, {.25, .75}, {.5, .75}, {4,0}, {4,1},{5,0}, {5,2}};
testg =System`Graph[testedges, VertexCoordinates -> coords, VertexLabels -> "Name"];
{testg,OrthogonalFlowPlanarEmbedding[testg]}

Example2

test2edges = {(Subscript[v, 1])\[UndirectedEdge](Subscript[v, 2]),(Subscript[v, 1])\[UndirectedEdge](Subscript[v, 12]),(Subscript[v, 2])\[UndirectedEdge](Subscript[v, 3]),(Subscript[v, 2])\[UndirectedEdge](Subscript[v, 13]),(Subscript[v, 2])\[UndirectedEdge](Subscript[v, 12]),(Subscript[v, 3])\[UndirectedEdge](Subscript[v, 4]),(Subscript[v, 3])\[UndirectedEdge](Subscript[v, 7]),(Subscript[v, 4])\[UndirectedEdge](Subscript[v, 5]),(Subscript[v, 4])\[UndirectedEdge](Subscript[v, 7]),(Subscript[v, 5])\[UndirectedEdge](Subscript[v, 6]),(Subscript[v, 6])\[UndirectedEdge](Subscript[v, 7]),(Subscript[v, 6])\[UndirectedEdge](Subscript[v, 8]),(Subscript[v, 7])\[UndirectedEdge](Subscript[v, 10]),(Subscript[v, 8])\[UndirectedEdge](Subscript[v, 9]),(Subscript[v, 9])\[UndirectedEdge](Subscript[v, 10]),(Subscript[v, 10])\[UndirectedEdge](Subscript[v, 11]),(Subscript[v, 10])\[UndirectedEdge](Subscript[v, 13]),(Subscript[v, 11])\[UndirectedEdge](Subscript[v, 12]),(Subscript[v, 12])\[UndirectedEdge](Subscript[v, 13])};
verts2 = {(Subscript[v, 1]),(Subscript[v, 2]),(Subscript[v, 3]),(Subscript[v, 4]),(Subscript[v, 5]),(Subscript[v, 6]),(Subscript[v, 7]),(Subscript[v, 8]),(Subscript[v, 9]),(Subscript[v, 10]),(Subscript[v, 11]),(Subscript[v, 12]),(Subscript[v, 13])};
coords2 = {{1.5,2.75},{2, 2.25},{3, 2},{2.75,1.25},{3.5,.5},{2.5,0},{2,1.25},{1,0},{0,.25},{.5,1}, {0,1.75},{1,2},{1.5,1.75}};
testg2 = System`Graph[verts2, test2edges, VertexCoordinates-> coords2, VertexLabels->"Name"];
{testg2, OrthogonalFlowPlanarEmbedding[testg2]}

Example3

test3edges = {1\[UndirectedEdge]3,1\[UndirectedEdge]7,1\[UndirectedEdge]8,2\[UndirectedEdge]7,2\[UndirectedEdge]13,3\[UndirectedEdge]8,4\[UndirectedEdge]11,4\[UndirectedEdge]13,4\[UndirectedEdge]14,5\[UndirectedEdge]10,5\[UndirectedEdge]11,5\[UndirectedEdge]12,6\[UndirectedEdge]12,6\[UndirectedEdge]15,6\[UndirectedEdge]18,7\[UndirectedEdge]8,7\[UndirectedEdge]13,8\[UndirectedEdge]16,9\[UndirectedEdge]16,9\[UndirectedEdge]17,9\[UndirectedEdge]18,9\[UndirectedEdge]20,10\[UndirectedEdge]11,10\[UndirectedEdge]13,11\[UndirectedEdge]19,12\[UndirectedEdge]17,12\[UndirectedEdge]18,14\[UndirectedEdge]16,14\[UndirectedEdge]19,14\[UndirectedEdge]20,15\[UndirectedEdge]18,15\[UndirectedEdge]19,15\[UndirectedEdge]20,16\[UndirectedEdge]17,19\[UndirectedEdge]20};
verts3 = {1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20};
coords3 = {{0.912115,0.507966},{0.815199,0.403792},{0.685917,0.545877},{0.57883,0.290213},{0.125822,0.110259},{0.144839,0.326135},{0.956527,0.425241},{0.954092,0.585795},{0.407364,0.802805},{0.698717,0.0806879},{0.470805,0.27633},{0.0259062,0.988346},{0.846992,0.209788},{0.641354,0.540486},{0.182998,0.61681},{0.740512,0.863652},{0.616341,0.935929},{0.0821156,0.853779},{0.358659,0.396573},{0.370222,0.607626}};
test3g = System`Graph[verts3, test3edges, VertexCoordinates -> coords3, VertexLabels->"Name"];
{test3g,OrthogonalFlowPlanarEmbedding[test3g]}