sicmutils · sritchie · Mar 1, 2022 · Feb 28, 2022 · Feb 28, 2022 · Feb 28, 2022
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -2,6 +2,14 @@
 
 ## unreleased
 
+- #490 adds `sicmutils.numerical.roots.bisect` with implementations of bisection
+  search, secant search and a mixed method found in `scmutils`. These all live
+  under a `bisect` function.
+
+  The data structure returned is similar to the minimization functions in the
+  `sicmutils.numeric.{unimin, multimin}` namespaces. As more root-finding
+  methods come online this should all standardize nicely.
+
 - #491 adds `sicmutils.mechanics.rotation/M->Euler`, for converting from a
   rotation matrix to a triple of Euler angles. Now we can successfully round
   trip.

diff --git a/src/sicmutils/numerical/roots/bisect.cljc b/src/sicmutils/numerical/roots/bisect.cljc
@@ -0,0 +1,217 @@
+;;
+;; Copyright © 2022 Sam Ritchie.
+;; This work is based on the Scmutils system of MIT/GNU Scheme:
+;; Copyright © 2002 Massachusetts Institute of Technology
+;;
+;; This is free software;  you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3 of the License, or (at
+;; your option) any later version.
+;;
+;; This software is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this code; if not, see <http://www.gnu.org/licenses/>.
+;;
+
+(ns sicmutils.numerical.roots.bisect
+  "This namespace contains implementations of a number of methods for root-finding
+  on real-valued functions of one argument.
+
+  NOTE: This namespace is not yet stable: Expect these functions to change as
+  new root-finding methods are added. "
+  (:require [sicmutils.util :as u]
+            [sicmutils.util.stream :as us]
+            [sicmutils.value :as v]))
+
+;; ## Root finding by successive bisection
+;;
+;; The [[bisect]] function below is really a combination of three methods of
+;; root-finding; bisection search, the [Secant
+;; method](https://en.wikipedia.org/wiki/Secant_method) and a mixed method found
+;; in scmutils.
+;;
+;; NOTE: As we bring in methods like `zbrent` it could be that the shell below
+;; should be shared for ALL root finding methods.
+
+(def ^{:dynamic true
+       :doc "Controls the default behavior of [[bisect]]'s search.
+  See [[bisect]]'s docstring for more info."}
+  *bisect-break* 60)
+
+(def ^{:doc "Set of all methods allowed as `:method` options to [[bisect]]."}
+  all-methods
+  #{:bisection :secant :mixed})
+
+;; ## Success / Failure Utilities
+
+(defn- succeed
+  "Given some point `x` and its value `fx`, the number of `iterations` of the
+  root-finding algorithm, and the total number of calls `fncalls` of the
+  function `f`, returns a data structure representing successful completion."
+  [x fx iterations fncalls]
+  {:result     x
+   :value      fx
+   :iterations iterations
+   :converged? true
+   :fncalls    fncalls})
+
+(defn- fail
+  "Generates a 'failure'-type message."
+  [message a fa b fb iterations fncalls]
+  {:error message
+   :bounds
+   {:lower a :f-lower fa
+    :upper b :f-upper fb}
+   :iterations iterations
+   :converged? false
+   :fncalls fncalls})
+
+(defn ^:no-doc midpoint
+  "Implements the midpoint lookup given endpoints `a` and `b` of a range. Used in
+  the implementation of the [Bisection
+  method](https://en.wikipedia.org/wiki/Bisection_method#Iteration_tasks)"
+  [a b]
+  (* 0.5 (+ a b)))
+
+(defn ^:no-doc secant-root
+  "Given two endpoints `[a fa]` and `[b fb]`, returns the root of a line drawn
+  between the two endpoints. Used in the implementation of the
+  [Secant
+  method](https://en.wikipedia.org/wiki/Secant_method)
+
+  NOTE that the signs of `fa` and `fb` must be opposite for the result to make
+  sense in the context of the secant method."
+  [a fa b fb]
+  (/ (- (* fb a) (* fa b))
+     (- fb fa)))
+
+(defn- next-point-fn
+  "Given a [[bisect]] options map, returns a function of `a, fa, b, fb,
+  iterations` that will generate the next candidate point for a root-finding
+  method search."
+  [{:keys [method n-break]}]
+  (case (or method :mixed)
+    :bisection (fn [a _fa b _fb _iter]
+                 (midpoint a b))
+    :secant (fn [a fa b fb _iter]
+              (secant-root a fa b fb))
+    :mixed (let [n-break (or n-break *bisect-break*)]
+             (fn [a fa b fb iter]
+               (if (< iter n-break)
+                 (midpoint a b)
+                 (secant-root a fa b fb))))
+    (u/illegal
+     (str "Method not supported: " method))))
+
+(defn bisect
+  "Given some function `f` and (inclusive) lower and upper bounds `a` and `b` on
+  the domain, attempts to find a root of `f` in that range, ie, a value `x` for
+  which `(f x)` is equal to 0.
+
+  Supports the following optional keyword arguments:
+
+  `:method`: can be `:bisection`, `:secant` or `:mixed`. See the Methods section
+  below for a description of each. Defaults to `:mixed`
+
+  `:eps`: defaults to [[sicmutils.value/machine-epsilon]].
+
+  `:callback`: if supplied, the supplied `f` will be invoked at each
+  intermediate point with the iteration count and the values of x and f(x) at
+  each search step.
+
+  `:maxiter`: maximum number of iterations allowed for the minimizer. Defaults to
+  1000.
+
+  `:maxfun` maximum number of times the function can be evaluated before
+  exiting. Defaults to `(inc maxiter)`.
+
+  `:n-break` defaults to the dynamically bindable `*bisect-break*` (which
+  defaults to 60). Bind `*bisect-break*` to modify the behavior of the `:mixed`
+  method (see below) when it's used inside a nested routine. Ignored if method
+  is not `:mixed`.
+
+  ## Methods
+
+  - `:bisection` causes [[bisect]] to use the [Bisection
+    method](https://en.wikipedia.org/wiki/Bisection_method); at each iteration,
+    the midpoint between the bounds is chosen as the next point.
+
+  - `:secant` uses the [Secant
+    method](https://en.wikipedia.org/wiki/Secant_method); each candidate point is
+    chosen by taking the root of a line drawn between the two endpoints `[a (f
+    a)]` and `[b (f b)]`. This method is most useful when the bounds are close to
+    the root.
+
+  - `:mixed` uses `:bisection` up until `:n-break` iterations and `:secant`
+    beyond. This can be useful for narrowing down a very wide range close to the
+    root, and then switching in to a faster search method."
+  ([f a b] (bisect f a b {}))
+  ([f a b {:keys [eps
+                  maxiter
+                  maxfun
+                  callback]
+           :or {eps     v/machine-epsilon
+                maxiter 1000
+                callback (constantly nil)}
+           :as opts}]
+   (let [close?        (us/close-enuf? eps)
+         get-next-pt   (next-point-fn opts)
+         maxfun        (or maxfun (inc maxiter))
+         [a b]         [(min a b) (max a b)]
+         [f-counter f] (u/counted f)]
+     (loop [a a, fa (f a)
+            b b, fb (f b)
+            iteration 0]
+       (cond (zero? fa) (succeed a fa iteration @f-counter)
+             (zero? fb) (succeed b fb iteration @f-counter)
+
+             (pos? (* fa fb))
+             (fail "Root not bounded" a fa b fb iteration @f-counter)
+
+             (or (> iteration maxiter)
+                 (> @f-counter maxfun))
+             (fail "Iteration bounds exceeded" a fa b fb iteration @f-counter)
+
+             :else
+             (let [mid  (get-next-pt a fa b fb iteration)
+                   fmid (f mid)]
+               (callback mid fmid iteration)
+               (if (close? a b)
+                 (succeed a fa iteration @f-counter)
+                 (if (pos? (* fb fmid))
+                   (recur a fa mid fmid (inc iteration))
+                   (recur mid fmid b fb (inc iteration))))))))))
+
+;; If we don't know anything, it is usually a good idea to break the interval
+;; into dx-sized pieces and look for roots in each interval.
+
+(defn search-for-roots
+  "Given a smooth function `f` and (inclusive) lower and upper bounds `a` and
+  `b` on the domain, attempts to find all roots of `f`, ie, a vector of values
+  `x_n` such that each `(f x_n)` is equal to 0.
+
+  [[search-for-roots]] first attempts to cut the (inclusive) range `[a, b]`
+  into pieces at most `dx` wide; then [[bisect]] is used to search each segment
+  for a root.
+
+  All `opts` supplied are passed on to [[bisect]]."
+  ([f a b dx]
+   (search-for-roots f a b dx {}))
+  ([f a b dx opts]
+   (letfn [(find-roots [a b]
+             (let [f1 (f b) f0 (f a)]
+               (if (< (Math/abs (- b a)) dx)
+                 (if (neg? (* f0 f1))
+                   (let [result (bisect f a b opts)]
+                     (if (:converged? result)
+                       [(:result result)]
+                       []))
+                   [])
+                 (let [m (midpoint a b)]
+                   (into (find-roots a m)
+                         (find-roots m b))))))]
+     (find-roots a b))))
diff --git a/test/sicmutils/numerical/roots/bisect_test.cljc b/test/sicmutils/numerical/roots/bisect_test.cljc
@@ -0,0 +1,81 @@
+;;
+;; Copyright © 2022 Sam Ritchie.
+;; This work is based on the Scmutils system of MIT/GNU Scheme:
+;; Copyright © 2002 Massachusetts Institute of Technology
+;;
+;; This is free software;  you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3 of the License, or (at
+;; your option) any later version.
+;;
+;; This software is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this code; if not, see <http://www.gnu.org/licenses/>.
+;;
+
+(ns sicmutils.numerical.roots.bisect-test
+  (:require [clojure.test :refer [is deftest testing]]
+            [same :refer [ish?]
+             #?@(:cljs [:include-macros true])]
+            [sicmutils.generic :as g]
+            [sicmutils.numbers]
+            [sicmutils.numerical.roots.bisect :as bi]
+            [sicmutils.value :as v]))
+
+(deftest bisect-tests
+  (doseq [method bi/all-methods]
+    (is (= {:result 0
+            :value 0
+            :iterations 0
+            :converged? true
+            :fncalls 2}
+           (bi/bisect g/square 0 1 {:method method}))
+        (str method "returns 0 at bounds"))
+
+    (is (= {:error "Root not bounded"
+            :bounds {:lower 2, :f-lower 4, :upper 3, :f-upper 9}
+            :iterations 0
+            :converged? false
+            :fncalls 2}
+           (bi/bisect g/square 2 3 {:method method}))
+        (str method " errors if no root's bounded")))
+
+  (letfn [(kepler [ecc m opts]
+            (bi/bisect
+             (fn [e]
+               (- e (* ecc (g/sin e)) m))
+             0.0 v/twopi opts))]
+    (is (ish? {:result 0.34227031649177475
+               :value 0.0
+               :fncalls 58
+               :iterations 55
+               :converged? true}
+              (kepler 0.99 0.01 {:method :bisection}))
+        "bisection method")
+
+    (is (ish? {:result 0.34227031649177486
+               :value 0.0
+               :iterations 540
+               :fncalls 543
+               :converged? true}
+              (kepler 0.99 0.01 {:method :secant}))
+        "secant method")
+
+    (is (ish? {:result 0.3422703164917748
+               :value 0.0
+               :iterations 20
+               :fncalls 23
+               :converged? true}
+              (kepler 0.99 0.01 {:method :mixed :n-break 10}))
+        "mixed method"))
+
+  (testing "search-for-roots"
+    (letfn [(poly [x] (* (- x 1) (- x 2) (- x 3)))]
+      (let [dx 2]
+        (is (ish? [1 2 3]
+                  (bi/search-for-roots poly -10 10 dx))
+            "search-for-roots finds all roots.")))))