{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
module Data.Heap(
Heap, empty, singleton, insert, removeMin, union, mapMaybe, size, toList) where
data Heap a = Nil | Node {-# UNPACK #-} !Int a (Heap a) (Heap a) deriving Int -> Heap a -> ShowS
[Heap a] -> ShowS
Heap a -> String
(Int -> Heap a -> ShowS)
-> (Heap a -> String) -> ([Heap a] -> ShowS) -> Show (Heap a)
forall a. Show a => Int -> Heap a -> ShowS
forall a. Show a => [Heap a] -> ShowS
forall a. Show a => Heap a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Heap a] -> ShowS
$cshowList :: forall a. Show a => [Heap a] -> ShowS
show :: Heap a -> String
$cshow :: forall a. Show a => Heap a -> String
showsPrec :: Int -> Heap a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Heap a -> ShowS
Show
{-# INLINEABLE union #-}
union :: forall a. Ord a => Heap a -> Heap a -> Heap a
union :: Heap a -> Heap a -> Heap a
union = Heap a -> Heap a -> Heap a
u
where
u :: Heap a -> Heap a -> Heap a
u :: Heap a -> Heap a -> Heap a
u Heap a
Nil Heap a
h = Heap a
h
u Heap a
h Heap a
Nil = Heap a
h
u h1 :: Heap a
h1@(Node Int
s1 a
x1 Heap a
l1 Heap a
r1) h2 :: Heap a
h2@(Node Int
s2 a
x2 Heap a
l2 Heap a
r2)
| a
x1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
x2 = (Int -> a -> Heap a -> Heap a -> Heap a
forall a. Int -> a -> Heap a -> Heap a -> Heap a
Node (Int
s1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
s2) a
x1 (Heap a -> Heap a -> Heap a) -> Heap a -> Heap a -> Heap a
forall a b. (a -> b) -> a -> b
$! Heap a -> Heap a -> Heap a
u Heap a
r1 Heap a
h2) Heap a
l1
| Bool
otherwise = (Int -> a -> Heap a -> Heap a -> Heap a
forall a. Int -> a -> Heap a -> Heap a -> Heap a
Node (Int
s1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
s2) a
x2 (Heap a -> Heap a -> Heap a) -> Heap a -> Heap a -> Heap a
forall a b. (a -> b) -> a -> b
$! Heap a -> Heap a -> Heap a
u Heap a
r2 Heap a
h1) Heap a
l2
{-# INLINE singleton #-}
singleton :: a -> Heap a
singleton :: a -> Heap a
singleton !a
x = Int -> a -> Heap a -> Heap a -> Heap a
forall a. Int -> a -> Heap a -> Heap a -> Heap a
Node Int
1 a
x Heap a
forall a. Heap a
Nil Heap a
forall a. Heap a
Nil
{-# INLINE empty #-}
empty :: Heap a
empty :: Heap a
empty = Heap a
forall a. Heap a
Nil
{-# INLINEABLE insert #-}
insert :: Ord a => a -> Heap a -> Heap a
insert :: a -> Heap a -> Heap a
insert a
x Heap a
h = Heap a -> Heap a -> Heap a
forall a. Ord a => Heap a -> Heap a -> Heap a
union (a -> Heap a
forall a. a -> Heap a
singleton a
x) Heap a
h
{-# INLINEABLE removeMin #-}
removeMin :: Ord a => Heap a -> Maybe (a, Heap a)
removeMin :: Heap a -> Maybe (a, Heap a)
removeMin Heap a
Nil = Maybe (a, Heap a)
forall a. Maybe a
Nothing
removeMin (Node Int
_ a
x Heap a
l Heap a
r) = (a, Heap a) -> Maybe (a, Heap a)
forall a. a -> Maybe a
Just (a
x, Heap a -> Heap a -> Heap a
forall a. Ord a => Heap a -> Heap a -> Heap a
union Heap a
l Heap a
r)
toList :: Heap a -> [a]
toList :: Heap a -> [a]
toList Heap a
h = Heap a -> [a] -> [a]
forall a. Heap a -> [a] -> [a]
tl Heap a
h []
where
tl :: Heap a -> [a] -> [a]
tl Heap a
Nil = [a] -> [a]
forall a. a -> a
id
tl (Node Int
_ a
x Heap a
l Heap a
r) = (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Heap a -> [a] -> [a]
tl Heap a
l ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Heap a -> [a] -> [a]
tl Heap a
r
{-# INLINEABLE mapMaybe #-}
mapMaybe :: forall a b. Ord b => (a -> Maybe b) -> Heap a -> Heap b
mapMaybe :: (a -> Maybe b) -> Heap a -> Heap b
mapMaybe a -> Maybe b
f Heap a
h = Heap a -> Heap b
mm Heap a
h
where
mm :: Heap a -> Heap b
mm :: Heap a -> Heap b
mm Heap a
Nil = Heap b
forall a. Heap a
Nil
mm (Node Int
_ a
x Heap a
l Heap a
r) =
case a -> Maybe b
f a
x of
Maybe b
Nothing -> Heap b -> Heap b -> Heap b
forall a. Ord a => Heap a -> Heap a -> Heap a
union Heap b
l' Heap b
r'
Just !b
y -> b -> Heap b -> Heap b
forall a. Ord a => a -> Heap a -> Heap a
insert b
y Heap b
l' Heap b -> Heap b -> Heap b
forall a. Ord a => Heap a -> Heap a -> Heap a
`union` Heap b
r'
where
!l' :: Heap b
l' = Heap a -> Heap b
mm Heap a
l
!r' :: Heap b
r' = Heap a -> Heap b
mm Heap a
r
{-# INLINE size #-}
size :: Heap a -> Int
size :: Heap a -> Int
size Heap a
Nil = Int
0
size (Node Int
n a
_ Heap a
_ Heap a
_) = Int
n