de Grey Graph

Author

Eric W. Weisstein
January 16, 2022

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

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

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

Table

TextGrid[Sort[GraphData[#,{"VertexCount","EdgeCount","ChromaticNumber","#"}]&/@GraphData["DeGrey*"]],Dividers->All,Alignment->{{{Decimal},Left}}]

"DeGreyGraph126"

GraphData["DeGreyGraph126"]

Construction

Parts, J.  "A Small 6-Chromatic Two-Distance Graph in the Plane."  23 Oct 2020.  https://arxiv.org/abs/2010.12656

https://arxiv.org/pdf/2010.12656.pdf

First[2/.Import["https://arxiv.org/pdf/2010.12656.pdf","EmbeddedImages"]]

Corresponding graph was defined explicitly by de Grey [3]:

[3] A. de Grey, Comments in Polymath16 , thread 14, comment 24439, October 20, 2019

https://dustingmixon.wordpress.com/2019/08/05/polymath16-fourteenth-thread-automated-graph-minimization/#comment-24439

G126 =G5 ⊕G5 ⊕G5 ⊕G5 ⊕G5,

Here G5 is a regular pentagon with side 1 and diagonal d =((Sqrt[5])+1)/2, and ⊕ denotes the Minkowski sum. The Minkowski sum of distance graphs is a graph whose vertex set is the union of all possible sums of their vertex coordinates, and the set of edges includes all pairs of obtained vertices for all forbidden distances.The size of this graph is much smaller than we expected – it has only 126 vertices, and 350 edges each of length 1 and d (Fig. 1).

Vertex coordinates

SetDirectory["/Users/eww/Documents/Mathematica/Paclets/GraphData/Collections/UnitDistance/Parts/126"];

Length[v=ToExpression/@Import["g126.vtx","Lines"]]

Length[e=Select[Subsets[Range[Length[v]],{2}],Abs[(d=EuclideanDistance@@v[[#]])-1]<.001||Abs[d-GoldenRatio]<.001&]]//Quiet//Timing

(G126=Graph[Range[Length[v]],UndirectedEdge@@@e,VertexCoordinates->v])

EdgeLengths[G126]//RootReduce//Tally

RecognizeGraph[G126]

GraphData["PartsGraph16"]

FindIsomorphicSubgraph[G126,GraphData["PartsGraph16"]]//Timing

VertexChromaticNumber[G126]//Timing

GraphData

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

WriteString[file,GraphDataString[G126,
"StandardName"->"DeGreyGraph126",
"Name"->"de Grey graph 126",
"ChromaticNumber"->5,
"Skip"->{"CliqueCoveringNumber","ConnectedInducedSubgraphPolynomial","CrossingNumber","DominatingSet","GracefulLabeling","GracefulLabelings","IndependencePolynomial","MatchingGeneratingPolynomial","MatchingPolynomial","RadioNumber","TotalDominatingSet","VertexCover"},
TimeConstraint->5,
Debug->True]]

Close[file]

"DeGreyGraph"

ColorGraph[g_Graph]:=Module[{col=FindVertexColoring[g],cols={Red,Green,Yellow,Green,Blue}},
Annotate[g,{EdgeStyle->Directive[LightGray],VertexStyle->MapIndexed[#2[[1]]->cols[[#]]&,col]}]
]

g=ColorGraph[GraphData["DeGreyGraph"]]

GraphData[gname,{"V","M"}]

UnitDistanceGraphQ[g,WorkingPrecision->∞]//FullSimplify//Timing

VertexChromaticNumber[g]//Timing

Construct

https://gilkalai.wordpress.com/2018/04/10/aubrey-de-grey-the-chromatic-number-of-the-plane-is-at-least-5/#comment-40108

SetDirectory["/Users/eww/Documents/Mathematica/Paclets/GraphData/Collections/Hadwiger-Nelson/1581"]

FileNames[]

Length[v=ToExpression/@Import["1581v.txt","Lines"]]

Length[e=ToExpression/@Import["1581e.txt","Lines"]]

(deGreyGraph=System`Graph[Range[Length[v]],UndirectedEdge@@@e,VertexCoordinates->v])

Compute Properties

TriangleFreeGraphQ[deGreyGraph]

UnitDistanceGraphQ[deGreyGraph]

UnitDistanceGraphQ[deGreyGraph,WorkingPrecision->∞]//FullSimplify//Timing

FindVertexColoring[deGreyGraph,Method->"Brelaz"]//Max//Timing

FindVertexColoring[deGreyGraph,Method->"Combinatorica"]//Max//Timing

FindVertexColoring[deGreyGraph,Method->{"ILP",3}]//Max//Timing

GraphDataString

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

WriteString[file,GraphDataString[deGreyGraph,
"StandardName"->"DeGreyGraph",
"Name"->"de Grey graph",
"Skip"->{"IndependencePolynomial","MatchingGeneratingPolynomial","MatchingPolynomial"},
TimeConstraint->5,
Debug->True]]

Close[file]