{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeFamilies #-}

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
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

-- | 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
    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


-- | /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