Projective Planar Graph

Author

Eric W. Weisstein
March 24, 2023

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

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

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

Counts

Connected

Length/@Table[GraphData[{"Connected","ProjectivePlanar"},n],{n,7}]

All

Length/@Table[GraphData["ProjectivePlanar",n],{n,7}]

Known

By vertex count

TextGrid[Table[{n,Select[GraphData["ProjectivePlanar",n],GraphData[#,"CrossingNumber"]>1&]},{n,15}],Dividers->All]

Missing

Select[GraphData["Connected",6],MissingQ[GraphData[#,"ProjectivePlanar"]]&]

Select[GraphData["Connected",7],MissingQ[GraphData[#,"ProjectivePlanar"]]&]

Select[GraphData["Connected",8],MissingQ[GraphData[#,"ProjectivePlanar"]]&]

Select[GraphData["Connected",9],MissingQ[GraphData[#,"ProjectivePlanar"]]&]

Select[GraphData["Connected",10],MissingQ[GraphData[#,"ProjectivePlanar"]]&]

Take[SortBy[Select[GraphData["Connected"],MissingQ[GraphData[#,"ProjectivePlanar"]]&],GraphData[#,"V"]&],UpTo[200]]

Special cases

Duals on the projective plane

K_6 can be  triangulated both on the projective plane and Klein bottle, so its dual is ambiguous (Petersen or Franklin) unless the surface is specified.

((Subscript[K, 6]), P)

ProjectivePlanarGraphQ[GraphData["K6"],Debug->True]

ProjectivePlanarGraphQ[GraphData["PetersenGraph"],Debug->True]

Forbidden

ProjectivePlanarGraphQ[GraphData["2K5"],Debug->True]

ProjectivePlanarGraphQ[GraphData["K3,5"],Debug->True]

GraphDataCountTable

<<MathWorld`Graphs`

GraphDataCountTable["ProjectivePlanar"]

Parametrized families

Alkane

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

AlternatingGroupGraph

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

Andrasfai

Inferred for n > 4:

seq=Table[GraphData[{"Andrasfai",n},"ProjectivePlanar"],{n,10}]

Antelope n×n

seq=Table[GraphData[{"Antelope",{n,n}},"ProjectivePlanar"],{n,15}]

Antiprism

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

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

Apollonian

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

Barbell

Inferred for n > 9:

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

Do[Print[{GraphData[gn={"Barbell",n},"#"],ProjectivePlanarGraphQ[GraphData[gn]]//Timing}],{n,3,10}]

BlackBishop n×n

Inferred for n > 5:

seq=Table[GraphData[{"BlackBishop",{n,n}},"ProjectivePlanar"],{n,10}]

Do[Print[{GraphData[gn={"BlackBishop",{n,n}},"#"],ProjectivePlanarGraphQ[GraphData[gn]]//Timing}],{n,10}]

Bishop n×n

seq=Table[GraphData[{"Bishop",{n,n}},"ProjectivePlanar"],{n,10}]

Do[Print[{GraphData[gn={"Bishop",{n,n}},"#"],ProjectivePlanarGraphQ[GraphData[gn]]//Timing}],{n,5}]

Book

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

Bruhat

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

Camel n×n

seq=Table[GraphData[{"Camel",{n,n}},"ProjectivePlanar"],{n,10}]

Centipede

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

CocktailParty

Inferred for n > 6:

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

Complete

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

Inferred for n > 17:

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

Do[Print[{GraphData[gn={"Complete",n},"#"],ProjectivePlanarGraphQ[GraphData[gn]]//Timing}],{n,17}]

CompleteBipartite m×n

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

TextGrid[{#[[1,1]],#[[All,2]]}&/@SplitBy[Cases[Sort[{GraphData[#,"NotationRules","CompleteBipartite"],GraphData[#,"ProjectivePlanar"]}&/@GraphData["CompleteBipartite"]],{gn_,True}:>gn],First],Dividers->All]

Table[GraphData[{"CompleteBipartite", {3,n}},"ProjectivePlanar"],{n,3,20}]

Table[GraphData[{"CompleteBipartite", {4,n}},"ProjectivePlanar"],{n,4,20}]

DeleteCases[Sort@Flatten[Table[{
{m,n},
GraphData[{"CompleteBipartite",{m,n}},"ProjectivePlanar"],
Piecewise[{{True,Min[m,n]<3||(Min[m,n]==3&&Max[m,n]≤4)}},False]
},{n,20},{m,n}],1],{_,x_,x_}]

CompleteBipartite n×n

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

Inferred for n > 8:

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

Do[Print[{gn=GraphData[{"CompleteBipartite",{n,n}},"#"],ProjectivePlanarGraphQ[GraphData[gn]]//Timing}],{n,9}]

CompleteTripartite k×m×n

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

Cases[Sort[{GraphData[#,"NotationRules","CompleteTripartite"],GraphData[#,"ProjectivePlanar"]}&/@GraphData["CompleteTripartite"]],{gn_,True}:>gn]

Cases[Sort[{GraphData[#,"NotationRules","CompleteTripartite"],GraphData[#,"ProjectivePlanar"]}&/@GraphData["CompleteTripartite"]],{gn_,False}:>gn]

CompleteTripartite n×n×n

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

Inferred for n > 4:

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

CrossedPrism

seq=Table[GraphData[{"CrossedPrism",2n},"ProjectivePlanar"],{n,2,10}]

Crown

Inferred for n > 7:

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

Do[Print[{gn=GraphData[{"Crown",n},"#"],ProjectivePlanarGraphQ[GraphData[gn]]//Timing}],{n,7}]

CubeConnectedCycle

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

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

Cycle

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

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

CycleComplement

Inferred for n > 10:

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

DiagonalIntersection

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

Dipyramid

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

DoubleCone

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

Empty

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

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

FibonacciCube

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

Flower

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

FoldedCube

Fillin for n > 4:

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

Gear

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

Giraffe n×n

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

Goldberg

seq=Table[GraphData[{"Goldberg",n},"ProjectivePlanar"],{n,3,10}]

Grid m×n

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

Table[GraphData[{"Grid",{m,n}},"ProjectivePlanar"],{n,10},{m,n}]//Flatten//Union

Grid n×n

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

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

Grid k×m×n

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

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

Tally[GraphData[{"Grid",{2,3,4}},"DistanceMatrix"]//Normal//Flatten]

Grid n×n×n

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

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

HalvedCube

Inferred for n > 4:

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

Hanoi

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

Helm

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

Hypercube

Inferred for n > 4:

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

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

Do[Print[{GraphData[gn={"Hypercube",n},"#"],ProjectivePlanarGraphQ[GraphData[gn]]//Timing}],{n,0,5}]

Keller

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

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

King n×n

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

Knight m×n

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

Knight n×n

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

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

Ladder

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

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

LadderRung

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

MengerSponge

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

MoebiusLadder

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

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

Mycielski

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

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

Odd

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

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

Pan

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

Path

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

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

PathComplement

Inferred for n > 10:

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

Prism

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

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

Queen n×n

Inferred for n > 3:

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

Rook n×n

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

RookComplement n×n

seq=Table[GraphData[{"RookComplement",{n,n}},"ProjectivePlanar"],{n,10}]

SierpinskiCarpet

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

SierpinskiGasket

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

SierpinskiTetrahedron

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

Spoke n×n

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

StackedBook

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

StackedPrism

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

Star

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

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

Sun

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

Sunlet

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

TorusGrid n×n

seq=Table[GraphData[{"TorusGrid",{n,n}},"ProjectivePlanar"],{n,3,10}]

Transposition

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

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

Trapezohedron

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

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

Triangular

Inferred for n > 5:

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

TriangularGrid

seq=Table[GraphData[{"TriangularGrid",n},"ProjectivePlanar"],{n,0,10}]

TriangularHoneycombAcuteKnight

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

TriangularHoneycombBishop

seq=Table[GraphData[{"TriangularHoneycombBishop",n},"ProjectivePlanar"],{n,9}]

TriangularHoneycombObtuseKnight

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

TriangularHoneycombQueen

Inferred for n > 4:

seq=Table[GraphData[{"TriangularHoneycombQueen",n},"ProjectivePlanar"],{n,10}]

TriangularHoneycombRook

seq=Table[GraphData[{"TriangularHoneycombRook",n},"ProjectivePlanar"],{n,10}]

TriangularSnake

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

Web

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

Wheel

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

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

WheelComplement

Inferred for n > 12:

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

Do[Print[{GraphData[gn={"WheelComplement",n},"#"],ProjectivePlanarGraphQ[GraphData[gn]]//Timing}],{n,4,12}]

WhiteBishop n×n

Inferred for n > 5:

seq=Table[GraphData[{"WhiteBishop",{n,n}},"ProjectivePlanar"],{n,2,10}]

Do[Print[{GraphData[gn={"WhiteBishop",{n,n}},"#"],ProjectivePlanarGraphQ[GraphData[gn]]//Timing}],{n,2,5}]

Zebra n×n

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

Checks

ForbiddenHomeomorphicSubgraphs

Not yet implemented because there is no built-in HomeomorphicSubgraphQ functionality

(bad=DeleteCases[Monitor[{
gn=#,
GraphData[#,"ProjectivePlanar"],
ProjectivePlanarGraphQ[GraphData[#],Method->"ForbiddenHomeomorphicSubgraphs"]
}&/@GraphData[;;7],gn],
{_,x_,x_}])//Timing

ProjectivePlanarGraphQ[CompleteGraph[7],Method->"ForbiddenHomeomorphicSubgraphs"]

ProjectivePlanarGraphQ[CompleteGraph[7],Method->"ForbiddenMinors"]

IGraphM`IGHomeomorphicQ[GraphData[#],CompleteGraph[7]]&/@GraphData["ProjectivePlanarForbiddenSubgraph"]

Union[%]

(bad=DeleteCases[Monitor[{
gn=#,
GraphData[#,"ProjectivePlanar"],
ProjectivePlanarGraphQ[GraphData[#],Method->"ForbiddenSubgraphs"]
}&/@GraphData[;;12],gn],
{_,x_,x_}])//Timing

DeleteCases[bad,{_,_Missing,_}]

Select[%10[[All,1]],!MissingQ[GraphData[#,"MinorCount"]]&]

ProjectivePlanarGraphQ[GraphData[{"Cubic",{12,42}}],Debug->True,Method->"ForbiddenMinors"]//Timing

GraphData[{"Cubic",{12,42}}]

forbidden=GraphData[#,"CanonicalGraph"]&/@GraphData["ProjectivePlanarForbiddenHomeomorphicSubgraph"];

g=GraphData[{"Cubic",{12,42}}];

AnyTrue[forbidden,IsomorphicSubgraphQ[#,g]&]

forbidden1=Union[Flatten[GraphSubdivisions[#,1]&/@forbidden]]

Length[forbidden1]

AnyTrue[forbidden1,IsomorphicSubgraphQ[#,g]&]

Length[forbidden2=Union[Flatten[GraphSubdivisions[#,1]&/@forbidden1]]]//Timing

exc=SelectFirst[forbidden2,IsomorphicSubgraphQ[#,g]&]

Do[Print[{i,SelectFirst[GraphSubdivisions[forbidden[[i]],1],IsomorphicSubgraphQ[#,g]&]//Timing}],{i,103}];

Do[Print[{i,SelectFirst[GraphSubdivisions[forbidden[[i]],2],IsomorphicSubgraphQ[#,g]&]//Timing}],{i,103}];

Do[Print[{i,SelectFirst[GraphSubdivisions[forbidden[[i]],3],IsomorphicSubgraphQ[#,GraphData[{"Quintic",{10,57}}]]&]//Timing}],{i,103}];

Do[Print[{i,SelectFirst[GraphSubdivisions[forbidden[[i]],4],IsomorphicSubgraphQ[#,GraphData[{"Quintic",{10,57}}]]&]//Timing}],{i,103}];

l={#,{0,#3}}&@@@bad

ForbiddenMinors

(bad=DeleteCases[Monitor[{
gn=#,
GraphData[#,"ProjectivePlanar"],
ProjectivePlanarGraphQ[GraphData[#]]
}&/@GraphData[;;8],gn],
{_,x_,x_}])//Timing

(bad=DeleteCases[Monitor[{
gn=#,
GraphData[#,"ProjectivePlanar"],
ProjectivePlanarGraphQ[GraphData[#]]
}&/@GraphData[9],gn],
{_,x_,x_}])//Timing

l={#,{0,#3}}&@@@Select[bad,FreeQ[$Aborted]]

Check for differing status between graph and cc

data=Function[g,{g,GraphData[g,"ProjectivePlanar"],GraphData[#,"ProjectivePlanar"]&/@GraphData[g,"ConnectedComponents","Name"]}]/@GraphData["Disconnected"]

Select[data,{_,False,{True..}}]

Select[data,{_,True,{False..}}]

DeleteCases[data,{_,True,{True..}}]

8-node

{{{8,5519},False,{True,True}},{{8,5527},False,{True,True}},{{8,8950},False,{True,True}},{{8,8952},False,{True,True}},{{8,8953},False,{True,True}},{{8,9881},False,{True,True}},{{8,10354},False,{False,True}},{{8,11481},False,{True,True}},{{8,11486},False,{False,True}},{{8,11566},False,{False,True}}}[[All,1]]

Print[{#,ProjectivePlanarGraphQ[GraphData[#]]//Timing}]&/@%

2K3,3

g=GraphData["2K3,3","Graph"]

ProjectivePlanarGraphQ[g,Debug->True]//Timing

GraphData["2K3,3","ConnectedComponents","Name"]

ProjectivePlanarGraphQ[GraphData["UtilityGraph"],Debug->True]//Timing

{8, 5519}

g=GraphData[{8,5519},"Graph"]

ProjectivePlanarGraphQ[g,Debug->True]//Timing

GraphData[{8,5519},"ConnectedComponents","Name"]

ProjectivePlanarGraphQ[GraphData["SingletonGraph"],Debug->True]//Timing

ProjectivePlanarGraphQ[GraphData[{7,906}],Debug->True]//Timing