package Algorithm::Networksort;

use Carp;
use 5.006;
use strict;
use warnings;
use integer;

require Exporter;

our @ISA = qw(Exporter);

our %EXPORT_TAGS = (
	'all' => [ qw(
		nw_graph
		nw_group
		nw_comparators
		nw_format
		nw_sort
	) ],
);

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our $VERSION = '1.05';
our $flag_internal = 0;

my %nw_best = (
	(9,	# R. W. Floyd.
	 [[0,1], [3,4], [6,7], [1,2], [4,5], [7,8], [0,1], [3,4], [6,7],
	  [0,3], [3,6], [0,3], [1,4], [4,7], [1,4], [2,5], [5,8], [2,5],
	  [1,3], [5,7], [2,6], [4,6], [2,4], [2,3], [5,6]]),

	(10,	# A. Waksman.
	 [[4,9], [3,8], [2,7], [1,6], [0,5], [1,4], [6,9], [0,3], [5,8],
	  [0,2], [3,6], [7,9], [0,1], [2,4], [5,7], [8,9],
	  [1,2], [4,6], [7,8], [3,5], [2,5], [6,8], [1,3], [4,7],
	  [2,3], [6,7], [3,4], [5,6], [4,5]]),

	(11,	# 12-input by Shapiro and Green, minus the connections
		# to a twelfth input.
	 [[0,1], [2,3], [4,5], [6,7], [8,9],
	  [1,3], [5,7], [0,2], [4,6], [8,10],
	  [1,2], [5,6], [9,10], [1,5], [6,10],
	  [5,9], [2,6], [1,5], [6,10], [0,4],
	  [3,7], [4,8], [0,4], [1,4], [7,10], [3,8],
	  [2,3], [8,9], [2,4], [7,9], [3,5], [6,8], [3,4], [5,6], [7,8]]),

	(12,	# Shapiro and Green.
	 [[0,1], [2,3], [4,5], [6,7], [8,9], [10,11],
	  [1,3], [5,7], [9,11], [0,2], [4,6], [8,10],
	  [1,2], [5,6], [9,10], [1,5], [6,10],
	  [5,9], [2,6], [1,5], [6,10], [0,4], [7,11],
	  [3,7], [4,8], [0,4], [7,11], [1,4], [7,10], [3,8],
	  [2,3], [8,9], [2,4], [7,9], [3,5], [6,8], [3,4], [5,6], [7,8]]),

	(13,	# Generated by the END algorithm.
	 [[1,7], [9,11], [3,4], [5,8], [0,12], [2,6],
	  [0,1], [2,3], [4,6], [8,11], [7,12], [5,9],
	  [0,2], [3,7], [10,11], [1,4], [6,12], [7,8],
	  [11,12], [4,9], [6,10],
	  [3,4], [5,6], [8,9], [10,11], [1,7], [2,6],
	  [9,11], [1,3], [4,7], [8,10],
	  [0,5], [2,5], [6,8], [9,10], [1,2], [3,5], [7,8],
	  [4,6],
	  [2,3], [4,5], [6,7], [8,9], [3,4], [5,6]]),

	(14,	# Green's construction for 16 inputs minus comparators for
		# the fifteenth and sixteenth inputs.
	 [[0,1], [2,3], [4,5], [6,7], [8,9], [10,11], [12,13],
	  [0,2], [4,6], [8,10], [1,3], [5,7], [9,11],
	  [0,4], [8,12], [1,5], [9,13], [2,6], [3,7],
	  [0,8], [1,9], [2,10], [3,11], [4,12], [5,13],
	  [5,10], [6,9], [3,12],
	  [7,11], [1,2], [4,8], [1,4], [7,13], [2,8],
	  [2,4], [5,6], [9,10], [11,13], [3,8], [7,12],
	  [6,8], [10,12], [3,5], [7,9],
	  [3,4], [5,6], [7,8], [9,10], [11,12], [6,7], [8,9]]),

	(15,	# Green's construction for 16 inputs minus comparators for
		# the sixteenth input.
	 [[0,1], [2,3], [4,5], [6,7], [8,9], [10,11], [12,13],
	  [0,2], [4,6], [8,10], [12,14], [1,3], [5,7], [9,11],
	  [0,4], [8,12], [1,5], [9,13], [2,6], [10,14], [3,7],
	  [0,8], [1,9], [2,10], [3,11], [4,12], [5,13], [6,14],
	  [5,10], [6,9], [3,12], [13,14],
	  [7,11], [1,2], [4,8], [1,4], [7,13], [2,8], [11,14],
	  [2,4], [5,6], [9,10], [11,13], [3,8], [7,12],
	  [6,8], [10,12], [3,5], [7,9],
	  [3,4], [5,6], [7,8], [9,10], [11,12], [6,7], [8,9]]),

	(16,	# Green's construction.
	 [[0,1], [2,3], [4,5], [6,7], [8,9], [10,11], [12,13], [14,15],
	  [0,2], [4,6], [8,10], [12,14], [1,3], [5,7], [9,11], [13,15],
	  [0,4], [8,12], [1,5], [9,13], [2,6], [10,14], [3,7], [11,15],
	  [0,8], [1,9], [2,10], [3,11], [4,12], [5,13], [6,14], [7,15],
	  [5,10], [6,9], [3,12], [13,14],
	  [7,11], [1,2], [4,8], [1,4], [7,13], [2,8], [11,14],
	  [2,4], [5,6], [9,10], [11,13], [3,8], [7,12],
	  [6,8], [10,12], [3,5], [7,9],
	  [3,4], [5,6], [7,8], [9,10], [11,12], [6,7], [8,9]])
);

