The Gradient of a Function
f[x,y]

by
K. D.  Stroyan
University of Iowa

copyright 1997 by Academic Press, Inc. - All rights reserved.

Special Mathematica Functions used in this NoteBook

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},BoxRatios->{1,1,1}];
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]];

sliceAt[f_,xCnt_,yCnt_,scale_,z_,zMIN_,opns___] :=
	Module[{surface,plane,contour,pLz,contLz,w},

	surface = Plot3D[ f[x,y] , {x,xCnt-scale,xCnt+scale},
						{y,yCnt-scale,yCnt+scale},opns,
				PlotPoints->30,BoxRatios->Automatic,
				AxesLabel->{"x","y","z"},
				ViewPoint->{1.149, -3.086, 0.779},
				DisplayFunction->Identity];


	plane[w_] := Plot3D[ w , {x,xCnt-scale,xCnt+scale},
						{y,yCnt-scale,yCnt+scale},
				PlotPoints->2,BoxRatios->Automatic,
				Ticks->None,DisplayFunction->Identity];
						
	contour[w_] := ContourPlot[ f[x,y] ,
		{x,xCnt-scale,xCnt+scale},{y,yCnt-scale,yCnt+scale},
		PlotPoints->30, Contours->{w},DisplayFunction->Identity];

				
	pLz = plane[z];

	contLz = Show[Evaluate[contour[z]],
			ContourShading->False,
			DisplayFunction -> Identity];

	contLz = First[Graphics[contLz]];
					
	contLz = Graphics3D[contLz /. Line[x_]:>
			Line[Map[Append[#,zMIN]&,x]]];

Show[surface,pLz,contLz,opns,
		DisplayFunction->$DisplayFunction]]

Notebook Overview

This NoteBook shows how the gradient interpretation of partial derivatives is used.  There are two main ways:

The gradient   Grad f = {a,b}  is the direction of fastest ascent at (x1,y1) 
		& |Grad f | is the fastest rate of increase

Suppose we know the value of a function at {x1,y1},  z1 = f[x1,y1], and want to move in the  x-y-plane in the direction that will increase  f[x,y]  at the fastest rate.  The tangent approximation of the  says that for any small vector  {dx,dy},

f[x+dx,y+dy] - f[x,y] ≈ a dx + b dy = {a,b}.{dx,dy}

The dot product

{a,b}.{dx,dy} = |{a,b}| * |{dx,dy}| * Cos[ Angle[{a,b},{dx,dy}] ]

so the largest value of this expression is when the cosine of the angle is +1, the smallest is when the cosine of the angle is -1 and there is no INSTANTANEOUS change if {a,b} and {dx,dy} are perpendicular. In other words:

(1)  if you move {dx,dy} in the direction of {a,b} = Grad f[x1,y1], the norm,

|Grad f[x1,y1]| = the fastest rate of increase of  f[x,y]  at  (x1,y1)

(2)  if you move in the direction of -{a,b} = -Grad f[x1,y1], f decreases at the fastest rate,

-|Grad f[x1,y1]| = the fastest rate of decrease of  f[x,y]  at  (x1,y1)

(3)  if you move {dx,dy} perpendicular to {a,b} = Grad f[x1,y1], f only changes by the error,  |{dx,dy}| · ϵ, in other words, it changes by "zero to first order."

The gradient is perpendicular to the level curve.

The implicit CURVE: f[x,y] = z1 (constant)  at  {x1,y1} 
has implicit tangent LINE: a dx + b dy = 0  in local coordinates,
with normal  grad f = {a,b}

Use this procedure for finding the implicit tangent LINE:

(0)  Begin with an implicit equation   f[x,y] = z1,  with  z1 a constant,
        and a point {x1,y1} satisfying the equation  f[x1,y1] = z1.

(1)  Compute the symbolic partial derivatives  df/dx and df/dy.

(2)  Evaluate the specific numbers  a = df/dx  and  b = df/dy  at the point  (x1,y1).

(3)  In local (dx,dy,dz)- coordinates, the equation of the tangent line is:

a dx + b dy = 0

Notice that this is an implicit linear function in (dx,dy)-coordinates.

(4)  The implicit function theorem says that if you can solve this linear equation for one of the d-variables, say,  dy = -(a/b) dx, in case  b is not zero, then there is a nonlinear function  y = y[x] defined for at least a small domain of x-values satisfying  f[x,y[x] ] = z1,  or,

y = y[x]

is an explicit representation of a small piece of the curve and its total differential is

dy = -(a/b) dx

References to the Text

This NoteBook goes with Section 18.5 of the text.

A Step-by-step Example of the Gradient

Compute each step of this example in order, first doing the computations by hand yourself.

Step (0): The Function & Graphs

Sketch a plot of the surface  z = 1 - (((x^2)/2) + ((y^2)/9)) by hand and then compare your sketch to Mathematica's drawing.  Make sure the point (x,y) = (1,2) lies on your plot.  Next, draw the contour curve through the level  z1 = 1 - (1/2 + 4/9) = 1/18

Clear[x, y, z, f, dx, dy, dz, p, v, pfpx, pfpy, gradf]; f[x_, y_] := 1 - (((x^2)/2) + ((y^2)/9)); x1 = 1; y1 = 2; d = 5; z1 = f[x1, y1]; surface = 
      sliceAt[f, x1, y1, d, z1, f[6, 7], 
        ViewPoint -> {1.325, -2.997, 0.845}, 
        DisplayFunction -> Identity]; Show[surface, Graphics3D[{PointSize[0.02], Point[{x1, y1, z1}]}], 
      DisplayFunction -> $DisplayFunction]; contour = 
      ContourPlot[f[x, y], {x, x1 - d, x1 + d}, {y, y1 - d, y1 + d}, 
        Contours -> {f[x1, y1]}, PlotPoints -> 30, 
        DisplayFunction -> Identity]; Show[contour, Graphics[{PointSize[0.02], Point[{x1, y1}]}], 
      DisplayFunction -> $DisplayFunction];

Step (1): The Partials,Gradient, and Total Derivative

Calculate the partial derivatives of this function by hand, write out the total derivative and then <Enter> the Mathematica computation of them and compare:

\(pfpx[x_, y_] := \ Evaluate[D[f[x, y], x]]; 

    pfpy[x_, y_] := \ Evaluate[D[f[x, y], y]]; 


    gradf[x_, y_] := {pfpx[x, y], pfpy[x, y]}; 

    \(Print["Partial df/dx = ", pfpx[x, y]]; \)\)Print[" "]; Print["Partial df/dy = ", pfpy[x, y]]; Print["Grad f = ", gradf[x, y]]; Print[" "]; Print["dz = ", pfpx[x, y], " dx + ", pfpy[x, y], " dy"];

Step (2): Evaluating the Specific Slopes

In your hand computation, set  x1 = 1,  y1 = 2  and evaluate the gradient, then  <Enter> the Mathematica version below.  Compare results.

dz[dx_, dy_] := pfpx[x1, y1] dx + pfpy[x1, y1] dy{x1, y1}gradf[x1, y1]dz[dx, dy]

Step (3): The Tangent Line in Local Coordinates

Plot the specific differential  dz = a dx + b dy and <Enter> the Mathematica version below.  Compare results.

loccontour = 
      ContourPlot[dz[dx, dy], {dx, -d, d}, {dy, -d, d}, 
        PlotRange -> {-d, d}, Contours -> {0}, 
        DisplayFunction -> Identity]; Show[{loccontour, Arrow[gradf[x1, y1], Red]}, Frame2D[1], 
      DisplayFunction -> $DisplayFunction]; surface = 
      sliceAt[dz, 0, 0, d, 0, dz[5, 5], 
        ViewPoint -> {1.325, -2.997, 0.845}, 
        DisplayFunction -> Identity]; Show[surface, Graphics3D[{PointSize[0.02], Point[{0, 0, 0}]}], 
      DisplayFunction -> $DisplayFunction];

Step (4): The Gradient in (x,y) - Coordinates

Replace dx by (x - x1), dy by (y - y1) and dz by (z - f[x1,y1]) by hand and write out the specific equation z = z1 + a (x - x1) + b (y - y1).  Sketch both graphs together.  Compare results.

Clear[x, y]; Print["Grad f = ", gradf[x1, y1]]; Plot3D[f[x, y], {x, x1 - d, x1 + d}, {y, y1 - d, y1 + d}, 
      PlotRange -> {z1 - d, z1 + d}, PlotPoints -> 30, 
      ViewPoint -> {1.325, -2.997, 0.845}]; contour = 
      ContourPlot[f[x, y], {x, x1 - d, x1 + d}, {y, y1 - d, y1 + d}, 
        PlotPoints -> 30, DisplayFunction -> Identity]; Show[{contour, Arrow[gradf[x1, y1], Tail -> {x1, y1}, Red], 
        Frame2D[1]}, DisplayFunction -> $DisplayFunction];

Step (5): Zooming to Tangency

Now we magnify the graph more and more at the point (x1,y1,z1):

d = 2; Do[
      contour = 
        ContourPlot[f[x, y], {x, x1 - d, x1 + d}, {y, y1 - d, y1 + d}, 
          PlotPoints -> 30, FrameTicks -> None, 
          ContourShading -> False, DisplayFunction -> Identity]; 
      Show[{contour, 
          Arrow[(1/2) d gradf[x1, y1], Tail -> {x1, y1}, Red]}, 
        DisplayFunction -> $DisplayFunction]; d = (d/2), {n, 1, 6}];

A Combined Gradient Example

The next computation combines all the steps described for the gradient.

Clear[x, y, z, f, dx, dy, dz, p, v, pfpx, pfpy, gradf]; \(f[x_, y_] := 5\ \((x\^2 + y\^2)\)\ Exp[\(-\((x\^2\/2 + y\^2\/3)\)\)]; 

    
pfpx[x_, y_] := \ Evaluate[D[f[x, y], x]]; 

    pfpy[x_, y_] := \ Evaluate[D[f[x, y], y]]; 


    gradf[x_, y_] := {pfpx[x, y], pfpy[x, y]}; 

    \(Print["Partial df/dx = ", pfpx[x, y]]; \)\)Print[" "]; Print["Partial df/dy = ", pfpy[x, y]]; Print[" "]; Print["Grad f = ", gradf[x1, y1]]; Print[" "]; x1 = (1/4); y1 = -2; d = 5; z1 = f[x1, y1]; Print["At x = ", x1, "and  y = ", y1]; Print[" "]; Print["The approx. gradient  Grad f = ", N[gradf[x1, y1]]]; 
    surface = 
      Plot3D[f[x, y], {x, x1 - d, x1 + d}, {y, y1 - d, y1 + d}, 
        PlotRange -> {z1 - d, z1 + d}, PlotPoints -> 30, 
        ViewPoint -> {1.325, -2.997, 0.845}, 
        AxesLabel -> {"x", "y", "z"}, 
        DisplayFunction -> Identity]; Show[surface, Graphics3D[{PointSize[0.02], Point[{x1, y1, z1}]}], 
      DisplayFunction -> $DisplayFunction]; line = 
      ContourPlot[
        gradf[x1, y1] . {x - x1, y - y1}, {x, x1 - d, x1 + d}, {y, y1 - d, 
          y1 + d}, Contours -> {0}, ContourShading -> False, 
        DisplayFunction -> Identity]; contour = 
      ContourPlot[f[x, y], {x, x1 - d, x1 + d}, {y, y1 - d, y1 + d}, 
        PlotPoints -> 30, DisplayFunction -> Identity]; Show[{contour, Arrow[gradf[x1, y1], Tail -> {x1, y1}, Red], 
        Frame2D[1], line}, DisplayFunction -> $DisplayFunction];

Explanations of the Figure from the Previous Computation

See:

The gradient   Grad f = {a,b}  is the direction of fastest ascent at (x1,y1)

and

The implicit CURVE: f[x,y] = z1 has implicit tangent LINE: a dx + b dy = 0

Zooming to Tangency

Now we magnify the graph more and more at the point (x1,y1,z1):

d = 2;
Do[
contour = ContourPlot[f[x,y],{x,x1-d,x1+d},{y,y1-d,y1+d},
		FrameTicks->None,ContourShading->False,
 		PlotPoints->30,DisplayFunction->Identity];

Show[{contour,Arrow[(d/2)*gradf[x1,y1],Tail->{x1,y1},Red]}, 
	DisplayFunction->$DisplayFunction];
	d = d/2
	,{n,1,6}];

Lots of Gradients: Example 18.8 on Heat Flow

The next computation shows gradient vectors at many points.  <Enter> it.

This is Example 18.8 on heat flow in the text.  (We scaled the gradient vectors by 1/3 so they wouldn't cross.)

Clear[x, y, z, f, dx, dy, dz, p, v, pfpx, pfpy, gradf]; \(f[x_, y_] := x\ y\ \((1 - x)\)\ \((1 - y)\); 


    pfpx[x_, y_] := \ Evaluate[D[f[x, y], x]]; 

    pfpy[x_, y_] := \ Evaluate[D[f[x, y], y]]; 


    gradf[x_, y_] := {pfpx[x, y], pfpy[x, y]}; 

    \(Print["Grad f = ", gradf[x, y]]; \)\)contour = 
      ContourPlot[f[x, y], {x, 0, 1}, {y, 0, 1}, 
        ContourShading -> False, PlotPoints -> 30, 
        DisplayFunction -> Identity]; arrows = 
      Table[Arrow[(1/3) gradf[x, y], Tail -> {x, y}, 
          AbsoluteThickness[2]], {x, 0, 1, (1/8)}, {y, 0, 1, (1/8)}]; Show[{contour, arrows}, DisplayFunction -> $DisplayFunction];

Exercises

Exercise 18.5.1

Draw the contour graph of   z = (x^2) + (y^2)/3   together with its tangent line at the points (x,y) =

(0,0), (1,1), (-1,0)

Which direction should you move at each of these points in order to increase at the fastest rate.  At what rate will you increase?  Which directions could you move in order to not change at all?

Computer Exercises

Hand calculations like 18.5.1 are based on a simple idea.  Use that idea to find rates of increase for the following more complicated functions:

Exercise 18.5.2

Draw the contour graph of   z = (x^2) + (y^3)   together with its tangent line at the point  (x,y) = (1,1).  Zoom in to the point and see the graph approach the tangent line.

Which direction should you move at this point in order to increase at the fastest rate.  At what rate will you increase?  What happens if you move in the opposite direction?  Which directions could you move in order to not change at all?

Exercise 18.5.2

Draw the level line on the contour plot of the function  f[x,y] = Cos[π x] Sin[π y]  that passes thru the point  x = 1/4,  y = 1/3.  Show the gradient vector of the function at this point.

Which direction should you move at this point in order to increase at the fastest rate.  At what rate will you increase?  What happens if you move in the opposite direction?  Which directions could you move in order to not change at all?

Problem 18.2 on the Perfecto Skier

Perfecto ski Bowl has perfectly manicured slopes in the shape

a = (x^2) + (y^2)

where  a  is the altitude, x  measures East and  y  measures North for  0 < x,y < 10.  Use Mathematica to sketch a contour plot of Perfecto and place arrows at many points on the mountain pointing downhill in the steepest possible direction at the point in question.

Exercise on Implicit Curves 18.7.3

1)  Sketch the ellipse

((((x/3)))^2) + ((((y/4)))^2) = 1

using Mathematica's ContourPlot on the function  f[x,y] = (x/3)^2 + (y/4)^2  with the Option

Contours->{1}

2)  Use Mathematica to compute the gradient of f[x,y].

3)  Fix the specific point  x = 12/5,  y = -12/5

4)  Plot the tangent line using your equation and Show both the curve and the line on the same plot.