Sphericon

Author

Eric W. Weisstein
February 3, 2022

This notebook downloaded from http://mathworld.wolfram.com/notebooks/SolidGeometry/Sphericon.nb.

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

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

Net

With[
{
θ=Pi Sqrt[2]/4,
x=Cos[Pi/2-θ],
y=Sin[Pi/2-θ],
off=.15
},
Graphics[{
Circle[{0,0},1,{Pi/2-θ,Pi/2+θ}],
Circle[{x,y},1,{3Pi/2-θ,3Pi/2+θ}],
Circle[{2x,0},1,{Pi/2-θ,Pi/2+θ}],
Circle[{3x,y},1,{3Pi/2-θ,3Pi/2+θ}],
Line[{{-x,y},{0,0},{x,y},{2x,0},{3x,y},{4x,0}}],
Text[HoldForm[θ],#]&/@{{0,off},{x,y-off},{2x,off},{3x,y-off}}
}]
]

Plots

Graphics3D

Show[SolidData["Sphericon","Graphics3D"],ImageSize->Small,Method->{"ShrinkWrap"->True}]

Region

Region[SolidData["Sphericon","Region"][1]]

RegionPlot3D

Solve[π/2==2ArcTan[c],c]

With[{h=1,r=1,a=1},RegionPlot3D[(((x^2+y^2)/(((r/h))^2))<(((Abs[z]-h))^2)&&x>0&&-h<z<h)||(((x^2+z^2)/(((r/h))^2))<(((Abs[y]-h))^2)&&x<0&&-h<y<h),{x,-a,a},{y,-a,a},{z,-a,a},PlotPoints->40,Boxed->False,Axes->False,ImageSize->Small,Method->{"ShrinkWrap"->True}]]

Rotated bicone halves

V5

bicone=SurfaceOfRevolution[{1-Abs[z],z},{z,-1,1},
PlotPoints->{15,25},Boxed->False,Axes->False,opts]

WriteLiveForm["spherico.m",
Show[knife[bicone,{1,0,0,0},{Pi/2,0,0},{0,0,0}],Boxed->False]]

Properties

Centroid

EntityValue

Entity["Solid","Sphericon"]["Centroid"][a]

Integrate

Integrate[{x,y,z}Boole[(x^2+y^2<(((Abs[z]-1))^2)&&x>0&&-1<z<1)||(x^2+z^2<(((Abs[y]-1))^2)&&x<0&&-1<y<1)],{x,-∞,∞},{y,-∞,∞},{z,-∞,∞}]//Timing

V6

Integrate[{x,y,z}Boole[ineq],{x,-∞,∞},{y,-∞,∞},{z,-∞,∞},Assumptions->a>0]//Timing

Integrate[{x,y,z}Boole[ineq],{z,-∞,∞},{y,-∞,∞},{x,-∞,∞},Assumptions->a>0]//Timing

V7

Integrate[{x,y,z}Boole[ineq],{x,-∞,∞},{y,-∞,∞},{z,-∞,∞},Assumptions->a>0]//Timing

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

Integrate[{x,y,z}Boole[ineq],{z,-∞,∞},{y,-∞,∞},{x,-∞,∞},,Assumptions->a>0]//Timing

V8

Integrate[{x,y,z}Boole[ineq],{z,-∞,∞},{y,-∞,∞},{x,-∞,∞},Assumptions->a>0]//Timing

RegionCentroid

RegionCentroid[SolidData["Sphericon","Region"][1]]//Timing

With[
{
reg=Entity["Solid","Sphericon"]["Region"][a],cons=Entity["Solid","Sphericon"]["VariableConstraints"][a]
},
Assuming[cons,RegionCentroid[reg]]
]//Timing

GeneralizedDiameter

Entity["Solid","Sphericon"]["GeneralizedDiameter"]

Solid

({d,soln}=With[{reg=Entity["Solid","Sphericon"]["Region"][1]},
NMaximize[
{
SquaredEuclideanDistance[{x1,y1,z1},{x2,y2,z2}],
{x1,y1,z1}∈reg&&{x2,y2,z2}∈reg
},
{x1,y1,z1,x2,y2,z2}]])//Timing

Graphics3D[{{Opacity[.5],SolidData["Sphericon","Graphics3D"][[1]]},PointSize[Large],Point[{{x1,y1,z1},{x2,y2,z2}}/.soln]}]

Ran overnight  and used 47 GB:

With[{reg=Entity["Solid","Sphericon"]["Region"][1]},
Maximize[
{
SquaredEuclideanDistance[{x1,y1,z1},{x2,y2,z2}],
{x1,y1,z1}∈reg&&{x2,y2,z2}∈reg
},
{x1,y1,z1,x2,y2,z2}]]//Timing

Surface

reg=Region[ImplicitRegion[((\[FormalX]^2)+(\[FormalY]^2)==(((-1+Abs[\[FormalZ]]))^2)&&\[FormalX]>0&&-1<\[FormalZ]<1)||((\[FormalX]^2)+(\[FormalZ]^2)==(((-1+Abs[\[FormalY]]))^2)&&\[FormalX]<0&&-1<\[FormalY]<1),{\[FormalX],\[FormalY],\[FormalZ]}]]

Ran for a couple hours:

With[{p1=Array[p,3],p2=Array[q,3]},Maximize[
{
SquaredEuclideanDistance[p1,p2],
p1∈reg&&p2∈reg
},
Join[p1,p2]]]//Timing

Inequality

Entity["Solid","Sphericon"]["Inequalities"][a][x,y,z]

(((x^2+y^2)/(((r/h))^2))<(((Abs[z]-h))^2)&&x>0&&-h<z<h)||(((x^2+z^2)/(((r/h))^2))<(((Abs[y]-h))^2)&&x<0&&-h<y<h)/.{r->a,h->a}

InertiaTensor

MomentOfInertia

With[{
reg=Entity["Solid","Sphericon"]["Region"][1],
vol=Entity["Solid","Sphericon"]["Volume"][1]
},
MomentOfInertia[reg]/vol]//Timing

Integrate

$Version

(inertia=With[{ρ=(M/(Entity["Solid","Sphericon"]["Volume"][1])),ineq=Entity["Solid","Sphericon"]["Inequalities"][1][x,y,z]},
ρ Integrate[{
{y^2+z^2,-x y,-x z},
{-x y,z^2+x^2,-y z},
{-x z,-y z,x^2+y^2}}Boole[ineq],{x,-∞,∞},{y,-∞,∞},{z,-∞,∞}]
])//Timing

inertia//TraditionalForm

V6

V8

With[{ρ=(M/((2 π (a^3))/3))},
ρ Integrate[{{y^2+z^2,-x y,-x z},
{-x y,z^2+x^2,-y z},
{-x z,-y z,x^2+y^2}}Boole[ineq],
{z,-∞,∞},{y,-∞,∞},{x,-∞,∞},Assumptions->a>0]
]//Timing

MeanCylindricalRadius

Entity["Solid","Sphericon"]["MeanCylindricalRadius"][a]

N[%]

With[{ineq=Entity["Solid","Sphericon"]["Inequalities"][1][x,y,z],vol=Entity["Solid","Sphericon"]["Volume"][1]},Integrate[(Sqrt[x^2+y^2]) Boole[ineq],{x,-1,1},{y,-1,1},{z,-1,1}]/vol]//Timing

MeanSphericalRadius

Entity["Solid","Sphericon"]["MeanSphericalRadius"]

ineq=Entity["Solid","Sphericon"]["Inequalities"][1][x,y,z]

NIntegrate[Sqrt[x^2+y^2+z^2] Boole[ineq],{x,0,1},{y,-1,1},{z,-1,1}]

Integrate[Sqrt[x^2+y^2+z^2] Boole[ineq],{x,0,1},{y,-1,1},{z,-1,1}]//Timing

$Version

-NIntegrate[(1/((x^2)+(y^2)+(((-1+(Sqrt[(x^2)+(y^2)])))^2)))(Sqrt[(x^2)+(y^2)]) ((((-1+(Sqrt[(x^2)+(y^2)])))^2) (-1-2 (x^2)-2 (y^2)+2 (Sqrt[(x^2)+(y^2)])) (Sqrt[(1/((x^2)+(y^2)))+(1/(((-1+(Sqrt[(x^2)+(y^2)])))^2))])-((((x^2)+(y^2)))^(3/2)) ArcSinh[((Abs[-1+(Sqrt[(x^2)+(y^2)])])/(Sqrt[(x^2)+(y^2)]))]-(Sqrt[(x^2)+(y^2)]) (((-1+(Sqrt[(x^2)+(y^2)])))^2) ArcSinh[((Abs[-1+(Sqrt[(x^2)+(y^2)])])/(Sqrt[(x^2)+(y^2)]))]),{x,0,1},{y,-(Sqrt[1-(x^2)]),(Sqrt[1-(x^2)])}]

-2NIntegrate[(1/((x^2)+(y^2)+(((-1+(Sqrt[(x^2)+(y^2)])))^2)))(Sqrt[(x^2)+(y^2)]) ((((-1+(Sqrt[(x^2)+(y^2)])))^2) (-1-2 (x^2)-2 (y^2)+2 (Sqrt[(x^2)+(y^2)])) (Sqrt[(1/((x^2)+(y^2)))+(1/(((-1+(Sqrt[(x^2)+(y^2)])))^2))])-((((x^2)+(y^2)))^(3/2)) ArcSinh[((Abs[-1+(Sqrt[(x^2)+(y^2)])])/(Sqrt[(x^2)+(y^2)]))]-(Sqrt[(x^2)+(y^2)]) (((-1+(Sqrt[(x^2)+(y^2)])))^2) ArcSinh[((Abs[-1+(Sqrt[(x^2)+(y^2)])])/(Sqrt[(x^2)+(y^2)]))]),{x,0,1},{y,0,(Sqrt[1-(x^2)])}]

FullSimplify[(1/((x^2)+(y^2)+(((-1+(Sqrt[(x^2)+(y^2)])))^2)))(Sqrt[(x^2)+(y^2)]) ((((-1+(Sqrt[(x^2)+(y^2)])))^2) (-1-2 (x^2)-2 (y^2)+2 (Sqrt[(x^2)+(y^2)])) (Sqrt[(1/((x^2)+(y^2)))+(1/(((-1+(Sqrt[(x^2)+(y^2)])))^2))])-((((x^2)+(y^2)))^(3/2)) ArcSinh[((Abs[-1+(Sqrt[(x^2)+(y^2)])])/(Sqrt[(x^2)+(y^2)]))]-(Sqrt[(x^2)+(y^2)]) (((-1+(Sqrt[(x^2)+(y^2)])))^2) ArcSinh[((Abs[-1+(Sqrt[(x^2)+(y^2)])])/(Sqrt[(x^2)+(y^2)]))]),0<x<1&&0<y<(Sqrt[1-(x^2)])]

-2NIntegrate[(1/((x^2)+(y^2)+(((-1+(Sqrt[(x^2)+(y^2)])))^2)))(Sqrt[(x^2)+(y^2)]) ((((-1+(Sqrt[(x^2)+(y^2)])))^2) (-1-2 (x^2)-2 (y^2)+2 (Sqrt[(x^2)+(y^2)])) (Sqrt[(1/((x^2)+(y^2)))+(1/(((-1+(Sqrt[(x^2)+(y^2)])))^2))])+((((x^2)+(y^2)))^(3/2)) ArcSinh[1-(1/(Sqrt[(x^2)+(y^2)]))]+(Sqrt[(x^2)+(y^2)]) (((-1+(Sqrt[(x^2)+(y^2)])))^2) ArcSinh[1-(1/(Sqrt[(x^2)+(y^2)]))]),{x,0,1},{y,0,(Sqrt[1-(x^2)])}]

$Version

-2Integrate[(1/((x^2)+(y^2)+(((-1+(Sqrt[(x^2)+(y^2)])))^2)))(Sqrt[(x^2)+(y^2)]) ((((-1+(Sqrt[(x^2)+(y^2)])))^2) (-1-2 (x^2)-2 (y^2)+2 (Sqrt[(x^2)+(y^2)])) (Sqrt[(1/((x^2)+(y^2)))+(1/(((-1+(Sqrt[(x^2)+(y^2)])))^2))])+((((x^2)+(y^2)))^(3/2)) ArcSinh[1-(1/(Sqrt[(x^2)+(y^2)]))]+(Sqrt[(x^2)+(y^2)]) (((-1+(Sqrt[(x^2)+(y^2)])))^2) ArcSinh[1-(1/(Sqrt[(x^2)+(y^2)]))]),{y,0,(Sqrt[1-(x^2)])}]//Timing

MeanSquareCylindricalRadius

Entity["Solid","Sphericon"]["MeanSquareCylindricalRadius"][a]

N[%]

With[{ineq=Entity["Solid","Sphericon"]["Inequalities"][1][x,y,z],vol=Entity["Solid","Sphericon"]["Volume"][1]},NIntegrate[(x^2+y^2) Boole[ineq],{x,-1,1},{y,-1,1},{z,-1,1}]/vol]//Timing

With[{ineq=Entity["Solid","Sphericon"]["Inequalities"][1][x,y,z],vol=Entity["Solid","Sphericon"]["Volume"][1]},Integrate[(x^2+y^2) Boole[ineq],{x,-1,1},{y,-1,1},{z,-1,1}]/vol]//Timing

MeanSquareSphericalRadius

Entity["Solid","Sphericon"]["MeanSquareSphericalRadius"][a]

N[%]

With[{ineq=Entity["Solid","Sphericon"]["Inequalities"][1][x,y,z],vol=Entity["Solid","Sphericon"]["Volume"][1]},NIntegrate[(x^2+y^2+z^2) Boole[ineq],{x,-1,1},{y,-1,1},{z,-1,1}]/vol]//Timing

With[{ineq=Entity["Solid","Sphericon"]["Inequalities"][1][x,y,z],vol=Entity["Solid","Sphericon"]["Volume"][1]},Integrate[(x^2+y^2+z^2) Boole[ineq],{x,-1,1},{y,-1,1},{z,-1,1}]/vol]//Timing

SurfaceArea

Entity["Solid","Sphericon"]["SurfaceArea"][a]

Entity["Solid","Bicone"]["SurfaceArea"][a]

N[%]

SurfaceArea

solid=Entity["Solid","Sphericon"]["Region"][1]

SurfaceArea[Entity["Solid","Sphericon"]["Region"][1]]

Area

surface=Region[ImplicitRegion[((\[FormalX]^2)+(\[FormalY]^2)==(((-1+Abs[\[FormalZ]]))^2)&&\[FormalX]>0&&-1<\[FormalZ]<1)||((\[FormalX]^2)+(\[FormalZ]^2)==(((-1+Abs[\[FormalY]]))^2)&&\[FormalX]<0&&-1<\[FormalY]<1),{\[FormalX],\[FormalY],\[FormalZ]}]]

Area[surface]//Timing

Volume

Integrate

Integrate[Boole[(x^2+y^2<(((Abs[z]-1))^2)&&x>0&&-1<z<1)||(x^2+z^2<(((Abs[y]-1))^2)&&x<0&&-1<y<1)],{x,-∞,∞},{y,-∞,∞},{z,-∞,∞}]//Timing

2((1/3)π (r^2)h)/.{r->1,h->1}

V6

(v=Integrate[Boole[ineq],{x,-∞,∞},{y,-∞,∞},{z,-∞,∞},Assumptions->a>0])//Timing

V7

(v=Integrate[Boole[ineq],{x,-∞,∞},{y,-∞,∞},{z,-∞,∞},Assumptions->a>0])//Timing

(v=Integrate[Boole[ineq],{z,-∞,∞},{y,-∞,∞},{x,-∞,∞},Assumptions->a>0])//Timing

V8

(v=Integrate[Boole[ineq],{z,-∞,∞},{y,-∞,∞},{x,-∞,∞},Assumptions->a>0])//Timing

RegionMeasure

Assuming[assum,RegionMeasure[reg]]

Volume

Entity["Solid","Sphericon"]["Volume"][a]

Volume[Entity["Solid","Sphericon"]["Region"][1]]//Timing

With[
{
reg=Entity["Solid","Sphericon"]["Region"][1],cons=Entity["Solid","Sphericon"]["VariableConstraints"][1]
},
Assuming[cons,Volume[reg]]
]//Timing

With[
{
reg=Entity["Solid","Sphericon"]["Region"][a],cons=Entity["Solid","Sphericon"]["VariableConstraints"][a]
},
Assuming[cons,Volume[reg]]
]//Timing

With[
{
reg=Entity["Solid","Sphericon"]["Region"][a],cons=Entity["Solid","Sphericon"]["VariableConstraints"][a]
},
Volume[reg,Assumptions->cons]
]//Timing