File Coverage

blib/lib/Algorithm/Networksort.pm
Criterion Covered Total %
statement 276 454 60.7
branch 87 136 63.9
condition 18 34 52.9
subroutine 30 41 73.1
pod 11 27 40.7
total 422 692 60.9


line stmt bran cond sub pod time code
1             package Algorithm::Networksort;
2              
3 5     5   64117 use 5.010001;
  5         15  
4              
5 5     5   3028 use Moose;
  5         1876836  
  5         29  
6 5     5   26718 use Moose::Exporter;
  5         16  
  5         27  
7 5     5   199 use namespace::autoclean;
  5         7  
  5         40  
8              
9 5     5   365 use Carp;
  5         7  
  5         335  
10 5     5   3707 use integer;
  5         50  
  5         20  
11              
12             #
13             # Three # for "I am here" messages, four # for variable dumps.
14             # Five # for sort tracking.
15             #
16             #use Smart::Comments ('####');
17              
18             #
19             # Export a couple of convenience functions:
20             # nwsrt(), which is shorthand for Algorithm::Networksort->new();
21             # and algorithms(), which gives a list of algorithm keys.
22             #
23             Moose::Exporter->setup_import_methods(
24             as_is => [\&nwsrt_algorithms, \&nwsrt],
25             );
26              
27             our $VERSION = '2.00';
28              
29             #
30             # Our one use of overload, because default
31             # printing is useful.
32             #
33             use overload
34 5     5   372 '""' => \&_stringify;
  5         8  
  5         46  
