Calculus: The Language of Change

Exercise Set 15.2
Computer Exercise: #3
Position Vectors

solutions by Randall Childs and David Theobald

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 = (.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]];

\(
\)

Exercise 3

Draw a 3-D rectangular box with sides parallel to the x, y, z axes and the vector X(1,3,2) pointing across its diagonal.

Enter the input cell below in order to see a Mathematica drawing of the requested picture.  You may wish to make the graph larger.  Mathematica doesn't draw the (Subscript[x, 1]), (Subscript[x, 2]), and (Subscript[x, 3]) axes in its 3-D plots, but the graph has been oriented so that the positive and negative directions of (Subscript[x, 1]), (Subscript[x, 2]), and (Subscript[x, 3]) in these plots correspond to the same directions in the 3-D diagrams in the text.

The gray line segments are the edges of the box.  Three of the edges coincide with the positive (Subscript[x, 1]),(Subscript[x, 2]), and (Subscript[x, 3]) axes.  These edges are "behind" the other nine edges and would be invisible if the box were constructed with some opaque material.  These three edges are a lighter gray than the others.  The black line connecting the intersection of the light gray edges and the large point is the vector (1,3,2).

\(AB\  = \ 
      Graphics3D[\ {\ GrayLevel[0.4], \ Line[{{1, 0, 0}, \ {1, 3, 0}}]\ }\ ]; 
    
BC\  = \ 
      Graphics3D[\ {\ GrayLevel[0.4], \ Line[{{1, 3, 0}, \ {0, 3, 0}}]\ }\ ]; 
    
EF\  = \ 
      Graphics3D[\ {\ GrayLevel[0.4], \ Line[{{1, 0, 2}, \ {1, 3, 2}}]\ }\ ]; 
    
FG\  = \ 
      Graphics3D[\ {\ GrayLevel[0.4], \ Line[{{1, 3, 2}, \ {0, 3, 2}}]\ }\ ]; 
    
EH\  = \ 
      Graphics3D[\ {\ GrayLevel[0.4], \ Line[{{1, 0, 2}, \ {0, 0, 2}}]\ }\ ]; 
    
GH\  = \ 
      Graphics3D[\ {\ GrayLevel[0.4], \ Line[{{0, 3, 2}, \ {0, 0, 2}}]\ }\ ]; 
    
AE\  = \ 
      Graphics3D[\ {\ GrayLevel[0.4], \ Line[{{1, 0, 0}, \ {1, 0, 2}}]\ }\ ]; 
    
BF\  = \ 
      Graphics3D[\ {\ GrayLevel[0.4], \ Line[{{1, 3, 0}, \ {1, 3, 2}}]\ }\ ]; 
    
CG\  = \ 
      Graphics3D[\ {\ GrayLevel[0.4], \ Line[{{0, 3, 0}, \ {0, 3, 2}}]\ }\ ]; 
    
DA\  = \ 
      Graphics3D[\ {\ GrayLevel[0.8], \ Line[{{0, 0, 0}, \ {1, 0, 0}}]\ }\ ]; 
    
DC\  = \ 
      Graphics3D[\ {\ GrayLevel[0.8], \ Line[{{0, 0, 0}, \ {0, 3, 0}}]\ }\ ]; 
    
DH\  = \ 
      Graphics3D[\ {\ GrayLevel[0.8], \ Line[{{0, 0, 0}, \ {0, 0, 2}}]\ }\ ]; 
    
df\  = \ Graphics3D[Line[{{0, 0, 0}, {1, 3, 2}}]]; 

    pt\  = \ Graphics3D[\ {\ PointSize[0.03], \ Point[{1, 3, 2}]\ }\ ]; 

    Show[{AB, BC, EF, FG, EH, GH, AE, BF, CG, DA, DC, DH, df, pt}, \ 
      Axes\  -> \ True, \ 
      PlotRange\  -> \ {{\(-3\), 3}, {\(-3\), 3}, {\(-3\), 3}}, \ 
      ViewPoint\  -> \ {1.5, 0.9, 0.9}]; \)

Why does this cell work?

The first fourteen lines take sets of three-dimensional graphical information and assigns a name to each set.  The last line tells Mathematica to actually draw or "Show" that graphical information with a set of guidelines telling the computer how to draw the graph.

The result is that Mathematica draws a box showing all points in three-dimensional space for which -3≤x1≤+3, -3≤x2≤+3, and -3≤x3≤+3.  Then it draws gray line segments which are the edges of the smaller box as described above.  The names given to these line segments follow the traditional geometric custom of naming important points in a geometric figure by capital letters and assigning to any line segment the pair of letters corresponding to its endpoints.  Then it draws in black the vector corresponding to the given set of coordinates.  Finally, it draws a "big" point at the given set of coordinates.