Parametric Curves in 3D

by
K. D.  Stroyan
University of Iowa

copyright 1997 by Academic Press, Inc. - All rights reserved.

Mathematica Functions used in this NoteBook

This horrible stuff sets various defaults and defines some functions needed to draw the geometric side of the lexicon.  Ignore the details here and go on to the lesson.

Off[General::spell];
Off[General::spell1];
Off[ParametricPlot3D::ppcom];
Off[ParametricPlot::ppcom];
Needs["Graphics`Colors`"];

SetOptions[Graphics, Axes -> False, AxesOrigin -> {0, 0}, 
        AspectRatio -> Automatic];
SetOptions[Graphics3D, ViewPoint -> {5, 2, 1}, Boxed -> False, 
        AspectRatio -> Automatic];
SetOptions[ParametricPlot3D, ViewPoint -> {5, 2, 1}, 
        AspectRatio -> Automatic];
SetOptions[Plot3D, ViewPoint -> {5, 2, 1}, 
        AspectRatio -> Automatic];
SetOptions[ParametricPlot, AspectRatio -> Automatic];
SetOptions[Plot, AspectRatio -> Automatic];

\(\(parametricCrv3D[X_, {t_, tmin_, tmax_, step_}, opns___] := 
	
        Module[{tPoints, tt}, 
		tPoints\  = \ 
            Table[tt, {tt, tmin, tmax, step}]; 

          Return[Show[
              Graphics3D[{opns, 
		Line[
                    Map[N[X[#]] &, tPoints]]}]]];
		];\)\)

colorQ[a_] := (Head[a] === RGBColor);
grayQ[a_] := (Head[a] === GrayLevel);
thickQ[a_] := (Head[a] === Thickness);
absthickQ[a_] := (Head[a] === AbsoluteThickness);
notruleQ[u_]  :=  ! (Head[u] === Rule);
ruleQ[u_]  :=  (Head[u] === Rule);

Norm::usage  =  "Norm[expr] returns the Euclidean length of the
		vector, 'expr'.";

\(\(Norm[a_?VectorQ]\  := \ Sqrt[a . a];\)
\)
\(\(Angle[a_?VectorQ, b_?VectorQ]\  := \ 
        ArcCos[\((a . b)\)/\((Norm[a]\ Norm[b])\)];\)
\)
Proj[a_?VectorQ, b_?VectorQ]  :=  ((a . b)/(b . b)) 
          b;

tol  =   .5*10^-6;

\(\(OrthUp[a_?VectorQ]\  := 
	
        Module[{b, c, d, f}, 
		d\  = \ N[a/Norm[a]]; 
		If[
            Chop[d[\([3]\)]^2\  - \ 1, tol]\  == \ 0, \ 
            b = {1, 0, 0}\ , 
		b\  = \ {0, 0, 1}\  - \ d[\([3]\)]\ d; \ 
            b\  = \ b/Norm[b];]; 
	Return[b]];\)
	\)
\(\(OrthSet[a_?VectorQ]\  := 
	
        Module[{b, c, d}, 
		d\  = \ N[a/Norm[a]]; 
		If[
            Chop[d[\([1]\)], tol] == 0, 
            b = {1, 0, 0}, 
			\ If[Chop[d[\([2]\)], tol] == 0, 
              b = {0, 1, 0}, 
			\ \ b = {\(-d[\([2]\)]\), d[\([1]\)], 
                  0}]]; 
			b = b/Norm[b]; c\  = \ Cross[d, b]; 
	
          Return[{b, c/Norm[c], d}]];\)

				\)
\(\(Rotate[a_?VectorQ, theta_]\  := 
	
        Module[{u, v, r}, 
		u\  = \ OrthSet[a]; 
		v\  = \ 
            Transpose[u]; 
		r\  = \ 
            N[{{Cos[theta], \(-Sin[theta]\), 0}, {Sin[theta], Cos[theta], 
                  0}, {0, 0, 1}}]; 
	Return[v . r . u]];\)\)

\(\(Vector2D[tail_, tip_, opts___] := 
	
        Module[{ntail, ntip, sopts, unit, up, arrow}, 
	
          ntail\  = \ N[tail]; 
	ntip\  = \ N[tip]; 
	
	
          sopts\  = \ 
            Join[Select[{opts}, colorQ], Select[{opts}, 
				thickQ], 
              Select[{opts}, absthickQ], Select[{opts}, grayQ]]; 


          If[Chop[ntail . ntail + ntip . ntip, tol]\  == \ 
              0, 
			 (*too\ small\ to\ plot\ or\ not\ number*) 
			\(Return[Graphics[Point[{0, 0}]]];\)
	, 						

            If[Chop[\((ntip - ntail)\) . \((ntip - ntail)\), tol]\  == \ 
                0, 
		\(Return[
                  Graphics[{Join[sopts, {Line[{ntail, ntip}]}]}]];\)
	, 
	
              unit\  = \ \(\((ntip - ntail)\)/Norm[ntip - ntail]\)/5; 
	
              up\  = \ 0.3\ {\(-unit[\([2]\)]\), unit[\([1]\)]}; 
	
              arrow\  = \ 
                Line[{ntail, ntip, ntip - unit + up, ntip, 
                    ntip - unit - up}];
	]]; 

          Return[Graphics[{Join[{AbsoluteThickness[2]}, 
                  Join[sopts, {arrow}]]}]];
];\)
\)
\(\(Vector3D[tail_, tip_, opts___] := 
	
        Module[{ntail, ntip, sopts, unit, up, u2, u3, u4, rotmat, arrow}, 
	
          ntail\  = \ N[tail]; 
	ntip\  = \ N[tip]; 
	
	
          sopts\  = \ 
            Join[Select[{opts}, colorQ], Select[{opts}, 
				thickQ], 
              Select[{opts}, absthickQ], Select[{opts}, grayQ]]; 


          If[Chop[ntail . ntail + ntip . ntip, tol]\  == \ 
              0, 
			 (*too\ small\ to\ plot\ or\ not\ number*) 
			\(Return[Graphics3D[Point[{0, 0, 0}]]];\)					
	, 		

            If[Chop[\((ntip - ntail)\) . \((ntip - ntail)\), tol]\  == \ 
                0, 
		\(Return[
                  Graphics3D[{Join[
                        sopts, {Line[{ntail, ntip}]}]}]];\)
	, 
	
              unit\  = \ \((ntip - ntail)\)/Norm[ntip - ntail]; 
	
              rotmat\  = \ Rotate[unit, N[Pi/2]]; 
	
              up\  = \ OrthUp[unit]; 
	unit\  = \  .2\ unit; 
	
              up\  = \  .05\ up; 
	u2\  = \ rotmat . up; 
	
              u3\  = \ rotmat . u2; 
	u4\  = \ rotmat . u3; 
	
              arrow\  = \ 
                Line[{ntail, ntip, 
				ntip\  - \ unit\  + \ up, 
                    ntip, 
				ntip\  - \ unit\  + \ u2, 
                    ntip, 
				ntip\  - \ unit\  + \ u3, 
                    ntip, 
				ntip\  - \ unit\  + \ u4}];
	]]; 

          Return[Graphics3D[{Join[{AbsoluteThickness[2]}, 
                  Join[sopts, {arrow}]]}]];
];\)\)

\(\(aRCtAN[y_, x_]\  := \ 
        Module[{v}, 
	
          If[\ Chop[N[x], tol]\  == \ 0\ , 
            If[\ N[y]\  < \ 0, \ v\  = \ \(-N[Pi/2]\), \ 
              v\  = \ N[Pi/2]], 
		v\  = \ N[ArcTan[y/x]]; 
		If[\ 
              x\  < \ 0\  && \ y\  < \ 0, \ v\  = \ N[Pi\  - \ \ v], v]]; 
	
          Return[v]];\)\)

\(\(Arc2D[X_, Y_, opts___]\  := \ 
        Graphics[{opts, 
		Disk[{0, 0}, 
              1, {Min[
							aRCtAN[
						N[X[\([2]\)]], 
                    N[X[\([1]\)]]
								]
							, 
							aRCtAN[
							N[Y[\([2]\)]], 
                    N[Y[\([1]\)]]
								]
						]
						, 
					Max[
							aRCtAN[
						N[X[\([2]\)]], 
                    N[X[\([1]\)]]
								]
							, 
							aRCtAN[
							N[Y[\([2]\)]], 
                    N[Y[\([1]\)]]
								]
						]}
				]}
				];\)\)
\(\(Arc3D[X_, Y_]\  := \ 
	
        Module[{t, U, V}, 
		U[V_] := \ 
            N[\((1/Sqrt[V . V])\)\ V]; 
		Return[
            Graphics3D[
		Polygon[
                Append[Table[
                    U[t\ X\  + \ \((1 - t)\)\ Y], {t, 0, 1, 0.1}], {0, 0, 
                    0}]]
				]
		]
	];\)\)

\(\(Vector[tail_, tip_, opts___] := 
	
        If[Length[N[tail]] == 2, 
          Return[Vector2D[tail, tip, opts]], 
		Return[
            Vector3D[tail, tip, opts]]];\)
		\)
\(\(Arrow[vec_, opts___] := \ 
	
        Module[{a, b}, 
				If[
            Length[N[vec]] == 
              2, 
				a = \(ToExpression["Tail"] /. 
                  Select[{opts}, 
                    ruleQ]\) /. 
					{ToExpression["Tail"] -> {0, 
                      0}}; 
				Return[
              Vector2D[a, a + vec, 
                opts]], 
				a = \(ToExpression["Tail"] /. 
                  Select[{opts}, 
                    ruleQ]\) /. 
					{ToExpression["Tail"] -> {0, 
                      0, 0}}; 
				Return[
              Vector3D[a, a + vec, opts]]]
				];\)\)

\(\(Frame2D[
          delta_]\  := \ 
\ \ \ \ \ \ Graphics[{
\ \ \ \ \ \ \ \ \ \ \ \ {Green, Line[{{\(-delta\)/4, 0}, {delta, 
                    0}}]}, 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Text["x", {1.01\ delta, 0}], 
\ \ \ \ \ \ \ \ \ \ \ \ {Green, 
              Line[{{0, \(-delta\)/4}, {0, 
                    delta}}]}, 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Text["y", {0, \ 1.01\ delta}]}];\)\)

\(\(Frame3D[
          delta_]\  := \ 
\ \ \ \ \ \ Graphics3D[{
\ \ \ \ \ \ \ \ \ \ \ \ {Green, Line[{{\(-delta\)/4, 0, 0}, {delta, 0, 
                    0}}]}, 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Text["x", {1.01\ delta, 0, 0}], 
\ \ \ \ \ \ \ \ \ \ \ \ {Green, 
              Line[{{0, \(-delta\)/4, 0}, {0, delta, 
                    0}}]}, 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Text["y", {0, \ 1.01\ delta, 0}], 
\ \ \ \ \ \ \ \ \ \ \ \ {Green, 
              Line[{{0, 0, \(-delta\)/4}, {0, 0, 
                    delta}}]}, 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Text["z", {0, 0, 1.01\ delta}]}];\)\)

View2D[stuff_]  :=  Show[stuff, Frame2D[1]];
View3D[stuff_]  :=  Show[stuff, Frame3D[1]];

FlyBy[.]

\(\(FlyBy[
	theGraphic_, \ 
	
          thePath_List: {pathVariable, \ \(-0.5\), \ 1.5}, 
	
          pathRange_List: {pathVariable, \ \(-3\), \ 3, \ 0.5}] := \ 
	
        Do[
		Show[theGraphic, \ ViewPoint -> thePath]
	, 
          pathRange];\)\)

Notebook Overview

This NoteBook draws some basic 3-D parametric curves.  You should already be familiar with the Parametric Line Notebook.

References to the Text

This NoteBook goes with Section 16.4 of the text.

The Helix

We add a simple equation in  z  to the parametric circle in 2D to obtain the following:

An Animated Helix

\(Clear[X, x, y, θ, arc]; 
x[θ_] := Cos[θ]; 

    y[θ_] := Sin[θ]; 
z[θ_] := θ\/π; 

    X[θ_] := {x[θ], y[θ], z[θ]}; 

    arc[θ_] := 
      ParametricPlot3D[X[t], {t, 0, θ}, 
        PlotRange -> {{\(-1.1\), 1.1}, {\(-1.1\), 1.1}, {0, 2.1}}, 
        Ticks -> None, AxesLabel -> {"x", "y", "z"}, 
        DisplayFunction -> Identity]; 
dθ = π\/20; 

    Do[\(Show[{arc[θ], Arrow[X[θ], Red], 
          Arrow[{x[θ], y[θ], 0}, Blue], 
			
          Arrow[{0, 0, z[θ]}, Tail -> {x[θ], y[θ], 0}, 
            Orange]}, DisplayFunction -> $DisplayFunction]; 
      \), {θ, dθ, 2\ π, dθ}]; \)

Practice Exercise

Modify the helix animation to run through  2  turns of the helix in 10 steps.

Plain Constant Pitch Helix

The (x,y) portion of the 3D vector in the next graph goes around the unit circle, because it is the 2D parametric circle we looked at in the 2D section above.  The z-coordinate steadily increases from 0 to 1.  Draw the graph.

Clear[X, x, y, z, t]; x[t_] := Cos[t]; y[t_] := Sin[t]; z[t_] := (t/π); X[t_] := {x[t], y[t], z[t]}; ParametricPlot3D[X[t], {t, -π, 2  π}, 
      AxesLabel -> {"x", "y", "z"}];

Other Twists in 3D

Go Up & Down in z as you go Round and Round in x-y:

The (x,y) portion of the 3D vector in the next graph goes around the unit circle, but now the z-coordinate goes up and down from -1 to +1.  Draw the graph.

\(Clear[X, x, y, z, t]; 
x[t_]\  := \ \ Cos[t]; 
y[t_]\  := \ \ Sin[t]; 
    
z[t_]\  := \ \ Cos[3  t]; 
X[t_]\  := \ {x[t], y[t], z[t]}; 


    ParametricPlot3D[\ X[t], 
		{t, \(-Pi\), Pi}, \ 
      BoxRatios -> {1, 1, 1}, 
		AxesLabel -> {"x", "y", "z"}, 
      Axes -> None]; \)

Go Up & Down in z and in and out in distance  r[t]  
		as you go Round and Round in x-y:

The (x,y) portion of the 3D vector in the next graph goes around the unit circle, the z-coordinate goes up and down, and now the "radius vector" or length of the plotted vector is magnified by a constant  r[t]  that varies between 0 and 2.  Draw the graph.

\(Clear[X, x, y, z, r, t, u]; 
x[t_]\  := \ \ Cos[t]; 

    y[t_]\  := \ \ Sin[t]; 
z[t_]\  := \ \ Cos[3  t]; 

    r[t_]\  := \ \ 1\  - \ Cos[2  t]; 
X[t_]\  := \ {x[t], y[t], z[t]}; 


    curve\  = \ 
      ParametricPlot3D[r[t]\ X[t], 
			{t, \(-Pi\), Pi}, 
        BoxRatios -> {1, 1, 1}, 
			
        AxesLabel -> {"x", "y", "z"}, Axes -> None]; \)

This curve is complicated!  If you want to see it from several points of view, get in your Mathematica helicopter and fly by it: <Enter> the next computation, highlight the cell containing all the graphs and press <Command> + <y> to run the animation.

FlyBy[curve,  {3  +  2 u,  5  +  u,  1}, 
       {u,  -4, 4, 0.5}];

Torus Curves

A torus is the donut-shaped surface given by all points that can be formed by adding a vector on a big circle to a vector on a small perpendicular circle:

Clear[r, B, S, T, φ, ψ, U, Subscript]; 
    U[φ_] := {Cos[φ], Sin[φ], 0};
B[φ_] := (Subscript[r, B]) U[φ]; 
    S[φ_, ψ_] := 
      (Subscript[r, S]) (Cos[ψ] U[φ] + 
            Sin[ψ] {0, 0, 1});
T[φ_, ψ_] := 
      B[φ]  +  S[φ, ψ]
(Subscript[r, B]) = 3; (Subscript[r, S]) = 1;
big = 
      ParametricPlot3D[B[φ], {φ, -π, π}, 
        AxesLabel -> {"x", "y", "z"}, 
        PlotRange -> {{-((Subscript[r, B]) + (Subscript[r, S])), ((Subscript[r, B]) + 
                  (Subscript[r, S]))}, {-((Subscript[r, B]) + (Subscript[r, S])), ((Subscript[r, B]) + 
                  (Subscript[r, S]))}, {-(Subscript[r, S]), (Subscript[r, S])}}, BoxRatios -> Automatic]; 
    small = ParametricPlot3D[
        T[(π/2), ψ], {ψ, -π, π}, 
        PlotRange -> {{-((Subscript[r, B]) + (Subscript[r, S])), ((Subscript[r, B]) + 
                  (Subscript[r, S]))}, {-((Subscript[r, B]) + (Subscript[r, S])), ((Subscript[r, B]) + 
                  (Subscript[r, S]))}, {-(Subscript[r, S]), (Subscript[r, S])}}, BoxRatios -> Automatic]; 
    Show[big, small, Arrow[B[π/2], Red], 
      Arrow[S[π/2, π/3], Tail -> B[π/2], Blue]];

surf  =  
        ParametricPlot3D[
          B[φ]  + 
            0.9 S[φ, ψ], {φ, -π, π}, {ψ, -π, π}, Boxed -> False, Axes -> None];
torus  =  
        Show[Graphics3D[{EdgeForm[], First[surf]}]];

We can make curves that wind around a torus by "spinning" the small circle angle  ψ  at various rates as we move the large circle angle  φ:

Clear[X, φ, ψ];
ψ  =  4 φ;
X[φ_]  =  T[φ, ψ];
curve  = 
        parametricCrv3D[X, {φ, -π, π, π/40}, 
          Thickness[0.02], Red];
Show[torus, curve];

Clear[
      X, φ, ψ]; ψ = ((2 )/3) φ; 
    X[φ_] = T[φ, ψ]; 
    curve2 = parametricCrv3D[
        X, {φ, -3 π, 3  π, (π/10)}, Thickness[0.02], 
        Brown]; Show[torus, curve2]; Show[torus, curve, curve2];

Exercises

Exercise 16.4.1

Use ParametricPlot3D[.] to draw 3 full turns of the constant pitch helix.

Exercise 16.4.2

Copy and modify the computations above to plot X[t] = {x[t],y[t],z[t]}, where
x[t_] :=  Cos[t];
y[t_] :=  Sin[t]Cos[t];
z[t_] :=  Cos[t];
For extra credit, plot as an animation and watch the dynamic motion.

Exercise 16.4.3

Copy and modify the computations above to plot and FlyBy  r[t] * X[t], where
x[t_] :=  Cos[t];
y[t_] :=  Sin[t];
z[t_] :=  Cos[t];
r[t_] :=  1 - Cos[2t];
For extra credit, plot as an animation and watch the dynamic motion.

Exercise 16.4.4: The Helicopter Blade

This is a simple three dimensional exercise like the cycloid or squashed bug projects.

The radius of the rotor of a helicopter blade is  10  feet.  It rotates  40  times per minute.  The helicopter flies along a straight line at elevation  500 feet at  50  miles per hour due East.  The rotor turns in a horizontal plane.  Give parametric equations for ont tip of the rotor and draw it with Mathematica.

Exercise 16.4.5 Bagel Curves

Parametric equations for a curve that lies on a torus of big radius (Subscript[r, B])  and small radius  (Subscript[r, S]) are given by

x[u_] := ((Subscript[r, B]) + (Subscript[r, S])  Cos[w φ])Cos[φ]
y[u_] := ((Subscript[r, B])  + (Subscript[r, S]) Cos[w φ])Sin[φ]
z[u_] := (Subscript[r, S]) Sin[w φ]

where the curve winds around the bagel  w  times.  Plot this curve with  (Subscript[r, B]) = 3, (Subscript[r, S]) = 1, and w = 2, 3, 4.

Animate the motion of a vector tracing along the curve.