ac57af572e2bc95e8be37c66b1a590f36246759a
use vars
qw($VERSION @ISA @EXPORT @EXPORT_OK);
@ISA = qw(Exporter AutoLoader);
# No names available for export.
# Preloaded methods go here.
# el - linkable element, contains user-provided value
# v - user-provided value
################################################# debugging control
# enable/disable debugging output
@_ ?
($debug = shift) : $debug;
# enable/disable validation checks on values
@_ ?
($validate = shift) : $validate;
$width = 2 if $width < 2;
$bar = $corner = ' ' x
$width;
substr($corner,-2,2) = '+-';
hdump
$ch1 = $el->{child
},
$l1 . sprintf( $vfmt, $el->{val
}->val),
for( $ch = $ch1->{right
}; $ch != $ch1; $ch = $ch->{right
} ) {
hdump
$ch, $b . $corner, $b . $bar;
hdump
$el, sprintf( "%02d: ", $el->{degree
}), ' ';
die "bad back link" unless $cur->{left
} == $prev;
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
};
if $p && $p->{val
}->cmp($cur->{val
}) > 0;
$ch = $cur->{child
} and bhcheck
$ch, $cur;
heapdump
$h if $validate >= 2;
$el = $$h and bhcheck
$el, undef;
################################################# forward declarations
################################################# 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.
my $class = ref($self) || $self;
die "Method 'heap' required for element on heap"
die "Method 'cmp' required for element on heap"
link_to_left_of
$top->{left
}, $el ;
link_to_left_of
$el,$top;
$$h = $el if $v->cmp($top->{val
}) < 0;
my $el = $$h or return undef;
# $el is the heap with the lowest value on it
# move all of $el's children (if any) to the top list (between
if( $cur = $el->{child
} ) {
# remember the beginning of the list of children
# the children are moving to the top, clear the p
# pointer for all of them
} until ($cur = $cur->{right
}) == $first;
# remember the end of the list
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
link_to_left_of
$el->{left
}, $$h = $el->{right
};
# now all those loose ends have to be merged together as we
# 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...
$el->{left
} = $el->{right
} = $el->{p
} = $el->{child
} = $el->{val
} =
*extract_minimum
= \
&extract_top
;
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
# $el2l -> $el2 -> ... -> $el2l are on $h2
# at end, $ell -> $el2l -> ... -> $el2 -> $el -> ... -> $ell are
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;
# a key has been decreased, it may have to percolate up in its heap
my $el = $v->heap or return undef;
# 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;
# 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)
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
$p = $el->{p
} and ascending_cut
$$h, $p, $el;
# $el is in the top list now, make it look like the smallest and
################################################# internal utility functions
$el->{left
} = $el->{right
} = $el;
$ch = $el->{child
} and elem_DESTROY
$ch;
$el->{child
} = $el->{right
} = $el->{left
} = $el->{p
} = $el->{val
}
if( $pc = $p->{child
} ) {
link_to_left_of
$pc->{left
}, $c;
my $last = $next->{left
};
# examine next item on top list
# 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
($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
};
link_as_parent_of
$cur, $alt;
# make sure that $h still points to a node at the top
# we've removed the old $d degree entry
# and we now have a $d+1 degree entry to try to insert
# found a previously unused degree
for $cur (grep defined, @a) {
$$h = $cur if $$h->{val
}->cmp( $cur->{val
} ) > 0;
# there are still other children below $p
link_to_left_of
$l, $el->{right
};
# $el was the only child of $p
link_to_left_of
$top->{left
}, $el;
link_to_left_of
$el, $top;
last unless $p = $el->{p
};
# quit if we can mark $el
$el->{mark
} = 1, last unless $el->{mark
};
Heap::Fibonacci - a Perl extension for keeping data partially sorted
$heap = Heap::Fibonacci->new;
Keeps elements in heap order using a linked list of Fibonacci trees.
The I<heap> method of an element is used to store a reference to
the node in the list that refers to the element.
See L<Heap> for details on using this module.
John Macdonald, jmm@perlwolf.com
Copyright 1998-2003, O'Reilly & Associates.
This code is distributed under the same copyright terms as perl itself.