Tesseract Graph

Author

Eric W. Weisstein
August 18, 2026

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

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

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

Figures

All

nice=Pick[
GraphData["TesseractGraph","Graph","All"],
FreeQ[#,"Degenerate"|"LCF"|"MinimalCrossing"|"UnitDistance"|"Voltage"]&/@GraphData["TesseractGraph","EmbeddingClasses"]
];

GraphicsGrid[
Partition[StyleGraphs@nice,UpTo[5]],
Dividers->All
]

UnitDistance

GraphicsGrid[
Partition[StyleGraphs@GraphData["TesseractGraph","Graph","UnitDistance"],UpTo[4]],
Dividers->All
]

Voltage

voltage=Pick[
GraphData["TesseractGraph","Graph","All"],
Intersection[#,{"LCF","Voltage"}]==={"Voltage"}&/@GraphData["TesseractGraph","EmbeddingClasses"]
]

GraphicsGrid[
Partition[StyleGraphs@voltage,UpTo[4]],
Dividers->All
]

LCF

GraphicsGrid[
SplitBy[
StyleGraphs@GraphData["TesseractGraph","Graph","LCF"],
LCFNotation[#][[-1]]&
],
Dividers->All]

MinimalCrossing

GraphicsRow[
GraphCrossingDiagram/@GraphData["TesseractGraph","Graph","MinimalCrossing"],
Dividers->All
]

Embeddings

<<MathWorld`Graphs`

Names

GraphData["TesseractGraph","StandardName"]

GraphData["TesseractGraph","StandardNames"]

HouseOfGraphs

hogid=GraphData["TesseractGraph","NotationRules","HouseOfGraphs"]

HouseOfGraphsLookup[hogid]

HouseOfGraphsGraph[hogid]//StyleGraphs[#,ImageSize->Small]&

Wikidata

GraphData["TesseractGraph","WikidataID"]

GraphData["TesseractGraph","WikidataID","URL"]

Primary

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

Read and Wilson construction

g=Graph[Range[16],UndirectedEdge@@@{{1,2},{1,3},{1,5},{1,15},{2,4},{2,6},{2,16},{3,4},{3,7},{3,13},{4,8},{4,14},{5,6},{5,7},{5,11},{6,8},{6,12},{7,8},{7,9},{8,10},{9,10},{9,11},{9,13},{10,12},{10,14},{11,12},{11,15},{12,16},{13,14},{13,15},{14,16},{15,16}},VertexCoordinates->(10^(-4)){{8262,-16449},{8262,-4420},{10614,-18803},{10614,-2066},{12608,-12099},{12608,-8770},{14961,-14453},{14961,-6416},{18288,-14453},{18288,-6416},{20641,-12099},{20641,-8770},{22635,-18803},{22635,-2066},{24987,-16449},{24987,-4420}}]

RecognizeGraph@g

Combinatorica

ShowGraph[Hypercube[4],ImageSize->200]

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["TesseractGraph","EdgeList"]]

Default embedding

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

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

RecognizeGraph[g]

Degenerate

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

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

GeneralizedPetersen

GraphData["TesseractGraph","Graph","GeneralizedPetersen"]//StyleGraphs

IGraph

GraphData["TesseractGraph","Graph","IGraph"]//StyleGraphs

CompleteKPartite

GraphData["TesseractGraph","Graph","CompleteKPartite"]//StyleGraphs

Bipartite

GraphData["TesseractGraph","Bipartite"]

GraphData["TesseractGraph","Graph","Bipartite"]//StyleGraphs

Bipartite construction

GraphData["TesseractGraph","Bipartite"]

g=BipartiteGraph[GraphData["TesseractGraph"]]

RecognizeGraph@g

Bilateral

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

Circular

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

Planar

GraphData["TesseractGraph","Planar"]

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

CrossingNumber exact

CrossingNumber[GraphData["TesseractGraph"],Method->"Exact",TimeConstraint->3600]//AbsoluteTiming

CrossingNumber[GraphData["TesseractGraph"],Method->"Exact"]//AbsoluteTiming

FindCrossingNumber crossings.uos.de [verified 8]

FindCrossingNumber[GraphData["TesseractGraph"],Method->"WebCompute"]//AbsoluteTiming

DateString[]

MinimalCrossing

GraphData["TesseractGraph","CN"]

gs=GraphData["TesseractGraph","Graph","MinimalCrossing"]

GraphCrossingCount/@gs

GraphCrossingDiagram/@gs

MinimalCrossing construction

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

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

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

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

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

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

GraphPlot@

v={#/14,#2/15}&@@@{{0,0},{14,0},{1,3},{13,3},{4,5},{10,5},{6,7},{8,7},{6,9},{8,9},{4,11},{10,11},{4,13},{10,13},{0,15},{14,15}};
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[1,2,16,15,1,5,6,2,4,14,13,3,1],e[13,15,11,12,16,14],e[11,5,7,9,13],e[14,10,8,6],e[3,4,8,7,3],e[11,9,10,12,6]},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

RectilinearCrossingCount[g]

Minimal crossing construction Pegg

From Ed Pegg, Jr.
Aug 17, 2026

g0=Graph[GraphData["TesseractGraph","EdgeList"],VertexCoordinates->Thread[Range[16]->{{0,0},{1,0},{5/7,1/8},{1/8,2/7},{2/7,2/7},{5/7,2/7},{4/7,3/7},{3/7,3/7},{2/7,5/7},{5/7,5/7},{4/7,4/7},{3/7,4/7},{0,1},{1,1},{7/8,5/7},{2/7,7/8}}]]

Refined so edges are perpendicuat by E. Weisstein.

c=Join[CirclePoints[4],CirclePoints[{r,Pi/8},4],CirclePoints[3/8-1/16,4],CirclePoints[1/8,4]];

g=LabelGraph@FindCorrespondingGraph[g0,c/.r->.5,Debug->True]

v=c[[{4,1,7,12,3,8,9,2,13,5,16,6,11,10,14,15}]];

Solve[FullSimplify[Dot[v[[12]]-v[[5]],v[[3]]-v[[12]]]]==0,r]

N[%]

g=LabelGraph@FindCorrespondingGraph[g0,c/.r->(Sqrt[2]) Sin[(π/8)]]

RecognizeGraph@g

GraphCrossingCount@g

Minimal crossing construction Pegg 2

g=Graph[GraphData["TesseractGraph","EdgeList"],VertexCoordinates->Thread[Range[16]->{{0,0},{1,0},{1/14 (7+2 Sqrt[6]),5/14},{5/14,1/14 (7-2 Sqrt[6])},{1/98 (49-2 Sqrt[94]),45/98},{53/98,1/98 (49-2 Sqrt[94])},{1/686 (347+4 Sqrt[141]-2 Sqrt[2 (59-4 Sqrt[141])]),1/686 (339-4 Sqrt[141]-2 Sqrt[2 (59-4 Sqrt[141])])},{1/686 (339-4 Sqrt[141]-2 Sqrt[2 (59-4 Sqrt[141])]),1/686 (339-4 Sqrt[141]+2 Sqrt[2 (59-4 Sqrt[141])])},{45/98,1/98 (49+2 Sqrt[94])},{1/98 (49+2 Sqrt[94]),53/98},{1/686 (347+4 Sqrt[141]+2 Sqrt[2 (59-4 Sqrt[141])]),1/686 (347+4 Sqrt[141]-2 Sqrt[2 (59-4 Sqrt[141])])},{1/686 (339-4 Sqrt[141]+2 Sqrt[2 (59-4 Sqrt[141])]),1/686 (347+4 Sqrt[141]+2 Sqrt[2 (59-4 Sqrt[141])])},{0,1},{1,1},{9/14,1/14 (7+2 Sqrt[6])},{1/14 (7-2 Sqrt[6]),9/14}}]]

RecognizeGraph@g

GraphCrossingCount@g

DegenerateGraphEmbeddingTypes@g

MinimalRectilinearCrossing

GraphData["TesseractGraph","RCN"]

GraphData["TesseractGraph","Graph","MinimalRectilinearCrossing"]//StyleGraphs

MinimalRectilinearLocalCrossing

GraphData["TesseractGraph",{"LocalCrossingNumber","RectilinearLocalCrossingNumber"}]

GraphData["TesseractGraph","Graph","MinimalRectilinearLocalCrossing"]//StyleGraphs

Circulant

GraphData["TesseractGraph","Circulant"]

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

Line graph

GraphData["TesseractGraph","Line"]

LineGraphQ[GraphData["TesseractGraph"]]//Timing

RootGraph

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

RootGraph[GraphData["TesseractGraph"]]

Halin

GraphData["TesseractGraph","Halin"]

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

Rigid

GraphData["TesseractGraph","Rigid"]

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

Flexible

GraphData["TesseractGraph","Flexible"]

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

Voltage

gs=GraphData["TesseractGraph","Graph","Voltage"]//StyleGraphs

VoltageGraphNotation/@gs//Column

Voltage construction

gs=FindVoltageGraph[GraphData["TesseractGraph"],20,TimeConstraint->60,Debug->True]

gs=Drop[gs,-6]

DegenerateGraphEmbeddingQ/@%

LCF

GraphData["TesseractGraph","LCF"]

GraphData["TesseractGraph","HamiltonianCycleCount"]

GraphData["TesseractGraph","LCFSignature"]

GraphData["TesseractGraph","LCFNotations"]

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

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

LCF compute all

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

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

lcf

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[{BilateralLCFGraph@#,#}&,Map[LCFGraph@@#&,SplitBy[DeleteCases[lcf,{_,1}],Last],{2}],{2}],
(* order-1 bilateral only *)
DeleteMissing[BilateralLCFGraph@@@Cases[lcf,{_,1}]]}])//Timing

Length[gs]

UnitDistance

GraphData["TesseractGraph","UnitDistance"]

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

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

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

UnitDistance construction

g=GraphData["Q3","Graph","UnitDistance"][[1]]

e=List@@@EdgeList[g];

enew=UndirectedEdge@@@Union[e,e/.i_Integer:>i+8,Table[{i,i+8},{i,8}]];

v=GraphEmbedding[g];

Manipulate[System`Graph[Range[16],enew,VertexCoordinates->Join[v,r Through[{Cos,Sin}[q]]+#&/@v]],{q,0,2π},{{r,1},0,3}]

Function[{q,r},System`Graph[Range[16],enew,VertexCoordinates->Join[v,r Through[{Cos,Sin}[q]]+#&/@v]]]@@@{{2.75,1},{.79,.41},{.8,2.265}}

LabelGraph@

UnitDistance by refinement

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

UnitDistanceGraphEmbeddingQ[%]

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

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

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

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

UnitDistance by FindSubgraphUnitDistanceEmbedding

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

gs=SortBy[UniqueEmbeddings[l],Replace[RectilinearCrossingCount[#],Infinity->0]&]

gs={,};

Matchstick

GraphData["TesseractGraph","Matchstick"]

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

3D default

Graph3D[GraphData["TesseractGraph","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["TesseractGraph","Polyhedral"]

4D All

GraphData["TesseractGraph","Graph",{"4D","All"}]

4D UnitDistance

GraphData["TesseractGraph","Graph",{"4D","UnitDistance"}]

UnitDistanceGraphEmbeddingQ/@%

Construction

4-hypercube

Q4=RelationGraph[Total[Abs[#-#2]]==1&,v=Tuples[{0,1},4],VertexCoordinates->v]

UnitDistanceGraphEmbeddingQ@Q4

RecognizeGraph@Q4

ToCommonEdges[Q4,GraphData["Q4"]]

8-cell

v=Tuples[{0,1},4];

edges={{1,2},{1,3},{1,5},{1,9},{2,4},{2,6},{2,10},{3,4},{3,7},{3,11},{4,8},{4,12},{5,6},{5,7},{5,13},{6,8},{6,14},{7,8},{7,15},{8,16},{9,10},{9,11},{9,13},{10,12},{10,14},{11,12},{11,15},{12,16},{13,14},{13,15},{14,16},{15,16}};

g=Graph[Range@Length@v,UndirectedEdge@@@edges,VertexCoordinates->v]

RecognizeGraph@g

EdgeLengths[g]

Vertex deletion leads to other UD graphs

Q4=GraphData["TesseractGraph","Graph",{"Labeled","UnitDistance"}][[1]]

1

g1={#,RecognizeGraph[#]}&/@(VertexDelete[Q4,#]&/@Range[16])

Tally[g1[[All,2]]]

2

g2={#,RecognizeGraph[#]}&/@(VertexDelete[Q4,#]&/@Subsets[Range[16],{2}]);

Tally[g2[[All,2]]]

{"UnitDistance", {14,1}}

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

Cases[g2,{g_,{"UnitDistance",{14,1}}}:>g]

RhombicDodecahedralGraph

GraphData["RhombicDodecahedralGraph","Graph","UnitDistance"]

Cases[g2,{g_,"RhombicDodecahedralGraph"}:>g]

3

g3={#,RecognizeGraph[#]}&/@(VertexDelete[Q4,#]&/@Subsets[Range[16],{3}]);

Tally[g3[[All,2]]]

4

g4={#,RecognizeGraph[#]}&/@(VertexDelete[Q4,#]&/@Subsets[Range[16],{4}]);

Tally[g4[[All,2]]]

{"Grid",{2,2,3}}

GraphData[{"Grid",{2,2,3}},"Graph","UnitDistance"]

Cases[g4,{g_,{"Grid",{2,2,3}}}:>g]

{"Prism",6}

GraphData[{"Prism",6},"Graph","UnitDistance"]

Cases[g4,{g_,{"Prism",6}}:>g]

{"EdgeTransitive",{12,3}}

GraphData[{"EdgeTransitive",{12,3}},"Graph","UnitDistance"]

Cases[g4,{g_,{"EdgeTransitive",{12,3}}}:>g]

5

g5={#,RecognizeGraph[#]}&/@(VertexDelete[Q4,#]&/@Subsets[Range[16],{5}]);

Tally[g5[[All,2]]]

{"MongolianTent",{2,5}}

GraphData[{"MongolianTent",{2,5}},"Graph","UnitDistance"]

Cases[g5,{g_,{"MongolianTent",{2,5}}}:>g]

6

g6={#,RecognizeGraph[#,"Cache"->"InternalOnly"]}&/@(VertexDelete[Q4,#]&/@Subsets[Range[16],{6}]);

Tally[g6[[All,2]]]

{Ladder,5}

GraphData[{"Ladder",5},"Graph","UnitDistance"]

Cases[g6,{g_,{"Ladder",5}}:>g]

{"MongolianTent",{3,3}}

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

Cases[g6,{g_,{"MongolianTent",{3,3}}}:>g]

PaschGraph

GraphData["PaschGraph","Graph","UnitDistance"]

Cases[g6,{g_,"PaschGraph"}:>g]

7

g7={#,RecognizeGraph[#,"Cache"->"InternalOnly"]}&/@(VertexDelete[Q4,#]&/@Subsets[Range[16],{7}]);

Tally[g7[[All,2]]]

{9,790}

GraphData[{9,790},"Graph","All"]

{"Caveman",{3,3}}

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

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

Cases[g7,{g_,{"Caveman",{3,3}}}:>g]

v=Join[CirclePoints[{Csc[Pi/6]/2,π/2},6],CirclePoints[2,3]];
e=Select[Subsets[Range[Length[v]],{2}],Abs[EuclideanDistance@@v[[#]]-1]<.01&];
g=Graph[Range[Length[v]],UndirectedEdge@@@e,VertexCoordinates->v,VertexLabels->"Name"]

RecognizeGraph[g]

{"Grid",{3,3}}

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

Cases[g7,{g_,{"Grid",{3,3}}}:>g]

GraphData

GraphDataClassString

GraphDataClassString["TesseractGraph"]