Tuba Package Examples

home

Get[tuba]

0. Setup

First open and save tuba.nb to generate tuba.m. Then load package as in

<<"mydirectory/Tuba.m"

After package has been opened, save default options for tube and Graphics3D -- we may need them later!

defaultgraphics  =  
        Options[Graphics3D];
defaulttube  =  Options[tube];
restoreoptions[sym_,  default_] := (SetOptions[sym, #1] &) /@ 
          default;

I. Simple Tubes and Ribbons

(Run this if you have messed with the options and wish to go back to default settings)

restoreoptions[Graphics3D,  
      defaultgraphics]
restoreoptions[tube,  defaulttube]

The basic command tube[curve, color, radius]  draws a tube around a curve. The curve can be given either as a function f:[0,1] -> (ℝ^3) or as a list of  {x,y,z} coordinates.If the curve is given by a function, the function must already be named and defined in a previous line. The second variable gives intrinsic surface colour. Tuba automatically loads the Graphics`Colors package which gives names to a variety of colours. The command AllColors lists the colours.

circlefun[t_]  :=  
        4 {Cos[2 Pi t],  Sin[2 Pi t],  0};
tube[circlefun,  Turquoise,  1]  //  Show;

The function todata changes circlefun to a list,just for fun done here with only 4 evaluation points. Tube defaults to 40 plotting points along the axis,which it finds from the evaluation points using cubic interpolation. A list of points can be fed to tube as well as a function.The command quicktube[curve] chooses unit radius and a white surface color,and sends the result to Show.

circlelist  =  todata[circlefun, 4]
quicktube[circlelist];

We can put some twist on the tube.For example, twistnumber -> 2 adds two full twists around the axis. We first set a few Graphics3D Options.

SetOptions[Graphics3D,  Background ->  GrayLevel[0.3],  
        Boxed  ->  False];
tube[circlefun,  Gold,  1,  twistnumber  ->  2] // 
        Show;

Tubes have nalongtube plotpoints along the axis, and naroundtube plotpoints around. We can create a ribbon by setting naroundtube to 2:

ribboncolors  =  {EdgeForm[Red],  Eggshell};
mobiusstrip  =  
        tube[circlefun,  ribboncolors, 0.6,  twistnumber  ->  0.5,  
            naroundtube ->  2] // Show;

II. Tube algorithms and Range

(Run this if you have messed with the options and wish to go back to default settings)

Note-- you will be sorry if you remove the ; from restoreoptions (The Mathematica book does it the same way). Use Options[tube] afterwards to look at the options.

restoreoptions[Graphics3D,  
        defaultgraphics];
restoreoptions[tube,  defaulttube];

Algorithms (framing) for generating the tubes

There are four algorithms for creating a tube surrounding the curve axis. A closed shape, by default a circle, is created at each position on the axis, usually in a plane perpendicular to the axis (the unusual xytube option has different rules). This circle is generated by finding two perpendicular unit vectors V and W, both perpendicular to the tangent T to the axis. The tips of V and W trace out secondary curves mostly parallel to the axis. Mostly parallel, because they will in general twist about the axis. The default algorithm specifies that the secondaries have locally zero twist number (apart from an optional small correction for rotational transform discussed below). The most common alternative (tubealgorithm ->frenettube) is to use the Frenet normal and binormal for V and W. Others are tubealgorithm -> xytube (circles in xy plane), and tubealgorithm -> {a,b,c} (normal = Cross[tangent, {a,b,c}] ).

SetOptions[Graphics3D, Background ->  GrayLevel[0.9],  
        Boxed  ->  False];
SetOptions[tube,  tubealgorithm  -> 0,  nalongtube ->  120,  
      naroundtube ->  8]

b = 2;  n = 0.5; tuberadius = 0.5;
supercoil[
          t_] :=  {Sin[2  π t] Cos[2  π n Cos[2  π t]],  
          Sin[2  π t] Sin[2  π n Cos[2  π t]],  
          b Cos[2  π t]};
figure8[t_]  :=  {1 Cos[2 Pi t], 3 Sin[4 Pi t],  
          6  Sin[2 Pi t]};

untwisted  =  
        tube[figure8,  {EdgeForm[Black], Yellow}, 
          tuberadius];
frenet  =  
        tube[figure8,  {EdgeForm[Black], Red}, tuberadius,  
          tubealgorithm  -> frenettube] ;
fixed  =  
        tube[figure8,   {EdgeForm[Black], Green},  tuberadius,  
          tubealgorithm  -> {0, 1, 0}] ;
xy  =  
        tube[figure8,   {EdgeForm[Black], Blue},  tuberadius, 
          tubealgorithm  ->  xytube] ;
GraphicsArray[{untwisted, frenet, fixed,  xy}] // 
        Show;

Correcting for Rotational Transform

For closed curves, the secondary curves on the tube may not close up with each other -- because of torsion along the axis, there is a rotational transform which rotates the secondary curves at the t=1 end with respect to their initial positions at t=0.

We add an arrow: arrow[p,q,n] draws an arrow from point p to pointq with main side of the arrow normal to the n direction. We will also make use of a little function which combines a list of Graphics3D objects  into one:

p  =  figure8[0] + 4 tuberadius {1, 0, 0};  
    q =  p - 2.5 tuberadius {1, 0, 0}; 
myarrow  =  arrow[p, q, {0, 0, 1}];

combinegraphics3D[v_] :=  
        Graphics3D[
          Table[v[[i, 1]],  {i,  
              Length[v]}]];

SetOptions[tube,  tubealgorithm  -> 0,  nalongtube ->  120,  
      naroundtube -> 7]; 
    uncorrected  = 
      tube[figure8,  {EdgeForm[Black], Gold}, tuberadius, 
        alignedtube ->  False]; 
    corrected      = 
      tube[figure8,  {EdgeForm[Black], Gold}, tuberadius]; 
    uncorrectedpic  =  
      combinegraphics3D[{uncorrected, myarrow}];
correctedpic      =  
        combinegraphics3D[{corrected, myarrow}];

GraphicsArray[{uncorrectedpic,  correctedpic}] // Show;

The function tuberange allows you to cut away unwanted polygons where tuberange <0:

helix[t_]  :=  {3 Sin[4 Pi t],  3 Cos[4 Pi t],  
          20 t};

rangefun[{x_,  y_,  z_}]  :=  6 - Abs[z  -  10];
sue  =  
        tube[helix,  EmeraldGreen,  1,  naroundtube ->  12, 
            tuberange  ->  rangefun] // Show;

III. Colourful Tubes

(Run this if you have messed with the options and wish to go back to default settings)

restoreoptions[Graphics3D,  
        defaultgraphics];
restoreoptions[tube,  defaulttube];

We can use any graphics directive we like in the second slot of tube.  We will use two directives, EdgeForm[Red] and surface colour Gold. For more than one directive, they must be put inside curly brackets{}. By default, the reflectivity of the surface is increased to 15, to improve the 3D picture quality.

SetOptions[Graphics3D,  Background ->  GrayLevel[0.9],  
        Boxed  ->  False];

circlefun[t_]  :=  
        4 {Cos[2 Pi t],  Sin[2 Pi t],  0};
tube[circlefun,  {EdgeForm[Red], Gold},  1,  
          tubehelicity  ->  2] // Show;

Now specify colour as a function of position. Here s ranges from 0 to 1 and gives position around the tube, while t goes along the tube from 0 to 1. First we make the surface smoother by making more plot points (this will slow things down, of course):

SetOptions[tube,  naroundtube  ->  60, 
        nalongtube -> 100];
SetOptions[Graphics3D,  Boxed -> False];

rainbow[s_, t_] := {EdgeForm[], 
          SurfaceColor[
            Hue[((1 + Sin[2  π (s  + t)])/2)]]};
tube[circlefun,  rainbow,  1,  tubehelicity -> -2] // 
        Show;

IV. Shapely Tubes

(Run this if you have messed with the options and wish to go back to default settings)

restoreoptions[Graphics3D,  
        defaultgraphics];
restoreoptions[tube,  defaulttube];

SetOptions[Graphics3D,  Background ->  GrayLevel[0.9],  
        Boxed  ->  False];

The third variable in tube can be radius from the axis as a function of position [s,t], where s goes around the tube from 0 to 1, and t goes along the axis from 0 to 1.

circlefun[t_]  :=  
        4 {Cos[2 Pi t],  Sin[2 Pi t],  0};
partcirc[t_] :=  circlefun[0.7  t  +  1];

shell[s_, t_] :=  .1  + 3  t  +   2  t^8;

tube[partcirc,  {EdgeForm[],  Gold},  shell] // Show;

Next try an elliptical cross section:

oval[s_, 
          t_] :=  (Sqrt[(((a^2) (b^2))/((b^2) Cos[2 π s]^2 + (a^2) Sin[2  π s]^2))]);

a  = 2;  b  =  1.1;  
    tube[circlefun,  {EdgeForm[],  Gold},  oval,  
        tubehelicity ->  0,  naroundtube ->  50] // 
      Show;

V. Whitehead Link with Arrows

(Run this if you have messed with the options and wish to go back to default settings)

restoreoptions[Graphics3D,  
        defaultgraphics];
restoreoptions[tube,  defaulttube];

SetOptions[Graphics3D,  Background ->  GrayLevel[0.9],  
        Boxed  ->  False];

The function sidearrow places an arrow on a tube plot. It knows about the viewing angle so the arrow never gets hidden behind the tube.

More details: sidearrow[fun, t, eps, radius, theta] draws a red arrow with tail at fun[t] and tip at  fun[t+eps]. The arrow is displaced by radius in the default viewing direction (ViewPoint). Use, e.g.  SetOptions[Graphics3D, ViewPoint -> {-1,1,3}] to change ViewPoint so that sidearrow knows about it. It can be rotated away from the viewing direction by the angle theta.

figure8[t_]  :=  {6 Cos[2 Pi t], 3 Sin[4 Pi t],  
          Sin[2 Pi t]};
 circe[t_]  :=  
        3 { Cos[2 Pi t],  Sin[2 Pi t],  Sin[4 Pi t]};

SetOptions[Graphics3D, ViewPoint -> {0.338,  -1.032,  3.161},  
        RenderAll  ->  True];
SetOptions[tube,  tubealgorithm  -> 0,  nalongtube ->  80,  
        naroundtube ->  12];

\(\(whitehead\  = \ {
			tube[figure8, \ {EdgeForm[], Red}, \ 
              0.4], 
			tube[
              circe, \ {EdgeForm[], 
                Turquoise}, \ \ 0.4], 
\ 
            sidearrow[figure8, \ 0. , \ 0.05, \ 0.7, \ 0, \ 
              arrowcolor -> Gold], 
\ 
            sidearrow[figure8, \ 0.5, \ 0.05, \ 0.7, \ 0, \ 
              arrowcolor -> Gold], 
\ 
            sidearrow[circe, \ 0.46, \ 0.07, \ 4, 0], 
\ 
            sidearrow[circe, \ 1, \ 0.07, \ 0.8, \ \(-0.1\)]} // 
          Show;\)\)

VI. Braids

(Run this if you have messed with the options and wish to go back to default settings)

restoreoptions[Graphics3D,  
        defaultgraphics];
restoreoptions[tube,  defaulttube];

SetOptions[Graphics3D,   Background  ->  GrayLevel[0],  
        ViewPoint  ->  {0, -3, 1},  PlotRange ->  All,  
        Boxed -> False];

size  = 5; height  = 50;
pigfunction[z_]  :=  {Sin[2 Pi z],  Sin[4 Pi z]}
curve1[z_]  :=  
        Join[ size pigfunction[z],  height {z}];
curve2[z_]  :=  
        Join[ size pigfunction[z  -  1/3],  height {z}];
curve3[z_]  :=  
        Join[ size pigfunction[z  +  1/3],  height {z}];
pigtail  =  {curve1, curve2,  curve3};

The function tress[braid] creates a graphics3D object including tubes around each curve in the braid, as well as an upper and lower boundary. Go get some coffee -- this can be slow!

pig  =  tress[pigtail, 1.5] // Show;

VII. Torusknots, Arches, and Artin Braids

(Run this if you have messed with the options and wish to go back to default settings)

restoreoptions[Graphics3D,  
        defaultgraphics];
restoreoptions[tube,  defaulttube];

Torus knots

Torus knots: torusknot[p,q, majorradius,minorradius, t] is a function of t which gives a torusknot curve. The curve is periodic in t with period 1. It is imbedded in a torus described by majorradius and minorradius, and goes p times the long way around and q times the short way around.

SetOptions[Graphics3D,   Background  ->  GrayLevel[0.5],  
        ViewPoint -> {-1. ,  -3. ,  1},  PlotRange ->  All,  
        Boxed -> False];
SetOptions[tube,  naroundtube  ->  12, 
        nalongtube -> 200];

knot35[t_] :=  torusknot[3, 5, 20, 10, t];
tube[knot35,  {EdgeForm[],  Eggshell},  1] // Show;

Arches

Arches: arch[{x1, y1}, {x2, y2}, t] gives a halfcircle in a verticle plane from {x1, y1,0} to {x2, y2, 0}. For more complicated loops above z=0, consider drawing a full circle or ellipse, then cutting off the part below z=0 by creating a function range[z_] = z, then setting tuberange -> range for the tube graphics routine.

corner  =  3;
laurel[t_] :=  
        arch[corner {-1,  -1},  corner {1, 1},  t]; 
hardy[t_] :=  
        arch[2  corner {-1,  1},  1.5 corner {1, -1},  
          t];
xyplane  =  
        Graphics3D[
          Polygon[3  
              corner { {1, 1,  0},  {1,  -1,  
                  0},  {-1, -1,  0},  {-1,  1,  
                  0}}]];

{xyplane,  tube[laurel,  {EdgeForm[],  Banana},  1],  
          tube[hardy,  {EdgeForm[],  MistyRose},  1]} // 
        Show;

Artin Braids

Artin Braids: Let's draw a braid with 6 strings, only four of them braided, with radii 1, distance between endpoints 5, and distance between top and bottom 50. First an Artin word which only braids four strings:

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

Next feed this to artin[word, nstrings]. This creates a set of curves which is rescaled by scaledbraid to have distance between endpoints 10 and distance between top and bottom 70. scaledbraid[braid, xyscale, n] first converts braid to a set of lists of length n.   It then chooses z values so that the ith point in the list for each curve is at z=i-1. Finally feed to tress to see what it looks like!

thisbraid  =  
        scaledbraid[artin[tangledstrings,  6],  10,  70];

SetOptions[Graphics3D,   Background  ->  GrayLevel[0.5],  
        ViewPoint -> {-1. ,  -3. ,  1},  PlotRange ->  All,  
        Boxed -> False];
SetOptions[tube,  naroundtube  ->  10, 
        nalongtube -> 100];

tress[thisbraid,  1] // Show;

VIII. Plaitlist

(Run this if you have messed with the options and wish to go back to default settings)

restoreoptions[Graphics3D,  
        defaultgraphics];
restoreoptions[tube,  defaulttube];

Here is the pigtail braid from Section VI:

size  = 5; height  = 50;
pigfunction[z_]  :=  {Sin[2 Pi z],  Sin[4 Pi z]}
curve1[z_]  :=  
        Join[ size pigfunction[z],  height {z}];
curve2[z_]  :=  
        Join[ size pigfunction[z  -  1/3],  height {z}];
curve3[z_]  :=  
        Join[ size pigfunction[z  +  1/3],  height {z}];
pigtail  =  {curve1, curve2,  curve3};

Plaitlist wraps the braid around a curve of your choice -- the z axis is mapped to the curve, and points in the xy plane are sent to planes normal to the curve.
Here the pigtailbraid is wrapped around the axis mycircle:

SetOptions[Graphics3D, 
        ViewPoint -> {2,  -4,  0.6}];

mycircle[t_]  :=  
        30 {Cos[2 Pi t],  0, Sin[2 Pi t]};
borromean  =  plaitlist[pigtail,  mycircle];  
    colours =  {Green,  Sienna,  Purple};
Table[
          tube[borromean[[
              i]],  {EdgeForm[], 
              colours[[i]]}, 1.4],  {i, 
            3}] // Show;

These are the Borromean rings: take away any one ring, and the other two are unlinked. For example:

Table[
          tube[borromean[[
              i]],  {EdgeForm[], 
              colours[[i]]}, 1.4,  
            nalongtube ->  200],  {i, 3}] // Show;

IX. Fluxlines and Satellites

(Run this if you have messed with the options and wish to go back to default settings)

Note-- you will be sorry if you remove the; from restoreoptions (The Mathematica book does it the same way). Use Options[tube] afterwards to look at the options.

restoreoptions[Graphics3D,  
        defaultgraphics];
restoreoptions[tube,  defaulttube];

SetOptions[Graphics3D,  Background ->  GrayLevel[0.9],  
        Boxed  ->  False];
SetOptions[tube, nalongtube -> 100,  
        naroundtube ->  50];

We can add lines separately going along the axis (say 3 lines), or around the axis (say 8 lines) using the fluxline function:

circlefun[t_]  :=  
        4 {Cos[2 Pi t],  Sin[2 Pi t],  0};
borderlines  =  
      fluxlines[circlefun,  1.05, 3,  8,  fluxcolor  ->  Blue,  
        fluxthickness  ->  0.01]

Hint: we called borderlines with radius set at 1.05 -- this makes sure the lines are completely outside of the radius 1 tube, in case we wish to show both! Here are some even bigger lines:

biggerlines  =  
      fluxlines[circlefun,  1.25, 3,  8,  fluxcolor  ->  Red,  
        fluxthickness  ->  0.01]

Here is the first set of lines:

Show[
        borderlines[[1]]];

Here is the second set of lines, along with the surface, drawn with no lines of its own (EdgeForm[]).

Show[{tube[circlefun,  {EdgeForm[], Gold},  1],  
          borderlines[[1]]}];

Here are both sets of lines, with radii set at 1.05 and 1.25:

Show[tube[circlefun, {EdgeForm[], Gold}, 1], 
        borderlines[[1]], 
        biggerlines[[2]]];

circlefun[t_]  :=  
        4 {Cos[2 Pi t],  Sin[2 Pi t],  0};
knot25[t_] :=  torusknot[1, 5, 20, 4, t];
borderlines  =  
        fluxlines[knot25,  2.1, 3,  3,  fluxcolor  ->  Blue,  
          fluxthickness  ->  0.01];
Show[tube[knot25,  {EdgeForm[], Gold},  2],  
        borderlines[[1]]];

satellites[curve, radius, nlonglines] gives a list of curves which, like fluxlines, follow the lattice on the tube. Here they are returned as lists of points. We can then
place tubes around them too, which sometimes improves the picture.

SetOptions[tube, nalongtube -> 200,  naroundtube ->  8,  
        twistnumber ->  -8];

We will give the central tube a radius of 2, and place the satellites at radius 2.6.

centraltube  :=  
        tube[knot25,  {EdgeForm[], Gold},  2,  
          naroundtube -> 20];

satellitecurves  :=  
        satellites[knot25, 2.6,  2]; 
satellitetube1  :=  
        tube[satellitecurves[[1]], {EdgeForm[],  Green},  0.5];
satellitetube2  :=  
        tube[satellitecurves[[2]],  {EdgeForm[],  Green},  0.5];

This can be slow if the tubes overlap!

SetOptions[Graphics3D,  
        ViewPoint -> {0,  0,  2}];
{ centraltube, satellitetube1, satellitetube2} // 
        Show;