Spherical Spiral

Author

Eric W. Weisstein
April 23, 2013

This notebook downloaded from http://mathworld.wolfram.com/notebooks/SpaceCurves/SphericalSpiral.nb.

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

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

Plot

SphericalSpiral[t_,a_:.2]:=Module[{c=ArcTan[a t]},{Cos[t]Cos[c],Sin[t]Cos[c],-Sin[c]}]

Simplify[Limit[SphericalSpiral[t,a],t->#∞]&/@{-1,1},a>0]

ParametricPlot3D[SphericalSpiral[t],{t,-10Pi,10Pi},Boxed->False,Ticks->None,Axes->False,PlotStyle->Red,ImageSize->Small]

ParametricPlot3D[SphericalSpiral[t,.02],{t,-120,120},Boxed->False,Ticks->None,Axes->False,PlotStyle->Red,ImageSize->Small]

With[{a=1,α=.02},ParametricPlot3D[{a Sin[α t]Cos[t],a Sin[α t]Sin[t],a Cos[α t]},{t,0,200},PlotStyle->Red,Boxed->True,Axes->False,ViewPoint->{2,0,.5}]]

Equation

Parametric

curve=With[{c=ArcTan[a t]},r{Cos[t]Cos[c],Sin[t]Cos[c],-Sin[c]}]

Block[{r=1, a=.2},Show[{
Graphics3D[{Opacity[.3],Sphere[{0,0,0},r]}],
ParametricPlot3D[curve,{t,-30,30},PlotRange->All]}]]

Block[{r=1, a=.5},Show[{
Graphics3D[{Opacity[.3],Sphere[{0,0,0},r]}],
ParametricPlot3D[curve,{t,-30,30},PlotRange->All]}]]

Natural

Solve[s==r (ArcTan[(a^2 t)/Sqrt[1+a^2 (1+t^2)]]+Log[(a t+Sqrt[1+a^2 (1+t^2)])/Sqrt[1+a^2]]/a),t]

Implicit

curve

{(y/z)=-((Sin[t])/(a t)),(x/z)=-((Cos[t])/(a t))}

(((x^2)+(y^2))/(z^2))==(1/((a^2)(t^2)))

Solve[z==-((a r t)/(Sqrt[1+(a^2) (t^2)])),t]

(((((I z)/(a (Sqrt[-(r^2)+(z^2)])))))^(-2))

(x^2)+(y^2)==((r^2)-(z^2))

Eliminate[Thread[{x,y,z}==curve],t]

(((r Sin[t])/(Sqrt[1+(a^2) (t^2)]))/((r Cos[t])/(Sqrt[1+(a^2) (t^2)])))

Eliminate[{(y/x)==Tan[t],z==-((a r t)/(Sqrt[1+(a^2) (t^2)]))},t]

Block[{r=1,a=.2},Show[{
ParametricPlot3D[curve,{t,-10,10},Evaluated->True,PlotStyle->Directive[Red,Thickness[.02]]],
Graphics3D[Sphere[{0,0,0},r]],
ContourPlot3D[((ArcTan[x,y])^2)==((z^2)/((a^2) ((r^2)-(z^2)))),{x,-1,1},{y,-1,1},{z,-1,1},ContourStyle->Opacity[0.8],PlotPoints->20,Mesh->None]
}]]

(a^2) (-(r^2)+(z^2)) ((ArcTan[(y/x)])^2)==-(z^2)

Block[{r=1,a=.5},Show[{
ParametricPlot3D[curve,{t,-10,10},Evaluated->True,PlotStyle->Directive[Red,Thickness[.02]]],
Graphics3D[Sphere[{0,0,0},r]],
ContourPlot3D[ArcTan[x,y]==((-z)/(a(Sqrt[(r^2)-(z^2)]))),{x,-1,1},{y,-1,1},{z,-1,1},Mesh->None]
},PlotRange->1]]

FunctionExpand[ArcTan[x,y],Assumptions->(x|y)∈Reals]

Block[{r=1,a=1/2},Show[{
ParametricPlot3D[curve,{t,-10,10},Evaluated->True,PlotStyle->Directive[Red,Thickness[.02]]],
ContourPlot3D[(x^2)+(y^2)+(z^2)==(r^2),{x,-1,1},{y,-1,1},{z,-1,1},Mesh->None],
ContourPlot3D[(y/x)==Tan[((-z)/(a(Sqrt[(r^2)-(z^2)])))],{x,-1.1,1.1},{y,-1.1,1.1},{z,-1.1,1.1},Mesh->None,MaxRecursion->0,PlotPoints->100]
},PlotRange->1]]

Length[l=With[{a=1/2,r=1,eps=1/100,ds=.005},Flatten[Table[{x,x Tan[((-z)/(a(Sqrt[(r^2)-(z^2)])))],z},{x,-1+eps,1-eps,ds},{z,-1+eps,1-eps,ds}],1]]]

Length[l2=Select[N[l,10],Norm[#]<1.5&]]

Graphics3D[Point[l2]]

lc=ListSurfacePlot3D[l2,Mesh->None,MaxPlotPoints->50]

Block[{r=1,a=1/2},Show[{
ParametricPlot3D[curve,{t,-10,10},Evaluated->True,PlotStyle->Directive[Red,Thickness[.02]]],
(*
Graphics3D[Sphere[{0,0,0},r]],
*)
lc
},PlotRange->1]]

Properties

curve=With[{c=ArcTan[a t]},r{Cos[t]Cos[c],Sin[t]Cos[c],-Sin[c]}]

Simplify[Norm[curve],a>0&&t>0]

Arc Length

ArcLength[curve,{t,-∞,∞}]

ArcLength[curve,{t,-∞,∞},Assumptions->a>0]

FullSimplify[√(((((((a^3) r (t^2))/(((1+(a^2) (t^2)))^(3/2)))-((a r)/(Sqrt[1+(a^2) (t^2)]))))^2)+(((((r Cos[t])/(Sqrt[1+(a^2) (t^2)]))-(((a^2) r t Sin[t])/(((1+(a^2) (t^2)))^(3/2)))))^2)+(((-(((a^2) r t Cos[t])/(((1+(a^2) (t^2)))^(3/2)))-((r Sin[t])/(Sqrt[1+(a^2) (t^2)]))))^2)),a>0&&r>0&&t>0]

Integrate[((r (Sqrt[1+(a^2) (1+(t^2))]))/(1+(a^2) (t^2))),{t,-∞,∞},Assumptions->a>0]

Arc Length Function

FullSimplify[ArcLength[curve,t,Assumptions->a>0&&t>0],r>0&&t>0]

Binormal Vector

b=FullSimplify[BinormalVector[curve,t],a>0&&r>0&&t>0]

FullSimplify[b.b,a>0&&r>0&&t>0]

Curvature

FullSimplify[Curvature[curve,t],a>0&&t>0&&r>0]

Normal Vector

n=FullSimplify[NormalVector[curve,t],a>0&&r>0&&t>0]

FullSimplify[n.n,a>0&&r>0&&t>0]

Tangent Vector

tan=FullSimplify[TangentVector[curve,t],a>0&&r>0&&t>0]

FullSimplify[tan.tan]

Torsion

Factor[FullSimplify[Torsion[curve,t],a>0&&t>0&&r>0]]

TotalCurvature

FullSimplify[TotalCurvature[curve,t],a>0&&t>0&&r>0]

VectorLength

Assuming[assum,FullSimplify[Norm[parm]/.xform]]