Hemicube

Author

Eric W. Weisstein
October 16, 2023

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

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

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

Solid

GraphicsRow[Graphics3D[{Opacity[.5],PolyhedronData[#,"GraphicsComplex"]},Boxed->False]&/@{"Hemicube","CanonicalHemicube"},Dividers->All]

Graphics3D

Graphics3D[{Opacity[.5],PolyhedronData["Hemicube","GraphicsComplex"]},Boxed->False]

Polyhedron

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

Region

PolyhedronData["Hemicube","Region"]

Net

PolyhedronData["Hemicube","Net"]

PolyhedronData["Hemicube","Net","Colored"]

Definition

Michon

http://nbarth.net/notes/src/notes-calc-raw/others/X-numericana/polyhedra.htm#hexahedra

Wikipedia

https://en.wikipedia.org/wiki/Hexahedron#Convex,_Others

Properties

Initialization

<<MathWorld`Polyhedra`

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

vol=PolyhedronData[pname,"Volume"]

Centroid

PolyhedronData["Hemicube","Centroid"]

RegionCentroid[p]

PolyhedronCentroid[p]

Circumsphere

PolyhedronData["Hemicube","Circumsphere"]

Circumsphere[p]

MyCircumsphere[p]

EdgeLengths

PolyhedronData["Hemicube","EdgeLengths"]

SortBy[PolyhedronEdgeLengths[p],N]

GeneralizedDiameter

PolyhedronData["Hemicube","GeneralizedDiameter"]

GeneralizedDiameter[p]//FullSimplify

InertiaTensor

PolyhedronData["Hemicube","InertiaTensor"]

PolyhedronInertiaTensor[p]//FullSimplify

Insphere

PolyhedronData["Hemicube","Insphere"]

Insphere[p]

MyInsphere[p]

MeanCylindricalRadius

PolyhedronData["Hemicube","MeanCylindricalRadius"]

N[%]

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

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)

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

N[rxyz,20]

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

CAD over  1/2

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

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

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

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

N[rxy,20]

rxysimp1=LogSimplify[rxy]//FullSimplify//TrigToExp

Divergence theorem

(r=MeanCylindricalRadius[p,Debug->True])//Timing

Integrate

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

FullSimplify[rxy]

rxy=(1/384) (128 (Sqrt[2])+102 ArcSinh[1]+36 ArcTanh[((2 (Sqrt[2]))/3)]+6 Log[3363-2378 (Sqrt[2])]+45 Log[3-2 (Sqrt[2])]+96 Log[2-(Sqrt[2])]-72 Log[2+(Sqrt[2])]+24 Log[-4+3 (Sqrt[2])]+16 Log[7+5 (Sqrt[2])]+10 Log[99+70 (Sqrt[2])]+Log[577+408 (Sqrt[2])]-12 Log[-6430084+4546756 (Sqrt[2])]);

TrigToExp[rxy]//FunctionExpand

N[rxy,30]

1/3 * universal parabolic constant

(1/3)(Sqrt[2]+Log[1+Sqrt[2]])//N

FullSimplify[Subtract@@{rxy,(1/3)(Sqrt[2]+Log[1+Sqrt[2]])}]//Timing

N[%15,1000]

MeanSquareCylindricalRadius

PolyhedronData["Hemicube","MeanSquareCylindricalRadius"]

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

Divergence theorem

MeanSquareCylindricalRadius[p]//Timing

MeanSphericalRadius

PolyhedronData["Hemicube","MeanSphericalRadius"]

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

Integrate over polyhedron [unevaluated]

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

CAD [unevaluated]

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

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

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

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

Divergence theorem [wrong integral]

(rxy=MeanSphericalRadius[p,Debug->True])//Timing

Divergence theorem "IntegrationIntervals"->{0,1/3,1/2,2/3,1} [uses 21+ GB]

(rxy=MeanSphericalRadius[p,"IntegrationIntervals"->{0,1/3,1/2,2/3,1},Debug->True])//Timing

> 21 GB

Divergence theorem "IntegrationIntervals"->{0,1/3,1/2,2/3,1} [unevaluated integral]

(rxy=MeanSphericalRadius[p,"Simplification"->FullSimplify,"IntegrationIntervals"->{0,1/3,1/2,2/3,1},Debug->True])//Timing

Integrate over x first

{{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^2)]),{x,xmin,xmax}])//Timing

