Truncated Cube

Author

Eric W. Weisstein
January 5, 2024

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

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

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

Figure

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

Polyhedron

PolyhedronData["TruncatedCube","Orientations"]

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

Polyhedron

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

Region

PolyhedronData["TruncatedCube","Region"]

Solid and Dual

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

UniformPolyhedron

uniform=UniformPolyhedron[stdname="TruncatedCube"]

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]

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

Maeder

MaederUniformName[UniformPolyhedronIndex[stdname,"Maeder"]]

wythoff=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"]]

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

PolyhedronFaceTally[maeder]

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

Net

PolyhedronData["TruncatedCube","Net"]

PolyhedronData["TruncatedCube","Net","Colored"]

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

Properties

Initialization

<<MathWorld`Polyhedra`

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

vol=PolyhedronData[pname,"Volume"]

Centroid

PolyhedronData["TruncatedCube","Centroid"]

RegionCentroid[PolyhedronData["TruncatedCube","Polyhedron"]]//RootReduce

Circumradius

PolyhedronData["TruncatedCube","Circumradius"]

RootReduce[%]

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

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

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

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["TruncatedCube","EdgeLengths"]

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

Inradius

PolyhedronData["TruncatedCube","Inradius"]

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

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

InertiaTensor

PolyhedronData["TruncatedCube","InertiaTensor"]

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

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

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

N[%]

Integrate over polyhedron [unevaluated]

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

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

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)

((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<x&&z>0]

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]

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

RootReduce[%]//FullSimplify

N[%]

Divergence theorem [bad integrals]

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

N[rxy]

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

Divergence theorem GenerateConditions ->True [unsimplifyable complicated integrals]

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

MeanCylindricalSquareRadius

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

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

Integrate over polyhedron

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

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

Divergence theorem

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

...ran overnight...

20+ GB

N[rxyz]

ResourceFunction["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

CAD over  1/16 [unevaluated]

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

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]

ResourceFunction["LogSimplify"][rxyz]//FullSimplify

MeanSphericalSquareRadius

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

Midradius

PolyhedronData["TruncatedCube","Midradius"]

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

Surface Area

PolyhedronData["TruncatedCube","SurfaceArea"]

RootReduce[%]

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

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

Volume

PolyhedronData["TruncatedCube","Volume"]

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

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

Faces

PolyhedronFaceList[poly]

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

Triangular Faces

Together//@EdgeLengths[PolyhedronFaces[TruncatedCubeExact,3]]

Octagonal Faces

Together//@EdgeLengths[PolyhedronFaces[TruncatedCubeExact,8]]

Dihedral angles

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

{3,8}

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

π-RootReduce/@(DihedralAngle@@p)

InputForm[%]

N[%]180/Pi

{8,8}

Show[Graphics3D[p=poly[[{2,3}]]],Boxed->False]

RootReduce[π-DihedralAngle@@p]

InputForm[%]

N[%]180/Pi

Projections

PolyhedronProjectionGraph[PolyhedronData["TruncatedCube","Polyhedron"],#]&/@{{0,0,1},{1,0,1},{0,(Sqrt[2])-1,1,π/2},{(Sqrt[2]),1,1},{1-(Sqrt[2]),1,1,π/2},{1,2+(Sqrt[2]),1},{(Sqrt[2])-1,(Sqrt[2]),1,π/2},{(2/(5+3 (Sqrt[2]))),1,1,π/2},{(1/7) (-8+9 (Sqrt[2])),1,1},{2((Sqrt[2])-1),1,1},{1,1,1}}

GraphData["TruncatedCubicalGraph","Graph","Perspective"]

Vertex subset hulls

Platonic

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

Construction

TruncatedCubeExact:=TruncatedCubeExact=Module[{t=Sqrt[2]-1,s=2(Sqrt[2]-1)},OrientCentered[{Polygon[{{t,1,-1},{1,t,-1},{1,-t,-1},{t,-1,-1},{-t,-1,-1},{-1,-t,-1},{-1,t,-1},{-t,1,-1}}/s],Polygon[{{t,1,1},{1,t,1},{1,-t,1},{t,-1,1},{-t,-1,1},{-1,-t,1},{-1,t,1},{-t,1,1}}/s],Polygon[{{t,-1,1},{1,-1,t},{1,-1,-t},{t,-1,-1},{-t,-1,-1},{-1,-1,-t},{-1,-1,t},{-t,-1,1}}/s],Polygon[{{t,1,1},{1,1,t},{1,1,-t},{t,1,-1},{-t,1,-1},{-1,1,-t},{-1,1,t},{-t,1,1}}/s],Polygon[{{1,t,1},{1,1,t},{1,1,-t},{1,t,-1},{1,-t,-1},{1,-1,-t},{1,-1,t},{1,-t,1}}/s],Polygon[{{-1,t,1},{-1,1,t},{-1,1,-t},{-1,t,-1},{-1,-t,-1},{-1,-1,-t},{-1,-1,t},{-1,-t,1}}/s],Polygon[{{t,-1,1},{1,-t,1},{1,-1,t}}/s],Polygon[{{t,1,1},{1,t,1},{1,1,t}}/s],Polygon[{{-t,-1,1},{-1,-t,1},{-1,-1,t}}/s],Polygon[{{-t,1,1},{-1,t,1},{-1,1,t}}/s],Polygon[{{t,-1,-1},{1,-t,-1},{1,-1,-t}}/s],Polygon[{{t,1,-1},{1,t,-1},{1,1,-t}}/s],Polygon[{{-t,-1,-1},{-1,-t,-1},{-1,-1,-t}}/s],Polygon[{{-t,1,-1},{-1,t,-1},{-1,1,-t}}/s]}]]