#!/usr/local/bin/perl -w # $Id: tsort,v 1.2 2004-05-10 13:13:35 tradke Exp $ use strict; use vars qw($opt_b $opt_d); use Getopt::Std; my $usage = "usage: $0 [-b|-d] [filename]\n"; getopts("bd") or die $usage; die $usage if ($opt_b && $opt_d); my %pairs; # all pairs ($l, $r) my %npred; # number of predecessors my %succ; # list of successors while (<>) { my ($l, $r) = my @l = split; next unless @l == 2; next if defined $pairs{$l}{$r}; $pairs{$l}{$r}++; $npred {$l} += 0; ++$npred{$r}; push @{$succ{$l}}, $r; } # create a list of nodes without predecessors my @list = grep {!$npred{$_}} keys %npred; while (@list) { $_ = pop @list; print "$_\n"; foreach my $child (@{$succ{$_}}) { if ($opt_b) { # breadth-first unshift @list, $child unless --$npred{$child}; } else { # depth-first (default) push @list, $child unless --$npred{$child}; } } } warn "cycle detected\n" if grep {$npred{$_}} keys %npred; =head1 NAME tcsort - topological sort =head1 SYNOPSIS tcsort [filename] =head1 DESCRIPTION =over 2 Does a topological sort of input pairs. For a more complete description, see the tsort(1) man page, For an explanation of the algorithm, see the I column in the October, 1998, issue of SunExpert, or the references given below. =back =head1 OPTIONS AND ARGUMENTS =over 8 =item B<[-b|-d]> breadth-first or depth-first (default) traversal =item B Optional input file. Input format is pairs of white-space-separated fields, one pair per line. Each field is the name of a node. Output is the topologically sorted list of nodes. Ignores lines without at least two fields. Ignores all fields on the line except the first two. =back =head1 AUTHOR Jeffrey S. Haemer =head1 SEE ALSO tsort(1), tcsh(1), tchrist(1) Algorithm stolen from Jon Bentley (I, pp. 20-23), who, in turn, stole it from Don Knuth (I, Section 2.2.3) =cut