{- |
   An implementation of lazy pairing minimum heaps following Chris Okazaki's 
   paper 'Functional Data Structures'
   
   @inproceedings{ DBLP:conf/afp/Okasaki96
                 , author    = {Chris Okasaki}
                 , title     = {Functional Data Structures}
                 , booktitle = {Advanced Functional Programming}
                 , year      = {1996}
                 , pages     = {131-158}
                 , crossref  = {DBLP:conf/afp/1996}
                 , bibsource = {DBLP, http://dblp.uni-trier.de}
                 }  
-}
module Data.GHeap (

    Heap(..),
    empty, isEmpty,
    
    singleton, insert, merge, insertWith, mergeWith, link,
    getMin, delMin, getDelMin,
    
    toList, prios, elems,
    fromList,
    
    ) where

import Data.Function (on)
import Data.List (foldl')

data (Ord p) => Heap p v = Nil | Node p v (Heap p v) (Heap p v)
    deriving (Show)

--both (Node _ _ l r) = (l,r)
--both _              = error "Data.Heap.both: empty heap"
               
-- | Returns an empty heap
empty :: (Ord p) => Heap p v
empty = Nil

-- | Returns 'True' if the heap is empty, 'alse' otherwise
isEmpty :: (Ord p) => Heap p v -> Bool
isEmpty Nil = True
isEmpty _   = False

prio :: (Ord p) => Heap p v -> p
prio (Node p _ _ _) = p
prio _              = error "Data.Heap.prio: empty heap"

val :: (Ord p) => Heap p v -> v
val (Node _ v _ _) = v
val _              = error "Data.Heap.val: empty heap"

-- | creates a singleton heap from a priority\/value pair
singleton :: (Ord p) => p -> v -> Heap p v
singleton p v = Node p v Nil Nil

-- | 'insert k v h' inserts the value 'k' with priority 'k' into heap 'h'
insert :: (Ord p) => p -> v -> Heap p v -> Heap p v
insert  = (merge . ) . singleton

-- | 'insert k v h' inserts the value 'k' with priority 'k' into heap 'h'
--   using a combining function for value with e same key
insertWith :: (Ord p) => (v->v->v) -> p -> v -> Heap p v -> Heap p v
insertWith f  = (mergeWith f . ) . singleton

-- | Merge two heaps into one
merge :: (Ord p) => (Heap p v) -> (Heap p v) -> (Heap p v)
merge a Nil = a
merge Nil b = b
merge a b
    | on (<=) prio a b = link a b
    | otherwise       = link b a
    
--- | Merge two heaps into one using a combining function for value with
--    the same key
mergeWith :: (Ord p) => (v->v->v) -> (Heap p v) -> (Heap p v) -> (Heap p v)
mergeWith _ a Nil = a
mergeWith _ Nil b = b
mergeWith f a@(Node p1 v1 l1 r1) b@(Node p2 v2 l2 r2) = case compare p1 p2 of
    EQ -> mergeWith f (singleton p1 (v1 `f` v2))
                      (mergeWith f (merge l1 r1) (merge l2 r2))
    LT -> linkWith f a b
    GT -> linkWith f b a

-- | Merging two heaps into one heap, maintainig the heap property
link :: (Ord p) => Heap p v -> Heap p v -> Heap p v
link (Node p v Nil ra) b = Node p v b ra
link (Node p v la ra) b  = Node p v Nil (merge (merge la b) ra)

-- | Merging two heaps into one heap using a combining function for value with
--   the same key, maintainig the heap property    
linkWith :: (Ord p) => (v->v->v) -> (Heap p v) -> (Heap p v) -> (Heap p v)
linkWith f (Node p v Nil ra) b = Node p v b ra
linkWith f (Node p v la ra) b  = Node p v Nil (mergeWith f (mergeWith f la b) ra)

--  | Returns the minimal priority\/value pair and the heap without it
getDelMin :: (Ord p) => (Heap p v) -> ((p,v),Heap p v)
getDelMin Nil =  error "Data.Heap.findDelMin: empty heap"
getDelMin (Node p v l r) = ((p,v),merge l r)

-- | Returns the th minimal priority\/value pair
getMin :: (Ord p) => (Heap p v) -> (p,v)
getMin = fst . getDelMin

-- | Returns the resulting heap after removing the minimal priority\/value pair
delMin :: (Ord p) => (Heap p v) -> Heap p v
delMin = snd . getDelMin

toList :: (Ord p) => (Heap p v) -> [(p,v)]
toList Nil = []
toList (Node p v l r) = (p,v) : (toList $ merge l r)

prios :: (Ord p) => (Heap p v) -> [p]
prios m = [p | (p,_) <- toList m]

elems :: (Ord p) => (Heap p v) -> [v]
elems m = [v | (_,v) <- toList m]

fromList :: (Ord p) => [(p,v)] -> (Heap p v) 
fromList = foldl' (flip $ uncurry insert) empty