Ticket #3909: containers-pqueue.2.patch

File containers-pqueue.2.patch, 32.2 KB (added by LouisWasserman, 4 years ago)

New version with both min and max queues exported in a nice, minimalist way that doesn't get in people's way, like many existing implementations.

Line 
1Thu Mar  4 11:22:34 CST 2010  wasserman.louis@gmail.com
2  * Data.PQueue with binomial heaps
3
4New patches:
5
6[Data.PQueue with binomial heaps
7wasserman.louis@gmail.com**20100304172234
8 Ignore-this: ff30638168b7add7d1fd1e5473289500
9] {
10adddir ./Data/PQueue
11addfile ./Data/PQueue.hs
12hunk ./Data/PQueue.hs 1
13+
14+-----------------------------------------------------------------------------
15+-- |
16+-- Module      :  Data.MinQueue
17+-- Copyright   :  (c) Louis Wasserman 2010
18+-- License     :  BSD-style
19+-- Maintainer  :  libraries@haskell.org
20+-- Stability   :  experimental
21+-- Portability :  portable
22+--
23+-- General purpose priority queue, supporting extract-maximum operations.
24+--
25+-- This module reexports "Data.PQueue.Min".  If you need to use a max-queue,
26+-- you should import "Data.PQueue.Max".
27+---------------------------------------------------------------------------
28+module Data.PQueue (
29+       PQueue,
30+       module Data.PQueue.Min) where
31hunk ./Data/PQueue.hs 20
32+import Data.PQueue.Min
33+
34+type PQueue = MinQueue
35addfile ./Data/PQueue/Max.hs
36hunk ./Data/PQueue/Max.hs 1
37+{-# LANGUAGE CPP #-}
38hunk ./Data/PQueue/Max.hs 3
39+-----------------------------------------------------------------------------
40+-- |
41+-- Module      :  Data.MinQueue.Max
42+-- Copyright   :  (c) Louis Wasserman 2010
43+-- License     :  BSD-style
44+-- Maintainer  :  libraries@haskell.org
45+-- Stability   :  experimental
46+-- Portability :  portable
47+--
48+-- General purpose priority queue, supporting extract-maximum operations.
49+--
50+-- An amortized running time is given for each operation, with /n/ referring
51+-- to the length of the sequence and /i/ being the integral index used by
52+-- some operations.  These bounds hold even in a persistent (shared) setting.
53+--
54+-- This implementation is based on a binomial heap augmented with a global root.
55+-- The spine of the heap is maintained strictly, ensuring that computations happen
56+-- as they are performed.  Note that this module is a small wrapper around
57+-- "Data.PQueue.Min".
58+--
59+-- /WARNING:/ 'toList' and 'toAscList' are /not/ equivalent, unlike for example
60+-- "Data.Map".
61+-----------------------------------------------------------------------------
62+module Data.PQueue.Max(
63+       MaxQueue,
64+       -- * Basic operations
65+       empty,
66+       null,
67+       size,
68+       -- * Query operations
69+       ViewQ(..),
70+       top,
71+       delete,
72+       extract,
73+       -- * Construction operations
74+       singleton,
75+       insert,
76+       union,
77+       unions,
78+       intersection,
79+       difference,
80+       -- * Fold\/Functor\/Traversable variations
81+       mapMonotonic,
82+       foldrQueue,
83+       foldlQueue,
84+       traverseMonotonic,
85+       -- * List operations
86+       toList,
87+       toDescList,
88+       fromList,
89+       fromDescList) where
90+
91+import Control.Applicative (Applicative(..), (<$>))
92+
93+import Data.Monoid
94+import Data.Foldable hiding (toList)
95+import Data.Traversable
96+
97+import qualified Data.PQueue.Min as Min
98+
99+import Prelude hiding (foldr, foldl, null)
100+
101+#ifdef __GLASGOW_HASKELL__
102+import GHC.Exts (build)
103+import Text.Read (Lexeme(Ident), lexP, parens, prec,
104+       readPrec, readListPrec, readListPrecDefault)
105+#endif
106+
107+-- | A priority queue implementation.  Implemented as a wrapper around "Data.PQueue.Min".
108+-- /Warning/: the 'Functor', 'Foldable', and 'Traversable' instances of this type /ignore ordering/.
109+-- For 'Functor', it is guaranteed that if @f@ is a monotonic function, then @'fmap' f@ on a valid
110+-- 'MaxQueue' will return a valid 'MaxQueue'.  An analogous guarantee holds for 'traverse'.  (Note:
111+-- if passed constant-time operations, every function in 'Functor', 'Foldable', and 'Traversable'
112+-- will run in /O(n)/.)
113+--
114+-- If you wish to perform folds on a priority queue that respect order, use 'foldrQueue' or
115+-- 'foldlQueue'.
116+newtype MaxQueue a = MaxQ {unMaxQ :: Min.MinQueue (Down a)}
117+newtype Down a = Down a deriving (Eq)
118+
119+instance Ord a => Ord (Down a) where
120+       Down x `compare` Down y = compare y x
121+       Down x <= Down y = y <= x
122+       Down x < Down y = y < x
123+       Down x >= Down y = y >= x
124+       Down x > Down y = y > x
125+
126+instance Ord a => Eq (MaxQueue a) where
127+       q1 == q2 = toDescList q1 == toDescList q2
128+
129+instance Ord a => Ord (MaxQueue a) where
130+       q1 `compare` q2 = toDescList q1 `compare` toDescList q2
131+
132+instance (Ord a, Show a) => Show (MaxQueue a) where
133+       showsPrec p xs = showParen (p > 10) $
134+               showString "fromDescList " . shows (toDescList xs)
135+               
136+instance Read a => Read (MaxQueue a) where
137+#ifdef __GLASGOW_HASKELL__
138+       readPrec = parens $ prec 10 $ do
139+               Ident "fromDescList" <- lexP
140+               xs <- readPrec
141+               return (fromDescList xs)
142+
143+       readListPrec = readListPrecDefault
144+#else
145+       readsPrec p = readParen (p > 10) $ \ r -> do
146+               ("fromDescList",s) <- lex r
147+               (xs,t) <- reads s
148+               return (fromDescList xs,t)
149+#endif
150+
151+instance Ord a => Monoid (MaxQueue a) where
152+       mempty = empty
153+       mappend = union
154+
155+-- | /O(1)/.  The empty priority queue.
156+empty :: MaxQueue a
157+empty = MaxQ Min.empty
158+
159+-- | /O(1)/.  Is this the empty priority queue?
160+null :: MaxQueue a -> Bool
161+null (MaxQ q) = Min.null q
162+
163+-- | /O(1)/.  The number of elements in the queue.
164+size :: MaxQueue a -> Int
165+size (MaxQ q) = Min.size q
166+
167+data ViewQ a = EmptyQ          -- ^ empty queue
168+       | a :^ MaxQueue a       -- ^ the top (maximum) of the queue and the rest of the queue
169+       deriving (Eq, Ord, Read, Show)
170+
171+instance Functor ViewQ where
172+       fmap f (a :^ q) = f a :^ fmap f q
173+       fmap _ _ = EmptyQ
174+
175+instance Foldable ViewQ where
176+       foldr _ z EmptyQ = z
177+       foldr f z (a :^ q) = a `f` foldr f z q
178+       foldl _ z EmptyQ = z
179+       foldl f z (a :^ q) = foldl f (z `f` a) q
180+
181+instance Traversable ViewQ where
182+       traverse _ EmptyQ = pure EmptyQ
183+       traverse f (a :^ q) = (:^) <$> f a <*> traverse f q
184+
185+-- | /O(log n)/.  The top (maximum) element of the queue, if there is one.
186+top :: Ord a => MaxQueue a -> Maybe a
187+top q = case extract q of
188+       EmptyQ  -> Nothing
189+       x :^ _  -> Just x
190+
191+-- | /O(log n)/.  Extract the top (maximum) element of the sequence, if there is one.
192+extract :: Ord a => MaxQueue a -> ViewQ a
193+extract (MaxQ q) = case Min.extract q of
194+       Min.EmptyQ      -> EmptyQ
195+       (Min.:^) (Down a) q'
196+                       -> a :^ MaxQ q'
197+
198+-- | /O(log n)/.  Delete the top (maximum) element of the sequence, if there is one.
199+delete :: Ord a => MaxQueue a -> Maybe (MaxQueue a)
200+delete (MaxQ q) = MaxQ <$> Min.delete q
201+
202+-- | /O(1)/.  Construct a priority queue with a single element.
203+singleton :: a -> MaxQueue a
204+singleton = MaxQ . Min.singleton . Down
205+
206+-- | /O(1)/.  Insert an element into the priority queue. 
207+insert :: Ord a => a -> MaxQueue a -> MaxQueue a
208+insert x (MaxQ q) = MaxQ (Min.insert (Down x) q)
209+
210+-- | /O(log (min(n,m)))/.  Take the union of two priority queues.
211+union :: Ord a => MaxQueue a -> MaxQueue a -> MaxQueue a
212+MaxQ q1 `union` MaxQ q2 = MaxQ (Min.union q1 q2)
213+
214+-- | Takes the union of a list of priority queues.  Equivalent to @'foldl' 'union' 'empty'@.
215+unions :: Ord a => [MaxQueue a] -> MaxQueue a
216+unions = foldl union empty
217+
218+-- | /O(n log n + m log m)/.  Take the intersection of two priority queues.
219+intersection :: Ord a => MaxQueue a -> MaxQueue a -> MaxQueue a
220+MaxQ q1 `intersection` MaxQ q2 = MaxQ (Min.intersection q1 q2)
221+
222+-- | /O(n log n + m log m)/.  Takes the difference of two priority queues.
223+difference :: Ord a => MaxQueue a -> MaxQueue a -> MaxQueue a
224+MaxQ q1 `difference` MaxQ q2 = MaxQ (Min.difference q1 q2)
225+
226+-- | /O(n)/.  Assumes that the function it is given is monotonic, and applies this function to every element of the priority queue,
227+-- as in 'fmap'.  If it is not, the result is undefined.
228+mapMonotonic :: (a -> b) -> MaxQueue a -> MaxQueue b
229+mapMonotonic = fmap
230+
231+-- | /O(n)/.  Assumes that the function it is given is monotonic, in some sense, and performs the 'traverse' operation.
232+-- If the function is not monotonic, the result is undefined.
233+traverseMonotonic :: Applicative f => (a -> f b) -> MaxQueue a -> f (MaxQueue b)
234+traverseMonotonic = traverse
235+
236+instance Functor Down where
237+       fmap f (Down a) = Down (f a)
238+
239+instance Foldable Down where
240+       foldr f z (Down a) = a `f` z
241+       foldl f z (Down a) = z `f` a
242+
243+instance Traversable Down where
244+       traverse f (Down a) = Down <$> f a
245+
246+instance Functor MaxQueue where
247+       fmap f (MaxQ q) = MaxQ (fmap (fmap f) q)
248+
249+instance Foldable MaxQueue where
250+       foldr f z (MaxQ q) = foldr (flip (foldr f)) z q
251+       foldl f z (MaxQ q) = foldl (foldl f) z q
252+
253+instance Traversable MaxQueue where
254+       traverse f (MaxQ q) = MaxQ <$> traverse (traverse f) q
255+
256+foldrQueue :: Ord a => (a -> b -> b) -> b -> MaxQueue a -> b
257+foldrQueue f z (MaxQ q) = Min.foldrQueue (flip (foldr f)) z q
258+
259+foldlQueue :: Ord a => (b -> a -> b) -> b -> MaxQueue a -> b
260+foldlQueue f z (MaxQ q) = Min.foldlQueue (foldl f) z q
261+
262+{-# INLINE toDescList #-}
263+-- | /O(n log n)/.  Extracts the elements of the priority queue in descending order.
264+toDescList :: Ord a => MaxQueue a -> [a]
265+#ifdef __GLASGOW_HASKELL__
266+toDescList q = build (\ c nil -> foldrQueue c nil q)
267+#else
268+toDescList = foldrQueue (:) []
269+#endif
270+
271+{-# INLINE toList #-}
272+-- | /O(n)/.  Returns the elements of the priority queue in no particular order.
273+toList :: MaxQueue a -> [a]
274+#ifdef __GLASGOW_HASKELL__
275+toList q = build (\ c nil -> foldr c nil q)
276+#else
277+toList = foldr (:) []
278+#endif
279+
280+{-# INLINE fromDescList #-}
281+-- | /O(n)/.  Constructs a priority queue from an descending list.  /Warning/: Does not check the precondition.
282+fromDescList :: [a] -> MaxQueue a
283+fromDescList = MaxQ . Min.fromAscList . map Down
284+
285+{-# INLINE fromList #-}
286+-- | /O(n log n)/.  Constructs a priority queue from an unordered list.
287+fromList :: Ord a => [a] -> MaxQueue a
288+fromList = foldr insert empty
289addfile ./Data/PQueue/Min.hs
290hunk ./Data/PQueue/Min.hs 1
291+{-# LANGUAGE CPP #-}
292hunk ./Data/PQueue/Min.hs 3
293+-----------------------------------------------------------------------------
294+-- |
295+-- Module      :  Data.MinQueue.Min
296+-- Copyright   :  (c) Louis Wasserman 2010
297+-- License     :  BSD-style
298+-- Maintainer  :  libraries@haskell.org
299+-- Stability   :  experimental
300+-- Portability :  portable
301+--
302+-- General purpose priority queue, supporting extract-minimum operations.
303+--
304+-- An amortized running time is given for each operation, with /n/ referring
305+-- to the length of the sequence and /i/ being the integral index used by
306+-- some operations.  These bounds hold even in a persistent (shared) setting.
307+--
308+-- This implementation is based on a binomial heap augmented with a global root.
309+-- The spine of the heap is maintained strictly, ensuring that computations happen
310+-- as they are performed.
311+--
312+-- /WARNING:/ 'toList' and 'toAscList' are /not/ equivalent, unlike for example
313+-- "Data.Map".
314+-----------------------------------------------------------------------------
315+module Data.PQueue.Min (
316+       MinQueue,
317+       -- * Basic operations
318+       empty,
319+       null,
320+       size,
321+       -- * Query operations
322+       ViewQ(..),
323+       top,
324+       delete,
325+       extract,
326+       -- * Construction operations
327+       singleton,
328+       insert,
329+       union,
330+       unions,
331+       intersection,
332+       difference,
333+       -- * Fold\/Functor\/Traversable variations
334+       mapMonotonic,
335+       foldrQueue,
336+       foldlQueue,
337+       traverseMonotonic,
338+       -- * List operations
339+       toList,
340+       toAscList,
341+       fromList,
342+       fromAscList) where
343+
344+import Prelude hiding (null, foldr, foldl)
345+
346+import Control.Applicative (Applicative(..), (<$>))
347+
348+import Data.Monoid
349+import Data.Foldable hiding (toList)
350+import Data.Traversable
351+
352+#ifdef __GLASGOW_HASKELL__
353+import GHC.Exts (build)
354+import Text.Read (Lexeme(Ident), lexP, parens, prec,
355+       readPrec, readListPrec, readListPrecDefault)
356+#endif
357+
358+-- | A priority queue implementation.  Implemented as a find-min wrapper around a binomial heap.
359+-- /Warning/: the 'Functor', 'Foldable', and 'Traversable' instances of this type /ignore ordering/.
360+-- For 'Functor', it is guaranteed that if @f@ is a monotonic function, then @'fmap' f@ on a valid
361+-- 'MinQueue' will return a valid 'MinQueue'.  An analogous guarantee holds for 'traverse'.  (Note:
362+-- if passed constant-time operations, every function in 'Functor', 'Foldable', and 'Traversable'
363+-- will run in /O(n)/.)
364+--
365+-- If you wish to perform folds on a priority queue that respect order, use 'foldrQueue' or
366+-- 'foldlQueue'.
367+data MinQueue a = Empty | MinQueue {-# UNPACK #-} !Int a !(BinomHeap a)
368+type BinomHeap a = BinomForest a Zero
369+
370+instance Ord a => Eq (MinQueue a) where
371+       q1 == q2 = toAscList q1 == toAscList q2
372+
373+instance Ord a => Ord (MinQueue a) where
374+       compare q1 q2 = compare (toAscList q1) (toAscList q2)
375+
376+instance (Ord a, Show a) => Show (MinQueue a) where
377+       showsPrec p xs = showParen (p > 10) $
378+               showString "fromAscList " . shows (toAscList xs)
379+
380+instance Read a => Read (MinQueue a) where
381+#ifdef __GLASGOW_HASKELL__
382+       readPrec = parens $ prec 10 $ do
383+               Ident "fromAscList" <- lexP
384+               xs <- readPrec
385+               return (fromAscList xs)
386+
387+       readListPrec = readListPrecDefault
388+#else
389+       readsPrec p = readParen (p > 10) $ \ r -> do
390+               ("fromAscList",s) <- lex r
391+               (xs,t) <- reads s
392+               return (fromAscList xs,t)
393+#endif
394+
395+instance Ord a => Monoid (MinQueue a) where
396+       mempty = Empty
397+       mappend = union
398+
399+-- We implement tree ranks in the type system with a nicely elegant approach, as follows.
400+--
401+-- A binomial tree of rank @0@ with elements of type @e@ has type @'BinomTree' e 'Zero'@.
402+-- If a binomial tree of rank @k@ has type @BinomTree e k@, then a binomial tree of rank
403+-- @k+1@ has type @'BinomTree' e ('Succ' e k)@.  Therefore, we may justifiably label the
404+-- second type argument as the /rank/ of the node.
405+--
406+-- Consider the set-theoretic definition of the natural numbers, in which a number is specified
407+-- to be the set of all numbers less than it, and 0 is the empty set.  The ranks of binomial
408+-- trees are similar: the children of a binomial tree of rank @k@ are a collection of a binomial
409+-- tree of every rank less than @k@.  We can then /define/ the type representing rank @k@
410+-- to be a sequence of a binomial tree of every rank less than @k@.  In particular,
411+-- @'Succ' e k@ is equivalent to @(BinomTree e k, k)@, since @k@ is a type representing a
412+-- sequence of binomial trees of rank less than @k@.  We may reasonably define the type
413+-- corresponding to @0@ to be @()@, since it should be an unambiguous ``unit.''  This is
414+-- nicely analogous to the construction of the natural numbers, where @succ(a) = {a} `union` a@.
415+--
416+-- Now that we've defined rank types, we note that a binomial tree with a given rank @rk@,
417+-- written as @'BinomTree' e rk@, has a root of type @e@ and a set of children of type @rk@.
418+-- We may justifiably say, then,
419+--
420+-- > data BinomTree e rk = BinomTree e rk
421+--
422+-- Cute!
423+--
424+-- To implement binomial heaps, in which we may have at most one root of each rank, we define
425+-- @'BinomForest' e rk@ to be a binomial forest of roots of rank at least @rk@.  Since there is only
426+-- one root of each rank, we may either have a binomial forest of rank @rk@ or not, and then
427+-- a @BinomForest e (Succ e rk)@ contains the rest of the forest.  We also have a 'Nil' constructor,
428+-- for when we have no more roots.  We maintain the invariant that @Nil@ always follows a @Cons@, but
429+-- don't implement that in the type system.
430+data BinomForest e rk = Nil | Skip !(BinomForest' e rk) | Cons {-# UNPACK #-} !(BinomTree e rk) !(BinomForest' e rk)
431+type BinomForest' e rk = BinomForest e (Succ e rk)
432+
433+instance Ord e => Monoid (BinomForest e rk) where
434+       mempty = Nil
435+       mappend = merge (<=)
436+
437+data BinomTree e rk = BinomTree e rk
438+type BinomTree' e rk = BinomTree e (Succ e rk)
439+data Succ e rk = Succ {-# UNPACK #-} !(BinomTree e rk) rk
440+type Zero = ()
441+
442+-- basics
443+
444+-- | /O(1)/.  The empty priority queue.
445+empty :: MinQueue a
446+empty = Empty
447+
448+-- | /O(1)/.  Is this the empty priority queue?
449+null :: MinQueue a -> Bool
450+null Empty = True
451+null _ = False
452+
453+-- | /O(1)/.  The number of elements in the queue.
454+size :: MinQueue a -> Int
455+size Empty = 0
456+size (MinQueue n _ _) = n
457+
458+-- queries
459+
460+-- | View of the top of a sequence.  Note: the 'Functor', 'Foldable', and 'Traversable' instances
461+-- have the same caveats as the instances for 'MinQueue'.
462+data ViewQ a = EmptyQ          -- ^ empty queue
463+       | a :^ MinQueue a       -- ^ the top (minimum) of the queue and the rest of the queue
464+       deriving (Eq, Ord, Read, Show)
465+
466+instance Functor ViewQ where
467+       fmap f (a :^ q) = f a :^ fmap f q
468+       fmap _ _ = EmptyQ
469+
470+instance Foldable ViewQ where
471+       foldr _ z EmptyQ = z
472+       foldr f z (a :^ q) = a `f` foldr f z q
473+       foldl _ z EmptyQ = z
474+       foldl f z (a :^ q) = foldl f (z `f` a) q
475+
476+instance Traversable ViewQ where
477+       traverse _ EmptyQ = pure EmptyQ
478+       traverse f (a :^ q) = (:^) <$> f a <*> traverse f q
479+
480+-- | /O(1)/.  View the top (minimum) element of the queue, if there is one.
481+top :: Ord a => MinQueue a -> Maybe a
482+top q = case extract q of
483+       EmptyQ  -> Nothing
484+       x :^ _  -> Just x
485+
486+-- | /O(log n)/.  Extract the top (minimum) element of the sequence, if there is one.
487+extract :: Ord a => MinQueue a -> ViewQ a
488+extract Empty = EmptyQ
489+extract (MinQueue n x f) = x :^ delete' n f
490+
491+-- | /O(log n)/.  Delete the top element of the sequence, if there is one.
492+delete :: Ord a => MinQueue a -> Maybe (MinQueue a)
493+delete q = case extract q of
494+       EmptyQ  -> Nothing
495+       _ :^ q' -> Just q'
496+
497+-- | Takes a size and a binomial forest and produces a priority queue with a distinguished global root.
498+delete' :: Ord a => Int -> BinomHeap a -> MinQueue a
499+delete' n f = n `seq` case extractBin (<=) f of
500+       NoExtract       -> Empty
501+       YesExtract x' _ f'
502+                       -> MinQueue (n-1) x' f'
503+
504+-- | A specialized type intended to organize the return of extract-min queries
505+-- from a binomial forest.  We walk all the way through the forest, and then
506+-- walk backwards.  @Extract e rk@ is the result type of an extract-min
507+-- operation that has walked as far backwards of rank @rk@ -- that is, it
508+-- has visited every root of rank @>= rk@.
509+--
510+-- The interpretation of @YesExtract minKey children forest@ is
511+--
512+--     * @minKey@ is the key of the minimum root visited so far.  It may have
513+--             any rank @>= rk@.  We will denote the root corresponding to
514+--             @minKey@ as @minRoot@.
515+--     
516+--     * @children@ is those children of @minRoot@ which have not yet been
517+--             merged with the rest of the forest. Specifically, these are
518+--             the children with rank @< rk@.
519+--     
520+--     * @forest@ is a partial reconstruction of the binomial forest without
521+--             @minRoot@. It is the union of all old roots with rank @>= rk@
522+--             (except @minRoot@), with the set of all children of @minRoot@
523+--             with rank @>= rk@.  Note that @forest@ is lazy, so if we discover
524+--             a smaller key than @minKey@ later, we haven't wasted significant
525+--             work.
526+data Extract e rk = NoExtract | YesExtract e rk (BinomForest e rk)
527+
528+-- | Walks backward from the biggest key in the forest, as far as rank @rk@.
529+-- Returns its progress.  Each successive application of @extractBin@ takes
530+-- amortized /O(1)/ time, so applying it from the beginning takes /O(log n)/ time.
531+extractBin :: (e -> e -> Bool) -> BinomForest e rk -> Extract e rk
532+extractBin _ Nil = NoExtract
533+extractBin (<=) (Skip f) = case extractBin (<=) f of
534+       NoExtract -> NoExtract
535+       YesExtract minKey (Succ kChild kChildren) f' ->
536+               YesExtract minKey kChildren (Cons kChild f')
537+extractBin (<=) (Cons t@(BinomTree x ts) f) = case extractBin (<=) f of
538+       YesExtract minKey (Succ kChild kChildren) f'
539+               | minKey <= x   -> YesExtract minKey kChildren (Skip (carry1 (<=) (t `cat` kChild) f'))
540+       _                       -> YesExtract x ts (Skip f)
541+       where   cat = joinBin (<=)
542+
543+-- | /O(1)/.  Construct a priority queue with a single element.
544+singleton :: a -> MinQueue a
545+singleton x = MinQueue 1 x Nil
546+
547+-- | /O(1)/.  Insert an element into the priority queue. 
548+insert :: Ord a => a -> MinQueue a -> MinQueue a
549+insert x' (MinQueue n x f)
550+       | x' <= x       = MinQueue (n+1) x' (insertBin x f)
551+       | otherwise     = MinQueue (n+1) x (insertBin x' f)
552+       where   insertBin = carry1 (<=) . tip
553+insert x Empty = singleton x
554+
555+-- | /O(log (min(n,m)))/.  Take the union of two priority queues.
556+union :: Ord a => MinQueue a -> MinQueue a -> MinQueue a
557+Empty `union` q = q
558+q `union` Empty = q
559+MinQueue n1 x1 f1 `union` MinQueue n2 x2 f2
560+       | x1 <= x2      = MinQueue (n1 + n2) x1 (carry (<=) (tip x2) f1 f2)
561+       | otherwise     = MinQueue (n1 + n2) x2 (carry (<=) (tip x1) f1 f2)
562+
563+-- | Takes the union of a list of priority queues.  Equivalent to @'foldl' 'union' 'empty'@.
564+unions :: Ord a => [MinQueue a] -> MinQueue a
565+unions = foldl union Empty
566+
567+-- | /O(n log n + m log m)/.  Take the intersection of two priority queues.
568+intersection :: Ord a => MinQueue a -> MinQueue a -> MinQueue a
569+Empty `intersection` _ = Empty
570+_ `intersection` Empty = Empty
571+MinQueue _ x1 f1 `intersection` MinQueue _ x2 f2 = intersectBin (<=) compare x1 f1 x2 f2
572+
573+-- Takes the intersection of two binomial heaps.  Essentially, this is just the algorithm
574+-- for intersecting two sorted lists, except unconsing is replaced by dequeueing.
575+-- Not particularly necessary, but interesting to have just for grins.
576+intersectBin :: (a -> a -> Bool) -> (a -> a -> Ordering) -> a -> BinomHeap a -> a -> BinomHeap a -> MinQueue a
577+intersectBin (<=) cmp = intersect where
578+       intersect x1 f1 x2 f2 = case (cmp x1 x2, extractBin (<=) f1, extractBin (<=) f2) of
579+               (LT, YesExtract x1' _ f1', _)
580+                       -> intersect x1' f1' x2 f2
581+               (EQ, YesExtract x1' _ f1', YesExtract x2' _ f2')
582+                       -> x1 `insertMinQ` intersect x1' f1' x2' f2'
583+               (EQ, _, _)
584+                       -> singleton x1
585+               (GT, _, YesExtract x2' _ f2')
586+                       -> intersect x1 f1 x2' f2'
587+               _       -> Empty
588+
589+-- | /O(n log n + m log m)/.  Takes the difference of two priority queues.
590+difference :: Ord a => MinQueue a -> MinQueue a -> MinQueue a
591+queue `difference` Empty
592+       = queue
593+Empty `difference` _   
594+       = Empty
595+MinQueue n1 x1 f1 `difference` MinQueue _ x2 f2
596+       = differenceBin (<=) compare n1 x1 f1 x2 f2
597+
598+-- Takes the difference of two binomial heaps.  Essentially, this is just the algorithm
599+-- for the difference of two sorted lists, except unconsing is replaced by dequeueing.
600+-- Not particularly necessary, but interesting to have just for grins.
601+differenceBin :: (a -> a -> Bool) -> (a -> a -> Ordering) -> Int -> a -> BinomHeap a -> a -> BinomHeap a -> MinQueue a
602+differenceBin (<=) cmp = diffBin where
603+       diffBin n x1 f1 x2 f2 = n `seq` case (cmp x1 x2, extractBin (<=) f1, extractBin (<=) f2) of
604+               (LT, YesExtract x1' _ f1', _)
605+                       -> x1 `insertMinQ` diffBin (n-1) x1' f1' x2 f2
606+               (LT, _, _)
607+                       -> singleton x1
608+               (EQ, YesExtract x1' _ f1', YesExtract x2' _ f2')
609+                       -> diffBin (n-1) x1' f1' x2' f2'
610+               (EQ, YesExtract x1' _ f1', _)
611+                       -> MinQueue n x1' f1'
612+               (EQ, _, _)
613+                       -> Empty
614+               (GT, _, YesExtract x2' _ f2')
615+                       -> diffBin n x1 f1 x2' f2'
616+               (GT, _, _)
617+                       -> MinQueue n x1 f1
618+
619+{-# INLINE tip #-}
620+-- | Constructs a binomial tree of rank 0.
621+tip :: e -> BinomTree e ()
622+tip x = BinomTree x ()
623+
624+-- | Given two binomial forests starting at rank @rk@, takes their union.
625+-- Each successive application of this function costs /O(1)/, so applying it
626+-- from the beginning costs /O(log n)/.
627+merge :: (e -> e -> Bool) -> BinomForest e rk -> BinomForest e rk -> BinomForest e rk
628+merge (<=) f1 f2 = case (f1, f2) of
629+       (Nil, _)        -> f2
630+       (_, Nil)        -> f1
631+       (Skip f1', Skip f2')
632+                       -> Skip (merge (<=) f1' f2')
633+       (Skip f1', Cons t2 f2')
634+                       -> Cons t2 (merge (<=) f1' f2')
635+       (Cons t1 f1', Skip f2')
636+                       -> Cons t1 (merge (<=) f1' f2')
637+       (Cons t1 f1', Cons t2 f2')
638+                       -> Skip (carry (<=) (t1 `cat` t2) f1' f2')
639+       where   cat = joinBin (<=)
640+
641+-- | Merges two binomial forests with another tree. If we are thinking of the trees
642+-- in the binomial forest as binary digits, this corresponds to a carry operation.
643+-- Each call to this function takes /O(1)/ time, so in total, it costs /O(log n)/.
644+carry :: (e -> e -> Bool) -> BinomTree e rk -> BinomForest e rk -> BinomForest e rk -> BinomForest e rk
645+carry (<=) t0 f1 f2 = t0 `seq` case (f1, f2) of
646+       (Nil, Nil)              -> Cons t0 Nil
647+       (Nil, Skip f2')         -> Cons t0 f2'
648+       (Skip f1', Nil)         -> Cons t0 f1'
649+       (Nil, Cons t2 f2')      -> Skip (carry1 (<=) (t0 `cat` t2) f2')
650+       (Cons t1 f1', Nil)      -> Skip (carry1 (<=) (t0 `cat` t1) f1')
651+       (Skip f1', Skip f2')    -> Cons t0 (merge (<=) f1' f2')
652+       (Skip f1', Cons t2 f2') -> Skip (carry (<=) (t0 `cat` t2) f1' f2')
653+       (Cons t1 f1', Skip f2') -> Skip (carry (<=) (t0 `cat` t1) f1' f2')
654+       (Cons t1 f1', Cons t2 f2')
655+                               -> Cons t0 (carry (<=) (t1 `cat` t2) f1' f2')
656+       where   cat = joinBin (<=)
657+
658+-- | Merges a binomial tree into a binomial forest.  If we are thinking
659+-- of the trees in the binomial forest as binary digits, this corresponds
660+-- to adding a power of 2.  This costs amortized /O(1)/ time.
661+carry1 :: (e -> e -> Bool) -> BinomTree e rk -> BinomForest e rk -> BinomForest e rk
662+carry1 (<=) t f = t `seq` case f of
663+       Nil     -> Cons t Nil
664+       Skip f  -> Cons t f
665+       Cons t' f' -> Skip (carry1 (<=) (t `cat` t') f')
666+       where   cat = joinBin (<=)
667+
668+-- | The carrying operation: takes two binomial heaps of the same rank @k@
669+-- and returns one of rank @k+1@.  Takes /O(1)/ time.
670+joinBin :: (e -> e -> Bool) -> BinomTree e rk -> BinomTree e rk -> BinomTree' e rk
671+joinBin (<=) t1@(BinomTree x1 ts1) t2@(BinomTree x2 ts2)
672+       | x1 <= x2      = BinomTree x1 (Succ t2 ts1)
673+       | otherwise     = BinomTree x2 (Succ t1 ts2)
674+
675+-- folding
676+
677+-- | /O(n)/.  Assumes that the function it is given is monotonic, and applies this function to every element of the priority queue,
678+-- as in 'fmap'.  If it is not, the result is undefined.
679+mapMonotonic :: (a -> b) -> MinQueue a -> MinQueue b
680+mapMonotonic = fmap
681+
682+-- | /O(n)/.  Assumes that the function it is given is monotonic, in some sense, and performs the 'traverse' operation.
683+-- If the function is not monotonic, the result is undefined.
684+traverseMonotonic :: Applicative f => (a -> f b) -> MinQueue a -> f (MinQueue b)
685+traverseMonotonic = traverse
686+
687+instance Functor MinQueue where
688+       fmap _ Empty = Empty
689+       fmap f (MinQueue n x forest) = MinQueue n (f x) (mapForest f (const ()) forest)
690+
691+mapForest :: (a -> b) -> (rk -> rk') -> BinomForest a rk -> BinomForest b rk'
692+mapForest f fCh forest = case forest of
693+       Nil     -> Nil
694+       Skip forest'
695+               -> Skip (fF' forest')
696+       Cons t forest'
697+               -> Cons (fT t) (fF' forest')
698+       where   fT (BinomTree x ts) = BinomTree (f x) (fCh ts)
699+               fCh' (Succ t ts) = Succ (fT t) (fCh ts)
700+               fF' = mapForest f fCh'
701+
702+instance Foldable MinQueue where
703+       foldr _ n Empty = n
704+       foldr c n (MinQueue _ x f) = x `c` foldrUnord c n (const id) f
705+       foldMap _ Empty = mempty
706+       foldMap f (MinQueue _ x forest) = f x `mappend` foldMap0 mappend mempty f forest
707+
708+-- | The initial level of 'foldMap'.  Avoids unnecessary @'mappend' 'mempty'@ computations.
709+foldMap0 :: (m -> m -> m) -> m -> (a -> m) -> BinomHeap a -> m
710+foldMap0 (><) zero f forest = case forest of
711+       Nil     -> zero
712+       Skip forest'
713+               -> fF' forest'
714+       Cons (BinomTree x _) forest'
715+               -> f x >< fF' forest'
716+       where   fF' = foldMapUnord (><) zero f (\ (Succ (BinomTree x _) _) -> f x)
717+
718+-- | A recursive implementation of 'foldMap' capable of working up to trees of arbitrary rank.
719+-- Does not respect ordering of the elements.
720+foldMapUnord :: (m -> m -> m) -> m -> (a -> m) -> (rk -> m) -> BinomForest a rk -> m
721+foldMapUnord (><) zero f fCh forest = case forest of
722+       Nil             -> zero
723+       Skip forest'    -> fF' forest'
724+       Cons t forest'  -> fT t >< fF' forest'
725+       where   fT (BinomTree x ts) = f x >< fCh ts
726+               fCh' (Succ t tss) = fT t >< fCh tss
727+               fF' = foldMapUnord (><) zero f fCh'
728+
729+-- | 'foldr' implementation on the binomial forest.  Does not respect ordering of the elements.
730+foldrUnord :: (a -> b -> b) -> b -> (rk -> b -> b) -> BinomForest a rk -> b
731+foldrUnord c n cCh forest = case forest of
732+       Nil        -> n
733+       Skip f'    -> cF' f'
734+       Cons t f'  -> t `cT` cF' f'
735+       where   cT (BinomTree x ts) = c x . cCh ts
736+               cCh' (Succ t tss) = cT t . cCh tss
737+               cF' = foldrUnord c n cCh'
738+
739+instance Traversable MinQueue where
740+       traverse _ Empty = pure Empty
741+       traverse f (MinQueue n x forest)
742+               = MinQueue n <$> f x <*> traverseBin f (const (pure ())) forest
743+
744+traverseBin :: Applicative f => (a -> f b) -> (rk -> f rk') -> BinomForest a rk -> f (BinomForest b rk')
745+traverseBin f fCh forest = case forest of
746+       Nil     -> pure Nil
747+       Skip forest'
748+               -> Skip <$> fF' forest'
749+       Cons t forest'
750+               -> Cons <$> fT t <*> fF' forest'
751+       where   fF' = traverseBin f fCh'
752+               fT (BinomTree x ts) = BinomTree <$> f x <*> fCh ts
753+               fCh' (Succ t tss) = Succ <$> fT t <*> fCh tss
754+
755+{-# INLINE toAscList #-}
756+-- | /O(n log n)/.  Extracts the elements of the priority queue in ascending order.
757+toAscList :: Ord a => MinQueue a -> [a]
758+#ifdef __GLASGOW_HASKELL__
759+toAscList q = build (\ c nil -> foldrQueue c nil q)
760+#else
761+toAscList = foldrQueue (:) []
762+#endif
763+
764+{-# INLINE toList #-}
765+-- | /O(n)/.  Returns the elements of the priority queue in no particular order.
766+toList :: MinQueue a -> [a]
767+#ifdef __GLASGOW_HASKELL__
768+toList q = build (\ c nil -> foldr c nil q)
769+#else
770+toList = foldr (:) []
771+#endif
772+
773+-- | /O(n log n)/.  Performs a right-fold on the elements of a priority queue in ascending order.
774+foldrQueue :: Ord a => (a -> b -> b) -> b -> MinQueue a -> b
775+foldrQueue c n (MinQueue _ x f) = x `c` foldrOrd (<=) c n f
776+foldrQueue _ n _ = n
777+
778+-- | /O(n log n)/.  Performs a left-fold on the elements of a priority queue in ascending order.
779+foldlQueue :: Ord a => (b -> a -> b) -> b -> MinQueue a -> b
780+foldlQueue f z (MinQueue _ x forest) = foldlOrd (<=) f (z `f` x) forest
781+foldlQueue _ z _ = z
782+
783+-- | Right fold on a binomial forest.  Respects order.
784+foldrOrd :: (a -> a -> Bool) -> (a -> b -> b) -> b -> BinomHeap a -> b
785+foldrOrd (<=) c n = foldQ0 where
786+       foldQ0 = foldQ1 . extractBin (<=)
787+       foldQ1 NoExtract = n
788+       foldQ1 (YesExtract x _ f)
789+                       = x `c` foldQ0 f
790+
791+-- | Left fold on a binomial forest.  Respects order.
792+foldlOrd :: (a -> a -> Bool) -> (b -> a -> b) -> b -> BinomHeap a -> b
793+foldlOrd (<=) f z = foldlQ0 z where
794+       foldlQ0 z = foldlQ1 z . extractBin (<=)
795+       foldlQ1 z NoExtract = z
796+       foldlQ1 z (YesExtract x _ f')
797+               = foldlQ0 (z `f` x) f'
798+       
799+
800+{-# INLINE fromAscList #-}
801+-- | /O(n)/.  Constructs a priority queue from an ascending list.  /Warning/: Does not check the precondition.
802+fromAscList :: [a] -> MinQueue a
803+fromAscList = foldr insertMinQ Empty
804+
805+insertMinQ :: a -> MinQueue a -> MinQueue a
806+insertMinQ x Empty = singleton x
807+insertMinQ x (MinQueue n x' f) = MinQueue (n+1) x (insertMin (tip x') f)
808+
809+-- | @insertMin t f@ assumes that the root of @t@ compares as less than
810+-- every other root in @f@, and merges accordingly.
811+insertMin :: BinomTree e rk -> BinomForest e rk -> BinomForest e rk
812+insertMin t Nil = Cons t Nil
813+insertMin t (Skip f) = Cons t f
814+insertMin (BinomTree x ts) (Cons t' f) = Skip (insertMin (BinomTree x (Succ t' ts)) f)
815+
816+{-# INLINE fromList #-}
817+-- | /O(n log n)/.  Constructs a priority queue from an unordered list.
818+fromList :: Ord a => [a] -> MinQueue a
819+fromList = foldr insert Empty
820hunk ./containers.cabal 36
821             Data.Graph
822             Data.Sequence
823             Data.Tree
824+            Data.PQueue
825+            Data.PQueue.Min
826+            Data.PQueue.Max
827     }
828     if impl(ghc) {
829         extensions: DeriveDataTypeable, MagicHash, Rank2Types
830}
831
832Context:
833
834[Tweak layout to work with the alternative layout rule
835Ian Lynagh <igloo@earth.li>**20091129154519]
836[Disable building Data.Sequence (and dependents) for nhc98.
837Malcolm.Wallace@cs.york.ac.uk**20091124025653
838 There is some subtlety of polymorphically recursive datatypes and
839 type-class defaulting that nhc98's type system barfs over.
840]
841[Fix another instance of non-ghc breakage.
842Malcolm.Wallace@cs.york.ac.uk**20091123092637]
843[Add #ifdef around ghc-only (<$) as member of Functor class.
844Malcolm.Wallace@cs.york.ac.uk**20091123085155]
845[Fix broken code in non-GHC branch of an ifdef.
846Malcolm.Wallace@cs.york.ac.uk**20091123084824]
847[doc bugfix: correct description of index argument
848Ross Paterson <ross@soi.city.ac.uk>**20091028105532
849 Ignore-this: 9790e7bf422c4cb528722c03cfa4fed9
850 
851 As noted by iaefai on the libraries list.
852 
853 Please merge to STABLE.
854]
855[Bump version to 0.3.0.0
856Ian Lynagh <igloo@earth.li>**20090920141847]
857[update base dependency
858Ross Paterson <ross@soi.city.ac.uk>**20090916073125
859 Ignore-this: ad382ffc6c6a18c15364e6c072f19edb
860 
861 The package uses mkNoRepType and Data.Functor, which were not in the
862 stable branch of base-4.
863]
864[add fast version of <$ for Seq
865Ross Paterson <ross@soi.city.ac.uk>**20090916072812
866 Ignore-this: 5a39a7d31d39760ed589790b1118d240
867]
868[new methods for Data.Sequence (proposal #3271)
869Ross Paterson <ross@soi.city.ac.uk>**20090915173324
870 Ignore-this: cf17bedd709a6ab3448fd718dcdf62e7
871 
872 Adds a lot of new methods to Data.Sequence, mostly paralleling those
873 in Data.List.  Several of these are significantly faster than versions
874 implemented with the previous public interface.  In particular, replicate
875 takes O(log n) time and space instead of O(n).
876 (by Louis Wasserman)
877]
878[Fix "Cabal check" warnings
879Ian Lynagh <igloo@earth.li>**20090811215900]
880[TAG 2009-06-25
881Ian Lynagh <igloo@earth.li>**20090625160202]
882Patch bundle hash:
8837b157605a4dbb34b789009b9de1873b5ae0a190f