Pairing Heaps
August 14, 2009
We represent a node in a priority queue as a list with the item in its car and the multi-way tree in its cdr. The empty priority queue is represented by the null list:
(define pq-empty '())
(define pq-empty? null?)
Pq-first, pq-merge and pq-insert are all trivial:
(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))
Pq-rest deletes the item at the root of a node, returning the tail after submitting it to the two-pass pair-wise merge algorithm:
(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))))
We provide conversions to and from lists and a sorting function based on priority queues; the functions below are copied unchanged from the prior exercise:
(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)))))
(define (pq-sort lt? xs)
(pq->list lt? (list->pq lt? xs)))
Here is a simple demonstration of priority queues:
> (pq-sort < '(3 7 8 1 2 9 6 4 5))
(1 2 3 4 5 6 7 8 9)
You can run the code at http://programmingpraxis.codepad.org/NHfZUl38.
Programming Praxis 
[…] Remco Niemeijer Righty, I’m back from vacation so let’s get right back to business. In today’s Programming Praxis problem we have another data structure to implement. Let’s get […]
My Haskell solution (see http://bonsaicode.wordpress.com/2009/08/14/programming-praxis-pairing-heaps/ for a version with comments):
data PairingHeap a = Empty | Node a [PairingHeap a] findFirst :: PairingHeap a -> Maybe a findFirst Empty = Nothing findFirst (Node n _) = Just n merge :: Ord a => PairingHeap a -> PairingHeap a -> PairingHeap a merge Empty p = p merge p Empty = p merge m@(Node x ps) n@(Node y qs) | y < x = Node y (m:qs) | otherwise = Node x (n:ps) insert :: Ord a => a -> PairingHeap a -> PairingHeap a insert x = merge (Node x []) deleteFirst :: Ord a => PairingHeap a -> PairingHeap a deleteFirst Empty = Empty deleteFirst (Node _ ps) = foldr merge Empty $ pair ps where pair (a:b:xs) = merge a b : pair xs pair xs = xs fromList :: Ord a => [a] -> PairingHeap a fromList = foldr insert Empty toList :: Ord a => PairingHeap a -> [a] toList Empty = [] toList n@(Node x _) = x : toList (deleteFirst n) pqSort :: Ord a => [a] -> [a] pqSort = toList . fromList main :: IO () main = print $ pqSort [3, 7, 8, 1, 2, 9, 6, 4, 5]How’s this for a Programming Praxis: Fix your damn website so it does not break in Opera when you get 1/3 of the way down the front page.
[…] […]
my implementation in C
#include <stdlib.h> typedef struct PairingHeapNode { int key; struct PairingHeapNode* child; struct PairingHeapNode* sibling; struct PairingHeapNode* prev; }PairHeap; static PairHeap* merge_subheaps(PairHeap *p, PairHeap *q); static PairHeap* combine_siblings(PairHeap *p); PairHeap* PairHeap_insert(PairHeap *p, int key) { PairHeap *node; node = (PairHeap*)malloc(sizeof(*node)); if(node == NULL) return NULL; node->key = key; node->child = node->sibling = node->prev = NULL; if(p == NULL) return node; else return merge_subheaps(p, node); } PairHeap* PairHeap_DecreaseKey(PairHeap *p, PairHeap *pos, int d) { if(d < 0) return p; pos->key = pos->key - d; if(p == pos) return p; if(pos->sibling != NULL) pos->sibling->prev = pos->prev; if(pos->prev->child = pos) pos->prev->child = pos->sibling; else pos->prev->sibling = p->sibling; p->sibling = NULL; return merge_subheaps(p, pos); } PairHeap* PairHeap_DeleteMin(int *key, PairHeap *p) { PairHeap *new_root; if(p == NULL) return NULL; else { *key = p->key; if(p->child != NULL) new_root = combine_siblings(p->child); free(p); } return new_root; } static PairHeap* combine_siblings(PairHeap *p) { PairHeap *tree_array[1024]; int i, count; if(p->sibling == NULL) return p; for(count = 0; p != NULL; count++) { tree_array[count] = p; p->prev->sibling = NULL; p = p->sibling; } tree_array[count] = NULL; for(i = 1; i < count; i++) tree_array[i] = merge_subheaps(tree_array[i-1], tree_array[i]); return tree_array[count-1]; } static PairHeap* merge_subheaps(PairHeap *p, PairHeap *q) { if(q == NULL) return p; else if(p->key <= q->key) { q->prev = p; p->sibling = q->sibling; if(p->sibling != NULL) p->sibling->prev = p; q->sibling = p->child; if(q->sibling != NULL) q->sibling->prev = q; p->child = q; return p; } else { q->prev = p->prev; p->prev = q; p->sibling = q->child; if(p->sibling != NULL) p->sibling->prev = p; q->child = p; return q; } }[…] a program to implement the algorithm described above, using the Scheme programming language. First, here is a library implementation of priority queues using the pairing heap […]
thank you!
[…] a program to implement the algorithm described above, using the Scheme programming language. First, here is a library implementation of priority queues using the pairing heap […]