Newton's method for systems of procedures

acer's picture

There have been a few posts on mapleprimes about numerically solving systems of procedures. The latest one, up until now, was this.

Here's some code to implement the method. Since the algorithm is basically very simple, I've added a few bells and whistles as optional arguments.

The essence of it is as follows. The number of procedures must match the number of parameters of each and every procedure. It does maxtries attempts at choosing a random point, and then does at most maxiter iterations. A solution is only accepted if the norm of the last change in vector (point) x is less than xtol, and if the forward error norm(F(x)) is less than ftol. The jacobian of F may be supplied optionally as a Matrix of procedures, or a method for computing the jacobian may be supplied. The methods are fdiff which only uses Maple's numerical differentiation routine fdiff, or hybrid which attempts symbolic differentiation via Maple's D[] operator and then falls back to fdiff via the nifty evalf@D equivalence.

I have not profiled it, though I have attempted to set up the jacobian construction so that it re-uses the same rtable for each instantiation. I have not gone really low-level with the external-calling to numeric solvers. I have not tried to leverage fast hardware double-precision solutions as jumping-off points for extended precision polishing (eg. see here).

I've added some examples, after the code below. Feel free to comment or mention bugs. I'd really like a better name for it.

NRprocs:=proc(
  funlist::{list(procedure),Vector(procedure)}
, {allowcomplex::truefalse:=false}
, {initialpoint::Vector:=NoUserValue}
, {maxtries::posint:=NoUserValue}
, {maxiter::posint:=30}
, {xtol::realcons:=5.0*10^(-Digits)}
, {ftol::realcons:=1.0*10^(-trunc(2*Digits/3))}
, {method::{identical(`hybrid`,`fdiff`)}:=`hybrid`}
, {jacobian::Matrix({operator,procedure}):=NoUserValue}
, $
)
local a, b, currXseq, dummy, dummyseq, F, i, ii, J, j, jj,
      MaxTries, numvars, oldX, thisJ, thistry, varnumset, X;
 
  varnumset := {seq(`if`(not(member('call_external',{op(3,eval(F))})),nops([op(1
,eval(F))]),NULL), F in funlist)};
  if nops(varnumset) > 1 then
    error "expecting procedure all taking same number of arguments";
  elif nops(varnumset) = 1 then
    numvars := varnumset[1];
  else
    numvars := nops(funlist);
  end if;
 
  if numvars <> nops(funlist) then
    error "number of procedures %1 does not match number of their parameters %2"
, nops(funlist), numvars;
  end if;
 
  if initialpoint <> 'NoUserValue' then
    oldX := Vector(numvars,(i)->evalf(initialpoint[i]),'storage'='rectangular',
                   'datatype'=`if`(allowcomplex,'complex'('float'),'float'));
    if maxtries = 'NoUserValue' then
      MaxTries := 1;
    elif maxtries > 1 then
      error "maxtries must be 1 when initialpoint is supplied";
    else
      MaxTries := maxtries;
    end if;
  else
    if maxtries = 'NoUserValue' then
      MaxTries := 20;
    else
      MaxTries := maxtries;
    end if;
  end if;
 
  if jacobian = 'NoUserValue' then
    # This is only built once, so there should be a way to make
    # it take a little more time and make a J that evaluates quicker.
    # Using evalhf is just one possibility.
    dummyseq:=seq(dummy[i],i=1..numvars);
    if method='hybrid' then
      J:=Matrix(nops(funlist),numvars,
              (i,j)->unapply('evalf'(D[j](funlist[i])(dummyseq)),[dummyseq]));
    else # method=fdiff
      J:=Matrix(nops(funlist),numvars,
              (i,j)->unapply(fdiff(funlist[i],[j],[dummyseq]),[dummyseq]));
    end if;
  else
    J:=jacobian;
  end if;
  thisJ := Matrix(nops(funlist),numvars,
                  'datatype'=`if`(allowcomplex,'complex'('float'),'float'));
                                                                                
  X := Vector(numvars,'datatype'=`if`(allowcomplex,'complex'('float'),'float'));
 
  userinfo(1,'NRprocs',`maximal number of tries is `, MaxTries);
  for thistry from 1 to MaxTries do
 
    if thistry > 1 or initialpoint = 'NoUserValue' then
      if allowcomplex = true then
        oldX := LinearAlgebra:-RandomVector(numvars,
                              'density'=1,'generator'=-1.0-1.0*I..1.0+1.0*I,
                              'outputoptions'=['datatype'='complex'('float')]);
      else
        oldX := LinearAlgebra:-RandomVector(numvars,
                              'density'=1,'generator'=-1.0..1.0,
                              'outputoptions'=['datatype'='float']);
      end if;
    end if;
 
    userinfo(1,'NRprocs',`initial point : `, convert(oldX,list));
    userinfo(1,'NRprocs',`maximal number of iterations is `, maxiter);
    try
      for ii from 1 to maxiter do
        currXseq:=seq(oldX[jj],jj=1..numvars);
        for i from 1 to nops(funlist) do
          for j from 1 to numvars do
            thisJ[i,j] := J[i,j](currXseq);
          end do;
        end do;
        # copy oldX into X, so that increment can be added to X inplace.
        ArrayTools:-Copy(numvars,oldX,0,1,X,0,1);
        LinearAlgebra:-LA_Main:-VectorAdd(
               X, LinearAlgebra:-LA_Main:-LinearSolve(
                   thisJ,
                   Vector(nops(funlist),
                     (i)->evalf(funlist[i](currXseq))),
                   'method'='none','free'='NoUserValue','conjugate'=true,
                   'inplace'=false,'outputoptions'=[],'methodoptions'=[]),
               1,-1,'inplace'=true,'outputoptions'=[]);
        userinfo(2,'NRprocs',`at iteration`,ii, convert(X,list));
        if LinearAlgebra:-LA_Main:-Norm(
             # oldX is no longer needed, so can overwrite it inplace.
             LinearAlgebra:-LA_Main:-VectorAdd(
               oldX,X,-1,1,'inplace'=true,'outputoptions'=[]),
             infinity,'conjugate'=true) < xtol
         and max(seq(abs(F(seq(X[jj],jj=1..numvars))),F in funlist)) < ftol then
          return X;
        end if;
        ArrayTools:-Copy(numvars,X,0,1,oldX,0,1);
      end do:
    catch "singular matrix","inconsistent system","unable to store":
      ii := ii - 1;
      next;
    end try;
  end do;
  return 'procname'(args);
