Harvey-Royle Graphs

Author

Eric W. Weisstein
July 26, 2024

This notebook downloaded from http://mathworld.wolfram.com/notebooks/GraphTheory/Harvey-RoyleGraphs.nb.

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

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

Figure

harveyroyle=GraphData["HarveyRoyle*"]

GraphicsRow[GraphData/@harveyroyle//StyleGraphs,Dividers->All]

Properties

With[{val=GoldenRatio+2},Monitor[Select[GraphData[All],PossibleZeroQ[GraphData[gn=#,"ChromaticPolynomial"][val]]&],gn]]//Quiet//Timing

GraphData[#,"ChromaticRoots"]&/@harveyroyle

FunctionExpand[GoldenRatio+2]//Expand//Factor

Count[GraphData[#,"ChromaticRoots"],(1/2) (5+(Sqrt[5]))]&/@harveyroyle

Embeddings

<<MathWorld`Graphs`

"HarveyRoyleGraph1"

Names

GraphData["HarveyRoyleGraph1","StandardName"]

GraphData["HarveyRoyleGraph1","StandardNames"]

Construction

Alikhani, S. and Ghanbari, N.  "Golden Ratio in Graph Theory: A Survey."  9 Jul 2024.  https://arxiv.org/abs/2407.15860

2Mean[v[[{1,8}]]]-v[[9]]//FullSimplify

v=CirclePoints[{1,-Pi/2},9];
v=Join[v,{(-Cos[(π/18)]+Sin[((2 π)/9)])#,-1+Cos[((2 π)/9)]-Sin[(π/18)]}&/@{-1,1}];
g1=Graph[Range@Length@v,UndirectedEdge@@@{e[{1,9},1,10,3,5,8,11,1],e[4,7,3,6,4,8,6],{5,7}},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph@g1

poly=ChromaticPolynomial[g1,x]

CountRoots[poly,x]

roots=x/.{ToRules[Roots[poly==0,x]//RootReduce]}

Select[roots,Im[#]==0&]

Length[%]

Select[roots,#==GoldenRatio+2&]

N[roots]

NRoots[poly==0,x]

x/.{ToRules[%]}

CountRoots[poly,{x,GoldenRatio+2,GoldenRatio+2}]

With[{eps=1*^-16},CountRoots[poly,{x,GoldenRatio+2-eps,GoldenRatio+2+eps}]]

Primary

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

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["HarveyRoyleGraph1","EdgeList"]]

Default embedding

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

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

RecognizeGraph[g]

Degenerate

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

DegenerateGraphEmbeddingTypes/@GraphData["HarveyRoyleGraph1","Graph","Degenerate"]

Configuration

GraphData["HarveyRoyleGraph1","Configuration"]

GraphData["HarveyRoyleGraph1","Graph","Configuration"]//StyleGraphs

Perspective

GraphData["HarveyRoyleGraph1","Graph","Perspective"]//StyleGraphs

HoneycombToroidal construction

GraphData["HarveyRoyleGraph1","NotationRules","HoneycombToroidal"]

GeneralizedPetersen

GraphData["HarveyRoyleGraph1","Graph","GeneralizedPetersen"]//StyleGraphs

IGraph

GraphData["HarveyRoyleGraph1","Graph","IGraph"]//StyleGraphs

Bilateral

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

Circular

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

Circular construction

GraphData["HarveyRoyleGraph1","Hamiltonian"]

GraphData["HarveyRoyleGraph1","HamiltonianCycleCount"]

Planar

GraphData["HarveyRoyleGraph1","Planar"]

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

MinimalCrossing

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

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

MinimalCrossing construction

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

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

(cn=CrossingNumber[GraphData["HarveyRoyleGraph1"],TimeConstraint->60])//AbsoluteTiming

(cn=CrossingNumber[GraphData["HarveyRoyleGraph1"],TimeConstraint->3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData["HarveyRoyleGraph1"],TimeConstraint->5 3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData["HarveyRoyleGraph1"],TimeConstraint->86400])//AbsoluteTiming

(g=MinimalCrossingGraph[GraphData["HarveyRoyleGraph1"],"CrossingNumber"->cn])//PolyhedralGraphQ

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

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

GraphPlot@

v={{0,0},{4,0},{3/2,1},{5/2,1},{2,2},{1,3},{2,3},{3,3},{0,4},{2,4},{4,4}}/4;
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[1,4,3,2,11,10,9,1,6,10,8,2,4,5,3,1,7,2,5,1],e[3,7,4],{5,7}},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

RectilinearCrossingCount[g]

LocalCrossingCount@g

GraphPlot@

v={#,5-#2}/5&@@@{{2,0},{2,1},{3/2,2},{5/2,2},{0,3},{4,3},{1,4},{3,4},{0,5},{2,5},{4,5}};
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[1,6,11,10,9,5,1,2,4,3,2,6,3,5,4,1,3],e[2,5,7,10,8,6,4]},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

RectilinearCrossingCount[g]

LocalCrossingCount@g

gs=UnlabelGraph/@{,}

MinimalLocalCrossing

GraphData["HarveyRoyleGraph1","LocalCrossingNumber"]

GraphData["HarveyRoyleGraph1","Graph","MinimalLocalCrossing"]//StyleGraphs

MinimalLocalCrossing construction

AdjacentCrossingsQ[g_Graph,cn_Integer]:=Module[{a=AdjacencyList[g],n=VertexCount[g]-cn},Max[Take[a,-cn]]>n]

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

Select[Table[MinimalCrossingGraph[GraphData["HarveyRoyleGraph1"],"CrossingNumber"->cn,RandomSeed->i],{i,50}],!AdjacentCrossingsQ[#,cn]&]//Union//Timing

Circulant

GraphData["HarveyRoyleGraph1","Circulant"]

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

Circulant construction

GraphData["HarveyRoyleGraph1","NotationRules","Circulant"]

(ci=CirculantIndices[GraphData["HarveyRoyleGraph1"]])//Timing

Complement graph

compl=GraphData["HarveyRoyleGraph1","ComplementGraph","Name"]

Line graph

GraphData["HarveyRoyleGraph1","Line"]

LineGraphQ[GraphData["HarveyRoyleGraph1"]]//Timing

RootGraph

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

RootGraph[GraphData["HarveyRoyleGraph1"]]

RecognizeGraph[%]

Halin

GraphData["HarveyRoyleGraph1","Halin"]

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

Rigid

GraphData["HarveyRoyleGraph1","Rigid"]

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

Flexible

GraphData["HarveyRoyleGraph1","Flexible"]

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

LCF

GraphData["HarveyRoyleGraph1","LCF"]

GraphData["HarveyRoyleGraph1","HamiltonianCycleCount"]

GraphData["HarveyRoyleGraph1","LCFSignature"]

GraphData["HarveyRoyleGraph1","LCFNotations"]

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

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

UnitDistance

GraphData["HarveyRoyleGraph1","UnitDistance"]

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

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData["HarveyRoyleGraph1","VertexList"],GraphData["HarveyRoyleGraph1","EdgeList"]],MaxIterations->500]

UnitDistanceEmbeddingRefine[Annotate[#,VertexCoordinates->N[GraphEmbedding[#]]],MaxIterations->500]&/@Complement@@(GraphData["HarveyRoyleGraph1","Graph",#]&/@{"All","UnitDistance"})

UnitDistance by FindUnitDistanceEmbedding

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

Matchstick

GraphData["HarveyRoyleGraph1","Matchstick"]

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

3D default

Graph3D[GraphData["HarveyRoyleGraph1","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["HarveyRoyleGraph1","Polyhedral"]

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

"HarveyRoyleGraph2"

Names

GraphData["HarveyRoyleGraph2","StandardName"]

GraphData["HarveyRoyleGraph2","StandardNames"]

Construction

Alikhani, S. and Ghanbari, N.  "Golden Ratio in Graph Theory: A Survey."  9 Jul 2024.  https://arxiv.org/abs/2407.15860

v=CirclePoints[5];
m=Mean[v[[{1,5}]]];
v=Join[v,Sequence@@Table[m+{i,j}/6,{i,{-1,1}},{j,-1,1}]];
g2=Graph[Range@Length@v,UndirectedEdge@@@{e[1,2,3,4,5,2,4,1,3,5,8,11,1,10,6,5,7,11],e[6,9,1]},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph@g2

poly=ChromaticPolynomial[g2,x]

roots=x/.{ToRules[Roots[poly==0,x]//RootReduce]}

Select[roots,#==GoldenRatio+2&]

CountRoots[poly,{x,GoldenRatio+2,GoldenRatio+2}]

With[{eps=1*^-16},CountRoots[poly,{x,GoldenRatio+2-eps,GoldenRatio+2+eps}]]

Primary

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

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["HarveyRoyleGraph2","EdgeList"]]

Default embedding

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

GraphPlot@RotateGraph[GraphicsToGraph@,Pi]

s=1/2;
v={{0,0},{1,0},{0,1},{1/2,1},{1,1},{0,3/2},{1,3/2},{0,2},{1,2},{-s,3/2},{1+s,3/2}};
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[1,2,5,7,9,11,5,4,3,10,8,5,1,3,2,4,1],e[3,6,8],{3,9}},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

gs=UnlabelGraph/@{,}

Degenerate

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

DegenerateGraphEmbeddingTypes/@GraphData["HarveyRoyleGraph2","Graph","Degenerate"]

Configuration

GraphData["HarveyRoyleGraph2","Configuration"]

GraphData["HarveyRoyleGraph2","Graph","Configuration"]//StyleGraphs

Perspective

GraphData["HarveyRoyleGraph2","Graph","Perspective"]//StyleGraphs

HoneycombToroidal construction

GraphData["HarveyRoyleGraph2","NotationRules","HoneycombToroidal"]

GeneralizedPetersen

GraphData["HarveyRoyleGraph2","Graph","GeneralizedPetersen"]//StyleGraphs

IGraph

GraphData["HarveyRoyleGraph2","Graph","IGraph"]//StyleGraphs

Bilateral

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

Circular

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

Circular construction

GraphData["HarveyRoyleGraph2","Hamiltonian"]

GraphData["HarveyRoyleGraph2","HamiltonianCycleCount"]

Planar

GraphData["HarveyRoyleGraph2","Planar"]

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

MinimalCrossing

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

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

MinimalCrossing construction

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

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

(cn=CrossingNumber[GraphData["HarveyRoyleGraph2"],TimeConstraint->60])//AbsoluteTiming

(cn=CrossingNumber[GraphData["HarveyRoyleGraph2"],TimeConstraint->3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData["HarveyRoyleGraph2"],TimeConstraint->5 3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData["HarveyRoyleGraph2"],TimeConstraint->86400])//AbsoluteTiming

(g=MinimalCrossingGraph[GraphData["HarveyRoyleGraph2"],"CrossingNumber"->cn])//PolyhedralGraphQ

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

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

GraphPlot@

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

MinimalLocalCrossing

GraphData["HarveyRoyleGraph2","LocalCrossingNumber"]

GraphData["HarveyRoyleGraph2","Graph","MinimalLocalCrossing"]//StyleGraphs

MinimalLocalCrossing construction

AdjacentCrossingsQ[g_Graph,cn_Integer]:=Module[{a=AdjacencyList[g],n=VertexCount[g]-cn},Max[Take[a,-cn]]>n]

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

Select[Table[MinimalCrossingGraph[GraphData["HarveyRoyleGraph2"],"CrossingNumber"->cn,RandomSeed->i],{i,50}],!AdjacentCrossingsQ[#,cn]&]//Union//Timing

GraphPlot@

v={#/6,#2/3}&@@@{{0,0},{3,0},{6,0},{1,1},{2,1},{4,1},{5,1},{3,2},{0,3},{3,3},{6,3}};
g=Graph[Range@Length@v,UndirectedEdge@@@{e[1,2,3,11,10,9,1,4,10,6,2,5,10,8,2,7,11],e[5,6,8,5]},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph@g

v={#/9,#2/3}&@@@{{0,0},{3,0},{9,0},{1,1},{2,1},{4,1},{5,1},{3,2},{0,3},{3,3},{9,3}};
g=Graph[Range@Length@v,UndirectedEdge@@@{e[1,2,3,11,10,9,1,4,10,6,2,5,10,8,2,7,11],e[5,6,8,5]},VertexCoordinates->v,VertexLabels->Automatic]

Circulant

GraphData["HarveyRoyleGraph2","Circulant"]

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

Circulant construction

GraphData["HarveyRoyleGraph2","NotationRules","Circulant"]

(ci=CirculantIndices[GraphData["HarveyRoyleGraph2"]])//Timing

Complement graph

compl=GraphData["HarveyRoyleGraph2","ComplementGraph","Name"]

Line graph

GraphData["HarveyRoyleGraph2","Line"]

LineGraphQ[GraphData["HarveyRoyleGraph2"]]//Timing

RootGraph

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

RootGraph[GraphData["HarveyRoyleGraph2"]]

RecognizeGraph[%]

Halin

GraphData["HarveyRoyleGraph2","Halin"]

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

Rigid

GraphData["HarveyRoyleGraph2","Rigid"]

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

Flexible

GraphData["HarveyRoyleGraph2","Flexible"]

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

LCF

GraphData["HarveyRoyleGraph2","LCF"]

GraphData["HarveyRoyleGraph2","HamiltonianCycleCount"]

GraphData["HarveyRoyleGraph2","LCFSignature"]

GraphData["HarveyRoyleGraph2","LCFNotations"]

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

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

UnitDistance

GraphData["HarveyRoyleGraph2","UnitDistance"]

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

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData["HarveyRoyleGraph2","VertexList"],GraphData["HarveyRoyleGraph2","EdgeList"]],MaxIterations->500]

UnitDistanceEmbeddingRefine[Annotate[#,VertexCoordinates->N[GraphEmbedding[#]]],MaxIterations->500]&/@Complement@@(GraphData["HarveyRoyleGraph2","Graph",#]&/@{"All","UnitDistance"})

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

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

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

Matchstick

GraphData["HarveyRoyleGraph2","Matchstick"]

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

3D default

Graph3D[GraphData["HarveyRoyleGraph2","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["HarveyRoyleGraph2","Polyhedral"]

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

GraphData

GraphDataString

<<MathWorld`Graphs`

gs={,};

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

Do[
WriteString[file,GraphDataString[gs[[i]],
"StandardName"->"HarveyRoyleGraph"<>ToString[i],
"AlternateStandardNames"->{"GoldenRatioPlusTwoChromaticRootGraph"<>ToString[i]},
"Name"->"Harvey\[Hyphen]Royle graph "<>ToString[i],
"AlternateNames"->{"golden ratio + 2 chromatic root graph "<>ToString[i]},
"Information"->"ChromaticRoot"
]],{i,2}]

Close[file]