module Arithmetic.Utility.Heap
( Heap,
size,
isEmpty,
empty,
add,
remove,
toList )
where
data Node a =
E
| T Int a (Node a) (Node a)
deriving Show
data Heap a =
Heap (a -> a -> Bool) Int (Node a)
singleton :: a -> Node a
singleton a = T 1 a E E
rank :: Node a -> Int
rank E = 0
rank (T r _ _ _) = r
mkT :: a -> Node a -> Node a -> Node a
mkT a x y =
if rx <= ry
then T (rx + 1) a y x
else T (ry + 1) a x y
where
rx = rank x
ry = rank y
merge :: (a -> a -> Bool) -> Node a -> Node a -> Node a
merge le =
mrg
where
mrg n1 n2 =
case n1 of
E -> n2
T _ a1 x1 y1 ->
case n2 of
E -> n1
T _ a2 x2 y2 ->
if le a1 a2
then mkT a1 x1 (mrg y1 n2)
else mkT a2 x2 (mrg n1 y2)
size :: Heap a -> Int
size (Heap _ k _) = k
isEmpty :: Heap a -> Bool
isEmpty h = size h == 0
empty :: (a -> a -> Bool) -> Heap a
empty le = Heap le 0 E
add :: a -> Heap a -> Heap a
add a (Heap le k n) = Heap le (k + 1) (merge le (singleton a) n)
remove :: Heap a -> Maybe (a, Heap a)
remove (Heap le k n) =
case n of
E -> Nothing
T _ a x y -> Just (a, Heap le (k - 1) (merge le x y))
toList :: Heap a -> [a]
toList h =
case remove h of
Nothing -> []
Just (a,h') -> a : toList h'
instance Show a => Show (Heap a) where
show = show . toList