PairingHeap.hs

{* Simple implementation of a pairing heap that supports safe
   head, tail *}

module PairingHeap ( empty
                   , insert
                   , head
                   , tail
                   , meld
                   , safeHead
                   , safeTail ) where

import Prelude hiding (head, tail)

data PairingHeap a = Empty 
                   | Heap a [PairingHeap a]
                   deriving (Show)

empty = Empty

insert :: (Ord a) => a -> PairingHeap a -> PairingHeap a
insert e h = meld (Heap e []) h

isEmpty Empty = True
isEmpty _ = False

head h = case safeHead h of
           Just h -> h
           _ -> error "can't call head on empty heap"

tail h = case safeTail h of
           Just h -> h
           _ -> error "can't call tail on empty heap"

safeHead Empty = Nothing
safeHead (Heap elem _) = Just elem

safeTail Empty = Nothing
safeTail (Heap _ []) = Just Empty
safeTail (Heap _ [h]) = Just h
safeTail (Heap _ hs) = Just $ mergePairs hs
   where mergePairs [] = Empty
         mergePairs (h:[]) = h
         mergePairs (h:hs) = foldr meld h hs

meld :: (Ord a) => PairingHeap a -> PairingHeap a -> PairingHeap a
meld h Empty = h
meld Empty h = h
meld ah@(Heap a as) bh@(Heap b bs) 
   | a < b = Heap a $ bh : as
   | otherwise = Heap b $ ah : bs