Merge pull request #168 from bo-tato/repeat-until-stable

repeat-until-stable

REFERENCE.md

@@ -2126,6 +2126,15 @@ From LispWorks.
 
 [View source](functions.lisp#L572)
 
+### `(repeat-until-stable fn x &key (test 'eql) max-depth)`
+
+Repeatedly call a single-argument function FN until the result stays the same (equal
+according to TEST). It will call `(fn x)`, then `(fn (fn x))` etc. If MAX-DEPTH
+is specified, then FN will be called at most MAX-DEPTH times, even if the result
+hasn't stabilized.
+
+[View source](functions.lisp#L580)
+
 ## Trees
 
 ### `(reuse-cons x y x-y)`

functions.lisp

@@ -576,3 +576,16 @@ This function is meant as a placeholder for a function argument.
 From LispWorks."
   (declare (ignore args))
   (values))
+
+(defloop repeat-until-stable (fn x &key (test 'eql) max-depth)
+  "Takes a single-argument FN and calls (fn x), then (fn (fn x)), and so on
+until the result doesn't change according to TEST. If MAX-DEPTH is specified
+then FN will be called at most MAX-DEPTH times even if the result is still changing."
+  (if (eql 0 max-depth)
+      x
+      (let ((next (funcall fn x)))
+        (if (funcall test next x)
+            x
+            (repeat-until-stable fn next :test test
+                                         :max-depth (when max-depth
+                                                      (1- max-depth)))))))

package.lisp

@@ -201,6 +201,7 @@
    #:mvconstantly
    #:fuel
    #:do-nothing
+   #:repeat-until-stable
    ;; Trees.
    #:reuse-cons
    #:car+cdr

tests/functions.lisp

@@ -264,3 +264,12 @@
   (let ((list '()))
     (do-nothing (push 1 list) (push 2 list))
     (is (equal list '(2 1)))))
+
+(test repeat-until-stable
+  (flet ((herons-method (S)
+           "Return a function that iteratively estimates the square root of S."
+           (lambda (n)
+             (/ (+ n (/ S n))
+                2d0))))
+    (is (= 2.23606797749979d0 (repeat-until-stable (herons-method 5) 7)))
+    (is (= 3.162319422150883d0 (repeat-until-stable (herons-method 10) 5 :max-depth 3)))))