Regular Graph

Author

Eric W. Weisstein
October 19, 2023

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

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

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

Counts

All

A005176

Import["https://oeis.org/A005176/b005176.txt","Table"][[3;;,2]]

Total[Boole[Get[#]]]&/@FileNames["*.m",FileNameJoin[{$GraphDataDirectory,"Nodes","Regular"}]]

Table[Total[Boole[RegularGraphQ/@Graphs[n]]],{n,10}]//Timing

Table[Length@GraphData["Regular",n],{n,12}]

Connected

A005177

Import["https://oeis.org/A005177/b005177.txt","Table"][[3;;,2]]

Table[Total[Boole[Get[FileNameJoin[{$GraphDataDirectory,"Nodes","Regular","Regular_"<>If[n<10,"0",""]<>ToString[n]<>".m"}]][[ConnectedGraphIndices[n]]]]],{n,10}]

Table[Total[Boole[RegularGraphQ/@ConnectedGraphs[n]]],{n,10}]//Timing

Table[Length@GraphData[{"Connected","Regular"},n],{n,12}]

Table[Length[RegularConnectedGraphs[n]],{n,12}]//Timing

Something is wrong; (Subscript[K, 11]) is missing

data=Join[{CanonicalForm[#],#}&/@RegularConnectedGraphs[11],
{CanonicalForm[#],#}&/@(GraphData/@GraphData[{"Connected","Regular"},11])];

Select[SplitBy[SortBy[data,First],First],Length[#]==1&][[All,All,2]]//Flatten

RecognizeGraph/@%

VertexDegree[System`CompleteGraph[11]]//Max

RegularConnectedGraphs[10,11]

RegularConnectedGraphs[10,11,Method->"WebImport"]

RegularConnectedGraphs[9,10]

Disconnected

Table[Total[Boole[Get[FileNameJoin[{$GraphDataDirectory,"Nodes","Regular","Regular_"<>If[n<10,"0",""]<>ToString[n]<>".m"}]][[DisconnectedGraphIndices[n]]]]],{n,10}]

(disc=Table[Total[Boole[(!ConnectedGraphQ[#]&&RegularGraphQ[#]&)/@Graphs[n]]],{n,10}])//Timing

Table[Length@GraphData[{"Disconnected","Regular"},n],{n,10}]

disc-%

new=Select[Graphs[10],!ConnectedGraphQ[#]&&RegularGraphQ[#]&&Head[ToEntity[#]]===ToEntity&]//Quiet

Map[ToEntity,ConnectedGraphComponents/@new,{2}]

Convert .asc files (Meringer) -> g6

<<MathWorld`Graphs`

SetDirectory[FileNameJoin[{$GraphDataDirectory,"Collections","Meringer"}]]

With[{file="22_3_3"},ConvertASCFileToGraph6["asc/"<>file<>".asc","g6/"<>file<>".g6",Debug->True]]//Timing

With[{file="15_4_3"},ConvertASCFileToGraph6["asc/"<>file<>".asc","g6/"<>file<>".g6",Debug->True]]//Timing

With[{file="16_4_3"},ConvertASCFileToGraph6["asc/"<>file<>".asc","g6/"<>file<>".g6",Debug->True]]//Timing

Enumeration

Timing[Length/@(regular=Table[Select[Graphs[n],RegularQ],{n,9}])]

Grid[Function[g,{g[[1,1]],GraphData[#,"Name"]&/@DeleteCases[g[[All,2]],{"Circulant"|"Haar"|"Sextic",_}]}]/@Select[SplitBy[Sort[{GraphData[#,"Degrees"][[1]],#}&/@GraphData["Regular"]],First],#[[1,1]]>5&],Dividers->All,Alignment->Left]//TraditionalForm

Grid[Function[g,{g[[1,1]],GraphData[#,"Name"]&/@Cases[g[[All,2]],_String]}]/@Select[SplitBy[Sort[{GraphData[#,"Degrees"][[1]],#}&/@GraphData["Regular"]],First],#[[1,1]]>5&],Dividers->All,Alignment->Left]//TraditionalForm

Disconnected

Table[Count[IntegerPartitions[n],_?(Min[#]>2&)],{n,20}]

(i=Table[Select[IntegerPartitions[n],(Min[#]>2&)],{n,10}])//Column

graphDisjointUnion[g_System`Graph`]:=g
graphDisjointUnion[g__]:=GraphDisjointUnion[g]

g=Map[GraphPlot[#]&,Map[graphDisjointUnion@@#&,Map[CycleGraph,DeleteCases[i,{}],{3}],{2}],{2}];

Grid[{GraphicsGrid[#,Dividers->All]&/@Partition[g,4]}]

By Degree

(degrees=Table[Count[regular[[n]],_?(Degrees[#][[1]]==k&)],{n,9},{k,0,n-1}])//TableForm

degrees={{1},{1,1},{1,0,1},{1,1,1,1},{1,0,1,0,1},{1,1,2,2,1,1},{1,0,2,0,2,0,1},{1,1,3,6,6,3,1,1},{1,0,4,0,16,0,4,0,1}};

Table[Count[IntegerPartitions[n],_?(Min[#]>2&)],{n,11}]

Table[Count[GraphData["Regular",n],_?(Union[GraphData[#1,"VertexDegrees"]]=={2}&)],{n,11}]

%%-%

So missing 5 2-regular graphs on 11-vertices (i.e., unions of cycles)

FrobeniusSolve[Range[3,10],11]

(cycleunions=Sort[Reverse/@DeleteCases[MapIndexed[{#,2+#2[[2]]}&,FrobeniusSolve[Range[3,10],11],{2}],{0,_},{2}]])//Column

RecognizeGraph@GraphDisjointUnion[CycleGraph[5],CycleGraph[6]]

GraphData

GraphDataString

reg=Table[Select[ConnectedGraphs[n],RegularGraphQ],{n,8}];

Length/@reg

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

9-node

GraphDataString[GraphUnion[Cycle[3],Cycle[6]],
"StandardName"->"TriangleHexagon",
"Name"->"triangle and hexagon graph",
"Classes"->{"UnitDistance"},
"Notation"->Row[{Subscript["C", 3],"⋃",Subscript["C",6]}],
Debug->True,
TimeConstraint->60
]

GraphDataString[GraphUnion[Cycle[4],Cycle[5]],
"StandardName"->"SquarePentagon",
"Name"->"square and pentagon graph",
"Classes"->{"UnitDistance"},
"Notation"->Row[{Subscript["C", 4],"⋃",Subscript["C",5]}],
Debug->True,
TimeConstraint->60
]

10-node

RecognizeGraph[GraphComplement[#]]&/@{GraphUnion[Cycle[3],Cycle[3],Cycle[4]],GraphUnion[Cycle[4],Cycle[6]],GraphUnion[Cycle[3],Cycle[7]]}

GraphDataString[GraphUnion[Cycle[3],Cycle[3],Cycle[4]],
"StandardName"->"TwoTrianglesSquare",
"Name"->"two triangles and a square graph",
"Classes"->{"UnitDistance"},
"Notation"->Row[{2,Subscript["C", 3],"⋃",Subscript["C",5]}],
Debug->True,
TimeConstraint->60
]

GraphDataString[GraphUnion[Cycle[4],Cycle[6]],
"StandardName"->"SquareHexagon",
"Name"->"square and hexagon graph",
"Classes"->{"UnitDistance"},
"Notation"->Row[{Subscript["C", 4],"⋃",Subscript["C",6]}],
Debug->True,
TimeConstraint->60
]

GraphDataString[GraphUnion[Cycle[3],Cycle[7]],
"StandardName"->"TriangleHeptagon",
"Name"->"triangle and heptagon graph",
"Classes"->{"UnitDistance"},
"Notation"->Row[{Subscript["C", 3],"⋃",Subscript["C",7]}],
Debug->True,
TimeConstraint->60
]

11-node

cycleunions

RecognizeGraph/@Function[g,GraphDisjointUnion@@Flatten[Table[CycleGraph[#2],{#1}]&@@@g]]/@cycleunions

Table[CycleGraph[#2],{#1}]&@@@{{1,5},{2,3}}

gon[n_]:={"","","triangle","square","pentagon","hexagon","heptagon","octagon"}[[n]]
countgon[k_,n_]:=Switch[k,1,"",2,"two "]<>gon[n]<>If[k==1,"","s"]

standardname[g_]:=StringJoin@@Riffle[If[#1==1,"",ToString[#1]]<>"C"<>ToString[#2]&@@@g,"+"]
notation[g_]:=Row[Flatten[Riffle[{If[#1==1,Sequence@@{},#1],Subscript["C", #2]}&@@@g,"⋃"]]]

standardname[{{1,3},{3,4}}]

notation[{{2,3},{3,4}}]

countgon[2,4]

file=OpenWrite["~/11-regular.m"]

Function[g,WriteString[file,GraphDataString[GraphDisjointUnion@@Flatten[Table[CycleGraph[#2],{#1}]&@@@g],
"StandardName"->standardname[g],
"Name"->StringJoin@@Flatten[Riffle[countgon@@@g," and "]],
"Classes"->{"UnitDistance"},
"Notation"->notation[g],
Debug->True,
TimeConstraint->60
]]]/@cycleunions

Close[file]