Algorithm-Networksort
view release on metacpan or search on metacpan
Sun Nov 18 2012
- Consolidated the "algorithm" test files into one file,
abecedarian.t. Now that we're using $ENV{AUTHOR_TESTING},
we can consolidate test files without worrying about
tests timing out on CPAN testers' machines.
- Simplified code in the "best" test files.
Sat Nov 17 2012
- Upgrage tests to use the is() function from Test::More.
Fri Nov 16 2012
- Fixed the code in Build.PL that would set $ENV{AUTHOR_TESTING}.
All tests, even the lengthy ones, are now run when using
"Build test --Testlong".
Tue Nov 13 2012
- Long-running tests now check for $ENV{AUTHOR_TESTING} = 1,
and skip if it doesn't.
Tue Nov 6 2012
- Worked on bitonic() code. Use existing pack/unpack code to
determine power-of-two value, this replaces the
greater_power_of_2_less_than() function.
- Made loop a little more perlish by using the '..' operator.
- Added 'bitonic' to the keyword list.
- Changed arrangement of files to default layout by Module::Build.
- Added the Meta.yml and Build.PL files.
- Changed test files to use Test::Simple.
Fri Jun 2 2006
- Added pod.t.
- Typo fix in pod (itme instead of item). Fixed stale links.
- It looks like the Forbes D. Lewis article, "Sorting Networks"
has vanished altogether. Removed it from the See Also section.
Wed Jul 26 2006
- Split the batcher.t, best.t, bn.t, and hibbard.t files into
two. I'm trying to cut down the time-to-finish length, which
some test environments don't handle well ("Is this test done
yet? I'm bored.")
Wed Sep 13 2006
- Added color components, although no actual colors are set yet
except for 'foreground'.
- Changed the text graph option names 'fromcomp' and 'tocomp'
to 'compbegin' and 'compend' to make them consistant with the
input line names 'inputbegin' and 'inputend'. These names
get adopted by the color option hash.
Fri Sep 15 2006
Run the tests:
Build test
Install the module:
Build install
MORE ON TESTING
With the addition of 'best' networks for sizes 18 and 22, the testing
time went from 'lengthy' to 'intolerable for unsuspecting CPAN testers'.
Consequently, the sorting tests now have an upper limit of 10 for
normal testing. This size goes up to 17 if the environment variable
AUTHOR_TESTING is set (and the size 12 and up 'best' networks are also
tested).
If you want to have the full testing experience, I've provided a switch
that will automatically do all this for you. Run the tests with
Build test --Testlong
lib/Algorithm/Networksort.pm view on Meta::CPAN
has comparators => (
isa => 'ArrayRef[ArrayRef[Int]]', is => 'rw', required => 0,
predicate => 'has_comparators',
);
has network => (
isa => 'ArrayRef[ArrayRef[Int]]', is => 'rw', required => 0,
predicate => 'has_network',
);
has ['depth', 'length'] => (
isa => 'Int', is => 'rw', required => 0,
init_arg => 0,
);
has creator => (
isa => 'Str', is => 'ro', required => 0,
default => sub { return "Perl module " . __PACKAGE__ . ", " .
"version $VERSION";}
);
lib/Algorithm/Networksort.pm view on Meta::CPAN
# Catch errors
#
croak "Input size must be 2 or greater" if ($inputs < 2);
#
# Providing our own-grown network?
#
if ($alg eq 'none')
{
croak "No comparators provided" unless ($self->has_comparators);
$self->length(scalar @{ $self->comparators });
#
# Algorithm::Networksort::Best will set these, so
# only go through with this if this is a user-provided
# sequence of comparators.
#
unless ($self->has_network and $self->depth > 0)
{
@grouped = $self->group();
$self->network($self->comparators);
lib/Algorithm/Networksort.pm view on Meta::CPAN
@network = bosenelson($inputs) if ($alg eq 'bosenelson');
@network = hibbard($inputs) if ($alg eq 'hibbard');
@network = batcher($inputs) if ($alg eq 'batcher');
@network = bitonic($inputs) if ($alg eq 'bitonic');
@network = bubble($inputs) if ($alg eq 'bubble');
@network = oddeventransposition($inputs) if ($alg eq 'oddeventrans');
@network = balanced($inputs) if ($alg eq 'balanced');
@network = oddevenmerge($inputs) if ($alg eq 'oddevenmerge');
$self->title($algname{$alg} . " for N = " . $inputs) unless ($self->has_title);
$self->length(scalar @network);
$self->comparators(\@network); # The 'raw' list of comparators.
#
# Re-order the comparator list using the parallel grouping for
# the graphs. The resulting parallelism means less stalling
# when used in a pipeline.
#
@grouped = $self->group();
#
lib/Algorithm/Networksort.pm view on Meta::CPAN
# The ALGOL code was overly dependent on gotos. This has been changed.
#
sub hibbard
{
my $inputs = shift;
my @comparators;
my($bit, $xbit, $ybit);
#
# $t = ceiling(log2($inputs - 1)); but we'll
# find it using the length of the bitstring.
#
my $t = length sprintf("%b", $inputs - 1);
my $lastbit = 1 << $t;
#
# $x and $y are the comparator endpoints.
# We begin with values of zero and one.
#
my($x, $y) = (0, 1);
while (1 == 1)
lib/Algorithm/Networksort.pm view on Meta::CPAN
# The Bose-Nelson algorithm.
#
sub bosenelson
{
my $inputs = shift;
return bn_split(0, $inputs);
}
#
# @comparators = bn_split($i, $length);
#
# The helper function that divides the range to be sorted.
#
# Note that the work of splitting the ranges is performed with the
# 'length' variables. The $i variable merely acts as a starting
# base, and could easily have been 1 to begin with.
#
sub bn_split
{
my($i, $length) = @_;
my @comparators = ();
#
### bn_split():
#### $i
#### $length
#
if ($length >= 2)
{
my $mid = $length >> 1;
push @comparators, bn_split($i, $mid);
push @comparators, bn_split($i + $mid, $length - $mid);
push @comparators, bn_merge($i, $mid, $i + $mid, $length - $mid);
}
#
### bn_split() returns
##### @comparators
#
return @comparators;
}
#
# @comparators = bn_merge($i, $length_i, $j, $length_j);
#
# The other helper function that adds comparators to the list, for a
# given pair of ranges.
#
# As with bn_split, the different conditions all depend upon the
# lengths of the ranges. The $i and $j variables merely act as
# starting bases.
#
sub bn_merge
{
my($i, $length_i, $j, $length_j) = @_;
my @comparators = ();
#
### bn_merge():
#### $i
#### $length_i
#### $j
#### $length_j
#
if ($length_i == 1 && $length_j == 1)
{
push @comparators, [$i, $j];
}
elsif ($length_i == 1 && $length_j == 2)
{
push @comparators, [$i, $j + 1];
push @comparators, [$i, $j];
}
elsif ($length_i == 2 && $length_j == 1)
{
push @comparators, [$i, $j];
push @comparators, [$i + 1, $j];
}
else
{
my $i_mid = int($length_i/2);
my $j_mid = int(($length_i & 1)? $length_j/2: ($length_j + 1)/2);
push @comparators, bn_merge($i, $i_mid, $j, $j_mid);
push @comparators, bn_merge($i + $i_mid, $length_i - $i_mid, $j + $j_mid, $length_j - $j_mid);
push @comparators, bn_merge($i + $i_mid, $length_i - $i_mid, $j, $j_mid);
}
#
### bn_merge() returns
##### @comparators
#
return @comparators;
}
#
lib/Algorithm/Networksort.pm view on Meta::CPAN
#
# Batcher's sort as laid out in Knuth, Sorting and Searching, algorithm 5.2.2M.
#
sub batcher
{
my $inputs = shift;
my @network;
#
# $t = ceiling(log2($inputs)); but we'll
# find it using the length of the bitstring.
#
my $t = length sprintf("%b", $inputs);
my $p = 1 << ($t -1);
while ($p > 0)
{
my $q = 1 << ($t -1);
my $r = 0;
my $d = $p;
while ($d > 0)
lib/Algorithm/Networksort.pm view on Meta::CPAN
$merge->($lo, $n, $dir);
}
};
$merge = sub {
my ($lo, $n, $dir) = @_;
if ($n > 1) {
#
# $t = ceiling(log2($n - 1)); but we'll
# find it using the length of the bitstring.
#
my $t = length sprintf("%b", $n - 1);
my $m = 1 << ($t - 1);
for my $i ($lo .. $lo+$n-$m-1)
{
push @network, ($dir)? [$i, $i+$m]: [$i+$m, $i];
}
$merge->($lo, $m, $dir);
$merge->($lo + $m, $n - $m, $dir);
lib/Algorithm/Networksort.pm view on Meta::CPAN
# "The Balanced Sorting Network" by M. Dowd, Y. Perl, M Saks, and L. Rudolph
# ftp://ftp.cs.rutgers.edu/cs/pub/technical-reports/pdfs/DCS-TR-127.pdf
#
sub balanced
{
my $inputs = shift;
my @network;
#
# $t = ceiling(log2($inputs - 1)); but we'll
# find it using the length of the bitstring.
#
my $t = length sprintf("%b", $inputs - 1);
for (1 .. $t)
{
for (my $curr = 1 << $t; $curr > 1; $curr >>= 1)
{
for (my $i = 0; $i < (1 << $t); $i += $curr)
{
for (my $j = 0; $j < int($curr/2); $j++)
{
my $wire1 = $i+$j;
lib/Algorithm/Networksort.pm view on Meta::CPAN
# http://www.iti.fh-flensburg.de/lang/algorithmen/sortieren/networks/oemen.htm
# http://cs.engr.uky.edu/~lewis/essays/algorithms/sortnets/sort-net.html
#
sub oddevenmerge
{
my $inputs = shift;
my @network;
#
# $t = ceiling(log2($inputs - 1)); but we'll
# find it using the length of the bitstring.
#
my $t = length sprintf("%b", $inputs - 1);
my ($add_elem, $sort, $merge);
$add_elem = sub {
my ($i, $j) = @_;
push @network, [$i, $j]
if $i < $inputs && $j < $inputs;
};
lib/Algorithm/Networksort.pm view on Meta::CPAN
printing of the comparators, without any grouping for graphing or
maximum parallelization.
=back
The chances that you will need to use this function are slim, but the
following code snippet may represent an example:
my $nw = Algorithm::Networksort->new(inputs => 8, algorithm => 'batcher');
print "There are ", $nw->length(),
" comparators in this network, grouped into\n",
$nw->depth(), " parallel operations.\n\n";
print $nw, "\n";
my @grouped_network = $nw->group(grouping=>'graph');
print "\nThis will be graphed in ", scalar @grouped_network,
" columns.\n";
This will produce:
lib/Algorithm/Networksort.pm view on Meta::CPAN
#
$color =~ s/ //g;
$color =~ s/^#//;
if ($color =~ /[^0-9a-fA-F]/)
{
carp "Color '$color' is not in six or three hexadecimal digit RGB form.";
$color = "000";
}
if (length $color == 3)
{
$color =~ s/(.)(.)(.)/$1$1 $2$2 $3$3/;
}
elsif (length $color == 6)
{
$color =~ s/(..)(..)(..)/$1 $2 $3/;
}
else
{
carp "Color '$color' is not in six or three hexadecimal digit RGB form.";
$color = "0 0 0";
}
return join(" ", map{hex()/256} split(/ /, $color));
( run in 0.610 second using v1.01-cache-2.11-cpan-65fba6d93b7 )