Topological sort
Tuesday, March 13, 2007
Today I had to implement a topological sort for arrays of classes under the partial order of class inclusion. Since the arrays in question are never large I used a rather naive algorithm. I think it looks nice:
: largest-class ( seq -- n elt )
dup [ swap [ class< ] subset-with length 1 = ] find-with ;
: (sort-classes) ( vec -- )
dup empty?
[ drop ]
[ dup largest-class , over delete-nth (sort-classes) ] if ;
: sort-classes ( seq -- newseq )
[ >vector (sort-classes) ] { } make ;
The first word takes a sequence and finds a class which is only a subclass of itself. Such a class always exists, since classes form a lattice.
The second word is the main iterative loop here. It repeatedly removes
the largest class and tucks it away by calling ,
- then deletes it
from the sequence. The recursion stops when the sequence is empty.
The last word does the setup and teardown for the algorithm. It copies
the input sequence into a fresh mutable vector, and wraps the whole
thing in a make
so that objects passed to ,
are collected into a new
sequence which is returned at the end.