packages feed

min-max-pqueue (empty) → 0.1.0.0

raw patch · 12 files changed

+1467/−0 lines, 12 filesdep +basedep +containersdep +criterionsetup-changed

Dependencies added: base, containers, criterion, hedgehog, integer-logarithms, min-max-pqueue, random

Files

+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Changelog for min-max-pqueue++## 0.1.0.0++- Initial release
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Ziyang Liu (c) 2019++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of the author nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,149 @@+# min-max-pqueue++A min-max priority queue provides efficient access to both its least element+and its greatest element. Also known as+[double-ended priority queue](https://en.wikipedia.org/wiki/Double-ended_priority_queue).++This library provides two variants of min-max priority queues:++- [`MinMaxQueue prio a`](https://hackage.haskell.org/package/min-max-pqueue/docs/Data-MinMaxQueue.html), a general-purpose min-max priority queue.+- [`IntMinMaxQueue a`](https://hackage.haskell.org/package/min-max-pqueue/docs/Data-IntMinMaxQueue.html), a min-max priority queue where priority values are integers.++A min-max priority queue can be configured with a maximum size. Each time an insertion+causes the queue to grow beyond the size limit, the greatest element+will be automatically removed (rather than rejecting the insertion).++Their implementations are backed by `Map prio (NonEmpty a)` and+`IntMap (NonEmpty a)`, respectively. This means+that certain operations are asymptotically more expensive than+implementations [backed by mutable arrays](https://dl.acm.org/citation.cfm?id=6621),+e.g., `peekMin` and `peekMax` is *O(n* log *n)* vs. *O(n)*, `fromList` is+also *O(n* log *n)* vs. *O(n)*. In a pure language like Haskell, a+mutable array based implementation would be impure+and need to operate inside monads. And in many applications, regardless+of language, the additional time complexity would be a small or negligible+price to pay to avoid destructive updates anyway.++If you only access one end of the queue (i.e., you need a regular+priority queue), an implementation based on a kind of heap that is more+amenable to purely functional implementations, such as binomial heap+and pairing heap, is *potentially* more efficient. But always benchmark+if performance is important; in my experience `Map` *always* wins, even for+regular priority queues.++## Advantages over Using Maps Directly++- `size` is *O(1)*, vs. *O(n)* for maps. Note that `Data.Map.size` is *O(1)* but it+  returns the number of keys, which is not the same as the number of elements in+  the queue. `Data.IntMap.size`, on the other hand, is *O(k)* where *k* is+  the number of keys.+- A queue can have a size limit, and it is guaranteed that its size+  does not grow beyond the limit.+- Many useful operations, such as `takeMin`, `dropMin`, are non-trivial to+  implement with `Map prio (NonEmpty a)` and `IntMap (NonEmpty a)`.+- The queue's fold operations operate on individual elements, as opposed to+  `NonEmpty a`.+++## Alternative Implementation++In Haskell, an alternative to the mutable array based implementation is+to use immutable, general purpose arrays such as `Seq`. This would achieve+*O(1)* `peekMin` and `peekMax`, but since `lookup` and `update` for `Seq`+cost *O(n* log  *n)*, the cost of `insert`, `deleteMin` and `deleteMax` would+become *O(n* log<sup>2</sup> *n)*.++[A `Seq`-based implementation](https://github.com/zliu41/min-max-pqueue/blob/master/benchmark/SeqQueue.hs) is provided for benchmarking purposes, which,+as shown below, is more than an order of magnitude slower than the `Map`-based implementation+for enqueuing and dequeuing 200,000 elements, proving that the improved+time complexity of `peekMin` and `peekMax` is not worth the cost. In fact,+if you perform `peekMin` and `peekMax` much more often than enqueuing and+dequeuing operations, which means you perform `peekMin` and `peekMax` many times+on the same queue, you should simply memoize the results.++## Benchmarks++Benchmarking was done on my laptop in which 200,000 elements (which are+integers) are inserted into the queue and subsequently removed one after+another.++- `pq`, `intpq` and `sq` represents `MinMaxQueue`, `IntMinMaxQueue` and+  `SeqQueue`.+- `asc`, `desc` and `rand` represents inserting the elements in ascending,+  descending and random order.+- `min` and `max` represents removing elements from the min-end and max-end.++As seen in the following result, `IntMinMaxQueue` is twice as fast as+`MinMaxQueue` for integer keys, whereas `SeqQueue` is more than an order+of magnitude slower.++```+benchmarking intpq-asc-min          +time                 27.15 ms   (23.85 ms .. 29.31 ms)+                     0.972 R²   (0.927 R² .. 0.997 R²)+mean                 30.84 ms   (29.67 ms .. 35.07 ms)+std dev              4.308 ms   (1.160 ms .. 7.915 ms)+variance introduced by outliers: 57% (severely inflated)++benchmarking intpq-desc-max         +time                 29.70 ms   (29.23 ms .. 30.41 ms)+                     0.998 R²   (0.995 R² .. 1.000 R²)+mean                 30.62 ms   (30.29 ms .. 31.02 ms)+std dev              803.7 μs   (548.0 μs .. 1.190 ms)++benchmarking intpq-rand-min         +time                 31.00 ms   (29.10 ms .. 33.05 ms)+                     0.985 R²   (0.973 R² .. 0.994 R²)+mean                 28.39 ms   (27.43 ms .. 29.46 ms)+std dev              2.216 ms   (1.968 ms .. 2.591 ms)+variance introduced by outliers: 32% (moderately inflated)++benchmarking intpq-rand-max         +time                 30.96 ms   (28.98 ms .. 32.96 ms)+                     0.987 R²   (0.976 R² .. 0.996 R²)+mean                 33.66 ms   (32.71 ms .. 34.49 ms)+std dev              1.820 ms   (1.473 ms .. 2.388 ms)+variance introduced by outliers: 18% (moderately inflated)++benchmarking pq-asc-min             +time                 69.02 ms   (61.94 ms .. 72.95 ms)+                     0.988 R²   (0.968 R² .. 0.997 R²)+mean                 71.41 ms   (68.99 ms .. 74.35 ms)+std dev              4.799 ms   (3.401 ms .. 6.974 ms)+variance introduced by outliers: 17% (moderately inflated)++benchmarking pq-desc-max            +time                 80.90 ms   (78.68 ms .. 85.06 ms)+                     0.997 R²   (0.994 R² .. 0.999 R²)+mean                 83.20 ms   (80.91 ms .. 89.15 ms)+std dev              5.853 ms   (2.234 ms .. 9.957 ms)+variance introduced by outliers: 19% (moderately inflated)++benchmarking pq-rand-min            +time                 65.80 ms   (60.01 ms .. 69.62 ms)+                     0.987 R²   (0.965 R² .. 0.996 R²)+mean                 74.17 ms   (70.93 ms .. 79.86 ms)+std dev              7.495 ms   (4.557 ms .. 12.39 ms)+variance introduced by outliers: 35% (moderately inflated)++benchmarking pq-rand-max            +time                 68.29 ms   (65.07 ms .. 70.84 ms)+                     0.997 R²   (0.995 R² .. 1.000 R²)+mean                 74.03 ms   (71.64 ms .. 77.51 ms)+std dev              5.016 ms   (3.110 ms .. 7.556 ms)+variance introduced by outliers: 17% (moderately inflated)++benchmarking sq-asc-min             +time                 1.954 s    (1.369 s .. 2.838 s)+                     0.971 R²   (NaN R² .. 1.000 R²)+mean                 1.733 s    (1.592 s .. 1.861 s)+std dev              160.1 ms   (28.78 ms .. 203.2 ms)+variance introduced by outliers: 22% (moderately inflated)++benchmarking sq-rand-min            +time                 2.889 s    (2.000 s .. 3.658 s)+                     0.989 R²   (0.959 R² .. 1.000 R²)+mean                 2.915 s    (2.828 s .. 3.054 s)+std dev              130.7 ms   (442.1 μs .. 159.9 ms)+variance introduced by outliers: 19% (moderately inflated)+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ benchmark/Main.hs view
@@ -0,0 +1,53 @@+module Main where++import qualified Criterion.Main as Criterion+import           Data.List (sort, sortBy, unfoldr)+import           System.Random++import qualified Data.IntMinMaxQueue as IPQ+import qualified Data.MinMaxQueue as PQ+import qualified SeqQueue as SQ++bench :: [Criterion.Benchmark]+bench =+  [ Criterion.bench "intpq-asc-min" $+      Criterion.nf (unfoldr IPQ.pollMin) (IPQ.fromListWith id ascElems)+  , Criterion.bench "intpq-desc-max" $+      Criterion.nf (unfoldr IPQ.pollMax) (IPQ.fromListWith id descElems)+  , Criterion.bench "intpq-rand-min" $+      Criterion.nf (unfoldr IPQ.pollMin) (IPQ.fromListWith id randomElems)+  , Criterion.bench "intpq-rand-max" $+      Criterion.nf (unfoldr IPQ.pollMax) (IPQ.fromListWith id randomElems)++  , Criterion.bench "pq-asc-min" $+      Criterion.nf (unfoldr PQ.pollMin) (PQ.fromListWith id ascElems)+  , Criterion.bench "pq-desc-max" $+      Criterion.nf (unfoldr PQ.pollMax) (PQ.fromListWith id descElems)+  , Criterion.bench "pq-rand-min" $+      Criterion.nf (unfoldr PQ.pollMin) (PQ.fromListWith id randomElems)+  , Criterion.bench "pq-rand-max" $+      Criterion.nf (unfoldr PQ.pollMax) (PQ.fromListWith id randomElems)++  , Criterion.bench "sq-asc-min" $+      Criterion.nf (unfoldr SQ.pollMin) (SQ.fromList ascElems)+  , Criterion.bench "sq-rand-min" $+      Criterion.nf (unfoldr SQ.pollMin) (SQ.fromList randomElems)+  ]++main :: IO ()+main = Criterion.defaultMain bench++numElems :: Int+numElems = 200000++gen :: StdGen+gen = mkStdGen 42++randomElems :: [Int]+randomElems = take numElems (randoms gen)++ascElems :: [Int]+ascElems = sort randomElems++descElems :: [Int]+descElems = sortBy (flip compare) randomElems
+ benchmark/SeqQueue.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE TupleSections #-}++-----------------------------------------------------------------------------+-- | A min-max priority queue implemented using a min-max heap+-- backed by a 'Seq', for benchmarking purposes.+module SeqQueue (fromList, pollMin) where++import qualified Data.Foldable as Foldable+import           Data.Maybe (catMaybes, fromJust)+import qualified Data.Sequence as Seq+import           Data.Sequence (Seq, (|>), ViewL((:<)), ViewR((:>)))+import           Math.NumberTheory.Logarithms (intLog2)++import           Prelude hiding (init)++type SeqQueue a = Seq a+type Index = Int++empty :: SeqQueue a+empty = Seq.empty++fromList :: Ord a => [a] -> SeqQueue a+fromList = Foldable.foldr insert empty++size :: SeqQueue a -> Int+size = Seq.length++insert :: Ord a => a -> SeqQueue a -> SeqQueue a+insert a q = bubbleUp (size q') a q'+  where q' = q |> a++peekMin :: SeqQueue a -> Maybe a+peekMin q+  | hd :< _ <- Seq.viewl q = Just hd+  | otherwise = Nothing++deleteMin :: Ord a => SeqQueue a -> SeqQueue a+deleteMin q+  | init :> an <- Seq.viewr q =+      trickleDown 1 an (update 1 an init)+  | otherwise = empty++pollMin :: Ord a => SeqQueue a -> Maybe (a, SeqQueue a)+pollMin q = (,) <$> peekMin q <*> pure (deleteMin q)++(!) :: Seq a -> Index -> a+(!) xs i = fromJust $ Seq.lookup (i-1) xs++(!?) :: Seq a -> Index -> Maybe a+(!?) xs i = Seq.lookup (i-1) xs++bubbleUp :: Ord a => Index -> a -> SeqQueue a -> SeqQueue a+bubbleUp idx a q+    | idx == 1 = q+    | isMinLevel idx =+        if a > parent+          then bubbleUpMax parentIdx a (swap parentIdx parent idx a q)+          else bubbleUpMin idx a q+    | otherwise =+        if a < parent+          then bubbleUpMin parentIdx a (swap parentIdx parent idx a q)+          else bubbleUpMax idx a q+  where+    parentIdx = idx `div` 2+    parent = q ! parentIdx++bubbleUpMin :: Ord a => Index -> a -> SeqQueue a -> SeqQueue a+bubbleUpMin idx a q+    | idx < 4 = q+    | a < grandParent = bubbleUpMin grandParentIdx a (swap grandParentIdx grandParent idx a q)+    | otherwise = q+  where+    grandParentIdx = idx `div` 4+    grandParent = q ! grandParentIdx++bubbleUpMax :: Ord a => Index -> a -> SeqQueue a -> SeqQueue a+bubbleUpMax idx a q+    | idx < 4 = q+    | a > grandParent = bubbleUpMax grandParentIdx a (swap grandParentIdx grandParent idx a q)+    | otherwise = q+  where+    grandParentIdx = idx `div` 4+    grandParent = q ! grandParentIdx++isMinLevel :: Int -> Bool+isMinLevel = even . intLog2++swap :: Index -> a -> Index -> a -> SeqQueue a -> SeqQueue a+swap idx1 a1 idx2 a2 = update idx1 a2 . update idx2 a1++trickleDown :: Ord a => Index -> a -> SeqQueue a -> SeqQueue a+trickleDown idx a q+  | fmly@(_:_) <- family idx q =+      let (a',idx') = Foldable.minimum fmly+       in if a' >= a+            then q+            else if idx' > 2 * idx + 1+                   then let q' = swap idx' a' idx a q+                            parentIdx = idx' `div` 2+                            parent = fst . fromJust $ Foldable.find ((== parentIdx) . snd) fmly+                         in if a > parent then trickleDown idx' parent (swap parentIdx parent idx' a q') else trickleDown idx' a q'+                   else swap idx' a' idx a q+  | otherwise = q++family :: Index -> SeqQueue a -> [(a, Index)]+family idx q = catMaybes+    [ (,l) <$> (q !? l)+    , (,r) <$> (q !? r)+    , (,ll) <$> (q !? ll)+    , (,lr) <$> (q !? lr)+    , (,rl) <$> (q !? rl)+    , (,rr) <$> (q !? rr)+    ]+  where+    l = idx * 2+    r = l + 1+    ll = idx * 4+    lr = ll + 1+    rl = ll + 2+    rr = ll + 3++update :: Int -> a -> SeqQueue a -> SeqQueue a+update x = Seq.update (x-1)
+ min-max-pqueue.cabal view
@@ -0,0 +1,74 @@+-- This file has been generated from package.yaml by hpack version 0.28.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: b4c26d035b2f2c698fa2c783190f06ef770dca9eb7fe551a97330979179847a1++name:           min-max-pqueue+version:        0.1.0.0+synopsis:       Double-ended priority queues.+description:    Min-max priority queues, also known as double-ended priority queues.+category:       Data Structures+homepage:       https://github.com/zliu41/min-max-pqueue#readme+bug-reports:    https://github.com/zliu41/min-max-pqueue/issues+author:         Ziyang Liu <free@cofree.io>+maintainer:     Ziyang Liu <free@cofree.io>+copyright:      2019 Ziyang Liu+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10+extra-source-files:+    ChangeLog.md+    README.md++source-repository head+  type: git+  location: https://github.com/zliu41/min-max-pqueue++library+  exposed-modules:+      Data.IntMinMaxQueue+      Data.MinMaxQueue+  other-modules:+      Paths_min_max_pqueue+  hs-source-dirs:+      src+  build-depends:+      base >=4.7 && <5+    , containers >=0.5.11 && <0.7+  default-language: Haskell2010++test-suite hedgehog+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      IntMinMaxQueueSpec+      MinMaxQueueSpec+      Paths_min_max_pqueue+  hs-source-dirs:+      test/hedgehog+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , containers >=0.5.11 && <0.7+    , hedgehog >=0.6.1 && <0.7+    , min-max-pqueue+  default-language: Haskell2010++benchmark benchmark+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      SeqQueue+      Paths_min_max_pqueue+  hs-source-dirs:+      benchmark+  build-depends:+      base >=4.7 && <5+    , containers >=0.5.11 && <0.7+    , criterion >=1.4.1 && <1.6+    , integer-logarithms >=1.0.2.2 && <1.1+    , min-max-pqueue+    , random >=1.1 && <1.2+  default-language: Haskell2010
+ src/Data/IntMinMaxQueue.hs view
@@ -0,0 +1,401 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TupleSections #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.IntMinMaxQueue+-- Maintainer  :  Ziyang Liu <free@cofree.io>+--+-- Double-ended priority queues where priority values are integers, allowing+-- efficient retrieval and removel from both ends of the queue.+--+-- A queue can be configured with a maximum size. Each time an insertion+-- causes the queue to grow beyond the size limit, the greatest element+-- will be automatically removed (rather than rejecting the insertion).+--+-- The implementation is backed by an @'IntMap' ('NonEmpty' a)@. This means+-- that certain operations, including 'peekMin', 'peekMax' and 'fromList',+-- are asymptotically more expensive than a mutable array based implementation.+-- In a pure language like Haskell, a+-- mutable array based implementation would be impure+-- and need to operate inside monads. And in many applications, regardless+-- of language, the additional time complexity would be a small or negligible+-- price to pay to avoid destructive updates anyway.+--+-- If you only access one end of the queue (i.e., you need a regular+-- priority queue), an implementation based on a kind of heap that is more+-- amenable to purely functional implementations, such as binomial heap+-- and pairing heap, is /potentially/ more efficient. But always benchmark+-- if performance is important; in my experience @Map@ /always/ wins, even for+-- regular priority queues.+--+-- See <https://github.com/zliu41/min-max-pqueue/blob/master/README.md README.md>+-- for more information.+module Data.IntMinMaxQueue (+  -- * IntMinMaxQueue type+    IntMinMaxQueue+  , Prio++  -- * Construction+  , empty+  , singleton+  , fromList+  , fromListWith+  , fromMap++  -- * Size+  , null+  , notNull+  , size++  -- * Maximum size+  , withMaxSize+  , maxSize++  -- * Queue operations+  , insert+  , peekMin+  , peekMax+  , deleteMin+  , deleteMax+  , pollMin+  , pollMax+  , takeMin+  , takeMax+  , dropMin+  , dropMax++  -- * Traversal+  -- ** Map+  , map+  , mapWithPriority++  -- ** Folds+  , foldr+  , foldl+  , foldrWithPriority+  , foldlWithPriority+  , foldMapWithPriority++  -- ** Strict Folds+  , foldr'+  , foldl'+  , foldrWithPriority'+  , foldlWithPriority'++  -- * Lists+  , elems+  , toList+  , toAscList+  , toDescList++  -- * Maps+  , toMap+  ) where++import           Data.Data (Data)+import qualified Data.Foldable as Foldable+import           Data.Functor.Classes+import           Data.IntMap.Strict (IntMap)+import qualified Data.IntMap.Strict as Map+import           Data.List.NonEmpty (NonEmpty(..), (<|))+import qualified Data.List.NonEmpty as Nel++import Prelude hiding (drop, foldl, foldr, lookup, map, null, take)+import qualified Prelude++type Size = Int+type MaxSize = Maybe Int+type Prio = Int++-- | A double-ended priority queue whose elements are compared+-- on an 'Int' field.+data IntMinMaxQueue a = IntMinMaxQueue {-# UNPACK #-} !Size !MaxSize !(IntMap (NonEmpty a))+  deriving (Eq, Ord, Data)++instance Eq1 IntMinMaxQueue where+  liftEq eqv q1 q2 =+    Map.size (toMap q1) == Map.size (toMap q2)+      && liftEq (liftEq eqv) (toList q1) (toList q2)++instance Ord1 IntMinMaxQueue where+  liftCompare cmpv q1 q2 =+    liftCompare (liftCompare cmpv) (toList q1) (toList q2)++instance Show a => Show (IntMinMaxQueue a) where+  showsPrec d q = showParen (d > 10) $+    showString "fromList " . shows (toList q)++instance Show1 IntMinMaxQueue where+  liftShowsPrec spv slv d m =+      showsUnaryWith (liftShowsPrec sp sl) "fromList" d (toList m)+    where+      sp = liftShowsPrec spv slv+      sl = liftShowList spv slv++instance Read a => Read (IntMinMaxQueue a) where+  readsPrec p = readParen (p > 10) $ \r -> do+    ("fromList",s) <- lex r+    (xs,t) <- reads s+    pure (fromList xs,t)++instance Read1 IntMinMaxQueue where+  liftReadsPrec rp rl = readsData $+      readsUnaryWith (liftReadsPrec rp' rl') "fromList" fromList+    where+      rp' = liftReadsPrec rp rl+      rl' = liftReadList rp rl++instance Functor IntMinMaxQueue where+  fmap = map++instance Foldable.Foldable IntMinMaxQueue where+  foldMap = foldMapWithPriority . const++-- | /O(1)/. The empty queue.+empty :: IntMinMaxQueue a+empty = IntMinMaxQueue 0 Nothing Map.empty++-- | /O(1)/. A queue with a single element.+singleton :: (a -> Prio) -> a -> IntMinMaxQueue a+singleton f a = IntMinMaxQueue 1 Nothing (Map.singleton (f a) (pure a))++-- | /O(n * log n)/. Build a queue from a list of (priority, element) pairs.+fromList :: [(Prio, a)] -> IntMinMaxQueue a+fromList = Foldable.foldr (uncurry (insert . const)) empty++-- | /O(n * log n)/. Build a queue from a list of elements and a function+-- from elements to priorities.+fromListWith :: (a -> Prio) -> [a] -> IntMinMaxQueue a+fromListWith f = Foldable.foldr (insert f) empty++-- | /O(n)/ (due to calculating the queue size).+fromMap :: IntMap (NonEmpty a) -> IntMinMaxQueue a+fromMap m = IntMinMaxQueue (sum (fmap length m)) Nothing m++-- | /O(1)/. Is the queue empty?+null :: IntMinMaxQueue a -> Bool+null = (== 0) . size++-- | /O(1)/. Is the queue non-empty?+notNull :: IntMinMaxQueue a -> Bool+notNull = not . null++-- | /O(1)/. The total number of elements in the queue.+size :: IntMinMaxQueue a -> Int+size (IntMinMaxQueue sz _ _) = sz++-- | Return a queue that is limited to the given number of elements.+-- If the original queue has more elements than the size limit, the greatest+-- elements will be dropped until the size limit is satisfied.+withMaxSize :: IntMinMaxQueue a -> Int -> IntMinMaxQueue a+withMaxSize q ms = IntMinMaxQueue sz (Just ms) m+  where (IntMinMaxQueue sz _ m) = takeMin ms q++-- | /O(1)/. The size limit of the queue. It returns either @Nothing@ (if+-- the queue does not have a size limit) or @Just n@ where @n >= 0@.+maxSize :: IntMinMaxQueue a -> Maybe Int+maxSize (IntMinMaxQueue _ ms _) = max 0 <$> ms++-- | /O(log n)/. Add the given element to the queue. If the queue has+-- a size limit, and the insertion causes the queue to grow beyond+-- its size limit, the greatest element will be removed from the+-- queue, which may be the element just added.+insert :: (a -> Prio) -> a -> IntMinMaxQueue a -> IntMinMaxQueue a+insert f a q@(IntMinMaxQueue sz ms _) = case ms of+  Just ms' | sz >= ms' -> deleteMax (insert' f a q)+  _ -> insert' f a q++insert' :: (a -> Prio) -> a -> IntMinMaxQueue a -> IntMinMaxQueue a+insert' f a (IntMinMaxQueue sz ms m) = IntMinMaxQueue (sz+1) ms (Map.alter g (f a) m)+  where+    g Nothing = Just (pure a)+    g (Just as) = Just (a <| as)++-- | /O(log n)/. Retrieve the least element of the queue, if exists.+peekMin :: IntMinMaxQueue a -> Maybe a+peekMin (IntMinMaxQueue _ _ m) = Nel.head . snd <$> Map.lookupMin m++-- | /O(log n)/. Retrieve the greatest element of the queue, if exists.+peekMax :: IntMinMaxQueue a -> Maybe a+peekMax (IntMinMaxQueue _ _ m) = Nel.head . snd <$> Map.lookupMax m++-- | /O(log n)/. Remove the least element of the queue, if exists.+deleteMin :: IntMinMaxQueue a -> IntMinMaxQueue a+deleteMin q@(IntMinMaxQueue sz ms m)+  | Just (prio,_) <- Map.lookupMin m = IntMinMaxQueue (sz-1) ms (Map.update (Nel.nonEmpty . Nel.tail) prio m)+  | otherwise = q++-- | /O(log n)/. Remove the greatest element of the queue, if exists.+deleteMax :: IntMinMaxQueue a -> IntMinMaxQueue a+deleteMax q@(IntMinMaxQueue sz ms m)+  | Just (prio,_) <- Map.lookupMax m = IntMinMaxQueue (sz-1) ms (Map.update (Nel.nonEmpty . Nel.tail) prio m)+  | otherwise = q++-- | /O(log n)/. Remove and return the least element of the queue, if exists.+pollMin :: IntMinMaxQueue a -> Maybe (a, IntMinMaxQueue a)+pollMin q = (,) <$> peekMin q <*> pure (deleteMin q)++-- | /O(log n)/. Remove and return the greatest element of the queue, if exists.+pollMax :: IntMinMaxQueue a -> Maybe (a, IntMinMaxQueue a)+pollMax q = (,) <$> peekMax q <*> pure (deleteMax q)++-- | @'takeMin' n q@ returns a queue with the @n@ least elements in @q@, or+-- @q@ itself if @n >= 'size' q@.+takeMin :: Int -> IntMinMaxQueue a -> IntMinMaxQueue a+takeMin n q@(IntMinMaxQueue sz ms m)+    | newSz >= sz = q+    | newSz * 2 <= sz = IntMinMaxQueue newSz ms (take Map.lookupMin newSz m)+    | otherwise = IntMinMaxQueue newSz ms (drop Map.lookupMax (sz - newSz) m)+  where newSz = max 0 (min sz n)++-- | @'takeMin' n q@ returns a queue with the @n@ greatest elements in @q@, or+-- @q@ itself if @n >= 'size' q@.+takeMax :: Int -> IntMinMaxQueue a -> IntMinMaxQueue a+takeMax n q@(IntMinMaxQueue sz ms m)+    | newSz >= sz = q+    | newSz * 2 <= sz = IntMinMaxQueue newSz ms (take Map.lookupMax newSz m)+    | otherwise = IntMinMaxQueue newSz ms (drop Map.lookupMin (sz - newSz) m)+  where newSz = max 0 (min sz n)++-- | @'dropMin' n q@ returns a queue with the @n@ least elements+-- dropped from @q@, or 'empty' if @n >= 'size' q@.+dropMin :: Int -> IntMinMaxQueue a -> IntMinMaxQueue a+dropMin n q@(IntMinMaxQueue sz ms m)+    | newSz >= sz = q+    | newSz * 2 > sz = IntMinMaxQueue newSz ms (drop Map.lookupMin (sz - newSz) m)+    | otherwise = IntMinMaxQueue newSz ms (take Map.lookupMax newSz m)+  where newSz = max 0 (min sz (sz - n))++-- | @'dropMax' n q@ returns a queue with the @n@ greatest elements+-- dropped from @q@, or 'empty' if @n >= 'size' q@.+dropMax :: Int -> IntMinMaxQueue a -> IntMinMaxQueue a+dropMax n q@(IntMinMaxQueue sz ms m)+    | newSz >= sz = q+    | newSz * 2 > sz = IntMinMaxQueue newSz ms (drop Map.lookupMax (sz - newSz) m)+    | otherwise = IntMinMaxQueue newSz ms (take Map.lookupMin newSz m)+  where newSz = max 0 (min sz (sz - n))++take+  :: (forall b. IntMap b -> Maybe (Int, b))+  -> Int -> IntMap (NonEmpty a) -> IntMap (NonEmpty a)+take lookup n m = go 0 m Map.empty+  where+    go sz mIn mOut+      | sz >= n = mOut+      | Just (prio, hd :| tl) <- lookup mIn =+          let as = hd :| Prelude.take (n - sz - 1) tl+              len = Nel.length as+              mOut' = Map.insert prio as mOut+              mIn' = Map.delete prio mIn+           in go (sz + len) mIn' mOut'+      | otherwise = mOut++drop+  :: (forall b. IntMap b -> Maybe (Int, b))+  -> Int -> IntMap (NonEmpty a) -> IntMap (NonEmpty a)+drop lookup n = go 0+  where+    go sz mOut+      | sz >= n = mOut+      | Just (prio, hd :| tl) <- lookup mOut =+          let len = length tl + 1+           in if sz + len <= n+                then go (sz + len) (Map.delete prio mOut)+                else Map.insert prio (hd :| Prelude.drop (n - sz) tl) mOut+      | otherwise = mOut++-- | Map a function over all elements in the queue.+map :: (a -> b) -> IntMinMaxQueue a -> IntMinMaxQueue b+map = mapWithPriority . const++-- | Map a function over all elements in the queue.+mapWithPriority :: (Prio -> a -> b) -> IntMinMaxQueue a -> IntMinMaxQueue b+mapWithPriority f (IntMinMaxQueue sz ms m) =+  IntMinMaxQueue sz ms (Map.mapWithKey (fmap . f) m)++-- | Fold the elements in the queue using the given right-associative+-- binary operator, such that @'foldr' f z == 'Prelude.foldr' f z . 'elems'@.+foldr :: (a -> b -> b) -> b -> IntMinMaxQueue a -> b+foldr = foldrWithPriority . const++-- | Fold the elements in the queue using the given left-associative+-- binary operator, such that @'foldl' f z == 'Prelude.foldl' f z . 'elems'@.+foldl :: (a -> b -> a) -> a -> IntMinMaxQueue b -> a+foldl = foldlWithPriority . (const .)++-- | Fold the elements in the queue using the given right-associative+-- binary operator, such that+-- @'foldrWithPriority' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@.+foldrWithPriority :: (Prio -> a -> b -> b) -> b -> IntMinMaxQueue a -> b+foldrWithPriority f b (IntMinMaxQueue _ _ m) = Map.foldrWithKey f' b m+  where+    f' = flip . Foldable.foldr . f++-- | Fold the elements in the queue using the given left-associative+-- binary operator, such that+-- @'foldlWithPriority' f z == 'Prelude.foldr' ('uncurry' . f) z . 'toAscList'@.+foldlWithPriority :: (a -> Prio -> b -> a) -> a -> IntMinMaxQueue b -> a+foldlWithPriority f a (IntMinMaxQueue _ _ m) = Map.foldlWithKey f' a m+  where+    f' = flip (Foldable.foldl . flip f)++-- | A strict version of 'foldr'. Each application of the+-- operator is evaluated before using the result in the next application.+-- This function is strict in the starting value.+foldr' :: (a -> b -> b) -> b -> IntMinMaxQueue a -> b+foldr' = foldrWithPriority' . const++-- | A strict version of 'foldl'. Each application of the+-- operator is evaluated before using the result in the next application.+-- This function is strict in the starting value.+foldl' :: (a -> b -> a) -> a -> IntMinMaxQueue b -> a+foldl' = foldlWithPriority' . (const .)++-- | A strict version of 'foldrWithPriority'. Each application of the+-- operator is evaluated before using the result in the next application.+-- This function is strict in the starting value.+foldrWithPriority' :: (Prio -> a -> b -> b) -> b -> IntMinMaxQueue a -> b+foldrWithPriority' f b (IntMinMaxQueue _ _ m) = Map.foldrWithKey' f' b m+  where+    f' = flip . Foldable.foldr . f++-- | A strict version of 'foldlWithPriority'. Each application of the+-- operator is evaluated before using the result in the next application.+-- This function is strict in the starting value.+foldlWithPriority' :: (a -> Prio -> b -> a) -> a -> IntMinMaxQueue b -> a+foldlWithPriority' f a (IntMinMaxQueue _ _ m) = Map.foldlWithKey' f' a m+  where+    f' = flip (Foldable.foldl' . flip f)++-- | Fold the elements in the queue using the given monoid, such that+-- @'foldMapWithPriority' f == 'Foldable.foldMap' (uncurry f) . 'elems'@.+foldMapWithPriority :: Monoid m => (Prio -> a -> m) -> IntMinMaxQueue a -> m+foldMapWithPriority f (IntMinMaxQueue _ _ m) =+  Map.foldMapWithKey (Foldable.foldMap . f) m++-- | Elements in the queue in ascending order of priority.+-- Elements with the same priority are returned in no particular order.+elems :: IntMinMaxQueue a -> [a]+elems (IntMinMaxQueue _ _ m) = Foldable.foldMap Nel.toList m++-- | An alias for 'toAscList'.+toList :: IntMinMaxQueue a -> [(Prio, a)]+toList = toAscList++-- | Convert the queue to a list in ascending order of priority.+-- Elements with the same priority are returned in no particular order.+toAscList :: IntMinMaxQueue a -> [(Prio, a)]+toAscList (IntMinMaxQueue _ _ m) =+  Map.toAscList m >>= uncurry (\prio -> fmap (prio,) . Nel.toList)++-- | Convert the queue to a list in descending order of priority.+-- Elements with the same priority are returned in no particular order.+toDescList :: IntMinMaxQueue a -> [(Prio, a)]+toDescList (IntMinMaxQueue _ _ m) =+  Map.toDescList m >>= uncurry (\prio -> fmap (prio,) . Nel.toList)++-- | /O(n)/. Convert the queue to an 'IntMap'.+toMap :: IntMinMaxQueue a -> IntMap (NonEmpty a)+toMap (IntMinMaxQueue _ _ m) = m
+ src/Data/MinMaxQueue.hs view
@@ -0,0 +1,412 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TupleSections #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.MinMaxQueue+-- Maintainer  :  Ziyang Liu <free@cofree.io>+--+-- Double-ended priority queues, allowing efficient retrieval and removel+-- from both ends of the queue.+--+-- A queue can be configured with a maximum size. Each time an insertion+-- causes the queue to grow beyond the size limit, the greatest element+-- will be automatically removed (rather than rejecting the insertion).+--+-- If the priority values are 'Int's, use "Data.IntMinMaxQueue".+--+-- The implementation is backed by a @'Map' prio ('NonEmpty' a)@. This means+-- that certain operations, including 'peekMin', 'peekMax' and 'fromList',+-- are asymptotically more expensive than a mutable array based implementation.+-- In a pure language like Haskell, a+-- mutable array based implementation would be impure+-- and need to operate inside monads. And in many applications, regardless+-- of language, the additional time complexity would be a small or negligible+-- price to pay to avoid destructive updates anyway.+--+-- If you only access one end of the queue (i.e., you need a regular+-- priority queue), an implementation based on a kind of heap that is more+-- amenable to purely functional implementations, such as binomial heap+-- and pairing heap, is /potentially/ more efficient. But always benchmark+-- if performance is important; in my experience @Map@ /always/ wins, even for+-- regular priority queues.+--+-- See <https://github.com/zliu41/min-max-pqueue/blob/master/README.md README.md>+-- for more information.+module Data.MinMaxQueue (+  -- * MinMaxQueue type+    MinMaxQueue++  -- * Construction+  , empty+  , singleton+  , fromList+  , fromListWith+  , fromMap++  -- * Size+  , null+  , notNull+  , size++  -- * Maximum size+  , withMaxSize+  , maxSize++  -- * Queue operations+  , insert+  , peekMin+  , peekMax+  , deleteMin+  , deleteMax+  , pollMin+  , pollMax+  , takeMin+  , takeMax+  , dropMin+  , dropMax++  -- * Traversal+  -- ** Map+  , map+  , mapWithPriority++  -- ** Folds+  , foldr+  , foldl+  , foldrWithPriority+  , foldlWithPriority+  , foldMapWithPriority++  -- ** Strict Folds+  , foldr'+  , foldl'+  , foldrWithPriority'+  , foldlWithPriority'++  -- * Lists+  , elems+  , toList+  , toAscList+  , toDescList++  -- * Maps+  , toMap+  ) where++import           Data.Data (Data)+import qualified Data.Foldable as Foldable+import           Data.Functor.Classes+import           Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import           Data.List.NonEmpty (NonEmpty(..), (<|))+import qualified Data.List.NonEmpty as Nel++import Prelude hiding (drop, foldl, foldr, lookup, map, null, take)+import qualified Prelude++type Size = Int+type MaxSize = Maybe Int++-- | A double-ended priority queue whose elements are of type @a@ and+-- are compared on @prio@.+data MinMaxQueue prio a = MinMaxQueue {-# UNPACK #-} !Size !MaxSize !(Map prio (NonEmpty a))+  deriving (Eq, Ord, Data)++instance Eq prio => Eq1 (MinMaxQueue prio) where+  liftEq = liftEq2 (==)++instance Eq2 MinMaxQueue where+  liftEq2 eqk eqv q1 q2 =+    Map.size (toMap q1) == Map.size (toMap q2)+      && liftEq (liftEq2 eqk eqv) (toList q1) (toList q2)++instance Ord prio => Ord1 (MinMaxQueue prio) where+  liftCompare = liftCompare2 compare++instance Ord2 MinMaxQueue where+  liftCompare2 cmpk cmpv q1 q2 =+    liftCompare (liftCompare2 cmpk cmpv) (toList q1) (toList q2)++instance (Show prio, Show a) => Show (MinMaxQueue prio a) where+  showsPrec d q = showParen (d > 10) $+    showString "fromList " . shows (toList q)++instance Show prio => Show1 (MinMaxQueue prio) where+  liftShowsPrec = liftShowsPrec2 showsPrec showList++instance Show2 MinMaxQueue where+  liftShowsPrec2 spk slk spv slv d m =+      showsUnaryWith (liftShowsPrec sp sl) "fromList" d (toList m)+    where+      sp = liftShowsPrec2 spk slk spv slv+      sl = liftShowList2 spk slk spv slv++instance (Ord prio, Read prio, Read a) => Read (MinMaxQueue prio a) where+  readsPrec p = readParen (p > 10) $ \r -> do+    ("fromList",s) <- lex r+    (xs,t) <- reads s+    pure (fromList xs,t)++instance (Ord prio, Read prio) => Read1 (MinMaxQueue prio) where+  liftReadsPrec rp rl = readsData $+      readsUnaryWith (liftReadsPrec rp' rl') "fromList" fromList+    where+      rp' = liftReadsPrec rp rl+      rl' = liftReadList rp rl++instance Functor (MinMaxQueue prio) where+  fmap = map++instance Foldable.Foldable (MinMaxQueue prio) where+  foldMap = foldMapWithPriority . const++-- | /O(1)/. The empty queue.+empty :: MinMaxQueue prio a+empty = MinMaxQueue 0 Nothing Map.empty++-- | /O(1)/. A queue with a single element.+singleton :: (a -> prio) -> a -> MinMaxQueue prio a+singleton f a = MinMaxQueue 1 Nothing (Map.singleton (f a) (pure a))++-- | /O(n * log n)/. Build a queue from a list of (priority, element) pairs.+fromList :: Ord prio => [(prio, a)] -> MinMaxQueue prio a+fromList = Foldable.foldr (uncurry (insert . const)) empty++-- | /O(n * log n)/. Build a queue from a list of elements and a function+-- from elements to priorities.+fromListWith :: Ord prio => (a -> prio) -> [a] -> MinMaxQueue prio a+fromListWith f = Foldable.foldr (insert f) empty++-- | /O(n)/ (due to calculating the queue size).+fromMap :: Map prio (NonEmpty a) -> MinMaxQueue prio a+fromMap m = MinMaxQueue (sum (fmap length m)) Nothing m++-- | /O(1)/. Is the queue empty?+null :: MinMaxQueue prio a -> Bool+null = (== 0) . size++-- | /O(1)/. Is the queue non-empty?+notNull :: MinMaxQueue prio a -> Bool+notNull = not . null++-- | /O(1)/. The total number of elements in the queue.+size :: MinMaxQueue prio a -> Int+size (MinMaxQueue sz _ _) = sz++-- | Return a queue that is limited to the given number of elements.+-- If the original queue has more elements than the size limit, the greatest+-- elements will be dropped until the size limit is satisfied.+withMaxSize :: Ord prio => MinMaxQueue prio a -> Int -> MinMaxQueue prio a+withMaxSize q ms = MinMaxQueue sz (Just ms) m+  where (MinMaxQueue sz _ m) = takeMin ms q++-- | /O(1)/. The size limit of the queue. It returns either @Nothing@ (if+-- the queue does not have a size limit) or @Just n@ where @n >= 0@.+maxSize :: MinMaxQueue prio a -> Maybe Int+maxSize (MinMaxQueue _ ms _) = max 0 <$> ms++-- | /O(log n)/. Add the given element to the queue. If the queue has+-- a size limit, and the insertion causes the queue to grow beyond+-- its size limit, the greatest element will be removed from the+-- queue, which may be the element just added.+insert :: Ord prio => (a -> prio) -> a -> MinMaxQueue prio a -> MinMaxQueue prio a+insert f a q@(MinMaxQueue sz ms _) = case ms of+  Just ms' | sz >= ms' -> deleteMax (insert' f a q)+  _ -> insert' f a q++insert' :: Ord prio => (a -> prio) -> a -> MinMaxQueue prio a -> MinMaxQueue prio a+insert' f a (MinMaxQueue sz ms m) = MinMaxQueue (sz+1) ms (Map.alter g (f a) m)+  where+    g Nothing = Just (pure a)+    g (Just as) = Just (a <| as)++-- | /O(log n)/. Retrieve the least element of the queue, if exists.+peekMin :: Ord prio => MinMaxQueue prio a -> Maybe a+peekMin (MinMaxQueue _ _ m) = Nel.head . snd <$> Map.lookupMin m++-- | /O(log n)/. Retrieve the greatest element of the queue, if exists.+peekMax :: Ord prio => MinMaxQueue prio a -> Maybe a+peekMax (MinMaxQueue _ _ m) = Nel.head . snd <$> Map.lookupMax m++-- | /O(log n)/. Remove the least element of the queue, if exists.+deleteMin :: Ord prio => MinMaxQueue prio a -> MinMaxQueue prio a+deleteMin q@(MinMaxQueue sz ms m)+  | Just (prio,_) <- Map.lookupMin m = MinMaxQueue (sz-1) ms (Map.update (Nel.nonEmpty . Nel.tail) prio m)+  | otherwise = q++-- | /O(log n)/. Remove the greatest element of the queue, if exists.+deleteMax :: Ord prio => MinMaxQueue prio a -> MinMaxQueue prio a+deleteMax q@(MinMaxQueue sz ms m)+  | Just (prio,_) <- Map.lookupMax m = MinMaxQueue (sz-1) ms (Map.update (Nel.nonEmpty . Nel.tail) prio m)+  | otherwise = q++-- | /O(log n)/. Remove and return the least element of the queue, if exists.+pollMin :: Ord prio => MinMaxQueue prio a -> Maybe (a, MinMaxQueue prio a)+pollMin q = (,) <$> peekMin q <*> pure (deleteMin q)++-- | /O(log n)/. Remove and return the greatest element of the queue, if exists.+pollMax :: Ord prio => MinMaxQueue prio a -> Maybe (a, MinMaxQueue prio a)+pollMax q = (,) <$> peekMax q <*> pure (deleteMax q)++-- | @'takeMin' n q@ returns a queue with the @n@ least elements in @q@, or+-- @q@ itself if @n >= 'size' q@.+takeMin :: Ord prio => Int -> MinMaxQueue prio a -> MinMaxQueue prio a+takeMin n q@(MinMaxQueue sz ms m)+    | newSz >= sz = q+    | newSz * 2 <= sz = MinMaxQueue newSz ms (take Map.lookupMin newSz m)+    | otherwise = MinMaxQueue newSz ms (drop Map.lookupMax (sz - newSz) m)+  where newSz = max 0 (min sz n)++-- | @'takeMin' n q@ returns a queue with the @n@ greatest elements in @q@, or+-- @q@ itself if @n >= 'size' q@.+takeMax :: Ord prio => Int -> MinMaxQueue prio a -> MinMaxQueue prio a+takeMax n q@(MinMaxQueue sz ms m)+    | newSz >= sz = q+    | newSz * 2 <= sz = MinMaxQueue newSz ms (take Map.lookupMax newSz m)+    | otherwise = MinMaxQueue newSz ms (drop Map.lookupMin (sz - newSz) m)+  where newSz = max 0 (min sz n)++-- | @'dropMin' n q@ returns a queue with the @n@ least elements+-- dropped from @q@, or 'empty' if @n >= 'size' q@.+dropMin :: Ord prio => Int -> MinMaxQueue prio a -> MinMaxQueue prio a+dropMin n q@(MinMaxQueue sz ms m)+    | newSz >= sz = q+    | newSz * 2 > sz = MinMaxQueue newSz ms (drop Map.lookupMin (sz - newSz) m)+    | otherwise = MinMaxQueue newSz ms (take Map.lookupMax newSz m)+  where newSz = max 0 (min sz (sz - n))++-- | @'dropMax' n q@ returns a queue with the @n@ greatest elements+-- dropped from @q@, or 'empty' if @n >= 'size' q@.+dropMax :: Ord prio => Int -> MinMaxQueue prio a -> MinMaxQueue prio a+dropMax n q@(MinMaxQueue sz ms m)+    | newSz >= sz = q+    | newSz * 2 > sz = MinMaxQueue newSz ms (drop Map.lookupMax (sz - newSz) m)+    | otherwise = MinMaxQueue newSz ms (take Map.lookupMin newSz m)+  where newSz = max 0 (min sz (sz - n))++take+  :: Ord prio+  => (forall b. Map prio b -> Maybe (prio, b))+  -> Int -> Map prio (NonEmpty a) -> Map prio (NonEmpty a)+take lookup n m = go 0 m Map.empty+  where+    go sz mIn mOut+      | sz >= n = mOut+      | Just (prio, hd :| tl) <- lookup mIn =+          let as = hd :| Prelude.take (n - sz - 1) tl+              len = Nel.length as+              mOut' = Map.insert prio as mOut+              mIn' = Map.delete prio mIn+           in go (sz + len) mIn' mOut'+      | otherwise = mOut++drop+  :: Ord prio+  => (forall b. Map prio b -> Maybe (prio, b))+  -> Int -> Map prio (NonEmpty a) -> Map prio (NonEmpty a)+drop lookup n = go 0+  where+    go sz mOut+      | sz >= n = mOut+      | Just (prio, hd :| tl) <- lookup mOut =+          let len = length tl + 1+           in if sz + len <= n+                then go (sz + len) (Map.delete prio mOut)+                else Map.insert prio (hd :| Prelude.drop (n - sz) tl) mOut+      | otherwise = mOut++-- | Map a function over all elements in the queue.+map :: (a -> b) -> MinMaxQueue prio a -> MinMaxQueue prio b+map = mapWithPriority . const++-- | Map a function over all elements in the queue.+mapWithPriority :: (prio -> a -> b) -> MinMaxQueue prio a -> MinMaxQueue prio b+mapWithPriority f (MinMaxQueue sz ms m) =+  MinMaxQueue sz ms (Map.mapWithKey (fmap . f) m)++-- | Fold the elements in the queue using the given right-associative+-- binary operator, such that @'foldr' f z == 'Prelude.foldr' f z . 'elems'@.+foldr :: (a -> b -> b) -> b -> MinMaxQueue prio a -> b+foldr = foldrWithPriority . const++-- | Fold the elements in the queue using the given left-associative+-- binary operator, such that @'foldl' f z == 'Prelude.foldl' f z . 'elems'@.+foldl :: (a -> b -> a) -> a -> MinMaxQueue prio b -> a+foldl = foldlWithPriority . (const .)++-- | Fold the elements in the queue using the given right-associative+-- binary operator, such that+-- @'foldrWithPriority' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@.+foldrWithPriority :: (prio -> a -> b -> b) -> b -> MinMaxQueue prio a -> b+foldrWithPriority f b (MinMaxQueue _ _ m) = Map.foldrWithKey f' b m+  where+    f' = flip . Foldable.foldr . f++-- | Fold the elements in the queue using the given left-associative+-- binary operator, such that+-- @'foldlWithPriority' f z == 'Prelude.foldr' ('uncurry' . f) z . 'toAscList'@.+foldlWithPriority :: (a -> prio -> b -> a) -> a -> MinMaxQueue prio b -> a+foldlWithPriority f a (MinMaxQueue _ _ m) = Map.foldlWithKey f' a m+  where+    f' = flip (Foldable.foldl . flip f)++-- | A strict version of 'foldr'. Each application of the+-- operator is evaluated before using the result in the next application.+-- This function is strict in the starting value.+foldr' :: (a -> b -> b) -> b -> MinMaxQueue prio a -> b+foldr' = foldrWithPriority' . const++-- | A strict version of 'foldl'. Each application of the+-- operator is evaluated before using the result in the next application.+-- This function is strict in the starting value.+foldl' :: (a -> b -> a) -> a -> MinMaxQueue prio b -> a+foldl' = foldlWithPriority' . (const .)++-- | A strict version of 'foldrWithPriority'. Each application of the+-- operator is evaluated before using the result in the next application.+-- This function is strict in the starting value.+foldrWithPriority' :: (prio -> a -> b -> b) -> b -> MinMaxQueue prio a -> b+foldrWithPriority' f b (MinMaxQueue _ _ m) = Map.foldrWithKey' f' b m+  where+    f' = flip . Foldable.foldr . f++-- | A strict version of 'foldlWithPriority'. Each application of the+-- operator is evaluated before using the result in the next application.+-- This function is strict in the starting value.+foldlWithPriority' :: (a -> prio -> b -> a) -> a -> MinMaxQueue prio b -> a+foldlWithPriority' f a (MinMaxQueue _ _ m) = Map.foldlWithKey' f' a m+  where+    f' = flip (Foldable.foldl' . flip f)++-- | Fold the elements in the queue using the given monoid, such that+-- @'foldMapWithPriority' f == 'Foldable.foldMap' (uncurry f) . 'elems'@.+foldMapWithPriority :: Monoid m => (prio -> a -> m) -> MinMaxQueue prio a -> m+foldMapWithPriority f (MinMaxQueue _ _ m) =+  Map.foldMapWithKey (Foldable.foldMap . f) m++-- | Elements in the queue in ascending order of priority.+-- Elements with the same priority are returned in no particular order.+elems :: MinMaxQueue prio a -> [a]+elems (MinMaxQueue _ _ m) = Foldable.foldMap Nel.toList m++-- | An alias for 'toAscList'.+toList :: MinMaxQueue prio a -> [(prio, a)]+toList = toAscList++-- | Convert the queue to a list in ascending order of priority.+-- Elements with the same priority are returned in no particular order.+toAscList :: MinMaxQueue prio a -> [(prio, a)]+toAscList (MinMaxQueue _ _ m) =+  Map.toAscList m >>= uncurry (\prio -> fmap (prio,) . Nel.toList)++-- | Convert the queue to a list in descending order of priority.+-- Elements with the same priority are returned in no particular order.+toDescList :: MinMaxQueue prio a -> [(prio, a)]+toDescList (MinMaxQueue _ _ m) =+  Map.toDescList m >>= uncurry (\prio -> fmap (prio,) . Nel.toList)++-- | /O(n)/. Convert the queue to a 'Map'.+toMap :: MinMaxQueue prio a -> Map prio (NonEmpty a)+toMap (MinMaxQueue _ _ m) = m
+ test/hedgehog/IntMinMaxQueueSpec.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE TemplateHaskell #-}++module IntMinMaxQueueSpec where++import qualified Data.Foldable as Foldable+import qualified Data.List as List++import           Hedgehog+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++import           Data.IntMinMaxQueue (IntMinMaxQueue)+import qualified Data.IntMinMaxQueue as PQ++genQueue :: Gen (IntMinMaxQueue Int)+genQueue = do+  xs <- Gen.list (Range.linear 0 500) (Gen.int (Range.linear 0 50))+  pure $ PQ.fromListWith id xs++prop_ascendingOrder :: Property+prop_ascendingOrder = property $ do+  q <- forAll genQueue+  let ascList = dequeueAllAsc q+  ascList === List.sort ascList+  PQ.size q === length ascList++prop_descendingOrder :: Property+prop_descendingOrder = property $ do+  q <- forAll genQueue+  let descList = dequeueAllDesc q+  descList === List.sortBy (flip compare) descList+  PQ.size q === length descList++prop_takeMin :: Property+prop_takeMin = property $ do+  q <- forAll genQueue+  n <- forAll $ Gen.int (Range.linear (-100) (PQ.size q + 100))+  take n (dequeueAllAsc q) === dequeueAllAsc (PQ.takeMin n q)+  length (take n (dequeueAllAsc q)) === PQ.size (PQ.takeMin n q)++prop_takeMax :: Property+prop_takeMax = property $ do+  q <- forAll genQueue+  n <- forAll $ Gen.int (Range.linear (-100) (PQ.size q + 100))+  take n (dequeueAllDesc q) === dequeueAllDesc (PQ.takeMax n q)+  length (take n (dequeueAllDesc q)) === PQ.size (PQ.takeMax n q)++prop_dropMin :: Property+prop_dropMin = property $ do+  q <- forAll genQueue+  n <- forAll $ Gen.int (Range.linear (-100) (PQ.size q + 100))+  drop n (dequeueAllAsc q) === dequeueAllAsc (PQ.dropMin n q)+  length (drop n (dequeueAllAsc q)) === PQ.size (PQ.dropMin n q)++prop_dropMax :: Property+prop_dropMax = property $ do+  q <- forAll genQueue+  n <- forAll $ Gen.int (Range.linear (-100) (PQ.size q + 100))+  drop n (dequeueAllDesc q) === dequeueAllDesc (PQ.dropMax n q)+  length (drop n (dequeueAllDesc q)) === PQ.size (PQ.dropMax n q)++prop_maxSize :: Property+prop_maxSize = property $ do+  q <- forAll genQueue+  n <- forAll $ Gen.int (Range.linear (-100) (PQ.size q + 100))+  let q' = q `PQ.withMaxSize` n+  PQ.size q' === max 0 (min (PQ.size q) n)+  PQ.maxSize q' === Just (max 0 n)+  dequeueAllAsc q' === take (PQ.size q') (dequeueAllAsc q)++prop_insertWithMaxSize :: Property+prop_insertWithMaxSize = property $ do+  q <- forAll genQueue+  let q' = q `PQ.withMaxSize` PQ.size q+  PQ.insert id maxBound q' === q'+  PQ.insert id minBound q' === PQ.insert id minBound (PQ.deleteMax q')++prop_fold :: Property+prop_fold = property $ do+  q <- forAll genQueue+  let f a s = show a ++ s+      g = flip f+      f' prio a s = show prio ++ show a ++ s+      g' s prio a = f' prio a s+      h prio a = show prio ++ show a+  PQ.foldr f "" q === foldr f "" (PQ.elems q)+  PQ.foldl g "" q === foldl g "" (PQ.elems q)+  PQ.foldrWithPriority f' "" q === foldr (uncurry f') "" (PQ.toAscList q)+  PQ.foldlWithPriority g' "" q === foldl (uncurry . g') "" (PQ.toAscList q)+  Foldable.foldMap show q === Foldable.foldMap show (PQ.elems q)+  PQ.foldMapWithPriority h q === Foldable.foldMap (uncurry h) (PQ.toAscList q)++dequeueAllAsc :: IntMinMaxQueue a -> [a]+dequeueAllAsc = List.unfoldr PQ.pollMin++dequeueAllDesc :: IntMinMaxQueue a -> [a]+dequeueAllDesc = List.unfoldr PQ.pollMax++tests :: IO Bool+tests =+  checkParallel $$(discover)
+ test/hedgehog/Main.hs view
@@ -0,0 +1,16 @@+module Main (main) where++import           Control.Monad (unless)+import           GHC.IO.Encoding (utf8)+import           System.Exit (exitFailure)+import           System.IO (hSetEncoding, stdout, stderr)++import qualified IntMinMaxQueueSpec+import qualified MinMaxQueueSpec++main :: IO ()+main = do+  hSetEncoding stdout utf8+  hSetEncoding stderr utf8+  passed <- sequenceA [MinMaxQueueSpec.tests, IntMinMaxQueueSpec.tests]+  unless (and passed) exitFailure
+ test/hedgehog/MinMaxQueueSpec.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE TemplateHaskell #-}++module MinMaxQueueSpec where++import qualified Data.Foldable as Foldable+import qualified Data.List as List++import           Hedgehog+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++import           Data.MinMaxQueue (MinMaxQueue)+import qualified Data.MinMaxQueue as PQ++genQueue :: Gen (MinMaxQueue Int Int)+genQueue = do+  xs <- Gen.list (Range.linear 0 500) (Gen.int (Range.linear 0 50))+  pure $ PQ.fromListWith id xs++prop_ascendingOrder :: Property+prop_ascendingOrder = property $ do+  q <- forAll genQueue+  let ascList = dequeueAllAsc q+  ascList === List.sort ascList+  PQ.size q === length ascList++prop_descendingOrder :: Property+prop_descendingOrder = property $ do+  q <- forAll genQueue+  let descList = dequeueAllDesc q+  descList === List.sortBy (flip compare) descList+  PQ.size q === length descList++prop_takeMin :: Property+prop_takeMin = property $ do+  q <- forAll genQueue+  n <- forAll $ Gen.int (Range.linear (-100) (PQ.size q + 100))+  take n (dequeueAllAsc q) === dequeueAllAsc (PQ.takeMin n q)+  length (take n (dequeueAllAsc q)) === PQ.size (PQ.takeMin n q)++prop_takeMax :: Property+prop_takeMax = property $ do+  q <- forAll genQueue+  n <- forAll $ Gen.int (Range.linear (-100) (PQ.size q + 100))+  take n (dequeueAllDesc q) === dequeueAllDesc (PQ.takeMax n q)+  length (take n (dequeueAllDesc q)) === PQ.size (PQ.takeMax n q)++prop_dropMin :: Property+prop_dropMin = property $ do+  q <- forAll genQueue+  n <- forAll $ Gen.int (Range.linear (-100) (PQ.size q + 100))+  drop n (dequeueAllAsc q) === dequeueAllAsc (PQ.dropMin n q)+  length (drop n (dequeueAllAsc q)) === PQ.size (PQ.dropMin n q)++prop_dropMax :: Property+prop_dropMax = property $ do+  q <- forAll genQueue+  n <- forAll $ Gen.int (Range.linear (-100) (PQ.size q + 100))+  drop n (dequeueAllDesc q) === dequeueAllDesc (PQ.dropMax n q)+  length (drop n (dequeueAllDesc q)) === PQ.size (PQ.dropMax n q)++prop_maxSize :: Property+prop_maxSize = property $ do+  q <- forAll genQueue+  n <- forAll $ Gen.int (Range.linear (-100) (PQ.size q + 100))+  let q' = q `PQ.withMaxSize` n+  PQ.size q' === max 0 (min (PQ.size q) n)+  PQ.maxSize q' === Just (max 0 n)+  dequeueAllAsc q' === take (PQ.size q') (dequeueAllAsc q)++prop_insertWithMaxSize :: Property+prop_insertWithMaxSize = property $ do+  q <- forAll genQueue+  let q' = q `PQ.withMaxSize` PQ.size q+  PQ.insert id maxBound q' === q'+  PQ.insert id minBound q' === PQ.insert id minBound (PQ.deleteMax q')++prop_fold :: Property+prop_fold = property $ do+  q <- forAll genQueue+  let f a s = show a ++ s+      g = flip f+      f' prio a s = show prio ++ show a ++ s+      g' s prio a = f' prio a s+      h prio a = show prio ++ show a+  PQ.foldr f "" q === foldr f "" (PQ.elems q)+  PQ.foldl g "" q === foldl g "" (PQ.elems q)+  PQ.foldrWithPriority f' "" q === foldr (uncurry f') "" (PQ.toAscList q)+  PQ.foldlWithPriority g' "" q === foldl (uncurry . g') "" (PQ.toAscList q)+  Foldable.foldMap show q === Foldable.foldMap show (PQ.elems q)+  PQ.foldMapWithPriority h q === Foldable.foldMap (uncurry h) (PQ.toAscList q)++dequeueAllAsc :: Ord prio => MinMaxQueue prio a -> [a]+dequeueAllAsc = List.unfoldr PQ.pollMin++dequeueAllDesc :: Ord prio => MinMaxQueue prio a -> [a]+dequeueAllDesc = List.unfoldr PQ.pollMax++tests :: IO Bool+tests =+  checkParallel $$(discover)