Tetrakis Hexahedron

Author

Eric W. Weisstein
January 5, 2024

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

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

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

Figure

With[{pname="TetrakisHexahedron"},
GraphicsRow[{
Graphics3D[{Opacity[.8],PolyhedronData[pname,"Polyhedron"]},Boxed->False],
Graphics3D[{PolyhedronData[pname,"Lines"]},Boxed->False],
PolyhedronData[pname,"Net"]
},ImageSize->700]]

Solid

PolyhedronData["TetrakisHexahedron","Orientations"]

Show[PolyhedronData[{"TetrakisHexahedron",#}],Boxed->False]&/@PolyhedronData["TetrakisHexahedron","Orientations"]

Polyhedron

Graphics3D[{FaceForm[Green,Red],PolyhedronData["Tetrahexahedron","Polyhedron"]}]

Region

PolyhedronData["Tetrahexahedron","Region"]

Solid and Dual

GraphicsRow[PolyhedronData["TetrakisHexahedron",#]&/@{"Graphics3D","Dual","DualCompound"}]

Net

PolyhedronData["TetrakisHexahedron","Net"]

PolyhedronData["TetrakisHexahedron","Net","Colored"]

NetPrintout[PolyhedronData["TetrakisHexahedron","Polyhedron"],"TriakisHexahedron.pdf"]

Cumulation

Graphics3D/@Table[AugmentedPolyhedron[Cube[],h],{h,-1,1,.2}]

Properties

Initialization

<<MathWorld`Polyhedra`

p=PolyhedronData[pname="TetrakisHexahedron","Polyhedron"]

vol=PolyhedronData[pname,"Volume"]

Centroid

PolyhedronData[pname,"Centroid"]

RegionCentroid[p]//FullSimplify

PolyhedronCentroid[p]//FullSimplify

Circumsphere

PolyhedronData[pname,"Circumsphere"]

Circumsphere[p]

MyCircumsphere[p]

DihedralAngles

PolyhedronData[pname,"DihedralAngles"]//Tally

DihedralAngles[p]//Tally

EdgeLengths

PolyhedronData[pname,"EdgeLengths"]

PolyhedronData[pname,"Lines"]/.Line[l_]:>EuclideanDistance@@l//FullSimplify//Union

Faces

Show[GraphicsArray[partition[PolyhedronFaces[poly],5]]]

PolyhedronFaceCounts[poly]

Insphere

PolyhedronData[pname,"Insphere"]

Insphere[p]

MyInsphere[p]//Timing

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

((MomentOfInertia[p])/(Volume[p]))//RootReduce//Timing

PolyhedronInertiaTensor[p]//Timing

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

N[%]

((NIntegrate[(Sqrt[(x^2)+(y^2)]),{x,y,z}∈p])/vol)

Integrate over polyhedron

(rxy=((Integrate[(Sqrt[(x^2)+(y^2)]),{x,y,z}∈p])/vol))//Timing

N[rxy]

Divergence theorem

(rxy=MeanCylindricalRadius[p,"Simplification"->FullSimplify,Debug->True])//Timing

N[rxy]

LogSimplify[rxy]//FullSimplify//Expand

CAD

cad=CylindricalDecomposition[PolyhedronData[pname,"RegionFunction"][x,y,z],{x,y,z},"Function"]

((NIntegrate[(Sqrt[(x^2)+(y^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol)

(rxy=((Integrate[(Sqrt[(x^2)+(y^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol))//Timing

CAD over  1/16

reg=FullSimplify[PolyhedronData[pname,"RegionFunction"][x,y,z]&&0<y<Tan[Pi/4]x&&z>0]

((Volume[ImplicitRegion[reg,{x,y,z}]])/vol)

cad=CylindricalDecomposition[reg,{x,y,z},"Function"]

16((NIntegrate[(Sqrt[(x^2)+(y^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol)

(rxy=16((Integrate[(Sqrt[(x^2)+(y^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol))//Timing

N[rxy]

LogSimplify[rxy]//FullSimplify

Expand[%]

N[%]

MeanCylindricalSquareRadius

((NIntegrate[(x^2)+(y^2),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"]))//FullSimplify

(i=((Integrate[(x^2)+(y^2),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"])))//Timing

N[i]

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

((NIntegrate[(Sqrt[(x^2)+(y^2)+(z^2)]),{x,y,z}∈p])/vol)

Integrate over polyhedron [unevaluated]

(rxyz=((Integrate[(Sqrt[(x^2)+(y^2)+(z^2)]),{x,y,z}∈p])/vol))//Timing

N[rxyz]

Divergence theorem [unevaluated integral]

(rxyz=MeanSphericalRadius[p,"Simplification"->FullSimplify,Debug->True])//Timing

N[rxyz]

LogSimplify[rxyz]//FullSimplify

CAD

cad=CylindricalDecomposition[PolyhedronData[pname,"RegionFunction"][x,y,z],{x,y,z},"Function"]

((NIntegrate[(Sqrt[(x^2)+(y^2)+(z^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol)

(rxyz=((Integrate[(Sqrt[(x^2)+(y^2)+(z^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol))//Timing

N[rxyz,20]

rxysimp1=ResourceFunction["LogSimplify"][rxy]//FullSimplify

CAD over  1/16 [unevaluated]

reg=FullSimplify[PolyhedronData[pname,"RegionFunction"][x,y,z]&&0<y<Tan[Pi/4]x&&z>0]

((Volume[ImplicitRegion[reg,{x,y,z}]])/vol)

cad=CylindricalDecomposition[reg,{x,y,z},"Function"]

16((NIntegrate[(Sqrt[(x^2)+(y^2)+(z^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol)

(rxyz=16((Integrate[(Sqrt[(x^2)+(y^2)+(z^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol))//Timing

N[rxyz,20]

rxysimp1=LogSimplify[rxy]//FullSimplify

MeanSphericalSquareRadius

((NIntegrate[(x^2)+(y^2)+(z^2),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"]))

(i=((Integrate[(x^2)+(y^2)+(z^2),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"])))//Timing

N[i]

Midsphere

PolyhedronData[pname,"Midsphere"]

Midsphere[p]//Timing

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

SurfaceArea[p]//RootReduce//Timing

Total[Area/@PolyhedronData[pname,"Polygons"]]//RootReduce//Timing

VertexSubsetHulls

Platonic

(h=VertexSubsetHulls[p,"Platonic","Skip"->{}])//Timing

g=Function[poly,Graphics3D[{
{Gray,Opacity[.2],EdgeForm[Thick],PolyhedronData[p,"Faces"]},ConvexHull3D[N[PolyhedronData[p,"VertexCoordinates"]][[#]]]&/@poly},Boxed->False]]/@h[[All,2]]

Volume

PolyhedronData[pname,"Volume"]

Volume[p]//FullSimplify

PolyhedronVolume[p,Method->"GaussLaw"]//FullSimplify

Perspective projections

Manipulate[PolyhedronProjectionGraph[PolyhedronData["TetrakisHexahedron","Polyhedron"],{a,b,c}],{a,-1,1},{b,-1,1},{c,-1,1}]

{1,1,(1/(Sqrt[2])),ArcCot[(Sqrt[5])]}

g=PolyhedronProjectionGraph[PolyhedronData["TetrakisHexahedron","Polyhedron"],{1,1,(1/(Sqrt[2])),ArcCot[(Sqrt[5])]},VertexLabels->"Name"]

v=GraphEmbedding[g];

ArcTan@@(v[[10]]-v[[14]])//FullSimplify

g=PolyhedronProjectionGraph[PolyhedronData["TetrakisHexahedron","Polyhedron"],{1,1,z},VertexLabels->"Name"]

v=GraphEmbedding[g];

FullSimplify[CollinearPoints[v[[{9,7,13}]]],z>0]

Solve[%,z]//FullSimplify

{1,1,(5/(Sqrt[2])),ArcTan[(5/(Sqrt[29]))]}

g=PolyhedronProjectionGraph[PolyhedronData["TetrakisHexahedron","Polyhedron"],{1,1,(5/(Sqrt[2])),ArcTan[(5/(Sqrt[29]))]},VertexLabels->"Name"]

v=GraphEmbedding[g];

ArcTan@@(v[[10]]-v[[14]])//FullSimplify

g=PolyhedronProjectionGraph[PolyhedronData["TetrakisHexahedron","Polyhedron"],{1,1,z},VertexLabels->"Name"]

v=GraphEmbedding[g];

FullSimplify[CollinearPoints[v[[{10,7,14}]]],z>0]

Solve[%,z]//FullSimplify

{((2 (Sqrt[2]))/5),0,1}

{.52,0,.92}/.92

g=PolyhedronProjectionGraph[PolyhedronData["TetrakisHexahedron","Polyhedron"],{((2 (Sqrt[2]))/5),0,1},VertexLabels->"Name"]

g=PolyhedronProjectionGraph[PolyhedronData["TetrakisHexahedron","Polyhedron"],{z,0,1},VertexLabels->"Name"]

v=GraphEmbedding[g];

eqn=FullSimplify[v[[1]]-v[[8]],z>0]

Solve[Thread[eqn==0],z]//FullSimplify

{(Sqrt[2]),0,1}

g=PolyhedronProjectionGraph[PolyhedronData["TetrakisHexahedron","Polyhedron"],{(Sqrt[2]),0,1},VertexLabels->"Name"]

g=PolyhedronProjectionGraph[PolyhedronData["TetrakisHexahedron","Polyhedron"],{z,0,1},VertexLabels->"Name"]

v=GraphEmbedding[g];

FullSimplify[v[[1]]-v[[14]],z>0]

Solve[Thread[%==0],z]

{2(Sqrt[2]),0,1}

g=PolyhedronProjectionGraph[PolyhedronData["TetrakisHexahedron","Polyhedron"],{2(Sqrt[2]),0,1},VertexLabels->"Name"]

g=PolyhedronProjectionGraph[PolyhedronData["TetrakisHexahedron","Polyhedron"],{1,0,z},VertexLabels->"Name"]

v=GraphEmbedding[g];

FullSimplify[v[[7]]-v[[13]],z>0]

Solve[Thread[%==0],z]//FullSimplify

{1, 1, 0}

PolyhedronProjectionGraph[PolyhedronData["TetrakisHexahedron","Polyhedron"],{1,1,0}]

Construction

teth1:=Dual[Polyhedron[TruncatedOctahedron],Method->Semiregular]

e=Union[PolyhedronEdgeLengths[teth1]];
#/Max[e]&/@e

Show[Graphics3D[teth1],Boxed->False]

e=Union[PolyhedronEdgeLengths[Cumulate[Polyhedron[Cube],1/4]]];
#/Max[e]&/@e

(1/4+Inradius[Cube])/(1/4)

Show[Graphics3D[Cumulate[Polyhedron[Cube],1/4]],Boxed->False]

Net construction

{a,b}=PolyhedronData["TetrakisHexahedron","EdgeLengths"]

v=PolyhedronData["TetrakisHexahedron","VertexCoordinates"];

Graphics3D[{PolyhedronData["TetrakisHexahedron","Polyhedron"],MapIndexed[Text[#2[[1]],#,Background->White]&,v]}]

PolygonAngle[Polygon[v[[{6,14,8}]]]]//RootReduce//FullSimplify//Quiet

N[%]

θ=ArcSec[9];
ϕ=ArcCos[(2/3)];
L=4/3;

v=Join[{{0,0}},Table[RotationMatrix[i θ].{0,1},{i,0,2}]];
v=Join[v,Table[v[[2]]+{1/L,1}[[i]]RotationMatrix[-i ϕ].(v[[3]]-v[[2]]),{i,2}]];
v=Join[v,Table[v[[5]]+RotationMatrix[i θ].(v[[6]]-v[[5]]),{i,2}]];
v=Join[v,{v[[4]]+RotationMatrix[2ϕ].(v[[1]]-v[[4]])}];
v=Join[v,Table[v[[9]]+RotationMatrix[i θ].(v[[3]]-v[[9]]),{i,2}],{v[[9]]+RotationMatrix[-θ].(v[[4]]-v[[9]])}];
v=Join[v,{-#,#2}&@@@Drop[v,2]];
v=Join[v,{v[[20]]+RotationMatrix[ϕ].(v[[21]]-v[[20]])/L}];
v=Join[v,{v[[21]]+RotationMatrix[-2ϕ].(v[[20]]-v[[21]])}];
v=Join[v,Table[v[[23]]+RotationMatrix[-i θ].(v[[20]]-v[[23]]),{i,2}]];
faces={{1,2,3},{1,3,4},{2,6,5},{2,5,3},{6,7,5},{5,7,8},{3,9,4},{3,10,9},{9,10,11},{4,9,12}};
faces=Join[faces,{{13,1,14},{2,1,13},{13,15,2},{16,2,15}},Reverse/@Drop[faces,4]+10];
faces=Join[faces,{{20,21,23},{23,21,24},{23,25,20},{25,23,26}}];
Graphics[{FaceForm[LightYellow],EdgeForm[Black],poly=Polygon[v,faces],MapIndexed[Text[#2[[1]],#,Background->White]&,v]}]

Total[Area[Polygon[v,#]]&/@faces]//ToAlgebraicRoot//FullSimplify

PolyhedronData["TetrakisHexahedron","SurfaceArea"]

faces=Sort[faces]

v1=FullSimplify@Map[ToAlgebraicRoot,v,{2}]

Total[Area[Polygon[v1,#]]&/@faces]//ToAlgebraicRoot//FullSimplify

net=GraphicsComplex[v1,Polygon[faces]];

SimplifyNumericallyDistinct[NetEdgeLengths[net]//Quiet,"Simplification"->FullSimplify]//Union