-- |
--   Module      :  Data.Edison.Coll.LeftistHeap
--   Copyright   :  Copyright (c) 1998-1999, 2008 Chris Okasaki
--   License     :  MIT; see COPYRIGHT file for terms and conditions
--
--   Maintainer  :  robdockins AT fastmail DOT fm
--   Stability   :  stable
--   Portability :  GHC, Hugs (MPTC and FD)
--
--   Leftist Heaps
--
--   /References:/
--
-- * Chris Okasaki. /Purely Functional Data Structures/. 1998. Section 3.1.

module Data.Edison.Coll.LeftistHeap (
    -- * Type of leftist heaps
    Heap, -- instance of Coll/CollX, OrdColl/OrdCollX

    -- * CollX operations
    empty,singleton,fromSeq,insert,insertSeq,union,unionSeq,delete,deleteAll,
    deleteSeq,null,size,member,count,strict,structuralInvariant,

    -- * Coll operations
    toSeq, lookup, lookupM, lookupAll, lookupWithDefault, fold, fold',
    fold1, fold1', filter, partition, strictWith,

    -- * OrdCollX operations
    deleteMin,deleteMax,unsafeInsertMin,unsafeInsertMax,unsafeFromOrdSeq,
    unsafeAppend,filterLT,filterLE,filterGT,filterGE,partitionLT_GE,
    partitionLE_GT,partitionLT_GT,

    -- * OrdColl operations
    minView,minElem,maxView,maxElem,foldr,foldr',foldl,foldl',
    foldr1,foldr1',foldl1,foldl1',toOrdSeq,
    unsafeMapMonotonic,

    -- * Documentation
    moduleName
) where

