Loxodrome Art

Manipulate[Show[
Table[
ParametricPlot3D[{(((4a)E^(θ t))Cos[t])/(4+a^2E^((2θ)t)),(((4a)*E^(θ t))Sin[t])/(4+a^2E^((2θ)t)),1-8/(4+a^2E^((2θ)t))},{t,-12 π,12 π},PerformanceGoal->"Speed",PlotPoints->ControlActive[12,80],PlotStyle->AbsoluteThickness[th],ColorFunction->Function[{x,y,z,u},ColorData[scheme,(θ-θMin)/θRange]],PlotRange->1,Axes->False,Boxed->False],{θ,θMin+θRange,θMin,-θRange/(m-1)}],Graphics3D[{Opacity[0.25],Sphere[]}],ViewAngle->20 °,Lighting->"Neutral",ImageSize->400],
Style["loxodrome specification",Bold],
"parameter a",{{a,1.33,""},.01,2,.01,ImageSize->Small,Appearance->"Labeled"},
"bearing angle start (Subscript[θ, min])",{{θMin,.4,""},.01,π,.01,ImageSize->Small,Appearance->"Labeled"},
"bearing angle range (Subscript[θ, range])",{{θRange,.86,""},.001,2,.001,ImageSize->Small,Appearance->"Labeled"},
Style["\nloxodrome appearance",Bold],
"number of curves m",{{m,32,""},2^Range[1,6],SetterBar},
"color scheme",{{scheme,"BrightBands",""},ColorData["Gradients"]},
"curve thickness",{{th,3,""},Range[6]},
ControlPlacement->Left,TrackedSymbols:>True]

The parametric equation of a loxodrome on the unit sphere can be expressed as (x,y,z)=(((cos(t) ((4 a) (e^(θ t))))/(4+(a^2) (e^(2 θ t)))),((sin(t) ((4 a) (e^(θ t))))/(4+(a^2) (e^(2 θ t)))),1-(8/(4+(a^2) (e^(2 θ t))))). This family of curves is parametrized by a and θ. In this Demonstration, you can continuously vary the parameter a and see m curves obtained by using values of the parameter θ spaced evenly from (Subscript[θ, min]) to (Subscript[θ, range]).

Varying the parameter a or the number of curves m, or changing the range of the bearing angle θ, yields some interesting artistic images.

Contributed by: Erik Mahieu