Heap.hs

module My.Data.Heap( Heap(..)
                   ) where

class Heap h where
  empty     :: Ord a => h a
  isEmpty   :: Ord a => h a -> Bool

  insert    :: Ord a => a -> h a -> h a
  merge     :: Ord a => h a -> h a -> h a

  find   :: Ord a => h a -> Maybe a
  delete :: Ord a => h a -> Maybe (h a)

LeftistHeap.hs

{-# LANGUAGE FlexibleInstances #-}

module My.Data.LeftistHeap( LeftistHeap
                          , fromListMax
                          , fromListMin
                          , module My.Data.Heap
                          ) where

import My.Data.Heap

data Max
data Min

data LeftistHeap a b = E | T Int b (LeftistHeap a b) (LeftistHeap a b) deriving Show

fromListMax :: Ord b => [b] -> LeftistHeap Max b
fromListMax [] = E
fromListMax (x:xs) = merge (T 1 x E E) $ fromListMax xs

fromListMin :: Ord b => [b] -> LeftistHeap Min b
fromListMin [] = E
fromListMin (x:xs) = merge (T 1 x E E) $ fromListMin xs

rank :: LeftistHeap a b -> Int
rank E = 0
rank (T r _ _ _) = r

makeT :: b -> LeftistHeap a b -> LeftistHeap a b -> LeftistHeap a b
makeT x a b = if rank a >= rank b
              then T (rank b + 1) x a b
              else T (rank a + 1) x b a

instance Heap (LeftistHeap Min) where
  empty     = E

  isEmpty E = True
  isEmpty _ = False

  insert x h = merge (T 1 x E E) h

  merge h E = h
  merge E h = h
  merge (h1@(T _ x a1 b1)) (h2@(T _ y a2 b2))
    = if x <= y
      then makeT x a1 $ merge b1 h2
      else makeT y a2 $ merge h1 b2

  find E = Nothing
  find (T _ x _ _) = Just x

  delete E = Nothing
  delete (T _ _ a b) = Just (merge a b)


instance Heap (LeftistHeap Max) where
  empty     = E

  isEmpty E = True
  isEmpty _ = False

  insert x h = merge (T 1 x E E) h

  merge h E = h
  merge E h = h
  merge (h1@(T _ x a1 b1)) (h2@(T _ y a2 b2))
    = if x >= y
      then makeT x a1 $ merge b1 h2
      else makeT y a2 $ merge h1 b2

  find E = Nothing
  find (T _ x _ _) = Just x

  delete E = Nothing
  delete (T _ _ a b) = Just (merge a b)