end proc:


Here are a few examples, which I have not set up as verified checks or tests.



kernelopts(printbytes=false):
kernelopts(gcfreq=10^8);
 
f:=proc(x,y) x^3-sin(y); end proc:
g:=proc(x,y)
local sol;
  sol:=fsolve(q^5+x*q^2+y*q=0,q,complex):
  Re(sol[1]+1);
end proc:
                                                                                
fl:=[f,g]:
NRprocs(fl);
if type(%,Vector) then
  max(seq(abs(fl[i](seq(%[j],j=1..nops(fl)))),i=1..nops(fl)));
end if;
 
Digits:=32:
NRprocs(fl);
if type(%,Vector) then
  max(seq(abs(fl[i](seq(%[j],j=1..nops(fl)))),i=1..nops(fl)));
end if;
Digits:=10:
 
infolevel[NRprocs]:=1;
sol := NRprocs([f,g],initialpoint=<5.0, 6.0>);
if type(%,Vector) then
  max(seq(abs(fl[i](seq(%[j],j=1..nops(fl)))),i=1..nops(fl)));
end if;
infolevel[NRprocs]:=0;
 
infolevel[NRprocs]:=2;
sol := NRprocs(fl,initialpoint=<-1, -2>);
if type(%,Vector) then
  max(seq(abs(fl[i](seq(%[j],j=1..nops(fl)))),i=1..nops(fl)));
end if;
infolevel[NRprocs]:=0;
 
sol := NRprocs(fl);
if type(%,Vector) then
  max(seq(abs(fl[i](seq(%[j],j=1..nops(fl)))),i=1..nops(fl)));
end if;
 
sol := NRprocs(fl,ftol=1e-8);
if type(%,Vector) then
  max(seq(abs(fl[i](seq(%[j],j=1..nops(fl)))),i=1..nops(fl)));
end if;
 
sol := NRprocs(fl,initialpoint=<-I,I>,allowcomplex=true);
if type(%,Vector) then
  max(seq(abs(fl[i](seq(%[j],j=1..nops(fl)))),i=1..nops(fl)));
end if;
 
sol := NRprocs(fl,allowcomplex=true);
if type(%,Vector) then
  max(seq(abs(fl[i](seq(%[j],j=1..nops(fl)))),i=1..nops(fl)));
end if;
 
NRprocs([f,g,(a,b)->a+b]);
NRprocs([(a,b,c)->a*b*c]);
 
fl:=[x->cos(x)-x]:
NRprocs(fl);
if type(%,Vector) then
  max(seq(abs(fl[i](seq(%[j],j=1..nops(fl)))),i=1..nops(fl)));
end if;
 
