{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
#if __GLASGOW_HASKELL__ >= 707
{-# LANGUAGE RoleAnnotations #-}
#endif
module Data.Heap
(
Heap
, Entry(..)
, empty
, null
, size
, singleton
, insert
, minimum
, deleteMin
, union
, uncons, viewMin
, mapMonotonic
, map
, toUnsortedList
, fromList
, sort
, traverse
, mapM
, concatMap
, filter
, partition
, split
, break
, span
, take
, drop
, splitAt
, takeWhile
, dropWhile
, group
, groupBy
, nub
, intersect
, intersectWith
, replicate
) where
import Prelude hiding
( map
, span, dropWhile, takeWhile, break, filter, take, drop, splitAt
, foldr, minimum, replicate, mapM
, concatMap
#if __GLASGOW_HASKELL__ < 710
, null
#else
, traverse
#endif
)
#if MIN_VERSION_base(4,8,0)
import Data.Bifunctor
#endif
import qualified Data.List as L
import Control.Applicative (Applicative(pure))
import Control.Monad (liftM)
#if MIN_VERSION_base(4,9,0)
import Data.Semigroup (Semigroup(..))
#endif
import Data.Monoid (Monoid(mappend, mempty))
import Data.Foldable hiding (minimum, concatMap)
import Data.Function (on)
import Data.Data (DataType, Constr, mkConstr, mkDataType, Fixity(Prefix), Data(..), constrIndex)
import Data.Typeable (Typeable)
import Text.Read
import Text.Show
import qualified Data.Traversable as Traversable
import Data.Traversable (Traversable)
data Heap a
= Empty
| Heap {-# UNPACK #-} !Int (a -> a -> Bool) {-# UNPACK #-} !(Tree a)
deriving Typeable
#if __GLASGOW_HASKELL__ >= 707
type role Heap nominal
#endif
instance Show a => Show (Heap a) where
showsPrec :: Int -> Heap a -> ShowS
showsPrec Int
_ Heap a
Empty = String -> ShowS
showString String
"fromList []"
showsPrec Int
d (Heap Int
_ a -> a -> Bool
_ Tree a
t) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"fromList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (Tree a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Tree a
t)
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] -> Heap a
forall a. Ord a => [a] -> Heap a
fromList ([a] -> Heap a) -> ReadPrec [a] -> ReadPrec (Heap a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ReadPrec [a] -> ReadPrec [a]
forall a. ReadPrec a -> ReadPrec a
step ReadPrec [a]
forall a. Read a => ReadPrec a
readPrec
instance (Ord a, Data a) => Data (Heap a) where
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Heap a -> c (Heap a)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
k forall g. g -> c g
z Heap a
h = ([a] -> Heap a) -> c ([a] -> Heap a)
forall g. g -> c g
z [a] -> Heap a
forall a. Ord a => [a] -> Heap a
fromList c ([a] -> Heap a) -> [a] -> c (Heap a)
forall d b. Data d => c (d -> b) -> d -> c b
`k` Heap a -> [a]
forall a. Heap a -> [a]
toUnsortedList Heap a
h
toConstr :: Heap a -> Constr
toConstr Heap a
_ = Constr
fromListConstr
dataTypeOf :: Heap a -> DataType
dataTypeOf Heap a
_ = DataType
heapDataType
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Heap a)
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c = case Constr -> Int
constrIndex Constr
c of
Int
1 -> c ([a] -> Heap a) -> c (Heap a)
forall b r. Data b => c (b -> r) -> c r
k (([a] -> Heap a) -> c ([a] -> Heap a)
forall r. r -> c r
z [a] -> Heap a
forall a. Ord a => [a] -> Heap a
fromList)
Int
_ -> String -> c (Heap a)
forall a. HasCallStack => String -> a
error String
"gunfold"
heapDataType :: DataType
heapDataType :: DataType
heapDataType = String -> [Constr] -> DataType
mkDataType String
"Data.Heap.Heap" [Constr
fromListConstr]
fromListConstr :: Constr
fromListConstr :: Constr
fromListConstr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
heapDataType String
"fromList" [] Fixity
Prefix
instance Eq (Heap a) where
Heap a
Empty == :: Heap a -> Heap a -> Bool
== Heap a
Empty = Bool
True
Heap a
Empty == Heap{} = Bool
False
Heap{} == Heap a
Empty = Bool
False
a :: Heap a
a@(Heap Int
s1 a -> a -> Bool
leq Tree a
_) == b :: Heap a
b@(Heap Int
s2 a -> a -> Bool
_ Tree a
_) = Int
s1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
s2 Bool -> Bool -> Bool
&& (a -> a -> Bool) -> [a] -> [a] -> Bool
forall t. (t -> t -> Bool) -> [t] -> [t] -> Bool
go a -> a -> Bool
leq (Heap a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Heap a
a) (Heap a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Heap a
b)
where
go :: (t -> t -> Bool) -> [t] -> [t] -> Bool
go t -> t -> Bool
f (t
x:[t]
xs) (t
y:[t]
ys) = t -> t -> Bool
f t
x t
y Bool -> Bool -> Bool
&& t -> t -> Bool
f t
y t
x Bool -> Bool -> Bool
&& (t -> t -> Bool) -> [t] -> [t] -> Bool
go t -> t -> Bool
f [t]
xs [t]
ys
go t -> t -> Bool
_ [] [] = Bool
True
go t -> t -> Bool
_ [t]
_ [t]
_ = Bool
False
instance Ord (Heap a) where
Heap a
Empty compare :: Heap a -> Heap a -> Ordering
`compare` Heap a
Empty = Ordering
EQ
Heap a
Empty `compare` Heap{} = Ordering
LT
Heap{} `compare` Heap a
Empty = Ordering
GT
a :: Heap a
a@(Heap Int
_ a -> a -> Bool
leq Tree a
_) `compare` Heap a
b = (a -> a -> Bool) -> [a] -> [a] -> Ordering
forall t. (t -> t -> Bool) -> [t] -> [t] -> Ordering
go a -> a -> Bool
leq (Heap a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Heap a
a) (Heap a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Heap a
b)
where
go :: (t -> t -> Bool) -> [t] -> [t] -> Ordering
go t -> t -> Bool
f (t
x:[t]
xs) (t
y:[t]
ys) =
if t -> t -> Bool
f t
x t
y
then if t -> t -> Bool
f t
y t
x
then (t -> t -> Bool) -> [t] -> [t] -> Ordering
go t -> t -> Bool
f [t]
xs [t]
ys
else Ordering
LT
else Ordering
GT
go t -> t -> Bool
f [] [] = Ordering
EQ
go t -> t -> Bool
f [] (t
_:[t]
_) = Ordering
LT
go t -> t -> Bool
f (t
_:[t]
_) [] = Ordering
GT
empty :: Heap a
empty :: Heap a
empty = Heap a
forall a. Heap a
Empty
{-# INLINE empty #-}
singleton :: Ord a => a -> Heap a
singleton :: a -> Heap a
singleton = (a -> a -> Bool) -> a -> Heap a
forall a. (a -> a -> Bool) -> a -> Heap a
singletonWith a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=)
{-# INLINE singleton #-}
singletonWith :: (a -> a -> Bool) -> a -> Heap a
singletonWith :: (a -> a -> Bool) -> a -> Heap a
singletonWith a -> a -> Bool
f a
a = Int -> (a -> a -> Bool) -> Tree a -> Heap a
forall a. Int -> (a -> a -> Bool) -> Tree a -> Heap a
Heap Int
1 a -> a -> Bool
f (Int -> a -> Forest a -> Tree a
forall a. Int -> a -> Forest a -> Tree a
Node Int
0 a
a Forest a
forall a. Forest a
Nil)
{-# INLINE singletonWith #-}
insert :: Ord a => a -> Heap a -> Heap a
insert :: a -> Heap a -> Heap a
insert = (a -> a -> Bool) -> a -> Heap a -> Heap a
forall a. (a -> a -> Bool) -> a -> Heap a -> Heap a
insertWith a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=)
{-# INLINE insert #-}
insertWith :: (a -> a -> Bool) -> a -> Heap a -> Heap a
insertWith :: (a -> a -> Bool) -> a -> Heap a -> Heap a
insertWith a -> a -> Bool
leq a
x Heap a
Empty = (a -> a -> Bool) -> a -> Heap a
forall a. (a -> a -> Bool) -> a -> Heap a
singletonWith a -> a -> Bool
leq a
x
insertWith a -> a -> Bool
leq a
x (Heap Int
s a -> a -> Bool
_ t :: Tree a
t@(Node Int
_ a
y Forest a
f))
| a -> a -> Bool
leq a
x a
y = Int -> (a -> a -> Bool) -> Tree a -> Heap a
forall a. Int -> (a -> a -> Bool) -> Tree a -> Heap a
Heap (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a -> a -> Bool
leq (Int -> a -> Forest a -> Tree a
forall a. Int -> a -> Forest a -> Tree a
Node Int
0 a
x (Tree a
t Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
forall a. Forest a
Nil))
| Bool
otherwise = Int -> (a -> a -> Bool) -> Tree a -> Heap a
forall a. Int -> (a -> a -> Bool) -> Tree a -> Heap a
Heap (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a -> a -> Bool
leq (Int -> a -> Forest a -> Tree a
forall a. Int -> a -> Forest a -> Tree a
Node Int
0 a
y ((a -> a -> Bool) -> Tree a -> Forest a -> Forest a
forall a. (a -> a -> Bool) -> Tree a -> Forest a -> Forest a
skewInsert a -> a -> Bool
leq (Int -> a -> Forest a -> Tree a
forall a. Int -> a -> Forest a -> Tree a
Node Int
0 a
x Forest a
forall a. Forest a
Nil) Forest a
f))
{-# INLINE insertWith #-}
union :: Heap a -> Heap a -> Heap a
union :: Heap a -> Heap a -> Heap a
union Heap a
Empty Heap a
q = Heap a
q
union Heap a
q Heap a
Empty = Heap a
q
union (Heap Int
s1 a -> a -> Bool
leq t1 :: Tree a
t1@(Node Int
_ a
x1 Forest a
f1)) (Heap Int
s2 a -> a -> Bool
_ t2 :: Tree a
t2@(Node Int
_ a
x2 Forest a
f2))
| a -> a -> Bool
leq a
x1 a
x2 = Int -> (a -> a -> Bool) -> Tree a -> Heap a
forall a. Int -> (a -> a -> Bool) -> Tree a -> Heap a
Heap (Int
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s2) a -> a -> Bool
leq (Int -> a -> Forest a -> Tree a
forall a. Int -> a -> Forest a -> Tree a
Node Int
0 a
x1 ((a -> a -> Bool) -> Tree a -> Forest a -> Forest a
forall a. (a -> a -> Bool) -> Tree a -> Forest a -> Forest a
skewInsert a -> a -> Bool
leq Tree a
t2 Forest a
f1))
| Bool
otherwise = Int -> (a -> a -> Bool) -> Tree a -> Heap a
forall a. Int -> (a -> a -> Bool) -> Tree a -> Heap a
Heap (Int
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s2) a -> a -> Bool
leq (Int -> a -> Forest a -> Tree a
forall a. Int -> a -> Forest a -> Tree a
Node Int
0 a
x2 ((a -> a -> Bool) -> Tree a -> Forest a -> Forest a
forall a. (a -> a -> Bool) -> Tree a -> Forest a -> Forest a
skewInsert a -> a -> Bool
leq Tree a
t1 Forest a
f2))
{-# INLINE union #-}
replicate :: Ord a => a -> Int -> Heap a
replicate :: a -> Int -> Heap a
replicate a
x0 Int
y0
| Int
y0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> Heap a
forall a. HasCallStack => String -> a
error String
"Heap.replicate: negative length"
| Int
y0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Heap a
forall a. Monoid a => a
mempty
| Bool
otherwise = Heap a -> Int -> Heap a
forall a a. Integral a => Heap a -> a -> Heap a
f (a -> Heap a
forall a. Ord a => a -> Heap a
singleton a
x0) Int
y0
where
f :: Heap a -> a -> Heap a
f Heap a
x a
y
| a -> Bool
forall a. Integral a => a -> Bool
even a
y = Heap a -> a -> Heap a
f (Heap a -> Heap a -> Heap a
forall a. Heap a -> Heap a -> Heap a
union Heap a
x Heap a
x) (a -> a -> a
forall a. Integral a => a -> a -> a
quot a
y a
2)
| a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 = Heap a
x
| Bool
otherwise = Heap a -> a -> Heap a -> Heap a
forall a a. Integral a => Heap a -> a -> Heap a -> Heap a
g (Heap a -> Heap a -> Heap a
forall a. Heap a -> Heap a -> Heap a
union Heap a
x Heap a
x) (a -> a -> a
forall a. Integral a => a -> a -> a
quot (a
y a -> a -> a
forall a. Num a => a -> a -> a
- a
1) a
2) Heap a
x
g :: Heap a -> a -> Heap a -> Heap a
g Heap a
x a
y Heap a
z
| a -> Bool
forall a. Integral a => a -> Bool
even a
y = Heap a -> a -> Heap a -> Heap a
g (Heap a -> Heap a -> Heap a
forall a. Heap a -> Heap a -> Heap a
union Heap a
x Heap a
x) (a -> a -> a
forall a. Integral a => a -> a -> a
quot a
y a
2) Heap a
z
| a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 = Heap a -> Heap a -> Heap a
forall a. Heap a -> Heap a -> Heap a
union Heap a
x Heap a
z
| Bool
otherwise = Heap a -> a -> Heap a -> Heap a
g (Heap a -> Heap a -> Heap a
forall a. Heap a -> Heap a -> Heap a
union Heap a
x Heap a
x) (a -> a -> a
forall a. Integral a => a -> a -> a
quot (a
y a -> a -> a
forall a. Num a => a -> a -> a
- a
1) a
2) (Heap a -> Heap a -> Heap a
forall a. Heap a -> Heap a -> Heap a
union Heap a
x Heap a
z)
{-# INLINE replicate #-}
uncons :: Heap a -> Maybe (a, Heap a)
uncons :: Heap a -> Maybe (a, Heap a)
uncons Heap a
Empty = Maybe (a, Heap a)
forall a. Maybe a
Nothing
uncons l :: Heap a
l@(Heap Int
_ a -> a -> Bool
_ Tree a
t) = (a, Heap a) -> Maybe (a, Heap a)
forall a. a -> Maybe a
Just (Tree a -> a
forall a. Tree a -> a
root Tree a
t, Heap a -> Heap a
forall a. Heap a -> Heap a
deleteMin Heap a
l)
{-# INLINE uncons #-}
viewMin :: Heap a -> Maybe (a, Heap a)
viewMin :: Heap a -> Maybe (a, Heap a)
viewMin = Heap a -> Maybe (a, Heap a)
forall a. Heap a -> Maybe (a, Heap a)
uncons
{-# INLINE viewMin #-}
minimum :: Heap a -> a
minimum :: Heap a -> a
minimum Heap a
Empty = String -> a
forall a. HasCallStack => String -> a
error String
"Heap.minimum: empty heap"
minimum (Heap Int
_ a -> a -> Bool
_ Tree a
t) = Tree a -> a
forall a. Tree a -> a
root Tree a
t
{-# INLINE minimum #-}
trees :: Forest a -> [Tree a]
trees :: Forest a -> [Tree a]
trees (Tree a
a `Cons` Forest a
as) = Tree a
a Tree a -> [Tree a] -> [Tree a]
forall a. a -> [a] -> [a]
: Forest a -> [Tree a]
forall a. Forest a -> [Tree a]
trees Forest a
as
trees Forest a
Nil = []
deleteMin :: Heap a -> Heap a
deleteMin :: Heap a -> Heap a
deleteMin Heap a
Empty = Heap a
forall a. Heap a
Empty
deleteMin (Heap Int
_ a -> a -> Bool
_ (Node Int
_ a
_ Forest a
Nil)) = Heap a
forall a. Heap a
Empty
deleteMin (Heap Int
s a -> a -> Bool
leq (Node Int
_ a
_ Forest a
f0)) = Int -> (a -> a -> Bool) -> Tree a -> Heap a
forall a. Int -> (a -> a -> Bool) -> Tree a -> Heap a
Heap (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) a -> a -> Bool
leq (Int -> a -> Forest a -> Tree a
forall a. Int -> a -> Forest a -> Tree a
Node Int
0 a
x Forest a
f3)
where
(Node Int
r a
x Forest a
cf, Forest a
ts2) = (a -> a -> Bool) -> Forest a -> (Tree a, Forest a)
forall a. (a -> a -> Bool) -> Forest a -> (Tree a, Forest a)
getMin a -> a -> Bool
leq Forest a
f0
(Forest a
zs, Forest a
ts1, Forest a
f1) = Int
-> Forest a
-> Forest a
-> Forest a
-> (Forest a, Forest a, Forest a)
forall a.
Int
-> Forest a
-> Forest a
-> Forest a
-> (Forest a, Forest a, Forest a)
splitForest Int
r Forest a
forall a. Forest a
Nil Forest a
forall a. Forest a
Nil Forest a
cf
f2 :: Forest a
f2 = (a -> a -> Bool) -> Forest a -> Forest a -> Forest a
forall a. (a -> a -> Bool) -> Forest a -> Forest a -> Forest a
skewMeld a -> a -> Bool
leq ((a -> a -> Bool) -> Forest a -> Forest a -> Forest a
forall a. (a -> a -> Bool) -> Forest a -> Forest a -> Forest a
skewMeld a -> a -> Bool
leq Forest a
ts1 Forest a
ts2) Forest a
f1
f3 :: Forest a
f3 = (Tree a -> Forest a -> Forest a)
-> Forest a -> [Tree a] -> Forest a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((a -> a -> Bool) -> Tree a -> Forest a -> Forest a
forall a. (a -> a -> Bool) -> Tree a -> Forest a -> Forest a
skewInsert a -> a -> Bool
leq) Forest a
f2 (Forest a -> [Tree a]
forall a. Forest a -> [Tree a]
trees Forest a
zs)
{-# INLINE deleteMin #-}
adjustMin :: (a -> a) -> Heap a -> Heap a
adjustMin :: (a -> a) -> Heap a -> Heap a
adjustMin a -> a
_ Heap a
Empty = Heap a
forall a. Heap a
Empty
adjustMin a -> a
f (Heap Int
s a -> a -> Bool
leq (Node Int
r a
x Forest a
xs)) = Int -> (a -> a -> Bool) -> Tree a -> Heap a
forall a. Int -> (a -> a -> Bool) -> Tree a -> Heap a
Heap Int
s a -> a -> Bool
leq ((a -> a -> Bool) -> Tree a -> Tree a
forall a. (a -> a -> Bool) -> Tree a -> Tree a
heapify a -> a -> Bool
leq (Int -> a -> Forest a -> Tree a
forall a. Int -> a -> Forest a -> Tree a
Node Int
r (a -> a
f a
x) Forest a
xs))
{-# INLINE adjustMin #-}
type ForestZipper a = (Forest a, Forest a)
zipper :: Forest a -> ForestZipper a
zipper :: Forest a -> ForestZipper a
zipper Forest a
xs = (Forest a
forall a. Forest a
Nil, Forest a
xs)
{-# INLINE zipper #-}
emptyZ :: ForestZipper a
emptyZ :: ForestZipper a
emptyZ = (Forest a
forall a. Forest a
Nil, Forest a
forall a. Forest a
Nil)
{-# INLINE emptyZ #-}
rightZ :: ForestZipper a -> ForestZipper a
rightZ :: ForestZipper a -> ForestZipper a
rightZ (Forest a
path, Tree a
x `Cons` Forest a
xs) = (Tree a
x Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
path, Forest a
xs)
{-# INLINE rightZ #-}
adjustZ :: (Tree a -> Tree a) -> ForestZipper a -> ForestZipper a
adjustZ :: (Tree a -> Tree a) -> ForestZipper a -> ForestZipper a
adjustZ Tree a -> Tree a
f (Forest a
path, Tree a
x `Cons` Forest a
xs) = (Forest a
path, Tree a -> Tree a
f Tree a
x Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
xs)
adjustZ Tree a -> Tree a
_ ForestZipper a
z = ForestZipper a
z
{-# INLINE adjustZ #-}
rezip :: ForestZipper a -> Forest a
rezip :: ForestZipper a -> Forest a
rezip (Forest a
Nil, Forest a
xs) = Forest a
xs
rezip (Tree a
x `Cons` Forest a
path, Forest a
xs) = ForestZipper a -> Forest a
forall a. ForestZipper a -> Forest a
rezip (Forest a
path, Tree a
x Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
xs)
rootZ :: ForestZipper a -> a
rootZ :: ForestZipper a -> a
rootZ (Forest a
_ , Tree a
x `Cons` Forest a
_) = Tree a -> a
forall a. Tree a -> a
root Tree a
x
rootZ ForestZipper a
_ = String -> a
forall a. HasCallStack => String -> a
error String
"Heap.rootZ: empty zipper"
{-# INLINE rootZ #-}
minZ :: (a -> a -> Bool) -> Forest a -> ForestZipper a
minZ :: (a -> a -> Bool) -> Forest a -> ForestZipper a
minZ a -> a -> Bool
_ Forest a
Nil = ForestZipper a
forall a. ForestZipper a
emptyZ
minZ a -> a -> Bool
f Forest a
xs = (a -> a -> Bool)
-> ForestZipper a -> ForestZipper a -> ForestZipper a
forall a.
(a -> a -> Bool)
-> ForestZipper a -> ForestZipper a -> ForestZipper a
minZ' a -> a -> Bool
f ForestZipper a
z ForestZipper a
z
where z :: ForestZipper a
z = Forest a -> ForestZipper a
forall a. Forest a -> ForestZipper a
zipper Forest a
xs
{-# INLINE minZ #-}
minZ' :: (a -> a -> Bool) -> ForestZipper a -> ForestZipper a -> ForestZipper a
minZ' :: (a -> a -> Bool)
-> ForestZipper a -> ForestZipper a -> ForestZipper a
minZ' a -> a -> Bool
_ ForestZipper a
lo (Forest a
_, Forest a
Nil) = ForestZipper a
lo
minZ' a -> a -> Bool
leq ForestZipper a
lo ForestZipper a
z = (a -> a -> Bool)
-> ForestZipper a -> ForestZipper a -> ForestZipper a
forall a.
(a -> a -> Bool)
-> ForestZipper a -> ForestZipper a -> ForestZipper a
minZ' a -> a -> Bool
leq (if a -> a -> Bool
leq (ForestZipper a -> a
forall a. ForestZipper a -> a
rootZ ForestZipper a
lo) (ForestZipper a -> a
forall a. ForestZipper a -> a
rootZ ForestZipper a
z) then ForestZipper a
lo else ForestZipper a
z) (ForestZipper a -> ForestZipper a
forall a. ForestZipper a -> ForestZipper a
rightZ ForestZipper a
z)
heapify :: (a -> a -> Bool) -> Tree a -> Tree a
heapify :: (a -> a -> Bool) -> Tree a -> Tree a
heapify a -> a -> Bool
_ n :: Tree a
n@(Node Int
_ a
_ Forest a
Nil) = Tree a
n
heapify a -> a -> Bool
leq n :: Tree a
n@(Node Int
r a
a Forest a
as)
| a -> a -> Bool
leq a
a a
a' = Tree a
n
| Bool
otherwise = Int -> a -> Forest a -> Tree a
forall a. Int -> a -> Forest a -> Tree a
Node Int
r a
a' (ForestZipper a -> Forest a
forall a. ForestZipper a -> Forest a
rezip (Forest a
left, (a -> a -> Bool) -> Tree a -> Tree a
forall a. (a -> a -> Bool) -> Tree a -> Tree a
heapify a -> a -> Bool
leq (Int -> a -> Forest a -> Tree a
forall a. Int -> a -> Forest a -> Tree a
Node Int
r' a
a Forest a
as') Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
right))
where
(Forest a
left, Node Int
r' a
a' Forest a
as' `Cons` Forest a
right) = (a -> a -> Bool) -> Forest a -> ForestZipper a
forall a. (a -> a -> Bool) -> Forest a -> ForestZipper a
minZ a -> a -> Bool
leq Forest a
as
fromList :: Ord a => [a] -> Heap a
fromList :: [a] -> Heap a
fromList = (a -> Heap a -> Heap a) -> Heap a -> [a] -> Heap a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> Heap a -> Heap a
forall a. Ord a => a -> Heap a -> Heap a
insert Heap a
forall a. Monoid a => a
mempty
{-# INLINE fromList #-}
fromListWith :: (a -> a -> Bool) -> [a] -> Heap a
fromListWith :: (a -> a -> Bool) -> [a] -> Heap a
fromListWith a -> a -> Bool
f = (a -> Heap a -> Heap a) -> Heap a -> [a] -> Heap a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((a -> a -> Bool) -> a -> Heap a -> Heap a
forall a. (a -> a -> Bool) -> a -> Heap a -> Heap a
insertWith a -> a -> Bool
f) Heap a
forall a. Monoid a => a
mempty
{-# INLINE fromListWith #-}
sort :: Ord a => [a] -> [a]
sort :: [a] -> [a]
sort = Heap a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (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
{-# INLINE sort #-}
#if MIN_VERSION_base(4,9,0)
instance Semigroup (Heap a) where
<> :: Heap a -> Heap a -> Heap a
(<>) = Heap a -> Heap a -> Heap a
forall a. Heap a -> Heap a -> Heap a
union
{-# INLINE (<>) #-}
#endif
instance Monoid (Heap a) where
mempty :: Heap a
mempty = Heap a
forall a. Heap a
empty
{-# INLINE mempty #-}
#if !(MIN_VERSION_base(4,11,0))
mappend = union
{-# INLINE mappend #-}
#endif
toUnsortedList :: Heap a -> [a]
toUnsortedList :: Heap a -> [a]
toUnsortedList Heap a
Empty = []
toUnsortedList (Heap Int
_ a -> a -> Bool
_ Tree a
t) = (a -> [a]) -> Tree a -> [a]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return Tree a
t
{-# INLINE toUnsortedList #-}
instance Foldable Heap where
foldMap :: (a -> m) -> Heap a -> m
foldMap a -> m
_ Heap a
Empty = m
forall a. Monoid a => a
mempty
foldMap a -> m
f l :: Heap a
l@(Heap Int
_ a -> a -> Bool
_ Tree a
t) = a -> m
f (Tree a -> a
forall a. Tree a -> a
root Tree a
t) m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> Heap a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f (Heap a -> Heap a
forall a. Heap a -> Heap a
deleteMin Heap a
l)
#if __GLASGOW_HASKELL__ >= 710
null :: Heap a -> Bool
null Heap a
Empty = Bool
True
null Heap a
_ = Bool
False
length :: Heap a -> Int
length = Heap a -> Int
forall a. Heap a -> Int
size
#else
null :: Heap a -> Bool
null Empty = True
null _ = False
{-# INLINE null #-}
#endif
size :: Heap a -> Int
size :: Heap a -> Int
size Heap a
Empty = Int
0
size (Heap Int
s a -> a -> Bool
_ Tree a
_) = Int
s
{-# INLINE size #-}
map :: Ord b => (a -> b) -> Heap a -> Heap b
map :: (a -> b) -> Heap a -> Heap b
map a -> b
_ Heap a
Empty = Heap b
forall a. Heap a
Empty
map a -> b
f (Heap Int
_ a -> a -> Bool
_ Tree a
t) = (a -> Heap b) -> Tree a -> Heap b
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (b -> Heap b
forall a. Ord a => a -> Heap a
singleton (b -> Heap b) -> (a -> b) -> a -> Heap b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) Tree a
t
{-# INLINE map #-}
mapMonotonic :: Ord b => (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 -> a -> Bool
_ Tree a
t) = Int -> (b -> b -> Bool) -> Tree b -> Heap b
forall a. Int -> (a -> a -> Bool) -> Tree a -> Heap a
Heap Int
s b -> b -> Bool
forall a. Ord a => a -> a -> Bool
(<=) ((a -> b) -> Tree a -> Tree b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Tree a
t)
{-# INLINE mapMonotonic #-}
filter :: (a -> Bool) -> Heap a -> Heap a
filter :: (a -> Bool) -> Heap a -> Heap a
filter a -> Bool
_ Heap a
Empty = Heap a
forall a. Heap a
Empty
filter a -> Bool
p (Heap Int
_ a -> a -> Bool
leq Tree a
t) = (a -> Heap a) -> Tree a -> Heap a
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> Heap a
f Tree a
t
where
f :: a -> Heap a
f a
x | a -> Bool
p a
x = (a -> a -> Bool) -> a -> Heap a
forall a. (a -> a -> Bool) -> a -> Heap a
singletonWith a -> a -> Bool
leq a
x
| Bool
otherwise = Heap a
forall a. Heap a
Empty
{-# INLINE filter #-}
partition :: (a -> Bool) -> Heap a -> (Heap a, Heap a)
partition :: (a -> Bool) -> Heap a -> (Heap a, Heap a)
partition a -> Bool
_ Heap a
Empty = (Heap a
forall a. Heap a
Empty, Heap a
forall a. Heap a
Empty)
partition a -> Bool
p (Heap Int
_ a -> a -> Bool
leq Tree a
t) = (a -> (Heap a, Heap a)) -> Tree a -> (Heap a, Heap a)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> (Heap a, Heap a)
f Tree a
t
where
f :: a -> (Heap a, Heap a)
f a
x | a -> Bool
p a
x = ((a -> a -> Bool) -> a -> Heap a
forall a. (a -> a -> Bool) -> a -> Heap a
singletonWith a -> a -> Bool
leq a
x, Heap a
forall a. Monoid a => a
mempty)
| Bool
otherwise = (Heap a
forall a. Monoid a => a
mempty, (a -> a -> Bool) -> a -> Heap a
forall a. (a -> a -> Bool) -> a -> Heap a
singletonWith a -> a -> Bool
leq a
x)
{-# INLINE partition #-}
split :: a -> Heap a -> (Heap a, Heap a, Heap a)
split :: a -> Heap a -> (Heap a, Heap a, Heap a)
split a
a Heap a
Empty = (Heap a
forall a. Heap a
Empty, Heap a
forall a. Heap a
Empty, Heap a
forall a. Heap a
Empty)
split a
a (Heap Int
s a -> a -> Bool
leq Tree a
t) = (a -> (Heap a, Heap a, Heap a))
-> Tree a -> (Heap a, Heap a, Heap a)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> (Heap a, Heap a, Heap a)
f Tree a
t
where
f :: a -> (Heap a, Heap a, Heap a)
f a
x = if a -> a -> Bool
leq a
x a
a
then if a -> a -> Bool
leq a
a a
x
then (Heap a
forall a. Monoid a => a
mempty, (a -> a -> Bool) -> a -> Heap a
forall a. (a -> a -> Bool) -> a -> Heap a
singletonWith a -> a -> Bool
leq a
x, Heap a
forall a. Monoid a => a
mempty)
else ((a -> a -> Bool) -> a -> Heap a
forall a. (a -> a -> Bool) -> a -> Heap a
singletonWith a -> a -> Bool
leq a
x, Heap a
forall a. Monoid a => a
mempty, Heap a
forall a. Monoid a => a
mempty)
else (Heap a
forall a. Monoid a => a
mempty, Heap a
forall a. Monoid a => a
mempty, (a -> a -> Bool) -> a -> Heap a
forall a. (a -> a -> Bool) -> a -> Heap a
singletonWith a -> a -> Bool
leq a
x)
{-# INLINE split #-}
take :: Int -> Heap a -> Heap a
take :: Int -> Heap a -> Heap a
take = ([a] -> [a]) -> Heap a -> Heap a
forall a. ([a] -> [a]) -> Heap a -> Heap a
withList (([a] -> [a]) -> Heap a -> Heap a)
-> (Int -> [a] -> [a]) -> Int -> Heap a -> Heap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
L.take
{-# INLINE take #-}
drop :: Int -> Heap a -> Heap a
drop :: Int -> Heap a -> Heap a
drop = ([a] -> [a]) -> Heap a -> Heap a
forall a. ([a] -> [a]) -> Heap a -> Heap a
withList (([a] -> [a]) -> Heap a -> Heap a)
-> (Int -> [a] -> [a]) -> Int -> Heap a -> Heap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
L.drop
{-# INLINE drop #-}
splitAt :: Int -> Heap a -> (Heap a, Heap a)
splitAt :: Int -> Heap a -> (Heap a, Heap a)
splitAt = ([a] -> ([a], [a])) -> Heap a -> (Heap a, Heap a)
forall a. ([a] -> ([a], [a])) -> Heap a -> (Heap a, Heap a)
splitWithList (([a] -> ([a], [a])) -> Heap a -> (Heap a, Heap a))
-> (Int -> [a] -> ([a], [a])) -> Int -> Heap a -> (Heap a, Heap a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
L.splitAt
{-# INLINE splitAt #-}
break :: (a -> Bool) -> Heap a -> (Heap a, Heap a)
break :: (a -> Bool) -> Heap a -> (Heap a, Heap a)
break = ([a] -> ([a], [a])) -> Heap a -> (Heap a, Heap a)
forall a. ([a] -> ([a], [a])) -> Heap a -> (Heap a, Heap a)
splitWithList (([a] -> ([a], [a])) -> Heap a -> (Heap a, Heap a))
-> ((a -> Bool) -> [a] -> ([a], [a]))
-> (a -> Bool)
-> Heap a
-> (Heap a, Heap a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.break
{-# INLINE break #-}
span :: (a -> Bool) -> Heap a -> (Heap a, Heap a)
span :: (a -> Bool) -> Heap a -> (Heap a, Heap a)
span = ([a] -> ([a], [a])) -> Heap a -> (Heap a, Heap a)
forall a. ([a] -> ([a], [a])) -> Heap a -> (Heap a, Heap a)
splitWithList (([a] -> ([a], [a])) -> Heap a -> (Heap a, Heap a))
-> ((a -> Bool) -> [a] -> ([a], [a]))
-> (a -> Bool)
-> Heap a
-> (Heap a, Heap a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.span
{-# INLINE span #-}
takeWhile :: (a -> Bool) -> Heap a -> Heap a
takeWhile :: (a -> Bool) -> Heap a -> Heap a
takeWhile = ([a] -> [a]) -> Heap a -> Heap a
forall a. ([a] -> [a]) -> Heap a -> Heap a
withList (([a] -> [a]) -> Heap a -> Heap a)
-> ((a -> Bool) -> [a] -> [a]) -> (a -> Bool) -> Heap a -> Heap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
L.takeWhile
{-# INLINE takeWhile #-}
dropWhile :: (a -> Bool) -> Heap a -> Heap a
dropWhile :: (a -> Bool) -> Heap a -> Heap a
dropWhile = ([a] -> [a]) -> Heap a -> Heap a
forall a. ([a] -> [a]) -> Heap a -> Heap a
withList (([a] -> [a]) -> Heap a -> Heap a)
-> ((a -> Bool) -> [a] -> [a]) -> (a -> Bool) -> Heap a -> Heap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
L.dropWhile
{-# INLINE dropWhile #-}
nub :: Heap a -> Heap a
nub :: Heap a -> Heap a
nub Heap a
Empty = Heap a
forall a. Heap a
Empty
nub h :: Heap a
h@(Heap Int
_ a -> a -> Bool
leq Tree a
t) = (a -> a -> Bool) -> a -> Heap a -> Heap a
forall a. (a -> a -> Bool) -> a -> Heap a -> Heap a
insertWith a -> a -> Bool
leq a
x (Heap a -> Heap a
forall a. Heap a -> Heap a
nub Heap a
zs)
where
x :: a
x = Tree a -> a
forall a. Tree a -> a
root Tree a
t
xs :: Heap a
xs = Heap a -> Heap a
forall a. Heap a -> Heap a
deleteMin Heap a
h
zs :: Heap a
zs = (a -> Bool) -> Heap a -> Heap a
forall a. (a -> Bool) -> Heap a -> Heap a
dropWhile (a -> a -> Bool
`leq` a
x) Heap a
xs
{-# INLINE nub #-}
concatMap :: (a -> Heap b) -> Heap a -> Heap b
concatMap :: (a -> Heap b) -> Heap a -> Heap b
concatMap a -> Heap b
_ Heap a
Empty = Heap b
forall a. Heap a
Empty
concatMap a -> Heap b
f h :: Heap a
h@(Heap Int
_ a -> a -> Bool
_ Tree a
t) = (a -> Heap b) -> Tree a -> Heap b
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> Heap b
f Tree a
t
{-# INLINE concatMap #-}
group :: Heap a -> Heap (Heap a)
group :: Heap a -> Heap (Heap a)
group Heap a
Empty = Heap (Heap a)
forall a. Heap a
Empty
group h :: Heap a
h@(Heap Int
_ a -> a -> Bool
leq Tree a
_) = (a -> a -> Bool) -> Heap a -> Heap (Heap a)
forall a. (a -> a -> Bool) -> Heap a -> Heap (Heap a)
groupBy ((a -> a -> Bool) -> a -> a -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> a -> Bool
leq) Heap a
h
{-# INLINE group #-}
groupBy :: (a -> a -> Bool) -> Heap a -> Heap (Heap a)
groupBy :: (a -> a -> Bool) -> Heap a -> Heap (Heap a)
groupBy a -> a -> Bool
f Heap a
Empty = Heap (Heap a)
forall a. Heap a
Empty
groupBy a -> a -> Bool
f h :: Heap a
h@(Heap Int
_ a -> a -> Bool
leq Tree a
t) = Heap a -> Heap (Heap a) -> Heap (Heap a)
forall a. Ord a => a -> Heap a -> Heap a
insert ((a -> a -> Bool) -> a -> Heap a -> Heap a
forall a. (a -> a -> Bool) -> a -> Heap a -> Heap a
insertWith a -> a -> Bool
leq a
x Heap a
ys) ((a -> a -> Bool) -> Heap a -> Heap (Heap a)
forall a. (a -> a -> Bool) -> Heap a -> Heap (Heap a)
groupBy a -> a -> Bool
f Heap a
zs)
where
x :: a
x = Tree a -> a
forall a. Tree a -> a
root Tree a
t
xs :: Heap a
xs = Heap a -> Heap a
forall a. Heap a -> Heap a
deleteMin Heap a
h
(Heap a
ys,Heap a
zs) = (a -> Bool) -> Heap a -> (Heap a, Heap a)
forall a. (a -> Bool) -> Heap a -> (Heap a, Heap a)
span (a -> a -> Bool
f a
x) Heap a
xs
{-# INLINE groupBy #-}
intersect :: Heap a -> Heap a -> Heap a
intersect :: Heap a -> Heap a -> Heap a
intersect Heap a
Empty Heap a
_ = Heap a
forall a. Heap a
Empty
intersect Heap a
_ Heap a
Empty = Heap a
forall a. Heap a
Empty
intersect a :: Heap a
a@(Heap Int
_ a -> a -> Bool
leq Tree a
_) Heap a
b = (a -> a -> Bool) -> [a] -> [a] -> Heap a
forall t. (t -> t -> Bool) -> [t] -> [t] -> Heap t
go a -> a -> Bool
leq (Heap a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Heap a
a) (Heap a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Heap a
b)
where
go :: (t -> t -> Bool) -> [t] -> [t] -> Heap t
go t -> t -> Bool
leq' xxs :: [t]
xxs@(t
x:[t]
xs) yys :: [t]
yys@(t
y:[t]
ys) =
if t -> t -> Bool
leq' t
x t
y
then if t -> t -> Bool
leq' t
y t
x
then (t -> t -> Bool) -> t -> Heap t -> Heap t
forall a. (a -> a -> Bool) -> a -> Heap a -> Heap a
insertWith t -> t -> Bool
leq' t
x ((t -> t -> Bool) -> [t] -> [t] -> Heap t
go t -> t -> Bool
leq' [t]
xs [t]
ys)
else (t -> t -> Bool) -> [t] -> [t] -> Heap t
go t -> t -> Bool
leq' [t]
xs [t]
yys
else (t -> t -> Bool) -> [t] -> [t] -> Heap t
go t -> t -> Bool
leq' [t]
xxs [t]
ys
go t -> t -> Bool
_ [] [t]
_ = Heap t
forall a. Heap a
empty
go t -> t -> Bool
_ [t]
_ [] = Heap t
forall a. Heap a
empty
{-# INLINE intersect #-}
intersectWith :: Ord b => (a -> a -> b) -> Heap a -> Heap a -> Heap b
intersectWith :: (a -> a -> b) -> Heap a -> Heap a -> Heap b
intersectWith a -> a -> b
_ Heap a
Empty Heap a
_ = Heap b
forall a. Heap a
Empty
intersectWith a -> a -> b
_ Heap a
_ Heap a
Empty = Heap b
forall a. Heap a
Empty
intersectWith a -> a -> b
f a :: Heap a
a@(Heap Int
_ a -> a -> Bool
leq Tree a
_) Heap a
b = (a -> a -> Bool) -> (a -> a -> b) -> [a] -> [a] -> Heap b
forall b a.
Ord b =>
(a -> a -> Bool) -> (a -> a -> b) -> [a] -> [a] -> Heap b
go a -> a -> Bool
leq a -> a -> b
f (Heap a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Heap a
a) (Heap a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Heap a
b)
where
go :: Ord b => (a -> a -> Bool) -> (a -> a -> b) -> [a] -> [a] -> Heap b
go :: (a -> a -> Bool) -> (a -> a -> b) -> [a] -> [a] -> Heap b
go a -> a -> Bool
leq' a -> a -> b
f' xxs :: [a]
xxs@(a
x:[a]
xs) yys :: [a]
yys@(a
y:[a]
ys)
| a -> a -> Bool
leq' a
x a
y =
if a -> a -> Bool
leq' a
y a
x
then b -> Heap b -> Heap b
forall a. Ord a => a -> Heap a -> Heap a
insert (a -> a -> b
f' a
x a
y) ((a -> a -> Bool) -> (a -> a -> b) -> [a] -> [a] -> Heap b
forall b a.
Ord b =>
(a -> a -> Bool) -> (a -> a -> b) -> [a] -> [a] -> Heap b
go a -> a -> Bool
leq' a -> a -> b
f' [a]
xs [a]
ys)
else (a -> a -> Bool) -> (a -> a -> b) -> [a] -> [a] -> Heap b
forall b a.
Ord b =>
(a -> a -> Bool) -> (a -> a -> b) -> [a] -> [a] -> Heap b
go a -> a -> Bool
leq' a -> a -> b
f' [a]
xs [a]
yys
| Bool
otherwise = (a -> a -> Bool) -> (a -> a -> b) -> [a] -> [a] -> Heap b
forall b a.
Ord b =>
(a -> a -> Bool) -> (a -> a -> b) -> [a] -> [a] -> Heap b
go a -> a -> Bool
leq' a -> a -> b
f' [a]
xxs [a]
ys
go a -> a -> Bool
_ a -> a -> b
_ [] [a]
_ = Heap b
forall a. Heap a
empty
go a -> a -> Bool
_ a -> a -> b
_ [a]
_ [] = Heap b
forall a. Heap a
empty
{-# INLINE intersectWith #-}
traverse :: (Applicative t, Ord b) => (a -> t b) -> Heap a -> t (Heap b)
traverse :: (a -> t b) -> Heap a -> t (Heap b)
traverse a -> t b
f = ([b] -> Heap b) -> t [b] -> t (Heap b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [b] -> Heap b
forall a. Ord a => [a] -> Heap a
fromList (t [b] -> t (Heap b)) -> (Heap a -> t [b]) -> Heap a -> t (Heap b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> t b) -> [a] -> t [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Traversable.traverse a -> t b
f ([a] -> t [b]) -> (Heap a -> [a]) -> Heap a -> t [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Heap a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
{-# INLINE traverse #-}
mapM :: (Monad m, Ord b) => (a -> m b) -> Heap a -> m (Heap b)
mapM :: (a -> m b) -> Heap a -> m (Heap b)
mapM a -> m b
f = ([b] -> Heap b) -> m [b] -> m (Heap b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [b] -> Heap b
forall a. Ord a => [a] -> Heap a
fromList (m [b] -> m (Heap b)) -> (Heap a -> m [b]) -> Heap a -> m (Heap b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m b) -> [a] -> m [b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
Traversable.mapM a -> m b
f ([a] -> m [b]) -> (Heap a -> [a]) -> Heap a -> m [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Heap a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
{-# INLINE mapM #-}
both :: (a -> b) -> (a, a) -> (b, b)
both :: (a -> b) -> (a, a) -> (b, b)
both a -> b
f (a
a,a
b) = (a -> b
f a
a, a -> b
f a
b)
{-# INLINE both #-}
data Tree a = Node
{ Tree a -> Int
rank :: {-# UNPACK #-} !Int
, Tree a -> a
root :: a
, Tree a -> Forest a
_forest :: !(Forest a)
} deriving (Int -> Tree a -> ShowS
[Tree a] -> ShowS
Tree a -> String
(Int -> Tree a -> ShowS)
-> (Tree a -> String) -> ([Tree a] -> ShowS) -> Show (Tree a)
forall a. Show a => Int -> Tree a -> ShowS
forall a. Show a => [Tree a] -> ShowS
forall a. Show a => Tree a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tree a] -> ShowS
$cshowList :: forall a. Show a => [Tree a] -> ShowS
show :: Tree a -> String
$cshow :: forall a. Show a => Tree a -> String
showsPrec :: Int -> Tree a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Tree a -> ShowS
Show,ReadPrec [Tree a]
ReadPrec (Tree a)
Int -> ReadS (Tree a)
ReadS [Tree a]
(Int -> ReadS (Tree a))
-> ReadS [Tree a]
-> ReadPrec (Tree a)
-> ReadPrec [Tree a]
-> Read (Tree a)
forall a. Read a => ReadPrec [Tree a]
forall a. Read a => ReadPrec (Tree a)
forall a. Read a => Int -> ReadS (Tree a)
forall a. Read a => ReadS [Tree a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Tree a]
$creadListPrec :: forall a. Read a => ReadPrec [Tree a]
readPrec :: ReadPrec (Tree a)
$creadPrec :: forall a. Read a => ReadPrec (Tree a)
readList :: ReadS [Tree a]
$creadList :: forall a. Read a => ReadS [Tree a]
readsPrec :: Int -> ReadS (Tree a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Tree a)
Read,Typeable)
data Forest a = !(Tree a) `Cons` !(Forest a) | Nil
deriving (Int -> Forest a -> ShowS
[Forest a] -> ShowS
Forest a -> String
(Int -> Forest a -> ShowS)
-> (Forest a -> String) -> ([Forest a] -> ShowS) -> Show (Forest a)
forall a. Show a => Int -> Forest a -> ShowS
forall a. Show a => [Forest a] -> ShowS
forall a. Show a => Forest a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Forest a] -> ShowS
$cshowList :: forall a. Show a => [Forest a] -> ShowS
show :: Forest a -> String
$cshow :: forall a. Show a => Forest a -> String
showsPrec :: Int -> Forest a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Forest a -> ShowS
Show,ReadPrec [Forest a]
ReadPrec (Forest a)
Int -> ReadS (Forest a)
ReadS [Forest a]
(Int -> ReadS (Forest a))
-> ReadS [Forest a]
-> ReadPrec (Forest a)
-> ReadPrec [Forest a]
-> Read (Forest a)
forall a. Read a => ReadPrec [Forest a]
forall a. Read a => ReadPrec (Forest a)
forall a. Read a => Int -> ReadS (Forest a)
forall a. Read a => ReadS [Forest a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Forest a]
$creadListPrec :: forall a. Read a => ReadPrec [Forest a]
readPrec :: ReadPrec (Forest a)
$creadPrec :: forall a. Read a => ReadPrec (Forest a)
readList :: ReadS [Forest a]
$creadList :: forall a. Read a => ReadS [Forest a]
readsPrec :: Int -> ReadS (Forest a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Forest a)
Read,Typeable)
infixr 5 `Cons`
instance Functor Tree where
fmap :: (a -> b) -> Tree a -> Tree b
fmap a -> b
f (Node Int
r a
a Forest a
as) = Int -> b -> Forest b -> Tree b
forall a. Int -> a -> Forest a -> Tree a
Node Int
r (a -> b
f a
a) ((a -> b) -> Forest a -> Forest b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Forest a
as)
instance Functor Forest where
fmap :: (a -> b) -> Forest a -> Forest b
fmap a -> b
f (Tree a
a `Cons` Forest a
as) = (a -> b) -> Tree a -> Tree b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Tree a
a Tree b -> Forest b -> Forest b
forall a. Tree a -> Forest a -> Forest a
`Cons` (a -> b) -> Forest a -> Forest b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Forest a
as
fmap a -> b
_ Forest a
Nil = Forest b
forall a. Forest a
Nil
instance Foldable Tree where
foldMap :: (a -> m) -> Tree a -> m
foldMap a -> m
f (Node Int
_ a
a Forest a
as) = a -> m
f a
a m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> Forest a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Forest a
as
instance Foldable Forest where
foldMap :: (a -> m) -> Forest a -> m
foldMap a -> m
f (Tree a
a `Cons` Forest a
as) = (a -> m) -> Tree a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Tree a
a m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> Forest a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Forest a
as
foldMap a -> m
_ Forest a
Nil = m
forall a. Monoid a => a
mempty
link :: (a -> a -> Bool) -> Tree a -> Tree a -> Tree a
link :: (a -> a -> Bool) -> Tree a -> Tree a -> Tree a
link a -> a -> Bool
f t1 :: Tree a
t1@(Node Int
r1 a
x1 Forest a
cf1) t2 :: Tree a
t2@(Node Int
r2 a
x2 Forest a
cf2)
| a -> a -> Bool
f a
x1 a
x2 = Int -> a -> Forest a -> Tree a
forall a. Int -> a -> Forest a -> Tree a
Node (Int
r1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a
x1 (Tree a
t2 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
cf1)
| Bool
otherwise = Int -> a -> Forest a -> Tree a
forall a. Int -> a -> Forest a -> Tree a
Node (Int
r2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a
x2 (Tree a
t1 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
cf2)
skewLink :: (a -> a -> Bool) -> Tree a -> Tree a -> Tree a -> Tree a
skewLink :: (a -> a -> Bool) -> Tree a -> Tree a -> Tree a -> Tree a
skewLink a -> a -> Bool
f t0 :: Tree a
t0@(Node Int
_ a
x0 Forest a
cf0) t1 :: Tree a
t1@(Node Int
r1 a
x1 Forest a
cf1) t2 :: Tree a
t2@(Node Int
r2 a
x2 Forest a
cf2)
| a -> a -> Bool
f a
x1 a
x0 Bool -> Bool -> Bool
&& a -> a -> Bool
f a
x1 a
x2 = Int -> a -> Forest a -> Tree a
forall a. Int -> a -> Forest a -> Tree a
Node (Int
r1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a
x1 (Tree a
t0 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Tree a
t2 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
cf1)
| a -> a -> Bool
f a
x2 a
x0 Bool -> Bool -> Bool
&& a -> a -> Bool
f a
x2 a
x1 = Int -> a -> Forest a -> Tree a
forall a. Int -> a -> Forest a -> Tree a
Node (Int
r2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a
x2 (Tree a
t0 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Tree a
t1 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
cf2)
| Bool
otherwise = Int -> a -> Forest a -> Tree a
forall a. Int -> a -> Forest a -> Tree a
Node (Int
r1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a
x0 (Tree a
t1 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Tree a
t2 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
cf0)
ins :: (a -> a -> Bool) -> Tree a -> Forest a -> Forest a
ins :: (a -> a -> Bool) -> Tree a -> Forest a -> Forest a
ins a -> a -> Bool
_ Tree a
t Forest a
Nil = Tree a
t Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
forall a. Forest a
Nil
ins a -> a -> Bool
f Tree a
t (Tree a
t' `Cons` Forest a
ts)
| Tree a -> Int
forall a. Tree a -> Int
rank Tree a
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Tree a -> Int
forall a. Tree a -> Int
rank Tree a
t' = Tree a
t Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Tree a
t' Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
ts
| Bool
otherwise = (a -> a -> Bool) -> Tree a -> Forest a -> Forest a
forall a. (a -> a -> Bool) -> Tree a -> Forest a -> Forest a
ins a -> a -> Bool
f ((a -> a -> Bool) -> Tree a -> Tree a -> Tree a
forall a. (a -> a -> Bool) -> Tree a -> Tree a -> Tree a
link a -> a -> Bool
f Tree a
t Tree a
t') Forest a
ts
uniqify :: (a -> a -> Bool) -> Forest a -> Forest a
uniqify :: (a -> a -> Bool) -> Forest a -> Forest a
uniqify a -> a -> Bool
_ Forest a
Nil = Forest a
forall a. Forest a
Nil
uniqify a -> a -> Bool
f (Tree a
t `Cons` Forest a
ts) = (a -> a -> Bool) -> Tree a -> Forest a -> Forest a
forall a. (a -> a -> Bool) -> Tree a -> Forest a -> Forest a
ins a -> a -> Bool
f Tree a
t Forest a
ts
unionUniq :: (a -> a -> Bool) -> Forest a -> Forest a -> Forest a
unionUniq :: (a -> a -> Bool) -> Forest a -> Forest a -> Forest a
unionUniq a -> a -> Bool
_ Forest a
Nil Forest a
ts = Forest a
ts
unionUniq a -> a -> Bool
_ Forest a
ts Forest a
Nil = Forest a
ts
unionUniq a -> a -> Bool
f tts1 :: Forest a
tts1@(Tree a
t1 `Cons` Forest a
ts1) tts2 :: Forest a
tts2@(Tree a
t2 `Cons` Forest a
ts2) = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Tree a -> Int
forall a. Tree a -> Int
rank Tree a
t1) (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. Tree a -> Forest a -> Forest a
`Cons` (a -> a -> Bool) -> Forest a -> Forest a -> Forest a
forall a. (a -> a -> Bool) -> Forest a -> Forest a -> Forest a
unionUniq a -> a -> Bool
f Forest a
ts1 Forest a
tts2
Ordering
EQ -> (a -> a -> Bool) -> Tree a -> Forest a -> Forest a
forall a. (a -> a -> Bool) -> Tree a -> Forest a -> Forest a
ins a -> a -> Bool
f ((a -> a -> Bool) -> Tree a -> Tree a -> Tree a
forall a. (a -> a -> Bool) -> Tree a -> Tree a -> Tree a
link a -> a -> Bool
f Tree a
t1 Tree a
t2) ((a -> a -> Bool) -> Forest a -> Forest a -> Forest a
forall a. (a -> a -> Bool) -> Forest a -> Forest a -> Forest a
unionUniq a -> a -> Bool
f Forest a
ts1 Forest a
ts2)
Ordering
GT -> Tree a
t2 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` (a -> a -> Bool) -> Forest a -> Forest a -> Forest a
forall a. (a -> a -> Bool) -> Forest a -> Forest a -> Forest a
unionUniq a -> a -> Bool
f Forest a
tts1 Forest a
ts2
skewInsert :: (a -> a -> Bool) -> Tree a -> Forest a -> Forest a
skewInsert :: (a -> a -> Bool) -> Tree a -> Forest a -> Forest a
skewInsert a -> a -> Bool
f Tree a
t ts :: Forest a
ts@(Tree a
t1 `Cons` Tree a
t2 `Cons`Forest a
rest)
| 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 -> a -> Bool) -> Tree a -> Tree a -> Tree a -> Tree a
forall a. (a -> a -> Bool) -> Tree a -> Tree a -> Tree a -> Tree a
skewLink a -> a -> Bool
f Tree a
t Tree a
t1 Tree a
t2 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
rest
| Bool
otherwise = Tree a
t Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
ts
skewInsert a -> a -> Bool
_ Tree a
t Forest a
ts = Tree a
t Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
ts
{-# INLINE skewInsert #-}
skewMeld :: (a -> a -> Bool) -> Forest a -> Forest a -> Forest a
skewMeld :: (a -> a -> Bool) -> Forest a -> Forest a -> Forest a
skewMeld a -> a -> Bool
f Forest a
ts Forest a
ts' = (a -> a -> Bool) -> Forest a -> Forest a -> Forest a
forall a. (a -> a -> Bool) -> Forest a -> Forest a -> Forest a
unionUniq a -> a -> Bool
f ((a -> a -> Bool) -> Forest a -> Forest a
forall a. (a -> a -> Bool) -> Forest a -> Forest a
uniqify a -> a -> Bool
f Forest a
ts) ((a -> a -> Bool) -> Forest a -> Forest a
forall a. (a -> a -> Bool) -> Forest a -> Forest a
uniqify a -> a -> Bool
f Forest a
ts')
{-# INLINE skewMeld #-}
getMin :: (a -> a -> Bool) -> Forest a -> (Tree a, Forest a)
getMin :: (a -> a -> Bool) -> Forest a -> (Tree a, Forest a)
getMin a -> a -> Bool
_ (Tree a
t `Cons` Forest a
Nil) = (Tree a
t, Forest a
forall a. Forest a
Nil)
getMin a -> a -> Bool
f (Tree a
t `Cons` Forest a
ts)
| a -> a -> Bool
f (Tree a -> a
forall a. Tree a -> a
root Tree a
t) (Tree a -> a
forall a. Tree a -> a
root Tree a
t') = (Tree a
t, Forest a
ts)
| Bool
otherwise = (Tree a
t', Tree a
t Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
ts')
where (Tree a
t',Forest a
ts') = (a -> a -> Bool) -> Forest a -> (Tree a, Forest a)
forall a. (a -> a -> Bool) -> Forest a -> (Tree a, Forest a)
getMin a -> a -> Bool
f Forest a
ts
getMin a -> a -> Bool
_ Forest a
Nil = String -> (Tree a, Forest a)
forall a. HasCallStack => String -> a
error String
"Heap.getMin: empty forest"
splitForest :: Int -> Forest a -> Forest a -> Forest a -> (Forest a, Forest a, Forest a)
splitForest :: Int
-> Forest a
-> Forest a
-> Forest a
-> (Forest a, Forest a, Forest a)
splitForest Int
a Forest a
b Forest a
c Forest a
d | Int
a Int -> Bool -> Bool
`seq` Forest a
b Forest a -> Bool -> Bool
`seq` Forest a
c Forest a -> Bool -> Bool
`seq` Forest a
d Forest a -> Bool -> Bool
`seq` Bool
False = (Forest a, Forest a, Forest a)
forall a. HasCallStack => a
undefined
splitForest Int
0 Forest a
zs Forest a
ts Forest a
f = (Forest a
zs, Forest a
ts, Forest a
f)
splitForest Int
1 Forest a
zs Forest a
ts (Tree a
t `Cons` Forest a
Nil) = (Forest a
zs, Tree a
t Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
ts, Forest a
forall a. Forest a
Nil)
splitForest Int
1 Forest a
zs Forest a
ts (Tree a
t1 `Cons` Tree a
t2 `Cons` Forest a
f)
| Tree a -> Int
forall a. Tree a -> Int
rank Tree a
t2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = (Tree a
t1 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
zs, Tree a
t2 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
ts, Forest a
f)
| Bool
otherwise = (Forest a
zs, Tree a
t1 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
ts, Tree a
t2 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
f)
splitForest Int
r Forest a
zs Forest a
ts (Tree a
t1 `Cons` Tree a
t2 `Cons` Forest a
cf)
| Int
r1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
r2 = (Forest a
zs, Tree a
t1 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Tree a
t2 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
ts, Forest a
cf)
| Int
r1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int
-> Forest a
-> Forest a
-> Forest a
-> (Forest a, Forest a, Forest a)
forall a.
Int
-> Forest a
-> Forest a
-> Forest a
-> (Forest a, Forest a, Forest a)
splitForest (Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Tree a
t1 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
zs) (Tree a
t2 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
ts) Forest a
cf
| Bool
otherwise = Int
-> Forest a
-> Forest a
-> Forest a
-> (Forest a, Forest a, Forest a)
forall a.
Int
-> Forest a
-> Forest a
-> Forest a
-> (Forest a, Forest a, Forest a)
splitForest (Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Forest a
zs (Tree a
t1 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
ts) (Tree a
t2 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
cf)
where
r1 :: Int
r1 = Tree a -> Int
forall a. Tree a -> Int
rank Tree a
t1
r2 :: Int
r2 = Tree a -> Int
forall a. Tree a -> Int
rank Tree a
t2
splitForest Int
_ Forest a
_ Forest a
_ Forest a
_ = String -> (Forest a, Forest a, Forest a)
forall a. HasCallStack => String -> a
error String
"Heap.splitForest: invalid arguments"
withList :: ([a] -> [a]) -> Heap a -> Heap a
withList :: ([a] -> [a]) -> Heap a -> Heap a
withList [a] -> [a]
_ Heap a
Empty = Heap a
forall a. Heap a
Empty
withList [a] -> [a]
f hp :: Heap a
hp@(Heap Int
_ a -> a -> Bool
leq Tree a
_) = (a -> a -> Bool) -> [a] -> Heap a
forall a. (a -> a -> Bool) -> [a] -> Heap a
fromListWith a -> a -> Bool
leq ([a] -> [a]
f (Heap a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Heap a
hp))
{-# INLINE withList #-}
splitWithList :: ([a] -> ([a],[a])) -> Heap a -> (Heap a, Heap a)
splitWithList :: ([a] -> ([a], [a])) -> Heap a -> (Heap a, Heap a)
splitWithList [a] -> ([a], [a])
_ Heap a
Empty = (Heap a
forall a. Heap a
Empty, Heap a
forall a. Heap a
Empty)
splitWithList [a] -> ([a], [a])
f hp :: Heap a
hp@(Heap Int
_ a -> a -> Bool
leq Tree a
_) = ([a] -> Heap a) -> ([a], [a]) -> (Heap a, Heap a)
forall a b. (a -> b) -> (a, a) -> (b, b)
both ((a -> a -> Bool) -> [a] -> Heap a
forall a. (a -> a -> Bool) -> [a] -> Heap a
fromListWith a -> a -> Bool
leq) ([a] -> ([a], [a])
f (Heap a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Heap a
hp))
{-# INLINE splitWithList #-}
data Entry p a = Entry { Entry p a -> p
priority :: p, Entry p a -> a
payload :: a }
deriving (ReadPrec [Entry p a]
ReadPrec (Entry p a)
Int -> ReadS (Entry p a)
ReadS [Entry p a]
(Int -> ReadS (Entry p a))
-> ReadS [Entry p a]
-> ReadPrec (Entry p a)
-> ReadPrec [Entry p a]
-> Read (Entry p a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall p a. (Read p, Read a) => ReadPrec [Entry p a]
forall p a. (Read p, Read a) => ReadPrec (Entry p a)
forall p a. (Read p, Read a) => Int -> ReadS (Entry p a)
forall p a. (Read p, Read a) => ReadS [Entry p a]
readListPrec :: ReadPrec [Entry p a]
$creadListPrec :: forall p a. (Read p, Read a) => ReadPrec [Entry p a]
readPrec :: ReadPrec (Entry p a)
$creadPrec :: forall p a. (Read p, Read a) => ReadPrec (Entry p a)
readList :: ReadS [Entry p a]
$creadList :: forall p a. (Read p, Read a) => ReadS [Entry p a]
readsPrec :: Int -> ReadS (Entry p a)
$creadsPrec :: forall p a. (Read p, Read a) => Int -> ReadS (Entry p a)
Read,Int -> Entry p a -> ShowS
[Entry p a] -> ShowS
Entry p a -> String
(Int -> Entry p a -> ShowS)
-> (Entry p a -> String)
-> ([Entry p a] -> ShowS)
-> Show (Entry p a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall p a. (Show p, Show a) => Int -> Entry p a -> ShowS
forall p a. (Show p, Show a) => [Entry p a] -> ShowS
forall p a. (Show p, Show a) => Entry p a -> String
showList :: [Entry p a] -> ShowS
$cshowList :: forall p a. (Show p, Show a) => [Entry p a] -> ShowS
show :: Entry p a -> String
$cshow :: forall p a. (Show p, Show a) => Entry p a -> String
showsPrec :: Int -> Entry p a -> ShowS
$cshowsPrec :: forall p a. (Show p, Show a) => Int -> Entry p a -> ShowS
Show,Typeable (Entry p a)
DataType
Constr
Typeable (Entry p a)
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Entry p a -> c (Entry p a))
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Entry p a))
-> (Entry p a -> Constr)
-> (Entry p a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Entry p a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Entry p a)))
-> ((forall b. Data b => b -> b) -> Entry p a -> Entry p a)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Entry p a -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Entry p a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Entry p a -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> Entry p a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Entry p a -> m (Entry p a))
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Entry p a -> m (Entry p a))
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Entry p a -> m (Entry p a))
-> Data (Entry p a)
Entry p a -> DataType
Entry p a -> Constr
(forall b. Data b => b -> b) -> Entry p a -> Entry p a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Entry p a -> c (Entry p a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Entry p a)
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Entry p a))
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Entry p a -> u
forall u. (forall d. Data d => d -> u) -> Entry p a -> [u]
forall p a. (Data p, Data a) => Typeable (Entry p a)
forall p a. (Data p, Data a) => Entry p a -> DataType
forall p a. (Data p, Data a) => Entry p a -> Constr
forall p a.
(Data p, Data a) =>
(forall b. Data b => b -> b) -> Entry p a -> Entry p a
forall p a u.
(Data p, Data a) =>
Int -> (forall d. Data d => d -> u) -> Entry p a -> u
forall p a u.
(Data p, Data a) =>
(forall d. Data d => d -> u) -> Entry p a -> [u]
forall p a r r'.
(Data p, Data a) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Entry p a -> r
forall p a r r'.
(Data p, Data a) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Entry p a -> r
forall p a (m :: * -> *).
(Data p, Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Entry p a -> m (Entry p a)
forall p a (m :: * -> *).
(Data p, Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Entry p a -> m (Entry p a)
forall p a (c :: * -> *).
(Data p, Data a) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Entry p a)
forall p a (c :: * -> *).
(Data p, Data a) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Entry p a -> c (Entry p a)
forall p a (t :: * -> *) (c :: * -> *).
(Data p, Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Entry p a))
forall p a (t :: * -> * -> *) (c :: * -> *).
(Data p, Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Entry p a))
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Entry p a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Entry p a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Entry p a -> m (Entry p a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Entry p a -> m (Entry p a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Entry p a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Entry p a -> c (Entry p a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Entry p a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Entry p a))
$cEntry :: Constr
$tEntry :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Entry p a -> m (Entry p a)
$cgmapMo :: forall p a (m :: * -> *).
(Data p, Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Entry p a -> m (Entry p a)
gmapMp :: (forall d. Data d => d -> m d) -> Entry p a -> m (Entry p a)
$cgmapMp :: forall p a (m :: * -> *).
(Data p, Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Entry p a -> m (Entry p a)
gmapM :: (forall d. Data d => d -> m d) -> Entry p a -> m (Entry p a)
$cgmapM :: forall p a (m :: * -> *).
(Data p, Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Entry p a -> m (Entry p a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> Entry p a -> u
$cgmapQi :: forall p a u.
(Data p, Data a) =>
Int -> (forall d. Data d => d -> u) -> Entry p a -> u
gmapQ :: (forall d. Data d => d -> u) -> Entry p a -> [u]
$cgmapQ :: forall p a u.
(Data p, Data a) =>
(forall d. Data d => d -> u) -> Entry p a -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Entry p a -> r
$cgmapQr :: forall p a r r'.
(Data p, Data a) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Entry p a -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Entry p a -> r
$cgmapQl :: forall p a r r'.
(Data p, Data a) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Entry p a -> r
gmapT :: (forall b. Data b => b -> b) -> Entry p a -> Entry p a
$cgmapT :: forall p a.
(Data p, Data a) =>
(forall b. Data b => b -> b) -> Entry p a -> Entry p a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Entry p a))
$cdataCast2 :: forall p a (t :: * -> * -> *) (c :: * -> *).
(Data p, Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Entry p a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Entry p a))
$cdataCast1 :: forall p a (t :: * -> *) (c :: * -> *).
(Data p, Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Entry p a))
dataTypeOf :: Entry p a -> DataType
$cdataTypeOf :: forall p a. (Data p, Data a) => Entry p a -> DataType
toConstr :: Entry p a -> Constr
$ctoConstr :: forall p a. (Data p, Data a) => Entry p a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Entry p a)
$cgunfold :: forall p a (c :: * -> *).
(Data p, Data a) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Entry p a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Entry p a -> c (Entry p a)
$cgfoldl :: forall p a (c :: * -> *).
(Data p, Data a) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Entry p a -> c (Entry p a)
$cp1Data :: forall p a. (Data p, Data a) => Typeable (Entry p a)
Data,Typeable)
instance Functor (Entry p) where
fmap :: (a -> b) -> Entry p a -> Entry p b
fmap a -> b
f (Entry p
p a
a) = p -> b -> Entry p b
forall p a. p -> a -> Entry p a
Entry p
p (a -> b
f a
a)
{-# INLINE fmap #-}
#if MIN_VERSION_base(4,8,0)
instance Bifunctor Entry where
bimap :: (a -> b) -> (c -> d) -> Entry a c -> Entry b d
bimap a -> b
f c -> d
g (Entry a
p c
a) = b -> d -> Entry b d
forall p a. p -> a -> Entry p a
Entry (a -> b
f a
p) (c -> d
g c
a)
#endif
instance Foldable (Entry p) where
foldMap :: (a -> m) -> Entry p a -> m
foldMap a -> m
f (Entry p
_ a
a) = a -> m
f a
a
{-# INLINE foldMap #-}
instance Traversable (Entry p) where
traverse :: (a -> f b) -> Entry p a -> f (Entry p b)
traverse a -> f b
f (Entry p
p a
a) = p -> b -> Entry p b
forall p a. p -> a -> Entry p a
Entry p
p (b -> Entry p b) -> f b -> f (Entry p b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` a -> f b
f a
a
{-# INLINE traverse #-}
instance Eq p => Eq (Entry p a) where
== :: Entry p a -> Entry p a -> Bool
(==) = p -> p -> Bool
forall a. Eq a => a -> a -> Bool
(==) (p -> p -> Bool)
-> (Entry p a -> p) -> Entry p a -> Entry p a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Entry p a -> p
forall p a. Entry p a -> p
priority
{-# INLINE (==) #-}
instance Ord p => Ord (Entry p a) where
compare :: Entry p a -> Entry p a -> Ordering
compare = p -> p -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (p -> p -> Ordering)
-> (Entry p a -> p) -> Entry p a -> Entry p a -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Entry p a -> p
forall p a. Entry p a -> p
priority
{-# INLINE compare #-}