Triakis Tetrahedron

Author

Eric W. Weisstein
January 5, 2024

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

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

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

Figure

With[{pname="TriakisTetrahedron"},
GraphicsRow[{
Graphics3D[{Opacity[.8],PolyhedronData[pname,"Polyhedron"]},Boxed->False,Method->{"ShrinkWrap"->True},ViewPoint->10{-1,-.8,-1}],
Graphics3D[{PolyhedronData[pname,"Lines"]},Boxed->False,Method->{"ShrinkWrap"->True},ViewPoint->10{-1,-.8,-1}],
PolyhedronData[pname,"Net"]
},ImageSize->700,Spacings->50]]

Solid

PolyhedronData["TriakisTetrahedron","Orientations"]

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

Solid and Dual

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

Net

PolyhedronData["TriakisTetrahedron","Net"]

PolyhedronData["TriakisTetrahedron","Net","Colored"]

NetPrintout[PolyhedronData["TriakisTetrahedron","Polyhedron"],"Cuboctahedron.pdf"]

Properties

Initialization

<<MathWorld`Polyhedra`

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

vol=PolyhedronData[pname,"Volume"]

Centroid

PolyhedronData["TriakisTetrahedron","Centroid"]

RegionCentroid[PolyhedronData["TriakisTetrahedron","Polyhedron"]]//FullSimplify

PolyhedronCentroid[p]

Circumradius

PolyhedronData["TriakisTetrahedron","Circumradius"]

Circumsphere[p]//RootReduce//Timing

MyCircumsphere[p]

ConvexHullOf

