# How can I plot a loxodrome?

Can someone show me how to plot a rhumb line (loxodrome) in Mathematica via the ParametricPlot3D function?

Here is what I got so far:

ParametricPlot3D[{Cos[λ]/Cosh[Cot[π/4] λ], Sin[λ]/Cosh[Cot[π/4] λ], Tanh[Cot[π/4] λ]},
{λ, 0, π}]


I am trying to get this one:

• I edited the question with something that shows my tries. I want to draw a rhumb line that starts from the norh pole and has a compas direction of 45° Jun 2, 2013 at 23:36
• You can look at the source code of this demonstration. I think that covers it.
– Jens
Jun 2, 2013 at 23:37
• Thanks Jens, I saw that allready, but was unable to exctract the loxodrome equasion from it. Jun 2, 2013 at 23:47
• Very confused...I thought a loxodrome was one of those arenas from antiquity where they used to race salmon. Aug 8, 2014 at 15:35

Here's a version where you can manipulate the angle under which the meridians of longitude are crossed, using the k slider. To get the full loxodrome from pole to pole, you have to plot from $-2\pi/k$ to $2\pi/k$, which is done automatically here when a = 1.

Furthermore, you can influence which meridian is crossed by changing $\lambda_0$. This is the same as rotating the loxodrome.

Manipulate[Show[
Graphics3D[{Opacity[.4], Specularity[White, 30], Orange,
Sphere[{0, 0, 0}, .95]}],
ParametricPlot3D[{Cos[λ]/Cosh[k (λ - λ0)], Sin[λ]/Cosh[k (λ - λ0)], Tanh[k (λ - λ0)]},
{λ, -2 a π/k, 2 a π/k},
MaxRecursion -> ControlActive[3, 7], PlotPoints -> ControlActive[20, 50]
] /. l : Line[pts_] :> ControlActive[l, Tube[pts]],
SphericalRegion -> True
],
{k, -1, 1, .09},
{{a, 1}, .01, 1},
{λ0, 0, 2 π}
]

• Thanks, thats exactly what I needed. Could you also explain me why k needs to be in range from -0,5 to -0,005 and what does it stand for? Jun 3, 2013 at 0:34
• @Ivana Sorry, I wasn't consistent in my notation with the English wiki. k is defined as k=Cot[beta] where beta is the crossing angle. k's meaningful interval is maybe [-1,1] although it cannot be 0 (which is 90 degree) and close to 0 there are too many lines and the graphic gets slow. But you could of course use something like {k, -1, 1, .09} (cleverly overjumping the 0). Jun 3, 2013 at 0:44
• You could use Sech[]... ;) Jun 3, 2013 at 1:25
• This hangs Mathematica 7. Before I dig into it: any idea why that would happen? Jun 3, 2013 at 7:04
• @Mr.Wizard My first guess is the replacement of Line with Tube. Tube was new in 7 and may not work as expected. You could remove the /.l:Line... part to test this. Then you could decrease the MaxRecursion and PlotPoints settings and if nothing helps even remove Opacity and Specularity. Jun 3, 2013 at 7:20

For a better presentation of the curve we would like to see also the background - in this case a sphere. Let's use your definition of the curve with appropriate options, e.g. MeshFunctions -> {#3&} to visualize parallels.

