Truncated Tetrahedron

Author

Eric W. Weisstein
January 5, 2024

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

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

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

Figure

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

Graphics

PolyhedronData["TruncatedTetrahedron","Orientations"]

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

Polyhedron

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

Region

PolyhedronData["TruncatedTetrahedron","Region"]

Solid and Dual

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

UniformPolyhedron

uniform=UniformPolyhedron[stdname="TruncatedTetrahedron"]

PolyhedronFaceTally[uniform]

UniformPolyhedron/@{
stdname,
UniformPolyhedronIndex[stdname,"Wenninger"],
{"Coxeter",UniformPolyhedronIndex[stdname,"Coxeter"]},
{"Kaleido",UniformPolyhedronIndex[stdname,"Kaleido"]},
{"Uniform",UniformPolyhedronIndex[stdname,"Maeder"]},
{"Wenninger",UniformPolyhedronIndex[stdname,"Wenninger"]}
}

SameQ@@%

Graphics3D/@(polys=Polygon[uniform[[1]],#]&/@uniform[[2]])

Graphics3D[#,Boxed->False]&/@{uniform,polys}

Bulatov

BulatovUniformName[UniformPolyhedronIndex[stdname,"Kaleido"]]

BulatovUniformGraphics3D[UniformPolyhedronIndex[stdname,"Kaleido"],Boxed->False]

bulatov=BulatovUniformPolyhedron[UniformPolyhedronIndex[stdname,"Kaleido"]]

Graphics3D/@(polys=Polygon[bulatov[[1]],#]&/@bulatov[[2]])

PolyhedronFaceTally[bulatov]

bulatov=BulatovUniformPolyhedron[7]

Maeder

MaederUniformName[UniformPolyhedronIndex[stdname,"Maeder"]]

MaederWythoffSymbol[UniformPolyhedronIndex[stdname,"Maeder"]]

Import["https://www.mathconsult.ch/static/unipoly/"<>If[maederindex<10,"0",""]<>ToString[UniformPolyhedronIndex[stdname,"Maeder"]]<>".html","Images"][[1]]

maeder=MaederUniformPolyhedron[UniformPolyhedronIndex[stdname,"Maeder"]]

MaederUniformPolyhedron[UniformPolyhedronIndex["TruncatedTetrahedron","Maeder"]]

Graphics3D/@(polys=Polygon[maeder[[1]],#]&/@maeder[[2]])

PolyhedronFaceTally[maeder]

Net

PolyhedronData["TruncatedTetrahedron","Net"]

PolyhedronData["TruncatedTetrahedron","Net","Colored"]

NetPrintout[PolyhedronData["TruncatedTetrahedron","Polyhedron"],"TruncatedTetrahedron.pdf"]

Properties

Initialization

<<MathWorld`Polyhedra`

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

vol=PolyhedronData[pname,"Volume"]

Centroid

PolyhedronData[pname,"Centroid"]

Graphics3D[{AbsolutePointSize[10],
Point[{0,0,0}],{Blue,Point[PolyhedronData[pname,"Centroid"]]},Opacity[.2],PolyhedronData[pname,"GraphicsComplex"]}]

RegionCentroid[p]//FullSimplify

PolyhedronCentroid[p]//Quiet//FullSimplify

Circumradius

PolyhedronData["TruncatedTetrahedron","Circumradius"]

Circumsphere[PolyhedronData["TruncatedTetrahedron","Polyhedron"]]//RootReduce//Timing

MyCircumsphere[PolyhedronData["TruncatedTetrahedron","Polyhedron"]]//RootReduce//Timing

Dual

pname

dname=PolyhedronData[pname,"Dual","Name"]

PolyhedronData[pname,"Dual","Scale"]

midrs={PolyhedronData[pname,"Midradius"],PolyhedronData[dname,"Midradius"]}

Divide@@midrs//FullSimplify

GraphicsRow[With[{
s={Yellow,PolyhedronData[pname,"Midsphere"]},
style=Directive[Black,Italic,FontFamily->"Times",14]
},
{
Graphics3D[{s,Green,Opacity[.5],PolyhedronData[pname,"Polyhedron"]},Boxed->False,PlotLabel->TextCell[Style[PolyhedronData[pname,"Name"],style],PageWidth->200,TextAlignment->Center]],
Graphics3D[{s,Red,Opacity[.5],PolyhedronData[pname,"Dual","Polyhedron"]},Boxed->False,PlotLabel->Style[PolyhedronData[dname,"Name"],style]],
Graphics3D[{
{Green,Opacity[.5],PolyhedronData[pname,"Polyhedron"]},
{Red,Opacity[.5],PolyhedronData[pname,"Dual","Polyhedron"]},
s
},Boxed->False,PlotLabel->Style["compound with midsphere",style]],
Graphics3D[{
PolyhedronData[pname,"Polyhedron"],
PolyhedronData[pname,"Dual","Polyhedron"]
},Boxed->False,PlotLabel->Style["compound",style]]
}],Alignment->Top,ImageSize->800]

EdgeLengths

PolyhedronData["TruncatedTetrahedron","EdgeLengths"]

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

Inradius

PolyhedronData["TruncatedTetrahedron","Inradius"]

Insphere[PolyhedronData["TruncatedTetrahedron","Polyhedron"]]//RootReduce//Timing

MyInsphere[PolyhedronData["TruncatedTetrahedron","Polyhedron"]]//RootReduce//Timing

InertiaTensor

PolyhedronData["TruncatedTetrahedron","InertiaTensor"]

PolyhedronInertiaTensor[PolyhedronData["TruncatedTetrahedron","Polyhedron"]]//Timing

((MomentOfInertia[PolyhedronData["TruncatedTetrahedron","Polyhedron"]])/(Volume[PolyhedronData["TruncatedTetrahedron","Polyhedron"]]))//RootReduce//Timing

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

N[%]

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

Integrate over polyhedron

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

Divergence theorem "Simplification" -> FullSimplify take 2 [differences all look OK but differs from NIntegrate!?]

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

N[rxy]

ResourceFunction["LogSimplify"][rxy]

N[%]

0.5407622762037364`-0.3092902146648545`

Divergence theorem "Simplification" -> Identity [wrong in Integrate]

bug(439538): Integrate[integrand containing logs, {t, 0, 1}, {s, 0, 1 - t}, GenerateConditions -> True | Automatic] gives wrong result; applying FullSimplify to integrand gives correct result (but only with GenerateConditions -> Automatic)

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

N[rxy,20]

ResourceFunction["LogSimplify"][rxy]

N[%]

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]

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

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]

LogSimplify[rxy]//FullSimplify//Expand

N[%]

MeanCylindricalSquareRadius

Integrate[(x^2)+(y^2),{x,y,z}∈PolyhedronData["TruncatedTetrahedron","Polyhedron"]]/PolyhedronData["TruncatedTetrahedron","Volume"]//FullSimplify

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

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

Integrate over polyhedron [unevaluated]

(1/vol)Integrate[(Sqrt[(x^2)+(y^2)+(z^2)]),{x,y,z}∈PolyhedronData["TruncatedTetrahedron","Polyhedron"]]//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"]

CylindricalDecompositionFunction[][x,y,z]

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

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

CAD over  1/6 [unevaluated]

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

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

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

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

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

N[rxy]

LogSimplify[rxy]//FullSimplify//Expand

N[%]

MeanSphericalSquareRadius

Integrate[(x^2)+(y^2)+(z^2),{x,y,z}∈PolyhedronData["TruncatedTetrahedron","Polyhedron"]]/PolyhedronData["TruncatedTetrahedron","Volume"]//FullSimplify

Midradius

PolyhedronData["TruncatedTetrahedron","Midradius"]

Midsphere[PolyhedronData["TruncatedTetrahedron","Polyhedron"]]//RootReduce//Timing

Surface Area

PolyhedronData["TruncatedTetrahedron","SurfaceArea"]

RootReduce[%]

SurfaceArea[PolyhedronData["TruncatedTetrahedron","Polyhedron"]]//RootReduce//Timing

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

Uniform

PolyhedronData[pname,"Uniform"]

With[{rules=PolyhedronData[pname,"NotationRules"]},{
UniformPolyhedron[Lookup[rules,"WenningerIndex"]],
UniformPolyhedron[{"Coxeter",Lookup[rules,"CoxeterIndex"]}],
UniformPolyhedron[{"Kaleido",Lookup[rules,"KaleidoIndex"]}],
UniformPolyhedron[{"Uniform",Lookup[rules,"MaederIndex"]}],
UniformPolyhedron[{"Wenninger",Lookup[rules,"WenningerIndex"]}]
}]

Equal@@%

Volume

PolyhedronData["TruncatedTetrahedron","Volume"]

Volume[PolyhedronData["TruncatedTetrahedron","Polyhedron"]]//FullSimplify

PolyhedronVolume[PolyhedronData["TruncatedTetrahedron","Polyhedron"],Method->"GaussLaw"]//FullSimplify

Faces

PolyhedronFaceList[poly]

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

Triangular and Hexagonal Faces

WriteLiveForm["test.m",
Show[Graphics3D[{
poly,LabelPolyhedronVertices[poly]
}],Boxed->False]
]

f1=v[[{5,6,7}]];
f2=v[[{1,11,12,2,10,9}]];

Show[GraphicsArray[{
Graphics3D[{
Polygon[f1],LabelVertices[f1]
},Boxed->False],
Graphics3D[{
Polygon[f2],LabelVertices[f2]
},Boxed->False],
Graphics3D[{
Polygon[f1],LabelVertices[f1],
Polygon[f2],LabelVertices[f2],
PointSize[.1],Point[{0,0,0}],
Line[{Centroid[f1][[1]],Centroid[f2][[1]]}]
},Boxed->False]
}]]

{a,b}=FullSimplify[{Centroid[f1][[1]],Centroid[f2][[1]]}]

Together//@FullSimplify[Sqrt/@{a.a,b.b}]

Dihedral angles

Show[Graphics3D[{poly,
MapIndexed[Text[#2[[1]],#1]&,Centroid/@poly//N]
}],Boxed->False,ViewPoint->{0,.1,1}3]

{3,6}

Show[Graphics3D[p=poly[[{4,7}]]],Boxed->False]

FullSimplify[π-DihedralAngle@@p]

InputForm[%]

N[%]180/Pi

{6,6}

Show[Graphics3D[p=poly[[{5,7}]]],Boxed->False]

FullSimplify[π-DihedralAngle@@p]

InputForm[%]

N[%]180/Pi

Projections

PolyhedronProjectionGraph[PolyhedronData["TruncatedTetrahedron","Polyhedron"],#]&/@{{1,0,2 (Sqrt[2]),π/2},{1,0,((2 (Sqrt[2]))/7),-π/2},{(7/(Sqrt[3])),1,2 (Sqrt[(2/3)]),π-ArcTan[(Sqrt[10])]},{0,0,1,π/2},{0,1,0,-ArcTan[(Sqrt[2])]},{Sqrt[2],0,1}}

GraphData["TruncatedTetrahedralGraph","Graph","Perspective"]

Vertex subset hulls

Platonic

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

Graph

skel=Skeleton[poly,1.3];

HamiltonianQ[skel]

RecognizeGraph[skel];

ShowGraph[skel]

DegreeSequence[skel]

DegreeSequence[CirculantGraph[12,#]]&/@KSubsets[Range[6],2]

IsomorphicQ[skel,CirculantGraph[12,#]]&/@(Or@@KSubsets[Range[6],2])

GraphProperties[skel]

Construction

TruncatedTetrahedronExact:=TruncatedTetrahedronExact=Module[{sq2=Sqrt[2],sq3=Sqrt[3],s=4Sqrt[3]},OrientCentered[{Polygon[{{6,-2sq3,-3sq2},{6,2sq3,-3sq2},{8,0,sq2}}/s],Polygon[{{0,-4sq3,-3sq2},{-6,-2sq3,-3sq2},{-4,-4sq3,sq2}}/s],Polygon[{{0,4sq3,-3sq2},{-6,2sq3,-3sq2},{-4,4sq3,sq2}}/s],Polygon[{{4,0,5sq2},{-2,-2sq3,5sq2},{-2,2sq3,5sq2}}/s],Polygon[{{0,-4sq3,-3sq2},{-4,-4sq3,sq2},{-2,-2sq3,5sq2},{4,0,5sq2},{8,0,sq2},{6,-2sq3,-3sq2}}/s],Polygon[{{6,2sq3,-3sq2},{8,0,sq2},{4,0,5sq2},{-2,2sq3,5sq2},{-4,4sq3,sq2},{0,4sq3,-3sq2}}/s],Polygon[{{-6,2sq3,-3sq2},{-4,4sq3,sq2},{-2,2sq3,5sq2},{-2,-2sq3,5sq2},{-4,-4sq3,sq2},{-6,-2sq3,-3sq2}}/s],Polygon[{{-6,2sq3,-3sq2},{-6,-2sq3,-3sq2},{0,-4sq3,-3sq2},{6,-2sq3,-3sq2},{6,2sq3,-3sq2},{0,4sq3,-3sq2}}/s]}]]