Grinberg Graphs

Author

Eric W. Weisstein
August 24, 2022

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

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

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

Graph

grinberg=GraphData["Grinb*"]

GraphData[#,{"VertexConnectivity","Cubic","Hamiltonian"}]&/@grinberg

GraphicsRow[Show[StyleGraphs@GraphData[#],PlotLabel->Style[GraphData[#,"Name"],Directive[14,Black,FontFamily->"Times",Italic]]]&/@grinberg,ImageSize->500,Dividers->All]

Embeddings

"GrinbergGraph42"

GraphData["GrinbergGraph42","StandardName"]

All

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

Construction from Read and Wilson

g=Graph[Range[42],UndirectedEdge@@@{{1,2},{1,3},{1,41},{2,4},{2,42},{3,5},{3,19},{4,8},{4,24},{5,6},{5,17},{6,7},{6,9},{7,8},{7,10},{8,18},{9,11},{9,12},{10,11},{10,13},{11,14},{12,15},{12,17},{13,16},{13,18},{14,15},{14,16},{15,21},{16,22},{17,20},{18,23},{19,20},{19,39},{20,25},{21,22},{21,27},{22,28},{23,24},{23,26},{24,40},{25,30},{25,35},{26,31},{26,38},{27,29},{27,30},{28,29},{28,31},{29,32},{30,33},{31,34},{32,33},{32,34},{33,36},{34,37},{35,36},{35,39},{36,37},{37,38},{38,40},{39,41},{40,42},{41,42}},VertexCoordinates->(10^(-4)){{4069,-23618},{4069,-1364},{6063,-21623},{6063,-3359},{8057,-19628},{8057,-13488},{8057,-11494},{8057,-5354},{10090,-14525},{10090,-10457},{11126,-12491},{12123,-15561},{12123,-9421},{13120,-12491},{14156,-14525},{14156,-10457},{14195,-19628},{14195,-5354},{16189,-21623},{16189,-19628},{16189,-13488},{16189,-11494},{16189,-5354},{16189,-3359},{18183,-19628},{18183,-5354},{18222,-14525},{18222,-10457},{19257,-12491},{20254,-15561},{20254,-9421},{21251,-12491},{22287,-14525},{22287,-10457},{24320,-19628},{24320,-13488},{24320,-11494},{24320,-5354},{26314,-21623},{26314,-3359},{28308,-23618},{28308,-1364}}]

RecognizeGraph@g

Planar

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

Tutte embeddings

faces=IGFaces[GraphData["GrinbergGraph42"]]

Union[Length/@faces]

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

gs={RotateGraph[,3Pi/8],RotateGraph[,4Pi/5]}

Halin

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

LCF

GraphData["GrinbergGraph42","LCFSignature"]

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

UnitDistance

GraphData["GrinbergGraph42","UnitDistance"]

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

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

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

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

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

UnitDistance FindSubgraphUnitDistanceEmbedding

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

gs=UniqueEmbeddings[l]

Matchstick

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

MinimalCrossing

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

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

Default embedding

g=Graph@GraphData["GrinbergGraph42","Edges"]

ShowLabeledGraph[g2=AddEdges[DeleteVertices[g,{2,11}],{{1,2},{9,10}}]]

CubicQ[g2]

RecognizeGraph[g2]

GraphData[{"Cubic",{42,1}},"AllImages"]

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

RecognizeGraph[g]

MinimalCrossing construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData["GrinbergGraph42"]]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData["GrinbergGraph42","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

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

Graphics3D[{FaceForm[Green,Red],GraphData["GrinbergGraph42","Polyhedron"]}]

3D Canonical

GraphData["GrinbergGraph42","Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData["GrinbergGraph42","Polyhedron"],Yellow,Sphere[]}]

3D Polyhedron construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData["GrinbergGraph42"],-1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->1000,MaxIterations->10000,PrecisionGoal->20])//Timing

SimplePolyhedronQ[can]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

"GrinbergGraph44"

GraphData["GrinbergGraph44","StandardName"]

All

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

Construction from Read and Wilson

Default embedding

g=Graph@GraphData["GrinbergGraph44","Edges"]

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

RecognizeGraph[g]

Planar

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

Tutte embeddings

faces=IGFaces[GraphData["GrinbergGraph44"]]

Union[Length/@faces]

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

gs={RotateGraph[,3Pi/6],RotateGraph[,2Pi/5]}

Halin

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

LCF

GraphData["GrinbergGraph44","LCFSignature"]

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

UnitDistance

GraphData["GrinbergGraph44","UnitDistance"]

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

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

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

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

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

UnitDistance FindSubgraphUnitDistanceEmbedding

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

gs=UniqueEmbeddings[l]

Matchstick

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

MinimalCrossing

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

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

Triangle boundary

ShowLabeledGraph[h=AddEdges[AddVertices[AddEdges[AddVertices[EmptyGraph[6],
Join[{{0,0}},
(Mean/@Partition[Vertices[EmptyGraph[6]],2,1,1]),
Flatten[Function[p,
Flatten[{#,{-First[#],Last[#]}}&/@(RotationMatrix[2Pi#/3].p&/@Range[0,2]),1]]/@{{-1,.855},{-.8,1.2},{-.6,1.5},{-.9,1.9}},1],
RotationMatrix[2Pi#/3].{0,3.46}&/@Range[0,2],
{{0,4.5}}]
],
Flatten[Partition[#,2,1]&/@{{31,25,19,14,20,26},{27,21,15,18,24,30},{28,22,16,17,23,29},{39,34,35,40,36,33,38,32,37,39},
{37,31,28,34},
{36,30,29,35},{3,9,2,8,1,13,6,12,5,11,4,10,3},
{32,26,27,33},{39,41,40},{41,38},{7,13},{7,9},{7,11}},1]
],RotationMatrix[2Pi#/3].{0,1.2}&/@Range[0,2]
],{{20,42},{42,21},{42,8},{25,43},{43,22},{43,10},{23,44},{44,24},{12,44},{1,15},{14,2},{6,18},{17,5},{3,19},{16,4}}
],AspectRatio->Automatic,VertexStyle->Disk[.02]]

Degrees[h]

Flatten[Position[Degrees[h],Except[3],Heads->False]]

PadVertices@Vertices[h//Chop]

Square boundary

ShowLabeledGraph[g=AddEdges[Graph[List/@{{1,5},{1,8},{2,11},{3,14},{4,16},{7,21},{15,29},{9,22},{10,24},{13,28},{6,20},{17,30},{19,34},{12,26},{18,32},{38,42},{33,44},{25,40},{35,37},{31,43},{27,41},{23,39},{20,36},{21,36}},List/@{{21,409},{217,409},{416,411},{419,22},{26,22},{70,71},{70,218},{71,365},{118,361},{171,364},{216,364},{265,366},{313,363},{364,362},{367,217},{369,68},{316,70},{270,70},{171,69},{117,69},{115,216},{117,289},{134,313},{146,331},{222,331},{284,334},{299,313},{312,295},{317,215},{319,140},{302,122},{289,102},{218,101},{145,101},{132,118},{116,133},{172,169},{172,217},{174,269},{220,269},{267,269},{267,217},{269,167},{220,168}}/400.],
Join[Partition[Range[20],2,1],
Partition[Range[21,36],2,1],
Partition[Range[37,44],2,1,1]]
]
]

Position[Degrees[g],Except[3],Heads->False]//Flatten

HamiltonianQ[g]

RecognizeGraph[g]

GraphData["GrinbergGraph44","AllImages"]

MinimalCrossing Construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData["GrinbergGraph44"]]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData["GrinbergGraph44","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

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

Graphics3D[{FaceForm[Green,Red],GraphData["GrinbergGraph44","Polyhedron"]}]

3D Canonical

GraphData["GrinbergGraph44","Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData["GrinbergGraph44","Polyhedron"],Yellow,Sphere[]}]

3D Polyhedron construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData["GrinbergGraph44"],1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->1000,MaxIterations->10000,PrecisionGoal->20])//Timing

SimplePolyhedronQ[can]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

"GrinbergGraph46"

GraphData["GrinbergGraph46","StandardName"]

All

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

Planar

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

Tutte embeddings

faces=IGFaces[GraphData["GrinbergGraph46"]]

Union[Length/@faces]

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

gs={,RotateGraph[,Pi/8],RotateGraph[,-4Pi/5]}

MinimalCrossing

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

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

MinimalCrossing Construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData["GrinbergGraph46"]]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Halin

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

LCF

GraphData["GrinbergGraph46","LCFSignature"]

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

UnitDistance

GraphData["GrinbergGraph46","UnitDistance"]

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

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

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

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

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

UnitDistance FindSubgraphUnitDistanceEmbedding

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

gs=UniqueEmbeddings[l]

Matchstick

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

Default embedding

g=Graph@GraphData["GrinbergGraph46","Edges"]

l=Graphics[{{Line[{{{15719.000000,-10207.000000},{15719.000000,-8837.000000}}}],Line[{{{15719.000000,-8837.000000},{14534.000000,-8152.000000}}}],Line[{{{15719.000000,-8837.000000},{16904.000000,-8152.000000}}}],Line[{{{18456.000000,-13582.000000},{17430.000000,-11802.000000}}}],Line[{{{19868.000000,-11234.000000},{18682.000000,-10549.000000}}}],Line[{{{21194.000000,-8837.000000},{19141.000000,-8837.000000}}}],Line[{{{18456.000000,-4093.000000},{17430.000000,-5872.000000}}}],Line[{{{12982.000000,-4093.000000},{14008.000000,-5872.000000}}}],Line[{{{10244.000000,-8837.000000},{12297.000000,-8837.000000}}}],Line[{{{12982.000000,-13582.000000},{14008.000000,-11802.000000}}}],Line[{{{15719.000000,-15000.000000},{15719.000000,-12261.000000}}}],Line[{{{14008.000000,-5872.000000},{14864.000000,-5642.000000}}}],Line[{{{14864.000000,-5642.000000},{15719.000000,-5413.000000}}}],Line[{{{16574.000000,-5642.000000},{15719.000000,-5413.000000}}}],Line[{{{16574.000000,-5642.000000},{17430.000000,-5872.000000}}}],Line[{{{16574.000000,-5642.000000},{16187.000000,-7550.000000}}}],Line[{{{15251.000000,-7550.000000},{14864.000000,-5642.000000}}}],Line[{{{14839.000000,-9886.000000},{13382.000000,-11176.000000}}}],Line[{{{12527.000000,-9693.000000},{14371.000000,-9075.000000}}}],Line[{{{12527.000000,-9693.000000},{12297.000000,-8837.000000}}}],Line[{{{12527.000000,-9693.000000},{12756.000000,-10549.000000}}}],Line[{{{13382.000000,-11176.000000},{12756.000000,-10549.000000}}}],Line[{{{14008.000000,-11802.000000},{13382.000000,-11176.000000}}}],Line[{{{17067.000000,-9075.000000},{18911.000000,-9693.000000}}}],Line[{{{18056.000000,-11176.000000},{16599.000000,-9886.000000}}}],Line[{{{18056.000000,-11176.000000},{17430.000000,-11802.000000}}}],Line[{{{18056.000000,-11176.000000},{18682.000000,-10549.000000}}}],Line[{{{18911.000000,-9693.000000},{18682.000000,-10549.000000}}}],Line[{{{19141.000000,-8837.000000},{18911.000000,-9693.000000}}}],Line[{{{19141.000000,-8837.000000},{18682.000000,-7125.000000}}}],Line[{{{18682.000000,-7125.000000},{17430.000000,-5872.000000}}}],Line[{{{12756.000000,-7125.000000},{12297.000000,-8837.000000}}}],Line[{{{14008.000000,-5872.000000},{12756.000000,-7125.000000}}}],Line[{{{15719.000000,-12261.000000},{17430.000000,-11802.000000}}}],Line[{{{14008.000000,-11802.000000},{15719.000000,-12261.000000}}}],Line[{{{16904.000000,-8152.000000},{16187.000000,-7550.000000}}}],Line[{{{16187.000000,-7550.000000},{15251.000000,-7550.000000}}}],Line[{{{15251.000000,-7550.000000},{14534.000000,-8152.000000}}}],Line[{{{14534.000000,-8152.000000},{14371.000000,-9075.000000}}}],Line[{{{14371.000000,-9075.000000},{14839.000000,-9886.000000}}}],Line[{{{14839.000000,-9886.000000},{15719.000000,-10207.000000}}}],Line[{{{15719.000000,-10207.000000},{16599.000000,-9886.000000}}}],Line[{{{16599.000000,-9886.000000},{17067.000000,-9075.000000}}}],Line[{{{17067.000000,-9075.000000},{16904.000000,-8152.000000}}}],Line[{{{19458.000000,-3041.000000},{18456.000000,-4093.000000}}}],Line[{{{12982.000000,-4093.000000},{11980.000000,-3041.000000}}}],Line[{{{18456.000000,-13582.000000},{19868.000000,-11234.000000}}}],Line[{{{19868.000000,-11234.000000},{21194.000000,-8837.000000}}}],Line[{{{19458.000000,-3041.000000},{11980.000000,-3041.000000}}}],Line[{{{8833.000000,-8495.000000},{12572.000000,-14976.000000}}}],Line[{{{12982.000000,-13582.000000},{12572.000000,-14976.000000}}}],Line[{{{12572.000000,-14976.000000},{15719.000000,-15000.000000}}}],Line[{{{8833.000000,-8495.000000},{10244.000000,-8837.000000}}}],Line[{{{18866.000000,-14976.000000},{22605.000000,-8495.000000}}}],Line[{{{21194.000000,-8837.000000},{22605.000000,-8495.000000}}}],Line[{{{18866.000000,-14976.000000},{18456.000000,-13582.000000}}}],Line[{{{15719.000000,-15000.000000},{18866.000000,-14976.000000}}}],Line[{{{15719.000000,-4043.000000},{12982.000000,-4093.000000}}}],Line[{{{18456.000000,-4093.000000},{15719.000000,-4043.000000}}}],Line[{{{15719.000000,-4043.000000},{15719.000000,-5413.000000}}}],Line[{{{11571.000000,-11234.000000},{12982.000000,-13582.000000}}}],Line[{{{10244.000000,-8837.000000},{11571.000000,-11234.000000}}}],Line[{{{11571.000000,-11234.000000},{12756.000000,-10549.000000}}}],Line[{{{21053.000000,-5755.000000},{19458.000000,-3041.000000}}}],Line[{{{22605.000000,-8495.000000},{21053.000000,-5755.000000}}}],Line[{{{21053.000000,-5755.000000},{18682.000000,-7125.000000}}}],Line[{{{10385.000000,-5755.000000},{8833.000000,-8495.000000}}}],Line[{{{11980.000000,-3041.000000},{10385.000000,-5755.000000}}}],Line[{{{10385.000000,-5755.000000},{12756.000000,-7125.000000}}}]}}];

g=LinesToGraph[l]

ShowGraph[g]

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

RecognizeGraph[g]

3D default

Graph3D[GraphData["GrinbergGraph46","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

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

Graphics3D[{FaceForm[Green,Red],GraphData["GrinbergGraph46","Polyhedron"]}]

3D Canonical

GraphData["GrinbergGraph46","Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData["GrinbergGraph46","Polyhedron"],Yellow,Sphere[]}]

3D Polyhedron construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData["GrinbergGraph46"],1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->1000,MaxIterations->10000,PrecisionGoal->20])//Timing

SimplePolyhedronQ[can]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]