Cube

Author

Eric W. Weisstein
January 4, 2024

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

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

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

Additional Authors

Cutting by plane and rotation about an axis based on
Hidekazu Takahashi
http://www.biwako.ne.jp/~hidekazu/materials/cubee.htm
and using the knife.m package by the same author

Inverted cube by Michael Trott
(see TMB v4 graphics gallery)

Figure

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

Solid

Orientations

PolyhedronData["Cube","Orientations"]

PolyhedronData["Cube","DefaultOrientation"]

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

axes=Line[{-#,#}]&/@Permutations[{1.1,0,0}];

Show[GraphicsArray[Graphics3D[{Polyhedron[Cube,#],{Red,Thickness[.02],axes}},PlotLabel->#,Boxed->False,ViewPoint->{5,1,0}]&/@{"C3","C4"}]]

Show[GraphicsArray[Graphics3D[{Polyhedron[Cube,#],{Red,Thickness[.02],axes}},PlotLabel->#,Boxed->False,ViewPoint->{0,0,5}]&/@{"C3","C4"}]]

c2=Select[KSubsets[Midpoint/@Map[PolyhedronVertices[Cube][[#]]&,PolyhedronEdges[Cube],{2}],2],Abs[Norm[Subtract@@#]-Sqrt[2]]<10^-10&]

c3=Diameters[Cube]

c4=Select[KSubsets[Centroid/@Map[PolyhedronVertices[Cube][[#]]&,PolyhedronFaces[Cube],{2}],2],Abs[Norm[Subtract@@#]-1]<10^-10&]

Length/@{c2,c3,c4}

Length[Join[c2,c3,c4]]

v=Subtract@@@Join[c2,c3,c4]

Polyhedron

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

Region

PolyhedronData["Cube","Region"]

Solid and Dual

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

UniformPolyhedron

uniform=UniformPolyhedron[stdname="Cube"]

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["Cube","Net"]

PolyhedronData["Cube","Net","Colored"]

NetPrintout[Cube,"Cube.pdf"]

All distinct nets

PolyhedronData["Cube","NetCount"]

square[x_]:=Line[#+x&/@{{0,0},{1,0},{1,1},{0,1},{0,0}}]

Show[GraphicsArray[Partition[
Graphics[#,AspectRatio->Automatic,
PlotRange->{{-.1,5.1},{-1.1,2.1}}
]&/@Map[square,
{
{{0,0},{1,0},{2,0},{3,0},{2,-1},{2,1}},
{{0,0},{1,0},{2,0},{3,0},{0,-1},{1,1}},
{{0,0},{1,0},{2,0},{3,0},{1,-1},{2,1}},
{{0,0},{1,0},{2,0},{3,0},{0,-1},{3,1}},
{{0,0},{1,0},{1,-1},{2,0},{3,0},{3,1}},
{{0,0},{1,0},{2,0},{2,-1},{3,-1},{4,-1}},
{{0,1},{1,1},{1,0},{2,0},{3,0},{2,-1}},
{{0,1},{1,1},{1,0},{2,0},{3,0},{3,-1}},
{{0,0},{1,0},{2,0},{2,1},{2,-1},{3,-1}},
{{0,0},{1,0},{2,0},{3,0},{3,-1},{3,1}},
{{0,1},{1,1},{1,0},{2,0},{2,-1},{3,-1}}
},{2}],
4,4,{1,1},{}]
]]

Properties: {"Cube", "C2"}

Initialization

<<MathWorld`Polyhedra`

p=PolyhedronData[pname={"Cube","C2"},"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]

PolyhedronCentroid[p]

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

(i=((MomentOfInertia[p,{0,0,0}])/vol))//Timing

Map[ToAlgebraicRoot,i,{2}]

PolyhedronInertiaTensor[p]//Timing

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

N[%]

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

ClosestMeanCylindricalRadius[%]

Integrate over polyhedron

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

N[rxy]

Divergence theorem [wrong integral]

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

N[rxy]

LogSimplify[rxy]//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/XX

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

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

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

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

LogSimplify[rxy]//FullSimplify

N[rxy]

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

N[%]

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

Integrate over Polyhedron

(rxy2=((Integrate[(x^2)+(y^2),{x,y,z}∈p])/vol)//FullSimplify)

N[rxy2]

Polygons

PolyhedronData[pname,"FaceCount"]

PolyhedronFaceTally[p]

Graphics3D/@PolyhedronData[pname,"Polygons"]

Show[%]

Polyhedra

polyhedra=PolyhedronData[pname,"Polyhedra"]

Length[polyhedra]

Graphics3D[polyhedra]

Graphics3D[Table[{Hue[(i/(Length[polyhedra]))],polyhedra[[i]]},{i,Length[polyhedra]}]]

PolyhedronData[pname,"PolyhedronIndices"]

Region

PolyhedronData[pname,"Region"]

RegionFunction

PolyhedronData[pname,"RegionFunction"]

{RegionPlot3D[ImplicitRegion[PolyhedronData[pname,"RegionFunction"][x,y,z],{x,y,z}],PlotPoints->50],
Graphics3D[p]}

Collect[#,{x,y,z},RootReduce]&/@PolyhedronInequalities[p,{x,y,z}]

ineq=FullSimplify[%]

ineq/.{x->#,y->#2,z->#3}

{Region@ImplicitRegion[ineq,{x,y,z}],Graphics3D[p]}

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

SurfaceArea[p]

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

SurfaceArea[PolyhedronData[pname,"Region"]]

Volume

PolyhedronData[pname,"Volume"]

Volume[p]//FullSimplify

PolyhedronVolume[p]//FullSimplify

Volume[PolyhedronData[pname,"Region"]]//FullSimplify

Volume[ImplicitRegion[Evaluate@PolyhedronData[pname,"RegionFunction"][x,y,z],{x,y,z}]]//FullSimplify

Properties: {"Cube", "C3"}

Initialization

<<MathWorld`Polyhedra`

p=PolyhedronData[pname={"Cube","C3"},"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]//FullSimplify//Quiet

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

(i=((MomentOfInertia[p,{0,0,0}])/vol))//Timing

PolyhedronInertiaTensor[p]//Timing

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

N[%]

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

ClosestMeanCylindricalRadius[%]

Integrate over polyhedron

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

N[rxy]

Divergence theorem

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

N[rxy]

LogSimplify[rxy]//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/XX

reg=FullSimplify[PolyhedronData[pname,"RegionFunction"][x,y,z]&&0<y<Tan[2Pi/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

FullSimplify[%]

((4+3Log[3])/(8 (Sqrt[6])))//N

Boole Integrate doing z integral first

{{xmin,xmax},{ymin,ymax},{zmin,zmax}}==CoordinateBounds[p]

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

(i1=Integrate[Boole[ineq](Sqrt[(x^2)+(y^2)]),{z,zmin,zmax}])//Timing

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

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

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

N[%]

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

ClosestMeanSphericalRadius[%]

Integrate over polyhedron

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

N[rxyz]

Divergence theorem

(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/XX

reg=FullSimplify[PolyhedronData[pname,"RegionFunction"][x,y,z]&&0<y<Tan[Pi/5]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"]

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

(rxyz=XX((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

Boole Integrate doing z integral first

{{xmin,xmax},{ymin,ymax},{zmin,zmax}}=CoordinateBounds[p]

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

(i1=Integrate[Boole[ineq](Sqrt[(x^2)+(y^2)+(z^2)]),{z,zmin,zmax}])//Timing

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

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

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

N[%]

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

Integrate over Polyhedron

(rxy2=((Integrate[(x^2)+(y^2),{x,y,z}∈p])/vol)//FullSimplify)

N[rxy2]

Divergence theorem

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

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

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

Integrate over polyhedron

(rxy2=((Integrate[(x^2)+(y^2)+(z^2),{x,y,z}∈p])/vol)//FullSimplify)

N[rxy2]

Integrate over region

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

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

Divergence theorem

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

Boole Integrate doing z integral first

{{xmin,xmax},{ymin,ymax},{zmin,zmax}}==CoordinateBounds[p]

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

(i1=Integrate[Boole[ineq]((x^2)+(y^2)+(z^2)),{z,zmin,zmax}])//Timing

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

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

Orientations

PolyhedronData[pname,"Orientations"]

PolyhedronData[pname,"DefaultOrientation"]

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

Polygons

PolyhedronData[pname,"FaceCount"]

PolyhedronFaceTally[p]

Graphics3D/@PolyhedronData[pname,"Polygons"]

Show[%]

Polyhedra

polyhedra=PolyhedronData[pname,"Polyhedra"]

Length[polyhedra]

Graphics3D[polyhedra]

Graphics3D[Table[{Hue[(i/(Length[polyhedra]))],polyhedra[[i]]},{i,Length[polyhedra]}]]

PolyhedronData[pname,"PolyhedronIndices"]

Region

PolyhedronData[pname,"Region"]

RegionFunction

PolyhedronData[pname,"RegionFunction"]

{RegionPlot3D[ImplicitRegion[PolyhedronData[pname,"RegionFunction"][x,y,z],{x,y,z}]],
Graphics3D[p]}

Collect[#,{x,y,z},RootReduce]&/@PolyhedronInequalities[p,{x,y,z}]

ineq=FullSimplify[%]

ineq/.{x->#,y->#2,z->#3}

{Region@ImplicitRegion[ineq,{x,y,z}],Graphics3D[p]}

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

SurfaceArea[p]

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

SurfaceArea[PolyhedronData[pname,"Region"]]

Volume

PolyhedronData[pname,"Volume"]

Volume[p]//FullSimplify

PolyhedronVolume[p]//FullSimplify

Volume[PolyhedronData[pname,"Region"]]//FullSimplify

Volume[ImplicitRegion[Evaluate@PolyhedronData[pname,"RegionFunction"][x,y,z],{x,y,z}]]//FullSimplify

Properties: {"Cube", "C3x"}

Initialization

<<MathWorld`Polyhedra`

p=PolyhedronData[pname={"Cube","C3x"},"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

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

(i=((MomentOfInertia[p,{0,0,0}])/vol))//Timing

PolyhedronInertiaTensor[p]//Timing

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

PolyhedronData[{"Cube","C3"},"MeanCylindricalRadius"]

N[%]

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

ClosestMeanCylindricalRadius[%]

Integrate over polyhedron

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

N[rxy]

Divergence theorem

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

N[rxy]

LogSimplify[rxy]//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/XX

reg=FullSimplify[PolyhedronData[pname,"RegionFunction"][x,y,z]&&0<y<Tan[Pi/5]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"]

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

(rxy=XX((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

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

Boole Integrate doing z integral first

{{xmin,xmax},{ymin,ymax},{zmin,zmax}}==CoordinateBounds[p]

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

(i1=Integrate[Boole[ineq](Sqrt[(x^2)+(y^2)]),{z,zmin,zmax}])//Timing

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

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

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

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

ClosestMeanSphericalRadius[%]

Integrate over polyhedron

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

N[rxyz]

Divergence theorem

(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/XX

reg=FullSimplify[PolyhedronData[pname,"RegionFunction"][x,y,z]&&0<y<Tan[Pi/5]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"]

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

(rxyz=XX((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

Boole Integrate doing z integral first

{{xmin,xmax},{ymin,ymax},{zmin,zmax}}=CoordinateBounds[p]

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

(i1=Integrate[Boole[ineq](Sqrt[(x^2)+(y^2)+(z^2)]),{z,zmin,zmax}])//Timing

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

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

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

N[%]

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

Integrate over Polyhedron

(rxy2=((Integrate[(x^2)+(y^2),{x,y,z}∈p])/vol)//FullSimplify)

N[rxy2]

Divergence theorem

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

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

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

Integrate over polyhedron

(rxy2=((Integrate[(x^2)+(y^2)+(z^2),{x,y,z}∈p])/vol)//FullSimplify)

N[rxy2]

Integrate over region

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

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

Divergence theorem

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

Boole Integrate doing z integral first

{{xmin,xmax},{ymin,ymax},{zmin,zmax}}==CoordinateBounds[p]

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

(i1=Integrate[Boole[ineq]((x^2)+(y^2)+(z^2)),{z,zmin,zmax}])//Timing

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

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

Orientations

PolyhedronData[pname,"Orientations"]

PolyhedronData[pname,"DefaultOrientation"]

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

Polygons

PolyhedronData[pname,"FaceCount"]

PolyhedronFaceTally[p]

Graphics3D/@PolyhedronData[pname,"Polygons"]

Show[%]

Polyhedra

polyhedra=PolyhedronData[pname,"Polyhedra"]

Length[polyhedra]

Graphics3D[polyhedra]

Graphics3D[Table[{Hue[(i/(Length[polyhedra]))],polyhedra[[i]]},{i,Length[polyhedra]}]]

PolyhedronData[pname,"PolyhedronIndices"]

Region

PolyhedronData[pname,"Region"]

RegionFunction

PolyhedronData[pname,"RegionFunction"]

{RegionPlot3D[ImplicitRegion[PolyhedronData[pname,"RegionFunction"][x,y,z],{x,y,z}]],
Graphics3D[p]}

Collect[#,{x,y,z},RootReduce]&/@PolyhedronInequalities[p,{x,y,z}]

ineq=FullSimplify[%]

ineq/.{x->#,y->#2,z->#3}

{Region@ImplicitRegion[ineq,{x,y,z}],Graphics3D[p]}

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

SurfaceArea[p]

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

SurfaceArea[PolyhedronData[pname,"Region"]]

Volume

PolyhedronData[pname,"Volume"]

Volume[p]//FullSimplify

PolyhedronVolume[p]//FullSimplify

Volume[PolyhedronData[pname,"Region"]]//FullSimplify

Volume[ImplicitRegion[Evaluate@PolyhedronData[pname,"RegionFunction"][x,y,z],{x,y,z}]]//FullSimplify

Properties: {"Cube", "C4"} == "Cube"

Initialization

<<MathWorld`Polyhedra`

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

vol=PolyhedronData[pname,"Volume"]

Centroid

PolyhedronData["Cube","Centroid"]

RegionCentroid[PolyhedronData["Cube","Polyhedron"]]

Circumradius

PolyhedronData["Cube","Circumradius"]

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

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

ConvexHullOf

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

GraphicsRow[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,Dividers->All]

Inradius

PolyhedronData["Cube","Inradius"]

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

InertiaTensor

PolyhedronData["Cube","InertiaTensor"]

((MomentOfInertia[PolyhedronData["Cube","Polyhedron"]])/(Volume[PolyhedronData["Cube","Polyhedron"]]))

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

((NIntegrate[(Sqrt[(x^2)+(y^2)]),{x,y,z}∈PolyhedronData["Cube","Polyhedron"]])/(PolyhedronData["Cube","Volume"]))

((Integrate[(Sqrt[(x^2)+(y^2)]),{x,0,1/2},{y,0,1/2},{z,0,1/2}])/(PolyhedronData["Cube","Volume"]/8))//Timing

N[%]

MeanInteriorLineSegmentLength

lbar=PolyhedronData[pname,"MeanInteriorLineSegmentLength"]

A073012

N[%]

Solve[vol (a^3)==1,a,PositiveReals]//FullSimplify

Dominik Beck.  "Mean distance in polyhedra."  https://arxiv.org/abs/2309.13177

GlobalAdaptive numerical integration

ineq=PolyhedronData[pname,"RegionFunction"]

{{xmin,xmax},{ymin,ymax},{zmin,zmax}}=RegionBounds[ImplicitRegion[ineq[x,y,z],{x,y,z}]]

(1/(vol^2)) NIntegrate[Sqrt[(x1-x2)^2+(y1-y2)^2+(z1-z2)^2]Boole[ineq[x1,y1,z1]&&ineq[x2,y2,z2]],
{x1,xmin,xmax},{y1,ymin,ymax},{z1,zmin,zmax},
{x2,xmin,xmax},{y2,ymin,ymax},{z2,zmin,zmax}]

(1/(vol^2)) NIntegrate[Sqrt[(x1-x2)^2+(y1-y2)^2+(z1-z2)^2]Boole[ineq[x1,y1,z1]&&ineq[x2,y2,z2]],
{x1,xmin,xmax},{y1,ymin,ymax},{z1,zmin,zmax},
{x2,xmin,xmax},{y2,ymin,ymax},{z2,zmin,zmax},
Method->{"GlobalAdaptive","MaxErrorIncreases"->1*^4}]//Timing

Integration using CAD

ineq=PolyhedronData[pname,"RegionFunction"]

{{xmin,xmax},{ymin,ymax},{zmin,zmax}}=RegionBounds[ImplicitRegion[ineq[x,y,z],{x,y,z}]]

cad=CylindricalDecomposition[ineq[x1,y1,z1]&&ineq[x2,y2,z2],{x1,y1,z1,x2,y2,z2},"Function"]

(1/(vol^2)) NIntegrate[Sqrt[(x1-x2)^2+(y1-y2)^2+(z1-z2)^2]Boole[cad],
{x1,xmin,xmax},{y1,ymin,ymax},{z1,zmin,zmax},
{x2,xmin,xmax},{y2,ymin,ymax},{z2,zmin,zmax}]

(1/(vol^2)) Integrate[Sqrt[(x1-x2)^2+(y1-y2)^2+(z1-z2)^2]Boole[cad],
{x1,xmin,xmax},{y1,ymin,ymax},{z1,zmin,zmax},
{x2,xmin,xmax},{y2,ymin,ymax},{z2,zmin,zmax}]

Integration using CAD over 1/8

ineq=PolyhedronData[pname,"RegionFunction"]

{{xmin,xmax},{ymin,ymax},{zmin,zmax}}=RegionBounds[ImplicitRegion[ineq[x,y,z]&&x>0&&y>0&&z>0,{x,y,z}]]

cad=CylindricalDecomposition[ineq[x1,y1,z1]&&ineq[x2,y2,z2]&&x1>0&&y1>0&&z1>0&&x2>0&&y2>0&&z2>0,{x1,y1,z1,x2,y2,z2},"Function"]

((2 (8^2))/(vol^2)) NIntegrate[Sqrt[(x1-x2)^2+(y1-y2)^2+(z1-z2)^2]Boole[cad],
{x1,xmin,xmax},{y1,ymin,ymax},{z1,zmin,zmax},
{x2,xmin,xmax},{y2,ymin,ymax},{z2,zmin,zmax}]

(lbar=(128/(vol^2)) Integrate[Sqrt[(x1-x2)^2+(y1-y2)^2+(z1-z2)^2]Boole[cad],
{x1,xmin,xmax},{y1,ymin,ymax},{z1,zmin,zmax},
{x2,xmin,xmax},{y2,ymin,ymax},{z2,zmin,zmax}])//Timing

Monte Carlo

reg=PolyhedronData[pname,"Region"]

Length[lines=Partition[RandomPoint[reg,10^7],2]]//Timing

Graphics3D[{{Opacity[.03],EdgeForm[],DiscretizeRegion[reg]},Red,Line/@Take[lines,UpTo@1000]},AspectRatio->Automatic]

lengths=Norm/@Subtract@@@lines;//Timing

Histogram[lengths,{.01}]

Mean[lengths]

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

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

Rule[#,((Integrate[(x^2)+(y^2),{x,y,z}∈PolyhedronData[{"Cube",#},"Polyhedron"]])/(PolyhedronData["Cube","Volume"]))]&/@PolyhedronData["Cube","Orientations"]

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

((NIntegrate[(Sqrt[(x^2)+(y^2)+(z^2)]),{x,y,z}∈PolyhedronData["Cube","Polyhedron"]])/(PolyhedronData["Cube","Volume"]))

((Integrate[(Sqrt[(x^2)+(y^2)+(z^2)]),{x,0,1/2},{y,0,1/2},{z,0,1/2}])/(PolyhedronData["Cube","Volume"]/8))//Timing

(i1=Assuming[{0<y<1/2,0<z<1/2},FullSimplify@Integrate[(Sqrt[(x^2)+(y^2)+(z^2)]),{x,0,1/2}]])//Timing

(i2=Assuming[{0<z<1/2},FullSimplify@Integrate[i1,{y,0,1/2}]])//Timing

((NIntegrate[i2,{z,0,1/2}])/(PolyhedronData["Cube","Volume"]/8))

(i3=FullSimplify@Integrate[i2,{z,0,1/2}])//Timing

FullSimplify[(i3/(PolyhedronData["Cube","Volume"]/8))]

N[%]

(1/8 (Sqrt[3]+Log[7+4 Sqrt[3]])-Pi/48)//N

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

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

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

Rule[#,((Integrate[(x^2)+(y^2)+(z^2),{x,y,z}∈PolyhedronData[{"Cube",#},"Polyhedron"]])/(PolyhedronData["Cube","Volume"]))]&/@PolyhedronData["Cube","Orientations"]

NotationRules

PolyhedronData[pname,"NotationRules"]

SurfaceArea

PolyhedronData["pname","SurfaceArea"]

SurfaceArea[PolyhedronData["Cube","Polyhedron"]]

Total[Area/@PolyhedronData["Cube","Polygons"]]//FullSimplify

Volume

PolyhedronData["Cube","Volume"]

Volume[PolyhedronData["Cube","Polyhedron"]]

PolyhedronVolume[PolyhedronData["Cube","Polyhedron"],Method->"GaussLaw"]

Properties: {"Cube", "C4xy"}

Initialization

<<MathWorld`Polyhedra`

Graphics3D[p=PolyhedronData[pname={"Cube","C4xy"},"Polyhedron"]]

NotationRules

PolyhedronData[pname,"NotationRules"]

RegionFunction

ineq=PolyhedronInequalities[p,{x,y,z}]//FullSimplify

ineq/.Thread[{x,y,z}->{#1,#2,#3}]

reg=ImplicitRegion[ineq,{x,y,z}]

RegionPlot3D[reg]

Faces

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

Projections

PolyhedronProjectionGraph[PolyhedronData["Cube","Polyhedron"],#]&/@{{0,0,1},{1,0,1},{1,0,2},{1,1,1},{1,2,1},{1,2,2},{2,1,1}}

GraphData["CubicalGraph","Graph","Perspective"]

Vertex subset hulls

<<MathWorld`PolyhedronOperations`

(h=VertexSubsetHulls[PolyhedronData["Cube","Polyhedron"],"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]]

GraphicsGrid[{g},Spacings->10]

Inequalities

PolyhedronInequalities[Polyhedron[Cube],{x,y,z}][[1]]//FullSimplify

<<Calculus`Integration`
<<Graphics`InequalityGraphics`

Integrate[Boole[And@@PolyhedronInequalities[CubeExact,{x,y,z}]],{x},{y},{z}]//Timing

InequalityPlot3D[-1<x<1&&-1<y<1&&-1<z<1,{x},{y},{z}]

Integrate[Boole[-1<x<1&&-1<y<1&&-1<z<1],{x},{y},{z}]

Table[{n,Integrate[# Boole[-1<x<1&&-1<y<1&&-1<z<1],{x},{y},{z}]&/@({x,y,z}^n)},{n,6}]//ColumnForm

V6

FullSimplify[z<1/2]

FullSimplify[z<-1/2,z>0]

ByteCount/@{z<-1/2,2z<1}

And@@{2 z<1,2 x<1,2 y<1,x>-(1/2),z>-(1/2),y>-(1/2)}//FullSimplify

RegionPlot3D[And@@{2 z<1,2 x<1,2 y<1,x>-(1/2),z>-(1/2),y>-(1/2)},{x,-1,1},{y,-1,1},{z,-1,1}]

Integrate[Boole[2 z<a&&2 x<a&&2 y<a&&x>-(a/2)&&z>-(a/2)&&y>-(a/2)],{x,-∞,∞},{y,-∞,∞},{z,-∞,∞},Assumptions->a>0]

Integrate[{x,y,z}Boole[2 z<a&&2 x<a&&2 y<a&&x>-(a/2)&&z>-(a/2)&&y>-(a/2)],{x,-∞,∞},{y,-∞,∞},{z,-∞,∞},Assumptions->a>0]

(M/(a^3))Integrate[InertiaTensor[{x,y,z}]Boole[2 z<a&&2 x<a&&2 y<a&&x>-(a/2)&&z>-(a/2)&&y>-(a/2)],{x,-∞,∞},{y,-∞,∞},{z,-∞,∞},Assumptions->a>0]

Cube Surface

ContourPlot3D[Abs[Abs[x-y]+Abs[x+y]-2z]+Abs[Abs[x-y]+Abs[x+y]+2z]==2,{x,-.6,.6},{y,-.6,.6},{z,-.6,.6}]

Abs[Abs[x-y]+Abs[x+y]-2z]+Abs[Abs[x-y]+Abs[x+y]+2z]/.{x->1/2,y->1/2,z->1/2}

Cube Inscribed in a Dodecahedron

WriteLiveForm["dodecube.m",Show[Graphics3D[SplitLines[{{Thickness[.015],frame[dodecahedron[]]},dodeccube},1]],
					Boxed->False,ViewPoint->{0,-2,2}]]//Timing

Cube Icosahedron

p5[n_]:=Mod[n-1,5]+1
icosahedron[a_:1,ang_:0]:=Module[{topV,botV,top,bot,midtop,midbot,i,
		r=a/(Sqrt[50-10Sqrt[5]]/5)},
	topV=Table[r{2/5 Sqrt[5]Cos[2/5 Pi i+ang],
						2/5 Sqrt[5]Sin[2/5 Pi i+ang],Sqrt[5]/5},
		{i,5}];
	botV=-topV;
	top=Table[{{0,0,r},topV[[i]],topV[[p5[i+1]]]},{i,5}];
	bot=-top;
	midtop=Table[{topV[[i]],botV[[p5[i+3]]],topV[[p5[i+1]]]},{i,5}];
	midbot=-midtop;
	{Polygon/@top,Polygon/@bot,Polygon/@midtop,Polygon/@midbot}
]

j=JessensOrthogonalPolyhedron[][[2]];
v=j /. Polygon->centroid;

Definitions changed; need to modify lists

WriteLiveForm["icoscube.m",
	Show[Graphics3D[{
			{PointSize[.03],Point/@v},
			Polygon[v[[{1,2,8,7}]]],
			Polygon[v[[{3,4,6,5}]]],
			Polygon[v[[{1,2,5,6}]]],
			Polygon[v[[{2,5,3,8}]]],
			Polygon[v[[{1,6,4,7}]]],
			Polygon[v[[{3,4,7,8}]]],
			icosahedron[] /. Polygon->line
		}],Boxed->False]]

Cut by Planes

<<Graphics`Polyhedra`
<<Extra`Hidekazu`Knife`
<<Utilities`Typesetting`

(cube=Polyhedron[Cube,{0,0,0},1/Sqrt[2]])[[1]]

Show[GraphicsArray[
Block[{$DisplayFunction=Identity},
{
Show[knife[cube,Sequence@@#,1],Boxed->False,PlotLabel->TraditionalForm[#[[1]].{x,y,z,1}==0]]&/@{
{{0,0,1,0},{0,0,0},{1,0,.2}},
{{1,0,1,0},{0,0,0},{1,0,0}},
{{1,1,1,0},{0,0,0},{1,0,0}},
{{1,1,1,-1/2},{0,0,0},{0,1,0}}
},
Graphics[{Polygon[#[[1]]],#[[2]]},AspectRatio->Automatic,PlotRange->{{-1,1},{-1.2,1}}]&/@{
{{{-1,-1},{1,-1},{1,1},{-1,1}}/2,{Text[1,{0,-.85}],Text[1,{.8,0}]}},
{{{-1,-Sqrt[2]},{1,-Sqrt[2]},{1,Sqrt[2]},{-1,Sqrt[2]}}/2,{Text[1,{0,-.95}],Text[Sqrt[2]//TraditionalForm,{.8,0}]}},
{Through[{Cos,Sin}[2Pi #/6]]&/@Range[0,5]Sqrt[2]/2,{Text[InlineFraction[Sqrt[2],2]//TraditionalForm,{0,-.95}]}},
{Through[{Cos,Sin}[2Pi #/3]]&/@Range[1/4,2+1/4]Sqrt[2]/Sqrt[3],{Text[Sqrt[2]//TraditionalForm,{0,.7}]}}
}
}
]
],GraphicsSpacing->.1
]

<<Graphics`InequalityGraphics`

Show[GraphicsArray[Block[{$DisplayFunction=Identity},
InequalityPlot3D[#<0,{x,-1/2,1/2},{y,-1/2,1/2},{z,-1/2,1/2}]&/@{z,x+z,x+y+z,x+y+z-1/2}
]]]

Areas

<<Calculus`Integration`

Boole ignores lower-dimensional components and so gives 0

Integrate[Boole[#==0],{x,-1/2,1/2},{y,-1/2,1/2},{z,-1/2,1/2}]&/@{z,x+z,x+y+z,x+y+z-1/2}

Square

r={u,v,0};

ParametricPlot3D[r,{u,-1/2,1/2},{v,-1/2,1/2},PlotRange->All,Axes->False,BoxRatios->{1,1,1}]

{D[r,u],D[r,v]}

Norm[Cross@@%]

Integrate[1,{u,-1/2,1/2},{v,-1/2,1/2}]

Rectangle

r={-u,v,u};

ParametricPlot3D[r,{u,-1/2,1/2},{v,-1/2,1/2},PlotRange->All,Axes->False,BoxRatios->{1,1,1}]

{D[r,u],D[r,v]}

Norm[Cross@@%]

Integrate[Sqrt[2],{u,-1/2,1/2},{v,-1/2,1/2}]

Hexagon

r={(u+v)(UnitStep[u+v-1/2]-UnitStep[u+v+1/2]),u,v};

θ=-Pi/2;
Show[
ParametricPlot3D[r,{u,-1/2,1/2},{v,-1/2,1/2},
PlotRange->All,Axes->False,BoxRatios->{1,1,1},
PlotRange->All,DisplayFunction->Identity],
Graphics3D[Polygon[{{Cos[θ],Sin[θ],0},{-Sin[θ],Cos[θ],0},{0,0,1}}.(#/2+{0,0,.02})&/@(cubeHexagon)]],
BoxRatios->{1,1,1},PlotRange->All,DisplayFunction->$DisplayFunction]

r={-(u+v),u,v};

{D[r,u],D[r,v]}

Norm[Cross@@%]

-Integrate[Sqrt[3](UnitStep[u+v-1/2]-UnitStep[u+v+1/2]),{u,-1/2,1/2},{v,-1/2,+1/2}]

Simplify[3/2 Sqrt[3](Sqrt[2]/2)^2]

Triangle

Simplify[Solve[x+y+z-1/2==0,z]]

r={u,v,-(1/2-(u+v))(UnitStep[u+v-1]-UnitStep[u+v])};

ParametricPlot3D[r,{u,-1/2,1/2},{v,-1/2,1/2},
PlotRange->All,Axes->False,BoxRatios->{1,1,1}]

r={u,v,-(1/2-(u+v))};

{D[r,u],D[r,v]}

Norm[Cross@@%]

-Integrate[Sqrt[3](UnitStep[u+v-1]-UnitStep[u+v]),{u,-1/2,1/2},{v,-1/2,1/2}]

Sqrt[3]Sqrt[2]^2/4

Volumes

Integrate[Boole[#<0],{x,-1/2,1/2},{y,-1/2,1/2},{z,-1/2,1/2}]&/@{z,x+z,x+y+z,x+y+z-1/2}

Integrate[Boole[#>0],{x,-1/2,1/2},{y,-1/2,1/2},{z,-1/2,1/2}]&/@{z,x+z,x+y+z,x+y+z-1/2}

Det[{{0,0,1,1},{1,0,0,1},{1,1,1,1},{1,0,1,1}}]/3!

Surface area of cut made by plane through the cube center

<<Graphics`Polyhedra`
<<Extra`Hidekazu`Knife`

?nArea

Show[GraphicsArray[
Block[{$DisplayFunction=Identity},
{
Plot3D[nArea[cube,{a,b,1,0}],{a,0,0.999},{b,0,0.999},
BoxRatios->{1,1,1},Mesh->False,
AxesLabel->TraditionalForm/@{a,b,""}],
ContourPlot[nArea[cube,{a,b,1,0}],{a,0,1},{b,0,1},
FrameLabel->TraditionalForm/@{a,b},ColorFunction->(Hue[#]&),ContourLines->False,PlotPoints->40]
}]]]

f[a_?NumericQ,b_]:=nArea[Polyhedron[Cube],{a,b,1,0}]

NMaximize[f[a,b],{a,b}]

Cube Hexagon

cube:=Module[{i},
{Table[Polygon[{{i,-1,-1},{i,1,-1},{i,1,1},{i,-1,1}}],{i,-1,1,2}],
			Table[Polygon[{{-1,i,-1},{1,i,-1},{1,i,1},{-1,i,1}}],{i,-1,1,2}],
			Table[Polygon[{{1,-1,i},{1,1,i},{-1,1,i},{-1,-1,i}}],{i,-1,1,2}]
		}//Flatten
]
 
cubeHexagon:={{0,-1,-1},{1,0,-1},{1,1,0},{0,1,1},{-1,0,1},{-1,-1,0},{0,-1,-1}}

Show[GraphicsArray[{
  Show[Graphics3D[{frame[cube],cubeHexagon}],Boxed->False,DisplayFunction->Identity],
  Show[Graphics3D[{cube[[1]],line[cubeHexagon[[1]]]}],Boxed->False,DisplayFunction->Identity]
  }],DisplayFunction->$DisplayFunction]

LiveGraphics3D

WriteLiveForm["cubehex1.m",Show[Graphics3D[{SplitLines[frame[cube],1],Polygon[cubeHexagon]}],opts]]

WriteLiveForm["cubehex2.m",
	Show[PolyhedronPolygon[cube,cubeHexagon],opts]]

Rotated about Space Diagonal

<<Graphics`Shapes`

Show[(Graphics3D[#,Boxed->False]&/@Table[RotateShape[Polyhedron[Cube,"C3"],i 2Pi/3/10,0,0],{i,0,9}]),
ViewPoint->{2,0,0}]

ineqs=PolyhedronInequalities[Flatten[RotateAboutAxis[Polyhedron[Cube,"C3"],{0,0,1},θ]],{x,y,z}]

NIntegrate[Boole[Evaluate[And@@ineqs/.θ->0]],{x,-∞,∞},{y,-∞,∞},{z,-∞,∞}]

NIntegrate[Boole[Evaluate[And@@ineqs/.θ->π/6]],{x,-∞,∞},{y,-∞,∞},{z,-∞,∞}]

<<Graphics`InequalityGraphics`

Show[GraphicsArray[
Block[{$DisplayFunction=Identity},
InequalityPlot3D[ineqs/.θ->#,{x},{y},{z},Axes->False,Boxed->False]&/@{0,π/6,π/3}
]
]]

<<Graphics`Shapes`
<<Graphics`Polyhedra`
<<Extra`Hidekazu`RotateGraphics`

cube=Polyhedron[Cube,{0,0,0},1/Sqrt[2]];

cube[[1]]

v={{1,0,1},{1,1/2,1},{1,1,1},{0.5293068763322593,0.23759289886707735,1}};

Show[GraphicsArray[
Transpose[Block[{$DisplayFunction=Identity},
{
showAxis[cube,#,Boxed->False,Axes->False],
showAxis[rotateGraphics[cube,#,31],#,
Boxed->False,Axes->False]
}&/@v
]
]
],GraphicsSpacing->{-.1,-.1}
]

f[a_?NumericQ,b_]:=nVolume[cube,{a,b,1}]

NMaximize[{f[a,b],0<a<1&&0<b<1},{a,b}]//Timing

f@@Most[v[[-1]]]

(g1=ContourPlot[nVolume[cube,{a,b,1}],{a,.001,1},{b,.001,1},PlotPoints->25,ContourLines->False,ColorFunction->Hue,FrameLabel->TraditionalForm/@{a,b}])//Timing

(g2=Plot3D[f[a,b],{a,.001,1},{b,.001,1},PlotPoints->25,AxesLabel->TraditionalForm/@{a,b,""}])//Timing

Show[GraphicsArray[{g2,g1}],GraphicsSpacing->-.05]

Timings

v4.2.1

ContourPlot[nVolume[cube,{a,b,1}],{a,.001,1},{b,.001,1},PlotPoints->5,ContourLines->False,ColorFunction->Hue]//Timing

v5.0.1 with t_?NumericQ

ContourPlot[nVolume[cube,{a,b,1}],{a,.001,1},{b,.001,1},PlotPoints->5,ContourLines->False,ColorFunction->Hue]//Timing

v5.0.1 with "EvaluateNumericalFunctionArgument" -> False

ContourPlot[nVolume[cube,{a,b,1}],{a,.001,1},{b,.001,1},PlotPoints->5,ContourLines->False,ColorFunction->Hue]//Timing

Inversion

By Michael Trott

Show[Function[pot,Graphics3D[{EdgeForm[Thickness[0.001]],SurfaceColor[Hue[0.12],Hue[0],2.2],Function[polys,Module[{rMax=Max[(Sqrt[#1.#1]&)/@Level[Cases[polys,_Polygon,Infinity],{-2}]]},Map[#1/rMax&,polys,{-1}]]][Function[x,Module[{mp=(1/4)*Plus@@x[[1]]},{Polygon[(mp+0.2*(#1-mp)&)/@x[[1]]],MapThread[Polygon[Join[#1,Reverse[#2]]]&,{Partition[(Append[#1,First[#1]]&)[(mp+0.8*(#1-mp)&)/@x[[1]]],2,1],Partition[(Append[#1,First[#1]]&)[(mp+0.5*(#1-mp)&)/@x[[1]]],2,1]}]}]]/@Map[(#1*Sqrt[#1.#1]^pot)/Sqrt[#1.#1]&,Join@@Apply[ParametricPlot3D[##1,PlotPoints->7,DisplayFunction->Identity][[1]]&,({#1[[1]],Flatten[Append[{#1[[2,1]]},{-1,1}]],Flatten[Append[{#1[[2,2]]},{-1,1}]]}&)/@({#1,Cases[#1,_Symbol]}&)/@Select[Flatten[Outer[List,{x,1,-1},{y,1,-1},{z,1,-1}],2],Length[Cases[#1,_Symbol]]==2&],{1}],{-2}]]},Axes->False,PlotRange->{{-1,1},{-1,1},{-1,1}}]]/@{-1},Boxed->False]

Cube Octahedron

WriteLiveForm["cubeoct1.m",
			Show[Graphics3D[{SplitLines[frame[cube[1][[1]]],1],octahedron[1][[1]],
		{PointSize[.04],Point/@Union[Flatten[octahedron[1][[1]] /. Polygon->Identity,1]]}}],opts]]

WriteLiveForm["cubeoct2.m",
			Show[Graphics3D[{cube[1][[1]],SplitLines[frame[octahedron[3][[1]]],1],
		{PointSize[.03],Point/@Union[Flatten[cube[1][[1]] /. Polygon->Identity,1]]}}],opts]]

Exact Construction

(Subscript[C, 4])

Show[Graphics3D[Polyhedron[Cube]],ViewPoint->2{1,0,0}]

(* s=Sqrt[2]/2 *)

cube[s_:1]:={
	Polygon[{{s,s,s},{-s,s,s},{-s,-s,s},{s,-s,s}}],
	Polygon[{{s,s,s},{s,-s,s},{s,-s,-s},{s,s,-s}}],
	Polygon[{{s,s,s},{s,s,-s},{-s,s,-s},{-s,s,s}}],
	Polygon[{{-s,s,s},{-s,s,-s},{-s,-s,-s},{-s,-s,s}}],
	Polygon[{{-s,-s,-s},{-s,s,-s},{s,s,-s},{s,-s,-s}}],
	Polygon[{{-s,-s,s},{-s,-s,-s},{s,-s,-s},{s,-s,s}}]
}

CubeExact:=OrientCentered[cube[1/2]]

(Subscript[C, 3])

θ=ArcCos[FullSimplify[Divide@@Through[{Inradius,Circumradius}[Cube]]]]

N[%]

Show[Graphics3D[poly=FullSimplify[(Polyhedron[Cube]/.Polygon[x_]:>Polygon[RotationMatrixZ[π/4].#&/@x])/.Polygon[x_]:>Polygon[RotationMatrixX[θ].#&/@x]],ViewPoint->5{0,0,1}]]

FullSimplify[RootReduce[poly[[1,#[[1]],1,#[[2]]]]&/@(First[Position[PolyhedronFaces[Cube],#]]&/@Range[Length[PolyhedronVertices[Cube]]])]]//InputForm

N[%]

Show[Graphics3D[{d=Dual[Antiprism[3]],Red,Thickness[.02],Line[{{0,0,-1},{0,0,1}}2]}],ViewPoint->{0,0,2}]

poly=d;
(Sqrt[2](v=PolyhedronVertices[d]))//InputForm
First/@poly/.Thread[v->Range[Length[v]]]

(Subscript[C, 2])

Show[Graphics3D[poly=FullSimplify[(Polyhedron[Cube]/.Polygon[x_]:>Polygon[RotationMatrixY[π/4].#&/@x])],ViewPoint->5{0,0,1}]]

FullSimplify[RootReduce[poly[[1,#[[1]],1,#[[2]]]]&/@(First[Position[PolyhedronFaces[Cube],#]]&/@Range[Length[PolyhedronVertices[Cube]]])]]//InputForm

Stellation

FaceIntersections[poly_]:=Module[{pairs=KSubsets[Take[#,3]&/@First/@poly,2]},
DeleteCases[Intersection3D@@@Map[Plane,pairs,{2}],{}]
]

poly=Cube;
Show[Graphics3D[{Polyhedron[poly],{Red,lines=FaceIntersections[Polyhedron[poly]]},PointSize[.02],points=Intersection3D@@@KSubsets[lines,2]}]]

Gravitational Force

V5

Integrate[Boole[PolyhedronData["Cube","RegionFunction"][x,y,z]]/((x-a)^2+(y-b)^2+(z-c)^2),{x,-∞,∞},{y,-∞,∞},{z,-∞,∞},Assumptions->(a|b|c)∈Reals]//Timing

V8

$Version

Integrate[Boole[PolyhedronData["Cube","RegionFunction"][x,y,z]]/((x-a)^2+(y-b)^2+(z-c)^2),{x,-∞,∞},{y,-∞,∞},{z,-∞,∞},Assumptions->(a|b|c)∈Reals]//Timing

Construction: C3x

Show[PolyhedronData[{"Cube","C3"}],Axes->True,AxesLabel->{"x","y","z"}]

v=RotationMatrix[π/2,{0,0,1}].#&/@PolyhedronData[{"Cube","C3"},"Vertices"]

p=Polyhedron[v,PolyhedronData["Cube","FaceIndices"]]

<<MathWorld`PolyhedronOperations`

PolyhedronInequalities[p,{#1,#2,#3}]//FullSimplify