PairingHeap.hs

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

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

import Prelude hiding (head, tail)

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

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 $ meldAll hs

meldAll [] = Empty
meldAll (h:[]) = h
meldAll (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


removeWith :: (Ord a) => (a -> Bool) -> PairingHeap a -> PairingHeap a
removeWith f Empty = Empty
removeWith f (Heap b hs) = if (f b) then meldAll $ kill hs
                           else Heap b $ kill hs
    where kill hs = filter ((/=) Empty) $ map (removeWith f) hs