Ticket #3909: containers-pqueue.4.patch

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

Semi-final implementation of binomial heap priority queue. Provides linear-time filter and partition implementations.

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