{-# LANGUAGE CPP #-}
#ifdef __GLASGOW_HASKELL__
{-# LANGUAGE TypeFamilies #-}
#endif

module Data.Heap.Internal
    ( Heap(..)
    , Tree(..)
    -- * Construction
    , empty, singleton
    -- ** From Lists
    , fromList
    -- * Insertion/Union
    , insert
    , union, unions
    -- * Traversal/Filter
    , map, mapMonotonic
    , filter
    , partition
    -- * Ordered Folds
    , foldMapOrd
    , foldlOrd, foldrOrd
    , foldlOrd', foldrOrd'
    -- * Query
    , size
    , member, notMember
    -- * Min
    , lookupMin
    , findMin
    , deleteMin
    , deleteFindMin
    , minView
    -- * Subranges
    , take
    , drop
    , splitAt
    , takeWhile
    , dropWhile
    , span
    , break
    , nub
    -- * Conversion
    -- ** To Lists
    , toAscList, toDescList
    -- * Heapsort
    , 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
#ifdef __GLASGOW_HASKELL__
import GHC.Exts (IsList)
import qualified GHC.Exts as Exts
#endif
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

-- | A skew binomial heap.
data Heap a
    = Empty
    | Heap
        {-# UNPACK #-} !Int  -- size
        !a  -- root
        !(Forest a)  -- forest

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
#ifdef __GLASGOW_HASKELL__
    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)
#else
    readsPrec = readsData $ readsUnaryWith readList "fromList" fromList
#endif

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

#ifdef __GLASGOW_HASKELL__
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
#endif

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


-- | /O(1)/. The empty heap.
--
-- > empty = fromList []
empty :: Heap a
empty :: Heap a
empty = Heap a
forall a. Heap a
Empty

-- | /O(1)/. A heap with a single element.
--
-- > singleton x = fromList [x]
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

-- | /O(n)/. Create a heap from a list.
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

-- | /O(1)/. Insert a new value into the heap.
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)

-- | /O(log n)/. The union of two heaps.
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))

-- | The union of a foldable of heaps.
--
-- > unions = foldl union empty
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

-- | /O(n)/. Map a function over the heap.
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

-- | /O(n)/, Map an increasing function over the heap. The precondition is not checked.
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)

-- | /O(n)/. Filter all elements that satisfy the predicate.
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

-- | /O(n)/. Partition the heap into two heaps, one with all elements that satisfy the predicate
-- and one with all elements that don't satisfy the predicate.
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)

-- | /O(n * log n)/. Fold the values in the heap in order, using the given monoid.
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

-- | /O(n * log n)/. Fold the values in the heap in order, using the given right-associative function.
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 #-}

-- | /O(n * log n)/. Fold the values in the heap in order, using the given left-associative function.
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 #-}

-- | /O(n * log n)/. A strict version of 'foldrOrd'.
-- Each application of the function is evaluated before using the result in the next application.
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' #-}

-- | /O(n)/. A strict version of 'foldlOrd'.
-- Each application of the function is evaluated before using the result in the next application.
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' #-}

-- | /O(1)/. The number of elements in the heap.
size :: Heap a -> Int
size :: Heap a -> Int
size Heap a
Empty = Int
0
size (Heap Int
s a
_ Forest a
_) = Int
s

-- | /O(n)/. Is the value a member of the heap?
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)

-- | /O(n)/. Is the value not a member of the heap?
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

-- | /O(log n)/. The minimal element in the heap. Calls 'error' if the heap is empty.
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)

-- | /O(log n)/. The minimal element in the heap or 'Nothing' if the heap is empty.
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

-- | /O(log n)/. Delete the minimal element. Returns the empty heap if the heap is empty.
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

-- | /O(log n)/. Delete and find the minimal element. Calls 'error' if the heap is empty.
--
-- > deleteFindMin heap = (findMin heap, deleteMin heap)
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)

-- | /O(log n)/. Retrieves the minimal element of the heap and the heap stripped of that element or 'Nothing' if the heap is empty.
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)

-- | /O(n * log n)/. @take n heap@ takes the @n@ smallest elements of @heap@, in ascending order.
--
-- > take n heap = take n (toAscList heap)
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'

-- | /O(n * log n)/. @drop n heap@ drops the @n@ smallest elements from @heap@.
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)

-- | /O(n * log n)/. @splitAt n heap@ takes and drops the @n@ smallest elements from @heap@.
--
-- > splitAt n heap = (take n heap, drop n heap)
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'')

-- | /O(n * log n)/. @takeWhile p heap@ takes the elements from @heap@ in ascending order, while @p@ holds.
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 #-}

-- | /O(n * log n)/. @dropWhile p heap@ drops the elements from @heap@ in ascending order, while @p@ holds.
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 #-}

-- | /O(n * log n)/. @span p heap@ takes and drops the elements from @heap@, while @p@ holds
--
-- > span p heap = (takeWhile p heap, dropWhile p heap)
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 #-}

-- | /O(n * log n)/. @span@, but with inverted predicate.
--
-- > break p = span (not . p)
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 #-}

-- | /O(n * log n)/. Remove duplicate elements from the heap.
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'))

-- | /O(n * log n)/. Create a descending list from the heap.
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 (:) []

-- | /O(n * log n)/. Create a descending list from the heap.
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 (:)) []

-- | /O(n * log n)/. Sort a list using a heap. The sort is unstable.
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