{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeFamilies #-}
module Data.Heap.Internal
( Heap(..)
, Tree(..)
, empty, singleton
, fromList
, insert
, union, unions
, map, mapMonotonic
, filter
, partition
, foldMapOrd
, foldlOrd, foldrOrd
, foldlOrd', foldrOrd'
, size
, member, notMember
, lookupMin
, findMin
, deleteMin
, deleteFindMin
, minView
, take
, drop
, splitAt
, takeWhile
, dropWhile
, span
, break
, nub
, toAscList, toDescList
, heapsort
) where
import Control.Exception (assert)
import Data.Foldable (foldl', toList)
import Data.Functor.Classes
import Data.Maybe (fromMaybe)
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup (Semigroup((<>)))
#endif
import GHC.Exts (IsList)
import qualified GHC.Exts as Exts
import Prelude hiding (break, drop, dropWhile, filter, map, reverse, span, splitAt, take, takeWhile)
import Text.Read (Lexeme(Ident), lexP, parens, prec, readPrec)
import Control.DeepSeq (NFData(..))
import Util.Internal.StrictList
data Heap a
= Empty
| Heap
{-# UNPACK #-} !Int
!a
!(Forest a)
type Forest a = List (Tree a)
data Tree a = Node
{ Tree a -> Int
_rank :: {-# UNPACK #-} !Int
, Tree a -> a
_root :: !a
, Tree a -> List a
_elements :: !(List a)
, Tree a -> Forest a
_children :: !(Forest a)
}
instance NFData a => NFData (Tree a) where
rnf :: Tree a -> ()
rnf (Node Int
_ a
x List a
xs Forest a
c) = a -> ()
forall a. NFData a => a -> ()
rnf a
x () -> () -> ()
`seq` List a -> ()
forall a. NFData a => a -> ()
rnf List a
xs () -> () -> ()
`seq` Forest a -> ()
forall a. NFData a => a -> ()
rnf Forest a
c
errorEmpty :: String -> a
errorEmpty :: String -> a
errorEmpty String
s = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Heap." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": empty heap"
link :: Ord a => Tree a -> Tree a -> Tree a
link :: Tree a -> Tree a -> Tree a
link t1 :: Tree a
t1@(Node Int
r1 a
x1 List a
xs1 Forest a
c1) t2 :: Tree a
t2@(Node Int
r2 a
x2 List a
xs2 Forest a
c2) = Bool -> Tree a -> Tree a
forall a. HasCallStack => Bool -> a -> a
assert (Int
r1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
r2) (Tree a -> Tree a) -> Tree a -> Tree a
forall a b. (a -> b) -> a -> b
$
if a
x1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
x2
then Int -> a -> List a -> Forest a -> Tree a
forall a. Int -> a -> List a -> Forest a -> Tree a
Node (Int
r1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
x1 List a
xs1 (Tree a
t2 Tree a -> Forest a -> Forest a
forall a. a -> List a -> List a
`Cons` Forest a
c1)
else Int -> a -> List a -> Forest a -> Tree a
forall a. Int -> a -> List a -> Forest a -> Tree a
Node (Int
r2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
x2 List a
xs2 (Tree a
t1 Tree a -> Forest a -> Forest a
forall a. a -> List a -> List a
`Cons` Forest a
c2)
skewLink :: Ord a => a -> Tree a -> Tree a -> Tree a
skewLink :: a -> Tree a -> Tree a -> Tree a
skewLink a
x Tree a
t1 Tree a
t2 = let Node Int
r a
y List a
ys Forest a
c = Tree a -> Tree a -> Tree a
forall a. Ord a => Tree a -> Tree a -> Tree a
link Tree a
t1 Tree a
t2
in if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y
then Int -> a -> List a -> Forest a -> Tree a
forall a. Int -> a -> List a -> Forest a -> Tree a
Node Int
r a
x (a
y a -> List a -> List a
forall a. a -> List a -> List a
`Cons` List a
ys) Forest a
c
else Int -> a -> List a -> Forest a -> Tree a
forall a. Int -> a -> List a -> Forest a -> Tree a
Node Int
r a
y (a
x a -> List a -> List a
forall a. a -> List a -> List a
`Cons` List a
ys) Forest a
c
insTree :: Ord a => Tree a -> Forest a -> Forest a
insTree :: Tree a -> Forest a -> Forest a
insTree Tree a
t Forest a
Nil = Tree a
t Tree a -> Forest a -> Forest a
forall a. a -> List a -> List a
`Cons` Forest a
forall a. List a
Nil
insTree Tree a
t1 f :: Forest a
f@(Tree a
t2 `Cons` Forest a
ts)
| Tree a -> Int
forall a. Tree a -> Int
_rank Tree a
t1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Tree a -> Int
forall a. Tree a -> Int
_rank Tree a
t2 = Tree a
t1 Tree a -> Forest a -> Forest a
forall a. a -> List a -> List a
`Cons` Forest a
f
| Bool
otherwise = Tree a -> Forest a -> Forest a
forall a. Ord a => Tree a -> Forest a -> Forest a
insTree (Tree a -> Tree a -> Tree a
forall a. Ord a => Tree a -> Tree a -> Tree a
link Tree a
t1 Tree a
t2) Forest a
ts
mergeTrees :: Ord a => Forest a -> Forest a -> Forest a
mergeTrees :: Forest a -> Forest a -> Forest a
mergeTrees Forest a
f Forest a
Nil = Forest a
f
mergeTrees Forest a
Nil Forest a
f = Forest a
f
mergeTrees f1 :: Forest a
f1@(Tree a
t1 `Cons` Forest a
ts1) f2 :: Forest a
f2@(Tree a
t2 `Cons` Forest a
ts2) = case Tree a -> Int
forall a. Tree a -> Int
_rank Tree a
t1 Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Tree a -> Int
forall a. Tree a -> Int
_rank Tree a
t2 of
Ordering
LT -> Tree a
t1 Tree a -> Forest a -> Forest a
forall a. a -> List a -> List a
`Cons` Forest a -> Forest a -> Forest a
forall a. Ord a => Forest a -> Forest a -> Forest a
mergeTrees Forest a
ts1 Forest a
f2
Ordering
GT -> Tree a
t2 Tree a -> Forest a -> Forest a
forall a. a -> List a -> List a
`Cons` Forest a -> Forest a -> Forest a
forall a. Ord a => Forest a -> Forest a -> Forest a
mergeTrees Forest a
f1 Forest a
ts2
Ordering
EQ -> Tree a -> Forest a -> Forest a
forall a. Ord a => Tree a -> Forest a -> Forest a
insTree (Tree a -> Tree a -> Tree a
forall a. Ord a => Tree a -> Tree a -> Tree a
link Tree a
t1 Tree a
t2) (Forest a -> Forest a -> Forest a
forall a. Ord a => Forest a -> Forest a -> Forest a
mergeTrees Forest a
ts1 Forest a
ts2)
merge :: Ord a => Forest a -> Forest a -> Forest a
merge :: Forest a -> Forest a -> Forest a
merge Forest a
f1 Forest a
f2 = Forest a -> Forest a -> Forest a
forall a. Ord a => Forest a -> Forest a -> Forest a
mergeTrees (Forest a -> Forest a
forall a. Ord a => Forest a -> Forest a
normalize Forest a
f1) (Forest a -> Forest a
forall a. Ord a => Forest a -> Forest a
normalize Forest a
f2)
{-# INLINE merge #-}
normalize :: Ord a => Forest a -> Forest a
normalize :: Forest a -> Forest a
normalize Forest a
Nil = Forest a
forall a. List a
Nil
normalize (Tree a
t `Cons` Forest a
ts) = Tree a -> Forest a -> Forest a
forall a. Ord a => Tree a -> Forest a -> Forest a
insTree Tree a
t Forest a
ts
{-# INLiNE normalize #-}
ins :: Ord a => a -> Forest a -> Forest a
ins :: a -> Forest a -> Forest a
ins a
x (Tree a
t1 `Cons` Tree a
t2 `Cons` Forest a
ts)
| Tree a -> Int
forall a. Tree a -> Int
_rank Tree a
t1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Tree a -> Int
forall a. Tree a -> Int
_rank Tree a
t2 = a
x a -> Forest a -> Forest a
`seq` a -> Tree a -> Tree a -> Tree a
forall a. Ord a => a -> Tree a -> Tree a -> Tree a
skewLink a
x Tree a
t1 Tree a
t2 Tree a -> Forest a -> Forest a
forall a. a -> List a -> List a
`Cons` Forest a
ts
ins a
x Forest a
ts = a
x a -> Forest a -> Forest a
`seq` Int -> a -> List a -> Forest a -> Tree a
forall a. Int -> a -> List a -> Forest a -> Tree a
Node Int
0 a
x List a
forall a. List a
Nil Forest a
forall a. List a
Nil Tree a -> Forest a -> Forest a
forall a. a -> List a -> List a
`Cons` Forest a
ts
fromForest :: Ord a => Int -> Forest a -> Heap a
fromForest :: Int -> Forest a -> Heap a
fromForest Int
_ Forest a
Nil = Heap a
forall a. Heap a
Empty
fromForest Int
s f :: Forest a
f@(Tree a
_ `Cons` Forest a
_) =
let (Node Int
_ a
x List a
xs Forest a
ts1, Forest a
ts2) = Forest a -> (Tree a, Forest a)
forall a. Ord a => Forest a -> (Tree a, Forest a)
removeMinTree Forest a
f
in Int -> a -> Forest a -> Heap a
forall a. Int -> a -> Forest a -> Heap a
Heap Int
s a
x ((Forest a -> a -> Forest a) -> Forest a -> List a -> Forest a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((a -> Forest a -> Forest a) -> Forest a -> a -> Forest a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Forest a -> Forest a
forall a. Ord a => a -> Forest a -> Forest a
ins) (Forest a -> Forest a -> Forest a
forall a. Ord a => Forest a -> Forest a -> Forest a
merge (Forest a -> Forest a
forall a. List a -> List a
reverse Forest a
ts1) Forest a
ts2) List a
xs)
removeMinTree :: Ord a => Forest a -> (Tree a, Forest a)
removeMinTree :: Forest a -> (Tree a, Forest a)
removeMinTree Forest a
Nil = String -> (Tree a, Forest a)
forall a. HasCallStack => String -> a
error String
"removeMinTree: empty heap"
removeMinTree (Tree a
t `Cons` Forest a
Nil) = (Tree a
t, Forest a
forall a. List a
Nil)
removeMinTree (Tree a
t `Cons` Forest a
ts) =
let (Tree a
t', Forest a
ts') = Forest a -> (Tree a, Forest a)
forall a. Ord a => Forest a -> (Tree a, Forest a)
removeMinTree Forest a
ts
in if Tree a -> a
forall a. Tree a -> a
_root Tree a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= Tree a -> a
forall a. Tree a -> a
_root Tree a
t'
then (Tree a
t, Forest a
ts)
else (Tree a
t', Tree a
t Tree a -> Forest a -> Forest a
forall a. a -> List a -> List a
`Cons` Forest a
ts')
instance Show1 Heap where
liftShowsPrec :: (Int -> a -> String -> String)
-> ([a] -> String -> String) -> Int -> Heap a -> String -> String
liftShowsPrec Int -> a -> String -> String
sp [a] -> String -> String
sl Int
p Heap a
heap = (Int -> [a] -> String -> String)
-> String -> Int -> [a] -> String -> String
forall a.
(Int -> a -> String -> String)
-> String -> Int -> a -> String -> String
showsUnaryWith ((Int -> a -> String -> String)
-> ([a] -> String -> String) -> Int -> [a] -> String -> String
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> String -> String)
-> ([a] -> String -> String) -> Int -> f a -> String -> String
liftShowsPrec Int -> a -> String -> String
sp [a] -> String -> String
sl) String
"fromList" Int
p (Heap a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Heap a
heap)
instance Show a => Show (Heap a) where
showsPrec :: Int -> Heap a -> String -> String
showsPrec = Int -> Heap a -> String -> String
forall (f :: * -> *) a.
(Show1 f, Show a) =>
Int -> f a -> String -> String
showsPrec1
instance (Ord a, Read a) => Read (Heap a) where
readPrec :: ReadPrec (Heap a)
readPrec = ReadPrec (Heap a) -> ReadPrec (Heap a)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (Heap a) -> ReadPrec (Heap a))
-> ReadPrec (Heap a) -> ReadPrec (Heap a)
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec (Heap a) -> ReadPrec (Heap a)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 (ReadPrec (Heap a) -> ReadPrec (Heap a))
-> ReadPrec (Heap a) -> ReadPrec (Heap a)
forall a b. (a -> b) -> a -> b
$ do
Ident String
"fromList" <- ReadPrec Lexeme
lexP
[a]
xs <- ReadPrec [a]
forall a. Read a => ReadPrec a
readPrec
Heap a -> ReadPrec (Heap a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> Heap a
forall a. Ord a => [a] -> Heap a
fromList [a]
xs)
instance Ord a => Eq (Heap a) where
Heap a
heap1 == :: Heap a -> Heap a -> Bool
== Heap a
heap2 = Heap a -> Int
forall a. Heap a -> Int
size Heap a
heap1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Heap a -> Int
forall a. Heap a -> Int
size Heap a
heap2 Bool -> Bool -> Bool
&& Heap a -> [a]
forall a. Ord a => Heap a -> [a]
toAscList Heap a
heap1 [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== Heap a -> [a]
forall a. Ord a => Heap a -> [a]
toAscList Heap a
heap2
instance Ord a => Ord (Heap a) where
compare :: Heap a -> Heap a -> Ordering
compare Heap a
heap1 Heap a
heap2 = [a] -> [a] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Heap a -> [a]
forall a. Ord a => Heap a -> [a]
toAscList Heap a
heap1) (Heap a -> [a]
forall a. Ord a => Heap a -> [a]
toAscList Heap a
heap2)
instance Ord a => Semigroup (Heap a) where
<> :: Heap a -> Heap a -> Heap a
(<>) = Heap a -> Heap a -> Heap a
forall a. Ord a => Heap a -> Heap a -> Heap a
union
instance Ord a => Monoid (Heap a) where
mempty :: Heap a
mempty = Heap a
forall a. Heap a
empty
mappend :: Heap a -> Heap a -> Heap a
mappend = Heap a -> Heap a -> Heap a
forall a. Semigroup a => a -> a -> a
(<>)
instance Foldable Heap where
foldr :: (a -> b -> b) -> b -> Heap a -> b
foldr a -> b -> b
f b
acc = Heap a -> b
go
where
go :: Heap a -> b
go Heap a
Empty = b
acc
go (Heap Int
_ a
x Forest a
forest) = a -> b -> b
f a
x ((Tree a -> b -> b) -> b -> Forest a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Tree a -> b -> b
foldTree b
acc Forest a
forest)
foldTree :: Tree a -> b -> b
foldTree (Node Int
_ a
x List a
xs Forest a
c) b
acc = a -> b -> b
f a
x ((a -> b -> b) -> b -> List a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f ((Tree a -> b -> b) -> b -> Forest a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Tree a -> b -> b
foldTree b
acc Forest a
c) List a
xs)
{-# INLINE foldr #-}
foldl :: (b -> a -> b) -> b -> Heap a -> b
foldl b -> a -> b
f b
acc = Heap a -> b
go
where
go :: Heap a -> b
go Heap a
Empty = b
acc
go (Heap Int
_ a
x Forest a
forest) = (b -> Tree a -> b) -> b -> Forest a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> Tree a -> b
foldTree (b -> a -> b
f b
acc a
x) Forest a
forest
foldTree :: b -> Tree a -> b
foldTree b
acc (Node Int
_ a
x List a
xs Forest a
c) = (b -> Tree a -> b) -> b -> Forest a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> Tree a -> b
foldTree ((b -> a -> b) -> b -> List a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> a -> b
f (b -> a -> b
f b
acc a
x) List a
xs) Forest a
c
{-# INLINE foldl #-}
null :: Heap a -> Bool
null Heap a
Empty = Bool
True
null Heap{} = Bool
False
length :: Heap a -> Int
length = Heap a -> Int
forall a. Heap a -> Int
size
minimum :: Heap a -> a
minimum = Heap a -> a
forall a. Heap a -> a
findMin
instance Ord a => IsList (Heap a) where
type Item (Heap a) = a
fromList :: [Item (Heap a)] -> Heap a
fromList = [Item (Heap a)] -> Heap a
forall a. Ord a => [a] -> Heap a
fromList
toList :: Heap a -> [Item (Heap a)]
toList = Heap a -> [Item (Heap a)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
instance NFData a => NFData (Heap a) where
rnf :: Heap a -> ()
rnf Heap a
Empty = ()
rnf (Heap Int
_ a
x Forest a
forest) = a -> ()
forall a. NFData a => a -> ()
rnf a
x () -> () -> ()
`seq` Forest a -> ()
forall a. NFData a => a -> ()
rnf Forest a
forest
empty :: Heap a
empty :: Heap a
empty = Heap a
forall a. Heap a
Empty
singleton :: a -> Heap a
singleton :: a -> Heap a
singleton a
x = Int -> a -> Forest a -> Heap a
forall a. Int -> a -> Forest a -> Heap a
Heap Int
1 a
x Forest a
forall a. List a
Nil
fromList :: Ord a => [a] -> Heap a
fromList :: [a] -> Heap a
fromList = (Heap a -> a -> Heap a) -> Heap a -> [a] -> Heap a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((a -> Heap a -> Heap a) -> Heap a -> a -> Heap a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Heap a -> Heap a
forall a. Ord a => a -> Heap a -> Heap a
insert) Heap a
forall a. Heap a
empty
insert :: Ord a => a -> Heap a -> Heap a
insert :: a -> Heap a -> Heap a
insert a
x Heap a
Empty = a -> Heap a
forall a. a -> Heap a
singleton a
x
insert a
x (Heap Int
s a
y Forest a
f)
| a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y = Int -> a -> Forest a -> Heap a
forall a. Int -> a -> Forest a -> Heap a
Heap (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
x (a -> Forest a -> Forest a
forall a. Ord a => a -> Forest a -> Forest a
ins a
y Forest a
f)
| Bool
otherwise = Int -> a -> Forest a -> Heap a
forall a. Int -> a -> Forest a -> Heap a
Heap (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
y (a -> Forest a -> Forest a
forall a. Ord a => a -> Forest a -> Forest a
ins a
x Forest a
f)
union :: Ord a => Heap a -> Heap a -> Heap a
union :: Heap a -> Heap a -> Heap a
union Heap a
heap Heap a
Empty = Heap a
heap
union Heap a
Empty Heap a
heap = Heap a
heap
union (Heap Int
s1 a
x1 Forest a
f1) (Heap Int
s2 a
x2 Forest a
f2)
| a
x1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
x2 = Int -> a -> Forest a -> Heap a
forall a. Int -> a -> Forest a -> Heap a
Heap (Int
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s2) a
x1 (a -> Forest a -> Forest a
forall a. Ord a => a -> Forest a -> Forest a
ins a
x2 (Forest a -> Forest a -> Forest a
forall a. Ord a => Forest a -> Forest a -> Forest a
merge Forest a
f1 Forest a
f2))
| Bool
otherwise = Int -> a -> Forest a -> Heap a
forall a. Int -> a -> Forest a -> Heap a
Heap (Int
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s2) a
x2 (a -> Forest a -> Forest a
forall a. Ord a => a -> Forest a -> Forest a
ins a
x1 (Forest a -> Forest a -> Forest a
forall a. Ord a => Forest a -> Forest a -> Forest a
merge Forest a
f1 Forest a
f2))
unions :: (Foldable f, Ord a) => f (Heap a) -> Heap a
unions :: f (Heap a) -> Heap a
unions = (Heap a -> Heap a -> Heap a) -> Heap a -> f (Heap a) -> Heap a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Heap a -> Heap a -> Heap a
forall a. Ord a => Heap a -> Heap a -> Heap a
union Heap a
forall a. Heap a
empty
map :: Ord b => (a -> b) -> Heap a -> Heap b
map :: (a -> b) -> Heap a -> Heap b
map a -> b
f = [b] -> Heap b
forall a. Ord a => [a] -> Heap a
fromList ([b] -> Heap b) -> (Heap a -> [b]) -> Heap a -> Heap b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f ([a] -> [b]) -> (Heap a -> [a]) -> Heap a -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Heap a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
mapMonotonic :: (a -> b) -> Heap a -> Heap b
mapMonotonic :: (a -> b) -> Heap a -> Heap b
mapMonotonic a -> b
_ Heap a
Empty = Heap b
forall a. Heap a
Empty
mapMonotonic a -> b
f (Heap Int
s a
x Forest a
forest) = Int -> b -> Forest b -> Heap b
forall a. Int -> a -> Forest a -> Heap a
Heap Int
s (a -> b
f a
x) ((Tree a -> Tree b) -> Forest a -> Forest b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tree a -> Tree b
mapTree Forest a
forest)
where
mapTree :: Tree a -> Tree b
mapTree (Node Int
r a
x List a
xs Forest a
c) = Int -> b -> List b -> Forest b -> Tree b
forall a. Int -> a -> List a -> Forest a -> Tree a
Node Int
r (a -> b
f a
x) ((a -> b) -> List a -> List b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f List a
xs) ((Tree a -> Tree b) -> Forest a -> Forest b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tree a -> Tree b
mapTree Forest a
c)
filter :: Ord a => (a -> Bool) -> Heap a -> Heap a
filter :: (a -> Bool) -> Heap a -> Heap a
filter a -> Bool
f = (Heap a -> a -> Heap a) -> Heap a -> Heap a -> Heap a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Heap a
acc a
x -> if a -> Bool
f a
x then a -> Heap a -> Heap a
forall a. Ord a => a -> Heap a -> Heap a
insert a
x Heap a
acc else Heap a
acc) Heap a
forall a. Heap a
empty
partition :: Ord a => (a -> Bool) -> Heap a -> (Heap a, Heap a)
partition :: (a -> Bool) -> Heap a -> (Heap a, Heap a)
partition a -> Bool
f = ((Heap a, Heap a) -> a -> (Heap a, Heap a))
-> (Heap a, Heap a) -> Heap a -> (Heap a, Heap a)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\(Heap a
h1, Heap a
h2) a
x -> if a -> Bool
f a
x then (a -> Heap a -> Heap a
forall a. Ord a => a -> Heap a -> Heap a
insert a
x Heap a
h1, Heap a
h2) else (Heap a
h1, a -> Heap a -> Heap a
forall a. Ord a => a -> Heap a -> Heap a
insert a
x Heap a
h2)) (Heap a
forall a. Heap a
empty, Heap a
forall a. Heap a
empty)
foldMapOrd :: (Ord a, Monoid m) => (a -> m) -> Heap a -> m
foldMapOrd :: (a -> m) -> Heap a -> m
foldMapOrd a -> m
f = (a -> m -> m) -> m -> Heap a -> m
forall a b. Ord a => (a -> b -> b) -> b -> Heap a -> b
foldrOrd (m -> m -> m
forall a. Monoid a => a -> a -> a
mappend (m -> m -> m) -> (a -> m) -> a -> m -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m
f) m
forall a. Monoid a => a
mempty
foldrOrd :: Ord a => (a -> b -> b) -> b -> Heap a -> b
foldrOrd :: (a -> b -> b) -> b -> Heap a -> b
foldrOrd a -> b -> b
f b
acc = Heap a -> b
go
where
go :: Heap a -> b
go Heap a
h = case Heap a -> Maybe (a, Heap a)
forall a. Ord a => Heap a -> Maybe (a, Heap a)
minView Heap a
h of
Maybe (a, Heap a)
Nothing -> b
acc
Just (a
x, Heap a
h') -> a -> b -> b
f a
x (Heap a -> b
go Heap a
h')
{-# INLINE foldrOrd #-}
foldlOrd :: Ord a => (b -> a -> b) -> b -> Heap a -> b
foldlOrd :: (b -> a -> b) -> b -> Heap a -> b
foldlOrd b -> a -> b
f = b -> Heap a -> b
go
where
go :: b -> Heap a -> b
go b
acc Heap a
h = case Heap a -> Maybe (a, Heap a)
forall a. Ord a => Heap a -> Maybe (a, Heap a)
minView Heap a
h of
Maybe (a, Heap a)
Nothing -> b
acc
Just (a
x, Heap a
h') -> b -> Heap a -> b
go (b -> a -> b
f b
acc a
x) Heap a
h'
{-# INLINE foldlOrd #-}
foldrOrd' :: Ord a => (a -> b -> b) -> b -> Heap a -> b
foldrOrd' :: (a -> b -> b) -> b -> Heap a -> b
foldrOrd' a -> b -> b
f b
acc Heap a
h = ((b -> b) -> a -> b -> b) -> (b -> b) -> Heap a -> b -> b
forall a b. Ord a => (b -> a -> b) -> b -> Heap a -> b
foldlOrd (b -> b) -> a -> b -> b
f' b -> b
forall a. a -> a
id Heap a
h b
acc
where
f' :: (b -> b) -> a -> b -> b
f' b -> b
k a
x b
z = b -> b
k (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
x b
z
{-# INLINE foldrOrd' #-}
foldlOrd' :: Ord a => (b -> a -> b) -> b -> Heap a -> b
foldlOrd' :: (b -> a -> b) -> b -> Heap a -> b
foldlOrd' b -> a -> b
f b
acc Heap a
h = (a -> (b -> b) -> b -> b) -> (b -> b) -> Heap a -> b -> b
forall a b. Ord a => (a -> b -> b) -> b -> Heap a -> b
foldrOrd a -> (b -> b) -> b -> b
f' b -> b
forall a. a -> a
id Heap a
h b
acc
where
f' :: a -> (b -> b) -> b -> b
f' a
x b -> b
k b
z = b -> b
k (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! b -> a -> b
f b
z a
x
{-# INLINE foldlOrd' #-}
size :: Heap a -> Int
size :: Heap a -> Int
size Heap a
Empty = Int
0
size (Heap Int
s a
_ Forest a
_) = Int
s
member :: Ord a => a -> Heap a -> Bool
member :: a -> Heap a -> Bool
member a
_ Heap a
Empty = Bool
False
member a
x (Heap Int
_ a
y Forest a
forest) = a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y Bool -> Bool -> Bool
&& (Tree a -> Bool) -> Forest a -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (a
x a -> Tree a -> Bool
forall t. Ord t => t -> Tree t -> Bool
`elemTree`) Forest a
forest
where
t
x elemTree :: t -> Tree t -> Bool
`elemTree` (Node Int
_ t
y List t
ys Forest t
c) = t
x t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
y Bool -> Bool -> Bool
&& (t
x t -> List t -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` List t
ys Bool -> Bool -> Bool
|| (Tree t -> Bool) -> Forest t -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (t
x t -> Tree t -> Bool
`elemTree`) Forest t
c)
notMember :: Ord a => a -> Heap a -> Bool
notMember :: a -> Heap a -> Bool
notMember a
x = Bool -> Bool
not (Bool -> Bool) -> (Heap a -> Bool) -> Heap a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Heap a -> Bool
forall a. Ord a => a -> Heap a -> Bool
member a
x
findMin :: Heap a -> a
findMin :: Heap a -> a
findMin Heap a
heap = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (String -> a
forall a. String -> a
errorEmpty String
"findMin") (Heap a -> Maybe a
forall a. Heap a -> Maybe a
lookupMin Heap a
heap)
lookupMin :: Heap a -> Maybe a
lookupMin :: Heap a -> Maybe a
lookupMin Heap a
Empty = Maybe a
forall a. Maybe a
Nothing
lookupMin (Heap Int
_ a
x Forest a
_) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$! a
x
deleteMin :: Ord a => Heap a -> Heap a
deleteMin :: Heap a -> Heap a
deleteMin Heap a
Empty = Heap a
forall a. Heap a
Empty
deleteMin (Heap Int
s a
_ Forest a
f) = Int -> Forest a -> Heap a
forall a. Ord a => Int -> Forest a -> Heap a
fromForest (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Forest a
f
deleteFindMin :: Ord a => Heap a -> (a, Heap a)
deleteFindMin :: Heap a -> (a, Heap a)
deleteFindMin Heap a
heap = (a, Heap a) -> Maybe (a, Heap a) -> (a, Heap a)
forall a. a -> Maybe a -> a
fromMaybe (String -> (a, Heap a)
forall a. String -> a
errorEmpty String
"deleteFindMin") (Heap a -> Maybe (a, Heap a)
forall a. Ord a => Heap a -> Maybe (a, Heap a)
minView Heap a
heap)
minView :: Ord a => Heap a -> Maybe (a, Heap a)
minView :: Heap a -> Maybe (a, Heap a)
minView Heap a
Empty = Maybe (a, Heap a)
forall a. Maybe a
Nothing
minView (Heap Int
s a
x Forest a
f) = (a, Heap a) -> Maybe (a, Heap a)
forall a. a -> Maybe a
Just (a
x, Int -> Forest a -> Heap a
forall a. Ord a => Int -> Forest a -> Heap a
fromForest (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Forest a
f)
take :: Ord a => Int -> Heap a -> [a]
take :: Int -> Heap a -> [a]
take Int
n Heap a
h
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = []
| Bool
otherwise = case Heap a -> Maybe (a, Heap a)
forall a. Ord a => Heap a -> Maybe (a, Heap a)
minView Heap a
h of
Maybe (a, Heap a)
Nothing -> []
Just (a
x, Heap a
h') -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Int -> Heap a -> [a]
forall a. Ord a => Int -> Heap a -> [a]
take (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Heap a
h'
drop :: Ord a => Int -> Heap a -> Heap a
drop :: Int -> Heap a -> Heap a
drop Int
n Heap a
h
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Heap a
h
| Bool
otherwise = Int -> Heap a -> Heap a
forall a. Ord a => Int -> Heap a -> Heap a
drop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Heap a -> Heap a
forall a. Ord a => Heap a -> Heap a
deleteMin Heap a
h)
splitAt :: Ord a => Int -> Heap a -> ([a], Heap a)
splitAt :: Int -> Heap a -> ([a], Heap a)
splitAt Int
n Heap a
h
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = ([], Heap a
h)
| Bool
otherwise = case Heap a -> Maybe (a, Heap a)
forall a. Ord a => Heap a -> Maybe (a, Heap a)
minView Heap a
h of
Maybe (a, Heap a)
Nothing -> ([], Heap a
h)
Just (a
x, Heap a
h') -> let ([a]
xs, Heap a
h'') = Int -> Heap a -> ([a], Heap a)
forall a. Ord a => Int -> Heap a -> ([a], Heap a)
splitAt (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Heap a
h' in (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs, Heap a
h'')
takeWhile :: Ord a => (a -> Bool) -> Heap a -> [a]
takeWhile :: (a -> Bool) -> Heap a -> [a]
takeWhile a -> Bool
p = Heap a -> [a]
go
where
go :: Heap a -> [a]
go Heap a
h = case Heap a -> Maybe (a, Heap a)
forall a. Ord a => Heap a -> Maybe (a, Heap a)
minView Heap a
h of
Maybe (a, Heap a)
Nothing -> []
Just (a
x, Heap a
h') -> if a -> Bool
p a
x then a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Heap a -> [a]
go Heap a
h' else []
{-# INLINE takeWhile #-}
dropWhile :: Ord a => (a -> Bool) -> Heap a -> Heap a
dropWhile :: (a -> Bool) -> Heap a -> Heap a
dropWhile a -> Bool
p = Heap a -> Heap a
go
where
go :: Heap a -> Heap a
go Heap a
h = case Heap a -> Maybe (a, Heap a)
forall a. Ord a => Heap a -> Maybe (a, Heap a)
minView Heap a
h of
Maybe (a, Heap a)
Nothing -> Heap a
h
Just (a
x, Heap a
h') -> if a -> Bool
p a
x then Heap a -> Heap a
go Heap a
h' else Heap a
h
{-# INLINE dropWhile #-}
span :: Ord a => (a -> Bool) -> Heap a -> ([a], Heap a)
span :: (a -> Bool) -> Heap a -> ([a], Heap a)
span a -> Bool
p = Heap a -> ([a], Heap a)
go
where
go :: Heap a -> ([a], Heap a)
go Heap a
h = case Heap a -> Maybe (a, Heap a)
forall a. Ord a => Heap a -> Maybe (a, Heap a)
minView Heap a
h of
Maybe (a, Heap a)
Nothing -> ([], Heap a
h)
Just (a
x, Heap a
h') -> if a -> Bool
p a
x
then let ([a]
xs, Heap a
h'') = Heap a -> ([a], Heap a)
go Heap a
h' in (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs, Heap a
h'')
else ([], Heap a
h)
{-# INLINE span #-}
break :: Ord a => (a -> Bool) -> Heap a -> ([a], Heap a)
break :: (a -> Bool) -> Heap a -> ([a], Heap a)
break a -> Bool
p = (a -> Bool) -> Heap a -> ([a], Heap a)
forall a. Ord a => (a -> Bool) -> Heap a -> ([a], Heap a)
span (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p)
{-# INLINE break #-}
nub :: Ord a => Heap a -> Heap a
nub :: Heap a -> Heap a
nub Heap a
h = case Heap a -> Maybe (a, Heap a)
forall a. Ord a => Heap a -> Maybe (a, Heap a)
minView Heap a
h of
Maybe (a, Heap a)
Nothing -> Heap a
forall a. Heap a
Empty
Just (a
x, Heap a
h') -> a -> Heap a -> Heap a
forall a. Ord a => a -> Heap a -> Heap a
insert a
x (Heap a -> Heap a
forall a. Ord a => Heap a -> Heap a
nub ((a -> Bool) -> Heap a -> Heap a
forall a. Ord a => (a -> Bool) -> Heap a -> Heap a
dropWhile (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x) Heap a
h'))
toAscList :: Ord a => Heap a -> [a]
toAscList :: Heap a -> [a]
toAscList = (a -> [a] -> [a]) -> [a] -> Heap a -> [a]
forall a b. Ord a => (a -> b -> b) -> b -> Heap a -> b
foldrOrd (:) []
toDescList :: Ord a => Heap a -> [a]
toDescList :: Heap a -> [a]
toDescList = ([a] -> a -> [a]) -> [a] -> Heap a -> [a]
forall a b. Ord a => (b -> a -> b) -> b -> Heap a -> b
foldlOrd ((a -> [a] -> [a]) -> [a] -> a -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) []
heapsort :: Ord a => [a] -> [a]
heapsort :: [a] -> [a]
heapsort = Heap a -> [a]
forall a. Ord a => Heap a -> [a]
toAscList (Heap a -> [a]) -> ([a] -> Heap a) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Heap a
forall a. Ord a => [a] -> Heap a
fromList