Tubular Worlds

Jaime Rangel-Mondragón

Permission is hereby granted to reproduce part or all of this file for any purpose other than direct profit providing that the source is acknowledged.

The aim of this work is to present several manipulations of tori and to introduce a novel recursive family arising from their linking.

Acknowledgements

This work was finished at Wolfram Research Inc., in Champaign IL, USA, while the author was spending two months as a Visiting Scholar. Their assistance and enthusiastic support is gratefully acknowledged. My thanks are also given for the continuous support received from the University of Queretaro in Mexico.

The figure below is an example of a torus rendered using the experimental feature RealTime3D in Mathematica , version 4. This feature allows us to manipulate graphics interactively by using the mouse, dragging it to rotate and pressing the Ctr key simultaneously in order to rescale the shape. Before proceeding further, the reader might like to verify the strong appeal this feature conveys by clicking in the figure below (DO NOT activate yet the input cell that generated it) and, after allowing a moment for RealTime3D to download, proceed to manipulate the object.

In order to minimize the size of this notebook, only some of  the shapes are rendered, and in those cases, the option Default3D has been used instead. We strongly recommend re-rendering each one of them via RealTime3D throughout the notebook - mainly the images coded in the last two sections, by issuing now the command

<< RealTime3D`

The speed of the rendering of the notebook will always depend on the resources available. We hope the patience invested in it will be rewarded by the quality of the graphics obtained. We might also want to turn the grid off by using the option Mesh -> False. 

In case the resources are insufficient, the user can re-render all graphics disregarding the above command exercising patience during the last renderings. Alternatively, the user might like to consider the use of GLExplorer, a third party application package developed by Conix Enterprises (http://www.conix3d.com) to further enhance his/her  experience in the design of 3D objects.

majorR = 2;
minorR = 1;
ParametricPlot3D[{(majorR + minorR  Cos[θ]) 
            Cos[φ], (majorR +  
                minorR Cos[θ]) Sin[φ], 
          minorR  Sin[θ]}, {φ, 0, 2  π}, {θ, 0, 
          2  π}, Boxed -> False, Axes -> False];

Modulating

Formally speaking, tori are closed, orientable surfaces of genus 1, which are often identified with a square in which opposite edges are glued pairwise together. Visually, a torus is a doughnut-like object generated by rotating a small circle about a line (the axis of the torus) in such a way that its center traverses a large circle perpendicular to it (the center of which is also regarded as the center of the torus itself). The radius of these circles - which we shall refer to as majorR and minorR, are such that majorR ≳ minorR. We can easily generate a torus by using its parametric equation as was shown previously.

The Mathematica standard package Shapes offers a convenient black-box approach to display tori, controlling the number of  steps used by the parameters θ and φ in traversing the whole circle.

<< Graphics`Shapes`

majorR = 2;
minorR = 1;
Show[Graphics3D[ Torus[majorR, minorR, 10, 5]], 
        Boxed  -> False];

Disregarding the limitation on the relative sizes of the circles we can generate objects that contain a hidden inner structure.

majorR = 1;
minorR = 2;
ParametricPlot3D[{(majorR + minorR  Cos[θ]) 
            Cos[φ] , (majorR + 
                minorR Cos[θ]) Sin[φ], 
          minorR  Sin[θ]}, {φ, 0, π}, {θ, 0, 
          2 π}, Boxed  -> False, 
        Axes -> False];

If we allow the parameter φ (the one responsible for rotating the small circle around the z axis) to influence the z component, we can actually modulate the ups and downs of the traversal section of the object.

majorR  =  4;
minorR  =  1;
ParametricPlot3D[{(majorR + minorR Cos[θ]) 
            Cos[φ] , (majorR + 
                minorR Cos[θ]) Sin[φ], 
          minorR  Sin[θ]  +  Cos[4 φ]}, {φ, 
          0, 2  π}, {θ, 0, 2  π},  Boxed  -> False, 
        Axes  -> False];

We can modulate not only the axis but the path controlled by the parameter φ, which so far is a circle of radius majorR, to produce families of tori. Consider, for example, the use of the polar equation r = R + Sin[n θ]

R = 4;
n = 5;
ParametricPlot[ (R + Sin[n φ]) {Cos[φ], 
            Sin[φ]}, {φ, 0, 2  π}, 
        AspectRatio -> Automatic,  Axes -> None];

n = 7;
Show[
        Table[ParametricPlot[ (R + 
                  Sin[n φ]) {Cos[φ], 
                Sin[φ]}, {φ, 0, 2  π}, 
            AspectRatio -> Automatic,  Axes -> None,  
            DisplayFunction -> Identity], {R, 7}],  
        DisplayFunction -> $DisplayFunction];

Following this, instead of rotating the small circle around a big one, we rotate it in such a way that the above shape is traversed by the parameter φ

majorR  =  4;
minorR  =  1;
n = 5;
ParametricPlot3D[{(majorR + Sin[n φ] + 
                minorR  Cos[θ]) 
            Cos[φ], (majorR + Sin[n φ] + 
                minorR Cos[θ]) Sin[φ], 
          minorR  Sin[θ]}, {φ, 0, 2  π}, {θ, 0, 
          2  π}, Boxed -> False, Axes -> False];

Intersecting

In order to get more flexibility in manipulating tori centered at the origin, let us now describe a general torus by specifying four parameters u, v, t and r defining a vector with size equal to majorR and parallel to the plane on which the big circle lies, a vector v normal to u (of any size), a vector t specifying the location of the center of the torus and r being the value of minorR, respectively.

torus[u_, v_, t_, r_] := 
      Module[{sU, sV, sW, 
          w = u\[Cross]
              v}, 
sU = (Sqrt[u . u]); 
sV = (Sqrt[v . v]); 
sW = (Sqrt[w . w]); 
t + {Cos[φ] (sU + r  Cos[θ]),  r Sin[θ],  
              Sin[φ] (sU + r  Cos[θ])} . {(u/sU), 
              (v/sV), (w/sW)}]

u = {4, 0, 0};
v = {0, 100, 0};
t = {0, 0, 0};
r = 2;
ParametricPlot3D[
        Evaluate[torus[u, v, t, r]], {φ, 0, 2  π}, {θ, 
          0, 2 π}, Boxed -> False, Axes -> False, 
        ViewPoint -> {0, 1, 0}];

The position of the viewpoint was changed in order to override the default one so that we can verify the correctness of the above setting. Note that at this moment we are unable to verify the effect of t in the presence of a single tori.

We can now superimpose several tori by manipulating the former parameters.

n = 3;
a = 5;
α = (π/n);
Show[
        Table[u = 
            a {Cos[α i], Sin[α i], 
                0}; 
v = {-Sin[α i], 
              Cos[α i], 0}; 
ParametricPlot3D[ 
            Evaluate[torus[u, v, {0, 0, 0}, 1]], {φ, 0, 
              2  π}, {θ, 0, 2 π},  Boxed -> False, 
            Axes -> False, DisplayFunction -> Identity], {i, n}], 
        DisplayFunction -> $DisplayFunction];

Three variations on the theme (output supressed):

u = {5, 0, 0};
v = {0, 1, 0};
\(\(Show[
        Table[ParametricPlot3D[\ 
            Evaluate[torus[u, v, 2\ i\ u, i]], 
\ \ \ \ {φ, \ 0, \ 
              2  π}, \ {θ, \ 0, \ 2\ π}, Boxed -> False, 
            Axes -> False, \ DisplayFunction -> Identity], {i, 5}], 
        DisplayFunction -> $DisplayFunction];\)\)

α = (π/2);
\(\(Show[
Table[
i = 
            Mod[j, 2]; 
u = 
            5 {Cos[α\ i], 0, 
                Sin[α\ i]}; 
v = {\(-Sin[α\ i]\), 0, Cos[α\ i]}; 
ParametricPlot3D[\ 
            Evaluate[torus[u, v, {7\ j, 0, 0}, 1]], 
\ \ \ \ {φ, 
              0, 2  π}, {θ, 0, 2\ π}, Boxed -> False, 
            Axes -> False, DisplayFunction -> Identity], {j, 5}], 
        DisplayFunction -> $DisplayFunction];\)\)

α = (π/2);
\(\(Show[
Table[
i = 
            Mod[j, 2]; 
u = 
            5 {0, Cos[α\ i], 
                Sin[α\ i]}; 
v = {0, \(-Sin[α\ i]\), Cos[α\ i]}; 
ParametricPlot3D[\ 
            Evaluate[torus[u, v, {7\ j, 0, 0}, 1]], 
\ \ \ \ {φ, 
              0, 2  π}, {θ, 0, 2\ π}, Boxed -> False, 
            AxesEdge -> None, \ DisplayFunction -> Identity], {j, 
            5}], DisplayFunction -> $DisplayFunction];\)\)

Note that u is effectively taking only two values u={0, 0, 5} or {0, -5, 0}

Linking

In order to make a circular chain, we will need the radius of the chain R and the major and minor radii of the tori composing it. The following comprise several experiments in this direction.

n = 5;
α = (π/n);
R = 5;
minorR = 1;
majorR = 2;
v = {0, 0, 1};
\(\(Show[
Table[
t = 
            R {Cos[α\ j], Sin[α\ j], 
                0}; 
u = \(majorR\ t\)\/R; 
ParametricPlot3D[\ 
            Evaluate[torus[u, v, t, minorR]], 
\ \ \ \ {φ, 0, 
              2  π}, {θ, 0, 2\ π}, Boxed -> False, 
            Axes -> False, DisplayFunction -> Identity], {j, 
            2\ n}], DisplayFunction -> $DisplayFunction, 
        ViewPoint -> \ {0, 0, 1}];\)\)

n = 5;
α = (π/n);
R = 5;
minorR = 1;
majorR = 2;
\(\(Show[
Table[
t = 
            R {Cos[α\ j], Sin[α\ j], 
                0}; 
v = {0, 0, 
              1}; 
u = \(majorR\ t\)\/R; 
If[Mod[j, 2] == 0, w = v; v = u; 
            u = w]; 
ParametricPlot3D[\ 
            Evaluate[torus[u, v, t, minorR]], 
\ \ \ \ {φ, 0, 
              2  π}, {θ, 0, 2\ π}, Boxed -> False, 
            Axes -> False, DisplayFunction -> Identity], {j, 
            2\ n}], DisplayFunction -> $DisplayFunction, 
        ViewPoint -> \ {0, 0, 1}];\)\)

n = 5;
α = (π/n);
minorR = 1;
majorR = 2;
R = minorR + majorR;
\(\(Show[
Table[
t = 
            R {Cos[α\ j], Sin[α\ j], 
                0}; 
v = {0, 0, 
              1}; 
u = \(majorR\ \ t\)\/R; 
If[Mod[j, 2] == 0, v = u; 
            u = {0, 0, 1}]; 
ParametricPlot3D[\ 
            Evaluate[torus[u, v, t, minorR]], 
\ \ \ \ {φ, 0, 
              2  π}, {θ, 0, 2\ π}, Boxed -> False, 
            Axes -> False, DisplayFunction -> Identity], {j, 
            2\ n}], DisplayFunction -> $DisplayFunction, 
        ViewPoint -> \ {0, 0, 1}];\)\)

n = 3;
α = (π/n);
minorR = 1;
majorR = 4;
R = (( 2 (majorR - minorR))/( Sin[α])) ;
\(\(Show[
Table[
t = 
            R {Cos[α\ j], Sin[α\ j], 
                0}; 
v = {0, 0, 
              1}; 
u = \(majorR\ \ t\)\/R; 
If[Mod[j, 2] == 0, t = Cos[α] t; v = u; 
            u = majorR\ {0, 0, 1}]; 
ParametricPlot3D[\ 
            Evaluate[torus[u, v, t, minorR]], 
\ \ \ \ {φ, 0, 
              2  π}, {θ, 0, 2\ π}, Boxed -> False, 
            Axes -> False, DisplayFunction -> Identity], {j, 
            2\ n}], DisplayFunction -> $DisplayFunction, 
        ViewPoint -> \ {0, 0, 1}];\)\)

n = 5;
α = (π/n);
minorR = 1;
majorR = 3;
R = ((2 ( majorR - minorR))/( Sin[α])) ;
\(\(Show[
Table[
t = 
            R {Cos[α\ j], Sin[α\ j], 
                0}; 
v = {0, 0, 
              1}; 
u = \(majorR\ \ t\)\/R; 
If[Mod[j, 2] == 0, t = Cos[α] t; v = u; 
            u = majorR\ {0, 0, 1}]; 
ParametricPlot3D[\ 
            Evaluate[torus[u, v, t, minorR]], 
\ \ \ \ {φ, 0, 
              2  π}, {θ, 0, 2\ π}, Boxed -> False, 
            Axes -> False, DisplayFunction -> Identity], {j, 
            2\ n}], DisplayFunction -> $DisplayFunction, 
        ViewPoint -> \ {0, 0, 1}];\)\)

If majorR < 3 minorR this kind of pattern results and self-intersection cannot be avoided.

n = 5;
α = (π/n);
minorR = 1;
majorR = 2;
R = ((2 ( majorR - minorR))/( Sin[α])) ;
\(\(Show[
Table[
t = 
            R {Cos[α\ j], Sin[α\ j], 
                0}; 
v = {0, 0, 
              1}; 
u = \(majorR\ \ t\)\/R; 
If[Mod[j, 2] == 0, t = Cos[α] t; v = u; 
            u = majorR\ {0, 0, 1}]; 
ParametricPlot3D[\ 
            Evaluate[torus[u, v, t, minorR]], 
\ \ \ \ {φ, 0, 
              2  π}, {θ, 0, 2\ π}, Boxed -> False, 
            Axes -> False, DisplayFunction -> Identity], {j, 
            2\ n}], DisplayFunction -> $DisplayFunction, 
        ViewPoint -> \ {0, 0, 1}];\)\)

ring[n_, minorR_] := 
      Module[{α, R, 
          j}, 
α = (π/n); 
R = ((4  minorR)/( Sin[α])) ; 
Table[
t = 
            N[R {Cos[α j], Sin[α j], 
                  0}]; 
v = {0, 0, 
              1}; 
u = 
            N[((3 minorR  t)/R)]; 
If[
            Mod[j, 2] == 0, t = Cos[α] t; v = u; 
            u = 3 minorR {0, 0, 1}]; 
{u, v, t, 
            minorR}, {j, 2 n}]]

\(u = 
      Map[ParametricPlot3D[\ 
            Evaluate[torus\  @@ \ #], 
\ \ \ \ {φ, 0, 
              2  π}, {θ, 0, 2\ π}, Boxed -> False, 
            Axes -> False, DisplayFunction -> Identity] &, \ \ ring[
          3, 1]]; Show[
u, 
      DisplayFunction -> $DisplayFunction, 
      ViewPoint -> \ {0, 0, 1}];\)

generate[{u_, v_, t_, _}, 
        0] := {{u, v, t, 0.5}}

generate[{u_, v_, t_, n_}, depth_] := 
      Module[{sU, sV, sW, w = u\[Cross]v, α = ((2  π)/n), i, t1, 
          u1, v1, p}, 
sU = 
          N[(Sqrt[u . u])]; 
sV = 
          N[(Sqrt[v . v])]; 
sW = 
          N[(Sqrt[w . w])]; 
p = 
          Table[
t1 = 
              t + sU {Cos[α i], 0, Sin[α i]} . {(u/sU), (v/sV), 
                      (w/sW)}; 
u1 = ((sU/(2 sV))) 
                v; 
v1 = (t1 - t)\[Cross]
                v; 
generate[{u1, v1, t1, n}, 
              depth - 1], 
{i, 
              n}]; 
Flatten[
          Append[p, generate[{u, v, t, n}, 0]], 1]]

Warning: the following rendering took about a minute in a vintage 2000 state of the art 500 MHz PC computer. Successive ones take progressively more time.

h = 
        generate[{{10, 0, 0}, {0, 10, 0}, {0, 0, 0}, 3}, 1]   //  
          N;
\(u = 
      Map[ParametricPlot3D[\ 
            Evaluate[torus\  @@ \ #], 
\ \ \ \ {φ, 0, 
              2  π}, {θ, 0, 2\ π}, Boxed -> False, 
            Axes -> False, DisplayFunction -> Identity] &, \ \ h]; 
    Show[
u, DisplayFunction -> $DisplayFunction, 
      ViewPoint -> \ {1, 1, 0.75}];\)

h = 
        generate[{{10, 0, 0}, {0, 10, 0}, {0, 0, 0}, 3}, 2]   //  
          N;
\(u = 
      Map[ParametricPlot3D[\ 
            Evaluate[torus\  @@ \ #], 
\ \ \ \ {φ, 0, 
              2  π}, {θ, 0, 2\ π}, Boxed -> False, 
            Axes -> False, DisplayFunction -> Identity] &, \ \ h]; 
    Show[
u, DisplayFunction -> $DisplayFunction, 
      ViewPoint -> \ {1, 1, 0.75}];\)

h = 
        generate[{{10, 0, 0}, {0, 10, 0}, {0, 0, 0}, 3}, 3]   //  
          N;
\(\(u = 
        Map[ParametricPlot3D[\ 
              Evaluate[torus\  @@ \ #], 
\ \ \ \ {φ, 0, 
                2  π}, {θ, 0, 2\ π}, Boxed -> False, 
              Axes -> False, 
              DisplayFunction -> 
                Identity] &, \ \ h];\)\)
Show[
u, DisplayFunction -> $DisplayFunction, 
        ViewPoint ->  {1, 1, 0.75}];

h = 
        generate[{{10, 0, 0}, {0, 10, 0}, {0, 0, 0}, 3}, 4]   //  
          N;
\(u = 
      Map[ParametricPlot3D[\ 
            Evaluate[torus\  @@ \ #], 
\ \ \ \ {φ, 0, 
              2  π}, {θ, 0, 2\ π}, Boxed -> False, 
            Axes -> False, DisplayFunction -> Identity] &, \ \ h]; 
    Show[
u, DisplayFunction -> $DisplayFunction, 
      ViewPoint -> \ {1, 1, 0.75}];\)

h = 
        generate[{{10, 0, 0}, {0, 10, 0}, {0, 0, 0}, 2}, 5]   //  
          N;
\(u = 
      Map[ParametricPlot3D[\ 
            Evaluate[torus\  @@ \ #], 
\ \ \ \ {φ, 0, 
              2  π}, {θ, 0, 2\ π}, Boxed -> False, 
            Axes -> False, DisplayFunction -> Identity] &, \ \ h]; 
    Show[
u, DisplayFunction -> $DisplayFunction, 
      ViewPoint -> \ {0, 0, 1}];\)