/usr/local/CPAN/Heap-Simple-Perl/Heap/Simple/Wrapper.pm

• package Heap::Simple::Wrapper
  • _ELEMENTS_PREPARE
  • _QUICK_KEY
  • _KEY
  • _VALUE
  • _WRAPPER
  • insert
  • key_insert
  • _key_insert
  • _key_absorb
  • wrapped
• EOF

package Heap::Simple::Wrapper;
$VERSION = "0.04";
use strict;

sub _ELEMENTS_PREPARE {
    return "";
}

sub _QUICK_KEY {
    return shift->_KEY(@_);
}

sub _KEY {
    return $_[1] . "->[0]";
}

sub _VALUE {
    return $_[1] . "->[1]";
}

sub _WRAPPER {
    return "[$_[1], $_[2]]";
}

sub insert {
    my $heap = shift;
    Carp::croak "Wrapped class with noop key" if $heap->_KEY("") eq "";
    $heap->_make('sub insert {
        my $heap = shift;
        _REAL_PREPARE()
        _CANT_DIE(
        _MAX_COUNT(my $available = _THE_MAX_COUNT()-$#$heap;)
        if (@_ > 1 _MAX_COUNT(&& $available > 1)) {
		my $first = @$heap;
                my $i = push(@$heap, map _WRAPPER(_REAL_KEY($_), $_), _MAX_COUNT(splice(@_, 0, $available), @_))-1;
		my @todo = reverse $first/2..$#$heap/2;
                while (my $j = shift @todo) {
	    	    my $value = $heap->[$j];
                        my $key = _KEY($value);
                        my $l = $j*2;
                        while ($l < $i) {
                                if (_SMALLER(_KEY($heap->[$l]), $key)) {
                                        $l++ if _SMALLER(_KEY($heap->[$l+1]), _KEY($heap->[$l]));
                                } elsif (!(_SMALLER(_KEY($heap->[++$l]), $key))) {
                                        $l--;
                                        last;
                                }
                                $heap->[$l >> 1] = $heap->[$l];
                                $l *= 2;
                        }
                        if ($l == $i && _SMALLER(_KEY($heap->[$l]), $key)) {
                                $heap->[$l >> 1] = $heap->[$l];
                        } else {
				$l >>= 1;
	    	    }
                        if ($j != $l) {
                                $heap->[$l] = $value;
                                $l >>= 1;
                                push(@todo, $l) if !@todo || $l < $todo[0];
                        }
                }
		return _MAX_COUNT(unless @_);
        })
        for my $value (@_) {
        my $key = _REAL_KEY($value);
        my $i = @$heap;
        _MAX_COUNT(if ($i > _THE_MAX_COUNT()) {
                next unless _SMALLER(_KEY($heap->[1]), $key);
                $i--;
                my $l = 2;
                _CAN_DIE(my $min = $heap->[1]; eval {)
                        while ($l < $i) {
                                if (_SMALLER(_KEY($heap->[$l]), $key)) {
                                        $l++ if _SMALLER(_KEY($heap->[$l+1]), _KEY($heap->[$l]));
                                } elsif (!(_SMALLER(_KEY($heap->[++$l]), $key))) {
                                        $l--;
                                        last;
                                }
                                $heap->[$l >> 1] = $heap->[$l];
                                $l *= 2;
                        }
                        if ($l == $i && _SMALLER(_KEY($heap->[$l]), $key)) {
                                $heap->[$l >> 1] = $heap->[$l];
                                $l *= 2;
                        }
                _CAN_DIE(        1
        } || $heap->_e_recover($l, $min);)
        $heap->[$l >> 1] = _WRAPPER($key, $value);
        next;})
        _CAN_DIE(eval {)
                $i = $i >> 1 while
                $i > 1 && _SMALLER($key, _KEY(($heap->[$i] = $heap->[$i >> 1])));
        _CAN_DIE(1} || $heap->_i_recover($i);)
        $heap->[$i] = _WRAPPER($key, $value);
        }}');
    $heap->insert(@_);
}

sub key_insert {
    my $heap = shift;
    $heap->_make('sub key_insert {
        my $heap = shift;
        _PREPARE()
        while (@_) {
        my $key  = shift;
        my $i = @$heap;
        _MAX_COUNT(if ($i > _THE_MAX_COUNT()) {
                shift _COMMA() next unless _SMALLER(_KEY($heap->[1]), $key);
                $i--;
                my $l = 2;
                _CAN_DIE(my $min = $heap->[1]; eval {)
                        while ($l < $i) {
                                if (_SMALLER(_KEY($heap->[$l]), $key)) {
                                        $l++ if _SMALLER(_KEY($heap->[$l+1]), _KEY($heap->[$l]));
                                } elsif (!(_SMALLER(_KEY($heap->[++$l]), $key))) {
                                        $l--;
                                        last;
                                }
                                $heap->[$l >> 1] = $heap->[$l];
                                $l *= 2;
                        }
                        if ($l == $i && _SMALLER(_KEY($heap->[$l]), $key)) {
                                $heap->[$l >> 1] = $heap->[$l];
                                $l *= 2;
                        }
                _CAN_DIE(        1
        } || $heap->_e_recover($l, $min);)
        $heap->[$l >> 1] = _WRAPPER($key, shift);
        next;})
        _CAN_DIE(eval {)
        $i = $i >> 1 while 
                $i > 1 && _SMALLER($key, _KEY(($heap->[$i] = $heap->[$i >> 1])));
        _CAN_DIE(1} || $heap->_i_recover($i);)
        $heap->[$i] = _WRAPPER($key, shift);
        }}');
    $heap->key_insert(@_);
}

sub _key_insert {
    my $heap = shift;
    $heap->_make('sub _key_insert {
        my $heap = shift;
        _PREPARE()
        for my $pair (@_) {
        my $key  = $pair->[0];
        my $i = @$heap;
        _MAX_COUNT(if ($i > _THE_MAX_COUNT()) {
                next unless _SMALLER(_KEY($heap->[1]), $key);
                $i--;
                my $l = 2;
                _CAN_DIE(my $min = $heap->[1]; eval {)
                        while ($l < $i) {
                                if (_SMALLER(_KEY($heap->[$l]), $key)) {
                                        $l++ if _SMALLER(_KEY($heap->[$l+1]), _KEY($heap->[$l]));
                                } elsif (!(_SMALLER(_KEY($heap->[++$l]), $key))) {
                                        $l--;
                                        last;
                                }
                                $heap->[$l >> 1] = $heap->[$l];
                                $l *= 2;
                        }
                        if ($l == $i && _SMALLER(_KEY($heap->[$l]), $key)) {
                                $heap->[$l >> 1] = $heap->[$l];
                                $l *= 2;
                        }
                _CAN_DIE(        1
        } || $heap->_e_recover($l, $min);)
        $heap->[$l >> 1] = $pair;
        next;})
        _CAN_DIE(eval {)
        $i = $i >> 1 while 
                $i > 1 && _SMALLER($key, _KEY(($heap->[$i] = $heap->[$i >> 1])));
        _CAN_DIE(1} || $heap->_i_recover($i);)
        $heap->[$i] = $pair;
        }}');
    $heap->_key_insert(@_);
}

sub _key_absorb {
    my ($from, $to) = @_;
    Carp::croak "Self absorption" if $from == $to;
    if (@$from > 2 && !$to->can_die) {
        $to->_key_insert(@$from[1..$#$from]);
        $#$from = 0;
        return;
    }
    while (@$from > 1) {
        $to->_key_insert($from->[-1]);
        pop @$from;
    }
}

sub wrapped {
    return 1;
}

1;