Planar Graph

Author

Eric W. Weisstein
October 12, 2011

This notebook downloaded from http://www.ericweisstein.com.

For more information, see Eric's none entry http://www.ericweisstein.com.

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

Counts

Should be 1, 2, 4, 11, 33, 142, 822, 6966, 79853, ... (Sloane's A005470)

Length/@PlanarGraphs/@Range[9]

Combinatorica

Count[#,_?PlanarQ]&/@Graphs/@Range[9]//Timing

V9

Count[#,_?PlanarGraphQ]&/@Graphs/@Range[8]//Timing

Count[#,_?PlanarGraphQ]&/@Graphs/@Range[9]//Timing

Checks

V9

Monitor[If[PlanarGraphQ[GraphData[g=#]]=!=GraphData[#,"Planar"],Print[#]]&/@GraphData[All],g];//Timing

Graphs

Simple

V5.2

planar=Table[PlanarGraphs[n],{n,4}];

ShowGraphArray[Flatten[Partition[#,6,6,{1,1},{}]&/@planar,1],
VertexStyle->Disk[.13],
VertexColor->Red,
GraphicsSpacing->{.5,.4}]

V6

GraphicsGrid[MapIndexed[
GraphPlot[#1,Method->If[#2=={5,5},"RadialDrawing",Automatic]]&,Flatten[Partition[#,6,6,{1,1},{}]&/@PlanarGraphs/@Range[4],1],{2}],Spacings->100]

Connected

GraphicsGrid[MapIndexed[
GraphPlot[#1,Method->If[#2=={4,6},"RadialDrawing",Automatic]]&,Flatten[Partition[#,6,6,{1,1},{}]&/@PlanarConnectedGraphs/@Range[4],1],{2}],Spacings->100]

Planar graph vs. Planar embedding

GraphicsArray[GraphData["K4","AllImages"]]

Mathematica embedding

{“SelfComplementary”,{8,6}}

GraphData[g1={"SelfComplementary",{8,6}},"LabeledImage"]

ShowLabeledGraph@ChangeVertices[Graph[{"SelfComplementary",{8,6}}],emb2={{3/2,1/2},{1,0},{0,1},{2,1},{0,0},{2,0},{1,1},{1/2,1/2}}]

v=SetProperty[GraphData[{"SelfComplementary",{8,6}}],GraphLayout->"PlanarEmbedding"]//GraphEmbedding

GraphPlot[GraphData[{"SelfComplementary",{8,6}},"EdgeRules"],VertexCoordinateRules->Thread[Range[8]->v]]

g=;

//InputForm

{{0.,0.},{3.4747725887883014,1.1539514058147464},{1.748716051532036,1.8147251479804858},{6.930498128481894,-0.01332912604457448},{0.0049508182451254434,6.604029748433142},{3.508541521587746,3.445478434018094},{5.038183865772982,4.77743895804317},{6.890040150591921,6.665890494428966}}/6.890040150591921

ShowLabeledGraph@(g=Graph[List/@{{1,4},{4,8},{5,8},{1,5},{5,6},{4,6},{6,7},{7,8},{3,6},{1,3},{2,3},{2,4},{1,2},{5,7}},List/@(v={{0,0},{1/2,1/6},{1/4,1/4},{1,0},{0,1},{1/2,1/2},{3/4,3/4},{1,1}})])

Solve[y-0==((1/4-0)/(1/4-1))(x-1)&&x==1/2,y]

((1/4-0)/(1/4-1))

Solve[y==-(1/3)(x-1)&&x==(1/2),y]

Solve[y==-(1/3)(x-1)&&x==(1/2),{x,y}]

Reduce[y==-(1/3)(x-1)&&x==(1/2),y]

Solve[y==-(1/3)(1/2-1),y]

RecognizeGraph[g]

emb1=ToCommonEdges[g,Graph[g1]]

emb={emb1,emb2}

{“SelfComplementary”,{8,10}}

GraphData[g1={"SelfComplementary",{8,10}},"LabeledImage"]

GraphData[g1,"Image"]

ShowLabeledGraph@ChangeVertices[Graph[g1],emb2={{1,2/3},{0,2/3},{1/2,0},{1/2,1},{1,1/3},{0,1/3},{1/3,2/3},{2/3,1/3}}]

SetProperty[GraphData[g1],GraphLayout->"PlanarEmbedding"]

v=GraphEmbedding[%]

GraphPlot[GraphData[g1,"EdgeRules"],VertexCoordinateRules->Thread[Range[8]->v]]

g=;

g//InputForm

{{0.,0.},{7.,0.},{0.,7.},{2.150398785689415,2.13868819637883},{4.6922876044568245,2.0339593488857926},{4.620631310933147,4.488958587221449},{2.0741371431058497,4.5085714441155975},{6.985027855153203,6.965349712743732}}/6.965349712743732

ShowLabeledGraph@(g=Graph[List/@{{1,2},{2,8},{3,8},{1,3},{3,7},{6,7},{6,8},{2,5},{1,4},{7,8},{2,4},{4,7},{5,6},{4,5}},List/@(v={{0,0},{1,0},{0,1},{1/3,1/3},{2/3,1/3},{2/3,2/3},{1/3,2/3},{1,1}})])

RecognizeGraph[g]

emb1=ToCommonEdges[g,Graph[g1]]

emb={emb1,emb2}

Bug

Combinatorica V1 (for V4.0)

This graph is not actually planar!

PlanarQ[Graph[{{0,0,0,1,1,1},{0,0,0,1,1,1},{0,0,0,1,1,1},{1,1,1,0,1,1},{1,1,1,1,0,1},{1,1,1,1,1,0}},{{1.,0.},{0.5,0.8660254037844386},{-0.5,0.8660254037844386},{-1.,0.},{-0.5,-0.8660254037844386},{0.5,-0.8660254037844386}}]]

Fixed in 4.1

PlanarQ[Graph[{{0,0,0,1,1,1},{0,0,0,1,1,1},{0,0,0,1,1,1},{1,1,1,0,1,1},{1,1,1,1,0,1},{1,1,1,1,1,0}},{{1.,0.},{0.5,0.8660254037844386},{-0.5,0.8660254037844386},{-1.,0.},{-0.5,-0.8660254037844386},{0.5,-0.8660254037844386}}]]

Combinatorica 2

<<"/Volumes/Data/Mathematica/OtherPackages/Combinatorica/NewCombinatorica.m"

m={{0,0,0,1,1,1},{0,0,0,1,1,1},{0,0,0,1,1,1},{1,1,1,0,1,1},{1,1,1,1,0,1},{1,1,1,1,1,0}};

PlanarQ[FromAdjacencyMatrix[m]]

Planar with minimum valency k

Planar with minimum valency ≥ 2

Length/@(v2=Select[PlanarGraphs[#],Min[Degrees[#]]≥2&]&/@Range[9])//Timing

Off[General::"stop"]

ShowGraphArray[
Map[RecognizeGraph,
Flatten[Partition[#,5,5,{1,1},{}]&/@Take[v2,5],1],
{2}],
VertexStyle->Disk[.15]
]

Planar with minimum valency ≥ 3

Length/@(v3=Select[v2[[#]],Min[Degrees[#]]≥3&]&/@Range[9])//Timing

Off[General::"stop"]

ShowGraphArray[
Map[RecognizeGraph,
Flatten[Partition[#,5,5,{1,1},{}]&/@Take[v3,6],1],
{2}],
VertexStyle->Disk[.1]
]

Planar with minimum valency ≥ 4

Length/@(v4=Select[v3[[#]],Min[Degrees[#]]≥4&]&/@Range[9])//Timing

Off[General::"stop"]

ShowGraphArray[
Map[RecognizeGraph,
Flatten[Partition[#,7,7,{1,1},{}]&/@v4,1],
{2}],
VertexStyle->Disk[.1]
]

Planar with minimum valency ≥ 5

Length/@(v5=Select[v4[[#]],Min[Degrees[#]]≥5&]&/@Range[9])//Timing

GraphDataCountTable

GraphDataCountTable["Planar"]

Parametrized families

<<MathWorld`Graphs`

Alkane

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

AlternatingGroupGraph

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

Andrasfai

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

Antelope n×n

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

Antiprism

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

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

Apollonian

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

Barbell

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

BlackBishop n×n

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

Bishop n×n

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

Book

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

Bruhat

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

Camel n×n

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

Centipede

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

CocktailParty

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

Complete

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

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

CompleteBipartite n×n

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

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

CompleteBipartite m×n

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

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

CompleteTripartite n×n×n

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

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

CompleteTripartite k×m×n

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

DeleteCases[Flatten[Table[{
{k,m,n},
GraphData[{"CompleteTripartite",{k,m,n}},"Planar"],
3Max[k,m,n]/2
},{n,10},{m,n},{k,m}],2],{_,x_,x_}]

CrossedPrism

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

Crown

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

CubeConnectedCycle

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

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

Cycle

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

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

CycleComplement

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

DiagonalIntersection

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

Dipyramid

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

DorogovtsevGoltsevMendes

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

DoubleCone

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

Empty

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

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

FibonacciCube

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

Fiveleaper n×n

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

Flower

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

FoldedCube

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

Gear

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

Giraffe n×n

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

Goldberg

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

Grid n×n

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

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

Grid m×n

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

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

Grid n×n×n

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

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

Grid k×m×n

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

Sort@Flatten[Table[{
{k,m,n},
GraphData[{"Grid",{k,m,n}},"Planar"],
XXX
},{n,5},{m,n},{k,m}],2]

HalvedCube

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

Hanoi

seq=Table[GraphData[{"Hanoi",n},"Planar"],{n,5}]

Helm

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

Hypercube

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

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

Keller

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

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

King n×n

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

King m×n

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

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

Knight n×n

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

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

Knight m×n

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

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

Ladder

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

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

LadderRung

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

LucasCube

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

MengerSponge

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

MoebiusLadder

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

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

Mycielski

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

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

Odd

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

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

Pan

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

Path

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

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

PathComplement

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

Pell

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

Prism

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

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

Queen n×n

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

Rook n×n

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

RookComplement n×n

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

SierpinskiCarpet

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

SierpinskiGasket

seq=Table[GraphData[{"SierpinskiGasket",n},"Planar"],{n,5}]

SierpinskiTetrahedron

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

Spoke n×n

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

StackedBook

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

StackedPrism

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

Star

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

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

Sun

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

Sunlet

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

TorusGrid n×n

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

Transposition

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

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

Trapezohedron

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

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

Triangular

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

TriangularGrid

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

TriangularHoneycombAcuteKnight

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

TriangularHoneycombBishop

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

TriangularHoneycombObtuseKnight

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

TriangularHoneycombQueen

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

TriangularHoneycombRook

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

TriangularSnake

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

Web

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

Wheel

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

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

WheelComplement

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

WhiteBishop n×n

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

Zebra n×n

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