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();

=head1 DESCRIPTION

This module will create sorting networks, a sequence of comparisons
that do not depend upon the results of prior comparisons.

Since the sequences and their order never change, they can be very
useful if deployed in hardware, or if used in software with a compiler
that can take advantage of parallelism. Unfortunately a sorting network cannot
be used for generic run-time sorting like quicksort, since the arrangement of
the comparisons is fixed according to the number of elements to be
sorted.

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;

	#
	# Set up a matrix of the begin and end points found in each column.
	# This will tell us where to draw our comparator lines.
	#
	for my $group (@node_stack)
	{
		my @node_column = (0) x $inputs;

		for my $comparator (@$group)
		{
			my($from, $to) = @$comparator;
			@node_column[$from, $to] = (1, -1);
		}
		push @inuse_nodes, [splice @node_column, 0];
	}

	#
	# Print that network.
	#
	my $column = scalar @node_stack;
	my @column_line = (0) x $column;
	my $string = "";

lib/Algorithm/Networksort.pm  view on Meta::CPAN

=back

=head2 Batcher's Merge Exchange algorithm.

=over 3

=item

Code for Kenneth Batcher's Merge Exchange algorithm was derived from Knuth's
The Art of Computer Programming, Vol. 3, section 5.2.2.

=back

=head2 Batcher's Bitonic algorithm

=over 3

=item

Kenneth Batcher, "Sorting Networks and their Applications", Proc. of the
AFIPS Spring Joint Computing Conf., Vol. 32, 1968, pp. 307-3114. A PDF of
this article may be found at L<http://www.cs.kent.edu/~batcher/sort.pdf>.

The paper discusses both the Odd-Even Merge algorithm and the Bitonic algorithm.

=item

Dr. Hans Werner Lang has written a detailed discussion of the bitonic
sort algorithm here:
L<http://www.iti.fh-flensburg.de/lang/algorithmen/sortieren/bitonic/bitonicen.htm>

=item

T. H. Cormen, E. E. Leiserson, R. L. Rivest, Introduction to Algorithms,
first edition, McGraw-Hill, 1990, section 28.3.

=item

T. H. Cormen, E. E. Leiserson, R. L. Rivest, C. Stein, Introduction to Algorithms,
2nd edition, McGraw-Hill, 2001, section 27.3.

=back

=head2 Algorithm discussion

=over 3

=item

Donald E. Knuth, B<The Art of Computer Programming, Vol. 3:
Sorting and Searching> (2nd ed.), Addison Wesley Longman Publishing Co., Inc.,
Redwood City, CA, 1998.

=item

Sherenaz W. Al-Haj Baddar and Kenneth E. Batcher,
B<Designing Sorting Networks: A New Paradigm>, Springer-Verlag, 2011

=item

Kenneth Batcher's web site (L<http://www.cs.kent.edu/~batcher/>) lists
his publications, including his paper listed above.

=back

=head1 AUTHOR

John M. Gamble may be found at B<jgamble@cpan.org>

=cut



( run in 0.768 second using v1.01-cache-2.11-cpan-df04353d9ac )