packages feed

pqueue (empty) → 1.0.0

raw patch · 10 files changed

+2351/−0 lines, 10 filesdep +basesetup-changed

Dependencies added: base

Files

+ Data/PQueue/Internals.hs view
@@ -0,0 +1,455 @@+{-# LANGUAGE CPP #-}++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,+	foldrU,+	foldlU,+	keysQueue,+	seqSpine+	) where++import Control.Applicative hiding (empty)+import Data.Foldable+import Data.Monoid+import qualified Data.PQueue.Prio.Internals as Prio++#ifdef __GLASGOW_HASKELL__+import Data.Data+#endif++import Prelude hiding (foldl, foldr, null)++-- | A priority queue implementation.  Implemented as a find-min wrapper around a binomial heap.+-- +-- If you wish to perform folds on a priority queue that respect order, use 'foldrAsc' or+-- 'foldlAsc'.+-- +-- For any operation @op@ in 'Eq' or 'Ord', @queue1 `op` queue2@ is equivalent to+-- @toAscList queue1 `op` toAscList queue2@.+data MinQueue a = Empty | MinQueue {-# UNPACK #-} !Int a !(BinomHeap a)++#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++#include "Typeable.h"+INSTANCE_TYPEABLE1(MinQueue,minQTC,"MinQueue")+#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 && x1 == x2 && eq' q1 q2 where+		eq' q1 q2 = case (extractHeap q1, extractHeap q2) of+			(Just (x1, q1'), Just (x2, q2'))+				-> x1 == x2 && eq' q1' q2'+			(Nothing, Nothing)+				-> True+			_	-> False+	_ == _ = False++instance Ord a => Ord (MinQueue a) where+	Empty `compare` Empty = EQ+	Empty `compare` _ = LT+	_ `compare` Empty = GT+	MinQueue n1 x1 q1 `compare` MinQueue n2 x2 q2 = compare x1 x2 `mappend` cmp' q1 q2 where+		cmp' q1 q2 = case (extractHeap q1, extractHeap q2) of+			(Just (x1, q1'), Just (x2, q2'))+				-> compare x1 x2 `mappend` cmp' q1' q2'+			(Nothing, Nothing)+				-> EQ+			(Just{}, Nothing)+				-> GT+			(Nothing, Just{})+				-> LT+			+		-- 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++getMin :: MinQueue a -> Maybe a+getMin (MinQueue _ x _) = Just x+getMin _ = Nothing++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 _ Empty = Empty+mapMonotonic f (MinQueue n x ts) = MinQueue n (f x) (fmap f ts)++{-# 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 z suc s0 = unf z s0 where+	unf z s = case suc s of+		Nothing		-> z+		Just (x, s')	-> unf (z `f` x) s'+insert' :: LEq a -> a -> MinQueue a -> MinQueue a+insert' _ x Empty = singleton x+insert' (<=) x (MinQueue n x' ts)+	| x <= x'	= MinQueue (n+1) x (incr (<=) (tip x') ts)+	| otherwise	= MinQueue (n+1) x' (incr (<=) (tip x) ts)++{-# INLINE union' #-}+union' :: LEq a -> MinQueue a -> MinQueue a -> MinQueue a+union' _ Empty q = q+union' _ q Empty = q+union' (<=) (MinQueue n1 x1 f1) (MinQueue n2 x2 f2)+	| x1 <= x2	= MinQueue (n1 + n2) x1 (carry (<=) (tip x2) f1 f2)+	| otherwise	= MinQueue (n1 + n2) x2 (carry (<=) (tip x1) f1 f2)++-- | 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' (<=) t (Extract minKey (Succ kChild kChildren) ts)+	= Extract minKey kChildren (Skip (incr (<=) (t `cat` kChild) ts))+	where	cat = joinBin (<=)++-- | Walks backward from the biggest key in the forest, as far as rank @rk@.+-- Returns its progress.  Each successive application of @extractBin@ takes+-- amortized /O(1)/ time, so applying it from the beginning takes /O(log n)/ time.+extractBin :: LEq a -> BinomForest rk a -> MExtract rk a+extractBin _ Nil = No+extractBin (<=) (Skip f) = case extractBin (<=) f of+	Yes ex	-> Yes (incrExtract ex)+	No	-> No+extractBin (<=) (Cons t@(BinomTree x ts) f) = Yes $ case extractBin (<=) f of+	Yes ex@(Extract minKey _ _)+		| minKey < x	-> incrExtract' (<=) t ex+	_			-> Extract x ts (Skip f)+	where	a < b = not (b <= a)++mapMaybeQueue :: (a -> Maybe b) -> LEq b -> (rk a -> MinQueue b) -> MinQueue b -> BinomForest rk a -> MinQueue b+mapMaybeQueue f (<=) fCh q0 forest = q0 `seq` case forest of+	Nil		-> q0+	Skip forest'	-> mapMaybeQueue f (<=) fCh' q0 forest'+	Cons t forest'	-> mapMaybeQueue f (<=) fCh' (union' (<=) (mapMaybeT t) q0) forest'+	where	fCh' (Succ t tss) = union' (<=) (mapMaybeT t) (fCh tss)+		mapMaybeT (BinomTree x ts) = maybe (fCh ts) (\ x -> insert' (<=) x (fCh ts)) (f x)++type Partition a b = (MinQueue a, MinQueue b)++mapEitherQueue :: (a -> Either b c) -> LEq b -> LEq c -> (rk a -> Partition b c) -> Partition b c ->+	BinomForest rk a -> Partition b c+mapEitherQueue f (<=) (<=.) fCh (q0, q1) ts = q0 `seq` q1 `seq` case ts of+	Nil		-> (q0, q1)+	Skip ts'	-> mapEitherQueue f (<=) (<=.) fCh' (q0, q1) ts'+	Cons t ts'	-> mapEitherQueue f (<=) (<=.) fCh' (both (union' (<=)) (union' (<=.)) (partitionT t) (q0, q1)) ts'+	where	both f g (x1, x2) (y1, y2) = (f x1 y1, g x2 y2)+		fCh' (Succ t tss) = both (union' (<=)) (union' (<=.)) (partitionT t) (fCh tss)+		partitionT (BinomTree x ts) = case fCh ts of+			(q0, q1) -> case f x of+				Left b	-> (insert' (<=) b q0, q1)+				Right c	-> (q0, insert' (<=.) c q1)++{-# 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 (<=) f1 f2 = case (f1, f2) of+	(Skip f1', Skip f2')	-> Skip (merge (<=) f1' f2')+	(Skip f1', Cons t2 f2')	-> Cons t2 (merge (<=) f1' f2')+	(Cons t1 f1', Skip f2')	-> Cons t1 (merge (<=) f1' f2')+	(Cons t1 f1', Cons t2 f2')+				-> Skip (carry (<=) (t1 `cat` t2) f1' f2')+	(Nil, _)		-> f2+	(_, Nil)		-> f1+	where	cat = joinBin (<=)++-- | Merges two binomial forests with another tree. If we are thinking of the trees +-- in the binomial forest as binary digits, this corresponds to a carry operation.+-- Each call to this function takes /O(1)/ time, so in total, it costs /O(log n)/.+carry :: LEq a -> BinomTree rk a -> BinomForest rk a -> BinomForest rk a -> BinomForest rk a+carry (<=) t0 f1 f2 = t0 `seq` case (f1, f2) of+	(Skip f1', Skip f2')	-> Cons t0 (merge (<=) f1' f2')+	(Skip f1', Cons t2 f2')	-> Skip (mergeCarry t0 t2 f1' f2')+	(Cons t1 f1', Skip f2')	-> Skip (mergeCarry t0 t1 f1' f2')+	(Cons t1 f1', Cons t2 f2')+				-> Cons t0 (mergeCarry t1 t2 f1' f2')+	(Nil, _f2)		-> incr (<=) t0 f2+	(_f1, Nil)		-> incr (<=) t0 f1+	where	cat = joinBin (<=)+		mergeCarry tA tB = carry (<=) (tA `cat` tB)++-- | Merges a binomial tree into a binomial forest.  If we are thinking+-- of the trees in the binomial forest as binary digits, this corresponds+-- to adding a power of 2.  This costs amortized /O(1)/ time.+incr :: LEq a -> BinomTree rk a -> BinomForest rk a -> BinomForest rk a+incr (<=) t f = t `seq` case f of+	Nil	-> Cons t Nil+	Skip f	-> Cons t f+	Cons t' f' -> Skip (incr (<=) (t `cat` t') f')+	where	cat = joinBin (<=)++-- | The carrying operation: takes two binomial heaps of the same rank @k@+-- and returns one of rank @k+1@.  Takes /O(1)/ time.+joinBin :: LEq a -> BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a+joinBin (<=) t1@(BinomTree x1 ts1) t2@(BinomTree x2 ts2)+	| x1 <= x2	= BinomTree x1 (Succ t2 ts1)+	| 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 ts) = foldr f z ts+	foldr f z (Cons t ts) = foldr f (foldr f z ts) t+	foldl _ z Nil = z+	foldl f z (Skip ts) = foldl f z ts+	foldl f z (Cons t ts) = foldl f (foldl f z t) ts++-- | /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++foldlU :: (b -> a -> b) -> b -> MinQueue a -> b+foldlU _ z Empty = z+foldlU f z (MinQueue _ x ts) = foldl f (z `f` x) 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 ts = case ts 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)
+ Data/PQueue/Max.hs view
@@ -0,0 +1,217 @@+{-# LANGUAGE CPP #-}++module Data.PQueue.Max (+	MaxQueue,+	-- * Construction+	empty,+	singleton,+	insert,+	union,+	unions,+	-- * Query+	null,+	size,+	-- ** Maximum view+	findMax,+	getMax,+	deleteMax,+	deleteFindMax,+	maxView,+	-- * Traversal+	-- ** Map+	map,+	mapMonotonic,+	-- ** Fold+	foldr,+	foldl,+	-- ** Traverse+	traverse,+	-- * Subsets+	-- ** Indexed+	take,+	drop,+	splitAt,+	-- ** Predicates+	takeWhile,+	dropWhile,+	span,+	break,+	-- *** Filter+	filter,+	partition,+	-- * List operations+	-- ** Conversion from lists+	fromList,+	fromDescList,+	fromAscList,+	-- ** Conversion to lists+	elems,+	toList,+	toDescList,+	-- * Conversion with MaxPQueue+	pqueueKeys,+	-- * Unordered operations+	foldrU,+	foldlU,+	toListU,+	-- * Helper methods+	seqSpine) where++import Control.Applicative hiding (empty)+import Data.Maybe hiding (mapMaybe)+import Data.Monoid+import qualified Data.List as List+import qualified Data.PQueue.Prio.Max as Q++import Prelude hiding (map, filter, break, span, takeWhile, dropWhile, splitAt, take, drop, (!!), null, foldr, foldl)++#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++newtype MaxQueue a = MaxQ (Q.MaxPQueue a ()) deriving (Eq, Ord)++null :: MaxQueue a -> Bool+null (MaxQ q) = Q.null q++size :: MaxQueue a -> Int+size (MaxQ q) = Q.size q++empty :: MaxQueue a+empty = MaxQ Q.empty++singleton :: a -> MaxQueue a+singleton a = MaxQ (Q.singleton a ())++insert :: Ord a => a -> MaxQueue a -> MaxQueue a+insert a (MaxQ q) = MaxQ (Q.insert a () q)++union :: Ord a => MaxQueue a -> MaxQueue a -> MaxQueue a+MaxQ q1 `union` MaxQ q2 = MaxQ (q1 `Q.union` q2)++unions :: Ord a => [MaxQueue a] -> MaxQueue a+unions qs = MaxQ (Q.unions [q | MaxQ q <- qs])++findMax :: MaxQueue a -> a+findMax = fromMaybe (error "Error: findMax called on an empty queue") . getMax++getMax :: MaxQueue a -> Maybe a+getMax (MaxQ q) = fst <$> Q.getMax q++deleteMax :: Ord a => MaxQueue a -> MaxQueue a+deleteMax (MaxQ q) = MaxQ (Q.deleteMax q)++deleteFindMax :: Ord a => MaxQueue a -> (a, MaxQueue a)+deleteFindMax = fromMaybe (error "Error: deleteFindMax called on an empty queue") . maxView++maxView :: Ord a => MaxQueue a -> Maybe (a, MaxQueue a)+maxView (MaxQ q) = do+	((a, _), q') <- Q.maxViewWithKey q+	return (a, MaxQ q')++map :: Ord b => (a -> b) -> MaxQueue a -> MaxQueue b+map f (MaxQ q) = MaxQ (Q.mapKeys f q)++mapMonotonic :: (a -> b) -> MaxQueue a -> MaxQueue b+mapMonotonic f (MaxQ q) = MaxQ (Q.mapKeysMonotonic f q)++traverse :: (Applicative f, Ord a, Ord b) => (a -> f b) -> MaxQueue a -> f (MaxQueue b)+traverse f q = case maxView q of+	Nothing		-> pure empty+	Just (a, q')	-> insert <$> f a <*> traverse f q'++foldr :: Ord a => (a -> b -> b) -> b -> MaxQueue a -> b+foldr f z (MaxQ q) = Q.foldrWithKey (const . f) z q++foldl :: Ord a => (b -> a -> b) -> b -> MaxQueue a -> b+foldl f z (MaxQ q) = Q.foldlWithKey (\ z -> const . f z) z q++foldrU :: (a -> b -> b) -> b -> MaxQueue a -> b+foldrU f z (MaxQ q) = Q.foldrWithKeyU (const . f) z q++foldlU :: (b -> a -> b) -> b -> MaxQueue a -> b+foldlU f z (MaxQ q) = Q.foldlWithKeyU (\ z -> const . f z) z q++-- {-# INLINE take #-}+take :: Ord a => Int -> MaxQueue a -> [a]+take k (MaxQ q) = List.map fst (Q.take k q)++drop :: Ord a => Int -> MaxQueue a -> MaxQueue a+drop k (MaxQ q) = MaxQ (Q.drop k q)++splitAt :: Ord a => Int -> MaxQueue a -> ([a], MaxQueue a)+splitAt k (MaxQ q) = case Q.splitAt k q of+	(xs, q') -> (List.map fst xs, MaxQ q')++takeWhile :: Ord a => (a -> Bool) -> MaxQueue a -> [a]+takeWhile p (MaxQ q) = List.map fst (Q.takeWhileWithKey (const . p) q)++dropWhile :: Ord a => (a -> Bool) -> MaxQueue a -> MaxQueue a+dropWhile p (MaxQ q) = MaxQ (Q.dropWhileWithKey (const . p) q)++span :: Ord a => (a -> Bool) -> MaxQueue a -> ([a], MaxQueue a)+span p (MaxQ q) = case Q.spanWithKey (const . p) q of+	(xs, q') -> (List.map fst xs, MaxQ q')++break :: Ord a => (a -> Bool) -> MaxQueue a -> ([a], MaxQueue a)+break p (MaxQ q) = case Q.breakWithKey (const . p) q of+	(xs, q') -> (List.map fst xs, MaxQ q')++filter :: Ord a => (a -> Bool) -> MaxQueue a -> MaxQueue a+filter f (MaxQ q) = MaxQ (Q.filterWithKey (const . f) q)++partition :: Ord a => (a -> Bool) -> MaxQueue a -> (MaxQueue a, MaxQueue a)+partition p (MaxQ q) = case Q.partitionWithKey (const . p) q of+	(q0, q1) -> (MaxQ q0, MaxQ q1)++{-# INLINE elems #-}+elems :: Ord a => MaxQueue a -> [a]+elems = toList++{-# INLINE toList #-}+toList :: Ord a => MaxQueue a -> [a]+toList (MaxQ q) = Q.keys q++{-# INLINE toDescList #-}+toDescList :: Ord a => MaxQueue a -> [a]+toDescList = toList++{-# INLINE toAscList #-}+toAscList :: Ord a => MaxQueue a -> [a]+toAscList (MaxQ q) = List.map fst (Q.toAscList q)++{-# INLINE elemsU #-}+elemsU :: Ord a => MaxQueue a -> [a]+elemsU = toListU++{-# INLINE toListU #-}+toListU :: Ord a => MaxQueue a -> [a]+toListU (MaxQ q) = Q.keysU q++{-# INLINE fromList #-}+fromList :: Ord a => [a] -> MaxQueue a+fromList as = MaxQ (Q.fromList [(a, ()) | a <- as])++{-# INLINE fromDescList #-}+fromDescList :: [a] -> MaxQueue a+fromDescList as = MaxQ (Q.fromDescList [(a, ()) | a <- as])++{-# INLINE fromAscList #-}+fromAscList :: [a] -> MaxQueue a+fromAscList as = MaxQ (Q.fromAscList [(a, ()) | a <- as])++pqueueKeys :: Q.MaxPQueue k a -> MaxQueue k+#ifdef __GLASGOW_HASKELL__+pqueueKeys q = MaxQ (() <$ q)+#else+pqueueKeys q = MaxQ (fmap (const ()) q)+#endif++seqSpine :: MaxQueue a -> b -> b+seqSpine (MaxQ q) = Q.seqSpine q
+ Data/PQueue/Min.hs view
@@ -0,0 +1,293 @@+{-# LANGUAGE CPP #-}++-----------------------------------------------------------------------------+-- |+-- 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 /i/ 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 strictly, ensuring that computations happen+-- as they are performed.+--+-- This implementation does not guarantee stable behavior.+-- +-- /WARNING:/ 'toList' and 'toAscList' are /not/ equivalent, unlike for example+-- "Data.Map".+-----------------------------------------------------------------------------+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,+	mapMonotonic,+	foldrAsc,+	foldlAsc,+	foldrDesc,+	foldlDesc,+	-- * List operations+	toList,+	toAscList,+	toDescList,+	fromList,+	fromAscList,+	fromDescList,+	-- * Unordered operations+	foldrU,+	foldlU,+	traverseU,+	elemsU,+	toListU,+	-- * Miscellaneous operations+	keysQueue,+	seqSpine) where++import Prelude hiding (null, foldr, foldl, take, drop, takeWhile, dropWhile, splitAt, span, break, (!!), filter, map)++import Control.Applicative (Applicative(..), (<$>))++import Data.Monoid+import Data.Maybe hiding (mapMaybe)+import Data.Foldable hiding (toList)+import Data.Traversable++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)+import Data.Data+#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++instance Ord a => Monoid (MinQueue a) where+	mempty = empty+	mappend = union+	mconcat = unions++findMin :: MinQueue a -> a+findMin = fromMaybe (error "Error: findMin called on empty queue") . getMin++deleteMin :: Ord a => MinQueue a -> MinQueue a+deleteMin q = case minView q of+	Nothing		-> empty+	Just (_, q')	-> q'++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 xs = build (\ c nil -> let +	consWhile x xs+		| p x		= x `c` xs+		| otherwise	= nil+	in foldr consWhile nil xs)++-- | '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 = fromList . List.map f . toListU++{-# 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)/.  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++{-# INLINE elemsU #-}+elemsU :: MinQueue a -> [a]+elemsU = toListU++toListU :: MinQueue a -> [a]+toListU q = build (\ c n -> foldrU c n q)++traverseU :: (Applicative f, Ord b) => (a -> f b) -> MinQueue a -> f (MinQueue b)+traverseU f = foldrU (\ a q -> insert <$> f a <*> q) (pure empty)++{-# RULES+	"foldr/toListU" forall f z q . foldr f z (toListU q) = foldrU f z q;+	"foldl/toListU" forall f z q . foldl f z (toListU q) = foldlU f z q;+	#-}
+ Data/PQueue/Prio/Internals.hs view
@@ -0,0 +1,404 @@+module Data.PQueue.Prio.Internals (+	MinPQueue(..),+	BinomForest(..),+	BinomHeap,+	BinomTree(..),+	Zero(..),+	Succ(..),+	LEq,+	empty,+	null,+	size,+	singleton,+	insert,+	union,+	getMin,+	alterMinWithKey,+	updateMinWithKey,+	minViewWithKey,+	mapWithKey,+	mapKeysMonotonic,+	mapMaybeWithKey,+	mapEitherWithKey,+	foldrWithKey,+	foldlWithKey,+	insertMin,+	foldrWithKeyU,+	foldlWithKeyU,+	seqSpine+	) where++import Data.Monoid+import Prelude hiding (null)++(.:) :: (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)++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 LEq 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 && k1 == k2 && a1 == a2 && equHeap ts1 ts2+	 where	equHeap ts1 ts2 = case (extract ts1, extract ts2) of+	 		(Yes (Extract k1 a1 _ ts1'), Yes (Extract k2 a2 _ ts2'))+				-> k1 == k2 && a1 == a2 && equHeap ts1' ts2'+			(No, No) -> True+			_	-> False+		extract = extractForest (<=)+	Empty == Empty = True+	_ == _ = False++(<>) :: Monoid m => m -> m -> m+(<>) = mappend+infixr 6 <>++instance (Ord k, Ord a) => Ord (MinPQueue k a) where+	MinPQ n1 k1 a1 ts1 `compare` MinPQ n2 k2 a2 ts2 =+		k1 `compare` k2 <> a1 `compare` a2 <> ts1 `cmpHeap` ts2+	 where	ts1 `cmpHeap` ts2 = case (extract ts1, extract ts2) of+	 		(Yes (Extract k1 a1 _ ts1'), Yes (Extract k2 a2 _ ts2'))+				-> k1 `compare` k2 <> a1 `compare` a2 <> ts1' `cmpHeap` ts2'+			(No, Yes{})	-> LT+			(Yes{}, No)	-> GT+			(No, No)	-> EQ+		extract = extractForest (<=)+	Empty `compare` Empty = EQ+	Empty `compare` MinPQ{} = LT+	MinPQ{} `compare` Empty = GT++-- | /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' (<=)++-- | Internal helper method, using a specific comparator function.+insert' :: LEq k -> k -> a -> MinPQueue k a -> MinPQueue k a+insert' _ k a Empty = singleton k a+insert' (<=) k a (MinPQ n k' a' ts)+	| k <= k'	= MinPQ (n+1) k a (incr (<=) (tip k' a') ts)+	| otherwise	= MinPQ (n+1) k' a' (incr (<=) (tip k a) ts)++-- | 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' :: LEq k -> MinPQueue k a -> MinPQueue k a -> MinPQueue k a+union' (<=) (MinPQ n1 k1 a1 ts1) (MinPQ n2 k2 a2 ts2)+	| k1 <= k2	= MinPQ (n1 + n2) k1 a1 (insMerge k2 a2)+	| otherwise	= MinPQ (n1 + n2) k2 a2 (insMerge k1 a1)+	where	insMerge k a = carryForest (<=) (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.+alterMinWithKey :: (k -> a -> a) -> MinPQueue k a -> MinPQueue k a+alterMinWithKey _ Empty = Empty+alterMinWithKey f (MinPQ n k a ts) = MinPQ n k (f k a) ts++-- | /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 _ Empty = Empty+mapWithKey f (MinPQ n k a ts) = MinPQ n k (f k a) (mapForest f (const Zero) ts)++-- | /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 _ k a ts) = f k a (foldF ts) where+	extract = extractForest (<=)+	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 z (MinPQ _ k a ts) = foldF (f z k a) ts where+	extract = extractForest (<=)+	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 :: LEq k -> BinomTree rk k a -> BinomTree rk k a -> BinomTree (Succ rk) k a+meld (<=) t1@(BinomTree k1 v1 ts1) t2@(BinomTree k2 v2 ts2)+	| k1 <= k2	= BinomTree k1 v1 (Succ t2 ts1)+	| otherwise	= BinomTree k2 v2 (Succ t1 ts2)++-- | Takes the union of two binomial forests, starting at the same rank.  Analogous to binary addition.+mergeForest :: LEq k -> BinomForest rk k a -> BinomForest rk k a -> BinomForest rk k a+mergeForest (<=) f1 f2 = case (f1, f2) of+	(Skip ts1, Skip ts2)		-> Skip (mergeForest (<=) ts1 ts2)+	(Skip ts1, Cons t2 ts2)		-> Cons t2 (mergeForest (<=) ts1 ts2)+	(Cons t1 ts1, Skip ts2)		-> Cons t1 (mergeForest (<=) ts1 ts2)+	(Cons t1 ts1, Cons t2 ts2)	-> Skip (carryForest (<=) (meld (<=) t1 t2) ts1 ts2)+	(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 :: LEq k -> BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a -> BinomForest rk k a+carryForest (<=) t0 f1 f2 = t0 `seq` case (f1, f2) of+	(Cons t1 ts1, Cons t2 ts2)	-> Cons t0 (carryMeld t1 t2 ts1 ts2)+	(Cons t1 ts1, Skip ts2)		-> Skip (carryMeld t0 t1 ts1 ts2)+	(Skip ts1, Cons t2 ts2)		-> Skip (carryMeld t0 t2 ts1 ts2)+	(Skip ts1, Skip ts2)		-> Cons t0 (mergeForest (<=) ts1 ts2)+	(Nil, _)			-> incr (<=) t0 f2+	(_, Nil)			-> incr (<=) t0 f1+	where	carryMeld = carryForest (<=) .: meld (<=)++-- | Inserts a binomial tree into a binomial forest.  Analogous to binary incrementation.+incr :: LEq k -> BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a+incr (<=) t ts = t `seq` case ts of+	Nil		-> Cons t Nil+	Skip ts'	-> Cons t ts'+	Cons t' ts'	-> Skip (incr (<=) (meld (<=) t t') ts')++-- | 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 :: LEq k -> Int -> BinomHeap k a -> MinPQueue k a+extractHeap (<=) n ts = n `seq` case extractForest (<=) 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 :: LEq k -> Maybe (BinomTree rk k a) -> Extract (Succ rk) k a -> Extract rk k a+incrExtract (<=) Nothing (Extract k a (Succ t ts) tss)+	= Extract k a ts (Cons t tss)+incrExtract (<=) (Just t) (Extract k a (Succ t' ts) tss)+	= Extract k a ts (Skip (incr (<=) (meld (<=) t t') tss))++-- | 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 :: LEq k -> BinomForest rk k a -> MExtract rk k a+extractForest _ Nil = No+extractForest (<=) (Skip tss) = case extractForest (<=) tss of+	No	-> No+	Yes ex	-> Yes (incrExtract (<=) Nothing ex)+extractForest (<=) (Cons t@(BinomTree k a ts) tss) = Yes $ case extractForest (<=) tss of+	Yes ex@(Extract k' _ _ _)+		| k' <? k	-> incrExtract (<=) (Just t) ex+	_			-> Extract k a ts (Skip tss)+	where	a <? b = not (b <= a)++-- | Utility function for mapping over a forest.+mapForest :: (k -> a -> b) -> (rk k a -> rk k b) -> BinomForest rk k a -> BinomForest rk k b+mapForest f fCh ts = case ts of+	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 :: LEq k -> (k -> a -> Maybe b) -> (rk k a -> MinPQueue k b) ->+	BinomForest rk k a -> MinPQueue k b+mapMaybeF (<=) f fCh ts = case ts of+	Nil		-> Empty+	Skip ts'	-> mapMaybeF (<=) f fCh' ts'+	Cons (BinomTree k a ts) ts'+			-> insF k a (fCh ts) (mapMaybeF (<=) f fCh' ts')+	where	insF k a = maybe id (insert' (<=) k) (f k a) .: union' (<=)+		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 :: LEq k -> (k -> a -> Either b c) -> (rk k a -> (MinPQueue k b, MinPQueue k c)) ->+	BinomForest rk k a -> (MinPQueue k b, MinPQueue k c)+mapEitherF (<=) f fCh ts = case ts of+	Nil		-> (Empty, Empty)+	Skip ts'	-> mapEitherF (<=) f fCh' ts'+	Cons (BinomTree k a ts) ts'+			-> insF k a (fCh ts) (mapEitherF (<=) f fCh' ts')+	where	insF k a = either (first' . insert' (<=) k) (second' . insert' (<=) k) (f k a) .: +			(union' (<=) `both` union' (<=))+		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 z (MinPQ _ k a ts) = foldlWithKeyF_ (\ k a z -> f z k a) (const id) ts (f z k a)++-- | Unordered right fold on a binomial forest.+foldrWithKeyF_ :: (k -> a -> b -> b) -> (rk k a -> b -> b) -> BinomForest rk k a -> b -> b+foldrWithKeyF_ f fCh ts z = case ts of+	Nil		-> z+	Skip ts'	-> foldrWithKeyF_ f fCh' ts' z+	Cons (BinomTree k a ts) ts'+		-> f k a (fCh ts (foldrWithKeyF_ f fCh' ts' z))+	where	fCh' (Succ (BinomTree k a ts) tss) z =+			f k a (fCh ts (fCh tss z))++-- | Unordered left fold on a binomial forest.+foldlWithKeyF_ :: (k -> a -> b -> b) -> (rk k a -> b -> b) -> BinomForest rk k a -> b -> b+foldlWithKeyF_ f fCh ts = case ts of+	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 ts = case ts 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 z = z+seqSpine (MinPQ _ _ _ ts) z = ts `seqSpineF` z 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
+ Data/PQueue/Prio/Max.hs view
@@ -0,0 +1,456 @@+{-# LANGUAGE CPP #-}++-----------------------------------------------------------------------------+-- |+-- 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, supporting extract-minimum operations.+-- Each element is associated with a /key/, and the priority queue supports+-- viewing and extracting the element with the minimum key.+--+-- An amortized running time is given for each operation, with /n/ referring+-- to the length of the sequence and /i/ being the integral index used by+-- 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.+--+-- This implementation does 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.+-- +-- This implementation offers a number of methods of the form @xxxU@, where @U@ stands for+-- "unordered."  No guarantees are made on the execution or traversal order of+-- these functions.+-----------------------------------------------------------------------------+module Data.PQueue.Prio.Max (+	MaxPQueue,+	-- * Construction+	empty,+	singleton,+	insert,+	union,+	unions, +	-- * Query+	null,+	size,+	-- ** Maximum view+	findMax,+	getMax,+	deleteMax,+	deleteFindMax,+	alterMax,+	alterMaxWithKey,+	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 hiding (empty)+import Control.Arrow+import Data.Monoid+import qualified Data.List as List+import Data.Foldable hiding (toList)+import Data.Traversable+import Data.Maybe hiding (mapMaybe)++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 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++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)++newtype Down a = Down {unDown :: a} deriving (Eq)++-- | 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 (Q.MinPQueue (Down k) a) deriving (Eq, Ord)++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 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)++-- | 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.+alterMax :: (a -> a) -> MaxPQueue k a -> MaxPQueue k a +alterMax = alterMaxWithKey . const++-- | /O(1)/.  Alter the value at the maximum key.  If the queue is empty, does nothing.+alterMaxWithKey :: (k -> a -> a) -> MaxPQueue k a -> MaxPQueue k a+alterMaxWithKey f (MaxPQ q) = MaxPQ (Q.alterMinWithKey (f . unDown) q)++-- | /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 ('toAscList' q)@.+-- +-- If you do not care about the traversal order, consider using 'foldrWithKeyU'.+foldrWithKey :: Ord k => (k -> a -> b -> b) -> b -> MaxPQueue k a -> b+foldrWithKey f z (MaxPQ q) = Q.foldrWithKey (f . unDown) z q++-- | /O(n log n)/.  Fold the keys and values in the map, such that +-- @'foldlWithKey' f z q == 'List.foldl' ('uncurry' . f) z ('toAscList' q)@.+-- +-- If you do not care about the traversal order, consider using 'foldlWithKeyU'.+foldlWithKey :: Ord k => (b -> k -> a -> b) -> b -> MaxPQueue k a -> b+foldlWithKey f z (MaxPQ q) = Q.foldlWithKey (\ z -> f z . unDown) z q++-- | /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') ('toAscList' q)@)+takeWhile :: Ord k => (a -> Bool) -> MaxPQueue k a -> [(k, a)]+takeWhile = takeWhileWithKey . const++-- | Takes the longest possible prefix of elements satisfying the predicate.+-- (@'takeWhile' p q == 'List.takeWhile' (uncurry p) ('toAscList' q)@)+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 ascending order.+keys :: Ord k => MaxPQueue k a -> [k]+keys = fmap fst . toDescList++-- | /O(n log n)/.  Return all elements of the queue in ascending order by key.+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 'toAscList'.+-- +-- 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 z (MaxPQ q) = Q.foldlWithKeyU (\ z -> f z . unDown) z 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, Ord b) => (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, Ord b) => (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/Min.hs view
@@ -0,0 +1,417 @@+{-# LANGUAGE CPP #-}++-----------------------------------------------------------------------------+-- |+-- 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.  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,+	union,+	unions, +	-- * Query+	null,+	size,+	-- ** Minimum view+	findMin,+	getMin,+	deleteMin,+	deleteFindMin,+	alterMin,+	alterMinWithKey,+	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 hiding (empty)+import Control.Arrow+import Data.Monoid+import qualified Data.List as List+import Data.Foldable hiding (toList)+import Data.Traversable+import Data.Maybe hiding (mapMaybe)++import Data.PQueue.Prio.Internals++import Prelude hiding (map, filter, break, span, takeWhile, dropWhile, splitAt, take, drop, (!!), null, foldr)++#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++(.:) :: (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 .:++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.+alterMin :: (a -> a) -> MinPQueue k a -> MinPQueue k a+alterMin = alterMinWithKey . 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 n q +	| n <= 0	= q+	| n >= size q	= empty+	| otherwise	= drop' n q+	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 p = takeWhileFB (uncurry' p) . 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 ((k, a), q')+		| p k a		-> let (kas, q'') = spanWithKey p q' in ((k, a):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 = 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, Ord b) => (a -> f b) -> MinPQueue k a -> f (MinPQueue k b)+traverseU = traverseWithKeyU . const++-- | /O(n)/.  An unordered traversal over a priority queue, in no particular order.+-- While there is no guarantee in which order the elements are traversed, the resulting+-- priority queue will be perfectly valid.+traverseWithKeyU :: (Applicative f, Ord b) => (k -> a -> f b) -> MinPQueue k a -> f (MinPQueue k b)+traverseWithKeyU f = foldrWithKeyU (\ k a q -> insertMin k <$> f k a <*> q) (pure empty)++instance Functor (MinPQueue k) where+	fmap = map++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
+ LICENSE view
@@ -0,0 +1,2 @@+Copyright Louis Wasserman 2010+BSD license
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain
+ include/Typeable.h view
@@ -0,0 +1,69 @@+{- --------------------------------------------------------------------------+// Macros to help make Typeable instances.+//+// INSTANCE_TYPEABLEn(tc,tcname,"tc") defines+//+//	instance Typeable/n/ tc+//	instance Typeable a => Typeable/n-1/ (tc a)+//	instance (Typeable a, Typeable b) => Typeable/n-2/ (tc a b)+//	...+//	instance (Typeable a1, ..., Typeable an) => Typeable (tc a1 ... an)+// --------------------------------------------------------------------------+-}++#ifndef TYPEABLE_H+#define TYPEABLE_H++#define INSTANCE_TYPEABLE0(tycon,tcname,str) \+tcname :: TyCon; \+tcname = mkTyCon str; \+instance Typeable tycon where { typeOf _ = mkTyConApp tcname [] }++#ifdef __GLASGOW_HASKELL__++--  // For GHC, the extra instances follow from general instance declarations+--  // defined in Data.Typeable.++#define INSTANCE_TYPEABLE1(tycon,tcname,str) \+tcname :: TyCon; \+tcname = mkTyCon str; \+instance Typeable1 tycon where { typeOf1 _ = mkTyConApp tcname [] }++#define INSTANCE_TYPEABLE2(tycon,tcname,str) \+tcname :: TyCon; \+tcname = mkTyCon str; \+instance Typeable2 tycon where { typeOf2 _ = mkTyConApp tcname [] }++#define INSTANCE_TYPEABLE3(tycon,tcname,str) \+tcname :: TyCon; \+tcname = mkTyCon str; \+instance Typeable3 tycon where { typeOf3 _ = mkTyConApp tcname [] }++#else /* !__GLASGOW_HASKELL__ */++#define INSTANCE_TYPEABLE1(tycon,tcname,str) \+tcname = mkTyCon str; \+instance Typeable1 tycon where { typeOf1 _ = mkTyConApp tcname [] }; \+instance Typeable a => Typeable (tycon a) where { typeOf = typeOfDefault }++#define INSTANCE_TYPEABLE2(tycon,tcname,str) \+tcname = mkTyCon str; \+instance Typeable2 tycon where { typeOf2 _ = mkTyConApp tcname [] }; \+instance Typeable a => Typeable1 (tycon a) where { \+  typeOf1 = typeOf1Default }; \+instance (Typeable a, Typeable b) => Typeable (tycon a b) where { \+  typeOf = typeOfDefault }++#define INSTANCE_TYPEABLE3(tycon,tcname,str) \+tcname = mkTyCon str; \+instance Typeable3 tycon where { typeOf3 _ = mkTyConApp tcname [] }; \+instance Typeable a => Typeable2 (tycon a) where { \+  typeOf2 = typeOf2Default }; \+instance (Typeable a, Typeable b) => Typeable1 (tycon a b) where { \+  typeOf1 = typeOf1Default }; \+instance (Typeable a, Typeable b, Typeable c) => Typeable (tycon a b c) where { \+  typeOf = typeOfDefault }++#endif /* !__GLASGOW_HASKELL__ */++#endif
+ pqueue.cabal view
@@ -0,0 +1,34 @@+Name:		pqueue+Version:	1.0.0+Category:	Data Structures+Author:		Louis Wasserman+License:	BSD3+License-file:	LICENSE+Stability:	experimental+Synopsis:	Reliable, persistent, fast priority queues.+Description:	A fast, reliable priority queue implementation based on a binomial heap.+Maintainer:	Louis Wasserman <wasserman.louis@gmail.com>+Build-type:	Simple+cabal-version:  >= 1.6+extra-source-files: include/Typeable.h++source-repository head+      type: darcs+      location: http://code.haskell.org/containers-pqueue/++Library{+  build-depends:  base >= 4 && < 5+  exposed-modules:+        Data.PQueue.Prio.Min+        Data.PQueue.Prio.Max+        Data.PQueue.Min+        Data.PQueue.Max+  other-modules:+        Data.PQueue.Prio.Internals+        Data.PQueue.Internals++  if impl(ghc) {+    extensions: DeriveDataTypeable+  }+  ghc-options: -fdicts-strict+}