packages feed

pqueue 1.3.2 → 1.3.2.1

raw patch · 10 files changed

+304/−286 lines, 10 files

Files

CHANGELOG.md view
@@ -1,5 +1,11 @@ # Revision history for pqueue +## 1.3.2.1  -- 2017-03-11++  * Fix documentation errors+    - complexity on `toList`, `toListU`+    - PQueue.Prio.Max had "ascending" instead of "descending" in some places+ ## 1.3.2    -- 2016-09-28    * Add function `insertBehind` as a slight variation of `insert` which differs
Control/Applicative/Identity.hs view
@@ -2,6 +2,8 @@  import Control.Applicative +import Prelude+ newtype Identity a = Identity {runIdentity :: a}  instance Functor Identity where
Data/PQueue/Internals.hs view
@@ -31,11 +31,11 @@   seqSpine   ) where -import Control.DeepSeq+import Control.DeepSeq (NFData(rnf), deepseq) -import Data.Functor+import Data.Functor ((<$>)) import Data.Foldable (Foldable (foldr, foldl))-import Data.Monoid (Monoid (..))+import Data.Monoid (mappend) import qualified Data.PQueue.Prio.Internals as Prio  #ifdef __GLASGOW_HASKELL__@@ -58,14 +58,14 @@   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@@ -85,30 +85,33 @@  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+  MinQueue n1 x1 q1 == MinQueue n2 x2 q2 =+    n1 == n2 && eqExtract (x1,q1) (x2,q2)   _ == _ = False +eqExtract :: Ord a => (a, BinomHeap a) -> (a, BinomHeap a) -> Bool+eqExtract (x1,q1) (x2,q2) =+  x1 == x2 &&+  case (extractHeap q1, extractHeap q2) of+    (Just h1, Just h2) -> eqExtract h1 h2+    (Nothing, Nothing) -> True+    _ -> 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-      +  MinQueue _n1 x1 q1 `compare` MinQueue _n2 x2 q2 = cmpExtract (x1,q1) (x2,q2)++cmpExtract :: Ord a => (a, BinomHeap a) -> (a, BinomHeap a) -> Ordering+cmpExtract (x1,q1) (x2,q2) =+  compare x1 x2 `mappend`+  case (extractHeap q1, extractHeap q2) of+    (Just h1, Just h2) -> cmpExtract h1 h2+    (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.@@ -116,31 +119,31 @@ -- 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 -- has the correct binomial structure.--- +-- -- In the traditional set-theoretic construction of the natural numbers, we define -- 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} ...--- +-- -- 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 -- to a collection of binomial trees of ranks @0..k-1@.  Then we can say that--- +-- -- > data Succ rk a = Succ (BinomTree rk a) (rk a)--- +-- -- and this behaves exactly as the successor operator for ranks should behave.  Furthermore, -- we immediately obtain that--- +-- -- > data BinomTree rk a = BinomTree a (rk a)--- +-- -- which is nice and compact.  With this construction, things work out extremely nicely:--- +-- -- > BinomTree (Succ (Succ (Succ Zero)))--- +-- -- 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) | +data BinomForest rk a = Nil | Skip (BinomForest (Succ rk) a) |   Cons {-# UNPACK #-} !(BinomTree rk a) (BinomForest (Succ rk) a)  data BinomTree rk a = BinomTree a (rk a)@@ -175,7 +178,7 @@ getMin (MinQueue _ x _) = Just x getMin _                = Nothing --- | Retrieves the minimum element of the queue, and the queue stripped of that element, +-- | 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@@ -187,7 +190,7 @@ singleton :: a -> MinQueue a singleton x = MinQueue 1 x Nil --- | Amortized /O(1)/, worst-case /O(log n)/.  Insert an element into the priority queue.  +-- | Amortized /O(1)/, worst-case /O(log n)/.  Insert an element into the priority queue. insert :: Ord a => a -> MinQueue a -> MinQueue a insert = insert' (<=) @@ -241,24 +244,24 @@ {-# 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+foldlUnfold f z0 suc s0 = unf z0 s0 where   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)+insert' le x (MinQueue n x' ts)+  | x `le` x' = MinQueue (n+1) x (incr le (tip x') ts)+  | otherwise = MinQueue (n+1) x' (incr le (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)+union' le (MinQueue n1 x1 f1) (MinQueue n2 x2 f2)+  | x1 `le` x2 = MinQueue (n1 + n2) x1 (carry le (tip x2) f1 f2)+  | otherwise  = MinQueue (n1 + n2) x2 (carry le (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)@@ -268,25 +271,25 @@  -- | 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--- walk backwards.  @Extract rk a@ is the result type of an extract-min +-- walk backwards.  @Extract rk a@ is the result type of an extract-min -- operation that has walked as far backwards of rank @rk@ -- that is, it -- has visited every root of rank @>= rk@.--- +-- -- 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 +--     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 +--+--   * @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 +--+--   * @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)@@ -296,47 +299,47 @@   = 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))+incrExtract' le t (Extract minKey (Succ kChild kChildren) ts)+  = Extract minKey kChildren (Skip (incr le (t `cat` kChild) ts))   where-    cat = joinBin (<=)+    cat = joinBin le  -- | Walks backward from the biggest key in the forest, as far as rank @rk@. -- Returns its progress.  Each successive application of @extractBin@ takes -- amortized /O(1)/ time, so applying it from the beginning takes /O(log n)/ time. extractBin :: LEq a -> BinomForest rk a -> MExtract rk a extractBin _ Nil = No-extractBin (<=) (Skip f) = case extractBin (<=) f of+extractBin le (Skip f) = case extractBin le f of   Yes ex -> Yes (incrExtract ex)   No     -> No-extractBin (<=) (Cons t@(BinomTree x ts) f) = Yes $ case extractBin (<=) f of+extractBin le (Cons t@(BinomTree x ts) f) = Yes $ case extractBin le f of   Yes ex@(Extract minKey _ _)-    | minKey < x  -> incrExtract' (<=) t ex-  _               -> Extract x ts (Skip f)-  where a < b = not (b <= a)+    | minKey `lt` x -> incrExtract' le t ex+  _                 -> Extract x ts (Skip f)+  where a `lt` b = not (b `le` 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+mapMaybeQueue f le 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)+  Skip forest'  -> mapMaybeQueue f le fCh' q0 forest'+  Cons t forest'  -> mapMaybeQueue f le fCh' (union' le (mapMaybeT t) q0) forest'+  where fCh' (Succ t tss) = union' le (mapMaybeT t) (fCh tss)+        mapMaybeT (BinomTree x0 ts) = maybe (fCh ts) (\ x -> insert' le x (fCh ts)) (f x0)  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-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'+mapEitherQueue f0 leB leC fCh (q00, q10) ts0 = q00 `seq` q10 `seq` case ts0 of+  Nil        -> (q00, q10)+  Skip ts'   -> mapEitherQueue f0 leB leC fCh' (q00, q10) ts'+  Cons t ts' -> mapEitherQueue f0 leB leC fCh' (both (union' leB) (union' leC) (partitionT t) (q00, q10)) 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)+         fCh' (Succ t tss) = both (union' leB) (union' leC) (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)+           (q0, q1) -> case f0 x of+             Left b  -> (insert' leB b q0, q1)+             Right c  -> (q0, insert' leC c q1)  {-# INLINE tip #-} -- | Constructs a binomial tree of rank 0.@@ -358,46 +361,46 @@ -- Each successive application of this function costs /O(1)/, so applying it -- 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')+merge le f1 f2 = case (f1, f2) of+  (Skip f1', Skip f2')    -> Skip (merge le f1' f2')+  (Skip f1', Cons t2 f2') -> Cons t2 (merge le f1' f2')+  (Cons t1 f1', Skip f2') -> Cons t1 (merge le f1' f2')   (Cons t1 f1', Cons t2 f2')-        -> Skip (carry (<=) (t1 `cat` t2) f1' f2')+        -> Skip (carry le (t1 `cat` t2) f1' f2')   (Nil, _)                -> f2   (_, Nil)                -> f1-  where  cat = joinBin (<=)+  where  cat = joinBin le --- | Merges two binomial forests with another tree. If we are thinking of the trees +-- | 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')+carry le t0 f1 f2 = t0 `seq` case (f1, f2) of+  (Skip f1', Skip f2')    -> Cons t0 (merge le 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)+  (Nil, _f2)              -> incr le t0 f2+  (_f1, Nil)              -> incr le t0 f1+  where  cat = joinBin le+         mergeCarry tA tB = carry le (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+incr le t f0 = t `seq` case f0 of   Nil  -> Cons t Nil   Skip f     -> Cons t f-  Cons t' f' -> Skip (incr (<=) (t `cat` t') f')-  where  cat = joinBin (<=)+  Cons t' f' -> Skip (incr le (t `cat` t') f')+  where  cat = joinBin le  -- | 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)+joinBin le t1@(BinomTree x1 ts1) t2@(BinomTree x2 ts2)+  | x1 `le` x2 = BinomTree x1 (Succ t2 ts1)   | otherwise  = BinomTree x2 (Succ t1 ts2)  instance Functor Zero where@@ -436,13 +439,13 @@  -- instance Traversable Zero where --   traverse _ _ = pure Zero--- +-- -- instance Traversable rk => Traversable (Succ rk) where --   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--- +-- -- instance Traversable rk => Traversable (BinomForest rk) where --   traverse _ Nil = pure Nil --   traverse f (Skip tss) = Skip <$> traverse f tss@@ -482,7 +485,7 @@ keysQueue (Prio.MinPQ n k _ ts) = MinQueue n k (keysF (const Zero) ts)  keysF :: (pRk k a -> rk k) -> Prio.BinomForest pRk k a -> BinomForest rk k-keysF f ts = case ts of+keysF f ts0 = case ts0 of   Prio.Nil       -> Nil   Prio.Skip ts'  -> Skip (keysF f' ts')   Prio.Cons (Prio.BinomTree k _ ts) ts'
Data/PQueue/Max.hs view
@@ -2,7 +2,7 @@  ----------------------------------------------------------------------------- -- |--- Module      :  Data.PQueue.Min+-- Module      :  Data.PQueue.Max -- Copyright   :  (c) Louis Wasserman 2010 -- License     :  BSD-style -- Maintainer  :  libraries@haskell.org@@ -20,7 +20,7 @@ -- use 'seqSpine'. -- -- This implementation does not guarantee stable behavior.--- +-- -- This implementation offers a number of methods of the form @xxxU@, where @U@ stands for -- unordered.  No guarantees whatsoever are made on the execution or traversal order of -- these functions.@@ -30,7 +30,7 @@   -- * Basic operations   empty,   null,-  size, +  size,   -- * Query operations   findMax,   getMax,@@ -83,13 +83,12 @@   keysQueue,   seqSpine) where -import Control.Applicative (Applicative(..), (<$>))-import Control.DeepSeq+import Control.DeepSeq (NFData(rnf)) -import Data.Monoid-import Data.Maybe hiding (mapMaybe)+import Data.Functor ((<$>))+import Data.Monoid (Monoid(mempty, mappend))+import Data.Maybe (fromMaybe) import Data.Foldable (foldl, foldr)-import Data.Traversable  import qualified Data.PQueue.Min as Min import qualified Data.PQueue.Prio.Max.Internals as Prio@@ -107,7 +106,7 @@ build f = f (:) [] #endif --- | A priority queue with elements of type @a@.  Supports extracting the maximum element.  +-- | A priority queue with elements of type @a@.  Supports extracting the maximum element. -- Implemented as a wrapper around 'Min.MinQueue'. newtype MaxQueue a = MaxQ (Min.MinQueue (Down a)) # if __GLASGOW_HASKELL__@@ -122,7 +121,7 @@ instance (Ord a, Show a) => Show (MaxQueue a) where   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@@ -176,7 +175,7 @@   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@@ -185,7 +184,7 @@ singleton :: a -> MaxQueue a singleton = MaxQ . Min.singleton . Down --- | /O(1)/.  Insert an element into the priority queue.  +-- | /O(1)/.  Insert an element into the priority queue. insert :: Ord a => a -> MaxQueue a -> MaxQueue a x `insert` MaxQ q = MaxQ (Down x `Min.insert` q) @@ -220,7 +219,7 @@ 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-  + -- | '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]@@ -233,7 +232,7 @@ -- | '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) -> MaxQueue a -> ([a], MaxQueue a) span p (MaxQ q) = (map unDown xs, MaxQ q') where   (xs, q') = Min.span (p . unDown) q@@ -308,19 +307,23 @@ -- | /O(n log n)/.  Extracts the elements of the priority queue in ascending order. toAscList :: Ord a => MaxQueue a -> [a] toAscList q = build (\ c nil -> foldrAsc c nil q)+-- I can see no particular reason this does not simply forward to Min.toDescList. (lsp, 2016)  {-# INLINE toDescList #-} -- | /O(n log n)/.  Extracts the elements of the priority queue in descending order. toDescList :: Ord a => MaxQueue a -> [a] toDescList q = build (\ c nil -> foldrDesc c nil q)+-- I can see no particular reason this does not simply forward to Min.toAscList. (lsp, 2016)  {-# INLINE toList #-}--- | /O(n)/.  Returns the elements of the priority queue in no particular order.+-- | /O(n log n)/.  Returns the elements of the priority queue in ascending order.  Equivalent to 'toDescList'.+--+-- If the order of the elements is irrelevant, consider using 'toListU'. toList :: Ord a => MaxQueue a -> [a] toList (MaxQ q) = map unDown (Min.toList q)  {-# INLINE fromAscList #-}--- | /O(n)/.  Constructs a priority queue from an ascending list.  /Warning/: Does not check the precondition. +-- | /O(n)/.  Constructs a priority queue from an ascending list.  /Warning/: Does not check the precondition. fromAscList :: [a] -> MaxQueue a fromAscList = MaxQ . Min.fromDescList . map Down
Data/PQueue/Min.hs view
@@ -21,7 +21,7 @@ -- use 'seqSpine'. -- -- This implementation does not guarantee stable behavior.--- +-- -- This implementation offers a number of methods of the form @xxxU@, where @U@ stands for -- unordered.  No guarantees whatsoever are made on the execution or traversal order of -- these functions.@@ -31,7 +31,7 @@   -- * Basic operations   empty,   null,-  size, +  size,   -- * Query operations   findMin,   getMin,@@ -85,13 +85,9 @@  import Prelude hiding (null, foldr, foldl, take, drop, takeWhile, dropWhile, splitAt, span, break, (!!), filter, map) -import Control.Applicative (Applicative(..), (<$>))-import Control.Applicative.Identity--import Data.Monoid-import Data.Maybe hiding (mapMaybe)+import Data.Monoid (Monoid(mempty, mappend, mconcat)) import Data.Foldable (foldl, foldr, foldl')-import Data.Traversable+import Data.Maybe (fromMaybe)  import qualified Data.List as List @@ -101,13 +97,12 @@ import GHC.Exts (build) import Text.Read (Lexeme(Ident), lexP, parens, prec,   readPrec, readListPrec, readListPrecDefault)-import Data.Data #else build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a] build f = f (:) [] #endif --- instance +-- instance  instance (Ord a, Show a) => Show (MinQueue a) where   showsPrec p xs = showParen (p > 10) $@@ -151,7 +146,7 @@ unions :: Ord a => [MinQueue a] -> MinQueue a unions = foldl union empty --- | /O(k log n)/.  Index (subscript) operator, starting from 0.  @queue !! k@ returns the @(k+1)@th smallest +-- | /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@@ -167,11 +162,11 @@ {-# INLINE foldWhileFB #-} -- | Equivalent to Data.List.takeWhile, but is a better producer. foldWhileFB :: (a -> Bool) -> [a] -> [a]-foldWhileFB p xs = build (\ c nil -> let +foldWhileFB p xs0 = build (\ c nil -> let   consWhile x xs     | p x    = x `c` xs     | otherwise  = nil-  in foldr consWhile nil xs)+  in foldr consWhile nil xs0)  -- | 'dropWhile' @p queue@ returns the queue remaining after 'takeWhile' @p queue@. dropWhile :: Ord a => (a -> Bool) -> MinQueue a -> MinQueue a@@ -185,7 +180,7 @@ -- 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') +  Just (x, q')     | p x  -> let (ys, q'') = span p q' in (x:ys, q'')   _        -> ([], queue) @@ -241,8 +236,8 @@ toDescList queue = build (\ c nil -> foldrDesc c nil queue)  {-# INLINE toList #-}--- | /O(n)/.  Returns the elements of the priority queue in ascending order.  Equivalent to 'toAscList'.--- +-- | /O(n log n)/.  Returns the elements of the priority queue in ascending order.  Equivalent to 'toAscList'.+-- -- If the order of the elements is irrelevant, consider using 'toListU'. toList :: Ord a => MinQueue a -> [a] toList = toAscList@@ -292,7 +287,7 @@ elemsU :: MinQueue a -> [a] elemsU = toListU --- | Returns the elements of the queue, in no particular order.+-- | /O(n)/.  Returns the elements of the queue, in no particular order. toListU :: MinQueue a -> [a] toListU q = build (\ c n -> foldrU c n q)
Data/PQueue/Prio/Internals.hs view
@@ -33,10 +33,11 @@   ) where  import Control.Applicative (Applicative(..), (<$>))-import Control.Applicative.Identity-import Control.DeepSeq+import Control.Applicative.Identity (Identity(Identity, runIdentity))+import Control.DeepSeq (NFData(rnf), deepseq)  import Data.Monoid (Monoid (..))+ import Prelude hiding (null)  #if __GLASGOW_HASKELL__@@ -73,7 +74,7 @@   deriving (Typeable) #endif -data BinomForest rk k a = +data BinomForest rk k a =   Nil |   Skip (BinomForest (Succ rk) k a) |   Cons {-# UNPACK #-} !(BinomTree rk k a) (BinomForest (Succ rk) k a)@@ -87,36 +88,48 @@  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 (<=)+    n1 == n2 && eqExtract k1 a1 ts1 k2 a2 ts2   Empty == Empty = True   _     == _     = False +eqExtract ::+  (Ord k, Eq a) =>+  k -> a -> BinomForest rk k a ->+  k -> a -> BinomForest rk k a ->+  Bool+eqExtract k10 a10 ts10 k20 a20 ts20 =+  k10 == k20 && a10 == a20 &&+  case (extract ts10, extract ts20) of+    (Yes (Extract k1 a1 _ ts1'), Yes (Extract k2 a2 _ ts2'))+             -> eqExtract k1 a1 ts1' k2 a2 ts2'+    (No, No) -> 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 (<=)+  MinPQ _n1 k10 a10 ts10 `compare` MinPQ _n2 k20 a20 ts20 =+    cmpExtract k10 a10 ts10 k20 a20 ts20   Empty `compare` Empty   = EQ   Empty `compare` MinPQ{} = LT   MinPQ{} `compare` Empty = GT +cmpExtract ::+  (Ord k, Ord a) =>+  k -> a -> BinomForest rk k a ->+  k -> a -> BinomForest rk k a ->+  Ordering+cmpExtract k10 a10 ts10 k20 a20 ts20 =+  k10 `compare` k20 <> a10 `compare` a20 <>+  case (extract ts10, extract ts20) of+    (Yes (Extract k1 a1 _ ts1'), Yes (Extract k2 a2 _ ts2'))+                -> cmpExtract k1 a1 ts1' k2 a2 ts2'+    (No, Yes{}) -> LT+    (Yes{}, No) -> GT+    (No, No)    -> EQ+ -- | /O(1)/.  Returns the empty priority queue. empty :: MinPQueue k a empty = Empty@@ -140,7 +153,7 @@ insert :: Ord k => k -> a -> MinPQueue k a -> MinPQueue k a insert = insert' (<=) --- | Amortized /O(1)/, worst-case /O(log n)/.  Insert an element +-- | Amortized /O(1)/, worst-case /O(log n)/.  Insert an element --   with the specified key into the priority queue, --   putting it behind elements whos key compares equal to the --   inserted one.@@ -150,9 +163,9 @@ -- | Internal helper method, using a specific comparator function. insert' :: CompF 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)+insert' le k a (MinPQ n k' a' ts)+  | k `le` k'  = MinPQ (n+1) k  a  (incr le (tip k' a') ts)+  | otherwise  = MinPQ (n+1) k' a' (incr le (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.@@ -161,10 +174,10 @@  -- | Takes the union of the two specified queues, using the given comparison function. union' :: CompF 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)+union' le (MinPQ n1 k1 a1 ts1) (MinPQ n2 k2 a2 ts2)+  | k1 `le` 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+  where  insMerge k a = carryForest le (tip k a) ts1 ts2 union' _ Empty q2 = q2 union' _ q1 Empty = q1 @@ -211,29 +224,27 @@ -- | /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 f (MinPQ _ k a ts) = either (first' . insert k) (second' . insert k) (f k a) +mapEitherWithKey f (MinPQ _ k a ts) = either (first' . insert k) (second' . insert k) (f k a)   (mapEitherF (<=) f (const (Empty, Empty)) ts) --- | /O(n log n)/.  Fold the keys and values in the map, such that +-- | /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)@.--- +-- -- If you do not care about the traversal order, consider using 'foldrWithKeyU'. 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 (<=)+foldrWithKey f z (MinPQ _ k0 a0 ts0) = f k0 a0 (foldF ts0) where   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 +-- | /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)@.--- +-- -- If you do not care about the traversal order, consider using 'foldlWithKeyU'. 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 (<=)+foldlWithKey f z0 (MinPQ _ k0 a0 ts0) = foldF (f z0 k0 a0) ts0 where   foldF z ts = case extract ts of     Yes (Extract k a _ ts') -> foldF (f z k a) ts'     _                       -> z@@ -251,38 +262,38 @@  -- | /O(1)/.  Takes the union of two binomial trees of the same rank. meld :: CompF 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)+meld le t1@(BinomTree k1 v1 ts1) t2@(BinomTree k2 v2 ts2)+  | k1 `le` 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 :: CompF 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)+mergeForest le f1 f2 = case (f1, f2) of+  (Skip ts1, Skip ts2)       -> Skip (mergeForest le ts1 ts2)+  (Skip ts1, Cons t2 ts2)    -> Cons t2 (mergeForest le ts1 ts2)+  (Cons t1 ts1, Skip ts2)    -> Cons t1 (mergeForest le ts1 ts2)+  (Cons t1 ts1, Cons t2 ts2) -> Skip (carryForest le (meld le t1 t2) ts1 ts2)   (Nil, _)                   -> f2   (_, Nil)                   -> f1 --- | Takes the union of two binomial forests, starting at the same rank, with an additional tree.  +-- | 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 :: CompF 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+carryForest le 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 (<=)+  (Skip ts1, Skip ts2)       -> Cons t0 (mergeForest le ts1 ts2)+  (Nil, _)                   -> incr le t0 f2+  (_, Nil)                   -> incr le t0 f1+  where  carryMeld = carryForest le .: meld le  -- | Inserts a binomial tree into a binomial forest.  Analogous to binary incrementation. incr :: CompF k -> BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a-incr (<=) t ts = t `seq` case ts of+incr le 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')+  Cons t' ts' -> Skip (incr le (meld le 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@@ -294,33 +305,33 @@   Cons t' tss' -> Skip (incrMin (BinomTree k a (Succ t' ts)) tss')  extractHeap :: CompF k -> Int -> BinomHeap k a -> MinPQueue k a-extractHeap (<=) n ts = n `seq` case extractForest (<=) ts of+extractHeap le n ts = n `seq` case extractForest le ts of   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--- walk backwards.  @Extract rk a@ is the result type of an extract-min +-- walk backwards.  @Extract rk a@ is the result type of an extract-min -- operation that has walked as far backwards of rank @rk@ -- that is, it -- has visited every root of rank @>= rk@.--- +-- -- 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 +--     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 +--+--   * @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 +--+--   * @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)@@ -329,27 +340,30 @@ incrExtract :: CompF 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)-incrExtract (<=) (Just t) (Extract k a (Succ t' ts) tss)-  = Extract k a ts (Skip (incr (<=) (meld (<=) t t') tss))+incrExtract le (Just t) (Extract k a (Succ t' ts) tss)+  = Extract k a ts (Skip (incr le (meld le 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 -- amortized /O(1)/ time, so applying it from the beginning takes /O(log n)/ time. extractForest :: CompF k -> BinomForest rk k a -> MExtract rk k a extractForest _ Nil = No-extractForest (<=) (Skip tss) = case extractForest (<=) tss of+extractForest le (Skip tss) = case extractForest le tss of   No     -> No-  Yes ex -> Yes (incrExtract (<=) Nothing ex)-extractForest (<=) (Cons t@(BinomTree k a ts) tss) = Yes $ case extractForest (<=) tss of+  Yes ex -> Yes (incrExtract le Nothing ex)+extractForest le (Cons t@(BinomTree k a0 ts) tss) = Yes $ case extractForest le tss of   Yes ex@(Extract k' _ _ _)-    | k' <? k  -> incrExtract (<=) (Just t) ex-  _            -> Extract k a ts (Skip tss)+    | k' <? k  -> incrExtract le (Just t) ex+  _            -> Extract k a0 ts (Skip tss)   where-    a <? b = not (b <= a)+    a <? b = not (b `le` a) +extract :: (Ord k) => BinomForest rk k a -> MExtract rk k a+extract = extractForest (<=)+ -- | 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+mapForest f fCh ts0 = case ts0 of   Nil      -> Nil   Skip ts' -> Skip (mapForest f fCh' ts')   Cons (BinomTree k a ts) tss@@ -360,26 +374,26 @@ -- | Utility function for mapping a 'Maybe' function over a forest. mapMaybeF :: CompF k -> (k -> a -> Maybe b) -> (rk k a -> MinPQueue k b) ->   BinomForest rk k a -> MinPQueue k b-mapMaybeF (<=) f fCh ts = case ts of+mapMaybeF le f fCh ts0 = case ts0 of   Nil    -> Empty-  Skip ts'  -> mapMaybeF (<=) f fCh' ts'+  Skip ts'  -> mapMaybeF le 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' (<=)+      -> insF k a (fCh ts) (mapMaybeF le f fCh' ts')+  where  insF k a = maybe id (insert' le k) (f k a) .: union' le          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 :: CompF 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)-mapEitherF (<=) f fCh ts = case ts of+mapEitherF le f0 fCh ts0 = case ts0 of   Nil    -> (Empty, Empty)-  Skip ts'  -> mapEitherF (<=) f fCh' ts'+  Skip ts'  -> mapEitherF le f0 fCh' ts'   Cons (BinomTree k a ts) ts'-      -> insF k a (fCh ts) (mapEitherF (<=) f fCh' ts')+      -> insF k a (fCh ts) (mapEitherF le f0 fCh' ts')   where-    insF k a = either (first' . insert' (<=) k) (second' . insert' (<=) k) (f k a) .: -      (union' (<=) `both` union' (<=))+    insF k a = either (first' . insert' le k) (second' . insert' le k) (f0 k a) .:+      (union' le `both` union' le)     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)@@ -392,7 +406,7 @@ -- | /O(n)/.  An unordered left fold over the elements of the queue, in no particular order. foldlWithKeyU :: (b -> k -> a -> b) -> b -> MinPQueue k a -> b foldlWithKeyU _ z Empty = z-foldlWithKeyU f z (MinPQ _ k a ts) = foldlWithKeyF_ (\ k a z -> f z k a) (const id) ts (f z k a)+foldlWithKeyU f z0 (MinPQ _ k0 a0 ts) = foldlWithKeyF_ (\ k a z -> f z k a) (const id) ts (f z0 k0 a0)  traverseWithKeyU :: Applicative f => (k -> a -> f b) -> MinPQueue k a -> f (MinPQueue k b) traverseWithKeyU _ Empty = pure Empty@@ -401,40 +415,40 @@ {-# SPECIALIZE traverseForest :: (k -> a -> Identity b) -> (rk k a -> Identity (rk k b)) -> BinomForest rk k a ->   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+traverseForest f fCh ts0 = case ts0 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 +  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+foldrWithKeyF_ f fCh ts0 z0 = case ts0 of+  Nil    -> z0+  Skip ts'  -> foldrWithKeyF_ f fCh' ts' z0   Cons (BinomTree k a ts) ts'-    -> f k a (fCh ts (foldrWithKeyF_ f fCh' ts' z))+    -> f k a (fCh ts (foldrWithKeyF_ f fCh' ts' z0))   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+foldlWithKeyF_ f fCh ts0 = case ts0 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 +  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+mapKeysMonoF f fCh ts0 = case ts0 of   Nil    -> Nil   Skip ts'  -> Skip (mapKeysMonoF f fCh' ts')   Cons (BinomTree k a ts) ts'@@ -445,8 +459,8 @@  -- | /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+seqSpine Empty z0 = z0+seqSpine (MinPQ _ _ _ ts0) z0 = ts0 `seqSpineF` z0 where   seqSpineF :: BinomForest rk k a -> b -> b   seqSpineF ts z = case ts of     Nil        -> z
Data/PQueue/Prio/Max.hs view
@@ -20,13 +20,13 @@ -- This implementation is based on a binomial heap augmented with a global root. -- The spine of the heap is maintained lazily.  To force the spine of the heap, -- use 'seqSpine'.--- +-- -- We do not guarantee stable behavior.--- Ties are broken arbitrarily -- that is, if @k1 <= k2@ and @k2 <= k1@, then there +-- Ties are broken arbitrarily -- that is, if @k1 <= k2@ and @k2 <= k1@, then there -- are no guarantees about the relative order in which @k1@, @k2@, and their associated -- elements are returned.  (Unlike Data.Map, we allow multiple elements with the -- same key.)--- +-- -- This implementation offers a number of methods of the form @xxxU@, where @U@ stands for -- unordered.  No guarantees whatsoever are made on the execution or traversal order of -- these functions.@@ -39,7 +39,7 @@   insert,   insertBehind,   union,-  unions, +  unions,   -- * Query   null,   size,@@ -116,13 +116,11 @@   )   where -import Control.Applicative hiding (empty)-import Control.Arrow-import Data.Monoid-import qualified Data.List as List+import Control.Applicative (Applicative, (<$>))+import Data.Monoid (Monoid(mempty, mappend, mconcat))+import Data.Traversable (Traversable(traverse)) import Data.Foldable (Foldable, foldr, foldl)-import Data.Traversable-import Data.Maybe hiding (mapMaybe)+import Data.Maybe (fromMaybe) import Data.PQueue.Prio.Max.Internals  import Prelude hiding (map, filter, break, span, takeWhile, dropWhile, splitAt, take, drop, (!!), null, foldr, foldl)@@ -130,10 +128,8 @@ import qualified Data.PQueue.Prio.Min as Q  #ifdef __GLASGOW_HASKELL__-import GHC.Exts (build) import Text.Read (Lexeme(Ident), lexP, parens, prec,   readPrec, readListPrec, readListPrecDefault)-import Data.Data #else build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a] build f = f (:) []@@ -230,7 +226,7 @@ deleteFindMax = fromMaybe (error "Error: deleteFindMax called on an empty queue") . maxViewWithKey  -- | /O(1)/.  Alter the value at the maximum key.  If the queue is empty, does nothing.-adjustMax :: (a -> a) -> MaxPQueue k a -> MaxPQueue k a +adjustMax :: (a -> a) -> MaxPQueue k a -> MaxPQueue k a adjustMax = adjustMaxWithKey . const  -- | /O(1)/.  Alter the value at the maximum key.  If the queue is empty, does nothing.@@ -279,23 +275,23 @@ mapKeysMonotonic :: (k -> k') -> MaxPQueue k a -> MaxPQueue k' a mapKeysMonotonic f (MaxPQ q) = MaxPQ (Q.mapKeysMonotonic (fmap f) q) --- | /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)@.--- +-- | /O(n log n)/.  Fold the keys and values in the map, such that+-- @'foldrWithKey' f z q == 'List.foldr' ('uncurry' f) z ('toDescList' q)@.+-- -- If you do not care about the traversal order, consider using 'foldrWithKeyU'. foldrWithKey :: Ord k => (k -> a -> b -> b) -> b -> MaxPQueue k a -> b foldrWithKey f z (MaxPQ q) = Q.foldrWithKey (f . unDown) z q --- | /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)@.--- +-- | /O(n log n)/.  Fold the keys and values in the map, such that+-- @'foldlWithKey' f z q == 'List.foldl' ('uncurry' . f) z ('toDescList' q)@.+-- -- If you do not care about the traversal order, consider using 'foldlWithKeyU'. foldlWithKey :: Ord k => (b -> k -> a -> b) -> b -> MaxPQueue k a -> b-foldlWithKey f z (MaxPQ q) = Q.foldlWithKey (\ z -> f z . unDown) z q+foldlWithKey f z0 (MaxPQ q) = Q.foldlWithKey (\ z -> f z . unDown) z0 q  -- | /O(n log n)/.  Traverses the elements of the queue in descending order by key. -- (@'traverseWithKey' f q == 'fromDescList' <$> 'traverse' ('uncurry' f) ('toDescList' q)@)--- +-- -- If you do not care about the /order/ of the traversal, consider using 'traverseWithKeyU'. traverseWithKey :: (Ord k, Applicative f) => (k -> a -> f b) -> MaxPQueue k a -> f (MaxPQueue k b) traverseWithKey f (MaxPQ q) = MaxPQ <$> Q.traverseWithKey (f . unDown) q@@ -315,12 +311,12 @@   (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)@)+-- (@'takeWhile' p q == 'List.takeWhile' (p . 'snd') ('toDescList' q)@) takeWhile :: Ord k => (a -> Bool) -> MaxPQueue k a -> [(k, a)] takeWhile = takeWhileWithKey . const  -- | Takes the longest possible prefix of elements satisfying the predicate.--- (@'takeWhile' p q == 'List.takeWhile' (uncurry p) ('toAscList' q)@)+-- (@'takeWhile' p q == 'List.takeWhile' (uncurry p) ('toDescList' q)@) takeWhileWithKey :: Ord k => (k -> a -> Bool) -> MaxPQueue k a -> [(k, a)] takeWhileWithKey p (MaxPQ q) = fmap (first' unDown) (Q.takeWhileWithKey (p . unDown) q) @@ -398,11 +394,11 @@ fromDescList :: [(k, a)] -> MaxPQueue k a fromDescList = MaxPQ . Q.fromAscList . fmap (first' Down) --- | /O(n log n)/.  Return all keys of the queue in ascending order.+-- | /O(n log n)/.  Return all keys of the queue in descending order. keys :: Ord k => MaxPQueue k a -> [k] keys = fmap fst . toDescList --- | /O(n log n)/.  Return all elements of the queue in ascending order by key.+-- | /O(n log n)/.  Return all elements of the queue in descending order by key. elems :: Ord k => MaxPQueue k a -> [a] elems = fmap snd . toDescList @@ -418,8 +414,8 @@ toDescList :: Ord k => MaxPQueue k a -> [(k, a)] toDescList (MaxPQ q) = fmap (first' unDown) (Q.toAscList q) --- | /O(n log n)/.  Equivalent to 'toAscList'.--- +-- | /O(n log n)/.  Equivalent to 'toDescList'.+-- -- If the traversal order is irrelevant, consider using 'toListU'. toList :: Ord k => MaxPQueue k a -> [(k, a)] toList = toDescList@@ -438,7 +434,7 @@  -- | /O(n)/.  An unordered left fold over the elements of the queue, in no particular order. foldlWithKeyU :: (b -> k -> a -> b) -> b -> MaxPQueue k a -> b-foldlWithKeyU f z (MaxPQ q) = Q.foldlWithKeyU (\ z -> f z . unDown) z q+foldlWithKeyU f z0 (MaxPQ q) = Q.foldlWithKeyU (\ z -> f z . unDown) z0 q  -- | /O(n)/.  An unordered traversal over a priority queue, in no particular order. -- While there is no guarantee in which order the elements are traversed, the resulting
Data/PQueue/Prio/Max/Internals.hs view
@@ -2,20 +2,20 @@  module Data.PQueue.Prio.Max.Internals where -import Control.Applicative-import Control.DeepSeq+import Control.DeepSeq (NFData(rnf)) -import Data.Foldable-import Data.Traversable+import Data.Traversable (Traversable(traverse))+import Data.Foldable (Foldable(foldr, foldl))+import Data.Functor ((<$>)) # if __GLASGOW_HASKELL__-import Data.Data+import Data.Data (Data, Typeable) # endif  import Prelude hiding (foldr, foldl)  import Data.PQueue.Prio.Internals (MinPQueue) -newtype Down a = Down {unDown :: a} +newtype Down a = Down {unDown :: a} # if __GLASGOW_HASKELL__   deriving (Eq, Data, Typeable) # else
Data/PQueue/Prio/Min.hs view
@@ -20,13 +20,13 @@ -- This implementation is based on a binomial heap augmented with a global root. -- The spine of the heap is maintained lazily.  To force the spine of the heap, -- use 'seqSpine'.--- +-- -- We do not guarantee stable behavior.--- Ties are broken arbitrarily -- that is, if @k1 <= k2@ and @k2 <= k1@, then there +-- Ties are broken arbitrarily -- that is, if @k1 <= k2@ and @k2 <= k1@, then there -- are no guarantees about the relative order in which @k1@, @k2@, and their associated -- elements are returned.  (Unlike Data.Map, we allow multiple elements with the -- same key.)--- +-- -- This implementation offers a number of methods of the form @xxxU@, where @U@ stands for -- unordered.  No guarantees whatsoever are made on the execution or traversal order of -- these functions.@@ -39,7 +39,7 @@   insert,   insertBehind,   union,-  unions, +  unions,   -- * Query   null,   size,@@ -116,22 +116,23 @@   )   where -import Control.Applicative (Applicative (..), (<$>))-import Data.Monoid +import Control.Applicative (Applicative, pure, (<*>), (<$>))+ import qualified Data.List as List-import Data.Foldable (Foldable, foldl, foldr, foldl')-import Data.Traversable+import qualified Data.Foldable as Fold(Foldable(..))+import Data.Monoid (Monoid(mempty, mappend, mconcat))+import Data.Traversable (Traversable(traverse))+import Data.Foldable (Foldable) import Data.Maybe (fromMaybe)  import Data.PQueue.Prio.Internals -import Prelude hiding (map, filter, break, span, takeWhile, dropWhile, splitAt, take, drop, (!!), null, foldr)+import Prelude hiding (map, filter, break, span, takeWhile, dropWhile, splitAt, take, drop, (!!), null)  #ifdef __GLASGOW_HASKELL__ import GHC.Exts (build) import Text.Read (Lexeme(Ident), lexP, parens, prec,   readPrec, readListPrec, readListPrecDefault)-import Data.Data #else build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a] build f = f (:) []@@ -212,7 +213,7 @@  -- | /O(n log n)/.  Traverses the elements of the queue in ascending order by key. -- (@'traverseWithKey' f q == 'fromAscList' <$> 'traverse' ('uncurry' f) ('toAscList' q)@)--- +-- -- 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@@ -253,10 +254,10 @@  -- | /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+drop n0 q0+  | n0 <= 0  = q0+  | n0 >= size q0  = empty+  | otherwise  = drop' n0 q0   where     drop' n q       | n == 0    = q@@ -264,7 +265,7 @@  -- | /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 +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'')@@ -280,7 +281,7 @@ -- | Takes the longest possible prefix of elements satisfying the predicate. -- (@'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+takeWhileWithKey p0 = takeWhileFB (uncurry' p0) . toAscList where   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.@@ -321,10 +322,10 @@  -- | /O(n)/.  Build a priority queue from a descending list of (key, value) pairs.  /The precondition is not checked./ fromDescList :: [(k, a)] -> MinPQueue k a-fromDescList = foldl' (\ q (k, a) -> insertMin k a q) empty+fromDescList = List.foldl' (\ q (k, a) -> insertMin k a q) empty  {-# RULES-  "fromList/build" forall (g :: forall b . ((k, a) -> b -> b) -> b -> b) . +  "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;@@ -356,7 +357,7 @@  {-# INLINE toList #-} -- | /O(n log n)/.  Equivalent to 'toAscList'.--- +-- -- If the traversal order is irrelevant, consider using 'toListU'. toList :: Ord k => MinPQueue k a -> [(k, a)] toList = toAscList
pqueue.cabal view
@@ -1,5 +1,5 @@ Name:               pqueue-Version:            1.3.2+Version:            1.3.2.1 Category:           Data Structures Author:             Louis Wasserman License:            BSD3@@ -43,8 +43,6 @@   ghc-options: {     -fdicts-strict     -Wall-    -fno-warn-name-shadowing-    -fno-warn-unused-imports   }  if impl(ghc>=7.8) {   ghc-options: {