Animating a 2D Plot

This Lab needs the arrow initializations in the next closed cell.  You need not look in there, but you do need to evaluate it when Mathematica asks.

Arrow Initialization

Off[General::spell];
Off[General::spell1];
Off[ParametricPlot::ppcom];
Off[ParametricPlot3D::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];

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[Simplify[(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,Punit,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}]}]}]];
	,
	Punit = 0.075 (ntip-ntail) ;
	up = 0.15 {-Punit[[2]],Punit[[1]]};
	arrow = Line[{ntail,ntip,ntip-Punit+up,ntip,ntip-Punit-up}];
	]];
Return[Graphics[{Join[{AbsoluteThickness[2]},Join[sopts,{arrow}]]}]];
];

Vector3D[tail_,tip_,opts___]:=
	Module[{ntail,ntip,sopts,Punit,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}]}]}]];
	,
	Punit = (ntip-ntail);
	rotmat = Rotate[Punit,N[Pi/2]];
	up = OrthUp[Punit];
	Punit = .075 Punit;
	up = .15 Norm[Punit] up;
	u2 = rotmat.up;
	u3 = rotmat.u2;
	u4 = rotmat.u3;
	arrow = Line[{ntail,ntip,
				ntip - Punit + up,ntip,
				ntip - Punit + u2,ntip,
				ntip - Punit + u3,ntip,
				ntip - Punit + 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}]]
				]
		]
	];

(*Zero Arrow causes trouble. Put in Vector?*)

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}],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}],Line[{{0,-delta/4,0},{0,delta,0}}],Text["y",{0, 1.01 delta,0}],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]];

Preparation

The text sections 9.3 and 9.5 from http://www.math.uiowa.edu/~stroyan/MultiVarCalc/

03MathParam2DCurves.nb & 05MathParam3DCurves.nb

have lots and lots of examples of graphing parametric curves.  This eLab outline has only the basics.

Parametric Curves in 2D

Parametric Plot of Basic Circles

Enter the following and explain briefly what it does.

Clear[X, W, t, r];
W[t_] = r {Cos[t], Sin[t]};
MatrixForm[W[t]]
r = 2;
firstCircle = ParametricPlot[W[t], {t, 0, 2  π}];

Change the radius by entering the next computation.  Explain.

r = 3;
secondCircle = ParametricPlot[W[t], {t, 0, 2  π}];

Show both circles.

Show[firstCircle, secondCircle];

Move the center by entering the following.  Explain what the program does.

center = {-1, 1};
X[t_] = center + W[t];
MatrixForm[X[t]]
r = 3/2;
thirdCircle = ParametricPlot[X[t], {t, 0, 2  π}];

Show all three circles by completing the following command and entering it.

Show[?,??,???];

Animating the Parametrization

Enter the following program.  Notice the ":=" command.  This "holds" this definition until you use it.

Clear[X, W, t, s, r, arc];
W[t_] = r {Cos[t], Sin[t]};
arc[s_] := 
        ParametricPlot[W[t], {t, 0, s}, 
          DisplayFunction  ->  Identity];
r = 2;
s = π/6;
Show[{arc[s], Arrow[W[s], Blue]},  
        DisplayFunction ->  $DisplayFunction];
MatrixForm[W[s]]

What's wrong with the graph?

Next, try the following and explain what has changed.

Clear[X, W, t, s, r, arc];
W[t_] = r {Cos[t], Sin[t]};
arc[s_] := 
        ParametricPlot[W[t], {t, 0, s}, 
          DisplayFunction -> Identity];
r = 2;
s = π/6;
Show[{arc[s], Arrow[W[s], Blue]}, 
        PlotRange -> {{-2, 2}, {-2, 2}}, 
        DisplayFunction -> $DisplayFunction];

Now "Do[.]" this for a list of s-values by entering the next command.

Clear[X, W, t, s, r, arc];
W[t_] = r {Cos[t], Sin[t]};
arc[s_] := 
        ParametricPlot[W[t], {t, 0, s}, 
          DisplayFunction -> Identity];
r = 2;
Do[
Show[{arc[s], Arrow[W[s], Blue]}, 
            PlotRange -> {{-2, 2}, {-2, 2}}, 
            DisplayFunction -> $DisplayFunction];
, {s, π/5, 2  π, π/5}];

Double click on one of the graphs you just drew.

