Optimization of the Rosenbrock Banana Function

Manipulate[
 DynamicModule[{plt2,plt3,plt4,tbl1,tbl2,tbl3},
Dynamic[
If[option== "fixed step steepest descent",
{uk={p[[1]],p[[2]]};itermax=500;u={u1,u2};alpha=.02;GradientFixe[fn_,var_List,var0_List,itermax_Integer,ak_]:=Module[{dfn=Grad[fn,var],u=var,uk=var0,pts},
pts=Table[uk=uk-ak dfn/.Thread[u->uk],{itermax}];PrependTo[pts,var0]];tbl1=GradientFixe[j[u1,u2],u,uk,itermax,alpha];plt2=ListPlot[{tbl1,tbl1},Joined->{True,False},PlotStyle->{RGBColor[0,0,1],RGBColor[0,1,1]}]}];
If[option== "optimal step steepest descent",{uk={p[[1]],p[[2]]};itermax=500;u={u1,u2};
RL[fon_,var_]:=FindMinimum[fon,{var,0.}][[2,1,2]];GradientOpt[fn_,var_List,var0_List,itermax_Integer]:=Module[{dfn=Grad[fn,var],v,vark=var0,alpha,h,pts,sk},sk:=Thread[var->vark];
pts=Table[v=vark-alpha dfn/.sk;
h=fn/.Thread[var->v];
vark=v/.alpha->RL[h,alpha],{itermax}];PrependTo[pts,var0]];tbl2=Quiet[GradientOpt[j[u1,u2],u,uk,itermax]];plt3=ListPlot[{tbl2,tbl2},Joined->{True,False},PlotStyle->{RGBColor[0,0,1],RGBColor[0,1,1]}]}];
If[option== "conjugate gradient method",{uk={p[[1]],p[[2]]};itermax=500;u={u1,u2};GradientConj[fn_,var_List,var0_List,itermax_Integer]:=Module[{dfn=Grad[fn,var],d2fn=Hess[fn,var],dir,vark=var0,ak,betak,oldfn,pts,sk},sk:=Thread[var->vark];
dir=dfn/.sk;
pts=Table[oldfn=N[dfn/.sk];
ak=N[(dir.oldfn)/(dir.d2fn.dir)/.sk];
vark=N[vark-ak dir];
betak=-N[(dfn.dfn)/(oldfn.oldfn)/.sk];
dir=N[(dfn/.sk)-betak dir];
vark,{itermax}];PrependTo[pts,var0]];
tbl3=Quiet[GradientConj[j[u1,u2],u,uk,itermax]];plt4=ListPlot[{tbl3,tbl3},Joined->{True,False},PlotStyle->{RGBColor[0,0,1],RGBColor[0,1,1]}]}];
   LocatorPane[
Dynamic[p,(p={#[[1]],#[[2]]})&],
Dynamic[Which[
option== "fixed step steepest descent",
Show[plt1,plt2,Graphics[{Red,PointSize[0.025],Point[{1,1}]}],ImageSize->{575, 400},ImagePadding->25,PlotRangeClipping->False],
option== "optimal step steepest descent",
Show[plt1,plt3,Graphics[{Red,PointSize[0.025],Point[{1,1}]}],ImageSize->{575, 400},ImagePadding->25,PlotRangeClipping->False],
option== "conjugate gradient method",
Show[plt1,plt4,Graphics[{Red,PointSize[0.025],Point[{1,1}]}],ImageSize->{575, 400},ImagePadding->25,PlotRangeClipping->False]]],
{{-1.0,-0.5},{1.0,1.5}}],
TrackedSymbols:>{option,p}]],
{{p,{-0.5,0.5}},{-1.0,-0.5},{1.0,1.5},None},
{{option,"fixed step steepest descent","optimization method"},{"fixed step steepest descent","optimal step steepest descent","conjugate gradient method"}},ControlPlacement-> Top,TrackedSymbols:>{option,p},SynchronousUpdating-> False,Initialization :> {j[u1_,u2_]:=(u1-1)^2+10 (u1^2-u2)^2;plt1=ContourPlot[j[u1,u2],{u1,-1,1.5},{u2,-0.5,1.5},Contours->Join[Table[i,{i,0,0.5,0.1}], Table[i,{i,0,20,1}]],ColorFunction-> (Blend[{Yellow,Green},2#]&),ContourLabels-> Automatic];Grad[fon_,var_List]:=D[fon,#] & /@ var;Hess[fon_,var_List]:=Grad[D[fon,#] &/@var,var];}]

THIS NOTEBOOK IS THE SOURCE CODE FROM

"Optimization of the Rosenbrock Banana Function" from The Wolfram Demonstrations Project
 http://demonstrations.wolfram.com/OptimizationOfTheRosenbrockBananaFunction/

Contributed by: Housam Binous

After work by: Jean-Christophe Culioli

A full-function Wolfram Mathematica system (Version 6 or higher) is required to edit this notebook.
GET WOLFRAM MATHEMATICA »

© The Wolfram Demonstrations Project & Contributors   |   Terms of Use   |   Make a new version of this Demonstration »