Project Help Notebook by Keith Stroyan

Help NoteBook Copyright 1998 by Academic Press, Inc. - All rights reserved.
Modify this Notebook to prepare your project report.

Project 43: Wheels Rolling on Wheels

by A. Student and B. Pupil

with technical help from Da LabMonitor and Help Notebook

Special Mathematica Functions used in this NoteBook: Arrows[.], etc.

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[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];

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);

Cross::usage = "Cross[a,b] returns the cross product of a and b.";

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
			
Cross[a_?VectorQ,b_?VectorQ]:={a[[2]]b[[3]]-a[[3]]b[[2]], 
				a[[3]]b[[1]]-a[[1]]b[[3]],
				a[[1]]b[[2]]-a[[2]]b[[1]]};

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 = (.075 Norm[ntip-ntail]/Norm[ntip-ntail]) (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]];

My Project Introduction

Write this last.  Begin with the basic question and state your main finding clearly, but with few technical details.  You might even modify the title of this section to make it more interesting.

Beginning Explorations or Computer Experiments

A Bug in the Gears

A simple way to combine parametric circles is to describe the path of a bug that gets squashed between two gears.  We have a big circle with radius  rB  centered at the origin and a small circle of radius  rS  centered at  rB + rS  on the x-axis.  Take a look:

rB = 3;
rS = 1;
circB = Graphics[Circle[{0,0},rB]];
circS = Graphics[Circle[{rB+rS,0},rS]];
Show[circB,circS];

We want to have one vector point to the blue head of the squashed bug and the other point to the red tail as his parts travel around the gears.  The basic parametric circle has equations:

		x = r Cos[t]
		y = r Sin[t]

This will do fine for our big gear.  
	
	We can move the center of a parametric circle by adding:
	
		x = r Cos[t] + a
		y = r Sin[t] + b

	The little gear rotates the opposite way, starts with the head and tail of the bug connected and turns faster so that as the big wheel makes a full turn, the little wheel has turned  rB/rS  times.  Explain our equations

Clear[X,Y,t,rB,rS,w];
X[t_] := rB{Cos[t],Sin[t]};
w := rB/rS;
Y[t_] := rS{Cos[Pi-w t]+(rB+rS),Sin[w t]};

rB = 3;
rS = 1;
circB = Graphics[Circle[{0,0},rB]];
circS = Graphics[Circle[{rB+rS,0},rS]];
Do[
head = ParametricPlot[Y[t],{t,0,s},
	PlotRange->{{-1.1rB,1.1(rB+2rS)},{-1.1rB,1.1 rB}},
	PlotStyle->{{Thickness[0.01],Blue}}, AxesLabel->{"x","y"},
	DisplayFunction->Identity];
	
tail = ParametricPlot[X[t],{t,0,s},
	PlotRange->{{-1.1rB,1.1(rB+2rS)},{-1.1rB,1.1 rB}},
	PlotStyle->{{Thickness[0.01],Red}}, AxesLabel->{"x","y"},
	DisplayFunction->Identity];

Show[head,tail,circB,circS,
	Arrow[X[s],Red],
	Arrow[Y[s]-{rB+rS,0},Tail->{rB+rS,0},Blue],
	DisplayFunction->$DisplayFunction];
,{s,Pi/20,2Pi,Pi/10}];

Practice Exercises

Make a parametric curve by spinning a little circle  10 times as fast as you go around the big circle.  Let the little circle have radius  2 and the big one radius  3.

The Epicycloid

When a small wheel of radius  (Subscript[r, s])  rolls along a large wheel of radius  (Subscript[r, b])  by an angle  θ  WITHOUT SLIPPING, YOR PROJECT explains why the angle  ω  of the small wheel satisfies

ω  =  (((Subscript[r, b]) + (Subscript[r, s]))/(Subscript[r, s])) θ

Run the animation program below and observe carefully that a wheel of radius  1  traveling once around a wheel of radius  3  makes  4  turns.

Derivation of the Epicycloid Equations

Type your derivation of the equations of an epicycloid here.  The most difficult part is the formula for  ω  given above.

The center of the little wheel

C[θ]=(({{R Cos[θ]}, {R Sin[θ]}}))

because...

The tip of the little wheel

W[ω] = (({{(Subscript[r, s]) Cos[ω]}, {(Subscript[r, s]) Sin[ω]}}))

because...

The relation between  θ  and  ω

...
finally, we see that

ω  =  (((Subscript[r, b]) + (Subscript[r, s]))/(Subscript[r, s])) θ

so the combined equations for the epicycloid curve are

