Topological sort

Function topological-sort below returns a topologically sorted list of vertices for a given directed acyclic graph. The algortihm is inspired by “Introduction to Algorithms”, chapter 22.4, by Cormen, Leiserson, Rivest, and Stein (2009).

A graph is represented by a list of sublists. The first element of each sublist is a vertex. The remaining elements of the sublist define all vertices that are adjacent to that vertex; i.e. for these vertices, there exists an edge to the first vertex. topological-sort sorts an acyclic directed graph such that for every edge from vertex u to v, u will become before v in the resulting list of vertices. The algorithm achieves this in O(|V| + |E|), where |V| is the number of vertices and |E| the number of edges.

The original code for the algorithm below was written by Mikael Djurfeldt:

"tsort.scm" Topological sort
Copyright (C) 1995 Mikael Djurfeldt
This code is in the public domain.
;; Returns a topologically sorted list of vertices for a given directed acyclic graph.
;; A graph is represented by a list of sublists. The first element of each sublist is a
;; vertex. The remaining elements of the sublist define all vertices for which there
;; exists an edge to the first vertex of the sublist.
;;   `dag`      is a directed acyclic graph
;;   `eql?`     is an equivalence relation
;;   `eql-hash` is a hash function compatible to `eql?`. `eql-hash` can be omitted if
;;              `eql?` is either `eq?`, `eqv?`, or `equal?`.
(define topological-sort
  (case-lambda
    ((dag)
      (tsort dag eqv-hash eqv?))
    ((dag eql?)
      (cond ((eq? eql? eq?)    (tsort dag eq-hash eq?))
            ((eq? eql? eqv?)   (tsort dag eqv-hash eqv?))
            ((eq? eql? equal?) (tsort dag equal-hash equal?))
            (else              (error "topological-sort: missing hash function"))))
    ((dag eql-hash eql?)
      (tsort dag eql-hash eql?))))

(define (tsort dag eql-hash eql?)
  (if (null? dag)
      '()
      (letrec* ((adj-table (make-hashtable eql-hash eql?))
                (sorted    '())
                (visit     (lambda (u adj-list)
                             ;; Color vertex u
                             (hashtable-set! adj-table u #t)
                             ;; Visit uncolored vertices which u connects to
                             (for-each (lambda (v)
                                         (let ((val (hashtable-ref adj-table v #f)))
                                           (if (not (eq? val #t))
                                               (visit v (or val '())))))
                                       adj-list)
                             ;; Since all vertices downstream u are visited by now, we can
                             ;; safely put u on the output list
                             (set! sorted (cons u sorted)))))
        ;; Hash adjacency lists
        (for-each (lambda (def) (hashtable-set! adj-table (car def) (cdr def)))
                  (cdr dag))
        ;; Visit vertices
        (visit (caar dag) (cdar dag))
        (for-each (lambda (def)
                    (let ((val (hashtable-ref adj-table (car def) #f)))
                      (if (not (eq? val #t))
                          (visit (car def) (cdr def)))))
                  (cdr dag))
        sorted)))

Below is the example from Cormen, Leiserson, Rivest, and Stein:

Prof. Bumstead topologically sorts his clothing when getting dressed. Clothes are vertices. Each directed edge (u,v) means that garment u must be put on before garment v. All edges from u are described as a single sublist of the form (u v1 v2 …). In the following example, Prof. Bumstead needs to put on his shirt before both his tie and his belt:

  ((shirt tie belt)
   (tie jacket)
   (belt jacket)
   (watch)
   (pants shoes belt)
   (undershorts pants shoes)
   (socks shoes))

Function topological-sort can now compute the order in which Prof. Bumstead has to get dressed:

(topological-sort '((shirt tie belt)
                (tie jacket)
                (belt jacket)
                (watch)
                (pants shoes belt)
                (undershorts pants shoes)
                (socks shoes))
==>
(socks undershorts pants shoes watch shirt belt tie jacket)