fl:=[(x,y,z)->x*z+2*y^2-sqrt(z),(x,y,z)->z+x*y,(x,y,z)->x^3+y*z]:
NRprocs(fl);
if type(%,Vector) then
  max(seq(abs(fl[i](seq(%[j],j=1..nops(fl)))),i=1..nops(fl)));
end if;
 
jfl:=Matrix(3,3,(i,j)->D[j](fl[i])):
NRprocs(fl,jacobian=jfl);
if type(%,Vector) then
  max(seq(abs(fl[i](seq(%[j],j=1..nops(fl)))),i=1..nops(fl)));
end if;
 
fl:=[(x,y,z)->x*z+2.1*y^2-sqrt(z),(x,y,z)->z+1.1*x*y,(x,y,z)->x^3+1.1*y*z]:
gc():
st,ba,bu:=time(),kernelopts(bytesalloc),kernelopts(bytesused):
for i from 1 to 5 do
  X0:=LinearAlgebra:-RandomVector(3,generator=-1.0..1.0,outputoptions=[datatype=
float]);
  NRprocs(fl,initialpoint=X0);
end do:
time()-st,kernelopts(bytesalloc)-ba,kernelopts(bytesused)-bu;
 
fl:=[(x,y,z)->x*z+2.2*y^2-sqrt(z),(x,y,z)->z+1.2*x*y,(x,y,z)->x^3+1.2*y*z]:
gc():
st,ba,bu:=time(),kernelopts(bytesalloc),kernelopts(bytesused):
jfl:=Matrix(3,3,(i,j)->D[j](fl[i])):
for i from 1 to 5 do
  X0:=LinearAlgebra:-RandomVector(3,generator=-1.0..1.0,outputoptions=[datatype=
float]);
  NRprocs(fl,jacobian=jfl,initialpoint=X0);
end do:
time()-st,kernelopts(bytesalloc)-ba,kernelopts(bytesused)-bu;
 
fl:=[proc(x::float,y::float,z::float) x*z+1.9*y^2-z^2; end proc,
     proc(x::float,y::float,z::float) z+0.9*x*y; end proc,
     proc(x::float,y::float,z::float) x^3+0.9*y*z; end proc]:
gc():
st,ba,bu:=time(),kernelopts(bytesalloc),kernelopts(bytesused):
jfl:=Matrix(3,3,(i,j)->D[j](fl[i])):
time()-st,kernelopts(bytesalloc)-ba,kernelopts(bytesused)-bu;
sol:=NRprocs(fl,jacobian=jfl,maxtries=50);
time()-st,kernelopts(bytesalloc)-ba,kernelopts(bytesused)-bu;
if type(sol,Vector) then
  max(seq(abs(fl[i](seq(sol[j],j=1..nops(fl)))),i=1..nops(fl)));
end if;
 
fl:=[proc(x::float,y::float,z::float) x*z+1.8*y^2-z^2; end proc,
     proc(x::float,y::float,z::float) z+0.8*x*y; end proc,
     proc(x::float,y::float,z::float) x^3+0.8*y*z; end proc]:
gc():
st,ba,bu:=time(),kernelopts(bytesalloc),kernelopts(bytesused):
jfl:=Matrix(3,3,(i,j)->D[j](fl[i])):
cfl:=[seq(Compiler:-Compile(fl[i]),i=1..nops(fl))]:
cjfl:=map(t->`if`(type(t,procedure),Compiler:-Compile(t),t),jfl):
time()-st,kernelopts(bytesalloc)-ba,kernelopts(bytesused)-bu;
sol:=NRprocs(cfl,jacobian=cjfl);
time()-st,kernelopts(bytesalloc)-ba,kernelopts(bytesused)-bu;
if type(sol,Vector) then
  max(seq(abs(fl[i](seq(sol[j],j=1..nops(fl)))),i=1..nops(fl)));
end if;
 
NRprocs([f,g],method=hybrid);
NRprocs([f,g],method=fdiff);

acer

Comments

acer's picture

initial point generation

I realized that an obvious improvement would be to generate each try's initial point inside a complex hyperbox specified by the user.

As originally written, each initial point is taken from the hyperbox [-1.0-1.0*I..1.0+1.0*I]'^n or [-1.0..1.0]^n. That's going to be weak in general, as the set of points in the box might be distinct from the set which converge to some roots.

In a related way, it would be an improvement to allow the user to supply the bound of those boxes, in order to also be able to search only for roots lying inside it.

So an additonal optional parameter, a list of Maple ranges, could specify the box used for both those purposes. For each dimension, the ends of the range could specify the lower-left and upper-right (possibly complex) corners.

Picking a finite box well, when not specified in the arguments, will be tricky.

acer

Comment viewing options

Select your preferred way to display the comments and click "Save settings" to activate your changes.
}