#
# Parameters for SVG and EPS graphing.
#
my %graphset = (
	hz_sep => 12,
	hz_margin => 18,
	vt_sep => 12,
	vt_margin => 21,
	indent => 9,
	stroke_width => 2,
	title => undef,
	namespace => undef,
);

#
# Parameters for text 'graphing'.
#
my %textset = (
	inputbegin => "o-",
	inputline => "---",
	inputcompline => "-|-",
	inputend => "-o\n",
	fromcomp => "-^-",
	tocomp => "-v-",
	gapbegin => "  ",
	gapcompline => " | ",
	gapnone => "   ",
	gapend => "  \n",
);

#
# Some forward declarations.
#
sub bn_split($$);
sub bn_merge($$$$);
sub semijoin($$@);

#
# @network = nw_comparators($input);
#
# The function that starts it all.  Return a list of comparators (a
# two-item list) that will sort an n-item list.  The default algorithm
# used is Bose-Nelson.
#
sub nw_comparators($%)
{
	my $inputs = shift;
	my %opts = @_;

	return () if ($inputs < 2);
	if (!defined $opts{algorithm} || $opts{algorithm} eq 'bosenelson')
	{
		return bosenelson($inputs);
	}
	
	if ($opts{algorithm} eq 'best')
	{
		return @{$nw_best{$inputs}} if (exists $nw_best{$inputs});
		carp "No 'best' network know for N = $inputs.  Using Bose-Nelson\n";
		return bosenelson($inputs);
	}

	if ($opts{algorithm} eq 'hibbard')
	{
		return hibbard($inputs);
	}

	if ($opts{algorithm} eq 'batcher')
	{
		return batcher($inputs);
	}

	carp "Unknown algorithm '", $opts{algorithm}, "'\n";
	return ();
}

#
# @network = hibbard($inputs);
#
# Return a list of two-element lists that comprise the comparators of a
# sorting network.
#
# Translated from the ALGOL listed in T. N. Hibbard's article, A Simple
# Sorting Algorithm, Journal of the ACM 10:142-50, 1963.
#
# The ALGOL code was overly dependent on gotos.  This has been changed.
#
sub hibbard($)
{ 
	my $inputs = shift;
	my @comparators;
	my($bit, $xbit, $ybit);

	#
	# $lastbit = ceiling(log2($inputs - 1)); but we'll
	# find it using the length of the bitstring.
	#
	my $lastbit = unpack("B32", pack("N", $inputs - 1));
	$lastbit =~ s/^0+//;
	$lastbit = 1 << (length $lastbit);

	#
	# $x and $y are the comparator endpoints.
	# We begin with values of zero and one.
	#
	my($x, $y) = (0, 1); 

	while (1 == 1)
	{
		#
		# Save the comparator pair, and calculate the next
		# comparator pair.
		#
		push @comparators, [$x, $y];
		print "Top of loop: ", nw_format(\@comparators) if ($flag_internal);

		#
		# Start with a check of X and Y's respective bits,
		# beginning with the zeroth bit.
		#
		$bit = 1;
		$xbit = $x & $bit;
	 	$ybit = $y & $bit; 

		#
		# But if the X bit is 1 and the Y bit is
		# zero, just clear the X bit and move on.
		#
 		while ($xbit != 0 and $ybit == 0)
		{
			$x &= ~$bit;

			$bit <<= 1;
			$xbit = $x & $bit;
	 		$ybit = $y & $bit; 
		}

 		if ($xbit != 0)		#  and $ybit != 0
		{
			$y &= ~$bit;
			next;
		}
 
		#
		# The X bit is zero if we've gotten this far.
		#
 		if ($ybit == 0)
		{
			$x |= $bit;
			$y |= $bit;
			$y &= ~$bit if ($y > $inputs - 1);
			next;
		}

		#
		# The X bit is zero, the Y bit is one, and we might
		# return the results.
		#
		do
		{
			return @comparators if ($bit == $lastbit);

			$x &= ~$bit;
			$y &= ~$bit;

			$bit <<= 1;	# Next bit.

			if ($y & $bit)
			{
				$x &= ~$bit;
				next;
			}

			$x |= $bit;
			$y |= $bit;
		} while ($y > $inputs - 1);

		#
		# No return, so loop onwards.
		#
		$bit = 1 if ($y < $inputs - 1); 
		$x &= ~$bit;
		$y |= $bit;
	}
}

#
# @network = bosenelson($inputs);
#
# The Bose-Nelson algorithm.
#
sub bosenelson($)
{
	my $inputs = shift;

	return () if ($inputs < 2);

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

	print "bn_split($i, $length)\n" if ($flag_internal);

	if ($length >= 2)
	{
		my $mid = $length/2;

		push @comparators, bn_split($i, $mid);
		push @comparators, bn_split($i + $mid, $length - $mid);
		push @comparators, bn_merge($i, $mid, $i + $mid, $length - $mid);
	}
	print "bn_split($i, $length) returns ", nw_format(\@comparators), "\n\n" if ($flag_internal);
	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 = ();

	print "bn_merge($i, $length_i, $j, $length_j)\n" if ($flag_internal);

	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 = $length_i/2;
		my $j_mid = ($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);
	}

	print "bn_merge($i, $length_i, $j, $length_j) returns ", nw_format(\@comparators), "\n\n" if ($flag_internal);
	return @comparators;
}

#
# @network = batcher($inputs);
#
# Batcher's sort as laid out in Knuth, Sorting and Searching, algorithm 5.2.2M.
#
sub batcher($)
{
	my $inputs = shift;
	my @network;

	return () if ($inputs < 2);

	#
	# $t = ceiling(log2($inputs)); but we'll
	# find it using the length of the bitstring.
	#
	my $t = unpack("B32", pack("N", $inputs));
	$t =~ s/^0+//;
	$t = length $t;

	my $p = 1 << ($t -1);

	while ($p > 0)
	{
		my $q = 1 << ($t -1);
		my $r = 0;
		my $d = $p;

		while ($d > 0)
		{
			for (my $i = 0; $i < $inputs - $d; $i++)
			{
				push @network, [$i, $i + $d] if (($i & $p) == $r);
			}

			$d = $q - $p;
			$q >>= 1;
			$r = $p;
		}
		$p >>= 1;
	}

	return @network;
}

#
# $array_ref = nw_sort(\@network, \@array);
#
# Use the network of comparators (in @network) to sort the elements
# in @array.  Returns the reference to the array, which is sorted
# in-place.
#
sub nw_sort($$)
{
	my $network = shift;
	my $array = shift;

	foreach my $comparator (@$network)
	{
		my($left, $right) = @$comparator;

		if (($$array[$left] <=> $$array[$right]) == 1)
		{
			@$array[$left, $right] = @$array[$right, $left];
		}

		if ($flag_internal) {foreach my $elem (@$array){print $elem;} print "  ";}
	}

	print "\n" if ($flag_internal);
	return $array;
}

#
# $string = nw_format(\@network, $cmp_format, $swap_format, \@index_base);
#
# Return a string that represents the comparators.  Default format is
# an array of arrays, in standard perl form
#
sub nw_format($;$$$)
{
	my($network, $cmp_format, $swap_format, $index_base) = @_;
	my $string = '';

	if (scalar @$network == 0)
	{
		carp "No network to format.\n";
		return "";
	}

	if (defined $cmp_format)
	{
		foreach my $comparator(@$network)
		{
			@$comparator = @$index_base[@$comparator] if (defined $index_base);

			$string .= sprintf($cmp_format, @$comparator);
			$string .= sprintf($swap_format, @$comparator) if ($swap_format);
		}
	}
	else
	{
		$string = '[';
		foreach my $comparator (@$network)
		{
			@$comparator = @$index_base[@$comparator] if (defined $index_base);

			$string .= "[" . join(",", @$comparator) . "],";
		}

		if ($string eq '[')
		{
			$string .= ']';
		}
		else
		{
			substr($string, -1, 1) = "]";
		}
	}

	return $string;
}

#
# @new_grouping = nw_group(\@network, $inputs);
#
# Take a list of comparators, and transform it into a list of a list of
# comparators, each sub-list representing a group that can be printed
# in a single column.  This makes it easier for the nw_graph routines to
# render a visual representation of the network.
#
sub nw_group($$;%)
{
	my $network = shift;
	my $inputs = shift;
	my %opts = @_;

	my @node_range_stack;
	my @node_stack;

	#
	# Group the comparator nodes into columns.
	#
	foreach my $comparator (@$network)
	{
		my($from, $to) = @$comparator;

		#
		# How much of a column becomes untouchable depends upon whether
		# we are trying to print out comparators in a single column, or
		# whether we are just trying to arrange comparators in a single
		# column without concern for overlap.
		#
		my @range = (exists $opts{grouping} and $opts{grouping} eq "parallel")?
				($from, $to):
				($from..$to);
		my $col = scalar @node_range_stack;

		#
		# Search back through the stack of columns to see if
		# we can fit the comparator in an existing column.
		#
		while (--$col >= 0)
		{
			last if (grep{$_ != 0} @{$node_range_stack[$col]}[@range]);
		}

		#
		# If even the top column can't fit it in, make a
		# new, empty top.
		#
		if (++$col == scalar(@node_range_stack))
		{
			push @node_range_stack, [(0) x $inputs];
		}

		@{$node_range_stack[$col]}[@range] = (1) x (scalar @range);

		#
		# Autovivification creates the [$col] array element
		# if it doesn't currently exist.
		#
		push @{$node_stack[$col]}, $comparator;
	}

	#push @node_stack, [sort {${$a}[0] <=> ${$b}[0]} splice @nodes, 0] if (@nodes);
	return @node_stack;
}

