Optimizing Subject to a Constraint

Code

graphics[showXY_,showInXY_,showOnSurface_,showPoints_]:=(
points=If[showPoints,{Green,PointSize[0.03],Point[{{x,y,f[x,y]}/.NSolve[Grad[f[x,y],{x,y}]==lambda*Grad[constraint[x,y],{x,y}]&&constraint[x,y]==0,{x,y,lambda},Reals]}]},{}];
xyConstraint=If[showInXY,ContourPlot3D[constraint[x,y]==0,{x,-3,3},{y,-3,3},{z,-1,1},MeshFunctions->{#3&},Mesh->{{0}},MeshStyle->{{Gray,Thickness[0.008]}},ContourStyle->Opacity[0],BoundaryStyle->None],{}];
meshFunctions=If[showOnSurface,{#1&,#2&,constraint[#1,#2]&},{#1&,#2&}];
mesh={10,10,{0}};
meshStyle={Automatic,Automatic,{Red,Thickness[0.008]}};
If[showOnSurface,Append[meshFunctions,constraint],];
xyPlane=If[showXY,Plot3D[0,{x,-3,3},{y,-3,3},Mesh->None],{}];
Show[Graphics3D[{points}],xyPlane,xyConstraint,Plot3D[f[x,y],{x,-3,3},{y,-3,3},MeshFunctions->meshFunctions,Mesh->mesh,MeshStyle->meshStyle],Axes->Automatic,AxesLabel->{x,y,z},BoxRatios->{1,1,1},PlotRange->{{-3,3} ,{-3,3},{-20,60}},ViewPoint->{20,4,8}]);

Graphics

f[x_,y_]:=2x^2+3y-x y^2;
constraint[x_,y_]:=x^2+1y^2-9;
showXYPlane=True;
showConstraintInXYPlane=True;
showConstraintOnSurface=True;
showLagrangePoints=True;
graphics[showXYPlane,showConstraintInXYPlane,showConstraintOnSurface,showLagrangePoints]

Constrained Extrema and Level Curves

Code

graphics[t_]:=(
currentZ=(1-t)*min+t*max;
points=Graphics[{Green,PointSize[0.02],Point[Take[#,2]&/@Select[extrema,#[[3]]<currentZ&]]}];
Show[contourPlot,constraintPlot,points,ContourPlot[f[x,y]==currentZ,{x,-4,4},{y,-4,4},ContourStyle->{Green,Thickness[0.008]}],Graphics[points],Axes->Automatic,AxesLabel->{x,y},PlotRange->{{-4,4} ,{-4,4}}])

generateAnimation[duration_,framerate_]:=(
extrema={x,y,f[x,y]}/.NSolve[Grad[f[x,y],{x,y}]==lambda*Grad[constraint[x,y],{x,y}]&&constraint[x,y]==0,{x,y,lambda},Reals];
min=NMinimize[{f[x,y],-3.5<x<3.5,-3.5<y<3.5},{x,y}][[1]];
max=NMaximize[{f[x,y],-3.5<x<3.5,-3.5<y<3.5},{x,y}][[1]];
contourPlot=ContourPlot[f[x,y],{x,-4,4},{y,-4,4},Contours->20];
constraintPlot=ContourPlot[constraint[x,y]==0,{x,-4,4},{y,-4,4},ContourStyle->{Red,Thickness[0.008]}];
frames=Table[Image[graphics[t]],{t,0,1,1/(duration*framerate)}];
frames
)

Graphics

It may take several seconds to run this command, as all frames of the animation are precomputed so that it can run smoothly.

f[x_,y_]:=2x^2+3y-x y^2;
constraint[x_,y_]:=x^2+y^2-9;

duration=3;
framerate=16;
frames=generateAnimation[duration,framerate];
ListAnimate[frames,DefaultDuration->duration]

Constrained Extrema and Gradient Vector Fields

Code

graphics[showConstraint_,showPoints_]:=(
grad=Grad[f[x,y],{x,y}];
extrema={x,y,f[x,y]}/.NSolve[Grad[f[x,y],{x,y}]==lambda*Grad[constraint[x,y],{x,y}]&&constraint[x,y]==0,{x,y,lambda},Reals];

constraintPlot=If[showConstraint,ContourPlot[constraint[x,y]==0,{x,-4,4},{y,-4,4},ContourStyle->{Red,Thickness[0.008]}],{}];
points=If[showPoints,Graphics[{Green,PointSize[0.02],Point[Take[#,2]&/@extrema]}],{}];
field=VectorPlot[grad,{x,-4,4},{y,-4,4}];
Show[field,constraintPlot,points,Axes->Automatic,AxesLabel->{x,y},PlotRange->{{-4,4} ,{-4,4}}])

Graphics

f[x_,y_]:=2x^2+3y-x y^2;
constraint[x_,y_]:=x^2+y^2-9;
showConstraint=True;
showLagrangePoints=True;
graphics[showConstraint,showLagrangePoints]