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