topic:  the gradient from a geometric point of view
description:  discusses the relationship between the gradient and a level curve.  Contains an application to heat-seeking missiles.
file name:  gradient.nb
directions:  Read the text cells for background information.  Execute any existing input cells as you come to them.  Answer questions or work exercises as you come to them.  Modify the existing input cells as needed to work exercises requiring the use of Mathematica.

Needs["Graphics`Colors`"]
Off[General::spell];
Off[General::spell1];
Off[ParametricPlot3D::ppcom];
Off[ParametricPlot::ppcom];
Off[Plot::plnr];
SetOptions[Limit,Analytic->True];

CMView = {2.7, 1.6, 1.2};

ThreeAxes[u,v]

ThreeAxes[u_,v_] := 
      Graphics3D[{
            {Blue,Line[{{-u,0,0},{u,0,0}}]},
                    Text["x",{u + v,0,0}],
            {Blue,Line[{{0,-u,0},{0,u,0}}]},
                    Text["y",{0, u + v,0}],
            {Blue,Line[{{0,0,0},{0,0,u}}]},
                    Text["z",{0,0,u + v}]}]; 
ThreeAxes[u_] := ThreeAxes[u,u/8];
ThreeAxes::usage = "ThreeAxes[a,b] makes a standard cartesian axis graphics object
	with x, y, and z running from -a to a, and with axis
	labels b units beyond the tips of the axes.  ThreeAxes[a]
	is ThreeAxes[a,a/8].";

Vector Drawers

(* :Title:  VectorDraw.m  *)

(* :Author: Bill Davis, for Calculus&Mathematica *)

(* :Summary:  Construct 2 and 3 dimensional vectors,
     arrows, pointers and arrowheads as graphics 
     objects.
*)

(* :Dates:  The original package was written in 1991.
     After messing it up several times, I rewrote it
     in July, 1994. I made an attempt at readability,
     so some things aren't slick.
*)

(*  :Drawbacks:  Since the vectors are drawn out of 
     context, the shapes of the arrowheads are only 
     correct with AspectRatio set to Automatic.  See 
     the Package, "Graphics`Vectors`".
*)

BeginPackage["Vectors3D`","Graphics`Colors`"];

Perp::usage = "Perp[expr] returns a single 3-d vector which is 
		perpendicular to the vector, 'expr'.";
		
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'.";
		
Arrow::usage = "Arrow[expr] produces a 2 or 3 dimensional 
	vector from the origin to expr. Arrow[expr,Tail->tail] gives a 
	vector from tail to expr.  RGBColor and Thickness may be added as 
	options";
	
Vector::usage = "Vector[a,b] gives a vector from a to b. 
			RGBColor and Thickness may be added as options";

Arrowhead::usage = "Arrowhead[at,toward,options] produces an
		arrowhead to be placed on a curve at the point 'at',
		pointing in the direction of the vector 'toward'. The
		size of the arrowhead is .17*Norm[toward], or can be
		set by the options HeadRatio->, or HeadSize->";

DirectedSegment::usage = "DirectedSegment[from,to,opts] 
		produces a line segment from 'from' to 'to' with a 
		direction arrow on the segment.";

HeadRatio::usage = "HeadRatio->num makes the length of the
		vector's head num*vectorLength.";
		
HeadSize::usage = "HeadRatio->num sets the length of the
		arrowhead to num.";

Tail::usage = "Tail->point puts the tail of the vector at
		the point.";

Aperture::usage = "Aperture is an option for arrowheads 
		which sets the ratio of the diameter of its base to the 
		length of the head to the value of Aperture. The default
		value is .6";
		

Vector::notnum = "The vectors `1` and `2` aren't numeric.";

		
Begin["`Private`"];

SetOptions[ParametricPlot,AspectRatio->Automatic];
SetOptions[Plot,AspectRatio->Automatic];
SetOptions[Graphics,AspectRatio->Automatic];

colorQ[a_] := Head[a] === RGBColor;
grayQ[a_]  := Head[a] === GrayLevel;
thickQ[a_] := Head[a] === Thickness;

