1: # This is essentially a copy of an old writeup of mine on Everything2.
2: #
3: # Here's an implementation of a [topological sort] in Perl.
4: # It's reasonably terse, and even has some comments!
5: #
6: # Pass it as input a list of array [reference]s; these
7: # specify that that index into the list must come before all
8: # elements of its array. Output is a topologically sorted
9: # list of indices, or undef if input contains a cycle. Note
10: # that you <em>must</em> pass an array ref for every input
11: # elements (if necessary, by adding an empty list
12: # reference)!
13: #
14: # For instance, tsort ([1,2,3], [3], [3], []) returns
15: # (0,2,1,3).
16:
17: sub tsort {
18: my @out = @_;
19: my @ret;
20:
21: # Compute initial in degrees
22: my @ind;
23: for my $l (@out) {
24: ++$ind[$_] for (@$l)
25: }
26:
27: # Work queue
28: my @q;
29: @q = grep { ! $ind[$_] } 0..$#out;
30:
31: # Loop
32: while (@q) {
33: my $el = pop @q;
34: $ret[@ret] = $el;
35: for (@{$out[$el]}) {
36: push @q, $_ if (! --$ind[$_]);
37: }
38: }
39:
40: @ret == @out ? @ret : undef;
41: }
42:
