view release on metacpan or  search on metacpan

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

}

=head3 comparators()

The comparators in their 'raw' form, as generated by its algorithm.

For the comparators re-ordered in such a way as to take advantage
of parallelism, see L<network()>.

=head3 network()

Returns the comparators re-ordered from the 'raw' form, providing a
parallelized version of the comparator list; e.g., the best order possible
to prevent stalling in a CPU's pipeline.

This is the form used when printing the sorting network using L<formats()>.

=cut

=head3 algorithm_name()

Return the full text name of the algorithm, given its key name.

=cut

sub algorithm_name
{
	my $self = shift;
	my $algthm = $_[0] // $self->algorithm();

	return $algname{$algthm} if (defined $algthm);
	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);

	#
	# $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)
	{
		#
		# Save the comparator pair, and calculate the next
		# comparator pair.
		#
		### hibbard() top of loop:
		##### @comparators
		#
		push @comparators, [$x, $y];

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

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

		$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