http://qs321.pair.com?node_id=84192

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

Replies are listed 'Best First'.
Re: Topological Sort in Perl
by larsen (Parson) on May 30, 2001 at 12:40 UTC