[libheap-perl] 01/04: [svn-inject] Installing original source of libheap-perl
dom at earth.li
dom at earth.li
Wed Mar 23 22:09:45 UTC 2016
This is an automated email from the git hooks/post-receive script.
dom pushed a commit to branch master
in repository libheap-perl.
commit 6de6581bca8405ce6da88929be2435e6bd27c8a2
Author: Dominic Hargreaves <dom at earth.li>
Date: Tue Oct 23 22:29:52 2007 +0000
[svn-inject] Installing original source of libheap-perl
---
Changes | 50 ++++++
MANIFEST | 30 ++++
META.yml | 11 ++
Makefile.PL | 10 ++
README | 45 +++++
TODO | 7 +
lib/Heap.pm | 144 +++++++++++++++
lib/Heap/Binary.pm | 311 ++++++++++++++++++++++++++++++++
lib/Heap/Binomial.pm | 456 ++++++++++++++++++++++++++++++++++++++++++++++
lib/Heap/Elem.pm | 163 +++++++++++++++++
lib/Heap/Elem/Num.pm | 77 ++++++++
lib/Heap/Elem/NumRev.pm | 77 ++++++++
lib/Heap/Elem/Ref.pm | 83 +++++++++
lib/Heap/Elem/RefRev.pm | 83 +++++++++
lib/Heap/Elem/Str.pm | 79 ++++++++
lib/Heap/Elem/StrRev.pm | 80 +++++++++
lib/Heap/Fibonacci.pm | 470 ++++++++++++++++++++++++++++++++++++++++++++++++
t/binary.t | 40 +++++
t/binomial.t | 41 +++++
t/elem.t | 27 +++
t/fibonacci.t | 39 ++++
t/num.t | 26 +++
t/numrev.t | 26 +++
t/ref.t | 26 +++
t/refrev.t | 26 +++
t/str.t | 26 +++
t/strrev.t | 26 +++
t/test.t | 107 +++++++++++
t/test_leaks.t | 95 ++++++++++
t/test_leaks2.t | 59 ++++++
30 files changed, 2740 insertions(+)
diff --git a/Changes b/Changes
new file mode 100644
index 0000000..ff11b82
--- /dev/null
+++ b/Changes
@@ -0,0 +1,50 @@
+Revision history for Perl extension Heap.
+
+0.01 Sun Apr 26 14:37:24 1998
+ - original version; created by h2xs 1.18
+
+0.50 (about Apr 28 1998)
+ - first general release
+
+0.60 Sun Nov 16 16:58:12 EST 2003
+ - ensured that $elem->heap can be tested for undef
+ to determine whether it is actually on a heap at
+ the moment
+ - requested by Dan Bolser <dmb at mrc-dunn.cam.ac.uk>
+ - fixed bug in Heap::Binary delete
+ - noted by Arun Bhalla <bhalla at uiuc.edu>
+ - changes to t/test.t
+ - added tests for delete
+ - made test run against all Heap variants
+ - made test configurable to get a small test case
+ for solving bugs
+ - fixed bug in Heap::Binomial delete
+ - Heap::Fibonacci delete worked in tests
+
+0.70 Fri Dec 5 00:55:41 EST 2003
+ - finally got around to renaming minimum and
+ extract_minimum methods to top and extract_top
+ - prompted by Steve Lembark <lembark at wrkhors.com>
+ - old names are still supported, but depracated
+
+0.71 Thu Jun 17 12:25:36 EDT 2004
+ - fixed a memory leak in Heap::Fibonacci
+ - the DESTROY method did'nt traverse fully
+ - one final reference to extract_minimum in doc for Heap.pm
+ - both issues reported by Christian Plessl <plessl at tik.ee.ethz.ch>
+
+0.72 Fri Jul 8 09:05:04 CET 2005 (Tels)
+ - moved file to lib/ and t/ to remove clutter and simplify build
+ - rewrite most test files to use Test::More
+ - change test files to load this version, not currently installed one
+ - added tests for the various other .pm files
+ - removed unnec. require Autoloader and comments about autoloading
+ - remove "perl extension" from ABSTRACTs
+ - Heap::Elem gets proper heap() and val() routines, the
+ other subclasses (Heap::Elem::Num etc) now simple inherit them
+
+0.80 Sat Apr 28 12:25:51 EDT 2007
+ - accepted (finally) all of the changes submitted by Tels++
+ - Heap::Elem gets proper new() method too, others all inherit it
+ - made cmp, val and heap methods use @_ for speed (as suggested
+ by Tels++)
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..4a3f612
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,30 @@
+Changes
+MANIFEST
+Makefile.PL
+README
+TODO
+lib/Heap.pm
+lib/Heap/Binary.pm
+lib/Heap/Binomial.pm
+lib/Heap/Elem.pm
+lib/Heap/Elem/Num.pm
+lib/Heap/Elem/NumRev.pm
+lib/Heap/Elem/Ref.pm
+lib/Heap/Elem/RefRev.pm
+lib/Heap/Elem/Str.pm
+lib/Heap/Elem/StrRev.pm
+lib/Heap/Fibonacci.pm
+t/binary.t
+t/binomial.t
+t/num.t
+t/numrev.t
+t/ref.t
+t/refrev.t
+t/str.t
+t/strrev.t
+t/elem.t
+t/fibonacci.t
+t/test.t
+t/test_leaks.t
+t/test_leaks2.t
+META.yml Module meta-data (added by MakeMaker)
diff --git a/META.yml b/META.yml
new file mode 100644
index 0000000..d51e4b9
--- /dev/null
+++ b/META.yml
@@ -0,0 +1,11 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: Heap
+version: 0.80
+version_from: lib/Heap.pm
+installdirs: site
+requires:
+ Test::Simple: 0.45
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..bb4ad1f
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,10 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ PREREQ_PM => {
+ Test::Simple => 0.45,
+ },
+ 'NAME' => 'Heap',
+ 'VERSION_FROM' => 'lib/Heap.pm', # finds $VERSION
+);
diff --git a/README b/README
new file mode 100644
index 0000000..7433deb
--- /dev/null
+++ b/README
@@ -0,0 +1,45 @@
+Heap routines...
+
+This is a collection of routines for managing a heap data structure.
+
+There are two major components: a heap component, and an element
+component.
+
+A heap package basically keeps a collection of elements and is
+able to return the smallest one.
+
+The heap component interface is defined in Heap(3) and must be
+supported by all heap packages. Currently there are three heap
+components provided:
+
+ Heap::Fibonacci (the preferred one)
+ Heap::Binomial
+ Heap::Binary
+
+See the book "Algorithms" by Cormen, Leiserson, and Rivest for
+details of the three heap packages.
+
+The element package wraps the data that is to be stored and retrieved
+on the heap. You can inherit from the Heap::Elem object to embed
+element capability into your own objects, or you can use the provided
+objects to embed your data into elements without having to
+specifically design your dat for that purpose. The Heap::Elem(3)
+module provides a detailed description of the requirements of an
+element module. (The main ones are that it must provide a cmp method
+so that the elements can be ordered, and it must provide a heap
+method that will either store or retrieve a scalar value so that the
+heap routines can map an element reference into its position within
+the heap.
+
+Version 0.70 was used for the graph routines in the book "Mastering
+Algorithms with Perl", and there has been some feedback from users,
+which indicates that it is not too rough around the edges.
+
+Comments to:
+
+ John Macdonald <john at perlwolf.com>
+
+Copyright:
+
+ This code is copyright 1998-2007 O'Reilly & Associates. It is
+ available on the same terms as perl itself.
diff --git a/TODO b/TODO
new file mode 100644
index 0000000..8e07402
--- /dev/null
+++ b/TODO
@@ -0,0 +1,7 @@
+
+Tels 2005-07-08:
+
+ * internal helper functions should have a leading underscore
+ (_moveto() vs. moveto)
+ * unec. forward declarations could be removed
+ * write a few more tests
diff --git a/lib/Heap.pm b/lib/Heap.pm
new file mode 100644
index 0000000..b076202
--- /dev/null
+++ b/lib/Heap.pm
@@ -0,0 +1,144 @@
+package Heap;
+
+# heap is mainly here as documentation for the common heap interface.
+# It defaults to Heap::Fibonacci.
+
+use strict;
+use vars qw($VERSION);
+
+$VERSION = '0.80';
+
+sub new {
+ use Heap::Fibonacci;
+
+ return &Heap::Fibonacci::new;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Heap - Perl extensions for keeping data partially sorted
+
+=head1 SYNOPSIS
+
+ use Heap;
+
+ my $heap = Heap->new;
+ my $elem;
+
+ use Heap::Elem::Num(NumElem);
+
+ foreach $i ( 1..100 ) {
+ $elem = NumElem( $i );
+ $heap->add( $elem );
+ }
+
+ while( defined( $elem = $heap->extract_top ) ) {
+ print "Smallest is ", $elem->val, "\n";
+ }
+
+=head1 DESCRIPTION
+
+The Heap collection of modules provide routines that manage
+a heap of elements. A heap is a partially sorted structure
+that is always able to easily extract the smallest of the
+elements in the structure (or the largest if a reversed compare
+routine is provided).
+
+If the collection of elements is changing dynamically, the
+heap has less overhead than keeping the collection fully
+sorted.
+
+The elements must be objects as described in L<"Heap::Elem">
+and all elements inserted into one heap must be mutually
+compatible - either the same class exactly or else classes that
+differ only in ways unrelated to the B<Heap::Elem> interface.
+
+=head1 METHODS
+
+=over 4
+
+=item $heap = HeapClass::new(); $heap2 = $heap1->new();
+
+Returns a new heap object of the specified (sub-)class.
+This is often used as a subroutine instead of a method,
+of course.
+
+=item $heap->DESTROY
+
+Ensures that no internal circular data references remain.
+Some variants of Heap ignore this (they have no such references).
+Heap users normally need not worry about it, DESTROY is automatically
+invoked when the heap reference goes out of scope.
+
+=item $heap->add($elem)
+
+Add an element to the heap.
+
+=item $elem = $heap->top
+
+Return the top element on the heap. It is B<not> removed from
+the heap but will remain at the top. It will be the smallest
+element on the heap (unless a reversed cmp function is being
+used, in which case it will be the largest). Returns I<undef>
+if the heap is empty.
+
+This method used to be called "minimum" instead of "top". The
+old name is still supported but is deprecated. (It was confusing
+to use the method "minimum" to get the maximum value on the heap
+when a reversed cmp function was used for ordering elements.)
+
+=item $elem = $heap->extract_top
+
+Delete the top element from the heap and return it. Returns
+I<undef> if the heap was empty.
+
+This method used to be called "extract_minimum" instead of
+"extract_top". The old name is still supported but is deprecated.
+(It was confusing to use the method "extract_minimum" to get the
+maximum value on the heap when a reversed cmp function was used
+for ordering elements.)
+
+=item $heap1->absorb($heap2)
+
+Merge all of the elements from I<$heap2> into I<$heap1>.
+This will leave I<$heap2> empty.
+
+=item $heap1->decrease_key($elem)
+
+The element will be moved closed to the top of the
+heap if it is now smaller than any higher parent elements.
+The user must have changed the value of I<$elem> before
+I<decrease_key> is called. Only a decrease is permitted.
+(This is a decrease according to the I<cmp> function - if it
+is a reversed order comparison, then you are only permitted
+to increase the value of the element. To be pedantic, you
+may only use I<decrease_key> if
+I<$elem->cmp($elem_original) <= 0> if I<$elem_original> were
+an elem with the value that I<$elem> had before it was
+I<decreased>.)
+
+=item $elem = $heap->delete($elem)
+
+The element is removed from the heap (whether it is at
+the top or not).
+
+=back
+
+=head1 AUTHOR
+
+John Macdonald, john at perlwolf.com
+
+=head1 COPYRIGHT
+
+Copyright 1998-2007, O'Reilly & Associates.
+
+This code is distributed under the same copyright terms as perl itself.
+
+=head1 SEE ALSO
+
+Heap::Elem(3), Heap::Binary(3), Heap::Binomial(3), Heap::Fibonacci(3).
+
+=cut
diff --git a/lib/Heap/Binary.pm b/lib/Heap/Binary.pm
new file mode 100644
index 0000000..16d5995
--- /dev/null
+++ b/lib/Heap/Binary.pm
@@ -0,0 +1,311 @@
+package Heap::Binary;
+
+use strict;
+use vars qw($VERSION);
+
+$VERSION = '0.80';
+
+# common names:
+# h - heap head
+# i - index of a heap value element
+# v - user-provided value (to be) stored on the heap
+
+################################################# debugging control
+
+my $debug = 0;
+my $validate = 0;
+
+# enable/disable debugging output
+sub debug {
+ @_ ? ($debug = shift) : $debug;
+}
+
+# enable/disable validation checks on values
+sub validate {
+ @_ ? ($validate = shift) : $validate;
+}
+
+my $width = 3;
+my $bar = ' | ';
+my $corner = ' +-';
+my $vfmt = "%3d";
+
+sub set_width {
+ $width = shift;
+ $width = 2 if $width < 2;
+
+ $vfmt = "%${width}d";
+ $bar = $corner = ' ' x $width;
+ substr($bar,-2,1) = '|';
+ substr($corner,-2,2) = '+-';
+}
+
+
+sub hdump {
+ my $h = shift;
+ my $i = shift;
+ my $p = shift;
+ my $ch = $i*2+1;
+
+ return if $i >= @$h;
+
+ my $space = ' ' x $width;
+
+ printf( "%${width}d", $h->[$i]->val );
+ if( $ch+1 < @$h ) {
+ hdump( $h, $ch, $p . $bar);
+ print( $p, $corner );
+ ++$ch;
+ }
+ if( $ch < @$h ) {
+ hdump( $h, $ch, $p . $space );
+ } else {
+ print "\n";
+ }
+}
+
+sub heapdump {
+ my $h;
+
+ while( $h = shift ) {
+ hdump $h, 0, '';
+ print "\n";
+ }
+}
+
+sub heapcheck {
+ my $h;
+ while( $h = shift ) {
+ my $i;
+ my $p;
+ next unless @$h;
+ for( $p = 0, $i = 1; $i < @$h; ++$p, ++$i ) {
+ $h->[$p]->cmp($h->[$i]) <= 0 or die "not in heap order";
+ last unless ++$i < @$h;
+ $h->[$p]->cmp($h->[$i]) <= 0 or die "not in heap order";
+ }
+ heapdump $h if $validate >= 2;
+ }
+}
+
+################################################# forward declarations
+
+sub moveto;
+sub heapup;
+sub heapdown;
+
+################################################# heap methods
+
+# new() usually Heap::Binary->new()
+# return a new empty heap
+sub new {
+ my $self = shift;
+ my $class = ref($self) || $self;
+ return bless [], $class;
+}
+
+# add($h,$v) usually $h->add($v)
+# insert value $v into the heap
+sub add {
+ my $h = shift;
+ my $v = shift;
+ $validate && do {
+ die "Method 'heap' required for element on heap"
+ unless $v->can('heap');
+ die "Method 'cmp' required for element on heap"
+ unless $v->can('cmp');
+ };
+ heapup $h, scalar(@$h), $v;
+}
+
+# top($h) usually $h->top
+# the smallest value is returned, but it is still left on the heap
+sub top {
+ my $h = shift;
+ $h->[0];
+}
+
+*minimum = \⊤
+
+# extract_top($h) usually $h->extract_top
+# the smallest value is returned after removing it from the heap
+sub extract_top {
+ my $h = shift;
+ my $top = $h->[0];
+ if( @$h ) {
+ # there was at least one item, must decrease the heap
+ $top->heap(undef);
+ my $last = pop(@$h);
+ if( @$h ) {
+ # $top was not the only thing left, so re-heap the
+ # remainder by over-writing position zero (where
+ # $top was) using the value popped from the end
+ heapdown $h, 0, $last;
+ }
+ }
+ $top;
+}
+
+*extract_minimum = \&extract_top;
+
+# absorb($h,$h2) usually $h->absorb($h2)
+# all of the values in $h2 are inserted into $h instead, $h2 is left
+# empty.
+sub absorb {
+ my $h = shift;
+ my $h2 = shift;
+ my $v;
+
+ foreach $v (splice @$h2, 0) {
+ $h->add($v);
+ }
+ $h;
+}
+
+# decrease_key($h,$v) usually $h->decrease_key($v)
+# the key value of $v has just been decreased and so it may need to
+# be percolated to a higher position in the heap
+sub decrease_key {
+ my $h = shift;
+ my $v = shift;
+ $validate && do {
+ die "Method 'heap' required for element on heap"
+ unless $v->can('heap');
+ die "Method 'cmp' required for element on heap"
+ unless $v->can('cmp');
+ };
+ my $i = $v->heap;
+
+ heapup $h, $i, $v;
+}
+
+# delete($h,$v) usually: $h->delete($v)
+# delete value $v from heap $h. It must have previously been
+# add'ed to $h.
+sub delete {
+ my $h = shift;
+ my $v = shift;
+ $validate && do {
+ die "Method 'heap' required for element on heap"
+ unless $v->can('heap');
+ die "Method 'cmp' required for element on heap"
+ unless $v->can('cmp');
+ };
+ my $i = $v->heap;
+
+ return $v unless defined $i;
+
+ if( $i == $#$h ) {
+ pop @$h;
+ } else {
+ my $v2 = pop @$h;
+ if( $v2->cmp($v) < 0 ) {
+ heapup $h, $i, $v2;
+ } else {
+ heapdown $h, $i, $v2;
+ }
+ }
+ $v->heap(undef);
+ return $v;
+}
+
+
+################################################# internal utility functions
+
+# moveto($h,$i,$v)
+# place value $v at index $i in the heap $h, and update it record
+# of where it is located
+sub moveto {
+ my $h = shift;
+ my $i = shift;
+ my $v = shift;
+
+ $h->[$i] = $v;
+ $v->heap($i);
+}
+
+# heapup($h,$i,$v)
+# value $v is to be placed at index $i in heap $h, but it might
+# be smaller than some of its parents. Keep pushing parents down
+# until a smaller parent is found or the top of the heap is reached,
+# and then place $v there.
+sub heapup {
+ my $h = shift;
+ my $i = shift;
+ my $v = shift;
+ my $pi; # parent index
+
+ while( $i && $v->cmp($h->[$pi = int( ($i-1)/2 )]) < 0 ) {
+ moveto $h, $i, $h->[$pi];
+ $i = $pi;
+ }
+
+ moveto $h, $i, $v;
+ $v;
+}
+
+# heapdown($h,$i,$v)
+# value $v is to be placed at index $i in heap $h, but it might
+# have children that are smaller than it is. Keep popping the smallest
+# child up until a pair of larger children is found or a leaf node is
+# reached, and then place $v there.
+sub heapdown {
+ my $h = shift;
+ my $i = shift;
+ my $v = shift;
+ my $leaf = int(@$h/2);
+
+ while( $i < $leaf ) {
+ my $j = $i*2+1;
+ my $k = $j+1;
+
+ $j = $k if $k < @$h && $h->[$k]->cmp($h->[$j]) < 0;
+ if( $v->cmp($h->[$j]) > 0 ) {
+ moveto $h, $i, $h->[$j];
+ $i = $j;
+ next;
+ }
+ last;
+ }
+ moveto $h, $i, $v;
+}
+
+
+1;
+
+__END__
+
+=head1 NAME
+
+Heap::Binary - a binary heap to keep data partially sorted
+
+=head1 SYNOPSIS
+
+ use Heap::Binary;
+
+ $heap = Heap::Binary->new;
+ # see Heap(3) for usage
+
+=head1 DESCRIPTION
+
+Keeps an array of elements in heap order. The I<heap> method
+of an element is used to store the index into the array that
+refers to the element.
+
+See L<Heap> for details on using this module.
+
+=head1 AUTHOR
+
+John Macdonald, john at perlwolf.com
+
+=head1 COPYRIGHT
+
+Copyright 1998-2007, O'Reilly & Associates.
+
+This code is distributed under the same copyright terms as perl itself.
+
+=head1 SEE ALSO
+
+Heap(3), Heap::Elem(3).
+
+=cut
diff --git a/lib/Heap/Binomial.pm b/lib/Heap/Binomial.pm
new file mode 100644
index 0000000..4597c4a
--- /dev/null
+++ b/lib/Heap/Binomial.pm
@@ -0,0 +1,456 @@
+package Heap::Binomial;
+
+use strict;
+use vars qw($VERSION);
+
+$VERSION = '0.80';
+
+# common names
+# h - heap head
+# el - linkable element, contains user-provided value
+# v - user-provided value
+
+################################################# debugging control
+
+my $debug = 0;
+my $validate = 0;
+
+# enable/disable debugging output
+sub debug {
+ @_ ? ($debug = shift) : $debug;
+}
+
+# enable/disable validation checks on values
+sub validate {
+ @_ ? ($validate = shift) : $validate;
+}
+
+my $width = 3;
+my $bar = ' | ';
+my $corner = ' +-';
+my $vfmt = "%3d";
+
+sub set_width {
+ $width = shift;
+ $width = 2 if $width < 2;
+
+ $vfmt = "%${width}d";
+ $bar = $corner = ' ' x $width;
+ substr($bar,-2,1) = '|';
+ substr($corner,-2,2) = '+-';
+}
+
+sub hdump {
+ my $el = shift;
+ my $l1 = shift;
+ my $b = shift;
+
+ my $ch;
+
+ unless( $el ) {
+ print $l1, "\n";
+ return;
+ }
+
+ hdump( $ch = $el->{child},
+ $l1 . sprintf( $vfmt, $el->{val}->val),
+ $b . $bar );
+
+ while( $ch = $ch->{sib} ) {
+ hdump( $ch, $b . $corner, $b . $bar );
+ }
+}
+
+sub heapdump {
+ my $h;
+
+ while( $h = shift ) {
+ my $el;
+
+ for( $el = $$h; $el; $el = $el->{sib} ) {
+ hdump( $el, sprintf( "%02d: ", $el->{degree}), ' ' );
+ }
+ print "\n";
+ }
+}
+
+sub bhcheck {
+
+ my $pel = shift;
+ my $pdeg = $pel->{degree};
+ my $pv = $pel->{val};
+ my $cel;
+ for( $cel = $pel->{child}; $cel; $cel = $cel->{sib} ) {
+ die "degree not decreasing in heap"
+ unless --$pdeg == $cel->{degree};
+ die "heap order not preserved"
+ unless $pv->cmp($cel->{val}) <= 0;
+ bhcheck($cel);
+ }
+ die "degree did not decrease to zero"
+ unless $pdeg == 0;
+}
+
+
+sub heapcheck {
+ my $h;
+ while( $h = shift ) {
+ heapdump $h if $validate >= 2;
+ my $el = $$h or next;
+ my $pdeg = -1;
+ for( ; $el; $el = $el->{sib} ) {
+ $el->{degree} > $pdeg
+ or die "degree not increasing in list";
+ $pdeg = $el->{degree};
+ bhcheck($el);
+ }
+ }
+}
+
+
+################################################# forward declarations
+
+sub elem;
+sub elem_DESTROY;
+sub link_to;
+sub moveto;
+
+################################################# heap methods
+
+
+sub new {
+ my $self = shift;
+ my $class = ref($self) || $self;
+ my $h = undef;
+ bless \$h, $class;
+}
+
+sub DESTROY {
+ my $h = shift;
+
+ elem_DESTROY $$h;
+}
+
+sub add {
+ my $h = shift;
+ my $v = shift;
+ $validate && do {
+ die "Method 'heap' required for element on heap"
+ unless $v->can('heap');
+ die "Method 'cmp' required for element on heap"
+ unless $v->can('cmp');
+ };
+ $$h = elem $v, $$h;
+ $h->self_union_once;
+}
+
+sub top {
+ my $h = shift;
+ my $el = $$h or return undef;
+ my $top = $el->{val};
+ while( $el = $el->{sib} ) {
+ $top = $el->{val}
+ if $top->cmp($el->{val}) > 0;
+ }
+ $top;
+}
+
+*minimum = \⊤
+
+sub extract_top {
+ my $h = shift;
+ my $mel = $$h or return undef;
+ my $top = $mel->{val};
+ my $mpred = $h;
+ my $el = $mel;
+ my $pred = $h;
+
+ # find the heap with the lowest value on it
+ while( $pred = \$el->{sib}, $el = $$pred ) {
+ if( $top->cmp($el->{val}) > 0 ) {
+ $top = $el->{val};
+ $mel = $el;
+ $mpred = $pred;
+ }
+ }
+
+ # found it, $mpred points to it, $mel is its container, $val is it
+ # unlink it from the chain
+ $$mpred = $mel->{sib};
+
+ # we're going to return the value from $mel, but all of its children
+ # must be retained in the heap. Make a second heap with the children
+ # and then merge the heaps.
+ $h->absorb_children($mel);
+
+ # finally break all of its pointers, so that we won't leave any
+ # memory loops when we forget about the pointer to $mel
+ $mel->{p} = $mel->{child} = $mel->{sib} = $mel->{val} = undef;
+
+ # break the back link
+ $top->heap(undef);
+
+ # and return the value
+ $top;
+}
+
+*extract_minimum = \&extract_top;
+
+sub absorb {
+ my $h = shift;
+ my $h2 = shift;
+
+ my $dest_link = $h;
+ my $el1 = $$h;
+ my $el2 = $$h2;
+ my $anymerge = $el1 && $el2;
+ while( $el1 && $el2 ) {
+ if( $el1->{degree} <= $el2->{degree} ) {
+ # advance on h's list, it's already linked
+ $dest_link = \$el1->{sib};
+ $el1 = $$dest_link;
+ } else {
+ # move next h2 elem to head of h list
+ $$dest_link = $el2;
+ $dest_link = \$el2->{sib};
+ $el2 = $$dest_link;
+ $$dest_link = $el1;
+ }
+ }
+
+ # if h ran out first, move rest of h2 onto end
+ if( $el2 ) {
+ $$dest_link = $el2;
+ }
+
+ # clean out h2, all of its elements have been move to h
+ $$h2 = undef;
+
+ # fix up h - it can have multiple items at the same degree if we
+ # actually merged two non-empty lists
+ $anymerge ? $h->self_union: $h;
+}
+
+# a key has been decreased, it may have to percolate up in its heap
+sub decrease_key {
+ my $h = shift;
+ my $v = shift;
+ my $el = $v->heap or return undef;
+ my $p;
+
+ while( $p = $el->{p} ) {
+ last if $v->cmp($p->{val}) >= 0;
+ moveto $el, $p->{val};
+ $el = $p;
+ }
+
+ moveto $el, $v;
+
+ $v;
+}
+
+# to delete an item, we bubble it to the top of its heap (as if its key
+# had been decreased to -infinity), and then remove it (as in extract_top)
+sub delete {
+ my $h = shift;
+ my $v = shift;
+ my $el = $v->heap or return undef;
+
+ # bubble it to the top of its heap
+ my $p;
+ while( $p = $el->{p} ) {
+ moveto $el, $p->{val};
+ $el = $p;
+ }
+
+ # find it on the main list, to remove it and split up the children
+ my $n;
+ for( $p = $h; ($n = $$p) && $n != $el; $p = \$n->{sib} ) {
+ ;
+ }
+
+ # remove it from the main list
+ $$p = $el->{sib};
+
+ # put any children back onto the main list
+ $h->absorb_children($el);
+
+ # remove the link to $el
+ $v->heap(undef);
+
+ return $v;
+}
+
+
+################################################# internal utility functions
+
+sub elem {
+ my $v = shift;
+ my $sib = shift;
+ my $el = {
+ p => undef,
+ degree => 0,
+ child => undef,
+ val => $v,
+ sib => $sib,
+ };
+ $v->heap($el);
+ $el;
+}
+
+sub elem_DESTROY {
+ my $el = shift;
+ my $ch;
+ my $next;
+
+ while( $el ) {
+ $ch = $el->{child} and elem_DESTROY $ch;
+ $next = $el->{sib};
+
+ $el->{val}->heap(undef);
+ $el->{child} = $el->{sib} = $el->{p} = $el->{val} = undef;
+ $el = $next;
+ }
+}
+
+sub link_to {
+ my $el = shift;
+ my $p = shift;
+
+ $el->{p} = $p;
+ $el->{sib} = $p->{child};
+ $p->{child} = $el;
+ $p->{degree}++;
+}
+
+sub moveto {
+ my $el = shift;
+ my $v = shift;
+
+ $el->{val} = $v;
+ $v->heap($el);
+}
+
+# we've merged two lists in degree order. Traverse the list and link
+# together any pairs (adding 1 + 1 to get 10 in binary) to the next
+# higher degree. After such a merge, there may be a triple at the
+# next degree - skip one and merge the others (adding 1 + 1 + carry
+# of 1 to get 11 in binary).
+sub self_union {
+ my $h = shift;
+ my $prev = $h;
+ my $cur = $$h;
+ my $next;
+ my $n2;
+
+ while( $next = $cur->{sib} ) {
+ if( $cur->{degree} != $next->{degree} ) {
+ $prev = \$cur->{sib};
+ $cur = $next;
+ next;
+ }
+
+ # two or three of same degree, need to do a merge. First though,
+ # skip over the leading one of there are three (it is the result
+ # [carry] from the previous merge)
+ if( ($n2 = $next->{sib}) && $n2->{degree} == $cur->{degree} ) {
+ $prev = \$cur->{sib};
+ $cur = $next;
+ $next = $n2;
+ }
+
+ # and now the merge
+ if( $cur->{val}->cmp($next->{val}) <= 0 ) {
+ $cur->{sib} = $next->{sib};
+ link_to $next, $cur;
+ } else {
+ $$prev = $next;
+ link_to $cur, $next;
+ $cur = $next;
+ }
+ }
+ $h;
+}
+
+# we've added one element at the front, keep merging pairs until there isn't
+# one of the same degree (change all the low order one bits to zero and the
+# lowest order zero bit to one)
+sub self_union_once {
+ my $h = shift;
+ my $cur = $$h;
+ my $next;
+
+ while( $next = $cur->{sib} ) {
+ return if $cur->{degree} != $next->{degree};
+
+ # merge
+ if( $cur->{val}->cmp($next->{val}) <= 0 ) {
+ $cur->{sib} = $next->{sib};
+ link_to $next, $cur;
+ } else {
+ $$h = $next;
+ link_to $cur, $next;
+ $cur = $next;
+ }
+ }
+ $h;
+}
+
+# absorb all the children of an element into a heap
+sub absorb_children {
+ my $h = shift;
+ my $el = shift;
+
+ my $h2 = $h->new;
+ my $child = $el->{child};
+ while( $child ) {
+ my $sib = $child->{sib};
+ $child->{sib} = $$h2;
+ $child->{p} = undef;
+ $$h2 = $child;
+ $child = $sib;
+ }
+
+ # merge them all in
+ $h->absorb($h2);
+}
+
+
+1;
+
+__END__
+
+=head1 NAME
+
+Heap::Binomial - a binomial heap to keep data partially sorted
+
+=head1 SYNOPSIS
+
+ use Heap::Binomial;
+
+ $heap = Heap::Binomial->new;
+ # see Heap(3) for usage
+
+=head1 DESCRIPTION
+
+Keeps elements in heap order using a linked list of binomial trees.
+The I<heap> method of an element is used to store a reference to
+the node in the list that refers to the element.
+
+See L<Heap> for details on using this module.
+
+=head1 AUTHOR
+
+John Macdonald, john at perlwolf.com
+
+=head1 COPYRIGHT
+
+Copyright 1998-2007, O'Reilly & Associates.
+
+This code is distributed under the same copyright terms as perl itself.
+
+=head1 SEE ALSO
+
+Heap(3), Heap::Elem(3).
+
+=cut
diff --git a/lib/Heap/Elem.pm b/lib/Heap/Elem.pm
new file mode 100644
index 0000000..8f47484
--- /dev/null
+++ b/lib/Heap/Elem.pm
@@ -0,0 +1,163 @@
+package Heap::Elem;
+
+use strict;
+use vars qw($VERSION);
+
+$VERSION = '0.80';
+
+sub new {
+ my $class = shift;
+ $class = ref($class) || $class;
+
+ # value is undef, single scalar, or hash depending upon args
+ my $val = (@_ > 1) ? { @_ }
+ : @_ ? $_[0]
+ : undef;
+
+ # two slot array, 0 for the element's own value, 1 for use by Heap
+ my $self = [ $val, undef ];
+
+ return bless $self, $class;
+}
+
+
+# get or set value slot
+sub val {
+ @_ > 1 ? ($_[0][0] = $_[1]) : $_[0][0];
+}
+
+# get or set heap slot
+sub heap {
+ @_ > 1 ? ($_[0][1] = $_[1]) : $_[0][1];
+}
+
+sub cmp {
+ die "This cmp method must be superceded by one that knows how to compare elements."
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Heap::Elem - Base class for elements in a Heap
+
+=head1 SYNOPSIS
+
+ use Heap::Elem::SomeInheritor;
+
+ use Heap::SomeHeapClass;
+
+ $elem = Heap::Elem::SomeInheritor->new( $value );
+ $heap = Heap::SomeHeapClass->new;
+
+ $heap->add($elem);
+
+=head1 DESCRIPTION
+
+This is an inheritable class for Heap Elements. It provides
+the interface documentation and some inheritable methods.
+Only a child classes can be used - this class is not complete.
+
+=head1 METHODS
+
+=over 4
+
+=item $elem = Heap::Elem::SomeInheritor->new( [args] );
+
+Creates a new Elem.
+If there is exactly one arg, the Elem's value will be set
+to that value.
+If there is more than one arg provided, the Elem's value will be set
+to an anonymous hash initialized to the provided args (which must
+have an even number, of course).
+
+=item $elem->heap( $val ); $elem->heap;
+
+Provides a method for use by the Heap processing routines.
+If a value argument is provided, it will be saved. The
+new saved value is always returned. If no value argument
+is provided, the old saved value is returned.
+
+The Heap processing routines use this method to map an element
+into its internal structure. This is needed to support the
+Heap methods that affect elements that are not are the top
+of the heap - I<decrease_key> and I<delete>.
+
+The Heap processing routines will ensure that this value is
+undef when this elem is removed from a heap, and is not undef
+after it is inserted into a heap. This means that you can
+check whether an element is currently contained within a heap
+or not. (It cannot be used to determine which heap an element
+is contained in, if you have multiple heaps. Keeping that
+information accurate would make the operation of merging two
+heaps into a single one take longer - it would have to traverse
+all of the elements in the merged heap to update them; for
+Binomial and Fibonacci heaps that would turn an O(1) operation
+into an O(n) one.)
+
+=item $elem->val( $val ); $elem->val;
+
+Provides a method to get and/or set the value of the element.
+
+=item $elem1->cmp($elem2)
+
+A routine to compare two elements. It must return a negative
+value if this element should go higher on the heap than I<$elem2>,
+0 if they are equal, or a positive value if this element should
+go lower on the heap than I<$elem2>. Just as with sort, the
+Perl operators <=> and cmp cause the smaller value to be returned
+first; similarly you can negate the meaning to reverse the order
+- causing the heap to always return the largest element instead
+of the smallest.
+
+=back
+
+=head1 INHERITING
+
+This class can be inherited to provide an object with the
+ability to be heaped. If the object is implemented as
+a hash, and if it can deal with a key of I<heap>, leaving
+it unchanged for use by the heap routines, then the following
+implemetation will work.
+
+ package myObject;
+
+ require Exporter;
+
+ @ISA = qw(Heap::Elem);
+
+ sub new {
+ my $self = shift;
+ my $class = ref($self) || $self;
+
+ my $self = SUPER::new($class);
+
+ # set $self->{key} = $value;
+ }
+
+ sub cmp {
+ my $self = shift;
+ my $other = shift;
+
+ $self->{key} cmp $other->{key};
+ }
+
+ # other methods for the rest of myObject's functionality
+
+=head1 AUTHOR
+
+John Macdonald, john at perlwolf.com
+
+=head1 COPYRIGHT
+
+Copyright 1998-2007, O'Reilly & Associates.
+
+This code is distributed under the same copyright terms as perl itself.
+
+=head1 SEE ALSO
+
+Heap(3), Heap::Elem::Num(3), Heap::Elem::NumRev(3),
+Heap::Elem::Str(3), Heap::Elem::StrRev(3).
+
+=cut
diff --git a/lib/Heap/Elem/Num.pm b/lib/Heap/Elem/Num.pm
new file mode 100644
index 0000000..4c5fdb8
--- /dev/null
+++ b/lib/Heap/Elem/Num.pm
@@ -0,0 +1,77 @@
+package Heap::Elem::Num;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+use Heap::Elem;
+
+require Exporter;
+
+ at ISA = qw(Exporter Heap::Elem);
+
+# No names exported.
+ at EXPORT = ( );
+
+# Available for export: NumElem (to allocate a new Heap::Elem::Num value)
+ at EXPORT_OK = qw( NumElem );
+
+$VERSION = '0.80';
+
+sub NumElem { # exportable synonym for new
+ Heap::Elem::Num->new(@_);
+}
+
+# compare two Num elems
+sub cmp {
+ return $_[0][0] <=> $_[1][0];
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Heap::Elem::Num - Numeric Heap Elements
+
+=head1 SYNOPSIS
+
+ use Heap::Elem::Num( NumElem );
+ use Heap::Fibonacci;
+
+ my $heap = Heap::Fibonacci->new;
+ my $elem;
+
+ foreach $i ( 1..100 ) {
+ $elem = NumElem( $i );
+ $heap->add( $elem );
+ }
+
+ while( defined( $elem = $heap->extract_top ) ) {
+ print "Smallest is ", $elem->val, "\n";
+ }
+
+=head1 DESCRIPTION
+
+Heap::Elem::Num is used to wrap numeric values into an element
+that can be managed on a heap. The top of the heap will have
+the smallest element still remaining. (See L<Heap::Elem::NumRev>
+if you want the heap to always return the largest element.)
+
+The details of the Elem interface are described in L<Heap::Elem>.
+
+The details of using a Heap interface are described in L<Heap>.
+
+=head1 AUTHOR
+
+John Macdonald, john at perlwolf.com
+
+=head1 COPYRIGHT
+
+Copyright 1998-2007, O'Reilly & Associates.
+
+This code is distributed under the same copyright terms as perl itself.
+
+=head1 SEE ALSO
+
+Heap(3), Heap::Elem(3), Heap::Elem::NumRev(3).
+
+=cut
diff --git a/lib/Heap/Elem/NumRev.pm b/lib/Heap/Elem/NumRev.pm
new file mode 100644
index 0000000..efb0438
--- /dev/null
+++ b/lib/Heap/Elem/NumRev.pm
@@ -0,0 +1,77 @@
+package Heap::Elem::NumRev;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+use Heap::Elem;
+
+require Exporter;
+
+ at ISA = qw(Exporter Heap::Elem);
+
+# No names exported.
+ at EXPORT = ( );
+
+# Available for export: NumRElem (to allocate a new Heap::Elem::NumRev value)
+ at EXPORT_OK = qw( NumRElem );
+
+$VERSION = '0.80';
+
+sub NumRElem { # exportable synonym for new
+ Heap::Elem::NumRev->new(@_);
+}
+
+# compare two NumR elems (reverse order)
+sub cmp {
+ return $_[1][0] <=> $_[0][0];
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Heap::Elem::NumRev - Reversed Numeric Heap Elements
+
+=head1 SYNOPSIS
+
+ use Heap::Elem::NumRev( NumRElem );
+ use Heap::Fibonacci;
+
+ my $heap = Heap::Fibonacci->new;
+ my $elem;
+
+ foreach $i ( 1..100 ) {
+ $elem = NumRElem( $i );
+ $heap->add( $elem );
+ }
+
+ while( defined( $elem = $heap->extract_top ) ) {
+ print "Largest is ", $elem->val, "\n";
+ }
+
+=head1 DESCRIPTION
+
+Heap::Elem::NumRev is used to wrap numeric values into an element
+that can be managed on a heap. The top of the heap will have
+the largest element still remaining. (See L<Heap::Elem::Num>
+if you want the heap to always return the smallest element.)
+
+The details of the Elem interface are described in L<Heap::Elem>.
+
+The details of using a Heap interface are described in L<Heap>.
+
+=head1 AUTHOR
+
+John Macdonald, john at perlwolf.com
+
+=head1 COPYRIGHT
+
+Copyright 1998-2007, O'Reilly & Associates.
+
+This code is distributed under the same copyright terms as perl itself.
+
+=head1 SEE ALSO
+
+Heap(3), Heap::Elem(3), Heap::Elem::Num(3).
+
+=cut
diff --git a/lib/Heap/Elem/Ref.pm b/lib/Heap/Elem/Ref.pm
new file mode 100644
index 0000000..cf69e6a
--- /dev/null
+++ b/lib/Heap/Elem/Ref.pm
@@ -0,0 +1,83 @@
+package Heap::Elem::Ref;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+use Heap::Elem;
+
+require Exporter;
+
+ at ISA = qw(Exporter Heap::Elem);
+
+# No names exported.
+ at EXPORT = ( );
+
+# Available for export: RefElem (to allocate a new Heap::Elem::Ref value)
+ at EXPORT_OK = qw( RefElem );
+
+$VERSION = '0.80';
+
+sub RefElem { # exportable synonym for new
+ Heap::Elem::Ref->new(@_);
+}
+
+# compare two Ref elems - the objects must have a compatible cmp method
+sub cmp {
+ return $_[0][0]->cmp( $_[1][0] );
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Heap::Elem::Ref - Object Reference Heap Elements
+
+=head1 SYNOPSIS
+
+ use Heap::Elem::Ref( RefElem );
+ use Heap::Fibonacci;
+
+ my $heap = Heap::Fibonacci->new;
+ my $elem;
+
+ foreach $i ( 1..100 ) {
+ $obj = myObject->new( $i );
+ $elem = RefElem( $obj );
+ $heap->add( $elem );
+ }
+
+ while( defined( $elem = $heap->extract_top ) ) {
+ # assume that myObject object have a method I<printable>
+ print "Smallest is ", $elem->val->printable, "\n";
+ }
+
+=head1 DESCRIPTION
+
+Heap::Elem::Ref is used to wrap object reference values into an
+element that can be managed on a heap. Each referenced object must
+have a method I<cmp> which can compare itself with any of the other
+objects that have references on the same heap. These comparisons
+must be consistant with normal arithmetic. The top of the heap will
+have the smallest (according to I<cmp>) element still remaining.
+(See L<Heap::Elem::RefRev> if you want the heap to always return the
+largest element.)
+
+The details of the Elem interface are described in L<Heap::Elem>.
+
+The details of using a Heap interface are described in L<Heap>.
+
+=head1 AUTHOR
+
+John Macdonald, john at perlwolf.com
+
+=head1 COPYRIGHT
+
+Copyright 1998-2007, O'Reilly & Associates.
+
+This code is distributed under the same copyright terms as perl itself.
+
+=head1 SEE ALSO
+
+Heap(3), Heap::Elem(3), Heap::Elem::RefRev(3).
+
+=cut
diff --git a/lib/Heap/Elem/RefRev.pm b/lib/Heap/Elem/RefRev.pm
new file mode 100644
index 0000000..6699750
--- /dev/null
+++ b/lib/Heap/Elem/RefRev.pm
@@ -0,0 +1,83 @@
+package Heap::Elem::RefRev;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+use Heap::Elem;
+
+require Exporter;
+
+ at ISA = qw(Exporter Heap::Elem);
+
+# No names exported.
+ at EXPORT = ( );
+
+# Available for export: RefRElem (to allocate a new Heap::Elem::RefRev value)
+ at EXPORT_OK = qw( RefRElem );
+
+$VERSION = '0.80';
+
+sub RefRElem { # exportable synonym for new
+ Heap::Elem::RefRev->new(@_);
+}
+
+# compare two RefRev elems - the objects must have a compatible cmp method
+sub cmp {
+ return $_[1][0]->cmp( $_[0][0] );
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Heap::Elem::RefRev - Reversed Object Reverence Heap Elements
+
+=head1 SYNOPSIS
+
+ use Heap::Elem::RefRev( RefRElem );
+ use Heap::Fibonacci;
+
+ my $heap = Heap::Fibonacci->new;
+ my $elem;
+
+ foreach $i ( 1..100 ) {
+ $obj = myObject->new( $i );
+ $elem = RefRElem( $obj );
+ $heap->add( $elem );
+ }
+
+ while( defined( $elem = $heap->extract_top ) ) {
+ # assume that myObject object have a method I<printable>
+ print "Largest is ", $elem->val->printable, "\n";
+ }
+
+=head1 DESCRIPTION
+
+Heap::Elem::RefRev is used to wrap object reference values into an
+element that can be managed on a heap. Each referenced object must
+have a method I<cmp> which can compare itself with any of the other
+objects that have references on the same heap. These comparisons
+must be consistant with normal arithmetic. The top of the heap will
+have the largest (according to I<cmp>) element still remaining.
+(See L<Heap::Elem::Ref> if you want the heap to always return the
+smallest element.)
+
+The details of the Elem interface are described in L<Heap::Elem>.
+
+The details of using a Heap interface are described in L<Heap>.
+
+=head1 AUTHOR
+
+John Macdonald, john at perlwolf.com
+
+=head1 COPYRIGHT
+
+Copyright 1998-2007, O'Reilly & Associates.
+
+This code is distributed under the same copyright terms as perl itself.
+
+=head1 SEE ALSO
+
+Heap(3), Heap::Elem(3), Heap::Elem::Ref(3).
+
+=cut
diff --git a/lib/Heap/Elem/Str.pm b/lib/Heap/Elem/Str.pm
new file mode 100644
index 0000000..7153e48
--- /dev/null
+++ b/lib/Heap/Elem/Str.pm
@@ -0,0 +1,79 @@
+package Heap::Elem::Str;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+use Heap::Elem;
+
+require Exporter;
+
+ at ISA = qw(Exporter Heap::Elem);
+
+# No names exported.
+ at EXPORT = ( );
+
+# Available for export: StrElem (to allocate a new Heap::Elem::Str value)
+ at EXPORT_OK = qw( StrElem );
+
+$VERSION = '0.80';
+
+sub StrElem { # exportable synonym for new
+ Heap::Elem::Str->new(@_);
+}
+
+# compare two Str elems
+sub cmp {
+ my $self = shift;
+ my $other = shift;
+ return $_[0][0] cmp $_[1][0];
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Heap::Elem::Str - String Heap Elements
+
+=head1 SYNOPSIS
+
+ use Heap::Elem::Str( StrElem );
+ use Heap::Fibonacci;
+
+ my $heap = Heap::Fibonacci->new;
+ my $elem;
+
+ foreach $i ( 'aa'..'bz' ) {
+ $elem = StrElem( $i );
+ $heap->add( $elem );
+ }
+
+ while( defined( $elem = $heap->extract_top ) ) {
+ print "Smallest is ", $elem->val, "\n";
+ }
+
+=head1 DESCRIPTION
+
+Heap::Elem::Str is used to wrap string values into an element
+that can be managed on a heap. The top of the heap will have
+the smallest element still remaining. (See L<Heap::Elem::StrRev>
+if you want the heap to always return the largest element.)
+
+The details of the Elem interface are described in L<Heap::Elem>.
+
+The details of using a Heap interface are described in L<Heap>.
+
+=head1 AUTHOR
+
+John Macdonald, john at perlwolf.com
+
+=head1 COPYRIGHT
+
+Copyright 1998-2007, O'Reilly & Associates.
+
+This code is distributed under the same copyright terms as perl itself.
+
+=head1 SEE ALSO
+
+Heap(3), Heap::Elem(3), Heap::Elem::StrRev(3).
+
+=cut
diff --git a/lib/Heap/Elem/StrRev.pm b/lib/Heap/Elem/StrRev.pm
new file mode 100644
index 0000000..6d78568
--- /dev/null
+++ b/lib/Heap/Elem/StrRev.pm
@@ -0,0 +1,80 @@
+package Heap::Elem::StrRev;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+use Heap::Elem;
+
+require Exporter;
+
+ at ISA = qw(Exporter Heap::Elem);
+
+# No names exported.
+ at EXPORT = ( );
+
+# Available for export: StrRElem (to allocate a new Heap::Elem::StrRev value)
+ at EXPORT_OK = qw( StrRElem );
+
+$VERSION = '0.80';
+
+
+sub StrRElem { # exportable synonym for new
+ Heap::Elem::StrRev->new(@_);
+}
+
+# compare two StrR elems (reverse order)
+sub cmp {
+ my $self = shift;
+ my $other = shift;
+ return $_[1][0] cmp $_[0][0];
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Heap::Elem::StrRev - Reversed String Heap Elements
+
+=head1 SYNOPSIS
+
+ use Heap::Elem::StrRev( StrRElem );
+ use Heap::Fibonacci;
+
+ my $heap = Heap::Fibonacci->new;
+ my $elem;
+
+ foreach $i ( 'aa'..'bz' ) {
+ $elem = StrRElem( $i );
+ $heap->add( $elem );
+ }
+
+ while( defined( $elem = $heap->extract_top ) ) {
+ print "Largest is ", $elem->val, "\n";
+ }
+
+=head1 DESCRIPTION
+
+Heap::Elem::StrRev is used to wrap string values into an element
+that can be managed on a heap. The top of the heap will have
+the largest element still remaining. (See L<Heap::Elem::Str>
+if you want the heap to always return the smallest element.)
+
+The details of the Elem interface are described in L<Heap::Elem>.
+
+The details of using a Heap interface are described in L<Heap>.
+
+=head1 AUTHOR
+
+John Macdonald, john at perlwolf.com
+
+=head1 COPYRIGHT
+
+Copyright 1998-2007, O'Reilly & Associates.
+
+This code is distributed under the same copyright terms as perl itself.
+
+=head1 SEE ALSO
+
+Heap(3), Heap::Elem(3), Heap::Elem::Str(3).
+
+=cut
diff --git a/lib/Heap/Fibonacci.pm b/lib/Heap/Fibonacci.pm
new file mode 100644
index 0000000..38d46e4
--- /dev/null
+++ b/lib/Heap/Fibonacci.pm
@@ -0,0 +1,470 @@
+package Heap::Fibonacci;
+
+use strict;
+use vars qw($VERSION);
+
+$VERSION = '0.80';
+
+# common names
+# h - heap head
+# el - linkable element, contains user-provided value
+# v - user-provided value
+
+################################################# debugging control
+
+my $debug = 0;
+my $validate = 0;
+
+# enable/disable debugging output
+sub debug {
+ @_ ? ($debug = shift) : $debug;
+}
+
+# enable/disable validation checks on values
+sub validate {
+ @_ ? ($validate = shift) : $validate;
+}
+
+my $width = 3;
+my $bar = ' | ';
+my $corner = ' +-';
+my $vfmt = "%3d";
+
+sub set_width {
+ $width = shift;
+ $width = 2 if $width < 2;
+
+ $vfmt = "%${width}d";
+ $bar = $corner = ' ' x $width;
+ substr($bar,-2,1) = '|';
+ substr($corner,-2,2) = '+-';
+}
+
+sub hdump;
+
+sub hdump {
+ my $el = shift;
+ my $l1 = shift;
+ my $b = shift;
+
+ my $ch;
+ my $ch1;
+
+ unless( $el ) {
+ print $l1, "\n";
+ return;
+ }
+
+ hdump $ch1 = $el->{child},
+ $l1 . sprintf( $vfmt, $el->{val}->val),
+ $b . $bar;
+
+ if( $ch1 ) {
+ for( $ch = $ch1->{right}; $ch != $ch1; $ch = $ch->{right} ) {
+ hdump $ch, $b . $corner, $b . $bar;
+ }
+ }
+}
+
+sub heapdump {
+ my $h;
+
+ while( $h = shift ) {
+ my $top = $$h or last;
+ my $el = $top;
+
+ do {
+ hdump $el, sprintf( "%02d: ", $el->{degree}), ' ';
+ $el = $el->{right};
+ } until $el == $top;
+ print "\n";
+ }
+}
+
+sub bhcheck;
+
+sub bhcheck {
+ my $el = shift;
+ my $p = shift;
+
+ my $cur = $el;
+ my $prev;
+ my $ch;
+ do {
+ $prev = $cur;
+ $cur = $cur->{right};
+ die "bad back link" unless $cur->{left} == $prev;
+ die "bad parent link"
+ unless (defined $p && defined $cur->{p} && $cur->{p} == $p)
+ || (!defined $p && !defined $cur->{p});
+ die "bad degree( $cur->{degree} > $p->{degree} )"
+ if $p && $p->{degree} <= $cur->{degree};
+ die "not heap ordered"
+ if $p && $p->{val}->cmp($cur->{val}) > 0;
+ $ch = $cur->{child} and bhcheck $ch, $cur;
+ } until $cur == $el;
+}
+
+
+sub heapcheck {
+ my $h;
+ my $el;
+ while( $h = shift ) {
+ heapdump $h if $validate >= 2;
+ $el = $$h and bhcheck $el, undef;
+ }
+}
+
+
+################################################# forward declarations
+
+sub ascending_cut;
+sub elem;
+sub elem_DESTROY;
+sub link_to_left_of;
+
+################################################# heap methods
+
+# Cormen et al. use two values for the heap, a pointer to an element in the
+# list at the top, and a count of the number of elements. The count is only
+# used to determine the size of array required to hold log(count) pointers,
+# but perl can set array sizes as needed and doesn't need to know their size
+# when they are created, so we're not maintaining that field.
+sub new {
+ my $self = shift;
+ my $class = ref($self) || $self;
+ my $h = undef;
+ bless \$h, $class;
+}
+
+sub DESTROY {
+ my $h = shift;
+
+ elem_DESTROY $$h;
+}
+
+sub add {
+ my $h = shift;
+ my $v = shift;
+ $validate && do {
+ die "Method 'heap' required for element on heap"
+ unless $v->can('heap');
+ die "Method 'cmp' required for element on heap"
+ unless $v->can('cmp');
+ };
+ my $el = elem $v;
+ my $top;
+ if( !($top = $$h) ) {
+ $$h = $el;
+ } else {
+ link_to_left_of $top->{left}, $el ;
+ link_to_left_of $el,$top;
+ $$h = $el if $v->cmp($top->{val}) < 0;
+ }
+}
+
+sub top {
+ my $h = shift;
+ $$h && $$h->{val};
+}
+
+*minimum = \⊤
+
+sub extract_top {
+ my $h = shift;
+ my $el = $$h or return undef;
+ my $ltop = $el->{left};
+ my $cur;
+ my $next;
+
+ # $el is the heap with the lowest value on it
+ # move all of $el's children (if any) to the top list (between
+ # $ltop and $el)
+ if( $cur = $el->{child} ) {
+ # remember the beginning of the list of children
+ my $first = $cur;
+ do {
+ # the children are moving to the top, clear the p
+ # pointer for all of them
+ $cur->{p} = undef;
+ } until ($cur = $cur->{right}) == $first;
+
+ # remember the end of the list
+ $cur = $cur->{left};
+ link_to_left_of $ltop, $first;
+ link_to_left_of $cur, $el;
+ }
+
+ if( $el->{right} == $el ) {
+ # $el had no siblings or children, the top only contains $el
+ # and $el is being removed
+ $$h = undef;
+ } else {
+ link_to_left_of $el->{left}, $$h = $el->{right};
+ # now all those loose ends have to be merged together as we
+ # search for the
+ # new smallest element
+ $h->consolidate;
+ }
+
+ # extract the actual value and return that, $el is no longer used
+ # but break all of its links so that it won't be pointed to...
+ my $top = $el->{val};
+ $top->heap(undef);
+ $el->{left} = $el->{right} = $el->{p} = $el->{child} = $el->{val} =
+ undef;
+ $top;
+}
+
+*extract_minimum = \&extract_top;
+
+sub absorb {
+ my $h = shift;
+ my $h2 = shift;
+
+ my $el = $$h;
+ unless( $el ) {
+ $$h = $$h2;
+ $$h2 = undef;
+ return $h;
+ }
+
+ my $el2 = $$h2 or return $h;
+
+ # add $el2 and its siblings to the head list for $h
+ # at start, $ell -> $el -> ... -> $ell is on $h (where $ell is
+ # $el->{left})
+ # $el2l -> $el2 -> ... -> $el2l are on $h2
+ # at end, $ell -> $el2l -> ... -> $el2 -> $el -> ... -> $ell are
+ # all on $h
+ my $el2l = $el2->{left};
+ link_to_left_of $el->{left}, $el2;
+ link_to_left_of $el2l, $el;
+
+ # change the top link if needed
+ $$h = $el2 if $el->{val}->cmp( $el2->{val} ) > 0;
+
+ # clean out $h2
+ $$h2 = undef;
+
+ # return the heap
+ $h;
+}
+
+# a key has been decreased, it may have to percolate up in its heap
+sub decrease_key {
+ my $h = shift;
+ my $top = $$h;
+ my $v = shift;
+ my $el = $v->heap or return undef;
+ my $p;
+
+ # first, link $h to $el if it is now the smallest (we will
+ # soon link $el to $top to properly put it up to the top list,
+ # if it isn't already there)
+ $$h = $el if $top->{val}->cmp( $v ) > 0;
+
+ if( $p = $el->{p} and $v->cmp($p->{val}) < 0 ) {
+ # remove $el from its parent's list - it is now smaller
+
+ ascending_cut $top, $p, $el;
+ }
+
+ $v;
+}
+
+
+# to delete an item, we bubble it to the top of its heap (as if its key
+# had been decreased to -infinity), and then remove it (as in extract_top)
+sub delete {
+ my $h = shift;
+ my $v = shift;
+ my $el = $v->heap or return undef;
+
+ # if there is a parent, cut $el to the top (as if it had just had its
+ # key decreased to a smaller value than $p's value
+ my $p;
+ $p = $el->{p} and ascending_cut $$h, $p, $el;
+
+ # $el is in the top list now, make it look like the smallest and
+ # remove it
+ $$h = $el;
+ $h->extract_top;
+}
+
+
+################################################# internal utility functions
+
+sub elem {
+ my $v = shift;
+ my $el = undef;
+ $el = {
+ p => undef,
+ degree => 0,
+ mark => 0,
+ child => undef,
+ val => $v,
+ left => undef,
+ right => undef,
+ };
+ $el->{left} = $el->{right} = $el;
+ $v->heap($el);
+ $el;
+}
+
+sub elem_DESTROY {
+ my $el = shift;
+ my $ch;
+ my $next;
+ $el->{left}->{right} = undef;
+
+ while( $el ) {
+ $ch = $el->{child} and elem_DESTROY $ch;
+ $next = $el->{right};
+
+ defined $el->{val} and $el->{val}->heap(undef);
+ $el->{child} = $el->{right} = $el->{left} = $el->{p} = $el->{val}
+ = undef;
+ $el = $next;
+ }
+}
+
+sub link_to_left_of {
+ my $l = shift;
+ my $r = shift;
+
+ $l->{right} = $r;
+ $r->{left} = $l;
+}
+
+sub link_as_parent_of {
+ my $p = shift;
+ my $c = shift;
+
+ my $pc;
+
+ if( $pc = $p->{child} ) {
+ link_to_left_of $pc->{left}, $c;
+ link_to_left_of $c, $pc;
+ } else {
+ link_to_left_of $c, $c;
+ }
+ $p->{child} = $c;
+ $c->{p} = $p;
+ $p->{degree}++;
+ $c->{mark} = 0;
+ $p;
+}
+
+sub consolidate {
+ my $h = shift;
+
+ my $cur;
+ my $this;
+ my $next = $$h;
+ my $last = $next->{left};
+ my @a;
+ do {
+ # examine next item on top list
+ $this = $cur = $next;
+ $next = $cur->{right};
+ my $d = $cur->{degree};
+ my $alt;
+ while( $alt = $a[$d] ) {
+ # we already saw another item of the same degree,
+ # put the larger valued one under the smaller valued
+ # one - switch $cur and $alt if necessary so that $cur
+ # is the smaller
+ ($cur,$alt) = ($alt,$cur)
+ if $cur->{val}->cmp( $alt->{val} ) > 0;
+ # remove $alt from the top list
+ link_to_left_of $alt->{left}, $alt->{right};
+ # and put it under $cur
+ link_as_parent_of $cur, $alt;
+ # make sure that $h still points to a node at the top
+ $$h = $cur;
+ # we've removed the old $d degree entry
+ $a[$d] = undef;
+ # and we now have a $d+1 degree entry to try to insert
+ # into @a
+ ++$d;
+ }
+ # found a previously unused degree
+ $a[$d] = $cur;
+ } until $this == $last;
+ $cur = $$h;
+ for $cur (grep defined, @a) {
+ $$h = $cur if $$h->{val}->cmp( $cur->{val} ) > 0;
+ }
+}
+
+sub ascending_cut {
+ my $top = shift;
+ my $p = shift;
+ my $el = shift;
+
+ while( 1 ) {
+ if( --$p->{degree} ) {
+ # there are still other children below $p
+ my $l = $el->{left};
+ $p->{child} = $l;
+ link_to_left_of $l, $el->{right};
+ } else {
+ # $el was the only child of $p
+ $p->{child} = undef;
+ }
+ link_to_left_of $top->{left}, $el;
+ link_to_left_of $el, $top;
+ $el->{p} = undef;
+ $el->{mark} = 0;
+
+ # propagate up the list
+ $el = $p;
+
+ # quit at the top
+ last unless $p = $el->{p};
+
+ # quit if we can mark $el
+ $el->{mark} = 1, last unless $el->{mark};
+ }
+}
+
+
+1;
+
+__END__
+
+=head1 NAME
+
+Heap::Fibonacci - a fibonacci heap to keep data partially sorted
+
+=head1 SYNOPSIS
+
+ use Heap::Fibonacci;
+
+ $heap = Heap::Fibonacci->new;
+ # see Heap(3) for usage
+
+=head1 DESCRIPTION
+
+Keeps elements in heap order using a linked list of Fibonacci trees.
+The I<heap> method of an element is used to store a reference to
+the node in the list that refers to the element.
+
+See L<Heap> for details on using this module.
+
+=head1 AUTHOR
+
+John Macdonald, john at perlwolf.com
+
+=head1 COPYRIGHT
+
+Copyright 1998-2007, O'Reilly & Associates.
+
+This code is distributed under the same copyright terms as perl itself.
+
+=head1 SEE ALSO
+
+Heap(3), Heap::Elem(3).
+
+=cut
diff --git a/t/binary.t b/t/binary.t
new file mode 100644
index 0000000..df9637c
--- /dev/null
+++ b/t/binary.t
@@ -0,0 +1,40 @@
+#!/usr/bin/perl -w
+
+use Test::More;
+use strict;
+
+BEGIN
+ {
+ plan tests => 4;
+ chdir 't' if -d 't';
+ use lib '../lib';
+ use_ok ("Heap::Binary") or die($@);
+ };
+
+can_ok ("Heap::Binary", qw/
+ new
+
+ absorb
+ add
+ decrease_key
+ delete
+
+ minimum
+ top
+
+ extract_top
+ extract_minimum
+
+
+ moveto
+ heapup
+ heapdown
+ /);
+
+my $heap = Heap::Binary->new();
+
+like (ref($heap), qr/Heap::Binary/, 'new returned an object');
+
+my $ver = $Heap::Binary::VERSION;
+ok ($ver >= 0.80, "Heap::Binary::VERSION >= 0.80 (is: $ver)");
+
diff --git a/t/binomial.t b/t/binomial.t
new file mode 100644
index 0000000..ed661e9
--- /dev/null
+++ b/t/binomial.t
@@ -0,0 +1,41 @@
+#!/usr/bin/perl -w
+
+use Test::More;
+use strict;
+
+BEGIN
+ {
+ plan tests => 4;
+ chdir 't' if -d 't';
+ use lib '../lib';
+ use_ok ("Heap::Binomial") or die($@);
+ };
+
+can_ok ("Heap::Binomial", qw/
+ new
+
+ elem
+ absorb
+ add
+ decrease_key
+ delete
+
+ minimum
+ top
+
+ extract_top
+ extract_minimum
+
+ moveto
+ link_to
+ absorb_children
+ self_union_once
+ self_union
+ /);
+
+my $heap = Heap::Binomial->new();
+
+like (ref($heap), qr/Heap::Binomial/, 'new returned an object');
+
+my $ver = $Heap::Binomial::VERSION;
+ok ($ver >= 0.80, "Heap::Binomial::VERSION >= 0.80 (is: $ver)");
diff --git a/t/elem.t b/t/elem.t
new file mode 100644
index 0000000..e95d756
--- /dev/null
+++ b/t/elem.t
@@ -0,0 +1,27 @@
+#!/usr/bin/perl -w
+
+use Test::More;
+use strict;
+
+BEGIN
+ {
+ plan tests => 4;
+ chdir 't' if -d 't';
+ use lib '../lib';
+ use_ok ("Heap::Elem") or die($@);
+ };
+
+can_ok ("Heap::Elem", qw/
+ new
+
+ val
+ heap
+ cmp
+ /);
+
+my $heap = Heap::Elem->new();
+
+like (ref($heap), qr/Heap::Elem/, 'new returned an object');
+
+my $ver = $Heap::Elem::VERSION;
+ok ($ver >= 0.80, "Heap::Elem::VERSION >= 0.80 (is: $ver)");
diff --git a/t/fibonacci.t b/t/fibonacci.t
new file mode 100644
index 0000000..f2e3edf
--- /dev/null
+++ b/t/fibonacci.t
@@ -0,0 +1,39 @@
+#!/usr/bin/perl -w
+
+use Test::More;
+use strict;
+
+BEGIN
+ {
+ plan tests => 4;
+ chdir 't' if -d 't';
+ use lib '../lib';
+ use_ok ("Heap::Fibonacci") or die($@);
+ };
+
+can_ok ("Heap::Fibonacci", qw/
+ new
+
+ elem
+ absorb
+ add
+ ascending_cut
+ decrease_key
+ delete
+ consolidate
+ link_to_left_of
+ link_as_parent_of
+
+ minimum
+ top
+
+ extract_top
+ extract_minimum
+ /);
+
+my $heap = Heap::Fibonacci->new();
+
+like (ref($heap), qr/Heap::Fibonacci/, 'new returned an object');
+
+my $ver = $Heap::Fibonacci::VERSION;
+ok ($ver >= 0.80, "Heap::Fibonacci::VERSION >= 0.80 (is: $ver)");
diff --git a/t/num.t b/t/num.t
new file mode 100644
index 0000000..0b7ad97
--- /dev/null
+++ b/t/num.t
@@ -0,0 +1,26 @@
+#!/usr/bin/perl -w
+
+use Test::More;
+use strict;
+
+BEGIN
+ {
+ plan tests => 4;
+ chdir 't' if -d 't';
+ use lib '../lib';
+ use_ok ("Heap::Elem::Num") or die($@);
+ };
+
+can_ok ("Heap::Elem::Num", qw/
+ new
+ val
+ heap
+ cmp
+ /);
+
+my $heap = Heap::Elem::Num->new();
+
+like (ref($heap), qr/Heap::Elem::Num/, 'new returned an object');
+
+my $ver = $Heap::Elem::Num::VERSION;
+ok ($ver >= 0.80, "Heap::Elem::Num::VERSION >= 0.80 (is: $ver)");
diff --git a/t/numrev.t b/t/numrev.t
new file mode 100644
index 0000000..44a55b3
--- /dev/null
+++ b/t/numrev.t
@@ -0,0 +1,26 @@
+#!/usr/bin/perl -w
+
+use Test::More;
+use strict;
+
+BEGIN
+ {
+ plan tests => 4;
+ chdir 't' if -d 't';
+ use lib '../lib';
+ use_ok ("Heap::Elem::NumRev") or die($@);
+ };
+
+can_ok ("Heap::Elem::NumRev", qw/
+ new
+ val
+ heap
+ cmp
+ /);
+
+my $heap = Heap::Elem::NumRev->new();
+
+like (ref($heap), qr/Heap::Elem::NumRev/, 'new returned an object');
+
+my $ver = $Heap::Elem::NumRev::VERSION;
+ok ($ver >= 0.80, "Heap::Elem::NumRev::VERSION >= 0.80 (is: $ver)");
diff --git a/t/ref.t b/t/ref.t
new file mode 100644
index 0000000..f7954f3
--- /dev/null
+++ b/t/ref.t
@@ -0,0 +1,26 @@
+#!/usr/bin/perl -w
+
+use Test::More;
+use strict;
+
+BEGIN
+ {
+ plan tests => 4;
+ chdir 't' if -d 't';
+ use lib '../lib';
+ use_ok ("Heap::Elem::Ref") or die($@);
+ };
+
+can_ok ("Heap::Elem::Ref", qw/
+ new
+ val
+ heap
+ cmp
+ /);
+
+my $heap = Heap::Elem::Ref->new();
+
+like (ref($heap), qr/Heap::Elem::Ref/, 'new returned an object');
+
+my $ver = $Heap::Elem::Ref::VERSION;
+ok ($ver >= 0.80, "Heap::Elem::Ref::VERSION >= 0.80 (is: $ver)");
diff --git a/t/refrev.t b/t/refrev.t
new file mode 100644
index 0000000..3435b2c
--- /dev/null
+++ b/t/refrev.t
@@ -0,0 +1,26 @@
+#!/usr/bin/perl -w
+
+use Test::More;
+use strict;
+
+BEGIN
+ {
+ plan tests => 4;
+ chdir 't' if -d 't';
+ use lib '../lib';
+ use_ok ("Heap::Elem::RefRev") or die($@);
+ };
+
+can_ok ("Heap::Elem::RefRev", qw/
+ new
+ val
+ heap
+ cmp
+ /);
+
+my $heap = Heap::Elem::RefRev->new();
+
+like (ref($heap), qr/Heap::Elem::RefRev/, 'new returned an object');
+
+my $ver = $Heap::Elem::RefRev::VERSION;
+ok ($ver >= 0.80, "Heap::Elem::RefRev::VERSION >= 0.80 (is: $ver)");
diff --git a/t/str.t b/t/str.t
new file mode 100644
index 0000000..08a7289
--- /dev/null
+++ b/t/str.t
@@ -0,0 +1,26 @@
+#!/usr/bin/perl -w
+
+use Test::More;
+use strict;
+
+BEGIN
+ {
+ plan tests => 4;
+ chdir 't' if -d 't';
+ use lib '../lib';
+ use_ok ("Heap::Elem::Str") or die($@);
+ };
+
+can_ok ("Heap::Elem::Str", qw/
+ new
+ val
+ heap
+ cmp
+ /);
+
+my $heap = Heap::Elem::Str->new();
+
+like (ref($heap), qr/Heap::Elem::Str/, 'new returned an object');
+
+my $ver = $Heap::Elem::Str::VERSION;
+ok ($ver >= 0.80, "Heap::Elem::Str::VERSION >= 0.80 (is: $ver)");
diff --git a/t/strrev.t b/t/strrev.t
new file mode 100644
index 0000000..38c58a7
--- /dev/null
+++ b/t/strrev.t
@@ -0,0 +1,26 @@
+#!/usr/bin/perl -w
+
+use Test::More;
+use strict;
+
+BEGIN
+ {
+ plan tests => 4;
+ chdir 't' if -d 't';
+ use lib '../lib';
+ use_ok ("Heap::Elem::StrRev") or die($@);
+ };
+
+can_ok ("Heap::Elem::StrRev", qw/
+ new
+ val
+ heap
+ cmp
+ /);
+
+my $heap = Heap::Elem::StrRev->new();
+
+like (ref($heap), qr/Heap::Elem::StrRev/, 'new returned an object');
+
+my $ver = $Heap::Elem::StrRev::VERSION;
+ok ($ver >= 0.80, "Heap::Elem::StrRev::VERSION >= 0.80 (is: $ver)");
diff --git a/t/test.t b/t/test.t
new file mode 100644
index 0000000..3b2aa7f
--- /dev/null
+++ b/t/test.t
@@ -0,0 +1,107 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+my $fibi;
+my $biny;
+my $binl;
+my $b1;
+
+BEGIN {
+ chdir 't' if -d 't';
+ use lib '../lib';
+ $| = 1;
+ my $arg = $ENV{HEAPTESTARG};
+ my $types;
+ $b1 = 50;
+ # env var $HEAPTESTARG can change the test set
+ # It can contain chars i y l to select fibonaccI binarY or binomiaL.
+ # It can contain a number to control the (number of items heaped)/4
+ # default is iyl50 (test all three, 200 numbers on heap).
+ # All comments below use the 50/200 default, other sizes are
+ # for debug purposes.
+ if( defined $arg ) {
+ $fibi = $biny = $binl = 0;
+ ++$fibi if $arg =~ /i/;
+ ++$biny if $arg =~ /y/;
+ ++$binl if $arg =~ /l/;
+ $b1 = $1 if $arg =~ /([\d]+)/;
+ } else {
+ $fibi = 1;
+ $biny = 1;
+ $binl = 1;
+ }
+ print "1..", ($b1*2*8+4)*($fibi+$biny+$binl)+1, "\n";
+}
+END {print "not ok 1\n" unless $loaded;}
+use Heap;
+$loaded = 1;
+print "ok 1\n";
+
+my $b2 = $b1*2;
+my $b3 = $b1*3;
+my $b4 = $b1*4;
+
+my $b0p1 = 1;
+my $b1p1 = $b1+1;
+my $b2p1 = $b2+1;
+my $b3p1 = $b3+1;
+
+use Heap::Fibonacci;
+use Heap::Binomial;
+use Heap::Binary;
+
+use Heap::Elem::Num( NumElem );
+
+my $count = 1;
+
+sub testaheap {
+ my $heap = shift;
+ my @elems = map { NumElem($_) } 1..($b4);
+ unshift @elems, undef; # index them 1..200, not 0..199
+
+ # add block4, block3, block2, block1 to mix the order a bit
+ foreach( ($b3p1)..($b4),
+ ($b2p1)..($b3),
+ ($b1p1)..($b2),
+ ($b0p1)..($b1) ) {
+ $heap->add( $elems[$_] );
+ }
+
+ sub testit {
+ print( ($_[0] ? "ok " : "not ok "), $_[1], "\n" );
+ }
+
+ # test 2..801
+ # We should find 1..100 in order on the heap, each element
+ # should have its heap value defined while it is still in
+ # the heap, and then undef after it is removed.
+ # Meanwhile, after removing element i (in 1..100) we then
+ # remove element i+100 out of order using delete, to test
+ # that the heap doesn't get corrupted.
+ # (i.e. 1, 101, 2, 102, ..., 100, 200)
+ foreach my $index ( 1..$b2 ) {
+ my $el;
+ $el = $heap->top;
+ testit( $index == $el->val, ++$count );
+ testit( defined($el->heap), ++$count );
+ $el = $heap->extract_top;
+ testit( $index == $el->val, ++$count );
+ testit( ! defined($el->heap), ++$count );
+ $el = $elems[$index+$b2];
+ testit( $index+$b2 == $el->val, ++$count );
+ testit( defined($el->heap), ++$count );
+ $heap->delete( $el );
+ testit( $index+$b2 == $el->val, ++$count );
+ testit( ! defined($el->heap), ++$count );
+ }
+
+ # test 802..805 - heap should be empty, and return undef
+ testit( ! defined($heap->top), ++$count );
+ testit( ! defined($heap->extract_top), ++$count );
+ testit( ! defined($heap->top), ++$count );
+ testit( ! defined($heap->extract_top), ++$count );
+}
+
+$fibi && testaheap( Heap::Fibonacci->new );
+$binl && testaheap( Heap::Binomial->new );
+$biny && testaheap( Heap::Binary->new );
diff --git a/t/test_leaks.t b/t/test_leaks.t
new file mode 100644
index 0000000..18e9786
--- /dev/null
+++ b/t/test_leaks.t
@@ -0,0 +1,95 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+BEGIN {
+ chdir 't' if -d 't';
+ use lib '../lib';
+ $| = 1;
+ print "1..7\n";
+}
+use Heap;
+use Heap::Elem::NumRev;
+
+my @test_seq =
+ (
+ [ test_empty => ],
+ [ add => 1, 100 ],
+ [ test => 100 ],
+ [ remove => 50, 100, 51 ],
+ [ test => 50 ],
+ [ remove => 50, 50, 1 ],
+ [ test_empty => ],
+ [ repeat => 0, 2 ],
+ [ mem_test => ],
+ [ repeat => 1, 50 ],
+ [ last => ],
+ );
+my $test_index = 0;
+my @repeat_count = ( 0, 0, 0, 0 );
+
+my $heap = new Heap::Fibonacci;
+my $test_num = 0;
+my $still_testing = 1;
+my $not;
+
+while (1) {
+ my $step = $test_seq[$test_index++];
+ my $op = $step->[0];
+ my $scratch;
+ $not = 'not ';
+ if( $op eq 'test_empty' ) {
+ defined($heap->top) or $not = '';
+ } elsif( $op eq 'test' ) {
+ defined($scratch = $heap->top) and $scratch->val == $step->[1] and $not = '';
+ } elsif( $op eq 'add' ) {
+ my( $base, $limit, $incr ) = (@$step)[1..3];
+ defined $incr or $incr = 1;
+ while(1) {
+ my $elem = new Heap::Elem::NumRev($base);
+ $heap->add( $elem );
+ last if $base == $limit;
+ $base += $incr;
+ }
+ $not = 'skip';
+ } elsif( $op eq 'remove' ) {
+ my( $count, $base, $limit, $incr ) = (@$step)[1..4];
+ defined $incr or $incr = -1;
+ $not = '';
+ while($count--) {
+ my $elem = $heap->extract_top;
+ defined($elem) && $elem->val == $base
+ or $not = 'not ';
+ $base += $incr;
+ }
+ $not = 'not '
+ if $base != $limit + $incr;
+ } elsif( $op eq 'repeat' ) {
+ my( $index, $limit ) = (@$step)[1..2];
+ if( $still_testing ) {
+ $still_testing = 0;
+ }
+ if( ++$repeat_count[$index] == $limit ) {
+ $repeat_count[$index] = 0;
+ } else {
+ $test_index = 0;
+ }
+ $not = '';
+ } elsif( $op eq 'mem_test' ) {
+ $not = '';
+ print `ps -lp$$`;
+ } elsif( $op eq 'last' ) {
+ $not = '';
+ last;
+ }
+ if( $not ne 'skip' ) {
+ if( $still_testing ) {
+ ++$test_num;
+ print $not, "ok $test_num\n";
+ } else {
+ last if $not;
+ }
+ }
+}
+
+++$test_num;
+print $not, "ok $test_num\n";
diff --git a/t/test_leaks2.t b/t/test_leaks2.t
new file mode 100644
index 0000000..e50a75f
--- /dev/null
+++ b/t/test_leaks2.t
@@ -0,0 +1,59 @@
+#!/usr/bin/env perl
+
+BEGIN {
+ chdir 't' if -d 't';
+ use lib '../lib';
+ $| = 1;
+ print "1..13\n";
+}
+
+END {print "not ok 1\n" unless $loaded;}
+$loaded = 1;
+print "ok 1\n";
+
+use Heap::Fibonacci;
+use Heap::Elem::Num( NumElem );
+
+my $heapsize;
+my $extractsize;
+my $test = 1;
+
+my $allocated;
+
+sub Heap::Elem::Num::DESTROY {
+ --$allocated;
+}
+
+for (
+ $extractsize = 5;
+ $extractsize < 20000;
+ $extractsize = $heapsize) {
+ $heapsize = $extractsize*5;
+ $allocated = 0;
+
+ my $heap = Heap::Fibonacci->new;
+
+ for (1..$heapsize) {
+ my $val = int(rand(1000));
+ my $heapElem = NumElem( $val );
+ $heap->add($heapElem);
+ ++$allocated;
+ }
+
+ print( (($allocated == $heapsize) ? "" : "not "),
+ "ok ",
+ ++$test,
+ "\n" );
+
+ for (1..$extractsize){
+ my $elem = $heap->extract_top;
+ }
+
+ undef $heap;
+
+ print( (($allocated == 0) ? "" : "not "),
+ "ok ",
+ ++$test,
+ "\n" );
+
+}
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libheap-perl.git
More information about the Pkg-perl-cvs-commits
mailing list