Generalised spheres and toruses

Ivan Cnop
Vrije universiteit Brussel
icnop@vub.ac.be

New experiments: SPIROIDS

Warning: generating all objects at once may take some time and memory. 
Timing will depending on your hardware.

<< Default3D`

Spirograph images of the circle.

coords[z_] := {Re[z], Im[z]}

𝓈 = 
        spirograph[(∑_(j = 1)^5) 1/
                Sqrt[j] (E^(j I φ)), φ];

Polynomials and rational functions

We want to define polynomials and some rational functions that are finite Laurent series at the origin. 
We want this input to be independent of the degree and therefore use a list-oriented description of exponents and nonzero coefficients,  
Example:

expList = {-3, -2, 1, 3}

coeffList = { .3,  .65, 1,  .5}

f[x_] := 
      coeffList . (E^(expList I x))

f[x]

𝓈 = spirograph[f[φ], φ];

Another example

expList = {-3, -2, 2, 3, 4}

coeffList = { .3, 1, 3,  .5,  .9}

f[x_] := 
      coeffList . (E^(expList I x))

f[x]

𝓈 = spirograph[f[φ], φ];

Solve[f[x] == 0, x]

ListPlot[coords[x] /. %, PlotRange  -> {-2, 2}]

Show[{%, Graphics[Circle[{0, 0}, 1]]}, 
      AspectRatio -> Automatic]

This allows to check Rouché's theorem.

expList = {1, 2, 3, 4}

coeffList = { .3, 1, 3,  .2}

f[x_] := 
      coeffList . (E^(expList I x))

f[x]

𝓈 = spirograph[f[φ], φ];

Solve[f[x] == 0, x]

ListPlot[coords[x] /. %, PlotRange  -> {-3, 3}]

f[r_, x_] := 
      coeffList . ((E^(expList I x)) (r^expList))

r = 4; 𝓈 = 
      spirograph[f[r, φ], φ];

Do[spirograph[f[r, φ], φ, 
        PlotRange  -> {{-4, 4}, {-4, 4}}], {r,  .7, 
        1.3,  .1}]

Combine these spirographs into a sphere

Turning spirograph of  f  by  the action of  g

If a second function g is defined, we can map the graph of f by rotating along  g  just as if it where the cos and sin describing a sphere

g[x_] := 
      1 (E^( I x)) +  .3 (E^(- I x)) +  .2  (E^(2 I x)) + 
        1  (E^(-2 I x))

𝓈 = spirograph[g[φ], φ];

ParametricPlot3D[{Re[f[x]], Im[f[x]] Re[g[φ]], 
          Im[f[x]] Im[g[φ]]}, {x, 0,  Pi}, {φ, 0, 
          2  Pi}, PlotPoints -> {60, 60}];

Show[%, ViewPoint -> {4, -1,  .5}, 
      BoxRatios -> {1, 1, 1}, Axes -> None, 
      Boxed -> False]

The hang glider

<< RealTime3D`

𝓈 = spirograph[f[φ], φ];

g[x_] := 
      2 (E^( I x)) + 
        1.5 (E^(- I x)) + I

𝓈 = spirograph[g[φ], φ];

tau =  .47 Pi; ro =  .25; a = 1;
f[t_] := 
      6 (a z +  1/(a z) + I) /. 
        z -> (E^(I t)) + 
            ro (E^(I tau))

𝓈 = spirograph[f[φ], φ];

ParametricPlot3D[{Re[f[x]], Im[f[x]] Re[g[φ]], 
          Im[f[x]] Im[g[φ]]}, {x, 0, 2  Pi}, {φ, 0,  
          Pi}, PlotPoints -> {40, 40}];

Middle section

ParametricPlot3D[{Re[f[x]], Im[f[x]] Re[g[φ]], 
          Im[f[x]] Im[g[φ]]}, {x, 0, 2  Pi}, {φ, 
          11 Pi/24, 13  Pi/24}, PlotPoints -> {60, 20}];

Turning spirograph of  f  by  action of  g

Example:  sqrt(x)

f[x_] := (∑_(j = 1)^8) 1/
            Sqrt[j] (E^(j I x))

g[x_] := (∑_(j = 1)^5) (((-1))^j)/
            j (E^(j I x))

ParametricPlot3D[{Re[f[x]], Im[f[x]] Re[g[φ]], 
          Im[f[x]] Im[g[φ]]}, {x, 0,  Pi}, {φ, 0, 
          2  Pi}, PlotPoints -> {40, 40}];

\(\(ParametricPlot3D[
        Prepend[Sqrt[x] 
            coords[\(\(\(\ \)\(∑\)\)\+\(j = 
                      1\)\%8\) E\^\(j\ I\ φ\)/j], x], {x, 0, 1}, {φ, 0, 2\ Pi}, 
        PlotPoints -> {20, 60}];\)\)

