Thursday, March 31, 2005


Fibonacci heap consolidate function

While redoing my fib heap code in OCAML, I figured out a nice tail-recursive way to do part of the heap consolidation function. The pseudo-code of the algorithm, as specified in CLRS is:

for i := 0 to d(n[H])
fo A[i] := NIL

for each node w in the root list of H
do x <= w
d := degree[x]
while A[d] != NIL
do y := A[d]
if key[x] > key[y]
then exchange x <-> y
A[d] := nil
d := d + 1
A[d] := x
min[H] := nil
for i := 0 to D(n[H])
do if A[i] != NIL
then add A[i] to the root list of H
if min[H] = nil or key[A[i]] < key[min[H]]
then min[H] := A[i]

I tend to split this into two pieces. The first part (the "for each node w ...") creates an array of root-level nodes, each with a different degree (number of children). If two nodes have the same degree, one becomes the child of the other - the one with the lower key being the parent. Once this array has been created, the second part wipes out the old root list and re-inserts the new nodes, adjusting the min pointer to point to the node with the lowest key.

The second part, in OCAML, looks like this:

let fh_consolidate2 heap node =
match node with
Empty -> ()
| Node(n) ->
if is_empty heap.min then
heap.min <- node
(fh_splice_nodes heap.min node;
if (heap.compare_func (as_fh_node_rec heap.min).data) then
heap.min <- node);;

I call fh_consolidate2 using an iterator (see my earlier blog on partial functions if you don't understand how I can pass (fh_consolidate2 heap) this way):

Array.iter (fh_consolidate2 heap) a;;

The first part is more interesting because it is a pain to write in OCAML. The LISP version looks like this:

(do* ((num-roots (fib-heap-node-list-length (fib-heap-min heap)) (decf num-roots))
(x (fib-heap-min heap) next)
(d (fib-heap-node-degree x) (fib-heap-node-degree x))
(next (fib-heap-node-right x) (fib-heap-node-right x)))
((<= num-roots 0))
(do ((y (aref a d) (aref a d)))
((null y))
(when (funcall (fib-heap-compare-func heap)
(fib-heap-node-data y) (fib-heap-node-data x))
(let ((temp x))
(setf x y)
(setf y temp)))
(fib-heap-link x y)
(setf (aref a d) nil)
(incf d))
(setf (aref a d) x))

As you can see, this is pretty much an imperitive Lisp version of the pseudo-code.
One observation I made was that since I am clearing out the root level of the heap, I can go ahead and do that as I iterate through the heap. I created a destructive foreach that removes nodes from the heap as it goes through. Since the list is circular, the loop is done when a node's right pointer points to itself (meaning it is the last one):

let destructive_foreach f node =
match node with
Empty -> ()
| Node(n) ->
let rec foreach_iter curr next =
fh_remove_from_list curr;
(f curr);
if next != curr then
(foreach_iter next next.right)
foreach_iter n n.right;;

Now that destructive_foreach handles the "for each node w in the root list of H", I just need a better way to store the nodes in the A array. The "while A[d] != NIL" loop is really just a loop that looks for an empty slot in A. I rewrote the loop as a tail recursive procedure like this:

let rec put_in_slot x =
let d = in
if is_empty a.(d) then
a.(d) <- Node(x)
(let y = (as_fh_node_rec a.(d)) in
a.(d) <- Empty;
if heap.compare_func then
(fh_link x y; put_in_slot x)
(fh_link y x; put_in_slot y))

Basically, look at the degree of x, if a[d] is empty, put x in there. Otherwise, pull the item out of a[d] and call it y. Link x and y together and then look for a slot to put the new joined-together nodes. Now, the guts of the consolidate routine just look like this:

destructive_foreach put_in_slot heap.min;
heap.min <- Empty;
Array.iter (fh_consolidate2 heap) a;;

Comments: Post a Comment

<< Home

This page is powered by Blogger. Isn't yours?