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