Another example

ParametricPlot3D[{Re[g[x]], Im[g[x]] Re[f[φ]], 
          Im[g[x]] Im[f[φ]]}, {x, 0,  Pi}, {φ, 0,  Pi}, 
        PlotPoints -> {80, 80}];

ParametricPlot3D[{Re[g[x]], Im[g[x]] Re[g[φ]], 
          Im[g[x]] Im[g[φ]]}, {x, 0,  Pi}, {φ, 0,  Pi}, 
        PlotPoints -> {80, 80}];

Try these again for different functions f and  g .

f[x_] := (∑_(j = 1)^6) 1/
            Sqrt[j] (E^((j - 2) I x))

g[x_] := (∑_(j = 1)^3) (((-1))^j)/
            j (E^((j - 2) I x))

ParametricPlot3D[{Re[g[x]], Im[g[x]] Re[f[φ]], 
          Im[g[x]] Im[f[φ]]}, {x, 0,  Pi}, {φ, 0,  Pi}, 
        PlotPoints -> {80, 80}];

f[x_] := (∑_(j = 1)^7) 1/
            Sqrt[j] (E^((j - 4) I x))

g[x_] := (∑_(j = 1)^3) (((-1))^j)/
            j (E^((j - 2) I x))

ParametricPlot3D[{Re[g[x]], Im[g[x]] Re[f[φ]], 
          Im[g[x]] Im[f[φ]]}, {x, 0,  3 Pi/2}, {φ, 0,  
          Pi/2}, PlotPoints -> {80, 40}];

\(f[x_] := ∑\+\(j = 1\)\%5 1/
            j\^ .7\ E\^\(\((j - 4)\)\ I\ x\)\)

g[x_] := (∑_(j = 1)^5) (((-1))^j) /
            Sqrt[j] (E^((j - 2) I x))

ParametricPlot3D[{Re[g[x]], Im[g[x]] Re[f[φ]], 
          Im[g[x]] Im[f[φ]]}, {x, 0,  3 Pi/2}, {φ, 0, 
          3 Pi/2}, PlotPoints -> {80, 40}];

𝓈 = spirograph[g[φ], φ];

Ofsetting polynomials

expList = {-2, -1, 2, 4}

coeffList = { .3,  .65, 1,  .5}

offset =  2

f[x_] := 
      coeffList . (E^((expList - offset) I x))

f[x]

𝓈 = spirograph[f[φ], φ];

g[x_] := 
      2 (E^( I x)) +  .3 (E^(- I x)) +  .2  (E^(2 I x)) + 
        1  (E^(-2 I x))

𝓈 = spirograph[g[φ], φ];

ParametricPlot3D[{Re[f[x]], Im[f[x]] Re[g[φ]], 
          Im[f[x]] Im[g[φ]]}, {x, 0, 2  Pi}, {φ, 0,  
          Pi}, PlotPoints -> {80, 80}];

ParametricPlot3D[{Re[g[x]], Im[g[x]] Re[f[φ]], 
          Im[g[x]] Im[f[φ]]}, {x, 0, 2  Pi}, {φ, 0,  
          Pi}, PlotPoints -> {80, 80}];

New experiments: TOROIDS

Definitions and animations

What we obtained so far are generalisations of a sphere

spiroid[f_, g_, opts___] := 
        ParametricPlot3D[{Re[f[x]], Im[f[x]] Re[g[t]], 
            Im[f[x]] Im[g[t]]}, {x, 0,  Pi}, {t, 0, 2  Pi}, 
          opts];

Clear[f, g]

f[t_] := (E^( I t))

g[t_] := (E^( I t))

