pqueue 1.2.1 → 1.3.0
raw patch · 9 files changed
+865/−853 lines, 9 filesdep ~basenew-uploader
Dependency ranges changed: base
Files
- Control/Applicative/Identity.hs +3/−3
- Data/PQueue/Internals.hs +203/−197
- Data/PQueue/Max.hs +82/−82
- Data/PQueue/Min.hs +100/−101
- Data/PQueue/Prio/Internals.hs +196/−191
- Data/PQueue/Prio/Max.hs +110/−110
- Data/PQueue/Prio/Max/Internals.hs +12/−13
- Data/PQueue/Prio/Min.hs +133/−132
- pqueue.cabal +26/−24
Control/Applicative/Identity.hs view
@@ -5,8 +5,8 @@ newtype Identity a = Identity {runIdentity :: a} instance Functor Identity where- fmap f (Identity x) = Identity (f x)+ fmap f (Identity x) = Identity (f x) instance Applicative Identity where- pure = Identity- Identity f <*> Identity x = Identity (f x)+ pure = Identity+ Identity f <*> Identity x = Identity (f x)
Data/PQueue/Internals.hs view
@@ -1,39 +1,39 @@ {-# LANGUAGE CPP, StandaloneDeriving #-} module Data.PQueue.Internals (- MinQueue (..),- BinomHeap,- BinomForest(..),- BinomTree(..),- Succ(..),- Zero(..),- LEq,- empty,- null,- size,- getMin,- minView,- singleton,- insert,- union,- mapMaybe,- mapEither,- mapMonotonic,- foldrAsc,- foldlAsc,- insertMinQ,--- mapU,- foldrU,- foldlU,--- traverseU,- keysQueue,- seqSpine- ) where+ MinQueue (..),+ BinomHeap,+ BinomForest(..),+ BinomTree(..),+ Succ(..),+ Zero(..),+ LEq,+ empty,+ null,+ size,+ getMin,+ minView,+ singleton,+ insert,+ union,+ mapMaybe,+ mapEither,+ mapMonotonic,+ foldrAsc,+ foldlAsc,+ insertMinQ,+-- mapU,+ foldrU,+ foldlU,+-- traverseU,+ keysQueue,+ seqSpine+ ) where import Control.DeepSeq import Data.Functor-import Data.Foldable (Foldable (..))+import Data.Foldable (Foldable (foldr, foldl)) import Data.Monoid (Monoid (..)) import qualified Data.PQueue.Prio.Internals as Prio @@ -45,26 +45,31 @@ -- | A priority queue with elements of type @a@. Supports extracting the minimum element. data MinQueue a = Empty | MinQueue {-# UNPACK #-} !Int a !(BinomHeap a)+#if __GLASGOW_HASKELL__>=707+ deriving Typeable+#else+#include "Typeable.h"+INSTANCE_TYPEABLE1(MinQueue,minQTC,"MinQueue")+#endif #ifdef __GLASGOW_HASKELL__ instance (Ord a, Data a) => Data (MinQueue a) where- gfoldl f z q = case minView q of- Nothing -> z Empty- Just (x, q')- -> z insertMinQ `f` x `f` q'- - gunfold k z c = case constrIndex c of- 1 -> z Empty- 2 -> k (k (z insertMinQ))- _ -> error "gunfold"- - dataCast1 x = gcast1 x- - toConstr q- | null q = emptyConstr- | otherwise = consConstr+ gfoldl f z q = case minView q of+ Nothing -> z Empty+ Just (x, q') -> z insertMinQ `f` x `f` q'+ + gunfold k z c = case constrIndex c of+ 1 -> z Empty+ 2 -> k (k (z insertMinQ))+ _ -> error "gunfold"+ + dataCast1 x = gcast1 x+ + toConstr q+ | null q = emptyConstr+ | otherwise = consConstr - dataTypeOf _ = queueDataType+ dataTypeOf _ = queueDataType queueDataType :: DataType queueDataType = mkDataType "Data.PQueue.Min.MinQueue" [emptyConstr, consConstr]@@ -73,41 +78,39 @@ emptyConstr = mkConstr queueDataType "empty" [] Prefix consConstr = mkConstr queueDataType "<|" [] Infix -#include "Typeable.h"-INSTANCE_TYPEABLE1(MinQueue,minQTC,"MinQueue") #endif type BinomHeap = BinomForest Zero instance Ord a => Eq (MinQueue a) where- Empty == Empty = True- MinQueue n1 x1 q1 == MinQueue n2 x2 q2 = n1 == n2 && x1 == x2 && eq' q1 q2 where- eq' q1 q2 = case (extractHeap q1, extractHeap q2) of- (Just (x1, q1'), Just (x2, q2'))- -> x1 == x2 && eq' q1' q2'- (Nothing, Nothing)- -> True- _ -> False- _ == _ = False+ Empty == Empty = True+ MinQueue n1 x1 q1 == MinQueue n2 x2 q2 = n1 == n2 && x1 == x2 && eq' q1 q2 where+ eq' q1 q2 = case (extractHeap q1, extractHeap q2) of+ (Just (x1, q1'), Just (x2, q2'))+ -> x1 == x2 && eq' q1' q2'+ (Nothing, Nothing)+ -> True+ _ -> False+ _ == _ = False instance Ord a => Ord (MinQueue a) where- Empty `compare` Empty = EQ- Empty `compare` _ = LT- _ `compare` Empty = GT- MinQueue n1 x1 q1 `compare` MinQueue n2 x2 q2 = compare x1 x2 `mappend` cmp' q1 q2 where- cmp' q1 q2 = case (extractHeap q1, extractHeap q2) of- (Just (x1, q1'), Just (x2, q2'))- -> compare x1 x2 `mappend` cmp' q1' q2'- (Nothing, Nothing)- -> EQ- (Just{}, Nothing)- -> GT- (Nothing, Just{})- -> LT- - -- We compare their first elements, then their other elements up to the smaller queue's length,- -- and then the longer queue wins.- -- This is equivalent to @comparing toAscList@, except it fuses much more nicely.+ Empty `compare` Empty = EQ+ Empty `compare` _ = LT+ _ `compare` Empty = GT+ MinQueue n1 x1 q1 `compare` MinQueue n2 x2 q2 = compare x1 x2 `mappend` cmp' q1 q2 where+ cmp' q1 q2 = case (extractHeap q1, extractHeap q2) of+ (Just (x1, q1'), Just (x2, q2'))+ -> compare x1 x2 `mappend` cmp' q1' q2'+ (Nothing, Nothing)+ -> EQ+ (Just{}, Nothing)+ -> GT+ (Nothing, Just{})+ -> LT+ + -- We compare their first elements, then their other elements up to the smaller queue's length,+ -- and then the longer queue wins.+ -- This is equivalent to @comparing toAscList@, except it fuses much more nicely. -- We implement tree ranks in the type system with a nicely elegant approach, as follows. -- The goal is to have the type system automatically guarantee that our binomial forest@@ -117,7 +120,7 @@ -- each number to be the set of numbers less than it, and Zero to be the empty set, -- as follows: -- --- 0 = {} 1 = {0} 2 = {0, 1} 3={0, 1, 2} ...+-- 0 = {} 1 = {0} 2 = {0, 1} 3={0, 1, 2} ... -- -- Binomial trees have a similar structure: a tree of rank @k@ has one child of each -- rank less than @k@. Let's define the type @rk@ corresponding to rank @k@ to refer@@ -137,7 +140,7 @@ -- is a type constructor that takes an element type and returns the type of binomial trees -- of rank @3@. data BinomForest rk a = Nil | Skip (BinomForest (Succ rk) a) | - Cons {-# UNPACK #-} !(BinomTree rk a) (BinomForest (Succ rk) a)+ Cons {-# UNPACK #-} !(BinomTree rk a) (BinomForest (Succ rk) a) data BinomTree rk a = BinomTree a (rk a) @@ -159,25 +162,25 @@ -- | /O(1)/. Is this the empty priority queue? null :: MinQueue a -> Bool null Empty = True-null _ = False+null _ = False -- | /O(1)/. The number of elements in the queue. size :: MinQueue a -> Int-size Empty = 0+size Empty = 0 size (MinQueue n _ _) = n -- | Returns the minimum element of the queue, if the queue is nonempty. getMin :: MinQueue a -> Maybe a getMin (MinQueue _ x _) = Just x-getMin _ = Nothing+getMin _ = Nothing -- | Retrieves the minimum element of the queue, and the queue stripped of that element, -- or 'Nothing' if passed an empty queue. minView :: Ord a => MinQueue a -> Maybe (a, MinQueue a) minView Empty = Nothing minView (MinQueue n x ts) = Just (x, case extractHeap ts of- Nothing -> Empty- Just (x', ts') -> MinQueue (n-1) x' ts')+ Nothing -> Empty+ Just (x', ts') -> MinQueue (n-1) x' ts') -- | /O(1)/. Construct a priority queue with a single element. singleton :: a -> MinQueue a@@ -195,14 +198,15 @@ mapMaybe :: Ord b => (a -> Maybe b) -> MinQueue a -> MinQueue b mapMaybe _ Empty = Empty mapMaybe f (MinQueue _ x ts) = maybe q' (`insert` q') (f x)- where q' = mapMaybeQueue f (<=) (const Empty) Empty ts+ where+ q' = mapMaybeQueue f (<=) (const Empty) Empty ts -- | /O(n)/. Map elements and separate the 'Left' and 'Right' results. mapEither :: (Ord b, Ord c) => (a -> Either b c) -> MinQueue a -> (MinQueue b, MinQueue c) mapEither _ Empty = (Empty, Empty) mapEither f (MinQueue _ x ts) = case (mapEitherQueue f (<=) (<=) (const (Empty, Empty)) (Empty, Empty) ts, f x) of- ((qL, qR), Left b) -> (insert b qL, qR)- ((qL, qR), Right c) -> (qL, insert c qR)+ ((qL, qR), Left b) -> (insert b qL, qR)+ ((qL, qR), Right c) -> (qL, insert c qR) -- | /O(n)/. Assumes that the function it is given is monotonic, and applies this function to every element of the priority queue, -- as in 'fmap'. If it is not, the result is undefined.@@ -219,41 +223,42 @@ -- | Equivalent to @foldr f z (unfoldr suc s0)@. foldrUnfold :: (a -> c -> c) -> c -> (b -> Maybe (a, b)) -> b -> c foldrUnfold f z suc s0 = unf s0 where- unf s = case suc s of- Nothing -> z- Just (x, s') -> x `f` unf s'+ unf s = case suc s of+ Nothing -> z+ Just (x, s') -> x `f` unf s' -- | /O(n log n)/. Performs a left-fold on the elements of a priority queue in ascending order. foldlAsc :: Ord a => (b -> a -> b) -> b -> MinQueue a -> b-foldlAsc _ z Empty = z+foldlAsc _ z Empty = z foldlAsc f z (MinQueue _ x ts) = foldlUnfold f (z `f` x) extractHeap ts {-# INLINE foldlUnfold #-} -- | @foldlUnfold f z suc s0@ is equivalent to @foldl f z (unfoldr suc s0)@. foldlUnfold :: (c -> a -> c) -> c -> (b -> Maybe (a, b)) -> b -> c foldlUnfold f z suc s0 = unf z s0 where- unf z s = case suc s of- Nothing -> z- Just (x, s') -> unf (z `f` x) s'+ unf z s = case suc s of+ Nothing -> z+ Just (x, s') -> unf (z `f` x) s'+ insert' :: LEq a -> a -> MinQueue a -> MinQueue a insert' _ x Empty = singleton x insert' (<=) x (MinQueue n x' ts)- | x <= x' = MinQueue (n+1) x (incr (<=) (tip x') ts)- | otherwise = MinQueue (n+1) x' (incr (<=) (tip x) ts)+ | x <= x' = MinQueue (n+1) x (incr (<=) (tip x') ts)+ | otherwise = MinQueue (n+1) x' (incr (<=) (tip x) ts) {-# INLINE union' #-} union' :: LEq a -> MinQueue a -> MinQueue a -> MinQueue a union' _ Empty q = q union' _ q Empty = q union' (<=) (MinQueue n1 x1 f1) (MinQueue n2 x2 f2)- | x1 <= x2 = MinQueue (n1 + n2) x1 (carry (<=) (tip x2) f1 f2)- | otherwise = MinQueue (n1 + n2) x2 (carry (<=) (tip x1) f1 f2)+ | x1 <= x2 = MinQueue (n1 + n2) x1 (carry (<=) (tip x2) f1 f2)+ | otherwise = MinQueue (n1 + n2) x2 (carry (<=) (tip x1) f1 f2) -- | Takes a size and a binomial forest and produces a priority queue with a distinguished global root. extractHeap :: Ord a => BinomHeap a -> Maybe (a, BinomHeap a) extractHeap ts = case extractBin (<=) ts of- Yes (Extract x _ ts') -> Just (x, ts')- _ -> Nothing+ Yes (Extract x _ ts') -> Just (x, ts')+ _ -> Nothing -- | A specialized type intended to organize the return of extract-min queries -- from a binomial forest. We walk all the way through the forest, and then@@ -263,31 +268,32 @@ -- -- The interpretation of @Extract minKey children forest@ is -- --- * @minKey@ is the key of the minimum root visited so far. It may have--- any rank @>= rk@. We will denote the root corresponding to --- @minKey@ as @minRoot@.--- --- * @children@ is those children of @minRoot@ which have not yet been --- merged with the rest of the forest. Specifically, these are --- the children with rank @< rk@.--- --- * @forest@ is an accumulating parameter that maintains the partial --- reconstruction of the binomial forest without @minRoot@. It is --- the union of all old roots with rank @>= rk@ (except @minRoot@), --- with the set of all children of @minRoot@ with rank @>= rk@. --- Note that @forest@ is lazy, so if we discover a smaller key --- than @minKey@ later, we haven't wasted significant work.+-- * @minKey@ is the key of the minimum root visited so far. It may have+-- any rank @>= rk@. We will denote the root corresponding to +-- @minKey@ as @minRoot@.+-- +-- * @children@ is those children of @minRoot@ which have not yet been +-- merged with the rest of the forest. Specifically, these are +-- the children with rank @< rk@.+-- +-- * @forest@ is an accumulating parameter that maintains the partial +-- reconstruction of the binomial forest without @minRoot@. It is +-- the union of all old roots with rank @>= rk@ (except @minRoot@), +-- with the set of all children of @minRoot@ with rank @>= rk@. +-- Note that @forest@ is lazy, so if we discover a smaller key +-- than @minKey@ later, we haven't wasted significant work. data Extract rk a = Extract a (rk a) (BinomForest rk a) data MExtract rk a = No | Yes {-# UNPACK #-} !(Extract rk a) incrExtract :: Extract (Succ rk) a -> Extract rk a incrExtract (Extract minKey (Succ kChild kChildren) ts)- = Extract minKey kChildren (Cons kChild ts)+ = Extract minKey kChildren (Cons kChild ts) incrExtract' :: LEq a -> BinomTree rk a -> Extract (Succ rk) a -> Extract rk a incrExtract' (<=) t (Extract minKey (Succ kChild kChildren) ts)- = Extract minKey kChildren (Skip (incr (<=) (t `cat` kChild) ts))- where cat = joinBin (<=)+ = Extract minKey kChildren (Skip (incr (<=) (t `cat` kChild) ts))+ where+ cat = joinBin (<=) -- | Walks backward from the biggest key in the forest, as far as rank @rk@. -- Returns its progress. Each successive application of @extractBin@ takes@@ -295,36 +301,36 @@ extractBin :: LEq a -> BinomForest rk a -> MExtract rk a extractBin _ Nil = No extractBin (<=) (Skip f) = case extractBin (<=) f of- Yes ex -> Yes (incrExtract ex)- No -> No+ Yes ex -> Yes (incrExtract ex)+ No -> No extractBin (<=) (Cons t@(BinomTree x ts) f) = Yes $ case extractBin (<=) f of- Yes ex@(Extract minKey _ _)- | minKey < x -> incrExtract' (<=) t ex- _ -> Extract x ts (Skip f)- where a < b = not (b <= a)+ Yes ex@(Extract minKey _ _)+ | minKey < x -> incrExtract' (<=) t ex+ _ -> Extract x ts (Skip f)+ where a < b = not (b <= a) mapMaybeQueue :: (a -> Maybe b) -> LEq b -> (rk a -> MinQueue b) -> MinQueue b -> BinomForest rk a -> MinQueue b mapMaybeQueue f (<=) fCh q0 forest = q0 `seq` case forest of- Nil -> q0- Skip forest' -> mapMaybeQueue f (<=) fCh' q0 forest'- Cons t forest' -> mapMaybeQueue f (<=) fCh' (union' (<=) (mapMaybeT t) q0) forest'- where fCh' (Succ t tss) = union' (<=) (mapMaybeT t) (fCh tss)- mapMaybeT (BinomTree x ts) = maybe (fCh ts) (\ x -> insert' (<=) x (fCh ts)) (f x)+ Nil -> q0+ Skip forest' -> mapMaybeQueue f (<=) fCh' q0 forest'+ Cons t forest' -> mapMaybeQueue f (<=) fCh' (union' (<=) (mapMaybeT t) q0) forest'+ where fCh' (Succ t tss) = union' (<=) (mapMaybeT t) (fCh tss)+ mapMaybeT (BinomTree x ts) = maybe (fCh ts) (\ x -> insert' (<=) x (fCh ts)) (f x) type Partition a b = (MinQueue a, MinQueue b) mapEitherQueue :: (a -> Either b c) -> LEq b -> LEq c -> (rk a -> Partition b c) -> Partition b c ->- BinomForest rk a -> Partition b c+ BinomForest rk a -> Partition b c mapEitherQueue f (<=) (<=.) fCh (q0, q1) ts = q0 `seq` q1 `seq` case ts of- Nil -> (q0, q1)- Skip ts' -> mapEitherQueue f (<=) (<=.) fCh' (q0, q1) ts'- Cons t ts' -> mapEitherQueue f (<=) (<=.) fCh' (both (union' (<=)) (union' (<=.)) (partitionT t) (q0, q1)) ts'- where both f g (x1, x2) (y1, y2) = (f x1 y1, g x2 y2)- fCh' (Succ t tss) = both (union' (<=)) (union' (<=.)) (partitionT t) (fCh tss)- partitionT (BinomTree x ts) = case fCh ts of- (q0, q1) -> case f x of- Left b -> (insert' (<=) b q0, q1)- Right c -> (q0, insert' (<=.) c q1)+ Nil -> (q0, q1)+ Skip ts' -> mapEitherQueue f (<=) (<=.) fCh' (q0, q1) ts'+ Cons t ts' -> mapEitherQueue f (<=) (<=.) fCh' (both (union' (<=)) (union' (<=.)) (partitionT t) (q0, q1)) ts'+ where both f g (x1, x2) (y1, y2) = (f x1 y1, g x2 y2)+ fCh' (Succ t tss) = both (union' (<=)) (union' (<=.)) (partitionT t) (fCh tss)+ partitionT (BinomTree x ts) = case fCh ts of+ (q0, q1) -> case f x of+ Left b -> (insert' (<=) b q0, q1)+ Right c -> (q0, insert' (<=.) c q1) {-# INLINE tip #-} -- | Constructs a binomial tree of rank 0.@@ -347,94 +353,94 @@ -- from the beginning costs /O(log n)/. merge :: LEq a -> BinomForest rk a -> BinomForest rk a -> BinomForest rk a merge (<=) f1 f2 = case (f1, f2) of- (Skip f1', Skip f2') -> Skip (merge (<=) f1' f2')- (Skip f1', Cons t2 f2') -> Cons t2 (merge (<=) f1' f2')- (Cons t1 f1', Skip f2') -> Cons t1 (merge (<=) f1' f2')- (Cons t1 f1', Cons t2 f2')- -> Skip (carry (<=) (t1 `cat` t2) f1' f2')- (Nil, _) -> f2- (_, Nil) -> f1- where cat = joinBin (<=)+ (Skip f1', Skip f2') -> Skip (merge (<=) f1' f2')+ (Skip f1', Cons t2 f2') -> Cons t2 (merge (<=) f1' f2')+ (Cons t1 f1', Skip f2') -> Cons t1 (merge (<=) f1' f2')+ (Cons t1 f1', Cons t2 f2')+ -> Skip (carry (<=) (t1 `cat` t2) f1' f2')+ (Nil, _) -> f2+ (_, Nil) -> f1+ where cat = joinBin (<=) -- | Merges two binomial forests with another tree. If we are thinking of the trees -- in the binomial forest as binary digits, this corresponds to a carry operation. -- Each call to this function takes /O(1)/ time, so in total, it costs /O(log n)/. carry :: LEq a -> BinomTree rk a -> BinomForest rk a -> BinomForest rk a -> BinomForest rk a carry (<=) t0 f1 f2 = t0 `seq` case (f1, f2) of- (Skip f1', Skip f2') -> Cons t0 (merge (<=) f1' f2')- (Skip f1', Cons t2 f2') -> Skip (mergeCarry t0 t2 f1' f2')- (Cons t1 f1', Skip f2') -> Skip (mergeCarry t0 t1 f1' f2')- (Cons t1 f1', Cons t2 f2')- -> Cons t0 (mergeCarry t1 t2 f1' f2')- (Nil, _f2) -> incr (<=) t0 f2- (_f1, Nil) -> incr (<=) t0 f1- where cat = joinBin (<=)- mergeCarry tA tB = carry (<=) (tA `cat` tB)+ (Skip f1', Skip f2') -> Cons t0 (merge (<=) f1' f2')+ (Skip f1', Cons t2 f2') -> Skip (mergeCarry t0 t2 f1' f2')+ (Cons t1 f1', Skip f2') -> Skip (mergeCarry t0 t1 f1' f2')+ (Cons t1 f1', Cons t2 f2')+ -> Cons t0 (mergeCarry t1 t2 f1' f2')+ (Nil, _f2) -> incr (<=) t0 f2+ (_f1, Nil) -> incr (<=) t0 f1+ where cat = joinBin (<=)+ mergeCarry tA tB = carry (<=) (tA `cat` tB) -- | Merges a binomial tree into a binomial forest. If we are thinking -- of the trees in the binomial forest as binary digits, this corresponds -- to adding a power of 2. This costs amortized /O(1)/ time. incr :: LEq a -> BinomTree rk a -> BinomForest rk a -> BinomForest rk a incr (<=) t f = t `seq` case f of- Nil -> Cons t Nil- Skip f -> Cons t f- Cons t' f' -> Skip (incr (<=) (t `cat` t') f')- where cat = joinBin (<=)+ Nil -> Cons t Nil+ Skip f -> Cons t f+ Cons t' f' -> Skip (incr (<=) (t `cat` t') f')+ where cat = joinBin (<=) -- | The carrying operation: takes two binomial heaps of the same rank @k@ -- and returns one of rank @k+1@. Takes /O(1)/ time. joinBin :: LEq a -> BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a joinBin (<=) t1@(BinomTree x1 ts1) t2@(BinomTree x2 ts2)- | x1 <= x2 = BinomTree x1 (Succ t2 ts1)- | otherwise = BinomTree x2 (Succ t1 ts2)+ | x1 <= x2 = BinomTree x1 (Succ t2 ts1)+ | otherwise = BinomTree x2 (Succ t1 ts2) instance Functor Zero where- fmap _ _ = Zero+ fmap _ _ = Zero instance Functor rk => Functor (Succ rk) where- fmap f (Succ t ts) = Succ (fmap f t) (fmap f ts)+ fmap f (Succ t ts) = Succ (fmap f t) (fmap f ts) instance Functor rk => Functor (BinomTree rk) where- fmap f (BinomTree x ts) = BinomTree (f x) (fmap f ts)+ fmap f (BinomTree x ts) = BinomTree (f x) (fmap f ts) instance Functor rk => Functor (BinomForest rk) where- fmap _ Nil = Nil- fmap f (Skip ts) = Skip (fmap f ts)- fmap f (Cons t ts) = Cons (fmap f t) (fmap f ts)+ fmap _ Nil = Nil+ fmap f (Skip ts) = Skip (fmap f ts)+ fmap f (Cons t ts) = Cons (fmap f t) (fmap f ts) instance Foldable Zero where- foldr _ z _ = z- foldl _ z _ = z+ foldr _ z _ = z+ foldl _ z _ = z instance Foldable rk => Foldable (Succ rk) where- foldr f z (Succ t ts) = foldr f (foldr f z ts) t- foldl f z (Succ t ts) = foldl f (foldl f z t) ts+ foldr f z (Succ t ts) = foldr f (foldr f z ts) t+ foldl f z (Succ t ts) = foldl f (foldl f z t) ts instance Foldable rk => Foldable (BinomTree rk) where- foldr f z (BinomTree x ts) = x `f` foldr f z ts- foldl f z (BinomTree x ts) = foldl f (z `f` x) ts+ foldr f z (BinomTree x ts) = x `f` foldr f z ts+ foldl f z (BinomTree x ts) = foldl f (z `f` x) ts instance Foldable rk => Foldable (BinomForest rk) where- foldr _ z Nil = z- foldr f z (Skip tss) = foldr f z tss- foldr f z (Cons t tss) = foldr f (foldr f z tss) t- foldl _ z Nil = z- foldl f z (Skip tss) = foldl f z tss- foldl f z (Cons t tss) = foldl f (foldl f z t) tss+ foldr _ z Nil = z+ foldr f z (Skip tss) = foldr f z tss+ foldr f z (Cons t tss) = foldr f (foldr f z tss) t+ foldl _ z Nil = z+ foldl f z (Skip tss) = foldl f z tss+ foldl f z (Cons t tss) = foldl f (foldl f z t) tss -- instance Traversable Zero where--- traverse _ _ = pure Zero+-- traverse _ _ = pure Zero -- -- instance Traversable rk => Traversable (Succ rk) where--- traverse f (Succ t ts) = Succ <$> traverse f t <*> traverse f ts+-- traverse f (Succ t ts) = Succ <$> traverse f t <*> traverse f ts -- -- instance Traversable rk => Traversable (BinomTree rk) where--- traverse f (BinomTree x ts) = BinomTree <$> f x <*> traverse f ts+-- traverse f (BinomTree x ts) = BinomTree <$> f x <*> traverse f ts -- -- instance Traversable rk => Traversable (BinomForest rk) where--- traverse _ Nil = pure Nil--- traverse f (Skip tss) = Skip <$> traverse f tss--- traverse f (Cons t tss) = Cons <$> traverse f t <*> traverse f tss+-- traverse _ Nil = pure Nil+-- traverse f (Skip tss) = Skip <$> traverse f tss+-- traverse f (Cons t tss) = Cons <$> traverse f t <*> traverse f tss mapU :: (a -> b) -> MinQueue a -> MinQueue b mapU _ Empty = Empty@@ -460,8 +466,8 @@ seqSpine (MinQueue _ _ ts) z = seqSpineF ts z seqSpineF :: BinomForest rk a -> b -> b-seqSpineF Nil z = z-seqSpineF (Skip ts') z = seqSpineF ts' z+seqSpineF Nil z = z+seqSpineF (Skip ts') z = seqSpineF ts' z seqSpineF (Cons _ ts') z = seqSpineF ts' z -- | Constructs a priority queue out of the keys of the specified 'Prio.MinPQueue'.@@ -471,29 +477,29 @@ keysF :: (pRk k a -> rk k) -> Prio.BinomForest pRk k a -> BinomForest rk k keysF f ts = case ts of- Prio.Nil -> Nil- Prio.Skip ts' -> Skip (keysF f' ts')- Prio.Cons (Prio.BinomTree k _ ts) ts'- -> Cons (BinomTree k (f ts)) (keysF f' ts')- where f' (Prio.Succ (Prio.BinomTree k _ ts) tss) = Succ (BinomTree k (f ts)) (f tss)+ Prio.Nil -> Nil+ Prio.Skip ts' -> Skip (keysF f' ts')+ Prio.Cons (Prio.BinomTree k _ ts) ts'+ -> Cons (BinomTree k (f ts)) (keysF f' ts')+ where f' (Prio.Succ (Prio.BinomTree k _ ts) tss) = Succ (BinomTree k (f ts)) (f tss) class NFRank rk where- rnfRk :: NFData a => rk a -> ()+ rnfRk :: NFData a => rk a -> () instance NFRank Zero where- rnfRk _ = ()+ rnfRk _ = () instance NFRank rk => NFRank (Succ rk) where- rnfRk (Succ t ts) = t `deepseq` rnfRk ts+ rnfRk (Succ t ts) = t `deepseq` rnfRk ts instance (NFData a, NFRank rk) => NFData (BinomTree rk a) where- rnf (BinomTree x ts) = x `deepseq` rnfRk ts+ rnf (BinomTree x ts) = x `deepseq` rnfRk ts instance (NFData a, NFRank rk) => NFData (BinomForest rk a) where- rnf Nil = ()- rnf (Skip ts) = rnf ts- rnf (Cons t ts) = t `deepseq` rnf ts+ rnf Nil = ()+ rnf (Skip ts) = rnf ts+ rnf (Cons t ts) = t `deepseq` rnf ts instance NFData a => NFData (MinQueue a) where- rnf Empty = ()- rnf (MinQueue _ x ts) = x `deepseq` rnf ts+ rnf Empty = ()+ rnf (MinQueue _ x ts) = x `deepseq` rnf ts
Data/PQueue/Max.hs view
@@ -26,67 +26,67 @@ -- these functions. ----------------------------------------------------------------------------- module Data.PQueue.Max (- MaxQueue,- -- * Basic operations- empty,- null,- size, - -- * Query operations- findMax,- getMax,- deleteMax,- deleteFindMax,- maxView,- -- * Construction operations- singleton,- insert,- union,- unions,- -- * Subsets- -- ** Extracting subsets- (!!),- take,- drop,- splitAt,- -- ** Predicates- takeWhile,- dropWhile,- span,- break,- -- * Filter/Map- filter,- partition,- mapMaybe,- mapEither,- -- * Fold\/Functor\/Traversable variations- map,- foldrAsc,- foldlAsc,- foldrDesc,- foldlDesc,- -- * List operations- toList,- toAscList,- toDescList,- fromList,- fromAscList,- fromDescList,- -- * Unordered operations- mapU,- foldrU,- foldlU,- elemsU,- toListU,- -- * Miscellaneous operations- keysQueue,- seqSpine) where+ MaxQueue,+ -- * Basic operations+ empty,+ null,+ size, + -- * Query operations+ findMax,+ getMax,+ deleteMax,+ deleteFindMax,+ maxView,+ -- * Construction operations+ singleton,+ insert,+ union,+ unions,+ -- * Subsets+ -- ** Extracting subsets+ (!!),+ take,+ drop,+ splitAt,+ -- ** Predicates+ takeWhile,+ dropWhile,+ span,+ break,+ -- * Filter/Map+ filter,+ partition,+ mapMaybe,+ mapEither,+ -- * Fold\/Functor\/Traversable variations+ map,+ foldrAsc,+ foldlAsc,+ foldrDesc,+ foldlDesc,+ -- * List operations+ toList,+ toAscList,+ toDescList,+ fromList,+ fromAscList,+ fromDescList,+ -- * Unordered operations+ mapU,+ foldrU,+ foldlU,+ elemsU,+ toListU,+ -- * Miscellaneous operations+ keysQueue,+ seqSpine) where import Control.Applicative (Applicative(..), (<$>)) import Control.DeepSeq import Data.Monoid import Data.Maybe hiding (mapMaybe)-import Data.Foldable hiding (toList)+import Data.Foldable (foldl, foldr) import Data.Traversable import qualified Data.PQueue.Min as Min@@ -98,7 +98,7 @@ #ifdef __GLASGOW_HASKELL__ import GHC.Exts (build) import Text.Read (Lexeme(Ident), lexP, parens, prec,- readPrec, readListPrec, readListPrecDefault)+ readPrec, readListPrec, readListPrecDefault) import Data.Data #else build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]@@ -109,36 +109,36 @@ -- Implemented as a wrapper around 'Min.MinQueue'. newtype MaxQueue a = MaxQ (Min.MinQueue (Down a)) # if __GLASGOW_HASKELL__- deriving (Eq, Ord, Data, Typeable)+ deriving (Eq, Ord, Data, Typeable) # else- deriving (Eq, Ord)+ deriving (Eq, Ord) # endif instance NFData a => NFData (MaxQueue a) where- rnf (MaxQ q) = rnf q+ rnf (MaxQ q) = rnf q instance (Ord a, Show a) => Show (MaxQueue a) where- showsPrec p xs = showParen (p > 10) $- showString "fromDescList " . shows (toDescList xs)- + showsPrec p xs = showParen (p > 10) $+ showString "fromDescList " . shows (toDescList xs)+ instance Read a => Read (MaxQueue a) where #ifdef __GLASGOW_HASKELL__- readPrec = parens $ prec 10 $ do- Ident "fromDescList" <- lexP- xs <- readPrec- return (fromDescList xs)+ readPrec = parens $ prec 10 $ do+ Ident "fromDescList" <- lexP+ xs <- readPrec+ return (fromDescList xs) - readListPrec = readListPrecDefault+ readListPrec = readListPrecDefault #else- readsPrec p = readParen (p > 10) $ \ r -> do- ("fromDescList",s) <- lex r- (xs,t) <- reads s- return (fromDescList xs,t)+ readsPrec p = readParen (p > 10) $ \ r -> do+ ("fromDescList",s) <- lex r+ (xs,t) <- reads s+ return (fromDescList xs,t) #endif instance Ord a => Monoid (MaxQueue a) where- mempty = empty- mappend = union+ mempty = empty+ mappend = union -- | /O(1)/. The empty priority queue. empty :: MaxQueue a@@ -171,10 +171,10 @@ -- | /O(log n)/. Extract the top (maximum) element of the sequence, if there is one. maxView :: Ord a => MaxQueue a -> Maybe (a, MaxQueue a) maxView (MaxQ q) = case Min.minView q of- Nothing -> Nothing- Just (Down x, q')- -> Just (x, MaxQ q')- + Nothing -> Nothing+ Just (Down x, q')+ -> Just (x, MaxQ q')+ -- | /O(log n)/. Delete the top (maximum) element of the sequence, if there is one. delete :: Ord a => MaxQueue a -> Maybe (MaxQueue a) delete = fmap snd . maxView@@ -212,8 +212,8 @@ -- | /O(k log n)/. Equivalent to @(take k queue, drop k queue)@. splitAt :: Ord a => Int -> MaxQueue a -> ([a], MaxQueue a) splitAt k (MaxQ q) = (map unDown xs, MaxQ q') where- (xs, q') = Min.splitAt k q- + (xs, q') = Min.splitAt k q+ -- | 'takeWhile', applied to a predicate @p@ and a queue @queue@, returns the -- longest prefix (possibly empty) of @queue@ of elements that satisfy @p@. takeWhile :: Ord a => (a -> Bool) -> MaxQueue a -> [a]@@ -229,7 +229,7 @@ -- span :: Ord a => (a -> Bool) -> MaxQueue a -> ([a], MaxQueue a) span p (MaxQ q) = (map unDown xs, MaxQ q') where- (xs, q') = Min.span (p . unDown) q+ (xs, q') = Min.span (p . unDown) q -- | 'break', applied to a predicate @p@ and a queue @queue@, returns a tuple where -- first element is longest prefix (possibly empty) of @queue@ of elements that@@ -245,7 +245,7 @@ -- and the right queue contains those that do not. partition :: Ord a => (a -> Bool) -> MaxQueue a -> (MaxQueue a, MaxQueue a) partition p (MaxQ q) = (MaxQ q0, MaxQ q1)- where (q0, q1) = Min.partition (p . unDown) q+ where (q0, q1) = Min.partition (p . unDown) q -- | /O(n)/. Maps a function over the elements of the queue, and collects the 'Just' values. mapMaybe :: Ord b => (a -> Maybe b) -> MaxQueue a -> MaxQueue b@@ -254,7 +254,7 @@ -- | /O(n)/. Maps a function over the elements of the queue, and separates the 'Left' and 'Right' values. mapEither :: (Ord b, Ord c) => (a -> Either b c) -> MaxQueue a -> (MaxQueue b, MaxQueue c) mapEither f (MaxQ q) = (MaxQ q0, MaxQ q1)- where (q0, q1) = Min.mapEither (either (Left . Down) (Right . Down) . f . unDown) q+ where (q0, q1) = Min.mapEither (either (Left . Down) (Right . Down) . f . unDown) q -- | /O(n)/. Assumes that the function it is given is monotonic, and applies this function to every element of the priority queue. -- /Does not check the precondition/.
Data/PQueue/Min.hs view
@@ -26,60 +26,60 @@ -- these functions. ----------------------------------------------------------------------------- module Data.PQueue.Min (- MinQueue,- -- * Basic operations- empty,- null,- size, - -- * Query operations- findMin,- getMin,- deleteMin,- deleteFindMin,- minView,- -- * Construction operations- singleton,- insert,- union,- unions,- -- * Subsets- -- ** Extracting subsets- (!!),- take,- drop,- splitAt,- -- ** Predicates- takeWhile,- dropWhile,- span,- break,- -- * Filter/Map- filter,- partition,- mapMaybe,- mapEither,- -- * Fold\/Functor\/Traversable variations- map,- foldrAsc,- foldlAsc,- foldrDesc,- foldlDesc,- -- * List operations- toList,- toAscList,- toDescList,- fromList,- fromAscList,- fromDescList,- -- * Unordered operations- mapU,- foldrU,- foldlU,- elemsU,- toListU,- -- * Miscellaneous operations- keysQueue,- seqSpine) where+ MinQueue,+ -- * Basic operations+ empty,+ null,+ size, + -- * Query operations+ findMin,+ getMin,+ deleteMin,+ deleteFindMin,+ minView,+ -- * Construction operations+ singleton,+ insert,+ union,+ unions,+ -- * Subsets+ -- ** Extracting subsets+ (!!),+ take,+ drop,+ splitAt,+ -- ** Predicates+ takeWhile,+ dropWhile,+ span,+ break,+ -- * Filter/Map+ filter,+ partition,+ mapMaybe,+ mapEither,+ -- * Fold\/Functor\/Traversable variations+ map,+ foldrAsc,+ foldlAsc,+ foldrDesc,+ foldlDesc,+ -- * List operations+ toList,+ toAscList,+ toDescList,+ fromList,+ fromAscList,+ fromDescList,+ -- * Unordered operations+ mapU,+ foldrU,+ foldlU,+ elemsU,+ toListU,+ -- * Miscellaneous operations+ keysQueue,+ seqSpine) where import Prelude hiding (null, foldr, foldl, take, drop, takeWhile, dropWhile, splitAt, span, break, (!!), filter, map) @@ -88,7 +88,7 @@ import Data.Monoid import Data.Maybe hiding (mapMaybe)-import Data.Foldable hiding (toList)+import Data.Foldable (foldl, foldr, foldl') import Data.Traversable import qualified Data.List as List@@ -98,7 +98,7 @@ #ifdef __GLASGOW_HASKELL__ import GHC.Exts (build) import Text.Read (Lexeme(Ident), lexP, parens, prec,- readPrec, readListPrec, readListPrecDefault)+ readPrec, readListPrec, readListPrecDefault) import Data.Data #else build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]@@ -108,28 +108,28 @@ -- instance instance (Ord a, Show a) => Show (MinQueue a) where- showsPrec p xs = showParen (p > 10) $- showString "fromAscList " . shows (toAscList xs)+ showsPrec p xs = showParen (p > 10) $+ showString "fromAscList " . shows (toAscList xs) instance Read a => Read (MinQueue a) where #ifdef __GLASGOW_HASKELL__- readPrec = parens $ prec 10 $ do- Ident "fromAscList" <- lexP- xs <- readPrec- return (fromAscList xs)+ readPrec = parens $ prec 10 $ do+ Ident "fromAscList" <- lexP+ xs <- readPrec+ return (fromAscList xs) - readListPrec = readListPrecDefault+ readListPrec = readListPrecDefault #else- readsPrec p = readParen (p > 10) $ \ r -> do- ("fromAscList",s) <- lex r- (xs,t) <- reads s- return (fromAscList xs,t)+ readsPrec p = readParen (p > 10) $ \ r -> do+ ("fromAscList",s) <- lex r+ (xs,t) <- reads s+ return (fromAscList xs,t) #endif instance Ord a => Monoid (MinQueue a) where- mempty = empty- mappend = union- mconcat = unions+ mempty = empty+ mappend = union+ mconcat = unions -- | /O(1)/. Returns the minimum element. Throws an error on an empty queue. findMin :: MinQueue a -> a@@ -138,8 +138,8 @@ -- | /O(log n)/. Deletes the minimum element. If the queue is empty, does nothing. deleteMin :: Ord a => MinQueue a -> MinQueue a deleteMin q = case minView q of- Nothing -> empty- Just (_, q') -> q'+ Nothing -> empty+ Just (_, q') -> q' -- | /O(log n)/. Extracts the minimum element. Throws an error on an empty queue. deleteFindMin :: Ord a => MinQueue a -> (a, MinQueue a)@@ -152,8 +152,8 @@ -- | /O(k log n)/. Index (subscript) operator, starting from 0. @queue !! k@ returns the @(k+1)@th smallest -- element in the queue. Equivalent to @toAscList queue !! k@. (!!) :: Ord a => MinQueue a -> Int -> a-q !! n | n >= size q- = error "Data.PQueue.Min.!!: index too large"+q !! n | n >= size q+ = error "Data.PQueue.Min.!!: index too large" q !! n = (List.!!) (toAscList q) n {-# INLINE takeWhile #-}@@ -166,27 +166,26 @@ -- | Equivalent to Data.List.takeWhile, but is a better producer. foldWhileFB :: (a -> Bool) -> [a] -> [a] foldWhileFB p xs = build (\ c nil -> let - consWhile x xs- | p x = x `c` xs- | otherwise = nil- in foldr consWhile nil xs)+ consWhile x xs+ | p x = x `c` xs+ | otherwise = nil+ in foldr consWhile nil xs) -- | 'dropWhile' @p queue@ returns the queue remaining after 'takeWhile' @p queue@. dropWhile :: Ord a => (a -> Bool) -> MinQueue a -> MinQueue a dropWhile p = drop' where- drop' q = case minView q of- Just (x, q')- | p x -> drop' q'- _ -> q+ drop' q = case minView q of+ Just (x, q') | p x -> drop' q'+ _ -> q -- | 'span', applied to a predicate @p@ and a queue @queue@, returns a tuple where -- first element is longest prefix (possibly empty) of @queue@ of elements that -- satisfy @p@ and second element is the remainder of the queue. span :: Ord a => (a -> Bool) -> MinQueue a -> ([a], MinQueue a) span p queue = case minView queue of- Just (x, q') - | p x -> let (ys, q'') = span p q' in (x:ys, q'')- _ -> ([], queue)+ Just (x, q') + | p x -> let (ys, q'') = span p q' in (x:ys, q'')+ _ -> ([], queue) -- | 'break', applied to a predicate @p@ and a queue @queue@, returns a tuple where -- first element is longest prefix (possibly empty) of @queue@ of elements that@@ -204,16 +203,16 @@ -- or an empty queue if @k >= size 'queue'@. drop :: Ord a => Int -> MinQueue a -> MinQueue a drop n queue = n `seq` case minView queue of- Just (_, queue')- | n > 0 -> drop (n-1) queue'- _ -> queue+ Just (_, queue')+ | n > 0 -> drop (n-1) queue'+ _ -> queue -- | /O(k log n)/. Equivalent to @('take' k queue, 'drop' k queue)@. splitAt :: Ord a => Int -> MinQueue a -> ([a], MinQueue a) splitAt n queue = n `seq` case minView queue of- Just (x, queue')- | n > 0 -> let (xs, queue'') = splitAt (n-1) queue' in (x:xs, queue'')- _ -> ([], queue)+ Just (x, queue')+ | n > 0 -> let (xs, queue'') = splitAt (n-1) queue' in (x:xs, queue'')+ _ -> ([], queue) -- | /O(n)/. Returns the queue with all elements not satisfying @p@ removed. filter :: Ord a => (a -> Bool) -> MinQueue a -> MinQueue a@@ -247,10 +246,10 @@ toList = toAscList {-# RULES- "toAscList" forall q . toAscList q = build (\ c nil -> foldrAsc c nil q);- -- inlining doesn't seem to be working out =/- "toDescList" forall q . toDescList q = build (\ c nil -> foldrDesc c nil q);- #-}+ "toAscList" forall q . toAscList q = build (\ c nil -> foldrAsc c nil q);+ -- inlining doesn't seem to be working out =/+ "toDescList" forall q . toDescList q = build (\ c nil -> foldrDesc c nil q);+ #-} -- | /O(n log n)/. Performs a right-fold on the elements of a priority queue in descending order. -- @foldrDesc f z q == foldlAsc (flip f) z q@.@@ -268,9 +267,9 @@ fromList = foldr insert empty {-# RULES- "fromList" fromList = foldr insert empty;- "fromAscList" fromAscList = foldr insertMinQ empty;- #-}+ "fromList" fromList = foldr insert empty;+ "fromAscList" fromAscList = foldr insertMinQ empty;+ #-} {-# INLINE fromAscList #-} -- | /O(n)/. Constructs a priority queue from an ascending list. /Warning/: Does not check the precondition.@@ -296,6 +295,6 @@ toListU q = build (\ c n -> foldrU c n q) {-# RULES- "foldr/toListU" forall f z q . foldr f z (toListU q) = foldrU f z q;- "foldl/toListU" forall f z q . foldl f z (toListU q) = foldlU f z q;- #-}+ "foldr/toListU" forall f z q . foldr f z (toListU q) = foldrU f z q;+ "foldl/toListU" forall f z q . foldl f z (toListU q) = foldlU f z q;+ #-}
Data/PQueue/Prio/Internals.hs view
@@ -1,34 +1,34 @@ {-# LANGUAGE CPP #-} module Data.PQueue.Prio.Internals (- MinPQueue(..),- BinomForest(..),- BinomHeap,- BinomTree(..),- Zero(..),- Succ(..),- LEq,- empty,- null,- size,- singleton,- insert,- union,- getMin,- adjustMinWithKey,- updateMinWithKey,- minViewWithKey,- mapWithKey,- mapKeysMonotonic,- mapMaybeWithKey,- mapEitherWithKey,- foldrWithKey,- foldlWithKey,- insertMin,- foldrWithKeyU,- foldlWithKeyU,- traverseWithKeyU,- seqSpine- ) where+ MinPQueue(..),+ BinomForest(..),+ BinomHeap,+ BinomTree(..),+ Zero(..),+ Succ(..),+ LEq,+ empty,+ null,+ size,+ singleton,+ insert,+ union,+ getMin,+ adjustMinWithKey,+ updateMinWithKey,+ minViewWithKey,+ mapWithKey,+ mapKeysMonotonic,+ mapMaybeWithKey,+ mapEitherWithKey,+ foldrWithKey,+ foldlWithKey,+ insertMin,+ foldrWithKeyU,+ foldlWithKeyU,+ traverseWithKeyU,+ seqSpine+ ) where import Control.Applicative (Applicative(..), (<$>)) import Control.Applicative.Identity@@ -68,13 +68,13 @@ -- The queue supports extracting the element with minimum key. data MinPQueue k a = Empty | MinPQ {-# UNPACK #-} !Int k a (BinomHeap k a) #if __GLASGOW_HASKELL__- deriving (Typeable)+ deriving (Typeable) #endif data BinomForest rk k a = - Nil |- Skip (BinomForest (Succ rk) k a) |- Cons {-# UNPACK #-} !(BinomTree rk k a) (BinomForest (Succ rk) k a)+ Nil |+ Skip (BinomForest (Succ rk) k a) |+ Cons {-# UNPACK #-} !(BinomTree rk k a) (BinomForest (Succ rk) k a) type BinomHeap = BinomForest Zero data BinomTree rk k a = BinomTree k a (rk k a)@@ -84,34 +84,36 @@ type LEq a = a -> a -> Bool instance (Ord k, Eq a) => Eq (MinPQueue k a) where- MinPQ n1 k1 a1 ts1 == MinPQ n2 k2 a2 ts2 =- n1 == n2 && k1 == k2 && a1 == a2 && equHeap ts1 ts2- where equHeap ts1 ts2 = case (extract ts1, extract ts2) of- (Yes (Extract k1 a1 _ ts1'), Yes (Extract k2 a2 _ ts2'))- -> k1 == k2 && a1 == a2 && equHeap ts1' ts2'- (No, No) -> True- _ -> False- extract = extractForest (<=)- Empty == Empty = True- _ == _ = False+ MinPQ n1 k1 a1 ts1 == MinPQ n2 k2 a2 ts2 =+ n1 == n2 && k1 == k2 && a1 == a2 && equHeap ts1 ts2+ where+ equHeap ts1 ts2 = case (extract ts1, extract ts2) of+ (Yes (Extract k1 a1 _ ts1'), Yes (Extract k2 a2 _ ts2'))+ -> k1 == k2 && a1 == a2 && equHeap ts1' ts2'+ (No, No) -> True+ _ -> False+ extract = extractForest (<=)+ Empty == Empty = True+ _ == _ = False (<>) :: Monoid m => m -> m -> m (<>) = mappend infixr 6 <> instance (Ord k, Ord a) => Ord (MinPQueue k a) where- MinPQ n1 k1 a1 ts1 `compare` MinPQ n2 k2 a2 ts2 =- k1 `compare` k2 <> a1 `compare` a2 <> ts1 `cmpHeap` ts2- where ts1 `cmpHeap` ts2 = case (extract ts1, extract ts2) of- (Yes (Extract k1 a1 _ ts1'), Yes (Extract k2 a2 _ ts2'))- -> k1 `compare` k2 <> a1 `compare` a2 <> ts1' `cmpHeap` ts2'- (No, Yes{}) -> LT- (Yes{}, No) -> GT- (No, No) -> EQ- extract = extractForest (<=)- Empty `compare` Empty = EQ- Empty `compare` MinPQ{} = LT- MinPQ{} `compare` Empty = GT+ MinPQ n1 k1 a1 ts1 `compare` MinPQ n2 k2 a2 ts2 =+ k1 `compare` k2 <> a1 `compare` a2 <> ts1 `cmpHeap` ts2+ where+ ts1 `cmpHeap` ts2 = case (extract ts1, extract ts2) of+ (Yes (Extract k1 a1 _ ts1'), Yes (Extract k2 a2 _ ts2'))+ -> k1 `compare` k2 <> a1 `compare` a2 <> ts1' `cmpHeap` ts2'+ (No, Yes{}) -> LT+ (Yes{}, No) -> GT+ (No, No) -> EQ+ extract = extractForest (<=)+ Empty `compare` Empty = EQ+ Empty `compare` MinPQ{} = LT+ MinPQ{} `compare` Empty = GT -- | /O(1)/. Returns the empty priority queue. empty :: MinPQueue k a@@ -120,11 +122,11 @@ -- | /O(1)/. Checks if this priority queue is empty. null :: MinPQueue k a -> Bool null Empty = True-null _ = False+null _ = False -- | /O(1)/. Returns the size of this priority queue. size :: MinPQueue k a -> Int-size Empty = 0+size Empty = 0 size (MinPQ n _ _ _) = n -- | /O(1)/. Constructs a singleton priority queue.@@ -140,8 +142,8 @@ insert' :: LEq k -> k -> a -> MinPQueue k a -> MinPQueue k a insert' _ k a Empty = singleton k a insert' (<=) k a (MinPQ n k' a' ts)- | k <= k' = MinPQ (n+1) k a (incr (<=) (tip k' a') ts)- | otherwise = MinPQ (n+1) k' a' (incr (<=) (tip k a) ts)+ | k <= k' = MinPQ (n+1) k a (incr (<=) (tip k' a') ts)+ | otherwise = MinPQ (n+1) k' a' (incr (<=) (tip k a ) ts) -- | Amortized /O(log(min(n1, n2)))/, worst-case /O(log(max(n1, n2)))/. Returns the union -- of the two specified queues.@@ -151,16 +153,16 @@ -- | Takes the union of the two specified queues, using the given comparison function. union' :: LEq k -> MinPQueue k a -> MinPQueue k a -> MinPQueue k a union' (<=) (MinPQ n1 k1 a1 ts1) (MinPQ n2 k2 a2 ts2)- | k1 <= k2 = MinPQ (n1 + n2) k1 a1 (insMerge k2 a2)- | otherwise = MinPQ (n1 + n2) k2 a2 (insMerge k1 a1)- where insMerge k a = carryForest (<=) (tip k a) ts1 ts2+ | k1 <= k2 = MinPQ (n1 + n2) k1 a1 (insMerge k2 a2)+ | otherwise = MinPQ (n1 + n2) k2 a2 (insMerge k1 a1)+ where insMerge k a = carryForest (<=) (tip k a) ts1 ts2 union' _ Empty q2 = q2 union' _ q1 Empty = q1 -- | /O(1)/. The minimal (key, element) in the queue, if the queue is nonempty. getMin :: MinPQueue k a -> Maybe (k, a) getMin (MinPQ _ k a _) = Just (k, a)-getMin _ = Nothing+getMin _ = Nothing -- | /O(1)/. Alter the value at the minimum key. If the queue is empty, does nothing. adjustMinWithKey :: (k -> a -> a) -> MinPQueue k a -> MinPQueue k a@@ -172,13 +174,13 @@ updateMinWithKey :: Ord k => (k -> a -> Maybe a) -> MinPQueue k a -> MinPQueue k a updateMinWithKey _ Empty = Empty updateMinWithKey f (MinPQ n k a ts) = case f k a of- Nothing -> extractHeap (<=) n ts- Just a' -> MinPQ n k a' ts+ Nothing -> extractHeap (<=) n ts+ Just a' -> MinPQ n k a' ts -- | /O(log n)/. Retrieves the minimal (key, value) pair of the map, and the map stripped of that -- element, or 'Nothing' if passed an empty map. minViewWithKey :: Ord k => MinPQueue k a -> Maybe ((k, a), MinPQueue k a)-minViewWithKey Empty = Nothing+minViewWithKey Empty = Nothing minViewWithKey (MinPQ n k a ts) = Just ((k, a), extractHeap (<=) n ts) -- | /O(n)/. Map a function over all values in the queue.@@ -194,14 +196,14 @@ -- | /O(n)/. Map values and collect the 'Just' results. mapMaybeWithKey :: Ord k => (k -> a -> Maybe b) -> MinPQueue k a -> MinPQueue k b-mapMaybeWithKey _ Empty = Empty+mapMaybeWithKey _ Empty = Empty mapMaybeWithKey f (MinPQ _ k a ts) = maybe id (insert k) (f k a) (mapMaybeF (<=) f (const Empty) ts) -- | /O(n)/. Map values and separate the 'Left' and 'Right' results. mapEitherWithKey :: Ord k => (k -> a -> Either b c) -> MinPQueue k a -> (MinPQueue k b, MinPQueue k c)-mapEitherWithKey _ Empty = (Empty, Empty)+mapEitherWithKey _ Empty = (Empty, Empty) mapEitherWithKey f (MinPQ _ k a ts) = either (first' . insert k) (second' . insert k) (f k a) - (mapEitherF (<=) f (const (Empty, Empty)) ts)+ (mapEitherF (<=) f (const (Empty, Empty)) ts) -- | /O(n log n)/. Fold the keys and values in the map, such that -- @'foldrWithKey' f z q == 'List.foldr' ('uncurry' f) z ('toAscList' q)@.@@ -210,11 +212,10 @@ foldrWithKey :: Ord k => (k -> a -> b -> b) -> b -> MinPQueue k a -> b foldrWithKey _ z Empty = z foldrWithKey f z (MinPQ _ k a ts) = f k a (foldF ts) where- extract = extractForest (<=)- foldF ts = case extract ts of- Yes (Extract k a _ ts')- -> f k a (foldF ts')- _ -> z+ extract = extractForest (<=)+ foldF ts = case extract ts of+ Yes (Extract k a _ ts') -> f k a (foldF ts')+ _ -> z -- | /O(n log n)/. Fold the keys and values in the map, such that -- @'foldlWithKey' f z q == 'List.foldl' ('uncurry' . f) z ('toAscList' q)@.@@ -223,11 +224,10 @@ foldlWithKey :: Ord k => (b -> k -> a -> b) -> b -> MinPQueue k a -> b foldlWithKey _ z Empty = z foldlWithKey f z (MinPQ _ k a ts) = foldF (f z k a) ts where- extract = extractForest (<=)- foldF z ts = case extract ts of- Yes (Extract k a _ ts')- -> foldF (f z k a) ts'- _ -> z+ extract = extractForest (<=)+ foldF z ts = case extract ts of+ Yes (Extract k a _ ts') -> foldF (f z k a) ts'+ _ -> z -- | Equivalent to 'insert', save the assumption that this key is @<=@ -- every other key in the map. /The precondition is not checked./@@ -243,52 +243,51 @@ -- | /O(1)/. Takes the union of two binomial trees of the same rank. meld :: LEq k -> BinomTree rk k a -> BinomTree rk k a -> BinomTree (Succ rk) k a meld (<=) t1@(BinomTree k1 v1 ts1) t2@(BinomTree k2 v2 ts2)- | k1 <= k2 = BinomTree k1 v1 (Succ t2 ts1)- | otherwise = BinomTree k2 v2 (Succ t1 ts2)+ | k1 <= k2 = BinomTree k1 v1 (Succ t2 ts1)+ | otherwise = BinomTree k2 v2 (Succ t1 ts2) -- | Takes the union of two binomial forests, starting at the same rank. Analogous to binary addition. mergeForest :: LEq k -> BinomForest rk k a -> BinomForest rk k a -> BinomForest rk k a mergeForest (<=) f1 f2 = case (f1, f2) of- (Skip ts1, Skip ts2) -> Skip (mergeForest (<=) ts1 ts2)- (Skip ts1, Cons t2 ts2) -> Cons t2 (mergeForest (<=) ts1 ts2)- (Cons t1 ts1, Skip ts2) -> Cons t1 (mergeForest (<=) ts1 ts2)- (Cons t1 ts1, Cons t2 ts2) -> Skip (carryForest (<=) (meld (<=) t1 t2) ts1 ts2)- (Nil, _) -> f2- (_, Nil) -> f1+ (Skip ts1, Skip ts2) -> Skip (mergeForest (<=) ts1 ts2)+ (Skip ts1, Cons t2 ts2) -> Cons t2 (mergeForest (<=) ts1 ts2)+ (Cons t1 ts1, Skip ts2) -> Cons t1 (mergeForest (<=) ts1 ts2)+ (Cons t1 ts1, Cons t2 ts2) -> Skip (carryForest (<=) (meld (<=) t1 t2) ts1 ts2)+ (Nil, _) -> f2+ (_, Nil) -> f1 -- | Takes the union of two binomial forests, starting at the same rank, with an additional tree. -- Analogous to binary addition when a digit has been carried. carryForest :: LEq k -> BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a -> BinomForest rk k a carryForest (<=) t0 f1 f2 = t0 `seq` case (f1, f2) of- (Cons t1 ts1, Cons t2 ts2) -> Cons t0 (carryMeld t1 t2 ts1 ts2)- (Cons t1 ts1, Skip ts2) -> Skip (carryMeld t0 t1 ts1 ts2)- (Skip ts1, Cons t2 ts2) -> Skip (carryMeld t0 t2 ts1 ts2)- (Skip ts1, Skip ts2) -> Cons t0 (mergeForest (<=) ts1 ts2)- (Nil, _) -> incr (<=) t0 f2- (_, Nil) -> incr (<=) t0 f1- where carryMeld = carryForest (<=) .: meld (<=)+ (Cons t1 ts1, Cons t2 ts2) -> Cons t0 (carryMeld t1 t2 ts1 ts2)+ (Cons t1 ts1, Skip ts2) -> Skip (carryMeld t0 t1 ts1 ts2)+ (Skip ts1, Cons t2 ts2) -> Skip (carryMeld t0 t2 ts1 ts2)+ (Skip ts1, Skip ts2) -> Cons t0 (mergeForest (<=) ts1 ts2)+ (Nil, _) -> incr (<=) t0 f2+ (_, Nil) -> incr (<=) t0 f1+ where carryMeld = carryForest (<=) .: meld (<=) -- | Inserts a binomial tree into a binomial forest. Analogous to binary incrementation. incr :: LEq k -> BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a incr (<=) t ts = t `seq` case ts of- Nil -> Cons t Nil- Skip ts' -> Cons t ts'- Cons t' ts' -> Skip (incr (<=) (meld (<=) t t') ts')+ Nil -> Cons t Nil+ Skip ts' -> Cons t ts'+ Cons t' ts' -> Skip (incr (<=) (meld (<=) t t') ts') -- | Inserts a binomial tree into a binomial forest. Assumes that the root of this tree -- is less than all other roots. Analogous to binary incrementation. Equivalent to -- @'incr' (\ _ _ -> True)@. incrMin :: BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a incrMin t@(BinomTree k a ts) tss = case tss of- Nil -> Cons t Nil- Skip tss' -> Cons t tss'- Cons t' tss' -> Skip (incrMin (BinomTree k a (Succ t' ts)) tss')+ Nil -> Cons t Nil+ Skip tss' -> Cons t tss'+ Cons t' tss' -> Skip (incrMin (BinomTree k a (Succ t' ts)) tss') extractHeap :: LEq k -> Int -> BinomHeap k a -> MinPQueue k a extractHeap (<=) n ts = n `seq` case extractForest (<=) ts of- No -> Empty- Yes (Extract k a _ ts')- -> MinPQ (n-1) k a ts'+ No -> Empty+ Yes (Extract k a _ ts') -> MinPQ (n-1) k a ts' -- | A specialized type intended to organize the return of extract-min queries -- from a binomial forest. We walk all the way through the forest, and then@@ -298,31 +297,31 @@ -- -- The interpretation of @Extract minKey minVal children forest@ is -- --- * @minKey@ is the key of the minimum root visited so far. It may have--- any rank @>= rk@. We will denote the root corresponding to --- @minKey@ as @minRoot@.--- --- * @minVal@ is the value corresponding to @minKey@.--- --- * @children@ is those children of @minRoot@ which have not yet been --- merged with the rest of the forest. Specifically, these are --- the children with rank @< rk@.--- --- * @forest@ is an accumulating parameter that maintains the partial --- reconstruction of the binomial forest without @minRoot@. It is --- the union of all old roots with rank @>= rk@ (except @minRoot@), --- with the set of all children of @minRoot@ with rank @>= rk@. --- Note that @forest@ is lazy, so if we discover a smaller key --- than @minKey@ later, we haven't wasted significant work.+-- * @minKey@ is the key of the minimum root visited so far. It may have+-- any rank @>= rk@. We will denote the root corresponding to +-- @minKey@ as @minRoot@.+-- +-- * @minVal@ is the value corresponding to @minKey@.+-- +-- * @children@ is those children of @minRoot@ which have not yet been +-- merged with the rest of the forest. Specifically, these are +-- the children with rank @< rk@.+-- +-- * @forest@ is an accumulating parameter that maintains the partial +-- reconstruction of the binomial forest without @minRoot@. It is +-- the union of all old roots with rank @>= rk@ (except @minRoot@), +-- with the set of all children of @minRoot@ with rank @>= rk@. +-- Note that @forest@ is lazy, so if we discover a smaller key +-- than @minKey@ later, we haven't wasted significant work. data Extract rk k a = Extract k a (rk k a) (BinomForest rk k a) data MExtract rk k a = No | Yes {-# UNPACK #-} !(Extract rk k a) incrExtract :: LEq k -> Maybe (BinomTree rk k a) -> Extract (Succ rk) k a -> Extract rk k a incrExtract (<=) Nothing (Extract k a (Succ t ts) tss)- = Extract k a ts (Cons t tss)+ = Extract k a ts (Cons t tss) incrExtract (<=) (Just t) (Extract k a (Succ t' ts) tss)- = Extract k a ts (Skip (incr (<=) (meld (<=) t t') tss))+ = Extract k a ts (Skip (incr (<=) (meld (<=) t t') tss)) -- | Walks backward from the biggest key in the forest, as far as rank @rk@. -- Returns its progress. Each successive application of @extractBin@ takes@@ -330,53 +329,55 @@ extractForest :: LEq k -> BinomForest rk k a -> MExtract rk k a extractForest _ Nil = No extractForest (<=) (Skip tss) = case extractForest (<=) tss of- No -> No- Yes ex -> Yes (incrExtract (<=) Nothing ex)+ No -> No+ Yes ex -> Yes (incrExtract (<=) Nothing ex) extractForest (<=) (Cons t@(BinomTree k a ts) tss) = Yes $ case extractForest (<=) tss of- Yes ex@(Extract k' _ _ _)- | k' <? k -> incrExtract (<=) (Just t) ex- _ -> Extract k a ts (Skip tss)- where a <? b = not (b <= a)+ Yes ex@(Extract k' _ _ _)+ | k' <? k -> incrExtract (<=) (Just t) ex+ _ -> Extract k a ts (Skip tss)+ where+ a <? b = not (b <= a) -- | Utility function for mapping over a forest. mapForest :: (k -> a -> b) -> (rk k a -> rk k b) -> BinomForest rk k a -> BinomForest rk k b mapForest f fCh ts = case ts of- Nil -> Nil- Skip ts' -> Skip (mapForest f fCh' ts')- Cons (BinomTree k a ts) tss- -> Cons (BinomTree k (f k a) (fCh ts)) (mapForest f fCh' tss)- where fCh' (Succ (BinomTree k a ts) tss)- = Succ (BinomTree k (f k a) (fCh ts)) (fCh tss)+ Nil -> Nil+ Skip ts' -> Skip (mapForest f fCh' ts')+ Cons (BinomTree k a ts) tss+ -> Cons (BinomTree k (f k a) (fCh ts)) (mapForest f fCh' tss)+ where fCh' (Succ (BinomTree k a ts) tss)+ = Succ (BinomTree k (f k a) (fCh ts)) (fCh tss) -- | Utility function for mapping a 'Maybe' function over a forest. mapMaybeF :: LEq k -> (k -> a -> Maybe b) -> (rk k a -> MinPQueue k b) ->- BinomForest rk k a -> MinPQueue k b+ BinomForest rk k a -> MinPQueue k b mapMaybeF (<=) f fCh ts = case ts of- Nil -> Empty- Skip ts' -> mapMaybeF (<=) f fCh' ts'- Cons (BinomTree k a ts) ts'- -> insF k a (fCh ts) (mapMaybeF (<=) f fCh' ts')- where insF k a = maybe id (insert' (<=) k) (f k a) .: union' (<=)- fCh' (Succ (BinomTree k a ts) tss) =- insF k a (fCh ts) (fCh tss)+ Nil -> Empty+ Skip ts' -> mapMaybeF (<=) f fCh' ts'+ Cons (BinomTree k a ts) ts'+ -> insF k a (fCh ts) (mapMaybeF (<=) f fCh' ts')+ where insF k a = maybe id (insert' (<=) k) (f k a) .: union' (<=)+ fCh' (Succ (BinomTree k a ts) tss) =+ insF k a (fCh ts) (fCh tss) -- | Utility function for mapping an 'Either' function over a forest. mapEitherF :: LEq k -> (k -> a -> Either b c) -> (rk k a -> (MinPQueue k b, MinPQueue k c)) ->- BinomForest rk k a -> (MinPQueue k b, MinPQueue k c)+ BinomForest rk k a -> (MinPQueue k b, MinPQueue k c) mapEitherF (<=) f fCh ts = case ts of- Nil -> (Empty, Empty)- Skip ts' -> mapEitherF (<=) f fCh' ts'- Cons (BinomTree k a ts) ts'- -> insF k a (fCh ts) (mapEitherF (<=) f fCh' ts')- where insF k a = either (first' . insert' (<=) k) (second' . insert' (<=) k) (f k a) .: - (union' (<=) `both` union' (<=))- fCh' (Succ (BinomTree k a ts) tss) =- insF k a (fCh ts) (fCh tss)- both f g (x1, x2) (y1, y2) = (f x1 y1, g x2 y2)+ Nil -> (Empty, Empty)+ Skip ts' -> mapEitherF (<=) f fCh' ts'+ Cons (BinomTree k a ts) ts'+ -> insF k a (fCh ts) (mapEitherF (<=) f fCh' ts')+ where+ insF k a = either (first' . insert' (<=) k) (second' . insert' (<=) k) (f k a) .: + (union' (<=) `both` union' (<=))+ fCh' (Succ (BinomTree k a ts) tss) =+ insF k a (fCh ts) (fCh tss)+ both f g (x1, x2) (y1, y2) = (f x1 y1, g x2 y2) -- | /O(n)/. An unordered right fold over the elements of the queue, in no particular order. foldrWithKeyU :: (k -> a -> b -> b) -> b -> MinPQueue k a -> b-foldrWithKeyU _ z Empty = z+foldrWithKeyU _ z Empty = z foldrWithKeyU f z (MinPQ _ k a ts) = f k a (foldrWithKeyF_ f (const id) ts z) -- | /O(n)/. An unordered left fold over the elements of the queue, in no particular order.@@ -389,73 +390,77 @@ traverseWithKeyU f (MinPQ n k a ts) = MinPQ n k <$> f k a <*> traverseForest f (const (pure Zero)) ts {-# SPECIALIZE traverseForest :: (k -> a -> Identity b) -> (rk k a -> Identity (rk k b)) -> BinomForest rk k a ->- Identity (BinomForest rk k b) #-}+ Identity (BinomForest rk k b) #-} traverseForest :: (Applicative f) => (k -> a -> f b) -> (rk k a -> f (rk k b)) -> BinomForest rk k a -> f (BinomForest rk k b) traverseForest f fCh ts = case ts of- Nil -> pure Nil- Skip ts' -> Skip <$> traverseForest f fCh' ts'- Cons (BinomTree k a ts) tss- -> Cons <$> (BinomTree k <$> f k a <*> fCh ts) <*> traverseForest f fCh' tss- where fCh' (Succ (BinomTree k a ts) tss)- = Succ <$> (BinomTree k <$> f k a <*> fCh ts) <*> fCh tss+ Nil -> pure Nil+ Skip ts' -> Skip <$> traverseForest f fCh' ts'+ Cons (BinomTree k a ts) tss+ -> Cons <$> (BinomTree k <$> f k a <*> fCh ts) <*> traverseForest f fCh' tss+ where + fCh' (Succ (BinomTree k a ts) tss)+ = Succ <$> (BinomTree k <$> f k a <*> fCh ts) <*> fCh tss -- | Unordered right fold on a binomial forest. foldrWithKeyF_ :: (k -> a -> b -> b) -> (rk k a -> b -> b) -> BinomForest rk k a -> b -> b foldrWithKeyF_ f fCh ts z = case ts of- Nil -> z- Skip ts' -> foldrWithKeyF_ f fCh' ts' z- Cons (BinomTree k a ts) ts'- -> f k a (fCh ts (foldrWithKeyF_ f fCh' ts' z))- where fCh' (Succ (BinomTree k a ts) tss) z =- f k a (fCh ts (fCh tss z))+ Nil -> z+ Skip ts' -> foldrWithKeyF_ f fCh' ts' z+ Cons (BinomTree k a ts) ts'+ -> f k a (fCh ts (foldrWithKeyF_ f fCh' ts' z))+ where+ fCh' (Succ (BinomTree k a ts) tss) z =+ f k a (fCh ts (fCh tss z)) -- | Unordered left fold on a binomial forest. foldlWithKeyF_ :: (k -> a -> b -> b) -> (rk k a -> b -> b) -> BinomForest rk k a -> b -> b foldlWithKeyF_ f fCh ts = case ts of- Nil -> id- Skip ts' -> foldlWithKeyF_ f fCh' ts'- Cons (BinomTree k a ts) ts'- -> foldlWithKeyF_ f fCh' ts' . fCh ts . f k a- where fCh' (Succ (BinomTree k a ts) tss) =- fCh tss . fCh ts . f k a+ Nil -> id+ Skip ts' -> foldlWithKeyF_ f fCh' ts'+ Cons (BinomTree k a ts) ts'+ -> foldlWithKeyF_ f fCh' ts' . fCh ts . f k a+ where + fCh' (Succ (BinomTree k a ts) tss) =+ fCh tss . fCh ts . f k a -- | Maps a monotonic function over the keys in a binomial forest. mapKeysMonoF :: (k -> k') -> (rk k a -> rk k' a) -> BinomForest rk k a -> BinomForest rk k' a mapKeysMonoF f fCh ts = case ts of- Nil -> Nil- Skip ts' -> Skip (mapKeysMonoF f fCh' ts')- Cons (BinomTree k a ts) ts'- -> Cons (BinomTree (f k) a (fCh ts)) (mapKeysMonoF f fCh' ts')- where fCh' (Succ (BinomTree k a ts) tss) =- Succ (BinomTree (f k) a (fCh ts)) (fCh tss)+ Nil -> Nil+ Skip ts' -> Skip (mapKeysMonoF f fCh' ts')+ Cons (BinomTree k a ts) ts'+ -> Cons (BinomTree (f k) a (fCh ts)) (mapKeysMonoF f fCh' ts')+ where+ fCh' (Succ (BinomTree k a ts) tss) =+ Succ (BinomTree (f k) a (fCh ts)) (fCh tss) -- | /O(log n)/. Analogous to @deepseq@ in the @deepseq@ package, but only forces the spine of the binomial heap. seqSpine :: MinPQueue k a -> b -> b seqSpine Empty z = z seqSpine (MinPQ _ _ _ ts) z = ts `seqSpineF` z where- seqSpineF :: BinomForest rk k a -> b -> b- seqSpineF ts z = case ts of- Nil -> z- Skip ts' -> seqSpineF ts' z- Cons _ ts' -> seqSpineF ts' z+ seqSpineF :: BinomForest rk k a -> b -> b+ seqSpineF ts z = case ts of+ Nil -> z+ Skip ts' -> seqSpineF ts' z+ Cons _ ts' -> seqSpineF ts' z class NFRank rk where- rnfRk :: (NFData k, NFData a) => rk k a -> ()+ rnfRk :: (NFData k, NFData a) => rk k a -> () instance NFRank Zero where- rnfRk _ = ()+ rnfRk _ = () instance NFRank rk => NFRank (Succ rk) where- rnfRk (Succ t ts) = t `deepseq` rnfRk ts+ rnfRk (Succ t ts) = t `deepseq` rnfRk ts instance (NFData k, NFData a, NFRank rk) => NFData (BinomTree rk k a) where- rnf (BinomTree k a ts) = k `deepseq` a `deepseq` rnfRk ts+ rnf (BinomTree k a ts) = k `deepseq` a `deepseq` rnfRk ts instance (NFData k, NFData a, NFRank rk) => NFData (BinomForest rk k a) where- rnf Nil = ()- rnf (Skip tss) = rnf tss- rnf (Cons t tss) = t `deepseq` rnf tss+ rnf Nil = ()+ rnf (Skip tss) = rnf tss+ rnf (Cons t tss) = t `deepseq` rnf tss instance (NFData k, NFData a) => NFData (MinPQueue k a) where- rnf Empty = ()- rnf (MinPQ _ k a ts) = k `deepseq` a `deepseq` rnf ts+ rnf Empty = ()+ rnf (MinPQ _ k a ts) = k `deepseq` a `deepseq` rnf ts
Data/PQueue/Prio/Max.hs view
@@ -31,94 +31,94 @@ -- these functions. ----------------------------------------------------------------------------- module Data.PQueue.Prio.Max (- MaxPQueue,- -- * Construction- empty,- singleton,- insert,- union,- unions, - -- * Query- null,- size,- -- ** Maximum view- findMax,- getMax,- deleteMax,- deleteFindMax,- adjustMax,- adjustMaxWithKey,- updateMax,- updateMaxWithKey,- maxView,- maxViewWithKey,- -- * Traversal- -- ** Map- map,- mapWithKey,- mapKeys,- mapKeysMonotonic,- -- ** Fold- foldrWithKey,- foldlWithKey,- -- ** Traverse- traverseWithKey,- -- * Subsets- -- ** Indexed- take,- drop,- splitAt,- -- ** Predicates- takeWhile,- takeWhileWithKey,- dropWhile,- dropWhileWithKey,- span,- spanWithKey,- break,- breakWithKey,- -- *** Filter- filter,- filterWithKey,- partition,- partitionWithKey,- mapMaybe,- mapMaybeWithKey,- mapEither,- mapEitherWithKey,- -- * List operations- -- ** Conversion from lists- fromList,- fromAscList,- fromDescList,- -- ** Conversion to lists- keys,- elems,- assocs,- toAscList,- toDescList,- toList,- -- * Unordered operations- foldrU,- foldrWithKeyU,- foldlU,- foldlWithKeyU,- traverseU,- traverseWithKeyU,- keysU,- elemsU,- assocsU,- toListU,- -- * Helper methods- seqSpine- )- where+ MaxPQueue,+ -- * Construction+ empty,+ singleton,+ insert,+ union,+ unions, + -- * Query+ null,+ size,+ -- ** Maximum view+ findMax,+ getMax,+ deleteMax,+ deleteFindMax,+ adjustMax,+ adjustMaxWithKey,+ updateMax,+ updateMaxWithKey,+ maxView,+ maxViewWithKey,+ -- * Traversal+ -- ** Map+ map,+ mapWithKey,+ mapKeys,+ mapKeysMonotonic,+ -- ** Fold+ foldrWithKey,+ foldlWithKey,+ -- ** Traverse+ traverseWithKey,+ -- * Subsets+ -- ** Indexed+ take,+ drop,+ splitAt,+ -- ** Predicates+ takeWhile,+ takeWhileWithKey,+ dropWhile,+ dropWhileWithKey,+ span,+ spanWithKey,+ break,+ breakWithKey,+ -- *** Filter+ filter,+ filterWithKey,+ partition,+ partitionWithKey,+ mapMaybe,+ mapMaybeWithKey,+ mapEither,+ mapEitherWithKey,+ -- * List operations+ -- ** Conversion from lists+ fromList,+ fromAscList,+ fromDescList,+ -- ** Conversion to lists+ keys,+ elems,+ assocs,+ toAscList,+ toDescList,+ toList,+ -- * Unordered operations+ foldrU,+ foldrWithKeyU,+ foldlU,+ foldlWithKeyU,+ traverseU,+ traverseWithKeyU,+ keysU,+ elemsU,+ assocsU,+ toListU,+ -- * Helper methods+ seqSpine+ )+ where import Control.Applicative hiding (empty) import Control.Arrow import Data.Monoid import qualified Data.List as List-import Data.Foldable hiding (toList)+import Data.Foldable (Foldable, foldr, foldl) import Data.Traversable import Data.Maybe hiding (mapMaybe) import Data.PQueue.Prio.Max.Internals@@ -130,7 +130,7 @@ #ifdef __GLASGOW_HASKELL__ import GHC.Exts (build) import Text.Read (Lexeme(Ident), lexP, parens, prec,- readPrec, readListPrec, readListPrecDefault)+ readPrec, readListPrec, readListPrecDefault) import Data.Data #else build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]@@ -144,33 +144,33 @@ second' f (a, b) = (a, f b) instance (Ord k, Show k, Show a) => Show (MaxPQueue k a) where- showsPrec p xs = showParen (p > 10) $- showString "fromDescList " . shows (toDescList xs)+ showsPrec p xs = showParen (p > 10) $+ showString "fromDescList " . shows (toDescList xs) instance (Read k, Read a) => Read (MaxPQueue k a) where #ifdef __GLASGOW_HASKELL__- readPrec = parens $ prec 10 $ do- Ident "fromDescList" <- lexP- xs <- readPrec- return (fromDescList xs)+ readPrec = parens $ prec 10 $ do+ Ident "fromDescList" <- lexP+ xs <- readPrec+ return (fromDescList xs) - readListPrec = readListPrecDefault+ readListPrec = readListPrecDefault #else- readsPrec p = readParen (p > 10) $ \ r -> do- ("fromDescList",s) <- lex r- (xs,t) <- reads s- return (fromDescList xs,t)+ readsPrec p = readParen (p > 10) $ \ r -> do+ ("fromDescList",s) <- lex r+ (xs,t) <- reads s+ return (fromDescList xs,t) #endif instance Functor (MaxPQueue k) where- fmap f (MaxPQ q) = MaxPQ (fmap f q)+ fmap f (MaxPQ q) = MaxPQ (fmap f q) instance Ord k => Foldable (MaxPQueue k) where- foldr f z (MaxPQ q) = foldr f z q- foldl f z (MaxPQ q) = foldl f z q+ foldr f z (MaxPQ q) = foldr f z q+ foldl f z (MaxPQ q) = foldl f z q instance Ord k => Traversable (MaxPQueue k) where- traverse f (MaxPQ q) = MaxPQ <$> traverse f q+ traverse f (MaxPQ q) = MaxPQ <$> traverse f q -- | /O(1)/. Returns the empty priority queue. empty :: MaxPQueue k a@@ -209,8 +209,8 @@ -- | /O(1)/. The maximal (key, element) in the queue, if the queue is nonempty. getMax :: MaxPQueue k a -> Maybe (k, a) getMax (MaxPQ q) = do- (Down k, a) <- Q.getMin q- return (k, a)+ (Down k, a) <- Q.getMin q+ return (k, a) -- | /O(log n)/. Delete and find the element with the maximum key. Calls 'error' if empty. deleteMax :: Ord k => MaxPQueue k a -> MaxPQueue k a@@ -242,15 +242,15 @@ -- stripped of that element, or 'Nothing' if passed an empty queue. maxView :: Ord k => MaxPQueue k a -> Maybe (a, MaxPQueue k a) maxView q = do- ((_, a), q') <- maxViewWithKey q- return (a, q')+ ((_, a), q') <- maxViewWithKey q+ return (a, q') -- | /O(log n)/. Retrieves the maximal (key, value) pair of the map, and the map stripped of that -- element, or 'Nothing' if passed an empty map. maxViewWithKey :: Ord k => MaxPQueue k a -> Maybe ((k, a), MaxPQueue k a) maxViewWithKey (MaxPQ q) = do- ((Down k, a), q') <- Q.minViewWithKey q- return ((k, a), MaxPQ q')+ ((Down k, a), q') <- Q.minViewWithKey q+ return ((k, a), MaxPQ q') -- | /O(n)/. Map a function over all values in the queue. map :: (a -> b) -> MaxPQueue k a -> MaxPQueue k b@@ -303,7 +303,7 @@ -- | /O(k log n)/. Equivalent to @('take' k q, 'drop' k q)@. splitAt :: Ord k => Int -> MaxPQueue k a -> ([(k, a)], MaxPQueue k a) splitAt k (MaxPQ q) = case Q.splitAt k q of- (xs, q') -> (fmap (first' unDown) xs, MaxPQ q')+ (xs, q') -> (fmap (first' unDown) xs, MaxPQ q') -- | Takes the longest possible prefix of elements satisfying the predicate. -- (@'takeWhile' p q == 'List.takeWhile' (p . 'snd') ('toAscList' q)@)@@ -334,12 +334,12 @@ -- | Equivalent to @'spanWithKey' (\ k a -> 'not' (p k a)) q@. spanWithKey :: Ord k => (k -> a -> Bool) -> MaxPQueue k a -> ([(k, a)], MaxPQueue k a) spanWithKey p (MaxPQ q) = case Q.spanWithKey (p . unDown) q of- (xs, q') -> (fmap (first' unDown) xs, MaxPQ q')+ (xs, q') -> (fmap (first' unDown) xs, MaxPQ q') -- | Equivalent to @'spanWithKey' (\ k a -> 'not' (p k a)) q@. breakWithKey :: Ord k => (k -> a -> Bool) -> MaxPQueue k a -> ([(k, a)], MaxPQueue k a) breakWithKey p (MaxPQ q) = case Q.breakWithKey (p . unDown) q of- (xs, q') -> (fmap (first' unDown) xs, MaxPQ q')+ (xs, q') -> (fmap (first' unDown) xs, MaxPQ q') -- | /O(n)/. Filter all values that satisfy the predicate. filter :: Ord k => (a -> Bool) -> MaxPQueue k a -> MaxPQueue k a@@ -358,7 +358,7 @@ -- which satisfy the predicate, the second all elements that fail the predicate. partitionWithKey :: Ord k => (k -> a -> Bool) -> MaxPQueue k a -> (MaxPQueue k a, MaxPQueue k a) partitionWithKey p (MaxPQ q) = case Q.partitionWithKey (p . unDown) q of- (q1, q0) -> (MaxPQ q1, MaxPQ q0)+ (q1, q0) -> (MaxPQ q1, MaxPQ q0) -- | /O(n)/. Map values and collect the 'Just' results. mapMaybe :: Ord k => (a -> Maybe b) -> MaxPQueue k a -> MaxPQueue k b@@ -375,7 +375,7 @@ -- | /O(n)/. Map values and separate the 'Left' and 'Right' results. mapEitherWithKey :: Ord k => (k -> a -> Either b c) -> MaxPQueue k a -> (MaxPQueue k b, MaxPQueue k c) mapEitherWithKey f (MaxPQ q) = case Q.mapEitherWithKey (f . unDown) q of- (qL, qR) -> (MaxPQ qL, MaxPQ qR)+ (qL, qR) -> (MaxPQ qL, MaxPQ qR) -- | /O(n)/. Build a priority queue from the list of (key, value) pairs. fromList :: Ord k => [(k, a)] -> MaxPQueue k a
Data/PQueue/Prio/Max/Internals.hs view
@@ -17,37 +17,36 @@ newtype Down a = Down {unDown :: a} # if __GLASGOW_HASKELL__- deriving (Eq, Data, Typeable)+ deriving (Eq, Data, Typeable) # else- deriving (Eq)+ deriving (Eq) # endif -- | A priority queue where values of type @a@ are annotated with keys of type @k@. -- The queue supports extracting the element with maximum key. newtype MaxPQueue k a = MaxPQ (MinPQueue (Down k) a) # if __GLASGOW_HASKELL__- deriving (Eq, Ord, Data, Typeable)+ deriving (Eq, Ord, Data, Typeable) # else- deriving (Eq, Ord)+ deriving (Eq, Ord) # endif instance (NFData k, NFData a) => NFData (MaxPQueue k a) where- rnf (MaxPQ q) = rnf q+ rnf (MaxPQ q) = rnf q instance NFData a => NFData (Down a) where- rnf (Down a) = rnf a+ rnf (Down a) = rnf a instance Ord a => Ord (Down a) where- Down a `compare` Down b = b `compare` a- Down a <= Down b = b <= a+ Down a `compare` Down b = b `compare` a+ Down a <= Down b = b <= a instance Functor Down where- fmap f (Down a) = Down (f a)-+ fmap f (Down a) = Down (f a) instance Foldable Down where- foldr f z (Down a) = a `f` z- foldl f z (Down a) = z `f` a+ foldr f z (Down a) = a `f` z+ foldl f z (Down a) = z `f` a instance Traversable Down where- traverse f (Down a) = Down <$> f a+ traverse f (Down a) = Down <$> f a
Data/PQueue/Prio/Min.hs view
@@ -31,93 +31,93 @@ -- these functions. ----------------------------------------------------------------------------- module Data.PQueue.Prio.Min (- MinPQueue,- -- * Construction- empty,- singleton,- insert,- union,- unions, - -- * Query- null,- size,- -- ** Minimum view- findMin,- getMin,- deleteMin,- deleteFindMin,- adjustMin,- adjustMinWithKey,- updateMin,- updateMinWithKey,- minView,- minViewWithKey,- -- * Traversal- -- ** Map- map,- mapWithKey,- mapKeys,- mapKeysMonotonic,- -- ** Fold- foldrWithKey,- foldlWithKey,- -- ** Traverse- traverseWithKey,- -- * Subsets- -- ** Indexed- take,- drop,- splitAt,- -- ** Predicates- takeWhile,- takeWhileWithKey,- dropWhile,- dropWhileWithKey,- span,- spanWithKey,- break,- breakWithKey,- -- *** Filter- filter,- filterWithKey,- partition,- partitionWithKey,- mapMaybe,- mapMaybeWithKey,- mapEither,- mapEitherWithKey,- -- * List operations- -- ** Conversion from lists- fromList,- fromAscList,- fromDescList,- -- ** Conversion to lists- keys,- elems,- assocs,- toAscList,- toDescList,- toList,- -- * Unordered operations- foldrU,- foldrWithKeyU,- foldlU,- foldlWithKeyU,- traverseU,- traverseWithKeyU,- keysU,- elemsU,- assocsU,- toListU,- -- * Helper methods- seqSpine- )- where+ MinPQueue,+ -- * Construction+ empty,+ singleton,+ insert,+ union,+ unions, + -- * Query+ null,+ size,+ -- ** Minimum view+ findMin,+ getMin,+ deleteMin,+ deleteFindMin,+ adjustMin,+ adjustMinWithKey,+ updateMin,+ updateMinWithKey,+ minView,+ minViewWithKey,+ -- * Traversal+ -- ** Map+ map,+ mapWithKey,+ mapKeys,+ mapKeysMonotonic,+ -- ** Fold+ foldrWithKey,+ foldlWithKey,+ -- ** Traverse+ traverseWithKey,+ -- * Subsets+ -- ** Indexed+ take,+ drop,+ splitAt,+ -- ** Predicates+ takeWhile,+ takeWhileWithKey,+ dropWhile,+ dropWhileWithKey,+ span,+ spanWithKey,+ break,+ breakWithKey,+ -- *** Filter+ filter,+ filterWithKey,+ partition,+ partitionWithKey,+ mapMaybe,+ mapMaybeWithKey,+ mapEither,+ mapEitherWithKey,+ -- * List operations+ -- ** Conversion from lists+ fromList,+ fromAscList,+ fromDescList,+ -- ** Conversion to lists+ keys,+ elems,+ assocs,+ toAscList,+ toDescList,+ toList,+ -- * Unordered operations+ foldrU,+ foldrWithKeyU,+ foldlU,+ foldlWithKeyU,+ traverseU,+ traverseWithKeyU,+ keysU,+ elemsU,+ assocsU,+ toListU,+ -- * Helper methods+ seqSpine+ )+ where import Control.Applicative (Applicative (..), (<$>)) import Data.Monoid import qualified Data.List as List-import Data.Foldable hiding (toList)+import Data.Foldable (Foldable, foldl, foldr, foldl') import Data.Traversable import Data.Maybe (fromMaybe) @@ -128,7 +128,7 @@ #ifdef __GLASGOW_HASKELL__ import GHC.Exts (build) import Text.Read (Lexeme(Ident), lexP, parens, prec,- readPrec, readListPrec, readListPrecDefault)+ readPrec, readListPrec, readListPrecDefault) import Data.Data #else build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]@@ -150,27 +150,27 @@ infixr 8 .: instance Ord k => Monoid (MinPQueue k a) where- mempty = empty- mappend = union- mconcat = unions+ mempty = empty+ mappend = union+ mconcat = unions instance (Ord k, Show k, Show a) => Show (MinPQueue k a) where- showsPrec p xs = showParen (p > 10) $- showString "fromAscList " . shows (toAscList xs)+ showsPrec p xs = showParen (p > 10) $+ showString "fromAscList " . shows (toAscList xs) instance (Read k, Read a) => Read (MinPQueue k a) where #ifdef __GLASGOW_HASKELL__- readPrec = parens $ prec 10 $ do- Ident "fromAscList" <- lexP- xs <- readPrec- return (fromAscList xs)+ readPrec = parens $ prec 10 $ do+ Ident "fromAscList" <- lexP+ xs <- readPrec+ return (fromAscList xs) - readListPrec = readListPrecDefault+ readListPrec = readListPrecDefault #else- readsPrec p = readParen (p > 10) $ \ r -> do- ("fromAscList",s) <- lex r- (xs,t) <- reads s- return (fromAscList xs,t)+ readsPrec p = readParen (p > 10) $ \ r -> do+ ("fromAscList",s) <- lex r+ (xs,t) <- reads s+ return (fromAscList xs,t) #endif @@ -203,8 +203,8 @@ -- | /O(log n)/. Retrieves the value associated with the minimal key of the queue, and the queue -- stripped of that element, or 'Nothing' if passed an empty queue. minView :: Ord k => MinPQueue k a -> Maybe (a, MinPQueue k a)-minView q = do ((_, a), q') <- minViewWithKey q- return (a, q')+minView q = do ((_, a), q') <- minViewWithKey q+ return (a, q') -- | /O(n)/. Map a function over all values in the queue. map :: (a -> b) -> MinPQueue k a -> MinPQueue k b@@ -220,8 +220,8 @@ -- If you do not care about the /order/ of the traversal, consider using 'traverseWithKeyU'. traverseWithKey :: (Ord k, Applicative f) => (k -> a -> f b) -> MinPQueue k a -> f (MinPQueue k b) traverseWithKey f q = case minViewWithKey q of- Nothing -> pure empty- Just ((k, a), q') -> insertMin k <$> f k a <*> traverseWithKey f q'+ Nothing -> pure empty+ Just ((k, a), q') -> insertMin k <$> f k a <*> traverseWithKey f q' -- | /O(n)/. Map values and collect the 'Just' results. mapMaybe :: Ord k => (a -> Maybe b) -> MinPQueue k a -> MinPQueue k b@@ -258,20 +258,21 @@ -- | /O(k log n)/. Deletes the first @k@ (key, value) pairs in the queue, or returns an empty queue if @k >= n@. drop :: Ord k => Int -> MinPQueue k a -> MinPQueue k a drop n q - | n <= 0 = q- | n >= size q = empty- | otherwise = drop' n q- where drop' n q- | n == 0 = q- | otherwise = drop' (n-1) (deleteMin q)+ | n <= 0 = q+ | n >= size q = empty+ | otherwise = drop' n q+ where+ drop' n q+ | n == 0 = q+ | otherwise = drop' (n-1) (deleteMin q) -- | /O(k log n)/. Equivalent to @('take' k q, 'drop' k q)@. splitAt :: Ord k => Int -> MinPQueue k a -> ([(k, a)], MinPQueue k a) splitAt n q - | n <= 0 = ([], q)- | otherwise = n `seq` case minViewWithKey q of- Just (ka, q') -> let (kas, q'') = splitAt (n-1) q' in (ka:kas, q'')- _ -> ([], q)+ | n <= 0 = ([], q)+ | otherwise = n `seq` case minViewWithKey q of+ Just (ka, q') -> let (kas, q'') = splitAt (n-1) q' in (ka:kas, q'')+ _ -> ([], q) {-# INLINE takeWhile #-} -- | Takes the longest possible prefix of elements satisfying the predicate.@@ -284,7 +285,7 @@ -- (@'takeWhile' p q == 'List.takeWhile' (uncurry p) ('toAscList' q)@) takeWhileWithKey :: Ord k => (k -> a -> Bool) -> MinPQueue k a -> [(k, a)] takeWhileWithKey p = takeWhileFB (uncurry' p) . toAscList where- takeWhileFB p xs = build (\ c n -> foldr (\ x z -> if p x then x `c` z else n) n xs)+ takeWhileFB p xs = build (\ c n -> foldr (\ x z -> if p x then x `c` z else n) n xs) -- | Removes the longest possible prefix of elements satisfying the predicate. dropWhile :: Ord k => (a -> Bool) -> MinPQueue k a -> MinPQueue k a@@ -293,9 +294,9 @@ -- | Removes the longest possible prefix of elements satisfying the predicate. dropWhileWithKey :: Ord k => (k -> a -> Bool) -> MinPQueue k a -> MinPQueue k a dropWhileWithKey p q = case minViewWithKey q of- Just ((k, a), q')- | p k a -> dropWhileWithKey p q'- _ -> q+ Just ((k, a), q')+ | p k a -> dropWhileWithKey p q'+ _ -> q -- | Equivalent to @('takeWhile' p q, 'dropWhile' p q)@. span :: Ord k => (a -> Bool) -> MinPQueue k a -> ([(k, a)], MinPQueue k a)@@ -309,9 +310,9 @@ -- | Equivalent to @'spanWithKey' (\ k a -> 'not' (p k a)) q@. breakWithKey :: Ord k => (k -> a -> Bool) -> MinPQueue k a -> ([(k, a)], MinPQueue k a) spanWithKey p q = case minViewWithKey q of- Just ((k, a), q')- | p k a -> let (kas, q'') = spanWithKey p q' in ((k, a):kas, q'')- _ -> ([], q)+ Just ((k, a), q')+ | p k a -> let (kas, q'') = spanWithKey p q' in ((k, a):kas, q'')+ _ -> ([], q) breakWithKey p = spanWithKey (not .: p) -- | /O(n)/. Build a priority queue from the list of (key, value) pairs.@@ -327,11 +328,11 @@ fromDescList = foldl' (\ q (k, a) -> insertMin k a q) empty {-# RULES- "fromList/build" forall (g :: forall b . ((k, a) -> b -> b) -> b -> b) . - fromList (build g) = g (uncurry' insert) empty;- "fromAscList/build" forall (g :: forall b . ((k, a) -> b -> b) -> b -> b) .- fromAscList (build g) = g (uncurry' insertMin) empty;- #-}+ "fromList/build" forall (g :: forall b . ((k, a) -> b -> b) -> b -> b) . + fromList (build g) = g (uncurry' insert) empty;+ "fromAscList/build" forall (g :: forall b . ((k, a) -> b -> b) -> b -> b) .+ fromAscList (build g) = g (uncurry' insertMin) empty;+ #-} {-# INLINE keys #-} -- | /O(n log n)/. Return all keys of the queue in ascending order.@@ -352,10 +353,10 @@ toDescList = foldlWithKey (\ z k a -> (k, a) : z) [] {-# RULES- "toAscList" toAscList = \ q -> build (\ c n -> foldrWithKey (curry c) n q);- "toDescList" toDescList = \ q -> build (\ c n -> foldlWithKey (\ z k a -> (k, a) `c` z) n q);- "toListU" toListU = \ q -> build (\ c n -> foldrWithKeyU (curry c) n q);- #-}+ "toAscList" toAscList = \ q -> build (\ c n -> foldrWithKey (curry c) n q);+ "toDescList" toDescList = \ q -> build (\ c n -> foldlWithKey (\ z k a -> (k, a) `c` z) n q);+ "toListU" toListU = \ q -> build (\ c n -> foldrWithKeyU (curry c) n q);+ #-} {-# INLINE toList #-} -- | /O(n log n)/. Equivalent to 'toAscList'.@@ -403,11 +404,11 @@ traverseU = traverseWithKeyU . const instance Functor (MinPQueue k) where- fmap = map+ fmap = map instance Ord k => Foldable (MinPQueue k) where- foldr = foldrWithKey . const- foldl f = foldlWithKey (const . f)+ foldr = foldrWithKey . const+ foldl f = foldlWithKey (const . f) instance Ord k => Traversable (MinPQueue k) where- traverse = traverseWithKey . const+ traverse = traverseWithKey . const
pqueue.cabal view
@@ -1,33 +1,35 @@-Name: pqueue-Version: 1.2.1-Category: Data Structures-Author: Louis Wasserman-License: BSD3-License-file: LICENSE-Stability: experimental-Synopsis: Reliable, persistent, fast priority queues.-Description: A fast, reliable priority queue implementation based on a binomial heap.-Maintainer: Louis Wasserman <wasserman.louis@gmail.com>-Build-type: Simple-cabal-version: >= 1.6+Name: pqueue+Version: 1.3.0+Category: Data Structures+Author: Louis Wasserman+License: BSD3+License-file: LICENSE+Stability: experimental+Synopsis: Reliable, persistent, fast priority queues.+Description: A fast, reliable priority queue implementation based on a binomial heap.+Maintainer: Lennart Spitzner <lsp@informatik.uni-kiel.de>+ Louis Wasserman <wasserman.louis@gmail.com>+Bug-reports: https://github.com/lspitzner/pqueue/issues+Build-type: Simple+cabal-version: >= 1.6 extra-source-files: include/Typeable.h source-repository head- type: darcs- location: http://code.haskell.org/containers-pqueue/+ type: git+ location: git@github.com:lspitzner/pqueue.git -Library{- build-depends: base >= 4 && < 5, deepseq+Library {+ build-depends: base >= 4 && < 4.9, deepseq exposed-modules:- Data.PQueue.Prio.Min- Data.PQueue.Prio.Max- Data.PQueue.Min- Data.PQueue.Max+ Data.PQueue.Prio.Min+ Data.PQueue.Prio.Max+ Data.PQueue.Min+ Data.PQueue.Max other-modules:- Data.PQueue.Prio.Internals- Data.PQueue.Internals- Data.PQueue.Prio.Max.Internals- Control.Applicative.Identity+ Data.PQueue.Prio.Internals+ Data.PQueue.Internals+ Data.PQueue.Prio.Max.Internals+ Control.Applicative.Identity if impl(ghc) { extensions: DeriveDataTypeable }