Version 6 of Topological sort

Updated 2014-06-07 16:43:42 by dkf

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
    foreach {DAG MAP} $alt {break}
    array set dag [lindex $DAG 0]
    set max [lindex $DAG 1]
    array set map $MAP

    set answer [list]
    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..."