Programming Praxis - Pairing Heaps

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 started.

The data structure is a simple tree:

data PairingHeap a = Empty | Node a [PairingHeap a]

findFirst, merge and insert are fairly trivial.

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 [])

For deleteFirst, just folding merge over ps would work as well, but the implementation calls for two passes, presumably for efficiency reasons.

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

And to implement the priority queue we need fromList, toList and pqSort from the priority queues exercise.

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

Let’s test if everything works:

main :: IO ()
main = print $ pqSort [3, 7, 8, 1, 2, 9, 6, 4, 5]

Yup. Simple enough.

About these ads

Tags: pairing, praxis, programming