# 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)