Heap-0.80/0000755000175100017510000000000010614707123010777 5ustar johnjohnHeap-0.80/t/0000755000175100017510000000000010614707123011242 5ustar johnjohnHeap-0.80/t/binary.t0000644000175100017510000000102010614706105012703 0ustar johnjohn#!/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)"); Heap-0.80/t/ref.t0000644000175100017510000000067310614706105012210 0ustar johnjohn#!/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)"); Heap-0.80/t/numrev.t0000644000175100017510000000071510614706105012745 0ustar johnjohn#!/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)"); Heap-0.80/t/num.t0000644000175100017510000000067310614706105012233 0ustar johnjohn#!/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)"); Heap-0.80/t/test_leaks2.t0000644000175100017510000000162710614706105013654 0ustar johnjohn#!/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" ); } Heap-0.80/t/test.t0000644000175100017510000000560610614706105012414 0ustar johnjohn# 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 ); Heap-0.80/t/strrev.t0000644000175100017510000000071510614706105012756 0ustar johnjohn#!/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)"); Heap-0.80/t/elem.t0000644000175100017510000000063610614706105012355 0ustar johnjohn#!/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)"); Heap-0.80/t/binomial.t0000644000175100017510000000111010614706105013211 0ustar johnjohn#!/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)"); Heap-0.80/t/str.t0000644000175100017510000000067310614706105012244 0ustar johnjohn#!/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)"); Heap-0.80/t/fibonacci.t0000644000175100017510000000111610614706105013342 0ustar johnjohn#!/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)"); Heap-0.80/t/refrev.t0000644000175100017510000000071510614706105012722 0ustar johnjohn#!/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)"); Heap-0.80/t/test_leaks.t0000644000175100017510000000412310614706105013564 0ustar johnjohn# 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"; Heap-0.80/lib/0000755000175100017510000000000010614707123011545 5ustar johnjohnHeap-0.80/lib/Heap/0000755000175100017510000000000010614707123012422 5ustar johnjohnHeap-0.80/lib/Heap/Elem/0000755000175100017510000000000010614707123013304 5ustar johnjohnHeap-0.80/lib/Heap/Elem/Str.pm0000644000175100017510000000301210614706105014405 0ustar johnjohnpackage Heap::Elem::Str; use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); use Heap::Elem; require Exporter; @ISA = qw(Exporter Heap::Elem); # No names exported. @EXPORT = ( ); # Available for export: StrElem (to allocate a new Heap::Elem::Str value) @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 if you want the heap to always return the largest element.) The details of the Elem interface are described in L. The details of using a Heap interface are described in L. =head1 AUTHOR John Macdonald, john@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 Heap-0.80/lib/Heap/Elem/NumRev.pm0000644000175100017510000000300510614706105015053 0ustar johnjohnpackage Heap::Elem::NumRev; use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); use Heap::Elem; require Exporter; @ISA = qw(Exporter Heap::Elem); # No names exported. @EXPORT = ( ); # Available for export: NumRElem (to allocate a new Heap::Elem::NumRev value) @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 if you want the heap to always return the smallest element.) The details of the Elem interface are described in L. The details of using a Heap interface are described in L. =head1 AUTHOR John Macdonald, john@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 Heap-0.80/lib/Heap/Elem/Ref.pm0000644000175100017510000000356210614706105014363 0ustar johnjohnpackage Heap::Elem::Ref; use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); use Heap::Elem; require Exporter; @ISA = qw(Exporter Heap::Elem); # No names exported. @EXPORT = ( ); # Available for export: RefElem (to allocate a new Heap::Elem::Ref value) @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 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 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) element still remaining. (See L if you want the heap to always return the largest element.) The details of the Elem interface are described in L. The details of using a Heap interface are described in L. =head1 AUTHOR John Macdonald, john@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 Heap-0.80/lib/Heap/Elem/Num.pm0000644000175100017510000000273310614706105014405 0ustar johnjohnpackage Heap::Elem::Num; use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); use Heap::Elem; require Exporter; @ISA = qw(Exporter Heap::Elem); # No names exported. @EXPORT = ( ); # Available for export: NumElem (to allocate a new Heap::Elem::Num value) @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 if you want the heap to always return the largest element.) The details of the Elem interface are described in L. The details of using a Heap interface are described in L. =head1 AUTHOR John Macdonald, john@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 Heap-0.80/lib/Heap/Elem/StrRev.pm0000644000175100017510000000306510614706105015072 0ustar johnjohnpackage Heap::Elem::StrRev; use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); use Heap::Elem; require Exporter; @ISA = qw(Exporter Heap::Elem); # No names exported. @EXPORT = ( ); # Available for export: StrRElem (to allocate a new Heap::Elem::StrRev value) @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 if you want the heap to always return the smallest element.) The details of the Elem interface are described in L. The details of using a Heap interface are described in L. =head1 AUTHOR John Macdonald, john@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 Heap-0.80/lib/Heap/Elem/RefRev.pm0000644000175100017510000000361610614706105015040 0ustar johnjohnpackage Heap::Elem::RefRev; use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); use Heap::Elem; require Exporter; @ISA = qw(Exporter Heap::Elem); # No names exported. @EXPORT = ( ); # Available for export: RefRElem (to allocate a new Heap::Elem::RefRev value) @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 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 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) element still remaining. (See L if you want the heap to always return the smallest element.) The details of the Elem interface are described in L. The details of using a Heap interface are described in L. =head1 AUTHOR John Macdonald, john@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 Heap-0.80/lib/Heap/Elem.pm0000644000175100017510000001015010614706105013636 0ustar johnjohnpackage 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 and I. 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, 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@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 Heap-0.80/lib/Heap/Fibonacci.pm0000644000175100017510000002330310614706105014635 0ustar johnjohnpackage 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 method of an element is used to store a reference to the node in the list that refers to the element. See L for details on using this module. =head1 AUTHOR John Macdonald, john@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 Heap-0.80/lib/Heap/Binomial.pm0000644000175100017510000002156410614706105014521 0ustar johnjohnpackage 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 method of an element is used to store a reference to the node in the list that refers to the element. See L for details on using this module. =head1 AUTHOR John Macdonald, john@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 Heap-0.80/lib/Heap/Binary.pm0000644000175100017510000001426410614706105014212 0ustar johnjohnpackage 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 method of an element is used to store the index into the array that refers to the element. See L for details on using this module. =head1 AUTHOR John Macdonald, john@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 Heap-0.80/lib/Heap.pm0000644000175100017510000000745710614706105012774 0ustar johnjohnpackage 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 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 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 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 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 is called. Only a decrease is permitted. (This is a decrease according to the I 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 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.) =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@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 Heap-0.80/Changes0000644000175100017510000000364510614706105012301 0ustar johnjohnRevision 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 - fixed bug in Heap::Binary delete - noted by Arun Bhalla - 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 - 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 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++) Heap-0.80/MANIFEST0000644000175100017510000000075210614706105012133 0ustar johnjohnChanges 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) Heap-0.80/TODO0000644000175100017510000000027010614706105011465 0ustar johnjohn 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 Heap-0.80/META.yml0000644000175100017510000000051410614707122012247 0ustar johnjohn# 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 Heap-0.80/README0000644000175100017510000000315410614706105011661 0ustar johnjohnHeap 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 Copyright: This code is copyright 1998-2007 O'Reilly & Associates. It is available on the same terms as perl itself. Heap-0.80/Makefile.PL0000644000175100017510000000045510614706105012754 0ustar johnjohnuse 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 );