Quasi-Regular Graph

Author

Eric W. Weisstein
September 10, 2022

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

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

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

Source

https://arxiv.org/pdf/2006.01127.pdf

A graph on an odd number of vertices is called quasi-regular if the degree of every vertex is the same odd number, except for one vertex whose degree is larger by one

Counts

GraphData

(quasiregular=Monitor[Select[GraphData[All],QuasiRegularGraphQ[GraphData[gn=#]]&],gn])//Timing

quasiregular===GraphData["QuasiRegular"]

All

Odd terms match A134047

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

Table[Count[Graphs[n],_?QuasiRegularGraphQ],{n,9}]//Timing

Table[Count[GraphData[n],_?(QuasiRegularGraphQ[GraphData[#]]&)],{n,10}]//Timing

Length/@Table[GraphData["QuasiRegular",n],{n,10}]

RecognizeGraph/@Select[Graphs[3],QuasiRegularGraphQ]

RecognizeGraph/@Select[Graphs[5],QuasiRegularGraphQ]

RecognizeGraph/@Select[Graphs[7],QuasiRegularGraphQ]

RecognizeGraph/@Select[Graphs[9],QuasiRegularGraphQ]

Connected

Table[Count[ConnectedGraphs[n],_?QuasiRegularGraphQ],{n,9}]//Timing

Polyhedral

Table[Count[PolyhedralGraphs[n],_?QuasiRegularGraphQ],{n,9}]//Timing

Select[GraphData["Polyhedral"],QuasiRegularGraphQ[GraphData[#]]&]

Quasi-Quartic

Enumerate

Do[Print[{n,Length[quarticquasi[n]=Select[ConnectedGraphs[n],QuasiRegularGraphQ[#,4]&]]//Timing}],{n,10}]

Table[Count[GraphData[n],_?(QuasiRegularGraphQ[GraphData[#],4]&)],{n,10}]

Quasi-Nonic

Enumerate

Do[Print[{n,Length[nonicquasi[n]=Select[ConnectedGraphs[n],QuasiRegularGraphQ[#,9]&]]//Timing}],{n,1,9,2}]

Table[Count[GraphData[n],_?(QuasiRegularGraphQ[GraphData[#],9]&)],{n,10}]

Table

TextGrid[DeleteCases[Table[{n,gs=Select[GraphData[n],QuasiRegularGraphQ[GraphData[#],9]&],Show[GraphData[#],ImageSize->50]&/@gs},{n,10}],{_,{},_}],Dividers->All]

GraphData

P3+nP2

GraphData["P3+2P2"]

GraphData["P3+2P2"]//GraphEmbedding

Table[GraphDisjointUnion[PathGraph[Range[3]],Sequence@@Table[PathGraph[Range[2]],n]],{n,5}]

RecognizeGraph/@%

P3nP2[n_]:=Graph[Range[2n+3],UndirectedEdge@@@Join[{{1,2},{2,3}},Partition[Range[4,2n+3],2]],VertexCoordinates->Join[{{0,0},{1,0},{2,0}},Flatten[Table[{i,-j/4},{j,n},{i,0,1}],1]]]

Table[P3nP2[n],{n,5}]

RecognizeGraph/@%

Close[file]

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

Do[WriteString[file,GraphDataString[P3nP2[n],
"StandardName"->"P3+"<>ToString[n]<>"P2",
"AlternateStandardNames"->{ToString[n]<>"K2+K3",ToString[n]<>"P2+K3","K3+"<>ToString[n]<>"K2"},
"Name"->"3\[Hyphen]path and "<>IntegerName[n]<>" 2\[Hyphen]paths"
]],{n,3,5}]

Close[file]