Uniquely Embeddable Graph

Author

Eric W. Weisstein
May 14, 2024

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

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

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

Source

Fleischner, H.  "The Uniquely Embeddable Planar Graphs."  Disc. Math. 4, 347–358, 1973.

https://doi.org/10.1016/0012-365X(73)90169-6

From Stan Wagon, 2024-05-12:
I wrote Fleischner. His response was that K(2,4) was not uniquely embeddable  — but it is !!!  His paper is using an odd definition — related to the labeled graphs.
We can just ignore it. His Thm has no relevance.
The proper definition of equivalent embeddings is that there is a homeomorphism of the sphere sending one drawing to the other.

Counts

GraphData

Length/@(uniquelyembeddable=Table[GraphData[{"Connected", "UniquelyEmbeddable"}, n],{n,7}])

Compute

<<MathWorld`Graphs`

Length/@(uniquelyembeddable=Table[Select[PlanarConnectedGraphs[n],UniquelyEmbeddableGraphQ],{n,6}])//Timing

Precomputed

SetDirectory[FileNameJoin[{$GraphDataDirectory,"Nodes","PlanarEmbeddingCount"}]]

FileNames["*.m"]

Table[Count[Get["PlanarEmbeddingCount_"<>If[n<10,"0",""]<>ToString[n]<>".m"],1],{n,7}]

McKay

SetDirectory[FileNameJoin[{$GraphDataDirectory,"Nodes","PlanarEmbeddingCount"}]]

FileNames["*.txt"]

(tallies=Rest@SequenceSplit[Import["embedding_counts.txt","Lines"],{_?(StringMatchQ["=====*"]),_}]/.s_String:>StringCases[s,d:DigitCharacter..:>FromDigits[d]]/.{}->Nothing)//Column

tallies[[All,1,2]]

Figure

GraphicsGrid[
Map[
Show[StyleGraphs[GraphData[#,"Graph","Planar"][[1]],VertexSize->If[#==="SingletonGraph",.015,{"Scaled",.05}]],PlotLabel->TextCell[Style[GraphData[#,"Name"],Directive[12,Black,Opacity[1],FontFamily->"Times",Italic]],PageWidth->700/8,TextAlignment->Center]]&,
Flatten[Partition[#,UpTo[8]]&/@Take[uniquelyembeddable,5],1],
{2}
],
Dividers->{{Thick,{True},Thick},{{Thick},True,Thick}},ImageSize->700,Alignment->Top]

Non-uniquely embeddable Trees

Table[Select[GraphData["Tree",n],GraphData[#,"UniquelyEmbeddable"]===False&],{n,8}]//Column

GraphDataCountTable

<<MathWorld`Graphs`

GraphDataCountTable["UniquelyEmbeddable"]

Examples

PlanarGraphEmbeddings[GraphData["DartGraph"]]

PlanarGraphEmbeddings[GraphData[{"Matchstick",{8,1}}]]