(* problem numbers are for Fifth Edition of Hughes-Hallet et alli text *)

Problem 5 (section 15.1)

Clear[f,x,y,fxx,fyy,fxy,disc];
f[x_,y_]=Sin[x] Sin[y];
ContourPlot[f[x,y],{x,-1,2},{y,-1,2},ContourShading->False,Contours->20]
fxx=(∂_x)(∂_x)f[x,y];
fyy=(∂_y)(∂_y)f[x,y];
fxy=(∂_y)(∂_x)f[x,y];
disc[x_,y_]=fxx fyy-(fxy^2);
Print["f(x,y) = ",f[x,y],"  has a critical point at the origin (and MANY other places)."];Plot3D[f[x,y],{x,-1,2},{y,-1,2},AxesLabel->{"x","y",None}]

Clear[f,x,y,fxx,fyy,fxy,disc];
f[x_,y_]=Sin[x] Sin[y];
ContourPlot[f[x,y],{x,-10,10},{y,-10,10},ContourShading->False,Contours->20]
fxx=(∂_x)(∂_x)f[x,y];
fyy=(∂_y)(∂_y)f[x,y];
fxy=(∂_y)(∂_x)f[x,y];
disc[x_,y_]=fxx fyy-(fxy^2);
Print["f(x,y) = ",f[x,y],"  has a critical point at the origin (and MANY other places)."];Plot3D[f[x,y],{x,-10,10},{y,-10,10},AxesLabel->{"x","y",None}]

Problem 7 (section 15.1)

Clear[f,x,y,fxx,fyy,fxy,disc];
f[x_,y_]=x^2-2*x*y+3*y^2-8*y;
ContourPlot[f[x,y],{x,-5,5},{y,-5,5},ContourShading->False,Contours->20]
fxx=(∂_x)(∂_x)f[x,y];
fyy=(∂_y)(∂_y)f[x,y];
fxy=(∂_y)(∂_x)f[x,y];
disc[x_,y_]=fxx fyy-(fxy^2);
Print["f(x,y) = ",f[x,y],"  has one critical point."];Plot3D[f[x,y],{x,-5,5},{y,-5,5},AxesLabel->{"x","y",None}]

Problem 12 (section 15.1)

Clear[f,x,y,fxx,fyy,fxy,disc];
f[x_,y_]=(x^3)+(y^3)-6 (y^2)-3 x+9;
ContourPlot[f[x,y],{x,-2,2},{y,-1,5},ContourShading->False,Contours->20]
fxx=(∂_x)(∂_x)f[x,y];
fyy=(∂_y)(∂_y)f[x,y];
fxy=(∂_y)(∂_x)f[x,y];
disc[x_,y_]=fxx fyy-(fxy^2);
Print["f(x,y) = ",f[x,y],"  has 4 critical points."];Plot3D[f[x,y],{x,-2,2},{y,-1,5},AxesLabel->{"x","y",None}]

Problem 13 (section 15.1)

Clear[f,x,y,fxx,fyy,fxy,disc];
f[x_,y_]=(x+y) (x y+1);
ContourPlot[f[x,y],{x,-2.5`,2.5`},{y,-2.5`,2.5`},ContourShading->False,Contours->25]
fxx=(∂_x)(∂_x)f[x,y];
fyy=(∂_y)(∂_y)f[x,y];
fxy=(∂_y)(∂_x)f[x,y];
disc[x_,y_]=fxx fyy-(fxy^2);
Print["f(x,y) = ",f[x,y],"  has 2 critical points"];Plot3D[f[x,y],{x,-2.5`,2.5`},{y,-2.5`,2.5`},AxesLabel->{"x","y",None}]

Problem 24 (section 15.1)

Clear[f,x,y,fxx,fyy,fxy,disc];
f[x_,y_]=(x^3)+(E^(-(y^2)));
ContourPlot[f[x,y],{x,-0.5`,0.5`},{y,-0.5`,0.5`},ContourShading->False,Contours->40]
fxx=(∂_x)(∂_x)f[x,y];
fyy=(∂_y)(∂_y)f[x,y];
fxy=(∂_y)(∂_x)f[x,y];
disc[x_,y_]=fxx fyy-(fxy^2);
Print["f(x,y) = ",f[x,y],"  has one critical point."];
Plot3D[f[x,y],{x,-0.5`,0.5`},{y,-0.5`,0.5`},AxesLabel->{"x","y",None}]

Problem 26 (section 15.1)