import Prelude hiding (null,foldr,foldl,foldr1,foldl1,foldl',lookup,filter)
import qualified Data.Edison.Coll as C ( CollX(..), OrdCollX(..), Coll(..), OrdColl(..),
                                   unionList, toOrdList )
import qualified Data.Edison.Seq as S
import Data.Edison.Coll.Defaults
import Data.Monoid
import Data.Semigroup as SG
import Control.Monad
import qualified Control.Monad.Fail as Fail
import Test.QuickCheck

moduleName :: String
moduleName :: String
moduleName = String
"Data.Edison.Coll.LeftistHeap"

data Heap a = E | L !Int !a !(Heap a) !(Heap a)

-- invariants:
--   * Heap ordered
--   * Leftist; the rank of any left node is >= the
--     rank of its right sibling.  The rank of a node
--     is the length of its right spine.

structuralInvariant :: Ord a => Heap a -> Bool
structuralInvariant :: forall a. Ord a => Heap a -> Bool
structuralInvariant Heap a
E = Bool
True
structuralInvariant t :: Heap a
t@(L Int
i a
x Heap a
_ Heap a
_) =
    Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Heap a -> Int
forall a. Heap a -> Int
rank Heap a
t Bool -> Bool -> Bool
&& a -> Heap a -> Bool
forall {t}. Ord t => t -> Heap t -> Bool
isMin a
x Heap a
t Bool -> Bool -> Bool
&& Heap a -> Bool
forall {a}. Heap a -> Bool
checkLeftist Heap a
t

 where rank :: Heap a -> Int
       rank :: forall a. Heap a -> Int
rank Heap a
E = Int
0
       rank (L Int
_ a
_ Heap a
_ Heap a
s) = (Heap a -> Int
forall a. Heap a -> Int
rank Heap a
s) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

       isMin :: t -> Heap t -> Bool
isMin t
_ Heap t
E = Bool
True
       isMin t
z (L Int
_ t
y Heap t
l Heap t
r) = t
z t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
y Bool -> Bool -> Bool
&& (t -> Heap t -> Bool
isMin t
y Heap t
l) Bool -> Bool -> Bool
&& (t -> Heap t -> Bool
isMin t
y Heap t
r)

       checkLeftist :: Heap a -> Bool
checkLeftist Heap a
E = Bool
True
       checkLeftist (L Int
_ a
_ Heap a
l Heap a
r) =
          Heap a -> Int
forall a. Heap a -> Int
rank Heap a
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Heap a -> Int
forall a. Heap a -> Int
rank Heap a
r Bool -> Bool -> Bool
&& Heap a -> Bool
checkLeftist Heap a
l Bool -> Bool -> Bool
&& Heap a -> Bool
checkLeftist Heap a
r

node :: a -> Heap a -> Heap a -> Heap a
node :: forall a. a -> Heap a -> Heap a -> Heap a
node a
x Heap a
a Heap a
E = Int -> a -> Heap a -> Heap a -> Heap a
forall a. Int -> a -> Heap a -> Heap a -> Heap a
L Int
1 a
x Heap a
a Heap a
forall a. Heap a
E
node a
x Heap a
E Heap a
b = Int -> a -> Heap a -> Heap a -> Heap a
forall a. Int -> a -> Heap a -> Heap a -> Heap a
L Int
1 a
x Heap a
b Heap a
forall a. Heap a
E
node a
x a :: Heap a
a@(L Int
m a
_ Heap a
_ Heap a
_) b :: Heap a
b@(L Int
n a
_ Heap a
_ Heap a
_)
  | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n     = Int -> a -> Heap a -> Heap a -> Heap a
forall a. Int -> a -> Heap a -> Heap a -> Heap a
L (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
x Heap a
b Heap a
a
  | Bool
otherwise  = Int -> a -> Heap a -> Heap a -> Heap a
forall a. Int -> a -> Heap a -> Heap a -> Heap a
L (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
x Heap a
a Heap a
b

{-
Note: when we want to recurse down both sides, and we have a choice,
recursing down the smaller side first will minimize stack usage.

For delete,deleteAll,filter,partition: could compute fringe and reduce
rather that rebuilding with union at every deleted node
-}

empty :: Ord a => Heap a
empty :: forall a. Ord a => Heap a
empty = Heap a
forall a. Heap a
E

singleton :: Ord a => a -> Heap a
singleton :: forall a. Ord a => a -> Heap a
singleton a
x = Int -> a -> Heap a -> Heap a -> Heap a
forall a. Int -> a -> Heap a -> Heap a -> Heap a
L Int
1 a
x Heap a
forall a. Heap a
E Heap a
forall a. Heap a
E

insert :: Ord a => a -> Heap a -> Heap a
insert :: forall a. Ord a => a -> Heap a -> Heap a
insert a
x Heap a
E = Int -> a -> Heap a -> Heap a -> Heap a
forall a. Int -> a -> Heap a -> Heap a -> Heap a
L Int
1 a
x Heap a
forall a. Heap a
E Heap a
forall a. Heap a
E
insert a
x h :: Heap a
h@(L Int
_ a
y Heap a
a Heap a
b)
  | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y    = Int -> a -> Heap a -> Heap a -> Heap a
forall a. Int -> a -> Heap a -> Heap a -> Heap a
L Int
1 a
x Heap a
h Heap a
forall a. Heap a
E
  | Bool
otherwise = a -> Heap a -> Heap a -> Heap a
forall a. a -> Heap a -> Heap a -> Heap a
node a
y Heap a
a (a -> Heap a -> Heap a
forall a. Ord a => a -> Heap a -> Heap a
insert a
x Heap a
b)

union :: Ord a => Heap a -> Heap a -> Heap a
union :: forall a. Ord a => Heap a -> Heap a -> Heap a
union Heap a
E Heap a
h = Heap a
h
union h :: Heap a
h@(L Int
_ a
x Heap a
a Heap a
b) Heap a
h' = Heap a -> a -> Heap a -> Heap a -> Heap a -> Heap a
forall {t}.
Ord t =>
Heap t -> t -> Heap t -> Heap t -> Heap t -> Heap t
union' Heap a
h a
x Heap a
a Heap a
b Heap a
h'
  where union' :: Heap t -> t -> Heap t -> Heap t -> Heap t -> Heap t
union' Heap t
i t
_ Heap t
_ Heap t
_ Heap t
E = Heap t
i
        union' Heap t
hx t
z Heap t
q Heap t
e hy :: Heap t
hy@(L Int
_ t
y Heap t
c Heap t
d)
          | t
z t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
y    = t -> Heap t -> Heap t -> Heap t
forall a. a -> Heap a -> Heap a -> Heap a
node t
z Heap t
q (Heap t -> t -> Heap t -> Heap t -> Heap t -> Heap t
union' Heap t
hy t
y Heap t
c Heap t
d Heap t
e)
          | Bool
otherwise = t -> Heap t -> Heap t -> Heap t
forall a. a -> Heap a -> Heap a -> Heap a
node t
y Heap t
c (Heap t -> t -> Heap t -> Heap t -> Heap t -> Heap t
union' Heap t
hx t
z Heap t
q Heap t
e Heap t
d)

{-
union E h = h
union h E = h
union h1@(L _ x a b) h2@(L _ y c d)
  | x <= y    = node x a (union b h2)
  | otherwise = node y c (union h1 d)
    -- ??? optimize to catch fact that h1 or h2 is known to be L case?
-}

delete :: Ord a => a -> Heap a -> Heap a
delete :: forall a. Ord a => a -> Heap a -> Heap a
delete a
x Heap a
h = case Heap a -> Maybe (Heap a)
del Heap a
h of
               Just Heap a
h' -> Heap a
h'
               Maybe (Heap a)
Nothing -> Heap a
h
  where del :: Heap a -> Maybe (Heap a)
del (L Int
_ a
y Heap a
a Heap a
b) =
          case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
            Ordering
LT -> Maybe (Heap a)
forall a. Maybe a
Nothing
            Ordering
EQ -> Heap a -> Maybe (Heap a)
forall a. a -> Maybe a
Just (Heap a -> Heap a -> Heap a
forall a. Ord a => Heap a -> Heap a -> Heap a
union Heap a
a Heap a
b)
            Ordering
GT -> case Heap a -> Maybe (Heap a)
del Heap a
b of
                    Just Heap a
b' -> Heap a -> Maybe (Heap a)
forall a. a -> Maybe a
Just (a -> Heap a -> Heap a -> Heap a
forall a. a -> Heap a -> Heap a -> Heap a
node a
y Heap a
a Heap a
b')
                    Maybe (Heap a)
Nothing -> case Heap a -> Maybe (Heap a)
del Heap a
a  of
                                 Just Heap a
a' -> Heap a -> Maybe (Heap a)
forall a. a -> Maybe a
Just (a -> Heap a -> Heap a -> Heap a
forall a. a -> Heap a -> Heap a -> Heap a
node a
y Heap a
a' Heap a
b)
                                 Maybe (Heap a)
Nothing -> Maybe (Heap a)
forall a. Maybe a
Nothing
        del Heap a
E = Maybe (Heap a)
forall a. Maybe a
Nothing

deleteAll :: Ord a => a -> Heap a -> Heap a
deleteAll :: forall a. Ord a => a -> Heap a -> Heap a
deleteAll a
x h :: Heap a
h@(L Int
_ a
y Heap a
a Heap a
b) =
  case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
    Ordering
LT -> Heap a
h
    Ordering
EQ -> Heap a -> Heap a -> Heap a
forall a. Ord a => Heap a -> Heap a -> Heap a
union (a -> Heap a -> Heap a
forall a. Ord a => a -> Heap a -> Heap a
deleteAll a
x Heap a
a) (a -> Heap a -> Heap a
forall a. Ord a => a -> Heap a -> Heap a
deleteAll a
x Heap a
b)
    Ordering
GT -> a -> Heap a -> Heap a -> Heap a
forall a. a -> Heap a -> Heap a -> Heap a
node a
y (a -> Heap a -> Heap a
forall a. Ord a => a -> Heap a -> Heap a
deleteAll a
x Heap a
a) (a -> Heap a -> Heap a
forall a. Ord a => a -> Heap a -> Heap a
deleteAll a
x Heap a
b)
deleteAll a
_ Heap a
E = Heap a
forall a. Heap a
E

null :: Ord a => Heap a -> Bool
null :: forall a. Ord a => Heap a -> Bool
null Heap a
E = Bool
True
null Heap a
_ = Bool
False

size :: Ord a => Heap a -> Int
size :: forall a. Ord a => Heap a -> Int
size Heap a
h = Heap a -> Int -> Int
forall {t} {a}. Num t => Heap a -> t -> t
sz Heap a
h Int
0
  where sz :: Heap a -> t -> t
sz Heap a
E t
i = t
i
        sz (L Int
_ a
_ Heap a
a Heap a
b) t
i = Heap a -> t -> t
sz Heap a
a (Heap a -> t -> t
sz Heap a
b (t
i t -> t -> t
forall a. Num a => a -> a -> a
+ t
1))

member :: Ord a => a -> Heap a -> Bool
member :: forall {t}. Ord t => t -> Heap t -> Bool
member a
_ Heap a
E = Bool
False
member a
x (L Int
_ a
y Heap a
a Heap a
b) =
  case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
    Ordering
LT -> Bool
False
    Ordering
EQ -> Bool
True
    Ordering
GT -> a -> Heap a -> Bool
forall {t}. Ord t => t -> Heap t -> Bool
member a
x Heap a
b Bool -> Bool -> Bool
|| a -> Heap a -> Bool
forall {t}. Ord t => t -> Heap t -> Bool
member a
x Heap a
a

count :: Ord a => a -> Heap a -> Int
count :: forall a. Ord a => a -> Heap a -> Int
count a
_ Heap a
E = Int
0
count a
x (L Int
_ a
y Heap a
a Heap a
b) =
  case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
    Ordering
LT -> Int
0
    Ordering
EQ -> Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Heap a -> Int
forall a. Ord a => a -> Heap a -> Int
count a
x Heap a
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Heap a -> Int
forall a. Ord a => a -> Heap a -> Int
count a
x Heap a
a
    Ordering
GT -> a -> Heap a -> Int
forall a. Ord a => a -> Heap a -> Int
count a
x Heap a
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Heap a -> Int
forall a. Ord a => a -> Heap a -> Int
count a
x Heap a
a

toSeq :: (Ord a,S.Sequence seq) => Heap a -> seq a
toSeq :: forall a (seq :: * -> *). (Ord a, Sequence seq) => Heap a -> seq a
toSeq Heap a
h = Heap a -> seq a -> seq a
forall {s :: * -> *} {a}. Sequence s => Heap a -> s a -> s a
tol Heap a
h seq a
forall (s :: * -> *) a. Sequence s => s a
S.empty
  where tol :: Heap a -> s a -> s a
tol Heap a
E s a
rest = s a
rest
        tol (L Int
_ a
x Heap a
a Heap a
b) s a
rest = a -> s a -> s a
forall a. a -> s a -> s a
forall (s :: * -> *) a. Sequence s => a -> s a -> s a
S.lcons a
x (Heap a -> s a -> s a
tol Heap a
b (Heap a -> s a -> s a
tol Heap a
a s a
rest))

lookupM :: (Ord a, Fail.MonadFail m) => a -> Heap a -> m a
lookupM :: forall a (m :: * -> *). (Ord a, MonadFail m) => a -> Heap a -> m a
lookupM a
_ Heap a
E = String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"LeftistHeap.lookupM: XXX"
lookupM a
x (L Int
_ a
y Heap a
a Heap a
b) =
  case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
    Ordering
LT -> String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"LeftistHeap.lookupM: XXX"
    Ordering
EQ -> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
y
    Ordering
GT -> case a -> Heap a -> Maybe a
forall a (m :: * -> *). (Ord a, MonadFail m) => a -> Heap a -> m a
lookupM a
x Heap a
b Maybe a -> Maybe a -> Maybe a
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` a -> Heap a -> Maybe a
forall a (m :: * -> *). (Ord a, MonadFail m) => a -> Heap a -> m a
lookupM a
x Heap a
a of
                Maybe a
Nothing -> String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"LeftistHeap.lookupM: XXX"
                Just a
q -> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
q

lookupAll :: (Ord a,S.Sequence seq) => a -> Heap a -> seq a
lookupAll :: forall a (seq :: * -> *).
(Ord a, Sequence seq) =>
a -> Heap a -> seq a
lookupAll a
x Heap a
h = Heap a -> seq a -> seq a
forall {s :: * -> *}. Sequence s => Heap a -> s a -> s a
look Heap a
h seq a
forall (s :: * -> *) a. Sequence s => s a
S.empty
  where look :: Heap a -> s a -> s a
look Heap a
E s a
ys = s a
ys
        look (L Int
_ a
y Heap a
a Heap a
b) s a
ys =
          case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
            Ordering
LT -> s a
ys
            Ordering
EQ -> a -> s a -> s a
forall a. a -> s a -> s a
forall (s :: * -> *) a. Sequence s => a -> s a -> s a
S.lcons a
y (Heap a -> s a -> s a
look Heap a
b (Heap a -> s a -> s a
look Heap a
a s a
ys))
            Ordering
GT -> Heap a -> s a -> s a
look Heap a
b (Heap a -> s a -> s a
look Heap a
a s a
ys)

fold :: Ord a => (a -> b -> b) -> b -> Heap a -> b
fold :: forall a b. Ord a => (a -> b -> b) -> b -> Heap a -> b
fold a -> b -> b
_ b
e Heap a
E = b
e
fold a -> b -> b
f b
e (L Int
_ a
x Heap a
a Heap a
b) = a -> b -> b
f a
x ((a -> b -> b) -> b -> Heap a -> b
forall a b. Ord a => (a -> b -> b) -> b -> Heap a -> b
fold a -> b -> b
f ((a -> b -> b) -> b -> Heap a -> b
forall a b. Ord a => (a -> b -> b) -> b -> Heap a -> b
fold a -> b -> b
f b
e Heap a
a) Heap a
b)

fold' :: Ord a => (a -> b -> b) -> b -> Heap a -> b
fold' :: forall a b. Ord a => (a -> b -> b) -> b -> Heap a -> b
fold' a -> b -> b
_ b
e Heap a
E = b
e
fold' a -> b -> b
f b
e (L Int
_ a
x Heap a
a Heap a
b) = b
e b -> b -> b
forall a b. a -> b -> b
`seq` a -> b -> b
f a
x (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! ((a -> b -> b) -> b -> Heap a -> b
forall a b. Ord a => (a -> b -> b) -> b -> Heap a -> b
fold' a -> b -> b
f ((a -> b -> b) -> b -> Heap a -> b
forall a b. Ord a => (a -> b -> b) -> b -> Heap a -> b
fold' a -> b -> b
f b
e Heap a
a) Heap a
b)

fold1 :: Ord a => (a -> a -> a) -> Heap a -> a
fold1 :: forall a. Ord a => (a -> a -> a) -> Heap a -> a
fold1 a -> a -> a
_ Heap a
E = String -> a
forall a. HasCallStack => String -> a
error String
"LeftistHeap.fold1: empty collection"
fold1 a -> a -> a
f (L Int
_ a
x Heap a
a Heap a
b) = (a -> a -> a) -> a -> Heap a -> a
forall a b. Ord a => (a -> b -> b) -> b -> Heap a -> b
fold a -> a -> a
f ((a -> a -> a) -> a -> Heap a -> a
forall a b. Ord a => (a -> b -> b) -> b -> Heap a -> b
fold a -> a -> a
f a
x Heap a
a) Heap a
b

fold1' :: Ord a => (a -> a -> a) -> Heap a -> a
fold1' :: forall a. Ord a => (a -> a -> a) -> Heap a -> a
fold1' a -> a -> a
_ Heap a
E = String -> a
forall a. HasCallStack => String -> a
error String
"LeftistHeap.fold1': empty collection"
fold1' a -> a -> a
f (L Int
_ a
x Heap a
a Heap a
b) = (a -> a -> a) -> a -> Heap a -> a
forall a b. Ord a => (a -> b -> b) -> b -> Heap a -> b
fold' a -> a -> a
f ((a -> a -> a) -> a -> Heap a -> a
forall a b. Ord a => (a -> b -> b) -> b -> Heap a -> b
fold' a -> a -> a
f a
x Heap a
a) Heap a
b


filter :: Ord a => (a -> Bool) -> Heap a -> Heap a
filter :: forall a. Ord a => (a -> Bool) -> Heap a -> Heap a
filter a -> Bool
_ Heap a
E = Heap a
forall a. Heap a
E
filter a -> Bool
p (L Int
_ a
x Heap a
a Heap a
b)
    | a -> Bool
p a
x = a -> Heap a -> Heap a -> Heap a
forall a. a -> Heap a -> Heap a -> Heap a
node a
x ((a -> Bool) -> Heap a -> Heap a
forall a. Ord a => (a -> Bool) -> Heap a -> Heap a
filter a -> Bool
p Heap a
a) ((a -> Bool) -> Heap a -> Heap a
forall a. Ord a => (a -> Bool) -> Heap a -> Heap a
filter a -> Bool
p Heap a
b)
    | Bool
otherwise = Heap a -> Heap a -> Heap a
forall a. Ord a => Heap a -> Heap a -> Heap a
union ((a -> Bool) -> Heap a -> Heap a
forall a. Ord a => (a -> Bool) -> Heap a -> Heap a
filter a -> Bool
p Heap a
a) ((a -> Bool) -> Heap a -> Heap a
forall a. Ord a => (a -> Bool) -> Heap a -> Heap a
filter a -> Bool
p Heap a
b)

partition :: Ord a => (a -> Bool) -> Heap a -> (Heap a, Heap a)
partition :: forall a. Ord a => (a -> Bool) -> Heap a -> (Heap a, Heap a)
partition a -> Bool
_ Heap a
E = (Heap a
forall a. Heap a
E, Heap a
forall a. Heap a
E)
partition a -> Bool
p (L Int
_ a
x Heap a
a Heap a
b)
    | a -> Bool
p a
x = (a -> Heap a -> Heap a -> Heap a
forall a. a -> Heap a -> Heap a -> Heap a
node a
x Heap a
a' Heap a
b', Heap a -> Heap a -> Heap a
forall a. Ord a => Heap a -> Heap a -> Heap a
union Heap a
a'' Heap a
b'')
    | Bool
otherwise = (Heap a -> Heap a -> Heap a
forall a. Ord a => Heap a -> Heap a -> Heap a
union Heap a
a' Heap a
b', a -> Heap a -> Heap a -> Heap a
forall a. a -> Heap a -> Heap a -> Heap a
node a
x Heap a
a'' Heap a
b'')
  where (Heap a
a', Heap a
a'') = (a -> Bool) -> Heap a -> (Heap a, Heap a)
forall a. Ord a => (a -> Bool) -> Heap a -> (Heap a, Heap a)
partition a -> Bool
p Heap a
a
        (Heap a
b', Heap a
b'') = (a -> Bool) -> Heap a -> (Heap a, Heap a)
forall a. Ord a => (a -> Bool) -> Heap a -> (Heap a, Heap a)
partition a -> Bool
p Heap a
b


deleteMin :: Ord a => Heap a -> Heap a
deleteMin :: forall a. Ord a => Heap a -> Heap a
deleteMin Heap a
E = Heap a
forall a. Heap a
E
deleteMin (L Int
_ a
_ Heap a
a Heap a
b) = Heap a -> Heap a -> Heap a
forall a. Ord a => Heap a -> Heap a -> Heap a
union Heap a
a Heap a
b

deleteMax :: Ord a => Heap a -> Heap a
deleteMax :: forall a. Ord a => Heap a -> Heap a
deleteMax Heap a
h = case Heap a -> Maybe (a, Heap a)
forall a (m :: * -> *).
(Ord a, MonadFail m) =>
Heap a -> m (a, Heap a)
maxView Heap a
h of
                Maybe (a, Heap a)
Nothing     -> Heap a
forall a. Heap a
E
                Just (a
_,Heap a
h') -> Heap a
h'

unsafeInsertMin :: Ord a => a -> Heap a -> Heap a
unsafeInsertMin :: forall a. Ord a => a -> Heap a -> Heap a
unsafeInsertMin a
x Heap a
h = Int -> a -> Heap a -> Heap a -> Heap a
forall a. Int -> a -> Heap a -> Heap a -> Heap a
L Int
1 a
x Heap a
h Heap a
forall a. Heap a
E

unsafeAppend :: Ord a => Heap a -> Heap a -> Heap a
unsafeAppend :: forall a. Ord a => Heap a -> Heap a -> Heap a
unsafeAppend Heap a
E Heap a
h = Heap a
h
unsafeAppend (L Int
_ a
y Heap a
a Heap a
b) Heap a
h = a -> Heap a -> Heap a -> Heap a
forall a. a -> Heap a -> Heap a -> Heap a
node a
y Heap a
a (Heap a -> Heap a -> Heap a
forall a. Ord a => Heap a -> Heap a -> Heap a
unsafeAppend Heap a
b Heap a
h)

filterLT :: Ord a => a -> Heap a -> Heap a
filterLT :: forall a. Ord a => a -> Heap a -> Heap a
filterLT a
y (L Int
_ a
x Heap a
a Heap a
b) | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
y = a -> Heap a -> Heap a -> Heap a
forall a. a -> Heap a -> Heap a -> Heap a
node a
x (a -> Heap a -> Heap a
forall a. Ord a => a -> Heap a -> Heap a
filterLT a
y Heap a
a) (a -> Heap a -> Heap a
forall a. Ord a => a -> Heap a -> Heap a
filterLT a
y Heap a
b)
filterLT a
_ Heap a
_ = Heap a
forall a. Heap a
E

filterLE :: Ord a => a -> Heap a -> Heap a
filterLE :: forall a. Ord a => a -> Heap a -> Heap a
filterLE a
y (L Int
_ a
x Heap a
a Heap a
b) | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y = a -> Heap a -> Heap a -> Heap a
forall a. a -> Heap a -> Heap a -> Heap a
node a
x (a -> Heap a -> Heap a
forall a. Ord a => a -> Heap a -> Heap a
filterLE a
y Heap a
a) (a -> Heap a -> Heap a
forall a. Ord a => a -> Heap a -> Heap a
filterLE a
y Heap a
b)
filterLE a
_ Heap a
_ = Heap a
forall a. Heap a
E

filterGT :: Ord a => a -> Heap a -> Heap a
filterGT :: forall a. Ord a => a -> Heap a -> Heap a
filterGT a
y Heap a
h = [Heap a] -> Heap a
forall c a. CollX c a => [c] -> c
C.unionList (Heap a -> [Heap a] -> [Heap a]
collect Heap a
h [])
  where collect :: Heap a -> [Heap a] -> [Heap a]
collect Heap a
E [Heap a]
hs = [Heap a]
hs
        collect h :: Heap a
h@(L Int
_ a
x Heap a
a Heap a
b) [Heap a]
hs
          | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
y = Heap a
h Heap a -> [Heap a] -> [Heap a]
forall a. a -> [a] -> [a]
: [Heap a]
hs
          | Bool
otherwise = Heap a -> [Heap a] -> [Heap a]
collect Heap a
a (Heap a -> [Heap a] -> [Heap a]
collect Heap a
b [Heap a]
hs)

filterGE :: Ord a => a -> Heap a -> Heap a
filterGE :: forall a. Ord a => a -> Heap a -> Heap a
filterGE a
y Heap a
h = [Heap a] -> Heap a
forall c a. CollX c a => [c] -> c
C.unionList (Heap a -> [Heap a] -> [Heap a]
collect Heap a
h [])
  where collect :: Heap a -> [Heap a] -> [Heap a]
collect Heap a
E [Heap a]
hs = [Heap a]
hs
        collect h :: Heap a
h@(L Int
_ a
x Heap a
a Heap a
b) [Heap a]
hs
          | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
y = Heap a
h Heap a -> [Heap a] -> [Heap a]
forall a. a -> [a] -> [a]
: [Heap a]
hs
          | Bool
otherwise = Heap a -> [Heap a] -> [Heap a]
collect Heap a
b (Heap a -> [Heap a] -> [Heap a]
collect Heap a
a [Heap a]
hs)

partitionLT_GE :: Ord a => a -> Heap a -> (Heap a, Heap a)
partitionLT_GE :: forall a. Ord a => a -> Heap a -> (Heap a, Heap a)
partitionLT_GE a
y Heap a
h = (Heap a
h', [Heap a] -> Heap a
forall c a. CollX c a => [c] -> c
C.unionList [Heap a]
hs)
  where (Heap a
h', [Heap a]
hs) = Heap a -> [Heap a] -> (Heap a, [Heap a])
collect Heap a
h []

        collect :: Heap a -> [Heap a] -> (Heap a, [Heap a])
collect Heap a
E [Heap a]
hs = (Heap a
forall a. Heap a
E, [Heap a]
hs)
        collect h :: Heap a
h@(L Int
_ a
x Heap a
a Heap a
b) [Heap a]
hs
          | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
y = (Heap a
forall a. Heap a
E, Heap a
hHeap a -> [Heap a] -> [Heap a]
forall a. a -> [a] -> [a]
:[Heap a]
hs)
          | Bool
otherwise = let (Heap a
a', [Heap a]
hs') = Heap a -> [Heap a] -> (Heap a, [Heap a])
collect Heap a
a [Heap a]
hs
                            (Heap a
b', [Heap a]
hs'') = Heap a -> [Heap a] -> (Heap a, [Heap a])
collect Heap a
b [Heap a]
hs'
                        in (a -> Heap a -> Heap a -> Heap a
forall a. a -> Heap a -> Heap a -> Heap a
node a
x Heap a
a' Heap a
b', [Heap a]
hs'')

partitionLE_GT :: Ord a => a -> Heap a -> (Heap a, Heap a)
partitionLE_GT :: forall a. Ord a => a -> Heap a -> (Heap a, Heap a)
partitionLE_GT a
y Heap a
h = (Heap a
h', [Heap a] -> Heap a
forall c a. CollX c a => [c] -> c
C.unionList [Heap a]
hs)
  where (Heap a
h', [Heap a]
hs) = Heap a -> [Heap a] -> (Heap a, [Heap a])
collect Heap a
h []

        collect :: Heap a -> [Heap a] -> (Heap a, [Heap a])
collect Heap a
E [Heap a]
hs = (Heap a
forall a. Heap a
E, [Heap a]
hs)
        collect h :: Heap a
h@(L Int
_ a
x Heap a
a Heap a
b) [Heap a]
hs
          | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
y = (Heap a
forall a. Heap a
E, Heap a
hHeap a -> [Heap a] -> [Heap a]
forall a. a -> [a] -> [a]
:[Heap a]
hs)
          | Bool
otherwise = let (Heap a
a', [Heap a]
hs') = Heap a -> [Heap a] -> (Heap a, [Heap a])
collect Heap a
a [Heap a]
hs
                            (Heap a
b', [Heap a]
hs'') = Heap a -> [Heap a] -> (Heap a, [Heap a])
collect Heap a
b [Heap a]
hs'
                        in (a -> Heap a -> Heap a -> Heap a
forall a. a -> Heap a -> Heap a -> Heap a
node a
x Heap a
a' Heap a
b', [Heap a]
hs'')

partitionLT_GT :: Ord a => a -> Heap a -> (Heap a, Heap a)
partitionLT_GT :: forall a. Ord a => a -> Heap a -> (Heap a, Heap a)
partitionLT_GT a
y Heap a
h = (Heap a
h', [Heap a] -> Heap a
forall c a. CollX c a => [c] -> c
C.unionList [Heap a]
hs)
  where (Heap a
h', [Heap a]
hs) = Heap a -> [Heap a] -> (Heap a, [Heap a])
collect Heap a
h []

        collect :: Heap a -> [Heap a] -> (Heap a, [Heap a])
collect Heap a
E [Heap a]
hs = (Heap a
forall a. Heap a
E, [Heap a]
hs)
        collect h :: Heap a
h@(L Int
_ a
x Heap a
a Heap a
b) [Heap a]
is =
          case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
            Ordering
GT -> (Heap a
forall a. Heap a
E, Heap a
hHeap a -> [Heap a] -> [Heap a]
forall a. a -> [a] -> [a]
:[Heap a]
is)
            Ordering
EQ -> let (Heap a
a', [Heap a]
hs') = Heap a -> [Heap a] -> (Heap a, [Heap a])
collect Heap a
a [Heap a]
is
                      (Heap a
b', [Heap a]
hs'') = Heap a -> [Heap a] -> (Heap a, [Heap a])
collect Heap a
b [Heap a]
hs'
                  in (Heap a -> Heap a -> Heap a
forall a. Ord a => Heap a -> Heap a -> Heap a
union Heap a
a' Heap a
b', [Heap a]
hs'')
            Ordering
LT -> let (Heap a
a', [Heap a]
hs') = Heap a -> [Heap a] -> (Heap a, [Heap a])
collect Heap a
a [Heap a]
is
                      (Heap a
b', [Heap a]
hs'') = Heap a -> [Heap a] -> (Heap a, [Heap a])
collect Heap a
b [Heap a]
hs'
                  in (a -> Heap a -> Heap a -> Heap a
forall a. a -> Heap a -> Heap a -> Heap a
node a
x Heap a
a' Heap a
b', [Heap a]
hs'')

minView :: (Ord a, Fail.MonadFail m) => Heap a -> m (a, Heap a)
minView :: forall a (m :: * -> *).
(Ord a, MonadFail m) =>
Heap a -> m (a, Heap a)
minView Heap a
E = String -> m (a, Heap a)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"LeftistHeap.minView: empty collection"
minView (L Int
_ a
x Heap a
a Heap a
b) = (a, Heap a) -> m (a, Heap a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, Heap a -> Heap a -> Heap a
forall a. Ord a => Heap a -> Heap a -> Heap a
union Heap a
a Heap a
b)

minElem :: Ord a => Heap a -> a
minElem :: forall a. Ord a => Heap a -> a
minElem Heap a
E = String -> a
forall a. HasCallStack => String -> a
error String
"LeftistHeap.minElem: empty collection"
minElem (L Int
_ a
x Heap a
_ Heap a
_) = a
x

maxView :: (Ord a, Fail.MonadFail m) => Heap a -> m (a, Heap a)
maxView :: forall a (m :: * -> *).
(Ord a, MonadFail m) =>
Heap a -> m (a, Heap a)
maxView Heap a
E = String -> m (a, Heap a)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"LeftistHeap.maxView: empty collection"
maxView (L Int
_ a
x Heap a
E Heap a
_) = (a, Heap a) -> m (a, Heap a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, Heap a
forall a. Heap a
E)
maxView (L Int
_ a
x Heap a
a Heap a
E) = (a, Heap a) -> m (a, Heap a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
y, Int -> a -> Heap a -> Heap a -> Heap a
forall a. Int -> a -> Heap a -> Heap a -> Heap a
L Int
1 a
x Heap a
a' Heap a
forall a. Heap a
E)
  where Just (a
y,Heap a
a') = Heap a -> Maybe (a, Heap a)
forall a (m :: * -> *).
(Ord a, MonadFail m) =>
Heap a -> m (a, Heap a)
maxView Heap a
a
maxView (L Int
_ a
x Heap a
a Heap a
b)
    | a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
z    = (a, Heap a) -> m (a, Heap a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
y, a -> Heap a -> Heap a -> Heap a
forall a. a -> Heap a -> Heap a -> Heap a
node a
x Heap a
a' Heap a
b)
    | Bool
otherwise = (a, Heap a) -> m (a, Heap a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
z, a -> Heap a -> Heap a -> Heap a
forall a. a -> Heap a -> Heap a -> Heap a
node a
x Heap a
a Heap a
b')
  where Just (a
y, Heap a
a') = Heap a -> Maybe (a, Heap a)
forall a (m :: * -> *).
(Ord a, MonadFail m) =>
Heap a -> m (a, Heap a)
maxView Heap a
a
        Just (a
z, Heap a
b') = Heap a -> Maybe (a, Heap a)
forall a (m :: * -> *).
(Ord a, MonadFail m) =>
Heap a -> m (a, Heap a)
maxView Heap a
b

-- warning: maxView and maxElem may disagree if root is equal to max!

maxElem :: Ord a => Heap a -> a
maxElem :: forall a. Ord a => Heap a -> a
maxElem Heap a
E = String -> a
forall a. HasCallStack => String -> a
error String
"LeftistHeap.maxElem: empty collection"
maxElem (L Int
_ a
x Heap a
E Heap a
_) = a
x
maxElem (L Int
_ a
_ Heap a
a Heap a
b) = Heap a -> a -> a
forall {t}. Ord t => Heap t -> t -> t
findMax Heap a
b (Heap a -> a
forall a. Ord a => Heap a -> a
findLeaf Heap a
a)
  where findMax :: Heap t -> t -> t
findMax Heap t
E t
m = t
m
        findMax (L Int
_ t
x Heap t
E Heap t
_) t
m
          | t
m t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>= t
x = t
m
          | Bool
otherwise = t
x
        findMax (L Int
_ t
_ Heap t
d Heap t
c) t
m = Heap t -> t -> t
findMax Heap t
d (Heap t -> t -> t
findMax Heap t
c t
m)

        findLeaf :: Heap a -> a
findLeaf Heap a
E = String -> a
forall a. HasCallStack => String -> a
error String
"LeftistHeap.maxElem: bug"
        findLeaf (L Int
_ a
x Heap a
E Heap a
_) = a
x
        findLeaf (L Int
_ a
_ Heap a
y Heap a
c) = Heap a -> a -> a
forall {t}. Ord t => Heap t -> t -> t
findMax Heap a
c (Heap a -> a
findLeaf Heap a
y)

foldr :: Ord a => (a -> b -> b) -> b -> Heap a -> b
foldr :: forall a b. Ord a => (a -> b -> b) -> b -> Heap a -> b
foldr a -> b -> b
_ b
e Heap a
E = b
e
foldr a -> b -> b
f b
e (L Int
_ a
x Heap a
a Heap a
b) = a -> b -> b
f a
x ((a -> b -> b) -> b -> Heap a -> b
forall a b. Ord a => (a -> b -> b) -> b -> Heap a -> b
foldr a -> b -> b
f b
e (Heap a -> Heap a -> Heap a
forall a. Ord a => Heap a -> Heap a -> Heap a
union Heap a
a Heap a
b))

foldr' :: Ord a => (a -> b -> b) -> b -> Heap a -> b
foldr' :: forall a b. Ord a => (a -> b -> b) -> b -> Heap a -> b
foldr' a -> b -> b
_ b
e Heap a
E = b
e
foldr' a -> b -> b
f b
e (L Int
_ a
x Heap a
a Heap a
b) = b
e b -> b -> b
forall a b. a -> b -> b
`seq` a -> b -> b
f a
x (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! ((a -> b -> b) -> b -> Heap a -> b
forall a b. Ord a => (a -> b -> b) -> b -> Heap a -> b
foldr' a -> b -> b
f b
e (Heap a -> Heap a -> Heap a
forall a. Ord a => Heap a -> Heap a -> Heap a
union Heap a
a Heap a
b))

foldl :: Ord a => (b -> a -> b) -> b -> Heap a -> b
foldl :: forall a b. Ord a => (b -> a -> b) -> b -> Heap a -> b
foldl b -> a -> b
_ b
e Heap a
E = b
e
foldl b -> a -> b
f b
e (L Int
_ a
x Heap a
a Heap a
b) = (b -> a -> b) -> b -> Heap a -> b
forall a b. Ord a => (b -> a -> b) -> b -> Heap a -> b
foldl b -> a -> b
f (b -> a -> b
f b
e a
x) (Heap a -> Heap a -> Heap a
forall a. Ord a => Heap a -> Heap a -> Heap a
union Heap a
a Heap a
b)

foldl' :: Ord a => (b -> a -> b) -> b -> Heap a -> b
foldl' :: forall a b. Ord a => (b -> a -> b) -> b -> Heap a -> b
foldl' b -> a -> b
_ b
e Heap a
E = b
e
foldl' b -> a -> b
f b
e (L Int
_ a
x Heap a
a Heap a
b) = b
e b -> b -> b
forall a b. a -> b -> b
`seq` (b -> a -> b) -> b -> Heap a -> b
forall a b. Ord a => (b -> a -> b) -> b -> Heap a -> b
foldl' b -> a -> b
f (b -> a -> b
f b
e a
x) (Heap a -> Heap a -> Heap a
forall a. Ord a => Heap a -> Heap a -> Heap a
union Heap a
a Heap a
b)

foldr1 :: Ord a => (a -> a -> a) -> Heap a -> a
foldr1 :: forall a. Ord a => (a -> a -> a) -> Heap a -> a
foldr1 a -> a -> a
_ Heap a
E = String -> a
forall a. HasCallStack => String -> a
error String
"LeftistHeap.foldr1: empty collection"
foldr1 a -> a -> a
_ (L Int
_ a
x Heap a
E Heap a
_) = a
x
foldr1 a -> a -> a
f (L Int
_ a
x Heap a
a Heap a
b) = a -> a -> a
f a
x ((a -> a -> a) -> Heap a -> a
forall a. Ord a => (a -> a -> a) -> Heap a -> a
foldr1 a -> a -> a
f (Heap a -> Heap a -> Heap a
forall a. Ord a => Heap a -> Heap a -> Heap a
union Heap a
a Heap a
b))

foldr1' :: Ord a => (a -> a -> a) -> Heap a -> a
foldr1' :: forall a. Ord a => (a -> a -> a) -> Heap a -> a
foldr1' a -> a -> a
_ Heap a
E = String -> a
forall a. HasCallStack => String -> a
error String
"LeftistHeap.foldr1': empty collection"
foldr1' a -> a -> a
_ (L Int
_ a
x Heap a
E Heap a
_) = a
x
foldr1' a -> a -> a
f (L Int
_ a
x Heap a
a Heap a
b) = a -> a -> a
f a
x (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$! ((a -> a -> a) -> Heap a -> a
forall a. Ord a => (a -> a -> a) -> Heap a -> a
foldr1' a -> a -> a
f (Heap a -> Heap a -> Heap a
forall a. Ord a => Heap a -> Heap a -> Heap a
union Heap a
a Heap a
b))

foldl1 :: Ord a => (a -> a -> a) -> Heap a -> a
foldl1 :: forall a. Ord a => (a -> a -> a) -> Heap a -> a
foldl1 a -> a -> a
_ Heap a
E = String -> a
forall a. HasCallStack => String -> a
error String
"LeftistHeap.foldl1: empty collection"
foldl1 a -> a -> a
f (L Int
_ a
x Heap a
a Heap a
b) = (a -> a -> a) -> a -> Heap a -> a
forall a b. Ord a => (b -> a -> b) -> b -> Heap a -> b
foldl a -> a -> a
f a
x (Heap a -> Heap a -> Heap a
forall a. Ord a => Heap a -> Heap a -> Heap a
union Heap a
a Heap a
b)

foldl1' :: Ord a => (a -> a -> a) -> Heap a -> a
foldl1' :: forall a. Ord a => (a -> a -> a) -> Heap a -> a
foldl1' a -> a -> a
_ Heap a
E = String -> a
forall a. HasCallStack => String -> a
error String
"LeftistHeap.foldl1: empty collection"
foldl1' a -> a -> a
f (L Int
_ a
x Heap a
a Heap a
b) = (a -> a -> a) -> a -> Heap a -> a
forall a b. Ord a => (b -> a -> b) -> b -> Heap a -> b
foldl' a -> a -> a
f a
x (Heap a -> Heap a -> Heap a
forall a. Ord a => Heap a -> Heap a -> Heap a
union Heap a
a Heap a
b)

{- ???? -}
unsafeMapMonotonic :: Ord a => (a -> a) -> Heap a -> Heap a
unsafeMapMonotonic :: forall a. Ord a => (a -> a) -> Heap a -> Heap a
unsafeMapMonotonic a -> a
_ Heap a
E = Heap a
forall a. Heap a
E
unsafeMapMonotonic a -> a
f (L Int
i a
x Heap a
a Heap a
b) =
  Int -> a -> Heap a -> Heap a -> Heap a
forall a. Int -> a -> Heap a -> Heap a -> Heap a
L Int
i (a -> a
f a
x) ((a -> a) -> Heap a -> Heap a
forall a. Ord a => (a -> a) -> Heap a -> Heap a
unsafeMapMonotonic a -> a
f Heap a
a) ((a -> a) -> Heap a -> Heap a
forall a. Ord a => (a -> a) -> Heap a -> Heap a
unsafeMapMonotonic a -> a
f Heap a
b)


-- all fields are already fully strict!
strict :: Heap a -> Heap a
strict :: forall a. Heap a -> Heap a
strict Heap a
h = Heap a
h

strictWith :: (a -> b) -> Heap a -> Heap a
strictWith :: forall a b. (a -> b) -> Heap a -> Heap a
strictWith a -> b
_ h :: Heap a
h@Heap a
E = Heap a
h
strictWith a -> b
f h :: Heap a
h@(L Int
_ a
x Heap a
l Heap a
r) = a -> b
f a
x b -> Heap a -> Heap a
forall a b. a -> b -> b
`seq` (a -> b) -> Heap a -> Heap a
forall a b. (a -> b) -> Heap a -> Heap a
strictWith a -> b
f Heap a
l Heap a -> Heap a -> Heap a
forall a b. a -> b -> b
`seq` (a -> b) -> Heap a -> Heap a
forall a b. (a -> b) -> Heap a -> Heap a
strictWith a -> b
f Heap a
r Heap a -> Heap a -> Heap a
forall a b. a -> b -> b
`seq` Heap a
h

-- the remaining functions all use default definitions

fromSeq :: (Ord a,S.Sequence seq) => seq a -> Heap a
fromSeq :: forall a (seq :: * -> *). (Ord a, Sequence seq) => seq a -> Heap a
fromSeq = seq a -> Heap a
forall c a (seq :: * -> *). (CollX c a, Sequence seq) => seq a -> c
fromSeqUsingUnionSeq

insertSeq :: (Ord a,S.Sequence seq) => seq a -> Heap a -> Heap a
insertSeq :: forall a (seq :: * -> *).
(Ord a, Sequence seq) =>
seq a -> Heap a -> Heap a
insertSeq = seq a -> Heap a -> Heap a
forall c a (seq :: * -> *).
(CollX c a, Sequence seq) =>
seq a -> c -> c
insertSeqUsingUnion

unionSeq :: (Ord a,S.Sequence seq) => seq (Heap a) -> Heap a
unionSeq :: forall a (seq :: * -> *).
(Ord a, Sequence seq) =>
seq (Heap a) -> Heap a
unionSeq = seq (Heap a) -> Heap a
forall c a (seq :: * -> *). (CollX c a, Sequence seq) => seq c -> c
unionSeqUsingReduce

deleteSeq :: (Ord a,S.Sequence seq) => seq a -> Heap a -> Heap a
deleteSeq :: forall a (seq :: * -> *).
(Ord a, Sequence seq) =>
seq a -> Heap a -> Heap a
deleteSeq = seq a -> Heap a -> Heap a
forall c a (seq :: * -> *).
(CollX c a, Sequence seq) =>
seq a -> c -> c
deleteSeqUsingDelete

lookup :: Ord a => a -> Heap a -> a
lookup :: forall a. Ord a => a -> Heap a -> a
lookup = a -> Heap a -> a
forall c a. Coll c a => a -> c -> a
lookupUsingLookupM

lookupWithDefault :: Ord a => a -> a -> Heap a -> a
lookupWithDefault :: forall a. Ord a => a -> a -> Heap a -> a
lookupWithDefault = a -> a -> Heap a -> a
forall c a. Coll c a => a -> a -> c -> a
lookupWithDefaultUsingLookupM

unsafeInsertMax :: Ord a => a -> Heap a -> Heap a
unsafeInsertMax :: forall a. Ord a => a -> Heap a -> Heap a
unsafeInsertMax = a -> Heap a -> Heap a
forall c a. OrdCollX c a => a -> c -> c
unsafeInsertMaxUsingUnsafeAppend

unsafeFromOrdSeq :: (Ord a,S.Sequence seq) => seq a -> Heap a
unsafeFromOrdSeq :: forall a (seq :: * -> *). (Ord a, Sequence seq) => seq a -> Heap a
unsafeFromOrdSeq = seq a -> Heap a
forall c a (seq :: * -> *).
(OrdCollX c a, Sequence seq) =>
seq a -> c
unsafeFromOrdSeqUsingUnsafeInsertMin

toOrdSeq :: (Ord a,S.Sequence seq) => Heap a -> seq a
toOrdSeq :: forall a (seq :: * -> *). (Ord a, Sequence seq) => Heap a -> seq a
toOrdSeq = Heap a -> seq a
forall c a (seq :: * -> *).
(OrdColl c a, Sequence seq) =>
c -> seq a
toOrdSeqUsingFoldr


-- instance declarations

instance Ord a => C.CollX (Heap a) a where
  {singleton :: a -> Heap a
singleton = a -> Heap a
forall a. Ord a => a -> Heap a
singleton; fromSeq :: forall (seq :: * -> *). Sequence seq => seq a -> Heap a
fromSeq = seq a -> Heap a
forall a (seq :: * -> *). (Ord a, Sequence seq) => seq a -> Heap a
fromSeq; insert :: a -> Heap a -> Heap a
insert = a -> Heap a -> Heap a
forall a. Ord a => a -> Heap a -> Heap a
insert;
   insertSeq :: forall (seq :: * -> *). Sequence seq => seq a -> Heap a -> Heap a
insertSeq = seq a -> Heap a -> Heap a
forall a (seq :: * -> *).
(Ord a, Sequence seq) =>
seq a -> Heap a -> Heap a
insertSeq; unionSeq :: forall (seq :: * -> *). Sequence seq => seq (Heap a) -> Heap a
unionSeq = seq (Heap a) -> Heap a
forall a (seq :: * -> *).
(Ord a, Sequence seq) =>
seq (Heap a) -> Heap a
unionSeq;
   delete :: a -> Heap a -> Heap a
delete = a -> Heap a -> Heap a
forall a. Ord a => a -> Heap a -> Heap a
delete; deleteAll :: a -> Heap a -> Heap a
deleteAll = a -> Heap a -> Heap a
forall a. Ord a => a -> Heap a -> Heap a
deleteAll; deleteSeq :: forall (seq :: * -> *). Sequence seq => seq a -> Heap a -> Heap a
deleteSeq = seq a -> Heap a -> Heap a
forall a (seq :: * -> *).
(Ord a, Sequence seq) =>
seq a -> Heap a -> Heap a
deleteSeq;
   null :: Heap a -> Bool
null = Heap a -> Bool
forall a. Ord a => Heap a -> Bool
null; size :: Heap a -> Int
size = Heap a -> Int
forall a. Ord a => Heap a -> Int
size; member :: a -> Heap a -> Bool
member = a -> Heap a -> Bool
forall {t}. Ord t => t -> Heap t -> Bool
member; count :: a -> Heap a -> Int
count = a -> Heap a -> Int
forall a. Ord a => a -> Heap a -> Int
count;
   strict :: Heap a -> Heap a
strict = Heap a -> Heap a
forall a. Heap a -> Heap a
strict;
   structuralInvariant :: Heap a -> Bool
structuralInvariant = Heap a -> Bool
forall a. Ord a => Heap a -> Bool
structuralInvariant; instanceName :: Heap a -> String
instanceName Heap a
_ = String
moduleName}

instance Ord a => C.OrdCollX (Heap a) a where
  {deleteMin :: Heap a -> Heap a
deleteMin = Heap a -> Heap a
forall a. Ord a => Heap a -> Heap a
deleteMin; deleteMax :: Heap a -> Heap a
deleteMax = Heap a -> Heap a
forall a. Ord a => Heap a -> Heap a
deleteMax;
   unsafeInsertMin :: a -> Heap a -> Heap a
unsafeInsertMin = a -> Heap a -> Heap a
forall a. Ord a => a -> Heap a -> Heap a
unsafeInsertMin; unsafeInsertMax :: a -> Heap a -> Heap a
unsafeInsertMax = a -> Heap a -> Heap a
forall a. Ord a => a -> Heap a -> Heap a
unsafeInsertMax;
   unsafeFromOrdSeq :: forall (seq :: * -> *). Sequence seq => seq a -> Heap a
unsafeFromOrdSeq = seq a -> Heap a
forall a (seq :: * -> *). (Ord a, Sequence seq) => seq a -> Heap a
unsafeFromOrdSeq; unsafeAppend :: Heap a -> Heap a -> Heap a
unsafeAppend = Heap a -> Heap a -> Heap a
forall a. Ord a => Heap a -> Heap a -> Heap a
unsafeAppend;
   filterLT :: a -> Heap a -> Heap a
filterLT = a -> Heap a -> Heap a
forall a. Ord a => a -> Heap a -> Heap a
filterLT; filterLE :: a -> Heap a -> Heap a
filterLE = a -> Heap a -> Heap a
forall a. Ord a => a -> Heap a -> Heap a
filterLE; filterGT :: a -> Heap a -> Heap a
filterGT = a -> Heap a -> Heap a
forall a. Ord a => a -> Heap a -> Heap a
filterGT;
   filterGE :: a -> Heap a -> Heap a
filterGE = a -> Heap a -> Heap a
forall a. Ord a => a -> Heap a -> Heap a
filterGE; partitionLT_GE :: a -> Heap a -> (Heap a, Heap a)
partitionLT_GE = a -> Heap a -> (Heap a, Heap a)
forall a. Ord a => a -> Heap a -> (Heap a, Heap a)
partitionLT_GE;
   partitionLE_GT :: a -> Heap a -> (Heap a, Heap a)
partitionLE_GT = a -> Heap a -> (Heap a, Heap a)
forall a. Ord a => a -> Heap a -> (Heap a, Heap a)
partitionLE_GT; partitionLT_GT :: a -> Heap a -> (Heap a, Heap a)
partitionLT_GT = a -> Heap a -> (Heap a, Heap a)
forall a. Ord a => a -> Heap a -> (Heap a, Heap a)
partitionLT_GT}

instance Ord a => C.Coll (Heap a) a where
  {toSeq :: forall (seq :: * -> *). Sequence seq => Heap a -> seq a
toSeq = Heap a -> seq a
forall a (seq :: * -> *). (Ord a, Sequence seq) => Heap a -> seq a
toSeq; lookup :: a -> Heap a -> a
lookup = a -> Heap a -> a
forall a. Ord a => a -> Heap a -> a
lookup; lookupM :: forall (m :: * -> *). MonadFail m => a -> Heap a -> m a
lookupM = a -> Heap a -> m a
forall a (m :: * -> *). (Ord a, MonadFail m) => a -> Heap a -> m a
lookupM;
   lookupAll :: forall (seq :: * -> *). Sequence seq => a -> Heap a -> seq a
lookupAll = a -> Heap a -> seq a
forall a (seq :: * -> *).
(Ord a, Sequence seq) =>
a -> Heap a -> seq a
lookupAll; lookupWithDefault :: a -> a -> Heap a -> a
lookupWithDefault = a -> a -> Heap a -> a
forall a. Ord a => a -> a -> Heap a -> a
lookupWithDefault;
   fold :: forall b. (a -> b -> b) -> b -> Heap a -> b
fold = (a -> b -> b) -> b -> Heap a -> b
forall a b. Ord a => (a -> b -> b) -> b -> Heap a -> b
fold; fold' :: forall b. (a -> b -> b) -> b -> Heap a -> b
fold' = (a -> b -> b) -> b -> Heap a -> b
forall a b. Ord a => (a -> b -> b) -> b -> Heap a -> b
fold'; fold1 :: (a -> a -> a) -> Heap a -> a
fold1 = (a -> a -> a) -> Heap a -> a
forall a. Ord a => (a -> a -> a) -> Heap a -> a
fold1; fold1' :: (a -> a -> a) -> Heap a -> a
fold1' = (a -> a -> a) -> Heap a -> a
forall a. Ord a => (a -> a -> a) -> Heap a -> a
fold1';
   filter :: (a -> Bool) -> Heap a -> Heap a
filter = (a -> Bool) -> Heap a -> Heap a
forall a. Ord a => (a -> Bool) -> Heap a -> Heap a
filter; partition :: (a -> Bool) -> Heap a -> (Heap a, Heap a)
partition = (a -> Bool) -> Heap a -> (Heap a, Heap a)
forall a. Ord a => (a -> Bool) -> Heap a -> (Heap a, Heap a)
partition; strictWith :: forall b. (a -> b) -> Heap a -> Heap a
strictWith = (a -> b) -> Heap a -> Heap a
forall a b. (a -> b) -> Heap a -> Heap a
strictWith}

instance Ord a => C.OrdColl (Heap a) a where
  {minView :: forall (m :: * -> *). MonadFail m => Heap a -> m (a, Heap a)
minView = Heap a -> m (a, Heap a)
forall a (m :: * -> *).
(Ord a, MonadFail m) =>
Heap a -> m (a, Heap a)
minView; minElem :: Heap a -> a
minElem = Heap a -> a
forall a. Ord a => Heap a -> a
minElem; maxView :: forall (m :: * -> *). MonadFail m => Heap a -> m (a, Heap a)
maxView = Heap a -> m (a, Heap a)
forall a (m :: * -> *).
(Ord a, MonadFail m) =>
Heap a -> m (a, Heap a)
maxView;
   maxElem :: Heap a -> a
maxElem = Heap a -> a
forall a. Ord a => Heap a -> a
maxElem; foldr :: forall b. (a -> b -> b) -> b -> Heap a -> b
foldr = (a -> b -> b) -> b -> Heap a -> b
forall a b. Ord a => (a -> b -> b) -> b -> Heap a -> b
foldr; foldr' :: forall b. (a -> b -> b) -> b -> Heap a -> b
foldr' = (a -> b -> b) -> b -> Heap a -> b
forall a b. Ord a => (a -> b -> b) -> b -> Heap a -> b
foldr';
   foldl :: forall b. (b -> a -> b) -> b -> Heap a -> b
foldl = (b -> a -> b) -> b -> Heap a -> b
forall a b. Ord a => (b -> a -> b) -> b -> Heap a -> b
foldl; foldl' :: forall b. (b -> a -> b) -> b -> Heap a -> b
foldl' = (b -> a -> b) -> b -> Heap a -> b
forall a b. Ord a => (b -> a -> b) -> b -> Heap a -> b
foldl'; foldr1 :: (a -> a -> a) -> Heap a -> a
foldr1 = (a -> a -> a) -> Heap a -> a
forall a. Ord a => (a -> a -> a) -> Heap a -> a
foldr1;
   foldr1' :: (a -> a -> a) -> Heap a -> a
foldr1' = (a -> a -> a) -> Heap a -> a
forall a. Ord a => (a -> a -> a) -> Heap a -> a
foldr1'; foldl1 :: (a -> a -> a) -> Heap a -> a
foldl1 = (a -> a -> a) -> Heap a -> a
forall a. Ord a => (a -> a -> a) -> Heap a -> a
foldl1; foldl1' :: (a -> a -> a) -> Heap a -> a
foldl1' = (a -> a -> a) -> Heap a -> a
forall a. Ord a => (a -> a -> a) -> Heap a -> a
foldl1';
   toOrdSeq :: forall (seq :: * -> *). Sequence seq => Heap a -> seq a
toOrdSeq = Heap a -> seq a
forall a (seq :: * -> *). (Ord a, Sequence seq) => Heap a -> seq a
toOrdSeq; unsafeMapMonotonic :: (a -> a) -> Heap a -> Heap a
unsafeMapMonotonic = (a -> a) -> Heap a -> Heap a
forall a. Ord a => (a -> a) -> Heap a -> Heap a
unsafeMapMonotonic}

instance Ord a => Eq (Heap a) where
  Heap a
xs == :: Heap a -> Heap a -> Bool
== Heap a
ys = Heap a -> [a]
forall c a. OrdColl c a => c -> [a]
C.toOrdList Heap a
xs [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== Heap a -> [a]
forall c a. OrdColl c a => c -> [a]
C.toOrdList Heap a
ys

instance (Ord a, Show a) => Show (Heap a) where
  showsPrec :: Int -> Heap a -> ShowS
showsPrec = Int -> Heap a -> ShowS
forall c a. (Coll c a, Show a) => Int -> c -> ShowS
showsPrecUsingToList

instance (Ord a, Read a) => Read (Heap a) where
  readsPrec :: Int -> ReadS (Heap a)
readsPrec = Int -> ReadS (Heap a)
forall c a. (Coll c a, Read a) => Int -> ReadS c
readsPrecUsingFromList


instance (Ord a, Arbitrary a) => Arbitrary (Heap a) where
  arbitrary :: Gen (Heap a)
arbitrary = (Int -> Gen (Heap a)) -> Gen (Heap a)
forall a. (Int -> Gen a) -> Gen a
sized (\Int
n -> Int -> Gen (Heap a)
forall {t} {a}.
(Arbitrary a, Integral t, Ord a) =>
t -> Gen (Heap a)
arbTree Int
n)
    where arbTree :: t -> Gen (Heap a)
arbTree t
0 = Heap a -> Gen (Heap a)
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return Heap a
forall a. Heap a
E
          arbTree t
n =
            [(Int, Gen (Heap a))] -> Gen (Heap a)
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [(Int
1, Heap a -> Gen (Heap a)
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return Heap a
forall a. Heap a
E),
                       (Int
4, (a -> Heap a -> Heap a -> Heap a)
-> Gen a -> Gen (Heap a) -> Gen (Heap a) -> Gen (Heap a)
forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 a -> Heap a -> Heap a -> Heap a
forall {a}. Ord a => a -> Heap a -> Heap a -> Heap a
snode Gen a
forall a. Arbitrary a => Gen a
arbitrary (t -> Gen (Heap a)
arbTree (t
n t -> t -> t
forall a. Integral a => a -> a -> a
`div` t
2))
                                                  (t -> Gen (Heap a)
arbTree (t
n t -> t -> t
forall a. Integral a => a -> a -> a
`div` t
4)))]

          snode :: a -> Heap a -> Heap a -> Heap a
snode a
x Heap a
a Heap a
b = Heap a -> Heap a
forall a. Ord a => Heap a -> Heap a
sift (a -> Heap a -> Heap a -> Heap a
forall a. a -> Heap a -> Heap a -> Heap a
node a
x Heap a
a Heap a
b)

          sift :: Heap a -> Heap a
sift Heap a
E = Heap a
forall a. Heap a
E
          sift t :: Heap a
t@(L Int
_ a
x Heap a
a Heap a
E)
            | Heap a
a Heap a -> Heap a -> Bool
forall a. Eq a => a -> a -> Bool
== Heap a
forall a. Heap a
E Bool -> Bool -> Bool
|| a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= Heap a -> a
forall a. Ord a => Heap a -> a
minElem Heap a
a = Heap a
t
          sift (L Int
r a
x (L Int
r' a
y Heap a
a Heap a
b) Heap a
E) =
                Int -> a -> Heap a -> Heap a -> Heap a
forall a. Int -> a -> Heap a -> Heap a -> Heap a
L Int
r a
y (Heap a -> Heap a
sift (Int -> a -> Heap a -> Heap a -> Heap a
forall a. Int -> a -> Heap a -> Heap a -> Heap a
L Int
r' a
x Heap a
a Heap a
b)) Heap a
forall a. Heap a
E
          sift t :: Heap a
t@(L Int
_ a
x Heap a
a Heap a
b)
            | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= Heap a -> a
forall a. Ord a => Heap a -> a
minElem Heap a
a Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= Heap a -> a
forall a. Ord a => Heap a -> a
minElem Heap a
b = Heap a
t
          sift (L Int
r a
x (L Int
r' a
y Heap a
a Heap a
b) Heap a
c)
            | a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= Heap a -> a
forall a. Ord a => Heap a -> a
minElem Heap a
c =
                Int -> a -> Heap a -> Heap a -> Heap a
forall a. Int -> a -> Heap a -> Heap a -> Heap a
L Int
r a
y (Heap a -> Heap a
sift (Int -> a -> Heap a -> Heap a -> Heap a
forall a. Int -> a -> Heap a -> Heap a -> Heap a
L Int
r' a
x Heap a
a Heap a
b)) Heap a
c
          sift (L Int
r a
x Heap a
a (L Int
r' a
y Heap a
b Heap a
c)) =
                Int -> a -> Heap a -> Heap a -> Heap a
forall a. Int -> a -> Heap a -> Heap a -> Heap a
L Int
r a
y Heap a
a (Heap a -> Heap a
sift (Int -> a -> Heap a -> Heap a -> Heap a
forall a. Int -> a -> Heap a -> Heap a -> Heap a
L Int
r' a
x Heap a
b Heap a
c))
          sift Heap a
_ = String -> Heap a
forall a. HasCallStack => String -> a
error String
"LeftistHeap.arbitrary: bug!"

instance (Ord a, CoArbitrary a) => CoArbitrary (Heap a) where
  coarbitrary :: forall b. Heap a -> Gen b -> Gen b
coarbitrary Heap a
E = Integer -> Gen b -> Gen b
forall n a. Integral n => n -> Gen a -> Gen a
variant Integer
0
  coarbitrary (L Int
_ a
x Heap a
a Heap a
b) =
      Integer -> Gen b -> Gen b
forall n a. Integral n => n -> Gen a -> Gen a
variant Integer
1 (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Gen b -> Gen b
forall b. a -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary a
x (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Heap a -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
forall b. Heap a -> Gen b -> Gen b
coarbitrary Heap a
a (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Heap a -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
forall b. Heap a -> Gen b -> Gen b
coarbitrary Heap a
b

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. Ord 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
(SG.<>)
    mconcat :: [Heap a] -> Heap a
mconcat = [Heap a] -> Heap a
forall a (seq :: * -> *).
(Ord a, Sequence seq) =>
seq (Heap a) -> Heap a
unionSeq

instance (Ord a) => Ord (Heap a) where
    compare :: Heap a -> Heap a -> Ordering
compare = Heap a -> Heap a -> Ordering
forall c a. OrdColl c a => c -> c -> Ordering
compareUsingToOrdList