pqueue 1.0.1 → 1.1.0
raw patch · 9 files changed
+172/−76 lines, 9 filesdep +deepseq
Dependencies added: deepseq
Files
- Control/Applicative/Identity.hs +12/−0
- Data/PQueue/Internals.hs +55/−9
- Data/PQueue/Max.hs +8/−17
- Data/PQueue/Min.hs +3/−18
- Data/PQueue/Prio/Internals.hs +64/−7
- Data/PQueue/Prio/Max.hs +6/−6
- Data/PQueue/Prio/Max/Internals.hs +13/−1
- Data/PQueue/Prio/Min.hs +8/−15
- pqueue.cabal +3/−3
+ Control/Applicative/Identity.hs view
@@ -0,0 +1,12 @@+module Control.Applicative.Identity where++import Control.Applicative++newtype Identity a = Identity {runIdentity :: a}++instance Functor Identity where+ fmap f (Identity x) = Identity (f x)++instance Applicative Identity where+ pure = Identity+ Identity f <*> Identity x = Identity (f x)
Data/PQueue/Internals.hs view
@@ -22,15 +22,19 @@ foldrAsc, foldlAsc, insertMinQ,+-- mapU, foldrU, foldlU,+-- traverseU, keysQueue, seqSpine ) where -import Control.Applicative hiding (empty)-import Data.Foldable-import Data.Monoid+import Control.DeepSeq++import Data.Functor+import Data.Foldable (Foldable (..))+import Data.Monoid (Monoid (..)) import qualified Data.PQueue.Prio.Internals as Prio #ifdef __GLASGOW_HASKELL__@@ -203,8 +207,7 @@ -- | /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. mapMonotonic :: (a -> b) -> MinQueue a -> MinQueue b-mapMonotonic _ Empty = Empty-mapMonotonic f (MinQueue n x ts) = MinQueue n (f x) (fmap f ts)+mapMonotonic = mapU {-# INLINE foldrAsc #-} -- | /O(n log n)/. Performs a right-fold on the elements of a priority queue in ascending order.@@ -413,12 +416,30 @@ instance Foldable rk => Foldable (BinomForest rk) where foldr _ z Nil = z- foldr f z (Skip ts) = foldr f z ts- foldr f z (Cons t ts) = foldr f (foldr f z ts) t+ 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 ts) = foldl f z ts- foldl f z (Cons t ts) = foldl f (foldl f z t) ts+ 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+-- +-- 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+-- traverse f (Cons t tss) = Cons <$> traverse f t <*> traverse f tss++mapU :: (a -> b) -> MinQueue a -> MinQueue b+mapU _ Empty = Empty+mapU f (MinQueue n x ts) = MinQueue n (f x) (f <$> ts)+ -- | /O(n)/. Unordered right fold on a priority queue. foldrU :: (a -> b -> b) -> b -> MinQueue a -> b foldrU _ z Empty = z@@ -429,6 +450,10 @@ foldlU _ z Empty = z foldlU f z (MinQueue _ x ts) = foldl f (z `f` x) ts +-- traverseU :: Applicative f => (a -> f b) -> MinQueue a -> f (MinQueue b)+-- traverseU _ Empty = pure Empty+-- traverseU f (MinQueue n x ts) = MinQueue n <$> f x <*> traverse f ts+ -- | Forces the spine of the priority queue. seqSpine :: MinQueue a -> b -> b seqSpine Empty z = z@@ -451,3 +476,24 @@ 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 -> ()++instance NFRank Zero where+ rnfRk _ = ()++instance NFRank rk => NFRank (Succ rk) where+ 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++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++instance NFData a => NFData (MinQueue a) where+ rnf Empty = ()+ rnf (MinQueue _ x ts) = x `deepseq` rnf ts
Data/PQueue/Max.hs view
@@ -9,10 +9,10 @@ -- Stability : experimental -- Portability : portable ----- General purpose priority queue, supporting maxView-maximum operations.+-- General purpose priority queue, supporting view-maximum operations. -- -- An amortized running time is given for each operation, with /n/ referring--- to the length of the sequence and /i/ being the integral index used by+-- to the length of the sequence and /k/ being the integral index used by -- some operations. These bounds hold even in a persistent (shared) setting. -- -- This implementation is based on a binomial heap augmented with a global root.@@ -75,7 +75,6 @@ mapU, foldrU, foldlU,- traverseU, elemsU, toListU, -- * Miscellaneous operations@@ -83,6 +82,7 @@ seqSpine) where import Control.Applicative (Applicative(..), (<$>))+import Control.DeepSeq import Data.Monoid import Data.Maybe hiding (mapMaybe)@@ -106,15 +106,8 @@ build f = f (:) [] #endif --- | A priority queue implementation. Implemented as a wrapper around "Data.PQueue.Min". --- /Warning/: the 'Functor', 'Foldable', and 'Traversable' instances of this type /ignore ordering/.--- For 'Functor', it is guaranteed that if @f@ is a monotonic function, then @'fmap' f@ on a valid--- 'MaxQueue' will return a valid 'MaxQueue'. An analogous guarantee holds for 'traverse'. (Note:--- if passed constant-time operations, every function in 'Functor', 'Foldable', and 'Traversable'--- will run in /O(n)/.)--- --- If you wish to perform folds on a priority queue that respect order, use 'foldrDesc' or--- 'foldlDesc'.+-- | 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__ deriving (Eq, Ord, Data, Typeable)@@ -122,6 +115,9 @@ deriving (Eq, Ord) # endif +instance NFData a => NFData (MaxQueue a) where+ 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)@@ -283,11 +279,6 @@ -- | /O(n)/. Returns a list of the elements of the priority queue, in no particular order. toListU :: MaxQueue a -> [a] toListU (MaxQ q) = map unDown (Min.toListU q)---- | /O(n)/. Assumes that the function it is given is monotonic, in some sense, and performs the 'traverse' operation.--- If the function is not monotonic, the result is undefined.-traverseU :: (Applicative f, Ord b) => (a -> f b) -> MaxQueue a -> f (MaxQueue b)-traverseU f (MaxQ q) = MaxQ <$> Min.traverseU (traverse f) q -- | /O(n log n)/. Performs a right-fold on the elements of a priority queue in ascending order. -- @'foldrAsc' f z q == 'foldlDesc' (flip f) z q@.
Data/PQueue/Min.hs view
@@ -12,7 +12,7 @@ -- General purpose priority queue, supporting extract-minimum operations. -- -- An amortized running time is given for each operation, with /n/ referring--- to the length of the sequence and /i/ being the integral index used by+-- to the length of the sequence and /k/ being the integral index used by -- some operations. These bounds hold even in a persistent (shared) setting. -- -- This implementation is based on a binomial heap augmented with a global root.@@ -64,8 +64,6 @@ foldlAsc, foldrDesc, foldlDesc,- traverseAsc,- traverseDesc, -- * List operations toList, toAscList,@@ -77,7 +75,6 @@ mapU, foldrU, foldlU,- traverseU, elemsU, toListU, -- * Miscellaneous operations@@ -87,6 +84,7 @@ 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)@@ -229,7 +227,7 @@ -- | /O(n)/. Creates a new priority queue containing the images of the elements of this queue. -- Equivalent to @'fromList' . 'Data.List.map' f . toList@. map :: Ord b => (a -> b) -> MinQueue a -> MinQueue b-map f = fromList . List.map f . toListU+map f = foldrU (insert . f) empty {-# INLINE toAscList #-} -- | /O(n log n)/. Extracts the elements of the priority queue in ascending order.@@ -264,14 +262,6 @@ foldlDesc :: Ord a => (b -> a -> b) -> b -> MinQueue a -> b foldlDesc = foldrAsc . flip --- | /O(n log n)/. Equivalent to @'fromList' <$> 'traverse' f ('toAscList' q)@.-traverseAsc :: (Applicative f, Ord a, Ord b) => (a -> f b) -> MinQueue a -> f (MinQueue b)-traverseAsc f = foldrAsc (\ a q -> insert <$> f a <*> q) (pure empty)---- | /O(n log n)/. Equivalent to @'fromList' <$> 'traverse' f ('toDescList' q)@.-traverseDesc :: (Applicative f, Ord a, Ord b) => (a -> f b) -> MinQueue a -> f (MinQueue b)-traverseDesc f = foldrDesc (\ a q -> insert <$> f a <*> q) (pure empty)- {-# INLINE fromList #-} -- | /O(n)/. Constructs a priority queue from an unordered list. fromList :: Ord a => [a] -> MinQueue a@@ -304,11 +294,6 @@ -- | Returns the elements of the queue, in no particular order. toListU :: MinQueue a -> [a] toListU q = build (\ c n -> foldrU c n q)---- | /O(n)/. Iterates over the elements of the queue in no particular order, but returns a valid queue that--- respects the order of the returned elements.-traverseU :: (Applicative f, Ord b) => (a -> f b) -> MinQueue a -> f (MinQueue b)-traverseU f = foldrU (\ a q -> insert <$> f a <*> q) (pure empty) {-# RULES "foldr/toListU" forall f z q . foldr f z (toListU q) = foldrU f z q;
Data/PQueue/Prio/Internals.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} module Data.PQueue.Prio.Internals ( MinPQueue(..), BinomForest(..),@@ -13,7 +14,7 @@ insert, union, getMin,- alterMinWithKey,+ adjustMinWithKey, updateMinWithKey, minViewWithKey, mapWithKey,@@ -25,12 +26,30 @@ insertMin, foldrWithKeyU, foldlWithKeyU,+ traverseWithKeyU, seqSpine ) where -import Data.Monoid+import Control.Applicative (Applicative(..), (<$>))+import Control.Applicative.Identity+import Control.DeepSeq++import Data.Monoid (Monoid (..)) import Prelude hiding (null) +#if __GLASGOW_HASKELL__++import Data.Data++instance (Data k, Data a, Ord k) => Data (MinPQueue k a) where+ gfoldl f z m = z (foldr (uncurry' insertMin) empty) `f` foldrWithKey (curry (:)) [] m+ toConstr _ = error "toConstr"+ gunfold _ _ = error "gunfold"+ dataTypeOf _ = mkNoRepType "Data.PQueue.Prio.Min.MinPQueue"+ dataCast2 f = gcast2 f++#endif+ (.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d (f .: g) x y = f (g x y) @@ -48,6 +67,9 @@ -- | A priority queue where values of type @a@ are annotated with keys of type @k@. -- 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)+#endif data BinomForest rk k a = Nil |@@ -141,9 +163,9 @@ getMin _ = Nothing -- | /O(1)/. Alter the value at the minimum key. If the queue is empty, does nothing.-alterMinWithKey :: (k -> a -> a) -> MinPQueue k a -> MinPQueue k a-alterMinWithKey _ Empty = Empty-alterMinWithKey f (MinPQ n k a ts) = MinPQ n k (f k a) ts+adjustMinWithKey :: (k -> a -> a) -> MinPQueue k a -> MinPQueue k a+adjustMinWithKey _ Empty = Empty+adjustMinWithKey f (MinPQ n k a ts) = MinPQ n k (f k a) ts -- | /O(log n)/. (Actually /O(1)/ if there's no deletion.) Update the value at the minimum key. -- If the queue is empty, does nothing.@@ -161,8 +183,7 @@ -- | /O(n)/. Map a function over all values in the queue. mapWithKey :: (k -> a -> b) -> MinPQueue k a -> MinPQueue k b-mapWithKey _ Empty = Empty-mapWithKey f (MinPQ n k a ts) = MinPQ n k (f k a) (mapForest f (const Zero) ts)+mapWithKey f = runIdentity . traverseWithKeyU (Identity .: f) -- | /O(n)/. @'mapKeysMonotonic' f q == 'mapKeys' f q@, but only works when @f@ is strictly -- monotonic. /The precondition is not checked./ This function has better performance than@@ -363,6 +384,21 @@ 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) +traverseWithKeyU :: Applicative f => (k -> a -> f b) -> MinPQueue k a -> f (MinPQueue k b)+traverseWithKeyU _ Empty = pure Empty+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) #-}+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+ -- | 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@@ -402,3 +438,24 @@ Nil -> z Skip ts' -> seqSpineF ts' z Cons _ ts' -> seqSpineF ts' z++class NFRank rk where+ rnfRk :: (NFData k, NFData a) => rk k a -> ()++instance NFRank Zero where+ rnfRk _ = ()++instance NFRank rk => NFRank (Succ rk) where+ 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++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++instance (NFData k, NFData a) => NFData (MinPQueue k a) where+ rnf Empty = ()+ rnf (MinPQ _ k a ts) = k `deepseq` a `deepseq` rnf ts
Data/PQueue/Prio/Max.hs view
@@ -46,8 +46,8 @@ getMax, deleteMax, deleteFindMax,- alterMax,- alterMaxWithKey,+ adjustMax,+ adjustMaxWithKey, updateMax, updateMaxWithKey, maxView,@@ -221,12 +221,12 @@ 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.-alterMax :: (a -> a) -> MaxPQueue k a -> MaxPQueue k a -alterMax = alterMaxWithKey . const+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.-alterMaxWithKey :: (k -> a -> a) -> MaxPQueue k a -> MaxPQueue k a-alterMaxWithKey f (MaxPQ q) = MaxPQ (Q.alterMinWithKey (f . unDown) q)+adjustMaxWithKey :: (k -> a -> a) -> MaxPQueue k a -> MaxPQueue k a+adjustMaxWithKey f (MaxPQ q) = MaxPQ (Q.adjustMinWithKey (f . unDown) q) -- | /O(log n)/. (Actually /O(1)/ if there's no deletion.) Update the value at the maximum key. -- If the queue is empty, does nothing.
Data/PQueue/Prio/Max/Internals.hs view
@@ -3,6 +3,7 @@ module Data.PQueue.Prio.Max.Internals where import Control.Applicative+import Control.DeepSeq import Data.Foldable import Data.Traversable@@ -23,7 +24,18 @@ -- | 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) deriving (Eq, Ord)+newtype MaxPQueue k a = MaxPQ (MinPQueue (Down k) a)+# if __GLASGOW_HASKELL__+ deriving (Eq, Ord, Data, Typeable)+# else+ deriving (Eq, Ord)+# endif++instance (NFData k, NFData a) => NFData (MaxPQueue k a) where+ rnf (MaxPQ q) = rnf q++instance NFData a => NFData (Down a) where+ rnf (Down a) = rnf a instance Ord a => Ord (Down a) where Down a `compare` Down b = b `compare` a
Data/PQueue/Prio/Min.hs view
@@ -46,8 +46,8 @@ getMin, deleteMin, deleteFindMin,- alterMin,- alterMinWithKey,+ adjustMin,+ adjustMinWithKey, updateMin, updateMinWithKey, minView,@@ -114,13 +114,12 @@ ) where -import Control.Applicative hiding (empty)-import Control.Arrow-import Data.Monoid+import Control.Applicative (Applicative (..), (<$>))+import Data.Monoid import qualified Data.List as List import Data.Foldable hiding (toList) import Data.Traversable-import Data.Maybe hiding (mapMaybe)+import Data.Maybe (fromMaybe) import Data.PQueue.Prio.Internals @@ -193,8 +192,8 @@ deleteFindMin = fromMaybe (error "Error: deleteFindMin called on an empty queue") . minViewWithKey -- | /O(1)/. Alter the value at the minimum key. If the queue is empty, does nothing.-alterMin :: (a -> a) -> MinPQueue k a -> MinPQueue k a-alterMin = alterMinWithKey . const+adjustMin :: (a -> a) -> MinPQueue k a -> MinPQueue k a+adjustMin = adjustMinWithKey . const -- | /O(log n)/. (Actually /O(1)/ if there's no deletion.) Update the value at the minimum key. -- If the queue is empty, does nothing.@@ -400,14 +399,8 @@ -- | /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 -- priority queue will be perfectly valid.-traverseU :: (Applicative f, Ord b) => (a -> f b) -> MinPQueue k a -> f (MinPQueue k b)+traverseU :: (Applicative f) => (a -> f b) -> MinPQueue k a -> f (MinPQueue k b) traverseU = traverseWithKeyU . const---- | /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--- priority queue will be perfectly valid.-traverseWithKeyU :: (Applicative f, Ord b) => (k -> a -> f b) -> MinPQueue k a -> f (MinPQueue k b)-traverseWithKeyU f = foldrWithKeyU (\ k a q -> insertMin k <$> f k a <*> q) (pure empty) instance Functor (MinPQueue k) where fmap = map
pqueue.cabal view
@@ -1,5 +1,5 @@ Name: pqueue-Version: 1.0.1+Version: 1.1.0 Category: Data Structures Author: Louis Wasserman License: BSD3@@ -17,7 +17,7 @@ location: http://code.haskell.org/containers-pqueue/ Library{- build-depends: base >= 4 && < 5+ build-depends: base >= 4 && < 5, deepseq exposed-modules: Data.PQueue.Prio.Min Data.PQueue.Prio.Max@@ -27,7 +27,7 @@ Data.PQueue.Prio.Internals Data.PQueue.Internals Data.PQueue.Prio.Max.Internals-+ Control.Applicative.Identity if impl(ghc) { extensions: DeriveDataTypeable }