Programming Praxis

My solution uses pairing heaps for the priority queue and sets implemented as a binary search tree to “pre-qualify” inserts and guarantee distinctness of the items in the priority queue. Here’s the priority queue, stolen from a previous exercise:

; priority queue -- pairing heaps

(define pq-empty (list))

(define pq-empty? null?)

(define (pq-first pq)
  (if (null? pq)
      (error 'pq-first "can't extract minimum from null queue")
      (car pq)))

(define (pq-merge lt? p1 p2)
  (cond ((null? p1) p2)
        ((null? p2) p1)
        ((lt? (car p2) (car p1))
          (cons (car p2) (cons p1 (cdr p2))))
        (else (cons (car p1) (cons p2 (cdr p1))))))

(define (pq-insert lt? x pq)
  (pq-merge lt? (list x) pq))

(define (pq-merge-pairs lt? ps)
  (cond ((null? ps) '())
        ((null? (cdr ps)) (car ps))
        (else (pq-merge lt? (pq-merge lt? (car ps) (cadr ps))
                            (pq-merge-pairs lt? (cddr ps))))))

(define (pq-rest lt? pq)
  (if (null? pq)
      (error 'pq-rest "can't delete minimum from null queue")
      (pq-merge-pairs lt? (cdr pq))))

(define (list->pq lt? xs)
  (let loop ((xs xs) (pq pq-empty))
    (if (null? xs) pq
      (loop (cdr xs) (pq-insert lt? (car xs) pq)))))

(define (pq->list lt? pq)
  (let loop ((pq pq) (xs '()))
    (if (pq-empty? pq) (reverse xs)
      (loop (pq-rest lt? pq) (cons (pq-first pq) xs)))))

Pairing heaps are my favorite implementation of the priority queue data structure; they are simple to implement, and perform quite well in practice, but their time complexity has defied analysis. Next we have a simple (unbalanced) binary search tree, with deletion implemented by tracking down the left spine of the right child of the node to be deleted to find the in-order successor, placing the in-order successor in the node of the item to be deleted, and then recursively deleting the in-order successor from the right child. This algorithm differs from the deletion in our previous implementation of binary search trees, which recursively rotates the node to be deleted down the tree until it reaches the bottom, where it is simply discarded:

; binary search tree

(define bst-empty (list))

(define bst-empty? null?)

(define (bst-member? lt? item bst)
  (cond ((bst-empty? bst) #f)
        ((lt? item (car bst))
          (bst-member? lt? item (cadr bst)))
        ((lt? (car bst) item)
          (bst-member? lt? item (caddr bst)))
        (else #t)))

(define (bst-insert lt? item bst)
  (cond ((bst-empty? bst)
          (list item (list) (list)))
        ((lt? item (car bst))
          (list (car bst)
                (bst-insert lt? item (cadr bst))
                (caddr bst)))
        ((lt? (car bst) item)
              (list (car bst)
              (cadr bst)
              (bst-insert lt? item (caddr bst))))
        (else bst)))

(define (bst-successor bst)
  (cond ((bst-empty? bst) bst-empty)
        ((bst-empty? (cadr bst)) bst)
        (else (bst-successor (cadr bst)))))

(define (bst-delete-root lt? bst)
  (cond ((and (bst-empty? (cadr bst))
              (bst-empty? (caddr bst)))
          bst-empty)
        ((bst-empty? (cadr bst)) (caddr bst))
        ((bst-empty? (caddr bst)) (cadr bst))
        (else (let ((new-root (car (bst-successor (caddr bst)))))
                (list new-root (cadr bst)
                      (bst-delete lt? new-root (caddr bst)))))))

(define (bst-delete lt? item bst)
  (cond ((bst-empty? bst) bst)
        ((lt? item (car bst))
          (list (car bst)
                (bst-delete lt? item (cadr bst))
                (caddr bst)))
        ((lt? (car bst) item)
          (list (car bst)
                (cadr bst)
                (bst-delete lt? item (caddr bst))))
        (else (bst-delete-root lt? bst))))

It would be better to use either a hash table or a balanced tree instead of a naive binary search tree, but we won’t bother. Feel free to do so if you wish. Note that hash tables are less convenient than trees for this application because using a hash table requires the programmer to provide both less-than and equal-to predicates.

Now it is easy to implement the priority queue with distinct elements. The only difference to the standard priority queue is that insertion first checks if the item is already in the queue, by querying the the binary search tree, then inserts the item only if it is not already present; insertion and deletion both update the binary search tree. The distinct priority queue is represented as a three-slot list containing the less-than predicate, priority queue, and binary search tree:

; distinct priority queue

(define (make-dpq lt?) (list lt? pq-empty bst-empty))

(define (dpq-empty? dpq) (pq-empty? (cadr dpq)))

(define (dpq-first dpq)
  (if (dpq-empty? dpq)
      (error 'dpq-first "can't extract minimum from null queue")
      (pq-first (cadr dpq))))

(define (dpq-insert item dpq)
  (if (bst-member? (car dpq) item (caddr dpq))
      dpq
      (list (car dpq)
            (pq-insert (car dpq) item (cadr dpq))
            (bst-insert (car dpq) item (caddr dpq)))))

(define (dpq-rest dpq)
  (if (dpq-empty? dpq)
      (error 'dpq-rest "can't delete minimum from null queue")
      (list (car dpq)
            (pq-rest (car dpq) (cadr dpq))
            (bst-delete (car dpq) (dpq-first dpq) (caddr dpq)))))

(define (dpq-enlist dpq) (pq->list (car dpq) (cadr dpq)))

There’s a lot of code shown above, but most if it was stolen from previous exercises, so it’s not as bad as it looks. Here are some examples:

> (define dpq (make-dpq <)) > (set! dpq (dpq-insert 3 dpq))
> (set! dpq (dpq-insert 4 dpq))
> (set! dpq (dpq-insert 1 dpq))
> (set! dpq (dpq-insert 5 dpq))
> (set! dpq (dpq-insert 3 dpq))
> (set! dpq (dpq-insert 2 dpq))
> (set! dpq (dpq-insert 5 dpq))
> (set! dpq (dpq-insert 1 dpq))
> (set! dpq (dpq-insert 2 dpq))
> (set! dpq (dpq-insert 4 dpq))
> (dpq-enlist dpq)
(1 2 3 4 5)
> (dpq-first dpq)
1
> (set! dpq (dpq-rest dpq))
> (set! dpq (dpq-rest dpq))
> (dpq-first dpq)
3
> (set! dpq (dpq-rest dpq))
> (set! dpq (dpq-rest dpq))
> (dpq-first dpq)
5
> (set! dpq (dpq-rest dpq))
> (dpq-enlist dpq)
()

Each item 1, 2, 3, 4 and 5 was inserted twice into the priority queue, but was output only once, as desired. You can run the program at http://ideone.com/K8njrh.

Pages: 1 2