# Non-geometric transformation of Graphics3D primitives

I want to apply non-geometric transformations to polygons etc, the goal is to have a Manipulate objects that behaves like that famous möbius transform video.

Since I was unable to apply non-geometric transformation to a polygon I went ahead and created a bunch of points in the plane and did appropriate transforms to them

(* plane region *)
region = {-1, 1};
d = 0.07;
(* Some points in plane *)
pts = Flatten[Table[{xi, yi, 0},
{xi, First@region, Last@region, d},
{yi, First@region, Last@region, d}]
, 1];
col = ColorData["Rainbow"] /@ Rescale[pts[[All, 1]], region];
(** Projections from plane to sphere on line going through north pole \
of sphere centered at {0, 0, 1} **)

(* Plane to sphere *)
f[vec_] := With[{t = 4/(4 + vec[]^2 + vec[]^2)}, vec*t + (1 - t) {0, 0, 2}]
(* Sphere to plane *)
g[vec_] := With[{t = -(2/(-2 + Last@vec))}, vec*t + (1 - t) {0, 0, 2}]

rt = RotationTransform[2.1, {0, 1, 0}, {0, 0, 1}];
Graphics3D[{
{Black, Opacity[0.3], Sphere[{0, 0, 1}]},
Point[(rt@f@# &) /@ pts, VertexColors -> col],
Point[((g@rt@f@# &) /@ pts), VertexColors -> col]
},
PlotRange -> {{-10, 10}, {-10, 10}, {0, 2}}] I wish that I could instead do something like:

Graphics3D[{
{Black, Opacity[0.3], Sphere[{0, 0, 1}]},
SomeTransformation[Polygon[{ {-1, -1, 0}, {-1, 1, 0}, {1, 1, 0}, {1, -1, 0}}], rt@f@#&],
SomeTransformation[Polygon[{ {-1, -1, 0}, {-1, 1, 0}, {1, 1, 0}, {1, -1, 0}}], g@rt@f@#&]
]


And end up with a smooth output, not just a few points here and there.

Is there already a function like this that I have missed?

If not are there other ways to arrive at the same result?

• Perhaps of use: How can I find the vertexes of a Polygon? Dec 27 '12 at 12:53
• If you use discrete point transformations with the methods below then to get smooth curves you will have to up the number of points defining your (e.g.) Polygon outlines. Dec 27 '12 at 19:05

I understand that it's better to use 3D vector primitives than images at certain stages of the process. Eventually, though, everything gets rasterized, so you could just use ImageTransformation for a quick fix... Manipulate[
compiledFunction = Compile[{{x, _Real}, {y, _Real}, {fg, _Real}},
Module[{r = x + I y},
r = r + fg / r - fg;
{Re[r], Im[r] }]
];
ImageTransformation[img,
compiledFunction[#[], #[], s] &,
DataRange -> {{-1, 1}, {-1, 1}}, Padding -> "Reversed"],
{s, -3, 3, .1}]

• Now all we need is some Pink Floyd and LSD to go with it...
– rm -rf
Dec 27 '12 at 14:17
• Also a lot of fun: stanwagon.com/public/ARCHIVE/QUADRATICCAMERA/… Dec 27 '12 at 18:56
• @rm-rf you go to the wrong sort of parties ... :) Dec 27 '12 at 22:50
• Since you didn't add the link for the Mona Lisa image, I looked for another one and found that this works quite well, too: Escher's Hand with reflecting sphere
– Jens
Dec 28 '12 at 4:24

Using parametrized surfaces it all becomes quite simple

σ[u_, v_] := {u, v, 0};

Manipulate[
(* Rotations *)
rtx = RotationTransform[ϕ, {1, 0, 0}, {0, 0, 1}];
rty = RotationTransform[θ, {0, 1, 0}, {0, 0, 1}];
rtz = RotationTransform[τ, {0, 0, 1}, {0, 0, 1}];
rt = rtz@rty@rtx@# &;

Show[
ParametricPlot3D[{g@rt@f@σ[u, v], rt@f@σ[u, v]},
{u, -1, 1}, {v, -1, 1},
ColorFunction -> Function[{x, y, z, u, v},
ColorData["Rainbow"][Rescale[u, {-1, 1}]]],
RegionFunction -> Function[{x, y, z, u, v}, Last@rt@f@σ[u, v] < 1.999],
ColorFunctionScaling -> False,
PlotRange -> {{-5, 5}, {-5, 5}, {-0.001, 2}},
Mesh -> 5],
Graphics3D[{
{Point[{0, 0, 2}]},
{Gray, Opacity[0.7], Sphere[{0, 0, 1}, 0.99]}}]
], {θ, 0, 2 Pi}, {ϕ, 0, 2 Pi}, {τ, 0, 2 Pi}] Update Fixed problem with north pole being covered

Compiling the functions give better interactivity

Clear[θ, ϕ, τ]
rtx = RotationTransform[ϕ, {1, 0, 0}, {0, 0, 1}];
rty = RotationTransform[θ, {0, 1, 0}, {0, 0, 1}];
rtz = RotationTransform[τ, {0, 0, 1}, {0, 0, 1}];
rt = rtz@rty@rtx@# &;

tosphere = Compile[{u, v, θ, ϕ, τ},
Evaluate[FullSimplify[rt@f@σ[u, v], _ ∈ Reals]]
, CompilationTarget -> "C",
RuntimeOptions -> "Speed"];
toplane = Compile[{ u, v, θ, ϕ, τ},
Evaluate[FullSimplify[g@rt@f@σ[u, v], _ ∈ Reals]]
, CompilationTarget -> "C",
RuntimeOptions -> "Speed"];

Manipulate[
Show[
ParametricPlot3D[{toplane[u, v, θ, ϕ, τ],
tosphere[u, v, θ, ϕ, τ]},
{u, -1, 1}, {v, -1, 1},
ColorFunction -> Function[{x, y, z, u, v}, ColorData["Rainbow"][Rescale[u, {-1, 1}]]],
RegionFunction -> Function[{x, y, z, u, v}, Last@tosphere[u, v, θ, ϕ, τ] < 1.999],
ColorFunctionScaling -> False,
PlotRange -> {{-5, 5}, {-5, 5}, {-0.001, 2}},
Mesh -> 5,
PerformanceGoal -> "Quality"],
Graphics3D[{
{Point[{0, 0, 2}]},
{Gray, Opacity[0.7], Sphere[{0, 0, 1}, 0.99]}}]
], {θ, 0, 2 Pi}, {ϕ, 0, 2 Pi}, {τ, 0, 2 Pi}]


What you are looking for is GeometricTransformation, specifically the first form

GeometricTransformation[g, tfun]


where g is a graphics primitive (like Polygon) and tfun is a TransformationFunction. You will have to figure out how to turn f and g into an AffineTransform or even more likely a LinearFractionalTransform, but composing them with the rotation is easy:

t = LinearFractionalTransform[{{1, 0, 1}, {0, 1, 1}, {1, 1, 1}}]
q = RotationTransform[Pi/3]
Composition[q, t]
(*
TransformationFunction[{{1, 0, 1}, {0, 1, 1}, {1, 1, 1}}]
TransformationFunction[{{1/2, -(Sqrt/2), 0}, {Sqrt/2, 1/2, 0}, {0, 0, 1}}]
TransformationFunction[{
{1/2, -(Sqrt/2), 1/2 - Sqrt/2},
{Sqrt/2, 1/2, 1/2 + Sqrt/2}, {1, 1, 1}
}]
*)

• I thought the whole point of the question was to do non geometric transformations (possibly non-linear)? Does GeometricTransformation take arbitrary functions?
– rm -rf
Dec 27 '12 at 16:42
• @rm-rf it takes whatever can be turned into a TransformationFunction, so within the scope of a Möbius transform, then yes it can as those are called LinearFractionalTransform in mma. Dec 27 '12 at 16:44
• Sadly if the TransformationFunction returned by LinearFractionalTransform is not affine GeometricTransformation gives the GeometricTransformation::nonaffine error
– ssch
Dec 27 '12 at 18:56
• And FindGeometricTransform gives quite big alignment error for the transformations in question @rm-rf see above comment
– ssch
Dec 27 '12 at 18:59
• @ssch well that sucks. I would have thought it could handle any TransformationFunction, otherwise I would not have suggested it. Dec 28 '12 at 3:06