Home
Manual
Packages
Global Index
Keywords
Quick Reference
|
/*
ROOTS.I
Collection of root, maximum, and minimum finders.
$Id$
*/
/* Copyright (c) 1996. The Regents of the University of California.
All rights reserved. */
local roots ;
/* DOCUMENT roots.i
defines:
nraphson - Newton-Raphson/bisection root solver (scalar)
f_inverse - function inverse by Newton-Raphson (vectorized)
mnbrent - Brent's method minimizer (scalar)
mxbrent - Brent's method maximizer (scalar)
*/
/* ------------------------------------------------------------------------ */
func nraphson (f_and_dfdx, x0, x1, xerr)
/* DOCUMENT nraphson(f_and_dfdx, x0, x1)
or nraphson(f_and_dfdx, x0, x1, xerr)
Find a root of a function by Newton-Raphson iteration, backed
up by bisection if the convergence seems poor. The subroutine
F_AND_DFDX must be defined as:
func F_AND_DFDX (x, &f, &dfdx)
returning both the function value f(x) and derivative dfdx(x).
If F_AND_DFDX always returns dfdx==0, nraphson uses bisection.
The value of x is constrained to lie within the interval from
X0 to X1; the function values at these two points must have
opposite sign. The iteration stops when the root is known to
within XERR, or to machine precision if XERR is nil or zero.
f_inverse is a "vectorized" version of nraphson.
Based on rtsafe from Press, et. al. Numerical Recipes, Ch 9.
SEE ALSO: mnbrent, mxbrent, f_inverse
*/
{
if (is_void(xerr) || xerr<0.0) xerr= 0.0;
x0= double(x0);
x1= double(x1);
local f, dfdx;
/* get function value at endpoints -- derivatives unused */
f_and_dfdx, x0, f, dfdx;
if (f == 0.0) return x0;
dxo= f;
f_and_dfdx, x1, f, dfdx;
if (f == 0.0) return x1;
if (f*dxo > 0.0) error, "f(x0) and f(x1) have same sign";
if (f > 0.0) {
xlo= x0;
xhi= x1;
} else {
xlo= x1;
xhi= x0;
}
/* first guess is midpoint */
x= 0.5*(xhi+xlo);
dx= dxo= abs(xhi-xlo);
f_and_dfdx, x, f, dfdx;
if (f < 0.0) xlo= x;
else if (f > 0.0) xhi= x;
else return x;
for (i=1 ; i<=nr_maxits ; ++i) {
xo= x;
if (((x-x1)*dfdx-f)*((x-x0)*dfdx-f) >= 0.0 ||
abs(2.*f) > abs(dxo*dfdx)) {
/* take bisection step if N-R step would be out of bounds
or if previous step did not converge fast enough */
dxo= dx;
dx= 0.5*(xhi-xlo);
x= xlo+dx;
} else {
/* take N-R step */
dxo= dx;
dx= f/double(dfdx);
x-= dx;
}
/* quit on either machine precision or requested precision */
if (x==xo || abs(dx)<xerr) return x;
f_and_dfdx, x, f, dfdx;
if (f < 0.0) xlo= x;
else xhi= x;
}
error, "nr_maxits iteration count exceeded";
}
nr_maxits= 100;
func f_inverse (f_and_dfdx, y, x0, x1, xerr)
/* DOCUMENT f_inverse(f_and_dfdx, y, x0, x1, xerr)
or f_inverse(f_and_dfdx, y, x0, x1, xerr)
Find values of an inverse function by Newton-Raphson iteration,
backed up by bisection if the convergence seems poor. The
subroutine F_AND_DFDX must be defined as:
func F_AND_DFDX (x, &f, &dfdx)
returning both the function value f(x) and derivative dfdx(x).
If the input x is an array, the returned f and dfdx must have
the same shape as the input x. If F_AND_DFDX always returns
zero dfdx, f_inverse will use bisection.
The result x will have the same shape as the input Y values.
The values of x are constrained to lie within the interval from
X0 to X1; the function value must be on opposite sides of the
required Y at these interval endpoints. The iteration stops
when the root is known to within XERR, or to machine precision
if XERR is nil or zero. X0, X1, and XERR may be arrays conformable
with Y.
f_inverse takes the same number of iterations for every Y value;
it does not notice that some may have converged before others.
SEE ALSO: nraphson
*/
{
if (is_void(xerr) || xerr<0.0) xerr= 0.0;
x0+= 0.0*y;
x1+= 0.0*y;
local f, dfdx;
/* get function value at endpoints -- derivatives unused */
f_and_dfdx, x0, f, dfdx;
f-= y;
dxo= f;
f_and_dfdx, x1, f, dfdx;
f-= y;
if (anyof(f*dxo > 0.0)) error, "f(x0)-y and f(x1)-y have same sign";
dfdx= x0;
mask= double(f > dxo);
maskc= 1.0-mask;
xlo= x0*mask + x1*maskc;
xhi= x1*mask + x0*maskc;
/* first guess is midpoint */
x= 0.5*(xhi+xlo);
dx= dxo= abs(xhi-xlo);
f_and_dfdx, x, f, dfdx;
f-= y;
mask= (f < 0.0);
list= where(mask);
if (numberof(list)) xlo(list)= x(list);
list= where(!mask);
if (numberof(list)) xhi(list)= x(list);
for (i=1 ; i<=nr_maxits ; ++i) {
xo= x;
mask= ((((x-x1)*dfdx-f)*((x-x0)*dfdx-f) >= 0.0) |
(abs(2.*f) > abs(dxo*dfdx)));
list= where(mask);
if (numberof(list)) {
/* take bisection step where N-R step would be out of bounds
or if previous step did not converge fast enough */
dxob= dx(list);
xob= xlo(list);
dxb= 0.5*(xhi(list)-xob);
xb= xob+dxb;
} else {
xb= dxb= dxob= [];
}
list= where(!mask);
if (numberof(list)) {
/* otherwise take N-R step */
dxon= dx(list);
dxn= f(list)/dfdx(list);
xon= x(list);
xn= xon-dxn;
} else {
xn= dxn= dxon= [];
}
x= merge(xb, xn, mask);
dx= merge(dxb, dxn, mask);
dxo= merge(dxob, dxon, mask);
/* check for uniform convergence either to requested precision
or to machine precision */
if (allof((x==xo) | (dx<xerr))) return x;
f_and_dfdx, x, f, dfdx;
f-= y;
mask= (f < 0.0);
list= where(mask);
if (numberof(list)) xlo(list)= x(list);
list= where(!mask);
if (numberof(list)) xhi(list)= x(list);
}
error, "nr_maxits iteration count exceeded";
}
/* ------------------------------------------------------------------------ */
func mxbrent (f, x0, x1, x2, &xmax, xerr)
/* DOCUMENT fmax= mxbrent(f, x0, x1, x2)
or fmax= mxbrent(f, x0, x1, x2, xmax)
or fmax= mxbrent(f, x0, x1, x2, xmax, xerr)
returns the maximum of the function F (of a single argument x),
given three points X0, X1, and X2 such that F(X1) is greater than
either F(X0) or F(X2), and X1 is between X0 and X2. If the
XMAX argument is provided, it is set to the x value which
produced FMAX. If XERR is supplied, the search stops when
a fractional error of XERR in x is reached; note that XERR
smaller than the square root of the machine precision (or
omitted) will cause convergence to machine precision in FMAX.
The algorithm is Brent's method - a combination of inverse
parabolic interpolation and golden section search - as adapted
from Numerical Recipes Ch. 10 (Press, et. al.).
SEE ALSO: mxbrent, nraphson, f_inverse
*/
{
from_mxbrent= 1;
return mnbrent(f, x0, x1, x2, xmax, xerr);
}
func mnbrent (f, x0, x1, x2, &xmin, xerr)
/* DOCUMENT fmin= mnbrent(f, x0, x1, x2)
or fmin= mnbrent(f, x0, x1, x2, xmin)
or fmin= mnbrent(f, x0, x1, x2, xmin, xerr)
returns the minimum of the function F (of a single argument x),
given three points X0, X1, and X2 such that F(X1) is less than
either F(X0) or F(X2), and X1 is between X0 and X2. If the
XMIN argument is provided, it is set to the x value which
produced FMIN. If XERR is supplied, the search stops when
a fractional error of XERR in x is reached; note that XERR
smaller than the square root of the machine precision (or
omitted) will cause convergence to machine precision in FMIN.
The algorithm is Brent's method - a combination of inverse
parabolic interpolation and golden section search - as adapted
from Numerical Recipes Ch. 10 (Press, et. al.).
SEE ALSO: mxbrent, nraphson, f_inverse
*/
{
if (is_void(xerr) || xerr<2.e-8) xerr= 2.e-8;
while (1.+xerr*xerr == 1.) xerr*= 2.0;
golden= (sqrt(5.)-1.)/(sqrt(5.)+1.);
epsilon= 1.e-20;
x0= double(x0);
x1= double(x1);
x2= double(x2);
xlo= min(x0, x2);
xhi= max(x0, x2);
x= w= v= x1;
e= 0.0;
fx= fw= fv= (from_mxbrent? -f(x) : f(x));
for (i=1 ; i<=br_maxits ; ++i) {
xm= 0.5*(xlo+xhi);
abserr= xerr*abs(x) + epsilon;
abserr2= 2.*abserr;
if (abs(x-xm) <= (abserr2-0.5*(xhi-xlo))) {
xmin= x;
return (from_mxbrent? -fx : fx);
}
if (abs(e) > abserr) {
/* attempt a trial parabolic fit to (w,v,x) -- the three
smallest points seen so far */
r= (x-w)*(fx-fv);
q= (x-v)*(fx-fw);
p= (x-v)*q - (x-w)*r;
q= 2.*(q-r);
if (q > 0.0) p= -p;
q= abs(q);
e1= e;
e= d;
if (abs(p)>=abs(0.5*q*e1) || p<=q*(xlo-x) || p>=q*(xhi-x)) {
/* take golden section step -- parabolic step is crazy */
e= (x>=xm? xlo-x : xhi-x);
d= golden*e;
} else {
/* take inverse parabolic step */
d= p/q;
u= x+d;
if ((u-xlo)<abserr2 || (xhi-u)<abserr2) d= sign(xm-x)*abserr;
}
} else {
/* take golden section step */
e= (x>=xm? xlo-x : xhi-x);
d= golden*e;
}
/* evaluate at next point, avoiding meaninglessly small step size */
u= x + (abs(d)>=abserr? d : sign(d)*abserr);
fu= (from_mxbrent? -f(u) : f(u));
if (fu <= fx) {
/* new point is best so far */
if (u >= x) xlo= x;
else xhi= x;
v= w; fv= fw;
w= x; fw= fx;
x= u; fx= fu;
} else {
if (u < x) xlo= u;
else xhi= u;
if (fu<=fw || w==x) {
/* new point is second best so far */
v= w; fv= fw;
w= u; fw= fu;
} else if (fu<=fw || v==x || v==w) {
/* new point is third best so far */
v= u; fv= fu;
}
}
}
error, "br_maxits iteration count exceeded";
}
br_maxits= 100;
/* ------------------------------------------------------------------------ */
|