Show[
ParametricPlot3D[ {Sin[u] Sin[v], Cos[u] Sin[v], Cos[v]},
{u, -Pi, Pi}, {v, -Pi, Pi}, MaxRecursion -> 4, PlotPoints -> 80,
PlotStyle -> { Lighter @ Blue, Specularity[Green, 10]}, Axes -> None,
Boxed -> False, Mesh -> 25, MeshFunctions -> {#3 &}],
ParametricPlot3D[{ Cos[ω]/Cosh[Cot[Pi/4]*ω], Sin[ω]/Cosh[Cot[Pi/4]*ω],
Tanh[Cot[Pi/4]*ω]}, {ω, 0, Pi},
PlotStyle -> {White, Thick}]]


Now it should be much easier to get any desired specific effects.

For more customized presentation we define a function drawing the loxodrome:

loxodrome[a_, b_, ω0_] /; 0.1 < a < Pi/2 && -1 < b < -0.01 && 0 < ω0 < 2 Pi :=
Show[
ParametricPlot3D[
{Sin[u] Sin[v], Cos[u] Sin[v], Cos[v]}, {u, -Pi, Pi}, {v, -Pi, Pi},
MaxRecursion -> 4, PlotPoints -> 80,
PlotStyle -> {Lighter@Blue, Specularity[Green, 10], Opacity[3/5]},
Axes -> None, Boxed -> False, Mesh -> {12, 12}, MeshFunctions -> {#3 &, #4 &},
MeshStyle -> {Dashed, Dashed}],
ParametricPlot3D[
{ Cos[ω]/Cosh[Cot[a](ω - ω0)], Sin[ω]/Cosh[Cot[a](ω - ω0)], Tanh[Cot[a](ω- ω0)]},
{ω, -2 Pi/b, 2 Pi/b}, PlotStyle -> {White, Thick} ]
]


Now we can manipulate the parameters, a, b and ω0, e.g. a determines inclination of the curve to parallels:

Manipulate[ loxodrome[a, b, ω0],
{{a, 3Pi/8}, 0.1, Pi/2}, {{ω0, Pi}, 0, 2 Pi}, {{b, -1/2}, -1, -0.01}]


or simply specify the arguments:

loxodrome[15 Pi/32, -1/8, 19 Pi/10]


• Thanks Artes, appreciate your help. I am trying to get this one upload.wikimedia.org/wikipedia/commons/0/02/Loxodrome-2.gif but unsuccesfully Jun 2, 2013 at 23:59
• @Ivana I provided in my answer meridians and parallels as you expected. Does this satisfy your needs ? Jun 3, 2013 at 14:50

Using the formulae from here, here is a way to plot the loxodrome of a general surface of revolution, specialized to the spherical case:

With[{α = π/4}, (* angle from the latitude *)
f[u_] := Cos[u]; g[u_] := Sin[u];
lox = DSolveValue[{l'[u] == Cot[α] (Sqrt[#.#] &[{f'[u], g'[u]}])/f[u], l[0] == -π/2},
l, u];
Show[RevolutionPlot3D[{f[u], g[u]}, {u, -π, π},
MeshStyle -> Directive[Thin, GrayLevel[1/4], Opacity[1/2]]],
ParametricPlot3D[{f[u] Cos[lox[u]], f[u] Sin[lox[u]], g[u]}, {u, -π, π}] /.
Line -> Tube]]


One can do something similar for the pseudosphere:

With[{α = π/12},
f[u_] := Sech[u]; g[u_] := u - Tanh[u];
lox = DSolveValue[{l'[u] == Cot[α] (Sqrt[#.#] &[{f'[u], g'[u]}])/f[u], l[0] == -π/2},
l, u];
Show[RevolutionPlot3D[{f[u], g[u]}, {u, -3, 3},
MeshStyle -> Directive[Thin, GrayLevel[1/4], Opacity[1/2]]],
ParametricPlot3D[{f[u] Cos[lox[u]], f[u] Sin[lox[u]], g[u]}, {u, -3, 3}] /.
Line -> Tube]]


(Of course, one can use NDSolveValue[] instead if the DE for the loxodrome does not have a closed form solution.)

• Wonderful extension! Jul 27, 2016 at 0:12

AFAIK, loxodrome is the image under the stereographic projection transformation of a logarithmic spiral. So I use the following approach.

Suppose the sphere is Sphere[{0,0,1},1], and the stereographic projection is

stereoMap[{x_, y_}] =
Block[{t},
t {0, 0, 2} + (1 - t) {x, y, 0} /.
Solve[EuclideanDistance[
t {0, 0, 2} + (1 - t) {x, y, 0}, {0, 0, 1}] == 1 && t != 1,
t] // Simplify][[1]];


That is

$$\{x,y\}\mapsto \left\{\frac{4 x}{x^2+y^2+4},\frac{4 y}{x^2+y^2+4},\frac{2 \left(x^2+y^2\right)}{x^2+y^2+4}\right\}$$

stereoMap[{x_, y_}] =
Block[{t},
t {0, 0, 2} + (1 - t) {x, y, 0} /.
Solve[EuclideanDistance[
t {0, 0, 2} + (1 - t) {x, y, 0}, {0, 0, 1}] == 1 && t != 1,
t] // Simplify][[1]];
logspiralMap[θ_] =
With[{a = .05, b = .15},
a*E^(b*θ) {Cos[θ], Sin[θ]}];
loxodromeMap[θ_] = stereoMap[logspiralMap[θ]];
pt = logspiralMap[30];
qt = loxodromeMap[30];
line = Graphics3D[{Red, Line[{{0, 0, 2}, PadRight[pt, 3]}],