hullof=DeleteCases[Select[PolyhedronData[All],PolyhedronData[#,"ConvexHullName"]===pname&],pname]

GraphicsGrid[Partition[Graphics3D[{
{Green,Opacity[.7],PolyhedronData[#,"Polyhedron"]},
{Blue,Opacity[.2],PolyhedronData[#,"ConvexHull","Polyhedron"]}},Boxed->False,PlotLabel->Style[PolyhedronData[#,"Name"],Directive[14,Black,Italic,FontFamily->"Times"]]]&/@hullof,UpTo[3]],Dividers->All,ImageSize->200]

EdgeLengths

PolyhedronData["TriakisTetrahedron","EdgeLengths"]

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

Faces

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

PolyhedronFaceCounts[poly]

Faces

GeneralizedDiameter

PolyhedronData["TriakisTetrahedron","GeneralizedDiameter"]

GeneralizedDiameter[p]

Insphere

PolyhedronData["TriakisTetrahedron","Inradius"]

Insphere[p]

MyInsphere[p]//RootReduce//Timing

InertiaTensor

PolyhedronData["TriakisTetrahedron","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 polyhedra [unevaluated]

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

Divergence theorem

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

N[rxy]

rxysimp=LogSimplify[rxy]//FullSimplify

TrigToExp[%]

FullSimplify[%]

LogSimplify[%]

LogSimplify[%]

?LogExpand

LogPowers[83+16 (Sqrt[19]),(Sqrt[19])]

((6764 (Sqrt[3])-2025 (Sqrt[57]) Log[3]-3610 Log[2+(Sqrt[3])]-675 (Sqrt[57]) (Log[75]-4 Log[8+(Sqrt[19])]))/51984)//N

((6764 (Sqrt[3])-2025 (Sqrt[57]) Log[3]-3610 Log[2+(Sqrt[3])]-675 (Sqrt[57]) (Log[75]-4 Log[8+(Sqrt[19])]))/51984)//FullSimplify

((6764 (Sqrt[3])-2025 (Sqrt[57]) Log[3]-3610 Log[2+(Sqrt[3])]- 675 (Sqrt[57]) (2Log[5]+Log[3]-4 Log[8+(Sqrt[19])]))/51984)//Expand//Together

FullSimplify[%]

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/6

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

Show[Graphics3D[{Opacity[.2],p}],RegionPlot3D[ImplicitRegion[reg,{x,y,z}],PlotPoints->50]]

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

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

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

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

N[rxy]

ByteCount[rxylog=LogSimplify[rxy,"ZeroTestNumericalPrecision"->10000,WorkingPrecision->10000,Debug->True]]//Timing

rxylog

ByteCount[rxycollect=Collect[TrigToExp[rxylog],Log[_]]//RootReduce]//Timing

rxycollect

FullSimplify[%]//Expand

LogPowers[11753+2656 (Sqrt[19]),(Sqrt[19]),20]

N[(89/(228 (Sqrt[3])))-(5/72) Log[2+(Sqrt[3])]+(75/304) (Sqrt[(3/19)]) Log[((((8+(Sqrt[19])))^4)/2025)]]

N[(89/(228 (Sqrt[3])))-(5/72) Log[2+(Sqrt[3])]+(75/304) (Sqrt[(3/19)]) (4Log[8+(Sqrt[19])]-Log[(3^4)(5^2)])]

N[(89/(228 (Sqrt[3])))-(5/72) Log[2+(Sqrt[3])]+(75/304) (Sqrt[(3/19)]) (4Log[8+(Sqrt[19])]-4Log[3]-2Log[5])]

Expand[(89/(228 (Sqrt[3])))-(5/72) Log[2+(Sqrt[3])]+(75/304) (Sqrt[(3/19)]) (4Log[8+(Sqrt[19])]-4Log[3]-2Log[5])]

FullSimplify[%]

Expand[%]

Inequalities

{{xmin,xmax},{ymin,ymax},{zmin,zmax}}=MinMax/@Transpose[PolyhedronCoordinates[p]]

ineq=PolyhedronData[pname,"RegionFunction"][x,y,z]

(i1=Integrate[Boole[ineq](Sqrt[(x^2)+(y^2)]),{z,zmin,zmax}]/.p_Piecewise:>RootReduce/@p)//Timing

NIntegrate[(i1/vol),{x,xmin,xmax},{y,ymin,ymax}]

(i2=Integrate[(i1/vol),{x,xmin,xmax},{y,ymin,ymax}])//Timing

MeanCylindricalSquareRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

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

(i=((Integrate[(x^2)+(y^2),{x,y,z}∈p])/(PolyhedronData["TriakisTetrahedron","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]

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

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/6 [unevaluated]

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

Show[Graphics3D[{Opacity[.2],p}],RegionPlot3D[ImplicitRegion[reg,{x,y,z}],PlotPoints->50]]

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

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

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

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

ByteCount[rxyzlog=LogSimplify[rxyz,"ZeroTestNumericalPrecision"->10000,WorkingPrecision->10000,Debug->True]]//Timing

ByteCount[rxyzcollect=Collect[TrigToExp[rxyzlog],Log[_]]//RootReduce]//Timing

MeanSphericalSquareRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

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

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

N[i]

Midsphere

PolyhedronData["TriakisTetrahedron","Midsphere"]

Midsphere[p]//RootReduce//Timing

SurfaceArea

PolyhedronData["TriakisTetrahedron","SurfaceArea"]

SurfaceArea[p]//RootReduce//Timing

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

VertexCount

PolyhedronData[pname,"VertexCount"]

VertexSubsetHulls

Platonic

(h=VertexSubsetHulls[p,"Platonic"])//Timing

Tetrahedron

(i1=VertexSubsetsHulls[p,"Tetrahedron"])//Timing

FullSimplify[PolyhedronEdgeLengths[#]]&/@(ConvexHull3D[v[[#]]]&/@i1)

Graphics3D[PolyhedronData[p,"Faces"],Boxed->False]

g1=Graphics3D[{
{Gray,Opacity[.1],PolyhedronData[p,"Faces"]},
Opacity[.1],h1=ConvexHull3D[v[[#]]]&/@i1
},Boxed->False]

g1=Graphics3D[{
{Gray,Opacity[.2],PolyhedronData[p,"Faces"]},
h1=ConvexHull3D[v[[#]]]&/@i1
},Boxed->False]

g2=Graphics3D[{
{Gray,Opacity[.2],PolyhedronData[p,"Faces"]},
h1=ConvexHull3D[v[[#]]]&/@i1[[{2,3,5,6}]]
},Boxed->False]

g3=Graphics3D[{
{Gray,Opacity[.2],PolyhedronData[p,"Faces"]},
h1=ConvexHull3D[v[[#]]]&/@i1[[{1,4}]]
},Boxed->False]

GraphicsGrid[{{g1,g2,g3}},Spacings->-100]

Volume

PolyhedronData["TriakisTetrahedron","Volume"]

Volume[p]//FullSimplify

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

Perspective projections

PolyhedronProjectionGraph[PolyhedronData["TriakisTetrahedron","Polyhedron"],#,"Simplification"->FullSimplify]&/@{{0,1,0,π-ArcTan[(Sqrt[2])]},{(1/(4 (Sqrt[2]))),((Sqrt[(3/2)])/4),1,ArcTan[((2 (Sqrt[(2/3)]))/3)]},{(1/(8 (Sqrt[2]))),((Sqrt[(3/2)])/8),1,ArcTan[((4 (Sqrt[(2/11)]))/3)]},{-(1/(Sqrt[3])),1,((2 (Sqrt[(2/3)]))/5),-ArcCot[(9/(Sqrt[2]))]},{1,.0001,.0001,π/4},{0,0,1,π/6},{(Sqrt[2]),0,1}}

GraphData["TriakisTetrahedralGraph","Graph","Perspective"]

Construction

Solid

TriakisTetrahedronExact:=OrientCentered[Dual[Polyhedron[TruncatedTetrahedron],Method->Semiregular]]

Net

<<ExtraPackages`UnfoldPolytope`

UnfoldPolytope[Flatten[Normal[PolyhedronData["TriakisTetrahedron","Faces"]]]]

PolyhedronData["TriakisTetrahedron","EdgeLengths"]

x=5/6;

y=Sqrt[1-x^2];

α=ArcCos[{1,0}.{x,-y}]//FullSimplify

RotationMatrix[-2α].{2x,0}//FullSimplify

p={Polygon[{{0,0},{2x,0},{x,-y}}],
Polygon[{{0,0},{x,-y},{(35/54),-(5/3) Sin[2 ArcCos[(5/6)]]}}],
Polygon[{{2x,0},{x,-y},{2x-(35/54),-(5/3) Sin[2 ArcCos[(5/6)]]}}]};

p/.Polygon[v_]:>Polygon[{1,-1}#&/@v]

Graphics[{FaceForm[LightYellow],EdgeForm[Black],g=Flatten[{p,p/.Polygon[v_]:>Polygon[({1,-1}#+{2x-(35/54),-(5/3) Sin[2 ArcCos[(5/6)]]})&/@v],
p/.Polygon[v_]:>Polygon[(-{(385/972)-(25/54) (Sqrt[11]) Sin[2 ArcCos[(5/6)]],-((275 (Sqrt[11]))/972)-(35/54) Sin[2 ArcCos[(5/6)]]}+RotationMatrix[π+θ].#)&/@v],
p/.Polygon[v_]:>Polygon[(-{(565/486),(5/3) Sin[2 ArcSin[(7/18)]]}+RotationMatrix[π+2θ].#)&/@v]}]}]

θ=ArcCos[{1,0}.Normalize[({2x-(35/54),-(5/3) Sin[2 ArcCos[(5/6)]]}-{2x,0})]]//FullSimplify

p/.Polygon[v_]:>Polygon[RotationMatrix[π+θ].#&/@v]//N

p/.Polygon[v_]:>Polygon[(RotationMatrix[π+2θ].#)&/@v]//FullSimplify

{Polygon[{{0,0},{(565/486),(5/3) Sin[2 ArcSin[(7/18)]]},{(475/486),((31 (Sqrt[11]))/486)}}],Polygon[{{0,0},{(475/486),((31 (Sqrt[11]))/486)},{(3395/2187),-((400 (Sqrt[11]))/2187)}}],Polygon[{{(565/486),(5/3) Sin[2 ArcSin[(7/18)]]},{(475/486),((31 (Sqrt[11]))/486)},{(440/243),-((25 (Sqrt[11]))/243)}}]}

FullSimplify[Map[TrigToExp,FullSimplify[g],{2}]]

gc=NetFromPolygon[FullSimplify[g]]

gc=NetFromPolygon[FullSimplify[Map[TrigToExp,FullSimplify[g],{2}]]]

FullSimplify[TrigToExp[(5/3) Sin[2 ArcSin[(7/18)]]]]

ByteCount/@(expr={Sin[2 ArcSin[(7/18)]],Sin[2 ArcCos[(5/6)]]})

(FullSimplify[#]==#)&/@expr

FunctionExpand/@expr

FullSimplify/@TrigToExp/@expr

ByteCount/@%

(5/3) Sin[2 ArcCos[(5/6)]]

Graphics[{{LightYellow,EdgeForm[Black],gc},MapIndexed[Text[#2[[1]],#,Background->White]&,SortBy[gc[[1]],N]]}]

PolyhedronData["TriakisTetrahedron","NetImage"]