Clear[f,x,y,fxx,fyy,fxy,disc];
f[x_,y_]=1-Cos[x]+y^2/2;
ContourPlot[f[x,y],{x,-10,10},{y,-10,10},ContourShading->False,Contours->40]
fxx=(∂_x)(∂_x)f[x,y];
fyy=(∂_y)(∂_y)f[x,y];
fxy=(∂_y)(∂_x)f[x,y];
disc[x_,y_]=fxx fyy-(fxy^2);
Print["f(x,y) = ",f[x,y],"  has infinitely many distinct critical points."];
Plot3D[f[x,y],{x,-10,10},{y,-10,10},AxesLabel->{"x","y",None}]

Problem 32 (section 15.1)

Clear[f,x,y,fxx,fyy,fxy,disc];
f[x_,y_]=((x^2)-y) ((x^2)+y);
ContourPlot[f[x,y],{x,-1,1},{y,-1,1},ContourShading->False,Contours->15]
fxx=(∂_x)(∂_x)f[x,y];
fyy=(∂_y)(∂_y)f[x,y];
fxy=(∂_y)(∂_x)f[x,y];
disc[x_,y_]=fxx fyy-(fxy^2);
Print["f(x,y) = ",f[x,y],"  has one critical point."];Plot3D[f[x,y],{x,-1,1},{y,-1,1},AxesLabel->{"x","y",None},AspectRatio->1,PlotPoints->50,ViewPoint->{100,100,50}]

++++++++++++++++++++++++++++++++++++++++++++++++++

Other examples
(including those from class)

Problem 8 (section 15.1)

Clear[f,x,y,fxx,fyy,fxy,disc];
f[x_,y_]=400-3 (x^2)-4 x+2 x y-5 (y^2)+48 y;
ContourPlot[f[x,y],{x,-7,7},{y,-7,7},ContourShading->False,Contours->25]
fxx=(∂_x)(∂_x)f[x,y];
fyy=(∂_y)(∂_y)f[x,y];
fxy=(∂_y)(∂_x)f[x,y];
disc[x_,y_]=fxx fyy-(fxy^2);
Print["f(x,y) = ",f[x,y]];Print["\!\(\*SubscriptBox[\(f\), \(x\)]\) = ",(∂_x)f[x,y],"  \!\(\*SubscriptBox[\(f\), \(xx\)]\) = ",fxx,"  \!\(\*SubscriptBox[\(f\), \(xy\)]\) = ",fxy];Print["\!\(\*SubscriptBox[\(f\), \(y\)]\) = ",(∂_y)f[x,y],"  \!\(\*SubscriptBox[\(f\), \(yy\)]\) = ",fyy,"  \!\(\*SubscriptBox[\(f\), \(yx\)]\) = ",fxy];Print["Discriminant = ",disc[x,y]];Plot3D[f[x,y],{x,-7,7},{y,-7,7},AxesLabel->{"x","y",None}]

Problem 10 (section 15.1)

Clear[f,x,y,fxx,fyy,fxy,disc];
f[x_,y_]=(x^3)-3 x+(y^3)-3 y;
ContourPlot[f[x,y],{x,-2.5`,2.5`},{y,-2.5`,2.5`},ContourShading->False,Contours->25]
fxx=(∂_x)(∂_x)f[x,y];
fyy=(∂_y)(∂_y)f[x,y];
fxy=(∂_y)(∂_x)f[x,y];
disc[x_,y_]=fxx fyy-(fxy^2);
Print["f(x,y) = ",f[x,y]];Print["\!\(\*SubscriptBox[\(f\), \(x\)]\) = ",(∂_x)f[x,y],"   \!\(\*SubscriptBox[\(f\), \(xx\)]\) = ",fxx,"   \!\(\*SubscriptBox[\(f\), \(xy\)]\) = ",fxy];Print["\!\(\*SubscriptBox[\(f\), \(y\)]\) = ",(∂_y)f[x,y],"   \!\(\*SubscriptBox[\(f\), \(yy\)]\) = ",fyy,"  \!\(\*SubscriptBox[\(f\), \(yx\)]\) = ",fxy];Print["Discriminant = ",disc[x,y]];Plot3D[f[x,y],{x,-1.5`,1.5`},{y,-1.5`,1.5`},AxesLabel->{"x","y",None}]

Problem 14 (section 15.1)