<< RealTime3D`

spiroid[f, g]

Roll this sphere by mouse manipulation.

We can also make generalisations of a torus

toroid[a_, f_, g_, opts___] := 
        ParametricPlot3D[{(a + Re[g[u]]) Re[f[t]], 
            Im[f[t]] (a + Re[g[u]]), Im[g[u]]}, {t, 0, 2 Pi}, {u, 0, 
            2  Pi}, opts];

toroid[3, f, g]

It looks like a slinky

a = 3; 
    ParametricPlot3D[{(a + Re[g[u]]) Re[f[t]], 
          Im[f[t]] (a + Re[g[u]]), Im[g[u]]} /. u -> 23 t, {t, 0, 
        2 Pi}, PlotPoints -> 360]

torsoid[a_, f_, g_, opts___] := 
        ParametricPlot3D[{(a + Re[g[u +  t/a]]) Re[f[t]], 
            Im[f[t]] (a + Re[g[u +  t/a]]), Im[g[u +  t/a]]}, {t, 0, 
            2 Pi}, {u, 0, 2  Pi}, opts];

torsoid[4, f, g]

What we obtain are "skewed torii". 
Convince yourself by following one of the (not so) parallel curves on the surface of the torus.

An example

Clear[f, g]

expList = {-1, 1, 3, 5};

coeffList = {2, 1,  .8,  .5};

f[x_] := 
      coeffList . (E^(expList I x))

expList = {-3, -2, 1, 3};

coeffList = { .3,  .65, 1,  .5};

f[x_] = 
      coeffList . (E^(expList I x))

f[x]

𝓈 = spirograph[f[t], t];

expList = {-2, -1, 1, 2};

coeffList = {1,  .3, 1,  .2};

g[x_] = 
      coeffList . (E^(expList I x))

g[x]

𝓈 = spirograph[g[t], t];

ParametricPlot3D[{Re[f[x]], Im[f[x]] Re[g[t]], 
          Im[f[x]] Im[g[t]]}, {x, 0,  Pi}, {t, 0, 2  Pi}, 
        PlotPoints -> {60, 60}];

toroid[3, f, g, PlotPoints -> {60, 60}]

torsoid[1, f, f, PlotPoints -> {60, 60}]

spiroid[f, g, PlotPoints -> {40, 40}]

Show[%, ViewPoint -> {2, 1,  .5}, BoxRatios -> {1, 1, 1}, 
      Axes -> None, Boxed -> False]

Another example

Clear[f, g]

f[x_] = (∑_(j = 1)^8) 1/
            Sqrt[j] (E^(j I x))

g[x_] = (∑_(j = 1)^5) (((-1))^j)/
            j (E^(j I x))

spiroid[f, g, PlotPoints -> {20, 40}];

toroid[3, f, g, PlotPoints -> {60, 60}]

Other examples

When polynomial (Fourier) coefficients are related to exponents in a simple way, 
the functions can be written in sum notation

Example 0: an earring

Clear[f, g]

f[x_] = (∑_(j = 1)^4) 1/
              Sqrt[j] (E^((j - 2) I x)) - 
        2

𝓈 = spirograph[f[t], t];

g[x_] = (∑_(j = 1)^4) (((-1))^j)/
              j (E^((j - 2) I x)) - 
        1/2

𝓈 = spirograph[g[t], t];

torsoid[3, g, g, PlotPoints -> 50]

Example 1

Clear[f, g]

f[x_] = (∑_(j = 1)^6) 1/
              Sqrt[j] (E^((j - 2) I x)) - 
        1

g[x_] = (∑_(j = 1)^3) (((-1))^j)/
            j (E^((j - 2) I x))

spiroid[f, g, PlotPoints -> {80, 80}];

toroid[3, f, g, PlotPoints -> {60, 60}]

Example 2

Clear[f, g]

f[x_] = (∑_(j = 1)^7) 1/
            Sqrt[j] (E^((j - 2) I x))

g[x_] = (∑_(j = 1)^3) (((-1))^j)/
            j (E^((j - 2) I x))

spiroid[f, g, PlotPoints -> {80, 40}];

Example 3

Clear[f, g]

\(f[x_] = ∑\+\(j = 1\)\%5 1/
            j\^ .7\ E\^\(\((j - 4)\)\ I\ x\)\)

g[x_] := (∑_(j = 1)^5) (((-1))^j) /
            Sqrt[j] (E^((j - 2) I x))

spiroid[f, g, PlotPoints -> {80, 40}];

Note that this was generated using the simple curve

𝓈 = spirograph[g[t], t];

toroid[4, g, f, PlotPoints -> {60, 60}]

toroid[4, f, g, PlotPoints -> {60, 60}]

Advanced experiments: Bundles and braids

Definitions

We are going to graph the parallel generating curves for toroids and torsoids:

bundle[a_, f_, g_] := 
        Show[Release[ 
            Table[ParametricPlot3D[{(a + Re[g[u]]) Re[f[t]], 
                  Im[f[t]] (a + Re[g[u]]), Im[g[u]]}, {t, 0, 2 Pi}, 
                DisplayFunction -> Identity], {u, 0, 2  Pi, Pi/6}]], 
          DisplayFunction -> $DisplayFunction];

braid[a_, f_, g_] := 
        Show[Release[ 
            Table[ParametricPlot3D[{(a + Re[g[u +  t/a]]) Re[f[t]], 
                  Im[f[t]] (a + Re[g[u +  t/a]]), Im[g[u +  t/a]]}, {t, 
                  0, 2 Pi}, DisplayFunction -> Identity], {u, 0, 
                2  Pi, Pi/6}]], 
          DisplayFunction -> $DisplayFunction];

{(a + Re[g[u +  t/a]]) Re[f[t]], 
      Im[f[t]] (a + Re[g[u +  t/a]]), Im[g[u +  t/a]]}

<< RealTime3D`

bundle[3, g, f]

braid[3, g,  f]

Assignment

Try some of the other functions  f  and  g  to create new forms

The outputs should be judged by an external (arts class) jury. Good luck !