bin_root.f
\ ---------------------------------------------------
\ (c) Copyright 2001 Julian V. Noble. \
\ Permission is granted by the author to \
\ use this software for any application pro- \
\ vided this copyright notice is preserved. \
\ ---------------------------------------------------
\ This is an ANS Forth program requiring the
\ FLOAT, FLOAT EXT, FILE and TOOLS EXT wordsets.
\
\ Environmental dependences:
\ Assumes independent floating point stack
\ Uses FORmula TRANslator for clarity
MARKER -binroot
include ftran201.f
\ Data structures
FVARIABLE Ra \ f(xa)
FVARIABLE Rb \ f(xb)
FVARIABLE Rp \ f(xp)
FVARIABLE xa \ lower end of interval
FVARIABLE xb \ upper end of interval
FVARIABLE xp \ next guess
FVARIABLE epsilon \ precision
v: dummy \ vectored function name
: initialize ( xt --) ( f: lower upper precision --)
epsilon F! xb F! xa F! \ store parameters
defines dummy \ xt -> dummy
f" Ra = dummy(xa)" \ compute fn at endpts
f" Rb = dummy(xb)"
f" Ra*Rb" F0>
ABORT" Even # of roots in interval!"
;
: not_converged? ( -- f)
f" ABS( xa - xb )" epsilon F@ F>
;
: )binsrch ( xt --) ( f: low hi precision -- root)
initialize
BEGIN not_converged?
WHILE f" xp = (xa+xb)/2" f" Rp = dummy(xp)"
f" Ra*Rp" F0>
IF f" Ra = Rp" f" xa = xp"
ELSE f" Rb = Rp" f" xb = xp"
THEN
REPEAT
f" (xa+xb)/2"
;