# Möbius transformations revealed

Möbius Transformations Revealed is a short video that vividly illustrates the simplicity of Möbius transformations when viewed as rigid motions of the Riemann sphere. It was one of the winners in the 2007 Science and Engineering Visualization Challenge and the various YouTube versions have been viewed some 2,000,000 times.

In the still image below, the colored portion corresponds to a simple square in the plane. The colored portion on the sphere is the image of the square in the plane under (inverse) stereographic projection; the sphere is then rotated into the position shown and finally projected back to the plane. The colored portion on the plane is the image of the original square under a Möbius transformation.

How can we implement this in Mathematica? Is it possible to create a dynamic version with Manipulate that allows us to interact with the image? Can we recreate a portion of the movie? Obviously, Mathematica can't create images of the quality of the original (which was produced with POV-Ray) but how close can we get? Can we generate color or should we stick with simple graphics primitives?

• ... I really hope a self-answer is in progress? Commented Sep 9, 2014 at 13:25
• @YvesKlett Seems like a reasonable expectation. :) I do have an implementation based on simple graphics primitives that I'll post soon. Commented Sep 9, 2014 at 13:32
• That I am much looking forward to :D Commented Sep 9, 2014 at 13:35
• Very nice. Thanks for sharing this.
– user29527
Commented May 16, 2015 at 20:37
• I remember first watching this on the Dimensions-Math.org video series, at a higher resolution. It's good to have the code for a part of its contents :) If you haven't watched these videos, it's totally a must see. Commented May 31, 2015 at 8:52

This is nowhere near as remarkable as Mark McClure's answer (which I have voted for and would upvote more if I could) but I only post it in relation to coloring to illustrated correspondence.

