Local Extrema of f[x,y], example 2

Set-up

Clear[f,x,y,fx,fy,fxx,fyy,fxy,gradf,CPRules,CPs,n,numPts,disc,d1,d2]
Clear[p1,p2,xlo,xhi,ylo,yhi,numCon,type]
Clear[t1,p3,t2,p4]

Define a function of two variables.

f[x_,y_]:= Cos[x]+Cos[y]

Note that the domain of this function is all of the real plane.

Find critical points

Calculate the 1st and 2nd order derivatives and the critical points just based on where the gradient is zero.

Also check where the gradient is undefined.  Our gradient is defined everywhere.

fx[x_,y_]=(∂_x) f[x,y]
fy[x_,y_]=(∂_y) f[x,y]

gradf[x_,y_]={fx[x,y],fy[x,y]}

fxx[x_,y_]=(∂_(x,x)) f[x,y]
fyy[x_,y_]=(∂_(y,y)) f[x,y]
fxy[x_,y_]=(∂_(x,y)) f[x,y]

the Hessian of f

MatrixForm[{{fxx[x,y],fxy[x,y]},{fxy[x,y],fyy[x,y]}}]

CPRules=Solve[{fx[x,y]==0,fy[x,y]==0},{x,y}]

N[CPRules]

Some of the values:

Clear[tics]
tics=Table[k Pi,{k,-2,2,1}]

N[tics]

Let’s examine all of the critical points  contained between these values:

xlo=-6; xhi = 6; ylo=-6;yhi=6;

CPs = {};
For[k=-1,k≤1,k++,
For[n=-1,n≤1,n++,
AppendTo[CPs,{n Pi,k Pi}]]]
CPs

This is the number of critical points that we’ll investigate individually, which are places in the domain where we might have extrema:

numPts=Length[CPs]

We should double-check that these points are in the domain of f.  Critical points also include any points where f is defined but the gradient is not.  For this function, there are no other points, and all these points are in the domain of f.  Alternatively, we can calculate the function values:

Table[f[CPs[[i,1]],CPs[[i,2]] ],{i,1,numPts}]

Test CPs

This is the "discriminant of f" or the determinant of the Hessian of f.

disc[x_,y_] = Det[{{fxx[x,y],fxy[x,y]},{fxy[x,y],fyy[x,y]}}]

An automated effort

For[n=1,n≤Length[CPs], 
type="has no info from this method";
CPs[[n]];
d1=disc[CPs[[n,1]],CPs[[n,2]] ];
d2=fxx[CPs[[n,1]],CPs[[n,2]] ];
If[And[d1>0,d2<0],type=" is a local max" ];
If[And[d1>0,d2>0],type=" is a local min" ];
If[d1<0,type=" is a saddle point"];
Print["Critical point", CPs[[n]], type];
n=n+1]

Some graphs

numCon=15;
p1=Plot3D[f[x,y],{x,xlo,xhi},{y,ylo,yhi},AxesLabel->{"x","y","z"}]
p2=ContourPlot[f[x,y],{x,xlo,xhi},{y,ylo,yhi},Contours->numCon]

Show the critical points on the surface and within the contour plot.

t1=Table[{CPs[[n,1]],CPs[[n,2]] ,f[CPs[[n,1]],CPs[[n,2]] ]},{n,1,numPts}]

p3=ListPointPlot3D[t1,PlotStyle->PointSize[0.03]]
Show[p1,p3]

t2=Table[{CPs[[n,1]],CPs[[n,2]]},{n,1,numPts}]
p4=ListPlot[t2,PlotStyle->PointSize[0.03]]
Show[p2,p4]

Show[{ContourPlot[f[x,y],{x,xlo,xhi},{y,ylo,yhi},ContourShading->False],
VectorPlot[gradf[x,y],{x,xlo,xhi},{y,ylo,yhi}], p4}]

Graph the gradient vector field using the same lengths so we can see the vectors better; length is meaningless here.

Show[{ContourPlot[f[x,y],{x,xlo,xhi},{y,ylo,yhi},ContourShading->False,Contours->15],
VectorPlot[gradf[x,y],{x,xlo,xhi},{y,ylo,yhi},VectorScale->{Small,Small,None}], p4}]