#
# $string = nw_graph(\@network, $inputs, %options);
#
# Returns a string that contains the network in a graphical format.
#
sub nw_graph($$;%)
{
	my $network = shift;
	my $inputs = shift;
	my %print_opts = @_;

	if (scalar @$network == 0)
	{
		carp "No network to graph.\n";
		return "";
	}

	if (!exists $print_opts{graph} or $print_opts{graph} eq "text")
	{
		foreach my $k (keys %textset)
		{
			$print_opts{$k} = $textset{$k} unless (exists $print_opts{$k});
		}
		return nw_text_graph($network, $inputs, %print_opts);
	}
	elsif ($print_opts{graph} eq "eps")
	{
		foreach my $k (keys %graphset)
		{
			$print_opts{$k} = $graphset{$k} unless (exists $print_opts{$k});
		}
		return nw_eps_graph($network, $inputs, %print_opts);
	}
	elsif ($print_opts{graph} eq "svg")
	{
		foreach my $k (keys %graphset)
		{
			$print_opts{$k} = $graphset{$k} unless (exists $print_opts{$k});
		}
		return nw_svg_graph($network, $inputs, %print_opts);
	}

	carp "Unknown 'graph' type '" . $print_opts{graph} . "'.\n";
	return "";
}

#
# $string = nw_eps_graph(\@network, $inputs, %graphing_options);
#
# Returns a string that contains the network in an EPS format.
#
sub nw_eps_graph($$%)
{
	my $network = shift;
	my $inputs = shift;
	my %grset = @_;

	my @node_stack = nw_group($network, $inputs);
	my $columns = scalar @node_stack;

	my(@vcoord, @hcoord, @vdef, @hdef);

	for (my $idx = 0; $idx < $inputs; $idx++)
	{
		$vcoord[$idx] = $idx * ($grset{vt_sep} + $grset{stroke_width}) +
			$grset{vt_margin};
	}

	for (my $idx = 0; $idx < $columns; $idx++)
	{
		$hcoord[$idx] = $idx * ($grset{hz_sep} + $grset{stroke_width}) +
			$grset{hz_margin} + $grset{indent};
	}

	my $xbound = $hcoord[$columns - 1] + $grset{hz_margin} + $grset{indent};
	my $ybound = $vcoord[$inputs - 1] + $grset{vt_margin};
	my $title = $grset{title} || "N = $inputs Sorting Network.";

	#
	# A long involved piece to create the necessary DSC, the subroutine
	# definitions, arrays of vertical and horizontal coordinates, and
	# left and right margin definitions.
	#
	my $string =
		"%!PS-Adobe-3.0 EPSF-3.0\n%%BoundingBox: 0 0 $xbound $ybound\n%%CreationDate: " .
		localtime() .
		"\n%%Creator: perl module " . __PACKAGE__ . " version $VERSION." .
		"\n%%Title: $title\n%%Pages: 1\n%%EndComments\n%%Page: 1 1\n" .
q(
% column inputline1 inputline2 draw-comparatorline
/draw-comparatorline {
    vcoord exch get 3 1 roll vcoord exch get
    3 1 roll hcoord exch get 3 1 roll 2 index exch % x1 y1 x1 y2
    newpath 2 copy currentlinewidth 0 360 arc gsave stroke grestore fill moveto
    2 copy lineto stroke currentlinewidth 0 360 arc gsave stroke grestore fill
} bind def

% inputline draw-inputline
/draw-inputline {
    vcoord exch get leftmargin exch dup rightmargin exch % x1 y1 x2 y1 
    newpath 2 copy currentlinewidth 0 360 arc moveto
    2 copy lineto currentlinewidth 0 360 arc stroke
} bind def

) .
		"/vcoord [" .
		join("\n    ", semijoin(' ', 16, @vcoord)) . "] def\n/hcoord [" .
		join("\n    ", semijoin(' ', 16, @hcoord)) . "] def\n\n" .
		"/leftmargin $grset{hz_margin} def\n/rightmargin " .
		($xbound - $grset{hz_margin}) . " def\n\n";

	#
	# Save the current graphics state, then change the default line width,
	# and the drawing coordinates from (0,0) = lower left to an upper left
	# origin.
	#
	$string .= "gsave\n$grset{stroke_width} setlinewidth\n0 $ybound translate\n1 -1 scale\n";

	#
	# Draw the input lines.
	#
	$string .= "\n%\n% Draw the input lines.\n%\n0 1 " . ($inputs-1) . " {draw-inputline} for\n";

	#
	# Draw our comparators.
	# Each member of a group of comparators is drawn in the same
	# column
	#
	$string .= "\n%\n% Draw the comparator lines.\n%\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 .= "showpage\ngrestore\n% End of the EPS graph.";
	return $string;
}

