Gray Graph

Author

Eric W. Weisstein
December 14, 2023

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

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

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

Configuration

GraphData["GrayGraph","Incidence"]

lines=GraphData["GrayGraph","Configurations"]

RecognizeGraph[LeviGraph[#]]&/@lines

GraphData["GrayConfigurationGraph","#"]

configg=GraphData["GrayConfigurationGraph","Graph",{"3D","Configuration","Labeled"}][[1]]

lines2=Sort@ConfigurationLinesFromGraph[configg]

LeviGraph[lines2]//RecognizeGraph

points=GraphEmbedding[configg]

Includes diagonal lines:

eolines=ResourceFunction["FindExtraordinaryLines"][points]

Graphics3D[{AbsolutePointSize[5],Point[points],MapIndexed[Text[#2[[1]],#,{1,1}]&,points],LongestLine[points,#]&/@eolines},Boxed->False]

LeviGraph[eolines]

RecognizeGraph@%

ConfigurationGraph[points,lines2,VertexLabels->Automatic]

RecognizeGraph@%

ConfigurationDiagram[points,lines2,.5,Boxed->False,VertexLabels->None,Method->{"ShrinkWrap"->True}]

Embeddings

<<MathWorld`Graphs`

Names

GraphData["GrayGraph","StandardName"]

GraphData["GrayGraph","StandardNames"]

Primary

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

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["GrayGraph","EdgeList"]]

Default embedding

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

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

RecognizeGraph[g]

Degenerate

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

Bilateral

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

Circular

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

Planar

GraphData["GrayGraph","Planar"]

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

Circulant

GraphData["GrayGraph","Circulant"]

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

Halin

GraphData["GrayGraph","Halin"]

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

LCF

GraphData["GrayGraph","LCF"]

GraphData["GrayGraph","HamiltonianCycleCount"]

GraphData["GrayGraph","LCFSignature"]

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

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

LCF compute

Length[FindHamiltonianCycle[GraphData["GrayGraph"],All][[All,All,1]]]//Timing

Tally[(lcf=LCF[GraphData["GrayGraph"],All])[[All,2]]]//Timing

LCFGraph@@@lcf//StyleGraphs

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

g=RotateGraph[,Pi]

Incidence Configuration

RecognizeGraph/@LeviGraph/@GraphData["GrayGraph","Configurations"]

Construction from Mod relation (Combinatorica)

MakeGraph[v_List,f_]:=Table[Boole[f@@v[[{i,j}]]],{i,Length[v]},{j,Length[v]}]

g=UndirectedGraph@AdjacencyGraph[MakeGraph[Range[54],Mod[#2-#1,54]==1||(Mod[#1,6]==1&&Mod[#2-#1,54]==25)||(Mod[#1,6]==2&&Mod[#2-#1,54]==29)||(Mod[#1,6]==5&&Mod[#2-#1,54]==7)||(Mod[#1,6]==3&&Mod[#2-#1,54]==13)&]]

RecognizeGraph[g]

UnitDistance

GraphData["GrayGraph","UnitDistance"]

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

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

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

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

UnitDistance FindSubgraphUnitDistanceEmbedding

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

GraphData[{"Hypercube",8},"Graph","UnitDistance"]

gs=UniqueEmbeddings[l]

Unit-Distance construction

By Jeremy Tan
Communicated by Ed Pegg, Jr.
Oct. 16, 2021

a=(#^2/16-17#/8+45/16&)[Tan[Pi/9]^2];b=(#^2/8-4#+15/8&)[Tan[Pi/9]^2];c=(-3#^2/16+49#/8-27/16&)[Tan[Pi/9]^2];grayline={a,b,c,a-1,b-1,c-1};grayverts=ReIm/@Flatten[Table[grayline Exp[2k I Pi/9],{k,0,8}]]//RootReduce//FullSimplify

grayedges=UnitEdges[grayverts]

g=Graph[Range[Length[grayverts]],grayedges,VertexCoordinates->grayverts]

RecognizeGraph[g]

UnitDistanceGraphEmbeddingQ[g]

DegenerateGraphEmbeddingTypes[g]

Matchstick

GraphData["GrayGraph","Matchstick"]

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

MinimalCrossing

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

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

Default embedding

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

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

RecognizeGraph[g]

MinimalCrossing construction

CrossingNumber[GraphData["GrayGraph"],TimeConstraint->10]//AbsoluteTiming

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

g=RotateGraph[MinimalCrossingGraph[GraphData["GrayGraph"],"CrossingNumber"->30]]

RecognizeGraph[g]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData["GrayGraph","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["GrayGraph","Polyhedral"]

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