Topological Graph

Author

Eric W. Weisstein
May 9, 2024

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

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

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

Enumeration

<<MathWorld`Graphs`

Length/@(connected=Table[ConnectedGraphs[n],{n,10}])//Timing

topological=Table[TopologicalGraphs[n],{n,9}];//Timing

Length/@(connected=Table[ConnectedGraphs[n],{n,9}])//Timing

topological=Table[TopologicalGraphs[n],{n,9}];//Timing

Among all graphs with n vertices

Length/@topological

GraphicsGrid[
Map[
Show[Annotate[GraphData[r=RecognizeGraph[#]],{VertexStyle->Red,EdgeStyle->Black,VertexSize->{"Scaled",.05}}],PlotLabel->TextCell[Style[GraphData[r,"Name"],Directive[12,Black,Italic,FontFamily->"Times"]],TextAlignment->Center,PageWidth->1000/10]]&,
Flatten[Partition[#,UpTo[10]]&/@Take[topological,5],1],
{2}
],Dividers->{{{Thick}},{{Thick},True,Thick}},ImageSize->1000,Alignment->Top]

Planar graphs with n vertices

Length/@(planar=Select[#,PlanarGraphQ]&/@topological)

GraphicsGrid[
Map[
Show[Annotate[GraphData[r=RecognizeGraph[#],"Graph","Planar"][[1]],{VertexStyle->Red,EdgeStyle->Black,VertexSize->{"Scaled",.05}}],PlotLabel->TextCell[Style[GraphData[r,"Name"],Directive[12,Black,Italic,FontFamily->"Times"]],TextAlignment->Center,PageWidth->1000/9]]&,
Flatten[Partition[#,UpTo[9]]&/@Take[planar,5],1],
{2}
],Dividers->{{{Thick}},{{Thick},True,Thick}},ImageSize->1000,Alignment->Top]

"Reduced" topological graphs on n vertices

reduced=DeleteDuplicatesBy[TopologicalGraph/@Join@@topological,CanonicalGraph];//Timing

Tally[VertexCount/@reduced][[All,2]]

Among all graphs with m edges

byedges=GroupBy[Join@@connected,EdgeCount];//Timing

ConnectedGraphsWithNEdges[n_]:=Lookup[byedges,n]

Length/@(edges=Table[DeleteDuplicatesBy[ConnectedGraphsWithNEdges[n],CanonicalGraph[TopologicalGraph[#]]&],{n,9}])//Timing

GraphicsGrid[
Map[
Show[Annotate[GraphData[r=RecognizeGraph[#]],{VertexStyle->Red,EdgeStyle->Black,VertexSize->{"Scaled",.05}}],PlotLabel->TextCell[Style[GraphData[r,"Name"],Directive[12,Black,Italic,FontFamily->"Times"]],TextAlignment->Center,PageWidth->1000/10]]&,
Flatten[Partition[#,UpTo[10]]&/@Take[edges,5],1],
{2}
],Dividers->{{{Thick}},{{Thick},True,Thick}},ImageSize->1000,Alignment->Top]