#
# $string = nw_svg_graph(\@network, $inputs, %graphing_options);
#
# Return a graph of the network in Scalable Vector Graphics.
# Measurements are in pixels. 0,0 is the upper left corner.
#
sub nw_svg_graph($$%)
{
	my $network = shift;
	my $inputs = shift;
	my %grset = @_;

	my @node_stack = nw_group($network, $inputs);
	my $columns = scalar @node_stack;
	my(@vcoord, @hcoord);
	my($ns, $string);

	for (my $idx = 0; $idx < $inputs; $idx++)
	{
		$vcoord[$idx] = $idx * ($grset{vt_sep} + $grset{stroke_width}) +
			$grset{vt_margin};
	}

	for (my $idx = 0; $idx < $columns; $idx++)
	{
		$hcoord[$idx] = $idx * ($grset{hz_sep} + $grset{stroke_width}) +
			$grset{hz_margin} + $grset{indent};
	}

	my $xbound = $hcoord[$columns - 1] + $grset{hz_margin} + $grset{indent};
	my $ybound = $vcoord[$inputs - 1] + $grset{vt_margin};
	my $title = $grset{title} || "N = $inputs Sorting Network.";

	if (defined $grset{namespace})
	{
		$string = "<$grset{namespace}:svg xmlns:$grset{namespace}=\"http://www.w3.org/2000/svg\" " .
			"width=\"$xbound\" height=\"$ybound\">\n";
		$ns = $grset{namespace} . ":";
	}
	else
	{
		$string = "<svg width=\"$xbound\" height=\"$ybound\">\n";
		$ns = "";
	}

	$string .= "    <" . $ns . "desc>\n" .
			"        CreationDate: " . localtime() . "\n" .
			"        Creator: perl module " . __PACKAGE__ . " version $VERSION.\n" .
			"    </" . $ns . "desc>\n    <" . $ns . "title>$title</" . $ns . "title>\n";

	#
	# Define the input line template.
	#
	$string .= "    <" . $ns . "defs>\n";
	$string .= "        <!-- Define the input lines. -->\n";
	$string .= "        <" . $ns . "g id=\"inputline\" style=\"fill:none; stroke:black; stroke-width:$grset{stroke_width}\" >\n";
	$string .= "            <" . $ns . "desc>Input line.</" . $ns . "desc>\n";
	$string .= "            <" . $ns . "circle cx=\"$grset{hz_margin}\" cy=\"0\" r=\"$grset{stroke_width}\" />\n";
	$string .= "            <" . $ns . "line x1=\"$grset{hz_margin}\" y1=\"0\" x2=\"" .
				($hcoord[$columns - 1] + $grset{indent}) . "\" y2=\"0\" />\n";
	$string .= "            <" . $ns . "circle cx=\"" . ($hcoord[$columns - 1] + $grset{indent}) .
				"\" cy=\"0\" r=\"$grset{stroke_width}\" />\n";
	$string .= "        </" . $ns . "g>\n";
	$string .= "        <!-- Now the comparator lines, which come in different lengths. -->\n";

	#
	# Define the comparator templates, which are of varying lengths.
	#
	my %cmptr_defd;
	for my $comparator (@$network)
	{
		my($from, $to) = @$comparator;
		my $cmptr_len = $to - $from;
		unless (defined $cmptr_defd{$cmptr_len})
		{
			my $endpoint = $vcoord[$to] - $vcoord[$from];
			$cmptr_defd{$cmptr_len} = 1;
			$string .=
			"        <" . $ns . "g id=\"comparator$cmptr_len\" style=\"fill:black; stroke:black; stroke-width:$grset{stroke_width}\" >\n" .
			"            <" . $ns . "desc>Comparator size $cmptr_len.</" . $ns . "desc>\n" .
			"            <" . $ns . "circle cx=\"0\" cy=\"0\" r=\"$grset{stroke_width}\" />\n" .
			"            <" . $ns . "line x1=\"0\" y1=\"0\" x2=\"0\" y2=\"$endpoint\" />\n" .
			"            <" . $ns . "circle cx=\"0\" cy=\"$endpoint\" r=\"$grset{stroke_width}\" />\n" .
			"        </" . $ns . "g>\n";
		}
	}

	#
	# End of definitions.  Draw the input lines.
	#
	$string .= "    </" . $ns . "defs>\n\n    <!-- Draw the input lines. -->\n";
	for (my $idx = 0; $idx < $inputs; $idx++)
	{
		$string .= "    <" . $ns . "use xlink:href=\"#inputline\" y = \"" . $vcoord[$idx] . "\" />\n";
	}

	#
	# Draw our comparators.
	# Each member of a group of comparators is drawn in the same
	# column
	#
	$string .= "\n    <!-- Draw the comparator lines. -->\n";
	my $hidx = 0;
	for my $group (@node_stack)
	{
		for my $comparator (@$group)
		{
			my($from, $to) = @$comparator;
			my $cmptr_len = $to - $from;

			$string .= "    <" . $ns . "use xlink:href=\"#comparator$cmptr_len\" x = \"" .
					$hcoord[$hidx] . "\" y = \"" . $vcoord[$from] . "\" />\n";
		}
		$hidx++;
	}

	$string .= "</" . $ns . "svg>\n";
	return $string;
}

