### 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:

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:

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):

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

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):

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:

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:

CONSOLIDATE(H)

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

FIB-HEAP-LINK (H,y,x)

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

else

(fh_splice_nodes heap.min node;

if (heap.compare_func n.data (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)

in

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 = x.degree in

if is_empty a.(d) then

a.(d) <- Node(x)

else

(let y = (as_fh_node_rec a.(d)) in

a.(d) <- Empty;

if heap.compare_func x.data y.data then

(fh_link x y; put_in_slot x)

else

(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;;