An exercise on 2D plotting is to be found in the file Lab4Report.nb.  Please do that exercise and submit your work via Blackboard.

Parametric Curves in 3D

Basic 3D Plots

Plot the helix X[t]=(({{Cos[t]}, {Sin[t]}, {t/π}})) by entering the following program.  Explain each command.

Clear[X, t];
X[t_] = {Cos[t], Sin[t], t/π};
ParametricPlot3D[
        X[t], {t, 0, 3  π}];
MatrixForm[X[t]]

Plot the tighter pitch helix X[t]=(({{Cos[t]}, {Sin[t]}, {t/(4  π)}})) by copying and pasting the program above.

Plot the closed curve X[t]=(({{Cos[t]}, {Sin[t]}, {Cos[4  t]}})) in "RealTime3D" by entering the next program.

Clear[X, t];
X[t_] = {Cos[t], Sin[t], Cos[4  t]};
<< RealTime3D`;
ParametricPlot3D[
        X[t], {t, 0, 2  π}];
<< Default3D`;
MatrixForm[X[t]]

Animated 3D Plots

We learned in lecture that a circle in the plane of two unit lenght perpendicular vectors U and V has parametrization

For example, we could define the paarametric function by the commands in the next cell.  enter them and explain.

Clear[X, U, V, W, t, r];
U = {1, 2, -2}/3;
V = {-2, 2, 1}/3;
W = U\[Cross]V
X[t_] = r Cos[t] U + r Sin[t] V;
MatrixForm[X[t]]

We can use the "hold definition" command to define an arc of the curve.  Enter the next program and explain what it does.

arc[s_] := 
        ParametricPlot3D[X[t], {t, 0, s}, 
          DisplayFunction -> Identity];
r = 1;
s = π/3;
Show[{arc[s], Arrow[X[s], Red]}, 
        DisplayFunction -> $DisplayFunction];
s = π/2;
Show[{arc[s], Arrow[X[s], Red]}, 
        DisplayFunction -> $DisplayFunction];
s = π;
Show[{arc[s], Arrow[X[s], Red]}, 
        DisplayFunction -> $DisplayFunction];

Modify the program to have a fixed plot range in all directions as follows.

s = 4  π/3;
Show[{arc[s], Arrow[X[s], Red], Arrow[U, Brown], Arrow[V, DarkGreen], 
          Arrow[W, Orange]}, 
        PlotRange -> {{-2, 2}, {-2, 2}, {-2, 2}}, 
        DisplayFunction -> $DisplayFunction];

<< RealTime3D`;
Show[{arc[s], Arrow[X[s], Red], Arrow[U, Brown], Arrow[V, DarkGreen], 
          Arrow[W, Orange]}, 
        PlotRange -> {{-2, 2}, {-2, 2}, {-2, 2}}, 
        DisplayFunction -> $DisplayFunction];
<< Default3D`;

Then modify this program to plot the arc for s = π/6,  π/4,  π/2,  π,  
      2  π

Now enter the next program and explain.

Do[
Show[{arc[s], Arrow[X[s], Red], 
              Arrow[U, Brown], Arrow[V, DarkGreen], Arrow[W, Orange]}, 
            PlotRange -> {{-2, 2}, {-2, 2}, {-2, 2}}, 
            DisplayFunction -> $DisplayFunction];
, {s, π/5, 2  π, π/5}];

Exercise for 3D (not to be handed in, but perhaps need ed in a future project.)

3D

Animate the parametric plot of the curve

for

where k = 5, r = 1, and R = 2. Show the vectors X[s], L[s], and B[s] with its tail at the tip of B[s] as you vary s in your animation.

Clear[X, L, B, U, W, t, r, R, k];
U[t_] =  ** ;
W =  ** ;
B[t_] =  ** ;
L[t_] =  ** ;
X[t_] = B[t] + L[t];
MatrixForm[X[t]]
arc[s_] :=  ** ;
r = 1;
R = 2;
k = 5;
Do[
Show[{arc[s], Arrow[X[s], Red], 
              Arrow[B[s], Blue], Arrow[L[s], Tail -> B[s], Green]}, 
            PlotRange -> {{-3, 3}, {-3, 3}, {-3, 3}}, 
            DisplayFunction -> $DisplayFunction];
, {s, π/5, 2  π, π/15}];

<< RealTime3D`;
ParametricPlot3D[
        X[t], {t, 0, 2  π}];
<< Default3D`;