#
# $string = nw_text_graph(\@network, $inputs, %graphing_options);
#
# Return a graph of the network in text.
#
sub nw_text_graph($$%)
{
	my $network = shift;
	my $inputs = shift;
	my %txset = @_;

	my @node_stack = nw_group($network, $inputs);
	my $column = 0;
	my $string = "";
	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];
		$column++;
	}

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

	for my $row (0..$inputs-1)
	{
		#
		# Begin with the input line...
		#
		$string .= $txset{inputbegin};

		for my $col (0..$column-1)
		{
			my @node_column = @{$inuse_nodes[$col]};

			if ($node_column[$row] == 0)
			{
				$string .= $txset{($column_line[$col] == 1)? 'inputcompline': 'inputline'};
			}
			elsif ($node_column[$row] == 1)
			{
				$string .= $txset{fromcomp};
			}
			else
			{
				$string .= $txset{tocomp};
			}
			$column_line[$col] += $node_column[$row];
		}

		$string .= $txset{inputend};

		#
		# Now print the space in between input lines.
		#
		if ($row != $inputs-1)
		{
			$string .= $txset{gapbegin};

			for my $col (0..$column -1)
			{
				$string .= $txset{($column_line[$col] == 0)? 'gapnone': 'gapcompline'};
			}

			$string .= $txset{gapend};
		}
	}

	return $string;
}

#
# @newlist = semijoin($expr, $itemcount, @list);
#
# $expr      - A string to be used in a join() call.
# $itemcount - The number of items in a list to be joined.
#	      It may be negative.
# @list      - The list
#
# Create a new list by performing a join on I<$itemcount> elements at a
# time on the original list. Any leftover elements from the end of the
# list become the last item of the new list, unless I<$itemcount> is
# negative, in which case the first item of the new list is made from the
# leftover elements from the front of the list.
#
sub semijoin($$@)
{
	my($jstr, $itemcount, @oldlist) = @_;
	my($idx);
	my(@newlist) = ();

	return @oldlist if ($itemcount <= 1 and $itemcount >= -1);

	if ($itemcount > 0)
	{
		push @newlist, join $jstr, splice(@oldlist, 0, $itemcount) while @oldlist;
	}
	else
	{
		$itemcount = -$itemcount;
		unshift @newlist, join $jstr, splice(@oldlist, -$itemcount, $itemcount)
			while $itemcount <= @oldlist;
		unshift @newlist, join $jstr, splice( @oldlist, 0, $itemcount) if @oldlist;
	}

	return @newlist;
}

1;
__END__

=head1 NAME

Algorithm::Networksort - Create inline comparisons for sorting.

=head1 SYNOPSIS

  use Algorithm::Networksort qw(:all);

  my $inputs = 4;

  #
  # Generate the network (a list of comparators).
  #
  my @network = nw_comparators($inputs);

  #
  # Print the list, and print the graph of the list.
  #
  print nw_format(\@network, $inputs), "\n";
  print nw_graph(\@network, $inputs), "\n";

=head1 PREREQUISITES

Perl 5.6 or later. This is the version of perl under which this module
was developed.

=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 used in software with a compiler
that can take advantage of parallelism. Unfortunately a 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.

This module's main purpose is to create compare-and-swap macros (or
functions, or templates) that one may insert into source code. It may
also be used to create images of the networks in either encapsulated
postscript (EPS), scalar vector graphics (SVG), or in "ascii art" format.

=head2 Export

None by default. There is only one available export tag, ':all', which
exports the functions to create and use sorting networks. The functions are
nw_comparator(), nw_format(), nw_graph(), nw_group(), and nw_sort().

=head2 Functions

=over 4

=item nw_comparator()

    @network = nw_comparator($inputs);

    @network1 = nw_comparator($inputs, algorithm => $alg);