spc[x_, y_] := {2 x, 2 y, -1 + x^2 + y^2}/(1 + x^2 + y^2)
mt[a_, b_, c_, d_][x_, y_] :=
Through[{Re, Im}[(a x + a I y + b)/(c x + c I y + d)]]
q = Flatten[
Table[{{i - 0.1, j - 0.1}, {i - 0.1, j}, {i, j}, {i, j - 0.1}}, {i,
0.1, 1, 0.1}, {j, 0.1, 1, 0.1}], 1];
col = ColorData["Rainbow"][#/100] & /@ Range[100];
Manipulate[
qm = Map[
mt[Complex @@ a, Complex @@ b, Complex @@ c, Complex @@ d] @@ # &,
q, {2}];
planm = Map[##~Join~{0} &, qm, {2}];
Graphics3D[{Opacity[0.4],
InfinitePlane[{0, 0, 0}, {{1, 0, 0}, {0, 1, 0}}], LightBlue,
Sphere[], Opacity[1],
MapThread[{#1, Polygon@#2} &, {col, Map[spc @@ # &, qm, {2}]}],
MapThread[{#1, Polygon@#2} &, {col, planm}]}, Boxed -> False,
Background -> White, FaceGrids -> All,
PlotRange -> Table[{-3, 3}, {3}]], {{a, {1, 0}}, {0.1, 0.1}, {1,
1}}, {b, {0, 0}, {1, 1}}, {c, {0, 0}, {1, 1}}, {{d, {1, 0}}, {0.1,
0.1}, {1, 1}}, ControlPlacement -> Left]


• Nice - and, it deals with the colors much better than I anticipated! Commented Jun 3, 2015 at 0:47
• @MarkMcClure thank you very much...it was a first attempt and if I had time I would improve it...thany you for accept :) Commented Jun 3, 2015 at 1:41

A major point behind the video is that Mobius transformations are simplest when viewed on the sphere. Thus, we'll never actually define a Mobius transformation - we'll do that part on the sphere. Of course, we will need to project back and forth. Here are the stereo graphic projection and it's inverse implemented as compiled functions for speed. This is actually a little more general then plain stereographic projection, as we need to account for the sphere being in general position.

(* Projection from the sphere to the plane *)
stereo = Compile[{{xyz, _Real, 1}, {XYZ, _Real, 1}}, Module[{
r = Sqrt[(xyz[[1]] - XYZ[[1]])^2 + (xyz[[2]] - XYZ[[2]])^2],
theta = ArcTan[(xyz[[1]] - XYZ[[1]]), (xyz[[2]] - XYZ[[2]])]},
{(r (1 + xyz[[3]]))/(1 - XYZ[[3]] + xyz[[3]]) Cos[theta + Pi] + xyz[[1]],
(r (1 + xyz[[3]]))/(1 - XYZ[[3]] + xyz[[3]]) Sin[theta + Pi] + xyz[[2]], 0}]];

(* Projection from the plane to the sphere *)
stereoInv = Compile[{{pq, _Real, 1}, {xyz, _Real, 1}},
{2 pq[[1]], 2 pq[[2]],
pq[[1]]^2 + pq[[2]]^2 - 1}/(pq[[1]]^2 + pq[[2]]^2 + 1) + xyz];


Here's a rectangular grid of points to work with.

(* The initial grid in the xy-plane *)
gridSpan = 1.2; step = 0.2;
plotSpan = 12;
xGrid = Table[{x, y, 0}, {y, -gridSpan, gridSpan, step},
{x, -gridSpan, gridSpan, step/10}];
yGrid = Table[{x, y, 0}, {x, -gridSpan, gridSpan, step},
{y, -gridSpan,
gridSpan, step/10}];
grid = Join[xGrid, yGrid];
(* {0,0} is problematic. *)
grid = DeleteCases[grid, {_?(NumericQ[#] &), _, _}?(Norm[#] < 0.0001 &), Infinity];


The following function accepts a sphere configuration (specified as an $xy, z$ position and $\varphi$, $\theta$ rotation) and returns a picture.

mtrPic[phi_, theta_, vp_, showSphere_, xy_, z_] := Module[{warpedGrid},
Quiet[warpedGrid = Normal[Rotate[
Rotate[Line[Map[stereoInv[#, Flatten[{xy, z}]] &, grid, {2}]],
theta, {0, 0, 1}, Flatten[{xy, 0}]],
phi, {-Sin[theta], Cos[theta], 0}, Flatten[{xy, z}]]];
Graphics3D[{
If[showSphere === True,
{{Opacity[0.8], Sphere[Flatten[{xy, z}]]}, warpedGrid}, {}],
{Map[stereo[Flatten[{xy, z}], #] &, warpedGrid, {3}]},
{Opacity[0.5],
Polygon[plotSpan {{-1, -1, 0}, {1, -1, 0}, {1, 1, 0}, {-1, 1, 0}}]},
{Specularity[White, 20], ColorData["StarryNightColors"][1],
Tube[{{-12, 0, 0}, {12, 0, 0}}, 0.02],
Tube[{{0, -12, 0}, {0, 12, 0}}, 0.02],
Tube[{{0, 0, 0}, {0, 0, 3.8}}, 0.02],
Cone[{{0, 0, 3.7}, {0, 0, 4}}, 0.1]}
}, ImageSize -> 500, ViewPoint -> vp,
ViewAngle -> 30 Degree, Boxed -> False,
PlotRange -> {plotSpan {-1, 1}, plotSpan {-1, 1}, {-1, 4}}],
Power::infy]
];


It's quite easy to use this with Manipulate.

Manipulate[mtrPic[phi, theta, vp, showSphere, xy, z],
{{phi, 0}, 0, Pi}, {{theta, 0}, -Pi, Pi},
{{vp, {1.77141, -2.5135, 1.4121}/4, "view point"},
{{1.77141, -2.5135, 1.4121}/4 -> "perspective", {0, 0, 2} -> "ortho"}},
{{showSphere, True, "show sphere"}, {True, False}},
{{xy, {0, 0}}, (plotSpan - 1) {-1, -1}, (plotSpan - 1) {1, 1},
ControlPlacement -> Left},
{{z, 1}, 0, 3, VerticalSlider, ControlPlacement -> Left},
TrackedSymbols -> {phi, theta, vp, xy, z, showSphere},
SaveDefinitions -> True]


We can also use mtrPic to generate a movie by programatically generating the frames.

xyMotion = Table[4 Sin[2 t] {Cos[t], Sin[t]}, {t, 0, Pi/2, Pi/(99)}];
xyPics = Table[Labeled[mtrPic[0, 0, {1.77141, -2.5135, 1.4121}/4, True, xy, 1],
"translation", Top], {xy, xyMotion}];
thetaMotion = Table[theta, {theta, 0, Pi/2, Pi/99}];
thetaPics = Table[Labeled[
mtrPic[0, theta, {1.77141, -2.5135, 1.4121}/4, True, {0, 0}, 1],
"rotation", Top], {theta, thetaMotion}];
(* The bounce effect is ripped from the Mathematica documentation *)
bounceEqns = {y''[t] == -9.81, y[0] == 1, y'[0] == 0};
c = .9; events = {WhenEvent[y[t] == 0, y'[t] -> -c y'[t]]};
bounce = NDSolveValue[{bounceEqns, events}, y, {t, 0, 5}];
bot1 = t /. FindRoot[bounce[t] == 0, {t, 0.5}];
bot3 = t /. FindRoot[bounce[t] == 0, {t, 2.5}];
zMotion = Table[bounce[t] + 1, {t, bot1, bot3, (bot3 - bot1)/50}];
zPics = Table[Labeled[mtrPic[0, 0, {1.77141, -2.5135, 1.4121}/4, True, {0, 0}, z],
"dilation", Top], {z, zMotion}];
phiMotion = Table[phi, {phi, 0, 2 Pi, 2 Pi/49}];
phiPics = Table[
Labeled[mtrPic[phi, 0, {1.77141, -2.5135, 1.4121}/4, True, {0, 0}, 1],
"inversion", Top],
{phi, phiMotion}];
allTogetherNow = Transpose[{xyMotion, thetaMotion, phiMotion}];
comboPics = Map[Labeled[
mtrPic[#[[3]], #[[2]], {1.77141, -2.5135, 1.4121}/4, True, #[[1]], 1],
"combination", Top] &,
allTogetherNow];
thetaPics2 = First /@ Partition[thetaPics, 2];
allPics = Join[xyPics, thetaPics2, zPics, phiPics, comboPics];


When passed to ListAnimate, this generates a movie that looks something like so:

Note that the animation as shown here can be made much nicer, but stackexhange limits the size of GIFs that we can upload. Again, we've never defined a Mobius transformation but we can see one on the plane. We can also hide the sphere and look at the animation in orthographic perspective.

Obviously, there's more that could be done. It would be interesting to know how nice the image could be by tweaking the graphics directives. I'm sure that adding color by using ParametricPlot3D would be easy, but I'm not sure how responsive the result would be. We might also add color via graphics directives applied to polygons. In both cases, it might be challenging to deal with polygons containing the point that maps to infinity under the Mobius transformation, though.

• I'd give you a thousand +1's if I could. :) Commented Sep 9, 2014 at 14:19
• Whoa! Glad this popped up on "active" - I'd not seen this answer. +100 bounty coming your way...
– ciao
Commented May 16, 2015 at 23:34