Algorithm-Networksort
view release on metacpan or search on metacpan
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";}
);
has title => (
isa => 'Str', is => 'rw', required => 0,
predicate => 'has_title'
);
has formats => (
isa => 'ArrayRef[Str]', is => 'rw', required => 0,
init_arg => undef,
);
has grouped_format => (
isa => 'Str', is => 'rw', required => 0,
default => "%s,\n",
);
has index_base => (
isa => 'ArrayRef[Value]', is => 'rw', required => 0,
);
#
# Variables to track sorting statistics
#
my $swaps = 0;
=pod
=encoding UTF-8
=head1 NAME
Algorithm::Networksort - Create Sorting Networks.
=begin html
<svg xmlns="http://www.w3.org/2000/svg"
xmlns:xlink="http://www.w3.org/1999/xlink" width="90" height="84" viewbox="0 0 90 84">
<title>Bose-Nelson Sort for N = 4</title>
<defs>
<g id="I_1c13" style="stroke-width:2; fill:#000; stroke:#000" >
<line x1="12" y1="0" x2="78" y2="0" />
</g>
<g id="C1_1c13" style="stroke-width:2;fill:#000; stroke:#000" >
<line x1="0" y1="0" x2="0" y2="14" />
<circle cx="0" cy="0" r="2" /> <circle cx="0" cy="14" r="2" />
</g>
<g id="C2_1c13" style="stroke-width:2;fill:#000; stroke:#000" >
<line x1="0" y1="0" x2="0" y2="28" />
<circle cx="0" cy="0" r="2" /> <circle cx="0" cy="28" r="2" />
</g>
</defs>
<g id="bosenelson04_1c13">
<use xlink:href="#I_1c13" y="21" /> <use xlink:href="#I_1c13" y="35" />
<use xlink:href="#I_1c13" y="49" /> <use xlink:href="#I_1c13" y="63" />
<use xlink:href="#C1_1c13" x="24" y="21" /> <use xlink:href="#C1_1c13" x="24" y="49" />
<use xlink:href="#C2_1c13" x="38" y="21" /> <use xlink:href="#C2_1c13" x="52" y="35" />
<use xlink:href="#C1_1c13" x="66" y="35" />
</g>
</svg>
<p>Bose-Nelson sorting network, inputs = 4, drawn as a Knuth diagram.</p>
<!--
This diagram was generated with the code in the SYNOPSIS; if you change
the code then please generate a new diagram from it.
-->
=end html
=head1 SYNOPSIS
use Algorithm::Networksort;
my $inputs = 4;
my $algorithm = "bosenelson";
#
# Generate the sorting network (a list of comparators).
#
# nwsrt() is a convenient short-hand
# for Algorithm::Networksort->new().
#
my $nw = nwsrt(inputs => $inputs, algorithm => $algorithm);
#
# Print the title, the comparator list using the default
# format, and a text-based Knuth diagram.
#
print $nw->title(), "\n";
$nw, "\n\n",
$nw->graph_text(), "\n";
#
# Create an SVG image of the Knuth diagram.
# Set the diagram sizes.
#
$nw->graphsettings(indent => 12,
hz_margin => 12, hz_sep=>12,
vt_margin => 21, vt_sep => 12,
compradius => 2, compline => 2,
inputradius => 0, inputline => 2);
print $nw->graph_svg();
lib/Algorithm/Networksort.pm view on Meta::CPAN
#
@d = @digits;
$nw_batcher->sort(\@d);
%nw_stats = $nw_batcher->statistics();
print "The Batcher Merge-Exchange network took ",
$nw_stats{swaps}, " exchanges to sort the array."
@d = @digits;
$nw_bn->sort(\@d);
%nw_stats = $nw_bn->statistics();
print "The Bose-Nelson network took ",
$nw_stats{swaps}, " exchanges to sort the array."
=cut
sub statistics
{
return (swaps => $swaps,
);
}
=head2 Methods For Printing
The network object by default prints itself in a grouped format; that is
my $nw = nwsrt(inputs => 8, algorithm => 'bosenelson');
print $nw . "\n";
Will result in the output
[[0,1], [2,3], [4,5], [6,7],
[0,2], [1,3], [4,6], [5,7],
[1,2], [5,6], [0,4], [3,7],
[1,5], [2,6],
[1,4], [3,6],
[2,4], [3,5],
[3,4]]
If you had shifted the array index by one using L<index_base()>:
my $nw = nwsrt(inputs => 8, algorithm => 'bosenelson');
$nw->index_base([1 .. 8]);
print $nw . "\n";
This would have resulted in the output
[[1,2], [3,4], [5,6], [7,8],
[1,3], [2,4], [5,7], [6,8],
[2,3], [6,7], [1,5], [4,8],
[2,6], [3,7],
[2,5], [4,7],
[3,5], [4,6],
[4,5]]
For a wider variety of outputs, use C<formats()> and C<index_base()> as
described below.
=head3 formats()
An array reference of format strings, for use in formatted printing (see
L<formatted()>). You may use as many sprintf-style formats as you like
to form your output.
$nw->formats([ "swap(%d, %d) ", "if ($card[%d] < $card[%d]);\n" ]);
=head3 index_base()
The values to use to reference array indices in formatted printing (see
L<formatted()>). By default, array indices are zero-based. To use a
different index base (most commonly, one-based array indexing), use
this method.
$nw->index_base([1 .. $inputs]);
=cut
sub _dflt_formatted
{
my $self = shift;
my $network = $_[0];
#
# Got comparators?
##### $network
#
if (scalar @$network == 0)
{
carp "No network to format.\n";
return "";
}
my $string = "";
my $index_base = $self->index_base();
for my $cmptr (@$network)
{
@$cmptr = @$index_base[@$cmptr] if (defined $index_base);
$string .= "[" . join(",", @$cmptr) . "], ";
}
chop $string; # Remove the trailing space, but not the comma.
return $string;
}
#
# _stringify
#
# Show a sorting network formatted by group (using _dflt_formatted() above).
#
sub _stringify
{
my $self = shift;
my @grouped = $self->group();
my $string = "[";
for my $grp (@grouped)
{
$string .= $self->_dflt_formatted($grp) . "\n";
}
lib/Algorithm/Networksort.pm view on Meta::CPAN
#
$string .= qq(gsave\n0 $ybound translate\n1 -1 scale\n);
$string .= qq($clrset{foreground}\n) if ($monotone);
if (defined $clrset{background})
{
$string .= qq(\ngsave $clrset{background}\n);
$string .= qq(0 0 moveto 0 $ybound lineto $xbound $ybound lineto $xbound 0 lineto closepath);
$string .= qq(\nfill grestore\n);
}
#
# Draw the input lines.
#
$string .= qq(\n%\n% Draw the input lines.\n%\n$grset{inputline} setlinewidth\n) .
qq(0 1 ) . ($inputs-1) . qq( {draw-inputline} for\n);
#
# Draw our comparators.
# Each member of a group of comparators is drawn in the same column.
#
$string .= qq(\n%\n% Draw the comparator lines.\n%\n$grset{compline} setlinewidth\n);
my $hidx = 0;
for my $group (@node_stack)
{
for my $comparator (@$group)
{
$string .= sprintf("%d %d %d draw-comparatorline\n", $hidx, @$comparator);
}
$hidx++;
}
$string .= qq(showpage\ngrestore\n% End of the EPS graph.\n);
return $string;
}
=head3 graph_svg()
Returns a string that creates a Knuth diagram of a network.
$nw = nwsrt(inputs => 4, algorithm => 'bitonic');
$diagram = $nw->graph_svg(); # Using default attributes.
The string will consist of SVG drawing tags enclosed by E<lt>svgE<gt> and E<lt>/svgE<gt> tags.
The attributes of the diagram can be changed via colorsettings() and graphsettings().
$nw = nwsrt_best(name => 'floyd09'); # See Algorithm::Networksort::Best
$nw->colorsettings(compbegin => '#04c', compend => '#00c');
$diagram = $nw->graph_svg();
=begin html
<p>Embedded in a web page, this will produce</p>
<svg xmlns="http://www.w3.org/2000/svg"
xmlns:xlink="http://www.w3.org/1999/xlink" width="278" height="154" viewbox="0 0 278 154">
<title>9-input Network by Robert W. Floyd</title>
<defs>
<g id="I_454d" style="stroke-width:2" >
<line style="fill:#000; stroke:#000" x1="18" y1="0" x2="260" y2="0" />
<circle style="fill:#000; stroke:#000" cx="18" cy="0" r="2" /> <circle style="fill:#000; stroke:#000" cx="260" cy="0" r="2" />
</g>
<g id="C1_454d" style="stroke-width:2" >
<line style="fill:#000; stroke:#000" x1="0" y1="0" x2="0" y2="14" />
<circle style="fill:#04c; stroke:#04c" cx="0" cy="0" r="2" /> <circle style="fill:#00c; stroke:#00c" cx="0" cy="14" r="2" />
</g>
<g id="C3_454d" style="stroke-width:2" >
<line style="fill:#000; stroke:#000" x1="0" y1="0" x2="0" y2="42" />
<circle style="fill:#04c; stroke:#04c" cx="0" cy="0" r="2" /> <circle style="fill:#00c; stroke:#00c" cx="0" cy="42" r="2" />
</g>
<g id="C2_454d" style="stroke-width:2" >
<line style="fill:#000; stroke:#000" x1="0" y1="0" x2="0" y2="28" />
<circle style="fill:#04c; stroke:#04c" cx="0" cy="0" r="2" /> <circle style="fill:#00c; stroke:#00c" cx="0" cy="28" r="2" />
</g>
<g id="C4_454d" style="stroke-width:2" >
<line style="fill:#000; stroke:#000" x1="0" y1="0" x2="0" y2="56" />
<circle style="fill:#04c; stroke:#04c" cx="0" cy="0" r="2" /> <circle style="fill:#00c; stroke:#00c" cx="0" cy="56" r="2" />
</g>
</defs>
<g id="floyd09_454d">
<use xlink:href="#I_454d" y="21" /> <use xlink:href="#I_454d" y="35" />
<use xlink:href="#I_454d" y="49" /> <use xlink:href="#I_454d" y="63" />
<use xlink:href="#I_454d" y="77" /> <use xlink:href="#I_454d" y="91" />
<use xlink:href="#I_454d" y="105" /> <use xlink:href="#I_454d" y="119" />
<use xlink:href="#I_454d" y="133" />
<use xlink:href="#C1_454d" x="27" y="21" /> <use xlink:href="#C1_454d" x="27" y="63" />
<use xlink:href="#C1_454d" x="27" y="105" /> <use xlink:href="#C1_454d" x="41" y="35" />
<use xlink:href="#C1_454d" x="41" y="77" /> <use xlink:href="#C1_454d" x="41" y="119" />
<use xlink:href="#C1_454d" x="55" y="21" /> <use xlink:href="#C1_454d" x="55" y="63" />
<use xlink:href="#C1_454d" x="55" y="105" /> <use xlink:href="#C3_454d" x="69" y="21" />
<use xlink:href="#C3_454d" x="83" y="63" /> <use xlink:href="#C3_454d" x="97" y="21" />
<use xlink:href="#C3_454d" x="111" y="35" /> <use xlink:href="#C3_454d" x="125" y="77" />
<use xlink:href="#C3_454d" x="139" y="35" /> <use xlink:href="#C3_454d" x="153" y="49" />
<use xlink:href="#C3_454d" x="167" y="91" /> <use xlink:href="#C3_454d" x="181" y="49" />
<use xlink:href="#C2_454d" x="195" y="35" /> <use xlink:href="#C2_454d" x="195" y="91" />
<use xlink:href="#C4_454d" x="209" y="49" /> <use xlink:href="#C2_454d" x="223" y="77" />
<use xlink:href="#C2_454d" x="237" y="49" /> <use xlink:href="#C1_454d" x="237" y="91" />
<use xlink:href="#C1_454d" x="251" y="49" />
</g>
</svg>
=end html
=cut
sub graph_svg
{
my $self = shift;
my $network = $self->network();
my $inputs = $self->inputs();
my %grset = $self->graphsettings();
#
# The 'salt' is used to ensure that the id attributes
# are unique -- I got bit by this when I put two SVG
# images in the same page.
#
my $salt = sprintf("_%x", int(rand(0x7fff)));
my @node_stack = $self->group(grouping => 'graph');
my $columns = scalar @node_stack;
#
# Get the colors for drawing.
#
my %clrset = colorswithdefaults();
my $monotone = ismonotone(%clrset);
#
# Set up the vertical and horizontal coordinates.
#
my @vcoord = vt_coords($inputs, %grset);
my @hcoord = hz_coords($columns, %grset);
my $xbound = $hcoord[$columns - 1] + $grset{hz_margin} + $grset{indent};
my $ybound = $vcoord[$inputs - 1] + $grset{vt_margin};
my $right_margin = $hcoord[$columns - 1] + $grset{indent};
my $i_radius = $grset{inputradius};
my $c_radius = $grset{compradius};
my $string = qq(<svg xmlns="http://www.w3.org/2000/svg"\n) .
qq( xmlns:xlink="http://www.w3.org/1999/xlink" ) .
qq(width="$xbound" height="$ybound" viewbox="0 0 $xbound $ybound">\n) .
qq( <title>) . $self->title() . qq(</title>\n) .
qq( <desc>\n CreationDate: ) . localtime() .
qq(\n Creator: ) . $self->creator() . qq(\n </desc>\n);
#
# Set up the input line template, and either set a single
# default color, or color the components individually.
#
#
my $g_style = qq(style="stroke-width:$grset{inputline});
my $b_style;
my $l_style;
my $e_style;
if ($monotone)
{
$g_style .= qq(; fill:$clrset{foreground}; stroke:$clrset{foreground}");
$b_style = "";
$l_style = "";
$e_style = "";
}
else
{
$g_style .= qq(");
$b_style = qq(style="fill:$clrset{inputbegin}; stroke:$clrset{inputbegin}");
$l_style = qq(style="fill:$clrset{inputline}; stroke:$clrset{inputline}");
$e_style = qq(style="fill:$clrset{inputend}; stroke:$clrset{inputend}");
}
$string .=
qq( <defs>\n) .
qq( <!-- Define the input line template. -->\n) .
qq( <g id="I$salt" $g_style >\n) .
qq( <desc>Input line</desc>\n) .
qq( <line $l_style x1="$grset{hz_margin}" y1="0" x2="$right_margin" y2="0" />\n);
if ($i_radius > 0)
{
$string .= qq( <circle $b_style cx="$grset{hz_margin}" cy="0" r="$i_radius" />) .
qq( <circle $e_style cx="$right_margin" cy="0" r="$i_radius" />\n);
}
$string .= qq( </g>\n\n);
#
# Set up the comparator templates, and like the input template,
# either set a single default color, or color the components
# individually.
#
$string .= qq( <!-- Define the different comparator lines. -->\n);
$g_style = qq(style="stroke-width:$grset{compline});
if ($monotone)
{
$g_style .= qq(;fill:$clrset{foreground}; stroke:$clrset{foreground}");
$b_style = "";
$l_style = "";
$e_style = "";
}
else
{
$g_style .= qq(");
$l_style = qq(style="fill:$clrset{compline}; stroke:$clrset{compline}");
$b_style = qq(style="fill:$clrset{compbegin}; stroke:$clrset{compbegin}");
$e_style = qq(style="fill:$clrset{compend}; stroke:$clrset{compend}");
}
my @cmptr = (0) x $inputs;
for my $comparator (@$network)
{
my($from, $to) = @$comparator;
my $clen = $to - $from;
if ($cmptr[$clen] == 0)
{
$cmptr[$clen] = 1;
my $endpoint = $vcoord[$to] - $vcoord[$from];
$string .=
qq( <g id="C$clen$salt" $g_style >\n) .
qq( <desc>Comparator size $clen</desc>\n) .
qq( <line $l_style x1="0" y1="0" x2="0" y2="$endpoint" />\n);
if ($c_radius > 0)
{
$string .= qq( <circle $b_style cx="0" cy="0" r="$c_radius" />) .
qq( <circle $e_style cx="0" cy="$endpoint" r="$c_radius" />\n);
}
$string .= qq( </g>\n);
}
}
$string .= qq( </defs>\n\n);
#
# End of definitions. Draw the input lines as a group.
#
$string .= qq( <g id=") . $self->nwid() . qq($salt">\n);
#
# If there's a background color, insert as the first element a <rect>
# with the full size of the view and a fill of the desired color.
#
if (defined $clrset{background})
{
$string .= qq( <rect width="100%" height="100%" style="fill:$clrset{background}" />\n);
}
$string .= qq( <!-- Draw the input lines. -->\n);
$string .= qq( <use xlink:href="#I$salt" y="$vcoord[$_]" />\n) for (0..$inputs-1);
#
# Draw our comparators.
# Each member of a group of comparators is drawn in the same column.
#
$string .= qq(\n <!-- Draw the comparator lines. -->\n);
my $hidx = 0;
for my $group (@node_stack)
{
my $h = $hcoord[$hidx++];
for my $comparator (@$group)
{
my($from, $to) = @$comparator;
my $clen = $to - $from;
my $v = $vcoord[$from];
$string .= qq( <!-- [$from,$to] -->) .
qq(<use xlink:href="#C$clen$salt" x="$h" y="$v" />\n);
}
}
$string .= qq( </g>\n</svg>\n);
return $string;
}
=head3 graph_text()
Returns a string that graphs out the network's comparators in plain text.
my $nw = Algorithm::Networksort(inputs = 4, algorithm => 'bitonic');
print $nw->graph_text();
This will produce
o--^-----^--^--o
| | |
o--v--^--|--v--o
| |
o--^--v--|--^--o
| | |
o--v-----v--v--o
=cut
sub graph_text
{
my $self = shift;
my $network = $self->network();
my $inputs = $self->inputs();
my %txset = $self->textsettings();
my @node_stack = $self->group(grouping => 'graph');
my @inuse_nodes;
( run in 0.939 second using v1.01-cache-2.11-cpan-d7f47b0818f )