Elliptic Cone

Author

Eric W. Weisstein
April 17, 2015

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Surfaces/EllipticCone.nb.

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

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

Figure

Show[EllipticCone[1,1.5],Boxed->False]

LiveGraphics3D

<<Utilities`LiveGraphics3D`

WriteLiveForm[ellcone.m,Show[DropInnerPolygons[EllipticCone[1,1.5]]]]

Equation

Infinite

GroebnerBasis[Append[Thread[{x,y,z}=={a u Cos[v],b u Sin[v],u}],Cos[v]^2+Sin[v]^2==1],{x,y,z},{u,Cos[v],Sin[v]},MonomialOrder->EliminationOrder]

-Numerator[Together[((x^2)/(a^2))+((y^2)/(b^2))-z^2]]

Block[{a=1,b=2},ContourPlot3D[((x^2)/(a^2))+((y^2)/(b^2))-z^2==0,{x,-2,2},{y,-2,2},{z,-2,2},RegionFunction->(-1<#3<1&),PlotRange->All,BoxRatios->Automatic]]

FInite

eqns=#==0&/@Numerator[Together[{x,y,z}-{a(h-u)/h Cos[v],b(h-u)/h Sin[v],u}]]

GroebnerBasis[Append[eqns,Cos[v]^2+Sin[v]^2==1],{x,y,z},{u,Cos[v],Sin[v]},MonomialOrder->EliminationOrder]

FullSimplify[%]

Numerator[Together[((x^2)/(a^2))+((y^2)/(b^2))-(((h-z)^2)/(h^2))]]

With[{a=1,b=2,h=3},ContourPlot3D[((x^2)/(a^2))+((y^2)/(b^2))==(((h-z)^2)/(h^2)),{x,-a,a},{y,-b,b},{z,0,h},PlotRange->All,BoxRatios->Automatic]]

Infinite Cone Properties

cone={a u Cos[v],b u Sin[v],u};

ParametricPlot3D[cone/.{a->1,b->1.5},{u,-1,1},{v,0,2π}]

Curvatures[cone,{u,v},FullSimplify[#,a>0&&b>0&&u∈Reals&&0<v<2π]&]

FullSimplify[PrincipalCurvatures[cone,{u,v}],a>0&&b>0&&(u|v)∈Reals]

Finite Cone Properties

par={a(h-u)/h Cos[v],b(h-u)/h Sin[v],u};

ineq=x^2/a^2+y^2/b^2<=(h-z)^2/h^2&&0≤z≤h;

assum=h>0&&a>0&&b>0;

Centroid

(int=(1/((1/3) a b h π))Assuming[h>0&&a>0&&b>0,Integrate[{x,y,z}Boole[x^2/a^2+y^2/b^2<(h-z)^2/h^2],{z,0,h},{x,-a,a},{y,-b,b}]])//Timing

(int=(1/((1/3) a b h π))Assuming[h>0&&a>0&&b>0,Integrate[{x,y,z}Boole[x^2/a^2+y^2/b^2<(h-z)^2/h^2],{z,0,h},{x,-∞,∞},{y,-∞,∞}]])//Timing

Assuming[assum,Centroid[ineq,{x,y,z}]]//Timing

MetricTensor

FullSimplify[ChristoffelSymbols[{a(h-u)/h Cos[v],b(h-u)/h Sin[v],u},{u,v}],h>0&&a>0&&b>0&&u>0&&0<v<2π]

Curvatures

Curvatures[{a(h-u)/h Cos[v],b(h-u)/h Sin[v],u},{u,v},FullSimplify[#,h>0&&a>0&&b>0]&]

FullSimplify[PrincipalCurvatures[{a(h-u)/h Cos[v],b(h-u)/h Sin[v],u},{u,v}],h>0&&a>0&&b>0]

InertiaTensor

InertiaMatrix[{x,y,z}]

(i=Assuming[h>0&&a>0&&b>0,(1/((1/3) a b h π))Integrate[{{(y^2)+(z^2),-x y,-x z},{-x y,(x^2)+(z^2),-y z},{-x z,-y z,(x^2)+(y^2)}}Boole[x^2/a^2+y^2/b^2<(h-z)^2/h^2],{z,0,h},{x,-a,a},{y,-b,b}]])//Timing

Assuming[assum,InertiaTensor[ineq,{x,y,z}]//FullSimplify]//Timing

MetricTensor

FullSimplify[MetricTensor[{a(h-u)/h Cos[v],b(h-u)/h Sin[v],u},{u,v}],h>0&&a>0&&b>0&&u>0&&0<v<2π]

Surface Area

{ℰ,ℱ,𝒢}=Assuming[assum,FullSimplify[FirstFundamentalForm[par,{u,v}]]]

Assuming[assum,FullSimplify[(Sqrt[ℰ 𝒢-(ℱ^2)])]]

((Sqrt[(((h-u))^2) (2 (a^2) (b^2)+((a^2)+(b^2)) (h^2)+(-(a^2)+(b^2)) (h^2) Cos[2 v])])/((Sqrt[2])(h^2)))

V5.0

(area=Integrate[(Sqrt[ℰ 𝒢-(ℱ^2)]),{u,0,h},{v,0,2π},Assumptions->r>0&&h>0&&0<b<a])//Timing

V5.1

(area=Integrate[(Sqrt[ℰ 𝒢-(ℱ^2)]),{u,0,h},{v,0,2π},Assumptions->h>0&&0<b<a])//Timing

FullSimplify[area,h>0&&0<b<a]

area/.{a->3.7,b->2.2,h->5}

V10

Assuming[assum,FullSimplify[Integrate[(Sqrt[ℰ 𝒢-(ℱ^2)]),{u,0,h},{v,0,2π}]]]//Timing

Assuming[h>0&&0<b<a,FullSimplify[Integrate[(Sqrt[ℰ 𝒢-(ℱ^2)]),{u,0,h},{v,0,2π}]]]//Timing

Assuming[h>0&&0<a<b,FullSimplify[Integrate[(Sqrt[ℰ 𝒢-(ℱ^2)]),{u,0,h},{v,0,2π}]]]//Timing

Numerical Check

expr={b (Sqrt[(a^2)+(h^2)]) EllipticE[(((-(a^2)+(b^2)) (h^2))/((b^2) ((a^2)+(h^2))))],a (Sqrt[(b^2)+(h^2)])EllipticE[((((a^2)-(b^2)) (h^2))/((a^2) ((b^2)+(h^2))))], a (Sqrt[(h^2)+(b^2)]) EllipticE[((1-((b^2)/(a^2)))/(1+((b^2)/(h^2))))],b (Sqrt[(a^2)+(h^2)]) EllipticE[((1-((a^2)/(b^2)))/(1+((a^2)/(h^2))))]};

expr/.{a->1,b->3.14,h->4.}

expr/.{a->3.14,b->1,h->4.}

Assuming[assum,FullSimplify[Subtract@@{b (Sqrt[(a^2)+(h^2)]) EllipticE[(((-(a^2)+(b^2)) (h^2))/((b^2) ((a^2)+(h^2))))],a (Sqrt[(b^2)+(h^2)])EllipticE[((((a^2)-(b^2)) (h^2))/((a^2) ((b^2)+(h^2))))]}]]

should be 0

Block[{a=1,b=π,h=E},{
NIntegrate[(Sqrt[ℰ 𝒢-(ℱ^2)]),{u,0,h},{v,0,2π}],
b (Sqrt[(a^2)+(h^2)]) EllipticE[(((-(a^2)+(b^2)) (h^2))/((b^2) ((a^2)+(h^2))))]+a (Sqrt[(b^2)+(h^2)]) EllipticE[(((a-b) (a+b) (h^2))/((a^2) ((b^2)+(h^2))))],
b (Sqrt[(a^2)+(h^2)]) EllipticE[(((-(a^2)+(b^2)) (h^2))/((b^2) ((a^2)+(h^2))))]+a (Sqrt[(b^2)+(h^2)]) EllipticE[((((a^2)-(b^2)) (h^2))/((a^2) ((b^2)+(h^2))))],
2 a (Sqrt[(h^2)+(b^2)]) EllipticE[((1-((b^2)/(a^2)))/(1+((b^2)/(h^2))))],
2b (Sqrt[(a^2)+(h^2)]) EllipticE[((1-((a^2)/(b^2)))/(1+((a^2)/(h^2))))]
}]//N

Block[{a=π,b=1,h=E},{
NIntegrate[(Sqrt[ℰ 𝒢-(ℱ^2)]),{u,0,h},{v,0,2π}],
b (Sqrt[(a^2)+(h^2)]) EllipticE[(((-(a^2)+(b^2)) (h^2))/((b^2) ((a^2)+(h^2))))]+a (Sqrt[(b^2)+(h^2)]) EllipticE[(((a-b) (a+b) (h^2))/((a^2) ((b^2)+(h^2))))],
b (Sqrt[(a^2)+(h^2)]) EllipticE[(((-(a^2)+(b^2)) (h^2))/((b^2) ((a^2)+(h^2))))]+a (Sqrt[(b^2)+(h^2)]) EllipticE[((((a^2)-(b^2)) (h^2))/((a^2) ((b^2)+(h^2))))],
2 a (Sqrt[(h^2)+(b^2)]) EllipticE[((1-((b^2)/(a^2)))/(1+((b^2)/(h^2))))],
2b (Sqrt[(a^2)+(h^2)]) EllipticE[((1-((a^2)/(b^2)))/(1+((a^2)/(h^2))))]
}]//N

Volume

x[θ_,u_]:=a ((h-u)/h)Cos[θ]
y[θ_,u_]:=b ((h-u)/h)Sin[θ]
z[θ_,u_]:=u

Block[{a=1.5,b=1,h=1},ParametricPlot3D[{x[θ,u],y[θ,u],z[θ,u]},{u,0,h},{θ,0,2π},Axes->False,Boxed->False]
]

FullSimplify[x[θ,u]^2+y[θ,u]^2]

Pi a b Integrate[(((((h-u))^2) )/(h^2)),{u,0,h}]

(int=Assuming[h>0&&a>0&&b>0,Integrate[Boole[x^2/a^2+y^2/b^2<(h-z)^2/h^2],{z,0,h},{x,-a,a},{y,-b,b}]])//Timing

(int=Assuming[h>0&&a>0&&b>0,Integrate[Boole[x^2/a^2+y^2/b^2<(h-z)^2/h^2],{z,0,h},{x,-∞,∞},{y,-∞,∞}]])//Timing

Assuming[assum,Volume[ineq,{x,y,z}]]//Timing

Metric Properties

Metric Tensor

MetricTensor[cone,{u,v}]//FullSimplify

Christoffel Symbol of the Second Kind

FullSimplify[ChristoffelSymbols[cone,{u,v}],a>0&&b>0]

Vector Properties

eqn={a u Cos[v],b u Sin[v],u}
rules={Abs[x_]^(n_/;Mod[n,2]==0):>x^n};
assum=a>0&&b>0&&u∈Reals&&0<v<2π;

Vector Length

Assuming[assum,FullSimplify[Norm[eqn]/.rules]]

Normal Vector

Assuming[assum,FullSimplify[NormalVector[eqn,{u,v}]/.rules]]