packages feed

pqueue 1.4.1.2 → 1.4.1.3

raw patch · 20 files changed

+2778/−2781 lines, 20 filesdep +pqueuedep ~base

Dependencies added: pqueue

Dependency ranges changed: base

Files

CHANGELOG.md view
@@ -1,5 +1,11 @@ # Revision history for pqueue +## 1.4.1.3  -- 2020-06-06++  * 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
− Control/Applicative/Identity.hs 
@@ -1,14 +0,0 @@-module Control.Applicative.Identity where--import Control.Applicative--import Prelude--newtype Identity a = Identity {runIdentity :: a}--instance Functor Identity where-  fmap f (Identity x) = Identity (f x)--instance Applicative Identity where-  pure = Identity-  Identity f <*> Identity x = Identity (f x)
− Data/PQueue/Internals.hs 
@@ -1,508 +0,0 @@-{-# LANGUAGE CPP, StandaloneDeriving #-}--module Data.PQueue.Internals (-  MinQueue (..),-  BinomHeap,-  BinomForest(..),-  BinomTree(..),-  Succ(..),-  Zero(..),-  LEq,-  empty,-  null,-  size,-  getMin,-  minView,-  singleton,-  insert,-  union,-  mapMaybe,-  mapEither,-  mapMonotonic,-  foldrAsc,-  foldlAsc,-  insertMinQ,---   mapU,-  foldrU,-  foldlU,---   traverseU,-  keysQueue,-  seqSpine-  ) where--import Control.DeepSeq (NFData(rnf), deepseq)--import Data.Functor ((<$>))-import Data.Foldable (Foldable (foldr, foldl))-import Data.Monoid (mappend)-import qualified Data.PQueue.Prio.Internals as Prio--#ifdef __GLASGOW_HASKELL__-import Data.Data-#endif--import Prelude hiding (foldl, foldr, null)---- | A priority queue with elements of type @a@.  Supports extracting the minimum element.-data MinQueue a = Empty | MinQueue {-# UNPACK #-} !Int a !(BinomHeap a)-#if __GLASGOW_HASKELL__>=707-  deriving Typeable-#else-#include "Typeable.h"-INSTANCE_TYPEABLE1(MinQueue,minQTC,"MinQueue")-#endif--#ifdef __GLASGOW_HASKELL__-instance (Ord a, Data a) => Data (MinQueue a) where-  gfoldl f z q  = case minView q of-    Nothing      -> z Empty-    Just (x, q') -> z insertMinQ `f` x `f` q'--  gunfold k z c = case constrIndex c of-    1  -> z Empty-    2  -> k (k (z insertMinQ))-    _  -> error "gunfold"--  dataCast1 x = gcast1 x--  toConstr q-    | null q  = emptyConstr-    | otherwise  = consConstr--  dataTypeOf _ = queueDataType--queueDataType :: DataType-queueDataType = mkDataType "Data.PQueue.Min.MinQueue" [emptyConstr, consConstr]--emptyConstr, consConstr :: Constr-emptyConstr = mkConstr queueDataType "empty" [] Prefix-consConstr  = mkConstr queueDataType "<|" [] Infix--#endif--type BinomHeap = BinomForest Zero--instance Ord a => Eq (MinQueue a) where-  Empty == Empty = True-  MinQueue n1 x1 q1 == MinQueue n2 x2 q2 =-    n1 == n2 && eqExtract (x1,q1) (x2,q2)-  _ == _ = False--eqExtract :: Ord a => (a, BinomHeap a) -> (a, BinomHeap a) -> Bool-eqExtract (x1,q1) (x2,q2) =-  x1 == x2 &&-  case (extractHeap q1, extractHeap q2) of-    (Just h1, Just h2) -> eqExtract h1 h2-    (Nothing, Nothing) -> True-    _ -> False--instance Ord a => Ord (MinQueue a) where-  Empty `compare` Empty = EQ-  Empty `compare` _ = LT-  _ `compare` Empty = GT-  MinQueue _n1 x1 q1 `compare` MinQueue _n2 x2 q2 = cmpExtract (x1,q1) (x2,q2)--cmpExtract :: Ord a => (a, BinomHeap a) -> (a, BinomHeap a) -> Ordering-cmpExtract (x1,q1) (x2,q2) =-  compare x1 x2 `mappend`-  case (extractHeap q1, extractHeap q2) of-    (Just h1, Just h2) -> cmpExtract h1 h2-    (Nothing, Nothing) -> EQ-    (Just _, Nothing) -> GT-    (Nothing, Just _) -> LT--    -- We compare their first elements, then their other elements up to the smaller queue's length,-    -- and then the longer queue wins.-    -- This is equivalent to @comparing toAscList@, except it fuses much more nicely.---- We implement tree ranks in the type system with a nicely elegant approach, as follows.--- The goal is to have the type system automatically guarantee that our binomial forest--- has the correct binomial structure.------ In the traditional set-theoretic construction of the natural numbers, we define--- each number to be the set of numbers less than it, and Zero to be the empty set,--- as follows:------ 0 = {}  1 = {0}    2 = {0, 1}  3={0, 1, 2} ...------ Binomial trees have a similar structure: a tree of rank @k@ has one child of each--- rank less than @k@.  Let's define the type @rk@ corresponding to rank @k@ to refer--- to a collection of binomial trees of ranks @0..k-1@.  Then we can say that------ > data Succ rk a = Succ (BinomTree rk a) (rk a)------ and this behaves exactly as the successor operator for ranks should behave.  Furthermore,--- we immediately obtain that------ > data BinomTree rk a = BinomTree a (rk a)------ which is nice and compact.  With this construction, things work out extremely nicely:------ > BinomTree (Succ (Succ (Succ Zero)))------ is a type constructor that takes an element type and returns the type of binomial trees--- of rank @3@.-data BinomForest rk a = Nil | Skip (BinomForest (Succ rk) a) |-  Cons {-# UNPACK #-} !(BinomTree rk a) (BinomForest (Succ rk) a)--data BinomTree rk a = BinomTree a (rk a)---- | If |rk| corresponds to rank @k@, then |'Succ' rk| corresponds to rank @k+1@.-data Succ rk a = Succ {-# UNPACK #-} !(BinomTree rk a) (rk a)---- | Type corresponding to the Zero rank.-data Zero a = Zero---- | Type alias for a comparison function.-type LEq a = a -> a -> Bool---- basics---- | /O(1)/.  The empty priority queue.-empty :: MinQueue a-empty = Empty---- | /O(1)/.  Is this the empty priority queue?-null :: MinQueue a -> Bool-null Empty = True-null _     = False---- | /O(1)/.  The number of elements in the queue.-size :: MinQueue a -> Int-size Empty            = 0-size (MinQueue n _ _) = n---- | Returns the minimum element of the queue, if the queue is nonempty.-getMin :: MinQueue a -> Maybe a-getMin (MinQueue _ x _) = Just x-getMin _                = Nothing---- | Retrieves the minimum element of the queue, and the queue stripped of that element,--- or 'Nothing' if passed an empty queue.-minView :: Ord a => MinQueue a -> Maybe (a, MinQueue a)-minView Empty = Nothing-minView (MinQueue n x ts) = Just (x, case extractHeap ts of-  Nothing        -> Empty-  Just (x', ts') -> MinQueue (n-1) x' ts')---- | /O(1)/.  Construct a priority queue with a single element.-singleton :: a -> MinQueue a-singleton x = MinQueue 1 x Nil---- | Amortized /O(1)/, worst-case /O(log n)/.  Insert an element into the priority queue.-insert :: Ord a => a -> MinQueue a -> MinQueue a-insert = insert' (<=)---- | Amortized /O(log (min(n,m)))/, worst-case /O(log (max (n,m)))/.  Take the union of two priority queues.-union :: Ord a => MinQueue a -> MinQueue a -> MinQueue a-union = union' (<=)---- | /O(n)/.  Map elements and collect the 'Just' results.-mapMaybe :: Ord b => (a -> Maybe b) -> MinQueue a -> MinQueue b-mapMaybe _ Empty = Empty-mapMaybe f (MinQueue _ x ts) = maybe q' (`insert` q') (f x)-  where-    q' = mapMaybeQueue f (<=) (const Empty) Empty ts---- | /O(n)/.  Map elements and separate the 'Left' and 'Right' results.-mapEither :: (Ord b, Ord c) => (a -> Either b c) -> MinQueue a -> (MinQueue b, MinQueue c)-mapEither _ Empty = (Empty, Empty)-mapEither f (MinQueue _ x ts) = case (mapEitherQueue f (<=) (<=) (const (Empty, Empty)) (Empty, Empty) ts, f x) of-  ((qL, qR), Left b)  -> (insert b qL, qR)-  ((qL, qR), Right c) -> (qL, insert c qR)---- | /O(n)/.  Assumes that the function it is given is monotonic, and applies this function to every element of the priority queue,--- as in 'fmap'.  If it is not, the result is undefined.-mapMonotonic :: (a -> b) -> MinQueue a -> MinQueue b-mapMonotonic = mapU--{-# INLINE foldrAsc #-}--- | /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 -> MinQueue a -> b-foldrAsc _ z Empty = z-foldrAsc f z (MinQueue _ x ts) = x `f` foldrUnfold f z extractHeap ts--{-# INLINE foldrUnfold #-}--- | Equivalent to @foldr f z (unfoldr suc s0)@.-foldrUnfold :: (a -> c -> c) -> c -> (b -> Maybe (a, b)) -> b -> c-foldrUnfold f z suc s0 = unf s0 where-  unf s = case suc s of-    Nothing      -> z-    Just (x, s') -> x `f` unf s'---- | /O(n log n)/.  Performs a left-fold on the elements of a priority queue in ascending order.-foldlAsc :: Ord a => (b -> a -> b) -> b -> MinQueue a -> b-foldlAsc _ z Empty             = z-foldlAsc f z (MinQueue _ x ts) = foldlUnfold f (z `f` x) extractHeap ts--{-# INLINE foldlUnfold #-}--- | @foldlUnfold f z suc s0@ is equivalent to @foldl f z (unfoldr suc s0)@.-foldlUnfold :: (c -> a -> c) -> c -> (b -> Maybe (a, b)) -> b -> c-foldlUnfold f z0 suc s0 = unf z0 s0 where-  unf z s = case suc s of-    Nothing      -> z-    Just (x, s') -> unf (z `f` x) s'--insert' :: LEq a -> a -> MinQueue a -> MinQueue a-insert' _ x Empty = singleton x-insert' le x (MinQueue n x' ts)-  | x `le` x' = MinQueue (n+1) x (incr le (tip x') ts)-  | otherwise = MinQueue (n+1) x' (incr le (tip x) ts)--{-# INLINE union' #-}-union' :: LEq a -> MinQueue a -> MinQueue a -> MinQueue a-union' _ Empty q = q-union' _ q Empty = q-union' le (MinQueue n1 x1 f1) (MinQueue n2 x2 f2)-  | x1 `le` x2 = MinQueue (n1 + n2) x1 (carry le (tip x2) f1 f2)-  | otherwise  = MinQueue (n1 + n2) x2 (carry le (tip x1) f1 f2)---- | Takes a size and a binomial forest and produces a priority queue with a distinguished global root.-extractHeap :: Ord a => BinomHeap a -> Maybe (a, BinomHeap a)-extractHeap ts = case extractBin (<=) ts of-  Yes (Extract x _ ts') -> Just (x, ts')-  _                     -> Nothing---- | A specialized type intended to organize the return of extract-min queries--- from a binomial forest.  We walk all the way through the forest, and then--- walk backwards.  @Extract rk a@ is the result type of an extract-min--- operation that has walked as far backwards of rank @rk@ -- that is, it--- has visited every root of rank @>= rk@.------ The interpretation of @Extract minKey children forest@ is------   * @minKey@ is the key of the minimum root visited so far.  It may have---     any rank @>= rk@.  We will denote the root corresponding to---     @minKey@ as @minRoot@.------   * @children@ is those children of @minRoot@ which have not yet been---     merged with the rest of the forest. Specifically, these are---     the children with rank @< rk@.------   * @forest@ is an accumulating parameter that maintains the partial---     reconstruction of the binomial forest without @minRoot@. It is---     the union of all old roots with rank @>= rk@ (except @minRoot@),---     with the set of all children of @minRoot@ with rank @>= rk@.---     Note that @forest@ is lazy, so if we discover a smaller key---     than @minKey@ later, we haven't wasted significant work.-data Extract rk a = Extract a (rk a) (BinomForest rk a)-data MExtract rk a = No | Yes {-# UNPACK #-} !(Extract rk a)--incrExtract :: Extract (Succ rk) a -> Extract rk a-incrExtract (Extract minKey (Succ kChild kChildren) ts)-  = Extract minKey kChildren (Cons kChild ts)--incrExtract' :: LEq a -> BinomTree rk a -> Extract (Succ rk) a -> Extract rk a-incrExtract' le t (Extract minKey (Succ kChild kChildren) ts)-  = Extract minKey kChildren (Skip (incr le (t `cat` kChild) ts))-  where-    cat = joinBin le---- | Walks backward from the biggest key in the forest, as far as rank @rk@.--- Returns its progress.  Each successive application of @extractBin@ takes--- amortized /O(1)/ time, so applying it from the beginning takes /O(log n)/ time.-extractBin :: LEq a -> BinomForest rk a -> MExtract rk a-extractBin _ Nil = No-extractBin le (Skip f) = case extractBin le f of-  Yes ex -> Yes (incrExtract ex)-  No     -> No-extractBin le (Cons t@(BinomTree x ts) f) = Yes $ case extractBin le f of-  Yes ex@(Extract minKey _ _)-    | minKey `lt` x -> incrExtract' le t ex-  _                 -> Extract x ts (Skip f)-  where a `lt` b = not (b `le` a)--mapMaybeQueue :: (a -> Maybe b) -> LEq b -> (rk a -> MinQueue b) -> MinQueue b -> BinomForest rk a -> MinQueue b-mapMaybeQueue f le fCh q0 forest = q0 `seq` case forest of-  Nil    -> q0-  Skip forest'  -> mapMaybeQueue f le fCh' q0 forest'-  Cons t forest'  -> mapMaybeQueue f le fCh' (union' le (mapMaybeT t) q0) forest'-  where fCh' (Succ t tss) = union' le (mapMaybeT t) (fCh tss)-        mapMaybeT (BinomTree x0 ts) = maybe (fCh ts) (\ x -> insert' le x (fCh ts)) (f x0)--type Partition a b = (MinQueue a, MinQueue b)--mapEitherQueue :: (a -> Either b c) -> LEq b -> LEq c -> (rk a -> Partition b c) -> Partition b c ->-  BinomForest rk a -> Partition b c-mapEitherQueue f0 leB leC fCh (q00, q10) ts0 = q00 `seq` q10 `seq` case ts0 of-  Nil        -> (q00, q10)-  Skip ts'   -> mapEitherQueue f0 leB leC fCh' (q00, q10) ts'-  Cons t ts' -> mapEitherQueue f0 leB leC fCh' (both (union' leB) (union' leC) (partitionT t) (q00, q10)) ts'-  where  both f g (x1, x2) (y1, y2) = (f x1 y1, g x2 y2)-         fCh' (Succ t tss) = both (union' leB) (union' leC) (partitionT t) (fCh tss)-         partitionT (BinomTree x ts) = case fCh ts of-           (q0, q1) -> case f0 x of-             Left b  -> (insert' leB b q0, q1)-             Right c  -> (q0, insert' leC c q1)--{-# INLINE tip #-}--- | Constructs a binomial tree of rank 0.-tip :: a -> BinomTree Zero a-tip x = BinomTree x Zero--insertMinQ :: a -> MinQueue a -> MinQueue a-insertMinQ x Empty = singleton x-insertMinQ x (MinQueue n x' f) = MinQueue (n+1) x (insertMin (tip x') f)---- | @insertMin t f@ assumes that the root of @t@ compares as less than--- every other root in @f@, and merges accordingly.-insertMin :: BinomTree rk a -> BinomForest rk a -> BinomForest rk a-insertMin t Nil = Cons t Nil-insertMin t (Skip f) = Cons t f-insertMin (BinomTree x ts) (Cons t' f) = Skip (insertMin (BinomTree x (Succ t' ts)) f)---- | Given two binomial forests starting at rank @rk@, takes their union.--- Each successive application of this function costs /O(1)/, so applying it--- from the beginning costs /O(log n)/.-merge :: LEq a -> BinomForest rk a -> BinomForest rk a -> BinomForest rk a-merge le f1 f2 = case (f1, f2) of-  (Skip f1', Skip f2')    -> Skip (merge le f1' f2')-  (Skip f1', Cons t2 f2') -> Cons t2 (merge le f1' f2')-  (Cons t1 f1', Skip f2') -> Cons t1 (merge le f1' f2')-  (Cons t1 f1', Cons t2 f2')-        -> Skip (carry le (t1 `cat` t2) f1' f2')-  (Nil, _)                -> f2-  (_, Nil)                -> f1-  where  cat = joinBin le---- | Merges two binomial forests with another tree. If we are thinking of the trees--- in the binomial forest as binary digits, this corresponds to a carry operation.--- Each call to this function takes /O(1)/ time, so in total, it costs /O(log n)/.-carry :: LEq a -> BinomTree rk a -> BinomForest rk a -> BinomForest rk a -> BinomForest rk a-carry le t0 f1 f2 = t0 `seq` case (f1, f2) of-  (Skip f1', Skip f2')    -> Cons t0 (merge le f1' f2')-  (Skip f1', Cons t2 f2') -> Skip (mergeCarry t0 t2 f1' f2')-  (Cons t1 f1', Skip f2') -> Skip (mergeCarry t0 t1 f1' f2')-  (Cons t1 f1', Cons t2 f2')-        -> Cons t0 (mergeCarry t1 t2 f1' f2')-  (Nil, _f2)              -> incr le t0 f2-  (_f1, Nil)              -> incr le t0 f1-  where  cat = joinBin le-         mergeCarry tA tB = carry le (tA `cat` tB)---- | Merges a binomial tree into a binomial forest.  If we are thinking--- of the trees in the binomial forest as binary digits, this corresponds--- to adding a power of 2.  This costs amortized /O(1)/ time.-incr :: LEq a -> BinomTree rk a -> BinomForest rk a -> BinomForest rk a-incr le t f0 = t `seq` case f0 of-  Nil  -> Cons t Nil-  Skip f     -> Cons t f-  Cons t' f' -> Skip (incr le (t `cat` t') f')-  where  cat = joinBin le---- | The carrying operation: takes two binomial heaps of the same rank @k@--- and returns one of rank @k+1@.  Takes /O(1)/ time.-joinBin :: LEq a -> BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a-joinBin le t1@(BinomTree x1 ts1) t2@(BinomTree x2 ts2)-  | x1 `le` x2 = BinomTree x1 (Succ t2 ts1)-  | otherwise  = BinomTree x2 (Succ t1 ts2)--instance Functor Zero where-  fmap _ _ = Zero--instance Functor rk => Functor (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 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 Foldable Zero where-  foldr _ z _ = z-  foldl _ z _ = z--instance Foldable rk => Foldable (Succ rk) where-  foldr f z (Succ t ts) = foldr f (foldr f z ts) t-  foldl f z (Succ t ts) = foldl f (foldl f z t) ts--instance Foldable rk => Foldable (BinomTree rk) where-  foldr f z (BinomTree x ts) = x `f` foldr f z ts-  foldl f z (BinomTree x ts) = foldl f (z `f` x) ts--instance Foldable rk => Foldable (BinomForest rk) where-  foldr _ z Nil          = z-  foldr f z (Skip tss)   = foldr f z tss-  foldr f z (Cons t tss) = foldr f (foldr f z tss) t-  foldl _ z Nil          = z-  foldl f z (Skip tss)   = foldl f z tss-  foldl f z (Cons t tss) = foldl f (foldl f z t) tss---- instance Traversable Zero where---   traverse _ _ = pure Zero------ instance Traversable rk => Traversable (Succ rk) where---   traverse f (Succ t ts) = Succ <$> traverse f t <*> traverse f ts------ instance Traversable rk => Traversable (BinomTree rk) where---   traverse f (BinomTree x ts) = BinomTree <$> f x <*> traverse f ts------ instance Traversable rk => Traversable (BinomForest rk) where---   traverse _ Nil = pure Nil---   traverse f (Skip tss) = Skip <$> traverse f tss---   traverse f (Cons t tss) = Cons <$> traverse f t <*> traverse f tss--mapU :: (a -> b) -> MinQueue a -> MinQueue b-mapU _ Empty = Empty-mapU f (MinQueue n x ts) = MinQueue n (f x) (f <$> ts)---- | /O(n)/.  Unordered right fold on a priority queue.-foldrU :: (a -> b -> b) -> b -> MinQueue a -> b-foldrU _ z Empty = z-foldrU f z (MinQueue _ x ts) = x `f` foldr f z ts---- | /O(n)/.  Unordered left fold on a priority queue.-foldlU :: (b -> a -> b) -> b -> MinQueue a -> b-foldlU _ z Empty = z-foldlU f z (MinQueue _ x ts) = foldl f (z `f` x) ts---- traverseU :: Applicative f => (a -> f b) -> MinQueue a -> f (MinQueue b)--- traverseU _ Empty = pure Empty--- traverseU f (MinQueue n x ts) = MinQueue n <$> f x <*> traverse f ts---- | Forces the spine of the priority queue.-seqSpine :: MinQueue a -> b -> b-seqSpine Empty z = z-seqSpine (MinQueue _ _ ts) z = seqSpineF ts z--seqSpineF :: BinomForest rk a -> b -> b-seqSpineF Nil z          = z-seqSpineF (Skip ts') z   = seqSpineF ts' z-seqSpineF (Cons _ ts') z = seqSpineF ts' z---- | Constructs a priority queue out of the keys of the specified 'Prio.MinPQueue'.-keysQueue :: Prio.MinPQueue k a -> MinQueue k-keysQueue Prio.Empty = Empty-keysQueue (Prio.MinPQ n k _ ts) = MinQueue n k (keysF (const Zero) ts)--keysF :: (pRk k a -> rk k) -> Prio.BinomForest pRk k a -> BinomForest rk k-keysF f ts0 = case ts0 of-  Prio.Nil       -> Nil-  Prio.Skip ts'  -> Skip (keysF f' ts')-  Prio.Cons (Prio.BinomTree k _ ts) ts'-    -> Cons (BinomTree k (f ts)) (keysF f' ts')-  where  f' (Prio.Succ (Prio.BinomTree k _ ts) tss) = Succ (BinomTree k (f ts)) (f tss)--class NFRank rk where-  rnfRk :: NFData a => rk a -> ()--instance NFRank Zero where-  rnfRk _ = ()--instance NFRank rk => NFRank (Succ rk) where-  rnfRk (Succ t ts) = t `deepseq` rnfRk ts--instance (NFData a, NFRank rk) => NFData (BinomTree rk a) where-  rnf (BinomTree x ts) = x `deepseq` rnfRk ts--instance (NFData a, NFRank rk) => NFData (BinomForest rk a) where-  rnf Nil         = ()-  rnf (Skip ts)   = rnf ts-  rnf (Cons t ts) = t `deepseq` rnf ts--instance NFData a => NFData (MinQueue a) where-  rnf Empty             = ()-  rnf (MinQueue _ x ts) = x `deepseq` rnf ts
− Data/PQueue/Max.hs 
@@ -1,349 +0,0 @@-{-# LANGUAGE CPP #-}---------------------------------------------------------------------------------- |--- Module      :  Data.PQueue.Max--- Copyright   :  (c) Louis Wasserman 2010--- License     :  BSD-style--- Maintainer  :  libraries@haskell.org--- Stability   :  experimental--- Portability :  portable------ General purpose priority queue, supporting view-maximum operations.------ An amortized running time is given for each operation, with /n/ referring--- to the length of the sequence and /k/ being the integral index used by--- some operations.  These bounds hold even in a persistent (shared) setting.------ This implementation is based on a binomial heap augmented with a global root.--- The spine of the heap is maintained lazily.  To force the spine of the heap,--- use 'seqSpine'.------ This implementation does not guarantee stable behavior.------ This implementation offers a number of methods of the form @xxxU@, where @U@ stands for--- unordered.  No guarantees whatsoever are made on the execution or traversal order of--- these functions.-------------------------------------------------------------------------------module Data.PQueue.Max (-  MaxQueue,-  -- * Basic operations-  empty,-  null,-  size,-  -- * Query operations-  findMax,-  getMax,-  deleteMax,-  deleteFindMax,-  delete,-  maxView,-  -- * Construction operations-  singleton,-  insert,-  union,-  unions,-  -- * Subsets-  -- ** Extracting subsets-  (!!),-  take,-  drop,-  splitAt,-  -- ** Predicates-  takeWhile,-  dropWhile,-  span,-  break,-  -- * Filter/Map-  filter,-  partition,-  mapMaybe,-  mapEither,-  -- * Fold\/Functor\/Traversable variations-  map,-  foldrAsc,-  foldlAsc,-  foldrDesc,-  foldlDesc,-  -- * List operations-  toList,-  toAscList,-  toDescList,-  fromList,-  fromAscList,-  fromDescList,-  -- * Unordered operations-  mapU,-  foldrU,-  foldlU,-  elemsU,-  toListU,-  -- * Miscellaneous operations-  keysQueue,-  seqSpine) where--import Control.DeepSeq (NFData(rnf))--import Data.Functor ((<$>))-import Data.Monoid (Monoid(mempty, mappend))-import Data.Maybe (fromMaybe)-import Data.Foldable (foldl, foldr)--#if MIN_VERSION_base(4,9,0)-import Data.Semigroup (Semigroup((<>)))-#endif--import qualified Data.PQueue.Min as Min-import qualified Data.PQueue.Prio.Max.Internals as Prio-import Data.PQueue.Prio.Max.Internals (Down(..))--import Prelude hiding (null, foldr, foldl, take, drop, takeWhile, dropWhile, splitAt, span, break, (!!), filter)--#ifdef __GLASGOW_HASKELL__-import GHC.Exts (build)-import Text.Read (Lexeme(Ident), lexP, parens, prec,-  readPrec, readListPrec, readListPrecDefault)-import Data.Data-#else-build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]-build f = f (:) []-#endif---- | A priority queue with elements of type @a@.  Supports extracting the maximum element.--- Implemented as a wrapper around 'Min.MinQueue'.-newtype MaxQueue a = MaxQ (Min.MinQueue (Down a))-# if __GLASGOW_HASKELL__-  deriving (Eq, Ord, Data, Typeable)-# else-  deriving (Eq, Ord)-# endif--instance NFData a => NFData (MaxQueue a) where-  rnf (MaxQ q) = rnf q--instance (Ord a, Show a) => Show (MaxQueue a) where-  showsPrec p xs = showParen (p > 10) $-    showString "fromDescList " . shows (toDescList xs)--instance Read a => Read (MaxQueue a) where-#ifdef __GLASGOW_HASKELL__-  readPrec = parens $ prec 10 $ do-    Ident "fromDescList" <- lexP-    xs <- readPrec-    return (fromDescList xs)--  readListPrec = readListPrecDefault-#else-  readsPrec p = readParen (p > 10) $ \ r -> do-    ("fromDescList",s) <- lex r-    (xs,t) <- reads s-    return (fromDescList xs,t)-#endif--#if MIN_VERSION_base(4,9,0)-instance Ord a => Semigroup (MaxQueue a) where-  (<>) = union-#endif--instance Ord a => Monoid (MaxQueue a) where-  mempty = empty-  mappend = union---- | /O(1)/.  The empty priority queue.-empty :: MaxQueue a-empty = MaxQ Min.empty---- | /O(1)/.  Is this the empty priority queue?-null :: MaxQueue a -> Bool-null (MaxQ q) = Min.null q---- | /O(1)/.  The number of elements in the queue.-size :: MaxQueue a -> Int-size (MaxQ q) = Min.size q---- | /O(1)/.  Returns the maximum element of the queue.  Throws an error on an empty queue.-findMax :: MaxQueue a -> a-findMax = fromMaybe (error "Error: findMax called on empty queue") . getMax---- | /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---- | /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)---- | /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)-deleteFindMax = fromMaybe (error "Error: deleteFindMax called on empty queue") . maxView---- | /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')---- | /O(log n)/.  Delete the top (maximum) element of the sequence, if there is one.-delete :: Ord a => MaxQueue a -> Maybe (MaxQueue a)-delete = fmap snd . maxView---- | /O(1)/.  Construct a priority queue with a single element.-singleton :: a -> MaxQueue a-singleton = MaxQ . Min.singleton . Down---- | /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)---- | /O(log (min(n1,n2)))/.  Take the union of two priority queues.-union :: Ord a => MaxQueue a -> MaxQueue a -> MaxQueue a-MaxQ q1 `union` MaxQ q2 = MaxQ (q1 `Min.union` q2)---- | 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])---- | /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)--{-# INLINE take #-}--- | /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]---- | /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)---- | /O(k log n)/.  Equivalent to @(take k queue, drop k queue)@.-splitAt :: Ord a => Int -> MaxQueue a -> ([a], MaxQueue a)-splitAt k (MaxQ q) = (map unDown xs, MaxQ q') where-  (xs, q') = Min.splitAt k q---- | '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) = map unDown (Min.takeWhile (p . unDown) q)---- | '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)---- | 'span', applied to a predicate @p@ and a queue @queue@, returns a tuple where--- first element is longest prefix (possibly empty) of @queue@ of elements that--- satisfy @p@ and second element is the remainder of the queue.----span :: Ord a => (a -> Bool) -> MaxQueue a -> ([a], MaxQueue a)-span p (MaxQ q) = (map unDown xs, MaxQ q') where-  (xs, q') = Min.span (p . unDown) q---- | '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--- /do not satisfy/ @p@ and second element is the remainder of the queue.-break :: Ord a => (a -> Bool) -> MaxQueue a -> ([a], MaxQueue a)-break p = span (not . p)---- | /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)---- | /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---- | /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)---- | /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---- | /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/.-mapU :: (a -> b) -> MaxQueue a -> MaxQueue b-mapU f (MaxQ q) = MaxQ (Min.mapU (\ (Down a) -> Down (f a)) q)---- | /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---- | /O(n)/.  Unordered left fold on a priority queue.-foldlU :: (b -> a -> b) -> b -> MaxQueue a -> b-foldlU f z (MaxQ q) = Min.foldlU (foldl f) z q--{-# INLINE elemsU #-}--- | Equivalent to 'toListU'.-elemsU :: MaxQueue a -> [a]-elemsU = toListU--{-# 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) = map unDown (Min.toListU q)---- | /O(n log n)/.  Performs a right-fold on the elements of a priority queue in ascending order.--- @'foldrAsc' f z q == 'foldlDesc' (flip f) z q@.-foldrAsc :: Ord a => (a -> b -> b) -> b -> MaxQueue a -> b-foldrAsc = foldlDesc . flip---- | /O(n log n)/.  Performs a left-fold on the elements of a priority queue in descending order.--- @'foldlAsc' f z q == 'foldrDesc' (flip f) z q@.-foldlAsc :: Ord a => (b -> a -> b) -> b -> MaxQueue a -> b-foldlAsc = foldrDesc . flip---- | /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---- | /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--{-# INLINE toAscList #-}--- | /O(n log n)/.  Extracts the elements of the priority queue in ascending order.-toAscList :: Ord a => MaxQueue a -> [a]-toAscList q = build (\ c nil -> foldrAsc c nil q)--- I can see no particular reason this does not simply forward to Min.toDescList. (lsp, 2016)--{-# INLINE toDescList #-}--- | /O(n log n)/.  Extracts the elements of the priority queue in descending order.-toDescList :: Ord a => MaxQueue a -> [a]-toDescList q = build (\ c nil -> foldrDesc c nil q)--- I can see no particular reason this does not simply forward to Min.toAscList. (lsp, 2016)--{-# INLINE toList #-}--- | /O(n log n)/.  Returns the elements of the priority queue in ascending order.  Equivalent to 'toDescList'.------ If the order of the elements is irrelevant, consider using 'toListU'.-toList :: Ord a => MaxQueue a -> [a]-toList (MaxQ q) = map unDown (Min.toList q)--{-# INLINE fromAscList #-}--- | /O(n)/.  Constructs a priority queue from an ascending list.  /Warning/: Does not check the precondition.-fromAscList :: [a] -> MaxQueue a-fromAscList = MaxQ . Min.fromDescList . map Down--{-# 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 . map Down--{-# INLINE fromList #-}--- | /O(n log n)/.  Constructs a priority queue from an unordered list.-fromList :: Ord a => [a] -> MaxQueue a-fromList = foldr insert empty---- | /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)---- | /O(log n)/.  Forces the spine of the heap.-seqSpine :: MaxQueue a -> b -> b-seqSpine (MaxQ q) = Min.seqSpine q
− Data/PQueue/Min.hs 
@@ -1,305 +0,0 @@-{-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}---------------------------------------------------------------------------------- |--- Module      :  Data.PQueue.Min--- Copyright   :  (c) Louis Wasserman 2010--- License     :  BSD-style--- Maintainer  :  libraries@haskell.org--- Stability   :  experimental--- Portability :  portable------ General purpose priority queue, supporting extract-minimum operations.------ An amortized running time is given for each operation, with /n/ referring--- to the length of the sequence and /k/ being the integral index used by--- some operations.  These bounds hold even in a persistent (shared) setting.------ This implementation is based on a binomial heap augmented with a global root.--- The spine of the heap is maintained lazily.  To force the spine of the heap,--- use 'seqSpine'.------ This implementation does not guarantee stable behavior.------ This implementation offers a number of methods of the form @xxxU@, where @U@ stands for--- unordered.  No guarantees whatsoever are made on the execution or traversal order of--- these functions.-------------------------------------------------------------------------------module Data.PQueue.Min (-  MinQueue,-  -- * Basic operations-  empty,-  null,-  size,-  -- * Query operations-  findMin,-  getMin,-  deleteMin,-  deleteFindMin,-  minView,-  -- * Construction operations-  singleton,-  insert,-  union,-  unions,-  -- * Subsets-  -- ** Extracting subsets-  (!!),-  take,-  drop,-  splitAt,-  -- ** Predicates-  takeWhile,-  dropWhile,-  span,-  break,-  -- * Filter/Map-  filter,-  partition,-  mapMaybe,-  mapEither,-  -- * Fold\/Functor\/Traversable variations-  map,-  foldrAsc,-  foldlAsc,-  foldrDesc,-  foldlDesc,-  -- * List operations-  toList,-  toAscList,-  toDescList,-  fromList,-  fromAscList,-  fromDescList,-  -- * Unordered operations-  mapU,-  foldrU,-  foldlU,-  elemsU,-  toListU,-  -- * Miscellaneous operations-  keysQueue,-  seqSpine) where--import Prelude hiding (null, foldr, foldl, take, drop, takeWhile, dropWhile, splitAt, span, break, (!!), filter, map)--import Data.Monoid (Monoid(mempty, mappend, mconcat))-import Data.Foldable (foldl, foldr, 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.PQueue.Internals--#ifdef __GLASGOW_HASKELL__-import GHC.Exts (build)-import Text.Read (Lexeme(Ident), lexP, parens, prec,-  readPrec, readListPrec, readListPrecDefault)-#else-build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]-build f = f (:) []-#endif---- instance--instance (Ord a, Show a) => Show (MinQueue a) where-  showsPrec p xs = showParen (p > 10) $-    showString "fromAscList " . shows (toAscList xs)--instance Read a => Read (MinQueue a) where-#ifdef __GLASGOW_HASKELL__-  readPrec = parens $ prec 10 $ do-    Ident "fromAscList" <- lexP-    xs <- readPrec-    return (fromAscList xs)--  readListPrec = readListPrecDefault-#else-  readsPrec p = readParen (p > 10) $ \ r -> do-    ("fromAscList",s) <- lex r-    (xs,t) <- reads s-    return (fromAscList xs,t)-#endif--#if MIN_VERSION_base(4,9,0)-instance Ord a => Semigroup (MinQueue a) where-  (<>) = union-#endif--instance Ord a => Monoid (MinQueue a) where-  mempty = empty-  mappend = union-  mconcat = unions---- | /O(1)/.  Returns the minimum element.  Throws an error on an empty queue.-findMin :: MinQueue a -> a-findMin = fromMaybe (error "Error: findMin called on empty queue") . getMin---- | /O(log n)/.  Deletes the minimum element.  If the queue is empty, does nothing.-deleteMin :: Ord a => MinQueue a -> MinQueue a-deleteMin q = case minView q of-  Nothing      -> empty-  Just (_, q') -> q'---- | /O(log n)/.  Extracts the minimum element.  Throws an error on an empty queue.-deleteFindMin :: Ord a => MinQueue a -> (a, MinQueue a)-deleteFindMin = fromMaybe (error "Error: deleteFindMin called on empty queue") . minView---- | Takes the union of a list of priority queues.  Equivalent to @'foldl' 'union' 'empty'@.-unions :: Ord a => [MinQueue a] -> MinQueue a-unions = foldl union empty---- | /O(k log n)/.  Index (subscript) operator, starting from 0.  @queue !! k@ returns the @(k+1)@th smallest--- element in the queue.  Equivalent to @toAscList queue !! k@.-(!!) :: Ord a => MinQueue a -> Int -> a-q !! n  | n >= size q-    = error "Data.PQueue.Min.!!: index too large"-q !! n = (List.!!) (toAscList q) n--{-# INLINE takeWhile #-}--- | '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) -> MinQueue a -> [a]-takeWhile p = foldWhileFB p . toAscList--{-# INLINE foldWhileFB #-}--- | Equivalent to Data.List.takeWhile, but is a better producer.-foldWhileFB :: (a -> Bool) -> [a] -> [a]-foldWhileFB p xs0 = build (\ c nil -> let-  consWhile x xs-    | p x    = x `c` xs-    | otherwise  = nil-  in foldr consWhile nil xs0)---- | 'dropWhile' @p queue@ returns the queue remaining after 'takeWhile' @p queue@.-dropWhile :: Ord a => (a -> Bool) -> MinQueue a -> MinQueue a-dropWhile p = drop' where-  drop' q = case minView q of-    Just (x, q') | p x -> drop' q'-    _                  -> q---- | 'span', applied to a predicate @p@ and a queue @queue@, returns a tuple where--- first element is longest prefix (possibly empty) of @queue@ of elements that--- satisfy @p@ and second element is the remainder of the queue.-span :: Ord a => (a -> Bool) -> MinQueue a -> ([a], MinQueue a)-span p queue = case minView queue of-  Just (x, q')-    | p x  -> let (ys, q'') = span p q' in (x:ys, q'')-  _        -> ([], queue)---- | '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--- /do not satisfy/ @p@ and second element is the remainder of the queue.-break :: Ord a => (a -> Bool) -> MinQueue a -> ([a], MinQueue a)-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@,--- 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'@.-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)@.-splitAt :: Ord a => Int -> MinQueue a -> ([a], MinQueue a)-splitAt n queue = n `seq` case minView queue of-  Just (x, queue')-    | n > 0  -> let (xs, queue'') = splitAt (n-1) queue' in (x:xs, queue'')-  _          -> ([], queue)---- | /O(n)/.  Returns the queue with all elements not satisfying @p@ removed.-filter :: Ord a => (a -> Bool) -> MinQueue a -> MinQueue a-filter p = mapMaybe (\ x -> if p x then Just x else Nothing)---- | /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) -> MinQueue a -> (MinQueue a, MinQueue a)-partition p = mapEither (\ x -> if p x then Left x else Right x)---- | /O(n)/.  Creates a new priority queue containing the images of the elements of this queue.--- Equivalent to @'fromList' . 'Data.List.map' f . toList@.-map :: Ord b => (a -> b) -> MinQueue a -> MinQueue b-map f = foldrU (insert . f) empty--{-# INLINE toAscList #-}--- | /O(n log n)/.  Extracts the elements of the priority queue in ascending order.-toAscList :: Ord a => MinQueue a -> [a]-toAscList queue = build (\ c nil -> foldrAsc c nil queue)--{-# INLINE toDescList #-}--- | /O(n log n)/.  Extracts the elements of the priority queue in descending order.-toDescList :: Ord a => MinQueue a -> [a]-toDescList queue = build (\ c nil -> foldrDesc c nil queue)--{-# INLINE toList #-}--- | /O(n log n)/.  Returns the elements of the priority queue in ascending order.  Equivalent to 'toAscList'.------ If the order of the elements is irrelevant, consider using 'toListU'.-toList :: Ord a => MinQueue a -> [a]-toList = toAscList--{-# RULES-  "toAscList" forall q . toAscList q = build (\ c nil -> foldrAsc c nil q);-    -- inlining doesn't seem to be working out =/-  "toDescList" forall q . toDescList q = build (\ c nil -> foldrDesc c nil q);-  #-}---- | /O(n log n)/.  Performs a right-fold on the elements of a priority queue in descending order.--- @foldrDesc f z q == foldlAsc (flip f) z q@.-foldrDesc :: Ord a => (a -> b -> b) -> b -> MinQueue a -> b-foldrDesc = foldlAsc . flip---- | /O(n log n)/.  Performs a left-fold on the elements of a priority queue in descending order.--- @foldlDesc f z q == foldrAsc (flip f) z q@.-foldlDesc :: Ord a => (b -> a -> b) -> b -> MinQueue a -> b-foldlDesc = foldrAsc . flip--{-# INLINE fromList #-}--- | /O(n)/.  Constructs a priority queue from an unordered list.-fromList :: Ord a => [a] -> MinQueue a-fromList = foldr insert empty--{-# RULES-  "fromList" fromList = foldr insert empty;-  "fromAscList" fromAscList = foldr insertMinQ empty;-  #-}--{-# INLINE fromAscList #-}--- | /O(n)/.  Constructs a priority queue from an ascending list.  /Warning/: Does not check the precondition.-fromAscList :: [a] -> MinQueue a-fromAscList = foldr insertMinQ empty---- | /O(n)/.  Constructs a priority queue from an descending list.  /Warning/: Does not check the precondition.-fromDescList :: [a] -> MinQueue a-fromDescList = foldl' (flip insertMinQ) empty---- | Maps a function over the elements of the queue, ignoring order.  This function is only safe if the function is monotonic.--- This function /does not/ check the precondition.-mapU :: (a -> b) -> MinQueue a -> MinQueue b-mapU = mapMonotonic--{-# INLINE elemsU #-}--- | Equivalent to 'toListU'.-elemsU :: MinQueue a -> [a]-elemsU = toListU---- | /O(n)/.  Returns the elements of the queue, in no particular order.-toListU :: MinQueue a -> [a]-toListU q = build (\ c n -> foldrU c n q)--{-# RULES-  "foldr/toListU" forall f z q . foldr f z (toListU q) = foldrU f z q;-  "foldl/toListU" forall f z q . foldl f z (toListU q) = foldlU f z q;-  #-}
− Data/PQueue/Prio/Internals.hs 
@@ -1,493 +0,0 @@-{-# LANGUAGE CPP #-}-module Data.PQueue.Prio.Internals (-  MinPQueue(..),-  BinomForest(..),-  BinomHeap,-  BinomTree(..),-  Zero(..),-  Succ(..),-  CompF,-  empty,-  null,-  size,-  singleton,-  insert,-  insertBehind,-  union,-  getMin,-  adjustMinWithKey,-  updateMinWithKey,-  minViewWithKey,-  mapWithKey,-  mapKeysMonotonic,-  mapMaybeWithKey,-  mapEitherWithKey,-  foldrWithKey,-  foldlWithKey,-  insertMin,-  foldrWithKeyU,-  foldlWithKeyU,-  traverseWithKeyU,-  seqSpine,-  mapForest-  ) where--import Control.Applicative (Applicative(..), (<$>))-import Control.Applicative.Identity (Identity(Identity, runIdentity))-import Control.DeepSeq (NFData(rnf), deepseq)--import Data.Monoid ((<>))--import Prelude hiding (null)--#if __GLASGOW_HASKELL__--import Data.Data--instance (Data k, Data a, Ord k) => Data (MinPQueue k a) where-  gfoldl f z m   = z (foldr (uncurry' insertMin) empty) `f` foldrWithKey (curry (:)) [] m-  toConstr _     = error "toConstr"-  gunfold _ _    = error "gunfold"-  dataTypeOf _   = mkNoRepType "Data.PQueue.Prio.Min.MinPQueue"-  dataCast2 f    = gcast2 f--#endif--(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d-(f .: g) x y = f (g x y)--first' :: (a -> b) -> (a, c) -> (b, c)-first' f (a, c) = (f a, c)--second' :: (b -> c) -> (a, b) -> (a, c)-second' f (a, b) = (a, f b)--uncurry' :: (a -> b -> c) -> (a, b) -> c-uncurry' f (a, b) = f a b--infixr 8 .:---- | A priority queue where values of type @a@ are annotated with keys of type @k@.--- The queue supports extracting the element with minimum key.-data MinPQueue k a = Empty | MinPQ {-# UNPACK #-} !Int k a (BinomHeap k a)-#if __GLASGOW_HASKELL__-  deriving (Typeable)-#endif--data BinomForest rk k a =-  Nil |-  Skip (BinomForest (Succ rk) k a) |-  Cons {-# UNPACK #-} !(BinomTree rk k a) (BinomForest (Succ rk) k a)-type BinomHeap = BinomForest Zero--data BinomTree rk k a = BinomTree k a (rk k a)-data Zero k a = Zero-data Succ rk k a = Succ {-# UNPACK #-} !(BinomTree rk k a) (rk k a)--type CompF a = a -> a -> Bool--instance (Ord k, Eq a) => Eq (MinPQueue k a) where-  MinPQ n1 k1 a1 ts1 == MinPQ n2 k2 a2 ts2 =-    n1 == n2 && eqExtract k1 a1 ts1 k2 a2 ts2-  Empty == Empty = True-  _     == _     = False--eqExtract ::-  (Ord k, Eq a) =>-  k -> a -> BinomForest rk k a ->-  k -> a -> BinomForest rk k a ->-  Bool-eqExtract k10 a10 ts10 k20 a20 ts20 =-  k10 == k20 && a10 == a20 &&-  case (extract ts10, extract ts20) of-    (Yes (Extract k1 a1 _ ts1'), Yes (Extract k2 a2 _ ts2'))-             -> eqExtract k1 a1 ts1' k2 a2 ts2'-    (No, No) -> True-    _        -> False--instance (Ord k, Ord a) => Ord (MinPQueue k a) where-  MinPQ _n1 k10 a10 ts10 `compare` MinPQ _n2 k20 a20 ts20 =-    cmpExtract k10 a10 ts10 k20 a20 ts20-  Empty `compare` Empty   = EQ-  Empty `compare` MinPQ{} = LT-  MinPQ{} `compare` Empty = GT--cmpExtract ::-  (Ord k, Ord a) =>-  k -> a -> BinomForest rk k a ->-  k -> a -> BinomForest rk k a ->-  Ordering-cmpExtract k10 a10 ts10 k20 a20 ts20 =-  k10 `compare` k20 <> a10 `compare` a20 <>-  case (extract ts10, extract ts20) of-    (Yes (Extract k1 a1 _ ts1'), Yes (Extract k2 a2 _ ts2'))-                -> cmpExtract k1 a1 ts1' k2 a2 ts2'-    (No, Yes{}) -> LT-    (Yes{}, No) -> GT-    (No, No)    -> EQ---- | /O(1)/.  Returns the empty priority queue.-empty :: MinPQueue k a-empty = Empty---- | /O(1)/.  Checks if this priority queue is empty.-null :: MinPQueue k a -> Bool-null Empty = True-null _     = False---- | /O(1)/.  Returns the size of this priority queue.-size :: MinPQueue k a -> Int-size Empty           = 0-size (MinPQ n _ _ _) = n---- | /O(1)/.  Constructs a singleton priority queue.-singleton :: k -> a -> MinPQueue k a-singleton k a = MinPQ 1 k a Nil---- | Amortized /O(1)/, worst-case /O(log n)/.  Inserts--- an element with the specified key into the queue.-insert :: Ord k => k -> a -> MinPQueue k a -> MinPQueue k a-insert = insert' (<=)---- | /O(n)/ (an earlier implementation had /O(1)/ but was buggy).---   Insert an element with the specified key into the priority queue,---   putting it behind elements whose key compares equal to the---   inserted one.-insertBehind :: Ord k => k -> a -> MinPQueue k a -> MinPQueue k a-insertBehind k v q =-  let (smaller, larger) = spanKey (<= k) q-  in  foldr (uncurry insert) (insert k v larger) smaller--spanKey :: Ord k => (k -> Bool) -> MinPQueue k a -> ([(k, a)], MinPQueue k a)-spanKey p q = case minViewWithKey q of-  Just (t@(k, _), q') | p k ->-    let (kas, q'') = spanKey p q' in (t : kas, q'')-  _ -> ([], q)---- | Internal helper method, using a specific comparator function.-insert' :: CompF k -> k -> a -> MinPQueue k a -> MinPQueue k a-insert' _ k a Empty = singleton k a-insert' le k a (MinPQ n k' a' ts)-  | k `le` k'  = MinPQ (n+1) k  a  (incr le (tip k' a') ts)-  | otherwise  = MinPQ (n+1) k' a' (incr le (tip k  a ) ts)---- | Amortized /O(log(min(n1, n2)))/, worst-case /O(log(max(n1, n2)))/.  Returns the union--- of the two specified queues.-union :: Ord k => MinPQueue k a -> MinPQueue k a -> MinPQueue k a-union = union' (<=)---- | Takes the union of the two specified queues, using the given comparison function.-union' :: CompF k -> MinPQueue k a -> MinPQueue k a -> MinPQueue k a-union' le (MinPQ n1 k1 a1 ts1) (MinPQ n2 k2 a2 ts2)-  | k1 `le` k2 = MinPQ (n1 + n2) k1 a1 (insMerge k2 a2)-  | otherwise  = MinPQ (n1 + n2) k2 a2 (insMerge k1 a1)-  where  insMerge k a = carryForest le (tip k a) ts1 ts2-union' _ Empty q2 = q2-union' _ q1 Empty = q1---- | /O(1)/.  The minimal (key, element) in the queue, if the queue is nonempty.-getMin :: MinPQueue k a -> Maybe (k, a)-getMin (MinPQ _ k a _) = Just (k, a)-getMin _               = Nothing---- | /O(1)/.  Alter the value at the minimum key.  If the queue is empty, does nothing.-adjustMinWithKey :: (k -> a -> a) -> MinPQueue k a -> MinPQueue k a-adjustMinWithKey _ Empty = Empty-adjustMinWithKey f (MinPQ n k a ts) = MinPQ n k (f k a) ts---- | /O(log n)/.  (Actually /O(1)/ if there's no deletion.)  Update the value at the minimum key.--- If the queue is empty, does nothing.-updateMinWithKey :: Ord k => (k -> a -> Maybe a) -> MinPQueue k a -> MinPQueue k a-updateMinWithKey _ Empty = Empty-updateMinWithKey f (MinPQ n k a ts) = case f k a of-  Nothing  -> extractHeap (<=) n ts-  Just a'  -> MinPQ n k a' ts---- | /O(log n)/.  Retrieves the minimal (key, value) pair of the map, and the map stripped of that--- element, or 'Nothing' if passed an empty map.-minViewWithKey :: Ord k => MinPQueue k a -> Maybe ((k, a), MinPQueue k a)-minViewWithKey Empty            = Nothing-minViewWithKey (MinPQ n k a ts) = Just ((k, a), extractHeap (<=) n ts)---- | /O(n)/.  Map a function over all values in the queue.-mapWithKey :: (k -> a -> b) -> MinPQueue k a -> MinPQueue k b-mapWithKey f = runIdentity . traverseWithKeyU (Identity .: f)---- | /O(n)/.  @'mapKeysMonotonic' f q == 'mapKeys' f q@, but only works when @f@ is strictly--- monotonic.  /The precondition is not checked./  This function has better performance than--- 'mapKeys'.-mapKeysMonotonic :: (k -> k') -> MinPQueue k a -> MinPQueue k' a-mapKeysMonotonic _ Empty = Empty-mapKeysMonotonic f (MinPQ n k a ts) = MinPQ n (f k) a (mapKeysMonoF f (const Zero) ts)---- | /O(n)/.  Map values and collect the 'Just' results.-mapMaybeWithKey :: Ord k => (k -> a -> Maybe b) -> MinPQueue k a -> MinPQueue k b-mapMaybeWithKey _ Empty            = Empty-mapMaybeWithKey f (MinPQ _ k a ts) = maybe id (insert k) (f k a) (mapMaybeF (<=) f (const Empty) ts)---- | /O(n)/.  Map values and separate the 'Left' and 'Right' results.-mapEitherWithKey :: Ord k => (k -> a -> Either b c) -> MinPQueue k a -> (MinPQueue k b, MinPQueue k c)-mapEitherWithKey _ Empty            = (Empty, Empty)-mapEitherWithKey f (MinPQ _ k a ts) = either (first' . insert k) (second' . insert k) (f k a)-  (mapEitherF (<=) f (const (Empty, Empty)) ts)---- | /O(n log n)/.  Fold the keys and values in the map, such that--- @'foldrWithKey' f z q == 'List.foldr' ('uncurry' f) z ('toAscList' q)@.------ If you do not care about the traversal order, consider using 'foldrWithKeyU'.-foldrWithKey :: Ord k => (k -> a -> b -> b) -> b -> MinPQueue k a -> b-foldrWithKey _ z Empty = z-foldrWithKey f z (MinPQ _ k0 a0 ts0) = f k0 a0 (foldF ts0) where-  foldF ts = case extract ts of-    Yes (Extract k a _ ts') -> f k a (foldF ts')-    _                       -> z---- | /O(n log n)/.  Fold the keys and values in the map, such that--- @'foldlWithKey' f z q == 'List.foldl' ('uncurry' . f) z ('toAscList' q)@.------ If you do not care about the traversal order, consider using 'foldlWithKeyU'.-foldlWithKey :: Ord k => (b -> k -> a -> b) -> b -> MinPQueue k a -> b-foldlWithKey _ z Empty = z-foldlWithKey f z0 (MinPQ _ k0 a0 ts0) = foldF (f z0 k0 a0) ts0 where-  foldF z ts = case extract ts of-    Yes (Extract k a _ ts') -> foldF (f z k a) ts'-    _                       -> z---- | Equivalent to 'insert', save the assumption that this key is @<=@--- every other key in the map.  /The precondition is not checked./-insertMin :: k -> a -> MinPQueue k a -> MinPQueue k a-insertMin k a Empty = MinPQ 1 k a Nil-insertMin k a (MinPQ n k' a' ts) = MinPQ (n+1) k a (incrMin (tip k' a') ts)---- | /O(1)/.  Returns a binomial tree of rank zero containing this--- key and value.-tip :: k -> a -> BinomTree Zero k a-tip k a = BinomTree k a Zero---- | /O(1)/.  Takes the union of two binomial trees of the same rank.-meld :: CompF k -> BinomTree rk k a -> BinomTree rk k a -> BinomTree (Succ rk) k a-meld le t1@(BinomTree k1 v1 ts1) t2@(BinomTree k2 v2 ts2)-  | k1 `le` k2 = BinomTree k1 v1 (Succ t2 ts1)-  | otherwise  = BinomTree k2 v2 (Succ t1 ts2)---- | Takes the union of two binomial forests, starting at the same rank.  Analogous to binary addition.-mergeForest :: CompF k -> BinomForest rk k a -> BinomForest rk k a -> BinomForest rk k a-mergeForest le f1 f2 = case (f1, f2) of-  (Skip ts1, Skip ts2)       -> Skip (mergeForest le ts1 ts2)-  (Skip ts1, Cons t2 ts2)    -> Cons t2 (mergeForest le ts1 ts2)-  (Cons t1 ts1, Skip ts2)    -> Cons t1 (mergeForest le ts1 ts2)-  (Cons t1 ts1, Cons t2 ts2) -> Skip (carryForest le (meld le t1 t2) ts1 ts2)-  (Nil, _)                   -> f2-  (_, Nil)                   -> f1---- | Takes the union of two binomial forests, starting at the same rank, with an additional tree.--- Analogous to binary addition when a digit has been carried.-carryForest :: CompF k -> BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a -> BinomForest rk k a-carryForest le t0 f1 f2 = t0 `seq` case (f1, f2) of-  (Cons t1 ts1, Cons t2 ts2) -> Cons t0 (carryMeld t1 t2 ts1 ts2)-  (Cons t1 ts1, Skip ts2)    -> Skip (carryMeld t0 t1 ts1 ts2)-  (Skip ts1, Cons t2 ts2)    -> Skip (carryMeld t0 t2 ts1 ts2)-  (Skip ts1, Skip ts2)       -> Cons t0 (mergeForest le ts1 ts2)-  (Nil, _)                   -> incr le t0 f2-  (_, Nil)                   -> incr le t0 f1-  where  carryMeld = carryForest le .: meld le---- | Inserts a binomial tree into a binomial forest.  Analogous to binary incrementation.-incr :: CompF k -> BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a-incr le t ts = t `seq` case ts of-  Nil         -> Cons t Nil-  Skip ts'    -> Cons t ts'-  Cons t' ts' -> Skip (incr le (meld le t t') ts')---- | Inserts a binomial tree into a binomial forest.  Assumes that the root of this tree--- is less than all other roots.  Analogous to binary incrementation.  Equivalent to--- @'incr' (\ _ _ -> True)@.-incrMin :: BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a-incrMin t@(BinomTree k a ts) tss = case tss of-  Nil          -> Cons t Nil-  Skip tss'    -> Cons t tss'-  Cons t' tss' -> Skip (incrMin (BinomTree k a (Succ t' ts)) tss')--extractHeap :: CompF k -> Int -> BinomHeap k a -> MinPQueue k a-extractHeap le n ts = n `seq` case extractForest le ts of-  No                      -> Empty-  Yes (Extract k a _ ts') -> MinPQ (n-1) k a ts'---- | A specialized type intended to organize the return of extract-min queries--- from a binomial forest.  We walk all the way through the forest, and then--- walk backwards.  @Extract rk a@ is the result type of an extract-min--- operation that has walked as far backwards of rank @rk@ -- that is, it--- has visited every root of rank @>= rk@.------ The interpretation of @Extract minKey minVal children forest@ is------   * @minKey@ is the key of the minimum root visited so far.  It may have---     any rank @>= rk@.  We will denote the root corresponding to---     @minKey@ as @minRoot@.------   * @minVal@ is the value corresponding to @minKey@.------   * @children@ is those children of @minRoot@ which have not yet been---     merged with the rest of the forest. Specifically, these are---     the children with rank @< rk@.------   * @forest@ is an accumulating parameter that maintains the partial---     reconstruction of the binomial forest without @minRoot@. It is---     the union of all old roots with rank @>= rk@ (except @minRoot@),---     with the set of all children of @minRoot@ with rank @>= rk@.---     Note that @forest@ is lazy, so if we discover a smaller key---     than @minKey@ later, we haven't wasted significant work.--data Extract rk k a = Extract k a (rk k a) (BinomForest rk k a)-data MExtract rk k a = No | Yes {-# UNPACK #-} !(Extract rk k a)--incrExtract :: CompF k -> Maybe (BinomTree rk k a) -> Extract (Succ rk) k a -> Extract rk k a-incrExtract _ Nothing (Extract k a (Succ t ts) tss)-  = Extract k a ts (Cons t tss)-incrExtract le (Just t) (Extract k a (Succ t' ts) tss)-  = Extract k a ts (Skip (incr le (meld le t t') tss))---- | Walks backward from the biggest key in the forest, as far as rank @rk@.--- Returns its progress.  Each successive application of @extractBin@ takes--- amortized /O(1)/ time, so applying it from the beginning takes /O(log n)/ time.-extractForest :: CompF k -> BinomForest rk k a -> MExtract rk k a-extractForest _ Nil = No-extractForest le (Skip tss) = case extractForest le tss of-  No     -> No-  Yes ex -> Yes (incrExtract le Nothing ex)-extractForest le (Cons t@(BinomTree k a0 ts) tss) = Yes $ case extractForest le tss of-  Yes ex@(Extract k' _ _ _)-    | k' <? k  -> incrExtract le (Just t) ex-  _            -> Extract k a0 ts (Skip tss)-  where-    a <? b = not (b `le` a)--extract :: (Ord k) => BinomForest rk k a -> MExtract rk k a-extract = extractForest (<=)---- | Utility function for mapping over a forest.-mapForest :: (k -> a -> b) -> (rk k a -> rk k b) -> BinomForest rk k a -> BinomForest rk k b-mapForest f fCh ts0 = case ts0 of-  Nil      -> Nil-  Skip ts' -> Skip (mapForest f fCh' ts')-  Cons (BinomTree k a ts) tss-           -> Cons (BinomTree k (f k a) (fCh ts)) (mapForest f fCh' tss)-  where fCh' (Succ (BinomTree k a ts) tss)-           = Succ (BinomTree k (f k a) (fCh ts)) (fCh tss)---- | Utility function for mapping a 'Maybe' function over a forest.-mapMaybeF :: CompF k -> (k -> a -> Maybe b) -> (rk k a -> MinPQueue k b) ->-  BinomForest rk k a -> MinPQueue k b-mapMaybeF le f fCh ts0 = case ts0 of-  Nil    -> Empty-  Skip ts'  -> mapMaybeF le f fCh' ts'-  Cons (BinomTree k a ts) ts'-      -> insF k a (fCh ts) (mapMaybeF le f fCh' ts')-  where  insF k a = maybe id (insert' le k) (f k a) .: union' le-         fCh' (Succ (BinomTree k a ts) tss) =-           insF k a (fCh ts) (fCh tss)---- | Utility function for mapping an 'Either' function over a forest.-mapEitherF :: CompF k -> (k -> a -> Either b c) -> (rk k a -> (MinPQueue k b, MinPQueue k c)) ->-  BinomForest rk k a -> (MinPQueue k b, MinPQueue k c)-mapEitherF le f0 fCh ts0 = case ts0 of-  Nil    -> (Empty, Empty)-  Skip ts'  -> mapEitherF le f0 fCh' ts'-  Cons (BinomTree k a ts) ts'-      -> insF k a (fCh ts) (mapEitherF le f0 fCh' ts')-  where-    insF k a = either (first' . insert' le k) (second' . insert' le k) (f0 k a) .:-      (union' le `both` union' le)-    fCh' (Succ (BinomTree k a ts) tss) =-      insF k a (fCh ts) (fCh tss)-    both f g (x1, x2) (y1, y2) = (f x1 y1, g x2 y2)---- | /O(n)/.  An unordered right fold over the elements of the queue, in no particular order.-foldrWithKeyU :: (k -> a -> b -> b) -> b -> MinPQueue k a -> b-foldrWithKeyU _ z Empty            = z-foldrWithKeyU f z (MinPQ _ k a ts) = f k a (foldrWithKeyF_ f (const id) ts z)---- | /O(n)/.  An unordered left fold over the elements of the queue, in no particular order.-foldlWithKeyU :: (b -> k -> a -> b) -> b -> MinPQueue k a -> b-foldlWithKeyU _ z Empty = z-foldlWithKeyU f z0 (MinPQ _ k0 a0 ts) = foldlWithKeyF_ (\ k a z -> f z k a) (const id) ts (f z0 k0 a0)--traverseWithKeyU :: Applicative f => (k -> a -> f b) -> MinPQueue k a -> f (MinPQueue k b)-traverseWithKeyU _ Empty = pure Empty-traverseWithKeyU f (MinPQ n k a ts) = MinPQ n k <$> f k a <*> traverseForest f (const (pure Zero)) ts--{-# SPECIALIZE traverseForest :: (k -> a -> Identity b) -> (rk k a -> Identity (rk k b)) -> BinomForest rk k a ->-  Identity (BinomForest rk k b) #-}-traverseForest :: (Applicative f) => (k -> a -> f b) -> (rk k a -> f (rk k b)) -> BinomForest rk k a -> f (BinomForest rk k b)-traverseForest f fCh ts0 = case ts0 of-  Nil       -> pure Nil-  Skip ts'  -> Skip <$> traverseForest f fCh' ts'-  Cons (BinomTree k a ts) tss-    -> Cons <$> (BinomTree k <$> f k a <*> fCh ts) <*> traverseForest f fCh' tss-  where-    fCh' (Succ (BinomTree k a ts) tss)-      = Succ <$> (BinomTree k <$> f k a <*> fCh ts) <*> fCh tss---- | Unordered right fold on a binomial forest.-foldrWithKeyF_ :: (k -> a -> b -> b) -> (rk k a -> b -> b) -> BinomForest rk k a -> b -> b-foldrWithKeyF_ f fCh ts0 z0 = case ts0 of-  Nil    -> z0-  Skip ts'  -> foldrWithKeyF_ f fCh' ts' z0-  Cons (BinomTree k a ts) ts'-    -> f k a (fCh ts (foldrWithKeyF_ f fCh' ts' z0))-  where-    fCh' (Succ (BinomTree k a ts) tss) z =-      f k a (fCh ts (fCh tss z))---- | Unordered left fold on a binomial forest.-foldlWithKeyF_ :: (k -> a -> b -> b) -> (rk k a -> b -> b) -> BinomForest rk k a -> b -> b-foldlWithKeyF_ f fCh ts0 = case ts0 of-  Nil    -> id-  Skip ts'  -> foldlWithKeyF_ f fCh' ts'-  Cons (BinomTree k a ts) ts'-    -> foldlWithKeyF_ f fCh' ts' . fCh ts . f k a-  where-    fCh' (Succ (BinomTree k a ts) tss) =-      fCh tss . fCh ts . f k a---- | Maps a monotonic function over the keys in a binomial forest.-mapKeysMonoF :: (k -> k') -> (rk k a -> rk k' a) -> BinomForest rk k a -> BinomForest rk k' a-mapKeysMonoF f fCh ts0 = case ts0 of-  Nil    -> Nil-  Skip ts'  -> Skip (mapKeysMonoF f fCh' ts')-  Cons (BinomTree k a ts) ts'-    -> Cons (BinomTree (f k) a (fCh ts)) (mapKeysMonoF f fCh' ts')-  where-    fCh' (Succ (BinomTree k a ts) tss) =-      Succ (BinomTree (f k) a (fCh ts)) (fCh tss)---- | /O(log n)/.  Analogous to @deepseq@ in the @deepseq@ package, but only forces the spine of the binomial heap.-seqSpine :: MinPQueue k a -> b -> b-seqSpine Empty z0 = z0-seqSpine (MinPQ _ _ _ ts0) z0 = ts0 `seqSpineF` z0 where-  seqSpineF :: BinomForest rk k a -> b -> b-  seqSpineF ts z = case ts of-    Nil        -> z-    Skip ts'   -> seqSpineF ts' z-    Cons _ ts' -> seqSpineF ts' z--class NFRank rk where-  rnfRk :: (NFData k, NFData a) => rk k a -> ()--instance NFRank Zero where-  rnfRk _ = ()--instance NFRank rk => NFRank (Succ rk) where-  rnfRk (Succ t ts) = t `deepseq` rnfRk ts--instance (NFData k, NFData a, NFRank rk) => NFData (BinomTree rk k a) where-  rnf (BinomTree k a ts) = k `deepseq` a `deepseq` rnfRk ts--instance (NFData k, NFData a, NFRank rk) => NFData (BinomForest rk k a) where-  rnf Nil = ()-  rnf (Skip tss) = rnf tss-  rnf (Cons t tss) = t `deepseq` rnf tss--instance (NFData k, NFData a) => NFData (MinPQueue k a) where-  rnf Empty = ()-  rnf (MinPQ _ k a ts) = k `deepseq` a `deepseq` rnf ts
− Data/PQueue/Prio/Max.hs 
@@ -1,480 +0,0 @@-{-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}---------------------------------------------------------------------------------- |--- Module      :  Data.PQueue.Prio.Max--- Copyright   :  (c) Louis Wasserman 2010--- License     :  BSD-style--- Maintainer  :  libraries@haskell.org--- Stability   :  experimental--- Portability :  portable------ General purpose priority queue.--- Each element is associated with a /key/, and the priority queue supports--- viewing and extracting the element with the maximum key.------ A worst-case bound is given for each operation.  In some cases, an amortized--- bound is also specified; these bounds do not hold in a persistent context.------ This implementation is based on a binomial heap augmented with a global root.--- The spine of the heap is maintained lazily.  To force the spine of the heap,--- use 'seqSpine'.------ We do not guarantee stable behavior.--- Ties are broken arbitrarily -- that is, if @k1 <= k2@ and @k2 <= k1@, then there--- are no guarantees about the relative order in which @k1@, @k2@, and their associated--- elements are returned.  (Unlike Data.Map, we allow multiple elements with the--- same key.)------ This implementation offers a number of methods of the form @xxxU@, where @U@ stands for--- unordered.  No guarantees whatsoever are made on the execution or traversal order of--- these functions.-------------------------------------------------------------------------------module Data.PQueue.Prio.Max (-  MaxPQueue,-  -- * Construction-  empty,-  singleton,-  insert,-  insertBehind,-  union,-  unions,-  -- * Query-  null,-  size,-  -- ** Maximum view-  findMax,-  getMax,-  deleteMax,-  deleteFindMax,-  adjustMax,-  adjustMaxWithKey,-  updateMax,-  updateMaxWithKey,-  maxView,-  maxViewWithKey,-  -- * Traversal-  -- ** Map-  map,-  mapWithKey,-  mapKeys,-  mapKeysMonotonic,-  -- ** Fold-  foldrWithKey,-  foldlWithKey,-  -- ** Traverse-  traverseWithKey,-  -- * Subsets-  -- ** Indexed-  take,-  drop,-  splitAt,-  -- ** Predicates-  takeWhile,-  takeWhileWithKey,-  dropWhile,-  dropWhileWithKey,-  span,-  spanWithKey,-  break,-  breakWithKey,-  -- *** Filter-  filter,-  filterWithKey,-  partition,-  partitionWithKey,-  mapMaybe,-  mapMaybeWithKey,-  mapEither,-  mapEitherWithKey,-  -- * List operations-  -- ** Conversion from lists-  fromList,-  fromAscList,-  fromDescList,-  -- ** Conversion to lists-  keys,-  elems,-  assocs,-  toAscList,-  toDescList,-  toList,-  -- * Unordered operations-  foldrU,-  foldrWithKeyU,-  foldlU,-  foldlWithKeyU,-  traverseU,-  traverseWithKeyU,-  keysU,-  elemsU,-  assocsU,-  toListU,-  -- * Helper methods-  seqSpine-  )-  where--import Control.Applicative (Applicative, (<$>))-import Data.Monoid (Monoid(mempty, mappend, mconcat))-import Data.Traversable (Traversable(traverse))-import Data.Foldable (Foldable, foldr, foldl)-import Data.Maybe (fromMaybe)-import Data.PQueue.Prio.Max.Internals--#if MIN_VERSION_base(4,9,0)-import Data.Semigroup (Semigroup((<>)))-#endif--import Prelude hiding (map, filter, break, span, takeWhile, dropWhile, splitAt, take, drop, (!!), null, foldr, foldl)--import qualified Data.PQueue.Prio.Min as Q--#ifdef __GLASGOW_HASKELL__-import Text.Read (Lexeme(Ident), lexP, parens, prec,-  readPrec, readListPrec, readListPrecDefault)-#else-build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]-build f = f (:) []-#endif--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-#endif--instance Ord k => Monoid (MaxPQueue k a) where-  mempty = empty-  mappend = union-  mconcat = unions--instance (Ord k, Show k, Show a) => Show (MaxPQueue k a) where-  showsPrec p xs = showParen (p > 10) $-    showString "fromDescList " . shows (toDescList xs)--instance (Read k, Read a) => Read (MaxPQueue k a) where-#ifdef __GLASGOW_HASKELL__-  readPrec = parens $ prec 10 $ do-    Ident "fromDescList" <- lexP-    xs <- readPrec-    return (fromDescList xs)--  readListPrec = readListPrecDefault-#else-  readsPrec p = readParen (p > 10) $ \ r -> do-    ("fromDescList",s) <- lex r-    (xs,t) <- reads s-    return (fromDescList xs,t)-#endif--instance Functor (MaxPQueue k) where-  fmap f (MaxPQ q) = MaxPQ (fmap f q)--instance Ord k => Foldable (MaxPQueue k) where-  foldr f z (MaxPQ q) = foldr f z q-  foldl f z (MaxPQ q) = foldl f z q--instance Ord k => Traversable (MaxPQueue k) where-  traverse f (MaxPQ q) = MaxPQ <$> traverse f q---- | /O(1)/.  Returns the empty priority queue.-empty :: MaxPQueue k a-empty = MaxPQ Q.empty---- | /O(1)/.  Constructs a singleton priority queue.-singleton :: k -> a -> MaxPQueue k a-singleton k a = MaxPQ (Q.singleton (Down k) a)---- | 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)---- | /O(n)/ (an earlier implementation had /O(1)/ but was buggy).---   Insert an element with the specified key into the priority queue,---   putting it behind elements whose key compares equal to the---   inserted one.-insertBehind :: Ord k => k -> a -> MaxPQueue k a -> MaxPQueue k a-insertBehind k a (MaxPQ q) = MaxPQ (Q.insertBehind (Down k) a q)---- | Amortized /O(log(min(n1, n2)))/, worst-case /O(log(max(n1, n2)))/.  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)---- | 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])---- | /O(1)/.  Checks if this priority queue is empty.-null :: MaxPQueue k a -> Bool-null (MaxPQ q) = Q.null q---- | /O(1)/.  Returns the size of this priority queue.-size :: MaxPQueue k a -> Int-size (MaxPQ q) = Q.size q---- | /O(1)/.  The maximal (key, element) in the queue.  Calls 'error' if empty.-findMax :: MaxPQueue k a -> (k, a)-findMax = fromMaybe (error "Error: findMax called on an empty queue") . getMax---- | /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)---- | /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)---- | /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)-deleteFindMax = fromMaybe (error "Error: deleteFindMax called on an empty queue") . maxViewWithKey---- | /O(1)/.  Alter the value at the maximum key.  If the queue is empty, does nothing.-adjustMax :: (a -> a) -> MaxPQueue k a -> MaxPQueue k a-adjustMax = adjustMaxWithKey . const---- | /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)---- | /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.-updateMax :: Ord k => (a -> Maybe a) -> MaxPQueue k a -> MaxPQueue k a-updateMax = updateMaxWithKey . const---- | /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)---- | /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.-maxView :: Ord k => MaxPQueue k a -> Maybe (a, MaxPQueue k a)-maxView q = do-  ((_, a), q') <- maxViewWithKey q-  return (a, q')---- | /O(log n)/.  Retrieves the maximal (key, value) pair of the map, and the map stripped of that--- element, or 'Nothing' if passed an empty map.-maxViewWithKey :: Ord k => MaxPQueue k a -> Maybe ((k, a), MaxPQueue k a)-maxViewWithKey (MaxPQ q) = do-  ((Down k, a), q') <- Q.minViewWithKey q-  return ((k, a), MaxPQ q')---- | /O(n)/.  Map a function over all values in the queue.-map :: (a -> b) -> MaxPQueue k a -> MaxPQueue k b-map = mapWithKey . const---- | /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)---- | /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)---- | /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'.-mapKeysMonotonic :: (k -> k') -> MaxPQueue k a -> MaxPQueue k' a-mapKeysMonotonic f (MaxPQ q) = MaxPQ (Q.mapKeysMonotonic (fmap f) q)---- | /O(n log n)/.  Fold the keys and values in the map, such that--- @'foldrWithKey' f z q == 'List.foldr' ('uncurry' f) z ('toDescList' q)@.------ If you do not care about the traversal order, consider using 'foldrWithKeyU'.-foldrWithKey :: Ord k => (k -> a -> b -> b) -> b -> MaxPQueue k a -> b-foldrWithKey f z (MaxPQ q) = Q.foldrWithKey (f . unDown) z q---- | /O(n log n)/.  Fold the keys and values in the map, such that--- @'foldlWithKey' f z q == 'List.foldl' ('uncurry' . f) z ('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---- | /O(n log n)/.  Traverses the elements of the queue in descending order by key.--- (@'traverseWithKey' f q == 'fromDescList' <$> 'traverse' ('uncurry' f) ('toDescList' q)@)------ If you do not care about the /order/ of the traversal, consider using 'traverseWithKeyU'.-traverseWithKey :: (Ord k, Applicative f) => (k -> a -> f b) -> MaxPQueue k a -> f (MaxPQueue k b)-traverseWithKey f (MaxPQ q) = MaxPQ <$> Q.traverseWithKey (f . unDown) q---- | /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)---- | /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)---- | /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')---- | Takes the longest possible prefix of elements satisfying the predicate.--- (@'takeWhile' p q == 'List.takeWhile' (p . 'snd') ('toDescList' q)@)-takeWhile :: Ord k => (a -> Bool) -> MaxPQueue k a -> [(k, a)]-takeWhile = takeWhileWithKey . const---- | Takes the longest possible prefix of elements satisfying the predicate.--- (@'takeWhile' p q == 'List.takeWhile' (uncurry p) ('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)---- | Removes the longest possible prefix of elements satisfying the predicate.-dropWhile :: Ord k => (a -> Bool) -> MaxPQueue k a -> MaxPQueue k a-dropWhile = dropWhileWithKey . const---- | 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)---- | Equivalent to @('takeWhile' p q, 'dropWhile' p q)@.-span :: Ord k => (a -> Bool) -> MaxPQueue k a -> ([(k, a)], MaxPQueue k a)-span = spanWithKey . const---- | Equivalent to @'span' ('not' . p)@.-break :: Ord k => (a -> Bool) -> MaxPQueue k a -> ([(k, a)], MaxPQueue k a)-break = breakWithKey . const---- | 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')---- | 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')---- | /O(n)/.  Filter all values that satisfy the predicate.-filter :: Ord k => (a -> Bool) -> MaxPQueue k a -> MaxPQueue k a-filter = filterWithKey . const---- | /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)---- | /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.-partition :: Ord k => (a -> Bool) -> MaxPQueue k a -> (MaxPQueue k a, MaxPQueue k a)-partition = partitionWithKey . const---- | /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)---- | /O(n)/.  Map values and collect the 'Just' results.-mapMaybe :: Ord k => (a -> Maybe b) -> MaxPQueue k a -> MaxPQueue k b-mapMaybe = mapMaybeWithKey . const---- | /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)---- | /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)-mapEither = mapEitherWithKey . const---- | /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)---- | /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)---- | /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)---- | /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)---- | /O(n log n)/.  Return all keys of the queue in descending order.-keys :: Ord k => MaxPQueue k a -> [k]-keys = fmap fst . toDescList---- | /O(n log n)/.  Return all elements of the queue in descending order by key.-elems :: Ord k => MaxPQueue k a -> [a]-elems = fmap snd . toDescList---- | /O(n log n)/.  Equivalent to 'toDescList'.-assocs :: Ord k => MaxPQueue k a -> [(k, a)]-assocs = toDescList---- | /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)---- | /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)---- | /O(n log n)/.  Equivalent to 'toDescList'.------ If the traversal order is irrelevant, consider using 'toListU'.-toList :: Ord k => MaxPQueue k a -> [(k, a)]-toList = toDescList---- | /O(n)/.  An unordered right fold over the elements of the queue, in no particular order.-foldrU :: (a -> b -> b) -> b -> MaxPQueue k a -> b-foldrU = foldrWithKeyU . const---- | /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---- | /O(n)/.  An unordered left fold over the elements of the queue, in no particular order.-foldlU :: (b -> a -> b) -> b -> MaxPQueue k a -> b-foldlU f = foldlWithKeyU (const . f)---- | /O(n)/.  An unordered left fold over the elements of the queue, in no particular order.-foldlWithKeyU :: (b -> k -> a -> b) -> b -> MaxPQueue k a -> b-foldlWithKeyU f z0 (MaxPQ q) = Q.foldlWithKeyU (\ z -> f z . unDown) z0 q---- | /O(n)/.  An unordered traversal over a priority queue, in no particular order.--- While there is no guarantee in which order the elements are traversed, the resulting--- priority queue will be perfectly valid.-traverseU :: (Applicative f) => (a -> f b) -> MaxPQueue k a -> f (MaxPQueue k b)-traverseU = traverseWithKeyU . const---- | /O(n)/.  An unordered traversal over a priority queue, in no particular order.--- While there is no guarantee in which order the elements are traversed, the resulting--- priority queue will be perfectly valid.-traverseWithKeyU :: (Applicative f) => (k -> a -> f b) -> MaxPQueue k a -> f (MaxPQueue k b)-traverseWithKeyU f (MaxPQ q) = MaxPQ <$> Q.traverseWithKeyU (f . unDown) q---- | /O(n)/.  Return all keys of the queue in no particular order.-keysU :: MaxPQueue k a -> [k]-keysU = fmap fst . toListU---- | /O(n)/.  Return all elements of the queue in no particular order.-elemsU :: MaxPQueue k a -> [a]-elemsU = fmap snd . toListU---- | /O(n)/.  Equivalent to 'toListU'.-assocsU :: MaxPQueue k a -> [(k, a)]-assocsU = toListU---- | /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)---- | /O(log n)/.  Analogous to @deepseq@ in the @deepseq@ package, but only forces the spine of the binomial heap.-seqSpine :: MaxPQueue k a -> b -> b-seqSpine (MaxPQ q) = Q.seqSpine q
− Data/PQueue/Prio/Max/Internals.hs 
@@ -1,52 +0,0 @@-{-# LANGUAGE CPP #-}--module Data.PQueue.Prio.Max.Internals where--import Control.DeepSeq (NFData(rnf))--import Data.Traversable (Traversable(traverse))-import Data.Foldable (Foldable(foldr, foldl))-import Data.Functor ((<$>))-# if __GLASGOW_HASKELL__-import Data.Data (Data, Typeable)-# endif--import Prelude hiding (foldr, foldl)--import Data.PQueue.Prio.Internals (MinPQueue)--newtype Down a = Down {unDown :: a}-# if __GLASGOW_HASKELL__-  deriving (Eq, Data, Typeable)-# else-  deriving (Eq)-# endif---- | A priority queue where values of type @a@ are annotated with keys of type @k@.--- The queue supports extracting the element with maximum key.-newtype MaxPQueue k a = MaxPQ (MinPQueue (Down k) a)-# if __GLASGOW_HASKELL__-  deriving (Eq, Ord, Data, Typeable)-# else-  deriving (Eq, Ord)-# endif--instance (NFData k, NFData a) => NFData (MaxPQueue k a) where-  rnf (MaxPQ q) = rnf q--instance NFData a => NFData (Down a) where-  rnf (Down a) = rnf a--instance Ord a => Ord (Down a) where-  Down a `compare` Down b = b `compare` a-  Down a <= Down b = b <= a--instance Functor Down where-  fmap f (Down a) = Down (f a)--instance Foldable Down where-  foldr f z (Down a) = a `f` z-  foldl f z (Down a) = z `f` a--instance Traversable Down where-  traverse f (Down a) = Down <$> f a
− Data/PQueue/Prio/Min.hs 
@@ -1,420 +0,0 @@-{-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}---------------------------------------------------------------------------------- |--- Module      :  Data.PQueue.Prio.Min--- Copyright   :  (c) Louis Wasserman 2010--- License     :  BSD-style--- Maintainer  :  libraries@haskell.org--- Stability   :  experimental--- Portability :  portable------ General purpose priority queue.--- Each element is associated with a /key/, and the priority queue supports--- viewing and extracting the element with the minimum key.------ A worst-case bound is given for each operation.  In some cases, an amortized--- bound is also specified; these bounds do not hold in a persistent context.------ This implementation is based on a binomial heap augmented with a global root.--- The spine of the heap is maintained lazily.  To force the spine of the heap,--- use 'seqSpine'.------ We do not guarantee stable behavior.--- Ties are broken arbitrarily -- that is, if @k1 <= k2@ and @k2 <= k1@, then there--- are no guarantees about the relative order in which @k1@, @k2@, and their associated--- elements are returned.  (Unlike Data.Map, we allow multiple elements with the--- same key.)------ This implementation offers a number of methods of the form @xxxU@, where @U@ stands for--- unordered.  No guarantees whatsoever are made on the execution or traversal order of--- these functions.-------------------------------------------------------------------------------module Data.PQueue.Prio.Min (-  MinPQueue,-  -- * Construction-  empty,-  singleton,-  insert,-  insertBehind,-  union,-  unions,-  -- * Query-  null,-  size,-  -- ** Minimum view-  findMin,-  getMin,-  deleteMin,-  deleteFindMin,-  adjustMin,-  adjustMinWithKey,-  updateMin,-  updateMinWithKey,-  minView,-  minViewWithKey,-  -- * Traversal-  -- ** Map-  map,-  mapWithKey,-  mapKeys,-  mapKeysMonotonic,-  -- ** Fold-  foldrWithKey,-  foldlWithKey,-  -- ** Traverse-  traverseWithKey,-  -- * Subsets-  -- ** Indexed-  take,-  drop,-  splitAt,-  -- ** Predicates-  takeWhile,-  takeWhileWithKey,-  dropWhile,-  dropWhileWithKey,-  span,-  spanWithKey,-  break,-  breakWithKey,-  -- *** Filter-  filter,-  filterWithKey,-  partition,-  partitionWithKey,-  mapMaybe,-  mapMaybeWithKey,-  mapEither,-  mapEitherWithKey,-  -- * List operations-  -- ** Conversion from lists-  fromList,-  fromAscList,-  fromDescList,-  -- ** Conversion to lists-  keys,-  elems,-  assocs,-  toAscList,-  toDescList,-  toList,-  -- * Unordered operations-  foldrU,-  foldrWithKeyU,-  foldlU,-  foldlWithKeyU,-  traverseU,-  traverseWithKeyU,-  keysU,-  elemsU,-  assocsU,-  toListU,-  -- * Helper methods-  seqSpine-  )-  where--import Control.Applicative (Applicative, pure, (<*>), (<$>))--import qualified Data.List as List-import qualified Data.Foldable as Fold(Foldable(..))-import Data.Monoid (Monoid(mempty, mappend, mconcat))-import Data.Traversable (Traversable(traverse))-import Data.Foldable (Foldable)-import Data.Maybe (fromMaybe)--#if MIN_VERSION_base(4,9,0)-import Data.Semigroup (Semigroup((<>)))-#endif--import Data.PQueue.Prio.Internals--import Prelude hiding (map, filter, break, span, takeWhile, dropWhile, splitAt, take, drop, (!!), null)--#ifdef __GLASGOW_HASKELL__-import GHC.Exts (build)-import Text.Read (Lexeme(Ident), lexP, parens, prec,-  readPrec, readListPrec, readListPrecDefault)-#else-build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]-build f = f (:) []-#endif--(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d-(f .: g) x y = f (g x y)--uncurry' :: (a -> b -> c) -> (a, b) -> c-uncurry' f (a, b) = f a b--infixr 8 .:--#if MIN_VERSION_base(4,9,0)-instance Ord k => Semigroup (MinPQueue k a) where-  (<>) = union-#endif--instance Ord k => Monoid (MinPQueue k a) where-  mempty = empty-  mappend = union-  mconcat = unions--instance (Ord k, Show k, Show a) => Show (MinPQueue k a) where-  showsPrec p xs = showParen (p > 10) $-    showString "fromAscList " . shows (toAscList xs)--instance (Read k, Read a) => Read (MinPQueue k a) where-#ifdef __GLASGOW_HASKELL__-  readPrec = parens $ prec 10 $ do-    Ident "fromAscList" <- lexP-    xs <- readPrec-    return (fromAscList xs)--  readListPrec = readListPrecDefault-#else-  readsPrec p = readParen (p > 10) $ \ r -> do-    ("fromAscList",s) <- lex r-    (xs,t) <- reads s-    return (fromAscList xs,t)-#endif----- | The union of a list of queues: (@'unions' == 'List.foldl' 'union' 'empty'@).-unions :: Ord k => [MinPQueue k a] -> MinPQueue k a-unions = List.foldl union empty---- | /O(1)/.  The minimal (key, element) in the queue.  Calls 'error' if empty.-findMin :: MinPQueue k a -> (k, a)-findMin = fromMaybe (error "Error: findMin called on an empty queue") . getMin---- | /O(log n)/.  Deletes the minimal (key, element) in the queue.  Returns an empty queue--- if the queue is empty.-deleteMin :: Ord k => MinPQueue k a -> MinPQueue k a-deleteMin = updateMin (const Nothing)---- | /O(log n)/.  Delete and find the element with the minimum key.  Calls 'error' if empty.-deleteFindMin :: Ord k => MinPQueue k a -> ((k, a), MinPQueue k a)-deleteFindMin = fromMaybe (error "Error: deleteFindMin called on an empty queue") . minViewWithKey---- | /O(1)/.  Alter the value at the minimum key.  If the queue is empty, does nothing.-adjustMin :: (a -> a) -> MinPQueue k a -> MinPQueue k a-adjustMin = adjustMinWithKey . const---- | /O(log n)/.  (Actually /O(1)/ if there's no deletion.)  Update the value at the minimum key.--- If the queue is empty, does nothing.-updateMin :: Ord k => (a -> Maybe a) -> MinPQueue k a -> MinPQueue k a-updateMin = updateMinWithKey . const---- | /O(log n)/.  Retrieves the value associated with the minimal key of the queue, and the queue--- stripped of that element, or 'Nothing' if passed an empty queue.-minView :: Ord k => MinPQueue k a -> Maybe (a, MinPQueue k a)-minView q = do  ((_, a), q') <- minViewWithKey q-                return (a, q')---- | /O(n)/.  Map a function over all values in the queue.-map :: (a -> b) -> MinPQueue k a -> MinPQueue k b-map = mapWithKey . const---- | /O(n)/.  @'mapKeys' f q@ is the queue obtained by applying @f@ to each key of @q@.-mapKeys :: Ord k' => (k -> k') -> MinPQueue k a -> MinPQueue k' a-mapKeys f q = fromList [(f k, a) | (k, a) <- toListU q]---- | /O(n log n)/.  Traverses the elements of the queue in ascending order by key.--- (@'traverseWithKey' f q == 'fromAscList' <$> 'traverse' ('uncurry' f) ('toAscList' q)@)------ If you do not care about the /order/ of the traversal, consider using 'traverseWithKeyU'.-traverseWithKey :: (Ord k, Applicative f) => (k -> a -> f b) -> MinPQueue k a -> f (MinPQueue k b)-traverseWithKey f q = case minViewWithKey q of-  Nothing      -> pure empty-  Just ((k, a), q')  -> insertMin k <$> f k a <*> traverseWithKey f q'---- | /O(n)/.  Map values and collect the 'Just' results.-mapMaybe :: Ord k => (a -> Maybe b) -> MinPQueue k a -> MinPQueue k b-mapMaybe = mapMaybeWithKey . const---- | /O(n)/.  Map values and separate the 'Left' and 'Right' results.-mapEither :: Ord k => (a -> Either b c) -> MinPQueue k a -> (MinPQueue k b, MinPQueue k c)-mapEither = mapEitherWithKey . const---- | /O(n)/.  Filter all values that satisfy the predicate.-filter :: Ord k => (a -> Bool) -> MinPQueue k a -> MinPQueue k a-filter = filterWithKey . const---- | /O(n)/.  Filter all values that satisfy the predicate.-filterWithKey :: Ord k => (k -> a -> Bool) -> MinPQueue k a -> MinPQueue k a-filterWithKey p = mapMaybeWithKey (\ k a -> if p k a then Just a else Nothing)---- | /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.-partition :: Ord k => (a -> Bool) -> MinPQueue k a -> (MinPQueue k a, MinPQueue k a)-partition = partitionWithKey . const---- | /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) -> MinPQueue k a -> (MinPQueue k a, MinPQueue k a)-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@.--- (@'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@.-drop :: Ord k => Int -> MinPQueue k a -> MinPQueue k a-drop n0 q0-  | n0 <= 0  = q0-  | n0 >= size q0  = empty-  | otherwise  = drop' n0 q0-  where-    drop' n q-      | n == 0    = q-      | otherwise = drop' (n-1) (deleteMin q)---- | /O(k log n)/.  Equivalent to @('take' k q, 'drop' k q)@.-splitAt :: Ord k => Int -> MinPQueue k a -> ([(k, a)], MinPQueue k a)-splitAt n q-  | n <= 0     = ([], q)-  | otherwise  = n `seq` case minViewWithKey q of-      Just (ka, q') -> let (kas, q'') = splitAt (n-1) q' in (ka:kas, q'')-      _             -> ([], q)--{-# INLINE takeWhile #-}--- | Takes the longest possible prefix of elements satisfying the predicate.--- (@'takeWhile' p q == 'List.takeWhile' (p . 'snd') ('toAscList' q)@)-takeWhile :: Ord k => (a -> Bool) -> MinPQueue k a -> [(k, a)]-takeWhile = takeWhileWithKey . const--{-# INLINE takeWhileWithKey #-}--- | Takes the longest possible prefix of elements satisfying the predicate.--- (@'takeWhile' p q == 'List.takeWhile' (uncurry p) ('toAscList' q)@)-takeWhileWithKey :: Ord k => (k -> a -> Bool) -> MinPQueue k a -> [(k, a)]-takeWhileWithKey p0 = takeWhileFB (uncurry' p0) . toAscList where-  takeWhileFB p xs = build (\ c n -> foldr (\ x z -> if p x then x `c` z else n) n xs)---- | Removes the longest possible prefix of elements satisfying the predicate.-dropWhile :: Ord k => (a -> Bool) -> MinPQueue k a -> MinPQueue k a-dropWhile = dropWhileWithKey . const---- | Removes the longest possible prefix of elements satisfying the predicate.-dropWhileWithKey :: Ord k => (k -> a -> Bool) -> MinPQueue k a -> MinPQueue k a-dropWhileWithKey p q = case minViewWithKey q of-  Just ((k, a), q')-    | p k a -> dropWhileWithKey p q'-  _         -> q---- | Equivalent to @('takeWhile' p q, 'dropWhile' p q)@.-span :: Ord k => (a -> Bool) -> MinPQueue k a -> ([(k, a)], MinPQueue k a)--- | Equivalent to @'span' ('not' . p)@.-break :: Ord k => (a -> Bool) -> MinPQueue k a -> ([(k, a)], MinPQueue k a)-span = spanWithKey . const-break p = span (not . p)---- | Equivalent to @('takeWhileWithKey' p q, 'dropWhileWithKey' p q)@.-spanWithKey :: Ord k => (k -> a -> Bool) -> MinPQueue k a -> ([(k, a)], MinPQueue k a)--- | Equivalent to @'spanWithKey' (\ k a -> 'not' (p k a)) q@.-breakWithKey :: Ord k => (k -> a -> Bool) -> MinPQueue k a -> ([(k, a)], MinPQueue k a)-spanWithKey p q = case minViewWithKey q of-  Just (t@(k, a), q')-    | p k a -> let (kas, q'') = spanWithKey p q' in (t:kas, q'')-  _         -> ([], q)-breakWithKey p = spanWithKey (not .: p)---- | /O(n)/.  Build a priority queue from the list of (key, value) pairs.-fromList :: Ord k => [(k, a)] -> MinPQueue k a-fromList = foldr (uncurry' insert) empty---- | /O(n)/.  Build a priority queue from an ascending list of (key, value) pairs.  /The precondition is not checked./-fromAscList :: [(k, a)] -> MinPQueue k a-fromAscList = foldr (uncurry' insertMin) empty---- | /O(n)/.  Build a priority queue from a descending list of (key, value) pairs.  /The precondition is not checked./-fromDescList :: [(k, a)] -> MinPQueue k a-fromDescList = List.foldl' (\ q (k, a) -> insertMin k a q) empty--{-# RULES-  "fromList/build" forall (g :: forall b . ((k, a) -> b -> b) -> b -> b) .-    fromList (build g) = g (uncurry' insert) empty;-  "fromAscList/build" forall (g :: forall b . ((k, a) -> b -> b) -> b -> b) .-    fromAscList (build g) = g (uncurry' insertMin) empty;-  #-}--{-# INLINE keys #-}--- | /O(n log n)/.  Return all keys of the queue in ascending order.-keys :: Ord k => MinPQueue k a -> [k]-keys = List.map fst . toAscList--{-# INLINE elems #-}--- | /O(n log n)/.  Return all elements of the queue in ascending order by key.-elems :: Ord k => MinPQueue k a -> [a]-elems = List.map snd . toAscList---- | /O(n log n)/.  Return all (key, value) pairs in ascending order by key.-toAscList :: Ord k => MinPQueue k a -> [(k, a)]-toAscList = foldrWithKey (curry (:)) []---- | /O(n log n)/.  Return all (key, value) pairs in descending order by key.-toDescList :: Ord k => MinPQueue k a -> [(k, a)]-toDescList = foldlWithKey (\ z k a -> (k, a) : z) []--{-# RULES-  "toAscList" toAscList = \ q -> build (\ c n -> foldrWithKey (curry c) n q);-  "toDescList" toDescList = \ q -> build (\ c n -> foldlWithKey (\ z k a -> (k, a) `c` z) n q);-  "toListU" toListU = \ q -> build (\ c n -> foldrWithKeyU (curry c) n q);-  #-}--{-# INLINE toList #-}--- | /O(n log n)/.  Equivalent to 'toAscList'.------ If the traversal order is irrelevant, consider using 'toListU'.-toList :: Ord k => MinPQueue k a -> [(k, a)]-toList = toAscList--{-# INLINE assocs #-}--- | /O(n log n)/.  Equivalent to 'toAscList'.-assocs :: Ord k => MinPQueue k a -> [(k, a)]-assocs = toAscList--{-# INLINE keysU #-}--- | /O(n)/.  Return all keys of the queue in no particular order.-keysU :: MinPQueue k a -> [k]-keysU = List.map fst . toListU--{-# INLINE elemsU #-}--- | /O(n)/.  Return all elements of the queue in no particular order.-elemsU :: MinPQueue k a -> [a]-elemsU = List.map snd . toListU--{-# INLINE assocsU #-}--- | /O(n)/.  Equivalent to 'toListU'.-assocsU :: MinPQueue k a -> [(k, a)]-assocsU = toListU---- | /O(n)/.  Returns all (key, value) pairs in the queue in no particular order.-toListU :: MinPQueue k a -> [(k, a)]-toListU = foldrWithKeyU (curry (:)) []---- | /O(n)/.  An unordered right fold over the elements of the queue, in no particular order.-foldrU :: (a -> b -> b) -> b -> MinPQueue k a -> b-foldrU = foldrWithKeyU . const---- | /O(n)/.  An unordered left fold over the elements of the queue, in no particular order.-foldlU :: (b -> a -> b) -> b -> MinPQueue k a -> b-foldlU f = foldlWithKeyU (const . f)---- | /O(n)/.  An unordered traversal over a priority queue, in no particular order.--- While there is no guarantee in which order the elements are traversed, the resulting--- priority queue will be perfectly valid.-traverseU :: (Applicative f) => (a -> f b) -> MinPQueue k a -> f (MinPQueue k b)-traverseU = traverseWithKeyU . const--instance Functor (MinPQueue k) where-  fmap = map--instance Ord k => Foldable (MinPQueue k) where-  foldr   = foldrWithKey . const-  foldl f = foldlWithKey (const . f)--instance Ord k => Traversable (MinPQueue k) where-  traverse = traverseWithKey . const
− PQueueTests.hs 
@@ -1,144 +0,0 @@-module Main (main) where--import qualified Data.PQueue.Prio.Max as PMax ()-import qualified Data.PQueue.Prio.Min as PMin ()-import qualified Data.PQueue.Max as Max ()-import qualified Data.PQueue.Min as Min--import Test.QuickCheck--import System.Exit--import qualified Data.List as List-import Control.Arrow (second)---validMinToAscList :: [Int] -> Bool-validMinToAscList xs = Min.toAscList (Min.fromList xs) == List.sort xs--validMinToDescList :: [Int] -> Bool-validMinToDescList xs = Min.toDescList (Min.fromList xs) == List.sortBy (flip compare) xs--validMinUnfoldr :: [Int] -> Bool-validMinUnfoldr xs = List.unfoldr Min.minView (Min.fromList xs) == List.sort xs--validMinToList :: [Int] -> Bool-validMinToList xs = List.sort (Min.toList (Min.fromList xs)) == List.sort xs--validMinFromAscList :: [Int] -> Bool-validMinFromAscList xs = Min.fromAscList (List.sort xs) == Min.fromList xs--validMinFromDescList :: [Int] -> Bool-validMinFromDescList xs = Min.fromDescList (List.sortBy (flip compare) xs) == Min.fromList xs--validMinUnion :: [Int] -> [Int] -> Bool-validMinUnion xs1 xs2 = Min.union (Min.fromList xs1) (Min.fromList xs2) == Min.fromList (xs1 ++ xs2)--validMinMapMonotonic :: [Int] -> Bool-validMinMapMonotonic xs = Min.mapU (+1) (Min.fromList xs) == Min.fromList (map (+1) xs)--validMinFilter :: [Int] -> Bool-validMinFilter xs = Min.filter even (Min.fromList xs) == Min.fromList (List.filter even xs)--validMinPartition :: [Int] -> Bool-validMinPartition xs = Min.partition even (Min.fromList xs) == (let (xs1, xs2) = List.partition even xs in (Min.fromList xs1, Min.fromList xs2))--validMinCmp :: [Int] -> [Int] -> Bool-validMinCmp xs1 xs2 = compare (Min.fromList xs1) (Min.fromList xs2) == compare (List.sort xs1) (List.sort xs2)--validMinCmp2 :: [Int] -> Bool-validMinCmp2 xs = compare (Min.fromList ys) (Min.fromList (take 30 ys)) == compare ys (take 30 ys)-  where ys = List.sort xs--validSpan :: [Int] -> Bool-validSpan xs = (Min.takeWhile even q, Min.dropWhile even q) == Min.span even q-  where q = Min.fromList xs--validSpan2 :: [Int] -> Bool-validSpan2 xs =-  second Min.toAscList (Min.span even (Min.fromList xs))-  ==-  List.span even (List.sort xs)--validSplit :: Int -> [Int] -> Bool-validSplit n xs = Min.splitAt n q == (Min.take n q, Min.drop n q)-  where q = Min.fromList xs--validSplit2 :: Int -> [Int] -> Bool-validSplit2 n xs = case Min.splitAt n (Min.fromList xs) of-  (ys, q') -> (ys, Min.toAscList q') == List.splitAt n (List.sort xs)--validMapEither :: [Int] -> Bool-validMapEither xs =-  Min.mapEither collatz q ==-    (Min.mapMaybe (either Just (const Nothing) . collatz) q,-     Min.mapMaybe (either (const Nothing) Just . collatz) q)-      where q = Min.fromList xs--validMap :: [Int] -> Bool-validMap xs = Min.map f (Min.fromList xs) == Min.fromList (List.map f xs)-  where f = either id id . collatz--collatz :: Int -> Either Int Int-collatz x =-  if even x-    then Left $ x `quot` 2-    else Right $ 3 * x + 1--validSize :: [Int] -> Bool-validSize xs = Min.size q == List.length xs'-  where-    q = Min.drop 10 (Min.fromList xs)-    xs' = List.drop 10 (List.sort xs)--validNull :: Int -> [Int] -> Bool-validNull n xs = Min.null q == List.null xs'-  where-    q = Min.drop n (Min.fromList xs)-    xs' = List.drop n (List.sort xs)--validFoldl :: [Int] -> Bool-validFoldl xs = Min.foldlAsc (flip (:)) [] (Min.fromList xs) == List.foldl (flip (:)) [] (List.sort xs)--validFoldlU :: [Int] -> Bool-validFoldlU xs = Min.foldlU (flip (:)) [] q == List.reverse (Min.foldrU (:) [] q)-  where q = Min.fromList xs--validFoldrU :: [Int] -> Bool-validFoldrU xs = Min.foldrU (+) 0 q == List.sum xs-  where q = Min.fromList xs--main :: IO ()-main = do-  check validMinToAscList-  check validMinToDescList-  check validMinUnfoldr-  check validMinToList-  check validMinFromAscList-  check validMinFromDescList-  check validMinUnion-  check validMinMapMonotonic-  check validMinPartition-  check validMinCmp-  check validMinCmp2-  check validSpan-  check validSpan2-  check validSplit-  check validSplit2-  check validMinFilter-  check validMapEither-  check validMap-  check validSize-  check validNull-  check validFoldl-  check validFoldlU-  check validFoldrU--isPass :: Result -> Bool-isPass Success{} = True-isPass _         = False--check :: Testable prop => prop -> IO ()-check p = do-  r <- quickCheckResult p-  if isPass r then return () else exitFailure
pqueue.cabal view
@@ -1,5 +1,5 @@ Name:               pqueue-Version:            1.4.1.2+Version:            1.4.1.3 Category:           Data Structures Author:             Louis Wasserman License:            BSD3@@ -12,7 +12,7 @@ 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.3, GHC == 8.6.1+tested-with:        GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.3, GHC == 8.10.1 extra-source-files: {   include/Typeable.h   CHANGELOG.md@@ -23,10 +23,11 @@   location: git@github.com:lspitzner/pqueue.git  Library {+  hs-source-dirs: src   default-language:     Haskell2010   build-depends:-  { base >= 4.8 && < 4.13+  { base >= 4.8 && < 4.15   , deepseq >= 1.3 && < 1.5   }   exposed-modules:@@ -55,14 +56,16 @@ }  Test-Suite test+  hs-source-dirs: tests   default-language:     Haskell2010   Type: exitcode-stdio-1.0   Main-Is: PQueueTests.hs   Build-Depends:-  { base >= 4.8 && < 4.13+  { base >= 4.8 && < 4.15   , deepseq >= 1.3 && < 1.5-  , QuickCheck >=2.5 && <3+  , QuickCheck >= 2.5 && < 3+  , pqueue   }   ghc-options: {     -Wall@@ -73,14 +76,3 @@       -fno-warn-unused-imports     }   }-  If impl(ghc)-    default-extensions: DeriveDataTypeable-  other-modules:-    Data.PQueue.Prio.Internals-    Data.PQueue.Internals-    Data.PQueue.Prio.Max.Internals-    Control.Applicative.Identity-    Data.PQueue.Prio.Min-    Data.PQueue.Prio.Max-    Data.PQueue.Min-    Data.PQueue.Max
+ src/Control/Applicative/Identity.hs view
@@ -0,0 +1,14 @@+module Control.Applicative.Identity where++import Control.Applicative++import Prelude++newtype Identity a = Identity { runIdentity :: a }++instance Functor Identity where+  fmap f (Identity x) = Identity (f x)++instance Applicative Identity where+  pure = Identity+  Identity f <*> Identity x = Identity (f x)
+ src/Data/PQueue/Internals.hs view
@@ -0,0 +1,508 @@+{-# LANGUAGE CPP, StandaloneDeriving #-}++module Data.PQueue.Internals (+  MinQueue (..),+  BinomHeap,+  BinomForest(..),+  BinomTree(..),+  Succ(..),+  Zero(..),+  LEq,+  empty,+  null,+  size,+  getMin,+  minView,+  singleton,+  insert,+  union,+  mapMaybe,+  mapEither,+  mapMonotonic,+  foldrAsc,+  foldlAsc,+  insertMinQ,+--   mapU,+  foldrU,+  foldlU,+--   traverseU,+  keysQueue,+  seqSpine+  ) where++import Control.DeepSeq (NFData(rnf), deepseq)++import Data.Functor ((<$>))+import Data.Foldable (Foldable (foldr, foldl))+import Data.Monoid (mappend)+import qualified Data.PQueue.Prio.Internals as Prio++#ifdef __GLASGOW_HASKELL__+import Data.Data+#endif++import Prelude hiding (foldl, foldr, null)++-- | A priority queue with elements of type @a@. Supports extracting the minimum element.+data MinQueue a = Empty | MinQueue {-# UNPACK #-} !Int a !(BinomHeap a)+#if __GLASGOW_HASKELL__>=707+  deriving Typeable+#else+#include "Typeable.h"+INSTANCE_TYPEABLE1(MinQueue,minQTC,"MinQueue")+#endif++#ifdef __GLASGOW_HASKELL__+instance (Ord a, Data a) => Data (MinQueue a) where+  gfoldl f z q = case minView q of+    Nothing      -> z Empty+    Just (x, q') -> z insertMinQ `f` x `f` q'++  gunfold k z c = case constrIndex c of+    1 -> z Empty+    2 -> k (k (z insertMinQ))+    _ -> error "gunfold"++  dataCast1 x = gcast1 x++  toConstr q+    | null q = emptyConstr+    | otherwise = consConstr++  dataTypeOf _ = queueDataType++queueDataType :: DataType+queueDataType = mkDataType "Data.PQueue.Min.MinQueue" [emptyConstr, consConstr]++emptyConstr, consConstr :: Constr+emptyConstr = mkConstr queueDataType "empty" [] Prefix+consConstr  = mkConstr queueDataType "<|" [] Infix++#endif++type BinomHeap = BinomForest Zero++instance Ord a => Eq (MinQueue a) where+  Empty == Empty = True+  MinQueue n1 x1 q1 == MinQueue n2 x2 q2 =+    n1 == n2 && eqExtract (x1,q1) (x2,q2)+  _ == _ = False++eqExtract :: Ord a => (a, BinomHeap a) -> (a, BinomHeap a) -> Bool+eqExtract (x1,q1) (x2,q2) =+  x1 == x2 &&+  case (extractHeap q1, extractHeap q2) of+    (Just h1, Just h2) -> eqExtract h1 h2+    (Nothing, Nothing) -> True+    _ -> False++instance Ord a => Ord (MinQueue a) where+  Empty `compare` Empty = EQ+  Empty `compare` _ = LT+  _ `compare` Empty = GT+  MinQueue _n1 x1 q1 `compare` MinQueue _n2 x2 q2 = cmpExtract (x1,q1) (x2,q2)++cmpExtract :: Ord a => (a, BinomHeap a) -> (a, BinomHeap a) -> Ordering+cmpExtract (x1,q1) (x2,q2) =+  compare x1 x2 `mappend`+  case (extractHeap q1, extractHeap q2) of+    (Just h1, Just h2) -> cmpExtract h1 h2+    (Nothing, Nothing) -> EQ+    (Just _, Nothing) -> GT+    (Nothing, Just _) -> LT++    -- We compare their first elements, then their other elements up to the smaller queue's length,+    -- and then the longer queue wins.+    -- This is equivalent to @comparing toAscList@, except it fuses much more nicely.++-- We implement tree ranks in the type system with a nicely elegant approach, as follows.+-- The goal is to have the type system automatically guarantee that our binomial forest+-- has the correct binomial structure.+--+-- In the traditional set-theoretic construction of the natural numbers, we define+-- each number to be the set of numbers less than it, and Zero to be the empty set,+-- as follows:+--+-- 0 = {}  1 = {0}    2 = {0, 1}  3={0, 1, 2} ...+--+-- Binomial trees have a similar structure: a tree of rank @k@ has one child of each+-- rank less than @k@. Let's define the type @rk@ corresponding to rank @k@ to refer+-- to a collection of binomial trees of ranks @0..k-1@. Then we can say that+--+-- > data Succ rk a = Succ (BinomTree rk a) (rk a)+--+-- and this behaves exactly as the successor operator for ranks should behave. Furthermore,+-- we immediately obtain that+--+-- > data BinomTree rk a = BinomTree a (rk a)+--+-- which is nice and compact. With this construction, things work out extremely nicely:+--+-- > BinomTree (Succ (Succ (Succ Zero)))+--+-- is a type constructor that takes an element type and returns the type of binomial trees+-- of rank @3@.+data BinomForest rk a = Nil | Skip (BinomForest (Succ rk) a) |+  Cons {-# UNPACK #-} !(BinomTree rk a) (BinomForest (Succ rk) a)++data BinomTree rk a = BinomTree a (rk a)++-- | If |rk| corresponds to rank @k@, then |'Succ' rk| corresponds to rank @k+1@.+data Succ rk a = Succ {-# UNPACK #-} !(BinomTree rk a) (rk a)++-- | Type corresponding to the Zero rank.+data Zero a = Zero++-- | Type alias for a comparison function.+type LEq a = a -> a -> Bool++-- basics++-- | /O(1)/. The empty priority queue.+empty :: MinQueue a+empty = Empty++-- | /O(1)/. Is this the empty priority queue?+null :: MinQueue a -> Bool+null Empty = True+null _     = False++-- | /O(1)/. The number of elements in the queue.+size :: MinQueue a -> Int+size Empty            = 0+size (MinQueue n _ _) = n++-- | Returns the minimum element of the queue, if the queue is nonempty.+getMin :: MinQueue a -> Maybe a+getMin (MinQueue _ x _) = Just x+getMin _                = Nothing++-- | Retrieves the minimum element of the queue, and the queue stripped of that element,+-- or 'Nothing' if passed an empty queue.+minView :: Ord a => MinQueue a -> Maybe (a, MinQueue a)+minView Empty = Nothing+minView (MinQueue n x ts) = Just (x, case extractHeap ts of+  Nothing        -> Empty+  Just (x', ts') -> MinQueue (n - 1) x' ts')++-- | /O(1)/. Construct a priority queue with a single element.+singleton :: a -> MinQueue a+singleton x = MinQueue 1 x Nil++-- | Amortized /O(1)/, worst-case /O(log n)/. Insert an element into the priority queue.+insert :: Ord a => a -> MinQueue a -> MinQueue a+insert = insert' (<=)++-- | Amortized /O(log (min(n,m)))/, worst-case /O(log (max (n,m)))/. Take the union of two priority queues.+union :: Ord a => MinQueue a -> MinQueue a -> MinQueue a+union = union' (<=)++-- | /O(n)/. Map elements and collect the 'Just' results.+mapMaybe :: Ord b => (a -> Maybe b) -> MinQueue a -> MinQueue b+mapMaybe _ Empty = Empty+mapMaybe f (MinQueue _ x ts) = maybe q' (`insert` q') (f x)+  where+    q' = mapMaybeQueue f (<=) (const Empty) Empty ts++-- | /O(n)/. Map elements and separate the 'Left' and 'Right' results.+mapEither :: (Ord b, Ord c) => (a -> Either b c) -> MinQueue a -> (MinQueue b, MinQueue c)+mapEither _ Empty = (Empty, Empty)+mapEither f (MinQueue _ x ts) = case (mapEitherQueue f (<=) (<=) (const (Empty, Empty)) (Empty, Empty) ts, f x) of+  ((qL, qR), Left b)  -> (insert b qL, qR)+  ((qL, qR), Right c) -> (qL, insert c qR)++-- | /O(n)/. Assumes that the function it is given is monotonic, and applies this function to every element of the priority queue,+-- as in 'fmap'. If it is not, the result is undefined.+mapMonotonic :: (a -> b) -> MinQueue a -> MinQueue b+mapMonotonic = mapU++{-# INLINE foldrAsc #-}+-- | /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 -> MinQueue a -> b+foldrAsc _ z Empty = z+foldrAsc f z (MinQueue _ x ts) = x `f` foldrUnfold f z extractHeap ts++{-# INLINE foldrUnfold #-}+-- | Equivalent to @foldr f z (unfoldr suc s0)@.+foldrUnfold :: (a -> c -> c) -> c -> (b -> Maybe (a, b)) -> b -> c+foldrUnfold f z suc s0 = unf s0 where+  unf s = case suc s of+    Nothing      -> z+    Just (x, s') -> x `f` unf s'++-- | /O(n log n)/. Performs a left-fold on the elements of a priority queue in ascending order.+foldlAsc :: Ord a => (b -> a -> b) -> b -> MinQueue a -> b+foldlAsc _ z Empty             = z+foldlAsc f z (MinQueue _ x ts) = foldlUnfold f (z `f` x) extractHeap ts++{-# INLINE foldlUnfold #-}+-- | @foldlUnfold f z suc s0@ is equivalent to @foldl f z (unfoldr suc s0)@.+foldlUnfold :: (c -> a -> c) -> c -> (b -> Maybe (a, b)) -> b -> c+foldlUnfold f z0 suc s0 = unf z0 s0 where+  unf z s = case suc s of+    Nothing      -> z+    Just (x, s') -> unf (z `f` x) s'++insert' :: LEq a -> a -> MinQueue a -> MinQueue a+insert' _ x Empty = singleton x+insert' le x (MinQueue n x' ts)+  | x `le` x' = MinQueue (n + 1) x (incr le (tip x') ts)+  | otherwise = MinQueue (n + 1) x' (incr le (tip x) ts)++{-# INLINE union' #-}+union' :: LEq a -> MinQueue a -> MinQueue a -> MinQueue a+union' _ Empty q = q+union' _ q Empty = q+union' le (MinQueue n1 x1 f1) (MinQueue n2 x2 f2)+  | x1 `le` x2 = MinQueue (n1 + n2) x1 (carry le (tip x2) f1 f2)+  | otherwise  = MinQueue (n1 + n2) x2 (carry le (tip x1) f1 f2)++-- | Takes a size and a binomial forest and produces a priority queue with a distinguished global root.+extractHeap :: Ord a => BinomHeap a -> Maybe (a, BinomHeap a)+extractHeap ts = case extractBin (<=) ts of+  Yes (Extract x _ ts') -> Just (x, ts')+  _                     -> Nothing++-- | A specialized type intended to organize the return of extract-min queries+-- from a binomial forest. We walk all the way through the forest, and then+-- walk backwards. @Extract rk a@ is the result type of an extract-min+-- operation that has walked as far backwards of rank @rk@ -- that is, it+-- has visited every root of rank @>= rk@.+--+-- The interpretation of @Extract minKey children forest@ is+--+--   * @minKey@ is the key of the minimum root visited so far. It may have+--     any rank @>= rk@. We will denote the root corresponding to+--     @minKey@ as @minRoot@.+--+--   * @children@ is those children of @minRoot@ which have not yet been+--     merged with the rest of the forest. Specifically, these are+--     the children with rank @< rk@.+--+--   * @forest@ is an accumulating parameter that maintains the partial+--     reconstruction of the binomial forest without @minRoot@. It is+--     the union of all old roots with rank @>= rk@ (except @minRoot@),+--     with the set of all children of @minRoot@ with rank @>= rk@.+--     Note that @forest@ is lazy, so if we discover a smaller key+--     than @minKey@ later, we haven't wasted significant work.+data Extract rk a = Extract a (rk a) (BinomForest rk a)+data MExtract rk a = No | Yes {-# UNPACK #-} !(Extract rk a)++incrExtract :: Extract (Succ rk) a -> Extract rk a+incrExtract (Extract minKey (Succ kChild kChildren) ts)+  = Extract minKey kChildren (Cons kChild ts)++incrExtract' :: LEq a -> BinomTree rk a -> Extract (Succ rk) a -> Extract rk a+incrExtract' le t (Extract minKey (Succ kChild kChildren) ts)+  = Extract minKey kChildren (Skip (incr le (t `cat` kChild) ts))+  where+    cat = joinBin le++-- | Walks backward from the biggest key in the forest, as far as rank @rk@.+-- Returns its progress. Each successive application of @extractBin@ takes+-- amortized /O(1)/ time, so applying it from the beginning takes /O(log n)/ time.+extractBin :: LEq a -> BinomForest rk a -> MExtract rk a+extractBin _ Nil = No+extractBin le (Skip f) = case extractBin le f of+  Yes ex -> Yes (incrExtract ex)+  No     -> No+extractBin le (Cons t@(BinomTree x ts) f) = Yes $ case extractBin le f of+  Yes ex@(Extract minKey _ _)+    | minKey `lt` x -> incrExtract' le t ex+  _                 -> Extract x ts (Skip f)+  where a `lt` b = not (b `le` a)++mapMaybeQueue :: (a -> Maybe b) -> LEq b -> (rk a -> MinQueue b) -> MinQueue b -> BinomForest rk a -> MinQueue b+mapMaybeQueue f le fCh q0 forest = q0 `seq` case forest of+  Nil    -> q0+  Skip forest'  -> mapMaybeQueue f le fCh' q0 forest'+  Cons t forest'  -> mapMaybeQueue f le fCh' (union' le (mapMaybeT t) q0) forest'+  where fCh' (Succ t tss) = union' le (mapMaybeT t) (fCh tss)+        mapMaybeT (BinomTree x0 ts) = maybe (fCh ts) (\x -> insert' le x (fCh ts)) (f x0)++type Partition a b = (MinQueue a, MinQueue b)++mapEitherQueue :: (a -> Either b c) -> LEq b -> LEq c -> (rk a -> Partition b c) -> Partition b c ->+  BinomForest rk a -> Partition b c+mapEitherQueue f0 leB leC fCh (q00, q10) ts0 = q00 `seq` q10 `seq` case ts0 of+  Nil        -> (q00, q10)+  Skip ts'   -> mapEitherQueue f0 leB leC fCh' (q00, q10) ts'+  Cons t ts' -> mapEitherQueue f0 leB leC fCh' (both (union' leB) (union' leC) (partitionT t) (q00, q10)) ts'+  where  both f g (x1, x2) (y1, y2) = (f x1 y1, g x2 y2)+         fCh' (Succ t tss) = both (union' leB) (union' leC) (partitionT t) (fCh tss)+         partitionT (BinomTree x ts) = case fCh ts of+           (q0, q1) -> case f0 x of+             Left b  -> (insert' leB b q0, q1)+             Right c  -> (q0, insert' leC c q1)++{-# INLINE tip #-}+-- | Constructs a binomial tree of rank 0.+tip :: a -> BinomTree Zero a+tip x = BinomTree x Zero++insertMinQ :: a -> MinQueue a -> MinQueue a+insertMinQ x Empty = singleton x+insertMinQ x (MinQueue n x' f) = MinQueue (n + 1) x (insertMin (tip x') f)++-- | @insertMin t f@ assumes that the root of @t@ compares as less than+-- every other root in @f@, and merges accordingly.+insertMin :: BinomTree rk a -> BinomForest rk a -> BinomForest rk a+insertMin t Nil = Cons t Nil+insertMin t (Skip f) = Cons t f+insertMin (BinomTree x ts) (Cons t' f) = Skip (insertMin (BinomTree x (Succ t' ts)) f)++-- | Given two binomial forests starting at rank @rk@, takes their union.+-- Each successive application of this function costs /O(1)/, so applying it+-- from the beginning costs /O(log n)/.+merge :: LEq a -> BinomForest rk a -> BinomForest rk a -> BinomForest rk a+merge le f1 f2 = case (f1, f2) of+  (Skip f1', Skip f2')    -> Skip (merge le f1' f2')+  (Skip f1', Cons t2 f2') -> Cons t2 (merge le f1' f2')+  (Cons t1 f1', Skip f2') -> Cons t1 (merge le f1' f2')+  (Cons t1 f1', Cons t2 f2')+        -> Skip (carry le (t1 `cat` t2) f1' f2')+  (Nil, _)                -> f2+  (_, Nil)                -> f1+  where  cat = joinBin le++-- | Merges two binomial forests with another tree. If we are thinking of the trees+-- in the binomial forest as binary digits, this corresponds to a carry operation.+-- Each call to this function takes /O(1)/ time, so in total, it costs /O(log n)/.+carry :: LEq a -> BinomTree rk a -> BinomForest rk a -> BinomForest rk a -> BinomForest rk a+carry le t0 f1 f2 = t0 `seq` case (f1, f2) of+  (Skip f1', Skip f2')    -> Cons t0 (merge le f1' f2')+  (Skip f1', Cons t2 f2') -> Skip (mergeCarry t0 t2 f1' f2')+  (Cons t1 f1', Skip f2') -> Skip (mergeCarry t0 t1 f1' f2')+  (Cons t1 f1', Cons t2 f2')+        -> Cons t0 (mergeCarry t1 t2 f1' f2')+  (Nil, _f2)              -> incr le t0 f2+  (_f1, Nil)              -> incr le t0 f1+  where  cat = joinBin le+         mergeCarry tA tB = carry le (tA `cat` tB)++-- | Merges a binomial tree into a binomial forest. If we are thinking+-- of the trees in the binomial forest as binary digits, this corresponds+-- to adding a power of 2. This costs amortized /O(1)/ time.+incr :: LEq a -> BinomTree rk a -> BinomForest rk a -> BinomForest rk a+incr le t f0 = t `seq` case f0 of+  Nil  -> Cons t Nil+  Skip f     -> Cons t f+  Cons t' f' -> Skip (incr le (t `cat` t') f')+  where  cat = joinBin le++-- | The carrying operation: takes two binomial heaps of the same rank @k@+-- and returns one of rank @k+1@. Takes /O(1)/ time.+joinBin :: LEq a -> BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a+joinBin le t1@(BinomTree x1 ts1) t2@(BinomTree x2 ts2)+  | x1 `le` x2 = BinomTree x1 (Succ t2 ts1)+  | otherwise  = BinomTree x2 (Succ t1 ts2)++instance Functor Zero where+  fmap _ _ = Zero++instance Functor rk => Functor (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 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 Foldable Zero where+  foldr _ z _ = z+  foldl _ z _ = z++instance Foldable rk => Foldable (Succ rk) where+  foldr f z (Succ t ts) = foldr f (foldr f z ts) t+  foldl f z (Succ t ts) = foldl f (foldl f z t) ts++instance Foldable rk => Foldable (BinomTree rk) where+  foldr f z (BinomTree x ts) = x `f` foldr f z ts+  foldl f z (BinomTree x ts) = foldl f (z `f` x) ts++instance Foldable rk => Foldable (BinomForest rk) where+  foldr _ z Nil          = z+  foldr f z (Skip tss)   = foldr f z tss+  foldr f z (Cons t tss) = foldr f (foldr f z tss) t+  foldl _ z Nil          = z+  foldl f z (Skip tss)   = foldl f z tss+  foldl f z (Cons t tss) = foldl f (foldl f z t) tss++-- instance Traversable Zero where+--   traverse _ _ = pure Zero+--+-- instance Traversable rk => Traversable (Succ rk) where+--   traverse f (Succ t ts) = Succ <$> traverse f t <*> traverse f ts+--+-- instance Traversable rk => Traversable (BinomTree rk) where+--   traverse f (BinomTree x ts) = BinomTree <$> f x <*> traverse f ts+--+-- instance Traversable rk => Traversable (BinomForest rk) where+--   traverse _ Nil = pure Nil+--   traverse f (Skip tss) = Skip <$> traverse f tss+--   traverse f (Cons t tss) = Cons <$> traverse f t <*> traverse f tss++mapU :: (a -> b) -> MinQueue a -> MinQueue b+mapU _ Empty = Empty+mapU f (MinQueue n x ts) = MinQueue n (f x) (f <$> ts)++-- | /O(n)/. Unordered right fold on a priority queue.+foldrU :: (a -> b -> b) -> b -> MinQueue a -> b+foldrU _ z Empty = z+foldrU f z (MinQueue _ x ts) = x `f` foldr f z ts++-- | /O(n)/. Unordered left fold on a priority queue.+foldlU :: (b -> a -> b) -> b -> MinQueue a -> b+foldlU _ z Empty = z+foldlU f z (MinQueue _ x ts) = foldl f (z `f` x) ts++-- traverseU :: Applicative f => (a -> f b) -> MinQueue a -> f (MinQueue b)+-- traverseU _ Empty = pure Empty+-- traverseU f (MinQueue n x ts) = MinQueue n <$> f x <*> traverse f ts++-- | Forces the spine of the priority queue.+seqSpine :: MinQueue a -> b -> b+seqSpine Empty z = z+seqSpine (MinQueue _ _ ts) z = seqSpineF ts z++seqSpineF :: BinomForest rk a -> b -> b+seqSpineF Nil z          = z+seqSpineF (Skip ts') z   = seqSpineF ts' z+seqSpineF (Cons _ ts') z = seqSpineF ts' z++-- | Constructs a priority queue out of the keys of the specified 'Prio.MinPQueue'.+keysQueue :: Prio.MinPQueue k a -> MinQueue k+keysQueue Prio.Empty = Empty+keysQueue (Prio.MinPQ n k _ ts) = MinQueue n k (keysF (const Zero) ts)++keysF :: (pRk k a -> rk k) -> Prio.BinomForest pRk k a -> BinomForest rk k+keysF f ts0 = case ts0 of+  Prio.Nil       -> Nil+  Prio.Skip ts'  -> Skip (keysF f' ts')+  Prio.Cons (Prio.BinomTree k _ ts) ts'+    -> Cons (BinomTree k (f ts)) (keysF f' ts')+  where  f' (Prio.Succ (Prio.BinomTree k _ ts) tss) = Succ (BinomTree k (f ts)) (f tss)++class NFRank rk where+  rnfRk :: NFData a => rk a -> ()++instance NFRank Zero where+  rnfRk _ = ()++instance NFRank rk => NFRank (Succ rk) where+  rnfRk (Succ t ts) = t `deepseq` rnfRk ts++instance (NFData a, NFRank rk) => NFData (BinomTree rk a) where+  rnf (BinomTree x ts) = x `deepseq` rnfRk ts++instance (NFData a, NFRank rk) => NFData (BinomForest rk a) where+  rnf Nil         = ()+  rnf (Skip ts)   = rnf ts+  rnf (Cons t ts) = t `deepseq` rnf ts++instance NFData a => NFData (MinQueue a) where+  rnf Empty             = ()+  rnf (MinQueue _ x ts) = x `deepseq` rnf ts
+ src/Data/PQueue/Max.hs view
@@ -0,0 +1,349 @@+{-# LANGUAGE CPP #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.PQueue.Max+-- Copyright   :  (c) Louis Wasserman 2010+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  portable+--+-- General purpose priority queue, supporting view-maximum operations.+--+-- An amortized running time is given for each operation, with /n/ referring+-- to the length of the sequence and /k/ being the integral index used by+-- some operations. These bounds hold even in a persistent (shared) setting.+--+-- This implementation is based on a binomial heap augmented with a global root.+-- The spine of the heap is maintained lazily. To force the spine of the heap,+-- use 'seqSpine'.+--+-- This implementation does not guarantee stable behavior.+--+-- This implementation offers a number of methods of the form @xxxU@, where @U@ stands for+-- unordered. No guarantees whatsoever are made on the execution or traversal order of+-- these functions.+-----------------------------------------------------------------------------+module Data.PQueue.Max (+  MaxQueue,+  -- * Basic operations+  empty,+  null,+  size,+  -- * Query operations+  findMax,+  getMax,+  deleteMax,+  deleteFindMax,+  delete,+  maxView,+  -- * Construction operations+  singleton,+  insert,+  union,+  unions,+  -- * Subsets+  -- ** Extracting subsets+  (!!),+  take,+  drop,+  splitAt,+  -- ** Predicates+  takeWhile,+  dropWhile,+  span,+  break,+  -- * Filter/Map+  filter,+  partition,+  mapMaybe,+  mapEither,+  -- * Fold\/Functor\/Traversable variations+  map,+  foldrAsc,+  foldlAsc,+  foldrDesc,+  foldlDesc,+  -- * List operations+  toList,+  toAscList,+  toDescList,+  fromList,+  fromAscList,+  fromDescList,+  -- * Unordered operations+  mapU,+  foldrU,+  foldlU,+  elemsU,+  toListU,+  -- * Miscellaneous operations+  keysQueue,+  seqSpine) where++import Control.DeepSeq (NFData(rnf))++import Data.Functor ((<$>))+import Data.Monoid (Monoid(mempty, mappend))+import Data.Maybe (fromMaybe)+import Data.Foldable (foldl, foldr)++#if MIN_VERSION_base(4,9,0)+import Data.Semigroup (Semigroup((<>)))+#endif++import qualified Data.PQueue.Min as Min+import qualified Data.PQueue.Prio.Max.Internals as Prio+import Data.PQueue.Prio.Max.Internals (Down(..))++import Prelude hiding (null, foldr, foldl, take, drop, takeWhile, dropWhile, splitAt, span, break, (!!), filter)++#ifdef __GLASGOW_HASKELL__+import GHC.Exts (build)+import Text.Read (Lexeme(Ident), lexP, parens, prec,+  readPrec, readListPrec, readListPrecDefault)+import Data.Data+#else+build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]+build f = f (:) []+#endif++-- | A priority queue with elements of type @a@. Supports extracting the maximum element.+-- Implemented as a wrapper around 'Min.MinQueue'.+newtype MaxQueue a = MaxQ (Min.MinQueue (Down a))+# if __GLASGOW_HASKELL__+  deriving (Eq, Ord, Data, Typeable)+# else+  deriving (Eq, Ord)+# endif++instance NFData a => NFData (MaxQueue a) where+  rnf (MaxQ q) = rnf q++instance (Ord a, Show a) => Show (MaxQueue a) where+  showsPrec p xs = showParen (p > 10) $+    showString "fromDescList " . shows (toDescList xs)++instance Read a => Read (MaxQueue a) where+#ifdef __GLASGOW_HASKELL__+  readPrec = parens $ prec 10 $ do+    Ident "fromDescList" <- lexP+    xs <- readPrec+    return (fromDescList xs)++  readListPrec = readListPrecDefault+#else+  readsPrec p = readParen (p > 10) $ \r -> do+    ("fromDescList",s) <- lex r+    (xs,t) <- reads s+    return (fromDescList xs,t)+#endif++#if MIN_VERSION_base(4,9,0)+instance Ord a => Semigroup (MaxQueue a) where+  (<>) = union+#endif++instance Ord a => Monoid (MaxQueue a) where+  mempty = empty+  mappend = union++-- | /O(1)/. The empty priority queue.+empty :: MaxQueue a+empty = MaxQ Min.empty++-- | /O(1)/. Is this the empty priority queue?+null :: MaxQueue a -> Bool+null (MaxQ q) = Min.null q++-- | /O(1)/. The number of elements in the queue.+size :: MaxQueue a -> Int+size (MaxQ q) = Min.size q++-- | /O(1)/. Returns the maximum element of the queue. Throws an error on an empty queue.+findMax :: MaxQueue a -> a+findMax = fromMaybe (error "Error: findMax called on empty queue") . getMax++-- | /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++-- | /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)++-- | /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)+deleteFindMax = fromMaybe (error "Error: deleteFindMax called on empty queue") . maxView++-- | /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')++-- | /O(log n)/. Delete the top (maximum) element of the sequence, if there is one.+delete :: Ord a => MaxQueue a -> Maybe (MaxQueue a)+delete = fmap snd . maxView++-- | /O(1)/. Construct a priority queue with a single element.+singleton :: a -> MaxQueue a+singleton = MaxQ . Min.singleton . Down++-- | /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)++-- | /O(log (min(n1,n2)))/. Take the union of two priority queues.+union :: Ord a => MaxQueue a -> MaxQueue a -> MaxQueue a+MaxQ q1 `union` MaxQ q2 = MaxQ (q1 `Min.union` q2)++-- | 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])++-- | /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)++{-# INLINE take #-}+-- | /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]++-- | /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)++-- | /O(k log n)/. Equivalent to @(take k queue, drop k queue)@.+splitAt :: Ord a => Int -> MaxQueue a -> ([a], MaxQueue a)+splitAt k (MaxQ q) = (map unDown xs, MaxQ q') where+  (xs, q') = Min.splitAt k q++-- | '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) = map unDown (Min.takeWhile (p . unDown) q)++-- | '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)++-- | 'span', applied to a predicate @p@ and a queue @queue@, returns a tuple where+-- first element is longest prefix (possibly empty) of @queue@ of elements that+-- satisfy @p@ and second element is the remainder of the queue.+--+span :: Ord a => (a -> Bool) -> MaxQueue a -> ([a], MaxQueue a)+span p (MaxQ q) = (map unDown xs, MaxQ q') where+  (xs, q') = Min.span (p . unDown) q++-- | '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+-- /do not satisfy/ @p@ and second element is the remainder of the queue.+break :: Ord a => (a -> Bool) -> MaxQueue a -> ([a], MaxQueue a)+break p = span (not . p)++-- | /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)++-- | /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++-- | /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)++-- | /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++-- | /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/.+mapU :: (a -> b) -> MaxQueue a -> MaxQueue b+mapU f (MaxQ q) = MaxQ (Min.mapU (\(Down a) -> Down (f a)) q)++-- | /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++-- | /O(n)/. Unordered left fold on a priority queue.+foldlU :: (b -> a -> b) -> b -> MaxQueue a -> b+foldlU f z (MaxQ q) = Min.foldlU (foldl f) z q++{-# INLINE elemsU #-}+-- | Equivalent to 'toListU'.+elemsU :: MaxQueue a -> [a]+elemsU = toListU++{-# 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) = map unDown (Min.toListU q)++-- | /O(n log n)/. Performs a right-fold on the elements of a priority queue in ascending order.+-- @'foldrAsc' f z q == 'foldlDesc' (flip f) z q@.+foldrAsc :: Ord a => (a -> b -> b) -> b -> MaxQueue a -> b+foldrAsc = foldlDesc . flip++-- | /O(n log n)/. Performs a left-fold on the elements of a priority queue in descending order.+-- @'foldlAsc' f z q == 'foldrDesc' (flip f) z q@.+foldlAsc :: Ord a => (b -> a -> b) -> b -> MaxQueue a -> b+foldlAsc = foldrDesc . flip++-- | /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++-- | /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++{-# INLINE toAscList #-}+-- | /O(n log n)/. Extracts the elements of the priority queue in ascending order.+toAscList :: Ord a => MaxQueue a -> [a]+toAscList q = build (\c nil -> foldrAsc c nil q)+-- I can see no particular reason this does not simply forward to Min.toDescList. (lsp, 2016)++{-# INLINE toDescList #-}+-- | /O(n log n)/. Extracts the elements of the priority queue in descending order.+toDescList :: Ord a => MaxQueue a -> [a]+toDescList q = build (\c nil -> foldrDesc c nil q)+-- I can see no particular reason this does not simply forward to Min.toAscList. (lsp, 2016)++{-# INLINE toList #-}+-- | /O(n log n)/. Returns the elements of the priority queue in ascending order. Equivalent to 'toDescList'.+--+-- If the order of the elements is irrelevant, consider using 'toListU'.+toList :: Ord a => MaxQueue a -> [a]+toList (MaxQ q) = map unDown (Min.toList q)++{-# INLINE fromAscList #-}+-- | /O(n)/. Constructs a priority queue from an ascending list. /Warning/: Does not check the precondition.+fromAscList :: [a] -> MaxQueue a+fromAscList = MaxQ . Min.fromDescList . map Down++{-# 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 . map Down++{-# INLINE fromList #-}+-- | /O(n log n)/. Constructs a priority queue from an unordered list.+fromList :: Ord a => [a] -> MaxQueue a+fromList = foldr insert empty++-- | /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)++-- | /O(log n)/. Forces the spine of the heap.+seqSpine :: MaxQueue a -> b -> b+seqSpine (MaxQ q) = Min.seqSpine q
+ src/Data/PQueue/Min.hs view
@@ -0,0 +1,305 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.PQueue.Min+-- Copyright   :  (c) Louis Wasserman 2010+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  portable+--+-- General purpose priority queue, supporting extract-minimum operations.+--+-- An amortized running time is given for each operation, with /n/ referring+-- to the length of the sequence and /k/ being the integral index used by+-- some operations. These bounds hold even in a persistent (shared) setting.+--+-- This implementation is based on a binomial heap augmented with a global root.+-- The spine of the heap is maintained lazily. To force the spine of the heap,+-- use 'seqSpine'.+--+-- This implementation does not guarantee stable behavior.+--+-- This implementation offers a number of methods of the form @xxxU@, where @U@ stands for+-- unordered. No guarantees whatsoever are made on the execution or traversal order of+-- these functions.+-----------------------------------------------------------------------------+module Data.PQueue.Min (+  MinQueue,+  -- * Basic operations+  empty,+  null,+  size,+  -- * Query operations+  findMin,+  getMin,+  deleteMin,+  deleteFindMin,+  minView,+  -- * Construction operations+  singleton,+  insert,+  union,+  unions,+  -- * Subsets+  -- ** Extracting subsets+  (!!),+  take,+  drop,+  splitAt,+  -- ** Predicates+  takeWhile,+  dropWhile,+  span,+  break,+  -- * Filter/Map+  filter,+  partition,+  mapMaybe,+  mapEither,+  -- * Fold\/Functor\/Traversable variations+  map,+  foldrAsc,+  foldlAsc,+  foldrDesc,+  foldlDesc,+  -- * List operations+  toList,+  toAscList,+  toDescList,+  fromList,+  fromAscList,+  fromDescList,+  -- * Unordered operations+  mapU,+  foldrU,+  foldlU,+  elemsU,+  toListU,+  -- * Miscellaneous operations+  keysQueue,+  seqSpine) where++import Prelude hiding (null, foldr, foldl, take, drop, takeWhile, dropWhile, splitAt, span, break, (!!), filter, map)++import Data.Monoid (Monoid(mempty, mappend, mconcat))+import Data.Foldable (foldl, foldr, 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.PQueue.Internals++#ifdef __GLASGOW_HASKELL__+import GHC.Exts (build)+import Text.Read (Lexeme(Ident), lexP, parens, prec,+  readPrec, readListPrec, readListPrecDefault)+#else+build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]+build f = f (:) []+#endif++-- instance++instance (Ord a, Show a) => Show (MinQueue a) where+  showsPrec p xs = showParen (p > 10) $+    showString "fromAscList " . shows (toAscList xs)++instance Read a => Read (MinQueue a) where+#ifdef __GLASGOW_HASKELL__+  readPrec = parens $ prec 10 $ do+    Ident "fromAscList" <- lexP+    xs <- readPrec+    return (fromAscList xs)++  readListPrec = readListPrecDefault+#else+  readsPrec p = readParen (p > 10) $ \r -> do+    ("fromAscList",s) <- lex r+    (xs,t) <- reads s+    return (fromAscList xs,t)+#endif++#if MIN_VERSION_base(4,9,0)+instance Ord a => Semigroup (MinQueue a) where+  (<>) = union+#endif++instance Ord a => Monoid (MinQueue a) where+  mempty = empty+  mappend = union+  mconcat = unions++-- | /O(1)/. Returns the minimum element. Throws an error on an empty queue.+findMin :: MinQueue a -> a+findMin = fromMaybe (error "Error: findMin called on empty queue") . getMin++-- | /O(log n)/. Deletes the minimum element. If the queue is empty, does nothing.+deleteMin :: Ord a => MinQueue a -> MinQueue a+deleteMin q = case minView q of+  Nothing      -> empty+  Just (_, q') -> q'++-- | /O(log n)/. Extracts the minimum element. Throws an error on an empty queue.+deleteFindMin :: Ord a => MinQueue a -> (a, MinQueue a)+deleteFindMin = fromMaybe (error "Error: deleteFindMin called on empty queue") . minView++-- | Takes the union of a list of priority queues. Equivalent to @'foldl' 'union' 'empty'@.+unions :: Ord a => [MinQueue a] -> MinQueue a+unions = foldl union empty++-- | /O(k log n)/. Index (subscript) operator, starting from 0. @queue !! k@ returns the @(k+1)@th smallest+-- element in the queue. Equivalent to @toAscList queue !! k@.+(!!) :: Ord a => MinQueue a -> Int -> a+q !! n  | n >= size q+    = error "Data.PQueue.Min.!!: index too large"+q !! n = (List.!!) (toAscList q) n++{-# INLINE takeWhile #-}+-- | '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) -> MinQueue a -> [a]+takeWhile p = foldWhileFB p . toAscList++{-# INLINE foldWhileFB #-}+-- | Equivalent to Data.List.takeWhile, but is a better producer.+foldWhileFB :: (a -> Bool) -> [a] -> [a]+foldWhileFB p xs0 = build (\c nil -> let+  consWhile x xs+    | p x    = x `c` xs+    | otherwise  = nil+  in foldr consWhile nil xs0)++-- | 'dropWhile' @p queue@ returns the queue remaining after 'takeWhile' @p queue@.+dropWhile :: Ord a => (a -> Bool) -> MinQueue a -> MinQueue a+dropWhile p = drop' where+  drop' q = case minView q of+    Just (x, q') | p x -> drop' q'+    _                  -> q++-- | 'span', applied to a predicate @p@ and a queue @queue@, returns a tuple where+-- first element is longest prefix (possibly empty) of @queue@ of elements that+-- satisfy @p@ and second element is the remainder of the queue.+span :: Ord a => (a -> Bool) -> MinQueue a -> ([a], MinQueue a)+span p queue = case minView queue of+  Just (x, q')+    | p x  -> let (ys, q'') = span p q' in (x : ys, q'')+  _        -> ([], queue)++-- | '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+-- /do not satisfy/ @p@ and second element is the remainder of the queue.+break :: Ord a => (a -> Bool) -> MinQueue a -> ([a], MinQueue a)+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@,+-- 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'@.+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)@.+splitAt :: Ord a => Int -> MinQueue a -> ([a], MinQueue a)+splitAt n queue = n `seq` case minView queue of+  Just (x, queue')+    | n > 0  -> let (xs, queue'') = splitAt (n - 1) queue' in (x : xs, queue'')+  _          -> ([], queue)++-- | /O(n)/. Returns the queue with all elements not satisfying @p@ removed.+filter :: Ord a => (a -> Bool) -> MinQueue a -> MinQueue a+filter p = mapMaybe (\x -> if p x then Just x else Nothing)++-- | /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) -> MinQueue a -> (MinQueue a, MinQueue a)+partition p = mapEither (\x -> if p x then Left x else Right x)++-- | /O(n)/. Creates a new priority queue containing the images of the elements of this queue.+-- Equivalent to @'fromList' . 'Data.List.map' f . toList@.+map :: Ord b => (a -> b) -> MinQueue a -> MinQueue b+map f = foldrU (insert . f) empty++{-# INLINE toAscList #-}+-- | /O(n log n)/. Extracts the elements of the priority queue in ascending order.+toAscList :: Ord a => MinQueue a -> [a]+toAscList queue = build (\c nil -> foldrAsc c nil queue)++{-# INLINE toDescList #-}+-- | /O(n log n)/. Extracts the elements of the priority queue in descending order.+toDescList :: Ord a => MinQueue a -> [a]+toDescList queue = build (\c nil -> foldrDesc c nil queue)++{-# INLINE toList #-}+-- | /O(n log n)/. Returns the elements of the priority queue in ascending order. Equivalent to 'toAscList'.+--+-- If the order of the elements is irrelevant, consider using 'toListU'.+toList :: Ord a => MinQueue a -> [a]+toList = toAscList++{-# RULES+  "toAscList" forall q . toAscList q = build (\c nil -> foldrAsc c nil q);+    -- inlining doesn't seem to be working out =/+  "toDescList" forall q . toDescList q = build (\c nil -> foldrDesc c nil q);+  #-}++-- | /O(n log n)/. Performs a right-fold on the elements of a priority queue in descending order.+-- @foldrDesc f z q == foldlAsc (flip f) z q@.+foldrDesc :: Ord a => (a -> b -> b) -> b -> MinQueue a -> b+foldrDesc = foldlAsc . flip++-- | /O(n log n)/. Performs a left-fold on the elements of a priority queue in descending order.+-- @foldlDesc f z q == foldrAsc (flip f) z q@.+foldlDesc :: Ord a => (b -> a -> b) -> b -> MinQueue a -> b+foldlDesc = foldrAsc . flip++{-# INLINE fromList #-}+-- | /O(n)/. Constructs a priority queue from an unordered list.+fromList :: Ord a => [a] -> MinQueue a+fromList = foldr insert empty++{-# RULES+  "fromList" fromList = foldr insert empty;+  "fromAscList" fromAscList = foldr insertMinQ empty;+  #-}++{-# INLINE fromAscList #-}+-- | /O(n)/. Constructs a priority queue from an ascending list. /Warning/: Does not check the precondition.+fromAscList :: [a] -> MinQueue a+fromAscList = foldr insertMinQ empty++-- | /O(n)/. Constructs a priority queue from an descending list. /Warning/: Does not check the precondition.+fromDescList :: [a] -> MinQueue a+fromDescList = foldl' (flip insertMinQ) empty++-- | Maps a function over the elements of the queue, ignoring order. This function is only safe if the function is monotonic.+-- This function /does not/ check the precondition.+mapU :: (a -> b) -> MinQueue a -> MinQueue b+mapU = mapMonotonic++{-# INLINE elemsU #-}+-- | Equivalent to 'toListU'.+elemsU :: MinQueue a -> [a]+elemsU = toListU++-- | /O(n)/. Returns the elements of the queue, in no particular order.+toListU :: MinQueue a -> [a]+toListU q = build (\c n -> foldrU c n q)++{-# RULES+  "foldr/toListU" forall f z q . foldr f z (toListU q) = foldrU f z q;+  "foldl/toListU" forall f z q . foldl f z (toListU q) = foldlU f z q;+  #-}
+ src/Data/PQueue/Prio/Internals.hs view
@@ -0,0 +1,489 @@+{-# LANGUAGE CPP #-}++module Data.PQueue.Prio.Internals (+  MinPQueue(..),+  BinomForest(..),+  BinomHeap,+  BinomTree(..),+  Zero(..),+  Succ(..),+  CompF,+  empty,+  null,+  size,+  singleton,+  insert,+  insertBehind,+  union,+  getMin,+  adjustMinWithKey,+  updateMinWithKey,+  minViewWithKey,+  mapWithKey,+  mapKeysMonotonic,+  mapMaybeWithKey,+  mapEitherWithKey,+  foldrWithKey,+  foldlWithKey,+  insertMin,+  foldrWithKeyU,+  foldlWithKeyU,+  traverseWithKeyU,+  seqSpine,+  mapForest+  ) where++import Control.Applicative (Applicative(..), (<$>))+import Control.Applicative.Identity (Identity(Identity, runIdentity))+import Control.DeepSeq (NFData(rnf), deepseq)++import Data.Monoid ((<>))++import Prelude hiding (null)++#if __GLASGOW_HASKELL__++import Data.Data++instance (Data k, Data a, Ord k) => Data (MinPQueue k a) where+  gfoldl f z m = z (foldr (uncurry' insertMin) empty) `f` foldrWithKey (curry (:)) [] m+  toConstr _   = error "toConstr"+  gunfold _ _  = error "gunfold"+  dataTypeOf _ = mkNoRepType "Data.PQueue.Prio.Min.MinPQueue"+  dataCast2 f  = gcast2 f++#endif++(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d+(f .: g) x y = f (g x y)++first' :: (a -> b) -> (a, c) -> (b, c)+first' f (a, c) = (f a, c)++second' :: (b -> c) -> (a, b) -> (a, c)+second' f (a, b) = (a, f b)++uncurry' :: (a -> b -> c) -> (a, b) -> c+uncurry' f (a, b) = f a b++infixr 8 .:++-- | A priority queue where values of type @a@ are annotated with keys of type @k@.+-- The queue supports extracting the element with minimum key.+data MinPQueue k a = Empty | MinPQ {-# UNPACK #-} !Int k a (BinomHeap k a)+#if __GLASGOW_HASKELL__+  deriving (Typeable)+#endif++data BinomForest rk k a =+  Nil |+  Skip (BinomForest (Succ rk) k a) |+  Cons {-# UNPACK #-} !(BinomTree rk k a) (BinomForest (Succ rk) k a)+type BinomHeap = BinomForest Zero++data BinomTree rk k a = BinomTree k a (rk k a)+data Zero k a = Zero+data Succ rk k a = Succ {-# UNPACK #-} !(BinomTree rk k a) (rk k a)++type CompF a = a -> a -> Bool++instance (Ord k, Eq a) => Eq (MinPQueue k a) where+  MinPQ n1 k1 a1 ts1 == MinPQ n2 k2 a2 ts2 =+    n1 == n2 && eqExtract k1 a1 ts1 k2 a2 ts2+  Empty == Empty = True+  _     == _     = False++eqExtract :: (Ord k, Eq a) => k -> a -> BinomForest rk k a -> k -> a -> BinomForest rk k a -> Bool+eqExtract k10 a10 ts10 k20 a20 ts20 =+  k10 == k20 && a10 == a20 &&+  case (extract ts10, extract ts20) of+    (Yes (Extract k1 a1 _ ts1'), Yes (Extract k2 a2 _ ts2'))+             -> eqExtract k1 a1 ts1' k2 a2 ts2'+    (No, No) -> True+    _        -> False++instance (Ord k, Ord a) => Ord (MinPQueue k a) where+  MinPQ _n1 k10 a10 ts10 `compare` MinPQ _n2 k20 a20 ts20 =+    cmpExtract k10 a10 ts10 k20 a20 ts20+  Empty `compare` Empty   = EQ+  Empty `compare` MinPQ{} = LT+  MinPQ{} `compare` Empty = GT++cmpExtract :: (Ord k, Ord a) => k -> a -> BinomForest rk k a -> k -> a -> BinomForest rk k a -> Ordering+cmpExtract k10 a10 ts10 k20 a20 ts20 =+  k10 `compare` k20 <> a10 `compare` a20 <>+  case (extract ts10, extract ts20) of+    (Yes (Extract k1 a1 _ ts1'), Yes (Extract k2 a2 _ ts2'))+                -> cmpExtract k1 a1 ts1' k2 a2 ts2'+    (No, Yes{}) -> LT+    (Yes{}, No) -> GT+    (No, No)    -> EQ++-- | /O(1)/. Returns the empty priority queue.+empty :: MinPQueue k a+empty = Empty++-- | /O(1)/. Checks if this priority queue is empty.+null :: MinPQueue k a -> Bool+null Empty = True+null _     = False++-- | /O(1)/. Returns the size of this priority queue.+size :: MinPQueue k a -> Int+size Empty           = 0+size (MinPQ n _ _ _) = n++-- | /O(1)/. Constructs a singleton priority queue.+singleton :: k -> a -> MinPQueue k a+singleton k a = MinPQ 1 k a Nil++-- | Amortized /O(1)/, worst-case /O(log n)/. Inserts+-- an element with the specified key into the queue.+insert :: Ord k => k -> a -> MinPQueue k a -> MinPQueue k a+insert = insert' (<=)++-- | /O(n)/ (an earlier implementation had /O(1)/ but was buggy).+-- Insert an element with the specified key into the priority queue,+-- putting it behind elements whose key compares equal to the+-- inserted one.+insertBehind :: Ord k => k -> a -> MinPQueue k a -> MinPQueue k a+insertBehind k v q =+  let (smaller, larger) = spanKey (<= k) q+  in  foldr (uncurry insert) (insert k v larger) smaller++spanKey :: Ord k => (k -> Bool) -> MinPQueue k a -> ([(k, a)], MinPQueue k a)+spanKey p q = case minViewWithKey q of+  Just (t@(k, _), q') | p k ->+    let (kas, q'') = spanKey p q' in (t : kas, q'')+  _ -> ([], q)++-- | Internal helper method, using a specific comparator function.+insert' :: CompF k -> k -> a -> MinPQueue k a -> MinPQueue k a+insert' _ k a Empty = singleton k a+insert' le k a (MinPQ n k' a' ts)+  | k `le` k' = MinPQ (n + 1) k  a  (incr le (tip k' a') ts)+  | otherwise = MinPQ (n + 1) k' a' (incr le (tip k  a ) ts)++-- | Amortized /O(log(min(n1, n2)))/, worst-case /O(log(max(n1, n2)))/. Returns the union+-- of the two specified queues.+union :: Ord k => MinPQueue k a -> MinPQueue k a -> MinPQueue k a+union = union' (<=)++-- | Takes the union of the two specified queues, using the given comparison function.+union' :: CompF k -> MinPQueue k a -> MinPQueue k a -> MinPQueue k a+union' le (MinPQ n1 k1 a1 ts1) (MinPQ n2 k2 a2 ts2)+  | k1 `le` k2 = MinPQ (n1 + n2) k1 a1 (insMerge k2 a2)+  | otherwise  = MinPQ (n1 + n2) k2 a2 (insMerge k1 a1)+  where  insMerge k a = carryForest le (tip k a) ts1 ts2+union' _ Empty q2 = q2+union' _ q1 Empty = q1++-- | /O(1)/. The minimal (key, element) in the queue, if the queue is nonempty.+getMin :: MinPQueue k a -> Maybe (k, a)+getMin (MinPQ _ k a _) = Just (k, a)+getMin _               = Nothing++-- | /O(1)/. Alter the value at the minimum key. If the queue is empty, does nothing.+adjustMinWithKey :: (k -> a -> a) -> MinPQueue k a -> MinPQueue k a+adjustMinWithKey _ Empty = Empty+adjustMinWithKey f (MinPQ n k a ts) = MinPQ n k (f k a) ts++-- | /O(log n)/. (Actually /O(1)/ if there's no deletion.) Update the value at the minimum key.+-- If the queue is empty, does nothing.+updateMinWithKey :: Ord k => (k -> a -> Maybe a) -> MinPQueue k a -> MinPQueue k a+updateMinWithKey _ Empty = Empty+updateMinWithKey f (MinPQ n k a ts) = case f k a of+  Nothing  -> extractHeap (<=) n ts+  Just a'  -> MinPQ n k a' ts++-- | /O(log n)/. Retrieves the minimal (key, value) pair of the map, and the map stripped of that+-- element, or 'Nothing' if passed an empty map.+minViewWithKey :: Ord k => MinPQueue k a -> Maybe ((k, a), MinPQueue k a)+minViewWithKey Empty            = Nothing+minViewWithKey (MinPQ n k a ts) = Just ((k, a), extractHeap (<=) n ts)++-- | /O(n)/. Map a function over all values in the queue.+mapWithKey :: (k -> a -> b) -> MinPQueue k a -> MinPQueue k b+mapWithKey f = runIdentity . traverseWithKeyU (Identity .: f)++-- | /O(n)/. @'mapKeysMonotonic' f q == 'mapKeys' f q@, but only works when @f@ is strictly+-- monotonic. /The precondition is not checked./ This function has better performance than+-- 'mapKeys'.+mapKeysMonotonic :: (k -> k') -> MinPQueue k a -> MinPQueue k' a+mapKeysMonotonic _ Empty = Empty+mapKeysMonotonic f (MinPQ n k a ts) = MinPQ n (f k) a (mapKeysMonoF f (const Zero) ts)++-- | /O(n)/. Map values and collect the 'Just' results.+mapMaybeWithKey :: Ord k => (k -> a -> Maybe b) -> MinPQueue k a -> MinPQueue k b+mapMaybeWithKey _ Empty            = Empty+mapMaybeWithKey f (MinPQ _ k a ts) = maybe id (insert k) (f k a) (mapMaybeF (<=) f (const Empty) ts)++-- | /O(n)/. Map values and separate the 'Left' and 'Right' results.+mapEitherWithKey :: Ord k => (k -> a -> Either b c) -> MinPQueue k a -> (MinPQueue k b, MinPQueue k c)+mapEitherWithKey _ Empty            = (Empty, Empty)+mapEitherWithKey f (MinPQ _ k a ts) = either (first' . insert k) (second' . insert k) (f k a)+  (mapEitherF (<=) f (const (Empty, Empty)) ts)++-- | /O(n log n)/. Fold the keys and values in the map, such that+-- @'foldrWithKey' f z q == 'List.foldr' ('uncurry' f) z ('toAscList' q)@.+--+-- If you do not care about the traversal order, consider using 'foldrWithKeyU'.+foldrWithKey :: Ord k => (k -> a -> b -> b) -> b -> MinPQueue k a -> b+foldrWithKey _ z Empty = z+foldrWithKey f z (MinPQ _ k0 a0 ts0) = f k0 a0 (foldF ts0) where+  foldF ts = case extract ts of+    Yes (Extract k a _ ts') -> f k a (foldF ts')+    _                       -> z++-- | /O(n log n)/. Fold the keys and values in the map, such that+-- @'foldlWithKey' f z q == 'List.foldl' ('uncurry' . f) z ('toAscList' q)@.+--+-- If you do not care about the traversal order, consider using 'foldlWithKeyU'.+foldlWithKey :: Ord k => (b -> k -> a -> b) -> b -> MinPQueue k a -> b+foldlWithKey _ z Empty = z+foldlWithKey f z0 (MinPQ _ k0 a0 ts0) = foldF (f z0 k0 a0) ts0 where+  foldF z ts = case extract ts of+    Yes (Extract k a _ ts') -> foldF (f z k a) ts'+    _                       -> z++-- | Equivalent to 'insert', save the assumption that this key is @<=@+-- every other key in the map. /The precondition is not checked./+insertMin :: k -> a -> MinPQueue k a -> MinPQueue k a+insertMin k a Empty = MinPQ 1 k a Nil+insertMin k a (MinPQ n k' a' ts) = MinPQ (n + 1) k a (incrMin (tip k' a') ts)++-- | /O(1)/. Returns a binomial tree of rank zero containing this+-- key and value.+tip :: k -> a -> BinomTree Zero k a+tip k a = BinomTree k a Zero++-- | /O(1)/. Takes the union of two binomial trees of the same rank.+meld :: CompF k -> BinomTree rk k a -> BinomTree rk k a -> BinomTree (Succ rk) k a+meld le t1@(BinomTree k1 v1 ts1) t2@(BinomTree k2 v2 ts2)+  | k1 `le` k2 = BinomTree k1 v1 (Succ t2 ts1)+  | otherwise  = BinomTree k2 v2 (Succ t1 ts2)++-- | Takes the union of two binomial forests, starting at the same rank. Analogous to binary addition.+mergeForest :: CompF k -> BinomForest rk k a -> BinomForest rk k a -> BinomForest rk k a+mergeForest le f1 f2 = case (f1, f2) of+  (Skip ts1, Skip ts2)       -> Skip (mergeForest le ts1 ts2)+  (Skip ts1, Cons t2 ts2)    -> Cons t2 (mergeForest le ts1 ts2)+  (Cons t1 ts1, Skip ts2)    -> Cons t1 (mergeForest le ts1 ts2)+  (Cons t1 ts1, Cons t2 ts2) -> Skip (carryForest le (meld le t1 t2) ts1 ts2)+  (Nil, _)                   -> f2+  (_, Nil)                   -> f1++-- | Takes the union of two binomial forests, starting at the same rank, with an additional tree.+-- Analogous to binary addition when a digit has been carried.+carryForest :: CompF k -> BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a -> BinomForest rk k a+carryForest le t0 f1 f2 = t0 `seq` case (f1, f2) of+  (Cons t1 ts1, Cons t2 ts2) -> Cons t0 (carryMeld t1 t2 ts1 ts2)+  (Cons t1 ts1, Skip ts2)    -> Skip (carryMeld t0 t1 ts1 ts2)+  (Skip ts1, Cons t2 ts2)    -> Skip (carryMeld t0 t2 ts1 ts2)+  (Skip ts1, Skip ts2)       -> Cons t0 (mergeForest le ts1 ts2)+  (Nil, _)                   -> incr le t0 f2+  (_, Nil)                   -> incr le t0 f1+  where  carryMeld = carryForest le .: meld le++-- | Inserts a binomial tree into a binomial forest. Analogous to binary incrementation.+incr :: CompF k -> BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a+incr le t ts = t `seq` case ts of+  Nil         -> Cons t Nil+  Skip ts'    -> Cons t ts'+  Cons t' ts' -> Skip (incr le (meld le t t') ts')++-- | Inserts a binomial tree into a binomial forest. Assumes that the root of this tree+-- is less than all other roots. Analogous to binary incrementation. Equivalent to+-- @'incr' (\_ _ -> True)@.+incrMin :: BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a+incrMin t@(BinomTree k a ts) tss = case tss of+  Nil          -> Cons t Nil+  Skip tss'    -> Cons t tss'+  Cons t' tss' -> Skip (incrMin (BinomTree k a (Succ t' ts)) tss')++extractHeap :: CompF k -> Int -> BinomHeap k a -> MinPQueue k a+extractHeap le n ts = n `seq` case extractForest le ts of+  No                      -> Empty+  Yes (Extract k a _ ts') -> MinPQ (n - 1) k a ts'++-- | A specialized type intended to organize the return of extract-min queries+-- from a binomial forest. We walk all the way through the forest, and then+-- walk backwards. @Extract rk a@ is the result type of an extract-min+-- operation that has walked as far backwards of rank @rk@ -- that is, it+-- has visited every root of rank @>= rk@.+--+-- The interpretation of @Extract minKey minVal children forest@ is+--+--   * @minKey@ is the key of the minimum root visited so far. It may have+--     any rank @>= rk@. We will denote the root corresponding to+--     @minKey@ as @minRoot@.+--+--   * @minVal@ is the value corresponding to @minKey@.+--+--   * @children@ is those children of @minRoot@ which have not yet been+--     merged with the rest of the forest. Specifically, these are+--     the children with rank @< rk@.+--+--   * @forest@ is an accumulating parameter that maintains the partial+--     reconstruction of the binomial forest without @minRoot@. It is+--     the union of all old roots with rank @>= rk@ (except @minRoot@),+--     with the set of all children of @minRoot@ with rank @>= rk@.+--     Note that @forest@ is lazy, so if we discover a smaller key+--     than @minKey@ later, we haven't wasted significant work.++data Extract rk k a = Extract k a (rk k a) (BinomForest rk k a)+data MExtract rk k a = No | Yes {-# UNPACK #-} !(Extract rk k a)++incrExtract :: CompF k -> Maybe (BinomTree rk k a) -> Extract (Succ rk) k a -> Extract rk k a+incrExtract _ Nothing (Extract k a (Succ t ts) tss)+  = Extract k a ts (Cons t tss)+incrExtract le (Just t) (Extract k a (Succ t' ts) tss)+  = Extract k a ts (Skip (incr le (meld le t t') tss))++-- | Walks backward from the biggest key in the forest, as far as rank @rk@.+-- Returns its progress. Each successive application of @extractBin@ takes+-- amortized /O(1)/ time, so applying it from the beginning takes /O(log n)/ time.+extractForest :: CompF k -> BinomForest rk k a -> MExtract rk k a+extractForest _ Nil = No+extractForest le (Skip tss) = case extractForest le tss of+  No     -> No+  Yes ex -> Yes (incrExtract le Nothing ex)+extractForest le (Cons t@(BinomTree k a0 ts) tss) = Yes $ case extractForest le tss of+  Yes ex@(Extract k' _ _ _)+    | k' <? k  -> incrExtract le (Just t) ex+  _            -> Extract k a0 ts (Skip tss)+  where+    a <? b = not (b `le` a)++extract :: (Ord k) => BinomForest rk k a -> MExtract rk k a+extract = extractForest (<=)++-- | Utility function for mapping over a forest.+mapForest :: (k -> a -> b) -> (rk k a -> rk k b) -> BinomForest rk k a -> BinomForest rk k b+mapForest f fCh ts0 = case ts0 of+  Nil      -> Nil+  Skip ts' -> Skip (mapForest f fCh' ts')+  Cons (BinomTree k a ts) tss+           -> Cons (BinomTree k (f k a) (fCh ts)) (mapForest f fCh' tss)+  where fCh' (Succ (BinomTree k a ts) tss)+           = Succ (BinomTree k (f k a) (fCh ts)) (fCh tss)++-- | Utility function for mapping a 'Maybe' function over a forest.+mapMaybeF :: CompF k -> (k -> a -> Maybe b) -> (rk k a -> MinPQueue k b) ->+  BinomForest rk k a -> MinPQueue k b+mapMaybeF le f fCh ts0 = case ts0 of+  Nil    -> Empty+  Skip ts'  -> mapMaybeF le f fCh' ts'+  Cons (BinomTree k a ts) ts'+      -> insF k a (fCh ts) (mapMaybeF le f fCh' ts')+  where  insF k a = maybe id (insert' le k) (f k a) .: union' le+         fCh' (Succ (BinomTree k a ts) tss) =+           insF k a (fCh ts) (fCh tss)++-- | Utility function for mapping an 'Either' function over a forest.+mapEitherF :: CompF k -> (k -> a -> Either b c) -> (rk k a -> (MinPQueue k b, MinPQueue k c)) ->+  BinomForest rk k a -> (MinPQueue k b, MinPQueue k c)+mapEitherF le f0 fCh ts0 = case ts0 of+  Nil    -> (Empty, Empty)+  Skip ts'  -> mapEitherF le f0 fCh' ts'+  Cons (BinomTree k a ts) ts'+      -> insF k a (fCh ts) (mapEitherF le f0 fCh' ts')+  where+    insF k a = either (first' . insert' le k) (second' . insert' le k) (f0 k a) .:+      (union' le `both` union' le)+    fCh' (Succ (BinomTree k a ts) tss) =+      insF k a (fCh ts) (fCh tss)+    both f g (x1, x2) (y1, y2) = (f x1 y1, g x2 y2)++-- | /O(n)/. An unordered right fold over the elements of the queue, in no particular order.+foldrWithKeyU :: (k -> a -> b -> b) -> b -> MinPQueue k a -> b+foldrWithKeyU _ z Empty            = z+foldrWithKeyU f z (MinPQ _ k a ts) = f k a (foldrWithKeyF_ f (const id) ts z)++-- | /O(n)/. An unordered left fold over the elements of the queue, in no particular order.+foldlWithKeyU :: (b -> k -> a -> b) -> b -> MinPQueue k a -> b+foldlWithKeyU _ z Empty = z+foldlWithKeyU f z0 (MinPQ _ k0 a0 ts) = foldlWithKeyF_ (\k a z -> f z k a) (const id) ts (f z0 k0 a0)++-- | /O(n)/. An unordered traversal over a priority queue, in no particular order.+-- While there is no guarantee in which order the elements are traversed, the resulting+-- priority queue will be perfectly valid.+traverseWithKeyU :: Applicative f => (k -> a -> f b) -> MinPQueue k a -> f (MinPQueue k b)+traverseWithKeyU _ Empty = pure Empty+traverseWithKeyU f (MinPQ n k a ts) = MinPQ n k <$> f k a <*> traverseForest f (const (pure Zero)) ts++{-# SPECIALIZE traverseForest :: (k -> a -> Identity b) -> (rk k a -> Identity (rk k b)) -> BinomForest rk k a ->+  Identity (BinomForest rk k b) #-}+traverseForest :: (Applicative f) => (k -> a -> f b) -> (rk k a -> f (rk k b)) -> BinomForest rk k a -> f (BinomForest rk k b)+traverseForest f fCh ts0 = case ts0 of+  Nil       -> pure Nil+  Skip ts'  -> Skip <$> traverseForest f fCh' ts'+  Cons (BinomTree k a ts) tss+    -> Cons <$> (BinomTree k <$> f k a <*> fCh ts) <*> traverseForest f fCh' tss+  where+    fCh' (Succ (BinomTree k a ts) tss)+      = Succ <$> (BinomTree k <$> f k a <*> fCh ts) <*> fCh tss++-- | Unordered right fold on a binomial forest.+foldrWithKeyF_ :: (k -> a -> b -> b) -> (rk k a -> b -> b) -> BinomForest rk k a -> b -> b+foldrWithKeyF_ f fCh ts0 z0 = case ts0 of+  Nil    -> z0+  Skip ts'  -> foldrWithKeyF_ f fCh' ts' z0+  Cons (BinomTree k a ts) ts'+    -> f k a (fCh ts (foldrWithKeyF_ f fCh' ts' z0))+  where+    fCh' (Succ (BinomTree k a ts) tss) z =+      f k a (fCh ts (fCh tss z))++-- | Unordered left fold on a binomial forest.+foldlWithKeyF_ :: (k -> a -> b -> b) -> (rk k a -> b -> b) -> BinomForest rk k a -> b -> b+foldlWithKeyF_ f fCh ts0 = case ts0 of+  Nil    -> id+  Skip ts'  -> foldlWithKeyF_ f fCh' ts'+  Cons (BinomTree k a ts) ts'+    -> foldlWithKeyF_ f fCh' ts' . fCh ts . f k a+  where+    fCh' (Succ (BinomTree k a ts) tss) =+      fCh tss . fCh ts . f k a++-- | Maps a monotonic function over the keys in a binomial forest.+mapKeysMonoF :: (k -> k') -> (rk k a -> rk k' a) -> BinomForest rk k a -> BinomForest rk k' a+mapKeysMonoF f fCh ts0 = case ts0 of+  Nil    -> Nil+  Skip ts'  -> Skip (mapKeysMonoF f fCh' ts')+  Cons (BinomTree k a ts) ts'+    -> Cons (BinomTree (f k) a (fCh ts)) (mapKeysMonoF f fCh' ts')+  where+    fCh' (Succ (BinomTree k a ts) tss) =+      Succ (BinomTree (f k) a (fCh ts)) (fCh tss)++-- | /O(log n)/. Analogous to @deepseq@ in the @deepseq@ package, but only forces the spine of the binomial heap.+seqSpine :: MinPQueue k a -> b -> b+seqSpine Empty z0 = z0+seqSpine (MinPQ _ _ _ ts0) z0 = ts0 `seqSpineF` z0 where+  seqSpineF :: BinomForest rk k a -> b -> b+  seqSpineF ts z = case ts of+    Nil        -> z+    Skip ts'   -> seqSpineF ts' z+    Cons _ ts' -> seqSpineF ts' z++class NFRank rk where+  rnfRk :: (NFData k, NFData a) => rk k a -> ()++instance NFRank Zero where+  rnfRk _ = ()++instance NFRank rk => NFRank (Succ rk) where+  rnfRk (Succ t ts) = t `deepseq` rnfRk ts++instance (NFData k, NFData a, NFRank rk) => NFData (BinomTree rk k a) where+  rnf (BinomTree k a ts) = k `deepseq` a `deepseq` rnfRk ts++instance (NFData k, NFData a, NFRank rk) => NFData (BinomForest rk k a) where+  rnf Nil = ()+  rnf (Skip tss) = rnf tss+  rnf (Cons t tss) = t `deepseq` rnf tss++instance (NFData k, NFData a) => NFData (MinPQueue k a) where+  rnf Empty = ()+  rnf (MinPQ _ k a ts) = k `deepseq` a `deepseq` rnf ts
+ src/Data/PQueue/Prio/Max.hs view
@@ -0,0 +1,480 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.PQueue.Prio.Max+-- Copyright   :  (c) Louis Wasserman 2010+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  portable+--+-- General purpose priority queue.+-- Each element is associated with a /key/, and the priority queue supports+-- viewing and extracting the element with the maximum key.+--+-- A worst-case bound is given for each operation. In some cases, an amortized+-- bound is also specified; these bounds do not hold in a persistent context.+--+-- This implementation is based on a binomial heap augmented with a global root.+-- The spine of the heap is maintained lazily. To force the spine of the heap,+-- use 'seqSpine'.+--+-- We do not guarantee stable behavior.+-- Ties are broken arbitrarily -- that is, if @k1 <= k2@ and @k2 <= k1@, then there+-- are no guarantees about the relative order in which @k1@, @k2@, and their associated+-- elements are returned. (Unlike Data.Map, we allow multiple elements with the+-- same key.)+--+-- This implementation offers a number of methods of the form @xxxU@, where @U@ stands for+-- unordered. No guarantees whatsoever are made on the execution or traversal order of+-- these functions.+-----------------------------------------------------------------------------+module Data.PQueue.Prio.Max (+  MaxPQueue,+  -- * Construction+  empty,+  singleton,+  insert,+  insertBehind,+  union,+  unions,+  -- * Query+  null,+  size,+  -- ** Maximum view+  findMax,+  getMax,+  deleteMax,+  deleteFindMax,+  adjustMax,+  adjustMaxWithKey,+  updateMax,+  updateMaxWithKey,+  maxView,+  maxViewWithKey,+  -- * Traversal+  -- ** Map+  map,+  mapWithKey,+  mapKeys,+  mapKeysMonotonic,+  -- ** Fold+  foldrWithKey,+  foldlWithKey,+  -- ** Traverse+  traverseWithKey,+  -- * Subsets+  -- ** Indexed+  take,+  drop,+  splitAt,+  -- ** Predicates+  takeWhile,+  takeWhileWithKey,+  dropWhile,+  dropWhileWithKey,+  span,+  spanWithKey,+  break,+  breakWithKey,+  -- *** Filter+  filter,+  filterWithKey,+  partition,+  partitionWithKey,+  mapMaybe,+  mapMaybeWithKey,+  mapEither,+  mapEitherWithKey,+  -- * List operations+  -- ** Conversion from lists+  fromList,+  fromAscList,+  fromDescList,+  -- ** Conversion to lists+  keys,+  elems,+  assocs,+  toAscList,+  toDescList,+  toList,+  -- * Unordered operations+  foldrU,+  foldrWithKeyU,+  foldlU,+  foldlWithKeyU,+  traverseU,+  traverseWithKeyU,+  keysU,+  elemsU,+  assocsU,+  toListU,+  -- * Helper methods+  seqSpine+  )+  where++import Control.Applicative (Applicative, (<$>))+import Data.Monoid (Monoid(mempty, mappend, mconcat))+import Data.Traversable (Traversable(traverse))+import Data.Foldable (Foldable, foldr, foldl)+import Data.Maybe (fromMaybe)+import Data.PQueue.Prio.Max.Internals++#if MIN_VERSION_base(4,9,0)+import Data.Semigroup (Semigroup((<>)))+#endif++import Prelude hiding (map, filter, break, span, takeWhile, dropWhile, splitAt, take, drop, (!!), null, foldr, foldl)++import qualified Data.PQueue.Prio.Min as Q++#ifdef __GLASGOW_HASKELL__+import Text.Read (Lexeme(Ident), lexP, parens, prec,+  readPrec, readListPrec, readListPrecDefault)+#else+build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]+build f = f (:) []+#endif++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+#endif++instance Ord k => Monoid (MaxPQueue k a) where+  mempty = empty+  mappend = union+  mconcat = unions++instance (Ord k, Show k, Show a) => Show (MaxPQueue k a) where+  showsPrec p xs = showParen (p > 10) $+    showString "fromDescList " . shows (toDescList xs)++instance (Read k, Read a) => Read (MaxPQueue k a) where+#ifdef __GLASGOW_HASKELL__+  readPrec = parens $ prec 10 $ do+    Ident "fromDescList" <- lexP+    xs <- readPrec+    return (fromDescList xs)++  readListPrec = readListPrecDefault+#else+  readsPrec p = readParen (p > 10) $ \r -> do+    ("fromDescList",s) <- lex r+    (xs,t) <- reads s+    return (fromDescList xs,t)+#endif++instance Functor (MaxPQueue k) where+  fmap f (MaxPQ q) = MaxPQ (fmap f q)++instance Ord k => Foldable (MaxPQueue k) where+  foldr f z (MaxPQ q) = foldr f z q+  foldl f z (MaxPQ q) = foldl f z q++instance Ord k => Traversable (MaxPQueue k) where+  traverse f (MaxPQ q) = MaxPQ <$> traverse f q++-- | /O(1)/. Returns the empty priority queue.+empty :: MaxPQueue k a+empty = MaxPQ Q.empty++-- | /O(1)/. Constructs a singleton priority queue.+singleton :: k -> a -> MaxPQueue k a+singleton k a = MaxPQ (Q.singleton (Down k) a)++-- | 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)++-- | /O(n)/ (an earlier implementation had /O(1)/ but was buggy).+-- Insert an element with the specified key into the priority queue,+-- putting it behind elements whose key compares equal to the+-- inserted one.+insertBehind :: Ord k => k -> a -> MaxPQueue k a -> MaxPQueue k a+insertBehind k a (MaxPQ q) = MaxPQ (Q.insertBehind (Down k) a q)++-- | Amortized /O(log(min(n1, n2)))/, worst-case /O(log(max(n1, n2)))/. 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)++-- | 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])++-- | /O(1)/. Checks if this priority queue is empty.+null :: MaxPQueue k a -> Bool+null (MaxPQ q) = Q.null q++-- | /O(1)/. Returns the size of this priority queue.+size :: MaxPQueue k a -> Int+size (MaxPQ q) = Q.size q++-- | /O(1)/. The maximal (key, element) in the queue. Calls 'error' if empty.+findMax :: MaxPQueue k a -> (k, a)+findMax = fromMaybe (error "Error: findMax called on an empty queue") . getMax++-- | /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)++-- | /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)++-- | /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)+deleteFindMax = fromMaybe (error "Error: deleteFindMax called on an empty queue") . maxViewWithKey++-- | /O(1)/. Alter the value at the maximum key. If the queue is empty, does nothing.+adjustMax :: (a -> a) -> MaxPQueue k a -> MaxPQueue k a+adjustMax = adjustMaxWithKey . const++-- | /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)++-- | /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.+updateMax :: Ord k => (a -> Maybe a) -> MaxPQueue k a -> MaxPQueue k a+updateMax = updateMaxWithKey . const++-- | /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)++-- | /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.+maxView :: Ord k => MaxPQueue k a -> Maybe (a, MaxPQueue k a)+maxView q = do+  ((_, a), q') <- maxViewWithKey q+  return (a, q')++-- | /O(log n)/. Retrieves the maximal (key, value) pair of the map, and the map stripped of that+-- element, or 'Nothing' if passed an empty map.+maxViewWithKey :: Ord k => MaxPQueue k a -> Maybe ((k, a), MaxPQueue k a)+maxViewWithKey (MaxPQ q) = do+  ((Down k, a), q') <- Q.minViewWithKey q+  return ((k, a), MaxPQ q')++-- | /O(n)/. Map a function over all values in the queue.+map :: (a -> b) -> MaxPQueue k a -> MaxPQueue k b+map = mapWithKey . const++-- | /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)++-- | /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)++-- | /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'.+mapKeysMonotonic :: (k -> k') -> MaxPQueue k a -> MaxPQueue k' a+mapKeysMonotonic f (MaxPQ q) = MaxPQ (Q.mapKeysMonotonic (fmap f) q)++-- | /O(n log n)/. Fold the keys and values in the map, such that+-- @'foldrWithKey' f z q == 'List.foldr' ('uncurry' f) z ('toDescList' q)@.+--+-- If you do not care about the traversal order, consider using 'foldrWithKeyU'.+foldrWithKey :: Ord k => (k -> a -> b -> b) -> b -> MaxPQueue k a -> b+foldrWithKey f z (MaxPQ q) = Q.foldrWithKey (f . unDown) z q++-- | /O(n log n)/. Fold the keys and values in the map, such that+-- @'foldlWithKey' f z q == 'List.foldl' ('uncurry' . f) z ('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++-- | /O(n log n)/. Traverses the elements of the queue in descending order by key.+-- (@'traverseWithKey' f q == 'fromDescList' <$> 'traverse' ('uncurry' f) ('toDescList' q)@)+--+-- If you do not care about the /order/ of the traversal, consider using 'traverseWithKeyU'.+traverseWithKey :: (Ord k, Applicative f) => (k -> a -> f b) -> MaxPQueue k a -> f (MaxPQueue k b)+traverseWithKey f (MaxPQ q) = MaxPQ <$> Q.traverseWithKey (f . unDown) q++-- | /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)++-- | /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)++-- | /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')++-- | Takes the longest possible prefix of elements satisfying the predicate.+-- (@'takeWhile' p q == 'List.takeWhile' (p . 'snd') ('toDescList' q)@)+takeWhile :: Ord k => (a -> Bool) -> MaxPQueue k a -> [(k, a)]+takeWhile = takeWhileWithKey . const++-- | Takes the longest possible prefix of elements satisfying the predicate.+-- (@'takeWhile' p q == 'List.takeWhile' (uncurry p) ('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)++-- | Removes the longest possible prefix of elements satisfying the predicate.+dropWhile :: Ord k => (a -> Bool) -> MaxPQueue k a -> MaxPQueue k a+dropWhile = dropWhileWithKey . const++-- | 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)++-- | Equivalent to @('takeWhile' p q, 'dropWhile' p q)@.+span :: Ord k => (a -> Bool) -> MaxPQueue k a -> ([(k, a)], MaxPQueue k a)+span = spanWithKey . const++-- | Equivalent to @'span' ('not' . p)@.+break :: Ord k => (a -> Bool) -> MaxPQueue k a -> ([(k, a)], MaxPQueue k a)+break = breakWithKey . const++-- | 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')++-- | 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')++-- | /O(n)/. Filter all values that satisfy the predicate.+filter :: Ord k => (a -> Bool) -> MaxPQueue k a -> MaxPQueue k a+filter = filterWithKey . const++-- | /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)++-- | /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.+partition :: Ord k => (a -> Bool) -> MaxPQueue k a -> (MaxPQueue k a, MaxPQueue k a)+partition = partitionWithKey . const++-- | /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)++-- | /O(n)/. Map values and collect the 'Just' results.+mapMaybe :: Ord k => (a -> Maybe b) -> MaxPQueue k a -> MaxPQueue k b+mapMaybe = mapMaybeWithKey . const++-- | /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)++-- | /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)+mapEither = mapEitherWithKey . const++-- | /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)++-- | /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)++-- | /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)++-- | /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)++-- | /O(n log n)/. Return all keys of the queue in descending order.+keys :: Ord k => MaxPQueue k a -> [k]+keys = fmap fst . toDescList++-- | /O(n log n)/. Return all elements of the queue in descending order by key.+elems :: Ord k => MaxPQueue k a -> [a]+elems = fmap snd . toDescList++-- | /O(n log n)/. Equivalent to 'toDescList'.+assocs :: Ord k => MaxPQueue k a -> [(k, a)]+assocs = toDescList++-- | /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)++-- | /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)++-- | /O(n log n)/. Equivalent to 'toDescList'.+--+-- If the traversal order is irrelevant, consider using 'toListU'.+toList :: Ord k => MaxPQueue k a -> [(k, a)]+toList = toDescList++-- | /O(n)/. An unordered right fold over the elements of the queue, in no particular order.+foldrU :: (a -> b -> b) -> b -> MaxPQueue k a -> b+foldrU = foldrWithKeyU . const++-- | /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++-- | /O(n)/. An unordered left fold over the elements of the queue, in no particular order.+foldlU :: (b -> a -> b) -> b -> MaxPQueue k a -> b+foldlU f = foldlWithKeyU (const . f)++-- | /O(n)/. An unordered left fold over the elements of the queue, in no particular order.+foldlWithKeyU :: (b -> k -> a -> b) -> b -> MaxPQueue k a -> b+foldlWithKeyU f z0 (MaxPQ q) = Q.foldlWithKeyU (\z -> f z . unDown) z0 q++-- | /O(n)/. An unordered traversal over a priority queue, in no particular order.+-- While there is no guarantee in which order the elements are traversed, the resulting+-- priority queue will be perfectly valid.+traverseU :: (Applicative f) => (a -> f b) -> MaxPQueue k a -> f (MaxPQueue k b)+traverseU = traverseWithKeyU . const++-- | /O(n)/. An unordered traversal over a priority queue, in no particular order.+-- While there is no guarantee in which order the elements are traversed, the resulting+-- priority queue will be perfectly valid.+traverseWithKeyU :: (Applicative f) => (k -> a -> f b) -> MaxPQueue k a -> f (MaxPQueue k b)+traverseWithKeyU f (MaxPQ q) = MaxPQ <$> Q.traverseWithKeyU (f . unDown) q++-- | /O(n)/. Return all keys of the queue in no particular order.+keysU :: MaxPQueue k a -> [k]+keysU = fmap fst . toListU++-- | /O(n)/. Return all elements of the queue in no particular order.+elemsU :: MaxPQueue k a -> [a]+elemsU = fmap snd . toListU++-- | /O(n)/. Equivalent to 'toListU'.+assocsU :: MaxPQueue k a -> [(k, a)]+assocsU = toListU++-- | /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)++-- | /O(log n)/. Analogous to @deepseq@ in the @deepseq@ package, but only forces the spine of the binomial heap.+seqSpine :: MaxPQueue k a -> b -> b+seqSpine (MaxPQ q) = Q.seqSpine q
+ src/Data/PQueue/Prio/Max/Internals.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE CPP #-}++module Data.PQueue.Prio.Max.Internals where++import Control.DeepSeq (NFData(rnf))++import Data.Traversable (Traversable(traverse))+import Data.Foldable (Foldable(foldr, foldl))+import Data.Functor ((<$>))+# if __GLASGOW_HASKELL__+import Data.Data (Data, Typeable)+# endif++import Prelude hiding (foldr, foldl)++import Data.PQueue.Prio.Internals (MinPQueue)++newtype Down a = Down { unDown :: a }+# if __GLASGOW_HASKELL__+  deriving (Eq, Data, Typeable)+# else+  deriving (Eq)+# endif++-- | A priority queue where values of type @a@ are annotated with keys of type @k@.+-- The queue supports extracting the element with maximum key.+newtype MaxPQueue k a = MaxPQ (MinPQueue (Down k) a)+# if __GLASGOW_HASKELL__+  deriving (Eq, Ord, Data, Typeable)+# else+  deriving (Eq, Ord)+# endif++instance (NFData k, NFData a) => NFData (MaxPQueue k a) where+  rnf (MaxPQ q) = rnf q++instance NFData a => NFData (Down a) where+  rnf (Down a) = rnf a++instance Ord a => Ord (Down a) where+  Down a `compare` Down b = b `compare` a+  Down a <= Down b = b <= a++instance Functor Down where+  fmap f (Down a) = Down (f a)++instance Foldable Down where+  foldr f z (Down a) = a `f` z+  foldl f z (Down a) = z `f` a++instance Traversable Down where+  traverse f (Down a) = Down <$> f a
+ src/Data/PQueue/Prio/Min.hs view
@@ -0,0 +1,422 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.PQueue.Prio.Min+-- Copyright   :  (c) Louis Wasserman 2010+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  portable+--+-- General purpose priority queue.+-- Each element is associated with a /key/, and the priority queue supports+-- viewing and extracting the element with the minimum key.+--+-- A worst-case bound is given for each operation. In some cases, an amortized+-- bound is also specified; these bounds do not hold in a persistent context.+--+-- This implementation is based on a binomial heap augmented with a global root.+-- The spine of the heap is maintained lazily. To force the spine of the heap,+-- use 'seqSpine'.+--+-- We do not guarantee stable behavior.+-- Ties are broken arbitrarily -- that is, if @k1 <= k2@ and @k2 <= k1@, then there+-- are no guarantees about the relative order in which @k1@, @k2@, and their associated+-- elements are returned. (Unlike Data.Map, we allow multiple elements with the+-- same key.)+--+-- This implementation offers a number of methods of the form @xxxU@, where @U@ stands for+-- unordered. No guarantees whatsoever are made on the execution or traversal order of+-- these functions.+-----------------------------------------------------------------------------+module Data.PQueue.Prio.Min (+  MinPQueue,+  -- * Construction+  empty,+  singleton,+  insert,+  insertBehind,+  union,+  unions,+  -- * Query+  null,+  size,+  -- ** Minimum view+  findMin,+  getMin,+  deleteMin,+  deleteFindMin,+  adjustMin,+  adjustMinWithKey,+  updateMin,+  updateMinWithKey,+  minView,+  minViewWithKey,+  -- * Traversal+  -- ** Map+  map,+  mapWithKey,+  mapKeys,+  mapKeysMonotonic,+  -- ** Fold+  foldrWithKey,+  foldlWithKey,+  -- ** Traverse+  traverseWithKey,+  -- * Subsets+  -- ** Indexed+  take,+  drop,+  splitAt,+  -- ** Predicates+  takeWhile,+  takeWhileWithKey,+  dropWhile,+  dropWhileWithKey,+  span,+  spanWithKey,+  break,+  breakWithKey,+  -- *** Filter+  filter,+  filterWithKey,+  partition,+  partitionWithKey,+  mapMaybe,+  mapMaybeWithKey,+  mapEither,+  mapEitherWithKey,+  -- * List operations+  -- ** Conversion from lists+  fromList,+  fromAscList,+  fromDescList,+  -- ** Conversion to lists+  keys,+  elems,+  assocs,+  toAscList,+  toDescList,+  toList,+  -- * Unordered operations+  foldrU,+  foldrWithKeyU,+  foldlU,+  foldlWithKeyU,+  traverseU,+  traverseWithKeyU,+  keysU,+  elemsU,+  assocsU,+  toListU,+  -- * Helper methods+  seqSpine+  )+  where++import Control.Applicative (Applicative, pure, (<*>), (<$>))++import qualified Data.List as List+import qualified Data.Foldable as Fold(Foldable(..))+import Data.Monoid (Monoid(mempty, mappend, mconcat))+import Data.Traversable (Traversable(traverse))+import Data.Foldable (Foldable)+import Data.Maybe (fromMaybe)++#if MIN_VERSION_base(4,9,0)+import Data.Semigroup (Semigroup((<>)))+#endif++import Data.PQueue.Prio.Internals++import Prelude hiding (map, filter, break, span, takeWhile, dropWhile, splitAt, take, drop, (!!), null)++#ifdef __GLASGOW_HASKELL__+import GHC.Exts (build)+import Text.Read (Lexeme(Ident), lexP, parens, prec,+  readPrec, readListPrec, readListPrecDefault)+#else+build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]+build f = f (:) []+#endif++(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d+(f .: g) x y = f (g x y)++uncurry' :: (a -> b -> c) -> (a, b) -> c+uncurry' f (a, b) = f a b++infixr 8 .:++#if MIN_VERSION_base(4,9,0)+instance Ord k => Semigroup (MinPQueue k a) where+  (<>) = union+#endif++instance Ord k => Monoid (MinPQueue k a) where+  mempty = empty+  mappend = union+  mconcat = unions++instance (Ord k, Show k, Show a) => Show (MinPQueue k a) where+  showsPrec p xs = showParen (p > 10) $+    showString "fromAscList " . shows (toAscList xs)++instance (Read k, Read a) => Read (MinPQueue k a) where+#ifdef __GLASGOW_HASKELL__+  readPrec = parens $ prec 10 $ do+    Ident "fromAscList" <- lexP+    xs <- readPrec+    return (fromAscList xs)++  readListPrec = readListPrecDefault+#else+  readsPrec p = readParen (p > 10) $ \r -> do+    ("fromAscList",s) <- lex r+    (xs,t) <- reads s+    return (fromAscList xs,t)+#endif+++-- | The union of a list of queues: (@'unions' == 'List.foldl' 'union' 'empty'@).+unions :: Ord k => [MinPQueue k a] -> MinPQueue k a+unions = List.foldl union empty++-- | /O(1)/. The minimal (key, element) in the queue. Calls 'error' if empty.+findMin :: MinPQueue k a -> (k, a)+findMin = fromMaybe (error "Error: findMin called on an empty queue") . getMin++-- | /O(log n)/. Deletes the minimal (key, element) in the queue. Returns an empty queue+-- if the queue is empty.+deleteMin :: Ord k => MinPQueue k a -> MinPQueue k a+deleteMin = updateMin (const Nothing)++-- | /O(log n)/. Delete and find the element with the minimum key. Calls 'error' if empty.+deleteFindMin :: Ord k => MinPQueue k a -> ((k, a), MinPQueue k a)+deleteFindMin = fromMaybe (error "Error: deleteFindMin called on an empty queue") . minViewWithKey++-- | /O(1)/. Alter the value at the minimum key. If the queue is empty, does nothing.+adjustMin :: (a -> a) -> MinPQueue k a -> MinPQueue k a+adjustMin = adjustMinWithKey . const++-- | /O(log n)/. (Actually /O(1)/ if there's no deletion.) Update the value at the minimum key.+-- If the queue is empty, does nothing.+updateMin :: Ord k => (a -> Maybe a) -> MinPQueue k a -> MinPQueue k a+updateMin = updateMinWithKey . const++-- | /O(log n)/. Retrieves the value associated with the minimal key of the queue, and the queue+-- stripped of that element, or 'Nothing' if passed an empty queue.+minView :: Ord k => MinPQueue k a -> Maybe (a, MinPQueue k a)+minView q = do  ((_, a), q') <- minViewWithKey q+                return (a, q')++-- | /O(n)/. Map a function over all values in the queue.+map :: (a -> b) -> MinPQueue k a -> MinPQueue k b+map = mapWithKey . const++-- | /O(n)/. @'mapKeys' f q@ is the queue obtained by applying @f@ to each key of @q@.+mapKeys :: Ord k' => (k -> k') -> MinPQueue k a -> MinPQueue k' a+mapKeys f q = fromList [(f k, a) | (k, a) <- toListU q]++-- | /O(n log n)/. Traverses the elements of the queue in ascending order by key.+-- (@'traverseWithKey' f q == 'fromAscList' <$> 'traverse' ('uncurry' f) ('toAscList' q)@)+--+-- If you do not care about the /order/ of the traversal, consider using 'traverseWithKeyU'.+traverseWithKey :: (Ord k, Applicative f) => (k -> a -> f b) -> MinPQueue k a -> f (MinPQueue k b)+traverseWithKey f q = case minViewWithKey q of+  Nothing      -> pure empty+  Just ((k, a), q')  -> insertMin k <$> f k a <*> traverseWithKey f q'++-- | /O(n)/. Map values and collect the 'Just' results.+mapMaybe :: Ord k => (a -> Maybe b) -> MinPQueue k a -> MinPQueue k b+mapMaybe = mapMaybeWithKey . const++-- | /O(n)/. Map values and separate the 'Left' and 'Right' results.+mapEither :: Ord k => (a -> Either b c) -> MinPQueue k a -> (MinPQueue k b, MinPQueue k c)+mapEither = mapEitherWithKey . const++-- | /O(n)/. Filter all values that satisfy the predicate.+filter :: Ord k => (a -> Bool) -> MinPQueue k a -> MinPQueue k a+filter = filterWithKey . const++-- | /O(n)/. Filter all values that satisfy the predicate.+filterWithKey :: Ord k => (k -> a -> Bool) -> MinPQueue k a -> MinPQueue k a+filterWithKey p = mapMaybeWithKey (\k a -> if p k a then Just a else Nothing)++-- | /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.+partition :: Ord k => (a -> Bool) -> MinPQueue k a -> (MinPQueue k a, MinPQueue k a)+partition = partitionWithKey . const++-- | /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) -> MinPQueue k a -> (MinPQueue k a, MinPQueue k a)+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@.+-- (@'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@.+drop :: Ord k => Int -> MinPQueue k a -> MinPQueue k a+drop n0 q0+  | n0 <= 0  = q0+  | n0 >= size q0  = empty+  | otherwise  = drop' n0 q0+  where+    drop' n q+      | n == 0    = q+      | otherwise = drop' (n - 1) (deleteMin q)++-- | /O(k log n)/. Equivalent to @('take' k q, 'drop' k q)@.+splitAt :: Ord k => Int -> MinPQueue k a -> ([(k, a)], MinPQueue k a)+splitAt n q+  | n <= 0     = ([], q)+  | otherwise  = n `seq` case minViewWithKey q of+      Just (ka, q') -> let (kas, q'') = splitAt (n - 1) q' in (ka : kas, q'')+      _             -> ([], q)++{-# INLINE takeWhile #-}+-- | Takes the longest possible prefix of elements satisfying the predicate.+-- (@'takeWhile' p q == 'List.takeWhile' (p . 'snd') ('toAscList' q)@)+takeWhile :: Ord k => (a -> Bool) -> MinPQueue k a -> [(k, a)]+takeWhile = takeWhileWithKey . const++{-# INLINE takeWhileWithKey #-}+-- | Takes the longest possible prefix of elements satisfying the predicate.+-- (@'takeWhile' p q == 'List.takeWhile' (uncurry p) ('toAscList' q)@)+takeWhileWithKey :: Ord k => (k -> a -> Bool) -> MinPQueue k a -> [(k, a)]+takeWhileWithKey p0 = takeWhileFB (uncurry' p0) . toAscList where+  takeWhileFB p xs = build (\c n -> foldr (\x z -> if p x then x `c` z else n) n xs)++-- | Removes the longest possible prefix of elements satisfying the predicate.+dropWhile :: Ord k => (a -> Bool) -> MinPQueue k a -> MinPQueue k a+dropWhile = dropWhileWithKey . const++-- | Removes the longest possible prefix of elements satisfying the predicate.+dropWhileWithKey :: Ord k => (k -> a -> Bool) -> MinPQueue k a -> MinPQueue k a+dropWhileWithKey p q = case minViewWithKey q of+  Just ((k, a), q')+    | p k a -> dropWhileWithKey p q'+  _         -> q++-- | Equivalent to @('takeWhile' p q, 'dropWhile' p q)@.+span :: Ord k => (a -> Bool) -> MinPQueue k a -> ([(k, a)], MinPQueue k a)+span = spanWithKey . const++-- | Equivalent to @'span' ('not' . p)@.+break :: Ord k => (a -> Bool) -> MinPQueue k a -> ([(k, a)], MinPQueue k a)+break p = span (not . p)++-- | Equivalent to @('takeWhileWithKey' p q, 'dropWhileWithKey' p q)@.+spanWithKey :: Ord k => (k -> a -> Bool) -> MinPQueue k a -> ([(k, a)], MinPQueue k a)+spanWithKey p q = case minViewWithKey q of+  Just (t@(k, a), q')+    | p k a -> let (kas, q'') = spanWithKey p q' in (t : kas, q'')+  _         -> ([], q)++-- | Equivalent to @'spanWithKey' (\ k a -> 'not' (p k a)) q@.+breakWithKey :: Ord k => (k -> a -> Bool) -> MinPQueue k a -> ([(k, a)], MinPQueue k a)+breakWithKey p = spanWithKey (not .: p)++-- | /O(n)/. Build a priority queue from the list of (key, value) pairs.+fromList :: Ord k => [(k, a)] -> MinPQueue k a+fromList = foldr (uncurry' insert) empty++-- | /O(n)/. Build a priority queue from an ascending list of (key, value) pairs. /The precondition is not checked./+fromAscList :: [(k, a)] -> MinPQueue k a+fromAscList = foldr (uncurry' insertMin) empty++-- | /O(n)/. Build a priority queue from a descending list of (key, value) pairs. /The precondition is not checked./+fromDescList :: [(k, a)] -> MinPQueue k a+fromDescList = List.foldl' (\q (k, a) -> insertMin k a q) empty++{-# RULES+  "fromList/build" forall (g :: forall b . ((k, a) -> b -> b) -> b -> b) .+    fromList (build g) = g (uncurry' insert) empty;+  "fromAscList/build" forall (g :: forall b . ((k, a) -> b -> b) -> b -> b) .+    fromAscList (build g) = g (uncurry' insertMin) empty;+  #-}++{-# INLINE keys #-}+-- | /O(n log n)/. Return all keys of the queue in ascending order.+keys :: Ord k => MinPQueue k a -> [k]+keys = List.map fst . toAscList++{-# INLINE elems #-}+-- | /O(n log n)/. Return all elements of the queue in ascending order by key.+elems :: Ord k => MinPQueue k a -> [a]+elems = List.map snd . toAscList++-- | /O(n log n)/. Return all (key, value) pairs in ascending order by key.+toAscList :: Ord k => MinPQueue k a -> [(k, a)]+toAscList = foldrWithKey (curry (:)) []++-- | /O(n log n)/. Return all (key, value) pairs in descending order by key.+toDescList :: Ord k => MinPQueue k a -> [(k, a)]+toDescList = foldlWithKey (\z k a -> (k, a) : z) []++{-# RULES+  "toAscList" toAscList = \q -> build (\c n -> foldrWithKey (curry c) n q);+  "toDescList" toDescList = \q -> build (\c n -> foldlWithKey (\z k a -> (k, a) `c` z) n q);+  "toListU" toListU = \q -> build (\c n -> foldrWithKeyU (curry c) n q);+  #-}++{-# INLINE toList #-}+-- | /O(n log n)/. Equivalent to 'toAscList'.+--+-- If the traversal order is irrelevant, consider using 'toListU'.+toList :: Ord k => MinPQueue k a -> [(k, a)]+toList = toAscList++{-# INLINE assocs #-}+-- | /O(n log n)/. Equivalent to 'toAscList'.+assocs :: Ord k => MinPQueue k a -> [(k, a)]+assocs = toAscList++{-# INLINE keysU #-}+-- | /O(n)/. Return all keys of the queue in no particular order.+keysU :: MinPQueue k a -> [k]+keysU = List.map fst . toListU++{-# INLINE elemsU #-}+-- | /O(n)/. Return all elements of the queue in no particular order.+elemsU :: MinPQueue k a -> [a]+elemsU = List.map snd . toListU++{-# INLINE assocsU #-}+-- | /O(n)/. Equivalent to 'toListU'.+assocsU :: MinPQueue k a -> [(k, a)]+assocsU = toListU++-- | /O(n)/. Returns all (key, value) pairs in the queue in no particular order.+toListU :: MinPQueue k a -> [(k, a)]+toListU = foldrWithKeyU (curry (:)) []++-- | /O(n)/. An unordered right fold over the elements of the queue, in no particular order.+foldrU :: (a -> b -> b) -> b -> MinPQueue k a -> b+foldrU = foldrWithKeyU . const++-- | /O(n)/. An unordered left fold over the elements of the queue, in no particular order.+foldlU :: (b -> a -> b) -> b -> MinPQueue k a -> b+foldlU f = foldlWithKeyU (const . f)++-- | /O(n)/. An unordered traversal over a priority queue, in no particular order.+-- While there is no guarantee in which order the elements are traversed, the resulting+-- priority queue will be perfectly valid.+traverseU :: (Applicative f) => (a -> f b) -> MinPQueue k a -> f (MinPQueue k b)+traverseU = traverseWithKeyU . const++instance Functor (MinPQueue k) where+  fmap = map++instance Ord k => Foldable (MinPQueue k) where+  foldr   = foldrWithKey . const+  foldl f = foldlWithKey (const . f)++instance Ord k => Traversable (MinPQueue k) where+  traverse = traverseWithKey . const
+ tests/PQueueTests.hs view
@@ -0,0 +1,145 @@+module Main (main) where++import qualified Data.PQueue.Prio.Max as PMax ()+import qualified Data.PQueue.Prio.Min as PMin ()+import qualified Data.PQueue.Max as Max ()+import qualified Data.PQueue.Min as Min++import Test.QuickCheck++import System.Exit++import qualified Data.List as List+import Control.Arrow (second)+++validMinToAscList :: [Int] -> Bool+validMinToAscList xs = Min.toAscList (Min.fromList xs) == List.sort xs++validMinToDescList :: [Int] -> Bool+validMinToDescList xs = Min.toDescList (Min.fromList xs) == List.sortBy (flip compare) xs++validMinUnfoldr :: [Int] -> Bool+validMinUnfoldr xs = List.unfoldr Min.minView (Min.fromList xs) == List.sort xs++validMinToList :: [Int] -> Bool+validMinToList xs = List.sort (Min.toList (Min.fromList xs)) == List.sort xs++validMinFromAscList :: [Int] -> Bool+validMinFromAscList xs = Min.fromAscList (List.sort xs) == Min.fromList xs++validMinFromDescList :: [Int] -> Bool+validMinFromDescList xs = Min.fromDescList (List.sortBy (flip compare) xs) == Min.fromList xs++validMinUnion :: [Int] -> [Int] -> Bool+validMinUnion xs1 xs2 = Min.union (Min.fromList xs1) (Min.fromList xs2) == Min.fromList (xs1 ++ xs2)++validMinMapMonotonic :: [Int] -> Bool+validMinMapMonotonic xs = Min.mapU (+1) (Min.fromList xs) == Min.fromList (map (+1) xs)++validMinFilter :: [Int] -> Bool+validMinFilter xs = Min.filter even (Min.fromList xs) == Min.fromList (List.filter even xs)++validMinPartition :: [Int] -> Bool+validMinPartition xs = Min.partition even (Min.fromList xs) == (let (xs1, xs2) = List.partition even xs in (Min.fromList xs1, Min.fromList xs2))++validMinCmp :: [Int] -> [Int] -> Bool+validMinCmp xs1 xs2 = compare (Min.fromList xs1) (Min.fromList xs2) == compare (List.sort xs1) (List.sort xs2)++validMinCmp2 :: [Int] -> Bool+validMinCmp2 xs = compare (Min.fromList ys) (Min.fromList (take 30 ys)) == compare ys (take 30 ys)+  where ys = List.sort xs++validSpan :: [Int] -> Bool+validSpan xs = (Min.takeWhile even q, Min.dropWhile even q) == Min.span even q+  where q = Min.fromList xs++validSpan2 :: [Int] -> Bool+validSpan2 xs =+  second Min.toAscList (Min.span even (Min.fromList xs))+  ==+  List.span even (List.sort xs)++validSplit :: Int -> [Int] -> Bool+validSplit n xs = Min.splitAt n q == (Min.take n q, Min.drop n q)+  where q = Min.fromList xs++validSplit2 :: Int -> [Int] -> Bool+validSplit2 n xs = case Min.splitAt n (Min.fromList xs) of+  (ys, q') -> (ys, Min.toAscList q') == List.splitAt n (List.sort xs)++validMapEither :: [Int] -> Bool+validMapEither xs =+  Min.mapEither collatz q ==+    (Min.mapMaybe (either Just (const Nothing) . collatz) q,+     Min.mapMaybe (either (const Nothing) Just . collatz) q)+      where q = Min.fromList xs++validMap :: [Int] -> Bool+validMap xs = Min.map f (Min.fromList xs) == Min.fromList (List.map f xs)+  where f = either id id . collatz++collatz :: Int -> Either Int Int+collatz x =+  if even x+    then Left $ x `quot` 2+    else Right $ 3 * x + 1++validSize :: [Int] -> Bool+validSize xs = Min.size q == List.length xs'+  where+    q = Min.drop 10 (Min.fromList xs)+    xs' = List.drop 10 (List.sort xs)++validNull :: Int -> [Int] -> Bool+validNull n xs = Min.null q == List.null xs'+  where+    q = Min.drop n (Min.fromList xs)+    xs' = List.drop n (List.sort xs)++validFoldl :: [Int] -> Bool+validFoldl xs = Min.foldlAsc (flip (:)) [] (Min.fromList xs) == List.foldl (flip (:)) [] (List.sort xs)++validFoldlU :: [Int] -> Bool+validFoldlU xs = Min.foldlU (flip (:)) [] q == List.reverse (Min.foldrU (:) [] q)+  where q = Min.fromList xs++validFoldrU :: [Int] -> Bool+validFoldrU xs = Min.foldrU (+) 0 q == List.sum xs+  where q = Min.fromList xs++main :: IO ()+main = do+  check validMinToAscList+  check validMinToDescList+  check validMinUnfoldr+  check validMinToList+  check validMinFromAscList+  check validMinFromDescList+  check validMinUnion+  check validMinMapMonotonic+  check validMinPartition+  check validMinCmp+  check validMinCmp2+  check validSpan+  check validSpan2+  check validSplit+  check validSplit2+  check validMinFilter+  check validMapEither+  check validMap+  check validSize+  check validNull+  check validFoldl+  check validFoldlU+  check validFoldrU+  putStrLn "all tests passed"++isPass :: Result -> Bool+isPass Success{} = True+isPass _         = False++check :: Testable prop => prop -> IO ()+check p = do+  r <- quickCheckResult p+  if isPass r then return () else exitFailure