x[θ] = ((Subscript[r, b]) + (Subscript[r, s])) Cos[θ] + 
        (Subscript[r, s]) Cos[(((Subscript[r, b]) + (Subscript[r, s]))/(Subscript[r, s])) θ]

y[θ] = ((Subscript[r, b]) + (Subscript[r, s])) Sin[θ] + 
        (Subscript[r, s]) Sin[(((Subscript[r, b]) + (Subscript[r, s]))/(Subscript[r, s])) θ]

The Animated Epicycloid

Clear[X,Y,t,rB,rS,w];

X[t_] := (rB+rS){Cos[t],Sin[t]};
w := (rB + rS)/rS
Y[t_] := rS{Cos[w t],Sin[w t]};

rB = 3;
rS = 1;

circB = Graphics[Circle[{0,0},rB]];
Do[
arc = ParametricPlot[X[t]+Y[t],{t,0,s},
	PlotRange->{{-1.1(rB+2 rS),1.1(rB+2 rS)},{-1.1(rB+2 rS),1.1(rB+2 rS)}},
	PlotStyle->{{Thickness[0.01],Blue}}, AxesLabel->{"x","y"},
	DisplayFunction->Identity];
	
	circS = Graphics[Circle[X[s],rS]];

Show[arc,circB,circS,
	Arrow[X[s],Red],
	Arrow[Y[s],Tail->X[s],Blue],
	DisplayFunction->$DisplayFunction];
,{s,Pi/20,2Pi,Pi/20}];

The Cycloid (HINT 43.5)

A wheel of radius  1  rolls to the right along the  x-axis at velocity  v.  The vector pointing to the center of the wheel is

c[t] = {v t,1}

The vector pointing from the center of the wheel to a reference point that starts pointing down to the track at  t=0  and rotates as the wheel turns has equation

w[t] = {-r Sin[ omega ], -r Cos[  omega ]}

where   omega  is the angle the wheel has turned.  (NOTE: w[0] = {0,-1}.)

The distance moved along the x-axis at time  t  is  v t.  How much distance is marked off along the rolling wheel in terms of  omega  and the radius?  Equate these distances to give a formula for  theta in terms of  t, assuming no slipping of the wheel.  Plot the curve by forming the proper vector sum to make the parametric plot.

The Cycloid Computation

A wheel rolls along a straight flat track.  The pen may extend beyond the wheel, such as at the edge of the flange on a railroad wheel.

Clear[c,w,t,v,omega];
v = 1;		(*Velocity of the center.*)
r = 1;		(*Radius of the wheel.*)
rp = 1.5;	(*Radius of the pen along the wheel.*)

omega := ?? angle in terms of  t ??;

c[t_] := {v*t,r};
w[t_] := {-rp Sin[omega],- rp Cos[omega]}

ParametricPlot[c[t]+w[t],{t, 0, 6 Pi},
				AspectRatio -> Automatic];

The Area Under a Loop of the Cycloid

The Hypocycloid: Exploration 43.9

A small wheel of radius rs rolls around the inside of a large fixed wheel of radius rb.  Use vectors to find parametric equations for the path of a point on the tip of the small wheel and plot the path using Mathematica.

There are three changes you need to make in the Epicycloid program above in order to draw the hypocycloid:

First the distance to the center of the small wheel is no longer (rB + rs), because the small wheel rolls inside  the big one.

Second, the small wheel rolls clockwise as its center moves counterclockwise around the inside of the big wheel.  If you mark the angle on the small wheel  w  measured clockwise from the horizontal, the wheel vector becomes:

W (w)  =  {  rS  Cos[ ?w] ,  rS Sin[ ?w]  }

Third, the equation for "no slipping" is no longer the same.  The distance traveled along the big wheel is  still  rb q  but the distance moved along the small wheel is measured by (q + w)  and  rs , of course.  Solve the equal lengths equation for  w = ?? q.

Finally, if the large wheel has radius 3 and the small wheel has radius 1, how many turns does the small wheel make when going around the large wheel once?

Hypocycloid - your computation.

Copy the Epicycloid program above to the input cell below and modify it according to your calculations  to plot the hypocycloid.

Hypocycloid - check your theory.

The hypocycloid is the parametric curve made by a Spirograph toy when a small wheel is rolled around the inside of a big wheel.  The following graph was produced with rB = 96, rs = 32 and rp = 24.

Alternative: The Hypocycloid as a Negative Epicycloid

What happens if you use the epicycloid program with r = -1?  Explain why you get  hypocycloid figures as if you had started the Spirograph with the small wheel in a different position.