Moved topological-sort to utility.lisp.

Pascal J. Bourguignon [2013-06-16 13:20]
Moved topological-sort to utility.lisp.
Filename
common-lisp/cesarum/constraints.lisp
common-lisp/cesarum/utility.lisp
diff --git a/common-lisp/cesarum/constraints.lisp b/common-lisp/cesarum/constraints.lisp
index 06f2ec0..2dc1208 100644
--- a/common-lisp/cesarum/constraints.lisp
+++ b/common-lisp/cesarum/constraints.lisp
@@ -394,39 +394,6 @@ NOTE:    This version avoids calling FUN twice with the same argument.
      :finally (return set)))


-(defun topological-sort (nodes lessp)
-  "
-RETURN: A list of NODES sorted topologically according to
-        the partial order function LESSP.
-        If there are cycles (discounting reflexivity),
-        then the list returned won't contain all the NODES.
-"
-  (loop
-     :with sorted = '()
-     :with incoming = (map 'vector (lambda (to)
-                                     (loop
-                                        :for from :in nodes
-                                        :when (and (not (eq from to))
-                                                   (funcall lessp from to))
-                                        :sum 1))
-                           nodes)
-     :with q = (loop
-                  :for node :in nodes
-                  :for inco :across incoming
-                  :when (zerop inco)
-                  :collect node)
-     :while q
-     :do (let ((n (pop q)))
-           (push n sorted)
-           (loop
-              :for m :in nodes
-              :for i :from 0
-              :do (when (and (and (not (eq n m))
-                                  (funcall lessp n m))
-                             (zerop (decf (aref incoming i))))
-                    (push m q))))
-     :finally (return (nreverse sorted))))
-

 (defun solve-constraints (edges propagate)
   "
diff --git a/common-lisp/cesarum/utility.lisp b/common-lisp/cesarum/utility.lisp
index cba4ac7..fb8d7ed 100644
--- a/common-lisp/cesarum/utility.lisp
+++ b/common-lisp/cesarum/utility.lisp
@@ -940,40 +940,109 @@ NOTE:    This version avoids calling FUN twice with the same argument.
 ;; (array->list array) --> (coerce array 'list)
 ;; (DEFUN ARRAY->LIST (A) (MAP 'LIST (FUNCTION IDENTITY) A));;ARRAY->LIST

-
 (defun topological-sort (nodes lessp)
-  "
+   "
 RETURN: A list of NODES sorted topologically according to
         the partial order function LESSP.
         If there are cycles (discounting reflexivity),
         then the list returned won't contain all the NODES.
 "
-  (loop
+   (loop
      :with sorted = '()
      :with incoming = (map 'vector (lambda (to)
                                      (loop
-                                        :for from :in nodes
-                                        :when (and (not (eq from to))
-                                                   (funcall lessp from to))
-                                        :sum 1))
+                                       :for from :in nodes
+                                       :when (and (not (eq from to))
+                                                  (funcall lessp from to))
+                                       :sum 1))
                            nodes)
      :with q = (loop
-                  :for node :in nodes
-                  :for inco :across incoming
-                  :when (zerop inco)
-                  :collect node)
+                 :for node :in nodes
+                 :for inco :across incoming
+                 :when (zerop inco)
+                 :collect node)
      :while q
      :do (let ((n (pop q)))
            (push n sorted)
            (loop
-              :for m :in nodes
-              :for i :from 0
-              :do (when (and (and (not (eq n m))
-                                  (funcall lessp n m))
-                             (zerop (decf (aref incoming i))))
-                    (push m q))))
+             :for m :in nodes
+             :for i :from 0
+             :do (when (and (and (not (eq n m))
+                                 (funcall lessp n m))
+                            (zerop (decf (aref incoming i))))
+                   (push m q))))
      :finally (return (nreverse sorted))))

+(error "Check topological-sort")
+#-(and)
+(tree-difference
+ '(defun topological-sort (nodes lessp)
+   "
+RETURN: A list of NODES sorted topologically according to
+        the partial order function LESSP.
+        If there are cycles (discounting reflexivity),
+        then the list returned won't contain all the NODES.
+"
+   (loop
+     :with sorted = '()
+     :with incoming = (map 'vector (lambda (to)
+                                     (loop
+                                       :for from :in nodes
+                                       :when (and (not (eq from to))
+                                                  (funcall lessp from to))
+                                       :sum 1))
+                           nodes)
+     :with q = (loop
+                 :for node :in nodes
+                 :for inco :across incoming
+                 :when (zerop inco)
+                 :collect node)
+     :while q
+     :do (let ((n (pop q)))
+           (push n sorted)
+           (loop
+             :for m :in nodes
+             :for i :from 0
+             :do (when (and (and (not (eq n m))
+                                 (funcall lessp n m))
+                            (zerop (decf (aref incoming i))))
+                   (push m q))))
+     :finally (return (nreverse sorted))))
+
+ '(defun topological-sort (nodes lessp)
+   "
+RETURN: A list of NODES sorted topologically according to
+        the partial order function LESSP.
+        If there are cycles (discounting reflexivity),
+        then the list returned won't contain all the NODES.
+"
+   (loop
+     :with sorted = '()
+     :with incoming = (map 'vector (lambda (to)
+                                     (loop
+                                       :for from :in nodes
+                                       :when (and (not (eq from to))
+                                                  (funcall lessp from to))
+                                       :sum 1))
+                           nodes)
+     :with q = (loop
+                 :for node :in nodes
+                 :for inco :across incoming
+                 :when (zerop inco)
+                 :collect node)
+     :while q
+     :do (let ((n (pop q)))
+           (push n sorted)
+           (loop
+             :for m :in nodes
+             :for i :from 0
+             :do (when (and (and (not (eq n m))
+                                 (funcall lessp n m))
+                            (zerop (decf (aref incoming i))))
+                   (push m q))))
+     :finally (return (nreverse sorted)))))
+
+

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; 15 - ARRAYS
ViewGit