|20-CS-4003-001||Organization of Programming Languages||Fall 2017|
Topological Sort - Stream solution
;; See extensive notes on newObject to the right (define newObject (lambda (idx id deps) (lambda () (letrec ((visitall (lambda (s d) (if (null? d) (begin (vector-set! vec idx '()) (cons id (lambda () s)) ) (if (null? (vector-ref vec (car d))) (visitall s (cdr d)) (let* ((p (vector-ref vec (car d))) (x ((cdr p)))) (visitall (splice$ x s) (cdr d)))))))) (visitall '() deps))))) ;; splice stream X$ onto stream S$ (define splice$ (lambda (X$ S$) (if (null? X$) S$ (if (null? ((cdr X$))) (cons (car X$) (lambda () S$)) (cons (car X$) (lambda () (splice ((cdr X$)) S$))))))) ;; take the first n tokens of a stream or list S (define take (lambda (n S) (if (or (null? S) (= n 0)) '() (if (and (not (null? (cdr S))) (procedure? (cdr S))) (cons (car S) (take (- n 1) ((cdr S)))) (cons (car S) (take (- n 1) (cdr S))))))) ;; An example: ;; format: '((<identity> (list-of-dependencies)) ...) (define input '((Cincinnati (1 5 7 9)) (Cleveland (4 5 8)) (Columbus (0 1 6 10 12 18)) (Chicago (5 9 12 13 14)) (Calumet (9 11 12)) (Corman ()) (Denver (3 9 10 11)) (Dallas (4 9 12 13)) (Durango (10 11 20 21)) (Durea (25)) (Detroit (25)) (Edwards ()) (Echemonte (8 9 10 11)) (Eagle_Creek (20 21 22)) (Erasmus (15 19 21)) (Fullman (10 11 19 24)) (Fortnight (19 20)) (Fallow (15 20 21)) (Fables (19 20)) (Finese (22)) (Gordon ()) (Gallop (10 20)) (Gormon (11 21 25)) (Harmon (12 22 24)) (Halpern (22)) (Hornwich ()))) ;; this vector stores the newObject procedures ;; for each object (define vec (make-vector (length input) '())) ;; create a vector of newObject procedures (define populate-vector (lambda (inp i) (if (null? inp) '() (let* ((id (caar inp)) (deps (cadar inp)) (no (newObject i id deps))) (vector-set! vec i (cons id no)) (populate-vector (cdr inp) (+ i 1)))))) ;; populate the vector with given input (populate-vector input 0) ;; See notes to the right (define solve (lambda (i len) (if (= i 0) '() (if (null? (vector-ref vec (- len i))) (solve (- i 1) len) (let* ((p (vector-ref vec (- len i))) (lst (take len ((cdr p))))) (append (solve (- i 1) len) lst)))))) ;; this makes it easier to run solve (define solveit (lambda (inp) (solve (length inp) (length inp))))
The code to the left implements a solution to the problem of
topologically sorting a partial order. This solution uses streams.
The following notes pertain to the procedures defined in the code.
newObject returns a thunk from which a stream of object identities can be produced. The thunk is paired with an object identity to create an official stream which resides in vec at position idx (idx is the vector index which is going to take the stream whose cdr is the procedure returned by newObject). Parameter id is any atomic token that represents an object identity. Parameter deps is a list of vector indices, in no particular order.
Procedure visitall is the procedure that produces a stream of identities that must be output (put into the output stream) before object idx is output minus those identities that have been output before visitall was called for object idx. The stream returned by visitall is returned when this thunk (returned by newObject) is invoked. The operation of visitall is straightforward: it splices the output streams of all dependent objects until no more dependent objects are left to consider. Then, it adds the identity of the object at position idx in the vector. with
(cons id (lambda () s))To prevent recomputation of the stream, in case object idx is a dependency of more than one object, the stream is closed to further hits by setting the idx position of the vector to '(). This is done by the line
(vector-set! vec idx '())If the vector had been maintained as a list this side effect would not be necessary but then the vector would have to be disassembled to replace a list member and this would be expensive, at least theoretically.
visitall parameters: s is the stream of all dependency outputs, d is a list vector indices of dependenciesObserve, even though vec is not yet defined in this file, loading proceeds normally because all references to vec are behind a (lamba ()..., also called a thunk. This is important because the definition of the vector cannot be known until an input is given.
Procedure solve solves the problem. The let is necessary due to the side effects of changing vector elements to '(). Without the let recursion on solve in the append line would create '() elements in the vector and after unwinding the recursion the take would operate on a '() element even though getting to the take happens only if the vector reference it operates on is not '()! So, the take must be executed before the solve!