view release on metacpan or  search on metacpan

bench/heap.pl  view on Meta::CPAN

#!/usr/bin/env perl
use strict;
use warnings;
use Benchmark qw(:all);
use lib 'blib/lib', 'blib/arch';

use heap 'import';  # Import function-style API
use Array::Heap qw(make_heap push_heap pop_heap);

# Import raw array functions
*push_heap_min = \&heap::push_heap_min;
*pop_heap_min = \&heap::pop_heap_min;
*make_heap_min = \&heap::make_heap_min;

print "=" x 60, "\n";
print "Heap Benchmark: heap (XS) vs Array::Heap (XS) vs Pure Perl\n";
print "=" x 60, "\n\n";

# Pure Perl min-heap implementation for comparison
package PureHeap {
    sub new {
        my $class = shift;
        return bless { data => [] }, $class;
    }

    sub push {
        my ($self, $val) = @_;
        push @{$self->{data}}, $val;
        $self->_sift_up($#{$self->{data}});
        return $self;
    }

    sub pop {
        my $self = shift;
        return undef unless @{$self->{data}};
        my $top = $self->{data}[0];
        my $last = pop @{$self->{data}};
        if (@{$self->{data}}) {
            $self->{data}[0] = $last;
            $self->_sift_down(0);
        }
        return $top;
    }

    sub peek { $_[0]->{data}[0] }
    sub size { scalar @{$_[0]->{data}} }

    sub _sift_up {
        my ($self, $idx) = @_;
        while ($idx > 0) {
            my $parent = int(($idx - 1) / 2);
            last if $self->{data}[$parent] <= $self->{data}[$idx];
            @{$self->{data}}[$parent, $idx] = @{$self->{data}}[$idx, $parent];
            $idx = $parent;
        }
    }

    sub _sift_down {
        my ($self, $idx) = @_;
        my $size = @{$self->{data}};
        while (1) {
            my $left = 2 * $idx + 1;
            my $right = 2 * $idx + 2;
            my $smallest = $idx;
            $smallest = $left if $left < $size && $self->{data}[$left] < $self->{data}[$smallest];