|
Example how to check homework: change the function and get an analysis about its critical points:
|
(* Mathematica code to classify critical points, O. knill, 2000 *)
f[x_,y_]:=4 x y - x^3 y - x y^3;
a[x_,y_]:=D[f[u,v],u] /. {u->x,v->y}; b[x_,y_]:=D[f[u,v],v] /. {u->x,v->y};
A=Solve[{a[x,y]==0,b[x,y]==0},{x,y}];
CriticalPoints=Table[{A[[i,1,2]],A[[i,2,2]]},{i,Length[A]}];
H[{x_,y_}]:={{D[f[u,v],{u,2}],D[D[f[u,v],v],u]},{D[D[f[u,v],u],v],D[f[u,v],{v,2}]}} /. {u->x,v->y};
F[A_]:=A[[1,1]]; Discriminant=Map[Det,Map[H,CriticalPoints]]
FirstEntry=Map[F,Map[H,CriticalPoints]]
Decide[B_]:=If[Det[B]<0,"saddle",If[B[[1,1]]<0,"max","min"]];
Analysis=Map[Decide, Map[H,CriticalPoints]];
Table[{CriticalPoints[[i]],Analysis[[i]]},{i,Length[CriticalPoints]}]
Here is a slicker code, doing the same and even presenting it as a nice
table (credit: Matt Leingang, 2006)
ClassifyCriticalPoints[f_,{x_,y_}] := Module[{X,P,H,g,d,S},
X={x,y}; P=Solve[Thread[D[f,#] & /@ X==0],X];H=Outer[D[f,#1,#2]&,X,X];g=H[[1,1]];d=Det[H];
S[d_,g_]:=If[d<0,"saddle",If[g>0,"minimum","maximum"]];
TableForm[{x,y,d,g,S[d,g],f} /. Sort[P],TableHeadings->{None,{x,y,"D","f_xx","Type","f"}}]]
ClassifyCriticalPoints[4 x y - x^3 y - x y^3,{x,y}]
Here is an example on how to solve a Lagrange problem for functions of 2 variables:
F[x_,y_]:=2x^2+4 x y
G[x_,y_]:=x^2 y
Solve[{D[F[x,y],x]== L*D[G[x,y],x],D[F[x,y],y]==L*D[G[x,y],y],G[x,y]==1},{x,y,L}]
and here an example with functions of 3 variables:
F[x_,y_,z_]:=x^2+y^2+z^2;
G[x_,y_,z_]:=x-y^2+z;
Solve[{D[F[x,y,z],x]== L*D[G[x,y,z],x],
D[F[x,y,z],y]== L*D[G[x,y,z],y],
D[F[x,y,z],z]== L*D[G[x,y,z],z],
G[x,y,z]==1},{x,y,z,L}]
or with two constraints:
F[x_, y_, z_] := x^2 + y^2 + z^2;
G[x_, y_, z_] := x - y^2 + z;
H[x_, y_, z_] := x + y - 2;
Solve[{
D[F[x, y, z], x] == L*D[G[x, y, z], x] + M*D[H[x, y, z], x],
D[F[x, y, z], y] == L*D[G[x, y, z], y] + M*D[H[x, y, z], y],
D[F[x, y, z], z] == L*D[G[x, y, z], z] + M*D[H[x, y, z], z],
G[x, y, z] == 1, H[x, y, z] == 1}, {x, y, z, L, M}]
Here is an example how to check that a function solves a PDE:
f[t_,x_]:=(x/t)*Sqrt[1/t]*Exp[-x^2/(4 t)]/(1+ Sqrt[1/t] Exp[-x^2/(4 t)]);
D[f[t,x],t]+f[t,x]*D[f[t,x],x]-D[f[t,x],{x,2}]
Simplify[%] Chop[%]
|
