src/utilities: (add partial-order-minima)

[sod] / src / utilities.lisp

diff --git a/src/utilities.lisp b/src/utilities.lisp
index 46270c4..38bb746 100644 (file)
--- a/src/utilities.lisp
+++ b/src/utilities.lisp
@@ -573,6 +573,24 @@
                     cat-names cat-vars)
         ,@body))))
 
+(export 'partial-order-minima)
+(defun partial-order-minima (items order)
+  "Return a list of minimal items according to the non-strict partial ORDER.
+
+   The ORDER function describes the partial order: (funcall ORDER X Y) should
+   return true if X precedes or is equal to Y in the order."
+  (reduce (lambda (tops this)
+           (let ((new nil) (keep t))
+             (dolist (top tops)
+               (cond ((funcall order top this)
+                      (setf keep nil)
+                      (push top new))
+                     ((not (funcall order this top))
+                      (push top new))))
+             (nreverse (if keep (cons this new) new))))
+         items
+         :initial-value nil))
+
 ;;;--------------------------------------------------------------------------
 ;;; Strings and characters.