Wells Graph

Author

Eric W. Weisstein
October 21, 2022

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

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

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

Embeddings

GraphData["WellsGraph","StandardName"]

Primary

GraphData["WellsGraph"]//StyleGraphs[#,ImageSize->Small]&

All

GraphData["WellsGraph","Graph","All"]//StyleGraphs

Inexact

Select[GraphData["WellsGraph","Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Default embedding

GraphPlot@GraphData["WellsGraph","Edges"]

v={};
g=Graph[Range[Length[v]],UndirectedEdge@@@{},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

Embedding types

GraphDataEmbeddings[GraphData["WellsGraph","EdgeList"]]

Degenerate

GraphData["WellsGraph","Graph","Degenerate"]//StyleGraphs

Bilateral

GraphData["WellsGraph","Graph","Bilateral"]//StyleGraphs

Circular

GraphData["WellsGraph","Graph","Circular"]//StyleGraphs

Planar

GraphData["WellsGraph","Planar"]

GraphData["WellsGraph","Graph","Planar"]//StyleGraphs

MinimalCrossing

GraphData["WellsGraph",{"RCN","CN"}]

GraphData["WellsGraph","Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

(cn=CrossingNumber[GraphData["WellsGraph"],TimeConstraint->10])//AbsoluteTiming

CrossingNumber[GraphData["WellsGraph"],TimeConstraint->60]//AbsoluteTiming

g=RotateGraph[MinimalCrossingGraph[GraphData["WellsGraph"],"CrossingNumber"->cn]]

Union[Select[Table[RotateGraph[MinimalCrossingGraph[GraphData["WellsGraph"],"CrossingNumber"->cn,RandomSeed->n]],{n,50}],Max[OuterFace[#]]<=GraphData["WellsGraph","V"]&]]//Timing

v={};
g=Graph[Range[Length[v]],UndirectedEdge@@@{},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData["WellsGraph","Circulant"]

GraphData["WellsGraph","Graph","Circulant"]//StyleGraphs

Halin

GraphData["WellsGraph","Halin"]

GraphData["WellsGraph","Graph","Halin"]//StyleGraphs

LCF

GraphData["WellsGraph","LCF"]

GraphData["WellsGraph","LCFSignature"]

GraphData["WellsGraph","Graph","LCF"]//StyleGraphs

Tally[(lcf=LCFNotation/@%)[[All,-1]]]

l={{"WellsGraph",{0,Missing["NotAvailanle",lcf]}}}

PropertyReplace[l,"LCFSignature","13.3"]

RenameGraphFiles[]

Planar

GraphData["WellsGraph","Planar"]

GraphData["WellsGraph","Graph","Planar"]//StyleGraphs

MinimalCrossing

GraphData["WellsGraph",{"RCN","CN"}]

GraphData["WellsGraph","Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

(cn=CrossingNumber[GraphData["WellsGraph"],TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData["WellsGraph"],TimeConstraint->10])//AbsoluteTiming

Union[Select[Table[RotateGraph[MinimalCrossingGraph[GraphData["WellsGraph"],"CrossingNumber"->cn,RandomSeed->n]],{n,50}],Max[OuterFace[#]]<=GraphData["WellsGraph","V"]&]]//Timing

Table[MinimalCrossingGraph[GraphData["WellsGraph"],"CrossingNumber"->cn,RandomSeed->i],{i,50}]//Union

v={};
g=Graph[Range[Length[v]],UndirectedEdge@@@{},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData["WellsGraph","Circulant"]

GraphData["WellsGraph","Graph","Circulant"]//StyleGraphs

Line graph

GraphData["WellsGraph","Line"]

LineGraphQ[GraphData["WellsGraph"]]//Timing

Select[GraphData[All],GraphData[#,"LineGraph","Name"]==="WellsGraph"&]

LineGraphRootGraph[GraphData["WellsGraph"]]

Halin

GraphData["WellsGraph","Halin"]

GraphData["WellsGraph","Graph","Halin"]//StyleGraphs

Rigid

GraphData["WellsGraph","Rigid"]

GraphData["WellsGraph","Graph","Rigid"]//StyleGraphs

Flexible

GraphData["WellsGraph","Flexible"]

GraphData["WellsGraph","Graph","Flexible"]//StyleGraphs

LCF

GraphData["WellsGraph","LCF"]

GraphData["WellsGraph","HamiltonianCycleCount"]

GraphData["WellsGraph","LCFSignature"]

GraphData["WellsGraph","LCFNotations"]

lcfgs=GraphData["WellsGraph","Graph","LCF"]//StyleGraphs

Length[lcfgs]

Tally[LCFNotation[#][[2]]&/@lcfgs]

lcf=LCFNotation/@lcfgs

(gs=Flatten[{
(* all LCF's with order >2, sorted by order and with bilateral graphs first *)
Join[DeleteCases[#,{_Missing,_}][[All,1]],Cases[#,{_Missing,_}][[All,2]]]&/@Map[{BilateralLCFGraph@#,#}&,Map[LCFGraph@@#&,SplitBy[DeleteCases[lcf,{_,2}],Last],{2}],{2}],
(* order-2 bilateral only *)
DeleteMissing[BilateralLCFGraph@@@Cases[lcf,{_,2}]]}])//Timing

LCF compute 10^5

Tally[(lcf=LCF[GraphData["WellsGraph"],10^5])[[All,2]]]//Timing

MaxMemoryUsed[]/10.^9 "GB"

LCF compute 10^6

Tally[(lcf=LCF[GraphData["WellsGraph"],10^6])[[All,2]]]//Timing

MaxMemoryUsed[]/10.^9 "GB"

lcf=LCFGraph@@@DeleteCases[lcf,{_,1}]

bilat=BilateralLCFGraph/@lcf

Sort[Transpose[{bilat,lcf}]]/.{{g_Graph,_}:>g,{_Missing,g_Graph}:>g}

LCF compute 10^7

Tally[(lcf=LCF[GraphData["WellsGraph"],10^7])[[All,2]]]//Timing

MaxMemoryUsed[]/10.^9 "GB"

lcfg=LCFGraph@@@DeleteCases[lcf,{_,1}]

(gs=Flatten[{
(* all LCF's with order >2, sorted by order and with bilateral graphs first *)
Join[DeleteCases[#,{_Missing,_}][[All,1]],Cases[#,{_Missing,_}][[All,2]]]&/@Map[{BilateralLCFGraph@#,#}&,Map[LCFGraph@@#&,SplitBy[DeleteCases[lcfg,{_,1|2}],Last],{2}],{2}],
(* order-2 bilateral only *)
DeleteMissing[BilateralLCFGraph@@@Cases[lcfg,{_,2}]]}])//Timing

Length[gs]

LCF compute 2*^7

Tally[(lcf=LCF[GraphData["WellsGraph"],2*^7])[[All,2]]]//Timing

Length[lcf]

MaxMemoryUsed[]/10.^9 "GB"

lcfg=LCFGraph@@@DeleteCases[lcf,{_,1}]

(gs=Flatten[{
(* all LCF's with order >2, sorted by order and with bilateral graphs first *)
Join[DeleteCases[#,{_Missing,_}][[All,1]],Cases[#,{_Missing,_}][[All,2]]]&/@Map[{BilateralLCFGraph@#,#}&,Map[LCFGraph@@#&,SplitBy[DeleteCases[lcf,{_,1|2}],Last],{2}],{2}],
(* order-2 bilateral only *)
DeleteMissing[BilateralLCFGraph@@@Cases[lcf,{_,2}]]}])//Timing

Length[gs]

UnitDistance

GraphData["WellsGraph","UnitDistance"]

UnitDistanceGraphQ[GraphData["WellsGraph"],Debug->True]//Timing

GraphData["WellsGraph","Graph","UnitDistance"]//StyleGraphs

Select[%,!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&]

UnitDistance by refinement

UnitDistanceEmbeddingRefine/@GraphData["WellsGraph","Graph","All"]

Select[%,UnitDistanceGraphEmbeddingQ]

LabelGraph@

g=RotateGraph[LabelGraph@,{3,32}]

EdgeLengths[g]

UnitDistanceEmbeddingRefine/@Complement@@(GraphData["WellsGraph","Graph",#]&/@{"All","UnitDistance"})

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

FindUnitDistanceEmbedding[GraphData["WellsGraph"],MaxIterations->5000,"ReturnWithMessage"->True]//Timing

FindUnitDistanceEmbedding[GraphData["WellsGraph"],MaxIterations->5000,"ReturnWithMessage"->False]//Quiet//Timing

FindUnitDistanceEmbedding[GraphData["WellsGraph"],MaxIterations->50000,"ReturnWithMessage"->False]//Quiet//Timing

UnitDistance by FindSubgraphUnitDistanceEmbedding

{"WellsGraph",l=FindSubgraphUnitDistanceEmbedding[GraphData["WellsGraph"],TimeConstraint->300,"Results"->All]//Timing}

gs=SortBy[UniqueEmbeddings[l],Replace[RectilinearCrossingCount[#],Infinity->0]&]

Matchstick

GraphData["WellsGraph","Matchstick"]

GraphData["WellsGraph","Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData["WellsGraph","Edges"]]

3D All

GraphData["WellsGraph","Graph",{"3D","All"}]

3D UnitDistance

GraphData["WellsGraph","Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData["WellsGraph","Polyhedral"]

GraphData["WellsGraph","Graph",{"3D","Polyhedron"}]

Properties

<<MathWorld`Graphs`

GraphData["WellsGraph","DistanceRegular"]

GraphData["WellsGraph","Quintic"]

"DistanceRegular"/.GraphData["WellsGraph","NotationRules"]

GraphData["WellsGraph","Spectrum"]//SpectrumForm

GraphData["WellsGraph","CospectralGraphs"]

"There are three distinct graphs having the spectrum of the Wells graph (van Dam and Haemers 2003)."

Select[GraphData[All],GraphData["WellsGraph","Spectrum"]===GraphData[#,"Spectrum"]&]

Construction

Wikipedia

g=System`Graph[Range[32],UndirectedEdge@@@Union[Sort/@Join[
Thread[{1,{11,2,18,31,8}}],
Thread[{2,{32,1,19,3,12}}],
Thread[{3,{25,2,20,4,13}}],
Thread[{4,{26,3,21,5,14}}],
Thread[{5,{27,4,15,6,22}}],
Thread[{6,{7,16,23,28,5}}],
Thread[{7,{9,8,24,29,6}}],
Thread[{8,{10,1,17,30,7}}],
Thread[{9,{26,22,7,31,32}}],
Thread[{10,{23,8,32,25,27}}],
Thread[{11,{28,26,25,1,24}}],
Thread[{12,{27,26,2,17,29}}],
Thread[{13,{28,27,3,18,30}}],
Thread[{14,{29,28,4,19,31}}],
Thread[{15,{30,29,5,20,32}}],
Thread[{16,{31,30,6,21,25}}],
Thread[{17,{12,20,28,22,8}}],
Thread[{18,{29,21,13,23,1}}],
Thread[{19,{2,24,30,22,14}}],
Thread[{20,{3,17,15,23,31}}],
Thread[{21,{24,32}}],
Thread[{22,{25}}],
Thread[{23,{6,20,10,18,26}}],
Thread[{24,{27}}]
]],VertexLabels->"Name",VertexCoordinates->Join@@Table[CirclePoints[{1.+.15r,0},8],{r,0,3}]]

VertexDegree[g]

r=RecognizeGraph[g]

distanceregular.org

ToEntity[g=DistanceRegularGraph["http://www.distanceregular.org/graphdata/armanios-wells.am"]]

VertexCount[g]

GraphDiameter[g]//Timing

RegularParameters[g]//Timing

IntersectionArray[g]//Timing

IntegerSpectrum[g]//SpectrumForm

GroupOrder[GraphAutomorphismGroup[g]]

HamiltonianGraphQ[g]