Ticket #3909: containers-pqueue.patch

File containers-pqueue.patch, 22.1 KB (added by LouisWasserman, 5 years ago)

Sexy implementation of a binomial queue, with the type system guaranteeing the correct relationship between binomial trees of different ranks.

Line 
1Thu Mar  4 08:59:15 CST 2010  [email protected]
2  * Data.PQueue with binomial heaps
3
4New patches:
5
6[Data.PQueue with binomial heaps
7[email protected]**20100304145915
8 Ignore-this: 31d532d51dda171d4ae2e484ffa3a8fb
9] {
10addfile ./Data/PQueue.hs
11hunk ./Data/PQueue.hs 1
12+{-# LANGUAGE ScopedTypeVariables, CPP, Rank2Types, ImplicitParams #-}
13hunk ./Data/PQueue.hs 3
14+-----------------------------------------------------------------------------
15+-- |
16+-- Module      :  Data.PQueue
17+-- Copyright   :  (c) Louis Wasserman 2010
18+-- License     :  BSD-style
19+-- Maintainer  :  [email protected]
20+-- Stability   :  experimental
21+-- Portability :  portable
22+--
23+-- General purpose priority queue, supporting extract-minimum operations.
24+--
25+-- An amortized running time is given for each operation, with /n/ referring
26+-- to the length of the sequence and /i/ being the integral index used by
27+-- some operations.  These bounds hold even in a persistent (shared) setting.
28+--
29+-- This implementation is based on a binomial heap augmented with a global root.
30+-- The spine of the heap is maintained strictly, ensuring that computations happen
31+-- as they are performed.
32+--
33+-- /WARNING:/ 'toList' and 'toAscList' are /not/ equivalent, unlike for example
34+-- "Data.Map".
35+-----------------------------------------------------------------------------
36+module Data.PQueue (
37+       PQueue,
38+       -- * Basic operations
39+       empty,
40+       null,
41+       size,
42+       -- * Query operations
43+       ViewQ(..),
44+       top,
45+       delete,
46+       extract,
47+       -- * Construction operations
48+       singleton,
49+       insert,
50+       union,
51+       unions,
52+       intersection,
53+       difference,
54+       -- * Fold\/Functor\/Traversable variations
55+       mapMonotonic,
56+       foldrQueue,
57+       foldlQueue,
58+       traverseMonotonic,
59+       -- * List operations
60+       toList,
61+       toAscList,
62+       fromList,
63+       fromAscList) where
64+
65+import Prelude hiding (null, foldr, foldl)
66+
67+import Control.Applicative (Applicative(..), (<$>))
68+
69+import Data.Monoid
70+import Data.Foldable hiding (toList)
71+import Data.Traversable
72+
73+#ifdef __GLASGOW_HASKELL__
74+import GHC.Exts (build)
75+import Text.Read (Lexeme(Ident), lexP, parens, prec,
76+       readPrec, readListPrec, readListPrecDefault)
77+#endif
78+
79+-- | A priority queue implementation.  Implemented as a find-min wrapper around a binomial heap.
80+-- /Warning/: the 'Functor', 'Foldable', and 'Traversable' instances of this type /ignore ordering/.
81+-- For 'Functor', it is guaranteed that if @f@ is a monotonic function, then @'fmap' f@ on a valid
82+-- 'PQueue' will return a valid 'PQueue'.  An analogous guarantee holds for 'traverse'.  (Note:
83+-- if passed constant-time operations, every function in 'Functor', 'Foldable', and 'Traversable'
84+-- will run in /O(n)/.)
85+--
86+-- If you wish to perform folds on a priority queue that respect order, it is advised that you apply
87+-- your fold function to @toAscList queue@.
88+data PQueue a = Empty | PQueue {-# UNPACK #-} !Int a !(BinomHeap a)
89+type BinomHeap a = BinomForest a Zero
90+
91+instance Ord a => Eq (PQueue a) where
92+       q1 == q2 = toAscList q1 == toAscList q2
93+
94+instance Ord a => Ord (PQueue a) where
95+       compare q1 q2 = compare (toAscList q1) (toAscList q2)
96+
97+instance (Ord a, Show a) => Show (PQueue a) where
98+       showsPrec p xs = showParen (p > 10) $
99+               showString "fromAscList " . shows (toAscList xs)
100+
101+instance Read a => Read (PQueue a) where
102+#ifdef __GLASGOW_HASKELL__
103+       readPrec = parens $ prec 10 $ do
104+               Ident "fromAscList" <- lexP
105+               xs <- readPrec
106+               return (fromAscList xs)
107+
108+       readListPrec = readListPrecDefault
109+#else
110+       readsPrec p = readParen (p > 10) $ \ r -> do
111+               ("fromAscList",s) <- lex r
112+               (xs,t) <- reads s
113+               return (fromAscList xs,t)
114+#endif
115+
116+instance Ord a => Monoid (PQueue a) where
117+       mempty = Empty
118+       mappend = union
119+
120+-- We implement tree ranks in the type system with a nicely elegant approach, as follows.
121+--
122+-- A binomial tree of rank @0@ with elements of type @e@ has type @'BinomTree' e 'Zero'@.
123+-- If a binomial tree of rank @k@ has type @BinomTree e k@, then a binomial tree of rank
124+-- @k+1@ has type @'BinomTree' e ('Succ' e k)@.  Therefore, we may justifiably label the
125+-- second type argument as the /rank/ of the node.
126+--
127+-- This is all in the type system.  A /value/ of type @'Succ' e rk@, however, is a sequence
128+-- of binomial trees of rank @0@ through @k-1@, which is exactly the type of the /collection of
129+-- children/ of a node of rank @rk@.  Therefore, @'BinomTree' e rk@, a binomial tree of rank
130+-- @rk@, is exactly equivalent to @(e, rk)@.  Cute!
131+--
132+-- To implement binomial heaps, in which we may have at most one root of each rank, we define
133+-- @'BinomForest' e rk@ to be a binomial forest of roots of rank at least @rk@.  Since there is only
134+-- one root of each rank, we may either have a binomial forest of rank @rk@ or not, and then
135+-- a @BinomForest e (Succ e rk)@ contains the rest of the forest.  We also have a 'Nil' constructor,
136+-- for when we have no more roots.  We maintain the invariant that @Nil@ always follows a @Cons@, but
137+-- don't implement that in the type system.
138+data BinomForest e rk = Nil | Skip !(BinomForest' e rk) | Cons {-# UNPACK #-} !(BinomTree e rk) !(BinomForest' e rk)
139+type BinomForest' e rk = BinomForest e (Succ e rk)
140+
141+instance Ord e => Monoid (BinomForest e rk) where
142+       mempty = Nil
143+       mappend = merge (<=)
144+
145+data BinomTree e rk = BinomTree e rk
146+type BinomTree' e rk = BinomTree e (Succ e rk)
147+data Succ e rk = Succ {-# UNPACK #-} !(BinomTree e rk) rk
148+type Zero = ()
149+
150+-- basics
151+
152+-- | /O(1)/.  The empty priority queue.
153+empty :: PQueue a
154+empty = Empty
155+
156+-- | /O(1)/.  Is this the empty priority queue?
157+null :: PQueue a -> Bool
158+null Empty = True
159+null _ = False
160+
161+-- | /O(1)/.  The number of elements in the queue.
162+size :: PQueue a -> Int
163+size Empty = 0
164+size (PQueue n _ _) = n
165+
166+-- queries
167+
168+-- | View of the top of a sequence.  Note: the 'Functor', 'Foldable', and 'Traversable' instances
169+-- have the same caveats as the instances for 'PQueue'.
170+data ViewQ a = EmptyQ  -- ^ empty queue
171+       | a :^ PQueue a -- ^ the top (minimum) of the queue and the rest of the queue
172+       deriving (Eq, Ord, Read, Show)
173+
174+instance Functor ViewQ where
175+       fmap f (a :^ q) = f a :^ fmap f q
176+       fmap _ _ = EmptyQ
177+
178+instance Foldable ViewQ where
179+       foldr _ z EmptyQ = z
180+       foldr f z (a :^ q) = a `f` foldr f z q
181+       foldl _ z EmptyQ = z
182+       foldl f z (a :^ q) = foldl f (z `f` a) q
183+
184+instance Traversable ViewQ where
185+       traverse _ EmptyQ = pure EmptyQ
186+       traverse f (a :^ q) = (:^) <$> f a <*> traverse f q
187+
188+-- | /O(1)/.  View the top (minimum) element of the queue, if there is one.
189+top :: Ord a => PQueue a -> Maybe a
190+top q = case extract q of
191+       EmptyQ  -> Nothing
192+       x :^ _  -> Just x
193+
194+-- | /O(log n)/.  Extract the top (minimum) element of the sequence, if there is one.
195+extract :: Ord a => PQueue a -> ViewQ a
196+extract Empty = EmptyQ
197+extract (PQueue n x f) = x :^ delete' n f
198+
199+-- | /O(log n)/.  Delete the top element of the sequence, if there is one.
200+delete :: Ord a => PQueue a -> Maybe (PQueue a)
201+delete q = case extract q of
202+       EmptyQ  -> Nothing
203+       _ :^ q' -> Just q'
204+
205+-- | Takes a size and a binomial forest and produces a priority queue with a distinguished global root.
206+delete' :: Ord a => Int -> BinomHeap a -> PQueue a
207+delete' n f = n `seq` case extractBin (<=) f of
208+       NoExtract       -> Empty
209+       YesExtract x' _ f'
210+                       -> PQueue (n-1) x' f'
211+
212+-- | A specialized type intended to organize the return of extract-min queries
213+-- from a binomial forest.  We walk all the way through the forest, and then
214+-- walk backwards.  @Extract e rk@ is the result type of an extract-min
215+-- operation that has walked as far backwards of rank @rk@ -- that is, it
216+-- has visited every root of rank @>= rk@.
217+--
218+-- The interpretation of @YesExtract minKey children forest@ is
219+--
220+--     * @minKey@ is the key of the minimum root visited so far.  It may have
221+--             any rank @>= rk@.  We will denote the root corresponding to
222+--             @minKey@ as @minRoot@.
223+--     
224+--     * @children@ is those children of @minRoot@ which have not yet been
225+--             merged with the rest of the forest. Specifically, these are
226+--             the children with rank @< rk@.
227+--     
228+--     * @forest@ is a partial reconstruction of the binomial forest without
229+--             @minRoot@. It is the union of all old roots with rank @>= rk@
230+--             (except @minRoot@), with the set of all children of @minRoot@
231+--             with rank @>= rk@.  Note that @forest@ is lazy, so if we discover
232+--             a smaller key than @minKey@ later, we haven't wasted significant
233+--             work.
234+data Extract e rk = NoExtract | YesExtract e rk (BinomForest e rk)
235+
236+
237+-- | Walks backward from the biggest key in the forest, as far as rank @rk@.
238+-- Returns its progress.  Each successive application of @extractBin@ takes
239+-- amortized /O(1)/ time, so applying it from the beginning takes /O(log n)/ time.
240+extractBin :: (e -> e -> Bool) -> BinomForest e rk -> Extract e rk
241+extractBin _ Nil = NoExtract
242+extractBin (<=) (Skip f) = case extractBin (<=) f of
243+       NoExtract -> NoExtract
244+       YesExtract minKey (Succ kChild kChildren) f' ->
245+               YesExtract minKey kChildren (Cons kChild f')
246+extractBin (<=) (Cons t@(BinomTree x ts) f) = case extractBin (<=) f of
247+       YesExtract minKey (Succ kChild kChildren) f'
248+               | minKey <= x   -> YesExtract minKey kChildren (Skip (carry1 (<=) (t `cat` kChild) f'))
249+       _                       -> YesExtract x ts (Skip f)
250+       where   cat = joinBin (<=)
251+
252+-- | /O(1)/.  Construct a priority queue with a single element.
253+singleton :: a -> PQueue a
254+singleton x = PQueue 1 x Nil
255+
256+-- | /O(1)/.  Insert an element into the priority queue. 
257+insert :: Ord a => a -> PQueue a -> PQueue a
258+insert x' (PQueue n x f)
259+       | x' <= x       = PQueue (n+1) x' (insertBin x f)
260+       | otherwise     = PQueue (n+1) x (insertBin x' f)
261+       where   insertBin = carry1 (<=) . tip
262+insert x Empty = singleton x
263+
264+-- | /O(log (min(n,m)))/.  Take the union of two priority queues.
265+union :: Ord a => PQueue a -> PQueue a -> PQueue a
266+Empty `union` q = q
267+q `union` Empty = q
268+PQueue n1 x1 f1 `union` PQueue n2 x2 f2
269+       | x1 <= x2      = PQueue (n1 + n2) x1 (carry (<=) (tip x2) f1 f2)
270+       | otherwise     = PQueue (n1 + n2) x2 (carry (<=) (tip x1) f1 f2)
271+
272+-- | Takes the union of a list of priority queues.  Equivalent to @'foldr' 'union' 'empty'@.
273+unions :: Ord a => [PQueue a] -> PQueue a
274+unions = foldr union Empty
275+
276+-- | /O(n log n + m log m)/.  Take the intersection of two priority queues.
277+intersection :: Ord a => PQueue a -> PQueue a -> PQueue a
278+Empty `intersection` _ = Empty
279+_ `intersection` Empty = Empty
280+PQueue _ x1 f1 `intersection` PQueue _ x2 f2 = intersectBin (<=) compare x1 f1 x2 f2
281+
282+-- Takes the intersection of two binomial heaps.  Essentially, this is just the algorithm
283+-- for intersecting two sorted lists, except unconsing is replaced by dequeueing.
284+-- Not particularly necessary, but interesting to have just for grins.
285+intersectBin :: (a -> a -> Bool) -> (a -> a -> Ordering) -> a -> BinomHeap a -> a -> BinomHeap a -> PQueue a
286+intersectBin (<=) cmp = intersect where
287+       intersect x1 f1 x2 f2 = case (cmp x1 x2, extractBin (<=) f1, extractBin (<=) f2) of
288+               (LT, YesExtract x1' _ f1', _)
289+                       -> intersect x1' f1' x2 f2
290+               (EQ, YesExtract x1' _ f1', YesExtract x2' _ f2')
291+                       -> x1 `insertMinQ` intersect x1' f1' x2' f2'
292+               (EQ, _, _)
293+                       -> singleton x1
294+               (GT, _, YesExtract x2' _ f2')
295+                       -> intersect x1 f1 x2' f2'
296+               _       -> Empty
297+
298+-- | /O(n log n + m log m)/.  Takes the difference of two priority queues.
299+difference :: Ord a => PQueue a -> PQueue a -> PQueue a
300+queue `difference` Empty
301+       = queue
302+Empty `difference` _   
303+       = Empty
304+PQueue n1 x1 f1 `difference` PQueue _ x2 f2
305+       = differenceBin (<=) compare n1 x1 f1 x2 f2
306+
307+-- Takes the difference of two binomial heaps.  Essentially, this is just the algorithm
308+-- for the difference of two sorted lists, except unconsing is replaced by dequeueing.
309+-- Not particularly necessary, but interesting to have just for grins.
310+differenceBin :: (a -> a -> Bool) -> (a -> a -> Ordering) -> Int -> a -> BinomHeap a -> a -> BinomHeap a -> PQueue a
311+differenceBin (<=) cmp = diffBin where
312+       diffBin n x1 f1 x2 f2 = n `seq` case (cmp x1 x2, extractBin (<=) f1, extractBin (<=) f2) of
313+               (LT, YesExtract x1' _ f1', _)
314+                       -> x1 `insertMinQ` diffBin (n-1) x1' f1' x2 f2
315+               (LT, _, _)
316+                       -> singleton x1
317+               (EQ, YesExtract x1' _ f1', YesExtract x2' _ f2')
318+                       -> diffBin (n-1) x1' f1' x2' f2'
319+               (EQ, YesExtract x1' _ f1', _)
320+                       -> PQueue n x1' f1'
321+               (EQ, _, _)
322+                       -> Empty
323+               (GT, _, YesExtract x2' _ f2')
324+                       -> diffBin n x1 f1 x2' f2'
325+               (GT, _, _)
326+                       -> PQueue n x1 f1
327+
328+{-# INLINE tip #-}
329+-- | Constructs a binomial tree of rank 0.
330+tip :: e -> BinomTree e ()
331+tip x = BinomTree x ()
332+
333+-- | Given two binomial forests starting at rank @rk@, takes their union.
334+-- Each successive application of this function costs /O(1)/, so applying it
335+-- from the beginning costs /O(log n)/.
336+merge :: (e -> e -> Bool) -> BinomForest e rk -> BinomForest e rk -> BinomForest e rk
337+merge (<=) f1 f2 = case (f1, f2) of
338+       (Nil, _)        -> f2
339+       (_, Nil)        -> f1
340+       (Skip f1', Skip f2')
341+                       -> Skip (merge (<=) f1' f2')
342+       (Skip f1', Cons t2 f2')
343+                       -> Cons t2 (merge (<=) f1' f2')
344+       (Cons t1 f1', Skip f2')
345+                       -> Cons t1 (merge (<=) f1' f2')
346+       (Cons t1 f1', Cons t2 f2')
347+                       -> Skip (carry (<=) (t1 `cat` t2) f1' f2')
348+       where   cat = joinBin (<=)
349+
350+-- | Merges two binomial forests with another tree. If we are thinking of the trees
351+-- in the binomial forest as binary digits, this corresponds to a carry operation.
352+-- Each call to this function takes /O(1)/ time, so in total, it costs /O(log n)/.
353+carry :: (e -> e -> Bool) -> BinomTree e rk -> BinomForest e rk -> BinomForest e rk -> BinomForest e rk
354+carry (<=) t0 f1 f2 = t0 `seq` case (f1, f2) of
355+       (Nil, Nil)              -> Cons t0 Nil
356+       (Nil, Skip f2')         -> Cons t0 f2'
357+       (Skip f1', Nil)         -> Cons t0 f1'
358+       (Nil, Cons t2 f2')      -> Skip (carry1 (<=) (t0 `cat` t2) f2')
359+       (Cons t1 f1', Nil)      -> Skip (carry1 (<=) (t0 `cat` t1) f1')
360+       (Skip f1', Skip f2')    -> Cons t0 (merge (<=) f1' f2')
361+       (Skip f1', Cons t2 f2') -> Skip (carry (<=) (t0 `cat` t2) f1' f2')
362+       (Cons t1 f1', Skip f2') -> Skip (carry (<=) (t0 `cat` t1) f1' f2')
363+       (Cons t1 f1', Cons t2 f2')
364+                               -> Cons t0 (carry (<=) (t1 `cat` t2) f1' f2')
365+       where   cat = joinBin (<=)
366+
367+-- | Merges a binomial tree into a binomial forest.  If we are thinking
368+-- of the trees in the binomial forest as binary digits, this corresponds
369+-- to adding a power of 2.  This costs amortized /O(1)/ time.
370+carry1 :: (e -> e -> Bool) -> BinomTree e rk -> BinomForest e rk -> BinomForest e rk
371+carry1 (<=) t f = t `seq` case f of
372+       Nil     -> Cons t Nil
373+       Skip f  -> Cons t f
374+       Cons t' f' -> Skip (carry1 (<=) (t `cat` t') f')
375+       where   cat = joinBin (<=)
376+
377+-- | The carrying operation: takes two binomial heaps of the same rank @k@
378+-- and returns one of rank @k+1@.  Takes /O(1)/ time.
379+joinBin :: (e -> e -> Bool) -> BinomTree e rk -> BinomTree e rk -> BinomTree' e rk
380+joinBin (<=) t1@(BinomTree x1 ts1) t2@(BinomTree x2 ts2)
381+       | x1 <= x2      = BinomTree x1 (Succ t2 ts1)
382+       | otherwise     = BinomTree x2 (Succ t1 ts2)
383+
384+-- folding
385+
386+-- | /O(n)/.  Assumes that the function it is given is monotonic, and applies this function to every element of the priority queue,
387+-- as in 'fmap'.  If it is not, the result is undefined.
388+mapMonotonic :: (a -> b) -> PQueue a -> PQueue b
389+mapMonotonic = fmap
390+
391+-- | /O(n)/.  Assumes that the function it is given is monotonic, in some sense, and performs the 'traverse' operation.
392+-- If the function is not monotonic, the result is undefined.
393+traverseMonotonic :: Applicative f => (a -> f b) -> PQueue a -> f (PQueue b)
394+traverseMonotonic = traverse
395+
396+instance Functor PQueue where
397+       fmap _ Empty = Empty
398+       fmap f (PQueue n x forest) = PQueue n (f x) (mapForest f (const ()) forest)
399+
400+mapForest :: (a -> b) -> (rk -> rk') -> BinomForest a rk -> BinomForest b rk'
401+mapForest f fCh forest = case forest of
402+       Nil     -> Nil
403+       Skip forest'
404+               -> Skip (fF' forest')
405+       Cons t forest'
406+               -> Cons (fT t) (fF' forest')
407+       where   fT (BinomTree x ts) = BinomTree (f x) (fCh ts)
408+               fCh' (Succ t ts) = Succ (fT t) (fCh ts)
409+               fF' = mapForest f fCh'
410+
411+instance Foldable PQueue where
412+       foldr _ n Empty = n
413+       foldr c n (PQueue _ x f) = x `c` foldrUnord c n (const id) f
414+       foldMap _ Empty = mempty
415+       foldMap f (PQueue _ x forest) = f x `mappend` foldMap0 mappend mempty f forest
416+
417+-- | The initial level of 'foldMap'.  Avoids unnecessary @'mappend' 'mempty'@ computations.
418+foldMap0 :: (m -> m -> m) -> m -> (a -> m) -> BinomHeap a -> m
419+foldMap0 (><) zero f forest = case forest of
420+       Nil     -> zero
421+       Skip forest'
422+               -> fF' forest'
423+       Cons (BinomTree x _) forest'
424+               -> f x >< fF' forest'
425+       where   fF' = foldMapUnord (><) zero f (\ (Succ (BinomTree x _) _) -> f x)
426+
427+-- | A recursive implementation of 'foldMap' capable of working up to trees of arbitrary rank.
428+-- Does not respect ordering of the elements.
429+foldMapUnord :: (m -> m -> m) -> m -> (a -> m) -> (rk -> m) -> BinomForest a rk -> m
430+foldMapUnord (><) zero f fCh forest = case forest of
431+       Nil             -> zero
432+       Skip forest'    -> fF' forest'
433+       Cons t forest'  -> fT t >< fF' forest'
434+       where   fT (BinomTree x ts) = f x >< fCh ts
435+               fCh' (Succ t tss) = fT t >< fCh tss
436+               fF' = foldMapUnord (><) zero f fCh'
437+
438+-- | 'foldr' implementation on the binomial forest.  Does not respect ordering of the elements.
439+foldrUnord :: (a -> b -> b) -> b -> (rk -> b -> b) -> BinomForest a rk -> b
440+foldrUnord c n cCh forest = case forest of
441+       Nil        -> n
442+       Skip f'    -> cF' f'
443+       Cons t f'  -> t `cT` cF' f'
444+       where   cT (BinomTree x ts) = c x . cCh ts
445+               cCh' (Succ t tss) = cT t . cCh tss
446+               cF' = foldrUnord c n cCh'
447+
448+instance Traversable PQueue where
449+       traverse _ Empty = pure Empty
450+       traverse f (PQueue n x forest)
451+               = PQueue n <$> f x <*> traverseBin f (const (pure ())) forest
452+
453+traverseBin :: Applicative f => (a -> f b) -> (rk -> f rk') -> BinomForest a rk -> f (BinomForest b rk')
454+traverseBin f fCh forest = case forest of
455+       Nil     -> pure Nil
456+       Skip forest'
457+               -> Skip <$> fF' forest'
458+       Cons t forest'
459+               -> Cons <$> fT t <*> fF' forest'
460+       where   fF' = traverseBin f fCh'
461+               fT (BinomTree x ts) = BinomTree <$> f x <*> fCh ts
462+               fCh' (Succ t tss) = Succ <$> fT t <*> fCh tss
463+
464+{-# INLINE toAscList #-}
465+-- | /O(n log n)/.  Extracts the elements of the priority queue in ascending order.
466+toAscList :: Ord a => PQueue a -> [a]
467+#ifdef __GLASGOW_HASKELL__
468+toAscList q = build (\ c nil -> foldrQueue c nil q)
469+#else
470+toAscList = foldrQueue (:) []
471+#endif
472+
473+{-# INLINE toList #-}
474+-- | /O(n)/.  Returns the elements of the priority queue in no particular order.
475+toList :: PQueue a -> [a]
476+#ifdef __GLASGOW_HASKELL__
477+toList q = build (\ c nil -> foldr c nil q)
478+#else
479+toList = foldr (:) []
480+#endif
481+
482+-- | /O(n log n)/.  Performs a right-fold on the elements of a priority queue in ascending order.
483+foldrQueue :: Ord a => (a -> b -> b) -> b -> PQueue a -> b
484+foldrQueue c n (PQueue _ x f) = x `c` foldrOrd (<=) c n f
485+foldrQueue _ n _ = n
486+
487+-- | /O(n log n)/.  Performs a left-fold on the elements of a priority queue in ascending order.
488+foldlQueue :: Ord a => (b -> a -> b) -> b -> PQueue a -> b
489+foldlQueue f z (PQueue _ x forest) = foldlOrd (<=) f (z `f` x) forest
490+foldlQueue _ z _ = z
491+
492+-- | Right fold on a binomial forest.  Respects order.
493+foldrOrd :: (a -> a -> Bool) -> (a -> b -> b) -> b -> BinomHeap a -> b
494+foldrOrd (<=) c n = foldQ0 where
495+       foldQ0 = foldQ1 . extractBin (<=)
496+       foldQ1 NoExtract = n
497+       foldQ1 (YesExtract x _ f)
498+                       = x `c` foldQ0 f
499+
500+-- | Left fold on a binomial forest.  Respects order.
501+foldlOrd :: (a -> a -> Bool) -> (b -> a -> b) -> b -> BinomHeap a -> b
502+foldlOrd (<=) f z = foldlQ0 z where
503+       foldlQ0 z = foldlQ1 z . extractBin (<=)
504+       foldlQ1 z NoExtract = z
505+       foldlQ1 z (YesExtract x _ f')
506+               = foldlQ0 (z `f` x) f'
507+       
508+
509+{-# INLINE fromAscList #-}
510+-- | /O(n)/.  Constructs a priority queue from an ascending list.
511+fromAscList :: [a] -> PQueue a
512+fromAscList = foldr insertMinQ Empty
513+
514+insertMinQ :: a -> PQueue a -> PQueue a
515+insertMinQ x Empty = singleton x
516+insertMinQ x (PQueue n x' f) = PQueue (n+1) x (insertMin (tip x') f)
517+
518+-- | @insertMin t f@ assumes that the root of @t@ compares as less than
519+-- every other root in @f@, and merges accordingly.
520+insertMin :: BinomTree e rk -> BinomForest e rk -> BinomForest e rk
521+insertMin t Nil = Cons t Nil
522+insertMin t (Skip f) = Cons t f
523+insertMin (BinomTree x ts) (Cons t' f) = Skip (insertMin (BinomTree x (Succ t' ts)) f)
524+
525+{-# INLINE fromList #-}
526+-- | /O(n log n)/.  Constructs a priority queue from an unordered list.
527+fromList :: Ord a => [a] -> PQueue a
528+fromList = foldr insert Empty
529hunk ./containers.cabal 36
530             Data.Graph
531             Data.Sequence
532             Data.Tree
533+            Data.PQueue
534     }
535     if impl(ghc) {
536         extensions: DeriveDataTypeable, MagicHash, Rank2Types
537}
538
539Context:
540
541[Tweak layout to work with the alternative layout rule
542Ian Lynagh <[email protected]>**20091129154519]
543[Disable building Data.Sequence (and dependents) for nhc98.
544[email protected]**20091124025653
545 There is some subtlety of polymorphically recursive datatypes and
546 type-class defaulting that nhc98's type system barfs over.
547]
548[Fix another instance of non-ghc breakage.
549[email protected]**20091123092637]
550[Add #ifdef around ghc-only (<$) as member of Functor class.
551[email protected]**20091123085155]
552[Fix broken code in non-GHC branch of an ifdef.
553[email protected]**20091123084824]
554[doc bugfix: correct description of index argument
555Ross Paterson <[email protected]>**20091028105532
556 Ignore-this: 9790e7bf422c4cb528722c03cfa4fed9
557 
558 As noted by iaefai on the libraries list.
559 
560 Please merge to STABLE.
561]
562[Bump version to 0.3.0.0
563Ian Lynagh <[email protected]>**20090920141847]
564[update base dependency
565Ross Paterson <[email protected]>**20090916073125
566 Ignore-this: ad382ffc6c6a18c15364e6c072f19edb
567 
568 The package uses mkNoRepType and Data.Functor, which were not in the
569 stable branch of base-4.
570]
571[add fast version of <$ for Seq
572Ross Paterson <[email protected]>**20090916072812
573 Ignore-this: 5a39a7d31d39760ed589790b1118d240
574]
575[new methods for Data.Sequence (proposal #3271)
576Ross Paterson <[email protected]>**20090915173324
577 Ignore-this: cf17bedd709a6ab3448fd718dcdf62e7
578 
579 Adds a lot of new methods to Data.Sequence, mostly paralleling those
580 in Data.List.  Several of these are significantly faster than versions
581 implemented with the previous public interface.  In particular, replicate
582 takes O(log n) time and space instead of O(n).
583 (by Louis Wasserman)
584]
585[Fix "Cabal check" warnings
586Ian Lynagh <[email protected]>**20090811215900]
587[TAG 2009-06-25
588Ian Lynagh <[email protected]>**20090625160202]
589Patch bundle hash:
59024d587a71217c65d71c47bdc69214ac3b42b08c2