SR1 Defn

SR1Update[B_,df_,dx_]:= Module[
{v=df-B.dx},
B+ (1/(v.dx))Outer[Times,v,v]
]

Step Size Testing and Selection

I have two tests.  For Wolfe they are: 
	1)	(Subscript[f, k+1])≤ (Subscript[f, k])+(Subscript[c, 1])α (Subscript[p, k]).∇(Subscript[f, k])
	2)	p.∇(Subscript[f, k+1])≥ c2 (Subscript[p, k]).∇(Subscript[f, k])
If do the first test first. If I fail test (1) I decrease α.  If I pass the first test and fail the second I increase the α.

I want to avoid repeating computations (particularly f and ∇f evaluations) so I am going to assume that I have precomputed and stored the values of (Subscript[f, k]) and ∇(Subscript[f, k]) and I am only going to compute (Subscript[f, k+1])and ∇(Subscript[f, k+1])when I need to.

StepSelection1[{xk_,αk_,fk_,Delfk_},pk_,{f_,Df_}]:= Module[
{Dfk=pk.Delfk,α=αk,
xN,fN,DelfN, 
flag=0,
MSmaller=0.5, MBigger=1.5, c1=(10^(-4)),c2=0.9,
n=0,nMax=40},
Dfk=pk.Delfk;
While[
And[(n++)<nMax,flag==0],
xN=xk+α  pk;
fN=f[xN];
If[
fN>fk+c1 α Dfk,
α = α*MSmaller;  Print["Failed Wolfe1 α=",α],
DelfN=Df[xN];   Print["Passed Wolfe1 α=",α];
If[pk.DelfN<c2 Dfk,
 α = α*MBigger;Print["Failed Wolfe2 α=",α],
flag=1;Print["Passed Wolfe2 α=",α]
]
]
];
{xN,α, fN, DelfN}
]

Testing the code

Clear[f,x,y]
f[{x_,y_}]:=(((x-1))^2)+100(((y-(x^2)))^2);
ContourPlot[f[{x,y}],{x,-2,2},{y,-2,2},
Contours->200]

Clear[f,x,y]
f[{x_,y_}]:=(((x-1))^2)+100(((y-(x^2)))^2);
Df[{x_,y_}]=D[f[{x,y}],{{x,y}}];
DDf[{x_,y_}]=D[Df[{x,y}],{{x,y}}]
M=6;
xk={x0,y0}= RandomReal[{-M,M},{2}];
αk=1.0;
fk=f[xk];
Delfk=Df[xk];
pk = -Delfk;
(* Newton pk=LinearSolve[DDf[xk],-Df[{x0,y0}]]; *)
StepSelection1[{xk,αk,fk,Delfk},pk,{f,Df}]

Newton vs SD vs QNewton Convergence

Using the Rosenbrock function

Clear[f,x,y]
f[{x_,y_}]:=(((x-1))^2)+100(((y-(x^2)))^2);
Df[{x_,y_}]=D[f[{x,y}],{{x,y}}];
DDf[{x_,y_}]=D[Df[{x,y}],{{x,y}}];
M=2;
RosenPic=ContourPlot[ f[{x,y}],{x,-M,M},{y,-2,2}]

nMax=20;
xk={x0,y0}= RandomReal[{-M,M},{2}];
fk=f[xk];
Delfk =Df[xk];

NewtonData=Table[
pk = LinearSolve[ DDf[xk],-Delfk];
If[pk.Delfk≥0, pk=-Delfk];
{xk,αk,fk,Delfk}=StepSelection1[{xk,1,fk,Delfk},pk,{f, Df}];
xk,
{nMax}];

Show[
RosenPic,
 ListPlot[
NewtonData,
PlotRange->All,
PlotStyle->Red
],
Epilog->{Green, PointSize[0.02], Point[{x0,y0}]}
]

nMax=20;
xk={x0,y0}= RandomReal[{-M,M},{2}];
fk=f[xk];
Delfk =Df[xk];
SDData=Table[
pk=-Delfk;
{xk,αk,fk,Delfk}=StepSelection1[{xk,1,fk,Delfk},pk,{f, Df}];
xk,
{nMax}];
Show[
RosenPic,
 ListPlot[
SDData,
PlotRange->All,
PlotStyle->Red
],
Epilog->{Green, PointSize[0.02],Point[{x0,y0}]}
]