Homework 4: the Gradient

Off[General::"spell"];
Off[General::"spell1"];

Needs["Units`"];

SetOptions[ListAnimate, AnimationRepetitions -> 4];
SetOptions[Animate, AnimationRepetitions -> 4];

CMView={2.7,1.6,1.2};

Vector Drawer

(* :Date:  Copyright 1993-2011, Math Everywhere, Inc. 
*)
(*
Original Conception to create a vector drawer is due to Bill Davis.
Current code is by Bruce Carpenter.
*)
(*  :Drawbacks:  Since the vectors are drawn out of 
     context, the shapes of the arrowheads are only 
     correct with AspectRatio set to Automatic.
*)

BeginPackage["Vector3D`"];

Axes3D::usage="Axes3D[a, b] creates a Graphics3D object of cartesian axes with x, y, and z running from -a/3 to a, and with axes labels b units beyond the tips of the axes.  Axes3D[a] is Axes3D[a, a/8].";
Perpend::usage="Perpend[a] returns a unit vector which is perpendicular to the vector a.";
Vector::usage="Vector[a] produces a 2 or 3 dimensional vector from the origin to a. Arrow[a, Tail -> tail] gives a vector from tail to a.";
CandMArrow::usage="CandMArrow[a, b] gives a 2D or 3D arrow from a to b.";
VectorHead::usage="VectorHead[a, vec] produces an arrowhead with its tip placed at the point a, pointing in the direction of the vector vec.";
Tail::usage="Tail -> point puts the tail of the vector at point.";
Aperture::usage="Aperture is the ratio of the radius of the base to the length of the head of a vector.";
TipSize::usage="TipSize specifies an absolute size for the inner tip length of the head of a vector.";
TipRatio::usage="TipRatio is the ratio of the inner length of the arrowhead to the length of the shaft of a vector.";
HeadRatio::usage="HeadRatio is the ratio of the outer length of the arrowhead to the length of the shaft of a vector.";
HeadSize::usage="HeadSize specifies an absolute size for the head of a vector.";
ScaleFactor::usage="ScaleFactor specifies the amount to scale a vector in length and may be either a number or a pure function.";
ZeroVectorPointSize::usage="ZeroVectorPointSize is the size of the point used to represent a zero vector.";
Options[Vector]=Options[CandMArrow]=Options[VectorHead]={HeadRatio->0.18,TipRatio->0.14,Aperture->0.3,ScaleFactor->1,HeadType->Polygon,ShaftQ->True,EdgesQ->True,VectorColor->RGBColor[0,0,1],ShaftWidth->0.005,ZeroVectorPointSize->0.01};
Begin["`Private`"];
SetOptions[ParametricPlot,AspectRatio->Automatic];
SetOptions[Plot,AspectRatio->Automatic];
SetOptions[Graphics,AspectRatio->Automatic];
Axes3D[u_,v_]:=Graphics3D[{{Blue,Line[{{-(u/3),0,0},{u,0,0}}]},Text["x",{u+v,0,0}],{Blue,Line[{{0,-(u/3),0},{0,u,0}}]},Text["y",{0,u+v,0}],{Blue,Line[{{0,0,-(u/3)},{0,0,u}}]},Text["z",{0,0,u+v}]}];
Axes3D[u_]:=Axes3D[u,(u/8)];
Perpend[a_?VectorQ]:=Normalize[{a[[2]],-a[[1]]}]/;Length[a]==2;
Perpend[a_?VectorQ]:=Normalize[If[a[[1]]==0,{1,0,0},{a[[2]],-a[[1]],0}]]/;Length[a]==3;
Base3D=Table[{Cos[((2 k π)/8.)],Sin[((2 k π)/8.)]},{k,0,8}];
CandMArrow[from_?VectorQ,to_?VectorQ,opts___]:=Module[{sq,sw,ht,hs,hr,tr,ap,sf,vc,zvps,diff=to-from,tip},{sq,sw,ht,hs,hr,ts,tr,ap,sf,vc,zvps}={ShaftQ,ShaftWidth,HeadType,HeadSize,HeadRatio,TipSize,TipRatio,Aperture,ScaleFactor,VectorColor,ZeroVectorPointSize}/.{opts}/.Options[Vector];If[from==to,Return[Graphics[{PointSize[zvps],vc,Point[from]}]]];diff=If[NumberQ[N[sf]],sf diff,sf[diff]];tip=from+diff;If[NumberQ[hs],hr=(hs/(Norm[diff]));tr=0.75 hr];If[NumberQ[ts],tr=(ts/(Norm[diff]))];Graphics[{If[sq,{vc,Thickness[sw],Line[{from,tip-tr diff}]},{}],With[{trans=ap hr Norm[diff] Perpend[diff]},{vc,Thickness[sw],ht[{tip,tip-hr diff+trans,tip-tr diff,tip-hr diff-trans,tip}]}]}]]/;Length[from]==Length[to]==2
CandMArrow[from_?VectorQ,to_?VectorQ,opts___]:=Module[{sq,eq,sw,hs,hr,tr,ap,sf,vc,zvps,diff=to-from,tip},{sq,eq,sw,hs,hr,ap,sf,vc,zvps}={ShaftQ,EdgesQ,ShaftWidth,HeadSize,HeadRatio,Aperture,ScaleFactor,VectorColor,ZeroVectorPointSize}/.{opts}/.Options[Vector];If[from==to,Return[Graphics3D[{PointSize[zvps],vc,Point[from]}]]];diff=If[NumberQ[N[sf]],sf diff,sf[diff]];tip=from+diff;If[NumberQ[hs],hr=(hs/(Norm[diff]))];tr=(hr/2);Graphics3D[{If[sq,{vc,Thickness[sw],Line[{from,tip-tr diff}]},{}],If[eq,{},EdgeForm[]],{SurfaceColor[vc],With[{temp=Perpend[diff]},(Polygon[Append[#1,tip]]&)/@Partition[(tip-hr diff+#1&)/@((ap hr Norm[diff] Base3D).{temp,Normalize[temp\[Cross]diff]}),2,1]]}}]]/;Length[from]==Length[to]==3
Vector[a_,Tail->b_,opts___]:=CandMArrow[b,a+b,opts]
Vector[a_,opts___]:=CandMArrow[Table[0,{Length[a]}],a,opts]
VectorHead[a_,b_,opts___]:=CandMArrow[a-b,a,ShaftQ->False,opts];
End[];
EndPackage[];

Graphics`Colors`GosiaGreen=RGBColor[0, 0.392187, 0];

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].";

Crisscross

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

4) Lagrange's method as part of a solution

Here's the problem under consideration.  A stove burner is in the shape of a disk of radius 4.  The burner heats unevenly; in fact, the temperature at the point {x, y} on the burner is given by
temp[x, y] = 40/(x^2 + (y + 1)^2 + 1) - 30/((x - 1)^2 + (y - 1)^2 + 1) - 0.1 (x^2 + y^2)^2 + 120
where the center of the burner is located at the origin.  We want to know where the hottest and coldest spots are.

Clear[temp,x,y]
temp[x_,y_]=40/(x^2+(y+1)^2+1)-30/((x-1)^2+(y-1)^2+1)-0.1(x^2+y^2)^2 + 120

a)

Find all the critical points for the temperature function (as a function on all of (ℝ^2)).
(Use NSolve, or Mathematica will probably timeout.  You' ll get lots of complex points, which you should ignore; you should find three real critical points.)
What is the temperature at these points?  Are these points on the burner?

b)

Here is a plot of the temperature function, shown first on a big square, then over just the burner.

Plot3D[temp[x,y],{x,-4,4},{y,-4,4},AspectRatio->0.5,ViewPoint->CMView]
ParametricPlot3D[{s Cos[t],s Sin[t],temp[s Cos[t],s Sin[t]]},{s,0,4},{t,0,2Pi},AspectRatio->0.5,ViewPoint->CMView+{0,0,15}]

As you can hopefully see, the minimum temperature on the burner doesn' t occur at any of the critical points.  It happens on the boundary of the burner.  Use Lagrange' s method to find the maximum and minimum temperatures on the boundary (circle) of the burner.  Then say what the maximum and minimum temperatures on the whole burner are, and where they occur.