Hexahedron

Author

Eric W. Weisstein
June 17, 2023

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Polyhedra/Hexahedron.nb.

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

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

Examples

FirstCase[Import["https://oeis.org/A000944/b000944.txt","Table"],{6,n_}:>n]

GraphData["Polyhedral",6]

Length[%]

TextGrid[Sort[PolyhedronData[#,{"F","V","E","#"}]&/@PolyhedronData[6]],Dividers->All,Alignment->{{{Decimal},Left}}]

PolyhedronData

PolyhedronData[6]

Extended

TextGrid[builtin={PolyhedronData[#,"Name"],Graphics3D[{Opacity[.8],PolyhedronData[#,"Polyhedron"]},Boxed->False]}&/@PolyhedronData[6],Dividers->All]

TextGrid[extra={{"cuboid",Graphics3D[{Opacity[.8],Cuboid[{0,0,0},{1,2,3}]},Boxed->False]}},Dividers->All]

hexahedra=Union[builtin,extra];

GraphicsGrid[Partition[Show[#2,PlotLabel->TextCell[Style[#,Italic,13,Black,FontFamily->"Times"],TextAlignment->Center,PageWidth->130]]&@@@hexahedra,UpTo[5]],ImageSize->700,Alignment->Top,Dividers->All]

By face type

One face type

Select[PolyhedronData[6],Length[PolyhedronData[#,"FaceCountRules"]]==1&]

Multiple face types

Select[PolyhedronData[6],Length[PolyhedronData[#,"FaceCountRules"]]>1&]

Plane intersection calculations

With[{a ={0,0,0},b1={-1,.3,1},b2 ={-1,-.04,.4},c={.5,.7,1},d={.5,-.7,1},e ={0,.2,2},p={x,y,z}},Solve[{Det[ Map[Append[#,1]&,{p,a,b1,c}]]==Det[Map[Append[#,1]&,{p,e,d,c}] ]==0}]]

With[{a ={0,0,0},b1={-1,.3,1},b2 ={-1,-.04,.4},c={.5,.7,1},d={.5,-.7,1},e ={0,.2,2},p={x,y,z}},Solve[{Det[ Map[Append[#,1]&,{p,a,c,d}]]==Det[Map[Append[#,1]&,{p,e,b1,c}] ]==0}]]

With[{a ={0,0,0},b1={-1,.3,1},b2 ={-1,-.04,.4},c1={.5,.7,1},c2 = {0,.933333,.0},d={.5,-.7,1},e ={0,.2,2},p={x,y,z}},Solve[{Det[ Map[Append[#,1]&,{p,a,c2,b1}]]==Det[Map[Append[#,1]&,{p,a,b2,d}] ]==Det[Map[Append[#,1]&,{p,e,b1,d}] ]== 0}]]

With[{a ={0,0,0},b1={-1,.3,1},b2 ={-1,-.04,.4},c={.5,.7,1},d1={.5,-.7,1},d2={.65,-.55,.7},e ={0,.2,2},p={x,y,z}},Solve[{Det[ Map[Append[#,1]&,{p,d1,d2,e}]]==Det[Map[Append[#,1]&,{p,b1,b2,a}] ]==0}]]/. z-> .7

Polyhedron skeletons

PlatonicName/@Flatten[Position[Table[Platonic[n],{n,5}],_?(Length[#]==6&),{1}]]

ArchimedeanName/@Flatten[Position[Table[Archimedean[n]//N,{n,13}],_?(Length[#]==6&),{1}]]

j=Flatten[Position[Table[JohnsonSolid[n],{n,92}],_?(Length[#]==6&),{1}]]

JohnsonSolidName/@j

poly=Skeleton/@{CubeExact,Pyramid[5],Dipyramid[3]};
ColumnForm[{Reverse[DegreeSequence[#]],V[#],M[#]}&/@poly
]

These are the duals of the polyhedral graphs corresponding to the octahedron, 5-pyramid, and 3-prism.

Display

Show[GraphicsArray[Table[Graphics3D[Hexahedron[n],Boxed->False],{n,7}]]]

hexahedra=Select[ReleaseHold[#[[1]]&/@DownValues[Hexahedron]/.Hexahedron:>Identity],ListQ]

Length/@Through[{PolyhedronVertices,PolyhedronEdges}[Hexahedron[#]]]&/@hexahedra

hex={Graph[{{{2,3}},{{3,4}},{{1,2}},{{1,5}},{{2,4}},{{2,5}},{{4,5}},{{3,5}},{{1,3}}},{{{0.0,0.9}},{{0.8,-0.8}},{{-0.8,-0.8}},{{0.0,-0.5}},{{0.0,0.0}}}],Graph[{{{1,2}},{{1,5}},{{2,3}},{{3,4}},{{4,5}},{{1,6}},{{5,6}},{{4,6}},{{3,6}},{{2,6}}},{{{0.0,1.0}},{{0.951057,0.309017}},{{0.587785,-0.809017}},{{-0.587785,-0.809017}},{{-0.951057,0.309017}},{{0.0,0.0}}}],Graph[{{{1,4}},{{2,3}},{{3,4}},{{3,5}},{{1,2}},{{1,6}},{{4,5}},{{2,5}},{{2,6}},{{5,6}}},{{{0.7,1.0}},{{0.7,-0.8}},{{-1.0,-0.8}},{{-1.0,1}},{{-0.5,0}},{{0.3,0.3}}}],Graph[{{{1,2}},{{1,5}},{{2,3}},{{3,4}},{{4,5}},{{1,6}},{{5,6}},{{2,6}},{{6,7}},{{3,7}},{{4,7}}},{{{0.0,1.0}},{{0.951057,0.309017}},{{0.587785,-0.809017}},{{-0.587785,-0.809017}},{{-0.951057,0.309017}},{{0.0,0.16}},{{0.0,-0.35}}}],Graph[{{{1,4}},{{2,3}},{{3,4}},{{1,2}},{{1,6}},{{4,5}},{{2,6}},{{5,6}},{{3,7}},{{2,7}},{{5,7}}},{{{0.7,1.0}},{{0.7,-0.8}},{{-1.0,-0.8}},{{-1.0,1.0}},{{-0.6,0.6}},{{0.3,0.6}},{{-0.6,-0.4}}}],Graph[{{{1,2}},{{1,5}},{{2,3}},{{3,4}},{{4,5}},{{1,6}},{{6,7}},{{4,7}},{{5,7}},{{6,8}},{{2,8}},{{3,8}}},{{{0.0,1.0}},{{0.951057,0.309017}},{{0.587785,-0.809017}},{{-0.587785,-0.809017}},{{-0.951057,0.309017}},{{0.0,0.16}},{{-0.4,-0.14}},{{0.4,-0.14}}}],Graph[{{{1,4}},{{2,3}},{{3,4}},{{1,2}},{{1,6}},{{4,5}},{{5,6}},{{3,7}},{{5,7}},{{2,8}},{{6,8}},{{7,8}}},{{{0.7,1.0}},{{0.7,-0.8}},{{-1.0,-0.8}},{{-1.0,1.0}},{{-0.6,0.6}},{{0.3,0.6}},{{-0.6,-0.4}},{{0.3,-0.4}}}]};

DegreeSequence/@PolyhedralGraphs[6]

ColumnForm[Sort[{Reverse[DegreeSequence[#]],V[#],M[#]}&/@PolyhedralGraphs[6]]
]

pos=Flatten[Position[hexahedra,#]&/@(Sort/@DegreeSequence/@PolyhedralGraphs[6])]

Table[Position[Skeleton/@Table[Hexahedron[n],{n,7}],_?(IsomorphicQ[Polyhedra[6][[i]],#]&)],{i,7}]//Flatten

Show[GraphicsArray[{
Graphics[HiddenWireframe[#,
PlotStyles->{{},Dashing[{1,1}.05]}],AspectRatio->Automatic]&/@Table[Hexahedron[n],{n,7}],
ShowGraph[RecognizeGraph[#],
VertexStyle->Disk[.095],
VertexColor->Red,
AspectRatio->Automatic,
DisplayFunction->Identity]&/@hex,
ShowGraph[RecognizeGraph[#],
VertexStyle->Disk[.095],
VertexColor->Red,
AspectRatio->Automatic,
DisplayFunction->Identity]&/@PolyhedralGraphs[6][[pos]]
}
]]

Select[GraphData["Polyhedral"],GraphData[#,"FaceCount"]==7&]

TextGrid[SortBy[{#,Sort@GraphData[#,"VertexDegrees"],GraphData[#,"M"],GraphData[#,"F"],GraphData[#],GraphData[#,"DualGraphName"],GraphData[#,"DualGraph"]}&/@GraphData["Polyhedral",6]/.g_Graph:>StyleGraphs@Annotate[g,ImageSize->100],#[[2]]&],Dividers->All]

Tables

Gérard P. Michon's site (from Jerry of Nashville, TN)

http://nbarth.net/notes/src/notes-calc-raw/others/X-numericana/polyhedra.htm#hexahedra

Wikipedia

https://en.wikipedia.org/wiki/Hexahedron#Convex,_Others