Wong Graph

Author

Eric W. Weisstein
October 31, 2023

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

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

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

Embeddings

<<MathWorld`Graphs`

Names

GraphData["WongGraph","StandardName"]

GraphData["WongGraph","StandardNames"]

Primary

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

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["WongGraph","EdgeList"]]

Default embedding

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

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

RecognizeGraph[g]

Degenerate

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

Circular

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

Planar

GraphData["WongGraph","Planar"]

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

MinimalCrossing

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

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

MinimalCrossing construction

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

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

g=RotateGraph[MinimalCrossingGraph[GraphData["WongGraph"],"CrossingNumber"->94]]

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

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData["WongGraph","Circulant"]

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

Halin

GraphData["WongGraph","Halin"]

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

LCF

GraphData["WongGraph","LCF"]

GraphData["WongGraph","HamiltonianCycleCount"]

GraphData["WongGraph","LCFSignature"]

GraphData["WongGraph","LCFNotations"]

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

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

LCF compute all

With[{debug=True},
ComputeLCF[
If[debug,Print[#]];
#,
"Prune"->False,
Method->"FindPath",
"ChunkSize"->10*^6,
Debug->debug
]
]&/@{"WongGraph"};

Tally[(lcf=ReadProperty["LCFNotations",GraphNameToFileName["WongGraph",".m.gz"]])[[All,2]]]//Timing

DeleteCases[lcf,{_,1}]

LCFGraph@@@DeleteCases[lcf,{_,1}]//StyleGraphs

Tally[LCFNotation[#][[-1]]&/@(gs=NiceLCFGraphs[lcf,3,2])]//Timing

Length[gs]

gs

LCFNotation[#][[2]]&/@gs

UnitDistance

GraphData["WongGraph","UnitDistance"]

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

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

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

UnitDistance by refinement

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

Select[%,UnitDistanceGraphEmbeddingQ]

gs={RotateGraph[LabelGraph@,{29,11}],RotateGraph[LabelGraph@,{15,16}],RotateGraph[LabelGraph@,{13,8}],RotateGraph[LabelGraph@,{17,2}]}

EdgeLengths/@gs

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

UnitDistance by FindUnitDistanceEmbedding

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

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

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

UnitDistance by FindSubgraphUnitDistanceEmbedding

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

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

Matchstick

GraphData["WongGraph","Matchstick"]

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

3D default

Graph3D[GraphData["WongGraph","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["WongGraph","Polyhedral"]

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

Properties

Through[{V,M,Union[DegreeSequence[#]]&,Girth,Diameter}[WongGraph]]

MyIsomorphicQ[WongGraph,CageGraph[5,5]]

Chromatic Number

ChromaticNumber[WongGraph]//Timing

Chromatic Polynomial

(p=ChromaticPolynomial[WongGraph,z])//Timing

TraditionalForm[Factor[p]]

Spectrum

Spectrum[WongGraph]//SpectrumForm//TraditionalForm

Automorphism Group

Length[Automorphisms[WongGraph]]//Timing