## Binomial Heaps

### June 5, 2012

We begin with some simple utility functions:

`(define node vector) ; rank item kids`

(define (rank n) (vector-ref n 0))

(define (item n) (vector-ref n 1))

(define (kids n) (vector-ref n 2))

(define empty (list))

(define empty? null?)

Linking assumes that two heaps have the same rank; we can enforce that condition because `link`

is only called internally, never by client code. The lesser element becomes the root of the new heap:

`(define (link lt? h1 h2)`

(if (not (lt? (item h1) (item h2)))

(node (add1 (rank h1))

(item h2)

(cons h1 (kids h2)))

(node (add1 (rank h1))

(item h1)

(cons h2 (kids h1)))))

The `insert`

function builds a singleton heap, then calls an auxiliary function to perform the insertion. `Insert-tree`

iterates through the list of trees, linking as it goes, until it finds a “hole” in the ranks. This process propagates through the list in a similar way to the “carry” in binary addition, an analogy that Okasaki exploits fruitfully in his book:

`(define (insert-tree lt? t ts)`

(if (null? ts) (list t)

(if (< (rank t) (rank (car ts))) (cons t ts)

(insert-tree lt? (link lt? t (car ts)) (cdr ts)))))

`(define (insert lt? x ts)`

(insert-tree lt? (node 0 x (list)) ts))

`Merge`

recurs through the trees, calling `insert-tree`

when it finds two of equal rank:

`(define (merge lt? ts1 ts2)`

(cond ((empty? ts1) ts2)

((empty? ts2) ts1)

((< (rank (car ts1)) (rank (car ts2)))

(cons (car ts1) (merge lt? (cdr ts1) ts2)))

((< (rank (car ts2)) (rank (car ts1)))

(cons (car ts2) (merge lt? ts1 (cdr ts2))))

(else (insert-tree lt? (link lt? (car ts1) (car ts2))

(merge lt? (cdr ts1) (cdr ts2))))))

`Remove-min-tree`

`cdr`

s through the list of trees until it finds the minimum, which is simple since the trees are in order, returning multiple values when it finds the minimum:

`(define (remove-min-tree lt? ts)`

(cond ((null? ts) (error 'remove-min-tree "empty"))

((null? (cdr ts)) (values (car ts) (list)))

(else (call-with-values

(lambda () (remove-min-tree lt? (cdr ts)))

(lambda (t-prime ts-prime)

(if (not (lt? (item (car ts)) (item t-prime)))

(values t-prime (cons (car ts) ts-prime))

(values t-prime ts-prime)))))))

`Find-min`

is simple. `Delete-min`

calls `merge`

to do the hard work; note the reversal, because the list of trees is kept in decreasing order:

`(define (find-min lt? ts)`

(call-with-values

(lambda () (remove-min-tree lt? ts))

(lambda (t ts) (item t))))

`(define (delete-min lt? ts)`

(call-with-values

(lambda () (remove-min-tree lt? ts))

(lambda (h ts) (merge lt? (reverse (kids h)) ts))))

As an example of the library, we write functions `from-list`

, `to-list`

, and `sort`

:

`(define (from-list lt? xs)`

(let ((h empty))

(do ((xs xs (cdr xs))) ((null? xs) h)

(set! h (insert lt? (car xs) h)))))

`(define (to-list lt? ts)`

(let loop ((ts ts) (xs (list)))

(if (empty? ts) (reverse xs)

(loop (delete-min lt? ts)

(cons (find-min lt? ts) xs)))))

`(define (sort lt? xs)`

(to-list lt? (from-list lt? xs)))

And here it is at work:

`> (sort '(3 7 6 1 5 2 4))`

(1 2 3 4 5 6 7)

When you implement the library, you will find that it’s not particularly fast; in particular, you would prefer an *O*(1) function for `find-min`

, which is after all the reason you want a heap library. Okasaki goes on to describe several improvements to these binomial heaps; perhaps we will see them in future exercises.

You can run the program at http://programmingpraxis.codepad.org/IgEKV5iJ.

Pages: 1 2