content: {-# LANGUAGE CPP #-}
  
  -- | Pairing heap implementation of dictionary
  module Data.Graph.Inductive.Internal.Heap(
      -- * Type
      Heap(..),
      prettyHeap,
      printPrettyHeap,
      -- * Operations
      empty,unit,insert,merge,mergeAll,
      isEmpty,findMin,deleteMin,splitMin,
      build, toList, heapsort
  ) where
  
  import Text.Show (showListWith)
  
  #if MIN_VERSION_containers (0,4,2)
  import Control.DeepSeq (NFData (..))
  #endif
  
  data Heap a b = Empty | Node a b [Heap a b]
       deriving (Eq, Show, Read)
  
  #if MIN_VERSION_containers (0,4,2)
  instance (NFData a, NFData b) => NFData (Heap a b) where
    rnf Empty         = ()
    rnf (Node a b hs) = rnf a `seq` rnf b `seq` rnf hs
  #endif
  
  prettyHeap :: (Show a, Show b) => Heap a b -> String
  prettyHeap = (`showsHeap` "")
    where
      showsHeap Empty             = id
      showsHeap (Node key val []) = shows key . (": "++) . shows val
      showsHeap (Node key val hs) = shows key . (": "++) . shows val
                                    .  (' ':) . showListWith showsHeap hs
  
  printPrettyHeap :: (Show a, Show b) => Heap a b -> IO ()
  printPrettyHeap = putStrLn . prettyHeap
  
  ----------------------------------------------------------------------
  -- MAIN FUNCTIONS
  ----------------------------------------------------------------------
  
  empty :: Heap a b
  empty = Empty
  
  unit :: a -> b -> Heap a b
  unit key val = Node key val []
  
  insert :: (Ord a) => (a, b) -> Heap a b -> Heap a b
  insert (key, val) = merge (unit key val)
  
  merge :: (Ord a) => Heap a b -> Heap a b -> Heap a b
  merge h Empty = h
  merge Empty h = h
  merge h@(Node key1 val1 hs) h'@(Node key2 val2 hs')
      | key1<key2 = Node key1 val1 (h':hs)
      | otherwise = Node key2 val2 (h:hs')
  
  mergeAll:: (Ord a) => [Heap a b] -> Heap a b
  mergeAll []        = Empty
  mergeAll [h]       = h
  mergeAll (h:h':hs) = merge (merge h h') (mergeAll hs)
  
  isEmpty :: Heap a b -> Bool
  isEmpty Empty = True
  isEmpty _     = False
  
  findMin :: Heap a b -> (a, b)
  findMin Empty      = error "Heap.findMin: empty heap"
  findMin (Node key val _) = (key, val)
  
  deleteMin :: (Ord a) => Heap a b -> Heap a b
  deleteMin Empty             = Empty
  deleteMin (Node _ _ hs) = mergeAll hs
  
  splitMin :: (Ord a) => Heap a b -> (a,b,Heap a b)
  splitMin Empty             = error "Heap.splitMin: empty heap"
  splitMin (Node key val hs) = (key,val,mergeAll hs)
  
  
  ----------------------------------------------------------------------
  -- APPLICATION FUNCTIONS, EXAMPLES
  ----------------------------------------------------------------------
  
  
  build :: (Ord a) => [(a,b)] -> Heap a b
  build = foldr insert Empty
  
  toList :: (Ord a) => Heap a b -> [(a,b)]
  toList Empty = []
  toList h = x:toList r
             where (x,r) = (findMin h,deleteMin h)
  
  heapsort :: (Ord a) => [a] -> [a]
  heapsort = map fst . toList . build . map (\x->(x,x))
  {-
  l :: (Num a) => [a]
  l  = [6,9,2,13,6,8,14,9,10,7,5]
  l' = reverse l
  
  h1  = build $ map (\x->(x,x)) l
  h1' = build $ map (\x->(x,x)) l'
  
  s1  = heapsort l
  s1' = heapsort l'
  -}
  