Tutte 12-Cage

Author

Eric W. Weisstein
November 10, 2023

This notebook downloaded from http://mathworld.wolfram.com/notebooks/GraphTheory/Tutte12-Cage.nb.

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

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

Configuration

{"GeneralizedHexagon", {2, 2}}

From Ed Pegg, Jr.
Mathematical Games, Episode 12: Configurations

GraphData["Tutte12Cage","Indidence"]

GraphData["Tutte12Cage"]

Embeddings

<<MathWorld`Graphs`

Names

GraphData["Tutte12Cage","StandardName"]

GraphData["Tutte12Cage","StandardNames"]

Primary

GraphData["Tutte12Cage"]//StyleGraphs

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["Tutte12Cage","EdgeList"]]

Default embedding

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

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

RecognizeGraph[g]

Degenerate

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

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

Perspective

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

Perspective construction

GraphData["Tutte12Cage","Polyhedron"]

Bilateral

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

Circular

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

Planar

GraphData["Tutte12Cage","Planar"]

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

MinimalCrossing

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

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

MinimalCrossing Quickcross from scratch [172]

QC -r 1 -z 100 -g

New best found: 194, at seed: 1
CR : 194
New best found: 193, at seed: 2
CR : 193
New best found: 190, at seed: 6
CR : 190
New best found: 188, at seed: 8
CR : 188
New best found: 186, at seed: 33
CR : 186
New best found: 180, at seed: 138
CR : 180
New best found: 177, at seed: 5534
CR : 177
New best found: 175, at seed: 137218
CR : 175
New best found: 174, at seed: 686983
CR : 174
New best found: 173, at seed: 1054256
CR : 173
New best found: 172, at seed: 2293363
CR : 172

Current best soln: 172, at seed: 2293363, current seed: 2845700

M. Haythorpe (pers. comm., May 3, 2019) also got this down to CR: 172 using QuickCross:
I ran QuickCross for a week on the Tutte 12-cage and it got down to 172 crossings. Unfortunately, for graphs of that size and symmetry, it seems that QuickCross is no longer able to find the minimal solution by simply running it over and over again. It would be quite fascinating to see how it would go if we started with Exoo's embedding.

MinimalCrossing Quickcross using Exoo's RCN = 166 embedding [165]

QC -e 5 -q tutte12cage_coords.txt -g tutte12cage.g6
CR : 165

QC -e 5 -q tutte12cage_coords.txt -g tutte12cage.g6 -o 3 -w tutte12cage_165-crossings.txt

ee=Cases[Import["/Users/eww/src/quickcross/tutte12cage_165-crossings.txt","Table"],{_Integer,_Integer}]

n=GraphData["Tutte12Cage","V"]

pn-n

Graph[Range[pn=Max[ee]],UndirectedEdge@@@ee,VertexStyle->Thread[Range[pn]->Join[Table[Blue,n],Table[Red,pn-n]]],GraphLayout->"TutteEmbedding"]

MinimalCrossing construction

