Uniquely Embeddable Graph

Author

Eric W. Weisstein
December 3, 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 [uses nonstandard definition]

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.

Examples of non-unique embeddings

PlanarGraphEmbeddings[GraphData["DartGraph"]]

GraphData["DartGraph","PlanarEmbeddingCount"]

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

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

Figure

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

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

uniquelyembeddable

bug(454882): GraphicsGrid's fail to display thin graphs, change width of rows, and display grid element content suboptimally starting in V14.1

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 New Roman",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]

Counts

Uniquely embeddable

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

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

A372853

tallies[[All,1,2]]

Not uniquely embeddable triangulated

Select[GraphData["Triangulated"],GraphData[#,"PlanarEmbeddingCount"]=!=1&]

GraphData[{"NotUniquelyEmbeddable","Triangulated"}]

Not uniquely embeddable polyhedral

Select[GraphData["Polyhedral"],GraphData[#,"PlanarEmbeddingCount"]=!=1&]

GraphData[{"NotUniquelyEmbeddable","Polyhedral"}]

Not uniquely embeddable trees

Sort[GraphData[#,{"V","#"}]&/@Select[GraphData["Tree"],MissingQ[GraphData[#,"PlanarEmbeddingCount"]]&]]

"Invalid line: "{"i?B{???????^?_??????…",{"Firecracker",{7,6}},{"BIG","[at","least","10]"}}
"Invalid line: "{"o?B{???????^?_??????…",{"Firecracker",{8,6}},{"BIG","[at","least","20]"}}
"Invalid line: "{"p??F{??????????^_G??…",{"Firecracker",{7,7}},{"BIG","[at","least","10]"}}
"Invalid line: "{"w???F}?????????????@…",{"Firecracker",{7,8}},{"BIG","[at","least","10]"}}
"Invalid line: "{"w??F{??????????^_G??…",{"Firecracker",{8,7}},{"BIG","[at","least","20]"}}
"Invalid line: "{"~?@????F}???????????…",{"Firecracker",{8,8}},{"BIG","[at","least","20]"}}

Sort@GroupBy[Select[GraphData["Tree"],GraphData[#,"PlanarEmbeddingCount"]>1&],GraphData[#,"V"]&]

GraphicsGrid[Map[
StyleGraphs[Graph[EdgeList[GraphData[#]]]]&,
DeleteCases[Flatten[Partition[#,UpTo[8]]&/@Table[GraphData[{"Tree","NotUniquelyEmbeddable"},n],{n,9}],1],{}],
{2}
],Dividers->{{Thick,{True},Thick},{Thick,Thick,Thick,True,Thick}}]

A378672

Length/@Table[GraphData[{"Tree","UniquelyEmbeddable"},n],{n,12}]

A000055

treecounts=Take[BFileSequence[55],{2,13}]

A378673

%-%%

Length/@Table[GraphData[{"Tree","NotUniquelyEmbeddable"},n],{n,12}]

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]]

GraphDataCountTable

<<MathWorld`Graphs`

GraphDataCountTable["UniquelyEmbeddable"]

Parametrized families

<<MathWorld`Graphs`

Alkane

seq=Table[GraphData[{"Alkane",n},"UniquelyEmbeddable"],{n,10}]

AlternatingGroupGraph

seq=Table[GraphData[{"AlternatingGroupGraph",n},"UniquelyEmbeddable"],{n,2,6}]

Andrasfai

seq=Table[GraphData[{"Andrasfai",n},"UniquelyEmbeddable"],{n,20}]

Antelope n×n

seq=Table[GraphData[{"Antelope",{n,n}},"UniquelyEmbeddable"],{n,20}]

Antiprism

Entity["Graph",{"Antiprism",n}]["UniquelyEmbeddable"]

seq=Table[GraphData[{"Antiprism",n},"UniquelyEmbeddable"],{n,3,25}]

Apollonian

seq=Table[GraphData[{"Apollonian",n},"UniquelyEmbeddable"],{n,5}]

Barbell

seq=Table[GraphData[{"Barbell",n},"UniquelyEmbeddable"],{n,3,20}]

Bishop n×n

seq=Table[GraphData[{"Bishop",{n,n}},"UniquelyEmbeddable"],{n,20}]

BlackBishop n×n

seq=Table[GraphData[{"BlackBishop",{n,n}},"UniquelyEmbeddable"],{n,20}]

Book

seq=Table[GraphData[{"Book",n},"UniquelyEmbeddable"],{n,20}]

Bruhat

seq=Table[GraphData[{"Bruhat",n},"UniquelyEmbeddable"],{n,6}]

Camel n×n

seq=Table[GraphData[{"Camel",{n,n}},"UniquelyEmbeddable"],{n,20}]

Centipede

seq=Table[GraphData[{"Centipede",n},"UniquelyEmbeddable"],{n,10}]

CocktailParty

seq=Table[GraphData[{"CocktailParty",n},"UniquelyEmbeddable"],{n,20}]

Complete

Entity["Graph",{"Complete",n}]["UniquelyEmbeddable"]

seq=Table[GraphData[{"Complete",n},"UniquelyEmbeddable"],{n,30}]

CompleteBipartite n×n

Entity["Graph",{"CompleteBipartite",{n,n}}]["UniquelyEmbeddable"]

Missing["UnknownProperty",{"Graph","UniquelyEmbeddable"}]

seq=Table[GraphData[{"CompleteBipartite",{n,n}},"UniquelyEmbeddable"],{n,20}]

CompleteBipartite m×n

Entity["Graph",{"CompleteBipartite",{m,n}}]["UniquelyEmbeddable"]

DeleteCases[Flatten[Table[{
{m,n},
GraphData[{"CompleteBipartite",{m,n}},"UniquelyEmbeddable"],
Piecewise[{{True,Min[m,n]<3}},False]
},{n,10},{m,n}],1],{_,x_,x_}]

CompleteTripartite n×n×n

Entity["Graph",{"CompleteTripartite",{n,n,n}}]["UniquelyEmbeddable"]

Missing["UnknownProperty",{"Graph","UniquelyEmbeddable"}]

seq=Table[GraphData[{"CompleteTripartite",{n,n,n}},"UniquelyEmbeddable"],{n,10}]

CompleteTripartite k×m×n

Entity["Graph",{"CompleteTripartite",{k,m,n}}]["UniquelyEmbeddable"]

Missing["UnknownProperty",{"Graph","UniquelyEmbeddable"}]

DeleteCases[Flatten[Table[{
{k,m,n},
GraphData[{"CompleteTripartite",{k,m,n}},"UniquelyEmbeddable"],
Piecewise[{{True, k*m*n == Max[k, m, n] || k == m == n == 2 || (Min[k, m, n] == 1 && Max[k, m, n] == 2 && k*m*n == 4)}}, False]
},{n,10},{m,n},{k,m}],2],{_,x_,x_}]

CrossedPrism

seq=Table[GraphData[{"CrossedPrism",2n},"UniquelyEmbeddable"],{n,2,12}]

Crown

seq=Table[GraphData[{"Crown",n},"UniquelyEmbeddable"],{n,20}]

CubeConnectedCycle

Entity["Graph",{"CubeConnectedCycle",n}]["UniquelyEmbeddable"]

Missing["UnknownProperty",{"Graph","UniquelyEmbeddable"}]

seq=Table[GraphData[{"CubeConnectedCycle",n},"UniquelyEmbeddable"],{n,3,8}]

Cycle

Entity["Graph",{"Cycle",n}]["UniquelyEmbeddable"]

Missing["UnknownProperty",{"Graph","UniquelyEmbeddable"}]

seq=Table[GraphData[{"Cycle",n},"UniquelyEmbeddable"],{n,3,30}]

CycleComplement

seq=Table[GraphData[{"CycleComplement",n},"UniquelyEmbeddable"],{n,3,20}]

DiagonalIntersection

seq=Table[GraphData[{"DiagonalIntersection",n},"UniquelyEmbeddable"],{n,3,14}]

Dipyramid

seq=Table[GraphData[{"Dipyramid",n},"UniquelyEmbeddable"],{n,3,20}]

DorogovtsevGoltsevMendes

seq=Table[GraphData[{"DorogovtsevGoltsevMendes",n},"UniquelyEmbeddable"],{n,0,7}]

DoubleCone

seq=Table[GraphData[{"DoubleCone",n},"UniquelyEmbeddable"],{n,3,20}]

Empty

Entity["Graph",{"Empty",n}]["UniquelyEmbeddable"]

Missing["UnknownProperty",{"Graph","UniquelyEmbeddable"}]

seq=Table[GraphData[{"Empty",n},"UniquelyEmbeddable"],{n,30}]

FibonacciCube

seq=Table[GraphData[{"FibonacciCube",n},"UniquelyEmbeddable"],{n,15}]

Fiveleaper n×n

seq=Table[GraphData[{"Fiveleaper",{n,n}},"UniquelyEmbeddable"],{n,20}]

Flower

seq=Table[GraphData[{"Flower",n},"UniquelyEmbeddable"],{n,5,20}]

FoldedCube

seq=Table[GraphData[{"FoldedCube",n},"UniquelyEmbeddable"],{n,2,10}]

Gear

seq=Table[GraphData[{"Gear",n},"UniquelyEmbeddable"],{n,3,20}]

Giraffe n×n

seq=Table[GraphData[{"Giraffe",{n,n}},"UniquelyEmbeddable"],{n,20}]

Goldberg

seq=Table[GraphData[{"Goldberg",n},"UniquelyEmbeddable"],{n,3,20}]

Grid n×n

Entity["Graph",{"Grid",{n,n}}]["UniquelyEmbeddable"]

Missing["UnknownProperty",{"Graph","UniquelyEmbeddable"}]

seq=Table[GraphData[{"Grid",{n,n}},"UniquelyEmbeddable"],{n,20}]

Grid m×n

Entity["Graph",{"Grid",{m,n}}]["UniquelyEmbeddable"]

Missing["UnknownProperty",{"Graph","UniquelyEmbeddable"}]

Sort@DeleteCases[Flatten[Table[{
{m,n},
GraphData[{"Grid",{m,n}},"UniquelyEmbeddable"],
Piecewise[{{False, Min[m, n] == 2 && Max[m, n] > 3}}, True]
},{n,10},{m,n}],1],{_,x_,x_}]

Grid n×n×n

Entity["Graph",{"Grid",{n,n,n}}]["UniquelyEmbeddable"]

Missing["UnknownProperty",{"Graph","UniquelyEmbeddable"}]

seq=Table[GraphData[{"Grid",{n,n,n}},"UniquelyEmbeddable"],{n,10}]

Grid k×m×n

Entity["Graph",{"Grid",{k,m,n}}]["UniquelyEmbeddable"]

Missing["UnknownProperty",{"Graph","UniquelyEmbeddable"}]

Sort@DeleteCases[Flatten[Table[{
{k,m,n},
GraphData[{"Grid",{k,m,n}},"UniquelyEmbeddable"],
XXX
},{n,5},{m,n},{k,m}],2],{_,x_,x_}]

HalvedCube

seq=Table[GraphData[{"HalvedCube",n},"UniquelyEmbeddable"],{n,10}]

Hanoi

seq=Table[GraphData[{"Hanoi",n},"UniquelyEmbeddable"],{n,6}]

Helm

seq=Table[GraphData[{"Helm",n},"UniquelyEmbeddable"],{n,3,20}]

Hypercube

Entity["Graph",{"Hypercube",n}]["UniquelyEmbeddable"]

Missing["UnknownProperty",{"Graph","UniquelyEmbeddable"}]

seq=Table[GraphData[{"Hypercube",n},"UniquelyEmbeddable"],{n,0,10}]

Keller

Entity["Graph",{"Keller",n}]["UniquelyEmbeddable"]

Missing["UnknownProperty",{"Graph","UniquelyEmbeddable"}]

seq=Table[GraphData[{"Keller",n},"UniquelyEmbeddable"],{n,5}]

King n×n

seq=Table[GraphData[{"King",{n,n}},"UniquelyEmbeddable"],{n,20}]

King m×n

Entity["Graph",{"King",{m,n}}]["UniquelyEmbeddable"]

DeleteCases[Flatten[Table[{
{m,n},
GraphData[{"King",{m,n}},"UniquelyEmbeddable"],
XXX
},{n,10},{m,n}],1],{_,x_,x_}]

Knight n×n

Entity["Graph",{"Knight",{n,n}}]["UniquelyEmbeddable"]

Missing["UnknownProperty",{"Graph","UniquelyEmbeddable"}]

seq=Table[GraphData[{"Knight",{n,n}},"UniquelyEmbeddable"],{n,20}]

Knight m×n

Entity["Graph",{"Knight",{m,n}}]["UniquelyEmbeddable"]

Missing["UnknownProperty",{"Graph","UniquelyEmbeddable"}]

DeleteCases[Flatten[Table[{
{m,n},
GraphData[{"Knight",{m,n}},"UniquelyEmbeddable"],
XXX
},{n,10},{m,n}],1],{_,x_,x_}]

Ladder

Entity["Graph",{"Ladder",n}]["UniquelyEmbeddable"]

Missing["UnknownProperty",{"Graph","UniquelyEmbeddable"}]

seq=Table[GraphData[{"Ladder",n},"UniquelyEmbeddable"],{n,20}]

LadderRung

seq=Table[GraphData[{"LadderRung",n},"UniquelyEmbeddable"],{n,20}]

LindgrenSousselier

seq=Table[GraphData[{"LindgrenSousselier",n},"UniquelyEmbeddable"],{n,11}]

LucasCube

seq=Table[GraphData[{"LucasCube",n},"UniquelyEmbeddable"],{n,15}]

MengerSponge

seq=Table[GraphData[{"MengerSponge",n},"UniquelyEmbeddable"],{n,3}]

MoebiusLadder

Entity["Graph",{"MoebiusLadder",n}]["UniquelyEmbeddable"]

Missing["UnknownProperty",{"Graph","UniquelyEmbeddable"}]

seq=Table[GraphData[{"MoebiusLadder",n},"UniquelyEmbeddable"],{n,3,25}]

Mycielski

Entity["Graph",{"Mycielski",n}]["UniquelyEmbeddable"]

Missing["UnknownProperty",{"Graph","UniquelyEmbeddable"}]

seq=Table[GraphData[{"Mycielski",n},"UniquelyEmbeddable"],{n,11}]

Odd

Entity["Graph",{"Odd",n}]["UniquelyEmbeddable"]

Missing["UnknownProperty",{"Graph","UniquelyEmbeddable"}]

seq=Table[GraphData[{"Odd",n},"UniquelyEmbeddable"],{n,7}]

Pan

seq=Table[GraphData[{"Pan",n},"UniquelyEmbeddable"],{n,3,20}]

Path

Entity["Graph",{"Path",n}]["UniquelyEmbeddable"]

Missing["UnknownProperty",{"Graph","UniquelyEmbeddable"}]

seq=Table[GraphData[{"Path",n},"UniquelyEmbeddable"],{n,20}]

PathComplement

seq=Table[GraphData[{"PathComplement",n},"UniquelyEmbeddable"],{n,20}]

Pell

seq=Table[GraphData[{"Pell",n},"UniquelyEmbeddable"],{n,9}]

PlummerToft

seq=Table[GraphData[{"PlummerToft",n},"UniquelyEmbeddable"],{n,20}]

Prism

Entity["Graph",{"Prism",n}]["UniquelyEmbeddable"]

Missing["UnknownProperty",{"Graph","UniquelyEmbeddable"}]

seq=Table[GraphData[{"Prism",n},"UniquelyEmbeddable"],{n,3,25}]

Queen n×n

seq=Table[GraphData[{"Queen",{n,n}},"UniquelyEmbeddable"],{n,20}]

Rook n×n

seq=Table[GraphData[{"Rook",{n,n}},"UniquelyEmbeddable"],{n,20}]

RookComplement n×n

seq=Table[GraphData[{"RookComplement",{n,n}},"UniquelyEmbeddable"],{n,20}]

SierpinskiCarpet

seq=Table[GraphData[{"SierpinskiCarpet",n},"UniquelyEmbeddable"],{n,4}]

SierpinskiGasket

seq=Table[GraphData[{"SierpinskiGasket",n},"UniquelyEmbeddable"],{n,7}]

SierpinskiTetrahedron

seq=Table[GraphData[{"SierpinskiTetrahedron",n},"UniquelyEmbeddable"],{n,6}]

Spoke n×n

seq=Table[GraphData[{"Spoke",{n,n}},"UniquelyEmbeddable"],{n,5}]

StackedBook

seq=Table[GraphData[{"StackedBook",{n,n}},"UniquelyEmbeddable"],{n,10}]

StackedPrism

seq=Table[GraphData[{"StackedPrism",{n,n}},"UniquelyEmbeddable"],{n,3,5}]

Star

Entity["Graph",{"Star",n}]["UniquelyEmbeddable"]

Missing["UnknownProperty",{"Graph","UniquelyEmbeddable"}]

seq=Table[GraphData[{"Star",n},"UniquelyEmbeddable"],{n,25}]

Sun

seq=Table[GraphData[{"Sun",n},"UniquelyEmbeddable"],{n,3,20}]

Sunlet

seq=Table[GraphData[{"Sunlet",n},"UniquelyEmbeddable"],{n,3,20}]

Tetrahedral

seq=Table[GraphData[{"Tetrahedral",n},"UniquelyEmbeddable"],{n,6,10}]

TorusGrid n×n

seq=Table[GraphData[{"TorusGrid",{n,n}},"UniquelyEmbeddable"],{n,3,20}]

Transposition

Entity["Graph",{"Transposition",n}]["UniquelyEmbeddable"]

Missing["UnknownProperty",{"Graph","UniquelyEmbeddable"}]

seq=Table[GraphData[{"Transposition",n},"UniquelyEmbeddable"],{n,6}]

Trapezohedron

Entity["Graph",{"Trapezohedron",n}]["UniquelyEmbeddable"]

Missing["UnknownProperty",{"Graph","UniquelyEmbeddable"}]

seq=Table[GraphData[{"Trapezohedron",n},"UniquelyEmbeddable"],{n,3,20}]

Triangular

seq=Table[GraphData[{"Triangular",n},"UniquelyEmbeddable"],{n,2,20}]

TriangularGrid

seq=Table[GraphData[{"TriangularGrid",n},"UniquelyEmbeddable"],{n,0,20}]

TriangularHoneycombAcuteKnight

seq=Table[GraphData[{"TriangularHoneycombAcuteKnight",n},"UniquelyEmbeddable"],{n,20}]

TriangularHoneycombBishop

seq=Table[GraphData[{"TriangularHoneycombBishop",n},"UniquelyEmbeddable"],{n,20}]

TriangularHoneycombObtuseKnight

seq=Table[GraphData[{"TriangularHoneycombObtuseKnight",n},"UniquelyEmbeddable"],{n,20}]

TriangularHoneycombQueen

seq=Table[GraphData[{"TriangularHoneycombQueen",n},"UniquelyEmbeddable"],{n,20}]

TriangularHoneycombRook

seq=Table[GraphData[{"TriangularHoneycombRook",n},"UniquelyEmbeddable"],{n,20}]

TriangularSnake

seq=Table[GraphData[{"TriangularSnake",n},"UniquelyEmbeddable"],{n,1,20,2}]

Web

seq=Table[GraphData[{"Web",n},"UniquelyEmbeddable"],{n,3,20}]

Wheel

Entity["Graph",{"Wheel",n}]["UniquelyEmbeddable"]

Missing["UnknownProperty",{"Graph","UniquelyEmbeddable"}]

seq=Table[GraphData[{"Wheel",n},"UniquelyEmbeddable"],{n,4,20}]

WheelComplement

seq=Table[GraphData[{"WheelComplement",n},"UniquelyEmbeddable"],{n,4,20}]

WhiteBishop n×n

seq=Table[GraphData[{"WhiteBishop",{n,n}},"UniquelyEmbeddable"],{n,2,20}]

WhiteCamel n×n

seq=Table[GraphData[{"Bishop",{n,n}},"UniquelyEmbeddable"],{n,{5}}]

Zebra n×n

seq=Table[GraphData[{"Zebra",{n,n}},"UniquelyEmbeddable"],{n,20}]