Topological sort

someone on the chat was asking for a topological sort algorithm. Here's one I have lying around, for what it's worth.


# [TopologicalSort] takes an alternative (which is represented by a directed acyclic graph, DAG)
# and returns a topological sort of it.  A topological sort of a DAG is
# a list of all the vertices of the DAG (here a list of package names),
# such that if A -> B is in the DAG, then the index of A in the list is
# less than the index of B in the list.  In addition, when constructing
# the list, this proc includes the corresponding requirement along with
# each package name.  Thus, the result is a requirement list, ordered so
# that each requirement is listed after its prerequisites.
#
# proc ::package::TopologicalSort alt {
 
proc TopologicalSort alt {
 
    # Unpack the alternative data structure
    lassign $alt DAG MAP
    array set dag [lindex $DAG 0]
    set max [lindex $DAG 1]
    array set map $MAP

    set answer {} 
    foreach vertex $max {
        unset dag($vertex)
    }
    while {[llength $max]} {
        set pkg [lindex $max 0]
        set max [lrange $max 1 end]
        set answer [linsert $answer 0 [
            linsert [lindex $map($pkg) 1] 0 $pkg]]
        foreach vertex [array names dag] {
            set idx [lsearch -exact $dag($vertex) $pkg]
            set dag($vertex) [lreplace $dag($vertex) $idx $idx]
            if {[llength $dag($vertex)] == 0} {
                lappend max $vertex
                unset dag($vertex)
            }
        }
    }
    set answer
}
# Test:
catch {console show}
set Result {} 
lappend Topo  foo 1  bar 2
puts   "Topo: $Topo"
set Result [ TopologicalSort $Topo ]
puts $Result

The above code may make little sense out of its context. For that, see [L1 ]. Look in mkdepend.tcl.

HJG: An example with some data would be nice. The above test gives an error "list must have an even number of elements..."