Graph Genus

Author

Eric W. Weisstein
December 8, 2023

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

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

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

Counts

Toroidal

toroidal=SortBy[GraphData[{"Connected","Toroidal"}],GraphData[#,"V"]&]

DoubleToroidal

doubletoroidal=SortBy[GraphData[{"Connected","DoubleToroidal"}],GraphData[#,"V"]&]

Print[{#,If[FreeQ[res=GraphGenus[GraphData[#],Method->"Sage",TimeConstraint->30],Failure],res,$Failed]//AbsoluteTiming}]&/@doubletoroidal

Pretzel

pretzel=SplitBy[Sort[GraphData[#,{"V","#"}]&/@GraphData[{"Connected","Pretzel"}]],First]

TextGrid[{#[[1,1]],#[[All,2]]}&/@pretzel,Dividers->All]

Genus counts

Connected Counts

Table[Count[PlanarGraphQ/@ConnectedGraphs[n],True],{n,8}]

genus=Table[GraphGenus/@ConnectedGraphs[n],{n,8}];//Timing

Planar:

Count[#,0]&/@genus

Toroidal:

A319115

Count[#,1]&/@genus

Double-toroidal:

Count[#,2]&/@genus

Simple Counts

Table[Count[PlanarGraphQ/@Graphs[n],True],{n,8}]

genus=Table[GraphGenus/@Graphs[n],{n,8}];//Timing

Planar:

Count[#,0]&/@genus

Toroidal:

A319114

Count[#,1]&/@genus

Double-toroidal:

Count[#,2]&/@genus

doubletoroidal=Position[genus,2]

RecognizeGraph[GraphData[#]]&/@doubletoroidal

GraphData

<<MathWorld`Graphs`

file=OpenWrite["~/doubletroidal.m"]

MapIndexed[WriteString[file,GraphDataString[Graphs[8][[#[[2]]]],
"StandardName"->{"DoubleToroidal",{8,#2[[1]]}},
"Name"->"8\[Hyphen]double\[Hyphen]toroidal graph "<>ToString[#2[[1]]],
"Embeddings"->None,
"Skip"->{"DistinguishingNumber","EdgeCovers"}
]]&,Drop[doubletoroidal,-4]]

Close[file]

Compute

Do[Print[{n,Length@ConnectedGraphs[n]//Timing}],{n,9}]

Connected

SetDirectory["/Users/eww/Documents/Mathematica/Paclets/GraphData/Nodes/Genus"]

Do[
Print[{n,Tally[Sort[genera=GraphGenus/@ConnectedGraphs[n]]]//Timing}];
Put[genera,"Genus_Connected_"<>ToString[n]<>".m"],
{n,9}]

Disconnected

Toroidal

Length/@Table[GraphData[{"Disconnected","Toroidal"},n],{n,8}]

n=6

GraphData[{"Disconnected","Toroidal"},6]

n=7

tor7=GraphData[{"Disconnected","Toroidal"},7]

TextGrid[{#,GraphData[#,"Genus"],cc=GraphData[#,"ConnectedComponents","Name"],GraphData[#,"Genus"]&/@cc}&/@tor7,Dividers->All]

n=8

tor8=GraphData[{"Disconnected","Toroidal"},8]

TextGrid[{#,GraphData[#,"Genus"],cc=GraphData[#,"ConnectedComponents","Name"],GraphData[#,"Genus"]&/@cc}&/@tor8,Dividers->All]

n>8

GraphData[{"Disconnected","Toroidal"},9;;]

DoubleToroidal

Length/@Table[GraphData[{"Disconnected","DoubleToroidal"},n],{n,9}]

Pretzel

Length/@Table[GraphData[{"Disconnected","Pretzel"},n],{n,9}]

GraphDataCountTable

GraphDataCountTable["Genus",{"CocktailParty"->000212,"Complete"->000933,"CompleteBipartite"->004652,"CompleteTripartite"->000217,"CrossedPrism"->057427,"Hypercube"->000337,"MoebiusLadder"->000012}]

Parametrized families

<<MathWorld`Graphs`

Andrasfai

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

Antelope m×n

DeleteCases[Sort[Flatten[Table[{{m,n},XXX,GraphData[{"Antelope",{m,n}},"Genus"]},{n,2,10},{m,2,n}],1]],{_,x_,x_}]

Antelope n×n

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

Antiprism

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

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

Apollonian

seq=Table[GraphData[{"Apollonian",n},"Genus"],{n,6}]

BananaTree

Block[{m,n},DeleteCases[{#,{m,n}="BananaTree"/.GraphData[#,"NotationRules"];0,GraphData[#,"Genus"]}&/@GraphData["BananaTree"],{_,x_,x_}]]

Barbell

2 γ((Subscript[K, n]))

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

Table[2Ceiling[(1/12) (n-3) (n-4)],{n,3,20}]

Bishop n×n

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

BlackBishop n×n

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

Book

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

Bruhat

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

Centipede

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

CocktailParty

White 2001

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

Complete

A000933

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

seq=Table[GraphData[{"Complete",n},"Genus"],{n,20}]

FindGeneratingFunction[seq,x]

seq=Table[Ceiling[(n-3)(n-4)/12],{n,20}]

FindLinearRecurrence[seq]

CompleteBipartite m×n

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

seq=Table[GraphData[{"CompleteBipartite",{m,n}},"Genus"],{n,20},{m,n}]//Column//TraditionalForm

Table[Piecewise[{{0,Min[m,n]==1}},Ceiling[(m-2)(n-2)/4]],{n,20},{m,n}]//Column

CompleteBipartite n×n

A004652

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

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

Table[Ceiling[(((n-2))^2)/4],{n,20}]

seq=Table[Ceiling[(n^2)/4],{n,0,20}]

Ceiling[((Range[0,20])^2)/4]

FindLinearRecurrence[seq]

LinearRecurrence[{2,0,-2,1},{1,1,3,4},{0,20}]

CompleteTripartite k×m×n

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

seq=Table[{GraphData[{"CompleteTripartite",{k,m,n}},"Genus"],XXX},{n,10},{m,n},{k,m}]

CompleteTripartite n×n×n

A000217

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

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

Table[Binomial[n-1,2],{n,10}]

CrossedPrism

Inferred for n > 20:

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

Do[Print[{{"CrossedPrism",2n},GraphGenus[GraphData[{"CrossedPrism",2n}]]//AbsoluteTiming}],{n,2,12}]

Crown

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

CubeConnectedCycle

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

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

Cycle

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

seq=Table[GraphData[{"Cycle",n},"Genus"],{n,3,20}]

CycleComplement

Inferred for n > 9:

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

Do[Print[{{"CycleComplement",n},GraphGenus[GraphData[{"CycleComplement",n}]]//AbsoluteTiming}],{n,3,20}]

DiagonalIntersection

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

PlanarGraphQ/@Table[GraphData[{"DiagonalIntersection",n}],{n,3,14}]

Dipyramid

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

DoubleCone

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

Empty

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

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

FibonacciCube

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

Fiveleaper m×n

DeleteCases[Sort[Flatten[Table[{{m,n},0,GraphData[{"Fiveleaper",{m,n}},"Genus"]},{n,10},{m,n}],1]],{_,x_,x_}]

Fiveleaper n×n

seq=Table[GraphData[{"Fiveleaper",{n,n}},"Genus"],{n,10}]

FoldedCube

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

Gear

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

Grid m×n

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

Table[GraphData[{"Grid",{m,n}},"Genus"],{n,10},{m,n}]//Column

Grid n×n

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

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

Grid k×m×n

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

seq=Table[GraphData[{"Grid",{n,n,n}},"Genus"],{n,10},{m,n},{k,m}]

Grid n×n×n

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

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

HalvedCube

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

Hanoi

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

Helm

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

HexagonalGrid n×n×n

seq=Table[GraphData[{"HexagonalGrid",{n,n,n}},"Genus"],{n,5}]

Hypercube

A000337

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

Table[1+(n-4)2^(n-3),{n,0,10}]

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

Keller

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

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

King m×n

Table[GraphData[{"King",{m,n}},"Genus"],{n,10},{m,n}]//Column

King n×n

seq=Table[GraphData[{"King",{n,n}},"Genus"],{n,10}]

Knight m×n

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

(seq=Table[GraphData[{"Knight",{m,n}},"Genus"],{n,10},{m,n}])//Column

Knight n×n

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

seq=Table[GraphData[{"Knight",{n,n}},"Genus"],{n,10}]

Ladder

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

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

LadderRung

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

MengerSponge

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

MoebiusLadder

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

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

Mycielski

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

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

Odd

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

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

Pan

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

Path

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

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

PathComplement

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

Do[Print[{{"PathComplement",n},GraphGenus[GraphData[{"PathComplement",n}]]//AbsoluteTiming}],{n,20}]

Prism

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

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

Queen m×n

DeleteCases[Sort[Flatten[Table[{
{m,n},
XXX,
GraphData[{"Queen",{m,n}},"Genus"]},{n,10},{m,n}],1]],{_,x_,x_}]

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

Queen n×n

seq=Table[GraphData[{"Queen",{n,n}},"Genus"],{n,10}]

Rook 2×n

White 2001, p. 59

seq=Table[GraphData[{"Rook",Sort[{2,n}]},"Genus"],{n,10}]

Table[Piecewise[{{0,n==1},{Ceiling[(n-2)(n-3)/6],Mod[n,12]≠5&&Max[n,12]≠9}},XXX],{n,20}]

Rook m×n

DeleteCases[Sort[Flatten[Table[{{m,n},XXX,GraphData[{"Rook",{m,n}},"Genus"]},{n,10},{m,n}],1]],{_,x_,x_}]

Rook n×n

seq=Table[GraphData[{"Rook",{n,n}},"Genus"],{n,10}]

RookComplement m×n

DeleteCases[Sort[Flatten[Table[{{m,n},Piecewise[{{0,Min[m,n]==1||(Min[m,n]==2&&Max[m,n]<5)},{1,Min[m,n]==3&&Max[m,n]<5}},XXX],GraphData[{"RookComplement",{m,n}},"Genus"]},{n,10},{m,n}],1]],{_,x_,x_}]

RookComplement n×n

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

SierpinskiCarpet

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

SierpinskiSieve

seq=Table[GraphData[{"SierpinskiSieve",n},"Genus"],{n,5}]

SierpinskiTetrahedron

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

StackedBook n×n

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

StackedPrism n×n

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

Star

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

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

Sun

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

Sunlet

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

Tetrahedral

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

TorusGrid m×n

Table[GraphData[{"TorusGrid",{m,n}},"Genus"],{n,3,10},{m,3,n}]//Column

TorusGrid n×n

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

Do[Print[{gn={"TorusGrid",{n,n}},GraphGenus[GraphData[gn],TimeConstraint->10]//AbsoluteTiming}],{n,3,5}]

Trapezohedron

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

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

Transposition

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

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

Triangular

seq=Table[GraphData[{"Triangular",n},"Genus"],{n,2,10}]

TriangularGrid

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

TriangularHoneycombAcuteKnight

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

TriangularHoneycombBishop

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

TriangularHoneycombKing

seq=Table[GraphData[{"TriangularHoneycombKing",n},"Genus"],{n,11}]

TriangularHoneycombQueen

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

TriangularHoneycombRook

sum of (Subscript[K, n]) genera

Table[GraphData[{"TriangularHoneycombRook",n},"ConnectedComponents","Name"],{n,10}]//Column

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

Sum[Piecewise[{{0,k == 1 ||k == 2}}, Ceiling[(k-4)(k-3)/12]],{k,n}]//Head//Timing

Table[Sum[Piecewise[{{0,k == 1 ||k == 2}}, Ceiling[(1/12)*(-4 + k)*(-3 + k)]],{k,n}],{n,20}]

TriangularSnake

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

Transposition

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

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

Web

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

Wheel

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

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

WheelComplement

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

Do[Print[{{"WheelComplement",n},GraphGenus[GraphData[{"WheelComplement",n}]]//AbsoluteTiming}],{n,4,20}]

WhiteBishop m×n

DeleteCases[Sort[Flatten[Table[{{m,n},XXX,GraphData[{"WhiteBishop",{m,n}},"Genus"]},{n,2,10},{m,2,n}],1]],{_,x_,x_}]

WhiteBishop n×n

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

Complete bipartite

Grid[data={#[[1,2]],#[[All,1]]}&/@SplitBy[SortBy[Flatten[Table[{{m,n},Ceiling[(m-2)(n-2)/4]},{n,2,20},{m,2,n}],1],Last],Last],Dividers->All,Alignment->Left]

Planar

FirstCase[data,{0,c_}:>c]

Toroidal

toroidal=FirstCase[data,{1,c_}:>c]

GraphData[{"CompleteBipartite",#},"Genus"]&/@toroidal

GraphData[{"CompleteBipartite",#},"Toroidal"]&/@toroidal

GraphData[{"CompleteBipartite",#},"Sextic"]&/@toroidal

Algorithms

SortBy[GraphData["Pretzel"],GraphData[#,"V"]&]

doubletoroidal=GraphData["DoubleToroidal"]

forbidden=GraphData[{"DoubleToroidal",{8,#}}]&/@{1,11,2}

Function[g,AnyTrue[forbidden,IsomorphicSubgraphQ[#,g]&]]/@doubletoroidal

Function[g,AnyTrue[forbidden,IsomorphicSubgraphQ[#,g]&]]@GraphData[{"Quartic",{10,7}}]

Function[g,AnyTrue[forbidden,IsomorphicSubgraphQ[#,g]&]]@GraphData[{"Quartic",{10,6}}]

Function[g,AnyTrue[forbidden,IsomorphicSubgraphQ[#,g]&]]@GraphData[{"CocktailParty",5}]

Duke & Haggard IsomorphicSubgraphQ

(bad=DeleteCases[Monitor[{
gn=#,
GraphData[#,"Genus"],
GraphGenus[GraphData[#],Method->"DukeHaggardIsomorphicSubgraph"]
}&/@GraphData[;;8],gn],
{_,x_,x_}])//Timing

(bad=DeleteCases[Monitor[{
gn=#,
GraphData[#,"Genus"],
GraphGenus[GraphData[#],Method->"DukeHaggardIsomorphicSubgraph"]
}&/@GraphData[9],gn],
{_,x_,x_}|{_,_Missing,$Failed}])//Timing

Cases[bad,{_,_,_Integer}]

genus1=Cases[bad,{gn_,1,$Failed}:>gn]

Print[{#,GraphGenus[GraphData[#],Method->"Sage"]//AbsoluteTiming}]&/@genus1

ToroidalGraphQ[GraphData@{"Circulant",{9,{1,3}}}]

Cases[bad,{gn_,2,$Failed}:>gn]

Cases[bad,{gn_,3,$Failed}:>gn]

Duke & Haggard EdgeInducedSubgraphFreeQ

(bad=DeleteCases[Monitor[{
gn=#,
GraphData[#,"Genus"],
GraphGenus[GraphData[#],Method->"DukeHaggardInducedSubgraph"]
}&/@GraphData[;;8],gn],
{_,x_,x_}])//Timing

Sage

(bad=DeleteCases[Monitor[{
gn=#,
GraphData[#,"Genus"],
GraphGenus[GraphData[#],Method->"Sage","Preprocess"->True]
}&/@GraphData["Connected",;;6],gn],
{_,x_,x_}])//AbsoluteTiming

(bad=DeleteCases[Monitor[{
gn=#,
GraphData[#,"Genus"],
GraphGenus[GraphData[#],Method->"Sage","Preprocess"->True]
}&/@GraphData["Connected",7],gn],
{_,x_,x_}])//AbsoluteTiming

Compute

Finished up to 600 s on XXX:

$Version

DateString[]

Length[todo=SortBy[Select[GraphData[All],MissingQ[GraphData[#,"Genus"]]&],GraphData[#,{"V","M"}]&]]

p=FirstPosition[todo,"ClebschGraph",{0}][[1]]

Take[todo,p+{1,50}]

Module[{
res={#,GraphGenus[GraphData[#],Method->"Sage",TimeConstraint->3600]//AbsoluteTiming}
},
Print[res]
]&/@Drop[todo,p];

Done