Returns a list of comparators that can sort B<$inputs>
items. The algorithm for generating the list may be chosen, but by default the
network is generated by the Bose-Nelson algorithm. The different methods will
produce different networks in general, although in some cases the differences
will be in the arrangement of the comparators, not in their number.

The choices for B<algorithm> are

=over 2

=item 'bosenelson'

Use the Bose-Nelson algorithm to generate the network. This is the most
commonly implemented algorithm, recursive and simple to code.

=item 'hibbard'

Use Hibbard's algorithm. This iterative algorithm was developed after the
Bose-Nelson algorithm was published, and produces a different network
"... for generating the comparisons one by one in the order in which
they are needed for sorting," according to his article (see below).

=item 'batcher'

Use Batcher's Merge Exchange algorithm. Merge Exchange is a real sort, in
that in its usual form (for example, as described in Knuth) it can handle
a variety of inputs. But when sorting it always generates the same
comparison pairs for a given input size, which lends itself to network sorting.

=item 'best'

For some inputs, networks have been discovered that are more efficient
than those generated by rote algorithms. When 'best' is specified one
of these are returned instead. The term "best" does not actually guarantee
the best network for all cases. It simply means that at the time of this
version of the module, the network returned has the lowest number of
comparators for the number of inputs. Considerations of parallelism, or of
other networks with an equally low comparator count but different arrangement
are ignored.

Currently more efficient networks have been discoverd for inputs of
nine through sixteen. If you choose 'best' outside of this range the module
will fall back to Bose-Nelson.

=back

=item nw_format()

    $string = nw_format(\@network, $format1, $format2, \@index_base);

Returns a formatted string that represents the list of comparators.
There are two sprintf-style format strings, which lets you separate
the comparison and exchange portions if you want. The second format
string is optional.

The first format string may also be ignored, in which case the default
format will be used: an array of arrays as represented in perl.

The network sorting pairs are zero-based. If you want the pairs written out
for some other sequence other than 0, 1, 2, ... then you can provide that in
an array reference.

Example 0: you want a string in the default format.

    print nw_format(\@network);

Example 1: you want the output to look like the default format, but one-based instead of zero-based.

    print nw_format(\@network,
                undef,
                undef,
                [1..$inputs]);

Example 2: you want a simple list of SWAP macros.

    print nw_format(\@network, "SWAP(%d, %d);\n");

Example 3: as with example 2, but the SWAP values need to be one-based instead of zero-based.

    print nw_format(\@network,
                "SWAP(%d, %d);\n",
                undef,
                [1..$inputs]);

Example 4: you want a series of comparison and swap statements.

    print nw_format(\@network,
                "if (v[%d] < v[%d]) then\n",
                "    exchange(v, %d, %d)\nend if\n");

Example 5: you want the default format to use letters, not numbers.

    my @alphabase = ('a'..'z')[0..$inputs];

    my $string = '[' .
            nw_format(\@network,
		"[%s,%s],",      # Note that we're using the string flag.
		undef,
		\@alphabase);

    substr($string, -1, 1) = ']';    # Overwrite the trailing comma.
    print $string;


=item nw_graph()

Returns a string that graphs out the comparators in a network. The format
may be encapsulated postscript (graph=>'eps'), scalar vector graphics
(graph=>'svg'), or the default plain text (graph=>'text' or none). The 'text'
and 'eps' options produce output that is self-contained. The 'svg' option
produces output between E<lt>svgE<gt> and E<lt>/svgE<gt> tags, which needs
to be combined with XML code in order to be viewed.

    my $inputs = 4;
    my @network = nw_comparators($inputs);
    $netgraph = nw_graph(\@network, $inputs, graph=>'svg');

    print "<?xml version=\"1.0\" standalone=\"no\"?>\n",
	"<!DOCTYPE svg PUBLIC \"-//W3C//DTD SVG 20001102//EN\"\n",
        "         \"http://www.w3.org/TR/2000/CR-SVG-20001102/DTD/" .
	"svg-20001102.dtd\">\n",
	$netgraph;

The 'graph' option is not the only one available. The graphing can be
adjusted to your needs using the following options.

=head2 Options for 'svg' only.

=over 2

=item namespace

I<Default value: undef.>
A tag prefix that allows programs to distinguish between different XML
vocabularies that have the same tag. If undefined, no tag is used.

=back

=head2 Options for 'svg' and 'eps' graphs

=over 2

=item hz_margin

I<Default value: 18.>
The horizontal spacing between the edges of the graphic and the
network.

=item hz_sep

I<Default value: 12.>
The spacing separating the horizontal lines (the input lines).

=item indent

I<Default value: 9.>
The indention between the start of the input lines and the placement of
the first comparator. The same value spaces the placement of the final
comparator and the end of the input lines.

=item stroke_width

I<Default value: 2.>
Width of the lines used to define comparators and input lines. Also
represents the radii of the endpoint circles.

=item title

I<Default value: "N = $inputs Sorting Network.">
Title of the graph. It should be a short one-line description.

=item vt_margin