35              
36             #
37             # Names for the algorithm keys.
38             #
39             my %algname = (
40             bosenelson => "Bose-Nelson Sort",
41             batcher => "Batcher's Mergesort",
42             hibbard => "Hibbard's Sort",
43             bubble => "Bubble Sort",
44             bitonic => "Bitonic Sort",
45             oddeventrans => "Odd-Even Transposition Sort",
46             balanced => "Balanced",
47             oddevenmerge => "Batcher's Odd-Even Merge Sort",
48             );
49              
50             #
51             # Default parameters for SVG, EPS, and text graphing.
52             #
53             my %graphset = (
54             hz_sep => 12,
55             hz_margin => 18,
56             vt_sep => 12,
57             vt_margin => 21,
58             indent => 9,
59             radius => 2,
60             stroke_width => 2,
61             inputbegin => "o-",
62             inputline => "---",
63             inputcompline => "-|-",
64             inputend => "-o\n",
65             compbegin => "-^-",
66             compend => "-v-",
67             gapbegin => " ",
68             gapcompline => " | ",
69             gapnone => " ",
70             gapend => " \n",
71             );
72              
73             #
74             # Default graphing color parameters.
75             #
76             my %colorset = (
77             foreground => undef,
78             inputbegin => undef,
79             inputline => undef,
80             inputend => undef,
81             compline=> undef,
82             compbegin => undef,
83             compend => undef,
84             background => undef,
85             );
86              
87             has algorithm => (
88             isa => 'Str', is => 'ro',
89             default => 'bosenelson',
90             );
91              
92             has inputs => (
93             isa => 'Int', is => 'ro', required => 1,
94             );
95              
96             has nwid => (
97             isa => 'Str', is => 'rw', required => 0,
98             predicate => 'has_nwid',
99             );
100              
101             has comparators => (
102             isa => 'ArrayRef[ArrayRef[Int]]', is => 'rw', required => 0,
103             predicate => 'has_comparators',
104             );
105              
106             has network => (
107             isa => 'ArrayRef[ArrayRef[Int]]', is => 'rw', required => 0,
108             predicate => 'has_network',
109             );
110              
111             has ['depth', 'length'] => (
112             isa => 'Int', is => 'rw', required => 0,
113             init_arg => 0,
114             );
115              
116             has creator => (
117             isa => 'Str', is => 'ro', required => 0,
118             default => sub { return "Perl module " . __PACKAGE__ . ", " .
119             "version $VERSION";}
120             );
121              
122             has title => (
123             isa => 'Str', is => 'rw', required => 0,
124             predicate => 'has_title'
125             );
126              
127             has formats => (
128             isa => 'ArrayRef[Str]', is => 'rw', required => 0,
129             init_arg => undef,
130             );
131              
132             has grouped_format => (
133             isa => 'Str', is => 'rw', required => 0,
134             default => "%s,\n",
135             );
136              
137             has index_base => (
138             isa => 'ArrayRef[Value]', is => 'rw', required => 0,
139             );
140              
141             #
142             # Variables to track sorting statistics
143             #
144             my $swaps = 0;
145              
146             =pod
147              
148             =encoding UTF-8
149              
150             =head1 NAME
151              
152             Algorithm::Networksort - Create Sorting Networks.
153              
154             =begin html
155              
156             <svg xmlns="http://www.w3.org/2000/svg"
157             xmlns:xlink="http://www.w3.org/1999/xlink" width="105" height="61" viewbox="0 0 105 61">
158             <rect width="100%" height="100%" fill="#c8c8c8" />
159             <defs>
160             <g id="I_41c1" style="fill:none; stroke-width:2" >
161             <circle style="stroke:#206068" cx="18" cy="0" r="2" />
162             <line style="stroke:#206068" x1="18" y1="0" x2="87" y2="0" />
163             <circle style="stroke:#206068" cx="87" cy="0" r="2" />
164             </g>
165              
166             <g id="C1_41c1" style="stroke-width:2" >
167             <line style="fill:#206068; stroke:#206068" x1="0" y1="0" x2="0" y2="15" />
168             <circle style="fill:#206068; stroke:#206068" cx="0" cy="0" r="2" />
169             <circle style="fill:#206068; stroke:#206068" cx="0" cy="15" r="2" />
170             </g>
171             <g id="C2_41c1" style="stroke-width:2" >
172             <line style="fill:#206068; stroke:#206068" x1="0" y1="0" x2="0" y2="30" />
173             <circle style="fill:#206068; stroke:#206068" cx="0" cy="0" r="2" />
174             <circle style="fill:#206068; stroke:#206068" cx="0" cy="30" r="2" />
175             </g>
176             </defs>
177              
178             <g id="N_41c1">
179             <use xlink:href="#I_41c1" y="8" /> <use xlink:href="#I_41c1" y="23" />
180             <use xlink:href="#I_41c1" y="38" /> <use xlink:href="#I_41c1" y="53" />
181              
182             <use xlink:href="#C1_41c1" x="27" y="8" /> <use xlink:href="#C1_41c1" x="27" y="38" />
183             <use xlink:href="#C2_41c1" x="44" y="8" /> <use xlink:href="#C2_41c1" x="61" y="23" />
184             <use xlink:href="#C1_41c1" x="78" y="23" />
185             </g>
186             </svg>
187              
188             =end html
189              
190             =head1 SYNOPSIS
191              
192             use Algorithm::Networksort;
193              
194             my $inputs = 4;
195             my $algorithm = "bosenelson";
196              
197             #
198             # Generate the sorting network (a list of comparators).
199             #
200             my $nw = Algorithm::Networksort->new(inputs =>$inputs
201             algorithm => $algorithm);
202              
203             #
204             # Print the comparator list using the default format,
205             # and print a graph of the list.
206             #
207             print $nw->formatted(), "\n";
208             print $nw->graph_text(), "\n";
209              
210             #
211             # Set up a pretty SVG image.
212             #
213             $nw->graphsettings(vt_margin => 8, vt_sep => 13, hz_sep=>15);
214             $nw->colorsettings(foreground => "#206068", background => "#c8c8c8");
215             print $nw->graph_svg();
216              
217             =head1 DESCRIPTION
218              
219             This module will create sorting networks, a sequence of comparisons
220             that do not depend upon the results of prior comparisons.
221              
222             Since the sequences and their order never change, they can be very
223             useful if deployed in hardware, or if used in software with a compiler
224             that can take advantage of parallelism. Unfortunately a sorting network cannot
225             be used for generic run-time sorting like quicksort, since the arrangement of
226             the comparisons is fixed according to the number of elements to be
227             sorted.
228              
229             This module's main purpose is to create compare-and-swap macros (or
230             functions, or templates) that one may insert into source code. It may
231             also be used to create images of the sorting networks in either encapsulated
232             postscript (EPS), scalar vector graphics (SVG), or in "ascii art" format.
233              
234             =head2 Exported Functions
235              
236             For convenience's sake, there are two exported functions to save typing
237             and inconvenient look-ups.
238              
239             =head3 nwsrt()
240              
241             Simple function to save the programmer from the agony of typing
242             C<Algorithm::Networksort-E<gt>new()>:
243              
244             use Algorithm::Networksort;
245              
246             my $nw = nwsrt(inputs => 13, algorithm => 'bitonic');
247              
248             =cut
249              
250 64     64 1 43489 sub nwsrt { return __PACKAGE__->new(@_); }
251              
252              
253             =head3 nwsrt_algorithms()
254              
255             Return a sorted list algorithm choices. Each one is a valid key for the
256             algorithm argument of Algorithm::Networksort->new(), or L<nwsrt()>.
257              
258             use Algorithm::Networksort;
259              
260             my @alg_keys = nwsrt_algorithms();
261              
262             print "The available keys for the algorithm argument are (",
263             join(", ", @alg_keys), ")\n";
264              
265             =cut
266              
267             sub nwsrt_algorithms
268             {
269 1     1 1 1201 return sort keys %algname;
270             }
271              
272             =head2 Methods
273              
274             =head3 new()
275              
276             $nw1 = Algorithm::Networksort->new(inputs => $inputs,
277             algorithm => 'batcher');
278              
279             $nw2 = Algorithm::Networksort->new(inputs => $inputs,
280             algorithm => 'oddevenmerge');
281              
282             Returns an object that contains, among other things, a list of comparators that
283             can sort B<$inputs> items. The algorithm for generating the list may be chosen,
284             but by default the sorting network is generated by the Bose-Nelson algorithm.
285              
286             The choices for the B<algorithm> key are
287              
288             =over 3
289              
290             =item 'bosenelson'
291              
292             Use the Bose-Nelson algorithm to generate the network. This is the most
293             commonly implemented algorithm, recursive and simple to code.
294              
295             =item 'hibbard'
296              
297             Use Hibbard's algorithm. This iterative algorithm was developed after the
298             Bose-Nelson algorithm was published, and produces a different network
299             "... for generating the comparisons one by one in the order in which
300             they are needed for sorting," according to his article (see below).
301              
302             =item 'batcher'
303              
304             Use Batcher's Merge Exchange algorithm. Merge Exchange is a real sort, in
305             that in its usual form (for example, as described in Knuth) it can handle
306             a variety of inputs. But while sorting it always generates an identical set of
307             comparison pairs per array size, which lends itself to sorting networks.
308              
309             =item 'bitonic'
310              
311             Use Batcher's bitonic algorithm. A bitonic sequence is a sequence that
312             monotonically increases and then monotonically decreases. The bitonic sort
313             algorithm works by recursively splitting sequences into bitonic sequences
314             using so-called "half-cleaners". These bitonic sequences are then merged
315             into a fully sorted sequence. Bitonic sort is a very efficient sort and
316             is especially suited for implementations that can exploit network
317             parallelism.
318              
319             =item 'oddevenmerge'
320              
321             Use Batcher's Odd-Even Merge algorithm. This sort works in a similar way
322             to a regular merge sort, except that in the merge phase the sorted halves
323             are merged by comparing even elements separately from odd elements. This
324             algorithm creates very efficient networks in both comparators and stages.
325              
326             =item 'bubble'
327              
328             Use a naive bubble-sort/insertion-sort algorithm. Since this algorithm
329             produces more comparison pairs than the other algorithms, it is only
330             useful for illustrative purposes.
331              
332             =item 'oddeventrans'
333              
334             Use a naive odd-even transposition sort. This is a primitive sort closely
335             related to bubble sort except it is more parallel. Because other algorithms
336             are more efficient, this sort is included for illustrative purposes.
337              
338             =item 'balanced'
339              
340             This network is described in the 1983 paper "The Balanced Sorting Network"
341             by M. Dowd, Y. Perl, M Saks, and L. Rudolph. It is not a particularly
342             efficient sort but it has some interesting properties due to the fact
343             that it is constructed as a series of successive identical sub-blocks,
344             somewhat like with 'oddeventrans'.
345              
346             =item 'none'
347              
348             Do not generate a set of comparators. Instead, take the set from an
349             outside source, using the C<comparators> option.
350              
351             #
352             # Test our own 5-input network.
353             #
354             @cmptr = ([1,2], [0,2], [0,1], [3,4], [0,3], [1,4], [2,4], [1,3], [2,3]);
355              
356             $nw = Algorithm::Networksort->new(inputs => 5,
357             algorithm => 'none',
358             comparators => [@cmptr]);
359              
360             Internally, this is what L<nwsrt_best()|Algorithm::Networksort::Best/nwsrt_best()>
361             of L<Algorithm::Networksort::Best> uses.
362              
363             =back
364              
365             =cut
366              
367             sub BUILD
368             {
369 66     66 0 88427 my $self = shift;
370 66         2253 my $alg = $self->algorithm();
371 66         1854 my $inputs = $self->inputs();
372              
373 66         92 my @network;
374             my @grouped;
375              
376             #
377             # Catch errors
378             #
379 66 50       166 croak "Input size must be 2 or greater" if ($inputs < 2);
380              
381             #
382             # Providing our own-grown network?
383             #
384 66 50       166 if ($alg eq 'none')
385             {
386 0 0       0 croak "No comparators provided" unless ($self->has_comparators);
387 0         0 $self->length(scalar @{ $self->comparators });
  0         0  
388              
389             #
390             # Algorithm::Networksort::Best will set these, so
391             # only go through with this if this is a user-provided
392             # sequence of comparators.
393             #
394 0 0 0     0 unless ($self->has_network and $self->depth > 0)
395             {
396 0         0 @grouped = $self->group();
397 0         0 $self->network($self->comparators);
398 0         0 $self->depth(scalar @grouped);
399 0         0 $self->network([map { @$_ } @grouped]);
  0         0  
400 0 0       0 $self->title("Unknown $inputs-Inputs Comparator Set") unless ($self->has_title());
401             }
402              
403 0 0       0 $self->nwid("nonalgorithmic-" . sprintf("%02d", $inputs)) unless ($self->has_nwid());
404              
405 0         0 return $self;
406             }
407              
408 66 50       154 croak "Unknown algorithm '$alg'" unless (exists $algname{$alg});
409 66         2087 $self->nwid($alg . sprintf("%02d", $inputs));
410              
411 66 100       167 @network = bosenelson($inputs) if ($alg eq 'bosenelson');
412 66 100       154 @network = hibbard($inputs) if ($alg eq 'hibbard');
413 66 100       141 @network = batcher($inputs) if ($alg eq 'batcher');
414 66 100       122 @network = bitonic($inputs) if ($alg eq 'bitonic');
415 66 100       131 @network = bubble($inputs) if ($alg eq 'bubble');
416 66 100       141 @network = oddeventransposition($inputs) if ($alg eq 'oddeventrans');
417 66 100       131 @network = balanced($inputs) if ($alg eq 'balanced');
418 66 100       146 @network = oddevenmerge($inputs) if ($alg eq 'oddevenmerge');
419              
420 66 50       2410 $self->title($algname{$alg} . " for N = " . $inputs) unless ($self->has_title);
421 66         1904 $self->length(scalar @network);
422 66         1980 $self->comparators(\@network); # The 'raw' list of comparators.
423              
424             #
425             # Re-order the comparator list using the parallel grouping for
426             # the graphs. The resulting parallelism means less stalling
427             # when used in a pipeline.
428             #
429 66         181 @grouped = $self->group();
430              
431             #
432             #### @grouped
433             #
434 66         2130 $self->depth(scalar @grouped);
435 66         108 $self->network([map { @$_ } @grouped]);
  470         2442  
436              
437 66         296 return $self;
438             }
439              
440             =head3 comparators()
441              
442             The comparators in their 'raw' form, as generated by its algorithm.
443              
444             For the comparators re-ordered in such a way as to take advantage
445             of parallelism, see L<network()>.
446              
447             =head3 network()
448              
449             Returns the comparators re-ordered from the 'raw' order, to provide a
450             parallelized version of the comparator list; the best order possible to
451             prevent stalling in a CPU's pipeline.
452              
453             This is the form used when printing the sorting network using L<formats()>.
454              
455             =cut
456              
457             =head3 algorithm_name()
458              
459             Return the full text name of the algorithm, given its key name.
460              
461             =cut
462              
463             sub algorithm_name
464             {
465 0     0 1 0 my $self = shift;
466 0   0     0 my $algthm = $_[0] // $self->algorithm();
467              
468 0 0       0 return $algname{$algthm} if (defined $algthm);
469 0         0 return "";
470             }
471              
472             #
473             # @network = hibbard($inputs);
474             #
475             # Return a list of two-element lists that comprise the comparators of a
476             # sorting network.
477             #
478             # Translated from the ALGOL listed in T. N. Hibbard's article, A Simple
479             # Sorting Algorithm, Journal of the ACM 10:142-50, 1963.
480             #
481             # The ALGOL code was overly dependent on gotos. This has been changed.
482             #
483             sub hibbard
484             {
485 10     10 0 12 my $inputs = shift;
486 10         11 my @comparators;
487 10         13 my($bit, $xbit, $ybit);
488              
489             #
490             # $t = ceiling(log2($inputs - 1)); but we'll
491             # find it using the length of the bitstring.
492             #
493 10         47 my $t = unpack("B32", pack("N", $inputs - 1));
494 10         36 $t =~ s/^0+//;
495 10         15 $t = length $t;
496              
497 10         14 my $lastbit = 1 << $t;
498              
499             #
500             # $x and $y are the comparator endpoints.
501             # We begin with values of zero and one.
502             #
503 10         14 my($x, $y) = (0, 1);
504              
505 10         10 while (1 == 1)
506             {
507             #
508             # Save the comparator pair, and calculate the next
509             # comparator pair.
510             #
511             ### hibbard() top of loop:
512             #### @comparators
513             #
514 144         154 push @comparators, [$x, $y];
515              
516             #
517             # Start with a check of X and Y's respective bits,
518             # beginning with the zeroth bit.
519             #
520 144         113 $bit = 1;
521 144         110 $xbit = $x & $bit;
522 144         107 $ybit = $y & $bit;
523              
524             #
525             # But if the X bit is 1 and the Y bit is
526             # zero, just clear the X bit and move on.
527             #
528 144   100     361 while ($xbit != 0 and $ybit == 0)
529             {
530 55         48 $x &= ~$bit;
531              
532 55         42 $bit <<= 1;
533 55         40 $xbit = $x & $bit;
534 55         117 $ybit = $y & $bit;
535             }
536              
537 144 100       205 if ($xbit != 0) # and $ybit != 0
538             {
539 36         36 $y &= ~$bit;
540 36         29 next;
541             }
542              
543             #
544             # The X bit is zero if we've gotten this far.
545             #
546 108 100       149 if ($ybit == 0)
547             {
548 55         47 $x |= $bit;
549 55         45 $y |= $bit;
550 55 100       84 $y &= ~$bit if ($y > $inputs - 1);
551 55         46 next;
552             }
553              
554             #
555             # The X bit is zero, the Y bit is one, and we might
556             # return the results.
557             #
558             do
559 53         38 {
560 66 100       133 return @comparators if ($bit == $lastbit);
561              
562 56         48 $x &= ~$bit;
563 56         44 $y &= ~$bit;
564              
565 56         44 $bit <<= 1; # Next bit.
566              
567 56 100       81 if ($y & $bit)
568             {
569 19         18 $x &= ~$bit;
570 19         22 next;
571             }
572              
573 37         41 $x |= $bit;
574 37         94 $y |= $bit;
575             } while ($y > $inputs - 1);
576              
577             #
578             # No return, so loop onwards.
579             #
580 24 100       40 $bit = 1 if ($y < $inputs - 1);
581 24         20 $x &= ~$bit;
582 24         20 $y |= $bit;
583             }
584             }
585              
586             #
587             # @network = bosenelson($inputs);
588             #
589             # Return a list of two-element lists that comprise the comparators of a
590             # sorting network.
591             #
592             # The Bose-Nelson algorithm.
593             #
594             sub bosenelson
595             {
596 8     8 0 10 my $inputs = shift;
597              
598 8         21 return bn_split(0, $inputs);
599             }
600              
601             #
602             # @comparators = bn_split($i, $length);
603             #
604             # The helper function that divides the range to be sorted.
605             #
606             # Note that the work of splitting the ranges is performed with the
607             # 'length' variables. The $i variable merely acts as a starting
608             # base, and could easily have been 1 to begin with.
609             #
610             sub bn_split
611             {
612 96     96 0 71 my($i, $length) = @_;
613 96         78 my @comparators = ();
614              
615             #
616             ### bn_split():
617             #### $i
618             #### $length
619             #
620              
621 96 100       141 if ($length >= 2)
622             {
623 44         31 my $mid = $length/2;
624              
625 44         69 push @comparators, bn_split($i, $mid);
626 44         69 push @comparators, bn_split($i + $mid, $length - $mid);
627 44         71 push @comparators, bn_merge($i, $mid, $i + $mid, $length - $mid);
628             }
629              
630             #
631             ### bn_split() returns
632             #### @comparators
633             #
634 96         109 return @comparators;
635             }
636              
637             #
638             # @comparators = bn_merge($i, $length_i, $j, $length_j);
639             #
640             # The other helper function that adds comparators to the list, for a
641             # given pair of ranges.
642             #
643             # As with bn_split, the different conditions all depend upon the
644             # lengths of the ranges. The $i and $j variables merely act as
645             # starting bases.
646             #
647             sub bn_merge
648             {
649 125     125 0 105 my($i, $length_i, $j, $length_j) = @_;
650 125         104 my @comparators = ();
651              
652             #
653             ### bn_merge():
654             #### $i
655             #### $length_i
656             #### $j
657             #### $length_j
658             #
659 125 100 100     448 if ($length_i == 1 && $length_j == 1)
    100 66        
    100 100        
660             {
661 73         88 push @comparators, [$i, $j];
662             }
663             elsif ($length_i == 1 && $length_j == 2)
664             {
665 21         27 push @comparators, [$i, $j + 1];
666 21         27 push @comparators, [$i, $j];
667             }
668             elsif ($length_i == 2 && $length_j == 1)
669             {
670 4         8 push @comparators, [$i, $j];
671 4         5 push @comparators, [$i + 1, $j];
672             }
673             else
674             {
675 27         25 my $i_mid = $length_i/2;
676 27 100       42 my $j_mid = ($length_i & 1)? $length_j/2: ($length_j + 1)/2;
677              
678 27         38 push @comparators, bn_merge($i, $i_mid, $j, $j_mid);
679 27         38 push @comparators, bn_merge($i + $i_mid, $length_i - $i_mid, $j + $j_mid, $length_j - $j_mid);
680 27         44 push @comparators, bn_merge($i + $i_mid, $length_i - $i_mid, $j, $j_mid);
681             }
682              
683             #
684             ### bn_merge() returns
685             #### @comparators
686             #
687 125         161 return @comparators;
688             }
689              
690             #
691             # @network = batcher($inputs);
692             #
693             # Return a list of two-element lists that comprise the comparators of a
694             # sorting network.
695             #
696             # Batcher's sort as laid out in Knuth, Sorting and Searching, algorithm 5.2.2M.
697             #
698             sub batcher
699             {
700 8     8 0 11 my $inputs = shift;
701 8         9 my @network;
702              
703             #
704             # $t = ceiling(log2($inputs)); but we'll
705             # find it using the length of the bitstring.
706             #
707 8         29 my $t = unpack("B32", pack("N", $inputs));
708 8         30 $t =~ s/^0+//;
709 8         9 $t = length $t;
710              
711 8         15 my $p = 1 << ($t -1);
712              
713 8         16 while ($p > 0)
714             {
715 26         22 my $q = 1 << ($t -1);
716 26         18 my $r = 0;
717 26         25 my $d = $p;
718              
719 26         33 while ($d > 0)
720             {
721 57         71 for my $i (0 .. $inputs - $d - 1)
722             {
723 241 100       406 push @network, [$i, $i + $d] if (($i & $p) == $r);
724             }
725              
726 57         41 $d = $q - $p;
727 57         48 $q >>= 1;
728 57         72 $r = $p;
729             }
730 26         47 $p >>= 1;
731             }
732              
733 8         28 return @network;
734             }
735              
736              
737              
738             #
739             # @network = bitonic($inputs);
740             #
741             # Return a list of two-element lists that comprise the comparators of a
742             # sorting network.
743             #
744             # Batcher's Bitonic sort as described here:
745             # http://www.iti.fh-flensburg.de/lang/algorithmen/sortieren/bitonic/oddn.htm
746             #
747             sub bitonic
748             {
749 8     8 0 11 my $inputs = shift;
750 8         8 my @network;
751              
752 8         9 my ($sort, $merge);
753              
754             $sort = sub {
755 96     96   97 my ($lo, $n, $dir) = @_;
756              
757 96 100       167 if ($n > 1) {
758 44         37 my $m = $n/2;
759 44         81 $sort->($lo, $m, !$dir);
760 44         67 $sort->($lo + $m, $n - $m, $dir);
761 44         56 $merge->($lo, $n, $dir);
762             }
763 8         35 };
764              
765             $merge = sub {
766 252     252   233 my ($lo, $n, $dir) = @_;
767              
768 252 100       383 if ($n > 1) {
769             #
770             # $t = ceiling(log2($n - 1)); but we'll
771             # find it using the length of the bitstring.
772             #
773 104         187 my $t = unpack("B32", pack("N", $n - 1));
774 104         229 $t =~ s/^0+//;
775 104         93 $t = length $t;
776              
777 104         88 my $m = 1 << ($t - 1);
778              
779 104         147 for my $i ($lo .. $lo+$n-$m-1)
780             {
781 134 100       283 push @network, ($dir)? [$i, $i+$m]: [$i+$m, $i];
782             }
783              
784 104         165 $merge->($lo, $m, $dir);
785 104         125 $merge->($lo + $m, $n - $m, $dir);
786             }
787 8         25 };
788              
789 8         18 $sort->(0, $inputs, 1);
790              
791 8         11 return @{ make_network_unidirectional(\@network) };
  8         17  
792             }
793              
794              
795             ## This function "re-wires" a bi-directional sorting network
796             ## and turns it into a normal, uni-directional network.
797              
798             sub make_network_unidirectional
799             {
800 8     8 0 9 my ($network_ref) = @_;
801              
802 8         25 my @network = @$network_ref;
803              
804 8         15 for my $i (0..$#network) {
805 134         95 my $comparator = $network[$i];
806 134         112 my ($x, $y) = @$comparator;
807              
808 134 100       191 if ($x > $y) {
809 44         57 for my $j (($i+1)..$#network) {
810 645         471 my $j_comparator = $network[$j];
811 645         480 my ($j_x, $j_y) = @$j_comparator;
812              
813 645 100       866 $j_comparator->[0] = $y if $x == $j_x;
814 645 100       844 $j_comparator->[1] = $y if $x == $j_y;
815 645 100       821 $j_comparator->[0] = $x if $y == $j_x;
816 645 100       957 $j_comparator->[1] = $x if $y == $j_y;
817             }
818 44         65 ($comparator->[0], $comparator->[1]) = ($comparator->[1], $comparator->[0]);
819             }
820             }
821              
822 8         63 return \@network;
823             }
824              
825             #
826             # @network = bubble($inputs);
827             #
828             # Simple bubble sort network, only for comparison purposes.
829             #
830             sub bubble
831             {
832 8     8 0 9 my $inputs = shift;
833 8         9 my @network;
834              
835 8         25 for my $j (reverse 0 .. $inputs - 1)
836             {
837 52         179 push @network, [$_, $_ + 1] for (0 .. $j - 1);
838             }
839              
840 8         34 return @network;
841             }
842              
843             #
844             # @network = bubble($inputs);
845             #
846             # Simple odd-even transposition network, only for comparison purposes.
847             #
848             sub oddeventransposition
849             {
850 8     8 0 11 my $inputs = shift;
851 8         12 my @network;
852              
853             my $odd;
854              
855 8         24 for my $stage (0 .. $inputs - 1)
856             {
857 52 100       111 for (my $j = $odd ? 1 : 0; $j < $inputs - 1; $j += 2)
858             {
859 164         305 push @network, [$j, $j+1];
860             }
861              
862 52         59 $odd = !$odd;
863             }
864              
865 8         32 return @network;
866             }
867              
868             #
869             # @network = balanced($inputs);
870             #
871             # "The Balanced Sorting Network" by M. Dowd, Y. Perl, M Saks, and L. Rudolph
872             # ftp://ftp.cs.rutgers.edu/cs/pub/technical-reports/pdfs/DCS-TR-127.pdf
873             #
874             sub balanced
875             {
876 8     8 0 8 my $inputs = shift;
877 8         8 my @network;
878              
879             #
880             # $t = ceiling(log2($inputs - 1)); but we'll
881             # find it using the length of the bitstring.
882             #
883 8         32 my $t = unpack("B32", pack("N", $inputs - 1));
884 8         26 $t =~ s/^0+//;
885 8         10 $t = length $t;
886              
887 8         19 for (1 .. $t)
888             {
889 24         49 for (my $curr = 2**($t); $curr > 1; $curr /= 2)
890             {
891 76         119 for (my $i = 0; $i < 2**$t; $i += $curr)
892             {
893 216         312 for (my $j = 0; $j < $curr/2; $j++)
894             {
895 416         296 my $wire1 = $i+$j;
896 416         305 my $wire2 = $i+$curr-$j-1;
897 416 100 100     1738 push @network, [$wire1, $wire2]
898             if $wire1 < $inputs && $wire2 < $inputs;
899             }
900             }
901             }
902             }
903              
904 8         45 return @network;
905             }
906              
907             #
908             # @network = oddevenmerge($inputs);
909             #
910             # Batcher's odd-even merge sort as described here:
911             # http://www.iti.fh-flensburg.de/lang/algorithmen/sortieren/networks/oemen.htm
912             # http://cs.engr.uky.edu/~lewis/essays/algorithms/sortnets/sort-net.html
913             #
914             sub oddevenmerge
915             {
916 8     8 0 10 my $inputs = shift;
917 8         12 my @network;
918              
919             #
920             # $t = ceiling(log2($inputs - 1)); but we'll
921             # find it using the length of the bitstring.
922             #
923 8         27 my $t = unpack("B32", pack("N", $inputs - 1));
924 8         30 $t =~ s/^0+//;
925 8         13 $t = length $t;
926              
927 8         7 my ($add_elem, $sort, $merge);
928              
929             $add_elem = sub {
930 212     212   172 my ($i, $j) = @_;
931              
932 212 100 100     803 push @network, [$i, $j]
933             if $i < $inputs && $j < $inputs;
934 8         35 };
935              
936             $sort = sub {
937 136     136   113 my ($lo, $n) = @_;
938              
939 136 100       205 if ($n > 1)
940             {
941 64         53 my $m = int($n / 2);
942              
943 64         93 $sort->($lo, $m);
944 64         76 $sort->($lo + $m, $m);
945 64         75 $merge->($lo, $n, 1);
946             }
947 8         23 };
948              
949             $merge = sub {
950 176     176   150 my ($lo, $n, $r) = @_;
951              
952 176         139 my $m = int($r * 2);
953              
954 176 100       216 if ($m < $n)
955             {
956 56         82 $merge->($lo, $n, $m); # even
957 56         73 $merge->($lo + $r, $n, $m); # odd
958              
959 56         113 for (my $i=$lo + $r; $i + $r < $lo + $n; $i += $m)
960             {
961 92         102 $add_elem->($i, $i + $r);
962             }
963             }
964             else
965             {
966 120         139 $add_elem->($lo, $lo + $r);
967             }
968 8         21 };
969              
970 8         21 $sort->(0, 2**$t);
971              
972 8         33 return @network;
973             }
974              
975             #
976             # $array_ref = $nw->sort(\@array);
977             #
978             # Use the network of comparators to sort the elements in the
979             # array. Returns the reference to the array, which is sorted
980             # in-place.
981             #
982             # This function is for testing and statistical purposes only, as
983             # interpreting sorting pairs ad hoc in an interpreted language is
984             # going to be very slow.
985             #
986             =head3 sort()
987              
988             Sort an array using the network. This is meant for testing purposes
989             only - looping around an array of comparators in order to sort an
990             array in an interpreted language is not the most efficient mechanism
991             for using a sorting network.
992              
993             This function uses the C<< <=> >> operator for comparisons.
994              
995             my @digits = (1, 8, 3, 0, 4, 7, 2, 5, 9, 6);
996             my $nw = Algorithm::Networksort->new(
997             inputs => (scalar @digits),
998             algorithm => 'hibbard');
999             $nw->sort(\@digits);
1000             print join(", ", @digits);
1001              
1002             =cut
1003              
1004             sub sort
1005             {
1006 15840     15840 0 115059 my $self = shift;
1007 15840         12686 my $array = $_[0];
1008              
1009 15840         430758 my $network = $self->network();
1010              
1011             #
1012             ### sort():
1013             #### $network
1014             #### $array
1015             #
1016              
1017             #
1018             # Variable $swaps is a global variable that reports back the
1019             # number of exchanges.
1020             #
1021 15840         12987 $swaps = 0;
1022 15840         20395 for my $comparator (@$network)
1023             {
1024 519164         408955 my($left, $right) = @$comparator;
1025              
1026 519164 100       800736 if (($$array[$left] <=> $$array[$right]) == 1)
1027             {
1028 91519         120648 @$array[$left, $right] = @$array[$right, $left];
1029 91519         90086 $swaps++;
1030             }
1031              
1032             #
1033             ##### @$array
1034             #
1035             }
1036              
1037 15840         19741 return $array;
1038             }
1039              
1040             =head3 statistics()
1041              
1042             Return statistics on the last sort() call. Currently only "swaps",
1043             a count of the number of exchanges, is returned.
1044              
1045             my(@d, %nw_stats);
1046             my @digits = (1, 8, 3, 0, 4, 7, 2, 5, 9, 6);
1047             my $inputs = scalar @digits;
1048             my $nw_batcher = Algorithm::Networksort->new(inputs => $inputs, algorithm => 'batcher');
1049             my $nw_bn = Algorithm::Networksort->new(inputs => $inputs, algorithm => 'bosenelson');
1050              
1051             #
1052             # List will wind up sorted, so copy it for our first test run.
1053             #
1054             @d = @digits;
1055             $nw_batcher->sort(\@d);
1056             %nw_stats = $nw_batcher->statistics();
1057             print "The Batcher Merge-Exchange network took ",
1058             $nw_stats{swaps}, " exchanges to sort the array."
1059              
1060             @d = @digits;
1061             $nw_bn->sort(\@d);
1062             %nw_stats = $nw_bn->statistics();
1063             print "The Bose-Nelson network took ",
1064             $nw_stats{swaps}, " exchanges to sort the array."
1065              
1066             =cut
1067              
1068             sub statistics
1069             {
1070 0     0 1 0 return (swaps => $swaps,
1071             );
1072             }
1073              
1074             =head2 Methods For Printing
1075              
1076             The network object by default prints itself in a grouped format; that is
1077              
1078             my $nw = nwsrt(inputs => 4, algorithm => 'bosenelson');
1079             print $nw;
1080              
1081             Will result in the output
1082              
1083             [[0,1], [2,3],
1084             [0,2], [1,3],
1085             [1,2]]
1086              
1087             =head3 formats()
1088              
1089             An array reference of format strings, for use in formatted printing (see
1090             L<formatted()>). You may use as many sprintf-style formats as you like
1091             to form your output.
1092              
1093             $nw->formats([ "swap(%d, %d) ", "if ($card[%d] < $card[%d]);\n" ]);
1094              
1095             =head3 index_base()
1096              
1097             The values to use to reference array indices in formatted printing (see
1098             L<formatted()>). By default, array indices are zero-based. To use a
1099             different index base (most commonly, one-based array indexing), use
1100             this method.
1101              
1102             $nw->index_base([1 .. $inputs]);
1103              
1104             =cut
1105              
1106             sub _dflt_formatted
1107             {
1108 1     1   1 my $self = shift;
1109 1         2 my $network = $_[0];
1110              
1111             #
1112             # Got comparators?
1113             #### $network
1114             #
1115 1 50       3 if (scalar @$network == 0)
1116             {
1117 0         0 carp "No network to format.\n";
1118 0         0 return "";
1119             }
1120              
1121 1         2 my $string = "";
1122 1         30 my $index_base = $self->index_base();
1123              
1124 1         2 for my $cmptr (@$network)
1125             {
1126 5 50       8 @$cmptr = @$index_base[@$cmptr] if (defined $index_base);
1127              
1128 5         12 $string .= "[" . join(",", @$cmptr) . "], ";
1129             }
1130              
1131 1         4 chop $string;
1132 1         2 chop $string;
1133              
1134 1         4 return $string;
1135             }
1136              
1137             #
1138             # _stringify
1139             #
1140             # Show a nicely formatted sorting network.
1141             #
1142             sub _stringify
1143             {
1144 0     0   0 my $self = shift;
1145 0         0 my @grouped = $self->group();
1146 0         0 my $string = "[";
1147              
1148 0         0 for my $grp (@grouped)
1149             {
1150 0         0 $string .= $self->_dflt_formatted($grp) . "\n";
1151             }
1152 0         0 substr($string, -1, 1) = ']'; # Overwrite the trailing "\n".
1153 0         0 return $string;
1154             }
1155              
1156             =head3 formatted()
1157              
1158             $string = $nw->formatted();
1159              
1160             Returns a formatted string that represents the list of comparators.
1161              
1162             If no formats have been provided via the L<formats()> method, the default
1163             format will be used: an array of arrays as represented in Perl.
1164              
1165             Likewise, the network sorting pairs are zero-based. If you want the
1166             pairs written out for some sequence other than 0, 1, 2, ... then you can
1167             provide that using L<inputs_base()>.
1168              
1169             B<Example 0: you want a string in the default format.>
1170              
1171             print $nw->formatted();
1172              
1173             B<Example 1: you want the output to look like the default format, but
1174             one-based instead of zero-based.>
1175              
1176             $nw->input_base([1..$inputs]);
1177             print $nw->formatted();
1178              
1179             B<Example 2: you want a simple list of SWAP macros.>
1180              
1181             $nw->formats([ "SWAP(%d, %d);\n" ]);
1182             print $nw->formatted();
1183              
1184             B<Example 3: as with example 2, but the SWAP values need to be one-based instead of zero-based.>
1185              
1186             $nw->input_base([1..$inputs]);
1187             $nw->formats([ "SWAP(%d, %d);\n" ]);
1188             print $nw->formatted();
1189              
1190             B<Example 4: you want a series of comparison and swap statements.>
1191              
1192             $nw->formats([ "if (v[%d] < v[%d]) then\n",
1193             " exchange(v, %d, %d)\nend if\n" ]);
1194             print $nw->formatted();
1195              
1196             B<Example 5: you want the default format to use letters, not numbers.>
1197              
1198             $nw->input_base( [('a'..'z')[0..$inputs]] );
1199             $nw->formats([ "[%s,%s]," ]); # Note that we're using the string flag.
1200              
1201             my $string = '[' . $nw->formatted();
1202             substr($string, -1, 1) = ']'; # Overwrite the trailing comma.
1203              
1204             print $string, "\n";
1205              
1206             =cut
1207              
1208             sub formatted
1209             {
1210 2     2 1 15 my $self = shift;
1211 2         64 my $network = $self->network();
1212              
1213             #
1214             # Got comparators?
1215             #### $network
1216             #
1217 2 50       6 if (scalar @$network == 0)
1218             {
1219 0         0 carp "No network to format.\n";
1220 0         0 return "";
1221             }
1222              
1223             #
1224             # Got formats?
1225             #
1226 2 100       58 my(@formats) = $self->formats? @{ $self->formats() }: ();
  1         29  
1227 2 100       6 unless (scalar @formats)
1228             {
1229 1         3 return '[' . $self->_dflt_formatted($network) . ']';
1230             }
1231              
1232 1         2 my $string = '';
1233 1         29 my $index_base = $self->index_base();
1234              
1235 1         3 for my $cmptr (@$network)
1236             {
1237 5 50       8 @$cmptr = @$index_base[@$cmptr] if (defined $index_base);
1238              
1239 5         6 for my $fmt (@formats)
1240             {
1241 5         14 $string .= sprintf($fmt, @$cmptr);
1242             }
1243             }
1244              
1245 1         3 return $string;
1246             }
1247              
1248             =head3 group()
1249              
1250             Takes the comparator list and returns a list of comparator lists, each
1251             sub-list representing a group of comparators that can be operate without
1252             interfering with each other, depending on what is needed for
1253             interference-free grouping.
1254              
1255             There is one option available, 'grouping', that will produce a grouping
1256             that represents parallel operations of comparators. Its values may be:
1257              
1258             =over 3
1259              
1260             =item 'graph'
1261              
1262             Group the comnparators as parallel as possible for graphing.
1263              
1264             =item 'parallel'
1265              
1266             Arrange the sequence in parallel so that it has a minimum depth. This,
1267             after flattening the lists into a single list again, is what is used to
1268             produce the sequence in L<network()>.
1269              
1270             =back
1271              
1272             The chances that you will need to use this function are slim, but the
1273             following code snippet may represent an example:
1274              
1275             my $nw = Algorithm::Networksort->new(inputs => 8, algorithm => 'batcher');
1276              
1277             print "There are ", $nw->length(),
1278             " comparators in this network, grouped into\n",
1279             $nw->depth(), " parallel operations.\n\n";
1280              
1281             print $nw, "\n";
1282              
1283             my @grouped_network = $nw->group(grouping=>'graph');
1284             print "\nThis will be graphed in ", scalar @grouped_network,
1285             " columns.\n";
1286              
1287             This will produce:
1288              
1289             There are 19 comparators in this network, grouped into 6 parallel operations.
1290              
1291             [[0,4], [1,5], [2,6], [3,7]]
1292             [[0,2], [1,3], [4,6], [5,7]]
1293             [[2,4], [3,5], [0,1], [6,7]]
1294             [[2,3], [4,5]]
1295             [[1,4], [3,6]]
1296             [[1,2], [3,4], [5,6]]
1297              
1298             This will be graphed in 11 columns.
1299              
1300             =cut
1301              
1302             sub group
1303             {
1304 66     66 1 90 my $self = shift;
1305 66         2095 my $network = $self->comparators;
1306 66         1820 my $inputs = $self->inputs;
1307 66         136 my %opts = @_;
1308              
1309 66         83 my @node_range_stack;
1310             my @node_stack;
1311 66   50     242 my $grp = $opts{grouping} // 'parallel';
1312            
1313             #
1314             # Group the comparator nodes by N.
1315             #
1316 66 50       183 if ($grp =~ /^[0-9]+$/)
1317             {
1318 0         0 my @s = @$network;
1319 0         0 while (scalar @s)
1320             {
1321 0         0 push @node_stack, [splice(@s, 0, $grp)];
1322             }
1323 0         0 return @node_stack;
1324             }
1325              
1326 66 50       240 unless ($grp =~ /^(graph|parallel)$/)
1327             {
1328 0         0 carp "Unknown option '$grp'";
1329 0         0 return undef;
1330             }
1331              
1332             #
1333             # Group the comparator nodes by columns.
1334             #
1335 66         135 for my $comparator (@$network)
1336             {
1337 1197         1145 my($from, $to) = @$comparator;
1338              
1339             #
1340             # How much of a column becomes untouchable depends upon whether
1341             # we are trying to print out comparators in a single column, or
1342             # whether we are just trying to arrange comparators in a single
1343             # column without concern for overlap.
1344             #
1345 1197 50       1780 my @range = ($grp eq "parallel")?
1346             ($from, $to):
1347             ($from..$to);
1348 1197         915 my $col = scalar @node_range_stack;
1349              
1350             #
1351             # Search back through the stack of columns to see if
1352             # we can fit the comparator in an existing column.
1353             #
1354 1197         1781 while (--$col >= 0)
1355             {
1356 2161 100       1507 last if (grep{$_ != 0} @{$node_range_stack[$col]}[@range]);
  4322         6685  
  2161         2092  
1357             }
1358              
1359             #
1360             # If even the top column can't fit it in, make a
1361             # new, empty top.
1362             #
1363 1197 100       1773 if (++$col == scalar(@node_range_stack))
1364             {
1365 470         890 push @node_range_stack, [(0) x $inputs];
1366             }
1367              
1368 1197         1140 @{$node_range_stack[$col]}[@range] = (1) x (scalar @range);
  1197         1330  
1369              
1370             #
1371             # Autovivification creates the [$col] array element
1372             # if it doesn't currently exist.
1373             #
1374 1197         912 push @{$node_stack[$col]}, $comparator;
  1197         1671  
1375             }
1376              
1377 66         313 return @node_stack;
1378             }
1379              
1380             #
1381             # Set up the horizontal coordinates.
1382             #
1383             sub hz_coords
1384             {
1385 0     0 0   my($columns, %grset) = @_;
1386              
1387 0           my @hcoord = ($grset{hz_margin} + $grset{indent}) x $columns;
1388              
1389 0           for my $idx (0..$columns-1)
1390             {
1391 0           $hcoord[$idx] += $idx * ($grset{hz_sep} + $grset{stroke_width});
1392             }
1393              
1394 0           return @hcoord;
1395             }
1396              
1397             #
1398             # Set up the vertical coordinates.
1399             #
1400             sub vt_coords
1401             {
1402 0     0 0   my($inputs, %grset) = @_;
1403              
1404 0           my @vcoord = ($grset{vt_margin}) x $inputs;
1405              
1406 0           for my $idx (0..$inputs-1)
1407             {
1408 0           $vcoord[$idx] += $idx * ($grset{vt_sep} + $grset{stroke_width});
1409             }
1410              
1411 0           return @vcoord;
1412             }
1413              
1414             =head2 Methods For Graphing
1415              
1416             =head3 graph_eps()
1417              
1418             Returns a string that graphs out the network's comparators. The format
1419             will be encapsulated postscript.
1420              
1421             my $nw = Algorithm::Networksort(inputs = 4, algorithm => 'bitonic');
1422              
1423             print $nw->graph_eps();
1424              
1425             =cut
1426              
1427             sub graph_eps
1428             {
1429 0     0 1   my $self = shift;
1430 0           my $network = $self->network();
1431 0           my $inputs = $self->inputs();
1432 0           my %grset = $self->graphsettings();
1433              
1434 0           my @node_stack = $self->group(grouping => 'graph');
1435 0           my $columns = scalar @node_stack;
1436              
1437             #
1438             # Set up the vertical and horizontal coordinates.
1439             #
1440 0           my @vcoord = vt_coords($inputs, %grset);
1441 0           my @hcoord = hz_coords($columns, %grset);
1442              
1443 0           my $xbound = $hcoord[$columns - 1] + $grset{hz_margin} + $grset{indent};
1444 0           my $ybound = $vcoord[$inputs - 1] + $grset{vt_margin};
1445              
1446             #
1447             # A long involved piece to create the necessary DSC, the subroutine
1448             # definitions, arrays of vertical and horizontal coordinates, and
1449             # left and right margin definitions.
1450             #
1451             my $string =
1452             qq(%!PS-Adobe-3.0 EPSF-3.0\n%%BoundingBox: 0 0 $xbound $ybound\n%%CreationDate: ) .
1453             localtime() .
1454             qq(\n%%Creator: ) . $self->creator() .
1455             qq(\n%%Title: ) . $self->title() .
1456             qq(\n%%Pages: 1\n%%EndComments\n%%Page: 1 1\n) .
1457             q(
1458             % column inputline1 inputline2 draw-comparatorline
1459             /draw-comparatorline {
1460             vcoord exch get 3 1 roll vcoord exch get
1461             3 1 roll hcoord exch get 3 1 roll 2 index exch % x1 y1 x1 y2
1462             newpath 2 copy currentlinewidth 0 360 arc gsave stroke grestore fill moveto
1463             2 copy lineto stroke currentlinewidth 0 360 arc gsave stroke grestore fill
1464             } bind def
1465              
1466             % inputline draw-inputline
1467             /draw-inputline {
1468             vcoord exch get leftmargin exch dup rightmargin exch % x1 y1 x2 y1
1469             newpath 2 copy currentlinewidth 0 360 arc moveto
1470             2 copy lineto currentlinewidth 0 360 arc stroke
1471             } bind def
1472              
1473             ) .
1474             "/vcoord [" .
1475             join("\n ", semijoin(' ', 16, @vcoord)) . "] def\n/hcoord [" .
1476             join("\n ", semijoin(' ', 16, @hcoord)) . "] def\n\n" .
1477             "/leftmargin $grset{hz_margin} def\n/rightmargin " .
1478 0           ($xbound - $grset{hz_margin}) . " def\n\n";
1479              
1480             #
1481             # Save the current graphics state, then change the default line width,
1482             # and the drawing coordinates from (0,0) = lower left to an upper left
1483             # origin.
1484             #
1485 0           $string .= "gsave\n$grset{stroke_width} setlinewidth\n0 $ybound translate\n1 -1 scale\n";
1486              
1487             #
1488             # Draw the input lines.
1489             #
1490 0           $string .= "\n%\n% Draw the input lines.\n%\n0 1 " . ($inputs-1) . " {draw-inputline} for\n";
1491              
1492             #
1493             # Draw our comparators.
1494             # Each member of a group of comparators is drawn in the same column.
1495             #
1496 0           $string .= "\n%\n% Draw the comparator lines.\n%\n";
1497 0           my $hidx = 0;
1498 0           for my $group (@node_stack)
1499             {
1500 0           for my $comparator (@$group)
1501             {
1502 0           $string .= sprintf("%d %d %d draw-comparatorline\n", $hidx, @$comparator);
1503             }
1504 0           $hidx++;
1505             }
1506              
1507 0           $string .= "showpage\ngrestore\n% End of the EPS graph.";
1508 0           return $string;
1509             }
1510              
1511             #svg.pl --background="#9494A4" --indent=15 --hz_sep=22 --hz_margin=16 --vt_margin=20 --stroke_width=4 --radius=3 --algorithm=bosenelson 4
1512              
1513             =head3 graph_svg()
1514              
1515             Returns a string that graphs out the network's comparators.
1516              
1517             $nw = Algorithm::Networksort(inputs => 4, algorithm => 'bitonic');
1518             $svg = $nw->graph_svg();
1519              
1520             The output will use the default colors and sizes, and will be enclosed between
1521             E<lt>svgE<gt> and E<lt>/svgE<gt> tags.
1522              
1523             An example of using the output in an HTML setting:
1524              
1525             $nw = nwsrt_best(name => 'floyd09'); # See Algorithm::Networksort::Best
1526              
1527             $nw->colorsettings(compbegin => '#04c', compend => '#40c');
1528             $svg = $nw->graph_svg();
1529              
1530             =begin html
1531              
1532             <p>Embedded in a web page, this will produce</p>
1533              
1534             <svg xmlns="http://www.w3.org/2000/svg"
1535             xmlns:xlink="http://www.w3.org/1999/xlink" width="278" height="154" viewbox="0 0 278 154">
1536             <defs>
1537             <g id="I_51b6" style="fill:none; stroke-width:2" >
1538             <circle style="stroke:black" cx="18" cy="0" r="2" />
1539             <line style="stroke:black" x1="18" y1="0" x2="260" y2="0" />
1540             <circle style="stroke:black" cx="260" cy="0" r="2" />
1541             </g>
1542              
1543             <g id="C1_51b6" style="stroke-width:2" >
1544             <line style="fill:black; stroke:black" x1="0" y1="0" x2="0" y2="14" />
1545             <circle style="fill:#04c; stroke:#04c" cx="0" cy="0" r="2" />
1546             <circle style="fill:#40c; stroke:#40c" cx="0" cy="14" r="2" />
1547             </g>
1548             <g id="C3_51b6" style="stroke-width:2" >
1549             <line style="fill:black; stroke:black" x1="0" y1="0" x2="0" y2="42" />
1550             <circle style="fill:#04c; stroke:#04c" cx="0" cy="0" r="2" />
1551             <circle style="fill:#40c; stroke:#40c" cx="0" cy="42" r="2" />
1552             </g>
1553             <g id="C2_51b6" style="stroke-width:2" >
1554             <line style="fill:black; stroke:black" x1="0" y1="0" x2="0" y2="28" />
1555             <circle style="fill:#04c; stroke:#04c" cx="0" cy="0" r="2" />
1556             <circle style="fill:#40c; stroke:#40c" cx="0" cy="28" r="2" />
1557             </g>
1558             <g id="C4_51b6" style="stroke-width:2" >
1559             <line style="fill:black; stroke:black" x1="0" y1="0" x2="0" y2="56" />
1560             <circle style="fill:#04c; stroke:#04c" cx="0" cy="0" r="2" />
1561             <circle style="fill:#40c; stroke:#40c" cx="0" cy="56" r="2" />
1562             </g>
1563             </defs>
1564              
1565             <g id="floyd09_51b6">
1566             <use xlink:href="#I_51b6" y="21" /> <use xlink:href="#I_51b6" y="35" />
1567             <use xlink:href="#I_51b6" y="49" /> <use xlink:href="#I_51b6" y="63" />
1568             <use xlink:href="#I_51b6" y="77" /> <use xlink:href="#I_51b6" y="91" />
1569             <use xlink:href="#I_51b6" y="105" /> <use xlink:href="#I_51b6" y="119" />
1570             <use xlink:href="#I_51b6" y="133" />
1571              
1572             <use xlink:href="#C1_51b6" x="27" y="21" /> <use xlink:href="#C1_51b6" x="27" y="63" />
1573             <use xlink:href="#C1_51b6" x="27" y="105" /> <use xlink:href="#C1_51b6" x="41" y="35" />
1574             <use xlink:href="#C1_51b6" x="41" y="77" /> <use xlink:href="#C1_51b6" x="41" y="119" />
1575             <use xlink:href="#C1_51b6" x="55" y="21" /> <use xlink:href="#C1_51b6" x="55" y="63" />
1576             <use xlink:href="#C1_51b6" x="55" y="105" /> <use xlink:href="#C3_51b6" x="69" y="21" />
1577             <use xlink:href="#C3_51b6" x="83" y="63" /> <use xlink:href="#C3_51b6" x="97" y="21" />
1578             <use xlink:href="#C3_51b6" x="111" y="35" /> <use xlink:href="#C3_51b6" x="125" y="77" />
1579             <use xlink:href="#C3_51b6" x="139" y="35" /> <use xlink:href="#C3_51b6" x="153" y="49" />
1580             <use xlink:href="#C3_51b6" x="167" y="91" /> <use xlink:href="#C3_51b6" x="181" y="49" />
1581             <use xlink:href="#C2_51b6" x="195" y="35" /> <use xlink:href="#C2_51b6" x="195" y="91" />
1582             <use xlink:href="#C4_51b6" x="209" y="49" /> <use xlink:href="#C2_51b6" x="223" y="77" />
1583             <use xlink:href="#C2_51b6" x="237" y="49" /> <use xlink:href="#C1_51b6" x="237" y="91" />
1584             <use xlink:href="#C1_51b6" x="251" y="49" />
1585             </g>
1586             </svg>
1587              
1588             =end html
1589              
1590             =cut
1591              
1592             sub graph_svg
1593             {
1594 0     0 1   my $self = shift;
1595 0           my $network = $self->network();
1596 0           my $inputs = $self->inputs();
1597 0           my %grset = $self->graphsettings();
1598              
1599             #
1600             # The 'salt' is used to ensure that the id attributes
1601             # are unique -- I got bit by this when I put two SVG
1602             # images in the same page.
1603             #
1604 0           my $salt = "_" . sprintf("%x", int(rand(0x7fff)));
1605              
1606 0           my @node_stack = $self->group(grouping => 'graph');
1607 0           my $columns = scalar @node_stack;
1608              
1609             #
1610             # Get the colorset, using the foreground color as the default color
1611             # for drawing.
1612             #
1613 0   0       my %clrset = map{$_ => ($colorset{$_} // $colorset{foreground} // 'black')} keys %colorset;
  0   0        
1614              
1615             #
1616             # Set up the vertical and horizontal coordinates.
1617             #
1618 0           my @vcoord = vt_coords($inputs, %grset);
1619 0           my @hcoord = hz_coords($columns, %grset);
1620              
1621 0           my $xbound = $hcoord[$columns - 1] + $grset{hz_margin} + $grset{indent};
1622 0           my $ybound = $vcoord[$inputs - 1] + $grset{vt_margin};
1623              
1624 0           my $right_margin = $hcoord[$columns - 1] + $grset{indent};
1625 0           my $radius = $grset{radius};
1626              
1627 0           my $string = qq(<svg xmlns="http://www.w3.org/2000/svg"\n) .
1628             qq( xmlns:xlink="http://www.w3.org/1999/xlink" ) .
1629             qq(width="$xbound" height="$ybound" viewbox="0 0 $xbound $ybound">\n) .
1630             qq( <title>) . $self->title() . qq(</title>\n) .
1631             qq( <desc>\n CreationDate: ) . localtime() .
1632             qq(\n Creator: ) . $self->creator() . qq(\n </desc>\n);
1633              
1634             #
1635             # Set a background color by inserting as the first element a <rect>
1636             # with the full size of the view and a fill of the desired color.
1637             # Use %colorset instead of %clrset, since we've just torpedoed
1638             # the background value if it was an undef.
1639             #
1640 0 0         if (defined $colorset{background})
1641             {
1642 0           my $filler = $colorset{background};
1643 0           $string .= qq( <rect width="100%" height="100%" fill="$filler" />\n);
1644             }
1645              
1646             #
1647             # Set up the input line template.
1648             #
1649 0           my $g_style = "style=\"fill:none; stroke-width:$grset{stroke_width}\"";
1650 0           my $b_style = "style=\"stroke:$clrset{inputbegin}\"";
1651 0           my $l_style = "style=\"stroke:$clrset{inputline}\"";
1652 0           my $e_style = "style=\"stroke:$clrset{inputend}\"";
1653              
1654 0           $string .=
1655             qq( <defs>\n) .
1656             qq( <!-- Define the input line template. -->\n) .
1657             qq( <g id="I$salt" $g_style >\n) .
1658             qq( <desc>Input line</desc>\n) .
1659             qq( <line $l_style x1="$grset{hz_margin}" y1="0" x2="$right_margin" y2="0" />\n) .
1660             qq( <circle $b_style cx="$grset{hz_margin}" cy="0" r="$radius" />\n) .
1661             qq( <circle $e_style cx="$right_margin" cy="0" r="$radius" />\n) .
1662             qq( </g>\n\n);
1663              
1664             #
1665             # Set up the comparator templates.
1666             #
1667 0           $string .= qq( <!-- Define the comparator lines, which vary in length. -->\n);
1668              
1669 0           $g_style = "style=\"stroke-width:$grset{stroke_width}\"";
1670              
1671 0           my @cmptr = (0) x $inputs;
1672 0           for my $comparator (@$network)
1673             {
1674 0           my($from, $to) = @$comparator;
1675 0           my $clen = $to - $from;
1676 0 0         if ($cmptr[$clen] == 0)
1677             {
1678 0           my $endpoint = $vcoord[$to] - $vcoord[$from];
1679 0           $cmptr[$clen] = 1;
1680              
1681             #
1682             # Color the components in the group individually.
1683             #
1684 0           $b_style = "style=\"fill:$clrset{compbegin}; stroke:$clrset{compbegin}\"";
1685 0           $l_style = "style=\"fill:$clrset{compline}; stroke:$clrset{compline}\"";
1686 0           $e_style = "style=\"fill:$clrset{compend}; stroke:$clrset{compend}\"";
1687              
1688 0           $string .=
1689             qq( <g id="C$clen$salt" $g_style >\n) .
1690             qq( <desc>Comparator size $clen</desc>\n) .
1691             qq( <line $l_style x1="0" y1="0" x2="0" y2="$endpoint" />\n) .
1692             qq( <circle $b_style cx="0" cy="0" r="$radius" />\n) .
1693             qq( <circle $e_style cx="0" cy="$endpoint" r="$radius" />\n) .
1694             qq( </g>\n);
1695             }
1696             }
1697              
1698 0           $string .= qq( </defs>\n\n);
1699              
1700             #
1701             # End of definitions. Draw the input lines as a group.
1702             #
1703 0           $string .= qq( <g id=") . $self->nwid() . qq($salt">\n);
1704 0           $string .= qq( <!-- Draw the input lines. -->\n);
1705 0           $string .= qq( <use xlink:href="#I$salt" y="$vcoord[$_]" />\n) for (0..$inputs-1);
1706              
1707             #
1708             # Draw our comparators.
1709             # Each member of a group of comparators is drawn in the same column.
1710             #
1711 0           $string .= qq(\n <!-- Draw the comparator lines. -->\n);
1712 0           my $hidx = 0;
1713 0           for my $group (@node_stack)
1714             {
1715 0           my $h = $hcoord[$hidx++];
1716              
1717 0           for my $comparator (@$group)
1718             {
1719 0           my($from, $to) = @$comparator;
1720 0           my $clen = $to - $from;
1721 0           my $v = $vcoord[$from];
1722              
1723 0           $string .= qq( <!-- [$from,$to] -->) .
1724             qq(<use xlink:href="#C$clen$salt" x="$h" y="$v" />\n);
1725             }
1726             }
1727              
1728 0           $string .= qq( </g>\n</svg>\n);
1729 0           return $string;
1730             }
1731              
1732             =head3 graph_text()
1733              
1734             Returns a string that graphs out the network's comparators in plain text.
1735              
1736             my $nw = Algorithm::Networksort(inputs = 4, algorithm => 'bitonic');
1737              
1738             print $nw->graph_text();
1739              
1740             This will produce
1741              
1742             o--^-----^--^--o
1743             | | |
1744             o--v--^--|--v--o
1745             | |
1746             o--^--v--|--^--o
1747             | | |
1748             o--v-----v--v--o
1749              
1750              
1751             =cut
1752              
1753             sub graph_text
1754             {
1755 0     0 1   my $self = shift;
1756 0           my $network = $self->network();
1757 0           my $inputs = $self->inputs();
1758 0           my %txset = $self->graphsettings();
1759              
1760 0           my @node_stack = $self->group(grouping => 'graph');
1761 0           my @inuse_nodes;
1762              
1763             #
1764             # Set up a matrix of the begin and end points found in each column.
1765             # This will tell us where to draw our comparator lines.
1766             #
1767 0           for my $group (@node_stack)
1768             {
1769 0           my @node_column = (0) x $inputs;
1770              
1771 0           for my $comparator (@$group)
1772             {
1773 0           my($from, $to) = @$comparator;
1774 0           @node_column[$from, $to] = (1, -1);
1775             }
1776 0           push @inuse_nodes, [splice @node_column, 0];
1777             }
1778              
1779             #
1780             # Print that network.
1781             #
1782 0           my $column = scalar @node_stack;
1783 0           my @column_line = (0) x $column;
1784 0           my $string = "";
1785              
1786 0           for my $row (0..$inputs-1)
1787             {
1788             #
1789             # Begin with the input line...
1790             #
1791 0           $string .= $txset{inputbegin};
1792              
1793 0           for my $col (0..$column-1)
1794             {
1795 0           my @node_column = @{$inuse_nodes[$col]};
  0            
1796              
1797 0 0         if ($node_column[$row] == 0)
    0          
1798             {
1799 0 0         $string .= $txset{($column_line[$col] == 1)?
1800             'inputcompline': 'inputline'};
1801             }
1802             elsif ($node_column[$row] == 1)
1803             {
1804 0           $string .= $txset{compbegin};
1805             }
1806             else
1807             {
1808 0           $string .= $txset{compend};
1809             }
1810 0           $column_line[$col] += $node_column[$row];
1811             }
1812              
1813 0           $string .= $txset{inputend};
1814              
1815             #
1816             # Now print the space in between input lines.
1817             #
1818 0 0         if ($row != $inputs-1)
1819             {
1820 0           $string .= $txset{gapbegin};
1821              
1822 0           for my $col (0..$column -1)
1823             {
1824 0 0         $string .= $txset{($column_line[$col] == 0)?
1825             'gapnone': 'gapcompline'};
1826             }
1827              
1828 0           $string .= $txset{gapend};
1829             }
1830             }
1831              
1832 0           return $string;
1833             }
1834              
1835             =head3 colorsettings()
1836              
1837             Sets the colors of the graph parts, currently for SVG output only.
1838              
1839             The parts are named.
1840              
1841             my %old_colors = $nw->colorsettings(inputbegin => "#c04", inputend => "#c40");
1842              
1843             =over 4
1844              
1845             =item inputbegin
1846              
1847             Opening of input line.
1848              
1849             =item inputline
1850              
1851             The input line.
1852              
1853             =item inputend
1854              
1855             Closing of the input line.
1856              
1857             =item compbegin
1858              
1859             Opening of the comparator.
1860              
1861             =item compline
1862              
1863             The comparator line.
1864              
1865             =item compend
1866              
1867             Closing of the comparator line.
1868              
1869             =item foreground
1870              
1871             Default color for the graph as a whole.
1872              
1873             =item background
1874              
1875             Color of the background. Currently unimplemented in SVG.
1876              
1877             =back
1878              
1879             All parts not named are reset to 'undef', and will be colored with the
1880             default 'foreground' color. The foreground color itself has a default
1881             value of 'black'. The one exception is the 'background' color, which
1882             has no default color at all.
1883              
1884             =cut
1885              
1886             sub colorsettings
1887             {
1888 0     0 1   my $self = shift;
1889 0           my %settings = @_;
1890 0           my %old_settings;
1891              
1892 0 0         return %colorset if (scalar @_ == 0);
1893              
1894 0           for my $k (keys %settings)
1895             {
1896             #
1897             # If it's a real part to color, save the
1898             # old value, then set it.
1899             #
1900 0 0         if (exists $colorset{$k})
1901             {
1902 0           $old_settings{$k} = $colorset{$k};
1903 0           $colorset{$k} = $settings{$k};
1904             }
1905             else
1906             {
1907 0           carp "colorsettings(): Unknown key '$k'";
1908             }
1909             }
1910              
1911 0           return %old_settings;
1912             }
1913              
1914             =head3 graphsettings()
1915              
1916             Alter the graphing settings, be it pixel measurements
1917             or ascii-art characters.
1918              
1919             #
1920             # Set hz_margin, saving its old value for later.
1921             #
1922             my %old_gset = $nw->graphsettings(hz_margin => 12);
1923              
1924             =head4 Options for graph_svg() and graph_eps():
1925              
1926             SVG measurements are in pixels.
1927              
1928             =over 3
1929              
1930             =item hz_margin
1931              
1932             I<Default value: 18.>
1933             The horizontal spacing between the edges of the graphic and the
1934             sorting network.
1935              
1936             =item hz_sep
1937              
1938             I<Default value: 12.>
1939             The spacing separating the horizontal lines (the input lines).
1940              
1941             =item indent
1942              
1943             I<Default value: 9.>
1944             The indention between the start of the input lines and the placement of
1945             the first comparator. The same value spaces the placement of the final
1946             comparator and the end of the input lines.
1947              
1948             =item radius
1949              
1950             I<Default value: 2.>
1951             Radii of the circles used to end the comparator and input lines.
1952              
1953             =item stroke_width
1954              
1955             I<Default value: 2.>
1956             Width of the lines used to define comparators and input lines.
1957              
1958             =item vt_margin
1959              
1960             I<Default value: 21.>
1961             The vertical spacing between the edges of the graphic and the sorting network.
1962              
1963             =item vt_sep
1964              
1965             I<Default value: 12.>
1966             The spacing separating the vertical lines (the comparators).
1967              
1968             =back
1969              
1970             =head4 Options for graph_text():
1971              
1972             =over 3
1973              
1974             =item inputbegin
1975              
1976             I<Default value: "o-".>
1977             The starting characters for the input line.
1978              
1979             =item inputline
1980              
1981             I<Default value: "---".>
1982             The characters that make up an input line.
1983              
1984             =item inputcompline
1985              
1986             I<Default value: "-|-".>
1987             The characters that make up an input line that has a comparator crossing
1988             over it.
1989              
1990             =item inputend
1991              
1992             I<Default value: "-o\n".>
1993             The characters that make up the end of an input line.
1994              
1995             =item compbegin
1996              
1997             I<Default value: "-^-".>
1998             The characters that make up an input line with the starting point of
1999             a comparator.
2000              
2001             =item compend
2002              
2003             I<Default value: "-v-".>
2004             The characters that make up an input line with the end point of
2005             a comparator.
2006              
2007             =item gapbegin
2008              
2009             I<Default value: " " (two spaces).>
2010             The characters that start the gap between the input lines.
2011              
2012             =item gapcompline
2013              
2014             I<Default value: " | " (space vertical bar space).>
2015             The characters that make up the gap with a comparator passing through.
2016              
2017             =item gapnone
2018              
2019             I<Default value: " " (three spaces).>
2020             The characters that make up the space between the input lines.
2021              
2022             =item gapend
2023              
2024             I<Default value: " \n" (two spaces and a newline).>
2025             The characters that end the gap between the input lines.
2026              
2027             =back
2028              
2029             =cut
2030              
2031             sub graphsettings
2032             {
2033 0     0 1   my $self = shift;
2034 0           my %settings = @_;
2035 0           my %old_settings;
2036              
2037 0 0         return %graphset if (scalar @_ == 0);
2038              
2039 0           for my $k (keys %settings)
2040             {
2041             #
2042             # If it's a real part to graph, save the
2043             # old value, then set it.
2044             #
2045 0 0         if (exists $graphset{$k})
2046             {
2047 0           $old_settings{$k} = $graphset{$k};
2048 0           $graphset{$k} = $settings{$k};
2049             }
2050             else
2051             {
2052 0           carp "graphsettings(): Unknown key '$k'";
2053             }
2054             }
2055              
2056 0           return %old_settings;
2057             }
2058              
2059             #
2060             # @newlist = semijoin($expr, $itemcount, @list);
2061             #
2062             # $expr - A string to be used in a join() call.
2063             # $itemcount - The number of items in a list to be joined.
2064             # It may be negative.
2065             # @list - The list
2066             #
2067             # Create a new list by performing a join on I<$itemcount> elements at a
2068             # time on the original list. Any leftover elements from the end of the
2069             # list become the last item of the new list, unless I<$itemcount> is
2070             # negative, in which case the first item of the new list is made from the
2071             # leftover elements from the front of the list.
2072             #
2073             sub semijoin
2074             {
2075 0     0 0   my($jstr, $itemcount, @oldlist) = @_;
2076 0           my(@newlist);
2077              
2078 0 0 0       return @oldlist if ($itemcount <= 1 and $itemcount >= -1);
2079              
2080 0 0         if ($itemcount > 0)
2081             {
2082 0           push @newlist, join $jstr, splice(@oldlist, 0, $itemcount)
2083             while @oldlist;
2084             }
2085             else
2086             {
2087 0           $itemcount = -$itemcount;
2088 0           unshift @newlist, join $jstr, splice(@oldlist, -$itemcount, $itemcount)
2089             while $itemcount <= @oldlist;
2090 0 0         unshift @newlist, join $jstr, splice( @oldlist, 0, $itemcount)
2091             if @oldlist;
2092             }
2093              
2094 0           return @newlist;
2095             }
2096              
2097             1;
2098             __END__
2099              
2100             =head1 ACKNOWLEDGMENTS
2101              
2102             L<Doug Hoyte|https://github.com/hoytech> provided the code for the bitonic,
2103             odd-even merge, odd-even transposition, balanced, and bubble sort algorithms,
2104             and the idea for what became the L<statistics()> method.
2105              
2106             L<Morwenn|https://github.com/Morwenn> found documentation errors and networks
2107             that went into L<Algorithm::Networksort::Best>.
2108              
2109             =head1 SEE ALSO
2110              
2111             =head2 Bose and Nelson's algorithm.
2112              
2113             =over 3
2114              
2115             =item
2116              
2117             Bose and Nelson, "A Sorting Problem", Journal of the ACM, Vol. 9, 1962, pp. 282-296.
2118              
2119             =item
2120              
2121             Joseph Celko, "Bose-Nelson Sort", Doctor Dobb's Journal, September 1985.
2122              
2123             =item
2124              
2125             Frederick Hegeman, "Sorting Networks", The C/C++ User's Journal, February 1993.
2126              
2127             =item
2128              
2129             Joe Celko, I<Joe Celko's SQL For Smarties> (third edition). Implementing Bose-Nelson sorting network in SQL.
2130              
2131             This material isn't in either the second or fourth edition of the book.
2132              
2133             =item
2134              
2135             Joe Celko, I<Joe Celko's Thinking in Sets: Auxiliary, Temporal, and Virtual Tables in SQL>.
2136              
2137             The sorting network material removed from the third edition of I<SQL For Smarties> seems to have been moved to this book.
2138              
2139             =back
2140              
2141             =head2 Hibbard's algorithm.
2142              
2143             =over 3
2144              
2145             =item
2146              
2147             T. N. Hibbard, "A Simple Sorting Algorithm", Journal of the ACM Vol. 10, 1963, pp. 142-50.
2148              
2149             =back
2150              
2151             =head2 Batcher's Merge Exchange algorithm.
2152              
2153             =over 3
2154              
2155             =item
2156              
2157             Code for Kenneth Batcher's Merge Exchange algorithm was derived from Knuth's
2158             The Art of Computer Programming, Vol. 3, section 5.2.2.
2159              
2160             =back
2161              
2162             =head2 Batcher's Bitonic algorithm
2163              
2164             =over 3
2165              
2166             =item
2167              
2168             Kenneth Batcher, "Sorting Networks and their Applications", Proc. of the
2169             AFIPS Spring Joint Computing Conf., Vol. 32, 1968, pp. 307-3114. A PDF of
2170             this article may be found at L<http://www.cs.kent.edu/~batcher/sort.pdf>.
2171              
2172             The paper discusses both the Odd-Even Merge algorithm and the Bitonic algorithm.
2173              
2174             =item
2175              
2176             Dr. Hans Werner Lang has written a detailed discussion of the bitonic
2177             sort algorithm here:
2178             L<http://www.iti.fh-flensburg.de/lang/algorithmen/sortieren/bitonic/bitonicen.htm>
2179              
2180             =item
2181              
2182             T. H. Cormen, E. E. Leiserson, R. L. Rivest, Introduction to Algorithms,
2183             first edition, McGraw-Hill, 1990, section 28.3.
2184              
2185             =item
2186              
2187             T. H. Cormen, E. E. Leiserson, R. L. Rivest, C. Stein, Introduction to Algorithms,
2188             2nd edition, McGraw-Hill, 2001, section 27.3.
2189              
2190             =back
2191              
2192             =head2 Algorithm discussion
2193              
2194             =over 3
2195              
2196             =item
2197              
2198             Donald E. Knuth, The Art of Computer Programming, Vol. 3: (2nd ed.)
2199             Sorting and Searching, Addison Wesley Longman Publishing Co., Inc.,
2200             Redwood City, CA, 1998.
2201              
2202             =item
2203              
2204             Kenneth Batcher's web site (L<http://www.cs.kent.edu/~batcher/>) lists
2205             his publications, including his paper listed above.
2206              
2207             =back
2208              
2209             =head1 AUTHOR
2210              
2211             John M. Gamble may be found at B<jgamble@cpan.org>
2212              
2213             =cut