NIntegrate[(i1/vol),{z,zmin,zmax},{y,ymin,ymax}]

(i2=Integrate[(i1/vol),{z,zmin,zmax},{y,ymin,ymax}])//Timing

MeanSquareSphericalRadius

PolyhedronData["Hemicube","MeanSquareSphericalRadius"]

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

Divergence theorem

MeanSquareSphericalRadius[p]//Timing

Net

PolyhedronData[pname,"Net"]

Total[Area/@Flatten[PolyhedronData[pname,"Net","Polygon"]]]//FullSimplify

PolyhedronData[pname,"SurfaceArea"]

Midsphere

PolyhedronData["Hemicube","Midsphere"]

Midsphere[p]//Timing

SurfaceArea

PolyhedronData["Hemicube","SurfaceArea"]

PolyhedronSurfaceArea[p]//FullSimplify

SurfaceArea[p]//FullSimplify

Volume

vol=PolyhedronData["Hemicube","Volume"]

PolyhedronVolume[p]//FullSimplify

Volume[p]

Construction

Cube truncation

v0=PolyhedronData["Cube","Vertices"];
f=PolyhedronData["Cube","Faces","Coordinates"];

Graphics3D[{{Opacity[.8],PolyhedronData["Cube","Polyhedron"]},MapIndexed[Text[#2[[1]],#,Background->White]&,v0],
MapIndexed[Text[#2[[1]],Mean[#],Background->Yellow]&,f]}]

v=Join[v0[[{1,5,7,3,4}]],Mean/@{v[[{1,2}]],v[[{7,8}]]}];

poly=ConvexHullRegion[v]

poly=Polyhedron[];

vol=NIntegrate[1,{x,y,z}∈poly]

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

(8/3)(Sqrt[2]+Log[1+Sqrt[2]])//N

Tally@SortBy[PolyhedronEdgeLengths[poly],N]

Graphics3D[{Opacity[.8],poly,Dashed,PolyhedronData["Cube","Lines"]},Boxed->False,Method->{"ShrinkWrap"->True}]

g=SkeletonGraph[poly]

RecognizeGraph[%]

GraphData[{"Heptahedral",7},"Embeddings3D"]

Net construction

Graphics3D[{Opacity[.5],PolyhedronData["Hemicube","GraphicsComplex"]},Boxed->False]

Graphics3D[face=PolyhedronData["Hemicube","Polygons"][[-1]]]

PolygonAngle[face]

N[%]

PolyhedronEdgeLengths[PolyhedronData["Hemicube","Polyhedron"]]

PolyhedronData["Hemicube","DihedralAngles"]

v={{0,0},{Sqrt[2],Sqrt[2]},{0,2Sqrt[2]},{-Sqrt[2],Sqrt[2]}};
v=Join[v,{
v[[2]]+(v[[2]]-v[[3]])/2,v[[4]]+(v[[4]]-v[[3]])/2,
v[[3]]+(v[[3]]-v[[4]]),v[[3]]+(v[[3]]-v[[2]]),
v[[2]]+(v[[2]]-v[[1]])/2,v[[4]]+(v[[4]]-v[[1]])/2
}];
v=Join[v,{
v[[7]]+RotationMatrix[ArcCos[(1/5)]].(v[[9]]-v[[7]]),v[[9]]+RotationMatrix[-ArcCos[-(1/5)]].(v[[7]]-v[[9]])
}]//FullSimplify

Sort[{{1,2,3,4},{2,1,5},{1,4,6},{3,2,9,7},{3,8,10,4},{9,12,11,7}}]

ps=Polygon[v,{{1,2,3,4},{2,1,5},{1,4,6},{3,2,9,7},{3,8,10,4},{9,12,11,7}}];
Graphics[{FaceForm[LightYellow,Red],EdgeForm[Black],ps,MapIndexed[Text[#2[[1]],#1,Background->White]&,v]}]

PolygonAngle[Polygon[v,{9,12,11,7}]]

PolyhedronData

PolyhedronDataString

PolyhedronDataString[poly,
"StandardName"->"Hemicube",
"Name"->"hemicube",
"Information"->"Hemicube",
Debug->True]

PolyhedronDataString[canonicalup,
"StandardName"->"CanonicalHemicube",
"Name"->"canonical hemicube",
"Information"->"Hemicube",
Debug->True]