Hemiobelisk

Author

Eric W. Weisstein
October 16, 2023

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

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

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

Solid

Rectangular

Graphics3D

Graphics3D[{Opacity[.5],PolyhedronData["Hemiobelisk","GraphicsComplex"]},Boxed->True]

Polyhedron

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

Region

PolyhedronData["Hemiobelisk","Region"]

Net

PolyhedronData["Hemiobelisk","Net"]

PolyhedronData["Hemiobelisk","Net","Colored"]

Canonical

Graphics3D

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

Polyhedron

Graphics3D[{PolyhedronData["CanonicalHemiobelisk","Polyhedron"]}]

Region

PolyhedronData["CanonicalHemiobelisk","Region"]

Net

PolyhedronData["CanonicalHemiobelisk","Net"]

PolyhedronData["CanonicalHemiobelisk","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: "Hemiobelisk" [rectangular]

Initialization

<<MathWorld`Polyhedra`

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

vol=PolyhedronData[pname,"Volume"]

Centroid

PolyhedronData["Hemiobelisk","Centroid"]

RegionCentroid[p]//FullSimplify

PolyhedronCentroid[p]

Circumsphere

PolyhedronData["Hemiobelisk","Circumsphere"]

Circumsphere[p]

MyCircumsphere[p]

EdgeLengths

PolyhedronData["Hemiobelisk","EdgeLengths"]

SortBy[PolyhedronEdgeLengths[p],N]

GeneralizedDiameter

PolyhedronData["Hemiobelisk","GeneralizedDiameter"]

GeneralizedDiameter[p]//FullSimplify

InertiaTensor

PolyhedronData["Hemiobelisk","InertiaTensor"]

PolyhedronInertiaTensor[p]//FullSimplify

Insphere

PolyhedronData["Hemiobelisk","Insphere"]

Insphere[p]

MyInsphere[p]

MeanCylindricalRadius

PolyhedronData["Hemiobelisk","MeanCylindricalRadius"]

N[%]

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

Integrate over polygon [unevaluated]

$Version

(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)

(rxy=((Integrate[(Sqrt[(x^2)+(y^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/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)

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

CAD over  1/2

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

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]

LogSimplify[rxy]//FullSimplify

CAD over  1/4

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

y>0&&z≥0&&2 (y+z)≤2+(Sqrt[2])+2 x&&(Sqrt[2]) y≤1+(Sqrt[2]) x&&x+y<0

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

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

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

N[rxy]

LogSimplify[rxy]//FullSimplify

Inequalities

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

ineq=2 (y+z)≤2+(Sqrt[2])+2 x&&z≥0&&2 z≤2+(Sqrt[2])+2 x+2 y&&(Sqrt[2]) y≤1+(Sqrt[2]) x&&1+(Sqrt[2]) x+(Sqrt[2]) y≥0&&x≤0;

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

ii1=FullSimplify[i1]

(i2=Integrate[ii1,{y,-∞,∞}])//Timing

(i2=Integrate[ii1,{z,-∞,∞}])//Timing

ii2=FullSimplify[i2]

NIntegrate[ii2,{y,-∞,∞}]/vol

(i3=Integrate[ii2,{y,-∞,∞}])//Timing

res=FullSimplify[(i3/vol)]

N[%]

TrigToExp[res]

6 (-Log[1-(1/(Sqrt[2]))]+Log[1+(1/(Sqrt[2]))])//N

Log[(((((1+(1/(Sqrt[2])))/(1-(1/(Sqrt[2]))))))^6)]//N

FullSimplify[(((((1+(1/(Sqrt[2])))/(1-(1/(Sqrt[2]))))))^6)]

FullSimplify[(((1+(1/(Sqrt[2])))/(1-(1/(Sqrt[2])))))]

((2+8 (Sqrt[2])+6 Log[3+2 (Sqrt[2])]+(-4+(Sqrt[2])) Log[1+(Sqrt[2])])/(8 (6+(Sqrt[2]))))//FullSimplify

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

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

((2+8 (Sqrt[2])-6Log[(Sqrt[2])-1]+6Log[(Sqrt[2])+1]+(-4+(Sqrt[2])) Log[1+(Sqrt[2])])/(8 (6+(Sqrt[2]))))//Simplify

FullSimplify[%]

N[(1/136) (-2+23 (Sqrt[2])-(-23+(Sqrt[2])) ArcSinh[1])]

N[(((-23+(Sqrt[2])) )/136) (((-2+23 (Sqrt[2]))/((-23+(Sqrt[2])) ))-ArcSinh[1])]

FullSimplify[((-2+23 (Sqrt[2]))/((-23+(Sqrt[2])) ))]

N[(((-23+(Sqrt[2])) )/136) (-(Sqrt[2])-ArcSinh[1])]

FullSimplify[(((-23+(Sqrt[2])) )/136) (-(Sqrt[2])-ArcSinh[1])]

N[(1/136) (23-(Sqrt[2])) ((Sqrt[2])+ArcSinh[1])]

FullSimplify[(1/136) (23-(Sqrt[2])) ((Sqrt[2])+ArcSinh[1])]

MeanSquareCylindricalRadius

PolyhedronData["Hemiobelisk","MeanSquareCylindricalRadius"]

PolyhedronData["Hemiobelisk","MeanSquareCylindricalRadius"]//FullSimplify

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

MeanSphericalRadius

PolyhedronData["Hemiobelisk","MeanSphericalRadius"]

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

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)

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

CAD over  1/2

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

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

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

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

N[rxy]

LogSimplify[rxy]//FullSimplify

MeanSquareSphericalRadius

PolyhedronData["Hemiobelisk","MeanSquareSphericalRadius"]

PolyhedronData["Hemiobelisk","MeanSquareSphericalRadius"]//FullSimplify

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

Midsphere

PolyhedronData["Hemiobelisk","Midsphere"]

Midsphere[p]

SurfaceArea

PolyhedronData["Hemiobelisk","SurfaceArea"]

PolyhedronSurfaceArea[p]//FullSimplify

SurfaceArea[p]//FullSimplify

Volume

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

PolyhedronVolume[p]//FullSimplify

Volume[p]

Properties: "CanonicalHemiobelisk"

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

vol=4;

Centroid

PolyhedronData["CanonicalHemiobelisk","Centroid"]

RegionCentroid[p]

PolyhedronCentroid[p]

Circumsphere

PolyhedronData["CanonicalHemiobelisk","Circumsphere"]

Circumsphere[p]

MyCircumsphere[p]

EdgeLengths

PolyhedronData["CanonicalHemiobelisk","EdgeLengths"]

SortBy[PolyhedronEdgeLengths[p],N]

GeneralizedDiameter

PolyhedronData["CanonicalHemiobelisk","GeneralizedDiameter"]

GeneralizedDiameter[p]//FullSimplify

InertiaTensor

PolyhedronData["CanonicalHemiobelisk","InertiaTensor"]

PolyhedronInertiaTensor[p]//FullSimplify

Insphere

PolyhedronData["CanonicalHemiobelisk","Insphere"]

Insphere[p]

MyInsphere[p]

MeanCylindricalRadius

PolyhedronData["CanonicalHemiobelisk","MeanCylindricalRadius"]

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

$Version

(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["CanonicalHemiobelisk","MeanSquareCylindricalRadius"]

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

MeanSphericalRadius

PolyhedronData["CanonicalHemiobelisk","MeanSphericalRadius"]

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

MeanSquareSphericalRadius

PolyhedronData["CanonicalHemiobelisk","MeanSquareSphericalRadius"]

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

Midsphere

PolyhedronData["CanonicalHemiobelisk","Midsphere"]

Midsphere[p]//Timing

Region

PolyhedronData[pname,"Region"]

RegionFunction

PolyhedronData[pname,"RegionFunction"]

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

FullSimplify[%]

SurfaceArea

PolyhedronData["CanonicalHemiobelisk","SurfaceArea"]

PolyhedronSurfaceArea[p]//FullSimplify

SurfaceArea[p]//FullSimplify

Volume

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

PolyhedronVolume[p]//FullSimplify

Volume[p]

Construction

By truncation of an elongated pyramid

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

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

v=Join[v0[[{1,7,6,2,3,4,5}]]];

poly=ConvexHullRegion[v]

poly=Polyhedron[];

PolyhedronEdgeLengths[poly]//FullSimplify

InputForm[poly]

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

Graphics3D[{Opacity[.5],poly}]

Length/@Through[{PolyhedronFaces,PolyhedronCoordinates,PolyhedronEdges}[poly]]

g=SkeletonGraph[poly]

RecognizeGraph[%]

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

Canonical

Graphics3D[PolyhedronData["Hemiobelisk","Polyhedron"]]

(poly=FindCanonicalPolyhedron[PolyhedronData["Hemiobelisk","Polyhedron"]])//Timing

Graphics3D[{Opacity[.5],Red,poly,Yellow,Sphere[{0,0,0},1]},Boxed->False]

poly=FindCanonicalPolyhedron[PolyhedronData["Hemiobelisk","Polyhedron"],PrecisionGoal->300,WorkingPrecision->1000,MaxIterations->10000];//Timing

p=Polyhedron[];

poly=FindCanonicalPolyhedron[p,PrecisionGoal->50,WorkingPrecision->1000,MaxIterations->20000];//Timing

SimplifyNumericallyDistinct[PolyhedronEdgeLengths[poly],"Simplification"->RootApproximant]

SimplePolyhedronQ[poly]

Graphics3D[{poly,MapIndexed[Text[#2[[1]],#,Background->White]&,poly[[1]]]},AxesLabel->{x,y,z},Axes->True]

v=poly[[1]];

CoplanarPoints[N[v[[{1,5,4,6,7}]],13]]

m=RotationMatrix[{v[[1]]-Mean[v[[{4,6}]]],{0,0,1}}]

v2=RotationMatrix[Pi/2,{0,1,0}].m.#&/@v;

poly2=Polyhedron[v2,poly[[2]]]

Graphics3D[{poly2,MapIndexed[Text[#2[[1]],#,Background->White]&,v2]},AxesLabel->{x,y,z},Axes->True]

CoplanarPoints[N[v2[[{1,5,4,6,7}]],13]]

v2//N

v3=(#-{0,0,Mean[Drop[v2,{2,3}][[All,-1]]]})&/@v2//Chop

v3=;

poly3=Polyhedron[v3,PolyhedronData["Hemiobelisk","FaceIndices"]]

Graphics3D[{poly3,MapIndexed[Text[#2[[1]],#,Background->White]&,v3]},AxesLabel->{x,y,z},Axes->True]

v3//N

Precision[v3[[1,1]]]

poly4=FindCanonicalPolyhedron[poly3,"ProgressInterval"->1000,Debug->True,PrecisionGoal->1000,WorkingPrecision->2000,MaxIterations->100000];//Timing

poly4[[1]]//N

Graphics3D[poly4]

poly5=FindCanonicalPolyhedron[poly4,"ProgressInterval"->1000,Debug->True,PrecisionGoal->5000,WorkingPrecision->10000,MaxIterations->100000];//Timing

poly5

poly5=Polyhedron[];

<<MathWorld`Polyhedra`

Midsphere[N[poly5],Method->"PointLineDistance",Debug->True]

Midsphere[N[poly5],Debug->True]

<<MathWorld`Polyhedra`

Graphics3D[{poly5,MapIndexed[Text[#2[[1]],#,Background->White]&,N[poly5[[1]],20]]}]

vv=poly5[[1]]//Chop;

vv//N

Map[ToAlgebraicRoot[#,"MaxDegree"->128,WorkingPrecision->4950]&,Chop@poly5[[1]],{2}]

pts={{a,0,z},{x,0,u},{c,0,d},{b,f,z},{g,h,z},{b,-f,z},{g,-h,z}};

PolyhedronEdges[poly5]

Mean[N[poly5[[1]],10][[#]]]&/@PolyhedronEdges[poly5]

es=Mean[N[Chop[poly5[[1]]]][[#]]]&/@Union[Sort/@Join@@(Partition[#,2,1,1]&/@poly5[[2]])]

ids={s[3]->s[2],s[6]->s[5],s[11]->s[9],s[8]->s[7]}

Graphics3D[{
poly5,
{Yellow,Sphere[]},
MapIndexed[Text[pts[[#2[[1]]]],#,Background->White]&,N[poly5[[1]]//Chop]],
MapIndexed[Text[Subscript["s",#2[[1]]],#,Background->White]&,es]
}]

Sort@PolyhedronEdgeLengths[poly5]//N//Tally

rules={a->vv[[1,1]],z->vv[[1,3]],x->vv[[2,1]],u->vv[[2,3]],c->vv[[3,1]],d->vv[[3,3]],b->vv[[4,1]],f->vv[[4,2]],g->vv[[5,1]],h->vv[[5,2]]};

{EuclideanDistance[{b,f,z},{b,-f,z}],EuclideanDistance[{b,f,z},{c,0,d}],EuclideanDistance[{b,f,z},{g,h,z}],EuclideanDistance[{a,0,z},{g,h,z}]}/.rules//N

v=PolyhedronEdges[poly5]/.i_Integer:>pts[[i]]

RegionDistance[Line[#]/.rules,{0,0,0}]&/@v//N[#,20]&

Point-Line distance

n=Length@v

eqn0=DeleteCases[Table[1^2#.#&[Subtract@@v[[i]]]-#.#&[Cross[Subtract@@v[[i]],v[[i,1]]-{0,0,0}]],{i,n}]//FullSimplify//Union,0]

var=Variables[eqn]

Length/@{eqn,var}

FindRoot[Evaluate@Thread[eqn==0],Evaluate@Transpose[{var,N[var/.rules]}]]

(soln=NSolve[eqn,var,Reals])//Timing

(gb=GroebnerBasis[eqn,vars,MonomialOrder->EliminationOrder])//Timing

PointsTangentAndPerpendicular

n=Length@v

eqn1=Table[#.#&[v[[i,1]]-s[i] Subtract@@v[[i]]-{0,0,0}]-1^2,{i,n}]

eqn2=Table[Dot[-Subtract@@v[[i]],v[[i,1]]-s[i] Subtract@@v[[i]]-{0,0,0}],{i,n}]

eqn=FullSimplify[Union[eqn1,eqn2]]//Union

eqn//Column

var=Variables[eqn]

Length/@{eqn,var}

(neweqn=FullSimplify[Union[eqn/.ids]]//Union)//Column

Length[neweqn]

Length[newvar=Union[var/.ids]]

newvar

(soln=NSolve[neweqn,newvar,Reals])//Timing

45+ GB

(gb=GroebnerBasis[eqn,var,Array[s,n],MonomialOrder->EliminationOrder])//Timing

Combine equations

eqnall=Union[eqn,eqn1,eqn2]//FullSimplify//Union

Length[eqnall]

Variables[eqnall]

Length[%]

Net construction

Graphics3D[{Opacity[.5],PolyhedronData["Hemiobelisk","Polyhedron"]},Boxed->False]

UnitDistancePoint[v[[10]],v[[9]]]

v={{-1,0},{0,0},{Sqrt[2],0},{1+Sqrt[2],0},{1+Sqrt[2],-1},{-1,1},{Sqrt[2]+1,1},{1/Sqrt[2],1+1/Sqrt[2]},{0,1},{Sqrt[2],1}};
v=Join[v,{UnitDistancePoint[v[[10]],v[[8]]],UnitDistancePoint[v[[8]],v[[9]]]}]//FullSimplify

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

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

PolyhedronData

PolyhedronDataString[poly,
"StandardName"->"Hemiobelisk",
"Name"->"hemiobelisk",
"Information"->"Hemiobelisk",
Debug->True]