I<Default value: 21.>
The vertical spacing between the edges of the graphic and the network.

=item vt_sep

I<Default value: 12.>
The spacing separating the vertical lines (the comparators).

=back

=head2 Options for the 'text' graph

=over 2

=item inputbegin

I<Default value: "o-".>
The starting characters for the input line.

=item inputline

I<Default value: "---".>
The characters that make up an input line.

=item inputcompline

I<Default value: "-|-".>
The characters that make up an input line that has a comparator crossing
over it.

=item inputend

I<Default value: "-o\n".>
The characters that make up the end of an input line.

=item fromcomp

I<Default value: "-^-".>
The characters that make up an input line with the starting point of
a comparator.

=item tocomp

I<Default value: "-v-".>
The characters that make up an input line with the end point of
a comparator.

=item gapbegin

I<Default value: "  " (two spaces).>
The characters that start the gap between the input lines.

=item gapcompline

I<Default value: " | " (space vertical bar space).>
The characters that make up the gap with a comparator passing through.

=item gapnone

I<Default value: "  " (three spaces).>
The characters that make up the space between the input lines.

=item gapend

I<Default value: "  \n" (two spaces and a newline).>
The characters that end the gap between the input lines.

=back

=item nw_group()

This is a function called by nw_graph(). The function takes
the comparator list and returns a list of comparator lists, each sub-list
representing a group of comparators that can be printed in a single column.
There is one option available, 'grouping', that will produce a grouping that
represents parallel operations of comparators.

The chances that you will need to use it are slim, but the following code snippet
may represent an example:

    my $inputs = 8;
    my @network = nw_comparators($inputs);
    my @grouped_network = nw_group(\@network, $inputs, grouping=>'parallel');

    print "There are ", scalar @network,
        " comparators in this network, grouped into\n",
        scalar @grouped_network, " parallel operations.\n\n";

    foreach my $group (@grouped_network)
    {
        print nw_format($group), "\n";
    }

    @grouped_network = nw_group(\@network, $inputs);
    print "\nThis will be graphed in ", scalar @grouped_network,
        " columns.\n";

This will produce:

    There are 19 comparators in this network, grouped into 6 parallel operations.

    [[0,4],[1,5],[2,6],[3,7]]
    [[0,2],[1,3],[4,6],[5,7]]
    [[2,4],[3,5],[0,1],[6,7]]
    [[2,3],[4,5]]
    [[1,4],[3,6]]
    [[1,2],[3,4],[5,6]]

    This will be graphed in 11 columns.

=item nw_sort()

Sort an array using the network. This is meant for testing purposes
only - looping around an array of comparators in order to sort an
array in an interpreted language is not the most efficient mechanism
for using a sorting network.

This function uses the C<< <=> >> operator for comparisons.

    my @digits = (1, 8, 3, 0, 4, 7, 2, 5, 9, 6);
    my @network = nw_comparators(scalar @digits, algorithm => 'best');
    nw_sort(\@network, \@digits);
    print join(", ", @digits);

=back

=head1 SEE ALSO

=head2 Bose and Nelson's algorithm.

=over 2

=item

Bose and Nelson, "A Sorting Problem", Journal of the ACM, Vol. 9, 1962, pp. 282-296.

=item

Frederick Hegeman, "Sorting Networks", The C/C++ User's Journal, February 1993.

=item

Joseph Celko, "Bose-Nelson Sort", Doctor Dobb's Journal, September 1985.

=back

=head2 Hibbard's algorithm.

=over 2

=item

T. N. Hibbard, "A Simple Sorting Algorithm", Journal of the ACM Vol. 10, 1963, pp. 142-50.

=back

=head2 Batcher's Merge Exchange algorithm.

=over 2

=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.

Batcher has written two other sorting algorithms that can generate network
sorting pairs, the "Odd-Even" algorithm and the "Bitonic" algorithm. His paper
on them can be found on his web site:
L<http://trident.mcs.kent.edu/~batcher/>.

Kenneth Batcher, "Sorting Networks and their Applications", Proc. of the
AFIPS Spring Joint Computing Conf., Vol. 32, 1968, pp. 307-3114. 

=item

Forbes D. Lewis, "Sorting Networks"
L<http://cs.engr.uky.edu/~lewis/essays/algorithms/sortnets/sort-net.html>

=back

=head2 Non-algorithmic discoveries

=over 2

=item

Ian Parberry, "A computer assisted optimal depth lower bound for sorting networks with nine inputs", 
L<http://hercule.csci.unt.edu/~ian/papers/9-input.ps>.

=item

The Evolving Non-Determinism (END) algorithm has found more efficient networks:
L<http://www.cs.brandeis.edu/~hugues/sorting_networks.html>.

=back

=head2 Algorithm discussion

=over 2

=item

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

=item

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

=back

=head1 AUTHOR

John M. Gamble may be found at B<jgamble@ripco.com>

=cut