Dice Graphs

Author

Eric W. Weisstein
July 26, 2026

This notebook downloaded from https://mathworld.wolfram.com/notebooks/GraphTheory/DiceGraphs.nb.

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

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

Figure

GraphData["Dice*"]

GraphicsRow[
StyleGraphs[GraphData/@GraphData["Dice*"]],
Dividers->All
]

Embeddings (merge)

1

Primary

GraphData[{"Dice",1}]//StyleGraphs

All

GraphData[{"Dice",1},"EmbeddingClasses"]

GraphicsRow[GraphData[{"Dice",1},"Graph","All"]//StyleGraphs]

LCF

GraphData[{"Dice",1},"LCFSignature"]

GraphData[{"Dice",1},"LCFNotations"]

GraphData[{"Dice",1},"Graph","LCF"]//StyleGraphs

MinimalCrossing

GraphData[{"Dice",1},"CN"]

GraphData[{"Dice",1},"Graph","MinimalCrossing"]//StyleGraphs

MinimalRectilinearCrossing = MinimalCrossing

GraphData[{"Dice",1},"RCN"]

GraphData[{"Dice",1},"Graph","MinimalRectilinearCrossing"]//StyleGraphs

UnitDistance

GraphData[{"Dice",1},"Graph","UnitDistance"]//StyleGraphs

2

Primary

GraphData[{"Dice",2}]//StyleGraphs

All

GraphData[{"Dice",2},"EmbeddingClasses"]

GraphicsRow[GraphData[{"Dice",2},"Graph","All"]//StyleGraphs]

LCF

GraphData[{"Dice",2},"LCFSignature"]

GraphData[{"Dice",2},"LCFNotations"]

GraphData[{"Dice",2},"Graph","LCF"]//StyleGraphs

MinimalCrossing

GraphData[{"Dice",2},"CN"]

GraphData[{"Dice",2},"Graph","MinimalCrossing"]//StyleGraphs

MinimalRectilinearCrossing = MinimalCrossing

GraphData[{"Dice",2},"RCN"]

GraphData[{"Dice",2},"Graph","MinimalRectilinearCrossing"]//StyleGraphs

UnitDistance

GraphData[{"Dice",2},"Graph","UnitDistance"]//StyleGraphs

3

Primary

GraphData[{"Dice",3}]//StyleGraphs

All

GraphData[{"Dice",3},"EmbeddingClasses"]

GraphicsRow[GraphData[{"Dice",3},"Graph","All"]//StyleGraphs]

LCF

GraphData[{"Dice",3},"LCFSignature"]

GraphData[{"Dice",3},"LCFNotations"]

GraphData[{"Dice",3},"Graph","LCF"]//StyleGraphs

MinimalCrossing

GraphData[{"Dice",3},"CN"]

GraphData[{"Dice",3},"Graph","MinimalCrossing"]//StyleGraphs

MinimalRectilinearCrossing = MinimalCrossing

GraphData[{"Dice",3},"RCN"]

GraphData[{"Dice",3},"Graph","MinimalRectilinearCrossing"]//StyleGraphs

UnitDistance

GraphData[{"Dice",3},"Graph","UnitDistance"]//StyleGraphs

4

Primary

GraphData[{"Dice",4}]//StyleGraphs

All

GraphData[{"Dice",4},"EmbeddingClasses"]

GraphicsRow[GraphData[{"Dice",4},"Graph","All"]//StyleGraphs]

LCF

GraphData[{"Dice",4},"LCFSignature"]

GraphData[{"Dice",4},"LCFNotations"]

GraphData[{"Dice",4},"Graph","LCF"]//StyleGraphs

MinimalCrossing

GraphData[{"Dice",4},"CN"]

GraphData[{"Dice",4},"Graph","MinimalCrossing"]//StyleGraphs

MinimalRectilinearCrossing = MinimalCrossing

GraphData[{"Dice",4},"RCN"]

GraphData[{"Dice",4},"Graph","MinimalRectilinearCrossing"]//StyleGraphs

UnitDistance

GraphData[{"Dice",4},"Graph","UnitDistance"]//StyleGraphs

Embeddings

{"Dice", 1}

GraphData[{"Dice",1},{"RCN","CN"}]

GraphData[{"Dice",1},"Graph","MinimalCrossing"]

GraphData[{"Dice",1},"Graph","LCF"]

GraphData[{"Dice",1},"Graph","UnitDistance"]

GraphData[{"Dice",1},"Graph","All"]

UnitDistanceEmbeddingRefine/@%

UnitDistanceGraphEmbeddingQ/@%

GraphPlot[GraphData[{"Dice",1}]]

GraphPlot[GraphData[{"Dice",1},"EdgeList"]]

UnitDistanceEmbeddingRefine@GraphicsToGraph@%

UnitDistanceGraphEmbeddingQ@%

(ud=FindUnitDistanceEmbedding[GraphData[{"Dice",1}],MaxIterations->10000])//Timing

UnitDistanceGraphEmbeddingQ@ud

FindUnitDistanceEmbedding[GraphData[{"Dice",1}],20]

l=FindSubgraphUnitDistanceEmbedding[{"Dice",1},"Results"->All]//Timing

gs=UniqueEmbeddings[l]

{"Dice", 2}

GraphData[{"Dice",2},{"TriangleCount","SquareCount"}]

GraphData[{"Dice",2},"Graph","UnitDistance"]

GraphData[{"Dice",2},"Graph","All"]

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

FindUnitDistanceEmbedding[GraphData[{"Dice",2}],20]

{"Dice", 3}

GraphData[{"Dice",3},{"TriangleCount","SquareCount"}]

GraphData[{"Dice",3},"Graph","UnitDistance"]

GraphData[{"Dice",3},"Graph","All"]

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

FindUnitDistanceEmbedding[GraphData[{"Dice",3}],20]

{"Dice", 4}

GraphData[{"Dice",4},{"TriangleCount","SquareCount"}]

GraphData[{"Dice",4},"Graph","UnitDistance"]

GraphData[{"Dice",4},"Graph","All"]

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

FindUnitDistanceEmbedding[GraphData[{"Dice",4}],20]

Construction

Robertson et al. 2019

1

v=Delete[Join[Delete[Union@@Table[CirclePoints[{0,Sqrt[3]i},1,6],{i,-2,2}],List/@{11,17,6,12}],
{{(3/2),-((Sqrt[3])/2)},{(3/2),((Sqrt[3])/2)},-{(3/2),((Sqrt[3])/2)},{-(3/2),((Sqrt[3])/2)},{2,0},{-2,0},{3,0},{-3,0},{0,3(Sqrt[3])},{0,-3(Sqrt[3])}}],List/@{1,14}];
d1=Graph[Range[Length[v]],UndirectedEdge@@@Sort[{{5,9},{9,14},{10,14},{6,10},{2,6},{2,5},{1,5},{9,13},{1,26},{13,26},{13,23},{1,24},{21,23},{22,24},{19,22},{2,19},{14,17},{17,21},{6,20},{10,18},{4,24},{4,25},{16,25},{16,23},{20,22},{3,20},{3,8},{8,12},{12,15},{15,18},{18,21},{4,8},{12,16},{7,19},{11,17},{7,11},{3,7},{11,15},{25,26}}],VertexCoordinates->v,VertexLabels->"Name"]

CubicGraphQ[d1]

RecognizeGraph[d1]

2

v=Delete[Join[Delete[Union@@Table[CirclePoints[{0,Sqrt[3]i},1,6],{i,-2,2}],List/@{11,17,6,12}],
{{(3/2),-((Sqrt[3])/2)},{(3/2),((Sqrt[3])/2)},-{(3/2),((Sqrt[3])/2)},{-(3/2),((Sqrt[3])/2)},{2,0},{-2,0},{3,0},{-3,0},{0,3(Sqrt[3])},{0,-3(Sqrt[3])}}],List/@{4,17,19,21}];
v=Join[v,Midpoint/@{v[[{22,20}]],v[[{21,19}]]}];
d2=Graph[Range[Length[v]],UndirectedEdge@@@Sort[{{20,25},{22,25},{19,26},{21,26},{4,22},{4,23},{16,23},{16,21},{2,22},{2,24},{14,24},{14,21},{2,5},{5,9},{9,14},{4,8},{8,12},{12,16},{3,5},{3,20},{9,15},{15,19},{18,20},{8,18},{12,17},{17,19},{1,18},{1,6},{3,6},{6,10},{10,15},{10,13},{13,17},{1,7},{7,11},{11,13},{7,25},{11,26},{23,24}}],VertexCoordinates->v,VertexLabels->"Name"]

CubicGraphQ[d2]

RecognizeGraph[d2]

3

v=Join[Delete[Union@@Table[CirclePoints[{0,Sqrt[3]i},1,6],{i,-2,2}],List/@{11,17,6,12}],
{{(3/2),-((Sqrt[3])/2)},{(3/2),((Sqrt[3])/2)},-{(3/2),((Sqrt[3])/2)},{-(3/2),((Sqrt[3])/2)},{2,0},{-2,0},{3,0},{-3,0},{0,3(Sqrt[3])},{0,-3(Sqrt[3])}}];
d31=Graph[Range[Length[v]],UndirectedEdge@@@Sort[{{5,27},{18,27},{5,9},{9,13},{13,18},{15,28},{10,15},{6,10},{2,6},{2,28},{2,26},{5,26},{18,25},{15,25},{3,6},{3,21},{21,24},{22,24},{4,22},{4,9},{24,26},{23,25},{10,16},{16,19},{19,23},{20,23},{17,20},{13,17},{3,7},{7,12},{12,17},{11,16},{8,11},{4,8},{1,7},{1,22},{1,21},{1,8},{11,14},{14,20},{12,14},{14,19},{27,28}}],VertexCoordinates->v,VertexLabels->"Name"]

d3=IndexGraph@EdgeAdd[VertexDelete[d31,{1,14}],{7\[UndirectedEdge]22,8\[UndirectedEdge]21,12\[UndirectedEdge]19,11\[UndirectedEdge]20}]

CubicGraphQ[d3]

RecognizeGraph[d3]

4

v=Join[Delete[Join[Delete[Union@@Table[CirclePoints[{0,Sqrt[3]i},1,6],{i,-2,2}],List/@{11,17,6,12}],
{{(3/2),-((Sqrt[3])/2)},{(3/2),((Sqrt[3])/2)},-{(3/2),((Sqrt[3])/2)},{-(3/2),((Sqrt[3])/2)},{2,0},{-2,0},{3,0},{-3,0},{0,3(Sqrt[3])},{0,-3(Sqrt[3])}}],List/@{19,22,17,3}],Mean/@{v[[{20,22}]],v[[{19,21}]]}];
d4=Graph[Range[Length[v]],UndirectedEdge@@@Sort[{{2,24},{2,5},{5,9},{9,14},{14,24},{4,8},{8,12},{12,16},{16,23},{4,23},{4,22},{22,25},{20,25},{19,26},{21,26},{16,21},{14,21},{2,22},{5,18},{18,20},{3,20},{3,8},{12,17},{17,19},{9,15},{15,19},{3,7},{7,10},{10,15},{1,6},{1,18},{1,7},{6,11},{11,13},{10,13},{13,17},{23,24},{6,25},{11,26}}],VertexCoordinates->v,VertexLabels->"Name"]

CubicGraphQ[d4]

RecognizeGraph[d4]

GraphData

GraphDataClassString

GraphDataClassString[GraphData["Dice*"]]

GraphDataString

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

Do[WriteString[file,GraphDataString[{d1,d2,d3,d4}[[n]],
"StandardName"->{"Dice",n},
"Name"->"dice graph "<>ToString[n],
TimeConstraint->10,
Debug->True,
"Skip"->{"Arboricity"}
]],{n,4}]

Close[file]