Calculus: The Language of Change

Special Mathematica Functions used in this NoteBook

We told you not to look.  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]
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[(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}],
            {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]];

Exercise Set 16.2
Parametric Circles

solutions by David Theobald

See the text for explicit instructions on using a Mathematica notebook to solve Exercise 1.

Exercise 2

A bug crawls onto a turning gear that revolves and meets another gear.  The bug is squashed, and half of its remains are left on the edge of each gear.  Are the parts of the ex-bug ever reunited?  Suppose the small gear has radius (Subscript[r, s]) and the big gear has radius (Subscript[r, B]).

(a)	Suppose the large gear turns at the rate of one revolution per second.

What is the speed of the small gear?  To figure out the speed of the small gear, we first look at the speed of the larger gear.  We know from previous chapters that the first derivative gives us speed.  To get the "speed of a vector" or VELOCITY, we will take the Norm of the vector.  Once we have the speed of the larger gear, we will do the same process with the smaller gear.  Notice we use omega (ω) to denote the missing speed information.

\(Clear[X, x1, x2, Y, y1, y2, Z, rb, rs, t, ω]; 

    x1[t_] := \ rb*Cos[2  π*t]; 
x2[t_] := \ rb*Sin[2  π*t]; 

    X[t_] = {x1[t], x2[t]}\)\(bigSpeed[t_] = Simplify[Norm[\(X'\)[t]]]
\)\(y1[t_] := \ \(-rs\)*Cos[ω*t]; 

    y2[t_] := \ \(-rs\)*Sin[ω*t]; 
Y[t_] = {y1[t], y2[t]}\)\(littleSpeed[t_] = Simplify[Norm[\(Y'\)[t]]]
\)

Now we have the speed of both gears in terms of rb, rs and ω.  To figure out the speed of the little gear alone, we must solve for ω.  How do we do this?  We must realize that in order for both wheels to be turning simulaneously, their speeds must be equal.  Therefore,  we set the two speed equations equal to each other.  After a little algebra, we come to the following conclusion:

\(TextForm\`\(																		
    ω = \(2\ π\ rb\)\/rs\)\)

(b) 	Give equations for the position of the part of the bug on the small gear.

Place the small gear at the (x,y)-point ((Subscript[r, B])+(Subscript[r, s]), 0) and assume that the bug is squashed at t=0.  The first issue at hand is the direction or "orientation" of the gears.  Which way are the gears turning?  By looking at the formula for the larger gear, we notice both x-components are positive.  This tells us that the larger gear is going clockwise.  Therefore we must make the smaller gear go oppositely, or counterclockwise.
To achieve this effect, we must look at what makes a parametric circle:

y1 = (+or-)radius*Cos[ωt]
		y2 = (+or-)radius*Sin[ωt]

To make our smaller gear go counterclockwise, we must choose both parts (y1 and y2) to be negative.  The next issue at hand is what is the radius of the smaller gear?  That's easy, radius is rs.  Another issue is what is the speed of the smaller gear.  That was the answer to part a, so we know this as well.  The final issue is where is the smaller gear located?  We know the larger gear is at the origin, so the smaller gear must be (rb+rs) off the origin in the x-direction and zero in the y-direction.  The equations for the small gear are as follows:

\(TextForm\`																							
    y1 = \ \(-rs\)*Cos[\(2\ π\ rb\)\/rs*t] + rb + rs
\)\(TextForm\`																							
    y2 = \ \(-rs\)*Sin[\(2\ π\ rb\)\/rs*t]
\)

(c)  	What is the maximum and minimum distance between the bug's parts?

If we let  X[t] = (({{(Subscript[x, 1])}, {(Subscript[x, 2])}})) and Y[t] =  (({{(Subscript[y, 1])}, {(Subscript[y, 2])}})) , then the distance between the bug's parts is:

d[t] = |  X[t] -Y[t] |
What is the maximum and minimum of d[t]?  In particular, is it ever zero or 2(rb+rs)?  (HINT: This can be plotted on the computer but is not a trivial max-min problem.  The answer depends on the radii. )

\(\(
little[s]\  = \ 
      ParametricPlot[Y[t], \ {t, 0, s}, AxesLabel -> {"x", "y"}, 
        PlotRange -> {{\(-10\), 10}, {\(-10\), 10}}, 
        DisplayFunction -> Identity]; 

    big[s]\  = \ 
      ParmetricPlot[X[t], \ {t, 0, s}, AxesLabel -> {"x", "y"}, 
        PlotRange -> {{\(-10\), 10}, {\(-10\), 10}}, 
        DisplayFunction -> Identity]; 

    Show[little[s], big[s], {s, 0, 6  π,  .3}, 
      DisplayFunction -> $DisplayFunction]; 

\)\)