Version 5 of Topological sort

Updated 2005-12-29 15:22:08 by escargo

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..."


Category Algorithm