[elpa] externals/dash 3992e3c 406/426: Make `-fixfn' more robust at handling floats

[Phillip Lord]

branch: externals/dash
commit 3992e3c506f1355aed287eccad9b71538e7080ea
Author: William West <address@hidden>
Commit: William West <address@hidden>

    Make `-fixfn' more robust at handling floats
    
    This change addreses issue #123. The two new optional parameters to
    `-fixfn' allow the caller to specify a custom equality test function,
    such as an approximate comparison of floats, and a halt test function,
    which can trigger a halt to the fixpoint iteration if it fails to
    converge.
    
    The default equality test remains `equal'. The default halt test is a
    simple counter up to `-fixfn-max-iterations'. The counter is provided by
    the new function `-counter'.
    
    The revised tests illustrate the usage of the new parameters.
---
 README.md          |   30 +++++++++++++++++++++---
 dash-functional.el |   63 +++++++++++++++++++++++++++++++++++++++++++++------
 dev/examples.el    |   10 +++++---
 3 files changed, 87 insertions(+), 16 deletions(-)

diff --git a/README.md b/README.md
index 91f0799..f4999b6 100644
--- a/README.md
+++ b/README.md
@@ -253,7 +253,7 @@ These combinators require Emacs 24 for its lexical scope. 
So they are offered in
 * [-orfn](#-orfn-rest-preds) `(&rest preds)`
 * [-andfn](#-andfn-rest-preds) `(&rest preds)`
 * [-iteratefn](#-iteratefn-fn-n) `(fn n)`
-* [-fixfn](#-fixfn-fn) `(fn)`
+* [-fixfn](#-fixfn-fn-optional-equal-test-halt-test) `(fn &optional equal-test 
halt-test)`
 * [-prodfn](#-prodfn-rest-fns) `(&rest fns)`
 
 ## Anaphoric functions
@@ -1470,6 +1470,7 @@ not, return a list with `args` as elements.
 ```el
 (-list 1) ;; => '(1)
 (-list 1 2 3) ;; => '(1 2 3)
+(-list '(1 2 3)) ;; => '(1 2 3)
 ```
 
 #### -fix `(fn list)`
@@ -2081,17 +2082,38 @@ This function satisfies the following law:
 (funcall (-iteratefn 'cdr 3) '(1 2 3 4 5)) ;; => '(4 5)
 ```
 
-#### -fixfn `(fn)`
+#### -fixfn `(fn &optional equal-test halt-test)`
 
 Return a function that computes the (least) fixpoint of `fn`.
 
-`fn` is a unary function, results are compared with `equal`.
+`fn` must be a unary function. The returned lambda takes a single
+argument, `x`, the initial value for the fixpoint iteration. The
+iteration halts when either of the following conditions is satisified:
+
+ 1. Iteration converges to the fixpoint, with equality being
+      tested using `equal-test`. If `equal-test` is not specified,
+      `equal` is used. For functions over the floating point
+      numbers, it may be necessary to provide an appropriate
+      appoximate comparsion test.
+
+ 2. `halt-test` returns a non-nil value. `halt-test` defaults to a
+      simple counter that returns t after `-fixfn-max-iterations`,
+      to guard against infinite iteration. Otherwise, `halt-test`
+      must be a function that accepts a single argument, the
+      current value of `x`, and returns non-nil as long as iteration
+      should continue. In this way, a more sophisticated
+      convergence test may be supplied by the caller.
+
+The return value of the lambda is either the fixpoint or, if
+iteration halted before converging, a cons with car `halted` and
+cdr the final output from `halt-test`.
 
 In types: (a -> a) -> a -> a.
 
 ```el
-(funcall (-fixfn 'cos) 0.7) ;; => 0.7390851332151607
+(funcall (-fixfn 'cos 'approx-equal) 0.7) ;; ~> 0.7390851332151607
 (funcall (-fixfn (lambda (x) (expt (+ x 10) 0.25))) 2.0) ;; => 
1.8555845286409378
+(funcall (-fixfn 'sin 'approx-equal) 0.1) ;; => '(halted . t)
 ```
 
 #### -prodfn `(&rest fns)`
diff --git a/dash-functional.el b/dash-functional.el
index 225c15d..296ccb1 100644
--- a/dash-functional.el
+++ b/dash-functional.el
@@ -135,18 +135,65 @@ This function satisfies the following law:
   (funcall (-iteratefn fn n) init) = (-last-item (-iterate fn init (1+ n)))."
   (lambda (x) (--dotimes n (setq x (funcall fn x))) x))
 
-(defun -fixfn (fn)
+(defun -counter (&optional beg end inc)
+  "Return a closure that counts from BEG to END, with increment INC.
+
+The closure will return the next value in the counting sequence
+each time it is called, and nil after END is reached. BEG
+defaults to 0, INC defaults to 1, and if END is nil, the counter
+will increment indefinitely.
+
+The closure accepts any number of arguments, which are discarded."
+  (let ((inc (or inc 1))
+       (n (or beg 0)))
+    (lambda (&rest _)
+      (when (or (not end) (< n end))
+       (prog1 n
+         (setq n (+ n inc)))))))
+
+(defvar -fixfn-max-iterations 1000
+  "The default maximum number of iterations performed by `-fixfn'
+  unless otherwise specified.")
+
+(defun -fixfn (fn &optional equal-test halt-test)
   "Return a function that computes the (least) fixpoint of FN.
 
-FN is a unary function, results are compared with `equal'.
+FN must be a unary function. The returned lambda takes a single
+argument, X, the initial value for the fixpoint iteration. The
+iteration halts when either of the following conditions is satisified:
+
+ 1. Iteration converges to the fixpoint, with equality being
+    tested using EQUAL-TEST. If EQUAL-TEST is not specified,
+    `equal' is used. For functions over the floating point
+    numbers, it may be necessary to provide an appropriate
+    appoximate comparsion test.
+
+ 2. HALT-TEST returns a non-nil value. HALT-TEST defaults to a
+    simple counter that returns t after `-fixfn-max-iterations',
+    to guard against infinite iteration. Otherwise, HALT-TEST
+    must be a function that accepts a single argument, the
+    current value of X, and returns non-nil as long as iteration
+    should continue. In this way, a more sophisticated
+    convergence test may be supplied by the caller.
+
+The return value of the lambda is either the fixpoint or, if
+iteration halted before converging, a cons with car `halted' and
+cdr the final output from HALT-TEST.
 
 In types: (a -> a) -> a -> a."
-  (lambda (x)
-    (let ((re (funcall fn x)))
-      (while (not (equal x re))
-        (setq x re)
-        (setq re (funcall fn re)))
-      re)))
+  (let ((eqfn   (or equal-test 'equal))
+       (haltfn (or halt-test
+                   (-not
+                     (-counter 0 -fixfn-max-iterations)))))
+    (lambda (x)
+      (let ((re (funcall fn x))
+           (halt? (funcall haltfn x)))
+       (while (and (not halt?) (not (funcall eqfn x re)))
+         (setq x     re
+               re    (funcall fn re)
+               halt? (funcall haltfn re)))
+       (if halt? (cons 'halted halt?)
+         re)))))
 
 (defun -prodfn (&rest fns)
   "Take a list of n functions and return a function that takes a
diff --git a/dev/examples.el b/dev/examples.el
index ac09d16..707123e 100644
--- a/dev/examples.el
+++ b/dev/examples.el
@@ -960,10 +960,12 @@ new list."
                     (-last-item (-iterate fn init (1+ 5)))))) => t)
 
     (defexamples -fixfn
-      ;; Find solution to cos(x) = x
-      (funcall (-fixfn 'cos) 0.7) => 0.7390851332151607
-      ;; Find solution to x^4 - x - 10 = 0
-      (funcall (-fixfn (lambda (x) (expt (+ x 10) 0.25))) 2.0) => 
1.8555845286409378)
+      ;; Find solution to cos(x) = x (may not converge without fuzzy 
comparison)
+      (funcall (-fixfn 'cos 'approx-equal) 0.7) ~> 0.7390851332151607
+      ;; Find solution to x^4 - x - 10 = 0 (converges using 'equal comparison)
+      (funcall (-fixfn (lambda (x) (expt (+ x 10) 0.25))) 2.0) => 
1.8555845286409378
+      ;; The sin function has a fixpoint at zero, but it converges too slowly 
and is halted
+      (funcall (-fixfn 'sin 'approx-equal) 0.1) => '(halted . t))
 
     (defexamples -prodfn
       (funcall (-prodfn '1+ '1- 'int-to-string) '(1 2 3)) => '(2 1 "3")