Horn Torus

Author

Eric W. Weisstein
June 10, 2014

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

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

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

Figure

Array

TorusPlot[{1,1}]

Cross Section

TorusCrossSection[{1,1}]

LiveGraphics3D

<<Utilities`LiveGraphics3D`

WriteLiveForm["torush1.m",Torus[{1,1}]]

WriteLiveForm["torush2.m",Torus[{1,1},1/2]]

TorusCrossSection[1,1,Ticks->None]

Equation

surf={a Cos[u] (1+Cos[v]),a (1+Cos[v]) Sin[u],a Sin[v]};

Block[{a=1,c=1},ParametricPlot3D[{(c+a Cos[v]) Cos[u],(c+a Cos[v]) Sin[u],a Sin[v]},{u,0,2π},{v,0,2π}]]

Factor[{(c+a Cos[v]) Cos[u],(c+a Cos[v]) Sin[u],a Sin[v]}/.c->a]

Factor/@GroebnerBasis[Join[Thread[{x,y,z}==surf],Cos[#]^2+Sin[#]^2==1&/@{u,v}],{x,y,z},{Cos[u],Sin[u],Cos[v],Sin[v]}]

Expand[eqn=(x^2+y^2+z^2)^2-4a^2(x^2+y^2)]

eqn

Properties

Curvatures[surf,{u,v},FullSimplify[#,a>0&&0<v<2π]&]

FullSimplify[PrincipalCurvatures[surf,{u,v}],a>0&&0<v<2π]

SortBy[FullSimplify[GaussianCurvature[eqn,{x,y,z}]],ByteCount]

Extent

MinValue[{#,eqn},{x,y,z}]&/@{x,y,z}

MaxValue[{#,eqn},{x,y,z}]&/@{x,y,z}//FullSimplify

Surface

ContourPlot3D[Evaluate[eqn==0/.a->1],{x,-2,2},{y,-2,2},{z,-1,1},BoxRatios->Automatic]

Cross Section

eqn

eqn/.{x->0}

ContourPlot[-4 (y^2)+((((y^2)+(z^2)))^2)==0,{y,-2,2},{z,-1,1},AspectRatio->Automatic,MaxRecursion->4,ContourStyle->Red]

Solve[-4a^2 (y^2)+((((y^2)+(z^2)))^2)==0,z]

Plot[(Sqrt[2y-(y^2)]),{y,0,2},AspectRatio->Automatic]

Volume

eqn/.a->1

NIntegrate[Boole[-4 ((x^2)+(y^2))+((((x^2)+(y^2)+(z^2)))^2)<0],{x,-2,2},{y,-2,2},{z,-1,1}]

2.Pi^2

Integrate[Boole[-4 ((x^2)+(y^2))+((((x^2)+(y^2)+(z^2)))^2)<0],{x,-∞,∞},{y,-∞,∞},{z,-∞,∞}]

Integrate[Boole[-4 ((x^2)+(y^2))+((((x^2)+(y^2)+(z^2)))^2)<0],{z,-∞,∞},{y,-∞,∞},{x,-∞,∞}]

2 2π Integrate[y(Sqrt[2 a y-(y^2)]),{y,0,2a},Assumptions->a>0]

FullSimplify[-4 a^2((x^2)+(y^2))+((((x^2)+(y^2)+(z^2)))^2)/.{x->r Cos[θ]Sin[ϕ],y->r Sin[θ]Sin[ϕ],z->r Cos[ϕ]}]

Integrate[Boole[(r^2) (-2 (a^2)+(r^2)+2 (a^2) Cos[2 ϕ])<0]r^2 Sin[ϕ],{r,0,∞},{θ,0,2π},{ϕ,0,π},Assumptions->a>0]

Integrate[Boole[(r^2) (-2 (a^2)+(r^2)+2 (a^2) Cos[2 ϕ])<0]r^2 Sin[ϕ],{θ,0,2π},{ϕ,0,π},{r,0,∞},Assumptions->a>0]

Centroid

Integrate[Boole[(r^2) (-2 (a^2)+(r^2)+2 (a^2) Cos[2 ϕ])<0]r^2 Sin[ϕ]{r Cos[θ]Sin[ϕ],r Sin[θ]Sin[ϕ],r Cos[ϕ]},{θ,0,2π},{ϕ,0,π},{r,0,∞},Assumptions->a>0]

Moment of Inertia Tensor

i=FullSimplify[{{y^2+z^2,-x y,-x z},
{-x y,z^2+x^2,-y z},
{-x z,-y z,x^2+y^2}}/.{x->r Cos[θ]Sin[ϕ],y->r Sin[θ]Sin[ϕ],z->r Cos[ϕ]}]

With[{ρ=(M/(2 (a^3) (π^2)))},ρ Integrate[i Boole[(r^2) (-2 (a^2)+(r^2)+2 (a^2) Cos[2 ϕ])<0]r^2 Sin[ϕ],
{θ,0,2π},{ϕ,0,π},{r,0,∞},Assumptions->a>0]
]

{{(5a^2/8+c^2/2),0,0},{0,(5a^2/8+c^2/2),0},{0,0,(3a^2/4+c^2)}}/.c->a

Surface Area

2π Integrate[(Sqrt[2 a y-(y^2)])(Sqrt[1+((D[(Sqrt[2 a y-(y^2)]),y])^2)]),{y,0,2a},Assumptions->a>0]

Integrate[(a^2) (1+Cos[v]),{v,0,2π},{u,0,2π}]

Metric Properties

Metric Tensor

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

Christoffel Symbol of the Second Kind

FullSimplify[ChristoffelSymbols[surf,{u,v}],a>0]

Vector Properties

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

Vector Length

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

Normal Vector

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