Hexahedral Graph

Author

Eric W. Weisstein
July 21, 2023

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

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

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

Hexahedral graphs

V6

ShowGraphArray[Partition[Graph/@GraphData["Polyhedral",6],7,7,{1,1},{}],ImageSize->500]

GraphData["Polyhedral",6]

DeleteCases[%,{_Integer,_Integer}]

V13

hexahedral=GraphData["Polyhedral",6]

GraphicsGrid[Partition[Show[StyleGraphs@GraphData[#],PlotLabel->TextCell[GraphData[#,"Name"],PageWidth->120,TextAlignment->Center],LabelStyle->{Black,"FontFamily"->"Times",Italic}]&/@hexahedral,UpTo[4]],Dividers->All,ImageSize->500]

Duals

Select[hexahedral,!DataPaclets`GraphDataDump`MyGraphQ[GraphData[#,"DualGraph","Name"]]&]

GraphicsGrid[Partition[Show[StyleGraphs@GraphData[dual=GraphData[#,"DualGraph","Name"]],PlotLabel->TextCell[GraphData[dual,"Name"],PageWidth->120,TextAlignment->Center],LabelStyle->{Black,"FontFamily"->"Times",Italic}]&/@hexahedral,UpTo[4]],Dividers->All,Alignment->Top,ImageSize->500]

Embeddings

GraphData["Polyhedral",6]//Length

{"Hexahedral", 1} == {"Wheel", 6}

GraphData[{"Hexahedral",1},"StandardName"]

{"Hexahedral", 2} == {"Prism", 3}

GraphData[{"Hexahedral",2},"StandardName"]

{"Hexahedral", 3} == {"PathComplement", 6}

GraphData[{"Hexahedral",3},"StandardName"]

{"Hexahedral", 4}

GraphData[{"Hexahedral",4},"StandardName"]

Primary

GraphData[{"Hexahedral",4}]//StyleGraphs[#,ImageSize->Small]&

All

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

Planar

GraphData[{"Hexahedral",4},"Planar"]

GraphData[{"Hexahedral",4},"Graph","Planar"]//StyleGraphs

Tutte embeddings

<<IGraphM`

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"Hexahedral",4}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"Hexahedral",4}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{,,,}

Tutte embedding construction 3 #1

GraphPlot[RotateGraph[]]

v=Join[{{-1,0},{1,0},{0,Sqrt[3]},{-1/2,1/2},{1/2,1/2},{0,1}}];
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[1,2,3,1,4,5,3,4,6,5,2],{3,6}},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

Tutte embedding construction 3 #2

GraphPlot[RotateGraph[]]

v=Join[UnitCirclePoints[3],CirclePoints[1/4,3]];
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[5,1,2,3,1,4,5,6,4],e[6,3,5,2]},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

Tutte embedding construction 3 #3

GraphPlot[RotateGraph[,-2Pi/3]]

v=Join[{{-1,0},{1,0},{0,Sqrt[3]},{-1/4,3/4},{0,3/4},{1/4,3/4}}];
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[1,2,3,1,4,3,6,2],e[3,5,1],e[4,5,6]},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

Tutte embedding construction 3 #4

GraphPlot[RotateGraph[]]

v=Join[{{-1,0},{1,0},{0,Sqrt[3]},{-1/4,3/4},{0,3/4},{1/4,3/4}}];
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[1,2,3,1,4,5,6,2,4,3,6],{3,5}},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

LCF

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

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

UnitDistance

GraphData[{"Hexahedral",4},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"Hexahedral",4}],Debug->True]//Timing

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

Matchstick

GraphData[{"Hexahedral",4},"Graph","Matchstick"]//StyleGraphs

Default embedding

g=Graph@GraphData[{"Hexahedral",4},"Edges"]

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

RecognizeGraph[g]

3D All

GraphData[{"Hexahedral",4},"Graph",{"3D","All"}]

3D Polyhedron

GraphData[{"Hexahedral",4},"Graph",{"3D","Polyhedron"}]

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

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

3D Polyhedron construction

poly=GraphPolyhedron[GraphData[{"Hexahedral",4}]]

Graphics3D[{FaceForm[Green,Red],poly}]

Graphics3D[poly2=Polyhedron[Normalize/@poly[[1]],poly[[2]]]]

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

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

SimplePolyhedronQ[can]

(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]

{"Hexahedral", 5} == "TritetrahedralGraph"

Names

GraphData[{"Hexahedral",5},"StandardName"]

GraphData[{"Hexahedral",5},"StandardNames"]

{"Hexahedral", 6} == {"Fan", {2, 4}}

GraphData[{"Hexahedral",6},"StandardName"]

{"Hexahedral", 7} == "OctahedralGraph"

GraphData[{"Hexahedral",7},"StandardName"]