pqueue 1.5.0.0 → 1.6.0.0
raw patch · 19 files changed
+356/−408 lines, 19 filesdep ~basedep ~randomdep ~tasty-bench
Dependency ranges changed: base, random, tasty-bench
Files
- CHANGELOG.md +81/−68
- benchmarks/HeapSort.hs +0/−1
- benchmarks/KWay/PrioMergeAlg.hs +0/−1
- benchmarks/KWay/RandomIncreasing.hs +0/−1
- benchmarks/PHeapSort.hs +0/−1
- pqueue.cabal +30/−20
- src/BinomialQueue/Internals.hs +19/−24
- src/BinomialQueue/Max.hs +37/−61
- src/BinomialQueue/Min.hs +8/−18
- src/Data/PQueue/Internals.hs +9/−19
- src/Data/PQueue/Internals/Classes.hs +26/−0
- src/Data/PQueue/Internals/Foldable.hs +0/−22
- src/Data/PQueue/Max.hs +51/−52
- src/Data/PQueue/Min.hs +14/−17
- src/Data/PQueue/Prio/Internals.hs +9/−10
- src/Data/PQueue/Prio/Max/Internals.hs +53/−74
- src/Data/PQueue/Prio/Min.hs +5/−7
- src/Nattish.hs +3/−3
- tests/PQueueTests.hs +11/−9
CHANGELOG.md view
@@ -1,124 +1,137 @@ # Revision history for pqueue +## 1.6.0.0 -- 2025-10-11++* Deprecate `mapU` and replace it by `mapMonotonic` in `Data.PQeueu.Min` and `Data.PQueue.Max`+ ([#129](https://github.com/lspitzner/pqueue/pull/129))++* Add ghc-9.8, ghc-9.10 & ghc-9.12 support+ ([#133](https://github.com/lspitzner/pqueue/pull/133), [#135](https://github.com/lspitzner/pqueue/pull/135), [#139](https://github.com/lspitzner/pqueue/pull/139))++* Drop ghc-7.10 support ([#142](https://github.com/lspitzner/pqueue/pull/142))++* Fix typo in `Data.PQueue.Max.toList` documentation+ ([#131](https://github.com/lspitzner/pqueue/pull/131))+ ## 1.5.0.0 -- 2023-08-08 - * Fix incorrect behavior of `mapMaybe` and `mapEither` for `MinQueue`. These- previously worked only for monotonic functions.+* Fix incorrect behavior of `mapMaybe` and `mapEither` for `MinQueue`. These+ previously worked only for monotonic functions. - * Fix a performance bug that caused queue performance not to improve- when the queue shrinks.- ([#109](https://github.com/lspitzner/pqueue/pull/109))+* Fix a performance bug that caused queue performance not to improve+ when the queue shrinks.+ ([#109](https://github.com/lspitzner/pqueue/pull/109)) - * Make `minView` more eager, improving performance in typical cases.- ([#107](https://github.com/lspitzner/pqueue/pull/107))+* Make `minView` more eager, improving performance in typical cases.+ ([#107](https://github.com/lspitzner/pqueue/pull/107)) - * Make mapping and traversal functions force the full data structure spine.- This should make performance more predictable, and removes the last- remaining reasons to use the `seqSpine` functions. As these are no longer- useful, deprecate them.- ([#103](https://github.com/lspitzner/pqueue/pull/103))+* Make mapping and traversal functions force the full data structure spine.+ This should make performance more predictable, and removes the last+ remaining reasons to use the `seqSpine` functions. As these are no longer+ useful, deprecate them.+ ([#103](https://github.com/lspitzner/pqueue/pull/103)) - * Deprecate `insertBehind`. This function does not play nicely with merges,- we lack tests to verify it works properly without merges, it imposes a- substantial maintenance burden on the rest of the package, and it is quite- slow. ([#35](https://github.com/lspitzner/pqueue/issues/35))+* Deprecate `insertBehind`. This function does not play nicely with merges,+ we lack tests to verify it works properly without merges, it imposes a+ substantial maintenance burden on the rest of the package, and it is quite+ slow. ([#35](https://github.com/lspitzner/pqueue/issues/35)) - * Add pattern synonyms to work with `MinQueue` and `MinPQueue`.- ([#92](http://github.com/lspitzner/pqueue/pull/92))+* Add pattern synonyms to work with `MinQueue` and `MinPQueue`.+ ([#92](https://github.com/lspitzner/pqueue/pull/92)) - * Make the `Data` instances respect the queue invariants. Make the- `Constr`s match the pattern synonyms. Make the `Data` instance for- `MinPQueue` work "incrementally", like the one for `MinQueue`.- ([#92](http://github.com/lspitzner/pqueue/pull/92))+* Make the `Data` instances respect the queue invariants. Make the+ `Constr`s match the pattern synonyms. Make the `Data` instance for+ `MinPQueue` work "incrementally", like the one for `MinQueue`.+ ([#92](https://github.com/lspitzner/pqueue/pull/92)) ## 1.4.3.0 -- 2022-10-30 - * Add instances for [indexed-traversable](https://hackage.haskell.org/package/indexed-traversable).- ([#85](https://github.com/lspitzner/pqueue/pull/85))- * Add ghc-9.4 support. ([#86](https://github.com/lspitzner/pqueue/pull/86))+* Add instances for [indexed-traversable](https://hackage.haskell.org/package/indexed-traversable).+ ([#85](https://github.com/lspitzner/pqueue/pull/85))+* Add ghc-9.4 support. ([#86](https://github.com/lspitzner/pqueue/pull/86)) ## 1.4.2.0 -- 2022-06-19 - * Overall performance has improved greatly, especially when there are many- insertions and/or merges in a row. Insertion, deletion, and merge are now- *worst case* logarithmic, while maintaining their previous amortized- bounds. ([#26](https://github.com/lspitzner/pqueue/pull/26))+* Overall performance has improved greatly, especially when there are many+ insertions and/or merges in a row. Insertion, deletion, and merge are now+ *worst case* logarithmic, while maintaining their previous amortized+ bounds. ([#26](https://github.com/lspitzner/pqueue/pull/26)) - * New `mapMWithKey` functions optimized for working in strict monads. These- are used to implement the `mapM` and `sequence` methods of `Traversable`.- ([#46](https://github.com/lspitzner/pqueue/pull/46))+* New `mapMWithKey` functions optimized for working in strict monads. These+ are used to implement the `mapM` and `sequence` methods of `Traversable`.+ ([#46](https://github.com/lspitzner/pqueue/pull/46)) - * Define `stimes` in the `Semigroup` instances.- ([#57](https://github.com/lspitzner/pqueue/pull/57))+* Define `stimes` in the `Semigroup` instances.+ ([#57](https://github.com/lspitzner/pqueue/pull/57)) - * Add strict left unordered folds (`foldlU'`, `foldlWithKeyU'`)- and monoidal unordered folds (`foldMapU`, `foldMapWithKeyU`).- ([#59](https://github.com/lspitzner/pqueue/pull/59))+* Add strict left unordered folds (`foldlU'`, `foldlWithKeyU'`)+ and monoidal unordered folds (`foldMapU`, `foldMapWithKeyU`).+ ([#59](https://github.com/lspitzner/pqueue/pull/59)) - * New functions for adjusting and updating the min/max of a key-value- priority queue in an `Applicative` context.- ([#66](https://github.com/lspitzner/pqueue/pull/66))+* New functions for adjusting and updating the min/max of a key-value+ priority queue in an `Applicative` context.+ ([#66](https://github.com/lspitzner/pqueue/pull/66)) - * Fixed `Data.PQueue.Max.map` to work on `MaxQueue`s.- ([#76](https://github.com/lspitzner/pqueue/pull/76))+* Fixed `Data.PQueue.Max.map` to work on `MaxQueue`s.+ ([#76](https://github.com/lspitzner/pqueue/pull/76)) ## 1.4.1.4 -- 2021-12-04 - * Maintenance release for ghc-9.0 & ghc-9.2 support- * Change nix-setup to use the seaaye tool+* Maintenance release for ghc-9.0 & ghc-9.2 support+* Change nix-setup to use the seaaye tool ## 1.4.1.3 -- 2020-06-06 - * Maintenance release- * Add missing documentation- * Add nix-expressions for testing against different compilers/package sets+* Maintenance release+* Add missing documentation+* Add nix-expressions for testing against different compilers/package sets ## 1.4.1.2 -- 2018-09-26 - * Maintenance release for ghc-8.6- * Drop support for ghc<7.10+* Maintenance release for ghc-8.6+* Drop support for ghc<7.10 ## 1.4.1.1 -- 2018-02-11 - * Remove/replace buggy `insertBehind` implementation.+* Remove/replace buggy `insertBehind` implementation. - The existing implementation did not always insert behind. As a fix,- the function was removed from Data.PQueue.Max/Min and was rewritten- with a O(n) complexity (!) for Data.PQueue.Prio.Max/Min.+ The existing implementation did not always insert behind. As a fix,+ the function was removed from Data.PQueue.Max/Min and was rewritten+ with a O(n) complexity (!) for Data.PQueue.Prio.Max/Min. - * Adapt for ghc-8.4, based on the ghc-8.4.1-alpha1 release- * Drop support for ghc<7.4+* Adapt for ghc-8.4, based on the ghc-8.4.1-alpha1 release+* Drop support for ghc<7.4 ## 1.3.2.3 -- 2017-08-01 - * Maintenance release for ghc-8.2+* Maintenance release for ghc-8.2 ## 1.3.2.2 -- 2017-03-12 - * Add test-suite from darcs repository for pqueue-1.0.1.+* Add test-suite from darcs repository for pqueue-1.0.1. ## 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+* 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- in behaviour for elements the compare equal.+* Add function `insertBehind` as a slight variation of `insert` which differs+ in behaviour for elements the compare equal. ## 1.3.1.1 -- 2016-05-21 - * Ensure compatibility with ghc-8- * Minor internal refactors+* Ensure compatibility with ghc-8+* Minor internal refactors ## 1.3.1 -- 2015-10-03 - * Add `Monoid` instance for `MaxPQueue`+* Add `Monoid` instance for `MaxPQueue` ## 1.3.0 -- 2015-06-23 - * Lennart Spitzner starts co-maintaining- * new git repository at github.com:lspitzner/pqueue- * Ensure compatibility with ghc-7.10+* Lennart Spitzner starts co-maintaining+* new git repository at github.com:lspitzner/pqueue+* Ensure compatibility with ghc-7.10
benchmarks/HeapSort.hs view
@@ -1,6 +1,5 @@ module HeapSort where -import Data.PQueue.Min (MinQueue) import qualified Data.PQueue.Min as P import System.Random
benchmarks/KWay/PrioMergeAlg.hs view
@@ -7,7 +7,6 @@ ) where import qualified Data.PQueue.Prio.Min as P-import System.Random (StdGen) import Data.Word import Data.List (unfoldr) import KWay.RandomIncreasing
benchmarks/KWay/RandomIncreasing.hs view
@@ -5,7 +5,6 @@ import System.Random import Data.Word-import Data.List (unfoldr) data Stream = Stream !Word64 {-# UNPACK #-} !StdGen
benchmarks/PHeapSort.hs view
@@ -1,6 +1,5 @@ module PHeapSort where -import Data.PQueue.Prio.Min (MinPQueue) import qualified Data.PQueue.Prio.Min as P import System.Random
pqueue.cabal view
@@ -1,5 +1,5 @@ name: pqueue-version: 1.5.0.0+version: 1.6.0.0 category: Data Structures author: Louis Wasserman license: BSD3@@ -15,8 +15,21 @@ bug-reports: https://github.com/lspitzner/pqueue/issues build-type: Simple cabal-version: >= 1.10-tested-with: GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.4,- GHC == 8.10.7, GHC == 9.0.2, GHC == 9.2.7, GHC == 9.4.5, GHC == 9.6.2+tested-with:+ GHC == 9.12.2+ GHC == 9.10.3+ GHC == 9.8.4+ GHC == 9.6.7+ GHC == 9.4.8+ GHC == 9.2.8+ GHC == 9.0.2+ GHC == 8.10.7+ GHC == 8.8.4+ GHC == 8.6.5+ GHC == 8.4.4+ GHC == 8.2.2+ GHC == 8.0.2+ extra-source-files: CHANGELOG.md README.md@@ -30,8 +43,8 @@ default-language: Haskell2010 build-depends:- { base >= 4.8 && < 4.19- , deepseq >= 1.3 && < 1.5+ { base >= 4.9 && < 4.22+ , deepseq >= 1.3 && < 1.6 , indexed-traversable >= 0.1 && < 0.2 } exposed-modules:@@ -45,8 +58,8 @@ BinomialQueue.Internals BinomialQueue.Min BinomialQueue.Max+ Data.PQueue.Internals.Classes Data.PQueue.Internals.Down- Data.PQueue.Internals.Foldable Data.PQueue.Prio.Max.Internals Nattish if impl(ghc) {@@ -62,9 +75,6 @@ -fspec-constr -fdicts-strict -Wall- if impl(ghc >= 8.0)- ghc-options:- -fno-warn-unused-imports test-suite test hs-source-dirs: src, tests@@ -72,8 +82,8 @@ type: exitcode-stdio-1.0 main-is: PQueueTests.hs build-depends:- { base >= 4.8 && < 4.19- , deepseq >= 1.3 && < 1.5+ { base >= 4.9 && < 4.22+ , deepseq >= 1.3 && < 1.6 , indexed-traversable >= 0.1 && < 0.2 , tasty , tasty-quickcheck@@ -88,8 +98,8 @@ BinomialQueue.Internals BinomialQueue.Min BinomialQueue.Max+ Data.PQueue.Internals.Classes Data.PQueue.Internals.Down- Data.PQueue.Internals.Foldable Data.PQueue.Prio.Max.Internals Nattish @@ -116,11 +126,11 @@ KWay.RandomIncreasing ghc-options: -O2 build-depends:- base >= 4.8 && < 5+ base >= 4.9 && < 5 , pqueue- , deepseq >= 1.3 && < 1.5- , random >= 1.2 && < 1.3- , tasty-bench >= 0.3 && < 0.4+ , deepseq >= 1.3 && < 1.6+ , random >= 1.2 && < 1.4+ , tasty-bench >= 0.3 && < 0.5 benchmark minpqueue-benchmarks default-language: Haskell2010@@ -133,8 +143,8 @@ KWay.RandomIncreasing ghc-options: -O2 build-depends:- base >= 4.8 && < 5+ base >= 4.9 && < 5 , pqueue- , deepseq >= 1.3 && < 1.5- , random >= 1.2 && < 1.3- , tasty-bench >= 0.3 && < 0.4+ , deepseq >= 1.3 && < 1.6+ , random >= 1.2 && < 1.4+ , tasty-bench >= 0.3 && < 0.5
src/BinomialQueue/Internals.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE StandaloneDeriving #-} module BinomialQueue.Internals ( MinQueue (..),@@ -37,7 +36,6 @@ toDescList, toListU, fromList,- mapU, fromAscList, foldMapU, foldrU,@@ -48,13 +46,13 @@ ) where import Control.DeepSeq (NFData(rnf), deepseq)+#if !MIN_VERSION_base(4,20,0) import Data.Foldable (foldl')+#endif import Data.Function (on)-#if MIN_VERSION_base(4,9,0) import Data.Semigroup (Semigroup(..), stimesMonoid)-#endif -import Data.PQueue.Internals.Foldable+import Data.PQueue.Internals.Classes #ifdef __GLASGOW_HASKELL__ import Data.Data import Text.Read (Lexeme(Ident), lexP, parens, prec,@@ -247,10 +245,12 @@ -- This seems to be needed for specialization. {-# INLINABLE mapEither #-} --- | \(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.+-- | \(O(n)\). Assumes that the function it is given is (weakly) monotonic+-- (meaning that @x <= y@ implies @f x <= f y@), and+-- applies this function to every element of the priority queue, as in 'fmap'.+-- If the function is not monotonic, the result is undefined. mapMonotonic :: (a -> b) -> MinQueue a -> MinQueue b-mapMonotonic = mapU+mapMonotonic f (MinQueue ts) = MinQueue (fmap_ f ts) {-# INLINABLE [0] foldrAsc #-} -- | \(O(n \log n)\). Performs a right fold on the elements of a priority queue in@@ -542,19 +542,19 @@ | otherwise = BinomTree x2 (Succ t1 ts2) -instance Functor Zero where- fmap _ _ = Zero+instance Fmap Zero where+ fmap_ _ _ = Zero -instance Functor rk => Functor (Succ rk) where- fmap f (Succ t ts) = Succ (fmap f t) (fmap f ts)+instance Fmap rk => Fmap (Succ rk) where+ 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)+instance Fmap rk => Fmap (BinomTree rk) where+ 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+instance Fmap rk => Fmap (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 instance Foldr Zero where foldr_ _ z ~Zero = z@@ -648,9 +648,6 @@ -- 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 f (MinQueue ts) = MinQueue (f <$> ts)- {-# NOINLINE [0] foldrU #-} -- | \(O(n)\). Unordered right fold on a priority queue. foldrU :: (a -> b -> b) -> b -> MinQueue a -> b@@ -696,7 +693,7 @@ -- -- Note: The spine of a 'MinQueue' is stored somewhat lazily. Most operations -- take great care to prevent chains of thunks from accumulating along the--- spine to the detriment of performance. However, @mapU@ can leave expensive+-- spine to the detriment of performance. However, @mapMonotonic@ can leave expensive -- thunks in the structure and repeated applications of that function can -- create thunk chains. seqSpine :: MinQueue a -> b -> b@@ -746,12 +743,10 @@ return (fromAscList xs,t) #endif -#if MIN_VERSION_base(4,9,0) instance Ord a => Semigroup (MinQueue a) where (<>) = union stimes = stimesMonoid {-# INLINABLE stimes #-}-#endif instance Ord a => Monoid (MinQueue a) where mempty = empty
src/BinomialQueue/Max.hs view
@@ -87,26 +87,13 @@ import Prelude hiding (null, take, drop, takeWhile, dropWhile, splitAt, span, break, (!!), filter, map) -import Data.Foldable (foldl')-import Data.Maybe (fromMaybe)-import Data.Bifunctor (bimap)--#if MIN_VERSION_base(4,9,0)-import Data.Semigroup (Semigroup((<>)))-#endif-+import Data.Coerce (coerce) import qualified Data.List as List+import Data.Maybe (fromMaybe) import qualified BinomialQueue.Min as MinQ import Data.PQueue.Internals.Down -#ifdef __GLASGOW_HASKELL__-import GHC.Exts (build)-#else-build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]-build f = f (:) []-#endif- newtype MaxQueue a = MaxQueue { unMaxQueue :: MinQ.MinQueue (Down a) } -- | \(O(\log n)\). Returns the minimum element. Throws an error on an empty queue.@@ -115,11 +102,11 @@ -- | \(O(1)\). The top (maximum) element of the queue, if there is one. getMax :: Ord a => MaxQueue a -> Maybe a-getMax (MaxQueue q) = unDown <$> MinQ.getMin q+getMax = coerce MinQ.getMin -- | \(O(\log n)\). Deletes the maximum element. If the queue is empty, does nothing. deleteMax :: Ord a => MaxQueue a -> MaxQueue a-deleteMax = MaxQueue . MinQ.deleteMin . unMaxQueue+deleteMax = coerce MinQ.deleteMin -- | \(O(\log n)\). Extracts the maximum element. Throws an error on an empty queue. deleteFindMax :: Ord a => MaxQueue a -> (a, MaxQueue a)@@ -127,11 +114,9 @@ -- | \(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 (MaxQueue q) = case MinQ.minView q of- Just (Down a, q') -> Just (a, MaxQueue q')- Nothing -> Nothing+maxView = coerce MinQ.minView --- | \(O(k \log n)\)/. Index (subscript) operator, starting from 0. @queue !! k@ returns the @(k+1)@th largest+-- | \(O(k \log n)\). Index (subscript) operator, starting from 0. @queue !! k@ returns the @(k+1)@th largest -- element in the queue. Equivalent to @toDescList queue !! k@. (!!) :: Ord a => MaxQueue a -> Int -> a q !! n | n >= size q@@ -142,19 +127,17 @@ -- | '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]-takeWhile p = fmap unDown . MinQ.takeWhile (p . unDown) . unMaxQueue+takeWhile = coerce MinQ.takeWhile -- | 'dropWhile' @p queue@ returns the queue remaining after 'takeWhile' @p queue@. dropWhile :: Ord a => (a -> Bool) -> MaxQueue a -> MaxQueue a-dropWhile p = MaxQueue . MinQ.dropWhile (p . unDown) . unMaxQueue+dropWhile = coerce MinQ.dropWhile -- | '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 (MaxQueue queue)- | (front, rear) <- MinQ.span (p . unDown) queue- = (fmap unDown front, MaxQueue rear)+span = coerce MinQ.span -- | '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@@ -163,81 +146,75 @@ break p = span (not . p) {-# INLINE take #-}--- | \(O(k \log n)\)/. 'take' @k@, applied to a queue @queue@, returns a list of the greatest @k@ elements of @queue@,+-- | \(O(k \log n)\). 'take' @k@, applied to a queue @queue@, returns a list of the greatest @k@ elements of @queue@, -- or all elements of @queue@ itself if @k >= 'size' queue@. take :: Ord a => Int -> MaxQueue a -> [a] take n = List.take n . toDescList --- | \(O(k \log n)\)/. 'drop' @k@, applied to a queue @queue@, returns @queue@ with the greatest @k@ elements deleted,--- or an empty queue if @k >= size 'queue'@.+-- | \(O(k \log n)\). 'drop' @k@, applied to a queue @queue@, returns @queue@ with the greatest @k@ elements deleted,+-- or an empty queue if @k >= 'size' queue@. drop :: Ord a => Int -> MaxQueue a -> MaxQueue a-drop n (MaxQueue queue) = MaxQueue (MinQ.drop n queue)+drop = coerce MinQ.drop --- | \(O(k \log n)\)/. Equivalent to @('take' k queue, 'drop' k queue)@.+-- | \(O(k \log n)\). Equivalent to @('take' k queue, 'drop' k queue)@. splitAt :: Ord a => Int -> MaxQueue a -> ([a], MaxQueue a)-splitAt n (MaxQueue queue)- | (l, r) <- MinQ.splitAt n queue- = (fmap unDown l, MaxQueue r)+splitAt = coerce MinQ.splitAt -- | \(O(n)\). Returns the queue with all elements not satisfying @p@ removed. filter :: Ord a => (a -> Bool) -> MaxQueue a -> MaxQueue a-filter p = MaxQueue . MinQ.filter (p . unDown) . unMaxQueue+filter = coerce MinQ.filter -- | \(O(n)\). Returns a pair where the first queue contains all elements satisfying @p@, and the second queue -- contains all elements not satisfying @p@. partition :: Ord a => (a -> Bool) -> MaxQueue a -> (MaxQueue a, MaxQueue a)-partition p = go . unMaxQueue- where- go queue- | (l, r) <- MinQ.partition (p . unDown) queue- = (MaxQueue l, MaxQueue r)+partition = coerce MinQ.partition -- | \(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) -> MaxQueue a -> MaxQueue b-map f = MaxQueue . MinQ.map (fmap f) . unMaxQueue+map = coerce MinQ.map {-# INLINE toList #-} -- | \(O(n \log n)\). Returns the elements of the priority queue in descending order. Equivalent to 'toDescList'. -- -- If the order of the elements is irrelevant, consider using 'toListU'. toList :: Ord a => MaxQueue a -> [a]-toList = fmap unDown . MinQ.toAscList . unMaxQueue+toList = coerce MinQ.toAscList toAscList :: Ord a => MaxQueue a -> [a]-toAscList = fmap unDown . MinQ.toDescList . unMaxQueue+toAscList = coerce MinQ.toDescList toDescList :: Ord a => MaxQueue a -> [a]-toDescList = fmap unDown . MinQ.toAscList . unMaxQueue+toDescList = coerce MinQ.toAscList -- | \(O(n \log n)\). Performs a right fold on the elements of a priority queue in descending order. foldrDesc :: Ord a => (a -> b -> b) -> b -> MaxQueue a -> b-foldrDesc f z (MaxQueue q) = MinQ.foldrAsc (flip (foldr f)) z q+foldrDesc f z (MaxQueue q) = MinQ.foldrAsc (coerce f) z q -- | \(O(n \log n)\). Performs a right fold on the elements of a priority queue in ascending order. foldrAsc :: Ord a => (a -> b -> b) -> b -> MaxQueue a -> b-foldrAsc f z (MaxQueue q) = MinQ.foldrDesc (flip (foldr f)) z q+foldrAsc f z (MaxQueue q) = MinQ.foldrDesc (coerce f) z q -- | \(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 -> MaxQueue a -> b-foldlAsc f z (MaxQueue q) = MinQ.foldlDesc (foldl f) z q+foldlAsc f z (MaxQueue q) = MinQ.foldlDesc (coerce f) z q -- | \(O(n \log n)\). Performs a left fold on the elements of a priority queue in descending order. foldlDesc :: Ord a => (b -> a -> b) -> b -> MaxQueue a -> b-foldlDesc f z (MaxQueue q) = MinQ.foldlAsc (foldl f) z q+foldlDesc f z (MaxQueue q) = MinQ.foldlAsc (coerce f) z q {-# INLINE fromAscList #-} -- | \(O(n)\). Constructs a priority queue from an ascending list. /Warning/: Does not check the precondition. fromAscList :: [a] -> MaxQueue a-fromAscList = MaxQueue . MinQ.fromDescList . fmap Down+fromAscList = coerce MinQ.fromDescList {-# INLINE fromDescList #-} -- | \(O(n)\). Constructs a priority queue from a descending list. /Warning/: Does not check the precondition. fromDescList :: [a] -> MaxQueue a-fromDescList = MaxQueue . MinQ.fromAscList . fmap Down+fromDescList = coerce MinQ.fromAscList fromList :: Ord a => [a] -> MaxQueue a-fromList = MaxQueue . MinQ.fromList . fmap Down+fromList = coerce MinQ.fromList -- | Equivalent to 'toListU'. elemsU :: MaxQueue a -> [a]@@ -245,7 +222,7 @@ -- | Convert to a list in an arbitrary order. toListU :: MaxQueue a -> [a]-toListU = fmap unDown . MinQ.toListU . unMaxQueue+toListU = coerce MinQ.toListU -- | Get the number of elements in a 'MaxQueue'. size :: MaxQueue a -> Int@@ -255,35 +232,34 @@ empty = MaxQueue MinQ.empty foldMapU :: Monoid m => (a -> m) -> MaxQueue a -> m-foldMapU f = MinQ.foldMapU (f . unDown) . unMaxQueue+foldMapU f = MinQ.foldMapU (coerce f) . unMaxQueue seqSpine :: MaxQueue a -> b -> b seqSpine = MinQ.seqSpine . unMaxQueue foldlU :: (b -> a -> b) -> b -> MaxQueue a -> b-foldlU f b = MinQ.foldlU (\acc (Down a) -> f acc a) b . unMaxQueue+foldlU f b = MinQ.foldlU (coerce f) b . unMaxQueue foldlU' :: (b -> a -> b) -> b -> MaxQueue a -> b-foldlU' f b = MinQ.foldlU' (\acc (Down a) -> f acc a) b . unMaxQueue+foldlU' f b = MinQ.foldlU' (coerce f) b . unMaxQueue foldrU :: (a -> b -> b) -> b -> MaxQueue a -> b-foldrU c n = MinQ.foldrU (c . unDown) n . unMaxQueue+foldrU c n = MinQ.foldrU (coerce c) n . unMaxQueue null :: MaxQueue a -> Bool null = MinQ.null . unMaxQueue singleton :: a -> MaxQueue a-singleton = MaxQueue . MinQ.singleton . Down+singleton = coerce MinQ.singleton mapMaybe :: Ord b => (a -> Maybe b) -> MaxQueue a -> MaxQueue b-mapMaybe f = MaxQueue . MinQ.mapMaybe (fmap Down . f . unDown) . unMaxQueue+mapMaybe = coerce MinQ.mapMaybe insert :: Ord a => a -> MaxQueue a -> MaxQueue a-insert a (MaxQueue q) = MaxQueue (MinQ.insert (Down a) q)+insert = coerce MinQ.insert mapEither :: (Ord b, Ord c) => (a -> Either b c) -> MaxQueue a -> (MaxQueue b, MaxQueue c)-mapEither f (MaxQueue q) = case MinQ.mapEither (bimap Down Down . f . unDown) q of- (l, r) -> (MaxQueue l, MaxQueue r)+mapEither = coerce MinQ.mapEither union :: Ord a => MaxQueue a -> MaxQueue a -> MaxQueue a union (MaxQueue a) (MaxQueue b) = MaxQueue (MinQ.union a b)
src/BinomialQueue/Min.hs view
@@ -62,6 +62,7 @@ mapEither, -- * Fold\/Functor\/Traversable variations map,+ mapMonotonic, foldrAsc, foldlAsc, foldrDesc,@@ -74,7 +75,6 @@ fromAscList, fromDescList, -- * Unordered operations- mapU, foldrU, foldlU, foldlU',@@ -88,24 +88,14 @@ import Prelude hiding (null, take, drop, takeWhile, dropWhile, splitAt, span, break, (!!), filter, map) +#if !MIN_VERSION_base(4,20,0) import Data.Foldable (foldl')-import Data.Maybe (fromMaybe)--#if MIN_VERSION_base(4,9,0)-import Data.Semigroup (Semigroup((<>))) #endif- import qualified Data.List as List+import Data.Maybe (fromMaybe) import BinomialQueue.Internals -#ifdef __GLASGOW_HASKELL__-import GHC.Exts (build)-#else-build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]-build f = f (:) []-#endif- -- | \(O(\log n)\). Returns the minimum element. Throws an error on an empty queue. findMin :: Ord a => MinQueue a -> a findMin = fromMaybe (error "Error: findMin called on empty queue") . getMin@@ -120,7 +110,7 @@ deleteFindMin :: Ord a => MinQueue a -> (a, MinQueue a) deleteFindMin = fromMaybe (error "Error: deleteFindMin called on empty queue") . minView --- | \(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@@ -156,20 +146,20 @@ break p = span (not . p) {-# INLINE take #-}--- | \(O(k \log n)\)/. 'take' @k@, applied to a queue @queue@, returns a list of the smallest @k@ elements of @queue@,+-- | \(O(k \log n)\). 'take' @k@, applied to a queue @queue@, returns a list of the smallest @k@ elements of @queue@, -- or all elements of @queue@ itself if @k >= 'size' queue@. take :: Ord a => Int -> MinQueue a -> [a] take n = List.take n . toAscList --- | \(O(k \log n)\)/. 'drop' @k@, applied to a queue @queue@, returns @queue@ with the smallest @k@ elements deleted,--- or an empty queue if @k >= size 'queue'@.+-- | \(O(k \log n)\). 'drop' @k@, applied to a queue @queue@, returns @queue@ with the smallest @k@ elements deleted,+-- 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 --- | \(O(k \log n)\)/. Equivalent to @('take' k queue, 'drop' k 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')
src/Data/PQueue/Internals.hs view
@@ -29,7 +29,6 @@ toDescList, toListU, fromList,- mapU, fromAscList, foldMapU, foldrU,@@ -46,17 +45,14 @@ , BinomTree (..) , Succ (..) , Zero (..)- , Extract (..)- , MExtract (..) ) import qualified BinomialQueue.Internals as BQ import Control.DeepSeq (NFData(rnf), deepseq)+#if !MIN_VERSION_base(4,20,0) import Data.Foldable (foldl')-#if MIN_VERSION_base(4,9,0)-import Data.Semigroup (Semigroup(..), stimesMonoid) #endif+import Data.Semigroup (Semigroup(..), stimesMonoid) -import Data.PQueue.Internals.Foldable #ifdef __GLASGOW_HASKELL__ import Data.Data import Text.Read (Lexeme(Ident), lexP, parens, prec,@@ -204,10 +200,13 @@ !r' = fromBare (BQ.insertEager z r) in (l', r') --- | \(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.+-- | \(O(n)\). Assumes that the function it is given is (weakly) monotonic+-- (meaning that @x <= y@ implies @f x <= f y@), and+-- applies this function to every element of the priority queue, as in 'fmap'.+-- If the function is not monotonic, the result is undefined. mapMonotonic :: (a -> b) -> MinQueue a -> MinQueue b-mapMonotonic = mapU+mapMonotonic _ Empty = Empty+mapMonotonic f (MinQueue n x ts) = MinQueue n (f x) (BQ.mapMonotonic f ts) {-# INLINABLE [0] foldrAsc #-} -- | \(O(n \log n)\). Performs a right fold on the elements of a priority queue in@@ -280,7 +279,7 @@ -- | @insertMaxQ' x h@ assumes that @x@ compares as greater -- than or equal to every element of @h@. It also assumes,--- and preserves, an extra invariant. See 'insertMax'' for details.+-- and preserves, an extra invariant. See 'BQ.insertMax'' for details. -- tldr: this function can be used safely to build a queue from an -- ascending list/array/whatever, but that's about it. insertMaxQ' :: a -> MinQueue a -> MinQueue a@@ -295,13 +294,6 @@ -- comparison per element. fromList xs = fromBare (BQ.fromList xs) --- | \(O(n)\). Assumes that the function it is given is (weakly) monotonic, and--- applies this function to every element of the priority queue, as in 'fmap'.--- If the function is not monotonic, the result is undefined.-mapU :: (a -> b) -> MinQueue a -> MinQueue b-mapU _ Empty = Empty-mapU f (MinQueue n x ts) = MinQueue n (f x) (BQ.mapU f ts)- {-# NOINLINE [0] foldrU #-} -- | \(O(n)\). Unordered right fold on a priority queue. foldrU :: (a -> b -> b) -> b -> MinQueue a -> b@@ -382,12 +374,10 @@ return (fromAscList xs,t) #endif -#if MIN_VERSION_base(4,9,0) instance Ord a => Semigroup (MinQueue a) where (<>) = union stimes = stimesMonoid {-# INLINABLE stimes #-}-#endif instance Ord a => Monoid (MinQueue a) where mempty = empty
+ src/Data/PQueue/Internals/Classes.hs view
@@ -0,0 +1,26 @@+-- | Writing `Foldable`/`Functor` instances for non-regular (AKA, nested) types in the+-- natural manner leads to full dictionaries being constructed on+-- each recursive call. This is pretty inefficient. It's better to construct+-- exactly what we need instead.+module Data.PQueue.Internals.Classes+ ( Foldr(..)+ , Foldl(..)+ , FoldMap(..)+ , Foldl'(..)+ , Fmap(..)+ ) where++class Foldr t where+ foldr_ :: (a -> b -> b) -> b -> t a -> b++class Foldl t where+ foldl_ :: (b -> a -> b) -> b -> t a -> b++class FoldMap t where+ foldMap_ :: Monoid m => (a -> m) -> t a -> m++class Foldl' t where+ foldl'_ :: (b -> a -> b) -> b -> t a -> b++class Fmap f where+ fmap_ :: (a -> b) -> f a -> f b
− src/Data/PQueue/Internals/Foldable.hs
@@ -1,22 +0,0 @@--- | Writing 'Foldable' instances for non-regular (AKA, nested) types in the--- natural manner leads to full `Foldable` dictionaries being constructed on--- each recursive call. This is pretty inefficient. It's better to construct--- exactly what we need instead.-module Data.PQueue.Internals.Foldable- ( Foldr (..)- , Foldl (..)- , FoldMap (..)- , Foldl' (..)- ) where--class Foldr t where- foldr_ :: (a -> b -> b) -> b -> t a -> b--class Foldl t where- foldl_ :: (b -> a -> b) -> b -> t a -> b--class FoldMap t where- foldMap_ :: Monoid m => (a -> m) -> t a -> m--class Foldl' t where- foldl'_ :: (b -> a -> b) -> b -> t a -> b
src/Data/PQueue/Max.hs view
@@ -1,5 +1,7 @@ {-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -Wno-deprecations #-}+ ----------------------------------------------------------------------------- -- | -- Module : Data.PQueue.Max@@ -59,6 +61,7 @@ mapEither, -- * Fold\/Functor\/Traversable variations map,+ mapMonotonic, foldrAsc, foldlAsc, foldrDesc,@@ -84,14 +87,13 @@ import Control.DeepSeq (NFData(rnf)) +import Data.Coerce (coerce)+#if !MIN_VERSION_base(4,20,0)+import Data.Foldable (foldl')+#endif import Data.Maybe (fromMaybe)--#if MIN_VERSION_base(4,9,0) import Data.Semigroup (Semigroup(..), stimesMonoid)-#endif -import Data.Foldable (foldl')- import qualified Data.PQueue.Min as Min import qualified Data.PQueue.Prio.Max.Internals as Prio import Data.PQueue.Internals.Down (Down(..))@@ -139,12 +141,10 @@ return (fromDescList xs,t) #endif -#if MIN_VERSION_base(4,9,0) instance Ord a => Semigroup (MaxQueue a) where (<>) = union stimes = stimesMonoid {-# INLINABLE stimes #-}-#endif instance Ord a => Monoid (MaxQueue a) where mempty = empty@@ -171,11 +171,11 @@ -- | \(O(1)\). The top (maximum) element of the queue, if there is one. getMax :: MaxQueue a -> Maybe a-getMax (MaxQ q) = unDown <$> Min.getMin q+getMax = coerce Min.getMin -- | \(O(\log n)\). Deletes the maximum element of the queue. Does nothing on an empty queue. deleteMax :: Ord a => MaxQueue a -> MaxQueue a-deleteMax (MaxQ q) = MaxQ (Min.deleteMin q)+deleteMax = coerce Min.deleteMin -- | \(O(\log n)\). Extracts the maximum element of the queue. Throws an error on an empty queue. deleteFindMax :: Ord a => MaxQueue a -> (a, MaxQueue a)@@ -183,10 +183,7 @@ -- | \(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')+maxView = coerce Min.minView -- | \(O(\log n)\). Delete the top (maximum) element of the sequence, if there is one. delete :: Ord a => MaxQueue a -> Maybe (MaxQueue a)@@ -194,11 +191,11 @@ -- | \(O(1)\). Construct a priority queue with a single element. singleton :: a -> MaxQueue a-singleton = MaxQ . Min.singleton . Down+singleton = coerce Min.singleton -- | \(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)+insert = coerce Min.insert -- | \(O(\log min(n_1,n_2))\). Take the union of two priority queues. union :: Ord a => MaxQueue a -> MaxQueue a -> MaxQueue a@@ -206,43 +203,41 @@ -- | Takes the union of a list of priority queues. Equivalent to @'foldl' 'union' 'empty'@. unions :: Ord a => [MaxQueue a] -> MaxQueue a-unions qs = MaxQ (Min.unions [q | MaxQ q <- qs])+unions = coerce Min.unions --- | \(O(k \log n)\)/. Returns the @(k+1)@th largest element of the queue.+-- | \(O(k \log n)\). Returns the @(k+1)@th largest element of the queue. (!!) :: Ord a => MaxQueue a -> Int -> a-MaxQ q !! n = unDown ((Min.!!) q n)+(!!) = coerce (Min.!!) {-# INLINE take #-}--- | \(O(k \log n)\)/. Returns the list of the @k@ largest elements of the queue, in descending order, or+-- | \(O(k \log n)\). Returns the list of the @k@ largest elements of the queue, in descending order, or -- all elements of the queue, if @k >= n@. take :: Ord a => Int -> MaxQueue a -> [a]-take k (MaxQ q) = [a | Down a <- Min.take k q]+take = coerce Min.take --- | \(O(k \log n)\)/. Returns the queue with the @k@ largest elements deleted, or the empty queue if @k >= n@.+-- | \(O(k \log n)\). Returns the queue with the @k@ largest elements deleted, or the empty queue if @k >= n@. drop :: Ord a => Int -> MaxQueue a -> MaxQueue a-drop k (MaxQ q) = MaxQ (Min.drop k q)+drop = coerce Min.drop --- | \(O(k \log n)\)/. Equivalent to @(take k queue, drop k queue)@.+-- | \(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) = (fmap unDown xs, MaxQ q') where- (xs, q') = Min.splitAt k q+splitAt = coerce Min.splitAt -- | '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]-takeWhile p (MaxQ q) = fmap unDown (Min.takeWhile (p . unDown) q)+takeWhile = coerce Min.takeWhile -- | 'dropWhile' @p queue@ returns the queue remaining after 'takeWhile' @p queue@. dropWhile :: Ord a => (a -> Bool) -> MaxQueue a -> MaxQueue a-dropWhile p (MaxQ q) = MaxQ (Min.dropWhile (p . unDown) q)+dropWhile = coerce Min.dropWhile -- | '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) = (fmap unDown xs, MaxQ q') where- (xs, q') = Min.span (p . unDown) q+span = coerce Min.span -- | '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@@ -252,54 +247,58 @@ -- | \(O(n)\). Returns a queue of those elements which satisfy the predicate. filter :: Ord a => (a -> Bool) -> MaxQueue a -> MaxQueue a-filter p (MaxQ q) = MaxQ (Min.filter (p . unDown) q)+filter = coerce Min.filter -- | \(O(n)\). Returns a pair of queues, where the left queue contains those elements that satisfy the predicate, -- 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+partition = coerce Min.partition -- | \(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-mapMaybe f (MaxQ q) = MaxQ (Min.mapMaybe (\(Down x) -> Down <$> f x) q)+mapMaybe = coerce Min.mapMaybe -- | \(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+mapEither = coerce Min.mapEither -- | \(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) -> MaxQueue a -> MaxQueue b-map f (MaxQ q) = MaxQ (Min.map (\(Down x) -> Down (f x)) q)+map = coerce Min.map --- | \(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/.+-- | \(O(n)\). Assumes that the function it is given is (weakly) monotonic+-- (meaning that @x <= y@ implies @f x <= f y@), and+-- applies this function to every element of the priority queue, as in 'fmap'.+-- If the function is not monotonic, the result is undefined.+mapMonotonic :: (a -> b) -> MaxQueue a -> MaxQueue b+mapMonotonic f (MaxQ q) = MaxQ (Min.mapMonotonic (\(Down a) -> Down (f a)) q)++{-# DEPRECATED mapU "use mapMonotonic instead" #-} mapU :: (a -> b) -> MaxQueue a -> MaxQueue b-mapU f (MaxQ q) = MaxQ (Min.mapU (\(Down a) -> Down (f a)) q)+mapU = mapMonotonic -- | \(O(n)\). Unordered right fold on a priority queue. foldrU :: (a -> b -> b) -> b -> MaxQueue a -> b-foldrU f z (MaxQ q) = Min.foldrU (flip (foldr f)) z q+foldrU f z (MaxQ q) = Min.foldrU (coerce f) z q -- | \(O(n)\). Unordered monoidal fold on a priority queue. -- -- @since 1.4.2 foldMapU :: Monoid m => (a -> m) -> MaxQueue a -> m-foldMapU f (MaxQ q) = Min.foldMapU (f . unDown) q+foldMapU f (MaxQ q) = Min.foldMapU (coerce f) q -- | \(O(n)\). Unordered left fold on a priority queue. This is rarely -- what you want; 'foldrU' and 'foldlU'' are more likely to perform -- well. foldlU :: (b -> a -> b) -> b -> MaxQueue a -> b-foldlU f z (MaxQ q) = Min.foldlU (foldl f) z q+foldlU f z (MaxQ q) = Min.foldlU (coerce f) z q -- | \(O(n)\). Unordered strict left fold on a priority queue. -- -- @since 1.4.2 foldlU' :: (b -> a -> b) -> b -> MaxQueue a -> b-foldlU' f z (MaxQ q) = Min.foldlU' (foldl' f) z q+foldlU' f z (MaxQ q) = Min.foldlU' (coerce f) z q {-# INLINE elemsU #-} -- | Equivalent to 'toListU'.@@ -309,7 +308,7 @@ {-# INLINE toListU #-} -- | \(O(n)\). Returns a list of the elements of the priority queue, in no particular order. toListU :: MaxQueue a -> [a]-toListU (MaxQ q) = fmap unDown (Min.toListU q)+toListU = coerce Min.toListU -- | \(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@.@@ -323,11 +322,11 @@ -- | \(O(n \log n)\). Performs a right-fold on the elements of a priority queue in descending order. foldrDesc :: Ord a => (a -> b -> b) -> b -> MaxQueue a -> b-foldrDesc f z (MaxQ q) = Min.foldrAsc (flip (foldr f)) z q+foldrDesc f z (MaxQ q) = Min.foldrAsc (coerce f) z q -- | \(O(n \log n)\). Performs a left-fold on the elements of a priority queue in descending order. foldlDesc :: Ord a => (b -> a -> b) -> b -> MaxQueue a -> b-foldlDesc f z (MaxQ q) = Min.foldlAsc (foldl f) z q+foldlDesc f z (MaxQ q) = Min.foldlAsc (coerce f) z q {-# INLINE toAscList #-} -- | \(O(n \log n)\). Extracts the elements of the priority queue in ascending order.@@ -342,30 +341,30 @@ -- I can see no particular reason this does not simply forward to Min.toAscList. (lsp, 2016) {-# INLINE toList #-}--- | \(O(n \log n)\). Returns the elements of the priority queue in ascending order. Equivalent to 'toDescList'.+-- | \(O(n \log n)\). Returns the elements of the priority queue in descending order. Equivalent to 'toDescList'. -- -- If the order of the elements is irrelevant, consider using 'toListU'. toList :: Ord a => MaxQueue a -> [a]-toList (MaxQ q) = fmap unDown (Min.toList q)+toList = coerce Min.toList {-# INLINE fromAscList #-} -- | \(O(n)\). Constructs a priority queue from an ascending list. /Warning/: Does not check the precondition. fromAscList :: [a] -> MaxQueue a-fromAscList = MaxQ . Min.fromDescList . fmap Down+fromAscList = coerce Min.fromDescList {-# INLINE fromDescList #-} -- | \(O(n)\). Constructs a priority queue from a descending list. /Warning/: Does not check the precondition. fromDescList :: [a] -> MaxQueue a-fromDescList = MaxQ . Min.fromAscList . fmap Down+fromDescList = coerce Min.fromAscList {-# INLINE fromList #-} -- | \(O(n \log n)\). Constructs a priority queue from an unordered list. fromList :: Ord a => [a] -> MaxQueue a-fromList = MaxQ . Min.fromList . fmap Down+fromList = coerce Min.fromList -- | \(O(n)\). Constructs a priority queue from the keys of a 'Prio.MaxPQueue'. keysQueue :: Prio.MaxPQueue k a -> MaxQueue k-keysQueue (Prio.MaxPQ q) = MaxQ (Min.keysQueue q)+keysQueue = coerce Min.keysQueue -- | \(O(\log n)\). @seqSpine q r@ forces the spine of @q@ and returns @r@. --
src/Data/PQueue/Min.hs view
@@ -68,6 +68,7 @@ mapEither, -- * Fold\/Functor\/Traversable variations map,+ mapMonotonic, foldrAsc, foldlAsc, foldrDesc,@@ -93,14 +94,11 @@ import Prelude hiding (null, take, drop, takeWhile, dropWhile, splitAt, span, break, (!!), filter, map) +#if !MIN_VERSION_base(4,20,0) import Data.Foldable (foldl')-import Data.Maybe (fromMaybe)--#if MIN_VERSION_base(4,9,0)-import Data.Semigroup (Semigroup((<>))) #endif- import qualified Data.List as List+import Data.Maybe (fromMaybe) import Data.PQueue.Internals hiding (MinQueue (..)) import Data.PQueue.Internals (MinQueue (MinQueue))@@ -109,13 +107,6 @@ import qualified Data.PQueue.Prio.Internals as Prio #ifdef __GLASGOW_HASKELL__-import GHC.Exts (build)-#else-build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]-build f = f (:) []-#endif--#ifdef __GLASGOW_HASKELL__ -- | A bidirectional pattern synonym for an empty priority queue. -- -- @since 1.5.0@@ -145,7 +136,9 @@ {-# INLINE (:<) #-} # endif +# if __GLASGOW_HASKELL__ >= 820 {-# COMPLETE Empty, (:<) #-}+# endif #endif -- | \(O(1)\). Returns the minimum element. Throws an error on an empty queue.@@ -162,7 +155,7 @@ deleteFindMin :: Ord a => MinQueue a -> (a, MinQueue a) deleteFindMin = fromMaybe (error "Error: deleteFindMin called on empty queue") . minView --- | \(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@@ -198,20 +191,20 @@ break p = span (not . p) {-# INLINE take #-}--- | \(O(k \log n)\)/. 'take' @k@, applied to a queue @queue@, returns a list of the smallest @k@ elements of @queue@,+-- | \(O(k \log n)\). 'take' @k@, applied to a queue @queue@, returns a list of the smallest @k@ elements of @queue@, -- or all elements of @queue@ itself if @k >= 'size' queue@. take :: Ord a => Int -> MinQueue a -> [a] take n = List.take n . toAscList --- | \(O(k \log n)\)/. 'drop' @k@, applied to a queue @queue@, returns @queue@ with the smallest @k@ elements deleted,--- or an empty queue if @k >= size 'queue'@.+-- | \(O(k \log n)\). 'drop' @k@, applied to a queue @queue@, returns @queue@ with the smallest @k@ elements deleted,+-- 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 --- | \(O(k \log n)\)/. Equivalent to @('take' k queue, 'drop' k 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')@@ -231,6 +224,10 @@ -- Equivalent to @'fromList' . 'Data.List.map' f . toList@. map :: Ord b => (a -> b) -> MinQueue a -> MinQueue b map f = foldrU (insert . f) empty++{-# DEPRECATED mapU "use mapMonotonic instead" #-}+mapU :: (a -> b) -> MinQueue a -> MinQueue b+mapU = mapMonotonic {-# INLINE toList #-} -- | \(O(n \log n)\). Returns the elements of the priority queue in ascending order. Equivalent to 'toAscList'.
src/Data/PQueue/Prio/Internals.hs view
@@ -52,17 +52,17 @@ unions ) where -import Control.Applicative (liftA2, liftA3, Const (..))+#if MIN_VERSION_base(4,18,0)+import Control.Applicative (Const (..))+#else+import Control.Applicative (liftA2, Const (..))+#endif import Control.DeepSeq (NFData(rnf), deepseq) import Data.Coerce (coerce) import Data.Functor.Identity (Identity(Identity, runIdentity)) import qualified Data.List as List -#if MIN_VERSION_base(4,9,0) import Data.Semigroup (Semigroup(..), stimesMonoid, Endo (..), Dual (..))-#else-import Data.Monoid ((<>), Endo (..), Dual (..))-#endif import Prelude hiding (null, map) #ifdef __GLASGOW_HASKELL__@@ -116,12 +116,10 @@ consConstr = mkConstr queueDataType ":<" [] Infix #endif -#if MIN_VERSION_base(4,9,0) instance Ord k => Semigroup (MinPQueue k a) where (<>) = union stimes = stimesMonoid {-# INLINABLE stimes #-}-#endif instance Ord k => Monoid (MinPQueue k a) where mempty = empty@@ -312,9 +310,10 @@ mapWithKey :: (k -> a -> b) -> MinPQueue k a -> MinPQueue k b mapWithKey f = runIdentity . traverseWithKeyU (coerce f) --- | \(O(n)\). @'mapKeysMonotonic' f q == 'mapKeys' f q@, but only works when--- @f@ is (weakly) monotonic. /The precondition is not checked./ This function--- has better performance than 'mapKeys'.+-- | \(O(n)\). @'mapKeysMonotonic' f q == 'Data.PQueue.Prio.Min.mapKeys' f q@,+-- but only works when @f@ is (weakly) monotonic (meaning that @x <= y@ implies+-- @f x <= f y@). /The precondition is not checked./ This function has better+-- performance than 'Data.PQueue.Prio.Min.mapKeys'. -- -- Note: if the given function returns bottom for any of the keys in the queue, then the -- portion of the queue which is bottom is /unspecified/.
src/Data/PQueue/Prio/Max/Internals.hs view
@@ -3,6 +3,8 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# OPTIONS_GHC -Wno-deprecations #-}+ ----------------------------------------------------------------------------- -- | -- Module : Data.PQueue.Prio.Max@@ -105,15 +107,14 @@ ) where +import Data.Coerce import Data.Maybe (fromMaybe) import Data.PQueue.Internals.Down import Data.PQueue.Prio.Internals (MinPQueue) import qualified Data.PQueue.Prio.Internals as PrioInternals import Control.DeepSeq (NFData(rnf)) -#if MIN_VERSION_base(4,9,0) import Data.Semigroup (Semigroup(..), stimesMonoid)-#endif import Prelude hiding (map, filter, break, span, takeWhile, dropWhile, splitAt, take, drop, (!!), null) import qualified Data.Foldable as F@@ -147,15 +148,10 @@ instance (NFData k, NFData a) => NFData (MaxPQueue k a) where rnf (MaxPQ q) = rnf q -first' :: (a -> b) -> (a, c) -> (b, c)-first' f (a, c) = (f a, c)--#if MIN_VERSION_base(4,9,0) instance Ord k => Semigroup (MaxPQueue k a) where (<>) = union stimes = stimesMonoid {-# INLINABLE stimes #-}-#endif instance Ord k => Monoid (MaxPQueue k a) where mempty = empty@@ -215,12 +211,12 @@ -- | \(O(1)\). Constructs a singleton priority queue. singleton :: k -> a -> MaxPQueue k a-singleton k a = MaxPQ (Q.singleton (Down k) a)+singleton = coerce Q.singleton -- | Amortized \(O(1)\), worst-case \(O(\log n)\). Inserts -- an element with the specified key into the queue. insert :: Ord k => k -> a -> MaxPQueue k a -> MaxPQueue k a-insert k a (MaxPQ q) = MaxPQ (Q.insert (Down k) a q)+insert = coerce Q.insert -- | \(O(n)\) (an earlier implementation had \(O(1)\) but was buggy). -- Insert an element with the specified key into the priority queue,@@ -228,16 +224,16 @@ -- inserted one. {-# DEPRECATED insertBehind "This function is not reliable." #-} insertBehind :: Ord k => k -> a -> MaxPQueue k a -> MaxPQueue k a-insertBehind k a (MaxPQ q) = MaxPQ (Q.insertBehind (Down k) a q)+insertBehind = coerce Q.insertBehind -- | Amortized \(O(\log \min(n_1,n_2))\), worst-case \(O(\log \max(n_1,n_2))\). Returns the union -- of the two specified queues. union :: Ord k => MaxPQueue k a -> MaxPQueue k a -> MaxPQueue k a-MaxPQ q1 `union` MaxPQ q2 = MaxPQ (q1 `Q.union` q2)+union = coerce Q.union -- | The union of a list of queues: (@'unions' == 'List.foldl' 'union' 'empty'@). unions :: Ord k => [MaxPQueue k a] -> MaxPQueue k a-unions qs = MaxPQ (Q.unions [q | MaxPQ q <- qs])+unions = coerce Q.unions -- | \(O(1)\). Checks if this priority queue is empty. null :: MaxPQueue k a -> Bool@@ -253,13 +249,11 @@ -- | \(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)+getMax = coerce Q.getMin -- | \(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-deleteMax (MaxPQ q) = MaxPQ (Q.deleteMin q)+deleteMax = coerce Q.deleteMin -- | \(O(\log n)\). Delete and find the element with the maximum key. Calls 'error' if empty. deleteFindMax :: Ord k => MaxPQueue k a -> ((k, a), MaxPQueue k a)@@ -278,14 +272,14 @@ -- | \(O(1)\). Alter the value at the maximum key. If the queue is empty, does nothing. adjustMaxWithKey :: (k -> a -> a) -> MaxPQueue k a -> MaxPQueue k a-adjustMaxWithKey f (MaxPQ q) = MaxPQ (Q.adjustMinWithKey (f . unDown) q)+adjustMaxWithKey = coerce Q.adjustMinWithKey -- | \(O(1)\) per operation. Alter the value at the maximum key in an -- 'Applicative' context. If the queue is empty, does nothing. -- -- @since 1.4.2 adjustMaxWithKeyA :: Applicative f => (k -> a -> f a) -> MaxPQueue k a -> f (MaxPQueue k a)-adjustMaxWithKeyA f (MaxPQ q) = PrioInternals.adjustMinWithKeyA' MaxPQ (f . unDown) q+adjustMaxWithKeyA f (MaxPQ q) = PrioInternals.adjustMinWithKeyA' MaxPQ (coerce f) 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.@@ -303,7 +297,7 @@ -- | \(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. updateMaxWithKey :: Ord k => (k -> a -> Maybe a) -> MaxPQueue k a -> MaxPQueue k a-updateMaxWithKey f (MaxPQ q) = MaxPQ (Q.updateMinWithKey (f . unDown) q)+updateMaxWithKey = coerce Q.updateMinWithKey -- | \(O(\log n)\) per operation. (Actually \(O(1)\) if there's no deletion.) Update -- the value at the maximum key in an 'Applicative' context. If the queue is@@ -311,7 +305,7 @@ -- -- @since 1.4.2 updateMaxWithKeyA :: (Applicative f, Ord k) => (k -> a -> f (Maybe a)) -> MaxPQueue k a -> f (MaxPQueue k a)-updateMaxWithKeyA f (MaxPQ q) = PrioInternals.updateMinWithKeyA' MaxPQ (f . unDown) q+updateMaxWithKeyA f (MaxPQ q) = PrioInternals.updateMinWithKeyA' MaxPQ (coerce f) q -- | \(O(\log n)\). Retrieves the value associated with the maximum key of the queue, and the queue -- stripped of that element, or 'Nothing' if passed an empty queue.@@ -323,9 +317,7 @@ -- | \(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')+maxViewWithKey = coerce Q.minViewWithKey -- | \(O(n)\). Map a function over all values in the queue. map :: (a -> b) -> MaxPQueue k a -> MaxPQueue k b@@ -333,31 +325,34 @@ -- | \(O(n)\). Map a function over all values in the queue. mapWithKey :: (k -> a -> b) -> MaxPQueue k a -> MaxPQueue k b-mapWithKey f (MaxPQ q) = MaxPQ (Q.mapWithKey (f . unDown) q)+mapWithKey = coerce Q.mapWithKey -- | \(O(n)\). Map a function over all values in the queue. mapKeys :: Ord k' => (k -> k') -> MaxPQueue k a -> MaxPQueue k' a-mapKeys f (MaxPQ q) = MaxPQ (Q.mapKeys (fmap f) q)+mapKeys = coerce Q.mapKeys --- | \(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--- 'mapKeys'.+-- | \(O(n)\). @'mapKeysMonotonic' f q == 'mapKeys' f q@, but only works when+-- @f@ is (weakly) monotonic (meaning that @x <= y@ implies @f x <= f y@).+-- /The precondition is not checked./ This function has better performance than 'mapKeys'.+--+-- Note: if the given function returns bottom for any of the keys in the queue, then the+-- portion of the queue which is bottom is /unspecified/. mapKeysMonotonic :: (k -> k') -> MaxPQueue k a -> MaxPQueue k' a-mapKeysMonotonic f (MaxPQ q) = MaxPQ (Q.mapKeysMonotonic (fmap f) q)+mapKeysMonotonic = coerce Q.mapKeysMonotonic -- | \(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+foldrWithKey f z (MaxPQ q) = Q.foldrWithKey (coerce f) 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 ('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 z0 (MaxPQ q) = Q.foldlWithKey (\z -> f z . unDown) z0 q+foldlWithKey f z0 (MaxPQ q) = Q.foldlWithKey (coerce f) 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)@)@@ -366,38 +361,26 @@ -- -- If you are working in a strict monad, consider using 'mapMWithKey'. 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+traverseWithKey f (MaxPQ q) = MaxPQ <$> Q.traverseWithKey (coerce f) q -- | A strictly accumulating version of 'traverseWithKey'. This works well in -- 'IO' and strict @State@, and is likely what you want for other "strict" monads, -- where @⊥ >>= pure () = ⊥@. mapMWithKey :: (Ord k, Monad m) => (k -> a -> m b) -> MaxPQueue k a -> m (MaxPQueue k b)-mapMWithKey f = go empty- where- go !acc q =- case maxViewWithKey q of- Nothing -> pure acc- Just ((k, a), q') -> do- b <- f k a- let !acc' = insertMin' k b acc- go acc' q'--insertMin' :: k -> a -> MaxPQueue k a -> MaxPQueue k a-insertMin' k a (MaxPQ q) = MaxPQ (PrioInternals.insertMax' (Down k) a q)+mapMWithKey f (MaxPQ q) = MaxPQ <$> Q.mapMWithKey (coerce f) q --- | \(O(k \log n)\)/. Takes the first @k@ (key, value) pairs in the queue, or the first @n@ if @k >= n@.+-- | \(O(k \log n)\). Takes the first @k@ (key, value) pairs in the queue, or the first @n@ if @k >= n@. -- (@'take' k q == 'List.take' k ('toDescList' q)@) take :: Ord k => Int -> MaxPQueue k a -> [(k, a)]-take k (MaxPQ q) = fmap (first' unDown) (Q.take k q)+take = coerce Q.take --- | \(O(k \log n)\)/. Deletes the first @k@ (key, value) pairs in the queue, or returns an empty queue if @k >= n@.+-- | \(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 -> MaxPQueue k a -> MaxPQueue k a-drop k (MaxPQ q) = MaxPQ (Q.drop k q)+drop = coerce Q.drop --- | \(O(k \log n)\)/. Equivalent to @('take' k q, 'drop' k q)@.+-- | \(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')+splitAt = coerce Q.splitAt -- | Takes the longest possible prefix of elements satisfying the predicate. -- (@'takeWhile' p q == 'List.takeWhile' (p . 'snd') ('toDescList' q)@)@@ -407,7 +390,7 @@ -- | Takes the longest possible prefix of elements satisfying the predicate. -- (@'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)+takeWhileWithKey = coerce Q.takeWhileWithKey -- | Removes the longest possible prefix of elements satisfying the predicate. dropWhile :: Ord k => (a -> Bool) -> MaxPQueue k a -> MaxPQueue k a@@ -415,7 +398,7 @@ -- | Removes the longest possible prefix of elements satisfying the predicate. dropWhileWithKey :: Ord k => (k -> a -> Bool) -> MaxPQueue k a -> MaxPQueue k a-dropWhileWithKey p (MaxPQ q) = MaxPQ (Q.dropWhileWithKey (p . unDown) q)+dropWhileWithKey = coerce Q.dropWhileWithKey -- | Equivalent to @('takeWhile' p q, 'dropWhile' p q)@. span :: Ord k => (a -> Bool) -> MaxPQueue k a -> ([(k, a)], MaxPQueue k a)@@ -427,13 +410,11 @@ -- | 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')+spanWithKey = coerce Q.spanWithKey -- | 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')+breakWithKey = coerce Q.breakWithKey -- | \(O(n)\). Filter all values that satisfy the predicate. filter :: Ord k => (a -> Bool) -> MaxPQueue k a -> MaxPQueue k a@@ -441,7 +422,7 @@ -- | \(O(n)\). Filter all values that satisfy the predicate. filterWithKey :: Ord k => (k -> a -> Bool) -> MaxPQueue k a -> MaxPQueue k a-filterWithKey p (MaxPQ q) = MaxPQ (Q.filterWithKey (p . unDown) q)+filterWithKey = coerce Q.filterWithKey -- | \(O(n)\). Partition the queue according to a predicate. The first queue contains all elements -- which satisfy the predicate, the second all elements that fail the predicate.@@ -451,8 +432,7 @@ -- | \(O(n)\). Partition the queue according to a predicate. The first queue contains all elements -- 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)+partitionWithKey = coerce Q.partitionWithKey -- | \(O(n)\). Map values and collect the 'Just' results. mapMaybe :: Ord k => (a -> Maybe b) -> MaxPQueue k a -> MaxPQueue k b@@ -460,7 +440,7 @@ -- | \(O(n)\). Map values and collect the 'Just' results. mapMaybeWithKey :: Ord k => (k -> a -> Maybe b) -> MaxPQueue k a -> MaxPQueue k b-mapMaybeWithKey f (MaxPQ q) = MaxPQ (Q.mapMaybeWithKey (f . unDown) q)+mapMaybeWithKey = coerce Q.mapMaybeWithKey -- | \(O(n)\). Map values and separate the 'Left' and 'Right' results. mapEither :: Ord k => (a -> Either b c) -> MaxPQueue k a -> (MaxPQueue k b, MaxPQueue k c)@@ -468,20 +448,19 @@ -- | \(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)+mapEitherWithKey = coerce Q.mapEitherWithKey -- | \(O(n)\). Build a priority queue from the list of (key, value) pairs. fromList :: Ord k => [(k, a)] -> MaxPQueue k a-fromList = MaxPQ . Q.fromList . fmap (first' Down)+fromList = coerce Q.fromList -- | \(O(n)\). Build a priority queue from an ascending list of (key, value) pairs. /The precondition is not checked./ fromAscList :: [(k, a)] -> MaxPQueue k a-fromAscList = MaxPQ . Q.fromDescList . fmap (first' Down)+fromAscList = coerce Q.fromDescList -- | \(O(n)\). Build a priority queue from a descending list of (key, value) pairs. /The precondition is not checked./ fromDescList :: [(k, a)] -> MaxPQueue k a-fromDescList = MaxPQ . Q.fromAscList . fmap (first' Down)+fromDescList = coerce Q.fromAscList -- | \(O(n \log n)\). Return all keys of the queue in descending order. keys :: Ord k => MaxPQueue k a -> [k]@@ -497,11 +476,11 @@ -- | \(O(n \log n)\). Return all (key, value) pairs in ascending order by key. toAscList :: Ord k => MaxPQueue k a -> [(k, a)]-toAscList (MaxPQ q) = fmap (first' unDown) (Q.toDescList q)+toAscList = coerce Q.toDescList -- | \(O(n \log n)\). Return all (key, value) pairs in descending order by key. toDescList :: Ord k => MaxPQueue k a -> [(k, a)]-toDescList (MaxPQ q) = fmap (first' unDown) (Q.toAscList q)+toDescList = coerce Q.toAscList -- | \(O(n \log n)\). Equivalent to 'toDescList'. --@@ -515,13 +494,13 @@ -- | \(O(n)\). An unordered right fold over the elements of the queue, in no particular order. foldrWithKeyU :: (k -> a -> b -> b) -> b -> MaxPQueue k a -> b-foldrWithKeyU f z (MaxPQ q) = Q.foldrWithKeyU (f . unDown) z q+foldrWithKeyU f z (MaxPQ q) = Q.foldrWithKeyU (coerce f) z q -- | \(O(n)\). An unordered monoidal fold over the elements of the queue, in no particular order. -- -- @since 1.4.2 foldMapWithKeyU :: Monoid m => (k -> a -> m) -> MaxPQueue k a -> m-foldMapWithKeyU f (MaxPQ q) = Q.foldMapWithKeyU (f . unDown) q+foldMapWithKeyU f (MaxPQ q) = Q.foldMapWithKeyU (coerce f) q -- | \(O(n)\). An unordered left fold over the elements of the queue, in no -- particular order. This is rarely what you want; 'foldrU' and 'foldlU'' are@@ -540,13 +519,13 @@ -- particular order. This is rarely what you want; 'foldrWithKeyU' and -- 'foldlWithKeyU'' are more likely to perform well. foldlWithKeyU :: (b -> k -> a -> b) -> b -> MaxPQueue k a -> b-foldlWithKeyU f z0 (MaxPQ q) = Q.foldlWithKeyU (\z -> f z . unDown) z0 q+foldlWithKeyU f z0 (MaxPQ q) = Q.foldlWithKeyU (coerce f) z0 q -- | \(O(n)\). An unordered left fold over the elements of the queue, in no particular order. -- -- @since 1.4.2 foldlWithKeyU' :: (b -> k -> a -> b) -> b -> MaxPQueue k a -> b-foldlWithKeyU' f z0 (MaxPQ q) = Q.foldlWithKeyU' (\z -> f z . unDown) z0 q+foldlWithKeyU' f z0 (MaxPQ q) = Q.foldlWithKeyU' (coerce f) 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@@ -558,7 +537,7 @@ -- While there is no guarantee in which order the elements are traversed, the resulting -- priority queue will be perfectly valid. traverseWithKeyU :: (Applicative f) => (k -> a -> f b) -> MaxPQueue k a -> f (MaxPQueue k b)-traverseWithKeyU f (MaxPQ q) = MaxPQ <$> Q.traverseWithKeyU (f . unDown) q+traverseWithKeyU f (MaxPQ q) = MaxPQ <$> Q.traverseWithKeyU (coerce f) q -- | \(O(n)\). Return all keys of the queue in no particular order. keysU :: MaxPQueue k a -> [k]@@ -574,7 +553,7 @@ -- | \(O(n)\). Returns all (key, value) pairs in the queue in no particular order. toListU :: MaxPQueue k a -> [(k, a)]-toListU (MaxPQ q) = fmap (first' unDown) (Q.toListU q)+toListU = coerce Q.toListU -- | \(O(\log n)\). @seqSpine q r@ forces the spine of @q@ and returns @r@. --
src/Data/PQueue/Prio/Min.hs view
@@ -132,10 +132,6 @@ import qualified Data.List as List import Data.Maybe (fromMaybe) -#if MIN_VERSION_base(4,9,0)-import Data.Semigroup (Semigroup((<>)))-#endif- import Data.PQueue.Prio.Internals hiding (MinPQueue (..)) import Data.PQueue.Prio.Internals (MinPQueue) import qualified Data.PQueue.Prio.Internals as Internals@@ -172,7 +168,9 @@ {-# INLINE (:<) #-} # endif +# if __GLASGOW_HASKELL__ >= 820 {-# COMPLETE Empty, (:<) #-}+# endif #endif (.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d@@ -275,12 +273,12 @@ partitionWithKey p = mapEitherWithKey (\k a -> if p k a then Left a else Right a) {-# INLINE take #-}--- | \(O(k \log n)\)/. Takes the first @k@ (key, value) pairs in the queue, or the first @n@ if @k >= n@.+-- | \(O(k \log n)\). Takes the first @k@ (key, value) pairs in the queue, or the first @n@ if @k >= n@. -- (@'take' k q == 'List.take' k ('toAscList' q)@) take :: Ord k => Int -> MinPQueue k a -> [(k, a)] take n = List.take n . toAscList --- | \(O(k \log n)\)/. Deletes the first @k@ (key, value) pairs in the queue, or returns an empty queue if @k >= n@.+-- | \(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 n0 q0 | n0 <= 0 = q0@@ -291,7 +289,7 @@ | n == 0 = q | otherwise = drop' (n - 1) (deleteMin q) --- | \(O(k \log n)\)/. Equivalent to @('take' k q, 'drop' k 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)
src/Nattish.hs view
@@ -18,10 +18,10 @@ ( Nattish (Zeroy, Succy) ) where+#if __GLASGOW_HASKELL__ >= 904 import Unsafe.Coerce (unsafeCoerce)-#if __GLASGOW_HASKELL__ >= 800-import Data.Kind (Type) #endif+import Data.Kind (Type) -- | Conceptually, --@@ -38,7 +38,7 @@ -- it is very fast to work with. #if __GLASGOW_HASKELL__ < 904-data Nattish :: k -> (k -> k) -> k -> * where+data Nattish :: k -> (k -> k) -> k -> Type where Zeroy :: Nattish zero succ zero Succy :: !(Nattish zero succ n) -> Nattish zero succ (succ n)
tests/PQueueTests.hs view
@@ -6,6 +6,8 @@ {-# language TupleSections #-} {-# language ViewPatterns #-} +{-# options_ghc -Wno-x-partial #-}+ module Main (main) where import Data.Bifunctor (bimap, first, second)@@ -74,6 +76,14 @@ validMinQueue zs .&&. (Min.toList ys, Min.toList zs) === bimap List.sort List.sort (Either.partitionEithers . List.map f $ xs) , testProperty "map" $ \xs -> Min.map negate (Min.fromList xs) === Min.fromList (List.map negate xs)+ , testProperty "mapMonotonic" $ \xs ->+ let+ -- Monotonic, but not strictly so+ fun x+ | even x = x+ | otherwise = x + 1+ res = Min.mapMonotonic fun (Min.fromList xs)+ in validMinQueue res .&&. Min.toList res === List.map fun (List.sort xs) , testProperty "take" $ \n xs -> Min.take n (Min.fromList xs) === List.take n (List.sort xs) , testProperty "drop" $ \n xs -> Min.drop n (Min.fromList xs) === Min.fromList (List.drop n (List.sort xs)) , testProperty "splitAt" $ \n xs -> Min.splitAt n (Min.fromList xs) === second Min.fromList (List.splitAt n (List.sort xs))@@ -88,14 +98,6 @@ , testProperty "toDescList" $ \xs -> Min.toDescList (Min.fromList xs) === List.sortOn Down xs , testProperty "fromAscList" $ \xs -> Min.fromAscList (List.sort xs) === Min.fromList xs , testProperty "fromDescList" $ \xs -> Min.fromDescList (List.sortOn Down xs) === Min.fromList xs- , testProperty "mapU" $ \xs ->- let- -- Monotonic, but not strictly so- fun x- | even x = x- | otherwise = x + 1- res = Min.mapU fun (Min.fromList xs)- in validMinQueue res .&&. Min.toList res === List.map fun (List.sort xs) , testProperty "foldrU" $ \xs -> Min.foldrU (+) 0 (Min.fromList xs) === sum xs , testProperty "foldlU" $ \xs -> Min.foldlU (+) 0 (Min.fromList xs) === sum xs , testProperty "foldlU'" $ \xs -> Min.foldlU' (+) 0 (Min.fromList xs) === sum xs@@ -115,6 +117,7 @@ , testProperty "filter" $ \xs -> Max.filter even (Max.fromList xs) === Max.fromList (List.filter even xs) , testProperty "partition" $ \xs -> Max.partition even (Max.fromList xs) === bimap Max.fromList Max.fromList (List.partition even xs) , testProperty "map" $ \xs -> Max.map negate (Max.fromList xs) === Max.fromList (List.map negate xs)+ , testProperty "mapMonotonic" $ \xs -> Max.mapMonotonic (+ 1) (Max.fromList xs) === Max.fromList (List.map (+ 1) xs) , testProperty "take" $ \n xs -> Max.take n (Max.fromList xs) === List.take n (List.sortOn Down xs) , testProperty "drop" $ \n xs -> Max.drop n (Max.fromList xs) === Max.fromList (List.drop n (List.sortOn Down xs)) , testProperty "splitAt" $ \n xs -> Max.splitAt n (Max.fromList xs) === second Max.fromList (List.splitAt n (List.sortOn Down xs))@@ -129,7 +132,6 @@ , testProperty "toDescList" $ \xs -> Max.toDescList (Max.fromList xs) === List.sortOn Down xs , testProperty "fromAscList" $ \xs -> Max.fromAscList (List.sort xs) === Max.fromList xs , testProperty "fromDescList" $ \xs -> Max.fromDescList (List.sortOn Down xs) === Max.fromList xs- , testProperty "mapU" $ \xs -> Max.mapU (+ 1) (Max.fromList xs) === Max.fromList (List.map (+ 1) xs) , testProperty "foldrU" $ \xs -> Max.foldrU (+) 0 (Max.fromList xs) === sum xs , testProperty "foldlU" $ \xs -> Max.foldlU (+) 0 (Max.fromList xs) === sum xs , testProperty "foldlU'" $ \xs -> Max.foldlU' (+) 0 (Max.fromList xs) === sum xs