From ea36ed84d44cf3d867e7858fd2253dc2f1e366eb Mon Sep 17 00:00:00 2001
From: bo-tato <122528427+bo-tato@users.noreply.github.com>
Date: Fri, 9 Feb 2024 20:37:57 +0000
Subject: [PATCH] repeat-until-stable

---
 REFERENCE.md         |  9 +++++++++
 functions.lisp       | 13 +++++++++++++
 package.lisp         |  1 +
 tests/functions.lisp |  9 +++++++++
 4 files changed, 32 insertions(+)

diff --git a/REFERENCE.md b/REFERENCE.md
index eadcf90..863bb5e 100644
--- a/REFERENCE.md
+++ b/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)`
diff --git a/functions.lisp b/functions.lisp
index 9460322..a97d96e 100644
--- a/functions.lisp
+++ b/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)))))))
diff --git a/package.lisp b/package.lisp
index 74b08b0..16682d2 100644
--- a/package.lisp
+++ b/package.lisp
@@ -201,6 +201,7 @@
    #:mvconstantly
    #:fuel
    #:do-nothing
+   #:repeat-until-stable
    ;; Trees.
    #:reuse-cons
    #:car+cdr
diff --git a/tests/functions.lisp b/tests/functions.lisp
index 77716c4..dbee8f3 100644
--- a/tests/functions.lisp
+++ b/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)))))