Rule[#,RectilinearCrossingCount[#]]&/@Take[GraphData["Tutte12Cage","Graph","All"],-3]

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

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

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

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

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

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

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

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[g,"OuterFace"->#]&/@faces

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

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

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData["Tutte12Cage","Circulant"]

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

Line graph

GraphData["Tutte12Cage","Line"]

LineGraphQ[GraphData["Tutte12Cage"]]//Timing

RootGraph

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

RootGraph[GraphData["Tutte12Cage"]]

Halin

GraphData["Tutte12Cage","Halin"]

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

Rigid

GraphData["Tutte12Cage","Rigid"]

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

Flexible

GraphData["Tutte12Cage","Flexible"]

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

LCF

GraphData["Tutte12Cage","LCF"]

GraphData["Tutte12Cage","HamiltonianCycleCount"]

GraphData["Tutte12Cage","LCFSignature"]

GraphData["Tutte12Cage","LCFNotations"]

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

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

LCF compute random

FindRandomLCFNotation[GraphData["Tutte12Cage"],TimeConstraint->120]

FindRandomLCFNotation[GraphData["Tutte12Cage"],TimeConstraint->3600]

LCF compute 10^5

Tally[(lcf=LCF[GraphData["Tutte12Cage"],10^5])[[All,2]]]//Timing

MaxMemoryUsed[]/10.^9 "GB"

DeleteCases[lcf,{_,1}]

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

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

Length[gs]

gs

LCF compute 10^6

Tally[(lcf=LCF[GraphData["Tutte12Cage"],10^6])[[All,2]]]//Timing

MaxMemoryUsed[]/10.^9 "GB"

DeleteCases[lcf,{_,1}]

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

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

Length[gs]

gs

LCF compute 10^7

Tally[(lcf=LCF[GraphData["Tutte12Cage"],10^7])[[All,2]]]//Timing

MaxMemoryUsed[]/10.^9 "GB"

DeleteCases[lcf,{_,1}]

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

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

Length[gs]

gs

LCF compute all

Divisors[GraphData["Tutte12Cage","V"]]

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

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

MaxMemoryUsed[]/10.^9 "GB"

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

DeleteCases[lcf,{_,1}]

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

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

Length[gs]

gs

UnitDistance

GraphData["Tutte12Cage","UnitDistance"]

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

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

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

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

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

UnitDistance FindSubgraphUnitDistanceEmbedding

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

gs=UniqueEmbeddings[l]

Matchstick

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

3D default

Graph3D[GraphData["Tutte12Cage","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["Tutte12Cage","Polyhedral"]

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

Construction

RCN = 170 from GIF (in progress)

Believed to have RCN = 170: http://isu.indstate.edu/ge/COMBIN/RECTILINEAR/index.html

Show[img=ImageCrop[Import["http://isu.indstate.edu/ge/COMBIN/RECTILINEAR/cage12.png"]],ImageSize->Small]

Length[]

Mean[v[[{47,49}]]]

GraphData["Tutte12Cage",{"V","M","Cubic"}]

Re-evaluate

g=Graph[Range[126],UndirectedEdge@@@(e=Sort[Sort/@{{10,13},{10,27},{10,18},{5,8},{5,6},{5,24},{51,66},{66,76},{67,78},{59,67},{58,67},{119,122},{112,122},{114,122},{11,14},{14,15},{14,32},{7,18},{7,107},{53,54},{43,53},{53,70},{56,58},{54,56},{30,56},{33,41},{40,41},{41,84},{15,62},{15,34},{17,18},{17,19},{17,59},{33,42},{109,110},{109,111},{105,109},{75,106},{105,106},{106,123},{44,115},{2,44},{4,44},{6,9},{6,7},{31,32},{32,35},{50,60},{59,60},{60,93},{90,104},{103,104},{96,104},{107,112},{95,107},{94,105},{47,94},{84,95},{99,101},{99,100},{101,108},{117,121},{91,93},{90,93},{90,102},{88,91},{87,91},{87,114},{77,96},{76,97},{9,43},{13,16},{16,36},{48,54},{46,48},{48,52},{46,47},{45,46},{8,97},{61,108},{108,110},{111,113},{103,113},{97,113},{63,126},{71,118},{68,98},{68,69},{86,88},{75,78},{62,75},{58,79},{89,92},{92,94},{88,92},{37,102},{52,96},{80,83},{100,117},{80,100},{83,84},{83,89},{20,31},{79,80},{36,69},{40,69},{40,71},{34,72},{57,73},{102,120},{34,35},{35,37},{36,37},{73,81},{73,82},{74,81},{74,78},{74,68},{9,125},{12,45},{64,65},{45,124},{50,61},{61,126},{49,126},{49,57},{55,89},{55,57},{31,55},{110,111},{51,63},{63,65},{25,85},{82,103},{19,20},{4,20},{123,125},{120,125},{21,121},{121,124}}]),VertexCoordinates->v,VertexSize->{"Scaled",.005},VertexLabels->Placed["Name",Above]]

Length[e]

d=VertexDegree[g]

Position[d,0]//Flatten

Position[d,1]//Flatten

Position[d,2]//Flatten

Position[d,_?(GreaterThan[3])]//Flatten

RCN = 170

SetDirectory["/Users/eww/Documents/Mathematica/Paclets/GraphData/Collections/Exoo/"]

From Geoffrey Exoo, 2019-05-11

data=Import["Cage3,12_170.txt","CSV"];
v=data[[All,;;2]];
e=Union[Sort/@Flatten[MapIndexed[Thread[#2[[1]]->Drop[#,2]]&,data]]];
g=Graph[Range[Length[v]],UndirectedEdge@@@e,VertexCoordinates->v]//StyleGraphs[#,VertexSize->{"Scaled",.02}]&

r=RecognizeGraph[g]

RectilinearCrossingCount@g

DegenerateEmbeddingQ@g

v1=ToCommonEdges[g,GraphData[r]]

GetGraphData[r,"File"]

RCN = 167

SetDirectory["/Users/eww/Documents/Mathematica/Paclets/GraphData/Collections/Exoo/"]

From Geoffrey Exoo, 2019-05-12

data=Import["Cage3,12_167.txt","CSV"];
v=data[[All,;;2]];
e=Union[Sort/@Flatten[MapIndexed[Thread[#2[[1]]->Drop[#,2]]&,data]]];
g=Graph[Range[Length[v]],UndirectedEdge@@@e,VertexCoordinates->v]//StyleGraphs[#,VertexSize->{"Scaled",.02}]&

r=RecognizeGraph[g]

RectilinearCrossingCount@g

DegenerateEmbeddingQ@g

v2=ToCommonEdges[g,GraphData[r]]

RCN = 166

From Geoffrey Exoo, 2019-05-12

SetDirectory["/Users/eww/Documents/Mathematica/Paclets/GraphData/Collections/Exoo/"]

data=Import["Cage3,12_166.txt","CSV"];
v=data[[All,;;2]];
e=Union[Sort/@Flatten[MapIndexed[Thread[#2[[1]]->Drop[#,2]]&,data]]];
g=Graph[Range[Length[v]],UndirectedEdge@@@e,VertexCoordinates->v]//StyleGraphs[#,VertexSize->{"Scaled",.02}]&

r=RecognizeGraph[g]

RectilinearCrossingCount@g

DegenerateEmbeddingQ@g

v3=ToCommonEdges[g,GraphData[r]]

Export["/Users/eww/Documents/Mathematica/Paclets/GraphData/Quickcross/eww/tutte12cage_coords.txt",v3,"Table","FieldSeparators"->" "]

Export["/Users/eww/Documents/Mathematica/Paclets/GraphData/Quickcross/eww/tutte12cage_coords.g6",g,"Graph6"]

distanceregular.org

g=DistanceRegularGraph["http://www.distanceregular.org/graphdata/tutte12.am"]

RecognizeGraph[g]

VertexCount[g]

GraphDiameter[g]//Timing

RegularParameters[g]//Timing

DistanceRegularGraphQ[g]//Timing

IntersectionArray[g]//Timing

IntegerSpectrum[g]//SpectrumForm

GroupOrder[GraphAutomorphismGroup[g]]

HamiltonianGraphQ[g]

GraphData

GraphClassString

GraphClassString["Tutte12Cage"]