——#!/usr/bin/perl
=begin metadata
Name: tsort
Description: topological sort
Author: Jeffrey S. Haemer
License:
=end metadata
=cut
use
strict;
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
;
"$_\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
tsort - topological sort
=head1 SYNOPSIS
tsort [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<Work> 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<filename>
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<More Programming Pearls>, pp. 20-23),
who, in turn, stole it from Don Knuth
(I<Art of Computer Programming, volume 1: Fundamental Algorithms>,
Section 2.2.3)
=cut