Another day, another study. Again, nothing fancy – merely a FTR, heap (or minheap, with root containing the minimum) implementation in Perl. extract_top name is to keep main interface similar to existing CPAN modules (like Heap::Simple)
package Heap::Hydra;
sub new {
return bless {_heap => [undef,], _heap_size => 0}, shift;
}
sub getParent {
my $self = shift;
my $child_pos = shift;
my $parent_pos = int($child_pos * 0.5) || 1;
return $self->{_heap}->[$parent_pos], $parent_pos;
}
sub getMinKid {
my $self = shift;
my $parent_pos = shift;
my $child_pos = $parent_pos * 2;
return undef if $child_pos >= scalar @{$self->{_heap}};
my $min_child = $self->{_heap}->[$child_pos];
if (defined $self->{_heap}->[$child_pos + 1] && $self->{_heap}->[$child_pos + 1] < $min_child) {
$child_pos += 1;
$min_child = $self->{_heap}->[$child_pos];
}
return $min_child, $child_pos;
}
sub extract_top {
my $self = shift;
my $top_pos = shift || 1;
my ($new_top, $new_top_pos) = $self->getMinKid($top_pos);
if (!defined $new_top) {
return splice @{$self->{_heap}}, $top_pos, 1;
}
my $prev_top = $self->{_heap}->[$top_pos];
$self->{_heap}->[$top_pos] = $self->extract_top($new_top_pos);
$self->{_heap_size}--;
return $prev_top;
}
sub insert {
my $self = shift;
my $child = shift;
$self->{_heap_size}++;
$self->{_heap}->[$self->{_heap_size}] = $child;
my $child_pos = $self->{_heap_size};
my ($parent, $parent_pos) = $self->getParent($child_pos);
while ($parent > $child) {
$self->{_heap}->[$parent_pos] = $child;
$self->{_heap}->[$child_pos] = $parent;
$child_pos = $parent_pos;
($parent, $parent_pos) = $self->getParent($child_pos);
}
return $child_pos;
}