# Fine-tuning stereographic stream plots

I would like to present Möbius transformations on the Riemann sphere. Having found the masterpiece answers to Mapping StreamPlot onto spherical surfaces, I am trying to adapt it to my case (those ones are about something slightly different - when the vector field is periodic to begin with).

This almost works, except I cannot regulate the density; it is either concentrated at the north pole, or features a bald spot around it:

Graphics3D[{StreamPlot[
ReIm[(1 + I) (x + I y)], {x, -3, 3}, {y, -3, 3}][[1]] /.
Arrow[z_] :>
Arrow[z /. {x_Real, y_Real} :> {2 x, 2 y, x^2 + y^2 - 1}/(x^2 + y^2 + 1)],
Opacity[.5], Sphere[]}, ImageSize -> 400, Boxed -> False]


results in

while

Graphics3D[{StreamPlot[
ReIm[(1 + I) (x + I y)], {x, -100, 100}, {y, -100, 100}][[1]] /.
Arrow[z_] :>
Arrow[z /. {x_Real, y_Real} :> {2 x, 2 y, x^2 + y^2 - 1}/(x^2 + y^2 + 1)],
Opacity[.5], Sphere[]}, ImageSize -> 400, Boxed -> False]


(i. e. changing 3 to 100) leaves me with

What would be the correct way to do it?

Later

Have tried to force stream points uniformly along several small concentric circles around origin. It is better but still messy, don't even know why...

Graphics3D[{StreamPlot[
ReIm[(1 + 2 I) (x + I y)], {x, -100, 100}, {y, -100, 100},
StreamPoints -> {
Flatten[Table[2^-c {Cos[a], Sin[a]}, {a, 0, 2 \[Pi], \[Pi]/3}, {c, .2, .8, .2}], 1],
500, 200}][[1]] /.
Arrow[z_] :> Arrow[z /. {x_Real, y_Real} :> {2 x, 2 y, x^2 + y^2 - 1}/(x^2 + y^2 + 1)],
Opacity[.5], Sphere[]}, ImageSize -> 400, Boxed -> False]


• "features a bald spot around it" - if the original StreamPlot[] is over a small domain (e.g. {x, -3, 3}, {y, -3, 3} in the first example), then it's no surprise you don't have much arrows near the point at infinity. – J. M. is in limbo Mar 29 '18 at 5:39
• @J.M. Yes it is probably that - but when I increase the domain it does all squeeze at the north pole – მამუკა ჯიბლაძე Mar 29 '18 at 5:42
• Hmm, may I suggest using spherical coordinates at the outset? StreamPlot[ReIm[(1 + I) (Cot[ϕ/2] Exp[I θ])], {θ, 0, 2 π}, {ϕ, 0, π}] – J. M. is in limbo Mar 29 '18 at 5:44
• @J.M. OK then how to move it to the sphere?? – მამუკა ჯიბლაძე Mar 29 '18 at 5:46
• I am trying to combine your suggestion with the formula from the linked answers but get something totally different – მამუკა ჯიბლაძე Mar 29 '18 at 5:49

As noted, one should already use the Riemann sphere representation of a complex number at the outset:

sp = First[StreamPlot[{{-Sin[θ], Cos[θ]}, {-Cos[θ], -Sin[θ]}}.
ReIm[(1 + I) (Cot[ϕ/2] Exp[I θ])], {θ, 0, 2 π}, {ϕ, 0, π}]];

Graphics3D[{{Opacity[.5], Sphere[]},
sp /. Arrow[v_?MatrixQ] :>
Arrow[Tube[Function[{θ, ϕ}, {Sin[ϕ] Cos[θ], Sin[ϕ] Sin[θ], Cos[ϕ]}] @@@ v]]},
Boxed -> False]


• Thanks - but this is not the plot of the original transformation! – მამუკა ჯიბლაძე Mar 29 '18 at 5:58
• Hmm, something's weird, even though the transformations check out. I'll look into it later. – J. M. is in limbo Mar 29 '18 at 6:15
• Must go like this – მამუკა ჯიბლაძე Mar 29 '18 at 6:45
• Assuming I didn't mess up my Jacobians and everything, I think this should be correct now. – J. M. is in limbo Mar 29 '18 at 14:10
• Maybe I can write up how I derived the Jacobian later, and you might be able to figure what wrong assumptions I made? – J. M. is in limbo Mar 30 '18 at 0:20