Perp[a_?VectorQ] := Which[a[[1]]==0,{1,0,0},
			 a[[2]]==0,{0,1,0},
			 True,{-a[[2]],a[[1]],0}];
			
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]]};
				
Norm[a_?VectorQ]:=Sqrt[a.a];

Turn[a_?VectorQ] := Module[{A,B,b = Norm[a],
		dim = Length[a]},
		A = a/b;
		Which[dim==3,B = Perp[A];Transpose[{B,A~Cross~B,A}],
			dim ==2,Transpose[{Reverse[A]{-1,1},A}],
			True,Null]
			];

Base3D = Table[N[{.3 Cos[2 k Pi/7],.3 Sin[2 k Pi/7],-1}],
	{k,8}]; 

UnitHead3D = Flatten[
		Join[
		Table[{{0,0,0},Base3D[[j]],Base3D[[j+1]]},{j,7}],
		Table[{{0,0,-.75},Base3D[[j]],Base3D[[j+1]]},{j,7}]
			],1];

UnitHead2D = {{0,0},{-.3,-1},{0,-.75},{.3,-1}};

VecHead[a_,b_,c_] := Module[{A,len,dim=Length[a]},
		len = Norm[b-a];
		If[len == 0,A = b-a,A = Turn[(b-a)/len]];
		Which[dim==2,Dot[A,#]&/@(Times[{c/.6,1},#]&/@ UnitHead2D),
			dim==3,Dot[A,#]&/@(Times[{c/.6,c/.6,1},#]&/@ UnitHead3D),
			True,Null]];

HeadColorOpts[a_] := Join[Select[a,colorQ],Select[a,grayQ]];

ColorOpts[a_] := Join[Select[a,colorQ],Select[a,grayQ],
	Select[a,thickQ]];

SelectOptions[a_] := Select[a,(Head[#] == Rule)&];

BasicVector[type_?NumberQ,a_,b_,opts___] := 
	Module[{B,aa=N[a],bb=N[b],headColor,len,
			dim=Length[a],aaa,bbb,ccc,AP,HR,HS},
		
		len=Norm[bb-aa];
		aaa = Which[type==1,0,type==2,.25,type==3,1,True,Null];
		bbb = Which[type==1,1,type==2,.75,type==3,0,True,Null];
		ccc = Which[type==1,1,type==2,1,type==3,0,True,Null];
		
		If[!NumberQ[aa.aa+bb.bb],
				Message[Vector::notnum,a,b];Null,

		AP = Aperture/.SelectOptions[{opts}]/.Aperture->.6;
		
		B = VecHead[aa,bb,AP];
		
		HR = HeadRatio/.SelectOptions[{opts}]/.{HeadRatio->.17};
		
		HS = With[{B=HeadSize/.SelectOptions[{opts}]/.{HeadSize->"Nope"}},
			If[NumberQ[B],B,len HR]];
			
				headColor = If[Length[HeadColorOpts[{opts}]]==0,
				Black,First[HeadColorOpts[{opts}]]];
				
		Which[dim==2,
			Graphics[{Append[ColorOpts[{opts}],Line[{aa,ccc bb + (1-ccc)aa}]],
				{headColor,Polygon[Plus[(aaa aa + bbb bb),#]&/@(HS B)]}}],
			dim==3,
			Graphics3D[{Append[ColorOpts[{opts}],
				Line[{aa,ccc bb + (1-ccc)aa}]],
				{SurfaceColor[headColor],
				Polygon[Plus[(aaa aa+bbb bb),#]&/@(HS B)]}}],
			True,Null]]
			];

Vector[from_?VectorQ,to_?VectorQ,opts___]:=
	BasicVector[1,from,to,opts];
		
Vector[to_?VectorQ,opts___] := With[{dim=Length[to]},
				BasicVector[1,Table[0,{dim}],to,opts]];

Arrow[vec_,start_Rule,opts___]:= With[{a=Tail/.{start}},
	BasicVector[1,a,a+vec,opts]];

Arrow[vec_,opts___]:= With[{a=Table[0,{Length[vec]}]},
	BasicVector[1,a,a+vec,opts]];
		
Arrowhead[at_,toward_,opts___] := 
		BasicVector[3,at,toward+at,opts];

DirectedSegment[from_,to_,opts___] :=
		BasicVector[2,from,to,opts];

(*Protect[Perp,Cross,Turn,Vector,Arrow,
		Arrowhead,DirectedSegment];*)

End[];


EndPackage[];
Null
(*

Spherical Setup

Clear[polar]
polar[{x_,y_,z_}]:=
{Sqrt[x^2+y^2+z^2],ArcTan[y/x],ArcCos[z/Sqrt[x^2+y^2+z^2]]};
Clear[X]
length[X_]:=Sqrt[X.X];
rr=3;
R=5;
scale=0.8;
red=RGBColor[1,0,0];
blue=RGBColor[0,0,1];
color1=RGBColor[0.8,0.2,0.8];
color2=RGBColor[0.2,0.8,0.2];
black=RGBColor[0,0,0];
Clear[axes]
axes:=Graphics3D[{
Line[{X,{1.5rr,0,0}}],
Line[{X,{0,1.5rr,0}}],
Line[{X,{0,0,2rr}}]}
];
Clear[xyplane]
xyplane:=Graphics3D[Polygon[
{
{-2rr,-2rr,0},
{-2rr, 2rr,0},
{ 2rr, 2rr,0},
{ 2rr,-2rr,0}
}]];
X={0,0,0};
origin=Graphics3D[{black,Point[X]}];
Z={2,3,5};
Clear[point]
point:=Graphics3D[{red,PointSize[0.03],Point[scale Z]}];
Z0={0,0,length[0.8 Z]};
Clear[zpoint]
zpoint=Graphics3D[{black,Point[Z0]}];
XY=scale Z {1,1,0};
Clear[xypoint]
xypoint:=Graphics3D[{black,Point[XY]}];
X0={length[scale Z {1,1,0}],0,0};
xpoint=Graphics3D[{black,Point[X0]}];
Y0={0,length[scale Z {1,1,0}],0};
ypoint=Graphics3D[{black,Point[Y0]}];
Clear[ray]
ray:=Graphics3D[{blue,Line[{X,scale Z}]}];
Clear[ray1]
ray1:=Graphics3D[{color1,Line[{scale Z,Z}]}];
Clear[xyray]
xyray:=Graphics3D[{red,Line[{X, Z {1,1,0}}]}];
rays:={ray,xyray};
xyaux=
length[0.8 Z](0.8 Z {1,1,0})/length[0.8 Z {1,1,0}];
Clear[zarc]
zarc=Graphics3D[{blue,Line[
Table[Cos[t]{0,0,length[0.8 Z]} + Sin[t]xyaux,
{t,0,polar[0.8 Z][[3]],.1}]
]}];
Clear[zarc1]
zarc1=Graphics3D[{color1,Line[
Table[Cos[t]{0,0,length[0.8 Z]} + Sin[t]xyaux,
{t,polar[0.8 Z][[3]],1,.1}]
]}];
Clear[zarc2]
zarc2=Graphics3D[{color1,Line[
Table[Cos[t]{0,0,length[0.8 Z]} + Sin[t]xyaux,
{t,-.8,0,.1}]
]}];
Clear[xyarc]
xyarc=Graphics3D[{blue,Line[
Table[Cos[t] X0 + Sin[t] Y0,
{t,0,polar[XY][[2]],.1}]
]}];
Clear[xyarc1]
xyarc1=Graphics3D[{color1,Line[
Table[Cos[t] X0 + Sin[t] Y0,
{t,-.5,0,.1}]
]}];
Clear[xyarc2]
xyarc2=Graphics3D[{color1,Line[
Table[Cos[t] X0 + Sin[t] Y0,
{t,polar[XY][[2]],polar[XY][[2]]+0.3,.1}]
]}];
Clear[stick]
stick=Graphics3D[{red,Line[{scale Z,XY}]}];

xaxislabel=Text["x",{0.363,0.26}];
yaxislabel = Text["y",{0.73, 0.30}];
zaxislabel = Text["z",{0.50, 0.67}];

stickplot =
Show[xyplane,axes,ray,point,Boxed->False,
ViewPoint->{2.747, 1.594, 1.168},
Epilog->{xaxislabel,yaxislabel,zaxislabel},
DisplayFunction->Identity];

rho=Text["r",{0.53, 0.45}];
rlabel = Show[xyplane,axes,ray,point,
Boxed->False,ViewPoint->{2.747, 1.594, 1.168},
Epilog->{rho,xaxislabel,yaxislabel,zaxislabel},
DisplayFunction->Identity];

phi=Text["s",{0.55, 0.57}];
slabel =
Show[xyplane,zpoint,axes,ray,point,zarc,zarc1,zarc2,Boxed->False,ViewPoint->{2.747, 1.594, 1.168},
Epilog->{phi,xaxislabel,yaxislabel,zaxislabel},DisplayFunction->Identity];

theta=Text["t",{0.5, 0.3}];

tlabel=Show[xyplane,axes,xypoint,xpoint,ray,stick,point,xyarc,xyarc1,xyarc2,Boxed->False,ViewPoint->{2.747, 1.594, 1.168},
Epilog->{theta,xaxislabel,yaxislabel,zaxislabel},
DisplayFunction->Identity];

all =
Show[xyplane,axes,ray,stick,point,zpoint,xpoint,xypoint,xyarc,xyarc1,xyarc2,zarc,zarc1,zarc2,Boxed->False,ViewPoint->{2.747, 1.594, 1.168},
Epilog->{theta,phi,rho,xaxislabel,yaxislabel,zaxislabel},DisplayFunction->Identity];

Crisscross

Clear[x]
crisscross = Plot[{Cos[x],Sin[x]},{x,Pi/8,3 Pi/8},
    PlotStyle->{{RGBColor[1,0,0],Thickness[0.02]}},
    Axes->None,AspectRatio->1/3,
    DisplayFunction->Identity];

Computer Assignment #2
The Gradient

Special thanks to Calculus&Mathematica (Addison-Wesley, 1994) for their support of these assignments.  Each is very much in the style of C&M, and some problems and commands are adaptations of C&M problems and commands.  In particular, the initialization cells were borrowed from Calculus&Mathematica with permission from Jerry Uhl.  The heat seeker problem is an adaptation of a problem from Calculus&Mathematica's Vector Calculus.

Why should I have to do this computer assignment anyway?

In this assignment we hope to provide you with a good visual understanding of the gradient 
because 
         "THE GRADIENT IS IMPORTANT ENOUGH TO CARRY THE WHOLE 
          COURSE FROM THIS POINT UNTIL ITS CONCLUSION."
                                                                     -Professor J. Jerry Uhl, University of Illinois

Part 1 -- The Gradient

Read the Geometric Definition of the Gradient Vector on Page 143 of your text.

a.  Plot the 3-D graph of f(x,y) = - (x^2)/6 - (y^2)/6.

<<INSERT COMMAND HERE>>

Execute the cells below to see the gradient of f(x,y) at many different points.

Clear[f,gradf,x,y]
f[x_,y_] = - (x^2)/6 - (y^2)/6;
gradf[x_,y_] = {D[f[x,y],x],D[f[x,y],y]};
gradfplot = Show[Table[
    Arrow[gradf[x,y],Tail->{x,y},Blue],
	    {x,-3,3},{y,-3,3}],Axes->Automatic,
	    AxesLabel->{"x","y"}];

b.  Use the geometric definition of the gradient to explain why the vectors point toward the origin.

<<TYPE ANSWER HERE>>

c.  Use the geometric definition of the gradient to explain why the vectors based near the edges of the plot are longer than the vectors based near the origin.

<<TYPE ANSWER HERE>>

d.  Next, plot the 3-D graph of g(x,y) = - (x^2)/3 - (y^2)/6.

<<INSERT COMMAND HERE>>

Next, execute the following to plot the gradient field of g(x,y).

Clear[g,gradg,x,y]
g[x_,y_] = - (x^2)/3 - (y^2)/6;
gradg[x_,y_] = {D[g[x,y],x],D[g[x,y],y]};
gradgplot = Show[Table[
    Arrow[gradg[x,y],Tail->{x,y},Blue],
	    {x,-3,3},{y,-3,3}],Axes->Automatic,
	    AxesLabel->{"x","y"}];

e.  Explain why the gradient vectors do not point DIRECTLY toward the origin in this case.

<<TYPE ANSWER HERE>>

Here is the contour plot of g(x,y):

contours = ContourPlot[- (x^2)/3 - (y^2)/6,
		{x,-3,3},{y,-3,3}];

Observe what happens when we combine the contour plot with the gradient field:

Show[contours,gradgplot];

f.  What is the geometric relationship between the level curves and the gradient vectors?

<<TYPE ANSWER HERE>>

Part 2 -- The Heat Seeker

Adapted from a problem in Calculus&Mathematica's Vector Calculus:  Measuring in Two and Three Dimensions (Addison-Wesley Publishing Company, 1994).

In Computer Assignment #6 (Block 3), we will learn about the flow "lines" (though they're generally not true lines) in a gradient field.  Roughly speaking, a flow line in a gradient field is a curve which runs tangent to each gradient vector that it encounters.  Flow lines in a sense "follow" the gradient field.  In Physics 215, you (will experience/are experiencing/have experienced) flow lines in the form of electric and magnetic field lines.

Assume the temperature surrounding a fighter plane may be modeled by

	T(x,y) = 100/( 1+(x-5.0)^2+ 4(y-2.5)^2),

where (x,y) is a point in the plane of the fighter (no pun intended), and T is in degrees Celsius.

a.  Produce a contour plot of the temperature function in a window which includes both the origin and the hot spot.

<<INSERT COMMAND HERE>>

Suppose a heat-seeking missile is fired from the origin (0,0).  It travels in such a way that it seeks the greatest rate of change in the surrounding air temperature, which is given by the direction of the gradient.  Here is the direction that the missile would travel:

Clear[temp,gradtemp,x,y]
temp[x_,y_] = 100/(1 + (x - 5.0)^2 + 4 (y - 2.5)^2);
gradtemp[x_,y_] = {D[temp[x,y],x],D[temp[x,y],y]};
a = 0;
b = 0;
Print["The gradient vector at (",a,",",b,") is ",
		gradtemp[a,b],"."];

And here is a plot of the gradient vector based at the origin, together with the hot spot representing the plane:

hottestpoint = {5.0,2.5};
a = 0;
b = 0;
start = {a,b};

hotpt=
Graphics[{{PointSize[0.04],Red,
           Point[hottestpoint]},
           Text["hottest",hottestpoint,{0,4}]}];
 
startpt=
Graphics[{{PointSize[0.04],Blue,Point[start]},
           Text["start",start,{-1.5,-1}]}];
 
setup = Show[hotpt,startpt,
             Arrow[gradtemp[a,b],Tail->{a,b},Blue],
                PlotRange->All,Axes->True,
                AxesOrigin->{0,0},AspectRatio->1,
                AxesLabel->{"x","y"}];

b.  Suppose the missile ends up at the tip of the gradient vector above, given by components {0.3845,0.7689}, before its sensors again determine the direction of the greatest rate of change in temperature.  Use Mathematica to determine the new direction which the missile would head.

<<INSERT COMMAND HERE>>

c.  Plot the vector which you found in Part b, together with the vector based at (0,0) given above.

<<INSERT COMMAND HERE>>

d.  Describe the path which the missile would follow if it were to periodically update its direction based on its reading of the current gradient vector.

<<INSERT ANSWER HERE>>

The process of periodically updating direction of travel is known as Euler's method.  This important method (which you will see more of if you are taking Math 245) is used to approximate flow lines in a gradient field.  We will learn more about flow lines and Euler's method in Computer Assignment #6.