# Author:  Chao-Kuei Hung
# License: This program is distributed under the same term as Perl
#          itself (GNU GPL or Artistic License)
# URL:     http://www.cyut.edu.tw/~ckhung/ 

package Heap;

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
use Carp;
require Exporter;
use overload
    '""' => 'stringify',
    'fallback' => undef
;

@ISA = qw(Exporter);
@EXPORT = qw();
@EXPORT_OK = qw();
%EXPORT_TAGS = (all => [@EXPORT_OK]);

$VERSION = '0.1';

sub new {
    my ($class, $data, %opts) = @_;
    $class = ref($class) if ref($class);
    my ($self) = bless {"#data"=>[undef, @$data]}, $class;
    # the following options need only be stored and need no further processing
    my ($k);
    foreach $k (qw(-compare -name -trace)) {
	$self->{$k} = exists $opts{$k} ? delete $opts{$k} : undef;
    }
    my (@unknown) = keys %opts;
    carp "unknown option(s) '@unknown' ignored" if (@unknown);

    if (not defined $self->{-compare}) {
	if (grep { ! /^\s*-?\d+(\.\d+)?\s*$/ } @$data) {
	    $self->{-compare} = sub { $_[0] cmp $_[1] };
	} else {
	    $self->{-compare} = sub { $_[0] <=> $_[1] };
	}
    }

    print "$self\n" if $self->{-trace};
    for ($k=int($self->size()/2); $k>=1; --$k) {
	$self->down($k);
	print "$self\n" if ($self->{-trace} and is_po2($k));
    }
    return $self;
}

sub is_po2 {
    my ($n) = @_;
    my ($po2) = 1;
    while ($po2 <= $n) {
	return 1 if $n == $po2;
	$po2 += $po2;
    }
    return 0;
}

sub size {
    my ($self, $newsize) = @_;
    $#{$self->{"#data"}} = $newsize if (defined $newsize);
    return $#{$self->{"#data"}};
}

sub is_empty {
    my ($self) = @_;
    return $self->size() <= 0;
}

sub stringify {
    my ($self) = @_;
    return "PQ[" . join(" ", @{$self->{'#data'}}[1..$self->size()]) . "]";
}

sub up {
    my ($self, $k) = @_;
    my ($v) = $self->{"#data"}[$k];
    while ($k > 1 && $self->{-compare}->($v,
	$self->{"#data"}[int($k/2)] ) < 0) {
	$self->{"#data"}[$k] = $self->{"#data"}[int($k/2)];
	$k = int($k/2);
    }
    $self->{"#data"}[$k] = $v;
}

sub down {
    my ($self, $k) = @_;
    my ($v) = $self->{"#data"}[$k];
    my ($lighter);
    while ($k*2 <= $self->size()) {
	$lighter = $k * 2;
	++$lighter if ($lighter < $self->size() && $self->{-compare}->(
	    $self->{"#data"}[$lighter+1],
	    $self->{"#data"}[$lighter]
	) < 0);
	last if ($self->{-compare}->($v, $self->{"#data"}[$lighter]) <= 0);
	$self->{"#data"}[$k] = $self->{"#data"}[$lighter];
	$k = $lighter;
    }
    $self->{"#data"}[$k] = $v;
}

sub insert {
    my ($self, $x) = @_;
    push(@{ $self->{"#data"} }, $x);
    $self->up($self->size());
    printf "(%3s) $self\n", $x if $self->{-trace};
}

sub remove {
    my ($self) = @_;
    my ($ret) = $self->{"#data"}[1];
    my ($last) = pop @{ $self->{"#data"} };
    return $ret if $self->size() <= 0;
    $self->{"#data"}[1] = $last;
    $self->down(1);
    printf "%3s | $self\n", $ret if $self->{-trace};
    return $ret;
}

if ($0 =~ /Heap.pm$/) {
# being tested as a stand-alone program, so run test code.

print "O(n) time buildheap (one output after finishing each layer)\n";
my ($data);
# 產生 20 個介於 [0..100) 之間的整數:
# $data = [ map { int(rand(100)) } 1..20 ];
# 或是直接敲入數據:
$data = [ qw(68 45 97 42 67 70 54 23 68 37 57 76 7 46 51 87 83 37 19 29) ];

my ($pq) = Heap->new($data, -trace=>1);

print "\nRandomly insert some elements\n";
$pq->insert(12);
$pq->insert(7);
$pq->insert(25);
$pq->insert(2);

print "\nRemove the smallest element one by one\n";
while ($pq->size() > 0) { $pq->remove(); }

}

1;