Implement topological-sort, porting the common lisp example from rosettacode.org.

This commit is contained in:
Dimitri Fontaine 2011-09-20 22:59:31 +02:00
parent 9efb25fc4c
commit 62a246cc21

View File

@ -12,6 +12,7 @@
;; Install
;; Please see the README.asciidoc file from the same distribution
(require 'cl)
(require 'el-get-core)
;;
@ -35,10 +36,55 @@ symbol) depends"
(append (list (append (list package) alldeps))
(loop for p in pdeps append (el-get-dependencies p)))))
(defun topological-sort (graph)
"return a list of packages to install in order"
nil)
(defun* topological-sort (graph &key (test 'eql))
"Returns a list of packages to install in order.
Graph is an association list whose keys are objects and whose
values are lists of objects on which the corresponding key depends.
Test is used to compare elements, and should be a suitable test for
hash-tables. Topological-sort returns two values. The first is a
list of objects sorted toplogically. The second is a boolean
indicating whether all of the objects in the input graph are present
in the topological ordering (i.e., the first value)."
(let ((entries (make-hash-table :test test)))
(flet ((entry (v)
"Return the entry for vertex. Each entry is a cons whose
car is the number of outstanding dependencies of vertex
and whose cdr is a list of dependants of vertex."
(or (gethash v entries)
(puthash v (cons 0 '()) entries))))
;; populate entries initially
(dolist (gvertex graph)
(destructuring-bind (vertex &rest dependencies) gvertex
(let ((ventry (entry vertex)))
(dolist (dependency dependencies)
(let ((dentry (entry dependency)))
(unless (funcall test dependency vertex)
(incf (car ventry))
(push vertex (cdr dentry))))))))
;; L is the list of sorted elements, and S the set of vertices
;; with no outstanding dependencies.
(let ((L '())
(S (loop for entry being each hash-value of entries
using (hash-key vertex)
when (zerop (car entry)) collect vertex)))
;; Until there are no vertices with no outstanding dependencies,
;; process vertices from S, adding them to L.
(do* () ((endp S))
(let* ((v (pop S)) (ventry (entry v)))
(remhash v entries)
(dolist (dependant (cdr ventry) (push v L))
(when (zerop (decf (car (entry dependant))))
(push dependant S)))))
(message "ARF %S" L)
;; return (1) the list of sorted items, (2) whether all items
;; were sorted, and (3) if there were unsorted vertices, the
;; hash table mapping these vertices to their dependants
(let ((all-sorted-p (zerop (hash-table-count entries))))
(values (nreverse L)
all-sorted-p
(unless all-sorted-p
entries)))))))
;;
;; Support for tracking package states
;;