Clear[f,x,y,fxx,fyy,fxy,disc];
f[x_,y_]=8 x y-(1/4) (((x+y))^4);
ContourPlot[f[x,y],{x,-2.5`,2.5`},{y,-2.5`,2.5`},ContourShading->False,Contours->25]
fxx=(∂_x)(∂_x)f[x,y];
fyy=(∂_y)(∂_y)f[x,y];
fxy=(∂_y)(∂_x)f[x,y];
disc[x_,y_]=fxx fyy-(fxy^2);
Print["f(x,y) = ",f[x,y]];Print["\!\(\*SubscriptBox[\(f\), \(x\)]\) = ",(∂_x)f[x,y],"  \!\(\*SubscriptBox[\(f\), \(xx\)]\) = ",fxx,"  \!\(\*SubscriptBox[\(f\), \(xy\)]\) = ",fxy];Print["\!\(\*SubscriptBox[\(f\), \(y\)]\) = ",(∂_y)f[x,y],"  \!\(\*SubscriptBox[\(f\), \(yy\)]\) = ",fyy,"  \!\(\*SubscriptBox[\(f\), \(yx\)]\) = ",fxy];Print["Discriminant = ",disc[x,y]];Plot3D[f[x,y],{x,-1.5`,1.5`},{y,-1.5`,1.5`},AxesLabel->{"x","y",None}]

Problem 27 (section 15.1)

Clear[f,x,y,fxx,fyy,fxy,disc];
f[x_,y_]=(E^x) (1-Cos[y]);
ContourPlot[f[x,y],{x,0,5 },{y,-9,9},ContourShading->False,Contours->10]
fxx=(∂_x)(∂_x)f[x,y];
fyy=(∂_y)(∂_y)f[x,y];
fxy=(∂_y)(∂_x)f[x,y];
disc[x_,y_]=fxx fyy-(fxy^2);
Print["f(x,y) = ",f[x,y],"  has a line of critical points for every y-value with Cos[y]=1." ];Plot3D[f[x,y],{x,0,5},{y,-9,9},AxesLabel->{"x","y",None},AspectRatio->1,PlotPoints->50,PlotRange->Automatic,ViewPoint->{100,100,50}]

USE THE REMAINING CELLS TO CHECK YOUR ANSWER TO QUESTION 18.
You need to enter your values for "A", "B", and "C" as "a", "b", and "c" below.

Clear[f,x,y,fx,fy,fxx,fyy,fxy,disc,a,b,c];
a=1; (* enter your value *)
b=1; (* enter your value *)
c=1; (* enter your value *)
f[x_,y_]=a-(x^2+b*x+y^2+c*y);
fx[x_,y_]=D[f[x,y],x];
fy[x_,y_]=D[f[x,y],y];
fxx[x_,y_]=D[D[f[x,y],x],x];
fyy[x_,y_]=D[D[f[x,y],y],y];
fxy[x_,y_]=D[D[f[x,y],x],y];
disc[x_,y_]=fxx[x,y]*fyy[x,y]-fxy[x,y]^2;
Print["f(x,y) = ",f[x,y]];
Print["(Subscript[f, x]) = ",D[f[x,y],x],"  (Subscript[f, xx]) = ",fxx[x,y],"  (Subscript[f, xy]) = ",fxy[x,y]];
Print["(Subscript[f, y]) = ",D[f[x,y],y],"  (Subscript[f, yy]) = ",fyy[x,y],"  (Subscript[f, yx]) = ",fxy[x,y]];
Print["Discriminant = ", disc[x,y]];
Clear[temp];
temp=FindMinimum[-1*f[x,y],{x,-1},{y,0}];
Print["The local maximum of f[x,y] is ",-1*temp[[1]]];
Print["    and it occurs when ",temp[[2]]];

If[f[-2,1]==15,Print["GOOD: f(-2,1)=15"],Print["NO: f(-2,1) is not 15"]];
If[fx[-2,1]==0,Print["GOOD: (Subscript[f, x])=0 at (-2,1)"],Print["NO: (Subscript[f, x]) is not zero at (-2,1)"]];
If[fy[-2,1]==0,Print["GOOD: (Subscript[f, y])=0 at (-2,1)"],Print["NO: (Subscript[f, y]) is not zero at (-2,1)"]];
If[disc[-2,1]>0,Print["GOOD: The dicriminant is positive at (-2,1)"],  ];
If[disc[-2,1]<0,Print["BAD: The discriminant is negative at (-2,1)"],  ];
If[disc[-2,1]>0,If[fxx[-2,1]<0,Print["GOOD: (Subscript[f, xx])<0"],  ],  ];

ContourPlot[f[x,y],{x,-4,0},{y,-1,3},ContourShading->False,Contours->25]
Plot3D[f[x,y],{x,-4,0},{y,-1,3},AxesLabel->{"x","y",None}]