[Date Prev] [Date Next] [Thread Prev] [Thread Next] Date Index Thread Index Search archive:
Date:Mon Jul 11 16:56:19 1994 
Subject:Re: topological sort 
From:Ian Rogers 
Volume-ID:940712.03 

Robin's TopologicalSort procedure takes an adjacency map and the root node
as arguments. Unfortunately I needed to find the root given just the
adjacency map. problem also turns out quite neat. The only nasty bit is in
the 2nd half of the procedure as my graphs are often cyclic.

define union(list1,list2);
    lvars list1, list2, e,
        ;
    /* this presumes that the two lists are pre-pruned */
    [%  for e in list1 do
            unless lmember(e, list2) do e endunless
        endfor;
     %
     ^^list2
    ]
enddefine;

/*
    findroot takes an adjacency table and tries to find the root (ie. the
    parent-most node). The returned list may contain more than one item if
    there is more than one node with nothing pointing to it.
    
    WARNING: if the graph contains a cycle then -adj- will
    be altered to remove it!
*/
define findroot(adj) -> parents;
    lvars   adj, parents = [], children = [],
            p, c, i,
        ;
    for p,c in_property adj do  
        /* if it's a child now then it can't be a parent any longer */
        for i in c do delete(i, parents) -> parents endfor;
        
        /* if it's not been a child so far then it could be a parent,
           (this test ignores links from the node back to itself)
        */
        unless member(p, children) do p :: parents -> parents endunless;
        
        /* remember all the children */
        union(c, children) -> children;
    endfor;
    
    if parents == [] then
        /*  ah, there's a cycle. Just pick a node with the most decendants
            and chop any links to it.
        */
        lvars   max_len = 0,
                top = false,
            ;
        fast_for p,c in_property adj do
            if (length(c) ->> c) > max_len then
                p -> top;
                c -> max_len;
            endif;
        endfor;
        for p,c in_property adj do  ;;; can't use fast as we're altering
                                    ;;; the prop
            delete(top, c) -> adj(p);
        endfor;
        [^top] -> parents;
    endif;
enddefine;

vars m = [  [a [b c]] [b [e d]] [c [d]] [d []] [e [a]] ],
    map = newassoc(m),
    ;
findroot(map) =>
** [a]


vars m = [  [a [b c]] [b [e d]] [c [d]] [d []] [e [a]] ],
    map = newassoc(m),
    ;
[% explode(TopologicalSort(hd(findroot(map)), map)) %] =>
** [[e 5] [d 4] [a 1] [c 2] [b 3]]



Ian.
--
<a href=http://www.cogs.susx.ac.uk/users/ianr/>Ian Rogers</a>