Schläfli Double Six Graph

Author

Eric W. Weisstein
September 25, 2024

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

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

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

Figure

GraphData["SchlaefliDoubleSixGraph",{"V","E"}]

Show[GraphData["SchlaefliDoubleSixGraph"]//StyleGraphs,ImageSize->300]

Configuration

From Schläefli double six

GraphData["SchlaefliDoubleSixGraph","Incidence"]

lines=GraphData["SchlaefliDoubleSixGraph","IncidenceLines"]

Subscript@@Reverse@Flatten@Tally[Length/@lines[[1]]]

RecognizeGraph[LeviGraph[#]]&/@lines

GraphData["SchlaefliDoubleSixConfigurationGraph","#"]

configg=GraphData["SchlaefliDoubleSixConfigurationGraph","Graph",{"Configuration","Labeled"}]

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

Sort@ConfigurationLines[configg]

points=GraphEmbedding[configg]

lines2=ResourceFunction["FindExtraordinaryLines"][points]

ConfigurationGraph[points,lines2,VertexLabels->Automatic]

RecognizeGraph@%

ConfigurationDiagram[points,lines2,.5,Boxed->False]

From configuration points (source unknown)

MatrixForm[conf={{1,4,26,20,21},{1,5,25,10,8},{2,4,29,14,18},{2,6,25,11,9},{3,5,29,13,17},{3,6,26,24,23},{7,10,27,22,23},{7,11,30,15,17},{8,12,30,14,16},{9,12,27,20,19},{16,13,28,22,21},{18,15,28,24,19}}]

LeviGraph[conf]//RecognizeGraph

Classes

GraphData["SchlaefliDoubleSixGraph","Classes"]

Embeddings

<<MathWorld`Graphs`

Names

GraphData["SchlaefliDoubleSixGraph","StandardName"]

GraphData["SchlaefliDoubleSixGraph","StandardNames"]

Primary

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

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["SchlaefliDoubleSixGraph","EdgeList"]]

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

Graph[EdgeList[g]]

GraphicsToGraph@GraphPlot[GraphData["SchlaefliDoubleSixGraph","Edges"]]

GraphPlot@

v=Join[CirclePoints[1/6,6],CirclePoints[2/3,18],CirclePoints[18]];
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[25,9,28,12,31,15,34,18,37,21,40,24,25],e[42,7,26,9,11,13,32,15,17,19 ,38,21,23,7,27,10,29,12,14,16,35],e[19,6,9],e[42,22,39,19,36,16,33,13,30,10,8,24,41,22,1,12],e[24,5,16],e[21,4,13],e[18,3,10],e[7,2,15],e[35,18,20,22]},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph@g

(Sqrt[2])/2.

square=CirclePoints[1,4];
square3=Flatten[{#1+(#2-#1)/3,#1+(#2-#1)2/3}&@@@Partition[square,2,1,1],1];

v=Join[CirclePoints[(1/(3 (Sqrt[2]))),6],square,square3,CirclePoints[.8,6],CirclePoints[(2^(-1/2)),4]];
g=Graph[Range[Length[v]],UndirectedEdge@@@Join[
{{18,7},{7,11},{12,8},{8,13},{14,9},{9,15},{16,10},{10,17},{17,5},{5,14},{18,2},{2,13},{16,4},{4,26},{15,6},{6,25}}
],VertexCoordinates->v,VertexLabels->Automatic]

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

RecognizeGraph[g]

Degenerate

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

Incidence

GraphData["SchlaefliDoubleSixGraph","Incidence"]

Select[GraphData[All],GraphData[#,"LeviGraph","Name"]==="SchlaefliDoubleSixGraph"&]

lines=GraphData["SchlaefliDoubleSixGraph","IncidenceLines"]

levi=LeviGraph[lines]

RecognizeGraph@levi

Perspective

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

Bilateral

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

Circular

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

Planar

GraphData["SchlaefliDoubleSixGraph","Planar"]

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

MinimalCrossing

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

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

MinimalCrossing construction

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

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

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

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

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

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

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

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData["SchlaefliDoubleSixGraph","Circulant"]

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

Complement graph

GraphData["SchlaefliDoubleSixGraph","ComplementGraph","Name"]

Line graph

GraphData["SchlaefliDoubleSixGraph","Line"]

LineGraphQ[GraphData["SchlaefliDoubleSixGraph"]]//Timing

RootGraph

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

RootGraph[GraphData["SchlaefliDoubleSixGraph"]]

Halin

GraphData["SchlaefliDoubleSixGraph","Halin"]

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

Rigid

GraphData["SchlaefliDoubleSixGraph","Rigid"]

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

Flexible

GraphData["SchlaefliDoubleSixGraph","Flexible"]

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

LCF

GraphData["SchlaefliDoubleSixGraph","LCF"]

GraphData["SchlaefliDoubleSixGraph","LCFSignature"]

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

UnitDistance by refinement

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

UnitDistanceGraphEmbeddingQ[%]

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

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

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

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

UnitDistance FindSubgraphUnitDistanceEmbedding

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

gs=UniqueEmbeddings[l]

Matchstick

GraphData["SchlaefliDoubleSixGraph","Matchstick"]

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

3D default

Graph3D[GraphData["SchlaefliDoubleSixGraph","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["SchlaefliDoubleSixGraph","Polyhedral"]

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

GraphData

GraphClassString

GraphClassString["SchlaefliDoubleSixGraph"]

GraphDataString

Print[GraphDataString[g,
"Name"->"Schläfli double-sixes graph",
"StandardName"->{"SchlaefliDoubleSixGraph"},
"AlternateStandardName"->{"SchlafliDoubleSixesGraph"},
"NotationRules"->{"Configuration"->{{1,4,26,20,21},{1,5,25,10,8},{2,4,29,14,18},{2,6,25,11,9},{3,5,29,13,17},{3,6,26,24,23},{7,10,27,22,23},{7,11,30,15,17},{8,12,30,14,16},{9,12,27,20,19},{16,13,28,22,21},{18,15,28,24,19}}},
TimeConstraint->120,
Debug->True
]]